zx81.txt (362497B)
1 ; =========================================================== 2 ; An Assembly Listing of the Operating System of the ZX81 ROM 3 ; =========================================================== 4 ; ------------------------- 5 ; Last updated: 13-DEC-2004 6 ; ------------------------- 7 ; 8 ; Work in progress. 9 ; This file will cross-assemble an original version of the "Improved" 10 ; ZX81 ROM. The file can be modified to change the behaviour of the ROM 11 ; when used in emulators although there is no spare space available. 12 ; 13 ; The documentation is incomplete and if you can find a copy 14 ; of "The Complete Spectrum ROM Disassembly" then many routines 15 ; such as POINTERS and most of the mathematical routines are 16 ; similar and often identical. 17 ; 18 ; I've used the labels from the above book in this file and also 19 ; some from the more elusive Complete ZX81 ROM Disassembly 20 ; by the same publishers, Melbourne House. 21 22 23 #define DEFB .BYTE ; TASM cross-assembler definitions 24 #define DEFW .WORD 25 #define EQU .EQU 26 27 28 ;***************************************** 29 ;** Part 1. RESTART ROUTINES AND TABLES ** 30 ;***************************************** 31 32 ; ----------- 33 ; THE 'START' 34 ; ----------- 35 ; All Z80 chips start at location zero. 36 ; At start-up the Interrupt Mode is 0, ZX computers use Interrupt Mode 1. 37 ; Interrupts are disabled . 38 39 ;; START 40 L0000: OUT ($FD),A ; Turn off the NMI generator if this ROM is 41 ; running in ZX81 hardware. This does nothing 42 ; if this ROM is running within an upgraded 43 ; ZX80. 44 LD BC,$7FFF ; Set BC to the top of possible RAM. 45 ; The higher unpopulated addresses are used for 46 ; video generation. 47 JP L03CB ; Jump forward to RAM-CHECK. 48 49 ; ------------------- 50 ; THE 'ERROR' RESTART 51 ; ------------------- 52 ; The error restart deals immediately with an error. ZX computers execute the 53 ; same code in runtime as when checking syntax. If the error occurred while 54 ; running a program then a brief report is produced. If the error occurred 55 ; while entering a BASIC line or in input etc., then the error marker indicates 56 ; the exact point at which the error lies. 57 58 ;; ERROR-1 59 L0008: LD HL,($4016) ; fetch character address from CH_ADD. 60 LD ($4018),HL ; and set the error pointer X_PTR. 61 JR L0056 ; forward to continue at ERROR-2. 62 63 ; ------------------------------- 64 ; THE 'PRINT A CHARACTER' RESTART 65 ; ------------------------------- 66 ; This restart prints the character in the accumulator using the alternate 67 ; register set so there is no requirement to save the main registers. 68 ; There is sufficient room available to separate a space (zero) from other 69 ; characters as leading spaces need not be considered with a space. 70 71 ;; PRINT-A 72 L0010: AND A ; test for zero - space. 73 JP NZ,L07F1 ; jump forward if not to PRINT-CH. 74 75 JP L07F5 ; jump forward to PRINT-SP. 76 77 ; --- 78 79 DEFB $FF ; unused location. 80 81 ; --------------------------------- 82 ; THE 'COLLECT A CHARACTER' RESTART 83 ; --------------------------------- 84 ; The character addressed by the system variable CH_ADD is fetched and if it 85 ; is a non-space, non-cursor character it is returned else CH_ADD is 86 ; incremented and the new addressed character tested until it is not a space. 87 88 ;; GET-CHAR 89 L0018: LD HL,($4016) ; set HL to character address CH_ADD. 90 LD A,(HL) ; fetch addressed character to A. 91 92 ;; TEST-SP 93 L001C: AND A ; test for space. 94 RET NZ ; return if not a space 95 96 NOP ; else trickle through 97 NOP ; to the next routine. 98 99 ; ------------------------------------ 100 ; THE 'COLLECT NEXT CHARACTER' RESTART 101 ; ------------------------------------ 102 ; The character address in incremented and the new addressed character is 103 ; returned if not a space, or cursor, else the process is repeated. 104 105 ;; NEXT-CHAR 106 L0020: CALL L0049 ; routine CH-ADD+1 gets next immediate 107 ; character. 108 JR L001C ; back to TEST-SP. 109 110 ; --- 111 112 DEFB $FF, $FF, $FF ; unused locations. 113 114 ; --------------------------------------- 115 ; THE 'FLOATING POINT CALCULATOR' RESTART 116 ; --------------------------------------- 117 ; this restart jumps to the recursive floating-point calculator. 118 ; the ZX81's internal, FORTH-like, stack-based language. 119 ; 120 ; In the five remaining bytes there is, appropriately, enough room for the 121 ; end-calc literal - the instruction which exits the calculator. 122 123 ;; FP-CALC 124 L0028: JP L199D ; jump immediately to the CALCULATE routine. 125 126 ; --- 127 128 ;; end-calc 129 L002B: POP AF ; drop the calculator return address RE-ENTRY 130 EXX ; switch to the other set. 131 132 EX (SP),HL ; transfer H'L' to machine stack for the 133 ; return address. 134 ; when exiting recursion then the previous 135 ; pointer is transferred to H'L'. 136 137 EXX ; back to main set. 138 RET ; return. 139 140 141 ; ----------------------------- 142 ; THE 'MAKE BC SPACES' RESTART 143 ; ----------------------------- 144 ; This restart is used eight times to create, in workspace, the number of 145 ; spaces passed in the BC register. 146 147 ;; BC-SPACES 148 L0030: PUSH BC ; push number of spaces on stack. 149 LD HL,($4014) ; fetch edit line location from E_LINE. 150 PUSH HL ; save this value on stack. 151 JP L1488 ; jump forward to continue at RESERVE. 152 153 ; ----------------------- 154 ; THE 'INTERRUPT' RESTART 155 ; ----------------------- 156 ; The Mode 1 Interrupt routine is concerned solely with generating the central 157 ; television picture. 158 ; On the ZX81 interrupts are enabled only during the interrupt routine, 159 ; although the interrupt 160 ; This Interrupt Service Routine automatically disables interrupts at the 161 ; outset and the last interrupt in a cascade exits before the interrupts are 162 ; enabled. 163 ; There is no DI instruction in the ZX81 ROM. 164 ; An maskable interrupt is triggered when bit 6 of the Z80's Refresh register 165 ; changes from set to reset. 166 ; The Z80 will always be executing a HALT (NEWLINE) when the interrupt occurs. 167 ; A HALT instruction repeatedly executes NOPS but the seven lower bits 168 ; of the Refresh register are incremented each time as they are when any 169 ; simple instruction is executed. (The lower 7 bits are incremented twice for 170 ; a prefixed instruction) 171 ; This is controlled by the Sinclair Computer Logic Chip - manufactured from 172 ; a Ferranti Uncommitted Logic Array. 173 ; 174 ; When a Mode 1 Interrupt occurs the Program Counter, which is the address in 175 ; the upper echo display following the NEWLINE/HALT instruction, goes on the 176 ; machine stack. 193 interrupts are required to generate the last part of 177 ; the 56th border line and then the 192 lines of the central TV picture and, 178 ; although each interrupt interrupts the previous one, there are no stack 179 ; problems as the 'return address' is discarded each time. 180 ; 181 ; The scan line counter in C counts down from 8 to 1 within the generation of 182 ; each text line. For the first interrupt in a cascade the initial value of 183 ; C is set to 1 for the last border line. 184 ; Timing is of the utmost importance as the RH border, horizontal retrace 185 ; and LH border are mostly generated in the 58 clock cycles this routine 186 ; takes . 187 188 ;; INTERRUPT 189 L0038: DEC C ; (4) decrement C - the scan line counter. 190 JP NZ,L0045 ; (10/10) JUMP forward if not zero to SCAN-LINE 191 192 POP HL ; (10) point to start of next row in display 193 ; file. 194 195 DEC B ; (4) decrement the row counter. (4) 196 RET Z ; (11/5) return when picture complete to L028B 197 ; with interrupts disabled. 198 199 SET 3,C ; (8) Load the scan line counter with eight. 200 ; Note. LD C,$08 is 7 clock cycles which 201 ; is way too fast. 202 203 ; -> 204 205 ;; WAIT-INT 206 L0041: LD R,A ; (9) Load R with initial rising value $DD. 207 208 EI ; (4) Enable Interrupts. [ R is now $DE ]. 209 210 JP (HL) ; (4) jump to the echo display file in upper 211 ; memory and execute characters $00 - $3F 212 ; as NOP instructions. The video hardware 213 ; is able to read these characters and, 214 ; with the I register is able to convert 215 ; the character bitmaps in this ROM into a 216 ; line of bytes. Eventually the NEWLINE/HALT 217 ; will be encountered before R reaches $FF. 218 ; It is however the transition from $FF to 219 ; $80 that triggers the next interrupt. 220 ; [ The Refresh register is now $DF ] 221 222 ; --- 223 224 ;; SCAN-LINE 225 L0045: POP DE ; (10) discard the address after NEWLINE as the 226 ; same text line has to be done again 227 ; eight times. 228 229 RET Z ; (5) Harmless Nonsensical Timing. 230 ; (condition never met) 231 232 JR L0041 ; (12) back to WAIT-INT 233 234 ; Note. that a computer with less than 4K or RAM will have a collapsed 235 ; display file and the above mechanism deals with both types of display. 236 ; 237 ; With a full display, the 32 characters in the line are treated as NOPS 238 ; and the Refresh register rises from $E0 to $FF and, at the next instruction 239 ; - HALT, the interrupt occurs. 240 ; With a collapsed display and an initial NEWLINE/HALT, it is the NOPs 241 ; generated by the HALT that cause the Refresh value to rise from $E0 to $FF, 242 ; triggering an Interrupt on the next transition. 243 ; This works happily for all display lines between these extremes and the 244 ; generation of the 32 character, 1 pixel high, line will always take 128 245 ; clock cycles. 246 247 ; --------------------------------- 248 ; THE 'INCREMENT CH-ADD' SUBROUTINE 249 ; --------------------------------- 250 ; This is the subroutine that increments the character address system variable 251 ; and returns if it is not the cursor character. The ZX81 has an actual 252 ; character at the cursor position rather than a pointer system variable 253 ; as is the case with prior and subsequent ZX computers. 254 255 ;; CH-ADD+1 256 L0049: LD HL,($4016) ; fetch character address to CH_ADD. 257 258 ;; TEMP-PTR1 259 L004C: INC HL ; address next immediate location. 260 261 ;; TEMP-PTR2 262 L004D: LD ($4016),HL ; update system variable CH_ADD. 263 264 LD A,(HL) ; fetch the character. 265 CP $7F ; compare to cursor character. 266 RET NZ ; return if not the cursor. 267 268 JR L004C ; back for next character to TEMP-PTR1. 269 270 ; -------------------- 271 ; THE 'ERROR-2' BRANCH 272 ; -------------------- 273 ; This is a continuation of the error restart. 274 ; If the error occurred in runtime then the error stack pointer will probably 275 ; lead to an error report being printed unless it occurred during input. 276 ; If the error occurred when checking syntax then the error stack pointer 277 ; will be an editing routine and the position of the error will be shown 278 ; when the lower screen is reprinted. 279 280 ;; ERROR-2 281 L0056: POP HL ; pop the return address which points to the 282 ; DEFB, error code, after the RST 08. 283 LD L,(HL) ; load L with the error code. HL is not needed 284 ; anymore. 285 286 ;; ERROR-3 287 L0058: LD (IY+$00),L ; place error code in system variable ERR_NR 288 LD SP,($4002) ; set the stack pointer from ERR_SP 289 CALL L0207 ; routine SLOW/FAST selects slow mode. 290 JP L14BC ; exit to address on stack via routine SET-MIN. 291 292 ; --- 293 294 DEFB $FF ; unused. 295 296 ; ------------------------------------ 297 ; THE 'NON MASKABLE INTERRUPT' ROUTINE 298 ; ------------------------------------ 299 ; Jim Westwood's technical dodge using Non-Maskable Interrupts solved the 300 ; flicker problem of the ZX80 and gave the ZX81 a multi-tasking SLOW mode 301 ; with a steady display. Note that the AF' register is reserved for this 302 ; function and its interaction with the display routines. When counting 303 ; TV lines, the NMI makes no use of the main registers. 304 ; The circuitry for the NMI generator is contained within the SCL (Sinclair 305 ; Computer Logic) chip. 306 ; ( It takes 32 clock cycles while incrementing towards zero ). 307 308 ;; NMI 309 L0066: EX AF,AF' ; (4) switch in the NMI's copy of the 310 ; accumulator. 311 INC A ; (4) increment. 312 JP M,L006D ; (10/10) jump, if minus, to NMI-RET as this is 313 ; part of a test to see if the NMI 314 ; generation is working or an intermediate 315 ; value for the ascending negated blank 316 ; line counter. 317 318 JR Z,L006F ; (12) forward to NMI-CONT 319 ; when line count has incremented to zero. 320 321 ; Note. the synchronizing NMI when A increments from zero to one takes this 322 ; 7 clock cycle route making 39 clock cycles in all. 323 324 ;; NMI-RET 325 L006D: EX AF,AF' ; (4) switch out the incremented line counter 326 ; or test result $80 327 RET ; (10) return to User application for a while. 328 329 ; --- 330 331 ; This branch is taken when the 55 (or 31) lines have been drawn. 332 333 ;; NMI-CONT 334 L006F: EX AF,AF' ; (4) restore the main accumulator. 335 336 PUSH AF ; (11) * Save Main Registers 337 PUSH BC ; (11) ** 338 PUSH DE ; (11) *** 339 PUSH HL ; (11) **** 340 341 ; the next set-up procedure is only really applicable when the top set of 342 ; blank lines have been generated. 343 344 LD HL,($400C) ; (16) fetch start of Display File from D_FILE 345 ; points to the HALT at beginning. 346 SET 7,H ; (8) point to upper 32K 'echo display file' 347 348 HALT ; (1) HALT synchronizes with NMI. 349 ; Used with special hardware connected to the 350 ; Z80 HALT and WAIT lines to take 1 clock cycle. 351 352 ; ---------------------------------------------------------------------------- 353 ; the NMI has been generated - start counting. The cathode ray is at the RH 354 ; side of the TV. 355 ; First the NMI servicing, similar to CALL = 17 clock cycles. 356 ; Then the time taken by the NMI for zero-to-one path = 39 cycles 357 ; The HALT above = 01 cycles. 358 ; The two instructions below = 19 cycles. 359 ; The code at L0281 up to and including the CALL = 43 cycles. 360 ; The Called routine at L02B5 = 24 cycles. 361 ; -------------------------------------- --- 362 ; Total Z80 instructions = 143 cycles. 363 ; 364 ; Meanwhile in TV world, 365 ; Horizontal retrace = 15 cycles. 366 ; Left blanking border 8 character positions = 32 cycles 367 ; Generation of 75% scanline from the first NEWLINE = 96 cycles 368 ; --------------------------------------- --- 369 ; 143 cycles 370 ; 371 ; Since at the time the first JP (HL) is encountered to execute the echo 372 ; display another 8 character positions have to be put out, then the 373 ; Refresh register need to hold $F8. Working back and counteracting 374 ; the fact that every instruction increments the Refresh register then 375 ; the value that is loaded into R needs to be $F5. :-) 376 ; 377 ; 378 OUT ($FD),A ; (11) Stop the NMI generator. 379 380 JP (IX) ; (8) forward to L0281 (after top) or L028F 381 382 ; **************** 383 ; ** KEY TABLES ** 384 ; **************** 385 386 ; ------------------------------- 387 ; THE 'UNSHIFTED' CHARACTER CODES 388 ; ------------------------------- 389 390 ;; K-UNSHIFT 391 L007E: DEFB $3F ; Z 392 DEFB $3D ; X 393 DEFB $28 ; C 394 DEFB $3B ; V 395 DEFB $26 ; A 396 DEFB $38 ; S 397 DEFB $29 ; D 398 DEFB $2B ; F 399 DEFB $2C ; G 400 DEFB $36 ; Q 401 DEFB $3C ; W 402 DEFB $2A ; E 403 DEFB $37 ; R 404 DEFB $39 ; T 405 DEFB $1D ; 1 406 DEFB $1E ; 2 407 DEFB $1F ; 3 408 DEFB $20 ; 4 409 DEFB $21 ; 5 410 DEFB $1C ; 0 411 DEFB $25 ; 9 412 DEFB $24 ; 8 413 DEFB $23 ; 7 414 DEFB $22 ; 6 415 DEFB $35 ; P 416 DEFB $34 ; O 417 DEFB $2E ; I 418 DEFB $3A ; U 419 DEFB $3E ; Y 420 DEFB $76 ; NEWLINE 421 DEFB $31 ; L 422 DEFB $30 ; K 423 DEFB $2F ; J 424 DEFB $2D ; H 425 DEFB $00 ; SPACE 426 DEFB $1B ; . 427 DEFB $32 ; M 428 DEFB $33 ; N 429 DEFB $27 ; B 430 431 ; ----------------------------- 432 ; THE 'SHIFTED' CHARACTER CODES 433 ; ----------------------------- 434 435 436 ;; K-SHIFT 437 L00A5: DEFB $0E ; : 438 DEFB $19 ; ; 439 DEFB $0F ; ? 440 DEFB $18 ; / 441 DEFB $E3 ; STOP 442 DEFB $E1 ; LPRINT 443 DEFB $E4 ; SLOW 444 DEFB $E5 ; FAST 445 DEFB $E2 ; LLIST 446 DEFB $C0 ; "" 447 DEFB $D9 ; OR 448 DEFB $E0 ; STEP 449 DEFB $DB ; <= 450 DEFB $DD ; <> 451 DEFB $75 ; EDIT 452 DEFB $DA ; AND 453 DEFB $DE ; THEN 454 DEFB $DF ; TO 455 DEFB $72 ; cursor-left 456 DEFB $77 ; RUBOUT 457 DEFB $74 ; GRAPHICS 458 DEFB $73 ; cursor-right 459 DEFB $70 ; cursor-up 460 DEFB $71 ; cursor-down 461 DEFB $0B ; " 462 DEFB $11 ; ) 463 DEFB $10 ; ( 464 DEFB $0D ; $ 465 DEFB $DC ; >= 466 DEFB $79 ; FUNCTION 467 DEFB $14 ; = 468 DEFB $15 ; + 469 DEFB $16 ; - 470 DEFB $D8 ; ** 471 DEFB $0C ; ukp 472 DEFB $1A ; , 473 DEFB $12 ; > 474 DEFB $13 ; < 475 DEFB $17 ; * 476 477 ; ------------------------------ 478 ; THE 'FUNCTION' CHARACTER CODES 479 ; ------------------------------ 480 481 482 ;; K-FUNCT 483 L00CC: DEFB $CD ; LN 484 DEFB $CE ; EXP 485 DEFB $C1 ; AT 486 DEFB $78 ; KL 487 DEFB $CA ; ASN 488 DEFB $CB ; ACS 489 DEFB $CC ; ATN 490 DEFB $D1 ; SGN 491 DEFB $D2 ; ABS 492 DEFB $C7 ; SIN 493 DEFB $C8 ; COS 494 DEFB $C9 ; TAN 495 DEFB $CF ; INT 496 DEFB $40 ; RND 497 DEFB $78 ; KL 498 DEFB $78 ; KL 499 DEFB $78 ; KL 500 DEFB $78 ; KL 501 DEFB $78 ; KL 502 DEFB $78 ; KL 503 DEFB $78 ; KL 504 DEFB $78 ; KL 505 DEFB $78 ; KL 506 DEFB $78 ; KL 507 DEFB $C2 ; TAB 508 DEFB $D3 ; PEEK 509 DEFB $C4 ; CODE 510 DEFB $D6 ; CHR$ 511 DEFB $D5 ; STR$ 512 DEFB $78 ; KL 513 DEFB $D4 ; USR 514 DEFB $C6 ; LEN 515 DEFB $C5 ; VAL 516 DEFB $D0 ; SQR 517 DEFB $78 ; KL 518 DEFB $78 ; KL 519 DEFB $42 ; PI 520 DEFB $D7 ; NOT 521 DEFB $41 ; INKEY$ 522 523 ; ----------------------------- 524 ; THE 'GRAPHIC' CHARACTER CODES 525 ; ----------------------------- 526 527 528 ;; K-GRAPH 529 L00F3: DEFB $08 ; graphic 530 DEFB $0A ; graphic 531 DEFB $09 ; graphic 532 DEFB $8A ; graphic 533 DEFB $89 ; graphic 534 DEFB $81 ; graphic 535 DEFB $82 ; graphic 536 DEFB $07 ; graphic 537 DEFB $84 ; graphic 538 DEFB $06 ; graphic 539 DEFB $01 ; graphic 540 DEFB $02 ; graphic 541 DEFB $87 ; graphic 542 DEFB $04 ; graphic 543 DEFB $05 ; graphic 544 DEFB $77 ; RUBOUT 545 DEFB $78 ; KL 546 DEFB $85 ; graphic 547 DEFB $03 ; graphic 548 DEFB $83 ; graphic 549 DEFB $8B ; graphic 550 DEFB $91 ; inverse ) 551 DEFB $90 ; inverse ( 552 DEFB $8D ; inverse $ 553 DEFB $86 ; graphic 554 DEFB $78 ; KL 555 DEFB $92 ; inverse > 556 DEFB $95 ; inverse + 557 DEFB $96 ; inverse - 558 DEFB $88 ; graphic 559 560 ; ------------------ 561 ; THE 'TOKEN' TABLES 562 ; ------------------ 563 564 565 ;; TOKENS 566 L0111: DEFB $0F+$80 ; '?'+$80 567 DEFB $0B,$0B+$80 ; "" 568 DEFB $26,$39+$80 ; AT 569 DEFB $39,$26,$27+$80 ; TAB 570 DEFB $0F+$80 ; '?'+$80 571 DEFB $28,$34,$29,$2A+$80 ; CODE 572 DEFB $3B,$26,$31+$80 ; VAL 573 DEFB $31,$2A,$33+$80 ; LEN 574 DEFB $38,$2E,$33+$80 ; SIN 575 DEFB $28,$34,$38+$80 ; COS 576 DEFB $39,$26,$33+$80 ; TAN 577 DEFB $26,$38,$33+$80 ; ASN 578 DEFB $26,$28,$38+$80 ; ACS 579 DEFB $26,$39,$33+$80 ; ATN 580 DEFB $31,$33+$80 ; LN 581 DEFB $2A,$3D,$35+$80 ; EXP 582 DEFB $2E,$33,$39+$80 ; INT 583 DEFB $38,$36,$37+$80 ; SQR 584 DEFB $38,$2C,$33+$80 ; SGN 585 DEFB $26,$27,$38+$80 ; ABS 586 DEFB $35,$2A,$2A,$30+$80 ; PEEK 587 DEFB $3A,$38,$37+$80 ; USR 588 DEFB $38,$39,$37,$0D+$80 ; STR$ 589 DEFB $28,$2D,$37,$0D+$80 ; CHR$ 590 DEFB $33,$34,$39+$80 ; NOT 591 DEFB $17,$17+$80 ; ** 592 DEFB $34,$37+$80 ; OR 593 DEFB $26,$33,$29+$80 ; AND 594 DEFB $13,$14+$80 ; <= 595 DEFB $12,$14+$80 ; >= 596 DEFB $13,$12+$80 ; <> 597 DEFB $39,$2D,$2A,$33+$80 ; THEN 598 DEFB $39,$34+$80 ; TO 599 DEFB $38,$39,$2A,$35+$80 ; STEP 600 DEFB $31,$35,$37,$2E,$33,$39+$80 ; LPRINT 601 DEFB $31,$31,$2E,$38,$39+$80 ; LLIST 602 DEFB $38,$39,$34,$35+$80 ; STOP 603 DEFB $38,$31,$34,$3C+$80 ; SLOW 604 DEFB $2B,$26,$38,$39+$80 ; FAST 605 DEFB $33,$2A,$3C+$80 ; NEW 606 DEFB $38,$28,$37,$34,$31,$31+$80 ; SCROLL 607 DEFB $28,$34,$33,$39+$80 ; CONT 608 DEFB $29,$2E,$32+$80 ; DIM 609 DEFB $37,$2A,$32+$80 ; REM 610 DEFB $2B,$34,$37+$80 ; FOR 611 DEFB $2C,$34,$39,$34+$80 ; GOTO 612 DEFB $2C,$34,$38,$3A,$27+$80 ; GOSUB 613 DEFB $2E,$33,$35,$3A,$39+$80 ; INPUT 614 DEFB $31,$34,$26,$29+$80 ; LOAD 615 DEFB $31,$2E,$38,$39+$80 ; LIST 616 DEFB $31,$2A,$39+$80 ; LET 617 DEFB $35,$26,$3A,$38,$2A+$80 ; PAUSE 618 DEFB $33,$2A,$3D,$39+$80 ; NEXT 619 DEFB $35,$34,$30,$2A+$80 ; POKE 620 DEFB $35,$37,$2E,$33,$39+$80 ; PRINT 621 DEFB $35,$31,$34,$39+$80 ; PLOT 622 DEFB $37,$3A,$33+$80 ; RUN 623 DEFB $38,$26,$3B,$2A+$80 ; SAVE 624 DEFB $37,$26,$33,$29+$80 ; RAND 625 DEFB $2E,$2B+$80 ; IF 626 DEFB $28,$31,$38+$80 ; CLS 627 DEFB $3A,$33,$35,$31,$34,$39+$80 ; UNPLOT 628 DEFB $28,$31,$2A,$26,$37+$80 ; CLEAR 629 DEFB $37,$2A,$39,$3A,$37,$33+$80 ; RETURN 630 DEFB $28,$34,$35,$3E+$80 ; COPY 631 DEFB $37,$33,$29+$80 ; RND 632 DEFB $2E,$33,$30,$2A,$3E,$0D+$80 ; INKEY$ 633 DEFB $35,$2E+$80 ; PI 634 635 636 ; ------------------------------ 637 ; THE 'LOAD-SAVE UPDATE' ROUTINE 638 ; ------------------------------ 639 ; 640 ; 641 642 ;; LOAD/SAVE 643 L01FC: INC HL ; 644 EX DE,HL ; 645 LD HL,($4014) ; system variable edit line E_LINE. 646 SCF ; set carry flag 647 SBC HL,DE ; 648 EX DE,HL ; 649 RET NC ; return if more bytes to load/save. 650 651 POP HL ; else drop return address 652 653 ; ---------------------- 654 ; THE 'DISPLAY' ROUTINES 655 ; ---------------------- 656 ; 657 ; 658 659 ;; SLOW/FAST 660 L0207: LD HL,$403B ; Address the system variable CDFLAG. 661 LD A,(HL) ; Load value to the accumulator. 662 RLA ; rotate bit 6 to position 7. 663 XOR (HL) ; exclusive or with original bit 7. 664 RLA ; rotate result out to carry. 665 RET NC ; return if both bits were the same. 666 667 ; Now test if this really is a ZX81 or a ZX80 running the upgraded ROM. 668 ; The standard ZX80 did not have an NMI generator. 669 670 LD A,$7F ; Load accumulator with %011111111 671 EX AF,AF' ; save in AF' 672 673 LD B,$11 ; A counter within which an NMI should occur 674 ; if this is a ZX81. 675 OUT ($FE),A ; start the NMI generator. 676 677 ; Note that if this is a ZX81 then the NMI will increment AF'. 678 679 ;; LOOP-11 680 L0216: DJNZ L0216 ; self loop to give the NMI a chance to kick in. 681 ; = 16*13 clock cycles + 8 = 216 clock cycles. 682 683 OUT ($FD),A ; Turn off the NMI generator. 684 EX AF,AF' ; bring back the AF' value. 685 RLA ; test bit 7. 686 JR NC,L0226 ; forward, if bit 7 is still reset, to NO-SLOW. 687 688 ; If the AF' was incremented then the NMI generator works and SLOW mode can 689 ; be set. 690 691 SET 7,(HL) ; Indicate SLOW mode - Compute and Display. 692 693 PUSH AF ; * Save Main Registers 694 PUSH BC ; ** 695 PUSH DE ; *** 696 PUSH HL ; **** 697 698 JR L0229 ; skip forward - to DISPLAY-1. 699 700 ; --- 701 702 ;; NO-SLOW 703 L0226: RES 6,(HL) ; reset bit 6 of CDFLAG. 704 RET ; return. 705 706 ; ----------------------- 707 ; THE 'MAIN DISPLAY' LOOP 708 ; ----------------------- 709 ; This routine is executed once for every frame displayed. 710 711 ;; DISPLAY-1 712 L0229: LD HL,($4034) ; fetch two-byte system variable FRAMES. 713 DEC HL ; decrement frames counter. 714 715 ;; DISPLAY-P 716 L022D: LD A,$7F ; prepare a mask 717 AND H ; pick up bits 6-0 of H. 718 OR L ; and any bits of L. 719 LD A,H ; reload A with all bits of H for PAUSE test. 720 721 ; Note both branches must take the same time. 722 723 JR NZ,L0237 ; (12/7) forward if bits 14-0 are not zero 724 ; to ANOTHER 725 726 RLA ; (4) test bit 15 of FRAMES. 727 JR L0239 ; (12) forward with result to OVER-NC 728 729 ; --- 730 731 ;; ANOTHER 732 L0237: LD B,(HL) ; (7) Note. Harmless Nonsensical Timing weight. 733 SCF ; (4) Set Carry Flag. 734 735 ; Note. the branch to here takes either (12)(7)(4) cyles or (7)(4)(12) cycles. 736 737 ;; OVER-NC 738 L0239: LD H,A ; (4) set H to zero 739 LD ($4034),HL ; (16) update system variable FRAMES 740 RET NC ; (11/5) return if FRAMES is in use by PAUSE 741 ; command. 742 743 ;; DISPLAY-2 744 L023E: CALL L02BB ; routine KEYBOARD gets the key row in H and 745 ; the column in L. Reading the ports also starts 746 ; the TV frame synchronization pulse. (VSYNC) 747 748 LD BC,($4025) ; fetch the last key values read from LAST_K 749 LD ($4025),HL ; update LAST_K with new values. 750 751 LD A,B ; load A with previous column - will be $FF if 752 ; there was no key. 753 ADD A,$02 ; adding two will set carry if no previous key. 754 755 SBC HL,BC ; subtract with the carry the two key values. 756 757 ; If the same key value has been returned twice then HL will be zero. 758 759 LD A,($4027) ; fetch system variable DEBOUNCE 760 OR H ; and OR with both bytes of the difference 761 OR L ; setting the zero flag for the upcoming branch. 762 763 LD E,B ; transfer the column value to E 764 LD B,$0B ; and load B with eleven 765 766 LD HL,$403B ; address system variable CDFLAG 767 RES 0,(HL) ; reset the rightmost bit of CDFLAG 768 JR NZ,L0264 ; skip forward if debounce/diff >0 to NO-KEY 769 770 BIT 7,(HL) ; test compute and display bit of CDFLAG 771 SET 0,(HL) ; set the rightmost bit of CDFLAG. 772 RET Z ; return if bit 7 indicated fast mode. 773 774 DEC B ; (4) decrement the counter. 775 NOP ; (4) Timing - 4 clock cycles. ?? 776 SCF ; (4) Set Carry Flag 777 778 ;; NO-KEY 779 L0264: LD HL,$4027 ; sv DEBOUNCE 780 CCF ; Complement Carry Flag 781 RL B ; rotate left B picking up carry 782 ; C<-76543210<-C 783 784 ;; LOOP-B 785 L026A: DJNZ L026A ; self-loop while B>0 to LOOP-B 786 787 LD B,(HL) ; fetch value of DEBOUNCE to B 788 LD A,E ; transfer column value 789 CP $FE ; 790 SBC A,A ; 791 LD B,$1F ; 792 OR (HL) ; 793 AND B ; 794 RRA ; 795 LD (HL),A ; 796 797 OUT ($FF),A ; end the TV frame synchronization pulse. 798 799 LD HL,($400C) ; (12) set HL to the Display File from D_FILE 800 SET 7,H ; (8) set bit 15 to address the echo display. 801 802 CALL L0292 ; (17) routine DISPLAY-3 displays the top set 803 ; of blank lines. 804 805 ; --------------------- 806 ; THE 'VIDEO-1' ROUTINE 807 ; --------------------- 808 809 ;; R-IX-1 810 L0281: LD A,R ; (9) Harmless Nonsensical Timing or something 811 ; very clever? 812 LD BC,$1901 ; (10) 25 lines, 1 scanline in first. 813 LD A,$F5 ; (7) This value will be loaded into R and 814 ; ensures that the cycle starts at the right 815 ; part of the display - after 32nd character 816 ; position. 817 818 CALL L02B5 ; (17) routine DISPLAY-5 completes the current 819 ; blank line and then generates the display of 820 ; the live picture using INT interrupts 821 ; The final interrupt returns to the next 822 ; address. 823 824 L028B: DEC HL ; point HL to the last NEWLINE/HALT. 825 826 CALL L0292 ; routine DISPLAY-3 displays the bottom set of 827 ; blank lines. 828 829 ; --- 830 831 ;; R-IX-2 832 L028F: JP L0229 ; JUMP back to DISPLAY-1 833 834 ; --------------------------------- 835 ; THE 'DISPLAY BLANK LINES' ROUTINE 836 ; --------------------------------- 837 ; This subroutine is called twice (see above) to generate first the blank 838 ; lines at the top of the television display and then the blank lines at the 839 ; bottom of the display. 840 841 ;; DISPLAY-3 842 L0292: POP IX ; pop the return address to IX register. 843 ; will be either L0281 or L028F - see above. 844 845 LD C,(IY+$28) ; load C with value of system constant MARGIN. 846 BIT 7,(IY+$3B) ; test CDFLAG for compute and display. 847 JR Z,L02A9 ; forward, with FAST mode, to DISPLAY-4 848 849 LD A,C ; move MARGIN to A - 31d or 55d. 850 NEG ; Negate 851 INC A ; 852 EX AF,AF' ; place negative count of blank lines in A' 853 854 OUT ($FE),A ; enable the NMI generator. 855 856 POP HL ; **** 857 POP DE ; *** 858 POP BC ; ** 859 POP AF ; * Restore Main Registers 860 861 RET ; return - end of interrupt. Return is to 862 ; user's program - BASIC or machine code. 863 ; which will be interrupted by every NMI. 864 865 ; ------------------------ 866 ; THE 'FAST MODE' ROUTINES 867 ; ------------------------ 868 869 ;; DISPLAY-4 870 L02A9: LD A,$FC ; (7) load A with first R delay value 871 LD B,$01 ; (7) one row only. 872 873 CALL L02B5 ; (17) routine DISPLAY-5 874 875 DEC HL ; (6) point back to the HALT. 876 EX (SP),HL ; (19) Harmless Nonsensical Timing if paired. 877 EX (SP),HL ; (19) Harmless Nonsensical Timing. 878 JP (IX) ; (8) to L0281 or L028F 879 880 ; -------------------------- 881 ; THE 'DISPLAY-5' SUBROUTINE 882 ; -------------------------- 883 ; This subroutine is called from SLOW mode and FAST mode to generate the 884 ; central TV picture. With SLOW mode the R register is incremented, with 885 ; each instruction, to $F7 by the time it completes. With fast mode, the 886 ; final R value will be $FF and an interrupt will occur as soon as the 887 ; Program Counter reaches the HALT. (24 clock cycles) 888 889 ;; DISPLAY-5 890 L02B5: LD R,A ; (9) Load R from A. R = slow: $F5 fast: $FC 891 LD A,$DD ; (7) load future R value. $F6 $FD 892 893 EI ; (4) Enable Interrupts $F7 $FE 894 895 JP (HL) ; (4) jump to the echo display. $F8 $FF 896 897 ; ---------------------------------- 898 ; THE 'KEYBOARD SCANNING' SUBROUTINE 899 ; ---------------------------------- 900 ; The keyboard is read during the vertical sync interval while no video is 901 ; being displayed. Reading a port with address bit 0 low i.e. $FE starts the 902 ; vertical sync pulse. 903 904 ;; KEYBOARD 905 L02BB: LD HL,$FFFF ; (16) prepare a buffer to take key. 906 LD BC,$FEFE ; (20) set BC to port $FEFE. The B register, 907 ; with its single reset bit also acts as 908 ; an 8-counter. 909 IN A,(C) ; (11) read the port - all 16 bits are put on 910 ; the address bus. Start VSYNC pulse. 911 OR $01 ; (7) set the rightmost bit so as to ignore 912 ; the SHIFT key. 913 914 ;; EACH-LINE 915 L02C5: OR $E0 ; [7] OR %11100000 916 LD D,A ; [4] transfer to D. 917 CPL ; [4] complement - only bits 4-0 meaningful now. 918 CP $01 ; [7] sets carry if A is zero. 919 SBC A,A ; [4] $FF if $00 else zero. 920 OR B ; [7] $FF or port FE,FD,FB.... 921 AND L ; [4] unless more than one key, L will still be 922 ; $FF. if more than one key is pressed then A is 923 ; now invalid. 924 LD L,A ; [4] transfer to L. 925 926 ; now consider the column identifier. 927 928 LD A,H ; [4] will be $FF if no previous keys. 929 AND D ; [4] 111xxxxx 930 LD H,A ; [4] transfer A to H 931 932 ; since only one key may be pressed, H will, if valid, be one of 933 ; 11111110, 11111101, 11111011, 11110111, 11101111 934 ; reading from the outer column, say Q, to the inner column, say T. 935 936 RLC B ; [8] rotate the 8-counter/port address. 937 ; sets carry if more to do. 938 IN A,(C) ; [10] read another half-row. 939 ; all five bits this time. 940 941 JR C,L02C5 ; [12](7) loop back, until done, to EACH-LINE 942 943 ; The last row read is SHIFT,Z,X,C,V for the second time. 944 945 RRA ; (4) test the shift key - carry will be reset 946 ; if the key is pressed. 947 RL H ; (8) rotate left H picking up the carry giving 948 ; column values - 949 ; $FD, $FB, $F7, $EF, $DF. 950 ; or $FC, $FA, $F6, $EE, $DE if shifted. 951 952 ; We now have H identifying the column and L identifying the row in the 953 ; keyboard matrix. 954 955 ; This is a good time to test if this is an American or British machine. 956 ; The US machine has an extra diode that causes bit 6 of a byte read from 957 ; a port to be reset. 958 959 RLA ; (4) compensate for the shift test. 960 RLA ; (4) rotate bit 7 out. 961 RLA ; (4) test bit 6. 962 963 SBC A,A ; (4) $FF or $00 {USA} 964 AND $18 ; (7) $18 or $00 965 ADD A,$1F ; (7) $37 or $1F 966 967 ; result is either 31 (USA) or 55 (UK) blank lines above and below the TV 968 ; picture. 969 970 LD ($4028),A ; (13) update system variable MARGIN 971 972 RET ; (10) return 973 974 ; ------------------------------ 975 ; THE 'SET FAST MODE' SUBROUTINE 976 ; ------------------------------ 977 ; 978 ; 979 980 ;; SET-FAST 981 L02E7: BIT 7,(IY+$3B) ; sv CDFLAG 982 RET Z ; 983 984 HALT ; Wait for Interrupt 985 OUT ($FD),A ; 986 RES 7,(IY+$3B) ; sv CDFLAG 987 RET ; return. 988 989 990 ; -------------- 991 ; THE 'REPORT-F' 992 ; -------------- 993 994 ;; REPORT-F 995 L02F4: RST 08H ; ERROR-1 996 DEFB $0E ; Error Report: No Program Name supplied. 997 998 ; -------------------------- 999 ; THE 'SAVE COMMAND' ROUTINE 1000 ; -------------------------- 1001 ; 1002 ; 1003 1004 ;; SAVE 1005 L02F6: CALL L03A8 ; routine NAME 1006 JR C,L02F4 ; back with null name to REPORT-F above. 1007 1008 EX DE,HL ; 1009 LD DE,$12CB ; five seconds timing value 1010 1011 ;; HEADER 1012 L02FF: CALL L0F46 ; routine BREAK-1 1013 JR NC,L0332 ; to BREAK-2 1014 1015 ;; DELAY-1 1016 L0304: DJNZ L0304 ; to DELAY-1 1017 1018 DEC DE ; 1019 LD A,D ; 1020 OR E ; 1021 JR NZ,L02FF ; back for delay to HEADER 1022 1023 ;; OUT-NAME 1024 L030B: CALL L031E ; routine OUT-BYTE 1025 BIT 7,(HL) ; test for inverted bit. 1026 INC HL ; address next character of name. 1027 JR Z,L030B ; back if not inverted to OUT-NAME 1028 1029 ; now start saving the system variables onwards. 1030 1031 LD HL,$4009 ; set start of area to VERSN thereby 1032 ; preserving RAMTOP etc. 1033 1034 ;; OUT-PROG 1035 L0316: CALL L031E ; routine OUT-BYTE 1036 1037 CALL L01FC ; routine LOAD/SAVE >> 1038 JR L0316 ; loop back to OUT-PROG 1039 1040 ; ------------------------- 1041 ; THE 'OUT-BYTE' SUBROUTINE 1042 ; ------------------------- 1043 ; This subroutine outputs a byte a bit at a time to a domestic tape recorder. 1044 1045 ;; OUT-BYTE 1046 L031E: LD E,(HL) ; fetch byte to be saved. 1047 SCF ; set carry flag - as a marker. 1048 1049 ;; EACH-BIT 1050 L0320: RL E ; C < 76543210 < C 1051 RET Z ; return when the marker bit has passed 1052 ; right through. >> 1053 1054 SBC A,A ; $FF if set bit or $00 with no carry. 1055 AND $05 ; $05 $00 1056 ADD A,$04 ; $09 $04 1057 LD C,A ; transfer timer to C. a set bit has a longer 1058 ; pulse than a reset bit. 1059 1060 ;; PULSES 1061 L0329: OUT ($FF),A ; pulse to cassette. 1062 LD B,$23 ; set timing constant 1063 1064 ;; DELAY-2 1065 L032D: DJNZ L032D ; self-loop to DELAY-2 1066 1067 CALL L0F46 ; routine BREAK-1 test for BREAK key. 1068 1069 ;; BREAK-2 1070 L0332: JR NC,L03A6 ; forward with break to REPORT-D 1071 1072 LD B,$1E ; set timing value. 1073 1074 ;; DELAY-3 1075 L0336: DJNZ L0336 ; self-loop to DELAY-3 1076 1077 DEC C ; decrement counter 1078 JR NZ,L0329 ; loop back to PULSES 1079 1080 ;; DELAY-4 1081 L033B: AND A ; clear carry for next bit test. 1082 DJNZ L033B ; self loop to DELAY-4 (B is zero - 256) 1083 1084 JR L0320 ; loop back to EACH-BIT 1085 1086 ; -------------------------- 1087 ; THE 'LOAD COMMAND' ROUTINE 1088 ; -------------------------- 1089 ; 1090 ; 1091 1092 ;; LOAD 1093 L0340: CALL L03A8 ; routine NAME 1094 1095 ; DE points to start of name in RAM. 1096 1097 RL D ; pick up carry 1098 RRC D ; carry now in bit 7. 1099 1100 ;; NEXT-PROG 1101 L0347: CALL L034C ; routine IN-BYTE 1102 JR L0347 ; loop to NEXT-PROG 1103 1104 ; ------------------------ 1105 ; THE 'IN-BYTE' SUBROUTINE 1106 ; ------------------------ 1107 1108 ;; IN-BYTE 1109 L034C: LD C,$01 ; prepare an eight counter 00000001. 1110 1111 ;; NEXT-BIT 1112 L034E: LD B,$00 ; set counter to 256 1113 1114 ;; BREAK-3 1115 L0350: LD A,$7F ; read the keyboard row 1116 IN A,($FE) ; with the SPACE key. 1117 1118 OUT ($FF),A ; output signal to screen. 1119 1120 RRA ; test for SPACE pressed. 1121 JR NC,L03A2 ; forward if so to BREAK-4 1122 1123 RLA ; reverse above rotation 1124 RLA ; test tape bit. 1125 JR C,L0385 ; forward if set to GET-BIT 1126 1127 DJNZ L0350 ; loop back to BREAK-3 1128 1129 POP AF ; drop the return address. 1130 CP D ; ugh. 1131 1132 ;; RESTART 1133 L0361: JP NC,L03E5 ; jump forward to INITIAL if D is zero 1134 ; to reset the system 1135 ; if the tape signal has timed out for example 1136 ; if the tape is stopped. Not just a simple 1137 ; report as some system variables will have 1138 ; been overwritten. 1139 1140 LD H,D ; else transfer the start of name 1141 LD L,E ; to the HL register 1142 1143 ;; IN-NAME 1144 L0366: CALL L034C ; routine IN-BYTE is sort of recursion for name 1145 ; part. received byte in C. 1146 BIT 7,D ; is name the null string ? 1147 LD A,C ; transfer byte to A. 1148 JR NZ,L0371 ; forward with null string to MATCHING 1149 1150 CP (HL) ; else compare with string in memory. 1151 JR NZ,L0347 ; back with mis-match to NEXT-PROG 1152 ; (seemingly out of subroutine but return 1153 ; address has been dropped). 1154 1155 1156 ;; MATCHING 1157 L0371: INC HL ; address next character of name 1158 RLA ; test for inverted bit. 1159 JR NC,L0366 ; back if not to IN-NAME 1160 1161 ; the name has been matched in full. 1162 ; proceed to load the data but first increment the high byte of E_LINE, which 1163 ; is one of the system variables to be loaded in. Since the low byte is loaded 1164 ; before the high byte, it is possible that, at the in-between stage, a false 1165 ; value could cause the load to end prematurely - see LOAD/SAVE check. 1166 1167 INC (IY+$15) ; increment system variable E_LINE_hi. 1168 LD HL,$4009 ; start loading at system variable VERSN. 1169 1170 ;; IN-PROG 1171 L037B: LD D,B ; set D to zero as indicator. 1172 CALL L034C ; routine IN-BYTE loads a byte 1173 LD (HL),C ; insert assembled byte in memory. 1174 CALL L01FC ; routine LOAD/SAVE >> 1175 JR L037B ; loop back to IN-PROG 1176 1177 ; --- 1178 1179 ; this branch assembles a full byte before exiting normally 1180 ; from the IN-BYTE subroutine. 1181 1182 ;; GET-BIT 1183 L0385: PUSH DE ; save the 1184 LD E,$94 ; timing value. 1185 1186 ;; TRAILER 1187 L0388: LD B,$1A ; counter to twenty six. 1188 1189 ;; COUNTER 1190 L038A: DEC E ; decrement the measuring timer. 1191 IN A,($FE) ; read the 1192 RLA ; 1193 BIT 7,E ; 1194 LD A,E ; 1195 JR C,L0388 ; loop back with carry to TRAILER 1196 1197 DJNZ L038A ; to COUNTER 1198 1199 POP DE ; 1200 JR NZ,L039C ; to BIT-DONE 1201 1202 CP $56 ; 1203 JR NC,L034E ; to NEXT-BIT 1204 1205 ;; BIT-DONE 1206 L039C: CCF ; complement carry flag 1207 RL C ; 1208 JR NC,L034E ; to NEXT-BIT 1209 1210 RET ; return with full byte. 1211 1212 ; --- 1213 1214 ; if break is pressed while loading data then perform a reset. 1215 ; if break pressed while waiting for program on tape then OK to break. 1216 1217 ;; BREAK-4 1218 L03A2: LD A,D ; transfer indicator to A. 1219 AND A ; test for zero. 1220 JR Z,L0361 ; back if so to RESTART 1221 1222 1223 ;; REPORT-D 1224 L03A6: RST 08H ; ERROR-1 1225 DEFB $0C ; Error Report: BREAK - CONT repeats 1226 1227 ; ----------------------------- 1228 ; THE 'PROGRAM NAME' SUBROUTINE 1229 ; ----------------------------- 1230 ; 1231 ; 1232 1233 ;; NAME 1234 L03A8: CALL L0F55 ; routine SCANNING 1235 LD A,($4001) ; sv FLAGS 1236 ADD A,A ; 1237 JP M,L0D9A ; to REPORT-C 1238 1239 POP HL ; 1240 RET NC ; 1241 1242 PUSH HL ; 1243 CALL L02E7 ; routine SET-FAST 1244 CALL L13F8 ; routine STK-FETCH 1245 LD H,D ; 1246 LD L,E ; 1247 DEC C ; 1248 RET M ; 1249 1250 ADD HL,BC ; 1251 SET 7,(HL) ; 1252 RET ; 1253 1254 ; ------------------------- 1255 ; THE 'NEW' COMMAND ROUTINE 1256 ; ------------------------- 1257 ; 1258 ; 1259 1260 ;; NEW 1261 L03C3: CALL L02E7 ; routine SET-FAST 1262 LD BC,($4004) ; fetch value of system variable RAMTOP 1263 DEC BC ; point to last system byte. 1264 1265 ; ----------------------- 1266 ; THE 'RAM CHECK' ROUTINE 1267 ; ----------------------- 1268 ; 1269 ; 1270 1271 ;; RAM-CHECK 1272 L03CB: LD H,B ; 1273 LD L,C ; 1274 LD A,$3F ; 1275 1276 ;; RAM-FILL 1277 L03CF: LD (HL),$02 ; 1278 DEC HL ; 1279 CP H ; 1280 JR NZ,L03CF ; to RAM-FILL 1281 1282 ;; RAM-READ 1283 L03D5: AND A ; 1284 SBC HL,BC ; 1285 ADD HL,BC ; 1286 INC HL ; 1287 JR NC,L03E2 ; to SET-TOP 1288 1289 DEC (HL) ; 1290 JR Z,L03E2 ; to SET-TOP 1291 1292 DEC (HL) ; 1293 JR Z,L03D5 ; to RAM-READ 1294 1295 ;; SET-TOP 1296 L03E2: LD ($4004),HL ; set system variable RAMTOP to first byte 1297 ; above the BASIC system area. 1298 1299 ; ---------------------------- 1300 ; THE 'INITIALIZATION' ROUTINE 1301 ; ---------------------------- 1302 ; 1303 ; 1304 1305 ;; INITIAL 1306 L03E5: LD HL,($4004) ; fetch system variable RAMTOP. 1307 DEC HL ; point to last system byte. 1308 LD (HL),$3E ; make GO SUB end-marker $3E - too high for 1309 ; high order byte of line number. 1310 ; (was $3F on ZX80) 1311 DEC HL ; point to unimportant low-order byte. 1312 LD SP,HL ; and initialize the stack-pointer to this 1313 ; location. 1314 DEC HL ; point to first location on the machine stack 1315 DEC HL ; which will be filled by next CALL/PUSH. 1316 LD ($4002),HL ; set the error stack pointer ERR_SP to 1317 ; the base of the now empty machine stack. 1318 1319 ; Now set the I register so that the video hardware knows where to find the 1320 ; character set. This ROM only uses the character set when printing to 1321 ; the ZX Printer. The TV picture is formed by the external video hardware. 1322 ; Consider also, that this 8K ROM can be retro-fitted to the ZX80 instead of 1323 ; its original 4K ROM so the video hardware could be on the ZX80. 1324 1325 LD A,$1E ; address for this ROM is $1E00. 1326 LD I,A ; set I register from A. 1327 IM 1 ; select Z80 Interrupt Mode 1. 1328 1329 LD IY,$4000 ; set IY to the start of RAM so that the 1330 ; system variables can be indexed. 1331 LD (IY+$3B),$40 ; set CDFLAG 0100 0000. Bit 6 indicates 1332 ; Compute nad Display required. 1333 1334 LD HL,$407D ; The first location after System Variables - 1335 ; 16509 decimal. 1336 LD ($400C),HL ; set system variable D_FILE to this value. 1337 LD B,$19 ; prepare minimal screen of 24 NEWLINEs 1338 ; following an initial NEWLINE. 1339 1340 ;; LINE 1341 L0408: LD (HL),$76 ; insert NEWLINE (HALT instruction) 1342 INC HL ; point to next location. 1343 DJNZ L0408 ; loop back for all twenty five to LINE 1344 1345 LD ($4010),HL ; set system variable VARS to next location 1346 1347 CALL L149A ; routine CLEAR sets $80 end-marker and the 1348 ; dynamic memory pointers E_LINE, STKBOT and 1349 ; STKEND. 1350 1351 ;; N/L-ONLY 1352 L0413: CALL L14AD ; routine CURSOR-IN inserts the cursor and 1353 ; end-marker in the Edit Line also setting 1354 ; size of lower display to two lines. 1355 1356 CALL L0207 ; routine SLOW/FAST selects COMPUTE and DISPLAY 1357 1358 ; --------------------------- 1359 ; THE 'BASIC LISTING' SECTION 1360 ; --------------------------- 1361 ; 1362 ; 1363 1364 ;; UPPER 1365 L0419: CALL L0A2A ; routine CLS 1366 LD HL,($400A) ; sv E_PPC_lo 1367 LD DE,($4023) ; sv S_TOP_lo 1368 AND A ; 1369 SBC HL,DE ; 1370 EX DE,HL ; 1371 JR NC,L042D ; to ADDR-TOP 1372 1373 ADD HL,DE ; 1374 LD ($4023),HL ; sv S_TOP_lo 1375 1376 ;; ADDR-TOP 1377 L042D: CALL L09D8 ; routine LINE-ADDR 1378 JR Z,L0433 ; to LIST-TOP 1379 1380 EX DE,HL ; 1381 1382 ;; LIST-TOP 1383 L0433: CALL L073E ; routine LIST-PROG 1384 DEC (IY+$1E) ; sv BERG 1385 JR NZ,L0472 ; to LOWER 1386 1387 LD HL,($400A) ; sv E_PPC_lo 1388 CALL L09D8 ; routine LINE-ADDR 1389 LD HL,($4016) ; sv CH_ADD_lo 1390 SCF ; Set Carry Flag 1391 SBC HL,DE ; 1392 LD HL,$4023 ; sv S_TOP_lo 1393 JR NC,L0457 ; to INC-LINE 1394 1395 EX DE,HL ; 1396 LD A,(HL) ; 1397 INC HL ; 1398 LDI ; 1399 LD (DE),A ; 1400 JR L0419 ; to UPPER 1401 1402 ; --- 1403 1404 ;; DOWN-KEY 1405 L0454: LD HL,$400A ; sv E_PPC_lo 1406 1407 ;; INC-LINE 1408 L0457: LD E,(HL) ; 1409 INC HL ; 1410 LD D,(HL) ; 1411 PUSH HL ; 1412 EX DE,HL ; 1413 INC HL ; 1414 CALL L09D8 ; routine LINE-ADDR 1415 CALL L05BB ; routine LINE-NO 1416 POP HL ; 1417 1418 ;; KEY-INPUT 1419 L0464: BIT 5,(IY+$2D) ; sv FLAGX 1420 JR NZ,L0472 ; forward to LOWER 1421 1422 LD (HL),D ; 1423 DEC HL ; 1424 LD (HL),E ; 1425 JR L0419 ; to UPPER 1426 1427 ; ---------------------------- 1428 ; THE 'EDIT LINE COPY' SECTION 1429 ; ---------------------------- 1430 ; This routine sets the edit line to just the cursor when 1431 ; 1) There is not enough memory to edit a BASIC line. 1432 ; 2) The edit key is used during input. 1433 ; The entry point LOWER 1434 1435 1436 ;; EDIT-INP 1437 L046F: CALL L14AD ; routine CURSOR-IN sets cursor only edit line. 1438 1439 ; -> 1440 1441 ;; LOWER 1442 L0472: LD HL,($4014) ; fetch edit line start from E_LINE. 1443 1444 ;; EACH-CHAR 1445 L0475: LD A,(HL) ; fetch a character from edit line. 1446 CP $7E ; compare to the number marker. 1447 JR NZ,L0482 ; forward if not to END-LINE 1448 1449 LD BC,$0006 ; else six invisible bytes to be removed. 1450 CALL L0A60 ; routine RECLAIM-2 1451 JR L0475 ; back to EACH-CHAR 1452 1453 ; --- 1454 1455 ;; END-LINE 1456 L0482: CP $76 ; 1457 INC HL ; 1458 JR NZ,L0475 ; to EACH-CHAR 1459 1460 ;; EDIT-LINE 1461 L0487: CALL L0537 ; routine CURSOR sets cursor K or L. 1462 1463 ;; EDIT-ROOM 1464 L048A: CALL L0A1F ; routine LINE-ENDS 1465 LD HL,($4014) ; sv E_LINE_lo 1466 LD (IY+$00),$FF ; sv ERR_NR 1467 CALL L0766 ; routine COPY-LINE 1468 BIT 7,(IY+$00) ; sv ERR_NR 1469 JR NZ,L04C1 ; to DISPLAY-6 1470 1471 LD A,($4022) ; sv DF_SZ 1472 CP $18 ; 1473 JR NC,L04C1 ; to DISPLAY-6 1474 1475 INC A ; 1476 LD ($4022),A ; sv DF_SZ 1477 LD B,A ; 1478 LD C,$01 ; 1479 CALL L0918 ; routine LOC-ADDR 1480 LD D,H ; 1481 LD E,L ; 1482 LD A,(HL) ; 1483 1484 ;; FREE-LINE 1485 L04B1: DEC HL ; 1486 CP (HL) ; 1487 JR NZ,L04B1 ; to FREE-LINE 1488 1489 INC HL ; 1490 EX DE,HL ; 1491 LD A,($4005) ; sv RAMTOP_hi 1492 CP $4D ; 1493 CALL C,L0A5D ; routine RECLAIM-1 1494 JR L048A ; to EDIT-ROOM 1495 1496 ; -------------------------- 1497 ; THE 'WAIT FOR KEY' SECTION 1498 ; -------------------------- 1499 ; 1500 ; 1501 1502 ;; DISPLAY-6 1503 L04C1: LD HL,$0000 ; 1504 LD ($4018),HL ; sv X_PTR_lo 1505 1506 LD HL,$403B ; system variable CDFLAG 1507 BIT 7,(HL) ; 1508 1509 CALL Z,L0229 ; routine DISPLAY-1 1510 1511 ;; SLOW-DISP 1512 L04CF: BIT 0,(HL) ; 1513 JR Z,L04CF ; to SLOW-DISP 1514 1515 LD BC,($4025) ; sv LAST_K 1516 CALL L0F4B ; routine DEBOUNCE 1517 CALL L07BD ; routine DECODE 1518 1519 JR NC,L0472 ; back to LOWER 1520 1521 ; ------------------------------- 1522 ; THE 'KEYBOARD DECODING' SECTION 1523 ; ------------------------------- 1524 ; The decoded key value is in E and HL points to the position in the 1525 ; key table. D contains zero. 1526 1527 ;; K-DECODE 1528 L04DF: LD A,($4006) ; Fetch value of system variable MODE 1529 DEC A ; test the three values together 1530 1531 JP M,L0508 ; forward, if was zero, to FETCH-2 1532 1533 JR NZ,L04F7 ; forward, if was 2, to FETCH-1 1534 1535 ; The original value was one and is now zero. 1536 1537 LD ($4006),A ; update the system variable MODE 1538 1539 DEC E ; reduce E to range $00 - $7F 1540 LD A,E ; place in A 1541 SUB $27 ; subtract 39 setting carry if range 00 - 38 1542 JR C,L04F2 ; forward, if so, to FUNC-BASE 1543 1544 LD E,A ; else set E to reduced value 1545 1546 ;; FUNC-BASE 1547 L04F2: LD HL,L00CC ; address of K-FUNCT table for function keys. 1548 JR L0505 ; forward to TABLE-ADD 1549 1550 ; --- 1551 1552 ;; FETCH-1 1553 L04F7: LD A,(HL) ; 1554 CP $76 ; 1555 JR Z,L052B ; to K/L-KEY 1556 1557 CP $40 ; 1558 SET 7,A ; 1559 JR C,L051B ; to ENTER 1560 1561 LD HL,$00C7 ; (expr reqd) 1562 1563 ;; TABLE-ADD 1564 L0505: ADD HL,DE ; 1565 JR L0515 ; to FETCH-3 1566 1567 ; --- 1568 1569 ;; FETCH-2 1570 L0508: LD A,(HL) ; 1571 BIT 2,(IY+$01) ; sv FLAGS - K or L mode ? 1572 JR NZ,L0516 ; to TEST-CURS 1573 1574 ADD A,$C0 ; 1575 CP $E6 ; 1576 JR NC,L0516 ; to TEST-CURS 1577 1578 ;; FETCH-3 1579 L0515: LD A,(HL) ; 1580 1581 ;; TEST-CURS 1582 L0516: CP $F0 ; 1583 JP PE,L052D ; to KEY-SORT 1584 1585 ;; ENTER 1586 L051B: LD E,A ; 1587 CALL L0537 ; routine CURSOR 1588 1589 LD A,E ; 1590 CALL L0526 ; routine ADD-CHAR 1591 1592 ;; BACK-NEXT 1593 L0523: JP L0472 ; back to LOWER 1594 1595 ; ------------------------------ 1596 ; THE 'ADD CHARACTER' SUBROUTINE 1597 ; ------------------------------ 1598 ; 1599 ; 1600 1601 ;; ADD-CHAR 1602 L0526: CALL L099B ; routine ONE-SPACE 1603 LD (DE),A ; 1604 RET ; 1605 1606 ; ------------------------- 1607 ; THE 'CURSOR KEYS' ROUTINE 1608 ; ------------------------- 1609 ; 1610 ; 1611 1612 ;; K/L-KEY 1613 L052B: LD A,$78 ; 1614 1615 ;; KEY-SORT 1616 L052D: LD E,A ; 1617 LD HL,$0482 ; base address of ED-KEYS (exp reqd) 1618 ADD HL,DE ; 1619 ADD HL,DE ; 1620 LD C,(HL) ; 1621 INC HL ; 1622 LD B,(HL) ; 1623 PUSH BC ; 1624 1625 ;; CURSOR 1626 L0537: LD HL,($4014) ; sv E_LINE_lo 1627 BIT 5,(IY+$2D) ; sv FLAGX 1628 JR NZ,L0556 ; to L-MODE 1629 1630 ;; K-MODE 1631 L0540: RES 2,(IY+$01) ; sv FLAGS - Signal use K mode 1632 1633 ;; TEST-CHAR 1634 L0544: LD A,(HL) ; 1635 CP $7F ; 1636 RET Z ; return 1637 1638 INC HL ; 1639 CALL L07B4 ; routine NUMBER 1640 JR Z,L0544 ; to TEST-CHAR 1641 1642 CP $26 ; 1643 JR C,L0544 ; to TEST-CHAR 1644 1645 CP $DE ; 1646 JR Z,L0540 ; to K-MODE 1647 1648 ;; L-MODE 1649 L0556: SET 2,(IY+$01) ; sv FLAGS - Signal use L mode 1650 JR L0544 ; to TEST-CHAR 1651 1652 ; -------------------------- 1653 ; THE 'CLEAR-ONE' SUBROUTINE 1654 ; -------------------------- 1655 ; 1656 ; 1657 1658 ;; CLEAR-ONE 1659 L055C: LD BC,$0001 ; 1660 JP L0A60 ; to RECLAIM-2 1661 1662 1663 1664 ; ------------------------ 1665 ; THE 'EDITING KEYS' TABLE 1666 ; ------------------------ 1667 ; 1668 ; 1669 1670 ;; ED-KEYS 1671 L0562: DEFW L059F ; Address: $059F; Address: UP-KEY 1672 DEFW L0454 ; Address: $0454; Address: DOWN-KEY 1673 DEFW L0576 ; Address: $0576; Address: LEFT-KEY 1674 DEFW L057F ; Address: $057F; Address: RIGHT-KEY 1675 DEFW L05AF ; Address: $05AF; Address: FUNCTION 1676 DEFW L05C4 ; Address: $05C4; Address: EDIT-KEY 1677 DEFW L060C ; Address: $060C; Address: N/L-KEY 1678 DEFW L058B ; Address: $058B; Address: RUBOUT 1679 DEFW L05AF ; Address: $05AF; Address: FUNCTION 1680 DEFW L05AF ; Address: $05AF; Address: FUNCTION 1681 1682 1683 ; ------------------------- 1684 ; THE 'CURSOR LEFT' ROUTINE 1685 ; ------------------------- 1686 ; 1687 ; 1688 1689 ;; LEFT-KEY 1690 L0576: CALL L0593 ; routine LEFT-EDGE 1691 LD A,(HL) ; 1692 LD (HL),$7F ; 1693 INC HL ; 1694 JR L0588 ; to GET-CODE 1695 1696 ; -------------------------- 1697 ; THE 'CURSOR RIGHT' ROUTINE 1698 ; -------------------------- 1699 ; 1700 ; 1701 1702 ;; RIGHT-KEY 1703 L057F: INC HL ; 1704 LD A,(HL) ; 1705 CP $76 ; 1706 JR Z,L059D ; to ENDED-2 1707 1708 LD (HL),$7F ; 1709 DEC HL ; 1710 1711 ;; GET-CODE 1712 L0588: LD (HL),A ; 1713 1714 ;; ENDED-1 1715 L0589: JR L0523 ; to BACK-NEXT 1716 1717 ; -------------------- 1718 ; THE 'RUBOUT' ROUTINE 1719 ; -------------------- 1720 ; 1721 ; 1722 1723 ;; RUBOUT 1724 L058B: CALL L0593 ; routine LEFT-EDGE 1725 CALL L055C ; routine CLEAR-ONE 1726 JR L0589 ; to ENDED-1 1727 1728 ; ------------------------ 1729 ; THE 'ED-EDGE' SUBROUTINE 1730 ; ------------------------ 1731 ; 1732 ; 1733 1734 ;; LEFT-EDGE 1735 L0593: DEC HL ; 1736 LD DE,($4014) ; sv E_LINE_lo 1737 LD A,(DE) ; 1738 CP $7F ; 1739 RET NZ ; 1740 1741 POP DE ; 1742 1743 ;; ENDED-2 1744 L059D: JR L0589 ; to ENDED-1 1745 1746 ; ----------------------- 1747 ; THE 'CURSOR UP' ROUTINE 1748 ; ----------------------- 1749 ; 1750 ; 1751 1752 ;; UP-KEY 1753 L059F: LD HL,($400A) ; sv E_PPC_lo 1754 CALL L09D8 ; routine LINE-ADDR 1755 EX DE,HL ; 1756 CALL L05BB ; routine LINE-NO 1757 LD HL,$400B ; point to system variable E_PPC_hi 1758 JP L0464 ; jump back to KEY-INPUT 1759 1760 ; -------------------------- 1761 ; THE 'FUNCTION KEY' ROUTINE 1762 ; -------------------------- 1763 ; 1764 ; 1765 1766 ;; FUNCTION 1767 L05AF: LD A,E ; 1768 AND $07 ; 1769 LD ($4006),A ; sv MODE 1770 JR L059D ; back to ENDED-2 1771 1772 ; ------------------------------------ 1773 ; THE 'COLLECT LINE NUMBER' SUBROUTINE 1774 ; ------------------------------------ 1775 ; 1776 ; 1777 1778 ;; ZERO-DE 1779 L05B7: EX DE,HL ; 1780 LD DE,L04C1 + 1 ; $04C2 - a location addressing two zeros. 1781 1782 ; -> 1783 1784 ;; LINE-NO 1785 L05BB: LD A,(HL) ; 1786 AND $C0 ; 1787 JR NZ,L05B7 ; to ZERO-DE 1788 1789 LD D,(HL) ; 1790 INC HL ; 1791 LD E,(HL) ; 1792 RET ; 1793 1794 ; ---------------------- 1795 ; THE 'EDIT KEY' ROUTINE 1796 ; ---------------------- 1797 ; 1798 ; 1799 1800 ;; EDIT-KEY 1801 L05C4: CALL L0A1F ; routine LINE-ENDS clears lower display. 1802 1803 LD HL,L046F ; Address: EDIT-INP 1804 PUSH HL ; ** is pushed as an error looping address. 1805 1806 BIT 5,(IY+$2D) ; test FLAGX 1807 RET NZ ; indirect jump if in input mode 1808 ; to L046F, EDIT-INP (begin again). 1809 1810 ; 1811 1812 LD HL,($4014) ; fetch E_LINE 1813 LD ($400E),HL ; and use to update the screen cursor DF_CC 1814 1815 ; so now RST $10 will print the line numbers to the edit line instead of screen. 1816 ; first make sure that no newline/out of screen can occur while sprinting the 1817 ; line numbers to the edit line. 1818 1819 LD HL,$1821 ; prepare line 0, column 0. 1820 LD ($4039),HL ; update S_POSN with these dummy values. 1821 1822 LD HL,($400A) ; fetch current line from E_PPC may be a 1823 ; non-existent line e.g. last line deleted. 1824 CALL L09D8 ; routine LINE-ADDR gets address or that of 1825 ; the following line. 1826 CALL L05BB ; routine LINE-NO gets line number if any in DE 1827 ; leaving HL pointing at second low byte. 1828 1829 LD A,D ; test the line number for zero. 1830 OR E ; 1831 RET Z ; return if no line number - no program to edit. 1832 1833 DEC HL ; point to high byte. 1834 CALL L0AA5 ; routine OUT-NO writes number to edit line. 1835 1836 INC HL ; point to length bytes. 1837 LD C,(HL) ; low byte to C. 1838 INC HL ; 1839 LD B,(HL) ; high byte to B. 1840 1841 INC HL ; point to first character in line. 1842 LD DE,($400E) ; fetch display file cursor DF_CC 1843 1844 LD A,$7F ; prepare the cursor character. 1845 LD (DE),A ; and insert in edit line. 1846 INC DE ; increment intended destination. 1847 1848 PUSH HL ; * save start of BASIC. 1849 1850 LD HL,$001D ; set an overhead of 29 bytes. 1851 ADD HL,DE ; add in the address of cursor. 1852 ADD HL,BC ; add the length of the line. 1853 SBC HL,SP ; subtract the stack pointer. 1854 1855 POP HL ; * restore pointer to start of BASIC. 1856 1857 RET NC ; return if not enough room to L046F EDIT-INP. 1858 ; the edit key appears not to work. 1859 1860 LDIR ; else copy bytes from program to edit line. 1861 ; Note. hidden floating point forms are also 1862 ; copied to edit line. 1863 1864 EX DE,HL ; transfer free location pointer to HL 1865 1866 POP DE ; ** remove address EDIT-INP from stack. 1867 1868 CALL L14A6 ; routine SET-STK-B sets STKEND from HL. 1869 1870 JR L059D ; back to ENDED-2 and after 3 more jumps 1871 ; to L0472, LOWER. 1872 ; Note. The LOWER routine removes the hidden 1873 ; floating-point numbers from the edit line. 1874 1875 ; ------------------------- 1876 ; THE 'NEWLINE KEY' ROUTINE 1877 ; ------------------------- 1878 ; 1879 ; 1880 1881 ;; N/L-KEY 1882 L060C: CALL L0A1F ; routine LINE-ENDS 1883 1884 LD HL,L0472 ; prepare address: LOWER 1885 1886 BIT 5,(IY+$2D) ; sv FLAGX 1887 JR NZ,L0629 ; to NOW-SCAN 1888 1889 LD HL,($4014) ; sv E_LINE_lo 1890 LD A,(HL) ; 1891 CP $FF ; 1892 JR Z,L0626 ; to STK-UPPER 1893 1894 CALL L08E2 ; routine CLEAR-PRB 1895 CALL L0A2A ; routine CLS 1896 1897 ;; STK-UPPER 1898 L0626: LD HL,L0419 ; Address: UPPER 1899 1900 ;; NOW-SCAN 1901 L0629: PUSH HL ; push routine address (LOWER or UPPER). 1902 CALL L0CBA ; routine LINE-SCAN 1903 POP HL ; 1904 CALL L0537 ; routine CURSOR 1905 CALL L055C ; routine CLEAR-ONE 1906 CALL L0A73 ; routine E-LINE-NO 1907 JR NZ,L064E ; to N/L-INP 1908 1909 LD A,B ; 1910 OR C ; 1911 JP NZ,L06E0 ; to N/L-LINE 1912 1913 DEC BC ; 1914 DEC BC ; 1915 LD ($4007),BC ; sv PPC_lo 1916 LD (IY+$22),$02 ; sv DF_SZ 1917 LD DE,($400C) ; sv D_FILE_lo 1918 1919 JR L0661 ; forward to TEST-NULL 1920 1921 ; --- 1922 1923 ;; N/L-INP 1924 L064E: CP $76 ; 1925 JR Z,L0664 ; to N/L-NULL 1926 1927 LD BC,($4030) ; sv T_ADDR_lo 1928 CALL L0918 ; routine LOC-ADDR 1929 LD DE,($4029) ; sv NXTLIN_lo 1930 LD (IY+$22),$02 ; sv DF_SZ 1931 1932 ;; TEST-NULL 1933 L0661: RST 18H ; GET-CHAR 1934 CP $76 ; 1935 1936 ;; N/L-NULL 1937 L0664: JP Z,L0413 ; to N/L-ONLY 1938 1939 LD (IY+$01),$80 ; sv FLAGS 1940 EX DE,HL ; 1941 1942 ;; NEXT-LINE 1943 L066C: LD ($4029),HL ; sv NXTLIN_lo 1944 EX DE,HL ; 1945 CALL L004D ; routine TEMP-PTR-2 1946 CALL L0CC1 ; routine LINE-RUN 1947 RES 1,(IY+$01) ; sv FLAGS - Signal printer not in use 1948 LD A,$C0 ; 1949 LD (IY+$19),A ; sv X_PTR_lo 1950 CALL L14A3 ; routine X-TEMP 1951 RES 5,(IY+$2D) ; sv FLAGX 1952 BIT 7,(IY+$00) ; sv ERR_NR 1953 JR Z,L06AE ; to STOP-LINE 1954 1955 LD HL,($4029) ; sv NXTLIN_lo 1956 AND (HL) ; 1957 JR NZ,L06AE ; to STOP-LINE 1958 1959 LD D,(HL) ; 1960 INC HL ; 1961 LD E,(HL) ; 1962 LD ($4007),DE ; sv PPC_lo 1963 INC HL ; 1964 LD E,(HL) ; 1965 INC HL ; 1966 LD D,(HL) ; 1967 INC HL ; 1968 EX DE,HL ; 1969 ADD HL,DE ; 1970 CALL L0F46 ; routine BREAK-1 1971 JR C,L066C ; to NEXT-LINE 1972 1973 LD HL,$4000 ; sv ERR_NR 1974 BIT 7,(HL) ; 1975 JR Z,L06AE ; to STOP-LINE 1976 1977 LD (HL),$0C ; 1978 1979 ;; STOP-LINE 1980 L06AE: BIT 7,(IY+$38) ; sv PR_CC 1981 CALL Z,L0871 ; routine COPY-BUFF 1982 LD BC,$0121 ; 1983 CALL L0918 ; routine LOC-ADDR 1984 LD A,($4000) ; sv ERR_NR 1985 LD BC,($4007) ; sv PPC_lo 1986 INC A ; 1987 JR Z,L06D1 ; to REPORT 1988 1989 CP $09 ; 1990 JR NZ,L06CA ; to CONTINUE 1991 1992 INC BC ; 1993 1994 ;; CONTINUE 1995 L06CA: LD ($402B),BC ; sv OLDPPC_lo 1996 JR NZ,L06D1 ; to REPORT 1997 1998 DEC BC ; 1999 2000 ;; REPORT 2001 L06D1: CALL L07EB ; routine OUT-CODE 2002 LD A,$18 ; 2003 2004 RST 10H ; PRINT-A 2005 CALL L0A98 ; routine OUT-NUM 2006 CALL L14AD ; routine CURSOR-IN 2007 JP L04C1 ; to DISPLAY-6 2008 2009 ; --- 2010 2011 ;; N/L-LINE 2012 L06E0: LD ($400A),BC ; sv E_PPC_lo 2013 LD HL,($4016) ; sv CH_ADD_lo 2014 EX DE,HL ; 2015 LD HL,L0413 ; Address: N/L-ONLY 2016 PUSH HL ; 2017 LD HL,($401A) ; sv STKBOT_lo 2018 SBC HL,DE ; 2019 PUSH HL ; 2020 PUSH BC ; 2021 CALL L02E7 ; routine SET-FAST 2022 CALL L0A2A ; routine CLS 2023 POP HL ; 2024 CALL L09D8 ; routine LINE-ADDR 2025 JR NZ,L0705 ; to COPY-OVER 2026 2027 CALL L09F2 ; routine NEXT-ONE 2028 CALL L0A60 ; routine RECLAIM-2 2029 2030 ;; COPY-OVER 2031 L0705: POP BC ; 2032 LD A,C ; 2033 DEC A ; 2034 OR B ; 2035 RET Z ; 2036 2037 PUSH BC ; 2038 INC BC ; 2039 INC BC ; 2040 INC BC ; 2041 INC BC ; 2042 DEC HL ; 2043 CALL L099E ; routine MAKE-ROOM 2044 CALL L0207 ; routine SLOW/FAST 2045 POP BC ; 2046 PUSH BC ; 2047 INC DE ; 2048 LD HL,($401A) ; sv STKBOT_lo 2049 DEC HL ; 2050 LDDR ; copy bytes 2051 LD HL,($400A) ; sv E_PPC_lo 2052 EX DE,HL ; 2053 POP BC ; 2054 LD (HL),B ; 2055 DEC HL ; 2056 LD (HL),C ; 2057 DEC HL ; 2058 LD (HL),E ; 2059 DEC HL ; 2060 LD (HL),D ; 2061 2062 RET ; return. 2063 2064 ; --------------------------------------- 2065 ; THE 'LIST' AND 'LLIST' COMMAND ROUTINES 2066 ; --------------------------------------- 2067 ; 2068 ; 2069 2070 ;; LLIST 2071 L072C: SET 1,(IY+$01) ; sv FLAGS - signal printer in use 2072 2073 ;; LIST 2074 L0730: CALL L0EA7 ; routine FIND-INT 2075 2076 LD A,B ; fetch high byte of user-supplied line number. 2077 AND $3F ; and crudely limit to range 1-16383. 2078 2079 LD H,A ; 2080 LD L,C ; 2081 LD ($400A),HL ; sv E_PPC_lo 2082 CALL L09D8 ; routine LINE-ADDR 2083 2084 ;; LIST-PROG 2085 L073E: LD E,$00 ; 2086 2087 ;; UNTIL-END 2088 L0740: CALL L0745 ; routine OUT-LINE lists one line of BASIC 2089 ; making an early return when the screen is 2090 ; full or the end of program is reached. >> 2091 JR L0740 ; loop back to UNTIL-END 2092 2093 ; ----------------------------------- 2094 ; THE 'PRINT A BASIC LINE' SUBROUTINE 2095 ; ----------------------------------- 2096 ; 2097 ; 2098 2099 ;; OUT-LINE 2100 L0745: LD BC,($400A) ; sv E_PPC_lo 2101 CALL L09EA ; routine CP-LINES 2102 LD D,$92 ; 2103 JR Z,L0755 ; to TEST-END 2104 2105 LD DE,$0000 ; 2106 RL E ; 2107 2108 ;; TEST-END 2109 L0755: LD (IY+$1E),E ; sv BERG 2110 LD A,(HL) ; 2111 CP $40 ; 2112 POP BC ; 2113 RET NC ; 2114 2115 PUSH BC ; 2116 CALL L0AA5 ; routine OUT-NO 2117 INC HL ; 2118 LD A,D ; 2119 2120 RST 10H ; PRINT-A 2121 INC HL ; 2122 INC HL ; 2123 2124 ;; COPY-LINE 2125 L0766: LD ($4016),HL ; sv CH_ADD_lo 2126 SET 0,(IY+$01) ; sv FLAGS - Suppress leading space 2127 2128 ;; MORE-LINE 2129 L076D: LD BC,($4018) ; sv X_PTR_lo 2130 LD HL,($4016) ; sv CH_ADD_lo 2131 AND A ; 2132 SBC HL,BC ; 2133 JR NZ,L077C ; to TEST-NUM 2134 2135 LD A,$B8 ; 2136 2137 RST 10H ; PRINT-A 2138 2139 ;; TEST-NUM 2140 L077C: LD HL,($4016) ; sv CH_ADD_lo 2141 LD A,(HL) ; 2142 INC HL ; 2143 CALL L07B4 ; routine NUMBER 2144 LD ($4016),HL ; sv CH_ADD_lo 2145 JR Z,L076D ; to MORE-LINE 2146 2147 CP $7F ; 2148 JR Z,L079D ; to OUT-CURS 2149 2150 CP $76 ; 2151 JR Z,L07EE ; to OUT-CH 2152 2153 BIT 6,A ; 2154 JR Z,L079A ; to NOT-TOKEN 2155 2156 CALL L094B ; routine TOKENS 2157 JR L076D ; to MORE-LINE 2158 2159 ; --- 2160 2161 2162 ;; NOT-TOKEN 2163 L079A: RST 10H ; PRINT-A 2164 JR L076D ; to MORE-LINE 2165 2166 ; --- 2167 2168 ;; OUT-CURS 2169 L079D: LD A,($4006) ; Fetch value of system variable MODE 2170 LD B,$AB ; Prepare an inverse [F] for function cursor. 2171 2172 AND A ; Test for zero - 2173 JR NZ,L07AA ; forward if not to FLAGS-2 2174 2175 LD A,($4001) ; Fetch system variable FLAGS. 2176 LD B,$B0 ; Prepare an inverse [K] for keyword cursor. 2177 2178 ;; FLAGS-2 2179 L07AA: RRA ; 00000?00 -> 000000?0 2180 RRA ; 000000?0 -> 0000000? 2181 AND $01 ; 0000000? 0000000x 2182 2183 ADD A,B ; Possibly [F] -> [G] or [K] -> [L] 2184 2185 CALL L07F5 ; routine PRINT-SP prints character 2186 JR L076D ; back to MORE-LINE 2187 2188 ; ----------------------- 2189 ; THE 'NUMBER' SUBROUTINE 2190 ; ----------------------- 2191 ; 2192 ; 2193 2194 ;; NUMBER 2195 L07B4: CP $7E ; 2196 RET NZ ; 2197 2198 INC HL ; 2199 INC HL ; 2200 INC HL ; 2201 INC HL ; 2202 INC HL ; 2203 RET ; 2204 2205 ; -------------------------------- 2206 ; THE 'KEYBOARD DECODE' SUBROUTINE 2207 ; -------------------------------- 2208 ; 2209 ; 2210 2211 ;; DECODE 2212 L07BD: LD D,$00 ; 2213 SRA B ; 2214 SBC A,A ; 2215 OR $26 ; 2216 LD L,$05 ; 2217 SUB L ; 2218 2219 ;; KEY-LINE 2220 L07C7: ADD A,L ; 2221 SCF ; Set Carry Flag 2222 RR C ; 2223 JR C,L07C7 ; to KEY-LINE 2224 2225 INC C ; 2226 RET NZ ; 2227 2228 LD C,B ; 2229 DEC L ; 2230 LD L,$01 ; 2231 JR NZ,L07C7 ; to KEY-LINE 2232 2233 LD HL,$007D ; (expr reqd) 2234 LD E,A ; 2235 ADD HL,DE ; 2236 SCF ; Set Carry Flag 2237 RET ; 2238 2239 ; ------------------------- 2240 ; THE 'PRINTING' SUBROUTINE 2241 ; ------------------------- 2242 ; 2243 ; 2244 2245 ;; LEAD-SP 2246 L07DC: LD A,E ; 2247 AND A ; 2248 RET M ; 2249 2250 JR L07F1 ; to PRINT-CH 2251 2252 ; --- 2253 2254 ;; OUT-DIGIT 2255 L07E1: XOR A ; 2256 2257 ;; DIGIT-INC 2258 L07E2: ADD HL,BC ; 2259 INC A ; 2260 JR C,L07E2 ; to DIGIT-INC 2261 2262 SBC HL,BC ; 2263 DEC A ; 2264 JR Z,L07DC ; to LEAD-SP 2265 2266 ;; OUT-CODE 2267 L07EB: LD E,$1C ; 2268 ADD A,E ; 2269 2270 ;; OUT-CH 2271 L07EE: AND A ; 2272 JR Z,L07F5 ; to PRINT-SP 2273 2274 ;; PRINT-CH 2275 L07F1: RES 0,(IY+$01) ; update FLAGS - signal leading space permitted 2276 2277 ;; PRINT-SP 2278 L07F5: EXX ; 2279 PUSH HL ; 2280 BIT 1,(IY+$01) ; test FLAGS - is printer in use ? 2281 JR NZ,L0802 ; to LPRINT-A 2282 2283 CALL L0808 ; routine ENTER-CH 2284 JR L0805 ; to PRINT-EXX 2285 2286 ; --- 2287 2288 ;; LPRINT-A 2289 L0802: CALL L0851 ; routine LPRINT-CH 2290 2291 ;; PRINT-EXX 2292 L0805: POP HL ; 2293 EXX ; 2294 RET ; 2295 2296 ; --- 2297 2298 ;; ENTER-CH 2299 L0808: LD D,A ; 2300 LD BC,($4039) ; sv S_POSN_x 2301 LD A,C ; 2302 CP $21 ; 2303 JR Z,L082C ; to TEST-LOW 2304 2305 ;; TEST-N/L 2306 L0812: LD A,$76 ; 2307 CP D ; 2308 JR Z,L0847 ; to WRITE-N/L 2309 2310 LD HL,($400E) ; sv DF_CC_lo 2311 CP (HL) ; 2312 LD A,D ; 2313 JR NZ,L083E ; to WRITE-CH 2314 2315 DEC C ; 2316 JR NZ,L083A ; to EXPAND-1 2317 2318 INC HL ; 2319 LD ($400E),HL ; sv DF_CC_lo 2320 LD C,$21 ; 2321 DEC B ; 2322 LD ($4039),BC ; sv S_POSN_x 2323 2324 ;; TEST-LOW 2325 L082C: LD A,B ; 2326 CP (IY+$22) ; sv DF_SZ 2327 JR Z,L0835 ; to REPORT-5 2328 2329 AND A ; 2330 JR NZ,L0812 ; to TEST-N/L 2331 2332 ;; REPORT-5 2333 L0835: LD L,$04 ; 'No more room on screen' 2334 JP L0058 ; to ERROR-3 2335 2336 ; --- 2337 2338 ;; EXPAND-1 2339 L083A: CALL L099B ; routine ONE-SPACE 2340 EX DE,HL ; 2341 2342 ;; WRITE-CH 2343 L083E: LD (HL),A ; 2344 INC HL ; 2345 LD ($400E),HL ; sv DF_CC_lo 2346 DEC (IY+$39) ; sv S_POSN_x 2347 RET ; 2348 2349 ; --- 2350 2351 ;; WRITE-N/L 2352 L0847: LD C,$21 ; 2353 DEC B ; 2354 SET 0,(IY+$01) ; sv FLAGS - Suppress leading space 2355 JP L0918 ; to LOC-ADDR 2356 2357 ; -------------------------- 2358 ; THE 'LPRINT-CH' SUBROUTINE 2359 ; -------------------------- 2360 ; This routine sends a character to the ZX-Printer placing the code for the 2361 ; character in the Printer Buffer. 2362 ; Note. PR-CC contains the low byte of the buffer address. The high order byte 2363 ; is always constant. 2364 2365 2366 ;; LPRINT-CH 2367 L0851: CP $76 ; compare to NEWLINE. 2368 JR Z,L0871 ; forward if so to COPY-BUFF 2369 2370 LD C,A ; take a copy of the character in C. 2371 LD A,($4038) ; fetch print location from PR_CC 2372 AND $7F ; ignore bit 7 to form true position. 2373 CP $5C ; compare to 33rd location 2374 2375 LD L,A ; form low-order byte. 2376 LD H,$40 ; the high-order byte is fixed. 2377 2378 CALL Z,L0871 ; routine COPY-BUFF to send full buffer to 2379 ; the printer if first 32 bytes full. 2380 ; (this will reset HL to start.) 2381 2382 LD (HL),C ; place character at location. 2383 INC L ; increment - will not cross a 256 boundary. 2384 LD (IY+$38),L ; update system variable PR_CC 2385 ; automatically resetting bit 7 to show that 2386 ; the buffer is not empty. 2387 RET ; return. 2388 2389 ; -------------------------- 2390 ; THE 'COPY' COMMAND ROUTINE 2391 ; -------------------------- 2392 ; The full character-mapped screen is copied to the ZX-Printer. 2393 ; All twenty-four text/graphic lines are printed. 2394 2395 ;; COPY 2396 L0869: LD D,$16 ; prepare to copy twenty four text lines. 2397 LD HL,($400C) ; set HL to start of display file from D_FILE. 2398 INC HL ; 2399 JR L0876 ; forward to COPY*D 2400 2401 ; --- 2402 2403 ; A single character-mapped printer buffer is copied to the ZX-Printer. 2404 2405 ;; COPY-BUFF 2406 L0871: LD D,$01 ; prepare to copy a single text line. 2407 LD HL,$403C ; set HL to start of printer buffer PRBUFF. 2408 2409 ; both paths converge here. 2410 2411 ;; COPY*D 2412 L0876: CALL L02E7 ; routine SET-FAST 2413 2414 PUSH BC ; *** preserve BC throughout. 2415 ; a pending character may be present 2416 ; in C from LPRINT-CH 2417 2418 ;; COPY-LOOP 2419 L087A: PUSH HL ; save first character of line pointer. (*) 2420 XOR A ; clear accumulator. 2421 LD E,A ; set pixel line count, range 0-7, to zero. 2422 2423 ; this inner loop deals with each horizontal pixel line. 2424 2425 ;; COPY-TIME 2426 L087D: OUT ($FB),A ; bit 2 reset starts the printer motor 2427 ; with an inactive stylus - bit 7 reset. 2428 POP HL ; pick up first character of line pointer (*) 2429 ; on inner loop. 2430 2431 ;; COPY-BRK 2432 L0880: CALL L0F46 ; routine BREAK-1 2433 JR C,L088A ; forward with no keypress to COPY-CONT 2434 2435 ; else A will hold 11111111 0 2436 2437 RRA ; 0111 1111 2438 OUT ($FB),A ; stop ZX printer motor, de-activate stylus. 2439 2440 ;; REPORT-D2 2441 L0888: RST 08H ; ERROR-1 2442 DEFB $0C ; Error Report: BREAK - CONT repeats 2443 2444 ; --- 2445 2446 ;; COPY-CONT 2447 L088A: IN A,($FB) ; read from printer port. 2448 ADD A,A ; test bit 6 and 7 2449 JP M,L08DE ; jump forward with no printer to COPY-END 2450 2451 JR NC,L0880 ; back if stylus not in position to COPY-BRK 2452 2453 PUSH HL ; save first character of line pointer (*) 2454 PUSH DE ; ** preserve character line and pixel line. 2455 2456 LD A,D ; text line count to A? 2457 CP $02 ; sets carry if last line. 2458 SBC A,A ; now $FF if last line else zero. 2459 2460 ; now cleverly prepare a printer control mask setting bit 2 (later moved to 1) 2461 ; of D to slow printer for the last two pixel lines ( E = 6 and 7) 2462 2463 AND E ; and with pixel line offset 0-7 2464 RLCA ; shift to left. 2465 AND E ; and again. 2466 LD D,A ; store control mask in D. 2467 2468 ;; COPY-NEXT 2469 L089C: LD C,(HL) ; load character from screen or buffer. 2470 LD A,C ; save a copy in C for later inverse test. 2471 INC HL ; update pointer for next time. 2472 CP $76 ; is character a NEWLINE ? 2473 JR Z,L08C7 ; forward, if so, to COPY-N/L 2474 2475 PUSH HL ; * else preserve the character pointer. 2476 2477 SLA A ; (?) multiply by two 2478 ADD A,A ; multiply by four 2479 ADD A,A ; multiply by eight 2480 2481 LD H,$0F ; load H with half the address of character set. 2482 RL H ; now $1E or $1F (with carry) 2483 ADD A,E ; add byte offset 0-7 2484 LD L,A ; now HL addresses character source byte 2485 2486 RL C ; test character, setting carry if inverse. 2487 SBC A,A ; accumulator now $00 if normal, $FF if inverse. 2488 2489 XOR (HL) ; combine with bit pattern at end or ROM. 2490 LD C,A ; transfer the byte to C. 2491 LD B,$08 ; count eight bits to output. 2492 2493 ;; COPY-BITS 2494 L08B5: LD A,D ; fetch speed control mask from D. 2495 RLC C ; rotate a bit from output byte to carry. 2496 RRA ; pick up in bit 7, speed bit to bit 1 2497 LD H,A ; store aligned mask in H register. 2498 2499 ;; COPY-WAIT 2500 L08BA: IN A,($FB) ; read the printer port 2501 RRA ; test for alignment signal from encoder. 2502 JR NC,L08BA ; loop if not present to COPY-WAIT 2503 2504 LD A,H ; control byte to A. 2505 OUT ($FB),A ; and output to printer port. 2506 DJNZ L08B5 ; loop for all eight bits to COPY-BITS 2507 2508 POP HL ; * restore character pointer. 2509 JR L089C ; back for adjacent character line to COPY-NEXT 2510 2511 ; --- 2512 2513 ; A NEWLINE has been encountered either following a text line or as the 2514 ; first character of the screen or printer line. 2515 2516 ;; COPY-N/L 2517 L08C7: IN A,($FB) ; read printer port. 2518 RRA ; wait for encoder signal. 2519 JR NC,L08C7 ; loop back if not to COPY-N/L 2520 2521 LD A,D ; transfer speed mask to A. 2522 RRCA ; rotate speed bit to bit 1. 2523 ; bit 7, stylus control is reset. 2524 OUT ($FB),A ; set the printer speed. 2525 2526 POP DE ; ** restore character line and pixel line. 2527 INC E ; increment pixel line 0-7. 2528 BIT 3,E ; test if value eight reached. 2529 JR Z,L087D ; back if not to COPY-TIME 2530 2531 ; eight pixel lines, a text line have been completed. 2532 2533 POP BC ; lose the now redundant first character 2534 ; pointer 2535 DEC D ; decrease text line count. 2536 JR NZ,L087A ; back if not zero to COPY-LOOP 2537 2538 LD A,$04 ; stop the already slowed printer motor. 2539 OUT ($FB),A ; output to printer port. 2540 2541 ;; COPY-END 2542 L08DE: CALL L0207 ; routine SLOW/FAST 2543 POP BC ; *** restore preserved BC. 2544 2545 ; ------------------------------------- 2546 ; THE 'CLEAR PRINTER BUFFER' SUBROUTINE 2547 ; ------------------------------------- 2548 ; This subroutine sets 32 bytes of the printer buffer to zero (space) and 2549 ; the 33rd character is set to a NEWLINE. 2550 ; This occurs after the printer buffer is sent to the printer but in addition 2551 ; after the 24 lines of the screen are sent to the printer. 2552 ; Note. This is a logic error as the last operation does not involve the 2553 ; buffer at all. Logically one should be able to use 2554 ; 10 LPRINT "HELLO "; 2555 ; 20 COPY 2556 ; 30 LPRINT ; "WORLD" 2557 ; and expect to see the entire greeting emerge from the printer. 2558 ; Surprisingly this logic error was never discovered and although one can argue 2559 ; if the above is a bug, the repetition of this error on the Spectrum was most 2560 ; definitely a bug. 2561 ; Since the printer buffer is fixed at the end of the system variables, and 2562 ; the print position is in the range $3C - $5C, then bit 7 of the system 2563 ; variable is set to show the buffer is empty and automatically reset when 2564 ; the variable is updated with any print position - neat. 2565 2566 ;; CLEAR-PRB 2567 L08E2: LD HL,$405C ; address fixed end of PRBUFF 2568 LD (HL),$76 ; place a newline at last position. 2569 LD B,$20 ; prepare to blank 32 preceding characters. 2570 2571 ;; PRB-BYTES 2572 L08E9: DEC HL ; decrement address - could be DEC L. 2573 LD (HL),$00 ; place a zero byte. 2574 DJNZ L08E9 ; loop for all thirty-two to PRB-BYTES 2575 2576 LD A,L ; fetch character print position. 2577 SET 7,A ; signal the printer buffer is clear. 2578 LD ($4038),A ; update one-byte system variable PR_CC 2579 RET ; return. 2580 2581 ; ------------------------- 2582 ; THE 'PRINT AT' SUBROUTINE 2583 ; ------------------------- 2584 ; 2585 ; 2586 2587 ;; PRINT-AT 2588 L08F5: LD A,$17 ; 2589 SUB B ; 2590 JR C,L0905 ; to WRONG-VAL 2591 2592 ;; TEST-VAL 2593 L08FA: CP (IY+$22) ; sv DF_SZ 2594 JP C,L0835 ; to REPORT-5 2595 2596 INC A ; 2597 LD B,A ; 2598 LD A,$1F ; 2599 SUB C ; 2600 2601 ;; WRONG-VAL 2602 L0905: JP C,L0EAD ; to REPORT-B 2603 2604 ADD A,$02 ; 2605 LD C,A ; 2606 2607 ;; SET-FIELD 2608 L090B: BIT 1,(IY+$01) ; sv FLAGS - Is printer in use 2609 JR Z,L0918 ; to LOC-ADDR 2610 2611 LD A,$5D ; 2612 SUB C ; 2613 LD ($4038),A ; sv PR_CC 2614 RET ; 2615 2616 ; ---------------------------- 2617 ; THE 'LOCATE ADDRESS' ROUTINE 2618 ; ---------------------------- 2619 ; 2620 ; 2621 2622 ;; LOC-ADDR 2623 L0918: LD ($4039),BC ; sv S_POSN_x 2624 LD HL,($4010) ; sv VARS_lo 2625 LD D,C ; 2626 LD A,$22 ; 2627 SUB C ; 2628 LD C,A ; 2629 LD A,$76 ; 2630 INC B ; 2631 2632 ;; LOOK-BACK 2633 L0927: DEC HL ; 2634 CP (HL) ; 2635 JR NZ,L0927 ; to LOOK-BACK 2636 2637 DJNZ L0927 ; to LOOK-BACK 2638 2639 INC HL ; 2640 CPIR ; 2641 DEC HL ; 2642 LD ($400E),HL ; sv DF_CC_lo 2643 SCF ; Set Carry Flag 2644 RET PO ; 2645 2646 DEC D ; 2647 RET Z ; 2648 2649 PUSH BC ; 2650 CALL L099E ; routine MAKE-ROOM 2651 POP BC ; 2652 LD B,C ; 2653 LD H,D ; 2654 LD L,E ; 2655 2656 ;; EXPAND-2 2657 L0940: LD (HL),$00 ; 2658 DEC HL ; 2659 DJNZ L0940 ; to EXPAND-2 2660 2661 EX DE,HL ; 2662 INC HL ; 2663 LD ($400E),HL ; sv DF_CC_lo 2664 RET ; 2665 2666 ; ------------------------------ 2667 ; THE 'EXPAND TOKENS' SUBROUTINE 2668 ; ------------------------------ 2669 ; 2670 ; 2671 2672 ;; TOKENS 2673 L094B: PUSH AF ; 2674 CALL L0975 ; routine TOKEN-ADD 2675 JR NC,L0959 ; to ALL-CHARS 2676 2677 BIT 0,(IY+$01) ; sv FLAGS - Leading space if set 2678 JR NZ,L0959 ; to ALL-CHARS 2679 2680 XOR A ; 2681 2682 RST 10H ; PRINT-A 2683 2684 ;; ALL-CHARS 2685 L0959: LD A,(BC) ; 2686 AND $3F ; 2687 2688 RST 10H ; PRINT-A 2689 LD A,(BC) ; 2690 INC BC ; 2691 ADD A,A ; 2692 JR NC,L0959 ; to ALL-CHARS 2693 2694 POP BC ; 2695 BIT 7,B ; 2696 RET Z ; 2697 2698 CP $1A ; 2699 JR Z,L096D ; to TRAIL-SP 2700 2701 CP $38 ; 2702 RET C ; 2703 2704 ;; TRAIL-SP 2705 L096D: XOR A ; 2706 SET 0,(IY+$01) ; sv FLAGS - Suppress leading space 2707 JP L07F5 ; to PRINT-SP 2708 2709 ; --- 2710 2711 ;; TOKEN-ADD 2712 L0975: PUSH HL ; 2713 LD HL,L0111 ; Address of TOKENS 2714 BIT 7,A ; 2715 JR Z,L097F ; to TEST-HIGH 2716 2717 AND $3F ; 2718 2719 ;; TEST-HIGH 2720 L097F: CP $43 ; 2721 JR NC,L0993 ; to FOUND 2722 2723 LD B,A ; 2724 INC B ; 2725 2726 ;; WORDS 2727 L0985: BIT 7,(HL) ; 2728 INC HL ; 2729 JR Z,L0985 ; to WORDS 2730 2731 DJNZ L0985 ; to WORDS 2732 2733 BIT 6,A ; 2734 JR NZ,L0992 ; to COMP-FLAG 2735 2736 CP $18 ; 2737 2738 ;; COMP-FLAG 2739 L0992: CCF ; Complement Carry Flag 2740 2741 ;; FOUND 2742 L0993: LD B,H ; 2743 LD C,L ; 2744 POP HL ; 2745 RET NC ; 2746 2747 LD A,(BC) ; 2748 ADD A,$E4 ; 2749 RET ; 2750 2751 ; -------------------------- 2752 ; THE 'ONE SPACE' SUBROUTINE 2753 ; -------------------------- 2754 ; 2755 ; 2756 2757 ;; ONE-SPACE 2758 L099B: LD BC,$0001 ; 2759 2760 ; -------------------------- 2761 ; THE 'MAKE ROOM' SUBROUTINE 2762 ; -------------------------- 2763 ; 2764 ; 2765 2766 ;; MAKE-ROOM 2767 L099E: PUSH HL ; 2768 CALL L0EC5 ; routine TEST-ROOM 2769 POP HL ; 2770 CALL L09AD ; routine POINTERS 2771 LD HL,($401C) ; sv STKEND_lo 2772 EX DE,HL ; 2773 LDDR ; Copy Bytes 2774 RET ; 2775 2776 ; ------------------------- 2777 ; THE 'POINTERS' SUBROUTINE 2778 ; ------------------------- 2779 ; 2780 ; 2781 2782 ;; POINTERS 2783 L09AD: PUSH AF ; 2784 PUSH HL ; 2785 LD HL,$400C ; sv D_FILE_lo 2786 LD A,$09 ; 2787 2788 ;; NEXT-PTR 2789 L09B4: LD E,(HL) ; 2790 INC HL ; 2791 LD D,(HL) ; 2792 EX (SP),HL ; 2793 AND A ; 2794 SBC HL,DE ; 2795 ADD HL,DE ; 2796 EX (SP),HL ; 2797 JR NC,L09C8 ; to PTR-DONE 2798 2799 PUSH DE ; 2800 EX DE,HL ; 2801 ADD HL,BC ; 2802 EX DE,HL ; 2803 LD (HL),D ; 2804 DEC HL ; 2805 LD (HL),E ; 2806 INC HL ; 2807 POP DE ; 2808 2809 ;; PTR-DONE 2810 L09C8: INC HL ; 2811 DEC A ; 2812 JR NZ,L09B4 ; to NEXT-PTR 2813 2814 EX DE,HL ; 2815 POP DE ; 2816 POP AF ; 2817 AND A ; 2818 SBC HL,DE ; 2819 LD B,H ; 2820 LD C,L ; 2821 INC BC ; 2822 ADD HL,DE ; 2823 EX DE,HL ; 2824 RET ; 2825 2826 ; ----------------------------- 2827 ; THE 'LINE ADDRESS' SUBROUTINE 2828 ; ----------------------------- 2829 ; 2830 ; 2831 2832 ;; LINE-ADDR 2833 L09D8: PUSH HL ; 2834 LD HL,$407D ; 2835 LD D,H ; 2836 LD E,L ; 2837 2838 ;; NEXT-TEST 2839 L09DE: POP BC ; 2840 CALL L09EA ; routine CP-LINES 2841 RET NC ; 2842 2843 PUSH BC ; 2844 CALL L09F2 ; routine NEXT-ONE 2845 EX DE,HL ; 2846 JR L09DE ; to NEXT-TEST 2847 2848 ; ------------------------------------- 2849 ; THE 'COMPARE LINE NUMBERS' SUBROUTINE 2850 ; ------------------------------------- 2851 ; 2852 ; 2853 2854 ;; CP-LINES 2855 L09EA: LD A,(HL) ; 2856 CP B ; 2857 RET NZ ; 2858 2859 INC HL ; 2860 LD A,(HL) ; 2861 DEC HL ; 2862 CP C ; 2863 RET ; 2864 2865 ; -------------------------------------- 2866 ; THE 'NEXT LINE OR VARIABLE' SUBROUTINE 2867 ; -------------------------------------- 2868 ; 2869 ; 2870 2871 ;; NEXT-ONE 2872 L09F2: PUSH HL ; 2873 LD A,(HL) ; 2874 CP $40 ; 2875 JR C,L0A0F ; to LINES 2876 2877 BIT 5,A ; 2878 JR Z,L0A10 ; forward to NEXT-O-4 2879 2880 ADD A,A ; 2881 JP M,L0A01 ; to NEXT+FIVE 2882 2883 CCF ; Complement Carry Flag 2884 2885 ;; NEXT+FIVE 2886 L0A01: LD BC,$0005 ; 2887 JR NC,L0A08 ; to NEXT-LETT 2888 2889 LD C,$11 ; 2890 2891 ;; NEXT-LETT 2892 L0A08: RLA ; 2893 INC HL ; 2894 LD A,(HL) ; 2895 JR NC,L0A08 ; to NEXT-LETT 2896 2897 JR L0A15 ; to NEXT-ADD 2898 2899 ; --- 2900 2901 ;; LINES 2902 L0A0F: INC HL ; 2903 2904 ;; NEXT-O-4 2905 L0A10: INC HL ; 2906 LD C,(HL) ; 2907 INC HL ; 2908 LD B,(HL) ; 2909 INC HL ; 2910 2911 ;; NEXT-ADD 2912 L0A15: ADD HL,BC ; 2913 POP DE ; 2914 2915 ; --------------------------- 2916 ; THE 'DIFFERENCE' SUBROUTINE 2917 ; --------------------------- 2918 ; 2919 ; 2920 2921 ;; DIFFER 2922 L0A17: AND A ; 2923 SBC HL,DE ; 2924 LD B,H ; 2925 LD C,L ; 2926 ADD HL,DE ; 2927 EX DE,HL ; 2928 RET ; 2929 2930 ; -------------------------- 2931 ; THE 'LINE-ENDS' SUBROUTINE 2932 ; -------------------------- 2933 ; 2934 ; 2935 2936 ;; LINE-ENDS 2937 L0A1F: LD B,(IY+$22) ; sv DF_SZ 2938 PUSH BC ; 2939 CALL L0A2C ; routine B-LINES 2940 POP BC ; 2941 DEC B ; 2942 JR L0A2C ; to B-LINES 2943 2944 ; ------------------------- 2945 ; THE 'CLS' COMMAND ROUTINE 2946 ; ------------------------- 2947 ; 2948 ; 2949 2950 ;; CLS 2951 L0A2A: LD B,$18 ; 2952 2953 ;; B-LINES 2954 L0A2C: RES 1,(IY+$01) ; sv FLAGS - Signal printer not in use 2955 LD C,$21 ; 2956 PUSH BC ; 2957 CALL L0918 ; routine LOC-ADDR 2958 POP BC ; 2959 LD A,($4005) ; sv RAMTOP_hi 2960 CP $4D ; 2961 JR C,L0A52 ; to COLLAPSED 2962 2963 SET 7,(IY+$3A) ; sv S_POSN_y 2964 2965 ;; CLEAR-LOC 2966 L0A42: XOR A ; prepare a space 2967 CALL L07F5 ; routine PRINT-SP prints a space 2968 LD HL,($4039) ; sv S_POSN_x 2969 LD A,L ; 2970 OR H ; 2971 AND $7E ; 2972 JR NZ,L0A42 ; to CLEAR-LOC 2973 2974 JP L0918 ; to LOC-ADDR 2975 2976 ; --- 2977 2978 ;; COLLAPSED 2979 L0A52: LD D,H ; 2980 LD E,L ; 2981 DEC HL ; 2982 LD C,B ; 2983 LD B,$00 ; 2984 LDIR ; Copy Bytes 2985 LD HL,($4010) ; sv VARS_lo 2986 2987 ; ---------------------------- 2988 ; THE 'RECLAIMING' SUBROUTINES 2989 ; ---------------------------- 2990 ; 2991 ; 2992 2993 ;; RECLAIM-1 2994 L0A5D: CALL L0A17 ; routine DIFFER 2995 2996 ;; RECLAIM-2 2997 L0A60: PUSH BC ; 2998 LD A,B ; 2999 CPL ; 3000 LD B,A ; 3001 LD A,C ; 3002 CPL ; 3003 LD C,A ; 3004 INC BC ; 3005 CALL L09AD ; routine POINTERS 3006 EX DE,HL ; 3007 POP HL ; 3008 ADD HL,DE ; 3009 PUSH DE ; 3010 LDIR ; Copy Bytes 3011 POP HL ; 3012 RET ; 3013 3014 ; ------------------------------ 3015 ; THE 'E-LINE NUMBER' SUBROUTINE 3016 ; ------------------------------ 3017 ; 3018 ; 3019 3020 ;; E-LINE-NO 3021 L0A73: LD HL,($4014) ; sv E_LINE_lo 3022 CALL L004D ; routine TEMP-PTR-2 3023 3024 RST 18H ; GET-CHAR 3025 BIT 5,(IY+$2D) ; sv FLAGX 3026 RET NZ ; 3027 3028 LD HL,$405D ; sv MEM-0-1st 3029 LD ($401C),HL ; sv STKEND_lo 3030 CALL L1548 ; routine INT-TO-FP 3031 CALL L158A ; routine FP-TO-BC 3032 JR C,L0A91 ; to NO-NUMBER 3033 3034 LD HL,$D8F0 ; value '-10000' 3035 ADD HL,BC ; 3036 3037 ;; NO-NUMBER 3038 L0A91: JP C,L0D9A ; to REPORT-C 3039 3040 CP A ; 3041 JP L14BC ; routine SET-MIN 3042 3043 ; ------------------------------------------------- 3044 ; THE 'REPORT AND LINE NUMBER' PRINTING SUBROUTINES 3045 ; ------------------------------------------------- 3046 ; 3047 ; 3048 3049 ;; OUT-NUM 3050 L0A98: PUSH DE ; 3051 PUSH HL ; 3052 XOR A ; 3053 BIT 7,B ; 3054 JR NZ,L0ABF ; to UNITS 3055 3056 LD H,B ; 3057 LD L,C ; 3058 LD E,$FF ; 3059 JR L0AAD ; to THOUSAND 3060 3061 ; --- 3062 3063 ;; OUT-NO 3064 L0AA5: PUSH DE ; 3065 LD D,(HL) ; 3066 INC HL ; 3067 LD E,(HL) ; 3068 PUSH HL ; 3069 EX DE,HL ; 3070 LD E,$00 ; set E to leading space. 3071 3072 ;; THOUSAND 3073 L0AAD: LD BC,$FC18 ; 3074 CALL L07E1 ; routine OUT-DIGIT 3075 LD BC,$FF9C ; 3076 CALL L07E1 ; routine OUT-DIGIT 3077 LD C,$F6 ; 3078 CALL L07E1 ; routine OUT-DIGIT 3079 LD A,L ; 3080 3081 ;; UNITS 3082 L0ABF: CALL L07EB ; routine OUT-CODE 3083 POP HL ; 3084 POP DE ; 3085 RET ; 3086 3087 ; -------------------------- 3088 ; THE 'UNSTACK-Z' SUBROUTINE 3089 ; -------------------------- 3090 ; This subroutine is used to return early from a routine when checking syntax. 3091 ; On the ZX81 the same routines that execute commands also check the syntax 3092 ; on line entry. This enables precise placement of the error marker in a line 3093 ; that fails syntax. 3094 ; The sequence CALL SYNTAX-Z ; RET Z can be replaced by a call to this routine 3095 ; although it has not replaced every occurrence of the above two instructions. 3096 ; Even on the ZX-80 this routine was not fully utilized. 3097 3098 ;; UNSTACK-Z 3099 L0AC5: CALL L0DA6 ; routine SYNTAX-Z resets the ZERO flag if 3100 ; checking syntax. 3101 POP HL ; drop the return address. 3102 RET Z ; return to previous calling routine if 3103 ; checking syntax. 3104 3105 JP (HL) ; else jump to the continuation address in 3106 ; the calling routine as RET would have done. 3107 3108 ; ---------------------------- 3109 ; THE 'LPRINT' COMMAND ROUTINE 3110 ; ---------------------------- 3111 ; 3112 ; 3113 3114 ;; LPRINT 3115 L0ACB: SET 1,(IY+$01) ; sv FLAGS - Signal printer in use 3116 3117 ; --------------------------- 3118 ; THE 'PRINT' COMMAND ROUTINE 3119 ; --------------------------- 3120 ; 3121 ; 3122 3123 ;; PRINT 3124 L0ACF: LD A,(HL) ; 3125 CP $76 ; 3126 JP Z,L0B84 ; to PRINT-END 3127 3128 ;; PRINT-1 3129 L0AD5: SUB $1A ; 3130 ADC A,$00 ; 3131 JR Z,L0B44 ; to SPACING 3132 3133 CP $A7 ; 3134 JR NZ,L0AFA ; to NOT-AT 3135 3136 3137 RST 20H ; NEXT-CHAR 3138 CALL L0D92 ; routine CLASS-6 3139 CP $1A ; 3140 JP NZ,L0D9A ; to REPORT-C 3141 3142 3143 RST 20H ; NEXT-CHAR 3144 CALL L0D92 ; routine CLASS-6 3145 CALL L0B4E ; routine SYNTAX-ON 3146 3147 RST 28H ;; FP-CALC 3148 DEFB $01 ;;exchange 3149 DEFB $34 ;;end-calc 3150 3151 CALL L0BF5 ; routine STK-TO-BC 3152 CALL L08F5 ; routine PRINT-AT 3153 JR L0B37 ; to PRINT-ON 3154 3155 ; --- 3156 3157 ;; NOT-AT 3158 L0AFA: CP $A8 ; 3159 JR NZ,L0B31 ; to NOT-TAB 3160 3161 3162 RST 20H ; NEXT-CHAR 3163 CALL L0D92 ; routine CLASS-6 3164 CALL L0B4E ; routine SYNTAX-ON 3165 CALL L0C02 ; routine STK-TO-A 3166 JP NZ,L0EAD ; to REPORT-B 3167 3168 AND $1F ; 3169 LD C,A ; 3170 BIT 1,(IY+$01) ; sv FLAGS - Is printer in use 3171 JR Z,L0B1E ; to TAB-TEST 3172 3173 SUB (IY+$38) ; sv PR_CC 3174 SET 7,A ; 3175 ADD A,$3C ; 3176 CALL NC,L0871 ; routine COPY-BUFF 3177 3178 ;; TAB-TEST 3179 L0B1E: ADD A,(IY+$39) ; sv S_POSN_x 3180 CP $21 ; 3181 LD A,($403A) ; sv S_POSN_y 3182 SBC A,$01 ; 3183 CALL L08FA ; routine TEST-VAL 3184 SET 0,(IY+$01) ; sv FLAGS - Suppress leading space 3185 JR L0B37 ; to PRINT-ON 3186 3187 ; --- 3188 3189 ;; NOT-TAB 3190 L0B31: CALL L0F55 ; routine SCANNING 3191 CALL L0B55 ; routine PRINT-STK 3192 3193 ;; PRINT-ON 3194 L0B37: RST 18H ; GET-CHAR 3195 SUB $1A ; 3196 ADC A,$00 ; 3197 JR Z,L0B44 ; to SPACING 3198 3199 CALL L0D1D ; routine CHECK-END 3200 JP L0B84 ;;; to PRINT-END 3201 3202 ; --- 3203 3204 ;; SPACING 3205 L0B44: CALL NC,L0B8B ; routine FIELD 3206 3207 RST 20H ; NEXT-CHAR 3208 CP $76 ; 3209 RET Z ; 3210 3211 JP L0AD5 ;;; to PRINT-1 3212 3213 ; --- 3214 3215 ;; SYNTAX-ON 3216 L0B4E: CALL L0DA6 ; routine SYNTAX-Z 3217 RET NZ ; 3218 3219 POP HL ; 3220 JR L0B37 ; to PRINT-ON 3221 3222 ; --- 3223 3224 ;; PRINT-STK 3225 L0B55: CALL L0AC5 ; routine UNSTACK-Z 3226 BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? 3227 CALL Z,L13F8 ; routine STK-FETCH 3228 JR Z,L0B6B ; to PR-STR-4 3229 3230 JP L15DB ; jump forward to PRINT-FP 3231 3232 ; --- 3233 3234 ;; PR-STR-1 3235 L0B64: LD A,$0B ; 3236 3237 ;; PR-STR-2 3238 L0B66: RST 10H ; PRINT-A 3239 3240 ;; PR-STR-3 3241 L0B67: LD DE,($4018) ; sv X_PTR_lo 3242 3243 ;; PR-STR-4 3244 L0B6B: LD A,B ; 3245 OR C ; 3246 DEC BC ; 3247 RET Z ; 3248 3249 LD A,(DE) ; 3250 INC DE ; 3251 LD ($4018),DE ; sv X_PTR_lo 3252 BIT 6,A ; 3253 JR Z,L0B66 ; to PR-STR-2 3254 3255 CP $C0 ; 3256 JR Z,L0B64 ; to PR-STR-1 3257 3258 PUSH BC ; 3259 CALL L094B ; routine TOKENS 3260 POP BC ; 3261 JR L0B67 ; to PR-STR-3 3262 3263 ; --- 3264 3265 ;; PRINT-END 3266 L0B84: CALL L0AC5 ; routine UNSTACK-Z 3267 LD A,$76 ; 3268 3269 RST 10H ; PRINT-A 3270 RET ; 3271 3272 ; --- 3273 3274 ;; FIELD 3275 L0B8B: CALL L0AC5 ; routine UNSTACK-Z 3276 SET 0,(IY+$01) ; sv FLAGS - Suppress leading space 3277 XOR A ; 3278 3279 RST 10H ; PRINT-A 3280 LD BC,($4039) ; sv S_POSN_x 3281 LD A,C ; 3282 BIT 1,(IY+$01) ; sv FLAGS - Is printer in use 3283 JR Z,L0BA4 ; to CENTRE 3284 3285 LD A,$5D ; 3286 SUB (IY+$38) ; sv PR_CC 3287 3288 ;; CENTRE 3289 L0BA4: LD C,$11 ; 3290 CP C ; 3291 JR NC,L0BAB ; to RIGHT 3292 3293 LD C,$01 ; 3294 3295 ;; RIGHT 3296 L0BAB: CALL L090B ; routine SET-FIELD 3297 RET ; 3298 3299 ; -------------------------------------- 3300 ; THE 'PLOT AND UNPLOT' COMMAND ROUTINES 3301 ; -------------------------------------- 3302 ; 3303 ; 3304 3305 ;; PLOT/UNP 3306 L0BAF: CALL L0BF5 ; routine STK-TO-BC 3307 LD ($4036),BC ; sv COORDS_x 3308 LD A,$2B ; 3309 SUB B ; 3310 JP C,L0EAD ; to REPORT-B 3311 3312 LD B,A ; 3313 LD A,$01 ; 3314 SRA B ; 3315 JR NC,L0BC5 ; to COLUMNS 3316 3317 LD A,$04 ; 3318 3319 ;; COLUMNS 3320 L0BC5: SRA C ; 3321 JR NC,L0BCA ; to FIND-ADDR 3322 3323 RLCA ; 3324 3325 ;; FIND-ADDR 3326 L0BCA: PUSH AF ; 3327 CALL L08F5 ; routine PRINT-AT 3328 LD A,(HL) ; 3329 RLCA ; 3330 CP $10 ; 3331 JR NC,L0BDA ; to TABLE-PTR 3332 3333 RRCA ; 3334 JR NC,L0BD9 ; to SQ-SAVED 3335 3336 XOR $8F ; 3337 3338 ;; SQ-SAVED 3339 L0BD9: LD B,A ; 3340 3341 ;; TABLE-PTR 3342 L0BDA: LD DE,L0C9E ; Address: P-UNPLOT 3343 LD A,($4030) ; sv T_ADDR_lo 3344 SUB E ; 3345 JP M,L0BE9 ; to PLOT 3346 3347 POP AF ; 3348 CPL ; 3349 AND B ; 3350 JR L0BEB ; to UNPLOT 3351 3352 ; --- 3353 3354 ;; PLOT 3355 L0BE9: POP AF ; 3356 OR B ; 3357 3358 ;; UNPLOT 3359 L0BEB: CP $08 ; 3360 JR C,L0BF1 ; to PLOT-END 3361 3362 XOR $8F ; 3363 3364 ;; PLOT-END 3365 L0BF1: EXX ; 3366 3367 RST 10H ; PRINT-A 3368 EXX ; 3369 RET ; 3370 3371 ; ---------------------------- 3372 ; THE 'STACK-TO-BC' SUBROUTINE 3373 ; ---------------------------- 3374 ; 3375 ; 3376 3377 ;; STK-TO-BC 3378 L0BF5: CALL L0C02 ; routine STK-TO-A 3379 LD B,A ; 3380 PUSH BC ; 3381 CALL L0C02 ; routine STK-TO-A 3382 LD E,C ; 3383 POP BC ; 3384 LD D,C ; 3385 LD C,A ; 3386 RET ; 3387 3388 ; --------------------------- 3389 ; THE 'STACK-TO-A' SUBROUTINE 3390 ; --------------------------- 3391 ; 3392 ; 3393 3394 ;; STK-TO-A 3395 L0C02: CALL L15CD ; routine FP-TO-A 3396 JP C,L0EAD ; to REPORT-B 3397 3398 LD C,$01 ; 3399 RET Z ; 3400 3401 LD C,$FF ; 3402 RET ; 3403 3404 ; ----------------------- 3405 ; THE 'SCROLL' SUBROUTINE 3406 ; ----------------------- 3407 ; 3408 ; 3409 3410 ;; SCROLL 3411 L0C0E: LD B,(IY+$22) ; sv DF_SZ 3412 LD C,$21 ; 3413 CALL L0918 ; routine LOC-ADDR 3414 CALL L099B ; routine ONE-SPACE 3415 LD A,(HL) ; 3416 LD (DE),A ; 3417 INC (IY+$3A) ; sv S_POSN_y 3418 LD HL,($400C) ; sv D_FILE_lo 3419 INC HL ; 3420 LD D,H ; 3421 LD E,L ; 3422 CPIR ; 3423 JP L0A5D ; to RECLAIM-1 3424 3425 ; ------------------- 3426 ; THE 'SYNTAX' TABLES 3427 ; ------------------- 3428 3429 ; i) The Offset table 3430 3431 ;; offset-t 3432 L0C29: DEFB L0CB4 - $ ; 8B offset to; Address: P-LPRINT 3433 DEFB L0CB7 - $ ; 8D offset to; Address: P-LLIST 3434 DEFB L0C58 - $ ; 2D offset to; Address: P-STOP 3435 DEFB L0CAB - $ ; 7F offset to; Address: P-SLOW 3436 DEFB L0CAE - $ ; 81 offset to; Address: P-FAST 3437 DEFB L0C77 - $ ; 49 offset to; Address: P-NEW 3438 DEFB L0CA4 - $ ; 75 offset to; Address: P-SCROLL 3439 DEFB L0C8F - $ ; 5F offset to; Address: P-CONT 3440 DEFB L0C71 - $ ; 40 offset to; Address: P-DIM 3441 DEFB L0C74 - $ ; 42 offset to; Address: P-REM 3442 DEFB L0C5E - $ ; 2B offset to; Address: P-FOR 3443 DEFB L0C4B - $ ; 17 offset to; Address: P-GOTO 3444 DEFB L0C54 - $ ; 1F offset to; Address: P-GOSUB 3445 DEFB L0C6D - $ ; 37 offset to; Address: P-INPUT 3446 DEFB L0C89 - $ ; 52 offset to; Address: P-LOAD 3447 DEFB L0C7D - $ ; 45 offset to; Address: P-LIST 3448 DEFB L0C48 - $ ; 0F offset to; Address: P-LET 3449 DEFB L0CA7 - $ ; 6D offset to; Address: P-PAUSE 3450 DEFB L0C66 - $ ; 2B offset to; Address: P-NEXT 3451 DEFB L0C80 - $ ; 44 offset to; Address: P-POKE 3452 DEFB L0C6A - $ ; 2D offset to; Address: P-PRINT 3453 DEFB L0C98 - $ ; 5A offset to; Address: P-PLOT 3454 DEFB L0C7A - $ ; 3B offset to; Address: P-RUN 3455 DEFB L0C8C - $ ; 4C offset to; Address: P-SAVE 3456 DEFB L0C86 - $ ; 45 offset to; Address: P-RAND 3457 DEFB L0C4F - $ ; 0D offset to; Address: P-IF 3458 DEFB L0C95 - $ ; 52 offset to; Address: P-CLS 3459 DEFB L0C9E - $ ; 5A offset to; Address: P-UNPLOT 3460 DEFB L0C92 - $ ; 4D offset to; Address: P-CLEAR 3461 DEFB L0C5B - $ ; 15 offset to; Address: P-RETURN 3462 DEFB L0CB1 - $ ; 6A offset to; Address: P-COPY 3463 3464 ; ii) The parameter table. 3465 3466 3467 ;; P-LET 3468 L0C48: DEFB $01 ; Class-01 - A variable is required. 3469 DEFB $14 ; Separator: '=' 3470 DEFB $02 ; Class-02 - An expression, numeric or string, 3471 ; must follow. 3472 3473 ;; P-GOTO 3474 L0C4B: DEFB $06 ; Class-06 - A numeric expression must follow. 3475 DEFB $00 ; Class-00 - No further operands. 3476 DEFW L0E81 ; Address: $0E81; Address: GOTO 3477 3478 ;; P-IF 3479 L0C4F: DEFB $06 ; Class-06 - A numeric expression must follow. 3480 DEFB $DE ; Separator: 'THEN' 3481 DEFB $05 ; Class-05 - Variable syntax checked entirely 3482 ; by routine. 3483 DEFW L0DAB ; Address: $0DAB; Address: IF 3484 3485 ;; P-GOSUB 3486 L0C54: DEFB $06 ; Class-06 - A numeric expression must follow. 3487 DEFB $00 ; Class-00 - No further operands. 3488 DEFW L0EB5 ; Address: $0EB5; Address: GOSUB 3489 3490 ;; P-STOP 3491 L0C58: DEFB $00 ; Class-00 - No further operands. 3492 DEFW L0CDC ; Address: $0CDC; Address: STOP 3493 3494 ;; P-RETURN 3495 L0C5B: DEFB $00 ; Class-00 - No further operands. 3496 DEFW L0ED8 ; Address: $0ED8; Address: RETURN 3497 3498 ;; P-FOR 3499 L0C5E: DEFB $04 ; Class-04 - A single character variable must 3500 ; follow. 3501 DEFB $14 ; Separator: '=' 3502 DEFB $06 ; Class-06 - A numeric expression must follow. 3503 DEFB $DF ; Separator: 'TO' 3504 DEFB $06 ; Class-06 - A numeric expression must follow. 3505 DEFB $05 ; Class-05 - Variable syntax checked entirely 3506 ; by routine. 3507 DEFW L0DB9 ; Address: $0DB9; Address: FOR 3508 3509 ;; P-NEXT 3510 L0C66: DEFB $04 ; Class-04 - A single character variable must 3511 ; follow. 3512 DEFB $00 ; Class-00 - No further operands. 3513 DEFW L0E2E ; Address: $0E2E; Address: NEXT 3514 3515 ;; P-PRINT 3516 L0C6A: DEFB $05 ; Class-05 - Variable syntax checked entirely 3517 ; by routine. 3518 DEFW L0ACF ; Address: $0ACF; Address: PRINT 3519 3520 ;; P-INPUT 3521 L0C6D: DEFB $01 ; Class-01 - A variable is required. 3522 DEFB $00 ; Class-00 - No further operands. 3523 DEFW L0EE9 ; Address: $0EE9; Address: INPUT 3524 3525 ;; P-DIM 3526 L0C71: DEFB $05 ; Class-05 - Variable syntax checked entirely 3527 ; by routine. 3528 DEFW L1409 ; Address: $1409; Address: DIM 3529 3530 ;; P-REM 3531 L0C74: DEFB $05 ; Class-05 - Variable syntax checked entirely 3532 ; by routine. 3533 DEFW L0D6A ; Address: $0D6A; Address: REM 3534 3535 ;; P-NEW 3536 L0C77: DEFB $00 ; Class-00 - No further operands. 3537 DEFW L03C3 ; Address: $03C3; Address: NEW 3538 3539 ;; P-RUN 3540 L0C7A: DEFB $03 ; Class-03 - A numeric expression may follow 3541 ; else default to zero. 3542 DEFW L0EAF ; Address: $0EAF; Address: RUN 3543 3544 ;; P-LIST 3545 L0C7D: DEFB $03 ; Class-03 - A numeric expression may follow 3546 ; else default to zero. 3547 DEFW L0730 ; Address: $0730; Address: LIST 3548 3549 ;; P-POKE 3550 L0C80: DEFB $06 ; Class-06 - A numeric expression must follow. 3551 DEFB $1A ; Separator: ',' 3552 DEFB $06 ; Class-06 - A numeric expression must follow. 3553 DEFB $00 ; Class-00 - No further operands. 3554 DEFW L0E92 ; Address: $0E92; Address: POKE 3555 3556 ;; P-RAND 3557 L0C86: DEFB $03 ; Class-03 - A numeric expression may follow 3558 ; else default to zero. 3559 DEFW L0E6C ; Address: $0E6C; Address: RAND 3560 3561 ;; P-LOAD 3562 L0C89: DEFB $05 ; Class-05 - Variable syntax checked entirely 3563 ; by routine. 3564 DEFW L0340 ; Address: $0340; Address: LOAD 3565 3566 ;; P-SAVE 3567 L0C8C: DEFB $05 ; Class-05 - Variable syntax checked entirely 3568 ; by routine. 3569 DEFW L02F6 ; Address: $02F6; Address: SAVE 3570 3571 ;; P-CONT 3572 L0C8F: DEFB $00 ; Class-00 - No further operands. 3573 DEFW L0E7C ; Address: $0E7C; Address: CONT 3574 3575 ;; P-CLEAR 3576 L0C92: DEFB $00 ; Class-00 - No further operands. 3577 DEFW L149A ; Address: $149A; Address: CLEAR 3578 3579 ;; P-CLS 3580 L0C95: DEFB $00 ; Class-00 - No further operands. 3581 DEFW L0A2A ; Address: $0A2A; Address: CLS 3582 3583 ;; P-PLOT 3584 L0C98: DEFB $06 ; Class-06 - A numeric expression must follow. 3585 DEFB $1A ; Separator: ',' 3586 DEFB $06 ; Class-06 - A numeric expression must follow. 3587 DEFB $00 ; Class-00 - No further operands. 3588 DEFW L0BAF ; Address: $0BAF; Address: PLOT/UNP 3589 3590 ;; P-UNPLOT 3591 L0C9E: DEFB $06 ; Class-06 - A numeric expression must follow. 3592 DEFB $1A ; Separator: ',' 3593 DEFB $06 ; Class-06 - A numeric expression must follow. 3594 DEFB $00 ; Class-00 - No further operands. 3595 DEFW L0BAF ; Address: $0BAF; Address: PLOT/UNP 3596 3597 ;; P-SCROLL 3598 L0CA4: DEFB $00 ; Class-00 - No further operands. 3599 DEFW L0C0E ; Address: $0C0E; Address: SCROLL 3600 3601 ;; P-PAUSE 3602 L0CA7: DEFB $06 ; Class-06 - A numeric expression must follow. 3603 DEFB $00 ; Class-00 - No further operands. 3604 DEFW L0F32 ; Address: $0F32; Address: PAUSE 3605 3606 ;; P-SLOW 3607 L0CAB: DEFB $00 ; Class-00 - No further operands. 3608 DEFW L0F2B ; Address: $0F2B; Address: SLOW 3609 3610 ;; P-FAST 3611 L0CAE: DEFB $00 ; Class-00 - No further operands. 3612 DEFW L0F23 ; Address: $0F23; Address: FAST 3613 3614 ;; P-COPY 3615 L0CB1: DEFB $00 ; Class-00 - No further operands. 3616 DEFW L0869 ; Address: $0869; Address: COPY 3617 3618 ;; P-LPRINT 3619 L0CB4: DEFB $05 ; Class-05 - Variable syntax checked entirely 3620 ; by routine. 3621 DEFW L0ACB ; Address: $0ACB; Address: LPRINT 3622 3623 ;; P-LLIST 3624 L0CB7: DEFB $03 ; Class-03 - A numeric expression may follow 3625 ; else default to zero. 3626 DEFW L072C ; Address: $072C; Address: LLIST 3627 3628 3629 ; --------------------------- 3630 ; THE 'LINE SCANNING' ROUTINE 3631 ; --------------------------- 3632 ; 3633 ; 3634 3635 ;; LINE-SCAN 3636 L0CBA: LD (IY+$01),$01 ; sv FLAGS 3637 CALL L0A73 ; routine E-LINE-NO 3638 3639 ;; LINE-RUN 3640 L0CC1: CALL L14BC ; routine SET-MIN 3641 LD HL,$4000 ; sv ERR_NR 3642 LD (HL),$FF ; 3643 LD HL,$402D ; sv FLAGX 3644 BIT 5,(HL) ; 3645 JR Z,L0CDE ; to LINE-NULL 3646 3647 CP $E3 ; 'STOP' ? 3648 LD A,(HL) ; 3649 JP NZ,L0D6F ; to INPUT-REP 3650 3651 CALL L0DA6 ; routine SYNTAX-Z 3652 RET Z ; 3653 3654 3655 RST 08H ; ERROR-1 3656 DEFB $0C ; Error Report: BREAK - CONT repeats 3657 3658 3659 ; -------------------------- 3660 ; THE 'STOP' COMMAND ROUTINE 3661 ; -------------------------- 3662 ; 3663 ; 3664 3665 ;; STOP 3666 L0CDC: RST 08H ; ERROR-1 3667 DEFB $08 ; Error Report: STOP statement 3668 3669 ; --- 3670 3671 ; the interpretation of a line continues with a check for just spaces 3672 ; followed by a carriage return. 3673 ; The IF command also branches here with a true value to execute the 3674 ; statement after the THEN but the statement can be null so 3675 ; 10 IF 1 = 1 THEN 3676 ; passes syntax (on all ZX computers). 3677 3678 ;; LINE-NULL 3679 L0CDE: RST 18H ; GET-CHAR 3680 LD B,$00 ; prepare to index - early. 3681 CP $76 ; compare to NEWLINE. 3682 RET Z ; return if so. 3683 3684 LD C,A ; transfer character to C. 3685 3686 RST 20H ; NEXT-CHAR advances. 3687 LD A,C ; character to A 3688 SUB $E1 ; subtract 'LPRINT' - lowest command. 3689 JR C,L0D26 ; forward if less to REPORT-C2 3690 3691 LD C,A ; reduced token to C 3692 LD HL,L0C29 ; set HL to address of offset table. 3693 ADD HL,BC ; index into offset table. 3694 LD C,(HL) ; fetch offset 3695 ADD HL,BC ; index into parameter table. 3696 JR L0CF7 ; to GET-PARAM 3697 3698 ; --- 3699 3700 ;; SCAN-LOOP 3701 L0CF4: LD HL,($4030) ; sv T_ADDR_lo 3702 3703 ; -> Entry Point to Scanning Loop 3704 3705 ;; GET-PARAM 3706 L0CF7: LD A,(HL) ; 3707 INC HL ; 3708 LD ($4030),HL ; sv T_ADDR_lo 3709 3710 LD BC,L0CF4 ; Address: SCAN-LOOP 3711 PUSH BC ; is pushed on machine stack. 3712 3713 LD C,A ; 3714 CP $0B ; 3715 JR NC,L0D10 ; to SEPARATOR 3716 3717 LD HL,L0D16 ; class-tbl - the address of the class table. 3718 LD B,$00 ; 3719 ADD HL,BC ; 3720 LD C,(HL) ; 3721 ADD HL,BC ; 3722 PUSH HL ; 3723 3724 RST 18H ; GET-CHAR 3725 RET ; indirect jump to class routine and 3726 ; by subsequent RET to SCAN-LOOP. 3727 3728 ; ----------------------- 3729 ; THE 'SEPARATOR' ROUTINE 3730 ; ----------------------- 3731 3732 ;; SEPARATOR 3733 L0D10: RST 18H ; GET-CHAR 3734 CP C ; 3735 JR NZ,L0D26 ; to REPORT-C2 3736 ; 'Nonsense in BASIC' 3737 3738 RST 20H ; NEXT-CHAR 3739 RET ; return 3740 3741 3742 ; ------------------------- 3743 ; THE 'COMMAND CLASS' TABLE 3744 ; ------------------------- 3745 ; 3746 3747 ;; class-tbl 3748 L0D16: DEFB L0D2D - $ ; 17 offset to; Address: CLASS-0 3749 DEFB L0D3C - $ ; 25 offset to; Address: CLASS-1 3750 DEFB L0D6B - $ ; 53 offset to; Address: CLASS-2 3751 DEFB L0D28 - $ ; 0F offset to; Address: CLASS-3 3752 DEFB L0D85 - $ ; 6B offset to; Address: CLASS-4 3753 DEFB L0D2E - $ ; 13 offset to; Address: CLASS-5 3754 DEFB L0D92 - $ ; 76 offset to; Address: CLASS-6 3755 3756 3757 ; -------------------------- 3758 ; THE 'CHECK END' SUBROUTINE 3759 ; -------------------------- 3760 ; Check for end of statement and that no spurious characters occur after 3761 ; a correctly parsed statement. Since only one statement is allowed on each 3762 ; line, the only character that may follow a statement is a NEWLINE. 3763 ; 3764 3765 ;; CHECK-END 3766 L0D1D: CALL L0DA6 ; routine SYNTAX-Z 3767 RET NZ ; return in runtime. 3768 3769 POP BC ; else drop return address. 3770 3771 ;; CHECK-2 3772 L0D22: LD A,(HL) ; fetch character. 3773 CP $76 ; compare to NEWLINE. 3774 RET Z ; return if so. 3775 3776 ;; REPORT-C2 3777 L0D26: JR L0D9A ; to REPORT-C 3778 ; 'Nonsense in BASIC' 3779 3780 ; -------------------------- 3781 ; COMMAND CLASSES 03, 00, 05 3782 ; -------------------------- 3783 ; 3784 ; 3785 3786 ;; CLASS-3 3787 L0D28: CP $76 ; 3788 CALL L0D9C ; routine NO-TO-STK 3789 3790 ;; CLASS-0 3791 L0D2D: CP A ; 3792 3793 ;; CLASS-5 3794 L0D2E: POP BC ; 3795 CALL Z,L0D1D ; routine CHECK-END 3796 EX DE,HL ; 3797 LD HL,($4030) ; sv T_ADDR_lo 3798 LD C,(HL) ; 3799 INC HL ; 3800 LD B,(HL) ; 3801 EX DE,HL ; 3802 3803 ;; CLASS-END 3804 L0D3A: PUSH BC ; 3805 RET ; 3806 3807 ; ------------------------------ 3808 ; COMMAND CLASSES 01, 02, 04, 06 3809 ; ------------------------------ 3810 ; 3811 ; 3812 3813 ;; CLASS-1 3814 L0D3C: CALL L111C ; routine LOOK-VARS 3815 3816 ;; CLASS-4-2 3817 L0D3F: LD (IY+$2D),$00 ; sv FLAGX 3818 JR NC,L0D4D ; to SET-STK 3819 3820 SET 1,(IY+$2D) ; sv FLAGX 3821 JR NZ,L0D63 ; to SET-STRLN 3822 3823 3824 ;; REPORT-2 3825 L0D4B: RST 08H ; ERROR-1 3826 DEFB $01 ; Error Report: Variable not found 3827 3828 ; --- 3829 3830 ;; SET-STK 3831 L0D4D: CALL Z,L11A7 ; routine STK-VAR 3832 BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? 3833 JR NZ,L0D63 ; to SET-STRLN 3834 3835 XOR A ; 3836 CALL L0DA6 ; routine SYNTAX-Z 3837 CALL NZ,L13F8 ; routine STK-FETCH 3838 LD HL,$402D ; sv FLAGX 3839 OR (HL) ; 3840 LD (HL),A ; 3841 EX DE,HL ; 3842 3843 ;; SET-STRLN 3844 L0D63: LD ($402E),BC ; sv STRLEN_lo 3845 LD ($4012),HL ; sv DEST-lo 3846 3847 ; THE 'REM' COMMAND ROUTINE 3848 3849 ;; REM 3850 L0D6A: RET ; 3851 3852 ; --- 3853 3854 ;; CLASS-2 3855 L0D6B: POP BC ; 3856 LD A,($4001) ; sv FLAGS 3857 3858 ;; INPUT-REP 3859 L0D6F: PUSH AF ; 3860 CALL L0F55 ; routine SCANNING 3861 POP AF ; 3862 LD BC,L1321 ; Address: LET 3863 LD D,(IY+$01) ; sv FLAGS 3864 XOR D ; 3865 AND $40 ; 3866 JR NZ,L0D9A ; to REPORT-C 3867 3868 BIT 7,D ; 3869 JR NZ,L0D3A ; to CLASS-END 3870 3871 JR L0D22 ; to CHECK-2 3872 3873 ; --- 3874 3875 ;; CLASS-4 3876 L0D85: CALL L111C ; routine LOOK-VARS 3877 PUSH AF ; 3878 LD A,C ; 3879 OR $9F ; 3880 INC A ; 3881 JR NZ,L0D9A ; to REPORT-C 3882 3883 POP AF ; 3884 JR L0D3F ; to CLASS-4-2 3885 3886 ; --- 3887 3888 ;; CLASS-6 3889 L0D92: CALL L0F55 ; routine SCANNING 3890 BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? 3891 RET NZ ; 3892 3893 3894 ;; REPORT-C 3895 L0D9A: RST 08H ; ERROR-1 3896 DEFB $0B ; Error Report: Nonsense in BASIC 3897 3898 ; -------------------------------- 3899 ; THE 'NUMBER TO STACK' SUBROUTINE 3900 ; -------------------------------- 3901 ; 3902 ; 3903 3904 ;; NO-TO-STK 3905 L0D9C: JR NZ,L0D92 ; back to CLASS-6 with a non-zero number. 3906 3907 CALL L0DA6 ; routine SYNTAX-Z 3908 RET Z ; return if checking syntax. 3909 3910 ; in runtime a zero default is placed on the calculator stack. 3911 3912 RST 28H ;; FP-CALC 3913 DEFB $A0 ;;stk-zero 3914 DEFB $34 ;;end-calc 3915 3916 RET ; return. 3917 3918 ; ------------------------- 3919 ; THE 'SYNTAX-Z' SUBROUTINE 3920 ; ------------------------- 3921 ; This routine returns with zero flag set if checking syntax. 3922 ; Calling this routine uses three instruction bytes compared to four if the 3923 ; bit test is implemented inline. 3924 3925 ;; SYNTAX-Z 3926 L0DA6: BIT 7,(IY+$01) ; test FLAGS - checking syntax only? 3927 RET ; return. 3928 3929 ; ------------------------ 3930 ; THE 'IF' COMMAND ROUTINE 3931 ; ------------------------ 3932 ; In runtime, the class routines have evaluated the test expression and 3933 ; the result, true or false, is on the stack. 3934 3935 ;; IF 3936 L0DAB: CALL L0DA6 ; routine SYNTAX-Z 3937 JR Z,L0DB6 ; forward if checking syntax to IF-END 3938 3939 ; else delete the Boolean value on the calculator stack. 3940 3941 RST 28H ;; FP-CALC 3942 DEFB $02 ;;delete 3943 DEFB $34 ;;end-calc 3944 3945 ; register DE points to exponent of floating point value. 3946 3947 LD A,(DE) ; fetch exponent. 3948 AND A ; test for zero - FALSE. 3949 RET Z ; return if so. 3950 3951 ;; IF-END 3952 L0DB6: JP L0CDE ; jump back to LINE-NULL 3953 3954 ; ------------------------- 3955 ; THE 'FOR' COMMAND ROUTINE 3956 ; ------------------------- 3957 ; 3958 ; 3959 3960 ;; FOR 3961 L0DB9: CP $E0 ; is current character 'STEP' ? 3962 JR NZ,L0DC6 ; forward if not to F-USE-ONE 3963 3964 3965 RST 20H ; NEXT-CHAR 3966 CALL L0D92 ; routine CLASS-6 stacks the number 3967 CALL L0D1D ; routine CHECK-END 3968 JR L0DCC ; forward to F-REORDER 3969 3970 ; --- 3971 3972 ;; F-USE-ONE 3973 L0DC6: CALL L0D1D ; routine CHECK-END 3974 3975 RST 28H ;; FP-CALC 3976 DEFB $A1 ;;stk-one 3977 DEFB $34 ;;end-calc 3978 3979 3980 3981 ;; F-REORDER 3982 L0DCC: RST 28H ;; FP-CALC v, l, s. 3983 DEFB $C0 ;;st-mem-0 v, l, s. 3984 DEFB $02 ;;delete v, l. 3985 DEFB $01 ;;exchange l, v. 3986 DEFB $E0 ;;get-mem-0 l, v, s. 3987 DEFB $01 ;;exchange l, s, v. 3988 DEFB $34 ;;end-calc l, s, v. 3989 3990 CALL L1321 ; routine LET 3991 3992 LD ($401F),HL ; set MEM to address variable. 3993 DEC HL ; point to letter. 3994 LD A,(HL) ; 3995 SET 7,(HL) ; 3996 LD BC,$0006 ; 3997 ADD HL,BC ; 3998 RLCA ; 3999 JR C,L0DEA ; to F-LMT-STP 4000 4001 SLA C ; 4002 CALL L099E ; routine MAKE-ROOM 4003 INC HL ; 4004 4005 ;; F-LMT-STP 4006 L0DEA: PUSH HL ; 4007 4008 RST 28H ;; FP-CALC 4009 DEFB $02 ;;delete 4010 DEFB $02 ;;delete 4011 DEFB $34 ;;end-calc 4012 4013 POP HL ; 4014 EX DE,HL ; 4015 4016 LD C,$0A ; ten bytes to be moved. 4017 LDIR ; copy bytes 4018 4019 LD HL,($4007) ; set HL to system variable PPC current line. 4020 EX DE,HL ; transfer to DE, variable pointer to HL. 4021 INC DE ; loop start will be this line + 1 at least. 4022 LD (HL),E ; 4023 INC HL ; 4024 LD (HL),D ; 4025 CALL L0E5A ; routine NEXT-LOOP considers an initial pass. 4026 RET NC ; return if possible. 4027 4028 ; else program continues from point following matching NEXT. 4029 4030 BIT 7,(IY+$08) ; test PPC_hi 4031 RET NZ ; return if over 32767 ??? 4032 4033 LD B,(IY+$2E) ; fetch variable name from STRLEN_lo 4034 RES 6,B ; make a true letter. 4035 LD HL,($4029) ; set HL from NXTLIN 4036 4037 ; now enter a loop to look for matching next. 4038 4039 ;; NXTLIN-NO 4040 L0E0E: LD A,(HL) ; fetch high byte of line number. 4041 AND $C0 ; mask off low bits $3F 4042 JR NZ,L0E2A ; forward at end of program to FOR-END 4043 4044 PUSH BC ; save letter 4045 CALL L09F2 ; routine NEXT-ONE finds next line. 4046 POP BC ; restore letter 4047 4048 INC HL ; step past low byte 4049 INC HL ; past the 4050 INC HL ; line length. 4051 CALL L004C ; routine TEMP-PTR1 sets CH_ADD 4052 4053 RST 18H ; GET-CHAR 4054 CP $F3 ; compare to 'NEXT'. 4055 EX DE,HL ; next line to HL. 4056 JR NZ,L0E0E ; back with no match to NXTLIN-NO 4057 4058 ; 4059 4060 EX DE,HL ; restore pointer. 4061 4062 RST 20H ; NEXT-CHAR advances and gets letter in A. 4063 EX DE,HL ; save pointer 4064 CP B ; compare to variable name. 4065 JR NZ,L0E0E ; back with mismatch to NXTLIN-NO 4066 4067 ;; FOR-END 4068 L0E2A: LD ($4029),HL ; update system variable NXTLIN 4069 RET ; return. 4070 4071 ; -------------------------- 4072 ; THE 'NEXT' COMMAND ROUTINE 4073 ; -------------------------- 4074 ; 4075 ; 4076 4077 ;; NEXT 4078 L0E2E: BIT 1,(IY+$2D) ; sv FLAGX 4079 JP NZ,L0D4B ; to REPORT-2 4080 4081 LD HL,($4012) ; DEST 4082 BIT 7,(HL) ; 4083 JR Z,L0E58 ; to REPORT-1 4084 4085 INC HL ; 4086 LD ($401F),HL ; sv MEM_lo 4087 4088 RST 28H ;; FP-CALC 4089 DEFB $E0 ;;get-mem-0 4090 DEFB $E2 ;;get-mem-2 4091 DEFB $0F ;;addition 4092 DEFB $C0 ;;st-mem-0 4093 DEFB $02 ;;delete 4094 DEFB $34 ;;end-calc 4095 4096 CALL L0E5A ; routine NEXT-LOOP 4097 RET C ; 4098 4099 LD HL,($401F) ; sv MEM_lo 4100 LD DE,$000F ; 4101 ADD HL,DE ; 4102 LD E,(HL) ; 4103 INC HL ; 4104 LD D,(HL) ; 4105 EX DE,HL ; 4106 JR L0E86 ; to GOTO-2 4107 4108 ; --- 4109 4110 4111 ;; REPORT-1 4112 L0E58: RST 08H ; ERROR-1 4113 DEFB $00 ; Error Report: NEXT without FOR 4114 4115 4116 ; -------------------------- 4117 ; THE 'NEXT-LOOP' SUBROUTINE 4118 ; -------------------------- 4119 ; 4120 ; 4121 4122 ;; NEXT-LOOP 4123 L0E5A: RST 28H ;; FP-CALC 4124 DEFB $E1 ;;get-mem-1 4125 DEFB $E0 ;;get-mem-0 4126 DEFB $E2 ;;get-mem-2 4127 DEFB $32 ;;less-0 4128 DEFB $00 ;;jump-true 4129 DEFB $02 ;;to L0E62, LMT-V-VAL 4130 4131 DEFB $01 ;;exchange 4132 4133 ;; LMT-V-VAL 4134 L0E62: DEFB $03 ;;subtract 4135 DEFB $33 ;;greater-0 4136 DEFB $00 ;;jump-true 4137 DEFB $04 ;;to L0E69, IMPOSS 4138 4139 DEFB $34 ;;end-calc 4140 4141 AND A ; clear carry flag 4142 RET ; return. 4143 4144 ; --- 4145 4146 4147 ;; IMPOSS 4148 L0E69: DEFB $34 ;;end-calc 4149 4150 SCF ; set carry flag 4151 RET ; return. 4152 4153 ; -------------------------- 4154 ; THE 'RAND' COMMAND ROUTINE 4155 ; -------------------------- 4156 ; The keyword was 'RANDOMISE' on the ZX80, is 'RAND' here on the ZX81 and 4157 ; becomes 'RANDOMIZE' on the ZX Spectrum. 4158 ; In all invocations the procedure is the same - to set the SEED system variable 4159 ; with a supplied integer value or to use a time-based value if no number, or 4160 ; zero, is supplied. 4161 4162 ;; RAND 4163 L0E6C: CALL L0EA7 ; routine FIND-INT 4164 LD A,B ; test value 4165 OR C ; for zero 4166 JR NZ,L0E77 ; forward if not zero to SET-SEED 4167 4168 LD BC,($4034) ; fetch value of FRAMES system variable. 4169 4170 ;; SET-SEED 4171 L0E77: LD ($4032),BC ; update the SEED system variable. 4172 RET ; return. 4173 4174 ; -------------------------- 4175 ; THE 'CONT' COMMAND ROUTINE 4176 ; -------------------------- 4177 ; Another abbreviated command. ROM space was really tight. 4178 ; CONTINUE at the line number that was set when break was pressed. 4179 ; Sometimes the current line, sometimes the next line. 4180 4181 ;; CONT 4182 L0E7C: LD HL,($402B) ; set HL from system variable OLDPPC 4183 JR L0E86 ; forward to GOTO-2 4184 4185 ; -------------------------- 4186 ; THE 'GOTO' COMMAND ROUTINE 4187 ; -------------------------- 4188 ; This token also suffered from the shortage of room and there is no space 4189 ; getween GO and TO as there is on the ZX80 and ZX Spectrum. The same also 4190 ; applies to the GOSUB keyword. 4191 4192 ;; GOTO 4193 L0E81: CALL L0EA7 ; routine FIND-INT 4194 LD H,B ; 4195 LD L,C ; 4196 4197 ;; GOTO-2 4198 L0E86: LD A,H ; 4199 CP $F0 ; 4200 JR NC,L0EAD ; to REPORT-B 4201 4202 CALL L09D8 ; routine LINE-ADDR 4203 LD ($4029),HL ; sv NXTLIN_lo 4204 RET ; 4205 4206 ; -------------------------- 4207 ; THE 'POKE' COMMAND ROUTINE 4208 ; -------------------------- 4209 ; 4210 ; 4211 4212 ;; POKE 4213 L0E92: CALL L15CD ; routine FP-TO-A 4214 JR C,L0EAD ; forward, with overflow, to REPORT-B 4215 4216 JR Z,L0E9B ; forward, if positive, to POKE-SAVE 4217 4218 NEG ; negate 4219 4220 ;; POKE-SAVE 4221 L0E9B: PUSH AF ; preserve value. 4222 CALL L0EA7 ; routine FIND-INT gets address in BC 4223 ; invoking the error routine with overflow 4224 ; or a negative number. 4225 POP AF ; restore value. 4226 4227 ; Note. the next two instructions are legacy code from the ZX80 and 4228 ; inappropriate here. 4229 4230 BIT 7,(IY+$00) ; test ERR_NR - is it still $FF ? 4231 RET Z ; return with error. 4232 4233 LD (BC),A ; update the address contents. 4234 RET ; return. 4235 4236 ; ----------------------------- 4237 ; THE 'FIND INTEGER' SUBROUTINE 4238 ; ----------------------------- 4239 ; 4240 ; 4241 4242 ;; FIND-INT 4243 L0EA7: CALL L158A ; routine FP-TO-BC 4244 JR C,L0EAD ; forward with overflow to REPORT-B 4245 4246 RET Z ; return if positive (0-65535). 4247 4248 4249 ;; REPORT-B 4250 L0EAD: RST 08H ; ERROR-1 4251 DEFB $0A ; Error Report: Integer out of range 4252 4253 ; ------------------------- 4254 ; THE 'RUN' COMMAND ROUTINE 4255 ; ------------------------- 4256 ; 4257 ; 4258 4259 ;; RUN 4260 L0EAF: CALL L0E81 ; routine GOTO 4261 JP L149A ; to CLEAR 4262 4263 ; --------------------------- 4264 ; THE 'GOSUB' COMMAND ROUTINE 4265 ; --------------------------- 4266 ; 4267 ; 4268 4269 ;; GOSUB 4270 L0EB5: LD HL,($4007) ; sv PPC_lo 4271 INC HL ; 4272 EX (SP),HL ; 4273 PUSH HL ; 4274 LD ($4002),SP ; set the error stack pointer - ERR_SP 4275 CALL L0E81 ; routine GOTO 4276 LD BC,$0006 ; 4277 4278 ; -------------------------- 4279 ; THE 'TEST ROOM' SUBROUTINE 4280 ; -------------------------- 4281 ; 4282 ; 4283 4284 ;; TEST-ROOM 4285 L0EC5: LD HL,($401C) ; sv STKEND_lo 4286 ADD HL,BC ; 4287 JR C,L0ED3 ; to REPORT-4 4288 4289 EX DE,HL ; 4290 LD HL,$0024 ; 4291 ADD HL,DE ; 4292 SBC HL,SP ; 4293 RET C ; 4294 4295 ;; REPORT-4 4296 L0ED3: LD L,$03 ; 4297 JP L0058 ; to ERROR-3 4298 4299 ; ---------------------------- 4300 ; THE 'RETURN' COMMAND ROUTINE 4301 ; ---------------------------- 4302 ; 4303 ; 4304 4305 ;; RETURN 4306 L0ED8: POP HL ; 4307 EX (SP),HL ; 4308 LD A,H ; 4309 CP $3E ; 4310 JR Z,L0EE5 ; to REPORT-7 4311 4312 LD ($4002),SP ; sv ERR_SP_lo 4313 JR L0E86 ; back to GOTO-2 4314 4315 ; --- 4316 4317 ;; REPORT-7 4318 L0EE5: EX (SP),HL ; 4319 PUSH HL ; 4320 4321 RST 08H ; ERROR-1 4322 DEFB $06 ; Error Report: RETURN without GOSUB 4323 4324 ; --------------------------- 4325 ; THE 'INPUT' COMMAND ROUTINE 4326 ; --------------------------- 4327 ; 4328 ; 4329 4330 ;; INPUT 4331 L0EE9: BIT 7,(IY+$08) ; sv PPC_hi 4332 JR NZ,L0F21 ; to REPORT-8 4333 4334 CALL L14A3 ; routine X-TEMP 4335 LD HL,$402D ; sv FLAGX 4336 SET 5,(HL) ; 4337 RES 6,(HL) ; 4338 LD A,($4001) ; sv FLAGS 4339 AND $40 ; 4340 LD BC,$0002 ; 4341 JR NZ,L0F05 ; to PROMPT 4342 4343 LD C,$04 ; 4344 4345 ;; PROMPT 4346 L0F05: OR (HL) ; 4347 LD (HL),A ; 4348 4349 RST 30H ; BC-SPACES 4350 LD (HL),$76 ; 4351 LD A,C ; 4352 RRCA ; 4353 RRCA ; 4354 JR C,L0F14 ; to ENTER-CUR 4355 4356 LD A,$0B ; 4357 LD (DE),A ; 4358 DEC HL ; 4359 LD (HL),A ; 4360 4361 ;; ENTER-CUR 4362 L0F14: DEC HL ; 4363 LD (HL),$7F ; 4364 LD HL,($4039) ; sv S_POSN_x 4365 LD ($4030),HL ; sv T_ADDR_lo 4366 POP HL ; 4367 JP L0472 ; to LOWER 4368 4369 ; --- 4370 4371 ;; REPORT-8 4372 L0F21: RST 08H ; ERROR-1 4373 DEFB $07 ; Error Report: End of file 4374 4375 ; --------------------------- 4376 ; THE 'PAUSE' COMMAND ROUTINE 4377 ; --------------------------- 4378 ; 4379 ; 4380 4381 ;; FAST 4382 L0F23: CALL L02E7 ; routine SET-FAST 4383 RES 6,(IY+$3B) ; sv CDFLAG 4384 RET ; return. 4385 4386 ; -------------------------- 4387 ; THE 'SLOW' COMMAND ROUTINE 4388 ; -------------------------- 4389 ; 4390 ; 4391 4392 ;; SLOW 4393 L0F2B: SET 6,(IY+$3B) ; sv CDFLAG 4394 JP L0207 ; to SLOW/FAST 4395 4396 ; --------------------------- 4397 ; THE 'PAUSE' COMMAND ROUTINE 4398 ; --------------------------- 4399 4400 ;; PAUSE 4401 L0F32: CALL L0EA7 ; routine FIND-INT 4402 CALL L02E7 ; routine SET-FAST 4403 LD H,B ; 4404 LD L,C ; 4405 CALL L022D ; routine DISPLAY-P 4406 4407 LD (IY+$35),$FF ; sv FRAMES_hi 4408 4409 CALL L0207 ; routine SLOW/FAST 4410 JR L0F4B ; routine DEBOUNCE 4411 4412 ; ---------------------- 4413 ; THE 'BREAK' SUBROUTINE 4414 ; ---------------------- 4415 ; 4416 ; 4417 4418 ;; BREAK-1 4419 L0F46: LD A,$7F ; read port $7FFE - keys B,N,M,.,SPACE. 4420 IN A,($FE) ; 4421 RRA ; carry will be set if space not pressed. 4422 4423 ; ------------------------- 4424 ; THE 'DEBOUNCE' SUBROUTINE 4425 ; ------------------------- 4426 ; 4427 ; 4428 4429 ;; DEBOUNCE 4430 L0F4B: RES 0,(IY+$3B) ; update system variable CDFLAG 4431 LD A,$FF ; 4432 LD ($4027),A ; update system variable DEBOUNCE 4433 RET ; return. 4434 4435 4436 ; ------------------------- 4437 ; THE 'SCANNING' SUBROUTINE 4438 ; ------------------------- 4439 ; This recursive routine is where the ZX81 gets its power. Provided there is 4440 ; enough memory it can evaluate an expression of unlimited complexity. 4441 ; Note. there is no unary plus so, as on the ZX80, PRINT +1 gives a syntax error. 4442 ; PRINT +1 works on the Spectrum but so too does PRINT + "STRING". 4443 4444 ;; SCANNING 4445 L0F55: RST 18H ; GET-CHAR 4446 LD B,$00 ; set B register to zero. 4447 PUSH BC ; stack zero as a priority end-marker. 4448 4449 ;; S-LOOP-1 4450 L0F59: CP $40 ; compare to the 'RND' character 4451 JR NZ,L0F8C ; forward, if not, to S-TEST-PI 4452 4453 ; ------------------ 4454 ; THE 'RND' FUNCTION 4455 ; ------------------ 4456 4457 CALL L0DA6 ; routine SYNTAX-Z 4458 JR Z,L0F8A ; forward if checking syntax to S-JPI-END 4459 4460 LD BC,($4032) ; sv SEED_lo 4461 CALL L1520 ; routine STACK-BC 4462 4463 RST 28H ;; FP-CALC 4464 DEFB $A1 ;;stk-one 4465 DEFB $0F ;;addition 4466 DEFB $30 ;;stk-data 4467 DEFB $37 ;;Exponent: $87, Bytes: 1 4468 DEFB $16 ;;(+00,+00,+00) 4469 DEFB $04 ;;multiply 4470 DEFB $30 ;;stk-data 4471 DEFB $80 ;;Bytes: 3 4472 DEFB $41 ;;Exponent $91 4473 DEFB $00,$00,$80 ;;(+00) 4474 DEFB $2E ;;n-mod-m 4475 DEFB $02 ;;delete 4476 DEFB $A1 ;;stk-one 4477 DEFB $03 ;;subtract 4478 DEFB $2D ;;duplicate 4479 DEFB $34 ;;end-calc 4480 4481 CALL L158A ; routine FP-TO-BC 4482 LD ($4032),BC ; update the SEED system variable. 4483 LD A,(HL) ; HL addresses the exponent of the last value. 4484 AND A ; test for zero 4485 JR Z,L0F8A ; forward, if so, to S-JPI-END 4486 4487 SUB $10 ; else reduce exponent by sixteen 4488 LD (HL),A ; thus dividing by 65536 for last value. 4489 4490 ;; S-JPI-END 4491 L0F8A: JR L0F99 ; forward to S-PI-END 4492 4493 ; --- 4494 4495 ;; S-TEST-PI 4496 L0F8C: CP $42 ; the 'PI' character 4497 JR NZ,L0F9D ; forward, if not, to S-TST-INK 4498 4499 ; ------------------- 4500 ; THE 'PI' EVALUATION 4501 ; ------------------- 4502 4503 CALL L0DA6 ; routine SYNTAX-Z 4504 JR Z,L0F99 ; forward if checking syntax to S-PI-END 4505 4506 4507 RST 28H ;; FP-CALC 4508 DEFB $A3 ;;stk-pi/2 4509 DEFB $34 ;;end-calc 4510 4511 INC (HL) ; double the exponent giving PI on the stack. 4512 4513 ;; S-PI-END 4514 L0F99: RST 20H ; NEXT-CHAR advances character pointer. 4515 4516 JP L1083 ; jump forward to S-NUMERIC to set the flag 4517 ; to signal numeric result before advancing. 4518 4519 ; --- 4520 4521 ;; S-TST-INK 4522 L0F9D: CP $41 ; compare to character 'INKEY$' 4523 JR NZ,L0FB2 ; forward, if not, to S-ALPHANUM 4524 4525 ; ----------------------- 4526 ; THE 'INKEY$' EVALUATION 4527 ; ----------------------- 4528 4529 CALL L02BB ; routine KEYBOARD 4530 LD B,H ; 4531 LD C,L ; 4532 LD D,C ; 4533 INC D ; 4534 CALL NZ,L07BD ; routine DECODE 4535 LD A,D ; 4536 ADC A,D ; 4537 LD B,D ; 4538 LD C,A ; 4539 EX DE,HL ; 4540 JR L0FED ; forward to S-STRING 4541 4542 ; --- 4543 4544 ;; S-ALPHANUM 4545 L0FB2: CALL L14D2 ; routine ALPHANUM 4546 JR C,L1025 ; forward, if alphanumeric to S-LTR-DGT 4547 4548 CP $1B ; is character a '.' ? 4549 JP Z,L1047 ; jump forward if so to S-DECIMAL 4550 4551 LD BC,$09D8 ; prepare priority 09, operation 'subtract' 4552 CP $16 ; is character unary minus '-' ? 4553 JR Z,L1020 ; forward, if so, to S-PUSH-PO 4554 4555 CP $10 ; is character a '(' ? 4556 JR NZ,L0FD6 ; forward if not to S-QUOTE 4557 4558 CALL L0049 ; routine CH-ADD+1 advances character pointer. 4559 4560 CALL L0F55 ; recursively call routine SCANNING to 4561 ; evaluate the sub-expression. 4562 4563 CP $11 ; is subsequent character a ')' ? 4564 JR NZ,L0FFF ; forward if not to S-RPT-C 4565 4566 4567 CALL L0049 ; routine CH-ADD+1 advances. 4568 JR L0FF8 ; relative jump to S-JP-CONT3 and then S-CONT3 4569 4570 ; --- 4571 4572 ; consider a quoted string e.g. PRINT "Hooray!" 4573 ; Note. quotes are not allowed within a string. 4574 4575 ;; S-QUOTE 4576 L0FD6: CP $0B ; is character a quote (") ? 4577 JR NZ,L1002 ; forward, if not, to S-FUNCTION 4578 4579 CALL L0049 ; routine CH-ADD+1 advances 4580 PUSH HL ; * save start of string. 4581 JR L0FE3 ; forward to S-QUOTE-S 4582 4583 ; --- 4584 4585 4586 ;; S-Q-AGAIN 4587 L0FE0: CALL L0049 ; routine CH-ADD+1 4588 4589 ;; S-QUOTE-S 4590 L0FE3: CP $0B ; is character a '"' ? 4591 JR NZ,L0FFB ; forward if not to S-Q-NL 4592 4593 POP DE ; * retrieve start of string 4594 AND A ; prepare to subtract. 4595 SBC HL,DE ; subtract start from current position. 4596 LD B,H ; transfer this length 4597 LD C,L ; to the BC register pair. 4598 4599 ;; S-STRING 4600 L0FED: LD HL,$4001 ; address system variable FLAGS 4601 RES 6,(HL) ; signal string result 4602 BIT 7,(HL) ; test if checking syntax. 4603 4604 CALL NZ,L12C3 ; in run-time routine STK-STO-$ stacks the 4605 ; string descriptor - start DE, length BC. 4606 4607 RST 20H ; NEXT-CHAR advances pointer. 4608 4609 ;; S-J-CONT-3 4610 L0FF8: JP L1088 ; jump to S-CONT-3 4611 4612 ; --- 4613 4614 ; A string with no terminating quote has to be considered. 4615 4616 ;; S-Q-NL 4617 L0FFB: CP $76 ; compare to NEWLINE 4618 JR NZ,L0FE0 ; loop back if not to S-Q-AGAIN 4619 4620 ;; S-RPT-C 4621 L0FFF: JP L0D9A ; to REPORT-C 4622 4623 ; --- 4624 4625 ;; S-FUNCTION 4626 L1002: SUB $C4 ; subtract 'CODE' reducing codes 4627 ; CODE thru '<>' to range $00 - $XX 4628 JR C,L0FFF ; back, if less, to S-RPT-C 4629 4630 ; test for NOT the last function in character set. 4631 4632 LD BC,$04EC ; prepare priority $04, operation 'not' 4633 CP $13 ; compare to 'NOT' ( - CODE) 4634 JR Z,L1020 ; forward, if so, to S-PUSH-PO 4635 4636 JR NC,L0FFF ; back with anything higher to S-RPT-C 4637 4638 ; else is a function 'CODE' thru 'CHR$' 4639 4640 LD B,$10 ; priority sixteen binds all functions to 4641 ; arguments removing the need for brackets. 4642 4643 ADD A,$D9 ; add $D9 to give range $D9 thru $EB 4644 ; bit 6 is set to show numeric argument. 4645 ; bit 7 is set to show numeric result. 4646 4647 ; now adjust these default argument/result indicators. 4648 4649 LD C,A ; save code in C 4650 4651 CP $DC ; separate 'CODE', 'VAL', 'LEN' 4652 JR NC,L101A ; skip forward if string operand to S-NO-TO-$ 4653 4654 RES 6,C ; signal string operand. 4655 4656 ;; S-NO-TO-$ 4657 L101A: CP $EA ; isolate top of range 'STR$' and 'CHR$' 4658 JR C,L1020 ; skip forward with others to S-PUSH-PO 4659 4660 RES 7,C ; signal string result. 4661 4662 ;; S-PUSH-PO 4663 L1020: PUSH BC ; push the priority/operation 4664 4665 RST 20H ; NEXT-CHAR 4666 JP L0F59 ; jump back to S-LOOP-1 4667 4668 ; --- 4669 4670 ;; S-LTR-DGT 4671 L1025: CP $26 ; compare to 'A'. 4672 JR C,L1047 ; forward if less to S-DECIMAL 4673 4674 CALL L111C ; routine LOOK-VARS 4675 JP C,L0D4B ; back if not found to REPORT-2 4676 ; a variable is always 'found' when checking 4677 ; syntax. 4678 4679 CALL Z,L11A7 ; routine STK-VAR stacks string parameters or 4680 ; returns cell location if numeric. 4681 4682 LD A,($4001) ; fetch FLAGS 4683 CP $C0 ; compare to numeric result/numeric operand 4684 JR C,L1087 ; forward if not numeric to S-CONT-2 4685 4686 INC HL ; address numeric contents of variable. 4687 LD DE,($401C) ; set destination to STKEND 4688 CALL L19F6 ; routine MOVE-FP stacks the five bytes 4689 EX DE,HL ; transfer new free location from DE to HL. 4690 LD ($401C),HL ; update STKEND system variable. 4691 JR L1087 ; forward to S-CONT-2 4692 4693 ; --- 4694 4695 ; The Scanning Decimal routine is invoked when a decimal point or digit is 4696 ; found in the expression. 4697 ; When checking syntax, then the 'hidden floating point' form is placed 4698 ; after the number in the BASIC line. 4699 ; In run-time, the digits are skipped and the floating point number is picked 4700 ; up. 4701 4702 ;; S-DECIMAL 4703 L1047: CALL L0DA6 ; routine SYNTAX-Z 4704 JR NZ,L106F ; forward in run-time to S-STK-DEC 4705 4706 CALL L14D9 ; routine DEC-TO-FP 4707 4708 RST 18H ; GET-CHAR advances HL past digits 4709 LD BC,$0006 ; six locations are required. 4710 CALL L099E ; routine MAKE-ROOM 4711 INC HL ; point to first new location 4712 LD (HL),$7E ; insert the number marker 126 decimal. 4713 INC HL ; increment 4714 EX DE,HL ; transfer destination to DE. 4715 LD HL,($401C) ; set HL from STKEND which points to the 4716 ; first location after the 'last value' 4717 LD C,$05 ; five bytes to move. 4718 AND A ; clear carry. 4719 SBC HL,BC ; subtract five pointing to 'last value'. 4720 LD ($401C),HL ; update STKEND thereby 'deleting the value. 4721 4722 LDIR ; copy the five value bytes. 4723 4724 EX DE,HL ; basic pointer to HL which may be white-space 4725 ; following the number. 4726 DEC HL ; now points to last of five bytes. 4727 CALL L004C ; routine TEMP-PTR1 advances the character 4728 ; address skipping any white-space. 4729 JR L1083 ; forward to S-NUMERIC 4730 ; to signal a numeric result. 4731 4732 ; --- 4733 4734 ; In run-time the branch is here when a digit or point is encountered. 4735 4736 ;; S-STK-DEC 4737 L106F: RST 20H ; NEXT-CHAR 4738 CP $7E ; compare to 'number marker' 4739 JR NZ,L106F ; loop back until found to S-STK-DEC 4740 ; skipping all the digits. 4741 4742 INC HL ; point to first of five hidden bytes. 4743 LD DE,($401C) ; set destination from STKEND system variable 4744 CALL L19F6 ; routine MOVE-FP stacks the number. 4745 LD ($401C),DE ; update system variable STKEND. 4746 LD ($4016),HL ; update system variable CH_ADD. 4747 4748 ;; S-NUMERIC 4749 L1083: SET 6,(IY+$01) ; update FLAGS - Signal numeric result 4750 4751 ;; S-CONT-2 4752 L1087: RST 18H ; GET-CHAR 4753 4754 ;; S-CONT-3 4755 L1088: CP $10 ; compare to opening bracket '(' 4756 JR NZ,L1098 ; forward if not to S-OPERTR 4757 4758 BIT 6,(IY+$01) ; test FLAGS - Numeric or string result? 4759 JR NZ,L10BC ; forward if numeric to S-LOOP 4760 4761 ; else is a string 4762 4763 CALL L1263 ; routine SLICING 4764 4765 RST 20H ; NEXT-CHAR 4766 JR L1088 ; back to S-CONT-3 4767 4768 ; --- 4769 4770 ; the character is now manipulated to form an equivalent in the table of 4771 ; calculator literals. This is quite cumbersome and in the ZX Spectrum a 4772 ; simple look-up table was introduced at this point. 4773 4774 ;; S-OPERTR 4775 L1098: LD BC,$00C3 ; prepare operator 'subtract' as default. 4776 ; also set B to zero for later indexing. 4777 4778 CP $12 ; is character '>' ? 4779 JR C,L10BC ; forward if less to S-LOOP as 4780 ; we have reached end of meaningful expression 4781 4782 SUB $16 ; is character '-' ? 4783 JR NC,L10A7 ; forward with - * / and '**' '<>' to SUBMLTDIV 4784 4785 ADD A,$0D ; increase others by thirteen 4786 ; $09 '>' thru $0C '+' 4787 JR L10B5 ; forward to GET-PRIO 4788 4789 ; --- 4790 4791 ;; SUBMLTDIV 4792 L10A7: CP $03 ; isolate $00 '-', $01 '*', $02 '/' 4793 JR C,L10B5 ; forward if so to GET-PRIO 4794 4795 ; else possibly originally $D8 '**' thru $DD '<>' already reduced by $16 4796 4797 SUB $C2 ; giving range $00 to $05 4798 JR C,L10BC ; forward if less to S-LOOP 4799 4800 CP $06 ; test the upper limit for nonsense also 4801 JR NC,L10BC ; forward if so to S-LOOP 4802 4803 ADD A,$03 ; increase by 3 to give combined operators of 4804 4805 ; $00 '-' 4806 ; $01 '*' 4807 ; $02 '/' 4808 4809 ; $03 '**' 4810 ; $04 'OR' 4811 ; $05 'AND' 4812 ; $06 '<=' 4813 ; $07 '>=' 4814 ; $08 '<>' 4815 4816 ; $09 '>' 4817 ; $0A '<' 4818 ; $0B '=' 4819 ; $0C '+' 4820 4821 ;; GET-PRIO 4822 L10B5: ADD A,C ; add to default operation 'sub' ($C3) 4823 LD C,A ; and place in operator byte - C. 4824 4825 LD HL,L110F - $C3 ; theoretical base of the priorities table. 4826 ADD HL,BC ; add C ( B is zero) 4827 LD B,(HL) ; pick up the priority in B 4828 4829 ;; S-LOOP 4830 L10BC: POP DE ; restore previous 4831 LD A,D ; load A with priority. 4832 CP B ; is present priority higher 4833 JR C,L10ED ; forward if so to S-TIGHTER 4834 4835 AND A ; are both priorities zero 4836 JP Z,L0018 ; exit if zero via GET-CHAR 4837 4838 PUSH BC ; stack present values 4839 PUSH DE ; stack last values 4840 CALL L0DA6 ; routine SYNTAX-Z 4841 JR Z,L10D5 ; forward is checking syntax to S-SYNTEST 4842 4843 LD A,E ; fetch last operation 4844 AND $3F ; mask off the indicator bits to give true 4845 ; calculator literal. 4846 LD B,A ; place in the B register for BREG 4847 4848 ; perform the single operation 4849 4850 RST 28H ;; FP-CALC 4851 DEFB $37 ;;fp-calc-2 4852 DEFB $34 ;;end-calc 4853 4854 JR L10DE ; forward to S-RUNTEST 4855 4856 ; --- 4857 4858 ;; S-SYNTEST 4859 L10D5: LD A,E ; transfer masked operator to A 4860 XOR (IY+$01) ; XOR with FLAGS like results will reset bit 6 4861 AND $40 ; test bit 6 4862 4863 ;; S-RPORT-C 4864 L10DB: JP NZ,L0D9A ; back to REPORT-C if results do not agree. 4865 4866 ; --- 4867 4868 ; in run-time impose bit 7 of the operator onto bit 6 of the FLAGS 4869 4870 ;; S-RUNTEST 4871 L10DE: POP DE ; restore last operation. 4872 LD HL,$4001 ; address system variable FLAGS 4873 SET 6,(HL) ; presume a numeric result 4874 BIT 7,E ; test expected result in operation 4875 JR NZ,L10EA ; forward if numeric to S-LOOPEND 4876 4877 RES 6,(HL) ; reset to signal string result 4878 4879 ;; S-LOOPEND 4880 L10EA: POP BC ; restore present values 4881 JR L10BC ; back to S-LOOP 4882 4883 ; --- 4884 4885 ;; S-TIGHTER 4886 L10ED: PUSH DE ; push last values and consider these 4887 4888 LD A,C ; get the present operator. 4889 BIT 6,(IY+$01) ; test FLAGS - Numeric or string result? 4890 JR NZ,L110A ; forward if numeric to S-NEXT 4891 4892 AND $3F ; strip indicator bits to give clear literal. 4893 ADD A,$08 ; add eight - augmenting numeric to equivalent 4894 ; string literals. 4895 LD C,A ; place plain literal back in C. 4896 CP $10 ; compare to 'AND' 4897 JR NZ,L1102 ; forward if not to S-NOT-AND 4898 4899 SET 6,C ; set the numeric operand required for 'AND' 4900 JR L110A ; forward to S-NEXT 4901 4902 ; --- 4903 4904 ;; S-NOT-AND 4905 L1102: JR C,L10DB ; back if less than 'AND' to S-RPORT-C 4906 ; Nonsense if '-', '*' etc. 4907 4908 CP $17 ; compare to 'strs-add' literal 4909 JR Z,L110A ; forward if so signaling string result 4910 4911 SET 7,C ; set bit to numeric (Boolean) for others. 4912 4913 ;; S-NEXT 4914 L110A: PUSH BC ; stack 'present' values 4915 4916 RST 20H ; NEXT-CHAR 4917 JP L0F59 ; jump back to S-LOOP-1 4918 4919 4920 4921 ; ------------------------- 4922 ; THE 'TABLE OF PRIORITIES' 4923 ; ------------------------- 4924 ; 4925 ; 4926 4927 ;; tbl-pri 4928 L110F: DEFB $06 ; '-' 4929 DEFB $08 ; '*' 4930 DEFB $08 ; '/' 4931 DEFB $0A ; '**' 4932 DEFB $02 ; 'OR' 4933 DEFB $03 ; 'AND' 4934 DEFB $05 ; '<=' 4935 DEFB $05 ; '>=' 4936 DEFB $05 ; '<>' 4937 DEFB $05 ; '>' 4938 DEFB $05 ; '<' 4939 DEFB $05 ; '=' 4940 DEFB $06 ; '+' 4941 4942 4943 ; -------------------------- 4944 ; THE 'LOOK-VARS' SUBROUTINE 4945 ; -------------------------- 4946 ; 4947 ; 4948 4949 ;; LOOK-VARS 4950 L111C: SET 6,(IY+$01) ; sv FLAGS - Signal numeric result 4951 4952 RST 18H ; GET-CHAR 4953 CALL L14CE ; routine ALPHA 4954 JP NC,L0D9A ; to REPORT-C 4955 4956 PUSH HL ; 4957 LD C,A ; 4958 4959 RST 20H ; NEXT-CHAR 4960 PUSH HL ; 4961 RES 5,C ; 4962 CP $10 ; 4963 JR Z,L1148 ; to V-SYN/RUN 4964 4965 SET 6,C ; 4966 CP $0D ; 4967 JR Z,L1143 ; forward to V-STR-VAR 4968 4969 SET 5,C ; 4970 4971 ;; V-CHAR 4972 L1139: CALL L14D2 ; routine ALPHANUM 4973 JR NC,L1148 ; forward when not to V-RUN/SYN 4974 4975 RES 6,C ; 4976 4977 RST 20H ; NEXT-CHAR 4978 JR L1139 ; loop back to V-CHAR 4979 4980 ; --- 4981 4982 ;; V-STR-VAR 4983 L1143: RST 20H ; NEXT-CHAR 4984 RES 6,(IY+$01) ; sv FLAGS - Signal string result 4985 4986 ;; V-RUN/SYN 4987 L1148: LD B,C ; 4988 CALL L0DA6 ; routine SYNTAX-Z 4989 JR NZ,L1156 ; forward to V-RUN 4990 4991 LD A,C ; 4992 AND $E0 ; 4993 SET 7,A ; 4994 LD C,A ; 4995 JR L118A ; forward to V-SYNTAX 4996 4997 ; --- 4998 4999 ;; V-RUN 5000 L1156: LD HL,($4010) ; sv VARS 5001 5002 ;; V-EACH 5003 L1159: LD A,(HL) ; 5004 AND $7F ; 5005 JR Z,L1188 ; to V-80-BYTE 5006 5007 CP C ; 5008 JR NZ,L1180 ; to V-NEXT 5009 5010 RLA ; 5011 ADD A,A ; 5012 JP P,L1195 ; to V-FOUND-2 5013 5014 JR C,L1195 ; to V-FOUND-2 5015 5016 POP DE ; 5017 PUSH DE ; 5018 PUSH HL ; 5019 5020 ;; V-MATCHES 5021 L116B: INC HL ; 5022 5023 ;; V-SPACES 5024 L116C: LD A,(DE) ; 5025 INC DE ; 5026 AND A ; 5027 JR Z,L116C ; back to V-SPACES 5028 5029 CP (HL) ; 5030 JR Z,L116B ; back to V-MATCHES 5031 5032 OR $80 ; 5033 CP (HL) ; 5034 JR NZ,L117F ; forward to V-GET-PTR 5035 5036 LD A,(DE) ; 5037 CALL L14D2 ; routine ALPHANUM 5038 JR NC,L1194 ; forward to V-FOUND-1 5039 5040 ;; V-GET-PTR 5041 L117F: POP HL ; 5042 5043 ;; V-NEXT 5044 L1180: PUSH BC ; 5045 CALL L09F2 ; routine NEXT-ONE 5046 EX DE,HL ; 5047 POP BC ; 5048 JR L1159 ; back to V-EACH 5049 5050 ; --- 5051 5052 ;; V-80-BYTE 5053 L1188: SET 7,B ; 5054 5055 ;; V-SYNTAX 5056 L118A: POP DE ; 5057 5058 RST 18H ; GET-CHAR 5059 CP $10 ; 5060 JR Z,L1199 ; forward to V-PASS 5061 5062 SET 5,B ; 5063 JR L11A1 ; forward to V-END 5064 5065 ; --- 5066 5067 ;; V-FOUND-1 5068 L1194: POP DE ; 5069 5070 ;; V-FOUND-2 5071 L1195: POP DE ; 5072 POP DE ; 5073 PUSH HL ; 5074 5075 RST 18H ; GET-CHAR 5076 5077 ;; V-PASS 5078 L1199: CALL L14D2 ; routine ALPHANUM 5079 JR NC,L11A1 ; forward if not alphanumeric to V-END 5080 5081 5082 RST 20H ; NEXT-CHAR 5083 JR L1199 ; back to V-PASS 5084 5085 ; --- 5086 5087 ;; V-END 5088 L11A1: POP HL ; 5089 RL B ; 5090 BIT 6,B ; 5091 RET ; 5092 5093 ; ------------------------ 5094 ; THE 'STK-VAR' SUBROUTINE 5095 ; ------------------------ 5096 ; 5097 ; 5098 5099 ;; STK-VAR 5100 L11A7: XOR A ; 5101 LD B,A ; 5102 BIT 7,C ; 5103 JR NZ,L11F8 ; forward to SV-COUNT 5104 5105 BIT 7,(HL) ; 5106 JR NZ,L11BF ; forward to SV-ARRAYS 5107 5108 INC A ; 5109 5110 ;; SV-SIMPLE$ 5111 L11B2: INC HL ; 5112 LD C,(HL) ; 5113 INC HL ; 5114 LD B,(HL) ; 5115 INC HL ; 5116 EX DE,HL ; 5117 CALL L12C3 ; routine STK-STO-$ 5118 5119 RST 18H ; GET-CHAR 5120 JP L125A ; jump forward to SV-SLICE? 5121 5122 ; --- 5123 5124 ;; SV-ARRAYS 5125 L11BF: INC HL ; 5126 INC HL ; 5127 INC HL ; 5128 LD B,(HL) ; 5129 BIT 6,C ; 5130 JR Z,L11D1 ; forward to SV-PTR 5131 5132 DEC B ; 5133 JR Z,L11B2 ; forward to SV-SIMPLE$ 5134 5135 EX DE,HL ; 5136 5137 RST 18H ; GET-CHAR 5138 CP $10 ; 5139 JR NZ,L1231 ; forward to REPORT-3 5140 5141 EX DE,HL ; 5142 5143 ;; SV-PTR 5144 L11D1: EX DE,HL ; 5145 JR L11F8 ; forward to SV-COUNT 5146 5147 ; --- 5148 5149 ;; SV-COMMA 5150 L11D4: PUSH HL ; 5151 5152 RST 18H ; GET-CHAR 5153 POP HL ; 5154 CP $1A ; 5155 JR Z,L11FB ; forward to SV-LOOP 5156 5157 BIT 7,C ; 5158 JR Z,L1231 ; forward to REPORT-3 5159 5160 BIT 6,C ; 5161 JR NZ,L11E9 ; forward to SV-CLOSE 5162 5163 CP $11 ; 5164 JR NZ,L1223 ; forward to SV-RPT-C 5165 5166 5167 RST 20H ; NEXT-CHAR 5168 RET ; 5169 5170 ; --- 5171 5172 ;; SV-CLOSE 5173 L11E9: CP $11 ; 5174 JR Z,L1259 ; forward to SV-DIM 5175 5176 CP $DF ; 5177 JR NZ,L1223 ; forward to SV-RPT-C 5178 5179 5180 ;; SV-CH-ADD 5181 L11F1: RST 18H ; GET-CHAR 5182 DEC HL ; 5183 LD ($4016),HL ; sv CH_ADD 5184 JR L1256 ; forward to SV-SLICE 5185 5186 ; --- 5187 5188 ;; SV-COUNT 5189 L11F8: LD HL,$0000 ; 5190 5191 ;; SV-LOOP 5192 L11FB: PUSH HL ; 5193 5194 RST 20H ; NEXT-CHAR 5195 POP HL ; 5196 LD A,C ; 5197 CP $C0 ; 5198 JR NZ,L120C ; forward to SV-MULT 5199 5200 5201 RST 18H ; GET-CHAR 5202 CP $11 ; 5203 JR Z,L1259 ; forward to SV-DIM 5204 5205 CP $DF ; 5206 JR Z,L11F1 ; back to SV-CH-ADD 5207 5208 ;; SV-MULT 5209 L120C: PUSH BC ; 5210 PUSH HL ; 5211 CALL L12FF ; routine DE,(DE+1) 5212 EX (SP),HL ; 5213 EX DE,HL ; 5214 CALL L12DD ; routine INT-EXP1 5215 JR C,L1231 ; forward to REPORT-3 5216 5217 DEC BC ; 5218 CALL L1305 ; routine GET-HL*DE 5219 ADD HL,BC ; 5220 POP DE ; 5221 POP BC ; 5222 DJNZ L11D4 ; loop back to SV-COMMA 5223 5224 BIT 7,C ; 5225 5226 ;; SV-RPT-C 5227 L1223: JR NZ,L128B ; relative jump to SL-RPT-C 5228 5229 PUSH HL ; 5230 BIT 6,C ; 5231 JR NZ,L123D ; forward to SV-ELEM$ 5232 5233 LD B,D ; 5234 LD C,E ; 5235 5236 RST 18H ; GET-CHAR 5237 CP $11 ; is character a ')' ? 5238 JR Z,L1233 ; skip forward to SV-NUMBER 5239 5240 5241 ;; REPORT-3 5242 L1231: RST 08H ; ERROR-1 5243 DEFB $02 ; Error Report: Subscript wrong 5244 5245 5246 ;; SV-NUMBER 5247 L1233: RST 20H ; NEXT-CHAR 5248 POP HL ; 5249 LD DE,$0005 ; 5250 CALL L1305 ; routine GET-HL*DE 5251 ADD HL,BC ; 5252 RET ; return >> 5253 5254 ; --- 5255 5256 ;; SV-ELEM$ 5257 L123D: CALL L12FF ; routine DE,(DE+1) 5258 EX (SP),HL ; 5259 CALL L1305 ; routine GET-HL*DE 5260 POP BC ; 5261 ADD HL,BC ; 5262 INC HL ; 5263 LD B,D ; 5264 LD C,E ; 5265 EX DE,HL ; 5266 CALL L12C2 ; routine STK-ST-0 5267 5268 RST 18H ; GET-CHAR 5269 CP $11 ; is it ')' ? 5270 JR Z,L1259 ; forward if so to SV-DIM 5271 5272 CP $1A ; is it ',' ? 5273 JR NZ,L1231 ; back if not to REPORT-3 5274 5275 ;; SV-SLICE 5276 L1256: CALL L1263 ; routine SLICING 5277 5278 ;; SV-DIM 5279 L1259: RST 20H ; NEXT-CHAR 5280 5281 ;; SV-SLICE? 5282 L125A: CP $10 ; 5283 JR Z,L1256 ; back to SV-SLICE 5284 5285 RES 6,(IY+$01) ; sv FLAGS - Signal string result 5286 RET ; return. 5287 5288 ; ------------------------ 5289 ; THE 'SLICING' SUBROUTINE 5290 ; ------------------------ 5291 ; 5292 ; 5293 5294 ;; SLICING 5295 L1263: CALL L0DA6 ; routine SYNTAX-Z 5296 CALL NZ,L13F8 ; routine STK-FETCH 5297 5298 RST 20H ; NEXT-CHAR 5299 CP $11 ; is it ')' ? 5300 JR Z,L12BE ; forward if so to SL-STORE 5301 5302 PUSH DE ; 5303 XOR A ; 5304 PUSH AF ; 5305 PUSH BC ; 5306 LD DE,$0001 ; 5307 5308 RST 18H ; GET-CHAR 5309 POP HL ; 5310 CP $DF ; is it 'TO' ? 5311 JR Z,L1292 ; forward if so to SL-SECOND 5312 5313 POP AF ; 5314 CALL L12DE ; routine INT-EXP2 5315 PUSH AF ; 5316 LD D,B ; 5317 LD E,C ; 5318 PUSH HL ; 5319 5320 RST 18H ; GET-CHAR 5321 POP HL ; 5322 CP $DF ; is it 'TO' ? 5323 JR Z,L1292 ; forward if so to SL-SECOND 5324 5325 CP $11 ; 5326 5327 ;; SL-RPT-C 5328 L128B: JP NZ,L0D9A ; to REPORT-C 5329 5330 LD H,D ; 5331 LD L,E ; 5332 JR L12A5 ; forward to SL-DEFINE 5333 5334 ; --- 5335 5336 ;; SL-SECOND 5337 L1292: PUSH HL ; 5338 5339 RST 20H ; NEXT-CHAR 5340 POP HL ; 5341 CP $11 ; is it ')' ? 5342 JR Z,L12A5 ; forward if so to SL-DEFINE 5343 5344 POP AF ; 5345 CALL L12DE ; routine INT-EXP2 5346 PUSH AF ; 5347 5348 RST 18H ; GET-CHAR 5349 LD H,B ; 5350 LD L,C ; 5351 CP $11 ; is it ')' ? 5352 JR NZ,L128B ; back if not to SL-RPT-C 5353 5354 ;; SL-DEFINE 5355 L12A5: POP AF ; 5356 EX (SP),HL ; 5357 ADD HL,DE ; 5358 DEC HL ; 5359 EX (SP),HL ; 5360 AND A ; 5361 SBC HL,DE ; 5362 LD BC,$0000 ; 5363 JR C,L12B9 ; forward to SL-OVER 5364 5365 INC HL ; 5366 AND A ; 5367 JP M,L1231 ; jump back to REPORT-3 5368 5369 LD B,H ; 5370 LD C,L ; 5371 5372 ;; SL-OVER 5373 L12B9: POP DE ; 5374 RES 6,(IY+$01) ; sv FLAGS - Signal string result 5375 5376 ;; SL-STORE 5377 L12BE: CALL L0DA6 ; routine SYNTAX-Z 5378 RET Z ; return if checking syntax. 5379 5380 ; -------------------------- 5381 ; THE 'STK-STORE' SUBROUTINE 5382 ; -------------------------- 5383 ; 5384 ; 5385 5386 ;; STK-ST-0 5387 L12C2: XOR A ; 5388 5389 ;; STK-STO-$ 5390 L12C3: PUSH BC ; 5391 CALL L19EB ; routine TEST-5-SP 5392 POP BC ; 5393 LD HL,($401C) ; sv STKEND 5394 LD (HL),A ; 5395 INC HL ; 5396 LD (HL),E ; 5397 INC HL ; 5398 LD (HL),D ; 5399 INC HL ; 5400 LD (HL),C ; 5401 INC HL ; 5402 LD (HL),B ; 5403 INC HL ; 5404 LD ($401C),HL ; sv STKEND 5405 RES 6,(IY+$01) ; update FLAGS - signal string result 5406 RET ; return. 5407 5408 ; ------------------------- 5409 ; THE 'INT EXP' SUBROUTINES 5410 ; ------------------------- 5411 ; 5412 ; 5413 5414 ;; INT-EXP1 5415 L12DD: XOR A ; 5416 5417 ;; INT-EXP2 5418 L12DE: PUSH DE ; 5419 PUSH HL ; 5420 PUSH AF ; 5421 CALL L0D92 ; routine CLASS-6 5422 POP AF ; 5423 CALL L0DA6 ; routine SYNTAX-Z 5424 JR Z,L12FC ; forward if checking syntax to I-RESTORE 5425 5426 PUSH AF ; 5427 CALL L0EA7 ; routine FIND-INT 5428 POP DE ; 5429 LD A,B ; 5430 OR C ; 5431 SCF ; Set Carry Flag 5432 JR Z,L12F9 ; forward to I-CARRY 5433 5434 POP HL ; 5435 PUSH HL ; 5436 AND A ; 5437 SBC HL,BC ; 5438 5439 ;; I-CARRY 5440 L12F9: LD A,D ; 5441 SBC A,$00 ; 5442 5443 ;; I-RESTORE 5444 L12FC: POP HL ; 5445 POP DE ; 5446 RET ; 5447 5448 ; -------------------------- 5449 ; THE 'DE,(DE+1)' SUBROUTINE 5450 ; -------------------------- 5451 ; INDEX and LOAD Z80 subroutine. 5452 ; This emulates the 6800 processor instruction LDX 1,X which loads a two-byte 5453 ; value from memory into the register indexing it. Often these are hardly worth 5454 ; the bother of writing as subroutines and this one doesn't save any time or 5455 ; memory. The timing and space overheads have to be offset against the ease of 5456 ; writing and the greater program readability from using such toolkit routines. 5457 5458 ;; DE,(DE+1) 5459 L12FF: EX DE,HL ; move index address into HL. 5460 INC HL ; increment to address word. 5461 LD E,(HL) ; pick up word low-order byte. 5462 INC HL ; index high-order byte and 5463 LD D,(HL) ; pick it up. 5464 RET ; return with DE = word. 5465 5466 ; -------------------------- 5467 ; THE 'GET-HL*DE' SUBROUTINE 5468 ; -------------------------- 5469 ; 5470 5471 ;; GET-HL*DE 5472 L1305: CALL L0DA6 ; routine SYNTAX-Z 5473 RET Z ; 5474 5475 PUSH BC ; 5476 LD B,$10 ; 5477 LD A,H ; 5478 LD C,L ; 5479 LD HL,$0000 ; 5480 5481 ;; HL-LOOP 5482 L1311: ADD HL,HL ; 5483 JR C,L131A ; forward with carry to HL-END 5484 5485 RL C ; 5486 RLA ; 5487 JR NC,L131D ; forward with no carry to HL-AGAIN 5488 5489 ADD HL,DE ; 5490 5491 ;; HL-END 5492 L131A: JP C,L0ED3 ; to REPORT-4 5493 5494 ;; HL-AGAIN 5495 L131D: DJNZ L1311 ; loop back to HL-LOOP 5496 5497 POP BC ; 5498 RET ; return. 5499 5500 ; -------------------- 5501 ; THE 'LET' SUBROUTINE 5502 ; -------------------- 5503 ; 5504 ; 5505 5506 ;; LET 5507 L1321: LD HL,($4012) ; sv DEST-lo 5508 BIT 1,(IY+$2D) ; sv FLAGX 5509 JR Z,L136E ; forward to L-EXISTS 5510 5511 LD BC,$0005 ; 5512 5513 ;; L-EACH-CH 5514 L132D: INC BC ; 5515 5516 ; check 5517 5518 ;; L-NO-SP 5519 L132E: INC HL ; 5520 LD A,(HL) ; 5521 AND A ; 5522 JR Z,L132E ; back to L-NO-SP 5523 5524 CALL L14D2 ; routine ALPHANUM 5525 JR C,L132D ; back to L-EACH-CH 5526 5527 CP $0D ; is it '$' ? 5528 JP Z,L13C8 ; forward if so to L-NEW$ 5529 5530 5531 RST 30H ; BC-SPACES 5532 PUSH DE ; 5533 LD HL,($4012) ; sv DEST 5534 DEC DE ; 5535 LD A,C ; 5536 SUB $06 ; 5537 LD B,A ; 5538 LD A,$40 ; 5539 JR Z,L1359 ; forward to L-SINGLE 5540 5541 ;; L-CHAR 5542 L134B: INC HL ; 5543 LD A,(HL) ; 5544 AND A ; is it a space ? 5545 JR Z,L134B ; back to L-CHAR 5546 5547 INC DE ; 5548 LD (DE),A ; 5549 DJNZ L134B ; loop back to L-CHAR 5550 5551 OR $80 ; 5552 LD (DE),A ; 5553 LD A,$80 ; 5554 5555 ;; L-SINGLE 5556 L1359: LD HL,($4012) ; sv DEST-lo 5557 XOR (HL) ; 5558 POP HL ; 5559 CALL L13E7 ; routine L-FIRST 5560 5561 ;; L-NUMERIC 5562 L1361: PUSH HL ; 5563 5564 RST 28H ;; FP-CALC 5565 DEFB $02 ;;delete 5566 DEFB $34 ;;end-calc 5567 5568 POP HL ; 5569 LD BC,$0005 ; 5570 AND A ; 5571 SBC HL,BC ; 5572 JR L13AE ; forward to L-ENTER 5573 5574 ; --- 5575 5576 ;; L-EXISTS 5577 L136E: BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? 5578 JR Z,L137A ; forward to L-DELETE$ 5579 5580 LD DE,$0006 ; 5581 ADD HL,DE ; 5582 JR L1361 ; back to L-NUMERIC 5583 5584 ; --- 5585 5586 ;; L-DELETE$ 5587 L137A: LD HL,($4012) ; sv DEST-lo 5588 LD BC,($402E) ; sv STRLEN_lo 5589 BIT 0,(IY+$2D) ; sv FLAGX 5590 JR NZ,L13B7 ; forward to L-ADD$ 5591 5592 LD A,B ; 5593 OR C ; 5594 RET Z ; 5595 5596 PUSH HL ; 5597 5598 RST 30H ; BC-SPACES 5599 PUSH DE ; 5600 PUSH BC ; 5601 LD D,H ; 5602 LD E,L ; 5603 INC HL ; 5604 LD (HL),$00 ; 5605 LDDR ; Copy Bytes 5606 PUSH HL ; 5607 CALL L13F8 ; routine STK-FETCH 5608 POP HL ; 5609 EX (SP),HL ; 5610 AND A ; 5611 SBC HL,BC ; 5612 ADD HL,BC ; 5613 JR NC,L13A3 ; forward to L-LENGTH 5614 5615 LD B,H ; 5616 LD C,L ; 5617 5618 ;; L-LENGTH 5619 L13A3: EX (SP),HL ; 5620 EX DE,HL ; 5621 LD A,B ; 5622 OR C ; 5623 JR Z,L13AB ; forward if zero to L-IN-W/S 5624 5625 LDIR ; Copy Bytes 5626 5627 ;; L-IN-W/S 5628 L13AB: POP BC ; 5629 POP DE ; 5630 POP HL ; 5631 5632 ; ------------------------ 5633 ; THE 'L-ENTER' SUBROUTINE 5634 ; ------------------------ 5635 ; 5636 5637 ;; L-ENTER 5638 L13AE: EX DE,HL ; 5639 LD A,B ; 5640 OR C ; 5641 RET Z ; 5642 5643 PUSH DE ; 5644 LDIR ; Copy Bytes 5645 POP HL ; 5646 RET ; return. 5647 5648 ; --- 5649 5650 ;; L-ADD$ 5651 L13B7: DEC HL ; 5652 DEC HL ; 5653 DEC HL ; 5654 LD A,(HL) ; 5655 PUSH HL ; 5656 PUSH BC ; 5657 5658 CALL L13CE ; routine L-STRING 5659 5660 POP BC ; 5661 POP HL ; 5662 INC BC ; 5663 INC BC ; 5664 INC BC ; 5665 JP L0A60 ; jump back to exit via RECLAIM-2 5666 5667 ; --- 5668 5669 ;; L-NEW$ 5670 L13C8: LD A,$60 ; prepare mask %01100000 5671 LD HL,($4012) ; sv DEST-lo 5672 XOR (HL) ; 5673 5674 ; ------------------------- 5675 ; THE 'L-STRING' SUBROUTINE 5676 ; ------------------------- 5677 ; 5678 5679 ;; L-STRING 5680 L13CE: PUSH AF ; 5681 CALL L13F8 ; routine STK-FETCH 5682 EX DE,HL ; 5683 ADD HL,BC ; 5684 PUSH HL ; 5685 INC BC ; 5686 INC BC ; 5687 INC BC ; 5688 5689 RST 30H ; BC-SPACES 5690 EX DE,HL ; 5691 POP HL ; 5692 DEC BC ; 5693 DEC BC ; 5694 PUSH BC ; 5695 LDDR ; Copy Bytes 5696 EX DE,HL ; 5697 POP BC ; 5698 DEC BC ; 5699 LD (HL),B ; 5700 DEC HL ; 5701 LD (HL),C ; 5702 POP AF ; 5703 5704 ;; L-FIRST 5705 L13E7: PUSH AF ; 5706 CALL L14C7 ; routine REC-V80 5707 POP AF ; 5708 DEC HL ; 5709 LD (HL),A ; 5710 LD HL,($401A) ; sv STKBOT_lo 5711 LD ($4014),HL ; sv E_LINE_lo 5712 DEC HL ; 5713 LD (HL),$80 ; 5714 RET ; 5715 5716 ; -------------------------- 5717 ; THE 'STK-FETCH' SUBROUTINE 5718 ; -------------------------- 5719 ; This routine fetches a five-byte value from the calculator stack 5720 ; reducing the pointer to the end of the stack by five. 5721 ; For a floating-point number the exponent is in A and the mantissa 5722 ; is the thirty-two bits EDCB. 5723 ; For strings, the start of the string is in DE and the length in BC. 5724 ; A is unused. 5725 5726 ;; STK-FETCH 5727 L13F8: LD HL,($401C) ; load HL from system variable STKEND 5728 5729 DEC HL ; 5730 LD B,(HL) ; 5731 DEC HL ; 5732 LD C,(HL) ; 5733 DEC HL ; 5734 LD D,(HL) ; 5735 DEC HL ; 5736 LD E,(HL) ; 5737 DEC HL ; 5738 LD A,(HL) ; 5739 5740 LD ($401C),HL ; set system variable STKEND to lower value. 5741 RET ; return. 5742 5743 ; ------------------------- 5744 ; THE 'DIM' COMMAND ROUTINE 5745 ; ------------------------- 5746 ; An array is created and initialized to zeros which is also the space 5747 ; character on the ZX81. 5748 5749 ;; DIM 5750 L1409: CALL L111C ; routine LOOK-VARS 5751 5752 ;; D-RPORT-C 5753 L140C: JP NZ,L0D9A ; to REPORT-C 5754 5755 CALL L0DA6 ; routine SYNTAX-Z 5756 JR NZ,L141C ; forward to D-RUN 5757 5758 RES 6,C ; 5759 CALL L11A7 ; routine STK-VAR 5760 CALL L0D1D ; routine CHECK-END 5761 5762 ;; D-RUN 5763 L141C: JR C,L1426 ; forward to D-LETTER 5764 5765 PUSH BC ; 5766 CALL L09F2 ; routine NEXT-ONE 5767 CALL L0A60 ; routine RECLAIM-2 5768 POP BC ; 5769 5770 ;; D-LETTER 5771 L1426: SET 7,C ; 5772 LD B,$00 ; 5773 PUSH BC ; 5774 LD HL,$0001 ; 5775 BIT 6,C ; 5776 JR NZ,L1434 ; forward to D-SIZE 5777 5778 LD L,$05 ; 5779 5780 ;; D-SIZE 5781 L1434: EX DE,HL ; 5782 5783 ;; D-NO-LOOP 5784 L1435: RST 20H ; NEXT-CHAR 5785 LD H,$40 ; 5786 CALL L12DD ; routine INT-EXP1 5787 JP C,L1231 ; jump back to REPORT-3 5788 5789 POP HL ; 5790 PUSH BC ; 5791 INC H ; 5792 PUSH HL ; 5793 LD H,B ; 5794 LD L,C ; 5795 CALL L1305 ; routine GET-HL*DE 5796 EX DE,HL ; 5797 5798 RST 18H ; GET-CHAR 5799 CP $1A ; 5800 JR Z,L1435 ; back to D-NO-LOOP 5801 5802 CP $11 ; is it ')' ? 5803 JR NZ,L140C ; back if not to D-RPORT-C 5804 5805 5806 RST 20H ; NEXT-CHAR 5807 POP BC ; 5808 LD A,C ; 5809 LD L,B ; 5810 LD H,$00 ; 5811 INC HL ; 5812 INC HL ; 5813 ADD HL,HL ; 5814 ADD HL,DE ; 5815 JP C,L0ED3 ; jump to REPORT-4 5816 5817 PUSH DE ; 5818 PUSH BC ; 5819 PUSH HL ; 5820 LD B,H ; 5821 LD C,L ; 5822 LD HL,($4014) ; sv E_LINE_lo 5823 DEC HL ; 5824 CALL L099E ; routine MAKE-ROOM 5825 INC HL ; 5826 LD (HL),A ; 5827 POP BC ; 5828 DEC BC ; 5829 DEC BC ; 5830 DEC BC ; 5831 INC HL ; 5832 LD (HL),C ; 5833 INC HL ; 5834 LD (HL),B ; 5835 POP AF ; 5836 INC HL ; 5837 LD (HL),A ; 5838 LD H,D ; 5839 LD L,E ; 5840 DEC DE ; 5841 LD (HL),$00 ; 5842 POP BC ; 5843 LDDR ; Copy Bytes 5844 5845 ;; DIM-SIZES 5846 L147F: POP BC ; 5847 LD (HL),B ; 5848 DEC HL ; 5849 LD (HL),C ; 5850 DEC HL ; 5851 DEC A ; 5852 JR NZ,L147F ; back to DIM-SIZES 5853 5854 RET ; return. 5855 5856 ; --------------------- 5857 ; THE 'RESERVE' ROUTINE 5858 ; --------------------- 5859 ; 5860 ; 5861 5862 ;; RESERVE 5863 L1488: LD HL,($401A) ; address STKBOT 5864 DEC HL ; now last byte of workspace 5865 CALL L099E ; routine MAKE-ROOM 5866 INC HL ; 5867 INC HL ; 5868 POP BC ; 5869 LD ($4014),BC ; sv E_LINE_lo 5870 POP BC ; 5871 EX DE,HL ; 5872 INC HL ; 5873 RET ; 5874 5875 ; --------------------------- 5876 ; THE 'CLEAR' COMMAND ROUTINE 5877 ; --------------------------- 5878 ; 5879 ; 5880 5881 ;; CLEAR 5882 L149A: LD HL,($4010) ; sv VARS_lo 5883 LD (HL),$80 ; 5884 INC HL ; 5885 LD ($4014),HL ; sv E_LINE_lo 5886 5887 ; ----------------------- 5888 ; THE 'X-TEMP' SUBROUTINE 5889 ; ----------------------- 5890 ; 5891 ; 5892 5893 ;; X-TEMP 5894 L14A3: LD HL,($4014) ; sv E_LINE_lo 5895 5896 ; ---------------------- 5897 ; THE 'SET-STK' ROUTINES 5898 ; ---------------------- 5899 ; 5900 ; 5901 5902 ;; SET-STK-B 5903 L14A6: LD ($401A),HL ; sv STKBOT 5904 5905 ; 5906 5907 ;; SET-STK-E 5908 L14A9: LD ($401C),HL ; sv STKEND 5909 RET ; 5910 5911 ; ----------------------- 5912 ; THE 'CURSOR-IN' ROUTINE 5913 ; ----------------------- 5914 ; This routine is called to set the edit line to the minimum cursor/newline 5915 ; and to set STKEND, the start of free space, at the next position. 5916 5917 ;; CURSOR-IN 5918 L14AD: LD HL,($4014) ; fetch start of edit line from E_LINE 5919 LD (HL),$7F ; insert cursor character 5920 5921 INC HL ; point to next location. 5922 LD (HL),$76 ; insert NEWLINE character 5923 INC HL ; point to next free location. 5924 5925 LD (IY+$22),$02 ; set lower screen display file size DF_SZ 5926 5927 JR L14A6 ; exit via SET-STK-B above 5928 5929 ; ------------------------ 5930 ; THE 'SET-MIN' SUBROUTINE 5931 ; ------------------------ 5932 ; 5933 ; 5934 5935 ;; SET-MIN 5936 L14BC: LD HL,$405D ; normal location of calculator's memory area 5937 LD ($401F),HL ; update system variable MEM 5938 LD HL,($401A) ; fetch STKBOT 5939 JR L14A9 ; back to SET-STK-E 5940 5941 5942 ; ------------------------------------ 5943 ; THE 'RECLAIM THE END-MARKER' ROUTINE 5944 ; ------------------------------------ 5945 5946 ;; REC-V80 5947 L14C7: LD DE,($4014) ; sv E_LINE_lo 5948 JP L0A5D ; to RECLAIM-1 5949 5950 ; ---------------------- 5951 ; THE 'ALPHA' SUBROUTINE 5952 ; ---------------------- 5953 5954 ;; ALPHA 5955 L14CE: CP $26 ; 5956 JR L14D4 ; skip forward to ALPHA-2 5957 5958 5959 ; ------------------------- 5960 ; THE 'ALPHANUM' SUBROUTINE 5961 ; ------------------------- 5962 5963 ;; ALPHANUM 5964 L14D2: CP $1C ; 5965 5966 5967 ;; ALPHA-2 5968 L14D4: CCF ; Complement Carry Flag 5969 RET NC ; 5970 5971 CP $40 ; 5972 RET ; 5973 5974 5975 ; ------------------------------------------ 5976 ; THE 'DECIMAL TO FLOATING POINT' SUBROUTINE 5977 ; ------------------------------------------ 5978 ; 5979 5980 ;; DEC-TO-FP 5981 L14D9: CALL L1548 ; routine INT-TO-FP gets first part 5982 CP $1B ; is character a '.' ? 5983 JR NZ,L14F5 ; forward if not to E-FORMAT 5984 5985 5986 RST 28H ;; FP-CALC 5987 DEFB $A1 ;;stk-one 5988 DEFB $C0 ;;st-mem-0 5989 DEFB $02 ;;delete 5990 DEFB $34 ;;end-calc 5991 5992 5993 ;; NXT-DGT-1 5994 L14E5: RST 20H ; NEXT-CHAR 5995 CALL L1514 ; routine STK-DIGIT 5996 JR C,L14F5 ; forward to E-FORMAT 5997 5998 5999 RST 28H ;; FP-CALC 6000 DEFB $E0 ;;get-mem-0 6001 DEFB $A4 ;;stk-ten 6002 DEFB $05 ;;division 6003 DEFB $C0 ;;st-mem-0 6004 DEFB $04 ;;multiply 6005 DEFB $0F ;;addition 6006 DEFB $34 ;;end-calc 6007 6008 JR L14E5 ; loop back till exhausted to NXT-DGT-1 6009 6010 ; --- 6011 6012 ;; E-FORMAT 6013 L14F5: CP $2A ; is character 'E' ? 6014 RET NZ ; return if not 6015 6016 LD (IY+$5D),$FF ; initialize sv MEM-0-1st to $FF TRUE 6017 6018 RST 20H ; NEXT-CHAR 6019 CP $15 ; is character a '+' ? 6020 JR Z,L1508 ; forward if so to SIGN-DONE 6021 6022 CP $16 ; is it a '-' ? 6023 JR NZ,L1509 ; forward if not to ST-E-PART 6024 6025 INC (IY+$5D) ; sv MEM-0-1st change to FALSE 6026 6027 ;; SIGN-DONE 6028 L1508: RST 20H ; NEXT-CHAR 6029 6030 ;; ST-E-PART 6031 L1509: CALL L1548 ; routine INT-TO-FP 6032 6033 RST 28H ;; FP-CALC m, e. 6034 DEFB $E0 ;;get-mem-0 m, e, (1/0) TRUE/FALSE 6035 DEFB $00 ;;jump-true 6036 DEFB $02 ;;to L1511, E-POSTVE 6037 DEFB $18 ;;neg m, -e 6038 6039 ;; E-POSTVE 6040 L1511: DEFB $38 ;;e-to-fp x. 6041 DEFB $34 ;;end-calc x. 6042 6043 RET ; return. 6044 6045 6046 ; -------------------------- 6047 ; THE 'STK-DIGIT' SUBROUTINE 6048 ; -------------------------- 6049 ; 6050 6051 ;; STK-DIGIT 6052 L1514: CP $1C ; 6053 RET C ; 6054 6055 CP $26 ; 6056 CCF ; Complement Carry Flag 6057 RET C ; 6058 6059 SUB $1C ; 6060 6061 ; ------------------------ 6062 ; THE 'STACK-A' SUBROUTINE 6063 ; ------------------------ 6064 ; 6065 6066 6067 ;; STACK-A 6068 L151D: LD C,A ; 6069 LD B,$00 ; 6070 6071 ; ------------------------- 6072 ; THE 'STACK-BC' SUBROUTINE 6073 ; ------------------------- 6074 ; The ZX81 does not have an integer number format so the BC register contents 6075 ; must be converted to their full floating-point form. 6076 6077 ;; STACK-BC 6078 L1520: LD IY,$4000 ; re-initialize the system variables pointer. 6079 PUSH BC ; save the integer value. 6080 6081 ; now stack zero, five zero bytes as a starting point. 6082 6083 RST 28H ;; FP-CALC 6084 DEFB $A0 ;;stk-zero 0. 6085 DEFB $34 ;;end-calc 6086 6087 POP BC ; restore integer value. 6088 6089 LD (HL),$91 ; place $91 in exponent 65536. 6090 ; this is the maximum possible value 6091 6092 LD A,B ; fetch hi-byte. 6093 AND A ; test for zero. 6094 JR NZ,L1536 ; forward if not zero to STK-BC-2 6095 6096 LD (HL),A ; else make exponent zero again 6097 OR C ; test lo-byte 6098 RET Z ; return if BC was zero - done. 6099 6100 ; else there has to be a set bit if only the value one. 6101 6102 LD B,C ; save C in B. 6103 LD C,(HL) ; fetch zero to C 6104 LD (HL),$89 ; make exponent $89 256. 6105 6106 ;; STK-BC-2 6107 L1536: DEC (HL) ; decrement exponent - halving number 6108 SLA C ; C<-76543210<-0 6109 RL B ; C<-76543210<-C 6110 JR NC,L1536 ; loop back if no carry to STK-BC-2 6111 6112 SRL B ; 0->76543210->C 6113 RR C ; C->76543210->C 6114 6115 INC HL ; address first byte of mantissa 6116 LD (HL),B ; insert B 6117 INC HL ; address second byte of mantissa 6118 LD (HL),C ; insert C 6119 6120 DEC HL ; point to the 6121 DEC HL ; exponent again 6122 RET ; return. 6123 6124 ; ------------------------------------------ 6125 ; THE 'INTEGER TO FLOATING POINT' SUBROUTINE 6126 ; ------------------------------------------ 6127 ; 6128 ; 6129 6130 ;; INT-TO-FP 6131 L1548: PUSH AF ; 6132 6133 RST 28H ;; FP-CALC 6134 DEFB $A0 ;;stk-zero 6135 DEFB $34 ;;end-calc 6136 6137 POP AF ; 6138 6139 ;; NXT-DGT-2 6140 L154D: CALL L1514 ; routine STK-DIGIT 6141 RET C ; 6142 6143 6144 RST 28H ;; FP-CALC 6145 DEFB $01 ;;exchange 6146 DEFB $A4 ;;stk-ten 6147 DEFB $04 ;;multiply 6148 DEFB $0F ;;addition 6149 DEFB $34 ;;end-calc 6150 6151 6152 RST 20H ; NEXT-CHAR 6153 JR L154D ; to NXT-DGT-2 6154 6155 6156 ; ------------------------------------------- 6157 ; THE 'E-FORMAT TO FLOATING POINT' SUBROUTINE 6158 ; ------------------------------------------- 6159 ; (Offset $38: 'e-to-fp') 6160 ; invoked from DEC-TO-FP and PRINT-FP. 6161 ; e.g. 2.3E4 is 23000. 6162 ; This subroutine evaluates xEm where m is a positive or negative integer. 6163 ; At a simple level x is multiplied by ten for every unit of m. 6164 ; If the decimal exponent m is negative then x is divided by ten for each unit. 6165 ; A short-cut is taken if the exponent is greater than seven and in this 6166 ; case the exponent is reduced by seven and the value is multiplied or divided 6167 ; by ten million. 6168 ; Note. for the ZX Spectrum an even cleverer method was adopted which involved 6169 ; shifting the bits out of the exponent so the result was achieved with six 6170 ; shifts at most. The routine below had to be completely re-written mostly 6171 ; in Z80 machine code. 6172 ; Although no longer operable, the calculator literal was retained for old 6173 ; times sake, the routine being invoked directly from a machine code CALL. 6174 ; 6175 ; On entry in the ZX81, m, the exponent, is the 'last value', and the 6176 ; floating-point decimal mantissa is beneath it. 6177 6178 6179 ;; e-to-fp 6180 L155A: RST 28H ;; FP-CALC x, m. 6181 DEFB $2D ;;duplicate x, m, m. 6182 DEFB $32 ;;less-0 x, m, (1/0). 6183 DEFB $C0 ;;st-mem-0 x, m, (1/0). 6184 DEFB $02 ;;delete x, m. 6185 DEFB $27 ;;abs x, +m. 6186 6187 ;; E-LOOP 6188 L1560: DEFB $A1 ;;stk-one x, m,1. 6189 DEFB $03 ;;subtract x, m-1. 6190 DEFB $2D ;;duplicate x, m-1,m-1. 6191 DEFB $32 ;;less-0 x, m-1, (1/0). 6192 DEFB $00 ;;jump-true x, m-1. 6193 DEFB $22 ;;to L1587, E-END x, m-1. 6194 6195 DEFB $2D ;;duplicate x, m-1, m-1. 6196 DEFB $30 ;;stk-data 6197 DEFB $33 ;;Exponent: $83, Bytes: 1 6198 6199 DEFB $40 ;;(+00,+00,+00) x, m-1, m-1, 6. 6200 DEFB $03 ;;subtract x, m-1, m-7. 6201 DEFB $2D ;;duplicate x, m-1, m-7, m-7. 6202 DEFB $32 ;;less-0 x, m-1, m-7, (1/0). 6203 DEFB $00 ;;jump-true x, m-1, m-7. 6204 DEFB $0C ;;to L157A, E-LOW 6205 6206 ; but if exponent m is higher than 7 do a bigger chunk. 6207 ; multiplying (or dividing if negative) by 10 million - 1e7. 6208 6209 DEFB $01 ;;exchange x, m-7, m-1. 6210 DEFB $02 ;;delete x, m-7. 6211 DEFB $01 ;;exchange m-7, x. 6212 DEFB $30 ;;stk-data 6213 DEFB $80 ;;Bytes: 3 6214 DEFB $48 ;;Exponent $98 6215 DEFB $18,$96,$80 ;;(+00) m-7, x, 10,000,000 (=f) 6216 DEFB $2F ;;jump 6217 DEFB $04 ;;to L157D, E-CHUNK 6218 6219 ; --- 6220 6221 ;; E-LOW 6222 L157A: DEFB $02 ;;delete x, m-1. 6223 DEFB $01 ;;exchange m-1, x. 6224 DEFB $A4 ;;stk-ten m-1, x, 10 (=f). 6225 6226 ;; E-CHUNK 6227 L157D: DEFB $E0 ;;get-mem-0 m-1, x, f, (1/0) 6228 DEFB $00 ;;jump-true m-1, x, f 6229 DEFB $04 ;;to L1583, E-DIVSN 6230 6231 DEFB $04 ;;multiply m-1, x*f. 6232 DEFB $2F ;;jump 6233 DEFB $02 ;;to L1584, E-SWAP 6234 6235 ; --- 6236 6237 ;; E-DIVSN 6238 L1583: DEFB $05 ;;division m-1, x/f (= new x). 6239 6240 ;; E-SWAP 6241 L1584: DEFB $01 ;;exchange x, m-1 (= new m). 6242 DEFB $2F ;;jump x, m. 6243 DEFB $DA ;;to L1560, E-LOOP 6244 6245 ; --- 6246 6247 ;; E-END 6248 L1587: DEFB $02 ;;delete x. (-1) 6249 DEFB $34 ;;end-calc x. 6250 6251 RET ; return. 6252 6253 ; ------------------------------------- 6254 ; THE 'FLOATING-POINT TO BC' SUBROUTINE 6255 ; ------------------------------------- 6256 ; The floating-point form on the calculator stack is compressed directly into 6257 ; the BC register rounding up if necessary. 6258 ; Valid range is 0 to 65535.4999 6259 6260 ;; FP-TO-BC 6261 L158A: CALL L13F8 ; routine STK-FETCH - exponent to A 6262 ; mantissa to EDCB. 6263 AND A ; test for value zero. 6264 JR NZ,L1595 ; forward if not to FPBC-NZRO 6265 6266 ; else value is zero 6267 6268 LD B,A ; zero to B 6269 LD C,A ; also to C 6270 PUSH AF ; save the flags on machine stack 6271 JR L15C6 ; forward to FPBC-END 6272 6273 ; --- 6274 6275 ; EDCB => BCE 6276 6277 ;; FPBC-NZRO 6278 L1595: LD B,E ; transfer the mantissa from EDCB 6279 LD E,C ; to BCE. Bit 7 of E is the 17th bit which 6280 LD C,D ; will be significant for rounding if the 6281 ; number is already normalized. 6282 6283 SUB $91 ; subtract 65536 6284 CCF ; complement carry flag 6285 BIT 7,B ; test sign bit 6286 PUSH AF ; push the result 6287 6288 SET 7,B ; set the implied bit 6289 JR C,L15C6 ; forward with carry from SUB/CCF to FPBC-END 6290 ; number is too big. 6291 6292 INC A ; increment the exponent and 6293 NEG ; negate to make range $00 - $0F 6294 6295 CP $08 ; test if one or two bytes 6296 JR C,L15AF ; forward with two to BIG-INT 6297 6298 LD E,C ; shift mantissa 6299 LD C,B ; 8 places right 6300 LD B,$00 ; insert a zero in B 6301 SUB $08 ; reduce exponent by eight 6302 6303 ;; BIG-INT 6304 L15AF: AND A ; test the exponent 6305 LD D,A ; save exponent in D. 6306 6307 LD A,E ; fractional bits to A 6308 RLCA ; rotate most significant bit to carry for 6309 ; rounding of an already normal number. 6310 6311 JR Z,L15BC ; forward if exponent zero to EXP-ZERO 6312 ; the number is normalized 6313 6314 ;; FPBC-NORM 6315 L15B5: SRL B ; 0->76543210->C 6316 RR C ; C->76543210->C 6317 6318 DEC D ; decrement exponent 6319 6320 JR NZ,L15B5 ; loop back till zero to FPBC-NORM 6321 6322 ;; EXP-ZERO 6323 L15BC: JR NC,L15C6 ; forward without carry to NO-ROUND 6324 6325 INC BC ; round up. 6326 LD A,B ; test result 6327 OR C ; for zero 6328 JR NZ,L15C6 ; forward if not to GRE-ZERO 6329 6330 POP AF ; restore sign flag 6331 SCF ; set carry flag to indicate overflow 6332 PUSH AF ; save combined flags again 6333 6334 ;; FPBC-END 6335 L15C6: PUSH BC ; save BC value 6336 6337 ; set HL and DE to calculator stack pointers. 6338 6339 RST 28H ;; FP-CALC 6340 DEFB $34 ;;end-calc 6341 6342 6343 POP BC ; restore BC value 6344 POP AF ; restore flags 6345 LD A,C ; copy low byte to A also. 6346 RET ; return 6347 6348 ; ------------------------------------ 6349 ; THE 'FLOATING-POINT TO A' SUBROUTINE 6350 ; ------------------------------------ 6351 ; 6352 ; 6353 6354 ;; FP-TO-A 6355 L15CD: CALL L158A ; routine FP-TO-BC 6356 RET C ; 6357 6358 PUSH AF ; 6359 DEC B ; 6360 INC B ; 6361 JR Z,L15D9 ; forward if in range to FP-A-END 6362 6363 POP AF ; fetch result 6364 SCF ; set carry flag signaling overflow 6365 RET ; return 6366 6367 ;; FP-A-END 6368 L15D9: POP AF ; 6369 RET ; 6370 6371 6372 ; ---------------------------------------------- 6373 ; THE 'PRINT A FLOATING-POINT NUMBER' SUBROUTINE 6374 ; ---------------------------------------------- 6375 ; prints 'last value' x on calculator stack. 6376 ; There are a wide variety of formats see Chapter 4. 6377 ; e.g. 6378 ; PI prints as 3.1415927 6379 ; .123 prints as 0.123 6380 ; .0123 prints as .0123 6381 ; 999999999999 prints as 1000000000000 6382 ; 9876543210123 prints as 9876543200000 6383 6384 ; Begin by isolating zero and just printing the '0' character 6385 ; for that case. For negative numbers print a leading '-' and 6386 ; then form the absolute value of x. 6387 6388 ;; PRINT-FP 6389 L15DB: RST 28H ;; FP-CALC x. 6390 DEFB $2D ;;duplicate x, x. 6391 DEFB $32 ;;less-0 x, (1/0). 6392 DEFB $00 ;;jump-true 6393 DEFB $0B ;;to L15EA, PF-NGTVE x. 6394 6395 DEFB $2D ;;duplicate x, x 6396 DEFB $33 ;;greater-0 x, (1/0). 6397 DEFB $00 ;;jump-true 6398 DEFB $0D ;;to L15F0, PF-POSTVE x. 6399 6400 DEFB $02 ;;delete . 6401 DEFB $34 ;;end-calc . 6402 6403 LD A,$1C ; load accumulator with character '0' 6404 6405 RST 10H ; PRINT-A 6406 RET ; return. >> 6407 6408 ; --- 6409 6410 ;; PF-NEGTVE 6411 L15EA: DEFB $27 ; abs +x. 6412 DEFB $34 ;;end-calc x. 6413 6414 LD A,$16 ; load accumulator with '-' 6415 6416 RST 10H ; PRINT-A 6417 6418 RST 28H ;; FP-CALC x. 6419 6420 ;; PF-POSTVE 6421 L15F0: DEFB $34 ;;end-calc x. 6422 6423 ; register HL addresses the exponent of the floating-point value. 6424 ; if positive, and point floats to left, then bit 7 is set. 6425 6426 LD A,(HL) ; pick up the exponent byte 6427 CALL L151D ; routine STACK-A places on calculator stack. 6428 6429 ; now calculate roughly the number of digits, n, before the decimal point by 6430 ; subtracting a half from true exponent and multiplying by log to 6431 ; the base 10 of 2. 6432 ; The true number could be one higher than n, the integer result. 6433 6434 RST 28H ;; FP-CALC x, e. 6435 DEFB $30 ;;stk-data 6436 DEFB $78 ;;Exponent: $88, Bytes: 2 6437 DEFB $00,$80 ;;(+00,+00) x, e, 128.5. 6438 DEFB $03 ;;subtract x, e -.5. 6439 DEFB $30 ;;stk-data 6440 DEFB $EF ;;Exponent: $7F, Bytes: 4 6441 DEFB $1A,$20,$9A,$85 ;; .30103 (log10 2) 6442 DEFB $04 ;;multiply x, 6443 DEFB $24 ;;int 6444 DEFB $C1 ;;st-mem-1 x, n. 6445 6446 6447 DEFB $30 ;;stk-data 6448 DEFB $34 ;;Exponent: $84, Bytes: 1 6449 DEFB $00 ;;(+00,+00,+00) x, n, 8. 6450 6451 DEFB $03 ;;subtract x, n-8. 6452 DEFB $18 ;;neg x, 8-n. 6453 DEFB $38 ;;e-to-fp x * (10^n) 6454 6455 ; finally the 8 or 9 digit decimal is rounded. 6456 ; a ten-digit integer can arise in the case of, say, 999999999.5 6457 ; which gives 1000000000. 6458 6459 DEFB $A2 ;;stk-half 6460 DEFB $0F ;;addition 6461 DEFB $24 ;;int i. 6462 DEFB $34 ;;end-calc 6463 6464 ; If there were 8 digits then final rounding will take place on the calculator 6465 ; stack above and the next two instructions insert a masked zero so that 6466 ; no further rounding occurs. If the result is a 9 digit integer then 6467 ; rounding takes place within the buffer. 6468 6469 LD HL,$406B ; address system variable MEM-2-5th 6470 ; which could be the 'ninth' digit. 6471 LD (HL),$90 ; insert the value $90 10010000 6472 6473 ; now starting from lowest digit lay down the 8, 9 or 10 digit integer 6474 ; which represents the significant portion of the number 6475 ; e.g. PI will be the nine-digit integer 314159265 6476 6477 LD B,$0A ; count is ten digits. 6478 6479 ;; PF-LOOP 6480 L1615: INC HL ; increase pointer 6481 6482 PUSH HL ; preserve buffer address. 6483 PUSH BC ; preserve counter. 6484 6485 RST 28H ;; FP-CALC i. 6486 DEFB $A4 ;;stk-ten i, 10. 6487 DEFB $2E ;;n-mod-m i mod 10, i/10 6488 DEFB $01 ;;exchange i/10, remainder. 6489 DEFB $34 ;;end-calc 6490 6491 CALL L15CD ; routine FP-TO-A $00-$09 6492 6493 OR $90 ; make left hand nibble 9 6494 6495 POP BC ; restore counter 6496 POP HL ; restore buffer address. 6497 6498 LD (HL),A ; insert masked digit in buffer. 6499 DJNZ L1615 ; loop back for all ten to PF-LOOP 6500 6501 ; the most significant digit will be last but if the number is exhausted then 6502 ; the last one or two positions will contain zero ($90). 6503 6504 ; e.g. for 'one' we have zero as estimate of leading digits. 6505 ; 1*10^8 100000000 as integer value 6506 ; 90 90 90 90 90 90 90 90 91 90 as buffer mem3/mem4 contents. 6507 6508 6509 INC HL ; advance pointer to one past buffer 6510 LD BC,$0008 ; set C to 8 ( B is already zero ) 6511 PUSH HL ; save pointer. 6512 6513 ;; PF-NULL 6514 L162C: DEC HL ; decrease pointer 6515 LD A,(HL) ; fetch masked digit 6516 CP $90 ; is it a leading zero ? 6517 JR Z,L162C ; loop back if so to PF-NULL 6518 6519 ; at this point a significant digit has been found. carry is reset. 6520 6521 SBC HL,BC ; subtract eight from the address. 6522 PUSH HL ; ** save this pointer too 6523 LD A,(HL) ; fetch addressed byte 6524 ADD A,$6B ; add $6B - forcing a round up ripple 6525 ; if $95 or over. 6526 PUSH AF ; save the carry result. 6527 6528 ; now enter a loop to round the number. After rounding has been considered 6529 ; a zero that has arisen from rounding or that was present at that position 6530 ; originally is changed from $90 to $80. 6531 6532 ;; PF-RND-LP 6533 L1639: POP AF ; retrieve carry from machine stack. 6534 INC HL ; increment address 6535 LD A,(HL) ; fetch new byte 6536 ADC A,$00 ; add in any carry 6537 6538 DAA ; decimal adjust accumulator 6539 ; carry will ripple through the '9' 6540 6541 PUSH AF ; save carry on machine stack. 6542 AND $0F ; isolate character 0 - 9 AND set zero flag 6543 ; if zero. 6544 LD (HL),A ; place back in location. 6545 SET 7,(HL) ; set bit 7 to show printable. 6546 ; but not if trailing zero after decimal point. 6547 JR Z,L1639 ; back if a zero to PF-RND-LP 6548 ; to consider further rounding and/or trailing 6549 ; zero identification. 6550 6551 POP AF ; balance stack 6552 POP HL ; ** retrieve lower pointer 6553 6554 ; now insert 6 trailing zeros which are printed if before the decimal point 6555 ; but mark the end of printing if after decimal point. 6556 ; e.g. 9876543210123 is printed as 9876543200000 6557 ; 123.456001 is printed as 123.456 6558 6559 LD B,$06 ; the count is six. 6560 6561 ;; PF-ZERO-6 6562 L164B: LD (HL),$80 ; insert a masked zero 6563 DEC HL ; decrease pointer. 6564 DJNZ L164B ; loop back for all six to PF-ZERO-6 6565 6566 ; n-mod-m reduced the number to zero and this is now deleted from the calculator 6567 ; stack before fetching the original estimate of leading digits. 6568 6569 6570 RST 28H ;; FP-CALC 0. 6571 DEFB $02 ;;delete . 6572 DEFB $E1 ;;get-mem-1 n. 6573 DEFB $34 ;;end-calc n. 6574 6575 CALL L15CD ; routine FP-TO-A 6576 JR Z,L165B ; skip forward if positive to PF-POS 6577 6578 NEG ; negate makes positive 6579 6580 ;; PF-POS 6581 L165B: LD E,A ; transfer count of digits to E 6582 INC E ; increment twice 6583 INC E ; 6584 POP HL ; * retrieve pointer to one past buffer. 6585 6586 ;; GET-FIRST 6587 L165F: DEC HL ; decrement address. 6588 DEC E ; decrement digit counter. 6589 LD A,(HL) ; fetch masked byte. 6590 AND $0F ; isolate right-hand nibble. 6591 JR Z,L165F ; back with leading zero to GET-FIRST 6592 6593 ; now determine if E-format printing is needed 6594 6595 LD A,E ; transfer now accurate number count to A. 6596 SUB $05 ; subtract five 6597 CP $08 ; compare with 8 as maximum digits is 13. 6598 JP P,L1682 ; forward if positive to PF-E-FMT 6599 6600 CP $F6 ; test for more than four zeros after point. 6601 JP M,L1682 ; forward if so to PF-E-FMT 6602 6603 ADD A,$06 ; test for zero leading digits, e.g. 0.5 6604 JR Z,L16BF ; forward if so to PF-ZERO-1 6605 6606 JP M,L16B2 ; forward if more than one zero to PF-ZEROS 6607 6608 ; else digits before the decimal point are to be printed 6609 6610 LD B,A ; count of leading characters to B. 6611 6612 ;; PF-NIB-LP 6613 L167B: CALL L16D0 ; routine PF-NIBBLE 6614 DJNZ L167B ; loop back for counted numbers to PF-NIB-LP 6615 6616 JR L16C2 ; forward to consider decimal part to PF-DC-OUT 6617 6618 ; --- 6619 6620 ;; PF-E-FMT 6621 L1682: LD B,E ; count to B 6622 CALL L16D0 ; routine PF-NIBBLE prints one digit. 6623 CALL L16C2 ; routine PF-DC-OUT considers fractional part. 6624 6625 LD A,$2A ; prepare character 'E' 6626 RST 10H ; PRINT-A 6627 6628 LD A,B ; transfer exponent to A 6629 AND A ; test the sign. 6630 JP P,L1698 ; forward if positive to PF-E-POS 6631 6632 NEG ; negate the negative exponent. 6633 LD B,A ; save positive exponent in B. 6634 6635 LD A,$16 ; prepare character '-' 6636 JR L169A ; skip forward to PF-E-SIGN 6637 6638 ; --- 6639 6640 ;; PF-E-POS 6641 L1698: LD A,$15 ; prepare character '+' 6642 6643 ;; PF-E-SIGN 6644 L169A: RST 10H ; PRINT-A 6645 6646 ; now convert the integer exponent in B to two characters. 6647 ; it will be less than 99. 6648 6649 LD A,B ; fetch positive exponent. 6650 LD B,$FF ; initialize left hand digit to minus one. 6651 6652 ;; PF-E-TENS 6653 L169E: INC B ; increment ten count 6654 SUB $0A ; subtract ten from exponent 6655 JR NC,L169E ; loop back if greater than ten to PF-E-TENS 6656 6657 ADD A,$0A ; reverse last subtraction 6658 LD C,A ; transfer remainder to C 6659 6660 LD A,B ; transfer ten value to A. 6661 AND A ; test for zero. 6662 JR Z,L16AD ; skip forward if so to PF-E-LOW 6663 6664 CALL L07EB ; routine OUT-CODE prints as digit '1' - '9' 6665 6666 ;; PF-E-LOW 6667 L16AD: LD A,C ; low byte to A 6668 CALL L07EB ; routine OUT-CODE prints final digit of the 6669 ; exponent. 6670 RET ; return. >> 6671 6672 ; --- 6673 6674 ; this branch deals with zeros after decimal point. 6675 ; e.g. .01 or .0000999 6676 6677 ;; PF-ZEROS 6678 L16B2: NEG ; negate makes number positive 1 to 4. 6679 LD B,A ; zero count to B. 6680 6681 LD A,$1B ; prepare character '.' 6682 RST 10H ; PRINT-A 6683 6684 LD A,$1C ; prepare a '0' 6685 6686 ;; PF-ZRO-LP 6687 L16BA: RST 10H ; PRINT-A 6688 DJNZ L16BA ; loop back to PF-ZRO-LP 6689 6690 JR L16C8 ; forward to PF-FRAC-LP 6691 6692 ; --- 6693 6694 ; there is a need to print a leading zero e.g. 0.1 but not with .01 6695 6696 ;; PF-ZERO-1 6697 L16BF: LD A,$1C ; prepare character '0'. 6698 RST 10H ; PRINT-A 6699 6700 ; this subroutine considers the decimal point and any trailing digits. 6701 ; if the next character is a marked zero, $80, then nothing more to print. 6702 6703 ;; PF-DC-OUT 6704 L16C2: DEC (HL) ; decrement addressed character 6705 INC (HL) ; increment it again 6706 RET PE ; return with overflow (was 128) >> 6707 ; as no fractional part 6708 6709 ; else there is a fractional part so print the decimal point. 6710 6711 LD A,$1B ; prepare character '.' 6712 RST 10H ; PRINT-A 6713 6714 ; now enter a loop to print trailing digits 6715 6716 ;; PF-FRAC-LP 6717 L16C8: DEC (HL) ; test for a marked zero. 6718 INC (HL) ; 6719 RET PE ; return when digits exhausted >> 6720 6721 CALL L16D0 ; routine PF-NIBBLE 6722 JR L16C8 ; back for all fractional digits to PF-FRAC-LP. 6723 6724 ; --- 6725 6726 ; subroutine to print right-hand nibble 6727 6728 ;; PF-NIBBLE 6729 L16D0: LD A,(HL) ; fetch addressed byte 6730 AND $0F ; mask off lower 4 bits 6731 CALL L07EB ; routine OUT-CODE 6732 DEC HL ; decrement pointer. 6733 RET ; return. 6734 6735 6736 ; ------------------------------- 6737 ; THE 'PREPARE TO ADD' SUBROUTINE 6738 ; ------------------------------- 6739 ; This routine is called twice to prepare each floating point number for 6740 ; addition, in situ, on the calculator stack. 6741 ; The exponent is picked up from the first byte which is then cleared to act 6742 ; as a sign byte and accept any overflow. 6743 ; If the exponent is zero then the number is zero and an early return is made. 6744 ; The now redundant sign bit of the mantissa is set and if the number is 6745 ; negative then all five bytes of the number are twos-complemented to prepare 6746 ; the number for addition. 6747 ; On the second invocation the exponent of the first number is in B. 6748 6749 6750 ;; PREP-ADD 6751 L16D8: LD A,(HL) ; fetch exponent. 6752 LD (HL),$00 ; make this byte zero to take any overflow and 6753 ; default to positive. 6754 AND A ; test stored exponent for zero. 6755 RET Z ; return with zero flag set if number is zero. 6756 6757 INC HL ; point to first byte of mantissa. 6758 BIT 7,(HL) ; test the sign bit. 6759 SET 7,(HL) ; set it to its implied state. 6760 DEC HL ; set pointer to first byte again. 6761 RET Z ; return if bit indicated number is positive.>> 6762 6763 ; if negative then all five bytes are twos complemented starting at LSB. 6764 6765 PUSH BC ; save B register contents. 6766 LD BC,$0005 ; set BC to five. 6767 ADD HL,BC ; point to location after 5th byte. 6768 LD B,C ; set the B counter to five. 6769 LD C,A ; store original exponent in C. 6770 SCF ; set carry flag so that one is added. 6771 6772 ; now enter a loop to twos-complement the number. 6773 ; The first of the five bytes becomes $FF to denote a negative number. 6774 6775 ;; NEG-BYTE 6776 L16EC: DEC HL ; point to first or more significant byte. 6777 LD A,(HL) ; fetch to accumulator. 6778 CPL ; complement. 6779 ADC A,$00 ; add in initial carry or any subsequent carry. 6780 LD (HL),A ; place number back. 6781 DJNZ L16EC ; loop back five times to NEG-BYTE 6782 6783 LD A,C ; restore the exponent to accumulator. 6784 POP BC ; restore B register contents. 6785 6786 RET ; return. 6787 6788 ; ---------------------------------- 6789 ; THE 'FETCH TWO NUMBERS' SUBROUTINE 6790 ; ---------------------------------- 6791 ; This routine is used by addition, multiplication and division to fetch 6792 ; the two five-byte numbers addressed by HL and DE from the calculator stack 6793 ; into the Z80 registers. 6794 ; The HL register may no longer point to the first of the two numbers. 6795 ; Since the 32-bit addition operation is accomplished using two Z80 16-bit 6796 ; instructions, it is important that the lower two bytes of each mantissa are 6797 ; in one set of registers and the other bytes all in the alternate set. 6798 ; 6799 ; In: HL = highest number, DE= lowest number 6800 ; 6801 ; : alt': : 6802 ; Out: :H,B-C:C,B: num1 6803 ; :L,D-E:D-E: num2 6804 6805 ;; FETCH-TWO 6806 L16F7: PUSH HL ; save HL 6807 PUSH AF ; save A - result sign when used from division. 6808 6809 LD C,(HL) ; 6810 INC HL ; 6811 LD B,(HL) ; 6812 LD (HL),A ; insert sign when used from multiplication. 6813 INC HL ; 6814 LD A,C ; m1 6815 LD C,(HL) ; 6816 PUSH BC ; PUSH m2 m3 6817 6818 INC HL ; 6819 LD C,(HL) ; m4 6820 INC HL ; 6821 LD B,(HL) ; m5 BC holds m5 m4 6822 6823 EX DE,HL ; make HL point to start of second number. 6824 6825 LD D,A ; m1 6826 LD E,(HL) ; 6827 PUSH DE ; PUSH m1 n1 6828 6829 INC HL ; 6830 LD D,(HL) ; 6831 INC HL ; 6832 LD E,(HL) ; 6833 PUSH DE ; PUSH n2 n3 6834 6835 EXX ; - - - - - - - 6836 6837 POP DE ; POP n2 n3 6838 POP HL ; POP m1 n1 6839 POP BC ; POP m2 m3 6840 6841 EXX ; - - - - - - - 6842 6843 INC HL ; 6844 LD D,(HL) ; 6845 INC HL ; 6846 LD E,(HL) ; DE holds n4 n5 6847 6848 POP AF ; restore saved 6849 POP HL ; registers. 6850 RET ; return. 6851 6852 ; ----------------------------- 6853 ; THE 'SHIFT ADDEND' SUBROUTINE 6854 ; ----------------------------- 6855 ; The accumulator A contains the difference between the two exponents. 6856 ; This is the lowest of the two numbers to be added 6857 6858 ;; SHIFT-FP 6859 L171A: AND A ; test difference between exponents. 6860 RET Z ; return if zero. both normal. 6861 6862 CP $21 ; compare with 33 bits. 6863 JR NC,L1736 ; forward if greater than 32 to ADDEND-0 6864 6865 PUSH BC ; preserve BC - part 6866 LD B,A ; shift counter to B. 6867 6868 ; Now perform B right shifts on the addend L'D'E'D E 6869 ; to bring it into line with the augend H'B'C'C B 6870 6871 ;; ONE-SHIFT 6872 L1722: EXX ; - - - 6873 SRA L ; 76543210->C bit 7 unchanged. 6874 RR D ; C->76543210->C 6875 RR E ; C->76543210->C 6876 EXX ; - - - 6877 RR D ; C->76543210->C 6878 RR E ; C->76543210->C 6879 DJNZ L1722 ; loop back B times to ONE-SHIFT 6880 6881 POP BC ; restore BC 6882 RET NC ; return if last shift produced no carry. >> 6883 6884 ; if carry flag was set then accuracy is being lost so round up the addend. 6885 6886 CALL L1741 ; routine ADD-BACK 6887 RET NZ ; return if not FF 00 00 00 00 6888 6889 ; this branch makes all five bytes of the addend zero and is made during 6890 ; addition when the exponents are too far apart for the addend bits to 6891 ; affect the result. 6892 6893 ;; ADDEND-0 6894 L1736: EXX ; select alternate set for more significant 6895 ; bytes. 6896 XOR A ; clear accumulator. 6897 6898 6899 ; this entry point (from multiplication) sets four of the bytes to zero or if 6900 ; continuing from above, during addition, then all five bytes are set to zero. 6901 6902 ;; ZEROS-4/5 6903 L1738: LD L,$00 ; set byte 1 to zero. 6904 LD D,A ; set byte 2 to A. 6905 LD E,L ; set byte 3 to zero. 6906 EXX ; select main set 6907 LD DE,$0000 ; set lower bytes 4 and 5 to zero. 6908 RET ; return. 6909 6910 ; ------------------------- 6911 ; THE 'ADD-BACK' SUBROUTINE 6912 ; ------------------------- 6913 ; Called from SHIFT-FP above during addition and after normalization from 6914 ; multiplication. 6915 ; This is really a 32-bit increment routine which sets the zero flag according 6916 ; to the 32-bit result. 6917 ; During addition, only negative numbers like FF FF FF FF FF, 6918 ; the twos-complement version of xx 80 00 00 01 say 6919 ; will result in a full ripple FF 00 00 00 00. 6920 ; FF FF FF FF FF when shifted right is unchanged by SHIFT-FP but sets the 6921 ; carry invoking this routine. 6922 6923 ;; ADD-BACK 6924 L1741: INC E ; 6925 RET NZ ; 6926 6927 INC D ; 6928 RET NZ ; 6929 6930 EXX ; 6931 INC E ; 6932 JR NZ,L174A ; forward if no overflow to ALL-ADDED 6933 6934 INC D ; 6935 6936 ;; ALL-ADDED 6937 L174A: EXX ; 6938 RET ; return with zero flag set for zero mantissa. 6939 6940 6941 ; --------------------------- 6942 ; THE 'SUBTRACTION' OPERATION 6943 ; --------------------------- 6944 ; just switch the sign of subtrahend and do an add. 6945 6946 ;; subtract 6947 L174C: LD A,(DE) ; fetch exponent byte of second number the 6948 ; subtrahend. 6949 AND A ; test for zero 6950 RET Z ; return if zero - first number is result. 6951 6952 INC DE ; address the first mantissa byte. 6953 LD A,(DE) ; fetch to accumulator. 6954 XOR $80 ; toggle the sign bit. 6955 LD (DE),A ; place back on calculator stack. 6956 DEC DE ; point to exponent byte. 6957 ; continue into addition routine. 6958 6959 ; ------------------------ 6960 ; THE 'ADDITION' OPERATION 6961 ; ------------------------ 6962 ; The addition operation pulls out all the stops and uses most of the Z80's 6963 ; registers to add two floating-point numbers. 6964 ; This is a binary operation and on entry, HL points to the first number 6965 ; and DE to the second. 6966 6967 ;; addition 6968 L1755: EXX ; - - - 6969 PUSH HL ; save the pointer to the next literal. 6970 EXX ; - - - 6971 6972 PUSH DE ; save pointer to second number 6973 PUSH HL ; save pointer to first number - will be the 6974 ; result pointer on calculator stack. 6975 6976 CALL L16D8 ; routine PREP-ADD 6977 LD B,A ; save first exponent byte in B. 6978 EX DE,HL ; switch number pointers. 6979 CALL L16D8 ; routine PREP-ADD 6980 LD C,A ; save second exponent byte in C. 6981 CP B ; compare the exponent bytes. 6982 JR NC,L1769 ; forward if second higher to SHIFT-LEN 6983 6984 LD A,B ; else higher exponent to A 6985 LD B,C ; lower exponent to B 6986 EX DE,HL ; switch the number pointers. 6987 6988 ;; SHIFT-LEN 6989 L1769: PUSH AF ; save higher exponent 6990 SUB B ; subtract lower exponent 6991 6992 CALL L16F7 ; routine FETCH-TWO 6993 CALL L171A ; routine SHIFT-FP 6994 6995 POP AF ; restore higher exponent. 6996 POP HL ; restore result pointer. 6997 LD (HL),A ; insert exponent byte. 6998 PUSH HL ; save result pointer again. 6999 7000 ; now perform the 32-bit addition using two 16-bit Z80 add instructions. 7001 7002 LD L,B ; transfer low bytes of mantissa individually 7003 LD H,C ; to HL register 7004 7005 ADD HL,DE ; the actual binary addition of lower bytes 7006 7007 ; now the two higher byte pairs that are in the alternate register sets. 7008 7009 EXX ; switch in set 7010 EX DE,HL ; transfer high mantissa bytes to HL register. 7011 7012 ADC HL,BC ; the actual addition of higher bytes with 7013 ; any carry from first stage. 7014 7015 EX DE,HL ; result in DE, sign bytes ($FF or $00) to HL 7016 7017 ; now consider the two sign bytes 7018 7019 LD A,H ; fetch sign byte of num1 7020 7021 ADC A,L ; add including any carry from mantissa 7022 ; addition. 00 or 01 or FE or FF 7023 7024 LD L,A ; result in L. 7025 7026 ; possible outcomes of signs and overflow from mantissa are 7027 ; 7028 ; H + L + carry = L RRA XOR L RRA 7029 ; ------------------------------------------------------------ 7030 ; 00 + 00 = 00 00 00 7031 ; 00 + 00 + carry = 01 00 01 carry 7032 ; FF + FF = FE C FF 01 carry 7033 ; FF + FF + carry = FF C FF 00 7034 ; FF + 00 = FF FF 00 7035 ; FF + 00 + carry = 00 C 80 80 7036 7037 RRA ; C->76543210->C 7038 XOR L ; set bit 0 if shifting required. 7039 7040 EXX ; switch back to main set 7041 EX DE,HL ; full mantissa result now in D'E'D E registers. 7042 POP HL ; restore pointer to result exponent on 7043 ; the calculator stack. 7044 7045 RRA ; has overflow occurred ? 7046 JR NC,L1790 ; skip forward if not to TEST-NEG 7047 7048 ; if the addition of two positive mantissas produced overflow or if the 7049 ; addition of two negative mantissas did not then the result exponent has to 7050 ; be incremented and the mantissa shifted one place to the right. 7051 7052 LD A,$01 ; one shift required. 7053 CALL L171A ; routine SHIFT-FP performs a single shift 7054 ; rounding any lost bit 7055 INC (HL) ; increment the exponent. 7056 JR Z,L17B3 ; forward to ADD-REP-6 if the exponent 7057 ; wraps round from FF to zero as number is too 7058 ; big for the system. 7059 7060 ; at this stage the exponent on the calculator stack is correct. 7061 7062 ;; TEST-NEG 7063 L1790: EXX ; switch in the alternate set. 7064 LD A,L ; load result sign to accumulator. 7065 AND $80 ; isolate bit 7 from sign byte setting zero 7066 ; flag if positive. 7067 EXX ; back to main set. 7068 7069 INC HL ; point to first byte of mantissa 7070 LD (HL),A ; insert $00 positive or $80 negative at 7071 ; position on calculator stack. 7072 7073 DEC HL ; point to exponent again. 7074 JR Z,L17B9 ; forward if positive to GO-NC-MLT 7075 7076 ; a negative number has to be twos-complemented before being placed on stack. 7077 7078 LD A,E ; fetch lowest (rightmost) mantissa byte. 7079 NEG ; Negate 7080 CCF ; Complement Carry Flag 7081 LD E,A ; place back in register 7082 7083 LD A,D ; ditto 7084 CPL ; 7085 ADC A,$00 ; 7086 LD D,A ; 7087 7088 EXX ; switch to higher (leftmost) 16 bits. 7089 7090 LD A,E ; ditto 7091 CPL ; 7092 ADC A,$00 ; 7093 LD E,A ; 7094 7095 LD A,D ; ditto 7096 CPL ; 7097 ADC A,$00 ; 7098 JR NC,L17B7 ; forward without overflow to END-COMPL 7099 7100 ; else entire mantissa is now zero. 00 00 00 00 7101 7102 RRA ; set mantissa to 80 00 00 00 7103 EXX ; switch. 7104 INC (HL) ; increment the exponent. 7105 7106 ;; ADD-REP-6 7107 L17B3: JP Z,L1880 ; jump forward if exponent now zero to REPORT-6 7108 ; 'Number too big' 7109 7110 EXX ; switch back to alternate set. 7111 7112 ;; END-COMPL 7113 L17B7: LD D,A ; put first byte of mantissa back in DE. 7114 EXX ; switch to main set. 7115 7116 ;; GO-NC-MLT 7117 L17B9: XOR A ; clear carry flag and 7118 ; clear accumulator so no extra bits carried 7119 ; forward as occurs in multiplication. 7120 7121 JR L1828 ; forward to common code at TEST-NORM 7122 ; but should go straight to NORMALIZE. 7123 7124 7125 ; ---------------------------------------------- 7126 ; THE 'PREPARE TO MULTIPLY OR DIVIDE' SUBROUTINE 7127 ; ---------------------------------------------- 7128 ; this routine is called twice from multiplication and twice from division 7129 ; to prepare each of the two numbers for the operation. 7130 ; Initially the accumulator holds zero and after the second invocation bit 7 7131 ; of the accumulator will be the sign bit of the result. 7132 7133 ;; PREP-M/D 7134 L17BC: SCF ; set carry flag to signal number is zero. 7135 DEC (HL) ; test exponent 7136 INC (HL) ; for zero. 7137 RET Z ; return if zero with carry flag set. 7138 7139 INC HL ; address first mantissa byte. 7140 XOR (HL) ; exclusive or the running sign bit. 7141 SET 7,(HL) ; set the implied bit. 7142 DEC HL ; point to exponent byte. 7143 RET ; return. 7144 7145 ; ------------------------------ 7146 ; THE 'MULTIPLICATION' OPERATION 7147 ; ------------------------------ 7148 ; 7149 ; 7150 7151 ;; multiply 7152 L17C6: XOR A ; reset bit 7 of running sign flag. 7153 CALL L17BC ; routine PREP-M/D 7154 RET C ; return if number is zero. 7155 ; zero * anything = zero. 7156 7157 EXX ; - - - 7158 PUSH HL ; save pointer to 'next literal' 7159 EXX ; - - - 7160 7161 PUSH DE ; save pointer to second number 7162 7163 EX DE,HL ; make HL address second number. 7164 7165 CALL L17BC ; routine PREP-M/D 7166 7167 EX DE,HL ; HL first number, DE - second number 7168 JR C,L1830 ; forward with carry to ZERO-RSLT 7169 ; anything * zero = zero. 7170 7171 PUSH HL ; save pointer to first number. 7172 7173 CALL L16F7 ; routine FETCH-TWO fetches two mantissas from 7174 ; calc stack to B'C'C,B D'E'D E 7175 ; (HL will be overwritten but the result sign 7176 ; in A is inserted on the calculator stack) 7177 7178 LD A,B ; transfer low mantissa byte of first number 7179 AND A ; clear carry. 7180 SBC HL,HL ; a short form of LD HL,$0000 to take lower 7181 ; two bytes of result. (2 program bytes) 7182 EXX ; switch in alternate set 7183 PUSH HL ; preserve HL 7184 SBC HL,HL ; set HL to zero also to take higher two bytes 7185 ; of the result and clear carry. 7186 EXX ; switch back. 7187 7188 LD B,$21 ; register B can now be used to count thirty 7189 ; three shifts. 7190 JR L17F8 ; forward to loop entry point STRT-MLT 7191 7192 ; --- 7193 7194 ; The multiplication loop is entered at STRT-LOOP. 7195 7196 ;; MLT-LOOP 7197 L17E7: JR NC,L17EE ; forward if no carry to NO-ADD 7198 7199 ; else add in the multiplicand. 7200 7201 ADD HL,DE ; add the two low bytes to result 7202 EXX ; switch to more significant bytes. 7203 ADC HL,DE ; add high bytes of multiplicand and any carry. 7204 EXX ; switch to main set. 7205 7206 ; in either case shift result right into B'C'C A 7207 7208 ;; NO-ADD 7209 L17EE: EXX ; switch to alternate set 7210 RR H ; C > 76543210 > C 7211 RR L ; C > 76543210 > C 7212 EXX ; 7213 RR H ; C > 76543210 > C 7214 RR L ; C > 76543210 > C 7215 7216 ;; STRT-MLT 7217 L17F8: EXX ; switch in alternate set. 7218 RR B ; C > 76543210 > C 7219 RR C ; C > 76543210 > C 7220 EXX ; now main set 7221 RR C ; C > 76543210 > C 7222 RRA ; C > 76543210 > C 7223 DJNZ L17E7 ; loop back 33 times to MLT-LOOP 7224 7225 ; 7226 7227 EX DE,HL ; 7228 EXX ; 7229 EX DE,HL ; 7230 EXX ; 7231 POP BC ; 7232 POP HL ; 7233 LD A,B ; 7234 ADD A,C ; 7235 JR NZ,L180E ; forward to MAKE-EXPT 7236 7237 AND A ; 7238 7239 ;; MAKE-EXPT 7240 L180E: DEC A ; 7241 CCF ; Complement Carry Flag 7242 7243 ;; DIVN-EXPT 7244 L1810: RLA ; 7245 CCF ; Complement Carry Flag 7246 RRA ; 7247 JP P,L1819 ; forward to OFLW1-CLR 7248 7249 JR NC,L1880 ; forward to REPORT-6 7250 7251 AND A ; 7252 7253 ;; OFLW1-CLR 7254 L1819: INC A ; 7255 JR NZ,L1824 ; forward to OFLW2-CLR 7256 7257 JR C,L1824 ; forward to OFLW2-CLR 7258 7259 EXX ; 7260 BIT 7,D ; 7261 EXX ; 7262 JR NZ,L1880 ; forward to REPORT-6 7263 7264 ;; OFLW2-CLR 7265 L1824: LD (HL),A ; 7266 EXX ; 7267 LD A,B ; 7268 EXX ; 7269 7270 ; addition joins here with carry flag clear. 7271 7272 ;; TEST-NORM 7273 L1828: JR NC,L183F ; forward to NORMALIZE 7274 7275 LD A,(HL) ; 7276 AND A ; 7277 7278 ;; NEAR-ZERO 7279 L182C: LD A,$80 ; prepare to rescue the most significant bit 7280 ; of the mantissa if it is set. 7281 JR Z,L1831 ; skip forward to SKIP-ZERO 7282 7283 ;; ZERO-RSLT 7284 L1830: XOR A ; make mask byte zero signaling set five 7285 ; bytes to zero. 7286 7287 ;; SKIP-ZERO 7288 L1831: EXX ; switch in alternate set 7289 AND D ; isolate most significant bit (if A is $80). 7290 7291 CALL L1738 ; routine ZEROS-4/5 sets mantissa without 7292 ; affecting any flags. 7293 7294 RLCA ; test if MSB set. bit 7 goes to bit 0. 7295 ; either $00 -> $00 or $80 -> $01 7296 LD (HL),A ; make exponent $01 (lowest) or $00 zero 7297 JR C,L1868 ; forward if first case to OFLOW-CLR 7298 7299 INC HL ; address first mantissa byte on the 7300 ; calculator stack. 7301 LD (HL),A ; insert a zero for the sign bit. 7302 DEC HL ; point to zero exponent 7303 JR L1868 ; forward to OFLOW-CLR 7304 7305 ; --- 7306 7307 ; this branch is common to addition and multiplication with the mantissa 7308 ; result still in registers D'E'D E . 7309 7310 ;; NORMALIZE 7311 L183F: LD B,$20 ; a maximum of thirty-two left shifts will be 7312 ; needed. 7313 7314 ;; SHIFT-ONE 7315 L1841: EXX ; address higher 16 bits. 7316 BIT 7,D ; test the leftmost bit 7317 EXX ; address lower 16 bits. 7318 7319 JR NZ,L1859 ; forward if leftmost bit was set to NORML-NOW 7320 7321 RLCA ; this holds zero from addition, 33rd bit 7322 ; from multiplication. 7323 7324 RL E ; C < 76543210 < C 7325 RL D ; C < 76543210 < C 7326 7327 EXX ; address higher 16 bits. 7328 7329 RL E ; C < 76543210 < C 7330 RL D ; C < 76543210 < C 7331 7332 EXX ; switch to main set. 7333 7334 DEC (HL) ; decrement the exponent byte on the calculator 7335 ; stack. 7336 7337 JR Z,L182C ; back if exponent becomes zero to NEAR-ZERO 7338 ; it's just possible that the last rotation 7339 ; set bit 7 of D. We shall see. 7340 7341 DJNZ L1841 ; loop back to SHIFT-ONE 7342 7343 ; if thirty-two left shifts were performed without setting the most significant 7344 ; bit then the result is zero. 7345 7346 JR L1830 ; back to ZERO-RSLT 7347 7348 ; --- 7349 7350 ;; NORML-NOW 7351 L1859: RLA ; for the addition path, A is always zero. 7352 ; for the mult path, ... 7353 7354 JR NC,L1868 ; forward to OFLOW-CLR 7355 7356 ; this branch is taken only with multiplication. 7357 7358 CALL L1741 ; routine ADD-BACK 7359 7360 JR NZ,L1868 ; forward to OFLOW-CLR 7361 7362 EXX ; 7363 LD D,$80 ; 7364 EXX ; 7365 INC (HL) ; 7366 JR Z,L1880 ; forward to REPORT-6 7367 7368 ; now transfer the mantissa from the register sets to the calculator stack 7369 ; incorporating the sign bit already there. 7370 7371 ;; OFLOW-CLR 7372 L1868: PUSH HL ; save pointer to exponent on stack. 7373 INC HL ; address first byte of mantissa which was 7374 ; previously loaded with sign bit $00 or $80. 7375 7376 EXX ; - - - 7377 PUSH DE ; push the most significant two bytes. 7378 EXX ; - - - 7379 7380 POP BC ; pop - true mantissa is now BCDE. 7381 7382 ; now pick up the sign bit. 7383 7384 LD A,B ; first mantissa byte to A 7385 RLA ; rotate out bit 7 which is set 7386 RL (HL) ; rotate sign bit on stack into carry. 7387 RRA ; rotate sign bit into bit 7 of mantissa. 7388 7389 ; and transfer mantissa from main registers to calculator stack. 7390 7391 LD (HL),A ; 7392 INC HL ; 7393 LD (HL),C ; 7394 INC HL ; 7395 LD (HL),D ; 7396 INC HL ; 7397 LD (HL),E ; 7398 7399 POP HL ; restore pointer to num1 now result. 7400 POP DE ; restore pointer to num2 now STKEND. 7401 7402 EXX ; - - - 7403 POP HL ; restore pointer to next calculator literal. 7404 EXX ; - - - 7405 7406 RET ; return. 7407 7408 ; --- 7409 7410 ;; REPORT-6 7411 L1880: RST 08H ; ERROR-1 7412 DEFB $05 ; Error Report: Arithmetic overflow. 7413 7414 ; ------------------------ 7415 ; THE 'DIVISION' OPERATION 7416 ; ------------------------ 7417 ; "Of all the arithmetic subroutines, division is the most complicated and 7418 ; the least understood. It is particularly interesting to note that the 7419 ; Sinclair programmer himself has made a mistake in his programming ( or has 7420 ; copied over someone else's mistake!) for 7421 ; PRINT PEEK 6352 [ $18D0 ] ('unimproved' ROM, 6351 [ $18CF ] ) 7422 ; should give 218 not 225." 7423 ; - Dr. Ian Logan, Syntax magazine Jul/Aug 1982. 7424 ; [ i.e. the jump should be made to div-34th ] 7425 7426 ; First check for division by zero. 7427 7428 ;; division 7429 L1882: EX DE,HL ; consider the second number first. 7430 XOR A ; set the running sign flag. 7431 CALL L17BC ; routine PREP-M/D 7432 JR C,L1880 ; back if zero to REPORT-6 7433 ; 'Arithmetic overflow' 7434 7435 EX DE,HL ; now prepare first number and check for zero. 7436 CALL L17BC ; routine PREP-M/D 7437 RET C ; return if zero, 0/anything is zero. 7438 7439 EXX ; - - - 7440 PUSH HL ; save pointer to the next calculator literal. 7441 EXX ; - - - 7442 7443 PUSH DE ; save pointer to divisor - will be STKEND. 7444 PUSH HL ; save pointer to dividend - will be result. 7445 7446 CALL L16F7 ; routine FETCH-TWO fetches the two numbers 7447 ; into the registers H'B'C'C B 7448 ; L'D'E'D E 7449 EXX ; - - - 7450 PUSH HL ; save the two exponents. 7451 7452 LD H,B ; transfer the dividend to H'L'H L 7453 LD L,C ; 7454 EXX ; 7455 LD H,C ; 7456 LD L,B ; 7457 7458 XOR A ; clear carry bit and accumulator. 7459 LD B,$DF ; count upwards from -33 decimal 7460 JR L18B2 ; forward to mid-loop entry point DIV-START 7461 7462 ; --- 7463 7464 ;; DIV-LOOP 7465 L18A2: RLA ; multiply partial quotient by two 7466 RL C ; setting result bit from carry. 7467 EXX ; 7468 RL C ; 7469 RL B ; 7470 EXX ; 7471 7472 ;; div-34th 7473 L18AB: ADD HL,HL ; 7474 EXX ; 7475 ADC HL,HL ; 7476 EXX ; 7477 JR C,L18C2 ; forward to SUBN-ONLY 7478 7479 ;; DIV-START 7480 L18B2: SBC HL,DE ; subtract divisor part. 7481 EXX ; 7482 SBC HL,DE ; 7483 EXX ; 7484 JR NC,L18C9 ; forward if subtraction goes to NO-RSTORE 7485 7486 ADD HL,DE ; else restore 7487 EXX ; 7488 ADC HL,DE ; 7489 EXX ; 7490 AND A ; clear carry 7491 JR L18CA ; forward to COUNT-ONE 7492 7493 ; --- 7494 7495 ;; SUBN-ONLY 7496 L18C2: AND A ; 7497 SBC HL,DE ; 7498 EXX ; 7499 SBC HL,DE ; 7500 EXX ; 7501 7502 ;; NO-RSTORE 7503 L18C9: SCF ; set carry flag 7504 7505 ;; COUNT-ONE 7506 L18CA: INC B ; increment the counter 7507 JP M,L18A2 ; back while still minus to DIV-LOOP 7508 7509 PUSH AF ; 7510 JR Z,L18B2 ; back to DIV-START 7511 7512 ; "This jump is made to the wrong place. No 34th bit will ever be obtained 7513 ; without first shifting the dividend. Hence important results like 1/10 and 7514 ; 1/1000 are not rounded up as they should be. Rounding up never occurs when 7515 ; it depends on the 34th bit. The jump should be made to div-34th above." 7516 ; - Dr. Frank O'Hara, "The Complete Spectrum ROM Disassembly", 1983, 7517 ; published by Melbourne House. 7518 ; (Note. on the ZX81 this would be JR Z,L18AB) 7519 ; 7520 ; However if you make this change, then while (1/2=.5) will now evaluate as 7521 ; true, (.25=1/4), which did evaluate as true, no longer does. 7522 7523 LD E,A ; 7524 LD D,C ; 7525 EXX ; 7526 LD E,C ; 7527 LD D,B ; 7528 7529 POP AF ; 7530 RR B ; 7531 POP AF ; 7532 RR B ; 7533 7534 EXX ; 7535 POP BC ; 7536 POP HL ; 7537 LD A,B ; 7538 SUB C ; 7539 JP L1810 ; jump back to DIVN-EXPT 7540 7541 ; ------------------------------------------------ 7542 ; THE 'INTEGER TRUNCATION TOWARDS ZERO' SUBROUTINE 7543 ; ------------------------------------------------ 7544 ; 7545 7546 ;; truncate 7547 L18E4: LD A,(HL) ; fetch exponent 7548 CP $81 ; compare to +1 7549 JR NC,L18EF ; forward, if 1 or more, to T-GR-ZERO 7550 7551 ; else the number is smaller than plus or minus 1 and can be made zero. 7552 7553 LD (HL),$00 ; make exponent zero. 7554 LD A,$20 ; prepare to set 32 bits of mantissa to zero. 7555 JR L18F4 ; forward to NIL-BYTES 7556 7557 ; --- 7558 7559 ;; T-GR-ZERO 7560 L18EF: SUB $A0 ; subtract +32 from exponent 7561 RET P ; return if result is positive as all 32 bits 7562 ; of the mantissa relate to the integer part. 7563 ; The floating point is somewhere to the right 7564 ; of the mantissa 7565 7566 NEG ; else negate to form number of rightmost bits 7567 ; to be blanked. 7568 7569 ; for instance, disregarding the sign bit, the number 3.5 is held as 7570 ; exponent $82 mantissa .11100000 00000000 00000000 00000000 7571 ; we need to set $82 - $A0 = $E2 NEG = $1E (thirty) bits to zero to form the 7572 ; integer. 7573 ; The sign of the number is never considered as the first bit of the mantissa 7574 ; must be part of the integer. 7575 7576 ;; NIL-BYTES 7577 L18F4: PUSH DE ; save pointer to STKEND 7578 EX DE,HL ; HL points at STKEND 7579 DEC HL ; now at last byte of mantissa. 7580 LD B,A ; Transfer bit count to B register. 7581 SRL B ; divide by 7582 SRL B ; eight 7583 SRL B ; 7584 JR Z,L1905 ; forward if zero to BITS-ZERO 7585 7586 ; else the original count was eight or more and whole bytes can be blanked. 7587 7588 ;; BYTE-ZERO 7589 L1900: LD (HL),$00 ; set eight bits to zero. 7590 DEC HL ; point to more significant byte of mantissa. 7591 DJNZ L1900 ; loop back to BYTE-ZERO 7592 7593 ; now consider any residual bits. 7594 7595 ;; BITS-ZERO 7596 L1905: AND $07 ; isolate the remaining bits 7597 JR Z,L1912 ; forward if none to IX-END 7598 7599 LD B,A ; transfer bit count to B counter. 7600 LD A,$FF ; form a mask 11111111 7601 7602 ;; LESS-MASK 7603 L190C: SLA A ; 1 <- 76543210 <- o slide mask leftwards. 7604 DJNZ L190C ; loop back for bit count to LESS-MASK 7605 7606 AND (HL) ; lose the unwanted rightmost bits 7607 LD (HL),A ; and place in mantissa byte. 7608 7609 ;; IX-END 7610 L1912: EX DE,HL ; restore result pointer from DE. 7611 POP DE ; restore STKEND from stack. 7612 RET ; return. 7613 7614 7615 ;******************************** 7616 ;** FLOATING-POINT CALCULATOR ** 7617 ;******************************** 7618 7619 ; As a general rule the calculator avoids using the IY register. 7620 ; Exceptions are val and str$. 7621 ; So an assembly language programmer who has disabled interrupts to use IY 7622 ; for other purposes can still use the calculator for mathematical 7623 ; purposes. 7624 7625 7626 ; ------------------------ 7627 ; THE 'TABLE OF CONSTANTS' 7628 ; ------------------------ 7629 ; The ZX81 has only floating-point number representation. 7630 ; Both the ZX80 and the ZX Spectrum have integer numbers in some form. 7631 7632 ;; stk-zero 00 00 00 00 00 7633 L1915: DEFB $00 ;;Bytes: 1 7634 DEFB $B0 ;;Exponent $00 7635 DEFB $00 ;;(+00,+00,+00) 7636 7637 ;; stk-one 81 00 00 00 00 7638 L1918: DEFB $31 ;;Exponent $81, Bytes: 1 7639 DEFB $00 ;;(+00,+00,+00) 7640 7641 7642 ;; stk-half 80 00 00 00 00 7643 L191A: DEFB $30 ;;Exponent: $80, Bytes: 1 7644 DEFB $00 ;;(+00,+00,+00) 7645 7646 7647 ;; stk-pi/2 81 49 0F DA A2 7648 L191C: DEFB $F1 ;;Exponent: $81, Bytes: 4 7649 DEFB $49,$0F,$DA,$A2 ;; 7650 7651 ;; stk-ten 84 20 00 00 00 7652 L1921: DEFB $34 ;;Exponent: $84, Bytes: 1 7653 DEFB $20 ;;(+00,+00,+00) 7654 7655 7656 ; ------------------------ 7657 ; THE 'TABLE OF ADDRESSES' 7658 ; ------------------------ 7659 ; 7660 ; starts with binary operations which have two operands and one result. 7661 ; three pseudo binary operations first. 7662 7663 ;; tbl-addrs 7664 L1923: DEFW L1C2F ; $00 Address: $1C2F - jump-true 7665 DEFW L1A72 ; $01 Address: $1A72 - exchange 7666 DEFW L19E3 ; $02 Address: $19E3 - delete 7667 7668 ; true binary operations. 7669 7670 DEFW L174C ; $03 Address: $174C - subtract 7671 DEFW L17C6 ; $04 Address: $176C - multiply 7672 DEFW L1882 ; $05 Address: $1882 - division 7673 DEFW L1DE2 ; $06 Address: $1DE2 - to-power 7674 DEFW L1AED ; $07 Address: $1AED - or 7675 7676 DEFW L1AF3 ; $08 Address: $1B03 - no-&-no 7677 DEFW L1B03 ; $09 Address: $1B03 - no-l-eql 7678 DEFW L1B03 ; $0A Address: $1B03 - no-gr-eql 7679 DEFW L1B03 ; $0B Address: $1B03 - nos-neql 7680 DEFW L1B03 ; $0C Address: $1B03 - no-grtr 7681 DEFW L1B03 ; $0D Address: $1B03 - no-less 7682 DEFW L1B03 ; $0E Address: $1B03 - nos-eql 7683 DEFW L1755 ; $0F Address: $1755 - addition 7684 7685 DEFW L1AF8 ; $10 Address: $1AF8 - str-&-no 7686 DEFW L1B03 ; $11 Address: $1B03 - str-l-eql 7687 DEFW L1B03 ; $12 Address: $1B03 - str-gr-eql 7688 DEFW L1B03 ; $13 Address: $1B03 - strs-neql 7689 DEFW L1B03 ; $14 Address: $1B03 - str-grtr 7690 DEFW L1B03 ; $15 Address: $1B03 - str-less 7691 DEFW L1B03 ; $16 Address: $1B03 - strs-eql 7692 DEFW L1B62 ; $17 Address: $1B62 - strs-add 7693 7694 ; unary follow 7695 7696 DEFW L1AA0 ; $18 Address: $1AA0 - neg 7697 7698 DEFW L1C06 ; $19 Address: $1C06 - code 7699 DEFW L1BA4 ; $1A Address: $1BA4 - val 7700 DEFW L1C11 ; $1B Address: $1C11 - len 7701 DEFW L1D49 ; $1C Address: $1D49 - sin 7702 DEFW L1D3E ; $1D Address: $1D3E - cos 7703 DEFW L1D6E ; $1E Address: $1D6E - tan 7704 DEFW L1DC4 ; $1F Address: $1DC4 - asn 7705 DEFW L1DD4 ; $20 Address: $1DD4 - acs 7706 DEFW L1D76 ; $21 Address: $1D76 - atn 7707 DEFW L1CA9 ; $22 Address: $1CA9 - ln 7708 DEFW L1C5B ; $23 Address: $1C5B - exp 7709 DEFW L1C46 ; $24 Address: $1C46 - int 7710 DEFW L1DDB ; $25 Address: $1DDB - sqr 7711 DEFW L1AAF ; $26 Address: $1AAF - sgn 7712 DEFW L1AAA ; $27 Address: $1AAA - abs 7713 DEFW L1ABE ; $28 Address: $1A1B - peek 7714 DEFW L1AC5 ; $29 Address: $1AC5 - usr-no 7715 DEFW L1BD5 ; $2A Address: $1BD5 - str$ 7716 DEFW L1B8F ; $2B Address: $1B8F - chrs 7717 DEFW L1AD5 ; $2C Address: $1AD5 - not 7718 7719 ; end of true unary 7720 7721 DEFW L19F6 ; $2D Address: $19F6 - duplicate 7722 DEFW L1C37 ; $2E Address: $1C37 - n-mod-m 7723 7724 DEFW L1C23 ; $2F Address: $1C23 - jump 7725 DEFW L19FC ; $30 Address: $19FC - stk-data 7726 7727 DEFW L1C17 ; $31 Address: $1C17 - dec-jr-nz 7728 DEFW L1ADB ; $32 Address: $1ADB - less-0 7729 DEFW L1ACE ; $33 Address: $1ACE - greater-0 7730 DEFW L002B ; $34 Address: $002B - end-calc 7731 DEFW L1D18 ; $35 Address: $1D18 - get-argt 7732 DEFW L18E4 ; $36 Address: $18E4 - truncate 7733 DEFW L19E4 ; $37 Address: $19E4 - fp-calc-2 7734 DEFW L155A ; $38 Address: $155A - e-to-fp 7735 7736 ; the following are just the next available slots for the 128 compound literals 7737 ; which are in range $80 - $FF. 7738 7739 DEFW L1A7F ; $39 Address: $1A7F - series-xx $80 - $9F. 7740 DEFW L1A51 ; $3A Address: $1A51 - stk-const-xx $A0 - $BF. 7741 DEFW L1A63 ; $3B Address: $1A63 - st-mem-xx $C0 - $DF. 7742 DEFW L1A45 ; $3C Address: $1A45 - get-mem-xx $E0 - $FF. 7743 7744 ; Aside: 3D - 7F are therefore unused calculator literals. 7745 ; 39 - 7B would be available for expansion. 7746 7747 ; ------------------------------- 7748 ; THE 'FLOATING POINT CALCULATOR' 7749 ; ------------------------------- 7750 ; 7751 ; 7752 7753 ;; CALCULATE 7754 L199D: CALL L1B85 ; routine STK-PNTRS is called to set up the 7755 ; calculator stack pointers for a default 7756 ; unary operation. HL = last value on stack. 7757 ; DE = STKEND first location after stack. 7758 7759 ; the calculate routine is called at this point by the series generator... 7760 7761 ;; GEN-ENT-1 7762 L19A0: LD A,B ; fetch the Z80 B register to A 7763 LD ($401E),A ; and store value in system variable BREG. 7764 ; this will be the counter for dec-jr-nz 7765 ; or if used from fp-calc2 the calculator 7766 ; instruction. 7767 7768 ; ... and again later at this point 7769 7770 ;; GEN-ENT-2 7771 L19A4: EXX ; switch sets 7772 EX (SP),HL ; and store the address of next instruction, 7773 ; the return address, in H'L'. 7774 ; If this is a recursive call then the H'L' 7775 ; of the previous invocation goes on stack. 7776 ; c.f. end-calc. 7777 EXX ; switch back to main set. 7778 7779 ; this is the re-entry looping point when handling a string of literals. 7780 7781 ;; RE-ENTRY 7782 L19A7: LD ($401C),DE ; save end of stack in system variable STKEND 7783 EXX ; switch to alt 7784 LD A,(HL) ; get next literal 7785 INC HL ; increase pointer' 7786 7787 ; single operation jumps back to here 7788 7789 ;; SCAN-ENT 7790 L19AE: PUSH HL ; save pointer on stack * 7791 AND A ; now test the literal 7792 JP P,L19C2 ; forward to FIRST-3D if in range $00 - $3D 7793 ; anything with bit 7 set will be one of 7794 ; 128 compound literals. 7795 7796 ; compound literals have the following format. 7797 ; bit 7 set indicates compound. 7798 ; bits 6-5 the subgroup 0-3. 7799 ; bits 4-0 the embedded parameter $00 - $1F. 7800 ; The subgroup 0-3 needs to be manipulated to form the next available four 7801 ; address places after the simple literals in the address table. 7802 7803 LD D,A ; save literal in D 7804 AND $60 ; and with 01100000 to isolate subgroup 7805 RRCA ; rotate bits 7806 RRCA ; 4 places to right 7807 RRCA ; not five as we need offset * 2 7808 RRCA ; 00000xx0 7809 ADD A,$72 ; add ($39 * 2) to give correct offset. 7810 ; alter above if you add more literals. 7811 LD L,A ; store in L for later indexing. 7812 LD A,D ; bring back compound literal 7813 AND $1F ; use mask to isolate parameter bits 7814 JR L19D0 ; forward to ENT-TABLE 7815 7816 ; --- 7817 7818 ; the branch was here with simple literals. 7819 7820 ;; FIRST-3D 7821 L19C2: CP $18 ; compare with first unary operations. 7822 JR NC,L19CE ; to DOUBLE-A with unary operations 7823 7824 ; it is binary so adjust pointers. 7825 7826 EXX ; 7827 LD BC,$FFFB ; the value -5 7828 LD D,H ; transfer HL, the last value, to DE. 7829 LD E,L ; 7830 ADD HL,BC ; subtract 5 making HL point to second 7831 ; value. 7832 EXX ; 7833 7834 ;; DOUBLE-A 7835 L19CE: RLCA ; double the literal 7836 LD L,A ; and store in L for indexing 7837 7838 ;; ENT-TABLE 7839 L19D0: LD DE,L1923 ; Address: tbl-addrs 7840 LD H,$00 ; prepare to index 7841 ADD HL,DE ; add to get address of routine 7842 LD E,(HL) ; low byte to E 7843 INC HL ; 7844 LD D,(HL) ; high byte to D 7845 7846 LD HL,L19A7 ; Address: RE-ENTRY 7847 EX (SP),HL ; goes on machine stack 7848 ; address of next literal goes to HL. * 7849 7850 7851 PUSH DE ; now the address of routine is stacked. 7852 EXX ; back to main set 7853 ; avoid using IY register. 7854 LD BC,($401D) ; STKEND_hi 7855 ; nothing much goes to C but BREG to B 7856 ; and continue into next ret instruction 7857 ; which has a dual identity 7858 7859 7860 ; ----------------------- 7861 ; THE 'DELETE' SUBROUTINE 7862 ; ----------------------- 7863 ; offset $02: 'delete' 7864 ; A simple return but when used as a calculator literal this 7865 ; deletes the last value from the calculator stack. 7866 ; On entry, as always with binary operations, 7867 ; HL=first number, DE=second number 7868 ; On exit, HL=result, DE=stkend. 7869 ; So nothing to do 7870 7871 ;; delete 7872 L19E3: RET ; return - indirect jump if from above. 7873 7874 ; --------------------------------- 7875 ; THE 'SINGLE OPERATION' SUBROUTINE 7876 ; --------------------------------- 7877 ; offset $37: 'fp-calc-2' 7878 ; this single operation is used, in the first instance, to evaluate most 7879 ; of the mathematical and string functions found in BASIC expressions. 7880 7881 ;; fp-calc-2 7882 L19E4: POP AF ; drop return address. 7883 LD A,($401E) ; load accumulator from system variable BREG 7884 ; value will be literal eg. 'tan' 7885 EXX ; switch to alt 7886 JR L19AE ; back to SCAN-ENT 7887 ; next literal will be end-calc in scanning 7888 7889 ; ------------------------------ 7890 ; THE 'TEST 5 SPACES' SUBROUTINE 7891 ; ------------------------------ 7892 ; This routine is called from MOVE-FP, STK-CONST and STK-STORE to 7893 ; test that there is enough space between the calculator stack and the 7894 ; machine stack for another five-byte value. It returns with BC holding 7895 ; the value 5 ready for any subsequent LDIR. 7896 7897 ;; TEST-5-SP 7898 L19EB: PUSH DE ; save 7899 PUSH HL ; registers 7900 LD BC,$0005 ; an overhead of five bytes 7901 CALL L0EC5 ; routine TEST-ROOM tests free RAM raising 7902 ; an error if not. 7903 POP HL ; else restore 7904 POP DE ; registers. 7905 RET ; return with BC set at 5. 7906 7907 7908 ; --------------------------------------------- 7909 ; THE 'MOVE A FLOATING POINT NUMBER' SUBROUTINE 7910 ; --------------------------------------------- 7911 ; offset $2D: 'duplicate' 7912 ; This simple routine is a 5-byte LDIR instruction 7913 ; that incorporates a memory check. 7914 ; When used as a calculator literal it duplicates the last value on the 7915 ; calculator stack. 7916 ; Unary so on entry HL points to last value, DE to stkend 7917 7918 ;; duplicate 7919 ;; MOVE-FP 7920 L19F6: CALL L19EB ; routine TEST-5-SP test free memory 7921 ; and sets BC to 5. 7922 LDIR ; copy the five bytes. 7923 RET ; return with DE addressing new STKEND 7924 ; and HL addressing new last value. 7925 7926 ; ------------------------------- 7927 ; THE 'STACK LITERALS' SUBROUTINE 7928 ; ------------------------------- 7929 ; offset $30: 'stk-data' 7930 ; When a calculator subroutine needs to put a value on the calculator 7931 ; stack that is not a regular constant this routine is called with a 7932 ; variable number of following data bytes that convey to the routine 7933 ; the floating point form as succinctly as is possible. 7934 7935 ;; stk-data 7936 L19FC: LD H,D ; transfer STKEND 7937 LD L,E ; to HL for result. 7938 7939 ;; STK-CONST 7940 L19FE: CALL L19EB ; routine TEST-5-SP tests that room exists 7941 ; and sets BC to $05. 7942 7943 EXX ; switch to alternate set 7944 PUSH HL ; save the pointer to next literal on stack 7945 EXX ; switch back to main set 7946 7947 EX (SP),HL ; pointer to HL, destination to stack. 7948 7949 PUSH BC ; save BC - value 5 from test room ??. 7950 7951 LD A,(HL) ; fetch the byte following 'stk-data' 7952 AND $C0 ; isolate bits 7 and 6 7953 RLCA ; rotate 7954 RLCA ; to bits 1 and 0 range $00 - $03. 7955 LD C,A ; transfer to C 7956 INC C ; and increment to give number of bytes 7957 ; to read. $01 - $04 7958 LD A,(HL) ; reload the first byte 7959 AND $3F ; mask off to give possible exponent. 7960 JR NZ,L1A14 ; forward to FORM-EXP if it was possible to 7961 ; include the exponent. 7962 7963 ; else byte is just a byte count and exponent comes next. 7964 7965 INC HL ; address next byte and 7966 LD A,(HL) ; pick up the exponent ( - $50). 7967 7968 ;; FORM-EXP 7969 L1A14: ADD A,$50 ; now add $50 to form actual exponent 7970 LD (DE),A ; and load into first destination byte. 7971 LD A,$05 ; load accumulator with $05 and 7972 SUB C ; subtract C to give count of trailing 7973 ; zeros plus one. 7974 INC HL ; increment source 7975 INC DE ; increment destination 7976 LD B,$00 ; prepare to copy 7977 LDIR ; copy C bytes 7978 7979 POP BC ; restore 5 counter to BC ??. 7980 7981 EX (SP),HL ; put HL on stack as next literal pointer 7982 ; and the stack value - result pointer - 7983 ; to HL. 7984 7985 EXX ; switch to alternate set. 7986 POP HL ; restore next literal pointer from stack 7987 ; to H'L'. 7988 EXX ; switch back to main set. 7989 7990 LD B,A ; zero count to B 7991 XOR A ; clear accumulator 7992 7993 ;; STK-ZEROS 7994 L1A27: DEC B ; decrement B counter 7995 RET Z ; return if zero. >> 7996 ; DE points to new STKEND 7997 ; HL to new number. 7998 7999 LD (DE),A ; else load zero to destination 8000 INC DE ; increase destination 8001 JR L1A27 ; loop back to STK-ZEROS until done. 8002 8003 ; ------------------------------- 8004 ; THE 'SKIP CONSTANTS' SUBROUTINE 8005 ; ------------------------------- 8006 ; This routine traverses variable-length entries in the table of constants, 8007 ; stacking intermediate, unwanted constants onto a dummy calculator stack, 8008 ; in the first five bytes of the ZX81 ROM. 8009 8010 ;; SKIP-CONS 8011 L1A2D: AND A ; test if initially zero. 8012 8013 ;; SKIP-NEXT 8014 L1A2E: RET Z ; return if zero. >> 8015 8016 PUSH AF ; save count. 8017 PUSH DE ; and normal STKEND 8018 8019 LD DE,$0000 ; dummy value for STKEND at start of ROM 8020 ; Note. not a fault but this has to be 8021 ; moved elsewhere when running in RAM. 8022 ; 8023 CALL L19FE ; routine STK-CONST works through variable 8024 ; length records. 8025 8026 POP DE ; restore real STKEND 8027 POP AF ; restore count 8028 DEC A ; decrease 8029 JR L1A2E ; loop back to SKIP-NEXT 8030 8031 ; -------------------------------- 8032 ; THE 'MEMORY LOCATION' SUBROUTINE 8033 ; -------------------------------- 8034 ; This routine, when supplied with a base address in HL and an index in A, 8035 ; will calculate the address of the A'th entry, where each entry occupies 8036 ; five bytes. It is used for addressing floating-point numbers in the 8037 ; calculator's memory area. 8038 8039 ;; LOC-MEM 8040 L1A3C: LD C,A ; store the original number $00-$1F. 8041 RLCA ; double. 8042 RLCA ; quadruple. 8043 ADD A,C ; now add original value to multiply by five. 8044 8045 LD C,A ; place the result in C. 8046 LD B,$00 ; set B to 0. 8047 ADD HL,BC ; add to form address of start of number in HL. 8048 8049 RET ; return. 8050 8051 ; ------------------------------------- 8052 ; THE 'GET FROM MEMORY AREA' SUBROUTINE 8053 ; ------------------------------------- 8054 ; offsets $E0 to $FF: 'get-mem-0', 'get-mem-1' etc. 8055 ; A holds $00-$1F offset. 8056 ; The calculator stack increases by 5 bytes. 8057 8058 ;; get-mem-xx 8059 L1A45: PUSH DE ; save STKEND 8060 LD HL,($401F) ; MEM is base address of the memory cells. 8061 CALL L1A3C ; routine LOC-MEM so that HL = first byte 8062 CALL L19F6 ; routine MOVE-FP moves 5 bytes with memory 8063 ; check. 8064 ; DE now points to new STKEND. 8065 POP HL ; the original STKEND is now RESULT pointer. 8066 RET ; return. 8067 8068 ; --------------------------------- 8069 ; THE 'STACK A CONSTANT' SUBROUTINE 8070 ; --------------------------------- 8071 ; offset $A0: 'stk-zero' 8072 ; offset $A1: 'stk-one' 8073 ; offset $A2: 'stk-half' 8074 ; offset $A3: 'stk-pi/2' 8075 ; offset $A4: 'stk-ten' 8076 ; This routine allows a one-byte instruction to stack up to 32 constants 8077 ; held in short form in a table of constants. In fact only 5 constants are 8078 ; required. On entry the A register holds the literal ANDed with $1F. 8079 ; It isn't very efficient and it would have been better to hold the 8080 ; numbers in full, five byte form and stack them in a similar manner 8081 ; to that which would be used later for semi-tone table values. 8082 8083 ;; stk-const-xx 8084 L1A51: LD H,D ; save STKEND - required for result 8085 LD L,E ; 8086 EXX ; swap 8087 PUSH HL ; save pointer to next literal 8088 LD HL,L1915 ; Address: stk-zero - start of table of 8089 ; constants 8090 EXX ; 8091 CALL L1A2D ; routine SKIP-CONS 8092 CALL L19FE ; routine STK-CONST 8093 EXX ; 8094 POP HL ; restore pointer to next literal. 8095 EXX ; 8096 RET ; return. 8097 8098 ; --------------------------------------- 8099 ; THE 'STORE IN A MEMORY AREA' SUBROUTINE 8100 ; --------------------------------------- 8101 ; Offsets $C0 to $DF: 'st-mem-0', 'st-mem-1' etc. 8102 ; Although 32 memory storage locations can be addressed, only six 8103 ; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5) 8104 ; required for these are allocated. ZX81 programmers who wish to 8105 ; use the floating point routines from assembly language may wish to 8106 ; alter the system variable MEM to point to 160 bytes of RAM to have 8107 ; use the full range available. 8108 ; A holds derived offset $00-$1F. 8109 ; Unary so on entry HL points to last value, DE to STKEND. 8110 8111 ;; st-mem-xx 8112 L1A63: PUSH HL ; save the result pointer. 8113 EX DE,HL ; transfer to DE. 8114 LD HL,($401F) ; fetch MEM the base of memory area. 8115 CALL L1A3C ; routine LOC-MEM sets HL to the destination. 8116 EX DE,HL ; swap - HL is start, DE is destination. 8117 CALL L19F6 ; routine MOVE-FP. 8118 ; note. a short ld bc,5; ldir 8119 ; the embedded memory check is not required 8120 ; so these instructions would be faster! 8121 EX DE,HL ; DE = STKEND 8122 POP HL ; restore original result pointer 8123 RET ; return. 8124 8125 ; ------------------------- 8126 ; THE 'EXCHANGE' SUBROUTINE 8127 ; ------------------------- 8128 ; offset $01: 'exchange' 8129 ; This routine exchanges the last two values on the calculator stack 8130 ; On entry, as always with binary operations, 8131 ; HL=first number, DE=second number 8132 ; On exit, HL=result, DE=stkend. 8133 8134 ;; exchange 8135 L1A72: LD B,$05 ; there are five bytes to be swapped 8136 8137 ; start of loop. 8138 8139 ;; SWAP-BYTE 8140 L1A74: LD A,(DE) ; each byte of second 8141 LD C,(HL) ; each byte of first 8142 EX DE,HL ; swap pointers 8143 LD (DE),A ; store each byte of first 8144 LD (HL),C ; store each byte of second 8145 INC HL ; advance both 8146 INC DE ; pointers. 8147 DJNZ L1A74 ; loop back to SWAP-BYTE until all 5 done. 8148 8149 EX DE,HL ; even up the exchanges 8150 ; so that DE addresses STKEND. 8151 RET ; return. 8152 8153 ; --------------------------------- 8154 ; THE 'SERIES GENERATOR' SUBROUTINE 8155 ; --------------------------------- 8156 ; offset $86: 'series-06' 8157 ; offset $88: 'series-08' 8158 ; offset $8C: 'series-0C' 8159 ; The ZX81 uses Chebyshev polynomials to generate approximations for 8160 ; SIN, ATN, LN and EXP. These are named after the Russian mathematician 8161 ; Pafnuty Chebyshev, born in 1821, who did much pioneering work on numerical 8162 ; series. As far as calculators are concerned, Chebyshev polynomials have an 8163 ; advantage over other series, for example the Taylor series, as they can 8164 ; reach an approximation in just six iterations for SIN, eight for EXP and 8165 ; twelve for LN and ATN. The mechanics of the routine are interesting but 8166 ; for full treatment of how these are generated with demonstrations in 8167 ; Sinclair BASIC see "The Complete Spectrum ROM Disassembly" by Dr Ian Logan 8168 ; and Dr Frank O'Hara, published 1983 by Melbourne House. 8169 8170 ;; series-xx 8171 L1A7F: LD B,A ; parameter $00 - $1F to B counter 8172 CALL L19A0 ; routine GEN-ENT-1 is called. 8173 ; A recursive call to a special entry point 8174 ; in the calculator that puts the B register 8175 ; in the system variable BREG. The return 8176 ; address is the next location and where 8177 ; the calculator will expect its first 8178 ; instruction - now pointed to by HL'. 8179 ; The previous pointer to the series of 8180 ; five-byte numbers goes on the machine stack. 8181 8182 ; The initialization phase. 8183 8184 DEFB $2D ;;duplicate x,x 8185 DEFB $0F ;;addition x+x 8186 DEFB $C0 ;;st-mem-0 x+x 8187 DEFB $02 ;;delete . 8188 DEFB $A0 ;;stk-zero 0 8189 DEFB $C2 ;;st-mem-2 0 8190 8191 ; a loop is now entered to perform the algebraic calculation for each of 8192 ; the numbers in the series 8193 8194 ;; G-LOOP 8195 L1A89: DEFB $2D ;;duplicate v,v. 8196 DEFB $E0 ;;get-mem-0 v,v,x+2 8197 DEFB $04 ;;multiply v,v*x+2 8198 DEFB $E2 ;;get-mem-2 v,v*x+2,v 8199 DEFB $C1 ;;st-mem-1 8200 DEFB $03 ;;subtract 8201 DEFB $34 ;;end-calc 8202 8203 ; the previous pointer is fetched from the machine stack to H'L' where it 8204 ; addresses one of the numbers of the series following the series literal. 8205 8206 CALL L19FC ; routine STK-DATA is called directly to 8207 ; push a value and advance H'L'. 8208 CALL L19A4 ; routine GEN-ENT-2 recursively re-enters 8209 ; the calculator without disturbing 8210 ; system variable BREG 8211 ; H'L' value goes on the machine stack and is 8212 ; then loaded as usual with the next address. 8213 8214 DEFB $0F ;;addition 8215 DEFB $01 ;;exchange 8216 DEFB $C2 ;;st-mem-2 8217 DEFB $02 ;;delete 8218 8219 DEFB $31 ;;dec-jr-nz 8220 DEFB $EE ;;back to L1A89, G-LOOP 8221 8222 ; when the counted loop is complete the final subtraction yields the result 8223 ; for example SIN X. 8224 8225 DEFB $E1 ;;get-mem-1 8226 DEFB $03 ;;subtract 8227 DEFB $34 ;;end-calc 8228 8229 RET ; return with H'L' pointing to location 8230 ; after last number in series. 8231 8232 ; ----------------------- 8233 ; Handle unary minus (18) 8234 ; ----------------------- 8235 ; Unary so on entry HL points to last value, DE to STKEND. 8236 8237 ;; NEGATE 8238 ;; negate 8239 L1AA0: LD A, (HL) ; fetch exponent of last value on the 8240 ; calculator stack. 8241 AND A ; test it. 8242 RET Z ; return if zero. 8243 8244 INC HL ; address the byte with the sign bit. 8245 LD A,(HL) ; fetch to accumulator. 8246 XOR $80 ; toggle the sign bit. 8247 LD (HL),A ; put it back. 8248 DEC HL ; point to last value again. 8249 RET ; return. 8250 8251 ; ----------------------- 8252 ; Absolute magnitude (27) 8253 ; ----------------------- 8254 ; This calculator literal finds the absolute value of the last value, 8255 ; floating point, on calculator stack. 8256 8257 ;; abs 8258 L1AAA: INC HL ; point to byte with sign bit. 8259 RES 7,(HL) ; make the sign positive. 8260 DEC HL ; point to last value again. 8261 RET ; return. 8262 8263 ; ----------- 8264 ; Signum (26) 8265 ; ----------- 8266 ; This routine replaces the last value on the calculator stack, 8267 ; which is in floating point form, with one if positive and with -minus one 8268 ; if negative. If it is zero then it is left as such. 8269 8270 ;; sgn 8271 L1AAF: INC HL ; point to first byte of 4-byte mantissa. 8272 LD A,(HL) ; pick up the byte with the sign bit. 8273 DEC HL ; point to exponent. 8274 DEC (HL) ; test the exponent for 8275 INC (HL) ; the value zero. 8276 8277 SCF ; set the carry flag. 8278 CALL NZ,L1AE0 ; routine FP-0/1 replaces last value with one 8279 ; if exponent indicates the value is non-zero. 8280 ; in either case mantissa is now four zeros. 8281 8282 INC HL ; point to first byte of 4-byte mantissa. 8283 RLCA ; rotate original sign bit to carry. 8284 RR (HL) ; rotate the carry into sign. 8285 DEC HL ; point to last value. 8286 RET ; return. 8287 8288 8289 ; ------------------------- 8290 ; Handle PEEK function (28) 8291 ; ------------------------- 8292 ; This function returns the contents of a memory address. 8293 ; The entire address space can be peeked including the ROM. 8294 8295 ;; peek 8296 L1ABE: CALL L0EA7 ; routine FIND-INT puts address in BC. 8297 LD A,(BC) ; load contents into A register. 8298 8299 ;; IN-PK-STK 8300 L1AC2: JP L151D ; exit via STACK-A to put value on the 8301 ; calculator stack. 8302 8303 ; --------------- 8304 ; USR number (29) 8305 ; --------------- 8306 ; The USR function followed by a number 0-65535 is the method by which 8307 ; the ZX81 invokes machine code programs. This function returns the 8308 ; contents of the BC register pair. 8309 ; Note. that STACK-BC re-initializes the IY register to $4000 if a user-written 8310 ; program has altered it. 8311 8312 ;; usr-no 8313 L1AC5: CALL L0EA7 ; routine FIND-INT to fetch the 8314 ; supplied address into BC. 8315 8316 LD HL,L1520 ; address: STACK-BC is 8317 PUSH HL ; pushed onto the machine stack. 8318 PUSH BC ; then the address of the machine code 8319 ; routine. 8320 8321 RET ; make an indirect jump to the routine 8322 ; and, hopefully, to STACK-BC also. 8323 8324 8325 ; ----------------------- 8326 ; Greater than zero ($33) 8327 ; ----------------------- 8328 ; Test if the last value on the calculator stack is greater than zero. 8329 ; This routine is also called directly from the end-tests of the comparison 8330 ; routine. 8331 8332 ;; GREATER-0 8333 ;; greater-0 8334 L1ACE: LD A,(HL) ; fetch exponent. 8335 AND A ; test it for zero. 8336 RET Z ; return if so. 8337 8338 8339 LD A,$FF ; prepare XOR mask for sign bit 8340 JR L1ADC ; forward to SIGN-TO-C 8341 ; to put sign in carry 8342 ; (carry will become set if sign is positive) 8343 ; and then overwrite location with 1 or 0 8344 ; as appropriate. 8345 8346 ; ------------------------ 8347 ; Handle NOT operator ($2C) 8348 ; ------------------------ 8349 ; This overwrites the last value with 1 if it was zero else with zero 8350 ; if it was any other value. 8351 ; 8352 ; e.g. NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0. 8353 ; 8354 ; The subroutine is also called directly from the end-tests of the comparison 8355 ; operator. 8356 8357 ;; NOT 8358 ;; not 8359 L1AD5: LD A,(HL) ; get exponent byte. 8360 NEG ; negate - sets carry if non-zero. 8361 CCF ; complement so carry set if zero, else reset. 8362 JR L1AE0 ; forward to FP-0/1. 8363 8364 ; ------------------- 8365 ; Less than zero (32) 8366 ; ------------------- 8367 ; Destructively test if last value on calculator stack is less than zero. 8368 ; Bit 7 of second byte will be set if so. 8369 8370 ;; less-0 8371 L1ADB: XOR A ; set xor mask to zero 8372 ; (carry will become set if sign is negative). 8373 8374 ; transfer sign of mantissa to Carry Flag. 8375 8376 ;; SIGN-TO-C 8377 L1ADC: INC HL ; address 2nd byte. 8378 XOR (HL) ; bit 7 of HL will be set if number is negative. 8379 DEC HL ; address 1st byte again. 8380 RLCA ; rotate bit 7 of A to carry. 8381 8382 ; ----------- 8383 ; Zero or one 8384 ; ----------- 8385 ; This routine places an integer value zero or one at the addressed location 8386 ; of calculator stack or MEM area. The value one is written if carry is set on 8387 ; entry else zero. 8388 8389 ;; FP-0/1 8390 L1AE0: PUSH HL ; save pointer to the first byte 8391 LD B,$05 ; five bytes to do. 8392 8393 ;; FP-loop 8394 L1AE3: LD (HL),$00 ; insert a zero. 8395 INC HL ; 8396 DJNZ L1AE3 ; repeat. 8397 8398 POP HL ; 8399 RET NC ; 8400 8401 LD (HL),$81 ; make value 1 8402 RET ; return. 8403 8404 8405 ; ----------------------- 8406 ; Handle OR operator (07) 8407 ; ----------------------- 8408 ; The Boolean OR operator. eg. X OR Y 8409 ; The result is zero if both values are zero else a non-zero value. 8410 ; 8411 ; e.g. 0 OR 0 returns 0. 8412 ; -3 OR 0 returns -3. 8413 ; 0 OR -3 returns 1. 8414 ; -3 OR 2 returns 1. 8415 ; 8416 ; A binary operation. 8417 ; On entry HL points to first operand (X) and DE to second operand (Y). 8418 8419 ;; or 8420 L1AED: LD A,(DE) ; fetch exponent of second number 8421 AND A ; test it. 8422 RET Z ; return if zero. 8423 8424 SCF ; set carry flag 8425 JR L1AE0 ; back to FP-0/1 to overwrite the first operand 8426 ; with the value 1. 8427 8428 8429 ; ----------------------------- 8430 ; Handle number AND number (08) 8431 ; ----------------------------- 8432 ; The Boolean AND operator. 8433 ; 8434 ; e.g. -3 AND 2 returns -3. 8435 ; -3 AND 0 returns 0. 8436 ; 0 and -2 returns 0. 8437 ; 0 and 0 returns 0. 8438 ; 8439 ; Compare with OR routine above. 8440 8441 ;; no-&-no 8442 L1AF3: LD A,(DE) ; fetch exponent of second number. 8443 AND A ; test it. 8444 RET NZ ; return if not zero. 8445 8446 JR L1AE0 ; back to FP-0/1 to overwrite the first operand 8447 ; with zero for return value. 8448 8449 ; ----------------------------- 8450 ; Handle string AND number (10) 8451 ; ----------------------------- 8452 ; e.g. "YOU WIN" AND SCORE>99 will return the string if condition is true 8453 ; or the null string if false. 8454 8455 ;; str-&-no 8456 L1AF8: LD A,(DE) ; fetch exponent of second number. 8457 AND A ; test it. 8458 RET NZ ; return if number was not zero - the string 8459 ; is the result. 8460 8461 ; if the number was zero (false) then the null string must be returned by 8462 ; altering the length of the string on the calculator stack to zero. 8463 8464 PUSH DE ; save pointer to the now obsolete number 8465 ; (which will become the new STKEND) 8466 8467 DEC DE ; point to the 5th byte of string descriptor. 8468 XOR A ; clear the accumulator. 8469 LD (DE),A ; place zero in high byte of length. 8470 DEC DE ; address low byte of length. 8471 LD (DE),A ; place zero there - now the null string. 8472 8473 POP DE ; restore pointer - new STKEND. 8474 RET ; return. 8475 8476 ; ----------------------------------- 8477 ; Perform comparison ($09-$0E, $11-$16) 8478 ; ----------------------------------- 8479 ; True binary operations. 8480 ; 8481 ; A single entry point is used to evaluate six numeric and six string 8482 ; comparisons. On entry, the calculator literal is in the B register and 8483 ; the two numeric values, or the two string parameters, are on the 8484 ; calculator stack. 8485 ; The individual bits of the literal are manipulated to group similar 8486 ; operations although the SUB 8 instruction does nothing useful and merely 8487 ; alters the string test bit. 8488 ; Numbers are compared by subtracting one from the other, strings are 8489 ; compared by comparing every character until a mismatch, or the end of one 8490 ; or both, is reached. 8491 ; 8492 ; Numeric Comparisons. 8493 ; -------------------- 8494 ; The 'x>y' example is the easiest as it employs straight-thru logic. 8495 ; Number y is subtracted from x and the result tested for greater-0 yielding 8496 ; a final value 1 (true) or 0 (false). 8497 ; For 'x<y' the same logic is used but the two values are first swapped on the 8498 ; calculator stack. 8499 ; For 'x=y' NOT is applied to the subtraction result yielding true if the 8500 ; difference was zero and false with anything else. 8501 ; The first three numeric comparisons are just the opposite of the last three 8502 ; so the same processing steps are used and then a final NOT is applied. 8503 ; 8504 ; literal Test No sub 8 ExOrNot 1st RRCA exch sub ? End-Tests 8505 ; ========= ==== == ======== === ======== ======== ==== === = === === === 8506 ; no-l-eql x<=y 09 00000001 dec 00000000 00000000 ---- x-y ? --- >0? NOT 8507 ; no-gr-eql x>=y 0A 00000010 dec 00000001 10000000c swap y-x ? --- >0? NOT 8508 ; nos-neql x<>y 0B 00000011 dec 00000010 00000001 ---- x-y ? NOT --- NOT 8509 ; no-grtr x>y 0C 00000100 - 00000100 00000010 ---- x-y ? --- >0? --- 8510 ; no-less x<y 0D 00000101 - 00000101 10000010c swap y-x ? --- >0? --- 8511 ; nos-eql x=y 0E 00000110 - 00000110 00000011 ---- x-y ? NOT --- --- 8512 ; 8513 ; comp -> C/F 8514 ; ==== === 8515 ; str-l-eql x$<=y$ 11 00001001 dec 00001000 00000100 ---- x$y$ 0 !or >0? NOT 8516 ; str-gr-eql x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0 !or >0? NOT 8517 ; strs-neql x$<>y$ 13 00001011 dec 00001010 00000101 ---- x$y$ 0 !or >0? NOT 8518 ; str-grtr x$>y$ 14 00001100 - 00001100 00000110 ---- x$y$ 0 !or >0? --- 8519 ; str-less x$<y$ 15 00001101 - 00001101 10000110c swap y$x$ 0 !or >0? --- 8520 ; strs-eql x$=y$ 16 00001110 - 00001110 00000111 ---- x$y$ 0 !or >0? --- 8521 ; 8522 ; String comparisons are a little different in that the eql/neql carry flag 8523 ; from the 2nd RRCA is, as before, fed into the first of the end tests but 8524 ; along the way it gets modified by the comparison process. The result on the 8525 ; stack always starts off as zero and the carry fed in determines if NOT is 8526 ; applied to it. So the only time the greater-0 test is applied is if the 8527 ; stack holds zero which is not very efficient as the test will always yield 8528 ; zero. The most likely explanation is that there were once separate end tests 8529 ; for numbers and strings. 8530 8531 ;; no-l-eql,etc. 8532 L1B03: LD A,B ; transfer literal to accumulator. 8533 SUB $08 ; subtract eight - which is not useful. 8534 8535 BIT 2,A ; isolate '>', '<', '='. 8536 8537 JR NZ,L1B0B ; skip to EX-OR-NOT with these. 8538 8539 DEC A ; else make $00-$02, $08-$0A to match bits 0-2. 8540 8541 ;; EX-OR-NOT 8542 L1B0B: RRCA ; the first RRCA sets carry for a swap. 8543 JR NC,L1B16 ; forward to NU-OR-STR with other 8 cases 8544 8545 ; for the other 4 cases the two values on the calculator stack are exchanged. 8546 8547 PUSH AF ; save A and carry. 8548 PUSH HL ; save HL - pointer to first operand. 8549 ; (DE points to second operand). 8550 8551 CALL L1A72 ; routine exchange swaps the two values. 8552 ; (HL = second operand, DE = STKEND) 8553 8554 POP DE ; DE = first operand 8555 EX DE,HL ; as we were. 8556 POP AF ; restore A and carry. 8557 8558 ; Note. it would be better if the 2nd RRCA preceded the string test. 8559 ; It would save two duplicate bytes and if we also got rid of that sub 8 8560 ; at the beginning we wouldn't have to alter which bit we test. 8561 8562 ;; NU-OR-STR 8563 L1B16: BIT 2,A ; test if a string comparison. 8564 JR NZ,L1B21 ; forward to STRINGS if so. 8565 8566 ; continue with numeric comparisons. 8567 8568 RRCA ; 2nd RRCA causes eql/neql to set carry. 8569 PUSH AF ; save A and carry 8570 8571 CALL L174C ; routine subtract leaves result on stack. 8572 JR L1B54 ; forward to END-TESTS 8573 8574 ; --- 8575 8576 ;; STRINGS 8577 L1B21: RRCA ; 2nd RRCA causes eql/neql to set carry. 8578 PUSH AF ; save A and carry. 8579 8580 CALL L13F8 ; routine STK-FETCH gets 2nd string params 8581 PUSH DE ; save start2 *. 8582 PUSH BC ; and the length. 8583 8584 CALL L13F8 ; routine STK-FETCH gets 1st string 8585 ; parameters - start in DE, length in BC. 8586 POP HL ; restore length of second to HL. 8587 8588 ; A loop is now entered to compare, by subtraction, each corresponding character 8589 ; of the strings. For each successful match, the pointers are incremented and 8590 ; the lengths decreased and the branch taken back to here. If both string 8591 ; remainders become null at the same time, then an exact match exists. 8592 8593 ;; BYTE-COMP 8594 L1B2C: LD A,H ; test if the second string 8595 OR L ; is the null string and hold flags. 8596 8597 EX (SP),HL ; put length2 on stack, bring start2 to HL *. 8598 LD A,B ; hi byte of length1 to A 8599 8600 JR NZ,L1B3D ; forward to SEC-PLUS if second not null. 8601 8602 OR C ; test length of first string. 8603 8604 ;; SECND-LOW 8605 L1B33: POP BC ; pop the second length off stack. 8606 JR Z,L1B3A ; forward to BOTH-NULL if first string is also 8607 ; of zero length. 8608 8609 ; the true condition - first is longer than second (SECND-LESS) 8610 8611 POP AF ; restore carry (set if eql/neql) 8612 CCF ; complement carry flag. 8613 ; Note. equality becomes false. 8614 ; Inequality is true. By swapping or applying 8615 ; a terminal 'not', all comparisons have been 8616 ; manipulated so that this is success path. 8617 JR L1B50 ; forward to leave via STR-TEST 8618 8619 ; --- 8620 ; the branch was here with a match 8621 8622 ;; BOTH-NULL 8623 L1B3A: POP AF ; restore carry - set for eql/neql 8624 JR L1B50 ; forward to STR-TEST 8625 8626 ; --- 8627 ; the branch was here when 2nd string not null and low byte of first is yet 8628 ; to be tested. 8629 8630 8631 ;; SEC-PLUS 8632 L1B3D: OR C ; test the length of first string. 8633 JR Z,L1B4D ; forward to FRST-LESS if length is zero. 8634 8635 ; both strings have at least one character left. 8636 8637 LD A,(DE) ; fetch character of first string. 8638 SUB (HL) ; subtract with that of 2nd string. 8639 JR C,L1B4D ; forward to FRST-LESS if carry set 8640 8641 JR NZ,L1B33 ; back to SECND-LOW and then STR-TEST 8642 ; if not exact match. 8643 8644 DEC BC ; decrease length of 1st string. 8645 INC DE ; increment 1st string pointer. 8646 8647 INC HL ; increment 2nd string pointer. 8648 EX (SP),HL ; swap with length on stack 8649 DEC HL ; decrement 2nd string length 8650 JR L1B2C ; back to BYTE-COMP 8651 8652 ; --- 8653 ; the false condition. 8654 8655 ;; FRST-LESS 8656 L1B4D: POP BC ; discard length 8657 POP AF ; pop A 8658 AND A ; clear the carry for false result. 8659 8660 ; --- 8661 ; exact match and x$>y$ rejoin here 8662 8663 ;; STR-TEST 8664 L1B50: PUSH AF ; save A and carry 8665 8666 RST 28H ;; FP-CALC 8667 DEFB $A0 ;;stk-zero an initial false value. 8668 DEFB $34 ;;end-calc 8669 8670 ; both numeric and string paths converge here. 8671 8672 ;; END-TESTS 8673 L1B54: POP AF ; pop carry - will be set if eql/neql 8674 PUSH AF ; save it again. 8675 8676 CALL C,L1AD5 ; routine NOT sets true(1) if equal(0) 8677 ; or, for strings, applies true result. 8678 CALL L1ACE ; greater-0 ?????????? 8679 8680 8681 POP AF ; pop A 8682 RRCA ; the third RRCA - test for '<=', '>=' or '<>'. 8683 CALL NC,L1AD5 ; apply a terminal NOT if so. 8684 RET ; return. 8685 8686 ; ------------------------- 8687 ; String concatenation ($17) 8688 ; ------------------------- 8689 ; This literal combines two strings into one e.g. LET A$ = B$ + C$ 8690 ; The two parameters of the two strings to be combined are on the stack. 8691 8692 ;; strs-add 8693 L1B62: CALL L13F8 ; routine STK-FETCH fetches string parameters 8694 ; and deletes calculator stack entry. 8695 PUSH DE ; save start address. 8696 PUSH BC ; and length. 8697 8698 CALL L13F8 ; routine STK-FETCH for first string 8699 POP HL ; re-fetch first length 8700 PUSH HL ; and save again 8701 PUSH DE ; save start of second string 8702 PUSH BC ; and its length. 8703 8704 ADD HL,BC ; add the two lengths. 8705 LD B,H ; transfer to BC 8706 LD C,L ; and create 8707 RST 30H ; BC-SPACES in workspace. 8708 ; DE points to start of space. 8709 8710 CALL L12C3 ; routine STK-STO-$ stores parameters 8711 ; of new string updating STKEND. 8712 8713 POP BC ; length of first 8714 POP HL ; address of start 8715 LD A,B ; test for 8716 OR C ; zero length. 8717 JR Z,L1B7D ; to OTHER-STR if null string 8718 8719 LDIR ; copy string to workspace. 8720 8721 ;; OTHER-STR 8722 L1B7D: POP BC ; now second length 8723 POP HL ; and start of string 8724 LD A,B ; test this one 8725 OR C ; for zero length 8726 JR Z,L1B85 ; skip forward to STK-PNTRS if so as complete. 8727 8728 LDIR ; else copy the bytes. 8729 ; and continue into next routine which 8730 ; sets the calculator stack pointers. 8731 8732 ; -------------------- 8733 ; Check stack pointers 8734 ; -------------------- 8735 ; Register DE is set to STKEND and HL, the result pointer, is set to five 8736 ; locations below this. 8737 ; This routine is used when it is inconvenient to save these values at the 8738 ; time the calculator stack is manipulated due to other activity on the 8739 ; machine stack. 8740 ; This routine is also used to terminate the VAL routine for 8741 ; the same reason and to initialize the calculator stack at the start of 8742 ; the CALCULATE routine. 8743 8744 ;; STK-PNTRS 8745 L1B85: LD HL,($401C) ; fetch STKEND value from system variable. 8746 LD DE,$FFFB ; the value -5 8747 PUSH HL ; push STKEND value. 8748 8749 ADD HL,DE ; subtract 5 from HL. 8750 8751 POP DE ; pop STKEND to DE. 8752 RET ; return. 8753 8754 ; ---------------- 8755 ; Handle CHR$ (2B) 8756 ; ---------------- 8757 ; This function returns a single character string that is a result of 8758 ; converting a number in the range 0-255 to a string e.g. CHR$ 38 = "A". 8759 ; Note. the ZX81 does not have an ASCII character set. 8760 8761 ;; chrs 8762 L1B8F: CALL L15CD ; routine FP-TO-A puts the number in A. 8763 8764 JR C,L1BA2 ; forward to REPORT-Bd if overflow 8765 JR NZ,L1BA2 ; forward to REPORT-Bd if negative 8766 8767 PUSH AF ; save the argument. 8768 8769 LD BC,$0001 ; one space required. 8770 RST 30H ; BC-SPACES makes DE point to start 8771 8772 POP AF ; restore the number. 8773 8774 LD (DE),A ; and store in workspace 8775 8776 CALL L12C3 ; routine STK-STO-$ stacks descriptor. 8777 8778 EX DE,HL ; make HL point to result and DE to STKEND. 8779 RET ; return. 8780 8781 ; --- 8782 8783 ;; REPORT-Bd 8784 L1BA2: RST 08H ; ERROR-1 8785 DEFB $0A ; Error Report: Integer out of range 8786 8787 ; ---------------------------- 8788 ; Handle VAL ($1A) 8789 ; ---------------------------- 8790 ; VAL treats the characters in a string as a numeric expression. 8791 ; e.g. VAL "2.3" = 2.3, VAL "2+4" = 6, VAL ("2" + "4") = 24. 8792 8793 ;; val 8794 L1BA4: LD HL,($4016) ; fetch value of system variable CH_ADD 8795 PUSH HL ; and save on the machine stack. 8796 8797 CALL L13F8 ; routine STK-FETCH fetches the string operand 8798 ; from calculator stack. 8799 8800 PUSH DE ; save the address of the start of the string. 8801 INC BC ; increment the length for a carriage return. 8802 8803 RST 30H ; BC-SPACES creates the space in workspace. 8804 POP HL ; restore start of string to HL. 8805 LD ($4016),DE ; load CH_ADD with start DE in workspace. 8806 8807 PUSH DE ; save the start in workspace 8808 LDIR ; copy string from program or variables or 8809 ; workspace to the workspace area. 8810 EX DE,HL ; end of string + 1 to HL 8811 DEC HL ; decrement HL to point to end of new area. 8812 LD (HL),$76 ; insert a carriage return at end. 8813 ; ZX81 has a non-ASCII character set 8814 RES 7,(IY+$01) ; update FLAGS - signal checking syntax. 8815 CALL L0D92 ; routine CLASS-06 - SCANNING evaluates string 8816 ; expression and checks for integer result. 8817 8818 CALL L0D22 ; routine CHECK-2 checks for carriage return. 8819 8820 8821 POP HL ; restore start of string in workspace. 8822 8823 LD ($4016),HL ; set CH_ADD to the start of the string again. 8824 SET 7,(IY+$01) ; update FLAGS - signal running program. 8825 CALL L0F55 ; routine SCANNING evaluates the string 8826 ; in full leaving result on calculator stack. 8827 8828 POP HL ; restore saved character address in program. 8829 LD ($4016),HL ; and reset the system variable CH_ADD. 8830 8831 JR L1B85 ; back to exit via STK-PNTRS. 8832 ; resetting the calculator stack pointers 8833 ; HL and DE from STKEND as it wasn't possible 8834 ; to preserve them during this routine. 8835 8836 ; ---------------- 8837 ; Handle STR$ (2A) 8838 ; ---------------- 8839 ; This function returns a string representation of a numeric argument. 8840 ; The method used is to trick the PRINT-FP routine into thinking it 8841 ; is writing to a collapsed display file when in fact it is writing to 8842 ; string workspace. 8843 ; If there is already a newline at the intended print position and the 8844 ; column count has not been reduced to zero then the print routine 8845 ; assumes that there is only 1K of RAM and the screen memory, like the rest 8846 ; of dynamic memory, expands as necessary using calls to the ONE-SPACE 8847 ; routine. The screen is character-mapped not bit-mapped. 8848 8849 ;; str$ 8850 L1BD5: LD BC,$0001 ; create an initial byte in workspace 8851 RST 30H ; using BC-SPACES restart. 8852 8853 LD (HL),$76 ; place a carriage return there. 8854 8855 LD HL,($4039) ; fetch value of S_POSN column/line 8856 PUSH HL ; and preserve on stack. 8857 8858 LD L,$FF ; make column value high to create a 8859 ; contrived buffer of length 254. 8860 LD ($4039),HL ; and store in system variable S_POSN. 8861 8862 LD HL,($400E) ; fetch value of DF_CC 8863 PUSH HL ; and preserve on stack also. 8864 8865 LD ($400E),DE ; now set DF_CC which normally addresses 8866 ; somewhere in the display file to the start 8867 ; of workspace. 8868 PUSH DE ; save the start of new string. 8869 8870 CALL L15DB ; routine PRINT-FP. 8871 8872 POP DE ; retrieve start of string. 8873 8874 LD HL,($400E) ; fetch end of string from DF_CC. 8875 AND A ; prepare for true subtraction. 8876 SBC HL,DE ; subtract to give length. 8877 8878 LD B,H ; and transfer to the BC 8879 LD C,L ; register. 8880 8881 POP HL ; restore original 8882 LD ($400E),HL ; DF_CC value 8883 8884 POP HL ; restore original 8885 LD ($4039),HL ; S_POSN values. 8886 8887 CALL L12C3 ; routine STK-STO-$ stores the string 8888 ; descriptor on the calculator stack. 8889 8890 EX DE,HL ; HL = last value, DE = STKEND. 8891 RET ; return. 8892 8893 8894 ; ------------------- 8895 ; THE 'CODE' FUNCTION 8896 ; ------------------- 8897 ; (offset $19: 'code') 8898 ; Returns the code of a character or first character of a string 8899 ; e.g. CODE "AARDVARK" = 38 (not 65 as the ZX81 does not have an ASCII 8900 ; character set). 8901 8902 8903 ;; code 8904 L1C06: CALL L13F8 ; routine STK-FETCH to fetch and delete the 8905 ; string parameters. 8906 ; DE points to the start, BC holds the length. 8907 LD A,B ; test length 8908 OR C ; of the string. 8909 JR Z,L1C0E ; skip to STK-CODE with zero if the null string. 8910 8911 LD A,(DE) ; else fetch the first character. 8912 8913 ;; STK-CODE 8914 L1C0E: JP L151D ; jump back to STACK-A (with memory check) 8915 8916 ; -------------------- 8917 ; THE 'LEN' SUBROUTINE 8918 ; -------------------- 8919 ; (offset $1b: 'len') 8920 ; Returns the length of a string. 8921 ; In Sinclair BASIC strings can be more than twenty thousand characters long 8922 ; so a sixteen-bit register is required to store the length 8923 8924 ;; len 8925 L1C11: CALL L13F8 ; routine STK-FETCH to fetch and delete the 8926 ; string parameters from the calculator stack. 8927 ; register BC now holds the length of string. 8928 8929 JP L1520 ; jump back to STACK-BC to save result on the 8930 ; calculator stack (with memory check). 8931 8932 ; ------------------------------------- 8933 ; THE 'DECREASE THE COUNTER' SUBROUTINE 8934 ; ------------------------------------- 8935 ; (offset $31: 'dec-jr-nz') 8936 ; The calculator has an instruction that decrements a single-byte 8937 ; pseudo-register and makes consequential relative jumps just like 8938 ; the Z80's DJNZ instruction. 8939 8940 ;; dec-jr-nz 8941 L1C17: EXX ; switch in set that addresses code 8942 8943 PUSH HL ; save pointer to offset byte 8944 LD HL,$401E ; address BREG in system variables 8945 DEC (HL) ; decrement it 8946 POP HL ; restore pointer 8947 8948 JR NZ,L1C24 ; to JUMP-2 if not zero 8949 8950 INC HL ; step past the jump length. 8951 EXX ; switch in the main set. 8952 RET ; return. 8953 8954 ; Note. as a general rule the calculator avoids using the IY register 8955 ; otherwise the cumbersome 4 instructions in the middle could be replaced by 8956 ; dec (iy+$xx) - using three instruction bytes instead of six. 8957 8958 8959 ; --------------------- 8960 ; THE 'JUMP' SUBROUTINE 8961 ; --------------------- 8962 ; (Offset $2F; 'jump') 8963 ; This enables the calculator to perform relative jumps just like 8964 ; the Z80 chip's JR instruction. 8965 ; This is one of the few routines to be polished for the ZX Spectrum. 8966 ; See, without looking at the ZX Spectrum ROM, if you can get rid of the 8967 ; relative jump. 8968 8969 ;; jump 8970 ;; JUMP 8971 L1C23: EXX ;switch in pointer set 8972 8973 ;; JUMP-2 8974 L1C24: LD E,(HL) ; the jump byte 0-127 forward, 128-255 back. 8975 XOR A ; clear accumulator. 8976 BIT 7,E ; test if negative jump 8977 JR Z,L1C2B ; skip, if positive, to JUMP-3. 8978 8979 CPL ; else change to $FF. 8980 8981 ;; JUMP-3 8982 L1C2B: LD D,A ; transfer to high byte. 8983 ADD HL,DE ; advance calculator pointer forward or back. 8984 8985 EXX ; switch out pointer set. 8986 RET ; return. 8987 8988 ; ----------------------------- 8989 ; THE 'JUMP ON TRUE' SUBROUTINE 8990 ; ----------------------------- 8991 ; (Offset $00; 'jump-true') 8992 ; This enables the calculator to perform conditional relative jumps 8993 ; dependent on whether the last test gave a true result 8994 ; On the ZX81, the exponent will be zero for zero or else $81 for one. 8995 8996 ;; jump-true 8997 L1C2F: LD A,(DE) ; collect exponent byte 8998 8999 AND A ; is result 0 or 1 ? 9000 JR NZ,L1C23 ; back to JUMP if true (1). 9001 9002 EXX ; else switch in the pointer set. 9003 INC HL ; step past the jump length. 9004 EXX ; switch in the main set. 9005 RET ; return. 9006 9007 9008 ; ------------------------ 9009 ; THE 'MODULUS' SUBROUTINE 9010 ; ------------------------ 9011 ; ( Offset $2E: 'n-mod-m' ) 9012 ; ( i1, i2 -- i3, i4 ) 9013 ; The subroutine calculate N mod M where M is the positive integer, the 9014 ; 'last value' on the calculator stack and N is the integer beneath. 9015 ; The subroutine returns the integer quotient as the last value and the 9016 ; remainder as the value beneath. 9017 ; e.g. 17 MOD 3 = 5 remainder 2 9018 ; It is invoked during the calculation of a random number and also by 9019 ; the PRINT-FP routine. 9020 9021 ;; n-mod-m 9022 L1C37: RST 28H ;; FP-CALC 17, 3. 9023 DEFB $C0 ;;st-mem-0 17, 3. 9024 DEFB $02 ;;delete 17. 9025 DEFB $2D ;;duplicate 17, 17. 9026 DEFB $E0 ;;get-mem-0 17, 17, 3. 9027 DEFB $05 ;;division 17, 17/3. 9028 DEFB $24 ;;int 17, 5. 9029 DEFB $E0 ;;get-mem-0 17, 5, 3. 9030 DEFB $01 ;;exchange 17, 3, 5. 9031 DEFB $C0 ;;st-mem-0 17, 3, 5. 9032 DEFB $04 ;;multiply 17, 15. 9033 DEFB $03 ;;subtract 2. 9034 DEFB $E0 ;;get-mem-0 2, 5. 9035 DEFB $34 ;;end-calc 2, 5. 9036 9037 RET ; return. 9038 9039 9040 ; ---------------------- 9041 ; THE 'INTEGER' FUNCTION 9042 ; ---------------------- 9043 ; (offset $24: 'int') 9044 ; This function returns the integer of x, which is just the same as truncate 9045 ; for positive numbers. The truncate literal truncates negative numbers 9046 ; upwards so that -3.4 gives -3 whereas the BASIC INT function has to 9047 ; truncate negative numbers down so that INT -3.4 is 4. 9048 ; It is best to work through using, say, plus or minus 3.4 as examples. 9049 9050 ;; int 9051 L1C46: RST 28H ;; FP-CALC x. (= 3.4 or -3.4). 9052 DEFB $2D ;;duplicate x, x. 9053 DEFB $32 ;;less-0 x, (1/0) 9054 DEFB $00 ;;jump-true x, (1/0) 9055 DEFB $04 ;;to L1C46, X-NEG 9056 9057 DEFB $36 ;;truncate trunc 3.4 = 3. 9058 DEFB $34 ;;end-calc 3. 9059 9060 RET ; return with + int x on stack. 9061 9062 9063 ;; X-NEG 9064 L1C4E: DEFB $2D ;;duplicate -3.4, -3.4. 9065 DEFB $36 ;;truncate -3.4, -3. 9066 DEFB $C0 ;;st-mem-0 -3.4, -3. 9067 DEFB $03 ;;subtract -.4 9068 DEFB $E0 ;;get-mem-0 -.4, -3. 9069 DEFB $01 ;;exchange -3, -.4. 9070 DEFB $2C ;;not -3, (0). 9071 DEFB $00 ;;jump-true -3. 9072 DEFB $03 ;;to L1C59, EXIT -3. 9073 9074 DEFB $A1 ;;stk-one -3, 1. 9075 DEFB $03 ;;subtract -4. 9076 9077 ;; EXIT 9078 L1C59: DEFB $34 ;;end-calc -4. 9079 9080 RET ; return. 9081 9082 9083 ; ---------------- 9084 ; Exponential (23) 9085 ; ---------------- 9086 ; 9087 ; 9088 9089 ;; EXP 9090 ;; exp 9091 L1C5B: RST 28H ;; FP-CALC 9092 DEFB $30 ;;stk-data 9093 DEFB $F1 ;;Exponent: $81, Bytes: 4 9094 DEFB $38,$AA,$3B,$29 ;; 9095 DEFB $04 ;;multiply 9096 DEFB $2D ;;duplicate 9097 DEFB $24 ;;int 9098 DEFB $C3 ;;st-mem-3 9099 DEFB $03 ;;subtract 9100 DEFB $2D ;;duplicate 9101 DEFB $0F ;;addition 9102 DEFB $A1 ;;stk-one 9103 DEFB $03 ;;subtract 9104 DEFB $88 ;;series-08 9105 DEFB $13 ;;Exponent: $63, Bytes: 1 9106 DEFB $36 ;;(+00,+00,+00) 9107 DEFB $58 ;;Exponent: $68, Bytes: 2 9108 DEFB $65,$66 ;;(+00,+00) 9109 DEFB $9D ;;Exponent: $6D, Bytes: 3 9110 DEFB $78,$65,$40 ;;(+00) 9111 DEFB $A2 ;;Exponent: $72, Bytes: 3 9112 DEFB $60,$32,$C9 ;;(+00) 9113 DEFB $E7 ;;Exponent: $77, Bytes: 4 9114 DEFB $21,$F7,$AF,$24 ;; 9115 DEFB $EB ;;Exponent: $7B, Bytes: 4 9116 DEFB $2F,$B0,$B0,$14 ;; 9117 DEFB $EE ;;Exponent: $7E, Bytes: 4 9118 DEFB $7E,$BB,$94,$58 ;; 9119 DEFB $F1 ;;Exponent: $81, Bytes: 4 9120 DEFB $3A,$7E,$F8,$CF ;; 9121 DEFB $E3 ;;get-mem-3 9122 DEFB $34 ;;end-calc 9123 9124 CALL L15CD ; routine FP-TO-A 9125 JR NZ,L1C9B ; to N-NEGTV 9126 9127 JR C,L1C99 ; to REPORT-6b 9128 9129 ADD A,(HL) ; 9130 JR NC,L1CA2 ; to RESULT-OK 9131 9132 9133 ;; REPORT-6b 9134 L1C99: RST 08H ; ERROR-1 9135 DEFB $05 ; Error Report: Number too big 9136 9137 ;; N-NEGTV 9138 L1C9B: JR C,L1CA4 ; to RSLT-ZERO 9139 9140 SUB (HL) ; 9141 JR NC,L1CA4 ; to RSLT-ZERO 9142 9143 NEG ; Negate 9144 9145 ;; RESULT-OK 9146 L1CA2: LD (HL),A ; 9147 RET ; return. 9148 9149 9150 ;; RSLT-ZERO 9151 L1CA4: RST 28H ;; FP-CALC 9152 DEFB $02 ;;delete 9153 DEFB $A0 ;;stk-zero 9154 DEFB $34 ;;end-calc 9155 9156 RET ; return. 9157 9158 9159 ; -------------------------------- 9160 ; THE 'NATURAL LOGARITHM' FUNCTION 9161 ; -------------------------------- 9162 ; (offset $22: 'ln') 9163 ; Like the ZX81 itself, 'natural' logarithms came from Scotland. 9164 ; They were devised in 1614 by well-traveled Scotsman John Napier who noted 9165 ; "Nothing doth more molest and hinder calculators than the multiplications, 9166 ; divisions, square and cubical extractions of great numbers". 9167 ; 9168 ; Napier's logarithms enabled the above operations to be accomplished by 9169 ; simple addition and subtraction simplifying the navigational and 9170 ; astronomical calculations which beset his age. 9171 ; Napier's logarithms were quickly overtaken by logarithms to the base 10 9172 ; devised, in conjunction with Napier, by Henry Briggs a Cambridge-educated 9173 ; professor of Geometry at Oxford University. These simplified the layout 9174 ; of the tables enabling humans to easily scale calculations. 9175 ; 9176 ; It is only recently with the introduction of pocket calculators and 9177 ; computers like the ZX81 that natural logarithms are once more at the fore, 9178 ; although some computers retain logarithms to the base ten. 9179 ; 'Natural' logarithms are powers to the base 'e', which like 'pi' is a 9180 ; naturally occurring number in branches of mathematics. 9181 ; Like 'pi' also, 'e' is an irrational number and starts 2.718281828... 9182 ; 9183 ; The tabular use of logarithms was that to multiply two numbers one looked 9184 ; up their two logarithms in the tables, added them together and then looked 9185 ; for the result in a table of antilogarithms to give the desired product. 9186 ; 9187 ; The EXP function is the BASIC equivalent of a calculator's 'antiln' function 9188 ; and by picking any two numbers, 1.72 and 6.89 say, 9189 ; 10 PRINT EXP ( LN 1.72 + LN 6.89 ) 9190 ; will give just the same result as 9191 ; 20 PRINT 1.72 * 6.89. 9192 ; Division is accomplished by subtracting the two logs. 9193 ; 9194 ; Napier also mentioned "square and cubicle extractions". 9195 ; To raise a number to the power 3, find its 'ln', multiply by 3 and find the 9196 ; 'antiln'. e.g. PRINT EXP( LN 4 * 3 ) gives 64. 9197 ; Similarly to find the n'th root divide the logarithm by 'n'. 9198 ; The ZX81 ROM used PRINT EXP ( LN 9 / 2 ) to find the square root of the 9199 ; number 9. The Napieran square root function is just a special case of 9200 ; the 'to_power' function. A cube root or indeed any root/power would be just 9201 ; as simple. 9202 9203 ; First test that the argument to LN is a positive, non-zero number. 9204 9205 ;; ln 9206 L1CA9: RST 28H ;; FP-CALC 9207 DEFB $2D ;;duplicate 9208 DEFB $33 ;;greater-0 9209 DEFB $00 ;;jump-true 9210 DEFB $04 ;;to L1CB1, VALID 9211 9212 DEFB $34 ;;end-calc 9213 9214 9215 ;; REPORT-Ab 9216 L1CAF: RST 08H ; ERROR-1 9217 DEFB $09 ; Error Report: Invalid argument 9218 9219 ;; VALID 9220 L1CB1: DEFB $A0 ;;stk-zero Note. not 9221 DEFB $02 ;;delete necessary. 9222 DEFB $34 ;;end-calc 9223 LD A,(HL) ; 9224 9225 LD (HL),$80 ; 9226 CALL L151D ; routine STACK-A 9227 9228 RST 28H ;; FP-CALC 9229 DEFB $30 ;;stk-data 9230 DEFB $38 ;;Exponent: $88, Bytes: 1 9231 DEFB $00 ;;(+00,+00,+00) 9232 DEFB $03 ;;subtract 9233 DEFB $01 ;;exchange 9234 DEFB $2D ;;duplicate 9235 DEFB $30 ;;stk-data 9236 DEFB $F0 ;;Exponent: $80, Bytes: 4 9237 DEFB $4C,$CC,$CC,$CD ;; 9238 DEFB $03 ;;subtract 9239 DEFB $33 ;;greater-0 9240 DEFB $00 ;;jump-true 9241 DEFB $08 ;;to L1CD2, GRE.8 9242 9243 DEFB $01 ;;exchange 9244 DEFB $A1 ;;stk-one 9245 DEFB $03 ;;subtract 9246 DEFB $01 ;;exchange 9247 DEFB $34 ;;end-calc 9248 9249 INC (HL) ; 9250 9251 RST 28H ;; FP-CALC 9252 9253 ;; GRE.8 9254 L1CD2: DEFB $01 ;;exchange 9255 DEFB $30 ;;stk-data 9256 DEFB $F0 ;;Exponent: $80, Bytes: 4 9257 DEFB $31,$72,$17,$F8 ;; 9258 DEFB $04 ;;multiply 9259 DEFB $01 ;;exchange 9260 DEFB $A2 ;;stk-half 9261 DEFB $03 ;;subtract 9262 DEFB $A2 ;;stk-half 9263 DEFB $03 ;;subtract 9264 DEFB $2D ;;duplicate 9265 DEFB $30 ;;stk-data 9266 DEFB $32 ;;Exponent: $82, Bytes: 1 9267 DEFB $20 ;;(+00,+00,+00) 9268 DEFB $04 ;;multiply 9269 DEFB $A2 ;;stk-half 9270 DEFB $03 ;;subtract 9271 DEFB $8C ;;series-0C 9272 DEFB $11 ;;Exponent: $61, Bytes: 1 9273 DEFB $AC ;;(+00,+00,+00) 9274 DEFB $14 ;;Exponent: $64, Bytes: 1 9275 DEFB $09 ;;(+00,+00,+00) 9276 DEFB $56 ;;Exponent: $66, Bytes: 2 9277 DEFB $DA,$A5 ;;(+00,+00) 9278 DEFB $59 ;;Exponent: $69, Bytes: 2 9279 DEFB $30,$C5 ;;(+00,+00) 9280 DEFB $5C ;;Exponent: $6C, Bytes: 2 9281 DEFB $90,$AA ;;(+00,+00) 9282 DEFB $9E ;;Exponent: $6E, Bytes: 3 9283 DEFB $70,$6F,$61 ;;(+00) 9284 DEFB $A1 ;;Exponent: $71, Bytes: 3 9285 DEFB $CB,$DA,$96 ;;(+00) 9286 DEFB $A4 ;;Exponent: $74, Bytes: 3 9287 DEFB $31,$9F,$B4 ;;(+00) 9288 DEFB $E7 ;;Exponent: $77, Bytes: 4 9289 DEFB $A0,$FE,$5C,$FC ;; 9290 DEFB $EA ;;Exponent: $7A, Bytes: 4 9291 DEFB $1B,$43,$CA,$36 ;; 9292 DEFB $ED ;;Exponent: $7D, Bytes: 4 9293 DEFB $A7,$9C,$7E,$5E ;; 9294 DEFB $F0 ;;Exponent: $80, Bytes: 4 9295 DEFB $6E,$23,$80,$93 ;; 9296 DEFB $04 ;;multiply 9297 DEFB $0F ;;addition 9298 DEFB $34 ;;end-calc 9299 9300 RET ; return. 9301 9302 ; ----------------------------- 9303 ; THE 'TRIGONOMETRIC' FUNCTIONS 9304 ; ----------------------------- 9305 ; Trigonometry is rocket science. It is also used by carpenters and pyramid 9306 ; builders. 9307 ; Some uses can be quite abstract but the principles can be seen in simple 9308 ; right-angled triangles. Triangles have some special properties - 9309 ; 9310 ; 1) The sum of the three angles is always PI radians (180 degrees). 9311 ; Very helpful if you know two angles and wish to find the third. 9312 ; 2) In any right-angled triangle the sum of the squares of the two shorter 9313 ; sides is equal to the square of the longest side opposite the right-angle. 9314 ; Very useful if you know the length of two sides and wish to know the 9315 ; length of the third side. 9316 ; 3) Functions sine, cosine and tangent enable one to calculate the length 9317 ; of an unknown side when the length of one other side and an angle is 9318 ; known. 9319 ; 4) Functions arcsin, arccosine and arctan enable one to calculate an unknown 9320 ; angle when the length of two of the sides is known. 9321 9322 ; -------------------------------- 9323 ; THE 'REDUCE ARGUMENT' SUBROUTINE 9324 ; -------------------------------- 9325 ; (offset $35: 'get-argt') 9326 ; 9327 ; This routine performs two functions on the angle, in radians, that forms 9328 ; the argument to the sine and cosine functions. 9329 ; First it ensures that the angle 'wraps round'. That if a ship turns through 9330 ; an angle of, say, 3*PI radians (540 degrees) then the net effect is to turn 9331 ; through an angle of PI radians (180 degrees). 9332 ; Secondly it converts the angle in radians to a fraction of a right angle, 9333 ; depending within which quadrant the angle lies, with the periodicity 9334 ; resembling that of the desired sine value. 9335 ; The result lies in the range -1 to +1. 9336 ; 9337 ; 90 deg. 9338 ; 9339 ; (pi/2) 9340 ; II +1 I 9341 ; | 9342 ; sin+ |\ | /| sin+ 9343 ; cos- | \ | / | cos+ 9344 ; tan- | \ | / | tan+ 9345 ; | \|/) | 9346 ; 180 deg. (pi) 0 -|----+----|-- 0 (0) 0 degrees 9347 ; | /|\ | 9348 ; sin- | / | \ | sin- 9349 ; cos- | / | \ | cos+ 9350 ; tan+ |/ | \| tan- 9351 ; | 9352 ; III -1 IV 9353 ; (3pi/2) 9354 ; 9355 ; 270 deg. 9356 9357 9358 ;; get-argt 9359 L1D18: RST 28H ;; FP-CALC X. 9360 DEFB $30 ;;stk-data 9361 DEFB $EE ;;Exponent: $7E, 9362 ;;Bytes: 4 9363 DEFB $22,$F9,$83,$6E ;; X, 1/(2*PI) 9364 DEFB $04 ;;multiply X/(2*PI) = fraction 9365 9366 DEFB $2D ;;duplicate 9367 DEFB $A2 ;;stk-half 9368 DEFB $0F ;;addition 9369 DEFB $24 ;;int 9370 9371 DEFB $03 ;;subtract now range -.5 to .5 9372 9373 DEFB $2D ;;duplicate 9374 DEFB $0F ;;addition now range -1 to 1. 9375 DEFB $2D ;;duplicate 9376 DEFB $0F ;;addition now range -2 to 2. 9377 9378 ; quadrant I (0 to +1) and quadrant IV (-1 to 0) are now correct. 9379 ; quadrant II ranges +1 to +2. 9380 ; quadrant III ranges -2 to -1. 9381 9382 DEFB $2D ;;duplicate Y, Y. 9383 DEFB $27 ;;abs Y, abs(Y). range 1 to 2 9384 DEFB $A1 ;;stk-one Y, abs(Y), 1. 9385 DEFB $03 ;;subtract Y, abs(Y)-1. range 0 to 1 9386 DEFB $2D ;;duplicate Y, Z, Z. 9387 DEFB $33 ;;greater-0 Y, Z, (1/0). 9388 9389 DEFB $C0 ;;st-mem-0 store as possible sign 9390 ;; for cosine function. 9391 9392 DEFB $00 ;;jump-true 9393 DEFB $04 ;;to L1D35, ZPLUS with quadrants II and III 9394 9395 ; else the angle lies in quadrant I or IV and value Y is already correct. 9396 9397 DEFB $02 ;;delete Y delete test value. 9398 DEFB $34 ;;end-calc Y. 9399 9400 RET ; return. with Q1 and Q4 >>> 9401 9402 ; The branch was here with quadrants II (0 to 1) and III (1 to 0). 9403 ; Y will hold -2 to -1 if this is quadrant III. 9404 9405 ;; ZPLUS 9406 L1D35: DEFB $A1 ;;stk-one Y, Z, 1 9407 DEFB $03 ;;subtract Y, Z-1. Q3 = 0 to -1 9408 DEFB $01 ;;exchange Z-1, Y. 9409 DEFB $32 ;;less-0 Z-1, (1/0). 9410 DEFB $00 ;;jump-true Z-1. 9411 DEFB $02 ;;to L1D3C, YNEG 9412 ;;if angle in quadrant III 9413 9414 ; else angle is within quadrant II (-1 to 0) 9415 9416 DEFB $18 ;;negate range +1 to 0 9417 9418 9419 ;; YNEG 9420 L1D3C: DEFB $34 ;;end-calc quadrants II and III correct. 9421 9422 RET ; return. 9423 9424 9425 ; --------------------- 9426 ; THE 'COSINE' FUNCTION 9427 ; --------------------- 9428 ; (offset $1D: 'cos') 9429 ; Cosines are calculated as the sine of the opposite angle rectifying the 9430 ; sign depending on the quadrant rules. 9431 ; 9432 ; 9433 ; /| 9434 ; h /y| 9435 ; / |o 9436 ; /x | 9437 ; /----| 9438 ; a 9439 ; 9440 ; The cosine of angle x is the adjacent side (a) divided by the hypotenuse 1. 9441 ; However if we examine angle y then a/h is the sine of that angle. 9442 ; Since angle x plus angle y equals a right-angle, we can find angle y by 9443 ; subtracting angle x from pi/2. 9444 ; However it's just as easy to reduce the argument first and subtract the 9445 ; reduced argument from the value 1 (a reduced right-angle). 9446 ; It's even easier to subtract 1 from the angle and rectify the sign. 9447 ; In fact, after reducing the argument, the absolute value of the argument 9448 ; is used and rectified using the test result stored in mem-0 by 'get-argt' 9449 ; for that purpose. 9450 9451 ;; cos 9452 L1D3E: RST 28H ;; FP-CALC angle in radians. 9453 DEFB $35 ;;get-argt X reduce -1 to +1 9454 9455 DEFB $27 ;;abs ABS X 0 to 1 9456 DEFB $A1 ;;stk-one ABS X, 1. 9457 DEFB $03 ;;subtract now opposite angle 9458 ;; though negative sign. 9459 DEFB $E0 ;;get-mem-0 fetch sign indicator. 9460 DEFB $00 ;;jump-true 9461 DEFB $06 ;;fwd to L1D4B, C-ENT 9462 ;;forward to common code if in QII or QIII 9463 9464 9465 DEFB $18 ;;negate else make positive. 9466 DEFB $2F ;;jump 9467 DEFB $03 ;;fwd to L1D4B, C-ENT 9468 ;;with quadrants QI and QIV 9469 9470 ; ------------------- 9471 ; THE 'SINE' FUNCTION 9472 ; ------------------- 9473 ; (offset $1C: 'sin') 9474 ; This is a fundamental transcendental function from which others such as cos 9475 ; and tan are directly, or indirectly, derived. 9476 ; It uses the series generator to produce Chebyshev polynomials. 9477 ; 9478 ; 9479 ; /| 9480 ; 1 / | 9481 ; / |x 9482 ; /a | 9483 ; /----| 9484 ; y 9485 ; 9486 ; The 'get-argt' function is designed to modify the angle and its sign 9487 ; in line with the desired sine value and afterwards it can launch straight 9488 ; into common code. 9489 9490 ;; sin 9491 L1D49: RST 28H ;; FP-CALC angle in radians 9492 DEFB $35 ;;get-argt reduce - sign now correct. 9493 9494 ;; C-ENT 9495 L1D4B: DEFB $2D ;;duplicate 9496 DEFB $2D ;;duplicate 9497 DEFB $04 ;;multiply 9498 DEFB $2D ;;duplicate 9499 DEFB $0F ;;addition 9500 DEFB $A1 ;;stk-one 9501 DEFB $03 ;;subtract 9502 9503 DEFB $86 ;;series-06 9504 DEFB $14 ;;Exponent: $64, Bytes: 1 9505 DEFB $E6 ;;(+00,+00,+00) 9506 DEFB $5C ;;Exponent: $6C, Bytes: 2 9507 DEFB $1F,$0B ;;(+00,+00) 9508 DEFB $A3 ;;Exponent: $73, Bytes: 3 9509 DEFB $8F,$38,$EE ;;(+00) 9510 DEFB $E9 ;;Exponent: $79, Bytes: 4 9511 DEFB $15,$63,$BB,$23 ;; 9512 DEFB $EE ;;Exponent: $7E, Bytes: 4 9513 DEFB $92,$0D,$CD,$ED ;; 9514 DEFB $F1 ;;Exponent: $81, Bytes: 4 9515 DEFB $23,$5D,$1B,$EA ;; 9516 9517 DEFB $04 ;;multiply 9518 DEFB $34 ;;end-calc 9519 9520 RET ; return. 9521 9522 9523 ; ---------------------- 9524 ; THE 'TANGENT' FUNCTION 9525 ; ---------------------- 9526 ; (offset $1E: 'tan') 9527 ; 9528 ; Evaluates tangent x as sin(x) / cos(x). 9529 ; 9530 ; 9531 ; /| 9532 ; h / | 9533 ; / |o 9534 ; /x | 9535 ; /----| 9536 ; a 9537 ; 9538 ; The tangent of angle x is the ratio of the length of the opposite side 9539 ; divided by the length of the adjacent side. As the opposite length can 9540 ; be calculates using sin(x) and the adjacent length using cos(x) then 9541 ; the tangent can be defined in terms of the previous two functions. 9542 9543 ; Error 6 if the argument, in radians, is too close to one like pi/2 9544 ; which has an infinite tangent. e.g. PRINT TAN (PI/2) evaluates as 1/0. 9545 ; Similarly PRINT TAN (3*PI/2), TAN (5*PI/2) etc. 9546 9547 ;; tan 9548 L1D6E: RST 28H ;; FP-CALC x. 9549 DEFB $2D ;;duplicate x, x. 9550 DEFB $1C ;;sin x, sin x. 9551 DEFB $01 ;;exchange sin x, x. 9552 DEFB $1D ;;cos sin x, cos x. 9553 DEFB $05 ;;division sin x/cos x (= tan x). 9554 DEFB $34 ;;end-calc tan x. 9555 9556 RET ; return. 9557 9558 ; --------------------- 9559 ; THE 'ARCTAN' FUNCTION 9560 ; --------------------- 9561 ; (Offset $21: 'atn') 9562 ; The inverse tangent function with the result in radians. 9563 ; This is a fundamental transcendental function from which others such as 9564 ; asn and acs are directly, or indirectly, derived. 9565 ; It uses the series generator to produce Chebyshev polynomials. 9566 9567 ;; atn 9568 L1D76: LD A,(HL) ; fetch exponent 9569 CP $81 ; compare to that for 'one' 9570 JR C,L1D89 ; forward, if less, to SMALL 9571 9572 RST 28H ;; FP-CALC X. 9573 DEFB $A1 ;;stk-one 9574 DEFB $18 ;;negate 9575 DEFB $01 ;;exchange 9576 DEFB $05 ;;division 9577 DEFB $2D ;;duplicate 9578 DEFB $32 ;;less-0 9579 DEFB $A3 ;;stk-pi/2 9580 DEFB $01 ;;exchange 9581 DEFB $00 ;;jump-true 9582 DEFB $06 ;;to L1D8B, CASES 9583 9584 DEFB $18 ;;negate 9585 DEFB $2F ;;jump 9586 DEFB $03 ;;to L1D8B, CASES 9587 9588 ; --- 9589 9590 ;; SMALL 9591 L1D89: RST 28H ;; FP-CALC 9592 DEFB $A0 ;;stk-zero 9593 9594 ;; CASES 9595 L1D8B: DEFB $01 ;;exchange 9596 DEFB $2D ;;duplicate 9597 DEFB $2D ;;duplicate 9598 DEFB $04 ;;multiply 9599 DEFB $2D ;;duplicate 9600 DEFB $0F ;;addition 9601 DEFB $A1 ;;stk-one 9602 DEFB $03 ;;subtract 9603 9604 DEFB $8C ;;series-0C 9605 DEFB $10 ;;Exponent: $60, Bytes: 1 9606 DEFB $B2 ;;(+00,+00,+00) 9607 DEFB $13 ;;Exponent: $63, Bytes: 1 9608 DEFB $0E ;;(+00,+00,+00) 9609 DEFB $55 ;;Exponent: $65, Bytes: 2 9610 DEFB $E4,$8D ;;(+00,+00) 9611 DEFB $58 ;;Exponent: $68, Bytes: 2 9612 DEFB $39,$BC ;;(+00,+00) 9613 DEFB $5B ;;Exponent: $6B, Bytes: 2 9614 DEFB $98,$FD ;;(+00,+00) 9615 DEFB $9E ;;Exponent: $6E, Bytes: 3 9616 DEFB $00,$36,$75 ;;(+00) 9617 DEFB $A0 ;;Exponent: $70, Bytes: 3 9618 DEFB $DB,$E8,$B4 ;;(+00) 9619 DEFB $63 ;;Exponent: $73, Bytes: 2 9620 DEFB $42,$C4 ;;(+00,+00) 9621 DEFB $E6 ;;Exponent: $76, Bytes: 4 9622 DEFB $B5,$09,$36,$BE ;; 9623 DEFB $E9 ;;Exponent: $79, Bytes: 4 9624 DEFB $36,$73,$1B,$5D ;; 9625 DEFB $EC ;;Exponent: $7C, Bytes: 4 9626 DEFB $D8,$DE,$63,$BE ;; 9627 DEFB $F0 ;;Exponent: $80, Bytes: 4 9628 DEFB $61,$A1,$B3,$0C ;; 9629 9630 DEFB $04 ;;multiply 9631 DEFB $0F ;;addition 9632 DEFB $34 ;;end-calc 9633 9634 RET ; return. 9635 9636 9637 ; --------------------- 9638 ; THE 'ARCSIN' FUNCTION 9639 ; --------------------- 9640 ; (Offset $1F: 'asn') 9641 ; The inverse sine function with result in radians. 9642 ; Derived from arctan function above. 9643 ; Error A unless the argument is between -1 and +1 inclusive. 9644 ; Uses an adaptation of the formula asn(x) = atn(x/sqr(1-x*x)) 9645 ; 9646 ; 9647 ; /| 9648 ; / | 9649 ; 1/ |x 9650 ; /a | 9651 ; /----| 9652 ; y 9653 ; 9654 ; e.g. We know the opposite side (x) and hypotenuse (1) 9655 ; and we wish to find angle a in radians. 9656 ; We can derive length y by Pythagoras and then use ATN instead. 9657 ; Since y*y + x*x = 1*1 (Pythagoras Theorem) then 9658 ; y=sqr(1-x*x) - no need to multiply 1 by itself. 9659 ; So, asn(a) = atn(x/y) 9660 ; or more fully, 9661 ; asn(a) = atn(x/sqr(1-x*x)) 9662 9663 ; Close but no cigar. 9664 9665 ; While PRINT ATN (x/SQR (1-x*x)) gives the same results as PRINT ASN x, 9666 ; it leads to division by zero when x is 1 or -1. 9667 ; To overcome this, 1 is added to y giving half the required angle and the 9668 ; result is then doubled. 9669 ; That is, PRINT ATN (x/(SQR (1-x*x) +1)) *2 9670 ; 9671 ; 9672 ; . /| 9673 ; . c/ | 9674 ; . /1 |x 9675 ; . c b /a | 9676 ; ---------/----| 9677 ; 1 y 9678 ; 9679 ; By creating an isosceles triangle with two equal sides of 1, angles c and 9680 ; c are also equal. If b+c+d = 180 degrees and b+a = 180 degrees then c=a/2. 9681 ; 9682 ; A value higher than 1 gives the required error as attempting to find the 9683 ; square root of a negative number generates an error in Sinclair BASIC. 9684 9685 ;; asn 9686 L1DC4: RST 28H ;; FP-CALC x. 9687 DEFB $2D ;;duplicate x, x. 9688 DEFB $2D ;;duplicate x, x, x. 9689 DEFB $04 ;;multiply x, x*x. 9690 DEFB $A1 ;;stk-one x, x*x, 1. 9691 DEFB $03 ;;subtract x, x*x-1. 9692 DEFB $18 ;;negate x, 1-x*x. 9693 DEFB $25 ;;sqr x, sqr(1-x*x) = y. 9694 DEFB $A1 ;;stk-one x, y, 1. 9695 DEFB $0F ;;addition x, y+1. 9696 DEFB $05 ;;division x/y+1. 9697 DEFB $21 ;;atn a/2 (half the angle) 9698 DEFB $2D ;;duplicate a/2, a/2. 9699 DEFB $0F ;;addition a. 9700 DEFB $34 ;;end-calc a. 9701 9702 RET ; return. 9703 9704 9705 ; ------------------------ 9706 ; THE 'ARCCOS' FUNCTION 9707 ; ------------------------ 9708 ; (Offset $20: 'acs') 9709 ; The inverse cosine function with the result in radians. 9710 ; Error A unless the argument is between -1 and +1. 9711 ; Result in range 0 to pi. 9712 ; Derived from asn above which is in turn derived from the preceding atn. It 9713 ; could have been derived directly from atn using acs(x) = atn(sqr(1-x*x)/x). 9714 ; However, as sine and cosine are horizontal translations of each other, 9715 ; uses acs(x) = pi/2 - asn(x) 9716 9717 ; e.g. the arccosine of a known x value will give the required angle b in 9718 ; radians. 9719 ; We know, from above, how to calculate the angle a using asn(x). 9720 ; Since the three angles of any triangle add up to 180 degrees, or pi radians, 9721 ; and the largest angle in this case is a right-angle (pi/2 radians), then 9722 ; we can calculate angle b as pi/2 (both angles) minus asn(x) (angle a). 9723 ; 9724 ; 9725 ; /| 9726 ; 1 /b| 9727 ; / |x 9728 ; /a | 9729 ; /----| 9730 ; y 9731 9732 ;; acs 9733 L1DD4: RST 28H ;; FP-CALC x. 9734 DEFB $1F ;;asn asn(x). 9735 DEFB $A3 ;;stk-pi/2 asn(x), pi/2. 9736 DEFB $03 ;;subtract asn(x) - pi/2. 9737 DEFB $18 ;;negate pi/2 - asn(x) = acs(x). 9738 DEFB $34 ;;end-calc acs(x) 9739 9740 RET ; return. 9741 9742 9743 ; -------------------------- 9744 ; THE 'SQUARE ROOT' FUNCTION 9745 ; -------------------------- 9746 ; (Offset $25: 'sqr') 9747 ; Error A if argument is negative. 9748 ; This routine is remarkable for its brevity - 7 bytes. 9749 ; The ZX81 code was originally 9K and various techniques had to be 9750 ; used to shoe-horn it into an 8K Rom chip. 9751 9752 9753 ;; sqr 9754 L1DDB: RST 28H ;; FP-CALC x. 9755 DEFB $2D ;;duplicate x, x. 9756 DEFB $2C ;;not x, 1/0 9757 DEFB $00 ;;jump-true x, (1/0). 9758 DEFB $1E ;;to L1DFD, LAST exit if argument zero 9759 ;; with zero result. 9760 9761 ; else continue to calculate as x ** .5 9762 9763 DEFB $A2 ;;stk-half x, .5. 9764 DEFB $34 ;;end-calc x, .5. 9765 9766 9767 ; ------------------------------ 9768 ; THE 'EXPONENTIATION' OPERATION 9769 ; ------------------------------ 9770 ; (Offset $06: 'to-power') 9771 ; This raises the first number X to the power of the second number Y. 9772 ; As with the ZX80, 9773 ; 0 ** 0 = 1 9774 ; 0 ** +n = 0 9775 ; 0 ** -n = arithmetic overflow. 9776 9777 ;; to-power 9778 L1DE2: RST 28H ;; FP-CALC X,Y. 9779 DEFB $01 ;;exchange Y,X. 9780 DEFB $2D ;;duplicate Y,X,X. 9781 DEFB $2C ;;not Y,X,(1/0). 9782 DEFB $00 ;;jump-true 9783 DEFB $07 ;;forward to L1DEE, XISO if X is zero. 9784 9785 ; else X is non-zero. function 'ln' will catch a negative value of X. 9786 9787 DEFB $22 ;;ln Y, LN X. 9788 DEFB $04 ;;multiply Y * LN X 9789 DEFB $34 ;;end-calc 9790 9791 JP L1C5B ; jump back to EXP routine. -> 9792 9793 ; --- 9794 9795 ; These routines form the three simple results when the number is zero. 9796 ; begin by deleting the known zero to leave Y the power factor. 9797 9798 ;; XISO 9799 L1DEE: DEFB $02 ;;delete Y. 9800 DEFB $2D ;;duplicate Y, Y. 9801 DEFB $2C ;;not Y, (1/0). 9802 DEFB $00 ;;jump-true 9803 DEFB $09 ;;forward to L1DFB, ONE if Y is zero. 9804 9805 ; the power factor is not zero. If negative then an error exists. 9806 9807 DEFB $A0 ;;stk-zero Y, 0. 9808 DEFB $01 ;;exchange 0, Y. 9809 DEFB $33 ;;greater-0 0, (1/0). 9810 DEFB $00 ;;jump-true 0 9811 DEFB $06 ;;to L1DFD, LAST if Y was any positive 9812 ;; number. 9813 9814 ; else force division by zero thereby raising an Arithmetic overflow error. 9815 ; There are some one and two-byte alternatives but perhaps the most formal 9816 ; might have been to use end-calc; rst 08; defb 05. 9817 9818 DEFB $A1 ;;stk-one 0, 1. 9819 DEFB $01 ;;exchange 1, 0. 9820 DEFB $05 ;;division 1/0 >> error 9821 9822 ; --- 9823 9824 ;; ONE 9825 L1DFB: DEFB $02 ;;delete . 9826 DEFB $A1 ;;stk-one 1. 9827 9828 ;; LAST 9829 L1DFD: DEFB $34 ;;end-calc last value 1 or 0. 9830 9831 RET ; return. 9832 9833 ; --------------------- 9834 ; THE 'SPARE LOCATIONS' 9835 ; --------------------- 9836 9837 ;; SPARE 9838 L1DFF: DEFB $FF ; That's all folks. 9839 9840 9841 9842 ; ------------------------ 9843 ; THE 'ZX81 CHARACTER SET' 9844 ; ------------------------ 9845 9846 ;; char-set - begins with space character. 9847 9848 ; $00 - Character: ' ' CHR$(0) 9849 9850 L1E00: DEFB %00000000 9851 DEFB %00000000 9852 DEFB %00000000 9853 DEFB %00000000 9854 DEFB %00000000 9855 DEFB %00000000 9856 DEFB %00000000 9857 DEFB %00000000 9858 9859 ; $01 - Character: mosaic CHR$(1) 9860 9861 DEFB %11110000 9862 DEFB %11110000 9863 DEFB %11110000 9864 DEFB %11110000 9865 DEFB %00000000 9866 DEFB %00000000 9867 DEFB %00000000 9868 DEFB %00000000 9869 9870 9871 ; $02 - Character: mosaic CHR$(2) 9872 9873 DEFB %00001111 9874 DEFB %00001111 9875 DEFB %00001111 9876 DEFB %00001111 9877 DEFB %00000000 9878 DEFB %00000000 9879 DEFB %00000000 9880 DEFB %00000000 9881 9882 9883 ; $03 - Character: mosaic CHR$(3) 9884 9885 DEFB %11111111 9886 DEFB %11111111 9887 DEFB %11111111 9888 DEFB %11111111 9889 DEFB %00000000 9890 DEFB %00000000 9891 DEFB %00000000 9892 DEFB %00000000 9893 9894 ; $04 - Character: mosaic CHR$(4) 9895 9896 DEFB %00000000 9897 DEFB %00000000 9898 DEFB %00000000 9899 DEFB %00000000 9900 DEFB %11110000 9901 DEFB %11110000 9902 DEFB %11110000 9903 DEFB %11110000 9904 9905 ; $05 - Character: mosaic CHR$(1) 9906 9907 DEFB %11110000 9908 DEFB %11110000 9909 DEFB %11110000 9910 DEFB %11110000 9911 DEFB %11110000 9912 DEFB %11110000 9913 DEFB %11110000 9914 DEFB %11110000 9915 9916 ; $06 - Character: mosaic CHR$(1) 9917 9918 DEFB %00001111 9919 DEFB %00001111 9920 DEFB %00001111 9921 DEFB %00001111 9922 DEFB %11110000 9923 DEFB %11110000 9924 DEFB %11110000 9925 DEFB %11110000 9926 9927 ; $07 - Character: mosaic CHR$(1) 9928 9929 DEFB %11111111 9930 DEFB %11111111 9931 DEFB %11111111 9932 DEFB %11111111 9933 DEFB %11110000 9934 DEFB %11110000 9935 DEFB %11110000 9936 DEFB %11110000 9937 9938 ; $08 - Character: mosaic CHR$(1) 9939 9940 DEFB %10101010 9941 DEFB %01010101 9942 DEFB %10101010 9943 DEFB %01010101 9944 DEFB %10101010 9945 DEFB %01010101 9946 DEFB %10101010 9947 DEFB %01010101 9948 9949 ; $09 - Character: mosaic CHR$(1) 9950 9951 DEFB %00000000 9952 DEFB %00000000 9953 DEFB %00000000 9954 DEFB %00000000 9955 DEFB %10101010 9956 DEFB %01010101 9957 DEFB %10101010 9958 DEFB %01010101 9959 9960 ; $0A - Character: mosaic CHR$(10) 9961 9962 DEFB %10101010 9963 DEFB %01010101 9964 DEFB %10101010 9965 DEFB %01010101 9966 DEFB %00000000 9967 DEFB %00000000 9968 DEFB %00000000 9969 DEFB %00000000 9970 9971 ; $0B - Character: '"' CHR$(11) 9972 9973 DEFB %00000000 9974 DEFB %00100100 9975 DEFB %00100100 9976 DEFB %00000000 9977 DEFB %00000000 9978 DEFB %00000000 9979 DEFB %00000000 9980 DEFB %00000000 9981 9982 ; $0B - Character: ukp CHR$(12) 9983 9984 DEFB %00000000 9985 DEFB %00011100 9986 DEFB %00100010 9987 DEFB %01111000 9988 DEFB %00100000 9989 DEFB %00100000 9990 DEFB %01111110 9991 DEFB %00000000 9992 9993 ; $0B - Character: '$' CHR$(13) 9994 9995 DEFB %00000000 9996 DEFB %00001000 9997 DEFB %00111110 9998 DEFB %00101000 9999 DEFB %00111110 10000 DEFB %00001010 10001 DEFB %00111110 10002 DEFB %00001000 10003 10004 ; $0B - Character: ':' CHR$(14) 10005 10006 DEFB %00000000 10007 DEFB %00000000 10008 DEFB %00000000 10009 DEFB %00010000 10010 DEFB %00000000 10011 DEFB %00000000 10012 DEFB %00010000 10013 DEFB %00000000 10014 10015 ; $0B - Character: '?' CHR$(15) 10016 10017 DEFB %00000000 10018 DEFB %00111100 10019 DEFB %01000010 10020 DEFB %00000100 10021 DEFB %00001000 10022 DEFB %00000000 10023 DEFB %00001000 10024 DEFB %00000000 10025 10026 ; $10 - Character: '(' CHR$(16) 10027 10028 DEFB %00000000 10029 DEFB %00000100 10030 DEFB %00001000 10031 DEFB %00001000 10032 DEFB %00001000 10033 DEFB %00001000 10034 DEFB %00000100 10035 DEFB %00000000 10036 10037 ; $11 - Character: ')' CHR$(17) 10038 10039 DEFB %00000000 10040 DEFB %00100000 10041 DEFB %00010000 10042 DEFB %00010000 10043 DEFB %00010000 10044 DEFB %00010000 10045 DEFB %00100000 10046 DEFB %00000000 10047 10048 ; $12 - Character: '>' CHR$(18) 10049 10050 DEFB %00000000 10051 DEFB %00000000 10052 DEFB %00010000 10053 DEFB %00001000 10054 DEFB %00000100 10055 DEFB %00001000 10056 DEFB %00010000 10057 DEFB %00000000 10058 10059 ; $13 - Character: '<' CHR$(19) 10060 10061 DEFB %00000000 10062 DEFB %00000000 10063 DEFB %00000100 10064 DEFB %00001000 10065 DEFB %00010000 10066 DEFB %00001000 10067 DEFB %00000100 10068 DEFB %00000000 10069 10070 ; $14 - Character: '=' CHR$(20) 10071 10072 DEFB %00000000 10073 DEFB %00000000 10074 DEFB %00000000 10075 DEFB %00111110 10076 DEFB %00000000 10077 DEFB %00111110 10078 DEFB %00000000 10079 DEFB %00000000 10080 10081 ; $15 - Character: '+' CHR$(21) 10082 10083 DEFB %00000000 10084 DEFB %00000000 10085 DEFB %00001000 10086 DEFB %00001000 10087 DEFB %00111110 10088 DEFB %00001000 10089 DEFB %00001000 10090 DEFB %00000000 10091 10092 ; $16 - Character: '-' CHR$(22) 10093 10094 DEFB %00000000 10095 DEFB %00000000 10096 DEFB %00000000 10097 DEFB %00000000 10098 DEFB %00111110 10099 DEFB %00000000 10100 DEFB %00000000 10101 DEFB %00000000 10102 10103 ; $17 - Character: '*' CHR$(23) 10104 10105 DEFB %00000000 10106 DEFB %00000000 10107 DEFB %00010100 10108 DEFB %00001000 10109 DEFB %00111110 10110 DEFB %00001000 10111 DEFB %00010100 10112 DEFB %00000000 10113 10114 ; $18 - Character: '/' CHR$(24) 10115 10116 DEFB %00000000 10117 DEFB %00000000 10118 DEFB %00000010 10119 DEFB %00000100 10120 DEFB %00001000 10121 DEFB %00010000 10122 DEFB %00100000 10123 DEFB %00000000 10124 10125 ; $19 - Character: ';' CHR$(25) 10126 10127 DEFB %00000000 10128 DEFB %00000000 10129 DEFB %00010000 10130 DEFB %00000000 10131 DEFB %00000000 10132 DEFB %00010000 10133 DEFB %00010000 10134 DEFB %00100000 10135 10136 ; $1A - Character: ',' CHR$(26) 10137 10138 DEFB %00000000 10139 DEFB %00000000 10140 DEFB %00000000 10141 DEFB %00000000 10142 DEFB %00000000 10143 DEFB %00001000 10144 DEFB %00001000 10145 DEFB %00010000 10146 10147 ; $1B - Character: '"' CHR$(27) 10148 10149 DEFB %00000000 10150 DEFB %00000000 10151 DEFB %00000000 10152 DEFB %00000000 10153 DEFB %00000000 10154 DEFB %00011000 10155 DEFB %00011000 10156 DEFB %00000000 10157 10158 ; $1C - Character: '0' CHR$(28) 10159 10160 DEFB %00000000 10161 DEFB %00111100 10162 DEFB %01000110 10163 DEFB %01001010 10164 DEFB %01010010 10165 DEFB %01100010 10166 DEFB %00111100 10167 DEFB %00000000 10168 10169 ; $1D - Character: '1' CHR$(29) 10170 10171 DEFB %00000000 10172 DEFB %00011000 10173 DEFB %00101000 10174 DEFB %00001000 10175 DEFB %00001000 10176 DEFB %00001000 10177 DEFB %00111110 10178 DEFB %00000000 10179 10180 ; $1E - Character: '2' CHR$(30) 10181 10182 DEFB %00000000 10183 DEFB %00111100 10184 DEFB %01000010 10185 DEFB %00000010 10186 DEFB %00111100 10187 DEFB %01000000 10188 DEFB %01111110 10189 DEFB %00000000 10190 10191 ; $1F - Character: '3' CHR$(31) 10192 10193 DEFB %00000000 10194 DEFB %00111100 10195 DEFB %01000010 10196 DEFB %00001100 10197 DEFB %00000010 10198 DEFB %01000010 10199 DEFB %00111100 10200 DEFB %00000000 10201 10202 ; $20 - Character: '4' CHR$(32) 10203 10204 DEFB %00000000 10205 DEFB %00001000 10206 DEFB %00011000 10207 DEFB %00101000 10208 DEFB %01001000 10209 DEFB %01111110 10210 DEFB %00001000 10211 DEFB %00000000 10212 10213 ; $21 - Character: '5' CHR$(33) 10214 10215 DEFB %00000000 10216 DEFB %01111110 10217 DEFB %01000000 10218 DEFB %01111100 10219 DEFB %00000010 10220 DEFB %01000010 10221 DEFB %00111100 10222 DEFB %00000000 10223 10224 ; $22 - Character: '6' CHR$(34) 10225 10226 DEFB %00000000 10227 DEFB %00111100 10228 DEFB %01000000 10229 DEFB %01111100 10230 DEFB %01000010 10231 DEFB %01000010 10232 DEFB %00111100 10233 DEFB %00000000 10234 10235 ; $23 - Character: '7' CHR$(35) 10236 10237 DEFB %00000000 10238 DEFB %01111110 10239 DEFB %00000010 10240 DEFB %00000100 10241 DEFB %00001000 10242 DEFB %00010000 10243 DEFB %00010000 10244 DEFB %00000000 10245 10246 ; $24 - Character: '8' CHR$(36) 10247 10248 DEFB %00000000 10249 DEFB %00111100 10250 DEFB %01000010 10251 DEFB %00111100 10252 DEFB %01000010 10253 DEFB %01000010 10254 DEFB %00111100 10255 DEFB %00000000 10256 10257 ; $25 - Character: '9' CHR$(37) 10258 10259 DEFB %00000000 10260 DEFB %00111100 10261 DEFB %01000010 10262 DEFB %01000010 10263 DEFB %00111110 10264 DEFB %00000010 10265 DEFB %00111100 10266 DEFB %00000000 10267 10268 ; $26 - Character: 'A' CHR$(38) 10269 10270 DEFB %00000000 10271 DEFB %00111100 10272 DEFB %01000010 10273 DEFB %01000010 10274 DEFB %01111110 10275 DEFB %01000010 10276 DEFB %01000010 10277 DEFB %00000000 10278 10279 ; $27 - Character: 'B' CHR$(39) 10280 10281 DEFB %00000000 10282 DEFB %01111100 10283 DEFB %01000010 10284 DEFB %01111100 10285 DEFB %01000010 10286 DEFB %01000010 10287 DEFB %01111100 10288 DEFB %00000000 10289 10290 ; $28 - Character: 'C' CHR$(40) 10291 10292 DEFB %00000000 10293 DEFB %00111100 10294 DEFB %01000010 10295 DEFB %01000000 10296 DEFB %01000000 10297 DEFB %01000010 10298 DEFB %00111100 10299 DEFB %00000000 10300 10301 ; $29 - Character: 'D' CHR$(41) 10302 10303 DEFB %00000000 10304 DEFB %01111000 10305 DEFB %01000100 10306 DEFB %01000010 10307 DEFB %01000010 10308 DEFB %01000100 10309 DEFB %01111000 10310 DEFB %00000000 10311 10312 ; $2A - Character: 'E' CHR$(42) 10313 10314 DEFB %00000000 10315 DEFB %01111110 10316 DEFB %01000000 10317 DEFB %01111100 10318 DEFB %01000000 10319 DEFB %01000000 10320 DEFB %01111110 10321 DEFB %00000000 10322 10323 ; $2B - Character: 'F' CHR$(43) 10324 10325 DEFB %00000000 10326 DEFB %01111110 10327 DEFB %01000000 10328 DEFB %01111100 10329 DEFB %01000000 10330 DEFB %01000000 10331 DEFB %01000000 10332 DEFB %00000000 10333 10334 ; $2C - Character: 'G' CHR$(44) 10335 10336 DEFB %00000000 10337 DEFB %00111100 10338 DEFB %01000010 10339 DEFB %01000000 10340 DEFB %01001110 10341 DEFB %01000010 10342 DEFB %00111100 10343 DEFB %00000000 10344 10345 ; $2D - Character: 'H' CHR$(45) 10346 10347 DEFB %00000000 10348 DEFB %01000010 10349 DEFB %01000010 10350 DEFB %01111110 10351 DEFB %01000010 10352 DEFB %01000010 10353 DEFB %01000010 10354 DEFB %00000000 10355 10356 ; $2E - Character: 'I' CHR$(46) 10357 10358 DEFB %00000000 10359 DEFB %00111110 10360 DEFB %00001000 10361 DEFB %00001000 10362 DEFB %00001000 10363 DEFB %00001000 10364 DEFB %00111110 10365 DEFB %00000000 10366 10367 ; $2F - Character: 'J' CHR$(47) 10368 10369 DEFB %00000000 10370 DEFB %00000010 10371 DEFB %00000010 10372 DEFB %00000010 10373 DEFB %01000010 10374 DEFB %01000010 10375 DEFB %00111100 10376 DEFB %00000000 10377 10378 ; $30 - Character: 'K' CHR$(48) 10379 10380 DEFB %00000000 10381 DEFB %01000100 10382 DEFB %01001000 10383 DEFB %01110000 10384 DEFB %01001000 10385 DEFB %01000100 10386 DEFB %01000010 10387 DEFB %00000000 10388 10389 ; $31 - Character: 'L' CHR$(49) 10390 10391 DEFB %00000000 10392 DEFB %01000000 10393 DEFB %01000000 10394 DEFB %01000000 10395 DEFB %01000000 10396 DEFB %01000000 10397 DEFB %01111110 10398 DEFB %00000000 10399 10400 ; $32 - Character: 'M' CHR$(50) 10401 10402 DEFB %00000000 10403 DEFB %01000010 10404 DEFB %01100110 10405 DEFB %01011010 10406 DEFB %01000010 10407 DEFB %01000010 10408 DEFB %01000010 10409 DEFB %00000000 10410 10411 ; $33 - Character: 'N' CHR$(51) 10412 10413 DEFB %00000000 10414 DEFB %01000010 10415 DEFB %01100010 10416 DEFB %01010010 10417 DEFB %01001010 10418 DEFB %01000110 10419 DEFB %01000010 10420 DEFB %00000000 10421 10422 ; $34 - Character: 'O' CHR$(52) 10423 10424 DEFB %00000000 10425 DEFB %00111100 10426 DEFB %01000010 10427 DEFB %01000010 10428 DEFB %01000010 10429 DEFB %01000010 10430 DEFB %00111100 10431 DEFB %00000000 10432 10433 ; $35 - Character: 'P' CHR$(53) 10434 10435 DEFB %00000000 10436 DEFB %01111100 10437 DEFB %01000010 10438 DEFB %01000010 10439 DEFB %01111100 10440 DEFB %01000000 10441 DEFB %01000000 10442 DEFB %00000000 10443 10444 ; $36 - Character: 'Q' CHR$(54) 10445 10446 DEFB %00000000 10447 DEFB %00111100 10448 DEFB %01000010 10449 DEFB %01000010 10450 DEFB %01010010 10451 DEFB %01001010 10452 DEFB %00111100 10453 DEFB %00000000 10454 10455 ; $37 - Character: 'R' CHR$(55) 10456 10457 DEFB %00000000 10458 DEFB %01111100 10459 DEFB %01000010 10460 DEFB %01000010 10461 DEFB %01111100 10462 DEFB %01000100 10463 DEFB %01000010 10464 DEFB %00000000 10465 10466 ; $38 - Character: 'S' CHR$(56) 10467 10468 DEFB %00000000 10469 DEFB %00111100 10470 DEFB %01000000 10471 DEFB %00111100 10472 DEFB %00000010 10473 DEFB %01000010 10474 DEFB %00111100 10475 DEFB %00000000 10476 10477 ; $39 - Character: 'T' CHR$(57) 10478 10479 DEFB %00000000 10480 DEFB %11111110 10481 DEFB %00010000 10482 DEFB %00010000 10483 DEFB %00010000 10484 DEFB %00010000 10485 DEFB %00010000 10486 DEFB %00000000 10487 10488 ; $3A - Character: 'U' CHR$(58) 10489 10490 DEFB %00000000 10491 DEFB %01000010 10492 DEFB %01000010 10493 DEFB %01000010 10494 DEFB %01000010 10495 DEFB %01000010 10496 DEFB %00111100 10497 DEFB %00000000 10498 10499 ; $3B - Character: 'V' CHR$(59) 10500 10501 DEFB %00000000 10502 DEFB %01000010 10503 DEFB %01000010 10504 DEFB %01000010 10505 DEFB %01000010 10506 DEFB %00100100 10507 DEFB %00011000 10508 DEFB %00000000 10509 10510 ; $3C - Character: 'W' CHR$(60) 10511 10512 DEFB %00000000 10513 DEFB %01000010 10514 DEFB %01000010 10515 DEFB %01000010 10516 DEFB %01000010 10517 DEFB %01011010 10518 DEFB %00100100 10519 DEFB %00000000 10520 10521 ; $3D - Character: 'X' CHR$(61) 10522 10523 DEFB %00000000 10524 DEFB %01000010 10525 DEFB %00100100 10526 DEFB %00011000 10527 DEFB %00011000 10528 DEFB %00100100 10529 DEFB %01000010 10530 DEFB %00000000 10531 10532 ; $3E - Character: 'Y' CHR$(62) 10533 10534 DEFB %00000000 10535 DEFB %10000010 10536 DEFB %01000100 10537 DEFB %00101000 10538 DEFB %00010000 10539 DEFB %00010000 10540 DEFB %00010000 10541 DEFB %00000000 10542 10543 ; $3F - Character: 'Z' CHR$(63) 10544 10545 DEFB %00000000 10546 DEFB %01111110 10547 DEFB %00000100 10548 DEFB %00001000 10549 DEFB %00010000 10550 DEFB %00100000 10551 DEFB %01111110 10552 DEFB %00000000 10553 10554 .END ;TASM assembler instruction. 10555 10556