.segment "CODE" ; ---------------------------------------------------------------------------- ; "FOR" STATEMENT ; ; FOR PUSHES 18 BYTES ON THE STACK: ; 2 -- TXTPTR ; 2 -- LINE NUMBER ; 5 -- INITIAL (CURRENT) FOR VARIABLE VALUE ; 1 -- STEP SIGN ; 5 -- STEP VALUE ; 2 -- ADDRESS OF FOR VARIABLE IN VARTAB ; 1 -- FOR TOKEN ($81) ; ---------------------------------------------------------------------------- FOR: lda #$80 sta SUBFLG jsr LET jsr GTFORPNT bne L2619 txa adc #FOR_STACK1 tax txs L2619: pla pla lda #FOR_STACK2 jsr CHKMEM jsr DATAN clc tya adc TXTPTR pha lda TXTPTR+1 adc #$00 pha lda CURLIN+1 pha lda CURLIN pha lda #TOKEN_TO jsr SYNCHR jsr CHKNUM jsr FRMNUM lda FACSIGN ora #$7F and FAC+1 sta FAC+1 lda #STEP sta INDEX sty INDEX+1 jmp FRM_STACK3 ; ---------------------------------------------------------------------------- ; "STEP" PHRASE OF "FOR" STATEMENT ; ---------------------------------------------------------------------------- STEP: lda #CON_ONE jsr LOAD_FAC_FROM_YA jsr CHRGOT cmp #TOKEN_STEP bne L2665 jsr CHRGET jsr FRMNUM L2665: jsr SIGN jsr FRM_STACK2 lda FORPNT+1 pha lda FORPNT pha lda #$81 pha ; ---------------------------------------------------------------------------- ; PERFORM NEXT STATEMENT ; ---------------------------------------------------------------------------- NEWSTT: jsr ISCNTC lda TXTPTR ldy TXTPTR+1 .ifdef CONFIG_2 cpy #>INPUTBUFFER .endif .ifdef CBM2 nop .endif .ifdef CONFIG_2 beq LC6D4 .else beq L2683 .endif sta OLDTEXT sty OLDTEXT+1 LC6D4: ldy #$00 L2683: lda (TXTPTR),y .ifndef CONFIG_11 beq LA5DC cmp #$3A beq NEWSTT2 SYNERR1: jmp SYNERR LA5DC: .else bne COLON .endif ldy #$02 lda (TXTPTR),y clc .ifdef CONFIG_2 jeq L2701 .else beq L2701 .endif iny lda (TXTPTR),y sta CURLIN iny lda (TXTPTR),y sta CURLIN+1 tya adc TXTPTR sta TXTPTR bcc NEWSTT2 inc TXTPTR+1 NEWSTT2: jsr CHRGET jsr EXECUTE_STATEMENT jmp NEWSTT ; ---------------------------------------------------------------------------- ; EXECUTE A STATEMENT ; ; (A) IS FIRST CHAR OF STATEMENT ; CARRY IS SET ; ---------------------------------------------------------------------------- EXECUTE_STATEMENT: .ifndef CONFIG_11A beq RET1 .ifndef APPLE sec .endif .else beq RET2 .endif EXECUTE_STATEMENT1: sbc #$80 .ifndef CONFIG_11 jcc LET .else bcc LET1 .endif cmp #NUM_TOKENS .ifdef CONFIG_2 bcs LC721 .else bcs SYNERR1 .endif asl a tay lda TOKEN_ADDRESS_TABLE+1,y pha lda TOKEN_ADDRESS_TABLE,y pha jmp CHRGET .ifdef CONFIG_11 LET1: jmp LET COLON: cmp #$3A beq NEWSTT2 SYNERR1: jmp SYNERR .endif .ifdef CONFIG_2 LC721: .ifdef KBD cmp #$45 .else cmp #$4B .endif bne SYNERR1 jsr CHRGET lda #TOKEN_TO jsr SYNCHR jmp GOTO .endif ; ---------------------------------------------------------------------------- ; "RESTORE" STATEMENT ; ---------------------------------------------------------------------------- RESTORE: sec lda TXTTAB sbc #$01 ldy TXTTAB+1 bcs SETDA dey SETDA: sta DATPTR sty DATPTR+1 RET2: rts .ifndef CONFIG_CBM_ALL ; ---------------------------------------------------------------------------- ; SEE IF CONTROL-C TYPED ; ---------------------------------------------------------------------------- ISCNTC: .endif .ifdef KBD jsr LE8F3 bcc RET1 LE633: jsr LDE7F beq STOP cmp #$03 bne LE633 .endif .ifdef OSI jmp MONISCNTC nop nop nop nop lsr a bcc RET2 jsr GETLN cmp #$03 .endif .ifdef APPLE lda $C000 cmp #$83 beq L0ECC rts L0ECC: jsr RDKEY cmp #$03 .endif .ifdef KIM lda #$01 bit $1740 bmi RET2 ldx #$08 lda #$03 clc cmp #$03 .endif ; ---------------------------------------------------------------------------- ; "STOP" STATEMENT ; ---------------------------------------------------------------------------- STOP: bcs END2 ; ---------------------------------------------------------------------------- ; "END" STATEMENT ; ---------------------------------------------------------------------------- END: clc END2: bne RET1 lda TXTPTR ldy TXTPTR+1 .ifdef CONFIG_2 ldx CURLIN+1 inx .endif beq END4 sta OLDTEXT sty OLDTEXT+1 CONTROL_C_TYPED: lda CURLIN ldy CURLIN+1 sta OLDLIN sty OLDLIN+1 END4: pla pla L2701: lda #QT_BREAK .ifndef KBD ldx #$00 stx Z14 .endif bcc L270E jmp PRINT_ERROR_LINNUM L270E: jmp RESTART .ifdef KBD LE664: tay jmp SNGFLT .endif ; ---------------------------------------------------------------------------- ; "CONT" COMMAND ; ---------------------------------------------------------------------------- CONT: bne RET1 ldx #ERR_CANTCONT ldy OLDTEXT+1 bne L271C jmp ERROR L271C: lda OLDTEXT sta TXTPTR sty TXTPTR+1 lda OLDLIN ldy OLDLIN+1 sta CURLIN sty CURLIN+1 RET1: rts .ifdef KBD PRT: jsr GETBYT txa ror a ror a ror a sta $8F rts LE68C: ldy #$12 LE68E: lda LEA30,y sta $03A2,y dey bpl LE68E rts .endif .if .def(CONFIG_NULL) || .def(CBM1) ; CBM1 has the keyword removed, ; but the code is still here NULL: jsr GETBYT bne RET1 inx cpx #NULL_MAX bcs L2739 dex stx Z15 rts L2739: jmp IQERR .endif .ifndef CONFIG_11A CLEAR: bne RET1 jmp CLEARC .endif .ifdef APPLE .include "apple_loadsave.s" .endif .ifdef KIM .include "kim_loadsave.s" .endif ; ---------------------------------------------------------------------------- ; "RUN" COMMAND ; ---------------------------------------------------------------------------- RUN: bne L27CF jmp SETPTRS L27CF: jsr CLEARC jmp L27E9 ; ---------------------------------------------------------------------------- ; "GOSUB" STATEMENT ; ; LEAVES 7 BYTES ON STACK: ; 2 -- RETURN ADDRESS (NEWSTT) ; 2 -- TXTPTR ; 2 -- LINE # ; 1 -- GOSUB TOKEN ; ---------------------------------------------------------------------------- GOSUB: lda #$03 jsr CHKMEM lda TXTPTR+1 pha lda TXTPTR pha lda CURLIN+1 pha lda CURLIN pha lda #TOKEN_GOSUB pha L27E9: jsr CHRGOT jsr GOTO jmp NEWSTT ; ---------------------------------------------------------------------------- ; "GOTO" STATEMENT ; ALSO USED BY "RUN" AND "GOSUB" ; ---------------------------------------------------------------------------- GOTO: jsr LINGET jsr REMN lda CURLIN+1 cmp LINNUM+1 bcs L2809 tya sec adc TXTPTR ldx TXTPTR+1 bcc L280D inx bcs L280D L2809: lda TXTTAB ldx TXTTAB+1 L280D: .ifdef KBD jsr LF457 bne UNDERR .else jsr FL1 bcc UNDERR .endif lda LOWTRX sbc #$01 sta TXTPTR lda LOWTRX+1 sbc #$00 sta TXTPTR+1 L281E: rts ; ---------------------------------------------------------------------------- ; "POP" AND "RETURN" STATEMENTS ; ---------------------------------------------------------------------------- POP: bne L281E lda #$FF .ifdef CONFIG_2 sta FORPNT+1 ; bugfix, wrong in AppleSoft .else sta FORPNT .endif jsr GTFORPNT txs cmp #TOKEN_GOSUB beq RETURN ldx #ERR_NOGOSUB .byte $2C UNDERR: ldx #ERR_UNDEFSTAT jmp ERROR ; ---------------------------------------------------------------------------- SYNERR2: jmp SYNERR ; ---------------------------------------------------------------------------- RETURN: pla pla sta CURLIN pla sta CURLIN+1 pla sta TXTPTR pla sta TXTPTR+1 ; ---------------------------------------------------------------------------- ; "DATA" STATEMENT ; EXECUTED BY SKIPPING TO NEXT COLON OR EOL ; ---------------------------------------------------------------------------- DATA: jsr DATAN ; ---------------------------------------------------------------------------- ; ADD (Y) TO TXTPTR ; ---------------------------------------------------------------------------- ADDON: tya clc adc TXTPTR sta TXTPTR bcc L2852 inc TXTPTR+1 L2852: rts ; ---------------------------------------------------------------------------- ; SCAN AHEAD TO NEXT ":" OR EOL ; ---------------------------------------------------------------------------- DATAN: ldx #$3A .byte $2C REMN: ldx #$00 stx CHARAC ldy #$00 sty ENDCHR L285E: lda ENDCHR ldx CHARAC sta CHARAC stx ENDCHR L2866: lda (TXTPTR),y beq L2852 cmp ENDCHR beq L2852 iny cmp #$22 .ifndef CONFIG_11 beq L285E bne L2866 .else bne L2866 beq L285E .endif ; ---------------------------------------------------------------------------- ; "IF" STATEMENT ; ---------------------------------------------------------------------------- IF: jsr FRMEVL jsr CHRGOT cmp #TOKEN_GOTO beq L2884 lda #TOKEN_THEN jsr SYNCHR L2884: lda FAC bne L288D ; ---------------------------------------------------------------------------- ; "REM" STATEMENT, OR FALSE "IF" STATEMENT ; ---------------------------------------------------------------------------- REM: jsr REMN beq ADDON L288D: jsr CHRGOT bcs L2895 jmp GOTO L2895: jmp EXECUTE_STATEMENT ; ---------------------------------------------------------------------------- ; "ON" STATEMENT ; ; ON GOTO ; ON GOSUB ; ---------------------------------------------------------------------------- ON: jsr GETBYT pha cmp #TOKEN_GOSUB beq L28A4 L28A0: cmp #TOKEN_GOTO bne SYNERR2 L28A4: dec FAC_LAST bne L28AC pla jmp EXECUTE_STATEMENT1 L28AC: jsr CHRGET jsr LINGET cmp #$2C beq L28A4 pla L28B7: rts