; Microsoft BASIC for 6502 .debuginfo + .if .def(cbmbasic1) CBM1 := 1 .include "defines_cbm.s" .elseif .def(osi) OSI := 1 .include "defines_osi.s" .elseif .def(applesoft) APPLE := 1 .include "defines_apple.s" .elseif .def(kb9) KIM := 1 .include "defines_kim.s" .elseif .def(cbmbasic2) CBM2 := 1 .include "defines_cbm.s" .elseif .def(kbdbasic) KBD := 1 .include "defines_kbd.s" .endif .ifdef CONFIG_SMALL BYTES_FP := 4 .else BYTES_FP := 5 .endif .ifdef APPLE BYTES_PER_ELEMENT := 6 ; ??? .else BYTES_PER_ELEMENT := BYTES_FP .endif BYTES_PER_VARIABLE := BYTES_FP+2 MANTISSA_BYTES := BYTES_FP-1 BYTES_PER_FRAME := 2*BYTES_FP+8 FOR_STACK1 := 2*BYTES_FP+5 FOR_STACK2 := BYTES_FP+4 .ifdef CBM1 MAX_EXPON = 12 .else MAX_EXPON = 10 .endif .include "macros.s" .include "zeropage.s" .setcpu "6502" .macpack longbranch STACK := $0100 .segment "HEADER" .ifdef KBD jmp LE68C .byte $00,$13,$56 .endif .include "token.s" .include "error.s" .segment "CODE" QT_ERROR: .ifdef KBD .byte " err" .else .ifdef APPLE .byte " ERR" .byte $07,$07 .else .byte " ERROR" .endif .endif .byte $00 .ifndef KBD QT_IN: .byte " IN " .byte $00 QT_OK: .ifdef APPLE .byte $0D,$00,$00 .byte "K" .else .byte $0D,$0A .ifdef CONFIG_CBM_ALL .byte "READY." .else .byte "OK" .endif .endif .byte $0D,$0A,$00 .else .byte $54,$D2 ; ??? OKPRT: jsr LDE42 .byte $0D,$0D .byte ">>" .byte $0D,$0A,$00 rts nop .endif QT_BREAK: .ifdef KBD .byte $0D,$0A .byte " Brk" .byte $00 .byte $54,$D0 ; ??? .else .byte $0D,$0A .byte "BREAK" .byte $00 .endif ; ---------------------------------------------------------------------------- ; CALLED BY "NEXT" AND "FOR" TO SCAN THROUGH ; THE STACK FOR A FRAME WITH THE SAME VARIABLE. ; ; (FORPNT) = ADDRESS OF VARIABLE IF "FOR" OR "NEXT" ; = $XXFF IF CALLED FROM "RETURN" ; <<< BUG: SHOULD BE $FFXX >>> ; ; RETURNS .NE. IF VARIABLE NOT FOUND, ; (X) = STACK PNTR AFTER SKIPPING ALL FRAMES ; ; .EQ. IF FOUND ; (X) = STACK PNTR OF FRAME FOUND ; ---------------------------------------------------------------------------- GTFORPNT: tsx inx inx inx inx L2279: lda STACK+1,x cmp #$81 bne L22A1 lda FORPNT+1 bne L228E lda STACK+2,x sta FORPNT lda STACK+3,x sta FORPNT+1 L228E: cmp STACK+3,x bne L229A lda FORPNT cmp STACK+2,x beq L22A1 L229A: txa clc adc #BYTES_PER_FRAME tax bne L2279 L22A1: rts ; ---------------------------------------------------------------------------- ; MOVE BLOCK OF MEMORY UP ; ; ON ENTRY: ; (Y,A) = (HIGHDS) = DESTINATION END+1 ; (LOWTR) = LOWEST ADDRESS OF SOURCE ; (HIGHTR) = HIGHEST SOURCE ADDRESS+1 ; ---------------------------------------------------------------------------- BLTU: jsr REASON sta STREND sty STREND+1 BLTU2: sec lda HIGHTR sbc LOWTR sta INDEX tay lda HIGHTR+1 sbc LOWTR+1 tax inx tya beq L22DD lda HIGHTR sec sbc INDEX sta HIGHTR bcs L22C6 dec HIGHTR+1 sec L22C6: lda HIGHDS sbc INDEX sta HIGHDS bcs L22D6 dec HIGHDS+1 bcc L22D6 L22D2: lda (HIGHTR),y sta (HIGHDS),y L22D6: dey bne L22D2 lda (HIGHTR),y sta (HIGHDS),y L22DD: dec HIGHTR+1 dec HIGHDS+1 dex bne L22D6 rts ; ---------------------------------------------------------------------------- ; CHECK IF ENOUGH ROOM LEFT ON STACK ; FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION ; ---------------------------------------------------------------------------- CHKMEM: asl a adc #SPACE_FOR_GOSUB bcs MEMERR sta INDEX tsx cpx INDEX bcc MEMERR rts ; ---------------------------------------------------------------------------- ; CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS ; (Y,A) = ADDR ARRAYS NEED TO GROW TO ; ---------------------------------------------------------------------------- REASON: cpy FRETOP+1 bcc L231E bne L22FC cmp FRETOP bcc L231E L22FC: pha ldx #FAC-TEMP1-1 tya L2300: pha lda TEMP1,x dex bpl L2300 jsr GARBAG ldx #TEMP1-FAC+1 L230B: pla sta FAC,x inx bmi L230B pla tay pla cpy FRETOP+1 bcc L231E bne MEMERR cmp FRETOP bcs MEMERR L231E: rts ; ---------------------------------------------------------------------------- MEMERR: ldx #ERR_MEMFULL ; ---------------------------------------------------------------------------- ; HANDLE AN ERROR ; ; (X)=OFFSET IN ERROR MESSAGE TABLE ; (ERRFLG) > 128 IF "ON ERR" TURNED ON ; (CURLIN+1) = $FF IF IN DIRECT MODE ; ---------------------------------------------------------------------------- ERROR: lsr Z14 .ifdef CONFIG_CBM_ALL lda Z03 ; output beq LC366 ; is screen jsr CLRCH ; otherwise redirect output back to screen lda #$00 sta Z03 LC366: .endif jsr CRDO jsr OUTQUES L2329: lda ERROR_MESSAGES,x .ifndef CONFIG_SMALL pha and #$7F .endif jsr OUTDO .ifdef CONFIG_SMALL lda ERROR_MESSAGES+1,x .ifdef KBD and #$7F .endif jsr OUTDO .else inx pla bpl L2329 .endif jsr STKINI lda #QT_ERROR ; ---------------------------------------------------------------------------- ; PRINT STRING AT (Y,A) ; PRINT CURRENT LINE # UNLESS IN DIRECT MODE ; FALL INTO WARM RESTART ; ---------------------------------------------------------------------------- PRINT_ERROR_LINNUM: jsr STROUT ldy CURLIN+1 iny beq RESTART jsr INPRT ; ---------------------------------------------------------------------------- ; WARM RESTART ENTRY ; ; COME HERE FROM MONITOR BY CTL-C, 0G, 3D0G, OR E003G ; ---------------------------------------------------------------------------- RESTART: .ifdef KBD jsr CRDO nop L2351X: jsr OKPRT L2351: jsr LFDDA LE28E: bpl RESTART .else lsr Z14 lda #QT_OK .ifdef CONFIG_CBM_ALL jsr STROUT .else jsr GOWARM .endif L2351: jsr INLIN .endif stx TXTPTR sty TXTPTR+1 jsr CHRGET .ifdef CONFIG_11 tax .endif .ifdef KBD beq L2351X .else beq L2351 .endif ldx #$FF stx CURLIN+1 bcc NUMBERED_LINE jsr PARSE_INPUT_LINE jmp NEWSTT2 ; ---------------------------------------------------------------------------- ; HANDLE NUMBERED LINE ; ---------------------------------------------------------------------------- NUMBERED_LINE: jsr LINGET jsr PARSE_INPUT_LINE sty EOLPNTR .ifdef KBD jsr LFD3E lda JMPADRS+1 sta LOWTR sta $96 lda JMPADRS+2 sta LOWTR+1 sta $97 lda $13 sta $06FE lda $14 sta $06FF inc $13 bne LE2D2 inc $14 bne LE2D2 jmp SYNERR LE2D2: jsr LF457 ldx #$96 jsr LE4D4 bcs LE2FD LE2DC: ldx #$00 lda (JMPADRS+1,x) sta ($96,x) inc JMPADRS+1 bne LE2E8 inc JMPADRS+2 LE2E8: inc $96 bne LE2EE inc $97 LE2EE: ldx #$2B jsr LE4D4 bne LE2DC lda $96 sta VARTAB lda $97 sta VARTAB+1 LE2FD: jsr SETPTRS jsr LE33D lda Z00 LE306: beq LE28E cmp #$A5 beq LE306 clc .else jsr FNDLIN bcc PUT_NEW_LINE ldy #$01 lda (LOWTR),y sta INDEX+1 lda VARTAB sta INDEX lda LOWTR+1 sta DEST+1 lda LOWTR dey sbc (LOWTR),y clc adc VARTAB sta VARTAB sta DEST lda VARTAB+1 adc #$FF sta VARTAB+1 sbc LOWTR+1 tax sec lda LOWTR sbc VARTAB tay bcs L23A5 inx dec DEST+1 L23A5: clc adc INDEX bcc L23AD dec INDEX+1 clc L23AD: lda (INDEX),y sta (DEST),y iny bne L23AD inc INDEX+1 inc DEST+1 dex bne L23AD .endif ; ---------------------------------------------------------------------------- PUT_NEW_LINE: .ifdef CBM2 jsr SETPTRS jsr LE33D lda INPUTBUFFER beq L2351 clc .else .ifndef KBD lda INPUTBUFFER beq FIX_LINKS lda MEMSIZ ldy MEMSIZ+1 sta FRETOP sty FRETOP+1 .endif .endif lda VARTAB sta HIGHTR adc EOLPNTR sta HIGHDS ldy VARTAB+1 sty HIGHTR+1 bcc L23D6 iny L23D6: sty HIGHDS+1 jsr BLTU .ifdef CBM2_APPLE lda LINNUM ldy LINNUM+1 sta INPUTBUFFER-2 sty INPUTBUFFER-1 .endif lda STREND ldy STREND+1 sta VARTAB sty VARTAB+1 ldy EOLPNTR dey ; ---COPY LINE INTO PROGRAM------- L23E6: lda INPUTBUFFER-4,y sta (LOWTR),y dey bpl L23E6 ; ---------------------------------------------------------------------------- ; CLEAR ALL VARIABLES ; RE-ESTABLISH ALL FORWARD LINKS ; ---------------------------------------------------------------------------- FIX_LINKS: jsr SETPTRS .ifdef CBM2_KBD jsr LE33D jmp L2351 LE33D: .endif lda TXTTAB ldy TXTTAB+1 sta INDEX sty INDEX+1 clc L23FA: ldy #$01 lda (INDEX),y .ifdef CBM2_KBD beq RET3 .else bne L2403 jmp L2351 .endif L2403: ldy #$04 L2405: iny lda (INDEX),y bne L2405 iny tya adc INDEX tax ldy #$00 sta (INDEX),y lda INDEX+1 adc #$00 iny sta (INDEX),y stx INDEX sta INDEX+1 bcc L23FA .ifdef KBD SLOD: ldx #$01 .byte $2C PLOD: ldx #$00 ldy CURLIN+1 iny sty JMPADRS jsr LFFD3 jsr LF422 ldx #$02 jsr LFF64 ldx #$6F ldy #$00 jsr LE39A jsr LE33D jmp CLEARC .byte $FF .byte $FF .byte $FF VER: lda #$13 ldx FAC beq LE397 lda $DFF9 LE397: jmp FLOAT LE39A: lda VARTAB,x clc adc $051B,y sta VARTAB,y lda VARTAB+1,x adc $051C,y sta VARTAB+1,y RET3: rts .else ; ---------------------------------------------------------------------------- ; READ A LINE, AND STRIP OFF SIGN BITS ; ---------------------------------------------------------------------------- .ifdef APPLE INLIN: ldx #$DD INLIN1: stx $33 jsr L2900 cpx #$EF bcs L0C32 ldx #$EF L0C32: lda #$00 sta INPUTBUFFER,x ldx #INPUTBUFFER-1 rts RDKEY: jsr LFD0C and #$7F .else .ifdef CBM2 RET3: rts .else L2420: .ifdef OSI jsr OUTDO .endif dex bpl INLIN2 L2423: .ifdef OSI jsr OUTDO .endif jsr CRDO .endif INLIN: ldx #$00 INLIN2: jsr GETLN .ifndef CONFIG_CBM_ALL cmp #$07 beq L2443 .endif cmp #$0D beq L2453 .ifndef CONFIG_CBM_ALL cmp #$20 ; line editing bcc INLIN2 cmp #$7D bcs INLIN2 cmp #$40 ; @ beq L2423 cmp #$5F ; _ beq L2420 L2443: cpx #$47 bcs L244C .endif sta INPUTBUFFER,x inx .ifdef OSI .byte $2C .else bne INLIN2 .endif L244C: .ifndef CONFIG_CBM_ALL lda #$07 jsr OUTDO bne INLIN2 .endif L2453: jmp L29B9 GETLN: .ifdef CONFIG_CBM_ALL jsr CHRIN ldy Z03 bne L2465 .else jsr MONRDKEY .endif .ifdef OSI nop nop nop nop nop nop nop nop nop nop nop nop nop nop and #$7F .endif .endif cmp #$0F bne L2465 pha lda Z14 eor #$FF sta Z14 pla L2465: rts .endif /* KBD */ ; ---------------------------------------------------------------------------- ; TOKENIZE THE INPUT LINE ; ---------------------------------------------------------------------------- PARSE_INPUT_LINE: ldx TXTPTR ldy #$04 sty DATAFLG L246C: lda INPUTBUFFERX,x .ifdef CONFIG_CBM_ALL bpl LC49E cmp #$FF beq L24AC inx bne L246C LC49E: .endif cmp #$20 beq L24AC sta ENDCHR cmp #$22 beq L24D0 bit DATAFLG bvs L24AC cmp #$3F bne L2484 lda #TOKEN_PRINT bne L24AC L2484: cmp #$30 bcc L248C cmp #$3C bcc L24AC ; ---------------------------------------------------------------------------- ; SEARCH TOKEN NAME TABLE FOR MATCH STARTING ; WITH CURRENT CHAR FROM INPUT LINE ; ---------------------------------------------------------------------------- L248C: sty STRNG2 ldy #$00 sty EOLPNTR dey stx TXTPTR dex L2496: iny L2497: inx L2498: .ifdef KBD jsr LF42D .else lda INPUTBUFFERX,x .ifndef CBM2 cmp #$20 beq L2497 .endif .endif sec sbc TOKEN_NAME_TABLE,y beq L2496 cmp #$80 bne L24D7 ora EOLPNTR ; ---------------------------------------------------------------------------- ; STORE CHARACTER OR TOKEN IN OUTPUT LINE ; ---------------------------------------------------------------------------- L24AA: ldy STRNG2 L24AC: inx iny sta INPUTBUFFER-5,y lda INPUTBUFFER-5,y beq L24EA sec sbc #$3A beq L24BF cmp #$49 bne L24C1 L24BF: sta DATAFLG L24C1: sec sbc #TOKEN_REM-':' bne L246C sta ENDCHR ; ---------------------------------------------------------------------------- ; HANDLE LITERAL (BETWEEN QUOTES) OR REMARK, ; BY COPYING CHARS UP TO ENDCHR. ; ---------------------------------------------------------------------------- L24C8: lda INPUTBUFFERX,x beq L24AC cmp ENDCHR beq L24AC L24D0: iny sta INPUTBUFFER-5,y inx bne L24C8 ; ---------------------------------------------------------------------------- ; ADVANCE POINTER TO NEXT TOKEN NAME ; ---------------------------------------------------------------------------- L24D7: ldx TXTPTR inc EOLPNTR L24DB: iny lda MATHTBL+28+1,y bpl L24DB lda TOKEN_NAME_TABLE,y bne L2498 lda INPUTBUFFERX,x bpl L24AA ; ---END OF LINE------------------ L24EA: sta INPUTBUFFER-3,y .if INPUTBUFFER >= $0100 dec TXTPTR+1 .endif lda #CONST_MEMSIZ .else lda MEMSIZ ldy MEMSIZ+1 .endif sta FRETOP sty FRETOP+1 .ifdef CONFIG_CBM_ALL jsr CLALL .endif lda VARTAB ldy VARTAB+1 sta ARYTAB sty ARYTAB+1 sta STREND sty STREND+1 jsr RESTORE ; ---------------------------------------------------------------------------- STKINI: ldx #TEMPST stx TEMPPT pla .ifdef CBM2_KBD tay .else .ifdef APPLE sta STACK+249 .else sta STACK+253 .endif .endif pla .ifndef CBM2_KBD .ifdef APPLE sta STACK+250 .else sta STACK+254 .endif .endif ldx #STACK_TOP txs .ifdef CBM2_KBD pha tya pha .endif lda #$00 sta OLDTEXT+1 sta SUBFLG L256A: rts ; ---------------------------------------------------------------------------- ; SET TXTPTR TO BEGINNING OF PROGRAM ; ---------------------------------------------------------------------------- STXTPT: clc lda TXTTAB adc #$FF sta TXTPTR lda TXTTAB+1 adc #$FF sta TXTPTR+1 rts .ifdef KBD LE4C0: ldy #LE444 LE4C4: jsr LFFD6 jsr LFFED lda $0504 clc adc #$08 sta $0504 rts LE4D4: lda $01,x cmp JMPADRS+2 bne LE4DE lda $00,x cmp JMPADRS+1 LE4DE: rts ; ---------------------------------------------------------------------------- ; "LIST" STATEMENT ; ---------------------------------------------------------------------------- LIST: jsr LE440 bne LE4DE pla pla L25A6: jsr CRDO .else LIST: bcc L2581 beq L2581 cmp #TOKEN_MINUS bne L256A L2581: jsr LINGET jsr FNDLIN jsr CHRGOT beq L2598 cmp #TOKEN_MINUS bne L2520 jsr CHRGET jsr LINGET bne L2520 L2598: pla pla lda LINNUM ora LINNUM+1 bne L25A6 lda #$FF sta LINNUM sta LINNUM+1 L25A6: .endif ldy #$01 .ifdef CONFIG_DATAFLAG sty DATAFLG .endif lda (LOWTRX),y beq L25E5 jsr ISCNTC .ifndef KBD jsr CRDO .endif iny lda (LOWTRX),y tax iny lda (LOWTRX),y cmp LINNUM+1 bne L25C1 cpx LINNUM beq L25C3 L25C1: bcs L25E5 ; ---LIST ONE LINE---------------- L25C3: sty FORPNT jsr LINPRT lda #$20 L25CA: ldy FORPNT and #$7F L25CE: jsr OUTDO .ifdef CONFIG_DATAFLAG cmp #$22 bne LA519 lda DATAFLG eor #$FF sta DATAFLG LA519: .endif iny .ifdef CONFIG_11 beq L25E5 .endif lda (LOWTRX),y bne L25E8 tay lda (LOWTRX),y tax iny lda (LOWTRX),y stx LOWTRX sta LOWTRX+1 bne L25A6 L25E5: jmp RESTART L25E8: bpl L25CE .ifdef CONFIG_DATAFLAG cmp #$FF beq L25CE bit DATAFLG bmi L25CE .endif sec sbc #$7F tax sty FORPNT ldy #$FF L25F2: dex beq L25FD L25F5: iny lda TOKEN_NAME_TABLE,y bpl L25F5 bmi L25F2 L25FD: iny lda TOKEN_NAME_TABLE,y bmi L25CA jsr OUTDO bne L25FD ; ---------------------------------------------------------------------------- ; "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 CBM2_KBD cpy #>INPUTBUFFER .endif .ifdef CBM2 nop .endif .ifdef CBM2_KBD 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 CBM2_KBD 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_11_NOAPPLE 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 CBM2_KBD 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 CBM2_KBD 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 CBM2_KBD 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_11_NOAPPLE CLEAR: bne RET1 jmp CLEARC .endif .ifdef APPLE SAVE: jsr L0F42 jsr LFECD jsr L0F51 jmp LFECD LOAD: jsr L0F42 jsr LFEFD jsr L0F51 jsr LFEFD lda #QT_LOADED jsr STROUT jmp FIX_LINKS QT_LOADED: .byte 0 ; XXX PATCHED .byte "OADED" .byte 0 L0F42: lda #$6C ldy #$00 sta $3C sty $3D lda #$6E sta $3E sty $3F rts L0F51: lda $6A ldy $6B sta $3C sty $3D lda $6C ldy $6D sta $3E sty $3F rts .endif .ifdef KIM SAVE: tsx stx INPUTFLG lda #$37 sta $F2 lda #$FE sta $17F9 lda TXTTAB ldy TXTTAB+1 sta $17F5 sty $17F6 lda VARTAB ldy VARTAB+1 sta $17F7 sty $17F8 jmp L1800 ldx INPUTFLG txs lda #QT_SAVED jmp STROUT QT_LOADED: .byte "LOADED" .byte $00 QT_SAVED: .byte "SAVED" .byte $0D,$0A,$00,$00,$00,$00,$00,$00 .byte $00,$00,$00,$00,$00,$00,$00,$00 .byte $00,$00,$00,$00,$00,$00,$00 LOAD: lda TXTTAB ldy TXTTAB+1 sta $17F5 sty $17F6 lda #$FF sta $17F9 lda #$A6 ldy #$27 ; XXX sta L0001 sty L0001+1 jmp L1873 ldx #$FF txs lda #$48 ldy #$23 ; XXX sta L0001 sty L0001+1 lda #QT_LOADED jsr STROUT ldx $17ED ldy $17EE txa bne L27C2 nop L27C2: nop stx VARTAB sty VARTAB+1 jmp FIX_LINKS .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 CBM2_KBD 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 ; ---------------------------------------------------------------------------- ; CONVERT LINE NUMBER ; ---------------------------------------------------------------------------- LINGET: ldx #$00 stx LINNUM stx LINNUM+1 L28BE: bcs L28B7 sbc #$2F sta CHARAC lda LINNUM+1 sta INDEX cmp #$19 bcs L28A0 ; <<<<>>>> ; NOTE THAT IF (A) = $AB ON THE LINE ABOVE, ; ON.1 WILL COMPARE = AND CAUSE A CATASTROPHIC ; JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS ; FOR OTHER CALLS TO LINGET. ; ; YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9, ; THEN TYPE "GO TO 437761". ; ; ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE ; THE PROBLEM. ($AB00 - $ABFF) ; <<<<>>>> lda LINNUM asl a rol INDEX asl a rol INDEX adc LINNUM sta LINNUM lda INDEX adc LINNUM+1 sta LINNUM+1 asl LINNUM rol LINNUM+1 lda LINNUM adc CHARAC sta LINNUM bcc L28EC inc LINNUM+1 L28EC: jsr CHRGET jmp L28BE ; ---------------------------------------------------------------------------- ; "LET" STATEMENT ; ; LET = ; = ; ---------------------------------------------------------------------------- LET: jsr PTRGET sta FORPNT sty FORPNT+1 lda #TOKEN_EQUAL jsr SYNCHR .ifndef CONFIG_SMALL lda VALTYP+1 pha .endif lda VALTYP pha jsr FRMEVL pla rol a jsr CHKVAL bne LETSTRING .ifndef CONFIG_SMALL pla LET2: bpl L2923 jsr ROUND_FAC jsr AYINT ldy #$00 lda FAC+3 sta (FORPNT),y iny lda FAC+4 sta (FORPNT),y rts L2923: .endif ; ---------------------------------------------------------------------------- ; REAL VARIABLE = EXPRESSION ; ---------------------------------------------------------------------------- jmp SETFOR LETSTRING: .ifndef CONFIG_SMALL pla ; ---------------------------------------------------------------------------- ; INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4 ; ---------------------------------------------------------------------------- PUTSTR: .endif .ifdef CONFIG_CBM_ALL ldy FORPNT+1 .ifdef CBM1 cpy #$D0 .else cpy #$DE .endif bne LC92B jsr FREFAC cmp #$06 .ifdef CBM2_KBD bne IQERR1 .else beq LC8E2 jmp IQERR LC8E2: .endif ldy #$00 sty FAC sty FACSIGN LC8E8: sty STRNG2 jsr LC91C jsr MUL10 inc STRNG2 ldy STRNG2 jsr LC91C jsr COPY_FAC_TO_ARG_ROUNDED tax beq LC902 inx txa jsr LD9BF LC902: ldy STRNG2 iny cpy #$06 bne LC8E8 jsr MUL10 jsr QINT ldx #$02 sei LC912: lda FAC+2,x .ifdef CBM2 sta $8D,x .else sta $0200,x .endif dex bpl LC912 cli rts LC91C: lda (INDEX),y jsr L00CF bcc LC926 IQERR1: jmp IQERR LC926: sbc #$2F jmp ADDACC LC92B: .endif ldy #$02 lda (FAC_LAST-1),y cmp FRETOP+1 bcc L2946 bne L2938 dey lda (FAC_LAST-1),y cmp FRETOP bcc L2946 L2938: ldy FAC_LAST cpy VARTAB+1 bcc L2946 bne L294D lda FAC_LAST-1 cmp VARTAB bcs L294D L2946: lda FAC_LAST-1 ldy FAC_LAST jmp L2963 L294D: ldy #$00 lda (FAC_LAST-1),y jsr STRINI lda DSCPTR ldy DSCPTR+1 sta STRNG1 sty STRNG1+1 jsr MOVINS lda #FAC ldy #$00 L2963: sta DSCPTR sty DSCPTR+1 jsr FRETMS ldy #$00 lda (DSCPTR),y sta (FORPNT),y iny lda (DSCPTR),y sta (FORPNT),y iny lda (DSCPTR),y sta (FORPNT),y rts .ifdef CONFIG_CBM_ALL PRINTH: jsr CMD jmp LCAD6 CMD: jsr GETBYT beq LC98F lda #$2C jsr SYNCHR LC98F: php jsr CHKOUT stx Z03 plp jmp PRINT .endif ; ---------------------------------------------------------------------------- PRSTRING: jsr STRPRT L297E: jsr CHRGOT ; ---------------------------------------------------------------------------- ; "PRINT" STATEMENT ; ---------------------------------------------------------------------------- PRINT: beq CRDO PRINT2: beq L29DD cmp #TOKEN_TAB beq L29F5 cmp #TOKEN_SPC .ifdef CBM2_KBD clc .endif beq L29F5 cmp #',' .ifdef KIM clc .endif beq L29DE cmp #$3B beq L2A0D jsr FRMEVL bit VALTYP bmi PRSTRING jsr FOUT jsr STRLIT .ifndef CONFIG_CBM_ALL ldy #$00 lda (FAC_LAST-1),y clc adc Z16 .ifdef KBD cmp #$28 .else cmp Z17 .endif bcc L29B1 jsr CRDO L29B1: .endif jsr STRPRT .ifdef KBD jmp L297E LE86C: pla jmp CONTROL_C_TYPED LE870: jsr GETBYT txa LE874: beq LE878 bpl LE8F2 LE878: jmp IQERR CRDO: lda #$0A sta $10 jsr OUTDO LE882: lda #$0D jsr OUTDO PRINTNULLS: lda #$00 sta $10 eor #$FF .else jsr OUTSP bne L297E L29B9: .ifdef CBM2 lda #$00 sta INPUTBUFFER,x ldx #<(INPUTBUFFER-1) ldy #>(INPUTBUFFER-1) .else .ifndef APPLE ldy #$00 sty INPUTBUFFER,x ldx #LINNUM+1 .endif .endif .ifdef CONFIG_CBM_ALL lda Z03 bne L29DD LC9D2: .endif CRDO: .ifdef CBM1 lda Z03 bne LC9D8 sta $05 LC9D8: .endif lda #$0D .ifndef CONFIG_CBM_ALL sta Z16 .endif jsr OUTDO .ifdef APPLE lda #$80 .else lda #$0A .endif jsr OUTDO PRINTNULLS: .ifdef CBM1 lda Z03 bne L29DD .endif .if .def(CONFIG_NULL) || .def(CBM1) txa pha ldx Z15 beq L29D9 lda #$00 L29D3: jsr OUTDO dex bne L29D3 L29D9: stx Z16 pla tax .else .ifdef APPLE lda #$00 sta $50 .endif eor #$FF .endif .endif L29DD: rts L29DE: lda Z16 .ifndef CONFIG_CBM_ALL .ifdef KBD cmp #$1A .else cmp Z18 .endif bcc L29EA jsr CRDO jmp L2A0D L29EA: .endif sec L29EB: .ifdef CONFIG_CBM_ALL sbc #$0A .else .ifdef KBD sbc #$0D .else sbc #$0E .endif .endif bcs L29EB eor #$FF adc #$01 bne L2A08 L29F5: .ifdef CONFIG_11_NOAPPLE php .else pha .endif jsr GTBYTC cmp #$29 .ifndef CONFIG_11_NOAPPLE .ifdef APPLE beq L1185 jmp SYNERR L1185: .else bne SYNERR4 .endif pla cmp #TOKEN_TAB .ifdef APPLE bne L2A09 .else bne L2A0A .endif .else .ifdef CBM2_KBD bne SYNERR4 .else beq @1 jmp SYNERR @1: .endif plp ;; XXX c64 has this bcc L2A09 .endif txa sbc Z16 bcc L2A0D .ifndef CONFIG_11 beq L2A0D .endif L2A08: tax .ifdef CONFIG_11 L2A09: inx .endif L2A0A: .ifndef CONFIG_11 jsr OUTSP .endif dex .ifndef CONFIG_11 bne L2A0A .else bne L2A13 .endif L2A0D: jsr CHRGET jmp PRINT2 .ifdef CONFIG_11 L2A13: jsr OUTSP bne L2A0A .endif ; ---------------------------------------------------------------------------- ; PRINT STRING AT (Y,A) ; ---------------------------------------------------------------------------- STROUT: jsr STRLIT ; ---------------------------------------------------------------------------- ; PRINT STRING AT (FACMO,FACLO) ; ---------------------------------------------------------------------------- STRPRT: jsr FREFAC tax ldy #$00 inx L2A22: dex beq L29DD lda (INDEX),y jsr OUTDO iny cmp #$0D bne L2A22 jsr PRINTNULLS jmp L2A22 ; ---------------------------------------------------------------------------- OUTSP: .ifdef CBM2 lda $0E beq LCA40 lda #$20 .byte $2C LCA40: .endif .ifdef CONFIG_CBM_ALL lda #$1D .else lda #$20 .endif .byte $2C OUTQUES: lda #$3F ; ---------------------------------------------------------------------------- ; PRINT CHAR FROM (A) ; ---------------------------------------------------------------------------- OUTDO: .ifndef KBD bit Z14 bmi L2A56 .endif .ifndef CBM2_KBD pha .endif .ifdef CBM1 cmp #$1D beq LCA6A cmp #$9D beq LCA5A cmp #$14 bne LCA64 LCA5A: lda $05 beq L2A4E lda Z03 bne L2A4E dec $05 LCA64: and #$7F .endif .ifndef CBM2 cmp #$20 bcc L2A4E .endif LCA6A: .ifdef CONFIG_CBM1_PATCHES lda Z03 jsr PATCH6 nop .endif .ifdef CONFIG_PRINT_CR lda Z16 cmp Z17 bne L2A4C .ifdef APPLE nop ; PATCH! nop ; don't print CR nop .else jsr CRDO .endif L2A4C: .endif .ifndef CONFIG_CBM_ALL inc Z16 .endif L2A4E: .ifndef CBM2_KBD pla .endif .ifdef KIM sty DIMFLG .endif .ifdef APPLE ora #$80 .endif jsr MONCOUT .ifdef APPLE and #$7F .endif .ifdef KIM ldy DIMFLG .endif .ifdef OSI nop nop nop nop .endif L2A56: and #$FF LE8F2: rts .ifdef KBD LE8F3: pha lda $047F clc beq LE900 lda #$00 sta $047F sec LE900: pla rts .endif ; ---------------------------------------------------------------------------- ; INPUT CONVERSION ERROR: ILLEGAL CHARACTER ; IN NUMERIC FIELD. MUST DISTINGUISH ; BETWEEN INPUT, READ, AND GET ; ---------------------------------------------------------------------------- INPUTERR: lda INPUTFLG beq RESPERR .ifdef CBM2_KIM_APPLE bmi L2A63 ldy #$FF bne L2A67 L2A63: .endif .ifdef CONFIG_CBM1_PATCHES jsr PATCH5 nop .else lda Z8C ldy Z8C+1 .endif L2A67: sta CURLIN sty CURLIN+1 SYNERR4: jmp SYNERR RESPERR: .ifdef CONFIG_CBM_ALL lda Z03 beq LCA8F ldx #ERR_BADDATA jmp ERROR LCA8F: .endif lda #ERRREENTRY jsr STROUT lda OLDTEXT ldy OLDTEXT+1 sta TXTPTR sty TXTPTR+1 LE920: rts .ifndef CONFIG_SMALL ; ---------------------------------------------------------------------------- ; "GET" STATEMENT ; ---------------------------------------------------------------------------- GET: jsr ERRDIR .ifdef CONFIG_CBM_ALL cmp #$23 bne LCAB6 jsr CHRGET jsr GETBYT lda #$2C jsr SYNCHR jsr CHKIN stx Z03 LCAB6: .endif ldx #<(INPUTBUFFER+1) ldy #>(INPUTBUFFER+1) .if INPUTBUFFER >= $0100 lda #$00 sta INPUTBUFFER+1 .else sty INPUTBUFFER+1 .endif lda #$40 jsr PROCESS_INPUT_LIST .ifdef CONFIG_CBM_ALL ldx Z03 bne LCAD8 .endif rts .endif .ifdef CONFIG_CBM_ALL INPUTH: jsr GETBYT lda #$2C jsr SYNCHR jsr CHKIN stx Z03 jsr L2A9E LCAD6: lda Z03 LCAD8: jsr CLRCH ldx #$00 stx Z03 rts LCAE0: .endif ; ---------------------------------------------------------------------------- ; "INPUT" STATEMENT ; ---------------------------------------------------------------------------- INPUT: .ifndef KBD lsr Z14 .endif cmp #$22 bne L2A9E jsr STRTXT lda #$3B jsr SYNCHR jsr STRPRT L2A9E: jsr ERRDIR lda #$2C sta INPUTBUFFER-1 LCAF8: .ifdef APPLE jsr INLINX .else jsr NXIN .endif .ifdef KBD bmi L2ABE NXIN: jsr LFDDA bmi LE920 pla jmp LE86C .else .ifdef CONFIG_CBM_ALL lda Z03 beq LCB0C lda Z96 and #$02 beq LCB0C jsr LCAD6 jmp DATA LCB0C: .endif lda INPUTBUFFER bne L2ABE .ifdef CONFIG_CBM_ALL lda Z03 bne LCAF8 .ifdef CONFIG_CBM1_PATCHES jmp PATCH1 .else clc jmp CONTROL_C_TYPED .endif NXIN: lda Z03 bne LCB21 .else clc jmp CONTROL_C_TYPED NXIN: .endif jsr OUTQUES jsr OUTSP LCB21: jmp INLIN .endif /* KBD */ .ifdef KBD GETC: jsr CONINT jsr LF43D jmp LE664 .endif ; ---------------------------------------------------------------------------- ; "READ" STATEMENT ; ---------------------------------------------------------------------------- READ: ldx DATPTR ldy DATPTR+1 .ifdef CBM2_KBD lda #$98 ; AppleSoft, too .byte $2C L2ABE: lda #$00 .else .byte $A9 L2ABE: tya .endif ; ---------------------------------------------------------------------------- ; PROCESS INPUT LIST ; ; (Y,X) IS ADDRESS OF INPUT DATA STRING ; (A) = VALUE FOR INPUTFLG: $00 FOR INPUT ; $40 FOR GET ; $98 FOR READ ; ---------------------------------------------------------------------------- PROCESS_INPUT_LIST: sta INPUTFLG stx INPTR sty INPTR+1 PROCESS_INPUT_ITEM: jsr PTRGET sta FORPNT sty FORPNT+1 lda TXTPTR ldy TXTPTR+1 sta TXPSV sty TXPSV+1 ldx INPTR ldy INPTR+1 stx TXTPTR sty TXTPTR+1 jsr CHRGOT bne INSTART bit INPUTFLG .ifndef CONFIG_SMALL bvc L2AF0 jsr MONRDKEY .ifdef APPLE and #$7F .endif sta INPUTBUFFER .ifdef CBM1 ldy #>(INPUTBUFFER-1) ldx #<(INPUTBUFFER-1) .else ldx #<(INPUTBUFFER-1) ldy #>(INPUTBUFFER-1) .endif bne L2AF8 L2AF0: .endif bmi FINDATA .ifdef CONFIG_CBM_ALL lda Z03 bne LCB64 .endif .ifdef KBD jsr OUTQUESSP .else jsr OUTQUES .endif LCB64: jsr NXIN L2AF8: stx TXTPTR sty TXTPTR+1 ; ---------------------------------------------------------------------------- INSTART: jsr CHRGET bit VALTYP bpl L2B34 .ifndef CONFIG_SMALL bit INPUTFLG bvc L2B10 .ifdef CONFIG_CBM1_PATCHES lda #$00 jsr PATCH4 nop .else inx stx TXTPTR lda #$00 sta CHARAC beq L2B1C .endif L2B10: .endif sta CHARAC cmp #$22 beq L2B1D lda #$3A sta CHARAC lda #$2C L2B1C: clc L2B1D: sta ENDCHR lda TXTPTR ldy TXTPTR+1 adc #$00 bcc L2B28 iny L2B28: jsr STRLT2 jsr POINT .ifdef CONFIG_SMALL jsr LETSTRING .else jsr PUTSTR .endif jmp INPUT_MORE ; ---------------------------------------------------------------------------- L2B34: jsr FIN .ifdef CONFIG_SMALL jsr SETFOR .else lda VALTYP+1 jsr LET2 .endif ; ---------------------------------------------------------------------------- INPUT_MORE: jsr CHRGOT beq L2B48 cmp #$2C beq L2B48 jmp INPUTERR L2B48: lda TXTPTR ldy TXTPTR+1 sta INPTR sty INPTR+1 lda TXPSV ldy TXPSV+1 sta TXTPTR sty TXTPTR+1 jsr CHRGOT beq INPDONE jsr CHKCOM jmp PROCESS_INPUT_ITEM ; ---------------------------------------------------------------------------- FINDATA: jsr DATAN iny tax bne L2B7C ldx #ERR_NODATA iny lda (TXTPTR),y beq GERR iny lda (TXTPTR),y sta Z8C iny lda (TXTPTR),y iny sta Z8C+1 L2B7C: lda (TXTPTR),y tax jsr ADDON cpx #$83 bne FINDATA jmp INSTART ; ---NO MORE INPUT REQUESTED------ INPDONE: lda INPTR ldy INPTR+1 ldx INPUTFLG .ifdef OSI beq L2B94 .else bpl L2B94 .endif jmp SETDA L2B94: ldy #$00 lda (INPTR),y beq L2BA1 .ifdef CONFIG_CBM_ALL lda Z03 bne L2BA1 .endif lda #ERREXTRA jmp STROUT L2BA1: rts ; ---------------------------------------------------------------------------- ERREXTRA: .ifdef KBD .byte "?Extra" .else .byte "?EXTRA IGNORED" .endif .byte $0D,$0A,$00 ERRREENTRY: .ifdef KBD .byte "What?" .else .byte "?REDO FROM START" .endif .byte $0D,$0A,$00 .ifdef KBD LEA30: .byte "B" .byte $FD .byte "GsBASIC" .byte $00,$1B,$0D,$13 .byte " BASIC" .endif ; ---------------------------------------------------------------------------- ; "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 CBM2_KBD inx inx inx inx .endif txa .ifdef CBM2_KBD 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 KBD inc INDEX ; bug: assumes not on page boundary .endif pla sta INDEX+1 .ifdef KBD 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 STRNG1 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: 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 $6D bit $62 bpl LCE53 cmp #$54 bne LCE53 .endif cpy #$C9 bne LCE53 jsr LCE76 sty EXPON dey sty STRNG2 ldy #$06 sty INDX ldy #$24 jsr LDD3A jmp LD353 LCE53: .endif .ifdef KBD ldx #$00 stx STRNG1+1 .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 .endif .ifdef CBM2 bit $62 bpl LCE90 cmp #$54 bne LCE82 .endif .ifndef CONFIG_CBM_ALL jmp LOAD_FAC_FROM_YA .endif .ifdef CBM1 .byte $19 .endif .ifdef CONFIG_CBM_ALL LCE69: cpy #$49 .ifdef CBM1 bne LCE82 .else bne LCE90 .endif jsr LCE76 tya ldx #$A0 jmp LDB21 LCE76: .ifdef CBM1 lda #$FE ldy #$01 .else lda #$8B ldy #$00 .endif sei jsr LOAD_FAC_FROM_YA cli sty FAC+1 rts LCE82: cmp #$53 bne LCE90 cpy #$54 bne LCE90 lda Z96 jmp FLOAT LCE90: lda FAC+3 ldy FAC+4 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 #FRM_VARIABLE_CALL bne MAKENEWVARIABLE .endif LD015: lda #C_ZERO rts ; ---------------------------------------------------------------------------- .ifndef CBM2_KBD C_ZERO: .byte $00,$00 .endif ; ---------------------------------------------------------------------------- ; MAKE A NEW SIMPLE VARIABLE ; ; MOVE ARRAYS UP 7 BYTES TO MAKE ROOM FOR NEW VARIABLE ; ENTER 7-BYTE VARIABLE DATA IN THE HOLE ; ---------------------------------------------------------------------------- MAKENEWVARIABLE: .ifdef CONFIG_CBM_ALL lda VARNAM ldy VARNAM+1 cmp #$54 bne LD02F cpy #$C9 beq LD015 cpy #$49 bne LD02F LD02C: jmp SYNERR LD02F: cmp #$53 bne LD037 cpy #$54 beq LD02C LD037: .endif lda ARYTAB ldy ARYTAB+1 sta LOWTR sty LOWTR+1 lda STREND ldy STREND+1 sta HIGHTR sty HIGHTR+1 clc adc #BYTES_PER_VARIABLE bcc L2F68 iny L2F68: sta HIGHDS sty HIGHDS+1 jsr BLTU lda HIGHDS ldy HIGHDS+1 iny sta ARYTAB sty ARYTAB+1 ldy #$00 lda VARNAM sta (LOWTR),y iny lda VARNAM+1 sta (LOWTR),y lda #$00 iny sta (LOWTR),y iny sta (LOWTR),y iny sta (LOWTR),y iny sta (LOWTR),y .ifndef CONFIG_SMALL iny sta (LOWTR),y .endif ; ---------------------------------------------------------------------------- ; PUT ADDRESS OF VALUE OF VARIABLE IN VARPNT AND Y,A ; ---------------------------------------------------------------------------- SET_VARPNT_AND_YA: lda LOWTR clc adc #$02 ldy LOWTR+1 bcc L2F9E iny L2F9E: sta VARPNT sty VARPNT+1 rts .include "array.s" ; ---------------------------------------------------------------------------- ; "FRE" FUNCTION ; ; COLLECTS GARBAGE AND RETURNS # BYTES OF MEMORY LEFT ; ---------------------------------------------------------------------------- FRE: lda VALTYP beq L3188 jsr FREFAC L3188: jsr GARBAG sec lda FRETOP sbc STREND tay lda FRETOP+1 sbc STREND+1 ; FALL INTO GIVAYF TO FLOAT THE VALUE ; NOTE THAT VALUES OVER 32767 WILL RETURN AS NEGATIVE ; ---------------------------------------------------------------------------- ; FLOAT THE SIGNED INTEGER IN A,Y ; ---------------------------------------------------------------------------- GIVAYF: ldx #$00 stx VALTYP sta FAC+1 sty FAC+2 ldx #$90 jmp FLOAT1 POS: ldy Z16 ; ---------------------------------------------------------------------------- ; FLOAT (Y) INTO FAC, GIVING VALUE 0-255 ; ---------------------------------------------------------------------------- SNGFLT: lda #$00 beq GIVAYF ; ---------------------------------------------------------------------------- ; CHECK FOR DIRECT OR RUNNING MODE ; GIVING ERROR IF DIRECT MODE ; ---------------------------------------------------------------------------- ERRDIR: ldx CURLIN+1 inx bne RTS9 ldx #ERR_ILLDIR .ifdef CBM2_KBD .byte $2C LD288: ldx #ERR_UNDEFFN .endif L31AF: jmp ERROR DEF: jsr FNC jsr ERRDIR jsr CHKOPN lda #$80 sta SUBFLG jsr PTRGET jsr CHKNUM jsr CHKCLS lda #TOKEN_EQUAL jsr SYNCHR .ifndef CONFIG_SMALL pha .endif lda VARPNT+1 pha lda VARPNT pha lda TXTPTR+1 pha lda TXTPTR pha jsr DATA jmp L3250 FNC: lda #TOKEN_FN jsr SYNCHR ora #$80 sta SUBFLG jsr PTRGET3 sta FNCNAM sty FNCNAM+1 jmp CHKNUM L31F3: jsr FNC lda FNCNAM+1 pha lda FNCNAM pha jsr PARCHK jsr CHKNUM pla sta FNCNAM pla sta FNCNAM+1 ldy #$02 .ifndef CBM2_KBD ldx #ERR_UNDEFFN .endif lda (FNCNAM),y .ifndef CBM2_KBD beq L31AF .endif sta VARPNT tax iny lda (FNCNAM),y .ifdef CBM2_KBD beq LD288 .endif sta VARPNT+1 .ifndef CONFIG_SMALL iny .endif L3219: lda (VARPNT),y pha dey bpl L3219 ldy VARPNT+1 jsr STORE_FAC_AT_YX_ROUNDED lda TXTPTR+1 pha lda TXTPTR pha lda (FNCNAM),y sta TXTPTR iny lda (FNCNAM),y sta TXTPTR+1 lda VARPNT+1 pha lda VARPNT pha jsr FRMNUM pla sta FNCNAM pla sta FNCNAM+1 jsr CHRGOT beq L324A jmp SYNERR L324A: pla sta TXTPTR pla sta TXTPTR+1 L3250: ldy #$00 pla sta (FNCNAM),y pla iny sta (FNCNAM),y pla iny sta (FNCNAM),y pla iny sta (FNCNAM),y .ifndef CONFIG_SMALL pla iny sta (FNCNAM),y .endif rts .include "string.s" .ifdef KBD LF422: lda VARTAB sec sbc #$02 ldy VARTAB+1 bcs LF42C dey LF42C: rts LF42D: lda Z00,x LF430: cmp #$61 bcc LF43A cmp #$7B bcs LF43A LF438: sbc #$1F LF43A: rts LF43B: ldx #$5D LF43D: txa and #$7F cmp $0340 beq LF44D sta $0340 lda #$03 jsr LDE48 LF44D: jsr LDE7F bne RTS4 cpx #$80 bcc LF44D RTS4: rts LF457: lda TXTTAB ldx TXTTAB+1 LF45B: sta JMPADRS+1 stx JMPADRS+2 ldy #$01 lda (JMPADRS+1),y beq LF438 iny iny lda (JMPADRS+1),y dey cmp $14 bne LF472 lda (JMPADRS+1),y cmp $13 LF472: bcs LF43A dey lda (JMPADRS+1),y tax dey lda (JMPADRS+1),y bcc LF45B LF47D: jmp (JMPADRS+1) .else ; ---------------------------------------------------------------------------- ; EVALUATE "EXP1,EXP2" ; ; CONVERT EXP1 TO 16-BIT NUMBER IN LINNUM ; CONVERT EXP2 TO 8-BIT NUMBER IN X-REG ; ---------------------------------------------------------------------------- GTNUM: jsr FRMNUM jsr GETADR ; ---------------------------------------------------------------------------- ; EVALUATE ",EXPRESSION" ; CONVERT EXPRESSION TO SINGLE BYTE IN X-REG ; ---------------------------------------------------------------------------- COMBYTE: jsr CHKCOM jmp GETBYT ; ---------------------------------------------------------------------------- ; CONVERT (FAC) TO A 16-BIT VALUE IN LINNUM ; ---------------------------------------------------------------------------- GETADR: lda FACSIGN .ifdef APPLE nop nop .else bmi GOIQ .endif lda FAC cmp #$91 bcs GOIQ jsr QINT lda FAC_LAST-1 ldy FAC_LAST sty LINNUM sta LINNUM+1 rts ; ---------------------------------------------------------------------------- ; "PEEK" FUNCTION ; ---------------------------------------------------------------------------- PEEK: .ifdef CBM2_KBD lda $12 pha lda $11 pha .endif jsr GETADR ldy #$00 .ifdef CBM1 cmp #$C0 bcc LD6F3 cmp #$E1 bcc LD6F6 LD6F3: .endif .ifdef CBM2_KBD nop ; patch that disables the compares above nop nop nop nop nop nop nop .endif lda (LINNUM),y tay .ifdef CBM2_KBD pla sta $11 pla sta $12 .endif LD6F6: jmp SNGFLT ; ---------------------------------------------------------------------------- ; "POKE" STATEMENT ; ---------------------------------------------------------------------------- POKE: jsr GTNUM txa ldy #$00 sta (LINNUM),y rts ; ---------------------------------------------------------------------------- ; "WAIT" STATEMENT ; ---------------------------------------------------------------------------- WAIT: jsr GTNUM stx FORPNT ldx #$00 jsr CHRGOT .ifdef CBM2 beq EASTER_EGG .else beq L3628 .endif jsr COMBYTE L3628: stx FORPNT+1 ldy #$00 L362C: lda (LINNUM),y eor FORPNT+1 and FORPNT beq L362C RTS3: rts .endif .include "float.s" .include "chrget.s" .include "rnd.s" .include "trig.s" .include "init.s"