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 � SKIP ONE BYTE 0017 008c SKP2 EQU $8C OP CODE OF CMPX # - SKIP TWO BYTES 0018 0086 SKP1LD EQU $86 OP CODE OF LDA # - SKIP THE NEXT BYTE 0019 * AND LOAD THE VALUE OF THAT BYTE INTO ACCA � THIS 0020 * IS USUALLY USED TO LOAD ACCA WITH A NON ZERO VALUE 0021 0095 RTS_LOW EQU $95 0022 0000 ORG 0 0023 0000 ENDFLG RMB 1 STOP/END FLAG: POSITIVE=STOP, NEG=END 0024 0001 CHARAC RMB 1 TERMINATOR FLAG 1 0025 0002 ENDCHR RMB 1 TERMINATOR FLAG 2 0026 0003 TMPLOC RMB 1 SCRATCH VARIABLE 0027 0004 IFCTR RMB 1 IF COUNTER - HOW MANY IF STATEMENTS IN A LINE 0028 0005 DIMFLG RMB 1 *DV* ARRAY FLAG 0=EVALUATE, 1=DIMENSIONING 0029 0006 VALTYP RMB 1 *DV* *PV TYPE FLAG: 0=NUMERIC, $FF=STRING 0030 0007 GARBFL RMB 1 *TV STRING SPACE HOUSEKEEPING FLAG 0031 0008 ARYDIS RMB 1 DISABLE ARRAY SEARCH: 00=ALLOW SEARCH 0032 0009 INPFLG RMB 1 *TV INPUT FLAG: READ=0, INPUT<>0 0033 000a RELFLG RMB 1 *TV RELATIONAL OPERATOR FLAG 0034 000b TEMPPT RMB 2 *PV TEMPORARY STRING STACK POINTER 0035 000d LASTPT RMB 2 *PV ADDR OF LAST USED STRING STACK ADDRESS 0036 000f TEMPTR RMB 2 TEMPORARY POINTER 0037 0011 TMPTR1 RMB 2 TEMPORARY DESCRIPTOR STORAGE (STACK SEARCH) 0038 0013 FPA2 RMB 4 FLOATING POINT ACCUMULATOR #2 MANTISSA 0039 0017 BOTSTK RMB 2 BOTTOM OF STACK AT LAST CHECK 0040 0019 TXTTAB RMB 2 *PV BEGINNING OF BASIC PROGRAM 0041 001b VARTAB RMB 2 *PV START OF VARIABLES 0042 001d ARYTAB RMB 2 *PV START OF ARRAYS 0043 001f ARYEND RMB 2 *PV END OF ARRAYS (+1) 0044 0021 FRETOP RMB 2 *PV START OF STRING STORAGE (TOP OF FREE RAM) 0045 0023 STRTAB RMB 2 *PV START OF STRING VARIABLES 0046 0025 FRESPC RMB 2 UTILITY STRING POINTER 0047 0027 MEMSIZ RMB 2 *PV TOP OF STRING SPACE 0048 0029 OLDTXT RMB 2 SAVED LINE NUMBER DURING A "STOP" 0049 002b BINVAL RMB 2 BINARY VALUE OF A CONVERTED LINE NUMBER 0050 002d OLDPTR RMB 2 SAVED INPUT PTR DURING A "STOP" 0051 002f TINPTR RMB 2 TEMPORARY INPUT POINTER STORAGE 0052 0031 DATTXT RMB 2 *PV 'DATA' STATEMENT LINE NUMBER POINTER 0053 0033 DATPTR RMB 2 *PV 'DATA' STATEMENT ADDRESS POINTER 0054 0035 DATTMP RMB 2 DATA POINTER FOR 'INPUT' & 'READ' 0055 0037 VARNAM RMB 2 *TV TEMP STORAGE FOR A VARIABLE NAME 0056 0039 VARPTR RMB 2 *TV POINTER TO A VARIABLE DESCRIPTOR 0057 003b VARDES RMB 2 TEMP POINTER TO A VARIABLE DESCRIPTOR 0058 003d RELPTR RMB 2 POINTER TO RELATIONAL OPERATOR PROCESSING ROUTINE 0059 003f TRELFL RMB 1 TEMPORARY RELATIONAL OPERATOR FLAG BYTE 0060 * FLOATING POINT ACCUMULATORS #3,4 & 5 ARE MOSTLY 0061 * USED AS SCRATCH PAD VARIABLES. 0062 ** FLOATING POINT ACCUMULATOR #3 :PACKED: ($40-$44) 0063 0040 V40 RMB 1 0064 0041 V41 RMB 1 0065 0042 V42 RMB 1 0066 0043 V43 RMB 1 0067 0044 V44 RMB 1 0068 ** FLOATING POINT ACCUMULATOR #4 :PACKED: ($45-$49) 0069 0045 V45 RMB 1 0070 0046 V46 RMB 1 0071 0047 V47 RMB 1 0072 0048 V48 RMB 2 0073 ** FLOATING POINT ACCUMULATOR #5 :PACKED: ($4A�$4E) 0074 004a V4A RMB 1 0075 004b V4B RMB 2 0076 004d V4D RMB 2 0077 ** FLOATING POINT ACCUMULATOR #0 0078 004f FP0EXP RMB 1 *PV FLOATING POINT ACCUMULATOR #0 EXPONENT 0079 0050 FPA0 RMB 4 *PV FLOATING POINT ACCUMULATOR #0 MANTISSA 0080 0054 FP0SGN RMB 1 *PV FLOATING POINT ACCUMULATOR #0 SIGN 0081 0055 COEFCT RMB 1 POLYNOMIAL COEFFICIENT COUNTER 0082 0056 STRDES RMB 5 TEMPORARY STRING DESCRIPTOR 0083 005b FPCARY RMB 1 FLOATING POINT CARRY BYTE 0084 ** FLOATING POINT ACCUMULATOR #1 0085 005c FP1EXP RMB 1 *PV FLOATING POINT ACCUMULATOR #1 EXPONENT 0086 005d FPA1 RMB 4 *PV FLOATING POINT ACCUMULATOR #1 MANTISSA 0087 0061 FP1SGN RMB 1 *PV FLOATING POINT ACCUMULATOR #1 SIGN 0088 0062 RESSGN RMB 1 SIGN OF RESULT OF FLOATING POINT OPERATION 0089 0063 FPSBYT RMB 1 FLOATING POINT SUB BYTE (FIFTH BYTE) 0090 0064 COEFPT RMB 2 POLYNOMIAL COEFFICIENT POINTER 0091 0066 LSTTXT RMB 2 CURRENT LINE POINTER DURING LIST 0092 0068 CURLIN RMB 2 *PV CURRENT LINE # OF BASIC PROGRAM, $FFFF = DIRECT 0093 006a DEVCFW RMB 1 *TV TAB FIELD WIDTH 0094 006b DEVLCF RMB 1 *TV TAB ZONE 0095 006c DEVPOS RMB 1 *TV PRINT POSITION 0096 006d DEVWID RMB 1 *TV PRINT WIDTH 0097 006e RSTFLG RMB 1 *PV WARM START FLAG: $55=WARM, OTHER=COLD 0098 006f RSTVEC RMB 2 *PV WARM START VECTOR - JUMP ADDRESS FOR WARM START 0099 0071 TOPRAM RMB 2 *PV TOP OF RAM 0100 0073 IKEYIM RMB 1 *TV INKEY$ RAM IMAGE 0101 0074 ZERO RMB 2 *PV DUMMY - THESE TWO BYTES ARE ALWAYS ZERO 0102 * THE FOLLOWING BYTES ARE MOVED DOWN FROM ROM 0103 0076 LPTCFW RMB 1 16 0104 0077 LPTLCF RMB 1 112 0105 0078 LPTWID RMB 1 132 0106 0079 LPTPOS RMB 1 0 0107 007a EXECJP RMB 2 LB4AA 0108 0109 * THIS ROUTINE PICKS UP THE NEXT INPUT CHARACTER FROM 0110 * BASIC. THE ADDRESS OF THE NEXT BASIC BYTE TO BE 0111 * INTERPRETED IS STORED AT CHARAD. 0112 007c 0c 84 GETNCH INC 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 �COLOR BASIC� 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�S MAIN LOOP 0311 e0ed 12 BAWMST NOP NOP REQ�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 �FC� 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 �FC� 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 �GOSUB/RETURN� OR �FOR/NEXT� DATA. 0790 * THE �FOR/NEXT� 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 �GOSUB/RETURN� 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 �FOR� 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 �FOR/NEXT� 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 �FOR/NEXT� DATA FOUND ON STACK 0807 * IF NO INDEX VARIABLE AFTER �NEXT� 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 �NEXT� INDEX 0816 e41a 9e 0f LAC1A LDX TEMPTR POINT X TO START OF �FOR/NEXT� DATA 0817 e41c 4d TSTA SET ZERO FLAG IF �FOR/NEXT� 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 �?� 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 �IN ****� 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 �OK�, CR MESSAGE 0865 e46b bd f1 25 JSR LB99C PRINT �OK�, 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 �LIVE KEYBOARD� (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�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�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�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 �DATA� 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 �CONT� ADDRESS SO YOU 0969 e525 0f 2e CLR OLDPTR+1 �CAN�T CONTINUE� 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 �TO� PARAMETER; 0982 * 14,15=CURRENT LINE NUMBER; 16,17=RAM ADDRESS OF THE END 0983 * OF THE LINE CONTAINING THE �FOR� 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 �FOR/NEXT� 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 �FOR/NEXT� DATA 0991 e53b 32 85 LEAS B,X MOVE THE STACK POINTER TO THE BEGINNING OF THE 0992 * MATCHED �FOR/NEXT� DATA SO THE NEW DATA WILL 0993 * OVERLAY THE OLD DATA. THIS WILL ALSO DESTROY 0994 * ALL OF THE �RETURN� AND �FOR/NEXT� 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 �TO� 1002 e54b bd ea 3b JSR LB26F SYNTAX CHECK FOR �TO� 1003 e54e bd e9 0f JSR LB143 �TM� 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 �STEP� 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 �STEP� 1022 e57c 34 06 PSHS B,A * VARIABLE AND SAVE IT ON THE STACK 1023 e57e 86 80 LDA #$80 = GET THE �FOR� 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�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 �SYNTAX ERROR�-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 �STOP� - 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 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 �LET� WHICH 1060 * IS THE �DEFAULT� 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 �SYNTAX ERROR� IF NON-EXECUTABLE TOKEN 1065 e5c9 be e1 18 LDX COMVEC+3 GET ADDRESS OF BASIC�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 �COMMAND� 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�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�S INPUT POINTER 1118 LAE22 1119 e61a 8e e3 f1 LDX #LABF2-1 POINT TO CR, �BREAK� 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 �BREAK AT ####� AND GO TO 1123 * BASIC�S MAIN LOOP IF �STOP� 1124 1125 * CONT 1126 e626 26 0e CONT BNE LAE40 RETURN IF ARGUMENT GIVEN 1127 e628 c6 20 LDB #2*16 �CAN�T CONTINUE� ERROR 1128 e62a 9e 2d LDX OLDPTR GET CONTINUE ADDRESS (INPUT POINTER) 1129 e62c 10 27 fe 16 LBEQ LAC46 �CN� ERROR IF CONTINUE ADDRESS = 0 1130 e630 9f 83 STX CHARAD RESET BASIC�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 �OM� 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 �OM� 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 �OM� ERROR IF FREE MEM < 0 1153 e65d 93 1b SUBD VARTAB SUBTRACT OUT START OF VARIABLES 1154 e65f 25 07 BCS LAE72 �OM� 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 �OM� 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 �GOTO� 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 �TO� TOKEN 1170 e67c 27 16 BEQ LAEA4 BRANCH IF GOTO 1171 e67e c1 a1 CMPB #TOK_SUB �SUB� TOKEN 1172 e680 26 45 BNE LAED7 �SYNTAX ERROR� 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 �GOTO� 1180 e691 7e e5 82 JMP LAD9E JUMP BACK TO BASIC�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�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�D LINE NUMBER IS > CURRENT LINE NUMBER, 1189 * DON�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 �UNDEFINED LINE NUMBER� 1194 e6ab 30 1f LAEBB LEAX -1,X MOVE BACK TO JUST BEFORE START OF LINE 1195 e6ad 9f 83 STX CHARAD RESET BASIC�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 �FOR/NEXT� 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 �RETURN� FROM SUBROUTINE 1208 e6bf c6 04 LDB #2*2 ERROR #2 �RETURN WITHOUT GOSUB� 1209 e6c1 8c FCB SKP2 SKIP TWO BYTES 1210 e6c2 c6 0e LAED2 LDB #7*2 ERROR #7 �UNDEFINED LINE NUMBER� 1211 e6c4 7e e4 46 JMP LAC46 JUMP TO ERROR HANDLER 1212 e6c7 7e ea 43 LAED7 JMP LB277 �SYNTAX ERROR� 1213 e6ca 35 52 LAEDA PULS A,X,U * RESTORE VALUES OF CURRENT LINE NUMBER AND 1214 e6cc 9f 68 STX CURLIN * BASIC�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�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�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�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 * �IF� 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 �GO� THE SAME AS �THEN� 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 �IF� LOOPS 1267 e718 8d b6 LAF28 BSR DATA MOVE BASIC�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 �ELSE� 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 �ELSE� 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 �GOTO� 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 �SYNTAX� ERROR IF NOT �SUB� OR �TO� 1290 e744 0a 53 LAF54 DEC FPA0+3 DECREMENT IS BYTE OF MANTISSA OF FPA0 - THIS 1291 * IS THE ARGUMENT OF THE �ON� 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 �GO� 1294 e74a 7e e6 78 JMP LAE88 GO DO A �GOTO� OR �GOSUB� 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 �SYNTAX� 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 �=� 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�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�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 �INPUT� 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 �SYNTAX ERROR� 1378 e7d4 8e e7 be LAFEA LDX #LAFCF-1 * POINT X TO �?REDO� 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 �ID� 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 �ID� 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�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�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 �SPACE� 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 �STOP� IF BREAK KEY ENDED LINE ENTRY 1411 e816 c6 2e LB03F LDB #2*23 �INPUT PAST END OF FILE� ERROR 1412 e818 39 RTS 1413 * 1414 * READ 1415 e819 9e 33 READ LDX DATPTR GET �READ� START ADDRESS 1416 e81b 86 FCB SKP1LD SKIP ONE BYTE - LDA #*$4F 1417 e81c 4f LB049 CLRA �INPUT� 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 �READ� START ADDRESS/�INPUT� 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�S INPUT POINTER 1423 e828 9f 2b STX BINVAL * AND SAVE IT 1424 e82a 9e 35 LDX DATTMP GET �READ� ADDRESS START/�INPUT� 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 �INPUT� 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�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�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 �OUT OF DATA� ERROR 1478 e891 ee 81 LDU ,X++ GET NEXT 2 CHARACTERS 1479 e893 27 41 BEQ LB10A �OD� 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 � 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 �INPUT� BUFFER 1491 e8ab 27 06 BEQ LB0E7 = 1492 e8ad 8e e8 b3 LDX #LB0E8-1 POINT X TO �?EXTRA IGNORED� 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 �FOR/NEXT� DATA ON STACK 1508 e8d2 27 04 BEQ LB10C BRANCH IF DATA FOUND 1509 e8d4 c6 00 LDB #0 �NEXT WITHOUT FOR� 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 �FOR/NEXT� 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 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 �>� 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 = �+� 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 �TM� 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�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 �SYNTAX ERROR� 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 �)� 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 �TM� 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 �NOT� OPERATOR 1661 e9d3 27 19 BEQ LB222 RETURN IF �NOT� - 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 �.� (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�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 �NOT� PRECEDENCE FLAG 1708 ea20 bd e9 26 JSR LB15A PROCESS OPERATION FOLLOWING �NOT� 1709 ea23 bd eb b4 JSR INTCNV CONVERT FPA0 TO INTEGER IN ACCD 1710 ea26 43 COMA * �NOT� 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 �(� 1716 ea30 bd e9 22 JSR LB156 EVALUATE EXPRESSIONS WITHIN PARENTHESES AT 1717 * HIGHEST PRECEDENCE 1718 ea33 c6 29 LB267 LDB #') SYNTAX CHECK FOR �)� 1719 ea35 8c FCB SKP2 SKIP 2 BYTES 1720 ea36 c6 28 LB26A LDB #'( SYNTAX CHECK FOR �(� 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 �UNARY� 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 �(� 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 �TM� 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 �(� 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 �TM� ERROR IF VARIABLE TYPE = STRING 1775 1776 * LOGICAL OPERATOR �OR� JUMPS HERE 1777 ea9b 86 LB2D4 FCB SKP1LD SKIP ONE BYTE - �OR� FLAG = $4F 1778 1779 * LOGICAL OPERATOR �AND� 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 * �AND� 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 * �OR� 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 �TM� ERROR IF TYPE MISMATCH 1797 eabe 26 10 BNE LB309 BRANCH IF STRING VARIABLE 1798 eac0 96 61 LDA FP1SGN * �PACK� 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�S 1,2,4 FOR > = < 1842 eb09 d4 0a ANDB RELFLG �AND� 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�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 < �A� 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 �EVALUATE ALPHA EXPR�? 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 �FC� ERROR IF NEGATIVE NUMBER 1952 1953 1954 ebb4 bd e9 0f INTCNV JSR LB143 �TM� 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 �FC� 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 �)� 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 �REDIMENSIONED ARRAY� 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 �BAD SUBSCRIPT� 2001 ec10 8c FCB SKP2 SKIP TWO BYTES 2002 ec11 c6 08 LB44A LDB #4*2 �ILLEGAL FUNCTION CALL� 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�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;� 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 �OM� 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 �DIM� ARGUMENT 2062 ec76 24 3a BCC LB4EB �BS� 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�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�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�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�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�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�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�T PUT IT IN BUFFER 2551 ef94 c1 83 CMPB #TOK_SNGL_Q TOKEN FOR REMARK? 2552 ef96 27 ec BEQ LB7CB YES - DON�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�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�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�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 �NORMALIZED� 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 �E� (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�S DIGIT OF EXPONENT 3555 f635 c0 0a SUBB #10 SUBTRACT 10 FROM ACCB 3556 f637 24 fb BCC LBEAB ADD 1 TO 10�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�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 �OV� 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 �FC� 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�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 �OV� 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 �OV� 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 �LIST� 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 �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 �1� 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 �NO LIST� 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�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�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�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 �(� 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 �)� 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 �FC� 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 �(� 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 �)� 4169 fb06 c6 ae LDB #TOK_EQUALS TOKEN FOR = 4170 fb08 bd ea 3b JSR LB26F SYNTAX CHECK FOR �=� 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 �FC� 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�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 *�TM� 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 �(� 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 �)� 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 �(� 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 �TM� 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�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 �&� (&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 �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 �&� 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�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 �ILLEGAL DIRECT STATEMENT� 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�T ALLOW DEF FN IF IN DIRECT MODE 4356 fc73 bd ea 36 JSR LB26A SYNTAX CHECK FOR �(� 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 �TM� ERROR IF STRING 4361 fc7f bd ea 33 JSR LB267 SYNTAX CHECK FOR �)� 4362 fc82 c6 ae LDB #TOK_EQUALS TOKEN FOR �=� 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 �TM� 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 �(� & EVALUATE EXPR 4382 fcae 8d f4 BSR L88B1 �TM� ERROR IF STRING VARIABLE 4383 fcb0 35 40 PULS U POINT U TO FN NAME DESCRIPTOR 4384 fcb2 c6 32 LDB #2*25 �UNDEFINED FUNCTION CALL� 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 �SYNTAX� 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 �(� & 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 �=� 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� 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 �-' 4453 fd32 26 3b BNE L89BF TERMINATE COMMAND IF LINE NUMBER NOT FOLLOWED BY �-� 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�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�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�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�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 �BS� 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 �TM� 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 �FC' ERROR 4533 fddb bd e1 fa L8A3A JSR LA5C7 CHECK FOR MORE CHARACTERS ON LINE - �SYNTAX� 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 �FC� 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 �EXPANDED� 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�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 �FC� 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 �FC� 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�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 �UL� 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 �IN XXXX� 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 �INPUT� TOKEN 4792 ffc1 10 27 fd ab LBEQ L89C0 GO DO �LINE INPUT� COMMAND 4793 ffc5 7e ea 43 JMP LB277 �SYNTAX ERROR� 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