; Microsoft BASIC for 6502 .debuginfo + .if .def(cbmbasic1) CBM1 := 1 .include "defines_cbm.s" ; 6 .elseif .def(osi) OSI := 1 .include "defines_osi.s"; 2 .elseif .def(applesoft) APPLE := 1 .include "defines_apple.s"; 10 .elseif .def(kb9) KIM := 1 .include "defines_kim.s" ; 7 .elseif .def(cbmbasic2) CBM2 := 1 .include "defines_cbm.s" ; 11 .elseif .def(kbdbasic) KBD := 1 .include "defines_kbd.s" ; 10 .endif .ifdef CONFIG_SMALL BYTES_FP := 4 BYTES_PER_ELEMENT := 4 BYTES_PER_VARIABLE := 6 .else BYTES_FP := 5 .ifdef APPLE BYTES_PER_ELEMENT := 6 ; ??? should be 5 on Apple .else BYTES_PER_ELEMENT := 5 .endif BYTES_PER_VARIABLE := 7 .endif MANTISSA_BYTES := BYTES_FP-1 BYTES_PER_FRAME := 2*BYTES_FP+8 FOR_STACK1 := 2*BYTES_FP+5 FOR_STACK2 := BYTES_FP+4 .include "macros.s" .include "zeropage.s" .setcpu "6502" .macpack longbranch STACK := $0100 .segment "HEADER" .ifdef KBD jmp LE68C .byte $00,$13,$56 .endif init_token_tables keyword_rts "END", END keyword_rts "FOR", FOR keyword_rts "NEXT", NEXT keyword_rts "DATA", DATA .ifdef CONFIG_CBM_ALL keyword_rts "INPUT#", INPUTH .endif keyword_rts "INPUT", INPUT keyword_rts "DIM", DIM keyword_rts "READ", READ .ifdef APPLE keyword_rts "PLT", PLT .else keyword_rts "LET", LET .endif keyword_rts "GOTO", GOTO, TOKEN_GOTO keyword_rts "RUN", RUN keyword_rts "IF", IF keyword_rts "RESTORE", RESTORE keyword_rts "GOSUB", GOSUB, TOKEN_GOSUB keyword_rts "RETURN", POP .ifdef APPLE keyword_rts "TEX", TEX, TOKEN_REM .else keyword_rts "REM", REM, TOKEN_REM .endif keyword_rts "STOP", STOP keyword_rts "ON", ON .ifdef CONFIG_NULL keyword_rts "NULL", NULL .endif .ifdef KBD keyword_rts "PLOD", PLOD keyword_rts "PSAV", PSAV keyword_rts "VLOD", VLOD keyword_rts "VSAV", VSAV .else keyword_rts "WAIT", WAIT keyword_rts "LOAD", LOAD keyword_rts "SAVE", SAVE .endif .ifdef CONFIG_CBM_ALL keyword_rts "VERIFY", VERIFY .endif keyword_rts "DEF", DEF .ifdef KBD keyword_rts "SLOD", SLOD .else keyword_rts "POKE", POKE .endif .ifdef CONFIG_CBM_ALL keyword_rts "PRINT#", PRINTH .endif keyword_rts "PRINT", PRINT, TOKEN_PRINT keyword_rts "CONT", CONT keyword_rts "LIST", LIST .ifdef CONFIG_CBM_ALL keyword_rts "CLR", CLEAR .else keyword_rts "CLEAR", CLEAR .endif .ifdef CONFIG_CBM_ALL keyword_rts "CMD", CMD keyword_rts "SYS", SYS keyword_rts "OPEN", OPEN keyword_rts "CLOSE", CLOSE .endif .ifndef CONFIG_SMALL keyword_rts "GET", GET .endif .ifdef KBD keyword_rts "PRT", PRT .endif keyword_rts "NEW", NEW keyword "TAB(", TOKEN_TAB keyword "TO", TOKEN_TO keyword "FN", TOKEN_FN keyword "SPC(", TOKEN_SPC keyword "THEN", TOKEN_THEN keyword "NOT", TOKEN_NOT keyword "STEP", TOKEN_STEP keyword "+", TOKEN_PLUS keyword "-", TOKEN_MINUS keyword "*" keyword "/" .ifdef KBD keyword "#" .else keyword "^" .endif keyword "AND" keyword "OR" keyword ">", TOKEN_GREATER keyword "=", TOKEN_EQUAL keyword "<" .segment "VECTORS" UNFNC: keyword_addr "SGN", SGN, TOKEN_SGN keyword_addr "INT", INT keyword_addr "ABS", ABS .ifdef KBD keyword_addr "VER", VER .else .ifdef KIM keyword_addr "USR", IQERR .else keyword_addr "USR", USR .endif .endif keyword_addr "FRE", FRE keyword_addr "POS", POS keyword_addr "SQR", SQR keyword_addr "RND", RND keyword_addr "LOG", LOG keyword_addr "EXP", EXP keyword_addr "COS", COS keyword_addr "SIN", SIN keyword_addr "TAN", TAN keyword_addr "ATN", ATN .ifdef KBD keyword_addr "GETC", GETC .else keyword_addr "PEEK", PEEK .endif keyword_addr "LEN", LEN keyword_addr "STR$", STR keyword_addr "VAL", VAL keyword_addr "ASC", ASC keyword_addr "CHR$", CHRSTR keyword_addr "LEFT$", LEFTSTR, TOKEN_LEFTSTR keyword_addr "RIGHT$", RIGHTSTR keyword_addr "MID$", MIDSTR .ifdef CBM2_KBD keyword "GO" .endif .segment "KEYWORDS" .byte 0 .segment "VECTORS" MATHTBL: .byte $79 .word FADDT-1 .byte $79 .word FSUBT-1 .byte $7B .word FMULTT-1 .byte $7B .word FDIVT-1 .byte $7F .word FPWRT-1 .byte $50 .word TAND-1 .byte $46 .word OR-1 .byte $7D .word NEGOP-1 .byte $5A .word EQUOP-1 .byte $64 .word RELOPS-1 .segment "CODE" ERROR_MESSAGES: .ifdef CONFIG_SMALL .define ERRSTR_NOFOR "NF" .define ERRSTR_SYNTAX "SN" .define ERRSTR_NOGOSUB "RG" .define ERRSTR_NODATA "OD" .define ERRSTR_ILLQTY "FC" .define ERRSTR_OVERFLOW "OV" .define ERRSTR_MEMFULL "OM" .define ERRSTR_UNDEFSTAT "US" .define ERRSTR_BADSUBS "BS" .define ERRSTR_REDIMD "DD" .define ERRSTR_ZERODIV "/0" .define ERRSTR_ILLDIR "ID" .define ERRSTR_BADTYPE "TM" .define ERRSTR_STRLONG "LS" .define ERRSTR_FRMCPX "ST" .define ERRSTR_CANTCONT "CN" .define ERRSTR_UNDEFFN "UF" .else .define ERRSTR_NOFOR "NEXT WITHOUT FOR" .define ERRSTR_SYNTAX "SYNTAX" .define ERRSTR_NOGOSUB "RETURN WITHOUT GOSUB" .define ERRSTR_NODATA "OUT OF DATA" .define ERRSTR_ILLQTY "ILLEGAL QUANTITY" .define ERRSTR_OVERFLOW "OVERFLOW" .define ERRSTR_MEMFULL "OUT OF MEMORY" .define ERRSTR_UNDEFSTAT "UNDEF'D STATEMENT" .define ERRSTR_BADSUBS "BAD SUBSCRIPT" .define ERRSTR_REDIMD "REDIM'D ARRAY" .define ERRSTR_ZERODIV "DIVISION BY ZERO" .define ERRSTR_ILLDIR "ILLEGAL DIRECT" .define ERRSTR_BADTYPE "TYPE MISMATCH" .define ERRSTR_STRLONG "STRING TOO LONG" .ifdef CBM1 .define ERRSTR_BADDATA "BAD DATA" .endif .ifdef CBM2 .define ERRSTR_BADDATA "FILE DATA" .endif .define ERRSTR_FRMCPX "FORMULA TOO COMPLEX" .define ERRSTR_CANTCONT "CAN'T CONTINUE" .define ERRSTR_UNDEFFN "UNDEF'D FUNCTION" .endif ERR_NOFOR := <(*-ERROR_MESSAGES) htasc ERRSTR_NOFOR ERR_SYNTAX := <(*-ERROR_MESSAGES) htasc ERRSTR_SYNTAX ERR_NOGOSUB := <(*-ERROR_MESSAGES) htasc ERRSTR_NOGOSUB ERR_NODATA := <(*-ERROR_MESSAGES) htasc ERRSTR_NODATA ERR_ILLQTY := <(*-ERROR_MESSAGES) htasc ERRSTR_ILLQTY .ifdef CBM1 .byte 0,0,0,0,0 .endif ERR_OVERFLOW := <(*-ERROR_MESSAGES) htasc ERRSTR_OVERFLOW ERR_MEMFULL := <(*-ERROR_MESSAGES) htasc ERRSTR_MEMFULL ERR_UNDEFSTAT := <(*-ERROR_MESSAGES) htasc ERRSTR_UNDEFSTAT ERR_BADSUBS := <(*-ERROR_MESSAGES) htasc ERRSTR_BADSUBS ERR_REDIMD := <(*-ERROR_MESSAGES) htasc ERRSTR_REDIMD ERR_ZERODIV := <(*-ERROR_MESSAGES) htasc ERRSTR_ZERODIV ERR_ILLDIR := <(*-ERROR_MESSAGES) htasc ERRSTR_ILLDIR ERR_BADTYPE := <(*-ERROR_MESSAGES) htasc ERRSTR_BADTYPE ERR_STRLONG := <(*-ERROR_MESSAGES) htasc ERRSTR_STRLONG .ifdef CONFIG_CBM_ALL ERR_BADDATA := <(*-ERROR_MESSAGES) htasc ERRSTR_BADDATA .endif ERR_FRMCPX := <(*-ERROR_MESSAGES) htasc ERRSTR_FRMCPX ERR_CANTCONT := <(*-ERROR_MESSAGES) htasc ERRSTR_CANTCONT ERR_UNDEFFN := <(*-ERROR_MESSAGES) htasc ERRSTR_UNDEFFN 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 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 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 CHKMEM: asl a adc #SPACE_FOR_GOSUB bcs MEMERR sta INDEX tsx cpx INDEX bcc MEMERR rts 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 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_ERROR_LINNUM: jsr STROUT ldy CURLIN+1 iny beq RESTART jsr INPRT 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 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 PUT_NEW_LINE: .ifdef CBM2 jsr SETPTRS jsr LE33D lda INPUTBUFFER beq L2351 clc .else 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 L23E6: lda INPUTBUFFER-4,y sta (LOWTR),y dey bpl L23E6 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 .ifdef APPLE INLIN: ldx #$DD INLIN1: stx $33 jsr L2900 cpx #$EF bcs L0C32 ldx #$EF L0C32: lda #$00 sta $0200,x ldx #$FF ldy #$01 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 */ 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 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 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 L24C8: lda INPUTBUFFERX,x beq L24AC cmp ENDCHR beq L24AC L24D0: iny sta INPUTBUFFER-5,y inx bne L24C8 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 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 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: 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 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: 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 L2CED 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 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_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: sec lda TXTTAB sbc #$01 ldy TXTTAB+1 bcs SETDA dey SETDA: sta DATPTR sty DATPTR+1 RET2: rts .ifndef CONFIG_CBM_ALL 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: bcs END2 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: 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: bne L27CF jmp SETPTRS L27CF: jsr CLEARC jmp L27E9 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: 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: 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: jsr DATAN ADDON: tya clc adc TXTPTR sta TXTPTR bcc L2852 inc TXTPTR+1 L2852: rts 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: jsr FRMEVL jsr CHRGOT cmp #TOKEN_GOTO beq L2884 lda #TOKEN_THEN jsr SYNCHR L2884: lda FAC bne L288D REM: jsr REMN beq ADDON L288D: jsr CHRGOT bcs L2895 jmp GOTO L2895: jmp EXECUTE_STATEMENT 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 LINGET: ldx #$00 stx LINNUM stx LINNUM+1 L28BE: bcs L28B7 sbc #$2F sta CHARAC lda LINNUM+1 sta INDEX cmp #$19 bcs L28A0 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: 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 jmp SETFOR LETSTRING: .ifndef CONFIG_SMALL pla 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: 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 STROUT: jsr STRLIT 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 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 L2A59: lda INPUTFLG beq L2A6E .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 L2A6E: .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: 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: .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: 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: 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 L2A59 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 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: 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 FRMNUM: jsr FRMEVL CHKNUM: clc .byte $24 CHKSTR: sec CHKVAL: bit VALTYP bmi L2C41 bcs L2C43 L2C40: rts L2C41: bcs L2C40 L2C43: ldx #ERR_BADTYPE JERROR: jmp ERROR 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 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 FRM_RECURSE: lda MATHTBL+2,y pha lda MATHTBL+1,y pha jsr FRM_STACK1 lda CPRTYP jmp FRMEVL1 SNTXERR: jmp SYNERR FRM_STACK1: lda FACSIGN ldx MATHTBL,y 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 L2CED: 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 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 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_ STRTXT: lda TXTPTR ldy TXTPTR+1 adc #$00 bcc L2D57 iny L2D57: jsr STRLIT jmp POINT NOT_: cmp #TOKEN_NOT bne L2D74 ldy #$18 bne EQUL 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 PARCHK: jsr CHKOPN jsr FRMEVL CHKCLS: lda #$29 .byte $2C CHKOPN: lda #$28 .byte $2C CHKCOM: lda #$2C 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 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 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 SET_VARPNT_AND_YA: lda LOWTR clc adc #$02 ldy LOWTR+1 bcc L2F9E iny L2F9E: sta VARPNT sty VARPNT+1 rts GETARY: lda EOLPNTR asl a adc #$05 adc LOWTR ldy LOWTR+1 bcc L2FAF iny L2FAF: sta HIGHDS sty HIGHDS+1 rts NEG32768: .byte $90,$80,$00,$00 MAKINT: jsr CHRGET .ifdef CBM2_KBD jsr FRMEVL .else jsr FRMNUM .endif MKINT: .ifdef CBM2_KBD jsr CHKNUM .endif lda FACSIGN bmi MI1 AYINT: lda FAC cmp #$90 bcc MI2 lda #NEG32768 jsr FCOMP MI1: bne IQERR MI2: jmp QINT ARRAY: lda DIMFLG .ifndef CONFIG_SMALL ora VALTYP+1 .endif pha lda VALTYP pha ldy #$00 L2FDE: tya pha lda VARNAM+1 pha lda VARNAM pha jsr MAKINT pla sta VARNAM pla sta VARNAM+1 pla tay tsx lda STACK+2,x pha lda STACK+1,x pha lda FAC_LAST-1 sta STACK+2,x lda FAC_LAST sta STACK+1,x iny jsr CHRGOT cmp #$2C beq L2FDE sty EOLPNTR jsr CHKCLS pla sta VALTYP pla .ifndef CONFIG_SMALL sta VALTYP+1 and #$7F .endif sta DIMFLG ldx ARYTAB lda ARYTAB+1 L301F: stx LOWTR sta LOWTR+1 cmp STREND+1 bne L302B cpx STREND beq MAKE_NEW_ARRAY L302B: ldy #$00 lda (LOWTR),y iny cmp VARNAM bne L303A lda VARNAM+1 cmp (LOWTR),y beq USE_OLD_ARRAY L303A: iny lda (LOWTR),y clc adc LOWTR tax iny lda (LOWTR),y adc LOWTR+1 bcc L301F SUBERR: ldx #ERR_BADSUBS .byte $2C IQERR: ldx #ERR_ILLQTY JER: jmp ERROR USE_OLD_ARRAY: ldx #ERR_REDIMD lda DIMFLG bne JER jsr GETARY lda EOLPNTR ldy #$04 cmp (LOWTR),y bne SUBERR jmp FIND_ARRAY_ELEMENT MAKE_NEW_ARRAY: jsr GETARY jsr REASON lda #$00 tay sta STRNG2+1 ldx #BYTES_PER_ELEMENT .ifdef OSI stx STRNG2 .endif lda VARNAM sta (LOWTR),y .ifndef CONFIG_SMALL bpl L3078 dex L3078: .endif iny lda VARNAM+1 sta (LOWTR),y .ifndef OSI bpl L3081 dex .ifndef KBD dex .endif L3081: stx STRNG2 .endif lda EOLPNTR iny iny iny sta (LOWTR),y L308A: ldx #$0B lda #$00 bit DIMFLG bvc L309A pla clc adc #$01 tax pla adc #$00 L309A: iny sta (LOWTR),y iny txa sta (LOWTR),y jsr MULTIPLY_SUBSCRIPT stx STRNG2 sta STRNG2+1 ldy INDEX dec EOLPNTR bne L308A adc HIGHDS+1 bcs GME sta HIGHDS+1 tay txa adc HIGHDS bcc L30BD iny beq GME L30BD: jsr REASON sta STREND sty STREND+1 lda #$00 inc STRNG2+1 ldy STRNG2 beq L30D1 L30CC: dey sta (HIGHDS),y bne L30CC L30D1: dec HIGHDS+1 dec STRNG2+1 bne L30CC inc HIGHDS+1 sec lda STREND sbc LOWTR ldy #$02 sta (LOWTR),y lda STREND+1 iny sbc LOWTR+1 sta (LOWTR),y lda DIMFLG bne RTS9 iny FIND_ARRAY_ELEMENT: lda (LOWTR),y sta EOLPNTR lda #$00 sta STRNG2 L30F6: sta STRNG2+1 iny pla tax sta FAC_LAST-1 pla sta FAC_LAST cmp (LOWTR),y bcc FAE2 bne GSE iny txa cmp (LOWTR),y bcc FAE3 GSE: jmp SUBERR GME: jmp MEMERR FAE2: iny FAE3: lda STRNG2+1 ora STRNG2 clc beq L3124 jsr MULTIPLY_SUBSCRIPT txa adc FAC_LAST-1 tax tya ldy INDEX L3124: adc FAC_LAST stx STRNG2 dec EOLPNTR bne L30F6 .ifdef OSI asl STRNG2 rol a bcs GSE asl STRNG2 rol a bcs GSE tay lda STRNG2 .else .ifndef CBM1_APPLE sta STRNG2+1 .endif ldx #BYTES_FP .ifdef KBD lda VARNAM+1 .else lda VARNAM .endif bpl L3135 dex L3135: .ifndef KBD lda VARNAM+1 bpl L313B dex dex L313B: .endif .ifdef KBD stx RESULT+1 .else stx RESULT+2 .endif lda #$00 jsr MULTIPLY_SUBS1 txa .endif adc HIGHDS sta VARPNT tya adc HIGHDS+1 sta VARPNT+1 tay lda VARPNT RTS9: rts MULTIPLY_SUBSCRIPT: sty INDEX lda (LOWTR),y sta RESULT_LAST-2 dey lda (LOWTR),y MULTIPLY_SUBS1: sta RESULT_LAST-1 lda #$10 sta INDX ldx #$00 ldy #$00 L3163: txa asl a tax tya rol a tay bcs GME asl STRNG2 rol STRNG2+1 bcc L317C clc txa adc RESULT_LAST-2 tax tya adc RESULT_LAST-1 tay bcs GME L317C: dec INDX bne L3163 rts FRE: lda VALTYP beq L3188 jsr FREFAC L3188: jsr GARBAG sec lda FRETOP sbc STREND tay lda FRETOP+1 sbc STREND+1 GIVAYF: ldx #$00 stx VALTYP sta FAC+1 sty FAC+2 ldx #$90 jmp FLOAT1 POS: ldy Z16 SNGFLT: lda #$00 beq GIVAYF 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 STR: jsr CHKNUM ldy #$00 jsr FOUT1 pla pla LD353: lda #$FF ldy #$00 beq STRLIT STRINI: ldx FAC_LAST-1 ldy FAC_LAST stx DSCPTR sty DSCPTR+1 STRSPA: jsr GETSPA stx FAC+1 sty FAC+2 sta FAC rts STRLIT: ldx #$22 stx CHARAC stx ENDCHR STRLT2: sta STRNG1 sty STRNG1+1 sta FAC+1 sty FAC+2 ldy #$FF L3298: iny lda (STRNG1),y beq L32A9 cmp CHARAC beq L32A5 cmp ENDCHR bne L3298 L32A5: cmp #$22 beq L32AA L32A9: clc L32AA: sty FAC tya adc STRNG1 sta STRNG2 ldx STRNG1+1 bcc L32B6 inx L32B6: stx STRNG2+1 lda STRNG1+1 .if INPUTBUFFER >= $0100 beq LD399 cmp #>INPUTBUFFER .endif bne PUTNEW LD399: tya jsr STRINI ldx STRNG1 ldy STRNG1+1 jsr MOVSTR PUTNEW: ldx TEMPPT cpx #TEMPST+9 bne PUTEMP ldx #ERR_FRMCPX JERR: jmp ERROR PUTEMP: lda FAC sta 0,x lda FAC+1 sta 1,x lda FAC+2 sta 2,x ldy #$00 stx FAC_LAST-1 sty FAC_LAST .ifdef CBM2_KBD sty FACEXTENSION .endif dey sty VALTYP stx LASTPT inx inx inx stx TEMPPT rts GETSPA: lsr DATAFLG L32F1: pha eor #$FF sec adc FRETOP ldy FRETOP+1 bcs L32FC dey L32FC: cpy STREND+1 bcc L3311 bne L3306 cmp STREND bcc L3311 L3306: sta FRETOP sty FRETOP+1 sta FRESPC sty FRESPC+1 tax pla rts L3311: ldx #ERR_MEMFULL lda DATAFLG bmi JERR jsr GARBAG lda #$80 sta DATAFLG pla bne L32F1 GARBAG: .ifdef KBD ldx #CONST_MEMSIZ .else ldx MEMSIZ lda MEMSIZ+1 .endif FINDHIGHESTSTRING: stx FRETOP sta FRETOP+1 ldy #$00 sty FNCNAM+1 .ifdef CBM2_KBD sty FNCNAM .endif lda STREND ldx STREND+1 sta LOWTR stx LOWTR+1 lda #TEMPST ldx #$00 sta INDEX stx INDEX+1 L333D: cmp TEMPPT beq L3346 jsr CHECK_VARIABLE beq L333D L3346: lda #BYTES_PER_VARIABLE sta DSCLEN lda VARTAB ldx VARTAB+1 sta INDEX stx INDEX+1 L3352: cpx ARYTAB+1 bne L335A cmp ARYTAB beq L335F L335A: jsr CHECK_SIMPLE_VARIABLE beq L3352 L335F: sta HIGHDS stx HIGHDS+1 lda #$03 sta DSCLEN L3367: lda HIGHDS ldx HIGHDS+1 L336B: cpx STREND+1 bne L3376 cmp STREND bne L3376 jmp MOVE_HIGHEST_STRING_TO_TOP L3376: sta INDEX stx INDEX+1 .ifdef CONFIG_SMALL ldy #$01 .else ldy #$00 lda (INDEX),y tax iny .endif lda (INDEX),y php iny lda (INDEX),y adc HIGHDS sta HIGHDS iny lda (INDEX),y adc HIGHDS+1 sta HIGHDS+1 plp bpl L3367 .ifndef CONFIG_SMALL txa bmi L3367 .endif iny lda (INDEX),y .ifdef KBD ldy #$00 .endif .ifdef CBM1 jsr LE7F3 .else .ifndef CONFIG_SMALL ldy #$00 .endif asl a adc #$05 .endif adc INDEX sta INDEX bcc L33A7 inc INDEX+1 L33A7: ldx INDEX+1 L33A9: cpx HIGHDS+1 bne L33B1 cmp HIGHDS beq L336B L33B1: jsr CHECK_VARIABLE beq L33A9 CHECK_SIMPLE_VARIABLE: .ifndef CONFIG_SMALL lda (INDEX),y bmi CHECK_BUMP .endif iny lda (INDEX),y bpl CHECK_BUMP iny CHECK_VARIABLE: lda (INDEX),y beq CHECK_BUMP iny lda (INDEX),y tax iny lda (INDEX),y cmp FRETOP+1 bcc L33D5 bne CHECK_BUMP cpx FRETOP bcs CHECK_BUMP L33D5: cmp LOWTR+1 bcc CHECK_BUMP bne L33DF cpx LOWTR bcc CHECK_BUMP L33DF: stx LOWTR sta LOWTR+1 lda INDEX ldx INDEX+1 sta FNCNAM stx FNCNAM+1 lda DSCLEN sta Z52 CHECK_BUMP: lda DSCLEN clc adc INDEX sta INDEX bcc L33FA inc INDEX+1 L33FA: ldx INDEX+1 ldy #$00 rts MOVE_HIGHEST_STRING_TO_TOP: .ifdef CBM2_KBD lda FNCNAM+1 ora FNCNAM .else ldx FNCNAM+1 .endif beq L33FA lda Z52 .ifdef CBM1 sbc #$03 .else and #$04 .endif lsr a tay sta Z52 lda (FNCNAM),y adc LOWTR sta HIGHTR lda LOWTR+1 adc #$00 sta HIGHTR+1 lda FRETOP ldx FRETOP+1 sta HIGHDS stx HIGHDS+1 jsr BLTU2 ldy Z52 iny lda HIGHDS sta (FNCNAM),y tax inc HIGHDS+1 lda HIGHDS+1 iny sta (FNCNAM),y jmp FINDHIGHESTSTRING CAT: lda FAC_LAST pha lda FAC_LAST-1 pha jsr FRM_ELEMENT jsr CHKSTR pla sta STRNG1 pla sta STRNG1+1 ldy #$00 lda (STRNG1),y clc adc (FAC_LAST-1),y bcc L3454 ldx #ERR_STRLONG jmp ERROR L3454: jsr STRINI jsr MOVINS lda DSCPTR ldy DSCPTR+1 jsr FRETMP jsr MOVSTR1 lda STRNG1 ldy STRNG1+1 jsr FRETMP jsr PUTNEW jmp FRMEVL2 MOVINS: ldy #$00 lda (STRNG1),y pha iny lda (STRNG1),y tax iny lda (STRNG1),y tay pla MOVSTR: stx INDEX sty INDEX+1 MOVSTR1: tay beq L3490 pha L3487: dey lda (INDEX),y sta (FRESPC),y tya bne L3487 pla L3490: clc adc FRESPC sta FRESPC bcc L3499 inc FRESPC+1 L3499: rts FRESTR: jsr CHKSTR FREFAC: lda FAC_LAST-1 ldy FAC_LAST FRETMP: sta INDEX sty INDEX+1 jsr FRETMS php ldy #$00 lda (INDEX),y pha iny lda (INDEX),y tax iny lda (INDEX),y tay pla plp bne L34CD cpy FRETOP+1 bne L34CD cpx FRETOP bne L34CD pha clc adc FRETOP sta FRETOP bcc L34CC inc FRETOP+1 L34CC: pla L34CD: stx INDEX sty INDEX+1 rts FRETMS: .ifdef KBD cpy #$00 .else cpy LASTPT+1 .endif bne L34E2 cmp LASTPT bne L34E2 sta TEMPPT sbc #$03 sta LASTPT ldy #$00 L34E2: rts CHRSTR: jsr CONINT txa pha lda #$01 jsr STRSPA pla ldy #$00 sta (FAC+1),y pla pla jmp PUTNEW LEFTSTR: jsr SUBSTRING_SETUP cmp (DSCPTR),y tya SUBSTRING1: bcc L3503 lda (DSCPTR),y tax tya L3503: pha SUBSTRING2: txa SUBSTRING3: pha jsr STRSPA lda DSCPTR ldy DSCPTR+1 jsr FRETMP pla tay pla clc adc INDEX sta INDEX bcc L351C inc INDEX+1 L351C: tya jsr MOVSTR1 jmp PUTNEW RIGHTSTR: jsr SUBSTRING_SETUP clc sbc (DSCPTR),y eor #$FF jmp SUBSTRING1 MIDSTR: lda #$FF sta FAC_LAST jsr CHRGOT cmp #$29 beq L353F jsr CHKCOM jsr GETBYT L353F: jsr SUBSTRING_SETUP .ifdef CBM2_KBD beq GOIQ .endif dex txa pha clc ldx #$00 sbc (DSCPTR),y bcs SUBSTRING2 eor #$FF cmp FAC_LAST bcc SUBSTRING3 lda FAC_LAST bcs SUBSTRING3 SUBSTRING_SETUP: jsr CHKCLS pla .ifndef CONFIG_11 sta JMPADRS+1 pla sta JMPADRS+2 .else tay pla sta Z52 .endif pla pla pla tax pla sta DSCPTR pla sta DSCPTR+1 .ifdef CONFIG_11 lda Z52 pha tya pha .endif ldy #$00 txa .ifndef CBM2_KBD beq GOIQ .endif .ifndef CONFIG_11 inc JMPADRS+1 jmp (JMPADRS+1) .else rts .endif LEN: jsr GETSTR SNGFLT1: jmp SNGFLT GETSTR: jsr FRESTR ldx #$00 stx VALTYP tay rts ASC: jsr GETSTR beq GOIQ ldy #$00 lda (INDEX),y tay .ifndef CONFIG_11_NOAPPLE jmp SNGFLT1 .else jmp SNGFLT .endif GOIQ: jmp IQERR GTBYTC: jsr CHRGET GETBYT: jsr FRMNUM CONINT: jsr MKINT ldx FAC_LAST-1 bne GOIQ ldx FAC_LAST jmp CHRGOT VAL: jsr GETSTR bne L35AC jmp ZERO_FAC L35AC: ldx TXTPTR ldy TXTPTR+1 stx STRNG2 sty STRNG2+1 ldx INDEX stx TXTPTR clc adc INDEX sta DEST ldx INDEX+1 stx TXTPTR+1 bcc L35C4 inx L35C4: stx DEST+1 ldy #$00 lda (DEST),y pha lda #$00 sta (DEST),y jsr CHRGOT jsr FIN pla ldy #$00 sta (DEST),y POINT: ldx STRNG2 ldy STRNG2+1 stx TXTPTR sty TXTPTR+1 rts .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 GTNUM: jsr FRMNUM jsr GETADR COMBYTE: jsr CHKCOM jmp GETBYT 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: .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 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: jsr GTNUM txa ldy #$00 sta (LINNUM),y rts WAIT: jsr GTNUM stx FORPNT ldx #$00 jsr CHRGOT .ifdef CBM2 beq LD745 .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 FADDH: lda #CON_HALF jmp FADD FSUB: jsr LOAD_ARG_FROM_YA FSUBT: lda FACSIGN eor #$FF sta FACSIGN eor ARGSIGN sta STRNG1 lda FAC jmp FADDT .ifdef CBM2 LD745: lda $11 cmp #<6502 bne L3628 lda $12 sbc #>6502 bne L3628 sta $11 tay lda #$80 sta $12 LD758: ldx #$0A LD75A: lda MICROSOFT-1,x and #$3F sta ($11),y iny bne LD766 inc $12 LD766: dex bne LD75A dec $46 bne LD758 rts .endif FADD1: jsr SHIFT_RIGHT bcc FADD3 FADD: jsr LOAD_ARG_FROM_YA FADDT: bne L365B jmp COPY_ARG_TO_FAC L365B: ldx FACEXTENSION stx ARGEXTENSION ldx #ARG lda ARG FADD2: tay .ifdef KBD beq RTS4 .else beq RTS3 .endif sec sbc FAC beq FADD3 bcc L367F sty FAC ldy ARGSIGN sty FACSIGN eor #$FF adc #$00 ldy #$00 sty ARGEXTENSION ldx #FAC bne L3683 L367F: ldy #$00 sty FACEXTENSION L3683: cmp #$F9 bmi FADD1 tay lda FACEXTENSION lsr 1,x jsr SHIFT_RIGHT4 FADD3: bit STRNG1 bpl FADD4 ldy #FAC cpx #ARG beq L369B ldy #ARG L369B: sec eor #$FF adc ARGEXTENSION sta FACEXTENSION .ifndef CONFIG_SMALL lda 4,y sbc 4,x sta FAC+4 .endif lda GOWARM,y sbc GOWARM,x sta FAC+3 lda 2,y sbc 2,x sta FAC+2 lda 1,y sbc 1,x sta FAC+1 NORMALIZE_FAC1: bcs NORMALIZE_FAC2 jsr COMPLEMENT_FAC NORMALIZE_FAC2: ldy #$00 tya clc L36C7: ldx FAC+1 bne NORMALIZE_FAC4 ldx FAC+2 stx FAC+1 ldx FAC+3 stx FAC+2 .ifdef CONFIG_SMALL ldx FACEXTENSION stx FAC+3 .else ldx FAC+4 stx FAC+3 ldx FACEXTENSION stx FAC+4 .endif sty FACEXTENSION adc #$08 .ifdef KBD cmp #$20 .else cmp #MANTISSA_BYTES*8 .endif bne L36C7 ZERO_FAC: lda #$00 STA_IN_FAC_SIGN_AND_EXP: sta FAC STA_IN_FAC_SIGN: sta FACSIGN rts FADD4: adc ARGEXTENSION sta FACEXTENSION .ifndef CONFIG_SMALL lda FAC+4 adc ARG+4 sta FAC+4 .endif lda FAC+3 adc ARG+3 sta FAC+3 lda FAC+2 adc ARG+2 sta FAC+2 lda FAC+1 adc ARG+1 sta FAC+1 jmp NORMALIZE_FAC5 NORMALIZE_FAC3: adc #$01 asl FACEXTENSION .ifndef CONFIG_SMALL rol FAC+4 .endif rol FAC+3 rol FAC+2 rol FAC+1 NORMALIZE_FAC4: bpl NORMALIZE_FAC3 sec sbc FAC bcs ZERO_FAC eor #$FF adc #$01 sta FAC NORMALIZE_FAC5: bcc L3764 NORMALIZE_FAC6: inc FAC beq OVERFLOW .ifndef KIM ror FAC+1 ror FAC+2 ror FAC+3 .ifndef CONFIG_SMALL ror FAC+4 .endif ror FACEXTENSION .else lda #$00 bcc L372E lda #$80 L372E: lsr FAC+1 ora FAC+1 sta FAC+1 lda #$00 bcc L373A lda #$80 L373A: lsr FAC+2 ora FAC+2 sta FAC+2 lda #$00 bcc L3746 lda #$80 L3746: lsr FAC+3 ora FAC+3 sta FAC+3 lda #$00 bcc L3752 lda #$80 L3752: lsr FAC+4 ora FAC+4 sta FAC+4 lda #$00 bcc L375E lda #$80 L375E: lsr FACEXTENSION ora FACEXTENSION sta FACEXTENSION .endif L3764: rts COMPLEMENT_FAC: lda FACSIGN eor #$FF sta FACSIGN COMPLEMENT_FAC_MANTISSA: lda FAC+1 eor #$FF sta FAC+1 lda FAC+2 eor #$FF sta FAC+2 lda FAC+3 eor #$FF sta FAC+3 .ifndef CONFIG_SMALL lda FAC+4 eor #$FF sta FAC+4 .endif lda FACEXTENSION eor #$FF sta FACEXTENSION inc FACEXTENSION bne RTS12 INCREMENT_FAC_MANTISSA: .ifndef CONFIG_SMALL inc FAC+4 bne RTS12 .endif inc FAC+3 bne RTS12 inc FAC+2 bne RTS12 inc FAC+1 RTS12: rts OVERFLOW: ldx #ERR_OVERFLOW jmp ERROR SHIFT_RIGHT1: ldx #RESULT-1 SHIFT_RIGHT2: .ifdef CONFIG_SMALL ldy 3,x .else ldy 4,x .endif sty FACEXTENSION .ifndef CONFIG_SMALL ldy 3,x sty 4,x .endif ldy 2,x sty 3,x ldy 1,x sty 2,x ldy SHIFTSIGNEXT sty 1,x SHIFT_RIGHT: adc #$08 bmi SHIFT_RIGHT2 beq SHIFT_RIGHT2 sbc #$08 tay lda FACEXTENSION bcs SHIFT_RIGHT5 .ifndef KIM LB588: asl 1,x bcc LB58E inc 1,x LB58E: ror 1,x ror 1,x SHIFT_RIGHT4: ror 2,x ror 3,x .ifndef CONFIG_SMALL ror 4,x .endif ror a iny bne LB588 .else L37C4: pha lda 1,x and #$80 lsr 1,x ora 1,x sta 1,x .byte $24 SHIFT_RIGHT4: pha lda #$00 bcc L37D7 lda #$80 L37D7: lsr 2,x ora 2,x sta 2,x lda #$00 bcc L37E3 lda #$80 L37E3: lsr 3,x ora 3,x sta 3,x lda #$00 bcc L37EF lda #$80 L37EF: lsr 4,x ora 4,x sta 4,x pla php lsr a plp bcc L37FD ora #$80 L37FD: iny bne L37C4 .endif SHIFT_RIGHT5: clc rts .ifdef CONFIG_SMALL CON_ONE: .byte $81,$00,$00,$00 POLY_LOG: .byte $02 .byte $80,$19,$56,$62 .byte $80,$76,$22,$F3 .byte $82,$38,$AA,$40 CON_SQR_HALF: .byte $80,$35,$04,$F3 CON_SQR_TWO: .byte $81,$35,$04,$F3 CON_NEG_HALF: .byte $80,$80,$00,$00 CON_LOG_TWO: .byte $80,$31,$72,$18 .else CON_ONE: .byte $81,$00,$00,$00,$00 POLY_LOG: .byte $03 .byte $7F,$5E,$56,$CB,$79 .byte $80,$13,$9B,$0B,$64 .byte $80,$76,$38,$93,$16 .byte $82,$38,$AA,$3B,$20 CON_SQR_HALF: .byte $80,$35,$04,$F3,$34 CON_SQR_TWO: .byte $81,$35,$04,$F3,$34 CON_NEG_HALF: .byte $80,$80,$00,$00,$00 CON_LOG_TWO: .byte $80,$31,$72,$17,$F8 .endif LOG: jsr SIGN beq GIQ bpl LOG2 GIQ: jmp IQERR LOG2: lda FAC sbc #$7F pha lda #$80 sta FAC lda #CON_SQR_HALF jsr FADD lda #CON_SQR_TWO jsr FDIV lda #CON_ONE jsr FSUB lda #POLY_LOG jsr POLYNOMIAL_ODD lda #CON_NEG_HALF jsr FADD pla jsr ADDACC lda #CON_LOG_TWO FMULT: jsr LOAD_ARG_FROM_YA FMULTT: .ifndef CONFIG_11 beq L3903 .else bne L3876 jmp L3903 L3876: .endif jsr ADD_EXPONENTS lda #$00 sta RESULT sta RESULT+1 sta RESULT+2 .ifndef CONFIG_SMALL sta RESULT+3 .endif lda FACEXTENSION jsr MULTIPLY1 .ifndef CONFIG_SMALL lda FAC+4 jsr MULTIPLY1 .endif lda FAC+3 jsr MULTIPLY1 lda FAC+2 jsr MULTIPLY1 lda FAC+1 jsr MULTIPLY2 jmp COPY_RESULT_INTO_FAC MULTIPLY1: bne MULTIPLY2 jmp SHIFT_RIGHT1 MULTIPLY2: lsr a ora #$80 L38A7: tay bcc L38C3 clc .ifndef CONFIG_SMALL lda RESULT+3 adc ARG+4 sta RESULT+3 .endif lda RESULT+2 adc ARG+3 sta RESULT+2 lda RESULT+1 adc ARG+2 sta RESULT+1 lda RESULT adc ARG+1 sta RESULT L38C3: .ifndef KIM ror RESULT ror RESULT+1 .ifdef APPLE .byte RESULT+2,RESULT+2 ; XXX BUG! .else ror RESULT+2 .endif .ifndef CONFIG_SMALL ror RESULT+3 .endif ror FACEXTENSION .else lda #$00 bcc L38C9 lda #$80 L38C9: lsr RESULT ora RESULT sta RESULT lda #$00 bcc L38D5 lda #$80 L38D5: lsr RESULT+1 ora RESULT+1 sta RESULT+1 lda #$00 bcc L38E1 lda #$80 L38E1: lsr RESULT+2 ora RESULT+2 sta RESULT+2 lda #$00 bcc L38ED lda #$80 L38ED: lsr RESULT+3 ora RESULT+3 sta RESULT+3 lda #$00 bcc L38F9 lda #$80 L38F9: lsr FACEXTENSION ora FACEXTENSION sta FACEXTENSION .endif tya lsr a bne L38A7 L3903: rts LOAD_ARG_FROM_YA: sta INDEX sty INDEX+1 ldy #BYTES_FP-1 .ifndef CONFIG_SMALL lda (INDEX),y sta ARG+4 dey .endif lda (INDEX),y sta ARG+3 dey lda (INDEX),y sta ARG+2 dey lda (INDEX),y sta ARGSIGN eor FACSIGN sta STRNG1 lda ARGSIGN ora #$80 sta ARG+1 dey lda (INDEX),y sta ARG lda FAC rts ADD_EXPONENTS: lda ARG ADD_EXPONENTS1: beq ZERO clc adc FAC bcc L393C bmi JOV clc .byte $2C L393C: bpl ZERO adc #$80 sta FAC bne L3947 jmp STA_IN_FAC_SIGN L3947: lda STRNG1 sta FACSIGN rts OUTOFRNG: lda FACSIGN eor #$FF bmi JOV ZERO: pla pla jmp ZERO_FAC JOV: jmp OVERFLOW MUL10: jsr COPY_FAC_TO_ARG_ROUNDED tax beq L3970 clc adc #$02 bcs JOV LD9BF: ldx #$00 stx STRNG1 jsr FADD2 inc FAC beq JOV L3970: rts CONTEN: .ifdef CONFIG_SMALL .byte $84,$20,$00,$00 .else .byte $84,$20,$00,$00,$00 .endif DIV10: jsr COPY_FAC_TO_ARG_ROUNDED lda #CONTEN ldx #$00 DIV: stx STRNG1 jsr LOAD_FAC_FROM_YA jmp FDIVT FDIV: jsr LOAD_ARG_FROM_YA FDIVT: beq L3A02 jsr ROUND_FAC lda #$00 sec sbc FAC sta FAC jsr ADD_EXPONENTS inc FAC beq JOV ldx #-MANTISSA_BYTES lda #$01 L39A1: ldy ARG+1 cpy FAC+1 bne L39B7 ldy ARG+2 cpy FAC+2 bne L39B7 ldy ARG+3 cpy FAC+3 .ifndef CONFIG_SMALL bne L39B7 ldy ARG+4 cpy FAC+4 .endif L39B7: php rol a bcc L39C4 inx sta RESULT_LAST-1,x beq L39F2 bpl L39F6 lda #$01 L39C4: plp bcs L39D5 L39C7: asl ARG_LAST .ifndef CONFIG_SMALL rol ARG+3 .endif rol ARG+2 rol ARG+1 bcs L39B7 bmi L39A1 bpl L39B7 L39D5: tay .ifndef CONFIG_SMALL lda ARG+4 sbc FAC+4 sta ARG+4 .endif lda ARG+3 sbc FAC+3 sta ARG+3 lda ARG+2 sbc FAC+2 sta ARG+2 lda ARG+1 sbc FAC+1 sta ARG+1 tya jmp L39C7 L39F2: lda #$40 bne L39C4 L39F6: asl a asl a asl a asl a asl a asl a sta FACEXTENSION plp jmp COPY_RESULT_INTO_FAC L3A02: ldx #ERR_ZERODIV jmp ERROR COPY_RESULT_INTO_FAC: lda RESULT sta FAC+1 lda RESULT+1 sta FAC+2 lda RESULT+2 sta FAC+3 .ifndef CONFIG_SMALL lda RESULT+3 sta FAC+4 .endif jmp NORMALIZE_FAC2 LOAD_FAC_FROM_YA: sta INDEX sty INDEX+1 ldy #MANTISSA_BYTES .ifndef CONFIG_SMALL lda (INDEX),y sta FAC+4 dey .endif lda (INDEX),y sta FAC+3 dey lda (INDEX),y sta FAC+2 dey lda (INDEX),y sta FACSIGN ora #$80 sta FAC+1 dey lda (INDEX),y sta FAC sty FACEXTENSION rts STORE_FAC_IN_TEMP2_ROUNDED: ldx #TEMP2 .byte $2C STORE_FAC_IN_TEMP1_ROUNDED: ldx #TEMP1+(5-BYTES_FP) ldy #$00 beq STORE_FAC_AT_YX_ROUNDED SETFOR: ldx FORPNT ldy FORPNT+1 STORE_FAC_AT_YX_ROUNDED: jsr ROUND_FAC stx INDEX sty INDEX+1 ldy #MANTISSA_BYTES .ifndef CONFIG_SMALL lda FAC+4 sta (INDEX),y dey .endif lda FAC+3 sta (INDEX),y dey lda FAC+2 sta (INDEX),y dey lda FACSIGN ora #$7F and FAC+1 sta (INDEX),y dey lda FAC sta (INDEX),y sty FACEXTENSION rts COPY_ARG_TO_FAC: lda ARGSIGN MFA: sta FACSIGN ldx #BYTES_FP L3A7A: lda SHIFTSIGNEXT,x sta EXPSGN,x dex bne L3A7A stx FACEXTENSION rts COPY_FAC_TO_ARG_ROUNDED: jsr ROUND_FAC MAF: ldx #BYTES_FP+1 L3A89: lda EXPSGN,x sta SHIFTSIGNEXT,x dex bne L3A89 stx FACEXTENSION RTS14: rts ROUND_FAC: lda FAC beq RTS14 asl FACEXTENSION bcc RTS14 INCREMENT_MANTISSA: jsr INCREMENT_FAC_MANTISSA bne RTS14 jmp NORMALIZE_FAC6 SIGN: lda FAC beq RTS15 L3AA7: lda FACSIGN SIGN2: rol a lda #$FF bcs RTS15 lda #$01 RTS15: rts SGN: jsr SIGN FLOAT: sta FAC+1 lda #$00 sta FAC+2 ldx #$88 FLOAT1: lda FAC+1 eor #$FF rol a FLOAT2: lda #$00 .ifndef CONFIG_SMALL sta FAC+4 .endif sta FAC+3 LDB21: stx FAC sta FACEXTENSION sta FACSIGN jmp NORMALIZE_FAC1 ABS: lsr FACSIGN rts FCOMP: sta DEST FCOMP2: sty DEST+1 ldy #$00 lda (DEST),y iny tax beq SIGN lda (DEST),y eor FACSIGN bmi L3AA7 cpx FAC bne L3B0A lda (DEST),y ora #$80 cmp FAC+1 bne L3B0A iny lda (DEST),y cmp FAC+2 bne L3B0A iny .ifndef CONFIG_SMALL lda (DEST),y cmp FAC+3 bne L3B0A iny .endif lda #$7F cmp FACEXTENSION lda (DEST),y sbc FAC_LAST beq L3B32 L3B0A: lda FACSIGN bcc L3B10 eor #$FF L3B10: jmp SIGN2 QINT: lda FAC beq QINT3 sec sbc #120+8*BYTES_FP bit FACSIGN bpl L3B27 tax lda #$FF sta SHIFTSIGNEXT jsr COMPLEMENT_FAC_MANTISSA txa L3B27: ldx #FAC cmp #$F9 bpl QINT2 jsr SHIFT_RIGHT sty SHIFTSIGNEXT L3B32: rts QINT2: tay lda FACSIGN and #$80 lsr FAC+1 ora FAC+1 sta FAC+1 jsr SHIFT_RIGHT4 sty SHIFTSIGNEXT rts INT: lda FAC cmp #120+8*BYTES_FP bcs RTS17 jsr QINT sty FACEXTENSION lda FACSIGN sty FACSIGN eor #$80 rol a lda #120+8*BYTES_FP sta FAC lda FAC_LAST sta CHARAC jmp NORMALIZE_FAC1 QINT3: sta FAC+1 sta FAC+2 sta FAC+3 .ifndef CONFIG_SMALL sta FAC+4 .endif tay RTS17: rts FIN: ldy #$00 ldx #SERLEN-TMPEXP L3B6F: sty TMPEXP,x dex bpl L3B6F bcc FIN2 cmp #$2D bne L3B7E stx SERLEN beq FIN1 L3B7E: cmp #$2B bne FIN3 FIN1: jsr CHRGET FIN2: bcc FIN9 FIN3: cmp #$2E beq FIN10 cmp #$45 bne FIN7 jsr CHRGET bcc FIN5 cmp #TOKEN_MINUS beq L3BA6 cmp #$2D beq L3BA6 cmp #TOKEN_PLUS beq FIN4 cmp #$2B beq FIN4 bne FIN6 L3BA6: .ifndef KIM ror EXPSGN .else lda #$00 bcc L3BAC lda #$80 L3BAC: lsr EXPSGN ora EXPSGN sta EXPSGN .endif FIN4: jsr CHRGET FIN5: bcc GETEXP FIN6: bit EXPSGN bpl FIN7 lda #$00 sec sbc EXPON jmp FIN8 FIN10: .ifndef KIM ror LOWTR .else lda #$00 bcc L3BC9 lda #$80 L3BC9: lsr LOWTR ora LOWTR sta LOWTR .endif bit LOWTR bvc FIN1 FIN7: lda EXPON FIN8: sec sbc INDX sta EXPON beq L3BEE bpl L3BE7 L3BDE: jsr DIV10 inc EXPON bne L3BDE beq L3BEE L3BE7: jsr MUL10 dec EXPON bne L3BE7 L3BEE: lda SERLEN bmi L3BF3 rts L3BF3: jmp NEGOP FIN9: pha bit LOWTR bpl L3BFD inc INDX L3BFD: jsr MUL10 pla sec sbc #$30 jsr ADDACC jmp FIN1 ADDACC: pha jsr COPY_FAC_TO_ARG_ROUNDED pla jsr FLOAT lda ARGSIGN eor FACSIGN sta STRNG1 ldx FAC jmp FADDT GETEXP: lda EXPON cmp #MAX_EXPON bcc L3C2C .ifndef CBM1 lda #$64 .endif bit EXPSGN .ifndef CBM1 bmi L3C3A .else bmi LDC70 .endif jmp OVERFLOW LDC70: .ifdef CBM1 lda #$0B .endif L3C2C: asl a asl a clc adc EXPON asl a clc ldy #$00 adc (TXTPTR),y sec sbc #$30 L3C3A: sta EXPON jmp FIN4 .ifdef CONFIG_SMALL ; these values are /1000 of what the labels say CON_99999999_9: .byte $91,$43,$4F,$F8 CON_999999999: .byte $94,$74,$23,$F7 CON_BILLION: .byte $94,$74,$24,$00 .else CON_99999999_9: .byte $9B,$3E,$BC,$1F,$FD CON_999999999: .ifdef CBM1 .byte $9E,$6E,$6B,$27,$FE .else .byte $9E,$6E,$6B,$27,$FD .endif CON_BILLION: .byte $9E,$6E,$6B,$28,$00 .endif INPRT: .ifdef KBD jsr LFE0B .byte " in" .byte 0 .else lda #QT_IN jsr GOSTROUT2 .endif lda CURLIN+1 ldx CURLIN LINPRT: sta FAC+1 stx FAC+2 ldx #$90 sec jsr FLOAT2 jsr FOUT GOSTROUT2: jmp STROUT FOUT: ldy #$01 FOUT1: lda #$20 bit FACSIGN bpl L3C73 lda #$2D L3C73: sta $FF,y sta FACSIGN sty STRNG2 iny lda #$30 ldx FAC bne L3C84 jmp FOUT4 L3C84: lda #$00 cpx #$80 beq L3C8C bcs L3C95 L3C8C: lda #CON_BILLION jsr FMULT .ifdef CONFIG_SMALL lda #-6 ; exponent adjustment .else lda #-9 .endif L3C95: sta INDX L3C97: lda #CON_999999999 jsr FCOMP beq L3CBE bpl L3CB4 L3CA2: lda #CON_99999999_9 jsr FCOMP beq L3CAD bpl L3CBB L3CAD: jsr MUL10 dec INDX bne L3CA2 L3CB4: jsr DIV10 inc INDX bne L3C97 L3CBB: jsr FADDH L3CBE: jsr QINT ldx #$01 lda INDX clc .ifdef CONFIG_SMALL adc #$07 .else adc #$0A .endif bmi L3CD3 .ifdef CONFIG_SMALL cmp #$08 .else cmp #$0B .endif bcs L3CD4 adc #$FF tax lda #$02 L3CD3: sec L3CD4: sbc #$02 sta EXPON stx INDX txa beq L3CDF bpl L3CF2 L3CDF: ldy STRNG2 lda #$2E iny sta $FF,y txa beq L3CF0 lda #$30 iny sta $FF,y L3CF0: sty STRNG2 L3CF2: ldy #$00 LDD3A: ldx #$80 L3CF6: lda FAC_LAST clc .ifndef CONFIG_SMALL adc DECTBL+3,y sta FAC+4 lda FAC+3 .endif adc DECTBL+2,y sta FAC+3 lda FAC+2 adc DECTBL+1,y sta FAC+2 lda FAC+1 adc DECTBL,y sta FAC+1 inx bcs L3D1A bpl L3CF6 bmi L3D1C L3D1A: bmi L3CF6 L3D1C: txa bcc L3D23 eor #$FF adc #$0A L3D23: adc #$2F iny iny iny .ifndef CONFIG_SMALL iny .endif sty VARPNT ldy STRNG2 iny tax and #$7F sta $FF,y dec INDX bne L3D3E lda #$2E iny sta $FF,y L3D3E: sty STRNG2 ldy VARPNT txa eor #$FF and #$80 tax cpy #DECTBL_END-DECTBL .ifdef CONFIG_CBM_ALL beq LDD96 cpy #$3C .endif bne L3CF6 LDD96: ldy STRNG2 L3D4E: lda $FF,y dey cmp #$30 beq L3D4E cmp #$2E beq L3D5B iny L3D5B: lda #$2B ldx EXPON beq L3D8F bpl L3D6B lda #$00 sec sbc EXPON tax lda #$2D L3D6B: sta STACK+1,y lda #$45 sta STACK,y txa ldx #$2F sec L3D77: inx sbc #$0A bcs L3D77 adc #$3A sta STACK+3,y txa sta STACK+2,y lda #$00 sta STACK+4,y beq L3D94 FOUT4: sta $FF,y L3D8F: lda #$00 sta STACK,y L3D94: lda #$00 ldy #$01 rts .ifdef CONFIG_SMALL CON_HALF: .byte $80,$00,$00,$00 DECTBL: .byte $FE,$79,$60 ; -100000 .byte $00,$27,$10 ; 10000 .byte $FF,$FC,$18 ; -1000 .byte $00,$00,$64 ; 100 .byte $FF,$FF,$F6 ; -10 .byte $00,$00,$01 ; 1 DECTBL_END: .else CON_HALF: .byte $80,$00,$00,$00,$00 DECTBL: .byte $FA,$0A,$1F,$00,$00,$98,$96,$80 .byte $FF,$F0,$BD,$C0,$00,$01,$86,$A0 .byte $FF,$FF,$D8,$F0,$00,$00,$03,$E8 .byte $FF,$FF,$FF,$9C,$00,$00,$00,$0A .byte $FF,$FF,$FF,$FF DECTBL_END: .endif .ifdef CONFIG_CBM_ALL .byte $FF,$DF,$0A,$80 ; TI$ .byte $00,$03,$4B,$C0 .byte $FF,$FF,$73,$60 .byte $00,$00,$0E,$10 .byte $FF,$FF,$FD,$A8 .byte $00,$00,$00,$3C .endif .ifdef CBM2_KBD C_ZERO = CON_HALF + 2 .endif SQR: jsr COPY_FAC_TO_ARG_ROUNDED lda #CON_HALF jsr LOAD_FAC_FROM_YA FPWRT: beq EXP lda ARG bne L3DD5 jmp STA_IN_FAC_SIGN_AND_EXP L3DD5: ldx #TEMP3 ldy #$00 jsr STORE_FAC_AT_YX_ROUNDED lda ARGSIGN bpl L3DEF jsr INT lda #TEMP3 ldy #$00 jsr FCOMP bne L3DEF tya ldy CHARAC L3DEF: jsr MFA tya pha jsr LOG lda #TEMP3 ldy #$00 jsr FMULT jsr EXP pla lsr a bcc L3E0F NEGOP: lda FAC beq L3E0F lda FACSIGN eor #$FF sta FACSIGN L3E0F: rts .ifdef CONFIG_SMALL CON_LOG_E: .byte $81,$38,$AA,$3B POLY_EXP: .byte $06 .byte $74,$63,$90,$8C .byte $77,$23,$0C,$AB .byte $7A,$1E,$94,$00 .byte $7C,$63,$42,$80 .byte $7E,$75,$FE,$D0 .byte $80,$31,$72,$15 .byte $81,$00,$00,$00 .else CON_LOG_E: .byte $81,$38,$AA,$3B,$29 POLY_EXP: .byte $07 .byte $71,$34,$58,$3E,$56 .byte $74,$16,$7E,$B3,$1B .byte $77,$2F,$EE,$E3,$85 .byte $7A,$1D,$84,$1C,$2A .byte $7C,$63,$59,$58,$0A .byte $7E,$75,$FD,$E7,$C6 .byte $80,$31,$72,$18,$10 .byte $81,$00,$00,$00,$00 .endif EXP: lda #CON_LOG_E jsr FMULT lda FACEXTENSION adc #$50 bcc L3E4E jsr INCREMENT_MANTISSA L3E4E: sta ARGEXTENSION jsr MAF lda FAC cmp #$88 bcc L3E5C L3E59: jsr OUTOFRNG L3E5C: jsr INT lda CHARAC clc adc #$81 beq L3E59 sec sbc #$01 pha ldx #BYTES_FP L3E6C: lda ARG,x ldy FAC,x sta FAC,x sty ARG,x dex bpl L3E6C lda ARGEXTENSION sta FACEXTENSION jsr FSUBT jsr NEGOP lda #POLY_EXP jsr POLYNOMIAL lda #$00 sta STRNG1 pla jsr ADD_EXPONENTS1 rts POLYNOMIAL_ODD: sta STRNG2 sty STRNG2+1 jsr STORE_FAC_IN_TEMP1_ROUNDED lda #TEMP1+(5-BYTES_FP) jsr FMULT jsr SERMAIN lda #TEMP1+(5-BYTES_FP) ldy #$00 jmp FMULT POLYNOMIAL: sta STRNG2 sty STRNG2+1 SERMAIN: jsr STORE_FAC_IN_TEMP2_ROUNDED lda (STRNG2),y sta SERLEN ldy STRNG2 iny tya bne L3EBA inc STRNG2+1 L3EBA: sta STRNG2 ldy STRNG2+1 L3EBE: jsr FMULT lda STRNG2 ldy STRNG2+1 clc adc #BYTES_FP bcc L3ECB iny L3ECB: sta STRNG2 sty STRNG2+1 jsr FADD lda #TEMP2 ldy #$00 dec SERLEN bne L3EBE L3EDA: rts .ifndef KBD CONRND1: .byte $98,$35,$44,$7A CONRND2: .byte $68,$28,$B1,$46 .endif RND: .ifdef KBD ldx #$10 jsr SIGN beq LFC26 bmi LFC10 lda $87 ldy $88 LFBFA: sta FAC+2 sty FAC+1 LFBFE: asl a asl a eor FAC+2 asl a eor FAC+1 asl a asl a asl a asl a eor FAC+1 asl a rol FAC+2 rol FAC+1 LFC10: lda FAC+2 dex bne LFBFE sta $87 sta FAC+3 lda FAC+1 sta $88 lda #$80 sta FAC stx FACSIGN jmp NORMALIZE_FAC2 LFC26: ldy $03CA lda $03C7 ora #$01 GOMOVMF: bne LFBFA .byte $F0 .else jsr SIGN .ifdef CONFIG_CBM_ALL bmi L3F01 bne LDF63 lda ENTROPY sta FAC+1 lda ENTROPY+4 sta FAC+2 lda ENTROPY+1 sta FAC+3 lda ENTROPY+5 sta FAC+4 jmp LDF88 LDF63: .else tax bmi L3F01 .endif lda #CONRND1 jsr FMULT lda #CONRND2 jsr FADD L3F01: ldx FAC_LAST lda FAC+1 sta FAC_LAST stx FAC+1 .ifdef CONFIG_CBM_ALL ldx FAC+2 lda FAC+3 sta FAC+2 stx FAC+3 LDF88: .endif lda #$00 sta FACSIGN lda FAC sta FACEXTENSION lda #$80 sta FAC jsr NORMALIZE_FAC2 ldx #RNDSEED ldy #$00 GOMOVMF: jmp STORE_FAC_AT_YX_ROUNDED .endif SIN_COS_TAN_ATN: COS: lda #CON_PI_HALF jsr FADD SIN: jsr COPY_FAC_TO_ARG_ROUNDED lda #CON_PI_DOUB ldx ARGSIGN jsr DIV jsr COPY_FAC_TO_ARG_ROUNDED jsr INT lda #$00 sta STRNG1 jsr FSUBT lda #QUARTER jsr FSUB lda FACSIGN pha bpl SIN1 jsr FADDH lda FACSIGN bmi L3F5B lda CPRMASK eor #$FF sta CPRMASK SIN1: jsr NEGOP L3F5B: lda #QUARTER jsr FADD pla bpl L3F68 jsr NEGOP L3F68: lda #POLY_SIN jmp POLYNOMIAL_ODD TAN: jsr STORE_FAC_IN_TEMP1_ROUNDED lda #$00 sta CPRMASK jsr SIN ldx #TEMP3 ldy #$00 jsr GOMOVMF lda #TEMP1+(5-BYTES_FP) ldy #$00 jsr LOAD_FAC_FROM_YA lda #$00 sta FACSIGN lda CPRMASK jsr TAN1 lda #TEMP3 ldy #$00 jmp FDIV TAN1: pha jmp SIN1 .ifdef CONFIG_SMALL CON_PI_HALF: .byte $81,$49,$0F,$DB CON_PI_DOUB: .byte $83,$49,$0F,$DB QUARTER: .byte $7F,$00,$00,$00 POLY_SIN: .byte $04,$86,$1E,$D7,$FB,$87,$99,$26 .byte $65,$87,$23,$34,$58,$86,$A5,$5D .byte $E1,$83,$49,$0F,$DB .else CON_PI_HALF: .byte $81,$49,$0F,$DA,$A2 CON_PI_DOUB: .byte $83,$49,$0F,$DA,$A2 QUARTER: .byte $7F,$00,$00,$00,$00 POLY_SIN: .byte $05,$84,$E6,$1A,$2D,$1B,$86,$28 .byte $07,$FB,$F8,$87,$99,$68,$89,$01 .byte $87,$23,$35,$DF,$E1,$86,$A5,$5D .byte $E7,$28,$83,$49,$0F,$DA,$A2 .ifndef CONFIG_CBM_ALL MICROSOFT: .byte $A6,$D3,$C1,$C8,$D4,$C8,$D5,$C4 .byte $CE,$CA .endif .ifdef CBM2 MICROSOFT: .byte $A1,$54,$46,$8F,$13,$8F,$52,$43 .byte $89,$CD .endif .endif ATN: lda FACSIGN pha bpl L3FDB jsr NEGOP L3FDB: lda FAC pha cmp #$81 bcc L3FE9 lda #CON_ONE jsr FDIV L3FE9: lda #POLY_ATN jsr POLYNOMIAL_ODD pla cmp #$81 bcc L3FFC lda #CON_PI_HALF jsr FSUB L3FFC: pla bpl L4002 jmp NEGOP L4002: rts POLY_ATN: .ifdef CONFIG_SMALL .byte $08 .byte $78,$3A,$C5,$37 .byte $7B,$83,$A2,$5C .byte $7C,$2E,$DD,$4D .byte $7D,$99,$B0,$1E .byte $7D,$59,$ED,$24 .byte $7E,$91,$72,$00 .byte $7E,$4C,$B9,$73 .byte $7F,$AA,$AA,$53 .byte $81,$00,$00,$00 .else .byte $0B .byte $76,$B3,$83,$BD,$D3 .byte $79,$1E,$F4,$A6,$F5 .byte $7B,$83,$FC,$B0,$10 .byte $7C,$0C,$1F,$67,$CA .byte $7C,$DE,$53,$CB,$C1 .byte $7D,$14,$64,$70,$4C .byte $7D,$B7,$EA,$51,$7A .byte $7D,$63,$30,$88,$7E .byte $7E,$92,$44,$99,$3A .byte $7E,$4C,$CC,$91,$C7 .byte $7F,$AA,$AA,$AA,$13 .byte $81,$00,$00,$00,$00 .ifdef KIM .byte $00 ; XXX .endif .endif RAMSTART1: GENERIC_CHRGET: inc TXTPTR bne L4047 inc TXTPTR+1 L4047: lda $EA60 .ifdef KBD jsr LF430 .endif cmp #$3A bcs L4058 cmp #$20 beq GENERIC_CHRGET sec sbc #$30 sec sbc #$D0 L4058: rts .ifndef KBD ; random number seed .ifdef OSI .byte $80,$4F,$C7,$52 .endif .ifdef CONFIG_11 .byte $80,$4F,$C7,$52,$58 .endif .ifdef CBM1 .byte $80,$4F,$C7,$52,$59 .endif .endif GENERIC_CHRGET_END: .ifdef KBD LFD3E: php jmp FNDLIN .endif COLD_START: .ifdef KBD lda #$81 sta $03A0 lda #$FD sta $03A1 lda #$20 sta $0480 lda $0352 sta $04 lda $0353 sta $05 .else .ifndef CONFIG_CBM_ALL lda #QT_WRITTEN_BY jsr STROUT .endif COLD_START2: .ifndef CBM2 ldx #$FF stx CURLIN+1 .endif .if INPUTBUFFER >= $0100 ldx #$FB .endif txs .ifndef CONFIG_CBM_ALL lda #COLD_START2 sta Z00+1 sty Z00+2 sta GOWARM+1 sty GOWARM+2 lda #AYINT sta GOSTROUT sty GOSTROUT+1 lda #GIVAYF sta GOGIVEAYF sty GOGIVEAYF+1 .endif lda #$4C .ifdef CONFIG_CBM_ALL sta JMPADRS sta Z00 .else sta Z00 sta GOWARM sta JMPADRS .endif .ifdef APPLE sta L000A .endif .ifdef CONFIG_SMALL sta USR lda #$88 ldy #$AE sta $0B sty $0C .endif .ifdef CONFIG_CBM_ALL lda #IQERR .endif .ifdef APPLE lda #L29D0 .endif .ifdef CBM_APPLE sta L0001 sty L0001+1 .endif .ifndef CONFIG_CBM_ALL .ifdef APPLE lda #$28 .else lda #$48 .endif sta Z17 .ifdef APPLE lda #$0E .else lda #$38 .endif sta Z18 .endif .ifdef CBM2_KBD lda #$28 sta $0F lda #$1E sta $10 .endif .endif .ifdef CONFIG_SMALL .ifdef KBD ldx #GENERIC_CHRGET_END-GENERIC_CHRGET+4 .else ldx #GENERIC_CHRGET_END-GENERIC_CHRGET .endif .else ldx #GENERIC_CHRGET_END-GENERIC_CHRGET-1 ; XXX .endif L4098: lda GENERIC_CHRGET-1,x sta STRNG2+1,x dex bne L4098 .ifdef CBM2_KBD lda #$03 sta DSCLEN .endif .ifndef KBD txa sta SHIFTSIGNEXT .ifdef CONFIG_CBM_ALL sta Z03 .endif sta LASTPT+1 .if .defined(CONFIG_NULL) || .defined(CBM1) sta Z15 .endif .ifndef CONFIG_11 sta Z16 .endif pha sta Z14 .ifdef CBM2_KBD inx stx $01FD stx $01FC .else lda #$03 sta DSCLEN .ifndef KIM_APPLE lda #$2C sta LINNUM+1 .endif jsr CRDO .endif .ifdef APPLE lda #$01 sta $01FD sta $01FC .endif ldx #TEMPST stx TEMPPT .ifndef CONFIG_CBM_ALL lda #QT_MEMORY_SIZE jsr STROUT .ifdef APPLE jsr INLINX .else jsr NXIN .endif stx TXTPTR sty TXTPTR+1 jsr CHRGET cmp #$41 beq COLD_START tay bne L40EE .endif .ifndef CBM2_KBD lda #RAMSTART2 .ifdef CBM2_KBD sta $28 sty $29 .endif sta LINNUM sty LINNUM+1 .ifdef CBM2_KBD tay .else ldy #$00 .endif L40D7: inc LINNUM bne L40DD inc LINNUM+1 .ifdef CBM1 lda $09 cmp #$80 beq L40FA .endif .ifdef CBM2_KBD bmi L40FA .endif L40DD: .ifdef CBM2_KBD lda #$55 .else lda #$92 .endif sta (LINNUM),y cmp (LINNUM),y bne L40FA asl a sta (LINNUM),y cmp (LINNUM),y .ifdef CONFIG_CBM_ALL beq L40D7 .endif .ifdef CONFIG_SMALL beq L40D7 bne L40FA .endif .ifdef KIM_APPLE bne L40FA beq L40D7 .endif L40EE: .ifndef CONFIG_CBM_ALL jsr CHRGOT jsr LINGET tay beq L40FA jmp SYNERR .endif L40FA: lda LINNUM ldy LINNUM+1 sta MEMSIZ sty MEMSIZ+1 sta FRETOP sty FRETOP+1 L4106: .ifndef CONFIG_CBM_ALL .ifdef APPLE lda #$FF jmp L2829 .word STROUT ; PATCH! jsr NXIN .else lda #QT_TERMINAL_WIDTH jsr STROUT jsr NXIN .endif stx TXTPTR sty TXTPTR+1 jsr CHRGET tay beq L4136 jsr LINGET lda LINNUM+1 bne L4106 lda LINNUM cmp #$10 bcc L4106 L2829: sta Z17 L4129: sbc #$0E bcs L4129 eor #$FF sbc #$0C clc adc Z17 sta Z18 L4136: .endif .ifndef KIM ldx #RAMSTART3 .else lda #QT_WANT jsr STROUT jsr NXIN stx TXTPTR sty TXTPTR+1 jsr CHRGET ldx #RAMSTART1 cmp #'Y' beq L4183 cmp #'A' beq L4157 cmp #'N' bne L4136 L4157: ldx #IQERR stx UNFNC+26 sty UNFNC+26+1 ldx #ATN cmp #'A' beq L4183 ldx #IQERR stx UNFNC+20 sty UNFNC+20+1 stx UNFNC+20+1+3 sty UNFNC+20+1+3+1 stx UNFNC+20+1+1 sty UNFNC+20+1+1+1 ldx #SIN_COS_TAN_ATN L4183: .endif stx TXTTAB sty TXTTAB+1 ldy #$00 tya sta (TXTTAB),y inc TXTTAB .ifndef CBM2_KBD bne L4192 inc TXTTAB+1 L4192: .endif lda TXTTAB ldy TXTTAB+1 jsr REASON .ifdef CBM2_KBD lda #QT_BASIC jsr STROUT .else jsr CRDO .endif lda MEMSIZ sec sbc TXTTAB tax lda MEMSIZ+1 sbc TXTTAB+1 jsr LINPRT lda #QT_BYTES_FREE jsr STROUT .ifndef CONFIG_SCRTCH_ORDER jsr SCRTCH .endif .ifdef CONFIG_CBM_ALL jmp RESTART .else lda #STROUT sta GOWARM+1 sty GOWARM+2 .ifdef CONFIG_SCRTCH_ORDER jsr SCRTCH .endif lda #RESTART sta Z00+1 sty Z00+2 jmp (Z00+1) .endif .ifndef CBM_APPLE QT_WANT: .byte "WANT SIN-COS-TAN-ATN" .byte $00 .endif QT_WRITTEN_BY: .ifndef CONFIG_CBM_ALL .ifdef APPLE asc80 "COPYRIGHT 1977 BY MICROSOFT CO" .byte $0D,$00 .else .byte $0D,$0A,$0C .ifdef CONFIG_SMALL .byte "WRITTEN BY RICHARD W. WEILAND." .else .byte "WRITTEN BY WEILAND & GATES" .endif .byte $0D,$0A,$00 .endif QT_MEMORY_SIZE: .byte "MEMORY SIZE" .byte $00 QT_TERMINAL_WIDTH: .byte "TERMINAL WIDTH" .byte $00 .endif QT_BYTES_FREE: .byte " BYTES FREE" .ifndef CBM_APPLE .byte $0D,$0A,$0D,$0A .endif .ifdef CBM2_KBD .byte $0D,$00 .endif .ifdef APPLE .byte $00 .endif QT_BASIC: .ifdef OSI .byte "OSI 6502 BASIC VERSION 1.0 REV 3.2" .endif .ifdef KIM .byte "MOS TECH 6502 BASIC V1.1" .endif .ifdef CBM1 .byte $13 .byte "*** COMMODORE BASIC ***" .byte $11,$11,$11,$00 .endif .ifdef CBM2 .byte "### COMMODORE BASIC ###" .byte $0D,$0D,$00 .endif .ifdef APPLE .byte $0A,$0D,$0A .byte "APPLE BASIC V1.1" .endif .ifndef CONFIG_CBM_ALL .byte $0D,$0A .byte "COPYRIGHT 1977 BY MICROSOFT CO." .byte $0D,$0A,$00 .endif .endif /* KBD */ .ifdef OSI .byte $00,$00 LBEE4: lda LBF05 lsr a bcc LBEE4 lda $FB03 sta $FB07 and #$7F rts pha LBEF4: lda $FB05 bpl LBEF4 pla sta $FB04 rts lda $FB06 lda #$FF .byte $8D .byte $05 LBF05: .byte $FB rts LBF07: lda $FC00 lsr a bcc LBF07 lda $FC01 beq LBF07 and #$7F rts pha LBF16: lda $FC00 lsr a lsr a bcc LBF16 pla sta $FC01 rts lda #$03 sta $FC00 lda #$B1 sta $FC00 rts sta $0202 pha txa pha tya pha lda $0202 beq LBF6D ldy $0206 beq LBF47 LBF3F: ldx #$40 LBF41: dex bne LBF41 dey bne LBF3F LBF47: cmp #$0A beq LBF76 cmp #$0D bne LBF55 jsr LBFD5 jmp LBF6D LBF55: sta $0201 jsr LBFC2 inc $0200 lda $FFE1 clc adc $FFE0 cmp $0200 bmi LBF73 LBF6A: jsr LBFDE LBF6D: pla tay pla tax pla rts LBF73: jsr LBFD8 LBF76: jsr LBFC2 lda $FFE0 and #$E0 sta $0202 ldx #$07 LBF83: lda LBFF3,x sta L0207,x dex bpl LBF83 ldx LBFFB,y lda #$20 ldy $FFE1 cpy #$20 bmi LBF99 asl a LBF99: sta $0208 ldy #$00 LBF9E: jsr L0207 bne LBF9E inc $0209 inc $020C cpx $0209 bne LBF9E LBFAE: jsr L0207 cpy $0202 bne LBFAE lda #$20 LBFB8: jsr L020A dec $0208 bne LBFB8 beq LBF6A LBFC2: ldx $0200 lda $0201 LBFC8: ldy $FFE2 bne LBFD1 sta $D300,x rts LBFD1: sta $D700,x rts LBFD5: jsr LBFC2 LBFD8: lda $FFE0 sta $0200 LBFDE: ldx $0200 lda $D300,x ldy $FFE2 beq LBFEC lda $D700,x LBFEC: sta $0201 lda #$5F bne LBFC8 LBFF3: lda $D000,y sta $D000,y iny rts LBFFB: .byte $D3 .byte $D7 brk brk brk .endif /* CONFIG_SMALL */ .ifdef KIM RAMSTART2: .byte $08,$29,$25,$20,$60,$2A,$E5,$E4 .byte $20,$66,$24,$65,$AC,$04,$A4 .endif /* KIM */ .ifdef CONFIG_CBM1_PATCHES PATCH1: clc jmp CONTROL_C_TYPED PATCH2: bit $B4 bpl LE1AA cmp #$54 bne LE1AA jmp LCE3B LE1AA: rts PATCH3: bit $B4 bmi LE1B2 jmp LCE90 LE1B2: cmp #$54 beq LE1B9 jmp LCE82 LE1B9: jmp LCE69 PATCH4: sta CHARAC inx jmp LE1D9 PATCH5: bpl LE1C9 lda $8E ldy $8F rts LE1C9: ldy #$FF rts PATCH6: bne LE1D8 LE1CE: inc $05 bne LE1D8 lda $E2 sta $05 bne LE1CE LE1D8: rts LE1D9: stx $C9 pla pla tya jmp L2B1C .endif .ifdef KBD stx SHIFTSIGNEXT stx $0800 inx stx Z17 stx Z18 stx TXTTAB lda #$08 sta TXTTAB+1 jsr SCRTCH sta STACK+255 jsr LDE42 .byte $1B,$06,$01,$0C .byte "INTELLIVISION BASIC" .byte $0D,$0A,$0A .byte "Copyright Microsoft, Mattel 1980" .byte $0D,$0A,$00 sta $0435 sta $8F ldy #$0F lda #$FF sta ($04),y jsr LDE8C .byte $0C jmp RESTART OUTQUESSP: jsr OUTQUES jmp OUTSP LFDDA: ldy #$FF LFDDC: iny LFDDD: jsr LF43B cmp #$03 beq LFDF7 cmp #$20 bcs LFDEC sbc #$09 bne LFDDD LFDEC: sta Z00,y tax bne LFDDC jsr LE882 ldy #$06 LFDF7: tax clc rts LFDFA: bit $8F bmi LFE01 jsr LDE48 LFE01: bit $8F bvc LFE10 jmp LDE53 LFE08: jsr LFDFA LFE0B: jsr LDE24 bne LFE08 LFE10: rts VSAV: jsr GARBAG lda FRETOP sta $00 lda FRETOP+1 .byte $85 LFE1B: ora ($A5,x) .byte $2F sta $02 lda STREND+1 sta $03 ldy #$00 LFE26: lda ($00),y sta ($02),y inc $02 bne LFE30 inc $03 LFE30: inc $00 bne LFE26 inc $01 bit $01 bvc LFE26 ldx VARTAB ldy VARTAB+1 lda #$01 bne LFE50 PSAV: lda VARTAB sta $02 lda VARTAB+1 sta $03 ldx #$01 ldy #$08 lda #$02 LFE50: sta $0513 stx $0503 stx $00 sty $0504 sty $01 ldy #$0D lda #$00 LFE61: sta $0504,y dey bne LFE61 sty $0500 lda #$40 sta $0505 lda $02 sec sbc $00 sta $00 lda $03 sbc $01 sta $01 lsr a lsr a lsr a sta $03 jsr LE870 sta $02 jsr CHRGOT beq LFEA6 cmp #$2C beq L40FA jmp SYNERR L40FA: jsr CHRGET jsr LE870 sec sbc $02 cmp $03 bpl LFEBF lda #$27 sta JMPADRS jmp LFFBD LFEA6: lda $02 clc adc $03 jsr LE874 pha jsr LFE0B jsr L6874 .byte $72 adc $00,x pla tax lda #$00 jsr LINPRT LFEBF: ldx #$07 LBF83: dex lda VARTAB,x sec sbc TXTTAB,x sta $051B,x lda VARTAB+1,x sbc TXTTAB+1,x sta $051C,x dex bpl LBF83 txa sbc FRETOP sta $0521 lda #$3F sbc FRETOP+1 sta $0522 lda FRETOP sta $0523 lda FRETOP+1 sta $0524 ldx $02 jsr LFFDD jsr LFFD1 lda $01 ldx #$05 LFEF7: stx $0511 ldy #$E4 sec sbc #$08 sta $01 bpl LFF15 adc #$08 asl $00 rol a asl $00 rol a asl $00 rol a adc #$01 sta $0505 ldy #$00 LFF15: sty $0512 jsr LE4C0 ldx #$00 lda $01 bpl LFEF7 LFF21: rts VLOD: jsr LFFD1 stx JMPADRS lda VARTAB ldy VARTAB+1 ldx #$01 jsr LFF64 ldx #$00 ldy #$02 LFF34: jsr LE39A iny iny inx inx cpx #$05 bmi LFF34 lda STREND sta LOWTR lda STREND+1 sta LOWTR+1 lda FRETOP sta HIGHTR lda FRETOP+1 sta HIGHTR+1 lda #$FF sta HIGHDS lda #$3F sta HIGHDS+1 lda $0523 sta FRETOP lda $0524 sta FRETOP+1 jmp BLTU2 LFF64: sta $9A sty $9B stx $00 jsr LE870 jsr LFFDD lda JMPADRS beq LFF7F lda #$01 sta $9A lda #$08 sta $9B jsr STXTPT LFF7F: lda $9A sta $0503 lda $9B sta $0504 lda #$ED sta $0512 lda #$05 sta $01 LFF92: ldx $0512 beq LFF21 ldy #$04 jsr LE4C4 lda $01 cmp $0511 bne LFFB2 lda #$00 sta $01 lda $00 cmp $0513 beq LFF92 lda #$18 bne LFFB8 LFFB2: lda #$27 bne LFFB8 LFFB6: lda #$3C LFFB8: sta JMPADRS jsr CLEARC LFFBD: jsr LF422 sta $9A sty $9B lda #$00 tay sta ($9A),y iny sta ($9A),y ldx JMPADRS jmp ERROR LFFD1: ldx #$00 LFFD3: lda #$02 .byte $2C LFFD6: lda #$03 jsr LDE8C asl FACSIGN LFFDD: jsr CHRGOT beq LFFE5 jmp SYNERR LFFE5: lda #$0D ldy #$00 jsr LDE8C .byte $06 LFFED: lda $034C bmi LFFED ldy #$01 lda ($04),y bne LFFB6 rts .byte $FF .addr LC000 .addr LC000 .addr LC009 .endif .ifdef APPLE .byte 0,0,0 L2900: jsr LFD6A stx $33 ldx #$00 L2907: lda $0200,x and #$7F cmp #$0D bne L2912 lda #$00 L2912: sta $0200,x inx bne L2907 ldx $33 rts PLT: jmp L29F0 L291E: cmp #$47 bne L2925 jmp L29E0 L2925: cmp #$43 bne L292B beq L2988 L292B: cmp #$50 beq L2930 inx L2930: stx $33 L2932: jsr FRMEVL jsr ROUND_FAC jsr AYINT lda FAC+4 ldx $33 sta $0300,x dec $33 bmi L294Dx lda #$2C jsr SYNCHR bpl L2932 L294Dx: tay pla cmp #$43 bne L2957 tya jmp LF864 L2957: cmp #$50 bne L2962 tya ldy $0301 jmp LF800 L2962: pha lda $0301 sta $2C sta $2D pla cmp #$48 bne L2978 lda $0300 ldy $0302 jmp LF819 L2978: cmp #$56 beq L297F jmp SYNERR L297F: ldy $0300 lda $0302 jmp LF828 L2988: dex beq L2930 INLINX: jsr OUTQUES jsr OUTSP ldx #$80 jmp INLIN1 .byte 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 .byte 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 .byte 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 .byte 0,0,0,0,0,0,0,0,0,0 L29D0: jsr L29DA lda FAC+3 sta FAC+5 jmp (FAC+4) L29DA: jmp (GOSTROUT) brk brk brk L29E0: pla jmp LFB40 .byte 0,0,0,0,0,0,0,0,0,0,0,0 L29F0: pha ; 29F0 48 H ldx #$01 ; 29F1 A2 01 .. inc $B9 ; 29F3 E6 B9 .. bne L29F9 ; 29F5 D0 02 .. inc $BA ; 29F7 E6 BA .. L29F9: jmp L291E ; 29F9 4C 1E 29 L.) .byte $00,$00,$00,$00,$41,$53,$21,$D2 .byte $02,$FA,$00 lda $12 beq L2A0E jmp (L0008) L2A0E: jsr LF689 .byte $15,$BC,$08,$10,$52,$45,$75,$10 .byte $CD,$00,$55,$15,$9E,$08,$10,$4C .byte $45,$75,$10,$D4,$00,$55,$15,$0E .byte $08,$10,$89,$10,$75,$15,$1C,$08 .byte $10,$1F,$10,$75,$00 jmp (L0008) ; ---------------------------------------------------------------------------- .byte 0,0,0,0,0,0 .endif