; ; Microsoft 6809 Basic ; ; v0.00 LFD: Updated for running on RedBoard 6809. ; v0.01 JGH: Updated to assemble with Kingswood as09. ; v0.02 25-Nov-2014 JGH: Seperated out and moved I/O code to end. ; RAM check stops before overwriting code. ; 01-Dec-2014 JGH: Outputs DEL instead of BS for delete. ; 03-Dec-2014 JGH: Checks for Tube Escape, passes on *commands. ; Host errors caught, lost NewLines output. ; Tidied zero page initialisation. ; v0.03 04-Dec-2014 JGH: Tidied up host interface code, added target equates. ; Escape stops running program. Warm start prints ; startup message. ; 21-Dec-2014 JGH: Adjusts startup message if entered from Tube at Reset. ; *commands are not tokenised, without interfering with ; '*' multiply operator. ; v0.04 31-Dec-2014 JGH: Rearranged tokens back into original CoCo order. ; Added LOAD and SAVE. ; v0.05 06-Sep-2017 JGH: LOAD/SAVE checks for endianness of MOS. ; ; Notes: ; This code is not position-independant, absolute code and workspace references ; are made. ; The Basic program in memory has absolute links from line to line, so when ; saved program is reloaded, it assumes it is loaded back to the same address. ; -------------------------------------------------------------------------------- ; TARGET HOST SYSTEM H_TUBE EQU 1 ; 6809 Tube at FFxx H_ACIA EQU 0 ; ACIA/UART for keyboard in/out BSS UART: EQU $D000 RECEV: EQU UART+1 TRANS: EQU UART+1 USTAT: EQU UART UCTRL: EQU UART BS: EQU 8 ; BACKSPACE DELCHR: EQU 127 ; JGH: DELETE KEY CR: EQU $D ; ENTER KEY ESC: EQU $1B ; ESCAPE CODE SPACE: EQU $20 ; SPACE (BLANK) STKBUF: EQU 58 ; STACK BUFFER ROOM LBUFMX: EQU 250 ; MAX NUMBER OF CHARS IN A BASIC LINE MAXLIN: EQU $FA ; MAXIMUM MS BYTE OF LINE NUMBER * PSEUDO PSEUDO OPS SKP1: EQU $21 ; OP CODE OF BRN - SKIP ONE BYTE SKP2: EQU $8C ; OP CODE OF CMPX # - SKIP TWO BYTES SKP1LD: EQU $86 ; OP CODE OF LDA # - SKIP THE NEXT BYTE * AND LOAD THE VALUE OF THAT BYTE INTO ACCA - THIS * IS USUALLY USED TO LOAD ACCA WITH A NON-ZERO VALUE * REGISTER ADDRESSES ORG 0 ; CoCo addr ENDFLG RMB 1 ; $00 STOP/END FLAG: POSITIVE=STOP, NEG=END CHARAC: RMB 1 ; $01 TERMINATOR FLAG 1 ENDCHR: RMB 1 ; $02 TERMINATOR FLAG 2 TMPLOC: RMB 1 ; $03 SCRATCH VARIABLE IFCTR: RMB 1 ; $04 IF COUNTER - HOW MANY IF STATEMENTS IN A LINE DIMFLG: RMB 1 ; $05 *DV ARRAY FLAG 0=EVALUATE, 1=DIMENSIONING VALTYP RMB 1 ; $06 *DV *PV TYPE FLAG: 0=NUMERIC, $FF=STRING GARBFL: RMB 1 ; $07 *TV STRING SPACE HOUSEKEEPING FLAG ARYDIS RMB 1 ; $08 DISABLE ARRAY SEARCH: 00=ALLOW SEARCH INPFLG RMB 1 ; $09 *TV INPUT FLAG: READ=0, INPUT<>0 RELFLG: RMB 1 ; $0A *TV RELATIONAL OPERATOR FLAG TEMPPT: RMB 2 ; $0B *PV TEMPORARY STRING STACK POINTER LASTPT: RMB 2 ; $0D *PV ADDR OF LAST USED STRING STACK ADDRESS TEMPTR: RMB 2 ; $0F TEMPORARY POINTER TMPTR1: RMB 2 ; TEMPORARY DESCRIPTOR STORAGE (STACK SEARCH) FPA2: RMB 4 ; ; FLOATING POINT ACCUMULATOR #2 MANTISSA BOTSTK: RMB 2 ; ; BOTTOM OF STACK AT LAST CHECK TXTTAB: RMB 2 ; $19 *PV BEGINNING OF BASIC PROGRAM VARTAB: RMB 2 ; $1B *PV START OF VARIABLES ARYTAB: RMB 2 ; $1D *PV START OF ARRAYS ARYEND: RMB 2 ; $1F *PV END OF ARRAYS (+1) FRETOP: RMB 2 ; $21 *PV START OF STRING STORAGE (TOP OF FREE RAM) STRTAB: RMB 2 ; ; *PV START OF STRING VARIABLES FRESPC: RMB 2 ; ; UTILITY STRING POINTER MEMSIZ: RMB 2 ; ; *PV TOP OF STRING SPACE OLDTXT: RMB 2 ; $29 SAVED LINE NUMBER DURING A "STOP" BINVAL: RMB 2 ; ; BINARY VALUE OF A CONVERTED LINE NUMBER OLDPTR: RMB 2 ; ; SAVED INPUT PTR DURING A "STOP" TINPTR: RMB 2 ; ; TEMPORARY INPUT POINTER STORAGE DATTXT: RMB 2 ; $31 *PV 'DATA' STATEMENT LINE NUMBER POINTER DATPTR: RMB 2 ; $33 *PV 'DATA' STATEMENT ADDRESS POINTER DATTMP: RMB 2 ; $35 DATA POINTER FOR 'INPUT' & 'READ' VARNAM: RMB 2 ; $37 *TV TEMP STORAGE FOR A VARIABLE NAME VARPTR: RMB 2 ; $39 *TV POINTER TO A VARIABLE DESCRIPTOR VARDES: RMB 2 ; ; TEMP POINTER TO A VARIABLE DESCRIPTOR RELPTR: RMB 2 ; ; POINTER TO RELATIONAL OPERATOR PROCESSING ROUTINE TRELFL: RMB 1 ; ; TEMPORARY RELATIONAL OPERATOR FLAG BYTE V40: RMB 1 ; $40 ; Various V41: RMB 1 ; $41 ; OS call control block V42: RMB 1 ; $42 ; Tokeniser flags V43: RMB 1 V44: RMB 1 V45: RMB 1 V46: RMB 1 V47: RMB 1 V48: RMB 2 V4A: RMB 1 V4B: RMB 2 V4D: RMB 2 FP0EXP: RMB 1 ; $4F *PV FLOATING POINT ACCUMULATOR #0 EXPONENT FPA0: RMB 4 ; $50 *PV FLOATING POINT ACCUMULATOR #0 MANTISSA FP0SGN: RMB 1 ; $54 *PV FLOATING POINT ACCUMULATOR #0 SIGN COEFCT: RMB 1 ; $55 POLYNOMIAL COEFFICIENT COUNTER STRDES: RMB 5 ; $56 TEMPORARY STRING DESCRIPTOR FPCARY: RMB 1 ; ; FLOATING POINT CARRY BYTE FP1EXP: RMB 1 ; $5C *PV FLOATING POINT ACCUMULATOR #1 EXPONENT FPA1: RMB 4 ; ; *PV FLOATING POINT ACCUMULATOR #1 MANTISSA FP1SGN: RMB 1 ; ; *PV FLOATING POINT ACCUMULATOR #1 SIGN RESSGN: RMB 1 ; $62 SIGN OF RESULT OF FLOATING POINT OPERATION FPSBYT: RMB 1 ; $63 FLOATING POINT SUB BYTE (FIFTH BYTE) COEFPT: RMB 2 ; ; POLYNOMIAL COEFFICIENT POINTER LSTTXT: RMB 2 ; ; CURRENT LINE POINTER DURING LIST CURLIN: RMB 2 ; $68 *PV CURRENT LINE # OF BASIC PROGRAM, $FFFF = DIRECT DEVCFW: RMB 1 ; $6A *TV TAB FIELD WIDTH DEVLCF: RMB 1 ; $6B *TV TAB ZONE DEVPOS: RMB 1 ; $6C *TV PRINT POSITION DEVWID: RMB 1 ; $6D *TV PRINT WIDTH ; -1=CASSETTE, 0=SCREEN, 1-15=DISK RMB 3 ; PADDING RSTFLG RMB 1 ; $71 *PV WARM START FLAG: $55=WARM, OTHER=COLD RSTVEC: RMB 2 ; $72 *PV WARM START VECTOR - JUMP ADDRESS FOR WARM START TOPRAM: RMB 2 ; $74 *PV TOP OF RAM ZERO: RMB 2 ; ; *PV DUMMY - THESE TWO BYTES ARE ALWAYS ZERO IKEYIM: RMB 1 ; $87 *TV INKEY$ RAM IMAGE RMB 1 * INIT ; DESCRIPTION * ; VALUE LPTCFW: RMB 1 ; $99 ; 16 LPTLCF: RMB 1 ; $9A ; 112 LPTWID: RMB 1 ; $9B ; 132 LPTPOS: RMB 1 ; $9C ; 0 EXECJP: RMB 2 ; $9D ; LB4AA ; LFD update: Subroutine moved to mainline code as 6809 has [addr] mode ; RMB 7 ;XGETNCH INC BROMHK ; $A8 JUMP BACK INTO THE BASIC RUM VAB: RMB 1 ; $AB = LOW ORDER FOUR BYTES OF THE PRODUCT VAC: RMB 1 ; $AC = OF A FLOATING POINT MULTIPLICATION VAD: RMB 1 ; $AD = THESE BYTES ARE USE AS RANDOM DATA VAE: RMB 1 ; $AE = BY THE RND STATEMENT USRADR: RMB 2 ; $B0 *PV ADDRESS OF THE START OF USR VECTORS TRCFLG: RMB 1 ; $AF *PV TRACE FLAG 0=OFF ELSE=ON VCF: RMB 2 ; $CF RENUM INCREMENT VD1: RMB 2 ; $D1 RENUM START VD3: RMB 2 ; (used in DEL) VD5: RMB 2 ; $D5 RENUM NEW START VD7: RMB 1 ; $D7 EDIT LINE LENGTH VD8: RMB 1 ; (PRINT USING) VD9: RMB 1 ; (PRINT USING) VDA: RMB 1 ; (PRINT USING) ; 11 spare bytes here ORG $00A0 ; Register store for CALL/USR REGSTR: RMB 1 ; CC ; $A0 RMB 1 ; A ; $A1 RMB 1 ; B ; $A2 RMB 1 ; DP ; $A3 RMB 1 ; XHI ; $A4 RMB 1 ; XLO ; $A5 RMB 1 ; YHI ; $A6 RMB 1 ; YLO ; $A7 RMB 1 ; UH ; $A8 RMB 1 ; UL ; $A9 RMB 1 ; PCHI ; $AA RMB 1 ; PCLO ; $AB RMB 1 ; $AC RMB 1 ; $AD RMB 1 ; $AE ORG $0100-41-8*5 STRBUF: RMB 41 ; ; STRING BUFFER STRSTK: RMB 8*5 ; $1A9 ; STRING DESCRIPTOR STACK ORG $0100 SW3VEC: RMB 3 ; $100 ; $XXXX SW2VEC: RMB 3 ; $103 ; $XXXX SWIVEC: RMB 3 ; $106 ; $XXXX NMIVEC: RMB 3 ; $109 ; $XXXX IRQVEC: RMB 3 ; $10C ; $A9B3 FRQVEC: RMB 3 ; $10F ; $A0F6 USRJMP: RMB 3 ; ; JUMP ADDRESS FOR BASIC'S USR FUNCTION RVSEED: RMB 1 ; $115 ; FLOATING POINT RANDOM NUMBER SEED EXPONENT RMB 4 ; $116 ; MANTISSA: INITIALLY SET TO $804FC75259 ; ; INITIALLY SET TO ERROR FOR BASIC, $8489 FOR EX BASIC ; 6 spare bytes here ORG $0120 * COMMAND INTERPRETATION VECTOR TABLE * ANY ADDITIONAL TABLES WILL HAVE TO BE * BYTE DESCRIPTION * 0 NUMBER OF RESERVED WORDS * 1,2 LOOKUP TABLE OF RESERVED WORDS * 3,4 JUMP TABLE FOR COMMANDS (FIRST TABLE) * VECTOR TO EXPANSION COMMAND HANDLERS (ALL BUT FIRST TABLE) * 5 NUMBER OF SECONDARY FUNCTIONS * 6,7 LOOKUP TABLE OF SECONDARY FUNCTIONS (FIRST TABLE) * VECTOR TO EXPANSION SECONDARY COMMAND HANDLERS (ALL BUT * FIRST TABLE) * 8,9 JUMP TABLE FOR ; SECONDARY FUNCTIONS * 10 0 BYTE - END OF TABLE FLAG (LAST TABLE ONLY) COMVEC: RMB 10 ; $120 ; BASIC'S TABLE RMB 10 ; $12A ; EX BASIC'S TABLE RMB 10 ; $134 ; DISC BASIC'S TABLE (UNUSED BY EX BASIC) USR0: RMB 2 ; $134 ; USR 0 VECTOR RMB 2 ; ; USR 1 RMB 2 ; ; USR 2 RMB 2 ; ; USR 3 RMB 2 ; ; USR 4 RMB 2 ; ; USR 5 RMB 2 ; ; USR 6 RMB 2 ; ; USR 7 RMB 2 ; ; USR 8 RMB 2 ; $146 ; USR 9 * ; 2.0 RVECSTART: RVEC2: RMB 3 ; $A35F RVEC9: RMB 3 ; $B918 RVEC10: RMB 3 ; $B061 RVEC11: RMB 3 ; $A549 RVEC12: RMB 3 ; $A390 RVEC15: RMB 3 ; $B223 RVEC16: RMB 3 ; $AC46 RVEC17: RMB 3 ; $AC49 RVEC18: RMB 3 ; $AE75 RVEC19: RMB 3 ; $BD22 RVEC20: RMB 3 ; $AD9E RVEC22: RMB 3 ; $A910 * ; $8162 * ; $8AFA * ; $975C RVEC23: RMB 3 ; $B821 RVEC24: RMB 3 ; $B7C2 RVECEND: RMB 2 ; Align LINBUF to $180 ;STRSTK: RMB 8*5 ; $1A9 ; STRING DESCRIPTOR STACK LINHDR: RMB 2 ; $2D9 ; LINE INPUT BUFFER HEADER LINBUF: RMB LBUFMX+1 ; $2DD ; BASIC LINE INPUT BUFFER ;STRBUF: RMB 41 ; ; STRING BUFFER RMB 5 ; Align PROGST to $280 PROGST: RMB 1 ; START OF PROGRAM SPACE ; =================================================================================================== CODE ORG $8000 DIRECT $00 CODESTART: ; Code header FCB $7E ; CODE+0: entry point FDB RESVEC ; Use JMP >ext to label as absolute code FCB 0,0,0 ; CODE+3: FCB $63 ; CODE+6: type=CODE+TUBE+6809 FCB LA14A-CODESTART ; CODE+7: offset to 0,"(C)" FCB 0 ; CODE+8: version LA147: FCC "6809 EXTENDED BASIC" ; CODE+9: title LA14A: FCB 0 LA14B: FCC "(C)1982 MICROSOFT" FCB 0 FCB CODESTART % 256, CODESTART / 256, 0, 0 ; =================================================================================================== RESVEC: LA00E: LDS #LINBUF+LBUFMX+1 ; SET STACK TO TOP OF LINE INPUT BUFFER JSR HOSTINIT ; JGH: Set up host interface, find memory limits ; JGH: Returns X=RAMTOP, Y=RAMBOT CLRA TFR A,DP ; DIRECT PAGE IS AT $00xx LDA RSTFLG ; GET WARM START FLAG CMPA #$55 ; IS IT A WARM START? BNE BACDST ; NO - DO A COLD START LDY RSTVEC ; WARM START VECTOR LDA ,Y ; GET FIRST BYTE OF WARM START ADDR CMPA #$12 ; IS IT NOP? BNE BACDST ; NO - DO A COLD START JMP ,Y ; YES, GO THERE ; COLD START ENTRY BACDST: LDY #PROGST+1 ; POINT Y TO CLEAR BASIC WORKSPACE LA077: CLR ,-Y ; MOVE POINTER DOWN, CLEAR BYTE CMPY #0 ; CHECK FOR BOTTOM OF MEMORY BNE LA077 ; KEEP GOING IF NOT AT BOTTOM OF PAGE 0 LDY #PROGST STY TXTTAB ; BEGINNING OF BASIC PROGRAM ; JGH: X=top of memory from HOSTINIT LEAX -1,X ; JGH: Point to last user memory byte STX TOPRAM ; SAVE ABSOLUTE TOP OF RAM STX MEMSIZ ; SAVE TOP OF STRING SPACE STX STRTAB ; SAVE START OF STRING VARIABLES LEAX -200,X ; CLEAR 200 - DEFAULT STRING SPACE TO 200 BYTES STX FRETOP ; SAVE START OF STRING SPACE TFR X,S ; PUT STACK THERE LDX #LA10D ; POINT X TO ROM SOURCE DATA LDU #LPTCFW ; POINT U TO RAM DESTINATION (WAS #CMPMID) LDB #LA129-LA10D ; MOVE 18 BYTES (WAS 28) JSR LA59A ; MOVE 18 BYTES FROM ROM TO RAM LDU #IRQVEC ; POINT U TO NEXT RAM DESTINATION LDB #LA16F-LA129 ; MOVE 24 MORE BYTES (WAS 30) JSR LA59A ; MOVE 24 BYTES FROM ROM TO RAM LDX #LB277 ; POINT X TO SYNTAX ERROR ADDRESS LDU #COMVEC STX 13,U ; SET EXBAS COMMAND INTERPRETATION STX 18,U ; HANDLERS TO SYNTAX ERROR LDX #RVEC2 ; POINT X TO START OF RAM VECTORS LDD #$3900+RVECEND-RVECSTART ; SET UP TO SAVE 42 (WAS 75) RTS LA0C0: STA ,X+ ; FILL THE RAM VECTORS WITH RTS DECB ; DECREMENT COUNTER AND BNE LA0C0 ; BRANCH IF NOT DONE STA LINHDR-1 ; PUT RTS IN LINHDR-1 JSR LAD19 ; GO TO DO A ‘NEW’ * EXTENDED BASIC INITIALISATION LDX #USR0 ; INITIALIZE ADDRESS OF START OF STX USRADR ; USR JUMP TABLE * INITIALIZE THE USR CALLS TO ; ‘FC ERROR’ LDU #LB44A ; ADDRESS OF ‘FC ERROR’ ROUTINE LDB #10 ; 10 USR CALLS IN EX BASIC L8031: STU ,X++ ; STORE ‘FC’ ERROR AT USR ADDRESSES DECB ; FINISHED ALL 10? BNE L8031 ; NO ; L8038: LDX #LA147-1 ; POINT X TO BASIC STARTUP MESSAGE JSR LB99C ; PRINT MESSAGE JSR NEWLINE LDX #LA14B-1 ; POINT X TO BASIC COPYRIGHT MESSAGE JSR LB99C ; PRINT MESSAGE JSR NEWLINE LDX #BAWMST ; WARM START ADDRESS STX RSTVEC ; SAVE IT LDA #$55 ; WARM START FLAG STA RSTFLG ; SAVE IT ; BRA LA0F3 ; GO TO BASIC’S MAIN LOOP JMP LAC73 ; GO TO MAIN LOOP OF BASIC BAWMST: NOP ; NOP REQ’D FOR WARM START JSR LAD33 ; DO PART OF A NEW BRA L8038 ; PRINT STARTUP MESSAGE AND GO TO MAIN LOOP ;LA0F3: JMP LAC73 ; GO TO MAIN LOOP OF BASIC ; FIRQ SERVICE ROUTINE BFRQSV: RTI ; DEFAULT PRINT FIELDS, EXEC DESTINATION AND CHARAD ; THESE BYTES ARE COPIED TO LPTCFW-CHARAD, $007A-$0082 IN DIRECT PAGE LA10D: FCB 16 ; TAB FIELD WIDTH FCB 112 ; LAST TAB ZONE FCB 132 ; PRINTER WIDTH FCB 0 ; LINE PRINTER POSITION FDB LB44A ; ARGUMENT OF EXEC COMMAND - SET TO ‘FC’ ERROR ; LINE INPUT ROUTINE ; INC CHARAD+1 ; NO LONGER COPIED TO RAM AS 6809 HAS LDA [ADDR] MODE ; BNE LA123 ; INC CHARAD ;LA123: FCB $B6 FDB $0000 ; LDA >0000 ; JMP >BROMHK LA129: ; DEFAULT INTERUPT VECTORS, RANDOM SEED, COMMAND TABLE ; COPIED TO SW3VEC-COMVEC, ADDRESSES $0100-$013E ; JMP >BIRQSV ; IRQ SERVICE FCB $7E ; Assemble JMP >ext FDB BIRQSV ; IRQ SERVICE ; JMP >BFRQSV ; FIRQ SERVICE FCB $7E ; Assemble JMP >ext FDB BFRQSV ; FIRQ SERVICE ; JMP >LB44A ; USR ADDRESS FOR 8K BASIC (INITIALIZED TO ‘FC’ ERROR) FCB $7E ; Assemble JMP >ext FDB LB44A ; USR ADDRESS FOR 8K BASIC (INITIALIZED TO ‘FC’ ERROR) FCB $80 ; RANDOM SEED FDB $4FC7 ; RANDOM SEED OF MANTISSA FDB $5259 ; 0.811635157 RMB 6 ; Pad command table to $0120 ; BASIC COMMAND INTERPRETATION TABLE ROM IMAGE LA13D: FCB MAXCMD-$7D ; NUMBER OF BASIC COMMANDS LA13E: FDB LAA66 ; POINTS TO RESERVED WORDS LA140: FDB LAB67 ; POINTS TO JUMP TABLE FOR COMMANDS LA142: FCB MAXFN-$7D ; NUMBER OF BASIC SECONDARY COMMANDS LA143: FDB LAB1A ; POINTS TO SECONDARY FUNCTION RESERVED WORDS LA145: FDB LAA29 ; POINTS TO SECONDARY FUNCTION JUMP TABLE LA165: FCB $00 ; 0 EXTENDED COMMANDS LA16F: LA35F: JSR RVEC2 ; HOOK INTO RAM PSHS X,B,A ; SAVE REGISTERS LDX LPTCFW ; TAB FIELD WIDTH AND TAB ZONE LDD LPTWID ; PRINTER WIDTH AND POSITION LA37C: STX DEVCFW ; SAVE TAB FIELD WIDTH AND ZONE ; STB DEVPOS ; SAVE PRINT POSITION STA DEVWID ; SAVE PRINT WIDTH PULS A,B,X,PC ; RESTORE REGISTERS AND RETURN JMP LA38D ; --------------------------------------------------------------------------------------------------- ; THIS IS THE ROUTINE THAT GETS AN INPUT LINE FOR BASIC ; EXIT WITH BREAK KEY: CARRY = 1 ; EXIT WITH ENTER KEY: CARRY = 0 ; LA38D: LA390: JSR RVEC12 ; HOOK INTO RAM CLR IKEYIM ; RESET BREAK CHECK KEY TEMP KEY STORAGE LDX #LINBUF+1 ; INPUT LINE BUFFER LDB #1 ; ACCB CHAR COUNTER: SET TO 1 TO ALLOW A ; BACKSPACE AS FIRST CHARACTER LA39A: JSR CHKESCAPE ; JGH BMI LA3CD ; JGH JSR LA171 ; GO GET A CHARACTER FROM CONSOLE IN CMPA #DELCHR ; JGH BEQ LA3B1 ; JGH CMPA #BS ; BACKSPACE BNE LA3B4 ; NO LA3B1: DECB ; YES - DECREMENT CHAR COUNTER BEQ LA390 ; BRANCH IF BACK AT START OF LINE AGAIN LEAX -1,X ; DECREMENT BUFFER POINTER LDA #DELCHR ; DELETE PREVIOUS CHARACTER BRA LA3E8 ; ECHO CHAR TO SCREEN LA3B4: CMPA #$15 ; SHIFT LEFT ARROW OR CTRL-U? BNE LA3C2 ; NO ; YES, RESET BUFFER TO BEGINNING AND ERASE CURRENT LINE LA3B8: DECB ; DEC CHAR CTR BEQ LA390 ; GO BACK TO START IF CHAR CTR = 0 LDA #DELCHR ; DELETE PREVIOUS CHARACTER JSR PUTCHR ; SEND TO CONSOLE OUT (SCREEN) BRA LA3B8 ; KEEP GOING LA3C2: CMPA #3 ; BREAK KEY? ORCC #1 ; SET CARRY FLAG BEQ LA3CD ; BRANCH IF BREAK KEY DOWN LA3C8: CMPA #CR ; ENTER KEY? BNE LA3D9 ; NO LA3CC: CLRA ; CLEAR CARRY FLAG IF ENTER KEY - END LINE ENTRY LA3CD: PSHS CC ; SAVE CARRY FLAG JSR LB958 ; SEND CR TO SCREEN CLR ,X ; MAKE LAST BYTE IN INPUT BUFFER = 0 LDX #LINBUF ; RESET INPUT BUFFER POINTER PULS CC,PC ; RESTORE CARRY FLAG AND RETURN ; INSERT A CHARACTER INTO THE BASIC LINE INPUT BUFFER LA3D9: CMPA #$20 ; IS IT CONTROL CHAR? BLO LA39A ; BRANCH IF CONTROL CHARACTER CMPA #'~'+1 ; BCC LA39A ; IGNORE IF > PRINTABLE CHARACTER CMPB #LBUFMX ; HAVE 250 OR MORE CHARACTERS BEEN ENTERED? BCC LA39A ; YES, IGNORE ANY MORE STA ,X+ ; PUT IT IN INPUT BUFFER INCB ; INCREMENT CHARACTER COUNTER LA3E8: JSR PUTCHR ; ECHO IT TO SCREEN BRA LA39A ; GO SET SOME MORE ; --------------------------------------------------------------------------------------------------- * LOAD CLOAD: JSR LA578 ; GET FILE NAME, RETURNS X=>FILENAME STRING JMP HOSTLOAD * SAVE CSAVE: JSR LA578 ; GET FILE NAME, RETURNS X=>FILENAME STRING JMP HOSTSAVE * EXEC EXEC: LBEQ LB277 ; SYNTAX ERROR BRANCH IF NO ARGUMENT JSR LB73D ; EVALUATE ARGUMENT - ARGUMENT RETURNED IN X STX EXECJP ; STORE X TO EXEC JUMP ADDRESS LDU REGSTR+8 LDY REGSTR+6 LDX REGSTR+4 LDB REGSTR+2 LDA REGSTR+0 PSHS A LDA REGSTR+1 ; Get register contents from register store PULS CC JSR [EXECJP] ; Call code PSHS CC STA REGSTR+1 ; Save register contents back to register store PULS A STA REGSTR+0 STB REGSTR+2 STX REGSTR+4 STY REGSTR+6 STU REGSTR+8 RTS ;REGSTR: RMB 1 ; CC ; $A0 ; RMB 1 ; A ; $A1 ; RMB 1 ; B ; $A2 ; RMB 1 ; DP ; $A3 ; RMB 1 ; XHI ; $A4 ; RMB 1 ; XLO ; $A5 ; RMB 1 ; YHI ; $A6 ; RMB 1 ; YLO ; $A7 ; RMB 1 ; UH ; $A8 ; RMB 1 ; UL ; $A9 ; RMB 1 ; PCHI ; $AA ; RMB 1 ; PCLO ; $AB ; RMB 1 ; $AC ; RMB 1 ; $AD ; RMB 1 ; $AE * BREAK CHECK LA549: JSR RVEC11 ; HOOK INTO RAM JMP LADEB ; GO TO BREAK KEY CHECK * INKEY$ INKEY: LDA IKEYIM ; WAS A KEY DOWN IN THE BREAK CHECK? BNE LA56B ; YES JSR KEYIN ; GO GET A KEY LA56B: CLR IKEYIM ; CLEAR INKEY RAM IMAGE STA FPA0+3 ; STORE THE KEY IN FPA0 LBNE LB68F ; CONVERT FPA0+3 TO A STRING STA STRDES ; SET LENGTH OF STRING = 0 IF NO KEY DOWN JMP LB69B ; PUT A NULL STRING ONTO THE STRING STACK ; ; GET FILENAME FROM THE BASIC LINE LA578: JSR GETCCH ; GET CURRENT INPUT CHAR BEQ LA5A1 ; RETURN IF NO NAME JSR LB156 ; GET THE FILE NAME - EVALUATE EXPRESSION JSR LB654 ; POINT X TO START OF NAME (TOP STRING ON STRING STACK) CLRA STA B,X ; PUT TERMINATING ZERO AT END OF STRING RTS * MOVE ACCB BYTES FROM (X) TO ; (U) LA59A: LDA ,X+ ; GET BYTE FROM X STA ,U+ ; STORE IT AT U DECB ; MOVED ALL BYTES? BNE LA59A ; NO LA5A1: RTS LA5C4: RTS ** THIS ROUTINE WILL SCAN OFF THE FILE NAME FROM A BASIC LINE ** AND RETURN A SYNTAX ERROR IF THERE ARE ANY CHARACTERS ** FOLLOWING THE END OF THE NAME LA5C7: JSR GETCCH ; GET CURRENT INPUT CHAR FROM BASIC LINE LA5C9: BEQ LA5C4 ; RETURN IF END OF LINE JMP LB277 ; SYNTAX ERROR IF ANY MORE CHARACTERS * IRQ SERVICE BIRQSV: LA9C5: RTI ; RETURN FROM INTERRUPT * * SET CARRY IF NUMERIC - RETURN WITH * ZERO FLAG SET IF ACCA = 0 OR 3A(:) - END * OF BASIC LINE OR SUB LINE BROMHK: CMPA #'9'+1 ; IS THIS CHARACTER >=(ASCII 9)+1? BHS LAA28 ; BRANCH IF > 9; Z SET IF = COLON CMPA #SPACE ; SPACE? BNE LAA24 ; NO - SET CARRY IF NUMERIC JMP GETNCH ; IF SPACE, GET NECT CHAR (IGNORE SPACES) LAA24: SUBA #'0' ; * SET CARRY IF SUBA #-'0' ; * CHARACTER > ASCII 0, SETS Z IF $00 LAA28: RTS ; EXBAS COMMAND TOKENS ; ==================== ; 80 FOR A0 SOUND C0 (PCLEAR) ; 81 GO A1 AUDIO C1 (COLOR) ; 82 REM A2 EXEC C2 (CIRCLE) ; 83 ' A3 SKIP C3 (PAINT) ; 84 ELSE A4 TAB( C4 (GET) ; 85 IF A5 TO C5 (PUT) ; 86 DATA A6 SUB C6 (DRAW) ; 87 PRINT A7 THEN C7 (PCOPY) ; 88 ON A8 NOT C8 (PMODE) ; 89 INPUT A9 STEP C9 (PLAY) ; 8A END AA OFF CA (DLOAD) ; 8B NEXT AB + CB (RENUM) ; 8C DIM AC - CC (FN) ; 8D READ AD * CD (USING) ; 8E RUN AE / CE ; 8F RESTORE AF ^ CF ; 90 RETURN B0 AND ; 91 STOP B1 OR ; 92 POKE B2 > ; 93 CONT B3 = ; 94 LIST B4 < ; 95 CLEAR B5 DEL ; 96 NEW B6 EDIT ; 97 LOAD B7 TRON ; 98 SAVE B8 TROFF ; 99 OPEN B9 DEF ; 9A CLOSE BA LET ; 9B (LLIST) BB LINE ; 9C (SET) BC RENUM (PCLS) ; 9D (RESET) BD FN (PSET) ; 9E CLS BE USING (PRESET) ; 9F MOTOR BF (SCREEN) * * COMMAND KEYWORD TABLE * TOKEN # LAA66: FCC "FO" ; 80 FOR FCB $80+'R' FCB "G" ; 81 GO FCB $80+'O' ; 82 REM FCC "RE" FCB $80+'M' ; 82 REM FCB "'"+$80 ; 83 ' FCC "ELS" ; 84 ELSE FCB $80+'E' FCC "I" ; 85 IF FCB $80+'F' FCC "DAT" ; 86 DATA FCB $80+'A' FCC "PRIN" ; 87 PRINT FCB $80+'T' FCC "O" ; 88 ON FCB $80+'N' FCC "INPU" ; 89 INPUT FCB $80+'T' FCC "EN" ; 8A END FCB $80+'D' FCC "NEX" ; 8B NEXT FCB $80+'T' FCC "DI" ; 8C DIM FCB $80+'M' FCC "REA" ; 8D READ FCB $80+'D' FCC "RU" ; 8E RUN FCB $80+'N' FCC "RESTOR" ; 8F RESTORE FCB $80+'E' FCC "RETUR" ; 90 RETURN FCB $80+'N' FCC "STO" ; 91 STOP FCB $80+'P' FCC "POK" ; 92 POKE FCB $80+'E' FCC "CON" ; 93 CONT FCB $80+'T' FCC "LIS" ; 94 LIST FCB $80+'T' FCC "CLEA" ; 95 CLEAR FCB $80+'R' FCC "NE" ; 96 NEW FCB $80+'W' FCC "LOA" ; 97 LOAD FCB $80+'D' FCC "SAV" ; 98 SAVE FCB $80+'E' FCC "OPE" ; 99 OPEN FCB $80+'N' FCC "CLOS" ; 9A CLOSE FCB $80+'E' FCC "LLIS" ; 9B (LLIST) FCB $80+'T' FCC "SE" ; 9C (SET) FCB $80+'T' FCC "RESE" ; 9D (RESET) FCB $80+'T' FCC "CL" ; 9E CLS FCB $80+'S' FCC "MOTO" ; 9F MOTOR FCB $80+'R' FCC "SOUN" ; A0 SOUND FCB $80+'D' FCC "AUDI" ; A1 AUDIO FCB $80+'O' FCC "EXE" ; A2 EXEC FCB $80+'C' FCC "SKIP" ; A3 SKIP FCB $80+'F' FCC "TAB" ; A4 TAB( FCB $80+'(' FCC "T" ; A5 TO FCB $80+'O' FCC "SU" ; A6 SUB FCB $80+'B' FCC "THE" ; A7 THEN FCB $80+'N' FCC "NO" ; A8 NOT FCB $80+'T' FCC "STE" ; A9 STEP FCB $80+'P' FCC "OF" ; AA OFF FCB $80+'F' FCB '+'+$80 ; AB + FCB '-'+$80 ; AC - FCB '*'+$80 ; AD * FCB '/'+$80 ; AE / FCB '^'+$80 ; AF ^ FCC "AN" ; B0 AND FCB $80+'D' FCC "O" ; B1 OR FCB $80+'R' FCB '>'+$80 ; B2 > FCB '='+$80 ; B3 = FCB '<'+$80 ; B4 < FCC "DE" ; B5 DEL FCB $80+'L' FCC "EDI" ; B6 EDIT FCB $80+'T' FCC "TRO" ; B7 TRON FCB $80+'N' FCC "TROF" ; B8 TROFF FCB $80+'F' FCC "DE" ; B9 DEF FCB $80+'F' FCC "LE" ; BA LET FCB $80+'T' FCC "LIN" ; BB LINE FCB $80+'E' FCC "RENU" ; BC RENUM FCB $80+'M' FCC "F" ; BD FN FCB $80+'N' FCC "USIN" ; BE USING FCB $80+'G' * * DISPATCH TABLE FOR COMMANDS ; TOKEN # LAB67: FDB FOR ; FOR 80 FDB GO ; GO 81 FDB REM ; REM 82 FDB REM ; REM 83 FDB REM ; ELSE 84 FDB cmdIF ; IF 85 FDB cmdDATA ; DATA 86 FDB PRINT ; PRINT 87 FDB ON ; ON 88 FDB INPUT ; INPUT 89 FDB cmdEND ; END 8A FDB NEXT ; NEXT 8B FDB DIM ; DIM 8C FDB READ ; READ 8D FDB RUN ; RUN 8E FDB RESTOR ; RESTORE 8F FDB RETURN ; RETURN 90 FDB STOP ; STOP 91 FDB POKE ; POKE 92 FDB CONT ; CONTINUE 93 FDB cmdLIST ; LIST 94 FDB CLEAR ; CLEAR 95 FDB NEW ; NEW 96 FDB CLOAD ; LOAD 97 FDB CSAVE ; SAVE 98 FDB REM ; OPEN 99 FDB REM ; CLOSE 9A FDB REM ; LLIST 9B FDB REM ; SET 9C FDB REM ; RESET 9D FDB CLS ; CLS 9E FDB REM ; MOTOR 9F FDB REM ; SOUND A0 FDB REM ; AUDIO A1 FDB EXEC ; EXEC A2 FDB REM ; SKIPF A3 FDB REM ; TAB A4 FDB REM ; TO A5 FDB REM ; SUB A6 FDB REM ; THEN A7 FDB REM ; NOT A8 FDB REM ; STEP A9 FDB REM ; OFF AA FDB REM ; AB FDB REM ; AC FDB REM ; AD FDB REM ; AE FDB REM ; AF FDB REM ; A0 FDB REM ; A1 FDB REM ; A2 FDB REM ; A3 FDB REM ; A4 FDB DEL ; DEL B5 FDB EDIT ; EDIT B6 FDB TRON ; TRON B7 FDB TROFF ; TROFF B8 FDB DEF ; DEF B9 FDB LET ; LET BA FDB LINE ; LINE BB FDB RENUM ; RENUM BC LABAE: MAXCMD: EQU (LABAE-LAB67)/2+$7F ; EXBAS FUNCTION TOKENS ; --------------------- ; 80 SGN 90 MID$ A0 PPOINT ; 81 INT 91 POINT A1 STRING$ ; 82 ABS 92 INKEY$ ; 83 USR 93 MEM ; 84 RND 94 ATN ; 85 SIN 95 COS ; 86 PEEK 96 TAN ; 87 LEN 97 EXP ; 88 STR$ 98 FIX ; 89 VAL 99 LOG ; 8A ASC 9A POS ; 8B CHR$ 9B SQR ; 8C EOF 9C HEX$ ; 8D JOYSTK 9D VARPTR ; 8E LEFT$ 9E INSTR ; 8F RIGHT$ 9F TIMER * * FUNCTION KEYWORD TABLE * TOKEN # LAB1A: FCC "SG" ; 80 SGN FCB $80+'N' FCC "IN" ; 81 INT FCB $80+'T' FCC "AB" ; 82 ABS FCB $80+'S' FCC "US" ; 83 USR FCB $80+'R' FCC "RN" ; 84 RND FCB $80+'D' FCC "SI" ; 85 SIN FCB $80+'N' FCC "PEE" ; 86 PEEK FCB $80+'K' FCC "LE" ; 87 LEN FCB $80+'N' FCC "STR" ; 88 STR$ FCB $80+'$' FCC "VA" ; 89 VAL FCB $80+'L' FCC "AS" ; 8A ASC FCB $80+'C' FCC "CHR" ; 8B CHR$ FCB $80+'$' FCC "EO" ; 8C EOF FCB $80+'F' FCC "JOYST" ; 8D JOYSTK FCB $80+'K' FCC "LEFT" ; 8E LEFT$ FCB $80+'$' FCC "RIGHT" ; 8F RIGHT$ FCB $80+'$' FCC "MID" ; 90 MID$ FCB $80+'$' FCC "POIN" ; 91 POINT FCB $80+'T' FCC "INKEY" ; 92 INKEY$ FCB $80+'$' FCC "ME" ; 93 MEM FCB $80+'M' FCC "AT" ; 94 ATN FCB $80+'N' FCC "CO" ; 95 COS FCB $80+'S' FCC "TA" ; 96 TAN FCB $80+'N' FCC "EX" ; 97 EXP FCB $80+'P' FCC "FI" ; 98 FIX FCB $80+'X' FCC "LO" ; 99 LOG FCB $80+'G' FCC "PO" ; 9A POS FCB $80+'S' FCC "SQ" ; 9B SQR FCB $80+'R' FCC "HEX" ; 9C HEX$ FCB $80+'$' FCC "VARPT" ; 9D VARPTR FCB $80+'R' FCC "INST" ; 9E INSTR FCB $80+'R' FCC "TIME" ; 9D TIMER FCB $80+'R' FCC "PPOIN" ; A0 POINT FCB $80+'T' FCC "STRING" ; A1 STRING$ FCB $80+'$' * DISPATCH TABLE FOR SECONDARY FUNCTIONS * TOKENS ARE PRECEEDED BY $FF ; TOKEN # LAA29: FDB SGN ; 80 SGN FDB INT ; 81 INT FDB ABS ; 82 ABS FDB $0112 ; 83 USR FDB RND ; 84 RND FDB SIN ; 85 SIN FDB PEEK ; 86 PEEK FDB LEN ; 87 LEN FDB STR ; 88 STR$ FDB VAL ; 89 VAL FDB ASC ; 8A ASC FDB CHR ; 8B CHR$ FDB REM ; 8C EOF FDB REM ; 8D JOYSTK FDB LEFT ; 8E LEFT$ FDB RIGHT ; 8F RIGHT$ FDB MID ; 90 MID$ FDB REM ; 91 POINT FDB INKEY ; 92 INKEY$ FDB MEM ; 93 MEM FDB ATN ; 94 ATN FDB COS ; 95 COS FDB TAN ; 96 TAN FDB EXP ; 97 EXP FDB FIX ; 98 FIX FDB LOG ; 99 LOG FDB POS ; 9A POS FDB SQR ; 9B SQR FDB HEXDOL ; 9C HEX$ FDB VARPT ; 9D VARPTR FDB INSTR ; 9E INSTR FDB REM ; 9F TIMER FDB REM ; A0 PPOINT FDB STRING ; A1 STRING$ LAA50: MAXFN: EQU (LAA50-LAA29)/2+$7F * LOOKUP TABLE FOR ARITHMETIC OPERATOS * LAA51: FCB $79 FDB LB9C5 ; + FCB $79 FDB LB9BC ; - FCB $7B FDB LBACC ; * FCB $7B FDB LBB91 ; / FCB $7F FDB L8489 ; EXPONENTIATION FCB $50 FDB LB2D5 ; AND FCB $46 FDB LB2D4 ; OR * * ERROR MESSAGES AND THEIR NUMBERS AS USED INTERNALLY LABAF: FCC "NF" ; 0 FCC "SN" ; 1 SYNTAX ERROR FCC "RG" ; 2 FCC "OD" ; 3 FCC "FC" ; 4 FCC "OV" ; 5 OVERFLOW FCC "OM" ; 6 OUT OF MEMORY FCC "UL" ; 7 FCC "BS" ; 8 FCC "DD" ; 9 FCC "/0" ; 10 DIVISION BY ZERO FCC "ID" ; 11 ILLEGAL DIRECT STATEMENT FCC "TM" ; 12 TYPE MISMATCH FCC "OS" ; 13 OUT OF STRING SPACE FCC "LS" ; 14 STRING TOO LONG FCC "ST" ; 15 STRING FORMULA TOO COMPLEX FCC "CN" ; 16 CAN'T CONTINUE FCC "FD" ; 17 BAD FILE DATA FCC "AO" ; 18 FILE ALREADY OPEN FCC "DN" ; 19 DEVICE NUMBER ERROR FCC "IO" ; 20 I/O ERROR FCC "FM" ; 21 BAD FILE MODE FCC "NO" ; 22 FILE NOT OPEN FCC "IE" ; 23 INPUT PAST END OF FILE FCC "DS" ; 24 DIRECT STATEMENT IN FILE * ADDITIONAL ERROR MESSAGES ADDED BY EXTENDED BASIC L890B: FCC "UF" ; 25 UNDEFINED FUNCTION (FN) CALL L890D: FCC "NE" ; 26 FILE NOT FOUND LABE1: FCC " ERROR" FCB $00 LABE8: FCC " IN " FCB $00 LABED: FCB CR LABEE: FCC "OK" FCB CR,$00 LABF2: FCB CR FCC "BREAK" FCB $00 * SEARCH THE STACK FOR ‘GOSUB/RETURN’ OR ‘FOR/NEXT’ DATA. * THE ‘FOR/NEXT’ INDEX VARIABLE DESCRIPTOR ADDRESS BEING * SOUGHT IS STORED IN VARDES. ; EACH BLOCK OF FOR/NEXT DATA IS 18 * BYTES WITH A $80 LEADER BYTE AND THE GOSUB/RETURN DATA IS 5 BYTES * WITH AN $A6 LEADER BYTE. THE FIRST NON "FOR/NEXT" DATA * IS CONSIDERED ‘GOSUB/RETURN’ LABF9: LEAX 4,S ; POINT X TO 3RD ADDRESS ON STACK - IGNORE THE * FIRST TWO RETURN ADDRESSES ON THE STACK LABFB: LDB #18 ; 18 BYTES SAVED ON STACK FOR EACH ‘FOR’ LOOP STX TEMPTR ; SAVE POINTER LDA ,X ; GET 1ST BYTE SUBA #$80 ; * CHECK FOR TYPE OF STACK JUMP FOUND BNE LAC1A ; * BRANCH IF NOT ‘FOR/NEXT’ LDX 1,X ; = GET INDEX VARIABLE DESCRIPTOR STX TMPTR1 ; = POINTER AND SAVE IT IN TMPTR1 LDX VARDES ; GET INDEX VARIABLE BEING SEARCHED FOR BEQ LAC16 ; BRANCH IF DEFAULT INDEX VARIABLE - USE THE * ; FIRST ‘FOR/NEXT’ DATA FOUND ON STACK * ; IF NO INDEX VARIABLE AFTER ‘NEXT’ CMPX TMPTR1 ; DOES THE STACK INDEX MATCH THE ONE * ; BEING SEARCHED FOR? BEQ LAC1A ; YES LDX TEMPTR ; * RESTORE INITIAL POINTER, ADD ABX ; * 18 TO IT AND LOOK FOR BRA LABFB ; * NEXT BLOCK OF DATA LAC16: LDX TMPTR1 ; = GET 1ST INDEX VARIABLE FOUND AND STX VARDES ; = SAVE AS ‘NEXT’ INDEX LAC1A: LDX TEMPTR ; POINT X TO START OF ‘FOR/NEXT’ DATA TSTA ; SET ZERO FLAG IF ‘FOR/NEXT’ DATA RTS * CHECK FOR MEMORY SPACE FOR NEW TOP OF * ARRAYS AND MOVE ARRAYS TO NEW LOCATION LAC1E: BSR LAC37 ; ACCD = NEW BOTTOM OF FREE RAM - IS THERE * ; ROOM FOR THE STACK? * MOVE BYTES FROM V43(X) TO V41(U) UNTIL (X) = V47 AND * SAVE FINAL VALUE OF U IN V45 LAC20: LDU V41 ; POINT U TO DESTINATION ADDRESS (V41) LEAU 1,U ; ADD ONE TO U - COMPENSATE FOR FIRST PSHU LDX V43 ; POINT X TO SOURCE ADDRESS (V43) LEAX 1,X ; ADD ONE - COMPENSATE FOR FIRST LDA ,X LAC28: LDA ,-X ; GRAB A BYTE FROM SOURCE PSHU A ; MOVE IT TO DESTINATION CMPX V47 ; DONE? BNE LAC28 ; NO - KEEP MOVING BYTES STU V45 ; SAVE FINAL DESTINATION ADDRESS LAC32: RTS * CHECK TO SEE IF THERE IS ROOM TO STORE 2*ACCB * BYTES IN FREE RAM - OM ERROR IF NOT LAC33: CLRA ; * ACCD CONTAINS NUMBER OF EXTRA ASLB ; * BYTES TO PUT ON STACK ADDD ARYEND ; END OF PROGRAM AND VARIABLES LAC37: ADDD #STKBUF ; ADD STACK BUFFER - ROOM FOR STACK? BCS LAC44 ; BRANCH IF GREATER THAN $FFFF STS BOTSTK ; CURRENT NEW BOTTOM OF STACK STACK POINTER CMPD BOTSTK ; ARE WE GOING TO BE BELOW STACK? BCS LAC32 ; YES - NO ERROR LAC44: LDB #6*2 ; OUT OF MEMORY ERROR * ERROR SERVICING ROUTINE LAC46: JSR RVEC16 ; HOOK INTO RAM JSR RVEC17 ; HOOK INTO RAM JSR LAD33 ; RESET STACK, STRING STACK, CONTINUE POINTER JSR LB958 ; SEND A CR TO SCREEN JSR LB9AF ; SEND A ‘?‘ TO SCREEN LDX #LABAF ; POINT TO ERROR TABLE LAC60: ABX ; ADD MESSAGE NUMBER OFFSET BSR LACA0 ; * GET TWO CHARACTERS FROM X AND BSR LACA0 ; * SEND TO CONSOLE OUT (SCREEN) LDX #LABE1-1 ; POINT TO "ERROR" MESSAGE LAC68: JSR LB99C ; PRINT MESSAGE POINTED TO BY X LDA CURLIN ; GET CURRENT LINE NUMBER (CURL IN) INCA ; TEST FOR DIRECT MODE BEQ LAC73 ; BRANCH IF DIRECT MODE JSR LBDC5 ; PRINT ‘IN ****‘ * THIS IS THE MAIN LOOP OF BASIC WHEN IN DIRECT MODE LAC73: JSR LB95C ; MOVE CURSOR TO START OF LINE LDX #LABED ; POINT X TO ‘OK’, CR MESSAGE JSR LB99C ; PRINT ‘OK’, CR LAC7C: JSR LA390 ; GO GET AN INPUT LINE LDU #$FFFF ; THE LINE NUMBER FOR DIRECT MODE IS $FFFF STU CURLIN ; SAVE IT IN CURLIN BCS LACBC ; BRANCH IF LINE INPUT TERMINATED BY BREAK STX CHARAD ; SAVE (X) AS CURRENT INPUT POINTER - THIS WILL * ENABLE THE ‘LIVE KEYBOARD’ (DIRECT) MODE. THE * LINE JUST ENTERED WILL BE INTERPRETED JSR GETNCH ; GET NEXT CHARACTER FROM BASIC BEQ LAC7C ; NO LINE INPUT - GET ANOTHER LINE BCS LACA5 ; BRANCH IF NUMERIC - THERE WAS A LINE NUMBER BEFORE * THE STATEMENT ENTERED, SO THIS STATEMENT * WILL BE MERGED INTO THE BASIC PROGRAM JSR LB821 ; GO CRUNCH LINE JMP LADC0 ; GO EXECUTE THE STATEMENT (LIVE KEYBOARD) LACBC: LDX #LABF2 ; POINT TO CR, ‘BREAK’ MESSAGE JSR LB99C ; PRINT 'BREAK' JSR LB958 ; MOVE CURSOR TO START OF LINE JMP LAC7C ; GO TO DIRECT MODE * LACA0: LDA ,X+ ; GET A CHARACTER JMP LB9B1 ; SEND TO CONSOLE OUT * TAKE A LINE FROM THE LINE INPUT BUFFER * AND INSERT IT INTO THE BASIC PROGRAM LACA5: JSR LAF67 ; CONVERT LINE NUMBER TO BINARY LACA8: LDX BINVAL ; GET CONVERTED LINE NUMBER STX LINHDR ; STORE IT IN LINE INPUT HEADER JSR LB821 ; GO CRUNCH THE LINE STB TMPLOC ; SAVE LINE LENGTH BSR LAD01 ; FIND OUT WHERE TO INSERT LINE BCS LACC8 ; BRANCH IF LINE NUMBER DOES NOT ALREADY EXIST LDD V47 ; GET ABSOLUTE ADDRESS OF LINE NUMBER SUBD ,X ; SUBTRACT ADDRESS OF NEXT LINE NUMBER ADDD VARTAB ; * ADD TO CURRENT END OF PROGRAM - THIS WILL REMOVE STD VARTAB ; * THE LENGTH OF THIS LINE NUMBER FROM THE PROGRAM LDU ,X ; POINT U TO ADDRESS OF NEXT LINE NUMBER * DELETE OLD LINE FROM BASIC PROGRAM LACC0: PULU A ; GET A BYTE FROM WHAT’S LEFT OF PROGRAM STA ,X+ ; MOVE IT DOWN CMPX VARTAB ; COMPARE TO END OF BASIC PROGRAM BNE LACC0 ; BRANCH IF NOT AT END LACC8: LDA LINBUF ; * CHECK TO SEE IF THERE IS A LINE IN BEQ LACE9 ; * THE BUFFER AND BRANCH IF NONE LDD VARTAB ; = SAVE CURRENT END OF STD V43 ; = PROGRAM IN V43 ADDB TMPLOC ; * ADD LENGTH OF CRUNCHED LINE, ADCA #0 ; * PROPOGATE CARRY AND SAVE NEW END STD V41 ; * OF PROGRAM IN V41 JSR LAC1E ; = MAKE SURE THERE’S ENOUGH RAM FOR THIS * = LINE & MAKE A HOLE IN BASIC FOR NEW LINE LDU #LINHDR-2 ; POINT U TO LINE TO BE INSERTED LACDD: PULU A ; GET A BYTE FROM NEW LINE STA ,X+ ; INSERT IT IN PROGRAM CMPX V45 ; * COMPARE TO ADDRESS OF END OF INSERTED BNE LACDD ; * LINE AND BRANCH IF NOT DONE LDX V41 ; = GET AND SAVE STX VARTAB ; = END OF PROGRAM LACE9: BSR LAD21 ; RESET INPUT POINTER, CLEAR VARIABLES, INITIALIZE BSR LACEF ; ADJUST START OF NEXT LINE ADDRESSES BRA LAC7C ; REENTER BASIC’S INPUT LOOP * COMPUTE THE START OF NEXT LINE ADDRESSES FOR THE BASIC PROGRAM LACEF: LDX TXTTAB ; POINT X TO START OF PROGRAM LACF1: LDD ,X ; GET ADDRESS OF NEXT LINE BEQ LAD16 ; RETURN IF END OF PROGRAM LEAU 4,X ; POINT U TO START OF BASIC TEXT IN LINE LACF7: LDA ,U+ ; * SKIP THROUGH THE LINE UNTIL A BNE LACF7 ; * ZERO (END OF LINE) IS FOUND STU ,X ; SAVE THE NEW START OF NEXT LINE ADDRESS LDX ,X ; POINT X TO START OF NEXT LINE BRA LACF1 ; KEEP GOING * * FIND A LINE NUMBER IN THE BASIC PROGRAM * RETURN WITH CARRY SET IF NO ; MATCH FOUND LAD01: LDD BINVAL ; GET THE LINE NUMBER TO FIND LDX TXTTAB ; BEGINNING OF PROGRAM LAD05: LDU ,X ; GET ADDRESS OF NEXT LINE NUMBER BEQ LAD12 ; BRANCH IF END OF PROG CMPD 2,X ; IS IT A MATCH? BLS LAD14 ; CARRY SET IF LOWER; CARRY CLEAR IF MATCH LDX ,X ; X = ADDRESS OF NEXT LINE BRA LAD05 ; KEEP LOOPING FOR LINE NUMBER LAD12: ORCC #1 ; SET CARRY FLAG LAD14: STX V47 ; SAVE MATCH LINE NUMBER OR NUMBER OF LINE JUST AFTER * ; WHERE IT SHOULD HAVE BEEN LAD16: RTS * NEW NEW: BNE LAD14 ; BRANCH IF ARGUMENT GIVEN LAD19: LDX TXTTAB ; GET START OF BASIC CLR ,X+ ; * PUT 2 ZERO BYTES THERE - ERASE CLR ,X+ ; * THE BASIC PROGRAM STX VARTAB ; AND THE NEXT ADDRESS IS NOW THE END OF PROGRAM LAD21: LDX TXTTAB ; GET START OF BASIC JSR LAEBB ; PUT INPUT POINTER ONE BEFORE START OF BASIC * ERASE ALL VARIABLES LAD26: LDX MEMSIZ ; * RESET START OF STRING VARIABLES STX STRTAB ; * TO TOP OF STRING SPACE JSR RESTOR ; RESET ‘DATA’ POINTER TO START OF BASIC LDX VARTAB ; * GET START OF VARIABLES AND USE IT STX ARYTAB ; * TO RESET START OF ARRAYS STX ARYEND ; RESET END OF ARRAYS LAD33: LDX #STRSTK ; * RESET STRING STACK POINTER TO STX TEMPPT ; * BOTTOM OF STRING STACK LDX ,S ; GET RETURN ADDRESS OFF STACK LDS FRETOP ; RESTORE STACK POINTER CLR ,-S ; PUT A ZERO BYTE ON STACK - TO CLEAR ANY RETURN OF * ; FOR/NEXT DATA FROM THE STACK CLR OLDPTR ; RESET ‘CONT’ ADDRESS SO YOU CLR OLDPTR+1 ; ‘CAN’T CONTINUE’ CLR ARYDIS ; CLEAR THE ARRAY DISABLE FLAG JMP ,X ; RETURN TO CALLING ROUTINE - THIS IS NECESSARY * ; SINCE THE STACK WAS RESET * * FOR * * THE FOR COMMAND WILL STORE 18 BYTES ON THE STACK FOR * EACH FOR-NEXT LOOP WHICH IS ; BEING PROCESSED. THESE * BYTES ARE DEFINED AS FOLLOWS: 0- $80 (FOR FLAG); * 1,2=INDEX VARIABLE DESCRIPTOR POINTER; 3-7=FP VALUE OF STEP; * 8=STEP DIRECTION: $FF IF NEGATIVE; 0 IF ZERO; 1 IF POSITIVE; * 9-13=FP VALUE OF ‘TO’ PARAMETER; * 14,15=CURRENT LINE NUMBER; 16,17=RAM ADDRESS OF THE END * OF THE LINE CONTAINING THE ‘FOR’ STATEMENT FOR: LDA #$80 ; * SAVE THE DISABLE ARRAY FLAG IN VO8 STA ARYDIS ; * DO NOT ALLOW THE INDEX VARIABLE TO BE AN ARRAY JSR LET ; SET INDEX VARIABLE TO INITIAL VALUE JSR LABF9 ; SEARCH THE STACK FOR ‘FOR/NEXT’ DATA LEAS 2,S ; PURGE RETURN ADDRESS OFF OF THE STACK BNE LAD59 ; BRANCH IF INDEX VARIABLE NOT ALREADY BEING USED LDX TEMPTR ; GET (ADDRESS + 18) OF MATCHED ‘FOR/NEXT’ DATA LEAS B,X ; MOVE THE STACK POINTER TO THE BEGINNING OF THE * MATCHED ‘FOR/NEXT’ DATA SO THE NEW DATA WILL * OVERLAY THE OLD DATA. THIS WILL ALSO DESTROY * ALL OF THE ‘RETURN’ AND ‘FOR/NEXT’ DATA BELOW * THIS POINT ON THE STACK LAD59: LDB #$09 ; * CHECK FOR ROOM FOR 18 BYTES JSR LAC33 ; * IN FREE RAM JSR LAEE8 ; GET ADDR OF END OF SUBLINE IN X LDD CURLIN ; GET CURRENT LINE NUMBER PSHS X,B,A ; SAVE LINE ADDR AND LINE NUMBER ON STACK LDB #$A5 ; TOKEN FOR ‘TO’ JSR LB26F ; SYNTAX CHECK FOR ‘TO’ JSR LB143 ; ‘TM’ ERROR IF INDEX VARIABLE SET TO STRING JSR LB141 ; EVALUATE EXPRESSION * LDB FP0SGN ; GET FPA0 MANTISSA SIGN ORB #$7F ; FORM A MASK TO SAVE DATA BITS OF HIGH ORDER MANTISSA ANDB FPA0 ; PUT THE MANTISSA SIGN IN BIT 7 OF HIGH ORDER MANTISSA STB FPA0 ; SAVE THE PACKED HIGH ORDER MANTISSA LDY #LAD7F ; LOAD FOLLOWING ADDRESS INTO Y AS A RETURN JMP LB1EA ; ADDRESS - PUSH FPA0 ONTO THE STACK LAD7F: LDX #LBAC5 ; POINT X TO FLOATING POINT NUMBER 1.0 (DEFAULT STEP VALUE) JSR LBC14 ; MOVE (X) TO FPA0 JSR GETCCH ; GET CURRENT INPUT CHARACTER CMPA #$A9 ; STEP TOKEN BNE LAD90 ; BRANCH IF NO ‘STEP’ VALUE JSR GETNCH ; GET A CHARACTER FROM BASIC JSR LB141 ; EVALUATE NUMERIC EXPRESSION LAD90: JSR LBC6D ; CHECK STATUS OF FPA0 JSR LB1E6 ; SAVE STATUS AND FPA0 ON THE STACK LDD VARDES ; * GET DESCRIPTOR POINTER FOR THE ‘STEP’ PSHS B,A ; * VARIABLE AND SAVE IT ON THE STACK LDA #$80 ; = GET THE ‘FOR’ FLAG AND PSHS A ; = SAVE IT ON THE STACK * * MAIN COMMAND INTERPRETATION LOOP LAD9E: JSR RVEC20 ; HOOK INTO RAM JSR XVEC20 ANDCC #$AF ; ENABLE IRQ,FIRQ JSR LADEB ; CHECK FOR KEYBOARD BREAK LDX CHARAD ; GET BASIC’S INPUT POINTER STX TINPTR ; SAVE IT LDA ,X+ ; GET CURRENT INPUT CHAR & MOVE POINTER BEQ LADB4 ; BRANCH IF END OF LINE CMPA #':' ; CHECK FOR LINE SEPARATOR BEQ LADC0 ; BRANCH IF COLON LADB1: JMP LB277 ; ‘SYNTAX ERROR’-IF NOT LINE SEPARATOR LADB4: LDA ,X++ ; GET MS BYTE OF ADDRESS OF NEXT BASIC LINE STA ENDFLG ; SAVE IN STOP/END FLAG - CAUSE A STOP IF * NEXT LINE ADDRESS IS < $8000; CAUSE * AN END IF ADDRESS > $8000 BEQ LAE15 ; BRANCH TO ‘STOP’ - END OF PROGRAM LDD ,X+ ; GET CURRENT LINE NUMBER STD CURLIN ; SAVE IN CURLIN STX CHARAD ; SAVE ADDRESS OF FIRST BYTE OF LINE LADC0: JSR GETNCH ; GET A CHARACTER FROM BASIC BSR LADC6 ; GO PROCESS COMMAND BRA LAD9E ; GO BACK TO MAIN LOOP LADC6: BEQ LADEA ; RETURN IF END OF LINE (RTS - was BEQ LAE40) CMPA #'*' ; JGH: untokenised '*' -> *command BEQ EXTCMD ; CMPA #$AD ; JGH: tokenised '*' -> *command BEQ EXTCMD ; TSTA ; CHECK FOR TOKEN - BIT 7 SET (NEGATIVE) LBPL LET ; BRANCH IF NOT A TOKEN - GO TO ‘LET’ WHICH * ; IS THE ‘DEFAULT’ TOKEN FOR MICROSOFT BASIC CMPA #$FF ; SECONDARY TOKEN BEQ SECTOK CMPA #MAXCMD ; HIGHEST EXECUTABLE COMMAND IN BASIC BHI LADDC ; BRANCH IF > A BASIC COMMAND LDX COMVEC+3 ; GET ADDRESS OF BASIC’S COMMAND TABLE LADD4: ASLA ; X2 (2 BYTE/JUMP ADDRESS) & DISCARD BIT 7 TFR A,B ; SAVE COMMAND OFFSET IN ACCB ABX ; NON X POINTS TO COMMAND JUMP ADDR JSR GETNCH ; GET AN INPUT CHAR * * HERE IS WHERE WE BRANCH TO DO A ‘COMMAND’ JMP [,X] ; DO A COMMAND LADDC: CMPA #MAXCMD ; CHECK AGAINST HIGHEST BASIC TOKEN BLS LADB1 ; ‘SYNTAX ERROR’ IF NON-EXECUTABLE TOKEN JMP [COMVEC+13] ; JUMP TO AN EXECUTE BASIC COMMAND EXTCMD: JSR HOSTCMD ; Pass command to host BRA LADC0 ; Execute next line SECTOK: JSR GETNCH ; GET AN INPUT CHAR CMPA #$97 ; TOKEN FOR "MID$" LBEQ L86D6 ; PROCESS MID$ REPLACEMENT JMP LB277 ; SYNTAX ERROR * * RESTORE RESTOR: LDX TXTTAB ; BEGINNING OF PROGRAM ADDRESS LEAX -1,X ; MOVE TO ONE BYTE BEFORE PROGRAM LADE8: STX DATPTR ; SAVE NEW DATA POINTER LADEA: RTS * * BREAK CHECK LADEB: JSR CHKESCAPE ; JGH BMI LAE0D ; JGH JSR LA1C1 ; GET A KEYSTROKE ENTRY BEQ LADFA ; RETURN IF NO INPUT LADF0: CMPA #3 ; CONTROL C? (BREAK) BEQ STOP ; YES CMPA #$13 ; CONTROL S? (PAUSE) BEQ LADFB ; YES STA IKEYIM ; SAVE KEYSTROKE IN INKEY IMAGE LADFA: RTS LADFB: JSR KEYIN ; GET A KEY BEQ LADFB ; BRANCH IF NO KEY DOWN BRA LADF0 ; CONTINUE - DO A BREAK CHECK * * END cmdEND: JSR GETCCH ; GET CURRENT INPUT CHAR BRA LAE0B * * STOP STOP: ORCC #$01 ; SET CARRY FLAG LAE0B: BNE LAE40 ; BRANCH IF ARGUMENT EXISTS LAE0D: LDX CHARAD ; * SAVE CURRENT POSITION OF STX TINPTR ; * BASIC’S INPUT POINTER LAE11: ROR ENDFLG ; ROTATE CARRY INTO BIT 7 OF STOP/END FLAG LEAS 2,S ; PURGE RETURN ADDRESS OFF STACK LAE15: LDX CURLIN ; GET CURRENT LINE NUMBER CMPX #$FFFF ; DIRECT MODE? BEQ LAE22 ; YES STX OLDTXT ; SAVE CURRENT LINE NUMBER LDX TINPTR ; * GET AND SAVE CURRENT POSITION STX OLDPTR ; * OF BASIC’S INPUT POINTER LAE22: LDX #LABF2-1 ; POINT TO CR, ‘BREAK’ MESSAGE TST ENDFLG ; CHECK STOP/END FLAG LBPL LAC73 ; BRANCH TO MAIN LOOP OF BASIC IF END JMP LAC68 ; PRINT ‘BREAK AT ####’ AND GO TO * ; BASIC’S MAIN LOOP IF ‘STOP’ * CONT CONT: BNE LAE40 ; RETURN IF ARGUMENT GIVEN LDB #2*16 ; ‘CAN’T CONTINUE’ ERROR LDX OLDPTR ; GET CONTINUE ADDRESS (INPUT POINTER) LBEQ LAC46 ; ‘CN’ ERROR IF CONTINUE ADDRESS = 0 STX CHARAD ; RESET BASIC’S INPUT POINTER LDX OLDTXT ; GET LINE NUMBER STX CURLIN ; RESET CURRENT LINE NUMBER LAE40: RTS * * CLEAR CLEAR: BEQ LAE6F ; BRANCH IF NO ARGUMENT JSR LB3E6 ; EVALUATE ARGUMENT PSHS B,A ; SAVE AMOUNT OF STRING SPACE ON STACK LDX MEMSIZ ; GET CURRENT TOP OF CLEARED SPACE JSR GETCCH ; GET CURRENT INPUT CHARACTER BEQ LAE5A ; BRANCH IF NO NEW TOP OF CLEARED SPACE JSR LB26D ; SYNTAX CHECK FOR COMMA JSR LB73D ; EVALUATE EXPRESSlON; RETURN VALUE IN X LEAX -1,X ; X = TOP OF CLEARED SPACE CMPX TOPRAM ; COMPARE TO TOP OF RAM BHI LAE72 ; ‘OM’ ERROR IF > TOP OF RAM LAE5A: TFR X,D ; ACCD = TOP OF CLEARED SPACE SUBD ,S++ ; SUBTRACT OUT AMOUNT OF CLEARED SPACE BCS LAE72 ; ‘OM’ ERROR IF FREE MEM < 0 TFR D,U ; U = BOTTOM OF CLEARED SPACE SUBD #STKBUF ; SUBTRACT OUT STACK BUFFER BCS LAE72 ; ‘OM’ ERROR IF FREE MEM < 0 SUBD VARTAB ; SUBTRACT OUT START OF VARIABLES BCS LAE72 ; ‘OM’ ERROR IF FREE MEM < 0 STU FRETOP ; SAVE NEW BOTTOM OF CLEARED SPACE STX MEMSIZ ; SAVE NEW TOP OF CLEARED SPACE LAE6F: JMP LAD26 ; ERASE ALL VARIABLES, INITIALIZE POINTERS, ETC LAE72: JMP LAC44 ; ‘OM’ ERROR * * RUN RUN: JSR RVEC18 ; HOOK INTO RAM JSR GETCCH ; * GET CURRENT INPUT CHARACTER LBEQ LAD21 ; * IF NO LINE NUMBER JSR LAD26 ; ERASE ALL VARIABLES BRA LAE9F ; ‘GOTO’ THE RUN ADDRESS * * GO GO: TFR A,B ; SAVE INPUT CHARACTER IN ACCB LAE88: JSR GETNCH ; GET A CHARACTER FROM BASIC CMPB #$A5 ; ‘TO’ TOKEN BEQ LAEA4 ; BRANCH IF GOTO CMPB #$A6 ; ‘SUB’ TOKEN BNE LAED7 ; ‘SYNTAX ERROR’ IF NEITHER LDB #3 ; =ROOM FOR 6 JSR LAC33 ; =BYTES ON STACK? LDU CHARAD ; * SAVE CURRENT BASIC INPUT POINTER, LINE LDX CURLIN ; * NUMBER AND SUB TOKEN ON STACK LDA #$A6 ; * PSHS U,X,A ; * LAE9F: BSR LAEA4 ; DO A ‘GOTO’ JMP LAD9E ; JUMP BACK TO BASIC’S MAIN LOOP * GOTO LAEA4: JSR GETCCH ; GET CURRENT INPUT CHAR JSR LAF67 ; GET LINE NUMBER TO BINARY IN BINVAL BSR LAEEB ; ADVANCE BASIC’S POINTER TO END OF LINE LEAX $01,X ; POINT TO START OF NEXT LINE LDD BINVAL ; GET THE LINE NUMBER TO RUN CMPD CURLIN ; COMPARE TO CURRENT LINE NUMBER BHI LAEB6 ; IF REO’D LINE NUMBER IS > CURRENT LINE NUMBER, * DON’T START LOOKING FROM * START OF PROGRAM LDX TXTTAB ; BEGINNING OF PROGRAM LAEB6: JSR LAD05 ; GO FIND A LINE NUMBER BCS LAED2 ; ‘UNDEFINED LINE NUMBER’ LAEBB: LEAX -1,X ; MOVE BACK TO JUST BEFORE START OF LINE STX CHARAD ; RESET BASIC’S INPUT POINTER LAEBF: RTS * * RETURN RETURN: BNE LAEBF ; EXIT ROUTINE IF ARGUMENT GIVEN LDA #$FF ; * PUT AN ILLEGAL VARIABLE NAME IN FIRST BYTE OF STA VARDES ; * VARDES WHICH WILL CAUSE ‘FOR/NEXT’ DATA ON THE * STACK TO BE IGNORED JSR LABF9 ; CHECK FOR RETURN DATA ON THE STACK TFR X,S ; RESET STACK POINTER - PURGE TWO RETURN ADDRESSES * FROM THE STACK CMPA #$A6-$80 ; SUB TOKEN - $80 BEQ LAEDA ; BRANCH IF ‘RETURN’ FROM SUBROUTINE LDB #2*2 ; ERROR #2 ‘RETURN WITHOUT GOSUB’ FCB SKP2 ; SKIP TWO BYTES LAED2: LDB #7*2 ; ERROR #7 ‘UNDEFINED LINE NUMBER’ JMP LAC46 ; JUMP TO ERROR HANDLER LAED7: JMP LB277 ; ‘SYNTAX ERROR’ LAEDA: PULS A,X,U ; * RESTORE VALUES OF CURRENT LINE NUMBER AND STX CURLIN ; * BASIC’S INPUT POINTER FOR THIS SUBROUTINE STU CHARAD ; * AND LOAD ACCA WITH SUB TOKEN ($A6) * * DATA cmdDATA: BSR LAEE8 ; MOVE INPUT POINTER TO END OF SUBLINE OR LINE FCB SKP2 ; SKIP 2 BYTES * REM, ELSE cmdELSE: REM: BSR LAEEB ; MOVE INPUT POINTER TO END OF LINE STX CHARAD ; RESET BASIC’S INPUT POINTER LAEE7: RTS * ADVANCE INPUT POINTER TO END OF SUBLINE OR LINE LAEE8 LDB #':' ; COLON = SUBLINE TERMINATOR CHARACTER LAEEA: FCB SKP1LD ; SKP1LD SKIP ONE BYTE; LDA #$5F * ADVANCE BASIC’S INPUT POINTER TO END OF * LINE - RETURN ADDRESS OF END OF LINE+1 IN X LAEEB: CLRB ; 0 = LINE TERMINATOR CHARACTER STB CHARAC ; TEMP STORE PRIMARY TERMINATOR CHARACTER CLRB ; 0 (END OF LINE) = ALTERNATE TERM. CHAR. LDX CHARAD ; LOAD X W/BASIC’S INPUT POINTER LAEF1: TFR B,A ; * CHANGE TERMINATOR CHARACTER LDB CHARAC ; * FROM ACCB TO CHARAC - SAVE OLD TERMINATOR * IN CHARAC STA CHARAC ; SWAP PRIMARY AND SECONDARY TERMINATORS LAEF7: LDA ,X ; GET NEXT INPUT CHARACTER BEQ LAEE7 ; RETURN IF 0 (END OF LINE) PSHS B ; SAVE TERMINATOR ON STACK CMPA ,S+ ; COMPARE TO INPUT CHARACTER BEQ LAEE7 ; RETURN IF EQUAL LEAX 1,X ; MOVE POINTER UP ONE CMPA #'"' ; CHECK FOR DOUBLE QUOTES BEQ LAEF1 ; BRANCH IF " - TOGGLE TERMINATOR CHARACTERS INCA ; * CHECK FOR $FF AND BRANCH IF BNE LAF0C ; * NOT SECONDARY TOKEN LEAX 1,X ; MOVE INPUT POINTER 1 MORE IF SECONDARY LAF0C: CMPA #$85+1 ; TOKEN FOR IF? BNE LAEF7 ; NO - GET ANOTHER INPUT CHARACTER INC IFCTR ; INCREMENT IF COUNTER - KEEP TRACK OF HOW MANY * ; ‘IF’ STATEMENTS ARE NESTED IN ONE LINE BRA LAEF7 ; GET ANOTHER INPUT CHARACTER * IF cmdIF: JSR LB141 ; EVALUATE NUMERIC EXPRESSION JSR GETCCH ; GET CURRENT INPUT CHARACTER CMPA #$81 ; TOKEN FOR GO BEQ LAF22 ; TREAT ‘GO’ THE SAME AS ‘THEN’ LDB #$A7 ; TOKEN FOR THEN JSR LB26F ; DO A SYNTAX CHECK ON ACCB LAF22: LDA FP0EXP ; CHECK FOR TRUE/FALSE - FALSE IF FPA0 EXPONENT = ZERO BNE LAF39 ; BRANCH IF CONDITION TRUE CLR IFCTR ; CLEAR FLAG - KEEP TRACK OF WHICH NESTED ELSE STATEMENT * ; TO SEARCH FOR IN NESTED ‘IF’ LOOPS LAF28: BSR cmdDATA ; MOVE BASIC’S POINTER TO END OF SUBLINE TSTA ; * CHECK TO SEE IF END OF LINE OR SUBLINE BEQ LAEE7 ; * AND RETURN IF END OF LINE JSR GETNCH ; GET AN INPUT CHARACTER FROM BASIC CMPA #$84 ; TOKEN FOR ELSE BNE LAF28 ; IGNORE ALL DATA EXCEPT ‘ELSE’ UNTIL * ; END OF LINE (ZERO BYTE) DEC IFCTR ; CHECK TO SEE IF YOU MUST SEARCH ANOTHER SUBLINE BPL LAF28 ; BRANCH TO SEARCH ANOTHER SUBLINE FOR ‘ELSE’ JSR GETNCH ; GET AN INPUT CHARACTER FROM BASIC LAF39: JSR GETCCH ; GET CURRENT INPUT CHARACTER LBCS LAEA4 ; BRANCH TO ‘GOTO’ IF NUMERIC CHARACTER JMP LADC6 ; RETURN TO MAIN INTERPRETATION LOOP * ON ON: JSR LB70B ; EVALUATE EXPRESSION LDB #$81 ; TOKEN FOR GO JSR LB26F ; SYNTAX CHECK FOR GO PSHS A ; SAVE NEW TOKEN (TO,SUB) CMPA #$A6 ; TOKEN FOR SUB? BEQ LAF54 ; YES CMPA #$A5 ; TOKEN FOR TO? LAF52: LBNE LAED7 ; ‘SYNTAX’ ERROR IF NOT ‘SUB’ OR ‘TO’ LAF54: DEC FPA0+3 ; DECREMENT IS BYTE OF MANTISSA OF FPA0 - THIS * ; IS THE ARGUMENT OF THE ‘ON’ STATEMENT BNE LAF5D ; BRANCH IF NOT AT THE PROPER GOTO OR GOSUB LINE NUMBER PULS B ; GET BACK THE TOKEN FOLLOWING ‘GO’ JMP LAE88 ; DO A ‘GOTO’ OR ‘GOSUB’ LAF5D: JSR GETNCH ; GET A CHARACTER FROM BASIC BSR LAF67 ; CONVERT BASIC LINE NUMBER TO BINARY CMPA #',' ; IS CHARACTER FOLLOWING LINE NUMBER A COMMA? BEQ LAF54 ; YES PULS B,PC ; IF NOT, FALL THROUGH TO NEXT COMMAND LAF67: LDX ZERO ; DEFAULT LINE NUMBER OF ZERO STX BINVAL ; SAVE IT IN BINVAL * * CONVERT LINE NUMBER TO BINARY - RETURN VALUE IN BINVAL * LAF6B: BCC LAFCE ; RETURN IF NOT NUMERIC CHARACTER SUBA #'0' ; MASK OFF ASCII STA CHARAC ; SAVE DIGIT IN VO1 LDD BINVAL ; GET ACCUMULATED LINE NUMBER VALUE CMPA #24 ; LARGEST LINE NUMBER IS $F9FF (63999) - * (24*256+255)*10+9 BHI LAF52 ; ‘SYNTAX’ ERROR IF TOO BIG * MULT ACCD X 10 ASLB ; * ROLA ; * TIMES 2 ASLB ; = ROLA ; = TIMES 4 ADDD BINVAL ; ADD 1 = TIMES 5 ASLB ; * ROLA ; * TIMES 10 ADDB CHARAC ; ADD NEXT DIGIT ADCA #0 ; PROPAGATE CARRY STD BINVAL ; SAVE NEW ACCUMULATED LINE NUMBER JSR GETNCH ; GET NEXT CHARACTER FROM BASIC BRA LAF6B ; LOOP- PROCESS NEXT DIGIT * * LET (EXBAS) * EVALUATE A NON-TOKEN EXPRESSION * TARGET = REPLACEMENT LET: JSR LB357 ; FIND TARGET VARIABLE DESCRIPTOR STX VARDES ; SAVE DESCRIPTOR ADDRESS OF 1ST EXPRESSION LDB #$B3 ; TOKEN FOR "=" JSR LB26F ; DO A SYNTAX CHECK FOR ‘=‘ LDA VALTYP ; * GET VARIABLE TYPE AND PSHS A ; * SAVE ON THE STACK JSR LB156 ; EVALUATE EXPRESSION PULS A ; * REGET VARIABLE TYPE OF 1ST EXPRESSION AND RORA ; * SET CARRY IF STRING JSR LB148 ; TYPE CHECK-TM ERROR IF VARIABLE TYPES ON * ; BOTH SIDES OF EQUALS SIGN NOT THE SAME LBEQ LBC33 ; GO PUT FPA0 INTO VARIABLE DESCRIPTOR IF NUMERIC * MOVE A STRING WHOSE DESCRIPTOR IS LOCATED AT * FPA0+2 INTO THE STRING SPACE. TRANSFER THE * DESCRIPTOR ADDRESS TO THE ADDRESS IN VARDES * DON’T MOVE THE STRING IF IT ; IS ALREADY IN THE * STRING SPACE. REMOVE DESCRIPTOR FROM STRING * STACK IF IT IS LAST ONE ON THE STACK LAFA4: LDX FPA0+2 ; POINT X TO DESCRIPTOR OF REPLACEMENT STRING LDD FRETOP ; LOAD ACCD WITH START OF STRING SPACE CMPD 2,X ; IS THE STRING IN STRING SPACE? BCC LAFBE ; BRANCH IF IT’S NOT IN THE STRING SPACE CMPX VARTAB ; COMPARE DESCRIPTOR ADDRESS TO START OF VARIABLES BCS LAFBE ; BRANCH IF DESCRIPTOR ADDRESS NOT IN VARIABLES LAFB1: LDB ,X ; GET LENGTH OF REPLACEMENT STRING JSR LB50D ; RESERVE ACCB BYTES OF STRING SPACE LDX V4D ; GET DESCRIPTOR ADDRESS BACK JSR LB643 ; MOVE STRING INTO STRING SPACE LDX #STRDES ; POINT X TO TEMP STRING DESCRIPTOR ADDRESS LAFBE: STX V4D ; SAVE STRING DESCRIPTOR ADDRESS IN V4D JSR LB675 ; REMOVE STRING DESCRIPTOR IF LAST ONE * ON STRING STACK LDU V4D ; POINT U TO REPLACEMENT DESCRIPTOR ADDRESS LDX VARDES ; GET TARGET DESCRIPTOR ADDRESS PULU A,B,Y ; GET LENGTH AND START OF REPLACEMENT STRING STA ,X ; * SAVE STRING LENGTH AND START IN STY 2,X ; * TARGET DESCRIPTOR LOCATION LAFCE: RTS LAFCF: FCC "?REDO" ; ?REDO MESSAGE FCB CR,$00 LAFD6: LAFDC: JMP LAC46 ; JMP TO ERROR HANDLER LAFDF: LDA INPFLG ; = GET THE INPUT FLAG AND BRANCH BEQ LAFEA ; = IF ‘INPUT’ LDX DATTXT ; * GET LINE NUMBER WHERE THE ERROR OCCURRED STX CURLIN ; * AND USE IT AS THE CURRENT LINE NUMBER JMP LB277 ; ‘SYNTAX ERROR’ LAFEA: LDX #LAFCF-1 ; * POINT X TO ‘?REDO’ AND PRINT JSR LB99C ; * IT ON THE SCREEN LDX TINPTR ; = GET THE SAVED ABSOLUTE ADDRESS OF STX CHARAD ; = INPUT POINTER AND RESTORE IT RTS * * INPUT INPUT: LDB #11*2 ; ‘ID’ ERROR LDX CURLIN ; GET CURRENT LINE NUMBER LEAX 1,X ; ADD ONE BEQ LAFDC ; ‘ID’ ERROR BRANCH IF DIRECT MODE BSR LB00F ; GET SOME INPUT DATA - WAS LB002 RTS LB00F: CMPA #'"' ; CHECK FOR PROMPT STRING DELIMITER BNE LB01E ; BRANCH IF NO PROMPT STRING JSR LB244 ; PUT PROMPT STRING ON STRING STACK LDB #';' ; * JSR LB26F ; * DO A SYNTAX CHECK FOR SEMICOLON JSR LB99F ; PRINT MESSAGE TO CONSOLE OUT LB01E: LDX #LINBUF ; POINT TO BASIC’S LINE BUFFER CLR ,X ; CLEAR 1ST BYTE - FLAG TO INDICATE NO DATA * IN LINE BUFFER BSR LB02F ; INPUT A STRING TO LINE BUFFER LDB #',' ; * INSERT A COMMA AT THE END STB ,X ; * OF THE LINE INPUT BUFFER BRA LB049 * FILL BASIC’S LINE INPUT BUFFER CONSOLE IN LB02F: JSR LB9AF ; SEND A "?" TO CONSOLE OUT JSR LB9AC ; SEND A ‘SPACE’ TO CONSOLE OUT LB035: JSR LA390 ; GO READ IN A BASIC LINE BCC LB03F ; BRANCH IF ENTER KEY ENDED ENTRY LEAS 4,S ; PURGE TWO RETURN ADDRESSES OFF THE STACK JMP LAE11 ; GO TO ‘STOP’ IF BREAK KEY ENDED LINE ENTRY LB03F: LDB #2*23 ; ‘INPUT PAST END OF FILE’ ERROR RTS * * READ READ: LDX DATPTR ; GET ‘READ’ START ADDRESS FCB SKP1LD ; SKIP ONE BYTE - LDA #*$4F LB049 CLRA ; ‘INPUT’ ENTRY POINT: INPUT FLAG = 0 STA INPFLG ; SET INPUT FLAG; 0 = INPUT: <> 0 = READ STX DATTMP ; SAVE ‘READ’ START ADDRESS/’INPUT’ BUFFER START LB04E: JSR LB357 ; EVALUATE A VARIABLE STX VARDES ; SAVE DESCRIPTOR ADDRESS LDX CHARAD ; * GET BASIC’S INPUT POINTER STX BINVAL ; * AND SAVE IT LDX DATTMP ; GET ‘READ’ ADDRESS START/’INPUT’ BUFFER POINTER LDA ,X ; GET A CHARACTER FROM THE BASIC PROGRAM BNE LB069 ; BRANCH IF NOT END OF LINE LDA INPFLG ; * CHECK INPUT FLAG AND BRANCH BNE LB0B9 ; * IF LOOKING FOR DATA (READ) * NO DATA IN ‘INPUT’ LINE BUFFER AND/OR INPUT * NOT COMING FROM SCREEN JSR RVEC10 ; HOOK INTO RAM IF ‘INPUT’ JSR LB9AF ; SEND A '?' TO CONSOLE OUT BSR LB02F ; FILL INPUT BUFFER FROM CONSOLE IN LB069: STX CHARAD ; RESET BASIC’S INPUT POINTER JSR GETNCH ; GET A CHARACTER FROM BASIC LDB VALTYP ; * CHECK VARIABLE TYPE AND BEQ LB098 ; * BRANCH IF NUMERIC * READ/INPUT A STRING VARIABLE LDX CHARAD ; LOAD X WITH CURRENT BASIC INPUT POINTER STA CHARAC ; SAVE CURRENT INPUT CHARACTER CMPA #'"' ; CHECK FOR STRING DELIMITER BEQ LB08B ; BRANCH IF STRING DELIMITER LEAX -1,X ; BACK UP POINTER CLRA ; * ZERO = END OF LINE CHARACTER STA CHARAC ; * SAVE AS TERMINATOR JSR LA35F ; SET UP PRINT PARAMETERS LDA #':' ; END OF SUBLINE CHARACTER STA CHARAC ; SAVE AS TERMINATOR I LDA #',' ; COMMA LB08B: STA ENDCHR ; SAVE AS TERMINATOR 2 JSR LB51E ; STRIP A STRING FROM THE INPUT BUFFER JSR LB249 ; MOVE INPUT POINTER TO END OF STRING JSR LAFA4 ; PUT A STRING INTO THE STRING SPACE IF NECESSARY BRA LB09E ; CHECK FOR ANOTHER DATA ITEM * SAVE A NUMERIC VALUE IN A READ OR INPUT DATA ITEM LB098: JSR LBD12 ; CONVERT AN ASCII STRING TO FP NUMBER JSR LBC33 ; PACK FPA0 AND STORE IT IN ADDRESS IN VARDES - * ; INPUT OR READ DATA ITEM LB09E: JSR GETCCH ; GET CURRENT INPUT CHARACTER BEQ LB0A8 ; BRANCH IF END OF LINE CMPA #',' ; CHECK FOR A COMMA LBNE LAFD6 ; BAD FILE DATA' ERROR OR RETRY LB0A8: LDX CHARAD ; * GET CURRENT INPUT STX DATTMP ; * POINTER (USED AS A DATA POINTER) AND SAVE IT LDX BINVAL ; * RESET INPUT POINTER TO INPUT OR STX CHARAD ; * READ STATEMENT JSR GETCCH ; GET CURRENT CHARACTER FROM BASIC BEQ LB0D5 ; BRANCH IF END OF LINE - EXIT COMMAND JSR LB26D ; SYNTAX CHECK FOR COMMA BRA LB04E ; GET ANOTHER INPUT OR READ ITEM * SEARCH FROM ADDRESS IN X FOR * 1ST OCCURENCE OF THE TOKEN FOR DATA LB0B9: STX CHARAD ; RESET BASIC’S INPUT POINTER JSR LAEE8 ; SEARCH FOR END OF CURRENT LINE OR SUBLINE LEAX 1,X ; MOVE X ONE PAST END OF LINE TSTA ; CHECK FOR END OF LINE BNE LB0CD ; BRANCH IF END OF SUBLINE LDB #2*3 ; ‘OUT OF DATA’ ERROR LDU ,X++ ; GET NEXT 2 CHARACTERS BEQ LB10A ; ‘OD’ ERROR IF END OF PROGRAM LDD ,X++ ; GET BASIC LINE NUMBER AND STD DATTXT ; SAVE IT IN DATTXT LB0CD: LDA ,X ; GET AN INPUT CHARACTER CMPA #$86 ; DATA TOKEN? BNE LB0B9 ; NO — KEEP LOOKING BRA LB069 ; YES * EXIT READ AND INPUT COMMANDS LB0D5: LDX DATTMP ; GET DATA POINTER LDB INPFLG ; * CHECK INPUT FLAG LBNE LADE8 ; * SAVE NEW DATA POINTER IF READ LDA ,X ; = CHECK NEXT CHARACTER IN ‘INPUT’ BUFFER BEQ LB0E7 ; = LDX #LB0E8-1 ; POINT X TO ‘?EXTRA IGNORED’ JMP LB99C ; PRINT THE MESSAGE LB0E7: RTS LB0E8: FCC "?EXTRA IGNORED" ; ?EXTRA IGNORED MESSAGE FCB CR,$00 * NEXT NEXT: BNE LB0FE ; BRANCH IF ARGUMENT GIVEN LDX ZERO ; X = 0: DEFAULT FOR NO ARGUMENT BRA LB101 LB0FE: JSR LB357 ; EVALUATE AN ALPHA EXPRESSION LB101: STX VARDES ; SAVE VARIABLE DESCRIPTOR POINTER JSR LABF9 ; GO SCAN FOR ‘FOR/NEXT’ DATA ON STACK BEQ LB10C ; BRANCH IF DATA FOUND LDB #0 ; ‘NEXT WITHOUT FOR’ ERROR (SHOULD BE CLRB) LB10A: BRA LB153 ; PROCESS ERROR LB10C: TFR X,S ; POINT S TO START OF ‘FOR/NEXT’ DATA LEAX 3,X ; POINT X TO FP VALUE OF STEP JSR LBC14 ; COPY A FP NUMBER FROM (X) TO FPA0 LDA 8,S ; GET THE DIRECTION OF STEP STA FP0SGN ; SAVE IT AS THE SIGN OF FPA0 LDX VARDES ; POINT (X) TO INDEX VARIABLE DESCRIPTOR JSR LB9C2 ; ADD (X) TO FPA0 (STEP TO INDEX) JSR LBC33 ; PACK FPA0 AND STORE IT IN ADDRESS * ; CONTAINED IN VARDES LEAX 9,S ; POINT (X) TO TERMINAL VALUE OF INDEX JSR LBC96 ; COMPARE CURRENT INDEX VALUE TO TERMINAL VALUE OF INDEX SUBB 8,S ; ACCB = 0 IF TERMINAL VALUE=CURRENT VALUE AND STEP=0 OR IF * ; STEP IS POSITIVE AND CURRENT VALUE>TERMINAL VALUE OR * ; STEP IS NEGATIVE AND CURRENT VALUE BCS LB181 ; BRANCH IF LESS THAN RELATIONAL OPERATORS CMPA #3 ; * BCC LB181 ; * BRANCH IF GREATER THAN RELATIONAL OPERATORS CMPA #1 ; SET CARRY IF ‘>‘ ROLA ; CARRY TO BIT 0 EORA TRELFL ; * CARRY SET IF CMPA TRELFL ; * TRELFL = ACCA BCS LB1DF ; BRANCH IF SYNTAX ERROR : == << OR >> STA TRELFL ; BIT 0: >, BIT 1 =, BIT 2: < JSR GETNCH ; GET AN INPUT CHARACTER BRA LB16A ; CHECK FOR ANOTHER RELATIONAL OPERATOR * LB181: LDB TRELFL ; GET RELATIONAL OPERATOR FLAG BNE LB1B8 ; BRANCH IF RELATIONAL COMPARISON LBCC LB1F4 ; BRANCH IF > RELATIONAL OPERATOR ADDA #7 ; SEVEN ARITHMETIC/LOGICAL OPERATORS BCC LB1F4 ; BRANCH IF NOT ARITHMETIC/LOGICAL OPERATOR ADCA VALTYP ; ADD CARRY, NUMERIC FLAG AND MODIFIED TOKEN NUMBER LBEQ LB60F ; BRANCH IF VALTYP = FF, AND ACCA = ‘+‘ TOKEN - * ; CONCATENATE TWO STRINGS ADCA #-1 ; RESTORE ARITHMETIC/LOGICAL OPERATOR NUMBER PSHS A ; * STORE OPERATOR NUMBER ON STACK; MULTIPLY IT BY 2 ASLA ; * THEN ADD THE STORED STACK DATA = MULTIPLY ADDA ,S+ ; * X 3; 3 BYTE/TABLE ENTRY LDX #LAA51 ; JUMP TABLE FOR ARITHMETIC & LOGICAL OPERATORS LEAX A,X ; POINT X TO PROPER TABLE LB19F: PULS A ; GET PRECEDENCE FLAG FROM STACK CMPA ,X ; COMPARE TO CURRENT OPERATOR BCC LB1FA ; BRANCH IF STACK OPERATOR > CURRENT OPERATOR BSR LB143 ; ‘TM’ ERROR IF VARIABLE TYPE = STRING * OPERATION BEING PROCESSED IS OF HIGHER PRECEDENCE THAN THE PREVIOUS OPERATION. LB1A7: PSHS A ; SAVE PRECEDENCE FLAG BSR LB1D4 ; PUSH OPERATOR ROUTINE ADDRESS AND FPA0 ONTO STACK LDX RELPTR ; GET POINTER TO ARITHMETIC/LOGICAL TABLE ENTRY FOR * ; LAST CALCULATED OPERATION PULS A ; GET PRECEDENCE FLAG OF PREVIOUS OPERATION BNE LB1CE ; BRANCH IF NOT END OF OPERATION TSTA ; CHECK TYPE OF PRECEDENCE FLAG LBEQ LB220 ; BRANCH IF END OF EXPRESSION OR SUB-EXPRESSION BRA LB203 ; EVALUATE AN OPERATION LB1B8: ASL VALTYP ; BIT 7 OF TYPE FLAG TO CARRY ROLB ; SHIFT RELATIONAL FLAG LEFT - VALTYP TO BIT 0 BSR LB1C6 ; MOVE THE INPUT POINTER BACK ONE LDX #LB1CB ; POINT X TO RELATIONAL COMPARISON JUMP TABLE STB TRELFL ; SAVE RELATIONAL COMPARISON DATA CLR VALTYP ; SET VARIABLE TYPE TO NUMERIC BRA LB19F ; PERFORM OPERATION OR SAVE ON STACK LB1C6: LDX CHARAD ; * GET BASIC’S INPUT POINTER AND JMP LAEBB ; * MOVE IT BACK ONE * RELATIONAL COMPARISON JUMP TABLE LB1CB: FCB $64 ; RELATIONAL COMPARISON FLAG LB1CC: FDB LB2F4 ; JUMP ADDRESS LB1CE: CMPA ,X ; COMPARE PRECEDENCE OF LAST DONE OPERATION TO * NEXT TO BE DONE OPERATION BCC LB203 ; EVALUATE OPERATION IF LOWER PRECEDENCE BRA LB1A7 ; PUSH OPERATION DATA ON STACK IF HIGHER PRECEDENCE * PUSH OPERATOR EVALUATION ADDRESS AND FPA0 ONTO STACK AND EVALUATE ANOTHER EXPR LB1D4: LDD 1,X ; GET ADDRESS OF OPERATOR ROUTINE PSHS B,A ; SAVE IT ON THE STACK BSR LB1E2 ; PUSH FPA0 ONTO STACK LDB TRELFL ; GET BACK RELATIONAL OPERATOR FLAG LBRA LB15A ; EVALUATE ANOTHER EXPRESSION LB1DF: JMP LB277 ; ‘SYNTAX ERROR’ * PUSH FPA0 ONTO THE STACK. ,S = EXPONENT * 1-2,S =HIGH ORDER MANTISSA 3-4,S = LOW ORDER MANTISSA * 5,S = SIGN RETURN WITH PRECEDENCE CODE IN ACCA LB1E2: LDB FP0SGN ; GET SIGN OF FPA0 MANTISSA LDA ,X ; GET PRECEDENCE CODE TO ACCA LB1E6: PULS Y ; GET RETURN ADDRESS FROM STACK & PUT IT IN Y PSHS B ; SAVE ACCB ON STACK LB1EA: LDB FP0EXP ; * PUSH FPA0 ONTO THE STACK LDX FPA0 ; * LDU FPA0+2 ; * PSHS U,X,B ; * JMP ,Y ; JUMP TO ADDRESS IN Y * BRANCH HERE IF NON-OPERATOR ; CHARACTER FOUND - USUALLY ‘)‘ OR END OF LINE LB1F4: LDX ZERO ; POINT X TO DUMMY VALUE (ZERO) LDA ,S+ ; GET PRECEDENCE FLAG FROM STACK BEQ LB220 ; BRANCH IF END OF EXPRESSION LB1FA: CMPA #$64 ; * CHECK FOR RELATIONAL COMPARISON FLAG BEQ LB201 ; * AND BRANCH IF RELATIONAL COMPARISON JSR LB143 ; ‘TM’ ERROR IF VARIABLE TYPE = STRING LB201: STX RELPTR ; SAVE POINTER TO OPERATOR ROUTINE LB203: PULS B ; GET RELATIONAL OPERATOR FLAG FROM STACK CMPA #$5A ; CHECK FOR ‘NOT’ OPERATOR BEQ LB222 ; RETURN IF ‘NOT’ - NO RELATIONAL COMPARISON CMPA #$7D ; CHECK FOR NEGATION (UNARY) FLAG BEQ LB222 ; RETURN IF NEGATION - NO RELATIONAL COMPARISON * EVALUATE AN OPERATION. EIGHT BYTES WILL BE STORED ON STACK, FIRST SIX BYTES * ARE A TEMPORARY FLOATING POINT RESULT THEN THE ADDRESS OF ROUTINE WHICH * WILL EVALUATE THE OPERATION. THE RTS AT END OF ROUTINE WILL VECTOR * TO EVALUATING ROUTINE. LSRB ; = ROTATE VALTYP BIT INTO CARRY STB RELFLG ; = FLAG AND SAVE NEW RELFLG PULS A,X,U ; * PULL A FP VALUE OFF OF THE STACK STA FP1EXP ; * AND SAVE IT IN FPA1 STX FPA1 ; * STU FPA1+2 ; * PULS B ; = GET MANTISSA SIGN AND STB FP1SGN ; = SAVE IT IN FPA1 EORB FP0SGN ; EOR IT WITH FPA1 MANTISSA SIGN STB RESSGN ; SAVE IT IN RESULT SIGN BYTE LB220: LDB FP0EXP ; GET EXPONENT OF FPA0 LB222: RTS LB223: JSR RVEC15 ; HOOK INTO RAM JSR XVEC15 CLR VALTYP ; INITIALIZE TYPE FLAG TO NUMERIC JSR GETNCH ; GET AN INPUT CHAR BCC LB22F ; BRANCH IF NOT NUMERIC LB22C: JMP LBD12 ; CONVERT ASCII STRING TO FLOATING POINT - * RETURN RESULT IN FPA0 * PROCESS A NON NUMERIC FIRST ; CHARACTER LB22F: JSR LB3A2 ; SET CARRY IF NOT ALPHA BCC LB284 ; BRANCH IF ALPHA CHARACTER CMPA #'.' ; IS IT ‘.‘ (DECIMAL POINT)? BEQ LB22C ; CONVERT ASCII STRING TO FLOATING POINT CMPA #$AC ; MINUS TOKEN BEQ LB27C ; YES - GO PROCESS THE MINUS OPERATOR CMPA #$AB ; PLUS TOKEN BEQ LB223 ; YES - GET ANOTHER CHARACTER CMPA #'"' ; STRING DELIMITER? BNE LB24E ; NO LB244: LDX CHARAD ; CURRENT BASIC POINTER TO X JSR LB518 ; SAVE STRING ON STRING STACK LB249: LDX COEFPT ; * GET ADDRESS OF END OF STRING AND STX CHARAD ; * PUT BASIC’S INPUT POINTER THERE RTS LB24E: CMPA #$A8 ; NOT TOKEN? BNE LB25F ; NO * PROCESS THE NOT OPERATOR LDA #$5A ; ‘NOT’ PRECEDENCE FLAG JSR LB15A ; PROCESS OPERATION FOLLOWING ‘NOT’ JSR INTCNV ; CONVERT FPA0 TO INTEGER IN ACCD COMA ; * ‘NOT’ THE INTEGER COMB ; * JMP GIVABF ; CONVERT ACCD TO FLOATING POINT (FPA0) LB25F: INCA ; CHECK FOR TOKENS PRECEEDED BY $FF BEQ LB290 ; IT WAS PRECEEDED BY $FF LB262: BSR LB26A ; SYNTAX CHECK FOR A ‘(‘ JSR LB156 ; EVALUATE EXPRESSIONS WITHIN PARENTHESES AT * HIGHEST PRECEDENCE LB267: LDB #')' ; SYNTAX CHECK FOR ‘)‘ FCB SKP2 ; SKIP 2 BYTES LB26A: LDB #'(' ; SYNTAX CHECK FOR ‘(‘ FCB SKP2 ; SKIP 2 BYTES LB26D: LDB #',' ; SYNTAX CHECK FOR COMMA LB26F: CMPB [CHARAD] ; * COMPARE ACCB TO CURRENT INPUT BNE LB277 ; * CHARACTER - SYNTAX ERROR IF NO MATCH JMP GETNCH ; GET A CHARACTER FROM BASIC LB277: LDB #2*1 ; SYNTAX ERROR JMP LAC46 ; JUMP TO ERROR HANDLER * PROCESS THE MINUS (UNARY) OPERATOR LB27C: LDA #$7D ; MINUS (UNARY) PRECEDENCE FLAG JSR LB15A ; PROCESS OPERATION FOLLOWING ‘UNARY’ NEGATION JMP LBEE9 ; CHANGE SIGN OF FPA0 MANTISSA * EVALUATE ALPHA EXPRESSION LB284: JSR LB357 ; FIND THE DESCRIPTOR ADDRESS OF A VARIABLE LB287: STX FPA0+2 ; SAVE DESCRIPTOR ADDRESS IN FPA0 LDA VALTYP ; TEST VARIABLE TYPE BNE LB222 ; RETURN IF STRING JMP LBC14 ; COPY A FP NUMBER FROM (X) TO FPA0 * EVALUATING A SECONDARY TOKEN LB290: JSR GETNCH ; GET AN INPUT CHARACTER (SECONDARY TOKEN) TFR A,B ; SAVE IT IN ACCB ASLB ; X2 & BET RID OF BIT 7 JSR GETNCH ; GET ANOTHER INPUT CHARACTER CMPB #2*28 ; 29 SECONDARY FUNCTIONS - 1 BLS LB29F ; BRANCH IF COLOR BASIC TOKEN JMP [COMVEC+18] ; JUMP TO EXBAS SECONDARY TOKEN HANDLER LB29F: PSHS B ; SAVE TOKEN OFFSET ON STACK CMPB #2*21 ; CHECK FOR NUMERIC ARGUMENT TOKEN BCS LB2C7 ; DO SECONDARIES HEX$ OR LESS CMPB #2*24 ; * BCC LB2C9 ; * DO SECONDARIES $92 (INKEY$) OR > BSR LB26A ; SYNTAX CHECK FOR A ‘(‘ LDA ,S ; GET TOKEN NUMBER * DO SECONDARIES $8E, $8F, $90 (LEFT$, RIGHT$, MID$) JSR LB156 ; EVALUATE FIRST STRING IN ARGUMENT BSR LB26D ; SYNTAX CHECK FOR A COMMA JSR LB146 ; ‘TM’ ERROR IF NUMERIC VARiABLE PULS A ; GET TOKEN OFFSET FROM STACK LDU FPA0+2 ; POINT U TO STRING DESCRIPTOR PSHS U,A ; SAVE TOKEN OFFSET AND DESCRIPTOR ADDRESS JSR LB70B ; EVALUATE FIRST NUMERIC ARGUMENT PULS A ; GET TOKEN OFFSET FROM STACK PSHS B,A ; SAVE TOKEN OFFSET AND NUMERIC ARGUMENT FCB $8E ; OP CODE OF LDX# - SKlP 2 BYTES LB2C7: BSR LB262 ; SYNTAX CHECK FOR A ‘(‘ LB2C9: PULS B ; GET TOKEN OFFSET LDX COMVEC+8 ; GET SECONDARY FUNCTION JUMP TABLE ADDRESS LB2CE: ABX ; ADD IN COMMAND OFFSET * * HERE IS WHERE WE BRANCH TO A SECONDARY FUNCTION JSR [,X] ; DO AN SECONDARY FUNCTION JMP LB143 ; ‘TM’ ERROR IF VARIABLE TYPE = STRING * LOGICAL OPERATOR ‘OR’ JUMPS ; HERE LB2D4: FCB SKP1LD ; SKIP ONE BYTE - ‘OR’ FLAG = $4F * LOGICAL OPERATOR ‘AND’ JUMPS HERE LB2D5: CLRA ; AND FLAG = 0 STA TMPLOC ; AND/OR FLAG JSR INTCNV ; CONVERT FPA0 INTO AN INTEGER IN ACCD STD CHARAC ; TEMP SAVE ACCD JSR LBC4A ; MOVE FPA1 TO FPA0 JSR INTCNV ; CONVERT FPA0 INTO AN INTEGER IN ACCD TST TMPLOC ; CHECK AND/OR FLAG BNE LB2ED ; BRANCH IF OR ANDA CHARAC ; * ‘AND’ ACCD WITH FPA0 INTEGER ANDB ENDCHR ; * STORED IN ENDCHR BRA LB2F1 ; CONVERT TO FP LB2ED: ORA CHARAC ; * ‘OR’ ACCD WITH FPA0 INTEGER ORB ENDCHR ; * STORED IN CHARAC LB2F1: JMP GIVABF ; CONVERT THE VALUE IN ACCD INTO A FP NUMBER * RELATIONAL COMPARISON PROCESS HANDLER LB2F4: JSR LB148 ; ‘TM’ ERROR IF TYPE MISMATCH BNE LB309 ; BRANCH IF STRING VARIABLE LDA FP1SGN ; * ‘PACK’ THE MANTISSA ORA #$7F ; * SIGN OF FPA1 INTO ANDA FPA1 ; * BIT 7 OF THE STA FPA1 ; * MANTISSA MS BYTE LDX #FP1EXP ; POINT X TO FPA1 JSR LBC96 ; COMPARE FPA0 TO FPA1 BRA LB33F ; CHECK TRUTH OF RELATIONAL COMPARISON * RELATIONAL COMPARISON OF STRINGS LB309: CLR VALTYP ; SET VARIABLE TYPE TO NUMERIC DEC TRELFL ; REMOVE STRING TYPE FLAG (BIT0=1 FOR STRINGS) FROM THE * ; DESIRED RELATIONAL COMPARISON DATA JSR LB657 ; GET LENGTH AND ADDRESS OF STRING WHOSE * ; DESCRIPTOR ADDRESS IS IN THE BOTTOM OF FPA0 STB STRDES ; * SAVE LENGTH AND ADDRESS IN TEMPORARY STX STRDES+2 ; * DESCRIPTOR (STRING B) LDX FPA1+2 ; = RETURN LENGTH AND ADDRESS OF STRING JSR LB659 ; = WHOSE DESCRIPTOR ADDRESS IS STORED IN FPA1+2 LDA STRDES ; LOAD ACCA WITH LENGTH OF STRING B PSHS B ; SAVE LENGTH A ON STACK SUBA ,S+ ; SUBTRACT LENGTH A FROM LENGTH B BEQ LB328 ; BRANCH IF STRINGS OF EQUAL LENGTH LDA #1 ; TRUE FLAG BCC LB328 ; TRUE IF LENGTH B > LENGTH A LDB STRDES ; LOAD ACCB WITH LENGTH B NEGA ; SET FLAG = FALSE (1FF) LB328: STA FP0SGN ; SAVE TRUE/FALSE FLAG LDU STRDES+2 ; POINT U TO START OF STRING INCB ; COMPENSATE FOR THE DECB BELOW * ENTER WITH ACCB CONTAINING LENGTH OF SHORTER STRING LB32D: DECB ; DECREMENT SHORTER STRING LENGTH BNE LB334 ; BRANCH IF ALL OF STRING NOT COMPARED LDB FP0SGN ; GET TRUE/FALSE FLAB BRA LB33F ; CHECK TRUTH OF RELATIONAL COMPARISON LB334: LDA ,X+ ; GET A BYTE FROM STRING A CMPA ,U+ ; COMPARE TO STRING B BEQ LB32D ; CHECK ANOTHER CHARACTER IF = LDB #$FF ; FALSE FLAG IF STRING A > B BCC LB33F ; BRANCH IF STRING A > STRING B NEGB ; SET FLAG = TRUE * DETERMINE TRUTH OF COMPARISON - RETURN RESULT IN FPA0 LB33F: ADDB #1 ; CONVERT $FF,0,1 TO 0,1,2 ROLB ; NOW IT’S 1,2,4 FOR > = < ANDB RELFLG ; ‘AND’ THE ACTUAL COMPARISON WITH THE DESIRED - COMPARISON: BEQ LB348 ; BRANCH IF FALSE (NO MATCHING BITS) LDB #$FF ; TRUE FLAG LB348: JMP LBC7C ; CONVERT ACCB INTO FP NUMBER IN FPA0 * DIM LB34B: JSR LB26D ; SYNTAX CHECK FOR COMMA DIM: LDB #1 ; DIMENSION FLAG BSR LB35A ; SAVE ARRAY SPACE FOR THIS VARIABLE JSR GETCCH ; GET CURRENT INPUT CHARACTER BNE LB34B ; KEEP DIMENSIONING IF NOT END OF LINE RTS * EVALUATE A VARIABLE - RETURN X AND * VARPTR POINTING TO VARIABLE ; DESCRIPTOR * EACH VARIABLE REQUIRES 7 BYTES - THE FIRST TWO * BYTES ARE THE VARIABLE NAME ; AND THE NEXT 5 * BYTES ARE THE DESCRIPTOR. IF BIT 7 OF THE * FIRST BYTE OF VARlABLE NAME ; IS SET, THE * VARIABLE IS A DEF FN VARIABLE. IF BIT 7 OF * THE SECOND BYTE OF VARIABLE ; NAME IS SET, THE * VARIABLE IS A STRING, OTHERWISE THE VARIABLE * IS NUMERIC. * IF THE VARIABLE IS NOT FOUND, A ZERO VARIABLE IS * INSERTED INTO THE VARIABLE SPACE LB357: CLRB ; DIMENSION FLAG = 0; DO NOT SET UP AN ARRAY JSR GETCCH ; GET CURRENT INPUT CHARACTER LB35A: STB DIMFLG ; SAVE ARRAY FLAG * ENTRY POINT FOR DEF FN VARIABLE SEARCH LB35C: STA VARNAM ; SAVE INPUT CHARACTER JSR GETCCH ; GET CURRENT INPUT CHARACTER BSR LB3A2 ; SET CARRY IF NOT ALPHA LBCS LB277 ; SYNTAX ERROR IF NOT ALPHA CLRB ; DEFAULT 2ND VARIABLE CHARACTER TO ZERO STB VALTYP ; SET VARIABLE TYPE TO NUMERIC JSR GETNCH ; GET ANOTHER CHARACTER FROM BASIC BCS LB371 ; BRANCH IF NUMERIC (2ND CHARACTER IN * ; VARIABLE MAY BE NUMERIC) BSR LB3A2 ; SET CARRY IF NOT ALPHA BCS LB37B ; BRANCH IF NOT ALPHA LB371: TFR A,B ; SAVE 2ND CHARACTER IN ACCB * READ INPUT CHARACTERS UNTIL ; A NON ALPHA OR * NON NUMERIC IS FOUND - IGNORE ALL CHARACTERS * IN VARIABLE NAME AFTER THE 1ST TWO LB373: JSR GETNCH ; GET AN INPUT CHARACTER BCS LB373 ; BRANCH IF NUMERIC BSR LB3A2 ; SET CARRY IF NOT ALPHA BCC LB373 ; BRANCH IF ALPHA LB37B: CMPA #'$' ; CHECK FOR A STRING VARIABLE BNE LB385 ; BRANCH IF IT IS NOT A STRING COM VALTYP ; SET VARIABLE TYPE TO STRING ADDB #$80 ; SET BIT 7 OF 2ND CHARACTER (STRING) JSR GETNCH ; GET AN INPUT CHARACTER LB385: STB VARNAM+1 ; SAVE 2ND CHARACTER IN VARNAM+1 ORA ARYDIS ; OR IN THE ARRAY DISABLE FLAG - IF = $80, * DON’T SEARCH FOR VARIABLES IN THE ARRAYS SUBA #'(' ; IS THIS AN ARRAY VARIABLE? LBEQ LB404 ; BRANCH IF IT IS CLR ARYDIS ; RESET THE ARRAY DISABLE FLAG LDX VARTAB ; POINT X TO THE START OF VARIABLES LDD VARNAM ; GET VARIABLE IN QUESTION LB395: CMPX ARYTAB ; COMPARE X TO THE END OF VARIABLES BEQ LB3AB ; BRANCH IF END OF VARIABLES CMPD ,X++ ; * COMPARE VARIABLE IN QUESTION TO CURRENT BEQ LB3DC ; * VARIABLE AND BRANCH IF MATCH LEAX 5,X ; = MOVE POINTER TO NEXT VARIABLE AND BRA LB395 ; = KEEP LOOKING * SET CARRY IF NOT UPPER CASE ; ALPHA LB3A2: CMPA #'A' ; * CARRY SET IF < ‘A’ BCS LB3AA ; * SUBA #'Z'+1 ; = * SUBA #-('Z'+1) ; = CARRY CLEAR IF <= 'Z' FCB $80,$A5 LB3AA: RTS * PUT A NEW VARIABLE IN TABLE ; OF VARIABLES LB3AB: LDX #ZERO ; POINT X TO ZERO LOCATION LDU ,S ; GET CURRENT RETURN ADDRESS CMPU #LB287 ; DID WE COME FROM ‘EVALUATE ALPHA EXPR’? BEQ LB3DE ; YES - RETURN A ZERO VALUE LDD ARYEND ; * GET END OF ARRAYS ADDRESS AND STD V43 ; * SAVE IT AT V43 ADDD #7 ; = ADD 7 TO END OF ARRAYS (EACH STD V41 ; = VARIABLE = 7 BYTES) AND SAVE AT V41 LDX ARYTAB ; * GET END OF VARIABLES AND SAVE AT V47 STX V47 ; * JSR LAC1E ; MAKE A SEVEN BYTE SLOT FOR NEW VARIABLE AT * TOP OF VARIABLES LDX V41 ; = GET NEW END OF ARRAYS AND SAVE IT STX ARYEND ; = LDX V45 ; * GET NEW END OF VARIABLES AND SAVE IT STX ARYTAB ; * LDX V47 ; GET OLD END OF VARIABLES LDD VARNAM ; GET NEW VARIABLE NAME STD ,X++ ; SAVE VARIABLE NAME CLRA ; * ZERO OUT THE FP VALUE OF THE NUMERIC CLRB ; * VARIABLE OR THE LENGTH AND ADDRESS STD ,X ; * OF A STRING VARIABLE STD 2,X ; * STA 4,X ; * LB3DC: STX VARPTR ; STORE ADDRESS OF VARIABLE VALUE LB3DE: RTS * LB3DF: FCB $90,$80,$00,$00,$00 ; FLOATING POINT -32768 * ; SMALLEST SIGNED TWO BYTE INTEGER * LB3E4: JSR GETNCH ; GET AN INPUT CHARACTER FROM BASIC LB3E6: JSR LB141 ; GO EVALUATE NUMERIC EXPRESSION LB3E9: LDA FP0SGN ; GET FPA0 MANTISSA SIGN BMI LB44A ; ‘FC’ ERROR IF NEGATIVE NUMBER INTCNV: JSR LB143 ; ‘TM’ ERROR IF STRING VARIABLE LDA FP0EXP ; GET FPA0 EXPONENT CMPA #$90 ; * COMPARE TO 32768 - LARGEST INTEGER EXPONENT AND BCS LB3FE ; * BRANCH IF FPA0 < 32768 LDX #LB3DF ; POINT X TO FP VALUE OF -32768 JSR LBC96 ; COMPARE -32768 TO FPA0 BNE LB44A ; ‘FC’ ERROR IF NOT = LB3FE: JSR LBCC8 ; CONVERT FPA0 TO A TWO BYTE INTEGER LDD FPA0+2 ; GET THE INTEGER RTS * EVALUATE AN ARRAY VARIABLE LB404: LDD DIMFLG ; GET ARRAY FLAG AND VARIABLE TYPE PSHS B,A ; SAVE THEM ON STACK NOP ; DEAD SPACE CAUSED BY 1.2 REVISION CLRB ; RESET DIMENSION COUNTER LB40A: LDX VARNAM ; GET VARIABLE NAME PSHS X,B ; SAVE VARIABLE NAME AND DIMENSION COUNTER BSR LB3E4 ; EVALUATE EXPRESSION (DIMENSlON LENGTH) PULS B,X,Y ; PULL OFF VARIABLE NAME, DIMENSlON COUNTER, * ; ARRAY FLAG STX VARNAM ; SAVE VARIABLE NAME AND VARIABLE TYPE LDU FPA0+2 ; GET DIMENSION LENGTH PSHS U,Y ; SAVE DIMENSION LENGTH, ARRAY FLAG, VARIABLE TYPE INCB ; INCREASE DIMENSION COUNTER JSR GETCCH ; GET CURRENT INPUT CHARACTER CMPA #',' ; CHECK FOR ANOTHER DIMENSION BEQ LB40A ; BRANCH IF MORE STB TMPLOC ; SAVE DIMENSION COUNTER JSR LB267 ; SYNTAX CHECK FOR A ‘)‘ PULS A,B ; * RESTORE VARIABLE TYPE AND ARRAY STD DIMFLG ; * FLAG - LEAVE DIMENSION LENGTH ON STACK LDX ARYTAB ; GET START OF ARRAYS LB42A: CMPX ARYEND ; COMPARE TO END OF ARRAYS BEQ LB44F ; BRANCH IF NO MATCH FOUND LDD VARNAM ; GET VARIABLE IN QUESTION CMPD ,X ; COMPARE TO CURRENT VARIABLE BEQ LB43B ; BRANCH IF = LDD 2,X ; GET OFFSET TO NEXT ARRAY VARIABLE LEAX D,X ; ADD TO CURRENT POINTER BRA LB42A ; KEEP SEARCHING LB43B: LDB #2*9 ; ‘REDIMENSIONED ARRAY’ ERROR LDA DIMFLG ; * TEST ARRAY FLAG - IF <>0 YOU ARE TRYING BNE LB44C ; * TO REDIMENSION AN ARRAY LDB TMPLOC ; GET NUMBER OF DIMENSIONS IN ARRAY CMPB 4,X ; COMPARE TO THIS ARRAYS DIMENSIONS BEQ LB4A0 ; BRANCH IF = LB447: LDB #8*2 ; ‘BAD SUBSCRIPT’ FCB SKP2 ; SKIP TWO BYTES LB44A: LDB #4*2 ; ‘ILLEGAL FUNCTION CALL’ LB44C: JMP LAC46 ; JUMP TO ERROR SERVICING ROUTINE * INSERT A NEW ARRAY INTO ARRAY VARIABLES * EACH SET OF ARRAY VARIABLES ; IS PRECEEDED BY A DE- * SCRIPTOR BLOCK COMPOSED OF 5+2*N BYTES WHERE N IS THE * NUMBER OF DIMENSIONS IN THE ; ARRAY. THE BLOCK IS DEFINED * AS FOLLOWS: BYTES 0,1:VARIABLE’S NAME; 2,3:TOTAL LENGTH * OF ARRAY ITEMS AND DESCRIPTOR BLOCK; 4:NUMBER OF DIMEN- * ISIONS; 5,6:LENGTH OF DIMENSION 1; 7,8:LENGTH OF DIMEN- * SION 2;… 4+N,5+N:LENGTH OF DIMENSION N. LB44F: LDD #5 ; * 5 BYTES/ARRAY ENTRY SAVE AT COEFPT STD COEFPT ; * LDD VARNAM ; = GET NAME OF ARRAY AND SAVE IN STD ,X ; = FIRST 2 BYTES OF DESCRIPTOR LDB TMPLOC ; GET NUMBER OF DIMENSIONS AND SAVE IN STB 4,X ; * 5TH BYTE OF DESCRIPTOR JSR LAC33 ; CHECK FOR ROOM FOR DESCRIPTOR IN FREE RAM STX V41 ; TEMPORARILY SAVE DESCRIPTOR ADDRESS LB461 LDB #11 ; * DEFAULT DIMENSION VALUE:X(10) CLRA ; * TST DIMFLG ; = CHECK ARRAY FLAG AND BRANCH IF BEQ LB46D ; = NOT DIMENSIONING AN ARRAY PULS A,B ; GET DIMENSION LENGTH ADDD #1 ; ADD ONE (X(0) HAS A LENGTH OF ONE) LB46D: STD 5,X ; SAVE LENGTH OF ARRAY DIMENSION BSR LB4CE ; MULTIPLY ACCUM ARRAY SIZE NUMBER LENGTH * ; OF NEW DIMENSION STD COEFPT ; TEMP STORE NEW CURRENT ACCUMULATED ARRAY SIZE LEAX 2,X ; BUMP POINTER UP TWO DEC TMPLOC ; * DECREMENT DIMENSION COUNTER AND BRANCH IF BNE LB461 ; * NOT DONE WITH ALL DIMENSIONS STX TEMPTR ; SAVE ADDRESS OF (END OF ARRAY DESCRIPTOR - 5) ADDD TEMPTR ; ADD TOTAL SIZE OF NEW ARRAY LBCS LAC44 ; ‘OM’ ERROR IF > $FFFF TFR D,X ; SAVE END OF ARRAY IN X JSR LAC37 ; MAKE SURE THERE IS ENOUGH FREE RAM FOR ARRAY SUBD #STKBUF-5 ; SUBTRACT OUT THE (STACK BUFFER - 5) STD ARYEND ; SAVE NEW END OF ARRAYS CLRA ; ZERO = TERMINATOR BYTE LB48C: LEAX -1,X ; * STORE TWO TERMINATOR BYTES AT STA 5,X ; * THE END OF THE ARRAY DESCRIPTOR CMPX TEMPTR ; * BNE LB48C ; * LDX V41 ; GET ADDRESS OF START OF DESCRIPTOR LDA ARYEND ; GET MSB OF END OF ARRAYS; LSB ALREADY THERE SUBD V41 ; SUBTRACT OUT ADDRESS OF START OF DESCRIPTOR STD 2,X ; SAVE LENGTH OF (ARRAY AND DESCRIPTOR) LDA DIMFLG ; * GET ARRAY FLAG AND BRANCH BNE LB4CD ; * BACK IF DIMENSIONING * CALCULATE POINTER TO CORRECT ELEMENT LB4A0: LDB 4,X ; GET THE NUMBER OF DIMENSIONS STB TMPLOC ; TEMPORARILY SAVE CLRA ; * INITIALIZE POINTER CLRB ; * TO ZERO LB4A6: STD COEFPT ; SAVE ACCUMULATED POINTER PULS A,B ; * PULL DIMENSION ARGUMENT OFF THE STD FPA0+2 ; * STACK AND SAVE IT CMPD 5,X ; COMPARE TO STORED ‘DIM’ ARGUMENT BCC LB4EB ; ‘BS’ ERROR IF > = "DIM" ARGUMENT LDU COEFPT ; * GET ACCUMULATED POINTER AND BEQ LB4B9 ; * BRANCH IF 1ST DIMENSION BSR LB4CE ; = MULTIPLY ACCUMULATED POINTER AND DIMENSION ADDD FPA0+2 ; = LENGTH AND ADD TO CURRENT ARGUMENT LB4B9: LEAX 2,X ; MOVE POINTER TO NEXT DIMENSION DEC TMPLOC ; * DECREMENT DIMENSION COUNTER AND BNE LB4A6 ; * BRANCH IF ANY DIMENSIONS LEFT * MULTIPLY ACCD BY 5 - 5 BYTES/ARRAY VALUE STD ,--S ASLB ROLA ; TIMES 2 ASLB ROLA ; TIMES 4 ADDD ,S++ ; TIMES 5 LEAX D,X ; ADD OFFSET TO START OF ARRAY LEAX 5,X ; ADJUST POINTER FOR SIZE OF DESCRIPTOR STX VARPTR ; SAVE POINTER TO ARRAY VALUE LB4CD: RTS * MULTIPLY 2 BYTE NUMBER IN 5,X BY THE 2 BYTE NUMBER * IN COEFPT. RETURN RESULT IN ; ACCD, BS ERROR IF > $FFFF LB4CE: LDA #16 ; 16 SHIFTS TO DO A MULTIPLY STA V45 ; SHIFT COUNTER LDD 5,X ; * GET SIZE OF DIMENSION STD BOTSTK ; * AND SAVE IT CLRA ; * ZERO CLRB ; * ACCD LB4D8: ASLB ; = SHIFT ACCB LEFT ROLA ; = ONE BIT BCS LB4EB ; BS' ERROR IF CARRY ASL COEFPT+1 ; * SHIFT MULTIPLICAND LEFT ONE ROL COEFPT ; * BIT - ADD MULTIPLIER TO ACCUMULATOR BCC LB4E6 ; * IF CARRY <> 0 ADDD BOTSTK ; ADD MULTIPLIER TO ACCD BCS LB4EB ; BS' ERROR IF CARRY (>$FFFF) LB4E6: DEC V45 ; * DECREMENT SHIFT COUNTER BNE LB4D8 ; * IF NOT DONE RTS LB4EB: JMP LB447 ; BS' ERROR * * MEM * THIS IS NOT A TRUE INDICATOR OF FREE MEMORY BECAUSE * BASIC REQUIRES A STKBUF SIZE BUFFER FOR THE STACK * FOR WHICH MEM DOES NOT ALLOW. * MEM: TFR S,D ; PUT STACK POINTER INTO ACCD SUBD ARYEND ; SUBTRACT END OF ARRAYS FCB SKP1 ; SKIP ONE BYTE *CONVERT THE VALUE IN ACCB INTO A FP NUMBER IN FPA0 LB4F3: CLRA ; CLEAR MS BYTE OF ACCD * CONVERT THE VALUE IN ACCD INTO A FLOATING POINT NUMBER IN FPA0 GIVABF: CLR VALTYP ; SET VARIABLE TYPE TO NUMERIC STD FPA0 ; SAVE ACCD IN TOP OF FACA LDB #$90 ; EXPONENT REQUIRED IF THE TOP TWO BYTES * OF FPA0 ARE TO BE ; TREATED AS AN INTEGER IN FPA0 JMP LBC82 ; CONVERT THE REST OF FPA0 TO AN INTEGER * STR$ STR: JSR LB143 ; TM' ERROR IF STRING VARIABLE LDU #STRBUF+2 ; *CONVERT FP NUMBER TO ASCII STRING IN JSR LBDDC ; *THE STRING BUFFER LEAS 2,S ; PURGE THE RETURN ADDRESS FROM THE STACK LDX #STRBUF+1 ; *POINT X TO STRING BUFFER AND SAVE BRA LB518 ; *THE STRING IN THE STRING SPACE * RESERVE ACCB BYTES OF STRING SPACE. RETURN START * ADDRESS IN (X) AND FRESPC LB50D: STX V4D ; SAVE X IN V4D LB50F: BSR LB56D ; RESERVE ACCB BYTES IN STRING SPACE LB511: STX STRDES+2 ; SAVE NEW STRING ADDRESS STB STRDES ; SAVE LENGTH OF RESERVED BLOCK RTS LB516: LEAX -1,X ; MOVE POINTER BACK ONE * SCAN A LINE FROM (X) UNTIL AN END OF LINE FLAG (ZERO) OR * EITHER OF THE TWO TERMINATORS STORED IN CHARAC OR ENDCHR IS MATCHED. * THE RESULTING STRING IS STORED IN THE STRING SPACE * ONLY IF THE START OF THE STRING IS <= STRBUF+2 LB518: LDA #'"' ; * INITIALIZE STA CHARAC ; * TERMINATORS LB51A: STA ENDCHR ; * TO " LB51E: LEAX 1,X ; MOVE POINTER UP ONE STX RESSGN ; TEMPORARILY SAVE START OF STRING STX STRDES+2 ; SAVE START OF STRING IN TEMP DESCRIPTOR LDB #-1 ; INITIALIZE CHARACTER COUNTER TO - 1 LB526: INCB ; INCREMENT CHARACTER COUNTER LDA ,X+ ; GET CHARACTER BEQ LB537 ; BRANCH IF END OF LINE CMPA CHARAC ; * CHECK FOR TERMINATORS BEQ LB533 ; * IN CHARAC AND ENDCHR CMPA ENDCHR ; * DON’T MOVE POINTER BACK BNE LB526 ; * ONE IF TERMINATOR IS "MATCHED" LB533: CMPA #'"' ; = COMPARE CHARACTER TO STRING DELIMITER BEQ LB539 ; = & DON’T MOVE POINTER BACK IF SO LB537: LEAX -1,X ; MOVE POINTER BACK ONE LB539: STX COEFPT ; SAVE END OF STRING ADDRESS STB STRDES ; SAVE STRING LENGTH IN TEMP DESCRIPTOR LDU RESSGN ; GET INITlAL STRING START CMPU #STRBUF+2 ; COMPARE TO START OF STRING BUFFER LB543: BHI LB54C ; BRANCH IF > START OF STRING BUFFER BSR LB50D ; GO RESERVE SPACE FOR THE STRING LDX RESSGN ; POINT X TO THE BEGINNING OF THE STRING JSR LB645 ; MOVE (B) BYTES FROM (X) TO * ; [FRESPC] - MOVE STRING DATA * PUT DIRECT PAGE STRING DESCRIPTOR BUFFER DATA * ON THE STRING STACK. SET VARIABLE TYPE TO STRING LB54C: LDX TEMPPT ; GET NEXT AVAILABLE STRING STACK DESCRIPTOR CMPX #LINHDR ; COMPARE TO TOP OF STRING DESCRIPTOR STACK - WAS #CFNBUF BNE LB558 ; FORMULA O.K. LDB #15*2 ; STRING FORMULA TOO COMPLEX' ERROR LB555: JMP LAC46 ; JUMP TO ERROR SERVICING ROUTINE LB558: LDA STRDES ; * GET LENGTH OF STRING AND SAVE IT * STA ,X ; * IN BYTE 0 OF DESCRIPTOR FCB $A7,$00 LDD STRDES+2 ; = GET START ADDRESS OF ACTUAL STRING STD 2,X ; = AND SAVE IN BYTES 2,3 OF DESCRIPTOR LDA #$FF ; * VARIABLE TYPE = STRING STA VALTYP ; * SAVE IN VARIABLE TYPE FLAG STX LASTPT ; = SAVE START OF DESCRIPTOR STX FPA1+2 ; = @DDRESS IN LASTPU AND FPA0 LEAX 5,X ! ; 5 BYTDS/STRING DESCRIQTOR STX TEMPPT ! ; NEXT AVAILABLE STRING VARIACLE DESCRIPTOR RTS * RESERVE ACCB BYTER IN STRING STORAGE SPACE * RETURN WITH THE STARUING ADDRESS OF THE * RESERVED SURING SPACE IN (X) AND FRESPC LB56D: CLR GARBFL ; CLEAR STRING REORG@NIZATION FLAG LC56F: CLRA ; *!PUSH THE LENGTH OF THE ! PSHS B,A ; * STRING!ONTO THE STACK LDD SURTAB ; FET START OF STRING VARIABLES SUBD ,S+! ; SUBTRACT STRING LEOGTH CLPD FRETOP ! ; COMPARE TO RTART OF STRING STORAGE BCS LB585 ! ; IF BELOW START, THEN REOSGANIZE STD STRTAB ! ; SAVE NEW START OF STRING!VARIABLES LDX STRTAB! ; GET START OF STRING VARIABLES LEAX 1,X ! ; ADD ONE STX GRESPC ; SAVE START ADDRESS OF NEWLY RESDRVED SPACE ! PULS B,PC ; RESTORE NUMBER OF BYTES RESERVED AND!RETURN LB585: LDB #2*13 ! ; OUT OF STRING SPACE' ERROR COM GARBFL !; TOGGLE REORGANIZATiON FLAG ! BEQ LB545 ; ERSOR IF FRESHLY RDORGANIZED ! BSR LB591 ; GO REORGANIZE STRING RPACE QULS B ; GET BACK TIE NUMBER OF BYTDS TO RESERVE ! BRA LB56F ; TRY TO RESERVE ACCB BYTES AGAIN * SEORGANIZE THE STRING SPACE LB591: LDX MEMSIZ ; GET UHE TOP OF STRINF SPACE LB593: ! STX STRTAB ; SAVE TOP!OF UNORGANIZED RTRING SPACE ! CLRA ; * ZERO OUT ACCD CLRB ! ; * AND RESET VARIABLE STD V4B ; * POINTER TO 0 LDX GRETOP ; POINT X TO STARU OF STRING SPACD STX !V47 : SAVE POINTER IO V47 LDX #STRSTK ! ; POINT X TO START OF STRING!DESCRIPTOR STACJ LB5A0: CMPX!TEMPPT : COMPARE TO ADDSESS OF NEXT AVAILABLE DESCRIPTOR BEQ LB5A8 ; BRANCH IF TOP OF STRING STACK BSR LB5D8 ; CHECK FOR STRING IN UNORGANIZED STRING SPACE BRA LB5A0 ; KEEP CHECKING LB5A8: LDX VARTAB ; GET THE END OF BASIC PROGRAM LB5AA: CMPX ARYTAB ; COMPARE TO END OF VARIABLES BEQ LB5B2 ; BRANCH IF AT TOP OF VARIABLES BSR LB5D2 ; CHECK FOR STRING IN UNORGANIZED STRING SPACE BRA LB5AA ; KEEP CHECKING VARIABLES LB5B2: STX V41 ; SAVE ADDRESS OF THE END OF VARIABLES LB5B4: LDX V41 ; GET CURRENT ARRAY POINTER LB5B6: CMPX ARYEND ; COMPARE TO THE END OF ARRAYS BEQ LB5EF ; BRANCH IF AT END OF ARRAYS LDD 2,X ; GET LENGTH OF ARRAY AND DESCRIPTOR ADDD V41 ; * ADD TO CURRENT ARRAY POINTER STD V41 ; * AND SAVE IT LDA 1,X ; GET 1ST CHARACTER OF VARIABLE NAME BPL LB5B4 ; BRANCH IF NUMERIC ARRAY LDB 4,X ; GET THE NUMBER OF DIMENSIONS IN THIS ARRAY ASLB ; MULTIPLY BY 2 ADDB #5 ; ADD FIVE BYTES (VARIABLE NAME, ARRAY * ; LENGTH, NUMBER DIMENSIONS) ABX ; X NOW POINTS TO START OF ARRAY ELEMENTS LB5CA: CMPX V41 ; AT END OF THIS ARRAY? BEQ LB5B6 ; YES - CHECK FOR ANOTHER BSR LB5D8 ; CHECK FOR STRING LOCATED IN * ; UNORGANIZED STRING SPACE BRA LB5CA ; KEEP CHECKING ELEMENTS IN THIS ARRAY LB5D2: LDA 1,X ; GET F1RST BYTE OF VARIABLE NAME LEAX 2,X ; MOVE POINTER TO DESCRIPTOR BPL LB5EC ; BRANCH IF VARIABLE IS NUMERIC * SEARCH FOR STRING - ENTER WITH X POINTING TO * THE STRING DESCRIPTOR. IF STRING IS STORED * BETWEEN V47 AND STRTAB, SAVE DESCRIPTOR POINTER * IN V4B AND RESET V47 TO STRING ADDRESS LB5D8: LDB ,X ; GET THE LENGTH OF THE STRING BEQ LB5EC ; BRANCH IF NULL - NO STRING LDD 2,X ; GET STARTING ADDRESS OF THE STRING CMPD STRTAB ; COMPARE TO THE START OF STRING VARIABLES BHI LB5EC ; BRANCH IF THIS STRING IS STORED IN * THE STRING VARIABLES CMPD V47 ; COMPARE TO START OF STRING SPACE BLS LB5EC ; BRANCH IF NOT STORED IN THE STRING SPACE STX V4B ; SAVE VARIABLE POINTER IF STORED IN STRING SPACE STD V47 ; SAVE STRING STARTING ADDRESS LB5EC: LEAX 5,X ; MOVE TO NEXT VARIABLE DESCRIPTOR LB5EE: RTS LB5EF: LDX V4B ; GET ADDRESS OF THE DESCRIPTOR FOR THE * STRING WHICH IS STORED IN THE HIGHEST RAM ADDRESS IN * THE UNORGANIZED STRING SPACE BEQ LB5EE ; BRANCH IF NONE FOUND AND REORGANIZATION DONE CLRA ; CLEAR MS BYTE OF LENGTH LDB ,X ; GET LENGTH OF STRING DECB ; SUBTRACT ONE ADDD V47 ; ADD LENGTH OF STRING TO ITS STARTING ADDRESS STD V43 ; SAVE AS MOVE STARTING ADDRESS LDX STRTAB ; POINT X TO THE START OF ORGANIZED STRING VARIABLES STX V41 ; SAVE AS MOVE ENDING ADDRESS JSR LAC20 ; MOVE STRING FROM CURRENT POSITION TO THE * TOP OF UNORGANIZED STRING SPACE LDX V4B ; POINT X TO STRING DESCRIPTOR LDD V45 ; * GET NEW STARTING ADDRESS OF STRING AND STD 2,X ; * SAVE IT IN DESCRIPTOR LDX V45 ; GET NEW TOP OF UNORGANIZED STRING SPACE LEAX -1,X ; MOVE POINTER BACK ONE JMP LB593 ; JUMP BACK AND REORGANIZE SOME MORE LB60F: LDD FPA0+2 ; * GET DESCRIPTOR ADDRESS OF STRING A PSHS B,A ; * AND SAVE IT ON THE STACK JSR LB223 ; GET DESCRIPTOR ADDRESS OF STRING B JSR LB146 ; TM' ERROR IF NUMERIC VARIABLE PULS X ; * POINT X TO STRING A DESCRIPTOR STX RESSGN ; * ADDRESS AND SAVE IT IN RESSGN LDB ,X ; GET LENGTH OF STRING A LDX FPA0+2 ; POINT X TO DESCRIPTOR OF STRING B ADDB ,X ; ADD LENGTH OF STRING B TO STR1NG A BCC LB62A ; BRANCH IF LENGTH < 256 LDB #2*14 ; STRING TOO LONG' ERROR IF LENGTH > 255 JMP LAC46 ; JUMP TO ERROR SERVICING ROUTINE LB62A: JSR LB50D ; RESERVE ROOM IN STRING SPACE FOR NEW STRING LDX RESSGN ; GET DESCRIPTOR ADDRESS OF STRING A LDB ,X ; GET LENGTH OF STRING A BSR LB643 ; MOVE STRING A INTO RESERVED BUFFER IN STRING SPACE LDX V4D ; GET DESCRIPTOR ADDRESS OF STRING B BSR LB659 ; GET LENGTH AND ADDRESS OF STRING B BSR LB645 ; MOVE STRING B INTO REST OF RESERVED BUFFER LDX RESSGN ; POINT X TO DESCRIPTOR OF STRING A BSR LB659 ; DELETE STRING A IF LAST STRING ON STRING STACK JSR LB54C ; PUT STRING DESCRIPTOR ON THE STRING STACK JMP LB168 ; BRANCH BACK TO EXPRESSION EVALUATION * MOVE (B) BYTES FROM 2,X TO FRESPC LB643: LDX 2,X ; POINT X TO SOURCE ADDRESS LB645: LDU FRESPC ; POINT U TO DESTINATION ADDRESS INCB ; COMPENSATION FOR THE DECB BELOW BRA LB64E ; GO MOVE THE BYTES * MOVE B BYTES FROM (X) TO (U) LB64A: LDA ,X+ ; * GET A SOURCE BYTE AND MOVE IT STA ,U+ ; * TO THE DESTINATION LB64E: DECB ; DECREMENT BYTE COUNTER BNE LB64A ; BRANCH IF ALL BYTES NOT MOVED STU FRESPC ; SAVE ENDING ADDRESS IN FRESPC RTS * RETURN LENGTH (ACCB) AND ADDRESS (X) OF * STRING WHOSE DESCRIPTOR IS IN FPA0+2 * DELETE THE STRING IF IT IS THE LAST ONE * PUT ON THE STRING STACK. REMOVE STRING FROM STRING * SPACE IF IT IS AT THE BOTTOM OF STRING VARIABLES. LB654: JSR LB146 ; TM' ERROR IF VARIABLE TYPE = NUMERIC LB657: LDX FPA0+2 ; GET ADDRESS OF SELECTED STRING DESCRIPTOR LB659: LDB ,X ; GET LENGTH OF STRING BSR LB675 ; * CHECK TO SEE IF THIS STRING DESCRIPTOR WAS BNE LB672 ; * THE LAST ONE PUT ON THE STRING STACK AND * ; * BRANCH IF NOT LDX 5+2,X ; GET START ADDRESS OF STRING JUST REMOVED LEAX -1,X ; MOVE POINTER DOWN ONE CMPX STRTAB ; COMPARE TO START OF STRING VARIABLES BNE LB66F ; BRANCH IF THIS STRING IS NOT AT THE BOTTOM * ; OF STRING VARIABLES PSHS B ; SAVE LENGTH; ACCA WAS CLEARED ADDD STRTAB ; * ADD THE LENGTH OF THE JUST REMOVED STRING STD STRTAB ; * TO THE START OF STRING VARIABLES - THIS WILL * ; * REMOVE THE STRING FROM THE STRING SPACE PULS B ; RESTORE LENGTH LB66F: LEAX 1,X ; ADD ONE TO POINTER RTS LB672: LDX 2,X ; *POINT X TO ADDRESS OF STRING NOT RTS ; *ON THE STRING STACK * REMOVE STRING FROM STRING STACK. ENTER WITH X * POINTING TO A STRING DESCRIPTOR - DELETE THE * STRING FROM STACK IF IT IS ON TOP OF THE * STACK. IF THE STRING IS DELETED, SET THE ZERO FLAG LB675: CMPX LASTPT ; *COMPARE TO LAST USED DESCRIPTOR ADDRESS BNE LB680 ; *ON THE STRING STACK, RETURN IF DESCRIPTOR * ; *ADDRESS NOT ON THE STRING STACK STX TEMPPT ; SAVE LAST USED DESCRIPTOR AS NEXT AVAILABLE LEAX -5,X ; * MOVE LAST USED DESCRIPTOR BACK 5 BYTES STX LASTPT ; * AND SAVE AS THE LAST USED DESCRIPTOR ADDR CLRA ; SET ZERO FLAG LB680: RTS * LEN LEN: BSR LB686 ; POINT X TO PROPER STRING AND GET LENGTH LB683: JMP LB4F3 ; CONVERT ACCB TO FP NUMBER IN FPA0 * POINT X TO STRING ADDRESS LOAD LENGTH INTO * ACCB. ENTER WITH THE STRING ; DESCRIPTOR IN * BOTTOM TWO BYTES OF FPA0 LB686: BSR LB654 ; GET LENGTH AND ADDRESS OF STRING CLR VALTYP ; SET VARIABLE TYPE TO NUMERIC TSTB ; SET FLAGS ACCORDING TO LENGTH RTS * CHR$ CHR: JSR LB70E ; CONVERT FPA0 TO AN INTEGER IN ACCD LB68F: LDB #1 ; * RESERVE ONE BYTE IN JSR LB56D ; * THE STRING SPACE LDA FPA0+3 ; GET ASCII STRING VALUE JSR LB511 ; SAVE RESERVED STRING DESCRIPTOR IN TEMP DESCRIPTOR STA ,X ; SAVE THE STRING (IT’S ONLY ONE BYTE) LB69B: LEAS 2,S ; PURGE THE RETURN ADDRESS OFF OF THE STACK LB69D: JMP LB54C ; PUT TEMP DESCRIPTOR DATA ONTO STRING STACK ASC: BSR LB6A4 ; PUT 1ST CHARACTER OF STRING INTO ACCB BRA LB683 ; CONVERT ACCB INTO FP NUMBER IN FPA0 LB6A4: BSR LB686 ; POINT X TO STRING DESCRIPTOR BEQ LB706 ; FC' ERROR IF NULL STRING LDB ,X ; GET FIRST BYTE OF STRING RTS LEFT: BSR LB6F5 ; GET ARGUMENTS FROM STACK LB6AD: CLRA ; CLEAR STRING POINTER OFFSET - OFFSET = 0 FOR LEFT$ LB6AE: CMPB ,X ; * COMPARE LENGTH PARAMETER TO LENGTH OF BLS LB6B5 ; * STRING AND BRANCH IF LENGTH OF STRING * ; >= LENGTH PARAMETER LDB ,X ; USE LENGTH OF STRING OTHERWISE CLRA ; CLEAR STRING POINTER OFFSET (0 FOR LEFT$) LB6B5: PSHS B,A ; PUSH PARAMETERS ONTO STACK JSR LB50F ; RESERVE ACCB BYTES IN THE STRING SPACE LDX V4D ; POINT X TO STRING DESCRIPTOR BSR LB659 ; GET ADDRESS OF OLD STRING (X=ADDRESS) PULS B ; * PULL STRING POINTER OFFSET OFF OF THE STACK ABX ; * AND ADD IT TO STRING ADDRESS PULS B ; PULL LENGTH PARAMETER OFF OF THE STACK JSR LB645 ; MOVE ACCB BYTES FROM (X) TO [FRESPC] BRA LB69D ; PUT TEMP STRING DESCRIPTOR ONTO THE STRING STACK * RIGHT$ RIGHT: BSR LB6F5 ; GET ARGUMENTS FROM STACK SUBA ,X ; ACCA=LENGTH PARAMETER - LENGTH OF OLD STRING NEGA ; NOW ACCA = LENGTH OF OLD STRING BRA LB6AE ; PUT NEW STRING IN THE STRING SPACE * MID$ MID: LDB #$FF ; * GET DEFAULT VALUE OF LENGTH AND STB FPA0+3 ; * SAVE IT IN FPA0 JSR GETCCH ; GET CURRENT CHARACTER FROM BASIC CMPA #')' ; ARGUMENT DELIMITER? BEQ LB6DE ; YES - NO LENGTH PARAMETER GIVEN JSR LB26D ; SYNTAX CHECK FOR COMMA BSR LB70B ; EVALUATE NUMERIC EXPRESSION (LENGTH) LB6DE: BSR LB6F5 ; GET ARGUMENTS FROM STACK BEQ LB706 ; FC' ERROR IF NULL STRING CLRB ; CLEAR LENGTH COUNTER (DEFAULT VALUE) DECA ; *SUOTRACT ONE FROM POSITION PARAMETER (THESE CMPA ,X ; *ROUTINES EXPECT 1ST POSITION TO BE ZERO, NOT ONE) * ; *AND COMPARE IT TO LENGTH OF OLD STRING BCC LB6B5 ; IF POSITION > LENGTH OF OLD STRING, THEN NEW * ; STRING WILL BE A NULL STRING TFR A,B ; SAVE ABSOLUTE POSITION PARAMETER IN ACCB SUBB ,X ; ACCB=POSITION-LENGTH OF OLD STRING NEGB ; NOW ACCB=LENGTH OF OLDSTRING-POSITION CMPB FPA0+3 ; *IF THE AMOUNT OF OLD STRING TO THE RIGHT OF BLS LB6B5 ; *POSITION IS <= THE LENGTH PARAMETER, BRANCH AND * USE ALL OF THE STRING TO THE RIGHT OF THE POSITION * INSTEAD OF THE LENGTH PARAMETER LDB FPA0+3 ; GET LENGTH OF NEW STRING BRA LB6B5 ; PUT NEW STRING IN STRING SPACE * DO A SYNTAX CHECK FOR ")", THEN PULL THE PREVIOUSLY CALCULATED NUMERIC * ARGUMENT (ACCD) AND STRING ARGUMENT DESCRIPTOR ADDR OFF OF THE STACK LB6F5: JSR LB267 ; SYNTAX CHECK FOR A ")" LDU ,S ; LOAD THE RETURN ADDRESS INTO U REGISTER LDX 5,S ; * GET ADDRESS OF STRING AND STX V4D ; * SAVE IT IN V4D LDA 4,S ; = PUT LENGTH OF STRING IN LDB 4,S ; = BOTH ACCA AND ACCB LEAS 7,S ; REMOVE DESCRIPTOR AND RETURN ADDRESS FROM STACK TFR U,PC ; JUMP TO ADDRESS IN U REGISTER LB706: JMP LB44A ; ILLEGAL FUNCTION CALL' * EVALUATE AN EXPRESSION - RETURN AN INTEGER IN * ACCB - 'FC' ERROR IF EXPRESSION > 255 LB709: JSR GETNCH ; GET NEXT BASIC INPUT CHARACTER LB70B: JSR LB141 ; EVALUATE A NUMERIC EXPRESSION LB70E: JSR LB3E9 ; CONVERT FPA0 TO INTEGER IN ACCD TSTA ; TEST MS BYTE OF INTEGER BNE LB706 ; FC' ERROR IF EXPRESSION > 255 JMP GETCCH ; GET CURRENT INPUT CHARACTER FROM BASIC * VAL VAL: JSR LB686 ; POINT X TO STRING ADDRESS LBEQ LBA39 ; IF NULL STRING SET FPA0 LDU CHARAD ; SAVE INPUT POINTER IN REGISTER U STX CHARAD ; POINT INPUT POINTER TO ADDRESS OF STRING ABX ; MOVE POINTER TO END OF STRING TERMINATOR LDA ,X ; GET LAST BYTE OF STRING PSHS U,X,A ; SAVE INPUT POINTER, STRING TERMINATOR * ADDRESS AND CHARACTER CLR ,X ; CLEAR STRING TERMINATOR : FOR ASCII - FP CONVERSION JSR GETCCH ; GET CURRENT CHARACTER FROM BASIC JSR LBD12 ; CONVERT AN ASCII STRING TO FLOATING POINT PULS A,X,U ; RESTORE CHARACTERS AND POINTERS STA ,X ; REPLACE STRING TERMINATOR STU CHARAD ; RESTORE INPUT CHARACTER RTS LB734: BSR LB73D ; * EVALUATE AN EXPRESSION, RETURN STX BINVAL ; * THE VALUE IN X; STORE IT IN BINVAL LB738: JSR LB26D ; SYNTAX CHECK FOR A COMMA BRA LB70B ; EVALUATE EXPRESSION IN RANGE 0 <= X < 256 * EVALUATE EXPRESSION : RETURN INTEGER PORTION IN X - 'FC' ERROR IF LB73D: JSR LB141 ; EVALUATE NUMERIC EXPRESSION LB740: LDA FP0SGN ; GET SIGN OF FPA0 MANTISSA BMI LB706 ; ILLEGAL FUNCTION CALL' IF NEGATIVE LDA FP0EXP ; GET EXPONENT OF FPA0 CMPA #$90 ; COMPARE TO LARGEST POSITIVE INTEGER BHI LB706 ; ILLEGAL FUNCTION CALL' IF TOO LARGE JSR LBCC8 ; SHIFT BINARY POINT TO EXTREME RIGHT OF FPA0 LDX FPA0+2 ; LOAD X WITH LOWER TWO BYTES OF FPA0 RTS * PEEK PEEK: BSR LB740 ; CONVERT FPA0 TO INTEGER IN REGISTER X LDB ,X ; GET THE VALUE BEING 'PEEK'ED JMP LB4F3 ; CONVERT ACCB INTO A FP NUMBER * POKE POKE: BSR LB734 ; EVALUATE 2 EXPRESSIONS LDX BINVAL ; GET THE ADDRESS TO BE 'POKE'ED STB ,X ; STORE THE DATA IN THAT ADDRESS RTS * LIST cmdLIST: PSHS CC ; SAVE ZERO FLAG ON STACK JSR LAF67 ; CONVERT DECIMAL LINE NUMBER TO BINARY JSR LAD01 ; * FIND RAM ADDRESS OF THAT LINE NUMBER AND STX LSTTXT ; * SAVE IT IN LSTTXT PULS CC ; GET ZERO FLAG FROM STACK BEQ LB784 ; BRANCH IF END OF LINE JSR GETCCH ; GET CURRENT CHARACTER FROM BASIC BEQ LB789 ; BRANCH IF END OF LINE CMPA #$AC ; MINUS TOKEN (IS IT A RANGE OF LINE NUMBERS?) BNE LB783 ; NO - RETURN JSR GETNCH ; GET NEXT CHARACTER FROM BASIC BEQ LB784 ; BRANCH IF END OF LINE JSR LAF67 ; GET ENDING LINE NUMBER BEQ LB789 ; BRANCH IF LEGAL LINE NUMBER LB783: RTS * LIST THE ENTIRE PROGRAM LB784: LDU #$FFFF ; * SET THE DEFAULT ENDING LINE NUMBER STU BINVAL ; * TO $FFFF LB789: LEAS 2,S ; PURGE RETURN ADDRESS FROM THE STACK LDX LSTTXT ; POINT X TO STARTING LINE ADDRESS LB78D: JSR LB95C ; MOVE CURSOR TO START OF A NEW LINE JSR LA549 ; CHECK FOR A BREAK OR PAUSE LDD ,X ; GET ADDRESS OF NEXT BASIC LINE BNE LB79F ; BRANCH IF NOT END OF PROGRAM LB797: JMP LAC73 ; RETURN TO BASIC’S MAIN INPUT LOOP LB79F: STX LSTTXT ; SAVE NEW STARTING LINE ADDRESS LDD 2,X ; * GET THE LINE NUMBER OF THIS LINE AND CMPD BINVAL ; * COMPARE IT TO ENDING LINE NUMBER BHI LB797 ; EXIT IF LINE NUMBER > ENDING LINE NUMBER JSR LBDCC ; PRINT THE NUMBER IN ACCD ON SCREEN IN DECIMAL JSR LB9AC ; SEND A SPACE TO CONSOLE OUT LDX LSTTXT ; GET RAM ADDRESS OF THIS LINE BSR LB7C2 ; UNCRUNCH A LINE LDX [LSTTXT] ; POINT X TO START OF NEXT LINE LDU #LINBUF+1 ; POINT U TO BUFFER FULL OF UNCRUNCHED LINE LB7B9: LDA ,U+ ; GET A BYTE FROM THE BUFFER BEQ LB78D ; BRANCH IF END OF BUFFER JSR LB9B1 ; SEND CHARACTER TO CONSOLE OUT BRA LB7B9 ; GET ANOTHER CHARACTER * UNCRUNCH A LINE INTO BASIC’S LINE INPUT BUFFER LB7C2: JSR RVEC24 ; HOOK INTO RAM LEAX 4,X ; MOVE POINTER PAST ADDRESS OF NEXT LINE AND LINE NUMBER LDY #LINBUF+1 ; UNCRUNCH LINE INTO LINE INPUT BUFFER LB7CB: LDA ,X+ ; GET A CHARACTER BEQ LB820 ; BRANCH IF END OF LINE BMI LB7E6 ; BRANCH IF IT’S A TOKEN CMPA #':' ; CHECK FOR END OF SUB LINE BNE LB7E2 ; BRNCH IF NOT END OF SUB LINE LDB ,X ; GET CHARACTER FOLLOWING COLON CMPB #$84 ; TOKEN FOR ELSE? BEQ LB7CB ; YES - DON’T PUT IT IN BUFFER CMPB #$83 ; TOKEN FOR REMARK? BEQ LB7CB ; YES - DON’T PUT IT IN BUFFER FCB SKP2 ; SKIP TWO BYTES LB7E0: LDA #'!' ; EXCLAMATION POINT LB7E2: BSR LB814 ; PUT CHARACTER IN BUFFER BRA LB7CB ; GET ANOTHER CHARACTER LB7E6: LDU #COMVEC-10 ; FIRST DO COMMANDS CMPA #$FF ; CHECK FOR SECONDARY TOKEN BNE LB7F1 ; BRANCH IF NON SECONDARY TOKEN LDA ,X+ ; GET SECONDARY TOKEN LEAU 5,U ; BUMP IT UP TO SECONDARY FUNCTIONS LB7F1: ANDA #$7F ; MASK OFF BIT 7 OF TOKEN LB7F3: LEAU 10,U ; MOVE TO NEXT COMMAND TABLE TST ,U ; IS THIS TABLE ENABLED? BEQ LB7E0 ; NO - ILLEGAL TOKEN SUBA ,U ; SUBTRACT THE NUMBER OF TOKENS FROM THE CURRENT TOKEN NUMBER BPL LB7F3 ; BRANCH IF TOKEN NOT IN THIS TABLE ADDA ,U ; RESTORE TOKEN NUMBER RELATIVE TO THIS TABLE LDU 1,U ; POINT U TO COMMAND DICTIONARY TABLE LB801: DECA ; DECREMENT TOKEN NUMBER BMI LB80A ; BRANCH IF THIS IS THE CORRECT TOKEN * SKIP THROUGH DICTIONARY TABLE TO START OF NEXT TOKEN LB804: TST ,U+ ; GRAB A BYTE BPL LB804 ; BRANCH IF BIT 7 NOT SET BRA LB801 ; GO SEE IF THIS IS THE CORRECT TOKEN LB80A: LDA ,U ; GET A CHARACTER FROM DICTIONARY TABLE BSR LB814 ; PUT CHARACTER IN BUFFER TST ,U+ ; CHECK FOR START OF NEXT TOKEN BPL LB80A ; BRANCH IF NOT DONE WITH THIS TOKEN BRA LB7CB ; GO GET ANOTHER CHARACTER LB814: CMPY #LINBUF+LBUFMX ; TEST FOR END OF LINE INPUT BUFFER BCC LB820 ; BRANCH IF AT END OF BUFFER ANDA #$7F ; MASK OFF BIT 7 STA ,Y+ ; * SAVE CHARACTER IN BUFFER AND CLR ,Y ; * CLEAR NEXT CHARACTER SLOT IN BUFFER LB820: RTS * * CRUNCH THE LINE THAT THE INPUT POINTER IS * POINTING TO INTO THE LINE INPUT BUFFER * RETURN LENGTH OF CRUNCHED LINE IN ACCD * LB821: JSR RVEC23 ; HOOK INTO RAM LDX CHARAD ; GET BASIC'S INPUT POINTER ADDRESS LDU #LINBUF ; POINT X TO LINE INPUT BUFFER LB829: CLR V43 ; CLEAR ILLEGAL TOKEN FLAG CLR V44 ; CLEAR DATA FLAG LB82B: CLRA ; CLEAR START OF SUBLINE FLAG LB82D: STA V45 LB82F: LDA ,X+ ; GET INPUT CHAR BEQ LB852 ; BRANCH IF END OF LINE TST V43 ; CHECK ILLEGAL TOKEN FLAG & BRANCH IF NOT BEQ LB844 ; PROCESSING AN ILLEGAL TOKEN JSR LB3A2 ; SET CARRY IF NOT UPPER CASE ALPHA BCC LB852 ; BRANCH IF UPPER CASE ALPHA CMPA #'0' ; DON’T CRUNCH ASCII NUMERIC CHARACTERS BLO LB842 ; BRANCH IF NOT NUMERIC CMPA #'9' ; BLS LB852 ; BRANCH IF NUMERIC * END UP HERE IF NOT UPPER CASE ALPHA OR NUMERIC LB842: CLR V43 ; CLEAR ILLEGAL TOKEN FLAG LB844: CMPA #SPACE ; SPACE? BEQ LB852 ; DO NOT REMOVE SPACES CMPA #$60 ; JGH BCC LB852 ; JGH: Don't tokenise lower case letters CMPA #$2A ; JGH BNE LB850 ; JGH: If not *command, continue tokenising TST V45 ; JGH BNE LB850 ; JGH: Not start of line, continue tokenising STA ,U+ ; JGH: * at start of line, so is a *command BRA LB87C ; JGH: Treat as REM, don't tokenise rest of line LB850: STA V42 ; SAVE INPUT CHARACTER AS SCAN DELIMITER CMPA #'"' ; CHECK FOR STRING DELIMITER BEQ LB886 ; BRANCH IF STRING TST V44 ; CHECK DATA FLAG AND BRANCH IF CLEAR BEQ LB86B ; TO CRUNCH DATA LB852: STA ,U+ ; SAVE CHARACTER IN BUFFER BEQ LB85C ; BRANCH IF END OF LINE CMPA #SPACE BEQ LB82F CMPA #':' ; CHECK FOR END OF SUBLINE BEQ LB829 ; AND RESET FLAGS IF END OF SUBLINE LB85A: BRA LB82D ; GO GET ANOTHER CHARACTER LB85C: CLR ,U+ ; DOUBLE ZERO AT END OF LINE CLR ,U+ ; TFR U,D ; SAVE ADDRESS OF END OF LINE IN ACCD SUBD #LINHDR ; LENGTH OF LINE IN ACCD LDX #LINBUF-1 ; SET THE INPUT POINTER TO ONE BEFORE STX CHARAD ; THE START OF THE CRUNCHED LINE RTS ; EXIT 'CRUNCH' LB86B: CMPA #'?' ; CHECK FOR "?" - PRINT ABBREVIATION BNE LB873 ; BRANCH IF NOT PRINT ABBREVIATION LDA #$87 ; GET THE PRINT TOKEN AND SAVE IT BRA LB852 ; IN BUFFER LB873: CMPA #$60 ; APOSTROPHE IS SAME AS REM BNE LB88A ; BRANCH IF NOT REMARK LDD #$3A83 ; COLON, REM TOKEN STD ,U++ ; SAVE IN BUFFER LB87C: CLR V42 ; SET DELIMITER = 0 (END OF LINE) LB87E: LDA ,X+ ; SCAN TILL WE MATCH [V42] BEQ LB852 ; BRANCH IF END OF LINE CMPA V42 ; DELIMITER? BEQ LB852 ; BRANCH OUT IF SO LB886: STA ,U+ ; DON’T CRUNCH REMARKS OR STRINGS BRA LB87E ; GO GET MORE STRING OR REMARK LB88A: CMPA #'0' ; LESS THAN ASCII ZERO? BCS LB892 ; BRANCH IF SO CMPA #';'+1 ; CHECK FOR NUMERIC VALUE, COLON OR SEMICOLON BCS LB852 ; AND INSERT IN BUFFER IF SO LB892: LEAX -1,X ; MOVE INPUT POINTER BACK ONE PSHS U,X ; SAVE POINTERS TO INPUT STRING, OUTPUT STRING CLR V41 ; TOKEN FLAG 0 = COMMAND, FF = SECONDARY LDU #COMVEC-10 ; POINT U TO COMMAND INTERPRETATION * ; TABLE FOR BASIC - 10 LB89B: CLR V42 ; INITIALIZE V42 AS TOKEN COUNTER LB89D: LEAU 10,U ; MOVE TO NEXT COMMAND INTERPRETATION TABLE LDA ,U ; GET NUMBER OF COMMANDS BEQ LB8D4 ; DO SECONDARY FUNCTIONS IF NO COMMAND TABLE LDY 1,U ; POINT Y TO COMMAND DICTIONARY TABLE LB8A6: LDX ,S ; GET POINTER TO INPUT STRING LB8A8: LDB ,Y+ ; GET A BYTE FROM DICTIONARY TABLE SUBB ,X+ ; SUBTRACT INPUT CHARACTER BEQ LB8A8 ; LOOP IF SAME CMPB #$80 ; LAST CHAR IN RESERVED WORD TABLE HAD * ; BIT 7 SET, SO IF WE HAVE $80 HERE * ; THEN IT IS A GOOD COMPARE BNE LB8EA ; BRANCH IF NO MATCH - CHECK ANOTHER COMMAND LEAS 2,S ; DELETE OLD INPUT POINTER FROM STACK PULS U ; GET POINTER TO OUTPUT STRING ORB V42 ; OR IN THE TABLE POSITION TO MAKE THE TOKEN * ; - NOTE THAT B ALREADY HAD $80 IN IT - LDA V41 ; CHECK TOKEN FLAG AND BRANCH BNE LB8C2 ; IF SECONDARY CMPB #$84 ; IS IT ELSE TOKEN? BNE LB8C6 ; NO LDA #':' ; PUT A COLON (SUBLINE) BEFORE ELSE TOKEN LB8C2: STD ,U++ ; SECONDARY TOKENS PRECEEDED BY $FF BRA LB82B ; GO PROCESS MORE INPUT CHARACTERS FROM START OF SUBLINE LB8C6: STB ,U+ ; SAVE THIS TOKEN CMPB #$86 ; DATA TOKEN? BNE LB8CE ; NO INC V44 ; SET DATA FLAG LB8CE: CMPB #$82 ; REM TOKEN? BEQ LB87C ; YES LB8D2: BRA LB85A ; GO PROCESS MORE INPUT CHARACTERS * CHECK FOR A SECONDARY TOKEN LB8D4: LDU #COMVEC-5 ; NOW DO SECONDARY FUNCTIONS COM V41 ; TOGGLE THE TOKEN FLAG BNE LB89B ; BRANCH IF NOW CHECKING SECONDARY COMMANDS * THIS CODE WILL PROCESS INPUT DATA WHICH CANNOT BE CRUNCHED AND SO * IS ASSUMED TO BE ILLEGAL DATA OR AN ILLEGAL TOKEN PULS X,U ; RESTORE INPUT AND OUTPUT POINTERS LDA ,X+ ; MOVE THE FIRST CHARACTER OF AN STA ,U+ ; ILLEGAL TOKEN JSR LB3A2 ; SET CARRY IF NOT ALPHA BCS LB8D2 ; BRANCH IF NOT ALPHA COM V43 ; SET ILLEGAL TOKEN FLAG IF UPPER CASE ALPHA BRA LB8D2 ; PROCESS MORE INPUT CHARACTERS LB8EA: INC V42 ; INCREMENT TOKEN COUNTER DECA ; DECR COMMAND COUNTER BEQ LB89D ; GET ANOTHER COMMAND TABLE IF DONE W/THIS ONE LEAY -1,Y ; MOVE POINTER BACK ONE LB8F1: LDB ,Y+ ; GET TO NEXT BPL LB8F1 ; RESERVED WORD BRA LB8A6 ; GO SEE IF THIS WORD IS A MATCH * PRINT PRINT: BEQ LB958 ; BRANCH IF NO ARGUMENT BSR LB8FE ; CHECK FOR ALL PRINT OPTIONS RTS LB8FE: LB918: JSR RVEC9 ; HOOK INTO RAM JSR XVEC9 LB91B: BEQ LB965 ; RETURN IF END OF LINE LB91D: CMPA #$A4 ; TOKEN FOR TAB( ? BEQ LB97E ; YES CMPA #',' ; COMMA? BEQ LB966 ; YES - ADVANCE TO NEXT TAB FIELD CMPA #';' ; SEMICOLON? BEQ LB997 ; YES - DO NOT ADVANCE CURSOR JSR LB156 ; EVALUATE EXPRESSION LDA VALTYP ; * GET VARIABLE TYPE AND PSHS A ; * SAVE IT ON THE STACK BNE LB938 ; BRANCH IF STRING VARIABLE JSR LBDD9 ; CONVERT FP NUMBER TO AN ASCII STRING JSR LB516 ; PARSE A STRING FROM (X-1) AND PUT * ; DESCRIPTOR ON STRING STACK LB938: BSR LB99F ; PRINT STRING POINTED TO BY X PULS B ; GET VARIABLE TYPE BACK JSR LA35F ; SET UP TAB WIDTH ZONE, ETC LB949: TSTB ; CHECK CURRENT PRINT POSITION BNE LB954 ; BRANCH IF NOT AT START OF LINE JSR GETCCH ; GET CURRENT INPUT CHARACTER CMPA #',' ; COMMA? BEQ LB966 ; SKIP TO NEXT TAB FIELD BSR LB9AC ; SEND A SPACE TO CONSOLE OUT LB954: JSR GETCCH ; GET CURRENT INPUT CHARACTER BNE LB91D ; BRANCH IF NOT END OF LINE LB958: LDA #CR ; * SEND A CR TO BRA LB9B1 ; * CONSOLE OUT LB95C: JSR LA35F ; SET UP TAB WIDTH, ZONE ETC BEQ LB958 ; BRANCH IF WIDTH = ZERO LDA DEVPOS ; GET PRINT POSITION BNE LB958 ; BRANCH IF NOT AT START OF LINE LB965: RTS * SKIP TO NEXT TAB FIELD LB966: JSR LA35F ; SET UP TAB WIDTH, ZONE ETC BEQ LB975 ; BRANCH IF LINE WIDTH = 0 (CASSETTE) LDB DEVPOS ; GET CURRENT POSITION CMPB DEVLCF ; COMPARE TO LAST TAB ZONE BCS LB977 ; BRANCH IF < LAST TAB ZONE BSR LB958 ; SEND A CARRIAGE RETURN TO CONSOLE OUT BRA LB997 ; GET MORE DATA LB975: LDB DEVPOS ; * LB977: SUBB DEVCFW ; * SUBTRACT TAB FIELD WIDTH FROM CURRENT BCC LB977 ; * POSITION UNTIL CARRY SET - NEGATING THE NEGB ; * REMAINDER LEAVES THE NUMBER OF SPACES TO NEXT * * TAB ZONE IN ACCB BRA LB98E ; GO ADVANCE TO NEXT TAB ZONE * PRINT TAB( LB97E: JSR LB709 ; EVALUATE EXPRESSION - RETURN VALUE IN B CMPA #')' ; * 'SYNTAX' ERROR IF NOT ')' LBNE LB277 ; * JSR LA35F ; SET UP TAB WIDTH, ZONE ETC SUBB DEVPOS ; GET DIFFERENCE OF PRINT POSITION & TAB POSITION BLS LB997 ; BRANCH IF TAB POSITION < CURRENT POSITION LB98E: LB992: BSR LB9AC ; SEND A SPACE TO CONSOLE OUT DECB ; DECREMENT DIFFERENCE COUNT BNE LB992 ; BRANCH UNTIL CURRENT POSITION = TAB POSITION LB997: JSR GETNCH ; GET NEXT CHARACTER FROM BASIC JMP LB91B ; LOOK FOR MORE PRINT DATA * COPY A STRING FROM (X) TO CONSOLE OUT LB99C: JSR LB518 ; PARSE A STRING FROM X AND PUT * DESCRIPTOR ON STRING STACK LB99F: JSR LB657 ; GET LENGTH OF STRING AND REMOVE * DESCRIPTOR FROM STRING STACK INCB ; COMPENSATE FOR DECB BELOW LB9A3: DECB ; DECREMENT COUNTER BEQ LB965 ; EXIT ROUTINE LDA ,X+ ; GET A CHARACTER FROM X BSR LB9B1 ; SEND TO CONSOLE OUT BRA LB9A3 ; KEEP LOOPING LB9AC: LDA #SPACE ; SPACE TO CONSOLE OUT FCB SKP2 ; SKIP NEXT TWO BYTES LB9AF: LDA #'?' ; QUESTION MARK TO CONSOLE OUT LB9B1: JMP PUTCHR ; JUMP TO CONSOLE OUT CLS: LDA #12 BRA LB9B1 * FLOATING POINT MATH PACKAGE * ADD .5 TO FPA0 LB9B4: LDX #LBEC0 ; FLOATING POINT CONSTANT (.5) BRA LB9C2 ; ADD .5 TO FPA0 * SUBTRACT FPA0 FROM FP NUMBER POINTED * TO BY (X), LEAVE RESULT IN FPA0 LB9B9: JSR LBB2F ; COPY PACKED FP DATA FROM (X) TO FPA1 * ARITHMETIC OPERATION (-) JUMPS HERE - SUBTRACT FPA0 FROM FPA1 (ENTER * WITH EXPONENT OF FPA0 IN ACCB AND EXPONENT OF FPA1 IN ACCA) LB9BC: COM FP0SGN ; CHANGE MANTISSA SIGN OF FPA0 COM RESSGN ; REVERSE RESULT SIGN FLAG BRA LB9C5 ; GO ADD FPA1 AND FPA0 * ADD FP NUMBER POINTED TO BY * (X) TO FPA0 - LEAVE RESULT IN FPA0 LB9C2: JSR LBB2F ; UNPACK PACKED FP DATA FROM (X) TO * FPA1; RETURN EXPONENT OF FPA1 IN ACCA * ARITHMETIC OPERATION (+) JUMPS HERE - ADD FPA0 TO LB9C5: TSTB ; CHECK EXPONENT OF FPA0 LBEQ LBC4A ; COPY FPA1 TO FPA0 IF FPA0 = LDX #FP1EXP ; POINT X TO FPA1 LB9CD: TFR A,B ; PUT EXPONENT OF FPA1 INTO ACCB TSTB ; CHECK EXPONENT BEQ LBA3E ; RETURN IF EXPONENT = 0 (ADDING 0 TO FPA0) SUBB FP0EXP ; SUBTRACT EXPONENT OF FPA0 FROM EXPONENT OF FPA1 BEQ LBA3F ; BRANCH IF EXPONENTS ARE EQUAL BCS LB9E2 ; BRANCH IF EXPONENT FPA0 > FPA1 STA FP0EXP ; REPLACE FPA0 EXPONENT WITH FPA1 EXPONENT LDA FP1SGN ; * REPLACE FPA0 MANTISSA SIGN STA FP0SGN ; * WITH FPA1 MANTISSA SIGN LDX #FP0EXP ; POINT X TO FPA0 NEGB ; NEGATE DIFFERENCE OF EXPONENTS LB9E2: CMPB #-8 ; TEST DIFFERENCE OF EXPONENTS BLE LBA3F ; BRANCH IF DIFFERENCE OF EXPONENTS <= 8 CLRA ; CLEAR OVERFLOW BYTE LSR 1,X ; SHIFT MS BYTE OF MANTISSA; BIT 7 = 0 JSR LBABA ; GO SHIFT MANTISSA OF (X) TO THE RIGHT (B) TIMES LB9EC: LDB RESSGN ; GET SIGN FLAG BPL LB9FB ; BRANCH IF FPA0 AND FPA1 SIGNS ARE THE SAME COM 1,X ; * COMPLEMENT MANTISSA POINTED COM 2,X ; * TO BY (X) THE COM 3,X ; * ADCA BELOW WILL COM 4,X ; * CONVERT THIS OPERATION COMA ; * INTO A NEG (MANTISSA) ADCA #0 ; ADD ONE TO ACCA - COMA ALWAYS SETS THE CARRY FLAG * THE PREVIOUS TWO BYTES MAY BE REPLACED BY A NEGA * * ADD MANTISSAS OF FPA0 AND FPA1, PUT RESULT IN FPA0 LB9FB: STA FPSBYT ; SAVE FPA SUB BYTE LDA FPA0+3 ; * ADD LS BYTE ADCA FPA1+3 ; * OF MANTISSA STA FPA0+3 ; SAVE IN FPA0 LSB LDA FPA0+2 ; * ADD NEXT BYTE ADCA FPA1+2 ; * OF MANTISSA STA FPA0+2 ; SAVE IN FPA0 LDA FPA0+1 ; * ADD NEXT BYTE ADCA FPA1+1 ; * OF MANTISSA STA FPA0+1 ; SAVE IN FPA0 LDA FPA0 ; * ADD MS BYTE ADCA FPA1 ; * OF MANTISSA STA FPA0 ; SAVE IN FPA0 TSTB ; TEST SIGN FLAG BPL LBA5C ; BRANCH IF FPA0 & FPA1 SIGNS WERE ALIKE LBA18: BCS LBA1C ; BRANCH IF POSITIVE MANTISSA BSR LBA79 ; NEGATE FPA0 MANTISSA * NORMALIZE FPA0 LBA1C: CLRB ; CLEAR TEMPORARY EXPONENT ACCUMULATOR LBA1D: LDA FPA0 ; TEST MSB OF MANTISSA BNE LBA4F ; BRANCH IF <> 0 LDA FPA0+1 ; * IF THE MSB IS STA FPA0 ; * 0, THEN SHIFT THE LDA FPA0+2 ; * MANTISSA A WHOLE BYTE STA FPA0+1 ; * AT A TIME. THIS LDA FPA0+3 ; * IS FASTER THAN ONE STA FPA0+2 ; * BIT AT A TIME LDA FPSBYT ; * BUT USES MORE MEMORY. STA FPA0+3 ; * FPSBYT, THE CARRY IN CLR FPSBYT ; * BYTE, REPLACES THE MATISSA LSB. ADDB #8 ; SHIFTING ONE BYTE = 8 BIT SHIFTS; ADD 8 TO EXPONENT CMPB #5*8 ; CHECK FOR 5 SHIFTS BLT LBA1D ; BRANCH IF < 5 SHIFTS, IF > 5, THEN MANTISSA = 0 LBA39: CLRA ; A ZERO EXPONENT = 0 FLOATING POINT LBA3A: STA FP0EXP ; ZERO OUT THE EXPONENT STA FP0SGN ; ZERO OUT THE MANTISSA SIGN LBA3E: RTS LBA3F: BSR LBAAE ; SHIFT FPA0 MANTISSA TO RIGHT CLRB ; CLEAR CARRY FLAG BRA LB9EC * SHIFT FPA0 LEFT ONE BIT UNTIL BIT 7 * OF MATISSA MS BYTE = 1 LBA44: INCB ; ADD ONE TO EXPONENT ACCUMULATOR ASL FPSBYT ; SHIFT SUB BYTE ONE LEFT ROL FPA0+3 ; SHIFT LS BYTE ROL FPA0+2 ; SHIFT NS BYTE ROL FPA0+1 ; SHIFT NS BYTE ROL FPA0 ; SHIFT MS BYTE LBA4F: BPL LBA44 ; BRANCH IF NOT YET NORMALIZED LDA FP0EXP ; GET CURRENT EXPONENT PSHS B ; SAVE EXPONENT MODIFIER CAUSED BY NORMALIZATION SUBA ,S+ ; SUBTRACT ACCUMULATED EXPONENT MODIFIER STA FP0EXP ; SAVE AS NEW EXPONENT BLS LBA39 ; SET FPA0 = 0 IF THE NORMALIZATION CAUSED * MORE OR EQUAL NUMBER OF LEFT SHIFTS THAN THE * SIZE OF THE EXPONENT FCB SKP2 ; SKIP 2 BYTES LBA5C: BCS LBA66 ; BRANCH IF MANTISSA OVERFLOW ASL FPSBYT ; SUB BYTE BIT 7 TO CARRY - USE AS ROUND-OFF * ; FLAG (TRUNCATE THE REST OF SUB BYTE) LDA #0 ; CLRA, BUT DO NOT CHANGE CARRY FLAG STA FPSBYT ; CLEAR THE SUB BYTE BRA LBA72 ; GO ROUND-OFF RESULT LBA66: INC FP0EXP ; INCREMENT EXPONENT - MULTIPLY BY 2 BEQ LBA92 ; OVERFLOW ERROR IF CARRY PAST $FF ROR FPA0 ; * SHIFT MANTISSA ROR FPA0+1 ; * ONE TO ROR FPA0+2 ; * THE RIGHT - ROR FPA0+3 ; * DIVIDE BY TWO LBA72: BCC LBA78 ; BRANCH IF NO ROUND-OFF NEEDED BSR LBA83 ; ADD ONE TO MANTISSA - ROUND OFF BEQ LBA66 ; BRANCH iF OVERFLOW - MANTISSA = 0 LBA78: RTS * NEGATE FPA0 MANTISSA LBA79: COM FP0SGN ; TOGGLE SIGN OF MANTISSA LBA7B: COM FPA0 ; * COMPLEMENT ALL 4 MANTISSA BYTES COM FPA0+1 ; * COM FPA0+2 ; * COM FPA0+3 ; * * ADD ONE TO FPA0 MANTISSA LBA83: LDX FPA0+2 ; * GET BOTTOM 2 MANTISSA LEAX 1,X ; * BYTES, ADD ONE TO STX FPA0+2 ; * THEM AND SAVE THEM BNE LBA91 ; BRANCH IF NO OVERFLOW LDX FPA0 ; * IF OVERFLOW ADD ONE LEAX 1,X ; * TO TOP 2 MANTISSA STX FPA0 ; * BYTES AND SAVE THEM LBA91: RTS LBA92: LDB #2*5 ; OV' OVERFLOW ERROR JMP LAC46 ; PROCESS AN ERROR LBA97: LDX #FPA2-1 ; POINT X TO FPA2 * SHIFT FPA POINTED TO BY (X) ; TO * THE RIGHT -(B) TIMES. EXIT WITH * ACCA CONTAINING DATA SHIFTED OUT * TO THE RIGHT (SUB BYTE) AND ; THE DATA * SHIFTED IN FROM THE LEFT WILL COME FROM FPCARY LBA9A: LDA 4,X ; GET LS BYTE OF MANTISSA (X) STA FPSBYT ; SAVE IN FPA SUB BYTE LDA 3,X ; * SHIFT THE NEXT THREE BYTES OF THE STA 4,X ; * MANTISSA RIGHT ONE COMPLETE BYTE. LDA 2,X ; * STA 3,X ; * LDA 1,X ; * STA 2,X ; * LDA FPCARY ; GET THE CARRY IN BYTE STA 1,X ; STORE AS THE MS MANTISSA BYTE OF (X) LBAAE: ADDB #8 ; ADD 8 TO DIFFERENCE OF EXPONENTS BLE LBA9A ; BRANCH IF EXPONENT DIFFERENCE < -8 LDA FPSBYT ; GET FPA SUB BYTE SUBB #8 ; CAST OUT THE 8 ADDED IN ABOVE BEQ LBAC4 ; BRANCH IF EXPONENT DIFFERENCE = 0 LBAB8: ASR 1,X ; * SHIFT MANTISSA AND SUB BYTE ONE BIT TO THE RIGHT LBABA: ROR 2,X ; * ROR 3,X ; * ROR 4,X ; * RORA ; * INCB ; ADD ONE TO EXPONENT DIFFERENCE BNE LBAB8 ; BRANCH IF EXPONENTS NOT = LBAC4: RTS LBAC5: FCB $81,$00,$00,$00,$00 ; FLOATING POINT CONSTANT 1.0 * ARITHMETIC OPERATION (*) JUMPS HERE - MULTIPLY * FPA0 BY (X) - RETURN PRODUCT IN FPA0 LBACA: BSR LBB2F ; MOVE PACKED FPA FROM (X) TO FPA1 LBACC: BEQ LBB2E ; BRANCH IF EXPONENT OF FPA0 = 0 BSR LBB48 ; CALCULATE EXPONENT OF PRODUCT * MULTIPLY FPA0 MANTISSA BY FPA1. NORMALIZE * HIGH ORDER BYTES OF PRODUCT ; IN FPA0. THE * LOW ORDER FOUR BYTES OF THE ; PRODUCT WILL * BE STORED IN VAB-VAE. LBAD0: LDA #0 ; * ZERO OUT MANTISSA OF FPA2 STA FPA2 ; * STA FPA2+1 ; * STA FPA2+2 ; * STA FPA2+3 ; * LDB FPA0+3 ; GET LS BYTE OF FPA0 BSR LBB00 ; MULTIPLY BY FPA1 LDB FPSBYT ; * TEMPORARILY SAVE SUB BYTE 4 STB VAE ; * LDB FPA0+2 ; GET NUMBER 3 MANTISSA BYTE OF FPA0 BSR LBB00 ; MULTIPLY BY FPA1 LDB FPSBYT ; * TEMPORARILY SAVE SUB BYTE 3 STB VAD ; * LDB FPA0+1 ; GET NUMBER 2 MANTISSA BYTE OF FPA0 BSR LBB00 ; MULTIPLY BY FPA1 LDB FPSBYT ; * TEMPORARILY SAVE SUB BYTE 2 STB VAC ; * LDB FPA0 ; GET MS BYTE OF FPA0 MANTISSA BSR LBB02 ; MULTIPLY BY FPA1 LDB FPSBYT ; * TEMPORARILY SAVE SUB BYTE 1 STB VAB ; * JSR LBC0B ; COPY MANTISSA FROM FPA2 TO FPA0 JMP LBA1C ; NORMALIZE FPA0 LBB00: BEQ LBA97 ; SHIFT FPA2 ONE BYTE TO RIGHT LBB02: COMA ; SET CARRY FLAG * MULTIPLY FPA1 MANTISSA BY ACCB AND * ADD PRODUCT TO FPA2 MANTISSA LBB03: LDA FPA2 ; GET FPA2 MS BYTE RORB ; ROTATE CARRY FLAG INTO SHIFT COUNTER; ; * DATA BIT INTO CARRY BEQ LBB2E ; BRANCH WHEN 8 SHIFTS DONE BCC LBB20 ; DO NOT ADD FPA1 IF DATA BIT = 0 LDA FPA2+3 ; * ADD MANTISSA LS BYTE ADDA FPA1+3 ; * STA FPA2+3 ; * LDA FPA2+2 ; = ADD MANTISSA NUMBER 3 BYTE ADCA FPA1+2 ; = STA FPA2+2 ; = LDA FPA2+1 ; * ADD MANTISSA NUMBER 2 BYTE ADCA FPA1+1 ; * STA FPA2+1 ; * LDA FPA2 ; = ADD MANTISSA MS BYTE ADCA FPA1 ; = LBB20: RORA ; * ROTATE CARRY INTO MS BYTE STA FPA2 ; * ROR FPA2+1 ; = ROTATE FPA2 ONE BIT TO THE RIGHT ROR FPA2+2 ; = ROR FPA2+3 ; = ROR FPSBYT ; = CLRA ; CLEAR CARRY FLAG BRA LBB03 ; KEEP LOOPING LBB2E: RTS * UNPACK A FP NUMBER FROM (X) ; TO FPA1 LBB2F: LDD 1,X ; GET TWO MSB BYTES OF MANTISSA FROM * FPA POINTED TO BY X STA FP1SGN ; SAVE PACKED MANTISSA SIGN BYTE ORA #$80 ; FORCE BIT 7 OF MSB MANTISSA = 1 STD FPA1 ; SAVE 2 MSB BYTES IN FPA1 LDB FP1SGN ; * GET PACKED MANTISSA SIGN BYTE. EOR W/FPA0 EORB FP0SGN ; * SIGN - NEW SIGN POSITION IF BOTH OLD SIGNS ALIKE, STB RESSGN ; * NEG IF BOTH OLD SIGNS DIFF. SAVE ADJUSTED * ; * MANTISSA SIGN BYTE LDD 3,X ; = GET 2 LSB BYTES OF MANTISSA STD FPA1+2 ; = AND PUT IN FPA1 LDA ,X ; * GET EXPONENT FROM (X) AND STA FP1EXP ; * PUT IN EXPONENT OF FPA1 LDB FP0EXP ; GET EXPONENT OF FPA0 RTS * CALCULATE EXPONENT FOR PRODUCT OF FPA0 & FPA1 * ENTER WITH EXPONENT OF FPA1 ; IN ACCA LBB48: TSTA ; TEST EXPONENT OF FPA1 BEQ LBB61 ; PURGE RETURN ADDRESS & SET FPA0 = 0 ADDA FP0EXP ; ADD FPA1 EXPONENT TO FPA0 EXPONENT RORA ; ROTATE CARRY INTO BIT 7; BIT 0 INTO CARRY ROLA ; SET OVERFLOW FLAG BVC LBB61 ; BRANCH IF EXPONENT TOO LARGE OR SMALL ADDA #$80 ; ADD $80 BIAS TO EXPONENT STA FP0EXP ; SAVE NEW EXPONENT BEQ LBB63 ; SET FPA0 LDA RESSGN ; GET MANTISSA SIGN STA FP0SGN ; SAVE AS MANTISSA SIGN OF FPA0 RTS * IF FPA0 = POSITIVE THEN 'OV' ERROR IF FPA0 * = IS NEGATIVE THEN FPA0 = 0 LBB5C: LDA FP0SGN ; GET MANTISSA SIGN OF FPA0 COMA ; CHANGE SIGN OF FPA0 MANTISSA BRA LBB63 LBB61: LEAS 2,S ; PURGE RETURN ADDRESS FROM STACK LBB63: LBPL LBA39 ; ZERO FPA0 MANTISSA SIGN & EXPONENT LBB67: JMP LBA92 ; OV' OVERFLOW ERROR * FAST MULTIPLY BY 10 AND LEAVE RESULT IN FPA0 LBB6A: JSR LBC5F ; TRANSFER FPA0 TO FPA1 BEQ LBB7C ; BRANCH IF EXPONENT = 0 ADDA #2 ; ADD 2 TO EXPONENT (TIMES 4) BCS LBB67 ; OV' ERROR IF EXPONENT > $FF CLR RESSGN ; CLEAR RESULT SIGN BYTE JSR LB9CD ; ADD FPA1 TO FPA0 (TIMES 5) INC FP0EXP ; ADD ONE TO EXPONENT (TIMES 10) BEQ LBB67 ; OV' ERROR IF EXPONENT > $FF LBB7C: RTS LBB7D: FCB $84,$20,$00,$00,$00 ; FLOATING POINT CONSTANT 10 * DIVIDE FPA0 BY 10 LBB82: JSR LBC5F ; MOVE FPA0 TO FPA1 LDX #LBB7D ; POINT TO FLOATING POINT CONSTANT 10 CLRB ; ZERO MANTISSA SIGN BYTE LBB89: STB RESSGN ; STORE THE QUOTIENT MANTISSA SIGN BYTE JSR LBC14 ; UNPACK AN FP NUMBER FROM (X) INTO FPA0 FCB SKP2 ; SKIP TWO BYTES * DIVIDE (X) BY FPA0-LEAVE NORMALIZED QUOTIENT IN FPA0 LBB8F: BSR LBB2F ; GET FP NUMBER FROM (X) TO FPA1 * ARITHMETIC OPERATION (/) JUMPS HERE. DIVIDE FPA1 BY FPA0 (ENTER WITH * EXPONENT OF FPA1 IN ACCA AND FLAGS SET BY TSTA) * DIVIDE FPA1 BY FPA0 LBB91: BEQ LBC06 ; /0' DIVIDE BY ZERO ERROR NEG FP0EXP ; GET EXPONENT OF RECIPROCAL OF DIVISOR BSR LBB48 ; CALCULATE EXPONENT OF QUOTIENT INC FP0EXP ; INCREMENT EXPONENT BEQ LBB67 ; OV' OVERFLOW ERROR LDX #FPA2 ; POINT X TO MANTISSA OF FPA2 - HOLD * ; TEMPORARY QUOTIENT IN FPA2 LDB #4 ; 5 BYTE DIVIDE STB TMPLOC ; SAVE BYTE COUNTER LDB #1 ; SHIFT COUNTER-AND TEMPORARY QUOTIENT BYTE * COMPARE FPA0 MANTISSA TO FPA1 MANTISSA - * SET CARRY FLAG IF FPA1 >= FPA0 LBBA4: LDA FPA0 ; * COMPARE THE TWO MS BYTES CMPA FPA1 ; * OF FPA0 AND FPA1 AND BNE LBBBD ; * BRANCH IF <> LDA FPA0+1 ; = COMPARE THE NUMBER 2 CMPA FPA1+1 ; = BYTES AND BNE LBBBD ; = BRANCH IF <> LDA FPA0+2 ; * COMPARE THE NUMBER 3 CMPA FPA1+2 ; * BYTES AND BNE LBBBD ; * BRANCH IF <> LDA FPA0+3 ; = COMPARE THE LS BYTES CMPA FPA1+3 ; = AND BRANCH BNE LBBBD ; = IF <> COMA ; SET CARRY FLAG IF FPA0 = FPA1 LBBBD: TFR CC,A ; SAVE CARRY FLAG STATUS IN ACCA; CARRY * CLEAR IF FPA0 > FPA1 ROLB ; ROTATE CARRY INTO TEMPORARY QUOTIENT BYTE BCC LBBCC ; CARRY WILL BE SET AFTER 8 SHIFTS STB ,X+ ; SAVE TEMPORARY QUOTIENT DEC TMPLOC ; DECREMENT BYTE COUNTER BMI LBBFC ; BRANCH IF DONE BEQ LBBF8 ; BRANCH IF LAST BYTE LDB #1 ; RESET SHIFT COUNTER AND TEMPORARY QUOTIENT BYTE LBBCC: TFR A,CC ; RESTORE CARRY FLAG AND BCS LBBDE ; BRANCH IF FPA0 =< FPA1 LBBD0: ASL FPA1+3 ; * SHIFT FPA1 MANTISSA 1 BIT TO LEFT ROL FPA1+2 ; * ROL FPA1+1 ; * ROL FPA1 ; * BCS LBBBD ; BRANCH IF CARRY - ADD ONE TO PARTIAL QUOTIENT BMI LBBA4 ; IF MSB OF HIGH ORDER MANTISSA BYTE IS * SET, CHECK THE MAGNITUDES OF FPA0, FPA1 BRA LBBBD ; CARRY IS CLEAR, CHECK ANOTHER BIT * SUBTRACT FPA0 FROM FPA1 - LEAVE RESULT IN FPA1 LBBDE: LDA FPA1+3 ; * SUBTRACT THE LS BYTES OF MANTISSA SUBA FPA0+3 ; * STA FPA1+3 ; * LDA FPA1+2 ; = THEN THE NEXT BYTE SBCA FPA0+2 ; = STA FPA1+2 ; = LDA FPA1+1 ; * AND THE NEXT SBCA FPA0+1 ; * STA FPA1+1 ; * LDA FPA1 ; = AND FINALLY, THE MS BYTE OF MANTISSA SBCA FPA0 ; = STA FPA1 ; = BRA LBBD0 ; GO SHIFT FPA1 LBBF8: LDB #$40 ; USE ONLY TWO BITS OF THE LAST BYTE (FIFTH) BRA LBBCC ; GO SHIFT THE LAST BYTE LBBFC: RORB ; * SHIFT CARRY (ALWAYS SET HERE) INTO RORB ; * BIT 5 AND MOVE RORB ; * BITS 1,0 TO BITS 7,6 STB FPSBYT ; SAVE SUB BYTE BSR LBC0B ; MOVE MANTISSA OF FPA2 TO FPA0 JMP LBA1C ; NORMALIZE FPA0 LBC06: LDB #2*10 ; /0' ERROR JMP LAC46 ; PROCESS THE ERROR * COPY MANTISSA FROM FPA2 TO FPA0 LBC0B: LDX FPA2 ; * MOVE TOP 2 BYTES STX FPA0 ; * LDX FPA2+2 ; = MOVE BOTTOM 2 BYTES STX FPA0+2 ; = RTS * COPY A PACKED FP NUMBER FROM (X) TO FPA0 LBC14: PSHS A ; SAVE ACCA LDD 1,X ; GET TOP TWO MANTISSA BYTES STA FP0SGN ; SAVE MS BYTE OF MANTISSA AS MANTISSA SIGN ORA #$80 ; UNPACK MS BYTE STD FPA0 ; SAVE UNPACKED TOP 2 MANTISSA BYTES CLR FPSBYT ; CLEAR MANTISSA SUB BYTE LDB ,X ; GET EXPONENT TO ACCB LDX 3,X ; * MOVE LAST 2 STX FPA0+2 ; * MANTISSA BYTES STB FP0EXP ; SAVE EXPONENT PULS A,PC ; RESTORE ACCA AND RETURN LBC2A: LDX #V45 ; POINT X TO MANTISSA OF FPA4 BRA LBC35 ; MOVE FPA0 TO FPA4 LBC2F: LDX #V40 ; POINT X TO MANTISSA OF FPA3 FCB SKP2 ; SKIP TWO BYTES LBC33: LDX VARDES ; POINT X TO VARIABLE DESCRIPTOR IN VARDES * PACK FPA0 AND MOVE IT TO ADDRESS IN X LBC35: LDA FP0EXP ; * COPY EXPONENT STA ,X ; * LDA FP0SGN ; GET MANTISSA SIGN BIT ORA #$7F ; MASK THE BOTTOM 7 BITS ANDA FPA0 ; AND BIT 7 OF MANTISSA SIGN INTO BIT 7 OF MS BYTE STA 1,X ; SAVE MS BYTE LDA FPA0+1 ; * MOVE 2ND MANTISSA BYTE STA 2,X ; * LDU FPA0+2 ; = MOVE BOTTOM 2 MANTISSA BYTES STU 3,X ; = RTS * MOVE FPA1 TO FPA0 RETURN W/MANTISSA SIGN IN ACCA LBC4A: LDA FP1SGN ; * COPY MANTISSA SIGN FROM LBC4C: STA FP0SGN ; * FPA1 TO FPA0 LDX FP1EXP ; = COPY EXPONENT + MS BYTE FROM STX FP0EXP ; = FPA1 TO FPA0 CLR FPSBYT ; CLEAR MANTISSA SUB BYTE LDA FPA1+1 ; * COPY 2ND MANTISSA BYTE STA FPA0+1 ; * FROM FPA1 TO FPA0 LDA FP0SGN ; GET MANTISSA SIGN LDX FPA1+2 ; * COPY 3RD AND 4TH MANTISSA BYTE STX FPA0+2 ; * FROM FPA1 TO FPA0 RTS * TRANSFER FPA0 TO FPA1 LBC5F: LDD FP0EXP ; * TRANSFER EXPONENT & MS BYTE STD FP1EXP ; * LDX FPA0+1 ; = TRANSFER MIDDLE TWO BYTES STX FPA1+1 ; = LDX FPA0+3 ; * TRANSFER BOTTOM TWO BYTES STX FPA1+3 ; * TSTA ; SET FLAGS ACCORDING TO EXPONENT RTS * CHECK FPA0; RETURN ACCB = 0 ; IF FPA0 = 0, * ACCB = $FF IF FPA0 = NEGATIVE, ACCB = 1 IF FPA0 = POSITIVE LBC6D: LDB FP0EXP ; GET EXPONENT BEQ LBC79 ; BRANCH IF FPA0 = 0 LBC71: LDB FP0SGN ; GET SIGN OF MANTISSA LBC73: ROLB ; BIT 7 TO CARRY LDB #$FF ; NEGATIVE FLAG BCS LBC79 ; BRANCH IF NEGATIVE MANTISSA NEGB ; ACCB = 1 IF POSITIVE MANTISSA LBC79: RTS * SGN SGN: BSR LBC6D ; SET ACCB ACCORDING TO SIGN OF FPA0 * CONVERT A SIGNED NUMBER IN ACCB INTO A FLOATING POINT NUMBER LBC7C: STB FPA0 ; SAVE ACCB IN FPA0 CLR FPA0+1 ; CLEAR NUMBER 2 MANTISSA BYTE OF FPA0 LDB #$88 ; EXPONENT REQUIRED IF FPA0 IS TO BE AN INTEGER LBC82: LDA FPA0 ; GET MS BYTE OF MANTISSA SUBA #$80 ; SET CARRY IF POSITIVE MANTISSA LBC86: STB FP0EXP ; SAVE EXPONENT LDD ZERO ; * ZERO OUT ACCD AND STD FPA0+2 ; * BOTTOM HALF OF FPA0 STA FPSBYT ; CLEAR SUB BYTE STA FP0SGN ; CLEAR SIGN OF FPA0 MANTISSA JMP LBA18 ; GO NORMALIZE FPA0 * ABS ABS: CLR FP0SGN ; FORCE MANTISSA SIGN OF FPA0 POSITIVE RTS * COMPARE A PACKED FLOATING POINT NUMBER POINTED TO * BY (X) TO AN UNPACKED FP NUMBER IN FPA0. RETURN * ZERO FLAG SET AND ACCB = 0, ; IF EQUAL; ACCB = 1 IF * FPA0 > (X); ACCB = $FF IF FPA0 < (X) LBC96: LDB ,X ; CHECK EXPONENT OF (X) BEQ LBC6D ; BRANCH IF FPA = 0 LDB 1,X ; GET MS BYTE OF MANTISSA OF (X) EORB FP0SGN ; EOR WITH SIGN OF FPA0 BMI LBC71 ; BRANCH IF SIGNS NOT = * COMPARE FPA0 WITH FP NUMBER ; POINTED TO BY (X). * FPA0 IS NORMALIZED, (X) IS PACKED. LBCA0: LDB FP0EXP ; * GET EXPONENT OF CMPB ,X ; * FPA0, COMPARE TO EXPONENT OF BNE LBCC3 ; * (X) AND BRANCH IF <>. LDB 1,X ; * GET MS BYTE OF (X), KEEP ONLY ORB #$7F ; * THE SIGN BIT - 'AND' THE BOTTOM 7 ANDB FPA0 ; * BITS OF FPA0 INTO ACCB CMPB 1,X ; = COMPARE THE BOTTOM 7 BITS OF THE MANTISSA BNE LBCC3 ; = MS BYTE AND BRANCH IF <> LDB FPA0+1 ; * COMPARE 2ND BYTE CMPB 2,X ; * OF MANTISSA, BNE LBCC3 ; * BRANCH IF <> LDB FPA0+2 ; = COMPARE 3RD BYTE CMPB 3,X ; = OF MANTISSA, BNE LBCC3 ; = BRANCH IF <> LDB FPA0+3 ; * SUBTRACT LS BYTE SUBB 4,X ; * OF (X) FROM LS BYTE OF BNE LBCC3 ; * FPA0, BRANCH IF <> RTS ; RETURN IF FP (X) = FPA0 LBCC3: RORB ; SHIFT CARRY TO BIT 7; CARRY SET IF FPA0 < (X) EORB FP0SGN ; TOGGLE SIZE COMPARISON BIT IF FPA0 IS NEGATIVE BRA LBC73 ; GO SET ACCB ACCORDING TO COMPARISON * DE-NORMALIZE FPA0 : SHIFT THE MANTISSA UNTIL THE BINARY POINT IS TO THE RIGHT * OF THE LEAST SIGNIFICANT BYTE OF THE MANTISSA LBCC8: LDB FP0EXP ; GET EXPONENT OF FPA0 BEQ LBD09 ; ZERO MANTISSA IF FPA0 = 0 SUBB #$A0 ; SUBTRACT $A0 FROM FPA0 EXPONENT T THIS WILL YIELD * ; THE NUMBER OF SHIFTS REQUIRED TO DENORMALIZE FPA0. WHEN * ; THE EXPONENT OF FPA0 IS = ZERO, THEN THE BINARY POINT * ; WILL BE TO THE RIGHT OF THE MANTISSA LDA FP0SGN ; TEST SIGN OF FPA0 MANTISSA BPL LBCD7 ; BRANCH IF POSITIVE COM FPCARY ; COMPLEMENT CARRY IN BYTE JSR LBA7B ; NEGATE MANTISSA OF FPA0 LBCD7: LDX #FP0EXP ; POINT X TO FPA0 CMPB #-8 ; EXPONENT DIFFERENCE < -8? BGT LBCE4 ; YES JSR LBAAE ; SHIFT FPA0 RIGHT UNTIL FPA0 EXPONENT = $A0 CLR FPCARY ; CLEAR CARRY IN BYTE RTS LBCE4: CLR FPCARY ; CLEAR CARRY IN BYTE LDA FP0SGN ; * GET SIGN OF FPA0 MANTISSA ROLA ; * ROTATE IT INTO THE CARRY FLAG ROR FPA0 ; ROTATE CARRY (MANTISSA SIGN) INTO BIT 7 * ; OF LS BYTE OF MANTISSA JMP LBABA ; DE-NORMALIZE FPA0 * INT * THE INT STATEMENT WILL "DENORMALIZE" FPA0 - THAT IS IT WILL SHIFT THE BINARY POINT * TO THE EXTREME RIGHT OF THE ; MANTISSA TO FORCE ITS EXPONENT TO BE $AO. ONCE * THIS IS DONE THE MANTISSA OF FPA0 WILL CONTAIN THE FOUR LEAST SIGNIFICANT * BYTES OF THE INTEGER PORTION OF FPA0. AT THE CONCLUSION OF THE DE-NORMALIZATION * ONLY THE INTEGER PORTION OF ; FPA0 WILL REMAIN. * INT: LDB FP0EXP ; GET EXPONENT OF FPA0 CMPB #$A0 ; LARGEST POSSIBLE INTEGER EXPONENT BCC LBD11 ; RETURN IF FPA0 >= 32768 BSR LBCC8 ; SHIFT THE BINARY POINT ONE TO THE RIGHT OF THE * ; LS BYTE OF THE FPA0 MANTISSA STB FPSBYT ; ACCB = 0: ZERO OUT THE SUB BYTE LDA FP0SGN ; GET MANTISSA SIGN STB FP0SGN ; FORCE MANTISSA SIGN TO BE POSITIVE SUBA #$80 ; SET CARRY IF MANTISSA LDA #$A0 ; * GET DENORMALIZED EXPONENT AND STA FP0EXP ; * SAVE IT IN FPA0 EXPONENT LDA FPA0+3 ; = GET LS BYTE OF FPA0 AND STA CHARAC ; = SAVE IT IN CHARAC JMP LBA18 ; NORMALIZE FPA0 LBD09: STB FPA0 ; * LOAD MANTISSA OF FPA0 WITH CONTENTS OF ACCB STB FPA0+1 ; * STB FPA0+2 ; * STB FPA0+3 ; * LBD11: RTS ; * * CONVERT ASCII STRING TO FLOATING POINT LBD12: LDX ZERO ; (X) = 0 STX FP0SGN ; * ZERO OUT FPA0 & THE SIGN FLAG (COEFCT) STX FP0EXP ; * STX FPA0+1 ; * STX FPA0+2 ; * STX V47 ; INITIALIZE EXPONENT & EXPONENT SIGN FLAG TO ZERO STX V45 ; INITIALIZE RIGHT DECIMAL CTR & DECIMAL PT FLAG TO 0 BCS LBD86 ; IF CARRY SET (NUMERIC CHARACTER), ASSUME ACCA CONTAINS FIRST * NUMERIC CHAR, SIGN IS POSITIVE AND SKIP THE RAM HOOK JSR RVEC19 ; HOOK INTO RAM JSR XVEC19 LBD25: CMPA #'-' ; * CHECK FOR A LEADING MINUS SIGN AND BRANCH BNE LBD2D ; * IF NO MINUS SIGN COM COEFCT ; TOGGLE SIGN; 0 = +; FF = - BRA LBD31 ; INTERPRET THE REST OF THE STRING LBD2D: CMPA #'+' ; * CHECK FOR LEADING PLUS SlGN AND BRANCH BNE LBD35 ; * IF NOT A PLUS SIGN LBD31: JSR GETNCH ; GET NEXT INPUT CHARACTER FROM BASIC BCS LBD86 ; BRANCH IF NUMERIC CHARACTER LBD35: CMPA #'.' ; DECIMAL POlNT? BEQ LBD61 ; YES CMPA #'E' ; "E" SHORTHAND FORM (SCIENTIFIC NOTATION)? BNE LBD65 ; NO * EVALUATE EXPONENT OF EXPONENTIAL FORMAT JSR GETNCH ; GET NEXT INPUT CHARACTER FROM BASIC BCS LBDA5 ; BRANCH IF NUMERIC CMPA #$AC ; MINUS TOKEN? BEQ LBD53 ; YES CMPA #'-' ; ASCII MINUS? BEQ LBD53 ; YES CMPA #$AB ; PLUS TOKEN? BEQ LBD55 ; YES CMPA #'+' ; ASCII PLUS? BEQ LBD55 ; YES BRA LBD59 ; BRANCH IF NO SIGN FOUND LBD53: COM V48 ; SET EXPONENT SIGN FLAG TO NEGATIVE * STRIP A DECIMAL NUMBER FROM ; BASIC LINE, CONVERT IT TO BINARY IN V47 LBD55: JSR GETNCH ; GET NEXT INPUT CHARACTER FROM BASIC BCS LBDA5 ; IF NUMERIC CHARACTER, CONVERT TO BINARY LBD59: TST V48 ; * CHECK EXPONENT SIGN FLAG BEQ LBD65 ; * AND BRANCH IF POSITIVE NEG V47 ; NEGATE VALUE OF EXPONENT BRA LBD65 LBD61: COM V46 ; *TOGGLE DECIMAL PT FLAG AND INTERPRET ANOTHER BNE LBD31 ; *CHARACTER IF <> 0 - TERMINATE INTERPRETATION * IF SECOND DECIMAL ; POINT * ADJUST FPA0 FOR THE DECIMAL ; EXPONENT IN V47 LBD65: LDA V47 ; * GET EXPONENT, SUBTRACT THE NUMBER OF SUBA V45 ; * PLACES TO THE RIGHT OF DECIMAL POINT STA V47 ; * AND RESAVE IT. BEQ LBD7F ; EXIT ROUTINE IF ADJUSTED EXPONENT = ZERO BPL LBD78 ; BRANCH IF POSITIVE EXPONENT LBD6F: JSR LBB82 ; DIVIDE FPA0 BY 10 INC V47 ; INCREMENT EXPONENT COUNTER (MULTIPLY BY 10) BNE LBD6F ; KEEP MULTIPLYING BRA LBD7F ; EXIT ROUTINE LBD78: JSR LBB6A ; MULTIPLY FPA0 BY 10 DEC V47 ; DECREMENT EXPONENT COUNTER (DIVIDE BY 10) BNE LBD78 ; KEEP MULTIPLYING LBD7F: LDA COEFCT ; GET THE SIGN FLAG BPL LBD11 ; RETURN IF POSITIVE JMP LBEE9 ; TOGGLE MANTISSA SIGN OF FPA0, IF NEGATIVE *MULTIPLY FPA0 BY TEN AND ADD ; ACCA TO THE RESULT LBD86: LDB V45 ; *GET THE RIGHT DECIMAL COUNTER AND SUBTRACT SUBB V46 ; *THE DECIMAL POINT FLAG FROM IT. IF DECIMAL POINT STB V45 ; *FLAG=0, NOTHING HAPPENS. IF DECIMAL POINT FLAG IS * ; -1, THEN RIGHT DECIMAL COUNTER IS INCREMENTED BY ONE PSHS A ; SAVE NEW DIGIT ON STACK JSR LBB6A ; MULTIPLY FPA0 BY 10 PULS B ; GET NEW DIGIT BACK SUBB #'0' ; MASK OFF ASCII BSR LBD99 ; ADD ACCB TO FPA0 BRA LBD31 ; GET ANOTHER CHARACTER FROM BASIC LBD99: JSR LBC2F ; PACK FPA0 AND SAVE IT IN FPA3 JSR LBC7C ; CONVERT ACCB TO FP NUMBER IN FPA0 LDX #V40 ; * ADD FPA0 TO JMP LB9C2 ; * FPA3 LBDA5: LDB V47 ASLB ; TIMES 2 ASLB ; TIMES 4 ADDB V47 ; ADD 1 = TIMES 5 ASLB ; TIMES 10 SUBA #'0' ; *MASK OFF ASCII FROM ACCA, PUSH PSHS B ; *RESULT ONTO THE STACK AND ADDA ,S+ ; ADD lT TO ACCB STA V47 ; SAVE IN V47 BRA LBD55 ; INTERPRET ANOTHER CHARACTER * LBDB6: FCB $9B,$3E,$BC,$1F,$FD ;* 99999999.9 LBDBB: FCB $9E,$6E,$6B,$27,$FD ;* 999999999 LBDC0: FCB $9E,$6E,$6B,$28,$00 ;* 1E + 09 * LBDC5: LDX #LABE8-1 ; POINT X TO " IN " MESSAGE BSR LBDD6 ; COPY A STRING FROM (X) TO CONSOLE OUT LDD CURLIN ; GET CURRENT BASIC LINE NUMBER TO ACCD * CONVERT VALUE IN ACCD INTO A DECIMAL NUMBER * AND PRINT IT TO CONSOLE OUT LBDCC: STD FPA0 ; SAVE ACCD IN TOP HALF OF FPA0 LDB #$90 ; REQ’D EXPONENT IF TOP HALF OF ACCD = INTEGER COMA ; SET CARRY FLAG - FORCE POSITIVE MANTISSA JSR LBC86 ; ZERO BOTTOM HALF AND SIGN OF FPA0, THEN * SAVE EXPONENT AND NORMALIZE IT BSR LBDD9 ; CONVERT FP NUMBER TO ASCII STRING LBDD6: JMP LB99C ; COPY A STRING FROM (X) TO CONSOLE OUT * CONVERT FP NUMBER TO ASCII STRING LBDD9: LDU #STRBUF+3 ; POINT U TO BUFFER WHICH WILL NOT CAUSE * ; THE STRING TO BE STORED IN STRING SPACE LBDDC: LDA #SPACE ; SPACE = DEFAULT SIGN FOR POSITIVE # LDB FP0SGN ; GET SIGN OF FPA0 BPL LBDE4 ; BRANCH IF POSITIVE LDA #'-' ; ASCII MINUS SIGN LBDE4: STA ,U+ ; STORE SIGN OF NUMBER STU COEFPT ; SAVE BUFFER POINTER STA FP0SGN ; SAVE SIGN (IN ASCII) LDA #'0' ; ASCII ZERO IF EXPONENT = 0 LDB FP0EXP ; GET FPA0 EXPONENT LBEQ LBEB8 ; BRANCH IF FPA0 = 0 CLRA ; BASE 10 EXPONENT=0 FOR FP NUMBER > 1 CMPB #$80 ; CHECK EXPONENT BHI LBDFF ; BRANCH IF FP NUMBER > 1 * IF FPA0 < 1.0, MULTIPLY IT BY 1E+09 TO SPEED UP THE CONVERSION PROCESS LDX #LBDC0 ; POINT X TO FP 1E+09 JSR LBACA ; MULTIPLY FPA0 BY (X) LDA #-9 ; BASE 10 EXPONENT = -9 LBDFF: STA V45 ; BASE 10 EXPONENT * PSEUDO - NORMALIZE THE FP NUMBER TO A VALUE IN THE RANGE * OF 999,999,999 RO 99,999,999.9 - THIS IS THE LARGEST * NUMBER RANGE IN WHICH ALL OF THE DIGITS ARE * SIGNIFICANT WHICH CAN BE DISPLAYED WITHOUT USING * SCIENTIFIC NOTATION LBE01: LDX #LBDBB ; POINT X TO FP 999,999,999 JSR LBCA0 ; COMPARE FPA0 TO 999,999,999 BGT LBE18 ; BRANCH IF > 999,999,999 LBE09: LDX #LBDB6 ; POINT X TO FP 99,999,999.9 JSR LBCA0 ; COMPARE FPA0 TO 99,999,999.9 BGT LBE1F ; BRANCH IF > 99,999,999.9 (IN RANGE) JSR LBB6A ; MULTIPLY FPA0 BY 10 DEC V45 ; SUBTRACT ONE FROM DECIMAL OFFSET BRA LBE09 ; PSEUDO - NORMALIZE SOME MORE LBE18: JSR LBB82 ; DIVIDE FPA0 BY 10 INC V45 ; ADD ONE TO BASE 10 EXPONENT BRA LBE01 ; PSEUDO - NORMALIZE SOME MORE LBE1F: JSR LB9B4 ; ADD .5 TO FPA0 (ROUND OFF) JSR LBCC8 ; CONVERT FPA0 TO AN INTEGER LDB #1 ; DEFAULT DECIMAL POINT FLAG (FORCE IMMED DECIMAL PT) LDA V45 ; * GET BASE 10 EXPONENT AND ADD TEN TO IT ADDA #9+1 ; * (NUMBER ‘NORMALIZED’ TO 9 PLACES & DECIMAL PT) BMI LBE36 ; BRANCH IF NUMBER < 1.0 CMPA #9+2 ; NINE PLACES MAY BE DISPLAYED WITHOUT * USING SCIENTIFIC NOTATION BCC LBE36 ; BRANCH IF SCIENTIFIC NOTATION REQUIRED DECA ; * SUBTRACT 1 FROM MODIFIED BASE 10 EXPONENT CTR TFR A,B ; * AND SAVE IT IN ACCB (DECiMAL POINT FLAG) LDA #2 ; FORCE EXPONENT = 0 - DON'T USE SCIENTIFIC NOTATION LBE36: DECA ; * SUBTRACT TWO (WITHOUT AFFECTING CARRY) DECA ; * FROM BASE 10 EXPONENT STA V47 ; SAVE EXPONENT - ZERO EXPONENT = DO NOT DISPLAY * IN SCIENTIFIC NOTATION STB V45 ; DECIMAL POINT FLAG - NUMBER OF PLACES TO * LEFT OF DECIMAL POINT BGT LBE4B ; BRANCH IF >= 1 LDU COEFPT ; POINT U TO THE STRING BUFFER LDA #'.' ; * STORE A PERIOD STA ,U+ ; * IN THE BUFFER TSTB ; CHECK DECIMAL POINT FLAG BEQ LBE4B ; BRANCH IF NOTHING TO LEFT OF DECIMAL POINT LDA #'0' ; * STORE A ZERO STA ,U+ ; * IN THE BUFFER * CONVERT FPA0 INTO A STRING OF ASCII DIGITS LBE4B: LDX #LBEC5 ; POINT X TO FP POWER OF 10 MANTISSA LDB #0+$80 ; INITIALIZE DIGIT COUNTER TO 0+$80 * BIT 7 SET IS USED TO INDICATE THAT THE POWER OF 10 MANTISSA * IS NEGATIVE. WHEN YOU 'ADD' ; A NEGATIVE MANTISSA, IT IS * THE SAME AS SUBTRACTING A POSITIVE ONE AND BIT 7 OF ACCB IS HOW * THE ROUTINE KNOWS THAT A 'SUBTRACTION' IS OCCURING. LBE50: LDA FPA0+3 ; * ADD MANTISSA LS ADDA 3,X ; * BYTE OF FPA0 STA FPA0+3 ; * AND (X) LDA FPA0+2 ; = ADD MANTISSA ADCA 2,X ; = NUMBER 3 BYTE OF STA FPA0+2 ; = FPA0 AND (X) LDA FPA0+1 ; * ADD MANTISSA ADCA 1,X ; * NUMBER 2 BYTE OF STA FPA0+1 ; * FPA0 AND (X) LDA FPA0 ; = ADD MANTISSA ADCA ,X ; = MS BYTE OF STA FPA0 ; = FPA0 AND (X) INCB ; ADD ONE TO DIGIT COUNTER RORB ; ROTATE CARRY INTO BIT 7 ROLB ; *SET OVERFLOW FLAG AND BRANCH IF CARRY = 1 AND BVC LBE50 ; *POSITIVE MANTISSA OR CARRY = 0 AND NEG MANTISSA BCC LBE72 ; BRANCH IF NEGATIVE MANTISSA SUBB #10+1 ; * TAKE THE 9’S COMPLEMENT IF NEGB ; * ADDING MANTISSA LBE72: ADDB #'0'-1 ; ADD ASCII OFFSET TO DIGIT LEAX 4,X ; MOVE TO NEXT POWER OF 10 MANTISSA TFR B,A ; SAVE DIGIT IN ACCA ANDA #$7F ; MASK OFF BIT 7 (ADD/SUBTRACT FLAG) STA ,U+ ; STORE DIGIT IN STRING BUFFER DEC V45 ; DECREMENT DECIMAL POINT FLAG BNE LBE84 ; BRANCH IF NOT TIME FOR DECIMAL POINT LDA #'.' ; * STORE DECIMAL POINT IN STA ,U+ ; * STRING BUFFER LBE84: COMB ; TOGGLE BIT 7 (ADD/SUBTRACT FLAG) ANDB #$80 ; MASK OFF ALL BUT ADD/SUBTRACT FLAG CMPX #LBEC5+36 ; COMPARE X TO END OF MANTISSA TABLE BNE LBE50 ; BRANCH IF NOT AT END OF TABLE * BLANK TRAILING ZEROS AND STORE EXPONENT IF ANY LBE8C: LDA ,-U ; GET THE LAST CHARACTER; MOVE POINTER BACK CMPA #'0' ; WAS IT A ZERO? BEQ LBE8C ; IGNORE TRAILING ZEROS IF SO CMPA #'.' ; CHECK FOR DECIMAL POINT BNE LBE98 ; BRANCH IF NOT DECIMAL POINT LEAU -1,U ; STEP OVER THE DECIMAL POINT LBE98: LDA #'+' ; ASCII PLUS SIGN LDB V47 ; GET SCIENTIFIC NOTATION EXPONENT BEQ LBEBA ; BRANCH IF NOT SCIENTIFIC NOTATION BPL LBEA3 ; BRANCH IF POSITIVE EXPONENT LDA #'-' ; ASCII MINUS SIGN NEGB ; NEGATE EXPONENT IF NEGATIVE LBEA3: STA 2,U ; STORE EXPONENT SIGN IN STRING LDA #'E' ; * GET ASCII ‘E’ (SCIENTIFIC NOTATION STA 1,U ; * FLAG) AND SAVE IT IN THE STRING LDA #'0'-1 ; INITIALIZE ACCA TO ASCII ZERO LBEAB: INCA ; ADD ONE TO 10’S DIGIT OF EXPONENT SUBB #10 ; SUBTRACT 10 FROM ACCB BCC LBEAB ; ADD 1 TO 10’S DIGIT IF NO CARRY ADDB #'9'+1 ; CONVERT UNITS DIGIT TO ASCII STD 3,U ; SAVE EXPONENT IN STRING CLR 5,U ; CLEAR LAST BYTE (TERMINATOR) BRA LBEBC ; GO RESET POINTER LBEB8: STA ,U ; STORE LAST CHARACTER LBEBA: CLR 1,U ; CLEAR LAST BYTE (TERMINATOR - REQUIRED BY * PRINT SUBROUTINES) LBEBC: LDX #STRBUF+3 ; RESET POINTER TO START OF BUFFER RTS * LBEC0: FCB $80,$00,$00,$00,$00 ; FLOATING POINT .5 * *** TABLE OF UNNORMALIZED POWERS OF 10 LBEC5: FCB $FA,$0A,$1F,$00 ;-100000000 LBEC9: FCB $00,$98,$96,$80 ;10000000 LBECD: FCB $FF,$F0,$BD,$C0 ;-1000000 LBED1: FCB $00,$01,$86,$A0 ;100000 LBED5: FCB $FF,$FF,$D8,$F0 ;-10000 LBED9: FCB $00,$00,$03,$E8 ;1000 LBEDD: FCB $FF,$FF,$FF,$9C ;-100 LBEE1: FCB $00,$00,$00,$0A ;10 LBEE5: FCB $FF,$FF,$FF,$FF ;-1 * * LBEE9: LDA FP0EXP ; GET EXPONENT OF FPA0 BEQ LBEEF ; BRANCH IF FPA0 = 0 COM FP0SGN ; TOGGLE MANTISSA SIGN OF FPA0 LBEEF: RTS * EXPAND A POLYNOMIAL OF THE FORM * AQ+BQ**3+CQ**5+DQ**7.... WHERE Q = FPA0 * AND THE X REGISTER POINTS TO A TABLE OF * COEFFICIENTS A,B,C,D.... LBEF0: STX COEFPT ; SAVE COEFFICIENT TABLE POINTER JSR LBC2F ; MOVE FPA0 TO FPA3 BSR LBEFC ; MULTIPLY FPA3 BY FPA0 BSR LBF01 ; EXPAND POLYNOMIAL LDX #V40 ; POINT X TO FPA3 LBEFC: JMP LBACA ; MULTIPLY (X) BY FPA0 * CALCULATE THE VALUE OF AN EXPANDED POLYNOMIAL * EXPRESSION. ENTER WITH (X) POINTING TO A TABLE * OF COEFFICIENTS, THE FIRST BYTE OF WHICH IS THE * NUMBER OF (COEFFICIENTS-1) FOLLOWED BY THAT NUMBER * OF PACKED FLOATING POINT NUMBERS. THE * POLYNOMIAL IS EVALUATED AS FOLLOWS: VALUE = * (((FPA0*Y0+Y1)*FPA0+Y2)*FPA0…YN) LBEFF: STX COEFPT ; SAVE COEFFICIENT TABLE POINTER LBF01: JSR LBC2A ; MOVE FPA0 TO FPA4 LDX COEFPT ; GET THE COEFFICIENT POINTER LDB ,X+ ; GET THE TOP OF COEFFICIENT TABLE TO STB COEFCT ; * USE AND STORE IT IN TEMPORARY COUNTER STX COEFPT ; SAVE NEW COEFFICIENT POINTER LBF0C: BSR LBEFC ; MULTIPLY (X) BY FPA0 LDX COEFPT ; *GET COEFFICIENT POINTER LEAX 5,X ; *MOVE TO NEXT FP NUMBER STX COEFPT ; *SAVE NEW COEFFICIENT POINTER JSR LB9C2 ; ADD (X) AND FPA0 LDX #V45 ; POINT (X) TO FPA4 DEC COEFCT ; DECREMENT TEMP COUNTER BNE LBF0C ; BRANCH IF MORE COEFFICIENTS LEFT RTS * RND RND: JSR LBC6D ; TEST FPA0 BMI LBF45 ; BRANCH IF FPA0 = NEGATIVE BEQ LBF3B ; BRANCH IF FPA0 = 0 BSR LBF38 ; CONVERT FPA0 TO AN INTEGER JSR LBC2F ; PACK FPA0 TO FPA3 BSR LBF3B ; GET A RANDOM NUMBER: FPA0 < 1.0 LDX #V40 ; POINT (X) TO FPA3 BSR LBEFC ; MULTIPLY (X) BY FPA0 LDX #LBAC5 ; POINT (X) TO FP VALUE OF 1.0 JSR LB9C2 ; ADD 1.0 TO FPA0 LBF38: JMP INT ; CONVERT FPA0 TO AN INTEGER * CALCULATE A RANDOM NUMBER IN THE RANGE 0.0 < X <= 1.0 LBF3B: LDX RVSEED+1 ; * MOVE VARIABLE STX FPA0 ; * RANDOM NUMBER LDX RVSEED+3 ; * SEED TO STX FPA0+2 ; * FPA0 LBF45: LDX RSEED ; = MOVE FIXED STX FPA1 ; = RANDOM NUMBER LDX RSEED+2 ; = SEED TO STX FPA1+2 ; = MANTISSA OF FPA0 JSR LBAD0 ; MULTIPLY FPA0 X FPA1 LDD VAD ; GET THE TWO LOWEST ORDER PRODUCT BYTES ADDD #$658B ; ADD A CONSTANT STD RVSEED+3 ; SAVE NEW LOW ORDER VARIABLE RANDOM # SEED STD FPA0+2 ; SAVE NEW LOW ORDER BYTES OF FPA0 MANTISSA LDD VAB ; GET 2 MORE LOW ORDER PRODUCT BYTES ADCB #$B0 ; ADD A CONSTANT ADCA #5 ; ADD A CONSTANT STD RVSEED+1 ; SAVE NEW HIGH ORDER VARIABLE RANDOM # SEED STD FPA0 ; SAVE NEW HIGH ORDER FPA0 MANTISSA CLR FP0SGN ; FORCE FPA0 MANTISSA = POSITIVE LDA #$80 ; * SET FPA0 BIASED EXPONENT STA FP0EXP ; * TO 0 1 < FPA0 < 0 LDA FPA2+2 ; GET A BYTE FROM FPA2 (MORE RANDOMNESS) STA FPSBYT ; SAVE AS SUB BYTE JMP LBA1C ; NORMALIZE FPA0 * RSEED: FDB $40E6 ; *CONSTANT RANDOM NUMBER GENERATOR SEED FDB $4DAB ; * * SIN * THE SIN FUNCTION REQUIRES AN ARGUMENT IN RADIANS AND WILL REPEAT ITSELF EVERY * 2*PI RADIANS. THE ARGUMENT IS DIVIDED BY 2*PI AND ONLY THE FRACTIONAL PART IS * RETAINED. SINCE THE ARGUMENT WAS DIVIDED BY 2*P1, THE COEFFICIENTS MUST BE * MULTIPLIED BY THE APPROPRIATE POWER OF 2*PI. * SIN IS EVALUATED USING THE TRIGONOMETRIC IDENTITIES BELOW: * SIN(X)=SIN(PI-X) & -SIN(PI/2-X)=SIN((3*PI)/2+X) SIN: JSR LBC5F ; COPY FPA0 TO FPA1 LDX #LBFBD ; POINT (X) TO 2*PI LDB FP1SGN ; *GET MANTISSA SIGN OF FPA1 JSR LBB89 ; *AND DIVIDE FPA0 BY 2*PI JSR LBC5F ; COPY FPA0 TO FPA1 BSR LBF38 ; CONVERT FPA0 TO AN INTEGER CLR RESSGN ; SET RESULT SIGN = POSITIVE LDA FP1EXP ; *GET EXPONENT OF FPA1 LDB FP0EXP ; *GET EXPONENT OF FPA0 JSR LB9BC ; *SUBTRACT FPA0 FROM FPA1 * NOW FPA0 CONTAINS ONLY THE FRACTIONAL PART OF ARGUMENT/2*PI LDX #LBFC2 ; POINT X TO FP (.25) JSR LB9B9 ; SUBTRACT FPA0 FROM .25 (PI/2) LDA FP0SGN ; GET MANTISSA SIGN OF FPA0 PSHS A ; SAVE IT ON STACK BPL LBFA6 ; BRANCH IF MANTISSA POSITIVE JSR LB9B4 ; ADD .5 (PI) TO FPA0 LDA FP0SGN ; GET SIGN OF FPA0 BMI LBFA9 ; BRANCH IF NEGATIVE COM RELFLG ; COM IF +(3*PI)/2 >= ARGUMENT >+ PI/2 (QUADRANT FLAG) LBFA6: JSR LBEE9 ; TOGGLE MANTISSA SIGN OF FPA0 LBFA9: LDX #LBFC2 ; POINT X TO FP (.25) JSR LB9C2 ; ADD .25 (PI/2) TO FPA0 PULS A ; GET OLD MANTISSA SIGN TSTA ; * BRANCH IF OLD BPL LBFB7 ; * SIGN WAS POSITIVE JSR LBEE9 ; TOGGLE MANTISSA SIGN LBFB7: LDX #LBFC7 ; POINT X TO TABLE OF COEFFICIENTS JMP LBEF0 ; GO CALCULATE POLYNOMIAL VALUE LBFBD: FCB $83,$49,$0F,$DA,$A2 ;6.28318531 (2*PI) LBFC2: FCB $7F,$00,$00,$00,$00 ;.25 LBFC7: FCB 6-1 ; ; SIX COEFFICIENTS LBFC8: FCB $84,$E6,$1A,$2D,$1B ;* -((2*PI)**11)/11! LBFCD: FCB $86,$28,$07,$FB,$F8 ;* ((2*PI)**9)/9! LBFD2: FCB $87,$99,$68,$89,$01 ;* -((2*PI)**7)/7! LBFD7: FCB $87,$23,$35,$DF,$E1 ;* ((2*PI)**5)/5! LBFDC: FCB $86,$A5,$5D,$E7,$28 ;* -((2*PI)**3)/3! LBFE1: FCB $83,$49,$0F,$DA,$A2 ;* ; FCB $A1,$54,$46,$8F,$13 ;ENCODED MICROSOFT STRING ; FCB $8F,$52,$43,$89,$CD ;ENCODED MICROSOFT STRING * EXTENDED BASIC XVEC20: LEAS $02,S ; PURGE RETURN ADDRESS FROM STACK L82BB: ANDCC #$AF ; ENABLE INTERRUPTS JSR LADEB ; CHECK FOR KEYBOARD BREAK LDX CHARAD ; * GET CURRENT BASIC LINE STX TINPTR ; * POINTER AND SAVE IT LDA ,X+ ; GET CURRENT INPUT CHARACTER AND ADVANCE POINTER BEQ L82CF ; BRANCH IF END OF LINE CMPA #':' ; CHECK FOR COLON BEQ L82F1 ; CONTINUE INTERPRETING IF COLON JMP LB277 ; SNYTAX ERROR - COLON ONLY LEGAL LINE SEPARATOR L82CF: LDA ,X++ ; * GET 1ST BYTE OF ADDRESS OF NEXT STA ENDFLG ; * BASIC LINE AND SAVE IT BNE L82D8 ; BRANCH IF NOT END OF PROGRAM JMP LAE15 ; RETURN TO DIRECT MODE - PRINT OK L82D8: LDD ,X+ ; GET LINE NUMBER OF NEXT LINE STD CURLIN ; SAVE LINE NUMBER STX CHARAD ; SAVE ADDRESS NEXT BYTE TO INTERPRET LDA TRCFLG ; TEST THE TRACE FLAG BEQ L82F1 ; BRANCH IF TRACE OFF LDA #$5B ; RIGHT HAND MARKER FOR TRON LINE NUMBER JSR PUTCHR ; OUTPUT A CHARACTER L82F1: JSR GETNCH ; GET A CHARACTER FROM BASIC JSR LADC6 ; LINK BACK TO BASIC’S INTERPRETATION LOOP BRA L82BB ; GO TO MAIN INTERPRETATION LOOP COS: LDX #L83AB ; POINT X TO FP CONSTANT (P1/2) JSR LB9C2 ; ADD FPA0 TO (X) L837E: JMP SIN ; JUMP TO SIN ROUTINE * TAN * THE VALUE OF TAN(X) IS DETERMINED BY THE TRIG IDENTITY TAN(X)=SIN(X)/COS(X) TAN: JSR LBC2F ; PACK FPA0 AND MOVE IT TO FPA3 CLR RELFLG ; RESET QUADRANT FLAG BSR L837E ; CALCULATE SIN OF ARGUMENT LDX #V4A ; POINT X TO FPA5 JSR LBC35 ; PACK FPA0 AND MOVE IT TO FPA5 LDX #V40 ; POINT X TO FPA3 JSR LBC14 ; MOVE FPA3 TO FPA0 CLR FP0SGN ; FORCE FPA0 MANTISSA TO BE POSITIVE LDA RELFLG ; GET THE QUADRANT FLAG - COS NEGATIVE IN QUADS 2,3 BSR L83A6 ; CALCULATE VALUE OF COS(FPA0) TST FP0EXP ; CHECK EXPONENT OF FPA0 LBEQ LBA92 ; ‘OV’ ERROR IF COS(X)=0 LDX #V4A ; POINT X TO FPA5 L83A3: JMP LBB8F ; DIVIDE (X) BY FPA0 - SIN(X)/COS(X) L83A6: PSHS A ; SAVE SIGN FLAG ON STACK JMP LBFA6 ; EXPAND POLYNOMIAL L83AB: FCB $81,$49,$0F,$DA,$A2 ; 1.57079633 (PI/2) * ATN * A 12 TERM TAYLOR SERIES IS USED TO EVALUATE THE * ARCTAN EXPRESSION. TWO DIFFERENT FORMULI ARE USED * TO EVALUATE THE EXPRESSION DEPENDING UPON * WHETHER OR NOT THE ARGUMENT ; SQUARED IS > OR < 1.0 * IF X**2<1 THEN ATN=X-(X**3)/3+(X**5)/5-(X**7)/7……….. * IF X**2>=1 THEN ATN=PI/2-(1/X-1/((X**3)*3)+(1/((X**5)*5)-………) ATN: LDA FP0SGN ; * GET THE SIGN OF THE MANTISSA AND PSHS A ; * SAVE IT ON THE STACK BPL L83B8 ; BRANCH IF POSITIVE MANTISSA BSR L83DC ; CHANGE SIGN OF FPA0 L83B8: LDA FP0EXP ; * GET EXPONENT OF FPA0 AND PSHS A ; * SAVE IT ON THE STACK CMPA #$81 ; IS FPAO < 1.0? BLO L83C5 ; YES LDX #LBAC5 ; POINT X TO FP CONSTANT 1.0 BSR L83A3 ; GET RECIPROCAL OF FPA0 L83C5: LDX #L83E0 ; POINT (X) TO TAYLOR SERIES COEFFICIENTS JSR LBEF0 ; EXPAND POLYNOMIAL PULS A ; GET EXPONENT OF ARGUMENT CMPA #$81 ; WAS ARGUMENT < 1.0? BLO L83D7 ; YES LDX #L83AB ; POINT (X) TO FP NUMBER (PI/2) JSR LB9B9 ; SUBTRACT FPA0 FROM (PI/2) L83D7: PULS A ; * GET SIGN OF INITIAL ARGUMENT MANTISSA TSTA ; * AND SET FLAGS ACCORDING TO IT BPL L83DF ; RETURN IF ARGUMENT WAS POSITIVE L83DC: JMP LBEE9 ; CHANGE MANTISSA SIGN OF FPA0 L83DF: RTS * * TCHEBYSHEV MODIFIED TAYLOR SERIES COEFFICIENTS FOR ARCTANGENT L83E0: FCB $0B ; TWELVE COEFFICIENTS L83E1: FCB $76,$B3,$83,$BD,$D3 ; -6.84793912E-04 1/23 L83E6: FCB $79,$1E,$F4,$A6,$F5 ; 4.85094216E-03 1/21 L83EB: FCB $7B,$83,$FC,$B0,$10 ; -0.0161117018 L83F0: FCB $7C,$0C,$1F,$67,$CA ; 0.0342096381 L83F5: FCB $7C,$DE,$53,$CB,$C1 ; -0.0542791328 L83FA: FCB $7D,$14,$64,$70,$4C ; 0.0724571965 L83FF: FCB $7D,$B7,$EA,$51,$7A ; -0.0898023954 L8404: FCB $7D,$63,$30,$88,$7E ; 0.110932413 L8409: FCB $7E,$92,$44,$99,$3A ; -0.142839808 L840E: FCB $7E,$4C,$CC,$91,$C7 ; 0.199999121 L8413: FCB $7F,$AA,$AA,$AA,$13 ; -0.333333316 L8418: FCB $81,$00,$00,$00,$00 ; 1 * *** TCHEBYSHEV MODIFIED TAYLOR SERIES COEFFICIENTS FOR LN(X) * L841D: FCB 3 ; FOUR COEFFICIENTS L841E: FCB $7F,$5E,$56,$CB,$79 ; 0.434255942 L8423: FCB $80,$13,$9B,$0B,$64 ; 0.576584541 L8428: FCB $80,$76,$38,$93,$16 ; 0.961800759 L842D: FCB $82,$38,$AA,$3B,$20 ; 2.88539007 L8432: FCB $80,$35,$04,$F3,$34 ; 1/SQR(2) L8437: FCB $81,$35,$04,$F3,$34 ; SQR(2) L843C: FCB $80,$80,$00,$00,$00 ; -0.5 L8441: FCB $80,$31,$72,$17,$F8 ; LN(2) LOG: JSR LBC6D ; CHECK STATUS OF FPA0 LBLE LB44A ; ‘FC’ ERROR IF NEGATIVE OR ZERO LDX #L8432 ; POINT (X) TO FP NUMBER (1/SQR(2)) LDA FP0EXP ; *GET EXPONENT OF ARGUMENT SUBA #$80 ; *SUBTRACT OFF THE BIAS AND PSHS A ; *SAVE IT ON THE STACK LDA #$80 STA FP0EXP JSR LB9C2 ; ADD FPA0 TO (X) LDX #L8437 ; POINT X TO SQR(2) JSR LBB8F ; DIVIDE SQR(2) BY FPA0 LDX #LBAC5 ; POINT X TO FP VALUE OF 1.00 JSR LB9B9 ; SUBTRACT FPA0 FROM (X) * NOW FPA0 = (1-SQR(2)*X)/(1+SQR(2)*X) WHERE X IS ARGUMENT LDX #L841D ; POINT X TO TABLE OF COEFFICIENTS JSR LBEF0 ; EXPAND POLYNOMIAL LDX #L843C ; POINT X TO FP VALUE OF (-.5) JSR LB9C2 ; ADD FPA0 TO X PULS B ; GET EXPONENT OF ARGUMENT BACK (WITHOUT BIAS) JSR LBD99 ; ADD ACCB TO FPA0 LDX #L8441 ; POINT X TO LN(2) JMP LBACA ; MULTIPLY FPA0 * LN(2) * SQR SQR: JSR LBC5F ; MOVE FPA0 TO FPA1 LDX #LBEC0 ; POINT (X) TO FP NUMBER (.5) JSR LBC14 ; COPY A PACKED NUMBER FROM (X) TO FPA0 * ARITHMETIC OPERATOR FOR EXPONENTIATION JUMPS * HERE. THE FORMULA USED TO EVALUATE EXPONENTIATION * IS A**X=E**(X LN A) = E**(FPA0*LN(FPA1)), E=2.7182818 L8489: BEQ EXP ; DO A NATURAL EXPONENTIATION IF EXPONENT = 0 TSTA ; *CHECK VALUE BEING EXPONENTIATED BNE L8491 ; *AND BRANCH IF IT IS <> 0 JMP LBA3A ; FPA0=0 IF RAISING ZERO TO A POWER L8491: LDX #V4A ; * PACK FPA0 AND SAVE JSR LBC35 ; * IT IN FPA5 (ARGUMENT’S EXPONENT) CLRB ; ACCB=DEFAULT RESULT SIGN FLAG; 0=POSITIVE LDA FP1SGN ; *CHECK THE SIGN OF ARGUMENT BPL L84AC ; *BRANCH IF POSITIVE JSR INT ; CONVERT EXPONENT INTO AN INTEGER LDX #V4A ; POINT X TO FPA5 (ORIGINAL EXPONENT) LDA FP1SGN ; GET MANTISSA SIGN OF FPA1 (ARGUMENT) JSR LBCA0 ; *COMPARE FPA0 TO (X) AND BNE L84AC ; *BRANCH IF NOT EQUAL COMA ; TOGGLE FPA1 MANTISSA SIGN - FORCE POSITIVE LDB CHARAC ; GET LS BYTE OF INTEGER VALUE OF EXPONENT (RESULT SIGN FLAG) L84AC: JSR LBC4C ; COPY FPA1 TO FPA0; ACCA = MANTISSA SIGN PSHS B ; PUT RESULT SIGN FLAG ON THE STACK JSR LOG LDX #V4A ; POINT (X) TO FPA5 JSR LBACA ; MULTIPLY FPA0 BY FPA5 BSR EXP ; CALCULATE E**(FPA0) PULS A ; * GET RESULT SIGN FLAG FROM THE STACK RORA ; * AND BRANCH IF NEGATIVE LBCS LBEE9 ; CHANGE SIGN OF FPA0 MANTISSA RTS * CORRECTION FACTOR FOR EXPONENTIAL FUNCTION L84C4: FCB $81,$38,$AA,$3B,$29 ;1.44269504 ( CF ) * * TCHEBYSHEV MODIFIED TAYLOR SERIES COEFFICIENTS FOR E**X * L84C9: FCB 7 ; EIGHT COEFFICIENTS L84CA FCB $71,$34,$58,$3E,$56 ; 2.14987637E-05: 1/(7!*(CF**7)) L84CF FCB $74,$16,$7E,$B3,$1B ; 1.4352314E-04 : 1/(6!*(CF**6)) L84D4 FCB $77,$2F,$EE,$E3,$85 ; 1.34226348E-03: 1/(5!*(CF**5)) L84D9 FCB $7A,$1D,$84,$1C,$2A ; 9.61401701E-03: 1/(4!*(CF**4)) L84DE: FCB $7C,$63,$59,$58,$0A ; 0.0555051269 L84E3: FCB $7E,$75,$FD,$E7,$C6 ; 0.240226385 L84E8: FCB $80,$31,$72,$18,$10 ; 0.693147186 L84ED: FCB $81,$00,$00,$00,$00 ; 1 * * EXP ( E**X) * THE EXPONENTIAL FUNCTION IS ; EVALUATED BY FIRST MULTIPLYING THE * ARGUMENT BY A CORRECTION FACTOR (CF). AFTER THIS IS DONE, AN * ARGUMENT >= 127 WILL YIELD A ZERO RESULT (NO UNDERFLOW) FOR A * NEGATIVE ARGUMENT OR AN 'OV' (OVERFLOW) ERROR FOR A POSITIVE * ARGUMENT. THE POLYNOMIAL COEFFICIENTS ARE MODIFIED TO REFLECT * THE CF MULTIPLICATION AT THE START OF THE EVALUATION PROCESS. EXP: LDX #L84C4 ; POINT X TO THE CORRECTION FACTOR JSR LBACA ; MULTIPLY FPA0 BY (X) JSR LBC2F ; PACK FPA0 AND STORE IT IN FPA3 LDA FP0EXP ; *GET EXPONENT OF FPA0 AND CMPA #$88 ; *COMPARE TO THE MAXIMUM VALUE BLO L8504 ; BRANCH IF FPA0 < 128 L8501: JMP LBB5C ; SET FPA0 = 0 OR ‘OV’ ERROR L8504: JSR INT ; CONVERT FPA0 TO INTEGER LDA CHARAC ; GET LS BYTE OF INTEGER ADDA #$81 ; * WAS THE ARGUMENT =127, IF SO BEQ L8501 ; * THEN ‘OV’ ERROR; THIS WILL ALSO ADD THE $80 BIAS * * REQUIRED WHEN THE NEW EXPONENT IS CALCULATED BELOW DECA ; DECREMENT ONE FROM THE EXPONENT, BECAUSE $81, NOT $80 WAS USED ABOVE PSHS A ; SAVE EXPONENT OF INTEGER PORTION ON STACK LDX #V40 ; POINT (X) TO FPA3 JSR LB9B9 ; SUBTRACT FPA0 FROM (X) - GET FRACTIONAL PART OF ARGUMENT LDX #L84C9 ; POINT X TO COEFFICIENTS JSR LBEFF ; EVALUATE POLYNOMIAL FOR FRACTIONAL PART CLR RESSGN ; FORCE THE MANTISSA TO BE POSITIVE PULS A ; GET INTEGER EXPONENT FROM STACK JSR LBB48 ; * CALCULATE EXPONENT OF NEW FPA0 BY ADDING THE EXPONENTS OF THE * * INTEGER AND FRACTIONAL PARTS RTS * FIX FIX: JSR LBC6D ; CHECK STATUS OF FPA0 BMI L852C ; BRANCH IF FPA0 = NEGATIVE L8529: JMP INT ; CONVERT FPA0 TO INTEGER L852C: COM FP0SGN ; TOGGLE SIGN OF FPA0 MANTISSA BSR L8529 ; CONVERT FPA0 TO INTEGER JMP LBEE9 ; TOGGLE SIGN OF FPA0 * EDIT EDIT: JSR L89AE ; GET LINE NUMBER FROM BASIC LEAS $02,S ; PURGE RETURN ADDRESS OFF THE STACK L8538: LDA #$01 ; ‘LIST’ FLAG STA VD8 ; SET FLAG TO LIST LINE JSR LAD01 ; GO FIND THE LINE NUMBER IN PROGRAM LBCS LAED2 ; ERROR #7 ‘UNDEFINED LINE #' JSR LB7C2 ; GO UNCRUNCH LINE INTO BUFFER AT LINBUF+1 TFR Y,D ; PUT ABSOLUTE ADDRESS OF END OF LINE TO ACCD SUBD #LINBUF+2 ; SUBTRACT OUT THE START OF LINE STB VD7 ; SAVE LENGTH OF LINE L854D: LDD BINVAL ; GET THE HEX VALUE OF LINE NUMBER JSR LBDCC ; LIST THE LINE NUMBER ON THE SCREEN JSR LB9AC ; PRINT A SPACE LDX #LINBUF+1 ; POINT X TO BUFFER LDB VD8 ; * CHECK TO SEE IF LINE IS TO BE BNE L8581 ; * LISTED TO SCREEN - BRANCH IF IT IS L855C: CLRB ; RESET DIGIT ACCUMULATOR - DEFAULT VALUE L855D: JSR L8687 ; GET KEY STROKE JSR L90AA ; SET CARRY IF NOT NUMERIC BLO L8570 ; BRANCH IF NOT NUMERIC SUBA #'0' ; MASK OFF ASCII PSHS A ; SAVE IT ON STACK LDA #10 ; NUMBER BEING CONVERTED IS BASE 10 MUL ; MULTIPLY ACCUMULATED VALUE BY BASE (10) ADDB ,S+ ; ADD DIGIT TO ACCUMULATED VALUE BRA L855D ; CHECK FOR ANOTHER DIGIT L8570: SUBB #$01 ; * REPEAT PARAMETER IN ACCB; IF IT ADCB #$01 ; *IS 0, THEN MAKE IT ‘1’ CMPA #'A' ; ABORT? BNE L857D ; NO JSR LB958 ; PRINT CARRIAGE RETURN TO SCREEN BRA L8538 ; RESTART EDIT PROCESS - CANCEL ALL CHANGES L857D: CMPA #'L' ; LIST? BNE L858C ; NO L8581: BSR L85B4 ; LIST THE LINE CLR VD8 ; RESET THE LIST FLAG TO ‘NO LIST’ JSR LB958 ; PRINT CARRIAGE RETURN BRA L854D ; GO INTERPRET ANOTHER EDIT COMMAND L858A: LEAS $02,S ; PURGE RETURN ADDRESS OFF OF THE STACK L858C: CMPA #CR ; ENTER KEY? BNE L859D ; NO BSR L85B4 ; ECHO THE LINE TO THE SCREEN L8592: JSR LB958 ; PRINT CARRIAGE RETURN LDX #LINBUF+1 ; * RESET BASIC’S INPUT POINTER STX CHARAD ; * TO THE LINE INPUT BUFFER JMP LACA8 ; GO PUT LINE BACK IN PROGRAM L859D: CMPA #'E' ; EXIT? BEQ L8592 ; YES - SAME AS ENTER EXCEPT NO ECHO CMPA #'Q' ; QUIT? BNE L85AB ; NO JSR LB958 ; PRINT CARRIAGE RETURN TO SCREEN JMP LAC73 ; GO TO COMMAND LEVEL - MAKE NO CHANGES L85AB: BSR L85AF ; INTERPRET THE REMAINING COMMANDS AS SUBROUTINES BRA L855C ; GO INTERPRET ANOTHER EDIT COMMAND L85AF: CMPA #SPACE ; SPACE BAR? BNE L85C3 ; NO L85B3: FCB SKP2 ; SKIP TWO BYTES * DISPLAY THE NEXT ACCB BYTES ; OF THE LINE IN THE BUFFER TO THE SCREEN * L85B4: LDB #LBUFMX-1 ; 250 BYTES MAX IN BUFFER L85B6: LDA ,X ; GET A CHARACTER FROM BUFFER BEQ L85C2 ; EXIT IF IT’S A 0 JSR PUTCHR ; SEND CHAR TO CONSOLE OUT LEAX $01,X ; MOVE POINTER UP ONE DECB ; DECREMENT CHARACTER COUNTER BNE L85B6 ; LOOP IF NOT DONE L85C2: RTS L85C3: CMPA #'D' ; DELETE? BNE L860F ; NO L85C7: TST ,X ; * CHECK FOR END OF LINE BEQ L85C2 ; * AND BRANCH IF SO BSR L85D1 ; REMOVE A CHARACTER DECB ; DECREMENT REPEAT PARAMETER BNE L85C7 ; BRANCH IF NOT DONE RTS * REMOVE ONE CHARACTER FROM BUFFER L85D1: DEC VD7 ; DECREMENT LENGTH OF BUFFER LEAY $-01,X ; POINT Y TO ONE BEFORE CURRENT BUFFER POINTER L85D5: LEAY $01,Y ; INCREMENT TEMPORARY BUFFER POINTER LDA $01,Y ; GET NEXT CHARACTER STA ,Y ; PUT IT IN CURRENT POSITION BNE L85D5 ; BRANCH IF NOT END OF LINE RTS L85DE: CMPA #'I' ; INSERT? BEQ L85F5 ; YES CMPA #'X' ; EXTEND? BEQ L85F3 ; YES CMPA #'H' ; HACK? BNE L8646 ; NO CLR ,X ; TURN CURRENT BUFFER POINTER INTO END OF LINE FLAG TFR X,D ; PUT CURRENT BUFFER POINTER IN ACCD SUBD #LINBUF+2 ; SUBTRACT INITIAL POINTER POSITION STB VD7 ; SAVE NEW BUFFER LENGTH L85F3: BSR L85B4 ; DISPLAY THE LINE ON THE SCREEN L85F5: JSR L8687 ; GET A KEYSTROKE CMPA #CR ; ENTER KEY? BEQ L858A ; YES - INTERPRET ANOTHER COMMAND - PRINT LINE CMPA #ESC ; ESCAPE? BEQ L8625 ; YES - RETURN TO COMMAND LEVEL - DON’T PRINT LINE CMPA #BS ; BACK SPACE? BNE L8626 ; NO CMPX #LINBUF+1 ; COMPARE POINTER TO START OF BUFFER BEQ L85F5 ; DO NOT ALLOW BS IF AT START BSR L8650 ; MOVE POINTER BACK ONE, BS TO SCREEN BSR L85D1 ; REMOVE ONE CHARACTER FROM BUFFER BRA L85F5 ; GET INSERT SUB COMMAND L860F: CMPA #'C' ; CHANGE? BNE L85DE ; NO L8613: TST ,X ; CHECK CURRENT BUFFER CHARACTER BEQ L8625 ; BRANCH IF END OF LINE JSR L8687 ; GET A KEYSTROKE BLO L861E ; BRANCH IF LEGITIMATE KEY BRA L8613 ; TRY AGAIN IF ILLEGAL KEY L861E: STA ,X+ ; INSERT NEW CHARACTER INTO BUFFER BSR L8659 ; SEND NEW CHARACTER TO SCREEN DECB ; DECREMENT REPEAT PARAMETER BNE L8613 ; BRANCH IF NOT DONE L8625: RTS L8626: LDB VD7 ; GET LENGTH OF LINE CMPB #LBUFMX-1 ; COMPARE TO MAXIMUM LENGTH BNE L862E ; BRANCH IF NOT AT MAXIMUM BRA L85F5 ; IGNORE INPUT IF LINE AT MAXIMUM LENGTH L862E: PSHS X ; SAVE CURRENT BUFFER POINTER L8630: TST ,X+ ; * SCAN THE LINE UNTIL END OF BNE L8630 ; * LINE (0) IS FOUND L8634: LDB ,-X ; DECR TEMP LINE POINTER AND GET A CHARACTER STB $01,X ; PUT CHARACTER BACK DOWN ONE SPOT CMPX ,S ; HAVE WE REACHED STARTING POINT? BNE L8634 ; NO - KEEP GOING LEAS $02,S ; PURGE BUFFER POINTER FROM STACK STA ,X+ ; INSERT NEW CHARACTER INTO THE LINE BSR L8659 ; SEND A CHARACTER TO CONSOLE OUT INC VD7 ; ADD ONE TO BUFFER LENGTH BRA L85F5 ; GET INSERT SUB COMMAND L8646: CMPA #BS ; BACKSPACE? BNE L865C ; NO L864A: BSR L8650 ; MOVE POINTER BACK 1, SEND BS TO SCREEN DECB ; DECREMENT REPEAT PARAMETER BNE L864A ; LOOP UNTIL DONE RTS L8650: CMPX #LINBUF+1 ; COMPARE POINTER TO START OF BUFFER BEQ L8625 ; DO NOT ALLOW BS IF AT START LEAX $-01,X ; MOVE POINTER BACK ONE LDA #BS ; BACK SPACE L8659: JMP PUTCHR ; SEND TO CONSOLE OUT L865C: CMPA #'K' ; KILL? BEQ L8665 ; YES SUBA #'S' ; SEARCH? BEQ L8665 ; YES RTS L8665: PSHS A ; SAVE KILL/SEARCH FLAG ON STACK BSR L8687 ; * GET A KEYSTROKE (TARGET CHARACTER) PSHS A ; * AND SAVE IT ON STACK L866B: LDA ,X ; Error 2029 BEQ L8685 ; Error 2029 TST $01,S ; CHECK KILL/SEARCH FLAG BNE L8679 ; BRANCH IF KILL BSR L8659 ; SEND A CHARACTER TO CONSOLE OUT LEAX $01,X ; INCREMENT BUFFER POINTER BRA L867C ; CHECK NEXT INPUT CHARACTER L8679: JSR L85D1 ; REMOVE ONE CHARACTER FROM BUFFER L867C: LDA ,X ; GET CURRENT INPUT CHARACTER CMPA ,S ; COMPARE TO TARGET CHARACTER BNE L866B ; BRANCH IF NO MATCH DECB ; DECREMENT REPEAT PARAMETER BNE L866B ; BRANCH IF NOT DONE L8685: PULS Y,PC ; THE Y PULL WILL CLEAN UP THE STACK FOR THE 2 PSHS A * * GET A KEYSTRKE L8687 JSR LA171 ; CALL CONSOLE IN : DEV NBR=SCREEN CMPA #$7F ; GRAPHIC CHARACTER? BCC L8687 ; YES - GET ANOTHER CHAR CMPA #$5F ; SHIFT UP ARROW (QUIT INSERT) BNE L8694 ; NO LDA #ESC ; REPLACE W/ESCAPE CODE L8694: CMPA #CR ; ENTER KEY BEQ L86A6 ; YES CMPA #ESC ; ESCAPE? BEQ L86A6 ; YES CMPA #BS ; BACKSPACE? BEQ L86A6 ; YES CMPA #SPACE ; SPACE BLO L8687 ; GET ANOTHER CHAR IF CONTROL CHAR ORCC #$01 ; SET CARRY L86A6: RTS * TRON TRON: FCB SKP1LD ; SKIP ONE BYTE AND LDA #$4F * TROFF TROFF: CLRA ; TROFF FLAG STA TRCFLG ; TRON/TROFF FLAG:0=TROFF, <> 0=TRON RTS * POS POS: LDA #0 ; GET DEVICE NUMBER LDB DEVPOS ; GET PRINT POSITION LA5E8: SEX ; CONVERT ACCB TO 2 DIGIT SIGNED INTEGER JMP GIVABF ; CONVERT ACCD TO FLOATING POINT * VARPTR VARPT: JSR LB26A ; SYNTAX CHECK FOR ‘(‘ LDD ARYEND ; GET ADDR OF END OF ARRAYS PSHS B,A ; SAVE IT ON STACK JSR LB357 ; GET VARIABLE DESCRIPTOR JSR LB267 ; SYNTAX CHECK FOR ‘)‘ PULS A,B ; GET END OF ARRAYS ADDR BACK EXG X,D ; SWAP END OF ARRAYS AND VARIABLE DESCRIPTOR CMPX ARYEND ; COMPARE TO NEW END OF ARRAYS BNE L8724 ; ‘FC’ ERROR IF VARIABLE WAS NOT DEFINED PRIOR TO CALLING VARPTR JMP GIVABF ; CONVERT VARIABLE DESCRIPTOR INTO A FP NUMBER L86D6: JSR GETNCH ; GET INPUT CHAR FROM BASIC JSR LB26A ; SYNTAX CHECK FOR ‘(‘ JSR LB357 ; * GET VARIABLE DESCRIPTOR ADDRESS AND PSHS X ; * SAVE IT ON THE STACK LDD $02,X ; POINT ACCD TO START OF OLDSTRING CMPD FRETOP ; COMPARE TO START OF CLEARED SPACE BLS L86EB ; BRANCH IF <= SUBD MEMSIZ ; SUBTRACT OUT TOP OF CLEARED SPACE BLS L86FD ; BRANCH IF STRING IN STRING SPACE L86EB: LDB ,X ; GET LENGTH OF OLDSTRING JSR LB56D ; RESERVE ACCB BYTES IN STRING SPACE PSHS X ; SAVE RESERVED SPACE STRING ADDRESS ON STACK LDX $02,S ; POINT X TO OLDSTRING DESCRIPTOR JSR LB643 ; MOVE OLDSTRING INTO STRING SPACE PULS X,U ; * GET OLDSTRING DESCRIPTOR ADDRESS AND RESERVED STRING STX $02,U ; * ADDRESS AND SAVE RESERVED ADDRESS AS OLDSTRING ADDRESS PSHS U ; SAVE OLDSTRING DESCRIPTOR ADDRESS L86FD: JSR LB738 ; SYNTAX CHECK FOR COMMA AND EVALUATE LENGTH EXPRESSION PSHS B ; SAVE POSITION PARAMETER ON STACK TSTB ; * CHECK POSITION PARAMETER AND BRANCH BEQ L8724 ; * IF START OF STRING LDB #$FF ; DEFAULT REPLACEMENT LENGTH = $FF CMPA #')' ; * CHECK FOR END OF MID$ STATEMENT AND BEQ L870E ; * BRANCH IF AT END OF STATEMENT JSR LB738 ; SYNTAX CHECK FOR COMMA AND EVALUATE LENGTH EXPRESSION L870E: PSHS B ; SAVE LENGTH PARAMETER ON STACK JSR LB267 ; SYNTAX CHECK FOR ‘)‘ LDB #$B3 ; TOKEN FOR = JSR LB26F ; SYNTAX CHECK FOR “=‘ BSR L8748 ; EVALUATE REPLACEMENT STRING TFR X,U ; SAVE REPLACEMENT STRING ADDRESS IN U LDX $02,S ; POINT X TO OLOSTRING DESCRIPTOR ADDRESS LDA ,X ; GET LENGTH OF OLDSTRING SUBA $01,S ; SUBTRACT POSITION PARAMETER BCC L8727 ; INSERT REPLACEMENT STRING INTO OLDSTRING L8724: JMP LB44A ; ‘FC’ ERROR IF POSITION > LENGTH OF OLDSTRING L8727: INCA ; * NOW ACCA = NUMBER OF CHARACTERS TO THE RIGHT * ; * (INCLUSIVE) OF THE POSITION PARAMETER CMPA ,S BCC L872E ; BRANCH IF NEW STRING WILL FIT IN OLDSTRING STA ,S ; IF NOT, USE AS MUCH OF LENGTH PARAMETER AS WILL FIT L872E: LDA $01,S ; GET POSITION PARAMETER EXG A,B ; ACCA=LENGTH OF REPL STRING, ACCB=POSITION PARAMETER LDX $02,X ; POINT X TO OLDSTRING ADDRESS DECB ; * BASIC’S POSITION PARAMETER STARTS AT 1; THIS ROUTINE * ; * WANTS IT TO START AT ZERO ABX ; POINT X TO POSITION IN OLDSTRING WHERE THE REPLACEMENT WILL GO TSTA ; * IF THE LENGTH OF THE REPLACEMENT STRING IS ZERO BEQ L8746 ; * THEN RETURN CMPA ,S BLS L873F ; ADJUSTED LENGTH PARAMETER, THEN BRANCH LDA ,S ; OTHERWISE USE AS MUCH ROOM AS IS AVAILABLE L873F: TFR A,B ; SAVE NUMBER OF BYTES TO MOVE IN ACCB EXG U,X ; SWAP SOURCE AND DESTINATION POINTERS JSR LA59A ; MOVE (B) BYTES FROM (X) TO (U) L8746: PULS A,B,X,PC L8748: JSR LB156 ; EVALUATE EXPRESSION JMP LB654 ; *‘TM’ ERROR IF NUMERIC; RETURN WITH X POINTING * ; *TO STRING, ACCB = LENGTH * STRING STRING: JSR LB26A ; SYNTAX CHECK FOR ‘(’ JSR LB70B ; EVALUATE EXPRESSION; ERROR IF > 255 PSHS B ; SAVE LENGTH OF STRING JSR LB26D ; SYNTAX CHECK FOR COMMA JSR LB156 ; EVALUATE EXPRESSION JSR LB267 ; SYNTAX CHECK FOR ‘)‘ LDA VALTYP ; GET VARIABLE TYPE BNE L8768 ; BRANCH IF STRING JSR LB70E ; CONVERT FPA0 INTO AN INTEGER IN ACCB BRA L876B ; SAVE THE STRING IN STRING SPACE L8768: JSR LB6A4 ; GET FIRST BYTE OF STRING L876B: PSHS B ; SAVE FIRST BYTE OF EXPRESSION LDB $01,S ; GET LENGTH OF STRING JSR LB50F ; RESERVE ACCB BYTES IN STRING SPACE PULS A,B ; GET LENGTH OF STRING AND CHARACTER BEQ L877B ; BRANCH IF NULL STRING L8776: STA ,X+ ; SAVE A CHARACTER IN STRING SPACE DECB ; DECREMENT LENGTH BNE L8776 ; BRANCH IF NOT DONE L877B: JMP LB69B ; PUT STRING DESCRIPTOR ONTO STRING STACK * INSTR INSTR: JSR LB26A ; SYNTAX CHECK FOR ‘(‘ JSR LB156 ; EVALUATE EXPRESSION LDB #$01 ; DEFAULT POSITION = 1 (SEARCH START) PSHS B ; SAVE START LDA VALTYP ; GET VARIABLE TYPE BNE L879C ; BRANCH IF STRING JSR LB70E ; CONVERT FPA0 TO INTEGER IN ACCB STB ,S ; SAVE START SEARCH VALUE BEQ L8724 ; BRANCH IF START SEARCH AT ZERO JSR LB26D ; SYNTAX CHECK FOR COMMA JSR LB156 ; EVALUATE EXPRESSION - SEARCH STRING JSR LB146 ; ‘TM’ ERROR IF NUMERIC L879C: LDX FPA0+2 ; SEARCH STRING DESCRIPTOR ADDRESS PSHS X ; SAVE ON THE STACK JSR LB26D ; SYNTAX CHECK FOR COMMA JSR L8748 ; EVALUATE TARGET STRING EXPRESSION PSHS X,B ; SAVE ADDRESS AND LENGTH ON STACK JSR LB267 ; SYNTAX CHECK FOR ')' LDX $03,S ; * LOAD X WITH SEARCH STRING DESCRIPTOR ADDRESS JSR LB659 ; * AND GET THE LENGTH ANDADDRESS OF SEARCH STRING PSHS B ; SAVE LENGTH ON STACK * * AT THIS POINT THE STACK HAS ; THE FOLLOWING INFORMATION * ON IT: 0,S-SEARCH LENGTH; 1,S-TARGET LENGTH; 2 3,S-TARGET * ADDRESS; 4 5,S-SEARCH DESCRIPTOR ADDRESS; 6,S-SEARCH POSITION CMPB $06,S ; COMPARE LENGTH OF SEARCH STRING TO START BLO L87D9 ; POSITION; RETURN 0 IF LENGTH < START LDA $01,S ; GET LENGTH OF TARGET STRING BEQ L87D6 ; BRANCH IF TARGET STRING = NULL LDB $06,S ; GET START POSITION DECB ; MOVE BACK ONE ABX ; POINT X TO POSITION IN SEARCH STRING WHERE SEARCHING WILL START L87BE: LEAY ,X ; POINT Y TO SEARCH POSITION LDU $02,S ; POINT U TO START OF TARGET LDB $01,S ; LOAD ACCB WITH LENGTH OF TARGET LDA ,S ; LOAD ACCA WITH LENGTH OF SEARCH SUBA $06,S ; SUBTRACT SEARCH POSITION FROM SEARCH LENGTH INCA ; ADD ONE CMPA $01,S ; COMPARE TO TARGET LENGTH BLO L87D9 ; RETURN 0 IF TARGET LENGTH > WHAT’S LEFT OF SEARCH STRING L87CD: LDA ,X+ ; GET A CHARACTER FROM SEARCH STRING CMPA ,U+ ; COMPARE IT TO TARGET STRING BNE L87DF ; BRANCH IF NO MATCH DECB ; DECREMENT TARGET LENGTH BNE L87CD ; CHECK ANOTHER CHARACTER L87D6: LDB $06,S ; GET MATCH POSITION L87D8: FCB SKP1 ; SKIP NEXT BYTE L87D9: CLRB ; MATCH ADDRESS = 0 LEAS $07,S ; CLEAN UP THE STACK JMP LB4F3 ; CONVERT ACCB TO FP NUMBER L87DF: INC $06,S ; INCREMENT SEARCH POSITION LEAX $01,Y ; MOVE X TO NEXT SEARCH POSITION BRA L87BE ; KEEP LOOKING FOR A MATCH * EXTENDED BASIC RVEC19 HOOK CODE XVEC19: CMPA #'&' ; * BNE L8845 ; * RETURN IF NOT HEX OR OCTAL VARIABLE LEAS $02,S ; PURGE RETURN ADDRESS FROM STACK * PROCESS A VARIABLE PRECEEDED BY A ‘&‘ (&H,&O) L87EB: CLR FPA0+2 ; * CLEAR BOTTOM TWO CLR FPA0+3 ; * BYTES OF FPA0 LDX #FPA0+2 ; BYTES 2,3 OF FPA0 = (TEMPORARY ACCUMULATOR) JSR GETNCH ; GET A CHARACTER FROM BASIC CMPA #'O' BEQ L880A ; YES CMPA #'H' BEQ L881F ; YES JSR GETCCH ; GET CURRENT INPUT CHARACTER BRA L880C ; DEFAULT TO OCTAL (&O) L8800: CMPA #'8' LBHI LB277 LDB #$03 ; BASE 8 MULTIPLIER BSR L8834 ; ADD DIGIT TO TEMPORARY ACCUMULATOR * EVALUATE AN &O VARIABLE L880A: JSR GETNCH ; GET A CHARACTER FROM BASIC L880C: BLO L8800 ; BRANCH IF NUMERIC L880E: CLR FPA0 ; * CLEAR 2 HIGH ORDER CLR FPA0+1 ; * BYTES OF FPA0 CLR VALTYP ; SET VARXABLE TYPE TO NUMERIC CLR FPSBYT ; ZERO OUT SUB BYTE OF FPA0 CLR FP0SGN ; ZERO OUT MANTISSA SIGN OF FPA0 LDB #$A0 ; * SET EXPONENT OF FPA0 STB FP0EXP ; * JMP LBA1C ; GO NORMALIZE FPA0 * EVALUATE AN &H VARIABLE L881F: JSR GETNCH ; GET A CHARACTER FROM BASIC BLO L882E ; BRANCH IF NUMERIC JSR LB3A2 ; SET CARRY IF NOT ALPHA BLO L880E ; BRANCH IF NOT ALPHA OR NUMERIC CMPA #'G' ; CHECK FOR LETTERS A-F BCC L880E ; BRANCH IF >= G (ILLEGAL HEX LETTER) SUBA #7 ; SUBTRACT ASCII DIFFERENCE BETWEEN A AND 9 L882E: LDB #$04 ; BASE 16 DIGIT MULTIPLIER = 2**4 BSR L8834 ; ADD DIGIT TO TEMPORARY ACCUMULATOR BRA L881F ; KEEP EVALUATING VARIABLE L8834: ASL $01,X ; * MULTIPLY TEMPORARY ROL ,X ; * ACCUMULATOR BY TWO LBCS LBA92 ; ‘OV' OVERFLOW ERROR DECB ; DECREMENT SHIFT COUNTER BNE L8834 ; MULTIPLY TEMPORARY ACCUMULATOR AGAIN SUBA #'0' ; MASK OFF ASCII ADDA $01,X ; * ADD DIGIT TO TEMPORARY STA $01,X ; * ACCUMULATOR AND SAVE IT L8845: RTS XVEC15: PULS U ; PULL RETURN ADDRESS AND SAVE IN U REGISTER CLR VALTYP ; SET VARIABLE TYPE TO NUMERIC LDX CHARAD ; CURRENT INPUT POINTER TO X JSR GETNCH ; GET CHARACTER FROM BASIC CMPA #'&' ; HEX AND OCTAL VARIABLES ARE PRECEEDED BY & BEQ L87EB ; PROCESS A ‘&‘ VARIABLE CMPA #$B5 ; TOKEN FOR FN BEQ L88B4 ; PROCESS FN CALL CMPA #$FF ; CHECK FOR SECONDARY TOKEN BNE L8862 ; NOT SECONDARY JSR GETNCH ; GET CHARACTER FROM BASIC CMPA #$83 ; TOKEN FOR USR LBEQ L892C ; PROCESS USR CALL L8862: STX CHARAD ; RESTORE BASIC’S INPUT POINTER JMP ,U ; RETURN TO CALLING ROUTINE L8866: LDX CURLIN ; GET CURRENT LINE NUMBER LEAX $01,X ; IN DIRECT MODE? BNE L8845 ; RETURN IF NOT IN DIRECT MODE LDB #2*11 ; ‘ILLEGAL DIRECT STATEMENT’ ERROR L886E: JMP LAC46 ; PROCESS ERROR DEF: LDX [CHARAD] ; GET TWO INPUT CHARS CMPX #$FF83 ; TOKEN FOR USR LBEQ L890F ; BRANCH IF DEF USR BSR L88A1 ; GET DESCRIPTOR ADDRESS FOR FN VARIABLE NAME BSR L8866 ; DON’T ALLOW DEF FN IF IN DIRECT MODE JSR LB26A ; SYNTAX CHECK FOR ‘(‘ LDB #$80 ; * GET THE FLAG TO INDICATE ARRAY VARIABLE SEARCH DISABLE STB ARYDIS ; * AND SAVE IT IN THE ARRAY DISABLE FLAG JSR LB357 ; GET VARIABLE DESCRIPTOR BSR L88B1 ; ‘TM’ ERROR IF STRING JSR LB267 ; SYNTAX CHECK FOR ‘)‘ LDB #$B3 ; TOKEN FOR ‘=‘ JSR LB26F ; DO A SYNTAX CHECK FOR = LDX V4B ; GET THE ADDRESS OF THE FN NAME DESCRIPTOR LDD CHARAD ; * GET THE CURRENT INPUT POINTER ADDRESS AND STD ,X ; * SAVE IT IN FIRST 2 BYTES OF THE DESCRIPTOR LDD VARPTR ; = GET THE DESCRIPTOR ADDRESS OF THE ARGUMENT STD $02,X ; = VARIABLE AND SAVE IT IN THE DESCRIPTOR OF THE FN NAME JMP cmdDATA ; MOVE INPUT POINTER TO END OF LINE OR SUBLINE L88A1: LDB #$B5 ; TOKEN FOR FN JSR LB26F ; DO A SYNTAX CHECK FOR FN LDB #$80 ; * GET THE FLAG TO INDICATE ARRAY VARIABLE SEARCH DISABLE FLAG STB ARYDIS ; * AND SAVE IT IN ARRAY VARIABLE FLAG ORA #$80 ; SET BIT 7 OF CURRENT INPUT CHARACTER TO INDICATE AN FN VARIABLE JSR LB35C ; * GET THE DESCRIPTOR ADDRESS OF THIS STX V4B ; * VARIABLE AND SAVE IT IN V4B L88B1: JMP LB143 ; ‘TM’ ERROR IF STRING VARIABLE * EVALUATE AN FN CALL L88B4: BSR L88A1 ; * GET THE DESCRIPTOR OF THE FN NAME PSHS X ; * VARIABLE AND SAVE IT ON THE STACK JSR LB262 ; SYNTAX CHECK FOR ‘(‘ & EVALUATE EXPR BSR L88B1 ; ‘TM’ ERROR IF STRING VARIABLE PULS U ; POINT U TO FN NAME DESCRIPTOR LDB #2*25 ; ‘UNDEFINED FUNCTION CALL’ ERROR LDX $02,U ; POINT X TO ARGUMENT VARIABLE DESCRIPTOR BEQ L886E ; BRANCH TO ERROR HANDLER LDY CHARAD ; SAVE CURRENT INPUT POINTER IN Y LDU ,U ; * POINT U TO START OF FN FORMULA AND STU CHARAD ; * SAVE IT IN INPUT POINTER LDA $04,X ; = GET FP VALUE OF PSHS A ; = ARGUMENT VARIABLE, CURRENT INPUT LDD ,X ; = POINTER, AND ADDRESS OF START LDU $02,X ; = OF FN FORMULA AND SAVE PSHS U,Y,X,B,A ; = THEM ON THE STACK JSR LBC35 ; PACK FPA0 AND SAVE IT IN (X) L88D9: JSR LB141 ; EVALUATE FN EXPRESSION PULS A,B,X,Y,U ; RESTORE REGISTERS STD ,X ; * GET THE FP STU $02,X ; * VALUE OF THE ARGUMENT PULS A ; * VARIABLE OFF OF THE STA $04,X ; * STACK AND RE-SAVE IT JSR GETCCH ; GET FINAL CHARACTER OF THE FN FORMULA LBNE LB277 ; ‘SYNTAX’ ERROR IF NOT END OF LINE STY CHARAD ; RESTORE INPUT POINTER L88EF: RTS * DEF USR L890F: JSR GETNCH ; SKIP PAST SECOND BYTE OF DEF USR TOKEN BSR L891C ; GET FN NUMBER PSHS X ; SAVE FN EXEC ADDRESS STORAGE LOC BSR L8944 ; CALCULATE EXEC ADDRESS PULS U ; GET FN EXEC ADDRESS STORAGE LOC STX ,U ; SAVE EXEC ADDRESS RTS L891C: CLRB ; DEFAULT TO USR0 IF NO ARGUMENT JSR GETNCH ; GET A CHARACTER FROM BASIC BCC L8927 ; BRANCH IF NOT NUMERIC SUBA #'0' ; MASK OFF ASCII TFR A,B ; SAVE USR NUMBER IN ACCB JSR GETNCH ; GET A CHARACTER FROM BASIC L8927: LDX USRADR ; GET ADDRESS OF STORAGE LOCs FOR USR ADDRESS ASLB ; X2 - 2 BYTES/USR ADDRESS ABX ; ADD OFFSET TO START ADDRESS OF STORAGE LOCs RTS * PROCESS A USR CALL L892C: BSR L891C ; GET STORAGE LOC OF EXEC ADDRESS FOR USR N LDX ,X ; * GET EXEC ADDRESS AND PSHS X ; * PUSH IT ONTO STACK JSR LB262 ; SYNTAX CHECK FOR ‘(‘ & EVALUATE EXPR LDX #FP0EXP ; POINT X TO FPA0 LDA VALTYP ; GET VARIABLE TYPE BEQ L8943 ; BRANCH IF NUMERIC, STRING IF <> 0 JSR LB657 ; GET LENGTH & ADDRESS OF STRING VARIABLE LDX FPA0+2 ; GET POINTER TO STRING DESCRIPTOR LDA VALTYP ; GET VARIABLE TYPE L8943: RTS ; JUMP TO USR ROUTINE (PSHS X ABOVE) L8944: LDB #$B3 ; TOKEN FOR ‘=‘ JSR LB26F ; DO A SYNTAX CHECK FOR = JMP LB73D ; EVALUATE EXPRESSION, RETURN VALUE IN X * DEL DEL: LBEQ LB44A ; FC’ ERROR IF NO ARGUMENT JSR LAF67 ; CONVERT A DECIMAL BASiC NUMBER TO BINARY JSR LAD01 ; FIND RAM ADDRESS OF START OF A BASIC LINE STX VD3 ; SAVE RAM ADDRESS OF STARTING LINE NUMBER JSR GETCCH ; GET CURRENT INPUT CHARACTER BEQ L8990 ; BRANCH IF END OF LINE CMPA #$AC ; TOKEN FOR ‘-' BNE L89BF ; TERMINATE COMMAND IF LINE NUMBER NOT FOLLOWED BY ‘-‘ JSR GETNCH ; GET A CHARACTER FROM BASIC BEQ L898C ; IF END OF LINE, USE DEFAULT ENDING LINE NUMBER BSR L89AE ; * CONVERT ENDING LINE NUMBER TO BINARY BRA L8990 ; * AND SAVE IT IN BINVAL L898C: LDA #$FF ; = USE $FFXX AS DEFAULT ENDING STA BINVAL ; = LINE NUMBER - SAVE IT IN BINVAL L8990: LDU VD3 ; POINT U TO STARTING LINE NUMBER ADDRESS L8992: FCB SKP2 ; SKIP TWO BYTES L8993: LDU ,U ; POINT U TO START OF NEXT LINE LDD ,U ; CHECK FOR END OF PROGRAM BEQ L899F ; BRANCH IF END OF PROGRAM LDD $02,U ; LOAD ACCD WITH THIS LINE’S NUMBER SUBD BINVAL ; SUBTRACT ENDING LINE NUMBER ADDRESS BLS L8993 ; BRANCH IF = < ENDING LINE NUMBER L899F: LDX VD3 ; GET STARTING LINE NUMBER BSR L89B8 ; MOVE (U) TO (X) UNTIL END OF PROGRAM JSR LAD21 ; RESET BASIC’S INPUT POINTER AND ERASE VARIABLES LDX VD3 ; GET STARTING LINE NUMBER ADDRESS JSR LACF1 ; RECOMPUTE START OF NEXT LINE ADDRESSES JMP LAC73 ; JUMP TO BASIC’S MAIN COMMAND LOOP L89AE: JSR LAF67 ; GO GET LINE NUMBER CONVERTED TO BINARY JMP LA5C7 ; MAKE SURE THERE’S NO MORE ON THIS LINE L89B4: LDA ,U+ ; GET A BYTE FROM (U) STA ,X+ ; MOVE THE BYTE TO (X) L89B8: CMPU VARTAB ; COMPARE TO END OF BASIC BNE L89B4 ; BRANCH IF NOT AT END STX VARTAB ; SAVE (X) AS NEW END OF BASIC L89BF: RTS L89C0: JSR L8866 ; ‘BS’ ERROR IF IN DIRECT MODE JSR GETNCH ; GET A CHAR FROM BASIC L89D2: CMPA #'"' ; CHECK FOR PROMPT STRING BNE L89E1 ; BRANCH IF NO PROMPT STRING JSR LB244 ; STRIP OFF PROMPT STRING & PUT IT ON STRING STACK LDB #';' ; * JSR LB26F ; * DO A SYNTAX CHECK FOR; JSR LB99F ; REMOVE PROMPT STRING FROM STRING STACK & SEND TO CONSOLE OUT L89E1: LEAS $-02,S ; RESERVE TWO STORAGE SLOTS ON STACK JSR LB035 ; INPUT A LINE FROM CURRENT INPUT DEVICE LEAS $02,S ; CLEAN UP THE STACK JSR LB357 ; SEARCH FOR A VARIABLE STX VARDES ; SAVE POINTER TO VARIABLE DESCRIPTOR JSR LB146 ; ‘TM’ ERROR IF VARIABLE TYPE = NUMERIC LDX #LINBUF ; POINT X TO THE STRING BUFFER WHERE THE INPUT STRING WAS STORED CLRA ; TERMINATOR CHARACTER 0 (END OF LINE) JSR LB51A ; PARSE THE INPUT STRING AND STORE IT IN THE STRING SPACE JMP LAFA4 ; REMOVE DESCRIPTOR FROM STRING STACK L89FC: JSR LAF67 ; STRIP A DECIMAL NUMBER FROM BASIC INPUT LINE LDX BINVAL ; GET BINARY VALUE RTS L8A02: LDX VD1 ; GET CURRENT OLD NUMBER BEING RENUMBERED L8A04: STX BINVAL ; SAVE THE LINE NUMBER BEING SEARCHED FOR JMP LAD01 ; GO FIND THE LINE NUMBER IN BASIC PROGRAM * RENUM RENUM: JSR LAD26 ; ERASE VARIABLES LDD #10 ; DEFAULT LINE NUMBER INTERVAL STD VD5 ; SAVE DEFAULT RENUMBER START LINE NUMBER STD VCF ; SAVE DEFAULT INTERVAL CLRB ; NOW ACCD = 0 STD VD1 ; DEFAULT LINE NUMBER OF WHERE TO START RENUMBERING JSR GETCCH ; GET CURRENT INPUT CHARACTER BCC L8A20 ; BRANCH IF NOT NUMERIC BSR L89FC ; CONVERT DECIMAL NUMBER IN BASIC PROGRAM TO BINARY STX VD5 ; SAVE LINE NUMBER WHERE RENUMBERING STARTS JSR GETCCH ; GET CURRENT INPUT CHARACTER L8A20: BEQ L8A3D ; BRANCH IF END OF LINE JSR LB26D ; SYNTAX CHECK FOR COMMA BCC L8A2D ; BRANCH IF NEXT CHARACTER NOT NUMERIC BSR L89FC ; CONVERT DECIMAL NUMBER IN BASIC PROGRAM TO BINARY STX VD1 ; SAVE NEW RENUMBER LINE JSR GETCCH ; GET CURRENT INPUT CHARACTER L8A2D: BEQ L8A3D ; BRANCH IF END OF LINE JSR LB26D ; SYNTAX CHECK FOR COMMA BCC L8A3A ; BRANCH IF NEXT CHARACTER NOT NUMERIC BSR L89FC ; CONVERT DECIMAL NUMBER IN BASIC PROGRAM TO BINARY STX VCF ; SAVE NEW INTERVAL BEQ L8A83 ; ‘FC' ERROR L8A3A: JSR LA5C7 ; CHECK FOR MORE CHARACTERS ON LINE - ‘SYNTAX’ ERROR IF ANY L8A3D: BSR L8A02 ; GO GET ADDRESS OF OLD NUMBER BEING RENUMBERED STX VD3 ; SAVE ADDRESS LDX VD5 ; GET NEXT RENUMBERED LINE NUMBER TO USE BSR L8A04 ; FIND THE LINE NUMBER IN THE BASIC PROGRAM CMPX VD3 ; COMPARE TO ADDRESS OF OLD LINE NUMBER BLO L8A83 ; ‘FC’ ERROR IF NEW ADDRESS < OLD ADDRESS BSR L8A67 ; MAKE SURE RENUMBERED LINE NUMBERS WILL BE IN RANGE JSR L8ADD ; CONVERT ASCII LINE NUMBERS TO ‘EXPANDED’ BINARY JSR LACEF ; RECALCULATE NEXT LINE RAM ADDRESSES BSR L8A02 ; GET RAM ADDRESS OF FIRST LINE TO BE RENUMBERED STX VD3 ; SAVE IT BSR L8A91 ; MAKE SURE LINE NUMBERS EXIST BSR L8A68 ; INSERT NEW LINE NUMBERS IN LINE HEADERS BSR L8A91 ; INSERT NEW LINE NUMBERS IN PROGRAM STATEMENTS JSR L8B7B ; CONVERT PACKED BINARY LINE NUMBERS TO ASCII JSR LAD26 ; ERASE VARIABLES JSR LACEF ; RECALCULATE NEXT LINE RAM ADDRESS JMP LAC73 ; GO BACK TO BASIC’S MAIN LOOP L8A67: FCB SKP1LD ; SKIP ONE BYTE - LDA #$4F L8A68: CLRA ; NEW LINE NUMBER FLAG - 0; INSERT NEW LINE NUMBERS STA VD8 ; SAVE NEW LINE NUMBER FLAG; 0 = INSERT NEW NUMBERS LDX VD3 ; GET ADDRESS OF OLD LINE NUMBER BEING RENUMBERED LDD VD5 ; GET THE CURRENT RENUMBERED LINE NUMBER BSR L8A86 ; RETURN IF END OF PROGRAM L8A71: TST VD8 ; CHECK NEW LINE NUMBER FLAG BNE L8A77 ; BRANCH IF NOT INSERTING NEW LINE NUMBERS STD $02,X ; STORE THE NEW LINE NUMBER IN THE BASIC PROGRAM L8A77: LDX ,X ; POINT X TO THE NEXT LINE IN BASIC BSR L8A86 ; RETURN IF END OF PROGRAM ADDD VCF ; ADD INTERVAL TO CURRENT RENUMBERED LINE NUMBER BLO L8A83 ; ‘FC’ ERROR IF LINE NUMBER > $FFFF CMPA #MAXLIN ; LARGEST LINE NUMBER = $F9FF BLO L8A71 ; BRANCH IF LEGAL LINE NUMBER L8A83: JMP LB44A ; ‘FC’ ERROR IF LINE NUMBER MS BYTE > $F9 * TEST THE TWO BYTES POINTED TO BY (X). * NORMAL RETURN IF <> 0. IF = ; 0 (END OF * PROGRAM) RETURN IS PULLED OFF STACK AND * YOU RETURN TO PREVIOUS SUBROUTINE CALL. L8A86: PSHS B,A ; SAVE ACCD LDD ,X ; TEST THE 2 BYTES POINTED TO BY X PULS A,B ; RESTORE ACCD BNE L8A90 ; BRANCH IF NOT END OF PROGRAM LEAS $02,S ; PURGE RETURN ADDRESS FROM STACK L8A90: RTS L8A91: LDX TXTTAB ; GET START OF BASIC PROGRAM LEAX $-01,X ; MOVE POINTER BACK ONE L8A95: LEAX $01,X ; MOVE POINTER UP ONE BSR L8A86 ; RETURN IF END OF PROGRAM L8A99: LEAX $03,X ; SKIP OVER NEXT LINE ADDRESS AND LINE NUMBER L8A9B: LEAX $01,X ; MOVE POINTER TO NEXT CHARACTER LDA ,X ; CHECK CURRENT CHARACTER BEQ L8A95 ; BRANCH IF END OF LINE STX TEMPTR ; SAVE CURRENT POINTER DECA ; = BEQ L8AB2 ; =BRANCH IF START OF PACKED NUMERIC LINE DECA ; * BEQ L8AD3 ; *BRANCH IF LINE NUMBER EXISTS DECA ; = BNE L8A9B ; =MOVE TO NEXT CHARACTER IF > 3 L8AAC: LDA #$03 ; * SET 1ST BYTE = 3 TO INDICATE LINE STA ,X+ ; * NUMBER DOESN’T CURRENTLY EXIST BRA L8A99 ; GO GET ANOTHER CHARACTER L8AB2: LDD $01,X ; GET MS BYTE OF LINE NUMBER DEC $02,X ; DECREMENT ZERO CHECK BYTE BEQ L8AB9 ; BRANCH IF MS BYTE <> 0 CLRA ; CLEAR MS BYTE L8AB9: LDB $03,X ; GET LS BYTE OF LINE NUMBER DEC $04,X ; DECREMENT ZERO CHECK FLAG BEQ L8AC0 ; BRANCH IF IS BYTE <> 0 CLRB ; CLEAR LS BYTE L8AC0: STD $01,X ; SAVE BINARY LINE NUMBER STD BINVAL ; SAVE TRIAL LINE NUMBER JSR LAD01 ; FIND RAM ADDRESS OF A BASIC LINE NUMBER L8AC7: LDX TEMPTR ; GET BACK POINTER TO START OF PACKED LINE NUMBER BLO L8AAC ; BRANCH IF NO LINE NUMBER MATCH FOUND LDD V47 ; GET START ADDRESS OF LINE NUMBER INC ,X+ ; * SET 1ST BYTE = 2, TO INDICATE LINE NUMBER EXISTS IF CHECKING FOR * * EXISTENCE OF ; LINE NUMBER, SET IT = 1 IF INSERTING LINE NUMBERS STD ,X ; SAVE RAM ADDRESS OF CORRECT LINE NUMBER BRA L8A99 ; GO GET ANOTHER CHARACTER L8AD3: CLR ,X ; CLEAR CARRY FLAG AND 1ST BYTE LDX $01,X ; POINT X TO RAM ADDRESS OF CORRECT LINE NUMBER LDX $02,X ; PUT CORRECT LINE NUMBER INTO (X) STX V47 ; SAVE IT TEMPORARILY BRA L8AC7 ; GO INSERT IT INTO BASIC LINE L8ADD: LDX TXTTAB ; GET BEGINNING OF BASIC PROGRAM BRA L8AE5 L8AE1: LDX CHARAD ; *GET CURRENT INPUT POINTER LEAX $01,X ; *AND BUMP IT ONE L8AE5: BSR L8A86 ; RETURN IF END OF PROGRAM LEAX $02,X ; SKIP PAST NEXT LINE ADDRESS L8AE9: LEAX $01,X ; ADVANCE POINTER BY ONE L8AEB: STX CHARAD ; SAVE NEW BASIC INPUT POINTER L8AED: JSR GETNCH ; GET NEXT CHARACTER FROM BASIC L8AEF: TSTA ; CHECK THE CHARACTER BEQ L8AE1 ; BRANCH IF END OF LINE BPL L8AED ; BRANCH IF NOT A TOKEN LDX CHARAD ; GET CURRENT INPUT POINTER CMPA #$FF ; IS THIS A SECONDARY TOKEN? BEQ L8AE9 ; YES - IGNORE IT JSR RVEC22 ; HOOK INTO RAM AND CHECK FOR USER ADDED TOKENS CMPA #$A7 ; TOKEN FOR THEN? BEQ L8B13 ; YES CMPA #$84 ; TOKEN FOR ELSE? BEQ L8B13 ; YES CMPA #$81 ; TOKEN FOR GO? BNE L8AED ; NO JSR GETNCH ; GET A CHARACTER FROM BASIC CMPA #$A5 ; TOKEN FOR TO? BEQ L8B13 ; YES CMPA #$A6 ; TOKEN FOR SUB? BNE L8AEB ; NO L8B13: JSR GETNCH ; GET A CHARACTER FROM BASIC BLO L8B1B ; BRANCH IF NUMERIC L8B17: JSR GETCCH ; GET CURRENT BASIC INPUT CHARRACTER BRA L8AEF ; KEEP CHECKING THE LINE L8B1B: LDX CHARAD ; GET CURRENT INPUT ADDRESS PSHS X ; SAVE IT ON THE STACK JSR LAF67 ; CONVERT DECIMAL BASIC NUMBER TO BINARY LDX CHARAD ; GET CURRENT INPUT POINTER L8B24: LDA ,-X ; GET PREVIOUS INPUT CHARACTER JSR L90AA ; CLEAR CARRY IF NUMERIC INPUT VALUE BLO L8B24 ; BRANCH IF NON-NUMERIC LEAX $01,X ; MOVE POINTER UP ONE TFR X,D ; NOW ACCD POINTS TO ONE PAST END OF LINE NUMBER SUBB $01,S ; SUBTRACT PRE-NUMERIC POINTER LS BYTE SUBB #$05 ; MAKE SURE THERE ARE AT LEAST 5 CHARACTERS IN THE NUMERIC LINE * BEQ L8B55 ; BRANCH IF EXACTLY 5 BLO L8B41 ; BRANCH IF < 5 LEAU ,X ; TRANSFER X TO U NEGB ; NEGATE B LEAX B,X ; MOVE X BACK B BYTES JSR L89B8 ; *MOVE BYTES FROM (U) TO (X) UNTIL * *U = END OF BASIC; (I) = NEW END OF BASIC BRA L8B55 * FORCE FIVE BYTES OF SPACE FOR THE LINE NUMBER L8B41: STX V47 ; SAVE END OF NUMERIC VALUE LDX VARTAB ; GET END OF BASIC PROGRAM STX V43 ; SAVE IT NEGB ; NEGATE B LEAX B,X ; ADD IT TO END OF NUMERIC POiNTER STX V41 ; SAVE POINTER STX VARTAB ; STORE END OF BASIC PROGRAM JSR LAC1E ; ACCD = TOP OF ARRAYS - CHECK FOR ENOUGH ROOM LDX V45 ; * GET AND SAVE THE STX CHARAD ; * NEW CURRENT INPUT POINTER L8B55: PULS X ; RESTORE POINTER TO START OF NUMERIC VALUE LDA #$01 ; NEW LINE NUMBER FLAG STA ,X ; * SAVE NEW LINE FLAG STA $02,X ; * STA $04,X ; * LDB BINVAL ; GET MS BYTE OF BINARY LINE NUMBER BNE L8B67 ; BRANCH IF IT IS NOT ZERO LDB #$01 ; SAVE A 1 IF BYTE IS 0; OTHERWISE, BASIC WILL * THINK IT IS THE END OF A LINE INC $02,X ; IF 2,X = 2, THEN PREVIOUS BYTE WAS A ZERO L8B67: STB $01,X ; SAVE MS BYTE OF BINARY LINE NUMBER LDB BINVAL+1 ; GET IS BYTE OF BINARY LINE NUMBER BNE L8B71 ; BRANCH IF NOT A ZERO BYTE LDB #$01 ; SAVE A 1 IF BYTE IS A 0 INC $04,X ; IF 4,X = 2, THEN PREVIOUS BYTE WAS A 0 L8B71: STB $03,X ; SAVE LS BYTE OF BINARY LINE NUMBER JSR GETCCH ; GET CURRENT INPUT CHARACTER CMPA #',' ; IS IT A COMMA? BEQ L8B13 ; YES - PROCESS ANOTHER NUMERIC VALUE BRA L8B17 ; NO - GO GET AND PROCESS AN INPUT CHARACTER L8B7B: LDX TXTTAB ; POINT X TO START OF BASIC PROGRAM LEAX $-01,X ; MOVE POINTER BACK ONE L8B7F: LEAX $01,X ; MOVE POINTER UP ONE LDD $02,X ; GET ADDRESS OF NEXT LINE STD CURLIN ; SAVE IT IN CURLIN JSR L8A86 ; RETURN IF END OF PROGRAM LEAX $03,X ; SKIP OVER ADDRESS OF NEXT LINE AND 1ST BYTE OF LINE NUMBER L8B8A: LEAX $01,X ; MOVE POINTER UP ONE L8B8C: LDA ,X ; GET CURRENT CHARACTER BEQ L8B7F ; BRANCH IF END OF LINE DECA ; INPUT CHARACTER = 1? - VALID LINE NUMBER BEQ L8BAE ; YES SUBA #$02 ; INPUT CHARACTER 3? - UL LINE NUMBER BNE L8B8A ; NO PSHS X ; SAVE CURRENT POSITION OF INPUT POINTER LDX #L8BD9-1 ; POINT X TO ‘UL’ MESSAGE JSR LB99C ; PRINT STRING TO THE SCREEN LDX ,S ; GET INPUT POINTER LDD $01,X ; GET THE UNDEFINED LINE NUMBER JSR LBDCC ; CONVERT NUMBER IN ACCD TO DECIMAL AND DISPLAY IT JSR LBDC5 ; PRINT ‘IN XXXX’ XXXX = CURRENT LINE NUMBER JSR LB958 ; SEND A CR TO CONSOLE OUT PULS X ; GET INPUT POINTER BACK L8BAE: PSHS X ; SAVE CURRENT POSITION OF INPUT POINTER LDD $01,X ; LOAD ACCD WITH BINARY VALUE OF LINE NUMBER STD FPA0+2 ; SAVE IN BOTTOM 2 BYTES OF FPA0 JSR L880E ; ADJUST REST OF FPA0 AS AN INTEGER JSR LBDD9 ; CONVERT FPA0 TO ASCII, STORE IN LINE NUMBER PULS U ; LOAD U WITH PREVIOUS ADDRESS OF INPUT POINTER LDB #$05 ; EACH EXPANDED LINE NUMBER USES 5 BYTES L8BBE: LEAX $01,X ; MOVE POINTER FORWARD ONE LDA ,X ; GET AN ASCII BYTE BEQ L8BC9 ; BRANCH IF END OF NUMBER DECB ; DECREMENT BYTE COUNTER STA ,U+ ; STORE ASCII NUMBER IN BASIC LINE BRA L8BBE ; CHECK FOR ANOTHER DIGIT L8BC9: LEAX ,U ; TRANSFER NEW LINE POINTER TO (X) TSTB ; DOES THE NEW LINE NUMBER REQUIRE 5 BYTES? BEQ L8B8C ; YES - GO GET ANOTHER INPUT CHARACTER LEAY ,U ; SAVE NEW LINE POINTER IN Y LEAU B,U ; POINT U TO END OF 5 BYTE PACKED LINE NUMBER BLOCK JSR L89B8 ; MOVE BYTES FROM (U) TO (X) UNTIL END OF PROGRAM LEAX ,Y ; LOAD (X) WITH NEW LINE POINTER BRA L8B8C ; GO GET ANOTHER INPUT CHARACTER L8BD9: FCC "UL " ; UNKNOWN LINE NUMBER MESSAGE FCB 0 HEXDOL: JSR LB740 ; CONVERT FPA0 INTO A POSITIVE 2 BYTE INTEGER LDX #STRBUF+2 ; POINT TO TEMPORARY BUFFER LDB #$04 ; CONVERT 4 NIBBLES L8BE5: PSHS B ; SAVE NIBBLE COUNTER CLRB ; CLEAR CARRY FLAG LDA #$04 ; 4 SHIFTS L8BEA: ASL FPA0+3 ; * SHIFT BOTTOM TWO BYTES OF ROL FPA0+2 ; * FPA0 LEFT ONE BIT (X2) ROLB ; IF OVERFLOW, ACCB <> 0 DECA ; * DECREMENT SHIFT COUNTER AND BNE L8BEA ; * BRANCH IF NOT DONE TSTB ; CHECK FOR OVERFLOW BNE L8BFF ; BRANCH IF OVERFLOW LDA ,S ; * GET NIBBLE COUNTER, DECA ; * DECREMENT IT AND BEQ L8BFF ; * BRANCH IF DONE CMPX #STRBUF+2 ; DO NOT DO A CONVERSION UNTIL A NON-ZERO BEQ L8C0B ; BYTE IS FOUND - LEADING ZERO SUPPRESSION L8BFF: ADDB #'0' ; ADD IN ASCII ZERO CMPB #'9' ; COMPARE TO ASCII 9 BLS L8C07 ; BRANCH IF < 9 ADDB #7 ; ADD ASCII OFFSET IF HEX LETTER L8C07: STB ,X+ ; STORE HEX VALUE AND ADVANCE POINTER CLR ,X ; CLEAR NEXT BYTE - END OF STRING FLAG L8C0B: PULS B ; * GET NIBBLE COUNTER, DECB ; * DECREMENT IT AND BNE L8BE5 ; * BRANCH IF NOT DONE LEAS $02,S ; PURGE RETURN ADDRESS OFF OF STACK LDX #STRBUF+1 ; RESET POINTER JMP LB518 ; SAVE STRING ON STRING STACK * PROCESS EXCLAMATION POINT L8E37: LDA #$01 ; * SET SPACES STA VD9 ; * COUNTER = 1 * PROCESS STRING ITEM - LIST L8E3B: DECB ; DECREMENT FORMAT STRING LENGTH COUNTER JSR L8FD8 ; SEND A '+' TO CONSOLE OUT IF VDA <>0 JSR GETCCH ; GET CURRENT INPUT CHARACTER LBEQ L8ED8 ; EXIT PRINT USING IF END OF LINE STB VD3 ; SAVE REMAINDER FORMAT STRING LENGTH JSR LB156 ; EVALUATE EXPRESSION JSR LB146 ; ‘TM’ ERROR IF NUMERIC VARIABLE LDX FPA0+2 ; * GET ITEM - LIST DESCRIPTOR ADDRESS STX V4D ; * AND SAVE IT IN V4D LDB VD9 ; GET SPACES COUNTER JSR LB6AD ; PUT ACCB BYTES INTO STRING SPACE & PUT DESCRIPTOR ON STRING STACK JSR LB99F ; PRINT THE FORMATTED STRING TO CONSOLE OUT * PAD FORMAT STRING WITH SPACES IF ITEM - LIST STRING < FORMAT STRING LENGTH LDX FPA0+2 ; POINT X TO FORMATTED STRING DESCRIPTOR ADDRESS LDB VD9 ; GET SPACES COUNTER SUBB ,X ; SUBTRACT LENGTH OF FORMATTED STRING L8E5F: DECB ; DECREMENT DIFFERENCE LBMI L8FB3 ; GO INTERPRET ANOTHER ITEM - LIST JSR LB9AC ; PAD FORMAT STRING WITH A SPACE BRA L8E5F ; KEEP PADDING * PERCENT SIGN - PROCESS A %SPACES% COMMAND L8E69: STB VD3 ; * SAVE THE CURRENT FORMAT STRING STX TEMPTR ; * COUNTER AND POINTER LDA #$02 ; INITIAL SPACES COUNTER = 2 STA VD9 ; SAVE IN SPACES COUNTER L8E71: LDA ,X ; GET A CHARACTER FROM FORMAT STRING CMPA #'%' ; COMPARE TO TERMINATOR CHARACTER BEQ L8E3B ; BRANCH IF END OF SPACES COMMAND CMPA #' ' ; BLANK BNE L8E82 ; BRANCH IF ILLEGAL CHARACTER INC VD9 ; ADD ONE TO SPACES COUNTER LEAX $01,X ; MOVE FORMAT POINTER UP ONE DECB ; DECREMENT LENGTH COUNTER BNE L8E71 ; BRANCH IF NOT END OF FORMAT STRING L8E82: LDX TEMPTR ; * RESTORE CURRENT FORMAT STRING COUNTER LDB VD3 ; * AND POINTER TO POSITION BEFORE SPACES COMMAND LDA #'%' ; SEND A ‘%’ TO CONSOLE OUT AS A DEBUGGING AID L8E88: JSR L8FD8 ; SEND A ‘+' TO CONSOLE OUT IF VDA <> 0 JSR PUTCHR ; SEND CHARACTER TO CONSOLE OUT BRA L8EB9 ; GET NEXT CHARACTER IN FORMAT STRING XVEC9: CMPA #$BE ; USING TOKEN BEQ L8E95 ; BRANCH IF PRINT USING RTS L8E95: LEAS $02,S ; PURGE RETURN ADDRESS OFF THE STACK JSR LB158 ; EVALUATE FORMAT STRING JSR LB146 ; ‘TM’ ERROR IF VARIABLE TYPE = NUMERIC LDB #';' ; CHECK FOR ITEM LIST SEPARATOR JSR LB26F ; SYNTAX CHECK FOR ; LDX FPA0+2 ; * GET FORMAT STRING DESCRIPTOR ADDRESS STX VD5 ; * AND SAVE IT IN VD5 BRA L8EAE ; GO PROCESS FORMAT STRING L8EA8: LDA VD7 ; *CHECK NEXT PRINT ITEM FLAG AND BEQ L8EB4 ; *‘FC’ ERROR IF NO FURTHER PRINT ITEMS LDX VD5 ; RESET FORMAT STRING POINTER TO START OF STRING L8EAE: CLR VD7 ; RESET NEXT PRINT ITEM FLAG LDB ,X ; GET LENGTH OF FORMAT STRING BNE L8EB7 ; INTERPRET FORMAT STRING IF LENGTH > 0 L8EB4: JMP LB44A ; ‘FC’ ERROR IF FORMAT STRING = NULL L8EB7: LDX $02,X ; POINT X TO START OF FORMAT STRING * INTERPRET THE FORMAT STRING L8EB9: CLR VDA ; CLEAR THE STATUS BYTE L8EBB: CLR VD9 ; CLEAR LEFT DIGIT COUNTER LDA ,X+ ; GET A CHARACTER FROM FORMAT STRING CMPA #'!' ; EXCLAMATION POINT? LBEQ L8E37 ; YES - STRING TYPE FORMAT CMPA #'#' ; NUMBER SIGN? (DIGIT LOCATOR) BEQ L8F24 ; YES - NUMERIC TYPE FORMAT DECB ; DECREMENT FORMAT STRING LENGTH BNE L8EE2 ; BRANCH IF NOT DONE JSR L8FD8 ; SEND A ‘+‘ TO CONSOLE OUT IF VDA <> 0 JSR PUTCHR ; SEND CHARACTER TO CONSOLE OUT L8ED2: JSR GETCCH ; GET CURRENT CHARACTER FROM BASIC BNE L8EA8 ; BRANCH IF NOT END OF LINE LDA VD7 ; GET NEXT PRINT ITEM FLAG L8ED8: BNE L8EDD ; BRANCH IF MORE PRINT ITEMS JSR LB958 ; SEND A CARRIAGE RETURN TO CONSOLE OUT L8EDD: LDX VD5 ; POINT X TO FORMAT STRING DESCRIPTOR JMP LB659 ; RETURN ADDRESS AND LENGTH OF FORMAT STRING - EXIT PRINT USING L8EE2: CMPA #'+' ; CHECK FOR ‘+‘ (PRE-SIGN FORCE) BNE L8EEF ; NO PLUS JSR L8FD8 ; SEND A ‘+' TO CONSOLE OUT IF VDA <> 0 LDA #$08 ; * LOAD THE STATUS BYTE WITH 8; STA VDA ; * PRE-SIGN FORCE FLAG BRA L8EBB ; INTERPRET THE REST OF THE FORMAT STRING L8EEF: CMPA #'.' ; DECIMAL POINT? BEQ L8F41 ; YES CMPA #'%' ; PERCENT SIGN? LBEQ L8E69 ; YES CMPA ,X ; COMPARE THE PRESENT FORMAT STRING INPUT * CHARACTER TO THE NEXT ONE IN THE STRING L8EFB: BNE L8E88 ; NO MATCH - ILLEGAL CHARACTER * TWO CONSECUTIVE EQUAL CHARACTERS IN FORMAT STRING CMPA #'$' ; DOLLAR SIGN? BEQ L8F1A ; YES - MAKE THE DOLLAR SIGN FLOAT CMPA #'*' ; ASTERISK? BNE L8EFB ; NO - ILLEGAL CHARACTER LDA VDA ; * GRAB THE STATUS BYTE AND BET BIT 5 ORA #$20 ; * TO INDICATE THAT THE OUTPUT WILL STA VDA ; * BE LEFT PADDED WITH ASTERISKS CMPB #2 ; * CHECK TO SEE IF THE $$ ARE THE LAST TWO BLO L8F20 ; * CHARACTERS IN THE FORMAT STRING AND BRANCH IF SO LDA $01,X ; GET THE NEXT CHARACTER AFTER ** CMPA #'$' ; CHECK FOR **$ BNE L8F20 ; CHECK FOR MORE CHARACTERS DECB ; DECREMENT STRING LENGTH COUNTER LEAX $01,X ; MOVE FORMAT STRING POINTER UP ONE INC VD9 ; ADD ONE TO LEFT DIGIT COUNTER - FOR ASTERISK PAD AND * FLOATING DOLLAR SIGN COMBINATION L8F1A: LDA VDA ; * GET THE STATUS BYTE AND SET ORA #$10 ; * BIT 4 TO INDICATE A STA VDA ; * FLOATING DOLLAR SIGN L8F20: LEAX $01,X ; MOVE FORMAT STRING POINTER UP ONE INC VD9 ; ADD ONE TO LEFT DIGIT (FLOATING $ OR ASTERISK PAD) * PROCESS CHARACTERS TO THE LEFT OF THE DECIMAL POINT IN THE FORMAT STRING L8F24: CLR VD8 ; CLEAR THE RIGHT DIGIT COUNTER L8F26: INC VD9 ; ADD ONE TO LEFT DIGIT COUNTER DECB ; DECREMENT FORMAT STRING LENGTH COUNTER BEQ L8F74 ; BRANCH IF END OF FORMAT STRING LDA ,X+ ; GET THE NEXT FORMAT CHARACTER CMPA #'.' ; DECIMAL POINT? BEQ L8F4F ; YES CMPA #'#' ; NUMBER SIGN? BEQ L8F26 ; YES CMPA #',' ; COMMA? BNE L8F5A ; NO LDA VDA ; * GET THE STATUS BYTE ORA #$40 ; * AND SET BIT 6 WHICH IS THE STA VDA ; * COMMA SEPARATOR FLAG BRA L8F26 ; PROCESS MORE CHARACTERS TO LEFT OF DECIMAL POINT * PROCESS DECIMAL POINT IF NO ; DIGITS TO LEFT OF IT L8F41: LDA ,X ; GET NEXT FORMAT CHARACTER CMPA #'#' ; IS IT A NUMBER SIGN? LBNE L8E88 ; NO LDA #1 ; * SET THE RIGHT DIGIT COUNTER TO 1 - STA VD8 ; * ALLOW ONE SPOT FOR DECIMAL POINT LEAX $01,X ; MOVE FORMAT POINTER UP ONE * PROCESS DIGITS TO RIGHT OF DECIMAL POINT L8F4F: INC VD8 ; ADD ONE TO RIGHT DIGIT COUNTER DECB ; DECREMENT FORMAT LENGTH COUNTER BEQ L8F74 ; BRANCH IF END OF FORMAT STRING LDA ,X+ ; GET A CHARACTER FROM FORMAT STRING CMPA #'#' ; IS IT NUMBER SIGN? BEQ L8F4F ; YES - KEEP CHECKING * CHECK FOR EXPONENTIAL FORCE L8F5A: CMPA #$5E ; CHECK FOR UP ARROW BNE L8F74 ; NO UP ARROW CMPA ,X ; IS THE NEXT CHARACTER AN UP ARROW? BNE L8F74 ; NO CMPA $01,X ; AND THE NEXT CHARACTER? BNE L8F74 ; NO CMPA $02,X ; HOW ABOUT THE 4TH CHARACTER? BNE L8F74 ; NO, ALSO CMPB #4 ; * CHECK TO SEE IF THE 4 UP ARROWS ARE IN THE BLO L8F74 ; * FORMAT STRING AND BRANCH IF NOT SUBB #4 ; * MOVE POINTER UP 4 AND SUBTRACT LEAX $04,X ; * FOUR FROM LENGTH INC VDA ; INCREMENT STATUS BYTE - EXPONENTIAL FORM * CHECK FOR A PRE OR POST - SIGN FORCE AT END OF FORMAT STRING L8F74: LEAX $-01,X ; MOVE POINTER BACK ONE INC VD9 ; ADD ONE TO LEFT DIGIT COUNTER FOR PRE-SIGN FORCE LDA VDA ; * PRE-SIGN BITA #$08 ; * FORCE AND BNE L8F96 ; * BRANCH IF SET DEC VD9 ; DECREMENT LEFT DIGIT — NO PRE-SIGN FORCE TSTB ; * CHECK LENGTH COUNTER AND BRANCH BEQ L8F96 ; * IF END OF FORMAT STRING LDA ,X ; GET NEXT FORMAT STRING CHARACTER SUBA #'-' ; CHECK FOR MINUS SIGN BEQ L8F8F ; BRANCH IF MINUS SIGN CMPA #$FE ; * WAS CMPA #('+')-('-') BNE L8F96 ; BRANCH IF NO PLUS SIGN LDA #$08 ; GET THE PRE-SIGN FORCE FLAG L8F8F: ORA #$04 ; ‘OR’ IN POST-SIGN FORCE FLAG ORA VDA ; ‘OR’ IN THE STATUS BYTE STA VDA ; SAVE THE STATUS BYTE DECB ; DECREMENT FORMAT STRING LENGTH * EVALUATE NUMERIC ITEM-LIST L8F96: JSR GETCCH ; GET CURRENT CHARACTER LBEQ L8ED8 ; BRANCH IF END OF LINE STB VD3 ; SAVE FORMAT STRING LENGTH WHEN FORMAT EVALUATION ENDED JSR LB141 ; EVALUATE EXPRESSION LDA VD9 ; GET THE LEFT DIGIT COUNTER ADDA VD8 ; ADD IT TO THE RIGHT DIGIT COUNTER CMPA #17 ; * LBHI LB44A ; *‘FC’ ERROR IF MORE THAN 16 DIGITS AND DECIMAL POiNT JSR L8FE5 ; CONVERT ITEM-LIST TO FORMATTED ASCII STRING LEAX $-01,X ; MOVE BUFFER POINTER BACK ONE JSR LB99C ; DISPLAY THE FORMATTED STRING TO CONSOLE OUT L8FB3: CLR VD7 ; RESET NEXT PRINT ITEM FLAG JSR GETCCH ; GET CURRENT INPUT CHARACTER BEQ L8FC6 ; BRANCH IF END OF LINE STA VD7 ; SAVE CURRENT CHARACTER (<>0) IN NEXT PRINT ITEM FLAG CMPA #';' ; * CHECK FOR ; - ITEM-LIST SEPARATOR AND BEQ L8FC4 ; * BRANCH IF SEMICOLON JSR LB26D ; SYNTAX CHECK FOR COMMA BRA L8FC6 ; PROCESS NEXT PRINT ITEM L8FC4: JSR GETNCH ; GET NEXT INPUT CHARACTER L8FC6: LDX VD5 ; GET FORMAT STRING DESCRIPTOR ADDRESS LDB ,X ; GET LENGTH OF FORMAT STRING SUBB VD3 ; SUBTRACT AMOUNT OF FORMAT STRING LEFT AFTER LAST PRINT ITEM LDX $02,X ; *GET FORMAT STRING START ADDRESS AND ADVANCE ABX ; *POINTER TO START OF UNUSED FORMAT STRING LDB VD3 ; * GET AMOUNT OF UNUSED FORMAT STRING LBNE L8EB9 ; * REINTERPRET FORMAT STRING FROM THAT POINT JMP L8ED2 ; REINTERPRET FORMAT STRING FROM THE START IF ENTIRELY * USED ON LAST PRINT ITEM * PRINT A ‘+‘ TO CONSOLE OUT IF THE STATUS BYTE <> 0 L8FD8: PSHS A ; RESTORE ACCA AND RETURN LDA #'+' ; GET ASCII PLUS SIGN TST VDA ; * CHECK THE STATUS BYTE AND BEQ L8FE3 ; * RETURN IF = 0 JSR PUTCHR ; SEND A CHARACTER TO CONSOLE OUT L8FE3: PULS A,PC ; RETURN ACCA AND RETURN * CONVERT ITEM-LIST TO DECIMAL ASCII STRING L8FE5: LDU #STRBUF+4 ; POINT U TO STRING BUFFER LDB #SPACE ; BLANK LDA VDA ; * GET THE STATUS FLAG AND BITA #$08 ; * CHECK FOR A PRE-SIGN FORCE BEQ L8FF2 ; * BRANCH IF NO PRE-SIGN FORCE LDB #'+' ; PLUS SIGN L8FF2: TST FP0SGN ; CHECK THE SIGN OF FPA0 BPL L8FFA ; BRANCH IF POSITIVE CLR FP0SGN ; FORCE FPA0 SIGN TO BE POSITIVE LDB #'-' ; MINUS SIGN L8FFA: STB ,U+ ; SAVE THE SIGN IN BUFFER LDB #'0' ; * PUT A ZERO INTO THE BUFFER STB ,U+ ; * ANDA #$01 LBNE L910D LDX #LBDC0 ; POINT X TO FLOATING POINT 1E + 09 JSR LBCA0 ; COMPARE FPA0 TO (X) BMI L9023 ; BRANCH IF FPA0 < 1E+09 JSR LBDD9 ; CONVERT FP NUMBER TO ASCII STRING L9011: LDA ,X+ ; * ADVANCE POINTER TO END OF BNE L9011 ; * ASCII STRING (ZERO BYTE) L9015: LDA ,-X ; Error 2029 STA $01,X ; Error 2029 CMPX #STRBUF+3 ; Error 2029 BNE L9015 ; Error 2029 LDA #'%' ; * INSERT A % SIGN AT START OF STA ,X ; * STRING - OVERFLOW ERROR RTS L9023: LDA FP0EXP ; Error 2029 STA V47 ; Error 2029 BEQ L902C ; BRANCH IF FPA0 = 0 JSR L91CD ; CONVERT FPA0 TO NUMBER WITH 9 SIGNIFICANT * PLACES TO LEFT ; OF DECIMAL POINT L902C: LDA V47 ; GET BASE 10 EXPONENT OFFSET LBMI L90B3 ; BRANCH IF FPA0 < 100,000,000 NEGA ; * CALCULATE THE NUMBER OF LEADING ZEROES TO INSERT - ADDA VD9 ; * SUBTRACT BASE 10 EXPONENT OFFSET AND 9 (FPA0 HAS SUBA #$09 ; * 9 PLACES TO LEFT OF EXPONENT) FROM LEFT DIGIT COUNTER JSR L90EA ; PUT ACCA ZEROES IN STRING BUFFER JSR L9263 ; INITIALIZE DECIMAL POINT AND COMMA COUNTERS JSR L9202 ; CONVERT FPA0 TO DECIMAL ASCII IN THE STRING BUFFER LDA V47 ; * GET BASE 10 EXPONENT AND PUT THAT MANY JSR L9281 ; * ZEROES IN STRING BUFFER - STOP AT DECIMAL POINT LDA V47 ; WASTED INSTRUCTION - SERVES NO PURPOSE JSR L9249 ; CHECK FOR DECIMAL POINT LDA VD8 ; GET THE RIGHT DIGIT COUNTER BNE L9050 ; BRANCH IF RIGHT DIGlT COUNTER <> 0 LEAU $-01,U ; * MOVE BUFFER POINTER BACK ONE - DELETE * * DECIMAL POINT IF NO RIGHT DIGITS SPECiFIED L9050: DECA ; SUBTRACT ONE (DECIMAL POINT) JSR L90EA ; PUT ACCA ZEROES INTO BUFFER (TRAILING ZEROES) L9054: JSR L9185 ; INSERT ASTERISK PADDING, FLOATING $, AND POST-SIGN TSTA ; WAS THERE A POST-SIGN? BEQ L9060 ; NO CMPB #'*' ; IS THE FIRST CHARACTER AN $? BEQ L9060 ; YES STB ,U+ ; STORE THE POST-SIGN L9060: CLR ,U ; CLEAR THE LAST CHARACTER IN THE BUFFER * * REMOVE ANY EXTRA BLANKS OR ASTERISKS FROM THE * STRING BUFFER TO THE LEFT OF THE DECIMAL POINT LDX #STRBUF+3 ; POINT X TO THE START OF THE BUFFER L9065: LEAX $01,X ; MOVE BUFFER POINTER UP ONE STX TEMPTR ; SAVE BUFFER POINTER IN TEMPTR LDA VARPTR+1 ; * GET ADDRESS OF DECIMAL POINT IN BUFFER, SUBTRACT SUBA TEMPTR+1 ; * CURRENT POSITION AND SUBTRACT LEFT DIGIT COUNTER - SUBA VD9 ; * THE RESULT WILL BE ZERO WHEN TEMPTR+1 IS POINTING * * TO THE FIRST ; DIGIT OF THE FORMAT STRING BEQ L90A9 ; RETURN IF NO DIGITS TO LEFT OF THE DECiMAL POINT LDA ,X ; GET THE CURRENT BUFFER CHARACTER CMPA #SPACE ; SPACE? BEQ L9065 ; YES - ADVANCE POINTER CMPA #'*' ; ASTERISK? BEQ L9065 ; YES - ADVANCE POINTER CLRA ; A ZERO ON THE STACK IS END OF DATA POINTER L907C: PSHS A ; PUSH A CHARACTER ONTO THE STACK LDA ,X+ ; GET NEXT CHARACTER FROM BUFFER CMPA #'-' ; MINUS SIGN? BEQ L907C ; YES CMPA #'+' ; PLUS SIGN? BEQ L907C ; YES CMPA #'$' ; DOLLAR SIGN? BEQ L907C ; YES CMPA #'0' ; ZERO? BNE L909E ; NO - ERROR LDA $01,X ; GET CHARACTER FOLLOWING ZERO BSR L90AA ; CLEAR CARRY IF NUMERIC BLO L909E ; BRANCH IF NOT A NUMERIC CHARACTER - ERROR L9096: PULS A ; * PULL A CHARACTER OFF OF THE STACK STA ,-X ; * AND PUT IT BACK IN THE STRING BUFFER BNE L9096 ; * KEEP GOING UNTIL ZERO FLAG BRA L9065 ; KEEP CLEANING UP THE INPUT BUFFER L909E: PULS A TSTA ; * THE STACK AND EXIT WHEN BNE L909E ; * ZERO FLAG FOUND LDX TEMPTR ; GET THE STRING BUFFER START POINTER LDA #'%' ; * PUT A % SIGN BEFORE THE ERROR POSITION TO STA ,-X ; * INDICATE AN ERROR L90A9: RTS * * CLEAR CARRY IF NUMERIC L90AA: CMPA #'0' ; ASCII ZERO BLO L90B2 ; RETURN IF ACCA < ASCII 0 SUBA #$3A ; * #'9'+1 SUBA #$C6 ; * #-('9'+1) CARRY CLEAR IF NUMERIC L90B2: RTS * * PROCESS AN ITEM-LIST WHICH IS < 100,000,000 L90B3: LDA VD8 ; GET RIGHT DIGIT COUNTER BEQ L90B8 ; BRANCH IF NO FORMATTED DIGITS TO THE RIGHT OF DECIMAL PT DECA ; SUBTRACT ONE FOR DECIMAL POINT L90B8: ADDA V47 ; *ADD THE BASE 10 EXPONENT OFFSET - ACCA CONTAINS THE * *NUMBER OF SHIFTS REQUIRED TO ADJUST FPA0 TO THE SPECIFIED * *NUMBER OF DlGITS TO THE RIGHT OF THE DECIMAL POINT BMI L90BD ; IF ACCA >= 0 THEN NO SHIFTS ARE REQUIRED CLRA ; FORCE SHIFT COUNTER = 0 L90BD: PSHS A ; SAVE INITIAL SHIFT COUNTER ON THE STACK L90BF: BPL L90CB ; EXIT ROUTINE IF POSITIVE PSHS A ; SAVE SHIFT COUNTER ON STACK JSR LBB82 ; DIVIDE FPA0 BY 10 - SHIFT ONE DIGIT TO RIGHT PULS A ; GET SHIFT COUNTER FROM THE STACK INCA ; BUMP SHIFT COUNTER UP BY ONE BRA L90BF ; CHECK FOR FURTHER DIVISION L90CB: LDA V47 ; * GET BASE 10 EXPONENT OFFSET, ADD INITIAL SHIFT COUNTER SUBA ,S+ ; * AND SAVE NEW BASE 10 EXPONENT OFFSET - BECAUSE STA V47 ; * FPA0 WAS SHIFTED ABOVE ADDA #$09 ; * ADD NINE (SIGNIFICANT PLACES) AND BRANCH IF THERE ARE NO BMI L90EE ; * ZEROES TO THE LEFT OF THE DECIMAL POINT IN THIS PRINT ITEM LDA VD9 ; *DETERMINE HOW MANY FILLER ZEROES TO THE LEFT OF THE DECIMAL SUBA #$09 ; *POINT. GET THE NUMBER OF FORMAT PLACES TO LEFT OF DECIMAL SUBA V47 ; *POINT, SUBTRACT THE BASE 10 EXPONENT OFFSET AND THE CONSTANT 9 BSR L90EA ; *(UNNORMALIZATION)-THEN OUTPUT THAT MANY ZEROES TO THE BUFFER JSR L9263 ; INITIALIZE DECIMAL POINT AND COMMA COUNTERS BRA L90FF ; PROCESS THE REMAINDER OF THE PRINT ITEM * * PUT (ACCA+1) ASCII ZEROES IN BUFFER L90E2: PSHS A ; SAVE ZERO COUNTER LDA #'0' ; * INSERT A ZERO INTO STA ,U+ ; * THE BUFFER PULS A ; RESTORE ZERO COUNTER * PUT ACCA ASCII ZEROES INTO THE BUFFER L90EA: DECA ; DECREMENT ZERO COUNTER BPL L90E2 ; BRANCH IF NOT DONE RTS L90EE: LDA VD9 ; * GET THE LEFT DIGIT COUNTER AND PUT BSR L90EA ; * THAT MANY ZEROES IN THE STRiNG BUFFER JSR L924D ; PUT THE DECIMAL POINT IN THE STRING BUFFER LDA #-9 ; *DETERMINE HOW MANY FILLER ZEROES BETWEEN THE DECIMAL POINT SUBA V47 ; *AND SIGNIFICANT DATA. SUBTRACT BASE 10 EXPONENT FROM -9 BSR L90EA ; *(UNNORMALIZATION) AND OUTPUT THAT MANY ZEROES TO BUFFER CLR V45 ; CLEAR THE DECIMAL POINT COUNTER - SUPPRESS THE DECIMAL POINT CLR VD7 ; CLEAR THE COMMA COUNTER - SUPPRESS COMMAS L90FF: JSR L9202 ; DECODE FPA0 INTO A DECIMAL ASCII STRING LDA VD8 ; GET THE RIGHT DIGIT COUNTER BNE L9108 ; BRANCH IF RIGHT DIGIT COUNTER <> 0 LDU VARPTR ; RESET BUFFER PTR TO THE DECIMAL POINT IF NO DIGITS TO RIGHT L9108: ADDA V47 ; *ADD BASE 10 EXPONENT - A POSITIVE ACCA WILL CAUSE THAT MANY * *FILLER ZEROES TO BE OUTPUT ; TO THE RIGHT OF LAST SIGNIFICANT DATA * *SIGNIFICANT DATA LBRA L9050 ; INSERT LEADING ASTERISKS, FLOATING DOLLAR SIGN, ETC * * FORCE THE NUMERIC OUTPUT FORMAT TO BE EXPONENTIAL FORMAT L910D: LDA FP0EXP ; * GET EXPONENT OF FPA0 AND PSHS A ; * SAVE IT ON THE STACK BEQ L9116 ; BRANCH IF FPA0 = 0 JSR L91CD ; *CONVERT FPA0 INTO A NUMBER WITH 9 SIGNIFICANT * *DIGITS TO THE LEFT ; OF THE DECIMAL POINT L9116: LDA VD8 ; GET THE RIGHT DIGIT COUNTER BEQ L911B ; BRANCH IF NO FORMATTED DIGITS TO THE RIGHT DECA ; SUBTRACT ONE FOR THE DECIMAL POINT L911B: ADDA VD9 ; ADD TO THE LEFT DIGIT COUNTER CLR STRBUF+3 ; CLEAR BUFFER BYTE AS TEMPORARY STORAGE LOCATION LDB VDA ; * GET THE STATUS BYTE FOR A ANDB #$04 ; * POST-BYTE FORCE; BRANCH IF BNE L9129 ; * A POST-BYTE FORCE COM STRBUF+3 ; TOGGLE BUFFER BYTE TO -1 IF NO POST-BYTE FORCE L9129: ADDA STRBUF+3 ; SUBTRACT 1 IF NO POST BYTE FORCE SUBA #$09 ; *SUBTRACT 9 (DUE TO THE CONVERSION TO 9 * *SIGNIFICANT DIGITS ; TO LEFT OF DECIMAL POINT) PSHS A ; * SAVE SHIFT COUNTER ON THE STACK - ACCA CONTAINS THE NUMBER * OF SHIFTS REQUIRED TO ADJUST FPA0 FOR THE NUMBER OF * FORMATTED PLACES TO ; THE RIGHT OF THE DECIMAL POINT. L9130: BPL L913C ; NO MORE SHIFTS WHEN ACCA >= 0 PSHS A ; SAVE SHIFT COUNTER JSR LBB82 ; DIVIDE FPA0 BY 10 - SHIFT TO RIGHT ONE PULS A ; RESTORE THE SHIFT COUNTER INCA ; ADD 1 TO SHIFT COUNTER BRA L9130 ; CHECK FOR FURTHER SHIFTING (DIVISION) L913C: LDA ,S ; *GET THE INITIAL VALUE OF THE SHIFT COUNTER BMI L9141 ; *AND BRANCH IF SHIFTING HAS TAKEN PLACE CLRA ; RESET ACCA IF NO SHIFTING HAS TAKEN PLACE L9141: NEGA ; *CALCULATE THE POSITION OF THE DECIMAL POINT BY ADDA VD9 ; *NEGATING SHIFT COUNTER, ADDING THE LEFT DIGIT COUNTER INCA ; *PLUS ONE AND THE POST-BYTE POSlTION, IF USED ADDA STRBUF+3 ; * STA V45 ; SAVE DECIMAL POINT COUNTER CLR VD7 ; CLEAR COMMA COUNTER - NO COMMAS INSERTED JSR L9202 ; CONVERT FPA0 INTO ASCII DECIMAL STRING PULS A ; * GET THE INITIAL VALUE OF SHIFT COUNTER AND JSR L9281 ; * INSERT THAT MANY ZEROES INTO THE BUFFER LDA VD8 ; *GET THE RIGHT DIGIT COUNTER AND BRANCH BNE L915A ; *IF NOT ZERO LEAU $-01,U ; MOVE BUFFER POINTER BACK ONE * CALCULATE VALUE OF EXPONENT ; AND PUT IN STRING BUFFER L915A: LDB ,S+ ; GET ORIGINAL EXPONENT OF FPA0 BEQ L9167 ; BRANCH IF EXPONENT = 0 LDB V47 ; GET BASE 10 EXPONENT ADDB #$09 ; ADD 9 FOR 9 SIGNIFICANT DIGIT CONVERSION SUBB VD9 ; SUBTRACT LEFT DIGIT COUNTER SUBB STRBUF+3 ; ADD ONE TO EXPONENT IF POST-SIGN FORCE L9167: LDA #'+' ; PLUS SIGN TSTB ; TEST EXPONENT BPL L916F ; BRANCH IF POSITIVE EXPONENT LDA #'-' ; MINUS SIGN NEGB ; CONVERT EXPONENT TO POSITIVE NUMBER L916F: STA $01,U ; PUT SIGN OF EXPONENT IN STRING BUFFER LDA #'E' ; * PUT AN ‘E’ (EXPONENTIATION FLAG) IN STA ,U++ ; * BUFFER AND SKIP OVER THE SIGN LDA #$2F ; * WAS LDA #'0'-1 *CONVERT BINARY EXPONENT IN ACCB TO ASCII VALUE IN ACCA L9177: INCA ; ADD ONE TO TENS DIGIT COUNTER SUBB #10 ; *SUBTRACT 10 FROM EXPONENT AND ADD ONE TO TENS BCC L9177 ; * DIGIT IF NO CARRY. TENS DIGIT DONE IF THERE IS A CARRY ADDB #$3A ; WAS ADDB #'9'+1 STD ,U++ ; SAVE EXPONENT IN BUFFER CLR ,U ; CLEAR FINAL BYTE IN BUFFER - PRINT TERMINATOR JMP L9054 ; INSERT ASTERISK PADDING, FLOATING DOLLAR SIGN, ETC. * INSERT ASTERISK PADDING, FLOATING $ AND PRE-SIGN L9185: LDX #STRBUF+4 ; POINT X TO START OF PRINT ITEM BUFFER LDB ,X ; * GET SIGN BYTE OF ITEM-LIST BUFFER PSHS B ; * AND SAVE IT ON THE STACK LDA #SPACE ; DEFAULT PAD WITH BLANKS LDB VDA ; * GET STATUS BYTE AND CHECK FOR BITB #$20 ; * ASTERISK LEFT PADDING PULS B ; GET SIGN BYTE AGAIN BEQ L919E ; BRANCH IF NO PADDING LDA #'*' ; PAD WITH ASTERISK CMPB #SPACE ; WAS THE FIRST BYTE A BLANK (POSITIVE)? BNE L919E ; NO TFR A,B ; TRANSFER PAD CHARACTER TO ACCB L919E: PSHS B ; SAVE FIRST CHARACTER ON STACK L91A0: STA ,X+ ; STORE PAD CHARACTER IN BUFFER LDB ,X ; GET NEXT CHARACTER IN BUFFER BEQ L91B6 ; INSERT A ZERO IF END OF BUFFER CMPB #'E' ; * CHECK FOR AN ‘E’ AND BEQ L91B6 ; * PUT A ZERO BEFORE IT CMPB #'0' ; * REPLACE LEADING ZEROES WITH BEQ L91A0 ; * PAD CHARACTERS CMPB #',' ; * REPLACE LEADING COMMAS BEQ L91A0 ; * WITH PAD CHARACTERS CMPB #'.' ; * CHECK FOR DECIMAL POINT BNE L91BA ; * AND DON’T PUT A ZERO BEFORE IT L91B6: LDA #'0' ; * REPLACE PREVIOUS CHARACTER STA ,-X ; * WITH A ZERO L91BA: LDA VDA ; * GET STATUS BYTE, CHECK BITA #$10 ; * FOR FLOATING $ BEQ L91C4 ; * BRANCH IF NO FLOATING $ LDB #'$' ; * STORE A $ IN STB ,-X ; * BUFFER L91C4: ANDA #$04 ; CHECK PRE-SIGN FLAG PULS B ; GET SIGN CHARACTER BNE L91CC ; RETURN IF POST-SIGN REQUIRED STB ,-X ; STORE FIRST CHARACTER L91CC: RTS * * CONVERT FPA0 INTO A NUMBER OF THE FORM - NNN,NNN,NNN X 10**M. * THE EXPONENT M WILL BE RETURNED IN V47 (BASE 10 EXPONENT). L91CD: PSHS U ; SAVE BUFFER POINTER CLRA ; INITIAL EXPONENT OFFSET = 0 L91D0: STA V47 ; SAVE EXPONENT OFFSET LDB FP0EXP ; GET EXPONENT OF FPA0 CMPB #$80 ; * COMPARE TO EXPONENT OF .5 BHI L91E9 ; * AND BRANCH IF FPA0 > = 1.0 * IF FPA0 < 1.0, MULTIPLY IT BY 1E+09 UNTIL IT IS >= 1 LDX #LBDC0 ; POINT X TO FP NUMBER (1E+09) JSR LBACA ; MULTIPLY FPA0 BY 1E+09 LDA V47 ; GET EXPONENT OFFSET SUBA #$09 ; SUBTRACT 9 (BECAUSE WE MULTIPLIED BY 1E+09 ABOVE) BRA L91D0 ; CHECK TO SEE IF > 1.0 L91E4: JSR LBB82 ; DIVIDE FPA0 BY 10 INC V47 ; INCREMENT EXPONENT OFFSET L91E9: LDX #LBDBB ; POINT X TO FP NUMBER (999,999,999) JSR LBCA0 ; COMPARE FPA0 TO X BGT L91E4 ; BRANCH IF FPA0 > 999,999,999 L91F1: LDX #LBDB6 ; POINT X TO FP NUMBER (99,999,999.9) JSR LBCA0 ; COMPARE FPA0 TO X BGT L9200 ; RETURN IF 999,999,999 > FPA0 > 99,999,999.9 JSR LBB6A ; MULTIPLY FPA0 BY 10 DEC V47 ; DECREMENT EXPONENT OFFSET BRA L91F1 ; KEEP UNNORMALIZING L9200: PULS U,PC ; RESTORE BUFFER POINTER AND RETURN * * CONVERT FPA0 INTO AN INTEGER, THEN DECODE IT * INTO A DECIMAL ASCII STRING ; IN THE BUFFER L9202: PSHS U ; SAVE BUFFER POINTER JSR LB9B4 ; ADD .5 TO FPA0 (ROUND OFF) JSR LBCC8 ; CONVERT FPA0 TO INTEGER FORMAT PULS U ; RESTORE BUFFER POINTER * * CONVERT FPA0 INTO A DECIMAL ; ASCII STRING LDX #LBEC5 ; POINT X TO UNNORMALIZED POWERS OF 10 LDB #$80 ; INITIALIZE DIGIT COUNTER TO 0 + $80. * BIT 7 SET IS USED TO INDICATE THAT THE POWER OF 10 MANTISSA * IS NEGATIVE. WHEN YOU ‘ADD’ ; A NEGATIVE MANTISSA, IT IS * THE SAME AS SUBTRACTING A POSITIVE ONE AND BIT 7 OF ACCB * IS HOW THIS ROUTINE KNOWS THAT A ‘SUBTRACTION’ IS OCCURRING. L9211: BSR L9249 ; CHECK FOR COMMA INSERTION L9213: LDA FPA0+3 ; * ‘ADD’ A POWER OF 10 MANTISSA TO FPA0. ADDA $03,X ; * IF THE MANTISSA IS NEGATIVE, A SUBTRACTION STA FPA0+3 ; * WILL BE WHAT REALLY TAKES PLACE. LDA FPA0+2 ; * ADCA $02,X ; * STA FPA0+2 ; * LDA FPA0+1 ; * ADCA $01,X ; * STA FPA0+1 ; * LDA FPA0 ; * ADCA ,X ; * STA FPA0 ; * INCB ; ADD ONE TO DIGIT COUNTER RORB ; ROTATE CARRY INTO BIT 7 ROLB ; * SET OVERFLOW FLAG - BRANCH IF CARRY SET AND BVC L9213 ; * ADDING MANTISSA OR CARRY CLEAR AND SUBTRACTING MANTISSA BCC L9235 ; BRANCH IF SUBTRACTING MANTISSA SUBB #10+1 ; WAS SUBB #10+1 NEGB ; * IF ADDING MANTISSA L9235: ADDB #$2F ; WAS ADDB #'0'-1 LEAX $04,X ; MOVE TO NEXT POWER OF 10 MANTISSA TFR B,A ; SAVE DIGIT IN ACCA ANDA #$7F ; MASK OFF ADD/SUBTRACT FLAG (BIT 7) STA ,U+ ; STORE DIGIT IN BUFFER COMB ; TOGGLE ADD/SUBTRACT FLAG ANDB #$80 ; MASK OFF EVERYTHING BUT ADD/SUB FLAG CMPX #LBEE9 ; COMPARE TO END OF UNNORMALIZED POWERS OF 10 BNE L9211 ; BRANCH IF NOT DONE CLR ,U ; PUT A ZERO AT END OF INTEGER * DECREMENT DECIMAL POINT COUNTER AND CHECK FOR COMMA INSERTION L9249: DEC V45 ; DECREMENT DECIMAL POINT COUNTER BNE L9256 ; NOT TIME FOR DECIMAL POINT L924D: STU VARPTR ; SAVE BUFFER POINTER-POSITION OF THE DECIMAL POINT LDA #'.' ; * STORE A DECIMAL STA ,U+ ; * POINT IN THE OUTPUT BUFFER CLR VD7 ; * CLEAR COMMA COUNTER - NOW IT WILL TAKE 255 * ; * DECREMENTS BEFORE ANOTHER COMMA WILL BE INSERTED RTS L9256: DEC VD7 ; DECREMENT COMMA COUNTER BNE L9262 ; RETURN IF NOT TIME FOR COMMA LDA #$03 ; * RESET COMMA COUNTER TO 3; THREE STA VD7 ; * DIGITS BETWEEN COMMAS LDA #',' ; * PUT A COMMA INTO STA ,U+ ; * THE BUFFER L9262: RTS * INITIALIZE DECIMAL POINT AND COMMA COUNTERS L9263: LDA V47 ; GET THE BASE 10 EXPONENT OFFSET ADDA #10 ; * ADD 10 (FPA0 WAS ‘NORMALIZED’ TO 9 PLACES LEFT STA V45 ; * OF DECIMAL POINT) - SAVE IN DECIMAL POINT COUNTER INCA ; ADD ONE FOR THE DECIMAL POINT L926A: SUBA #$03 ; * DIVIDE DECIMAL POINT COUNTER BY 3; LEAVE BCC L926A ; * THE REMAINDER IN ACCA ADDA #$05 ; CONVERT REMAINDER INTO A NUMBER FROM 1-3 STA VD7 ; SAVE COMMA COUNTER LDA VDA ; GET STATUS BYTE ANDA #$40 ; CHECK FOR COMMA FLAG BNE L927A ; BRANCH IF COMMA FLAG ACTIVE STA VD7 ; CLEAR COMMA COUNTER - 255 DIGITS OUTPUT BEFORE A COMMA L927A: RTS * * INSERT ACCA ZEROES INTO THE ; BUFFER L927B: PSHS A ; SAVE ZEROES COUNTER BSR L9249 ; CHECK FOR DECIMAL POINT PULS A ; RESTORE ZEROES COUNTER L9281: DECA ; * DECREMENT ZEROES COUNTER AND BMI L928E ; * RETURN IF < 0 PSHS A ; SAVE ZEROES COUNTER LDA #'0' ; * PUT A ZERO INTO STA ,U+ ; * THE BUFFER LDA ,S+ ; RESTORE THE ZEROES COUNTER BNE L927B ; BRANCH IF NOT DONE L928E: RTS * LINE LINE: CMPA #$89 LBEQ L89C0 JMP LB277 ; --------------------------------------------------------------------------------------------------- ; LFD: Code in ROM, CHARAD stay in RAM because receive a pointer GETNCH: INC USTAT BITA #1 ; Test ACIA RxReady BEQ GETKEY ; Loop until byte ready GETKEY2: LDA RECEV ; Get from ACIA RxData ANDCC #$FD ; Set Z=0 RTS ELSE JSR [INCH] ; Ask BIOS for input character ANDCC #$FD ; Set Z=0 RTS ENDIF ; --------------------------------------------------------------------------------------------------- ; THIS ROUTINE GETS A KEYSTROKE FROM THE KEYBOARD IF A KEY ; IS DOWN. IT RETURNS ZERO TRUE IF THERE WAS NO KEY DOWN. ; LA1C1: KEYIN: IF H_ACIA LDA >USTAT ANDA #1 ; Test ACIA RxReady BNE GETKEY2 ; Byte ready, jump to read it RTS ; Nothing, return with A=0, Z=1 ELSE JSR [INCHECK] ; Ask BIOS if input pending BNE GETKEY ; Keypress pending, jump to get it CLRA ; Nothing, return with A=0, Z=1 RTS ENDIF ; --------------------------------------------------------------------------------------------------- ; CHECK IF ESCAPE STATE PENDING ; RETURNS MI (+NZ+CS) IF ESCAPE PRESSED ; RETURNS PL IF ESCAPE NOT PRESSED ; CHKESCAPE: IF H_TUBE LDA $FFFF ; Overwrite with ESCFLG address BPL NOESC ; Exit with PL LDA #126 JSR OSBYTE ; Acknowledge Escape LDA #255 ; Set MI and also NZ ORCC #$01 ; Also set CS ELSE CLRA ENDIF NOESC: RTS ; --------------------------------------------------------------------------------------------------- ; SEND CHARACTER TO CONSOLE OUTPUT ; PUTCHR: CMPA #CR ; Is it carriage return? BEQ NEWLINE ; Yes, jump to do NEWLINE PSHS A IF H_ACIA JSR PUTACIA ELSE JSR [OUTCH] ENDIF INC DEVPOS ; Increment character counter BRA PUTEND PULS A NEWLINE: PSHS A IF H_ACIA LDA #10 JSR PUTACIA LDA #13 JSR PUTACIA ELSE JSR [PCRLF] ENDIF CLR DEVPOS ; Reset character counter PUTEND: PULS A RTS IF H_ACIA PUTACIA: PSHS A ACIAWAIT: LDA USTAT BITA #2 BEQ ACIAWAIT ; Wait for ACIA TxReady PULS A STA TRANS ; Send character to ACIA TxData RTS ENDIF ; --------------------------------------------------------------------------------------------------- ; HOSTINIT - Initialise interface with host system ; On exit, X=address of first byte after user memory ; Y=address of first byte of user memory ; HOSTINIT: IF H_ACIA LDA #3 ; RESET ACIA STA UCTRL LDA #21 ; DIV16 CLOCK -> 7372800 / 4 / 16 = 115200 STA UCTRL ENDIF IF H_TUBE ADCA #0 CMPA #1 BNE HOSTINIT2 LDA #11 ; If entered from Tube on RESET, move cursor JSR [OUTCH] ; upwards to overwrite startup message JSR [OUTCH] HOSTINIT2: JSR OSINIT ; Set up error handler vectors LDD #REPORT STD ,X ; Claim BRKV STY CHKESCAPE+1 ; Save ESCFLG address LDA #$83 ; OSBYTE $83 - bottom of user memory JSR OSBYTE PSHS X LDA #$84 ; OSBYTE $84 - top of user memory JSR OSBYTE ; X=top of user memory PULS Y ; Y=bottom of user memory ELSE ; FIND OUT HOW MUCH USER RAM AVAILABLE LDY #PROGST ; SET TO START OF PROGRAM SPACE TFR Y,X ; START AT BOTTOM OF USER RAM FNDRAMLP: LDA 128,X ; LOOK FOR END COMA ; COMPLEMENT IT AND PUT IT BACK STA 128,X ; INTO SYSTEM MEMORY CMPA 128,X ; IS IT RAM? BNE FNDRAMOK ; BRANCH IF NOT (ROM, BAD RAM OR NO RAM) COM 128,X ; RE-COMPLEMENT TO RESTORE BYTE LEAX 128,X ; MOVE POINTER UP ONE CMPX #CODESTART-256 ; REACHED START OF BASIC? BCS FNDRAMLP ; KEEP LOOKING FOR END OF RAM FNDRAMOK: ENDIF RTS ; --------------------------------------------------------------------------------------------------- ; Catch host errors ; IF H_TUBE REPORT: JMP LAC68 ; Jump to report it ENDIF ; --------------------------------------------------------------------------------------------------- ; HOSTCMD - Pass a command to external system ; On entry, CHARAD=>command string to execute, terminated with <00> ; HOSTCMD: IF H_TUBE LDX CHARAD ; Get program address BSR CONVSTR ; Convert <00>-string to -string STY CHARAD ; Update program address LEAX 1,X ; Step past initial '*' JMP OS_CLI ; Pass command at X to OSCLI ENDIF ; --------------------------------------------------------------------------------------------------- ; HOSTLOAD - Load a file ; On entry, X=>filename string to save, terminated with <00> ; HOSTLOAD: IF H_TUBE LDA #$FF ; A=$FF for LOAD BSR HOSTFILE ; Load to program area LDD V40+10 ; Get length from control block EXG A,B ; Make big-endian LDX TXTTAB ; Start of program data LEAX D,X ; X=X+D, X=>end of program STX VARTAB ; Set end of program address LDX #LABEE-1 ; Print to 'OK' message JSR LB99C ; Print 'OK' JMP LACE9 ; Reset program pointers, clear variables and ; ; return to main program loop ENDIF ; --------------------------------------------------------------------------------------------------- ; HOSTSAVE - Save a file ; On entry, X=>filename string to save, terminated with <00> ; HOSTSAVE: IF H_TUBE CLRA ; A=0 for SAVE ; --------------------------------------------------------------------------------------------------- ; HOSTSAVE - Save a file ; On entry, X=>filename string to save, terminated with <00> ; HOSTFILE: PSHS A BSR CONVSTR ; Convert <00>-string to -string STX V40+0 ; Store pointer to filename in control block LDB #16 LDX #V40+18 HOST_FLP: CLR ,-X ; Clear control block DECB BNE HOST_FLP LDA #$FF JSR OSINIT ; Read endian-ness ASLA ; CC=bigendian, CS=littleendian LDX #V40+2 ; X=>control block high bytes LDD TXTTAB ; Get start of program area LDY VARTAB ; Get end of data BCC HOST_BIG EXG A,B ; Make start little-endian EXG D,Y EXG A,B ; Make end little-endian EXG D,Y LEAX -2,X ; X=>control block low bytes HOST_BIG: STD 2,X ; ctrl+2=load.little // ctrl+4=load.big STD 10,X ; ctrl+10=start.little // ctrl+12=start.big STY 14,X ; ctrl+14=end.little // ctrl+16=end.big LDX #V40 ; X=>control block PULS A ; Get LOAD/SAVE action JMP OSFILE ; Jump to OSFILE to load or save ; --------------------------------------------------------------------------------------------------- ; CONVSTR - Convert a <00>-string to a -string ; On entry, X=><00>-string ; On exit, X=>-string ; Y=>final <00> of source string ; CONVSTR: TFR X,Y ; Y=>source string LDX #LINBUF ; INPUT buffer CONVSTRLP: LDA ,Y+ ; Copy string to INPUT buffer STA ,X+ BNE CONVSTRLP ; Loop until terminating <00> LDA #13 STA ,-X ; Convert to LEAY -1,Y ; Leave Y pointing to <00> LDX #LINBUF ; X=>INPUT buffer holing -string ENDIF RTS ; =================================================================================================== * END OF CODE