Nuevo proyecto Basic CoCo/Dragon/DP400

[luiscoco]

Último mensaje de la página anterior:

Comando LET y evaluación de una expresión sin token ($AF89-$AFA3)

Código: Seleccionar todo

2217 *
2218 * LET (EXBAS)
2219 * EVALUATE A NON-TOKEN EXPRESSION
2220 * TARGET = REPLACEMENT
2221 AF89 BD B3 57 LET JSR LB357 FIND TARGET VARIABLE DESCRIPTOR
2222 AF8C 9F 3B STX VARDES SAVE DESCRIPTOR ADDRESS OF 1ST EXPRESSION
2223 AF8E C6 B3 LDB #$B3 TOKEN FOR "="
2224 AF90 BD B2 6F JSR LB26F DO A SYNTAX CHECK FOR ‘=‘
2225 AF93 96 06 LDA VALTYP * GET VARIABLE TYPE AND
2226 AF95 34 02 PSHS A * SAVE ON THE STACK
2227 AF97 BD B1 56 JSR LB156 EVALUATE EXPRESSION
2228 AF9A 35 02 PULS A * REGET VARIABLE TYPE OF 1ST EXPRESSION AND
2229 AF9C 46 RORA * SET CARRY IF STRING
2230 AF9D BD B1 48 JSR LB148 TYPE CHECK-TM ERROR IF VARIABLE TYPES ON
2231 * BOTH SIDES OF EQUALS SIGN NOT THE SAME
2232 AFA0 10 27 0C 8F LBEQ LBC33 GO PUT FPA0 INTO VARIABLE DESCRIPTOR IF NUMERIC

[luiscoco]

Mueve un String ($AFA4-$AFCE)

Código: Seleccionar todo

2233 * MOVE A STRING WHOSE DESCRIPTOR IS LOCATED AT
2234 * FPA0+2 INTO THE STRING SPACE. TRANSFER THE
2235 * DESCRIPTOR ADDRESS TO THE ADDRESS IN VARDES
2236 * DON’T MOVE THE STRING IF IT IS ALREADY IN THE
2237 * STRING SPACE. REMOVE DESCRIPTOR FROM STRING
2238 * STACK IF IT IS LAST ONE ON THE STACK
2239 AFA4 9E 52 LAFA4 LDX FPA0+2 POINT X TO DESCRIPTOR OF REPLACEMENT STRING
2240 AFA6 DC 21 LDD FRETOP LOAD ACCD WITH START OF STRING SPACE
2241 AFA8 10 A3 02 CMPD 2,X IS THE STRING IN STRING SPACE?
2242 AFAB 24 11 BCC LAFBE BRANCH IF IT’S NOT IN THE STRING SPACE
2243 AFAD 9C 1B CMPX VARTAB COMPARE DESCRIPTOR ADDRESS TO START OF VARIABLES
2244 AFAF 25 0D BCS LAFBE BRANCH IF DESCRIPTOR ADDRESS NOT IN VARIABLES
2245 AFB1 E6 84 LAFB1 LDB ,X GET LENGTH OF REPLACEMENT STRING
2246 AFB3 BD B5 0D JSR LB50D RESERVE ACCB BYTES OF STRING SPACE
2247 AFB6 9E 4D LDX V4D GET DESCRIPTOR ADDRESS BACK
2248 AFB8 BD B6 43 JSR LB643 MOVE STRING INTO STRING SPACE
2249 AFBB 8E 00 56 LDX #STRDES POINT X TO TEMP STRING DESCRIPTOR ADDRESS
2250 AFBE 9F 4D LAFBE STX V4D SAVE STRING DESCRIPTOR ADDRESS IN V4D
2251 AFC0 BD B6 75 JSR LB675 REMOVE STRING DESCRIPTOR IF LAST ONE
2252 * ON STRING STACK
2253 AFC3 DE 4D LDU V4D POINT U TO REPLACEMENT DESCRIPTOR ADDRESS
2254 AFC5 9E 3B LDX VARDES GET TARGET DESCRIPTOR ADDRESS
2255 AFC7 37 26 PULU A,B,Y GET LENGTH AND START OF REPLACEMENT STRING
2256 AFC9 A7 84 STA ,X * SAVE STRING LENGTH AND START IN
2257 AFCB 10 AF 02 STY 2,X * TARGET DESCRIPTOR LOCATION
2258 AFCE 39 LAFCE RTS

[luiscoco]

Mensaje de REDO ($AFCF-$AFF4)

Código: Seleccionar todo

2259
2260 AFCF 3F 52 45 44 4F LAFCF FCC '?REDO' ?REDO MESSAGE
2261 AFD4 0D 00 FCB CR,$00
2262
2263 AFD6 C6 22 LAFD6 LDB #2*17 ‘BAD FILE DATA’ ERROR
2264 AFD8 0D 6F TST DEVNUM CHECK DEVICE NUMBER AND BRANCH
2265 AFDA 27 03 BEQ LAFDF IF SET TO SCREEN
2266 AFDC 7E AC 46 LAFDC JMP LAC46 JMP TO ERROR HANDLER
2267 AFDF 96 09 LAFDF LDA INPFLG = GET THE INPUT FLAG AND BRANCH
2268 AFE1 27 07 BEQ LAFEA = IF ‘INPUT’
2269 AFE3 9E 31 LDX DATTXT * GET LINE NUMBER WHERE THE ERROR OCCURRED
2270 AFE5 9F 68 STX CURLIN * AND USE IT AS THE CURRENT LINE NUMBER
2271 AFE7 7E B2 77 JMP LB277 ‘SYNTAX ERROR’
2272 AFEA 8E AF CE LAFEA LDX #LAFCF-1 * POINT X TO ‘?REDO’ AND PRINT
2273 AFED BD B9 9C JSR LB99C * IT ON THE SCREEN
2274 AFF0 9E 2F LDX TINPTR = GET THE SAVED ABSOLUTE ADDRESS OF
2275 AFF2 9F A6 STX CHARAD = INPUT POINTER AND RESTORE IT
2276 AFF4 39 RTS

[luiscoco]

Comando INPUT ($AFF5-$B02E)

Código: Seleccionar todo

2277 *
2278 * INPUT
2279 AFF5 C6 16 INPUT LDB #11*2 ‘ID’ ERROR
2280 AFF7 9E 68 LDX CURLIN GET CURRENT LINE NUMBER
2281 AFF9 30 01 LEAX 1,X ADD ONE
2282 AFFB 27 DF BEQ LAFDC ‘ID’ ERROR BRANCH IF DIRECT MODE
2283 AFFD 8D 03 BSR LB002 GET SOME INPUT DATA
2284 AFFF 0F 6F CLR DEVNUM SET DEVICE NUMBER TO SCREEN
2285 B001 39 RTS
2286 B002 81 23 LB002 CMPA #'# CHECK FOR DEVICE NUMBER
2287 B004 26 09 BNE LB00F NO DEVICE NUMBER GIVEN
2288 B006 BD A5 A5 JSR LA5A5 CHECK SYNTAX AND GET DEVICE NUMBER
2289 B009 BD A3 ED JSR LA3ED CHECK FOR VALID INPUT FILE
2290 B00C BD B2 6D JSR LB26D SYNTAX CHECK FOR COMMA
2291 B00F 81 22 LB00F CMPA #'" CHECK FOR PROMPT STRING DELIMITER
2292 B011 26 0B BNE LB01E BRANCH IF NO PROMPT STRING
2293 B013 BD B2 44 JSR LB244 PUT PROMPT STRING ON STRING STACK
2294 B016 C6 3B LDB #'; *
2295 B018 BD B2 6F JSR LB26F * DO A SYNTAX CHECK FOR SEMICOLON
2296 B01B BD B9 9F JSR LB99F PRINT MESSAGE TO CONSOLE OUT
2297 B01E 8E 02 DC LB01E LDX #LINBUF POINT TO BASIC’S LINE BUFFER
2298 B021 6F 84 CLR ,X CLEAR 1ST BYTE - FLAG TO INDICATE NO DATA
2299 * IN LINE BUFFER
2300 B023 0D 6F TST DEVNUM CHECK DEVICE NUMBER
2301 B025 26 22 BNE LB049 BRANCH IF NOT SET TO SCREEN
2302 B027 8D 06 BSR LB02F INPUT A STRING TO LINE BUFFER
2303 B029 C6 2C LDB #', * INSERT A COMMA AT THE END
2304 B02B E7 84 STB ,X * OF THE LINE INPUT BUFFER
2305 B02D 20 1A BRA LB049

[luiscoco]

Llena el buffer de la linea de entrada en consola ($B02F-$B045)

Código: Seleccionar todo

2306 * FILL BASIC’S LINE INPUT BUFFER CONSOLE IN
2307 B02F BD B9 AF LB02F JSR LB9AF SEND A "?" TO CONSOLE OUT
2308 B032 BD B9 AC JSR LB9AC SEND A ‘SPACE’ TO CONSOLE OUT
2309 B035 BD A3 90 LB035 JSR LA390 GO READ IN A BASIC LINE
2310 B038 24 05 BCC LB03F BRANCH IF ENTER KEY ENDED ENTRY
2311 B03A 32 64 LEAS 4,S PURGE TWO RETURN ADDRESSES OFF THE STACK
2312 B03C 7E AE 11 JMP LAE11 GO DO A ‘STOP’ IF BREAK KEY ENDED LINE ENTRY
2313 B03F C6 2E LB03F LDB #2*23 ‘INPUT PAST END OF FILE’ ERROR
2314 B041 0D 70 TST CINBFL CHECK FOR MORE CHARACTERS IN CONSOLE IN BUFFER
2315 B043 26 97 BNE LAFDC ‘IE’ ERROR IF EMPTY
2316 B045 39 RTS

[luiscoco]

Comando READ ($B046-$B070)

Código: Seleccionar todo

2317 *
2318 * READ
2319 B046 9E 33 READ LDX DATPTR GET ‘READ’ START ADDRESS
2320 B048 86 FCB SKP1LD SKIP ONE BYTE - LDA #*$4F
2321 B049 4F LB049 CLRA ‘INPUT’ ENTRY POINT: INPUT FLAG = 0
2322 B04A 97 09 STA INPFLG SET INPUT FLAG; 0 = INPUT: <> 0 = READ
2323 B04C 9F 35 STX DATTMP SAVE ‘READ’ START ADDRESS/’INPUT’ BUFFER START
2324 B04E BD B3 57 LB04E JSR LB357 EVALUATE A VARIABLE
2325 B051 9F 3B STX VARDES SAVE DESCRIPTOR ADDRESS
2326 B053 9E A6 LDX CHARAD * GET BASIC’S INPUT POINTER
2327 B055 9F 2B STX BINVAL * AND SAVE IT
2328 B057 9E 35 LDX DATTMP GET ‘READ’ ADDRESS START/’INPUT’ BUFFER POINTER
2329 B059 A6 84 LDA ,X GET A CHARACTER FROM THE BASIC PROGRAM
2330 B05B 26 0C BNE LB069 BRANCH IF NOT END OF LINE
2331 B05D 96 09 LDA INPFLG * CHECK INPUT FLAG AND BRANCH
2332 B05F 26 58 BNE LB0B9 * IF LOOKING FOR DATA (READ)

2333 * NO DATA IN ‘INPUT’ LINE BUFFER AND/OR INPUT
2334 * NOT COMING FROM SCREEN
2335 B061 BD 01 7C JSR RVEC10 HOOK INTO RAM IF ‘INPUT’
2336 B064 BD B9 AF JSR LB9AF SEND A '?' TO CONSOLE OUT
2337 B067 8D C6 BSR LB02F FILL INPUT BUFFER FROM CONSOLE IN
2338 B069 9F A6 LB069 STX CHARAD RESET BASIC’S INPUT POINTER
2339 B06B 9D 9F JSR GETNCH GET A CHARACTER FROM BASIC
2340 B06D D6 06 LDB VALTYP * CHECK VARIABLE TYPE AND
2341 B06F 27 27 BEQ LB098 * BRANCH IF NUMERIC

Lee/Entra una variable de cadena ($B071-$B09D)

Código: Seleccionar todo

2342 * READ/INPUT A STRING VARIABLE
2343 B071 9E A6 LDX CHARAD LOAD X WITH CURRENT BASIC INPUT POINTER
2344 B073 97 01 STA CHARAC SAVE CURRENT INPUT CHARACTER
2345 B075 81 22 CMPA #'" CHECK FOR STRING DELIMITER
2346 B077 27 12 BEQ LB08B BRANCH IF STRING DELIMITER
2347 B079 30 1F LEAX -1,X BACK UP POINTER
2348 B07B 4F CLRA * ZERO = END OF LINE CHARACTER
2349 B07C 97 01 STA CHARAC * SAVE AS TERMINATOR
2350 B07E BD A3 5F JSR LA35F SET UP PRINT PARAMETERS
2351 B081 0D 6E TST PRTDEV CHECK PRINT DEVICE NUMBER
2352 B083 26 06 BNE LB08B BRANCH IF CASSETTE - USE TWO ZEROS AS TERMINATOR
2353 * CHARACTERS FOR CASSETTE
2354 B085 86 3A LDA #': END OF SUBLINE CHARACTER
2355 B087 97 01 STA CHARAC SAVE AS TERMINATOR I
2356 B089 86 2C LDA #', COMMA
2357 B08B 97 02 LB08B STA ENDCHR SAVE AS TERMINATOR 2
2358 B08D BD B5 1E JSR LB51E STRIP A STRING FROM THE INPUT BUFFER
2359 B090 BD B2 49 JSR LB249 MOVE INPUT POINTER TO END OF STRING
2360 B093 BD AF A4 JSR LAFA4 PUT A STRING INTO THE STRING SPACE IF NECESSARY
2361 B096 20 06 BRA LB09E CHECK FOR ANOTHER DATA ITEM

2362 * SAVE A NUMERIC VALUE IN A READ OR INPUT DATA ITEM
2363 B098 BD BD 12 LB098 JSR LBD12 CONVERT AN ASCII STRING TO FP NUMBER
2364 B09B BD BC 33 JSR LBC33 PACK FPA0 AND STORE IT IN ADDRESS IN VARDES -

Entra o lee un dato ($B09E-$B0B7)

Código: Seleccionar todo

2365 * INPUT OR READ DATA ITEM
2366 B09E 9D A5 LB09E JSR GETCCH GET CURRENT INPUT CHARACTER
2367 B0A0 27 06 BEQ LB0A8 BRANCH IF END OF LINE
2368 B0A2 81 2C CMPA #', CHECK FOR A COMMA
2369 B0A4 10 26 FF 2E LBNE LAFD6 'BAD FILE DATA' ERROR OR RETRY
2370 B0A8 9E A6 LB0A8 LDX CHARAD * GET CURRENT INPUT
2371 B0AA 9F 35 STX DATTMP * POINTER (USED AS A DATA POINTER) AND SAVE IT
2372 B0AC 9E 2B LDX BINVAL * RESET INPUT POINTER TO INPUT OR
2373 B0AE 9F A6 STX CHARAD * READ STATEMENT
2374 B0B0 9D A5 JSR GETCCH GET CURRENT CHARACTER FROM BASIC
2375 B0B2 27 21 BEQ LB0D5 BRANCH IF END OF LINE - EXIT COMMAND
2376 B0B4 BD B2 6D JSR LB26D SYNTAX CHECK FOR COMMA
2377 B0B7 20 95 BRA LB04E GET ANOTHER INPUT OR READ ITEM

Buscar próximo DATA ($B0B9-$B0F6)

Código: Seleccionar todo

2378 * SEARCH FROM ADDRESS IN X FOR
2379 * 1ST OCCURENCE OF THE TOKEN FOR DATA
2380 B0B9 9F A6 LB0B9 STX CHARAD RESET BASIC’S INPUT POINTER
2381 B0BB BD AE E8 JSR LAEE8 SEARCH FOR END OF CURRENT LINE OR SUBLINE
2382 B0BE 30 01 LEAX 1,X MOVE X ONE PAST END OF LINE
2383 B0C0 4D TSTA CHECK FOR END OF LINE
2384 B0C1 26 0A BNE LB0CD BRANCH IF END OF SUBLINE
2385 B0C3 C6 06 LDB #2*3 ‘OUT OF DATA’ ERROR
2386 B0C5 EE 81 LDU ,X++ GET NEXT 2 CHARACTERS
2387 B0C7 27 41 BEQ LB10A ‘OD’ ERROR IF END OF PROGRAM
2388 B0C9 EC 81 LDD ,X++ GET BASIC LINE NUMBER AND
2389 B0CB DD 31 STD DATTXT SAVE IT IN DATTXT
2390 B0CD A6 84 LB0CD LDA ,X GET AN INPUT CHARACTER
2391 B0CF 81 86 CMPA #$86 DATA TOKEN?
2392 B0D1 26 E6 BNE LB0B9 NO — KEEP LOOKING
2393 B0D3 20 94 BRA LB069 YES
2394 * EXIT READ AND INPUT COMMANDS
2395 B0D5 9E 35 LB0D5 LDX DATTMP GET DATA POINTER
2396 B0D7 D6 09 LDB INPFLG * CHECK INPUT FLAG
2397 B0D9 10 26 FD 0B LBNE LADE8 * SAVE NEW DATA POINTER IF READ
2398 B0DD A6 84 LDA ,X = CHECK NEXT CHARACTER IN ‘INPUT’ BUFFER
2399 B0DF 27 06 BEQ LB0E7 = RETURN IF NO MORE DATA FOR INPUT
2400 B0E1 8E B0 E7 LDX #LB0E8-1 POINT X TO ‘?EXTRA IGNORED’
2401 B0E4 7E B9 9C JMP LB99C PRINT THE MESSAGE
2402 B0E7 39 LB0E7 RTS
2403
2404 B0E8 3F 45 58 54 52 41 LB0E8 FCC '?EXTRA IGNORED' ?EXTRA IGNORED MESSAGE
2405 B0EE 20 49 47 4E 4F 52
2406 B0F4 45 44
2407 B0F6 0D 00 FCB CR,$00

[luiscoco]

Comando NEXT ($B0F8-$B140)

Código: Seleccionar todo

2408
2409 * NEXT
2410 B0F8 26 04 NEXT BNE LB0FE BRANCH IF ARGUMENT GIVEN
2411 B0FA 9E 8A LDX ZERO X = 0: DEFAULT FOR NO ARGUMENT
2412 B0FC 20 03 BRA LB101
2413 B0FE BD B3 57 LB0FE JSR LB357 EVALUATE AN ALPHA EXPRESSION
2414 B101 9F 3B LB101 STX VARDES SAVE VARIABLE DESCRIPTOR POINTER
2415 B103 BD AB F9 JSR LABF9 GO SCAN FOR ‘FOR/NEXT’ DATA ON STACK
2416 B106 27 04 BEQ LB10C BRANCH IF DATA FOUND
2417 B108 C6 00 LDB #0 ‘NEXT WITHOUT FOR’ ERROR (SHOULD BE CLRB)
2418 B10A 20 47 LB10A BRA LB153 PROCESS ERROR
2419 B10C 1F 14 LB10C TFR X,S POINT S TO START OF ‘FOR/NEXT’ DATA
2420 B10E 30 03 LEAX 3,X POINT X TO FP VALUE OF STEP
2421 B110 BD BC 14 JSR LBC14 COPY A FP NUMBER FROM (X) TO FPA0
2422 B113 A6 68 LDA 8,S GET THE DIRECTION OF STEP
2423 B115 97 54 STA FP0SGN SAVE IT AS THE SIGN OF FPA0
2424 B117 9E 3B LDX VARDES POINT (X) TO INDEX VARIABLE DESCRIPTOR
2425 B119 BD B9 C2 JSR LB9C2 ADD (X) TO FPA0 (STEP TO INDEX)
2426 B11C BD BC 33 JSR LBC33 PACK FPA0 AND STORE IT IN ADDRESS
2427 * CONTAINED IN VARDES
2428 B11F 30 69 LEAX 9,S POINT (X) TO TERMINAL VALUE OF INDEX
2429 B121 BD BC 96 JSR LBC96 COMPARE CURRENT INDEX VALUE TO TERMINAL VALUE OF INDEX
2430 B124 E0 68 SUBB 8,S ACCB = 0 IF TERMINAL VALUE=CURRENT VALUE AND STEP=0 OR IF
2431 * STEP IS POSITIVE AND CURRENT VALUE>TERMINAL VALUE OR
2432 * STEP IS NEGATIVE AND CURRENT VALUE<TERMINAL VALUE
2433 B126 27 0C BEQ LB134 BRANCH IF ‘FOR/NEXT’ LOOP DONE
2434 B128 AE 6E LDX 14,S * GET LINE NUMBER AND
2435 B12A 9F 68 STX CURLIN * BASIC POINTER OF
2436 B12C AE E8 10 LDX 16,S * STATEMENT FOLLOWING THE
2437 B12F 9F A6 STX CHARAD * PROPER FOR STATEMENT
2438 B131 7E AD 9E LB131 JMP LAD9E JUMP BACK TO COMMAND INTEPR. LOOP
2439 B134 32 E8 12 LB134 LEAS 18,S PULL THE ‘FOR-NEXT’ DATA OFF THE STACK
2440 B137 9D A5 JSR GETCCH GET CURRENT INPUT CHARACTER
2441 B139 81 2C CMPA #', CHECK FOR ANOTHER ARGUMENT
2442 B13B 26 F4 BNE LB131 RETURN IF NONE
2443 B13D 9D 9F JSR GETNCH GET NEXT CHARACTER FROM BASIC
2444 B13F 8D BD BSR LB0FE BSR SIMULATES A CALL TO ‘NEXT’ FROM COMMAND LOOP

[luiscoco]

Evalúa una expresión($B141-$B147)
Esta función tiene 3 entradas, y evalúa una expresión y da TM error (TYPE MISMACH ERROR) si es del tipo equivocado.
Para hacerlo y abreviar espacio, usa un truco, que según se entre en un sitio u otro, pasa por una zona sin afectar el resultado y si salta en medio cambia la acción, se usaron trucos así en 10 o 20 sitios. (esto es en lenguaje de maquina no puede expresarse correctamente en ensamblador)
Si se comienza en:
LB146 Se hace evaluación de la expresión para ver si es STRING y si el tipo de variable es numérica [VALTYP es positivo (cero)] da 'TM' ERROR
LB144 Se hace evaluación de la expresión para ver si es NUMÉRICO y si el tipo de variable es String [VALTYP es negativo ($FF o bit 7 encendido)] da 'TM' ERROR.
LB148 La evaluación se hace en VALTYP y según el Carry da lo siguiente:
Si carry esta en 1 y es numérico da TM ERROR
Si carry esta en 0 y es STRING da TM ERROR

Código: Seleccionar todo

2445
2446 * EVALUATE A NUMERIC EXPRESSION
2447 B141 8D 13 LB141 BSR LB156   EVALUATE EXPRESSION AND DO A TYPE CHECK FOR NUMERIC
2448 B143 1C FE LB143 ANDCC #$FE   CLEAR CARRY FLAG
2449 B145 7D LB145 FCB $7D OP CODE OF TST $1A01 - SKIP TWO BYTES (DO
2450 * NOT CHANGE CARRY FLAG)
2451 B146 1A 01 LB146 ORCC #1 SET CARRY
2452
2453 * STRING TYPE MODE CHECK - IF ENTERED AT LB146 THEN VALTYP PLUS IS 'TM' ERROR
2454 * NUMERIC TYPE MODE CHECK - IF ENTERED AT LB143 THEN VALTYP MINUS IS 'TM' ERROR
2455 * IF ENTERED AT LB148, A TYPE CHECK IS DONE ON VALTYP
2456 * IF ENTERED WITH CARRY SET, THEN 'TM' ERROR IF NUMERIC
2457 * IF ENTERED WITH CARRY CLEAR, THEN 'TM' ERROR IF STRING.
2458 B148 0D 06 LB148 TST VALTYP TEST TYPE FLAG; DO NOT CHANGE CARRY
2459 B14A 25 03 BCS LB14F BRANCH IF STRING
2460 B14C 2A 99 BPL LB0E7 RETURN ON PLUS
2461 B14E 8C FCB SKP2 SKIP 2 BYTES - ‘TM’ ERROR
2462 B14F 2B 96 LB14F BMI LB0E7 RETURN ON MINUS
2463 B151 C6 18 LDB #12*2 ‘TYPE MISMATCH’ ERROR
2464 B153 7E AC 46 LB153 JMP LAC46 PROCESS ERROR

Evalúa expresión ($B156-$B169)

Código: Seleccionar todo

2465 * EVALUATE EXPRESSION
2466 B156 8D 6E LB156 BSR LB1C6 BACK UP INPUT POINTER
2467 B158 4F CLRA END OF OPERATION PRECEDENCE FLAG
2468 B159 8C FCB SKP2 SKIP TWO BYTES
2469 B15A 34 04 LB15A PSHS B SAVE FLAG (RELATIONAL OPERATOR FLAG)
2470 B15C 34 02 PSHS A SAVE FLAG (PRECEDENCE FLAG)
2471 B15E C6 01 LDB #1 *
2472 B160 BD AC 33 JSR LAC33 * SEE IF ROOM IN FREE RAM FOR (B) WORDS
2473 B163 BD B2 23 JSR LB223 GO EVALUATE AN EXPRESSION
2474 B166 0F 3F CLR TRELFL RESET RELATIONAL OPERATOR FLAG
2475 B168 9D A5 LB168 JSR GETCCH GET CURRENT INPUT CHARACTER

Chequea operadores relacionales ($B16A-$B34A)

Código: Seleccionar todo

2476 * CHECK FOR RELATIONAL OPERATORS
2477 B16A 80 B2 LB16A SUBA #$B2 TOKEN FOR >
2478 B16C 25 13 BCS LB181 BRANCH IF LESS THAN RELATIONAL OPERATORS
2479 B16E 81 03 CMPA #3 *
2480 B170 24 0F BCC LB181 * BRANCH IF GREATER THAN RELATIONAL OPERATORS
2481 B172 81 01 CMPA #1 SET CARRY IF ‘>‘
2482 B174 49 ROLA CARRY TO BIT 0
2483 B175 98 3F EORA TRELFL * CARRY SET IF
2484 B177 91 3F CMPA TRELFL * TRELFL = ACCA
2485 B179 25 64 BCS LB1DF BRANCH IF SYNTAX ERROR : == << OR >>
2486 B17B 97 3F STA TRELFL BIT 0: >, BIT 1 =, BIT 2: < SAVE DESIRED RELATIONAL COMPARISON
2487 B17D 9D 9F JSR GETNCH GET AN INPUT CHARACTER
2488 B17F 20 E9 BRA LB16A CHECK FOR ANOTHER RELATIONAL OPERATOR
2489 *
2490 B181 D6 3F LB181 LDB TRELFL GET RELATIONAL OPERATOR FLAG
2491 B183 26 33 BNE LB1B8 BRANCH IF RELATIONAL COMPARISON
2492 B185 10 24 00 6B LBCC LB1F4 BRANCH IF > RELATIONAL OPERATOR
2493 B189 8B 07 ADDA #7 SEVEN ARITHMETIC/LOGICAL OPERATORS
2494 B18B 24 67 BCC LB1F4 BRANCH IF NOT ARITHMETIC/LOGICAL OPERATOR
2495 B18D 99 06 ADCA VALTYP ADD CARRY, NUMERIC FLAG AND MODIFIED TOKEN NUMBER
2496 B18F 10 27 04 7C LBEQ LB60F BRANCH IF VALTYP = FF, AND ACCA = ‘+‘ TOKEN -

2497 CONCATENATE TWO STRINGS
2498 B193 89 FF ADCA #-1 RESTORE ARITHMETIC/LOGICAL OPERATOR NUMBER
2499 B195 34 02 PSHS A * STORE OPERATOR NUMBER ON STACK; MULTIPLY IT BY 2
2500 B197 48 ASLA * THEN ADD THE STORED STACK DATA = MULTIPLY
2501 B198 AB E0 ADDA ,S+ * X 3; 3 BYTE/TABLE ENTRY
2502 B19A 8E AA 51 LDX #LAA51 JUMP TABLE FOR ARITHMETIC & LOGICAL OPERATORS
2503 B19D 30 86 LEAX A,X POINT X TO PROPER TABLE
2504 B19F 35 02 LB19F PULS A GET PRECEDENCE FLAG FROM STACK
2505 B1A1 A1 84 CMPA ,X COMPARE TO CURRENT OPERATOR
2506 B1A3 24 55 BCC LB1FA BRANCH IF STACK OPERATOR > CURRENT OPERATOR
2507 B1A5 8D 9C BSR LB143 ‘TM’ ERROR IF VARIABLE TYPE = STRING
2508
2509 * OPERATION BEING PROCESSED IS OF HIGHER PRECEDENCE THAN THE PREVIOUS OPERATION.
2510 B1A7 34 02 LB1A7 PSHS A SAVE PRECEDENCE FLAG
2511 B1A9 8D 29 BSR LB1D4 PUSH OPERATOR ROUTINE ADDRESS AND FPA0 ONTO STACK
2512 B1AB 9E 3D LDX RELPTR GET POINTER TO ARITHMETIC/LOGICAL TABLE ENTRY FOR
2513 * LAST CALCULATED OPERATION
2514 B1AD 35 02 PULS A GET PRECEDENCE FLAG OF PREVIOUS OPERATION
2515 B1AF 26 1D BNE LB1CE BRANCH IF NOT END OF OPERATION
2516 B1B1 4D TSTA CHECK TYPE OF PRECEDENCE FLAG
2517 > B1B2 10 27 00 6A LBEQ LB220 BRANCH IF END OF EXPRESSION OR SUB-EXPRESSION
2518 B1B6 20 4B BRA LB203 EVALUATE AN OPERATION
2519 * DO A RELATIONAL COMPARISON HERE
2520 B1B8 08 06 LB1B8 ASL VALTYP BIT 7 OF TYPE FLAG TO CARRY
2521 B1BA 59 ROLB SHIFT RELATIONAL FLAG LEFT - VALTYP TO BIT 0
2522 B1BB 8D 09 BSR LB1C6 MOVE THE INPUT POINTER BACK ONE
2523 B1BD 8E B1 CB LDX #LB1CB POINT X TO RELATIONAL COMPARISON JUMP TABLE
2524 B1C0 D7 3F STB TRELFL SAVE RELATIONAL COMPARISON DATA
2525 B1C2 0F 06 CLR VALTYP SET VARIABLE TYPE TO NUMERIC
2526 B1C4 20 D9 BRA LB19F PERFORM OPERATION OR SAVE ON STACK
2527
2528 B1C6 9E A6 LB1C6 LDX CHARAD * GET BASIC’S INPUT POINTER AND
2529 B1C8 7E AE BB JMP LAEBB * MOVE IT BACK ONE
2530 * RELATIONAL COMPARISON JUMP TABLE
2531 B1CB 64 LB1CB FCB $64 RELATIONAL COMPARISON FLAG
2532 B1CC B2 F4 LB1CC FDB LB2F4 JUMP ADDRESS
2533
2534 B1CE A1 84 LB1CE CMPA ,X COMPARE PRECEDENCE OF LAST DONE OPERATION TO
2535 * NEXT TO BE DONE OPERATION
2536 B1D0 24 31 BCC LB203 EVALUATE OPERATION IF LOWER PRECEDENCE
2537 B1D2 20 D3 BRA LB1A7 PUSH OPERATION DATA ON STACK IF HIGHER PRECEDENCE
2538
2539 * PUSH OPERATOR EVALUATION ADDRESS AND FPA0 ONTO STACK AND EVALUATE ANOTHER EXPR
2540 B1D4 EC 01 LB1D4 LDD 1,X GET ADDRESS OF OPERATOR ROUTINE
2541 B1D6 34 06 PSHS B,A SAVE IT ON THE STACK
2542 B1D8 8D 08 BSR LB1E2 PUSH FPA0 ONTO STACK
2543 B1DA D6 3F LDB TRELFL GET BACK RELATIONAL OPERATOR FLAG
2544 B1DC 16 FF 7B LBRA LB15A EVALUATE ANOTHER EXPRESSION
2545 B1DF 7E B2 77 LB1DF JMP LB277 ‘SYNTAX ERROR’
2546 * PUSH FPA0 ONTO THE STACK. ,S = EXPONENT
2547 * 1-2,S =HIGH ORDER MANTISSA 3-4,S = LOW ORDER MANTISSA
2548 * 5,S = SIGN RETURN WITH PRECEDENCE CODE IN ACCA
2549 B1E2 D6 54 LB1E2 LDB FP0SGN GET SIGN OF FPA0 MANTISSA
2550 B1E4 A6 84 LDA ,X GET PRECEDENCE CODE TO ACCA
2551 B1E6 35 20 LB1E6 PULS Y GET RETURN ADDRESS FROM STACK & PUT IT IN Y
2552 B1E8 34 04 PSHS B SAVE ACCB ON STACK
2553 B1EA D6 4F LB1EA LDB FP0EXP * PUSH FPA0 ONTO THE STACK
2554 B1EC 9E 50 LDX FPA0 *
2555 B1EE DE 52 LDU FPA0+2 *
2556 B1F0 34 54 PSHS U,X,B *
2557 B1F2 6E A4 JMP ,Y JUMP TO ADDRESS IN Y
2558
2559 * BRANCH HERE IF NON-OPERATOR CHARACTER FOUND - USUALLY ‘)‘ OR END OF LINE
2560 B1F4 9E 8A LB1F4 LDX ZERO POINT X TO DUMMY VALUE (ZERO)
2561 B1F6 A6 E0 LDA ,S+ GET PRECEDENCE FLAG FROM STACK
2562 B1F8 27 26 BEQ LB220 BRANCH IF END OF EXPRESSION
2563 B1FA 81 64 LB1FA CMPA #$64 * CHECK FOR RELATIONAL COMPARISON FLAG
2564 B1FC 27 03 BEQ LB201 * AND BRANCH IF RELATIONAL COMPARISON
2565 B1FE BD B1 43 JSR LB143 ‘TM’ ERROR IF VARIABLE TYPE = STRING
2566 B201 9F 3D LB201 STX RELPTR SAVE POINTER TO OPERATOR ROUTINE
2567 B203 35 04 LB203 PULS B GET RELATIONAL OPERATOR FLAG FROM STACK
2568 B205 81 5A CMPA #$5A CHECK FOR ‘NOT’ OPERATOR
2569 B207 27 19 BEQ LB222 RETURN IF ‘NOT’ - NO RELATIONAL COMPARISON
2570 B209 81 7D CMPA #$7D CHECK FOR NEGATION (UNARY) FLAG
2571 B20B 27 15 BEQ LB222 RETURN IF NEGATION - NO RELATIONAL COMPARISON
2572
2573 * EVALUATE AN OPERATION. EIGHT BYTES WILL BE STORED ON STACK, FIRST SIX BYTES
2574 * ARE A TEMPORARY FLOATING POINT RESULT THEN THE ADDRESS OF ROUTINE WHICH
2575 * WILL EVALUATE THE OPERATION. THE RTS AT END OF ROUTINE WILL VECTOR
2576 * TO EVALUATING ROUTINE.
2577 B20D 54 LSRB = ROTATE VALTYP BIT INTO CARRY
2578 B20E D7 0A STB RELFLG = FLAG AND SAVE NEW RELFLG
2579 B210 35 52 PULS A,X,U * PULL A FP VALUE OFF OF THE STACK
2580 B212 97 5C STA FP1EXP * AND SAVE IT IN FPA1
2581 B214 9F 5D STX FPA1 *
2582 B216 DF 5F STU FPA1+2 *
2583 B218 35 04 PULS B = GET MANTISSA SIGN AND
2584 B21A D7 61 STB FP1SGN = SAVE IT IN FPA1
2585 B21C D8 54 EORB FP0SGN EOR IT WITH FPA1 MANTISSA SIGN
2586 B21E D7 62 STB RESSGN SAVE IT IN RESULT SIGN BYTE
2587 B220 D6 4F LB220 LDB FP0EXP GET EXPONENT OF FPA0
2588 B222 39 LB222 RTS
2589
2590 B223 BD 01 8B LB223 JSR RVEC15 HOOK INTO RAM
2591 B226 0F 06 CLR VALTYP INITIALIZE TYPE FLAG TO NUMERIC
2592 B228 9D 9F JSR GETNCH GET AN INPUT CHAR
2593 B22A 24 03 BCC LB22F BRANCH IF NOT NUMERIC
2594 B22C 7E BD 12 LB22C JMP LBD12 CONVERT ASCII STRING TO FLOATING POINT -
2595 * RETURN RESULT IN FPA0
2596 * PROCESS A NON NUMERIC FIRST CHARACTER
2597 B22F BD B3 A2 LB22F JSR LB3A2 SET CARRY IF NOT ALPHA
2598 B232 24 50 BCC LB284 BRANCH IF ALPHA CHARACTER
2599 B234 81 2E CMPA #'. IS IT ‘.‘ (DECIMAL POINT)?
2600 B236 27 F4 BEQ LB22C CONVERT ASCII STRING TO FLOATING POINT
2601 B238 81 AC CMPA #$AC MINUS TOKEN
2602 B23A 27 40 BEQ LB27C YES - GO PROCESS THE MINUS OPERATOR
2603 B23C 81 AB CMPA #$AB PLUS TOKEN
2604 B23E 27 E3 BEQ LB223 YES - GET ANOTHER CHARACTER
2605 B240 81 22 CMPA #'" STRING DELIMITER?
2606 B242 26 0A BNE LB24E NO
2607 B244 9E A6 LB244 LDX CHARAD CURRENT BASIC POINTER TO X
2608 B246 BD B5 18 JSR LB518 SAVE STRING ON STRING STACK
2609 B249 9E 64 LB249 LDX COEFPT * GET ADDRESS OF END OF STRING AND
2610 B24B 9F A6 STX CHARAD * PUT BASIC’S INPUT POINTER THERE
2611 B24D 39 RTS
2612 B24E 81 A8 LB24E CMPA #$A8 NOT TOKEN?
2613 B250 26 0D BNE LB25F NO
2614 * PROCESS THE NOT OPERATOR
2615 B252 86 5A LDA #$5A ‘NOT’ PRECEDENCE FLAG
2616 B254 BD B1 5A JSR LB15A PROCESS OPERATION FOLLOWING ‘NOT’
2617 B257 BD B3 ED JSR INTCNV CONVERT FPA0 TO INTEGER IN ACCD
2618 B25A 43 COMA * ‘NOT’ THE INTEGER
2619 B25B 53 COMB *
2620 B25C 7E B4 F4 JMP GIVABF CONVERT ACCD TO FLOATING POINT (FPA0)
2621 B25F 4C LB25F INCA CHECK FOR TOKENS PRECEEDED BY 5FF
2622 B260 27 2E BEQ LB290 IT WAS PRECEEDED BY 5FF
2623 B262 8D 06 LB262 BSR LB26A SYNTAX CHECK FOR A ‘(‘
2624 B264 BD B1 56 JSR LB156 EVALUATE EXPRESSIONS WITHIN PARENTHESES AT
2625 * HIGHEST PRECEDENCE
2626 B267 C6 29 LB267 LDB #') SYNTAX CHECK FOR ‘)‘
2627 B269 8C FCB SKP2 SKIP 2 BYTES
2628 B26A C6 28 LB26A LDB #'( SYNTAX CHECK FOR ‘(‘
2629 B26C 8C FCB SKP2 SKIP 2 BYTES
2630 B26D C6 2C LB26D LDB #', SYNTAX CHECK FOR COMMA
2631 B26F E1 9F 00 A6 LB26F CMPB [CHARAD] * COMPARE ACCB TO CURRENT INPUT
2632 B273 26 02 BNE LB277 * CHARACTER - SYNTAX ERROR IF NO MATCH
2633 B275 0E 9F JMP GETNCH GET A CHARACTER FROM BASIC
2634 B277 C6 02 LB277 LDB #2*1 SYNTAX ERROR
2635 B279 7E AC 46 JMP LAC46 JUMP TO ERROR HANDLER
2636
2637 * PROCESS THE MINUS (UNARY) OPERATOR
2638 B27C 86 7D LB27C LDA #$7D MINUS (UNARY) PRECEDENCE FLAG
2639 B27E BD B1 5A JSR LB15A PROCESS OPERATION FOLLOWING ‘UNARY’ NEGATION
2640 B281 7E BE E9 JMP LBEE9 CHANGE SIGN OF FPA0 MANTISSA
2641
2642 * EVALUATE ALPHA EXPRESSION
2643 B284 BD B3 57 LB284 JSR LB357 FIND THE DESCRIPTOR ADDRESS OF A VARIABLE
2644 B287 9F 52 STX FPA0+2 SAVE DESCRIPTOR ADDRESS IN FPA0
2645 B289 96 06 LDA VALTYP TEST VARIABLE TYPE
2646 B28B 26 95 BNE LB222 RETURN IF STRING
2647 B28D 7E BC 14 JMP LBC14 COPY A FP NUMBER FROM (X) TO FPA0
2648
2649 * EVALUATING A SECONDARY TOKEN
2650 B290 9D 9F LB290 JSR GETNCH GET AN INPUT CHARACTER (SECONDARY TOKEN)
2651 B292 1F 89 TFR A,B SAVE IT IN ACCB
2652 B294 58 ASLB X2 & BET RID OF BIT 7
2653 B295 9D 9F JSR GETNCH GET ANOTHER INPUT CHARACTER
2654 B297 C1 26 CMPB #2*19 19 SECONDARY FUNCTIONS IN BASIC
2655 B299 23 04 BLS LB29F BRANCH IF COLOR BASIC TOKEN
2656 B29B 6E 9F 01 32 JMP [COMVEC+18] JUMP TO EXBAS SECONDARY TOKEN HANDLER
2657 B29F 34 04 LB29F PSHS B SAVE TOKEN OFFSET ON STACK
2658 B2A1 C1 1C CMPB #2*14 CHECK FOR NUMERIC ARGUMENT TOKEN
2659 B2A3 25 22 BCS LB2C7 DO SECONDARIES $8D (JOYSTK) OR LESS
2660 B2A5 C1 24 CMPB #2*18 *
2661 B2A7 24 20 BCC LB2C9 * DO SECONDARIES $92 (INKEY$) OR >
2662 B2A9 8D BF BSR LB26A SYNTAX CHECK FOR A ‘(‘
2663 B2AB A6 E4 LDA ,S GET TOKEN NUMBER
2664 B2AD 81 22 CMPA #2*17 CHECK FOR ‘POINT’ COMMAND
2665 B2AF 24 18 BCC LB2C9 DO POINT COMMAND ($91)
2666 * DO SECONDARIES $8E, $8F, $90 (LEFT$, RIGHT$, MID$)
2667 B2B1 BD B1 56 JSR LB156 EVALUATE FIRST STRING IN ARGUMENT
2668 B2B4 8D B7 BSR LB26D SYNTAX CHECK FOR A COMMA
2669 B2B6 BD B1 46 JSR LB146 ‘TM’ ERROR IF NUMERIC VARiABLE
2670 B2B9 35 02 PULS A GET TOKEN OFFSET FROM STACK
2671 B2BB DE 52 LDU FPA0+2 POINT U TO STRING DESCRIPTOR
2672 B2BD 34 42 PSHS U,A SAVE TOKEN OFFSET AND DESCRIPTOR ADDRESS
2673 B2BF BD B7 0B JSR LB70B EVALUATE FIRST NUMERIC ARGUMENT
2674 B2C2 35 02 PULS A GET TOKEN OFFSET FROM STACK
2675 B2C4 34 06 PSHS B,A SAVE TOKEN OFFSET AND NUMERIC ARGUMENT
2676 B2C6 8E FCB $8E OP CODE OF LDX# - SKlP 2 BYTES
2677 B2C7 8D 99 LB2C7 BSR LB262 SYNTAX CHECK FOR A ‘(‘
2678 B2C9 35 04 LB2C9 PULS B GET TOKEN OFFSET
2679 B2CB BE 01 28 LDX COMVEC+8 GET SECONDARY FUNCTION JUMP TABLE ADDRESS
2680 B2CE 3A LB2CE ABX ADD IN COMMAND OFFSET
2681 *
2682 * HERE IS WHERE WE BRANCH TO A SECONDARY FUNCTION
2683 B2CF AD 94 JSR [,X] GO DO AN SECONDARY FUNCTION
2684 B2D1 7E B1 43 JMP LB143 ‘TM’ ERROR IF VARIABLE TYPE = STRING
2685
2686 * LOGICAL OPERATOR ‘OR’ JUMPS HERE
2687 B2D4 86 LB2D4 FCB SKP1LD SKIP ONE BYTE - ‘OR’ FLAG = $4F
2688
2689 * LOGICAL OPERATOR ‘AND’ JUMPS HERE
2690 B2D5 4F LB2D5 CLRA AND FLAG = 0
2691 B2D6 97 03 STA TMPLOC AND/OR FLAG
2692 B2D8 BD B3 ED JSR INTCNV CONVERT FPA0 INTO AN INTEGER IN ACCD
2693 B2DB DD 01 STD CHARAC TEMP SAVE ACCD
2694 B2DD BD BC 4A JSR LBC4A MOVE FPA1 TO FPA0
2695 B2E0 BD B3 ED JSR INTCNV CONVERT FPA0 INTO AN INTEGER IN ACCD
2696 B2E3 0D 03 TST TMPLOC CHECK AND/OR FLAG
2697 B2E5 26 06 BNE LB2ED BRANCH IF OR
2698 B2E7 94 01 ANDA CHARAC * ‘AND’ ACCD WITH FPA0 INTEGER
2699 B2E9 D4 02 ANDB ENDCHR * STORED IN ENDCHR
2700 B2EB 20 04 BRA LB2F1 CONVERT TO FP
2701 B2ED 9A 01 LB2ED ORA CHARAC * ‘OR’ ACCD WITH FPA0 INTEGER
2702 B2EF DA 02 ORB ENDCHR * STORED IN CHARAC
2703 B2F1 7E B4 F4 LB2F1 JMP GIVABF CONVERT THE VALUE IN ACCD INTO A FP NUMBER
2704
2705 * RELATIONAL COMPARISON PROCESS HANDLER
2706 B2F4 BD B1 48 JSR LB148 ‘TM’ ERROR IF TYPE MISMATCH
2707 B2F7 26 10 BNE LB309 BRANCH IF STRING VARIABLE
2708 B2F9 96 61 LDA FP1SGN * ‘PACK’ THE MANTISSA
2709 B2FB 8A 7F ORA #$7F * SIGN OF FPA1 INTO
2710 B2FD 94 5D ANDA FPA1 * BIT 7 OF THE
2711 B2FF 97 5D STA FPA1 * MANTISSA MS BYTE
2712 B301 8E 00 5C LDX #FP1EXP POINT X TO FPA1
2713 B304 BD BC 96 JSR LBC96 COMPARE FPA0 TO FPA1
2714 B307 20 36 BRA LB33F CHECK TRUTH OF RELATIONAL COMPARISON
2715
2716 * RELATIONAL COMPARISON OF STRINGS
2717 B309 0F 06 LB309 CLR VALTYP SET VARIABLE TYPE TO NUMERIC
2718 B30B 0A 3F DEC TRELFL REMOVE STRING TYPE FLAG (BIT0=1 FOR STRINGS) FROM THE
2719 * DESIRED RELATIONAL COMPARISON DATA
2720 B30D BD B6 57 JSR LB657 GET LENGTH AND ADDRESS OF STRING WHOSE
2721 * DESCRIPTOR ADDRESS IS IN THE BOTTOM OF FPA0
2722 B310 D7 56 STB STRDES * SAVE LENGTH AND ADDRESS IN TEMPORARY
2723 B312 9F 58 STX STRDES+2 * DESCRIPTOR (STRING B)
2724 B314 9E 5F LDX FPA1+2 = RETURN LENGTH AND ADDRESS OF STRING
2725 B316 BD B6 59 JSR LB659 = WHOSE DESCRIPTOR ADDRESS IS STORED IN FPA1+2
2726 B319 96 56 LDA STRDES LOAD ACCA WITH LENGTH OF STRING B
2727 B31B 34 04 PSHS B SAVE LENGTH A ON STACK
2728 B31D A0 E0 SUBA ,S+ SUBTRACT LENGTH A FROM LENGTH B
2729 B31F 27 07 BEQ LB328 BRANCH IF STRINGS OF EQUAL LENGTH
2730 B321 86 01 LDA #1 TRUE FLAG
2731 B323 24 03 BCC LB328 TRUE IF LENGTH B > LENGTH A
2732 B325 D6 56 LDB STRDES LOAD ACCB WITH LENGTH B
2733 B327 40 NEGA SET FLAG = FALSE (1FF)
2734 B328 97 54 LB328 STA FP0SGN SAVE TRUE/FALSE FLAG
2735 B32A DE 58 LDU STRDES+2 POINT U TO START OF STRING
2736 B32C 5C INCB COMPENSATE FOR THE DECB BELOW
2737 * ENTER WITH ACCB CONTAINING LENGTH OF SHORTER STRING
2738 B32D 5A LB32D DECB DECREMENT SHORTER STRING LENGTH
2739 B32E 26 04 BNE LB334 BRANCH IF ALL OF STRING NOT COMPARED
2740 B330 D6 54 LDB FP0SGN GET TRUE/FALSE FLAB
2741 B332 20 0B BRA LB33F CHECK TRUTH OF RELATIONAL COMPARISON
2742 B334 A6 80 LB334 LDA ,X+ GET A BYTE FROM STRING A
2743 B336 A1 C0 CMPA ,U+ COMPARE TO STRING B
2744 B338 27 F3 BEQ LB32D CHECK ANOTHER CHARACTER IF =
2745 B33A C6 FF LDB #$FF FALSE FLAG IF STRING A > B
2746 B33C 24 01 BCC LB33F BRANCH IF STRING A > STRING B
2747 B33E 50 NEGB SET FLAG = TRUE
2748
2749 * DETERMINE TRUTH OF COMPARISON - RETURN RESULT IN FPA0
2750 B33F CB 01 LB33F ADDB #1 CONVERT $FF,0,1 TO 0,1,2
2751 B341 59 ROLB NOW IT’S 1,2,4 FOR > = <
2752 B342 D4 0A ANDB RELFLG ‘AND’ THE ACTUAL COMPARISON WITH THE DESIRED -
2753 COMPARISON
2754 B344 27 02 BEQ LB348 BRANCH IF FALSE (NO MATCHING BITS)
2755 B346 C6 FF LDB #$FF TRUE FLAG
2756 B348 7E BC 7C LB348 JMP LBC7C CONVERT ACCB INTO FP NUMBER IN FPA0

[pser1]

Buenos días , Luis
¿Vale la pena llenar este hilo con mensajes cortos que no son otra cosa que partes de la serie de tres libros CoCo Basic Unravelled?
Para ahorrar trabajo adjunto aquí en forma de zip los tres libros conocidos, bueno añadiendo el de disco son cuatro!
saludos
pere

Color Basic Unravelled II (Spectral Associates, Walter K. Zydhek).zip

(959.42 KiB) Descargado 2 veces

Extended Basic Unravelled II (Spectral Associates, Walter K. Zydhek).zip

(985.24 KiB) Descargado 1 vez

Super Extended Basic Unravelled II (Spectral Associates, Walter K. Zydhek).zip

(828.52 KiB) Descargado 1 vez

Disk Basic Unravelled II (Spectral Associates, Walter K. Zydhek).zip

(1.17 MiB) Descargado 1 vez

[luiscoco]

Buenos días , Luis
¿Vale la pena llenar este hilo con mensajes cortos que no son otra cosa que partes de la serie de tres libros CoCo Basic Unravelled?
Para ahorrar trabajo adjunto aquí en forma de zip los tres libros conocidos, bueno añadiendo el de disco son cuatro!
saludos
pere

Puedo quitar los trozos de código, lo que me interesa es el resumen que hago al principio de cada función para tener claro lo que hace y como cambiarlo, teniendo una vista general, puedo planear como modificar las cosas que afectan a todo.

Hasta ahora tengo claro como voy a hacer lo siguiente
sin números de linea y las etiquetas aquí
los GOTO y GOSUB aquí

y no tan claro:
VARIABLES
FUNCIONES y SUBs o PROCEDURES
FORMATOS DOS

Recuerda que es tambien para dragón y colocaré las decisiones de cada función en cada segmento.
Por ahora uso el hilo como herramienta para aclarar las ideas.
Para discusiones usaremos el hilo anexo

[luiscoco]

Comando DIM ($B34B-$B3A1)

No se bien porque comienza buscando una coma, y da SYNTAX ERROR si no esta la coma
- Pone un 1 en DIMFLG
- Pone la primera letra del nombre de la variable en VARNAM
- Coloca un supuesto 0 como segunda letra
- coloca tipo numérico en VALTYP=0
- Toma otra letra, esta puede ser numérica
- Lee mas caracteres, ignorándolos mientras sean Alfanuméricos
- Acepta un $ como definidor de string
- Busca "(" pero acepta variables solas
- Si es arreglo, evalúa una expresión numérica o da error
- Puede evaluar varias expresiones

Lo que veo mal de todo esto es que se debió ejecutar alguna rutina para buscar el nombre de una variable ya que esto obviamente es muy usado y eso no esta pasando.

Código: Seleccionar todo

2758 * DIM
2759 B34B BD B2 6D LB34B JSR LB26D SYNTAX CHECK FOR COMMA
2760 B34E C6 01 DIM LDB #1 DIMENSION FLAG
2761 B350 8D 08 BSR LB35A SAVE ARRAY SPACE FOR THIS VARIABLE
2762 B352 9D A5 JSR GETCCH GET CURRENT INPUT CHARACTER
2763 B354 26 F5 BNE LB34B KEEP DIMENSIONING IF NOT END OF LINE
2764 B356 39 RTS

Código: Seleccionar todo

2765 * EVALUATE A VARIABLE - RETURN X AND
2766 * VARPTR POINTING TO VARIABLE DESCRIPTOR
2767 * EACH VARIABLE REQUIRES 7 BYTES - THE FIRST TWO
2768 * BYTES ARE THE VARIABLE NAME AND THE NEXT 5
2769 * BYTES ARE THE DESCRIPTOR. IF BIT 7 OF THE
2770 * FIRST BYTE OF VARlABLE NAME IS SET, THE
2771 * VARIABLE IS A DEF FN VARIABLE. IF BIT 7 OF
2772 * THE SECOND BYTE OF VARIABLE NAME IS SET, THE
2773 * VARIABLE IS A STRING, OTHERWISE THE VARIABLE
2774 * IS NUMERIC.
2775 * IF THE VARIABLE IS NOT FOUND, A ZERO VARIABLE IS
2776 * INSERTED INTO THE VARIABLE SPACE
2777 B357 5F LB357 CLRB DIMENSION FLAG = 0; DO NOT SET UP AN ARRAY
2778 B358 9D A5 JSR GETCCH GET CURRENT INPUT CHARACTER
2779 B35A D7 05 LB35A STB DIMFLG SAVE ARRAY FLAG
2780 B35C 97 37 STA VARNAM SAVE INPUT CHARACTER
2781 * ENTRY POINT FOR DEF FN VARIABLE SEARCH
2782 B35E 9D A5 LB35C JSR GETCCH GET CURRENT INPUT CHARACTER
2783 B360 8D 40 BSR LB3A2 SET CARRY IF NOT ALPHA
2784 B362 10 25 FF 11 LBCS LB277 SYNTAX ERROR IF NOT ALPHA
2785 B366 5F CLRB DEFAULT 2ND VARIABLE CHARACTER TO ZERO
2786 B367 D7 06 STB VALTYP SET VARIABLE TYPE TO NUMERIC
2787 B369 9D 9F JSR GETNCH GET ANOTHER CHARACTER FROM BASIC
2788 B36B 25 04 BCS LB371 BRANCH IF NUMERIC (2ND CHARACTER IN
2789 * VARIABLE MAY BE NUMERIC)
2790 B36D 8D 33 BSR LB3A2 SET CARRY IF NOT ALPHA
2791 B36F 25 0A BCS LB37B BRANCH IF NOT ALPHA
2792 B371 1F 89 LB371 TFR A,B SAVE 2ND CHARACTER IN ACCB
2793 * READ INPUT CHARACTERS UNTIL A NON ALPHA OR
2794 * NON NUMERIC IS FOUND - IGNORE ALL CHARACTERS
2795 * IN VARIABLE NAME AFTER THE 1ST TWO
2796 B373 9D 9F LB373 JSR GETNCH GET AN INPUT CHARACTER
2797 B375 25 FC BCS LB373 BRANCH IF NUMERIC
2798 B377 8D 29 BSR LB3A2 SET CARRY IF NOT ALPHA
2799 B379 24 F8 BCC LB373 BRANCH IF ALPHA
2800 B37B 81 24 LB37B CMPA #'$ CHECK FOR A STRING VARIABLE
2801 B37D 26 06 BNE LB385 BRANCH IF IT IS NOT A STRING
2802 B37F 03 06 COM VALTYP SET VARIABLE TYPE TO STRING
2803 B381 CB 80 ADDB #$80 SET BIT 7 OF 2ND CHARACTER (STRING)
2804 B383 9D 9F JSR GETNCH GET AN INPUT CHARACTER
2805 B385 D7 38 LB385 STB VARNAM+1 SAVE 2ND CHARACTER IN VARNAM+1
2806 B387 9A 08 ORA ARYDIS OR IN THE ARRAY DISABLE FLAG - IF = $80,
2807 * DON’T SEARCH FOR VARIABLES IN THE ARRAYS
2808 B389 80 28 SUBA #'( IS THIS AN ARRAY VARIABLE?
2809 > B38B 10 27 00 75 LBEQ LB404 BRANCH IF IT IS
2810 B38F 0F 08 CLR ARYDIS RESET THE ARRAY DISABLE FLAG
2811 B391 9E 1B LDX VARTAB POINT X TO THE START OF VARIABLES
2812 B393 DC 37 LDD VARNAM GET VARIABLE IN QUESTION
2813 B395 9C 1D LB395 CMPX ARYTAB COMPARE X TO THE END OF VARIABLES
2814 B397 27 12 BEQ LB3AB BRANCH IF END OF VARIABLES
2815 B399 10 A3 81 CMPD ,X++ * COMPARE VARIABLE IN QUESTION TO CURRENT
2816 B39C 27 3E BEQ LB3DC * VARIABLE AND BRANCH IF MATCH
2817 B39E 30 05 LEAX 5,X = MOVE POINTER TO NEXT VARIABLE AND
2818 B3A0 20 F3 BRA LB395 = KEEP LOOKING


IS_MAYUS
Esta pequeña rutina enciende el acarreo si el byte en ACCA no es una letra mayúscula.
ENTRADAS: ACCA
SALIDAS: Acarreo si no es mayúsculas
En B3A8 no se porque usa SUBA -('Z+1), en lugar de ADDA 'Z+1 , esta restando un negativo (complementario) pero podría hacer usado una suma para reponer el valor. También se podía haber usado CMPA.

Código: Seleccionar todo

2819
2820 * SET CARRY IF NOT UPPER CASE ALPHA
2821 B3A2 81 41 LB3A2 CMPA #'A * CARRY SET IF < ‘A’
2822 B3A4 25 04 BCS LB3AA *
2823 B3A6 80 5B SUBA #'Z+1 =
2824 B3A8 80 A5 SUBA #-('Z+1) = CARRY CLEAR IF <= 'Z'
2825 B3AA 39 LB3AA RTS

Código: Seleccionar todo

2826 * PUT A NEW VARIABLE IN TABLE OF VARIABLES
2827 B3AB 8E 00 8A LB3AB LDX #ZERO POINT X TO ZERO LOCATION
2828 B3AE EE E4 LDU ,S GET CURRENT RETURN ADDRESS
2829 B3B0 11 83 B2 87 CMPU #LB287 DID WE COME FROM ‘EVALUATE ALPHA EXPR’?
2830 B3B4 27 28 BEQ LB3DE YES - RETURN A ZERO VALUE
2831 B3B6 DC 1F LDD ARYEND * GET END OF ARRAYS ADDRESS AND
2832 B3B8 DD 43 STD V43 * SAVE IT AT V43
2833 B3BA C3 00 07 ADDD #7 = ADD 7 TO END OF ARRAYS (EACH
2834 B3BD DD 41 STD V41 = VARIABLE = 7 BYTES) AND SAVE AT V41
2835 B3BF 9E 1D LDX ARYTAB * GET END OF VARIABLES AND SAVE AT V47
2836 B3C1 9F 47 STX V47 *
2837 B3C3 BD AC 1E JSR LAC1E MAKE A SEVEN BYTE SLOT FOR NEW VARIABLE AT
2838 * TOP OF VARIABLES
2839 B3C6 9E 41 LDX V41 = GET NEW END OF ARRAYS AND SAVE IT
2840 B3C8 9F 1F STX ARYEND =
2841 B3CA 9E 45 LDX V45 * GET NEW END OF VARIABLES AND SAVE IT
2842 B3CC 9F 1D STX ARYTAB *
2843 B3CE 9E 47 LDX V47 GET OLD END OF VARIABLES
2844 B3D0 DC 37 LDD VARNAM GET NEW VARIABLE NAME
2845 B3D2 ED 81 STD ,X++ SAVE VARIABLE NAME
2846 B3D4 4F CLRA * ZERO OUT THE FP VALUE OF THE NUMERIC
2847 B3D5 5F CLRB * VARIABLE OR THE LENGTH AND ADDRESS
2848 B3D6 ED 84 STD ,X * OF A STRING VARIABLE
2849 B3D8 ED 02 STD 2,X *
2850 B3DA A7 04 STA 4,X *
2851 B3DC 9F 39 LB3DC STX VARPTR STORE ADDRESS OF VARIABLE VALUE
2852 B3DE 39 LB3DE RTS
2853 *
2854 B3DF 90 80 00 00 00 LB3DF FCB $90,$80,$00,$00,$00 * FLOATING POINT -32768
2855 * SMALLEST SIGNED TWO BYTE INTEGER
2856 *
2857 B3E4 9D 9F LB3E4 JSR GETNCH GET AN INPUT CHARACTER FROM BASIC
2858 B3E6 BD B1 41 LB3E6 JSR LB141 GO EVALUATE NUMERIC EXPRESSION
2859 B3E9 96 54 LB3E9 LDA FP0SGN GET FPA0 MANTISSA SIGN
2860 B3EB 2B 5D BMI LB44A ‘FC’ ERROR IF NEGATIVE NUMBER
2861
2862 * CONVERT FPA0 TO A SIGNED TWO BYTE INTEGER; RETURN VALUE IN ACCD
2863 B3ED BD B1 43 INTCNV JSR LB143 ‘TM’ ERROR IF STRING VARIABLE
2864 B3F0 96 4F LDA FP0EXP GET FPA0 EXPONENT
2865 B3F2 81 90 CMPA #$90 * COMPARE TO 32768 - LARGEST INTEGER EXPONENT AND
2866 B3F4 25 08 BCS LB3FE * BRANCH IF FPA0 < 32768
2867 B3F6 8E B3 DF LDX #LB3DF POINT X TO FP VALUE OF -32768
2868 B3F9 BD BC 96 JSR LBC96 COMPARE -32768 TO FPA0
2869 B3FC 26 4C BNE LB44A ‘FC’ ERROR IF NOT =
2870 B3FE BD BC C8 LB3FE JSR LBCC8 CONVERT FPA0 TO A TWO BYTE INTEGER
2871 B401 DC 52 LDD FPA0+2 GET THE INTEGER
2872 B403 39 RTS
2873 * EVALUATE AN ARRAY VARIABLE
2874 B404 DC 05 LB404 LDD DIMFLG GET ARRAY FLAG AND VARIABLE TYPE
2875 B406 34 06 PSHS B,A SAVE THEM ON STACK
2876 B408 12 NOP DEAD SPACE CAUSED BY 1.2 REVISION
2877 B409 5F CLRB RESET DIMENSION COUNTER
2878 B40A 9E 37 LB40A LDX VARNAM GET VARIABLE NAME
2879 B40C 34 14 PSHS X,B SAVE VARIABLE NAME AND DIMENSION COUNTER
2880 B40E 8D D4 BSR LB3E4 EVALUATE EXPRESSION (DIMENSlON LENGTH)
2881 B410 35 34 PULS B,X,Y PULL OFF VARIABLE NAME, DIMENSlON COUNTER,
2882 * ARRAY FLAG
2883 B412 9F 37 STX VARNAM SAVE VARIABLE NAME AND VARIABLE TYPE
2884 B414 DE 52 LDU FPA0+2 GET DIMENSION LENGTH
2885 B416 34 60 PSHS U,Y SAVE DIMENSION LENGTH, ARRAY FLAG, VARIABLE TYPE
2886 B418 5C INCB INCREASE DIMENSION COUNTER
2887 B419 9D A5 JSR GETCCH GET CURRENT INPUT CHARACTER
2888 B41B 81 2C CMPA #', CHECK FOR ANOTHER DIMENSION
2889 B41D 27 EB BEQ LB40A BRANCH IF MORE
2890 B41F D7 03 STB TMPLOC SAVE DIMENSION COUNTER
2891 B421 BD B2 67 JSR LB267 SYNTAX CHECK FOR A ‘)‘
2892 B424 35 06 PULS A,B * RESTORE VARIABLE TYPE AND ARRAY
2893 B426 DD 05 STD DIMFLG * FLAG - LEAVE DIMENSION LENGTH ON STACK
2894 B428 9E 1D LDX ARYTAB GET START OF ARRAYS
2895 B42A 9C 1F LB42A CMPX ARYEND COMPARE TO END OF ARRAYS
2896 B42C 27 21 BEQ LB44F BRANCH IF NO MATCH FOUND
2897 B42E DC 37 LDD VARNAM GET VARIABLE IN QUESTION
2898 B430 10 A3 84 CMPD ,X COMPARE TO CURRENT VARIABLE
2899 B433 27 06 BEQ LB43B BRANCH IF =
2900 B435 EC 02 LDD 2,X GET OFFSET TO NEXT ARRAY VARIABLE
2901 B437 30 8B LEAX D,X ADD TO CURRENT POINTER
2902 B439 20 EF BRA LB42A KEEP SEARCHING
2903 B43B C6 12 LB43B LDB #2*9 ‘REDIMENSIONED ARRAY’ ERROR
2904 B43D 96 05 LDA DIMFLG * TEST ARRAY FLAG - IF <>0 YOU ARE TRYING
2905 B43F 26 0B BNE LB44C * TO REDIMENSION AN ARRAY
2906 B441 D6 03 LDB TMPLOC GET NUMBER OF DIMENSIONS IN ARRAY
2907 B443 E1 04 CMPB 4,X COMPARE TO THIS ARRAYS DIMENSIONS
2908 B445 27 59 BEQ LB4A0 BRANCH IF =
2909 B447 C6 10 LB447 LDB #8*2 ‘BAD SUBSCRIPT’
2910 B449 8C FCB SKP2 SKIP TWO BYTES
2911 B44A C6 08 LB44A LDB #4*2 ‘ILLEGAL FUNCTION CALL’
2912 B44C 7E AC 46 LB44C JMP LAC46 JUMP TO ERROR SERVICING ROUTINE
2913
2914 * INSERT A NEW ARRAY INTO ARRAY VARIABLES
2915 * EACH SET OF ARRAY VARIABLES IS PRECEEDED BY A DE-
2916 * SCRIPTOR BLOCK COMPOSED OF 5+2*N BYTES WHERE N IS THE
2917 * NUMBER OF DIMENSIONS IN THE ARRAY. THE BLOCK IS DEFINED
2918 * AS FOLLOWS: BYTES 0,1:VARIABLE’S NAME; 2,3:TOTAL LENGTH
2919 * OF ARRAY ITEMS AND DESCRIPTOR BLOCK; 4:NUMBER OF DIMEN-
2920 * ISIONS; 5,6:LENGTH OF DIMENSION 1; 7,8:LENGTH OF DIMEN-
2921 * SION 2;… 4+N,5+N:LENGTH OF DIMENSION N.
2922
2923 B44F CC 00 05 LB44F LDD #5 * 5 BYTES/ARRAY ENTRY SAVE AT COEFPT
2924 B452 DD 64 STD COEFPT *
2925 B454 DC 37 LDD VARNAM = GET NAME OF ARRAY AND SAVE IN
2926 B456 ED 84 STD ,X = FIRST 2 BYTES OF DESCRIPTOR
2927 B458 D6 03 LDB TMPLOC GET NUMBER OF DIMENSIONS AND SAVE IN
2928 B45A E7 04 STB 4,X * 5TH BYTE OF DESCRIPTOR
2929 B45C BD AC 33 JSR LAC33 CHECK FOR ROOM FOR DESCRIPTOR IN FREE RAM
2930 B45F 9F 41 STX V41 TEMPORARILY SAVE DESCRIPTOR ADDRESS
2931 B461 C6 0B LB461 LDB #11 * DEFAULT DIMENSION VALUE:X(10)
2932 B463 4F CLRA *
2933 B464 0D 05 TST DIMFLG = CHECK ARRAY FLAG AND BRANCH IF
2934 B466 27 05 BEQ LB46D = NOT DIMENSIONING AN ARRAY
2935 B468 35 06 PULS A,B GET DIMENSION LENGTH
2936 B46A C3 00 01 ADDD #1 ADD ONE (X(0) HAS A LENGTH OF ONE)
2937 B46D ED 05 LB46D STD 5,X SAVE LENGTH OF ARRAY DIMENSION
2938 B46F 8D 5D BSR LB4CE MULTIPLY ACCUM ARRAY SIZE NUMBER LENGTH
2939 * OF NEW DIMENSION
2940 B471 DD 64 STD COEFPT TEMP STORE NEW CURRENT ACCUMULATED ARRAY SIZE
2941 B473 30 02 LEAX 2,X BUMP POINTER UP TWO
2942 B475 0A 03 DEC TMPLOC * DECREMENT DIMENSION COUNTER AND BRANCH IF
2943 B477 26 E8 BNE LB461 * NOT DONE WITH ALL DIMENSIONS
2944 B479 9F 0F STX TEMPTR SAVE ADDRESS OF (END OF ARRAY DESCRIPTOR - 5)
2945 B47B D3 0F ADDD TEMPTR ADD TOTAL SIZE OF NEW ARRAY
2946 B47D 10 25 F7 C3 LBCS LAC44 ‘OM’ ERROR IF > $FFFF
2947 B481 1F 01 TFR D,X SAVE END OF ARRAY IN X
2948 B483 BD AC 37 JSR LAC37 MAKE SURE THERE IS ENOUGH FREE RAM FOR ARRAY
2949 B486 83 00 35 SUBD #STKBUF-5 SUBTRACT OUT THE (STACK BUFFER - 5)
2950 B489 DD 1F STD ARYEND SAVE NEW END OF ARRAYS
2951 B48B 4F CLRA ZERO = TERMINATOR BYTE
2952 B48C 30 1F LB48C LEAX -1,X * STORE TWO TERMINATOR BYTES AT
2953 B48E A7 05 STA 5,X * THE END OF THE ARRAY DESCRIPTOR
2954 B490 9C 0F CMPX TEMPTR *
2955 B492 26 F8 BNE LB48C *
2956 B494 9E 41 LDX V41 GET ADDRESS OF START OF DESCRIPTOR
2957 B496 96 1F LDA ARYEND GET MSB OF END OF ARRAYS; LSB ALREADY THERE
2958 B498 93 41 SUBD V41 SUBTRACT OUT ADDRESS OF START OF DESCRIPTOR
2959 B49A ED 02 STD 2,X SAVE LENGTH OF (ARRAY AND DESCRIPTOR)
2960 B49C 96 05 LDA DIMFLG * GET ARRAY FLAG AND BRANCH
2961 B49E 26 2D BNE LB4CD * BACK IF DIMENSIONING
2962 * CALCULATE POINTER TO CORRECT ELEMENT
2963 B4A0 E6 04 LB4A0 LDB 4,X GET THE NUMBER OF DIMENSIONS
2964 B4A2 D7 03 STB TMPLOC TEMPORARILY SAVE
2965 B4A4 4F CLRA * INITIALIZE POINTER
2966 B4A5 5F CLRB * TO ZERO
2967 B4A6 DD 64 LB4A6 STD COEFPT SAVE ACCUMULATED POINTER
2968 B4A8 35 06 PULS A,B * PULL DIMENSION ARGUMENT OFF THE
2969 B4AA DD 52 STD FPA0+2 * STACK AND SAVE IT
2970 B4AC 10 A3 05 CMPD 5,X COMPARE TO STORED ‘DIM’ ARGUMENT
2971 B4AF 24 3A BCC LB4EB ‘BS’ ERROR IF > = "DIM" ARGUMENT
2972 B4B1 DE 64 LDU COEFPT * GET ACCUMULATED POINTER AND
2973 B4B3 27 04 BEQ LB4B9 * BRANCH IF 1ST DIMENSION
2974 B4B5 8D 17 BSR LB4CE = MULTIPLY ACCUMULATED POINTER AND DIMENSION
2975 B4B7 D3 52 ADDD FPA0+2 = LENGTH AND ADD TO CURRENT ARGUMENT
2976 B4B9 30 02 LB4B9 LEAX 2,X MOVE POINTER TO NEXT DIMENSION
2977 B4BB 0A 03 DEC TMPLOC * DECREMENT DIMENSION COUNTER AND
2978 B4BD 26 E7 BNE LB4A6 * BRANCH IF ANY DIMENSIONS LEFT
2979 * MULTIPLY ACCD BY 5 - 5 BYTES/ARRAY VALUE
2980 B4BF ED E3 STD ,--S
2981 B4C1 58 ASLB
2982 B4C2 49 ROLA TIMES 2
2983 B4C3 58 ASLB
2984 B4C4 49 ROLA TIMES 4
2985 B4C5 E3 E1 ADDD ,S++ TIMES 5
2986 B4C7 30 8B LEAX D,X ADD OFFSET TO START OF ARRAY
2987 B4C9 30 05 LEAX 5,X ADJUST POINTER FOR SIZE OF DESCRIPTOR
2988 B4CB 9F 39 STX VARPTR SAVE POINTER TO ARRAY VALUE
2989 B4CD 39 LB4CD RTS
2990 * MULTIPLY 2 BYTE NUMBER IN 5,X BY THE 2 BYTE NUMBER
2991 IN COEFPT. RETURN RESULT IN ACCD, BS ERROR IF > $FFFF
2992 B4CE 86 10 LB4CE LDA #16 16 SHIFTS TO DO A MULTIPLY
2993 B4D0 97 45 STA V45 SHIFT COUNTER
2994 B4D2 EC 05 LDD 5,X * GET SIZE OF DIMENSION
2995 B4D4 DD 17 STD BOTSTK * AND SAVE IT
2996 B4D6 4F CLRA * ZERO
2997 B4D7 5F CLRB * ACCD
2998 B4D8 58 LB4D8 ASLB = SHIFT ACCB LEFT
2999 B4D9 49 ROLA = ONE BIT
3000 B4DA 25 0F BCS LB4EB 'BS' ERROR IF CARRY
3001 B4DC 08 65 ASL COEFPT+1 * SHIFT MULTIPLICAND LEFT ONE
3002 B4DE 09 64 ROL COEFPT * BIT - ADD MULTIPLIER TO ACCUMULATOR
3003 B4E0 24 04 BCC LB4E6 * IF CARRY <> 0
3004 B4E2 D3 17 ADDD BOTSTK ADD MULTIPLIER TO ACCD
3005 B4E4 25 05 BCS LB4EB 'BS' ERROR IF CARRY (>$FFFF)
3006 B4E6 0A 45 LB4E6 DEC V45 * DECREMENT SHIFT COUNTER
3007 B4E8 26 EE BNE LB4D8 * IF NOT DONE
3008 B4EA 39 RTS
3009 B4EB 7E B4 47 LB4EB JMP LB447 'BS' ERROR