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