UART EQU $A000 RECEV EQU UART+1 TRANS EQU UART+1 USTAT EQU UART UCTRL EQU UART BS EQU 8 BACKSPACE 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 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 RTS_LOW EQU $95 ORG 0 ENDFLG RMB 1 STOP/END FLAG: POSITIVE=STOP, NEG=END CHARAC RMB 1 TERMINATOR FLAG 1 ENDCHR RMB 1 TERMINATOR FLAG 2 TMPLOC RMB 1 SCRATCH VARIABLE IFCTR RMB 1 IF COUNTER - HOW MANY IF STATEMENTS IN A LINE DIMFLG RMB 1 *DV* ARRAY FLAG 0=EVALUATE, 1=DIMENSIONING VALTYP RMB 1 *DV* *PV TYPE FLAG: 0=NUMERIC, $FF=STRING GARBFL RMB 1 *TV STRING SPACE HOUSEKEEPING FLAG ARYDIS RMB 1 DISABLE ARRAY SEARCH: 00=ALLOW SEARCH INPFLG RMB 1 *TV INPUT FLAG: READ=0, INPUT<>0 RELFLG RMB 1 *TV RELATIONAL OPERATOR FLAG TEMPPT RMB 2 *PV TEMPORARY STRING STACK POINTER LASTPT RMB 2 *PV ADDR OF LAST USED STRING STACK ADDRESS TEMPTR RMB 2 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 *PV BEGINNING OF BASIC PROGRAM VARTAB RMB 2 *PV START OF VARIABLES ARYTAB RMB 2 *PV START OF ARRAYS ARYEND RMB 2 *PV END OF ARRAYS (+1) FRETOP RMB 2 *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 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 *PV 'DATA' STATEMENT LINE NUMBER POINTER DATPTR RMB 2 *PV 'DATA' STATEMENT ADDRESS POINTER DATTMP RMB 2 DATA POINTER FOR 'INPUT' & 'READ' VARNAM RMB 2 *TV TEMP STORAGE FOR A VARIABLE NAME VARPTR RMB 2 *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 * FLOATING POINT ACCUMULATORS #3,4 & 5 ARE MOSTLY * USED AS SCRATCH PAD VARIABLES. ** FLOATING POINT ACCUMULATOR #3 :PACKED: ($40-$44) V40 RMB 1 V41 RMB 1 V42 RMB 1 V43 RMB 1 V44 RMB 1 ** FLOATING POINT ACCUMULATOR #4 :PACKED: ($45-$49) V45 RMB 1 V46 RMB 1 V47 RMB 1 V48 RMB 2 ** FLOATING POINT ACCUMULATOR #5 :PACKED: ($4A—$4E) V4A RMB 1 V4B RMB 2 V4D RMB 2 ** FLOATING POINT ACCUMULATOR #0 FP0EXP RMB 1 *PV FLOATING POINT ACCUMULATOR #0 EXPONENT FPA0 RMB 4 *PV FLOATING POINT ACCUMULATOR #0 MANTISSA FP0SGN RMB 1 *PV FLOATING POINT ACCUMULATOR #0 SIGN COEFCT RMB 1 POLYNOMIAL COEFFICIENT COUNTER STRDES RMB 5 TEMPORARY STRING DESCRIPTOR FPCARY RMB 1 FLOATING POINT CARRY BYTE ** FLOATING POINT ACCUMULATOR #1 FP1EXP RMB 1 *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 SIGN OF RESULT OF FLOATING POINT OPERATION FPSBYT RMB 1 FLOATING POINT SUB BYTE (FIFTH BYTE) COEFPT RMB 2 POLYNOMIAL COEFFICIENT POINTER LSTTXT RMB 2 CURRENT LINE POINTER DURING LIST CURLIN RMB 2 *PV CURRENT LINE # OF BASIC PROGRAM, $FFFF = DIRECT DEVCFW RMB 1 *TV TAB FIELD WIDTH DEVLCF RMB 1 *TV TAB ZONE DEVPOS RMB 1 *TV PRINT POSITION DEVWID RMB 1 *TV PRINT WIDTH RSTFLG RMB 1 *PV WARM START FLAG: $55=WARM, OTHER=COLD RSTVEC RMB 2 *PV WARM START VECTOR - JUMP ADDRESS FOR WARM START TOPRAM RMB 2 *PV TOP OF RAM IKEYIM RMB 1 *TV INKEY$ RAM IMAGE ZERO RMB 2 *PV DUMMY - THESE TWO BYTES ARE ALWAYS ZERO * THE FOLLOWING BYTES ARE MOVED DOWN FROM ROM LPTCFW RMB 1 16 LPTLCF RMB 1 112 LPTWID RMB 1 132 LPTPOS RMB 1 0 EXECJP RMB 2 LB4AA * THIS ROUTINE PICKS UP THE NEXT INPUT CHARACTER FROM * BASIC. THE ADDRESS OF THE NEXT BASIC BYTE TO BE * INTERPRETED IS STORED AT CHARAD. GETNCH INC 7372800 / 4 / 16 = 115200 STA UCTRL LDX #LA147-1 POINT X TO COLOR BASIC COPYRIGHT MESSAGE JSR LB99C PRINT ‘COLOR BASIC’ 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 BAWMST NOP NOP REQ’D FOR WARM START JSR LAD33 DO PART OF A NEW LA0F3 JMP LAC73 GO TO MAIN LOOP OF BASIC * * FIRQ SERVICE ROUTINE BFRQSV RTI * * THESE BYTES ARE MOVED TO ADDRESSES $76 - $85 THE DIRECT PAGE LA10D FCB 16 TAB FIELD WIDTH FCB 64 LAST TAB ZONE FCB 80 PRINTER WIDTH FCB 0 LINE PRINTER POSITION FDB LB44A ARGUMENT OF EXEC COMMAND - SET TO ‘FC’ ERROR * LINE INPUT ROUTINE INC CHARAD+1 BNE LA123 INC CHARAD LA123 LDA >0000 JMP BROMHK * * THESE BYTES ARE MOVED TO ADDRESSES $A7-$B1 JMP BIRQSV IRQ SERVICE JMP BFRQSV FIRQ SERVICE JMP LB44A USR ADDRESS FOR 8K BASIC (INITIALIZED TO ‘FC’ ERROR) FCB $80 *RANDOM SEED FDB $4FC7 *RANDON SEED OF MANTISSA FDB $5259 *.811635157 * BASIC COMMAND INTERPRETATION TABLE ROM IMAGE COMVEC FCB 50 50 BASIC COMMANDS FDB LAA66 POINTS TO RESERVED WORDS FDB LAB67 POINTS TO JUMP TABLE FOR COMMANDS FCB 29 29 BASIC SECONDARY COMMANDS FDB LAB1A POINTS TO SECONDARY FUNCTION RESERVED WORDS FDB LAA29 POINTS TO SECONDARY FUNCTION JUMP TABLE FDB 0 NO MORE TABLES (RES WORDS=0) FDB 0 NO MORE TABLES FDB 0 NO MORE TABLES FDB 0 NO MORE TABLES FDB 0 NO MORE TABLES FDB 0 NO MORE TABLES (SECONDARY FNS =0) * COPYRIGHT MESSAGES LA147 FCC "6809 EXTENDED BASIC" FCB CR FCC "(C) 1982 BY MICROSOFT" LA156 FCB CR,CR LA165 FCB $00 LA35F 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 * 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 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 LA171 GO GET A CHARACTER FROM CONSOLE IN CMPA #BS BACKSPACE BNE LA3B4 NO DECB YES - DECREMENT CHAR COUNTER BEQ LA390 BRANCH IF BACK AT START OF LINE AGAIN LEAX -1,X DECREMENT BUFFER POINTER BRA LA3E8 ECHO CHAR TO SCREEN LA3B4 CMPA #$15 SHIFT RIGHT ARROW? 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 #BS BACKSPACE? 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 * INSERT A CHARACTER INTO THE BASIC LINE INPUT BUFFER LA3D9 CMPA #$20 IS IT CONTROL CHAR? BLO LA39A BRANCH IF CONTROL CHARACTER CMPA #'z+1 * BCC LA39A * IGNORE IF > LOWER CASE Z 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 * EXEC EXEC BEQ LA545 BRANCH IF NO ARGUMENT JSR LB73D EVALUATE ARGUMENT - ARGUMENT RETURNED IN X STX EXECJP STORE X TO EXEC JUMP ADDRESS LA545 JMP [EXECJP] GO DO IT * BREAK CHECK LA549 JMP LADEB GO DO 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 * 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 LAA28 RTS * DISPATCH TABLE FOR SECONDARY FUNCTIONS * TOKENS ARE PRECEEDED BY $FF * FIRST SET ALWAYS HAS ONE PARAMETER FUNC_TAB LAA29 FDB SGN SGN FDB INT INT FDB ABS ABS FDB USRJMP USR TOK_USR EQU *-FUNC_TAB/2+$7F TOK_FF_USR EQU *-FUNC_TAB/2+$FF7F FDB RND RND FDB SIN SIN FDB PEEK PEEK FDB LEN LEN FDB STR STR$ FDB VAL VAL FDB ASC ASC FDB CHR CHR$ FDB ATN ATN FDB COS COS FDB TAN TAN FDB EXP EXP FDB FIX FIX FDB LOG LOG FDB POS POS FDB SQR SQR FDB HEXDOL HEX$ * LEFT, RIGHT AND MID ARE TREATED SEPARATELY FDB LEFT LEFT$ TOK_LEFT EQU *-FUNC_TAB/2+$7F FDB RIGHT RIGHT$ FDB MID MID$ TOK_MID EQU *-FUNC_TAB/2+$7F * REMAINING FUNCTIONS FDB INKEY INKEY$ TOK_INKEY EQU *-FUNC_TAB/2+$7F FDB MEM MEM FDB VARPT VARPTR FDB INSTR INSTR FDB STRING STRING$ NUM_SEC_FNS EQU *-FUNC_TAB/2 * THIS TABLE CONTAINS PRECEDENCES AND DISPATCH ADDRESSES FOR ARITHMETIC * AND LOGICAL OPERATORS - THE NEGATION OPERATORS DO NOT ACT ON TWO OPERANDS * S0 THEY ARE NOT LISTED IN THIS TABLE. THEY ARE TREATED SEPARATELY IN THE * EXPRESSION EVALUATION ROUTINE. THEY ARE: * UNARY NEGATION (-), PRECEDENCE &7D AND LOGICAL NEGATION (NOT), PRECEDENCE $5A * THE RELATIONAL OPERATORS < > = ARE ALSO NOT LISTED, PRECEDENCE $64. * A PRECEDENCE VALUE OF ZERO INDICATES END OF EXPRESSION OR PARENTHESES * 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 * THIS IS THE RESERVED WORD TABLE * FIRST PART OF THE TABLE CONTAINS EXECUTABLE COMMANDS LAA66 FCC "FO" 80 FCB $80+'R' FCC "G" 81 FCB $80+'O' TOK_GO EQU $81 FCC "RE" 82 FCB $80+'M' FCB ''+$80 83 FCC "ELS" 84 FCB $80+'E' FCC "I" 85 FCB $80+'F' FCC "DAT" 86 FCB $80+'A' FCC "PRIN" 87 FCB $80+'T' FCC "O" 88 FCB $80+'N' FCC "INPU" 89 FCB $80+'T' FCC "EN" 8A FCB $80+'D' FCC "NEX" 8B FCB $80+'T' FCC "DI" 8C FCB $80+'M' FCC "REA" 8D FCB $80+'D' FCC "RU" 8E FCB $80+'N' FCC "RESTOR" 8F FCB $80+'E' FCC "RETUR" 90 FCB $80+'N' FCC "STO" 91 FCB $80+'P' FCC "POK" 92 FCB $80+'E' FCC "CON" 93 FCB $80+'T' FCC "LIS" 94 FCB $80+'T' FCC "CLEA" 95 FCB $80+'R' FCC "NE" 96 FCB $80+'W' FCC "EXE" 97 FCB $80+'C' FCC "TRO" 98 FCB $80+'N' FCC "TROF" 99 FCB $80+'F' FCC "DE" 9A FCB $80+'L' FCC "DE" 9B FCB $80+'F' FCC "LIN" 9C FCB $80+'E' FCC "RENU" 9D FCB $80+'M' FCC "EDI" 9E FCB $80+'T' * END OF EXECUTABLE COMMANDS. THE REMAINDER OF THE TABLE ARE NON-EXECUTABLE TOKENS FCC "TAB" 9F FCB $80+'(' TOK_TAB EQU $9F FCC "T" A0 FCB $80+'O' TOK_TO EQU $A0 FCC "SU" A1 FCB $80+'B' TOK_SUB EQU $A1 FCC "THE" A2 FCB $80+'N' TOK_THEN EQU $A2 FCC "NO" A3 FCB $80+'T' TOK_NOT EQU $A3 FCC "STE" A4 FCB $80+'P' TOK_STEP EQU $A4 FCC "OF" A5 FCB $80+'F' FCB '++$80 A6 TOK_PLUS EQU $A6 FCB '-+$80 A7 TOK_MINUS EQU $A7 FCB '*+$80 A8 FCB '/+$80 A9 FCB '^+$80 AA FCC "AN" AB FCB $80+'D' FCC "O" AC FCB $80+'R' FCB '>+$80 AD TOK_GREATER EQU $AD FCB '=+$80 AE TOK_EQUALS EQU $AE FCB '<+$80 AF FCC "F" B0 FCB $80+'N' TOK_FN EQU $B0 FCC "USIN" B1 FCB $80+'G' TOK_USING EQU $B1 * * FIRST SET ALWAYS HAS ONE PARAMETER LAB1A FCC "SG" 80 FCB $80+'N' FCC "IN" 81 FCB $80+'T' FCC "AB" 82 FCB $80+'S' FCC "US" 83 FCB $80+'R' FCC "RN" 84 FCB $80+'D' FCC "SI" 85 FCB $80+'N' FCC "PEE" 86 FCB $80+'K' FCC "LE" 87 FCB $80+'N' FCC "STR" 88 FCB $80+'$' FCC "VA" 89 FCB $80+'L' FCC "AS" 8A FCB $80+'C' FCC "CHR" 8B FCB $80+'$' FCC "AT" 8C FCB $80+'N' FCC "CO" 8D FCB $80+'S' FCC "TA" 8E FCB $80+'N' FCC "EX" 8F FCB $80+'P' FCC "FI" 90 FCB $80+'X' FCC "LO" 91 FCB $80+'G' FCC "PO" 92 FCB $80+'S' FCC "SQ" 93 FCB $80+'R' FCC "HEX" 94 FCB $80+'$' * LEFT, RIGHT AND MID ARE TREATED SEPARATELY FCC "LEFT" 95 FCB $80+'$' FCC "RIGHT" 96 FCB $80+'$' FCC "MID" 97 FCB $80+'$' * REMAINING FUNCTIONS FCC "INKEY" 98 FCB $80+'$' FCC "ME" 99 FCB $80+'M' FCC "VARPT" 9A FCB $80+'R' FCC "INST" 9B FCB $80+'R' FCC "STRING" 9C FCB $80+'$' * * DISPATCH TABLE FOR COMMANDS TOKEN # CMD_TAB LAB67 FDB FOR 80 FDB GO 81 FDB REM 82 TOK_REM EQU *-CMD_TAB/2+$7F FDB REM 83 (') TOK_SNGL_Q EQU *-CMD_TAB/2+$7F FDB REM 84 (ELSE) TOK_ELSE EQU *-CMD_TAB/2+$7F FDB IF 85 TOK_IF EQU *-CMD_TAB/2+$7F FDB DATA 86 TOK_DATA EQU *-CMD_TAB/2+$7F FDB PRINT 87 TOK_PRINT EQU *-CMD_TAB/2+$7F FDB ON 88 FDB INPUT 89 TOK_INPUT EQU *-CMD_TAB/2+$7F FDB END 8A FDB NEXT 8B FDB DIM 8C FDB READ 8D FDB RUN 8E FDB RESTOR 8F FDB RETURN 90 FDB STOP 91 FDB POKE 92 FDB CONT 93 FDB LIST 94 FDB CLEAR 95 FDB NEW 96 FDB EXEC 97 FDB TRON 98 FDB TROFF 99 FDB DEL 9A FDB DEF 9B FDB LINE 9C FDB RENUM 9D FDB EDIT 9E TOK_HIGH_EXEC EQU *-CMD_TAB/2+$7F * ERROR MESSAGES AND THEIR NUMBERS AS USED INTERNALLY LABAF FCC "NF" 0 NEXT WITHOUT FOR FCC "SN" 1 SYNTAX ERROR FCC "RG" 2 RETURN WITHOUT GOSUB FCC "OD" 3 OUT OF DATA FCC "FC" 4 ILLEGAL FUNCTION CALL FCC "OV" 5 OVERFLOW FCC "OM" 6 OUT OF MEMORY FCC "UL" 7 UNDEFINED LINE NUMBER FCC "BS" 8 BAD SUBSCRIPT FCC "DD" 9 REDIMENSIONED ARRAY 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 LAD33 RESET STACK, STRING STACK, CONTINUE POINTER JSR LB95C 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 LAC7C 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 NUMER1C - 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) * 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 #TOK_TO 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 #TOK_STEP 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 ANDCC #$AF ENABLE IRQ,FIRQ BSR 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 * EXTENDED BASIC TRACE LDA TRCFLG TEST THE TRACE FLAG BEQ LADC0 BRANCH IF TRACE OFF LDA #$5B RIGHT HAND MARKER FOR TRON LINE NUMBER JSR PUTCHR OUTPUT A CHARACTER * END OF EXTENDED BASIC TRACE 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) TSTA CHECK FOR TOKEN - BIT 7 SET (NEGATIVE) LBPL LET BRANCH IF NOT A TOKEN - GO DO A ‘LET’ WHICH * IS THE ‘DEFAULT’ TOKEN FOR MICROSOFT BASIC CMPA #$FF SECONDARY TOKEN BEQ SECTOK CMPA #TOK_HIGH_EXEC SKIPF TOKEN - HIGHEST EXECUTABLE COMMAND IN BASIC BHI LADB1 ‘SYNTAX ERROR’ IF NON-EXECUTABLE TOKEN 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] GO DO A COMMAND SECTOK * THE ONLY SECONDARY TOKEN THAT CAN ALSO BE AN EXECUTABLE IS * THE MID$ REPLACEMENT STATEMENT. SO SPECIAL-CASE CHECK DONE HERE JSR GETNCH GET AN INPUT CHAR CMPA #TOK_MID 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 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 END JSR GETCCH GET CURRENT INPUT CHAR BRA LAE0B * * STOP STOP ORCC #$01 SET CARRY FLAG LAE0B BNE LAE40 BRANCH IF ARGUMENT EXISTS 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 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 #TOK_TO ‘TO’ TOKEN BEQ LAEA4 BRANCH IF GOTO CMPB #TOK_SUB ‘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 #TOK_SUB * PSHS U,X,A * LAE9F BSR LAEA4 GO 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 #TOK_SUB-$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 DATA BSR LAEE8 MOVE INPUT POINTER TO END OF SUBLINE OR LINE FCB SKP2 SKIP 2 BYTES * REM, ELSE ELSE 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 SKPILD 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 #TOK_IF+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 IF JSR LB141 EVALUATE NUMERIC EXPRESSION JSR GETCCH GET CURRENT INPUT CHARACTER CMPA #TOK_GO TOKEN FOR GO BEQ LAF22 TREAT ‘GO’ THE SAME AS ‘THEN’ LDB #TOK_THEN 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 DATA 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 #TOK_ELSE 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 #TOK_GO TOKEN FOR GO JSR LB26F SYNTAX CHECK FOR GO PSHS A SAVE NEW TOKEN (TO,SUB) CMPA #TOK_SUB TOKEN FOR SUB? BEQ LAF54 YES CMPA #TOK_TO TOKEN FOR TO? LAF52 BNE 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 GO 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 #TOK_EQUALS 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 DO A ‘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 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 #TOK_DATA 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 XVEC15 CALL EXTENDED BASIC ADD-IN 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 #TOK_MINUS MINUS TOKEN BEQ LB27C YES - GO PROCESS THE MINUS OPERATOR CMPA #TOK_PLUS 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 #TOK_NOT 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 #NUM_SEC_FNS-1*2 29 SECONDARY FUNCTIONS - 1 BLS LB29F BRANCH IF COLOR BASIC TOKEN JMP LB277 SYNTAX ERROR LB29F PSHS B SAVE TOKEN OFFSET ON STACK CMPB #TOK_LEFT-$80*2 CHECK FOR TOKEN WITH AN ARGUMENT BCS LB2C7 DO SECONDARIES STRING$ OR LESS CMPB #TOK_INKEY-$80*2 * BCC LB2C9 * DO SECONDARIES $92 (INKEY$) OR > BSR LB26A SYNTAX CHECK FOR A ‘(‘ LDA ,S GET TOKEN NUMBER * DO SECONDARIES (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] GO 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 FPA0+2 = ADDRESS IN LASTPT AND FPA0 LEAX 5,X 5 BYTES/STRING DESCRIPTOR STX TEMPPT NEXT AVAILABLE STRING VARIABLE DESCRIPTOR RTS * RESERVE ACCB BYTES IN STRING STORAGE SPACE * RETURN WITH THE STARTING ADDRESS OF THE * RESERVED STRING SPACE IN (X) AND FRESPC LB56D CLR GARBFL CLEAR STRING REORGANIZATION FLAG LB56F CLRA * PUSH THE LENGTH OF THE PSHS B,A * STRING ONTO THE STACK LDD STRTAB GET START OF STRING VARIABLES SUBD ,S+ SUBTRACT STRING LENGTH CMPD FRETOP COMPARE TO START OF STRING STORAGE BCS LB585 IF BELOW START, THEN REORGANIZE STD STRTAB SAVE NEW START OF STRING VARIABLES LDX STRTAB GET START OF STRING VARIABLES LEAX 1,X ADD ONE STX FRESPC SAVE START ADDRESS OF NEWLY RESERVED 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 LB555 ERROR IF FRESHLY REORGANIZED BSR LB591 GO REORGANIZE STRING SPACE PULS B GET BACK THE NUMBER OF BYTES TO RESERVE BRA LB56F TRY TO RESERVE ACCB BYTES AGAIN * REORGANIZE THE STRING SPACE LB591 LDX MEMSIZ GET THE TOP OF STRING SPACE LB593 STX STRTAB SAVE TOP OF UNORGANIZED STRING SPACE CLRA * ZERO OUT ACCD CLRB * AND RESET VARIABLE STD V4B * POINTER TO 0 LDX FRETOP POINT X TO START OF STRING SPACE STX V47 SAVE POINTER IN V47 LDX #STRSTK POINT X TO START OF STRING DESCRIPTOR STACK LB5A0 CMPX TEMPPT COMPARE TO ADDRESS 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 LIST 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 #TOK_MINUS 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 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 #TOK_ELSE TOKEN FOR ELSE? BEQ LB7CB YES - DON’T PUT IT IN BUFFER CMPB #TOK_SNGL_Q 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 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 LB82D 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 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 * DO NOT CRUNCH DATA LB852 STA ,U+ SAVE CHARACTER IN BUFFER BEQ LB85C BRANCH IF END OF LINE 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 #TOK_PRINT * GET THE PRINT TOKEN AND SAVE IT BRA LB852 * IN BUFFER LB873 CMPA #'' APOSTROPHE IS SAME AS REM BNE LB88A BRANCH IF NOT REMARK LDD #$3A00+TOK_SNGL_Q 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 GO 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 #TOK_ELSE IS IT ELSE TOKEN? BNE LB8C6 NO LDA #': PUT A COLON (SUBLINE) BEFORE ELSE TOKEN LB8C2 STD ,U++ SECONDARY TOKENS PRECEEDED BY $FF BRA LB85A GO PROCESS MORE INPUT CHARACTERS LB8C6 STB ,U+ SAVE THIS TOKEN CMPB #TOK_DATA DATA TOKEN? BNE LB8CE NO INC V44 SET DATA FLAG LB8CE CMPB #TOK_REM 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 XVEC9 CALL EXTENDED BASIC ADD-IN LB91B BEQ LB965 RETURN IF END OF LINE LB91D CMPA #TOK_TAB 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 * 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 XVEC19 CALL EXTENDED BASIC ADD-IN 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 #TOK_MINUS MINUS TOKEN? BEQ LBD53 YES CMPA #'- ASCII MINUS? BEQ LBD53 YES CMPA #TOK_PLUS 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 UNUSED GARBAGE BYTES FCB $8F,$52,$43,$89,$CD UNUSED GARBAGE BYTES * EXTENDED BASIC * COS * THE VALUE OF COS(X) IS DETERMINED BY THE TRIG IDENTITY COS(X)=SIN((PI/2)+X) 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 - NATURAL LOGARITHM (LN) * THE NATURAL OR NAPERIAN LOGARITHM IS CALCULATED USING * MATHEMATICAL IDENTITIES. FPA0 IS OF THE FORM FPA0=A*(2**B) (SCIENTIFIC * NOTATION). THEREFORE, THE LOG ROUTINE DETERMINES THE VALUE OF * LN(A*(2**B)). A SERIES OF MATHEMATICAL IDENTITIES WILL EXPAND THIS * TERM: LN(A*(2**B))=(-1/2+(1/LN(2))*(LN(A*SQR(2)))+B)*LN(2). ALL OF * THE TERMS OF THE LATTER EXPRESSION ARE CONSTANTS EXCEPT FOR THE * LN(A*SQR(2)) TERM WHICH IS EVALUATED USING THE TAYLOR SERIES EXPANSION 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 OF 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 GET CURRENT BUFFER CHARACTER BEQ L8685 AND RETURN IF END OF LINE 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 LPTPOS 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 * MID$(OLDSTRING,POSITION,LENGTH)=REPLACEMENT 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 #TOK_EQUALS 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 #TOK_FN 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 #TOK_USR 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 #TOK_FF_USR 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 #TOK_EQUALS 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 DATA MOVE INPUT POINTER TO END OF LINE OR SUBLINE L88A1 LDB #TOK_FN 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 #TOK_EQUALS 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 #TOK_MINUS 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 CMPA #TOK_THEN TOKEN FOR THEN? BEQ L8B13 YES CMPA #TOK_ELSE TOKEN FOR ELSE? BEQ L8B13 YES CMPA #TOK_GO TOKEN FOR GO? BNE L8AED NO JSR GETNCH GET A CHARACTER FROM BASIC CMPA #TOK_TO TOKEN FOR TO? BEQ L8B13 YES CMPA #TOK_SUB 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 * ERROR PROCESSOR - ILLEGAL CHARACTER OR BAD SYNTAX IN FORMAT STRING 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 * PRINT RAM HOOK XVEC9 CMPA #TOK_USING USING TOKEN BEQ L8E95 BRANCH IF PRINT USING RTS * PRINT USING * VDA IS USED AS A STATUS BYTE: BIT 6 = COMMA FORCE * BIT 5=LEADING ASTERISK FORCE; BIT 4 = FLOATING $ FORCE * BIT 3 = PRE SIGN FORCE; BIT 2 = POST SIGN FORCE; BIT 0 = EXPONENTIAL FORCE 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 * CHECK THE EXPONENTIAL FORCE FLAG IN LBNE L910D * THE STATUS BYTE - BRANCH IF ACTIVE 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 MOVE THE STA $01,X ENTIRE STRING CMPX #STRBUF+3 UP ONE BNE L9015 BYTE LDA #'%' * INSERT A % SIGN AT START OF STA ,X * STRING - OVERFLOW ERROR RTS L9023 LDA FP0EXP GET EXPONENT OF FPA0 STA V47 AND SAVE IT IN V74 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 #TOK_INPUT ‘INPUT’ TOKEN LBEQ L89C0 GO DO ‘LINE INPUT’ COMMAND JMP LB277 ‘SYNTAX ERROR’ IF NOT "LINE INPUT" * END OF EXTENDED BASIC * INTERRUPT VECTORS ORG $FFF0 LBFF0 FDB $0000 RESERVED LBFF2 FDB SW3VEC SWI3 LBFF4 FDB SW2VEC SWI2 LBFF6 FDB FRQVEC FIRQ LBFF8 FDB IRQVEC IRQ LBFFA FDB SWIVEC SWI LBFFC FDB NMIVEC NMI LBFFE FDB RESVEC RESET