; Microsoft BASIC for 6502 .debuginfo + .if .def(cbmbasic1) CBM1 := 1 .include "defines_cbm.s" .elseif .def(osi) OSI := 1 .include "defines_osi.s" .elseif .def(applesoft) APPLE := 1 .include "defines_apple.s" .elseif .def(kb9) KIM := 1 .include "defines_kim.s" .elseif .def(cbmbasic2) CBM2 := 1 .include "defines_cbm.s" .elseif .def(kbdbasic) KBD := 1 .include "defines_kbd.s" .endif .ifdef CONFIG_SMALL BYTES_FP := 4 .else BYTES_FP := 5 .endif .ifdef APPLE BYTES_PER_ELEMENT := 6 ; ??? .else BYTES_PER_ELEMENT := BYTES_FP .endif BYTES_PER_VARIABLE := BYTES_FP+2 MANTISSA_BYTES := BYTES_FP-1 BYTES_PER_FRAME := 2*BYTES_FP+8 FOR_STACK1 := 2*BYTES_FP+5 FOR_STACK2 := BYTES_FP+4 .ifdef CBM1 MAX_EXPON = 12 .else MAX_EXPON = 10 .endif .include "macros.s" .include "zeropage.s" .setcpu "6502" .macpack longbranch STACK := $0100 .segment "HEADER" .ifdef KBD jmp LE68C .byte $00,$13,$56 .endif .include "token.s" .include "error.s" .include "message.s" ; ---------------------------------------------------------------------------- ; CALLED BY "NEXT" AND "FOR" TO SCAN THROUGH ; THE STACK FOR A FRAME WITH THE SAME VARIABLE. ; ; (FORPNT) = ADDRESS OF VARIABLE IF "FOR" OR "NEXT" ; = $XXFF IF CALLED FROM "RETURN" ; <<< BUG: SHOULD BE $FFXX >>> ; ; RETURNS .NE. IF VARIABLE NOT FOUND, ; (X) = STACK PNTR AFTER SKIPPING ALL FRAMES ; ; .EQ. IF FOUND ; (X) = STACK PNTR OF FRAME FOUND ; ---------------------------------------------------------------------------- GTFORPNT: tsx inx inx inx inx L2279: lda STACK+1,x cmp #$81 bne L22A1 lda FORPNT+1 bne L228E lda STACK+2,x sta FORPNT lda STACK+3,x sta FORPNT+1 L228E: cmp STACK+3,x bne L229A lda FORPNT cmp STACK+2,x beq L22A1 L229A: txa clc adc #BYTES_PER_FRAME tax bne L2279 L22A1: rts ; ---------------------------------------------------------------------------- ; MOVE BLOCK OF MEMORY UP ; ; ON ENTRY: ; (Y,A) = (HIGHDS) = DESTINATION END+1 ; (LOWTR) = LOWEST ADDRESS OF SOURCE ; (HIGHTR) = HIGHEST SOURCE ADDRESS+1 ; ---------------------------------------------------------------------------- BLTU: jsr REASON sta STREND sty STREND+1 BLTU2: sec lda HIGHTR sbc LOWTR sta INDEX tay lda HIGHTR+1 sbc LOWTR+1 tax inx tya beq L22DD lda HIGHTR sec sbc INDEX sta HIGHTR bcs L22C6 dec HIGHTR+1 sec L22C6: lda HIGHDS sbc INDEX sta HIGHDS bcs L22D6 dec HIGHDS+1 bcc L22D6 L22D2: lda (HIGHTR),y sta (HIGHDS),y L22D6: dey bne L22D2 lda (HIGHTR),y sta (HIGHDS),y L22DD: dec HIGHTR+1 dec HIGHDS+1 dex bne L22D6 rts ; ---------------------------------------------------------------------------- ; CHECK IF ENOUGH ROOM LEFT ON STACK ; FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION ; ---------------------------------------------------------------------------- CHKMEM: asl a adc #SPACE_FOR_GOSUB bcs MEMERR sta INDEX tsx cpx INDEX bcc MEMERR rts ; ---------------------------------------------------------------------------- ; CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS ; (Y,A) = ADDR ARRAYS NEED TO GROW TO ; ---------------------------------------------------------------------------- REASON: cpy FRETOP+1 bcc L231E bne L22FC cmp FRETOP bcc L231E L22FC: pha ldx #FAC-TEMP1-1 tya L2300: pha lda TEMP1,x dex bpl L2300 jsr GARBAG ldx #TEMP1-FAC+1 L230B: pla sta FAC,x inx bmi L230B pla tay pla cpy FRETOP+1 bcc L231E bne MEMERR cmp FRETOP bcs MEMERR L231E: rts .include "program.s" ; ---------------------------------------------------------------------------- ; "FOR" STATEMENT ; ; FOR PUSHES 18 BYTES ON THE STACK: ; 2 -- TXTPTR ; 2 -- LINE NUMBER ; 5 -- INITIAL (CURRENT) FOR VARIABLE VALUE ; 1 -- STEP SIGN ; 5 -- STEP VALUE ; 2 -- ADDRESS OF FOR VARIABLE IN VARTAB ; 1 -- FOR TOKEN ($81) ; ---------------------------------------------------------------------------- FOR: lda #$80 sta SUBFLG jsr LET jsr GTFORPNT bne L2619 txa adc #FOR_STACK1 tax txs L2619: pla pla lda #FOR_STACK2 jsr CHKMEM jsr DATAN clc tya adc TXTPTR pha lda TXTPTR+1 adc #$00 pha lda CURLIN+1 pha lda CURLIN pha lda #TOKEN_TO jsr SYNCHR jsr CHKNUM jsr FRMNUM lda FACSIGN ora #$7F and FAC+1 sta FAC+1 lda #STEP sta INDEX sty INDEX+1 jmp FRM_STACK3 ; ---------------------------------------------------------------------------- ; "STEP" PHRASE OF "FOR" STATEMENT ; ---------------------------------------------------------------------------- STEP: lda #CON_ONE jsr LOAD_FAC_FROM_YA jsr CHRGOT cmp #TOKEN_STEP bne L2665 jsr CHRGET jsr FRMNUM L2665: jsr SIGN jsr FRM_STACK2 lda FORPNT+1 pha lda FORPNT pha lda #$81 pha ; ---------------------------------------------------------------------------- ; PERFORM NEXT STATEMENT ; ---------------------------------------------------------------------------- NEWSTT: jsr ISCNTC lda TXTPTR ldy TXTPTR+1 .ifdef CBM2_KBD cpy #>INPUTBUFFER .endif .ifdef CBM2 nop .endif .ifdef CBM2_KBD beq LC6D4 .else beq L2683 .endif sta OLDTEXT sty OLDTEXT+1 LC6D4: ldy #$00 L2683: lda (TXTPTR),y .ifndef CONFIG_11 beq LA5DC cmp #$3A beq NEWSTT2 SYNERR1: jmp SYNERR LA5DC: .else bne COLON .endif ldy #$02 lda (TXTPTR),y clc .ifdef CBM2_KBD jeq L2701 .else beq L2701 .endif iny lda (TXTPTR),y sta CURLIN iny lda (TXTPTR),y sta CURLIN+1 tya adc TXTPTR sta TXTPTR bcc NEWSTT2 inc TXTPTR+1 NEWSTT2: jsr CHRGET jsr EXECUTE_STATEMENT jmp NEWSTT ; ---------------------------------------------------------------------------- ; EXECUTE A STATEMENT ; ; (A) IS FIRST CHAR OF STATEMENT ; CARRY IS SET ; ---------------------------------------------------------------------------- EXECUTE_STATEMENT: .ifndef CONFIG_11_NOAPPLE beq RET1 .ifndef APPLE sec .endif .else beq RET2 .endif EXECUTE_STATEMENT1: sbc #$80 .ifndef CONFIG_11 jcc LET .else bcc LET1 .endif cmp #NUM_TOKENS .ifdef CBM2_KBD bcs LC721 .else bcs SYNERR1 .endif asl a tay lda TOKEN_ADDRESS_TABLE+1,y pha lda TOKEN_ADDRESS_TABLE,y pha jmp CHRGET .ifdef CONFIG_11 LET1: jmp LET COLON: cmp #$3A beq NEWSTT2 SYNERR1: jmp SYNERR .endif .ifdef CBM2_KBD LC721: .ifdef KBD cmp #$45 .else cmp #$4B .endif bne SYNERR1 jsr CHRGET lda #TOKEN_TO jsr SYNCHR jmp GOTO .endif ; ---------------------------------------------------------------------------- ; "RESTORE" STATEMENT ; ---------------------------------------------------------------------------- RESTORE: sec lda TXTTAB sbc #$01 ldy TXTTAB+1 bcs SETDA dey SETDA: sta DATPTR sty DATPTR+1 RET2: rts .ifndef CONFIG_CBM_ALL ; ---------------------------------------------------------------------------- ; SEE IF CONTROL-C TYPED ; ---------------------------------------------------------------------------- ISCNTC: .endif .ifdef KBD jsr LE8F3 bcc RET1 LE633: jsr LDE7F beq STOP cmp #$03 bne LE633 .endif .ifdef OSI jmp MONISCNTC nop nop nop nop lsr a bcc RET2 jsr GETLN cmp #$03 .endif .ifdef APPLE lda $C000 cmp #$83 beq L0ECC rts L0ECC: jsr RDKEY cmp #$03 .endif .ifdef KIM lda #$01 bit $1740 bmi RET2 ldx #$08 lda #$03 clc cmp #$03 .endif ; ---------------------------------------------------------------------------- ; "STOP" STATEMENT ; ---------------------------------------------------------------------------- STOP: bcs END2 ; ---------------------------------------------------------------------------- ; "END" STATEMENT ; ---------------------------------------------------------------------------- END: clc END2: bne RET1 lda TXTPTR ldy TXTPTR+1 .ifdef CBM2_KBD ldx CURLIN+1 inx .endif beq END4 sta OLDTEXT sty OLDTEXT+1 CONTROL_C_TYPED: lda CURLIN ldy CURLIN+1 sta OLDLIN sty OLDLIN+1 END4: pla pla L2701: lda #QT_BREAK .ifndef KBD ldx #$00 stx Z14 .endif bcc L270E jmp PRINT_ERROR_LINNUM L270E: jmp RESTART .ifdef KBD LE664: tay jmp SNGFLT .endif ; ---------------------------------------------------------------------------- ; "CONT" COMMAND ; ---------------------------------------------------------------------------- CONT: bne RET1 ldx #ERR_CANTCONT ldy OLDTEXT+1 bne L271C jmp ERROR L271C: lda OLDTEXT sta TXTPTR sty TXTPTR+1 lda OLDLIN ldy OLDLIN+1 sta CURLIN sty CURLIN+1 RET1: rts .ifdef KBD PRT: jsr GETBYT txa ror a ror a ror a sta $8F rts LE68C: ldy #$12 LE68E: lda LEA30,y sta $03A2,y dey bpl LE68E rts .endif .if .def(CONFIG_NULL) || .def(CBM1) ; CBM1 has the keyword removed, ; but the code is, still here NULL: jsr GETBYT bne RET1 inx cpx #NULL_MAX bcs L2739 dex stx Z15 rts L2739: jmp IQERR .endif .ifndef CONFIG_11_NOAPPLE CLEAR: bne RET1 jmp CLEARC .endif .ifdef APPLE .include "apple_loadsave.s" .endif .ifdef KIM .include "kim_loadsave.s" .endif ; ---------------------------------------------------------------------------- ; "RUN" COMMAND ; ---------------------------------------------------------------------------- RUN: bne L27CF jmp SETPTRS L27CF: jsr CLEARC jmp L27E9 ; ---------------------------------------------------------------------------- ; "GOSUB" STATEMENT ; ; LEAVES 7 BYTES ON STACK: ; 2 -- RETURN ADDRESS (NEWSTT) ; 2 -- TXTPTR ; 2 -- LINE # ; 1 -- GOSUB TOKEN ; ---------------------------------------------------------------------------- GOSUB: lda #$03 jsr CHKMEM lda TXTPTR+1 pha lda TXTPTR pha lda CURLIN+1 pha lda CURLIN pha lda #TOKEN_GOSUB pha L27E9: jsr CHRGOT jsr GOTO jmp NEWSTT ; ---------------------------------------------------------------------------- ; "GOTO" STATEMENT ; ALSO USED BY "RUN" AND "GOSUB" ; ---------------------------------------------------------------------------- GOTO: jsr LINGET jsr REMN lda CURLIN+1 cmp LINNUM+1 bcs L2809 tya sec adc TXTPTR ldx TXTPTR+1 bcc L280D inx bcs L280D L2809: lda TXTTAB ldx TXTTAB+1 L280D: .ifdef KBD jsr LF457 bne UNDERR .else jsr FL1 bcc UNDERR .endif lda LOWTRX sbc #$01 sta TXTPTR lda LOWTRX+1 sbc #$00 sta TXTPTR+1 L281E: rts ; ---------------------------------------------------------------------------- ; "POP" AND "RETURN" STATEMENTS ; ---------------------------------------------------------------------------- POP: bne L281E lda #$FF .ifdef CBM2_KBD sta FORPNT+1 ; bugfix, wrong in AppleSoft .else sta FORPNT .endif jsr GTFORPNT txs cmp #TOKEN_GOSUB beq RETURN ldx #ERR_NOGOSUB .byte $2C UNDERR: ldx #ERR_UNDEFSTAT jmp ERROR ; ---------------------------------------------------------------------------- SYNERR2: jmp SYNERR ; ---------------------------------------------------------------------------- RETURN: pla pla sta CURLIN pla sta CURLIN+1 pla sta TXTPTR pla sta TXTPTR+1 ; ---------------------------------------------------------------------------- ; "DATA" STATEMENT ; EXECUTED BY SKIPPING TO NEXT COLON OR EOL ; ---------------------------------------------------------------------------- DATA: jsr DATAN ; ---------------------------------------------------------------------------- ; ADD (Y) TO TXTPTR ; ---------------------------------------------------------------------------- ADDON: tya clc adc TXTPTR sta TXTPTR bcc L2852 inc TXTPTR+1 L2852: rts ; ---------------------------------------------------------------------------- ; SCAN AHEAD TO NEXT ":" OR EOL ; ---------------------------------------------------------------------------- DATAN: ldx #$3A .byte $2C REMN: ldx #$00 stx CHARAC ldy #$00 sty ENDCHR L285E: lda ENDCHR ldx CHARAC sta CHARAC stx ENDCHR L2866: lda (TXTPTR),y beq L2852 cmp ENDCHR beq L2852 iny cmp #$22 .ifndef CONFIG_11 beq L285E bne L2866 .else bne L2866 beq L285E .endif ; ---------------------------------------------------------------------------- ; "IF" STATEMENT ; ---------------------------------------------------------------------------- IF: jsr FRMEVL jsr CHRGOT cmp #TOKEN_GOTO beq L2884 lda #TOKEN_THEN jsr SYNCHR L2884: lda FAC bne L288D ; ---------------------------------------------------------------------------- ; "REM" STATEMENT, OR FALSE "IF" STATEMENT ; ---------------------------------------------------------------------------- REM: jsr REMN beq ADDON L288D: jsr CHRGOT bcs L2895 jmp GOTO L2895: jmp EXECUTE_STATEMENT ; ---------------------------------------------------------------------------- ; "ON" STATEMENT ; ; ON GOTO ; ON GOSUB ; ---------------------------------------------------------------------------- ON: jsr GETBYT pha cmp #TOKEN_GOSUB beq L28A4 L28A0: cmp #TOKEN_GOTO bne SYNERR2 L28A4: dec FAC_LAST bne L28AC pla jmp EXECUTE_STATEMENT1 L28AC: jsr CHRGET jsr LINGET cmp #$2C beq L28A4 pla L28B7: rts ; ---------------------------------------------------------------------------- ; CONVERT LINE NUMBER ; ---------------------------------------------------------------------------- LINGET: ldx #$00 stx LINNUM stx LINNUM+1 L28BE: bcs L28B7 sbc #$2F sta CHARAC lda LINNUM+1 sta INDEX cmp #$19 bcs L28A0 ; <<<<>>>> ; NOTE THAT IF (A) = $AB ON THE LINE ABOVE, ; ON.1 WILL COMPARE = AND CAUSE A CATASTROPHIC ; JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS ; FOR OTHER CALLS TO LINGET. ; ; YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9, ; THEN TYPE "GO TO 437761". ; ; ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE ; THE PROBLEM. ($AB00 - $ABFF) ; <<<<>>>> lda LINNUM asl a rol INDEX asl a rol INDEX adc LINNUM sta LINNUM lda INDEX adc LINNUM+1 sta LINNUM+1 asl LINNUM rol LINNUM+1 lda LINNUM adc CHARAC sta LINNUM bcc L28EC inc LINNUM+1 L28EC: jsr CHRGET jmp L28BE ; ---------------------------------------------------------------------------- ; "LET" STATEMENT ; ; LET = ; = ; ---------------------------------------------------------------------------- LET: jsr PTRGET sta FORPNT sty FORPNT+1 lda #TOKEN_EQUAL jsr SYNCHR .ifndef CONFIG_SMALL lda VALTYP+1 pha .endif lda VALTYP pha jsr FRMEVL pla rol a jsr CHKVAL bne LETSTRING .ifndef CONFIG_SMALL pla LET2: bpl L2923 jsr ROUND_FAC jsr AYINT ldy #$00 lda FAC+3 sta (FORPNT),y iny lda FAC+4 sta (FORPNT),y rts L2923: .endif ; ---------------------------------------------------------------------------- ; REAL VARIABLE = EXPRESSION ; ---------------------------------------------------------------------------- jmp SETFOR LETSTRING: .ifndef CONFIG_SMALL pla ; ---------------------------------------------------------------------------- ; INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4 ; ---------------------------------------------------------------------------- PUTSTR: .endif .ifdef CONFIG_CBM_ALL ldy FORPNT+1 .ifdef CBM1 cpy #$D0 .else cpy #$DE .endif bne LC92B jsr FREFAC cmp #$06 .ifdef CBM2_KBD bne IQERR1 .else beq LC8E2 jmp IQERR LC8E2: .endif ldy #$00 sty FAC sty FACSIGN LC8E8: sty STRNG2 jsr LC91C jsr MUL10 inc STRNG2 ldy STRNG2 jsr LC91C jsr COPY_FAC_TO_ARG_ROUNDED tax beq LC902 inx txa jsr LD9BF LC902: ldy STRNG2 iny cpy #$06 bne LC8E8 jsr MUL10 jsr QINT ldx #$02 sei LC912: lda FAC+2,x .ifdef CBM2 sta $8D,x .else sta $0200,x .endif dex bpl LC912 cli rts LC91C: lda (INDEX),y jsr L00CF bcc LC926 IQERR1: jmp IQERR LC926: sbc #$2F jmp ADDACC LC92B: .endif ldy #$02 lda (FAC_LAST-1),y cmp FRETOP+1 bcc L2946 bne L2938 dey lda (FAC_LAST-1),y cmp FRETOP bcc L2946 L2938: ldy FAC_LAST cpy VARTAB+1 bcc L2946 bne L294D lda FAC_LAST-1 cmp VARTAB bcs L294D L2946: lda FAC_LAST-1 ldy FAC_LAST jmp L2963 L294D: ldy #$00 lda (FAC_LAST-1),y jsr STRINI lda DSCPTR ldy DSCPTR+1 sta STRNG1 sty STRNG1+1 jsr MOVINS lda #FAC ldy #$00 L2963: sta DSCPTR sty DSCPTR+1 jsr FRETMS ldy #$00 lda (DSCPTR),y sta (FORPNT),y iny lda (DSCPTR),y sta (FORPNT),y iny lda (DSCPTR),y sta (FORPNT),y rts .ifdef CONFIG_CBM_ALL PRINTH: jsr CMD jmp LCAD6 CMD: jsr GETBYT beq LC98F lda #$2C jsr SYNCHR LC98F: php jsr CHKOUT stx Z03 plp jmp PRINT .endif ; ---------------------------------------------------------------------------- PRSTRING: jsr STRPRT L297E: jsr CHRGOT ; ---------------------------------------------------------------------------- ; "PRINT" STATEMENT ; ---------------------------------------------------------------------------- PRINT: beq CRDO PRINT2: beq L29DD cmp #TOKEN_TAB beq L29F5 cmp #TOKEN_SPC .ifdef CBM2_KBD clc .endif beq L29F5 cmp #',' .ifdef KIM clc .endif beq L29DE cmp #$3B beq L2A0D jsr FRMEVL bit VALTYP bmi PRSTRING jsr FOUT jsr STRLIT .ifndef CONFIG_CBM_ALL ldy #$00 lda (FAC_LAST-1),y clc adc Z16 .ifdef KBD cmp #$28 .else cmp Z17 .endif bcc L29B1 jsr CRDO L29B1: .endif jsr STRPRT .ifdef KBD jmp L297E LE86C: pla jmp CONTROL_C_TYPED LE870: jsr GETBYT txa LE874: beq LE878 bpl LE8F2 LE878: jmp IQERR CRDO: lda #$0A sta $10 jsr OUTDO LE882: lda #$0D jsr OUTDO PRINTNULLS: lda #$00 sta $10 eor #$FF .else jsr OUTSP bne L297E L29B9: .ifdef CBM2 lda #$00 sta INPUTBUFFER,x ldx #<(INPUTBUFFER-1) ldy #>(INPUTBUFFER-1) .else .ifndef APPLE ldy #$00 sty INPUTBUFFER,x ldx #LINNUM+1 .endif .endif .ifdef CONFIG_CBM_ALL lda Z03 bne L29DD LC9D2: .endif CRDO: .ifdef CBM1 lda Z03 bne LC9D8 sta $05 LC9D8: .endif lda #$0D .ifndef CONFIG_CBM_ALL sta Z16 .endif jsr OUTDO .ifdef APPLE lda #$80 .else lda #$0A .endif jsr OUTDO PRINTNULLS: .ifdef CBM1 lda Z03 bne L29DD .endif .if .def(CONFIG_NULL) || .def(CBM1) txa pha ldx Z15 beq L29D9 lda #$00 L29D3: jsr OUTDO dex bne L29D3 L29D9: stx Z16 pla tax .else .ifdef APPLE lda #$00 sta $50 .endif eor #$FF .endif .endif L29DD: rts L29DE: lda Z16 .ifndef CONFIG_CBM_ALL .ifdef KBD cmp #$1A .else cmp Z18 .endif bcc L29EA jsr CRDO jmp L2A0D L29EA: .endif sec L29EB: .ifdef CONFIG_CBM_ALL sbc #$0A .else .ifdef KBD sbc #$0D .else sbc #$0E .endif .endif bcs L29EB eor #$FF adc #$01 bne L2A08 L29F5: .ifdef CONFIG_11_NOAPPLE php .else pha .endif jsr GTBYTC cmp #$29 .ifndef CONFIG_11_NOAPPLE .ifdef APPLE beq L1185 jmp SYNERR L1185: .else bne SYNERR4 .endif pla cmp #TOKEN_TAB .ifdef APPLE bne L2A09 .else bne L2A0A .endif .else .ifdef CBM2_KBD bne SYNERR4 .else beq @1 jmp SYNERR @1: .endif plp ;; XXX c64 has this bcc L2A09 .endif txa sbc Z16 bcc L2A0D .ifndef CONFIG_11 beq L2A0D .endif L2A08: tax .ifdef CONFIG_11 L2A09: inx .endif L2A0A: .ifndef CONFIG_11 jsr OUTSP .endif dex .ifndef CONFIG_11 bne L2A0A .else bne L2A13 .endif L2A0D: jsr CHRGET jmp PRINT2 .ifdef CONFIG_11 L2A13: jsr OUTSP bne L2A0A .endif ; ---------------------------------------------------------------------------- ; PRINT STRING AT (Y,A) ; ---------------------------------------------------------------------------- STROUT: jsr STRLIT ; ---------------------------------------------------------------------------- ; PRINT STRING AT (FACMO,FACLO) ; ---------------------------------------------------------------------------- STRPRT: jsr FREFAC tax ldy #$00 inx L2A22: dex beq L29DD lda (INDEX),y jsr OUTDO iny cmp #$0D bne L2A22 jsr PRINTNULLS jmp L2A22 ; ---------------------------------------------------------------------------- OUTSP: .ifdef CBM2 lda $0E beq LCA40 lda #$20 .byte $2C LCA40: .endif .ifdef CONFIG_CBM_ALL lda #$1D .else lda #$20 .endif .byte $2C OUTQUES: lda #$3F ; ---------------------------------------------------------------------------- ; PRINT CHAR FROM (A) ; ---------------------------------------------------------------------------- OUTDO: .ifndef KBD bit Z14 bmi L2A56 .endif .ifndef CBM2_KBD pha .endif .ifdef CBM1 cmp #$1D beq LCA6A cmp #$9D beq LCA5A cmp #$14 bne LCA64 LCA5A: lda $05 beq L2A4E lda Z03 bne L2A4E dec $05 LCA64: and #$7F .endif .ifndef CBM2 cmp #$20 bcc L2A4E .endif LCA6A: .ifdef CONFIG_CBM1_PATCHES lda Z03 jsr PATCH6 nop .endif .ifdef CONFIG_PRINT_CR lda Z16 cmp Z17 bne L2A4C .ifdef APPLE nop ; PATCH! nop ; don't print CR nop .else jsr CRDO .endif L2A4C: .endif .ifndef CONFIG_CBM_ALL inc Z16 .endif L2A4E: .ifndef CBM2_KBD pla .endif .ifdef KIM sty DIMFLG .endif .ifdef APPLE ora #$80 .endif jsr MONCOUT .ifdef APPLE and #$7F .endif .ifdef KIM ldy DIMFLG .endif .ifdef OSI nop nop nop nop .endif L2A56: and #$FF LE8F2: rts .ifdef KBD LE8F3: pha lda $047F clc beq LE900 lda #$00 sta $047F sec LE900: pla rts .endif .include "input.s" .include "eval.s" .include "memory.s" .include "array.s" ; ---------------------------------------------------------------------------- ; "FRE" FUNCTION ; ; COLLECTS GARBAGE AND RETURNS # BYTES OF MEMORY LEFT ; ---------------------------------------------------------------------------- FRE: lda VALTYP beq L3188 jsr FREFAC L3188: jsr GARBAG sec lda FRETOP sbc STREND tay lda FRETOP+1 sbc STREND+1 ; FALL INTO GIVAYF TO FLOAT THE VALUE ; NOTE THAT VALUES OVER 32767 WILL RETURN AS NEGATIVE ; ---------------------------------------------------------------------------- ; FLOAT THE SIGNED INTEGER IN A,Y ; ---------------------------------------------------------------------------- GIVAYF: ldx #$00 stx VALTYP sta FAC+1 sty FAC+2 ldx #$90 jmp FLOAT1 POS: ldy Z16 ; ---------------------------------------------------------------------------- ; FLOAT (Y) INTO FAC, GIVING VALUE 0-255 ; ---------------------------------------------------------------------------- SNGFLT: lda #$00 beq GIVAYF ; ---------------------------------------------------------------------------- ; CHECK FOR DIRECT OR RUNNING MODE ; GIVING ERROR IF DIRECT MODE ; ---------------------------------------------------------------------------- ERRDIR: ldx CURLIN+1 inx bne RTS9 ldx #ERR_ILLDIR .ifdef CBM2_KBD .byte $2C LD288: ldx #ERR_UNDEFFN .endif L31AF: jmp ERROR DEF: jsr FNC jsr ERRDIR jsr CHKOPN lda #$80 sta SUBFLG jsr PTRGET jsr CHKNUM jsr CHKCLS lda #TOKEN_EQUAL jsr SYNCHR .ifndef CONFIG_SMALL pha .endif lda VARPNT+1 pha lda VARPNT pha lda TXTPTR+1 pha lda TXTPTR pha jsr DATA jmp L3250 FNC: lda #TOKEN_FN jsr SYNCHR ora #$80 sta SUBFLG jsr PTRGET3 sta FNCNAM sty FNCNAM+1 jmp CHKNUM L31F3: jsr FNC lda FNCNAM+1 pha lda FNCNAM pha jsr PARCHK jsr CHKNUM pla sta FNCNAM pla sta FNCNAM+1 ldy #$02 .ifndef CBM2_KBD ldx #ERR_UNDEFFN .endif lda (FNCNAM),y .ifndef CBM2_KBD beq L31AF .endif sta VARPNT tax iny lda (FNCNAM),y .ifdef CBM2_KBD beq LD288 .endif sta VARPNT+1 .ifndef CONFIG_SMALL iny .endif L3219: lda (VARPNT),y pha dey bpl L3219 ldy VARPNT+1 jsr STORE_FAC_AT_YX_ROUNDED lda TXTPTR+1 pha lda TXTPTR pha lda (FNCNAM),y sta TXTPTR iny lda (FNCNAM),y sta TXTPTR+1 lda VARPNT+1 pha lda VARPNT pha jsr FRMNUM pla sta FNCNAM pla sta FNCNAM+1 jsr CHRGOT beq L324A jmp SYNERR L324A: pla sta TXTPTR pla sta TXTPTR+1 L3250: ldy #$00 pla sta (FNCNAM),y pla iny sta (FNCNAM),y pla iny sta (FNCNAM),y pla iny sta (FNCNAM),y .ifndef CONFIG_SMALL pla iny sta (FNCNAM),y .endif rts .include "string.s" .ifdef KBD LF422: lda VARTAB sec sbc #$02 ldy VARTAB+1 bcs LF42C dey LF42C: rts LF42D: lda Z00,x LF430: cmp #$61 bcc LF43A cmp #$7B bcs LF43A LF438: sbc #$1F LF43A: rts LF43B: ldx #$5D LF43D: txa and #$7F cmp $0340 beq LF44D sta $0340 lda #$03 jsr LDE48 LF44D: jsr LDE7F bne RTS4 cpx #$80 bcc LF44D RTS4: rts LF457: lda TXTTAB ldx TXTTAB+1 LF45B: sta JMPADRS+1 stx JMPADRS+2 ldy #$01 lda (JMPADRS+1),y beq LF438 iny iny lda (JMPADRS+1),y dey cmp $14 bne LF472 lda (JMPADRS+1),y cmp $13 LF472: bcs LF43A dey lda (JMPADRS+1),y tax dey lda (JMPADRS+1),y bcc LF45B LF47D: jmp (JMPADRS+1) .else ; ---------------------------------------------------------------------------- ; EVALUATE "EXP1,EXP2" ; ; CONVERT EXP1 TO 16-BIT NUMBER IN LINNUM ; CONVERT EXP2 TO 8-BIT NUMBER IN X-REG ; ---------------------------------------------------------------------------- GTNUM: jsr FRMNUM jsr GETADR ; ---------------------------------------------------------------------------- ; EVALUATE ",EXPRESSION" ; CONVERT EXPRESSION TO SINGLE BYTE IN X-REG ; ---------------------------------------------------------------------------- COMBYTE: jsr CHKCOM jmp GETBYT ; ---------------------------------------------------------------------------- ; CONVERT (FAC) TO A 16-BIT VALUE IN LINNUM ; ---------------------------------------------------------------------------- GETADR: lda FACSIGN .ifdef APPLE nop nop .else bmi GOIQ .endif lda FAC cmp #$91 bcs GOIQ jsr QINT lda FAC_LAST-1 ldy FAC_LAST sty LINNUM sta LINNUM+1 rts ; ---------------------------------------------------------------------------- ; "PEEK" FUNCTION ; ---------------------------------------------------------------------------- PEEK: .ifdef CBM2_KBD lda $12 pha lda $11 pha .endif jsr GETADR ldy #$00 .ifdef CBM1 cmp #$C0 bcc LD6F3 cmp #$E1 bcc LD6F6 LD6F3: .endif .ifdef CBM2_KBD nop ; patch that disables the compares above nop nop nop nop nop nop nop .endif lda (LINNUM),y tay .ifdef CBM2_KBD pla sta $11 pla sta $12 .endif LD6F6: jmp SNGFLT ; ---------------------------------------------------------------------------- ; "POKE" STATEMENT ; ---------------------------------------------------------------------------- POKE: jsr GTNUM txa ldy #$00 sta (LINNUM),y rts ; ---------------------------------------------------------------------------- ; "WAIT" STATEMENT ; ---------------------------------------------------------------------------- WAIT: jsr GTNUM stx FORPNT ldx #$00 jsr CHRGOT .ifdef CBM2 beq EASTER_EGG .else beq L3628 .endif jsr COMBYTE L3628: stx FORPNT+1 ldy #$00 L362C: lda (LINNUM),y eor FORPNT+1 and FORPNT beq L362C RTS3: rts .endif .include "float.s" .include "chrget.s" .include "rnd.s" .include "trig.s" .include "init.s"