6502/AtomBusMon
1
0
Fork 0
mirror of https://github.com/hoglet67/AtomBusMon.git synced 2024-06-18 17:29:31 +00:00
Code Issues Projects Releases Wiki Activity
20269623ea
AtomBusMon/6809/ExBasROM.LST
David Banks 20269623ea Initial checkin of ICE-6809; version now 0.49 
Change-Id: I502840a0be0fa58adfc9ddb27c4e2a35a7c2849c
2015-07-02 15:35:05 +01:00

5407 lines
449 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

0001
0002 a000 UART EQU $A000
0003 a001 RECEV EQU UART+1
0004 a001 TRANS EQU UART+1
0005 a000 USTAT EQU UART
0006 a000 UCTRL EQU UART
0007
0008 0008 BS EQU 8 BACKSPACE
0009 000d CR EQU $D ENTER KEY
0010 001b ESC EQU $1B ESCAPE CODE
0011 0020 SPACE EQU $20 SPACE (BLANK)
0012 003a STKBUF EQU 58 STACK BUFFER ROOM
0013 00fa LBUFMX EQU 250 MAX NUMBER OF CHARS IN A BASIC LINE
0014 00fa MAXLIN EQU $FA MAXIMUM MS BYTE OF LINE NUMBER
0015 * PSEUDO OPS
0016 0021 SKP1 EQU $21 OP CODE OF BRN — SKIP ONE BYTE
0017 008c SKP2 EQU $8C OP CODE OF CMPX # - SKIP TWO BYTES
0018 0086 SKP1LD EQU $86 OP CODE OF LDA # - SKIP THE NEXT BYTE
0019 * AND LOAD THE VALUE OF THAT BYTE INTO ACCA — THIS
0020 * IS USUALLY USED TO LOAD ACCA WITH A NON ZERO VALUE
0021 0095 RTS_LOW EQU $95
0022 0000 ORG 0
0023 0000 ENDFLG RMB 1 STOP/END FLAG: POSITIVE=STOP, NEG=END
0024 0001 CHARAC RMB 1 TERMINATOR FLAG 1
0025 0002 ENDCHR RMB 1 TERMINATOR FLAG 2
0026 0003 TMPLOC RMB 1 SCRATCH VARIABLE
0027 0004 IFCTR RMB 1 IF COUNTER - HOW MANY IF STATEMENTS IN A LINE
0028 0005 DIMFLG RMB 1 *DV* ARRAY FLAG 0=EVALUATE, 1=DIMENSIONING
0029 0006 VALTYP RMB 1 *DV* *PV TYPE FLAG: 0=NUMERIC, $FF=STRING
0030 0007 GARBFL RMB 1 *TV STRING SPACE HOUSEKEEPING FLAG
0031 0008 ARYDIS RMB 1 DISABLE ARRAY SEARCH: 00=ALLOW SEARCH
0032 0009 INPFLG RMB 1 *TV INPUT FLAG: READ=0, INPUT<>0
0033 000a RELFLG RMB 1 *TV RELATIONAL OPERATOR FLAG
0034 000b TEMPPT RMB 2 *PV TEMPORARY STRING STACK POINTER
0035 000d LASTPT RMB 2 *PV ADDR OF LAST USED STRING STACK ADDRESS
0036 000f TEMPTR RMB 2 TEMPORARY POINTER
0037 0011 TMPTR1 RMB 2 TEMPORARY DESCRIPTOR STORAGE (STACK SEARCH)
0038 0013 FPA2 RMB 4 FLOATING POINT ACCUMULATOR #2 MANTISSA
0039 0017 BOTSTK RMB 2 BOTTOM OF STACK AT LAST CHECK
0040 0019 TXTTAB RMB 2 *PV BEGINNING OF BASIC PROGRAM
0041 001b VARTAB RMB 2 *PV START OF VARIABLES
0042 001d ARYTAB RMB 2 *PV START OF ARRAYS
0043 001f ARYEND RMB 2 *PV END OF ARRAYS (+1)
0044 0021 FRETOP RMB 2 *PV START OF STRING STORAGE (TOP OF FREE RAM)
0045 0023 STRTAB RMB 2 *PV START OF STRING VARIABLES
0046 0025 FRESPC RMB 2 UTILITY STRING POINTER
0047 0027 MEMSIZ RMB 2 *PV TOP OF STRING SPACE
0048 0029 OLDTXT RMB 2 SAVED LINE NUMBER DURING A "STOP"
0049 002b BINVAL RMB 2 BINARY VALUE OF A CONVERTED LINE NUMBER
0050 002d OLDPTR RMB 2 SAVED INPUT PTR DURING A "STOP"
0051 002f TINPTR RMB 2 TEMPORARY INPUT POINTER STORAGE
0052 0031 DATTXT RMB 2 *PV 'DATA' STATEMENT LINE NUMBER POINTER
0053 0033 DATPTR RMB 2 *PV 'DATA' STATEMENT ADDRESS POINTER
0054 0035 DATTMP RMB 2 DATA POINTER FOR 'INPUT' & 'READ'
0055 0037 VARNAM RMB 2 *TV TEMP STORAGE FOR A VARIABLE NAME
0056 0039 VARPTR RMB 2 *TV POINTER TO A VARIABLE DESCRIPTOR
0057 003b VARDES RMB 2 TEMP POINTER TO A VARIABLE DESCRIPTOR
0058 003d RELPTR RMB 2 POINTER TO RELATIONAL OPERATOR PROCESSING ROUTINE
0059 003f TRELFL RMB 1 TEMPORARY RELATIONAL OPERATOR FLAG BYTE
0060 * FLOATING POINT ACCUMULATORS #3,4 & 5 ARE MOSTLY
0061 * USED AS SCRATCH PAD VARIABLES.
0062 ** FLOATING POINT ACCUMULATOR #3 :PACKED: ($40-$44)
0063 0040 V40 RMB 1
0064 0041 V41 RMB 1
0065 0042 V42 RMB 1
0066 0043 V43 RMB 1
0067 0044 V44 RMB 1
0068 ** FLOATING POINT ACCUMULATOR #4 :PACKED: ($45-$49)
0069 0045 V45 RMB 1
0070 0046 V46 RMB 1
0071 0047 V47 RMB 1
0072 0048 V48 RMB 2
0073 ** FLOATING POINT ACCUMULATOR #5 :PACKED: ($4A—$4E)
0074 004a V4A RMB 1
0075 004b V4B RMB 2
0076 004d V4D RMB 2
0077 ** FLOATING POINT ACCUMULATOR #0
0078 004f FP0EXP RMB 1 *PV FLOATING POINT ACCUMULATOR #0 EXPONENT
0079 0050 FPA0 RMB 4 *PV FLOATING POINT ACCUMULATOR #0 MANTISSA
0080 0054 FP0SGN RMB 1 *PV FLOATING POINT ACCUMULATOR #0 SIGN
0081 0055 COEFCT RMB 1 POLYNOMIAL COEFFICIENT COUNTER
0082 0056 STRDES RMB 5 TEMPORARY STRING DESCRIPTOR
0083 005b FPCARY RMB 1 FLOATING POINT CARRY BYTE
0084 ** FLOATING POINT ACCUMULATOR #1
0085 005c FP1EXP RMB 1 *PV FLOATING POINT ACCUMULATOR #1 EXPONENT
0086 005d FPA1 RMB 4 *PV FLOATING POINT ACCUMULATOR #1 MANTISSA
0087 0061 FP1SGN RMB 1 *PV FLOATING POINT ACCUMULATOR #1 SIGN
0088 0062 RESSGN RMB 1 SIGN OF RESULT OF FLOATING POINT OPERATION
0089 0063 FPSBYT RMB 1 FLOATING POINT SUB BYTE (FIFTH BYTE)
0090 0064 COEFPT RMB 2 POLYNOMIAL COEFFICIENT POINTER
0091 0066 LSTTXT RMB 2 CURRENT LINE POINTER DURING LIST
0092 0068 CURLIN RMB 2 *PV CURRENT LINE # OF BASIC PROGRAM, $FFFF = DIRECT
0093 006a DEVCFW RMB 1 *TV TAB FIELD WIDTH
0094 006b DEVLCF RMB 1 *TV TAB ZONE
0095 006c DEVPOS RMB 1 *TV PRINT POSITION
0096 006d DEVWID RMB 1 *TV PRINT WIDTH
0097 006e RSTFLG RMB 1 *PV WARM START FLAG: $55=WARM, OTHER=COLD
0098 006f RSTVEC RMB 2 *PV WARM START VECTOR - JUMP ADDRESS FOR WARM START
0099 0071 TOPRAM RMB 2 *PV TOP OF RAM
0100 0073 IKEYIM RMB 1 *TV INKEY$ RAM IMAGE
0101 0074 ZERO RMB 2 *PV DUMMY - THESE TWO BYTES ARE ALWAYS ZERO
0102 * THE FOLLOWING BYTES ARE MOVED DOWN FROM ROM
0103 0076 LPTCFW RMB 1 16
0104 0077 LPTLCF RMB 1 112
0105 0078 LPTWID RMB 1 132
0106 0079 LPTPOS RMB 1 0
0107 007a EXECJP RMB 2 LB4AA
0108
0109 * THIS ROUTINE PICKS UP THE NEXT INPUT CHARACTER FROM
0110 * BASIC. THE ADDRESS OF THE NEXT BASIC BYTE TO BE
0111 * INTERPRETED IS STORED AT CHARAD.
0112 007c 0c 84 GETNCH INC <CHARAD+1 *PV INCREMENT LS BYTE OF INPUT POINTER
0113 007e 26 02 BNE GETCCH *PV BRANCH IF NOT ZERO (NO CARRY)
0114 0080 0c 83 INC <CHARAD *PV INCREMENT MS BYTE OF INPUT POINTER
0115 0082 b6 GETCCH FCB $B6 *PV OP CODE OF LDA EXTENDED
0116 0083 CHARAD RMB 2 *PV THESE 2 BYTES CONTAIN ADDRESS OF THE CURRENT
0117 * * CHARACTER WHICH THE BASIC INTERPRETER IS
0118 * * PROCESSING
0119 0085 7e dc bf JMP BROMHK JUMP BACK INTO THE BASIC RUM
0120
0121 0088 VAB RMB 1 = LOW ORDER FOUR BYTES OF THE PRODUCT
0122 0089 VAC RMB 1 = OF A FLOATING POINT MULTIPLICATION
0123 008a VAD RMB 1 = THESE BYTES ARE USE AS RANDOM DATA
0124 008b VAE RMB 1 = BY THE RND STATEMENT
0125
0126 * EXTENDED BASIC VARIABLES
0127 008c TRCFLG RMB 1 *PV TRACE FLAG 0=OFF ELSE=ON
0128 008d USRADR RMB 2 *PV ADDRESS OF THE START OF USR VECTORS
0129
0130 * EXTENDED BASIC SCRATCH PAD VARIABLES
0131 008f VCF RMB 2
0132 0091 VD1 RMB 2
0133 0093 VD3 RMB 2
0134 0095 VD5 RMB 2
0135 0097 VD7 RMB 1
0136 0098 VD8 RMB 1
0137 0099 VD9 RMB 1
0138 009a VDA RMB 1
0139 009b SW3VEC RMB 3
0140 009e SW2VEC RMB 3
0141 00a1 SWIVEC RMB 3
0142 00a4 NMIVEC RMB 3
0143 00a7 IRQVEC RMB 3
0144 00aa FRQVEC RMB 3
0145 00ad USRJMP RMB 3 JUMP ADDRESS FOR BASIC'S USR FUNCTION
0146 00b0 RVSEED RMB 1 * FLOATING POINT RANDOM NUMBER SEED EXPONENT
0147 00b1 RMB 4 * MANTISSA: INITIALLY SET TO $804FC75259
0148
0149 **** USR FUNCTION VECTOR ADDRESSES (EX BASIC ONLY)
0150 00b5 USR0 RMB 2 USR 0 VECTOR
0151 00b7 RMB 2 USR 1
0152 00b9 RMB 2 USR 2
0153 00bb RMB 2 USR 3
0154 00bd RMB 2 USR 4
0155 00bf RMB 2 USR 5
0156 00c1 RMB 2 USR 6
0157 00c3 RMB 2 USR 7
0158 00c5 RMB 2 USR 8
0159 00c7 RMB 2 USR 9
0160
0161 00c9 STRSTK RMB 8*5 STRING DESCRIPTOR STACK
0162 00f1 LINHDR RMB 2 LINE INPUT BUFFER HEADER
0163 00f3 LINBUF RMB LBUFMX+1 BASIC LINE INPUT BUFFER
0164 01ee STRBUF RMB 41 STRING BUFFER
0165
0166 0217 PROGST RMB 1 START OF PROGRAM SPACE
0167 * INTERRUPT VECTORS
0168 fff2 ORG $FFF2
0169 fff2 SWI3 RMB 2
0170 fff4 SWI2 RMB 2
0171 fff6 FIRQ RMB 2
0172 fff8 IRQ RMB 2
0173 fffa SWI RMB 2
0174 fffc NMI RMB 2
0175 fffe RESETV RMB 2
0176
0177
0178
0179 db00 ORG $DB00
0180
0181 * CONSOLE IN
0182 db00 8d 03 LA171 BSR KEYIN GET A CHARACTER FROM CONSOLE IN
0183 db02 27 fc BEQ LA171 LOOP IF NO KEY DOWN
0184 db04 39 RTS
0185
0186 *
0187 * THIS ROUTINE GETS A KEYSTROKE FROM THE KEYBOARD IF A KEY
0188 * IS DOWN. IT RETURNS ZERO TRUE IF THERE WAS NO KEY DOWN.
0189 *
0190 *
0191 LA1C1
0192 db05 b6 a0 00 KEYIN LDA USTAT
0193 db08 85 01 BITA #1
0194 db0a 27 06 BEQ NOCHAR
0195 db0c b6 a0 01 LDA RECEV
0196 db0f 84 7f ANDA #$7F
0197 db11 39 RTS
0198 db12 4f NOCHAR CLRA
0199 db13 39 RTS
0200
0201
0202
0203 * CONSOLE OUT
0204 db14 8d 24 PUTCHR BSR WAITACIA
0205 db16 34 02 PSHS A
0206 db18 81 0d CMPA #CR IS IT CARRIAGE RETURN?
0207 db1a 27 0b BEQ NEWLINE YES
0208 db1c b7 a0 01 STA TRANS
0209 db1f 0c 79 INC LPTPOS INCREMENT CHARACTER COUNTER
0210 db21 96 79 LDA LPTPOS CHECK FOR END OF LINE PRINTER LINE
0211 db23 91 78 CMPA LPTWID AT END OF LINE PRINTER LINE?
0212 db25 25 10 BLO PUTEND NO
0213 db27 0f 79 NEWLINE CLR LPTPOS RESET CHARACTER COUNTER
0214 db29 8d 0f BSR WAITACIA
0215 db2b 86 0d LDA #13
0216 db2d b7 a0 01 STA TRANS
0217 db30 8d 08 BSR WAITACIA
0218 db32 86 0a LDA #10 DO LINEFEED AFTER CR
0219 db34 b7 a0 01 STA TRANS
0220 db37 35 02 PUTEND PULS A
0221 db39 39 RTS
0222
0223 db3a 34 02 WAITACIA PSHS A
0224 db3c b6 a0 00 WRWAIT LDA USTAT
0225 db3f 85 02 BITA #2
0226 db41 27 f9 BEQ WRWAIT
0227 db43 35 02 PULS A
0228 db45 39 RTS
0229
0230 *
0231 RESVEC
0232 db46 10 ce 01 ee LA00E LDS #LINBUF+LBUFMX+1 SET STACK TO TOP OF LINE INPUT BUFFER
0233 db4a 96 6e LDA RSTFLG GET WARM START FLAG
0234 db4c 81 55 CMPA #$55 IS IT A WARM START?
0235 db4e 26 0a BNE BACDST NO - D0 A COLD START
0236 db50 9e 6f LDX RSTVEC WARM START VECTOR
0237 db52 a6 84 LDA ,X GET FIRST BYTE OF WARM START ADDR
0238 db54 81 12 CMPA #$12 IS IT NOP?
0239 db56 26 02 BNE BACDST NO - DO A COLD START
0240 db58 6e 84 JMP ,X YES, G0 THERE
0241
0242 * COLD START ENTRY
0243
0244 db5a 8e 02 18 BACDST LDX #PROGST+1 POINT X TO CLEAR 1ST 1K OF RAM
0245 db5d 6f 83 LA077 CLR ,--X MOVE POINTER DOWN TWO-CLEAR BYTE
0246 db5f 30 01 LEAX 1,X ADVANCE POINTER ONE
0247 db61 26 fa BNE LA077 KEEP GOING IF NOT AT BOTTOM OF PAGE 0
0248 db63 8e 02 17 LDX #PROGST SET TO START OF PROGRAM SPACE
0249 db66 6f 80 CLR ,X+ CLEAR 1ST BYTE OF BASIC PROGRAM
0250 db68 9f 19 STX TXTTAB BEGINNING OF BASIC PROGRAM
0251 db6a a6 02 LA084 LDA 2,X LOOK FOR END OF MEMORY
0252 db6c 43 COMA * COMPLEMENT IT AND PUT IT BACK
0253 db6d a7 02 STA 2,X * INTO SYSTEM MEMORY
0254 db6f a1 02 CMPA 2,X IS IT RAM?
0255 db71 26 06 BNE LA093 BRANCH IF NOT (ROM, BAD RAM OR NO RAM)
0256 db73 30 01 LEAX 1,X MOVE POINTER UP ONE
0257 db75 63 01 COM 1,X RE-COMPLEMENT TO RESTORE BYTE
0258 db77 20 f1 BRA LA084 KEEP LOOKING FOR END OF RAM
0259 db79 9f 71 LA093 STX TOPRAM SAVE ABSOLUTE TOP OF RAM
0260 db7b 9f 27 STX MEMSIZ SAVE TOP OF STRING SPACE
0261 db7d 9f 23 STX STRTAB SAVE START OF STRING VARIABLES
0262 db7f 30 89 ff 38 LEAX -200,X CLEAR 200 - DEFAULT STRING SPACE TO 200 BYTES
0263 db83 9f 21 STX FRETOP SAVE START OF STRING SPACE
0264 db85 1f 14 TFR X,S PUT STACK THERE
0265 db87 8e db ce LDX #LA10D POINT X TO ROM SOURCE DATA
0266 db8a ce 00 76 LDU #LPTCFW POINT U TO RAM DESTINATION
0267 db8d c6 12 LDB #18 MOVE 18 BYTES
0268 db8f bd dc ae JSR LA59A MOVE 18 BYTES FROM ROM TO RAM
0269 db92 ce 00 a7 LDU #IRQVEC POINT U TO NEXT RAM DESTINATION
0270 db95 c6 04 LDB #4 MOVE 4 MORE BYTES
0271 db97 bd dc ae JSR LA59A MOVE 4 BYTES FROM ROM TO RAM
0272 db9a 86 39 LDA #$39
0273 db9c 97 f0 STA LINHDR-1 PUT RTS IN LINHDR-1
0274 db9e bd df ba JSR LAD19 G0 DO A ‘NEW’
0275 * EXTENDED BASIC INITIALISATION
0276 dba1 8e 00 b5 LDX #USR0 INITIALIZE ADDRESS OF START OF
0277 dba4 9f 8d STX USRADR USR JUMP TABLE
0278 * INITIALIZE THE USR CALLS TO ‘FC ERROR’
0279 dba6 ce e6 ce LDU #LB44A ADDRESS OF ‘FC ERROR’ ROUTINE
0280 dba9 c6 0a LDB #10 10 USR CALLS IN EX BASIC
0281 dbab ef 81 L8031 STU ,X++ STORE ‘FC’ ERROR AT USR ADDRESSES
0282 dbad 5a DECB FINISHED ALL 10?
0283 dbae 26 fb BNE L8031 NO
0284
0285 * INITIALISE ACIA
0286 dbb0 86 95 LDA #RTS_LOW DIV16 CLOCK -> 7372800 / 4 / 16 = 115200
0287 dbb2 b7 a0 00 STA UCTRL
0288 dbb5 8e dc 03 LDX #LA147-1 POINT X TO COLOR BASIC COPYRIGHT MESSAGE
0289 dbb8 bd eb e5 JSR LB99C PRINT ‘COLOR BASIC’
0290 dbbb 8e db c6 LDX #BAWMST WARM START ADDRESS
0291 dbbe 9f 6f STX RSTVEC SAVE IT
0292 dbc0 86 55 LDA #$55 WARM START FLAG
0293 dbc2 97 6e STA RSTFLG SAVE IT
0294 dbc4 20 04 BRA LA0F3 GO TO BASIC’S MAIN LOOP
0295 dbc6 12 BAWMST NOP NOP REQ’D FOR WARM START
0296 dbc7 bd df d4 JSR LAD33 DO PART OF A NEW
0297 dbca 7e df 22 LA0F3 JMP LAC73 GO TO MAIN LOOP OF BASIC
0298 *
0299 * FIRQ SERVICE ROUTINE
0300 BFRQSV
0301 dbcd 3b RTI
0302 *
0303 * THESE BYTES ARE MOVED TO ADDRESSES $76 - $85 THE DIRECT PAGE
0304 dbce 10 LA10D FCB 16 TAB FIELD WIDTH
0305 dbcf 40 FCB 64 LAST TAB ZONE
0306 dbd0 50 FCB 80 PRINTER WIDTH
0307 dbd1 00 FCB 0 LINE PRINTER POSITION
0308 dbd2 e6 ce FDB LB44A ARGUMENT OF EXEC COMMAND - SET TO ‘FC’ ERROR
0309 * LINE INPUT ROUTINE
0310 dbd4 0c 84 INC CHARAD+1
0311 dbd6 26 02 BNE LA123
0312 dbd8 0c 83 INC CHARAD
0313 dbda b6 00 00 LA123 LDA >0000
0314 dbdd 7e dc bf JMP BROMHK
0315 *
0316 * THESE BYTES ARE MOVED TO ADDRESSES $A7-$B1
0317 dbe0 7e dc be JMP BIRQSV IRQ SERVICE
0318 dbe3 7e db cd JMP BFRQSV FIRQ SERVICE
0319 dbe6 7e e6 ce JMP LB44A USR ADDRESS FOR 8K BASIC (INITIALIZED TO ‘FC’ ERROR)
0320 dbe9 80 FCB $80 *RANDOM SEED
0321 dbea 4f c7 FDB $4FC7 *RANDON SEED OF MANTISSA
0322 dbec 52 59 FDB $5259 *.811635157
0323 * BASIC COMMAND INTERPRETATION TABLE ROM IMAGE
0324 dbee 32 COMVEC FCB 50 50 BASIC COMMANDS
0325 dbef dd 1d FDB LAA66 POINTS TO RESERVED WORDS
0326 dbf1 de 2a FDB LAB67 POINTS TO JUMP TABLE FOR COMMANDS
0327 dbf3 1d FCB 29 29 BASIC SECONDARY COMMANDS
0328 dbf4 dd bd FDB LAB1A POINTS TO SECONDARY FUNCTION RESERVED WORDS
0329 dbf6 dc ce FDB LAA29 POINTS TO SECONDARY FUNCTION JUMP TABLE
0330 dbf8 00 00 FDB 0 NO MORE TABLES (RES WORDS=0)
0331 dbfa 00 00 FDB 0 NO MORE TABLES
0332 dbfc 00 00 FDB 0 NO MORE TABLES
0333 dbfe 00 00 FDB 0 NO MORE TABLES
0334 dc00 00 00 FDB 0 NO MORE TABLES
0335 dc02 00 00 FDB 0 NO MORE TABLES (SECONDARY FNS =0)
0336
0337 * COPYRIGHT MESSAGES
0338 dc04 36 38 30 39 20 45 LA147 FCC "6809 EXTENDED BASIC"
58 54 45 4e 44 45
44 20 42 41 53 49
43
0339 dc17 0d FCB CR
0340 dc18 28 43 29 20 31 39 FCC "(C) 1982 BY MICROSOFT"
38 32 20 42 59 20
4d 49 43 52 4f 53
4f 46 54
0341 dc2d 0d 0d LA156 FCB CR,CR
0342 dc2f 00 LA165 FCB $00
0343
0344
0345 dc30 34 16 LA35F PSHS X,B,A SAVE REGISTERS
0346 dc32 9e 76 LDX LPTCFW TAB FIELD WIDTH AND TAB ZONE
0347 dc34 dc 78 LDD LPTWID PRINTER WIDTH AND POSITION
0348 dc36 9f 6a LA37C STX DEVCFW SAVE TAB FIELD WIDTH AND ZONE
0349 dc38 d7 6c STB DEVPOS SAVE PRINT POSITION
0350 dc3a 97 6d STA DEVWID SAVE PRINT WIDTH
0351 dc3c 35 96 PULS A,B,X,PC RESTORE REGISTERS
0352
0353 * THIS IS THE ROUTINE THAT GETS AN INPUT LINE FOR BASIC
0354 * EXIT WITH BREAK KEY: CARRY = 1
0355 * EXIT WITH ENTER KEY: CARRY = 0
0356 LA38D
0357 dc3e 0f 73 LA390 CLR IKEYIM RESET BREAK CHECK KEY TEMP KEY STORAGE
0358 dc40 8e 00 f4 LDX #LINBUF+1 INPUT LINE BUFFER
0359 dc43 c6 01 LDB #1 ACCB CHAR COUNTER: SET TO 1 TO ALLOW A
0360 * BACKSPACE AS FIRST CHARACTER
0361 dc45 bd db 00 LA39A JSR LA171 GO GET A CHARACTER FROM CONSOLE IN
0362 dc48 81 08 CMPA #BS BACKSPACE
0363 dc4a 26 07 BNE LA3B4 NO
0364 dc4c 5a DECB YES - DECREMENT CHAR COUNTER
0365 dc4d 27 ef BEQ LA390 BRANCH IF BACK AT START OF LINE AGAIN
0366 dc4f 30 1f LEAX -1,X DECREMENT BUFFER POINTER
0367 dc51 20 34 BRA LA3E8 ECHO CHAR TO SCREEN
0368 dc53 81 15 LA3B4 CMPA #$15 SHIFT RIGHT ARROW?
0369 dc55 26 0a BNE LA3C2 NO
0370 * YES, RESET BUFFER TO BEGINNING AND ERASE CURRENT LINE
0371 dc57 5a LA3B8 DECB DEC CHAR CTR
0372 dc58 27 e4 BEQ LA390 GO BACK TO START IF CHAR CTR = 0
0373 dc5a 86 08 LDA #BS BACKSPACE?
0374 dc5c bd db 14 JSR PUTCHR SEND TO CONSOLE OUT (SCREEN)
0375 dc5f 20 f6 BRA LA3B8 KEEP GOING
0376 dc61 81 03 LA3C2 CMPA #3 BREAK KEY?
0377 dc63 1a 01 ORCC #1 SET CARRY FLAG
0378 dc65 27 05 BEQ LA3CD BRANCH IF BREAK KEY DOWN
0379 dc67 81 0d LA3C8 CMPA #CR ENTER KEY?
0380 dc69 26 0d BNE LA3D9 NO
0381 dc6b 4f LA3CC CLRA CLEAR CARRY FLAG IF ENTER KEY - END LINE ENTRY
0382 dc6c 34 01 LA3CD PSHS CC SAVE CARRY FLAG
0383 dc6e bd eb a5 JSR LB958 SEND CR TO SCREEN
0384 dc71 6f 84 CLR ,X MAKE LAST BYTE IN INPUT BUFFER = 0
0385 dc73 8e 00 f3 LDX #LINBUF RESET INPUT BUFFER POINTER
0386 dc76 35 81 PULS CC,PC RESTORE CARRY FLAG
0387
0388 * INSERT A CHARACTER INTO THE BASIC LINE INPUT BUFFER
0389 dc78 81 20 LA3D9 CMPA #$20 IS IT CONTROL CHAR?
0390 dc7a 25 c9 BLO LA39A BRANCH IF CONTROL CHARACTER
0391 dc7c 81 7b CMPA #'z+1 *
0392 dc7e 24 c5 BCC LA39A * IGNORE IF > LOWER CASE Z
0393 dc80 c1 fa CMPB #LBUFMX HAVE 250 OR MORE CHARACTERS BEEN ENTERED?
0394 dc82 24 c1 BCC LA39A YES, IGNORE ANY MORE
0395 dc84 a7 80 STA ,X+ PUT IT IN INPUT BUFFER
0396 dc86 5c INCB INCREMENT CHARACTER COUNTER
0397 dc87 bd db 14 LA3E8 JSR PUTCHR ECHO IT TO SCREEN
0398 dc8a 20 b9 BRA LA39A GO SET SOME MORE
0399
0400
0401 * EXEC
0402 dc8c 27 05 EXEC BEQ LA545 BRANCH IF NO ARGUMENT
0403 dc8e bd e9 c1 JSR LB73D EVALUATE ARGUMENT - ARGUMENT RETURNED IN X
0404 dc91 9f 7a STX EXECJP STORE X TO EXEC JUMP ADDRESS
0405 dc93 6e 9f 00 7a LA545 JMP [EXECJP] GO DO IT
0406
0407 * BREAK CHECK
0408 dc97 7e e0 a3 LA549 JMP LADEB GO DO BREAK KEY CHECK
0409
0410 * INKEY$
0411 dc9a 96 73 INKEY LDA IKEYIM WAS A KEY DOWN IN THE BREAK CHECK?
0412 dc9c 26 03 BNE LA56B YES
0413 dc9e bd db 05 JSR KEYIN GO GET A KEY
0414 dca1 0f 73 LA56B CLR IKEYIM CLEAR INKEY RAM IMAGE
0415 dca3 97 53 STA FPA0+3 STORE THE KEY IN FPA0
0416 dca5 10 26 0c 6a LBNE LB68F CONVERT FPA0+3 TO A STRING
0417 dca9 97 56 STA STRDES SET LENGTH OF STRING = 0 IF NO KEY DOWN
0418 dcab 7e e9 1f JMP LB69B PUT A NULL STRING ONTO THE STRING STACK
0419
0420 * MOVE ACCB BYTES FROM (X) TO (U)
0421 dcae a6 80 LA59A LDA ,X+ GET BYTE FROM X
0422 dcb0 a7 c0 STA ,U+ STORE IT AT U
0423 dcb2 5a DECB MOVED ALL BYTES?
0424 dcb3 26 f9 BNE LA59A NO
0425 dcb5 39 LA5A1 RTS
0426
0427 dcb6 39 LA5C4 RTS
0428
0429 ** THIS ROUTINE WILL SCAN OFF THE FILE NAME FROM A BASIC LINE
0430 ** AND RETURN A SYNTAX ERROR IF THERE ARE ANY CHARACTERS
0431 ** FOLLOWING THE END OF THE NAME
0432 dcb7 9d 82 LA5C7 JSR GETCCH GET CURRENT INPUT CHAR FROM BASIC LINE
0433 dcb9 27 fb LA5C9 BEQ LA5C4 RETURN IF END OF LINE
0434 dcbb 7e e5 00 JMP LB277 SYNTAX ERROR IF ANY MORE CHARACTERS
0435 * IRQ SERVICE
0436 BIRQSV
0437 dcbe 3b LA9C5 RTI RETURN FROM INTERRUPT
0438
0439 * SET CARRY IF NUMERIC - RETURN WITH
0440 * ZERO FLAG SET IF ACCA = 0 OR 3A(:) - END
0441 * OF BASIC LINE OR SUB LINE
0442 dcbf 81 3a BROMHK CMPA #'9+1 IS THIS CHARACTER >=(ASCII 9)+1?
0443 dcc1 24 0a BHS LAA28 BRANCH IF > 9; Z SET IF = COLON
0444 dcc3 81 20 CMPA #SPACE SPACE?
0445 dcc5 26 02 BNE LAA24 NO - SET CARRY IF NUMERIC
0446 dcc7 0e 7c JMP GETNCH IF SPACE, GET NECT CHAR (IGNORE SPACES)
0447 dcc9 80 30 LAA24 SUBA #'0 * SET CARRY IF
0448 dccb 80 d0 SUBA #-'0 * CHARACTER > ASCII 0
0449 dccd 39 LAA28 RTS
0450
0451 * DISPATCH TABLE FOR SECONDARY FUNCTIONS
0452 * TOKENS ARE PRECEEDED BY $FF
0453 * FIRST SET ALWAYS HAS ONE PARAMETER
0454 FUNC_TAB
0455 dcce ee c3 LAA29 FDB SGN SGN
0456 dcd0 ef 37 FDB INT INT
0457 dcd2 ee dc FDB ABS ABS
0458 dcd4 00 ad FDB USRJMP USR
0459 0083 TOK_USR EQU *-FUNC_TAB/2+$7F
0460 ff83 TOK_FF_USR EQU *-FUNC_TAB/2+$FF7F
0461 dcd6 f1 68 FDB RND RND
0462 dcd8 f1 bd FDB SIN SIN
0463 dcda e9 d4 FDB PEEK PEEK
0464 dcdc e9 05 FDB LEN LEN
0465 dcde e7 81 FDB STR STR$
0466 dce0 e9 9a FDB VAL VAL
0467 dce2 e9 24 FDB ASC ASC
0468 dce4 e9 10 FDB CHR CHR$
0469 dce6 f2 6d FDB ATN ATN
0470 dce8 f2 35 FDB COS COS
0471 dcea f2 3e FDB TAN TAN
0472 dcec f3 af FDB EXP EXP
0473 dcee f3 e1 FDB FIX FIX
0474 dcf0 f3 03 FDB LOG LOG
0475 dcf2 f5 69 FDB POS POS
0476 dcf4 f3 3d FDB SQR SQR
0477 dcf6 fa 3b FDB HEXDOL HEX$
0478 * LEFT, RIGHT AND MID ARE TREATED SEPARATELY
0479 dcf8 e9 2f FDB LEFT LEFT$
0480 0095 TOK_LEFT EQU *-FUNC_TAB/2+$7F
0481 dcfa e9 4c FDB RIGHT RIGHT$
0482 dcfc e9 53 FDB MID MID$
0483 0097 TOK_MID EQU *-FUNC_TAB/2+$7F
0484 * REMAINING FUNCTIONS
0485 dcfe dc 9a FDB INKEY INKEY$
0486 0098 TOK_INKEY EQU *-FUNC_TAB/2+$7F
0487 dd00 e7 72 FDB MEM MEM
0488 dd02 f5 71 FDB VARPT VARPTR
0489 dd04 f6 31 FDB INSTR INSTR
0490 dd06 f6 01 FDB STRING STRING$
0491 001d NUM_SEC_FNS EQU *-FUNC_TAB/2
0492
0493 * THIS TABLE CONTAINS PRECEDENCES AND DISPATCH ADDRESSES FOR ARITHMETIC
0494 * AND LOGICAL OPERATORS - THE NEGATION OPERATORS DO NOT ACT ON TWO OPERANDS
0495 * S0 THEY ARE NOT LISTED IN THIS TABLE. THEY ARE TREATED SEPARATELY IN THE
0496 * EXPRESSION EVALUATION ROUTINE. THEY ARE:
0497 * UNARY NEGATION (-), PRECEDENCE &7D AND LOGICAL NEGATION (NOT), PRECEDENCE $5A
0498 * THE RELATIONAL OPERATORS < > = ARE ALSO NOT LISTED, PRECEDENCE $64.
0499 * A PRECEDENCE VALUE OF ZERO INDICATES END OF EXPRESSION OR PARENTHESES
0500 *
0501 dd08 79 LAA51 FCB $79
0502 dd09 ec 0e FDB LB9C5 +
0503 dd0b 79 FCB $79
0504 dd0c ec 05 FDB LB9BC -
0505 dd0e 7b FCB $7B
0506 dd0f ed 15 FDB LBACC *
0507 dd11 7b FCB $7B
0508 dd12 ed da FDB LBB91 /
0509 dd14 7f FCB $7F
0510 dd15 f3 46 FDB L8489 EXPONENTIATION
0511 dd17 50 FCB $50
0512 dd18 e5 59 FDB LB2D5 AND
0513 dd1a 46 FCB $46
0514 dd1b e5 58 FDB LB2D4 OR
0515
0516 * THIS IS THE RESERVED WORD TABLE
0517 * FIRST PART OF THE TABLE CONTAINS EXECUTABLE COMMANDS
0518 dd1d 46 4f LAA66 FCC "FO" 80
0519 dd1f d2 FCB $80+'R'
0520 dd20 47 FCC "G" 81
0521 dd21 cf FCB $80+'O'
0522 0081 TOK_GO EQU $81
0523 dd22 52 45 FCC "RE" 82
0524 dd24 cd FCB $80+'M'
0525 dd25 a7 FCB ''+$80 83
0526 dd26 45 4c 53 FCC "ELS" 84
0527 dd29 c5 FCB $80+'E'
0528 dd2a 49 FCC "I" 85
0529 dd2b c6 FCB $80+'F'
0530 dd2c 44 41 54 FCC "DAT" 86
0531 dd2f c1 FCB $80+'A'
0532 dd30 50 52 49 4e FCC "PRIN" 87
0533 dd34 d4 FCB $80+'T'
0534 dd35 4f FCC "O" 88
0535 dd36 ce FCB $80+'N'
0536 dd37 49 4e 50 55 FCC "INPU" 89
0537 dd3b d4 FCB $80+'T'
0538 dd3c 45 4e FCC "EN" 8A
0539 dd3e c4 FCB $80+'D'
0540 dd3f 4e 45 58 FCC "NEX" 8B
0541 dd42 d4 FCB $80+'T'
0542 dd43 44 49 FCC "DI" 8C
0543 dd45 cd FCB $80+'M'
0544 dd46 52 45 41 FCC "REA" 8D
0545 dd49 c4 FCB $80+'D'
0546 dd4a 52 55 FCC "RU" 8E
0547 dd4c ce FCB $80+'N'
0548 dd4d 52 45 53 54 4f 52 FCC "RESTOR" 8F
0549 dd53 c5 FCB $80+'E'
0550 dd54 52 45 54 55 52 FCC "RETUR" 90
0551 dd59 ce FCB $80+'N'
0552 dd5a 53 54 4f FCC "STO" 91
0553 dd5d d0 FCB $80+'P'
0554 dd5e 50 4f 4b FCC "POK" 92
0555 dd61 c5 FCB $80+'E'
0556 dd62 43 4f 4e FCC "CON" 93
0557 dd65 d4 FCB $80+'T'
0558 dd66 4c 49 53 FCC "LIS" 94
0559 dd69 d4 FCB $80+'T'
0560 dd6a 43 4c 45 41 FCC "CLEA" 95
0561 dd6e d2 FCB $80+'R'
0562 dd6f 4e 45 FCC "NE" 96
0563 dd71 d7 FCB $80+'W'
0564 dd72 45 58 45 FCC "EXE" 97
0565 dd75 c3 FCB $80+'C'
0566 dd76 54 52 4f FCC "TRO" 98
0567 dd79 ce FCB $80+'N'
0568 dd7a 54 52 4f 46 FCC "TROF" 99
0569 dd7e c6 FCB $80+'F'
0570 dd7f 44 45 FCC "DE" 9A
0571 dd81 cc FCB $80+'L'
0572 dd82 44 45 FCC "DE" 9B
0573 dd84 c6 FCB $80+'F'
0574 dd85 4c 49 4e FCC "LIN" 9C
0575 dd88 c5 FCB $80+'E'
0576 dd89 52 45 4e 55 FCC "RENU" 9D
0577 dd8d cd FCB $80+'M'
0578 dd8e 45 44 49 FCC "EDI" 9E
0579 dd91 d4 FCB $80+'T'
0580 * END OF EXECUTABLE COMMANDS. THE REMAINDER OF THE TABLE ARE NON-EXECUTABLE TOKENS
0581 dd92 54 41 42 FCC "TAB" 9F
0582 dd95 a8 FCB $80+'('
0583 009f TOK_TAB EQU $9F
0584 dd96 54 FCC "T" A0
0585 dd97 cf FCB $80+'O'
0586 00a0 TOK_TO EQU $A0
0587 dd98 53 55 FCC "SU" A1
0588 dd9a c2 FCB $80+'B'
0589 00a1 TOK_SUB EQU $A1
0590 dd9b 54 48 45 FCC "THE" A2
0591 dd9e ce FCB $80+'N'
0592 00a2 TOK_THEN EQU $A2
0593 dd9f 4e 4f FCC "NO" A3
0594 dda1 d4 FCB $80+'T'
0595 00a3 TOK_NOT EQU $A3
0596 dda2 53 54 45 FCC "STE" A4
0597 dda5 d0 FCB $80+'P'
0598 00a4 TOK_STEP EQU $A4
0599 dda6 4f 46 FCC "OF" A5
0600 dda8 c6 FCB $80+'F'
0601 dda9 ab FCB '++$80 A6
0602 00a6 TOK_PLUS EQU $A6
0603 ddaa ad FCB '-+$80 A7
0604 00a7 TOK_MINUS EQU $A7
0605 ddab aa FCB '*+$80 A8
0606 ddac af FCB '/+$80 A9
0607 ddad de FCB '^+$80 AA
0608 ddae 41 4e FCC "AN" AB
0609 ddb0 c4 FCB $80+'D'
0610 ddb1 4f FCC "O" AC
0611 ddb2 d2 FCB $80+'R'
0612 ddb3 be FCB '>+$80 AD
0613 00ad TOK_GREATER EQU $AD
0614 ddb4 bd FCB '=+$80 AE
0615 00ae TOK_EQUALS EQU $AE
0616 ddb5 bc FCB '<+$80 AF
0617 ddb6 46 FCC "F" B0
0618 ddb7 ce FCB $80+'N'
0619 00b0 TOK_FN EQU $B0
0620 ddb8 55 53 49 4e FCC "USIN" B1
0621 ddbc c7 FCB $80+'G'
0622 00b1 TOK_USING EQU $B1
0623 *
0624
0625 * FIRST SET ALWAYS HAS ONE PARAMETER
0626 ddbd 53 47 LAB1A FCC "SG" 80
0627 ddbf ce FCB $80+'N'
0628 ddc0 49 4e FCC "IN" 81
0629 ddc2 d4 FCB $80+'T'
0630 ddc3 41 42 FCC "AB" 82
0631 ddc5 d3 FCB $80+'S'
0632 ddc6 55 53 FCC "US" 83
0633 ddc8 d2 FCB $80+'R'
0634 ddc9 52 4e FCC "RN" 84
0635 ddcb c4 FCB $80+'D'
0636 ddcc 53 49 FCC "SI" 85
0637 ddce ce FCB $80+'N'
0638 ddcf 50 45 45 FCC "PEE" 86
0639 ddd2 cb FCB $80+'K'
0640 ddd3 4c 45 FCC "LE" 87
0641 ddd5 ce FCB $80+'N'
0642 ddd6 53 54 52 FCC "STR" 88
0643 ddd9 a4 FCB $80+'$'
0644 ddda 56 41 FCC "VA" 89
0645 dddc cc FCB $80+'L'
0646 dddd 41 53 FCC "AS" 8A
0647 dddf c3 FCB $80+'C'
0648 dde0 43 48 52 FCC "CHR" 8B
0649 dde3 a4 FCB $80+'$'
0650 dde4 41 54 FCC "AT" 8C
0651 dde6 ce FCB $80+'N'
0652 dde7 43 4f FCC "CO" 8D
0653 dde9 d3 FCB $80+'S'
0654 ddea 54 41 FCC "TA" 8E
0655 ddec ce FCB $80+'N'
0656 dded 45 58 FCC "EX" 8F
0657 ddef d0 FCB $80+'P'
0658 ddf0 46 49 FCC "FI" 90
0659 ddf2 d8 FCB $80+'X'
0660 ddf3 4c 4f FCC "LO" 91
0661 ddf5 c7 FCB $80+'G'
0662 ddf6 50 4f FCC "PO" 92
0663 ddf8 d3 FCB $80+'S'
0664 ddf9 53 51 FCC "SQ" 93
0665 ddfb d2 FCB $80+'R'
0666 ddfc 48 45 58 FCC "HEX" 94
0667 ddff a4 FCB $80+'$'
0668 * LEFT, RIGHT AND MID ARE TREATED SEPARATELY
0669 de00 4c 45 46 54 FCC "LEFT" 95
0670 de04 a4 FCB $80+'$'
0671 de05 52 49 47 48 54 FCC "RIGHT" 96
0672 de0a a4 FCB $80+'$'
0673 de0b 4d 49 44 FCC "MID" 97
0674 de0e a4 FCB $80+'$'
0675 * REMAINING FUNCTIONS
0676 de0f 49 4e 4b 45 59 FCC "INKEY" 98
0677 de14 a4 FCB $80+'$'
0678 de15 4d 45 FCC "ME" 99
0679 de17 cd FCB $80+'M'
0680 de18 56 41 52 50 54 FCC "VARPT" 9A
0681 de1d d2 FCB $80+'R'
0682 de1e 49 4e 53 54 FCC "INST" 9B
0683 de22 d2 FCB $80+'R'
0684 de23 53 54 52 49 4e 47 FCC "STRING" 9C
0685 de29 a4 FCB $80+'$'
0686
0687 *
0688 * DISPATCH TABLE FOR COMMANDS TOKEN #
0689 CMD_TAB
0690 de2a df e8 LAB67 FDB FOR 80
0691 de2c e1 33 FDB GO 81
0692 de2e e1 90 FDB REM 82
0693 0082 TOK_REM EQU *-CMD_TAB/2+$7F
0694 de30 e1 90 FDB REM 83 (')
0695 0083 TOK_SNGL_Q EQU *-CMD_TAB/2+$7F
0696 de32 e1 90 FDB REM 84 (ELSE)
0697 0084 TOK_ELSE EQU *-CMD_TAB/2+$7F
0698 de34 e1 c1 FDB IF 85
0699 0085 TOK_IF EQU *-CMD_TAB/2+$7F
0700 de36 e1 8d FDB DATA 86
0701 0086 TOK_DATA EQU *-CMD_TAB/2+$7F
0702 de38 eb 6a FDB PRINT 87
0703 0087 TOK_PRINT EQU *-CMD_TAB/2+$7F
0704 de3a e1 ef FDB ON 88
0705 de3c e2 9c FDB INPUT 89
0706 0089 TOK_INPUT EQU *-CMD_TAB/2+$7F
0707 de3e e0 ba FDB END 8A
0708 de40 e3 81 FDB NEXT 8B
0709 de42 e5 d2 FDB DIM 8C
0710 de44 e2 d6 FDB READ 8D
0711 de46 e1 28 FDB RUN 8E
0712 de48 e0 9c FDB RESTOR 8F
0713 de4a e1 6d FDB RETURN 90
0714 de4c e0 be FDB STOP 91
0715 de4e e9 db FDB POKE 92
0716 de50 e0 e3 FDB CONT 93
0717 de52 e9 e2 FDB LIST 94
0718 de54 e0 f4 FDB CLEAR 95
0719 de56 df b8 FDB NEW 96
0720 de58 dc 8c FDB EXEC 97
0721 de5a f5 64 FDB TRON 98
0722 de5c f5 65 FDB TROFF 99
0723 de5e f7 e0 FDB DEL 9A
0724 de60 f7 24 FDB DEF 9B
0725 de62 fe ce FDB LINE 9C
0726 de64 f8 6a FDB RENUM 9D
0727 de66 f3 f0 FDB EDIT 9E
0728 009e TOK_HIGH_EXEC EQU *-CMD_TAB/2+$7F
0729
0730 * ERROR MESSAGES AND THEIR NUMBERS AS USED INTERNALLY
0731 de68 4e 46 LABAF FCC "NF" 0 NEXT WITHOUT FOR
0732 de6a 53 4e FCC "SN" 1 SYNTAX ERROR
0733 de6c 52 47 FCC "RG" 2 RETURN WITHOUT GOSUB
0734 de6e 4f 44 FCC "OD" 3 OUT OF DATA
0735 de70 46 43 FCC "FC" 4 ILLEGAL FUNCTION CALL
0736 de72 4f 56 FCC "OV" 5 OVERFLOW
0737 de74 4f 4d FCC "OM" 6 OUT OF MEMORY
0738 de76 55 4c FCC "UL" 7 UNDEFINED LINE NUMBER
0739 de78 42 53 FCC "BS" 8 BAD SUBSCRIPT
0740 de7a 44 44 FCC "DD" 9 REDIMENSIONED ARRAY
0741 de7c 2f 30 FCC "/0" 10 DIVISION BY ZERO
0742 de7e 49 44 FCC "ID" 11 ILLEGAL DIRECT STATEMENT
0743 de80 54 4d FCC "TM" 12 TYPE MISMATCH
0744 de82 4f 53 FCC "OS" 13 OUT OF STRING SPACE
0745 de84 4c 53 FCC "LS" 14 STRING TOO LONG
0746 de86 53 54 FCC "ST" 15 STRING FORMULA TOO COMPLEX
0747 de88 43 4e FCC "CN" 16 CAN'T CONTINUE
0748 de8a 46 44 FCC "FD" 17 BAD FILE DATA
0749 de8c 41 4f FCC "AO" 18 FILE ALREADY OPEN
0750 de8e 44 4e FCC "DN" 19 DEVICE NUMBER ERROR
0751 de90 49 4f FCC "IO" 20 I/O ERROR
0752 de92 46 4d FCC "FM" 21 BAD FILE MODE
0753 de94 4e 4f FCC "NO" 22 FILE NOT OPEN
0754 de96 49 45 FCC "IE" 23 INPUT PAST END OF FILE
0755 de98 44 53 FCC "DS" 24 DIRECT STATEMENT IN FILE
0756 * ADDITIONAL ERROR MESSAGES ADDED BY EXTENDED BASIC
0757 de9a 55 46 L890B FCC "UF" 25 UNDEFINED FUNCTION (FN) CALL
0758 de9c 4e 45 L890D FCC "NE" 26 FILE NOT FOUND
0759
0760 de9e 20 45 52 52 4f 52 LABE1 FCC " ERROR"
0761 dea4 00 FCB $00
0762 dea5 20 49 4e 20 LABE8 FCC " IN "
0763 dea9 00 FCB $00
0764 deaa 0d LABED FCB CR
0765 deab 4f 4b LABEE FCC "OK"
0766 dead 0d 00 FCB CR,$00
0767 deaf 0d LABF2 FCB CR
0768 deb0 42 52 45 41 4b FCC "BREAK"
0769 deb5 00 FCB $00
0770
0771 * SEARCH THE STACK FOR ‘GOSUB/RETURN’ OR ‘FOR/NEXT’ DATA.
0772 * THE ‘FOR/NEXT’ INDEX VARIABLE DESCRIPTOR ADDRESS BEING
0773 * SOUGHT IS STORED IN VARDES. EACH BLOCK OF FOR/NEXT DATA IS 18
0774 * BYTES WITH A $80 LEADER BYTE AND THE GOSUB/RETURN DATA IS 5 BYTES
0775 * WITH AN $A6 LEADER BYTE. THE FIRST NON "FOR/NEXT" DATA
0776 * IS CONSIDERED ‘GOSUB/RETURN’
0777 deb6 30 64 LABF9 LEAX 4,S POINT X TO 3RD ADDRESS ON STACK - IGNORE THE
0778 * FIRST TWO RETURN ADDRESSES ON THE STACK
0779 deb8 c6 12 LABFB LDB #18 18 BYTES SAVED ON STACK FOR EACH ‘FOR’ LOOP
0780 deba 9f 0f STX TEMPTR SAVE POINTER
0781 debc a6 84 LDA ,X GET 1ST BYTE
0782 debe 80 80 SUBA #$80 * CHECK FOR TYPE OF STACK JUMP FOUND
0783 dec0 26 15 BNE LAC1A * BRANCH IF NOT ‘FOR/NEXT’
0784 dec2 ae 01 LDX 1,X = GET INDEX VARIABLE DESCRIPTOR
0785 dec4 9f 11 STX TMPTR1 = POINTER AND SAVE IT IN TMPTR1
0786 dec6 9e 3b LDX VARDES GET INDEX VARIABLE BEING SEARCHED FOR
0787 dec8 27 09 BEQ LAC16 BRANCH IF DEFAULT INDEX VARIABLE - USE THE
0788 * FIRST ‘FOR/NEXT’ DATA FOUND ON STACK
0789 * IF NO INDEX VARIABLE AFTER ‘NEXT’
0790 deca 9c 11 CMPX TMPTR1 DOES THE STACK INDEX MATCH THE ONE
0791 * BEING SEARCHED FOR?
0792 decc 27 09 BEQ LAC1A YES
0793 dece 9e 0f LDX TEMPTR * RESTORE INITIAL POINTER, ADD
0794 ded0 3a ABX * 18 TO IT AND LOOK FOR
0795 ded1 20 e5 BRA LABFB * NEXT BLOCK OF DATA
0796 ded3 9e 11 LAC16 LDX TMPTR1 = GET 1ST INDEX VARIABLE FOUND AND
0797 ded5 9f 3b STX VARDES = SAVE AS ‘NEXT’ INDEX
0798 ded7 9e 0f LAC1A LDX TEMPTR POINT X TO START OF ‘FOR/NEXT’ DATA
0799 ded9 4d TSTA SET ZERO FLAG IF ‘FOR/NEXT’ DATA
0800 deda 39 RTS
0801 * CHECK FOR MEMORY SPACE FOR NEW TOP OF
0802 * ARRAYS AND MOVE ARRAYS TO NEW LOCATION
0803 dedb 8d 17 LAC1E BSR LAC37 ACCD = NEW BOTTOM OF FREE RAM - IS THERE
0804 * ROOM FOR THE STACK?
0805 * MOVE BYTES FROM V43(X) TO V41(U) UNTIL (X) = V47 AND
0806 * SAVE FINAL VALUE OF U IN V45
0807 dedd de 41 LAC20 LDU V41 POINT U TO DESTINATION ADDRESS (V41)
0808 dedf 33 41 LEAU 1,U ADD ONE TO U - COMPENSATE FOR FIRST PSHU
0809 dee1 9e 43 LDX V43 POINT X TO SOURCE ADDRESS (V43)
0810 dee3 30 01 LEAX 1,X ADD ONE - COMPENSATE FOR FIRST LDA ,X
0811 dee5 a6 82 LAC28 LDA ,-X GRAB A BYTE FROM SOURCE
0812 dee7 36 02 PSHU A MOVE IT TO DESTINATION
0813 dee9 9c 47 CMPX V47 DONE?
0814 deeb 26 f8 BNE LAC28 NO - KEEP MOVING BYTES
0815 deed df 45 STU V45 SAVE FINAL DESTINATION ADDRESS
0816 deef 39 LAC32 RTS
0817 * CHECK TO SEE IF THERE IS ROOM TO STORE 2*ACCB
0818 * BYTES IN FREE RAM - OM ERROR IF NOT
0819 def0 4f LAC33 CLRA * ACCD CONTAINS NUMBER OF EXTRA
0820 def1 58 ASLB * BYTES TO PUT ON STACK
0821 def2 d3 1f ADDD ARYEND END OF PROGRAM AND VARIABLES
0822 def4 c3 00 3a LAC37 ADDD #STKBUF ADD STACK BUFFER - ROOM FOR STACK?
0823 def7 25 08 BCS LAC44 BRANCH IF GREATER THAN $FFFF
0824 def9 10 df 17 STS BOTSTK CURRENT NEW BOTTOM OF STACK STACK POINTER
0825 defc 10 93 17 CMPD BOTSTK ARE WE GOING TO BE BELOW STACK?
0826 deff 25 ee BCS LAC32 YES - NO ERROR
0827 df01 c6 0c LAC44 LDB #6*2 OUT OF MEMORY ERROR
0828
0829 * ERROR SERVICING ROUTINE
0830 df03 bd df d4 LAC46 JSR LAD33 RESET STACK, STRING STACK, CONTINUE POINTER
0831 df06 bd eb a9 JSR LB95C SEND A CR TO SCREEN
0832 df09 bd eb f8 JSR LB9AF SEND A ‘?‘ TO SCREEN
0833 df0c 8e de 68 LDX #LABAF POINT TO ERROR TABLE
0834 df0f 3a LAC60 ABX ADD MESSAGE NUMBER OFFSET
0835 df10 8d 31 BSR LACA0 * GET TWO CHARACTERS FROM X AND
0836 df12 8d 2f BSR LACA0 * SEND TO CONSOLE OUT (SCREEN)
0837 df14 8e de 9d LDX #LABE1-1 POINT TO "ERROR" MESSAGE
0838 df17 bd eb e5 LAC68 JSR LB99C PRINT MESSAGE POINTED TO BY X
0839 df1a 96 68 LDA CURLIN GET CURRENT LINE NUMBER (CURL IN)
0840 df1c 4c INCA TEST FOR DIRECT MODE
0841 df1d 27 03 BEQ LAC73 BRANCH IF DIRECT MODE
0842 df1f bd f0 0e JSR LBDC5 PRINT ‘IN ****‘
0843
0844 * THIS IS THE MAIN LOOP OF BASIC WHEN IN DIRECT MODE
0845 df22 bd eb a9 LAC73 JSR LB95C MOVE CURSOR TO START OF LINE
0846 df25 8e de aa LDX #LABED POINT X TO ‘OK’, CR MESSAGE
0847 df28 bd eb e5 JSR LB99C PRINT ‘OK’, CR
0848 df2b bd dc 3e LAC7C JSR LA390 GO GET AN INPUT LINE
0849 df2e ce ff ff LDU #$FFFF THE LINE NUMBER FOR DIRECT MODE IS $FFFF
0850 df31 df 68 STU CURLIN SAVE IT IN CURLIN
0851 df33 25 f6 BCS LAC7C BRANCH IF LINE INPUT TERMINATED BY BREAK
0852 df35 9f 83 STX CHARAD SAVE (X) AS CURRENT INPUT POINTER - THIS WILL
0853 * ENABLE THE ‘LIVE KEYBOARD’ (DIRECT) MODE. THE
0854 * LINE JUST ENTERED WILL BE INTERPRETED
0855 df37 9d 7c JSR GETNCH GET NEXT CHARACTER FROM BASIC
0856 df39 27 f0 BEQ LAC7C NO LINE INPUT - GET ANOTHER LINE
0857 df3b 25 0b BCS LACA5 BRANCH IF NUMER1C - THERE WAS A LINE NUMBER BEFORE
0858 * THE STATEMENT ENTERED, SO THIS STATEMENT
0859 * WILL BE MERGED INTO THE BASIC PROGRAM
0860 df3d bd ea 97 JSR LB821 GO CRUNCH LINE
0861 df40 7e e0 71 JMP LADC0 GO EXECUTE THE STATEMENT (LIVE KEYBOARD)
0862 *
0863 df43 a6 80 LACA0 LDA ,X+ GET A CHARACTER
0864 df45 7e eb fa JMP LB9B1 SEND TO CONSOLE OUT
0865 * TAKE A LINE FROM THE LINE INPUT BUFFER
0866 * AND INSERT IT INTO THE BASIC PROGRAM
0867 df48 bd e2 14 LACA5 JSR LAF67 CONVERT LINE NUMBER TO BINARY
0868 df4b 9e 2b LACA8 LDX BINVAL GET CONVERTED LINE NUMBER
0869 df4d 9f f1 STX LINHDR STORE IT IN LINE INPUT HEADER
0870 df4f bd ea 97 JSR LB821 GO CRUNCH THE LINE
0871 df52 d7 03 STB TMPLOC SAVE LINE LENGTH
0872 df54 8d 4c BSR LAD01 FIND OUT WHERE TO INSERT LINE
0873 df56 25 12 BCS LACC8 BRANCH IF LINE NUMBER DOES NOT ALREADY EXIST
0874 df58 dc 47 LDD V47 GET ABSOLUTE ADDRESS OF LINE NUMBER
0875 df5a a3 84 SUBD ,X SUBTRACT ADDRESS OF NEXT LINE NUMBER
0876 df5c d3 1b ADDD VARTAB * ADD TO CURRENT END OF PROGRAM - THIS WILL REMOVE
0877 df5e dd 1b STD VARTAB * THE LENGTH OF THIS LINE NUMBER FROM THE PROGRAM
0878 df60 ee 84 LDU ,X POINT U TO ADDRESS OF NEXT LINE NUMBER
0879 * DELETE OLD LINE FROM BASIC PROGRAM
0880 df62 37 02 LACC0 PULU A GET A BYTE FROM WHAT’S LEFT OF PROGRAM
0881 df64 a7 80 STA ,X+ MOVE IT DOWN
0882 df66 9c 1b CMPX VARTAB COMPARE TO END OF BASIC PROGRAM
0883 df68 26 f8 BNE LACC0 BRANCH IF NOT AT END
0884 df6a 96 f3 LACC8 LDA LINBUF * CHECK TO SEE IF THERE IS A LINE IN
0885 df6c 27 1c BEQ LACE9 * THE BUFFER AND BRANCH IF NONE
0886 df6e dc 1b LDD VARTAB = SAVE CURRENT END OF
0887 df70 dd 43 STD V43 = PROGRAM IN V43
0888 df72 db 03 ADDB TMPLOC * ADD LENGTH OF CRUNCHED LINE,
0889 df74 89 00 ADCA #0 * PROPOGATE CARRY AND SAVE NEW END
0890 df76 dd 41 STD V41 * OF PROGRAM IN V41
0891 df78 bd de db JSR LAC1E = MAKE SURE THERE’S ENOUGH RAM FOR THIS
0892 * = LINE & MAKE A HOLE IN BASIC FOR NEW LINE
0893 df7b ce 00 ef LDU #LINHDR-2 POINT U TO LINE TO BE INSERTED
0894 df7e 37 02 LACDD PULU A GET A BYTE FROM NEW LINE
0895 df80 a7 80 STA ,X+ INSERT IT IN PROGRAM
0896 df82 9c 45 CMPX V45 * COMPARE TO ADDRESS OF END OF INSERTED
0897 df84 26 f8 BNE LACDD * LINE AND BRANCH IF NOT DONE
0898 df86 9e 41 LDX V41 = GET AND SAVE
0899 df88 9f 1b STX VARTAB = END OF PROGRAM
0900 df8a 8d 36 LACE9 BSR LAD21 RESET INPUT POINTER, CLEAR VARIABLES, INITIALIZE
0901 df8c 8d 02 BSR LACEF ADJUST START OF NEXT LINE ADDRESSES
0902 df8e 20 9b BRA LAC7C REENTER BASIC’S INPUT LOOP
0903 * COMPUTE THE START OF NEXT LINE ADDRESSES FOR THE BASIC PROGRAM
0904 df90 9e 19 LACEF LDX TXTTAB POINT X TO START OF PROGRAM
0905 df92 ec 84 LACF1 LDD ,X GET ADDRESS OF NEXT LINE
0906 df94 27 21 BEQ LAD16 RETURN IF END OF PROGRAM
0907 df96 33 04 LEAU 4,X POINT U TO START OF BASIC TEXT IN LINE
0908 df98 a6 c0 LACF7 LDA ,U+ * SKIP THROUGH THE LINE UNTIL A
0909 df9a 26 fc BNE LACF7 * ZERO (END OF LINE) IS FOUND
0910 df9c ef 84 STU ,X SAVE THE NEW START OF NEXT LINE ADDRESS
0911 df9e ae 84 LDX ,X POINT X TO START OF NEXT LINE
0912 dfa0 20 f0 BRA LACF1 KEEP GOING
0913 *
0914 * FIND A LINE NUMBER IN THE BASIC PROGRAM
0915 * RETURN WITH CARRY SET IF NO MATCH FOUND
0916 dfa2 dc 2b LAD01 LDD BINVAL GET THE LINE NUMBER TO FIND
0917 dfa4 9e 19 LDX TXTTAB BEGINNING OF PROGRAM
0918 dfa6 ee 84 LAD05 LDU ,X GET ADDRESS OF NEXT LINE NUMBER
0919 dfa8 27 09 BEQ LAD12 BRANCH IF END OF PROG
0920 dfaa 10 a3 02 CMPD 2,X IS IT A MATCH?
0921 dfad 23 06 BLS LAD14 CARRY SET IF LOWER; CARRY CLEAR IF MATCH
0922 dfaf ae 84 LDX ,X X = ADDRESS OF NEXT LINE
0923 dfb1 20 f3 BRA LAD05 KEEP LOOPING FOR LINE NUMBER
0924 dfb3 1a 01 LAD12 ORCC #1 SET CARRY FLAG
0925 dfb5 9f 47 LAD14 STX V47 SAVE MATCH LINE NUMBER OR NUMBER OF LINE JUST AFTER
0926 * WHERE IT SHOULD HAVE BEEN
0927 dfb7 39 LAD16 RTS
0928
0929 * NEW
0930 dfb8 26 fb NEW BNE LAD14 BRANCH IF ARGUMENT GIVEN
0931 dfba 9e 19 LAD19 LDX TXTTAB GET START OF BASIC
0932 dfbc 6f 80 CLR ,X+ * PUT 2 ZERO BYTES THERE - ERASE
0933 dfbe 6f 80 CLR ,X+ * THE BASIC PROGRAM
0934 dfc0 9f 1b STX VARTAB AND THE NEXT ADDRESS IS NOW THE END OF PROGRAM
0935 dfc2 9e 19 LAD21 LDX TXTTAB GET START OF BASIC
0936 dfc4 bd e1 68 JSR LAEBB PUT INPUT POINTER ONE BEFORE START OF BASIC
0937 * ERASE ALL VARIABLES
0938 dfc7 9e 27 LAD26 LDX MEMSIZ * RESET START OF STRING VARIABLES
0939 dfc9 9f 23 STX STRTAB * TO TOP OF STRING SPACE
0940 dfcb bd e0 9c JSR RESTOR RESET ‘DATA’ POINTER TO START OF BASIC
0941 dfce 9e 1b LDX VARTAB * GET START OF VARIABLES AND USE IT
0942 dfd0 9f 1d STX ARYTAB * TO RESET START OF ARRAYS
0943 dfd2 9f 1f STX ARYEND RESET END OF ARRAYS
0944 dfd4 8e 00 c9 LAD33 LDX #STRSTK * RESET STRING STACK POINTER TO
0945 dfd7 9f 0b STX TEMPPT * BOTTOM OF STRING STACK
0946 dfd9 ae e4 LDX ,S GET RETURN ADDRESS OFF STACK
0947 dfdb 10 de 21 LDS FRETOP RESTORE STACK POINTER
0948 dfde 6f e2 CLR ,-S PUT A ZERO BYTE ON STACK - TO CLEAR ANY RETURN OF
0949 * FOR/NEXT DATA FROM THE STACK
0950 dfe0 0f 2d CLR OLDPTR RESET ‘CONT’ ADDRESS SO YOU
0951 dfe2 0f 2e CLR OLDPTR+1 ‘CAN’T CONTINUE’
0952 dfe4 0f 08 CLR ARYDIS CLEAR THE ARRAY DISABLE FLAG
0953 dfe6 6e 84 JMP ,X RETURN TO CALLING ROUTINE - THIS IS NECESSARY
0954 * SINCE THE STACK WAS RESET
0955 *
0956 * FOR
0957 *
0958 * THE FOR COMMAND WILL STORE 18 BYTES ON THE STACK FOR
0959 * EACH FOR-NEXT LOOP WHICH IS BEING PROCESSED. THESE
0960 * BYTES ARE DEFINED AS FOLLOWS: 0- $80 (FOR FLAG);
0961 * 1,2=INDEX VARIABLE DESCRIPTOR POINTER; 3-7=FP VALUE OF STEP;
0962 * 8=STEP DIRECTION: $FF IF NEGATIVE; 0 IF ZERO; 1 IF POSITIVE;
0963 * 9-13=FP VALUE OF ‘TO’ PARAMETER;
0964 * 14,15=CURRENT LINE NUMBER; 16,17=RAM ADDRESS OF THE END
0965 * OF THE LINE CONTAINING THE ‘FOR’ STATEMENT
0966 dfe8 86 80 FOR LDA #$80 * SAVE THE DISABLE ARRAY FLAG IN VO8
0967 dfea 97 08 STA ARYDIS * DO NOT ALLOW THE INDEX VARIABLE TO BE AN ARRAY
0968 dfec bd e2 36 JSR LET SET INDEX VARIABLE TO INITIAL VALUE
0969 dfef bd de b6 JSR LABF9 SEARCH THE STACK FOR ‘FOR/NEXT’ DATA
0970 dff2 32 62 LEAS 2,S PURGE RETURN ADDRESS OFF OF THE STACK
0971 dff4 26 04 BNE LAD59 BRANCH IF INDEX VARIABLE NOT ALREADY BEING USED
0972 dff6 9e 0f LDX TEMPTR GET (ADDRESS + 18) OF MATCHED ‘FOR/NEXT’ DATA
0973 dff8 32 85 LEAS B,X MOVE THE STACK POINTER TO THE BEGINNING OF THE
0974 * MATCHED ‘FOR/NEXT’ DATA SO THE NEW DATA WILL
0975 * OVERLAY THE OLD DATA. THIS WILL ALSO DESTROY
0976 * ALL OF THE ‘RETURN’ AND ‘FOR/NEXT’ DATA BELOW
0977 * THIS POINT ON THE STACK
0978 dffa c6 09 LAD59 LDB #$09 * CHECK FOR ROOM FOR 18 BYTES
0979 dffc bd de f0 JSR LAC33 * IN FREE RAM
0980 dfff bd e1 95 JSR LAEE8 GET ADDR OF END OF SUBLINE IN X
0981 e002 dc 68 LDD CURLIN GET CURRENT LINE NUMBER
0982 e004 34 16 PSHS X,B,A SAVE LINE ADDR AND LINE NUMBER ON STACK
0983 e006 c6 a0 LDB #TOK_TO TOKEN FOR ‘TO’
0984 e008 bd e4 f8 JSR LB26F SYNTAX CHECK FOR ‘TO’
0985 e00b bd e3 cc JSR LB143 ‘TM’ ERROR IF INDEX VARIABLE SET TO STRING
0986 e00e bd e3 ca JSR LB141 EVALUATE EXPRESSION
0987 *
0988 e011 d6 54 LDB FP0SGN GET FPA0 MANTISSA SIGN
0989 e013 ca 7f ORB #$7F FORM A MASK TO SAVE DATA BITS OF HIGH ORDER MANTISSA
0990 e015 d4 50 ANDB FPA0 PUT THE MANTISSA SIGN IN BIT 7 OF HIGH ORDER MANTISSA
0991 e017 d7 50 STB FPA0 SAVE THE PACKED HIGH ORDER MANTISSA
0992 e019 10 8e e0 20 LDY #LAD7F LOAD FOLLOWING ADDRESS INTO Y AS A RETURN
0993 e01d 7e e4 73 JMP LB1EA ADDRESS - PUSH FPA0 ONTO THE STACK
0994 e020 8e ed 0e LAD7F LDX #LBAC5 POINT X TO FLOATING POINT NUMBER 1.0 (DEFAULT STEP VALUE)
0995 e023 bd ee 5d JSR LBC14 MOVE (X) TO FPA0
0996 e026 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
0997 e028 81 a4 CMPA #TOK_STEP STEP TOKEN
0998 e02a 26 05 BNE LAD90 BRANCH IF NO ‘STEP’ VALUE
0999 e02c 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
1000 e02e bd e3 ca JSR LB141 EVALUATE NUMERIC EXPRESSION
1001 e031 bd ee b6 LAD90 JSR LBC6D CHECK STATUS OF FPA0
1002 e034 bd e4 6f JSR LB1E6 SAVE STATUS AND FPA0 ON THE STACK
1003 e037 dc 3b LDD VARDES * GET DESCRIPTOR POINTER FOR THE ‘STEP’
1004 e039 34 06 PSHS B,A * VARIABLE AND SAVE IT ON THE STACK
1005 e03b 86 80 LDA #$80 = GET THE ‘FOR’ FLAG AND
1006 e03d 34 02 PSHS A = SAVE IT ON THE STACK
1007 *
1008 * MAIN COMMAND INTERPRETATION LOOP
1009 e03f 1c af LAD9E ANDCC #$AF ENABLE IRQ,FIRQ
1010 e041 8d 60 BSR LADEB CHECK FOR KEYBOARD BREAK
1011 e043 9e 83 LDX CHARAD GET BASIC’S INPUT POINTER
1012 e045 9f 2f STX TINPTR SAVE IT
1013 e047 a6 80 LDA ,X+ GET CURRENT INPUT CHAR & MOVE POINTER
1014 e049 27 07 BEQ LADB4 BRANCH IF END OF LINE
1015 e04b 81 3a CMPA #': CHECK FOR LINE SEPARATOR
1016 e04d 27 22 BEQ LADC0 BRANCH IF COLON
1017 e04f 7e e5 00 LADB1 JMP LB277 ‘SYNTAX ERROR’-IF NOT LINE SEPARATOR
1018 e052 a6 81 LADB4 LDA ,X++ GET MS BYTE OF ADDRESS OF NEXT BASIC LINE
1019 e054 97 00 STA ENDFLG SAVE IN STOP/END FLAG - CAUSE A STOP IF
1020 * NEXT LINE ADDRESS IS < $8000; CAUSE
1021 * AN END IF ADDRESS > $8000
1022 e056 27 72 BEQ LAE15 BRANCH TO ‘STOP’ - END OF PROGRAM
1023 e058 ec 80 LDD ,X+ GET CURRENT LINE NUMBER
1024 e05a dd 68 STD CURLIN SAVE IN CURLIN
1025 e05c 9f 83 STX CHARAD SAVE ADDRESS OF FIRST BYTE OF LINE
1026 * EXTENDED BASIC TRACE
1027 e05e 96 8c LDA TRCFLG TEST THE TRACE FLAG
1028 e060 27 0f BEQ LADC0 BRANCH IF TRACE OFF
1029 e062 86 5b LDA #$5B <LEFT HAND MARKER FOR TRON LINE NUMBER
1030 e064 bd db 14 JSR PUTCHR OUTPUT A CHARACTER
1031 e067 96 68 LDA CURLIN GET MS BYTE OF LINE NUMBER
1032 e069 bd f0 15 JSR LBDCC CONVERT ACCD TO DECIMAL AND PRINT ON SCREEN
1033 e06c 86 5d LDA #$5D > RIGHT HAND MARKER FOR TRON LINE NUMBER
1034 e06e bd db 14 JSR PUTCHR OUTPUT A CHARACTER
1035 * END OF EXTENDED BASIC TRACE
1036 e071 9d 7c LADC0 JSR GETNCH GET A CHARACTER FROM BASIC
1037 e073 8d 02 BSR LADC6 GO PROCESS COMMAND
1038 e075 20 c8 BRA LAD9E GO BACK TO MAIN LOOP
1039 e077 27 29 LADC6 BEQ LADEA RETURN IF END OF LINE (RTS - was BEQ LAE40)
1040 e079 4d TSTA CHECK FOR TOKEN - BIT 7 SET (NEGATIVE)
1041 e07a 10 2a 01 b8 LBPL LET BRANCH IF NOT A TOKEN - GO DO A ‘LET’ WHICH
1042 * IS THE ‘DEFAULT’ TOKEN FOR MICROSOFT BASIC
1043 e07e 81 ff CMPA #$FF SECONDARY TOKEN
1044 e080 27 0f BEQ SECTOK
1045 e082 81 9e CMPA #TOK_HIGH_EXEC SKIPF TOKEN - HIGHEST EXECUTABLE COMMAND IN BASIC
1046 e084 22 c9 BHI LADB1 ‘SYNTAX ERROR’ IF NON-EXECUTABLE TOKEN
1047 e086 be db f1 LDX COMVEC+3 GET ADDRESS OF BASIC’S COMMAND TABLE
1048 e089 48 LADD4 ASLA X2 (2 BYTE/JUMP ADDRESS) & DISCARD BIT 7
1049 e08a 1f 89 TFR A,B SAVE COMMAND OFFSET IN ACCB
1050 e08c 3a ABX NON X POINTS TO COMMAND JUMP ADDR
1051 e08d 9d 7c JSR GETNCH GET AN INPUT CHAR
1052 *
1053 * HERE IS WHERE WE BRANCH TO DO A ‘COMMAND’
1054 e08f 6e 94 JMP [,X] GO DO A COMMAND
1055 SECTOK
1056 * THE ONLY SECONDARY TOKEN THAT CAN ALSO BE AN EXECUTABLE IS
1057 * THE MID$ REPLACEMENT STATEMENT. SO SPECIAL-CASE CHECK DONE HERE
1058 e091 9d 7c JSR GETNCH GET AN INPUT CHAR
1059 e093 81 97 CMPA #TOK_MID TOKEN FOR "MID$"
1060 e095 10 27 14 f0 LBEQ L86D6 PROCESS MID$ REPLACEMENT
1061 e099 7e e5 00 JMP LB277 SYNTAX ERROR
1062
1063 *
1064 * RESTORE
1065 e09c 9e 19 RESTOR LDX TXTTAB BEGINNING OF PROGRAM ADDRESS
1066 e09e 30 1f LEAX -1,X MOVE TO ONE BYTE BEFORE PROGRAM
1067 e0a0 9f 33 LADE8 STX DATPTR SAVE NEW DATA POINTER
1068 e0a2 39 LADEA RTS
1069 *
1070 * BREAK CHECK
1071 e0a3 bd db 05 LADEB JSR LA1C1 GET A KEYSTROKE ENTRY
1072 e0a6 27 0a BEQ LADFA RETURN IF NO INPUT
1073 e0a8 81 03 LADF0 CMPA #3 CONTROL C? (BREAK)
1074 e0aa 27 12 BEQ STOP YES
1075 e0ac 81 13 CMPA #$13 CONTROL S? (PAUSE)
1076 e0ae 27 03 BEQ LADFB YES
1077 e0b0 97 73 STA IKEYIM SAVE KEYSTROKE IN INKEY IMAGE
1078 e0b2 39 LADFA RTS
1079 e0b3 bd db 05 LADFB JSR KEYIN GET A KEY
1080 e0b6 27 fb BEQ LADFB BRANCH IF NO KEY DOWN
1081 e0b8 20 ee BRA LADF0 CONTINUE - DO A BREAK CHECK
1082 *
1083 * END
1084 e0ba 9d 82 END JSR GETCCH GET CURRENT INPUT CHAR
1085 e0bc 20 02 BRA LAE0B
1086 *
1087 * STOP
1088 e0be 1a 01 STOP ORCC #$01 SET CARRY FLAG
1089 e0c0 26 31 LAE0B BNE LAE40 BRANCH IF ARGUMENT EXISTS
1090 e0c2 9e 83 LDX CHARAD * SAVE CURRENT POSITION OF
1091 e0c4 9f 2f STX TINPTR * BASIC’S INPUT POINTER
1092 e0c6 06 00 LAE11 ROR ENDFLG ROTATE CARRY INTO BIT 7 OF STOP/END FLAG
1093 e0c8 32 62 LEAS 2,S PURGE RETURN ADDRESS OFF STACK
1094 e0ca 9e 68 LAE15 LDX CURLIN GET CURRENT LINE NUMBER
1095 e0cc 8c ff ff CMPX #$FFFF DIRECT MODE?
1096 e0cf 27 06 BEQ LAE22 YES
1097 e0d1 9f 29 STX OLDTXT SAVE CURRENT LINE NUMBER
1098 e0d3 9e 2f LDX TINPTR * GET AND SAVE CURRENT POSITION
1099 e0d5 9f 2d STX OLDPTR * OF BASIC’S INPUT POINTER
1100 LAE22
1101 e0d7 8e de ae LDX #LABF2-1 POINT TO CR, ‘BREAK’ MESSAGE
1102 e0da 0d 00 TST ENDFLG CHECK STOP/END FLAG
1103 e0dc 10 2a fe 42 LBPL LAC73 BRANCH TO MAIN LOOP OF BASIC IF END
1104 e0e0 7e df 17 JMP LAC68 PRINT ‘BREAK AT ####’ AND GO TO
1105 * BASIC’S MAIN LOOP IF ‘STOP’
1106
1107 * CONT
1108 e0e3 26 0e CONT BNE LAE40 RETURN IF ARGUMENT GIVEN
1109 e0e5 c6 20 LDB #2*16 ‘CAN’T CONTINUE’ ERROR
1110 e0e7 9e 2d LDX OLDPTR GET CONTINUE ADDRESS (INPUT POINTER)
1111 e0e9 10 27 fe 16 LBEQ LAC46 ‘CN’ ERROR IF CONTINUE ADDRESS = 0
1112 e0ed 9f 83 STX CHARAD RESET BASIC’S INPUT POINTER
1113 e0ef 9e 29 LDX OLDTXT GET LINE NUMBER
1114 e0f1 9f 68 STX CURLIN RESET CURRENT LINE NUMBER
1115 e0f3 39 LAE40 RTS
1116 *
1117 * CLEAR
1118 e0f4 27 2c CLEAR BEQ LAE6F BRANCH IF NO ARGUMENT
1119 e0f6 bd e6 6a JSR LB3E6 EVALUATE ARGUMENT
1120 e0f9 34 06 PSHS B,A SAVE AMOUNT OF STRING SPACE ON STACK
1121 e0fb 9e 27 LDX MEMSIZ GET CURRENT TOP OF CLEARED SPACE
1122 e0fd 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1123 e0ff 27 0c BEQ LAE5A BRANCH IF NO NEW TOP OF CLEARED SPACE
1124 e101 bd e4 f6 JSR LB26D SYNTAX CHECK FOR COMMA
1125 e104 bd e9 c1 JSR LB73D EVALUATE EXPRESSlON; RETURN VALUE IN X
1126 e107 30 1f LEAX -1,X X = TOP OF CLEARED SPACE
1127 e109 9c 71 CMPX TOPRAM COMPARE TO TOP OF RAM
1128 e10b 22 18 BHI LAE72 ‘OM’ ERROR IF > TOP OF RAM
1129 e10d 1f 10 LAE5A TFR X,D ACCD = TOP OF CLEARED SPACE
1130 e10f a3 e1 SUBD ,S++ SUBTRACT OUT AMOUNT OF CLEARED SPACE
1131 e111 25 12 BCS LAE72 ‘OM’ ERROR IF FREE MEM < 0
1132 e113 1f 03 TFR D,U U = BOTTOM OF CLEARED SPACE
1133 e115 83 00 3a SUBD #STKBUF SUBTRACT OUT STACK BUFFER
1134 e118 25 0b BCS LAE72 ‘OM’ ERROR IF FREE MEM < 0
1135 e11a 93 1b SUBD VARTAB SUBTRACT OUT START OF VARIABLES
1136 e11c 25 07 BCS LAE72 ‘OM’ ERROR IF FREE MEM < 0
1137 e11e df 21 STU FRETOP SAVE NEW BOTTOM OF CLEARED SPACE
1138 e120 9f 27 STX MEMSIZ SAVE NEW TOP OF CLEARED SPACE
1139 e122 7e df c7 LAE6F JMP LAD26 ERASE ALL VARIABLES, INITIALIZE POINTERS, ETC
1140 e125 7e df 01 LAE72 JMP LAC44 ‘OM’ ERROR
1141 *
1142 * RUN
1143 e128 9d 82 RUN JSR GETCCH * GET CURRENT INPUT CHARACTER
1144 e12a 10 27 fe 94 LBEQ LAD21 * IF NO LINE NUMBER
1145 e12e bd df c7 JSR LAD26 ERASE ALL VARIABLES
1146 e131 20 19 BRA LAE9F ‘GOTO’ THE RUN ADDRESS
1147 *
1148 * GO
1149 e133 1f 89 GO TFR A,B SAVE INPUT CHARACTER IN ACCB
1150 e135 9d 7c LAE88 JSR GETNCH GET A CHARACTER FROM BASIC
1151 e137 c1 a0 CMPB #TOK_TO ‘TO’ TOKEN
1152 e139 27 16 BEQ LAEA4 BRANCH IF GOTO
1153 e13b c1 a1 CMPB #TOK_SUB ‘SUB’ TOKEN
1154 e13d 26 45 BNE LAED7 ‘SYNTAX ERROR’ IF NEITHER
1155 e13f c6 03 LDB #3 =ROOM FOR 6
1156 e141 bd de f0 JSR LAC33 =BYTES ON STACK?
1157 e144 de 83 LDU CHARAD * SAVE CURRENT BASIC INPUT POINTER, LINE
1158 e146 9e 68 LDX CURLIN * NUMBER AND SUB TOKEN ON STACK
1159 e148 86 a1 LDA #TOK_SUB *
1160 e14a 34 52 PSHS U,X,A *
1161 e14c 8d 03 LAE9F BSR LAEA4 GO DO A ‘GOTO’
1162 e14e 7e e0 3f JMP LAD9E JUMP BACK TO BASIC’S MAIN LOOP
1163 * GOTO
1164 e151 9d 82 LAEA4 JSR GETCCH GET CURRENT INPUT CHAR
1165 e153 bd e2 14 JSR LAF67 GET LINE NUMBER TO BINARY IN BINVAL
1166 e156 8d 40 BSR LAEEB ADVANCE BASIC’S POINTER TO END OF LINE
1167 e158 30 01 LEAX $01,X POINT TO START OF NEXT LINE
1168 e15a dc 2b LDD BINVAL GET THE LINE NUMBER TO RUN
1169 e15c 10 93 68 CMPD CURLIN COMPARE TO CURRENT LINE NUMBER
1170 e15f 22 02 BHI LAEB6 IF REO’D LINE NUMBER IS > CURRENT LINE NUMBER,
1171 * DON’T START LOOKING FROM
1172 * START OF PROGRAM
1173 e161 9e 19 LDX TXTTAB BEGINNING OF PROGRAM
1174 e163 bd df a6 LAEB6 JSR LAD05 GO FIND A LINE NUMBER
1175 e166 25 17 BCS LAED2 ‘UNDEFINED LINE NUMBER’
1176 e168 30 1f LAEBB LEAX -1,X MOVE BACK TO JUST BEFORE START OF LINE
1177 e16a 9f 83 STX CHARAD RESET BASIC’S INPUT POINTER
1178 e16c 39 LAEBF RTS
1179 *
1180 * RETURN
1181 e16d 26 fd RETURN BNE LAEBF EXIT ROUTINE IF ARGUMENT GIVEN
1182 e16f 86 ff LDA #$FF * PUT AN ILLEGAL VARIABLE NAME IN FIRST BYTE OF
1183 e171 97 3b STA VARDES * VARDES WHICH WILL CAUSE ‘FOR/NEXT’ DATA ON THE
1184 * STACK TO BE IGNORED
1185 e173 bd de b6 JSR LABF9 CHECK FOR RETURN DATA ON THE STACK
1186 e176 1f 14 TFR X,S RESET STACK POINTER - PURGE TWO RETURN ADDRESSES
1187 * FROM THE STACK
1188 e178 81 21 CMPA #TOK_SUB-$80 SUB TOKEN - $80
1189 e17a 27 0b BEQ LAEDA BRANCH IF ‘RETURN’ FROM SUBROUTINE
1190 e17c c6 04 LDB #2*2 ERROR #2 ‘RETURN WITHOUT GOSUB’
1191 e17e 8c FCB SKP2 SKIP TWO BYTES
1192 e17f c6 0e LAED2 LDB #7*2 ERROR #7 ‘UNDEFINED LINE NUMBER’
1193 e181 7e df 03 JMP LAC46 JUMP TO ERROR HANDLER
1194 e184 7e e5 00 LAED7 JMP LB277 ‘SYNTAX ERROR’
1195 e187 35 52 LAEDA PULS A,X,U * RESTORE VALUES OF CURRENT LINE NUMBER AND
1196 e189 9f 68 STX CURLIN * BASIC’S INPUT POINTER FOR THIS SUBROUTINE
1197 e18b df 83 STU CHARAD * AND LOAD ACCA WITH SUB TOKEN ($A6)
1198 *
1199 * DATA
1200 e18d 8d 06 DATA BSR LAEE8 MOVE INPUT POINTER TO END OF SUBLINE OR LINE
1201 e18f 8c FCB SKP2 SKIP 2 BYTES
1202
1203 * REM, ELSE
1204 ELSE
1205 e190 8d 06 REM BSR LAEEB MOVE INPUT POINTER TO END OF LINE
1206 e192 9f 83 STX CHARAD RESET BASIC’S INPUT POINTER
1207 e194 39 LAEE7 RTS
1208 * ADVANCE INPUT POINTER TO END OF SUBLINE OR LINE
1209 e195 c6 3a LAEE8 LDB #': COLON = SUBLINE TERMINATOR CHARACTER
1210 e197 86 LAEEA FCB SKP1LD SKPILD SKIP ONE BYTE; LDA #$5F
1211 * ADVANCE BASIC’S INPUT POINTER TO END OF
1212 * LINE - RETURN ADDRESS OF END OF LINE+1 IN X
1213 e198 5f LAEEB CLRB 0 = LINE TERMINATOR CHARACTER
1214 e199 d7 01 STB CHARAC TEMP STORE PRIMARY TERMINATOR CHARACTER
1215 e19b 5f CLRB 0 (END OF LINE) = ALTERNATE TERM. CHAR.
1216 e19c 9e 83 LDX CHARAD LOAD X W/BASIC’S INPUT POINTER
1217 e19e 1f 98 LAEF1 TFR B,A * CHANGE TERMINATOR CHARACTER
1218 e1a0 d6 01 LDB CHARAC * FROM ACCB TO CHARAC - SAVE OLD TERMINATOR
1219 * IN CHARAC
1220 e1a2 97 01 STA CHARAC SWAP PRIMARY AND SECONDARY TERMINATORS
1221 e1a4 a6 84 LAEF7 LDA ,X GET NEXT INPUT CHARACTER
1222 e1a6 27 ec BEQ LAEE7 RETURN IF 0 (END OF LINE)
1223 e1a8 34 04 PSHS B SAVE TERMINATOR ON STACK
1224 e1aa a1 e0 CMPA ,S+ COMPARE TO INPUT CHARACTER
1225 e1ac 27 e6 BEQ LAEE7 RETURN IF EQUAL
1226 e1ae 30 01 LEAX 1,X MOVE POINTER UP ONE
1227 e1b0 81 22 CMPA #'" CHECK FOR DOUBLE QUOTES
1228 e1b2 27 ea BEQ LAEF1 BRANCH IF " - TOGGLE TERMINATOR CHARACTERS
1229 e1b4 4c INCA * CHECK FOR $FF AND BRANCH IF
1230 e1b5 26 02 BNE LAF0C * NOT SECONDARY TOKEN
1231 e1b7 30 01 LEAX 1,X MOVE INPUT POINTER 1 MORE IF SECONDARY
1232 e1b9 81 86 LAF0C CMPA #TOK_IF+1 TOKEN FOR IF?
1233 e1bb 26 e7 BNE LAEF7 NO - GET ANOTHER INPUT CHARACTER
1234 e1bd 0c 04 INC IFCTR INCREMENT IF COUNTER - KEEP TRACK OF HOW MANY
1235 * ‘IF’ STATEMENTS ARE NESTED IN ONE LINE
1236 e1bf 20 e3 BRA LAEF7 GET ANOTHER INPUT CHARACTER
1237
1238 * IF
1239 e1c1 bd e3 ca IF JSR LB141 EVALUATE NUMERIC EXPRESSION
1240 e1c4 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1241 e1c6 81 81 CMPA #TOK_GO TOKEN FOR GO
1242 e1c8 27 05 BEQ LAF22 TREAT ‘GO’ THE SAME AS ‘THEN’
1243 e1ca c6 a2 LDB #TOK_THEN TOKEN FOR THEN
1244 e1cc bd e4 f8 JSR LB26F DO A SYNTAX CHECK ON ACCB
1245 e1cf 96 4f LAF22 LDA FP0EXP CHECK FOR TRUE/FALSE - FALSE IF FPA0 EXPONENT = ZERO
1246 e1d1 26 13 BNE LAF39 BRANCH IF CONDITION TRUE
1247 e1d3 0f 04 CLR IFCTR CLEAR FLAG - KEEP TRACK OF WHICH NESTED ELSE STATEMENT
1248 * TO SEARCH FOR IN NESTED ‘IF’ LOOPS
1249 e1d5 8d b6 LAF28 BSR DATA MOVE BASIC’S POINTER TO END OF SUBLINE
1250 e1d7 4d TSTA * CHECK TO SEE IF END OF LINE OR SUBLINE
1251 e1d8 27 ba BEQ LAEE7 * AND RETURN IF END OF LINE
1252 e1da 9d 7c JSR GETNCH GET AN INPUT CHARACTER FROM BASIC
1253 e1dc 81 84 CMPA #TOK_ELSE TOKEN FOR ELSE
1254 e1de 26 f5 BNE LAF28 IGNORE ALL DATA EXCEPT ‘ELSE’ UNTIL
1255 * END OF LINE (ZERO BYTE)
1256 e1e0 0a 04 DEC IFCTR CHECK TO SEE IF YOU MUST SEARCH ANOTHER SUBLINE
1257 e1e2 2a f1 BPL LAF28 BRANCH TO SEARCH ANOTHER SUBLINE FOR ‘ELSE’
1258 e1e4 9d 7c JSR GETNCH GET AN INPUT CHARACTER FROM BASIC
1259 e1e6 9d 82 LAF39 JSR GETCCH GET CURRENT INPUT CHARACTER
1260 e1e8 10 25 ff 65 LBCS LAEA4 BRANCH TO ‘GOTO’ IF NUMERIC CHARACTER
1261 e1ec 7e e0 77 JMP LADC6 RETURN TO MAIN INTERPRETATION LOOP
1262
1263 * ON
1264 e1ef bd e9 8f ON JSR LB70B EVALUATE EXPRESSION
1265 e1f2 c6 81 LDB #TOK_GO TOKEN FOR GO
1266 e1f4 bd e4 f8 JSR LB26F SYNTAX CHECK FOR GO
1267 e1f7 34 02 PSHS A SAVE NEW TOKEN (TO,SUB)
1268 e1f9 81 a1 CMPA #TOK_SUB TOKEN FOR SUB?
1269 e1fb 27 04 BEQ LAF54 YES
1270 e1fd 81 a0 CMPA #TOK_TO TOKEN FOR TO?
1271 e1ff 26 83 LAF52 BNE LAED7 ‘SYNTAX’ ERROR IF NOT ‘SUB’ OR ‘TO’
1272 e201 0a 53 LAF54 DEC FPA0+3 DECREMENT IS BYTE OF MANTISSA OF FPA0 - THIS
1273 * IS THE ARGUMENT OF THE ‘ON’ STATEMENT
1274 e203 26 05 BNE LAF5D BRANCH IF NOT AT THE PROPER GOTO OR GOSUB LINE NUMBER
1275 e205 35 04 PULS B GET BACK THE TOKEN FOLLOWING ‘GO’
1276 e207 7e e1 35 JMP LAE88 GO DO A ‘GOTO’ OR ‘GOSUB’
1277 e20a 9d 7c LAF5D JSR GETNCH GET A CHARACTER FROM BASIC
1278 e20c 8d 06 BSR LAF67 CONVERT BASIC LINE NUMBER TO BINARY
1279 e20e 81 2c CMPA #', IS CHARACTER FOLLOWING LINE NUMBER A COMMA?
1280 e210 27 ef BEQ LAF54 YES
1281 e212 35 84 PULS B,PC IF NOT, FALL THROUGH TO NEXT COMMAND
1282 e214 9e 74 LAF67 LDX ZERO DEFAULT LINE NUMBER OF ZERO
1283 e216 9f 2b STX BINVAL SAVE IT IN BINVAL
1284 *
1285 * CONVERT LINE NUMBER TO BINARY - RETURN VALUE IN BINVAL
1286 *
1287 e218 24 61 LAF6B BCC LAFCE RETURN IF NOT NUMERIC CHARACTER
1288 e21a 80 30 SUBA #'0 MASK OFF ASCII
1289 e21c 97 01 STA CHARAC SAVE DIGIT IN VO1
1290 e21e dc 2b LDD BINVAL GET ACCUMULATED LINE NUMBER VALUE
1291 e220 81 18 CMPA #24 LARGEST LINE NUMBER IS $F9FF (63999) -
1292 * (24*256+255)*10+9
1293 e222 22 db BHI LAF52 ‘SYNTAX’ ERROR IF TOO BIG
1294 * MULT ACCD X 10
1295 e224 58 ASLB *
1296 e225 49 ROLA * TIMES 2
1297 e226 58 ASLB =
1298 e227 49 ROLA = TIMES 4
1299 e228 d3 2b ADDD BINVAL ADD 1 = TIMES 5
1300 e22a 58 ASLB *
1301 e22b 49 ROLA * TIMES 10
1302 e22c db 01 ADDB CHARAC ADD NEXT DIGIT
1303 e22e 89 00 ADCA #0 PROPAGATE CARRY
1304 e230 dd 2b STD BINVAL SAVE NEW ACCUMULATED LINE NUMBER
1305 e232 9d 7c JSR GETNCH GET NEXT CHARACTER FROM BASIC
1306 e234 20 e2 BRA LAF6B LOOP- PROCESS NEXT DIGIT
1307 *
1308 * LET (EXBAS)
1309 * EVALUATE A NON-TOKEN EXPRESSION
1310 * TARGET = REPLACEMENT
1311 e236 bd e5 db LET JSR LB357 FIND TARGET VARIABLE DESCRIPTOR
1312 e239 9f 3b STX VARDES SAVE DESCRIPTOR ADDRESS OF 1ST EXPRESSION
1313 e23b c6 ae LDB #TOK_EQUALS TOKEN FOR "="
1314 e23d bd e4 f8 JSR LB26F DO A SYNTAX CHECK FOR ‘=‘
1315 e240 96 06 LDA VALTYP * GET VARIABLE TYPE AND
1316 e242 34 02 PSHS A * SAVE ON THE STACK
1317 e244 bd e3 df JSR LB156 EVALUATE EXPRESSION
1318 e247 35 02 PULS A * REGET VARIABLE TYPE OF 1ST EXPRESSION AND
1319 e249 46 RORA * SET CARRY IF STRING
1320 e24a bd e3 d1 JSR LB148 TYPE CHECK-TM ERROR IF VARIABLE TYPES ON
1321 * BOTH SIDES OF EQUALS SIGN NOT THE SAME
1322 e24d 10 27 0c 2b LBEQ LBC33 GO PUT FPA0 INTO VARIABLE DESCRIPTOR IF NUMERIC
1323 * MOVE A STRING WHOSE DESCRIPTOR IS LOCATED AT
1324 * FPA0+2 INTO THE STRING SPACE. TRANSFER THE
1325 * DESCRIPTOR ADDRESS TO THE ADDRESS IN VARDES
1326 * DON’T MOVE THE STRING IF IT IS ALREADY IN THE
1327 * STRING SPACE. REMOVE DESCRIPTOR FROM STRING
1328 * STACK IF IT IS LAST ONE ON THE STACK
1329 e251 9e 52 LAFA4 LDX FPA0+2 POINT X TO DESCRIPTOR OF REPLACEMENT STRING
1330 e253 dc 21 LDD FRETOP LOAD ACCD WITH START OF STRING SPACE
1331 e255 10 a3 02 CMPD 2,X IS THE STRING IN STRING SPACE?
1332 e258 24 11 BCC LAFBE BRANCH IF IT’S NOT IN THE STRING SPACE
1333 e25a 9c 1b CMPX VARTAB COMPARE DESCRIPTOR ADDRESS TO START OF VARIABLES
1334 e25c 25 0d BCS LAFBE BRANCH IF DESCRIPTOR ADDRESS NOT IN VARIABLES
1335 e25e e6 84 LAFB1 LDB ,X GET LENGTH OF REPLACEMENT STRING
1336 e260 bd e7 91 JSR LB50D RESERVE ACCB BYTES OF STRING SPACE
1337 e263 9e 4d LDX V4D GET DESCRIPTOR ADDRESS BACK
1338 e265 bd e8 c7 JSR LB643 MOVE STRING INTO STRING SPACE
1339 e268 8e 00 56 LDX #STRDES POINT X TO TEMP STRING DESCRIPTOR ADDRESS
1340 e26b 9f 4d LAFBE STX V4D SAVE STRING DESCRIPTOR ADDRESS IN V4D
1341 e26d bd e8 f9 JSR LB675 REMOVE STRING DESCRIPTOR IF LAST ONE
1342 * ON STRING STACK
1343 e270 de 4d LDU V4D POINT U TO REPLACEMENT DESCRIPTOR ADDRESS
1344 e272 9e 3b LDX VARDES GET TARGET DESCRIPTOR ADDRESS
1345 e274 37 26 PULU A,B,Y GET LENGTH AND START OF REPLACEMENT STRING
1346 e276 a7 84 STA ,X * SAVE STRING LENGTH AND START IN
1347 e278 10 af 02 STY 2,X * TARGET DESCRIPTOR LOCATION
1348 e27b 39 LAFCE RTS
1349
1350 e27c 3f 52 45 44 4f LAFCF FCC "?REDO" ?REDO MESSAGE
1351 e281 0d 00 FCB CR,$00
1352
1353 LAFD6
1354 e283 7e df 03 LAFDC JMP LAC46 JMP TO ERROR HANDLER
1355 e286 96 09 LAFDF LDA INPFLG = GET THE INPUT FLAG AND BRANCH
1356 e288 27 07 BEQ LAFEA = IF ‘INPUT’
1357 e28a 9e 31 LDX DATTXT * GET LINE NUMBER WHERE THE ERROR OCCURRED
1358 e28c 9f 68 STX CURLIN * AND USE IT AS THE CURRENT LINE NUMBER
1359 e28e 7e e5 00 JMP LB277 ‘SYNTAX ERROR’
1360 e291 8e e2 7b LAFEA LDX #LAFCF-1 * POINT X TO ‘?REDO’ AND PRINT
1361 e294 bd eb e5 JSR LB99C * IT ON THE SCREEN
1362 e297 9e 2f LDX TINPTR = GET THE SAVED ABSOLUTE ADDRESS OF
1363 e299 9f 83 STX CHARAD = INPUT POINTER AND RESTORE IT
1364 e29b 39 RTS
1365 *
1366 * INPUT
1367 e29c c6 16 INPUT LDB #11*2 ‘ID’ ERROR
1368 e29e 9e 68 LDX CURLIN GET CURRENT LINE NUMBER
1369 e2a0 30 01 LEAX 1,X ADD ONE
1370 e2a2 27 df BEQ LAFDC ‘ID’ ERROR BRANCH IF DIRECT MODE
1371 e2a4 8d 01 BSR LB00F GET SOME INPUT DATA - WAS LB002
1372 e2a6 39 RTS
1373 e2a7 81 22 LB00F CMPA #'" CHECK FOR PROMPT STRING DELIMITER
1374 e2a9 26 0b BNE LB01E BRANCH IF NO PROMPT STRING
1375 e2ab bd e4 cd JSR LB244 PUT PROMPT STRING ON STRING STACK
1376 e2ae c6 3b LDB #'; *
1377 e2b0 bd e4 f8 JSR LB26F * DO A SYNTAX CHECK FOR SEMICOLON
1378 e2b3 bd eb e8 JSR LB99F PRINT MESSAGE TO CONSOLE OUT
1379 e2b6 8e 00 f3 LB01E LDX #LINBUF POINT TO BASIC’S LINE BUFFER
1380 e2b9 6f 84 CLR ,X CLEAR 1ST BYTE - FLAG TO INDICATE NO DATA
1381 * IN LINE BUFFER
1382 e2bb 8d 06 BSR LB02F INPUT A STRING TO LINE BUFFER
1383 e2bd c6 2c LDB #', * INSERT A COMMA AT THE END
1384 e2bf e7 84 STB ,X * OF THE LINE INPUT BUFFER
1385 e2c1 20 16 BRA LB049
1386 * FILL BASIC’S LINE INPUT BUFFER CONSOLE IN
1387 e2c3 bd eb f8 LB02F JSR LB9AF SEND A "?" TO CONSOLE OUT
1388 e2c6 bd eb f5 JSR LB9AC SEND A ‘SPACE’ TO CONSOLE OUT
1389 e2c9 bd dc 3e LB035 JSR LA390 GO READ IN A BASIC LINE
1390 e2cc 24 05 BCC LB03F BRANCH IF ENTER KEY ENDED ENTRY
1391 e2ce 32 64 LEAS 4,S PURGE TWO RETURN ADDRESSES OFF THE STACK
1392 e2d0 7e e0 c6 JMP LAE11 GO DO A ‘STOP’ IF BREAK KEY ENDED LINE ENTRY
1393 e2d3 c6 2e LB03F LDB #2*23 ‘INPUT PAST END OF FILE’ ERROR
1394 e2d5 39 RTS
1395 *
1396 * READ
1397 e2d6 9e 33 READ LDX DATPTR GET ‘READ’ START ADDRESS
1398 e2d8 86 FCB SKP1LD SKIP ONE BYTE - LDA #*$4F
1399 e2d9 4f LB049 CLRA ‘INPUT’ ENTRY POINT: INPUT FLAG = 0
1400 e2da 97 09 STA INPFLG SET INPUT FLAG; 0 = INPUT: <> 0 = READ
1401 e2dc 9f 35 STX DATTMP SAVE ‘READ’ START ADDRESS/’INPUT’ BUFFER START
1402 e2de bd e5 db LB04E JSR LB357 EVALUATE A VARIABLE
1403 e2e1 9f 3b STX VARDES SAVE DESCRIPTOR ADDRESS
1404 e2e3 9e 83 LDX CHARAD * GET BASIC’S INPUT POINTER
1405 e2e5 9f 2b STX BINVAL * AND SAVE IT
1406 e2e7 9e 35 LDX DATTMP GET ‘READ’ ADDRESS START/’INPUT’ BUFFER POINTER
1407 e2e9 a6 84 LDA ,X GET A CHARACTER FROM THE BASIC PROGRAM
1408 e2eb 26 09 BNE LB069 BRANCH IF NOT END OF LINE
1409 e2ed 96 09 LDA INPFLG * CHECK INPUT FLAG AND BRANCH
1410 e2ef 26 51 BNE LB0B9 * IF LOOKING FOR DATA (READ)
1411 * NO DATA IN ‘INPUT’ LINE BUFFER AND/OR INPUT
1412 * NOT COMING FROM SCREEN
1413 e2f1 bd eb f8 JSR LB9AF SEND A '?' TO CONSOLE OUT
1414 e2f4 8d cd BSR LB02F FILL INPUT BUFFER FROM CONSOLE IN
1415 e2f6 9f 83 LB069 STX CHARAD RESET BASIC’S INPUT POINTER
1416 e2f8 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
1417 e2fa d6 06 LDB VALTYP * CHECK VARIABLE TYPE AND
1418 e2fc 27 23 BEQ LB098 * BRANCH IF NUMERIC
1419 * READ/INPUT A STRING VARIABLE
1420 e2fe 9e 83 LDX CHARAD LOAD X WITH CURRENT BASIC INPUT POINTER
1421 e300 97 01 STA CHARAC SAVE CURRENT INPUT CHARACTER
1422 e302 81 22 CMPA #'" CHECK FOR STRING DELIMITER
1423 e304 27 0e BEQ LB08B BRANCH IF STRING DELIMITER
1424 e306 30 1f LEAX -1,X BACK UP POINTER
1425 e308 4f CLRA * ZERO = END OF LINE CHARACTER
1426 e309 97 01 STA CHARAC * SAVE AS TERMINATOR
1427 e30b bd dc 30 JSR LA35F SET UP PRINT PARAMETERS
1428 e30e 86 3a LDA #': END OF SUBLINE CHARACTER
1429 e310 97 01 STA CHARAC SAVE AS TERMINATOR I
1430 e312 86 2c LDA #', COMMA
1431 e314 97 02 LB08B STA ENDCHR SAVE AS TERMINATOR 2
1432 e316 bd e7 a2 JSR LB51E STRIP A STRING FROM THE INPUT BUFFER
1433 e319 bd e4 d2 JSR LB249 MOVE INPUT POINTER TO END OF STRING
1434 e31c bd e2 51 JSR LAFA4 PUT A STRING INTO THE STRING SPACE IF NECESSARY
1435 e31f 20 06 BRA LB09E CHECK FOR ANOTHER DATA ITEM
1436 * SAVE A NUMERIC VALUE IN A READ OR INPUT DATA ITEM
1437 e321 bd ef 5b LB098 JSR LBD12 CONVERT AN ASCII STRING TO FP NUMBER
1438 e324 bd ee 7c JSR LBC33 PACK FPA0 AND STORE IT IN ADDRESS IN VARDES -
1439 * INPUT OR READ DATA ITEM
1440 e327 9d 82 LB09E JSR GETCCH GET CURRENT INPUT CHARACTER
1441 e329 27 06 BEQ LB0A8 BRANCH IF END OF LINE
1442 e32b 81 2c CMPA #', CHECK FOR A COMMA
1443 e32d 10 26 ff 52 LBNE LAFD6 BAD FILE DATA' ERROR OR RETRY
1444 e331 9e 83 LB0A8 LDX CHARAD * GET CURRENT INPUT
1445 e333 9f 35 STX DATTMP * POINTER (USED AS A DATA POINTER) AND SAVE IT
1446 e335 9e 2b LDX BINVAL * RESET INPUT POINTER TO INPUT OR
1447 e337 9f 83 STX CHARAD * READ STATEMENT
1448 e339 9d 82 JSR GETCCH GET CURRENT CHARACTER FROM BASIC
1449 e33b 27 21 BEQ LB0D5 BRANCH IF END OF LINE - EXIT COMMAND
1450 e33d bd e4 f6 JSR LB26D SYNTAX CHECK FOR COMMA
1451 e340 20 9c BRA LB04E GET ANOTHER INPUT OR READ ITEM
1452 * SEARCH FROM ADDRESS IN X FOR
1453 * 1ST OCCURENCE OF THE TOKEN FOR DATA
1454 e342 9f 83 LB0B9 STX CHARAD RESET BASIC’S INPUT POINTER
1455 e344 bd e1 95 JSR LAEE8 SEARCH FOR END OF CURRENT LINE OR SUBLINE
1456 e347 30 01 LEAX 1,X MOVE X ONE PAST END OF LINE
1457 e349 4d TSTA CHECK FOR END OF LINE
1458 e34a 26 0a BNE LB0CD BRANCH IF END OF SUBLINE
1459 e34c c6 06 LDB #2*3 ‘OUT OF DATA’ ERROR
1460 e34e ee 81 LDU ,X++ GET NEXT 2 CHARACTERS
1461 e350 27 41 BEQ LB10A ‘OD’ ERROR IF END OF PROGRAM
1462 e352 ec 81 LDD ,X++ GET BASIC LINE NUMBER AND
1463 e354 dd 31 STD DATTXT SAVE IT IN DATTXT
1464 e356 a6 84 LB0CD LDA ,X GET AN INPUT CHARACTER
1465 e358 81 86 CMPA #TOK_DATA DATA TOKEN?
1466 e35a 26 e6 BNE LB0B9 NO — KEEP LOOKING
1467 e35c 20 98 BRA LB069 YES
1468 * EXIT READ AND INPUT COMMANDS
1469 e35e 9e 35 LB0D5 LDX DATTMP GET DATA POINTER
1470 e360 d6 09 LDB INPFLG * CHECK INPUT FLAG
1471 e362 10 26 fd 3a LBNE LADE8 * SAVE NEW DATA POINTER IF READ
1472 e366 a6 84 LDA ,X = CHECK NEXT CHARACTER IN ‘INPUT’ BUFFER
1473 e368 27 06 BEQ LB0E7 =
1474 e36a 8e e3 70 LDX #LB0E8-1 POINT X TO ‘?EXTRA IGNORED’
1475 e36d 7e eb e5 JMP LB99C PRINT THE MESSAGE
1476 e370 39 LB0E7 RTS
1477
1478 e371 3f 45 58 54 52 41 LB0E8 FCC "?EXTRA IGNORED" ?EXTRA IGNORED MESSAGE
20 49 47 4e 4f 52
45 44
1479
1480
1481 e37f 0d 00 FCB CR,$00
1482
1483 * NEXT
1484 e381 26 04 NEXT BNE LB0FE BRANCH IF ARGUMENT GIVEN
1485 e383 9e 74 LDX ZERO X = 0: DEFAULT FOR NO ARGUMENT
1486 e385 20 03 BRA LB101
1487 e387 bd e5 db LB0FE JSR LB357 EVALUATE AN ALPHA EXPRESSION
1488 e38a 9f 3b LB101 STX VARDES SAVE VARIABLE DESCRIPTOR POINTER
1489 e38c bd de b6 JSR LABF9 GO SCAN FOR ‘FOR/NEXT’ DATA ON STACK
1490 e38f 27 04 BEQ LB10C BRANCH IF DATA FOUND
1491 e391 c6 00 LDB #0 ‘NEXT WITHOUT FOR’ ERROR (SHOULD BE CLRB)
1492 e393 20 47 LB10A BRA LB153 PROCESS ERROR
1493 e395 1f 14 LB10C TFR X,S POINT S TO START OF ‘FOR/NEXT’ DATA
1494 e397 30 03 LEAX 3,X POINT X TO FP VALUE OF STEP
1495 e399 bd ee 5d JSR LBC14 COPY A FP NUMBER FROM (X) TO FPA0
1496 e39c a6 68 LDA 8,S GET THE DIRECTION OF STEP
1497 e39e 97 54 STA FP0SGN SAVE IT AS THE SIGN OF FPA0
1498 e3a0 9e 3b LDX VARDES POINT (X) TO INDEX VARIABLE DESCRIPTOR
1499 e3a2 bd ec 0b JSR LB9C2 ADD (X) TO FPA0 (STEP TO INDEX)
1500 e3a5 bd ee 7c JSR LBC33 PACK FPA0 AND STORE IT IN ADDRESS
1501 * CONTAINED IN VARDES
1502 e3a8 30 69 LEAX 9,S POINT (X) TO TERMINAL VALUE OF INDEX
1503 e3aa bd ee df JSR LBC96 COMPARE CURRENT INDEX VALUE TO TERMINAL VALUE OF INDEX
1504 e3ad e0 68 SUBB 8,S ACCB = 0 IF TERMINAL VALUE=CURRENT VALUE AND STEP=0 OR IF
1505 * STEP IS POSITIVE AND CURRENT VALUE>TERMINAL VALUE OR
1506 * STEP IS NEGATIVE AND CURRENT VALUE<TERMINAL VALUE
1507 e3af 27 0c BEQ LB134 BRANCH IF ‘FOR/NEXT’ LOOP DONE
1508 e3b1 ae 6e LDX 14,S * GET LINE NUMBER AND
1509 e3b3 9f 68 STX CURLIN * BASIC POINTER OF
1510 e3b5 ae e8 10 LDX 16,S * STATEMENT FOLLOWING THE
1511 e3b8 9f 83 STX CHARAD * PROPER FOR STATEMENT
1512 e3ba 7e e0 3f LB131 JMP LAD9E JUMP BACK TO COMMAND INTEPR. LOOP
1513 e3bd 32 e8 12 LB134 LEAS 18,S PULL THE ‘FOR-NEXT’ DATA OFF THE STACK
1514 e3c0 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1515 e3c2 81 2c CMPA #', CHECK FOR ANOTHER ARGUMENT
1516 e3c4 26 f4 BNE LB131 RETURN IF NONE
1517 e3c6 9d 7c JSR GETNCH GET NEXT CHARACTER FROM BASIC
1518 e3c8 8d bd BSR LB0FE BSR SIMULATES A CALL TO ‘NEXT’ FROM COMMAND LOOP
1519
1520
1521 e3ca 8d 13 LB141 BSR LB156 EVALUATE EXPRESSION AND DO A TYPE CHECK FOR NUMERIC
1522 e3cc 1c fe LB143 ANDCC #$FE CLEAR CARRY FLAG
1523 e3ce 7d LB145 FCB $7D OP CODE OF TST $1A01 - SKIP TWO BYTES (DO
1524 * NOT CHANGE CARRY FLAG)
1525 e3cf 1a 01 LB146 ORCC #1 SET CARRY
1526
1527 * STRING TYPE MODE CHECK - IF ENTERED AT LB146 THEN VALTYP PLUS IS 'TM' ERROR
1528 * NUMERIC TYPE MODE CHECK - IF ENTERED AT LB143 THEN VALTYP MINUS IS 'TM' ERROR
1529 * IF ENTERED AT LB148, A TYPE CHECK IS DONE ON VALTYP
1530 * IF ENTERED WITH CARRY SET, THEN 'TM' ERROR IF NUMERIC
1531 * IF ENTERED WITH CARRY CLEAR, THEN 'TM' ERROR IF STRING.
1532 e3d1 0d 06 LB148 TST VALTYP TEST TYPE FLAG; DO NOT CHANGE CARRY
1533 e3d3 25 03 BCS LB14F BRANCH IF STRING
1534 e3d5 2a 99 BPL LB0E7 RETURN ON PLUS
1535 e3d7 8c FCB SKP2 SKIP 2 BYTES - ‘TM’ ERROR
1536 e3d8 2b 96 LB14F BMI LB0E7 RETURN ON MINUS
1537 e3da c6 18 LDB #12*2 ‘TYPE M1SMATCH’ ERROR
1538 e3dc 7e df 03 LB153 JMP LAC46 PROCESS ERROR
1539 * EVALUATE EXPRESSION
1540 e3df 8d 6e LB156 BSR LB1C6 BACK UP INPUT POINTER
1541 e3e1 4f LB158 CLRA END OF OPERATION PRECEDENCE FLAG
1542 e3e2 8c FCB SKP2 SKIP TWO BYTES
1543 e3e3 34 04 LB15A PSHS B SAVE FLAG (RELATIONAL OPERATOR FLAG)
1544 e3e5 34 02 PSHS A SAVE FLAG (PRECEDENCE FLAG)
1545 e3e7 c6 01 LDB #1 *
1546 e3e9 bd de f0 JSR LAC33 * SEE IF ROOM IN FREE RAM FOR (B) WORDS
1547 e3ec bd e4 ac JSR LB223 GO EVALUATE AN EXPRESSION
1548 e3ef 0f 3f CLR TRELFL RESET RELATIONAL OPERATOR FLAG
1549 e3f1 9d 82 LB168 JSR GETCCH GET CURRENT INPUT CHARACTER
1550 * CHECK FOR RELATIONAL OPERATORS
1551 e3f3 80 ad LB16A SUBA #TOK_GREATER TOKEN FOR >
1552 e3f5 25 13 BCS LB181 BRANCH IF LESS THAN RELATIONAL OPERATORS
1553 e3f7 81 03 CMPA #3 *
1554 e3f9 24 0f BCC LB181 * BRANCH IF GREATER THAN RELATIONAL OPERATORS
1555 e3fb 81 01 CMPA #1 SET CARRY IF ‘>‘
1556 e3fd 49 ROLA CARRY TO BIT 0
1557 e3fe 98 3f EORA TRELFL * CARRY SET IF
1558 e400 91 3f CMPA TRELFL * TRELFL = ACCA
1559 e402 25 64 BCS LB1DF BRANCH IF SYNTAX ERROR : == << OR >>
1560 e404 97 3f STA TRELFL BIT 0: >, BIT 1 =, BIT 2: <
1561 e406 9d 7c JSR GETNCH GET AN INPUT CHARACTER
1562 e408 20 e9 BRA LB16A CHECK FOR ANOTHER RELATIONAL OPERATOR
1563 *
1564 e40a d6 3f LB181 LDB TRELFL GET RELATIONAL OPERATOR FLAG
1565 e40c 26 33 BNE LB1B8 BRANCH IF RELATIONAL COMPARISON
1566 e40e 10 24 00 6b LBCC LB1F4 BRANCH IF > RELATIONAL OPERATOR
1567 e412 8b 07 ADDA #7 SEVEN ARITHMETIC/LOGICAL OPERATORS
1568 e414 24 67 BCC LB1F4 BRANCH IF NOT ARITHMETIC/LOGICAL OPERATOR
1569 e416 99 06 ADCA VALTYP ADD CARRY, NUMERIC FLAG AND MODIFIED TOKEN NUMBER
1570 e418 10 27 04 77 LBEQ LB60F BRANCH IF VALTYP = FF, AND ACCA = ‘+‘ TOKEN -
1571 * CONCATENATE TWO STRINGS
1572 e41c 89 ff ADCA #-1 RESTORE ARITHMETIC/LOGICAL OPERATOR NUMBER
1573 e41e 34 02 PSHS A * STORE OPERATOR NUMBER ON STACK; MULTIPLY IT BY 2
1574 e420 48 ASLA * THEN ADD THE STORED STACK DATA = MULTIPLY
1575 e421 ab e0 ADDA ,S+ * X 3; 3 BYTE/TABLE ENTRY
1576 e423 8e dd 08 LDX #LAA51 JUMP TABLE FOR ARITHMETIC & LOGICAL OPERATORS
1577 e426 30 86 LEAX A,X POINT X TO PROPER TABLE
1578 e428 35 02 LB19F PULS A GET PRECEDENCE FLAG FROM STACK
1579 e42a a1 84 CMPA ,X COMPARE TO CURRENT OPERATOR
1580 e42c 24 55 BCC LB1FA BRANCH IF STACK OPERATOR > CURRENT OPERATOR
1581 e42e 8d 9c BSR LB143 ‘TM’ ERROR IF VARIABLE TYPE = STRING
1582
1583 * OPERATION BEING PROCESSED IS OF HIGHER PRECEDENCE THAN THE PREVIOUS OPERATION.
1584 e430 34 02 LB1A7 PSHS A SAVE PRECEDENCE FLAG
1585 e432 8d 29 BSR LB1D4 PUSH OPERATOR ROUTINE ADDRESS AND FPA0 ONTO STACK
1586 e434 9e 3d LDX RELPTR GET POINTER TO ARITHMETIC/LOGICAL TABLE ENTRY FOR
1587 * LAST CALCULATED OPERATION
1588 e436 35 02 PULS A GET PRECEDENCE FLAG OF PREVIOUS OPERATION
1589 e438 26 1d BNE LB1CE BRANCH IF NOT END OF OPERATION
1590 e43a 4d TSTA CHECK TYPE OF PRECEDENCE FLAG
1591 e43b 10 27 00 6a LBEQ LB220 BRANCH IF END OF EXPRESSION OR SUB-EXPRESSION
1592 e43f 20 4b BRA LB203 EVALUATE AN OPERATION
1593
1594 e441 08 06 LB1B8 ASL VALTYP BIT 7 OF TYPE FLAG TO CARRY
1595 e443 59 ROLB SHIFT RELATIONAL FLAG LEFT - VALTYP TO BIT 0
1596 e444 8d 09 BSR LB1C6 MOVE THE INPUT POINTER BACK ONE
1597 e446 8e e4 54 LDX #LB1CB POINT X TO RELATIONAL COMPARISON JUMP TABLE
1598 e449 d7 3f STB TRELFL SAVE RELATIONAL COMPARISON DATA
1599 e44b 0f 06 CLR VALTYP SET VARIABLE TYPE TO NUMERIC
1600 e44d 20 d9 BRA LB19F PERFORM OPERATION OR SAVE ON STACK
1601
1602 e44f 9e 83 LB1C6 LDX CHARAD * GET BASIC’S INPUT POINTER AND
1603 e451 7e e1 68 JMP LAEBB * MOVE IT BACK ONE
1604 * RELATIONAL COMPARISON JUMP TABLE
1605 e454 64 LB1CB FCB $64 RELATIONAL COMPARISON FLAG
1606 e455 e5 78 LB1CC FDB LB2F4 JUMP ADDRESS
1607
1608 e457 a1 84 LB1CE CMPA ,X COMPARE PRECEDENCE OF LAST DONE OPERATION TO
1609 * NEXT TO BE DONE OPERATION
1610 e459 24 31 BCC LB203 EVALUATE OPERATION IF LOWER PRECEDENCE
1611 e45b 20 d3 BRA LB1A7 PUSH OPERATION DATA ON STACK IF HIGHER PRECEDENCE
1612
1613 * PUSH OPERATOR EVALUATION ADDRESS AND FPA0 ONTO STACK AND EVALUATE ANOTHER EXPR
1614 e45d ec 01 LB1D4 LDD 1,X GET ADDRESS OF OPERATOR ROUTINE
1615 e45f 34 06 PSHS B,A SAVE IT ON THE STACK
1616 e461 8d 08 BSR LB1E2 PUSH FPA0 ONTO STACK
1617 e463 d6 3f LDB TRELFL GET BACK RELATIONAL OPERATOR FLAG
1618 e465 16 ff 7b LBRA LB15A EVALUATE ANOTHER EXPRESSION
1619 e468 7e e5 00 LB1DF JMP LB277 ‘SYNTAX ERROR’
1620 * PUSH FPA0 ONTO THE STACK. ,S = EXPONENT
1621 * 1-2,S =HIGH ORDER MANTISSA 3-4,S = LOW ORDER MANTISSA
1622 * 5,S = SIGN RETURN WITH PRECEDENCE CODE IN ACCA
1623 e46b d6 54 LB1E2 LDB FP0SGN GET SIGN OF FPA0 MANTISSA
1624 e46d a6 84 LDA ,X GET PRECEDENCE CODE TO ACCA
1625 e46f 35 20 LB1E6 PULS Y GET RETURN ADDRESS FROM STACK & PUT IT IN Y
1626 e471 34 04 PSHS B SAVE ACCB ON STACK
1627 e473 d6 4f LB1EA LDB FP0EXP * PUSH FPA0 ONTO THE STACK
1628 e475 9e 50 LDX FPA0 *
1629 e477 de 52 LDU FPA0+2 *
1630 e479 34 54 PSHS U,X,B *
1631 e47b 6e a4 JMP ,Y JUMP TO ADDRESS IN Y
1632
1633 * BRANCH HERE IF NON-OPERATOR CHARACTER FOUND - USUALLY ‘)‘ OR END OF LINE
1634 e47d 9e 74 LB1F4 LDX ZERO POINT X TO DUMMY VALUE (ZERO)
1635 e47f a6 e0 LDA ,S+ GET PRECEDENCE FLAG FROM STACK
1636 e481 27 26 BEQ LB220 BRANCH IF END OF EXPRESSION
1637 e483 81 64 LB1FA CMPA #$64 * CHECK FOR RELATIONAL COMPARISON FLAG
1638 e485 27 03 BEQ LB201 * AND BRANCH IF RELATIONAL COMPARISON
1639 e487 bd e3 cc JSR LB143 ‘TM’ ERROR IF VARIABLE TYPE = STRING
1640 e48a 9f 3d LB201 STX RELPTR SAVE POINTER TO OPERATOR ROUTINE
1641 e48c 35 04 LB203 PULS B GET RELATIONAL OPERATOR FLAG FROM STACK
1642 e48e 81 5a CMPA #$5A CHECK FOR ‘NOT’ OPERATOR
1643 e490 27 19 BEQ LB222 RETURN IF ‘NOT’ - NO RELATIONAL COMPARISON
1644 e492 81 7d CMPA #$7D CHECK FOR NEGATION (UNARY) FLAG
1645 e494 27 15 BEQ LB222 RETURN IF NEGATION - NO RELATIONAL COMPARISON
1646
1647 * EVALUATE AN OPERATION. EIGHT BYTES WILL BE STORED ON STACK, FIRST SIX BYTES
1648 * ARE A TEMPORARY FLOATING POINT RESULT THEN THE ADDRESS OF ROUTINE WHICH
1649 * WILL EVALUATE THE OPERATION. THE RTS AT END OF ROUTINE WILL VECTOR
1650 * TO EVALUATING ROUTINE.
1651 e496 54 LSRB = ROTATE VALTYP BIT INTO CARRY
1652 e497 d7 0a STB RELFLG = FLAG AND SAVE NEW RELFLG
1653 e499 35 52 PULS A,X,U * PULL A FP VALUE OFF OF THE STACK
1654 e49b 97 5c STA FP1EXP * AND SAVE IT IN FPA1
1655 e49d 9f 5d STX FPA1 *
1656 e49f df 5f STU FPA1+2 *
1657 e4a1 35 04 PULS B = GET MANTISSA SIGN AND
1658 e4a3 d7 61 STB FP1SGN = SAVE IT IN FPA1
1659 e4a5 d8 54 EORB FP0SGN EOR IT WITH FPA1 MANTISSA SIGN
1660 e4a7 d7 62 STB RESSGN SAVE IT IN RESULT SIGN BYTE
1661 e4a9 d6 4f LB220 LDB FP0EXP GET EXPONENT OF FPA0
1662 e4ab 39 LB222 RTS
1663
1664 e4ac bd f6 f9 LB223 JSR XVEC15 CALL EXTENDED BASIC ADD-IN
1665 e4af 0f 06 CLR VALTYP INITIALIZE TYPE FLAG TO NUMERIC
1666 e4b1 9d 7c JSR GETNCH GET AN INPUT CHAR
1667 e4b3 24 03 BCC LB22F BRANCH IF NOT NUMERIC
1668 e4b5 7e ef 5b LB22C JMP LBD12 CONVERT ASCII STRING TO FLOATING POINT -
1669 * RETURN RESULT IN FPA0
1670 * PROCESS A NON NUMERIC FIRST CHARACTER
1671 e4b8 bd e6 26 LB22F JSR LB3A2 SET CARRY IF NOT ALPHA
1672 e4bb 24 50 BCC LB284 BRANCH IF ALPHA CHARACTER
1673 e4bd 81 2e CMPA #'. IS IT ‘.‘ (DECIMAL POINT)?
1674 e4bf 27 f4 BEQ LB22C CONVERT ASCII STRING TO FLOATING POINT
1675 e4c1 81 a7 CMPA #TOK_MINUS MINUS TOKEN
1676 e4c3 27 40 BEQ LB27C YES - GO PROCESS THE MINUS OPERATOR
1677 e4c5 81 a6 CMPA #TOK_PLUS PLUS TOKEN
1678 e4c7 27 e3 BEQ LB223 YES - GET ANOTHER CHARACTER
1679 e4c9 81 22 CMPA #'" STRING DELIMITER?
1680 e4cb 26 0a BNE LB24E NO
1681 e4cd 9e 83 LB244 LDX CHARAD CURRENT BASIC POINTER TO X
1682 e4cf bd e7 9c JSR LB518 SAVE STRING ON STRING STACK
1683 e4d2 9e 64 LB249 LDX COEFPT * GET ADDRESS OF END OF STRING AND
1684 e4d4 9f 83 STX CHARAD * PUT BASIC’S INPUT POINTER THERE
1685 e4d6 39 RTS
1686 e4d7 81 a3 LB24E CMPA #TOK_NOT NOT TOKEN?
1687 e4d9 26 0d BNE LB25F NO
1688 * PROCESS THE NOT OPERATOR
1689 e4db 86 5a LDA #$5A ‘NOT’ PRECEDENCE FLAG
1690 e4dd bd e3 e3 JSR LB15A PROCESS OPERATION FOLLOWING ‘NOT’
1691 e4e0 bd e6 71 JSR INTCNV CONVERT FPA0 TO INTEGER IN ACCD
1692 e4e3 43 COMA * ‘NOT’ THE INTEGER
1693 e4e4 53 COMB *
1694 e4e5 7e e7 78 JMP GIVABF CONVERT ACCD TO FLOATING POINT (FPA0)
1695 e4e8 4c LB25F INCA CHECK FOR TOKENS PRECEEDED BY $FF
1696 e4e9 27 2e BEQ LB290 IT WAS PRECEEDED BY $FF
1697 e4eb 8d 06 LB262 BSR LB26A SYNTAX CHECK FOR A ‘(‘
1698 e4ed bd e3 df JSR LB156 EVALUATE EXPRESSIONS WITHIN PARENTHESES AT
1699 * HIGHEST PRECEDENCE
1700 e4f0 c6 29 LB267 LDB #') SYNTAX CHECK FOR ‘)‘
1701 e4f2 8c FCB SKP2 SKIP 2 BYTES
1702 e4f3 c6 28 LB26A LDB #'( SYNTAX CHECK FOR ‘(‘
1703 e4f5 8c FCB SKP2 SKIP 2 BYTES
1704 e4f6 c6 2c LB26D LDB #', SYNTAX CHECK FOR COMMA
1705 e4f8 e1 9f 00 83 LB26F CMPB [CHARAD] * COMPARE ACCB TO CURRENT INPUT
1706 e4fc 26 02 BNE LB277 * CHARACTER - SYNTAX ERROR IF NO MATCH
1707 e4fe 0e 7c JMP GETNCH GET A CHARACTER FROM BASIC
1708 e500 c6 02 LB277 LDB #2*1 SYNTAX ERROR
1709 e502 7e df 03 JMP LAC46 JUMP TO ERROR HANDLER
1710
1711 * PROCESS THE MINUS (UNARY) OPERATOR
1712 e505 86 7d LB27C LDA #$7D MINUS (UNARY) PRECEDENCE FLAG
1713 e507 bd e3 e3 JSR LB15A PROCESS OPERATION FOLLOWING ‘UNARY’ NEGATION
1714 e50a 7e f1 32 JMP LBEE9 CHANGE SIGN OF FPA0 MANTISSA
1715
1716 * EVALUATE ALPHA EXPRESSION
1717 e50d bd e5 db LB284 JSR LB357 FIND THE DESCRIPTOR ADDRESS OF A VARIABLE
1718 e510 9f 52 LB287 STX FPA0+2 SAVE DESCRIPTOR ADDRESS IN FPA0
1719 e512 96 06 LDA VALTYP TEST VARIABLE TYPE
1720 e514 26 95 BNE LB222 RETURN IF STRING
1721 e516 7e ee 5d JMP LBC14 COPY A FP NUMBER FROM (X) TO FPA0
1722
1723 * EVALUATING A SECONDARY TOKEN
1724 e519 9d 7c LB290 JSR GETNCH GET AN INPUT CHARACTER (SECONDARY TOKEN)
1725 e51b 1f 89 TFR A,B SAVE IT IN ACCB
1726 e51d 58 ASLB X2 & BET RID OF BIT 7
1727 e51e 9d 7c JSR GETNCH GET ANOTHER INPUT CHARACTER
1728 e520 c1 38 CMPB #NUM_SEC_FNS-1*2 29 SECONDARY FUNCTIONS - 1
1729 e522 23 03 BLS LB29F BRANCH IF COLOR BASIC TOKEN
1730 e524 7e e5 00 JMP LB277 SYNTAX ERROR
1731 e527 34 04 LB29F PSHS B SAVE TOKEN OFFSET ON STACK
1732 e529 c1 2a CMPB #TOK_LEFT-$80*2 CHECK FOR TOKEN WITH AN ARGUMENT
1733 e52b 25 1e BCS LB2C7 DO SECONDARIES STRING$ OR LESS
1734 e52d c1 30 CMPB #TOK_INKEY-$80*2 *
1735 e52f 24 1c BCC LB2C9 * DO SECONDARIES $92 (INKEY$) OR >
1736 e531 8d c0 BSR LB26A SYNTAX CHECK FOR A ‘(‘
1737 e533 a6 e4 LDA ,S GET TOKEN NUMBER
1738 * DO SECONDARIES (LEFT$, RIGHT$, MID$)
1739 e535 bd e3 df JSR LB156 EVALUATE FIRST STRING IN ARGUMENT
1740 e538 8d bc BSR LB26D SYNTAX CHECK FOR A COMMA
1741 e53a bd e3 cf JSR LB146 ‘TM’ ERROR IF NUMERIC VARiABLE
1742 e53d 35 02 PULS A GET TOKEN OFFSET FROM STACK
1743 e53f de 52 LDU FPA0+2 POINT U TO STRING DESCRIPTOR
1744 e541 34 42 PSHS U,A SAVE TOKEN OFFSET AND DESCRIPTOR ADDRESS
1745 e543 bd e9 8f JSR LB70B EVALUATE FIRST NUMERIC ARGUMENT
1746 e546 35 02 PULS A GET TOKEN OFFSET FROM STACK
1747 e548 34 06 PSHS B,A SAVE TOKEN OFFSET AND NUMERIC ARGUMENT
1748 e54a 8e FCB $8E OP CODE OF LDX# - SKlP 2 BYTES
1749 e54b 8d 9e LB2C7 BSR LB262 SYNTAX CHECK FOR A ‘(‘
1750 e54d 35 04 LB2C9 PULS B GET TOKEN OFFSET
1751 e54f be db f6 LDX COMVEC+8 GET SECONDARY FUNCTION JUMP TABLE ADDRESS
1752 e552 3a LB2CE ABX ADD IN COMMAND OFFSET
1753 *
1754 * HERE IS WHERE WE BRANCH TO A SECONDARY FUNCTION
1755 e553 ad 94 JSR [,X] GO DO AN SECONDARY FUNCTION
1756 e555 7e e3 cc JMP LB143 ‘TM’ ERROR IF VARIABLE TYPE = STRING
1757
1758 * LOGICAL OPERATOR ‘OR’ JUMPS HERE
1759 e558 86 LB2D4 FCB SKP1LD SKIP ONE BYTE - ‘OR’ FLAG = $4F
1760
1761 * LOGICAL OPERATOR ‘AND’ JUMPS HERE
1762 e559 4f LB2D5 CLRA AND FLAG = 0
1763 e55a 97 03 STA TMPLOC AND/OR FLAG
1764 e55c bd e6 71 JSR INTCNV CONVERT FPA0 INTO AN INTEGER IN ACCD
1765 e55f dd 01 STD CHARAC TEMP SAVE ACCD
1766 e561 bd ee 93 JSR LBC4A MOVE FPA1 TO FPA0
1767 e564 bd e6 71 JSR INTCNV CONVERT FPA0 INTO AN INTEGER IN ACCD
1768 e567 0d 03 TST TMPLOC CHECK AND/OR FLAG
1769 e569 26 06 BNE LB2ED BRANCH IF OR
1770 e56b 94 01 ANDA CHARAC * ‘AND’ ACCD WITH FPA0 INTEGER
1771 e56d d4 02 ANDB ENDCHR * STORED IN ENDCHR
1772 e56f 20 04 BRA LB2F1 CONVERT TO FP
1773 e571 9a 01 LB2ED ORA CHARAC * ‘OR’ ACCD WITH FPA0 INTEGER
1774 e573 da 02 ORB ENDCHR * STORED IN CHARAC
1775 e575 7e e7 78 LB2F1 JMP GIVABF CONVERT THE VALUE IN ACCD INTO A FP NUMBER
1776
1777 * RELATIONAL COMPARISON PROCESS HANDLER
1778 e578 bd e3 d1 LB2F4 JSR LB148 ‘TM’ ERROR IF TYPE MISMATCH
1779 e57b 26 10 BNE LB309 BRANCH IF STRING VARIABLE
1780 e57d 96 61 LDA FP1SGN * ‘PACK’ THE MANTISSA
1781 e57f 8a 7f ORA #$7F * SIGN OF FPA1 INTO
1782 e581 94 5d ANDA FPA1 * BIT 7 OF THE
1783 e583 97 5d STA FPA1 * MANTISSA MS BYTE
1784 e585 8e 00 5c LDX #FP1EXP POINT X TO FPA1
1785 e588 bd ee df JSR LBC96 COMPARE FPA0 TO FPA1
1786 e58b 20 36 BRA LB33F CHECK TRUTH OF RELATIONAL COMPARISON
1787
1788 * RELATIONAL COMPARISON OF STRINGS
1789 e58d 0f 06 LB309 CLR VALTYP SET VARIABLE TYPE TO NUMERIC
1790 e58f 0a 3f DEC TRELFL REMOVE STRING TYPE FLAG (BIT0=1 FOR STRINGS) FROM THE
1791 * DESIRED RELATIONAL COMPARISON DATA
1792 e591 bd e8 db JSR LB657 GET LENGTH AND ADDRESS OF STRING WHOSE
1793 * DESCRIPTOR ADDRESS IS IN THE BOTTOM OF FPA0
1794 e594 d7 56 STB STRDES * SAVE LENGTH AND ADDRESS IN TEMPORARY
1795 e596 9f 58 STX STRDES+2 * DESCRIPTOR (STRING B)
1796 e598 9e 5f LDX FPA1+2 = RETURN LENGTH AND ADDRESS OF STRING
1797 e59a bd e8 dd JSR LB659 = WHOSE DESCRIPTOR ADDRESS IS STORED IN FPA1+2
1798 e59d 96 56 LDA STRDES LOAD ACCA WITH LENGTH OF STRING B
1799 e59f 34 04 PSHS B SAVE LENGTH A ON STACK
1800 e5a1 a0 e0 SUBA ,S+ SUBTRACT LENGTH A FROM LENGTH B
1801 e5a3 27 07 BEQ LB328 BRANCH IF STRINGS OF EQUAL LENGTH
1802 e5a5 86 01 LDA #1 TRUE FLAG
1803 e5a7 24 03 BCC LB328 TRUE IF LENGTH B > LENGTH A
1804 e5a9 d6 56 LDB STRDES LOAD ACCB WITH LENGTH B
1805 e5ab 40 NEGA SET FLAG = FALSE (1FF)
1806 e5ac 97 54 LB328 STA FP0SGN SAVE TRUE/FALSE FLAG
1807 e5ae de 58 LDU STRDES+2 POINT U TO START OF STRING
1808 e5b0 5c INCB COMPENSATE FOR THE DECB BELOW
1809 * ENTER WITH ACCB CONTAINING LENGTH OF SHORTER STRING
1810 e5b1 5a LB32D DECB DECREMENT SHORTER STRING LENGTH
1811 e5b2 26 04 BNE LB334 BRANCH IF ALL OF STRING NOT COMPARED
1812 e5b4 d6 54 LDB FP0SGN GET TRUE/FALSE FLAB
1813 e5b6 20 0b BRA LB33F CHECK TRUTH OF RELATIONAL COMPARISON
1814 e5b8 a6 80 LB334 LDA ,X+ GET A BYTE FROM STRING A
1815 e5ba a1 c0 CMPA ,U+ COMPARE TO STRING B
1816 e5bc 27 f3 BEQ LB32D CHECK ANOTHER CHARACTER IF =
1817 e5be c6 ff LDB #$FF FALSE FLAG IF STRING A > B
1818 e5c0 24 01 BCC LB33F BRANCH IF STRING A > STRING B
1819 e5c2 50 NEGB SET FLAG = TRUE
1820
1821 * DETERMINE TRUTH OF COMPARISON - RETURN RESULT IN FPA0
1822 e5c3 cb 01 LB33F ADDB #1 CONVERT $FF,0,1 TO 0,1,2
1823 e5c5 59 ROLB NOW IT’S 1,2,4 FOR > = <
1824 e5c6 d4 0a ANDB RELFLG ‘AND’ THE ACTUAL COMPARISON WITH THE DESIRED -
1825 COMPARISON
1826 e5c8 27 02 BEQ LB348 BRANCH IF FALSE (NO MATCHING BITS)
1827 e5ca c6 ff LDB #$FF TRUE FLAG
1828 e5cc 7e ee c5 LB348 JMP LBC7C CONVERT ACCB INTO FP NUMBER IN FPA0
1829
1830 * DIM
1831 e5cf bd e4 f6 LB34B JSR LB26D SYNTAX CHECK FOR COMMA
1832 e5d2 c6 01 DIM LDB #1 DIMENSION FLAG
1833 e5d4 8d 08 BSR LB35A SAVE ARRAY SPACE FOR THIS VARIABLE
1834 e5d6 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1835 e5d8 26 f5 BNE LB34B KEEP DIMENSIONING IF NOT END OF LINE
1836 e5da 39 RTS
1837 * EVALUATE A VARIABLE - RETURN X AND
1838 * VARPTR POINTING TO VARIABLE DESCRIPTOR
1839 * EACH VARIABLE REQUIRES 7 BYTES - THE FIRST TWO
1840 * BYTES ARE THE VARIABLE NAME AND THE NEXT 5
1841 * BYTES ARE THE DESCRIPTOR. IF BIT 7 OF THE
1842 * FIRST BYTE OF VARlABLE NAME IS SET, THE
1843 * VARIABLE IS A DEF FN VARIABLE. IF BIT 7 OF
1844 * THE SECOND BYTE OF VARIABLE NAME IS SET, THE
1845 * VARIABLE IS A STRING, OTHERWISE THE VARIABLE
1846 * IS NUMERIC.
1847 * IF THE VARIABLE IS NOT FOUND, A ZERO VARIABLE IS
1848 * INSERTED INTO THE VARIABLE SPACE
1849 e5db 5f LB357 CLRB DIMENSION FLAG = 0; DO NOT SET UP AN ARRAY
1850 e5dc 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1851 e5de d7 05 LB35A STB DIMFLG SAVE ARRAY FLAG
1852 * ENTRY POINT FOR DEF FN VARIABLE SEARCH
1853 e5e0 97 37 LB35C STA VARNAM SAVE INPUT CHARACTER
1854 e5e2 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1855 e5e4 8d 40 BSR LB3A2 SET CARRY IF NOT ALPHA
1856 e5e6 10 25 ff 16 LBCS LB277 SYNTAX ERROR IF NOT ALPHA
1857 e5ea 5f CLRB DEFAULT 2ND VARIABLE CHARACTER TO ZERO
1858 e5eb d7 06 STB VALTYP SET VARIABLE TYPE TO NUMERIC
1859 e5ed 9d 7c JSR GETNCH GET ANOTHER CHARACTER FROM BASIC
1860 e5ef 25 04 BCS LB371 BRANCH IF NUMERIC (2ND CHARACTER IN
1861 * VARIABLE MAY BE NUMERIC)
1862 e5f1 8d 33 BSR LB3A2 SET CARRY IF NOT ALPHA
1863 e5f3 25 0a BCS LB37B BRANCH IF NOT ALPHA
1864 e5f5 1f 89 LB371 TFR A,B SAVE 2ND CHARACTER IN ACCB
1865 * READ INPUT CHARACTERS UNTIL A NON ALPHA OR
1866 * NON NUMERIC IS FOUND - IGNORE ALL CHARACTERS
1867 * IN VARIABLE NAME AFTER THE 1ST TWO
1868 e5f7 9d 7c LB373 JSR GETNCH GET AN INPUT CHARACTER
1869 e5f9 25 fc BCS LB373 BRANCH IF NUMERIC
1870 e5fb 8d 29 BSR LB3A2 SET CARRY IF NOT ALPHA
1871 e5fd 24 f8 BCC LB373 BRANCH IF ALPHA
1872 e5ff 81 24 LB37B CMPA #'$ CHECK FOR A STRING VARIABLE
1873 e601 26 06 BNE LB385 BRANCH IF IT IS NOT A STRING
1874 e603 03 06 COM VALTYP SET VARIABLE TYPE TO STRING
1875 e605 cb 80 ADDB #$80 SET BIT 7 OF 2ND CHARACTER (STRING)
1876 e607 9d 7c JSR GETNCH GET AN INPUT CHARACTER
1877 e609 d7 38 LB385 STB VARNAM+1 SAVE 2ND CHARACTER IN VARNAM+1
1878 e60b 9a 08 ORA ARYDIS OR IN THE ARRAY DISABLE FLAG - IF = $80,
1879 * DON’T SEARCH FOR VARIABLES IN THE ARRAYS
1880 e60d 80 28 SUBA #'( IS THIS AN ARRAY VARIABLE?
1881 e60f 10 27 00 75 LBEQ LB404 BRANCH IF IT IS
1882 e613 0f 08 CLR ARYDIS RESET THE ARRAY DISABLE FLAG
1883 e615 9e 1b LDX VARTAB POINT X TO THE START OF VARIABLES
1884 e617 dc 37 LDD VARNAM GET VARIABLE IN QUESTION
1885 e619 9c 1d LB395 CMPX ARYTAB COMPARE X TO THE END OF VARIABLES
1886 e61b 27 12 BEQ LB3AB BRANCH IF END OF VARIABLES
1887 e61d 10 a3 81 CMPD ,X++ * COMPARE VARIABLE IN QUESTION TO CURRENT
1888 e620 27 3e BEQ LB3DC * VARIABLE AND BRANCH IF MATCH
1889 e622 30 05 LEAX 5,X = MOVE POINTER TO NEXT VARIABLE AND
1890 e624 20 f3 BRA LB395 = KEEP LOOKING
1891
1892 * SET CARRY IF NOT UPPER CASE ALPHA
1893 e626 81 41 LB3A2 CMPA #'A * CARRY SET IF < ‘A’
1894 e628 25 04 BCS LB3AA *
1895 e62a 80 5b SUBA #'Z+1 =
1896 * SUBA #-('Z+1) = CARRY CLEAR IF <= 'Z'
1897 e62c 80 a5 FCB $80,$A5
1898 e62e 39 LB3AA RTS
1899 * PUT A NEW VARIABLE IN TABLE OF VARIABLES
1900 e62f 8e 00 74 LB3AB LDX #ZERO POINT X TO ZERO LOCATION
1901 e632 ee e4 LDU ,S GET CURRENT RETURN ADDRESS
1902 e634 11 83 e5 10 CMPU #LB287 DID WE COME FROM ‘EVALUATE ALPHA EXPR’?
1903 e638 27 28 BEQ LB3DE YES - RETURN A ZERO VALUE
1904 e63a dc 1f LDD ARYEND * GET END OF ARRAYS ADDRESS AND
1905 e63c dd 43 STD V43 * SAVE IT AT V43
1906 e63e c3 00 07 ADDD #7 = ADD 7 TO END OF ARRAYS (EACH
1907 e641 dd 41 STD V41 = VARIABLE = 7 BYTES) AND SAVE AT V41
1908 e643 9e 1d LDX ARYTAB * GET END OF VARIABLES AND SAVE AT V47
1909 e645 9f 47 STX V47 *
1910 e647 bd de db JSR LAC1E MAKE A SEVEN BYTE SLOT FOR NEW VARIABLE AT
1911 * TOP OF VARIABLES
1912 e64a 9e 41 LDX V41 = GET NEW END OF ARRAYS AND SAVE IT
1913 e64c 9f 1f STX ARYEND =
1914 e64e 9e 45 LDX V45 * GET NEW END OF VARIABLES AND SAVE IT
1915 e650 9f 1d STX ARYTAB *
1916 e652 9e 47 LDX V47 GET OLD END OF VARIABLES
1917 e654 dc 37 LDD VARNAM GET NEW VARIABLE NAME
1918 e656 ed 81 STD ,X++ SAVE VARIABLE NAME
1919 e658 4f CLRA * ZERO OUT THE FP VALUE OF THE NUMERIC
1920 e659 5f CLRB * VARIABLE OR THE LENGTH AND ADDRESS
1921 e65a ed 84 STD ,X * OF A STRING VARIABLE
1922 e65c ed 02 STD 2,X *
1923 e65e a7 04 STA 4,X *
1924 e660 9f 39 LB3DC STX VARPTR STORE ADDRESS OF VARIABLE VALUE
1925 e662 39 LB3DE RTS
1926 *
1927 e663 90 80 00 00 00 LB3DF FCB $90,$80,$00,$00,$00 * FLOATING POINT -32768
1928 * SMALLEST SIGNED TWO BYTE INTEGER
1929 *
1930 e668 9d 7c LB3E4 JSR GETNCH GET AN INPUT CHARACTER FROM BASIC
1931 e66a bd e3 ca LB3E6 JSR LB141 GO EVALUATE NUMERIC EXPRESSION
1932 e66d 96 54 LB3E9 LDA FP0SGN GET FPA0 MANTISSA SIGN
1933 e66f 2b 5d BMI LB44A ‘FC’ ERROR IF NEGATIVE NUMBER
1934
1935
1936 e671 bd e3 cc INTCNV JSR LB143 ‘TM’ ERROR IF STRING VARIABLE
1937 e674 96 4f LDA FP0EXP GET FPA0 EXPONENT
1938 e676 81 90 CMPA #$90 * COMPARE TO 32768 - LARGEST INTEGER EXPONENT AND
1939 e678 25 08 BCS LB3FE * BRANCH IF FPA0 < 32768
1940 e67a 8e e6 63 LDX #LB3DF POINT X TO FP VALUE OF -32768
1941 e67d bd ee df JSR LBC96 COMPARE -32768 TO FPA0
1942 e680 26 4c BNE LB44A ‘FC’ ERROR IF NOT =
1943 e682 bd ef 11 LB3FE JSR LBCC8 CONVERT FPA0 TO A TWO BYTE INTEGER
1944 e685 dc 52 LDD FPA0+2 GET THE INTEGER
1945 e687 39 RTS
1946 * EVALUATE AN ARRAY VARIABLE
1947 e688 dc 05 LB404 LDD DIMFLG GET ARRAY FLAG AND VARIABLE TYPE
1948 e68a 34 06 PSHS B,A SAVE THEM ON STACK
1949 e68c 12 NOP DEAD SPACE CAUSED BY 1.2 REVISION
1950 e68d 5f CLRB RESET DIMENSION COUNTER
1951 e68e 9e 37 LB40A LDX VARNAM GET VARIABLE NAME
1952 e690 34 14 PSHS X,B SAVE VARIABLE NAME AND DIMENSION COUNTER
1953 e692 8d d4 BSR LB3E4 EVALUATE EXPRESSION (DIMENSlON LENGTH)
1954 e694 35 34 PULS B,X,Y PULL OFF VARIABLE NAME, DIMENSlON COUNTER,
1955 * ARRAY FLAG
1956 e696 9f 37 STX VARNAM SAVE VARIABLE NAME AND VARIABLE TYPE
1957 e698 de 52 LDU FPA0+2 GET DIMENSION LENGTH
1958 e69a 34 60 PSHS U,Y SAVE DIMENSION LENGTH, ARRAY FLAG, VARIABLE TYPE
1959 e69c 5c INCB INCREASE DIMENSION COUNTER
1960 e69d 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1961 e69f 81 2c CMPA #', CHECK FOR ANOTHER DIMENSION
1962 e6a1 27 eb BEQ LB40A BRANCH IF MORE
1963 e6a3 d7 03 STB TMPLOC SAVE DIMENSION COUNTER
1964 e6a5 bd e4 f0 JSR LB267 SYNTAX CHECK FOR A ‘)‘
1965 e6a8 35 06 PULS A,B * RESTORE VARIABLE TYPE AND ARRAY
1966 e6aa dd 05 STD DIMFLG * FLAG - LEAVE DIMENSION LENGTH ON STACK
1967 e6ac 9e 1d LDX ARYTAB GET START OF ARRAYS
1968 e6ae 9c 1f LB42A CMPX ARYEND COMPARE TO END OF ARRAYS
1969 e6b0 27 21 BEQ LB44F BRANCH IF NO MATCH FOUND
1970 e6b2 dc 37 LDD VARNAM GET VARIABLE IN QUESTION
1971 e6b4 10 a3 84 CMPD ,X COMPARE TO CURRENT VARIABLE
1972 e6b7 27 06 BEQ LB43B BRANCH IF =
1973 e6b9 ec 02 LDD 2,X GET OFFSET TO NEXT ARRAY VARIABLE
1974 e6bb 30 8b LEAX D,X ADD TO CURRENT POINTER
1975 e6bd 20 ef BRA LB42A KEEP SEARCHING
1976 e6bf c6 12 LB43B LDB #2*9 ‘REDIMENSIONED ARRAY’ ERROR
1977 e6c1 96 05 LDA DIMFLG * TEST ARRAY FLAG - IF <>0 YOU ARE TRYING
1978 e6c3 26 0b BNE LB44C * TO REDIMENSION AN ARRAY
1979 e6c5 d6 03 LDB TMPLOC GET NUMBER OF DIMENSIONS IN ARRAY
1980 e6c7 e1 04 CMPB 4,X COMPARE TO THIS ARRAYS DIMENSIONS
1981 e6c9 27 59 BEQ LB4A0 BRANCH IF =
1982 e6cb c6 10 LB447 LDB #8*2 ‘BAD SUBSCRIPT’
1983 e6cd 8c FCB SKP2 SKIP TWO BYTES
1984 e6ce c6 08 LB44A LDB #4*2 ‘ILLEGAL FUNCTION CALL’
1985 e6d0 7e df 03 LB44C JMP LAC46 JUMP TO ERROR SERVICING ROUTINE
1986
1987 * INSERT A NEW ARRAY INTO ARRAY VARIABLES
1988 * EACH SET OF ARRAY VARIABLES IS PRECEEDED BY A DE-
1989 * SCRIPTOR BLOCK COMPOSED OF 5+2*N BYTES WHERE N IS THE
1990 * NUMBER OF DIMENSIONS IN THE ARRAY. THE BLOCK IS DEFINED
1991 * AS FOLLOWS: BYTES 0,1:VARIABLE’S NAME; 2,3:TOTAL LENGTH
1992 * OF ARRAY ITEMS AND DESCRIPTOR BLOCK; 4:NUMBER OF DIMEN-
1993 * ISIONS; 5,6:LENGTH OF DIMENSION 1; 7,8:LENGTH OF DIMEN-
1994 * SION 2;… 4+N,5+N:LENGTH OF DIMENSION N.
1995
1996 e6d3 cc 00 05 LB44F LDD #5 * 5 BYTES/ARRAY ENTRY SAVE AT COEFPT
1997 e6d6 dd 64 STD COEFPT *
1998 e6d8 dc 37 LDD VARNAM = GET NAME OF ARRAY AND SAVE IN
1999 e6da ed 84 STD ,X = FIRST 2 BYTES OF DESCRIPTOR
2000 e6dc d6 03 LDB TMPLOC GET NUMBER OF DIMENSIONS AND SAVE IN
2001 e6de e7 04 STB 4,X * 5TH BYTE OF DESCRIPTOR
2002 e6e0 bd de f0 JSR LAC33 CHECK FOR ROOM FOR DESCRIPTOR IN FREE RAM
2003 e6e3 9f 41 STX V41 TEMPORARILY SAVE DESCRIPTOR ADDRESS
2004 e6e5 c6 0b LB461 LDB #11 * DEFAULT DIMENSION VALUE:X(10)
2005 e6e7 4f CLRA *
2006 e6e8 0d 05 TST DIMFLG = CHECK ARRAY FLAG AND BRANCH IF
2007 e6ea 27 05 BEQ LB46D = NOT DIMENSIONING AN ARRAY
2008 e6ec 35 06 PULS A,B GET DIMENSION LENGTH
2009 e6ee c3 00 01 ADDD #1 ADD ONE (X(0) HAS A LENGTH OF ONE)
2010 e6f1 ed 05 LB46D STD 5,X SAVE LENGTH OF ARRAY DIMENSION
2011 e6f3 8d 5d BSR LB4CE MULTIPLY ACCUM ARRAY SIZE NUMBER LENGTH
2012 * OF NEW DIMENSION
2013 e6f5 dd 64 STD COEFPT TEMP STORE NEW CURRENT ACCUMULATED ARRAY SIZE
2014 e6f7 30 02 LEAX 2,X BUMP POINTER UP TWO
2015 e6f9 0a 03 DEC TMPLOC * DECREMENT DIMENSION COUNTER AND BRANCH IF
2016 e6fb 26 e8 BNE LB461 * NOT DONE WITH ALL DIMENSIONS
2017 e6fd 9f 0f STX TEMPTR SAVE ADDRESS OF (END OF ARRAY DESCRIPTOR - 5)
2018 e6ff d3 0f ADDD TEMPTR ADD TOTAL SIZE OF NEW ARRAY
2019 e701 10 25 f7 fc LBCS LAC44 ‘OM’ ERROR IF > $FFFF
2020 e705 1f 01 TFR D,X SAVE END OF ARRAY IN X
2021 e707 bd de f4 JSR LAC37 MAKE SURE THERE IS ENOUGH FREE RAM FOR ARRAY
2022 e70a 83 00 35 SUBD #STKBUF-5 SUBTRACT OUT THE (STACK BUFFER - 5)
2023 e70d dd 1f STD ARYEND SAVE NEW END OF ARRAYS
2024 e70f 4f CLRA ZERO = TERMINATOR BYTE
2025 e710 30 1f LB48C LEAX -1,X * STORE TWO TERMINATOR BYTES AT
2026 e712 a7 05 STA 5,X * THE END OF THE ARRAY DESCRIPTOR
2027 e714 9c 0f CMPX TEMPTR *
2028 e716 26 f8 BNE LB48C *
2029 e718 9e 41 LDX V41 GET ADDRESS OF START OF DESCRIPTOR
2030 e71a 96 1f LDA ARYEND GET MSB OF END OF ARRAYS; LSB ALREADY THERE
2031 e71c 93 41 SUBD V41 SUBTRACT OUT ADDRESS OF START OF DESCRIPTOR
2032 e71e ed 02 STD 2,X SAVE LENGTH OF (ARRAY AND DESCRIPTOR)
2033 e720 96 05 LDA DIMFLG * GET ARRAY FLAG AND BRANCH
2034 e722 26 2d BNE LB4CD * BACK IF DIMENSIONING
2035 * CALCULATE POINTER TO CORRECT ELEMENT
2036 e724 e6 04 LB4A0 LDB 4,X GET THE NUMBER OF DIMENSIONS
2037 e726 d7 03 STB TMPLOC TEMPORARILY SAVE
2038 e728 4f CLRA * INITIALIZE POINTER
2039 e729 5f CLRB * TO ZERO
2040 e72a dd 64 LB4A6 STD COEFPT SAVE ACCUMULATED POINTER
2041 e72c 35 06 PULS A,B * PULL DIMENSION ARGUMENT OFF THE
2042 e72e dd 52 STD FPA0+2 * STACK AND SAVE IT
2043 e730 10 a3 05 CMPD 5,X COMPARE TO STORED ‘DIM’ ARGUMENT
2044 e733 24 3a BCC LB4EB ‘BS’ ERROR IF > = "DIM" ARGUMENT
2045 e735 de 64 LDU COEFPT * GET ACCUMULATED POINTER AND
2046 e737 27 04 BEQ LB4B9 * BRANCH IF 1ST DIMENSION
2047 e739 8d 17 BSR LB4CE = MULTIPLY ACCUMULATED POINTER AND DIMENSION
2048 e73b d3 52 ADDD FPA0+2 = LENGTH AND ADD TO CURRENT ARGUMENT
2049 e73d 30 02 LB4B9 LEAX 2,X MOVE POINTER TO NEXT DIMENSION
2050 e73f 0a 03 DEC TMPLOC * DECREMENT DIMENSION COUNTER AND
2051 e741 26 e7 BNE LB4A6 * BRANCH IF ANY DIMENSIONS LEFT
2052 * MULTIPLY ACCD BY 5 - 5 BYTES/ARRAY VALUE
2053 e743 ed e3 STD ,--S
2054 e745 58 ASLB
2055 e746 49 ROLA TIMES 2
2056 e747 58 ASLB
2057 e748 49 ROLA TIMES 4
2058 e749 e3 e1 ADDD ,S++ TIMES 5
2059 e74b 30 8b LEAX D,X ADD OFFSET TO START OF ARRAY
2060 e74d 30 05 LEAX 5,X ADJUST POINTER FOR SIZE OF DESCRIPTOR
2061 e74f 9f 39 STX VARPTR SAVE POINTER TO ARRAY VALUE
2062 e751 39 LB4CD RTS
2063 * MULTIPLY 2 BYTE NUMBER IN 5,X BY THE 2 BYTE NUMBER
2064 * IN COEFPT. RETURN RESULT IN ACCD, BS ERROR IF > $FFFF
2065 e752 86 10 LB4CE LDA #16 16 SHIFTS TO DO A MULTIPLY
2066 e754 97 45 STA V45 SHIFT COUNTER
2067 e756 ec 05 LDD 5,X * GET SIZE OF DIMENSION
2068 e758 dd 17 STD BOTSTK * AND SAVE IT
2069 e75a 4f CLRA * ZERO
2070 e75b 5f CLRB * ACCD
2071 e75c 58 LB4D8 ASLB = SHIFT ACCB LEFT
2072 e75d 49 ROLA = ONE BIT
2073 e75e 25 0f BCS LB4EB BS' ERROR IF CARRY
2074 e760 08 65 ASL COEFPT+1 * SHIFT MULTIPLICAND LEFT ONE
2075 e762 09 64 ROL COEFPT * BIT - ADD MULTIPLIER TO ACCUMULATOR
2076 e764 24 04 BCC LB4E6 * IF CARRY <> 0
2077 e766 d3 17 ADDD BOTSTK ADD MULTIPLIER TO ACCD
2078 e768 25 05 BCS LB4EB BS' ERROR IF CARRY (>$FFFF)
2079 e76a 0a 45 LB4E6 DEC V45 * DECREMENT SHIFT COUNTER
2080 e76c 26 ee BNE LB4D8 * IF NOT DONE
2081 e76e 39 RTS
2082 e76f 7e e6 cb LB4EB JMP LB447 BS' ERROR
2083 *
2084 * MEM
2085 * THIS IS NOT A TRUE INDICATOR OF FREE MEMORY BECAUSE
2086 * BASIC REQUIRES A STKBUF SIZE BUFFER FOR THE STACK
2087 * FOR WHICH MEM DOES NOT ALLOW.
2088 *
2089 e772 1f 40 MEM TFR S,D PUT STACK POINTER INTO ACCD
2090 e774 93 1f SUBD ARYEND SUBTRACT END OF ARRAYS
2091 e776 21 FCB SKP1 SKIP ONE BYTE
2092 *CONVERT THE VALUE IN ACCB INTO A FP NUMBER IN FPA0
2093 e777 4f LB4F3 CLRA CLEAR MS BYTE OF ACCD
2094 * CONVERT THE VALUE IN ACCD INTO A FLOATING POINT NUMBER IN FPA0
2095 e778 0f 06 GIVABF CLR VALTYP SET VARIABLE TYPE TO NUMERIC
2096 e77a dd 50 STD FPA0 SAVE ACCD IN TOP OF FACA
2097 e77c c6 90 LDB #$90 EXPONENT REQUIRED IF THE TOP TWO BYTES
2098 * OF FPA0 ARE TO BE TREATED AS AN INTEGER IN FPA0
2099 e77e 7e ee cb JMP LBC82 CONVERT THE REST OF FPA0 TO AN INTEGER
2100
2101 * STR$
2102 e781 bd e3 cc STR JSR LB143 TM' ERROR IF STRING VARIABLE
2103 e784 ce 01 f0 LDU #STRBUF+2 *CONVERT FP NUMBER TO ASCII STRING IN
2104 e787 bd f0 25 JSR LBDDC *THE STRING BUFFER
2105 e78a 32 62 LEAS 2,S PURGE THE RETURN ADDRESS FROM THE STACK
2106 e78c 8e 01 ef LDX #STRBUF+1 *POINT X TO STRING BUFFER AND SAVE
2107 e78f 20 0b BRA LB518 *THE STRING IN THE STRING SPACE
2108 * RESERVE ACCB BYTES OF STRING SPACE. RETURN START
2109 * ADDRESS IN (X) AND FRESPC
2110 e791 9f 4d LB50D STX V4D SAVE X IN V4D
2111 e793 8d 5c LB50F BSR LB56D RESERVE ACCB BYTES IN STRING SPACE
2112 e795 9f 58 LB511 STX STRDES+2 SAVE NEW STRING ADDRESS
2113 e797 d7 56 STB STRDES SAVE LENGTH OF RESERVED BLOCK
2114 e799 39 RTS
2115 e79a 30 1f LB516 LEAX -1,X MOVE POINTER BACK ONE
2116 * SCAN A LINE FROM (X) UNTIL AN END OF LINE FLAG (ZERO) OR
2117 * EITHER OF THE TWO TERMINATORS STORED IN CHARAC OR ENDCHR IS MATCHED.
2118 * THE RESULTING STRING IS STORED IN THE STRING SPACE
2119 * ONLY IF THE START OF THE STRING IS <= STRBUF+2
2120 e79c 86 22 LB518 LDA #'" * INITIALIZE
2121 e79e 97 01 STA CHARAC * TERMINATORS
2122 e7a0 97 02 LB51A STA ENDCHR * TO "
2123 e7a2 30 01 LB51E LEAX 1,X MOVE POINTER UP ONE
2124 e7a4 9f 62 STX RESSGN TEMPORARILY SAVE START OF STRING
2125 e7a6 9f 58 STX STRDES+2 SAVE START OF STRING IN TEMP DESCRIPTOR
2126 e7a8 c6 ff LDB #-1 INITIALIZE CHARACTER COUNTER TO - 1
2127 e7aa 5c LB526 INCB INCREMENT CHARACTER COUNTER
2128 e7ab a6 80 LDA ,X+ GET CHARACTER
2129 e7ad 27 0c BEQ LB537 BRANCH IF END OF LINE
2130 e7af 91 01 CMPA CHARAC * CHECK FOR TERMINATORS
2131 e7b1 27 04 BEQ LB533 * IN CHARAC AND ENDCHR
2132 e7b3 91 02 CMPA ENDCHR * DON’T MOVE POINTER BACK
2133 e7b5 26 f3 BNE LB526 * ONE IF TERMINATOR IS "MATCHED"
2134 e7b7 81 22 LB533 CMPA #'" = COMPARE CHARACTER TO STRING DELIMITER
2135 e7b9 27 02 BEQ LB539 = & DON’T MOVE POINTER BACK IF SO
2136 e7bb 30 1f LB537 LEAX -1,X MOVE POINTER BACK ONE
2137 e7bd 9f 64 LB539 STX COEFPT SAVE END OF STRING ADDRESS
2138 e7bf d7 56 STB STRDES SAVE STRING LENGTH IN TEMP DESCRIPTOR
2139 e7c1 de 62 LDU RESSGN GET INITlAL STRING START
2140 e7c3 11 83 01 f0 CMPU #STRBUF+2 COMPARE TO START OF STRING BUFFER
2141 e7c7 22 07 LB543 BHI LB54C BRANCH IF > START OF STRING BUFFER
2142 e7c9 8d c6 BSR LB50D GO RESERVE SPACE FOR THE STRING
2143 e7cb 9e 62 LDX RESSGN POINT X TO THE BEGINNING OF THE STRING
2144 e7cd bd e8 c9 JSR LB645 MOVE (B) BYTES FROM (X) TO
2145 * [FRESPC] - MOVE STRING DATA
2146 * PUT DIRECT PAGE STRING DESCRIPTOR BUFFER DATA
2147 * ON THE STRING STACK. SET VARIABLE TYPE TO STRING
2148 e7d0 9e 0b LB54C LDX TEMPPT GET NEXT AVAILABLE STRING STACK DESCRIPTOR
2149 e7d2 8c 00 f1 CMPX #LINHDR COMPARE TO TOP OF STRING DESCRIPTOR STACK - WAS #CFNBUF
2150 e7d5 26 05 BNE LB558 FORMULA O.K.
2151 e7d7 c6 1e LDB #15*2 STRING FORMULA TOO COMPLEX' ERROR
2152 e7d9 7e df 03 LB555 JMP LAC46 JUMP TO ERROR SERVICING ROUTINE
2153 e7dc 96 56 LB558 LDA STRDES * GET LENGTH OF STRING AND SAVE IT
2154 * STA ,X * IN BYTE 0 OF DESCRIPTOR
2155 e7de a7 00 FCB $A7,$00
2156 e7e0 dc 58 LDD STRDES+2 = GET START ADDRESS OF ACTUAL STRING
2157 e7e2 ed 02 STD 2,X = AND SAVE IN BYTES 2,3 OF DESCRIPTOR
2158 e7e4 86 ff LDA #$FF * VARIABLE TYPE = STRING
2159 e7e6 97 06 STA VALTYP * SAVE IN VARIABLE TYPE FLAG
2160 e7e8 9f 0d STX LASTPT = SAVE START OF DESCRIPTOR
2161 e7ea 9f 52 STX FPA0+2 = ADDRESS IN LASTPT AND FPA0
2162 e7ec 30 05 LEAX 5,X 5 BYTES/STRING DESCRIPTOR
2163 e7ee 9f 0b STX TEMPPT NEXT AVAILABLE STRING VARIABLE DESCRIPTOR
2164 e7f0 39 RTS
2165 * RESERVE ACCB BYTES IN STRING STORAGE SPACE
2166 * RETURN WITH THE STARTING ADDRESS OF THE
2167 * RESERVED STRING SPACE IN (X) AND FRESPC
2168 e7f1 0f 07 LB56D CLR GARBFL CLEAR STRING REORGANIZATION FLAG
2169 e7f3 4f LB56F CLRA * PUSH THE LENGTH OF THE
2170 e7f4 34 06 PSHS B,A * STRING ONTO THE STACK
2171 e7f6 dc 23 LDD STRTAB GET START OF STRING VARIABLES
2172 e7f8 a3 e0 SUBD ,S+ SUBTRACT STRING LENGTH
2173 e7fa 10 93 21 CMPD FRETOP COMPARE TO START OF STRING STORAGE
2174 e7fd 25 0a BCS LB585 IF BELOW START, THEN REORGANIZE
2175 e7ff dd 23 STD STRTAB SAVE NEW START OF STRING VARIABLES
2176 e801 9e 23 LDX STRTAB GET START OF STRING VARIABLES
2177 e803 30 01 LEAX 1,X ADD ONE
2178 e805 9f 25 STX FRESPC SAVE START ADDRESS OF NEWLY RESERVED SPACE
2179 e807 35 84 PULS B,PC RESTORE NUMBER OF BYTES RESERVED AND RETURN
2180 e809 c6 1a LB585 LDB #2*13 OUT OF STRING SPACE' ERROR
2181 e80b 03 07 COM GARBFL TOGGLE REORGANIZATiON FLAG
2182 e80d 27 ca BEQ LB555 ERROR IF FRESHLY REORGANIZED
2183 e80f 8d 04 BSR LB591 GO REORGANIZE STRING SPACE
2184 e811 35 04 PULS B GET BACK THE NUMBER OF BYTES TO RESERVE
2185 e813 20 de BRA LB56F TRY TO RESERVE ACCB BYTES AGAIN
2186 * REORGANIZE THE STRING SPACE
2187 e815 9e 27 LB591 LDX MEMSIZ GET THE TOP OF STRING SPACE
2188 e817 9f 23 LB593 STX STRTAB SAVE TOP OF UNORGANIZED STRING SPACE
2189 e819 4f CLRA * ZERO OUT ACCD
2190 e81a 5f CLRB * AND RESET VARIABLE
2191 e81b dd 4b STD V4B * POINTER TO 0
2192 e81d 9e 21 LDX FRETOP POINT X TO START OF STRING SPACE
2193 e81f 9f 47 STX V47 SAVE POINTER IN V47
2194 e821 8e 00 c9 LDX #STRSTK POINT X TO START OF STRING DESCRIPTOR STACK
2195 e824 9c 0b LB5A0 CMPX TEMPPT COMPARE TO ADDRESS OF NEXT AVAILABLE DESCRIPTOR
2196 e826 27 04 BEQ LB5A8 BRANCH IF TOP OF STRING STACK
2197 e828 8d 32 BSR LB5D8 CHECK FOR STRING IN UNORGANIZED STRING SPACE
2198 e82a 20 f8 BRA LB5A0 KEEP CHECKING
2199 e82c 9e 1b LB5A8 LDX VARTAB GET THE END OF BASIC PROGRAM
2200 e82e 9c 1d LB5AA CMPX ARYTAB COMPARE TO END OF VARIABLES
2201 e830 27 04 BEQ LB5B2 BRANCH IF AT TOP OF VARIABLES
2202 e832 8d 22 BSR LB5D2 CHECK FOR STRING IN UNORGANIZED STRING SPACE
2203 e834 20 f8 BRA LB5AA KEEP CHECKING VARIABLES
2204 e836 9f 41 LB5B2 STX V41 SAVE ADDRESS OF THE END OF VARIABLES
2205 e838 9e 41 LB5B4 LDX V41 GET CURRENT ARRAY POINTER
2206 e83a 9c 1f LB5B6 CMPX ARYEND COMPARE TO THE END OF ARRAYS
2207 e83c 27 35 BEQ LB5EF BRANCH IF AT END OF ARRAYS
2208 e83e ec 02 LDD 2,X GET LENGTH OF ARRAY AND DESCRIPTOR
2209 e840 d3 41 ADDD V41 * ADD TO CURRENT ARRAY POINTER
2210 e842 dd 41 STD V41 * AND SAVE IT
2211 e844 a6 01 LDA 1,X GET 1ST CHARACTER OF VARIABLE NAME
2212 e846 2a f0 BPL LB5B4 BRANCH IF NUMERIC ARRAY
2213 e848 e6 04 LDB 4,X GET THE NUMBER OF DIMENSIONS IN THIS ARRAY
2214 e84a 58 ASLB MULTIPLY BY 2
2215 e84b cb 05 ADDB #5 ADD FIVE BYTES (VARIABLE NAME, ARRAY
2216 * LENGTH, NUMBER DIMENSIONS)
2217 e84d 3a ABX X NOW POINTS TO START OF ARRAY ELEMENTS
2218 e84e 9c 41 LB5CA CMPX V41 AT END OF THIS ARRAY?
2219 e850 27 e8 BEQ LB5B6 YES - CHECK FOR ANOTHER
2220 e852 8d 08 BSR LB5D8 CHECK FOR STRING LOCATED IN
2221 * UNORGANIZED STRING SPACE
2222 e854 20 f8 BRA LB5CA KEEP CHECKING ELEMENTS IN THIS ARRAY
2223 e856 a6 01 LB5D2 LDA 1,X GET F1RST BYTE OF VARIABLE NAME
2224 e858 30 02 LEAX 2,X MOVE POINTER TO DESCRIPTOR
2225 e85a 2a 14 BPL LB5EC BRANCH IF VARIABLE IS NUMERIC
2226 * SEARCH FOR STRING - ENTER WITH X POINTING TO
2227 * THE STRING DESCRIPTOR. IF STRING IS STORED
2228 * BETWEEN V47 AND STRTAB, SAVE DESCRIPTOR POINTER
2229 * IN V4B AND RESET V47 TO STRING ADDRESS
2230 e85c e6 84 LB5D8 LDB ,X GET THE LENGTH OF THE STRING
2231 e85e 27 10 BEQ LB5EC BRANCH IF NULL - NO STRING
2232 e860 ec 02 LDD 2,X GET STARTING ADDRESS OF THE STRING
2233 e862 10 93 23 CMPD STRTAB COMPARE TO THE START OF STRING VARIABLES
2234 e865 22 09 BHI LB5EC BRANCH IF THIS STRING IS STORED IN
2235 * THE STRING VARIABLES
2236 e867 10 93 47 CMPD V47 COMPARE TO START OF STRING SPACE
2237 e86a 23 04 BLS LB5EC BRANCH IF NOT STORED IN THE STRING SPACE
2238 e86c 9f 4b STX V4B SAVE VARIABLE POINTER IF STORED IN STRING SPACE
2239 e86e dd 47 STD V47 SAVE STRING STARTING ADDRESS
2240 e870 30 05 LB5EC LEAX 5,X MOVE TO NEXT VARIABLE DESCRIPTOR
2241 e872 39 LB5EE RTS
2242 e873 9e 4b LB5EF LDX V4B GET ADDRESS OF THE DESCRIPTOR FOR THE
2243 * STRING WHICH IS STORED IN THE HIGHEST RAM ADDRESS IN
2244 * THE UNORGANIZED STRING SPACE
2245 e875 27 fb BEQ LB5EE BRANCH IF NONE FOUND AND REORGANIZATION DONE
2246 e877 4f CLRA CLEAR MS BYTE OF LENGTH
2247 e878 e6 84 LDB ,X GET LENGTH OF STRING
2248 e87a 5a DECB SUBTRACT ONE
2249 e87b d3 47 ADDD V47 ADD LENGTH OF STRING TO ITS STARTING ADDRESS
2250 e87d dd 43 STD V43 SAVE AS MOVE STARTING ADDRESS
2251 e87f 9e 23 LDX STRTAB POINT X TO THE START OF ORGANIZED STRING VARIABLES
2252 e881 9f 41 STX V41 SAVE AS MOVE ENDING ADDRESS
2253 e883 bd de dd JSR LAC20 MOVE STRING FROM CURRENT POSITION TO THE
2254 * TOP OF UNORGANIZED STRING SPACE
2255 e886 9e 4b LDX V4B POINT X TO STRING DESCRIPTOR
2256 e888 dc 45 LDD V45 * GET NEW STARTING ADDRESS OF STRING AND
2257 e88a ed 02 STD 2,X * SAVE IT IN DESCRIPTOR
2258 e88c 9e 45 LDX V45 GET NEW TOP OF UNORGANIZED STRING SPACE
2259 e88e 30 1f LEAX -1,X MOVE POINTER BACK ONE
2260 e890 7e e8 17 JMP LB593 JUMP BACK AND REORGANIZE SOME MORE
2261
2262
2263 e893 dc 52 LB60F LDD FPA0+2 * GET DESCRIPTOR ADDRESS OF STRING A
2264 e895 34 06 PSHS B,A * AND SAVE IT ON THE STACK
2265 e897 bd e4 ac JSR LB223 GET DESCRIPTOR ADDRESS OF STRING B
2266 e89a bd e3 cf JSR LB146 TM' ERROR IF NUMERIC VARIABLE
2267 e89d 35 10 PULS X * POINT X TO STRING A DESCRIPTOR
2268 e89f 9f 62 STX RESSGN * ADDRESS AND SAVE IT IN RESSGN
2269 e8a1 e6 84 LDB ,X GET LENGTH OF STRING A
2270 e8a3 9e 52 LDX FPA0+2 POINT X TO DESCRIPTOR OF STRING B
2271 e8a5 eb 84 ADDB ,X ADD LENGTH OF STRING B TO STR1NG A
2272 e8a7 24 05 BCC LB62A BRANCH IF LENGTH < 256
2273 e8a9 c6 1c LDB #2*14 STRING TOO LONG' ERROR IF LENGTH > 255
2274 e8ab 7e df 03 JMP LAC46 JUMP TO ERROR SERVICING ROUTINE
2275 e8ae bd e7 91 LB62A JSR LB50D RESERVE ROOM IN STRING SPACE FOR NEW STRING
2276 e8b1 9e 62 LDX RESSGN GET DESCRIPTOR ADDRESS OF STRING A
2277 e8b3 e6 84 LDB ,X GET LENGTH OF STRING A
2278 e8b5 8d 10 BSR LB643 MOVE STRING A INTO RESERVED BUFFER IN STRING SPACE
2279 e8b7 9e 4d LDX V4D GET DESCRIPTOR ADDRESS OF STRING B
2280 e8b9 8d 22 BSR LB659 GET LENGTH AND ADDRESS OF STRING B
2281 e8bb 8d 0c BSR LB645 MOVE STRING B INTO REST OF RESERVED BUFFER
2282 e8bd 9e 62 LDX RESSGN POINT X TO DESCRIPTOR OF STRING A
2283 e8bf 8d 1c BSR LB659 DELETE STRING A IF LAST STRING ON STRING STACK
2284 e8c1 bd e7 d0 JSR LB54C PUT STRING DESCRIPTOR ON THE STRING STACK
2285 e8c4 7e e3 f1 JMP LB168 BRANCH BACK TO EXPRESSION EVALUATION
2286
2287 * MOVE (B) BYTES FROM 2,X TO FRESPC
2288 e8c7 ae 02 LB643 LDX 2,X POINT X TO SOURCE ADDRESS
2289 e8c9 de 25 LB645 LDU FRESPC POINT U TO DESTINATION ADDRESS
2290 e8cb 5c INCB COMPENSATION FOR THE DECB BELOW
2291 e8cc 20 04 BRA LB64E GO MOVE THE BYTES
2292 * MOVE B BYTES FROM (X) TO (U)
2293 e8ce a6 80 LB64A LDA ,X+ * GET A SOURCE BYTE AND MOVE IT
2294 e8d0 a7 c0 STA ,U+ * TO THE DESTINATION
2295 e8d2 5a LB64E DECB DECREMENT BYTE COUNTER
2296 e8d3 26 f9 BNE LB64A BRANCH IF ALL BYTES NOT MOVED
2297 e8d5 df 25 STU FRESPC SAVE ENDING ADDRESS IN FRESPC
2298 e8d7 39 RTS
2299 * RETURN LENGTH (ACCB) AND ADDRESS (X) OF
2300 * STRING WHOSE DESCRIPTOR IS IN FPA0+2
2301 * DELETE THE STRING IF IT IS THE LAST ONE
2302 * PUT ON THE STRING STACK. REMOVE STRING FROM STRING
2303 * SPACE IF IT IS AT THE BOTTOM OF STRING VARIABLES.
2304 e8d8 bd e3 cf LB654 JSR LB146 TM' ERROR IF VARIABLE TYPE = NUMERIC
2305 e8db 9e 52 LB657 LDX FPA0+2 GET ADDRESS OF SELECTED STRING DESCRIPTOR
2306 e8dd e6 84 LB659 LDB ,X GET LENGTH OF STRING
2307 e8df 8d 18 BSR LB675 * CHECK TO SEE IF THIS STRING DESCRIPTOR WAS
2308 e8e1 26 13 BNE LB672 * THE LAST ONE PUT ON THE STRING STACK AND
2309 * * BRANCH IF NOT
2310 e8e3 ae 07 LDX 5+2,X GET START ADDRESS OF STRING JUST REMOVED
2311 e8e5 30 1f LEAX -1,X MOVE POINTER DOWN ONE
2312 e8e7 9c 23 CMPX STRTAB COMPARE TO START OF STRING VARIABLES
2313 e8e9 26 08 BNE LB66F BRANCH IF THIS STRING IS NOT AT THE BOTTOM
2314 * OF STRING VARIABLES
2315 e8eb 34 04 PSHS B SAVE LENGTH; ACCA WAS CLEARED
2316 e8ed d3 23 ADDD STRTAB * ADD THE LENGTH OF THE JUST REMOVED STRING
2317 e8ef dd 23 STD STRTAB * TO THE START OF STRING VARIABLES - THIS WILL
2318 * * REMOVE THE STRING FROM THE STRING SPACE
2319 e8f1 35 04 PULS B RESTORE LENGTH
2320 e8f3 30 01 LB66F LEAX 1,X ADD ONE TO POINTER
2321 e8f5 39 RTS
2322 e8f6 ae 02 LB672 LDX 2,X *POINT X TO ADDRESS OF STRING NOT
2323 e8f8 39 RTS *ON THE STRING STACK
2324 * REMOVE STRING FROM STRING STACK. ENTER WITH X
2325 * POINTING TO A STRING DESCRIPTOR - DELETE THE
2326 * STRING FROM STACK IF IT IS ON TOP OF THE
2327 * STACK. IF THE STRING IS DELETED, SET THE ZERO FLAG
2328 e8f9 9c 0d LB675 CMPX LASTPT *COMPARE TO LAST USED DESCRIPTOR ADDRESS
2329 e8fb 26 07 BNE LB680 *ON THE STRING STACK, RETURN IF DESCRIPTOR
2330 * *ADDRESS NOT ON THE STRING STACK
2331 e8fd 9f 0b STX TEMPPT SAVE LAST USED DESCRIPTOR AS NEXT AVAILABLE
2332 e8ff 30 1b LEAX -5,X * MOVE LAST USED DESCRIPTOR BACK 5 BYTES
2333 e901 9f 0d STX LASTPT * AND SAVE AS THE LAST USED DESCRIPTOR ADDR
2334 e903 4f CLRA SET ZERO FLAG
2335 e904 39 LB680 RTS
2336
2337 * LEN
2338 e905 8d 03 LEN BSR LB686 POINT X TO PROPER STRING AND GET LENGTH
2339 e907 7e e7 77 LB683 JMP LB4F3 CONVERT ACCB TO FP NUMBER IN FPA0
2340 * POINT X TO STRING ADDRESS LOAD LENGTH INTO
2341 * ACCB. ENTER WITH THE STRING DESCRIPTOR IN
2342 * BOTTOM TWO BYTES OF FPA0
2343 e90a 8d cc LB686 BSR LB654 GET LENGTH AND ADDRESS OF STRING
2344 e90c 0f 06 CLR VALTYP SET VARIABLE TYPE TO NUMERIC
2345 e90e 5d TSTB SET FLAGS ACCORDING TO LENGTH
2346 e90f 39 RTS
2347
2348 * CHR$
2349 e910 bd e9 92 CHR JSR LB70E CONVERT FPA0 TO AN INTEGER IN ACCD
2350 e913 c6 01 LB68F LDB #1 * RESERVE ONE BYTE IN
2351 e915 bd e7 f1 JSR LB56D * THE STRING SPACE
2352 e918 96 53 LDA FPA0+3 GET ASCII STRING VALUE
2353 e91a bd e7 95 JSR LB511 SAVE RESERVED STRING DESCRIPTOR IN TEMP DESCRIPTOR
2354 e91d a7 84 STA ,X SAVE THE STRING (IT’S ONLY ONE BYTE)
2355 e91f 32 62 LB69B LEAS 2,S PURGE THE RETURN ADDRESS OFF OF THE STACK
2356 e921 7e e7 d0 LB69D JMP LB54C PUT TEMP DESCRIPTOR DATA ONTO STRING STACK
2357
2358
2359 e924 8d 02 ASC BSR LB6A4 PUT 1ST CHARACTER OF STRING INTO ACCB
2360 e926 20 df BRA LB683 CONVERT ACCB INTO FP NUMBER IN FPA0
2361 e928 8d e0 LB6A4 BSR LB686 POINT X TO STRING DESCRIPTOR
2362 e92a 27 5e BEQ LB706 FC' ERROR IF NULL STRING
2363 e92c e6 84 LDB ,X GET FIRST BYTE OF STRING
2364 e92e 39 RTS
2365
2366
2367 e92f 8d 48 LEFT BSR LB6F5 GET ARGUMENTS FROM STACK
2368 e931 4f LB6AD CLRA CLEAR STRING POINTER OFFSET - OFFSET = 0 FOR LEFT$
2369 e932 e1 84 LB6AE CMPB ,X * COMPARE LENGTH PARAMETER TO LENGTH OF
2370 e934 23 03 BLS LB6B5 * STRING AND BRANCH IF LENGTH OF STRING
2371 * >= LENGTH PARAMETER
2372 e936 e6 84 LDB ,X USE LENGTH OF STRING OTHERWISE
2373 e938 4f CLRA CLEAR STRING POINTER OFFSET (0 FOR LEFT$)
2374 e939 34 06 LB6B5 PSHS B,A PUSH PARAMETERS ONTO STACK
2375 e93b bd e7 93 JSR LB50F RESERVE ACCB BYTES IN THE STRING SPACE
2376 e93e 9e 4d LDX V4D POINT X TO STRING DESCRIPTOR
2377 e940 8d 9b BSR LB659 GET ADDRESS OF OLD STRING (X=ADDRESS)
2378 e942 35 04 PULS B * PULL STRING POINTER OFFSET OFF OF THE STACK
2379 e944 3a ABX * AND ADD IT TO STRING ADDRESS
2380 e945 35 04 PULS B PULL LENGTH PARAMETER OFF OF THE STACK
2381 e947 bd e8 c9 JSR LB645 MOVE ACCB BYTES FROM (X) TO [FRESPC]
2382 e94a 20 d5 BRA LB69D PUT TEMP STRING DESCRIPTOR ONTO THE STRING STACK
2383
2384 * RIGHT$
2385 e94c 8d 2b RIGHT BSR LB6F5 GET ARGUMENTS FROM STACK
2386 e94e a0 84 SUBA ,X ACCA=LENGTH PARAMETER - LENGTH OF OLD STRING
2387 e950 40 NEGA NOW ACCA = LENGTH OF OLD STRING
2388 e951 20 df BRA LB6AE PUT NEW STRING IN THE STRING SPACE
2389
2390 * MID$
2391 e953 c6 ff MID LDB #$FF * GET DEFAULT VALUE OF LENGTH AND
2392 e955 d7 53 STB FPA0+3 * SAVE IT IN FPA0
2393 e957 9d 82 JSR GETCCH GET CURRENT CHARACTER FROM BASIC
2394 e959 81 29 CMPA #') ARGUMENT DELIMITER?
2395 e95b 27 05 BEQ LB6DE YES - NO LENGTH PARAMETER GIVEN
2396 e95d bd e4 f6 JSR LB26D SYNTAX CHECK FOR COMMA
2397 e960 8d 2d BSR LB70B EVALUATE NUMERIC EXPRESSION (LENGTH)
2398 e962 8d 15 LB6DE BSR LB6F5 GET ARGUMENTS FROM STACK
2399 e964 27 24 BEQ LB706 FC' ERROR IF NULL STRING
2400 e966 5f CLRB CLEAR LENGTH COUNTER (DEFAULT VALUE)
2401 e967 4a DECA *SUOTRACT ONE FROM POSITION PARAMETER (THESE
2402 e968 a1 84 CMPA ,X *ROUTINES EXPECT 1ST POSITION TO BE ZERO, NOT ONE)
2403 * *AND COMPARE IT TO LENGTH OF OLD STRING
2404 e96a 24 cd BCC LB6B5 IF POSITION > LENGTH OF OLD STRING, THEN NEW
2405 * STRING WILL BE A NULL STRING
2406 e96c 1f 89 TFR A,B SAVE ABSOLUTE POSITION PARAMETER IN ACCB
2407 e96e e0 84 SUBB ,X ACCB=POSITION-LENGTH OF OLD STRING
2408 e970 50 NEGB NOW ACCB=LENGTH OF OLDSTRING-POSITION
2409 e971 d1 53 CMPB FPA0+3 *IF THE AMOUNT OF OLD STRING TO THE RIGHT OF
2410 e973 23 c4 BLS LB6B5 *POSITION IS <= THE LENGTH PARAMETER, BRANCH AND
2411 * USE ALL OF THE STRING TO THE RIGHT OF THE POSITION
2412 * INSTEAD OF THE LENGTH PARAMETER
2413 e975 d6 53 LDB FPA0+3 GET LENGTH OF NEW STRING
2414 e977 20 c0 BRA LB6B5 PUT NEW STRING IN STRING SPACE
2415 * DO A SYNTAX CHECK FOR ")", THEN PULL THE PREVIOUSLY CALCULATED NUMERIC
2416 * ARGUMENT (ACCD) AND STRING ARGUMENT DESCRIPTOR ADDR OFF OF THE STACK
2417 e979 bd e4 f0 LB6F5 JSR LB267 SYNTAX CHECK FOR A ")"
2418 e97c ee e4 LDU ,S LOAD THE RETURN ADDRESS INTO U REGISTER
2419 e97e ae 65 LDX 5,S * GET ADDRESS OF STRING AND
2420 e980 9f 4d STX V4D * SAVE IT IN V4D
2421 e982 a6 64 LDA 4,S = PUT LENGTH OF STRING IN
2422 e984 e6 64 LDB 4,S = BOTH ACCA AND ACCB
2423 e986 32 67 LEAS 7,S REMOVE DESCRIPTOR AND RETURN ADDRESS FROM STACK
2424 e988 1f 35 TFR U,PC JUMP TO ADDRESS IN U REGISTER
2425 e98a 7e e6 ce LB706 JMP LB44A ILLEGAL FUNCTION CALL'
2426 * EVALUATE AN EXPRESSION - RETURN AN INTEGER IN
2427 * ACCB - 'FC' ERROR IF EXPRESSION > 255
2428 e98d 9d 7c LB709 JSR GETNCH GET NEXT BASIC INPUT CHARACTER
2429 e98f bd e3 ca LB70B JSR LB141 EVALUATE A NUMERIC EXPRESSION
2430 e992 bd e6 6d LB70E JSR LB3E9 CONVERT FPA0 TO INTEGER IN ACCD
2431 e995 4d TSTA TEST MS BYTE OF INTEGER
2432 e996 26 f2 BNE LB706 FC' ERROR IF EXPRESSION > 255
2433 e998 0e 82 JMP GETCCH GET CURRENT INPUT CHARACTER FROM BASIC
2434
2435 * VAL
2436 e99a bd e9 0a VAL JSR LB686 POINT X TO STRING ADDRESS
2437 e99d 10 27 02 e1 LBEQ LBA39 IF NULL STRING SET FPA0
2438 e9a1 de 83 LDU CHARAD SAVE INPUT POINTER IN REGISTER U
2439 e9a3 9f 83 STX CHARAD POINT INPUT POINTER TO ADDRESS OF STRING
2440 e9a5 3a ABX MOVE POINTER TO END OF STRING TERMINATOR
2441 e9a6 a6 84 LDA ,X GET LAST BYTE OF STRING
2442 e9a8 34 52 PSHS U,X,A SAVE INPUT POINTER, STRING TERMINATOR
2443 * ADDRESS AND CHARACTER
2444 e9aa 6f 84 CLR ,X CLEAR STRING TERMINATOR : FOR ASCII - FP CONVERSION
2445 e9ac 9d 82 JSR GETCCH GET CURRENT CHARACTER FROM BASIC
2446 e9ae bd ef 5b JSR LBD12 CONVERT AN ASCII STRING TO FLOATING POINT
2447 e9b1 35 52 PULS A,X,U RESTORE CHARACTERS AND POINTERS
2448 e9b3 a7 84 STA ,X REPLACE STRING TERMINATOR
2449 e9b5 df 83 STU CHARAD RESTORE INPUT CHARACTER
2450 e9b7 39 RTS
2451
2452 e9b8 8d 07 LB734 BSR LB73D * EVALUATE AN EXPRESSION, RETURN
2453 e9ba 9f 2b STX BINVAL * THE VALUE IN X; STORE IT IN BINVAL
2454 e9bc bd e4 f6 LB738 JSR LB26D SYNTAX CHECK FOR A COMMA
2455 e9bf 20 ce BRA LB70B EVALUATE EXPRESSION IN RANGE 0 <= X < 256
2456 * EVALUATE EXPRESSION : RETURN INTEGER PORTION IN X - 'FC' ERROR IF
2457
2458 e9c1 bd e3 ca LB73D JSR LB141 EVALUATE NUMERIC EXPRESSION
2459 e9c4 96 54 LB740 LDA FP0SGN GET SIGN OF FPA0 MANTISSA
2460 e9c6 2b c2 BMI LB706 ILLEGAL FUNCTION CALL' IF NEGATIVE
2461 e9c8 96 4f LDA FP0EXP GET EXPONENT OF FPA0
2462 e9ca 81 90 CMPA #$90 COMPARE TO LARGEST POSITIVE INTEGER
2463 e9cc 22 bc BHI LB706 ILLEGAL FUNCTION CALL' IF TOO LARGE
2464 e9ce bd ef 11 JSR LBCC8 SHIFT BINARY POINT TO EXTREME RIGHT OF FPA0
2465 e9d1 9e 52 LDX FPA0+2 LOAD X WITH LOWER TWO BYTES OF FPA0
2466 e9d3 39 RTS
2467
2468 * PEEK
2469 e9d4 8d ee PEEK BSR LB740 CONVERT FPA0 TO INTEGER IN REGISTER X
2470 e9d6 e6 84 LDB ,X GET THE VALUE BEING 'PEEK'ED
2471 e9d8 7e e7 77 JMP LB4F3 CONVERT ACCB INTO A FP NUMBER
2472
2473 * POKE
2474 e9db 8d db POKE BSR LB734 EVALUATE 2 EXPRESSIONS
2475 e9dd 9e 2b LDX BINVAL GET THE ADDRESS TO BE 'POKE'ED
2476 e9df e7 84 STB ,X STORE THE DATA IN THAT ADDRESS
2477 e9e1 39 RTS
2478
2479
2480 * LIST
2481 e9e2 34 01 LIST PSHS CC SAVE ZERO FLAG ON STACK
2482 e9e4 bd e2 14 JSR LAF67 CONVERT DECIMAL LINE NUMBER TO BINARY
2483 e9e7 bd df a2 JSR LAD01 * FIND RAM ADDRESS OF THAT LINE NUMBER AND
2484 e9ea 9f 66 STX LSTTXT * SAVE IT IN LSTTXT
2485 e9ec 35 01 PULS CC GET ZERO FLAG FROM STACK
2486 e9ee 27 12 BEQ LB784 BRANCH IF END OF LINE
2487 e9f0 9d 82 JSR GETCCH GET CURRENT CHARACTER FROM BASIC
2488 e9f2 27 13 BEQ LB789 BRANCH IF END OF LINE
2489 e9f4 81 a7 CMPA #TOK_MINUS MINUS TOKEN (IS IT A RANGE OF LINE NUMBERS?)
2490 e9f6 26 09 BNE LB783 NO - RETURN
2491 e9f8 9d 7c JSR GETNCH GET NEXT CHARACTER FROM BASIC
2492 e9fa 27 06 BEQ LB784 BRANCH IF END OF LINE
2493 e9fc bd e2 14 JSR LAF67 GET ENDING LINE NUMBER
2494 e9ff 27 06 BEQ LB789 BRANCH IF LEGAL LINE NUMBER
2495 ea01 39 LB783 RTS
2496 * LIST THE ENTIRE PROGRAM
2497 ea02 ce ff ff LB784 LDU #$FFFF * SET THE DEFAULT ENDING LINE NUMBER
2498 ea05 df 2b STU BINVAL * TO $FFFF
2499 ea07 32 62 LB789 LEAS 2,S PURGE RETURN ADDRESS FROM THE STACK
2500 ea09 9e 66 LDX LSTTXT POINT X TO STARTING LINE ADDRESS
2501 ea0b bd eb a9 LB78D JSR LB95C MOVE CURSOR TO START OF A NEW LINE
2502 ea0e bd dc 97 JSR LA549 CHECK FOR A BREAK OR PAUSE
2503 ea11 ec 84 LDD ,X GET ADDRESS OF NEXT BASIC LINE
2504 ea13 26 03 BNE LB79F BRANCH IF NOT END OF PROGRAM
2505 LB797
2506 ea15 7e df 22 JMP LAC73 RETURN TO BASIC’S MAIN INPUT LOOP
2507 ea18 9f 66 LB79F STX LSTTXT SAVE NEW STARTING LINE ADDRESS
2508 ea1a ec 02 LDD 2,X * GET THE LINE NUMBER OF THIS LINE AND
2509 ea1c 10 93 2b CMPD BINVAL * COMPARE IT TO ENDING LINE NUMBER
2510 ea1f 22 f4 BHI LB797 EXIT IF LINE NUMBER > ENDING LINE NUMBER
2511 ea21 bd f0 15 JSR LBDCC PRINT THE NUMBER IN ACCD ON SCREEN IN DECIMAL
2512 ea24 bd eb f5 JSR LB9AC SEND A SPACE TO CONSOLE OUT
2513 ea27 9e 66 LDX LSTTXT GET RAM ADDRESS OF THIS LINE
2514 ea29 8d 10 BSR LB7C2 UNCRUNCH A LINE
2515 ea2b ae 9f 00 66 LDX [LSTTXT] POINT X TO START OF NEXT LINE
2516 ea2f ce 00 f4 LDU #LINBUF+1 POINT U TO BUFFER FULL OF UNCRUNCHED LINE
2517 ea32 a6 c0 LB7B9 LDA ,U+ GET A BYTE FROM THE BUFFER
2518 ea34 27 d5 BEQ LB78D BRANCH IF END OF BUFFER
2519 ea36 bd eb fa JSR LB9B1 SEND CHARACTER TO CONSOLE OUT
2520 ea39 20 f7 BRA LB7B9 GET ANOTHER CHARACTER
2521
2522 * UNCRUNCH A LINE INTO BASIC’S LINE INPUT BUFFER
2523 ea3b 30 04 LB7C2 LEAX 4,X MOVE POINTER PAST ADDRESS OF NEXT LINE AND LINE NUMBER
2524 ea3d 10 8e 00 f4 LDY #LINBUF+1 UNCRUNCH LINE INTO LINE INPUT BUFFER
2525 ea41 a6 80 LB7CB LDA ,X+ GET A CHARACTER
2526 ea43 27 51 BEQ LB820 BRANCH IF END OF LINE
2527 ea45 2b 15 BMI LB7E6 BRANCH IF IT’S A TOKEN
2528 ea47 81 3a CMPA #': CHECK FOR END OF SUB LINE
2529 ea49 26 0d BNE LB7E2 BRNCH IF NOT END OF SUB LINE
2530 ea4b e6 84 LDB ,X GET CHARACTER FOLLOWING COLON
2531 ea4d c1 84 CMPB #TOK_ELSE TOKEN FOR ELSE?
2532 ea4f 27 f0 BEQ LB7CB YES - DON’T PUT IT IN BUFFER
2533 ea51 c1 83 CMPB #TOK_SNGL_Q TOKEN FOR REMARK?
2534 ea53 27 ec BEQ LB7CB YES - DON’T PUT IT IN BUFFER
2535 ea55 8c FCB SKP2 SKIP TWO BYTES
2536 ea56 86 21 LB7E0 LDA #'! EXCLAMATION POINT
2537 ea58 8d 30 LB7E2 BSR LB814 PUT CHARACTER IN BUFFER
2538 ea5a 20 e5 BRA LB7CB GET ANOTHER CHARACTER
2539
2540 ea5c ce db e4 LB7E6 LDU #COMVEC-10 FIRST DO COMMANDS
2541 ea5f 81 ff CMPA #$FF CHECK FOR SECONDARY TOKEN
2542 ea61 26 04 BNE LB7F1 BRANCH IF NON SECONDARY TOKEN
2543 ea63 a6 80 LDA ,X+ GET SECONDARY TOKEN
2544 ea65 33 45 LEAU 5,U BUMP IT UP TO SECONDARY FUNCTIONS
2545 ea67 84 7f LB7F1 ANDA #$7F MASK OFF BIT 7 OF TOKEN
2546 ea69 33 4a LB7F3 LEAU 10,U MOVE TO NEXT COMMAND TABLE
2547 ea6b 6d c4 TST ,U IS THIS TABLE ENABLED?
2548 ea6d 27 e7 BEQ LB7E0 NO - ILLEGAL TOKEN
2549 ea6f a0 c4 SUBA ,U SUBTRACT THE NUMBER OF TOKENS FROM THE CURRENT TOKEN NUMBER
2550 ea71 2a f6 BPL LB7F3 BRANCH IF TOKEN NOT IN THIS TABLE
2551 ea73 ab c4 ADDA ,U RESTORE TOKEN NUMBER RELATIVE TO THIS TABLE
2552 ea75 ee 41 LDU 1,U POINT U TO COMMAND DICTIONARY TABLE
2553 ea77 4a LB801 DECA DECREMENT TOKEN NUMBER
2554 ea78 2b 06 BMI LB80A BRANCH IF THIS IS THE CORRECT TOKEN
2555 * SKIP THROUGH DICTIONARY TABLE TO START OF NEXT TOKEN
2556 ea7a 6d c0 LB804 TST ,U+ GRAB A BYTE
2557 ea7c 2a fc BPL LB804 BRANCH IF BIT 7 NOT SET
2558 ea7e 20 f7 BRA LB801 GO SEE IF THIS IS THE CORRECT TOKEN
2559 ea80 a6 c4 LB80A LDA ,U GET A CHARACTER FROM DICTIONARY TABLE
2560 ea82 8d 06 BSR LB814 PUT CHARACTER IN BUFFER
2561 ea84 6d c0 TST ,U+ CHECK FOR START OF NEXT TOKEN
2562 ea86 2a f8 BPL LB80A BRANCH IF NOT DONE WITH THIS TOKEN
2563 ea88 20 b7 BRA LB7CB GO GET ANOTHER CHARACTER
2564 ea8a 10 8c 01 ed LB814 CMPY #LINBUF+LBUFMX TEST FOR END OF LINE INPUT BUFFER
2565 ea8e 24 06 BCC LB820 BRANCH IF AT END OF BUFFER
2566 ea90 84 7f ANDA #$7F MASK OFF BIT 7
2567 ea92 a7 a0 STA ,Y+ * SAVE CHARACTER IN BUFFER AND
2568 ea94 6f a4 CLR ,Y * CLEAR NEXT CHARACTER SLOT IN BUFFER
2569 ea96 39 LB820 RTS
2570 *
2571 * CRUNCH THE LINE THAT THE INPUT POINTER IS
2572 * POINTING TO INTO THE LINE INPUT BUFFER
2573 * RETURN LENGTH OF CRUNCHED LINE IN ACCD
2574 *
2575 ea97 9e 83 LB821 LDX CHARAD GET BASIC'S INPUT POINTER ADDRESS
2576 ea99 ce 00 f3 LDU #LINBUF POINT X TO LINE INPUT BUFFER
2577 ea9c 0f 43 LB829 CLR V43 CLEAR ILLEGAL TOKEN FLAG
2578 ea9e 0f 44 CLR V44 CLEAR DATA FLAG
2579 eaa0 a6 80 LB82D LDA ,X+ GET INPUT CHAR
2580 eaa2 27 21 BEQ LB852 BRANCH IF END OF LINE
2581 eaa4 0d 43 TST V43 * CHECK ILLEGAL TOKEN FLAG & BRANCH IF NOT
2582 eaa6 27 0f BEQ LB844 * PROCESSING AN ILLEGAL TOKEN
2583 eaa8 bd e6 26 JSR LB3A2 SET CARRY IF NOT UPPER CASE ALPHA
2584 eaab 24 18 BCC LB852 BRANCH IF UPPER CASE ALPHA
2585 eaad 81 30 CMPA #'0 * DON’T CRUNCH ASCII NUMERIC CHARACTERS
2586 eaaf 25 04 BLO LB842 * BRANCH IF NOT NUMERIC
2587 eab1 81 39 CMPA #'9 *
2588 eab3 23 10 BLS LB852 * BRANCH IF NUMERIC
2589 * END UP HERE IF NOT UPPER CASE ALPHA OR NUMERIC
2590 eab5 0f 43 LB842 CLR V43 CLEAR ILLEGAL TOKEN FLAG
2591 eab7 81 20 LB844 CMPA #SPACE SPACE?
2592 eab9 27 0a BEQ LB852 DO NOT REMOVE SPACES
2593 eabb 97 42 STA V42 SAVE INPUT CHARACTER AS SCAN DELIMITER
2594 eabd 81 22 CMPA #'" CHECK FOR STRING DELIMITER
2595 eabf 27 38 BEQ LB886 BRANCH IF STRING
2596 eac1 0d 44 TST V44 * CHECK DATA FLAG AND BRANCH IF CLEAR
2597 eac3 27 19 BEQ LB86B * DO NOT CRUNCH DATA
2598 eac5 a7 c0 LB852 STA ,U+ SAVE CHARACTER IN BUFFER
2599 eac7 27 06 BEQ LB85C BRANCH IF END OF LINE
2600 eac9 81 3a CMPA #': * CHECK FOR END OF SUBLINE
2601 eacb 27 cf BEQ LB829 * AND RESET FLAGS IF END OF SUBLINE
2602 eacd 20 d1 LB85A BRA LB82D GO GET ANOTHER CHARACTER
2603 eacf 6f c0 LB85C CLR ,U+ * DOUBLE ZERO AT END OF LINE
2604 ead1 6f c0 CLR ,U+ *
2605 ead3 1f 30 TFR U,D SAVE ADDRESS OF END OF LINE IN ACCD
2606 ead5 83 00 f1 SUBD #LINHDR LENGTH OF LINE IN ACCD
2607 ead8 8e 00 f2 LDX #LINBUF-1 * SET THE INPUT POINTER TO ONE BEFORE
2608 eadb 9f 83 STX CHARAD * THE START OF THE CRUNCHED LINE
2609 eadd 39 RTS EXIT 'CRUNCH'
2610 eade 81 3f LB86B CMPA #'? CHECK FOR "?" - PRINT ABBREVIATION
2611 eae0 26 04 BNE LB873 BRANCH IF NOT PRINT ABBREVIATION
2612 eae2 86 87 LDA #TOK_PRINT * GET THE PRINT TOKEN AND SAVE IT
2613 eae4 20 df BRA LB852 * IN BUFFER
2614 eae6 81 27 LB873 CMPA #'' APOSTROPHE IS SAME AS REM
2615 eae8 26 13 BNE LB88A BRANCH IF NOT REMARK
2616 eaea cc 3a 83 LDD #$3A00+TOK_SNGL_Q COLON, REM TOKEN
2617 eaed ed c1 STD ,U++ SAVE IN BUFFER
2618 eaef 0f 42 LB87C CLR V42 SET DELIMITER = 0 (END OF LINE)
2619 eaf1 a6 80 LB87E LDA ,X+ SCAN TILL WE MATCH [V42]
2620 eaf3 27 d0 BEQ LB852 BRANCH IF END OF LINE
2621 eaf5 91 42 CMPA V42 DELIMITER?
2622 eaf7 27 cc BEQ LB852 BRANCH OUT IF SO
2623 eaf9 a7 c0 LB886 STA ,U+ DON’T CRUNCH REMARKS OR STRINGS
2624 eafb 20 f4 BRA LB87E GO GET MORE STRING OR REMARK
2625 eafd 81 30 LB88A CMPA #'0 * LESS THAN ASCII ZERO?
2626 eaff 25 04 BCS LB892 * BRANCH IF SO
2627 eb01 81 3c CMPA #';+1 = CHECK FOR NUMERIC VALUE, COLON OR SEMICOLON
2628 eb03 25 c0 BCS LB852 = AND INSERT IN BUFFER IF SO
2629 eb05 30 1f LB892 LEAX -1,X MOVE INPUT POINTER BACK ONE
2630 eb07 34 50 PSHS U,X SAVE POINTERS TO INPUT STRING, OUTPUT STRING
2631 eb09 0f 41 CLR V41 TOKEN FLAG 0 = COMMAND, FF = SECONDARY
2632 eb0b ce db e4 LDU #COMVEC-10 POINT U TO COMMAND INTERPRETATION
2633 * TABLE FOR BASIC - 10
2634 eb0e 0f 42 LB89B CLR V42 INITIALIZE V42 AS TOKEN COUNTER
2635 eb10 33 4a LB89D LEAU 10,U MOVE TO NEXT COMMAND INTERPRETATION TABLE
2636 eb12 a6 c4 LDA ,U GET NUMBER OF COMMANDS
2637 eb14 27 31 BEQ LB8D4 GO DO SECONDARY FUNCTIONS IF NO COMMAND TABLE
2638 eb16 10 ae 41 LDY 1,U POINT Y TO COMMAND DICTIONARY TABLE
2639 eb19 ae e4 LB8A6 LDX ,S GET POINTER TO INPUT STRING
2640 eb1b e6 a0 LB8A8 LDB ,Y+ GET A BYTE FROM DICTIONARY TABLE
2641 eb1d e0 80 SUBB ,X+ SUBTRACT INPUT CHARACTER
2642 eb1f 27 fa BEQ LB8A8 LOOP IF SAME
2643 eb21 c1 80 CMPB #$80 LAST CHAR IN RESERVED WORD TABLE HAD
2644 * BIT 7 SET, SO IF WE HAVE $80 HERE
2645 * THEN IT IS A GOOD COMPARE
2646 eb23 26 38 BNE LB8EA BRANCH IF NO MATCH - CHECK ANOTHER COMMAND
2647 eb25 32 62 LEAS 2,S DELETE OLD INPUT POINTER FROM STACK
2648 eb27 35 40 PULS U GET POINTER TO OUTPUT STRING
2649 eb29 da 42 ORB V42 OR IN THE TABLE POSITION TO MAKE THE TOKEN
2650 * - NOTE THAT B ALREADY HAD $80 IN IT -
2651 eb2b 96 41 LDA V41 * CHECK TOKEN FLAG AND BRANCH
2652 eb2d 26 06 BNE LB8C2 * IF SECONDARY
2653 eb2f c1 84 CMPB #TOK_ELSE IS IT ELSE TOKEN?
2654 eb31 26 06 BNE LB8C6 NO
2655 eb33 86 3a LDA #': PUT A COLON (SUBLINE) BEFORE ELSE TOKEN
2656 eb35 ed c1 LB8C2 STD ,U++ SECONDARY TOKENS PRECEEDED BY $FF
2657 eb37 20 94 BRA LB85A GO PROCESS MORE INPUT CHARACTERS
2658 eb39 e7 c0 LB8C6 STB ,U+ SAVE THIS TOKEN
2659 eb3b c1 86 CMPB #TOK_DATA DATA TOKEN?
2660 eb3d 26 02 BNE LB8CE NO
2661 eb3f 0c 44 INC V44 SET DATA FLAG
2662 eb41 c1 82 LB8CE CMPB #TOK_REM REM TOKEN?
2663 eb43 27 aa BEQ LB87C YES
2664 eb45 20 86 LB8D2 BRA LB85A GO PROCESS MORE INPUT CHARACTERS
2665 * CHECK FOR A SECONDARY TOKEN
2666 eb47 ce db e9 LB8D4 LDU #COMVEC-5 NOW DO SECONDARY FUNCTIONS
2667 eb4a 03 41 COM V41 TOGGLE THE TOKEN FLAG
2668 eb4c 26 c0 BNE LB89B BRANCH IF NOW CHECKING SECONDARY COMMANDS
2669
2670 * THIS CODE WILL PROCESS INPUT DATA WHICH CANNOT BE CRUNCHED AND SO
2671 * IS ASSUMED TO BE ILLEGAL DATA OR AN ILLEGAL TOKEN
2672 eb4e 35 50 PULS X,U RESTORE INPUT AND OUTPUT POINTERS
2673 eb50 a6 80 LDA ,X+ * MOVE THE FIRST CHARACTER OF AN
2674 eb52 a7 c0 STA ,U+ * ILLEGAL TOKEN
2675 eb54 bd e6 26 JSR LB3A2 SET CARRY IF NOT ALPHA
2676 eb57 25 ec BCS LB8D2 BRANCH IF NOT ALPHA
2677 eb59 03 43 COM V43 SET ILLEGAL TOKEN FLAG IF UPPER CASE ALPHA
2678 eb5b 20 e8 BRA LB8D2 PROCESS MORE INPUT CHARACTERS
2679 eb5d 0c 42 LB8EA INC V42 INCREMENT TOKEN COUNTER
2680 eb5f 4a DECA DECR COMMAND COUNTER
2681 eb60 27 ae BEQ LB89D GET ANOTHER COMMAND TABLE IF DONE W/THIS ONE
2682 eb62 31 3f LEAY -1,Y MOVE POINTER BACK ONE
2683 eb64 e6 a0 LB8F1 LDB ,Y+ * GET TO NEXT
2684 eb66 2a fc BPL LB8F1 * RESERVED WORD
2685 eb68 20 af BRA LB8A6 GO SEE IF THIS WORD IS A MATCH
2686
2687 * PRINT
2688 eb6a 27 39 PRINT BEQ LB958 BRANCH IF NO ARGUMENT
2689 eb6c 8d 01 BSR LB8FE CHECK FOR ALL PRINT OPTIONS
2690 eb6e 39 RTS
2691 LB8FE
2692 eb6f bd fa cf LB918 JSR XVEC9 CALL EXTENDED BASIC ADD-IN
2693 eb72 27 3e LB91B BEQ LB965 RETURN IF END OF LINE
2694 eb74 81 9f LB91D CMPA #TOK_TAB TOKEN FOR TAB( ?
2695 eb76 27 53 BEQ LB97E YES
2696 eb78 81 2c CMPA #', COMMA?
2697 eb7a 27 37 BEQ LB966 YES - ADVANCE TO NEXT TAB FIELD
2698 eb7c 81 3b CMPA #'; SEMICOLON?
2699 eb7e 27 60 BEQ LB997 YES - DO NOT ADVANCE CURSOR
2700 eb80 bd e3 df JSR LB156 EVALUATE EXPRESSION
2701 eb83 96 06 LDA VALTYP * GET VARIABLE TYPE AND
2702 eb85 34 02 PSHS A * SAVE IT ON THE STACK
2703 eb87 26 06 BNE LB938 BRANCH IF STRING VARIABLE
2704 eb89 bd f0 22 JSR LBDD9 CONVERT FP NUMBER TO AN ASCII STRING
2705 eb8c bd e7 9a JSR LB516 PARSE A STRING FROM (X-1) AND PUT
2706 * DESCRIPTOR ON STRING STACK
2707 eb8f 8d 57 LB938 BSR LB99F PRINT STRING POINTED TO BY X
2708 eb91 35 04 PULS B GET VARIABLE TYPE BACK
2709 eb93 bd dc 30 JSR LA35F SET UP TAB WIDTH ZONE, ETC
2710 eb96 5d LB949 TSTB CHECK CURRENT PRINT POSITION
2711 eb97 26 08 BNE LB954 BRANCH IF NOT AT START OF LINE
2712 eb99 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
2713 eb9b 81 2c CMPA #', COMMA?
2714 eb9d 27 14 BEQ LB966 SKIP TO NEXT TAB FIELD
2715 eb9f 8d 54 BSR LB9AC SEND A SPACE TO CONSOLE OUT
2716 eba1 9d 82 LB954 JSR GETCCH GET CURRENT INPUT CHARACTER
2717 eba3 26 cf BNE LB91D BRANCH IF NOT END OF LINE
2718 eba5 86 0d LB958 LDA #CR * SEND A CR TO
2719 eba7 20 51 BRA LB9B1 * CONSOLE OUT
2720 eba9 bd dc 30 LB95C JSR LA35F SET UP TAB WIDTH, ZONE ETC
2721 ebac 27 f7 BEQ LB958 BRANCH IF WIDTH = ZERO
2722 ebae 96 6c LDA DEVPOS GET PRINT POSITION
2723 ebb0 26 f3 BNE LB958 BRANCH IF NOT AT START OF LINE
2724 ebb2 39 LB965 RTS
2725 * SKIP TO NEXT TAB FIELD
2726 ebb3 bd dc 30 LB966 JSR LA35F SET UP TAB WIDTH, ZONE ETC
2727 ebb6 27 0a BEQ LB975 BRANCH IF LINE WIDTH = 0 (CASSETTE)
2728 ebb8 d6 6c LDB DEVPOS GET CURRENT POSITION
2729 ebba d1 6b CMPB DEVLCF COMPARE TO LAST TAB ZONE
2730 ebbc 25 06 BCS LB977 BRANCH IF < LAST TAB ZONE
2731 ebbe 8d e5 BSR LB958 SEND A CARRIAGE RETURN TO CONSOLE OUT
2732 ebc0 20 1e BRA LB997 GET MORE DATA
2733 ebc2 d6 6c LB975 LDB DEVPOS *
2734 ebc4 d0 6a LB977 SUBB DEVCFW * SUBTRACT TAB FIELD WIDTH FROM CURRENT
2735 ebc6 24 fc BCC LB977 * POSITION UNTIL CARRY SET - NEGATING THE
2736 ebc8 50 NEGB * REMAINDER LEAVES THE NUMBER OF SPACES TO NEXT
2737 * * TAB ZONE IN ACCB
2738 ebc9 20 10 BRA LB98E GO ADVANCE TO NEXT TAB ZONE
2739
2740 * PRINT TAB(
2741 ebcb bd e9 8d LB97E JSR LB709 EVALUATE EXPRESSION - RETURN VALUE IN B
2742 ebce 81 29 CMPA #') * 'SYNTAX' ERROR IF NOT ')'
2743 ebd0 10 26 f9 2c LBNE LB277 *
2744 ebd4 bd dc 30 JSR LA35F SET UP TAB WIDTH, ZONE ETC
2745 ebd7 d0 6c SUBB DEVPOS GET DIFFERENCE OF PRINT POSITION & TAB POSITION
2746 ebd9 23 05 BLS LB997 BRANCH IF TAB POSITION < CURRENT POSITION
2747 LB98E
2748 ebdb 8d 18 LB992 BSR LB9AC SEND A SPACE TO CONSOLE OUT
2749 ebdd 5a DECB DECREMENT DIFFERENCE COUNT
2750 ebde 26 fb BNE LB992 BRANCH UNTIL CURRENT POSITION = TAB POSITION
2751 ebe0 9d 7c LB997 JSR GETNCH GET NEXT CHARACTER FROM BASIC
2752 ebe2 7e eb 72 JMP LB91B LOOK FOR MORE PRINT DATA
2753 * COPY A STRING FROM (X) TO CONSOLE OUT
2754 ebe5 bd e7 9c LB99C JSR LB518 PARSE A STRING FROM X AND PUT
2755 * DESCRIPTOR ON STRING STACK
2756 ebe8 bd e8 db LB99F JSR LB657 GET LENGTH OF STRING AND REMOVE
2757 * DESCRIPTOR FROM STRING STACK
2758 ebeb 5c INCB COMPENSATE FOR DECB BELOW
2759 ebec 5a LB9A3 DECB DECREMENT COUNTER
2760 ebed 27 c3 BEQ LB965 EXIT ROUTINE
2761 ebef a6 80 LDA ,X+ GET A CHARACTER FROM X
2762 ebf1 8d 07 BSR LB9B1 SEND TO CONSOLE OUT
2763 ebf3 20 f7 BRA LB9A3 KEEP LOOPING
2764 ebf5 86 20 LB9AC LDA #SPACE SPACE TO CONSOLE OUT
2765 ebf7 8c FCB SKP2 SKIP NEXT TWO BYTES
2766 ebf8 86 3f LB9AF LDA #'? QUESTION MARK TO CONSOLE OUT
2767 ebfa 7e db 14 LB9B1 JMP PUTCHR JUMP TO CONSOLE OUT
2768
2769 * FLOATING POINT MATH PACKAGE
2770
2771 * ADD .5 TO FPA0
2772 ebfd 8e f1 09 LB9B4 LDX #LBEC0 FLOATING POINT CONSTANT (.5)
2773 ec00 20 09 BRA LB9C2 ADD .5 TO FPA0
2774 * SUBTRACT FPA0 FROM FP NUMBER POINTED
2775 * TO BY (X), LEAVE RESULT IN FPA0
2776 ec02 bd ed 78 LB9B9 JSR LBB2F COPY PACKED FP DATA FROM (X) TO FPA1
2777
2778 * ARITHMETIC OPERATION (-) JUMPS HERE - SUBTRACT FPA0 FROM FPA1 (ENTER
2779 * WITH EXPONENT OF FPA0 IN ACCB AND EXPONENT OF FPA1 IN ACCA)
2780 ec05 03 54 LB9BC COM FP0SGN CHANGE MANTISSA SIGN OF FPA0
2781 ec07 03 62 COM RESSGN REVERSE RESULT SIGN FLAG
2782 ec09 20 03 BRA LB9C5 GO ADD FPA1 AND FPA0
2783 * ADD FP NUMBER POINTED TO BY
2784 * (X) TO FPA0 - LEAVE RESULT IN FPA0
2785 ec0b bd ed 78 LB9C2 JSR LBB2F UNPACK PACKED FP DATA FROM (X) TO
2786 * FPA1; RETURN EXPONENT OF FPA1 IN ACCA
2787
2788 * ARITHMETIC OPERATION (+) JUMPS HERE - ADD FPA0 TO
2789
2790 ec0e 5d LB9C5 TSTB CHECK EXPONENT OF FPA0
2791 ec0f 10 27 02 80 LBEQ LBC4A COPY FPA1 TO FPA0 IF FPA0 =
2792 ec13 8e 00 5c LDX #FP1EXP POINT X TO FPA1
2793 ec16 1f 89 LB9CD TFR A,B PUT EXPONENT OF FPA1 INTO ACCB
2794 ec18 5d TSTB CHECK EXPONENT
2795 ec19 27 6c BEQ LBA3E RETURN IF EXPONENT = 0 (ADDING 0 TO FPA0)
2796 ec1b d0 4f SUBB FP0EXP SUBTRACT EXPONENT OF FPA0 FROM EXPONENT OF FPA1
2797 ec1d 27 69 BEQ LBA3F BRANCH IF EXPONENTS ARE EQUAL
2798 ec1f 25 0a BCS LB9E2 BRANCH IF EXPONENT FPA0 > FPA1
2799 ec21 97 4f STA FP0EXP REPLACE FPA0 EXPONENT WITH FPA1 EXPONENT
2800 ec23 96 61 LDA FP1SGN * REPLACE FPA0 MANTISSA SIGN
2801 ec25 97 54 STA FP0SGN * WITH FPA1 MANTISSA SIGN
2802 ec27 8e 00 4f LDX #FP0EXP POINT X TO FPA0
2803 ec2a 50 NEGB NEGATE DIFFERENCE OF EXPONENTS
2804 ec2b c1 f8 LB9E2 CMPB #-8 TEST DIFFERENCE OF EXPONENTS
2805 ec2d 2f 59 BLE LBA3F BRANCH IF DIFFERENCE OF EXPONENTS <= 8
2806 ec2f 4f CLRA CLEAR OVERFLOW BYTE
2807 ec30 64 01 LSR 1,X SHIFT MS BYTE OF MANTISSA; BIT 7 = 0
2808 ec32 bd ed 03 JSR LBABA GO SHIFT MANTISSA OF (X) TO THE RIGHT (B) TIMES
2809 ec35 d6 62 LB9EC LDB RESSGN GET SIGN FLAG
2810 ec37 2a 0b BPL LB9FB BRANCH IF FPA0 AND FPA1 SIGNS ARE THE SAME
2811 ec39 63 01 COM 1,X * COMPLEMENT MANTISSA POINTED
2812 ec3b 63 02 COM 2,X * TO BY (X) THE
2813 ec3d 63 03 COM 3,X * ADCA BELOW WILL
2814 ec3f 63 04 COM 4,X * CONVERT THIS OPERATION
2815 ec41 43 COMA * INTO A NEG (MANTISSA)
2816 ec42 89 00 ADCA #0 ADD ONE TO ACCA - COMA ALWAYS SETS THE CARRY FLAG
2817 * THE PREVIOUS TWO BYTES MAY BE REPLACED BY A NEGA
2818 *
2819 * ADD MANTISSAS OF FPA0 AND FPA1, PUT RESULT IN FPA0
2820 ec44 97 63 LB9FB STA FPSBYT SAVE FPA SUB BYTE
2821 ec46 96 53 LDA FPA0+3 * ADD LS BYTE
2822 ec48 99 60 ADCA FPA1+3 * OF MANTISSA
2823 ec4a 97 53 STA FPA0+3 SAVE IN FPA0 LSB
2824 ec4c 96 52 LDA FPA0+2 * ADD NEXT BYTE
2825 ec4e 99 5f ADCA FPA1+2 * OF MANTISSA
2826 ec50 97 52 STA FPA0+2 SAVE IN FPA0
2827 ec52 96 51 LDA FPA0+1 * ADD NEXT BYTE
2828 ec54 99 5e ADCA FPA1+1 * OF MANTISSA
2829 ec56 97 51 STA FPA0+1 SAVE IN FPA0
2830 ec58 96 50 LDA FPA0 * ADD MS BYTE
2831 ec5a 99 5d ADCA FPA1 * OF MANTISSA
2832 ec5c 97 50 STA FPA0 SAVE IN FPA0
2833 ec5e 5d TSTB TEST SIGN FLAG
2834 ec5f 2a 44 BPL LBA5C BRANCH IF FPA0 & FPA1 SIGNS WERE ALIKE
2835 ec61 25 02 LBA18 BCS LBA1C BRANCH IF POSITIVE MANTISSA
2836 ec63 8d 5d BSR LBA79 NEGATE FPA0 MANTISSA
2837
2838 * NORMALIZE FPA0
2839 ec65 5f LBA1C CLRB CLEAR TEMPORARY EXPONENT ACCUMULATOR
2840 ec66 96 50 LBA1D LDA FPA0 TEST MSB OF MANTISSA
2841 ec68 26 2e BNE LBA4F BRANCH IF <> 0
2842 ec6a 96 51 LDA FPA0+1 * IF THE MSB IS
2843 ec6c 97 50 STA FPA0 * 0, THEN SHIFT THE
2844 ec6e 96 52 LDA FPA0+2 * MANTISSA A WHOLE BYTE
2845 ec70 97 51 STA FPA0+1 * AT A TIME. THIS
2846 ec72 96 53 LDA FPA0+3 * IS FASTER THAN ONE
2847 ec74 97 52 STA FPA0+2 * BIT AT A TIME
2848 ec76 96 63 LDA FPSBYT * BUT USES MORE MEMORY.
2849 ec78 97 53 STA FPA0+3 * FPSBYT, THE CARRY IN
2850 ec7a 0f 63 CLR FPSBYT * BYTE, REPLACES THE MATISSA LSB.
2851 ec7c cb 08 ADDB #8 SHIFTING ONE BYTE = 8 BIT SHIFTS; ADD 8 TO EXPONENT
2852 ec7e c1 28 CMPB #5*8 CHECK FOR 5 SHIFTS
2853 ec80 2d e4 BLT LBA1D BRANCH IF < 5 SHIFTS, IF > 5, THEN MANTISSA = 0
2854 ec82 4f LBA39 CLRA A ZERO EXPONENT = 0 FLOATING POINT
2855 ec83 97 4f LBA3A STA FP0EXP ZERO OUT THE EXPONENT
2856 ec85 97 54 STA FP0SGN ZERO OUT THE MANTISSA SIGN
2857 ec87 39 LBA3E RTS
2858 ec88 8d 6d LBA3F BSR LBAAE SHIFT FPA0 MANTISSA TO RIGHT
2859 ec8a 5f CLRB CLEAR CARRY FLAG
2860 ec8b 20 a8 BRA LB9EC
2861 * SHIFT FPA0 LEFT ONE BIT UNTIL BIT 7
2862 * OF MATISSA MS BYTE = 1
2863 ec8d 5c LBA44 INCB ADD ONE TO EXPONENT ACCUMULATOR
2864 ec8e 08 63 ASL FPSBYT SHIFT SUB BYTE ONE LEFT
2865 ec90 09 53 ROL FPA0+3 SHIFT LS BYTE
2866 ec92 09 52 ROL FPA0+2 SHIFT NS BYTE
2867 ec94 09 51 ROL FPA0+1 SHIFT NS BYTE
2868 ec96 09 50 ROL FPA0 SHIFT MS BYTE
2869 ec98 2a f3 LBA4F BPL LBA44 BRANCH IF NOT YET NORMALIZED
2870 ec9a 96 4f LDA FP0EXP GET CURRENT EXPONENT
2871 ec9c 34 04 PSHS B SAVE EXPONENT MODIFIER CAUSED BY NORMALIZATION
2872 ec9e a0 e0 SUBA ,S+ SUBTRACT ACCUMULATED EXPONENT MODIFIER
2873 eca0 97 4f STA FP0EXP SAVE AS NEW EXPONENT
2874 eca2 23 de BLS LBA39 SET FPA0 = 0 IF THE NORMALIZATION CAUSED
2875 * MORE OR EQUAL NUMBER OF LEFT SHIFTS THAN THE
2876 * SIZE OF THE EXPONENT
2877 eca4 8c FCB SKP2 SKIP 2 BYTES
2878 eca5 25 08 LBA5C BCS LBA66 BRANCH IF MANTISSA OVERFLOW
2879 eca7 08 63 ASL FPSBYT SUB BYTE BIT 7 TO CARRY - USE AS ROUND-OFF
2880 * FLAG (TRUNCATE THE REST OF SUB BYTE)
2881 eca9 86 00 LDA #0 CLRA, BUT DO NOT CHANGE CARRY FLAG
2882 ecab 97 63 STA FPSBYT CLEAR THE SUB BYTE
2883 ecad 20 0c BRA LBA72 GO ROUND-OFF RESULT
2884 ecaf 0c 4f LBA66 INC FP0EXP INCREMENT EXPONENT - MULTIPLY BY 2
2885 ecb1 27 28 BEQ LBA92 OVERFLOW ERROR IF CARRY PAST $FF
2886 ecb3 06 50 ROR FPA0 * SHIFT MANTISSA
2887 ecb5 06 51 ROR FPA0+1 * ONE TO
2888 ecb7 06 52 ROR FPA0+2 * THE RIGHT -
2889 ecb9 06 53 ROR FPA0+3 * DIVIDE BY TWO
2890 ecbb 24 04 LBA72 BCC LBA78 BRANCH IF NO ROUND-OFF NEEDED
2891 ecbd 8d 0d BSR LBA83 ADD ONE TO MANTISSA - ROUND OFF
2892 ecbf 27 ee BEQ LBA66 BRANCH iF OVERFLOW - MANTISSA = 0
2893 ecc1 39 LBA78 RTS
2894 * NEGATE FPA0 MANTISSA
2895 ecc2 03 54 LBA79 COM FP0SGN TOGGLE SIGN OF MANTISSA
2896 ecc4 03 50 LBA7B COM FPA0 * COMPLEMENT ALL 4 MANTISSA BYTES
2897 ecc6 03 51 COM FPA0+1 *
2898 ecc8 03 52 COM FPA0+2 *
2899 ecca 03 53 COM FPA0+3 *
2900 * ADD ONE TO FPA0 MANTISSA
2901 eccc 9e 52 LBA83 LDX FPA0+2 * GET BOTTOM 2 MANTISSA
2902 ecce 30 01 LEAX 1,X * BYTES, ADD ONE TO
2903 ecd0 9f 52 STX FPA0+2 * THEM AND SAVE THEM
2904 ecd2 26 06 BNE LBA91 BRANCH IF NO OVERFLOW
2905 ecd4 9e 50 LDX FPA0 * IF OVERFLOW ADD ONE
2906 ecd6 30 01 LEAX 1,X * TO TOP 2 MANTISSA
2907 ecd8 9f 50 STX FPA0 * BYTES AND SAVE THEM
2908 ecda 39 LBA91 RTS
2909 ecdb c6 0a LBA92 LDB #2*5 OV' OVERFLOW ERROR
2910 ecdd 7e df 03 JMP LAC46 PROCESS AN ERROR
2911 ece0 8e 00 12 LBA97 LDX #FPA2-1 POINT X TO FPA2
2912 * SHIFT FPA POINTED TO BY (X) TO
2913 * THE RIGHT -(B) TIMES. EXIT WITH
2914 * ACCA CONTAINING DATA SHIFTED OUT
2915 * TO THE RIGHT (SUB BYTE) AND THE DATA
2916 * SHIFTED IN FROM THE LEFT WILL COME FROM FPCARY
2917 ece3 a6 04 LBA9A LDA 4,X GET LS BYTE OF MANTISSA (X)
2918 ece5 97 63 STA FPSBYT SAVE IN FPA SUB BYTE
2919 ece7 a6 03 LDA 3,X * SHIFT THE NEXT THREE BYTES OF THE
2920 ece9 a7 04 STA 4,X * MANTISSA RIGHT ONE COMPLETE BYTE.
2921 eceb a6 02 LDA 2,X *
2922 eced a7 03 STA 3,X *
2923 ecef a6 01 LDA 1,X *
2924 ecf1 a7 02 STA 2,X *
2925 ecf3 96 5b LDA FPCARY GET THE CARRY IN BYTE
2926 ecf5 a7 01 STA 1,X STORE AS THE MS MANTISSA BYTE OF (X)
2927 ecf7 cb 08 LBAAE ADDB #8 ADD 8 TO DIFFERENCE OF EXPONENTS
2928 ecf9 2f e8 BLE LBA9A BRANCH IF EXPONENT DIFFERENCE < -8
2929 ecfb 96 63 LDA FPSBYT GET FPA SUB BYTE
2930 ecfd c0 08 SUBB #8 CAST OUT THE 8 ADDED IN ABOVE
2931 ecff 27 0c BEQ LBAC4 BRANCH IF EXPONENT DIFFERENCE = 0
2932
2933
2934 ed01 67 01 LBAB8 ASR 1,X * SHIFT MANTISSA AND SUB BYTE ONE BIT TO THE RIGHT
2935 ed03 66 02 LBABA ROR 2,X *
2936 ed05 66 03 ROR 3,X *
2937 ed07 66 04 ROR 4,X *
2938 ed09 46 RORA *
2939 ed0a 5c INCB ADD ONE TO EXPONENT DIFFERENCE
2940 ed0b 26 f4 BNE LBAB8 BRANCH IF EXPONENTS NOT =
2941 ed0d 39 LBAC4 RTS
2942 ed0e 81 00 00 00 00 LBAC5 FCB $81,$00,$00,$00,$00 FLOATING POINT CONSTANT 1.0
2943
2944 * ARITHMETIC OPERATION (*) JUMPS HERE - MULTIPLY
2945 * FPA0 BY (X) - RETURN PRODUCT IN FPA0
2946 ed13 8d 63 LBACA BSR LBB2F MOVE PACKED FPA FROM (X) TO FPA1
2947 ed15 27 60 LBACC BEQ LBB2E BRANCH IF EXPONENT OF FPA0 = 0
2948 ed17 8d 78 BSR LBB48 CALCULATE EXPONENT OF PRODUCT
2949 * MULTIPLY FPA0 MANTISSA BY FPA1. NORMALIZE
2950 * HIGH ORDER BYTES OF PRODUCT IN FPA0. THE
2951 * LOW ORDER FOUR BYTES OF THE PRODUCT WILL
2952 * BE STORED IN VAB-VAE.
2953 ed19 86 00 LBAD0 LDA #0 * ZERO OUT MANTISSA OF FPA2
2954 ed1b 97 13 STA FPA2 *
2955 ed1d 97 14 STA FPA2+1 *
2956 ed1f 97 15 STA FPA2+2 *
2957 ed21 97 16 STA FPA2+3 *
2958 ed23 d6 53 LDB FPA0+3 GET LS BYTE OF FPA0
2959 ed25 8d 22 BSR LBB00 MULTIPLY BY FPA1
2960 ed27 d6 63 LDB FPSBYT * TEMPORARILY SAVE SUB BYTE 4
2961 ed29 d7 8b STB VAE *
2962 ed2b d6 52 LDB FPA0+2 GET NUMBER 3 MANTISSA BYTE OF FPA0
2963 ed2d 8d 1a BSR LBB00 MULTIPLY BY FPA1
2964 ed2f d6 63 LDB FPSBYT * TEMPORARILY SAVE SUB BYTE 3
2965 ed31 d7 8a STB VAD *
2966 ed33 d6 51 LDB FPA0+1 GET NUMBER 2 MANTISSA BYTE OF FPA0
2967 ed35 8d 12 BSR LBB00 MULTIPLY BY FPA1
2968 ed37 d6 63 LDB FPSBYT * TEMPORARILY SAVE SUB BYTE 2
2969 ed39 d7 89 STB VAC *
2970 ed3b d6 50 LDB FPA0 GET MS BYTE OF FPA0 MANTISSA
2971 ed3d 8d 0c BSR LBB02 MULTIPLY BY FPA1
2972 ed3f d6 63 LDB FPSBYT * TEMPORARILY SAVE SUB BYTE 1
2973 ed41 d7 88 STB VAB *
2974 ed43 bd ee 54 JSR LBC0B COPY MANTISSA FROM FPA2 TO FPA0
2975 ed46 7e ec 65 JMP LBA1C NORMALIZE FPA0
2976 ed49 27 95 LBB00 BEQ LBA97 SHIFT FPA2 ONE BYTE TO RIGHT
2977 ed4b 43 LBB02 COMA SET CARRY FLAG
2978 * MULTIPLY FPA1 MANTISSA BY ACCB AND
2979 * ADD PRODUCT TO FPA2 MANTISSA
2980 ed4c 96 13 LBB03 LDA FPA2 GET FPA2 MS BYTE
2981 ed4e 56 RORB ROTATE CARRY FLAG INTO SHIFT COUNTER;
2982 * DATA BIT INTO CARRY
2983 ed4f 27 26 BEQ LBB2E BRANCH WHEN 8 SHIFTS DONE
2984 ed51 24 16 BCC LBB20 DO NOT ADD FPA1 IF DATA BIT = 0
2985 ed53 96 16 LDA FPA2+3 * ADD MANTISSA LS BYTE
2986 ed55 9b 60 ADDA FPA1+3 *
2987 ed57 97 16 STA FPA2+3 *
2988 ed59 96 15 LDA FPA2+2 = ADD MANTISSA NUMBER 3 BYTE
2989 ed5b 99 5f ADCA FPA1+2 =
2990 ed5d 97 15 STA FPA2+2 =
2991 ed5f 96 14 LDA FPA2+1 * ADD MANTISSA NUMBER 2 BYTE
2992 ed61 99 5e ADCA FPA1+1 *
2993 ed63 97 14 STA FPA2+1 *
2994 ed65 96 13 LDA FPA2 = ADD MANTISSA MS BYTE
2995 ed67 99 5d ADCA FPA1 =
2996 ed69 46 LBB20 RORA * ROTATE CARRY INTO MS BYTE
2997 ed6a 97 13 STA FPA2 *
2998 ed6c 06 14 ROR FPA2+1 = ROTATE FPA2 ONE BIT TO THE RIGHT
2999 ed6e 06 15 ROR FPA2+2 =
3000 ed70 06 16 ROR FPA2+3 =
3001 ed72 06 63 ROR FPSBYT =
3002 ed74 4f CLRA CLEAR CARRY FLAG
3003 ed75 20 d5 BRA LBB03 KEEP LOOPING
3004 ed77 39 LBB2E RTS
3005 * UNPACK A FP NUMBER FROM (X) TO FPA1
3006 ed78 ec 01 LBB2F LDD 1,X GET TWO MSB BYTES OF MANTISSA FROM
3007 * FPA POINTED TO BY X
3008 ed7a 97 61 STA FP1SGN SAVE PACKED MANTISSA SIGN BYTE
3009 ed7c 8a 80 ORA #$80 FORCE BIT 7 OF MSB MANTISSA = 1
3010 ed7e dd 5d STD FPA1 SAVE 2 MSB BYTES IN FPA1
3011 ed80 d6 61 LDB FP1SGN * GET PACKED MANTISSA SIGN BYTE. EOR W/FPA0
3012 ed82 d8 54 EORB FP0SGN * SIGN - NEW SIGN POSITION IF BOTH OLD SIGNS ALIKE,
3013 ed84 d7 62 STB RESSGN * NEG IF BOTH OLD SIGNS DIFF. SAVE ADJUSTED
3014 * * MANTISSA SIGN BYTE
3015 ed86 ec 03 LDD 3,X = GET 2 LSB BYTES OF MANTISSA
3016 ed88 dd 5f STD FPA1+2 = AND PUT IN FPA1
3017 ed8a a6 84 LDA ,X * GET EXPONENT FROM (X) AND
3018 ed8c 97 5c STA FP1EXP * PUT IN EXPONENT OF FPA1
3019 ed8e d6 4f LDB FP0EXP GET EXPONENT OF FPA0
3020 ed90 39 RTS
3021 * CALCULATE EXPONENT FOR PRODUCT OF FPA0 & FPA1
3022 * ENTER WITH EXPONENT OF FPA1 IN ACCA
3023 ed91 4d LBB48 TSTA TEST EXPONENT OF FPA1
3024 ed92 27 16 BEQ LBB61 PURGE RETURN ADDRESS & SET FPA0 = 0
3025 ed94 9b 4f ADDA FP0EXP ADD FPA1 EXPONENT TO FPA0 EXPONENT
3026 ed96 46 RORA ROTATE CARRY INTO BIT 7; BIT 0 INTO CARRY
3027 ed97 49 ROLA SET OVERFLOW FLAG
3028 ed98 28 10 BVC LBB61 BRANCH IF EXPONENT TOO LARGE OR SMALL
3029 ed9a 8b 80 ADDA #$80 ADD $80 BIAS TO EXPONENT
3030 ed9c 97 4f STA FP0EXP SAVE NEW EXPONENT
3031 ed9e 27 0c BEQ LBB63 SET FPA0
3032 eda0 96 62 LDA RESSGN GET MANTISSA SIGN
3033 eda2 97 54 STA FP0SGN SAVE AS MANTISSA SIGN OF FPA0
3034 eda4 39 RTS
3035 * IF FPA0 = POSITIVE THEN 'OV' ERROR IF FPA0
3036 * = IS NEGATIVE THEN FPA0 = 0
3037 eda5 96 54 LBB5C LDA FP0SGN GET MANTISSA SIGN OF FPA0
3038 eda7 43 COMA CHANGE SIGN OF FPA0 MANTISSA
3039 eda8 20 02 BRA LBB63
3040 edaa 32 62 LBB61 LEAS 2,S PURGE RETURN ADDRESS FROM STACK
3041 edac 10 2a fe d2 LBB63 LBPL LBA39 ZERO FPA0 MANTISSA SIGN & EXPONENT
3042 edb0 7e ec db LBB67 JMP LBA92 OV' OVERFLOW ERROR
3043 * FAST MULTIPLY BY 10 AND LEAVE RESULT IN FPA0
3044 edb3 bd ee a8 LBB6A JSR LBC5F TRANSFER FPA0 TO FPA1
3045 edb6 27 0d BEQ LBB7C BRANCH IF EXPONENT = 0
3046 edb8 8b 02 ADDA #2 ADD 2 TO EXPONENT (TIMES 4)
3047 edba 25 f4 BCS LBB67 OV' ERROR IF EXPONENT > $FF
3048 edbc 0f 62 CLR RESSGN CLEAR RESULT SIGN BYTE
3049 edbe bd ec 16 JSR LB9CD ADD FPA1 TO FPA0 (TIMES 5)
3050 edc1 0c 4f INC FP0EXP ADD ONE TO EXPONENT (TIMES 10)
3051 edc3 27 eb BEQ LBB67 OV' ERROR IF EXPONENT > $FF
3052 edc5 39 LBB7C RTS
3053 edc6 84 20 00 00 00 LBB7D FCB $84,$20,$00,$00,$00 FLOATING POINT CONSTANT 10
3054 * DIVIDE FPA0 BY 10
3055 edcb bd ee a8 LBB82 JSR LBC5F MOVE FPA0 TO FPA1
3056 edce 8e ed c6 LDX #LBB7D POINT TO FLOATING POINT CONSTANT 10
3057 edd1 5f CLRB ZERO MANTISSA SIGN BYTE
3058 edd2 d7 62 LBB89 STB RESSGN STORE THE QUOTIENT MANTISSA SIGN BYTE
3059 edd4 bd ee 5d JSR LBC14 UNPACK AN FP NUMBER FROM (X) INTO FPA0
3060 edd7 8c FCB SKP2 SKIP TWO BYTES
3061 * DIVIDE (X) BY FPA0-LEAVE NORMALIZED QUOTIENT IN FPA0
3062 edd8 8d 9e LBB8F BSR LBB2F GET FP NUMBER FROM (X) TO FPA1
3063
3064 * ARITHMETIC OPERATION (/) JUMPS HERE. DIVIDE FPA1 BY FPA0 (ENTER WITH
3065 * EXPONENT OF FPA1 IN ACCA AND FLAGS SET BY TSTA)
3066
3067 * DIVIDE FPA1 BY FPA0
3068 edda 27 73 LBB91 BEQ LBC06 /0' DIVIDE BY ZERO ERROR
3069 eddc 00 4f NEG FP0EXP GET EXPONENT OF RECIPROCAL OF DIVISOR
3070 edde 8d b1 BSR LBB48 CALCULATE EXPONENT OF QUOTIENT
3071 ede0 0c 4f INC FP0EXP INCREMENT EXPONENT
3072 ede2 27 cc BEQ LBB67 OV' OVERFLOW ERROR
3073 ede4 8e 00 13 LDX #FPA2 POINT X TO MANTISSA OF FPA2 - HOLD
3074 * TEMPORARY QUOTIENT IN FPA2
3075 ede7 c6 04 LDB #4 5 BYTE DIVIDE
3076 ede9 d7 03 STB TMPLOC SAVE BYTE COUNTER
3077 edeb c6 01 LDB #1 SHIFT COUNTER-AND TEMPORARY QUOTIENT BYTE
3078 * COMPARE FPA0 MANTISSA TO FPA1 MANTISSA -
3079 * SET CARRY FLAG IF FPA1 >= FPA0
3080 eded 96 50 LBBA4 LDA FPA0 * COMPARE THE TWO MS BYTES
3081 edef 91 5d CMPA FPA1 * OF FPA0 AND FPA1 AND
3082 edf1 26 13 BNE LBBBD * BRANCH IF <>
3083 edf3 96 51 LDA FPA0+1 = COMPARE THE NUMBER 2
3084 edf5 91 5e CMPA FPA1+1 = BYTES AND
3085 edf7 26 0d BNE LBBBD = BRANCH IF <>
3086 edf9 96 52 LDA FPA0+2 * COMPARE THE NUMBER 3
3087 edfb 91 5f CMPA FPA1+2 * BYTES AND
3088 edfd 26 07 BNE LBBBD * BRANCH IF <>
3089 edff 96 53 LDA FPA0+3 = COMPARE THE LS BYTES
3090 ee01 91 60 CMPA FPA1+3 = AND BRANCH
3091 ee03 26 01 BNE LBBBD = IF <>
3092 ee05 43 COMA SET CARRY FLAG IF FPA0 = FPA1
3093 ee06 1f a8 LBBBD TFR CC,A SAVE CARRY FLAG STATUS IN ACCA; CARRY
3094 * CLEAR IF FPA0 > FPA1
3095 ee08 59 ROLB ROTATE CARRY INTO TEMPORARY QUOTIENT BYTE
3096 ee09 24 0a BCC LBBCC CARRY WILL BE SET AFTER 8 SHIFTS
3097 ee0b e7 80 STB ,X+ SAVE TEMPORARY QUOTIENT
3098 ee0d 0a 03 DEC TMPLOC DECREMENT BYTE COUNTER
3099 ee0f 2b 34 BMI LBBFC BRANCH IF DONE
3100 ee11 27 2e BEQ LBBF8 BRANCH IF LAST BYTE
3101 ee13 c6 01 LDB #1 RESET SHIFT COUNTER AND TEMPORARY QUOTIENT BYTE
3102 ee15 1f 8a LBBCC TFR A,CC RESTORE CARRY FLAG AND
3103 ee17 25 0e BCS LBBDE BRANCH IF FPA0 =< FPA1
3104 ee19 08 60 LBBD0 ASL FPA1+3 * SHIFT FPA1 MANTISSA 1 BIT TO LEFT
3105 ee1b 09 5f ROL FPA1+2 *
3106 ee1d 09 5e ROL FPA1+1 *
3107 ee1f 09 5d ROL FPA1 *
3108 ee21 25 e3 BCS LBBBD BRANCH IF CARRY - ADD ONE TO PARTIAL QUOTIENT
3109 ee23 2b c8 BMI LBBA4 IF MSB OF HIGH ORDER MANTISSA BYTE IS
3110 * SET, CHECK THE MAGNITUDES OF FPA0, FPA1
3111 ee25 20 df BRA LBBBD CARRY IS CLEAR, CHECK ANOTHER BIT
3112 * SUBTRACT FPA0 FROM FPA1 - LEAVE RESULT IN FPA1
3113 ee27 96 60 LBBDE LDA FPA1+3 * SUBTRACT THE LS BYTES OF MANTISSA
3114 ee29 90 53 SUBA FPA0+3 *
3115 ee2b 97 60 STA FPA1+3 *
3116 ee2d 96 5f LDA FPA1+2 = THEN THE NEXT BYTE
3117 ee2f 92 52 SBCA FPA0+2 =
3118 ee31 97 5f STA FPA1+2 =
3119 ee33 96 5e LDA FPA1+1 * AND THE NEXT
3120 ee35 92 51 SBCA FPA0+1 *
3121 ee37 97 5e STA FPA1+1 *
3122 ee39 96 5d LDA FPA1 = AND FINALLY, THE MS BYTE OF MANTISSA
3123 ee3b 92 50 SBCA FPA0 =
3124 ee3d 97 5d STA FPA1 =
3125 ee3f 20 d8 BRA LBBD0 GO SHIFT FPA1
3126 ee41 c6 40 LBBF8 LDB #$40 USE ONLY TWO BITS OF THE LAST BYTE (FIFTH)
3127 ee43 20 d0 BRA LBBCC GO SHIFT THE LAST BYTE
3128 ee45 56 LBBFC RORB * SHIFT CARRY (ALWAYS SET HERE) INTO
3129 ee46 56 RORB * BIT 5 AND MOVE
3130 ee47 56 RORB * BITS 1,0 TO BITS 7,6
3131 ee48 d7 63 STB FPSBYT SAVE SUB BYTE
3132 ee4a 8d 08 BSR LBC0B MOVE MANTISSA OF FPA2 TO FPA0
3133 ee4c 7e ec 65 JMP LBA1C NORMALIZE FPA0
3134 ee4f c6 14 LBC06 LDB #2*10 /0' ERROR
3135 ee51 7e df 03 JMP LAC46 PROCESS THE ERROR
3136 * COPY MANTISSA FROM FPA2 TO FPA0
3137 ee54 9e 13 LBC0B LDX FPA2 * MOVE TOP 2 BYTES
3138 ee56 9f 50 STX FPA0 *
3139 ee58 9e 15 LDX FPA2+2 = MOVE BOTTOM 2 BYTES
3140 ee5a 9f 52 STX FPA0+2 =
3141 ee5c 39 RTS
3142 * COPY A PACKED FP NUMBER FROM (X) TO FPA0
3143 ee5d 34 02 LBC14 PSHS A SAVE ACCA
3144 ee5f ec 01 LDD 1,X GET TOP TWO MANTISSA BYTES
3145 ee61 97 54 STA FP0SGN SAVE MS BYTE OF MANTISSA AS MANTISSA SIGN
3146 ee63 8a 80 ORA #$80 UNPACK MS BYTE
3147 ee65 dd 50 STD FPA0 SAVE UNPACKED TOP 2 MANTISSA BYTES
3148 ee67 0f 63 CLR FPSBYT CLEAR MANTISSA SUB BYTE
3149 ee69 e6 84 LDB ,X GET EXPONENT TO ACCB
3150 ee6b ae 03 LDX 3,X * MOVE LAST 2
3151 ee6d 9f 52 STX FPA0+2 * MANTISSA BYTES
3152 ee6f d7 4f STB FP0EXP SAVE EXPONENT
3153 ee71 35 82 PULS A,PC RESTORE ACCA AND RETURN
3154
3155 ee73 8e 00 45 LBC2A LDX #V45 POINT X TO MANTISSA OF FPA4
3156 ee76 20 06 BRA LBC35 MOVE FPA0 TO FPA4
3157 ee78 8e 00 40 LBC2F LDX #V40 POINT X TO MANTISSA OF FPA3
3158 ee7b 8c FCB SKP2 SKIP TWO BYTES
3159 ee7c 9e 3b LBC33 LDX VARDES POINT X TO VARIABLE DESCRIPTOR IN VARDES
3160 * PACK FPA0 AND MOVE IT TO ADDRESS IN X
3161 ee7e 96 4f LBC35 LDA FP0EXP * COPY EXPONENT
3162 ee80 a7 84 STA ,X *
3163 ee82 96 54 LDA FP0SGN GET MANTISSA SIGN BIT
3164 ee84 8a 7f ORA #$7F MASK THE BOTTOM 7 BITS
3165 ee86 94 50 ANDA FPA0 AND BIT 7 OF MANTISSA SIGN INTO BIT 7 OF MS BYTE
3166 ee88 a7 01 STA 1,X SAVE MS BYTE
3167 ee8a 96 51 LDA FPA0+1 * MOVE 2ND MANTISSA BYTE
3168 ee8c a7 02 STA 2,X *
3169 ee8e de 52 LDU FPA0+2 = MOVE BOTTOM 2 MANTISSA BYTES
3170 ee90 ef 03 STU 3,X =
3171 ee92 39 RTS
3172 * MOVE FPA1 TO FPA0 RETURN W/MANTISSA SIGN IN ACCA
3173 ee93 96 61 LBC4A LDA FP1SGN * COPY MANTISSA SIGN FROM
3174 ee95 97 54 LBC4C STA FP0SGN * FPA1 TO FPA0
3175 ee97 9e 5c LDX FP1EXP = COPY EXPONENT + MS BYTE FROM
3176 ee99 9f 4f STX FP0EXP = FPA1 TO FPA0
3177 ee9b 0f 63 CLR FPSBYT CLEAR MANTISSA SUB BYTE
3178 ee9d 96 5e LDA FPA1+1 * COPY 2ND MANTISSA BYTE
3179 ee9f 97 51 STA FPA0+1 * FROM FPA1 TO FPA0
3180 eea1 96 54 LDA FP0SGN GET MANTISSA SIGN
3181 eea3 9e 5f LDX FPA1+2 * COPY 3RD AND 4TH MANTISSA BYTE
3182 eea5 9f 52 STX FPA0+2 * FROM FPA1 TO FPA0
3183 eea7 39 RTS
3184 * TRANSFER FPA0 TO FPA1
3185 eea8 dc 4f LBC5F LDD FP0EXP * TRANSFER EXPONENT & MS BYTE
3186 eeaa dd 5c STD FP1EXP *
3187 eeac 9e 51 LDX FPA0+1 = TRANSFER MIDDLE TWO BYTES
3188 eeae 9f 5e STX FPA1+1 =
3189 eeb0 9e 53 LDX FPA0+3 * TRANSFER BOTTOM TWO BYTES
3190 eeb2 9f 60 STX FPA1+3 *
3191 eeb4 4d TSTA SET FLAGS ACCORDING TO EXPONENT
3192 eeb5 39 RTS
3193 * CHECK FPA0; RETURN ACCB = 0 IF FPA0 = 0,
3194 * ACCB = $FF IF FPA0 = NEGATIVE, ACCB = 1 IF FPA0 = POSITIVE
3195 eeb6 d6 4f LBC6D LDB FP0EXP GET EXPONENT
3196 eeb8 27 08 BEQ LBC79 BRANCH IF FPA0 = 0
3197 eeba d6 54 LBC71 LDB FP0SGN GET SIGN OF MANTISSA
3198 eebc 59 LBC73 ROLB BIT 7 TO CARRY
3199 eebd c6 ff LDB #$FF NEGATIVE FLAG
3200 eebf 25 01 BCS LBC79 BRANCH IF NEGATIVE MANTISSA
3201 eec1 50 NEGB ACCB = 1 IF POSITIVE MANTISSA
3202 eec2 39 LBC79 RTS
3203
3204 * SGN
3205 eec3 8d f1 SGN BSR LBC6D SET ACCB ACCORDING TO SIGN OF FPA0
3206 * CONVERT A SIGNED NUMBER IN ACCB INTO A FLOATING POINT NUMBER
3207 eec5 d7 50 LBC7C STB FPA0 SAVE ACCB IN FPA0
3208 eec7 0f 51 CLR FPA0+1 CLEAR NUMBER 2 MANTISSA BYTE OF FPA0
3209 eec9 c6 88 LDB #$88 EXPONENT REQUIRED IF FPA0 IS TO BE AN INTEGER
3210 eecb 96 50 LBC82 LDA FPA0 GET MS BYTE OF MANTISSA
3211 eecd 80 80 SUBA #$80 SET CARRY IF POSITIVE MANTISSA
3212 eecf d7 4f LBC86 STB FP0EXP SAVE EXPONENT
3213 eed1 dc 74 LDD ZERO * ZERO OUT ACCD AND
3214 eed3 dd 52 STD FPA0+2 * BOTTOM HALF OF FPA0
3215 eed5 97 63 STA FPSBYT CLEAR SUB BYTE
3216 eed7 97 54 STA FP0SGN CLEAR SIGN OF FPA0 MANTISSA
3217 eed9 7e ec 61 JMP LBA18 GO NORMALIZE FPA0
3218
3219 * ABS
3220 eedc 0f 54 ABS CLR FP0SGN FORCE MANTISSA SIGN OF FPA0 POSITIVE
3221 eede 39 RTS
3222 * COMPARE A PACKED FLOATING POINT NUMBER POINTED TO
3223 * BY (X) TO AN UNPACKED FP NUMBER IN FPA0. RETURN
3224 * ZERO FLAG SET AND ACCB = 0, IF EQUAL; ACCB = 1 IF
3225 * FPA0 > (X); ACCB = $FF IF FPA0 < (X)
3226 eedf e6 84 LBC96 LDB ,X CHECK EXPONENT OF (X)
3227 eee1 27 d3 BEQ LBC6D BRANCH IF FPA = 0
3228 eee3 e6 01 LDB 1,X GET MS BYTE OF MANTISSA OF (X)
3229 eee5 d8 54 EORB FP0SGN EOR WITH SIGN OF FPA0
3230 eee7 2b d1 BMI LBC71 BRANCH IF SIGNS NOT =
3231 * COMPARE FPA0 WITH FP NUMBER POINTED TO BY (X).
3232 * FPA0 IS NORMALIZED, (X) IS PACKED.
3233 eee9 d6 4f LBCA0 LDB FP0EXP * GET EXPONENT OF
3234 eeeb e1 84 CMPB ,X * FPA0, COMPARE TO EXPONENT OF
3235 eeed 26 1d BNE LBCC3 * (X) AND BRANCH IF <>.
3236 eeef e6 01 LDB 1,X * GET MS BYTE OF (X), KEEP ONLY
3237 eef1 ca 7f ORB #$7F * THE SIGN BIT - 'AND' THE BOTTOM 7
3238 eef3 d4 50 ANDB FPA0 * BITS OF FPA0 INTO ACCB
3239 eef5 e1 01 CMPB 1,X = COMPARE THE BOTTOM 7 BITS OF THE MANTISSA
3240 eef7 26 13 BNE LBCC3 = MS BYTE AND BRANCH IF <>
3241 eef9 d6 51 LDB FPA0+1 * COMPARE 2ND BYTE
3242 eefb e1 02 CMPB 2,X * OF MANTISSA,
3243 eefd 26 0d BNE LBCC3 * BRANCH IF <>
3244 eeff d6 52 LDB FPA0+2 = COMPARE 3RD BYTE
3245 ef01 e1 03 CMPB 3,X = OF MANTISSA,
3246 ef03 26 07 BNE LBCC3 = BRANCH IF <>
3247 ef05 d6 53 LDB FPA0+3 * SUBTRACT LS BYTE
3248 ef07 e0 04 SUBB 4,X * OF (X) FROM LS BYTE OF
3249 ef09 26 01 BNE LBCC3 * FPA0, BRANCH IF <>
3250 ef0b 39 RTS RETURN IF FP (X) = FPA0
3251 ef0c 56 LBCC3 RORB SHIFT CARRY TO BIT 7; CARRY SET IF FPA0 < (X)
3252 ef0d d8 54 EORB FP0SGN TOGGLE SIZE COMPARISON BIT IF FPA0 IS NEGATIVE
3253 ef0f 20 ab BRA LBC73 GO SET ACCB ACCORDING TO COMPARISON
3254 * DE-NORMALIZE FPA0 : SHIFT THE MANTISSA UNTIL THE BINARY POINT IS TO THE RIGHT
3255 * OF THE LEAST SIGNIFICANT BYTE OF THE MANTISSA
3256 ef11 d6 4f LBCC8 LDB FP0EXP GET EXPONENT OF FPA0
3257 ef13 27 3d BEQ LBD09 ZERO MANTISSA IF FPA0 = 0
3258 ef15 c0 a0 SUBB #$A0 SUBTRACT $A0 FROM FPA0 EXPONENT T THIS WILL YIELD
3259 * THE NUMBER OF SHIFTS REQUIRED TO DENORMALIZE FPA0. WHEN
3260 * THE EXPONENT OF FPA0 IS = ZERO, THEN THE BINARY POINT
3261 * WILL BE TO THE RIGHT OF THE MANTISSA
3262 ef17 96 54 LDA FP0SGN TEST SIGN OF FPA0 MANTISSA
3263 ef19 2a 05 BPL LBCD7 BRANCH IF POSITIVE
3264 ef1b 03 5b COM FPCARY COMPLEMENT CARRY IN BYTE
3265 ef1d bd ec c4 JSR LBA7B NEGATE MANTISSA OF FPA0
3266 ef20 8e 00 4f LBCD7 LDX #FP0EXP POINT X TO FPA0
3267 ef23 c1 f8 CMPB #-8 EXPONENT DIFFERENCE < -8?
3268 ef25 2e 06 BGT LBCE4 YES
3269 ef27 bd ec f7 JSR LBAAE SHIFT FPA0 RIGHT UNTIL FPA0 EXPONENT = $A0
3270 ef2a 0f 5b CLR FPCARY CLEAR CARRY IN BYTE
3271 ef2c 39 RTS
3272 ef2d 0f 5b LBCE4 CLR FPCARY CLEAR CARRY IN BYTE
3273 ef2f 96 54 LDA FP0SGN * GET SIGN OF FPA0 MANTISSA
3274 ef31 49 ROLA * ROTATE IT INTO THE CARRY FLAG
3275 ef32 06 50 ROR FPA0 ROTATE CARRY (MANTISSA SIGN) INTO BIT 7
3276 * OF LS BYTE OF MANTISSA
3277 ef34 7e ed 03 JMP LBABA DE-NORMALIZE FPA0
3278
3279 * INT
3280 * THE INT STATEMENT WILL "DENORMALIZE" FPA0 - THAT IS IT WILL SHIFT THE BINARY POINT
3281 * TO THE EXTREME RIGHT OF THE MANTISSA TO FORCE ITS EXPONENT TO BE $AO. ONCE
3282 * THIS IS DONE THE MANTISSA OF FPA0 WILL CONTAIN THE FOUR LEAST SIGNIFICANT
3283 * BYTES OF THE INTEGER PORTION OF FPA0. AT THE CONCLUSION OF THE DE-NORMALIZATION
3284 * ONLY THE INTEGER PORTION OF FPA0 WILL REMAIN.
3285 *
3286 ef37 d6 4f INT LDB FP0EXP GET EXPONENT OF FPA0
3287 ef39 c1 a0 CMPB #$A0 LARGEST POSSIBLE INTEGER EXPONENT
3288 ef3b 24 1d BCC LBD11 RETURN IF FPA0 >= 32768
3289 ef3d 8d d2 BSR LBCC8 SHIFT THE BINARY POINT ONE TO THE RIGHT OF THE
3290 * LS BYTE OF THE FPA0 MANTISSA
3291 ef3f d7 63 STB FPSBYT ACCB = 0: ZERO OUT THE SUB BYTE
3292 ef41 96 54 LDA FP0SGN GET MANTISSA SIGN
3293 ef43 d7 54 STB FP0SGN FORCE MANTISSA SIGN TO BE POSITIVE
3294 ef45 80 80 SUBA #$80 SET CARRY IF MANTISSA
3295 ef47 86 a0 LDA #$A0 * GET DENORMALIZED EXPONENT AND
3296 ef49 97 4f STA FP0EXP * SAVE IT IN FPA0 EXPONENT
3297 ef4b 96 53 LDA FPA0+3 = GET LS BYTE OF FPA0 AND
3298 ef4d 97 01 STA CHARAC = SAVE IT IN CHARAC
3299 ef4f 7e ec 61 JMP LBA18 NORMALIZE FPA0
3300
3301 ef52 d7 50 LBD09 STB FPA0 * LOAD MANTISSA OF FPA0 WITH CONTENTS OF ACCB
3302 ef54 d7 51 STB FPA0+1 *
3303 ef56 d7 52 STB FPA0+2 *
3304 ef58 d7 53 STB FPA0+3 *
3305 ef5a 39 LBD11 RTS *
3306
3307 * CONVERT ASCII STRING TO FLOATING POINT
3308 ef5b 9e 74 LBD12 LDX ZERO (X) = 0
3309 ef5d 9f 54 STX FP0SGN * ZERO OUT FPA0 & THE SIGN FLAG (COEFCT)
3310 ef5f 9f 4f STX FP0EXP *
3311 ef61 9f 51 STX FPA0+1 *
3312 ef63 9f 52 STX FPA0+2 *
3313 ef65 9f 47 STX V47 INITIALIZE EXPONENT & EXPONENT SIGN FLAG TO ZERO
3314 ef67 9f 45 STX V45 INITIALIZE RIGHT DECIMAL CTR & DECIMAL PT FLAG TO 0
3315 ef69 25 64 BCS LBD86 IF CARRY SET (NUMERIC CHARACTER), ASSUME ACCA CONTAINS FIRST
3316 * NUMERIC CHAR, SIGN IS POSITIVE AND SKIP THE RAM HOOK
3317 ef6b bd f6 98 JSR XVEC19 CALL EXTENDED BASIC ADD-IN
3318 ef6e 81 2d LBD25 CMPA #'- * CHECK FOR A LEADING MINUS SIGN AND BRANCH
3319 ef70 26 04 BNE LBD2D * IF NO MINUS SIGN
3320 ef72 03 55 COM COEFCT TOGGLE SIGN; 0 = +; FF = -
3321 ef74 20 04 BRA LBD31 INTERPRET THE REST OF THE STRING
3322 ef76 81 2b LBD2D CMPA #'+ * CHECK FOR LEADING PLUS SlGN AND BRANCH
3323 ef78 26 04 BNE LBD35 * IF NOT A PLUS SIGN
3324 ef7a 9d 7c LBD31 JSR GETNCH GET NEXT INPUT CHARACTER FROM BASIC
3325 ef7c 25 51 BCS LBD86 BRANCH IF NUMERIC CHARACTER
3326 ef7e 81 2e LBD35 CMPA #'. DECIMAL POlNT?
3327 ef80 27 28 BEQ LBD61 YES
3328 ef82 81 45 CMPA #'E "E" SHORTHAND FORM (SCIENTIFIC NOTATION)?
3329 ef84 26 28 BNE LBD65 NO
3330 * EVALUATE EXPONENT OF EXPONENTIAL FORMAT
3331 ef86 9d 7c JSR GETNCH GET NEXT INPUT CHARACTER FROM BASIC
3332 ef88 25 64 BCS LBDA5 BRANCH IF NUMERIC
3333 ef8a 81 a7 CMPA #TOK_MINUS MINUS TOKEN?
3334 ef8c 27 0e BEQ LBD53 YES
3335 ef8e 81 2d CMPA #'- ASCII MINUS?
3336 ef90 27 0a BEQ LBD53 YES
3337 ef92 81 a6 CMPA #TOK_PLUS PLUS TOKEN?
3338 ef94 27 08 BEQ LBD55 YES
3339 ef96 81 2b CMPA #'+ ASCII PLUS?
3340 ef98 27 04 BEQ LBD55 YES
3341 ef9a 20 06 BRA LBD59 BRANCH IF NO SIGN FOUND
3342 ef9c 03 48 LBD53 COM V48 SET EXPONENT SIGN FLAG TO NEGATIVE
3343 * STRIP A DECIMAL NUMBER FROM BASIC LINE, CONVERT IT TO BINARY IN V47
3344 ef9e 9d 7c LBD55 JSR GETNCH GET NEXT INPUT CHARACTER FROM BASIC
3345 efa0 25 4c BCS LBDA5 IF NUMERIC CHARACTER, CONVERT TO BINARY
3346 efa2 0d 48 LBD59 TST V48 * CHECK EXPONENT SIGN FLAG
3347 efa4 27 08 BEQ LBD65 * AND BRANCH IF POSITIVE
3348 efa6 00 47 NEG V47 NEGATE VALUE OF EXPONENT
3349 efa8 20 04 BRA LBD65
3350 efaa 03 46 LBD61 COM V46 *TOGGLE DECIMAL PT FLAG AND INTERPRET ANOTHER
3351 efac 26 cc BNE LBD31 *CHARACTER IF <> 0 - TERMINATE INTERPRETATION
3352 * IF SECOND DECIMAL POINT
3353 * ADJUST FPA0 FOR THE DECIMAL EXPONENT IN V47
3354 efae 96 47 LBD65 LDA V47 * GET EXPONENT, SUBTRACT THE NUMBER OF
3355 efb0 90 45 SUBA V45 * PLACES TO THE RIGHT OF DECIMAL POINT
3356 efb2 97 47 STA V47 * AND RESAVE IT.
3357 efb4 27 12 BEQ LBD7F EXIT ROUTINE IF ADJUSTED EXPONENT = ZERO
3358 efb6 2a 09 BPL LBD78 BRANCH IF POSITIVE EXPONENT
3359 efb8 bd ed cb LBD6F JSR LBB82 DIVIDE FPA0 BY 10
3360 efbb 0c 47 INC V47 INCREMENT EXPONENT COUNTER (MULTIPLY BY 10)
3361 efbd 26 f9 BNE LBD6F KEEP MULTIPLYING
3362 efbf 20 07 BRA LBD7F EXIT ROUTINE
3363 efc1 bd ed b3 LBD78 JSR LBB6A MULTIPLY FPA0 BY 10
3364 efc4 0a 47 DEC V47 DECREMENT EXPONENT COUNTER (DIVIDE BY 10)
3365 efc6 26 f9 BNE LBD78 KEEP MULTIPLYING
3366 efc8 96 55 LBD7F LDA COEFCT GET THE SIGN FLAG
3367 efca 2a 8e BPL LBD11 RETURN IF POSITIVE
3368 efcc 7e f1 32 JMP LBEE9 TOGGLE MANTISSA SIGN OF FPA0, IF NEGATIVE
3369 *MULTIPLY FPA0 BY TEN AND ADD ACCA TO THE RESULT
3370 efcf d6 45 LBD86 LDB V45 *GET THE RIGHT DECIMAL COUNTER AND SUBTRACT
3371 efd1 d0 46 SUBB V46 *THE DECIMAL POINT FLAG FROM IT. IF DECIMAL POINT
3372 efd3 d7 45 STB V45 *FLAG=0, NOTHING HAPPENS. IF DECIMAL POINT FLAG IS
3373 * -1, THEN RIGHT DECIMAL COUNTER IS INCREMENTED BY ONE
3374 efd5 34 02 PSHS A SAVE NEW DIGIT ON STACK
3375 efd7 bd ed b3 JSR LBB6A MULTIPLY FPA0 BY 10
3376 efda 35 04 PULS B GET NEW DIGIT BACK
3377 efdc c0 30 SUBB #'0 MASK OFF ASCII
3378 efde 8d 02 BSR LBD99 ADD ACCB TO FPA0
3379 efe0 20 98 BRA LBD31 GET ANOTHER CHARACTER FROM BASIC
3380 efe2 bd ee 78 LBD99 JSR LBC2F PACK FPA0 AND SAVE IT IN FPA3
3381 efe5 bd ee c5 JSR LBC7C CONVERT ACCB TO FP NUMBER IN FPA0
3382 efe8 8e 00 40 LDX #V40 * ADD FPA0 TO
3383 efeb 7e ec 0b JMP LB9C2 * FPA3
3384
3385
3386 efee d6 47 LBDA5 LDB V47
3387 eff0 58 ASLB TIMES 2
3388 eff1 58 ASLB TIMES 4
3389 eff2 db 47 ADDB V47 ADD 1 = TIMES 5
3390 eff4 58 ASLB TIMES 10
3391 eff5 80 30 SUBA #'0 *MASK OFF ASCII FROM ACCA, PUSH
3392 eff7 34 04 PSHS B *RESULT ONTO THE STACK AND
3393 eff9 ab e0 ADDA ,S+ ADD lT TO ACCB
3394 effb 97 47 STA V47 SAVE IN V47
3395 effd 20 9f BRA LBD55 INTERPRET ANOTHER CHARACTER
3396 *
3397 efff 9b 3e bc 1f fd LBDB6 FCB $9B,$3E,$BC,$1F,$FD * 99999999.9
3398 f004 9e 6e 6b 27 fd LBDBB FCB $9E,$6E,$6B,$27,$FD * 999999999
3399 f009 9e 6e 6b 28 00 LBDC0 FCB $9E,$6E,$6B,$28,$00 * 1E + 09
3400 *
3401 f00e 8e de a4 LBDC5 LDX #LABE8-1 POINT X TO " IN " MESSAGE
3402 f011 8d 0c BSR LBDD6 COPY A STRING FROM (X) TO CONSOLE OUT
3403 f013 dc 68 LDD CURLIN GET CURRENT BASIC LINE NUMBER TO ACCD
3404 * CONVERT VALUE IN ACCD INTO A DECIMAL NUMBER
3405 * AND PRINT IT TO CONSOLE OUT
3406 f015 dd 50 LBDCC STD FPA0 SAVE ACCD IN TOP HALF OF FPA0
3407 f017 c6 90 LDB #$90 REQ’D EXPONENT IF TOP HALF OF ACCD = INTEGER
3408 f019 43 COMA SET CARRY FLAG - FORCE POSITIVE MANTISSA
3409 f01a bd ee cf JSR LBC86 ZERO BOTTOM HALF AND SIGN OF FPA0, THEN
3410 * SAVE EXPONENT AND NORMALIZE IT
3411 f01d 8d 03 BSR LBDD9 CONVERT FP NUMBER TO ASCII STRING
3412 f01f 7e eb e5 LBDD6 JMP LB99C COPY A STRING FROM (X) TO CONSOLE OUT
3413
3414 * CONVERT FP NUMBER TO ASCII STRING
3415 f022 ce 01 f1 LBDD9 LDU #STRBUF+3 POINT U TO BUFFER WHICH WILL NOT CAUSE
3416 * THE STRING TO BE STORED IN STRING SPACE
3417 f025 86 20 LBDDC LDA #SPACE SPACE = DEFAULT SIGN FOR POSITIVE #
3418 f027 d6 54 LDB FP0SGN GET SIGN OF FPA0
3419 f029 2a 02 BPL LBDE4 BRANCH IF POSITIVE
3420 f02b 86 2d LDA #'- ASCII MINUS SIGN
3421 f02d a7 c0 LBDE4 STA ,U+ STORE SIGN OF NUMBER
3422 f02f df 64 STU COEFPT SAVE BUFFER POINTER
3423 f031 97 54 STA FP0SGN SAVE SIGN (IN ASCII)
3424 f033 86 30 LDA #'0 ASCII ZERO IF EXPONENT = 0
3425 f035 d6 4f LDB FP0EXP GET FPA0 EXPONENT
3426 f037 10 27 00 c6 LBEQ LBEB8 BRANCH IF FPA0 = 0
3427 f03b 4f CLRA BASE 10 EXPONENT=0 FOR FP NUMBER > 1
3428 f03c c1 80 CMPB #$80 CHECK EXPONENT
3429 f03e 22 08 BHI LBDFF BRANCH IF FP NUMBER > 1
3430 * IF FPA0 < 1.0, MULTIPLY IT BY 1E+09 TO SPEED UP THE CONVERSION PROCESS
3431 f040 8e f0 09 LDX #LBDC0 POINT X TO FP 1E+09
3432 f043 bd ed 13 JSR LBACA MULTIPLY FPA0 BY (X)
3433 f046 86 f7 LDA #-9 BASE 10 EXPONENT = -9
3434 f048 97 45 LBDFF STA V45 BASE 10 EXPONENT
3435 * PSEUDO - NORMALIZE THE FP NUMBER TO A VALUE IN THE RANGE
3436 * OF 999,999,999 RO 99,999,999.9 - THIS IS THE LARGEST
3437 * NUMBER RANGE IN WHICH ALL OF THE DIGITS ARE
3438 * SIGNIFICANT WHICH CAN BE DISPLAYED WITHOUT USING
3439 * SCIENTIFIC NOTATION
3440 f04a 8e f0 04 LBE01 LDX #LBDBB POINT X TO FP 999,999,999
3441 f04d bd ee e9 JSR LBCA0 COMPARE FPA0 TO 999,999,999
3442 f050 2e 0f BGT LBE18 BRANCH IF > 999,999,999
3443 f052 8e ef ff LBE09 LDX #LBDB6 POINT X TO FP 99,999,999.9
3444 f055 bd ee e9 JSR LBCA0 COMPARE FPA0 TO 99,999,999.9
3445 f058 2e 0e BGT LBE1F BRANCH IF > 99,999,999.9 (IN RANGE)
3446 f05a bd ed b3 JSR LBB6A MULTIPLY FPA0 BY 10
3447 f05d 0a 45 DEC V45 SUBTRACT ONE FROM DECIMAL OFFSET
3448 f05f 20 f1 BRA LBE09 PSEUDO - NORMALIZE SOME MORE
3449 f061 bd ed cb LBE18 JSR LBB82 DIVIDE FPA0 BY 10
3450 f064 0c 45 INC V45 ADD ONE TO BASE 10 EXPONENT
3451 f066 20 e2 BRA LBE01 PSEUDO - NORMALIZE SOME MORE
3452 f068 bd eb fd LBE1F JSR LB9B4 ADD .5 TO FPA0 (ROUND OFF)
3453 f06b bd ef 11 JSR LBCC8 CONVERT FPA0 TO AN INTEGER
3454 f06e c6 01 LDB #1 DEFAULT DECIMAL POINT FLAG (FORCE IMMED DECIMAL PT)
3455 f070 96 45 LDA V45 * GET BASE 10 EXPONENT AND ADD TEN TO IT
3456 f072 8b 0a ADDA #9+1 * (NUMBER ‘NORMALIZED’ TO 9 PLACES & DECIMAL PT)
3457 f074 2b 09 BMI LBE36 BRANCH IF NUMBER < 1.0
3458 f076 81 0b CMPA #9+2 NINE PLACES MAY BE DISPLAYED WITHOUT
3459 * USING SCIENTIFIC NOTATION
3460 f078 24 05 BCC LBE36 BRANCH IF SCIENTIFIC NOTATION REQUIRED
3461 f07a 4a DECA * SUBTRACT 1 FROM MODIFIED BASE 10 EXPONENT CTR
3462 f07b 1f 89 TFR A,B * AND SAVE IT IN ACCB (DECiMAL POINT FLAG)
3463 f07d 86 02 LDA #2 FORCE EXPONENT = 0 - DON'T USE SCIENTIFIC NOTATION
3464 f07f 4a LBE36 DECA * SUBTRACT TWO (WITHOUT AFFECTING CARRY)
3465 f080 4a DECA * FROM BASE 10 EXPONENT
3466 f081 97 47 STA V47 SAVE EXPONENT - ZERO EXPONENT = DO NOT DISPLAY
3467 * IN SCIENTIFIC NOTATION
3468 f083 d7 45 STB V45 DECIMAL POINT FLAG - NUMBER OF PLACES TO
3469 * LEFT OF DECIMAL POINT
3470 f085 2e 0d BGT LBE4B BRANCH IF >= 1
3471 f087 de 64 LDU COEFPT POINT U TO THE STRING BUFFER
3472 f089 86 2e LDA #'. * STORE A PERIOD
3473 f08b a7 c0 STA ,U+ * IN THE BUFFER
3474 f08d 5d TSTB CHECK DECIMAL POINT FLAG
3475 f08e 27 04 BEQ LBE4B BRANCH IF NOTHING TO LEFT OF DECIMAL POINT
3476 f090 86 30 LDA #'0 * STORE A ZERO
3477 f092 a7 c0 STA ,U+ * IN THE BUFFER
3478
3479 * CONVERT FPA0 INTO A STRING OF ASCII DIGITS
3480 f094 8e f1 0e LBE4B LDX #LBEC5 POINT X TO FP POWER OF 10 MANTISSA
3481 f097 c6 80 LDB #0+$80 INITIALIZE DIGIT COUNTER TO 0+$80
3482 * BIT 7 SET IS USED TO INDICATE THAT THE POWER OF 10 MANTISSA
3483 * IS NEGATIVE. WHEN YOU 'ADD' A NEGATIVE MANTISSA, IT IS
3484 * THE SAME AS SUBTRACTING A POSITIVE ONE AND BIT 7 OF ACCB IS HOW
3485 * THE ROUTINE KNOWS THAT A 'SUBTRACTION' IS OCCURING.
3486 f099 96 53 LBE50 LDA FPA0+3 * ADD MANTISSA LS
3487 f09b ab 03 ADDA 3,X * BYTE OF FPA0
3488 f09d 97 53 STA FPA0+3 * AND (X)
3489 f09f 96 52 LDA FPA0+2 = ADD MANTISSA
3490 f0a1 a9 02 ADCA 2,X = NUMBER 3 BYTE OF
3491 f0a3 97 52 STA FPA0+2 = FPA0 AND (X)
3492 f0a5 96 51 LDA FPA0+1 * ADD MANTISSA
3493 f0a7 a9 01 ADCA 1,X * NUMBER 2 BYTE OF
3494 f0a9 97 51 STA FPA0+1 * FPA0 AND (X)
3495 f0ab 96 50 LDA FPA0 = ADD MANTISSA
3496 f0ad a9 84 ADCA ,X = MS BYTE OF
3497 f0af 97 50 STA FPA0 = FPA0 AND (X)
3498 f0b1 5c INCB ADD ONE TO DIGIT COUNTER
3499 f0b2 56 RORB ROTATE CARRY INTO BIT 7
3500 f0b3 59 ROLB *SET OVERFLOW FLAG AND BRANCH IF CARRY = 1 AND
3501 f0b4 28 e3 BVC LBE50 *POSITIVE MANTISSA OR CARRY = 0 AND NEG MANTISSA
3502 f0b6 24 03 BCC LBE72 BRANCH IF NEGATIVE MANTISSA
3503 f0b8 c0 0b SUBB #10+1 * TAKE THE 9’S COMPLEMENT IF
3504 f0ba 50 NEGB * ADDING MANTISSA
3505 f0bb cb 2f LBE72 ADDB #'0-1 ADD ASCII OFFSET TO DIGIT
3506 f0bd 30 04 LEAX 4,X MOVE TO NEXT POWER OF 10 MANTISSA
3507 f0bf 1f 98 TFR B,A SAVE DIGIT IN ACCA
3508 f0c1 84 7f ANDA #$7F MASK OFF BIT 7 (ADD/SUBTRACT FLAG)
3509 f0c3 a7 c0 STA ,U+ STORE DIGIT IN STRING BUFFER
3510 f0c5 0a 45 DEC V45 DECREMENT DECIMAL POINT FLAG
3511 f0c7 26 04 BNE LBE84 BRANCH IF NOT TIME FOR DECIMAL POINT
3512 f0c9 86 2e LDA #'. * STORE DECIMAL POINT IN
3513 f0cb a7 c0 STA ,U+ * STRING BUFFER
3514 f0cd 53 LBE84 COMB TOGGLE BIT 7 (ADD/SUBTRACT FLAG)
3515 f0ce c4 80 ANDB #$80 MASK OFF ALL BUT ADD/SUBTRACT FLAG
3516 f0d0 8c f1 32 CMPX #LBEC5+36 COMPARE X TO END OF MANTISSA TABLE
3517 f0d3 26 c4 BNE LBE50 BRANCH IF NOT AT END OF TABLE
3518 * BLANK TRAILING ZEROS AND STORE EXPONENT IF ANY
3519 f0d5 a6 c2 LBE8C LDA ,-U GET THE LAST CHARACTER; MOVE POINTER BACK
3520 f0d7 81 30 CMPA #'0 WAS IT A ZERO?
3521 f0d9 27 fa BEQ LBE8C IGNORE TRAILING ZEROS IF SO
3522 f0db 81 2e CMPA #'. CHECK FOR DECIMAL POINT
3523 f0dd 26 02 BNE LBE98 BRANCH IF NOT DECIMAL POINT
3524 f0df 33 5f LEAU -1,U STEP OVER THE DECIMAL POINT
3525 f0e1 86 2b LBE98 LDA #'+ ASCII PLUS SIGN
3526 f0e3 d6 47 LDB V47 GET SCIENTIFIC NOTATION EXPONENT
3527 f0e5 27 1c BEQ LBEBA BRANCH IF NOT SCIENTIFIC NOTATION
3528 f0e7 2a 03 BPL LBEA3 BRANCH IF POSITIVE EXPONENT
3529 f0e9 86 2d LDA #'- ASCII MINUS SIGN
3530 f0eb 50 NEGB NEGATE EXPONENT IF NEGATIVE
3531 f0ec a7 42 LBEA3 STA 2,U STORE EXPONENT SIGN IN STRING
3532 f0ee 86 45 LDA #'E * GET ASCII ‘E’ (SCIENTIFIC NOTATION
3533 f0f0 a7 41 STA 1,U * FLAG) AND SAVE IT IN THE STRING
3534 f0f2 86 2f LDA #'0-1 INITIALIZE ACCA TO ASCII ZERO
3535
3536
3537 f0f4 4c LBEAB INCA ADD ONE TO 10’S DIGIT OF EXPONENT
3538 f0f5 c0 0a SUBB #10 SUBTRACT 10 FROM ACCB
3539 f0f7 24 fb BCC LBEAB ADD 1 TO 10’S DIGIT IF NO CARRY
3540 f0f9 cb 3a ADDB #'9+1 CONVERT UNITS DIGIT TO ASCII
3541 f0fb ed 43 STD 3,U SAVE EXPONENT IN STRING
3542 f0fd 6f 45 CLR 5,U CLEAR LAST BYTE (TERMINATOR)
3543 f0ff 20 04 BRA LBEBC GO RESET POINTER
3544 f101 a7 c4 LBEB8 STA ,U STORE LAST CHARACTER
3545 f103 6f 41 LBEBA CLR 1,U CLEAR LAST BYTE (TERMINATOR - REQUIRED BY
3546 * PRINT SUBROUTINES)
3547 f105 8e 01 f1 LBEBC LDX #STRBUF+3 RESET POINTER TO START OF BUFFER
3548 f108 39 RTS
3549 *
3550 f109 80 00 00 00 00 LBEC0 FCB $80,$00,$00,$00,$00 FLOATING POINT .5
3551 *
3552 *** TABLE OF UNNORMALIZED POWERS OF 10
3553 f10e fa 0a 1f 00 LBEC5 FCB $FA,$0A,$1F,$00 -100000000
3554 f112 00 98 96 80 LBEC9 FCB $00,$98,$96,$80 10000000
3555 f116 ff f0 bd c0 LBECD FCB $FF,$F0,$BD,$C0 -1000000
3556 f11a 00 01 86 a0 LBED1 FCB $00,$01,$86,$A0 100000
3557 f11e ff ff d8 f0 LBED5 FCB $FF,$FF,$D8,$F0 -10000
3558 f122 00 00 03 e8 LBED9 FCB $00,$00,$03,$E8 1000
3559 f126 ff ff ff 9c LBEDD FCB $FF,$FF,$FF,$9C -100
3560 f12a 00 00 00 0a LBEE1 FCB $00,$00,$00,$0A 10
3561 f12e ff ff ff ff LBEE5 FCB $FF,$FF,$FF,$FF -1
3562 *
3563 *
3564 f132 96 4f LBEE9 LDA FP0EXP GET EXPONENT OF FPA0
3565 f134 27 02 BEQ LBEEF BRANCH IF FPA0 = 0
3566 f136 03 54 COM FP0SGN TOGGLE MANTISSA SIGN OF FPA0
3567 f138 39 LBEEF RTS
3568 * EXPAND A POLYNOMIAL OF THE FORM
3569 * AQ+BQ**3+CQ**5+DQ**7.... WHERE Q = FPA0
3570 * AND THE X REGISTER POINTS TO A TABLE OF
3571 * COEFFICIENTS A,B,C,D....
3572 f139 9f 64 LBEF0 STX COEFPT SAVE COEFFICIENT TABLE POINTER
3573 f13b bd ee 78 JSR LBC2F MOVE FPA0 TO FPA3
3574 f13e 8d 05 BSR LBEFC MULTIPLY FPA3 BY FPA0
3575 f140 8d 08 BSR LBF01 EXPAND POLYNOMIAL
3576 f142 8e 00 40 LDX #V40 POINT X TO FPA3
3577 f145 7e ed 13 LBEFC JMP LBACA MULTIPLY (X) BY FPA0
3578
3579 * CALCULATE THE VALUE OF AN EXPANDED POLYNOMIAL
3580 * EXPRESSION. ENTER WITH (X) POINTING TO A TABLE
3581 * OF COEFFICIENTS, THE FIRST BYTE OF WHICH IS THE
3582 * NUMBER OF (COEFFICIENTS-1) FOLLOWED BY THAT NUMBER
3583 * OF PACKED FLOATING POINT NUMBERS. THE
3584 * POLYNOMIAL IS EVALUATED AS FOLLOWS: VALUE =
3585 * (((FPA0*Y0+Y1)*FPA0+Y2)*FPA0…YN)
3586 f148 9f 64 LBEFF STX COEFPT SAVE COEFFICIENT TABLE POINTER
3587 f14a bd ee 73 LBF01 JSR LBC2A MOVE FPA0 TO FPA4
3588 f14d 9e 64 LDX COEFPT GET THE COEFFICIENT POINTER
3589 f14f e6 80 LDB ,X+ GET THE TOP OF COEFFICIENT TABLE TO
3590 f151 d7 55 STB COEFCT * USE AND STORE IT IN TEMPORARY COUNTER
3591 f153 9f 64 STX COEFPT SAVE NEW COEFFICIENT POINTER
3592 f155 8d ee LBF0C BSR LBEFC MULTIPLY (X) BY FPA0
3593 f157 9e 64 LDX COEFPT *GET COEFFICIENT POINTER
3594 f159 30 05 LEAX 5,X *MOVE TO NEXT FP NUMBER
3595 f15b 9f 64 STX COEFPT *SAVE NEW COEFFICIENT POINTER
3596 f15d bd ec 0b JSR LB9C2 ADD (X) AND FPA0
3597 f160 8e 00 45 LDX #V45 POINT (X) TO FPA4
3598 f163 0a 55 DEC COEFCT DECREMENT TEMP COUNTER
3599 f165 26 ee BNE LBF0C BRANCH IF MORE COEFFICIENTS LEFT
3600 f167 39 RTS
3601
3602 * RND
3603 f168 bd ee b6 RND JSR LBC6D TEST FPA0
3604 f16b 2b 1f BMI LBF45 BRANCH IF FPA0 = NEGATIVE
3605 f16d 27 15 BEQ LBF3B BRANCH IF FPA0 = 0
3606 f16f 8d 10 BSR LBF38 CONVERT FPA0 TO AN INTEGER
3607 f171 bd ee 78 JSR LBC2F PACK FPA0 TO FPA3
3608 f174 8d 0e BSR LBF3B GET A RANDOM NUMBER: FPA0 < 1.0
3609 f176 8e 00 40 LDX #V40 POINT (X) TO FPA3
3610 f179 8d ca BSR LBEFC MULTIPLY (X) BY FPA0
3611 f17b 8e ed 0e LDX #LBAC5 POINT (X) TO FP VALUE OF 1.0
3612 f17e bd ec 0b JSR LB9C2 ADD 1.0 TO FPA0
3613 f181 7e ef 37 LBF38 JMP INT CONVERT FPA0 TO AN INTEGER
3614 * CALCULATE A RANDOM NUMBER IN THE RANGE 0.0 < X <= 1.0
3615 f184 9e b1 LBF3B LDX RVSEED+1 * MOVE VARIABLE
3616 f186 9f 50 STX FPA0 * RANDOM NUMBER
3617 f188 9e b3 LDX RVSEED+3 * SEED TO
3618 f18a 9f 52 STX FPA0+2 * FPA0
3619 f18c be f1 b9 LBF45 LDX RSEED = MOVE FIXED
3620 f18f 9f 5d STX FPA1 = RANDOM NUMBER
3621 f191 be f1 bb LDX RSEED+2 = SEED TO
3622 f194 9f 5f STX FPA1+2 = MANTISSA OF FPA0
3623 f196 bd ed 19 JSR LBAD0 MULTIPLY FPA0 X FPA1
3624 f199 dc 8a LDD VAD GET THE TWO LOWEST ORDER PRODUCT BYTES
3625 f19b c3 65 8b ADDD #$658B ADD A CONSTANT
3626 f19e dd b3 STD RVSEED+3 SAVE NEW LOW ORDER VARIABLE RANDOM # SEED
3627 f1a0 dd 52 STD FPA0+2 SAVE NEW LOW ORDER BYTES OF FPA0 MANTISSA
3628 f1a2 dc 88 LDD VAB GET 2 MORE LOW ORDER PRODUCT BYTES
3629 f1a4 c9 b0 ADCB #$B0 ADD A CONSTANT
3630 f1a6 89 05 ADCA #5 ADD A CONSTANT
3631 f1a8 dd b1 STD RVSEED+1 SAVE NEW HIGH ORDER VARIABLE RANDOM # SEED
3632 f1aa dd 50 STD FPA0 SAVE NEW HIGH ORDER FPA0 MANTISSA
3633 f1ac 0f 54 CLR FP0SGN FORCE FPA0 MANTISSA = POSITIVE
3634 f1ae 86 80 LDA #$80 * SET FPA0 BIASED EXPONENT
3635 f1b0 97 4f STA FP0EXP * TO 0 1 < FPA0 < 0
3636 f1b2 96 15 LDA FPA2+2 GET A BYTE FROM FPA2 (MORE RANDOMNESS)
3637 f1b4 97 63 STA FPSBYT SAVE AS SUB BYTE
3638 f1b6 7e ec 65 JMP LBA1C NORMALIZE FPA0
3639 *
3640 f1b9 40 e6 RSEED FDB $40E6 *CONSTANT RANDOM NUMBER GENERATOR SEED
3641 f1bb 4d ab FDB $4DAB *
3642
3643 * SIN
3644 * THE SIN FUNCTION REQUIRES AN ARGUMENT IN RADIANS AND WILL REPEAT ITSELF EVERY
3645 * 2*PI RADIANS. THE ARGUMENT IS DIVIDED BY 2*PI AND ONLY THE FRACTIONAL PART IS
3646 * RETAINED. SINCE THE ARGUMENT WAS DIVIDED BY 2*P1, THE COEFFICIENTS MUST BE
3647 * MULTIPLIED BY THE APPROPRIATE POWER OF 2*PI.
3648
3649 * SIN IS EVALUATED USING THE TRIGONOMETRIC IDENTITIES BELOW:
3650 * SIN(X)=SIN(PI-X) & -SIN(PI/2-X)=SIN((3*PI)/2+X)
3651 f1bd bd ee a8 SIN JSR LBC5F COPY FPA0 TO FPA1
3652 f1c0 8e f2 02 LDX #LBFBD POINT (X) TO 2*PI
3653 f1c3 d6 61 LDB FP1SGN *GET MANTISSA SIGN OF FPA1
3654 f1c5 bd ed d2 JSR LBB89 *AND DIVIDE FPA0 BY 2*PI
3655 f1c8 bd ee a8 JSR LBC5F COPY FPA0 TO FPA1
3656 f1cb 8d b4 BSR LBF38 CONVERT FPA0 TO AN INTEGER
3657 f1cd 0f 62 CLR RESSGN SET RESULT SIGN = POSITIVE
3658 f1cf 96 5c LDA FP1EXP *GET EXPONENT OF FPA1
3659 f1d1 d6 4f LDB FP0EXP *GET EXPONENT OF FPA0
3660 f1d3 bd ec 05 JSR LB9BC *SUBTRACT FPA0 FROM FPA1
3661 * NOW FPA0 CONTAINS ONLY THE FRACTIONAL PART OF ARGUMENT/2*PI
3662 f1d6 8e f2 07 LDX #LBFC2 POINT X TO FP (.25)
3663 f1d9 bd ec 02 JSR LB9B9 SUBTRACT FPA0 FROM .25 (PI/2)
3664 f1dc 96 54 LDA FP0SGN GET MANTISSA SIGN OF FPA0
3665 f1de 34 02 PSHS A SAVE IT ON STACK
3666 f1e0 2a 09 BPL LBFA6 BRANCH IF MANTISSA POSITIVE
3667 f1e2 bd eb fd JSR LB9B4 ADD .5 (PI) TO FPA0
3668 f1e5 96 54 LDA FP0SGN GET SIGN OF FPA0
3669 f1e7 2b 05 BMI LBFA9 BRANCH IF NEGATIVE
3670 f1e9 03 0a COM RELFLG COM IF +(3*PI)/2 >= ARGUMENT >+ PI/2 (QUADRANT FLAG)
3671 f1eb bd f1 32 LBFA6 JSR LBEE9 TOGGLE MANTISSA SIGN OF FPA0
3672 f1ee 8e f2 07 LBFA9 LDX #LBFC2 POINT X TO FP (.25)
3673 f1f1 bd ec 0b JSR LB9C2 ADD .25 (PI/2) TO FPA0
3674 f1f4 35 02 PULS A GET OLD MANTISSA SIGN
3675 f1f6 4d TSTA * BRANCH IF OLD
3676 f1f7 2a 03 BPL LBFB7 * SIGN WAS POSITIVE
3677 f1f9 bd f1 32 JSR LBEE9 TOGGLE MANTISSA SIGN
3678 f1fc 8e f2 0c LBFB7 LDX #LBFC7 POINT X TO TABLE OF COEFFICIENTS
3679 f1ff 7e f1 39 JMP LBEF0 GO CALCULATE POLYNOMIAL VALUE
3680
3681 f202 83 49 0f da a2 LBFBD FCB $83,$49,$0F,$DA,$A2 6.28318531 (2*PI)
3682 f207 7f 00 00 00 00 LBFC2 FCB $7F,$00,$00,$00,$00 .25
3683
3684
3685 f20c 05 LBFC7 FCB 6-1 SIX COEFFICIENTS
3686 f20d 84 e6 1a 2d 1b LBFC8 FCB $84,$E6,$1A,$2D,$1B * -((2*PI)**11)/11!
3687 f212 86 28 07 fb f8 LBFCD FCB $86,$28,$07,$FB,$F8 * ((2*PI)**9)/9!
3688 f217 87 99 68 89 01 LBFD2 FCB $87,$99,$68,$89,$01 * -((2*PI)**7)/7!
3689 f21c 87 23 35 df e1 LBFD7 FCB $87,$23,$35,$DF,$E1 * ((2*PI)**5)/5!
3690 f221 86 a5 5d e7 28 LBFDC FCB $86,$A5,$5D,$E7,$28 * -((2*PI)**3)/3!
3691 f226 83 49 0f da a2 LBFE1 FCB $83,$49,$0F,$DA,$A2 *
3692
3693 f22b a1 54 46 8f 13 FCB $A1,$54,$46,$8F,$13 UNUSED GARBAGE BYTES
3694 f230 8f 52 43 89 cd FCB $8F,$52,$43,$89,$CD UNUSED GARBAGE BYTES
3695 * EXTENDED BASIC
3696
3697 * COS
3698 * THE VALUE OF COS(X) IS DETERMINED BY THE TRIG IDENTITY COS(X)=SIN((PI/2)+X)
3699 f235 8e f2 68 COS LDX #L83AB POINT X TO FP CONSTANT (P1/2)
3700 f238 bd ec 0b JSR LB9C2 ADD FPA0 TO (X)
3701 f23b 7e f1 bd L837E JMP SIN JUMP TO SIN ROUTINE
3702
3703 * TAN
3704 * THE VALUE OF TAN(X) IS DETERMINED BY THE TRIG IDENTITY TAN(X)=SIN(X)/COS(X)
3705 f23e bd ee 78 TAN JSR LBC2F PACK FPA0 AND MOVE IT TO FPA3
3706 f241 0f 0a CLR RELFLG RESET QUADRANT FLAG
3707 f243 8d f6 BSR L837E CALCULATE SIN OF ARGUMENT
3708 f245 8e 00 4a LDX #V4A POINT X TO FPA5
3709 f248 bd ee 7e JSR LBC35 PACK FPA0 AND MOVE IT TO FPA5
3710 f24b 8e 00 40 LDX #V40 POINT X TO FPA3
3711 f24e bd ee 5d JSR LBC14 MOVE FPA3 TO FPA0
3712 f251 0f 54 CLR FP0SGN FORCE FPA0 MANTISSA TO BE POSITIVE
3713 f253 96 0a LDA RELFLG GET THE QUADRANT FLAG - COS NEGATIVE IN QUADS 2,3
3714 f255 8d 0c BSR L83A6 CALCULATE VALUE OF COS(FPA0)
3715 f257 0d 4f TST FP0EXP CHECK EXPONENT OF FPA0
3716 f259 10 27 fa 7e LBEQ LBA92 ‘OV’ ERROR IF COS(X)=0
3717 f25d 8e 00 4a LDX #V4A POINT X TO FPA5
3718 f260 7e ed d8 L83A3 JMP LBB8F DIVIDE (X) BY FPA0 - SIN(X)/COS(X)
3719 f263 34 02 L83A6 PSHS A SAVE SIGN FLAG ON STACK
3720 f265 7e f1 eb JMP LBFA6 EXPAND POLYNOMIAL
3721
3722 f268 81 49 0f da a2 L83AB FCB $81,$49,$0F,$DA,$A2 1.57079633 (PI/2)
3723
3724 * ATN
3725 * A 12 TERM TAYLOR SERIES IS USED TO EVALUATE THE
3726 * ARCTAN EXPRESSION. TWO DIFFERENT FORMULI ARE USED
3727 * TO EVALUATE THE EXPRESSION DEPENDING UPON
3728 * WHETHER OR NOT THE ARGUMENT SQUARED IS > OR < 1.0
3729
3730 * IF X**2<1 THEN ATN=X-(X**3)/3+(X**5)/5-(X**7)/7. . .
3731 * IF X**2>=1 THEN ATN=PI/2-(1/X-1/((X**3)*3)+(1/((X**5)*5)-. . .)
3732
3733 f26d 96 54 ATN LDA FP0SGN * GET THE SIGN OF THE MANTISSA AND
3734 f26f 34 02 PSHS A * SAVE IT ON THE STACK
3735 f271 2a 02 BPL L83B8 BRANCH IF POSITIVE MANTISSA
3736 f273 8d 24 BSR L83DC CHANGE SIGN OF FPA0
3737 f275 96 4f L83B8 LDA FP0EXP * GET EXPONENT OF FPA0 AND
3738 f277 34 02 PSHS A * SAVE IT ON THE STACK
3739 f279 81 81 CMPA #$81 IS FPAO < 1.0?
3740 f27b 25 05 BLO L83C5 YES
3741 f27d 8e ed 0e LDX #LBAC5 POINT X TO FP CONSTANT 1.0
3742 f280 8d de BSR L83A3 GET RECIPROCAL OF FPA0
3743 f282 8e f2 9d L83C5 LDX #L83E0 POINT (X) TO TAYLOR SERIES COEFFICIENTS
3744 f285 bd f1 39 JSR LBEF0 EXPAND POLYNOMIAL
3745 f288 35 02 PULS A GET EXPONENT OF ARGUMENT
3746 f28a 81 81 CMPA #$81 WAS ARGUMENT < 1.0?
3747 f28c 25 06 BLO L83D7 YES
3748 f28e 8e f2 68 LDX #L83AB POINT (X) TO FP NUMBER (PI/2)
3749 f291 bd ec 02 JSR LB9B9 SUBTRACT FPA0 FROM (PI/2)
3750 f294 35 02 L83D7 PULS A * GET SIGN OF INITIAL ARGUMENT MANTISSA
3751 f296 4d TSTA * AND SET FLAGS ACCORDING TO IT
3752 f297 2a 03 BPL L83DF RETURN IF ARGUMENT WAS POSITIVE
3753 f299 7e f1 32 L83DC JMP LBEE9 CHANGE MANTISSA SIGN OF FPA0
3754 f29c 39 L83DF RTS
3755 *
3756 * TCHEBYSHEV MODIFIED TAYLOR SERIES COEFFICIENTS FOR ARCTANGENT
3757 f29d 0b L83E0 FCB $0B TWELVE COEFFICIENTS
3758 f29e 76 b3 83 bd d3 L83E1 FCB $76,$B3,$83,$BD,$D3 -6.84793912E-04 1/23
3759 f2a3 79 1e f4 a6 f5 L83E6 FCB $79,$1E,$F4,$A6,$F5 +4.85094216E-03 1/21
3760 f2a8 7b 83 fc b0 10 L83EB FCB $7B,$83,$FC,$B0,$10 -0.0161117018
3761 f2ad 7c 0c 1f 67 ca L83F0 FCB $7C,$0C,$1F,$67,$CA 0.0342096381
3762 f2b2 7c de 53 cb c1 L83F5 FCB $7C,$DE,$53,$CB,$C1 -0.0542791328
3763 f2b7 7d 14 64 70 4c L83FA FCB $7D,$14,$64,$70,$4C 0.0724571965
3764 f2bc 7d b7 ea 51 7a L83FF FCB $7D,$B7,$EA,$51,$7A -0.0898023954
3765 f2c1 7d 63 30 88 7e L8404 FCB $7D,$63,$30,$88,$7E 0.110932413
3766 f2c6 7e 92 44 99 3a L8409 FCB $7E,$92,$44,$99,$3A -0.142839808
3767 f2cb 7e 4c cc 91 c7 L840E FCB $7E,$4C,$CC,$91,$C7 0.199999121
3768 f2d0 7f aa aa aa 13 L8413 FCB $7F,$AA,$AA,$AA,$13 -0.333333316
3769 f2d5 81 00 00 00 00 L8418 FCB $81,$00,$00,$00,$00 1
3770 *
3771 *** TCHEBYSHEV MODIFIED TAYLOR SERIES COEFFICIENTS FOR LN(X)
3772 *
3773 f2da 03 L841D FCB 3 FOUR COEFFICIENTS
3774 f2db 7f 5e 56 cb 79 L841E FCB $7F,$5E,$56,$CB,$79 0.434255942
3775 f2e0 80 13 9b 0b 64 L8423 FCB $80,$13,$9B,$0B,$64 0.576584541
3776 f2e5 80 76 38 93 16 L8428 FCB $80,$76,$38,$93,$16 0.961800759
3777 f2ea 82 38 aa 3b 20 L842D FCB $82,$38,$AA,$3B,$20 2.88539007
3778
3779 f2ef 80 35 04 f3 34 L8432 FCB $80,$35,$04,$F3,$34 1/SQR(2)
3780
3781 f2f4 81 35 04 f3 34 L8437 FCB $81,$35,$04,$F3,$34 SQR(2)
3782
3783 f2f9 80 80 00 00 00 L843C FCB $80,$80,$00,$00,$00 -0.5
3784
3785 f2fe 80 31 72 17 f8 L8441 FCB $80,$31,$72,$17,$F8 LN(2)
3786 *
3787 * LOG - NATURAL LOGARITHM (LN)
3788
3789 * THE NATURAL OR NAPERIAN LOGARITHM IS CALCULATED USING
3790 * MATHEMATICAL IDENTITIES. FPA0 IS OF THE FORM FPA0=A*(2**B) (SCIENTIFIC
3791 * NOTATION). THEREFORE, THE LOG ROUTINE DETERMINES THE VALUE OF
3792 * LN(A*(2**B)). A SERIES OF MATHEMATICAL IDENTITIES WILL EXPAND THIS
3793 * TERM: LN(A*(2**B))=(-1/2+(1/LN(2))*(LN(A*SQR(2)))+B)*LN(2). ALL OF
3794 * THE TERMS OF THE LATTER EXPRESSION ARE CONSTANTS EXCEPT FOR THE
3795 * LN(A*SQR(2)) TERM WHICH IS EVALUATED USING THE TAYLOR SERIES EXPANSION
3796 f303 bd ee b6 LOG JSR LBC6D CHECK STATUS OF FPA0
3797 f306 10 2f f3 c4 LBLE LB44A ‘FC’ ERROR IF NEGATIVE OR ZERO
3798 f30a 8e f2 ef LDX #L8432 POINT (X) TO FP NUMBER (1/SQR(2))
3799 f30d 96 4f LDA FP0EXP *GET EXPONENT OF ARGUMENT
3800 f30f 80 80 SUBA #$80 *SUBTRACT OFF THE BIAS AND
3801 f311 34 02 PSHS A *SAVE IT ON THE STACK
3802 f313 86 80 LDA #$80
3803 f315 97 4f STA FP0EXP
3804 f317 bd ec 0b JSR LB9C2 ADD FPA0 TO (X)
3805 f31a 8e f2 f4 LDX #L8437 POINT X TO SQR(2)
3806 f31d bd ed d8 JSR LBB8F DIVIDE SQR(2) BY FPA0
3807 f320 8e ed 0e LDX #LBAC5 POINT X TO FP VALUE OF 1.00
3808 f323 bd ec 02 JSR LB9B9 SUBTRACT FPA0 FROM (X)
3809 * NOW FPA0 = (1-SQR(2)*X)/(1+SQR(2)*X) WHERE X IS ARGUMENT
3810 f326 8e f2 da LDX #L841D POINT X TO TABLE OF COEFFICIENTS
3811 f329 bd f1 39 JSR LBEF0 EXPAND POLYNOMIAL
3812 f32c 8e f2 f9 LDX #L843C POINT X TO FP VALUE OF (-.5)
3813 f32f bd ec 0b JSR LB9C2 ADD FPA0 TO X
3814 f332 35 04 PULS B GET EXPONENT OF ARGUMENT BACK (WITHOUT BIAS)
3815 f334 bd ef e2 JSR LBD99 ADD ACCB TO FPA0
3816 f337 8e f2 fe LDX #L8441 POINT X TO LN(2)
3817 f33a 7e ed 13 JMP LBACA MULTIPLY FPA0 * LN(2)
3818
3819 * SQR
3820 f33d bd ee a8 SQR JSR LBC5F MOVE FPA0 TO FPA1
3821 f340 8e f1 09 LDX #LBEC0 POINT (X) TO FP NUMBER (.5)
3822 f343 bd ee 5d JSR LBC14 COPY A PACKED NUMBER FROM (X) TO FPA0
3823
3824 * ARITHMETIC OPERATOR FOR EXPONENTIATION JUMPS
3825 * HERE. THE FORMULA USED TO EVALUATE EXPONENTIATION
3826 * IS A**X=E**(X LN A) = E**(FPA0*LN(FPA1)), E=2.7182818
3827 f346 27 67 L8489 BEQ EXP DO A NATURAL EXPONENTIATION IF EXPONENT = 0
3828 f348 4d TSTA *CHECK VALUE BEING EXPONENTIATED
3829 f349 26 03 BNE L8491 *AND BRANCH IF IT IS <> 0
3830 f34b 7e ec 83 JMP LBA3A FPA0=0 IF RAISING ZERO TO A POWER
3831 f34e 8e 00 4a L8491 LDX #V4A * PACK FPA0 AND SAVE
3832 f351 bd ee 7e JSR LBC35 * IT IN FPA5 (ARGUMENT’S EXPONENT)
3833 f354 5f CLRB ACCB=DEFAULT RESULT SIGN FLAG; 0=POSITIVE
3834 f355 96 61 LDA FP1SGN *CHECK THE SIGN OF ARGUMENT
3835 f357 2a 10 BPL L84AC *BRANCH IF POSITIVE
3836 f359 bd ef 37 JSR INT CONVERT EXPONENT INTO AN INTEGER
3837 f35c 8e 00 4a LDX #V4A POINT X TO FPA5 (ORIGINAL EXPONENT)
3838 f35f 96 61 LDA FP1SGN GET MANTISSA SIGN OF FPA1 (ARGUMENT)
3839 f361 bd ee e9 JSR LBCA0 *COMPARE FPA0 TO (X) AND
3840 f364 26 03 BNE L84AC *BRANCH IF NOT EQUAL
3841 f366 43 COMA TOGGLE FPA1 MANTISSA SIGN - FORCE POSITIVE
3842 f367 d6 01 LDB CHARAC GET LS BYTE OF INTEGER VALUE OF EXPONENT (RESULT SIGN FLAG)
3843 f369 bd ee 95 L84AC JSR LBC4C COPY FPA1 TO FPA0; ACCA = MANTISSA SIGN
3844 f36c 34 04 PSHS B PUT RESULT SIGN FLAG ON THE STACK
3845 f36e bd f3 03 JSR LOG
3846 f371 8e 00 4a LDX #V4A POINT (X) TO FPA5
3847 f374 bd ed 13 JSR LBACA MULTIPLY FPA0 BY FPA5
3848 f377 8d 36 BSR EXP CALCULATE E**(FPA0)
3849 f379 35 02 PULS A * GET RESULT SIGN FLAG FROM THE STACK
3850 f37b 46 RORA * AND BRANCH IF NEGATIVE
3851 f37c 10 25 fd b2 LBCS LBEE9 CHANGE SIGN OF FPA0 MANTISSA
3852 f380 39 RTS
3853
3854 * CORRECTION FACTOR FOR EXPONENTIAL FUNCTION
3855 f381 81 38 aa 3b 29 L84C4 FCB $81,$38,$AA,$3B,$29 1.44269504 ( CF )
3856 *
3857 * TCHEBYSHEV MODIFIED TAYLOR SERIES COEFFICIENTS FOR E**X
3858 *
3859 f386 07 L84C9 FCB 7 EIGHT COEFFICIENTS
3860 f387 71 34 58 3e 56 L84CA FCB $71,$34,$58,$3E,$56 2.14987637E-05: 1/(7!*(CF**7))
3861 f38c 74 16 7e b3 1b L84CF FCB $74,$16,$7E,$B3,$1B 1.4352314E-04 : 1/(6!*(CF**6))
3862 f391 77 2f ee e3 85 L84D4 FCB $77,$2F,$EE,$E3,$85 1.34226348E-03: 1/(5!*(CF**5))
3863 f396 7a 1d 84 1c 2a L84D9 FCB $7A,$1D,$84,$1C,$2A 9.61401701E-03: 1/(4!*(CF**4))
3864 f39b 7c 63 59 58 0a L84DE FCB $7C,$63,$59,$58,$0A 0.0555051269
3865 f3a0 7e 75 fd e7 c6 L84E3 FCB $7E,$75,$FD,$E7,$C6 0.240226385
3866 f3a5 80 31 72 18 10 L84E8 FCB $80,$31,$72,$18,$10 0.693147186
3867 f3aa 81 00 00 00 00 L84ED FCB $81,$00,$00,$00,$00 1
3868 *
3869 * EXP ( E**X)
3870 * THE EXPONENTIAL FUNCTION IS EVALUATED BY FIRST MULTIPLYING THE
3871 * ARGUMENT BY A CORRECTION FACTOR (CF). AFTER THIS IS DONE, AN
3872 * ARGUMENT >= 127 WILL YIELD A ZERO RESULT (NO UNDERFLOW) FOR A
3873 * NEGATIVE ARGUMENT OR AN 'OV' (OVERFLOW) ERROR FOR A POSITIVE
3874 * ARGUMENT. THE POLYNOMIAL COEFFICIENTS ARE MODIFIED TO REFLECT
3875 * THE CF MULTIPLICATION AT THE START OF THE EVALUATION PROCESS.
3876
3877 f3af 8e f3 81 EXP LDX #L84C4 POINT X TO THE CORRECTION FACTOR
3878 f3b2 bd ed 13 JSR LBACA MULTIPLY FPA0 BY (X)
3879 f3b5 bd ee 78 JSR LBC2F PACK FPA0 AND STORE IT IN FPA3
3880 f3b8 96 4f LDA FP0EXP *GET EXPONENT OF FPA0 AND
3881 f3ba 81 88 CMPA #$88 *COMPARE TO THE MAXIMUM VALUE
3882 f3bc 25 03 BLO L8504 BRANCH IF FPA0 < 128
3883 f3be 7e ed a5 L8501 JMP LBB5C SET FPA0 = 0 OR ‘OV’ ERROR
3884 f3c1 bd ef 37 L8504 JSR INT CONVERT FPA0 TO INTEGER
3885 f3c4 96 01 LDA CHARAC GET LS BYTE OF INTEGER
3886 f3c6 8b 81 ADDA #$81 * WAS THE ARGUMENT =127, IF SO
3887 f3c8 27 f4 BEQ L8501 * THEN ‘OV’ ERROR; THIS WILL ALSO ADD THE $80 BIAS
3888 * * REQUIRED WHEN THE NEW EXPONENT IS CALCULATED BELOW
3889 f3ca 4a DECA DECREMENT ONE FROM THE EXPONENT, BECAUSE $81, NOT $80 WAS USED ABOVE
3890 f3cb 34 02 PSHS A SAVE EXPONENT OF INTEGER PORTION ON STACK
3891 f3cd 8e 00 40 LDX #V40 POINT (X) TO FPA3
3892 f3d0 bd ec 02 JSR LB9B9 SUBTRACT FPA0 FROM (X) - GET FRACTIONAL PART OF ARGUMENT
3893 f3d3 8e f3 86 LDX #L84C9 POINT X TO COEFFICIENTS
3894 f3d6 bd f1 48 JSR LBEFF EVALUATE POLYNOMIAL FOR FRACTIONAL PART
3895 f3d9 0f 62 CLR RESSGN FORCE THE MANTISSA TO BE POSITIVE
3896 f3db 35 02 PULS A GET INTEGER EXPONENT FROM STACK
3897 f3dd bd ed 91 JSR LBB48 * CALCULATE EXPONENT OF NEW FPA0 BY ADDING THE EXPONENTS OF THE
3898 * * INTEGER AND FRACTIONAL PARTS
3899 f3e0 39 RTS
3900
3901 * FIX
3902 f3e1 bd ee b6 FIX JSR LBC6D CHECK STATUS OF FPA0
3903 f3e4 2b 03 BMI L852C BRANCH IF FPA0 = NEGATIVE
3904 f3e6 7e ef 37 L8529 JMP INT CONVERT FPA0 TO INTEGER
3905 f3e9 03 54 L852C COM FP0SGN TOGGLE SIGN OF FPA0 MANTISSA
3906 f3eb 8d f9 BSR L8529 CONVERT FPA0 TO INTEGER
3907 f3ed 7e f1 32 JMP LBEE9 TOGGLE SIGN OF FPA0
3908
3909 * EDIT
3910 f3f0 bd f8 1e EDIT JSR L89AE GET LINE NUMBER FROM BASIC
3911 f3f3 32 62 LEAS $02,S PURGE RETURN ADDRESS OFF OF THE STACK
3912 f3f5 86 01 L8538 LDA #$01 ‘LIST’ FLAG
3913 f3f7 97 98 STA VD8 SET FLAG TO LIST LINE
3914 f3f9 bd df a2 JSR LAD01 GO FIND THE LINE NUMBER IN PROGRAM
3915 f3fc 10 25 ed 7f LBCS LAED2 ERROR #7 ‘UNDEFINED LINE #'
3916 f400 bd ea 3b JSR LB7C2 GO UNCRUNCH LINE INTO BUFFER AT LINBUF+1
3917 f403 1f 20 TFR Y,D PUT ABSOLUTE ADDRESS OF END OF LINE TO ACCD
3918 f405 83 00 f5 SUBD #LINBUF+2 SUBTRACT OUT THE START OF LINE
3919 f408 d7 97 STB VD7 SAVE LENGTH OF LINE
3920 f40a dc 2b L854D LDD BINVAL GET THE HEX VALUE OF LINE NUMBER
3921 f40c bd f0 15 JSR LBDCC LIST THE LINE NUMBER ON THE SCREEN
3922 f40f bd eb f5 JSR LB9AC PRINT A SPACE
3923 f412 8e 00 f4 LDX #LINBUF+1 POINT X TO BUFFER
3924 f415 d6 98 LDB VD8 * CHECK TO SEE IF LINE IS TO BE
3925 f417 26 25 BNE L8581 * LISTED TO SCREEN - BRANCH IF IT IS
3926 f419 5f L855C CLRB RESET DIGIT ACCUMULATOR - DEFAULT VALUE
3927 f41a bd f5 44 L855D JSR L8687 GET KEY STROKE
3928 f41d bd fc e9 JSR L90AA SET CARRY IF NOT NUMERIC
3929 f420 25 0b BLO L8570 BRANCH IF NOT NUMERIC
3930 f422 80 30 SUBA #'0' MASK OFF ASCII
3931 f424 34 02 PSHS A SAVE IT ON STACK
3932 f426 86 0a LDA #10 NUMBER BEING CONVERTED IS BASE 10
3933 f428 3d MUL MULTIPLY ACCUMULATED VALUE BY BASE (10)
3934 f429 eb e0 ADDB ,S+ ADD DIGIT TO ACCUMULATED VALUE
3935 f42b 20 ed BRA L855D CHECK FOR ANOTHER DIGIT
3936 f42d c0 01 L8570 SUBB #$01 * REPEAT PARAMETER IN ACCB; IF IT
3937 f42f c9 01 ADCB #$01 *IS 0, THEN MAKE IT ‘1’
3938 f431 81 41 CMPA #'A' ABORT?
3939 f433 26 05 BNE L857D NO
3940 f435 bd eb a5 JSR LB958 PRINT CARRIAGE RETURN TO SCREEN
3941 f438 20 bb BRA L8538 RESTART EDIT PROCESS - CANCEL ALL CHANGES
3942 f43a 81 4c L857D CMPA #'L' LIST?
3943 f43c 26 0b BNE L858C NO
3944 f43e 8d 31 L8581 BSR L85B4 LIST THE LINE
3945 f440 0f 98 CLR VD8 RESET THE LIST FLAG TO ‘NO LIST’
3946 f442 bd eb a5 JSR LB958 PRINT CARRIAGE RETURN
3947 f445 20 c3 BRA L854D GO INTERPRET ANOTHER EDIT COMMAND
3948 f447 32 62 L858A LEAS $02,S PURGE RETURN ADDRESS OFF OF THE STACK
3949 f449 81 0d L858C CMPA #CR ENTER KEY?
3950 f44b 26 0d BNE L859D NO
3951 f44d 8d 22 BSR L85B4 ECHO THE LINE TO THE SCREEN
3952 f44f bd eb a5 L8592 JSR LB958 PRINT CARRIAGE RETURN
3953 f452 8e 00 f4 LDX #LINBUF+1 * RESET BASIC’S INPUT POINTER
3954 f455 9f 83 STX CHARAD * TO THE LINE INPUT BUFFER
3955 f457 7e df 4b JMP LACA8 GO PUT LINE BACK IN PROGRAM
3956 f45a 81 45 L859D CMPA #'E' EXIT?
3957 f45c 27 f1 BEQ L8592 YES - SAME AS ENTER EXCEPT NO ECHO
3958 f45e 81 51 CMPA #'Q' QUIT?
3959 f460 26 06 BNE L85AB NO
3960 f462 bd eb a5 JSR LB958 PRINT CARRIAGE RETURN TO SCREEN
3961 f465 7e df 22 JMP LAC73 GO TO COMMAND LEVEL - MAKE NO CHANGES
3962 f468 8d 02 L85AB BSR L85AF INTERPRET THE REMAINING COMMANDS AS SUBROUTINES
3963 f46a 20 ad BRA L855C GO INTERPRET ANOTHER EDIT COMMAND
3964 f46c 81 20 L85AF CMPA #SPACE SPACE BAR?
3965 f46e 26 10 BNE L85C3 NO
3966 f470 8c L85B3 FCB SKP2 SKIP TWO BYTES
3967 * DISPLAY THE NEXT ACCB BYTES OF THE LINE IN THE BUFFER TO THE SCREEN
3968 *
3969 f471 c6 f9 L85B4 LDB #LBUFMX-1 250 BYTES MAX IN BUFFER
3970 f473 a6 84 L85B6 LDA ,X GET A CHARACTER FROM BUFFER
3971 f475 27 08 BEQ L85C2 EXIT IF IT’S A 0
3972 f477 bd db 14 JSR PUTCHR SEND CHAR TO CONSOLE OUT
3973 f47a 30 01 LEAX $01,X MOVE POINTER UP ONE
3974 f47c 5a DECB DECREMENT CHARACTER COUNTER
3975 f47d 26 f4 BNE L85B6 LOOP IF NOT DONE
3976 f47f 39 L85C2 RTS
3977 f480 81 44 L85C3 CMPA #'D' DELETE?
3978 f482 26 48 BNE L860F NO
3979 f484 6d 84 L85C7 TST ,X * CHECK FOR END OF LINE
3980 f486 27 f7 BEQ L85C2 * AND BRANCH IF SO
3981 f488 8d 04 BSR L85D1 REMOVE A CHARACTER
3982 f48a 5a DECB DECREMENT REPEAT PARAMETER
3983 f48b 26 f7 BNE L85C7 BRANCH IF NOT DONE
3984 f48d 39 RTS
3985 * REMOVE ONE CHARACTER FROM BUFFER
3986 f48e 0a 97 L85D1 DEC VD7 DECREMENT LENGTH OF BUFFER
3987 f490 31 1f LEAY $-01,X POINT Y TO ONE BEFORE CURRENT BUFFER POINTER
3988 f492 31 21 L85D5 LEAY $01,Y INCREMENT TEMPORARY BUFFER POINTER
3989 f494 a6 21 LDA $01,Y GET NEXT CHARACTER
3990 f496 a7 a4 STA ,Y PUT IT IN CURRENT POSITION
3991 f498 26 f8 BNE L85D5 BRANCH IF NOT END OF LINE
3992 f49a 39 RTS
3993 f49b 81 49 L85DE CMPA #'I' INSERT?
3994 f49d 27 13 BEQ L85F5 YES
3995 f49f 81 58 CMPA #'X' EXTEND?
3996 f4a1 27 0d BEQ L85F3 YES
3997 f4a3 81 48 CMPA #'H' HACK?
3998 f4a5 26 5c BNE L8646 NO
3999 f4a7 6f 84 CLR ,X TURN CURRENT BUFFER POINTER INTO END OF LINE FLAG
4000 f4a9 1f 10 TFR X,D PUT CURRENT BUFFER POINTER IN ACCD
4001 f4ab 83 00 f5 SUBD #LINBUF+2 SUBTRACT INITIAL POINTER POSITION
4002 f4ae d7 97 STB VD7 SAVE NEW BUFFER LENGTH
4003 f4b0 8d bf L85F3 BSR L85B4 DISPLAY THE LINE ON THE SCREEN
4004 f4b2 bd f5 44 L85F5 JSR L8687 GET A KEYSTROKE
4005 f4b5 81 0d CMPA #CR ENTER KEY?
4006 f4b7 27 8e BEQ L858A YES - INTERPRET ANOTHER COMMAND - PRINT LINE
4007 f4b9 81 1b CMPA #ESC ESCAPE?
4008 f4bb 27 25 BEQ L8625 YES - RETURN TO COMMAND LEVEL - DON’T PRINT LINE
4009 f4bd 81 08 CMPA #BS BACK SPACE?
4010 f4bf 26 22 BNE L8626 NO
4011 f4c1 8c 00 f4 CMPX #LINBUF+1 COMPARE POINTER TO START OF BUFFER
4012 f4c4 27 ec BEQ L85F5 DO NOT ALLOW BS IF AT START
4013 f4c6 8d 45 BSR L8650 MOVE POINTER BACK ONE, BS TO SCREEN
4014 f4c8 8d c4 BSR L85D1 REMOVE ONE CHARACTER FROM BUFFER
4015 f4ca 20 e6 BRA L85F5 GET INSERT SUB COMMAND
4016 f4cc 81 43 L860F CMPA #'C' CHANGE?
4017 f4ce 26 cb BNE L85DE NO
4018 f4d0 6d 84 L8613 TST ,X CHECK CURRENT BUFFER CHARACTER
4019 f4d2 27 0e BEQ L8625 BRANCH IF END OF LINE
4020 f4d4 bd f5 44 JSR L8687 GET A KEYSTROKE
4021 f4d7 25 02 BLO L861E BRANCH IF LEGITIMATE KEY
4022 f4d9 20 f5 BRA L8613 TRY AGAIN IF ILLEGAL KEY
4023 f4db a7 80 L861E STA ,X+ INSERT NEW CHARACTER INTO BUFFER
4024 f4dd 8d 37 BSR L8659 SEND NEW CHARACTER TO SCREEN
4025 f4df 5a DECB DECREMENT REPEAT PARAMETER
4026 f4e0 26 ee BNE L8613 BRANCH IF NOT DONE
4027 f4e2 39 L8625 RTS
4028 f4e3 d6 97 L8626 LDB VD7 GET LENGTH OF LINE
4029 f4e5 c1 f9 CMPB #LBUFMX-1 COMPARE TO MAXIMUM LENGTH
4030 f4e7 26 02 BNE L862E BRANCH IF NOT AT MAXIMUM
4031 f4e9 20 c7 BRA L85F5 IGNORE INPUT IF LINE AT MAXIMUM LENGTH
4032 f4eb 34 10 L862E PSHS X SAVE CURRENT BUFFER POINTER
4033 f4ed 6d 80 L8630 TST ,X+ * SCAN THE LINE UNTIL END OF
4034 f4ef 26 fc BNE L8630 * LINE (0) IS FOUND
4035 f4f1 e6 82 L8634 LDB ,-X DECR TEMP LINE POINTER AND GET A CHARACTER
4036 f4f3 e7 01 STB $01,X PUT CHARACTER BACK DOWN ONE SPOT
4037 f4f5 ac e4 CMPX ,S HAVE WE REACHED STARTING POINT?
4038 f4f7 26 f8 BNE L8634 NO - KEEP GOING
4039 f4f9 32 62 LEAS $02,S PURGE BUFFER POINTER FROM STACK
4040 f4fb a7 80 STA ,X+ INSERT NEW CHARACTER INTO THE LINE
4041 f4fd 8d 17 BSR L8659 SEND A CHARACTER TO CONSOLE OUT
4042 f4ff 0c 97 INC VD7 ADD ONE TO BUFFER LENGTH
4043 f501 20 af BRA L85F5 GET INSERT SUB COMMAND
4044 f503 81 08 L8646 CMPA #BS BACKSPACE?
4045 f505 26 12 BNE L865C NO
4046 f507 8d 04 L864A BSR L8650 MOVE POINTER BACK 1, SEND BS TO SCREEN
4047 f509 5a DECB DECREMENT REPEAT PARAMETER
4048 f50a 26 fb BNE L864A LOOP UNTIL DONE
4049 f50c 39 RTS
4050 f50d 8c 00 f4 L8650 CMPX #LINBUF+1 COMPARE POINTER TO START OF BUFFER
4051 f510 27 d0 BEQ L8625 DO NOT ALLOW BS IF AT START
4052 f512 30 1f LEAX $-01,X MOVE POINTER BACK ONE
4053 f514 86 08 LDA #BS BACK SPACE
4054 f516 7e db 14 L8659 JMP PUTCHR SEND TO CONSOLE OUT
4055 f519 81 4b L865C CMPA #'K' KILL?
4056 f51b 27 05 BEQ L8665 YES
4057 f51d 80 53 SUBA #'S' SEARCH?
4058 f51f 27 01 BEQ L8665 YES
4059 f521 39 RTS
4060 f522 34 02 L8665 PSHS A SAVE KILL/SEARCH FLAG ON STACK
4061 f524 8d 1e BSR L8687 * GET A KEYSTROKE (TARGET CHARACTER)
4062 f526 34 02 PSHS A * AND SAVE IT ON STACK
4063 f528 a6 84 L866B LDA ,X GET CURRENT BUFFER CHARACTER
4064 f52a 27 16 BEQ L8685 AND RETURN IF END OF LINE
4065 f52c 6d 61 TST $01,S CHECK KILL/SEARCH FLAG
4066 f52e 26 06 BNE L8679 BRANCH IF KILL
4067 f530 8d e4 BSR L8659 SEND A CHARACTER TO CONSOLE OUT
4068 f532 30 01 LEAX $01,X INCREMENT BUFFER POINTER
4069 f534 20 03 BRA L867C CHECK NEXT INPUT CHARACTER
4070 f536 bd f4 8e L8679 JSR L85D1 REMOVE ONE CHARACTER FROM BUFFER
4071 f539 a6 84 L867C LDA ,X GET CURRENT INPUT CHARACTER
4072 f53b a1 e4 CMPA ,S COMPARE TO TARGET CHARACTER
4073 f53d 26 e9 BNE L866B BRANCH IF NO MATCH
4074 f53f 5a DECB DECREMENT REPEAT PARAMETER
4075 f540 26 e6 BNE L866B BRANCH IF NOT DONE
4076 f542 35 a0 L8685 PULS Y,PC THE Y PULL WILL CLEAN UP THE STACK FOR THE 2 PSHS A
4077 *
4078 * GET A KEYSTRKE
4079 f544 bd db 00 L8687 JSR LA171 CALL CONSOLE IN : DEV NBR=SCREEN
4080 f547 81 7f CMPA #$7F GRAPHIC CHARACTER?
4081 f549 24 f9 BCC L8687 YES - GET ANOTHER CHAR
4082 f54b 81 5f CMPA #$5F SHIFT UP ARROW (QUIT INSERT)
4083 f54d 26 02 BNE L8694 NO
4084 f54f 86 1b LDA #ESC REPLACE W/ESCAPE CODE
4085 f551 81 0d L8694 CMPA #CR ENTER KEY
4086 f553 27 0e BEQ L86A6 YES
4087 f555 81 1b CMPA #ESC ESCAPE?
4088 f557 27 0a BEQ L86A6 YES
4089 f559 81 08 CMPA #BS BACKSPACE?
4090 f55b 27 06 BEQ L86A6 YES
4091 f55d 81 20 CMPA #SPACE SPACE
4092 f55f 25 e3 BLO L8687 GET ANOTHER CHAR IF CONTROL CHAR
4093 f561 1a 01 ORCC #$01 SET CARRY
4094 f563 39 L86A6 RTS
4095
4096 * TRON
4097 f564 86 TRON FCB SKP1LD SKIP ONE BYTE AND LDA #$4F
4098
4099 * TROFF
4100 f565 4f TROFF CLRA TROFF FLAG
4101 f566 97 8c STA TRCFLG TRON/TROFF FLAG:0=TROFF, <> 0=TRON
4102 f568 39 RTS
4103
4104 * POS
4105
4106 f569 86 00 POS LDA #0 GET DEVICE NUMBER
4107 f56b d6 79 LDB LPTPOS GET PRINT POSITION
4108 f56d 1d LA5E8 SEX CONVERT ACCB TO 2 DIGIT SIGNED INTEGER
4109 f56e 7e e7 78 JMP GIVABF CONVERT ACCD TO FLOATING POINT
4110
4111
4112 * VARPTR
4113 f571 bd e4 f3 VARPT JSR LB26A SYNTAX CHECK FOR ‘(‘
4114 f574 dc 1f LDD ARYEND GET ADDR OF END OF ARRAYS
4115 f576 34 06 PSHS B,A SAVE IT ON STACK
4116 f578 bd e5 db JSR LB357 GET VARIABLE DESCRIPTOR
4117 f57b bd e4 f0 JSR LB267 SYNTAX CHECK FOR ‘)‘
4118 f57e 35 06 PULS A,B GET END OF ARRAYS ADDR BACK
4119 f580 1e 10 EXG X,D SWAP END OF ARRAYS AND VARIABLE DESCRIPTOR
4120 f582 9c 1f CMPX ARYEND COMPARE TO NEW END OF ARRAYS
4121 f584 26 51 BNE L8724 ‘FC’ ERROR IF VARIABLE WAS NOT DEFINED PRIOR TO CALLING VARPTR
4122 f586 7e e7 78 JMP GIVABF CONVERT VARIABLE DESCRIPTOR INTO A FP NUMBER
4123
4124 * MID$(OLDSTRING,POSITION,LENGTH)=REPLACEMENT
4125 f589 9d 7c L86D6 JSR GETNCH GET INPUT CHAR FROM BASIC
4126 f58b bd e4 f3 JSR LB26A SYNTAX CHECK FOR ‘(‘
4127 f58e bd e5 db JSR LB357 * GET VARIABLE DESCRIPTOR ADDRESS AND
4128 f591 34 10 PSHS X * SAVE IT ON THE STACK
4129 f593 ec 02 LDD $02,X POINT ACCD TO START OF OLDSTRING
4130 f595 10 93 21 CMPD FRETOP COMPARE TO START OF CLEARED SPACE
4131 f598 23 04 BLS L86EB BRANCH IF <=
4132 f59a 93 27 SUBD MEMSIZ SUBTRACT OUT TOP OF CLEARED SPACE
4133 f59c 23 12 BLS L86FD BRANCH IF STRING IN STRING SPACE
4134 f59e e6 84 L86EB LDB ,X GET LENGTH OF OLDSTRING
4135 f5a0 bd e7 f1 JSR LB56D RESERVE ACCB BYTES IN STRING SPACE
4136 f5a3 34 10 PSHS X SAVE RESERVED SPACE STRING ADDRESS ON STACK
4137 f5a5 ae 62 LDX $02,S POINT X TO OLDSTRING DESCRIPTOR
4138 f5a7 bd e8 c7 JSR LB643 MOVE OLDSTRING INTO STRING SPACE
4139 f5aa 35 50 PULS X,U * GET OLDSTRING DESCRIPTOR ADDRESS AND RESERVED STRING
4140 f5ac af 42 STX $02,U * ADDRESS AND SAVE RESERVED ADDRESS AS OLDSTRING ADDRESS
4141 f5ae 34 40 PSHS U SAVE OLDSTRING DESCRIPTOR ADDRESS
4142 f5b0 bd e9 bc L86FD JSR LB738 SYNTAX CHECK FOR COMMA AND EVALUATE LENGTH EXPRESSION
4143 f5b3 34 04 PSHS B SAVE POSITION PARAMETER ON STACK
4144 f5b5 5d TSTB * CHECK POSITION PARAMETER AND BRANCH
4145 f5b6 27 1f BEQ L8724 * IF START OF STRING
4146 f5b8 c6 ff LDB #$FF DEFAULT REPLACEMENT LENGTH = $FF
4147 f5ba 81 29 CMPA #')' * CHECK FOR END OF MID$ STATEMENT AND
4148 f5bc 27 03 BEQ L870E * BRANCH IF AT END OF STATEMENT
4149 f5be bd e9 bc JSR LB738 SYNTAX CHECK FOR COMMA AND EVALUATE LENGTH EXPRESSION
4150 f5c1 34 04 L870E PSHS B SAVE LENGTH PARAMETER ON STACK
4151 f5c3 bd e4 f0 JSR LB267 SYNTAX CHECK FOR ‘)‘
4152 f5c6 c6 ae LDB #TOK_EQUALS TOKEN FOR =
4153 f5c8 bd e4 f8 JSR LB26F SYNTAX CHECK FOR “=‘
4154 f5cb 8d 2e BSR L8748 EVALUATE REPLACEMENT STRING
4155 f5cd 1f 13 TFR X,U SAVE REPLACEMENT STRING ADDRESS IN U
4156 f5cf ae 62 LDX $02,S POINT X TO OLOSTRING DESCRIPTOR ADDRESS
4157 f5d1 a6 84 LDA ,X GET LENGTH OF OLDSTRING
4158 f5d3 a0 61 SUBA $01,S SUBTRACT POSITION PARAMETER
4159 f5d5 24 03 BCC L8727 INSERT REPLACEMENT STRING INTO OLDSTRING
4160 f5d7 7e e6 ce L8724 JMP LB44A ‘FC’ ERROR IF POSITION > LENGTH OF OLDSTRING
4161 f5da 4c L8727 INCA * NOW ACCA = NUMBER OF CHARACTERS TO THE RIGHT
4162 * * (INCLUSIVE) OF THE POSITION PARAMETER
4163 f5db a1 e4 CMPA ,S
4164 f5dd 24 02 BCC L872E BRANCH IF NEW STRING WILL FIT IN OLDSTRING
4165 f5df a7 e4 STA ,S IF NOT, USE AS MUCH OF LENGTH PARAMETER AS WILL FIT
4166 f5e1 a6 61 L872E LDA $01,S GET POSITION PARAMETER
4167 f5e3 1e 89 EXG A,B ACCA=LENGTH OF REPL STRING, ACCB=POSITION PARAMETER
4168 f5e5 ae 02 LDX $02,X POINT X TO OLDSTRING ADDRESS
4169 f5e7 5a DECB * BASIC’S POSITION PARAMETER STARTS AT 1; THIS ROUTINE
4170 * * WANTS IT TO START AT ZERO
4171 f5e8 3a ABX POINT X TO POSITION IN OLDSTRING WHERE THE REPLACEMENT WILL GO
4172 f5e9 4d TSTA * IF THE LENGTH OF THE REPLACEMENT STRING IS ZERO
4173 f5ea 27 0d BEQ L8746 * THEN RETURN
4174 f5ec a1 e4 CMPA ,S
4175 f5ee 23 02 BLS L873F ADJUSTED LENGTH PARAMETER, THEN BRANCH
4176 f5f0 a6 e4 LDA ,S OTHERWISE USE AS MUCH ROOM AS IS AVAILABLE
4177 f5f2 1f 89 L873F TFR A,B SAVE NUMBER OF BYTES TO MOVE IN ACCB
4178 f5f4 1e 31 EXG U,X SWAP SOURCE AND DESTINATION POINTERS
4179 f5f6 bd dc ae JSR LA59A MOVE (B) BYTES FROM (X) TO (U)
4180 f5f9 35 96 L8746 PULS A,B,X,PC
4181 f5fb bd e3 df L8748 JSR LB156 EVALUATE EXPRESSION
4182 f5fe 7e e8 d8 JMP LB654 *‘TM’ ERROR IF NUMERIC; RETURN WITH X POINTING
4183 * *TO STRING, ACCB = LENGTH
4184
4185 * STRING
4186 f601 bd e4 f3 STRING JSR LB26A SYNTAX CHECK FOR ‘(’
4187 f604 bd e9 8f JSR LB70B EVALUATE EXPRESSION; ERROR IF > 255
4188 f607 34 04 PSHS B SAVE LENGTH OF STRING
4189 f609 bd e4 f6 JSR LB26D SYNTAX CHECK FOR COMMA
4190 f60c bd e3 df JSR LB156 EVALUATE EXPRESSION
4191 f60f bd e4 f0 JSR LB267 SYNTAX CHECK FOR ‘)‘
4192 f612 96 06 LDA VALTYP GET VARIABLE TYPE
4193 f614 26 05 BNE L8768 BRANCH IF STRING
4194 f616 bd e9 92 JSR LB70E CONVERT FPA0 INTO AN INTEGER IN ACCB
4195 f619 20 03 BRA L876B SAVE THE STRING IN STRING SPACE
4196 f61b bd e9 28 L8768 JSR LB6A4 GET FIRST BYTE OF STRING
4197 f61e 34 04 L876B PSHS B SAVE FIRST BYTE OF EXPRESSION
4198 f620 e6 61 LDB $01,S GET LENGTH OF STRING
4199 f622 bd e7 93 JSR LB50F RESERVE ACCB BYTES IN STRING SPACE
4200 f625 35 06 PULS A,B GET LENGTH OF STRING AND CHARACTER
4201 f627 27 05 BEQ L877B BRANCH IF NULL STRING
4202 f629 a7 80 L8776 STA ,X+ SAVE A CHARACTER IN STRING SPACE
4203 f62b 5a DECB DECREMENT LENGTH
4204 f62c 26 fb BNE L8776 BRANCH IF NOT DONE
4205 f62e 7e e9 1f L877B JMP LB69B PUT STRING DESCRIPTOR ONTO STRING STACK
4206
4207 * INSTR
4208 f631 bd e4 f3 INSTR JSR LB26A SYNTAX CHECK FOR ‘(‘
4209 f634 bd e3 df JSR LB156 EVALUATE EXPRESSION
4210 f637 c6 01 LDB #$01 DEFAULT POSITION = 1 (SEARCH START)
4211 f639 34 04 PSHS B SAVE START
4212 f63b 96 06 LDA VALTYP GET VARIABLE TYPE
4213 f63d 26 10 BNE L879C BRANCH IF STRING
4214 f63f bd e9 92 JSR LB70E CONVERT FPA0 TO INTEGER IN ACCB
4215 f642 e7 e4 STB ,S SAVE START SEARCH VALUE
4216 f644 27 91 BEQ L8724 BRANCH IF START SEARCH AT ZERO
4217 f646 bd e4 f6 JSR LB26D SYNTAX CHECK FOR COMMA
4218 f649 bd e3 df JSR LB156 EVALUATE EXPRESSION - SEARCH STRING
4219 f64c bd e3 cf JSR LB146 ‘TM’ ERROR IF NUMERIC
4220 f64f 9e 52 L879C LDX FPA0+2 SEARCH STRING DESCRIPTOR ADDRESS
4221 f651 34 10 PSHS X SAVE ON THE STACK
4222 f653 bd e4 f6 JSR LB26D SYNTAX CHECK FOR COMMA
4223 f656 bd f5 fb JSR L8748 EVALUATE TARGET STRING EXPRESSION
4224 f659 34 14 PSHS X,B SAVE ADDRESS AND LENGTH ON STACK
4225 f65b bd e4 f0 JSR LB267 SYNTAX CHECK FOR ')'
4226 f65e ae 63 LDX $03,S * LOAD X WITH SEARCH STRING DESCRIPTOR ADDRESS
4227 f660 bd e8 dd JSR LB659 * AND GET THE LENGTH ANDADDRESS OF SEARCH STRING
4228 f663 34 04 PSHS B SAVE LENGTH ON STACK
4229 *
4230 * AT THIS POINT THE STACK HAS THE FOLLOWING INFORMATION
4231 * ON IT: 0,S-SEARCH LENGTH; 1,S-TARGET LENGTH; 2 3,S-TARGET
4232 * ADDRESS; 4 5,S-SEARCH DESCRIPTOR ADDRESS; 6,S-SEARCH POSITION
4233 f665 e1 66 CMPB $06,S COMPARE LENGTH OF SEARCH STRING TO START
4234 f667 25 23 BLO L87D9 POSITION; RETURN 0 IF LENGTH < START
4235 f669 a6 61 LDA $01,S GET LENGTH OF TARGET STRING
4236 f66b 27 1c BEQ L87D6 BRANCH IF TARGET STRING = NULL
4237 f66d e6 66 LDB $06,S GET START POSITION
4238 f66f 5a DECB MOVE BACK ONE
4239 f670 3a ABX POINT X TO POSITION IN SEARCH STRING WHERE SEARCHING WILL START
4240 f671 31 84 L87BE LEAY ,X POINT Y TO SEARCH POSITION
4241 f673 ee 62 LDU $02,S POINT U TO START OF TARGET
4242 f675 e6 61 LDB $01,S LOAD ACCB WITH LENGTH OF TARGET
4243 f677 a6 e4 LDA ,S LOAD ACCA WITH LENGTH OF SEARCH
4244 f679 a0 66 SUBA $06,S SUBTRACT SEARCH POSITION FROM SEARCH LENGTH
4245 f67b 4c INCA ADD ONE
4246 f67c a1 61 CMPA $01,S COMPARE TO TARGET LENGTH
4247 f67e 25 0c BLO L87D9 RETURN 0 IF TARGET LENGTH > WHAT’S LEFT OF SEARCH STRING
4248 f680 a6 80 L87CD LDA ,X+ GET A CHARACTER FROM SEARCH STRING
4249 f682 a1 c0 CMPA ,U+ COMPARE IT TO TARGET STRING
4250 f684 26 0c BNE L87DF BRANCH IF NO MATCH
4251 f686 5a DECB DECREMENT TARGET LENGTH
4252 f687 26 f7 BNE L87CD CHECK ANOTHER CHARACTER
4253 f689 e6 66 L87D6 LDB $06,S GET MATCH POSITION
4254 f68b 21 L87D8 FCB SKP1 SKIP NEXT BYTE
4255 f68c 5f L87D9 CLRB MATCH ADDRESS = 0
4256 f68d 32 67 LEAS $07,S CLEAN UP THE STACK
4257 f68f 7e e7 77 JMP LB4F3 CONVERT ACCB TO FP NUMBER
4258 f692 6c 66 L87DF INC $06,S INCREMENT SEARCH POSITION
4259 f694 30 21 LEAX $01,Y MOVE X TO NEXT SEARCH POSITION
4260 f696 20 d9 BRA L87BE KEEP LOOKING FOR A MATCH
4261
4262 * EXTENDED BASIC RVEC19 HOOK CODE
4263 f698 81 26 XVEC19 CMPA #'&' *
4264 f69a 26 5c BNE L8845 * RETURN IF NOT HEX OR OCTAL VARIABLE
4265 f69c 32 62 LEAS $02,S PURGE RETURN ADDRESS FROM STACK
4266 * PROCESS A VARIABLE PRECEEDED BY A ‘&‘ (&H,&O)
4267 f69e 0f 52 L87EB CLR FPA0+2 * CLEAR BOTTOM TWO
4268 f6a0 0f 53 CLR FPA0+3 * BYTES OF FPA0
4269 f6a2 8e 00 52 LDX #FPA0+2 BYTES 2,3 OF FPA0 = (TEMPORARY ACCUMULATOR)
4270 f6a5 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
4271 f6a7 81 4f CMPA #'O'
4272 f6a9 27 12 BEQ L880A YES
4273 f6ab 81 48 CMPA #'H'
4274 f6ad 27 23 BEQ L881F YES
4275 f6af 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4276 f6b1 20 0c BRA L880C DEFAULT TO OCTAL (&O)
4277 f6b3 81 38 L8800 CMPA #'8'
4278 f6b5 10 22 ee 47 LBHI LB277
4279 f6b9 c6 03 LDB #$03 BASE 8 MULTIPLIER
4280 f6bb 8d 2a BSR L8834 ADD DIGIT TO TEMPORARY ACCUMULATOR
4281 * EVALUATE AN &O VARIABLE
4282 f6bd 9d 7c L880A JSR GETNCH GET A CHARACTER FROM BASIC
4283 f6bf 25 f2 L880C BLO L8800 BRANCH IF NUMERIC
4284 f6c1 0f 50 L880E CLR FPA0 * CLEAR 2 HIGH ORDER
4285 f6c3 0f 51 CLR FPA0+1 * BYTES OF FPA0
4286 f6c5 0f 06 CLR VALTYP SET VARXABLE TYPE TO NUMERIC
4287 f6c7 0f 63 CLR FPSBYT ZERO OUT SUB BYTE OF FPA0
4288 f6c9 0f 54 CLR FP0SGN ZERO OUT MANTISSA SIGN OF FPA0
4289 f6cb c6 a0 LDB #$A0 * SET EXPONENT OF FPA0
4290 f6cd d7 4f STB FP0EXP *
4291 f6cf 7e ec 65 JMP LBA1C GO NORMALIZE FPA0
4292 * EVALUATE AN &H VARIABLE
4293 f6d2 9d 7c L881F JSR GETNCH GET A CHARACTER FROM BASIC
4294 f6d4 25 0b BLO L882E BRANCH IF NUMERIC
4295 f6d6 bd e6 26 JSR LB3A2 SET CARRY IF NOT ALPHA
4296 f6d9 25 e6 BLO L880E BRANCH IF NOT ALPHA OR NUMERIC
4297 f6db 81 47 CMPA #'G' CHECK FOR LETTERS A-F
4298 f6dd 24 e2 BCC L880E BRANCH IF >= G (ILLEGAL HEX LETTER)
4299 f6df 80 07 SUBA #7 SUBTRACT ASCII DIFFERENCE BETWEEN A AND 9
4300 f6e1 c6 04 L882E LDB #$04 BASE 16 DIGIT MULTIPLIER = 2**4
4301 f6e3 8d 02 BSR L8834 ADD DIGIT TO TEMPORARY ACCUMULATOR
4302 f6e5 20 eb BRA L881F KEEP EVALUATING VARIABLE
4303 f6e7 68 01 L8834 ASL $01,X * MULTIPLY TEMPORARY
4304 f6e9 69 84 ROL ,X * ACCUMULATOR BY TWO
4305 f6eb 10 25 f5 ec LBCS LBA92 ‘OV' OVERFLOW ERROR
4306 f6ef 5a DECB DECREMENT SHIFT COUNTER
4307 f6f0 26 f5 BNE L8834 MULTIPLY TEMPORARY ACCUMULATOR AGAIN
4308 f6f2 80 30 SUBA #'0' MASK OFF ASCII
4309 f6f4 ab 01 ADDA $01,X * ADD DIGIT TO TEMPORARY
4310 f6f6 a7 01 STA $01,X * ACCUMULATOR AND SAVE IT
4311 f6f8 39 L8845 RTS
4312
4313 f6f9 35 40 XVEC15 PULS U PULL RETURN ADDRESS AND SAVE IN U REGISTER
4314 f6fb 0f 06 CLR VALTYP SET VARIABLE TYPE TO NUMERIC
4315 f6fd 9e 83 LDX CHARAD CURRENT INPUT POINTER TO X
4316 f6ff 9d 7c JSR GETNCH GET CHARACTER FROM BASIC
4317 f701 81 26 CMPA #'&' HEX AND OCTAL VARIABLES ARE PRECEEDED BY &
4318 f703 27 99 BEQ L87EB PROCESS A ‘&‘ VARIABLE
4319 f705 81 b0 CMPA #TOK_FN TOKEN FOR FN
4320 f707 27 5e BEQ L88B4 PROCESS FN CALL
4321 f709 81 ff CMPA #$FF CHECK FOR SECONDARY TOKEN
4322 f70b 26 08 BNE L8862 NOT SECONDARY
4323 f70d 9d 7c JSR GETNCH GET CHARACTER FROM BASIC
4324 f70f 81 83 CMPA #TOK_USR TOKEN FOR USR
4325 f711 10 27 00 ab LBEQ L892C PROCESS USR CALL
4326 f715 9f 83 L8862 STX CHARAD RESTORE BASIC’S INPUT POINTER
4327 f717 6e c4 JMP ,U RETURN TO CALLING ROUTINE
4328 f719 9e 68 L8866 LDX CURLIN GET CURRENT LINE NUMBER
4329 f71b 30 01 LEAX $01,X IN DIRECT MODE?
4330 f71d 26 d9 BNE L8845 RETURN IF NOT IN DIRECT MODE
4331 f71f c6 16 LDB #2*11 ‘ILLEGAL DIRECT STATEMENT’ ERROR
4332 f721 7e df 03 L886E JMP LAC46 PROCESS ERROR
4333
4334 f724 ae 9f 00 83 DEF LDX [CHARAD] GET TWO INPUT CHARS
4335 f728 8c ff 83 CMPX #TOK_FF_USR TOKEN FOR USR
4336 f72b 10 27 00 74 LBEQ L890F BRANCH IF DEF USR
4337 f72f 8d 23 BSR L88A1 GET DESCRIPTOR ADDRESS FOR FN VARIABLE NAME
4338 f731 8d e6 BSR L8866 DON’T ALLOW DEF FN IF IN DIRECT MODE
4339 f733 bd e4 f3 JSR LB26A SYNTAX CHECK FOR ‘(‘
4340 f736 c6 80 LDB #$80 * GET THE FLAG TO INDICATE ARRAY VARIABLE SEARCH DISABLE
4341 f738 d7 08 STB ARYDIS * AND SAVE IT IN THE ARRAY DISABLE FLAG
4342 f73a bd e5 db JSR LB357 GET VARIABLE DESCRIPTOR
4343 f73d 8d 25 BSR L88B1 ‘TM’ ERROR IF STRING
4344 f73f bd e4 f0 JSR LB267 SYNTAX CHECK FOR ‘)‘
4345 f742 c6 ae LDB #TOK_EQUALS TOKEN FOR ‘=‘
4346 f744 bd e4 f8 JSR LB26F DO A SYNTAX CHECK FOR =
4347 f747 9e 4b LDX V4B GET THE ADDRESS OF THE FN NAME DESCRIPTOR
4348 f749 dc 83 LDD CHARAD * GET THE CURRENT INPUT POINTER ADDRESS AND
4349 f74b ed 84 STD ,X * SAVE IT IN FIRST 2 BYTES OF THE DESCRIPTOR
4350 f74d dc 39 LDD VARPTR = GET THE DESCRIPTOR ADDRESS OF THE ARGUMENT
4351 f74f ed 02 STD $02,X = VARIABLE AND SAVE IT IN THE DESCRIPTOR OF THE FN NAME
4352 f751 7e e1 8d JMP DATA MOVE INPUT POINTER TO END OF LINE OR SUBLINE
4353 f754 c6 b0 L88A1 LDB #TOK_FN TOKEN FOR FN
4354 f756 bd e4 f8 JSR LB26F DO A SYNTAX CHECK FOR FN
4355 f759 c6 80 LDB #$80 * GET THE FLAG TO INDICATE ARRAY VARIABLE SEARCH DISABLE FLAG
4356 f75b d7 08 STB ARYDIS * AND SAVE IT IN ARRAY VARIABLE FLAG
4357 f75d 8a 80 ORA #$80 SET BIT 7 OF CURRENT INPUT CHARACTER TO INDICATE AN FN VARIABLE
4358 f75f bd e5 e0 JSR LB35C * GET THE DESCRIPTOR ADDRESS OF THIS
4359 f762 9f 4b STX V4B * VARIABLE AND SAVE IT IN V4B
4360 f764 7e e3 cc L88B1 JMP LB143 ‘TM’ ERROR IF STRING VARIABLE
4361 * EVALUATE AN FN CALL
4362 f767 8d eb L88B4 BSR L88A1 * GET THE DESCRIPTOR OF THE FN NAME
4363 f769 34 10 PSHS X * VARIABLE AND SAVE IT ON THE STACK
4364 f76b bd e4 eb JSR LB262 SYNTAX CHECK FOR ‘(‘ & EVALUATE EXPR
4365 f76e 8d f4 BSR L88B1 ‘TM’ ERROR IF STRING VARIABLE
4366 f770 35 40 PULS U POINT U TO FN NAME DESCRIPTOR
4367 f772 c6 32 LDB #2*25 ‘UNDEFINED FUNCTION CALL’ ERROR
4368 f774 ae 42 LDX $02,U POINT X TO ARGUMENT VARIABLE DESCRIPTOR
4369 f776 27 a9 BEQ L886E BRANCH TO ERROR HANDLER
4370 f778 10 9e 83 LDY CHARAD SAVE CURRENT INPUT POINTER IN Y
4371 f77b ee c4 LDU ,U * POINT U TO START OF FN FORMULA AND
4372 f77d df 83 STU CHARAD * SAVE IT IN INPUT POINTER
4373 f77f a6 04 LDA $04,X = GET FP VALUE OF
4374 f781 34 02 PSHS A = ARGUMENT VARIABLE, CURRENT INPUT
4375 f783 ec 84 LDD ,X = POINTER, AND ADDRESS OF START
4376 f785 ee 02 LDU $02,X = OF FN FORMULA AND SAVE
4377 f787 34 76 PSHS U,Y,X,B,A = THEM ON THE STACK
4378 f789 bd ee 7e JSR LBC35 PACK FPA0 AND SAVE IT IN (X)
4379 f78c bd e3 ca L88D9 JSR LB141 EVALUATE FN EXPRESSION
4380 f78f 35 76 PULS A,B,X,Y,U RESTORE REGISTERS
4381 f791 ed 84 STD ,X * GET THE FP
4382 f793 ef 02 STU $02,X * VALUE OF THE ARGUMENT
4383 f795 35 02 PULS A * VARIABLE OFF OF THE
4384 f797 a7 04 STA $04,X * STACK AND RE-SAVE IT
4385 f799 9d 82 JSR GETCCH GET FINAL CHARACTER OF THE FN FORMULA
4386 f79b 10 26 ed 61 LBNE LB277 ‘SYNTAX’ ERROR IF NOT END OF LINE
4387 f79f 10 9f 83 STY CHARAD RESTORE INPUT POINTER
4388 f7a2 39 L88EF RTS
4389
4390
4391
4392 * DEF USR
4393 f7a3 9d 7c L890F JSR GETNCH SKIP PAST SECOND BYTE OF DEF USR TOKEN
4394 f7a5 8d 09 BSR L891C GET FN NUMBER
4395 f7a7 34 10 PSHS X SAVE FN EXEC ADDRESS STORAGE LOC
4396 f7a9 8d 2d BSR L8944 CALCULATE EXEC ADDRESS
4397 f7ab 35 40 PULS U GET FN EXEC ADDRESS STORAGE LOC
4398 f7ad af c4 STX ,U SAVE EXEC ADDRESS
4399 f7af 39 RTS
4400 f7b0 5f L891C CLRB DEFAULT TO USR0 IF NO ARGUMENT
4401 f7b1 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
4402 f7b3 24 06 BCC L8927 BRANCH IF NOT NUMERIC
4403 f7b5 80 30 SUBA #'0' MASK OFF ASCII
4404 f7b7 1f 89 TFR A,B SAVE USR NUMBER IN ACCB
4405 f7b9 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
4406 f7bb 9e 8d L8927 LDX USRADR GET ADDRESS OF STORAGE LOCs FOR USR ADDRESS
4407 f7bd 58 ASLB X2 - 2 BYTES/USR ADDRESS
4408 f7be 3a ABX ADD OFFSET TO START ADDRESS OF STORAGE LOCs
4409 f7bf 39 RTS
4410 * PROCESS A USR CALL
4411 f7c0 8d ee L892C BSR L891C GET STORAGE LOC OF EXEC ADDRESS FOR USR N
4412 f7c2 ae 84 LDX ,X * GET EXEC ADDRESS AND
4413 f7c4 34 10 PSHS X * PUSH IT ONTO STACK
4414 f7c6 bd e4 eb JSR LB262 SYNTAX CHECK FOR ‘(‘ & EVALUATE EXPR
4415 f7c9 8e 00 4f LDX #FP0EXP POINT X TO FPA0
4416 f7cc 96 06 LDA VALTYP GET VARIABLE TYPE
4417 f7ce 27 07 BEQ L8943 BRANCH IF NUMERIC, STRING IF <> 0
4418 f7d0 bd e8 db JSR LB657 GET LENGTH & ADDRESS OF STRING VARIABLE
4419 f7d3 9e 52 LDX FPA0+2 GET POINTER TO STRING DESCRIPTOR
4420 f7d5 96 06 LDA VALTYP GET VARIABLE TYPE
4421 f7d7 39 L8943 RTS JUMP TO USR ROUTINE (PSHS X ABOVE)
4422 f7d8 c6 ae L8944 LDB #TOK_EQUALS TOKEN FOR ‘=‘
4423 f7da bd e4 f8 JSR LB26F DO A SYNTAX CHECK FOR =
4424 f7dd 7e e9 c1 JMP LB73D EVALUATE EXPRESSION, RETURN VALUE IN X
4425
4426
4427
4428 * DEL
4429 f7e0 10 27 ee ea DEL LBEQ LB44A FC’ ERROR IF NO ARGUMENT
4430 f7e4 bd e2 14 JSR LAF67 CONVERT A DECIMAL BASiC NUMBER TO BINARY
4431 f7e7 bd df a2 JSR LAD01 FIND RAM ADDRESS OF START OF A BASIC LINE
4432 f7ea 9f 93 STX VD3 SAVE RAM ADDRESS OF STARTING LINE NUMBER
4433 f7ec 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4434 f7ee 27 10 BEQ L8990 BRANCH IF END OF LINE
4435 f7f0 81 a7 CMPA #TOK_MINUS TOKEN FOR ‘-'
4436 f7f2 26 3b BNE L89BF TERMINATE COMMAND IF LINE NUMBER NOT FOLLOWED BY ‘-‘
4437 f7f4 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
4438 f7f6 27 04 BEQ L898C IF END OF LINE, USE DEFAULT ENDING LINE NUMBER
4439 f7f8 8d 24 BSR L89AE * CONVERT ENDING LINE NUMBER TO BINARY
4440 f7fa 20 04 BRA L8990 * AND SAVE IT IN BINVAL
4441 f7fc 86 ff L898C LDA #$FF = USE $FFXX AS DEFAULT ENDING
4442 f7fe 97 2b STA BINVAL = LINE NUMBER - SAVE IT IN BINVAL
4443 f800 de 93 L8990 LDU VD3 POINT U TO STARTING LINE NUMBER ADDRESS
4444 f802 8c L8992 FCB SKP2 SKIP TWO BYTES
4445 f803 ee c4 L8993 LDU ,U POINT U TO START OF NEXT LINE
4446 f805 ec c4 LDD ,U CHECK FOR END OF PROGRAM
4447 f807 27 06 BEQ L899F BRANCH IF END OF PROGRAM
4448 f809 ec 42 LDD $02,U LOAD ACCD WITH THIS LINE’S NUMBER
4449 f80b 93 2b SUBD BINVAL SUBTRACT ENDING LINE NUMBER ADDRESS
4450 f80d 23 f4 BLS L8993 BRANCH IF = < ENDING LINE NUMBER
4451 f80f 9e 93 L899F LDX VD3 GET STARTING LINE NUMBER
4452 f811 8d 15 BSR L89B8 MOVE (U) TO (X) UNTIL END OF PROGRAM
4453 f813 bd df c2 JSR LAD21 RESET BASIC’S INPUT POINTER AND ERASE VARIABLES
4454 f816 9e 93 LDX VD3 GET STARTING LINE NUMBER ADDRESS
4455 f818 bd df 92 JSR LACF1 RECOMPUTE START OF NEXT LINE ADDRESSES
4456 f81b 7e df 22 JMP LAC73 JUMP TO BASIC’S MAIN COMMAND LOOP
4457 f81e bd e2 14 L89AE JSR LAF67 GO GET LINE NUMBER CONVERTED TO BINARY
4458 f821 7e dc b7 JMP LA5C7 MAKE SURE THERE’S NO MORE ON THIS LINE
4459 f824 a6 c0 L89B4 LDA ,U+ GET A BYTE FROM (U)
4460 f826 a7 80 STA ,X+ MOVE THE BYTE TO (X)
4461 f828 11 93 1b L89B8 CMPU VARTAB COMPARE TO END OF BASIC
4462 f82b 26 f7 BNE L89B4 BRANCH IF NOT AT END
4463 f82d 9f 1b STX VARTAB SAVE (X) AS NEW END OF BASIC
4464 f82f 39 L89BF RTS
4465
4466
4467 f830 bd f7 19 L89C0 JSR L8866 ‘BS’ ERROR IF IN DIRECT MODE
4468 f833 9d 7c JSR GETNCH GET A CHAR FROM BASIC
4469 f835 81 22 L89D2 CMPA #'"' CHECK FOR PROMPT STRING
4470 f837 26 0b BNE L89E1 BRANCH IF NO PROMPT STRING
4471 f839 bd e4 cd JSR LB244 STRIP OFF PROMPT STRING & PUT IT ON STRING STACK
4472 f83c c6 3b LDB #';' *
4473 f83e bd e4 f8 JSR LB26F * DO A SYNTAX CHECK FOR;
4474 f841 bd eb e8 JSR LB99F REMOVE PROMPT STRING FROM STRING STACK & SEND TO CONSOLE OUT
4475 f844 32 7e L89E1 LEAS $-02,S RESERVE TWO STORAGE SLOTS ON STACK
4476 f846 bd e2 c9 JSR LB035 INPUT A LINE FROM CURRENT INPUT DEVICE
4477 f849 32 62 LEAS $02,S CLEAN UP THE STACK
4478 f84b bd e5 db JSR LB357 SEARCH FOR A VARIABLE
4479 f84e 9f 3b STX VARDES SAVE POINTER TO VARIABLE DESCRIPTOR
4480 f850 bd e3 cf JSR LB146 ‘TM’ ERROR IF VARIABLE TYPE = NUMERIC
4481 f853 8e 00 f3 LDX #LINBUF POINT X TO THE STRING BUFFER WHERE THE INPUT STRING WAS STORED
4482 f856 4f CLRA TERMINATOR CHARACTER 0 (END OF LINE)
4483 f857 bd e7 a0 JSR LB51A PARSE THE INPUT STRING AND STORE IT IN THE STRING SPACE
4484 f85a 7e e2 51 JMP LAFA4 REMOVE DESCRIPTOR FROM STRING STACK
4485 f85d bd e2 14 L89FC JSR LAF67 STRIP A DECIMAL NUMBER FROM BASIC INPUT LINE
4486 f860 9e 2b LDX BINVAL GET BINARY VALUE
4487 f862 39 RTS
4488 f863 9e 91 L8A02 LDX VD1 GET CURRENT OLD NUMBER BEING RENUMBERED
4489 f865 9f 2b L8A04 STX BINVAL SAVE THE LINE NUMBER BEING SEARCHED FOR
4490 f867 7e df a2 JMP LAD01 GO FIND THE LINE NUMBER IN BASIC PROGRAM
4491
4492 * RENUM
4493 f86a bd df c7 RENUM JSR LAD26 ERASE VARIABLES
4494 f86d cc 00 0a LDD #10 DEFAULT LINE NUMBER INTERVAL
4495 f870 dd 95 STD VD5 SAVE DEFAULT RENUMBER START LINE NUMBER
4496 f872 dd 8f STD VCF SAVE DEFAULT INTERVAL
4497 f874 5f CLRB NOW ACCD = 0
4498 f875 dd 91 STD VD1 DEFAULT LINE NUMBER OF WHERE TO START RENUMBERING
4499 f877 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4500 f879 24 06 BCC L8A20 BRANCH IF NOT NUMERIC
4501 f87b 8d e0 BSR L89FC CONVERT DECIMAL NUMBER IN BASIC PROGRAM TO BINARY
4502 f87d 9f 95 STX VD5 SAVE LINE NUMBER WHERE RENUMBERING STARTS
4503 f87f 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4504 f881 27 1b L8A20 BEQ L8A3D BRANCH IF END OF LINE
4505 f883 bd e4 f6 JSR LB26D SYNTAX CHECK FOR COMMA
4506 f886 24 06 BCC L8A2D BRANCH IF NEXT CHARACTER NOT NUMERIC
4507 f888 8d d3 BSR L89FC CONVERT DECIMAL NUMBER IN BASIC PROGRAM TO BINARY
4508 f88a 9f 91 STX VD1 SAVE NEW RENUMBER LINE
4509 f88c 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4510 f88e 27 0e L8A2D BEQ L8A3D BRANCH IF END OF LINE
4511 f890 bd e4 f6 JSR LB26D SYNTAX CHECK FOR COMMA
4512 f893 24 06 BCC L8A3A BRANCH IF NEXT CHARACTER NOT NUMERIC
4513 f895 8d c6 BSR L89FC CONVERT DECIMAL NUMBER IN BASIC PROGRAM TO BINARY
4514 f897 9f 8f STX VCF SAVE NEW INTERVAL
4515 f899 27 49 BEQ L8A83 ‘FC' ERROR
4516 f89b bd dc b7 L8A3A JSR LA5C7 CHECK FOR MORE CHARACTERS ON LINE - ‘SYNTAX’ ERROR IF ANY
4517 f89e 8d c3 L8A3D BSR L8A02 GO GET ADDRESS OF OLD NUMBER BEING RENUMBERED
4518 f8a0 9f 93 STX VD3 SAVE ADDRESS
4519 f8a2 9e 95 LDX VD5 GET NEXT RENUMBERED LINE NUMBER TO USE
4520 f8a4 8d bf BSR L8A04 FIND THE LINE NUMBER IN THE BASIC PROGRAM
4521 f8a6 9c 93 CMPX VD3 COMPARE TO ADDRESS OF OLD LINE NUMBER
4522 f8a8 25 3a BLO L8A83 ‘FC’ ERROR IF NEW ADDRESS < OLD ADDRESS
4523 f8aa 8d 1c BSR L8A67 MAKE SURE RENUMBERED LINE NUMBERS WILL BE IN RANGE
4524 f8ac bd f9 3e JSR L8ADD CONVERT ASCII LINE NUMBERS TO ‘EXPANDED’ BINARY
4525 f8af bd df 90 JSR LACEF RECALCULATE NEXT LINE RAM ADDRESSES
4526 f8b2 8d af BSR L8A02 GET RAM ADDRESS OF FIRST LINE TO BE RENUMBERED
4527 f8b4 9f 93 STX VD3 SAVE IT
4528 f8b6 8d 3a BSR L8A91 MAKE SURE LINE NUMBERS EXIST
4529 f8b8 8d 0f BSR L8A68 INSERT NEW LINE NUMBERS IN LINE HEADERS
4530 f8ba 8d 36 BSR L8A91 INSERT NEW LINE NUMBERS IN PROGRAM STATEMENTS
4531 f8bc bd f9 d9 JSR L8B7B CONVERT PACKED BINARY LINE NUMBERS TO ASCII
4532 f8bf bd df c7 JSR LAD26 ERASE VARIABLES
4533 f8c2 bd df 90 JSR LACEF RECALCULATE NEXT LINE RAM ADDRESS
4534 f8c5 7e df 22 JMP LAC73 GO BACK TO BASIC’S MAIN LOOP
4535 f8c8 86 L8A67 FCB SKP1LD SKIP ONE BYTE - LDA #$4F
4536 f8c9 4f L8A68 CLRA NEW LINE NUMBER FLAG - 0; INSERT NEW LINE NUMBERS
4537 f8ca 97 98 STA VD8 SAVE NEW LINE NUMBER FLAG; 0 = INSERT NEW NUMBERS
4538 f8cc 9e 93 LDX VD3 GET ADDRESS OF OLD LINE NUMBER BEING RENUMBERED
4539 f8ce dc 95 LDD VD5 GET THE CURRENT RENUMBERED LINE NUMBER
4540 f8d0 8d 15 BSR L8A86 RETURN IF END OF PROGRAM
4541 f8d2 0d 98 L8A71 TST VD8 CHECK NEW LINE NUMBER FLAG
4542 f8d4 26 02 BNE L8A77 BRANCH IF NOT INSERTING NEW LINE NUMBERS
4543 f8d6 ed 02 STD $02,X STORE THE NEW LINE NUMBER IN THE BASIC PROGRAM
4544 f8d8 ae 84 L8A77 LDX ,X POINT X TO THE NEXT LINE IN BASIC
4545 f8da 8d 0b BSR L8A86 RETURN IF END OF PROGRAM
4546 f8dc d3 8f ADDD VCF ADD INTERVAL TO CURRENT RENUMBERED LINE NUMBER
4547 f8de 25 04 BLO L8A83 ‘FC’ ERROR IF LINE NUMBER > $FFFF
4548 f8e0 81 fa CMPA #MAXLIN LARGEST LINE NUMBER = $F9FF
4549 f8e2 25 ee BLO L8A71 BRANCH IF LEGAL LINE NUMBER
4550 f8e4 7e e6 ce L8A83 JMP LB44A ‘FC’ ERROR IF LINE NUMBER MS BYTE > $F9
4551 * TEST THE TWO BYTES POINTED TO BY (X).
4552 * NORMAL RETURN IF <> 0. IF = 0 (END OF
4553 * PROGRAM) RETURN IS PULLED OFF STACK AND
4554 * YOU RETURN TO PREVIOUS SUBROUTINE CALL.
4555 f8e7 34 06 L8A86 PSHS B,A SAVE ACCD
4556 f8e9 ec 84 LDD ,X TEST THE 2 BYTES POINTED TO BY X
4557 f8eb 35 06 PULS A,B RESTORE ACCD
4558 f8ed 26 02 BNE L8A90 BRANCH IF NOT END OF PROGRAM
4559 f8ef 32 62 LEAS $02,S PURGE RETURN ADDRESS FROM STACK
4560 f8f1 39 L8A90 RTS
4561 f8f2 9e 19 L8A91 LDX TXTTAB GET START OF BASIC PROGRAM
4562 f8f4 30 1f LEAX $-01,X MOVE POINTER BACK ONE
4563 f8f6 30 01 L8A95 LEAX $01,X MOVE POINTER UP ONE
4564 f8f8 8d ed BSR L8A86 RETURN IF END OF PROGRAM
4565 f8fa 30 03 L8A99 LEAX $03,X SKIP OVER NEXT LINE ADDRESS AND LINE NUMBER
4566 f8fc 30 01 L8A9B LEAX $01,X MOVE POINTER TO NEXT CHARACTER
4567 f8fe a6 84 LDA ,X CHECK CURRENT CHARACTER
4568 f900 27 f4 BEQ L8A95 BRANCH IF END OF LINE
4569 f902 9f 0f STX TEMPTR SAVE CURRENT POINTER
4570 f904 4a DECA =
4571 f905 27 0c BEQ L8AB2 =BRANCH IF START OF PACKED NUMERIC LINE
4572 f907 4a DECA *
4573 f908 27 2a BEQ L8AD3 *BRANCH IF LINE NUMBER EXISTS
4574 f90a 4a DECA =
4575 f90b 26 ef BNE L8A9B =MOVE TO NEXT CHARACTER IF > 3
4576 f90d 86 03 L8AAC LDA #$03 * SET 1ST BYTE = 3 TO INDICATE LINE
4577 f90f a7 80 STA ,X+ * NUMBER DOESN’T CURRENTLY EXIST
4578 f911 20 e7 BRA L8A99 GO GET ANOTHER CHARACTER
4579 f913 ec 01 L8AB2 LDD $01,X GET MS BYTE OF LINE NUMBER
4580 f915 6a 02 DEC $02,X DECREMENT ZERO CHECK BYTE
4581 f917 27 01 BEQ L8AB9 BRANCH IF MS BYTE <> 0
4582 f919 4f CLRA CLEAR MS BYTE
4583 f91a e6 03 L8AB9 LDB $03,X GET LS BYTE OF LINE NUMBER
4584 f91c 6a 04 DEC $04,X DECREMENT ZERO CHECK FLAG
4585 f91e 27 01 BEQ L8AC0 BRANCH IF IS BYTE <> 0
4586 f920 5f CLRB CLEAR LS BYTE
4587 f921 ed 01 L8AC0 STD $01,X SAVE BINARY LINE NUMBER
4588 f923 dd 2b STD BINVAL SAVE TRIAL LINE NUMBER
4589 f925 bd df a2 JSR LAD01 FIND RAM ADDRESS OF A BASIC LINE NUMBER
4590 f928 9e 0f L8AC7 LDX TEMPTR GET BACK POINTER TO START OF PACKED LINE NUMBER
4591 f92a 25 e1 BLO L8AAC BRANCH IF NO LINE NUMBER MATCH FOUND
4592 f92c dc 47 LDD V47 GET START ADDRESS OF LINE NUMBER
4593 f92e 6c 80 INC ,X+ * SET 1ST BYTE = 2, TO INDICATE LINE NUMBER EXISTS IF CHECKING FOR
4594 * * EXISTENCE OF LINE NUMBER, SET IT = 1 IF INSERTING LINE NUMBERS
4595
4596 f930 ed 84 STD ,X SAVE RAM ADDRESS OF CORRECT LINE NUMBER
4597 f932 20 c6 BRA L8A99 GO GET ANOTHER CHARACTER
4598 f934 6f 84 L8AD3 CLR ,X CLEAR CARRY FLAG AND 1ST BYTE
4599 f936 ae 01 LDX $01,X POINT X TO RAM ADDRESS OF CORRECT LINE NUMBER
4600 f938 ae 02 LDX $02,X PUT CORRECT LINE NUMBER INTO (X)
4601 f93a 9f 47 STX V47 SAVE IT TEMPORARILY
4602 f93c 20 ea BRA L8AC7 GO INSERT IT INTO BASIC LINE
4603 f93e 9e 19 L8ADD LDX TXTTAB GET BEGINNING OF BASIC PROGRAM
4604 f940 20 04 BRA L8AE5
4605 f942 9e 83 L8AE1 LDX CHARAD *GET CURRENT INPUT POINTER
4606 f944 30 01 LEAX $01,X *AND BUMP IT ONE
4607 f946 8d 9f L8AE5 BSR L8A86 RETURN IF END OF PROGRAM
4608 f948 30 02 LEAX $02,X SKIP PAST NEXT LINE ADDRESS
4609 f94a 30 01 L8AE9 LEAX $01,X ADVANCE POINTER BY ONE
4610 f94c 9f 83 L8AEB STX CHARAD SAVE NEW BASIC INPUT POINTER
4611 f94e 9d 7c L8AED JSR GETNCH GET NEXT CHARACTER FROM BASIC
4612 f950 4d L8AEF TSTA CHECK THE CHARACTER
4613 f951 27 ef BEQ L8AE1 BRANCH IF END OF LINE
4614 f953 2a f9 BPL L8AED BRANCH IF NOT A TOKEN
4615 f955 9e 83 LDX CHARAD GET CURRENT INPUT POINTER
4616 f957 81 ff CMPA #$FF IS THIS A SECONDARY TOKEN?
4617 f959 27 ef BEQ L8AE9 YES - IGNORE IT
4618 f95b 81 a2 CMPA #TOK_THEN TOKEN FOR THEN?
4619 f95d 27 12 BEQ L8B13 YES
4620 f95f 81 84 CMPA #TOK_ELSE TOKEN FOR ELSE?
4621 f961 27 0e BEQ L8B13 YES
4622 f963 81 81 CMPA #TOK_GO TOKEN FOR GO?
4623 f965 26 e7 BNE L8AED NO
4624 f967 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
4625 f969 81 a0 CMPA #TOK_TO TOKEN FOR TO?
4626 f96b 27 04 BEQ L8B13 YES
4627 f96d 81 a1 CMPA #TOK_SUB TOKEN FOR SUB?
4628 f96f 26 db BNE L8AEB NO
4629 f971 9d 7c L8B13 JSR GETNCH GET A CHARACTER FROM BASIC
4630 f973 25 04 BLO L8B1B BRANCH IF NUMERIC
4631 f975 9d 82 L8B17 JSR GETCCH GET CURRENT BASIC INPUT CHARRACTER
4632 f977 20 d7 BRA L8AEF KEEP CHECKING THE LINE
4633 f979 9e 83 L8B1B LDX CHARAD GET CURRENT INPUT ADDRESS
4634 f97b 34 10 PSHS X SAVE IT ON THE STACK
4635 f97d bd e2 14 JSR LAF67 CONVERT DECIMAL BASIC NUMBER TO BINARY
4636 f980 9e 83 LDX CHARAD GET CURRENT INPUT POINTER
4637 f982 a6 82 L8B24 LDA ,-X GET PREVIOUS INPUT CHARACTER
4638 f984 bd fc e9 JSR L90AA CLEAR CARRY IF NUMERIC INPUT VALUE
4639 f987 25 f9 BLO L8B24 BRANCH IF NON-NUMERIC
4640 f989 30 01 LEAX $01,X MOVE POINTER UP ONE
4641 f98b 1f 10 TFR X,D NOW ACCD POINTS TO ONE PAST END OF LINE NUMBER
4642 f98d e0 61 SUBB $01,S SUBTRACT PRE-NUMERIC POINTER LS BYTE
4643 f98f c0 05 SUBB #$05 MAKE SURE THERE ARE AT LEAST 5 CHARACTERS IN THE NUMERIC LINE
4644 *
4645 f991 27 20 BEQ L8B55 BRANCH IF EXACTLY 5
4646 f993 25 0a BLO L8B41 BRANCH IF < 5
4647 f995 33 84 LEAU ,X TRANSFER X TO U
4648 f997 50 NEGB NEGATE B
4649 f998 30 85 LEAX B,X MOVE X BACK B BYTES
4650 f99a bd f8 28 JSR L89B8 *MOVE BYTES FROM (U) TO (X) UNTIL
4651 * *U = END OF BASIC; (I) = NEW END OF BASIC
4652 f99d 20 14 BRA L8B55
4653 * FORCE FIVE BYTES OF SPACE FOR THE LINE NUMBER
4654 f99f 9f 47 L8B41 STX V47 SAVE END OF NUMERIC VALUE
4655 f9a1 9e 1b LDX VARTAB GET END OF BASIC PROGRAM
4656 f9a3 9f 43 STX V43 SAVE IT
4657 f9a5 50 NEGB NEGATE B
4658 f9a6 30 85 LEAX B,X ADD IT TO END OF NUMERIC POiNTER
4659 f9a8 9f 41 STX V41 SAVE POINTER
4660 f9aa 9f 1b STX VARTAB STORE END OF BASIC PROGRAM
4661 f9ac bd de db JSR LAC1E ACCD = TOP OF ARRAYS - CHECK FOR ENOUGH ROOM
4662 f9af 9e 45 LDX V45 * GET AND SAVE THE
4663 f9b1 9f 83 STX CHARAD * NEW CURRENT INPUT POINTER
4664 f9b3 35 10 L8B55 PULS X RESTORE POINTER TO START OF NUMERIC VALUE
4665 f9b5 86 01 LDA #$01 NEW LINE NUMBER FLAG
4666 f9b7 a7 84 STA ,X * SAVE NEW LINE FLAG
4667 f9b9 a7 02 STA $02,X *
4668 f9bb a7 04 STA $04,X *
4669 f9bd d6 2b LDB BINVAL GET MS BYTE OF BINARY LINE NUMBER
4670 f9bf 26 04 BNE L8B67 BRANCH IF IT IS NOT ZERO
4671 f9c1 c6 01 LDB #$01 SAVE A 1 IF BYTE IS 0; OTHERWISE, BASIC WILL
4672 * THINK IT IS THE END OF A LINE
4673 f9c3 6c 02 INC $02,X IF 2,X = 2, THEN PREVIOUS BYTE WAS A ZERO
4674 f9c5 e7 01 L8B67 STB $01,X SAVE MS BYTE OF BINARY LINE NUMBER
4675 f9c7 d6 2c LDB BINVAL+1 GET IS BYTE OF BINARY LINE NUMBER
4676 f9c9 26 04 BNE L8B71 BRANCH IF NOT A ZERO BYTE
4677 f9cb c6 01 LDB #$01 SAVE A 1 IF BYTE IS A 0
4678 f9cd 6c 04 INC $04,X IF 4,X = 2, THEN PREVIOUS BYTE WAS A 0
4679 f9cf e7 03 L8B71 STB $03,X SAVE LS BYTE OF BINARY LINE NUMBER
4680 f9d1 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4681 f9d3 81 2c CMPA #',' IS IT A COMMA?
4682 f9d5 27 9a BEQ L8B13 YES - PROCESS ANOTHER NUMERIC VALUE
4683 f9d7 20 9c BRA L8B17 NO - GO GET AND PROCESS AN INPUT CHARACTER
4684 f9d9 9e 19 L8B7B LDX TXTTAB POINT X TO START OF BASIC PROGRAM
4685 f9db 30 1f LEAX $-01,X MOVE POINTER BACK ONE
4686 f9dd 30 01 L8B7F LEAX $01,X MOVE POINTER UP ONE
4687 f9df ec 02 LDD $02,X GET ADDRESS OF NEXT LINE
4688 f9e1 dd 68 STD CURLIN SAVE IT IN CURLIN
4689 f9e3 bd f8 e7 JSR L8A86 RETURN IF END OF PROGRAM
4690 f9e6 30 03 LEAX $03,X SKIP OVER ADDRESS OF NEXT LINE AND 1ST BYTE OF LINE NUMBER
4691 f9e8 30 01 L8B8A LEAX $01,X MOVE POINTER UP ONE
4692 f9ea a6 84 L8B8C LDA ,X GET CURRENT CHARACTER
4693 f9ec 27 ef BEQ L8B7F BRANCH IF END OF LINE
4694 f9ee 4a DECA INPUT CHARACTER = 1? - VALID LINE NUMBER
4695 f9ef 27 1b BEQ L8BAE YES
4696 f9f1 80 02 SUBA #$02 INPUT CHARACTER 3? - UL LINE NUMBER
4697 f9f3 26 f3 BNE L8B8A NO
4698 f9f5 34 10 PSHS X SAVE CURRENT POSITION OF INPUT POINTER
4699 f9f7 8e fa 36 LDX #L8BD9-1 POINT X TO ‘UL’ MESSAGE
4700 f9fa bd eb e5 JSR LB99C PRINT STRING TO THE SCREEN
4701 f9fd ae e4 LDX ,S GET INPUT POINTER
4702 f9ff ec 01 LDD $01,X GET THE UNDEFINED LINE NUMBER
4703 fa01 bd f0 15 JSR LBDCC CONVERT NUMBER IN ACCD TO DECIMAL AND DISPLAY IT
4704 fa04 bd f0 0e JSR LBDC5 PRINT ‘IN XXXX’ XXXX = CURRENT LINE NUMBER
4705 fa07 bd eb a5 JSR LB958 SEND A CR TO CONSOLE OUT
4706 fa0a 35 10 PULS X GET INPUT POINTER BACK
4707 fa0c 34 10 L8BAE PSHS X SAVE CURRENT POSITION OF INPUT POINTER
4708 fa0e ec 01 LDD $01,X LOAD ACCD WITH BINARY VALUE OF LINE NUMBER
4709 fa10 dd 52 STD FPA0+2 SAVE IN BOTTOM 2 BYTES OF FPA0
4710 fa12 bd f6 c1 JSR L880E ADJUST REST OF FPA0 AS AN INTEGER
4711 fa15 bd f0 22 JSR LBDD9 CONVERT FPA0 TO ASCII, STORE IN LINE NUMBER
4712 fa18 35 40 PULS U LOAD U WITH PREVIOUS ADDRESS OF INPUT POINTER
4713 fa1a c6 05 LDB #$05 EACH EXPANDED LINE NUMBER USES 5 BYTES
4714 fa1c 30 01 L8BBE LEAX $01,X MOVE POINTER FORWARD ONE
4715 fa1e a6 84 LDA ,X GET AN ASCII BYTE
4716 fa20 27 05 BEQ L8BC9 BRANCH IF END OF NUMBER
4717 fa22 5a DECB DECREMENT BYTE COUNTER
4718 fa23 a7 c0 STA ,U+ STORE ASCII NUMBER IN BASIC LINE
4719 fa25 20 f5 BRA L8BBE CHECK FOR ANOTHER DIGIT
4720 fa27 30 c4 L8BC9 LEAX ,U TRANSFER NEW LINE POINTER TO (X)
4721 fa29 5d TSTB DOES THE NEW LINE NUMBER REQUIRE 5 BYTES?
4722 fa2a 27 be BEQ L8B8C YES - GO GET ANOTHER INPUT CHARACTER
4723 fa2c 31 c4 LEAY ,U SAVE NEW LINE POINTER IN Y
4724 fa2e 33 c5 LEAU B,U POINT U TO END OF 5 BYTE PACKED LINE NUMBER BLOCK
4725 fa30 bd f8 28 JSR L89B8 MOVE BYTES FROM (U) TO (X) UNTIL END OF PROGRAM
4726 fa33 30 a4 LEAX ,Y LOAD (X) WITH NEW LINE POINTER
4727 fa35 20 b3 BRA L8B8C GO GET ANOTHER INPUT CHARACTER
4728
4729 fa37 55 4c 20 L8BD9 FCC "UL " UNKNOWN LINE NUMBER MESSAGE
4730 fa3a 00 FCB 0
4731
4732
4733 fa3b bd e9 c4 HEXDOL JSR LB740 CONVERT FPA0 INTO A POSITIVE 2 BYTE INTEGER
4734 fa3e 8e 01 f0 LDX #STRBUF+2 POINT TO TEMPORARY BUFFER
4735 fa41 c6 04 LDB #$04 CONVERT 4 NIBBLES
4736 fa43 34 04 L8BE5 PSHS B SAVE NIBBLE COUNTER
4737 fa45 5f CLRB CLEAR CARRY FLAG
4738 fa46 86 04 LDA #$04 4 SHIFTS
4739 fa48 08 53 L8BEA ASL FPA0+3 * SHIFT BOTTOM TWO BYTES OF
4740 fa4a 09 52 ROL FPA0+2 * FPA0 LEFT ONE BIT (X2)
4741 fa4c 59 ROLB IF OVERFLOW, ACCB <> 0
4742 fa4d 4a DECA * DECREMENT SHIFT COUNTER AND
4743 fa4e 26 f8 BNE L8BEA * BRANCH IF NOT DONE
4744 fa50 5d TSTB CHECK FOR OVERFLOW
4745 fa51 26 0a BNE L8BFF BRANCH IF OVERFLOW
4746 fa53 a6 e4 LDA ,S * GET NIBBLE COUNTER,
4747 fa55 4a DECA * DECREMENT IT AND
4748 fa56 27 05 BEQ L8BFF * BRANCH IF DONE
4749 fa58 8c 01 f0 CMPX #STRBUF+2 DO NOT DO A CONVERSION UNTIL A NON-ZERO
4750 fa5b 27 0c BEQ L8C0B BYTE IS FOUND - LEADING ZERO SUPPRESSION
4751 fa5d cb 30 L8BFF ADDB #'0' ADD IN ASCII ZERO
4752 fa5f c1 39 CMPB #'9' COMPARE TO ASCII 9
4753 fa61 23 02 BLS L8C07 BRANCH IF < 9
4754 fa63 cb 07 ADDB #7 ADD ASCII OFFSET IF HEX LETTER
4755 fa65 e7 80 L8C07 STB ,X+ STORE HEX VALUE AND ADVANCE POINTER
4756 fa67 6f 84 CLR ,X CLEAR NEXT BYTE - END OF STRING FLAG
4757 fa69 35 04 L8C0B PULS B * GET NIBBLE COUNTER,
4758 fa6b 5a DECB * DECREMENT IT AND
4759 fa6c 26 d5 BNE L8BE5 * BRANCH IF NOT DONE
4760 fa6e 32 62 LEAS $02,S PURGE RETURN ADDRESS OFF OF STACK
4761 fa70 8e 01 ef LDX #STRBUF+1 RESET POINTER
4762 fa73 7e e7 9c JMP LB518 SAVE STRING ON STRING STACK
4763 * PROCESS EXCLAMATION POINT
4764 fa76 86 01 L8E37 LDA #$01 * SET SPACES
4765 fa78 97 99 STA VD9 * COUNTER = 1
4766 * PROCESS STRING ITEM - LIST
4767 fa7a 5a L8E3B DECB DECREMENT FORMAT STRING LENGTH COUNTER
4768 fa7b bd fc 17 JSR L8FD8 SEND A '+' TO CONSOLE OUT IF VDA <>0
4769 fa7e 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4770 fa80 10 27 00 93 LBEQ L8ED8 EXIT PRINT USING IF END OF LINE
4771 fa84 d7 93 STB VD3 SAVE REMAINDER FORMAT STRING LENGTH
4772 fa86 bd e3 df JSR LB156 EVALUATE EXPRESSION
4773 fa89 bd e3 cf JSR LB146 ‘TM’ ERROR IF NUMERIC VARIABLE
4774 fa8c 9e 52 LDX FPA0+2 * GET ITEM - LIST DESCRIPTOR ADDRESS
4775 fa8e 9f 4d STX V4D * AND SAVE IT IN V4D
4776 fa90 d6 99 LDB VD9 GET SPACES COUNTER
4777 fa92 bd e9 31 JSR LB6AD PUT ACCB BYTES INTO STRING SPACE & PUT DESCRIPTOR ON STRING STACK
4778 fa95 bd eb e8 JSR LB99F PRINT THE FORMATTED STRING TO CONSOLE OUT
4779 * PAD FORMAT STRING WITH SPACES IF ITEM - LIST STRING < FORMAT STRING LENGTH
4780 fa98 9e 52 LDX FPA0+2 POINT X TO FORMATTED STRING DESCRIPTOR ADDRESS
4781 fa9a d6 99 LDB VD9 GET SPACES COUNTER
4782 fa9c e0 84 SUBB ,X SUBTRACT LENGTH OF FORMATTED STRING
4783 fa9e 5a L8E5F DECB DECREMENT DIFFERENCE
4784 fa9f 10 2b 01 4f LBMI L8FB3 GO INTERPRET ANOTHER ITEM - LIST
4785 faa3 bd eb f5 JSR LB9AC PAD FORMAT STRING WITH A SPACE
4786 faa6 20 f6 BRA L8E5F KEEP PADDING
4787 * PERCENT SIGN - PROCESS A %SPACES% COMMAND
4788 faa8 d7 93 L8E69 STB VD3 * SAVE THE CURRENT FORMAT STRING
4789 faaa 9f 0f STX TEMPTR * COUNTER AND POINTER
4790 faac 86 02 LDA #$02 INITIAL SPACES COUNTER = 2
4791 faae 97 99 STA VD9 SAVE IN SPACES COUNTER
4792 fab0 a6 84 L8E71 LDA ,X GET A CHARACTER FROM FORMAT STRING
4793 fab2 81 25 CMPA #'%' COMPARE TO TERMINATOR CHARACTER
4794 fab4 27 c4 BEQ L8E3B BRANCH IF END OF SPACES COMMAND
4795 fab6 81 20 CMPA #' ' BLANK
4796 fab8 26 07 BNE L8E82 BRANCH IF ILLEGAL CHARACTER
4797 faba 0c 99 INC VD9 ADD ONE TO SPACES COUNTER
4798 fabc 30 01 LEAX $01,X MOVE FORMAT POINTER UP ONE
4799 fabe 5a DECB DECREMENT LENGTH COUNTER
4800 fabf 26 ef BNE L8E71 BRANCH IF NOT END OF FORMAT STRING
4801 fac1 9e 0f L8E82 LDX TEMPTR * RESTORE CURRENT FORMAT STRING COUNTER
4802 fac3 d6 93 LDB VD3 * AND POINTER TO POSITION BEFORE SPACES COMMAND
4803 fac5 86 25 LDA #'%' SEND A ‘%’ TO CONSOLE OUT AS A DEBUGGING AID
4804 * ERROR PROCESSOR - ILLEGAL CHARACTER OR BAD SYNTAX IN FORMAT STRING
4805 fac7 bd fc 17 L8E88 JSR L8FD8 SEND A ‘+' TO CONSOLE OUT IF VDA <> 0
4806 faca bd db 14 JSR PUTCHR SEND CHARACTER TO CONSOLE OUT
4807 facd 20 29 BRA L8EB9 GET NEXT CHARACTER IN FORMAT STRING
4808
4809 * PRINT RAM HOOK
4810 facf 81 b1 XVEC9 CMPA #TOK_USING USING TOKEN
4811 fad1 27 01 BEQ L8E95 BRANCH IF PRINT USING
4812 fad3 39 RTS
4813
4814 * PRINT USING
4815 * VDA IS USED AS A STATUS BYTE: BIT 6 = COMMA FORCE
4816 * BIT 5=LEADING ASTERISK FORCE; BIT 4 = FLOATING $ FORCE
4817 * BIT 3 = PRE SIGN FORCE; BIT 2 = POST SIGN FORCE; BIT 0 = EXPONENTIAL FORCE
4818 fad4 32 62 L8E95 LEAS $02,S PURGE RETURN ADDRESS OFF THE STACK
4819 fad6 bd e3 e1 JSR LB158 EVALUATE FORMAT STRING
4820 fad9 bd e3 cf JSR LB146 ‘TM’ ERROR IF VARIABLE TYPE = NUMERIC
4821 fadc c6 3b LDB #';' CHECK FOR ITEM LIST SEPARATOR
4822 fade bd e4 f8 JSR LB26F SYNTAX CHECK FOR ;
4823 fae1 9e 52 LDX FPA0+2 * GET FORMAT STRING DESCRIPTOR ADDRESS
4824 fae3 9f 95 STX VD5 * AND SAVE IT IN VD5
4825 fae5 20 06 BRA L8EAE GO PROCESS FORMAT STRING
4826 fae7 96 97 L8EA8 LDA VD7 *CHECK NEXT PRINT ITEM FLAG AND
4827 fae9 27 08 BEQ L8EB4 *‘FC’ ERROR IF NO FURTHER PRINT ITEMS
4828 faeb 9e 95 LDX VD5 RESET FORMAT STRING POINTER TO START OF STRING
4829 faed 0f 97 L8EAE CLR VD7 RESET NEXT PRINT ITEM FLAG
4830 faef e6 84 LDB ,X GET LENGTH OF FORMAT STRING
4831 faf1 26 03 BNE L8EB7 INTERPRET FORMAT STRING IF LENGTH > 0
4832 faf3 7e e6 ce L8EB4 JMP LB44A ‘FC’ ERROR IF FORMAT STRING = NULL
4833 faf6 ae 02 L8EB7 LDX $02,X POINT X TO START OF FORMAT STRING
4834 * INTERPRET THE FORMAT STRING
4835 faf8 0f 9a L8EB9 CLR VDA CLEAR THE STATUS BYTE
4836 fafa 0f 99 L8EBB CLR VD9 CLEAR LEFT DIGIT COUNTER
4837 fafc a6 80 LDA ,X+ GET A CHARACTER FROM FORMAT STRING
4838 fafe 81 21 CMPA #'!' EXCLAMATION POINT?
4839 fb00 10 27 ff 72 LBEQ L8E37 YES - STRING TYPE FORMAT
4840 fb04 81 23 CMPA #'#' NUMBER SIGN? (DIGIT LOCATOR)
4841 fb06 27 5b BEQ L8F24 YES - NUMERIC TYPE FORMAT
4842 fb08 5a DECB DECREMENT FORMAT STRING LENGTH
4843 fb09 26 16 BNE L8EE2 BRANCH IF NOT DONE
4844 fb0b bd fc 17 JSR L8FD8 SEND A ‘+‘ TO CONSOLE OUT IF VDA <> 0
4845 fb0e bd db 14 JSR PUTCHR SEND CHARACTER TO CONSOLE OUT
4846 fb11 9d 82 L8ED2 JSR GETCCH GET CURRENT CHARACTER FROM BASIC
4847 fb13 26 d2 BNE L8EA8 BRANCH IF NOT END OF LINE
4848 fb15 96 97 LDA VD7 GET NEXT PRINT ITEM FLAG
4849 fb17 26 03 L8ED8 BNE L8EDD BRANCH IF MORE PRINT ITEMS
4850 fb19 bd eb a5 JSR LB958 SEND A CARRIAGE RETURN TO CONSOLE OUT
4851 fb1c 9e 95 L8EDD LDX VD5 POINT X TO FORMAT STRING DESCRIPTOR
4852 fb1e 7e e8 dd JMP LB659 RETURN ADDRESS AND LENGTH OF FORMAT STRING - EXIT PRINT USING
4853 fb21 81 2b L8EE2 CMPA #'+' CHECK FOR ‘+‘ (PRE-SIGN FORCE)
4854 fb23 26 09 BNE L8EEF NO PLUS
4855 fb25 bd fc 17 JSR L8FD8 SEND A ‘+' TO CONSOLE OUT IF VDA <> 0
4856 fb28 86 08 LDA #$08 * LOAD THE STATUS BYTE WITH 8;
4857 fb2a 97 9a STA VDA * PRE-SIGN FORCE FLAG
4858 fb2c 20 cc BRA L8EBB INTERPRET THE REST OF THE FORMAT STRING
4859 fb2e 81 2e L8EEF CMPA #'.' DECIMAL POINT?
4860 fb30 27 4e BEQ L8F41 YES
4861 fb32 81 25 CMPA #'%' PERCENT SIGN?
4862 fb34 10 27 ff 70 LBEQ L8E69 YES
4863 fb38 a1 84 CMPA ,X COMPARE THE PRESENT FORMAT STRING INPUT
4864 * CHARACTER TO THE NEXT ONE IN THE STRING
4865 fb3a 26 8b L8EFB BNE L8E88 NO MATCH - ILLEGAL CHARACTER
4866 * TWO CONSECUTIVE EQUAL CHARACTERS IN FORMAT STRING
4867 fb3c 81 24 CMPA #'$' DOLLAR SIGN?
4868 fb3e 27 19 BEQ L8F1A YES - MAKE THE DOLLAR SIGN FLOAT
4869 fb40 81 2a CMPA #'*' ASTERISK?
4870 fb42 26 f6 BNE L8EFB NO - ILLEGAL CHARACTER
4871 fb44 96 9a LDA VDA * GRAB THE STATUS BYTE AND BET BIT 5
4872 fb46 8a 20 ORA #$20 * TO INDICATE THAT THE OUTPUT WILL
4873 fb48 97 9a STA VDA * BE LEFT PADDED WITH ASTERISKS
4874 fb4a c1 02 CMPB #2 * CHECK TO SEE IF THE $$ ARE THE LAST TWO
4875 fb4c 25 11 BLO L8F20 * CHARACTERS IN THE FORMAT STRING AND BRANCH IF SO
4876 fb4e a6 01 LDA $01,X GET THE NEXT CHARACTER AFTER **
4877 fb50 81 24 CMPA #'$' CHECK FOR **$
4878 fb52 26 0b BNE L8F20 CHECK FOR MORE CHARACTERS
4879 fb54 5a DECB DECREMENT STRING LENGTH COUNTER
4880 fb55 30 01 LEAX $01,X MOVE FORMAT STRING POINTER UP ONE
4881 fb57 0c 99 INC VD9 ADD ONE TO LEFT DIGIT COUNTER - FOR ASTERISK PAD AND
4882 * FLOATING DOLLAR SIGN COMBINATION
4883 fb59 96 9a L8F1A LDA VDA * GET THE STATUS BYTE AND SET
4884 fb5b 8a 10 ORA #$10 * BIT 4 TO INDICATE A
4885 fb5d 97 9a STA VDA * FLOATING DOLLAR SIGN
4886 fb5f 30 01 L8F20 LEAX $01,X MOVE FORMAT STRING POINTER UP ONE
4887 fb61 0c 99 INC VD9 ADD ONE TO LEFT DIGIT (FLOATING $ OR ASTERISK PAD)
4888 * PROCESS CHARACTERS TO THE LEFT OF THE DECIMAL POINT IN THE FORMAT STRING
4889 fb63 0f 98 L8F24 CLR VD8 CLEAR THE RIGHT DIGIT COUNTER
4890 fb65 0c 99 L8F26 INC VD9 ADD ONE TO LEFT DIGIT COUNTER
4891 fb67 5a DECB DECREMENT FORMAT STRING LENGTH COUNTER
4892 fb68 27 49 BEQ L8F74 BRANCH IF END OF FORMAT STRING
4893 fb6a a6 80 LDA ,X+ GET THE NEXT FORMAT CHARACTER
4894 fb6c 81 2e CMPA #'.' DECIMAL POINT?
4895 fb6e 27 1e BEQ L8F4F YES
4896 fb70 81 23 CMPA #'#' NUMBER SIGN?
4897 fb72 27 f1 BEQ L8F26 YES
4898 fb74 81 2c CMPA #',' COMMA?
4899 fb76 26 21 BNE L8F5A NO
4900 fb78 96 9a LDA VDA * GET THE STATUS BYTE
4901 fb7a 8a 40 ORA #$40 * AND SET BIT 6 WHICH IS THE
4902 fb7c 97 9a STA VDA * COMMA SEPARATOR FLAG
4903 fb7e 20 e5 BRA L8F26 PROCESS MORE CHARACTERS TO LEFT OF DECIMAL POINT
4904 * PROCESS DECIMAL POINT IF NO DIGITS TO LEFT OF IT
4905 fb80 a6 84 L8F41 LDA ,X GET NEXT FORMAT CHARACTER
4906 fb82 81 23 CMPA #'#' IS IT A NUMBER SIGN?
4907 fb84 10 26 ff 3f LBNE L8E88 NO
4908 fb88 86 01 LDA #1 * SET THE RIGHT DIGIT COUNTER TO 1 -
4909 fb8a 97 98 STA VD8 * ALLOW ONE SPOT FOR DECIMAL POINT
4910 fb8c 30 01 LEAX $01,X MOVE FORMAT POINTER UP ONE
4911 * PROCESS DIGITS TO RIGHT OF DECIMAL POINT
4912 fb8e 0c 98 L8F4F INC VD8 ADD ONE TO RIGHT DIGIT COUNTER
4913 fb90 5a DECB DECREMENT FORMAT LENGTH COUNTER
4914 fb91 27 20 BEQ L8F74 BRANCH IF END OF FORMAT STRING
4915 fb93 a6 80 LDA ,X+ GET A CHARACTER FROM FORMAT STRING
4916 fb95 81 23 CMPA #'#' IS IT NUMBER SIGN?
4917 fb97 27 f5 BEQ L8F4F YES - KEEP CHECKING
4918 * CHECK FOR EXPONENTIAL FORCE
4919 fb99 81 5e L8F5A CMPA #$5E CHECK FOR UP ARROW
4920 fb9b 26 16 BNE L8F74 NO UP ARROW
4921 fb9d a1 84 CMPA ,X IS THE NEXT CHARACTER AN UP ARROW?
4922 fb9f 26 12 BNE L8F74 NO
4923 fba1 a1 01 CMPA $01,X AND THE NEXT CHARACTER?
4924 fba3 26 0e BNE L8F74 NO
4925 fba5 a1 02 CMPA $02,X HOW ABOUT THE 4TH CHARACTER?
4926 fba7 26 0a BNE L8F74 NO, ALSO
4927 fba9 c1 04 CMPB #4 * CHECK TO SEE IF THE 4 UP ARROWS ARE IN THE
4928 fbab 25 06 BLO L8F74 * FORMAT STRING AND BRANCH IF NOT
4929 fbad c0 04 SUBB #4 * MOVE POINTER UP 4 AND SUBTRACT
4930 fbaf 30 04 LEAX $04,X * FOUR FROM LENGTH
4931 fbb1 0c 9a INC VDA INCREMENT STATUS BYTE - EXPONENTIAL FORM
4932
4933 * CHECK FOR A PRE OR POST - SIGN FORCE AT END OF FORMAT STRING
4934 fbb3 30 1f L8F74 LEAX $-01,X MOVE POINTER BACK ONE
4935 fbb5 0c 99 INC VD9 ADD ONE TO LEFT DIGIT COUNTER FOR PRE-SIGN FORCE
4936 fbb7 96 9a LDA VDA * PRE-SIGN
4937 fbb9 85 08 BITA #$08 * FORCE AND
4938 fbbb 26 18 BNE L8F96 * BRANCH IF SET
4939 fbbd 0a 99 DEC VD9 DECREMENT LEFT DIGIT — NO PRE-SIGN FORCE
4940 fbbf 5d TSTB * CHECK LENGTH COUNTER AND BRANCH
4941 fbc0 27 13 BEQ L8F96 * IF END OF FORMAT STRING
4942 fbc2 a6 84 LDA ,X GET NEXT FORMAT STRING CHARACTER
4943 fbc4 80 2d SUBA #'-' CHECK FOR MINUS SIGN
4944 fbc6 27 06 BEQ L8F8F BRANCH IF MINUS SIGN
4945 fbc8 81 fe CMPA #$FE * WAS CMPA #('+')-('-')
4946 fbca 26 09 BNE L8F96 BRANCH IF NO PLUS SIGN
4947 fbcc 86 08 LDA #$08 GET THE PRE-SIGN FORCE FLAG
4948 fbce 8a 04 L8F8F ORA #$04 ‘OR’ IN POST-SIGN FORCE FLAG
4949 fbd0 9a 9a ORA VDA ‘OR’ IN THE STATUS BYTE
4950 fbd2 97 9a STA VDA SAVE THE STATUS BYTE
4951 fbd4 5a DECB DECREMENT FORMAT STRING LENGTH
4952
4953 * EVALUATE NUMERIC ITEM-LIST
4954 fbd5 9d 82 L8F96 JSR GETCCH GET CURRENT CHARACTER
4955 fbd7 10 27 ff 3c LBEQ L8ED8 BRANCH IF END OF LINE
4956 fbdb d7 93 STB VD3 SAVE FORMAT STRING LENGTH WHEN FORMAT EVALUATION ENDED
4957 fbdd bd e3 ca JSR LB141 EVALUATE EXPRESSION
4958 fbe0 96 99 LDA VD9 GET THE LEFT DIGIT COUNTER
4959 fbe2 9b 98 ADDA VD8 ADD IT TO THE RIGHT DIGIT COUNTER
4960 fbe4 81 11 CMPA #17 *
4961 fbe6 10 22 ea e4 LBHI LB44A *‘FC’ ERROR IF MORE THAN 16 DIGITS AND DECIMAL POiNT
4962 fbea bd fc 24 JSR L8FE5 CONVERT ITEM-LIST TO FORMATTED ASCII STRING
4963 fbed 30 1f LEAX $-01,X MOVE BUFFER POINTER BACK ONE
4964 fbef bd eb e5 JSR LB99C DISPLAY THE FORMATTED STRING TO CONSOLE OUT
4965 fbf2 0f 97 L8FB3 CLR VD7 RESET NEXT PRINT ITEM FLAG
4966 fbf4 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4967 fbf6 27 0d BEQ L8FC6 BRANCH IF END OF LINE
4968 fbf8 97 97 STA VD7 SAVE CURRENT CHARACTER (<>0) IN NEXT PRINT ITEM FLAG
4969 fbfa 81 3b CMPA #';' * CHECK FOR ; - ITEM-LIST SEPARATOR AND
4970 fbfc 27 05 BEQ L8FC4 * BRANCH IF SEMICOLON
4971 fbfe bd e4 f6 JSR LB26D SYNTAX CHECK FOR COMMA
4972 fc01 20 02 BRA L8FC6 PROCESS NEXT PRINT ITEM
4973 fc03 9d 7c L8FC4 JSR GETNCH GET NEXT INPUT CHARACTER
4974 fc05 9e 95 L8FC6 LDX VD5 GET FORMAT STRING DESCRIPTOR ADDRESS
4975 fc07 e6 84 LDB ,X GET LENGTH OF FORMAT STRING
4976 fc09 d0 93 SUBB VD3 SUBTRACT AMOUNT OF FORMAT STRING LEFT AFTER LAST PRINT ITEM
4977 fc0b ae 02 LDX $02,X *GET FORMAT STRING START ADDRESS AND ADVANCE
4978 fc0d 3a ABX *POINTER TO START OF UNUSED FORMAT STRING
4979 fc0e d6 93 LDB VD3 * GET AMOUNT OF UNUSED FORMAT STRING
4980 fc10 10 26 fe e4 LBNE L8EB9 * REINTERPRET FORMAT STRING FROM THAT POINT
4981 fc14 7e fb 11 JMP L8ED2 REINTERPRET FORMAT STRING FROM THE START IF ENTIRELY
4982 * USED ON LAST PRINT ITEM
4983
4984 * PRINT A ‘+‘ TO CONSOLE OUT IF THE STATUS BYTE <> 0
4985 fc17 34 02 L8FD8 PSHS A RESTORE ACCA AND RETURN
4986 fc19 86 2b LDA #'+' GET ASCII PLUS SIGN
4987 fc1b 0d 9a TST VDA * CHECK THE STATUS BYTE AND
4988 fc1d 27 03 BEQ L8FE3 * RETURN IF = 0
4989 fc1f bd db 14 JSR PUTCHR SEND A CHARACTER TO CONSOLE OUT
4990 fc22 35 82 L8FE3 PULS A,PC RETURN ACCA AND RETURN
4991
4992 * CONVERT ITEM-LIST TO DECIMAL ASCII STRING
4993 fc24 ce 01 f2 L8FE5 LDU #STRBUF+4 POINT U TO STRING BUFFER
4994 fc27 c6 20 LDB #SPACE BLANK
4995 fc29 96 9a LDA VDA * GET THE STATUS FLAG AND
4996 fc2b 85 08 BITA #$08 * CHECK FOR A PRE-SIGN FORCE
4997 fc2d 27 02 BEQ L8FF2 * BRANCH IF NO PRE-SIGN FORCE
4998 fc2f c6 2b LDB #'+' PLUS SIGN
4999 fc31 0d 54 L8FF2 TST FP0SGN CHECK THE SIGN OF FPA0
5000 fc33 2a 04 BPL L8FFA BRANCH IF POSITIVE
5001 fc35 0f 54 CLR FP0SGN FORCE FPA0 SIGN TO BE POSITIVE
5002 fc37 c6 2d LDB #'-' MINUS SIGN
5003 fc39 e7 c0 L8FFA STB ,U+ SAVE THE SIGN IN BUFFER
5004 fc3b c6 30 LDB #'0' * PUT A ZERO INTO THE BUFFER
5005 fc3d e7 c0 STB ,U+ *
5006 fc3f 84 01 ANDA #$01 * CHECK THE EXPONENTIAL FORCE FLAG IN
5007 fc41 10 26 01 07 LBNE L910D * THE STATUS BYTE - BRANCH IF ACTIVE
5008 fc45 8e f0 09 LDX #LBDC0 POINT X TO FLOATING POINT 1E + 09
5009 fc48 bd ee e9 JSR LBCA0 COMPARE FPA0 TO (X)
5010 fc4b 2b 15 BMI L9023 BRANCH IF FPA0 < 1E+09
5011 fc4d bd f0 22 JSR LBDD9 CONVERT FP NUMBER TO ASCII STRING
5012 fc50 a6 80 L9011 LDA ,X+ * ADVANCE POINTER TO END OF
5013 fc52 26 fc BNE L9011 * ASCII STRING (ZERO BYTE)
5014 fc54 a6 82 L9015 LDA ,-X MOVE THE
5015 fc56 a7 01 STA $01,X ENTIRE STRING
5016 fc58 8c 01 f1 CMPX #STRBUF+3 UP ONE
5017 fc5b 26 f7 BNE L9015 BYTE
5018 fc5d 86 25 LDA #'%' * INSERT A % SIGN AT START OF
5019 fc5f a7 84 STA ,X * STRING - OVERFLOW ERROR
5020 fc61 39 RTS
5021
5022 fc62 96 4f L9023 LDA FP0EXP GET EXPONENT OF FPA0
5023 fc64 97 47 STA V47 AND SAVE IT IN V74
5024 fc66 27 03 BEQ L902C BRANCH IF FPA0 = 0
5025 fc68 bd fe 0c JSR L91CD CONVERT FPA0 TO NUMBER WITH 9 SIGNIFICANT
5026 * PLACES TO LEFT OF DECIMAL POINT
5027 fc6b 96 47 L902C LDA V47 GET BASE 10 EXPONENT OFFSET
5028 fc6d 10 2b 00 81 LBMI L90B3 BRANCH IF FPA0 < 100,000,000
5029 fc71 40 NEGA * CALCULATE THE NUMBER OF LEADING ZEROES TO INSERT -
5030 fc72 9b 99 ADDA VD9 * SUBTRACT BASE 10 EXPONENT OFFSET AND 9 (FPA0 HAS
5031 fc74 80 09 SUBA #$09 * 9 PLACES TO LEFT OF EXPONENT) FROM LEFT DIGIT COUNTER
5032 fc76 bd fd 29 JSR L90EA PUT ACCA ZEROES IN STRING BUFFER
5033 fc79 bd fe a2 JSR L9263 INITIALIZE DECIMAL POINT AND COMMA COUNTERS
5034 fc7c bd fe 41 JSR L9202 CONVERT FPA0 TO DECIMAL ASCII IN THE STRING BUFFER
5035 fc7f 96 47 LDA V47 * GET BASE 10 EXPONENT AND PUT THAT MANY
5036 fc81 bd fe c0 JSR L9281 * ZEROES IN STRING BUFFER - STOP AT DECIMAL POINT
5037 fc84 96 47 LDA V47 WASTED INSTRUCTION - SERVES NO PURPOSE
5038 fc86 bd fe 88 JSR L9249 CHECK FOR DECIMAL POINT
5039 fc89 96 98 LDA VD8 GET THE RIGHT DIGIT COUNTER
5040 fc8b 26 02 BNE L9050 BRANCH IF RIGHT DIGlT COUNTER <> 0
5041 fc8d 33 5f LEAU $-01,U * MOVE BUFFER POINTER BACK ONE - DELETE
5042 * * DECIMAL POINT IF NO RIGHT DIGITS SPECiFIED
5043 fc8f 4a L9050 DECA SUBTRACT ONE (DECIMAL POINT)
5044 fc90 bd fd 29 JSR L90EA PUT ACCA ZEROES INTO BUFFER (TRAILING ZEROES)
5045 fc93 bd fd c4 L9054 JSR L9185 INSERT ASTERISK PADDING, FLOATING $, AND POST-SIGN
5046 fc96 4d TSTA WAS THERE A POST-SIGN?
5047 fc97 27 06 BEQ L9060 NO
5048 fc99 c1 2a CMPB #'*' IS THE FIRST CHARACTER AN $?
5049 fc9b 27 02 BEQ L9060 YES
5050 fc9d e7 c0 STB ,U+ STORE THE POST-SIGN
5051 fc9f 6f c4 L9060 CLR ,U CLEAR THE LAST CHARACTER IN THE BUFFER
5052 *
5053 * REMOVE ANY EXTRA BLANKS OR ASTERISKS FROM THE
5054 * STRING BUFFER TO THE LEFT OF THE DECIMAL POINT
5055 fca1 8e 01 f1 LDX #STRBUF+3 POINT X TO THE START OF THE BUFFER
5056 fca4 30 01 L9065 LEAX $01,X MOVE BUFFER POINTER UP ONE
5057 fca6 9f 0f STX TEMPTR SAVE BUFFER POINTER IN TEMPTR
5058 fca8 96 3a LDA VARPTR+1 * GET ADDRESS OF DECIMAL POINT IN BUFFER, SUBTRACT
5059 fcaa 90 10 SUBA TEMPTR+1 * CURRENT POSITION AND SUBTRACT LEFT DIGIT COUNTER -
5060 fcac 90 99 SUBA VD9 * THE RESULT WILL BE ZERO WHEN TEMPTR+1 IS POINTING
5061 * * TO THE FIRST DIGIT OF THE FORMAT STRING
5062 fcae 27 38 BEQ L90A9 RETURN IF NO DIGITS TO LEFT OF THE DECiMAL POINT
5063 fcb0 a6 84 LDA ,X GET THE CURRENT BUFFER CHARACTER
5064 fcb2 81 20 CMPA #SPACE SPACE?
5065 fcb4 27 ee BEQ L9065 YES - ADVANCE POINTER
5066 fcb6 81 2a CMPA #'*' ASTERISK?
5067 fcb8 27 ea BEQ L9065 YES - ADVANCE POINTER
5068 fcba 4f CLRA A ZERO ON THE STACK IS END OF DATA POINTER
5069 fcbb 34 02 L907C PSHS A PUSH A CHARACTER ONTO THE STACK
5070 fcbd a6 80 LDA ,X+ GET NEXT CHARACTER FROM BUFFER
5071 fcbf 81 2d CMPA #'-' MINUS SIGN?
5072 fcc1 27 f8 BEQ L907C YES
5073 fcc3 81 2b CMPA #'+' PLUS SIGN?
5074 fcc5 27 f4 BEQ L907C YES
5075 fcc7 91 00 CMPA $'$' DOLLAR SIGN?
5076 fcc9 27 f0 BEQ L907C YES
5077 fccb 81 30 CMPA #'0' ZERO?
5078 fccd 26 0e BNE L909E NO - ERROR
5079 fccf a6 01 LDA $01,X GET CHARACTER FOLLOWING ZERO
5080 fcd1 8d 16 BSR L90AA CLEAR CARRY IF NUMERIC
5081 fcd3 25 08 BLO L909E BRANCH IF NOT A NUMERIC CHARACTER - ERROR
5082 fcd5 35 02 L9096 PULS A * PULL A CHARACTER OFF OF THE STACK
5083 fcd7 a7 82 STA ,-X * AND PUT IT BACK IN THE STRING BUFFER
5084 fcd9 26 fa BNE L9096 * KEEP GOING UNTIL ZERO FLAG
5085 fcdb 20 c7 BRA L9065 KEEP CLEANING UP THE INPUT BUFFER
5086 fcdd 35 02 L909E PULS A
5087 fcdf 4d TSTA * THE STACK AND EXIT WHEN
5088 fce0 26 fb BNE L909E * ZERO FLAG FOUND
5089 fce2 9e 0f LDX TEMPTR GET THE STRING BUFFER START POINTER
5090 fce4 86 25 LDA #'%' * PUT A % SIGN BEFORE THE ERROR POSITION TO
5091 fce6 a7 82 STA ,-X * INDICATE AN ERROR
5092 fce8 39 L90A9 RTS
5093 *
5094 * CLEAR CARRY IF NUMERIC
5095 fce9 81 30 L90AA CMPA #'0' ASCII ZERO
5096 fceb 25 04 BLO L90B2 RETURN IF ACCA < ASCII 0
5097 fced 80 3a SUBA #$3A * #'9'+1
5098 fcef 80 c6 SUBA #$C6 * #-('9'+1) CARRY CLEAR IF NUMERIC
5099 fcf1 39 L90B2 RTS
5100 *
5101 * PROCESS AN ITEM-LIST WHICH IS < 100,000,000
5102 fcf2 96 98 L90B3 LDA VD8 GET RIGHT DIGIT COUNTER
5103 fcf4 27 01 BEQ L90B8 BRANCH IF NO FORMATTED DIGITS TO THE RIGHT OF DECIMAL PT
5104 fcf6 4a DECA SUBTRACT ONE FOR DECIMAL POINT
5105 fcf7 9b 47 L90B8 ADDA V47 *ADD THE BASE 10 EXPONENT OFFSET - ACCA CONTAINS THE
5106 * *NUMBER OF SHIFTS REQUIRED TO ADJUST FPA0 TO THE SPECIFIED
5107 * *NUMBER OF DlGITS TO THE RIGHT OF THE DECIMAL POINT
5108 fcf9 2b 01 BMI L90BD IF ACCA >= 0 THEN NO SHIFTS ARE REQUIRED
5109 fcfb 4f CLRA FORCE SHIFT COUNTER = 0
5110 fcfc 34 02 L90BD PSHS A SAVE INITIAL SHIFT COUNTER ON THE STACK
5111 fcfe 2a 0a L90BF BPL L90CB EXIT ROUTINE IF POSITIVE
5112 fd00 34 02 PSHS A SAVE SHIFT COUNTER ON STACK
5113 fd02 bd ed cb JSR LBB82 DIVIDE FPA0 BY 10 - SHIFT ONE DIGIT TO RIGHT
5114 fd05 35 02 PULS A GET SHIFT COUNTER FROM THE STACK
5115 fd07 4c INCA BUMP SHIFT COUNTER UP BY ONE
5116 fd08 20 f4 BRA L90BF CHECK FOR FURTHER DIVISION
5117 fd0a 96 47 L90CB LDA V47 * GET BASE 10 EXPONENT OFFSET, ADD INITIAL SHIFT COUNTER
5118 fd0c a0 e0 SUBA ,S+ * AND SAVE NEW BASE 10 EXPONENT OFFSET - BECAUSE
5119 fd0e 97 47 STA V47 * FPA0 WAS SHIFTED ABOVE
5120 fd10 8b 09 ADDA #$09 * ADD NINE (SIGNIFICANT PLACES) AND BRANCH IF THERE ARE NO
5121 fd12 2b 19 BMI L90EE * ZEROES TO THE LEFT OF THE DECIMAL POINT IN THIS PRINT ITEM
5122 fd14 96 99 LDA VD9 *DETERMINE HOW MANY FILLER ZEROES TO THE LEFT OF THE DECIMAL
5123 fd16 80 09 SUBA #$09 *POINT. GET THE NUMBER OF FORMAT PLACES TO LEFT OF DECIMAL
5124 fd18 90 47 SUBA V47 *POINT, SUBTRACT THE BASE 10 EXPONENT OFFSET AND THE CONSTANT 9
5125 fd1a 8d 0d BSR L90EA *(UNNORMALIZATION)-THEN OUTPUT THAT MANY ZEROES TO THE BUFFER
5126 fd1c bd fe a2 JSR L9263 INITIALIZE DECIMAL POINT AND COMMA COUNTERS
5127 fd1f 20 1d BRA L90FF PROCESS THE REMAINDER OF THE PRINT ITEM
5128 *
5129 * PUT (ACCA+1) ASCII ZEROES IN BUFFER
5130 fd21 34 02 L90E2 PSHS A SAVE ZERO COUNTER
5131 fd23 86 30 LDA #'0' * INSERT A ZERO INTO
5132 fd25 a7 c0 STA ,U+ * THE BUFFER
5133 fd27 35 02 PULS A RESTORE ZERO COUNTER
5134
5135 * PUT ACCA ASCII ZEROES INTO THE BUFFER
5136 fd29 4a L90EA DECA DECREMENT ZERO COUNTER
5137 fd2a 2a f5 BPL L90E2 BRANCH IF NOT DONE
5138 fd2c 39 RTS
5139
5140 fd2d 96 99 L90EE LDA VD9 * GET THE LEFT DIGIT COUNTER AND PUT
5141 fd2f 8d f8 BSR L90EA * THAT MANY ZEROES IN THE STRiNG BUFFER
5142 fd31 bd fe 8c JSR L924D PUT THE DECIMAL POINT IN THE STRING BUFFER
5143 fd34 86 f7 LDA #-9 *DETERMINE HOW MANY FILLER ZEROES BETWEEN THE DECIMAL POINT
5144 fd36 90 47 SUBA V47 *AND SIGNIFICANT DATA. SUBTRACT BASE 10 EXPONENT FROM -9
5145 fd38 8d ef BSR L90EA *(UNNORMALIZATION) AND OUTPUT THAT MANY ZEROES TO BUFFER
5146 fd3a 0f 45 CLR V45 CLEAR THE DECIMAL POINT COUNTER - SUPPRESS THE DECIMAL POINT
5147 fd3c 0f 97 CLR VD7 CLEAR THE COMMA COUNTER - SUPPRESS COMMAS
5148 fd3e bd fe 41 L90FF JSR L9202 DECODE FPA0 INTO A DECIMAL ASCII STRING
5149 fd41 96 98 LDA VD8 GET THE RIGHT DIGIT COUNTER
5150 fd43 26 02 BNE L9108 BRANCH IF RIGHT DIGIT COUNTER <> 0
5151 fd45 de 39 LDU VARPTR RESET BUFFER PTR TO THE DECIMAL POINT IF NO DIGITS TO RIGHT
5152 fd47 9b 47 L9108 ADDA V47 *ADD BASE 10 EXPONENT - A POSITIVE ACCA WILL CAUSE THAT MANY
5153 * *FILLER ZEROES TO BE OUTPUT TO THE RIGHT OF LAST SIGNIFICANT DATA
5154 * *SIGNIFICANT DATA
5155 fd49 16 ff 43 LBRA L9050 INSERT LEADING ASTERISKS, FLOATING DOLLAR SIGN, ETC
5156 *
5157 * FORCE THE NUMERIC OUTPUT FORMAT TO BE EXPONENTIAL FORMAT
5158 fd4c 96 4f L910D LDA FP0EXP * GET EXPONENT OF FPA0 AND
5159 fd4e 34 02 PSHS A * SAVE IT ON THE STACK
5160 fd50 27 03 BEQ L9116 BRANCH IF FPA0 = 0
5161 fd52 bd fe 0c JSR L91CD *CONVERT FPA0 INTO A NUMBER WITH 9 SIGNIFICANT
5162 * *DIGITS TO THE LEFT OF THE DECIMAL POINT
5163 fd55 96 98 L9116 LDA VD8 GET THE RIGHT DIGIT COUNTER
5164 fd57 27 01 BEQ L911B BRANCH IF NO FORMATTED DIGITS TO THE RIGHT
5165 fd59 4a DECA SUBTRACT ONE FOR THE DECIMAL POINT
5166 fd5a 9b 99 L911B ADDA VD9 ADD TO THE LEFT DIGIT COUNTER
5167 fd5c 7f 01 f1 CLR STRBUF+3 CLEAR BUFFER BYTE AS TEMPORARY STORAGE LOCATION
5168 fd5f d6 9a LDB VDA * GET THE STATUS BYTE FOR A
5169 fd61 c4 04 ANDB #$04 * POST-BYTE FORCE; BRANCH IF
5170 fd63 26 03 BNE L9129 * A POST-BYTE FORCE
5171 fd65 73 01 f1 COM STRBUF+3 TOGGLE BUFFER BYTE TO -1 IF NO POST-BYTE FORCE
5172 fd68 bb 01 f1 L9129 ADDA STRBUF+3 SUBTRACT 1 IF NO POST BYTE FORCE
5173 fd6b 80 09 SUBA #$09 *SUBTRACT 9 (DUE TO THE CONVERSION TO 9
5174 * *SIGNIFICANT DIGITS TO LEFT OF DECIMAL POINT)
5175 fd6d 34 02 PSHS A * SAVE SHIFT COUNTER ON THE STACK - ACCA CONTAINS THE NUMBER
5176 * OF SHIFTS REQUIRED TO ADJUST FPA0 FOR THE NUMBER OF
5177 * FORMATTED PLACES TO THE RIGHT OF THE DECIMAL POINT.
5178 fd6f 2a 0a L9130 BPL L913C NO MORE SHIFTS WHEN ACCA >= 0
5179 fd71 34 02 PSHS A SAVE SHIFT COUNTER
5180 fd73 bd ed cb JSR LBB82 DIVIDE FPA0 BY 10 - SHIFT TO RIGHT ONE
5181 fd76 35 02 PULS A RESTORE THE SHIFT COUNTER
5182 fd78 4c INCA ADD 1 TO SHIFT COUNTER
5183 fd79 20 f4 BRA L9130 CHECK FOR FURTHER SHIFTING (DIVISION)
5184 fd7b a6 e4 L913C LDA ,S *GET THE INITIAL VALUE OF THE SHIFT COUNTER
5185 fd7d 2b 01 BMI L9141 *AND BRANCH IF SHIFTING HAS TAKEN PLACE
5186 fd7f 4f CLRA RESET ACCA IF NO SHIFTING HAS TAKEN PLACE
5187 fd80 40 L9141 NEGA *CALCULATE THE POSITION OF THE DECIMAL POINT BY
5188 fd81 9b 99 ADDA VD9 *NEGATING SHIFT COUNTER, ADDING THE LEFT DIGIT COUNTER
5189 fd83 4c INCA *PLUS ONE AND THE POST-BYTE POSlTION, IF USED
5190 fd84 bb 01 f1 ADDA STRBUF+3 *
5191 fd87 97 45 STA V45 SAVE DECIMAL POINT COUNTER
5192 fd89 0f 97 CLR VD7 CLEAR COMMA COUNTER - NO COMMAS INSERTED
5193 fd8b bd fe 41 JSR L9202 CONVERT FPA0 INTO ASCII DECIMAL STRING
5194 fd8e 35 02 PULS A * GET THE INITIAL VALUE OF SHIFT COUNTER AND
5195 fd90 bd fe c0 JSR L9281 * INSERT THAT MANY ZEROES INTO THE BUFFER
5196 fd93 96 98 LDA VD8 *GET THE RIGHT DIGIT COUNTER AND BRANCH
5197 fd95 26 02 BNE L915A *IF NOT ZERO
5198 fd97 33 5f LEAU $-01,U MOVE BUFFER POINTER BACK ONE
5199
5200 * CALCULATE VALUE OF EXPONENT AND PUT IN STRING BUFFER
5201 fd99 e6 e0 L915A LDB ,S+ GET ORIGINAL EXPONENT OF FPA0
5202 fd9b 27 09 BEQ L9167 BRANCH IF EXPONENT = 0
5203 fd9d d6 47 LDB V47 GET BASE 10 EXPONENT
5204 fd9f cb 09 ADDB #$09 ADD 9 FOR 9 SIGNIFICANT DIGIT CONVERSION
5205 fda1 d0 99 SUBB VD9 SUBTRACT LEFT DIGIT COUNTER
5206 fda3 f0 01 f1 SUBB STRBUF+3 ADD ONE TO EXPONENT IF POST-SIGN FORCE
5207 fda6 86 2b L9167 LDA #'+' PLUS SIGN
5208 fda8 5d TSTB TEST EXPONENT
5209 fda9 2a 03 BPL L916F BRANCH IF POSITIVE EXPONENT
5210 fdab 86 2d LDA #'-' MINUS SIGN
5211 fdad 50 NEGB CONVERT EXPONENT TO POSITIVE NUMBER
5212 fdae a7 41 L916F STA $01,U PUT SIGN OF EXPONENT IN STRING BUFFER
5213 fdb0 86 45 LDA #'E' * PUT AN ‘E’ (EXPONENTIATION FLAG) IN
5214 fdb2 a7 c1 STA ,U++ * BUFFER AND SKIP OVER THE SIGN
5215 fdb4 86 2f LDA #$2F * WAS LDA #'0'-1
5216 *CONVERT BINARY EXPONENT IN ACCB TO ASCII VALUE IN ACCA
5217 fdb6 4c L9177 INCA ADD ONE TO TENS DIGIT COUNTER
5218 fdb7 c0 0a SUBB #10 *SUBTRACT 10 FROM EXPONENT AND ADD ONE TO TENS
5219 fdb9 24 fb BCC L9177 * DIGIT IF NO CARRY. TENS DIGIT DONE IF THERE IS A CARRY
5220 fdbb cb 3a ADDB #$3A WAS ADDB #'9'+1
5221 fdbd ed c1 STD ,U++ SAVE EXPONENT IN BUFFER
5222 fdbf 6f c4 CLR ,U CLEAR FINAL BYTE IN BUFFER - PRINT TERMINATOR
5223 fdc1 7e fc 93 JMP L9054 INSERT ASTERISK PADDING, FLOATING DOLLAR SIGN, ETC.
5224
5225 * INSERT ASTERISK PADDING, FLOATING $ AND PRE-SIGN
5226 fdc4 8e 01 f2 L9185 LDX #STRBUF+4 POINT X TO START OF PRINT ITEM BUFFER
5227 fdc7 e6 84 LDB ,X * GET SIGN BYTE OF ITEM-LIST BUFFER
5228 fdc9 34 04 PSHS B * AND SAVE IT ON THE STACK
5229 fdcb 86 20 LDA #SPACE DEFAULT PAD WITH BLANKS
5230 fdcd d6 9a LDB VDA * GET STATUS BYTE AND CHECK FOR
5231 fdcf c5 20 BITB #$20 * ASTERISK LEFT PADDING
5232 fdd1 35 04 PULS B GET SIGN BYTE AGAIN
5233 fdd3 27 08 BEQ L919E BRANCH IF NO PADDING
5234 fdd5 86 2a LDA #'*' PAD WITH ASTERISK
5235 fdd7 c1 20 CMPB #SPACE WAS THE FIRST BYTE A BLANK (POSITIVE)?
5236 fdd9 26 02 BNE L919E NO
5237 fddb 1f 89 TFR A,B TRANSFER PAD CHARACTER TO ACCB
5238 fddd 34 04 L919E PSHS B SAVE FIRST CHARACTER ON STACK
5239 fddf a7 80 L91A0 STA ,X+ STORE PAD CHARACTER IN BUFFER
5240 fde1 e6 84 LDB ,X GET NEXT CHARACTER IN BUFFER
5241 fde3 27 10 BEQ L91B6 INSERT A ZERO IF END OF BUFFER
5242 fde5 c1 45 CMPB #'E' * CHECK FOR AN ‘E’ AND
5243 fde7 27 0c BEQ L91B6 * PUT A ZERO BEFORE IT
5244 fde9 c1 30 CMPB #'0' * REPLACE LEADING ZEROES WITH
5245 fdeb 27 f2 BEQ L91A0 * PAD CHARACTERS
5246 fded c1 2c CMPB #',' * REPLACE LEADING COMMAS
5247 fdef 27 ee BEQ L91A0 * WITH PAD CHARACTERS
5248 fdf1 c1 2e CMPB #'.' * CHECK FOR DECIMAL POINT
5249 fdf3 26 04 BNE L91BA * AND DON’T PUT A ZERO BEFORE IT
5250 fdf5 86 30 L91B6 LDA #'0' * REPLACE PREVIOUS CHARACTER
5251 fdf7 a7 82 STA ,-X * WITH A ZERO
5252 fdf9 96 9a L91BA LDA VDA * GET STATUS BYTE, CHECK
5253 fdfb 85 10 BITA #$10 * FOR FLOATING $
5254 fdfd 27 04 BEQ L91C4 * BRANCH IF NO FLOATING $
5255 fdff c6 24 LDB #'$' * STORE A $ IN
5256 fe01 e7 82 STB ,-X * BUFFER
5257 fe03 84 04 L91C4 ANDA #$04 CHECK PRE-SIGN FLAG
5258 fe05 35 04 PULS B GET SIGN CHARACTER
5259 fe07 26 02 BNE L91CC RETURN IF POST-SIGN REQUIRED
5260 fe09 e7 82 STB ,-X STORE FIRST CHARACTER
5261 fe0b 39 L91CC RTS
5262 *
5263 * CONVERT FPA0 INTO A NUMBER OF THE FORM - NNN,NNN,NNN X 10**M.
5264 * THE EXPONENT M WILL BE RETURNED IN V47 (BASE 10 EXPONENT).
5265 fe0c 34 40 L91CD PSHS U SAVE BUFFER POINTER
5266 fe0e 4f CLRA INITIAL EXPONENT OFFSET = 0
5267 fe0f 97 47 L91D0 STA V47 SAVE EXPONENT OFFSET
5268 fe11 d6 4f LDB FP0EXP GET EXPONENT OF FPA0
5269 fe13 c1 80 CMPB #$80 * COMPARE TO EXPONENT OF .5
5270 fe15 22 11 BHI L91E9 * AND BRANCH IF FPA0 > = 1.0
5271
5272 * IF FPA0 < 1.0, MULTIPLY IT BY 1E+09 UNTIL IT IS >= 1
5273 fe17 8e f0 09 LDX #LBDC0 POINT X TO FP NUMBER (1E+09)
5274 fe1a bd ed 13 JSR LBACA MULTIPLY FPA0 BY 1E+09
5275 fe1d 96 47 LDA V47 GET EXPONENT OFFSET
5276 fe1f 80 09 SUBA #$09 SUBTRACT 9 (BECAUSE WE MULTIPLIED BY 1E+09 ABOVE)
5277 fe21 20 ec BRA L91D0 CHECK TO SEE IF > 1.0
5278 fe23 bd ed cb L91E4 JSR LBB82 DIVIDE FPA0 BY 10
5279 fe26 0c 47 INC V47 INCREMENT EXPONENT OFFSET
5280 fe28 8e f0 04 L91E9 LDX #LBDBB POINT X TO FP NUMBER (999,999,999)
5281 fe2b bd ee e9 JSR LBCA0 COMPARE FPA0 TO X
5282 fe2e 2e f3 BGT L91E4 BRANCH IF FPA0 > 999,999,999
5283 fe30 8e ef ff L91F1 LDX #LBDB6 POINT X TO FP NUMBER (99,999,999.9)
5284 fe33 bd ee e9 JSR LBCA0 COMPARE FPA0 TO X
5285 fe36 2e 07 BGT L9200 RETURN IF 999,999,999 > FPA0 > 99,999,999.9
5286 fe38 bd ed b3 JSR LBB6A MULTIPLY FPA0 BY 10
5287 fe3b 0a 47 DEC V47 DECREMENT EXPONENT OFFSET
5288 fe3d 20 f1 BRA L91F1 KEEP UNNORMALIZING
5289 fe3f 35 c0 L9200 PULS U,PC RESTORE BUFFER POINTER AND RETURN
5290 *
5291 * CONVERT FPA0 INTO AN INTEGER, THEN DECODE IT
5292 * INTO A DECIMAL ASCII STRING IN THE BUFFER
5293 fe41 34 40 L9202 PSHS U SAVE BUFFER POINTER
5294 fe43 bd eb fd JSR LB9B4 ADD .5 TO FPA0 (ROUND OFF)
5295 fe46 bd ef 11 JSR LBCC8 CONVERT FPA0 TO INTEGER FORMAT
5296 fe49 35 40 PULS U RESTORE BUFFER POINTER
5297 *
5298 * CONVERT FPA0 INTO A DECIMAL ASCII STRING
5299 fe4b 8e f1 0e LDX #LBEC5 POINT X TO UNNORMALIZED POWERS OF 10
5300 fe4e c6 80 LDB #$80 INITIALIZE DIGIT COUNTER TO 0 + $80.
5301 * BIT 7 SET IS USED TO INDICATE THAT THE POWER OF 10 MANTISSA
5302 * IS NEGATIVE. WHEN YOU ‘ADD’ A NEGATIVE MANTISSA, IT IS
5303 * THE SAME AS SUBTRACTING A POSITIVE ONE AND BIT 7 OF ACCB
5304 * IS HOW THIS ROUTINE KNOWS THAT A ‘SUBTRACTION’ IS OCCURRING.
5305 fe50 8d 36 L9211 BSR L9249 CHECK FOR COMMA INSERTION
5306 fe52 96 53 L9213 LDA FPA0+3 * ‘ADD’ A POWER OF 10 MANTISSA TO FPA0.
5307 fe54 ab 03 ADDA $03,X * IF THE MANTISSA IS NEGATIVE, A SUBTRACTION
5308 fe56 97 53 STA FPA0+3 * WILL BE WHAT REALLY TAKES PLACE.
5309 fe58 96 52 LDA FPA0+2 *
5310 fe5a a9 02 ADCA $02,X *
5311 fe5c 97 52 STA FPA0+2 *
5312 fe5e 96 51 LDA FPA0+1 *
5313 fe60 a9 01 ADCA $01,X *
5314 fe62 97 51 STA FPA0+1 *
5315 fe64 96 50 LDA FPA0 *
5316 fe66 a9 84 ADCA ,X *
5317 fe68 97 50 STA FPA0 *
5318 fe6a 5c INCB ADD ONE TO DIGIT COUNTER
5319 fe6b 56 RORB ROTATE CARRY INTO BIT 7
5320 fe6c 59 ROLB * SET OVERFLOW FLAG - BRANCH IF CARRY SET AND
5321 fe6d 28 e3 BVC L9213 * ADDING MANTISSA OR CARRY CLEAR AND SUBTRACTING MANTISSA
5322 fe6f 24 03 BCC L9235 BRANCH IF SUBTRACTING MANTISSA
5323 fe71 c0 0b SUBB #10+1 WAS SUBB #10+1
5324 fe73 50 NEGB * IF ADDING MANTISSA
5325 fe74 cb 2f L9235 ADDB #$2F WAS ADDB #'0'-1
5326 fe76 30 04 LEAX $04,X MOVE TO NEXT POWER OF 10 MANTISSA
5327 fe78 1f 98 TFR B,A SAVE DIGIT IN ACCA
5328 fe7a 84 7f ANDA #$7F MASK OFF ADD/SUBTRACT FLAG (BIT 7)
5329 fe7c a7 c0 STA ,U+ STORE DIGIT IN BUFFER
5330 fe7e 53 COMB TOGGLE ADD/SUBTRACT FLAG
5331 fe7f c4 80 ANDB #$80 MASK OFF EVERYTHING BUT ADD/SUB FLAG
5332 fe81 8c f1 32 CMPX #LBEE9 COMPARE TO END OF UNNORMALIZED POWERS OF 10
5333 fe84 26 ca BNE L9211 BRANCH IF NOT DONE
5334 fe86 6f c4 CLR ,U PUT A ZERO AT END OF INTEGER
5335
5336 * DECREMENT DECIMAL POINT COUNTER AND CHECK FOR COMMA INSERTION
5337 fe88 0a 45 L9249 DEC V45 DECREMENT DECIMAL POINT COUNTER
5338 fe8a 26 09 BNE L9256 NOT TIME FOR DECIMAL POINT
5339 fe8c df 39 L924D STU VARPTR SAVE BUFFER POINTER-POSITION OF THE DECIMAL POINT
5340 fe8e 86 2e LDA #'.' * STORE A DECIMAL
5341 fe90 a7 c0 STA ,U+ * POINT IN THE OUTPUT BUFFER
5342 fe92 0f 97 CLR VD7 * CLEAR COMMA COUNTER - NOW IT WILL TAKE 255
5343 * * DECREMENTS BEFORE ANOTHER COMMA WILL BE INSERTED
5344 fe94 39 RTS
5345 fe95 0a 97 L9256 DEC VD7 DECREMENT COMMA COUNTER
5346 fe97 26 08 BNE L9262 RETURN IF NOT TIME FOR COMMA
5347 fe99 86 03 LDA #$03 * RESET COMMA COUNTER TO 3; THREE
5348 fe9b 97 97 STA VD7 * DIGITS BETWEEN COMMAS
5349 fe9d 86 2c LDA #',' * PUT A COMMA INTO
5350 fe9f a7 c0 STA ,U+ * THE BUFFER
5351 fea1 39 L9262 RTS
5352
5353 * INITIALIZE DECIMAL POINT AND COMMA COUNTERS
5354 fea2 96 47 L9263 LDA V47 GET THE BASE 10 EXPONENT OFFSET
5355 fea4 8b 0a ADDA #10 * ADD 10 (FPA0 WAS ‘NORMALIZED’ TO 9 PLACES LEFT
5356 fea6 97 45 STA V45 * OF DECIMAL POINT) - SAVE IN DECIMAL POINT COUNTER
5357 fea8 4c INCA ADD ONE FOR THE DECIMAL POINT
5358 fea9 80 03 L926A SUBA #$03 * DIVIDE DECIMAL POINT COUNTER BY 3; LEAVE
5359 feab 24 fc BCC L926A * THE REMAINDER IN ACCA
5360 fead 8b 05 ADDA #$05 CONVERT REMAINDER INTO A NUMBER FROM 1-3
5361 feaf 97 97 STA VD7 SAVE COMMA COUNTER
5362 feb1 96 9a LDA VDA GET STATUS BYTE
5363 feb3 84 40 ANDA #$40 CHECK FOR COMMA FLAG
5364 feb5 26 02 BNE L927A BRANCH IF COMMA FLAG ACTIVE
5365 feb7 97 97 STA VD7 CLEAR COMMA COUNTER - 255 DIGITS OUTPUT BEFORE A COMMA
5366 feb9 39 L927A RTS
5367 *
5368 * INSERT ACCA ZEROES INTO THE BUFFER
5369 feba 34 02 L927B PSHS A SAVE ZEROES COUNTER
5370 febc 8d ca BSR L9249 CHECK FOR DECIMAL POINT
5371 febe 35 02 PULS A RESTORE ZEROES COUNTER
5372 fec0 4a L9281 DECA * DECREMENT ZEROES COUNTER AND
5373 fec1 2b 0a BMI L928E * RETURN IF < 0
5374 fec3 34 02 PSHS A SAVE ZEROES COUNTER
5375 fec5 86 30 LDA #'0' * PUT A ZERO INTO
5376 fec7 a7 c0 STA ,U+ * THE BUFFER
5377 fec9 a6 e0 LDA ,S+ RESTORE THE ZEROES COUNTER
5378 fecb 26 ed BNE L927B BRANCH IF NOT DONE
5379 fecd 39 L928E RTS
5380
5381
5382 * LINE
5383 fece 81 89 LINE CMPA #TOK_INPUT ‘INPUT’ TOKEN
5384 fed0 10 27 f9 5c LBEQ L89C0 GO DO ‘LINE INPUT’ COMMAND
5385 fed4 7e e5 00 JMP LB277 ‘SYNTAX ERROR’ IF NOT "LINE INPUT"
5386
5387
5388 * END OF EXTENDED BASIC
5389 * INTERRUPT VECTORS
5390 fff0 ORG $FFF0
5391 fff0 00 00 LBFF0 FDB $0000 RESERVED
5392 fff2 00 9b LBFF2 FDB SW3VEC SWI3
5393 fff4 00 9e LBFF4 FDB SW2VEC SWI2
5394 fff6 00 aa LBFF6 FDB FRQVEC FIRQ
5395 fff8 00 a7 LBFF8 FDB IRQVEC IRQ
5396 fffa 00 a1 LBFFA FDB SWIVEC SWI
5397 fffc 00 a4 LBFFC FDB NMIVEC NMI
5398 fffe db 46 LBFFE FDB RESVEC RESET
Reference in New Issue View Git Blame Copy Permalink