diff --git a/apple_loadsave.s b/apple_loadsave.s new file mode 100644 index 0000000..5b6009e --- /dev/null +++ b/apple_loadsave.s @@ -0,0 +1,39 @@ +.segment "CODE" + +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 diff --git a/eval.s b/eval.s new file mode 100644 index 0000000..44f87f1 --- /dev/null +++ b/eval.s @@ -0,0 +1,686 @@ +.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 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 #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 diff --git a/kim_loadsave.s b/kim_loadsave.s new file mode 100644 index 0000000..9e65e81 --- /dev/null +++ b/kim_loadsave.s @@ -0,0 +1,61 @@ +.segment "CODE" +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 diff --git a/memory.s b/memory.s new file mode 100644 index 0000000..5e26bc5 --- /dev/null +++ b/memory.s @@ -0,0 +1,242 @@ +.segment "CODE" + +; ---------------------------------------------------------------------------- +; "DIM" STATEMENT +; ---------------------------------------------------------------------------- +NXDIM: + jsr CHKCOM +DIM: + tax + jsr PTRGET2 + jsr CHRGOT + bne NXDIM + rts + +; ---------------------------------------------------------------------------- +; PTRGET -- GENERAL VARIABLE SCAN +; +; SCANS VARIABLE NAME AT TXTPTR, AND SEARCHES THE +; VARTAB AND ARYTAB FOR THE NAME. +; IF NOT FOUND, CREATE VARIABLE OF APPROPRIATE TYPE. +; RETURN WITH ADDRESS IN VARPNT AND Y,A +; +; ACTUAL ACTIVITY CONTROLLED SOMEWHAT BY TWO FLAGS: +; DIMFLG -- NONZERO IF CALLED FROM "DIM" +; ELSE = 0 +; +; SUBFLG -- = $00 +; = $40 IF CALLED FROM "GETARYPT" +; ---------------------------------------------------------------------------- +PTRGET: + ldx #$00 + jsr CHRGOT +PTRGET2: + stx DIMFLG +PTRGET3: + sta VARNAM + jsr CHRGOT + jsr ISLETC + bcs NAMOK +SYNERR3: + jmp SYNERR +NAMOK: + ldx #$00 + stx VALTYP +.ifndef CONFIG_SMALL + stx VALTYP+1 +.endif + jsr CHRGET + bcc L2ECD + jsr ISLETC + bcc L2ED8 +L2ECD: + tax +L2ECE: + jsr CHRGET + bcc L2ECE + jsr ISLETC + bcs L2ECE +L2ED8: + cmp #$24 +.ifdef CONFIG_SMALL + bne L2EF9 +.else + bne L2EE2 +.endif + lda #$FF + sta VALTYP +.ifndef CONFIG_SMALL + bne L2EF2 +L2EE2: + cmp #$25 + bne L2EF9 + lda SUBFLG + bne SYNERR3 + lda #$80 + sta VALTYP+1 + ora VARNAM + sta VARNAM +L2EF2: +.endif + txa + ora #$80 + tax + jsr CHRGET +L2EF9: + stx VARNAM+1 + sec + ora SUBFLG + sbc #$28 + bne L2F05 + jmp ARRAY +L2F05: + lda #$00 + sta SUBFLG + lda VARTAB + ldx VARTAB+1 + ldy #$00 +L2F0F: + stx LOWTR+1 +L2F11: + sta LOWTR + cpx ARYTAB+1 + bne L2F1B + cmp ARYTAB + beq NAMENOTFOUND +L2F1B: + lda VARNAM + cmp (LOWTR),y + bne L2F29 + lda VARNAM+1 + iny + cmp (LOWTR),y + beq SET_VARPNT_AND_YA + dey +L2F29: + clc + lda LOWTR + adc #BYTES_PER_VARIABLE + bcc L2F11 + inx + bne L2F0F + +; ---------------------------------------------------------------------------- +; CHECK IF (A) IS ASCII LETTER A-Z +; +; RETURN CARRY = 1 IF A-Z +; = 0 IF NOT +; ---------------------------------------------------------------------------- +ISLETC: + cmp #$41 + bcc L2F3C + sbc #$5B + sec + sbc #$A5 +L2F3C: + rts + +; ---------------------------------------------------------------------------- +; VARIABLE NOT FOUND, SO MAKE ONE +; ---------------------------------------------------------------------------- +NAMENOTFOUND: + pla + pha + cmp #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 diff --git a/message.s b/message.s new file mode 100644 index 0000000..90d1354 --- /dev/null +++ b/message.s @@ -0,0 +1,52 @@ +.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 diff --git a/msbasic.s b/msbasic.s index 2f3889f..73da247 100644 --- a/msbasic.s +++ b/msbasic.s @@ -64,58 +64,7 @@ STACK := $0100 .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 +.include "message.s" @@ -275,891 +224,56 @@ L230B: 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 +.include "program.s" + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -; ---------------------------------------------------------------------------- -; 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 @@ -1517,108 +631,27 @@ 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 +.include "apple_loadsave.s" .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 +.include "kim_loadsave.s" .endif + + + + + + + + + + + + + ; ---------------------------------------------------------------------------- ; "RUN" COMMAND ; ---------------------------------------------------------------------------- @@ -2429,1323 +1462,22 @@ LE900: 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 +.include "input.s" -; ---------------------------------------------------------------------------- -; 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 "eval.s" +.include "memory.s" .include "array.s" diff --git a/program.s b/program.s new file mode 100644 index 0000000..ad3e07b --- /dev/null +++ b/program.s @@ -0,0 +1,885 @@ +.segment "CODE" + +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 +; ---------------------------------------------------------------------------- +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 +