mister-devel/MultiComp_MiSTer
1
0
Fork 0
mirror of https://github.com/MiSTer-devel/MultiComp_MiSTer.git synced 2026-04-19 03:04:38 +00:00
Code Issues Packages Projects Releases Wiki Activity
Files
master
MultiComp_MiSTer/ROMS/6809/basic.lst
Fred VanEijk f219ef5c22 - work on basic/interpreter option for for Z80/CPM 
- add warm/cold reset option for the 6809
- add tools and docs to build 6809 interpreter
- revert the basMon files
2024-12-05 21:22:14 -05:00

4819 lines
398 KiB
Plaintext
Raw Permalink Blame History

0001
0002 ffd0 UART EQU $FFD0
0003 ffd1 RECEV EQU UART+1
0004 ffd1 TRANS EQU UART+1
0005 ffd0 USTAT EQU UART
0006 ffd0 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 <20> 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 <20> 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<34>$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 e2 02 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 e000 ORG $E000
0180
0181 * CONSOLE IN
0182 e000 8d 03 LA171 BSR KEYIN GET A CHARACTER FROM CONSOLE IN
0183 e002 27 fc BEQ LA171 LOOP IF NO KEY DOWN
0184 e004 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 e005 b6 ff d0 KEYIN LDA USTAT
0193 e008 85 01 BITA #1
0194 e00a 27 06 BEQ NOCHAR
0195 e00c b6 ff d1 LDA RECEV
0196 e00f 84 7f ANDA #$7F
0197 e011 39 RTS
0198 e012 4f NOCHAR CLRA
0199 e013 39 RTS
0200
0201
0202
0203 * CONSOLE OUT
0204 e014 8d 26 PUTCHR BSR WAITACIA
0205 e016 34 02 PSHS A
0206 e018 81 0d CMPA #CR IS IT CARRIAGE RETURN?
0207 e01a 27 0d BEQ NEWLINE YES
0208 e01c b7 ff d1 STA TRANS
0209 e01f 0c 79 INC LPTPOS INCREMENT CHARACTER COUNTER
0210 e021 96 79 LDA LPTPOS CHECK FOR END OF LINE PRINTER LINE
0211 e023 91 78 CMPA LPTWID AT END OF LINE PRINTER LINE?
0212 e025 25 12 BLO PUTEND NO
0213 e027 20 10 BRA PUTEND Skip newline if not CR
0214 e029 0f 79 NEWLINE CLR LPTPOS
0215 e02b 8d 0f BSR WAITACIA
0216 e02d 86 0d LDA #13 Send CR
0217 e02f b7 ff d1 STA TRANS
0218 e032 8d 08 BSR WAITACIA
0219 e034 86 0a LDA #10 Send LF after CR
0220 e036 b7 ff d1 STA TRANS
0221 e039 35 02 PUTEND PULS A
0222 e03b 39 RTS
0223
0224 e03c 34 02 WAITACIA PSHS A
0225 e03e b6 ff d0 WRWAIT LDA USTAT
0226 e041 85 02 BITA #2
0227 e043 27 f9 BEQ WRWAIT
0228 e045 35 02 PULS A
0229 e047 39 RTS
0230
0231 * ALLOW CHOICE OF COLD OR WARM START
0232 e048 10 ce 01 ee RESVEC LDS #LINBUF+LBUFMX+1 SET STACK TO TOP OF LINE INPUT BUFFER
0233 e04c 86 0c LDA #$0C Load FF (Form Feed) character to clear screen
0234 e04e bd e0 14 JSR PUTCHR Send it to clear the screen
0235 e051 8e e1 57 LDX #PROMPT POINT TO PROMPT MESSAGE
0236 e054 a6 80 PRLOOP LDA ,X+ GET NEXT CHARACTER FROM PROMPT
0237 e056 27 05 BEQ KCHECK EXIT IF NULL TERMINATOR
0238 e058 bd e0 14 JSR PUTCHR PRINT CHARACTER
0239 e05b 20 f7 BRA PRLOOP CONTINUE PRINTING
0240 e05d b6 ff d0 KCHECK LDA USTAT CHECK UART STATUS
0241 e060 85 01 BITA #1 TEST INPUT READY BIT
0242 e062 27 f9 BEQ KCHECK LOOP UNTIL KEY PRESSED
0243 e064 b6 ff d1 LDA RECEV GET CHARACTER FROM UART
0244 e067 84 7f ANDA #$7F MASK TO 7 BITS
0245 e069 81 43 CMPA #'C CHECK FOR COLD START REQUEST
0246 e06b 27 14 BEQ BACDST DO COLD START IF REQUESTED
0247 e06d 81 57 CMPA #'W CHECK FOR WARM START REQUEST
0248 e06f 27 06 BEQ DOWARM DO WARM START IF REQUESTED
0249 e071 96 6e LDA RSTFLG DEFAULT TO FLAG CHECK IF NO VALID KEY
0250 e073 81 55 CMPA #$55 IS IT A WARM START?
0251 e075 26 0a BNE BACDST NO - DO A COLD START
0252 e077 9e 6f DOWARM LDX RSTVEC WARM START VECTOR
0253 e079 a6 84 LDA ,X GET FIRST BYTE OF WARM START ADDR
0254 e07b 81 12 CMPA #$12 IS IT NOP?
0255 e07d 26 02 BNE BACDST NO - DO A COLD START
0256 e07f 6e 84 JMP ,X YES, GO THERE
0257
0258 * COLD START ENTRY
0259
0260 e081 8e 02 18 BACDST LDX #PROGST+1 POINT X TO CLEAR 1ST 1K OF RAM
0261 e084 6f 83 LA077 CLR ,--X MOVE POINTER DOWN TWO-CLEAR BYTE
0262 e086 30 01 LEAX 1,X ADVANCE POINTER ONE
0263 e088 26 fa BNE LA077 KEEP GOING IF NOT AT BOTTOM OF PAGE 0
0264 e08a 8e 02 17 LDX #PROGST SET TO START OF PROGRAM SPACE
0265 e08d 6f 80 CLR ,X+ CLEAR 1ST BYTE OF BASIC PROGRAM
0266 e08f 9f 19 STX TXTTAB BEGINNING OF BASIC PROGRAM
0267 e091 a6 02 LA084 LDA 2,X LOOK FOR END OF MEMORY
0268 e093 43 COMA * COMPLEMENT IT AND PUT IT BACK
0269 e094 a7 02 STA 2,X * INTO SYSTEM MEMORY
0270 e096 a1 02 CMPA 2,X IS IT RAM?
0271 e098 26 06 BNE LA093 BRANCH IF NOT (ROM, BAD RAM OR NO RAM)
0272 e09a 30 01 LEAX 1,X MOVE POINTER UP ONE
0273 e09c 63 01 COM 1,X RE-COMPLEMENT TO RESTORE BYTE
0274 e09e 20 f1 BRA LA084 KEEP LOOKING FOR END OF RAM
0275 e0a0 9f 71 LA093 STX TOPRAM SAVE ABSOLUTE TOP OF RAM
0276 e0a2 9f 27 STX MEMSIZ SAVE TOP OF STRING SPACE
0277 e0a4 9f 23 STX STRTAB SAVE START OF STRING VARIABLES
0278 e0a6 30 89 ff 38 LEAX -200,X CLEAR 200 - DEFAULT STRING SPACE TO 200 BYTES
0279 e0aa 9f 21 STX FRETOP SAVE START OF STRING SPACE
0280 e0ac 1f 14 TFR X,S PUT STACK THERE
0281 e0ae 8e e0 f5 LDX #LA10D POINT X TO ROM SOURCE DATA
0282 e0b1 ce 00 76 LDU #LPTCFW POINT U TO RAM DESTINATION
0283 e0b4 c6 12 LDB #18 MOVE 18 BYTES
0284 e0b6 bd e1 f1 JSR LA59A MOVE 18 BYTES FROM ROM TO RAM
0285 e0b9 ce 00 a7 LDU #IRQVEC POINT U TO NEXT RAM DESTINATION
0286 e0bc c6 04 LDB #4 MOVE 4 MORE BYTES
0287 e0be bd e1 f1 JSR LA59A MOVE 4 BYTES FROM ROM TO RAM
0288 e0c1 86 39 LDA #$39
0289 e0c3 97 f0 STA LINHDR-1 PUT RTS IN LINHDR-1
0290 e0c5 bd e4 fd JSR LAD19 G0 DO A <20>NEW<45>
0291 * EXTENDED BASIC INITIALISATION
0292 e0c8 8e 00 b5 LDX #USR0 INITIALIZE ADDRESS OF START OF
0293 e0cb 9f 8d STX USRADR USR JUMP TABLE
0294 * INITIALIZE THE USR CALLS TO <20>FC ERROR<4F>
0295 e0cd ce ec 11 LDU #LB44A ADDRESS OF <20>FC ERROR<4F> ROUTINE
0296 e0d0 c6 0a LDB #10 10 USR CALLS IN EX BASIC
0297 e0d2 ef 81 L8031 STU ,X++ STORE <20>FC<46> ERROR AT USR ADDRESSES
0298 e0d4 5a DECB FINISHED ALL 10?
0299 e0d5 26 fb BNE L8031 NO
0300
0301 * INITIALISE ACIA
0302 e0d7 86 95 LDA #RTS_LOW DIV16 CLOCK -> 7372800 / 4 / 16 = 115200
0303 e0d9 b7 ff d0 STA UCTRL
0304 e0dc 8e e1 2a LDX #LA147-1 POINT X TO COLOR BASIC COPYRIGHT MESSAGE
0305 e0df bd f1 25 JSR LB99C PRINT <20>COLOR BASIC<49>
0306 e0e2 8e e0 ed LDX #BAWMST WARM START ADDRESS
0307 e0e5 9f 6f STX RSTVEC SAVE IT
0308 e0e7 86 55 LDA #$55 WARM START FLAG
0309 e0e9 97 6e STA RSTFLG SAVE IT
0310 e0eb 20 04 BRA LA0F3 GO TO BASIC<49>S MAIN LOOP
0311 e0ed 12 BAWMST NOP NOP REQ<45>D FOR WARM START
0312 e0ee bd e5 17 JSR LAD33 DO PART OF A NEW
0313 e0f1 7e e4 65 LA0F3 JMP LAC73 GO TO MAIN LOOP OF BASIC
0314 *
0315 * FIRQ SERVICE ROUTINE
0316 BFRQSV
0317 e0f4 3b RTI
0318 *
0319 * THESE BYTES ARE MOVED TO ADDRESSES $76 - $85 THE DIRECT PAGE
0320 e0f5 10 LA10D FCB 16 TAB FIELD WIDTH
0321 e0f6 40 FCB 64 LAST TAB ZONE
0322 e0f7 ff FCB 255 PRINTER WIDTH
0323 e0f8 00 FCB 0 LINE PRINTER POSITION
0324 e0f9 ec 11 FDB LB44A ARGUMENT OF EXEC COMMAND - SET TO <20>FC<46> ERROR
0325 * LINE INPUT ROUTINE
0326 e0fb 0c 84 INC CHARAD+1
0327 e0fd 26 02 BNE LA123
0328 e0ff 0c 83 INC CHARAD
0329 e101 b6 00 00 LA123 LDA >0000
0330 e104 7e e2 02 JMP BROMHK
0331 *
0332 * THESE BYTES ARE MOVED TO ADDRESSES $A7-$B1
0333 e107 7e e2 01 JMP BIRQSV IRQ SERVICE
0334 e10a 7e e0 f4 JMP BFRQSV FIRQ SERVICE
0335 e10d 7e ec 11 JMP LB44A USR ADDRESS FOR 8K BASIC (INITIALIZED TO <20>FC<46> ERROR)
0336 e110 80 FCB $80 *RANDOM SEED
0337 e111 4f c7 FDB $4FC7 *RANDON SEED OF MANTISSA
0338 e113 52 59 FDB $5259 *.811635157
0339 * BASIC COMMAND INTERPRETATION TABLE ROM IMAGE
0340 e115 32 COMVEC FCB 50 50 BASIC COMMANDS
0341 e116 e2 60 FDB LAA66 POINTS TO RESERVED WORDS
0342 e118 e3 6d FDB LAB67 POINTS TO JUMP TABLE FOR COMMANDS
0343 e11a 1d FCB 29 29 BASIC SECONDARY COMMANDS
0344 e11b e3 00 FDB LAB1A POINTS TO SECONDARY FUNCTION RESERVED WORDS
0345 e11d e2 11 FDB LAA29 POINTS TO SECONDARY FUNCTION JUMP TABLE
0346 e11f 00 00 FDB 0 NO MORE TABLES (RES WORDS=0)
0347 e121 00 00 FDB 0 NO MORE TABLES
0348 e123 00 00 FDB 0 NO MORE TABLES
0349 e125 00 00 FDB 0 NO MORE TABLES
0350 e127 00 00 FDB 0 NO MORE TABLES
0351 e129 00 00 FDB 0 NO MORE TABLES (SECONDARY FNS =0)
0352
0353 * COPYRIGHT MESSAGES
0354 e12b 36 38 30 39 20 45 LA147 FCC "6809 EXTENDED BASIC"
58 54 45 4e 44 45
44 20 42 41 53 49
43
0355 e13e 0d FCB CR
0356 e13f 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
0357 e154 0d 0d LA156 FCB CR,CR
0358 e156 00 LA165 FCB $00
0359
0360 e157 43 4f 4c 44 20 4f PROMPT FCC "COLD OR WARM START (C/W)? "
52 20 57 41 52 4d
20 53 54 41 52 54
20 28 43 2f 57 29
3f 20
0361 e171 0d FCB CR
0362 e172 00 FCB $00
0363
0364 e173 34 16 LA35F PSHS X,B,A SAVE REGISTERS
0365 e175 9e 76 LDX LPTCFW TAB FIELD WIDTH AND TAB ZONE
0366 e177 dc 78 LDD LPTWID PRINTER WIDTH AND POSITION
0367 e179 9f 6a LA37C STX DEVCFW SAVE TAB FIELD WIDTH AND ZONE
0368 e17b d7 6c STB DEVPOS SAVE PRINT POSITION
0369 e17d 97 6d STA DEVWID SAVE PRINT WIDTH
0370 e17f 35 96 PULS A,B,X,PC RESTORE REGISTERS
0371
0372 * THIS IS THE ROUTINE THAT GETS AN INPUT LINE FOR BASIC
0373 * EXIT WITH BREAK KEY: CARRY = 1
0374 * EXIT WITH ENTER KEY: CARRY = 0
0375 LA38D
0376 e181 0f 73 LA390 CLR IKEYIM RESET BREAK CHECK KEY TEMP KEY STORAGE
0377 e183 8e 00 f4 LDX #LINBUF+1 INPUT LINE BUFFER
0378 e186 c6 01 LDB #1 ACCB CHAR COUNTER: SET TO 1 TO ALLOW A
0379 * BACKSPACE AS FIRST CHARACTER
0380 e188 bd e0 00 LA39A JSR LA171 GO GET A CHARACTER FROM CONSOLE IN
0381 e18b 81 08 CMPA #BS BACKSPACE
0382 e18d 26 07 BNE LA3B4 NO
0383 e18f 5a DECB YES - DECREMENT CHAR COUNTER
0384 e190 27 ef BEQ LA390 BRANCH IF BACK AT START OF LINE AGAIN
0385 e192 30 1f LEAX -1,X DECREMENT BUFFER POINTER
0386 e194 20 34 BRA LA3E8 ECHO CHAR TO SCREEN
0387 e196 81 15 LA3B4 CMPA #$15 SHIFT RIGHT ARROW?
0388 e198 26 0a BNE LA3C2 NO
0389 * YES, RESET BUFFER TO BEGINNING AND ERASE CURRENT LINE
0390 e19a 5a LA3B8 DECB DEC CHAR CTR
0391 e19b 27 e4 BEQ LA390 GO BACK TO START IF CHAR CTR = 0
0392 e19d 86 08 LDA #BS BACKSPACE?
0393 e19f bd e0 14 JSR PUTCHR SEND TO CONSOLE OUT (SCREEN)
0394 e1a2 20 f6 BRA LA3B8 KEEP GOING
0395 e1a4 81 03 LA3C2 CMPA #3 BREAK KEY?
0396 e1a6 1a 01 ORCC #1 SET CARRY FLAG
0397 e1a8 27 05 BEQ LA3CD BRANCH IF BREAK KEY DOWN
0398 e1aa 81 0d LA3C8 CMPA #CR ENTER KEY?
0399 e1ac 26 0d BNE LA3D9 NO
0400 e1ae 4f LA3CC CLRA CLEAR CARRY FLAG IF ENTER KEY - END LINE ENTRY
0401 e1af 34 01 LA3CD PSHS CC SAVE CARRY FLAG
0402 e1b1 bd f0 e5 JSR LB958 SEND CR TO SCREEN
0403 e1b4 6f 84 CLR ,X MAKE LAST BYTE IN INPUT BUFFER = 0
0404 e1b6 8e 00 f3 LDX #LINBUF RESET INPUT BUFFER POINTER
0405 e1b9 35 81 PULS CC,PC RESTORE CARRY FLAG
0406
0407 * INSERT A CHARACTER INTO THE BASIC LINE INPUT BUFFER
0408 e1bb 81 20 LA3D9 CMPA #$20 IS IT CONTROL CHAR?
0409 e1bd 25 c9 BLO LA39A BRANCH IF CONTROL CHARACTER
0410 e1bf 81 7b CMPA #'z+1 *
0411 e1c1 24 c5 BCC LA39A * IGNORE IF > LOWER CASE Z
0412 e1c3 c1 fa CMPB #LBUFMX HAVE 250 OR MORE CHARACTERS BEEN ENTERED?
0413 e1c5 24 c1 BCC LA39A YES, IGNORE ANY MORE
0414 e1c7 a7 80 STA ,X+ PUT IT IN INPUT BUFFER
0415 e1c9 5c INCB INCREMENT CHARACTER COUNTER
0416 e1ca bd e0 14 LA3E8 JSR PUTCHR ECHO IT TO SCREEN
0417 e1cd 20 b9 BRA LA39A GO SET SOME MORE
0418
0419
0420 * EXEC
0421 e1cf 27 05 EXEC BEQ LA545 BRANCH IF NO ARGUMENT
0422 e1d1 bd ef 04 JSR LB73D EVALUATE ARGUMENT - ARGUMENT RETURNED IN X
0423 e1d4 9f 7a STX EXECJP STORE X TO EXEC JUMP ADDRESS
0424 e1d6 6e 9f 00 7a LA545 JMP [EXECJP] GO DO IT
0425
0426 * BREAK CHECK
0427 e1da 7e e5 e6 LA549 JMP LADEB GO DO BREAK KEY CHECK
0428
0429 * INKEY$
0430 e1dd 96 73 INKEY LDA IKEYIM WAS A KEY DOWN IN THE BREAK CHECK?
0431 e1df 26 03 BNE LA56B YES
0432 e1e1 bd e0 05 JSR KEYIN GO GET A KEY
0433 e1e4 0f 73 LA56B CLR IKEYIM CLEAR INKEY RAM IMAGE
0434 e1e6 97 53 STA FPA0+3 STORE THE KEY IN FPA0
0435 e1e8 10 26 0c 6a LBNE LB68F CONVERT FPA0+3 TO A STRING
0436 e1ec 97 56 STA STRDES SET LENGTH OF STRING = 0 IF NO KEY DOWN
0437 e1ee 7e ee 62 JMP LB69B PUT A NULL STRING ONTO THE STRING STACK
0438
0439 * MOVE ACCB BYTES FROM (X) TO (U)
0440 e1f1 a6 80 LA59A LDA ,X+ GET BYTE FROM X
0441 e1f3 a7 c0 STA ,U+ STORE IT AT U
0442 e1f5 5a DECB MOVED ALL BYTES?
0443 e1f6 26 f9 BNE LA59A NO
0444 e1f8 39 LA5A1 RTS
0445
0446 e1f9 39 LA5C4 RTS
0447
0448 ** THIS ROUTINE WILL SCAN OFF THE FILE NAME FROM A BASIC LINE
0449 ** AND RETURN A SYNTAX ERROR IF THERE ARE ANY CHARACTERS
0450 ** FOLLOWING THE END OF THE NAME
0451 e1fa 9d 82 LA5C7 JSR GETCCH GET CURRENT INPUT CHAR FROM BASIC LINE
0452 e1fc 27 fb LA5C9 BEQ LA5C4 RETURN IF END OF LINE
0453 e1fe 7e ea 43 JMP LB277 SYNTAX ERROR IF ANY MORE CHARACTERS
0454 * IRQ SERVICE
0455 BIRQSV
0456 e201 3b LA9C5 RTI RETURN FROM INTERRUPT
0457
0458 * SET CARRY IF NUMERIC - RETURN WITH
0459 * ZERO FLAG SET IF ACCA = 0 OR 3A(:) - END
0460 * OF BASIC LINE OR SUB LINE
0461 e202 81 3a BROMHK CMPA #'9+1 IS THIS CHARACTER >=(ASCII 9)+1?
0462 e204 24 0a BHS LAA28 BRANCH IF > 9; Z SET IF = COLON
0463 e206 81 20 CMPA #SPACE SPACE?
0464 e208 26 02 BNE LAA24 NO - SET CARRY IF NUMERIC
0465 e20a 0e 7c JMP GETNCH IF SPACE, GET NECT CHAR (IGNORE SPACES)
0466 e20c 80 30 LAA24 SUBA #'0 * SET CARRY IF
0467 e20e 80 d0 SUBA #-'0 * CHARACTER > ASCII 0
0468 e210 39 LAA28 RTS
0469
0470 * DISPATCH TABLE FOR SECONDARY FUNCTIONS
0471 * TOKENS ARE PRECEEDED BY $FF
0472 * FIRST SET ALWAYS HAS ONE PARAMETER
0473 FUNC_TAB
0474 e211 f4 03 LAA29 FDB SGN SGN
0475 e213 f4 77 FDB INT INT
0476 e215 f4 1c FDB ABS ABS
0477 e217 00 ad FDB USRJMP USR
0478 0083 TOK_USR EQU *-FUNC_TAB/2+$7F
0479 ff83 TOK_FF_USR EQU *-FUNC_TAB/2+$FF7F
0480 e219 f6 a8 FDB RND RND
0481 e21b f6 fd FDB SIN SIN
0482 e21d ef 17 FDB PEEK PEEK
0483 e21f ee 48 FDB LEN LEN
0484 e221 ec c4 FDB STR STR$
0485 e223 ee dd FDB VAL VAL
0486 e225 ee 67 FDB ASC ASC
0487 e227 ee 53 FDB CHR CHR$
0488 e229 f7 ad FDB ATN ATN
0489 e22b f7 75 FDB COS COS
0490 e22d f7 7e FDB TAN TAN
0491 e22f f8 ef FDB EXP EXP
0492 e231 f9 21 FDB FIX FIX
0493 e233 f8 43 FDB LOG LOG
0494 e235 fa a9 FDB POS POS
0495 e237 f8 7d FDB SQR SQR
0496 e239 ff 7b FDB HEXDOL HEX$
0497 * LEFT, RIGHT AND MID ARE TREATED SEPARATELY
0498 e23b ee 72 FDB LEFT LEFT$
0499 0095 TOK_LEFT EQU *-FUNC_TAB/2+$7F
0500 e23d ee 8f FDB RIGHT RIGHT$
0501 e23f ee 96 FDB MID MID$
0502 0097 TOK_MID EQU *-FUNC_TAB/2+$7F
0503 * REMAINING FUNCTIONS
0504 e241 e1 dd FDB INKEY INKEY$
0505 0098 TOK_INKEY EQU *-FUNC_TAB/2+$7F
0506 e243 ec b5 FDB MEM MEM
0507 e245 fa b1 FDB VARPT VARPTR
0508 e247 fb 71 FDB INSTR INSTR
0509 e249 fb 41 FDB STRING STRING$
0510 001d NUM_SEC_FNS EQU *-FUNC_TAB/2
0511
0512 * THIS TABLE CONTAINS PRECEDENCES AND DISPATCH ADDRESSES FOR ARITHMETIC
0513 * AND LOGICAL OPERATORS - THE NEGATION OPERATORS DO NOT ACT ON TWO OPERANDS
0514 * S0 THEY ARE NOT LISTED IN THIS TABLE. THEY ARE TREATED SEPARATELY IN THE
0515 * EXPRESSION EVALUATION ROUTINE. THEY ARE:
0516 * UNARY NEGATION (-), PRECEDENCE &7D AND LOGICAL NEGATION (NOT), PRECEDENCE $5A
0517 * THE RELATIONAL OPERATORS < > = ARE ALSO NOT LISTED, PRECEDENCE $64.
0518 * A PRECEDENCE VALUE OF ZERO INDICATES END OF EXPRESSION OR PARENTHESES
0519 *
0520 e24b 79 LAA51 FCB $79
0521 e24c f1 4e FDB LB9C5 +
0522 e24e 79 FCB $79
0523 e24f f1 45 FDB LB9BC -
0524 e251 7b FCB $7B
0525 e252 f2 55 FDB LBACC *
0526 e254 7b FCB $7B
0527 e255 f3 1a FDB LBB91 /
0528 e257 7f FCB $7F
0529 e258 f8 86 FDB L8489 EXPONENTIATION
0530 e25a 50 FCB $50
0531 e25b ea 9c FDB LB2D5 AND
0532 e25d 46 FCB $46
0533 e25e ea 9b FDB LB2D4 OR
0534
0535 * THIS IS THE RESERVED WORD TABLE
0536 * FIRST PART OF THE TABLE CONTAINS EXECUTABLE COMMANDS
0537 e260 46 4f LAA66 FCC "FO" 80
0538 e262 d2 FCB $80+'R'
0539 e263 47 FCC "G" 81
0540 e264 cf FCB $80+'O'
0541 0081 TOK_GO EQU $81
0542 e265 52 45 FCC "RE" 82
0543 e267 cd FCB $80+'M'
0544 e268 a7 FCB ''+$80 83
0545 e269 45 4c 53 FCC "ELS" 84
0546 e26c c5 FCB $80+'E'
0547 e26d 49 FCC "I" 85
0548 e26e c6 FCB $80+'F'
0549 e26f 44 41 54 FCC "DAT" 86
0550 e272 c1 FCB $80+'A'
0551 e273 50 52 49 4e FCC "PRIN" 87
0552 e277 d4 FCB $80+'T'
0553 e278 4f FCC "O" 88
0554 e279 ce FCB $80+'N'
0555 e27a 49 4e 50 55 FCC "INPU" 89
0556 e27e d4 FCB $80+'T'
0557 e27f 45 4e FCC "EN" 8A
0558 e281 c4 FCB $80+'D'
0559 e282 4e 45 58 FCC "NEX" 8B
0560 e285 d4 FCB $80+'T'
0561 e286 44 49 FCC "DI" 8C
0562 e288 cd FCB $80+'M'
0563 e289 52 45 41 FCC "REA" 8D
0564 e28c c4 FCB $80+'D'
0565 e28d 52 55 FCC "RU" 8E
0566 e28f ce FCB $80+'N'
0567 e290 52 45 53 54 4f 52 FCC "RESTOR" 8F
0568 e296 c5 FCB $80+'E'
0569 e297 52 45 54 55 52 FCC "RETUR" 90
0570 e29c ce FCB $80+'N'
0571 e29d 53 54 4f FCC "STO" 91
0572 e2a0 d0 FCB $80+'P'
0573 e2a1 50 4f 4b FCC "POK" 92
0574 e2a4 c5 FCB $80+'E'
0575 e2a5 43 4f 4e FCC "CON" 93
0576 e2a8 d4 FCB $80+'T'
0577 e2a9 4c 49 53 FCC "LIS" 94
0578 e2ac d4 FCB $80+'T'
0579 e2ad 43 4c 45 41 FCC "CLEA" 95
0580 e2b1 d2 FCB $80+'R'
0581 e2b2 4e 45 FCC "NE" 96
0582 e2b4 d7 FCB $80+'W'
0583 e2b5 45 58 45 FCC "EXE" 97
0584 e2b8 c3 FCB $80+'C'
0585 e2b9 54 52 4f FCC "TRO" 98
0586 e2bc ce FCB $80+'N'
0587 e2bd 54 52 4f 46 FCC "TROF" 99
0588 e2c1 c6 FCB $80+'F'
0589 e2c2 44 45 FCC "DE" 9A
0590 e2c4 cc FCB $80+'L'
0591 e2c5 44 45 FCC "DE" 9B
0592 e2c7 c6 FCB $80+'F'
0593 e2c8 4c 49 4e FCC "LIN" 9C
0594 e2cb c5 FCB $80+'E'
0595 e2cc 52 45 4e 55 FCC "RENU" 9D
0596 e2d0 cd FCB $80+'M'
0597 e2d1 45 44 49 FCC "EDI" 9E
0598 e2d4 d4 FCB $80+'T'
0599 * END OF EXECUTABLE COMMANDS. THE REMAINDER OF THE TABLE ARE NON-EXECUTABLE TOKENS
0600 e2d5 54 41 42 FCC "TAB" 9F
0601 e2d8 a8 FCB $80+'('
0602 009f TOK_TAB EQU $9F
0603 e2d9 54 FCC "T" A0
0604 e2da cf FCB $80+'O'
0605 00a0 TOK_TO EQU $A0
0606 e2db 53 55 FCC "SU" A1
0607 e2dd c2 FCB $80+'B'
0608 00a1 TOK_SUB EQU $A1
0609 e2de 54 48 45 FCC "THE" A2
0610 e2e1 ce FCB $80+'N'
0611 00a2 TOK_THEN EQU $A2
0612 e2e2 4e 4f FCC "NO" A3
0613 e2e4 d4 FCB $80+'T'
0614 00a3 TOK_NOT EQU $A3
0615 e2e5 53 54 45 FCC "STE" A4
0616 e2e8 d0 FCB $80+'P'
0617 00a4 TOK_STEP EQU $A4
0618 e2e9 4f 46 FCC "OF" A5
0619 e2eb c6 FCB $80+'F'
0620 e2ec ab FCB '++$80 A6
0621 00a6 TOK_PLUS EQU $A6
0622 e2ed ad FCB '-+$80 A7
0623 00a7 TOK_MINUS EQU $A7
0624 e2ee aa FCB '*+$80 A8
0625 e2ef af FCB '/+$80 A9
0626 e2f0 de FCB '^+$80 AA
0627 e2f1 41 4e FCC "AN" AB
0628 e2f3 c4 FCB $80+'D'
0629 e2f4 4f FCC "O" AC
0630 e2f5 d2 FCB $80+'R'
0631 e2f6 be FCB '>+$80 AD
0632 00ad TOK_GREATER EQU $AD
0633 e2f7 bd FCB '=+$80 AE
0634 00ae TOK_EQUALS EQU $AE
0635 e2f8 bc FCB '<+$80 AF
0636 e2f9 46 FCC "F" B0
0637 e2fa ce FCB $80+'N'
0638 00b0 TOK_FN EQU $B0
0639 e2fb 55 53 49 4e FCC "USIN" B1
0640 e2ff c7 FCB $80+'G'
0641 *
0642
0643 * FIRST SET ALWAYS HAS ONE PARAMETER
0644 e300 53 47 LAB1A FCC "SG" 80
0645 e302 ce FCB $80+'N'
0646 e303 49 4e FCC "IN" 81
0647 e305 d4 FCB $80+'T'
0648 e306 41 42 FCC "AB" 82
0649 e308 d3 FCB $80+'S'
0650 e309 55 53 FCC "US" 83
0651 e30b d2 FCB $80+'R'
0652 e30c 52 4e FCC "RN" 84
0653 e30e c4 FCB $80+'D'
0654 e30f 53 49 FCC "SI" 85
0655 e311 ce FCB $80+'N'
0656 e312 50 45 45 FCC "PEE" 86
0657 e315 cb FCB $80+'K'
0658 e316 4c 45 FCC "LE" 87
0659 e318 ce FCB $80+'N'
0660 e319 53 54 52 FCC "STR" 88
0661 e31c a4 FCB $80+'$'
0662 e31d 56 41 FCC "VA" 89
0663 e31f cc FCB $80+'L'
0664 e320 41 53 FCC "AS" 8A
0665 e322 c3 FCB $80+'C'
0666 e323 43 48 52 FCC "CHR" 8B
0667 e326 a4 FCB $80+'$'
0668 e327 41 54 FCC "AT" 8C
0669 e329 ce FCB $80+'N'
0670 e32a 43 4f FCC "CO" 8D
0671 e32c d3 FCB $80+'S'
0672 e32d 54 41 FCC "TA" 8E
0673 e32f ce FCB $80+'N'
0674 e330 45 58 FCC "EX" 8F
0675 e332 d0 FCB $80+'P'
0676 e333 46 49 FCC "FI" 90
0677 e335 d8 FCB $80+'X'
0678 e336 4c 4f FCC "LO" 91
0679 e338 c7 FCB $80+'G'
0680 e339 50 4f FCC "PO" 92
0681 e33b d3 FCB $80+'S'
0682 e33c 53 51 FCC "SQ" 93
0683 e33e d2 FCB $80+'R'
0684 e33f 48 45 58 FCC "HEX" 94
0685 e342 a4 FCB $80+'$'
0686 * LEFT, RIGHT AND MID ARE TREATED SEPARATELY
0687 e343 4c 45 46 54 FCC "LEFT" 95
0688 e347 a4 FCB $80+'$'
0689 e348 52 49 47 48 54 FCC "RIGHT" 96
0690 e34d a4 FCB $80+'$'
0691 e34e 4d 49 44 FCC "MID" 97
0692 e351 a4 FCB $80+'$'
0693 * REMAINING FUNCTIONS
0694 e352 49 4e 4b 45 59 FCC "INKEY" 98
0695 e357 a4 FCB $80+'$'
0696 e358 4d 45 FCC "ME" 99
0697 e35a cd FCB $80+'M'
0698 e35b 56 41 52 50 54 FCC "VARPT" 9A
0699 e360 d2 FCB $80+'R'
0700 e361 49 4e 53 54 FCC "INST" 9B
0701 e365 d2 FCB $80+'R'
0702 e366 53 54 52 49 4e 47 FCC "STRING" 9C
0703 e36c a4 FCB $80+'$'
0704
0705 *
0706 * DISPATCH TABLE FOR COMMANDS TOKEN #
0707 CMD_TAB
0708 e36d e5 2b LAB67 FDB FOR 80
0709 e36f e6 76 FDB GO 81
0710 e371 e6 d3 FDB REM 82
0711 0082 TOK_REM EQU *-CMD_TAB/2+$7F
0712 e373 e6 d3 FDB REM 83 (')
0713 0083 TOK_SNGL_Q EQU *-CMD_TAB/2+$7F
0714 e375 e6 d3 FDB REM 84 (ELSE)
0715 0084 TOK_ELSE EQU *-CMD_TAB/2+$7F
0716 e377 e7 04 FDB IF 85
0717 0085 TOK_IF EQU *-CMD_TAB/2+$7F
0718 e379 e6 d0 FDB DATA 86
0719 0086 TOK_DATA EQU *-CMD_TAB/2+$7F
0720 e37b f0 ad FDB PRINT 87
0721 0087 TOK_PRINT EQU *-CMD_TAB/2+$7F
0722 e37d e7 32 FDB ON 88
0723 e37f e7 df FDB INPUT 89
0724 0089 TOK_INPUT EQU *-CMD_TAB/2+$7F
0725 e381 e5 fd FDB END 8A
0726 e383 e8 c4 FDB NEXT 8B
0727 e385 eb 15 FDB DIM 8C
0728 e387 e8 19 FDB READ 8D
0729 e389 e6 6b FDB RUN 8E
0730 e38b e5 df FDB RESTOR 8F
0731 e38d e6 b0 FDB RETURN 90
0732 e38f e6 01 FDB STOP 91
0733 e391 ef 1e FDB POKE 92
0734 e393 e6 26 FDB CONT 93
0735 e395 ef 25 FDB LIST 94
0736 e397 e6 37 FDB CLEAR 95
0737 e399 e4 fb FDB NEW 96
0738 e39b e1 cf FDB EXEC 97
0739 e39d fa a4 FDB TRON 98
0740 e39f fa a5 FDB TROFF 99
0741 e3a1 fd 20 FDB DEL 9A
0742 e3a3 fc 64 FDB DEF 9B
0743 e3a5 ff bf FDB LINE 9C
0744 e3a7 fd aa FDB RENUM 9D
0745 e3a9 f9 30 FDB EDIT 9E
0746 009e TOK_HIGH_EXEC EQU *-CMD_TAB/2+$7F
0747
0748 * ERROR MESSAGES AND THEIR NUMBERS AS USED INTERNALLY
0749 e3ab 4e 46 LABAF FCC "NF" 0 NEXT WITHOUT FOR
0750 e3ad 53 4e FCC "SN" 1 SYNTAX ERROR
0751 e3af 52 47 FCC "RG" 2 RETURN WITHOUT GOSUB
0752 e3b1 4f 44 FCC "OD" 3 OUT OF DATA
0753 e3b3 46 43 FCC "FC" 4 ILLEGAL FUNCTION CALL
0754 e3b5 4f 56 FCC "OV" 5 OVERFLOW
0755 e3b7 4f 4d FCC "OM" 6 OUT OF MEMORY
0756 e3b9 55 4c FCC "UL" 7 UNDEFINED LINE NUMBER
0757 e3bb 42 53 FCC "BS" 8 BAD SUBSCRIPT
0758 e3bd 44 44 FCC "DD" 9 REDIMENSIONED ARRAY
0759 e3bf 2f 30 FCC "/0" 10 DIVISION BY ZERO
0760 e3c1 49 44 FCC "ID" 11 ILLEGAL DIRECT STATEMENT
0761 e3c3 54 4d FCC "TM" 12 TYPE MISMATCH
0762 e3c5 4f 53 FCC "OS" 13 OUT OF STRING SPACE
0763 e3c7 4c 53 FCC "LS" 14 STRING TOO LONG
0764 e3c9 53 54 FCC "ST" 15 STRING FORMULA TOO COMPLEX
0765 e3cb 43 4e FCC "CN" 16 CAN'T CONTINUE
0766 e3cd 46 44 FCC "FD" 17 BAD FILE DATA
0767 e3cf 41 4f FCC "AO" 18 FILE ALREADY OPEN
0768 e3d1 44 4e FCC "DN" 19 DEVICE NUMBER ERROR
0769 e3d3 49 4f FCC "IO" 20 I/O ERROR
0770 e3d5 46 4d FCC "FM" 21 BAD FILE MODE
0771 e3d7 4e 4f FCC "NO" 22 FILE NOT OPEN
0772 e3d9 49 45 FCC "IE" 23 INPUT PAST END OF FILE
0773 e3db 44 53 FCC "DS" 24 DIRECT STATEMENT IN FILE
0774 * ADDITIONAL ERROR MESSAGES ADDED BY EXTENDED BASIC
0775 e3dd 55 46 L890B FCC "UF" 25 UNDEFINED FUNCTION (FN) CALL
0776 e3df 4e 45 L890D FCC "NE" 26 FILE NOT FOUND
0777
0778 e3e1 20 45 52 52 4f 52 LABE1 FCC " ERROR"
0779 e3e7 00 FCB $00
0780 e3e8 20 49 4e 20 LABE8 FCC " IN "
0781 e3ec 00 FCB $00
0782 e3ed 0d LABED FCB CR
0783 e3ee 4f 4b LABEE FCC "OK"
0784 e3f0 0d 00 FCB CR,$00
0785 e3f2 0d LABF2 FCB CR
0786 e3f3 42 52 45 41 4b FCC "BREAK"
0787 e3f8 00 FCB $00
0788
0789 * SEARCH THE STACK FOR <20>GOSUB/RETURN<52> OR <20>FOR/NEXT<58> DATA.
0790 * THE <20>FOR/NEXT<58> INDEX VARIABLE DESCRIPTOR ADDRESS BEING
0791 * SOUGHT IS STORED IN VARDES. EACH BLOCK OF FOR/NEXT DATA IS 18
0792 * BYTES WITH A $80 LEADER BYTE AND THE GOSUB/RETURN DATA IS 5 BYTES
0793 * WITH AN $A6 LEADER BYTE. THE FIRST NON "FOR/NEXT" DATA
0794 * IS CONSIDERED <20>GOSUB/RETURN<52>
0795 e3f9 30 64 LABF9 LEAX 4,S POINT X TO 3RD ADDRESS ON STACK - IGNORE THE
0796 * FIRST TWO RETURN ADDRESSES ON THE STACK
0797 e3fb c6 12 LABFB LDB #18 18 BYTES SAVED ON STACK FOR EACH <20>FOR<4F> LOOP
0798 e3fd 9f 0f STX TEMPTR SAVE POINTER
0799 e3ff a6 84 LDA ,X GET 1ST BYTE
0800 e401 80 80 SUBA #$80 * CHECK FOR TYPE OF STACK JUMP FOUND
0801 e403 26 15 BNE LAC1A * BRANCH IF NOT <20>FOR/NEXT<58>
0802 e405 ae 01 LDX 1,X = GET INDEX VARIABLE DESCRIPTOR
0803 e407 9f 11 STX TMPTR1 = POINTER AND SAVE IT IN TMPTR1
0804 e409 9e 3b LDX VARDES GET INDEX VARIABLE BEING SEARCHED FOR
0805 e40b 27 09 BEQ LAC16 BRANCH IF DEFAULT INDEX VARIABLE - USE THE
0806 * FIRST <20>FOR/NEXT<58> DATA FOUND ON STACK
0807 * IF NO INDEX VARIABLE AFTER <20>NEXT<58>
0808 e40d 9c 11 CMPX TMPTR1 DOES THE STACK INDEX MATCH THE ONE
0809 * BEING SEARCHED FOR?
0810 e40f 27 09 BEQ LAC1A YES
0811 e411 9e 0f LDX TEMPTR * RESTORE INITIAL POINTER, ADD
0812 e413 3a ABX * 18 TO IT AND LOOK FOR
0813 e414 20 e5 BRA LABFB * NEXT BLOCK OF DATA
0814 e416 9e 11 LAC16 LDX TMPTR1 = GET 1ST INDEX VARIABLE FOUND AND
0815 e418 9f 3b STX VARDES = SAVE AS <20>NEXT<58> INDEX
0816 e41a 9e 0f LAC1A LDX TEMPTR POINT X TO START OF <20>FOR/NEXT<58> DATA
0817 e41c 4d TSTA SET ZERO FLAG IF <20>FOR/NEXT<58> DATA
0818 e41d 39 RTS
0819 * CHECK FOR MEMORY SPACE FOR NEW TOP OF
0820 * ARRAYS AND MOVE ARRAYS TO NEW LOCATION
0821 e41e 8d 17 LAC1E BSR LAC37 ACCD = NEW BOTTOM OF FREE RAM - IS THERE
0822 * ROOM FOR THE STACK?
0823 * MOVE BYTES FROM V43(X) TO V41(U) UNTIL (X) = V47 AND
0824 * SAVE FINAL VALUE OF U IN V45
0825 e420 de 41 LAC20 LDU V41 POINT U TO DESTINATION ADDRESS (V41)
0826 e422 33 41 LEAU 1,U ADD ONE TO U - COMPENSATE FOR FIRST PSHU
0827 e424 9e 43 LDX V43 POINT X TO SOURCE ADDRESS (V43)
0828 e426 30 01 LEAX 1,X ADD ONE - COMPENSATE FOR FIRST LDA ,X
0829 e428 a6 82 LAC28 LDA ,-X GRAB A BYTE FROM SOURCE
0830 e42a 36 02 PSHU A MOVE IT TO DESTINATION
0831 e42c 9c 47 CMPX V47 DONE?
0832 e42e 26 f8 BNE LAC28 NO - KEEP MOVING BYTES
0833 e430 df 45 STU V45 SAVE FINAL DESTINATION ADDRESS
0834 e432 39 LAC32 RTS
0835 * CHECK TO SEE IF THERE IS ROOM TO STORE 2*ACCB
0836 * BYTES IN FREE RAM - OM ERROR IF NOT
0837 e433 4f LAC33 CLRA * ACCD CONTAINS NUMBER OF EXTRA
0838 e434 58 ASLB * BYTES TO PUT ON STACK
0839 e435 d3 1f ADDD ARYEND END OF PROGRAM AND VARIABLES
0840 e437 c3 00 3a LAC37 ADDD #STKBUF ADD STACK BUFFER - ROOM FOR STACK?
0841 e43a 25 08 BCS LAC44 BRANCH IF GREATER THAN $FFFF
0842 e43c 10 df 17 STS BOTSTK CURRENT NEW BOTTOM OF STACK STACK POINTER
0843 e43f 10 93 17 CMPD BOTSTK ARE WE GOING TO BE BELOW STACK?
0844 e442 25 ee BCS LAC32 YES - NO ERROR
0845 e444 c6 0c LAC44 LDB #6*2 OUT OF MEMORY ERROR
0846
0847 * ERROR SERVICING ROUTINE
0848 e446 bd e5 17 LAC46 JSR LAD33 RESET STACK, STRING STACK, CONTINUE POINTER
0849 e449 bd f0 e9 JSR LB95C SEND A CR TO SCREEN
0850 e44c bd f1 38 JSR LB9AF SEND A <20>?<3F> TO SCREEN
0851 e44f 8e e3 ab LDX #LABAF POINT TO ERROR TABLE
0852 e452 3a LAC60 ABX ADD MESSAGE NUMBER OFFSET
0853 e453 8d 31 BSR LACA0 * GET TWO CHARACTERS FROM X AND
0854 e455 8d 2f BSR LACA0 * SEND TO CONSOLE OUT (SCREEN)
0855 e457 8e e3 e0 LDX #LABE1-1 POINT TO "ERROR" MESSAGE
0856 e45a bd f1 25 LAC68 JSR LB99C PRINT MESSAGE POINTED TO BY X
0857 e45d 96 68 LDA CURLIN GET CURRENT LINE NUMBER (CURL IN)
0858 e45f 4c INCA TEST FOR DIRECT MODE
0859 e460 27 03 BEQ LAC73 BRANCH IF DIRECT MODE
0860 e462 bd f5 4e JSR LBDC5 PRINT <20>IN ****<2A>
0861
0862 * THIS IS THE MAIN LOOP OF BASIC WHEN IN DIRECT MODE
0863 e465 bd f0 e9 LAC73 JSR LB95C MOVE CURSOR TO START OF LINE
0864 e468 8e e3 ed LDX #LABED POINT X TO <20>OK<4F>, CR MESSAGE
0865 e46b bd f1 25 JSR LB99C PRINT <20>OK<4F>, CR
0866 e46e bd e1 81 LAC7C JSR LA390 GO GET AN INPUT LINE
0867 e471 ce ff ff LDU #$FFFF THE LINE NUMBER FOR DIRECT MODE IS $FFFF
0868 e474 df 68 STU CURLIN SAVE IT IN CURLIN
0869 e476 25 f6 BCS LAC7C BRANCH IF LINE INPUT TERMINATED BY BREAK
0870 e478 9f 83 STX CHARAD SAVE (X) AS CURRENT INPUT POINTER - THIS WILL
0871 * ENABLE THE <20>LIVE KEYBOARD<52> (DIRECT) MODE. THE
0872 * LINE JUST ENTERED WILL BE INTERPRETED
0873 e47a 9d 7c JSR GETNCH GET NEXT CHARACTER FROM BASIC
0874 e47c 27 f0 BEQ LAC7C NO LINE INPUT - GET ANOTHER LINE
0875 e47e 25 0b BCS LACA5 BRANCH IF NUMER1C - THERE WAS A LINE NUMBER BEFORE
0876 * THE STATEMENT ENTERED, SO THIS STATEMENT
0877 * WILL BE MERGED INTO THE BASIC PROGRAM
0878 e480 bd ef da JSR LB821 GO CRUNCH LINE
0879 e483 7e e5 b4 JMP LADC0 GO EXECUTE THE STATEMENT (LIVE KEYBOARD)
0880 *
0881 e486 a6 80 LACA0 LDA ,X+ GET A CHARACTER
0882 e488 7e f1 3a JMP LB9B1 SEND TO CONSOLE OUT
0883 * TAKE A LINE FROM THE LINE INPUT BUFFER
0884 * AND INSERT IT INTO THE BASIC PROGRAM
0885 e48b bd e7 57 LACA5 JSR LAF67 CONVERT LINE NUMBER TO BINARY
0886 e48e 9e 2b LACA8 LDX BINVAL GET CONVERTED LINE NUMBER
0887 e490 9f f1 STX LINHDR STORE IT IN LINE INPUT HEADER
0888 e492 bd ef da JSR LB821 GO CRUNCH THE LINE
0889 e495 d7 03 STB TMPLOC SAVE LINE LENGTH
0890 e497 8d 4c BSR LAD01 FIND OUT WHERE TO INSERT LINE
0891 e499 25 12 BCS LACC8 BRANCH IF LINE NUMBER DOES NOT ALREADY EXIST
0892 e49b dc 47 LDD V47 GET ABSOLUTE ADDRESS OF LINE NUMBER
0893 e49d a3 84 SUBD ,X SUBTRACT ADDRESS OF NEXT LINE NUMBER
0894 e49f d3 1b ADDD VARTAB * ADD TO CURRENT END OF PROGRAM - THIS WILL REMOVE
0895 e4a1 dd 1b STD VARTAB * THE LENGTH OF THIS LINE NUMBER FROM THE PROGRAM
0896 e4a3 ee 84 LDU ,X POINT U TO ADDRESS OF NEXT LINE NUMBER
0897 * DELETE OLD LINE FROM BASIC PROGRAM
0898 e4a5 37 02 LACC0 PULU A GET A BYTE FROM WHAT<41>S LEFT OF PROGRAM
0899 e4a7 a7 80 STA ,X+ MOVE IT DOWN
0900 e4a9 9c 1b CMPX VARTAB COMPARE TO END OF BASIC PROGRAM
0901 e4ab 26 f8 BNE LACC0 BRANCH IF NOT AT END
0902 e4ad 96 f3 LACC8 LDA LINBUF * CHECK TO SEE IF THERE IS A LINE IN
0903 e4af 27 1c BEQ LACE9 * THE BUFFER AND BRANCH IF NONE
0904 e4b1 dc 1b LDD VARTAB = SAVE CURRENT END OF
0905 e4b3 dd 43 STD V43 = PROGRAM IN V43
0906 e4b5 db 03 ADDB TMPLOC * ADD LENGTH OF CRUNCHED LINE,
0907 e4b7 89 00 ADCA #0 * PROPOGATE CARRY AND SAVE NEW END
0908 e4b9 dd 41 STD V41 * OF PROGRAM IN V41
0909 e4bb bd e4 1e JSR LAC1E = MAKE SURE THERE<52>S ENOUGH RAM FOR THIS
0910 * = LINE & MAKE A HOLE IN BASIC FOR NEW LINE
0911 e4be ce 00 ef LDU #LINHDR-2 POINT U TO LINE TO BE INSERTED
0912 e4c1 37 02 LACDD PULU A GET A BYTE FROM NEW LINE
0913 e4c3 a7 80 STA ,X+ INSERT IT IN PROGRAM
0914 e4c5 9c 45 CMPX V45 * COMPARE TO ADDRESS OF END OF INSERTED
0915 e4c7 26 f8 BNE LACDD * LINE AND BRANCH IF NOT DONE
0916 e4c9 9e 41 LDX V41 = GET AND SAVE
0917 e4cb 9f 1b STX VARTAB = END OF PROGRAM
0918 e4cd 8d 36 LACE9 BSR LAD21 RESET INPUT POINTER, CLEAR VARIABLES, INITIALIZE
0919 e4cf 8d 02 BSR LACEF ADJUST START OF NEXT LINE ADDRESSES
0920 e4d1 20 9b BRA LAC7C REENTER BASIC<49>S INPUT LOOP
0921 * COMPUTE THE START OF NEXT LINE ADDRESSES FOR THE BASIC PROGRAM
0922 e4d3 9e 19 LACEF LDX TXTTAB POINT X TO START OF PROGRAM
0923 e4d5 ec 84 LACF1 LDD ,X GET ADDRESS OF NEXT LINE
0924 e4d7 27 21 BEQ LAD16 RETURN IF END OF PROGRAM
0925 e4d9 33 04 LEAU 4,X POINT U TO START OF BASIC TEXT IN LINE
0926 e4db a6 c0 LACF7 LDA ,U+ * SKIP THROUGH THE LINE UNTIL A
0927 e4dd 26 fc BNE LACF7 * ZERO (END OF LINE) IS FOUND
0928 e4df ef 84 STU ,X SAVE THE NEW START OF NEXT LINE ADDRESS
0929 e4e1 ae 84 LDX ,X POINT X TO START OF NEXT LINE
0930 e4e3 20 f0 BRA LACF1 KEEP GOING
0931 *
0932 * FIND A LINE NUMBER IN THE BASIC PROGRAM
0933 * RETURN WITH CARRY SET IF NO MATCH FOUND
0934 e4e5 dc 2b LAD01 LDD BINVAL GET THE LINE NUMBER TO FIND
0935 e4e7 9e 19 LDX TXTTAB BEGINNING OF PROGRAM
0936 e4e9 ee 84 LAD05 LDU ,X GET ADDRESS OF NEXT LINE NUMBER
0937 e4eb 27 09 BEQ LAD12 BRANCH IF END OF PROG
0938 e4ed 10 a3 02 CMPD 2,X IS IT A MATCH?
0939 e4f0 23 06 BLS LAD14 CARRY SET IF LOWER; CARRY CLEAR IF MATCH
0940 e4f2 ae 84 LDX ,X X = ADDRESS OF NEXT LINE
0941 e4f4 20 f3 BRA LAD05 KEEP LOOPING FOR LINE NUMBER
0942 e4f6 1a 01 LAD12 ORCC #1 SET CARRY FLAG
0943 e4f8 9f 47 LAD14 STX V47 SAVE MATCH LINE NUMBER OR NUMBER OF LINE JUST AFTER
0944 * WHERE IT SHOULD HAVE BEEN
0945 e4fa 39 LAD16 RTS
0946
0947 * NEW
0948 e4fb 26 fb NEW BNE LAD14 BRANCH IF ARGUMENT GIVEN
0949 e4fd 9e 19 LAD19 LDX TXTTAB GET START OF BASIC
0950 e4ff 6f 80 CLR ,X+ * PUT 2 ZERO BYTES THERE - ERASE
0951 e501 6f 80 CLR ,X+ * THE BASIC PROGRAM
0952 e503 9f 1b STX VARTAB AND THE NEXT ADDRESS IS NOW THE END OF PROGRAM
0953 e505 9e 19 LAD21 LDX TXTTAB GET START OF BASIC
0954 e507 bd e6 ab JSR LAEBB PUT INPUT POINTER ONE BEFORE START OF BASIC
0955 * ERASE ALL VARIABLES
0956 e50a 9e 27 LAD26 LDX MEMSIZ * RESET START OF STRING VARIABLES
0957 e50c 9f 23 STX STRTAB * TO TOP OF STRING SPACE
0958 e50e bd e5 df JSR RESTOR RESET <20>DATA<54> POINTER TO START OF BASIC
0959 e511 9e 1b LDX VARTAB * GET START OF VARIABLES AND USE IT
0960 e513 9f 1d STX ARYTAB * TO RESET START OF ARRAYS
0961 e515 9f 1f STX ARYEND RESET END OF ARRAYS
0962 e517 8e 00 c9 LAD33 LDX #STRSTK * RESET STRING STACK POINTER TO
0963 e51a 9f 0b STX TEMPPT * BOTTOM OF STRING STACK
0964 e51c ae e4 LDX ,S GET RETURN ADDRESS OFF STACK
0965 e51e 10 de 21 LDS FRETOP RESTORE STACK POINTER
0966 e521 6f e2 CLR ,-S PUT A ZERO BYTE ON STACK - TO CLEAR ANY RETURN OF
0967 * FOR/NEXT DATA FROM THE STACK
0968 e523 0f 2d CLR OLDPTR RESET <20>CONT<4E> ADDRESS SO YOU
0969 e525 0f 2e CLR OLDPTR+1 <20>CAN<41>T CONTINUE<55>
0970 e527 0f 08 CLR ARYDIS CLEAR THE ARRAY DISABLE FLAG
0971 e529 6e 84 JMP ,X RETURN TO CALLING ROUTINE - THIS IS NECESSARY
0972 * SINCE THE STACK WAS RESET
0973 *
0974 * FOR
0975 *
0976 * THE FOR COMMAND WILL STORE 18 BYTES ON THE STACK FOR
0977 * EACH FOR-NEXT LOOP WHICH IS BEING PROCESSED. THESE
0978 * BYTES ARE DEFINED AS FOLLOWS: 0- $80 (FOR FLAG);
0979 * 1,2=INDEX VARIABLE DESCRIPTOR POINTER; 3-7=FP VALUE OF STEP;
0980 * 8=STEP DIRECTION: $FF IF NEGATIVE; 0 IF ZERO; 1 IF POSITIVE;
0981 * 9-13=FP VALUE OF <20>TO<54> PARAMETER;
0982 * 14,15=CURRENT LINE NUMBER; 16,17=RAM ADDRESS OF THE END
0983 * OF THE LINE CONTAINING THE <20>FOR<4F> STATEMENT
0984 e52b 86 80 FOR LDA #$80 * SAVE THE DISABLE ARRAY FLAG IN VO8
0985 e52d 97 08 STA ARYDIS * DO NOT ALLOW THE INDEX VARIABLE TO BE AN ARRAY
0986 e52f bd e7 79 JSR LET SET INDEX VARIABLE TO INITIAL VALUE
0987 e532 bd e3 f9 JSR LABF9 SEARCH THE STACK FOR <20>FOR/NEXT<58> DATA
0988 e535 32 62 LEAS 2,S PURGE RETURN ADDRESS OFF OF THE STACK
0989 e537 26 04 BNE LAD59 BRANCH IF INDEX VARIABLE NOT ALREADY BEING USED
0990 e539 9e 0f LDX TEMPTR GET (ADDRESS + 18) OF MATCHED <20>FOR/NEXT<58> DATA
0991 e53b 32 85 LEAS B,X MOVE THE STACK POINTER TO THE BEGINNING OF THE
0992 * MATCHED <20>FOR/NEXT<58> DATA SO THE NEW DATA WILL
0993 * OVERLAY THE OLD DATA. THIS WILL ALSO DESTROY
0994 * ALL OF THE <20>RETURN<52> AND <20>FOR/NEXT<58> DATA BELOW
0995 * THIS POINT ON THE STACK
0996 e53d c6 09 LAD59 LDB #$09 * CHECK FOR ROOM FOR 18 BYTES
0997 e53f bd e4 33 JSR LAC33 * IN FREE RAM
0998 e542 bd e6 d8 JSR LAEE8 GET ADDR OF END OF SUBLINE IN X
0999 e545 dc 68 LDD CURLIN GET CURRENT LINE NUMBER
1000 e547 34 16 PSHS X,B,A SAVE LINE ADDR AND LINE NUMBER ON STACK
1001 e549 c6 a0 LDB #TOK_TO TOKEN FOR <20>TO<54>
1002 e54b bd ea 3b JSR LB26F SYNTAX CHECK FOR <20>TO<54>
1003 e54e bd e9 0f JSR LB143 <20>TM<54> ERROR IF INDEX VARIABLE SET TO STRING
1004 e551 bd e9 0d JSR LB141 EVALUATE EXPRESSION
1005 *
1006 e554 d6 54 LDB FP0SGN GET FPA0 MANTISSA SIGN
1007 e556 ca 7f ORB #$7F FORM A MASK TO SAVE DATA BITS OF HIGH ORDER MANTISSA
1008 e558 d4 50 ANDB FPA0 PUT THE MANTISSA SIGN IN BIT 7 OF HIGH ORDER MANTISSA
1009 e55a d7 50 STB FPA0 SAVE THE PACKED HIGH ORDER MANTISSA
1010 e55c 10 8e e5 63 LDY #LAD7F LOAD FOLLOWING ADDRESS INTO Y AS A RETURN
1011 e560 7e e9 b6 JMP LB1EA ADDRESS - PUSH FPA0 ONTO THE STACK
1012 e563 8e f2 4e LAD7F LDX #LBAC5 POINT X TO FLOATING POINT NUMBER 1.0 (DEFAULT STEP VALUE)
1013 e566 bd f3 9d JSR LBC14 MOVE (X) TO FPA0
1014 e569 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1015 e56b 81 a4 CMPA #TOK_STEP STEP TOKEN
1016 e56d 26 05 BNE LAD90 BRANCH IF NO <20>STEP<45> VALUE
1017 e56f 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
1018 e571 bd e9 0d JSR LB141 EVALUATE NUMERIC EXPRESSION
1019 e574 bd f3 f6 LAD90 JSR LBC6D CHECK STATUS OF FPA0
1020 e577 bd e9 b2 JSR LB1E6 SAVE STATUS AND FPA0 ON THE STACK
1021 e57a dc 3b LDD VARDES * GET DESCRIPTOR POINTER FOR THE <20>STEP<45>
1022 e57c 34 06 PSHS B,A * VARIABLE AND SAVE IT ON THE STACK
1023 e57e 86 80 LDA #$80 = GET THE <20>FOR<4F> FLAG AND
1024 e580 34 02 PSHS A = SAVE IT ON THE STACK
1025 *
1026 * MAIN COMMAND INTERPRETATION LOOP
1027 e582 1c af LAD9E ANDCC #$AF ENABLE IRQ,FIRQ
1028 e584 8d 60 BSR LADEB CHECK FOR KEYBOARD BREAK
1029 e586 9e 83 LDX CHARAD GET BASIC<49>S INPUT POINTER
1030 e588 9f 2f STX TINPTR SAVE IT
1031 e58a a6 80 LDA ,X+ GET CURRENT INPUT CHAR & MOVE POINTER
1032 e58c 27 07 BEQ LADB4 BRANCH IF END OF LINE
1033 e58e 81 3a CMPA #': CHECK FOR LINE SEPARATOR
1034 e590 27 22 BEQ LADC0 BRANCH IF COLON
1035 e592 7e ea 43 LADB1 JMP LB277 <20>SYNTAX ERROR<4F>-IF NOT LINE SEPARATOR
1036 e595 a6 81 LADB4 LDA ,X++ GET MS BYTE OF ADDRESS OF NEXT BASIC LINE
1037 e597 97 00 STA ENDFLG SAVE IN STOP/END FLAG - CAUSE A STOP IF
1038 * NEXT LINE ADDRESS IS < $8000; CAUSE
1039 * AN END IF ADDRESS > $8000
1040 e599 27 72 BEQ LAE15 BRANCH TO <20>STOP<4F> - END OF PROGRAM
1041 e59b ec 80 LDD ,X+ GET CURRENT LINE NUMBER
1042 e59d dd 68 STD CURLIN SAVE IN CURLIN
1043 e59f 9f 83 STX CHARAD SAVE ADDRESS OF FIRST BYTE OF LINE
1044 * EXTENDED BASIC TRACE
1045 e5a1 96 8c LDA TRCFLG TEST THE TRACE FLAG
1046 e5a3 27 0f BEQ LADC0 BRANCH IF TRACE OFF
1047 e5a5 86 5b LDA #$5B <LEFT HAND MARKER FOR TRON LINE NUMBER
1048 e5a7 bd e0 14 JSR PUTCHR OUTPUT A CHARACTER
1049 e5aa 96 68 LDA CURLIN GET MS BYTE OF LINE NUMBER
1050 e5ac bd f5 55 JSR LBDCC CONVERT ACCD TO DECIMAL AND PRINT ON SCREEN
1051 e5af 86 5d LDA #$5D > RIGHT HAND MARKER FOR TRON LINE NUMBER
1052 e5b1 bd e0 14 JSR PUTCHR OUTPUT A CHARACTER
1053 * END OF EXTENDED BASIC TRACE
1054 e5b4 9d 7c LADC0 JSR GETNCH GET A CHARACTER FROM BASIC
1055 e5b6 8d 02 BSR LADC6 GO PROCESS COMMAND
1056 e5b8 20 c8 BRA LAD9E GO BACK TO MAIN LOOP
1057 e5ba 27 29 LADC6 BEQ LADEA RETURN IF END OF LINE (RTS - was BEQ LAE40)
1058 e5bc 4d TSTA CHECK FOR TOKEN - BIT 7 SET (NEGATIVE)
1059 e5bd 10 2a 01 b8 LBPL LET BRANCH IF NOT A TOKEN - GO DO A <20>LET<45> WHICH
1060 * IS THE <20>DEFAULT<4C> TOKEN FOR MICROSOFT BASIC
1061 e5c1 81 ff CMPA #$FF SECONDARY TOKEN
1062 e5c3 27 0f BEQ SECTOK
1063 e5c5 81 9e CMPA #TOK_HIGH_EXEC SKIPF TOKEN - HIGHEST EXECUTABLE COMMAND IN BASIC
1064 e5c7 22 c9 BHI LADB1 <20>SYNTAX ERROR<4F> IF NON-EXECUTABLE TOKEN
1065 e5c9 be e1 18 LDX COMVEC+3 GET ADDRESS OF BASIC<49>S COMMAND TABLE
1066 e5cc 48 LADD4 ASLA X2 (2 BYTE/JUMP ADDRESS) & DISCARD BIT 7
1067 e5cd 1f 89 TFR A,B SAVE COMMAND OFFSET IN ACCB
1068 e5cf 3a ABX NON X POINTS TO COMMAND JUMP ADDR
1069 e5d0 9d 7c JSR GETNCH GET AN INPUT CHAR
1070 *
1071 * HERE IS WHERE WE BRANCH TO DO A <20>COMMAND<4E>
1072 e5d2 6e 94 JMP [,X] GO DO A COMMAND
1073 SECTOK
1074 * THE ONLY SECONDARY TOKEN THAT CAN ALSO BE AN EXECUTABLE IS
1075 * THE MID$ REPLACEMENT STATEMENT. SO SPECIAL-CASE CHECK DONE HERE
1076 e5d4 9d 7c JSR GETNCH GET AN INPUT CHAR
1077 e5d6 81 97 CMPA #TOK_MID TOKEN FOR "MID$"
1078 e5d8 10 27 14 ed LBEQ L86D6 PROCESS MID$ REPLACEMENT
1079 e5dc 7e ea 43 JMP LB277 SYNTAX ERROR
1080
1081 *
1082 * RESTORE
1083 e5df 9e 19 RESTOR LDX TXTTAB BEGINNING OF PROGRAM ADDRESS
1084 e5e1 30 1f LEAX -1,X MOVE TO ONE BYTE BEFORE PROGRAM
1085 e5e3 9f 33 LADE8 STX DATPTR SAVE NEW DATA POINTER
1086 e5e5 39 LADEA RTS
1087 *
1088 * BREAK CHECK
1089 e5e6 bd e0 05 LADEB JSR LA1C1 GET A KEYSTROKE ENTRY
1090 e5e9 27 0a BEQ LADFA RETURN IF NO INPUT
1091 e5eb 81 03 LADF0 CMPA #3 CONTROL C? (BREAK)
1092 e5ed 27 12 BEQ STOP YES
1093 e5ef 81 13 CMPA #$13 CONTROL S? (PAUSE)
1094 e5f1 27 03 BEQ LADFB YES
1095 e5f3 97 73 STA IKEYIM SAVE KEYSTROKE IN INKEY IMAGE
1096 e5f5 39 LADFA RTS
1097 e5f6 bd e0 05 LADFB JSR KEYIN GET A KEY
1098 e5f9 27 fb BEQ LADFB BRANCH IF NO KEY DOWN
1099 e5fb 20 ee BRA LADF0 CONTINUE - DO A BREAK CHECK
1100 *
1101 * END
1102 e5fd 9d 82 END JSR GETCCH GET CURRENT INPUT CHAR
1103 e5ff 20 02 BRA LAE0B
1104 *
1105 * STOP
1106 e601 1a 01 STOP ORCC #$01 SET CARRY FLAG
1107 e603 26 31 LAE0B BNE LAE40 BRANCH IF ARGUMENT EXISTS
1108 e605 9e 83 LDX CHARAD * SAVE CURRENT POSITION OF
1109 e607 9f 2f STX TINPTR * BASIC<49>S INPUT POINTER
1110 e609 06 00 LAE11 ROR ENDFLG ROTATE CARRY INTO BIT 7 OF STOP/END FLAG
1111 e60b 32 62 LEAS 2,S PURGE RETURN ADDRESS OFF STACK
1112 e60d 9e 68 LAE15 LDX CURLIN GET CURRENT LINE NUMBER
1113 e60f 8c ff ff CMPX #$FFFF DIRECT MODE?
1114 e612 27 06 BEQ LAE22 YES
1115 e614 9f 29 STX OLDTXT SAVE CURRENT LINE NUMBER
1116 e616 9e 2f LDX TINPTR * GET AND SAVE CURRENT POSITION
1117 e618 9f 2d STX OLDPTR * OF BASIC<49>S INPUT POINTER
1118 LAE22
1119 e61a 8e e3 f1 LDX #LABF2-1 POINT TO CR, <20>BREAK<41> MESSAGE
1120 e61d 0d 00 TST ENDFLG CHECK STOP/END FLAG
1121 e61f 10 2a fe 42 LBPL LAC73 BRANCH TO MAIN LOOP OF BASIC IF END
1122 e623 7e e4 5a JMP LAC68 PRINT <20>BREAK AT ####<23> AND GO TO
1123 * BASIC<49>S MAIN LOOP IF <20>STOP<4F>
1124
1125 * CONT
1126 e626 26 0e CONT BNE LAE40 RETURN IF ARGUMENT GIVEN
1127 e628 c6 20 LDB #2*16 <20>CAN<41>T CONTINUE<55> ERROR
1128 e62a 9e 2d LDX OLDPTR GET CONTINUE ADDRESS (INPUT POINTER)
1129 e62c 10 27 fe 16 LBEQ LAC46 <20>CN<43> ERROR IF CONTINUE ADDRESS = 0
1130 e630 9f 83 STX CHARAD RESET BASIC<49>S INPUT POINTER
1131 e632 9e 29 LDX OLDTXT GET LINE NUMBER
1132 e634 9f 68 STX CURLIN RESET CURRENT LINE NUMBER
1133 e636 39 LAE40 RTS
1134 *
1135 * CLEAR
1136 e637 27 2c CLEAR BEQ LAE6F BRANCH IF NO ARGUMENT
1137 e639 bd eb ad JSR LB3E6 EVALUATE ARGUMENT
1138 e63c 34 06 PSHS B,A SAVE AMOUNT OF STRING SPACE ON STACK
1139 e63e 9e 27 LDX MEMSIZ GET CURRENT TOP OF CLEARED SPACE
1140 e640 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1141 e642 27 0c BEQ LAE5A BRANCH IF NO NEW TOP OF CLEARED SPACE
1142 e644 bd ea 39 JSR LB26D SYNTAX CHECK FOR COMMA
1143 e647 bd ef 04 JSR LB73D EVALUATE EXPRESSlON; RETURN VALUE IN X
1144 e64a 30 1f LEAX -1,X X = TOP OF CLEARED SPACE
1145 e64c 9c 71 CMPX TOPRAM COMPARE TO TOP OF RAM
1146 e64e 22 18 BHI LAE72 <20>OM<4F> ERROR IF > TOP OF RAM
1147 e650 1f 10 LAE5A TFR X,D ACCD = TOP OF CLEARED SPACE
1148 e652 a3 e1 SUBD ,S++ SUBTRACT OUT AMOUNT OF CLEARED SPACE
1149 e654 25 12 BCS LAE72 <20>OM<4F> ERROR IF FREE MEM < 0
1150 e656 1f 03 TFR D,U U = BOTTOM OF CLEARED SPACE
1151 e658 83 00 3a SUBD #STKBUF SUBTRACT OUT STACK BUFFER
1152 e65b 25 0b BCS LAE72 <20>OM<4F> ERROR IF FREE MEM < 0
1153 e65d 93 1b SUBD VARTAB SUBTRACT OUT START OF VARIABLES
1154 e65f 25 07 BCS LAE72 <20>OM<4F> ERROR IF FREE MEM < 0
1155 e661 df 21 STU FRETOP SAVE NEW BOTTOM OF CLEARED SPACE
1156 e663 9f 27 STX MEMSIZ SAVE NEW TOP OF CLEARED SPACE
1157 e665 7e e5 0a LAE6F JMP LAD26 ERASE ALL VARIABLES, INITIALIZE POINTERS, ETC
1158 e668 7e e4 44 LAE72 JMP LAC44 <20>OM<4F> ERROR
1159 *
1160 * RUN
1161 e66b 9d 82 RUN JSR GETCCH * GET CURRENT INPUT CHARACTER
1162 e66d 10 27 fe 94 LBEQ LAD21 * IF NO LINE NUMBER
1163 e671 bd e5 0a JSR LAD26 ERASE ALL VARIABLES
1164 e674 20 19 BRA LAE9F <20>GOTO<54> THE RUN ADDRESS
1165 *
1166 * GO
1167 e676 1f 89 GO TFR A,B SAVE INPUT CHARACTER IN ACCB
1168 e678 9d 7c LAE88 JSR GETNCH GET A CHARACTER FROM BASIC
1169 e67a c1 a0 CMPB #TOK_TO <20>TO<54> TOKEN
1170 e67c 27 16 BEQ LAEA4 BRANCH IF GOTO
1171 e67e c1 a1 CMPB #TOK_SUB <20>SUB<55> TOKEN
1172 e680 26 45 BNE LAED7 <20>SYNTAX ERROR<4F> IF NEITHER
1173 e682 c6 03 LDB #3 =ROOM FOR 6
1174 e684 bd e4 33 JSR LAC33 =BYTES ON STACK?
1175 e687 de 83 LDU CHARAD * SAVE CURRENT BASIC INPUT POINTER, LINE
1176 e689 9e 68 LDX CURLIN * NUMBER AND SUB TOKEN ON STACK
1177 e68b 86 a1 LDA #TOK_SUB *
1178 e68d 34 52 PSHS U,X,A *
1179 e68f 8d 03 LAE9F BSR LAEA4 GO DO A <20>GOTO<54>
1180 e691 7e e5 82 JMP LAD9E JUMP BACK TO BASIC<49>S MAIN LOOP
1181 * GOTO
1182 e694 9d 82 LAEA4 JSR GETCCH GET CURRENT INPUT CHAR
1183 e696 bd e7 57 JSR LAF67 GET LINE NUMBER TO BINARY IN BINVAL
1184 e699 8d 40 BSR LAEEB ADVANCE BASIC<49>S POINTER TO END OF LINE
1185 e69b 30 01 LEAX $01,X POINT TO START OF NEXT LINE
1186 e69d dc 2b LDD BINVAL GET THE LINE NUMBER TO RUN
1187 e69f 10 93 68 CMPD CURLIN COMPARE TO CURRENT LINE NUMBER
1188 e6a2 22 02 BHI LAEB6 IF REO<45>D LINE NUMBER IS > CURRENT LINE NUMBER,
1189 * DON<4F>T START LOOKING FROM
1190 * START OF PROGRAM
1191 e6a4 9e 19 LDX TXTTAB BEGINNING OF PROGRAM
1192 e6a6 bd e4 e9 LAEB6 JSR LAD05 GO FIND A LINE NUMBER
1193 e6a9 25 17 BCS LAED2 <20>UNDEFINED LINE NUMBER<45>
1194 e6ab 30 1f LAEBB LEAX -1,X MOVE BACK TO JUST BEFORE START OF LINE
1195 e6ad 9f 83 STX CHARAD RESET BASIC<49>S INPUT POINTER
1196 e6af 39 LAEBF RTS
1197 *
1198 * RETURN
1199 e6b0 26 fd RETURN BNE LAEBF EXIT ROUTINE IF ARGUMENT GIVEN
1200 e6b2 86 ff LDA #$FF * PUT AN ILLEGAL VARIABLE NAME IN FIRST BYTE OF
1201 e6b4 97 3b STA VARDES * VARDES WHICH WILL CAUSE <20>FOR/NEXT<58> DATA ON THE
1202 * STACK TO BE IGNORED
1203 e6b6 bd e3 f9 JSR LABF9 CHECK FOR RETURN DATA ON THE STACK
1204 e6b9 1f 14 TFR X,S RESET STACK POINTER - PURGE TWO RETURN ADDRESSES
1205 * FROM THE STACK
1206 e6bb 81 21 CMPA #TOK_SUB-$80 SUB TOKEN - $80
1207 e6bd 27 0b BEQ LAEDA BRANCH IF <20>RETURN<52> FROM SUBROUTINE
1208 e6bf c6 04 LDB #2*2 ERROR #2 <20>RETURN WITHOUT GOSUB<55>
1209 e6c1 8c FCB SKP2 SKIP TWO BYTES
1210 e6c2 c6 0e LAED2 LDB #7*2 ERROR #7 <20>UNDEFINED LINE NUMBER<45>
1211 e6c4 7e e4 46 JMP LAC46 JUMP TO ERROR HANDLER
1212 e6c7 7e ea 43 LAED7 JMP LB277 <20>SYNTAX ERROR<4F>
1213 e6ca 35 52 LAEDA PULS A,X,U * RESTORE VALUES OF CURRENT LINE NUMBER AND
1214 e6cc 9f 68 STX CURLIN * BASIC<49>S INPUT POINTER FOR THIS SUBROUTINE
1215 e6ce df 83 STU CHARAD * AND LOAD ACCA WITH SUB TOKEN ($A6)
1216 *
1217 * DATA
1218 e6d0 8d 06 DATA BSR LAEE8 MOVE INPUT POINTER TO END OF SUBLINE OR LINE
1219 e6d2 8c FCB SKP2 SKIP 2 BYTES
1220
1221 * REM, ELSE
1222 ELSE
1223 e6d3 8d 06 REM BSR LAEEB MOVE INPUT POINTER TO END OF LINE
1224 e6d5 9f 83 STX CHARAD RESET BASIC<49>S INPUT POINTER
1225 e6d7 39 LAEE7 RTS
1226 * ADVANCE INPUT POINTER TO END OF SUBLINE OR LINE
1227 e6d8 c6 3a LAEE8 LDB #': COLON = SUBLINE TERMINATOR CHARACTER
1228 e6da 86 LAEEA FCB SKP1LD SKPILD SKIP ONE BYTE; LDA #$5F
1229 * ADVANCE BASIC<49>S INPUT POINTER TO END OF
1230 * LINE - RETURN ADDRESS OF END OF LINE+1 IN X
1231 e6db 5f LAEEB CLRB 0 = LINE TERMINATOR CHARACTER
1232 e6dc d7 01 STB CHARAC TEMP STORE PRIMARY TERMINATOR CHARACTER
1233 e6de 5f CLRB 0 (END OF LINE) = ALTERNATE TERM. CHAR.
1234 e6df 9e 83 LDX CHARAD LOAD X W/BASIC<49>S INPUT POINTER
1235 e6e1 1f 98 LAEF1 TFR B,A * CHANGE TERMINATOR CHARACTER
1236 e6e3 d6 01 LDB CHARAC * FROM ACCB TO CHARAC - SAVE OLD TERMINATOR
1237 * IN CHARAC
1238 e6e5 97 01 STA CHARAC SWAP PRIMARY AND SECONDARY TERMINATORS
1239 e6e7 a6 84 LAEF7 LDA ,X GET NEXT INPUT CHARACTER
1240 e6e9 27 ec BEQ LAEE7 RETURN IF 0 (END OF LINE)
1241 e6eb 34 04 PSHS B SAVE TERMINATOR ON STACK
1242 e6ed a1 e0 CMPA ,S+ COMPARE TO INPUT CHARACTER
1243 e6ef 27 e6 BEQ LAEE7 RETURN IF EQUAL
1244 e6f1 30 01 LEAX 1,X MOVE POINTER UP ONE
1245 e6f3 81 22 CMPA #'" CHECK FOR DOUBLE QUOTES
1246 e6f5 27 ea BEQ LAEF1 BRANCH IF " - TOGGLE TERMINATOR CHARACTERS
1247 e6f7 4c INCA * CHECK FOR $FF AND BRANCH IF
1248 e6f8 26 02 BNE LAF0C * NOT SECONDARY TOKEN
1249 e6fa 30 01 LEAX 1,X MOVE INPUT POINTER 1 MORE IF SECONDARY
1250 e6fc 81 86 LAF0C CMPA #TOK_IF+1 TOKEN FOR IF?
1251 e6fe 26 e7 BNE LAEF7 NO - GET ANOTHER INPUT CHARACTER
1252 e700 0c 04 INC IFCTR INCREMENT IF COUNTER - KEEP TRACK OF HOW MANY
1253 * <20>IF<49> STATEMENTS ARE NESTED IN ONE LINE
1254 e702 20 e3 BRA LAEF7 GET ANOTHER INPUT CHARACTER
1255
1256 * IF
1257 e704 bd e9 0d IF JSR LB141 EVALUATE NUMERIC EXPRESSION
1258 e707 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1259 e709 81 81 CMPA #TOK_GO TOKEN FOR GO
1260 e70b 27 05 BEQ LAF22 TREAT <20>GO<47> THE SAME AS <20>THEN<45>
1261 e70d c6 a2 LDB #TOK_THEN TOKEN FOR THEN
1262 e70f bd ea 3b JSR LB26F DO A SYNTAX CHECK ON ACCB
1263 e712 96 4f LAF22 LDA FP0EXP CHECK FOR TRUE/FALSE - FALSE IF FPA0 EXPONENT = ZERO
1264 e714 26 13 BNE LAF39 BRANCH IF CONDITION TRUE
1265 e716 0f 04 CLR IFCTR CLEAR FLAG - KEEP TRACK OF WHICH NESTED ELSE STATEMENT
1266 * TO SEARCH FOR IN NESTED <20>IF<49> LOOPS
1267 e718 8d b6 LAF28 BSR DATA MOVE BASIC<49>S POINTER TO END OF SUBLINE
1268 e71a 4d TSTA * CHECK TO SEE IF END OF LINE OR SUBLINE
1269 e71b 27 ba BEQ LAEE7 * AND RETURN IF END OF LINE
1270 e71d 9d 7c JSR GETNCH GET AN INPUT CHARACTER FROM BASIC
1271 e71f 81 84 CMPA #TOK_ELSE TOKEN FOR ELSE
1272 e721 26 f5 BNE LAF28 IGNORE ALL DATA EXCEPT <20>ELSE<53> UNTIL
1273 * END OF LINE (ZERO BYTE)
1274 e723 0a 04 DEC IFCTR CHECK TO SEE IF YOU MUST SEARCH ANOTHER SUBLINE
1275 e725 2a f1 BPL LAF28 BRANCH TO SEARCH ANOTHER SUBLINE FOR <20>ELSE<53>
1276 e727 9d 7c JSR GETNCH GET AN INPUT CHARACTER FROM BASIC
1277 e729 9d 82 LAF39 JSR GETCCH GET CURRENT INPUT CHARACTER
1278 e72b 10 25 ff 65 LBCS LAEA4 BRANCH TO <20>GOTO<54> IF NUMERIC CHARACTER
1279 e72f 7e e5 ba JMP LADC6 RETURN TO MAIN INTERPRETATION LOOP
1280
1281 * ON
1282 e732 bd ee d2 ON JSR LB70B EVALUATE EXPRESSION
1283 e735 c6 81 LDB #TOK_GO TOKEN FOR GO
1284 e737 bd ea 3b JSR LB26F SYNTAX CHECK FOR GO
1285 e73a 34 02 PSHS A SAVE NEW TOKEN (TO,SUB)
1286 e73c 81 a1 CMPA #TOK_SUB TOKEN FOR SUB?
1287 e73e 27 04 BEQ LAF54 YES
1288 e740 81 a0 CMPA #TOK_TO TOKEN FOR TO?
1289 e742 26 83 LAF52 BNE LAED7 <20>SYNTAX<41> ERROR IF NOT <20>SUB<55> OR <20>TO<54>
1290 e744 0a 53 LAF54 DEC FPA0+3 DECREMENT IS BYTE OF MANTISSA OF FPA0 - THIS
1291 * IS THE ARGUMENT OF THE <20>ON<4F> STATEMENT
1292 e746 26 05 BNE LAF5D BRANCH IF NOT AT THE PROPER GOTO OR GOSUB LINE NUMBER
1293 e748 35 04 PULS B GET BACK THE TOKEN FOLLOWING <20>GO<47>
1294 e74a 7e e6 78 JMP LAE88 GO DO A <20>GOTO<54> OR <20>GOSUB<55>
1295 e74d 9d 7c LAF5D JSR GETNCH GET A CHARACTER FROM BASIC
1296 e74f 8d 06 BSR LAF67 CONVERT BASIC LINE NUMBER TO BINARY
1297 e751 81 2c CMPA #', IS CHARACTER FOLLOWING LINE NUMBER A COMMA?
1298 e753 27 ef BEQ LAF54 YES
1299 e755 35 84 PULS B,PC IF NOT, FALL THROUGH TO NEXT COMMAND
1300 e757 9e 74 LAF67 LDX ZERO DEFAULT LINE NUMBER OF ZERO
1301 e759 9f 2b STX BINVAL SAVE IT IN BINVAL
1302 *
1303 * CONVERT LINE NUMBER TO BINARY - RETURN VALUE IN BINVAL
1304 *
1305 e75b 24 61 LAF6B BCC LAFCE RETURN IF NOT NUMERIC CHARACTER
1306 e75d 80 30 SUBA #'0 MASK OFF ASCII
1307 e75f 97 01 STA CHARAC SAVE DIGIT IN VO1
1308 e761 dc 2b LDD BINVAL GET ACCUMULATED LINE NUMBER VALUE
1309 e763 81 18 CMPA #24 LARGEST LINE NUMBER IS $F9FF (63999) -
1310 * (24*256+255)*10+9
1311 e765 22 db BHI LAF52 <20>SYNTAX<41> ERROR IF TOO BIG
1312 * MULT ACCD X 10
1313 e767 58 ASLB *
1314 e768 49 ROLA * TIMES 2
1315 e769 58 ASLB =
1316 e76a 49 ROLA = TIMES 4
1317 e76b d3 2b ADDD BINVAL ADD 1 = TIMES 5
1318 e76d 58 ASLB *
1319 e76e 49 ROLA * TIMES 10
1320 e76f db 01 ADDB CHARAC ADD NEXT DIGIT
1321 e771 89 00 ADCA #0 PROPAGATE CARRY
1322 e773 dd 2b STD BINVAL SAVE NEW ACCUMULATED LINE NUMBER
1323 e775 9d 7c JSR GETNCH GET NEXT CHARACTER FROM BASIC
1324 e777 20 e2 BRA LAF6B LOOP- PROCESS NEXT DIGIT
1325 *
1326 * LET (EXBAS)
1327 * EVALUATE A NON-TOKEN EXPRESSION
1328 * TARGET = REPLACEMENT
1329 e779 bd eb 1e LET JSR LB357 FIND TARGET VARIABLE DESCRIPTOR
1330 e77c 9f 3b STX VARDES SAVE DESCRIPTOR ADDRESS OF 1ST EXPRESSION
1331 e77e c6 ae LDB #TOK_EQUALS TOKEN FOR "="
1332 e780 bd ea 3b JSR LB26F DO A SYNTAX CHECK FOR <20>=<3D>
1333 e783 96 06 LDA VALTYP * GET VARIABLE TYPE AND
1334 e785 34 02 PSHS A * SAVE ON THE STACK
1335 e787 bd e9 22 JSR LB156 EVALUATE EXPRESSION
1336 e78a 35 02 PULS A * REGET VARIABLE TYPE OF 1ST EXPRESSION AND
1337 e78c 46 RORA * SET CARRY IF STRING
1338 e78d bd e9 14 JSR LB148 TYPE CHECK-TM ERROR IF VARIABLE TYPES ON
1339 * BOTH SIDES OF EQUALS SIGN NOT THE SAME
1340 e790 10 27 0c 28 LBEQ LBC33 GO PUT FPA0 INTO VARIABLE DESCRIPTOR IF NUMERIC
1341 * MOVE A STRING WHOSE DESCRIPTOR IS LOCATED AT
1342 * FPA0+2 INTO THE STRING SPACE. TRANSFER THE
1343 * DESCRIPTOR ADDRESS TO THE ADDRESS IN VARDES
1344 * DON<4F>T MOVE THE STRING IF IT IS ALREADY IN THE
1345 * STRING SPACE. REMOVE DESCRIPTOR FROM STRING
1346 * STACK IF IT IS LAST ONE ON THE STACK
1347 e794 9e 52 LAFA4 LDX FPA0+2 POINT X TO DESCRIPTOR OF REPLACEMENT STRING
1348 e796 dc 21 LDD FRETOP LOAD ACCD WITH START OF STRING SPACE
1349 e798 10 a3 02 CMPD 2,X IS THE STRING IN STRING SPACE?
1350 e79b 24 11 BCC LAFBE BRANCH IF IT<49>S NOT IN THE STRING SPACE
1351 e79d 9c 1b CMPX VARTAB COMPARE DESCRIPTOR ADDRESS TO START OF VARIABLES
1352 e79f 25 0d BCS LAFBE BRANCH IF DESCRIPTOR ADDRESS NOT IN VARIABLES
1353 e7a1 e6 84 LAFB1 LDB ,X GET LENGTH OF REPLACEMENT STRING
1354 e7a3 bd ec d4 JSR LB50D RESERVE ACCB BYTES OF STRING SPACE
1355 e7a6 9e 4d LDX V4D GET DESCRIPTOR ADDRESS BACK
1356 e7a8 bd ee 0a JSR LB643 MOVE STRING INTO STRING SPACE
1357 e7ab 8e 00 56 LDX #STRDES POINT X TO TEMP STRING DESCRIPTOR ADDRESS
1358 e7ae 9f 4d LAFBE STX V4D SAVE STRING DESCRIPTOR ADDRESS IN V4D
1359 e7b0 bd ee 3c JSR LB675 REMOVE STRING DESCRIPTOR IF LAST ONE
1360 * ON STRING STACK
1361 e7b3 de 4d LDU V4D POINT U TO REPLACEMENT DESCRIPTOR ADDRESS
1362 e7b5 9e 3b LDX VARDES GET TARGET DESCRIPTOR ADDRESS
1363 e7b7 37 26 PULU A,B,Y GET LENGTH AND START OF REPLACEMENT STRING
1364 e7b9 a7 84 STA ,X * SAVE STRING LENGTH AND START IN
1365 e7bb 10 af 02 STY 2,X * TARGET DESCRIPTOR LOCATION
1366 e7be 39 LAFCE RTS
1367
1368 e7bf 3f 52 45 44 4f LAFCF FCC "?REDO" ?REDO MESSAGE
1369 e7c4 0d 00 FCB CR,$00
1370
1371 LAFD6
1372 e7c6 7e e4 46 LAFDC JMP LAC46 JMP TO ERROR HANDLER
1373 e7c9 96 09 LAFDF LDA INPFLG = GET THE INPUT FLAG AND BRANCH
1374 e7cb 27 07 BEQ LAFEA = IF <20>INPUT<55>
1375 e7cd 9e 31 LDX DATTXT * GET LINE NUMBER WHERE THE ERROR OCCURRED
1376 e7cf 9f 68 STX CURLIN * AND USE IT AS THE CURRENT LINE NUMBER
1377 e7d1 7e ea 43 JMP LB277 <20>SYNTAX ERROR<4F>
1378 e7d4 8e e7 be LAFEA LDX #LAFCF-1 * POINT X TO <20>?REDO<44> AND PRINT
1379 e7d7 bd f1 25 JSR LB99C * IT ON THE SCREEN
1380 e7da 9e 2f LDX TINPTR = GET THE SAVED ABSOLUTE ADDRESS OF
1381 e7dc 9f 83 STX CHARAD = INPUT POINTER AND RESTORE IT
1382 e7de 39 RTS
1383 *
1384 * INPUT
1385 e7df c6 16 INPUT LDB #11*2 <20>ID<49> ERROR
1386 e7e1 9e 68 LDX CURLIN GET CURRENT LINE NUMBER
1387 e7e3 30 01 LEAX 1,X ADD ONE
1388 e7e5 27 df BEQ LAFDC <20>ID<49> ERROR BRANCH IF DIRECT MODE
1389 e7e7 8d 01 BSR LB00F GET SOME INPUT DATA - WAS LB002
1390 e7e9 39 RTS
1391 e7ea 81 22 LB00F CMPA #'" CHECK FOR PROMPT STRING DELIMITER
1392 e7ec 26 0b BNE LB01E BRANCH IF NO PROMPT STRING
1393 e7ee bd ea 10 JSR LB244 PUT PROMPT STRING ON STRING STACK
1394 e7f1 c6 3b LDB #'; *
1395 e7f3 bd ea 3b JSR LB26F * DO A SYNTAX CHECK FOR SEMICOLON
1396 e7f6 bd f1 28 JSR LB99F PRINT MESSAGE TO CONSOLE OUT
1397 e7f9 8e 00 f3 LB01E LDX #LINBUF POINT TO BASIC<49>S LINE BUFFER
1398 e7fc 6f 84 CLR ,X CLEAR 1ST BYTE - FLAG TO INDICATE NO DATA
1399 * IN LINE BUFFER
1400 e7fe 8d 06 BSR LB02F INPUT A STRING TO LINE BUFFER
1401 e800 c6 2c LDB #', * INSERT A COMMA AT THE END
1402 e802 e7 84 STB ,X * OF THE LINE INPUT BUFFER
1403 e804 20 16 BRA LB049
1404 * FILL BASIC<49>S LINE INPUT BUFFER CONSOLE IN
1405 e806 bd f1 38 LB02F JSR LB9AF SEND A "?" TO CONSOLE OUT
1406 e809 bd f1 35 JSR LB9AC SEND A <20>SPACE<43> TO CONSOLE OUT
1407 e80c bd e1 81 LB035 JSR LA390 GO READ IN A BASIC LINE
1408 e80f 24 05 BCC LB03F BRANCH IF ENTER KEY ENDED ENTRY
1409 e811 32 64 LEAS 4,S PURGE TWO RETURN ADDRESSES OFF THE STACK
1410 e813 7e e6 09 JMP LAE11 GO DO A <20>STOP<4F> IF BREAK KEY ENDED LINE ENTRY
1411 e816 c6 2e LB03F LDB #2*23 <20>INPUT PAST END OF FILE<4C> ERROR
1412 e818 39 RTS
1413 *
1414 * READ
1415 e819 9e 33 READ LDX DATPTR GET <20>READ<41> START ADDRESS
1416 e81b 86 FCB SKP1LD SKIP ONE BYTE - LDA #*$4F
1417 e81c 4f LB049 CLRA <20>INPUT<55> ENTRY POINT: INPUT FLAG = 0
1418 e81d 97 09 STA INPFLG SET INPUT FLAG; 0 = INPUT: <> 0 = READ
1419 e81f 9f 35 STX DATTMP SAVE <20>READ<41> START ADDRESS/<2F>INPUT<55> BUFFER START
1420 e821 bd eb 1e LB04E JSR LB357 EVALUATE A VARIABLE
1421 e824 9f 3b STX VARDES SAVE DESCRIPTOR ADDRESS
1422 e826 9e 83 LDX CHARAD * GET BASIC<49>S INPUT POINTER
1423 e828 9f 2b STX BINVAL * AND SAVE IT
1424 e82a 9e 35 LDX DATTMP GET <20>READ<41> ADDRESS START/<2F>INPUT<55> BUFFER POINTER
1425 e82c a6 84 LDA ,X GET A CHARACTER FROM THE BASIC PROGRAM
1426 e82e 26 09 BNE LB069 BRANCH IF NOT END OF LINE
1427 e830 96 09 LDA INPFLG * CHECK INPUT FLAG AND BRANCH
1428 e832 26 51 BNE LB0B9 * IF LOOKING FOR DATA (READ)
1429 * NO DATA IN <20>INPUT<55> LINE BUFFER AND/OR INPUT
1430 * NOT COMING FROM SCREEN
1431 e834 bd f1 38 JSR LB9AF SEND A '?' TO CONSOLE OUT
1432 e837 8d cd BSR LB02F FILL INPUT BUFFER FROM CONSOLE IN
1433 e839 9f 83 LB069 STX CHARAD RESET BASIC<49>S INPUT POINTER
1434 e83b 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
1435 e83d d6 06 LDB VALTYP * CHECK VARIABLE TYPE AND
1436 e83f 27 23 BEQ LB098 * BRANCH IF NUMERIC
1437 * READ/INPUT A STRING VARIABLE
1438 e841 9e 83 LDX CHARAD LOAD X WITH CURRENT BASIC INPUT POINTER
1439 e843 97 01 STA CHARAC SAVE CURRENT INPUT CHARACTER
1440 e845 81 22 CMPA #'" CHECK FOR STRING DELIMITER
1441 e847 27 0e BEQ LB08B BRANCH IF STRING DELIMITER
1442 e849 30 1f LEAX -1,X BACK UP POINTER
1443 e84b 4f CLRA * ZERO = END OF LINE CHARACTER
1444 e84c 97 01 STA CHARAC * SAVE AS TERMINATOR
1445 e84e bd e1 73 JSR LA35F SET UP PRINT PARAMETERS
1446 e851 86 3a LDA #': END OF SUBLINE CHARACTER
1447 e853 97 01 STA CHARAC SAVE AS TERMINATOR I
1448 e855 86 2c LDA #', COMMA
1449 e857 97 02 LB08B STA ENDCHR SAVE AS TERMINATOR 2
1450 e859 bd ec e5 JSR LB51E STRIP A STRING FROM THE INPUT BUFFER
1451 e85c bd ea 15 JSR LB249 MOVE INPUT POINTER TO END OF STRING
1452 e85f bd e7 94 JSR LAFA4 PUT A STRING INTO THE STRING SPACE IF NECESSARY
1453 e862 20 06 BRA LB09E CHECK FOR ANOTHER DATA ITEM
1454 * SAVE A NUMERIC VALUE IN A READ OR INPUT DATA ITEM
1455 e864 bd f4 9b LB098 JSR LBD12 CONVERT AN ASCII STRING TO FP NUMBER
1456 e867 bd f3 bc JSR LBC33 PACK FPA0 AND STORE IT IN ADDRESS IN VARDES -
1457 * INPUT OR READ DATA ITEM
1458 e86a 9d 82 LB09E JSR GETCCH GET CURRENT INPUT CHARACTER
1459 e86c 27 06 BEQ LB0A8 BRANCH IF END OF LINE
1460 e86e 81 2c CMPA #', CHECK FOR A COMMA
1461 e870 10 26 ff 52 LBNE LAFD6 BAD FILE DATA' ERROR OR RETRY
1462 e874 9e 83 LB0A8 LDX CHARAD * GET CURRENT INPUT
1463 e876 9f 35 STX DATTMP * POINTER (USED AS A DATA POINTER) AND SAVE IT
1464 e878 9e 2b LDX BINVAL * RESET INPUT POINTER TO INPUT OR
1465 e87a 9f 83 STX CHARAD * READ STATEMENT
1466 e87c 9d 82 JSR GETCCH GET CURRENT CHARACTER FROM BASIC
1467 e87e 27 21 BEQ LB0D5 BRANCH IF END OF LINE - EXIT COMMAND
1468 e880 bd ea 39 JSR LB26D SYNTAX CHECK FOR COMMA
1469 e883 20 9c BRA LB04E GET ANOTHER INPUT OR READ ITEM
1470 * SEARCH FROM ADDRESS IN X FOR
1471 * 1ST OCCURENCE OF THE TOKEN FOR DATA
1472 e885 9f 83 LB0B9 STX CHARAD RESET BASIC<49>S INPUT POINTER
1473 e887 bd e6 d8 JSR LAEE8 SEARCH FOR END OF CURRENT LINE OR SUBLINE
1474 e88a 30 01 LEAX 1,X MOVE X ONE PAST END OF LINE
1475 e88c 4d TSTA CHECK FOR END OF LINE
1476 e88d 26 0a BNE LB0CD BRANCH IF END OF SUBLINE
1477 e88f c6 06 LDB #2*3 <20>OUT OF DATA<54> ERROR
1478 e891 ee 81 LDU ,X++ GET NEXT 2 CHARACTERS
1479 e893 27 41 BEQ LB10A <20>OD<4F> ERROR IF END OF PROGRAM
1480 e895 ec 81 LDD ,X++ GET BASIC LINE NUMBER AND
1481 e897 dd 31 STD DATTXT SAVE IT IN DATTXT
1482 e899 a6 84 LB0CD LDA ,X GET AN INPUT CHARACTER
1483 e89b 81 86 CMPA #TOK_DATA DATA TOKEN?
1484 e89d 26 e6 BNE LB0B9 NO <20> KEEP LOOKING
1485 e89f 20 98 BRA LB069 YES
1486 * EXIT READ AND INPUT COMMANDS
1487 e8a1 9e 35 LB0D5 LDX DATTMP GET DATA POINTER
1488 e8a3 d6 09 LDB INPFLG * CHECK INPUT FLAG
1489 e8a5 10 26 fd 3a LBNE LADE8 * SAVE NEW DATA POINTER IF READ
1490 e8a9 a6 84 LDA ,X = CHECK NEXT CHARACTER IN <20>INPUT<55> BUFFER
1491 e8ab 27 06 BEQ LB0E7 =
1492 e8ad 8e e8 b3 LDX #LB0E8-1 POINT X TO <20>?EXTRA IGNORED<45>
1493 e8b0 7e f1 25 JMP LB99C PRINT THE MESSAGE
1494 e8b3 39 LB0E7 RTS
1495
1496 e8b4 3f 45 58 54 52 41 LB0E8 FCC "?EXTRA IGNORED" ?EXTRA IGNORED MESSAGE
20 49 47 4e 4f 52
45 44
1497
1498
1499 e8c2 0d 00 FCB CR,$00
1500
1501 * NEXT
1502 e8c4 26 04 NEXT BNE LB0FE BRANCH IF ARGUMENT GIVEN
1503 e8c6 9e 74 LDX ZERO X = 0: DEFAULT FOR NO ARGUMENT
1504 e8c8 20 03 BRA LB101
1505 e8ca bd eb 1e LB0FE JSR LB357 EVALUATE AN ALPHA EXPRESSION
1506 e8cd 9f 3b LB101 STX VARDES SAVE VARIABLE DESCRIPTOR POINTER
1507 e8cf bd e3 f9 JSR LABF9 GO SCAN FOR <20>FOR/NEXT<58> DATA ON STACK
1508 e8d2 27 04 BEQ LB10C BRANCH IF DATA FOUND
1509 e8d4 c6 00 LDB #0 <20>NEXT WITHOUT FOR<4F> ERROR (SHOULD BE CLRB)
1510 e8d6 20 47 LB10A BRA LB153 PROCESS ERROR
1511 e8d8 1f 14 LB10C TFR X,S POINT S TO START OF <20>FOR/NEXT<58> DATA
1512 e8da 30 03 LEAX 3,X POINT X TO FP VALUE OF STEP
1513 e8dc bd f3 9d JSR LBC14 COPY A FP NUMBER FROM (X) TO FPA0
1514 e8df a6 68 LDA 8,S GET THE DIRECTION OF STEP
1515 e8e1 97 54 STA FP0SGN SAVE IT AS THE SIGN OF FPA0
1516 e8e3 9e 3b LDX VARDES POINT (X) TO INDEX VARIABLE DESCRIPTOR
1517 e8e5 bd f1 4b JSR LB9C2 ADD (X) TO FPA0 (STEP TO INDEX)
1518 e8e8 bd f3 bc JSR LBC33 PACK FPA0 AND STORE IT IN ADDRESS
1519 * CONTAINED IN VARDES
1520 e8eb 30 69 LEAX 9,S POINT (X) TO TERMINAL VALUE OF INDEX
1521 e8ed bd f4 1f JSR LBC96 COMPARE CURRENT INDEX VALUE TO TERMINAL VALUE OF INDEX
1522 e8f0 e0 68 SUBB 8,S ACCB = 0 IF TERMINAL VALUE=CURRENT VALUE AND STEP=0 OR IF
1523 * STEP IS POSITIVE AND CURRENT VALUE>TERMINAL VALUE OR
1524 * STEP IS NEGATIVE AND CURRENT VALUE<TERMINAL VALUE
1525 e8f2 27 0c BEQ LB134 BRANCH IF <20>FOR/NEXT<58> LOOP DONE
1526 e8f4 ae 6e LDX 14,S * GET LINE NUMBER AND
1527 e8f6 9f 68 STX CURLIN * BASIC POINTER OF
1528 e8f8 ae e8 10 LDX 16,S * STATEMENT FOLLOWING THE
1529 e8fb 9f 83 STX CHARAD * PROPER FOR STATEMENT
1530 e8fd 7e e5 82 LB131 JMP LAD9E JUMP BACK TO COMMAND INTEPR. LOOP
1531 e900 32 e8 12 LB134 LEAS 18,S PULL THE <20>FOR-NEXT<58> DATA OFF THE STACK
1532 e903 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1533 e905 81 2c CMPA #', CHECK FOR ANOTHER ARGUMENT
1534 e907 26 f4 BNE LB131 RETURN IF NONE
1535 e909 9d 7c JSR GETNCH GET NEXT CHARACTER FROM BASIC
1536 e90b 8d bd BSR LB0FE BSR SIMULATES A CALL TO <20>NEXT<58> FROM COMMAND LOOP
1537
1538
1539 e90d 8d 13 LB141 BSR LB156 EVALUATE EXPRESSION AND DO A TYPE CHECK FOR NUMERIC
1540 e90f 1c fe LB143 ANDCC #$FE CLEAR CARRY FLAG
1541 e911 7d LB145 FCB $7D OP CODE OF TST $1A01 - SKIP TWO BYTES (DO
1542 * NOT CHANGE CARRY FLAG)
1543 e912 1a 01 LB146 ORCC #1 SET CARRY
1544
1545 * STRING TYPE MODE CHECK - IF ENTERED AT LB146 THEN VALTYP PLUS IS 'TM' ERROR
1546 * NUMERIC TYPE MODE CHECK - IF ENTERED AT LB143 THEN VALTYP MINUS IS 'TM' ERROR
1547 * IF ENTERED AT LB148, A TYPE CHECK IS DONE ON VALTYP
1548 * IF ENTERED WITH CARRY SET, THEN 'TM' ERROR IF NUMERIC
1549 * IF ENTERED WITH CARRY CLEAR, THEN 'TM' ERROR IF STRING.
1550 e914 0d 06 LB148 TST VALTYP TEST TYPE FLAG; DO NOT CHANGE CARRY
1551 e916 25 03 BCS LB14F BRANCH IF STRING
1552 e918 2a 99 BPL LB0E7 RETURN ON PLUS
1553 e91a 8c FCB SKP2 SKIP 2 BYTES - <20>TM<54> ERROR
1554 e91b 2b 96 LB14F BMI LB0E7 RETURN ON MINUS
1555 e91d c6 18 LDB #12*2 <20>TYPE M1SMATCH<43> ERROR
1556 e91f 7e e4 46 LB153 JMP LAC46 PROCESS ERROR
1557 * EVALUATE EXPRESSION
1558 e922 8d 6e LB156 BSR LB1C6 BACK UP INPUT POINTER
1559 e924 4f LB158 CLRA END OF OPERATION PRECEDENCE FLAG
1560 e925 8c FCB SKP2 SKIP TWO BYTES
1561 e926 34 04 LB15A PSHS B SAVE FLAG (RELATIONAL OPERATOR FLAG)
1562 e928 34 02 PSHS A SAVE FLAG (PRECEDENCE FLAG)
1563 e92a c6 01 LDB #1 *
1564 e92c bd e4 33 JSR LAC33 * SEE IF ROOM IN FREE RAM FOR (B) WORDS
1565 e92f bd e9 ef JSR LB223 GO EVALUATE AN EXPRESSION
1566 e932 0f 3f CLR TRELFL RESET RELATIONAL OPERATOR FLAG
1567 e934 9d 82 LB168 JSR GETCCH GET CURRENT INPUT CHARACTER
1568 * CHECK FOR RELATIONAL OPERATORS
1569 e936 80 ad LB16A SUBA #TOK_GREATER TOKEN FOR >
1570 e938 25 13 BCS LB181 BRANCH IF LESS THAN RELATIONAL OPERATORS
1571 e93a 81 03 CMPA #3 *
1572 e93c 24 0f BCC LB181 * BRANCH IF GREATER THAN RELATIONAL OPERATORS
1573 e93e 81 01 CMPA #1 SET CARRY IF <20>><3E>
1574 e940 49 ROLA CARRY TO BIT 0
1575 e941 98 3f EORA TRELFL * CARRY SET IF
1576 e943 91 3f CMPA TRELFL * TRELFL = ACCA
1577 e945 25 64 BCS LB1DF BRANCH IF SYNTAX ERROR : == << OR >>
1578 e947 97 3f STA TRELFL BIT 0: >, BIT 1 =, BIT 2: <
1579 e949 9d 7c JSR GETNCH GET AN INPUT CHARACTER
1580 e94b 20 e9 BRA LB16A CHECK FOR ANOTHER RELATIONAL OPERATOR
1581 *
1582 e94d d6 3f LB181 LDB TRELFL GET RELATIONAL OPERATOR FLAG
1583 e94f 26 33 BNE LB1B8 BRANCH IF RELATIONAL COMPARISON
1584 e951 10 24 00 6b LBCC LB1F4 BRANCH IF > RELATIONAL OPERATOR
1585 e955 8b 07 ADDA #7 SEVEN ARITHMETIC/LOGICAL OPERATORS
1586 e957 24 67 BCC LB1F4 BRANCH IF NOT ARITHMETIC/LOGICAL OPERATOR
1587 e959 99 06 ADCA VALTYP ADD CARRY, NUMERIC FLAG AND MODIFIED TOKEN NUMBER
1588 e95b 10 27 04 77 LBEQ LB60F BRANCH IF VALTYP = FF, AND ACCA = <20>+<2B> TOKEN -
1589 * CONCATENATE TWO STRINGS
1590 e95f 89 ff ADCA #-1 RESTORE ARITHMETIC/LOGICAL OPERATOR NUMBER
1591 e961 34 02 PSHS A * STORE OPERATOR NUMBER ON STACK; MULTIPLY IT BY 2
1592 e963 48 ASLA * THEN ADD THE STORED STACK DATA = MULTIPLY
1593 e964 ab e0 ADDA ,S+ * X 3; 3 BYTE/TABLE ENTRY
1594 e966 8e e2 4b LDX #LAA51 JUMP TABLE FOR ARITHMETIC & LOGICAL OPERATORS
1595 e969 30 86 LEAX A,X POINT X TO PROPER TABLE
1596 e96b 35 02 LB19F PULS A GET PRECEDENCE FLAG FROM STACK
1597 e96d a1 84 CMPA ,X COMPARE TO CURRENT OPERATOR
1598 e96f 24 55 BCC LB1FA BRANCH IF STACK OPERATOR > CURRENT OPERATOR
1599 e971 8d 9c BSR LB143 <20>TM<54> ERROR IF VARIABLE TYPE = STRING
1600
1601 * OPERATION BEING PROCESSED IS OF HIGHER PRECEDENCE THAN THE PREVIOUS OPERATION.
1602 e973 34 02 LB1A7 PSHS A SAVE PRECEDENCE FLAG
1603 e975 8d 29 BSR LB1D4 PUSH OPERATOR ROUTINE ADDRESS AND FPA0 ONTO STACK
1604 e977 9e 3d LDX RELPTR GET POINTER TO ARITHMETIC/LOGICAL TABLE ENTRY FOR
1605 * LAST CALCULATED OPERATION
1606 e979 35 02 PULS A GET PRECEDENCE FLAG OF PREVIOUS OPERATION
1607 e97b 26 1d BNE LB1CE BRANCH IF NOT END OF OPERATION
1608 e97d 4d TSTA CHECK TYPE OF PRECEDENCE FLAG
1609 e97e 10 27 00 6a LBEQ LB220 BRANCH IF END OF EXPRESSION OR SUB-EXPRESSION
1610 e982 20 4b BRA LB203 EVALUATE AN OPERATION
1611
1612 e984 08 06 LB1B8 ASL VALTYP BIT 7 OF TYPE FLAG TO CARRY
1613 e986 59 ROLB SHIFT RELATIONAL FLAG LEFT - VALTYP TO BIT 0
1614 e987 8d 09 BSR LB1C6 MOVE THE INPUT POINTER BACK ONE
1615 e989 8e e9 97 LDX #LB1CB POINT X TO RELATIONAL COMPARISON JUMP TABLE
1616 e98c d7 3f STB TRELFL SAVE RELATIONAL COMPARISON DATA
1617 e98e 0f 06 CLR VALTYP SET VARIABLE TYPE TO NUMERIC
1618 e990 20 d9 BRA LB19F PERFORM OPERATION OR SAVE ON STACK
1619
1620 e992 9e 83 LB1C6 LDX CHARAD * GET BASIC<49>S INPUT POINTER AND
1621 e994 7e e6 ab JMP LAEBB * MOVE IT BACK ONE
1622 * RELATIONAL COMPARISON JUMP TABLE
1623 e997 64 LB1CB FCB $64 RELATIONAL COMPARISON FLAG
1624 e998 ea bb LB1CC FDB LB2F4 JUMP ADDRESS
1625
1626 e99a a1 84 LB1CE CMPA ,X COMPARE PRECEDENCE OF LAST DONE OPERATION TO
1627 * NEXT TO BE DONE OPERATION
1628 e99c 24 31 BCC LB203 EVALUATE OPERATION IF LOWER PRECEDENCE
1629 e99e 20 d3 BRA LB1A7 PUSH OPERATION DATA ON STACK IF HIGHER PRECEDENCE
1630
1631 * PUSH OPERATOR EVALUATION ADDRESS AND FPA0 ONTO STACK AND EVALUATE ANOTHER EXPR
1632 e9a0 ec 01 LB1D4 LDD 1,X GET ADDRESS OF OPERATOR ROUTINE
1633 e9a2 34 06 PSHS B,A SAVE IT ON THE STACK
1634 e9a4 8d 08 BSR LB1E2 PUSH FPA0 ONTO STACK
1635 e9a6 d6 3f LDB TRELFL GET BACK RELATIONAL OPERATOR FLAG
1636 e9a8 16 ff 7b LBRA LB15A EVALUATE ANOTHER EXPRESSION
1637 e9ab 7e ea 43 LB1DF JMP LB277 <20>SYNTAX ERROR<4F>
1638 * PUSH FPA0 ONTO THE STACK. ,S = EXPONENT
1639 * 1-2,S =HIGH ORDER MANTISSA 3-4,S = LOW ORDER MANTISSA
1640 * 5,S = SIGN RETURN WITH PRECEDENCE CODE IN ACCA
1641 e9ae d6 54 LB1E2 LDB FP0SGN GET SIGN OF FPA0 MANTISSA
1642 e9b0 a6 84 LDA ,X GET PRECEDENCE CODE TO ACCA
1643 e9b2 35 20 LB1E6 PULS Y GET RETURN ADDRESS FROM STACK & PUT IT IN Y
1644 e9b4 34 04 PSHS B SAVE ACCB ON STACK
1645 e9b6 d6 4f LB1EA LDB FP0EXP * PUSH FPA0 ONTO THE STACK
1646 e9b8 9e 50 LDX FPA0 *
1647 e9ba de 52 LDU FPA0+2 *
1648 e9bc 34 54 PSHS U,X,B *
1649 e9be 6e a4 JMP ,Y JUMP TO ADDRESS IN Y
1650
1651 * BRANCH HERE IF NON-OPERATOR CHARACTER FOUND - USUALLY <20>)<29> OR END OF LINE
1652 e9c0 9e 74 LB1F4 LDX ZERO POINT X TO DUMMY VALUE (ZERO)
1653 e9c2 a6 e0 LDA ,S+ GET PRECEDENCE FLAG FROM STACK
1654 e9c4 27 26 BEQ LB220 BRANCH IF END OF EXPRESSION
1655 e9c6 81 64 LB1FA CMPA #$64 * CHECK FOR RELATIONAL COMPARISON FLAG
1656 e9c8 27 03 BEQ LB201 * AND BRANCH IF RELATIONAL COMPARISON
1657 e9ca bd e9 0f JSR LB143 <20>TM<54> ERROR IF VARIABLE TYPE = STRING
1658 e9cd 9f 3d LB201 STX RELPTR SAVE POINTER TO OPERATOR ROUTINE
1659 e9cf 35 04 LB203 PULS B GET RELATIONAL OPERATOR FLAG FROM STACK
1660 e9d1 81 5a CMPA #$5A CHECK FOR <20>NOT<4F> OPERATOR
1661 e9d3 27 19 BEQ LB222 RETURN IF <20>NOT<4F> - NO RELATIONAL COMPARISON
1662 e9d5 81 7d CMPA #$7D CHECK FOR NEGATION (UNARY) FLAG
1663 e9d7 27 15 BEQ LB222 RETURN IF NEGATION - NO RELATIONAL COMPARISON
1664
1665 * EVALUATE AN OPERATION. EIGHT BYTES WILL BE STORED ON STACK, FIRST SIX BYTES
1666 * ARE A TEMPORARY FLOATING POINT RESULT THEN THE ADDRESS OF ROUTINE WHICH
1667 * WILL EVALUATE THE OPERATION. THE RTS AT END OF ROUTINE WILL VECTOR
1668 * TO EVALUATING ROUTINE.
1669 e9d9 54 LSRB = ROTATE VALTYP BIT INTO CARRY
1670 e9da d7 0a STB RELFLG = FLAG AND SAVE NEW RELFLG
1671 e9dc 35 52 PULS A,X,U * PULL A FP VALUE OFF OF THE STACK
1672 e9de 97 5c STA FP1EXP * AND SAVE IT IN FPA1
1673 e9e0 9f 5d STX FPA1 *
1674 e9e2 df 5f STU FPA1+2 *
1675 e9e4 35 04 PULS B = GET MANTISSA SIGN AND
1676 e9e6 d7 61 STB FP1SGN = SAVE IT IN FPA1
1677 e9e8 d8 54 EORB FP0SGN EOR IT WITH FPA1 MANTISSA SIGN
1678 e9ea d7 62 STB RESSGN SAVE IT IN RESULT SIGN BYTE
1679 e9ec d6 4f LB220 LDB FP0EXP GET EXPONENT OF FPA0
1680 e9ee 39 LB222 RTS
1681
1682 e9ef bd fc 39 LB223 JSR XVEC15 CALL EXTENDED BASIC ADD-IN
1683 e9f2 0f 06 CLR VALTYP INITIALIZE TYPE FLAG TO NUMERIC
1684 e9f4 9d 7c JSR GETNCH GET AN INPUT CHAR
1685 e9f6 24 03 BCC LB22F BRANCH IF NOT NUMERIC
1686 e9f8 7e f4 9b LB22C JMP LBD12 CONVERT ASCII STRING TO FLOATING POINT -
1687 * RETURN RESULT IN FPA0
1688 * PROCESS A NON NUMERIC FIRST CHARACTER
1689 e9fb bd eb 69 LB22F JSR LB3A2 SET CARRY IF NOT ALPHA
1690 e9fe 24 50 BCC LB284 BRANCH IF ALPHA CHARACTER
1691 ea00 81 2e CMPA #'. IS IT <20>.<2E> (DECIMAL POINT)?
1692 ea02 27 f4 BEQ LB22C CONVERT ASCII STRING TO FLOATING POINT
1693 ea04 81 a7 CMPA #TOK_MINUS MINUS TOKEN
1694 ea06 27 40 BEQ LB27C YES - GO PROCESS THE MINUS OPERATOR
1695 ea08 81 a6 CMPA #TOK_PLUS PLUS TOKEN
1696 ea0a 27 e3 BEQ LB223 YES - GET ANOTHER CHARACTER
1697 ea0c 81 22 CMPA #'" STRING DELIMITER?
1698 ea0e 26 0a BNE LB24E NO
1699 ea10 9e 83 LB244 LDX CHARAD CURRENT BASIC POINTER TO X
1700 ea12 bd ec df JSR LB518 SAVE STRING ON STRING STACK
1701 ea15 9e 64 LB249 LDX COEFPT * GET ADDRESS OF END OF STRING AND
1702 ea17 9f 83 STX CHARAD * PUT BASIC<49>S INPUT POINTER THERE
1703 ea19 39 RTS
1704 ea1a 81 a3 LB24E CMPA #TOK_NOT NOT TOKEN?
1705 ea1c 26 0d BNE LB25F NO
1706 * PROCESS THE NOT OPERATOR
1707 ea1e 86 5a LDA #$5A <20>NOT<4F> PRECEDENCE FLAG
1708 ea20 bd e9 26 JSR LB15A PROCESS OPERATION FOLLOWING <20>NOT<4F>
1709 ea23 bd eb b4 JSR INTCNV CONVERT FPA0 TO INTEGER IN ACCD
1710 ea26 43 COMA * <20>NOT<4F> THE INTEGER
1711 ea27 53 COMB *
1712 ea28 7e ec bb JMP GIVABF CONVERT ACCD TO FLOATING POINT (FPA0)
1713 ea2b 4c LB25F INCA CHECK FOR TOKENS PRECEEDED BY $FF
1714 ea2c 27 2e BEQ LB290 IT WAS PRECEEDED BY $FF
1715 ea2e 8d 06 LB262 BSR LB26A SYNTAX CHECK FOR A <20>(<28>
1716 ea30 bd e9 22 JSR LB156 EVALUATE EXPRESSIONS WITHIN PARENTHESES AT
1717 * HIGHEST PRECEDENCE
1718 ea33 c6 29 LB267 LDB #') SYNTAX CHECK FOR <20>)<29>
1719 ea35 8c FCB SKP2 SKIP 2 BYTES
1720 ea36 c6 28 LB26A LDB #'( SYNTAX CHECK FOR <20>(<28>
1721 ea38 8c FCB SKP2 SKIP 2 BYTES
1722 ea39 c6 2c LB26D LDB #', SYNTAX CHECK FOR COMMA
1723 ea3b e1 9f 00 83 LB26F CMPB [CHARAD] * COMPARE ACCB TO CURRENT INPUT
1724 ea3f 26 02 BNE LB277 * CHARACTER - SYNTAX ERROR IF NO MATCH
1725 ea41 0e 7c JMP GETNCH GET A CHARACTER FROM BASIC
1726 ea43 c6 02 LB277 LDB #2*1 SYNTAX ERROR
1727 ea45 7e e4 46 JMP LAC46 JUMP TO ERROR HANDLER
1728
1729 * PROCESS THE MINUS (UNARY) OPERATOR
1730 ea48 86 7d LB27C LDA #$7D MINUS (UNARY) PRECEDENCE FLAG
1731 ea4a bd e9 26 JSR LB15A PROCESS OPERATION FOLLOWING <20>UNARY<52> NEGATION
1732 ea4d 7e f6 72 JMP LBEE9 CHANGE SIGN OF FPA0 MANTISSA
1733
1734 * EVALUATE ALPHA EXPRESSION
1735 ea50 bd eb 1e LB284 JSR LB357 FIND THE DESCRIPTOR ADDRESS OF A VARIABLE
1736 ea53 9f 52 LB287 STX FPA0+2 SAVE DESCRIPTOR ADDRESS IN FPA0
1737 ea55 96 06 LDA VALTYP TEST VARIABLE TYPE
1738 ea57 26 95 BNE LB222 RETURN IF STRING
1739 ea59 7e f3 9d JMP LBC14 COPY A FP NUMBER FROM (X) TO FPA0
1740
1741 * EVALUATING A SECONDARY TOKEN
1742 ea5c 9d 7c LB290 JSR GETNCH GET AN INPUT CHARACTER (SECONDARY TOKEN)
1743 ea5e 1f 89 TFR A,B SAVE IT IN ACCB
1744 ea60 58 ASLB X2 & BET RID OF BIT 7
1745 ea61 9d 7c JSR GETNCH GET ANOTHER INPUT CHARACTER
1746 ea63 c1 38 CMPB #NUM_SEC_FNS-1*2 29 SECONDARY FUNCTIONS - 1
1747 ea65 23 03 BLS LB29F BRANCH IF COLOR BASIC TOKEN
1748 ea67 7e ea 43 JMP LB277 SYNTAX ERROR
1749 ea6a 34 04 LB29F PSHS B SAVE TOKEN OFFSET ON STACK
1750 ea6c c1 2a CMPB #TOK_LEFT-$80*2 CHECK FOR TOKEN WITH AN ARGUMENT
1751 ea6e 25 1e BCS LB2C7 DO SECONDARIES STRING$ OR LESS
1752 ea70 c1 30 CMPB #TOK_INKEY-$80*2 *
1753 ea72 24 1c BCC LB2C9 * DO SECONDARIES $92 (INKEY$) OR >
1754 ea74 8d c0 BSR LB26A SYNTAX CHECK FOR A <20>(<28>
1755 ea76 a6 e4 LDA ,S GET TOKEN NUMBER
1756 * DO SECONDARIES (LEFT$, RIGHT$, MID$)
1757 ea78 bd e9 22 JSR LB156 EVALUATE FIRST STRING IN ARGUMENT
1758 ea7b 8d bc BSR LB26D SYNTAX CHECK FOR A COMMA
1759 ea7d bd e9 12 JSR LB146 <20>TM<54> ERROR IF NUMERIC VARiABLE
1760 ea80 35 02 PULS A GET TOKEN OFFSET FROM STACK
1761 ea82 de 52 LDU FPA0+2 POINT U TO STRING DESCRIPTOR
1762 ea84 34 42 PSHS U,A SAVE TOKEN OFFSET AND DESCRIPTOR ADDRESS
1763 ea86 bd ee d2 JSR LB70B EVALUATE FIRST NUMERIC ARGUMENT
1764 ea89 35 02 PULS A GET TOKEN OFFSET FROM STACK
1765 ea8b 34 06 PSHS B,A SAVE TOKEN OFFSET AND NUMERIC ARGUMENT
1766 ea8d 8e FCB $8E OP CODE OF LDX# - SKlP 2 BYTES
1767 ea8e 8d 9e LB2C7 BSR LB262 SYNTAX CHECK FOR A <20>(<28>
1768 ea90 35 04 LB2C9 PULS B GET TOKEN OFFSET
1769 ea92 be e1 1d LDX COMVEC+8 GET SECONDARY FUNCTION JUMP TABLE ADDRESS
1770 ea95 3a LB2CE ABX ADD IN COMMAND OFFSET
1771 *
1772 * HERE IS WHERE WE BRANCH TO A SECONDARY FUNCTION
1773 ea96 ad 94 JSR [,X] GO DO AN SECONDARY FUNCTION
1774 ea98 7e e9 0f JMP LB143 <20>TM<54> ERROR IF VARIABLE TYPE = STRING
1775
1776 * LOGICAL OPERATOR <20>OR<4F> JUMPS HERE
1777 ea9b 86 LB2D4 FCB SKP1LD SKIP ONE BYTE - <20>OR<4F> FLAG = $4F
1778
1779 * LOGICAL OPERATOR <20>AND<4E> JUMPS HERE
1780 ea9c 4f LB2D5 CLRA AND FLAG = 0
1781 ea9d 97 03 STA TMPLOC AND/OR FLAG
1782 ea9f bd eb b4 JSR INTCNV CONVERT FPA0 INTO AN INTEGER IN ACCD
1783 eaa2 dd 01 STD CHARAC TEMP SAVE ACCD
1784 eaa4 bd f3 d3 JSR LBC4A MOVE FPA1 TO FPA0
1785 eaa7 bd eb b4 JSR INTCNV CONVERT FPA0 INTO AN INTEGER IN ACCD
1786 eaaa 0d 03 TST TMPLOC CHECK AND/OR FLAG
1787 eaac 26 06 BNE LB2ED BRANCH IF OR
1788 eaae 94 01 ANDA CHARAC * <20>AND<4E> ACCD WITH FPA0 INTEGER
1789 eab0 d4 02 ANDB ENDCHR * STORED IN ENDCHR
1790 eab2 20 04 BRA LB2F1 CONVERT TO FP
1791 eab4 9a 01 LB2ED ORA CHARAC * <20>OR<4F> ACCD WITH FPA0 INTEGER
1792 eab6 da 02 ORB ENDCHR * STORED IN CHARAC
1793 eab8 7e ec bb LB2F1 JMP GIVABF CONVERT THE VALUE IN ACCD INTO A FP NUMBER
1794
1795 * RELATIONAL COMPARISON PROCESS HANDLER
1796 eabb bd e9 14 LB2F4 JSR LB148 <20>TM<54> ERROR IF TYPE MISMATCH
1797 eabe 26 10 BNE LB309 BRANCH IF STRING VARIABLE
1798 eac0 96 61 LDA FP1SGN * <20>PACK<43> THE MANTISSA
1799 eac2 8a 7f ORA #$7F * SIGN OF FPA1 INTO
1800 eac4 94 5d ANDA FPA1 * BIT 7 OF THE
1801 eac6 97 5d STA FPA1 * MANTISSA MS BYTE
1802 eac8 8e 00 5c LDX #FP1EXP POINT X TO FPA1
1803 eacb bd f4 1f JSR LBC96 COMPARE FPA0 TO FPA1
1804 eace 20 36 BRA LB33F CHECK TRUTH OF RELATIONAL COMPARISON
1805
1806 * RELATIONAL COMPARISON OF STRINGS
1807 ead0 0f 06 LB309 CLR VALTYP SET VARIABLE TYPE TO NUMERIC
1808 ead2 0a 3f DEC TRELFL REMOVE STRING TYPE FLAG (BIT0=1 FOR STRINGS) FROM THE
1809 * DESIRED RELATIONAL COMPARISON DATA
1810 ead4 bd ee 1e JSR LB657 GET LENGTH AND ADDRESS OF STRING WHOSE
1811 * DESCRIPTOR ADDRESS IS IN THE BOTTOM OF FPA0
1812 ead7 d7 56 STB STRDES * SAVE LENGTH AND ADDRESS IN TEMPORARY
1813 ead9 9f 58 STX STRDES+2 * DESCRIPTOR (STRING B)
1814 eadb 9e 5f LDX FPA1+2 = RETURN LENGTH AND ADDRESS OF STRING
1815 eadd bd ee 20 JSR LB659 = WHOSE DESCRIPTOR ADDRESS IS STORED IN FPA1+2
1816 eae0 96 56 LDA STRDES LOAD ACCA WITH LENGTH OF STRING B
1817 eae2 34 04 PSHS B SAVE LENGTH A ON STACK
1818 eae4 a0 e0 SUBA ,S+ SUBTRACT LENGTH A FROM LENGTH B
1819 eae6 27 07 BEQ LB328 BRANCH IF STRINGS OF EQUAL LENGTH
1820 eae8 86 01 LDA #1 TRUE FLAG
1821 eaea 24 03 BCC LB328 TRUE IF LENGTH B > LENGTH A
1822 eaec d6 56 LDB STRDES LOAD ACCB WITH LENGTH B
1823 eaee 40 NEGA SET FLAG = FALSE (1FF)
1824 eaef 97 54 LB328 STA FP0SGN SAVE TRUE/FALSE FLAG
1825 eaf1 de 58 LDU STRDES+2 POINT U TO START OF STRING
1826 eaf3 5c INCB COMPENSATE FOR THE DECB BELOW
1827 * ENTER WITH ACCB CONTAINING LENGTH OF SHORTER STRING
1828 eaf4 5a LB32D DECB DECREMENT SHORTER STRING LENGTH
1829 eaf5 26 04 BNE LB334 BRANCH IF ALL OF STRING NOT COMPARED
1830 eaf7 d6 54 LDB FP0SGN GET TRUE/FALSE FLAB
1831 eaf9 20 0b BRA LB33F CHECK TRUTH OF RELATIONAL COMPARISON
1832 eafb a6 80 LB334 LDA ,X+ GET A BYTE FROM STRING A
1833 eafd a1 c0 CMPA ,U+ COMPARE TO STRING B
1834 eaff 27 f3 BEQ LB32D CHECK ANOTHER CHARACTER IF =
1835 eb01 c6 ff LDB #$FF FALSE FLAG IF STRING A > B
1836 eb03 24 01 BCC LB33F BRANCH IF STRING A > STRING B
1837 eb05 50 NEGB SET FLAG = TRUE
1838
1839 * DETERMINE TRUTH OF COMPARISON - RETURN RESULT IN FPA0
1840 eb06 cb 01 LB33F ADDB #1 CONVERT $FF,0,1 TO 0,1,2
1841 eb08 59 ROLB NOW IT<49>S 1,2,4 FOR > = <
1842 eb09 d4 0a ANDB RELFLG <20>AND<4E> THE ACTUAL COMPARISON WITH THE DESIRED -
1843 COMPARISON
1844 eb0b 27 02 BEQ LB348 BRANCH IF FALSE (NO MATCHING BITS)
1845 eb0d c6 ff LDB #$FF TRUE FLAG
1846 eb0f 7e f4 05 LB348 JMP LBC7C CONVERT ACCB INTO FP NUMBER IN FPA0
1847
1848 * DIM
1849 eb12 bd ea 39 LB34B JSR LB26D SYNTAX CHECK FOR COMMA
1850 eb15 c6 01 DIM LDB #1 DIMENSION FLAG
1851 eb17 8d 08 BSR LB35A SAVE ARRAY SPACE FOR THIS VARIABLE
1852 eb19 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1853 eb1b 26 f5 BNE LB34B KEEP DIMENSIONING IF NOT END OF LINE
1854 eb1d 39 RTS
1855 * EVALUATE A VARIABLE - RETURN X AND
1856 * VARPTR POINTING TO VARIABLE DESCRIPTOR
1857 * EACH VARIABLE REQUIRES 7 BYTES - THE FIRST TWO
1858 * BYTES ARE THE VARIABLE NAME AND THE NEXT 5
1859 * BYTES ARE THE DESCRIPTOR. IF BIT 7 OF THE
1860 * FIRST BYTE OF VARlABLE NAME IS SET, THE
1861 * VARIABLE IS A DEF FN VARIABLE. IF BIT 7 OF
1862 * THE SECOND BYTE OF VARIABLE NAME IS SET, THE
1863 * VARIABLE IS A STRING, OTHERWISE THE VARIABLE
1864 * IS NUMERIC.
1865 * IF THE VARIABLE IS NOT FOUND, A ZERO VARIABLE IS
1866 * INSERTED INTO THE VARIABLE SPACE
1867 eb1e 5f LB357 CLRB DIMENSION FLAG = 0; DO NOT SET UP AN ARRAY
1868 eb1f 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1869 eb21 d7 05 LB35A STB DIMFLG SAVE ARRAY FLAG
1870 * ENTRY POINT FOR DEF FN VARIABLE SEARCH
1871 eb23 97 37 LB35C STA VARNAM SAVE INPUT CHARACTER
1872 eb25 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1873 eb27 8d 40 BSR LB3A2 SET CARRY IF NOT ALPHA
1874 eb29 10 25 ff 16 LBCS LB277 SYNTAX ERROR IF NOT ALPHA
1875 eb2d 5f CLRB DEFAULT 2ND VARIABLE CHARACTER TO ZERO
1876 eb2e d7 06 STB VALTYP SET VARIABLE TYPE TO NUMERIC
1877 eb30 9d 7c JSR GETNCH GET ANOTHER CHARACTER FROM BASIC
1878 eb32 25 04 BCS LB371 BRANCH IF NUMERIC (2ND CHARACTER IN
1879 * VARIABLE MAY BE NUMERIC)
1880 eb34 8d 33 BSR LB3A2 SET CARRY IF NOT ALPHA
1881 eb36 25 0a BCS LB37B BRANCH IF NOT ALPHA
1882 eb38 1f 89 LB371 TFR A,B SAVE 2ND CHARACTER IN ACCB
1883 * READ INPUT CHARACTERS UNTIL A NON ALPHA OR
1884 * NON NUMERIC IS FOUND - IGNORE ALL CHARACTERS
1885 * IN VARIABLE NAME AFTER THE 1ST TWO
1886 eb3a 9d 7c LB373 JSR GETNCH GET AN INPUT CHARACTER
1887 eb3c 25 fc BCS LB373 BRANCH IF NUMERIC
1888 eb3e 8d 29 BSR LB3A2 SET CARRY IF NOT ALPHA
1889 eb40 24 f8 BCC LB373 BRANCH IF ALPHA
1890 eb42 81 24 LB37B CMPA #'$ CHECK FOR A STRING VARIABLE
1891 eb44 26 06 BNE LB385 BRANCH IF IT IS NOT A STRING
1892 eb46 03 06 COM VALTYP SET VARIABLE TYPE TO STRING
1893 eb48 cb 80 ADDB #$80 SET BIT 7 OF 2ND CHARACTER (STRING)
1894 eb4a 9d 7c JSR GETNCH GET AN INPUT CHARACTER
1895 eb4c d7 38 LB385 STB VARNAM+1 SAVE 2ND CHARACTER IN VARNAM+1
1896 eb4e 9a 08 ORA ARYDIS OR IN THE ARRAY DISABLE FLAG - IF = $80,
1897 * DON<4F>T SEARCH FOR VARIABLES IN THE ARRAYS
1898 eb50 80 28 SUBA #'( IS THIS AN ARRAY VARIABLE?
1899 eb52 10 27 00 75 LBEQ LB404 BRANCH IF IT IS
1900 eb56 0f 08 CLR ARYDIS RESET THE ARRAY DISABLE FLAG
1901 eb58 9e 1b LDX VARTAB POINT X TO THE START OF VARIABLES
1902 eb5a dc 37 LDD VARNAM GET VARIABLE IN QUESTION
1903 eb5c 9c 1d LB395 CMPX ARYTAB COMPARE X TO THE END OF VARIABLES
1904 eb5e 27 12 BEQ LB3AB BRANCH IF END OF VARIABLES
1905 eb60 10 a3 81 CMPD ,X++ * COMPARE VARIABLE IN QUESTION TO CURRENT
1906 eb63 27 3e BEQ LB3DC * VARIABLE AND BRANCH IF MATCH
1907 eb65 30 05 LEAX 5,X = MOVE POINTER TO NEXT VARIABLE AND
1908 eb67 20 f3 BRA LB395 = KEEP LOOKING
1909
1910 * SET CARRY IF NOT UPPER CASE ALPHA
1911 eb69 81 41 LB3A2 CMPA #'A * CARRY SET IF < <20>A<EFBFBD>
1912 eb6b 25 04 BCS LB3AA *
1913 eb6d 80 5b SUBA #'Z+1 =
1914 * SUBA #-('Z+1) = CARRY CLEAR IF <= 'Z'
1915 eb6f 80 a5 FCB $80,$A5
1916 eb71 39 LB3AA RTS
1917 * PUT A NEW VARIABLE IN TABLE OF VARIABLES
1918 eb72 8e 00 74 LB3AB LDX #ZERO POINT X TO ZERO LOCATION
1919 eb75 ee e4 LDU ,S GET CURRENT RETURN ADDRESS
1920 eb77 11 83 ea 53 CMPU #LB287 DID WE COME FROM <20>EVALUATE ALPHA EXPR<50>?
1921 eb7b 27 28 BEQ LB3DE YES - RETURN A ZERO VALUE
1922 eb7d dc 1f LDD ARYEND * GET END OF ARRAYS ADDRESS AND
1923 eb7f dd 43 STD V43 * SAVE IT AT V43
1924 eb81 c3 00 07 ADDD #7 = ADD 7 TO END OF ARRAYS (EACH
1925 eb84 dd 41 STD V41 = VARIABLE = 7 BYTES) AND SAVE AT V41
1926 eb86 9e 1d LDX ARYTAB * GET END OF VARIABLES AND SAVE AT V47
1927 eb88 9f 47 STX V47 *
1928 eb8a bd e4 1e JSR LAC1E MAKE A SEVEN BYTE SLOT FOR NEW VARIABLE AT
1929 * TOP OF VARIABLES
1930 eb8d 9e 41 LDX V41 = GET NEW END OF ARRAYS AND SAVE IT
1931 eb8f 9f 1f STX ARYEND =
1932 eb91 9e 45 LDX V45 * GET NEW END OF VARIABLES AND SAVE IT
1933 eb93 9f 1d STX ARYTAB *
1934 eb95 9e 47 LDX V47 GET OLD END OF VARIABLES
1935 eb97 dc 37 LDD VARNAM GET NEW VARIABLE NAME
1936 eb99 ed 81 STD ,X++ SAVE VARIABLE NAME
1937 eb9b 4f CLRA * ZERO OUT THE FP VALUE OF THE NUMERIC
1938 eb9c 5f CLRB * VARIABLE OR THE LENGTH AND ADDRESS
1939 eb9d ed 84 STD ,X * OF A STRING VARIABLE
1940 eb9f ed 02 STD 2,X *
1941 eba1 a7 04 STA 4,X *
1942 eba3 9f 39 LB3DC STX VARPTR STORE ADDRESS OF VARIABLE VALUE
1943 eba5 39 LB3DE RTS
1944 *
1945 eba6 90 80 00 00 00 LB3DF FCB $90,$80,$00,$00,$00 * FLOATING POINT -32768
1946 * SMALLEST SIGNED TWO BYTE INTEGER
1947 *
1948 ebab 9d 7c LB3E4 JSR GETNCH GET AN INPUT CHARACTER FROM BASIC
1949 ebad bd e9 0d LB3E6 JSR LB141 GO EVALUATE NUMERIC EXPRESSION
1950 ebb0 96 54 LB3E9 LDA FP0SGN GET FPA0 MANTISSA SIGN
1951 ebb2 2b 5d BMI LB44A <20>FC<46> ERROR IF NEGATIVE NUMBER
1952
1953
1954 ebb4 bd e9 0f INTCNV JSR LB143 <20>TM<54> ERROR IF STRING VARIABLE
1955 ebb7 96 4f LDA FP0EXP GET FPA0 EXPONENT
1956 ebb9 81 90 CMPA #$90 * COMPARE TO 32768 - LARGEST INTEGER EXPONENT AND
1957 ebbb 25 08 BCS LB3FE * BRANCH IF FPA0 < 32768
1958 ebbd 8e eb a6 LDX #LB3DF POINT X TO FP VALUE OF -32768
1959 ebc0 bd f4 1f JSR LBC96 COMPARE -32768 TO FPA0
1960 ebc3 26 4c BNE LB44A <20>FC<46> ERROR IF NOT =
1961 ebc5 bd f4 51 LB3FE JSR LBCC8 CONVERT FPA0 TO A TWO BYTE INTEGER
1962 ebc8 dc 52 LDD FPA0+2 GET THE INTEGER
1963 ebca 39 RTS
1964 * EVALUATE AN ARRAY VARIABLE
1965 ebcb dc 05 LB404 LDD DIMFLG GET ARRAY FLAG AND VARIABLE TYPE
1966 ebcd 34 06 PSHS B,A SAVE THEM ON STACK
1967 ebcf 12 NOP DEAD SPACE CAUSED BY 1.2 REVISION
1968 ebd0 5f CLRB RESET DIMENSION COUNTER
1969 ebd1 9e 37 LB40A LDX VARNAM GET VARIABLE NAME
1970 ebd3 34 14 PSHS X,B SAVE VARIABLE NAME AND DIMENSION COUNTER
1971 ebd5 8d d4 BSR LB3E4 EVALUATE EXPRESSION (DIMENSlON LENGTH)
1972 ebd7 35 34 PULS B,X,Y PULL OFF VARIABLE NAME, DIMENSlON COUNTER,
1973 * ARRAY FLAG
1974 ebd9 9f 37 STX VARNAM SAVE VARIABLE NAME AND VARIABLE TYPE
1975 ebdb de 52 LDU FPA0+2 GET DIMENSION LENGTH
1976 ebdd 34 60 PSHS U,Y SAVE DIMENSION LENGTH, ARRAY FLAG, VARIABLE TYPE
1977 ebdf 5c INCB INCREASE DIMENSION COUNTER
1978 ebe0 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
1979 ebe2 81 2c CMPA #', CHECK FOR ANOTHER DIMENSION
1980 ebe4 27 eb BEQ LB40A BRANCH IF MORE
1981 ebe6 d7 03 STB TMPLOC SAVE DIMENSION COUNTER
1982 ebe8 bd ea 33 JSR LB267 SYNTAX CHECK FOR A <20>)<29>
1983 ebeb 35 06 PULS A,B * RESTORE VARIABLE TYPE AND ARRAY
1984 ebed dd 05 STD DIMFLG * FLAG - LEAVE DIMENSION LENGTH ON STACK
1985 ebef 9e 1d LDX ARYTAB GET START OF ARRAYS
1986 ebf1 9c 1f LB42A CMPX ARYEND COMPARE TO END OF ARRAYS
1987 ebf3 27 21 BEQ LB44F BRANCH IF NO MATCH FOUND
1988 ebf5 dc 37 LDD VARNAM GET VARIABLE IN QUESTION
1989 ebf7 10 a3 84 CMPD ,X COMPARE TO CURRENT VARIABLE
1990 ebfa 27 06 BEQ LB43B BRANCH IF =
1991 ebfc ec 02 LDD 2,X GET OFFSET TO NEXT ARRAY VARIABLE
1992 ebfe 30 8b LEAX D,X ADD TO CURRENT POINTER
1993 ec00 20 ef BRA LB42A KEEP SEARCHING
1994 ec02 c6 12 LB43B LDB #2*9 <20>REDIMENSIONED ARRAY<41> ERROR
1995 ec04 96 05 LDA DIMFLG * TEST ARRAY FLAG - IF <>0 YOU ARE TRYING
1996 ec06 26 0b BNE LB44C * TO REDIMENSION AN ARRAY
1997 ec08 d6 03 LDB TMPLOC GET NUMBER OF DIMENSIONS IN ARRAY
1998 ec0a e1 04 CMPB 4,X COMPARE TO THIS ARRAYS DIMENSIONS
1999 ec0c 27 59 BEQ LB4A0 BRANCH IF =
2000 ec0e c6 10 LB447 LDB #8*2 <20>BAD SUBSCRIPT<50>
2001 ec10 8c FCB SKP2 SKIP TWO BYTES
2002 ec11 c6 08 LB44A LDB #4*2 <20>ILLEGAL FUNCTION CALL<4C>
2003 ec13 7e e4 46 LB44C JMP LAC46 JUMP TO ERROR SERVICING ROUTINE
2004
2005 * INSERT A NEW ARRAY INTO ARRAY VARIABLES
2006 * EACH SET OF ARRAY VARIABLES IS PRECEEDED BY A DE-
2007 * SCRIPTOR BLOCK COMPOSED OF 5+2*N BYTES WHERE N IS THE
2008 * NUMBER OF DIMENSIONS IN THE ARRAY. THE BLOCK IS DEFINED
2009 * AS FOLLOWS: BYTES 0,1:VARIABLE<4C>S NAME; 2,3:TOTAL LENGTH
2010 * OF ARRAY ITEMS AND DESCRIPTOR BLOCK; 4:NUMBER OF DIMEN-
2011 * ISIONS; 5,6:LENGTH OF DIMENSION 1; 7,8:LENGTH OF DIMEN-
2012 * SION 2;<3B> 4+N,5+N:LENGTH OF DIMENSION N.
2013
2014 ec16 cc 00 05 LB44F LDD #5 * 5 BYTES/ARRAY ENTRY SAVE AT COEFPT
2015 ec19 dd 64 STD COEFPT *
2016 ec1b dc 37 LDD VARNAM = GET NAME OF ARRAY AND SAVE IN
2017 ec1d ed 84 STD ,X = FIRST 2 BYTES OF DESCRIPTOR
2018 ec1f d6 03 LDB TMPLOC GET NUMBER OF DIMENSIONS AND SAVE IN
2019 ec21 e7 04 STB 4,X * 5TH BYTE OF DESCRIPTOR
2020 ec23 bd e4 33 JSR LAC33 CHECK FOR ROOM FOR DESCRIPTOR IN FREE RAM
2021 ec26 9f 41 STX V41 TEMPORARILY SAVE DESCRIPTOR ADDRESS
2022 ec28 c6 0b LB461 LDB #11 * DEFAULT DIMENSION VALUE:X(10)
2023 ec2a 4f CLRA *
2024 ec2b 0d 05 TST DIMFLG = CHECK ARRAY FLAG AND BRANCH IF
2025 ec2d 27 05 BEQ LB46D = NOT DIMENSIONING AN ARRAY
2026 ec2f 35 06 PULS A,B GET DIMENSION LENGTH
2027 ec31 c3 00 01 ADDD #1 ADD ONE (X(0) HAS A LENGTH OF ONE)
2028 ec34 ed 05 LB46D STD 5,X SAVE LENGTH OF ARRAY DIMENSION
2029 ec36 8d 5d BSR LB4CE MULTIPLY ACCUM ARRAY SIZE NUMBER LENGTH
2030 * OF NEW DIMENSION
2031 ec38 dd 64 STD COEFPT TEMP STORE NEW CURRENT ACCUMULATED ARRAY SIZE
2032 ec3a 30 02 LEAX 2,X BUMP POINTER UP TWO
2033 ec3c 0a 03 DEC TMPLOC * DECREMENT DIMENSION COUNTER AND BRANCH IF
2034 ec3e 26 e8 BNE LB461 * NOT DONE WITH ALL DIMENSIONS
2035 ec40 9f 0f STX TEMPTR SAVE ADDRESS OF (END OF ARRAY DESCRIPTOR - 5)
2036 ec42 d3 0f ADDD TEMPTR ADD TOTAL SIZE OF NEW ARRAY
2037 ec44 10 25 f7 fc LBCS LAC44 <20>OM<4F> ERROR IF > $FFFF
2038 ec48 1f 01 TFR D,X SAVE END OF ARRAY IN X
2039 ec4a bd e4 37 JSR LAC37 MAKE SURE THERE IS ENOUGH FREE RAM FOR ARRAY
2040 ec4d 83 00 35 SUBD #STKBUF-5 SUBTRACT OUT THE (STACK BUFFER - 5)
2041 ec50 dd 1f STD ARYEND SAVE NEW END OF ARRAYS
2042 ec52 4f CLRA ZERO = TERMINATOR BYTE
2043 ec53 30 1f LB48C LEAX -1,X * STORE TWO TERMINATOR BYTES AT
2044 ec55 a7 05 STA 5,X * THE END OF THE ARRAY DESCRIPTOR
2045 ec57 9c 0f CMPX TEMPTR *
2046 ec59 26 f8 BNE LB48C *
2047 ec5b 9e 41 LDX V41 GET ADDRESS OF START OF DESCRIPTOR
2048 ec5d 96 1f LDA ARYEND GET MSB OF END OF ARRAYS; LSB ALREADY THERE
2049 ec5f 93 41 SUBD V41 SUBTRACT OUT ADDRESS OF START OF DESCRIPTOR
2050 ec61 ed 02 STD 2,X SAVE LENGTH OF (ARRAY AND DESCRIPTOR)
2051 ec63 96 05 LDA DIMFLG * GET ARRAY FLAG AND BRANCH
2052 ec65 26 2d BNE LB4CD * BACK IF DIMENSIONING
2053 * CALCULATE POINTER TO CORRECT ELEMENT
2054 ec67 e6 04 LB4A0 LDB 4,X GET THE NUMBER OF DIMENSIONS
2055 ec69 d7 03 STB TMPLOC TEMPORARILY SAVE
2056 ec6b 4f CLRA * INITIALIZE POINTER
2057 ec6c 5f CLRB * TO ZERO
2058 ec6d dd 64 LB4A6 STD COEFPT SAVE ACCUMULATED POINTER
2059 ec6f 35 06 PULS A,B * PULL DIMENSION ARGUMENT OFF THE
2060 ec71 dd 52 STD FPA0+2 * STACK AND SAVE IT
2061 ec73 10 a3 05 CMPD 5,X COMPARE TO STORED <20>DIM<49> ARGUMENT
2062 ec76 24 3a BCC LB4EB <20>BS<42> ERROR IF > = "DIM" ARGUMENT
2063 ec78 de 64 LDU COEFPT * GET ACCUMULATED POINTER AND
2064 ec7a 27 04 BEQ LB4B9 * BRANCH IF 1ST DIMENSION
2065 ec7c 8d 17 BSR LB4CE = MULTIPLY ACCUMULATED POINTER AND DIMENSION
2066 ec7e d3 52 ADDD FPA0+2 = LENGTH AND ADD TO CURRENT ARGUMENT
2067 ec80 30 02 LB4B9 LEAX 2,X MOVE POINTER TO NEXT DIMENSION
2068 ec82 0a 03 DEC TMPLOC * DECREMENT DIMENSION COUNTER AND
2069 ec84 26 e7 BNE LB4A6 * BRANCH IF ANY DIMENSIONS LEFT
2070 * MULTIPLY ACCD BY 5 - 5 BYTES/ARRAY VALUE
2071 ec86 ed e3 STD ,--S
2072 ec88 58 ASLB
2073 ec89 49 ROLA TIMES 2
2074 ec8a 58 ASLB
2075 ec8b 49 ROLA TIMES 4
2076 ec8c e3 e1 ADDD ,S++ TIMES 5
2077 ec8e 30 8b LEAX D,X ADD OFFSET TO START OF ARRAY
2078 ec90 30 05 LEAX 5,X ADJUST POINTER FOR SIZE OF DESCRIPTOR
2079 ec92 9f 39 STX VARPTR SAVE POINTER TO ARRAY VALUE
2080 ec94 39 LB4CD RTS
2081 * MULTIPLY 2 BYTE NUMBER IN 5,X BY THE 2 BYTE NUMBER
2082 * IN COEFPT. RETURN RESULT IN ACCD, BS ERROR IF > $FFFF
2083 ec95 86 10 LB4CE LDA #16 16 SHIFTS TO DO A MULTIPLY
2084 ec97 97 45 STA V45 SHIFT COUNTER
2085 ec99 ec 05 LDD 5,X * GET SIZE OF DIMENSION
2086 ec9b dd 17 STD BOTSTK * AND SAVE IT
2087 ec9d 4f CLRA * ZERO
2088 ec9e 5f CLRB * ACCD
2089 ec9f 58 LB4D8 ASLB = SHIFT ACCB LEFT
2090 eca0 49 ROLA = ONE BIT
2091 eca1 25 0f BCS LB4EB BS' ERROR IF CARRY
2092 eca3 08 65 ASL COEFPT+1 * SHIFT MULTIPLICAND LEFT ONE
2093 eca5 09 64 ROL COEFPT * BIT - ADD MULTIPLIER TO ACCUMULATOR
2094 eca7 24 04 BCC LB4E6 * IF CARRY <> 0
2095 eca9 d3 17 ADDD BOTSTK ADD MULTIPLIER TO ACCD
2096 ecab 25 05 BCS LB4EB BS' ERROR IF CARRY (>$FFFF)
2097 ecad 0a 45 LB4E6 DEC V45 * DECREMENT SHIFT COUNTER
2098 ecaf 26 ee BNE LB4D8 * IF NOT DONE
2099 ecb1 39 RTS
2100 ecb2 7e ec 0e LB4EB JMP LB447 BS' ERROR
2101 *
2102 * MEM
2103 * THIS IS NOT A TRUE INDICATOR OF FREE MEMORY BECAUSE
2104 * BASIC REQUIRES A STKBUF SIZE BUFFER FOR THE STACK
2105 * FOR WHICH MEM DOES NOT ALLOW.
2106 *
2107 ecb5 1f 40 MEM TFR S,D PUT STACK POINTER INTO ACCD
2108 ecb7 93 1f SUBD ARYEND SUBTRACT END OF ARRAYS
2109 ecb9 21 FCB SKP1 SKIP ONE BYTE
2110 *CONVERT THE VALUE IN ACCB INTO A FP NUMBER IN FPA0
2111 ecba 4f LB4F3 CLRA CLEAR MS BYTE OF ACCD
2112 * CONVERT THE VALUE IN ACCD INTO A FLOATING POINT NUMBER IN FPA0
2113 ecbb 0f 06 GIVABF CLR VALTYP SET VARIABLE TYPE TO NUMERIC
2114 ecbd dd 50 STD FPA0 SAVE ACCD IN TOP OF FACA
2115 ecbf c6 90 LDB #$90 EXPONENT REQUIRED IF THE TOP TWO BYTES
2116 * OF FPA0 ARE TO BE TREATED AS AN INTEGER IN FPA0
2117 ecc1 7e f4 0b JMP LBC82 CONVERT THE REST OF FPA0 TO AN INTEGER
2118
2119 * STR$
2120 ecc4 bd e9 0f STR JSR LB143 TM' ERROR IF STRING VARIABLE
2121 ecc7 ce 01 f0 LDU #STRBUF+2 *CONVERT FP NUMBER TO ASCII STRING IN
2122 ecca bd f5 65 JSR LBDDC *THE STRING BUFFER
2123 eccd 32 62 LEAS 2,S PURGE THE RETURN ADDRESS FROM THE STACK
2124 eccf 8e 01 ef LDX #STRBUF+1 *POINT X TO STRING BUFFER AND SAVE
2125 ecd2 20 0b BRA LB518 *THE STRING IN THE STRING SPACE
2126 * RESERVE ACCB BYTES OF STRING SPACE. RETURN START
2127 * ADDRESS IN (X) AND FRESPC
2128 ecd4 9f 4d LB50D STX V4D SAVE X IN V4D
2129 ecd6 8d 5c LB50F BSR LB56D RESERVE ACCB BYTES IN STRING SPACE
2130 ecd8 9f 58 LB511 STX STRDES+2 SAVE NEW STRING ADDRESS
2131 ecda d7 56 STB STRDES SAVE LENGTH OF RESERVED BLOCK
2132 ecdc 39 RTS
2133 ecdd 30 1f LB516 LEAX -1,X MOVE POINTER BACK ONE
2134 * SCAN A LINE FROM (X) UNTIL AN END OF LINE FLAG (ZERO) OR
2135 * EITHER OF THE TWO TERMINATORS STORED IN CHARAC OR ENDCHR IS MATCHED.
2136 * THE RESULTING STRING IS STORED IN THE STRING SPACE
2137 * ONLY IF THE START OF THE STRING IS <= STRBUF+2
2138 ecdf 86 22 LB518 LDA #'" * INITIALIZE
2139 ece1 97 01 STA CHARAC * TERMINATORS
2140 ece3 97 02 LB51A STA ENDCHR * TO "
2141 ece5 30 01 LB51E LEAX 1,X MOVE POINTER UP ONE
2142 ece7 9f 62 STX RESSGN TEMPORARILY SAVE START OF STRING
2143 ece9 9f 58 STX STRDES+2 SAVE START OF STRING IN TEMP DESCRIPTOR
2144 eceb c6 ff LDB #-1 INITIALIZE CHARACTER COUNTER TO - 1
2145 eced 5c LB526 INCB INCREMENT CHARACTER COUNTER
2146 ecee a6 80 LDA ,X+ GET CHARACTER
2147 ecf0 27 0c BEQ LB537 BRANCH IF END OF LINE
2148 ecf2 91 01 CMPA CHARAC * CHECK FOR TERMINATORS
2149 ecf4 27 04 BEQ LB533 * IN CHARAC AND ENDCHR
2150 ecf6 91 02 CMPA ENDCHR * DON<4F>T MOVE POINTER BACK
2151 ecf8 26 f3 BNE LB526 * ONE IF TERMINATOR IS "MATCHED"
2152 ecfa 81 22 LB533 CMPA #'" = COMPARE CHARACTER TO STRING DELIMITER
2153 ecfc 27 02 BEQ LB539 = & DON<4F>T MOVE POINTER BACK IF SO
2154 ecfe 30 1f LB537 LEAX -1,X MOVE POINTER BACK ONE
2155 ed00 9f 64 LB539 STX COEFPT SAVE END OF STRING ADDRESS
2156 ed02 d7 56 STB STRDES SAVE STRING LENGTH IN TEMP DESCRIPTOR
2157 ed04 de 62 LDU RESSGN GET INITlAL STRING START
2158 ed06 11 83 01 f0 CMPU #STRBUF+2 COMPARE TO START OF STRING BUFFER
2159 ed0a 22 07 LB543 BHI LB54C BRANCH IF > START OF STRING BUFFER
2160 ed0c 8d c6 BSR LB50D GO RESERVE SPACE FOR THE STRING
2161 ed0e 9e 62 LDX RESSGN POINT X TO THE BEGINNING OF THE STRING
2162 ed10 bd ee 0c JSR LB645 MOVE (B) BYTES FROM (X) TO
2163 * [FRESPC] - MOVE STRING DATA
2164 * PUT DIRECT PAGE STRING DESCRIPTOR BUFFER DATA
2165 * ON THE STRING STACK. SET VARIABLE TYPE TO STRING
2166 ed13 9e 0b LB54C LDX TEMPPT GET NEXT AVAILABLE STRING STACK DESCRIPTOR
2167 ed15 8c 00 f1 CMPX #LINHDR COMPARE TO TOP OF STRING DESCRIPTOR STACK - WAS #CFNBUF
2168 ed18 26 05 BNE LB558 FORMULA O.K.
2169 ed1a c6 1e LDB #15*2 STRING FORMULA TOO COMPLEX' ERROR
2170 ed1c 7e e4 46 LB555 JMP LAC46 JUMP TO ERROR SERVICING ROUTINE
2171 ed1f 96 56 LB558 LDA STRDES * GET LENGTH OF STRING AND SAVE IT
2172 * STA ,X * IN BYTE 0 OF DESCRIPTOR
2173 ed21 a7 00 FCB $A7,$00
2174 ed23 dc 58 LDD STRDES+2 = GET START ADDRESS OF ACTUAL STRING
2175 ed25 ed 02 STD 2,X = AND SAVE IN BYTES 2,3 OF DESCRIPTOR
2176 ed27 86 ff LDA #$FF * VARIABLE TYPE = STRING
2177 ed29 97 06 STA VALTYP * SAVE IN VARIABLE TYPE FLAG
2178 ed2b 9f 0d STX LASTPT = SAVE START OF DESCRIPTOR
2179 ed2d 9f 52 STX FPA0+2 = ADDRESS IN LASTPT AND FPA0
2180 ed2f 30 05 LEAX 5,X 5 BYTES/STRING DESCRIPTOR
2181 ed31 9f 0b STX TEMPPT NEXT AVAILABLE STRING VARIABLE DESCRIPTOR
2182 ed33 39 RTS
2183 * RESERVE ACCB BYTES IN STRING STORAGE SPACE
2184 * RETURN WITH THE STARTING ADDRESS OF THE
2185 * RESERVED STRING SPACE IN (X) AND FRESPC
2186 ed34 0f 07 LB56D CLR GARBFL CLEAR STRING REORGANIZATION FLAG
2187 ed36 4f LB56F CLRA * PUSH THE LENGTH OF THE
2188 ed37 34 06 PSHS B,A * STRING ONTO THE STACK
2189 ed39 dc 23 LDD STRTAB GET START OF STRING VARIABLES
2190 ed3b a3 e0 SUBD ,S+ SUBTRACT STRING LENGTH
2191 ed3d 10 93 21 CMPD FRETOP COMPARE TO START OF STRING STORAGE
2192 ed40 25 0a BCS LB585 IF BELOW START, THEN REORGANIZE
2193 ed42 dd 23 STD STRTAB SAVE NEW START OF STRING VARIABLES
2194 ed44 9e 23 LDX STRTAB GET START OF STRING VARIABLES
2195 ed46 30 01 LEAX 1,X ADD ONE
2196 ed48 9f 25 STX FRESPC SAVE START ADDRESS OF NEWLY RESERVED SPACE
2197 ed4a 35 84 PULS B,PC RESTORE NUMBER OF BYTES RESERVED AND RETURN
2198 ed4c c6 1a LB585 LDB #2*13 OUT OF STRING SPACE' ERROR
2199 ed4e 03 07 COM GARBFL TOGGLE REORGANIZATiON FLAG
2200 ed50 27 ca BEQ LB555 ERROR IF FRESHLY REORGANIZED
2201 ed52 8d 04 BSR LB591 GO REORGANIZE STRING SPACE
2202 ed54 35 04 PULS B GET BACK THE NUMBER OF BYTES TO RESERVE
2203 ed56 20 de BRA LB56F TRY TO RESERVE ACCB BYTES AGAIN
2204 * REORGANIZE THE STRING SPACE
2205 ed58 9e 27 LB591 LDX MEMSIZ GET THE TOP OF STRING SPACE
2206 ed5a 9f 23 LB593 STX STRTAB SAVE TOP OF UNORGANIZED STRING SPACE
2207 ed5c 4f CLRA * ZERO OUT ACCD
2208 ed5d 5f CLRB * AND RESET VARIABLE
2209 ed5e dd 4b STD V4B * POINTER TO 0
2210 ed60 9e 21 LDX FRETOP POINT X TO START OF STRING SPACE
2211 ed62 9f 47 STX V47 SAVE POINTER IN V47
2212 ed64 8e 00 c9 LDX #STRSTK POINT X TO START OF STRING DESCRIPTOR STACK
2213 ed67 9c 0b LB5A0 CMPX TEMPPT COMPARE TO ADDRESS OF NEXT AVAILABLE DESCRIPTOR
2214 ed69 27 04 BEQ LB5A8 BRANCH IF TOP OF STRING STACK
2215 ed6b 8d 32 BSR LB5D8 CHECK FOR STRING IN UNORGANIZED STRING SPACE
2216 ed6d 20 f8 BRA LB5A0 KEEP CHECKING
2217 ed6f 9e 1b LB5A8 LDX VARTAB GET THE END OF BASIC PROGRAM
2218 ed71 9c 1d LB5AA CMPX ARYTAB COMPARE TO END OF VARIABLES
2219 ed73 27 04 BEQ LB5B2 BRANCH IF AT TOP OF VARIABLES
2220 ed75 8d 22 BSR LB5D2 CHECK FOR STRING IN UNORGANIZED STRING SPACE
2221 ed77 20 f8 BRA LB5AA KEEP CHECKING VARIABLES
2222 ed79 9f 41 LB5B2 STX V41 SAVE ADDRESS OF THE END OF VARIABLES
2223 ed7b 9e 41 LB5B4 LDX V41 GET CURRENT ARRAY POINTER
2224 ed7d 9c 1f LB5B6 CMPX ARYEND COMPARE TO THE END OF ARRAYS
2225 ed7f 27 35 BEQ LB5EF BRANCH IF AT END OF ARRAYS
2226 ed81 ec 02 LDD 2,X GET LENGTH OF ARRAY AND DESCRIPTOR
2227 ed83 d3 41 ADDD V41 * ADD TO CURRENT ARRAY POINTER
2228 ed85 dd 41 STD V41 * AND SAVE IT
2229 ed87 a6 01 LDA 1,X GET 1ST CHARACTER OF VARIABLE NAME
2230 ed89 2a f0 BPL LB5B4 BRANCH IF NUMERIC ARRAY
2231 ed8b e6 04 LDB 4,X GET THE NUMBER OF DIMENSIONS IN THIS ARRAY
2232 ed8d 58 ASLB MULTIPLY BY 2
2233 ed8e cb 05 ADDB #5 ADD FIVE BYTES (VARIABLE NAME, ARRAY
2234 * LENGTH, NUMBER DIMENSIONS)
2235 ed90 3a ABX X NOW POINTS TO START OF ARRAY ELEMENTS
2236 ed91 9c 41 LB5CA CMPX V41 AT END OF THIS ARRAY?
2237 ed93 27 e8 BEQ LB5B6 YES - CHECK FOR ANOTHER
2238 ed95 8d 08 BSR LB5D8 CHECK FOR STRING LOCATED IN
2239 * UNORGANIZED STRING SPACE
2240 ed97 20 f8 BRA LB5CA KEEP CHECKING ELEMENTS IN THIS ARRAY
2241 ed99 a6 01 LB5D2 LDA 1,X GET F1RST BYTE OF VARIABLE NAME
2242 ed9b 30 02 LEAX 2,X MOVE POINTER TO DESCRIPTOR
2243 ed9d 2a 14 BPL LB5EC BRANCH IF VARIABLE IS NUMERIC
2244 * SEARCH FOR STRING - ENTER WITH X POINTING TO
2245 * THE STRING DESCRIPTOR. IF STRING IS STORED
2246 * BETWEEN V47 AND STRTAB, SAVE DESCRIPTOR POINTER
2247 * IN V4B AND RESET V47 TO STRING ADDRESS
2248 ed9f e6 84 LB5D8 LDB ,X GET THE LENGTH OF THE STRING
2249 eda1 27 10 BEQ LB5EC BRANCH IF NULL - NO STRING
2250 eda3 ec 02 LDD 2,X GET STARTING ADDRESS OF THE STRING
2251 eda5 10 93 23 CMPD STRTAB COMPARE TO THE START OF STRING VARIABLES
2252 eda8 22 09 BHI LB5EC BRANCH IF THIS STRING IS STORED IN
2253 * THE STRING VARIABLES
2254 edaa 10 93 47 CMPD V47 COMPARE TO START OF STRING SPACE
2255 edad 23 04 BLS LB5EC BRANCH IF NOT STORED IN THE STRING SPACE
2256 edaf 9f 4b STX V4B SAVE VARIABLE POINTER IF STORED IN STRING SPACE
2257 edb1 dd 47 STD V47 SAVE STRING STARTING ADDRESS
2258 edb3 30 05 LB5EC LEAX 5,X MOVE TO NEXT VARIABLE DESCRIPTOR
2259 edb5 39 LB5EE RTS
2260 edb6 9e 4b LB5EF LDX V4B GET ADDRESS OF THE DESCRIPTOR FOR THE
2261 * STRING WHICH IS STORED IN THE HIGHEST RAM ADDRESS IN
2262 * THE UNORGANIZED STRING SPACE
2263 edb8 27 fb BEQ LB5EE BRANCH IF NONE FOUND AND REORGANIZATION DONE
2264 edba 4f CLRA CLEAR MS BYTE OF LENGTH
2265 edbb e6 84 LDB ,X GET LENGTH OF STRING
2266 edbd 5a DECB SUBTRACT ONE
2267 edbe d3 47 ADDD V47 ADD LENGTH OF STRING TO ITS STARTING ADDRESS
2268 edc0 dd 43 STD V43 SAVE AS MOVE STARTING ADDRESS
2269 edc2 9e 23 LDX STRTAB POINT X TO THE START OF ORGANIZED STRING VARIABLES
2270 edc4 9f 41 STX V41 SAVE AS MOVE ENDING ADDRESS
2271 edc6 bd e4 20 JSR LAC20 MOVE STRING FROM CURRENT POSITION TO THE
2272 * TOP OF UNORGANIZED STRING SPACE
2273 edc9 9e 4b LDX V4B POINT X TO STRING DESCRIPTOR
2274 edcb dc 45 LDD V45 * GET NEW STARTING ADDRESS OF STRING AND
2275 edcd ed 02 STD 2,X * SAVE IT IN DESCRIPTOR
2276 edcf 9e 45 LDX V45 GET NEW TOP OF UNORGANIZED STRING SPACE
2277 edd1 30 1f LEAX -1,X MOVE POINTER BACK ONE
2278 edd3 7e ed 5a JMP LB593 JUMP BACK AND REORGANIZE SOME MORE
2279
2280
2281 edd6 dc 52 LB60F LDD FPA0+2 * GET DESCRIPTOR ADDRESS OF STRING A
2282 edd8 34 06 PSHS B,A * AND SAVE IT ON THE STACK
2283 edda bd e9 ef JSR LB223 GET DESCRIPTOR ADDRESS OF STRING B
2284 eddd bd e9 12 JSR LB146 TM' ERROR IF NUMERIC VARIABLE
2285 ede0 35 10 PULS X * POINT X TO STRING A DESCRIPTOR
2286 ede2 9f 62 STX RESSGN * ADDRESS AND SAVE IT IN RESSGN
2287 ede4 e6 84 LDB ,X GET LENGTH OF STRING A
2288 ede6 9e 52 LDX FPA0+2 POINT X TO DESCRIPTOR OF STRING B
2289 ede8 eb 84 ADDB ,X ADD LENGTH OF STRING B TO STR1NG A
2290 edea 24 05 BCC LB62A BRANCH IF LENGTH < 256
2291 edec c6 1c LDB #2*14 STRING TOO LONG' ERROR IF LENGTH > 255
2292 edee 7e e4 46 JMP LAC46 JUMP TO ERROR SERVICING ROUTINE
2293 edf1 bd ec d4 LB62A JSR LB50D RESERVE ROOM IN STRING SPACE FOR NEW STRING
2294 edf4 9e 62 LDX RESSGN GET DESCRIPTOR ADDRESS OF STRING A
2295 edf6 e6 84 LDB ,X GET LENGTH OF STRING A
2296 edf8 8d 10 BSR LB643 MOVE STRING A INTO RESERVED BUFFER IN STRING SPACE
2297 edfa 9e 4d LDX V4D GET DESCRIPTOR ADDRESS OF STRING B
2298 edfc 8d 22 BSR LB659 GET LENGTH AND ADDRESS OF STRING B
2299 edfe 8d 0c BSR LB645 MOVE STRING B INTO REST OF RESERVED BUFFER
2300 ee00 9e 62 LDX RESSGN POINT X TO DESCRIPTOR OF STRING A
2301 ee02 8d 1c BSR LB659 DELETE STRING A IF LAST STRING ON STRING STACK
2302 ee04 bd ed 13 JSR LB54C PUT STRING DESCRIPTOR ON THE STRING STACK
2303 ee07 7e e9 34 JMP LB168 BRANCH BACK TO EXPRESSION EVALUATION
2304
2305 * MOVE (B) BYTES FROM 2,X TO FRESPC
2306 ee0a ae 02 LB643 LDX 2,X POINT X TO SOURCE ADDRESS
2307 ee0c de 25 LB645 LDU FRESPC POINT U TO DESTINATION ADDRESS
2308 ee0e 5c INCB COMPENSATION FOR THE DECB BELOW
2309 ee0f 20 04 BRA LB64E GO MOVE THE BYTES
2310 * MOVE B BYTES FROM (X) TO (U)
2311 ee11 a6 80 LB64A LDA ,X+ * GET A SOURCE BYTE AND MOVE IT
2312 ee13 a7 c0 STA ,U+ * TO THE DESTINATION
2313 ee15 5a LB64E DECB DECREMENT BYTE COUNTER
2314 ee16 26 f9 BNE LB64A BRANCH IF ALL BYTES NOT MOVED
2315 ee18 df 25 STU FRESPC SAVE ENDING ADDRESS IN FRESPC
2316 ee1a 39 RTS
2317 * RETURN LENGTH (ACCB) AND ADDRESS (X) OF
2318 * STRING WHOSE DESCRIPTOR IS IN FPA0+2
2319 * DELETE THE STRING IF IT IS THE LAST ONE
2320 * PUT ON THE STRING STACK. REMOVE STRING FROM STRING
2321 * SPACE IF IT IS AT THE BOTTOM OF STRING VARIABLES.
2322 ee1b bd e9 12 LB654 JSR LB146 TM' ERROR IF VARIABLE TYPE = NUMERIC
2323 ee1e 9e 52 LB657 LDX FPA0+2 GET ADDRESS OF SELECTED STRING DESCRIPTOR
2324 ee20 e6 84 LB659 LDB ,X GET LENGTH OF STRING
2325 ee22 8d 18 BSR LB675 * CHECK TO SEE IF THIS STRING DESCRIPTOR WAS
2326 ee24 26 13 BNE LB672 * THE LAST ONE PUT ON THE STRING STACK AND
2327 * * BRANCH IF NOT
2328 ee26 ae 07 LDX 5+2,X GET START ADDRESS OF STRING JUST REMOVED
2329 ee28 30 1f LEAX -1,X MOVE POINTER DOWN ONE
2330 ee2a 9c 23 CMPX STRTAB COMPARE TO START OF STRING VARIABLES
2331 ee2c 26 08 BNE LB66F BRANCH IF THIS STRING IS NOT AT THE BOTTOM
2332 * OF STRING VARIABLES
2333 ee2e 34 04 PSHS B SAVE LENGTH; ACCA WAS CLEARED
2334 ee30 d3 23 ADDD STRTAB * ADD THE LENGTH OF THE JUST REMOVED STRING
2335 ee32 dd 23 STD STRTAB * TO THE START OF STRING VARIABLES - THIS WILL
2336 * * REMOVE THE STRING FROM THE STRING SPACE
2337 ee34 35 04 PULS B RESTORE LENGTH
2338 ee36 30 01 LB66F LEAX 1,X ADD ONE TO POINTER
2339 ee38 39 RTS
2340 ee39 ae 02 LB672 LDX 2,X *POINT X TO ADDRESS OF STRING NOT
2341 ee3b 39 RTS *ON THE STRING STACK
2342 * REMOVE STRING FROM STRING STACK. ENTER WITH X
2343 * POINTING TO A STRING DESCRIPTOR - DELETE THE
2344 * STRING FROM STACK IF IT IS ON TOP OF THE
2345 * STACK. IF THE STRING IS DELETED, SET THE ZERO FLAG
2346 ee3c 9c 0d LB675 CMPX LASTPT *COMPARE TO LAST USED DESCRIPTOR ADDRESS
2347 ee3e 26 07 BNE LB680 *ON THE STRING STACK, RETURN IF DESCRIPTOR
2348 * *ADDRESS NOT ON THE STRING STACK
2349 ee40 9f 0b STX TEMPPT SAVE LAST USED DESCRIPTOR AS NEXT AVAILABLE
2350 ee42 30 1b LEAX -5,X * MOVE LAST USED DESCRIPTOR BACK 5 BYTES
2351 ee44 9f 0d STX LASTPT * AND SAVE AS THE LAST USED DESCRIPTOR ADDR
2352 ee46 4f CLRA SET ZERO FLAG
2353 ee47 39 LB680 RTS
2354
2355 * LEN
2356 ee48 8d 03 LEN BSR LB686 POINT X TO PROPER STRING AND GET LENGTH
2357 ee4a 7e ec ba LB683 JMP LB4F3 CONVERT ACCB TO FP NUMBER IN FPA0
2358 * POINT X TO STRING ADDRESS LOAD LENGTH INTO
2359 * ACCB. ENTER WITH THE STRING DESCRIPTOR IN
2360 * BOTTOM TWO BYTES OF FPA0
2361 ee4d 8d cc LB686 BSR LB654 GET LENGTH AND ADDRESS OF STRING
2362 ee4f 0f 06 CLR VALTYP SET VARIABLE TYPE TO NUMERIC
2363 ee51 5d TSTB SET FLAGS ACCORDING TO LENGTH
2364 ee52 39 RTS
2365
2366 * CHR$
2367 ee53 bd ee d5 CHR JSR LB70E CONVERT FPA0 TO AN INTEGER IN ACCD
2368 ee56 c6 01 LB68F LDB #1 * RESERVE ONE BYTE IN
2369 ee58 bd ed 34 JSR LB56D * THE STRING SPACE
2370 ee5b 96 53 LDA FPA0+3 GET ASCII STRING VALUE
2371 ee5d bd ec d8 JSR LB511 SAVE RESERVED STRING DESCRIPTOR IN TEMP DESCRIPTOR
2372 ee60 a7 84 STA ,X SAVE THE STRING (IT<49>S ONLY ONE BYTE)
2373 ee62 32 62 LB69B LEAS 2,S PURGE THE RETURN ADDRESS OFF OF THE STACK
2374 ee64 7e ed 13 LB69D JMP LB54C PUT TEMP DESCRIPTOR DATA ONTO STRING STACK
2375
2376
2377 ee67 8d 02 ASC BSR LB6A4 PUT 1ST CHARACTER OF STRING INTO ACCB
2378 ee69 20 df BRA LB683 CONVERT ACCB INTO FP NUMBER IN FPA0
2379 ee6b 8d e0 LB6A4 BSR LB686 POINT X TO STRING DESCRIPTOR
2380 ee6d 27 5e BEQ LB706 FC' ERROR IF NULL STRING
2381 ee6f e6 84 LDB ,X GET FIRST BYTE OF STRING
2382 ee71 39 RTS
2383
2384
2385 ee72 8d 48 LEFT BSR LB6F5 GET ARGUMENTS FROM STACK
2386 ee74 4f LB6AD CLRA CLEAR STRING POINTER OFFSET - OFFSET = 0 FOR LEFT$
2387 ee75 e1 84 LB6AE CMPB ,X * COMPARE LENGTH PARAMETER TO LENGTH OF
2388 ee77 23 03 BLS LB6B5 * STRING AND BRANCH IF LENGTH OF STRING
2389 * >= LENGTH PARAMETER
2390 ee79 e6 84 LDB ,X USE LENGTH OF STRING OTHERWISE
2391 ee7b 4f CLRA CLEAR STRING POINTER OFFSET (0 FOR LEFT$)
2392 ee7c 34 06 LB6B5 PSHS B,A PUSH PARAMETERS ONTO STACK
2393 ee7e bd ec d6 JSR LB50F RESERVE ACCB BYTES IN THE STRING SPACE
2394 ee81 9e 4d LDX V4D POINT X TO STRING DESCRIPTOR
2395 ee83 8d 9b BSR LB659 GET ADDRESS OF OLD STRING (X=ADDRESS)
2396 ee85 35 04 PULS B * PULL STRING POINTER OFFSET OFF OF THE STACK
2397 ee87 3a ABX * AND ADD IT TO STRING ADDRESS
2398 ee88 35 04 PULS B PULL LENGTH PARAMETER OFF OF THE STACK
2399 ee8a bd ee 0c JSR LB645 MOVE ACCB BYTES FROM (X) TO [FRESPC]
2400 ee8d 20 d5 BRA LB69D PUT TEMP STRING DESCRIPTOR ONTO THE STRING STACK
2401
2402 * RIGHT$
2403 ee8f 8d 2b RIGHT BSR LB6F5 GET ARGUMENTS FROM STACK
2404 ee91 a0 84 SUBA ,X ACCA=LENGTH PARAMETER - LENGTH OF OLD STRING
2405 ee93 40 NEGA NOW ACCA = LENGTH OF OLD STRING
2406 ee94 20 df BRA LB6AE PUT NEW STRING IN THE STRING SPACE
2407
2408 * MID$
2409 ee96 c6 ff MID LDB #$FF * GET DEFAULT VALUE OF LENGTH AND
2410 ee98 d7 53 STB FPA0+3 * SAVE IT IN FPA0
2411 ee9a 9d 82 JSR GETCCH GET CURRENT CHARACTER FROM BASIC
2412 ee9c 81 29 CMPA #') ARGUMENT DELIMITER?
2413 ee9e 27 05 BEQ LB6DE YES - NO LENGTH PARAMETER GIVEN
2414 eea0 bd ea 39 JSR LB26D SYNTAX CHECK FOR COMMA
2415 eea3 8d 2d BSR LB70B EVALUATE NUMERIC EXPRESSION (LENGTH)
2416 eea5 8d 15 LB6DE BSR LB6F5 GET ARGUMENTS FROM STACK
2417 eea7 27 24 BEQ LB706 FC' ERROR IF NULL STRING
2418 eea9 5f CLRB CLEAR LENGTH COUNTER (DEFAULT VALUE)
2419 eeaa 4a DECA *SUOTRACT ONE FROM POSITION PARAMETER (THESE
2420 eeab a1 84 CMPA ,X *ROUTINES EXPECT 1ST POSITION TO BE ZERO, NOT ONE)
2421 * *AND COMPARE IT TO LENGTH OF OLD STRING
2422 eead 24 cd BCC LB6B5 IF POSITION > LENGTH OF OLD STRING, THEN NEW
2423 * STRING WILL BE A NULL STRING
2424 eeaf 1f 89 TFR A,B SAVE ABSOLUTE POSITION PARAMETER IN ACCB
2425 eeb1 e0 84 SUBB ,X ACCB=POSITION-LENGTH OF OLD STRING
2426 eeb3 50 NEGB NOW ACCB=LENGTH OF OLDSTRING-POSITION
2427 eeb4 d1 53 CMPB FPA0+3 *IF THE AMOUNT OF OLD STRING TO THE RIGHT OF
2428 eeb6 23 c4 BLS LB6B5 *POSITION IS <= THE LENGTH PARAMETER, BRANCH AND
2429 * USE ALL OF THE STRING TO THE RIGHT OF THE POSITION
2430 * INSTEAD OF THE LENGTH PARAMETER
2431 eeb8 d6 53 LDB FPA0+3 GET LENGTH OF NEW STRING
2432 eeba 20 c0 BRA LB6B5 PUT NEW STRING IN STRING SPACE
2433 * DO A SYNTAX CHECK FOR ")", THEN PULL THE PREVIOUSLY CALCULATED NUMERIC
2434 * ARGUMENT (ACCD) AND STRING ARGUMENT DESCRIPTOR ADDR OFF OF THE STACK
2435 eebc bd ea 33 LB6F5 JSR LB267 SYNTAX CHECK FOR A ")"
2436 eebf ee e4 LDU ,S LOAD THE RETURN ADDRESS INTO U REGISTER
2437 eec1 ae 65 LDX 5,S * GET ADDRESS OF STRING AND
2438 eec3 9f 4d STX V4D * SAVE IT IN V4D
2439 eec5 a6 64 LDA 4,S = PUT LENGTH OF STRING IN
2440 eec7 e6 64 LDB 4,S = BOTH ACCA AND ACCB
2441 eec9 32 67 LEAS 7,S REMOVE DESCRIPTOR AND RETURN ADDRESS FROM STACK
2442 eecb 1f 35 TFR U,PC JUMP TO ADDRESS IN U REGISTER
2443 eecd 7e ec 11 LB706 JMP LB44A ILLEGAL FUNCTION CALL'
2444 * EVALUATE AN EXPRESSION - RETURN AN INTEGER IN
2445 * ACCB - 'FC' ERROR IF EXPRESSION > 255
2446 eed0 9d 7c LB709 JSR GETNCH GET NEXT BASIC INPUT CHARACTER
2447 eed2 bd e9 0d LB70B JSR LB141 EVALUATE A NUMERIC EXPRESSION
2448 eed5 bd eb b0 LB70E JSR LB3E9 CONVERT FPA0 TO INTEGER IN ACCD
2449 eed8 4d TSTA TEST MS BYTE OF INTEGER
2450 eed9 26 f2 BNE LB706 FC' ERROR IF EXPRESSION > 255
2451 eedb 0e 82 JMP GETCCH GET CURRENT INPUT CHARACTER FROM BASIC
2452
2453 * VAL
2454 eedd bd ee 4d VAL JSR LB686 POINT X TO STRING ADDRESS
2455 eee0 10 27 02 de LBEQ LBA39 IF NULL STRING SET FPA0
2456 eee4 de 83 LDU CHARAD SAVE INPUT POINTER IN REGISTER U
2457 eee6 9f 83 STX CHARAD POINT INPUT POINTER TO ADDRESS OF STRING
2458 eee8 3a ABX MOVE POINTER TO END OF STRING TERMINATOR
2459 eee9 a6 84 LDA ,X GET LAST BYTE OF STRING
2460 eeeb 34 52 PSHS U,X,A SAVE INPUT POINTER, STRING TERMINATOR
2461 * ADDRESS AND CHARACTER
2462 eeed 6f 84 CLR ,X CLEAR STRING TERMINATOR : FOR ASCII - FP CONVERSION
2463 eeef 9d 82 JSR GETCCH GET CURRENT CHARACTER FROM BASIC
2464 eef1 bd f4 9b JSR LBD12 CONVERT AN ASCII STRING TO FLOATING POINT
2465 eef4 35 52 PULS A,X,U RESTORE CHARACTERS AND POINTERS
2466 eef6 a7 84 STA ,X REPLACE STRING TERMINATOR
2467 eef8 df 83 STU CHARAD RESTORE INPUT CHARACTER
2468 eefa 39 RTS
2469
2470 eefb 8d 07 LB734 BSR LB73D * EVALUATE AN EXPRESSION, RETURN
2471 eefd 9f 2b STX BINVAL * THE VALUE IN X; STORE IT IN BINVAL
2472 eeff bd ea 39 LB738 JSR LB26D SYNTAX CHECK FOR A COMMA
2473 ef02 20 ce BRA LB70B EVALUATE EXPRESSION IN RANGE 0 <= X < 256
2474 * EVALUATE EXPRESSION : RETURN INTEGER PORTION IN X - 'FC' ERROR IF
2475
2476 ef04 bd e9 0d LB73D JSR LB141 EVALUATE NUMERIC EXPRESSION
2477 ef07 96 54 LB740 LDA FP0SGN GET SIGN OF FPA0 MANTISSA
2478 ef09 2b c2 BMI LB706 ILLEGAL FUNCTION CALL' IF NEGATIVE
2479 ef0b 96 4f LDA FP0EXP GET EXPONENT OF FPA0
2480 ef0d 81 90 CMPA #$90 COMPARE TO LARGEST POSITIVE INTEGER
2481 ef0f 22 bc BHI LB706 ILLEGAL FUNCTION CALL' IF TOO LARGE
2482 ef11 bd f4 51 JSR LBCC8 SHIFT BINARY POINT TO EXTREME RIGHT OF FPA0
2483 ef14 9e 52 LDX FPA0+2 LOAD X WITH LOWER TWO BYTES OF FPA0
2484 ef16 39 RTS
2485
2486 * PEEK
2487 ef17 8d ee PEEK BSR LB740 CONVERT FPA0 TO INTEGER IN REGISTER X
2488 ef19 e6 84 LDB ,X GET THE VALUE BEING 'PEEK'ED
2489 ef1b 7e ec ba JMP LB4F3 CONVERT ACCB INTO A FP NUMBER
2490
2491 * POKE
2492 ef1e 8d db POKE BSR LB734 EVALUATE 2 EXPRESSIONS
2493 ef20 9e 2b LDX BINVAL GET THE ADDRESS TO BE 'POKE'ED
2494 ef22 e7 84 STB ,X STORE THE DATA IN THAT ADDRESS
2495 ef24 39 RTS
2496
2497
2498 * LIST
2499 ef25 34 01 LIST PSHS CC SAVE ZERO FLAG ON STACK
2500 ef27 bd e7 57 JSR LAF67 CONVERT DECIMAL LINE NUMBER TO BINARY
2501 ef2a bd e4 e5 JSR LAD01 * FIND RAM ADDRESS OF THAT LINE NUMBER AND
2502 ef2d 9f 66 STX LSTTXT * SAVE IT IN LSTTXT
2503 ef2f 35 01 PULS CC GET ZERO FLAG FROM STACK
2504 ef31 27 12 BEQ LB784 BRANCH IF END OF LINE
2505 ef33 9d 82 JSR GETCCH GET CURRENT CHARACTER FROM BASIC
2506 ef35 27 13 BEQ LB789 BRANCH IF END OF LINE
2507 ef37 81 a7 CMPA #TOK_MINUS MINUS TOKEN (IS IT A RANGE OF LINE NUMBERS?)
2508 ef39 26 09 BNE LB783 NO - RETURN
2509 ef3b 9d 7c JSR GETNCH GET NEXT CHARACTER FROM BASIC
2510 ef3d 27 06 BEQ LB784 BRANCH IF END OF LINE
2511 ef3f bd e7 57 JSR LAF67 GET ENDING LINE NUMBER
2512 ef42 27 06 BEQ LB789 BRANCH IF LEGAL LINE NUMBER
2513 ef44 39 LB783 RTS
2514 * LIST THE ENTIRE PROGRAM
2515 ef45 ce ff ff LB784 LDU #$FFFF * SET THE DEFAULT ENDING LINE NUMBER
2516 ef48 df 2b STU BINVAL * TO $FFFF
2517 ef4a 32 62 LB789 LEAS 2,S PURGE RETURN ADDRESS FROM THE STACK
2518 ef4c 9e 66 LDX LSTTXT POINT X TO STARTING LINE ADDRESS
2519 ef4e bd f0 e9 LB78D JSR LB95C MOVE CURSOR TO START OF A NEW LINE
2520 ef51 bd e1 da JSR LA549 CHECK FOR A BREAK OR PAUSE
2521 ef54 ec 84 LDD ,X GET ADDRESS OF NEXT BASIC LINE
2522 ef56 26 03 BNE LB79F BRANCH IF NOT END OF PROGRAM
2523 LB797
2524 ef58 7e e4 65 JMP LAC73 RETURN TO BASIC<49>S MAIN INPUT LOOP
2525 ef5b 9f 66 LB79F STX LSTTXT SAVE NEW STARTING LINE ADDRESS
2526 ef5d ec 02 LDD 2,X * GET THE LINE NUMBER OF THIS LINE AND
2527 ef5f 10 93 2b CMPD BINVAL * COMPARE IT TO ENDING LINE NUMBER
2528 ef62 22 f4 BHI LB797 EXIT IF LINE NUMBER > ENDING LINE NUMBER
2529 ef64 bd f5 55 JSR LBDCC PRINT THE NUMBER IN ACCD ON SCREEN IN DECIMAL
2530 ef67 bd f1 35 JSR LB9AC SEND A SPACE TO CONSOLE OUT
2531 ef6a 9e 66 LDX LSTTXT GET RAM ADDRESS OF THIS LINE
2532 ef6c 8d 10 BSR LB7C2 UNCRUNCH A LINE
2533 ef6e ae 9f 00 66 LDX [LSTTXT] POINT X TO START OF NEXT LINE
2534 ef72 ce 00 f4 LDU #LINBUF+1 POINT U TO BUFFER FULL OF UNCRUNCHED LINE
2535 ef75 a6 c0 LB7B9 LDA ,U+ GET A BYTE FROM THE BUFFER
2536 ef77 27 d5 BEQ LB78D BRANCH IF END OF BUFFER
2537 ef79 bd f1 3a JSR LB9B1 SEND CHARACTER TO CONSOLE OUT
2538 ef7c 20 f7 BRA LB7B9 GET ANOTHER CHARACTER
2539
2540 * UNCRUNCH A LINE INTO BASIC<49>S LINE INPUT BUFFER
2541 ef7e 30 04 LB7C2 LEAX 4,X MOVE POINTER PAST ADDRESS OF NEXT LINE AND LINE NUMBER
2542 ef80 10 8e 00 f4 LDY #LINBUF+1 UNCRUNCH LINE INTO LINE INPUT BUFFER
2543 ef84 a6 80 LB7CB LDA ,X+ GET A CHARACTER
2544 ef86 27 51 BEQ LB820 BRANCH IF END OF LINE
2545 ef88 2b 15 BMI LB7E6 BRANCH IF IT<49>S A TOKEN
2546 ef8a 81 3a CMPA #': CHECK FOR END OF SUB LINE
2547 ef8c 26 0d BNE LB7E2 BRNCH IF NOT END OF SUB LINE
2548 ef8e e6 84 LDB ,X GET CHARACTER FOLLOWING COLON
2549 ef90 c1 84 CMPB #TOK_ELSE TOKEN FOR ELSE?
2550 ef92 27 f0 BEQ LB7CB YES - DON<4F>T PUT IT IN BUFFER
2551 ef94 c1 83 CMPB #TOK_SNGL_Q TOKEN FOR REMARK?
2552 ef96 27 ec BEQ LB7CB YES - DON<4F>T PUT IT IN BUFFER
2553 ef98 8c FCB SKP2 SKIP TWO BYTES
2554 ef99 86 21 LB7E0 LDA #'! EXCLAMATION POINT
2555 ef9b 8d 30 LB7E2 BSR LB814 PUT CHARACTER IN BUFFER
2556 ef9d 20 e5 BRA LB7CB GET ANOTHER CHARACTER
2557
2558 ef9f ce e1 0b LB7E6 LDU #COMVEC-10 FIRST DO COMMANDS
2559 efa2 81 ff CMPA #$FF CHECK FOR SECONDARY TOKEN
2560 efa4 26 04 BNE LB7F1 BRANCH IF NON SECONDARY TOKEN
2561 efa6 a6 80 LDA ,X+ GET SECONDARY TOKEN
2562 efa8 33 45 LEAU 5,U BUMP IT UP TO SECONDARY FUNCTIONS
2563 efaa 84 7f LB7F1 ANDA #$7F MASK OFF BIT 7 OF TOKEN
2564 efac 33 4a LB7F3 LEAU 10,U MOVE TO NEXT COMMAND TABLE
2565 efae 6d c4 TST ,U IS THIS TABLE ENABLED?
2566 efb0 27 e7 BEQ LB7E0 NO - ILLEGAL TOKEN
2567 efb2 a0 c4 SUBA ,U SUBTRACT THE NUMBER OF TOKENS FROM THE CURRENT TOKEN NUMBER
2568 efb4 2a f6 BPL LB7F3 BRANCH IF TOKEN NOT IN THIS TABLE
2569 efb6 ab c4 ADDA ,U RESTORE TOKEN NUMBER RELATIVE TO THIS TABLE
2570 efb8 ee 41 LDU 1,U POINT U TO COMMAND DICTIONARY TABLE
2571 efba 4a LB801 DECA DECREMENT TOKEN NUMBER
2572 efbb 2b 06 BMI LB80A BRANCH IF THIS IS THE CORRECT TOKEN
2573 * SKIP THROUGH DICTIONARY TABLE TO START OF NEXT TOKEN
2574 efbd 6d c0 LB804 TST ,U+ GRAB A BYTE
2575 efbf 2a fc BPL LB804 BRANCH IF BIT 7 NOT SET
2576 efc1 20 f7 BRA LB801 GO SEE IF THIS IS THE CORRECT TOKEN
2577 efc3 a6 c4 LB80A LDA ,U GET A CHARACTER FROM DICTIONARY TABLE
2578 efc5 8d 06 BSR LB814 PUT CHARACTER IN BUFFER
2579 efc7 6d c0 TST ,U+ CHECK FOR START OF NEXT TOKEN
2580 efc9 2a f8 BPL LB80A BRANCH IF NOT DONE WITH THIS TOKEN
2581 efcb 20 b7 BRA LB7CB GO GET ANOTHER CHARACTER
2582 efcd 10 8c 01 ed LB814 CMPY #LINBUF+LBUFMX TEST FOR END OF LINE INPUT BUFFER
2583 efd1 24 06 BCC LB820 BRANCH IF AT END OF BUFFER
2584 efd3 84 7f ANDA #$7F MASK OFF BIT 7
2585 efd5 a7 a0 STA ,Y+ * SAVE CHARACTER IN BUFFER AND
2586 efd7 6f a4 CLR ,Y * CLEAR NEXT CHARACTER SLOT IN BUFFER
2587 efd9 39 LB820 RTS
2588 *
2589 * CRUNCH THE LINE THAT THE INPUT POINTER IS
2590 * POINTING TO INTO THE LINE INPUT BUFFER
2591 * RETURN LENGTH OF CRUNCHED LINE IN ACCD
2592 *
2593 efda 9e 83 LB821 LDX CHARAD GET BASIC'S INPUT POINTER ADDRESS
2594 efdc ce 00 f3 LDU #LINBUF POINT X TO LINE INPUT BUFFER
2595 efdf 0f 43 LB829 CLR V43 CLEAR ILLEGAL TOKEN FLAG
2596 efe1 0f 44 CLR V44 CLEAR DATA FLAG
2597 efe3 a6 80 LB82D LDA ,X+ GET INPUT CHAR
2598 efe5 27 21 BEQ LB852 BRANCH IF END OF LINE
2599 efe7 0d 43 TST V43 * CHECK ILLEGAL TOKEN FLAG & BRANCH IF NOT
2600 efe9 27 0f BEQ LB844 * PROCESSING AN ILLEGAL TOKEN
2601 efeb bd eb 69 JSR LB3A2 SET CARRY IF NOT UPPER CASE ALPHA
2602 efee 24 18 BCC LB852 BRANCH IF UPPER CASE ALPHA
2603 eff0 81 30 CMPA #'0 * DON<4F>T CRUNCH ASCII NUMERIC CHARACTERS
2604 eff2 25 04 BLO LB842 * BRANCH IF NOT NUMERIC
2605 eff4 81 39 CMPA #'9 *
2606 eff6 23 10 BLS LB852 * BRANCH IF NUMERIC
2607 * END UP HERE IF NOT UPPER CASE ALPHA OR NUMERIC
2608 eff8 0f 43 LB842 CLR V43 CLEAR ILLEGAL TOKEN FLAG
2609 effa 81 20 LB844 CMPA #SPACE SPACE?
2610 effc 27 0a BEQ LB852 DO NOT REMOVE SPACES
2611 effe 97 42 STA V42 SAVE INPUT CHARACTER AS SCAN DELIMITER
2612 f000 81 22 CMPA #'" CHECK FOR STRING DELIMITER
2613 f002 27 38 BEQ LB886 BRANCH IF STRING
2614 f004 0d 44 TST V44 * CHECK DATA FLAG AND BRANCH IF CLEAR
2615 f006 27 19 BEQ LB86B * DO NOT CRUNCH DATA
2616 f008 a7 c0 LB852 STA ,U+ SAVE CHARACTER IN BUFFER
2617 f00a 27 06 BEQ LB85C BRANCH IF END OF LINE
2618 f00c 81 3a CMPA #': * CHECK FOR END OF SUBLINE
2619 f00e 27 cf BEQ LB829 * AND RESET FLAGS IF END OF SUBLINE
2620 f010 20 d1 LB85A BRA LB82D GO GET ANOTHER CHARACTER
2621 f012 6f c0 LB85C CLR ,U+ * DOUBLE ZERO AT END OF LINE
2622 f014 6f c0 CLR ,U+ *
2623 f016 1f 30 TFR U,D SAVE ADDRESS OF END OF LINE IN ACCD
2624 f018 83 00 f1 SUBD #LINHDR LENGTH OF LINE IN ACCD
2625 f01b 8e 00 f2 LDX #LINBUF-1 * SET THE INPUT POINTER TO ONE BEFORE
2626 f01e 9f 83 STX CHARAD * THE START OF THE CRUNCHED LINE
2627 f020 39 RTS EXIT 'CRUNCH'
2628 f021 81 3f LB86B CMPA #'? CHECK FOR "?" - PRINT ABBREVIATION
2629 f023 26 04 BNE LB873 BRANCH IF NOT PRINT ABBREVIATION
2630 f025 86 87 LDA #TOK_PRINT * GET THE PRINT TOKEN AND SAVE IT
2631 f027 20 df BRA LB852 * IN BUFFER
2632 f029 81 27 LB873 CMPA #'' APOSTROPHE IS SAME AS REM
2633 f02b 26 13 BNE LB88A BRANCH IF NOT REMARK
2634 f02d cc 3a 83 LDD #$3A00+TOK_SNGL_Q COLON, REM TOKEN
2635 f030 ed c1 STD ,U++ SAVE IN BUFFER
2636 f032 0f 42 LB87C CLR V42 SET DELIMITER = 0 (END OF LINE)
2637 f034 a6 80 LB87E LDA ,X+ SCAN TILL WE MATCH [V42]
2638 f036 27 d0 BEQ LB852 BRANCH IF END OF LINE
2639 f038 91 42 CMPA V42 DELIMITER?
2640 f03a 27 cc BEQ LB852 BRANCH OUT IF SO
2641 f03c a7 c0 LB886 STA ,U+ DON<4F>T CRUNCH REMARKS OR STRINGS
2642 f03e 20 f4 BRA LB87E GO GET MORE STRING OR REMARK
2643 f040 81 30 LB88A CMPA #'0 * LESS THAN ASCII ZERO?
2644 f042 25 04 BCS LB892 * BRANCH IF SO
2645 f044 81 3c CMPA #';+1 = CHECK FOR NUMERIC VALUE, COLON OR SEMICOLON
2646 f046 25 c0 BCS LB852 = AND INSERT IN BUFFER IF SO
2647 f048 30 1f LB892 LEAX -1,X MOVE INPUT POINTER BACK ONE
2648 f04a 34 50 PSHS U,X SAVE POINTERS TO INPUT STRING, OUTPUT STRING
2649 f04c 0f 41 CLR V41 TOKEN FLAG 0 = COMMAND, FF = SECONDARY
2650 f04e ce e1 0b LDU #COMVEC-10 POINT U TO COMMAND INTERPRETATION
2651 * TABLE FOR BASIC - 10
2652 f051 0f 42 LB89B CLR V42 INITIALIZE V42 AS TOKEN COUNTER
2653 f053 33 4a LB89D LEAU 10,U MOVE TO NEXT COMMAND INTERPRETATION TABLE
2654 f055 a6 c4 LDA ,U GET NUMBER OF COMMANDS
2655 f057 27 31 BEQ LB8D4 GO DO SECONDARY FUNCTIONS IF NO COMMAND TABLE
2656 f059 10 ae 41 LDY 1,U POINT Y TO COMMAND DICTIONARY TABLE
2657 f05c ae e4 LB8A6 LDX ,S GET POINTER TO INPUT STRING
2658 f05e e6 a0 LB8A8 LDB ,Y+ GET A BYTE FROM DICTIONARY TABLE
2659 f060 e0 80 SUBB ,X+ SUBTRACT INPUT CHARACTER
2660 f062 27 fa BEQ LB8A8 LOOP IF SAME
2661 f064 c1 80 CMPB #$80 LAST CHAR IN RESERVED WORD TABLE HAD
2662 * BIT 7 SET, SO IF WE HAVE $80 HERE
2663 * THEN IT IS A GOOD COMPARE
2664 f066 26 38 BNE LB8EA BRANCH IF NO MATCH - CHECK ANOTHER COMMAND
2665 f068 32 62 LEAS 2,S DELETE OLD INPUT POINTER FROM STACK
2666 f06a 35 40 PULS U GET POINTER TO OUTPUT STRING
2667 f06c da 42 ORB V42 OR IN THE TABLE POSITION TO MAKE THE TOKEN
2668 * - NOTE THAT B ALREADY HAD $80 IN IT -
2669 f06e 96 41 LDA V41 * CHECK TOKEN FLAG AND BRANCH
2670 f070 26 06 BNE LB8C2 * IF SECONDARY
2671 f072 c1 84 CMPB #TOK_ELSE IS IT ELSE TOKEN?
2672 f074 26 06 BNE LB8C6 NO
2673 f076 86 3a LDA #': PUT A COLON (SUBLINE) BEFORE ELSE TOKEN
2674 f078 ed c1 LB8C2 STD ,U++ SECONDARY TOKENS PRECEEDED BY $FF
2675 f07a 20 94 BRA LB85A GO PROCESS MORE INPUT CHARACTERS
2676 f07c e7 c0 LB8C6 STB ,U+ SAVE THIS TOKEN
2677 f07e c1 86 CMPB #TOK_DATA DATA TOKEN?
2678 f080 26 02 BNE LB8CE NO
2679 f082 0c 44 INC V44 SET DATA FLAG
2680 f084 c1 82 LB8CE CMPB #TOK_REM REM TOKEN?
2681 f086 27 aa BEQ LB87C YES
2682 f088 20 86 LB8D2 BRA LB85A GO PROCESS MORE INPUT CHARACTERS
2683 * CHECK FOR A SECONDARY TOKEN
2684 f08a ce e1 10 LB8D4 LDU #COMVEC-5 NOW DO SECONDARY FUNCTIONS
2685 f08d 03 41 COM V41 TOGGLE THE TOKEN FLAG
2686 f08f 26 c0 BNE LB89B BRANCH IF NOW CHECKING SECONDARY COMMANDS
2687
2688 * THIS CODE WILL PROCESS INPUT DATA WHICH CANNOT BE CRUNCHED AND SO
2689 * IS ASSUMED TO BE ILLEGAL DATA OR AN ILLEGAL TOKEN
2690 f091 35 50 PULS X,U RESTORE INPUT AND OUTPUT POINTERS
2691 f093 a6 80 LDA ,X+ * MOVE THE FIRST CHARACTER OF AN
2692 f095 a7 c0 STA ,U+ * ILLEGAL TOKEN
2693 f097 bd eb 69 JSR LB3A2 SET CARRY IF NOT ALPHA
2694 f09a 25 ec BCS LB8D2 BRANCH IF NOT ALPHA
2695 f09c 03 43 COM V43 SET ILLEGAL TOKEN FLAG IF UPPER CASE ALPHA
2696 f09e 20 e8 BRA LB8D2 PROCESS MORE INPUT CHARACTERS
2697 f0a0 0c 42 LB8EA INC V42 INCREMENT TOKEN COUNTER
2698 f0a2 4a DECA DECR COMMAND COUNTER
2699 f0a3 27 ae BEQ LB89D GET ANOTHER COMMAND TABLE IF DONE W/THIS ONE
2700 f0a5 31 3f LEAY -1,Y MOVE POINTER BACK ONE
2701 f0a7 e6 a0 LB8F1 LDB ,Y+ * GET TO NEXT
2702 f0a9 2a fc BPL LB8F1 * RESERVED WORD
2703 f0ab 20 af BRA LB8A6 GO SEE IF THIS WORD IS A MATCH
2704
2705 * PRINT
2706 f0ad 27 36 PRINT BEQ LB958 BRANCH IF NO ARGUMENT
2707 f0af 8d 01 BSR LB8FE CHECK FOR ALL PRINT OPTIONS
2708 f0b1 39 RTS
2709 LB8FE
2710 f0b2 27 3e LB91B BEQ LB965 RETURN IF END OF LINE
2711 f0b4 81 9f LB91D CMPA #TOK_TAB TOKEN FOR TAB( ?
2712 f0b6 27 53 BEQ LB97E YES
2713 f0b8 81 2c CMPA #', COMMA?
2714 f0ba 27 37 BEQ LB966 YES - ADVANCE TO NEXT TAB FIELD
2715 f0bc 81 3b CMPA #'; SEMICOLON?
2716 f0be 27 60 BEQ LB997 YES - DO NOT ADVANCE CURSOR
2717 f0c0 bd e9 22 JSR LB156 EVALUATE EXPRESSION
2718 f0c3 96 06 LDA VALTYP * GET VARIABLE TYPE AND
2719 f0c5 34 02 PSHS A * SAVE IT ON THE STACK
2720 f0c7 26 06 BNE LB938 BRANCH IF STRING VARIABLE
2721 f0c9 bd f5 62 JSR LBDD9 CONVERT FP NUMBER TO AN ASCII STRING
2722 f0cc bd ec dd JSR LB516 PARSE A STRING FROM (X-1) AND PUT
2723 * DESCRIPTOR ON STRING STACK
2724 f0cf 8d 57 LB938 BSR LB99F PRINT STRING POINTED TO BY X
2725 f0d1 35 04 PULS B GET VARIABLE TYPE BACK
2726 f0d3 bd e1 73 JSR LA35F SET UP TAB WIDTH ZONE, ETC
2727 f0d6 5d LB949 TSTB CHECK CURRENT PRINT POSITION
2728 f0d7 26 08 BNE LB954 BRANCH IF NOT AT START OF LINE
2729 f0d9 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
2730 f0db 81 2c CMPA #', COMMA?
2731 f0dd 27 14 BEQ LB966 SKIP TO NEXT TAB FIELD
2732 f0df 8d 54 BSR LB9AC SEND A SPACE TO CONSOLE OUT
2733 f0e1 9d 82 LB954 JSR GETCCH GET CURRENT INPUT CHARACTER
2734 f0e3 26 cf BNE LB91D BRANCH IF NOT END OF LINE
2735 f0e5 86 0d LB958 LDA #CR * SEND A CR TO
2736 f0e7 20 51 BRA LB9B1 * CONSOLE OUT
2737 f0e9 bd e1 73 LB95C JSR LA35F SET UP TAB WIDTH, ZONE ETC
2738 f0ec 27 f7 BEQ LB958 BRANCH IF WIDTH = ZERO
2739 f0ee 96 6c LDA DEVPOS GET PRINT POSITION
2740 f0f0 26 f3 BNE LB958 BRANCH IF NOT AT START OF LINE
2741 f0f2 39 LB965 RTS
2742 * SKIP TO NEXT TAB FIELD
2743 f0f3 bd e1 73 LB966 JSR LA35F SET UP TAB WIDTH, ZONE ETC
2744 f0f6 27 0a BEQ LB975 BRANCH IF LINE WIDTH = 0 (CASSETTE)
2745 f0f8 d6 6c LDB DEVPOS GET CURRENT POSITION
2746 f0fa d1 6b CMPB DEVLCF COMPARE TO LAST TAB ZONE
2747 f0fc 25 06 BCS LB977 BRANCH IF < LAST TAB ZONE
2748 f0fe 8d e5 BSR LB958 SEND A CARRIAGE RETURN TO CONSOLE OUT
2749 f100 20 1e BRA LB997 GET MORE DATA
2750 f102 d6 6c LB975 LDB DEVPOS *
2751 f104 d0 6a LB977 SUBB DEVCFW * SUBTRACT TAB FIELD WIDTH FROM CURRENT
2752 f106 24 fc BCC LB977 * POSITION UNTIL CARRY SET - NEGATING THE
2753 f108 50 NEGB * REMAINDER LEAVES THE NUMBER OF SPACES TO NEXT
2754 * * TAB ZONE IN ACCB
2755 f109 20 10 BRA LB98E GO ADVANCE TO NEXT TAB ZONE
2756
2757 * PRINT TAB(
2758 f10b bd ee d0 LB97E JSR LB709 EVALUATE EXPRESSION - RETURN VALUE IN B
2759 f10e 81 29 CMPA #') * 'SYNTAX' ERROR IF NOT ')'
2760 f110 10 26 f9 2f LBNE LB277 *
2761 f114 bd e1 73 JSR LA35F SET UP TAB WIDTH, ZONE ETC
2762 f117 d0 6c SUBB DEVPOS GET DIFFERENCE OF PRINT POSITION & TAB POSITION
2763 f119 23 05 BLS LB997 BRANCH IF TAB POSITION < CURRENT POSITION
2764 LB98E
2765 f11b 8d 18 LB992 BSR LB9AC SEND A SPACE TO CONSOLE OUT
2766 f11d 5a DECB DECREMENT DIFFERENCE COUNT
2767 f11e 26 fb BNE LB992 BRANCH UNTIL CURRENT POSITION = TAB POSITION
2768 f120 9d 7c LB997 JSR GETNCH GET NEXT CHARACTER FROM BASIC
2769 f122 7e f0 b2 JMP LB91B LOOK FOR MORE PRINT DATA
2770 * COPY A STRING FROM (X) TO CONSOLE OUT
2771 f125 bd ec df LB99C JSR LB518 PARSE A STRING FROM X AND PUT
2772 * DESCRIPTOR ON STRING STACK
2773 f128 bd ee 1e LB99F JSR LB657 GET LENGTH OF STRING AND REMOVE
2774 * DESCRIPTOR FROM STRING STACK
2775 f12b 5c INCB COMPENSATE FOR DECB BELOW
2776 f12c 5a LB9A3 DECB DECREMENT COUNTER
2777 f12d 27 c3 BEQ LB965 EXIT ROUTINE
2778 f12f a6 80 LDA ,X+ GET A CHARACTER FROM X
2779 f131 8d 07 BSR LB9B1 SEND TO CONSOLE OUT
2780 f133 20 f7 BRA LB9A3 KEEP LOOPING
2781 f135 86 20 LB9AC LDA #SPACE SPACE TO CONSOLE OUT
2782 f137 8c FCB SKP2 SKIP NEXT TWO BYTES
2783 f138 86 3f LB9AF LDA #'? QUESTION MARK TO CONSOLE OUT
2784 f13a 7e e0 14 LB9B1 JMP PUTCHR JUMP TO CONSOLE OUT
2785
2786 * FLOATING POINT MATH PACKAGE
2787
2788 * ADD .5 TO FPA0
2789 f13d 8e f6 49 LB9B4 LDX #LBEC0 FLOATING POINT CONSTANT (.5)
2790 f140 20 09 BRA LB9C2 ADD .5 TO FPA0
2791 * SUBTRACT FPA0 FROM FP NUMBER POINTED
2792 * TO BY (X), LEAVE RESULT IN FPA0
2793 f142 bd f2 b8 LB9B9 JSR LBB2F COPY PACKED FP DATA FROM (X) TO FPA1
2794
2795 * ARITHMETIC OPERATION (-) JUMPS HERE - SUBTRACT FPA0 FROM FPA1 (ENTER
2796 * WITH EXPONENT OF FPA0 IN ACCB AND EXPONENT OF FPA1 IN ACCA)
2797 f145 03 54 LB9BC COM FP0SGN CHANGE MANTISSA SIGN OF FPA0
2798 f147 03 62 COM RESSGN REVERSE RESULT SIGN FLAG
2799 f149 20 03 BRA LB9C5 GO ADD FPA1 AND FPA0
2800 * ADD FP NUMBER POINTED TO BY
2801 * (X) TO FPA0 - LEAVE RESULT IN FPA0
2802 f14b bd f2 b8 LB9C2 JSR LBB2F UNPACK PACKED FP DATA FROM (X) TO
2803 * FPA1; RETURN EXPONENT OF FPA1 IN ACCA
2804
2805 * ARITHMETIC OPERATION (+) JUMPS HERE - ADD FPA0 TO
2806
2807 f14e 5d LB9C5 TSTB CHECK EXPONENT OF FPA0
2808 f14f 10 27 02 80 LBEQ LBC4A COPY FPA1 TO FPA0 IF FPA0 =
2809 f153 8e 00 5c LDX #FP1EXP POINT X TO FPA1
2810 f156 1f 89 LB9CD TFR A,B PUT EXPONENT OF FPA1 INTO ACCB
2811 f158 5d TSTB CHECK EXPONENT
2812 f159 27 6c BEQ LBA3E RETURN IF EXPONENT = 0 (ADDING 0 TO FPA0)
2813 f15b d0 4f SUBB FP0EXP SUBTRACT EXPONENT OF FPA0 FROM EXPONENT OF FPA1
2814 f15d 27 69 BEQ LBA3F BRANCH IF EXPONENTS ARE EQUAL
2815 f15f 25 0a BCS LB9E2 BRANCH IF EXPONENT FPA0 > FPA1
2816 f161 97 4f STA FP0EXP REPLACE FPA0 EXPONENT WITH FPA1 EXPONENT
2817 f163 96 61 LDA FP1SGN * REPLACE FPA0 MANTISSA SIGN
2818 f165 97 54 STA FP0SGN * WITH FPA1 MANTISSA SIGN
2819 f167 8e 00 4f LDX #FP0EXP POINT X TO FPA0
2820 f16a 50 NEGB NEGATE DIFFERENCE OF EXPONENTS
2821 f16b c1 f8 LB9E2 CMPB #-8 TEST DIFFERENCE OF EXPONENTS
2822 f16d 2f 59 BLE LBA3F BRANCH IF DIFFERENCE OF EXPONENTS <= 8
2823 f16f 4f CLRA CLEAR OVERFLOW BYTE
2824 f170 64 01 LSR 1,X SHIFT MS BYTE OF MANTISSA; BIT 7 = 0
2825 f172 bd f2 43 JSR LBABA GO SHIFT MANTISSA OF (X) TO THE RIGHT (B) TIMES
2826 f175 d6 62 LB9EC LDB RESSGN GET SIGN FLAG
2827 f177 2a 0b BPL LB9FB BRANCH IF FPA0 AND FPA1 SIGNS ARE THE SAME
2828 f179 63 01 COM 1,X * COMPLEMENT MANTISSA POINTED
2829 f17b 63 02 COM 2,X * TO BY (X) THE
2830 f17d 63 03 COM 3,X * ADCA BELOW WILL
2831 f17f 63 04 COM 4,X * CONVERT THIS OPERATION
2832 f181 43 COMA * INTO A NEG (MANTISSA)
2833 f182 89 00 ADCA #0 ADD ONE TO ACCA - COMA ALWAYS SETS THE CARRY FLAG
2834 * THE PREVIOUS TWO BYTES MAY BE REPLACED BY A NEGA
2835 *
2836 * ADD MANTISSAS OF FPA0 AND FPA1, PUT RESULT IN FPA0
2837 f184 97 63 LB9FB STA FPSBYT SAVE FPA SUB BYTE
2838 f186 96 53 LDA FPA0+3 * ADD LS BYTE
2839 f188 99 60 ADCA FPA1+3 * OF MANTISSA
2840 f18a 97 53 STA FPA0+3 SAVE IN FPA0 LSB
2841 f18c 96 52 LDA FPA0+2 * ADD NEXT BYTE
2842 f18e 99 5f ADCA FPA1+2 * OF MANTISSA
2843 f190 97 52 STA FPA0+2 SAVE IN FPA0
2844 f192 96 51 LDA FPA0+1 * ADD NEXT BYTE
2845 f194 99 5e ADCA FPA1+1 * OF MANTISSA
2846 f196 97 51 STA FPA0+1 SAVE IN FPA0
2847 f198 96 50 LDA FPA0 * ADD MS BYTE
2848 f19a 99 5d ADCA FPA1 * OF MANTISSA
2849 f19c 97 50 STA FPA0 SAVE IN FPA0
2850 f19e 5d TSTB TEST SIGN FLAG
2851 f19f 2a 44 BPL LBA5C BRANCH IF FPA0 & FPA1 SIGNS WERE ALIKE
2852 f1a1 25 02 LBA18 BCS LBA1C BRANCH IF POSITIVE MANTISSA
2853 f1a3 8d 5d BSR LBA79 NEGATE FPA0 MANTISSA
2854
2855 * NORMALIZE FPA0
2856 f1a5 5f LBA1C CLRB CLEAR TEMPORARY EXPONENT ACCUMULATOR
2857 f1a6 96 50 LBA1D LDA FPA0 TEST MSB OF MANTISSA
2858 f1a8 26 2e BNE LBA4F BRANCH IF <> 0
2859 f1aa 96 51 LDA FPA0+1 * IF THE MSB IS
2860 f1ac 97 50 STA FPA0 * 0, THEN SHIFT THE
2861 f1ae 96 52 LDA FPA0+2 * MANTISSA A WHOLE BYTE
2862 f1b0 97 51 STA FPA0+1 * AT A TIME. THIS
2863 f1b2 96 53 LDA FPA0+3 * IS FASTER THAN ONE
2864 f1b4 97 52 STA FPA0+2 * BIT AT A TIME
2865 f1b6 96 63 LDA FPSBYT * BUT USES MORE MEMORY.
2866 f1b8 97 53 STA FPA0+3 * FPSBYT, THE CARRY IN
2867 f1ba 0f 63 CLR FPSBYT * BYTE, REPLACES THE MATISSA LSB.
2868 f1bc cb 08 ADDB #8 SHIFTING ONE BYTE = 8 BIT SHIFTS; ADD 8 TO EXPONENT
2869 f1be c1 28 CMPB #5*8 CHECK FOR 5 SHIFTS
2870 f1c0 2d e4 BLT LBA1D BRANCH IF < 5 SHIFTS, IF > 5, THEN MANTISSA = 0
2871 f1c2 4f LBA39 CLRA A ZERO EXPONENT = 0 FLOATING POINT
2872 f1c3 97 4f LBA3A STA FP0EXP ZERO OUT THE EXPONENT
2873 f1c5 97 54 STA FP0SGN ZERO OUT THE MANTISSA SIGN
2874 f1c7 39 LBA3E RTS
2875 f1c8 8d 6d LBA3F BSR LBAAE SHIFT FPA0 MANTISSA TO RIGHT
2876 f1ca 5f CLRB CLEAR CARRY FLAG
2877 f1cb 20 a8 BRA LB9EC
2878 * SHIFT FPA0 LEFT ONE BIT UNTIL BIT 7
2879 * OF MATISSA MS BYTE = 1
2880 f1cd 5c LBA44 INCB ADD ONE TO EXPONENT ACCUMULATOR
2881 f1ce 08 63 ASL FPSBYT SHIFT SUB BYTE ONE LEFT
2882 f1d0 09 53 ROL FPA0+3 SHIFT LS BYTE
2883 f1d2 09 52 ROL FPA0+2 SHIFT NS BYTE
2884 f1d4 09 51 ROL FPA0+1 SHIFT NS BYTE
2885 f1d6 09 50 ROL FPA0 SHIFT MS BYTE
2886 f1d8 2a f3 LBA4F BPL LBA44 BRANCH IF NOT YET NORMALIZED
2887 f1da 96 4f LDA FP0EXP GET CURRENT EXPONENT
2888 f1dc 34 04 PSHS B SAVE EXPONENT MODIFIER CAUSED BY NORMALIZATION
2889 f1de a0 e0 SUBA ,S+ SUBTRACT ACCUMULATED EXPONENT MODIFIER
2890 f1e0 97 4f STA FP0EXP SAVE AS NEW EXPONENT
2891 f1e2 23 de BLS LBA39 SET FPA0 = 0 IF THE NORMALIZATION CAUSED
2892 * MORE OR EQUAL NUMBER OF LEFT SHIFTS THAN THE
2893 * SIZE OF THE EXPONENT
2894 f1e4 8c FCB SKP2 SKIP 2 BYTES
2895 f1e5 25 08 LBA5C BCS LBA66 BRANCH IF MANTISSA OVERFLOW
2896 f1e7 08 63 ASL FPSBYT SUB BYTE BIT 7 TO CARRY - USE AS ROUND-OFF
2897 * FLAG (TRUNCATE THE REST OF SUB BYTE)
2898 f1e9 86 00 LDA #0 CLRA, BUT DO NOT CHANGE CARRY FLAG
2899 f1eb 97 63 STA FPSBYT CLEAR THE SUB BYTE
2900 f1ed 20 0c BRA LBA72 GO ROUND-OFF RESULT
2901 f1ef 0c 4f LBA66 INC FP0EXP INCREMENT EXPONENT - MULTIPLY BY 2
2902 f1f1 27 28 BEQ LBA92 OVERFLOW ERROR IF CARRY PAST $FF
2903 f1f3 06 50 ROR FPA0 * SHIFT MANTISSA
2904 f1f5 06 51 ROR FPA0+1 * ONE TO
2905 f1f7 06 52 ROR FPA0+2 * THE RIGHT -
2906 f1f9 06 53 ROR FPA0+3 * DIVIDE BY TWO
2907 f1fb 24 04 LBA72 BCC LBA78 BRANCH IF NO ROUND-OFF NEEDED
2908 f1fd 8d 0d BSR LBA83 ADD ONE TO MANTISSA - ROUND OFF
2909 f1ff 27 ee BEQ LBA66 BRANCH iF OVERFLOW - MANTISSA = 0
2910 f201 39 LBA78 RTS
2911 * NEGATE FPA0 MANTISSA
2912 f202 03 54 LBA79 COM FP0SGN TOGGLE SIGN OF MANTISSA
2913 f204 03 50 LBA7B COM FPA0 * COMPLEMENT ALL 4 MANTISSA BYTES
2914 f206 03 51 COM FPA0+1 *
2915 f208 03 52 COM FPA0+2 *
2916 f20a 03 53 COM FPA0+3 *
2917 * ADD ONE TO FPA0 MANTISSA
2918 f20c 9e 52 LBA83 LDX FPA0+2 * GET BOTTOM 2 MANTISSA
2919 f20e 30 01 LEAX 1,X * BYTES, ADD ONE TO
2920 f210 9f 52 STX FPA0+2 * THEM AND SAVE THEM
2921 f212 26 06 BNE LBA91 BRANCH IF NO OVERFLOW
2922 f214 9e 50 LDX FPA0 * IF OVERFLOW ADD ONE
2923 f216 30 01 LEAX 1,X * TO TOP 2 MANTISSA
2924 f218 9f 50 STX FPA0 * BYTES AND SAVE THEM
2925 f21a 39 LBA91 RTS
2926 f21b c6 0a LBA92 LDB #2*5 OV' OVERFLOW ERROR
2927 f21d 7e e4 46 JMP LAC46 PROCESS AN ERROR
2928 f220 8e 00 12 LBA97 LDX #FPA2-1 POINT X TO FPA2
2929 * SHIFT FPA POINTED TO BY (X) TO
2930 * THE RIGHT -(B) TIMES. EXIT WITH
2931 * ACCA CONTAINING DATA SHIFTED OUT
2932 * TO THE RIGHT (SUB BYTE) AND THE DATA
2933 * SHIFTED IN FROM THE LEFT WILL COME FROM FPCARY
2934 f223 a6 04 LBA9A LDA 4,X GET LS BYTE OF MANTISSA (X)
2935 f225 97 63 STA FPSBYT SAVE IN FPA SUB BYTE
2936 f227 a6 03 LDA 3,X * SHIFT THE NEXT THREE BYTES OF THE
2937 f229 a7 04 STA 4,X * MANTISSA RIGHT ONE COMPLETE BYTE.
2938 f22b a6 02 LDA 2,X *
2939 f22d a7 03 STA 3,X *
2940 f22f a6 01 LDA 1,X *
2941 f231 a7 02 STA 2,X *
2942 f233 96 5b LDA FPCARY GET THE CARRY IN BYTE
2943 f235 a7 01 STA 1,X STORE AS THE MS MANTISSA BYTE OF (X)
2944 f237 cb 08 LBAAE ADDB #8 ADD 8 TO DIFFERENCE OF EXPONENTS
2945 f239 2f e8 BLE LBA9A BRANCH IF EXPONENT DIFFERENCE < -8
2946 f23b 96 63 LDA FPSBYT GET FPA SUB BYTE
2947 f23d c0 08 SUBB #8 CAST OUT THE 8 ADDED IN ABOVE
2948 f23f 27 0c BEQ LBAC4 BRANCH IF EXPONENT DIFFERENCE = 0
2949
2950
2951 f241 67 01 LBAB8 ASR 1,X * SHIFT MANTISSA AND SUB BYTE ONE BIT TO THE RIGHT
2952 f243 66 02 LBABA ROR 2,X *
2953 f245 66 03 ROR 3,X *
2954 f247 66 04 ROR 4,X *
2955 f249 46 RORA *
2956 f24a 5c INCB ADD ONE TO EXPONENT DIFFERENCE
2957 f24b 26 f4 BNE LBAB8 BRANCH IF EXPONENTS NOT =
2958 f24d 39 LBAC4 RTS
2959 f24e 81 00 00 00 00 LBAC5 FCB $81,$00,$00,$00,$00 FLOATING POINT CONSTANT 1.0
2960
2961 * ARITHMETIC OPERATION (*) JUMPS HERE - MULTIPLY
2962 * FPA0 BY (X) - RETURN PRODUCT IN FPA0
2963 f253 8d 63 LBACA BSR LBB2F MOVE PACKED FPA FROM (X) TO FPA1
2964 f255 27 60 LBACC BEQ LBB2E BRANCH IF EXPONENT OF FPA0 = 0
2965 f257 8d 78 BSR LBB48 CALCULATE EXPONENT OF PRODUCT
2966 * MULTIPLY FPA0 MANTISSA BY FPA1. NORMALIZE
2967 * HIGH ORDER BYTES OF PRODUCT IN FPA0. THE
2968 * LOW ORDER FOUR BYTES OF THE PRODUCT WILL
2969 * BE STORED IN VAB-VAE.
2970 f259 86 00 LBAD0 LDA #0 * ZERO OUT MANTISSA OF FPA2
2971 f25b 97 13 STA FPA2 *
2972 f25d 97 14 STA FPA2+1 *
2973 f25f 97 15 STA FPA2+2 *
2974 f261 97 16 STA FPA2+3 *
2975 f263 d6 53 LDB FPA0+3 GET LS BYTE OF FPA0
2976 f265 8d 22 BSR LBB00 MULTIPLY BY FPA1
2977 f267 d6 63 LDB FPSBYT * TEMPORARILY SAVE SUB BYTE 4
2978 f269 d7 8b STB VAE *
2979 f26b d6 52 LDB FPA0+2 GET NUMBER 3 MANTISSA BYTE OF FPA0
2980 f26d 8d 1a BSR LBB00 MULTIPLY BY FPA1
2981 f26f d6 63 LDB FPSBYT * TEMPORARILY SAVE SUB BYTE 3
2982 f271 d7 8a STB VAD *
2983 f273 d6 51 LDB FPA0+1 GET NUMBER 2 MANTISSA BYTE OF FPA0
2984 f275 8d 12 BSR LBB00 MULTIPLY BY FPA1
2985 f277 d6 63 LDB FPSBYT * TEMPORARILY SAVE SUB BYTE 2
2986 f279 d7 89 STB VAC *
2987 f27b d6 50 LDB FPA0 GET MS BYTE OF FPA0 MANTISSA
2988 f27d 8d 0c BSR LBB02 MULTIPLY BY FPA1
2989 f27f d6 63 LDB FPSBYT * TEMPORARILY SAVE SUB BYTE 1
2990 f281 d7 88 STB VAB *
2991 f283 bd f3 94 JSR LBC0B COPY MANTISSA FROM FPA2 TO FPA0
2992 f286 7e f1 a5 JMP LBA1C NORMALIZE FPA0
2993 f289 27 95 LBB00 BEQ LBA97 SHIFT FPA2 ONE BYTE TO RIGHT
2994 f28b 43 LBB02 COMA SET CARRY FLAG
2995 * MULTIPLY FPA1 MANTISSA BY ACCB AND
2996 * ADD PRODUCT TO FPA2 MANTISSA
2997 f28c 96 13 LBB03 LDA FPA2 GET FPA2 MS BYTE
2998 f28e 56 RORB ROTATE CARRY FLAG INTO SHIFT COUNTER;
2999 * DATA BIT INTO CARRY
3000 f28f 27 26 BEQ LBB2E BRANCH WHEN 8 SHIFTS DONE
3001 f291 24 16 BCC LBB20 DO NOT ADD FPA1 IF DATA BIT = 0
3002 f293 96 16 LDA FPA2+3 * ADD MANTISSA LS BYTE
3003 f295 9b 60 ADDA FPA1+3 *
3004 f297 97 16 STA FPA2+3 *
3005 f299 96 15 LDA FPA2+2 = ADD MANTISSA NUMBER 3 BYTE
3006 f29b 99 5f ADCA FPA1+2 =
3007 f29d 97 15 STA FPA2+2 =
3008 f29f 96 14 LDA FPA2+1 * ADD MANTISSA NUMBER 2 BYTE
3009 f2a1 99 5e ADCA FPA1+1 *
3010 f2a3 97 14 STA FPA2+1 *
3011 f2a5 96 13 LDA FPA2 = ADD MANTISSA MS BYTE
3012 f2a7 99 5d ADCA FPA1 =
3013 f2a9 46 LBB20 RORA * ROTATE CARRY INTO MS BYTE
3014 f2aa 97 13 STA FPA2 *
3015 f2ac 06 14 ROR FPA2+1 = ROTATE FPA2 ONE BIT TO THE RIGHT
3016 f2ae 06 15 ROR FPA2+2 =
3017 f2b0 06 16 ROR FPA2+3 =
3018 f2b2 06 63 ROR FPSBYT =
3019 f2b4 4f CLRA CLEAR CARRY FLAG
3020 f2b5 20 d5 BRA LBB03 KEEP LOOPING
3021 f2b7 39 LBB2E RTS
3022 * UNPACK A FP NUMBER FROM (X) TO FPA1
3023 f2b8 ec 01 LBB2F LDD 1,X GET TWO MSB BYTES OF MANTISSA FROM
3024 * FPA POINTED TO BY X
3025 f2ba 97 61 STA FP1SGN SAVE PACKED MANTISSA SIGN BYTE
3026 f2bc 8a 80 ORA #$80 FORCE BIT 7 OF MSB MANTISSA = 1
3027 f2be dd 5d STD FPA1 SAVE 2 MSB BYTES IN FPA1
3028 f2c0 d6 61 LDB FP1SGN * GET PACKED MANTISSA SIGN BYTE. EOR W/FPA0
3029 f2c2 d8 54 EORB FP0SGN * SIGN - NEW SIGN POSITION IF BOTH OLD SIGNS ALIKE,
3030 f2c4 d7 62 STB RESSGN * NEG IF BOTH OLD SIGNS DIFF. SAVE ADJUSTED
3031 * * MANTISSA SIGN BYTE
3032 f2c6 ec 03 LDD 3,X = GET 2 LSB BYTES OF MANTISSA
3033 f2c8 dd 5f STD FPA1+2 = AND PUT IN FPA1
3034 f2ca a6 84 LDA ,X * GET EXPONENT FROM (X) AND
3035 f2cc 97 5c STA FP1EXP * PUT IN EXPONENT OF FPA1
3036 f2ce d6 4f LDB FP0EXP GET EXPONENT OF FPA0
3037 f2d0 39 RTS
3038 * CALCULATE EXPONENT FOR PRODUCT OF FPA0 & FPA1
3039 * ENTER WITH EXPONENT OF FPA1 IN ACCA
3040 f2d1 4d LBB48 TSTA TEST EXPONENT OF FPA1
3041 f2d2 27 16 BEQ LBB61 PURGE RETURN ADDRESS & SET FPA0 = 0
3042 f2d4 9b 4f ADDA FP0EXP ADD FPA1 EXPONENT TO FPA0 EXPONENT
3043 f2d6 46 RORA ROTATE CARRY INTO BIT 7; BIT 0 INTO CARRY
3044 f2d7 49 ROLA SET OVERFLOW FLAG
3045 f2d8 28 10 BVC LBB61 BRANCH IF EXPONENT TOO LARGE OR SMALL
3046 f2da 8b 80 ADDA #$80 ADD $80 BIAS TO EXPONENT
3047 f2dc 97 4f STA FP0EXP SAVE NEW EXPONENT
3048 f2de 27 0c BEQ LBB63 SET FPA0
3049 f2e0 96 62 LDA RESSGN GET MANTISSA SIGN
3050 f2e2 97 54 STA FP0SGN SAVE AS MANTISSA SIGN OF FPA0
3051 f2e4 39 RTS
3052 * IF FPA0 = POSITIVE THEN 'OV' ERROR IF FPA0
3053 * = IS NEGATIVE THEN FPA0 = 0
3054 f2e5 96 54 LBB5C LDA FP0SGN GET MANTISSA SIGN OF FPA0
3055 f2e7 43 COMA CHANGE SIGN OF FPA0 MANTISSA
3056 f2e8 20 02 BRA LBB63
3057 f2ea 32 62 LBB61 LEAS 2,S PURGE RETURN ADDRESS FROM STACK
3058 f2ec 10 2a fe d2 LBB63 LBPL LBA39 ZERO FPA0 MANTISSA SIGN & EXPONENT
3059 f2f0 7e f2 1b LBB67 JMP LBA92 OV' OVERFLOW ERROR
3060 * FAST MULTIPLY BY 10 AND LEAVE RESULT IN FPA0
3061 f2f3 bd f3 e8 LBB6A JSR LBC5F TRANSFER FPA0 TO FPA1
3062 f2f6 27 0d BEQ LBB7C BRANCH IF EXPONENT = 0
3063 f2f8 8b 02 ADDA #2 ADD 2 TO EXPONENT (TIMES 4)
3064 f2fa 25 f4 BCS LBB67 OV' ERROR IF EXPONENT > $FF
3065 f2fc 0f 62 CLR RESSGN CLEAR RESULT SIGN BYTE
3066 f2fe bd f1 56 JSR LB9CD ADD FPA1 TO FPA0 (TIMES 5)
3067 f301 0c 4f INC FP0EXP ADD ONE TO EXPONENT (TIMES 10)
3068 f303 27 eb BEQ LBB67 OV' ERROR IF EXPONENT > $FF
3069 f305 39 LBB7C RTS
3070 f306 84 20 00 00 00 LBB7D FCB $84,$20,$00,$00,$00 FLOATING POINT CONSTANT 10
3071 * DIVIDE FPA0 BY 10
3072 f30b bd f3 e8 LBB82 JSR LBC5F MOVE FPA0 TO FPA1
3073 f30e 8e f3 06 LDX #LBB7D POINT TO FLOATING POINT CONSTANT 10
3074 f311 5f CLRB ZERO MANTISSA SIGN BYTE
3075 f312 d7 62 LBB89 STB RESSGN STORE THE QUOTIENT MANTISSA SIGN BYTE
3076 f314 bd f3 9d JSR LBC14 UNPACK AN FP NUMBER FROM (X) INTO FPA0
3077 f317 8c FCB SKP2 SKIP TWO BYTES
3078 * DIVIDE (X) BY FPA0-LEAVE NORMALIZED QUOTIENT IN FPA0
3079 f318 8d 9e LBB8F BSR LBB2F GET FP NUMBER FROM (X) TO FPA1
3080
3081 * ARITHMETIC OPERATION (/) JUMPS HERE. DIVIDE FPA1 BY FPA0 (ENTER WITH
3082 * EXPONENT OF FPA1 IN ACCA AND FLAGS SET BY TSTA)
3083
3084 * DIVIDE FPA1 BY FPA0
3085 f31a 27 73 LBB91 BEQ LBC06 /0' DIVIDE BY ZERO ERROR
3086 f31c 00 4f NEG FP0EXP GET EXPONENT OF RECIPROCAL OF DIVISOR
3087 f31e 8d b1 BSR LBB48 CALCULATE EXPONENT OF QUOTIENT
3088 f320 0c 4f INC FP0EXP INCREMENT EXPONENT
3089 f322 27 cc BEQ LBB67 OV' OVERFLOW ERROR
3090 f324 8e 00 13 LDX #FPA2 POINT X TO MANTISSA OF FPA2 - HOLD
3091 * TEMPORARY QUOTIENT IN FPA2
3092 f327 c6 04 LDB #4 5 BYTE DIVIDE
3093 f329 d7 03 STB TMPLOC SAVE BYTE COUNTER
3094 f32b c6 01 LDB #1 SHIFT COUNTER-AND TEMPORARY QUOTIENT BYTE
3095 * COMPARE FPA0 MANTISSA TO FPA1 MANTISSA -
3096 * SET CARRY FLAG IF FPA1 >= FPA0
3097 f32d 96 50 LBBA4 LDA FPA0 * COMPARE THE TWO MS BYTES
3098 f32f 91 5d CMPA FPA1 * OF FPA0 AND FPA1 AND
3099 f331 26 13 BNE LBBBD * BRANCH IF <>
3100 f333 96 51 LDA FPA0+1 = COMPARE THE NUMBER 2
3101 f335 91 5e CMPA FPA1+1 = BYTES AND
3102 f337 26 0d BNE LBBBD = BRANCH IF <>
3103 f339 96 52 LDA FPA0+2 * COMPARE THE NUMBER 3
3104 f33b 91 5f CMPA FPA1+2 * BYTES AND
3105 f33d 26 07 BNE LBBBD * BRANCH IF <>
3106 f33f 96 53 LDA FPA0+3 = COMPARE THE LS BYTES
3107 f341 91 60 CMPA FPA1+3 = AND BRANCH
3108 f343 26 01 BNE LBBBD = IF <>
3109 f345 43 COMA SET CARRY FLAG IF FPA0 = FPA1
3110 f346 1f a8 LBBBD TFR CC,A SAVE CARRY FLAG STATUS IN ACCA; CARRY
3111 * CLEAR IF FPA0 > FPA1
3112 f348 59 ROLB ROTATE CARRY INTO TEMPORARY QUOTIENT BYTE
3113 f349 24 0a BCC LBBCC CARRY WILL BE SET AFTER 8 SHIFTS
3114 f34b e7 80 STB ,X+ SAVE TEMPORARY QUOTIENT
3115 f34d 0a 03 DEC TMPLOC DECREMENT BYTE COUNTER
3116 f34f 2b 34 BMI LBBFC BRANCH IF DONE
3117 f351 27 2e BEQ LBBF8 BRANCH IF LAST BYTE
3118 f353 c6 01 LDB #1 RESET SHIFT COUNTER AND TEMPORARY QUOTIENT BYTE
3119 f355 1f 8a LBBCC TFR A,CC RESTORE CARRY FLAG AND
3120 f357 25 0e BCS LBBDE BRANCH IF FPA0 =< FPA1
3121 f359 08 60 LBBD0 ASL FPA1+3 * SHIFT FPA1 MANTISSA 1 BIT TO LEFT
3122 f35b 09 5f ROL FPA1+2 *
3123 f35d 09 5e ROL FPA1+1 *
3124 f35f 09 5d ROL FPA1 *
3125 f361 25 e3 BCS LBBBD BRANCH IF CARRY - ADD ONE TO PARTIAL QUOTIENT
3126 f363 2b c8 BMI LBBA4 IF MSB OF HIGH ORDER MANTISSA BYTE IS
3127 * SET, CHECK THE MAGNITUDES OF FPA0, FPA1
3128 f365 20 df BRA LBBBD CARRY IS CLEAR, CHECK ANOTHER BIT
3129 * SUBTRACT FPA0 FROM FPA1 - LEAVE RESULT IN FPA1
3130 f367 96 60 LBBDE LDA FPA1+3 * SUBTRACT THE LS BYTES OF MANTISSA
3131 f369 90 53 SUBA FPA0+3 *
3132 f36b 97 60 STA FPA1+3 *
3133 f36d 96 5f LDA FPA1+2 = THEN THE NEXT BYTE
3134 f36f 92 52 SBCA FPA0+2 =
3135 f371 97 5f STA FPA1+2 =
3136 f373 96 5e LDA FPA1+1 * AND THE NEXT
3137 f375 92 51 SBCA FPA0+1 *
3138 f377 97 5e STA FPA1+1 *
3139 f379 96 5d LDA FPA1 = AND FINALLY, THE MS BYTE OF MANTISSA
3140 f37b 92 50 SBCA FPA0 =
3141 f37d 97 5d STA FPA1 =
3142 f37f 20 d8 BRA LBBD0 GO SHIFT FPA1
3143 f381 c6 40 LBBF8 LDB #$40 USE ONLY TWO BITS OF THE LAST BYTE (FIFTH)
3144 f383 20 d0 BRA LBBCC GO SHIFT THE LAST BYTE
3145 f385 56 LBBFC RORB * SHIFT CARRY (ALWAYS SET HERE) INTO
3146 f386 56 RORB * BIT 5 AND MOVE
3147 f387 56 RORB * BITS 1,0 TO BITS 7,6
3148 f388 d7 63 STB FPSBYT SAVE SUB BYTE
3149 f38a 8d 08 BSR LBC0B MOVE MANTISSA OF FPA2 TO FPA0
3150 f38c 7e f1 a5 JMP LBA1C NORMALIZE FPA0
3151 f38f c6 14 LBC06 LDB #2*10 /0' ERROR
3152 f391 7e e4 46 JMP LAC46 PROCESS THE ERROR
3153 * COPY MANTISSA FROM FPA2 TO FPA0
3154 f394 9e 13 LBC0B LDX FPA2 * MOVE TOP 2 BYTES
3155 f396 9f 50 STX FPA0 *
3156 f398 9e 15 LDX FPA2+2 = MOVE BOTTOM 2 BYTES
3157 f39a 9f 52 STX FPA0+2 =
3158 f39c 39 RTS
3159 * COPY A PACKED FP NUMBER FROM (X) TO FPA0
3160 f39d 34 02 LBC14 PSHS A SAVE ACCA
3161 f39f ec 01 LDD 1,X GET TOP TWO MANTISSA BYTES
3162 f3a1 97 54 STA FP0SGN SAVE MS BYTE OF MANTISSA AS MANTISSA SIGN
3163 f3a3 8a 80 ORA #$80 UNPACK MS BYTE
3164 f3a5 dd 50 STD FPA0 SAVE UNPACKED TOP 2 MANTISSA BYTES
3165 f3a7 0f 63 CLR FPSBYT CLEAR MANTISSA SUB BYTE
3166 f3a9 e6 84 LDB ,X GET EXPONENT TO ACCB
3167 f3ab ae 03 LDX 3,X * MOVE LAST 2
3168 f3ad 9f 52 STX FPA0+2 * MANTISSA BYTES
3169 f3af d7 4f STB FP0EXP SAVE EXPONENT
3170 f3b1 35 82 PULS A,PC RESTORE ACCA AND RETURN
3171
3172 f3b3 8e 00 45 LBC2A LDX #V45 POINT X TO MANTISSA OF FPA4
3173 f3b6 20 06 BRA LBC35 MOVE FPA0 TO FPA4
3174 f3b8 8e 00 40 LBC2F LDX #V40 POINT X TO MANTISSA OF FPA3
3175 f3bb 8c FCB SKP2 SKIP TWO BYTES
3176 f3bc 9e 3b LBC33 LDX VARDES POINT X TO VARIABLE DESCRIPTOR IN VARDES
3177 * PACK FPA0 AND MOVE IT TO ADDRESS IN X
3178 f3be 96 4f LBC35 LDA FP0EXP * COPY EXPONENT
3179 f3c0 a7 84 STA ,X *
3180 f3c2 96 54 LDA FP0SGN GET MANTISSA SIGN BIT
3181 f3c4 8a 7f ORA #$7F MASK THE BOTTOM 7 BITS
3182 f3c6 94 50 ANDA FPA0 AND BIT 7 OF MANTISSA SIGN INTO BIT 7 OF MS BYTE
3183 f3c8 a7 01 STA 1,X SAVE MS BYTE
3184 f3ca 96 51 LDA FPA0+1 * MOVE 2ND MANTISSA BYTE
3185 f3cc a7 02 STA 2,X *
3186 f3ce de 52 LDU FPA0+2 = MOVE BOTTOM 2 MANTISSA BYTES
3187 f3d0 ef 03 STU 3,X =
3188 f3d2 39 RTS
3189 * MOVE FPA1 TO FPA0 RETURN W/MANTISSA SIGN IN ACCA
3190 f3d3 96 61 LBC4A LDA FP1SGN * COPY MANTISSA SIGN FROM
3191 f3d5 97 54 LBC4C STA FP0SGN * FPA1 TO FPA0
3192 f3d7 9e 5c LDX FP1EXP = COPY EXPONENT + MS BYTE FROM
3193 f3d9 9f 4f STX FP0EXP = FPA1 TO FPA0
3194 f3db 0f 63 CLR FPSBYT CLEAR MANTISSA SUB BYTE
3195 f3dd 96 5e LDA FPA1+1 * COPY 2ND MANTISSA BYTE
3196 f3df 97 51 STA FPA0+1 * FROM FPA1 TO FPA0
3197 f3e1 96 54 LDA FP0SGN GET MANTISSA SIGN
3198 f3e3 9e 5f LDX FPA1+2 * COPY 3RD AND 4TH MANTISSA BYTE
3199 f3e5 9f 52 STX FPA0+2 * FROM FPA1 TO FPA0
3200 f3e7 39 RTS
3201 * TRANSFER FPA0 TO FPA1
3202 f3e8 dc 4f LBC5F LDD FP0EXP * TRANSFER EXPONENT & MS BYTE
3203 f3ea dd 5c STD FP1EXP *
3204 f3ec 9e 51 LDX FPA0+1 = TRANSFER MIDDLE TWO BYTES
3205 f3ee 9f 5e STX FPA1+1 =
3206 f3f0 9e 53 LDX FPA0+3 * TRANSFER BOTTOM TWO BYTES
3207 f3f2 9f 60 STX FPA1+3 *
3208 f3f4 4d TSTA SET FLAGS ACCORDING TO EXPONENT
3209 f3f5 39 RTS
3210 * CHECK FPA0; RETURN ACCB = 0 IF FPA0 = 0,
3211 * ACCB = $FF IF FPA0 = NEGATIVE, ACCB = 1 IF FPA0 = POSITIVE
3212 f3f6 d6 4f LBC6D LDB FP0EXP GET EXPONENT
3213 f3f8 27 08 BEQ LBC79 BRANCH IF FPA0 = 0
3214 f3fa d6 54 LBC71 LDB FP0SGN GET SIGN OF MANTISSA
3215 f3fc 59 LBC73 ROLB BIT 7 TO CARRY
3216 f3fd c6 ff LDB #$FF NEGATIVE FLAG
3217 f3ff 25 01 BCS LBC79 BRANCH IF NEGATIVE MANTISSA
3218 f401 50 NEGB ACCB = 1 IF POSITIVE MANTISSA
3219 f402 39 LBC79 RTS
3220
3221 * SGN
3222 f403 8d f1 SGN BSR LBC6D SET ACCB ACCORDING TO SIGN OF FPA0
3223 * CONVERT A SIGNED NUMBER IN ACCB INTO A FLOATING POINT NUMBER
3224 f405 d7 50 LBC7C STB FPA0 SAVE ACCB IN FPA0
3225 f407 0f 51 CLR FPA0+1 CLEAR NUMBER 2 MANTISSA BYTE OF FPA0
3226 f409 c6 88 LDB #$88 EXPONENT REQUIRED IF FPA0 IS TO BE AN INTEGER
3227 f40b 96 50 LBC82 LDA FPA0 GET MS BYTE OF MANTISSA
3228 f40d 80 80 SUBA #$80 SET CARRY IF POSITIVE MANTISSA
3229 f40f d7 4f LBC86 STB FP0EXP SAVE EXPONENT
3230 f411 dc 74 LDD ZERO * ZERO OUT ACCD AND
3231 f413 dd 52 STD FPA0+2 * BOTTOM HALF OF FPA0
3232 f415 97 63 STA FPSBYT CLEAR SUB BYTE
3233 f417 97 54 STA FP0SGN CLEAR SIGN OF FPA0 MANTISSA
3234 f419 7e f1 a1 JMP LBA18 GO NORMALIZE FPA0
3235
3236 * ABS
3237 f41c 0f 54 ABS CLR FP0SGN FORCE MANTISSA SIGN OF FPA0 POSITIVE
3238 f41e 39 RTS
3239 * COMPARE A PACKED FLOATING POINT NUMBER POINTED TO
3240 * BY (X) TO AN UNPACKED FP NUMBER IN FPA0. RETURN
3241 * ZERO FLAG SET AND ACCB = 0, IF EQUAL; ACCB = 1 IF
3242 * FPA0 > (X); ACCB = $FF IF FPA0 < (X)
3243 f41f e6 84 LBC96 LDB ,X CHECK EXPONENT OF (X)
3244 f421 27 d3 BEQ LBC6D BRANCH IF FPA = 0
3245 f423 e6 01 LDB 1,X GET MS BYTE OF MANTISSA OF (X)
3246 f425 d8 54 EORB FP0SGN EOR WITH SIGN OF FPA0
3247 f427 2b d1 BMI LBC71 BRANCH IF SIGNS NOT =
3248 * COMPARE FPA0 WITH FP NUMBER POINTED TO BY (X).
3249 * FPA0 IS NORMALIZED, (X) IS PACKED.
3250 f429 d6 4f LBCA0 LDB FP0EXP * GET EXPONENT OF
3251 f42b e1 84 CMPB ,X * FPA0, COMPARE TO EXPONENT OF
3252 f42d 26 1d BNE LBCC3 * (X) AND BRANCH IF <>.
3253 f42f e6 01 LDB 1,X * GET MS BYTE OF (X), KEEP ONLY
3254 f431 ca 7f ORB #$7F * THE SIGN BIT - 'AND' THE BOTTOM 7
3255 f433 d4 50 ANDB FPA0 * BITS OF FPA0 INTO ACCB
3256 f435 e1 01 CMPB 1,X = COMPARE THE BOTTOM 7 BITS OF THE MANTISSA
3257 f437 26 13 BNE LBCC3 = MS BYTE AND BRANCH IF <>
3258 f439 d6 51 LDB FPA0+1 * COMPARE 2ND BYTE
3259 f43b e1 02 CMPB 2,X * OF MANTISSA,
3260 f43d 26 0d BNE LBCC3 * BRANCH IF <>
3261 f43f d6 52 LDB FPA0+2 = COMPARE 3RD BYTE
3262 f441 e1 03 CMPB 3,X = OF MANTISSA,
3263 f443 26 07 BNE LBCC3 = BRANCH IF <>
3264 f445 d6 53 LDB FPA0+3 * SUBTRACT LS BYTE
3265 f447 e0 04 SUBB 4,X * OF (X) FROM LS BYTE OF
3266 f449 26 01 BNE LBCC3 * FPA0, BRANCH IF <>
3267 f44b 39 RTS RETURN IF FP (X) = FPA0
3268 f44c 56 LBCC3 RORB SHIFT CARRY TO BIT 7; CARRY SET IF FPA0 < (X)
3269 f44d d8 54 EORB FP0SGN TOGGLE SIZE COMPARISON BIT IF FPA0 IS NEGATIVE
3270 f44f 20 ab BRA LBC73 GO SET ACCB ACCORDING TO COMPARISON
3271 * DE-NORMALIZE FPA0 : SHIFT THE MANTISSA UNTIL THE BINARY POINT IS TO THE RIGHT
3272 * OF THE LEAST SIGNIFICANT BYTE OF THE MANTISSA
3273 f451 d6 4f LBCC8 LDB FP0EXP GET EXPONENT OF FPA0
3274 f453 27 3d BEQ LBD09 ZERO MANTISSA IF FPA0 = 0
3275 f455 c0 a0 SUBB #$A0 SUBTRACT $A0 FROM FPA0 EXPONENT T THIS WILL YIELD
3276 * THE NUMBER OF SHIFTS REQUIRED TO DENORMALIZE FPA0. WHEN
3277 * THE EXPONENT OF FPA0 IS = ZERO, THEN THE BINARY POINT
3278 * WILL BE TO THE RIGHT OF THE MANTISSA
3279 f457 96 54 LDA FP0SGN TEST SIGN OF FPA0 MANTISSA
3280 f459 2a 05 BPL LBCD7 BRANCH IF POSITIVE
3281 f45b 03 5b COM FPCARY COMPLEMENT CARRY IN BYTE
3282 f45d bd f2 04 JSR LBA7B NEGATE MANTISSA OF FPA0
3283 f460 8e 00 4f LBCD7 LDX #FP0EXP POINT X TO FPA0
3284 f463 c1 f8 CMPB #-8 EXPONENT DIFFERENCE < -8?
3285 f465 2e 06 BGT LBCE4 YES
3286 f467 bd f2 37 JSR LBAAE SHIFT FPA0 RIGHT UNTIL FPA0 EXPONENT = $A0
3287 f46a 0f 5b CLR FPCARY CLEAR CARRY IN BYTE
3288 f46c 39 RTS
3289 f46d 0f 5b LBCE4 CLR FPCARY CLEAR CARRY IN BYTE
3290 f46f 96 54 LDA FP0SGN * GET SIGN OF FPA0 MANTISSA
3291 f471 49 ROLA * ROTATE IT INTO THE CARRY FLAG
3292 f472 06 50 ROR FPA0 ROTATE CARRY (MANTISSA SIGN) INTO BIT 7
3293 * OF LS BYTE OF MANTISSA
3294 f474 7e f2 43 JMP LBABA DE-NORMALIZE FPA0
3295
3296 * INT
3297 * THE INT STATEMENT WILL "DENORMALIZE" FPA0 - THAT IS IT WILL SHIFT THE BINARY POINT
3298 * TO THE EXTREME RIGHT OF THE MANTISSA TO FORCE ITS EXPONENT TO BE $AO. ONCE
3299 * THIS IS DONE THE MANTISSA OF FPA0 WILL CONTAIN THE FOUR LEAST SIGNIFICANT
3300 * BYTES OF THE INTEGER PORTION OF FPA0. AT THE CONCLUSION OF THE DE-NORMALIZATION
3301 * ONLY THE INTEGER PORTION OF FPA0 WILL REMAIN.
3302 *
3303 f477 d6 4f INT LDB FP0EXP GET EXPONENT OF FPA0
3304 f479 c1 a0 CMPB #$A0 LARGEST POSSIBLE INTEGER EXPONENT
3305 f47b 24 1d BCC LBD11 RETURN IF FPA0 >= 32768
3306 f47d 8d d2 BSR LBCC8 SHIFT THE BINARY POINT ONE TO THE RIGHT OF THE
3307 * LS BYTE OF THE FPA0 MANTISSA
3308 f47f d7 63 STB FPSBYT ACCB = 0: ZERO OUT THE SUB BYTE
3309 f481 96 54 LDA FP0SGN GET MANTISSA SIGN
3310 f483 d7 54 STB FP0SGN FORCE MANTISSA SIGN TO BE POSITIVE
3311 f485 80 80 SUBA #$80 SET CARRY IF MANTISSA
3312 f487 86 a0 LDA #$A0 * GET DENORMALIZED EXPONENT AND
3313 f489 97 4f STA FP0EXP * SAVE IT IN FPA0 EXPONENT
3314 f48b 96 53 LDA FPA0+3 = GET LS BYTE OF FPA0 AND
3315 f48d 97 01 STA CHARAC = SAVE IT IN CHARAC
3316 f48f 7e f1 a1 JMP LBA18 NORMALIZE FPA0
3317
3318 f492 d7 50 LBD09 STB FPA0 * LOAD MANTISSA OF FPA0 WITH CONTENTS OF ACCB
3319 f494 d7 51 STB FPA0+1 *
3320 f496 d7 52 STB FPA0+2 *
3321 f498 d7 53 STB FPA0+3 *
3322 f49a 39 LBD11 RTS *
3323
3324 * CONVERT ASCII STRING TO FLOATING POINT
3325 f49b 9e 74 LBD12 LDX ZERO (X) = 0
3326 f49d 9f 54 STX FP0SGN * ZERO OUT FPA0 & THE SIGN FLAG (COEFCT)
3327 f49f 9f 4f STX FP0EXP *
3328 f4a1 9f 51 STX FPA0+1 *
3329 f4a3 9f 52 STX FPA0+2 *
3330 f4a5 9f 47 STX V47 INITIALIZE EXPONENT & EXPONENT SIGN FLAG TO ZERO
3331 f4a7 9f 45 STX V45 INITIALIZE RIGHT DECIMAL CTR & DECIMAL PT FLAG TO 0
3332 f4a9 25 64 BCS LBD86 IF CARRY SET (NUMERIC CHARACTER), ASSUME ACCA CONTAINS FIRST
3333 * NUMERIC CHAR, SIGN IS POSITIVE AND SKIP THE RAM HOOK
3334 f4ab bd fb d8 JSR XVEC19 CALL EXTENDED BASIC ADD-IN
3335 f4ae 81 2d LBD25 CMPA #'- * CHECK FOR A LEADING MINUS SIGN AND BRANCH
3336 f4b0 26 04 BNE LBD2D * IF NO MINUS SIGN
3337 f4b2 03 55 COM COEFCT TOGGLE SIGN; 0 = +; FF = -
3338 f4b4 20 04 BRA LBD31 INTERPRET THE REST OF THE STRING
3339 f4b6 81 2b LBD2D CMPA #'+ * CHECK FOR LEADING PLUS SlGN AND BRANCH
3340 f4b8 26 04 BNE LBD35 * IF NOT A PLUS SIGN
3341 f4ba 9d 7c LBD31 JSR GETNCH GET NEXT INPUT CHARACTER FROM BASIC
3342 f4bc 25 51 BCS LBD86 BRANCH IF NUMERIC CHARACTER
3343 f4be 81 2e LBD35 CMPA #'. DECIMAL POlNT?
3344 f4c0 27 28 BEQ LBD61 YES
3345 f4c2 81 45 CMPA #'E "E" SHORTHAND FORM (SCIENTIFIC NOTATION)?
3346 f4c4 26 28 BNE LBD65 NO
3347 * EVALUATE EXPONENT OF EXPONENTIAL FORMAT
3348 f4c6 9d 7c JSR GETNCH GET NEXT INPUT CHARACTER FROM BASIC
3349 f4c8 25 64 BCS LBDA5 BRANCH IF NUMERIC
3350 f4ca 81 a7 CMPA #TOK_MINUS MINUS TOKEN?
3351 f4cc 27 0e BEQ LBD53 YES
3352 f4ce 81 2d CMPA #'- ASCII MINUS?
3353 f4d0 27 0a BEQ LBD53 YES
3354 f4d2 81 a6 CMPA #TOK_PLUS PLUS TOKEN?
3355 f4d4 27 08 BEQ LBD55 YES
3356 f4d6 81 2b CMPA #'+ ASCII PLUS?
3357 f4d8 27 04 BEQ LBD55 YES
3358 f4da 20 06 BRA LBD59 BRANCH IF NO SIGN FOUND
3359 f4dc 03 48 LBD53 COM V48 SET EXPONENT SIGN FLAG TO NEGATIVE
3360 * STRIP A DECIMAL NUMBER FROM BASIC LINE, CONVERT IT TO BINARY IN V47
3361 f4de 9d 7c LBD55 JSR GETNCH GET NEXT INPUT CHARACTER FROM BASIC
3362 f4e0 25 4c BCS LBDA5 IF NUMERIC CHARACTER, CONVERT TO BINARY
3363 f4e2 0d 48 LBD59 TST V48 * CHECK EXPONENT SIGN FLAG
3364 f4e4 27 08 BEQ LBD65 * AND BRANCH IF POSITIVE
3365 f4e6 00 47 NEG V47 NEGATE VALUE OF EXPONENT
3366 f4e8 20 04 BRA LBD65
3367 f4ea 03 46 LBD61 COM V46 *TOGGLE DECIMAL PT FLAG AND INTERPRET ANOTHER
3368 f4ec 26 cc BNE LBD31 *CHARACTER IF <> 0 - TERMINATE INTERPRETATION
3369 * IF SECOND DECIMAL POINT
3370 * ADJUST FPA0 FOR THE DECIMAL EXPONENT IN V47
3371 f4ee 96 47 LBD65 LDA V47 * GET EXPONENT, SUBTRACT THE NUMBER OF
3372 f4f0 90 45 SUBA V45 * PLACES TO THE RIGHT OF DECIMAL POINT
3373 f4f2 97 47 STA V47 * AND RESAVE IT.
3374 f4f4 27 12 BEQ LBD7F EXIT ROUTINE IF ADJUSTED EXPONENT = ZERO
3375 f4f6 2a 09 BPL LBD78 BRANCH IF POSITIVE EXPONENT
3376 f4f8 bd f3 0b LBD6F JSR LBB82 DIVIDE FPA0 BY 10
3377 f4fb 0c 47 INC V47 INCREMENT EXPONENT COUNTER (MULTIPLY BY 10)
3378 f4fd 26 f9 BNE LBD6F KEEP MULTIPLYING
3379 f4ff 20 07 BRA LBD7F EXIT ROUTINE
3380 f501 bd f2 f3 LBD78 JSR LBB6A MULTIPLY FPA0 BY 10
3381 f504 0a 47 DEC V47 DECREMENT EXPONENT COUNTER (DIVIDE BY 10)
3382 f506 26 f9 BNE LBD78 KEEP MULTIPLYING
3383 f508 96 55 LBD7F LDA COEFCT GET THE SIGN FLAG
3384 f50a 2a 8e BPL LBD11 RETURN IF POSITIVE
3385 f50c 7e f6 72 JMP LBEE9 TOGGLE MANTISSA SIGN OF FPA0, IF NEGATIVE
3386 *MULTIPLY FPA0 BY TEN AND ADD ACCA TO THE RESULT
3387 f50f d6 45 LBD86 LDB V45 *GET THE RIGHT DECIMAL COUNTER AND SUBTRACT
3388 f511 d0 46 SUBB V46 *THE DECIMAL POINT FLAG FROM IT. IF DECIMAL POINT
3389 f513 d7 45 STB V45 *FLAG=0, NOTHING HAPPENS. IF DECIMAL POINT FLAG IS
3390 * -1, THEN RIGHT DECIMAL COUNTER IS INCREMENTED BY ONE
3391 f515 34 02 PSHS A SAVE NEW DIGIT ON STACK
3392 f517 bd f2 f3 JSR LBB6A MULTIPLY FPA0 BY 10
3393 f51a 35 04 PULS B GET NEW DIGIT BACK
3394 f51c c0 30 SUBB #'0 MASK OFF ASCII
3395 f51e 8d 02 BSR LBD99 ADD ACCB TO FPA0
3396 f520 20 98 BRA LBD31 GET ANOTHER CHARACTER FROM BASIC
3397 f522 bd f3 b8 LBD99 JSR LBC2F PACK FPA0 AND SAVE IT IN FPA3
3398 f525 bd f4 05 JSR LBC7C CONVERT ACCB TO FP NUMBER IN FPA0
3399 f528 8e 00 40 LDX #V40 * ADD FPA0 TO
3400 f52b 7e f1 4b JMP LB9C2 * FPA3
3401
3402
3403 f52e d6 47 LBDA5 LDB V47
3404 f530 58 ASLB TIMES 2
3405 f531 58 ASLB TIMES 4
3406 f532 db 47 ADDB V47 ADD 1 = TIMES 5
3407 f534 58 ASLB TIMES 10
3408 f535 80 30 SUBA #'0 *MASK OFF ASCII FROM ACCA, PUSH
3409 f537 34 04 PSHS B *RESULT ONTO THE STACK AND
3410 f539 ab e0 ADDA ,S+ ADD lT TO ACCB
3411 f53b 97 47 STA V47 SAVE IN V47
3412 f53d 20 9f BRA LBD55 INTERPRET ANOTHER CHARACTER
3413 *
3414 f53f 9b 3e bc 1f fd LBDB6 FCB $9B,$3E,$BC,$1F,$FD * 99999999.9
3415 f544 9e 6e 6b 27 fd LBDBB FCB $9E,$6E,$6B,$27,$FD * 999999999
3416 f549 9e 6e 6b 28 00 LBDC0 FCB $9E,$6E,$6B,$28,$00 * 1E + 09
3417 *
3418 f54e 8e e3 e7 LBDC5 LDX #LABE8-1 POINT X TO " IN " MESSAGE
3419 f551 8d 0c BSR LBDD6 COPY A STRING FROM (X) TO CONSOLE OUT
3420 f553 dc 68 LDD CURLIN GET CURRENT BASIC LINE NUMBER TO ACCD
3421 * CONVERT VALUE IN ACCD INTO A DECIMAL NUMBER
3422 * AND PRINT IT TO CONSOLE OUT
3423 f555 dd 50 LBDCC STD FPA0 SAVE ACCD IN TOP HALF OF FPA0
3424 f557 c6 90 LDB #$90 REQ<45>D EXPONENT IF TOP HALF OF ACCD = INTEGER
3425 f559 43 COMA SET CARRY FLAG - FORCE POSITIVE MANTISSA
3426 f55a bd f4 0f JSR LBC86 ZERO BOTTOM HALF AND SIGN OF FPA0, THEN
3427 * SAVE EXPONENT AND NORMALIZE IT
3428 f55d 8d 03 BSR LBDD9 CONVERT FP NUMBER TO ASCII STRING
3429 f55f 7e f1 25 LBDD6 JMP LB99C COPY A STRING FROM (X) TO CONSOLE OUT
3430
3431 * CONVERT FP NUMBER TO ASCII STRING
3432 f562 ce 01 f1 LBDD9 LDU #STRBUF+3 POINT U TO BUFFER WHICH WILL NOT CAUSE
3433 * THE STRING TO BE STORED IN STRING SPACE
3434 f565 86 20 LBDDC LDA #SPACE SPACE = DEFAULT SIGN FOR POSITIVE #
3435 f567 d6 54 LDB FP0SGN GET SIGN OF FPA0
3436 f569 2a 02 BPL LBDE4 BRANCH IF POSITIVE
3437 f56b 86 2d LDA #'- ASCII MINUS SIGN
3438 f56d a7 c0 LBDE4 STA ,U+ STORE SIGN OF NUMBER
3439 f56f df 64 STU COEFPT SAVE BUFFER POINTER
3440 f571 97 54 STA FP0SGN SAVE SIGN (IN ASCII)
3441 f573 86 30 LDA #'0 ASCII ZERO IF EXPONENT = 0
3442 f575 d6 4f LDB FP0EXP GET FPA0 EXPONENT
3443 f577 10 27 00 c6 LBEQ LBEB8 BRANCH IF FPA0 = 0
3444 f57b 4f CLRA BASE 10 EXPONENT=0 FOR FP NUMBER > 1
3445 f57c c1 80 CMPB #$80 CHECK EXPONENT
3446 f57e 22 08 BHI LBDFF BRANCH IF FP NUMBER > 1
3447 * IF FPA0 < 1.0, MULTIPLY IT BY 1E+09 TO SPEED UP THE CONVERSION PROCESS
3448 f580 8e f5 49 LDX #LBDC0 POINT X TO FP 1E+09
3449 f583 bd f2 53 JSR LBACA MULTIPLY FPA0 BY (X)
3450 f586 86 f7 LDA #-9 BASE 10 EXPONENT = -9
3451 f588 97 45 LBDFF STA V45 BASE 10 EXPONENT
3452 * PSEUDO - NORMALIZE THE FP NUMBER TO A VALUE IN THE RANGE
3453 * OF 999,999,999 RO 99,999,999.9 - THIS IS THE LARGEST
3454 * NUMBER RANGE IN WHICH ALL OF THE DIGITS ARE
3455 * SIGNIFICANT WHICH CAN BE DISPLAYED WITHOUT USING
3456 * SCIENTIFIC NOTATION
3457 f58a 8e f5 44 LBE01 LDX #LBDBB POINT X TO FP 999,999,999
3458 f58d bd f4 29 JSR LBCA0 COMPARE FPA0 TO 999,999,999
3459 f590 2e 0f BGT LBE18 BRANCH IF > 999,999,999
3460 f592 8e f5 3f LBE09 LDX #LBDB6 POINT X TO FP 99,999,999.9
3461 f595 bd f4 29 JSR LBCA0 COMPARE FPA0 TO 99,999,999.9
3462 f598 2e 0e BGT LBE1F BRANCH IF > 99,999,999.9 (IN RANGE)
3463 f59a bd f2 f3 JSR LBB6A MULTIPLY FPA0 BY 10
3464 f59d 0a 45 DEC V45 SUBTRACT ONE FROM DECIMAL OFFSET
3465 f59f 20 f1 BRA LBE09 PSEUDO - NORMALIZE SOME MORE
3466 f5a1 bd f3 0b LBE18 JSR LBB82 DIVIDE FPA0 BY 10
3467 f5a4 0c 45 INC V45 ADD ONE TO BASE 10 EXPONENT
3468 f5a6 20 e2 BRA LBE01 PSEUDO - NORMALIZE SOME MORE
3469 f5a8 bd f1 3d LBE1F JSR LB9B4 ADD .5 TO FPA0 (ROUND OFF)
3470 f5ab bd f4 51 JSR LBCC8 CONVERT FPA0 TO AN INTEGER
3471 f5ae c6 01 LDB #1 DEFAULT DECIMAL POINT FLAG (FORCE IMMED DECIMAL PT)
3472 f5b0 96 45 LDA V45 * GET BASE 10 EXPONENT AND ADD TEN TO IT
3473 f5b2 8b 0a ADDA #9+1 * (NUMBER <20>NORMALIZED<45> TO 9 PLACES & DECIMAL PT)
3474 f5b4 2b 09 BMI LBE36 BRANCH IF NUMBER < 1.0
3475 f5b6 81 0b CMPA #9+2 NINE PLACES MAY BE DISPLAYED WITHOUT
3476 * USING SCIENTIFIC NOTATION
3477 f5b8 24 05 BCC LBE36 BRANCH IF SCIENTIFIC NOTATION REQUIRED
3478 f5ba 4a DECA * SUBTRACT 1 FROM MODIFIED BASE 10 EXPONENT CTR
3479 f5bb 1f 89 TFR A,B * AND SAVE IT IN ACCB (DECiMAL POINT FLAG)
3480 f5bd 86 02 LDA #2 FORCE EXPONENT = 0 - DON'T USE SCIENTIFIC NOTATION
3481 f5bf 4a LBE36 DECA * SUBTRACT TWO (WITHOUT AFFECTING CARRY)
3482 f5c0 4a DECA * FROM BASE 10 EXPONENT
3483 f5c1 97 47 STA V47 SAVE EXPONENT - ZERO EXPONENT = DO NOT DISPLAY
3484 * IN SCIENTIFIC NOTATION
3485 f5c3 d7 45 STB V45 DECIMAL POINT FLAG - NUMBER OF PLACES TO
3486 * LEFT OF DECIMAL POINT
3487 f5c5 2e 0d BGT LBE4B BRANCH IF >= 1
3488 f5c7 de 64 LDU COEFPT POINT U TO THE STRING BUFFER
3489 f5c9 86 2e LDA #'. * STORE A PERIOD
3490 f5cb a7 c0 STA ,U+ * IN THE BUFFER
3491 f5cd 5d TSTB CHECK DECIMAL POINT FLAG
3492 f5ce 27 04 BEQ LBE4B BRANCH IF NOTHING TO LEFT OF DECIMAL POINT
3493 f5d0 86 30 LDA #'0 * STORE A ZERO
3494 f5d2 a7 c0 STA ,U+ * IN THE BUFFER
3495
3496 * CONVERT FPA0 INTO A STRING OF ASCII DIGITS
3497 f5d4 8e f6 4e LBE4B LDX #LBEC5 POINT X TO FP POWER OF 10 MANTISSA
3498 f5d7 c6 80 LDB #0+$80 INITIALIZE DIGIT COUNTER TO 0+$80
3499 * BIT 7 SET IS USED TO INDICATE THAT THE POWER OF 10 MANTISSA
3500 * IS NEGATIVE. WHEN YOU 'ADD' A NEGATIVE MANTISSA, IT IS
3501 * THE SAME AS SUBTRACTING A POSITIVE ONE AND BIT 7 OF ACCB IS HOW
3502 * THE ROUTINE KNOWS THAT A 'SUBTRACTION' IS OCCURING.
3503 f5d9 96 53 LBE50 LDA FPA0+3 * ADD MANTISSA LS
3504 f5db ab 03 ADDA 3,X * BYTE OF FPA0
3505 f5dd 97 53 STA FPA0+3 * AND (X)
3506 f5df 96 52 LDA FPA0+2 = ADD MANTISSA
3507 f5e1 a9 02 ADCA 2,X = NUMBER 3 BYTE OF
3508 f5e3 97 52 STA FPA0+2 = FPA0 AND (X)
3509 f5e5 96 51 LDA FPA0+1 * ADD MANTISSA
3510 f5e7 a9 01 ADCA 1,X * NUMBER 2 BYTE OF
3511 f5e9 97 51 STA FPA0+1 * FPA0 AND (X)
3512 f5eb 96 50 LDA FPA0 = ADD MANTISSA
3513 f5ed a9 84 ADCA ,X = MS BYTE OF
3514 f5ef 97 50 STA FPA0 = FPA0 AND (X)
3515 f5f1 5c INCB ADD ONE TO DIGIT COUNTER
3516 f5f2 56 RORB ROTATE CARRY INTO BIT 7
3517 f5f3 59 ROLB *SET OVERFLOW FLAG AND BRANCH IF CARRY = 1 AND
3518 f5f4 28 e3 BVC LBE50 *POSITIVE MANTISSA OR CARRY = 0 AND NEG MANTISSA
3519 f5f6 24 03 BCC LBE72 BRANCH IF NEGATIVE MANTISSA
3520 f5f8 c0 0b SUBB #10+1 * TAKE THE 9<>S COMPLEMENT IF
3521 f5fa 50 NEGB * ADDING MANTISSA
3522 f5fb cb 2f LBE72 ADDB #'0-1 ADD ASCII OFFSET TO DIGIT
3523 f5fd 30 04 LEAX 4,X MOVE TO NEXT POWER OF 10 MANTISSA
3524 f5ff 1f 98 TFR B,A SAVE DIGIT IN ACCA
3525 f601 84 7f ANDA #$7F MASK OFF BIT 7 (ADD/SUBTRACT FLAG)
3526 f603 a7 c0 STA ,U+ STORE DIGIT IN STRING BUFFER
3527 f605 0a 45 DEC V45 DECREMENT DECIMAL POINT FLAG
3528 f607 26 04 BNE LBE84 BRANCH IF NOT TIME FOR DECIMAL POINT
3529 f609 86 2e LDA #'. * STORE DECIMAL POINT IN
3530 f60b a7 c0 STA ,U+ * STRING BUFFER
3531 f60d 53 LBE84 COMB TOGGLE BIT 7 (ADD/SUBTRACT FLAG)
3532 f60e c4 80 ANDB #$80 MASK OFF ALL BUT ADD/SUBTRACT FLAG
3533 f610 8c f6 72 CMPX #LBEC5+36 COMPARE X TO END OF MANTISSA TABLE
3534 f613 26 c4 BNE LBE50 BRANCH IF NOT AT END OF TABLE
3535 * BLANK TRAILING ZEROS AND STORE EXPONENT IF ANY
3536 f615 a6 c2 LBE8C LDA ,-U GET THE LAST CHARACTER; MOVE POINTER BACK
3537 f617 81 30 CMPA #'0 WAS IT A ZERO?
3538 f619 27 fa BEQ LBE8C IGNORE TRAILING ZEROS IF SO
3539 f61b 81 2e CMPA #'. CHECK FOR DECIMAL POINT
3540 f61d 26 02 BNE LBE98 BRANCH IF NOT DECIMAL POINT
3541 f61f 33 5f LEAU -1,U STEP OVER THE DECIMAL POINT
3542 f621 86 2b LBE98 LDA #'+ ASCII PLUS SIGN
3543 f623 d6 47 LDB V47 GET SCIENTIFIC NOTATION EXPONENT
3544 f625 27 1c BEQ LBEBA BRANCH IF NOT SCIENTIFIC NOTATION
3545 f627 2a 03 BPL LBEA3 BRANCH IF POSITIVE EXPONENT
3546 f629 86 2d LDA #'- ASCII MINUS SIGN
3547 f62b 50 NEGB NEGATE EXPONENT IF NEGATIVE
3548 f62c a7 42 LBEA3 STA 2,U STORE EXPONENT SIGN IN STRING
3549 f62e 86 45 LDA #'E * GET ASCII <20>E<EFBFBD> (SCIENTIFIC NOTATION
3550 f630 a7 41 STA 1,U * FLAG) AND SAVE IT IN THE STRING
3551 f632 86 2f LDA #'0-1 INITIALIZE ACCA TO ASCII ZERO
3552
3553
3554 f634 4c LBEAB INCA ADD ONE TO 10<31>S DIGIT OF EXPONENT
3555 f635 c0 0a SUBB #10 SUBTRACT 10 FROM ACCB
3556 f637 24 fb BCC LBEAB ADD 1 TO 10<31>S DIGIT IF NO CARRY
3557 f639 cb 3a ADDB #'9+1 CONVERT UNITS DIGIT TO ASCII
3558 f63b ed 43 STD 3,U SAVE EXPONENT IN STRING
3559 f63d 6f 45 CLR 5,U CLEAR LAST BYTE (TERMINATOR)
3560 f63f 20 04 BRA LBEBC GO RESET POINTER
3561 f641 a7 c4 LBEB8 STA ,U STORE LAST CHARACTER
3562 f643 6f 41 LBEBA CLR 1,U CLEAR LAST BYTE (TERMINATOR - REQUIRED BY
3563 * PRINT SUBROUTINES)
3564 f645 8e 01 f1 LBEBC LDX #STRBUF+3 RESET POINTER TO START OF BUFFER
3565 f648 39 RTS
3566 *
3567 f649 80 00 00 00 00 LBEC0 FCB $80,$00,$00,$00,$00 FLOATING POINT .5
3568 *
3569 *** TABLE OF UNNORMALIZED POWERS OF 10
3570 f64e fa 0a 1f 00 LBEC5 FCB $FA,$0A,$1F,$00 -100000000
3571 f652 00 98 96 80 LBEC9 FCB $00,$98,$96,$80 10000000
3572 f656 ff f0 bd c0 LBECD FCB $FF,$F0,$BD,$C0 -1000000
3573 f65a 00 01 86 a0 LBED1 FCB $00,$01,$86,$A0 100000
3574 f65e ff ff d8 f0 LBED5 FCB $FF,$FF,$D8,$F0 -10000
3575 f662 00 00 03 e8 LBED9 FCB $00,$00,$03,$E8 1000
3576 f666 ff ff ff 9c LBEDD FCB $FF,$FF,$FF,$9C -100
3577 f66a 00 00 00 0a LBEE1 FCB $00,$00,$00,$0A 10
3578 f66e ff ff ff ff LBEE5 FCB $FF,$FF,$FF,$FF -1
3579 *
3580 *
3581 f672 96 4f LBEE9 LDA FP0EXP GET EXPONENT OF FPA0
3582 f674 27 02 BEQ LBEEF BRANCH IF FPA0 = 0
3583 f676 03 54 COM FP0SGN TOGGLE MANTISSA SIGN OF FPA0
3584 f678 39 LBEEF RTS
3585 * EXPAND A POLYNOMIAL OF THE FORM
3586 * AQ+BQ**3+CQ**5+DQ**7.... WHERE Q = FPA0
3587 * AND THE X REGISTER POINTS TO A TABLE OF
3588 * COEFFICIENTS A,B,C,D....
3589 f679 9f 64 LBEF0 STX COEFPT SAVE COEFFICIENT TABLE POINTER
3590 f67b bd f3 b8 JSR LBC2F MOVE FPA0 TO FPA3
3591 f67e 8d 05 BSR LBEFC MULTIPLY FPA3 BY FPA0
3592 f680 8d 08 BSR LBF01 EXPAND POLYNOMIAL
3593 f682 8e 00 40 LDX #V40 POINT X TO FPA3
3594 f685 7e f2 53 LBEFC JMP LBACA MULTIPLY (X) BY FPA0
3595
3596 * CALCULATE THE VALUE OF AN EXPANDED POLYNOMIAL
3597 * EXPRESSION. ENTER WITH (X) POINTING TO A TABLE
3598 * OF COEFFICIENTS, THE FIRST BYTE OF WHICH IS THE
3599 * NUMBER OF (COEFFICIENTS-1) FOLLOWED BY THAT NUMBER
3600 * OF PACKED FLOATING POINT NUMBERS. THE
3601 * POLYNOMIAL IS EVALUATED AS FOLLOWS: VALUE =
3602 * (((FPA0*Y0+Y1)*FPA0+Y2)*FPA0<41>YN)
3603 f688 9f 64 LBEFF STX COEFPT SAVE COEFFICIENT TABLE POINTER
3604 f68a bd f3 b3 LBF01 JSR LBC2A MOVE FPA0 TO FPA4
3605 f68d 9e 64 LDX COEFPT GET THE COEFFICIENT POINTER
3606 f68f e6 80 LDB ,X+ GET THE TOP OF COEFFICIENT TABLE TO
3607 f691 d7 55 STB COEFCT * USE AND STORE IT IN TEMPORARY COUNTER
3608 f693 9f 64 STX COEFPT SAVE NEW COEFFICIENT POINTER
3609 f695 8d ee LBF0C BSR LBEFC MULTIPLY (X) BY FPA0
3610 f697 9e 64 LDX COEFPT *GET COEFFICIENT POINTER
3611 f699 30 05 LEAX 5,X *MOVE TO NEXT FP NUMBER
3612 f69b 9f 64 STX COEFPT *SAVE NEW COEFFICIENT POINTER
3613 f69d bd f1 4b JSR LB9C2 ADD (X) AND FPA0
3614 f6a0 8e 00 45 LDX #V45 POINT (X) TO FPA4
3615 f6a3 0a 55 DEC COEFCT DECREMENT TEMP COUNTER
3616 f6a5 26 ee BNE LBF0C BRANCH IF MORE COEFFICIENTS LEFT
3617 f6a7 39 RTS
3618
3619 * RND
3620 f6a8 bd f3 f6 RND JSR LBC6D TEST FPA0
3621 f6ab 2b 1f BMI LBF45 BRANCH IF FPA0 = NEGATIVE
3622 f6ad 27 15 BEQ LBF3B BRANCH IF FPA0 = 0
3623 f6af 8d 10 BSR LBF38 CONVERT FPA0 TO AN INTEGER
3624 f6b1 bd f3 b8 JSR LBC2F PACK FPA0 TO FPA3
3625 f6b4 8d 0e BSR LBF3B GET A RANDOM NUMBER: FPA0 < 1.0
3626 f6b6 8e 00 40 LDX #V40 POINT (X) TO FPA3
3627 f6b9 8d ca BSR LBEFC MULTIPLY (X) BY FPA0
3628 f6bb 8e f2 4e LDX #LBAC5 POINT (X) TO FP VALUE OF 1.0
3629 f6be bd f1 4b JSR LB9C2 ADD 1.0 TO FPA0
3630 f6c1 7e f4 77 LBF38 JMP INT CONVERT FPA0 TO AN INTEGER
3631 * CALCULATE A RANDOM NUMBER IN THE RANGE 0.0 < X <= 1.0
3632 f6c4 9e b1 LBF3B LDX RVSEED+1 * MOVE VARIABLE
3633 f6c6 9f 50 STX FPA0 * RANDOM NUMBER
3634 f6c8 9e b3 LDX RVSEED+3 * SEED TO
3635 f6ca 9f 52 STX FPA0+2 * FPA0
3636 f6cc be f6 f9 LBF45 LDX RSEED = MOVE FIXED
3637 f6cf 9f 5d STX FPA1 = RANDOM NUMBER
3638 f6d1 be f6 fb LDX RSEED+2 = SEED TO
3639 f6d4 9f 5f STX FPA1+2 = MANTISSA OF FPA0
3640 f6d6 bd f2 59 JSR LBAD0 MULTIPLY FPA0 X FPA1
3641 f6d9 dc 8a LDD VAD GET THE TWO LOWEST ORDER PRODUCT BYTES
3642 f6db c3 65 8b ADDD #$658B ADD A CONSTANT
3643 f6de dd b3 STD RVSEED+3 SAVE NEW LOW ORDER VARIABLE RANDOM # SEED
3644 f6e0 dd 52 STD FPA0+2 SAVE NEW LOW ORDER BYTES OF FPA0 MANTISSA
3645 f6e2 dc 88 LDD VAB GET 2 MORE LOW ORDER PRODUCT BYTES
3646 f6e4 c9 b0 ADCB #$B0 ADD A CONSTANT
3647 f6e6 89 05 ADCA #5 ADD A CONSTANT
3648 f6e8 dd b1 STD RVSEED+1 SAVE NEW HIGH ORDER VARIABLE RANDOM # SEED
3649 f6ea dd 50 STD FPA0 SAVE NEW HIGH ORDER FPA0 MANTISSA
3650 f6ec 0f 54 CLR FP0SGN FORCE FPA0 MANTISSA = POSITIVE
3651 f6ee 86 80 LDA #$80 * SET FPA0 BIASED EXPONENT
3652 f6f0 97 4f STA FP0EXP * TO 0 1 < FPA0 < 0
3653 f6f2 96 15 LDA FPA2+2 GET A BYTE FROM FPA2 (MORE RANDOMNESS)
3654 f6f4 97 63 STA FPSBYT SAVE AS SUB BYTE
3655 f6f6 7e f1 a5 JMP LBA1C NORMALIZE FPA0
3656 *
3657 f6f9 40 e6 RSEED FDB $40E6 *CONSTANT RANDOM NUMBER GENERATOR SEED
3658 f6fb 4d ab FDB $4DAB *
3659
3660 * SIN
3661 * THE SIN FUNCTION REQUIRES AN ARGUMENT IN RADIANS AND WILL REPEAT ITSELF EVERY
3662 * 2*PI RADIANS. THE ARGUMENT IS DIVIDED BY 2*PI AND ONLY THE FRACTIONAL PART IS
3663 * RETAINED. SINCE THE ARGUMENT WAS DIVIDED BY 2*P1, THE COEFFICIENTS MUST BE
3664 * MULTIPLIED BY THE APPROPRIATE POWER OF 2*PI.
3665
3666 * SIN IS EVALUATED USING THE TRIGONOMETRIC IDENTITIES BELOW:
3667 * SIN(X)=SIN(PI-X) & -SIN(PI/2-X)=SIN((3*PI)/2+X)
3668 f6fd bd f3 e8 SIN JSR LBC5F COPY FPA0 TO FPA1
3669 f700 8e f7 42 LDX #LBFBD POINT (X) TO 2*PI
3670 f703 d6 61 LDB FP1SGN *GET MANTISSA SIGN OF FPA1
3671 f705 bd f3 12 JSR LBB89 *AND DIVIDE FPA0 BY 2*PI
3672 f708 bd f3 e8 JSR LBC5F COPY FPA0 TO FPA1
3673 f70b 8d b4 BSR LBF38 CONVERT FPA0 TO AN INTEGER
3674 f70d 0f 62 CLR RESSGN SET RESULT SIGN = POSITIVE
3675 f70f 96 5c LDA FP1EXP *GET EXPONENT OF FPA1
3676 f711 d6 4f LDB FP0EXP *GET EXPONENT OF FPA0
3677 f713 bd f1 45 JSR LB9BC *SUBTRACT FPA0 FROM FPA1
3678 * NOW FPA0 CONTAINS ONLY THE FRACTIONAL PART OF ARGUMENT/2*PI
3679 f716 8e f7 47 LDX #LBFC2 POINT X TO FP (.25)
3680 f719 bd f1 42 JSR LB9B9 SUBTRACT FPA0 FROM .25 (PI/2)
3681 f71c 96 54 LDA FP0SGN GET MANTISSA SIGN OF FPA0
3682 f71e 34 02 PSHS A SAVE IT ON STACK
3683 f720 2a 09 BPL LBFA6 BRANCH IF MANTISSA POSITIVE
3684 f722 bd f1 3d JSR LB9B4 ADD .5 (PI) TO FPA0
3685 f725 96 54 LDA FP0SGN GET SIGN OF FPA0
3686 f727 2b 05 BMI LBFA9 BRANCH IF NEGATIVE
3687 f729 03 0a COM RELFLG COM IF +(3*PI)/2 >= ARGUMENT >+ PI/2 (QUADRANT FLAG)
3688 f72b bd f6 72 LBFA6 JSR LBEE9 TOGGLE MANTISSA SIGN OF FPA0
3689 f72e 8e f7 47 LBFA9 LDX #LBFC2 POINT X TO FP (.25)
3690 f731 bd f1 4b JSR LB9C2 ADD .25 (PI/2) TO FPA0
3691 f734 35 02 PULS A GET OLD MANTISSA SIGN
3692 f736 4d TSTA * BRANCH IF OLD
3693 f737 2a 03 BPL LBFB7 * SIGN WAS POSITIVE
3694 f739 bd f6 72 JSR LBEE9 TOGGLE MANTISSA SIGN
3695 f73c 8e f7 4c LBFB7 LDX #LBFC7 POINT X TO TABLE OF COEFFICIENTS
3696 f73f 7e f6 79 JMP LBEF0 GO CALCULATE POLYNOMIAL VALUE
3697
3698 f742 83 49 0f da a2 LBFBD FCB $83,$49,$0F,$DA,$A2 6.28318531 (2*PI)
3699 f747 7f 00 00 00 00 LBFC2 FCB $7F,$00,$00,$00,$00 .25
3700
3701
3702 f74c 05 LBFC7 FCB 6-1 SIX COEFFICIENTS
3703 f74d 84 e6 1a 2d 1b LBFC8 FCB $84,$E6,$1A,$2D,$1B * -((2*PI)**11)/11!
3704 f752 86 28 07 fb f8 LBFCD FCB $86,$28,$07,$FB,$F8 * ((2*PI)**9)/9!
3705 f757 87 99 68 89 01 LBFD2 FCB $87,$99,$68,$89,$01 * -((2*PI)**7)/7!
3706 f75c 87 23 35 df e1 LBFD7 FCB $87,$23,$35,$DF,$E1 * ((2*PI)**5)/5!
3707 f761 86 a5 5d e7 28 LBFDC FCB $86,$A5,$5D,$E7,$28 * -((2*PI)**3)/3!
3708 f766 83 49 0f da a2 LBFE1 FCB $83,$49,$0F,$DA,$A2 *
3709
3710 f76b a1 54 46 8f 13 FCB $A1,$54,$46,$8F,$13 UNUSED GARBAGE BYTES
3711 f770 8f 52 43 89 cd FCB $8F,$52,$43,$89,$CD UNUSED GARBAGE BYTES
3712 * EXTENDED BASIC
3713
3714 * COS
3715 * THE VALUE OF COS(X) IS DETERMINED BY THE TRIG IDENTITY COS(X)=SIN((PI/2)+X)
3716 f775 8e f7 a8 COS LDX #L83AB POINT X TO FP CONSTANT (P1/2)
3717 f778 bd f1 4b JSR LB9C2 ADD FPA0 TO (X)
3718 f77b 7e f6 fd L837E JMP SIN JUMP TO SIN ROUTINE
3719
3720 * TAN
3721 * THE VALUE OF TAN(X) IS DETERMINED BY THE TRIG IDENTITY TAN(X)=SIN(X)/COS(X)
3722 f77e bd f3 b8 TAN JSR LBC2F PACK FPA0 AND MOVE IT TO FPA3
3723 f781 0f 0a CLR RELFLG RESET QUADRANT FLAG
3724 f783 8d f6 BSR L837E CALCULATE SIN OF ARGUMENT
3725 f785 8e 00 4a LDX #V4A POINT X TO FPA5
3726 f788 bd f3 be JSR LBC35 PACK FPA0 AND MOVE IT TO FPA5
3727 f78b 8e 00 40 LDX #V40 POINT X TO FPA3
3728 f78e bd f3 9d JSR LBC14 MOVE FPA3 TO FPA0
3729 f791 0f 54 CLR FP0SGN FORCE FPA0 MANTISSA TO BE POSITIVE
3730 f793 96 0a LDA RELFLG GET THE QUADRANT FLAG - COS NEGATIVE IN QUADS 2,3
3731 f795 8d 0c BSR L83A6 CALCULATE VALUE OF COS(FPA0)
3732 f797 0d 4f TST FP0EXP CHECK EXPONENT OF FPA0
3733 f799 10 27 fa 7e LBEQ LBA92 <20>OV<4F> ERROR IF COS(X)=0
3734 f79d 8e 00 4a LDX #V4A POINT X TO FPA5
3735 f7a0 7e f3 18 L83A3 JMP LBB8F DIVIDE (X) BY FPA0 - SIN(X)/COS(X)
3736 f7a3 34 02 L83A6 PSHS A SAVE SIGN FLAG ON STACK
3737 f7a5 7e f7 2b JMP LBFA6 EXPAND POLYNOMIAL
3738
3739 f7a8 81 49 0f da a2 L83AB FCB $81,$49,$0F,$DA,$A2 1.57079633 (PI/2)
3740
3741 * ATN
3742 * A 12 TERM TAYLOR SERIES IS USED TO EVALUATE THE
3743 * ARCTAN EXPRESSION. TWO DIFFERENT FORMULI ARE USED
3744 * TO EVALUATE THE EXPRESSION DEPENDING UPON
3745 * WHETHER OR NOT THE ARGUMENT SQUARED IS > OR < 1.0
3746
3747 * IF X**2<1 THEN ATN=X-(X**3)/3+(X**5)/5-(X**7)/7. . .
3748 * IF X**2>=1 THEN ATN=PI/2-(1/X-1/((X**3)*3)+(1/((X**5)*5)-. . .)
3749
3750 f7ad 96 54 ATN LDA FP0SGN * GET THE SIGN OF THE MANTISSA AND
3751 f7af 34 02 PSHS A * SAVE IT ON THE STACK
3752 f7b1 2a 02 BPL L83B8 BRANCH IF POSITIVE MANTISSA
3753 f7b3 8d 24 BSR L83DC CHANGE SIGN OF FPA0
3754 f7b5 96 4f L83B8 LDA FP0EXP * GET EXPONENT OF FPA0 AND
3755 f7b7 34 02 PSHS A * SAVE IT ON THE STACK
3756 f7b9 81 81 CMPA #$81 IS FPAO < 1.0?
3757 f7bb 25 05 BLO L83C5 YES
3758 f7bd 8e f2 4e LDX #LBAC5 POINT X TO FP CONSTANT 1.0
3759 f7c0 8d de BSR L83A3 GET RECIPROCAL OF FPA0
3760 f7c2 8e f7 dd L83C5 LDX #L83E0 POINT (X) TO TAYLOR SERIES COEFFICIENTS
3761 f7c5 bd f6 79 JSR LBEF0 EXPAND POLYNOMIAL
3762 f7c8 35 02 PULS A GET EXPONENT OF ARGUMENT
3763 f7ca 81 81 CMPA #$81 WAS ARGUMENT < 1.0?
3764 f7cc 25 06 BLO L83D7 YES
3765 f7ce 8e f7 a8 LDX #L83AB POINT (X) TO FP NUMBER (PI/2)
3766 f7d1 bd f1 42 JSR LB9B9 SUBTRACT FPA0 FROM (PI/2)
3767 f7d4 35 02 L83D7 PULS A * GET SIGN OF INITIAL ARGUMENT MANTISSA
3768 f7d6 4d TSTA * AND SET FLAGS ACCORDING TO IT
3769 f7d7 2a 03 BPL L83DF RETURN IF ARGUMENT WAS POSITIVE
3770 f7d9 7e f6 72 L83DC JMP LBEE9 CHANGE MANTISSA SIGN OF FPA0
3771 f7dc 39 L83DF RTS
3772 *
3773 * TCHEBYSHEV MODIFIED TAYLOR SERIES COEFFICIENTS FOR ARCTANGENT
3774 f7dd 0b L83E0 FCB $0B TWELVE COEFFICIENTS
3775 f7de 76 b3 83 bd d3 L83E1 FCB $76,$B3,$83,$BD,$D3 -6.84793912E-04 1/23
3776 f7e3 79 1e f4 a6 f5 L83E6 FCB $79,$1E,$F4,$A6,$F5 +4.85094216E-03 1/21
3777 f7e8 7b 83 fc b0 10 L83EB FCB $7B,$83,$FC,$B0,$10 -0.0161117018
3778 f7ed 7c 0c 1f 67 ca L83F0 FCB $7C,$0C,$1F,$67,$CA 0.0342096381
3779 f7f2 7c de 53 cb c1 L83F5 FCB $7C,$DE,$53,$CB,$C1 -0.0542791328
3780 f7f7 7d 14 64 70 4c L83FA FCB $7D,$14,$64,$70,$4C 0.0724571965
3781 f7fc 7d b7 ea 51 7a L83FF FCB $7D,$B7,$EA,$51,$7A -0.0898023954
3782 f801 7d 63 30 88 7e L8404 FCB $7D,$63,$30,$88,$7E 0.110932413
3783 f806 7e 92 44 99 3a L8409 FCB $7E,$92,$44,$99,$3A -0.142839808
3784 f80b 7e 4c cc 91 c7 L840E FCB $7E,$4C,$CC,$91,$C7 0.199999121
3785 f810 7f aa aa aa 13 L8413 FCB $7F,$AA,$AA,$AA,$13 -0.333333316
3786 f815 81 00 00 00 00 L8418 FCB $81,$00,$00,$00,$00 1
3787 *
3788 *** TCHEBYSHEV MODIFIED TAYLOR SERIES COEFFICIENTS FOR LN(X)
3789 *
3790 f81a 03 L841D FCB 3 FOUR COEFFICIENTS
3791 f81b 7f 5e 56 cb 79 L841E FCB $7F,$5E,$56,$CB,$79 0.434255942
3792 f820 80 13 9b 0b 64 L8423 FCB $80,$13,$9B,$0B,$64 0.576584541
3793 f825 80 76 38 93 16 L8428 FCB $80,$76,$38,$93,$16 0.961800759
3794 f82a 82 38 aa 3b 20 L842D FCB $82,$38,$AA,$3B,$20 2.88539007
3795
3796 f82f 80 35 04 f3 34 L8432 FCB $80,$35,$04,$F3,$34 1/SQR(2)
3797
3798 f834 81 35 04 f3 34 L8437 FCB $81,$35,$04,$F3,$34 SQR(2)
3799
3800 f839 80 80 00 00 00 L843C FCB $80,$80,$00,$00,$00 -0.5
3801
3802 f83e 80 31 72 17 f8 L8441 FCB $80,$31,$72,$17,$F8 LN(2)
3803 *
3804 * LOG - NATURAL LOGARITHM (LN)
3805
3806 * THE NATURAL OR NAPERIAN LOGARITHM IS CALCULATED USING
3807 * MATHEMATICAL IDENTITIES. FPA0 IS OF THE FORM FPA0=A*(2**B) (SCIENTIFIC
3808 * NOTATION). THEREFORE, THE LOG ROUTINE DETERMINES THE VALUE OF
3809 * LN(A*(2**B)). A SERIES OF MATHEMATICAL IDENTITIES WILL EXPAND THIS
3810 * TERM: LN(A*(2**B))=(-1/2+(1/LN(2))*(LN(A*SQR(2)))+B)*LN(2). ALL OF
3811 * THE TERMS OF THE LATTER EXPRESSION ARE CONSTANTS EXCEPT FOR THE
3812 * LN(A*SQR(2)) TERM WHICH IS EVALUATED USING THE TAYLOR SERIES EXPANSION
3813 f843 bd f3 f6 LOG JSR LBC6D CHECK STATUS OF FPA0
3814 f846 10 2f f3 c7 LBLE LB44A <20>FC<46> ERROR IF NEGATIVE OR ZERO
3815 f84a 8e f8 2f LDX #L8432 POINT (X) TO FP NUMBER (1/SQR(2))
3816 f84d 96 4f LDA FP0EXP *GET EXPONENT OF ARGUMENT
3817 f84f 80 80 SUBA #$80 *SUBTRACT OFF THE BIAS AND
3818 f851 34 02 PSHS A *SAVE IT ON THE STACK
3819 f853 86 80 LDA #$80
3820 f855 97 4f STA FP0EXP
3821 f857 bd f1 4b JSR LB9C2 ADD FPA0 TO (X)
3822 f85a 8e f8 34 LDX #L8437 POINT X TO SQR(2)
3823 f85d bd f3 18 JSR LBB8F DIVIDE SQR(2) BY FPA0
3824 f860 8e f2 4e LDX #LBAC5 POINT X TO FP VALUE OF 1.00
3825 f863 bd f1 42 JSR LB9B9 SUBTRACT FPA0 FROM (X)
3826 * NOW FPA0 = (1-SQR(2)*X)/(1+SQR(2)*X) WHERE X IS ARGUMENT
3827 f866 8e f8 1a LDX #L841D POINT X TO TABLE OF COEFFICIENTS
3828 f869 bd f6 79 JSR LBEF0 EXPAND POLYNOMIAL
3829 f86c 8e f8 39 LDX #L843C POINT X TO FP VALUE OF (-.5)
3830 f86f bd f1 4b JSR LB9C2 ADD FPA0 TO X
3831 f872 35 04 PULS B GET EXPONENT OF ARGUMENT BACK (WITHOUT BIAS)
3832 f874 bd f5 22 JSR LBD99 ADD ACCB TO FPA0
3833 f877 8e f8 3e LDX #L8441 POINT X TO LN(2)
3834 f87a 7e f2 53 JMP LBACA MULTIPLY FPA0 * LN(2)
3835
3836 * SQR
3837 f87d bd f3 e8 SQR JSR LBC5F MOVE FPA0 TO FPA1
3838 f880 8e f6 49 LDX #LBEC0 POINT (X) TO FP NUMBER (.5)
3839 f883 bd f3 9d JSR LBC14 COPY A PACKED NUMBER FROM (X) TO FPA0
3840
3841 * ARITHMETIC OPERATOR FOR EXPONENTIATION JUMPS
3842 * HERE. THE FORMULA USED TO EVALUATE EXPONENTIATION
3843 * IS A**X=E**(X LN A) = E**(FPA0*LN(FPA1)), E=2.7182818
3844 f886 27 67 L8489 BEQ EXP DO A NATURAL EXPONENTIATION IF EXPONENT = 0
3845 f888 4d TSTA *CHECK VALUE BEING EXPONENTIATED
3846 f889 26 03 BNE L8491 *AND BRANCH IF IT IS <> 0
3847 f88b 7e f1 c3 JMP LBA3A FPA0=0 IF RAISING ZERO TO A POWER
3848 f88e 8e 00 4a L8491 LDX #V4A * PACK FPA0 AND SAVE
3849 f891 bd f3 be JSR LBC35 * IT IN FPA5 (ARGUMENT<4E>S EXPONENT)
3850 f894 5f CLRB ACCB=DEFAULT RESULT SIGN FLAG; 0=POSITIVE
3851 f895 96 61 LDA FP1SGN *CHECK THE SIGN OF ARGUMENT
3852 f897 2a 10 BPL L84AC *BRANCH IF POSITIVE
3853 f899 bd f4 77 JSR INT CONVERT EXPONENT INTO AN INTEGER
3854 f89c 8e 00 4a LDX #V4A POINT X TO FPA5 (ORIGINAL EXPONENT)
3855 f89f 96 61 LDA FP1SGN GET MANTISSA SIGN OF FPA1 (ARGUMENT)
3856 f8a1 bd f4 29 JSR LBCA0 *COMPARE FPA0 TO (X) AND
3857 f8a4 26 03 BNE L84AC *BRANCH IF NOT EQUAL
3858 f8a6 43 COMA TOGGLE FPA1 MANTISSA SIGN - FORCE POSITIVE
3859 f8a7 d6 01 LDB CHARAC GET LS BYTE OF INTEGER VALUE OF EXPONENT (RESULT SIGN FLAG)
3860 f8a9 bd f3 d5 L84AC JSR LBC4C COPY FPA1 TO FPA0; ACCA = MANTISSA SIGN
3861 f8ac 34 04 PSHS B PUT RESULT SIGN FLAG ON THE STACK
3862 f8ae bd f8 43 JSR LOG
3863 f8b1 8e 00 4a LDX #V4A POINT (X) TO FPA5
3864 f8b4 bd f2 53 JSR LBACA MULTIPLY FPA0 BY FPA5
3865 f8b7 8d 36 BSR EXP CALCULATE E**(FPA0)
3866 f8b9 35 02 PULS A * GET RESULT SIGN FLAG FROM THE STACK
3867 f8bb 46 RORA * AND BRANCH IF NEGATIVE
3868 f8bc 10 25 fd b2 LBCS LBEE9 CHANGE SIGN OF FPA0 MANTISSA
3869 f8c0 39 RTS
3870
3871 * CORRECTION FACTOR FOR EXPONENTIAL FUNCTION
3872 f8c1 81 38 aa 3b 29 L84C4 FCB $81,$38,$AA,$3B,$29 1.44269504 ( CF )
3873 *
3874 * TCHEBYSHEV MODIFIED TAYLOR SERIES COEFFICIENTS FOR E**X
3875 *
3876 f8c6 07 L84C9 FCB 7 EIGHT COEFFICIENTS
3877 f8c7 71 34 58 3e 56 L84CA FCB $71,$34,$58,$3E,$56 2.14987637E-05: 1/(7!*(CF**7))
3878 f8cc 74 16 7e b3 1b L84CF FCB $74,$16,$7E,$B3,$1B 1.4352314E-04 : 1/(6!*(CF**6))
3879 f8d1 77 2f ee e3 85 L84D4 FCB $77,$2F,$EE,$E3,$85 1.34226348E-03: 1/(5!*(CF**5))
3880 f8d6 7a 1d 84 1c 2a L84D9 FCB $7A,$1D,$84,$1C,$2A 9.61401701E-03: 1/(4!*(CF**4))
3881 f8db 7c 63 59 58 0a L84DE FCB $7C,$63,$59,$58,$0A 0.0555051269
3882 f8e0 7e 75 fd e7 c6 L84E3 FCB $7E,$75,$FD,$E7,$C6 0.240226385
3883 f8e5 80 31 72 18 10 L84E8 FCB $80,$31,$72,$18,$10 0.693147186
3884 f8ea 81 00 00 00 00 L84ED FCB $81,$00,$00,$00,$00 1
3885 *
3886 * EXP ( E**X)
3887 * THE EXPONENTIAL FUNCTION IS EVALUATED BY FIRST MULTIPLYING THE
3888 * ARGUMENT BY A CORRECTION FACTOR (CF). AFTER THIS IS DONE, AN
3889 * ARGUMENT >= 127 WILL YIELD A ZERO RESULT (NO UNDERFLOW) FOR A
3890 * NEGATIVE ARGUMENT OR AN 'OV' (OVERFLOW) ERROR FOR A POSITIVE
3891 * ARGUMENT. THE POLYNOMIAL COEFFICIENTS ARE MODIFIED TO REFLECT
3892 * THE CF MULTIPLICATION AT THE START OF THE EVALUATION PROCESS.
3893
3894 f8ef 8e f8 c1 EXP LDX #L84C4 POINT X TO THE CORRECTION FACTOR
3895 f8f2 bd f2 53 JSR LBACA MULTIPLY FPA0 BY (X)
3896 f8f5 bd f3 b8 JSR LBC2F PACK FPA0 AND STORE IT IN FPA3
3897 f8f8 96 4f LDA FP0EXP *GET EXPONENT OF FPA0 AND
3898 f8fa 81 88 CMPA #$88 *COMPARE TO THE MAXIMUM VALUE
3899 f8fc 25 03 BLO L8504 BRANCH IF FPA0 < 128
3900 f8fe 7e f2 e5 L8501 JMP LBB5C SET FPA0 = 0 OR <20>OV<4F> ERROR
3901 f901 bd f4 77 L8504 JSR INT CONVERT FPA0 TO INTEGER
3902 f904 96 01 LDA CHARAC GET LS BYTE OF INTEGER
3903 f906 8b 81 ADDA #$81 * WAS THE ARGUMENT =127, IF SO
3904 f908 27 f4 BEQ L8501 * THEN <20>OV<4F> ERROR; THIS WILL ALSO ADD THE $80 BIAS
3905 * * REQUIRED WHEN THE NEW EXPONENT IS CALCULATED BELOW
3906 f90a 4a DECA DECREMENT ONE FROM THE EXPONENT, BECAUSE $81, NOT $80 WAS USED ABOVE
3907 f90b 34 02 PSHS A SAVE EXPONENT OF INTEGER PORTION ON STACK
3908 f90d 8e 00 40 LDX #V40 POINT (X) TO FPA3
3909 f910 bd f1 42 JSR LB9B9 SUBTRACT FPA0 FROM (X) - GET FRACTIONAL PART OF ARGUMENT
3910 f913 8e f8 c6 LDX #L84C9 POINT X TO COEFFICIENTS
3911 f916 bd f6 88 JSR LBEFF EVALUATE POLYNOMIAL FOR FRACTIONAL PART
3912 f919 0f 62 CLR RESSGN FORCE THE MANTISSA TO BE POSITIVE
3913 f91b 35 02 PULS A GET INTEGER EXPONENT FROM STACK
3914 f91d bd f2 d1 JSR LBB48 * CALCULATE EXPONENT OF NEW FPA0 BY ADDING THE EXPONENTS OF THE
3915 * * INTEGER AND FRACTIONAL PARTS
3916 f920 39 RTS
3917
3918 * FIX
3919 f921 bd f3 f6 FIX JSR LBC6D CHECK STATUS OF FPA0
3920 f924 2b 03 BMI L852C BRANCH IF FPA0 = NEGATIVE
3921 f926 7e f4 77 L8529 JMP INT CONVERT FPA0 TO INTEGER
3922 f929 03 54 L852C COM FP0SGN TOGGLE SIGN OF FPA0 MANTISSA
3923 f92b 8d f9 BSR L8529 CONVERT FPA0 TO INTEGER
3924 f92d 7e f6 72 JMP LBEE9 TOGGLE SIGN OF FPA0
3925
3926 * EDIT
3927 f930 bd fd 5e EDIT JSR L89AE GET LINE NUMBER FROM BASIC
3928 f933 32 62 LEAS $02,S PURGE RETURN ADDRESS OFF OF THE STACK
3929 f935 86 01 L8538 LDA #$01 <20>LIST<53> FLAG
3930 f937 97 98 STA VD8 SET FLAG TO LIST LINE
3931 f939 bd e4 e5 JSR LAD01 GO FIND THE LINE NUMBER IN PROGRAM
3932 f93c 10 25 ed 82 LBCS LAED2 ERROR #7 <20>UNDEFINED LINE #'
3933 f940 bd ef 7e JSR LB7C2 GO UNCRUNCH LINE INTO BUFFER AT LINBUF+1
3934 f943 1f 20 TFR Y,D PUT ABSOLUTE ADDRESS OF END OF LINE TO ACCD
3935 f945 83 00 f5 SUBD #LINBUF+2 SUBTRACT OUT THE START OF LINE
3936 f948 d7 97 STB VD7 SAVE LENGTH OF LINE
3937 f94a dc 2b L854D LDD BINVAL GET THE HEX VALUE OF LINE NUMBER
3938 f94c bd f5 55 JSR LBDCC LIST THE LINE NUMBER ON THE SCREEN
3939 f94f bd f1 35 JSR LB9AC PRINT A SPACE
3940 f952 8e 00 f4 LDX #LINBUF+1 POINT X TO BUFFER
3941 f955 d6 98 LDB VD8 * CHECK TO SEE IF LINE IS TO BE
3942 f957 26 25 BNE L8581 * LISTED TO SCREEN - BRANCH IF IT IS
3943 f959 5f L855C CLRB RESET DIGIT ACCUMULATOR - DEFAULT VALUE
3944 f95a bd fa 84 L855D JSR L8687 GET KEY STROKE
3945 f95d bd ff b6 JSR L90AA SET CARRY IF NOT NUMERIC
3946 f960 25 0b BLO L8570 BRANCH IF NOT NUMERIC
3947 f962 80 30 SUBA #'0' MASK OFF ASCII
3948 f964 34 02 PSHS A SAVE IT ON STACK
3949 f966 86 0a LDA #10 NUMBER BEING CONVERTED IS BASE 10
3950 f968 3d MUL MULTIPLY ACCUMULATED VALUE BY BASE (10)
3951 f969 eb e0 ADDB ,S+ ADD DIGIT TO ACCUMULATED VALUE
3952 f96b 20 ed BRA L855D CHECK FOR ANOTHER DIGIT
3953 f96d c0 01 L8570 SUBB #$01 * REPEAT PARAMETER IN ACCB; IF IT
3954 f96f c9 01 ADCB #$01 *IS 0, THEN MAKE IT <20>1<EFBFBD>
3955 f971 81 41 CMPA #'A' ABORT?
3956 f973 26 05 BNE L857D NO
3957 f975 bd f0 e5 JSR LB958 PRINT CARRIAGE RETURN TO SCREEN
3958 f978 20 bb BRA L8538 RESTART EDIT PROCESS - CANCEL ALL CHANGES
3959 f97a 81 4c L857D CMPA #'L' LIST?
3960 f97c 26 0b BNE L858C NO
3961 f97e 8d 31 L8581 BSR L85B4 LIST THE LINE
3962 f980 0f 98 CLR VD8 RESET THE LIST FLAG TO <20>NO LIST<53>
3963 f982 bd f0 e5 JSR LB958 PRINT CARRIAGE RETURN
3964 f985 20 c3 BRA L854D GO INTERPRET ANOTHER EDIT COMMAND
3965 f987 32 62 L858A LEAS $02,S PURGE RETURN ADDRESS OFF OF THE STACK
3966 f989 81 0d L858C CMPA #CR ENTER KEY?
3967 f98b 26 0d BNE L859D NO
3968 f98d 8d 22 BSR L85B4 ECHO THE LINE TO THE SCREEN
3969 f98f bd f0 e5 L8592 JSR LB958 PRINT CARRIAGE RETURN
3970 f992 8e 00 f4 LDX #LINBUF+1 * RESET BASIC<49>S INPUT POINTER
3971 f995 9f 83 STX CHARAD * TO THE LINE INPUT BUFFER
3972 f997 7e e4 8e JMP LACA8 GO PUT LINE BACK IN PROGRAM
3973 f99a 81 45 L859D CMPA #'E' EXIT?
3974 f99c 27 f1 BEQ L8592 YES - SAME AS ENTER EXCEPT NO ECHO
3975 f99e 81 51 CMPA #'Q' QUIT?
3976 f9a0 26 06 BNE L85AB NO
3977 f9a2 bd f0 e5 JSR LB958 PRINT CARRIAGE RETURN TO SCREEN
3978 f9a5 7e e4 65 JMP LAC73 GO TO COMMAND LEVEL - MAKE NO CHANGES
3979 f9a8 8d 02 L85AB BSR L85AF INTERPRET THE REMAINING COMMANDS AS SUBROUTINES
3980 f9aa 20 ad BRA L855C GO INTERPRET ANOTHER EDIT COMMAND
3981 f9ac 81 20 L85AF CMPA #SPACE SPACE BAR?
3982 f9ae 26 10 BNE L85C3 NO
3983 f9b0 8c L85B3 FCB SKP2 SKIP TWO BYTES
3984 * DISPLAY THE NEXT ACCB BYTES OF THE LINE IN THE BUFFER TO THE SCREEN
3985 *
3986 f9b1 c6 f9 L85B4 LDB #LBUFMX-1 250 BYTES MAX IN BUFFER
3987 f9b3 a6 84 L85B6 LDA ,X GET A CHARACTER FROM BUFFER
3988 f9b5 27 08 BEQ L85C2 EXIT IF IT<49>S A 0
3989 f9b7 bd e0 14 JSR PUTCHR SEND CHAR TO CONSOLE OUT
3990 f9ba 30 01 LEAX $01,X MOVE POINTER UP ONE
3991 f9bc 5a DECB DECREMENT CHARACTER COUNTER
3992 f9bd 26 f4 BNE L85B6 LOOP IF NOT DONE
3993 f9bf 39 L85C2 RTS
3994 f9c0 81 44 L85C3 CMPA #'D' DELETE?
3995 f9c2 26 48 BNE L860F NO
3996 f9c4 6d 84 L85C7 TST ,X * CHECK FOR END OF LINE
3997 f9c6 27 f7 BEQ L85C2 * AND BRANCH IF SO
3998 f9c8 8d 04 BSR L85D1 REMOVE A CHARACTER
3999 f9ca 5a DECB DECREMENT REPEAT PARAMETER
4000 f9cb 26 f7 BNE L85C7 BRANCH IF NOT DONE
4001 f9cd 39 RTS
4002 * REMOVE ONE CHARACTER FROM BUFFER
4003 f9ce 0a 97 L85D1 DEC VD7 DECREMENT LENGTH OF BUFFER
4004 f9d0 31 1f LEAY $-01,X POINT Y TO ONE BEFORE CURRENT BUFFER POINTER
4005 f9d2 31 21 L85D5 LEAY $01,Y INCREMENT TEMPORARY BUFFER POINTER
4006 f9d4 a6 21 LDA $01,Y GET NEXT CHARACTER
4007 f9d6 a7 a4 STA ,Y PUT IT IN CURRENT POSITION
4008 f9d8 26 f8 BNE L85D5 BRANCH IF NOT END OF LINE
4009 f9da 39 RTS
4010 f9db 81 49 L85DE CMPA #'I' INSERT?
4011 f9dd 27 13 BEQ L85F5 YES
4012 f9df 81 58 CMPA #'X' EXTEND?
4013 f9e1 27 0d BEQ L85F3 YES
4014 f9e3 81 48 CMPA #'H' HACK?
4015 f9e5 26 5c BNE L8646 NO
4016 f9e7 6f 84 CLR ,X TURN CURRENT BUFFER POINTER INTO END OF LINE FLAG
4017 f9e9 1f 10 TFR X,D PUT CURRENT BUFFER POINTER IN ACCD
4018 f9eb 83 00 f5 SUBD #LINBUF+2 SUBTRACT INITIAL POINTER POSITION
4019 f9ee d7 97 STB VD7 SAVE NEW BUFFER LENGTH
4020 f9f0 8d bf L85F3 BSR L85B4 DISPLAY THE LINE ON THE SCREEN
4021 f9f2 bd fa 84 L85F5 JSR L8687 GET A KEYSTROKE
4022 f9f5 81 0d CMPA #CR ENTER KEY?
4023 f9f7 27 8e BEQ L858A YES - INTERPRET ANOTHER COMMAND - PRINT LINE
4024 f9f9 81 1b CMPA #ESC ESCAPE?
4025 f9fb 27 25 BEQ L8625 YES - RETURN TO COMMAND LEVEL - DON<4F>T PRINT LINE
4026 f9fd 81 08 CMPA #BS BACK SPACE?
4027 f9ff 26 22 BNE L8626 NO
4028 fa01 8c 00 f4 CMPX #LINBUF+1 COMPARE POINTER TO START OF BUFFER
4029 fa04 27 ec BEQ L85F5 DO NOT ALLOW BS IF AT START
4030 fa06 8d 45 BSR L8650 MOVE POINTER BACK ONE, BS TO SCREEN
4031 fa08 8d c4 BSR L85D1 REMOVE ONE CHARACTER FROM BUFFER
4032 fa0a 20 e6 BRA L85F5 GET INSERT SUB COMMAND
4033 fa0c 81 43 L860F CMPA #'C' CHANGE?
4034 fa0e 26 cb BNE L85DE NO
4035 fa10 6d 84 L8613 TST ,X CHECK CURRENT BUFFER CHARACTER
4036 fa12 27 0e BEQ L8625 BRANCH IF END OF LINE
4037 fa14 bd fa 84 JSR L8687 GET A KEYSTROKE
4038 fa17 25 02 BLO L861E BRANCH IF LEGITIMATE KEY
4039 fa19 20 f5 BRA L8613 TRY AGAIN IF ILLEGAL KEY
4040 fa1b a7 80 L861E STA ,X+ INSERT NEW CHARACTER INTO BUFFER
4041 fa1d 8d 37 BSR L8659 SEND NEW CHARACTER TO SCREEN
4042 fa1f 5a DECB DECREMENT REPEAT PARAMETER
4043 fa20 26 ee BNE L8613 BRANCH IF NOT DONE
4044 fa22 39 L8625 RTS
4045 fa23 d6 97 L8626 LDB VD7 GET LENGTH OF LINE
4046 fa25 c1 f9 CMPB #LBUFMX-1 COMPARE TO MAXIMUM LENGTH
4047 fa27 26 02 BNE L862E BRANCH IF NOT AT MAXIMUM
4048 fa29 20 c7 BRA L85F5 IGNORE INPUT IF LINE AT MAXIMUM LENGTH
4049 fa2b 34 10 L862E PSHS X SAVE CURRENT BUFFER POINTER
4050 fa2d 6d 80 L8630 TST ,X+ * SCAN THE LINE UNTIL END OF
4051 fa2f 26 fc BNE L8630 * LINE (0) IS FOUND
4052 fa31 e6 82 L8634 LDB ,-X DECR TEMP LINE POINTER AND GET A CHARACTER
4053 fa33 e7 01 STB $01,X PUT CHARACTER BACK DOWN ONE SPOT
4054 fa35 ac e4 CMPX ,S HAVE WE REACHED STARTING POINT?
4055 fa37 26 f8 BNE L8634 NO - KEEP GOING
4056 fa39 32 62 LEAS $02,S PURGE BUFFER POINTER FROM STACK
4057 fa3b a7 80 STA ,X+ INSERT NEW CHARACTER INTO THE LINE
4058 fa3d 8d 17 BSR L8659 SEND A CHARACTER TO CONSOLE OUT
4059 fa3f 0c 97 INC VD7 ADD ONE TO BUFFER LENGTH
4060 fa41 20 af BRA L85F5 GET INSERT SUB COMMAND
4061 fa43 81 08 L8646 CMPA #BS BACKSPACE?
4062 fa45 26 12 BNE L865C NO
4063 fa47 8d 04 L864A BSR L8650 MOVE POINTER BACK 1, SEND BS TO SCREEN
4064 fa49 5a DECB DECREMENT REPEAT PARAMETER
4065 fa4a 26 fb BNE L864A LOOP UNTIL DONE
4066 fa4c 39 RTS
4067 fa4d 8c 00 f4 L8650 CMPX #LINBUF+1 COMPARE POINTER TO START OF BUFFER
4068 fa50 27 d0 BEQ L8625 DO NOT ALLOW BS IF AT START
4069 fa52 30 1f LEAX $-01,X MOVE POINTER BACK ONE
4070 fa54 86 08 LDA #BS BACK SPACE
4071 fa56 7e e0 14 L8659 JMP PUTCHR SEND TO CONSOLE OUT
4072 fa59 81 4b L865C CMPA #'K' KILL?
4073 fa5b 27 05 BEQ L8665 YES
4074 fa5d 80 53 SUBA #'S' SEARCH?
4075 fa5f 27 01 BEQ L8665 YES
4076 fa61 39 RTS
4077 fa62 34 02 L8665 PSHS A SAVE KILL/SEARCH FLAG ON STACK
4078 fa64 8d 1e BSR L8687 * GET A KEYSTROKE (TARGET CHARACTER)
4079 fa66 34 02 PSHS A * AND SAVE IT ON STACK
4080 fa68 a6 84 L866B LDA ,X GET CURRENT BUFFER CHARACTER
4081 fa6a 27 16 BEQ L8685 AND RETURN IF END OF LINE
4082 fa6c 6d 61 TST $01,S CHECK KILL/SEARCH FLAG
4083 fa6e 26 06 BNE L8679 BRANCH IF KILL
4084 fa70 8d e4 BSR L8659 SEND A CHARACTER TO CONSOLE OUT
4085 fa72 30 01 LEAX $01,X INCREMENT BUFFER POINTER
4086 fa74 20 03 BRA L867C CHECK NEXT INPUT CHARACTER
4087 fa76 bd f9 ce L8679 JSR L85D1 REMOVE ONE CHARACTER FROM BUFFER
4088 fa79 a6 84 L867C LDA ,X GET CURRENT INPUT CHARACTER
4089 fa7b a1 e4 CMPA ,S COMPARE TO TARGET CHARACTER
4090 fa7d 26 e9 BNE L866B BRANCH IF NO MATCH
4091 fa7f 5a DECB DECREMENT REPEAT PARAMETER
4092 fa80 26 e6 BNE L866B BRANCH IF NOT DONE
4093 fa82 35 a0 L8685 PULS Y,PC THE Y PULL WILL CLEAN UP THE STACK FOR THE 2 PSHS A
4094 *
4095 * GET A KEYSTRKE
4096 fa84 bd e0 00 L8687 JSR LA171 CALL CONSOLE IN : DEV NBR=SCREEN
4097 fa87 81 7f CMPA #$7F GRAPHIC CHARACTER?
4098 fa89 24 f9 BCC L8687 YES - GET ANOTHER CHAR
4099 fa8b 81 5f CMPA #$5F SHIFT UP ARROW (QUIT INSERT)
4100 fa8d 26 02 BNE L8694 NO
4101 fa8f 86 1b LDA #ESC REPLACE W/ESCAPE CODE
4102 fa91 81 0d L8694 CMPA #CR ENTER KEY
4103 fa93 27 0e BEQ L86A6 YES
4104 fa95 81 1b CMPA #ESC ESCAPE?
4105 fa97 27 0a BEQ L86A6 YES
4106 fa99 81 08 CMPA #BS BACKSPACE?
4107 fa9b 27 06 BEQ L86A6 YES
4108 fa9d 81 20 CMPA #SPACE SPACE
4109 fa9f 25 e3 BLO L8687 GET ANOTHER CHAR IF CONTROL CHAR
4110 faa1 1a 01 ORCC #$01 SET CARRY
4111 faa3 39 L86A6 RTS
4112
4113 * TRON
4114 faa4 86 TRON FCB SKP1LD SKIP ONE BYTE AND LDA #$4F
4115
4116 * TROFF
4117 faa5 4f TROFF CLRA TROFF FLAG
4118 faa6 97 8c STA TRCFLG TRON/TROFF FLAG:0=TROFF, <> 0=TRON
4119 faa8 39 RTS
4120
4121 * POS
4122
4123 faa9 86 00 POS LDA #0 GET DEVICE NUMBER
4124 faab d6 79 LDB LPTPOS GET PRINT POSITION
4125 faad 1d LA5E8 SEX CONVERT ACCB TO 2 DIGIT SIGNED INTEGER
4126 faae 7e ec bb JMP GIVABF CONVERT ACCD TO FLOATING POINT
4127
4128
4129 * VARPTR
4130 fab1 bd ea 36 VARPT JSR LB26A SYNTAX CHECK FOR <20>(<28>
4131 fab4 dc 1f LDD ARYEND GET ADDR OF END OF ARRAYS
4132 fab6 34 06 PSHS B,A SAVE IT ON STACK
4133 fab8 bd eb 1e JSR LB357 GET VARIABLE DESCRIPTOR
4134 fabb bd ea 33 JSR LB267 SYNTAX CHECK FOR <20>)<29>
4135 fabe 35 06 PULS A,B GET END OF ARRAYS ADDR BACK
4136 fac0 1e 10 EXG X,D SWAP END OF ARRAYS AND VARIABLE DESCRIPTOR
4137 fac2 9c 1f CMPX ARYEND COMPARE TO NEW END OF ARRAYS
4138 fac4 26 51 BNE L8724 <20>FC<46> ERROR IF VARIABLE WAS NOT DEFINED PRIOR TO CALLING VARPTR
4139 fac6 7e ec bb JMP GIVABF CONVERT VARIABLE DESCRIPTOR INTO A FP NUMBER
4140
4141 * MID$(OLDSTRING,POSITION,LENGTH)=REPLACEMENT
4142 fac9 9d 7c L86D6 JSR GETNCH GET INPUT CHAR FROM BASIC
4143 facb bd ea 36 JSR LB26A SYNTAX CHECK FOR <20>(<28>
4144 face bd eb 1e JSR LB357 * GET VARIABLE DESCRIPTOR ADDRESS AND
4145 fad1 34 10 PSHS X * SAVE IT ON THE STACK
4146 fad3 ec 02 LDD $02,X POINT ACCD TO START OF OLDSTRING
4147 fad5 10 93 21 CMPD FRETOP COMPARE TO START OF CLEARED SPACE
4148 fad8 23 04 BLS L86EB BRANCH IF <=
4149 fada 93 27 SUBD MEMSIZ SUBTRACT OUT TOP OF CLEARED SPACE
4150 fadc 23 12 BLS L86FD BRANCH IF STRING IN STRING SPACE
4151 fade e6 84 L86EB LDB ,X GET LENGTH OF OLDSTRING
4152 fae0 bd ed 34 JSR LB56D RESERVE ACCB BYTES IN STRING SPACE
4153 fae3 34 10 PSHS X SAVE RESERVED SPACE STRING ADDRESS ON STACK
4154 fae5 ae 62 LDX $02,S POINT X TO OLDSTRING DESCRIPTOR
4155 fae7 bd ee 0a JSR LB643 MOVE OLDSTRING INTO STRING SPACE
4156 faea 35 50 PULS X,U * GET OLDSTRING DESCRIPTOR ADDRESS AND RESERVED STRING
4157 faec af 42 STX $02,U * ADDRESS AND SAVE RESERVED ADDRESS AS OLDSTRING ADDRESS
4158 faee 34 40 PSHS U SAVE OLDSTRING DESCRIPTOR ADDRESS
4159 faf0 bd ee ff L86FD JSR LB738 SYNTAX CHECK FOR COMMA AND EVALUATE LENGTH EXPRESSION
4160 faf3 34 04 PSHS B SAVE POSITION PARAMETER ON STACK
4161 faf5 5d TSTB * CHECK POSITION PARAMETER AND BRANCH
4162 faf6 27 1f BEQ L8724 * IF START OF STRING
4163 faf8 c6 ff LDB #$FF DEFAULT REPLACEMENT LENGTH = $FF
4164 fafa 81 29 CMPA #')' * CHECK FOR END OF MID$ STATEMENT AND
4165 fafc 27 03 BEQ L870E * BRANCH IF AT END OF STATEMENT
4166 fafe bd ee ff JSR LB738 SYNTAX CHECK FOR COMMA AND EVALUATE LENGTH EXPRESSION
4167 fb01 34 04 L870E PSHS B SAVE LENGTH PARAMETER ON STACK
4168 fb03 bd ea 33 JSR LB267 SYNTAX CHECK FOR <20>)<29>
4169 fb06 c6 ae LDB #TOK_EQUALS TOKEN FOR =
4170 fb08 bd ea 3b JSR LB26F SYNTAX CHECK FOR <20>=<3D>
4171 fb0b 8d 2e BSR L8748 EVALUATE REPLACEMENT STRING
4172 fb0d 1f 13 TFR X,U SAVE REPLACEMENT STRING ADDRESS IN U
4173 fb0f ae 62 LDX $02,S POINT X TO OLOSTRING DESCRIPTOR ADDRESS
4174 fb11 a6 84 LDA ,X GET LENGTH OF OLDSTRING
4175 fb13 a0 61 SUBA $01,S SUBTRACT POSITION PARAMETER
4176 fb15 24 03 BCC L8727 INSERT REPLACEMENT STRING INTO OLDSTRING
4177 fb17 7e ec 11 L8724 JMP LB44A <20>FC<46> ERROR IF POSITION > LENGTH OF OLDSTRING
4178 fb1a 4c L8727 INCA * NOW ACCA = NUMBER OF CHARACTERS TO THE RIGHT
4179 * * (INCLUSIVE) OF THE POSITION PARAMETER
4180 fb1b a1 e4 CMPA ,S
4181 fb1d 24 02 BCC L872E BRANCH IF NEW STRING WILL FIT IN OLDSTRING
4182 fb1f a7 e4 STA ,S IF NOT, USE AS MUCH OF LENGTH PARAMETER AS WILL FIT
4183 fb21 a6 61 L872E LDA $01,S GET POSITION PARAMETER
4184 fb23 1e 89 EXG A,B ACCA=LENGTH OF REPL STRING, ACCB=POSITION PARAMETER
4185 fb25 ae 02 LDX $02,X POINT X TO OLDSTRING ADDRESS
4186 fb27 5a DECB * BASIC<49>S POSITION PARAMETER STARTS AT 1; THIS ROUTINE
4187 * * WANTS IT TO START AT ZERO
4188 fb28 3a ABX POINT X TO POSITION IN OLDSTRING WHERE THE REPLACEMENT WILL GO
4189 fb29 4d TSTA * IF THE LENGTH OF THE REPLACEMENT STRING IS ZERO
4190 fb2a 27 0d BEQ L8746 * THEN RETURN
4191 fb2c a1 e4 CMPA ,S
4192 fb2e 23 02 BLS L873F ADJUSTED LENGTH PARAMETER, THEN BRANCH
4193 fb30 a6 e4 LDA ,S OTHERWISE USE AS MUCH ROOM AS IS AVAILABLE
4194 fb32 1f 89 L873F TFR A,B SAVE NUMBER OF BYTES TO MOVE IN ACCB
4195 fb34 1e 31 EXG U,X SWAP SOURCE AND DESTINATION POINTERS
4196 fb36 bd e1 f1 JSR LA59A MOVE (B) BYTES FROM (X) TO (U)
4197 fb39 35 96 L8746 PULS A,B,X,PC
4198 fb3b bd e9 22 L8748 JSR LB156 EVALUATE EXPRESSION
4199 fb3e 7e ee 1b JMP LB654 *<2A>TM<54> ERROR IF NUMERIC; RETURN WITH X POINTING
4200 * *TO STRING, ACCB = LENGTH
4201
4202 * STRING
4203 fb41 bd ea 36 STRING JSR LB26A SYNTAX CHECK FOR <20>(<28>
4204 fb44 bd ee d2 JSR LB70B EVALUATE EXPRESSION; ERROR IF > 255
4205 fb47 34 04 PSHS B SAVE LENGTH OF STRING
4206 fb49 bd ea 39 JSR LB26D SYNTAX CHECK FOR COMMA
4207 fb4c bd e9 22 JSR LB156 EVALUATE EXPRESSION
4208 fb4f bd ea 33 JSR LB267 SYNTAX CHECK FOR <20>)<29>
4209 fb52 96 06 LDA VALTYP GET VARIABLE TYPE
4210 fb54 26 05 BNE L8768 BRANCH IF STRING
4211 fb56 bd ee d5 JSR LB70E CONVERT FPA0 INTO AN INTEGER IN ACCB
4212 fb59 20 03 BRA L876B SAVE THE STRING IN STRING SPACE
4213 fb5b bd ee 6b L8768 JSR LB6A4 GET FIRST BYTE OF STRING
4214 fb5e 34 04 L876B PSHS B SAVE FIRST BYTE OF EXPRESSION
4215 fb60 e6 61 LDB $01,S GET LENGTH OF STRING
4216 fb62 bd ec d6 JSR LB50F RESERVE ACCB BYTES IN STRING SPACE
4217 fb65 35 06 PULS A,B GET LENGTH OF STRING AND CHARACTER
4218 fb67 27 05 BEQ L877B BRANCH IF NULL STRING
4219 fb69 a7 80 L8776 STA ,X+ SAVE A CHARACTER IN STRING SPACE
4220 fb6b 5a DECB DECREMENT LENGTH
4221 fb6c 26 fb BNE L8776 BRANCH IF NOT DONE
4222 fb6e 7e ee 62 L877B JMP LB69B PUT STRING DESCRIPTOR ONTO STRING STACK
4223
4224 * INSTR
4225 fb71 bd ea 36 INSTR JSR LB26A SYNTAX CHECK FOR <20>(<28>
4226 fb74 bd e9 22 JSR LB156 EVALUATE EXPRESSION
4227 fb77 c6 01 LDB #$01 DEFAULT POSITION = 1 (SEARCH START)
4228 fb79 34 04 PSHS B SAVE START
4229 fb7b 96 06 LDA VALTYP GET VARIABLE TYPE
4230 fb7d 26 10 BNE L879C BRANCH IF STRING
4231 fb7f bd ee d5 JSR LB70E CONVERT FPA0 TO INTEGER IN ACCB
4232 fb82 e7 e4 STB ,S SAVE START SEARCH VALUE
4233 fb84 27 91 BEQ L8724 BRANCH IF START SEARCH AT ZERO
4234 fb86 bd ea 39 JSR LB26D SYNTAX CHECK FOR COMMA
4235 fb89 bd e9 22 JSR LB156 EVALUATE EXPRESSION - SEARCH STRING
4236 fb8c bd e9 12 JSR LB146 <20>TM<54> ERROR IF NUMERIC
4237 fb8f 9e 52 L879C LDX FPA0+2 SEARCH STRING DESCRIPTOR ADDRESS
4238 fb91 34 10 PSHS X SAVE ON THE STACK
4239 fb93 bd ea 39 JSR LB26D SYNTAX CHECK FOR COMMA
4240 fb96 bd fb 3b JSR L8748 EVALUATE TARGET STRING EXPRESSION
4241 fb99 34 14 PSHS X,B SAVE ADDRESS AND LENGTH ON STACK
4242 fb9b bd ea 33 JSR LB267 SYNTAX CHECK FOR ')'
4243 fb9e ae 63 LDX $03,S * LOAD X WITH SEARCH STRING DESCRIPTOR ADDRESS
4244 fba0 bd ee 20 JSR LB659 * AND GET THE LENGTH ANDADDRESS OF SEARCH STRING
4245 fba3 34 04 PSHS B SAVE LENGTH ON STACK
4246 *
4247 * AT THIS POINT THE STACK HAS THE FOLLOWING INFORMATION
4248 * ON IT: 0,S-SEARCH LENGTH; 1,S-TARGET LENGTH; 2 3,S-TARGET
4249 * ADDRESS; 4 5,S-SEARCH DESCRIPTOR ADDRESS; 6,S-SEARCH POSITION
4250 fba5 e1 66 CMPB $06,S COMPARE LENGTH OF SEARCH STRING TO START
4251 fba7 25 23 BLO L87D9 POSITION; RETURN 0 IF LENGTH < START
4252 fba9 a6 61 LDA $01,S GET LENGTH OF TARGET STRING
4253 fbab 27 1c BEQ L87D6 BRANCH IF TARGET STRING = NULL
4254 fbad e6 66 LDB $06,S GET START POSITION
4255 fbaf 5a DECB MOVE BACK ONE
4256 fbb0 3a ABX POINT X TO POSITION IN SEARCH STRING WHERE SEARCHING WILL START
4257 fbb1 31 84 L87BE LEAY ,X POINT Y TO SEARCH POSITION
4258 fbb3 ee 62 LDU $02,S POINT U TO START OF TARGET
4259 fbb5 e6 61 LDB $01,S LOAD ACCB WITH LENGTH OF TARGET
4260 fbb7 a6 e4 LDA ,S LOAD ACCA WITH LENGTH OF SEARCH
4261 fbb9 a0 66 SUBA $06,S SUBTRACT SEARCH POSITION FROM SEARCH LENGTH
4262 fbbb 4c INCA ADD ONE
4263 fbbc a1 61 CMPA $01,S COMPARE TO TARGET LENGTH
4264 fbbe 25 0c BLO L87D9 RETURN 0 IF TARGET LENGTH > WHAT<41>S LEFT OF SEARCH STRING
4265 fbc0 a6 80 L87CD LDA ,X+ GET A CHARACTER FROM SEARCH STRING
4266 fbc2 a1 c0 CMPA ,U+ COMPARE IT TO TARGET STRING
4267 fbc4 26 0c BNE L87DF BRANCH IF NO MATCH
4268 fbc6 5a DECB DECREMENT TARGET LENGTH
4269 fbc7 26 f7 BNE L87CD CHECK ANOTHER CHARACTER
4270 fbc9 e6 66 L87D6 LDB $06,S GET MATCH POSITION
4271 fbcb 21 L87D8 FCB SKP1 SKIP NEXT BYTE
4272 fbcc 5f L87D9 CLRB MATCH ADDRESS = 0
4273 fbcd 32 67 LEAS $07,S CLEAN UP THE STACK
4274 fbcf 7e ec ba JMP LB4F3 CONVERT ACCB TO FP NUMBER
4275 fbd2 6c 66 L87DF INC $06,S INCREMENT SEARCH POSITION
4276 fbd4 30 21 LEAX $01,Y MOVE X TO NEXT SEARCH POSITION
4277 fbd6 20 d9 BRA L87BE KEEP LOOKING FOR A MATCH
4278
4279 * EXTENDED BASIC RVEC19 HOOK CODE
4280 fbd8 81 26 XVEC19 CMPA #'&' *
4281 fbda 26 5c BNE L8845 * RETURN IF NOT HEX OR OCTAL VARIABLE
4282 fbdc 32 62 LEAS $02,S PURGE RETURN ADDRESS FROM STACK
4283 * PROCESS A VARIABLE PRECEEDED BY A <20>&<26> (&H,&O)
4284 fbde 0f 52 L87EB CLR FPA0+2 * CLEAR BOTTOM TWO
4285 fbe0 0f 53 CLR FPA0+3 * BYTES OF FPA0
4286 fbe2 8e 00 52 LDX #FPA0+2 BYTES 2,3 OF FPA0 = (TEMPORARY ACCUMULATOR)
4287 fbe5 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
4288 fbe7 81 4f CMPA #'O'
4289 fbe9 27 12 BEQ L880A YES
4290 fbeb 81 48 CMPA #'H'
4291 fbed 27 23 BEQ L881F YES
4292 fbef 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4293 fbf1 20 0c BRA L880C DEFAULT TO OCTAL (&O)
4294 fbf3 81 38 L8800 CMPA #'8'
4295 fbf5 10 22 ee 4a LBHI LB277
4296 fbf9 c6 03 LDB #$03 BASE 8 MULTIPLIER
4297 fbfb 8d 2a BSR L8834 ADD DIGIT TO TEMPORARY ACCUMULATOR
4298 * EVALUATE AN &O VARIABLE
4299 fbfd 9d 7c L880A JSR GETNCH GET A CHARACTER FROM BASIC
4300 fbff 25 f2 L880C BLO L8800 BRANCH IF NUMERIC
4301 fc01 0f 50 L880E CLR FPA0 * CLEAR 2 HIGH ORDER
4302 fc03 0f 51 CLR FPA0+1 * BYTES OF FPA0
4303 fc05 0f 06 CLR VALTYP SET VARXABLE TYPE TO NUMERIC
4304 fc07 0f 63 CLR FPSBYT ZERO OUT SUB BYTE OF FPA0
4305 fc09 0f 54 CLR FP0SGN ZERO OUT MANTISSA SIGN OF FPA0
4306 fc0b c6 a0 LDB #$A0 * SET EXPONENT OF FPA0
4307 fc0d d7 4f STB FP0EXP *
4308 fc0f 7e f1 a5 JMP LBA1C GO NORMALIZE FPA0
4309 * EVALUATE AN &H VARIABLE
4310 fc12 9d 7c L881F JSR GETNCH GET A CHARACTER FROM BASIC
4311 fc14 25 0b BLO L882E BRANCH IF NUMERIC
4312 fc16 bd eb 69 JSR LB3A2 SET CARRY IF NOT ALPHA
4313 fc19 25 e6 BLO L880E BRANCH IF NOT ALPHA OR NUMERIC
4314 fc1b 81 47 CMPA #'G' CHECK FOR LETTERS A-F
4315 fc1d 24 e2 BCC L880E BRANCH IF >= G (ILLEGAL HEX LETTER)
4316 fc1f 80 07 SUBA #7 SUBTRACT ASCII DIFFERENCE BETWEEN A AND 9
4317 fc21 c6 04 L882E LDB #$04 BASE 16 DIGIT MULTIPLIER = 2**4
4318 fc23 8d 02 BSR L8834 ADD DIGIT TO TEMPORARY ACCUMULATOR
4319 fc25 20 eb BRA L881F KEEP EVALUATING VARIABLE
4320 fc27 68 01 L8834 ASL $01,X * MULTIPLY TEMPORARY
4321 fc29 69 84 ROL ,X * ACCUMULATOR BY TWO
4322 fc2b 10 25 f5 ec LBCS LBA92 <20>OV' OVERFLOW ERROR
4323 fc2f 5a DECB DECREMENT SHIFT COUNTER
4324 fc30 26 f5 BNE L8834 MULTIPLY TEMPORARY ACCUMULATOR AGAIN
4325 fc32 80 30 SUBA #'0' MASK OFF ASCII
4326 fc34 ab 01 ADDA $01,X * ADD DIGIT TO TEMPORARY
4327 fc36 a7 01 STA $01,X * ACCUMULATOR AND SAVE IT
4328 fc38 39 L8845 RTS
4329
4330 fc39 35 40 XVEC15 PULS U PULL RETURN ADDRESS AND SAVE IN U REGISTER
4331 fc3b 0f 06 CLR VALTYP SET VARIABLE TYPE TO NUMERIC
4332 fc3d 9e 83 LDX CHARAD CURRENT INPUT POINTER TO X
4333 fc3f 9d 7c JSR GETNCH GET CHARACTER FROM BASIC
4334 fc41 81 26 CMPA #'&' HEX AND OCTAL VARIABLES ARE PRECEEDED BY &
4335 fc43 27 99 BEQ L87EB PROCESS A <20>&<26> VARIABLE
4336 fc45 81 b0 CMPA #TOK_FN TOKEN FOR FN
4337 fc47 27 5e BEQ L88B4 PROCESS FN CALL
4338 fc49 81 ff CMPA #$FF CHECK FOR SECONDARY TOKEN
4339 fc4b 26 08 BNE L8862 NOT SECONDARY
4340 fc4d 9d 7c JSR GETNCH GET CHARACTER FROM BASIC
4341 fc4f 81 83 CMPA #TOK_USR TOKEN FOR USR
4342 fc51 10 27 00 ab LBEQ L892C PROCESS USR CALL
4343 fc55 9f 83 L8862 STX CHARAD RESTORE BASIC<49>S INPUT POINTER
4344 fc57 6e c4 JMP ,U RETURN TO CALLING ROUTINE
4345 fc59 9e 68 L8866 LDX CURLIN GET CURRENT LINE NUMBER
4346 fc5b 30 01 LEAX $01,X IN DIRECT MODE?
4347 fc5d 26 d9 BNE L8845 RETURN IF NOT IN DIRECT MODE
4348 fc5f c6 16 LDB #2*11 <20>ILLEGAL DIRECT STATEMENT<4E> ERROR
4349 fc61 7e e4 46 L886E JMP LAC46 PROCESS ERROR
4350
4351 fc64 ae 9f 00 83 DEF LDX [CHARAD] GET TWO INPUT CHARS
4352 fc68 8c ff 83 CMPX #TOK_FF_USR TOKEN FOR USR
4353 fc6b 10 27 00 74 LBEQ L890F BRANCH IF DEF USR
4354 fc6f 8d 23 BSR L88A1 GET DESCRIPTOR ADDRESS FOR FN VARIABLE NAME
4355 fc71 8d e6 BSR L8866 DON<4F>T ALLOW DEF FN IF IN DIRECT MODE
4356 fc73 bd ea 36 JSR LB26A SYNTAX CHECK FOR <20>(<28>
4357 fc76 c6 80 LDB #$80 * GET THE FLAG TO INDICATE ARRAY VARIABLE SEARCH DISABLE
4358 fc78 d7 08 STB ARYDIS * AND SAVE IT IN THE ARRAY DISABLE FLAG
4359 fc7a bd eb 1e JSR LB357 GET VARIABLE DESCRIPTOR
4360 fc7d 8d 25 BSR L88B1 <20>TM<54> ERROR IF STRING
4361 fc7f bd ea 33 JSR LB267 SYNTAX CHECK FOR <20>)<29>
4362 fc82 c6 ae LDB #TOK_EQUALS TOKEN FOR <20>=<3D>
4363 fc84 bd ea 3b JSR LB26F DO A SYNTAX CHECK FOR =
4364 fc87 9e 4b LDX V4B GET THE ADDRESS OF THE FN NAME DESCRIPTOR
4365 fc89 dc 83 LDD CHARAD * GET THE CURRENT INPUT POINTER ADDRESS AND
4366 fc8b ed 84 STD ,X * SAVE IT IN FIRST 2 BYTES OF THE DESCRIPTOR
4367 fc8d dc 39 LDD VARPTR = GET THE DESCRIPTOR ADDRESS OF THE ARGUMENT
4368 fc8f ed 02 STD $02,X = VARIABLE AND SAVE IT IN THE DESCRIPTOR OF THE FN NAME
4369 fc91 7e e6 d0 JMP DATA MOVE INPUT POINTER TO END OF LINE OR SUBLINE
4370 fc94 c6 b0 L88A1 LDB #TOK_FN TOKEN FOR FN
4371 fc96 bd ea 3b JSR LB26F DO A SYNTAX CHECK FOR FN
4372 fc99 c6 80 LDB #$80 * GET THE FLAG TO INDICATE ARRAY VARIABLE SEARCH DISABLE FLAG
4373 fc9b d7 08 STB ARYDIS * AND SAVE IT IN ARRAY VARIABLE FLAG
4374 fc9d 8a 80 ORA #$80 SET BIT 7 OF CURRENT INPUT CHARACTER TO INDICATE AN FN VARIABLE
4375 fc9f bd eb 23 JSR LB35C * GET THE DESCRIPTOR ADDRESS OF THIS
4376 fca2 9f 4b STX V4B * VARIABLE AND SAVE IT IN V4B
4377 fca4 7e e9 0f L88B1 JMP LB143 <20>TM<54> ERROR IF STRING VARIABLE
4378 * EVALUATE AN FN CALL
4379 fca7 8d eb L88B4 BSR L88A1 * GET THE DESCRIPTOR OF THE FN NAME
4380 fca9 34 10 PSHS X * VARIABLE AND SAVE IT ON THE STACK
4381 fcab bd ea 2e JSR LB262 SYNTAX CHECK FOR <20>(<28> & EVALUATE EXPR
4382 fcae 8d f4 BSR L88B1 <20>TM<54> ERROR IF STRING VARIABLE
4383 fcb0 35 40 PULS U POINT U TO FN NAME DESCRIPTOR
4384 fcb2 c6 32 LDB #2*25 <20>UNDEFINED FUNCTION CALL<4C> ERROR
4385 fcb4 ae 42 LDX $02,U POINT X TO ARGUMENT VARIABLE DESCRIPTOR
4386 fcb6 27 a9 BEQ L886E BRANCH TO ERROR HANDLER
4387 fcb8 10 9e 83 LDY CHARAD SAVE CURRENT INPUT POINTER IN Y
4388 fcbb ee c4 LDU ,U * POINT U TO START OF FN FORMULA AND
4389 fcbd df 83 STU CHARAD * SAVE IT IN INPUT POINTER
4390 fcbf a6 04 LDA $04,X = GET FP VALUE OF
4391 fcc1 34 02 PSHS A = ARGUMENT VARIABLE, CURRENT INPUT
4392 fcc3 ec 84 LDD ,X = POINTER, AND ADDRESS OF START
4393 fcc5 ee 02 LDU $02,X = OF FN FORMULA AND SAVE
4394 fcc7 34 76 PSHS U,Y,X,B,A = THEM ON THE STACK
4395 fcc9 bd f3 be JSR LBC35 PACK FPA0 AND SAVE IT IN (X)
4396 fccc bd e9 0d L88D9 JSR LB141 EVALUATE FN EXPRESSION
4397 fccf 35 76 PULS A,B,X,Y,U RESTORE REGISTERS
4398 fcd1 ed 84 STD ,X * GET THE FP
4399 fcd3 ef 02 STU $02,X * VALUE OF THE ARGUMENT
4400 fcd5 35 02 PULS A * VARIABLE OFF OF THE
4401 fcd7 a7 04 STA $04,X * STACK AND RE-SAVE IT
4402 fcd9 9d 82 JSR GETCCH GET FINAL CHARACTER OF THE FN FORMULA
4403 fcdb 10 26 ed 64 LBNE LB277 <20>SYNTAX<41> ERROR IF NOT END OF LINE
4404 fcdf 10 9f 83 STY CHARAD RESTORE INPUT POINTER
4405 fce2 39 L88EF RTS
4406
4407
4408
4409 * DEF USR
4410 fce3 9d 7c L890F JSR GETNCH SKIP PAST SECOND BYTE OF DEF USR TOKEN
4411 fce5 8d 09 BSR L891C GET FN NUMBER
4412 fce7 34 10 PSHS X SAVE FN EXEC ADDRESS STORAGE LOC
4413 fce9 8d 2d BSR L8944 CALCULATE EXEC ADDRESS
4414 fceb 35 40 PULS U GET FN EXEC ADDRESS STORAGE LOC
4415 fced af c4 STX ,U SAVE EXEC ADDRESS
4416 fcef 39 RTS
4417 fcf0 5f L891C CLRB DEFAULT TO USR0 IF NO ARGUMENT
4418 fcf1 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
4419 fcf3 24 06 BCC L8927 BRANCH IF NOT NUMERIC
4420 fcf5 80 30 SUBA #'0' MASK OFF ASCII
4421 fcf7 1f 89 TFR A,B SAVE USR NUMBER IN ACCB
4422 fcf9 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
4423 fcfb 9e 8d L8927 LDX USRADR GET ADDRESS OF STORAGE LOCs FOR USR ADDRESS
4424 fcfd 58 ASLB X2 - 2 BYTES/USR ADDRESS
4425 fcfe 3a ABX ADD OFFSET TO START ADDRESS OF STORAGE LOCs
4426 fcff 39 RTS
4427 * PROCESS A USR CALL
4428 fd00 8d ee L892C BSR L891C GET STORAGE LOC OF EXEC ADDRESS FOR USR N
4429 fd02 ae 84 LDX ,X * GET EXEC ADDRESS AND
4430 fd04 34 10 PSHS X * PUSH IT ONTO STACK
4431 fd06 bd ea 2e JSR LB262 SYNTAX CHECK FOR <20>(<28> & EVALUATE EXPR
4432 fd09 8e 00 4f LDX #FP0EXP POINT X TO FPA0
4433 fd0c 96 06 LDA VALTYP GET VARIABLE TYPE
4434 fd0e 27 07 BEQ L8943 BRANCH IF NUMERIC, STRING IF <> 0
4435 fd10 bd ee 1e JSR LB657 GET LENGTH & ADDRESS OF STRING VARIABLE
4436 fd13 9e 52 LDX FPA0+2 GET POINTER TO STRING DESCRIPTOR
4437 fd15 96 06 LDA VALTYP GET VARIABLE TYPE
4438 fd17 39 L8943 RTS JUMP TO USR ROUTINE (PSHS X ABOVE)
4439 fd18 c6 ae L8944 LDB #TOK_EQUALS TOKEN FOR <20>=<3D>
4440 fd1a bd ea 3b JSR LB26F DO A SYNTAX CHECK FOR =
4441 fd1d 7e ef 04 JMP LB73D EVALUATE EXPRESSION, RETURN VALUE IN X
4442
4443
4444
4445 * DEL
4446 fd20 10 27 ee ed DEL LBEQ LB44A FC<46> ERROR IF NO ARGUMENT
4447 fd24 bd e7 57 JSR LAF67 CONVERT A DECIMAL BASiC NUMBER TO BINARY
4448 fd27 bd e4 e5 JSR LAD01 FIND RAM ADDRESS OF START OF A BASIC LINE
4449 fd2a 9f 93 STX VD3 SAVE RAM ADDRESS OF STARTING LINE NUMBER
4450 fd2c 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4451 fd2e 27 10 BEQ L8990 BRANCH IF END OF LINE
4452 fd30 81 a7 CMPA #TOK_MINUS TOKEN FOR <20>-'
4453 fd32 26 3b BNE L89BF TERMINATE COMMAND IF LINE NUMBER NOT FOLLOWED BY <20>-<2D>
4454 fd34 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
4455 fd36 27 04 BEQ L898C IF END OF LINE, USE DEFAULT ENDING LINE NUMBER
4456 fd38 8d 24 BSR L89AE * CONVERT ENDING LINE NUMBER TO BINARY
4457 fd3a 20 04 BRA L8990 * AND SAVE IT IN BINVAL
4458 fd3c 86 ff L898C LDA #$FF = USE $FFXX AS DEFAULT ENDING
4459 fd3e 97 2b STA BINVAL = LINE NUMBER - SAVE IT IN BINVAL
4460 fd40 de 93 L8990 LDU VD3 POINT U TO STARTING LINE NUMBER ADDRESS
4461 fd42 8c L8992 FCB SKP2 SKIP TWO BYTES
4462 fd43 ee c4 L8993 LDU ,U POINT U TO START OF NEXT LINE
4463 fd45 ec c4 LDD ,U CHECK FOR END OF PROGRAM
4464 fd47 27 06 BEQ L899F BRANCH IF END OF PROGRAM
4465 fd49 ec 42 LDD $02,U LOAD ACCD WITH THIS LINE<4E>S NUMBER
4466 fd4b 93 2b SUBD BINVAL SUBTRACT ENDING LINE NUMBER ADDRESS
4467 fd4d 23 f4 BLS L8993 BRANCH IF = < ENDING LINE NUMBER
4468 fd4f 9e 93 L899F LDX VD3 GET STARTING LINE NUMBER
4469 fd51 8d 15 BSR L89B8 MOVE (U) TO (X) UNTIL END OF PROGRAM
4470 fd53 bd e5 05 JSR LAD21 RESET BASIC<49>S INPUT POINTER AND ERASE VARIABLES
4471 fd56 9e 93 LDX VD3 GET STARTING LINE NUMBER ADDRESS
4472 fd58 bd e4 d5 JSR LACF1 RECOMPUTE START OF NEXT LINE ADDRESSES
4473 fd5b 7e e4 65 JMP LAC73 JUMP TO BASIC<49>S MAIN COMMAND LOOP
4474 fd5e bd e7 57 L89AE JSR LAF67 GO GET LINE NUMBER CONVERTED TO BINARY
4475 fd61 7e e1 fa JMP LA5C7 MAKE SURE THERE<52>S NO MORE ON THIS LINE
4476 fd64 a6 c0 L89B4 LDA ,U+ GET A BYTE FROM (U)
4477 fd66 a7 80 STA ,X+ MOVE THE BYTE TO (X)
4478 fd68 11 93 1b L89B8 CMPU VARTAB COMPARE TO END OF BASIC
4479 fd6b 26 f7 BNE L89B4 BRANCH IF NOT AT END
4480 fd6d 9f 1b STX VARTAB SAVE (X) AS NEW END OF BASIC
4481 fd6f 39 L89BF RTS
4482
4483
4484 fd70 bd fc 59 L89C0 JSR L8866 <20>BS<42> ERROR IF IN DIRECT MODE
4485 fd73 9d 7c JSR GETNCH GET A CHAR FROM BASIC
4486 fd75 81 22 L89D2 CMPA #'"' CHECK FOR PROMPT STRING
4487 fd77 26 0b BNE L89E1 BRANCH IF NO PROMPT STRING
4488 fd79 bd ea 10 JSR LB244 STRIP OFF PROMPT STRING & PUT IT ON STRING STACK
4489 fd7c c6 3b LDB #';' *
4490 fd7e bd ea 3b JSR LB26F * DO A SYNTAX CHECK FOR;
4491 fd81 bd f1 28 JSR LB99F REMOVE PROMPT STRING FROM STRING STACK & SEND TO CONSOLE OUT
4492 fd84 32 7e L89E1 LEAS $-02,S RESERVE TWO STORAGE SLOTS ON STACK
4493 fd86 bd e8 0c JSR LB035 INPUT A LINE FROM CURRENT INPUT DEVICE
4494 fd89 32 62 LEAS $02,S CLEAN UP THE STACK
4495 fd8b bd eb 1e JSR LB357 SEARCH FOR A VARIABLE
4496 fd8e 9f 3b STX VARDES SAVE POINTER TO VARIABLE DESCRIPTOR
4497 fd90 bd e9 12 JSR LB146 <20>TM<54> ERROR IF VARIABLE TYPE = NUMERIC
4498 fd93 8e 00 f3 LDX #LINBUF POINT X TO THE STRING BUFFER WHERE THE INPUT STRING WAS STORED
4499 fd96 4f CLRA TERMINATOR CHARACTER 0 (END OF LINE)
4500 fd97 bd ec e3 JSR LB51A PARSE THE INPUT STRING AND STORE IT IN THE STRING SPACE
4501 fd9a 7e e7 94 JMP LAFA4 REMOVE DESCRIPTOR FROM STRING STACK
4502 fd9d bd e7 57 L89FC JSR LAF67 STRIP A DECIMAL NUMBER FROM BASIC INPUT LINE
4503 fda0 9e 2b LDX BINVAL GET BINARY VALUE
4504 fda2 39 RTS
4505 fda3 9e 91 L8A02 LDX VD1 GET CURRENT OLD NUMBER BEING RENUMBERED
4506 fda5 9f 2b L8A04 STX BINVAL SAVE THE LINE NUMBER BEING SEARCHED FOR
4507 fda7 7e e4 e5 JMP LAD01 GO FIND THE LINE NUMBER IN BASIC PROGRAM
4508
4509 * RENUM
4510 fdaa bd e5 0a RENUM JSR LAD26 ERASE VARIABLES
4511 fdad cc 00 0a LDD #10 DEFAULT LINE NUMBER INTERVAL
4512 fdb0 dd 95 STD VD5 SAVE DEFAULT RENUMBER START LINE NUMBER
4513 fdb2 dd 8f STD VCF SAVE DEFAULT INTERVAL
4514 fdb4 5f CLRB NOW ACCD = 0
4515 fdb5 dd 91 STD VD1 DEFAULT LINE NUMBER OF WHERE TO START RENUMBERING
4516 fdb7 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4517 fdb9 24 06 BCC L8A20 BRANCH IF NOT NUMERIC
4518 fdbb 8d e0 BSR L89FC CONVERT DECIMAL NUMBER IN BASIC PROGRAM TO BINARY
4519 fdbd 9f 95 STX VD5 SAVE LINE NUMBER WHERE RENUMBERING STARTS
4520 fdbf 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4521 fdc1 27 1b L8A20 BEQ L8A3D BRANCH IF END OF LINE
4522 fdc3 bd ea 39 JSR LB26D SYNTAX CHECK FOR COMMA
4523 fdc6 24 06 BCC L8A2D BRANCH IF NEXT CHARACTER NOT NUMERIC
4524 fdc8 8d d3 BSR L89FC CONVERT DECIMAL NUMBER IN BASIC PROGRAM TO BINARY
4525 fdca 9f 91 STX VD1 SAVE NEW RENUMBER LINE
4526 fdcc 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4527 fdce 27 0e L8A2D BEQ L8A3D BRANCH IF END OF LINE
4528 fdd0 bd ea 39 JSR LB26D SYNTAX CHECK FOR COMMA
4529 fdd3 24 06 BCC L8A3A BRANCH IF NEXT CHARACTER NOT NUMERIC
4530 fdd5 8d c6 BSR L89FC CONVERT DECIMAL NUMBER IN BASIC PROGRAM TO BINARY
4531 fdd7 9f 8f STX VCF SAVE NEW INTERVAL
4532 fdd9 27 49 BEQ L8A83 <20>FC' ERROR
4533 fddb bd e1 fa L8A3A JSR LA5C7 CHECK FOR MORE CHARACTERS ON LINE - <20>SYNTAX<41> ERROR IF ANY
4534 fdde 8d c3 L8A3D BSR L8A02 GO GET ADDRESS OF OLD NUMBER BEING RENUMBERED
4535 fde0 9f 93 STX VD3 SAVE ADDRESS
4536 fde2 9e 95 LDX VD5 GET NEXT RENUMBERED LINE NUMBER TO USE
4537 fde4 8d bf BSR L8A04 FIND THE LINE NUMBER IN THE BASIC PROGRAM
4538 fde6 9c 93 CMPX VD3 COMPARE TO ADDRESS OF OLD LINE NUMBER
4539 fde8 25 3a BLO L8A83 <20>FC<46> ERROR IF NEW ADDRESS < OLD ADDRESS
4540 fdea 8d 1c BSR L8A67 MAKE SURE RENUMBERED LINE NUMBERS WILL BE IN RANGE
4541 fdec bd fe 7e JSR L8ADD CONVERT ASCII LINE NUMBERS TO <20>EXPANDED<45> BINARY
4542 fdef bd e4 d3 JSR LACEF RECALCULATE NEXT LINE RAM ADDRESSES
4543 fdf2 8d af BSR L8A02 GET RAM ADDRESS OF FIRST LINE TO BE RENUMBERED
4544 fdf4 9f 93 STX VD3 SAVE IT
4545 fdf6 8d 3a BSR L8A91 MAKE SURE LINE NUMBERS EXIST
4546 fdf8 8d 0f BSR L8A68 INSERT NEW LINE NUMBERS IN LINE HEADERS
4547 fdfa 8d 36 BSR L8A91 INSERT NEW LINE NUMBERS IN PROGRAM STATEMENTS
4548 fdfc bd ff 19 JSR L8B7B CONVERT PACKED BINARY LINE NUMBERS TO ASCII
4549 fdff bd e5 0a JSR LAD26 ERASE VARIABLES
4550 fe02 bd e4 d3 JSR LACEF RECALCULATE NEXT LINE RAM ADDRESS
4551 fe05 7e e4 65 JMP LAC73 GO BACK TO BASIC<49>S MAIN LOOP
4552 fe08 86 L8A67 FCB SKP1LD SKIP ONE BYTE - LDA #$4F
4553 fe09 4f L8A68 CLRA NEW LINE NUMBER FLAG - 0; INSERT NEW LINE NUMBERS
4554 fe0a 97 98 STA VD8 SAVE NEW LINE NUMBER FLAG; 0 = INSERT NEW NUMBERS
4555 fe0c 9e 93 LDX VD3 GET ADDRESS OF OLD LINE NUMBER BEING RENUMBERED
4556 fe0e dc 95 LDD VD5 GET THE CURRENT RENUMBERED LINE NUMBER
4557 fe10 8d 15 BSR L8A86 RETURN IF END OF PROGRAM
4558 fe12 0d 98 L8A71 TST VD8 CHECK NEW LINE NUMBER FLAG
4559 fe14 26 02 BNE L8A77 BRANCH IF NOT INSERTING NEW LINE NUMBERS
4560 fe16 ed 02 STD $02,X STORE THE NEW LINE NUMBER IN THE BASIC PROGRAM
4561 fe18 ae 84 L8A77 LDX ,X POINT X TO THE NEXT LINE IN BASIC
4562 fe1a 8d 0b BSR L8A86 RETURN IF END OF PROGRAM
4563 fe1c d3 8f ADDD VCF ADD INTERVAL TO CURRENT RENUMBERED LINE NUMBER
4564 fe1e 25 04 BLO L8A83 <20>FC<46> ERROR IF LINE NUMBER > $FFFF
4565 fe20 81 fa CMPA #MAXLIN LARGEST LINE NUMBER = $F9FF
4566 fe22 25 ee BLO L8A71 BRANCH IF LEGAL LINE NUMBER
4567 fe24 7e ec 11 L8A83 JMP LB44A <20>FC<46> ERROR IF LINE NUMBER MS BYTE > $F9
4568 * TEST THE TWO BYTES POINTED TO BY (X).
4569 * NORMAL RETURN IF <> 0. IF = 0 (END OF
4570 * PROGRAM) RETURN IS PULLED OFF STACK AND
4571 * YOU RETURN TO PREVIOUS SUBROUTINE CALL.
4572 fe27 34 06 L8A86 PSHS B,A SAVE ACCD
4573 fe29 ec 84 LDD ,X TEST THE 2 BYTES POINTED TO BY X
4574 fe2b 35 06 PULS A,B RESTORE ACCD
4575 fe2d 26 02 BNE L8A90 BRANCH IF NOT END OF PROGRAM
4576 fe2f 32 62 LEAS $02,S PURGE RETURN ADDRESS FROM STACK
4577 fe31 39 L8A90 RTS
4578 fe32 9e 19 L8A91 LDX TXTTAB GET START OF BASIC PROGRAM
4579 fe34 30 1f LEAX $-01,X MOVE POINTER BACK ONE
4580 fe36 30 01 L8A95 LEAX $01,X MOVE POINTER UP ONE
4581 fe38 8d ed BSR L8A86 RETURN IF END OF PROGRAM
4582 fe3a 30 03 L8A99 LEAX $03,X SKIP OVER NEXT LINE ADDRESS AND LINE NUMBER
4583 fe3c 30 01 L8A9B LEAX $01,X MOVE POINTER TO NEXT CHARACTER
4584 fe3e a6 84 LDA ,X CHECK CURRENT CHARACTER
4585 fe40 27 f4 BEQ L8A95 BRANCH IF END OF LINE
4586 fe42 9f 0f STX TEMPTR SAVE CURRENT POINTER
4587 fe44 4a DECA =
4588 fe45 27 0c BEQ L8AB2 =BRANCH IF START OF PACKED NUMERIC LINE
4589 fe47 4a DECA *
4590 fe48 27 2a BEQ L8AD3 *BRANCH IF LINE NUMBER EXISTS
4591 fe4a 4a DECA =
4592 fe4b 26 ef BNE L8A9B =MOVE TO NEXT CHARACTER IF > 3
4593 fe4d 86 03 L8AAC LDA #$03 * SET 1ST BYTE = 3 TO INDICATE LINE
4594 fe4f a7 80 STA ,X+ * NUMBER DOESN<53>T CURRENTLY EXIST
4595 fe51 20 e7 BRA L8A99 GO GET ANOTHER CHARACTER
4596 fe53 ec 01 L8AB2 LDD $01,X GET MS BYTE OF LINE NUMBER
4597 fe55 6a 02 DEC $02,X DECREMENT ZERO CHECK BYTE
4598 fe57 27 01 BEQ L8AB9 BRANCH IF MS BYTE <> 0
4599 fe59 4f CLRA CLEAR MS BYTE
4600 fe5a e6 03 L8AB9 LDB $03,X GET LS BYTE OF LINE NUMBER
4601 fe5c 6a 04 DEC $04,X DECREMENT ZERO CHECK FLAG
4602 fe5e 27 01 BEQ L8AC0 BRANCH IF IS BYTE <> 0
4603 fe60 5f CLRB CLEAR LS BYTE
4604 fe61 ed 01 L8AC0 STD $01,X SAVE BINARY LINE NUMBER
4605 fe63 dd 2b STD BINVAL SAVE TRIAL LINE NUMBER
4606 fe65 bd e4 e5 JSR LAD01 FIND RAM ADDRESS OF A BASIC LINE NUMBER
4607 fe68 9e 0f L8AC7 LDX TEMPTR GET BACK POINTER TO START OF PACKED LINE NUMBER
4608 fe6a 25 e1 BLO L8AAC BRANCH IF NO LINE NUMBER MATCH FOUND
4609 fe6c dc 47 LDD V47 GET START ADDRESS OF LINE NUMBER
4610 fe6e 6c 80 INC ,X+ * SET 1ST BYTE = 2, TO INDICATE LINE NUMBER EXISTS IF CHECKING FOR
4611 * * EXISTENCE OF LINE NUMBER, SET IT = 1 IF INSERTING LINE NUMBERS
4612
4613 fe70 ed 84 STD ,X SAVE RAM ADDRESS OF CORRECT LINE NUMBER
4614 fe72 20 c6 BRA L8A99 GO GET ANOTHER CHARACTER
4615 fe74 6f 84 L8AD3 CLR ,X CLEAR CARRY FLAG AND 1ST BYTE
4616 fe76 ae 01 LDX $01,X POINT X TO RAM ADDRESS OF CORRECT LINE NUMBER
4617 fe78 ae 02 LDX $02,X PUT CORRECT LINE NUMBER INTO (X)
4618 fe7a 9f 47 STX V47 SAVE IT TEMPORARILY
4619 fe7c 20 ea BRA L8AC7 GO INSERT IT INTO BASIC LINE
4620 fe7e 9e 19 L8ADD LDX TXTTAB GET BEGINNING OF BASIC PROGRAM
4621 fe80 20 04 BRA L8AE5
4622 fe82 9e 83 L8AE1 LDX CHARAD *GET CURRENT INPUT POINTER
4623 fe84 30 01 LEAX $01,X *AND BUMP IT ONE
4624 fe86 8d 9f L8AE5 BSR L8A86 RETURN IF END OF PROGRAM
4625 fe88 30 02 LEAX $02,X SKIP PAST NEXT LINE ADDRESS
4626 fe8a 30 01 L8AE9 LEAX $01,X ADVANCE POINTER BY ONE
4627 fe8c 9f 83 L8AEB STX CHARAD SAVE NEW BASIC INPUT POINTER
4628 fe8e 9d 7c L8AED JSR GETNCH GET NEXT CHARACTER FROM BASIC
4629 fe90 4d L8AEF TSTA CHECK THE CHARACTER
4630 fe91 27 ef BEQ L8AE1 BRANCH IF END OF LINE
4631 fe93 2a f9 BPL L8AED BRANCH IF NOT A TOKEN
4632 fe95 9e 83 LDX CHARAD GET CURRENT INPUT POINTER
4633 fe97 81 ff CMPA #$FF IS THIS A SECONDARY TOKEN?
4634 fe99 27 ef BEQ L8AE9 YES - IGNORE IT
4635 fe9b 81 a2 CMPA #TOK_THEN TOKEN FOR THEN?
4636 fe9d 27 12 BEQ L8B13 YES
4637 fe9f 81 84 CMPA #TOK_ELSE TOKEN FOR ELSE?
4638 fea1 27 0e BEQ L8B13 YES
4639 fea3 81 81 CMPA #TOK_GO TOKEN FOR GO?
4640 fea5 26 e7 BNE L8AED NO
4641 fea7 9d 7c JSR GETNCH GET A CHARACTER FROM BASIC
4642 fea9 81 a0 CMPA #TOK_TO TOKEN FOR TO?
4643 feab 27 04 BEQ L8B13 YES
4644 fead 81 a1 CMPA #TOK_SUB TOKEN FOR SUB?
4645 feaf 26 db BNE L8AEB NO
4646 feb1 9d 7c L8B13 JSR GETNCH GET A CHARACTER FROM BASIC
4647 feb3 25 04 BLO L8B1B BRANCH IF NUMERIC
4648 feb5 9d 82 L8B17 JSR GETCCH GET CURRENT BASIC INPUT CHARRACTER
4649 feb7 20 d7 BRA L8AEF KEEP CHECKING THE LINE
4650 feb9 9e 83 L8B1B LDX CHARAD GET CURRENT INPUT ADDRESS
4651 febb 34 10 PSHS X SAVE IT ON THE STACK
4652 febd bd e7 57 JSR LAF67 CONVERT DECIMAL BASIC NUMBER TO BINARY
4653 fec0 9e 83 LDX CHARAD GET CURRENT INPUT POINTER
4654 fec2 a6 82 L8B24 LDA ,-X GET PREVIOUS INPUT CHARACTER
4655 fec4 bd ff b6 JSR L90AA CLEAR CARRY IF NUMERIC INPUT VALUE
4656 fec7 25 f9 BLO L8B24 BRANCH IF NON-NUMERIC
4657 fec9 30 01 LEAX $01,X MOVE POINTER UP ONE
4658 fecb 1f 10 TFR X,D NOW ACCD POINTS TO ONE PAST END OF LINE NUMBER
4659 fecd e0 61 SUBB $01,S SUBTRACT PRE-NUMERIC POINTER LS BYTE
4660 fecf c0 05 SUBB #$05 MAKE SURE THERE ARE AT LEAST 5 CHARACTERS IN THE NUMERIC LINE
4661 *
4662 fed1 27 20 BEQ L8B55 BRANCH IF EXACTLY 5
4663 fed3 25 0a BLO L8B41 BRANCH IF < 5
4664 fed5 33 84 LEAU ,X TRANSFER X TO U
4665 fed7 50 NEGB NEGATE B
4666 fed8 30 85 LEAX B,X MOVE X BACK B BYTES
4667 feda bd fd 68 JSR L89B8 *MOVE BYTES FROM (U) TO (X) UNTIL
4668 * *U = END OF BASIC; (I) = NEW END OF BASIC
4669 fedd 20 14 BRA L8B55
4670 * FORCE FIVE BYTES OF SPACE FOR THE LINE NUMBER
4671 fedf 9f 47 L8B41 STX V47 SAVE END OF NUMERIC VALUE
4672 fee1 9e 1b LDX VARTAB GET END OF BASIC PROGRAM
4673 fee3 9f 43 STX V43 SAVE IT
4674 fee5 50 NEGB NEGATE B
4675 fee6 30 85 LEAX B,X ADD IT TO END OF NUMERIC POiNTER
4676 fee8 9f 41 STX V41 SAVE POINTER
4677 feea 9f 1b STX VARTAB STORE END OF BASIC PROGRAM
4678 feec bd e4 1e JSR LAC1E ACCD = TOP OF ARRAYS - CHECK FOR ENOUGH ROOM
4679 feef 9e 45 LDX V45 * GET AND SAVE THE
4680 fef1 9f 83 STX CHARAD * NEW CURRENT INPUT POINTER
4681 fef3 35 10 L8B55 PULS X RESTORE POINTER TO START OF NUMERIC VALUE
4682 fef5 86 01 LDA #$01 NEW LINE NUMBER FLAG
4683 fef7 a7 84 STA ,X * SAVE NEW LINE FLAG
4684 fef9 a7 02 STA $02,X *
4685 fefb a7 04 STA $04,X *
4686 fefd d6 2b LDB BINVAL GET MS BYTE OF BINARY LINE NUMBER
4687 feff 26 04 BNE L8B67 BRANCH IF IT IS NOT ZERO
4688 ff01 c6 01 LDB #$01 SAVE A 1 IF BYTE IS 0; OTHERWISE, BASIC WILL
4689 * THINK IT IS THE END OF A LINE
4690 ff03 6c 02 INC $02,X IF 2,X = 2, THEN PREVIOUS BYTE WAS A ZERO
4691 ff05 e7 01 L8B67 STB $01,X SAVE MS BYTE OF BINARY LINE NUMBER
4692 ff07 d6 2c LDB BINVAL+1 GET IS BYTE OF BINARY LINE NUMBER
4693 ff09 26 04 BNE L8B71 BRANCH IF NOT A ZERO BYTE
4694 ff0b c6 01 LDB #$01 SAVE A 1 IF BYTE IS A 0
4695 ff0d 6c 04 INC $04,X IF 4,X = 2, THEN PREVIOUS BYTE WAS A 0
4696 ff0f e7 03 L8B71 STB $03,X SAVE LS BYTE OF BINARY LINE NUMBER
4697 ff11 9d 82 JSR GETCCH GET CURRENT INPUT CHARACTER
4698 ff13 81 2c CMPA #',' IS IT A COMMA?
4699 ff15 27 9a BEQ L8B13 YES - PROCESS ANOTHER NUMERIC VALUE
4700 ff17 20 9c BRA L8B17 NO - GO GET AND PROCESS AN INPUT CHARACTER
4701 ff19 9e 19 L8B7B LDX TXTTAB POINT X TO START OF BASIC PROGRAM
4702 ff1b 30 1f LEAX $-01,X MOVE POINTER BACK ONE
4703 ff1d 30 01 L8B7F LEAX $01,X MOVE POINTER UP ONE
4704 ff1f ec 02 LDD $02,X GET ADDRESS OF NEXT LINE
4705 ff21 dd 68 STD CURLIN SAVE IT IN CURLIN
4706 ff23 bd fe 27 JSR L8A86 RETURN IF END OF PROGRAM
4707 ff26 30 03 LEAX $03,X SKIP OVER ADDRESS OF NEXT LINE AND 1ST BYTE OF LINE NUMBER
4708 ff28 30 01 L8B8A LEAX $01,X MOVE POINTER UP ONE
4709 ff2a a6 84 L8B8C LDA ,X GET CURRENT CHARACTER
4710 ff2c 27 ef BEQ L8B7F BRANCH IF END OF LINE
4711 ff2e 4a DECA INPUT CHARACTER = 1? - VALID LINE NUMBER
4712 ff2f 27 1b BEQ L8BAE YES
4713 ff31 80 02 SUBA #$02 INPUT CHARACTER 3? - UL LINE NUMBER
4714 ff33 26 f3 BNE L8B8A NO
4715 ff35 34 10 PSHS X SAVE CURRENT POSITION OF INPUT POINTER
4716 ff37 8e ff 76 LDX #L8BD9-1 POINT X TO <20>UL<55> MESSAGE
4717 ff3a bd f1 25 JSR LB99C PRINT STRING TO THE SCREEN
4718 ff3d ae e4 LDX ,S GET INPUT POINTER
4719 ff3f ec 01 LDD $01,X GET THE UNDEFINED LINE NUMBER
4720 ff41 bd f5 55 JSR LBDCC CONVERT NUMBER IN ACCD TO DECIMAL AND DISPLAY IT
4721 ff44 bd f5 4e JSR LBDC5 PRINT <20>IN XXXX<58> XXXX = CURRENT LINE NUMBER
4722 ff47 bd f0 e5 JSR LB958 SEND A CR TO CONSOLE OUT
4723 ff4a 35 10 PULS X GET INPUT POINTER BACK
4724 ff4c 34 10 L8BAE PSHS X SAVE CURRENT POSITION OF INPUT POINTER
4725 ff4e ec 01 LDD $01,X LOAD ACCD WITH BINARY VALUE OF LINE NUMBER
4726 ff50 dd 52 STD FPA0+2 SAVE IN BOTTOM 2 BYTES OF FPA0
4727 ff52 bd fc 01 JSR L880E ADJUST REST OF FPA0 AS AN INTEGER
4728 ff55 bd f5 62 JSR LBDD9 CONVERT FPA0 TO ASCII, STORE IN LINE NUMBER
4729 ff58 35 40 PULS U LOAD U WITH PREVIOUS ADDRESS OF INPUT POINTER
4730 ff5a c6 05 LDB #$05 EACH EXPANDED LINE NUMBER USES 5 BYTES
4731 ff5c 30 01 L8BBE LEAX $01,X MOVE POINTER FORWARD ONE
4732 ff5e a6 84 LDA ,X GET AN ASCII BYTE
4733 ff60 27 05 BEQ L8BC9 BRANCH IF END OF NUMBER
4734 ff62 5a DECB DECREMENT BYTE COUNTER
4735 ff63 a7 c0 STA ,U+ STORE ASCII NUMBER IN BASIC LINE
4736 ff65 20 f5 BRA L8BBE CHECK FOR ANOTHER DIGIT
4737 ff67 30 c4 L8BC9 LEAX ,U TRANSFER NEW LINE POINTER TO (X)
4738 ff69 5d TSTB DOES THE NEW LINE NUMBER REQUIRE 5 BYTES?
4739 ff6a 27 be BEQ L8B8C YES - GO GET ANOTHER INPUT CHARACTER
4740 ff6c 31 c4 LEAY ,U SAVE NEW LINE POINTER IN Y
4741 ff6e 33 c5 LEAU B,U POINT U TO END OF 5 BYTE PACKED LINE NUMBER BLOCK
4742 ff70 bd fd 68 JSR L89B8 MOVE BYTES FROM (U) TO (X) UNTIL END OF PROGRAM
4743 ff73 30 a4 LEAX ,Y LOAD (X) WITH NEW LINE POINTER
4744 ff75 20 b3 BRA L8B8C GO GET ANOTHER INPUT CHARACTER
4745
4746 ff77 55 4c 20 L8BD9 FCC "UL " UNKNOWN LINE NUMBER MESSAGE
4747 ff7a 00 FCB 0
4748
4749
4750 ff7b bd ef 07 HEXDOL JSR LB740 CONVERT FPA0 INTO A POSITIVE 2 BYTE INTEGER
4751 ff7e 8e 01 f0 LDX #STRBUF+2 POINT TO TEMPORARY BUFFER
4752 ff81 c6 04 LDB #$04 CONVERT 4 NIBBLES
4753 ff83 34 04 L8BE5 PSHS B SAVE NIBBLE COUNTER
4754 ff85 5f CLRB CLEAR CARRY FLAG
4755 ff86 86 04 LDA #$04 4 SHIFTS
4756 ff88 08 53 L8BEA ASL FPA0+3 * SHIFT BOTTOM TWO BYTES OF
4757 ff8a 09 52 ROL FPA0+2 * FPA0 LEFT ONE BIT (X2)
4758 ff8c 59 ROLB IF OVERFLOW, ACCB <> 0
4759 ff8d 4a DECA * DECREMENT SHIFT COUNTER AND
4760 ff8e 26 f8 BNE L8BEA * BRANCH IF NOT DONE
4761 ff90 5d TSTB CHECK FOR OVERFLOW
4762 ff91 26 0a BNE L8BFF BRANCH IF OVERFLOW
4763 ff93 a6 e4 LDA ,S * GET NIBBLE COUNTER,
4764 ff95 4a DECA * DECREMENT IT AND
4765 ff96 27 05 BEQ L8BFF * BRANCH IF DONE
4766 ff98 8c 01 f0 CMPX #STRBUF+2 DO NOT DO A CONVERSION UNTIL A NON-ZERO
4767 ff9b 27 0c BEQ L8C0B BYTE IS FOUND - LEADING ZERO SUPPRESSION
4768 ff9d cb 30 L8BFF ADDB #'0' ADD IN ASCII ZERO
4769 ff9f c1 39 CMPB #'9' COMPARE TO ASCII 9
4770 ffa1 23 02 BLS L8C07 BRANCH IF < 9
4771 ffa3 cb 07 ADDB #7 ADD ASCII OFFSET IF HEX LETTER
4772 ffa5 e7 80 L8C07 STB ,X+ STORE HEX VALUE AND ADVANCE POINTER
4773 ffa7 6f 84 CLR ,X CLEAR NEXT BYTE - END OF STRING FLAG
4774 ffa9 35 04 L8C0B PULS B * GET NIBBLE COUNTER,
4775 ffab 5a DECB * DECREMENT IT AND
4776 ffac 26 d5 BNE L8BE5 * BRANCH IF NOT DONE
4777 ffae 32 62 LEAS $02,S PURGE RETURN ADDRESS OFF OF STACK
4778 ffb0 8e 01 ef LDX #STRBUF+1 RESET POINTER
4779 ffb3 7e ec df JMP LB518 SAVE STRING ON STRING STACK
4780
4781
4782 * CLEAR CARRY IF NUMERIC
4783 ffb6 81 30 L90AA CMPA #'0' ASCII ZERO
4784 ffb8 25 04 BLO L90B2 RETURN IF ACCA < ASCII 0
4785 ffba 80 3a SUBA #$3A * #'9'+1
4786 ffbc 80 c6 SUBA #$C6 * #-('9'+1) CARRY CLEAR IF NUMERIC
4787 ffbe 39 L90B2 RTS
4788
4789
4790 * LINE
4791 ffbf 81 89 LINE CMPA #TOK_INPUT <20>INPUT<55> TOKEN
4792 ffc1 10 27 fd ab LBEQ L89C0 GO DO <20>LINE INPUT<55> COMMAND
4793 ffc5 7e ea 43 JMP LB277 <20>SYNTAX ERROR<4F> IF NOT "LINE INPUT"
4794
4795
4796 * END OF EXTENDED BASIC
4797 * INTERRUPT VECTORS
4798 fff0 ORG $FFF0
4799 fff0 00 00 LBFF0 FDB $0000 RESERVED
4800 fff2 00 9b LBFF2 FDB SW3VEC SWI3
4801 fff4 00 9e LBFF4 FDB SW2VEC SWI2
4802 fff6 00 aa LBFF6 FDB FRQVEC FIRQ
4803 fff8 00 a7 LBFF8 FDB IRQVEC IRQ
4804 fffa 00 a1 LBFFA FDB SWIVEC SWI
4805 fffc 00 a4 LBFFC FDB NMIVEC NMI
4806 fffe e0 48 LBFFE FDB RESVEC RESET
Reference in New Issue View Git Blame Copy Permalink