.segment "CODE" ; ---------------------------------------------------------------------------- ; "NEXT" STATEMENT ; ---------------------------------------------------------------------------- NEXT: bne NEXT1 ldy #$00 beq NEXT2 NEXT1: jsr PTRGET NEXT2: sta FORPNT sty FORPNT+1 jsr GTFORPNT beq NEXT3 ldx #$00 GERR: beq JERROR NEXT3: txs .ifndef CONFIG_2 inx inx inx inx .endif txa .ifdef CONFIG_2 clc adc #$04 pha adc #BYTES_FP+1 sta DEST pla .else inx inx inx inx inx .ifndef CONFIG_SMALL inx .endif stx DEST .endif ldy #>STACK jsr LOAD_FAC_FROM_YA tsx lda STACK+BYTES_FP+4,x sta FACSIGN lda FORPNT ldy FORPNT+1 jsr FADD jsr SETFOR ldy #>STACK jsr FCOMP2 tsx sec sbc STACK+BYTES_FP+4,x beq L2C22 lda STACK+2*BYTES_FP+5,x sta CURLIN lda STACK+2*BYTES_FP+6,x sta CURLIN+1 lda STACK+2*BYTES_FP+8,x sta TXTPTR lda STACK+2*BYTES_FP+7,x sta TXTPTR+1 L2C1F: jmp NEWSTT L2C22: txa adc #2*BYTES_FP+7 tax txs jsr CHRGOT cmp #$2C bne L2C1F jsr CHRGET jsr NEXT1 ; ---------------------------------------------------------------------------- ; EVALUATE EXPRESSION, MAKE SURE IT IS NUMERIC ; ---------------------------------------------------------------------------- FRMNUM: jsr FRMEVL ; ---------------------------------------------------------------------------- ; MAKE SURE (FAC) IS NUMERIC ; ---------------------------------------------------------------------------- CHKNUM: clc .byte $24 ; ---------------------------------------------------------------------------- ; MAKE SURE (FAC) IS STRING ; ---------------------------------------------------------------------------- CHKSTR: sec ; ---------------------------------------------------------------------------- ; MAKE SURE (FAC) IS CORRECT TYPE ; IF C=0, TYPE MUST BE NUMERIC ; IF C=1, TYPE MUST BE STRING ; ---------------------------------------------------------------------------- CHKVAL: bit VALTYP bmi L2C41 bcs L2C43 L2C40: rts L2C41: bcs L2C40 L2C43: ldx #ERR_BADTYPE JERROR: jmp ERROR ; ---------------------------------------------------------------------------- ; EVALUATE THE EXPRESSION AT TXTPTR, LEAVING THE ; RESULT IN FAC. WORKS FOR BOTH STRING AND NUMERIC ; EXPRESSIONS. ; ---------------------------------------------------------------------------- FRMEVL: ldx TXTPTR bne L2C4E dec TXTPTR+1 L2C4E: dec TXTPTR ldx #$00 .byte $24 FRMEVL1: pha txa pha lda #$01 jsr CHKMEM jsr FRM_ELEMENT lda #$00 sta CPRTYP FRMEVL2: jsr CHRGOT L2C65: sec sbc #TOKEN_GREATER bcc L2C81 cmp #$03 bcs L2C81 cmp #$01 rol a eor #$01 eor CPRTYP cmp CPRTYP bcc SNTXERR sta CPRTYP jsr CHRGET jmp L2C65 L2C81: ldx CPRTYP bne FRM_RELATIONAL bcs L2D02 adc #$07 bcc L2D02 adc VALTYP bne L2C92 jmp CAT L2C92: adc #$FF sta INDEX asl a adc INDEX tay FRM_PRECEDENCE_TEST: pla cmp MATHTBL,y bcs FRM_PERFORM1 jsr CHKNUM L2CA3: pha L2CA4: jsr FRM_RECURSE pla ldy LASTOP bpl PREFNC tax beq GOEX bne FRM_PERFORM2 ; ---------------------------------------------------------------------------- ; FOUND ONE OR MORE RELATIONAL OPERATORS <,=,> ; ---------------------------------------------------------------------------- FRM_RELATIONAL: lsr VALTYP txa rol a ldx TXTPTR bne L2CBB dec TXTPTR+1 L2CBB: dec TXTPTR ldy #$1B sta CPRTYP bne FRM_PRECEDENCE_TEST PREFNC: cmp MATHTBL,y bcs FRM_PERFORM2 bcc L2CA3 ; ---------------------------------------------------------------------------- ; STACK THIS OPERATION AND CALL FRMEVL FOR ; ANOTHER ONE ; ---------------------------------------------------------------------------- FRM_RECURSE: lda MATHTBL+2,y pha lda MATHTBL+1,y pha jsr FRM_STACK1 lda CPRTYP jmp FRMEVL1 SNTXERR: jmp SYNERR ; ---------------------------------------------------------------------------- ; STACK (FAC) ; THREE ENTRY POINTS: ; 1, FROM FRMEVL ; 2, FROM "STEP" ; 3, FROM "FOR" ; ---------------------------------------------------------------------------- FRM_STACK1: lda FACSIGN ldx MATHTBL,y ; ---------------------------------------------------------------------------- ; ENTER HERE FROM "STEP", TO PUSH STEP SIGN AND VALUE ; ---------------------------------------------------------------------------- FRM_STACK2: tay pla sta INDEX .ifndef CONFIG_2B inc INDEX ; bug: assumes not on page boundary ; bug exists on AppleSoft II .endif pla sta INDEX+1 .ifdef CONFIG_2B inc INDEX bne LEB69 inc INDEX+1 LEB69: .endif tya pha ; ---------------------------------------------------------------------------- ; ENTER HERE FROM "FOR", WITH (INDEX) = STEP, ; TO PUSH INITIAL VALUE OF "FOR" VARIABLE ; ---------------------------------------------------------------------------- FRM_STACK3: jsr ROUND_FAC .ifndef CONFIG_SMALL lda FAC+4 pha .endif lda FAC+3 pha lda FAC+2 pha lda FAC+1 pha lda FAC pha jmp (INDEX) L2D02: ldy #$FF pla GOEX: beq EXIT ; ---------------------------------------------------------------------------- ; PERFORM STACKED OPERATION ; ; (A) = PRECEDENCE BYTE ; STACK: 1 -- CPRMASK ; 5 -- (ARG) ; 2 -- ADDR OF PERFORMER ; ---------------------------------------------------------------------------- FRM_PERFORM1: cmp #$64 beq L2D0E jsr CHKNUM L2D0E: sty LASTOP FRM_PERFORM2: pla lsr a sta CPRMASK pla sta ARG pla sta ARG+1 pla sta ARG+2 pla sta ARG+3 pla .ifndef CONFIG_SMALL sta ARG+4 pla .endif sta ARGSIGN eor FACSIGN sta SGNCPR EXIT: lda FAC rts ; ---------------------------------------------------------------------------- ; GET ELEMENT IN EXPRESSION ; ; GET VALUE OF VARIABLE OR NUMBER AT TXTPNT, OR POINT ; TO STRING DESCRIPTOR IF A STRING, AND PUT IN FAC. ; ---------------------------------------------------------------------------- FRM_ELEMENT: lda #$00 sta VALTYP L2D31: jsr CHRGET bcs L2D39 L2D36: jmp FIN L2D39: jsr ISLETC bcs FRM_VARIABLE .ifdef CONFIG_CBM_ALL cmp #$FF bne LCDC1 lda #CON_PI jsr LOAD_FAC_FROM_YA jmp CHRGET CON_PI: .byte $82,$49,$0f,$DA,$A1 LCDC1: .endif cmp #$2E beq L2D36 cmp #TOKEN_MINUS beq MIN cmp #TOKEN_PLUS beq L2D31 cmp #$22 bne NOT_ ; ---------------------------------------------------------------------------- ; STRING CONSTANT ELEMENT ; ; SET Y,A = (TXTPTR)+CARRY ; ---------------------------------------------------------------------------- STRTXT: lda TXTPTR ldy TXTPTR+1 adc #$00 bcc L2D57 iny L2D57: jsr STRLIT jmp POINT ; ---------------------------------------------------------------------------- ; "NOT" FUNCTION ; IF FAC=0, RETURN FAC=1 ; IF FAC<>0, RETURN FAC=0 ; ---------------------------------------------------------------------------- NOT_: cmp #TOKEN_NOT bne L2D74 ldy #$18 bne EQUL ; ---------------------------------------------------------------------------- ; COMPARISON FOR EQUALITY (= OPERATOR) ; ALSO USED TO EVALUATE "NOT" FUNCTION ; ---------------------------------------------------------------------------- EQUOP: jsr AYINT lda FAC_LAST eor #$FF tay lda FAC_LAST-1 eor #$FF jmp GIVAYF L2D74: .ifdef SYM1 cmp #TOKEN_USR bne LCC8A jmp LCDBD LCC8A: cmp #$26 bne LCC91 jmp LCDFE LCC91: .endif cmp #TOKEN_FN bne L2D7B jmp L31F3 L2D7B: cmp #TOKEN_SGN bcc PARCHK jmp UNARY ; ---------------------------------------------------------------------------- ; EVALUATE "(EXPRESSION)" ; ---------------------------------------------------------------------------- PARCHK: jsr CHKOPN jsr FRMEVL CHKCLS: lda #$29 .byte $2C CHKOPN: lda #$28 .byte $2C CHKCOM: lda #$2C ; ---------------------------------------------------------------------------- ; UNLESS CHAR AT TXTPTR = (A), SYNTAX ERROR ; ---------------------------------------------------------------------------- SYNCHR: ; XXX all CBM code calls SYNCHR instead of CHKCOM ldy #$00 cmp (TXTPTR),y bne SYNERR jmp CHRGET ; ---------------------------------------------------------------------------- SYNERR: ldx #ERR_SYNTAX jmp ERROR ; ---------------------------------------------------------------------------- MIN: ldy #$15 EQUL: pla pla jmp L2CA4 ; ---------------------------------------------------------------------------- FRM_VARIABLE: jsr PTRGET FRM_VARIABLE_CALL = *-1 sta FAC_LAST-1 sty FAC_LAST .ifdef CONFIG_CBM_ALL lda VARNAM ldy VARNAM+1 .endif ldx VALTYP beq L2DB1 .ifdef CONFIG_CBM_ALL .ifdef CONFIG_CBM1_PATCHES jmp PATCH2 clc LCE3B: .else ldx #$00 stx STRNG1+1 bit FAC_LAST bpl LCE53 ; XXX Assumes vars are <32K and C_ZERO lives above! cmp #$54 ; T bne LCE53 .endif cpy #$C9 ; I$ bne LCE53 jsr GETTIM sty EXPON ; Y=0 dey sty STRNG2 ldy #$06 sty INDX ldy #$24 jsr LDD3A jmp LD353 LCE53: .endif .ifdef CONFIG_2 .ifndef CBM2 ; bugfix? ; fixed on AppleSoft II, not on any CBM ldx #$00 stx STRNG1+1 .endif .endif rts L2DB1: .ifndef CONFIG_SMALL ldx VALTYP+1 bpl L2DC2 ldy #$00 lda (FAC+3),y tax iny lda (FAC+3),y tay txa jmp GIVAYF L2DC2: .endif .ifdef CONFIG_CBM1_PATCHES jmp PATCH3 .byte $19 .endif .ifdef CBM2 bit FAC_LAST bpl LCE90 ; XXX Assumes vars are <32K and C_ZERO lives above! cmp #$54 ; T bne LCE82 .endif .ifndef CONFIG_CBM_ALL jmp LOAD_FAC_FROM_YA .endif .ifdef CONFIG_CBM_ALL LCE69: cpy #$49 ; I .ifdef CBM1 bne LCE82 .else bne LCE90 .endif jsr GETTIM tya ; FOR FLOAT3 (Y=0) ldx #$A0 ; EXPONENT jmp FLOAT3 GETTIM: lda #<(TISTR-2) ldy #>(TISTR-2) sei jsr LOAD_FAC_FROM_YA cli sty FAC+1 ; ZERO HIGHEST. rts LCE82: cmp #$53 ; S bne LCE90 cpy #$54 ; T bne LCE90 lda Z96 jmp FLOAT LCE90: lda FAC_LAST-1 ldy FAC_LAST jmp LOAD_FAC_FROM_YA .endif ; ---------------------------------------------------------------------------- UNARY: asl a pha tax jsr CHRGET cpx #<(TOKEN_LEFTSTR*2-1) bcc L2DEF jsr CHKOPN jsr FRMEVL jsr CHKCOM jsr CHKSTR pla tax lda FAC_LAST pha lda FAC_LAST-1 pha txa pha jsr GETBYT pla tay txa pha jmp L2DF4 L2DEF: jsr PARCHK pla tay L2DF4: lda UNFNC-TOKEN_SGN-TOKEN_SGN+$100,y sta JMPADRS+1 lda UNFNC-TOKEN_SGN-TOKEN_SGN+$101,y sta JMPADRS+2 .ifdef KBD jsr LF47D .else jsr JMPADRS .endif jmp CHKNUM ; ---------------------------------------------------------------------------- OR: ldy #$FF .byte $2C ; ---------------------------------------------------------------------------- TAND: ldy #$00 sty EOLPNTR jsr AYINT lda FAC_LAST-1 eor EOLPNTR sta CHARAC lda FAC_LAST eor EOLPNTR sta ENDCHR jsr COPY_ARG_TO_FAC jsr AYINT lda FAC_LAST eor EOLPNTR and ENDCHR eor EOLPNTR tay lda FAC_LAST-1 eor EOLPNTR and CHARAC eor EOLPNTR jmp GIVAYF ; ---------------------------------------------------------------------------- ; PERFORM RELATIONAL OPERATIONS ; ---------------------------------------------------------------------------- RELOPS: jsr CHKVAL bcs STRCMP lda ARGSIGN ora #$7F and ARG+1 sta ARG+1 lda #