zx81.html (417753B)
1 <HTML> 2 <HEAD> 3 <TITLE> 4 Assembly Listing of the Operating System of the Sinclair ZX81. 5 </TITLE> 6 </HEAD> 7 <BODY> 8 <font face = "Courier"> </font> 9 <PRE> 10 ; =========================================================== 11 ; An Assembly Listing of the Operating System of the ZX81 ROM 12 ; =========================================================== 13 ; ------------------------- 14 ; Last updated: 13-DEC-2004 15 ; ------------------------- 16 ; 17 ; Work in progress. 18 ; This file will cross-assemble an original version of the "Improved" 19 ; ZX81 ROM. The file can be modified to change the behaviour of the ROM 20 ; when used in emulators although there is no spare space available. 21 ; 22 ; The documentation is incomplete and if you can find a copy 23 ; of "The Complete Spectrum ROM Disassembly" then many routines 24 ; such as POINTERS and most of the mathematical routines are 25 ; similar and often identical. 26 ; 27 ; I've used the labels from the above book in this file and also 28 ; some from the more elusive Complete ZX81 ROM Disassembly 29 ; by the same publishers, Melbourne House. 30 31 32 #define DEFB .BYTE ; TASM cross-assembler definitions 33 #define DEFW .WORD 34 #define EQU .EQU 35 36 37 ;***************************************** 38 ;** Part 1. RESTART ROUTINES AND TABLES ** 39 ;***************************************** 40 41 ; ----------- 42 ; THE <b><font color=#333388>'START'</font></b> 43 ; ----------- 44 ; All Z80 chips start at location zero. 45 ; At start-up the Interrupt Mode is 0, ZX computers use Interrupt Mode 1. 46 ; Interrupts are disabled . 47 48 <a name="L0000"></a>;; <b>START</b> 49 L0000: OUT ($FD),A ; Turn off the NMI generator if this ROM is 50 ; running in ZX81 hardware. This does nothing 51 ; if this ROM is running within an upgraded 52 ; ZX80. 53 LD BC,$7FFF ; Set BC to the top of possible RAM. 54 ; The higher unpopulated addresses are used for 55 ; video generation. 56 JP <A href="#L03CB">L03CB</a> ; Jump forward to RAM-CHECK. 57 58 ; ------------------- 59 ; THE <b><font color=#333388>'ERROR'</font></b> RESTART 60 ; ------------------- 61 ; The error restart deals immediately with an error. ZX computers execute the 62 ; same code in runtime as when checking syntax. If the error occurred while 63 ; running a program then a brief report is produced. If the error occurred 64 ; while entering a BASIC line or in input etc., then the error marker indicates 65 ; the exact point at which the error lies. 66 67 <a name="L0008"></a>;; <b>ERROR-1</b> 68 L0008: LD HL,($4016) ; fetch character address from CH_ADD. 69 LD ($4018),HL ; and set the error pointer X_PTR. 70 JR <A href="#L0056">L0056</a> ; forward to continue at ERROR-2. 71 72 ; ------------------------------- 73 ; THE <b><font color=#333388>'PRINT A CHARACTER'</font></b> RESTART 74 ; ------------------------------- 75 ; This restart prints the character in the accumulator using the alternate 76 ; register set so there is no requirement to save the main registers. 77 ; There is sufficient room available to separate a space (zero) from other 78 ; characters as leading spaces need not be considered with a space. 79 80 <a name="L0010"></a>;; <b>PRINT-A</b> 81 L0010: AND A ; test for zero - space. 82 JP NZ,<A href="#L07F1">L07F1</a> ; jump forward if not to PRINT-CH. 83 84 JP <A href="#L07F5">L07F5</a> ; jump forward to PRINT-SP. 85 86 ; --- 87 88 DEFB $FF ; unused location. 89 90 ; --------------------------------- 91 ; THE <b><font color=#333388>'COLLECT A CHARACTER'</font></b> RESTART 92 ; --------------------------------- 93 ; The character addressed by the system variable CH_ADD is fetched and if it 94 ; is a non-space, non-cursor character it is returned else CH_ADD is 95 ; incremented and the new addressed character tested until it is not a space. 96 97 <a name="L0018"></a>;; <b>GET-CHAR</b> 98 L0018: LD HL,($4016) ; set HL to character address CH_ADD. 99 LD A,(HL) ; fetch addressed character to A. 100 101 <a name="L001C"></a>;; <b>TEST-SP</b> 102 L001C: AND A ; test for space. 103 RET NZ ; return if not a space 104 105 NOP ; else trickle through 106 NOP ; to the next routine. 107 108 ; ------------------------------------ 109 ; THE <b><font color=#333388>'COLLECT NEXT CHARACTER'</font></b> RESTART 110 ; ------------------------------------ 111 ; The character address in incremented and the new addressed character is 112 ; returned if not a space, or cursor, else the process is repeated. 113 114 <a name="L0020"></a>;; <b>NEXT-CHAR</b> 115 L0020: CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 gets next immediate 116 ; character. 117 JR <A href="#L001C">L001C</a> ; back to TEST-SP. 118 119 ; --- 120 121 DEFB $FF, $FF, $FF ; unused locations. 122 123 ; --------------------------------------- 124 ; THE <b><font color=#333388>'FLOATING POINT CALCULATOR'</font></b> RESTART 125 ; --------------------------------------- 126 ; this restart jumps to the recursive floating-point calculator. 127 ; the ZX81's internal, FORTH-like, stack-based language. 128 ; 129 ; In the five remaining bytes there is, appropriately, enough room for the 130 ; end-calc literal - the instruction which exits the calculator. 131 132 <a name="L0028"></a>;; <b>FP-CALC</b> 133 L0028: JP <A href="#L199D">L199D</a> ; jump immediately to the CALCULATE routine. 134 135 ; --- 136 137 <a name="L002B"></a>;; <b>end-calc</b> 138 L002B: POP AF ; drop the calculator return address RE-ENTRY 139 EXX ; switch to the other set. 140 141 EX (SP),HL ; transfer H'L' to machine stack for the 142 ; return address. 143 ; when exiting recursion then the previous 144 ; pointer is transferred to H'L'. 145 146 EXX ; back to main set. 147 RET ; return. 148 149 150 ; ----------------------------- 151 ; THE <b><font color=#333388>'MAKE BC SPACES'</font></b> RESTART 152 ; ----------------------------- 153 ; This restart is used eight times to create, in workspace, the number of 154 ; spaces passed in the BC register. 155 156 <a name="L0030"></a>;; <b>BC-SPACES</b> 157 L0030: PUSH BC ; push number of spaces on stack. 158 LD HL,($4014) ; fetch edit line location from E_LINE. 159 PUSH HL ; save this value on stack. 160 JP <A href="#L1488">L1488</a> ; jump forward to continue at RESERVE. 161 162 ; ----------------------- 163 ; THE <b><font color=#333388>'INTERRUPT'</font></b> RESTART 164 ; ----------------------- 165 ; The Mode 1 Interrupt routine is concerned solely with generating the central 166 ; television picture. 167 ; On the ZX81 interrupts are enabled only during the interrupt routine, 168 ; although the interrupt 169 ; This Interrupt Service Routine automatically disables interrupts at the 170 ; outset and the last interrupt in a cascade exits before the interrupts are 171 ; enabled. 172 ; There is no DI instruction in the ZX81 ROM. 173 ; An maskable interrupt is triggered when bit 6 of the Z80's Refresh register 174 ; changes from set to reset. 175 ; The Z80 will always be executing a HALT (NEWLINE) when the interrupt occurs. 176 ; A HALT instruction repeatedly executes NOPS but the seven lower bits 177 ; of the Refresh register are incremented each time as they are when any 178 ; simple instruction is executed. (The lower 7 bits are incremented twice for 179 ; a prefixed instruction) 180 ; This is controlled by the Sinclair Computer Logic Chip - manufactured from 181 ; a Ferranti Uncommitted Logic Array. 182 ; 183 ; When a Mode 1 Interrupt occurs the Program Counter, which is the address in 184 ; the upper echo display following the NEWLINE/HALT instruction, goes on the 185 ; machine stack. 193 interrupts are required to generate the last part of 186 ; the 56th border line and then the 192 lines of the central TV picture and, 187 ; although each interrupt interrupts the previous one, there are no stack 188 ; problems as the 'return address' is discarded each time. 189 ; 190 ; The scan line counter in C counts down from 8 to 1 within the generation of 191 ; each text line. For the first interrupt in a cascade the initial value of 192 ; C is set to 1 for the last border line. 193 ; Timing is of the utmost importance as the RH border, horizontal retrace 194 ; and LH border are mostly generated in the 58 clock cycles this routine 195 ; takes . 196 197 <a name="L0038"></a>;; <b>INTERRUPT</b> 198 L0038: DEC C ; (4) decrement C - the scan line counter. 199 JP NZ,<A href="#L0045">L0045</a> ; (10/10) JUMP forward if not zero to SCAN-LINE 200 201 POP HL ; (10) point to start of next row in display 202 ; file. 203 204 DEC B ; (4) decrement the row counter. (4) 205 RET Z ; (11/5) return when picture complete to L028B 206 ; with interrupts disabled. 207 208 SET 3,C ; (8) Load the scan line counter with eight. 209 ; <font color=#9900FF>Note.</font> LD C,$08 is 7 clock cycles which 210 ; is way too fast. 211 212 ; -> 213 214 <a name="L0041"></a>;; <b>WAIT-INT</b> 215 L0041: LD R,A ; (9) Load R with initial rising value $DD. 216 217 EI ; (4) Enable Interrupts. [ R is now $DE ]. 218 219 JP (HL) ; (4) jump to the echo display file in upper 220 ; memory and execute characters $00 - $3F 221 ; as NOP instructions. The video hardware 222 ; is able to read these characters and, 223 ; with the I register is able to convert 224 ; the character bitmaps in this ROM into a 225 ; line of bytes. Eventually the NEWLINE/HALT 226 ; will be encountered before R reaches $FF. 227 ; It is however the transition from $FF to 228 ; $80 that triggers the next interrupt. 229 ; [ The Refresh register is now $DF ] 230 231 ; --- 232 233 <a name="L0045"></a>;; <b>SCAN-LINE</b> 234 L0045: POP DE ; (10) discard the address after NEWLINE as the 235 ; same text line has to be done again 236 ; eight times. 237 238 RET Z ; (5) Harmless Nonsensical Timing. 239 ; (condition never met) 240 241 JR <A href="#L0041">L0041</a> ; (12) back to WAIT-INT 242 243 ; <font color=#9900FF>Note.</font> that a computer with less than 4K or RAM will have a collapsed 244 ; display file and the above mechanism deals with both types of display. 245 ; 246 ; With a full display, the 32 characters in the line are treated as NOPS 247 ; and the Refresh register rises from $E0 to $FF and, at the next instruction 248 ; - HALT, the interrupt occurs. 249 ; With a collapsed display and an initial NEWLINE/HALT, it is the NOPs 250 ; generated by the HALT that cause the Refresh value to rise from $E0 to $FF, 251 ; triggering an Interrupt on the next transition. 252 ; This works happily for all display lines between these extremes and the 253 ; generation of the 32 character, 1 pixel high, line will always take 128 254 ; clock cycles. 255 256 ; --------------------------------- 257 ; THE <b><font color=#333388>'INCREMENT CH-ADD'</font></b> SUBROUTINE 258 ; --------------------------------- 259 ; This is the subroutine that increments the character address system variable 260 ; and returns if it is not the cursor character. The ZX81 has an actual 261 ; character at the cursor position rather than a pointer system variable 262 ; as is the case with prior and subsequent ZX computers. 263 264 <a name="L0049"></a>;; <b>CH-ADD+1</b> 265 L0049: LD HL,($4016) ; fetch character address to CH_ADD. 266 267 <a name="L004C"></a>;; <b>TEMP-PTR1</b> 268 L004C: INC HL ; address next immediate location. 269 270 <a name="L004D"></a>;; <b>TEMP-PTR2</b> 271 L004D: LD ($4016),HL ; update system variable CH_ADD. 272 273 LD A,(HL) ; fetch the character. 274 CP $7F ; compare to cursor character. 275 RET NZ ; return if not the cursor. 276 277 JR <A href="#L004C">L004C</a> ; back for next character to TEMP-PTR1. 278 279 ; -------------------- 280 ; THE <b><font color=#333388>'ERROR-2'</font></b> BRANCH 281 ; -------------------- 282 ; This is a continuation of the error restart. 283 ; If the error occurred in runtime then the error stack pointer will probably 284 ; lead to an error report being printed unless it occurred during input. 285 ; If the error occurred when checking syntax then the error stack pointer 286 ; will be an editing routine and the position of the error will be shown 287 ; when the lower screen is reprinted. 288 289 <a name="L0056"></a>;; <b>ERROR-2</b> 290 L0056: POP HL ; pop the return address which points to the 291 ; DEFB, error code, after the RST 08. 292 LD L,(HL) ; load L with the error code. HL is not needed 293 ; anymore. 294 295 <a name="L0058"></a>;; <b>ERROR-3</b> 296 L0058: LD (IY+$00),L ; place error code in system variable ERR_NR 297 LD SP,($4002) ; set the stack pointer from ERR_SP 298 CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST selects slow mode. 299 JP <A href="#L14BC">L14BC</a> ; exit to address on stack via routine SET-MIN. 300 301 ; --- 302 303 DEFB $FF ; unused. 304 305 ; ------------------------------------ 306 ; THE <b><font color=#333388>'NON MASKABLE INTERRUPT'</font></b> ROUTINE 307 ; ------------------------------------ 308 ; Jim Westwood's technical dodge using Non-Maskable Interrupts solved the 309 ; flicker problem of the ZX80 and gave the ZX81 a multi-tasking SLOW mode 310 ; with a steady display. Note that the AF' register is reserved for this 311 ; function and its interaction with the display routines. When counting 312 ; TV lines, the NMI makes no use of the main registers. 313 ; The circuitry for the NMI generator is contained within the SCL (Sinclair 314 ; Computer Logic) chip. 315 ; ( It takes 32 clock cycles while incrementing towards zero ). 316 317 <a name="L0066"></a>;; <b>NMI</b> 318 L0066: EX AF,AF' ; (4) switch in the NMI's copy of the 319 ; accumulator. 320 INC A ; (4) increment. 321 JP M,<A href="#L006D">L006D</a> ; (10/10) jump, if minus, to NMI-RET as this is 322 ; part of a test to see if the NMI 323 ; generation is working or an intermediate 324 ; value for the ascending negated blank 325 ; line counter. 326 327 JR Z,<A href="#L006F">L006F</a> ; (12) forward to NMI-CONT 328 ; when line count has incremented to zero. 329 330 ; <font color=#9900FF>Note.</font> the synchronizing NMI when A increments from zero to one takes this 331 ; 7 clock cycle route making 39 clock cycles in all. 332 333 <a name="L006D"></a>;; <b>NMI-RET</b> 334 L006D: EX AF,AF' ; (4) switch out the incremented line counter 335 ; or test result $80 336 RET ; (10) return to User application for a while. 337 338 ; --- 339 340 ; This branch is taken when the 55 (or 31) lines have been drawn. 341 342 <a name="L006F"></a>;; <b>NMI-CONT</b> 343 L006F: EX AF,AF' ; (4) restore the main accumulator. 344 345 PUSH AF ; (11) * Save Main Registers 346 PUSH BC ; (11) ** 347 PUSH DE ; (11) *** 348 PUSH HL ; (11) **** 349 350 ; the next set-up procedure is only really applicable when the top set of 351 ; blank lines have been generated. 352 353 LD HL,($400C) ; (16) fetch start of Display File from D_FILE 354 ; points to the HALT at beginning. 355 SET 7,H ; (8) point to upper 32K 'echo display file' 356 357 HALT ; (1) HALT synchronizes with NMI. 358 ; Used with special hardware connected to the 359 ; Z80 HALT and WAIT lines to take 1 clock cycle. 360 361 ; ---------------------------------------------------------------------------- 362 ; the NMI has been generated - start counting. The cathode ray is at the RH 363 ; side of the TV. 364 ; First the NMI servicing, similar to CALL = 17 clock cycles. 365 ; Then the time taken by the NMI for zero-to-one path = 39 cycles 366 ; The HALT above = 01 cycles. 367 ; The two instructions below = 19 cycles. 368 ; The code at <A href="#L0281">L0281</a> up to and including the CALL = 43 cycles. 369 ; The Called routine at <A href="#L02B5">L02B5</a> = 24 cycles. 370 ; -------------------------------------- --- 371 ; Total Z80 instructions = 143 cycles. 372 ; 373 ; Meanwhile in TV world, 374 ; Horizontal retrace = 15 cycles. 375 ; Left blanking border 8 character positions = 32 cycles 376 ; Generation of 75% scanline from the first NEWLINE = 96 cycles 377 ; --------------------------------------- --- 378 ; 143 cycles 379 ; 380 ; Since at the time the first JP (HL) is encountered to execute the echo 381 ; display another 8 character positions have to be put out, then the 382 ; Refresh register need to hold $F8. Working back and counteracting 383 ; the fact that every instruction increments the Refresh register then 384 ; the value that is loaded into R needs to be $F5. :-) 385 ; 386 ; 387 OUT ($FD),A ; (11) Stop the NMI generator. 388 389 JP (IX) ; (8) forward to L0281 (after top) or L028F 390 391 ; **************** 392 ; ** KEY TABLES ** 393 ; **************** 394 395 ; ------------------------------- 396 ; THE <b><font color=#333388>'UNSHIFTED'</font></b> CHARACTER CODES 397 ; ------------------------------- 398 399 <a name="L007E"></a>;; <b>K-UNSHIFT</b> 400 L007E: DEFB $3F ; Z 401 DEFB $3D ; X 402 DEFB $28 ; C 403 DEFB $3B ; V 404 DEFB $26 ; A 405 DEFB $38 ; S 406 DEFB $29 ; D 407 DEFB $2B ; F 408 DEFB $2C ; G 409 DEFB $36 ; Q 410 DEFB $3C ; W 411 DEFB $2A ; E 412 DEFB $37 ; R 413 DEFB $39 ; T 414 DEFB $1D ; 1 415 DEFB $1E ; 2 416 DEFB $1F ; 3 417 DEFB $20 ; 4 418 DEFB $21 ; 5 419 DEFB $1C ; 0 420 DEFB $25 ; 9 421 DEFB $24 ; 8 422 DEFB $23 ; 7 423 DEFB $22 ; 6 424 DEFB $35 ; P 425 DEFB $34 ; O 426 DEFB $2E ; I 427 DEFB $3A ; U 428 DEFB $3E ; Y 429 DEFB $76 ; NEWLINE 430 DEFB $31 ; L 431 DEFB $30 ; K 432 DEFB $2F ; J 433 DEFB $2D ; H 434 DEFB $00 ; SPACE 435 DEFB $1B ; . 436 DEFB $32 ; M 437 DEFB $33 ; N 438 DEFB $27 ; B 439 440 ; ----------------------------- 441 ; THE <b><font color=#333388>'SHIFTED'</font></b> CHARACTER CODES 442 ; ----------------------------- 443 444 445 <a name="L00A5"></a>;; <b>K-SHIFT</b> 446 L00A5: DEFB $0E ; : 447 DEFB $19 ; ; 448 DEFB $0F ; ? 449 DEFB $18 ; / 450 DEFB $E3 ; STOP 451 DEFB $E1 ; LPRINT 452 DEFB $E4 ; SLOW 453 DEFB $E5 ; FAST 454 DEFB $E2 ; LLIST 455 DEFB $C0 ; "" 456 DEFB $D9 ; OR 457 DEFB $E0 ; STEP 458 DEFB $DB ; <= 459 DEFB $DD ; <> 460 DEFB $75 ; EDIT 461 DEFB $DA ; AND 462 DEFB $DE ; THEN 463 DEFB $DF ; TO 464 DEFB $72 ; cursor-left 465 DEFB $77 ; RUBOUT 466 DEFB $74 ; GRAPHICS 467 DEFB $73 ; cursor-right 468 DEFB $70 ; cursor-up 469 DEFB $71 ; cursor-down 470 DEFB $0B ; " 471 DEFB $11 ; ) 472 DEFB $10 ; ( 473 DEFB $0D ; $ 474 DEFB $DC ; >= 475 DEFB $79 ; FUNCTION 476 DEFB $14 ; = 477 DEFB $15 ; + 478 DEFB $16 ; - 479 DEFB $D8 ; ** 480 DEFB $0C ; £ 481 DEFB $1A ; , 482 DEFB $12 ; > 483 DEFB $13 ; < 484 DEFB $17 ; * 485 486 ; ------------------------------ 487 ; THE <b><font color=#333388>'FUNCTION'</font></b> CHARACTER CODES 488 ; ------------------------------ 489 490 491 <a name="L00CC"></a>;; <b>K-FUNCT</b> 492 L00CC: DEFB $CD ; LN 493 DEFB $CE ; EXP 494 DEFB $C1 ; AT 495 DEFB $78 ; KL 496 DEFB $CA ; ASN 497 DEFB $CB ; ACS 498 DEFB $CC ; ATN 499 DEFB $D1 ; SGN 500 DEFB $D2 ; ABS 501 DEFB $C7 ; SIN 502 DEFB $C8 ; COS 503 DEFB $C9 ; TAN 504 DEFB $CF ; INT 505 DEFB $40 ; RND 506 DEFB $78 ; KL 507 DEFB $78 ; KL 508 DEFB $78 ; KL 509 DEFB $78 ; KL 510 DEFB $78 ; KL 511 DEFB $78 ; KL 512 DEFB $78 ; KL 513 DEFB $78 ; KL 514 DEFB $78 ; KL 515 DEFB $78 ; KL 516 DEFB $C2 ; TAB 517 DEFB $D3 ; PEEK 518 DEFB $C4 ; CODE 519 DEFB $D6 ; CHR$ 520 DEFB $D5 ; STR$ 521 DEFB $78 ; KL 522 DEFB $D4 ; USR 523 DEFB $C6 ; LEN 524 DEFB $C5 ; VAL 525 DEFB $D0 ; SQR 526 DEFB $78 ; KL 527 DEFB $78 ; KL 528 DEFB $42 ; PI 529 DEFB $D7 ; NOT 530 DEFB $41 ; INKEY$ 531 532 ; ----------------------------- 533 ; THE <b><font color=#333388>'GRAPHIC'</font></b> CHARACTER CODES 534 ; ----------------------------- 535 536 537 <a name="L00F3"></a>;; <b>K-GRAPH</b> 538 L00F3: DEFB $08 ; graphic 539 DEFB $0A ; graphic 540 DEFB $09 ; graphic 541 DEFB $8A ; graphic 542 DEFB $89 ; graphic 543 DEFB $81 ; graphic 544 DEFB $82 ; graphic 545 DEFB $07 ; graphic 546 DEFB $84 ; graphic 547 DEFB $06 ; graphic 548 DEFB $01 ; graphic 549 DEFB $02 ; graphic 550 DEFB $87 ; graphic 551 DEFB $04 ; graphic 552 DEFB $05 ; graphic 553 DEFB $77 ; RUBOUT 554 DEFB $78 ; KL 555 DEFB $85 ; graphic 556 DEFB $03 ; graphic 557 DEFB $83 ; graphic 558 DEFB $8B ; graphic 559 DEFB $91 ; inverse ) 560 DEFB $90 ; inverse ( 561 DEFB $8D ; inverse $ 562 DEFB $86 ; graphic 563 DEFB $78 ; KL 564 DEFB $92 ; inverse > 565 DEFB $95 ; inverse + 566 DEFB $96 ; inverse - 567 DEFB $88 ; graphic 568 569 ; ------------------ 570 ; THE <b><font color=#333388>'TOKEN'</font></b> TABLES 571 ; ------------------ 572 573 574 <a name="L094B"></a>;; <b>TOKENS</b> 575 L0111: DEFB $0F+$80 ; '?'+$80 576 DEFB $0B,$0B+$80 ; "" 577 DEFB $26,$39+$80 ; AT 578 DEFB $39,$26,$27+$80 ; TAB 579 DEFB $0F+$80 ; '?'+$80 580 DEFB $28,$34,$29,$2A+$80 ; CODE 581 DEFB $3B,$26,$31+$80 ; VAL 582 DEFB $31,$2A,$33+$80 ; LEN 583 DEFB $38,$2E,$33+$80 ; SIN 584 DEFB $28,$34,$38+$80 ; COS 585 DEFB $39,$26,$33+$80 ; TAN 586 DEFB $26,$38,$33+$80 ; ASN 587 DEFB $26,$28,$38+$80 ; ACS 588 DEFB $26,$39,$33+$80 ; ATN 589 DEFB $31,$33+$80 ; LN 590 DEFB $2A,$3D,$35+$80 ; EXP 591 DEFB $2E,$33,$39+$80 ; INT 592 DEFB $38,$36,$37+$80 ; SQR 593 DEFB $38,$2C,$33+$80 ; SGN 594 DEFB $26,$27,$38+$80 ; ABS 595 DEFB $35,$2A,$2A,$30+$80 ; PEEK 596 DEFB $3A,$38,$37+$80 ; USR 597 DEFB $38,$39,$37,$0D+$80 ; STR$ 598 DEFB $28,$2D,$37,$0D+$80 ; CHR$ 599 DEFB $33,$34,$39+$80 ; NOT 600 DEFB $17,$17+$80 ; ** 601 DEFB $34,$37+$80 ; OR 602 DEFB $26,$33,$29+$80 ; AND 603 DEFB $13,$14+$80 ; <= 604 DEFB $12,$14+$80 ; >= 605 DEFB $13,$12+$80 ; <> 606 DEFB $39,$2D,$2A,$33+$80 ; THEN 607 DEFB $39,$34+$80 ; TO 608 DEFB $38,$39,$2A,$35+$80 ; STEP 609 DEFB $31,$35,$37,$2E,$33,$39+$80 ; LPRINT 610 DEFB $31,$31,$2E,$38,$39+$80 ; LLIST 611 DEFB $38,$39,$34,$35+$80 ; STOP 612 DEFB $38,$31,$34,$3C+$80 ; SLOW 613 DEFB $2B,$26,$38,$39+$80 ; FAST 614 DEFB $33,$2A,$3C+$80 ; NEW 615 DEFB $38,$28,$37,$34,$31,$31+$80 ; SCROLL 616 DEFB $28,$34,$33,$39+$80 ; CONT 617 DEFB $29,$2E,$32+$80 ; DIM 618 DEFB $37,$2A,$32+$80 ; REM 619 DEFB $2B,$34,$37+$80 ; FOR 620 DEFB $2C,$34,$39,$34+$80 ; GOTO 621 DEFB $2C,$34,$38,$3A,$27+$80 ; GOSUB 622 DEFB $2E,$33,$35,$3A,$39+$80 ; INPUT 623 DEFB $31,$34,$26,$29+$80 ; LOAD 624 DEFB $31,$2E,$38,$39+$80 ; LIST 625 DEFB $31,$2A,$39+$80 ; LET 626 DEFB $35,$26,$3A,$38,$2A+$80 ; PAUSE 627 DEFB $33,$2A,$3D,$39+$80 ; NEXT 628 DEFB $35,$34,$30,$2A+$80 ; POKE 629 DEFB $35,$37,$2E,$33,$39+$80 ; PRINT 630 DEFB $35,$31,$34,$39+$80 ; PLOT 631 DEFB $37,$3A,$33+$80 ; RUN 632 DEFB $38,$26,$3B,$2A+$80 ; SAVE 633 DEFB $37,$26,$33,$29+$80 ; RAND 634 DEFB $2E,$2B+$80 ; IF 635 DEFB $28,$31,$38+$80 ; CLS 636 DEFB $3A,$33,$35,$31,$34,$39+$80 ; UNPLOT 637 DEFB $28,$31,$2A,$26,$37+$80 ; CLEAR 638 DEFB $37,$2A,$39,$3A,$37,$33+$80 ; RETURN 639 DEFB $28,$34,$35,$3E+$80 ; COPY 640 DEFB $37,$33,$29+$80 ; RND 641 DEFB $2E,$33,$30,$2A,$3E,$0D+$80 ; INKEY$ 642 DEFB $35,$2E+$80 ; PI 643 644 645 ; ------------------------------ 646 ; THE <b><font color=#333388>'LOAD-SAVE UPDATE'</font></b> ROUTINE 647 ; ------------------------------ 648 ; 649 ; 650 651 <a name="L01FC"></a>;; <b>LOAD/SAVE</b> 652 L01FC: INC HL ; 653 EX DE,HL ; 654 LD HL,($4014) ; system variable edit line E_LINE. 655 SCF ; set carry flag 656 SBC HL,DE ; 657 EX DE,HL ; 658 RET NC ; return if more bytes to load/save. 659 660 POP HL ; else drop return address 661 662 ; ---------------------- 663 ; THE <b><font color=#333388>'DISPLAY'</font></b> ROUTINES 664 ; ---------------------- 665 ; 666 ; 667 668 <a name="L0207"></a>;; <b>SLOW/FAST</b> 669 L0207: LD HL,$403B ; Address the system variable CDFLAG. 670 LD A,(HL) ; Load value to the accumulator. 671 RLA ; rotate bit 6 to position 7. 672 XOR (HL) ; exclusive or with original bit 7. 673 RLA ; rotate result out to carry. 674 RET NC ; return if both bits were the same. 675 676 ; Now test if this really is a ZX81 or a ZX80 running the upgraded ROM. 677 ; The standard ZX80 did not have an NMI generator. 678 679 LD A,$7F ; Load accumulator with %011111111 680 EX AF,AF' ; save in AF' 681 682 LD B,$11 ; A counter within which an NMI should occur 683 ; if this is a ZX81. 684 OUT ($FE),A ; start the NMI generator. 685 686 ; Note that if this is a ZX81 then the NMI will increment AF'. 687 688 <a name="L0216"></a>;; <b>LOOP-11</b> 689 L0216: DJNZ <A href="#L0216">L0216</a> ; self loop to give the NMI a chance to kick in. 690 ; = 16*13 clock cycles + 8 = 216 clock cycles. 691 692 OUT ($FD),A ; Turn off the NMI generator. 693 EX AF,AF' ; bring back the AF' value. 694 RLA ; test bit 7. 695 JR NC,<A href="#L0226">L0226</a> ; forward, if bit 7 is still reset, to NO-SLOW. 696 697 ; If the AF' was incremented then the NMI generator works and SLOW mode can 698 ; be set. 699 700 SET 7,(HL) ; Indicate SLOW mode - Compute and Display. 701 702 PUSH AF ; * Save Main Registers 703 PUSH BC ; ** 704 PUSH DE ; *** 705 PUSH HL ; **** 706 707 JR <A href="#L0229">L0229</a> ; skip forward - to DISPLAY-1. 708 709 ; --- 710 711 <a name="L0226"></a>;; <b>NO-SLOW</b> 712 L0226: RES 6,(HL) ; reset bit 6 of CDFLAG. 713 RET ; return. 714 715 ; ----------------------- 716 ; THE <b><font color=#333388>'MAIN DISPLAY'</font></b> LOOP 717 ; ----------------------- 718 ; This routine is executed once for every frame displayed. 719 720 <a name="L0229"></a>;; <b>DISPLAY-1</b> 721 L0229: LD HL,($4034) ; fetch two-byte system variable FRAMES. 722 DEC HL ; decrement frames counter. 723 724 <a name="L022D"></a>;; <b>DISPLAY-P</b> 725 L022D: LD A,$7F ; prepare a mask 726 AND H ; pick up bits 6-0 of H. 727 OR L ; and any bits of L. 728 LD A,H ; reload A with all bits of H for PAUSE test. 729 730 ; Note both branches must take the same time. 731 732 JR NZ,<A href="#L0237">L0237</a> ; (12/7) forward if bits 14-0 are not zero 733 ; to ANOTHER 734 735 RLA ; (4) test bit 15 of FRAMES. 736 JR <A href="#L0239">L0239</a> ; (12) forward with result to OVER-NC 737 738 ; --- 739 740 <a name="L0237"></a>;; <b>ANOTHER</b> 741 L0237: LD B,(HL) ; (7) <font color=#9900FF>Note.</font> Harmless Nonsensical Timing weight. 742 SCF ; (4) Set Carry Flag. 743 744 ; <font color=#9900FF>Note.</font> the branch to here takes either (12)(7)(4) cyles or (7)(4)(12) cycles. 745 746 <a name="L0239"></a>;; <b>OVER-NC</b> 747 L0239: LD H,A ; (4) set H to zero 748 LD ($4034),HL ; (16) update system variable FRAMES 749 RET NC ; (11/5) return if FRAMES is in use by PAUSE 750 ; command. 751 752 <a name="L023E"></a>;; <b>DISPLAY-2</b> 753 L023E: CALL <A href="#L02BB">L02BB</a> ; routine KEYBOARD gets the key row in H and 754 ; the column in L. Reading the ports also starts 755 ; the TV frame synchronization pulse. (VSYNC) 756 757 LD BC,($4025) ; fetch the last key values read from LAST_K 758 LD ($4025),HL ; update LAST_K with new values. 759 760 LD A,B ; load A with previous column - will be $FF if 761 ; there was no key. 762 ADD A,$02 ; adding two will set carry if no previous key. 763 764 SBC HL,BC ; subtract with the carry the two key values. 765 766 ; If the same key value has been returned twice then HL will be zero. 767 768 LD A,($4027) ; fetch system variable DEBOUNCE 769 OR H ; and OR with both bytes of the difference 770 OR L ; setting the zero flag for the upcoming branch. 771 772 LD E,B ; transfer the column value to E 773 LD B,$0B ; and load B with eleven 774 775 LD HL,$403B ; address system variable CDFLAG 776 RES 0,(HL) ; reset the rightmost bit of CDFLAG 777 JR NZ,<A href="#L0264">L0264</a> ; skip forward if debounce/diff >0 to NO-KEY 778 779 BIT 7,(HL) ; test compute and display bit of CDFLAG 780 SET 0,(HL) ; set the rightmost bit of CDFLAG. 781 RET Z ; return if bit 7 indicated fast mode. 782 783 DEC B ; (4) decrement the counter. 784 NOP ; (4) Timing - 4 clock cycles. ?? 785 SCF ; (4) Set Carry Flag 786 787 <a name="L0264"></a>;; <b>NO-KEY</b> 788 L0264: LD HL,$4027 ; sv DEBOUNCE 789 CCF ; Complement Carry Flag 790 RL B ; rotate left B picking up carry 791 ; C<-76543210<-C 792 793 <a name="L026A"></a>;; <b>LOOP-B</b> 794 L026A: DJNZ <A href="#L026A">L026A</a> ; self-loop while B>0 to LOOP-B 795 796 LD B,(HL) ; fetch value of DEBOUNCE to B 797 LD A,E ; transfer column value 798 CP $FE ; 799 SBC A,A ; 800 LD B,$1F ; 801 OR (HL) ; 802 AND B ; 803 RRA ; 804 LD (HL),A ; 805 806 OUT ($FF),A ; end the TV frame synchronization pulse. 807 808 LD HL,($400C) ; (12) set HL to the Display File from D_FILE 809 SET 7,H ; (8) set bit 15 to address the echo display. 810 811 CALL <A href="#L0292">L0292</a> ; (17) routine DISPLAY-3 displays the top set 812 ; of blank lines. 813 814 ; --------------------- 815 ; THE <b><font color=#333388>'VIDEO-1'</font></b> ROUTINE 816 ; --------------------- 817 818 <a name="L0281"></a>;; <b>R-IX-1</b> 819 L0281: LD A,R ; (9) Harmless Nonsensical Timing or something 820 ; very clever? 821 LD BC,$1901 ; (10) 25 lines, 1 scanline in first. 822 LD A,$F5 ; (7) This value will be loaded into R and 823 ; ensures that the cycle starts at the right 824 ; part of the display - after 32nd character 825 ; position. 826 827 CALL <A href="#L02B5">L02B5</a> ; (17) routine DISPLAY-5 completes the current 828 ; blank line and then generates the display of 829 ; the live picture using INT interrupts 830 ; The final interrupt returns to the next 831 ; address. 832 833 L028B: DEC HL ; point HL to the last NEWLINE/HALT. 834 835 CALL <A href="#L0292">L0292</a> ; routine DISPLAY-3 displays the bottom set of 836 ; blank lines. 837 838 ; --- 839 840 <a name="L028F"></a>;; <b>R-IX-2</b> 841 L028F: JP <A href="#L0229">L0229</a> ; JUMP back to DISPLAY-1 842 843 ; --------------------------------- 844 ; THE <b><font color=#333388>'DISPLAY BLANK LINES'</font></b> ROUTINE 845 ; --------------------------------- 846 ; This subroutine is called twice (see above) to generate first the blank 847 ; lines at the top of the television display and then the blank lines at the 848 ; bottom of the display. 849 850 <a name="L0292"></a>;; <b>DISPLAY-3</b> 851 L0292: POP IX ; pop the return address to IX register. 852 ; will be either L0281 or L028F - see above. 853 854 LD C,(IY+$28) ; load C with value of system constant MARGIN. 855 BIT 7,(IY+$3B) ; test CDFLAG for compute and display. 856 JR Z,<A href="#L02A9">L02A9</a> ; forward, with FAST mode, to DISPLAY-4 857 858 LD A,C ; move MARGIN to A - 31d or 55d. 859 NEG ; Negate 860 INC A ; 861 EX AF,AF' ; place negative count of blank lines in A' 862 863 OUT ($FE),A ; enable the NMI generator. 864 865 POP HL ; **** 866 POP DE ; *** 867 POP BC ; ** 868 POP AF ; * Restore Main Registers 869 870 RET ; return - end of interrupt. Return is to 871 ; user's program - BASIC or machine code. 872 ; which will be interrupted by every NMI. 873 874 ; ------------------------ 875 ; THE <b><font color=#333388>'FAST MODE'</font></b> ROUTINES 876 ; ------------------------ 877 878 <a name="L02A9"></a>;; <b>DISPLAY-4</b> 879 L02A9: LD A,$FC ; (7) load A with first R delay value 880 LD B,$01 ; (7) one row only. 881 882 CALL <A href="#L02B5">L02B5</a> ; (17) routine DISPLAY-5 883 884 DEC HL ; (6) point back to the HALT. 885 EX (SP),HL ; (19) Harmless Nonsensical Timing if paired. 886 EX (SP),HL ; (19) Harmless Nonsensical Timing. 887 JP (IX) ; (8) to L0281 or L028F 888 889 ; -------------------------- 890 ; THE <b><font color=#333388>'DISPLAY-5'</font></b> SUBROUTINE 891 ; -------------------------- 892 ; This subroutine is called from SLOW mode and FAST mode to generate the 893 ; central TV picture. With SLOW mode the R register is incremented, with 894 ; each instruction, to $F7 by the time it completes. With fast mode, the 895 ; final R value will be $FF and an interrupt will occur as soon as the 896 ; Program Counter reaches the HALT. (24 clock cycles) 897 898 <a name="L02B5"></a>;; <b>DISPLAY-5</b> 899 L02B5: LD R,A ; (9) Load R from A. R = slow: $F5 fast: $FC 900 LD A,$DD ; (7) load future R value. $F6 $FD 901 902 EI ; (4) Enable Interrupts $F7 $FE 903 904 JP (HL) ; (4) jump to the echo display. $F8 $FF 905 906 ; ---------------------------------- 907 ; THE <b><font color=#333388>'KEYBOARD SCANNING'</font></b> SUBROUTINE 908 ; ---------------------------------- 909 ; The keyboard is read during the vertical sync interval while no video is 910 ; being displayed. Reading a port with address bit 0 low i.e. $FE starts the 911 ; vertical sync pulse. 912 913 <a name="L02BB"></a>;; <b>KEYBOARD</b> 914 L02BB: LD HL,$FFFF ; (16) prepare a buffer to take key. 915 LD BC,$FEFE ; (20) set BC to port $FEFE. The B register, 916 ; with its single reset bit also acts as 917 ; an 8-counter. 918 IN A,(C) ; (11) read the port - all 16 bits are put on 919 ; the address bus. Start VSYNC pulse. 920 OR $01 ; (7) set the rightmost bit so as to ignore 921 ; the SHIFT key. 922 923 <a name="L02C5"></a>;; <b>EACH-LINE</b> 924 L02C5: OR $E0 ; [7] OR %11100000 925 LD D,A ; [4] transfer to D. 926 CPL ; [4] complement - only bits 4-0 meaningful now. 927 CP $01 ; [7] sets carry if A is zero. 928 SBC A,A ; [4] $FF if $00 else zero. 929 OR B ; [7] $FF or port FE,FD,FB.... 930 AND L ; [4] unless more than one key, L will still be 931 ; $FF. if more than one key is pressed then A is 932 ; now invalid. 933 LD L,A ; [4] transfer to L. 934 935 ; now consider the column identifier. 936 937 LD A,H ; [4] will be $FF if no previous keys. 938 AND D ; [4] 111xxxxx 939 LD H,A ; [4] transfer A to H 940 941 ; since only one key may be pressed, H will, if valid, be one of 942 ; 11111110, 11111101, 11111011, 11110111, 11101111 943 ; reading from the outer column, say Q, to the inner column, say T. 944 945 RLC B ; [8] rotate the 8-counter/port address. 946 ; sets carry if more to do. 947 IN A,(C) ; [10] read another half-row. 948 ; all five bits this time. 949 950 JR C,<A href="#L02C5">L02C5</a> ; [12](7) loop back, until done, to EACH-LINE 951 952 ; The last row read is SHIFT,Z,X,C,V for the second time. 953 954 RRA ; (4) test the shift key - carry will be reset 955 ; if the key is pressed. 956 RL H ; (8) rotate left H picking up the carry giving 957 ; column values - 958 ; $FD, $FB, $F7, $EF, $DF. 959 ; or $FC, $FA, $F6, $EE, $DE if shifted. 960 961 ; We now have H identifying the column and L identifying the row in the 962 ; keyboard matrix. 963 964 ; This is a good time to test if this is an American or British machine. 965 ; The US machine has an extra diode that causes bit 6 of a byte read from 966 ; a port to be reset. 967 968 RLA ; (4) compensate for the shift test. 969 RLA ; (4) rotate bit 7 out. 970 RLA ; (4) test bit 6. 971 972 SBC A,A ; (4) $FF or $00 {USA} 973 AND $18 ; (7) $18 or $00 974 ADD A,$1F ; (7) $37 or $1F 975 976 ; result is either 31 (USA) or 55 (UK) blank lines above and below the TV 977 ; picture. 978 979 LD ($4028),A ; (13) update system variable MARGIN 980 981 RET ; (10) return 982 983 ; ------------------------------ 984 ; THE <b><font color=#333388>'SET FAST MODE'</font></b> SUBROUTINE 985 ; ------------------------------ 986 ; 987 ; 988 989 <a name="L02E7"></a>;; <b>SET-FAST</b> 990 L02E7: BIT 7,(IY+$3B) ; sv CDFLAG 991 RET Z ; 992 993 HALT ; Wait for Interrupt 994 OUT ($FD),A ; 995 RES 7,(IY+$3B) ; sv CDFLAG 996 RET ; return. 997 998 999 ; -------------- 1000 ; THE <b><font color=#333388>'REPORT-F'</font></b> 1001 ; -------------- 1002 1003 <a name="L02F4"></a>;; <b>REPORT-F</b> 1004 L02F4: RST 08H ; ERROR-1 1005 DEFB $0E ; Error Report: No Program Name supplied. 1006 1007 ; -------------------------- 1008 ; THE <b><font color=#333388>'SAVE COMMAND'</font></b> ROUTINE 1009 ; -------------------------- 1010 ; 1011 ; 1012 1013 <a name="L02F6"></a>;; <b>SAVE</b> 1014 L02F6: CALL <A href="#L03A8">L03A8</a> ; routine NAME 1015 JR C,<A href="#L02F4">L02F4</a> ; back with null name to REPORT-F above. 1016 1017 EX DE,HL ; 1018 LD DE,$12CB ; five seconds timing value 1019 1020 <a name="L02FF"></a>;; <b>HEADER</b> 1021 L02FF: CALL <A href="#L0F46">L0F46</a> ; routine BREAK-1 1022 JR NC,<A href="#L0332">L0332</a> ; to BREAK-2 1023 1024 <a name="L0304"></a>;; <b>DELAY-1</b> 1025 L0304: DJNZ <A href="#L0304">L0304</a> ; to DELAY-1 1026 1027 DEC DE ; 1028 LD A,D ; 1029 OR E ; 1030 JR NZ,<A href="#L02FF">L02FF</a> ; back for delay to HEADER 1031 1032 <a name="L030B"></a>;; <b>OUT-NAME</b> 1033 L030B: CALL <A href="#L031E">L031E</a> ; routine OUT-BYTE 1034 BIT 7,(HL) ; test for inverted bit. 1035 INC HL ; address next character of name. 1036 JR Z,<A href="#L030B">L030B</a> ; back if not inverted to OUT-NAME 1037 1038 ; now start saving the system variables onwards. 1039 1040 LD HL,$4009 ; set start of area to VERSN thereby 1041 ; preserving RAMTOP etc. 1042 1043 <a name="L0316"></a>;; <b>OUT-PROG</b> 1044 L0316: CALL <A href="#L031E">L031E</a> ; routine OUT-BYTE 1045 1046 CALL <A href="#L01FC">L01FC</a> ; routine LOAD/SAVE >> 1047 JR <A href="#L0316">L0316</a> ; loop back to OUT-PROG 1048 1049 ; ------------------------- 1050 ; THE <b><font color=#333388>'OUT-BYTE'</font></b> SUBROUTINE 1051 ; ------------------------- 1052 ; This subroutine outputs a byte a bit at a time to a domestic tape recorder. 1053 1054 <a name="L031E"></a>;; <b>OUT-BYTE</b> 1055 L031E: LD E,(HL) ; fetch byte to be saved. 1056 SCF ; set carry flag - as a marker. 1057 1058 <a name="L0320"></a>;; <b>EACH-BIT</b> 1059 L0320: RL E ; C < 76543210 < C 1060 RET Z ; return when the marker bit has passed 1061 ; right through. >> 1062 1063 SBC A,A ; $FF if set bit or $00 with no carry. 1064 AND $05 ; $05 $00 1065 ADD A,$04 ; $09 $04 1066 LD C,A ; transfer timer to C. a set bit has a longer 1067 ; pulse than a reset bit. 1068 1069 <a name="L0329"></a>;; <b>PULSES</b> 1070 L0329: OUT ($FF),A ; pulse to cassette. 1071 LD B,$23 ; set timing constant 1072 1073 <a name="L032D"></a>;; <b>DELAY-2</b> 1074 L032D: DJNZ <A href="#L032D">L032D</a> ; self-loop to DELAY-2 1075 1076 CALL <A href="#L0F46">L0F46</a> ; routine BREAK-1 test for BREAK key. 1077 1078 <a name="L0332"></a>;; <b>BREAK-2</b> 1079 L0332: JR NC,<A href="#L03A6">L03A6</a> ; forward with break to REPORT-D 1080 1081 LD B,$1E ; set timing value. 1082 1083 <a name="L0336"></a>;; <b>DELAY-3</b> 1084 L0336: DJNZ <A href="#L0336">L0336</a> ; self-loop to DELAY-3 1085 1086 DEC C ; decrement counter 1087 JR NZ,<A href="#L0329">L0329</a> ; loop back to PULSES 1088 1089 <a name="L033B"></a>;; <b>DELAY-4</b> 1090 L033B: AND A ; clear carry for next bit test. 1091 DJNZ <A href="#L033B">L033B</a> ; self loop to DELAY-4 (B is zero - 256) 1092 1093 JR <A href="#L0320">L0320</a> ; loop back to EACH-BIT 1094 1095 ; -------------------------- 1096 ; THE <b><font color=#333388>'LOAD COMMAND'</font></b> ROUTINE 1097 ; -------------------------- 1098 ; 1099 ; 1100 1101 <a name="L0340"></a>;; <b>LOAD</b> 1102 L0340: CALL <A href="#L03A8">L03A8</a> ; routine NAME 1103 1104 ; DE points to start of name in RAM. 1105 1106 RL D ; pick up carry 1107 RRC D ; carry now in bit 7. 1108 1109 <a name="L0347"></a>;; <b>NEXT-PROG</b> 1110 L0347: CALL <A href="#L034C">L034C</a> ; routine IN-BYTE 1111 JR <A href="#L0347">L0347</a> ; loop to NEXT-PROG 1112 1113 ; ------------------------ 1114 ; THE <b><font color=#333388>'IN-BYTE'</font></b> SUBROUTINE 1115 ; ------------------------ 1116 1117 <a name="L034C"></a>;; <b>IN-BYTE</b> 1118 L034C: LD C,$01 ; prepare an eight counter 00000001. 1119 1120 <a name="L034E"></a>;; <b>NEXT-BIT</b> 1121 L034E: LD B,$00 ; set counter to 256 1122 1123 <a name="L0350"></a>;; <b>BREAK-3</b> 1124 L0350: LD A,$7F ; read the keyboard row 1125 IN A,($FE) ; with the SPACE key. 1126 1127 OUT ($FF),A ; output signal to screen. 1128 1129 RRA ; test for SPACE pressed. 1130 JR NC,<A href="#L03A2">L03A2</a> ; forward if so to BREAK-4 1131 1132 RLA ; reverse above rotation 1133 RLA ; test tape bit. 1134 JR C,<A href="#L0385">L0385</a> ; forward if set to GET-BIT 1135 1136 DJNZ <A href="#L0350">L0350</a> ; loop back to BREAK-3 1137 1138 POP AF ; drop the return address. 1139 CP D ; ugh. 1140 1141 <a name="L0361"></a>;; <b>RESTART</b> 1142 L0361: JP NC,<A href="#L03E5">L03E5</a> ; jump forward to INITIAL if D is zero 1143 ; to reset the system 1144 ; if the tape signal has timed out for example 1145 ; if the tape is stopped. Not just a simple 1146 ; report as some system variables will have 1147 ; been overwritten. 1148 1149 LD H,D ; else transfer the start of name 1150 LD L,E ; to the HL register 1151 1152 <a name="L0366"></a>;; <b>IN-NAME</b> 1153 L0366: CALL <A href="#L034C">L034C</a> ; routine IN-BYTE is sort of recursion for name 1154 ; part. received byte in C. 1155 BIT 7,D ; is name the null string ? 1156 LD A,C ; transfer byte to A. 1157 JR NZ,<A href="#L0371">L0371</a> ; forward with null string to MATCHING 1158 1159 CP (HL) ; else compare with string in memory. 1160 JR NZ,<A href="#L0347">L0347</a> ; back with mis-match to NEXT-PROG 1161 ; (seemingly out of subroutine but return 1162 ; address has been dropped). 1163 1164 1165 <a name="L0371"></a>;; <b>MATCHING</b> 1166 L0371: INC HL ; address next character of name 1167 RLA ; test for inverted bit. 1168 JR NC,<A href="#L0366">L0366</a> ; back if not to IN-NAME 1169 1170 ; the name has been matched in full. 1171 ; proceed to load the data but first increment the high byte of E_LINE, which 1172 ; is one of the system variables to be loaded in. Since the low byte is loaded 1173 ; before the high byte, it is possible that, at the in-between stage, a false 1174 ; value could cause the load to end prematurely - see LOAD/SAVE check. 1175 1176 INC (IY+$15) ; increment system variable E_LINE_hi. 1177 LD HL,$4009 ; start loading at system variable VERSN. 1178 1179 <a name="L037B"></a>;; <b>IN-PROG</b> 1180 L037B: LD D,B ; set D to zero as indicator. 1181 CALL <A href="#L034C">L034C</a> ; routine IN-BYTE loads a byte 1182 LD (HL),C ; insert assembled byte in memory. 1183 CALL <A href="#L01FC">L01FC</a> ; routine LOAD/SAVE >> 1184 JR <A href="#L037B">L037B</a> ; loop back to IN-PROG 1185 1186 ; --- 1187 1188 ; this branch assembles a full byte before exiting normally 1189 ; from the IN-BYTE subroutine. 1190 1191 <a name="L0385"></a>;; <b>GET-BIT</b> 1192 L0385: PUSH DE ; save the 1193 LD E,$94 ; timing value. 1194 1195 <a name="L0388"></a>;; <b>TRAILER</b> 1196 L0388: LD B,$1A ; counter to twenty six. 1197 1198 <a name="L038A"></a>;; <b>COUNTER</b> 1199 L038A: DEC E ; decrement the measuring timer. 1200 IN A,($FE) ; read the 1201 RLA ; 1202 BIT 7,E ; 1203 LD A,E ; 1204 JR C,<A href="#L0388">L0388</a> ; loop back with carry to TRAILER 1205 1206 DJNZ <A href="#L038A">L038A</a> ; to COUNTER 1207 1208 POP DE ; 1209 JR NZ,<A href="#L039C">L039C</a> ; to BIT-DONE 1210 1211 CP $56 ; 1212 JR NC,<A href="#L034E">L034E</a> ; to NEXT-BIT 1213 1214 <a name="L039C"></a>;; <b>BIT-DONE</b> 1215 L039C: CCF ; complement carry flag 1216 RL C ; 1217 JR NC,<A href="#L034E">L034E</a> ; to NEXT-BIT 1218 1219 RET ; return with full byte. 1220 1221 ; --- 1222 1223 ; if break is pressed while loading data then perform a reset. 1224 ; if break pressed while waiting for program on tape then OK to break. 1225 1226 <a name="L03A2"></a>;; <b>BREAK-4</b> 1227 L03A2: LD A,D ; transfer indicator to A. 1228 AND A ; test for zero. 1229 JR Z,<A href="#L0361">L0361</a> ; back if so to RESTART 1230 1231 1232 <a name="L03A6"></a>;; <b>REPORT-D</b> 1233 L03A6: RST 08H ; ERROR-1 1234 DEFB $0C ; Error Report: BREAK - CONT repeats 1235 1236 ; ----------------------------- 1237 ; THE <b><font color=#333388>'PROGRAM NAME'</font></b> SUBROUTINE 1238 ; ----------------------------- 1239 ; 1240 ; 1241 1242 <a name="L03A8"></a>;; <b>NAME</b> 1243 L03A8: CALL <A href="#L0F55">L0F55</a> ; routine SCANNING 1244 LD A,($4001) ; sv FLAGS 1245 ADD A,A ; 1246 JP M,<A href="#L0D9A">L0D9A</a> ; to REPORT-C 1247 1248 POP HL ; 1249 RET NC ; 1250 1251 PUSH HL ; 1252 CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST 1253 CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH 1254 LD H,D ; 1255 LD L,E ; 1256 DEC C ; 1257 RET M ; 1258 1259 ADD HL,BC ; 1260 SET 7,(HL) ; 1261 RET ; 1262 1263 ; ------------------------- 1264 ; THE <b><font color=#333388>'NEW'</font></b> COMMAND ROUTINE 1265 ; ------------------------- 1266 ; 1267 ; 1268 1269 <a name="L03C3"></a>;; <b>NEW</b> 1270 L03C3: CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST 1271 LD BC,($4004) ; fetch value of system variable RAMTOP 1272 DEC BC ; point to last system byte. 1273 1274 ; ----------------------- 1275 ; THE <b><font color=#333388>'RAM CHECK'</font></b> ROUTINE 1276 ; ----------------------- 1277 ; 1278 ; 1279 1280 <a name="L03CB"></a>;; <b>RAM-CHECK</b> 1281 L03CB: LD H,B ; 1282 LD L,C ; 1283 LD A,$3F ; 1284 1285 <a name="L03CF"></a>;; <b>RAM-FILL</b> 1286 L03CF: LD (HL),$02 ; 1287 DEC HL ; 1288 CP H ; 1289 JR NZ,<A href="#L03CF">L03CF</a> ; to RAM-FILL 1290 1291 <a name="L03D5"></a>;; <b>RAM-READ</b> 1292 L03D5: AND A ; 1293 SBC HL,BC ; 1294 ADD HL,BC ; 1295 INC HL ; 1296 JR NC,<A href="#L03E2">L03E2</a> ; to SET-TOP 1297 1298 DEC (HL) ; 1299 JR Z,<A href="#L03E2">L03E2</a> ; to SET-TOP 1300 1301 DEC (HL) ; 1302 JR Z,<A href="#L03D5">L03D5</a> ; to RAM-READ 1303 1304 <a name="L03E2"></a>;; <b>SET-TOP</b> 1305 L03E2: LD ($4004),HL ; set system variable RAMTOP to first byte 1306 ; above the BASIC system area. 1307 1308 ; ---------------------------- 1309 ; THE <b><font color=#333388>'INITIALIZATION'</font></b> ROUTINE 1310 ; ---------------------------- 1311 ; 1312 ; 1313 1314 <a name="L03E5"></a>;; <b>INITIAL</b> 1315 L03E5: LD HL,($4004) ; fetch system variable RAMTOP. 1316 DEC HL ; point to last system byte. 1317 LD (HL),$3E ; make GO SUB end-marker $3E - too high for 1318 ; high order byte of line number. 1319 ; (was $3F on ZX80) 1320 DEC HL ; point to unimportant low-order byte. 1321 LD SP,HL ; and initialize the stack-pointer to this 1322 ; location. 1323 DEC HL ; point to first location on the machine stack 1324 DEC HL ; which will be filled by next CALL/PUSH. 1325 LD ($4002),HL ; set the error stack pointer ERR_SP to 1326 ; the base of the now empty machine stack. 1327 1328 ; Now set the I register so that the video hardware knows where to find the 1329 ; character set. This ROM only uses the character set when printing to 1330 ; the ZX Printer. The TV picture is formed by the external video hardware. 1331 ; Consider also, that this 8K ROM can be retro-fitted to the ZX80 instead of 1332 ; its original 4K ROM so the video hardware could be on the ZX80. 1333 1334 LD A,$1E ; address for this ROM is $1E00. 1335 LD I,A ; set I register from A. 1336 IM 1 ; select Z80 Interrupt Mode 1. 1337 1338 LD IY,$4000 ; set IY to the start of RAM so that the 1339 ; system variables can be indexed. 1340 LD (IY+$3B),$40 ; set CDFLAG 0100 0000. Bit 6 indicates 1341 ; Compute nad Display required. 1342 1343 LD HL,$407D ; The first location after System Variables - 1344 ; 16509 decimal. 1345 LD ($400C),HL ; set system variable D_FILE to this value. 1346 LD B,$19 ; prepare minimal screen of 24 NEWLINEs 1347 ; following an initial NEWLINE. 1348 1349 <a name="L0408"></a>;; <b>LINE</b> 1350 L0408: LD (HL),$76 ; insert NEWLINE (HALT instruction) 1351 INC HL ; point to next location. 1352 DJNZ <A href="#L0408">L0408</a> ; loop back for all twenty five to LINE 1353 1354 LD ($4010),HL ; set system variable VARS to next location 1355 1356 CALL <A href="#L149A">L149A</a> ; routine CLEAR sets $80 end-marker and the 1357 ; dynamic memory pointers E_LINE, STKBOT and 1358 ; STKEND. 1359 1360 <a name="L0413"></a>;; <b>N/L-ONLY</b> 1361 L0413: CALL <A href="#L14AD">L14AD</a> ; routine CURSOR-IN inserts the cursor and 1362 ; end-marker in the Edit Line also setting 1363 ; size of lower display to two lines. 1364 1365 CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST selects COMPUTE and DISPLAY 1366 1367 ; --------------------------- 1368 ; THE <b><font color=#333388>'BASIC LISTING'</font></b> SECTION 1369 ; --------------------------- 1370 ; 1371 ; 1372 1373 <a name="L0419"></a>;; <b>UPPER</b> 1374 L0419: CALL <A href="#L0A2A">L0A2A</a> ; routine CLS 1375 LD HL,($400A) ; sv E_PPC_lo 1376 LD DE,($4023) ; sv S_TOP_lo 1377 AND A ; 1378 SBC HL,DE ; 1379 EX DE,HL ; 1380 JR NC,<A href="#L042D">L042D</a> ; to ADDR-TOP 1381 1382 ADD HL,DE ; 1383 LD ($4023),HL ; sv S_TOP_lo 1384 1385 <a name="L042D"></a>;; <b>ADDR-TOP</b> 1386 L042D: CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR 1387 JR Z,<A href="#L0433">L0433</a> ; to LIST-TOP 1388 1389 EX DE,HL ; 1390 1391 <a name="L0433"></a>;; <b>LIST-TOP</b> 1392 L0433: CALL <A href="#L073E">L073E</a> ; routine LIST-PROG 1393 DEC (IY+$1E) ; sv BERG 1394 JR NZ,<A href="#L0472">L0472</a> ; to LOWER 1395 1396 LD HL,($400A) ; sv E_PPC_lo 1397 CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR 1398 LD HL,($4016) ; sv CH_ADD_lo 1399 SCF ; Set Carry Flag 1400 SBC HL,DE ; 1401 LD HL,$4023 ; sv S_TOP_lo 1402 JR NC,<A href="#L0457">L0457</a> ; to INC-LINE 1403 1404 EX DE,HL ; 1405 LD A,(HL) ; 1406 INC HL ; 1407 LDI ; 1408 LD (DE),A ; 1409 JR <A href="#L0419">L0419</a> ; to UPPER 1410 1411 ; --- 1412 1413 <a name="L0454"></a>;; <b>DOWN-KEY</b> 1414 L0454: LD HL,$400A ; sv E_PPC_lo 1415 1416 <a name="L0457"></a>;; <b>INC-LINE</b> 1417 L0457: LD E,(HL) ; 1418 INC HL ; 1419 LD D,(HL) ; 1420 PUSH HL ; 1421 EX DE,HL ; 1422 INC HL ; 1423 CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR 1424 CALL <A href="#L05BB">L05BB</a> ; routine LINE-NO 1425 POP HL ; 1426 1427 <a name="L0464"></a>;; <b>KEY-INPUT</b> 1428 L0464: BIT 5,(IY+$2D) ; sv FLAGX 1429 JR NZ,<A href="#L0472">L0472</a> ; forward to LOWER 1430 1431 LD (HL),D ; 1432 DEC HL ; 1433 LD (HL),E ; 1434 JR <A href="#L0419">L0419</a> ; to UPPER 1435 1436 ; ---------------------------- 1437 ; THE <b><font color=#333388>'EDIT LINE COPY'</font></b> SECTION 1438 ; ---------------------------- 1439 ; This routine sets the edit line to just the cursor when 1440 ; 1) There is not enough memory to edit a BASIC line. 1441 ; 2) The edit key is used during input. 1442 ; The entry point LOWER 1443 1444 1445 <a name="L046F"></a>;; <b>EDIT-INP</b> 1446 L046F: CALL <A href="#L14AD">L14AD</a> ; routine CURSOR-IN sets cursor only edit line. 1447 1448 ; -> 1449 1450 <a name="L0472"></a>;; <b>LOWER</b> 1451 L0472: LD HL,($4014) ; fetch edit line start from E_LINE. 1452 1453 <a name="L0475"></a>;; <b>EACH-CHAR</b> 1454 L0475: LD A,(HL) ; fetch a character from edit line. 1455 CP $7E ; compare to the number marker. 1456 JR NZ,<A href="#L0482">L0482</a> ; forward if not to END-LINE 1457 1458 LD BC,$0006 ; else six invisible bytes to be removed. 1459 CALL <A href="#L0A60">L0A60</a> ; routine RECLAIM-2 1460 JR <A href="#L0475">L0475</a> ; back to EACH-CHAR 1461 1462 ; --- 1463 1464 <a name="L0482"></a>;; <b>END-LINE</b> 1465 L0482: CP $76 ; 1466 INC HL ; 1467 JR NZ,<A href="#L0475">L0475</a> ; to EACH-CHAR 1468 1469 <a name="L0487"></a>;; <b>EDIT-LINE</b> 1470 L0487: CALL <A href="#L0537">L0537</a> ; routine CURSOR sets cursor K or L. 1471 1472 <a name="L048A"></a>;; <b>EDIT-ROOM</b> 1473 L048A: CALL <A href="#L0A1F">L0A1F</a> ; routine LINE-ENDS 1474 LD HL,($4014) ; sv E_LINE_lo 1475 LD (IY+$00),$FF ; sv ERR_NR 1476 CALL <A href="#L0766">L0766</a> ; routine COPY-LINE 1477 BIT 7,(IY+$00) ; sv ERR_NR 1478 JR NZ,<A href="#L04C1">L04C1</a> ; to DISPLAY-6 1479 1480 LD A,($4022) ; sv DF_SZ 1481 CP $18 ; 1482 JR NC,<A href="#L04C1">L04C1</a> ; to DISPLAY-6 1483 1484 INC A ; 1485 LD ($4022),A ; sv DF_SZ 1486 LD B,A ; 1487 LD C,$01 ; 1488 CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR 1489 LD D,H ; 1490 LD E,L ; 1491 LD A,(HL) ; 1492 1493 <a name="L04B1"></a>;; <b>FREE-LINE</b> 1494 L04B1: DEC HL ; 1495 CP (HL) ; 1496 JR NZ,<A href="#L04B1">L04B1</a> ; to FREE-LINE 1497 1498 INC HL ; 1499 EX DE,HL ; 1500 LD A,($4005) ; sv RAMTOP_hi 1501 CP $4D ; 1502 CALL C,<A href="#L0A5D">L0A5D</a> ; routine RECLAIM-1 1503 JR <A href="#L048A">L048A</a> ; to EDIT-ROOM 1504 1505 ; -------------------------- 1506 ; THE <b><font color=#333388>'WAIT FOR KEY'</font></b> SECTION 1507 ; -------------------------- 1508 ; 1509 ; 1510 1511 <a name="L04C1"></a>;; <b>DISPLAY-6</b> 1512 L04C1: LD HL,$0000 ; 1513 LD ($4018),HL ; sv X_PTR_lo 1514 1515 LD HL,$403B ; system variable CDFLAG 1516 BIT 7,(HL) ; 1517 1518 CALL Z,<A href="#L0229">L0229</a> ; routine DISPLAY-1 1519 1520 <a name="L04CF"></a>;; <b>SLOW-DISP</b> 1521 L04CF: BIT 0,(HL) ; 1522 JR Z,<A href="#L04CF">L04CF</a> ; to SLOW-DISP 1523 1524 LD BC,($4025) ; sv LAST_K 1525 CALL <A href="#L0F4B">L0F4B</a> ; routine DEBOUNCE 1526 CALL <A href="#L07BD">L07BD</a> ; routine DECODE 1527 1528 JR NC,<A href="#L0472">L0472</a> ; back to LOWER 1529 1530 ; ------------------------------- 1531 ; THE <b><font color=#333388>'KEYBOARD DECODING'</font></b> SECTION 1532 ; ------------------------------- 1533 ; The decoded key value is in E and HL points to the position in the 1534 ; key table. D contains zero. 1535 1536 <a name="L04DF"></a>;; <b>K-DECODE</b> 1537 L04DF: LD A,($4006) ; Fetch value of system variable MODE 1538 DEC A ; test the three values together 1539 1540 JP M,<A href="#L0508">L0508</a> ; forward, if was zero, to FETCH-2 1541 1542 JR NZ,<A href="#L04F7">L04F7</a> ; forward, if was 2, to FETCH-1 1543 1544 ; The original value was one and is now zero. 1545 1546 LD ($4006),A ; update the system variable MODE 1547 1548 DEC E ; reduce E to range $00 - $7F 1549 LD A,E ; place in A 1550 SUB $27 ; subtract 39 setting carry if range 00 - 38 1551 JR C,<A href="#L04F2">L04F2</a> ; forward, if so, to FUNC-BASE 1552 1553 LD E,A ; else set E to reduced value 1554 1555 <a name="L04F2"></a>;; <b>FUNC-BASE</b> 1556 L04F2: LD HL,<A href="#L00CC">L00CC</a> ; address of K-FUNCT table for function keys. 1557 JR <A href="#L0505">L0505</a> ; forward to TABLE-ADD 1558 1559 ; --- 1560 1561 <a name="L04F7"></a>;; <b>FETCH-1</b> 1562 L04F7: LD A,(HL) ; 1563 CP $76 ; 1564 JR Z,<A href="#L052B">L052B</a> ; to K/L-KEY 1565 1566 CP $40 ; 1567 SET 7,A ; 1568 JR C,<A href="#L051B">L051B</a> ; to ENTER 1569 1570 LD HL,$00C7 ; (expr reqd) 1571 1572 <a name="L0505"></a>;; <b>TABLE-ADD</b> 1573 L0505: ADD HL,DE ; 1574 JR <A href="#L0515">L0515</a> ; to FETCH-3 1575 1576 ; --- 1577 1578 <a name="L0508"></a>;; <b>FETCH-2</b> 1579 L0508: LD A,(HL) ; 1580 BIT 2,(IY+$01) ; sv FLAGS - K or L mode ? 1581 JR NZ,<A href="#L0516">L0516</a> ; to TEST-CURS 1582 1583 ADD A,$C0 ; 1584 CP $E6 ; 1585 JR NC,<A href="#L0516">L0516</a> ; to TEST-CURS 1586 1587 <a name="L0515"></a>;; <b>FETCH-3</b> 1588 L0515: LD A,(HL) ; 1589 1590 <a name="L0516"></a>;; <b>TEST-CURS</b> 1591 L0516: CP $F0 ; 1592 JP PE,<A href="#L052D">L052D</a> ; to KEY-SORT 1593 1594 <a name="L051B"></a>;; <b>ENTER</b> 1595 L051B: LD E,A ; 1596 CALL <A href="#L0537">L0537</a> ; routine CURSOR 1597 1598 LD A,E ; 1599 CALL <A href="#L0526">L0526</a> ; routine ADD-CHAR 1600 1601 <a name="L0523"></a>;; <b>BACK-NEXT</b> 1602 L0523: JP <A href="#L0472">L0472</a> ; back to LOWER 1603 1604 ; ------------------------------ 1605 ; THE <b><font color=#333388>'ADD CHARACTER'</font></b> SUBROUTINE 1606 ; ------------------------------ 1607 ; 1608 ; 1609 1610 <a name="L0526"></a>;; <b>ADD-CHAR</b> 1611 L0526: CALL <A href="#L099B">L099B</a> ; routine ONE-SPACE 1612 LD (DE),A ; 1613 RET ; 1614 1615 ; ------------------------- 1616 ; THE <b><font color=#333388>'CURSOR KEYS'</font></b> ROUTINE 1617 ; ------------------------- 1618 ; 1619 ; 1620 1621 <a name="L052B"></a>;; <b>K/L-KEY</b> 1622 L052B: LD A,$78 ; 1623 1624 <a name="L052D"></a>;; <b>KEY-SORT</b> 1625 L052D: LD E,A ; 1626 LD HL,$0482 ; base address of ED-KEYS (exp reqd) 1627 ADD HL,DE ; 1628 ADD HL,DE ; 1629 LD C,(HL) ; 1630 INC HL ; 1631 LD B,(HL) ; 1632 PUSH BC ; 1633 1634 <a name="L0537"></a>;; <b>CURSOR</b> 1635 L0537: LD HL,($4014) ; sv E_LINE_lo 1636 BIT 5,(IY+$2D) ; sv FLAGX 1637 JR NZ,<A href="#L0556">L0556</a> ; to L-MODE 1638 1639 <a name="L0540"></a>;; <b>K-MODE</b> 1640 L0540: RES 2,(IY+$01) ; sv FLAGS - Signal use K mode 1641 1642 <a name="L0544"></a>;; <b>TEST-CHAR</b> 1643 L0544: LD A,(HL) ; 1644 CP $7F ; 1645 RET Z ; return 1646 1647 INC HL ; 1648 CALL <A href="#L07B4">L07B4</a> ; routine NUMBER 1649 JR Z,<A href="#L0544">L0544</a> ; to TEST-CHAR 1650 1651 CP $26 ; 1652 JR C,<A href="#L0544">L0544</a> ; to TEST-CHAR 1653 1654 CP $DE ; 1655 JR Z,<A href="#L0540">L0540</a> ; to K-MODE 1656 1657 <a name="L0556"></a>;; <b>L-MODE</b> 1658 L0556: SET 2,(IY+$01) ; sv FLAGS - Signal use L mode 1659 JR <A href="#L0544">L0544</a> ; to TEST-CHAR 1660 1661 ; -------------------------- 1662 ; THE <b><font color=#333388>'CLEAR-ONE'</font></b> SUBROUTINE 1663 ; -------------------------- 1664 ; 1665 ; 1666 1667 <a name="L055C"></a>;; <b>CLEAR-ONE</b> 1668 L055C: LD BC,$0001 ; 1669 JP <A href="#L0A60">L0A60</a> ; to RECLAIM-2 1670 1671 1672 1673 ; ------------------------ 1674 ; THE <b><font color=#333388>'EDITING KEYS'</font></b> TABLE 1675 ; ------------------------ 1676 ; 1677 ; 1678 1679 <a name="L0562"></a>;; <b>ED-KEYS</b> 1680 L0562: DEFW <A href="#L059F">L059F</a> ; Address: $059F; Address: UP-KEY 1681 DEFW <A href="#L0454">L0454</a> ; Address: $0454; Address: DOWN-KEY 1682 DEFW <A href="#L0576">L0576</a> ; Address: $0576; Address: LEFT-KEY 1683 DEFW <A href="#L057F">L057F</a> ; Address: $057F; Address: RIGHT-KEY 1684 DEFW <A href="#L05AF">L05AF</a> ; Address: $05AF; Address: FUNCTION 1685 DEFW <A href="#L05C4">L05C4</a> ; Address: $05C4; Address: EDIT-KEY 1686 DEFW <A href="#L060C">L060C</a> ; Address: $060C; Address: N/L-KEY 1687 DEFW <A href="#L058B">L058B</a> ; Address: $058B; Address: RUBOUT 1688 DEFW <A href="#L05AF">L05AF</a> ; Address: $05AF; Address: FUNCTION 1689 DEFW <A href="#L05AF">L05AF</a> ; Address: $05AF; Address: FUNCTION 1690 1691 1692 ; ------------------------- 1693 ; THE <b><font color=#333388>'CURSOR LEFT'</font></b> ROUTINE 1694 ; ------------------------- 1695 ; 1696 ; 1697 1698 <a name="L0576"></a>;; <b>LEFT-KEY</b> 1699 L0576: CALL <A href="#L0593">L0593</a> ; routine LEFT-EDGE 1700 LD A,(HL) ; 1701 LD (HL),$7F ; 1702 INC HL ; 1703 JR <A href="#L0588">L0588</a> ; to GET-CODE 1704 1705 ; -------------------------- 1706 ; THE <b><font color=#333388>'CURSOR RIGHT'</font></b> ROUTINE 1707 ; -------------------------- 1708 ; 1709 ; 1710 1711 <a name="L057F"></a>;; <b>RIGHT-KEY</b> 1712 L057F: INC HL ; 1713 LD A,(HL) ; 1714 CP $76 ; 1715 JR Z,<A href="#L059D">L059D</a> ; to ENDED-2 1716 1717 LD (HL),$7F ; 1718 DEC HL ; 1719 1720 <a name="L0588"></a>;; <b>GET-CODE</b> 1721 L0588: LD (HL),A ; 1722 1723 <a name="L0589"></a>;; <b>ENDED-1</b> 1724 L0589: JR <A href="#L0523">L0523</a> ; to BACK-NEXT 1725 1726 ; -------------------- 1727 ; THE <b><font color=#333388>'RUBOUT'</font></b> ROUTINE 1728 ; -------------------- 1729 ; 1730 ; 1731 1732 <a name="L058B"></a>;; <b>RUBOUT</b> 1733 L058B: CALL <A href="#L0593">L0593</a> ; routine LEFT-EDGE 1734 CALL <A href="#L055C">L055C</a> ; routine CLEAR-ONE 1735 JR <A href="#L0589">L0589</a> ; to ENDED-1 1736 1737 ; ------------------------ 1738 ; THE <b><font color=#333388>'ED-EDGE'</font></b> SUBROUTINE 1739 ; ------------------------ 1740 ; 1741 ; 1742 1743 <a name="L0593"></a>;; <b>LEFT-EDGE</b> 1744 L0593: DEC HL ; 1745 LD DE,($4014) ; sv E_LINE_lo 1746 LD A,(DE) ; 1747 CP $7F ; 1748 RET NZ ; 1749 1750 POP DE ; 1751 1752 <a name="L059D"></a>;; <b>ENDED-2</b> 1753 L059D: JR <A href="#L0589">L0589</a> ; to ENDED-1 1754 1755 ; ----------------------- 1756 ; THE <b><font color=#333388>'CURSOR UP'</font></b> ROUTINE 1757 ; ----------------------- 1758 ; 1759 ; 1760 1761 <a name="L059F"></a>;; <b>UP-KEY</b> 1762 L059F: LD HL,($400A) ; sv E_PPC_lo 1763 CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR 1764 EX DE,HL ; 1765 CALL <A href="#L05BB">L05BB</a> ; routine LINE-NO 1766 LD HL,$400B ; point to system variable E_PPC_hi 1767 JP <A href="#L0464">L0464</a> ; jump back to KEY-INPUT 1768 1769 ; -------------------------- 1770 ; THE <b><font color=#333388>'FUNCTION KEY'</font></b> ROUTINE 1771 ; -------------------------- 1772 ; 1773 ; 1774 1775 <a name="L05AF"></a>;; <b>FUNCTION</b> 1776 L05AF: LD A,E ; 1777 AND $07 ; 1778 LD ($4006),A ; sv MODE 1779 JR <A href="#L059D">L059D</a> ; back to ENDED-2 1780 1781 ; ------------------------------------ 1782 ; THE <b><font color=#333388>'COLLECT LINE NUMBER'</font></b> SUBROUTINE 1783 ; ------------------------------------ 1784 ; 1785 ; 1786 1787 <a name="L05B7"></a>;; <b>ZERO-DE</b> 1788 L05B7: EX DE,HL ; 1789 LD DE,<A href="#L04C1">L04C1</a> + 1 ; $04C2 - a location addressing two zeros. 1790 1791 ; -> 1792 1793 <a name="L05BB"></a>;; <b>LINE-NO</b> 1794 L05BB: LD A,(HL) ; 1795 AND $C0 ; 1796 JR NZ,<A href="#L05B7">L05B7</a> ; to ZERO-DE 1797 1798 LD D,(HL) ; 1799 INC HL ; 1800 LD E,(HL) ; 1801 RET ; 1802 1803 ; ---------------------- 1804 ; THE <b><font color=#333388>'EDIT KEY'</font></b> ROUTINE 1805 ; ---------------------- 1806 ; 1807 ; 1808 1809 <a name="L05C4"></a>;; <b>EDIT-KEY</b> 1810 L05C4: CALL <A href="#L0A1F">L0A1F</a> ; routine LINE-ENDS clears lower display. 1811 1812 LD HL,<A href="#L046F">L046F</a> ; Address: EDIT-INP 1813 PUSH HL ; ** is pushed as an error looping address. 1814 1815 BIT 5,(IY+$2D) ; test FLAGX 1816 RET NZ ; indirect jump if in input mode 1817 ; to <A href="#L046F">L046F</a>, EDIT-INP (begin again). 1818 1819 ; 1820 1821 LD HL,($4014) ; fetch E_LINE 1822 LD ($400E),HL ; and use to update the screen cursor DF_CC 1823 1824 ; so now RST $10 will print the line numbers to the edit line instead of screen. 1825 ; first make sure that no newline/out of screen can occur while sprinting the 1826 ; line numbers to the edit line. 1827 1828 LD HL,$1821 ; prepare line 0, column 0. 1829 LD ($4039),HL ; update S_POSN with these dummy values. 1830 1831 LD HL,($400A) ; fetch current line from E_PPC may be a 1832 ; non-existent line e.g. last line deleted. 1833 CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR gets address or that of 1834 ; the following line. 1835 CALL <A href="#L05BB">L05BB</a> ; routine LINE-NO gets line number if any in DE 1836 ; leaving HL pointing at second low byte. 1837 1838 LD A,D ; test the line number for zero. 1839 OR E ; 1840 RET Z ; return if no line number - no program to edit. 1841 1842 DEC HL ; point to high byte. 1843 CALL <A href="#L0AA5">L0AA5</a> ; routine OUT-NO writes number to edit line. 1844 1845 INC HL ; point to length bytes. 1846 LD C,(HL) ; low byte to C. 1847 INC HL ; 1848 LD B,(HL) ; high byte to B. 1849 1850 INC HL ; point to first character in line. 1851 LD DE,($400E) ; fetch display file cursor DF_CC 1852 1853 LD A,$7F ; prepare the cursor character. 1854 LD (DE),A ; and insert in edit line. 1855 INC DE ; increment intended destination. 1856 1857 PUSH HL ; * save start of BASIC. 1858 1859 LD HL,$001D ; set an overhead of 29 bytes. 1860 ADD HL,DE ; add in the address of cursor. 1861 ADD HL,BC ; add the length of the line. 1862 SBC HL,SP ; subtract the stack pointer. 1863 1864 POP HL ; * restore pointer to start of BASIC. 1865 1866 RET NC ; return if not enough room to L046F EDIT-INP. 1867 ; the edit key appears not to work. 1868 1869 LDIR ; else copy bytes from program to edit line. 1870 ; <font color=#9900FF>Note.</font> hidden floating point forms are also 1871 ; copied to edit line. 1872 1873 EX DE,HL ; transfer free location pointer to HL 1874 1875 POP DE ; ** remove address EDIT-INP from stack. 1876 1877 CALL <A href="#L14A6">L14A6</a> ; routine SET-STK-B sets STKEND from HL. 1878 1879 JR <A href="#L059D">L059D</a> ; back to ENDED-2 and after 3 more jumps 1880 ; to <A href="#L0472">L0472</a>, LOWER. 1881 ; <font color=#9900FF>Note.</font> The LOWER routine removes the hidden 1882 ; floating-point numbers from the edit line. 1883 1884 ; ------------------------- 1885 ; THE <b><font color=#333388>'NEWLINE KEY'</font></b> ROUTINE 1886 ; ------------------------- 1887 ; 1888 ; 1889 1890 <a name="L060C"></a>;; <b>N/L-KEY</b> 1891 L060C: CALL <A href="#L0A1F">L0A1F</a> ; routine LINE-ENDS 1892 1893 LD HL,<A href="#L0472">L0472</a> ; prepare address: LOWER 1894 1895 BIT 5,(IY+$2D) ; sv FLAGX 1896 JR NZ,<A href="#L0629">L0629</a> ; to NOW-SCAN 1897 1898 LD HL,($4014) ; sv E_LINE_lo 1899 LD A,(HL) ; 1900 CP $FF ; 1901 JR Z,<A href="#L0626">L0626</a> ; to STK-UPPER 1902 1903 CALL <A href="#L08E2">L08E2</a> ; routine CLEAR-PRB 1904 CALL <A href="#L0A2A">L0A2A</a> ; routine CLS 1905 1906 <a name="L0626"></a>;; <b>STK-UPPER</b> 1907 L0626: LD HL,<A href="#L0419">L0419</a> ; Address: UPPER 1908 1909 <a name="L0629"></a>;; <b>NOW-SCAN</b> 1910 L0629: PUSH HL ; push routine address (LOWER or UPPER). 1911 CALL <A href="#L0CBA">L0CBA</a> ; routine LINE-SCAN 1912 POP HL ; 1913 CALL <A href="#L0537">L0537</a> ; routine CURSOR 1914 CALL <A href="#L055C">L055C</a> ; routine CLEAR-ONE 1915 CALL <A href="#L0A73">L0A73</a> ; routine E-LINE-NO 1916 JR NZ,<A href="#L064E">L064E</a> ; to N/L-INP 1917 1918 LD A,B ; 1919 OR C ; 1920 JP NZ,<A href="#L06E0">L06E0</a> ; to N/L-LINE 1921 1922 DEC BC ; 1923 DEC BC ; 1924 LD ($4007),BC ; sv PPC_lo 1925 LD (IY+$22),$02 ; sv DF_SZ 1926 LD DE,($400C) ; sv D_FILE_lo 1927 1928 JR <A href="#L0661">L0661</a> ; forward to TEST-NULL 1929 1930 ; --- 1931 1932 <a name="L064E"></a>;; <b>N/L-INP</b> 1933 L064E: CP $76 ; 1934 JR Z,<A href="#L0664">L0664</a> ; to N/L-NULL 1935 1936 LD BC,($4030) ; sv T_ADDR_lo 1937 CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR 1938 LD DE,($4029) ; sv NXTLIN_lo 1939 LD (IY+$22),$02 ; sv DF_SZ 1940 1941 <a name="L0661"></a>;; <b>TEST-NULL</b> 1942 L0661: RST 18H ; GET-CHAR 1943 CP $76 ; 1944 1945 <a name="L0664"></a>;; <b>N/L-NULL</b> 1946 L0664: JP Z,<A href="#L0413">L0413</a> ; to N/L-ONLY 1947 1948 LD (IY+$01),$80 ; sv FLAGS 1949 EX DE,HL ; 1950 1951 <a name="L066C"></a>;; <b>NEXT-LINE</b> 1952 L066C: LD ($4029),HL ; sv NXTLIN_lo 1953 EX DE,HL ; 1954 CALL <A href="#L004D">L004D</a> ; routine TEMP-PTR-2 1955 CALL <A href="#L0CC1">L0CC1</a> ; routine LINE-RUN 1956 RES 1,(IY+$01) ; sv FLAGS - Signal printer not in use 1957 LD A,$C0 ; 1958 LD (IY+$19),A ; sv X_PTR_lo 1959 CALL <A href="#L14A3">L14A3</a> ; routine X-TEMP 1960 RES 5,(IY+$2D) ; sv FLAGX 1961 BIT 7,(IY+$00) ; sv ERR_NR 1962 JR Z,<A href="#L06AE">L06AE</a> ; to STOP-LINE 1963 1964 LD HL,($4029) ; sv NXTLIN_lo 1965 AND (HL) ; 1966 JR NZ,<A href="#L06AE">L06AE</a> ; to STOP-LINE 1967 1968 LD D,(HL) ; 1969 INC HL ; 1970 LD E,(HL) ; 1971 LD ($4007),DE ; sv PPC_lo 1972 INC HL ; 1973 LD E,(HL) ; 1974 INC HL ; 1975 LD D,(HL) ; 1976 INC HL ; 1977 EX DE,HL ; 1978 ADD HL,DE ; 1979 CALL <A href="#L0F46">L0F46</a> ; routine BREAK-1 1980 JR C,<A href="#L066C">L066C</a> ; to NEXT-LINE 1981 1982 LD HL,$4000 ; sv ERR_NR 1983 BIT 7,(HL) ; 1984 JR Z,<A href="#L06AE">L06AE</a> ; to STOP-LINE 1985 1986 LD (HL),$0C ; 1987 1988 <a name="L06AE"></a>;; <b>STOP-LINE</b> 1989 L06AE: BIT 7,(IY+$38) ; sv PR_CC 1990 CALL Z,<A href="#L0871">L0871</a> ; routine COPY-BUFF 1991 LD BC,$0121 ; 1992 CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR 1993 LD A,($4000) ; sv ERR_NR 1994 LD BC,($4007) ; sv PPC_lo 1995 INC A ; 1996 JR Z,<A href="#L06D1">L06D1</a> ; to REPORT 1997 1998 CP $09 ; 1999 JR NZ,<A href="#L06CA">L06CA</a> ; to CONTINUE 2000 2001 INC BC ; 2002 2003 <a name="L06CA"></a>;; <b>CONTINUE</b> 2004 L06CA: LD ($402B),BC ; sv OLDPPC_lo 2005 JR NZ,<A href="#L06D1">L06D1</a> ; to REPORT 2006 2007 DEC BC ; 2008 2009 <a name="L06D1"></a>;; <b>REPORT</b> 2010 L06D1: CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE 2011 LD A,$18 ; 2012 2013 RST 10H ; PRINT-A 2014 CALL <A href="#L0A98">L0A98</a> ; routine OUT-NUM 2015 CALL <A href="#L14AD">L14AD</a> ; routine CURSOR-IN 2016 JP <A href="#L04C1">L04C1</a> ; to DISPLAY-6 2017 2018 ; --- 2019 2020 <a name="L06E0"></a>;; <b>N/L-LINE</b> 2021 L06E0: LD ($400A),BC ; sv E_PPC_lo 2022 LD HL,($4016) ; sv CH_ADD_lo 2023 EX DE,HL ; 2024 LD HL,<A href="#L0413">L0413</a> ; Address: N/L-ONLY 2025 PUSH HL ; 2026 LD HL,($401A) ; sv STKBOT_lo 2027 SBC HL,DE ; 2028 PUSH HL ; 2029 PUSH BC ; 2030 CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST 2031 CALL <A href="#L0A2A">L0A2A</a> ; routine CLS 2032 POP HL ; 2033 CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR 2034 JR NZ,<A href="#L0705">L0705</a> ; to COPY-OVER 2035 2036 CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE 2037 CALL <A href="#L0A60">L0A60</a> ; routine RECLAIM-2 2038 2039 <a name="L0705"></a>;; <b>COPY-OVER</b> 2040 L0705: POP BC ; 2041 LD A,C ; 2042 DEC A ; 2043 OR B ; 2044 RET Z ; 2045 2046 PUSH BC ; 2047 INC BC ; 2048 INC BC ; 2049 INC BC ; 2050 INC BC ; 2051 DEC HL ; 2052 CALL <A href="#L099E">L099E</a> ; routine MAKE-ROOM 2053 CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST 2054 POP BC ; 2055 PUSH BC ; 2056 INC DE ; 2057 LD HL,($401A) ; sv STKBOT_lo 2058 DEC HL ; 2059 LDDR ; copy bytes 2060 LD HL,($400A) ; sv E_PPC_lo 2061 EX DE,HL ; 2062 POP BC ; 2063 LD (HL),B ; 2064 DEC HL ; 2065 LD (HL),C ; 2066 DEC HL ; 2067 LD (HL),E ; 2068 DEC HL ; 2069 LD (HL),D ; 2070 2071 RET ; return. 2072 2073 ; --------------------------------------- 2074 ; THE <b><font color=#333388>'LIST'</font></b> AND 'LLIST' COMMAND ROUTINES 2075 ; --------------------------------------- 2076 ; 2077 ; 2078 2079 <a name="L072C"></a>;; <b>LLIST</b> 2080 L072C: SET 1,(IY+$01) ; sv FLAGS - signal printer in use 2081 2082 <a name="L0730"></a>;; <b>LIST</b> 2083 L0730: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT 2084 2085 LD A,B ; fetch high byte of user-supplied line number. 2086 AND $3F ; and crudely limit to range 1-16383. 2087 2088 LD H,A ; 2089 LD L,C ; 2090 LD ($400A),HL ; sv E_PPC_lo 2091 CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR 2092 2093 <a name="L073E"></a>;; <b>LIST-PROG</b> 2094 L073E: LD E,$00 ; 2095 2096 <a name="L0740"></a>;; <b>UNTIL-END</b> 2097 L0740: CALL <A href="#L0745">L0745</a> ; routine OUT-LINE lists one line of BASIC 2098 ; making an early return when the screen is 2099 ; full or the end of program is reached. >> 2100 JR <A href="#L0740">L0740</a> ; loop back to UNTIL-END 2101 2102 ; ----------------------------------- 2103 ; THE <b><font color=#333388>'PRINT A BASIC LINE'</font></b> SUBROUTINE 2104 ; ----------------------------------- 2105 ; 2106 ; 2107 2108 <a name="L0745"></a>;; <b>OUT-LINE</b> 2109 L0745: LD BC,($400A) ; sv E_PPC_lo 2110 CALL <A href="#L09EA">L09EA</a> ; routine CP-LINES 2111 LD D,$92 ; 2112 JR Z,<A href="#L0755">L0755</a> ; to TEST-END 2113 2114 LD DE,$0000 ; 2115 RL E ; 2116 2117 <a name="L0755"></a>;; <b>TEST-END</b> 2118 L0755: LD (IY+$1E),E ; sv BERG 2119 LD A,(HL) ; 2120 CP $40 ; 2121 POP BC ; 2122 RET NC ; 2123 2124 PUSH BC ; 2125 CALL <A href="#L0AA5">L0AA5</a> ; routine OUT-NO 2126 INC HL ; 2127 LD A,D ; 2128 2129 RST 10H ; PRINT-A 2130 INC HL ; 2131 INC HL ; 2132 2133 <a name="L0766"></a>;; <b>COPY-LINE</b> 2134 L0766: LD ($4016),HL ; sv CH_ADD_lo 2135 SET 0,(IY+$01) ; sv FLAGS - Suppress leading space 2136 2137 <a name="L076D"></a>;; <b>MORE-LINE</b> 2138 L076D: LD BC,($4018) ; sv X_PTR_lo 2139 LD HL,($4016) ; sv CH_ADD_lo 2140 AND A ; 2141 SBC HL,BC ; 2142 JR NZ,<A href="#L077C">L077C</a> ; to TEST-NUM 2143 2144 LD A,$B8 ; 2145 2146 RST 10H ; PRINT-A 2147 2148 <a name="L077C"></a>;; <b>TEST-NUM</b> 2149 L077C: LD HL,($4016) ; sv CH_ADD_lo 2150 LD A,(HL) ; 2151 INC HL ; 2152 CALL <A href="#L07B4">L07B4</a> ; routine NUMBER 2153 LD ($4016),HL ; sv CH_ADD_lo 2154 JR Z,<A href="#L076D">L076D</a> ; to MORE-LINE 2155 2156 CP $7F ; 2157 JR Z,<A href="#L079D">L079D</a> ; to OUT-CURS 2158 2159 CP $76 ; 2160 JR Z,<A href="#L07EE">L07EE</a> ; to OUT-CH 2161 2162 BIT 6,A ; 2163 JR Z,<A href="#L079A">L079A</a> ; to NOT-TOKEN 2164 2165 CALL <A href="#L094B">L094B</a> ; routine TOKENS 2166 JR <A href="#L076D">L076D</a> ; to MORE-LINE 2167 2168 ; --- 2169 2170 2171 <a name="L079A"></a>;; <b>NOT-TOKEN</b> 2172 L079A: RST 10H ; PRINT-A 2173 JR <A href="#L076D">L076D</a> ; to MORE-LINE 2174 2175 ; --- 2176 2177 <a name="L079D"></a>;; <b>OUT-CURS</b> 2178 L079D: LD A,($4006) ; Fetch value of system variable MODE 2179 LD B,$AB ; Prepare an inverse [F] for function cursor. 2180 2181 AND A ; Test for zero - 2182 JR NZ,<A href="#L07AA">L07AA</a> ; forward if not to FLAGS-2 2183 2184 LD A,($4001) ; Fetch system variable FLAGS. 2185 LD B,$B0 ; Prepare an inverse [K] for keyword cursor. 2186 2187 <a name="L07AA"></a>;; <b>FLAGS-2</b> 2188 L07AA: RRA ; 00000?00 -> 000000?0 2189 RRA ; 000000?0 -> 0000000? 2190 AND $01 ; 0000000? 0000000x 2191 2192 ADD A,B ; Possibly [F] -> [G] or [K] -> [L] 2193 2194 CALL <A href="#L07F5">L07F5</a> ; routine PRINT-SP prints character 2195 JR <A href="#L076D">L076D</a> ; back to MORE-LINE 2196 2197 ; ----------------------- 2198 ; THE <b><font color=#333388>'NUMBER'</font></b> SUBROUTINE 2199 ; ----------------------- 2200 ; 2201 ; 2202 2203 <a name="L07B4"></a>;; <b>NUMBER</b> 2204 L07B4: CP $7E ; 2205 RET NZ ; 2206 2207 INC HL ; 2208 INC HL ; 2209 INC HL ; 2210 INC HL ; 2211 INC HL ; 2212 RET ; 2213 2214 ; -------------------------------- 2215 ; THE <b><font color=#333388>'KEYBOARD DECODE'</font></b> SUBROUTINE 2216 ; -------------------------------- 2217 ; 2218 ; 2219 2220 <a name="L07BD"></a>;; <b>DECODE</b> 2221 L07BD: LD D,$00 ; 2222 SRA B ; 2223 SBC A,A ; 2224 OR $26 ; 2225 LD L,$05 ; 2226 SUB L ; 2227 2228 <a name="L07C7"></a>;; <b>KEY-LINE</b> 2229 L07C7: ADD A,L ; 2230 SCF ; Set Carry Flag 2231 RR C ; 2232 JR C,<A href="#L07C7">L07C7</a> ; to KEY-LINE 2233 2234 INC C ; 2235 RET NZ ; 2236 2237 LD C,B ; 2238 DEC L ; 2239 LD L,$01 ; 2240 JR NZ,<A href="#L07C7">L07C7</a> ; to KEY-LINE 2241 2242 LD HL,$007D ; (expr reqd) 2243 LD E,A ; 2244 ADD HL,DE ; 2245 SCF ; Set Carry Flag 2246 RET ; 2247 2248 ; ------------------------- 2249 ; THE <b><font color=#333388>'PRINTING'</font></b> SUBROUTINE 2250 ; ------------------------- 2251 ; 2252 ; 2253 2254 <a name="L07DC"></a>;; <b>LEAD-SP</b> 2255 L07DC: LD A,E ; 2256 AND A ; 2257 RET M ; 2258 2259 JR <A href="#L07F1">L07F1</a> ; to PRINT-CH 2260 2261 ; --- 2262 2263 <a name="L07E1"></a>;; <b>OUT-DIGIT</b> 2264 L07E1: XOR A ; 2265 2266 <a name="L07E2"></a>;; <b>DIGIT-INC</b> 2267 L07E2: ADD HL,BC ; 2268 INC A ; 2269 JR C,<A href="#L07E2">L07E2</a> ; to DIGIT-INC 2270 2271 SBC HL,BC ; 2272 DEC A ; 2273 JR Z,<A href="#L07DC">L07DC</a> ; to LEAD-SP 2274 2275 <a name="L07EB"></a>;; <b>OUT-CODE</b> 2276 L07EB: LD E,$1C ; 2277 ADD A,E ; 2278 2279 <a name="L07EE"></a>;; <b>OUT-CH</b> 2280 L07EE: AND A ; 2281 JR Z,<A href="#L07F5">L07F5</a> ; to PRINT-SP 2282 2283 <a name="L07F1"></a>;; <b>PRINT-CH</b> 2284 L07F1: RES 0,(IY+$01) ; update FLAGS - signal leading space permitted 2285 2286 <a name="L07F5"></a>;; <b>PRINT-SP</b> 2287 L07F5: EXX ; 2288 PUSH HL ; 2289 BIT 1,(IY+$01) ; test FLAGS - is printer in use ? 2290 JR NZ,<A href="#L0802">L0802</a> ; to LPRINT-A 2291 2292 CALL <A href="#L0808">L0808</a> ; routine ENTER-CH 2293 JR <A href="#L0805">L0805</a> ; to PRINT-EXX 2294 2295 ; --- 2296 2297 <a name="L0802"></a>;; <b>LPRINT-A</b> 2298 L0802: CALL <A href="#L0851">L0851</a> ; routine LPRINT-CH 2299 2300 <a name="L0805"></a>;; <b>PRINT-EXX</b> 2301 L0805: POP HL ; 2302 EXX ; 2303 RET ; 2304 2305 ; --- 2306 2307 <a name="L0808"></a>;; <b>ENTER-CH</b> 2308 L0808: LD D,A ; 2309 LD BC,($4039) ; sv S_POSN_x 2310 LD A,C ; 2311 CP $21 ; 2312 JR Z,<A href="#L082C">L082C</a> ; to TEST-LOW 2313 2314 <a name="L0812"></a>;; <b>TEST-N/L</b> 2315 L0812: LD A,$76 ; 2316 CP D ; 2317 JR Z,<A href="#L0847">L0847</a> ; to WRITE-N/L 2318 2319 LD HL,($400E) ; sv DF_CC_lo 2320 CP (HL) ; 2321 LD A,D ; 2322 JR NZ,<A href="#L083E">L083E</a> ; to WRITE-CH 2323 2324 DEC C ; 2325 JR NZ,<A href="#L083A">L083A</a> ; to EXPAND-1 2326 2327 INC HL ; 2328 LD ($400E),HL ; sv DF_CC_lo 2329 LD C,$21 ; 2330 DEC B ; 2331 LD ($4039),BC ; sv S_POSN_x 2332 2333 <a name="L082C"></a>;; <b>TEST-LOW</b> 2334 L082C: LD A,B ; 2335 CP (IY+$22) ; sv DF_SZ 2336 JR Z,<A href="#L0835">L0835</a> ; to REPORT-5 2337 2338 AND A ; 2339 JR NZ,<A href="#L0812">L0812</a> ; to TEST-N/L 2340 2341 <a name="L0835"></a>;; <b>REPORT-5</b> 2342 L0835: LD L,$04 ; 'No more room on screen' 2343 JP <A href="#L0058">L0058</a> ; to ERROR-3 2344 2345 ; --- 2346 2347 <a name="L083A"></a>;; <b>EXPAND-1</b> 2348 L083A: CALL <A href="#L099B">L099B</a> ; routine ONE-SPACE 2349 EX DE,HL ; 2350 2351 <a name="L083E"></a>;; <b>WRITE-CH</b> 2352 L083E: LD (HL),A ; 2353 INC HL ; 2354 LD ($400E),HL ; sv DF_CC_lo 2355 DEC (IY+$39) ; sv S_POSN_x 2356 RET ; 2357 2358 ; --- 2359 2360 <a name="L0847"></a>;; <b>WRITE-N/L</b> 2361 L0847: LD C,$21 ; 2362 DEC B ; 2363 SET 0,(IY+$01) ; sv FLAGS - Suppress leading space 2364 JP <A href="#L0918">L0918</a> ; to LOC-ADDR 2365 2366 ; -------------------------- 2367 ; THE <b><font color=#333388>'LPRINT-CH'</font></b> SUBROUTINE 2368 ; -------------------------- 2369 ; This routine sends a character to the ZX-Printer placing the code for the 2370 ; character in the Printer Buffer. 2371 ; <font color=#9900FF>Note.</font> PR-CC contains the low byte of the buffer address. The high order byte 2372 ; is always constant. 2373 2374 2375 <a name="L0851"></a>;; <b>LPRINT-CH</b> 2376 L0851: CP $76 ; compare to NEWLINE. 2377 JR Z,<A href="#L0871">L0871</a> ; forward if so to COPY-BUFF 2378 2379 LD C,A ; take a copy of the character in C. 2380 LD A,($4038) ; fetch print location from PR_CC 2381 AND $7F ; ignore bit 7 to form true position. 2382 CP $5C ; compare to 33rd location 2383 2384 LD L,A ; form low-order byte. 2385 LD H,$40 ; the high-order byte is fixed. 2386 2387 CALL Z,<A href="#L0871">L0871</a> ; routine COPY-BUFF to send full buffer to 2388 ; the printer if first 32 bytes full. 2389 ; (this will reset HL to start.) 2390 2391 LD (HL),C ; place character at location. 2392 INC L ; increment - will not cross a 256 boundary. 2393 LD (IY+$38),L ; update system variable PR_CC 2394 ; automatically resetting bit 7 to show that 2395 ; the buffer is not empty. 2396 RET ; return. 2397 2398 ; -------------------------- 2399 ; THE <b><font color=#333388>'COPY'</font></b> COMMAND ROUTINE 2400 ; -------------------------- 2401 ; The full character-mapped screen is copied to the ZX-Printer. 2402 ; All twenty-four text/graphic lines are printed. 2403 2404 <a name="L0869"></a>;; <b>COPY</b> 2405 L0869: LD D,$16 ; prepare to copy twenty four text lines. 2406 LD HL,($400C) ; set HL to start of display file from D_FILE. 2407 INC HL ; 2408 JR <A href="#L0876">L0876</a> ; forward to COPY*D 2409 2410 ; --- 2411 2412 ; A single character-mapped printer buffer is copied to the ZX-Printer. 2413 2414 <a name="L0871"></a>;; <b>COPY-BUFF</b> 2415 L0871: LD D,$01 ; prepare to copy a single text line. 2416 LD HL,$403C ; set HL to start of printer buffer PRBUFF. 2417 2418 ; both paths converge here. 2419 2420 <a name="L0876"></a>;; <b>COPY*D</b> 2421 L0876: CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST 2422 2423 PUSH BC ; *** preserve BC throughout. 2424 ; a pending character may be present 2425 ; in C from LPRINT-CH 2426 2427 <a name="L087A"></a>;; <b>COPY-LOOP</b> 2428 L087A: PUSH HL ; save first character of line pointer. (*) 2429 XOR A ; clear accumulator. 2430 LD E,A ; set pixel line count, range 0-7, to zero. 2431 2432 ; this inner loop deals with each horizontal pixel line. 2433 2434 <a name="L087D"></a>;; <b>COPY-TIME</b> 2435 L087D: OUT ($FB),A ; bit 2 reset starts the printer motor 2436 ; with an inactive stylus - bit 7 reset. 2437 POP HL ; pick up first character of line pointer (*) 2438 ; on inner loop. 2439 2440 <a name="L0880"></a>;; <b>COPY-BRK</b> 2441 L0880: CALL <A href="#L0F46">L0F46</a> ; routine BREAK-1 2442 JR C,<A href="#L088A">L088A</a> ; forward with no keypress to COPY-CONT 2443 2444 ; else A will hold 11111111 0 2445 2446 RRA ; 0111 1111 2447 OUT ($FB),A ; stop ZX printer motor, de-activate stylus. 2448 2449 <a name="L0888"></a>;; <b>REPORT-D2</b> 2450 L0888: RST 08H ; ERROR-1 2451 DEFB $0C ; Error Report: BREAK - CONT repeats 2452 2453 ; --- 2454 2455 <a name="L088A"></a>;; <b>COPY-CONT</b> 2456 L088A: IN A,($FB) ; read from printer port. 2457 ADD A,A ; test bit 6 and 7 2458 JP M,<A href="#L08DE">L08DE</a> ; jump forward with no printer to COPY-END 2459 2460 JR NC,<A href="#L0880">L0880</a> ; back if stylus not in position to COPY-BRK 2461 2462 PUSH HL ; save first character of line pointer (*) 2463 PUSH DE ; ** preserve character line and pixel line. 2464 2465 LD A,D ; text line count to A? 2466 CP $02 ; sets carry if last line. 2467 SBC A,A ; now $FF if last line else zero. 2468 2469 ; now cleverly prepare a printer control mask setting bit 2 (later moved to 1) 2470 ; of D to slow printer for the last two pixel lines ( E = 6 and 7) 2471 2472 AND E ; and with pixel line offset 0-7 2473 RLCA ; shift to left. 2474 AND E ; and again. 2475 LD D,A ; store control mask in D. 2476 2477 <a name="L089C"></a>;; <b>COPY-NEXT</b> 2478 L089C: LD C,(HL) ; load character from screen or buffer. 2479 LD A,C ; save a copy in C for later inverse test. 2480 INC HL ; update pointer for next time. 2481 CP $76 ; is character a NEWLINE ? 2482 JR Z,<A href="#L08C7">L08C7</a> ; forward, if so, to COPY-N/L 2483 2484 PUSH HL ; * else preserve the character pointer. 2485 2486 SLA A ; (?) multiply by two 2487 ADD A,A ; multiply by four 2488 ADD A,A ; multiply by eight 2489 2490 LD H,$0F ; load H with half the address of character set. 2491 RL H ; now $1E or $1F (with carry) 2492 ADD A,E ; add byte offset 0-7 2493 LD L,A ; now HL addresses character source byte 2494 2495 RL C ; test character, setting carry if inverse. 2496 SBC A,A ; accumulator now $00 if normal, $FF if inverse. 2497 2498 XOR (HL) ; combine with bit pattern at end or ROM. 2499 LD C,A ; transfer the byte to C. 2500 LD B,$08 ; count eight bits to output. 2501 2502 <a name="L08B5"></a>;; <b>COPY-BITS</b> 2503 L08B5: LD A,D ; fetch speed control mask from D. 2504 RLC C ; rotate a bit from output byte to carry. 2505 RRA ; pick up in bit 7, speed bit to bit 1 2506 LD H,A ; store aligned mask in H register. 2507 2508 <a name="L08BA"></a>;; <b>COPY-WAIT</b> 2509 L08BA: IN A,($FB) ; read the printer port 2510 RRA ; test for alignment signal from encoder. 2511 JR NC,<A href="#L08BA">L08BA</a> ; loop if not present to COPY-WAIT 2512 2513 LD A,H ; control byte to A. 2514 OUT ($FB),A ; and output to printer port. 2515 DJNZ <A href="#L08B5">L08B5</a> ; loop for all eight bits to COPY-BITS 2516 2517 POP HL ; * restore character pointer. 2518 JR <A href="#L089C">L089C</a> ; back for adjacent character line to COPY-NEXT 2519 2520 ; --- 2521 2522 ; A NEWLINE has been encountered either following a text line or as the 2523 ; first character of the screen or printer line. 2524 2525 <a name="L08C7"></a>;; <b>COPY-N/L</b> 2526 L08C7: IN A,($FB) ; read printer port. 2527 RRA ; wait for encoder signal. 2528 JR NC,<A href="#L08C7">L08C7</a> ; loop back if not to COPY-N/L 2529 2530 LD A,D ; transfer speed mask to A. 2531 RRCA ; rotate speed bit to bit 1. 2532 ; bit 7, stylus control is reset. 2533 OUT ($FB),A ; set the printer speed. 2534 2535 POP DE ; ** restore character line and pixel line. 2536 INC E ; increment pixel line 0-7. 2537 BIT 3,E ; test if value eight reached. 2538 JR Z,<A href="#L087D">L087D</a> ; back if not to COPY-TIME 2539 2540 ; eight pixel lines, a text line have been completed. 2541 2542 POP BC ; lose the now redundant first character 2543 ; pointer 2544 DEC D ; decrease text line count. 2545 JR NZ,<A href="#L087A">L087A</a> ; back if not zero to COPY-LOOP 2546 2547 LD A,$04 ; stop the already slowed printer motor. 2548 OUT ($FB),A ; output to printer port. 2549 2550 <a name="L08DE"></a>;; <b>COPY-END</b> 2551 L08DE: CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST 2552 POP BC ; *** restore preserved BC. 2553 2554 ; ------------------------------------- 2555 ; THE <b><font color=#333388>'CLEAR PRINTER BUFFER'</font></b> SUBROUTINE 2556 ; ------------------------------------- 2557 ; This subroutine sets 32 bytes of the printer buffer to zero (space) and 2558 ; the 33rd character is set to a NEWLINE. 2559 ; This occurs after the printer buffer is sent to the printer but in addition 2560 ; after the 24 lines of the screen are sent to the printer. 2561 ; <font color=#9900FF>Note.</font> This is a logic error as the last operation does not involve the 2562 ; buffer at all. Logically one should be able to use 2563 ; 10 LPRINT "HELLO "; 2564 ; 20 COPY 2565 ; 30 LPRINT ; "WORLD" 2566 ; and expect to see the entire greeting emerge from the printer. 2567 ; Surprisingly this logic error was never discovered and although one can argue 2568 ; if the above is a bug, the repetition of this error on the Spectrum was most 2569 ; definitely a bug. 2570 ; Since the printer buffer is fixed at the end of the system variables, and 2571 ; the print position is in the range $3C - $5C, then bit 7 of the system 2572 ; variable is set to show the buffer is empty and automatically reset when 2573 ; the variable is updated with any print position - neat. 2574 2575 <a name="L08E2"></a>;; <b>CLEAR-PRB</b> 2576 L08E2: LD HL,$405C ; address fixed end of PRBUFF 2577 LD (HL),$76 ; place a newline at last position. 2578 LD B,$20 ; prepare to blank 32 preceding characters. 2579 2580 <a name="L08E9"></a>;; <b>PRB-BYTES</b> 2581 L08E9: DEC HL ; decrement address - could be DEC L. 2582 LD (HL),$00 ; place a zero byte. 2583 DJNZ <A href="#L08E9">L08E9</a> ; loop for all thirty-two to PRB-BYTES 2584 2585 LD A,L ; fetch character print position. 2586 SET 7,A ; signal the printer buffer is clear. 2587 LD ($4038),A ; update one-byte system variable PR_CC 2588 RET ; return. 2589 2590 ; ------------------------- 2591 ; THE <b><font color=#333388>'PRINT AT'</font></b> SUBROUTINE 2592 ; ------------------------- 2593 ; 2594 ; 2595 2596 <a name="L08F5"></a>;; <b>PRINT-AT</b> 2597 L08F5: LD A,$17 ; 2598 SUB B ; 2599 JR C,<A href="#L0905">L0905</a> ; to WRONG-VAL 2600 2601 <a name="L08FA"></a>;; <b>TEST-VAL</b> 2602 L08FA: CP (IY+$22) ; sv DF_SZ 2603 JP C,<A href="#L0835">L0835</a> ; to REPORT-5 2604 2605 INC A ; 2606 LD B,A ; 2607 LD A,$1F ; 2608 SUB C ; 2609 2610 <a name="L0905"></a>;; <b>WRONG-VAL</b> 2611 L0905: JP C,<A href="#L0EAD">L0EAD</a> ; to REPORT-B 2612 2613 ADD A,$02 ; 2614 LD C,A ; 2615 2616 <a name="L090B"></a>;; <b>SET-FIELD</b> 2617 L090B: BIT 1,(IY+$01) ; sv FLAGS - Is printer in use 2618 JR Z,<A href="#L0918">L0918</a> ; to LOC-ADDR 2619 2620 LD A,$5D ; 2621 SUB C ; 2622 LD ($4038),A ; sv PR_CC 2623 RET ; 2624 2625 ; ---------------------------- 2626 ; THE <b><font color=#333388>'LOCATE ADDRESS'</font></b> ROUTINE 2627 ; ---------------------------- 2628 ; 2629 ; 2630 2631 <a name="L0918"></a>;; <b>LOC-ADDR</b> 2632 L0918: LD ($4039),BC ; sv S_POSN_x 2633 LD HL,($4010) ; sv VARS_lo 2634 LD D,C ; 2635 LD A,$22 ; 2636 SUB C ; 2637 LD C,A ; 2638 LD A,$76 ; 2639 INC B ; 2640 2641 <a name="L0927"></a>;; <b>LOOK-BACK</b> 2642 L0927: DEC HL ; 2643 CP (HL) ; 2644 JR NZ,<A href="#L0927">L0927</a> ; to LOOK-BACK 2645 2646 DJNZ <A href="#L0927">L0927</a> ; to LOOK-BACK 2647 2648 INC HL ; 2649 CPIR ; 2650 DEC HL ; 2651 LD ($400E),HL ; sv DF_CC_lo 2652 SCF ; Set Carry Flag 2653 RET PO ; 2654 2655 DEC D ; 2656 RET Z ; 2657 2658 PUSH BC ; 2659 CALL <A href="#L099E">L099E</a> ; routine MAKE-ROOM 2660 POP BC ; 2661 LD B,C ; 2662 LD H,D ; 2663 LD L,E ; 2664 2665 <a name="L0940"></a>;; <b>EXPAND-2</b> 2666 L0940: LD (HL),$00 ; 2667 DEC HL ; 2668 DJNZ <A href="#L0940">L0940</a> ; to EXPAND-2 2669 2670 EX DE,HL ; 2671 INC HL ; 2672 LD ($400E),HL ; sv DF_CC_lo 2673 RET ; 2674 2675 ; ------------------------------ 2676 ; THE <b><font color=#333388>'EXPAND TOKENS'</font></b> SUBROUTINE 2677 ; ------------------------------ 2678 ; 2679 ; 2680 2681 <a name="L094B"></a>;; <b>TOKENS</b> 2682 L094B: PUSH AF ; 2683 CALL <A href="#L0975">L0975</a> ; routine TOKEN-ADD 2684 JR NC,<A href="#L0959">L0959</a> ; to ALL-CHARS 2685 2686 BIT 0,(IY+$01) ; sv FLAGS - Leading space if set 2687 JR NZ,<A href="#L0959">L0959</a> ; to ALL-CHARS 2688 2689 XOR A ; 2690 2691 RST 10H ; PRINT-A 2692 2693 <a name="L0959"></a>;; <b>ALL-CHARS</b> 2694 L0959: LD A,(BC) ; 2695 AND $3F ; 2696 2697 RST 10H ; PRINT-A 2698 LD A,(BC) ; 2699 INC BC ; 2700 ADD A,A ; 2701 JR NC,<A href="#L0959">L0959</a> ; to ALL-CHARS 2702 2703 POP BC ; 2704 BIT 7,B ; 2705 RET Z ; 2706 2707 CP $1A ; 2708 JR Z,<A href="#L096D">L096D</a> ; to TRAIL-SP 2709 2710 CP $38 ; 2711 RET C ; 2712 2713 <a name="L096D"></a>;; <b>TRAIL-SP</b> 2714 L096D: XOR A ; 2715 SET 0,(IY+$01) ; sv FLAGS - Suppress leading space 2716 JP <A href="#L07F5">L07F5</a> ; to PRINT-SP 2717 2718 ; --- 2719 2720 <a name="L0975"></a>;; <b>TOKEN-ADD</b> 2721 L0975: PUSH HL ; 2722 LD HL,<A href="#L0111">L0111</a> ; Address of TOKENS 2723 BIT 7,A ; 2724 JR Z,<A href="#L097F">L097F</a> ; to TEST-HIGH 2725 2726 AND $3F ; 2727 2728 <a name="L097F"></a>;; <b>TEST-HIGH</b> 2729 L097F: CP $43 ; 2730 JR NC,<A href="#L0993">L0993</a> ; to FOUND 2731 2732 LD B,A ; 2733 INC B ; 2734 2735 <a name="L0985"></a>;; <b>WORDS</b> 2736 L0985: BIT 7,(HL) ; 2737 INC HL ; 2738 JR Z,<A href="#L0985">L0985</a> ; to WORDS 2739 2740 DJNZ <A href="#L0985">L0985</a> ; to WORDS 2741 2742 BIT 6,A ; 2743 JR NZ,<A href="#L0992">L0992</a> ; to COMP-FLAG 2744 2745 CP $18 ; 2746 2747 <a name="L0992"></a>;; <b>COMP-FLAG</b> 2748 L0992: CCF ; Complement Carry Flag 2749 2750 <a name="L0993"></a>;; <b>FOUND</b> 2751 L0993: LD B,H ; 2752 LD C,L ; 2753 POP HL ; 2754 RET NC ; 2755 2756 LD A,(BC) ; 2757 ADD A,$E4 ; 2758 RET ; 2759 2760 ; -------------------------- 2761 ; THE <b><font color=#333388>'ONE SPACE'</font></b> SUBROUTINE 2762 ; -------------------------- 2763 ; 2764 ; 2765 2766 <a name="L099B"></a>;; <b>ONE-SPACE</b> 2767 L099B: LD BC,$0001 ; 2768 2769 ; -------------------------- 2770 ; THE <b><font color=#333388>'MAKE ROOM'</font></b> SUBROUTINE 2771 ; -------------------------- 2772 ; 2773 ; 2774 2775 <a name="L099E"></a>;; <b>MAKE-ROOM</b> 2776 L099E: PUSH HL ; 2777 CALL <A href="#L0EC5">L0EC5</a> ; routine TEST-ROOM 2778 POP HL ; 2779 CALL <A href="#L09AD">L09AD</a> ; routine POINTERS 2780 LD HL,($401C) ; sv STKEND_lo 2781 EX DE,HL ; 2782 LDDR ; Copy Bytes 2783 RET ; 2784 2785 ; ------------------------- 2786 ; THE <b><font color=#333388>'POINTERS'</font></b> SUBROUTINE 2787 ; ------------------------- 2788 ; 2789 ; 2790 2791 <a name="L09AD"></a>;; <b>POINTERS</b> 2792 L09AD: PUSH AF ; 2793 PUSH HL ; 2794 LD HL,$400C ; sv D_FILE_lo 2795 LD A,$09 ; 2796 2797 <a name="L09B4"></a>;; <b>NEXT-PTR</b> 2798 L09B4: LD E,(HL) ; 2799 INC HL ; 2800 LD D,(HL) ; 2801 EX (SP),HL ; 2802 AND A ; 2803 SBC HL,DE ; 2804 ADD HL,DE ; 2805 EX (SP),HL ; 2806 JR NC,<A href="#L09C8">L09C8</a> ; to PTR-DONE 2807 2808 PUSH DE ; 2809 EX DE,HL ; 2810 ADD HL,BC ; 2811 EX DE,HL ; 2812 LD (HL),D ; 2813 DEC HL ; 2814 LD (HL),E ; 2815 INC HL ; 2816 POP DE ; 2817 2818 <a name="L09C8"></a>;; <b>PTR-DONE</b> 2819 L09C8: INC HL ; 2820 DEC A ; 2821 JR NZ,<A href="#L09B4">L09B4</a> ; to NEXT-PTR 2822 2823 EX DE,HL ; 2824 POP DE ; 2825 POP AF ; 2826 AND A ; 2827 SBC HL,DE ; 2828 LD B,H ; 2829 LD C,L ; 2830 INC BC ; 2831 ADD HL,DE ; 2832 EX DE,HL ; 2833 RET ; 2834 2835 ; ----------------------------- 2836 ; THE <b><font color=#333388>'LINE ADDRESS'</font></b> SUBROUTINE 2837 ; ----------------------------- 2838 ; 2839 ; 2840 2841 <a name="L09D8"></a>;; <b>LINE-ADDR</b> 2842 L09D8: PUSH HL ; 2843 LD HL,$407D ; 2844 LD D,H ; 2845 LD E,L ; 2846 2847 <a name="L09DE"></a>;; <b>NEXT-TEST</b> 2848 L09DE: POP BC ; 2849 CALL <A href="#L09EA">L09EA</a> ; routine CP-LINES 2850 RET NC ; 2851 2852 PUSH BC ; 2853 CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE 2854 EX DE,HL ; 2855 JR <A href="#L09DE">L09DE</a> ; to NEXT-TEST 2856 2857 ; ------------------------------------- 2858 ; THE <b><font color=#333388>'COMPARE LINE NUMBERS'</font></b> SUBROUTINE 2859 ; ------------------------------------- 2860 ; 2861 ; 2862 2863 <a name="L09EA"></a>;; <b>CP-LINES</b> 2864 L09EA: LD A,(HL) ; 2865 CP B ; 2866 RET NZ ; 2867 2868 INC HL ; 2869 LD A,(HL) ; 2870 DEC HL ; 2871 CP C ; 2872 RET ; 2873 2874 ; -------------------------------------- 2875 ; THE <b><font color=#333388>'NEXT LINE OR VARIABLE'</font></b> SUBROUTINE 2876 ; -------------------------------------- 2877 ; 2878 ; 2879 2880 <a name="L09F2"></a>;; <b>NEXT-ONE</b> 2881 L09F2: PUSH HL ; 2882 LD A,(HL) ; 2883 CP $40 ; 2884 JR C,<A href="#L0A0F">L0A0F</a> ; to LINES 2885 2886 BIT 5,A ; 2887 JR Z,<A href="#L0A10">L0A10</a> ; forward to NEXT-O-4 2888 2889 ADD A,A ; 2890 JP M,<A href="#L0A01">L0A01</a> ; to NEXT+FIVE 2891 2892 CCF ; Complement Carry Flag 2893 2894 <a name="L0A01"></a>;; <b>NEXT+FIVE</b> 2895 L0A01: LD BC,$0005 ; 2896 JR NC,<A href="#L0A08">L0A08</a> ; to NEXT-LETT 2897 2898 LD C,$11 ; 2899 2900 <a name="L0A08"></a>;; <b>NEXT-LETT</b> 2901 L0A08: RLA ; 2902 INC HL ; 2903 LD A,(HL) ; 2904 JR NC,<A href="#L0A08">L0A08</a> ; to NEXT-LETT 2905 2906 JR <A href="#L0A15">L0A15</a> ; to NEXT-ADD 2907 2908 ; --- 2909 2910 <a name="L0A0F"></a>;; <b>LINES</b> 2911 L0A0F: INC HL ; 2912 2913 <a name="L0A10"></a>;; <b>NEXT-O-4</b> 2914 L0A10: INC HL ; 2915 LD C,(HL) ; 2916 INC HL ; 2917 LD B,(HL) ; 2918 INC HL ; 2919 2920 <a name="L0A15"></a>;; <b>NEXT-ADD</b> 2921 L0A15: ADD HL,BC ; 2922 POP DE ; 2923 2924 ; --------------------------- 2925 ; THE <b><font color=#333388>'DIFFERENCE'</font></b> SUBROUTINE 2926 ; --------------------------- 2927 ; 2928 ; 2929 2930 <a name="L0A17"></a>;; <b>DIFFER</b> 2931 L0A17: AND A ; 2932 SBC HL,DE ; 2933 LD B,H ; 2934 LD C,L ; 2935 ADD HL,DE ; 2936 EX DE,HL ; 2937 RET ; 2938 2939 ; -------------------------- 2940 ; THE <b><font color=#333388>'LINE-ENDS'</font></b> SUBROUTINE 2941 ; -------------------------- 2942 ; 2943 ; 2944 2945 <a name="L0A1F"></a>;; <b>LINE-ENDS</b> 2946 L0A1F: LD B,(IY+$22) ; sv DF_SZ 2947 PUSH BC ; 2948 CALL <A href="#L0A2C">L0A2C</a> ; routine B-LINES 2949 POP BC ; 2950 DEC B ; 2951 JR <A href="#L0A2C">L0A2C</a> ; to B-LINES 2952 2953 ; ------------------------- 2954 ; THE <b><font color=#333388>'CLS'</font></b> COMMAND ROUTINE 2955 ; ------------------------- 2956 ; 2957 ; 2958 2959 <a name="L0A2A"></a>;; <b>CLS</b> 2960 L0A2A: LD B,$18 ; 2961 2962 <a name="L0A2C"></a>;; <b>B-LINES</b> 2963 L0A2C: RES 1,(IY+$01) ; sv FLAGS - Signal printer not in use 2964 LD C,$21 ; 2965 PUSH BC ; 2966 CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR 2967 POP BC ; 2968 LD A,($4005) ; sv RAMTOP_hi 2969 CP $4D ; 2970 JR C,<A href="#L0A52">L0A52</a> ; to COLLAPSED 2971 2972 SET 7,(IY+$3A) ; sv S_POSN_y 2973 2974 <a name="L0A42"></a>;; <b>CLEAR-LOC</b> 2975 L0A42: XOR A ; prepare a space 2976 CALL <A href="#L07F5">L07F5</a> ; routine PRINT-SP prints a space 2977 LD HL,($4039) ; sv S_POSN_x 2978 LD A,L ; 2979 OR H ; 2980 AND $7E ; 2981 JR NZ,<A href="#L0A42">L0A42</a> ; to CLEAR-LOC 2982 2983 JP <A href="#L0918">L0918</a> ; to LOC-ADDR 2984 2985 ; --- 2986 2987 <a name="L0A52"></a>;; <b>COLLAPSED</b> 2988 L0A52: LD D,H ; 2989 LD E,L ; 2990 DEC HL ; 2991 LD C,B ; 2992 LD B,$00 ; 2993 LDIR ; Copy Bytes 2994 LD HL,($4010) ; sv VARS_lo 2995 2996 ; ---------------------------- 2997 ; THE <b><font color=#333388>'RECLAIMING'</font></b> SUBROUTINES 2998 ; ---------------------------- 2999 ; 3000 ; 3001 3002 <a name="L0A5D"></a>;; <b>RECLAIM-1</b> 3003 L0A5D: CALL <A href="#L0A17">L0A17</a> ; routine DIFFER 3004 3005 <a name="L0A60"></a>;; <b>RECLAIM-2</b> 3006 L0A60: PUSH BC ; 3007 LD A,B ; 3008 CPL ; 3009 LD B,A ; 3010 LD A,C ; 3011 CPL ; 3012 LD C,A ; 3013 INC BC ; 3014 CALL <A href="#L09AD">L09AD</a> ; routine POINTERS 3015 EX DE,HL ; 3016 POP HL ; 3017 ADD HL,DE ; 3018 PUSH DE ; 3019 LDIR ; Copy Bytes 3020 POP HL ; 3021 RET ; 3022 3023 ; ------------------------------ 3024 ; THE <b><font color=#333388>'E-LINE NUMBER'</font></b> SUBROUTINE 3025 ; ------------------------------ 3026 ; 3027 ; 3028 3029 <a name="L0A73"></a>;; <b>E-LINE-NO</b> 3030 L0A73: LD HL,($4014) ; sv E_LINE_lo 3031 CALL <A href="#L004D">L004D</a> ; routine TEMP-PTR-2 3032 3033 RST 18H ; GET-CHAR 3034 BIT 5,(IY+$2D) ; sv FLAGX 3035 RET NZ ; 3036 3037 LD HL,$405D ; sv MEM-0-1st 3038 LD ($401C),HL ; sv STKEND_lo 3039 CALL <A href="#L1548">L1548</a> ; routine INT-TO-FP 3040 CALL <A href="#L158A">L158A</a> ; routine FP-TO-BC 3041 JR C,<A href="#L0A91">L0A91</a> ; to NO-NUMBER 3042 3043 LD HL,$D8F0 ; value '-10000' 3044 ADD HL,BC ; 3045 3046 <a name="L0A91"></a>;; <b>NO-NUMBER</b> 3047 L0A91: JP C,<A href="#L0D9A">L0D9A</a> ; to REPORT-C 3048 3049 CP A ; 3050 JP <A href="#L14BC">L14BC</a> ; routine SET-MIN 3051 3052 ; ------------------------------------------------- 3053 ; THE <b><font color=#333388>'REPORT AND LINE NUMBER'</font></b> PRINTING SUBROUTINES 3054 ; ------------------------------------------------- 3055 ; 3056 ; 3057 3058 <a name="L0A98"></a>;; <b>OUT-NUM</b> 3059 L0A98: PUSH DE ; 3060 PUSH HL ; 3061 XOR A ; 3062 BIT 7,B ; 3063 JR NZ,<A href="#L0ABF">L0ABF</a> ; to UNITS 3064 3065 LD H,B ; 3066 LD L,C ; 3067 LD E,$FF ; 3068 JR <A href="#L0AAD">L0AAD</a> ; to THOUSAND 3069 3070 ; --- 3071 3072 <a name="L0AA5"></a>;; <b>OUT-NO</b> 3073 L0AA5: PUSH DE ; 3074 LD D,(HL) ; 3075 INC HL ; 3076 LD E,(HL) ; 3077 PUSH HL ; 3078 EX DE,HL ; 3079 LD E,$00 ; set E to leading space. 3080 3081 <a name="L0AAD"></a>;; <b>THOUSAND</b> 3082 L0AAD: LD BC,$FC18 ; 3083 CALL <A href="#L07E1">L07E1</a> ; routine OUT-DIGIT 3084 LD BC,$FF9C ; 3085 CALL <A href="#L07E1">L07E1</a> ; routine OUT-DIGIT 3086 LD C,$F6 ; 3087 CALL <A href="#L07E1">L07E1</a> ; routine OUT-DIGIT 3088 LD A,L ; 3089 3090 <a name="L0ABF"></a>;; <b>UNITS</b> 3091 L0ABF: CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE 3092 POP HL ; 3093 POP DE ; 3094 RET ; 3095 3096 ; -------------------------- 3097 ; THE <b><font color=#333388>'UNSTACK-Z'</font></b> SUBROUTINE 3098 ; -------------------------- 3099 ; This subroutine is used to return early from a routine when checking syntax. 3100 ; On the ZX81 the same routines that execute commands also check the syntax 3101 ; on line entry. This enables precise placement of the error marker in a line 3102 ; that fails syntax. 3103 ; The sequence CALL SYNTAX-Z ; RET Z can be replaced by a call to this routine 3104 ; although it has not replaced every occurrence of the above two instructions. 3105 ; Even on the ZX-80 this routine was not fully utilized. 3106 3107 <a name="L0AC5"></a>;; <b>UNSTACK-Z</b> 3108 L0AC5: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z resets the ZERO flag if 3109 ; checking syntax. 3110 POP HL ; drop the return address. 3111 RET Z ; return to previous calling routine if 3112 ; checking syntax. 3113 3114 JP (HL) ; else jump to the continuation address in 3115 ; the calling routine as RET would have done. 3116 3117 ; ---------------------------- 3118 ; THE <b><font color=#333388>'LPRINT'</font></b> COMMAND ROUTINE 3119 ; ---------------------------- 3120 ; 3121 ; 3122 3123 <a name="L0ACB"></a>;; <b>LPRINT</b> 3124 L0ACB: SET 1,(IY+$01) ; sv FLAGS - Signal printer in use 3125 3126 ; --------------------------- 3127 ; THE <b><font color=#333388>'PRINT'</font></b> COMMAND ROUTINE 3128 ; --------------------------- 3129 ; 3130 ; 3131 3132 <a name="L0ACF"></a>;; <b>PRINT</b> 3133 L0ACF: LD A,(HL) ; 3134 CP $76 ; 3135 JP Z,<A href="#L0B84">L0B84</a> ; to PRINT-END 3136 3137 <a name="L0AD5"></a>;; <b>PRINT-1</b> 3138 L0AD5: SUB $1A ; 3139 ADC A,$00 ; 3140 JR Z,<A href="#L0B44">L0B44</a> ; to SPACING 3141 3142 CP $A7 ; 3143 JR NZ,<A href="#L0AFA">L0AFA</a> ; to NOT-AT 3144 3145 3146 RST 20H ; NEXT-CHAR 3147 CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6 3148 CP $1A ; 3149 JP NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C 3150 3151 3152 RST 20H ; NEXT-CHAR 3153 CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6 3154 CALL <A href="#L0B4E">L0B4E</a> ; routine SYNTAX-ON 3155 3156 RST 28H ;; FP-CALC 3157 DEFB $01 ;;exchange 3158 DEFB $34 ;;end-calc 3159 3160 CALL <A href="#L0BF5">L0BF5</a> ; routine STK-TO-BC 3161 CALL <A href="#L08F5">L08F5</a> ; routine PRINT-AT 3162 JR <A href="#L0B37">L0B37</a> ; to PRINT-ON 3163 3164 ; --- 3165 3166 <a name="L0AFA"></a>;; <b>NOT-AT</b> 3167 L0AFA: CP $A8 ; 3168 JR NZ,<A href="#L0B31">L0B31</a> ; to NOT-TAB 3169 3170 3171 RST 20H ; NEXT-CHAR 3172 CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6 3173 CALL <A href="#L0B4E">L0B4E</a> ; routine SYNTAX-ON 3174 CALL <A href="#L0C02">L0C02</a> ; routine STK-TO-A 3175 JP NZ,<A href="#L0EAD">L0EAD</a> ; to REPORT-B 3176 3177 AND $1F ; 3178 LD C,A ; 3179 BIT 1,(IY+$01) ; sv FLAGS - Is printer in use 3180 JR Z,<A href="#L0B1E">L0B1E</a> ; to TAB-TEST 3181 3182 SUB (IY+$38) ; sv PR_CC 3183 SET 7,A ; 3184 ADD A,$3C ; 3185 CALL NC,<A href="#L0871">L0871</a> ; routine COPY-BUFF 3186 3187 <a name="L0B1E"></a>;; <b>TAB-TEST</b> 3188 L0B1E: ADD A,(IY+$39) ; sv S_POSN_x 3189 CP $21 ; 3190 LD A,($403A) ; sv S_POSN_y 3191 SBC A,$01 ; 3192 CALL <A href="#L08FA">L08FA</a> ; routine TEST-VAL 3193 SET 0,(IY+$01) ; sv FLAGS - Suppress leading space 3194 JR <A href="#L0B37">L0B37</a> ; to PRINT-ON 3195 3196 ; --- 3197 3198 <a name="L0B31"></a>;; <b>NOT-TAB</b> 3199 L0B31: CALL <A href="#L0F55">L0F55</a> ; routine SCANNING 3200 CALL <A href="#L0B55">L0B55</a> ; routine PRINT-STK 3201 3202 <a name="L0B37"></a>;; <b>PRINT-ON</b> 3203 L0B37: RST 18H ; GET-CHAR 3204 SUB $1A ; 3205 ADC A,$00 ; 3206 JR Z,<A href="#L0B44">L0B44</a> ; to SPACING 3207 3208 CALL <A href="#L0D1D">L0D1D</a> ; routine CHECK-END 3209 JP <A href="#L0B84">L0B84</a> ;;; to PRINT-END 3210 3211 ; --- 3212 3213 <a name="L0B44"></a>;; <b>SPACING</b> 3214 L0B44: CALL NC,<A href="#L0B8B">L0B8B</a> ; routine FIELD 3215 3216 RST 20H ; NEXT-CHAR 3217 CP $76 ; 3218 RET Z ; 3219 3220 JP <A href="#L0AD5">L0AD5</a> ;;; to PRINT-1 3221 3222 ; --- 3223 3224 <a name="L0B4E"></a>;; <b>SYNTAX-ON</b> 3225 L0B4E: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 3226 RET NZ ; 3227 3228 POP HL ; 3229 JR <A href="#L0B37">L0B37</a> ; to PRINT-ON 3230 3231 ; --- 3232 3233 <a name="L0B55"></a>;; <b>PRINT-STK</b> 3234 L0B55: CALL <A href="#L0AC5">L0AC5</a> ; routine UNSTACK-Z 3235 BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? 3236 CALL Z,<A href="#L13F8">L13F8</a> ; routine STK-FETCH 3237 JR Z,<A href="#L0B6B">L0B6B</a> ; to PR-STR-4 3238 3239 JP <A href="#L15DB">L15DB</a> ; jump forward to PRINT-FP 3240 3241 ; --- 3242 3243 <a name="L0B64"></a>;; <b>PR-STR-1</b> 3244 L0B64: LD A,$0B ; 3245 3246 <a name="L0B66"></a>;; <b>PR-STR-2</b> 3247 L0B66: RST 10H ; PRINT-A 3248 3249 <a name="L0B67"></a>;; <b>PR-STR-3</b> 3250 L0B67: LD DE,($4018) ; sv X_PTR_lo 3251 3252 <a name="L0B6B"></a>;; <b>PR-STR-4</b> 3253 L0B6B: LD A,B ; 3254 OR C ; 3255 DEC BC ; 3256 RET Z ; 3257 3258 LD A,(DE) ; 3259 INC DE ; 3260 LD ($4018),DE ; sv X_PTR_lo 3261 BIT 6,A ; 3262 JR Z,<A href="#L0B66">L0B66</a> ; to PR-STR-2 3263 3264 CP $C0 ; 3265 JR Z,<A href="#L0B64">L0B64</a> ; to PR-STR-1 3266 3267 PUSH BC ; 3268 CALL <A href="#L094B">L094B</a> ; routine TOKENS 3269 POP BC ; 3270 JR <A href="#L0B67">L0B67</a> ; to PR-STR-3 3271 3272 ; --- 3273 3274 <a name="L0B84"></a>;; <b>PRINT-END</b> 3275 L0B84: CALL <A href="#L0AC5">L0AC5</a> ; routine UNSTACK-Z 3276 LD A,$76 ; 3277 3278 RST 10H ; PRINT-A 3279 RET ; 3280 3281 ; --- 3282 3283 <a name="L0B8B"></a>;; <b>FIELD</b> 3284 L0B8B: CALL <A href="#L0AC5">L0AC5</a> ; routine UNSTACK-Z 3285 SET 0,(IY+$01) ; sv FLAGS - Suppress leading space 3286 XOR A ; 3287 3288 RST 10H ; PRINT-A 3289 LD BC,($4039) ; sv S_POSN_x 3290 LD A,C ; 3291 BIT 1,(IY+$01) ; sv FLAGS - Is printer in use 3292 JR Z,<A href="#L0BA4">L0BA4</a> ; to CENTRE 3293 3294 LD A,$5D ; 3295 SUB (IY+$38) ; sv PR_CC 3296 3297 <a name="L0BA4"></a>;; <b>CENTRE</b> 3298 L0BA4: LD C,$11 ; 3299 CP C ; 3300 JR NC,<A href="#L0BAB">L0BAB</a> ; to RIGHT 3301 3302 LD C,$01 ; 3303 3304 <a name="L0BAB"></a>;; <b>RIGHT</b> 3305 L0BAB: CALL <A href="#L090B">L090B</a> ; routine SET-FIELD 3306 RET ; 3307 3308 ; -------------------------------------- 3309 ; THE <b><font color=#333388>'PLOT AND UNPLOT'</font></b> COMMAND ROUTINES 3310 ; -------------------------------------- 3311 ; 3312 ; 3313 3314 <a name="L0BAF"></a>;; <b>PLOT/UNP</b> 3315 L0BAF: CALL <A href="#L0BF5">L0BF5</a> ; routine STK-TO-BC 3316 LD ($4036),BC ; sv COORDS_x 3317 LD A,$2B ; 3318 SUB B ; 3319 JP C,<A href="#L0EAD">L0EAD</a> ; to REPORT-B 3320 3321 LD B,A ; 3322 LD A,$01 ; 3323 SRA B ; 3324 JR NC,<A href="#L0BC5">L0BC5</a> ; to COLUMNS 3325 3326 LD A,$04 ; 3327 3328 <a name="L0BC5"></a>;; <b>COLUMNS</b> 3329 L0BC5: SRA C ; 3330 JR NC,<A href="#L0BCA">L0BCA</a> ; to FIND-ADDR 3331 3332 RLCA ; 3333 3334 <a name="L0BCA"></a>;; <b>FIND-ADDR</b> 3335 L0BCA: PUSH AF ; 3336 CALL <A href="#L08F5">L08F5</a> ; routine PRINT-AT 3337 LD A,(HL) ; 3338 RLCA ; 3339 CP $10 ; 3340 JR NC,<A href="#L0BDA">L0BDA</a> ; to TABLE-PTR 3341 3342 RRCA ; 3343 JR NC,<A href="#L0BD9">L0BD9</a> ; to SQ-SAVED 3344 3345 XOR $8F ; 3346 3347 <a name="L0BD9"></a>;; <b>SQ-SAVED</b> 3348 L0BD9: LD B,A ; 3349 3350 <a name="L0BDA"></a>;; <b>TABLE-PTR</b> 3351 L0BDA: LD DE,<A href="#L0C9E">L0C9E</a> ; Address: P-UNPLOT 3352 LD A,($4030) ; sv T_ADDR_lo 3353 SUB E ; 3354 JP M,<A href="#L0BE9">L0BE9</a> ; to PLOT 3355 3356 POP AF ; 3357 CPL ; 3358 AND B ; 3359 JR <A href="#L0BEB">L0BEB</a> ; to UNPLOT 3360 3361 ; --- 3362 3363 <a name="L0BE9"></a>;; <b>PLOT</b> 3364 L0BE9: POP AF ; 3365 OR B ; 3366 3367 <a name="L0BEB"></a>;; <b>UNPLOT</b> 3368 L0BEB: CP $08 ; 3369 JR C,<A href="#L0BF1">L0BF1</a> ; to PLOT-END 3370 3371 XOR $8F ; 3372 3373 <a name="L0BF1"></a>;; <b>PLOT-END</b> 3374 L0BF1: EXX ; 3375 3376 RST 10H ; PRINT-A 3377 EXX ; 3378 RET ; 3379 3380 ; ---------------------------- 3381 ; THE <b><font color=#333388>'STACK-TO-BC'</font></b> SUBROUTINE 3382 ; ---------------------------- 3383 ; 3384 ; 3385 3386 <a name="L0BF5"></a>;; <b>STK-TO-BC</b> 3387 L0BF5: CALL <A href="#L0C02">L0C02</a> ; routine STK-TO-A 3388 LD B,A ; 3389 PUSH BC ; 3390 CALL <A href="#L0C02">L0C02</a> ; routine STK-TO-A 3391 LD E,C ; 3392 POP BC ; 3393 LD D,C ; 3394 LD C,A ; 3395 RET ; 3396 3397 ; --------------------------- 3398 ; THE <b><font color=#333388>'STACK-TO-A'</font></b> SUBROUTINE 3399 ; --------------------------- 3400 ; 3401 ; 3402 3403 <a name="L0C02"></a>;; <b>STK-TO-A</b> 3404 L0C02: CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A 3405 JP C,<A href="#L0EAD">L0EAD</a> ; to REPORT-B 3406 3407 LD C,$01 ; 3408 RET Z ; 3409 3410 LD C,$FF ; 3411 RET ; 3412 3413 ; ----------------------- 3414 ; THE <b><font color=#333388>'SCROLL'</font></b> SUBROUTINE 3415 ; ----------------------- 3416 ; 3417 ; 3418 3419 <a name="L0C0E"></a>;; <b>SCROLL</b> 3420 L0C0E: LD B,(IY+$22) ; sv DF_SZ 3421 LD C,$21 ; 3422 CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR 3423 CALL <A href="#L099B">L099B</a> ; routine ONE-SPACE 3424 LD A,(HL) ; 3425 LD (DE),A ; 3426 INC (IY+$3A) ; sv S_POSN_y 3427 LD HL,($400C) ; sv D_FILE_lo 3428 INC HL ; 3429 LD D,H ; 3430 LD E,L ; 3431 CPIR ; 3432 JP <A href="#L0A5D">L0A5D</a> ; to RECLAIM-1 3433 3434 ; ------------------- 3435 ; THE <b><font color=#333388>'SYNTAX'</font></b> TABLES 3436 ; ------------------- 3437 3438 ; i) The Offset table 3439 3440 <a name="L0C29"></a>;; <b>offset-t</b> 3441 L0C29: DEFB <A href="#L0CB4">L0CB4</a> - $ ; 8B offset to; Address: P-LPRINT 3442 DEFB <A href="#L0CB7">L0CB7</a> - $ ; 8D offset to; Address: P-LLIST 3443 DEFB <A href="#L0C58">L0C58</a> - $ ; 2D offset to; Address: P-STOP 3444 DEFB <A href="#L0CAB">L0CAB</a> - $ ; 7F offset to; Address: P-SLOW 3445 DEFB <A href="#L0CAE">L0CAE</a> - $ ; 81 offset to; Address: P-FAST 3446 DEFB <A href="#L0C77">L0C77</a> - $ ; 49 offset to; Address: P-NEW 3447 DEFB <A href="#L0CA4">L0CA4</a> - $ ; 75 offset to; Address: P-SCROLL 3448 DEFB <A href="#L0C8F">L0C8F</a> - $ ; 5F offset to; Address: P-CONT 3449 DEFB <A href="#L0C71">L0C71</a> - $ ; 40 offset to; Address: P-DIM 3450 DEFB <A href="#L0C74">L0C74</a> - $ ; 42 offset to; Address: P-REM 3451 DEFB <A href="#L0C5E">L0C5E</a> - $ ; 2B offset to; Address: P-FOR 3452 DEFB <A href="#L0C4B">L0C4B</a> - $ ; 17 offset to; Address: P-GOTO 3453 DEFB <A href="#L0C54">L0C54</a> - $ ; 1F offset to; Address: P-GOSUB 3454 DEFB <A href="#L0C6D">L0C6D</a> - $ ; 37 offset to; Address: P-INPUT 3455 DEFB <A href="#L0C89">L0C89</a> - $ ; 52 offset to; Address: P-LOAD 3456 DEFB <A href="#L0C7D">L0C7D</a> - $ ; 45 offset to; Address: P-LIST 3457 DEFB <A href="#L0C48">L0C48</a> - $ ; 0F offset to; Address: P-LET 3458 DEFB <A href="#L0CA7">L0CA7</a> - $ ; 6D offset to; Address: P-PAUSE 3459 DEFB <A href="#L0C66">L0C66</a> - $ ; 2B offset to; Address: P-NEXT 3460 DEFB <A href="#L0C80">L0C80</a> - $ ; 44 offset to; Address: P-POKE 3461 DEFB <A href="#L0C6A">L0C6A</a> - $ ; 2D offset to; Address: P-PRINT 3462 DEFB <A href="#L0C98">L0C98</a> - $ ; 5A offset to; Address: P-PLOT 3463 DEFB <A href="#L0C7A">L0C7A</a> - $ ; 3B offset to; Address: P-RUN 3464 DEFB <A href="#L0C8C">L0C8C</a> - $ ; 4C offset to; Address: P-SAVE 3465 DEFB <A href="#L0C86">L0C86</a> - $ ; 45 offset to; Address: P-RAND 3466 DEFB <A href="#L0C4F">L0C4F</a> - $ ; 0D offset to; Address: P-IF 3467 DEFB <A href="#L0C95">L0C95</a> - $ ; 52 offset to; Address: P-CLS 3468 DEFB <A href="#L0C9E">L0C9E</a> - $ ; 5A offset to; Address: P-UNPLOT 3469 DEFB <A href="#L0C92">L0C92</a> - $ ; 4D offset to; Address: P-CLEAR 3470 DEFB <A href="#L0C5B">L0C5B</a> - $ ; 15 offset to; Address: P-RETURN 3471 DEFB <A href="#L0CB1">L0CB1</a> - $ ; 6A offset to; Address: P-COPY 3472 3473 ; ii) The parameter table. 3474 3475 3476 <a name="L0C48"></a>;; <b>P-LET</b> 3477 L0C48: DEFB $01 ; Class-01 - A variable is required. 3478 DEFB $14 ; Separator: '=' 3479 DEFB $02 ; Class-02 - An expression, numeric or string, 3480 ; must follow. 3481 3482 <a name="L0C4B"></a>;; <b>P-GOTO</b> 3483 L0C4B: DEFB $06 ; Class-06 - A numeric expression must follow. 3484 DEFB $00 ; Class-00 - No further operands. 3485 DEFW <A href="#L0E81">L0E81</a> ; Address: $0E81; Address: GOTO 3486 3487 <a name="L0C4F"></a>;; <b>P-IF</b> 3488 L0C4F: DEFB $06 ; Class-06 - A numeric expression must follow. 3489 DEFB $DE ; Separator: 'THEN' 3490 DEFB $05 ; Class-05 - Variable syntax checked entirely 3491 ; by routine. 3492 DEFW <A href="#L0DAB">L0DAB</a> ; Address: $0DAB; Address: IF 3493 3494 <a name="L0C54"></a>;; <b>P-GOSUB</b> 3495 L0C54: DEFB $06 ; Class-06 - A numeric expression must follow. 3496 DEFB $00 ; Class-00 - No further operands. 3497 DEFW <A href="#L0EB5">L0EB5</a> ; Address: $0EB5; Address: GOSUB 3498 3499 <a name="L0C58"></a>;; <b>P-STOP</b> 3500 L0C58: DEFB $00 ; Class-00 - No further operands. 3501 DEFW <A href="#L0CDC">L0CDC</a> ; Address: $0CDC; Address: STOP 3502 3503 <a name="L0C5B"></a>;; <b>P-RETURN</b> 3504 L0C5B: DEFB $00 ; Class-00 - No further operands. 3505 DEFW <A href="#L0ED8">L0ED8</a> ; Address: $0ED8; Address: RETURN 3506 3507 <a name="L0C5E"></a>;; <b>P-FOR</b> 3508 L0C5E: DEFB $04 ; Class-04 - A single character variable must 3509 ; follow. 3510 DEFB $14 ; Separator: '=' 3511 DEFB $06 ; Class-06 - A numeric expression must follow. 3512 DEFB $DF ; Separator: 'TO' 3513 DEFB $06 ; Class-06 - A numeric expression must follow. 3514 DEFB $05 ; Class-05 - Variable syntax checked entirely 3515 ; by routine. 3516 DEFW <A href="#L0DB9">L0DB9</a> ; Address: $0DB9; Address: FOR 3517 3518 <a name="L0C66"></a>;; <b>P-NEXT</b> 3519 L0C66: DEFB $04 ; Class-04 - A single character variable must 3520 ; follow. 3521 DEFB $00 ; Class-00 - No further operands. 3522 DEFW <A href="#L0E2E">L0E2E</a> ; Address: $0E2E; Address: NEXT 3523 3524 <a name="L0C6A"></a>;; <b>P-PRINT</b> 3525 L0C6A: DEFB $05 ; Class-05 - Variable syntax checked entirely 3526 ; by routine. 3527 DEFW <A href="#L0ACF">L0ACF</a> ; Address: $0ACF; Address: PRINT 3528 3529 <a name="L0C6D"></a>;; <b>P-INPUT</b> 3530 L0C6D: DEFB $01 ; Class-01 - A variable is required. 3531 DEFB $00 ; Class-00 - No further operands. 3532 DEFW <A href="#L0EE9">L0EE9</a> ; Address: $0EE9; Address: INPUT 3533 3534 <a name="L0C71"></a>;; <b>P-DIM</b> 3535 L0C71: DEFB $05 ; Class-05 - Variable syntax checked entirely 3536 ; by routine. 3537 DEFW <A href="#L1409">L1409</a> ; Address: $1409; Address: DIM 3538 3539 <a name="L0C74"></a>;; <b>P-REM</b> 3540 L0C74: DEFB $05 ; Class-05 - Variable syntax checked entirely 3541 ; by routine. 3542 DEFW <A href="#L0D6A">L0D6A</a> ; Address: $0D6A; Address: REM 3543 3544 <a name="L0C77"></a>;; <b>P-NEW</b> 3545 L0C77: DEFB $00 ; Class-00 - No further operands. 3546 DEFW <A href="#L03C3">L03C3</a> ; Address: $03C3; Address: NEW 3547 3548 <a name="L0C7A"></a>;; <b>P-RUN</b> 3549 L0C7A: DEFB $03 ; Class-03 - A numeric expression may follow 3550 ; else default to zero. 3551 DEFW <A href="#L0EAF">L0EAF</a> ; Address: $0EAF; Address: RUN 3552 3553 <a name="L0C7D"></a>;; <b>P-LIST</b> 3554 L0C7D: DEFB $03 ; Class-03 - A numeric expression may follow 3555 ; else default to zero. 3556 DEFW <A href="#L0730">L0730</a> ; Address: $0730; Address: LIST 3557 3558 <a name="L0C80"></a>;; <b>P-POKE</b> 3559 L0C80: DEFB $06 ; Class-06 - A numeric expression must follow. 3560 DEFB $1A ; Separator: ',' 3561 DEFB $06 ; Class-06 - A numeric expression must follow. 3562 DEFB $00 ; Class-00 - No further operands. 3563 DEFW <A href="#L0E92">L0E92</a> ; Address: $0E92; Address: POKE 3564 3565 <a name="L0C86"></a>;; <b>P-RAND</b> 3566 L0C86: DEFB $03 ; Class-03 - A numeric expression may follow 3567 ; else default to zero. 3568 DEFW <A href="#L0E6C">L0E6C</a> ; Address: $0E6C; Address: RAND 3569 3570 <a name="L0C89"></a>;; <b>P-LOAD</b> 3571 L0C89: DEFB $05 ; Class-05 - Variable syntax checked entirely 3572 ; by routine. 3573 DEFW <A href="#L0340">L0340</a> ; Address: $0340; Address: LOAD 3574 3575 <a name="L0C8C"></a>;; <b>P-SAVE</b> 3576 L0C8C: DEFB $05 ; Class-05 - Variable syntax checked entirely 3577 ; by routine. 3578 DEFW <A href="#L02F6">L02F6</a> ; Address: $02F6; Address: SAVE 3579 3580 <a name="L0C8F"></a>;; <b>P-CONT</b> 3581 L0C8F: DEFB $00 ; Class-00 - No further operands. 3582 DEFW <A href="#L0E7C">L0E7C</a> ; Address: $0E7C; Address: CONT 3583 3584 <a name="L0C92"></a>;; <b>P-CLEAR</b> 3585 L0C92: DEFB $00 ; Class-00 - No further operands. 3586 DEFW <A href="#L149A">L149A</a> ; Address: $149A; Address: CLEAR 3587 3588 <a name="L0C95"></a>;; <b>P-CLS</b> 3589 L0C95: DEFB $00 ; Class-00 - No further operands. 3590 DEFW <A href="#L0A2A">L0A2A</a> ; Address: $0A2A; Address: CLS 3591 3592 <a name="L0C98"></a>;; <b>P-PLOT</b> 3593 L0C98: DEFB $06 ; Class-06 - A numeric expression must follow. 3594 DEFB $1A ; Separator: ',' 3595 DEFB $06 ; Class-06 - A numeric expression must follow. 3596 DEFB $00 ; Class-00 - No further operands. 3597 DEFW <A href="#L0BAF">L0BAF</a> ; Address: $0BAF; Address: PLOT/UNP 3598 3599 <a name="L0C9E"></a>;; <b>P-UNPLOT</b> 3600 L0C9E: DEFB $06 ; Class-06 - A numeric expression must follow. 3601 DEFB $1A ; Separator: ',' 3602 DEFB $06 ; Class-06 - A numeric expression must follow. 3603 DEFB $00 ; Class-00 - No further operands. 3604 DEFW <A href="#L0BAF">L0BAF</a> ; Address: $0BAF; Address: PLOT/UNP 3605 3606 <a name="L0CA4"></a>;; <b>P-SCROLL</b> 3607 L0CA4: DEFB $00 ; Class-00 - No further operands. 3608 DEFW <A href="#L0C0E">L0C0E</a> ; Address: $0C0E; Address: SCROLL 3609 3610 <a name="L0CA7"></a>;; <b>P-PAUSE</b> 3611 L0CA7: DEFB $06 ; Class-06 - A numeric expression must follow. 3612 DEFB $00 ; Class-00 - No further operands. 3613 DEFW <A href="#L0F32">L0F32</a> ; Address: $0F32; Address: PAUSE 3614 3615 <a name="L0CAB"></a>;; <b>P-SLOW</b> 3616 L0CAB: DEFB $00 ; Class-00 - No further operands. 3617 DEFW <A href="#L0F2B">L0F2B</a> ; Address: $0F2B; Address: SLOW 3618 3619 <a name="L0CAE"></a>;; <b>P-FAST</b> 3620 L0CAE: DEFB $00 ; Class-00 - No further operands. 3621 DEFW <A href="#L0F23">L0F23</a> ; Address: $0F23; Address: FAST 3622 3623 <a name="L0CB1"></a>;; <b>P-COPY</b> 3624 L0CB1: DEFB $00 ; Class-00 - No further operands. 3625 DEFW <A href="#L0869">L0869</a> ; Address: $0869; Address: COPY 3626 3627 <a name="L0CB4"></a>;; <b>P-LPRINT</b> 3628 L0CB4: DEFB $05 ; Class-05 - Variable syntax checked entirely 3629 ; by routine. 3630 DEFW <A href="#L0ACB">L0ACB</a> ; Address: $0ACB; Address: LPRINT 3631 3632 <a name="L0CB7"></a>;; <b>P-LLIST</b> 3633 L0CB7: DEFB $03 ; Class-03 - A numeric expression may follow 3634 ; else default to zero. 3635 DEFW <A href="#L072C">L072C</a> ; Address: $072C; Address: LLIST 3636 3637 3638 ; --------------------------- 3639 ; THE <b><font color=#333388>'LINE SCANNING'</font></b> ROUTINE 3640 ; --------------------------- 3641 ; 3642 ; 3643 3644 <a name="L0CBA"></a>;; <b>LINE-SCAN</b> 3645 L0CBA: LD (IY+$01),$01 ; sv FLAGS 3646 CALL <A href="#L0A73">L0A73</a> ; routine E-LINE-NO 3647 3648 <a name="L0CC1"></a>;; <b>LINE-RUN</b> 3649 L0CC1: CALL <A href="#L14BC">L14BC</a> ; routine SET-MIN 3650 LD HL,$4000 ; sv ERR_NR 3651 LD (HL),$FF ; 3652 LD HL,$402D ; sv FLAGX 3653 BIT 5,(HL) ; 3654 JR Z,<A href="#L0CDE">L0CDE</a> ; to LINE-NULL 3655 3656 CP $E3 ; 'STOP' ? 3657 LD A,(HL) ; 3658 JP NZ,<A href="#L0D6F">L0D6F</a> ; to INPUT-REP 3659 3660 CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 3661 RET Z ; 3662 3663 3664 RST 08H ; ERROR-1 3665 DEFB $0C ; Error Report: BREAK - CONT repeats 3666 3667 3668 ; -------------------------- 3669 ; THE <b><font color=#333388>'STOP'</font></b> COMMAND ROUTINE 3670 ; -------------------------- 3671 ; 3672 ; 3673 3674 <a name="L0CDC"></a>;; <b>STOP</b> 3675 L0CDC: RST 08H ; ERROR-1 3676 DEFB $08 ; Error Report: STOP statement 3677 3678 ; --- 3679 3680 ; the interpretation of a line continues with a check for just spaces 3681 ; followed by a carriage return. 3682 ; The IF command also branches here with a true value to execute the 3683 ; statement after the THEN but the statement can be null so 3684 ; 10 IF 1 = 1 THEN 3685 ; passes syntax (on all ZX computers). 3686 3687 <a name="L0CDE"></a>;; <b>LINE-NULL</b> 3688 L0CDE: RST 18H ; GET-CHAR 3689 LD B,$00 ; prepare to index - early. 3690 CP $76 ; compare to NEWLINE. 3691 RET Z ; return if so. 3692 3693 LD C,A ; transfer character to C. 3694 3695 RST 20H ; NEXT-CHAR advances. 3696 LD A,C ; character to A 3697 SUB $E1 ; subtract 'LPRINT' - lowest command. 3698 JR C,<A href="#L0D26">L0D26</a> ; forward if less to REPORT-C2 3699 3700 LD C,A ; reduced token to C 3701 LD HL,<A href="#L0C29">L0C29</a> ; set HL to address of offset table. 3702 ADD HL,BC ; index into offset table. 3703 LD C,(HL) ; fetch offset 3704 ADD HL,BC ; index into parameter table. 3705 JR <A href="#L0CF7">L0CF7</a> ; to GET-PARAM 3706 3707 ; --- 3708 3709 <a name="L0CF4"></a>;; <b>SCAN-LOOP</b> 3710 L0CF4: LD HL,($4030) ; sv T_ADDR_lo 3711 3712 ; -> Entry Point to Scanning Loop 3713 3714 <a name="L0CF7"></a>;; <b>GET-PARAM</b> 3715 L0CF7: LD A,(HL) ; 3716 INC HL ; 3717 LD ($4030),HL ; sv T_ADDR_lo 3718 3719 LD BC,<A href="#L0CF4">L0CF4</a> ; Address: SCAN-LOOP 3720 PUSH BC ; is pushed on machine stack. 3721 3722 LD C,A ; 3723 CP $0B ; 3724 JR NC,<A href="#L0D10">L0D10</a> ; to SEPARATOR 3725 3726 LD HL,<A href="#L0D16">L0D16</a> ; class-tbl - the address of the class table. 3727 LD B,$00 ; 3728 ADD HL,BC ; 3729 LD C,(HL) ; 3730 ADD HL,BC ; 3731 PUSH HL ; 3732 3733 RST 18H ; GET-CHAR 3734 RET ; indirect jump to class routine and 3735 ; by subsequent RET to SCAN-LOOP. 3736 3737 ; ----------------------- 3738 ; THE <b><font color=#333388>'SEPARATOR'</font></b> ROUTINE 3739 ; ----------------------- 3740 3741 <a name="L0D10"></a>;; <b>SEPARATOR</b> 3742 L0D10: RST 18H ; GET-CHAR 3743 CP C ; 3744 JR NZ,<A href="#L0D26">L0D26</a> ; to REPORT-C2 3745 ; 'Nonsense in BASIC' 3746 3747 RST 20H ; NEXT-CHAR 3748 RET ; return 3749 3750 3751 ; ------------------------- 3752 ; THE <b><font color=#333388>'COMMAND CLASS'</font></b> TABLE 3753 ; ------------------------- 3754 ; 3755 3756 <a name="L0D16"></a>;; <b>class-tbl</b> 3757 L0D16: DEFB <A href="#L0D2D">L0D2D</a> - $ ; 17 offset to; Address: CLASS-0 3758 DEFB <A href="#L0D3C">L0D3C</a> - $ ; 25 offset to; Address: CLASS-1 3759 DEFB <A href="#L0D6B">L0D6B</a> - $ ; 53 offset to; Address: CLASS-2 3760 DEFB <A href="#L0D28">L0D28</a> - $ ; 0F offset to; Address: CLASS-3 3761 DEFB <A href="#L0D85">L0D85</a> - $ ; 6B offset to; Address: CLASS-4 3762 DEFB <A href="#L0D2E">L0D2E</a> - $ ; 13 offset to; Address: CLASS-5 3763 DEFB <A href="#L0D92">L0D92</a> - $ ; 76 offset to; Address: CLASS-6 3764 3765 3766 ; -------------------------- 3767 ; THE <b><font color=#333388>'CHECK END'</font></b> SUBROUTINE 3768 ; -------------------------- 3769 ; Check for end of statement and that no spurious characters occur after 3770 ; a correctly parsed statement. Since only one statement is allowed on each 3771 ; line, the only character that may follow a statement is a NEWLINE. 3772 ; 3773 3774 <a name="L0D1D"></a>;; <b>CHECK-END</b> 3775 L0D1D: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 3776 RET NZ ; return in runtime. 3777 3778 POP BC ; else drop return address. 3779 3780 <a name="L0D22"></a>;; <b>CHECK-2</b> 3781 L0D22: LD A,(HL) ; fetch character. 3782 CP $76 ; compare to NEWLINE. 3783 RET Z ; return if so. 3784 3785 <a name="L0D26"></a>;; <b>REPORT-C2</b> 3786 L0D26: JR <A href="#L0D9A">L0D9A</a> ; to REPORT-C 3787 ; 'Nonsense in BASIC' 3788 3789 ; -------------------------- 3790 ; COMMAND CLASSES 03, 00, 05 3791 ; -------------------------- 3792 ; 3793 ; 3794 3795 <a name="L0D28"></a>;; <b>CLASS-3</b> 3796 L0D28: CP $76 ; 3797 CALL <A href="#L0D9C">L0D9C</a> ; routine NO-TO-STK 3798 3799 <a name="L0D2D"></a>;; <b>CLASS-0</b> 3800 L0D2D: CP A ; 3801 3802 <a name="L0D2E"></a>;; <b>CLASS-5</b> 3803 L0D2E: POP BC ; 3804 CALL Z,<A href="#L0D1D">L0D1D</a> ; routine CHECK-END 3805 EX DE,HL ; 3806 LD HL,($4030) ; sv T_ADDR_lo 3807 LD C,(HL) ; 3808 INC HL ; 3809 LD B,(HL) ; 3810 EX DE,HL ; 3811 3812 <a name="L0D3A"></a>;; <b>CLASS-END</b> 3813 L0D3A: PUSH BC ; 3814 RET ; 3815 3816 ; ------------------------------ 3817 ; COMMAND CLASSES 01, 02, 04, 06 3818 ; ------------------------------ 3819 ; 3820 ; 3821 3822 <a name="L0D3C"></a>;; <b>CLASS-1</b> 3823 L0D3C: CALL <A href="#L111C">L111C</a> ; routine LOOK-VARS 3824 3825 <a name="L0D3F"></a>;; <b>CLASS-4-2</b> 3826 L0D3F: LD (IY+$2D),$00 ; sv FLAGX 3827 JR NC,<A href="#L0D4D">L0D4D</a> ; to SET-STK 3828 3829 SET 1,(IY+$2D) ; sv FLAGX 3830 JR NZ,<A href="#L0D63">L0D63</a> ; to SET-STRLN 3831 3832 3833 <a name="L0D4B"></a>;; <b>REPORT-2</b> 3834 L0D4B: RST 08H ; ERROR-1 3835 DEFB $01 ; Error Report: Variable not found 3836 3837 ; --- 3838 3839 <a name="L0D4D"></a>;; <b>SET-STK</b> 3840 L0D4D: CALL Z,<A href="#L11A7">L11A7</a> ; routine STK-VAR 3841 BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? 3842 JR NZ,<A href="#L0D63">L0D63</a> ; to SET-STRLN 3843 3844 XOR A ; 3845 CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 3846 CALL NZ,<A href="#L13F8">L13F8</a> ; routine STK-FETCH 3847 LD HL,$402D ; sv FLAGX 3848 OR (HL) ; 3849 LD (HL),A ; 3850 EX DE,HL ; 3851 3852 <a name="L0D63"></a>;; <b>SET-STRLN</b> 3853 L0D63: LD ($402E),BC ; sv STRLEN_lo 3854 LD ($4012),HL ; sv DEST-lo 3855 3856 ; THE <b><font color=#333388>'REM'</font></b> COMMAND ROUTINE 3857 3858 <a name="L0D6A"></a>;; <b>REM</b> 3859 L0D6A: RET ; 3860 3861 ; --- 3862 3863 <a name="L0D6B"></a>;; <b>CLASS-2</b> 3864 L0D6B: POP BC ; 3865 LD A,($4001) ; sv FLAGS 3866 3867 <a name="L0D6F"></a>;; <b>INPUT-REP</b> 3868 L0D6F: PUSH AF ; 3869 CALL <A href="#L0F55">L0F55</a> ; routine SCANNING 3870 POP AF ; 3871 LD BC,<A href="#L1321">L1321</a> ; Address: LET 3872 LD D,(IY+$01) ; sv FLAGS 3873 XOR D ; 3874 AND $40 ; 3875 JR NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C 3876 3877 BIT 7,D ; 3878 JR NZ,<A href="#L0D3A">L0D3A</a> ; to CLASS-END 3879 3880 JR <A href="#L0D22">L0D22</a> ; to CHECK-2 3881 3882 ; --- 3883 3884 <a name="L0D85"></a>;; <b>CLASS-4</b> 3885 L0D85: CALL <A href="#L111C">L111C</a> ; routine LOOK-VARS 3886 PUSH AF ; 3887 LD A,C ; 3888 OR $9F ; 3889 INC A ; 3890 JR NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C 3891 3892 POP AF ; 3893 JR <A href="#L0D3F">L0D3F</a> ; to CLASS-4-2 3894 3895 ; --- 3896 3897 <a name="L0D92"></a>;; <b>CLASS-6</b> 3898 L0D92: CALL <A href="#L0F55">L0F55</a> ; routine SCANNING 3899 BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? 3900 RET NZ ; 3901 3902 3903 <a name="L0D9A"></a>;; <b>REPORT-C</b> 3904 L0D9A: RST 08H ; ERROR-1 3905 DEFB $0B ; Error Report: Nonsense in BASIC 3906 3907 ; -------------------------------- 3908 ; THE <b><font color=#333388>'NUMBER TO STACK'</font></b> SUBROUTINE 3909 ; -------------------------------- 3910 ; 3911 ; 3912 3913 <a name="L0D9C"></a>;; <b>NO-TO-STK</b> 3914 L0D9C: JR NZ,<A href="#L0D92">L0D92</a> ; back to CLASS-6 with a non-zero number. 3915 3916 CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 3917 RET Z ; return if checking syntax. 3918 3919 ; in runtime a zero default is placed on the calculator stack. 3920 3921 RST 28H ;; FP-CALC 3922 DEFB $A0 ;;stk-zero 3923 DEFB $34 ;;end-calc 3924 3925 RET ; return. 3926 3927 ; ------------------------- 3928 ; THE <b><font color=#333388>'SYNTAX-Z'</font></b> SUBROUTINE 3929 ; ------------------------- 3930 ; This routine returns with zero flag set if checking syntax. 3931 ; Calling this routine uses three instruction bytes compared to four if the 3932 ; bit test is implemented inline. 3933 3934 <a name="L0DA6"></a>;; <b>SYNTAX-Z</b> 3935 L0DA6: BIT 7,(IY+$01) ; test FLAGS - checking syntax only? 3936 RET ; return. 3937 3938 ; ------------------------ 3939 ; THE <b><font color=#333388>'IF'</font></b> COMMAND ROUTINE 3940 ; ------------------------ 3941 ; In runtime, the class routines have evaluated the test expression and 3942 ; the result, true or false, is on the stack. 3943 3944 <a name="L0DAB"></a>;; <b>IF</b> 3945 L0DAB: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 3946 JR Z,<A href="#L0DB6">L0DB6</a> ; forward if checking syntax to IF-END 3947 3948 ; else delete the Boolean value on the calculator stack. 3949 3950 RST 28H ;; FP-CALC 3951 DEFB $02 ;;delete 3952 DEFB $34 ;;end-calc 3953 3954 ; register DE points to exponent of floating point value. 3955 3956 LD A,(DE) ; fetch exponent. 3957 AND A ; test for zero - FALSE. 3958 RET Z ; return if so. 3959 3960 <a name="L0DB6"></a>;; <b>IF-END</b> 3961 L0DB6: JP <A href="#L0CDE">L0CDE</a> ; jump back to LINE-NULL 3962 3963 ; ------------------------- 3964 ; THE <b><font color=#333388>'FOR'</font></b> COMMAND ROUTINE 3965 ; ------------------------- 3966 ; 3967 ; 3968 3969 <a name="L0DB9"></a>;; <b>FOR</b> 3970 L0DB9: CP $E0 ; is current character 'STEP' ? 3971 JR NZ,<A href="#L0DC6">L0DC6</a> ; forward if not to F-USE-ONE 3972 3973 3974 RST 20H ; NEXT-CHAR 3975 CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6 stacks the number 3976 CALL <A href="#L0D1D">L0D1D</a> ; routine CHECK-END 3977 JR <A href="#L0DCC">L0DCC</a> ; forward to F-REORDER 3978 3979 ; --- 3980 3981 <a name="L0DC6"></a>;; <b>F-USE-ONE</b> 3982 L0DC6: CALL <A href="#L0D1D">L0D1D</a> ; routine CHECK-END 3983 3984 RST 28H ;; FP-CALC 3985 DEFB $A1 ;;stk-one 3986 DEFB $34 ;;end-calc 3987 3988 3989 3990 <a name="L0DCC"></a>;; <b>F-REORDER</b> 3991 L0DCC: RST 28H ;; FP-CALC v, l, s. 3992 DEFB $C0 ;;st-mem-0 v, l, s. 3993 DEFB $02 ;;delete v, l. 3994 DEFB $01 ;;exchange l, v. 3995 DEFB $E0 ;;get-mem-0 l, v, s. 3996 DEFB $01 ;;exchange l, s, v. 3997 DEFB $34 ;;end-calc l, s, v. 3998 3999 CALL <A href="#L1321">L1321</a> ; routine LET 4000 4001 LD ($401F),HL ; set MEM to address variable. 4002 DEC HL ; point to letter. 4003 LD A,(HL) ; 4004 SET 7,(HL) ; 4005 LD BC,$0006 ; 4006 ADD HL,BC ; 4007 RLCA ; 4008 JR C,<A href="#L0DEA">L0DEA</a> ; to F-LMT-STP 4009 4010 SLA C ; 4011 CALL <A href="#L099E">L099E</a> ; routine MAKE-ROOM 4012 INC HL ; 4013 4014 <a name="L0DEA"></a>;; <b>F-LMT-STP</b> 4015 L0DEA: PUSH HL ; 4016 4017 RST 28H ;; FP-CALC 4018 DEFB $02 ;;delete 4019 DEFB $02 ;;delete 4020 DEFB $34 ;;end-calc 4021 4022 POP HL ; 4023 EX DE,HL ; 4024 4025 LD C,$0A ; ten bytes to be moved. 4026 LDIR ; copy bytes 4027 4028 LD HL,($4007) ; set HL to system variable PPC current line. 4029 EX DE,HL ; transfer to DE, variable pointer to HL. 4030 INC DE ; loop start will be this line + 1 at least. 4031 LD (HL),E ; 4032 INC HL ; 4033 LD (HL),D ; 4034 CALL <A href="#L0E5A">L0E5A</a> ; routine NEXT-LOOP considers an initial pass. 4035 RET NC ; return if possible. 4036 4037 ; else program continues from point following matching NEXT. 4038 4039 BIT 7,(IY+$08) ; test PPC_hi 4040 RET NZ ; return if over 32767 ??? 4041 4042 LD B,(IY+$2E) ; fetch variable name from STRLEN_lo 4043 RES 6,B ; make a true letter. 4044 LD HL,($4029) ; set HL from NXTLIN 4045 4046 ; now enter a loop to look for matching next. 4047 4048 <a name="L0E0E"></a>;; <b>NXTLIN-NO</b> 4049 L0E0E: LD A,(HL) ; fetch high byte of line number. 4050 AND $C0 ; mask off low bits $3F 4051 JR NZ,<A href="#L0E2A">L0E2A</a> ; forward at end of program to FOR-END 4052 4053 PUSH BC ; save letter 4054 CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE finds next line. 4055 POP BC ; restore letter 4056 4057 INC HL ; step past low byte 4058 INC HL ; past the 4059 INC HL ; line length. 4060 CALL <A href="#L004C">L004C</a> ; routine TEMP-PTR1 sets CH_ADD 4061 4062 RST 18H ; GET-CHAR 4063 CP $F3 ; compare to 'NEXT'. 4064 EX DE,HL ; next line to HL. 4065 JR NZ,<A href="#L0E0E">L0E0E</a> ; back with no match to NXTLIN-NO 4066 4067 ; 4068 4069 EX DE,HL ; restore pointer. 4070 4071 RST 20H ; NEXT-CHAR advances and gets letter in A. 4072 EX DE,HL ; save pointer 4073 CP B ; compare to variable name. 4074 JR NZ,<A href="#L0E0E">L0E0E</a> ; back with mismatch to NXTLIN-NO 4075 4076 <a name="L0E2A"></a>;; <b>FOR-END</b> 4077 L0E2A: LD ($4029),HL ; update system variable NXTLIN 4078 RET ; return. 4079 4080 ; -------------------------- 4081 ; THE <b><font color=#333388>'NEXT'</font></b> COMMAND ROUTINE 4082 ; -------------------------- 4083 ; 4084 ; 4085 4086 <a name="L0E2E"></a>;; <b>NEXT</b> 4087 L0E2E: BIT 1,(IY+$2D) ; sv FLAGX 4088 JP NZ,<A href="#L0D4B">L0D4B</a> ; to REPORT-2 4089 4090 LD HL,($4012) ; DEST 4091 BIT 7,(HL) ; 4092 JR Z,<A href="#L0E58">L0E58</a> ; to REPORT-1 4093 4094 INC HL ; 4095 LD ($401F),HL ; sv MEM_lo 4096 4097 RST 28H ;; FP-CALC 4098 DEFB $E0 ;;get-mem-0 4099 DEFB $E2 ;;get-mem-2 4100 DEFB $0F ;;addition 4101 DEFB $C0 ;;st-mem-0 4102 DEFB $02 ;;delete 4103 DEFB $34 ;;end-calc 4104 4105 CALL <A href="#L0E5A">L0E5A</a> ; routine NEXT-LOOP 4106 RET C ; 4107 4108 LD HL,($401F) ; sv MEM_lo 4109 LD DE,$000F ; 4110 ADD HL,DE ; 4111 LD E,(HL) ; 4112 INC HL ; 4113 LD D,(HL) ; 4114 EX DE,HL ; 4115 JR <A href="#L0E86">L0E86</a> ; to GOTO-2 4116 4117 ; --- 4118 4119 4120 <a name="L0E58"></a>;; <b>REPORT-1</b> 4121 L0E58: RST 08H ; ERROR-1 4122 DEFB $00 ; Error Report: NEXT without FOR 4123 4124 4125 ; -------------------------- 4126 ; THE <b><font color=#333388>'NEXT-LOOP'</font></b> SUBROUTINE 4127 ; -------------------------- 4128 ; 4129 ; 4130 4131 <a name="L0E5A"></a>;; <b>NEXT-LOOP</b> 4132 L0E5A: RST 28H ;; FP-CALC 4133 DEFB $E1 ;;get-mem-1 4134 DEFB $E0 ;;get-mem-0 4135 DEFB $E2 ;;get-mem-2 4136 DEFB $32 ;;less-0 4137 DEFB $00 ;;jump-true 4138 DEFB $02 ;;to <A href="#L0E62">L0E62</a>, LMT-V-VAL 4139 4140 DEFB $01 ;;exchange 4141 4142 <a name="L0E62"></a>;; <b>LMT-V-VAL</b> 4143 L0E62: DEFB $03 ;;subtract 4144 DEFB $33 ;;greater-0 4145 DEFB $00 ;;jump-true 4146 DEFB $04 ;;to <A href="#L0E69">L0E69</a>, IMPOSS 4147 4148 DEFB $34 ;;end-calc 4149 4150 AND A ; clear carry flag 4151 RET ; return. 4152 4153 ; --- 4154 4155 4156 <a name="L0E69"></a>;; <b>IMPOSS</b> 4157 L0E69: DEFB $34 ;;end-calc 4158 4159 SCF ; set carry flag 4160 RET ; return. 4161 4162 ; -------------------------- 4163 ; THE <b><font color=#333388>'RAND'</font></b> COMMAND ROUTINE 4164 ; -------------------------- 4165 ; The keyword was <b><font color=#333388>'RANDOMISE'</font></b> on the ZX80, is 'RAND' here on the ZX81 and 4166 ; becomes 'RANDOMIZE' on the ZX Spectrum. 4167 ; In all invocations the procedure is the same - to set the SEED system variable 4168 ; with a supplied integer value or to use a time-based value if no number, or 4169 ; zero, is supplied. 4170 4171 <a name="L0E6C"></a>;; <b>RAND</b> 4172 L0E6C: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT 4173 LD A,B ; test value 4174 OR C ; for zero 4175 JR NZ,<A href="#L0E77">L0E77</a> ; forward if not zero to SET-SEED 4176 4177 LD BC,($4034) ; fetch value of FRAMES system variable. 4178 4179 <a name="L0E77"></a>;; <b>SET-SEED</b> 4180 L0E77: LD ($4032),BC ; update the SEED system variable. 4181 RET ; return. 4182 4183 ; -------------------------- 4184 ; THE <b><font color=#333388>'CONT'</font></b> COMMAND ROUTINE 4185 ; -------------------------- 4186 ; Another abbreviated command. ROM space was really tight. 4187 ; CONTINUE at the line number that was set when break was pressed. 4188 ; Sometimes the current line, sometimes the next line. 4189 4190 <a name="L0E7C"></a>;; <b>CONT</b> 4191 L0E7C: LD HL,($402B) ; set HL from system variable OLDPPC 4192 JR <A href="#L0E86">L0E86</a> ; forward to GOTO-2 4193 4194 ; -------------------------- 4195 ; THE <b><font color=#333388>'GOTO'</font></b> COMMAND ROUTINE 4196 ; -------------------------- 4197 ; This token also suffered from the shortage of room and there is no space 4198 ; getween GO and TO as there is on the ZX80 and ZX Spectrum. The same also 4199 ; applies to the GOSUB keyword. 4200 4201 <a name="L0E81"></a>;; <b>GOTO</b> 4202 L0E81: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT 4203 LD H,B ; 4204 LD L,C ; 4205 4206 <a name="L0E86"></a>;; <b>GOTO-2</b> 4207 L0E86: LD A,H ; 4208 CP $F0 ; 4209 JR NC,<A href="#L0EAD">L0EAD</a> ; to REPORT-B 4210 4211 CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR 4212 LD ($4029),HL ; sv NXTLIN_lo 4213 RET ; 4214 4215 ; -------------------------- 4216 ; THE <b><font color=#333388>'POKE'</font></b> COMMAND ROUTINE 4217 ; -------------------------- 4218 ; 4219 ; 4220 4221 <a name="L0E92"></a>;; <b>POKE</b> 4222 L0E92: CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A 4223 JR C,<A href="#L0EAD">L0EAD</a> ; forward, with overflow, to REPORT-B 4224 4225 JR Z,<A href="#L0E9B">L0E9B</a> ; forward, if positive, to POKE-SAVE 4226 4227 NEG ; negate 4228 4229 <a name="L0E9B"></a>;; <b>POKE-SAVE</b> 4230 L0E9B: PUSH AF ; preserve value. 4231 CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT gets address in BC 4232 ; invoking the error routine with overflow 4233 ; or a negative number. 4234 POP AF ; restore value. 4235 4236 ; <font color=#9900FF>Note.</font> the next two instructions are legacy code from the ZX80 and 4237 ; inappropriate here. 4238 4239 BIT 7,(IY+$00) ; test ERR_NR - is it still $FF ? 4240 RET Z ; return with error. 4241 4242 LD (BC),A ; update the address contents. 4243 RET ; return. 4244 4245 ; ----------------------------- 4246 ; THE <b><font color=#333388>'FIND INTEGER'</font></b> SUBROUTINE 4247 ; ----------------------------- 4248 ; 4249 ; 4250 4251 <a name="L0EA7"></a>;; <b>FIND-INT</b> 4252 L0EA7: CALL <A href="#L158A">L158A</a> ; routine FP-TO-BC 4253 JR C,<A href="#L0EAD">L0EAD</a> ; forward with overflow to REPORT-B 4254 4255 RET Z ; return if positive (0-65535). 4256 4257 4258 <a name="L0EAD"></a>;; <b>REPORT-B</b> 4259 L0EAD: RST 08H ; ERROR-1 4260 DEFB $0A ; Error Report: Integer out of range 4261 4262 ; ------------------------- 4263 ; THE <b><font color=#333388>'RUN'</font></b> COMMAND ROUTINE 4264 ; ------------------------- 4265 ; 4266 ; 4267 4268 <a name="L0EAF"></a>;; <b>RUN</b> 4269 L0EAF: CALL <A href="#L0E81">L0E81</a> ; routine GOTO 4270 JP <A href="#L149A">L149A</a> ; to CLEAR 4271 4272 ; --------------------------- 4273 ; THE <b><font color=#333388>'GOSUB'</font></b> COMMAND ROUTINE 4274 ; --------------------------- 4275 ; 4276 ; 4277 4278 <a name="L0EB5"></a>;; <b>GOSUB</b> 4279 L0EB5: LD HL,($4007) ; sv PPC_lo 4280 INC HL ; 4281 EX (SP),HL ; 4282 PUSH HL ; 4283 LD ($4002),SP ; set the error stack pointer - ERR_SP 4284 CALL <A href="#L0E81">L0E81</a> ; routine GOTO 4285 LD BC,$0006 ; 4286 4287 ; -------------------------- 4288 ; THE <b><font color=#333388>'TEST ROOM'</font></b> SUBROUTINE 4289 ; -------------------------- 4290 ; 4291 ; 4292 4293 <a name="L0EC5"></a>;; <b>TEST-ROOM</b> 4294 L0EC5: LD HL,($401C) ; sv STKEND_lo 4295 ADD HL,BC ; 4296 JR C,<A href="#L0ED3">L0ED3</a> ; to REPORT-4 4297 4298 EX DE,HL ; 4299 LD HL,$0024 ; 4300 ADD HL,DE ; 4301 SBC HL,SP ; 4302 RET C ; 4303 4304 <a name="L0ED3"></a>;; <b>REPORT-4</b> 4305 L0ED3: LD L,$03 ; 4306 JP <A href="#L0058">L0058</a> ; to ERROR-3 4307 4308 ; ---------------------------- 4309 ; THE <b><font color=#333388>'RETURN'</font></b> COMMAND ROUTINE 4310 ; ---------------------------- 4311 ; 4312 ; 4313 4314 <a name="L0ED8"></a>;; <b>RETURN</b> 4315 L0ED8: POP HL ; 4316 EX (SP),HL ; 4317 LD A,H ; 4318 CP $3E ; 4319 JR Z,<A href="#L0EE5">L0EE5</a> ; to REPORT-7 4320 4321 LD ($4002),SP ; sv ERR_SP_lo 4322 JR <A href="#L0E86">L0E86</a> ; back to GOTO-2 4323 4324 ; --- 4325 4326 <a name="L0EE5"></a>;; <b>REPORT-7</b> 4327 L0EE5: EX (SP),HL ; 4328 PUSH HL ; 4329 4330 RST 08H ; ERROR-1 4331 DEFB $06 ; Error Report: RETURN without GOSUB 4332 4333 ; --------------------------- 4334 ; THE <b><font color=#333388>'INPUT'</font></b> COMMAND ROUTINE 4335 ; --------------------------- 4336 ; 4337 ; 4338 4339 <a name="L0EE9"></a>;; <b>INPUT</b> 4340 L0EE9: BIT 7,(IY+$08) ; sv PPC_hi 4341 JR NZ,<A href="#L0F21">L0F21</a> ; to REPORT-8 4342 4343 CALL <A href="#L14A3">L14A3</a> ; routine X-TEMP 4344 LD HL,$402D ; sv FLAGX 4345 SET 5,(HL) ; 4346 RES 6,(HL) ; 4347 LD A,($4001) ; sv FLAGS 4348 AND $40 ; 4349 LD BC,$0002 ; 4350 JR NZ,<A href="#L0F05">L0F05</a> ; to PROMPT 4351 4352 LD C,$04 ; 4353 4354 <a name="L0F05"></a>;; <b>PROMPT</b> 4355 L0F05: OR (HL) ; 4356 LD (HL),A ; 4357 4358 RST 30H ; BC-SPACES 4359 LD (HL),$76 ; 4360 LD A,C ; 4361 RRCA ; 4362 RRCA ; 4363 JR C,<A href="#L0F14">L0F14</a> ; to ENTER-CUR 4364 4365 LD A,$0B ; 4366 LD (DE),A ; 4367 DEC HL ; 4368 LD (HL),A ; 4369 4370 <a name="L0F14"></a>;; <b>ENTER-CUR</b> 4371 L0F14: DEC HL ; 4372 LD (HL),$7F ; 4373 LD HL,($4039) ; sv S_POSN_x 4374 LD ($4030),HL ; sv T_ADDR_lo 4375 POP HL ; 4376 JP <A href="#L0472">L0472</a> ; to LOWER 4377 4378 ; --- 4379 4380 <a name="L0F21"></a>;; <b>REPORT-8</b> 4381 L0F21: RST 08H ; ERROR-1 4382 DEFB $07 ; Error Report: End of file 4383 4384 ; --------------------------- 4385 ; THE <b><font color=#333388>'PAUSE'</font></b> COMMAND ROUTINE 4386 ; --------------------------- 4387 ; 4388 ; 4389 4390 <a name="L0F23"></a>;; <b>FAST</b> 4391 L0F23: CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST 4392 RES 6,(IY+$3B) ; sv CDFLAG 4393 RET ; return. 4394 4395 ; -------------------------- 4396 ; THE <b><font color=#333388>'SLOW'</font></b> COMMAND ROUTINE 4397 ; -------------------------- 4398 ; 4399 ; 4400 4401 <a name="L0F2B"></a>;; <b>SLOW</b> 4402 L0F2B: SET 6,(IY+$3B) ; sv CDFLAG 4403 JP <A href="#L0207">L0207</a> ; to SLOW/FAST 4404 4405 ; --------------------------- 4406 ; THE <b><font color=#333388>'PAUSE'</font></b> COMMAND ROUTINE 4407 ; --------------------------- 4408 4409 <a name="L0F32"></a>;; <b>PAUSE</b> 4410 L0F32: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT 4411 CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST 4412 LD H,B ; 4413 LD L,C ; 4414 CALL <A href="#L022D">L022D</a> ; routine DISPLAY-P 4415 4416 LD (IY+$35),$FF ; sv FRAMES_hi 4417 4418 CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST 4419 JR <A href="#L0F4B">L0F4B</a> ; routine DEBOUNCE 4420 4421 ; ---------------------- 4422 ; THE <b><font color=#333388>'BREAK'</font></b> SUBROUTINE 4423 ; ---------------------- 4424 ; 4425 ; 4426 4427 <a name="L0F46"></a>;; <b>BREAK-1</b> 4428 L0F46: LD A,$7F ; read port $7FFE - keys B,N,M,.,SPACE. 4429 IN A,($FE) ; 4430 RRA ; carry will be set if space not pressed. 4431 4432 ; ------------------------- 4433 ; THE <b><font color=#333388>'DEBOUNCE'</font></b> SUBROUTINE 4434 ; ------------------------- 4435 ; 4436 ; 4437 4438 <a name="L0F4B"></a>;; <b>DEBOUNCE</b> 4439 L0F4B: RES 0,(IY+$3B) ; update system variable CDFLAG 4440 LD A,$FF ; 4441 LD ($4027),A ; update system variable DEBOUNCE 4442 RET ; return. 4443 4444 4445 ; ------------------------- 4446 ; THE <b><font color=#333388>'SCANNING'</font></b> SUBROUTINE 4447 ; ------------------------- 4448 ; This recursive routine is where the ZX81 gets its power. Provided there is 4449 ; enough memory it can evaluate an expression of unlimited complexity. 4450 ; <font color=#9900FF>Note.</font> there is no unary plus so, as on the ZX80, PRINT +1 gives a syntax error. 4451 ; PRINT +1 works on the Spectrum but so too does PRINT + "STRING". 4452 4453 <a name="L0F55"></a>;; <b>SCANNING</b> 4454 L0F55: RST 18H ; GET-CHAR 4455 LD B,$00 ; set B register to zero. 4456 PUSH BC ; stack zero as a priority end-marker. 4457 4458 <a name="L0F59"></a>;; <b>S-LOOP-1</b> 4459 L0F59: CP $40 ; compare to the 'RND' character 4460 JR NZ,<A href="#L0F8C">L0F8C</a> ; forward, if not, to S-TEST-PI 4461 4462 ; ------------------ 4463 ; THE <b><font color=#333388>'RND'</font></b> FUNCTION 4464 ; ------------------ 4465 4466 CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 4467 JR Z,<A href="#L0F8A">L0F8A</a> ; forward if checking syntax to S-JPI-END 4468 4469 LD BC,($4032) ; sv SEED_lo 4470 CALL <A href="#L1520">L1520</a> ; routine STACK-BC 4471 4472 RST 28H ;; FP-CALC 4473 DEFB $A1 ;;stk-one 4474 DEFB $0F ;;addition 4475 DEFB $30 ;;stk-data 4476 DEFB $37 ;;Exponent: $87, Bytes: 1 4477 DEFB $16 ;;(+00,+00,+00) 4478 DEFB $04 ;;multiply 4479 DEFB $30 ;;stk-data 4480 DEFB $80 ;;Bytes: 3 4481 DEFB $41 ;;Exponent $91 4482 DEFB $00,$00,$80 ;;(+00) 4483 DEFB $2E ;;n-mod-m 4484 DEFB $02 ;;delete 4485 DEFB $A1 ;;stk-one 4486 DEFB $03 ;;subtract 4487 DEFB $2D ;;duplicate 4488 DEFB $34 ;;end-calc 4489 4490 CALL <A href="#L158A">L158A</a> ; routine FP-TO-BC 4491 LD ($4032),BC ; update the SEED system variable. 4492 LD A,(HL) ; HL addresses the exponent of the last value. 4493 AND A ; test for zero 4494 JR Z,<A href="#L0F8A">L0F8A</a> ; forward, if so, to S-JPI-END 4495 4496 SUB $10 ; else reduce exponent by sixteen 4497 LD (HL),A ; thus dividing by 65536 for last value. 4498 4499 <a name="L0F8A"></a>;; <b>S-JPI-END</b> 4500 L0F8A: JR <A href="#L0F99">L0F99</a> ; forward to S-PI-END 4501 4502 ; --- 4503 4504 <a name="L0F8C"></a>;; <b>S-TEST-PI</b> 4505 L0F8C: CP $42 ; the 'PI' character 4506 JR NZ,<A href="#L0F9D">L0F9D</a> ; forward, if not, to S-TST-INK 4507 4508 ; ------------------- 4509 ; THE <b><font color=#333388>'PI'</font></b> EVALUATION 4510 ; ------------------- 4511 4512 CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 4513 JR Z,<A href="#L0F99">L0F99</a> ; forward if checking syntax to S-PI-END 4514 4515 4516 RST 28H ;; FP-CALC 4517 DEFB $A3 ;;stk-pi/2 4518 DEFB $34 ;;end-calc 4519 4520 INC (HL) ; double the exponent giving PI on the stack. 4521 4522 <a name="L0F99"></a>;; <b>S-PI-END</b> 4523 L0F99: RST 20H ; NEXT-CHAR advances character pointer. 4524 4525 JP <A href="#L1083">L1083</a> ; jump forward to S-NUMERIC to set the flag 4526 ; to signal numeric result before advancing. 4527 4528 ; --- 4529 4530 <a name="L0F9D"></a>;; <b>S-TST-INK</b> 4531 L0F9D: CP $41 ; compare to character 'INKEY$' 4532 JR NZ,<A href="#L0FB2">L0FB2</a> ; forward, if not, to S-ALPHANUM 4533 4534 ; ----------------------- 4535 ; THE <b><font color=#333388>'INKEY$'</font></b> EVALUATION 4536 ; ----------------------- 4537 4538 CALL <A href="#L02BB">L02BB</a> ; routine KEYBOARD 4539 LD B,H ; 4540 LD C,L ; 4541 LD D,C ; 4542 INC D ; 4543 CALL NZ,<A href="#L07BD">L07BD</a> ; routine DECODE 4544 LD A,D ; 4545 ADC A,D ; 4546 LD B,D ; 4547 LD C,A ; 4548 EX DE,HL ; 4549 JR <A href="#L0FED">L0FED</a> ; forward to S-STRING 4550 4551 ; --- 4552 4553 <a name="L0FB2"></a>;; <b>S-ALPHANUM</b> 4554 L0FB2: CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM 4555 JR C,<A href="#L1025">L1025</a> ; forward, if alphanumeric to S-LTR-DGT 4556 4557 CP $1B ; is character a '.' ? 4558 JP Z,<A href="#L1047">L1047</a> ; jump forward if so to S-DECIMAL 4559 4560 LD BC,$09D8 ; prepare priority 09, operation 'subtract' 4561 CP $16 ; is character unary minus '-' ? 4562 JR Z,<A href="#L1020">L1020</a> ; forward, if so, to S-PUSH-PO 4563 4564 CP $10 ; is character a '(' ? 4565 JR NZ,<A href="#L0FD6">L0FD6</a> ; forward if not to S-QUOTE 4566 4567 CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 advances character pointer. 4568 4569 CALL <A href="#L0F55">L0F55</a> ; recursively call routine SCANNING to 4570 ; evaluate the sub-expression. 4571 4572 CP $11 ; is subsequent character a ')' ? 4573 JR NZ,<A href="#L0FFF">L0FFF</a> ; forward if not to S-RPT-C 4574 4575 4576 CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 advances. 4577 JR <A href="#L0FF8">L0FF8</a> ; relative jump to S-JP-CONT3 and then S-CONT3 4578 4579 ; --- 4580 4581 ; consider a quoted string e.g. PRINT "Hooray!" 4582 ; <font color=#9900FF>Note.</font> quotes are not allowed within a string. 4583 4584 <a name="L0FD6"></a>;; <b>S-QUOTE</b> 4585 L0FD6: CP $0B ; is character a quote (") ? 4586 JR NZ,<A href="#L1002">L1002</a> ; forward, if not, to S-FUNCTION 4587 4588 CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 advances 4589 PUSH HL ; * save start of string. 4590 JR <A href="#L0FE3">L0FE3</a> ; forward to S-QUOTE-S 4591 4592 ; --- 4593 4594 4595 <a name="L0FE0"></a>;; <b>S-Q-AGAIN</b> 4596 L0FE0: CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 4597 4598 <a name="L0FE3"></a>;; <b>S-QUOTE-S</b> 4599 L0FE3: CP $0B ; is character a '"' ? 4600 JR NZ,<A href="#L0FFB">L0FFB</a> ; forward if not to S-Q-NL 4601 4602 POP DE ; * retrieve start of string 4603 AND A ; prepare to subtract. 4604 SBC HL,DE ; subtract start from current position. 4605 LD B,H ; transfer this length 4606 LD C,L ; to the BC register pair. 4607 4608 <a name="L0FED"></a>;; <b>S-STRING</b> 4609 L0FED: LD HL,$4001 ; address system variable FLAGS 4610 RES 6,(HL) ; signal string result 4611 BIT 7,(HL) ; test if checking syntax. 4612 4613 CALL NZ,<A href="#L12C3">L12C3</a> ; in run-time routine STK-STO-$ stacks the 4614 ; string descriptor - start DE, length BC. 4615 4616 RST 20H ; NEXT-CHAR advances pointer. 4617 4618 <a name="L0FF8"></a>;; <b>S-J-CONT-3</b> 4619 L0FF8: JP <A href="#L1088">L1088</a> ; jump to S-CONT-3 4620 4621 ; --- 4622 4623 ; A string with no terminating quote has to be considered. 4624 4625 <a name="L0FFB"></a>;; <b>S-Q-NL</b> 4626 L0FFB: CP $76 ; compare to NEWLINE 4627 JR NZ,<A href="#L0FE0">L0FE0</a> ; loop back if not to S-Q-AGAIN 4628 4629 <a name="L0FFF"></a>;; <b>S-RPT-C</b> 4630 L0FFF: JP <A href="#L0D9A">L0D9A</a> ; to REPORT-C 4631 4632 ; --- 4633 4634 <a name="L1002"></a>;; <b>S-FUNCTION</b> 4635 L1002: SUB $C4 ; subtract 'CODE' reducing codes 4636 ; CODE thru '<>' to range $00 - $XX 4637 JR C,<A href="#L0FFF">L0FFF</a> ; back, if less, to S-RPT-C 4638 4639 ; test for NOT the last function in character set. 4640 4641 LD BC,$04EC ; prepare priority $04, operation 'not' 4642 CP $13 ; compare to 'NOT' ( - CODE) 4643 JR Z,<A href="#L1020">L1020</a> ; forward, if so, to S-PUSH-PO 4644 4645 JR NC,<A href="#L0FFF">L0FFF</a> ; back with anything higher to S-RPT-C 4646 4647 ; else is a function 'CODE' thru 'CHR$' 4648 4649 LD B,$10 ; priority sixteen binds all functions to 4650 ; arguments removing the need for brackets. 4651 4652 ADD A,$D9 ; add $D9 to give range $D9 thru $EB 4653 ; bit 6 is set to show numeric argument. 4654 ; bit 7 is set to show numeric result. 4655 4656 ; now adjust these default argument/result indicators. 4657 4658 LD C,A ; save code in C 4659 4660 CP $DC ; separate 'CODE', 'VAL', 'LEN' 4661 JR NC,<A href="#L101A">L101A</a> ; skip forward if string operand to S-NO-TO-$ 4662 4663 RES 6,C ; signal string operand. 4664 4665 <a name="L101A"></a>;; <b>S-NO-TO-$</b> 4666 L101A: CP $EA ; isolate top of range 'STR$' and 'CHR$' 4667 JR C,<A href="#L1020">L1020</a> ; skip forward with others to S-PUSH-PO 4668 4669 RES 7,C ; signal string result. 4670 4671 <a name="L1020"></a>;; <b>S-PUSH-PO</b> 4672 L1020: PUSH BC ; push the priority/operation 4673 4674 RST 20H ; NEXT-CHAR 4675 JP <A href="#L0F59">L0F59</a> ; jump back to S-LOOP-1 4676 4677 ; --- 4678 4679 <a name="L1025"></a>;; <b>S-LTR-DGT</b> 4680 L1025: CP $26 ; compare to 'A'. 4681 JR C,<A href="#L1047">L1047</a> ; forward if less to S-DECIMAL 4682 4683 CALL <A href="#L111C">L111C</a> ; routine LOOK-VARS 4684 JP C,<A href="#L0D4B">L0D4B</a> ; back if not found to REPORT-2 4685 ; a variable is always 'found' when checking 4686 ; syntax. 4687 4688 CALL Z,<A href="#L11A7">L11A7</a> ; routine STK-VAR stacks string parameters or 4689 ; returns cell location if numeric. 4690 4691 LD A,($4001) ; fetch FLAGS 4692 CP $C0 ; compare to numeric result/numeric operand 4693 JR C,<A href="#L1087">L1087</a> ; forward if not numeric to S-CONT-2 4694 4695 INC HL ; address numeric contents of variable. 4696 LD DE,($401C) ; set destination to STKEND 4697 CALL <A href="#L19F6">L19F6</a> ; routine MOVE-FP stacks the five bytes 4698 EX DE,HL ; transfer new free location from DE to HL. 4699 LD ($401C),HL ; update STKEND system variable. 4700 JR <A href="#L1087">L1087</a> ; forward to S-CONT-2 4701 4702 ; --- 4703 4704 ; The Scanning Decimal routine is invoked when a decimal point or digit is 4705 ; found in the expression. 4706 ; When checking syntax, then the 'hidden floating point' form is placed 4707 ; after the number in the BASIC line. 4708 ; In run-time, the digits are skipped and the floating point number is picked 4709 ; up. 4710 4711 <a name="L1047"></a>;; <b>S-DECIMAL</b> 4712 L1047: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 4713 JR NZ,<A href="#L106F">L106F</a> ; forward in run-time to S-STK-DEC 4714 4715 CALL <A href="#L14D9">L14D9</a> ; routine DEC-TO-FP 4716 4717 RST 18H ; GET-CHAR advances HL past digits 4718 LD BC,$0006 ; six locations are required. 4719 CALL <A href="#L099E">L099E</a> ; routine MAKE-ROOM 4720 INC HL ; point to first new location 4721 LD (HL),$7E ; insert the number marker 126 decimal. 4722 INC HL ; increment 4723 EX DE,HL ; transfer destination to DE. 4724 LD HL,($401C) ; set HL from STKEND which points to the 4725 ; first location after the 'last value' 4726 LD C,$05 ; five bytes to move. 4727 AND A ; clear carry. 4728 SBC HL,BC ; subtract five pointing to 'last value'. 4729 LD ($401C),HL ; update STKEND thereby 'deleting the value. 4730 4731 LDIR ; copy the five value bytes. 4732 4733 EX DE,HL ; basic pointer to HL which may be white-space 4734 ; following the number. 4735 DEC HL ; now points to last of five bytes. 4736 CALL <A href="#L004C">L004C</a> ; routine TEMP-PTR1 advances the character 4737 ; address skipping any white-space. 4738 JR <A href="#L1083">L1083</a> ; forward to S-NUMERIC 4739 ; to signal a numeric result. 4740 4741 ; --- 4742 4743 ; In run-time the branch is here when a digit or point is encountered. 4744 4745 <a name="L106F"></a>;; <b>S-STK-DEC</b> 4746 L106F: RST 20H ; NEXT-CHAR 4747 CP $7E ; compare to 'number marker' 4748 JR NZ,<A href="#L106F">L106F</a> ; loop back until found to S-STK-DEC 4749 ; skipping all the digits. 4750 4751 INC HL ; point to first of five hidden bytes. 4752 LD DE,($401C) ; set destination from STKEND system variable 4753 CALL <A href="#L19F6">L19F6</a> ; routine MOVE-FP stacks the number. 4754 LD ($401C),DE ; update system variable STKEND. 4755 LD ($4016),HL ; update system variable CH_ADD. 4756 4757 <a name="L1083"></a>;; <b>S-NUMERIC</b> 4758 L1083: SET 6,(IY+$01) ; update FLAGS - Signal numeric result 4759 4760 <a name="L1087"></a>;; <b>S-CONT-2</b> 4761 L1087: RST 18H ; GET-CHAR 4762 4763 <a name="L1088"></a>;; <b>S-CONT-3</b> 4764 L1088: CP $10 ; compare to opening bracket '(' 4765 JR NZ,<A href="#L1098">L1098</a> ; forward if not to S-OPERTR 4766 4767 BIT 6,(IY+$01) ; test FLAGS - Numeric or string result? 4768 JR NZ,<A href="#L10BC">L10BC</a> ; forward if numeric to S-LOOP 4769 4770 ; else is a string 4771 4772 CALL <A href="#L1263">L1263</a> ; routine SLICING 4773 4774 RST 20H ; NEXT-CHAR 4775 JR <A href="#L1088">L1088</a> ; back to S-CONT-3 4776 4777 ; --- 4778 4779 ; the character is now manipulated to form an equivalent in the table of 4780 ; calculator literals. This is quite cumbersome and in the ZX Spectrum a 4781 ; simple look-up table was introduced at this point. 4782 4783 <a name="L1098"></a>;; <b>S-OPERTR</b> 4784 L1098: LD BC,$00C3 ; prepare operator 'subtract' as default. 4785 ; also set B to zero for later indexing. 4786 4787 CP $12 ; is character '>' ? 4788 JR C,<A href="#L10BC">L10BC</a> ; forward if less to S-LOOP as 4789 ; we have reached end of meaningful expression 4790 4791 SUB $16 ; is character '-' ? 4792 JR NC,<A href="#L10A7">L10A7</a> ; forward with - * / and '**' '<>' to SUBMLTDIV 4793 4794 ADD A,$0D ; increase others by thirteen 4795 ; $09 '>' thru $0C '+' 4796 JR <A href="#L10B5">L10B5</a> ; forward to GET-PRIO 4797 4798 ; --- 4799 4800 <a name="L10A7"></a>;; <b>SUBMLTDIV</b> 4801 L10A7: CP $03 ; isolate $00 '-', $01 '*', $02 '/' 4802 JR C,<A href="#L10B5">L10B5</a> ; forward if so to GET-PRIO 4803 4804 ; else possibly originally $D8 '**' thru $DD '<>' already reduced by $16 4805 4806 SUB $C2 ; giving range $00 to $05 4807 JR C,<A href="#L10BC">L10BC</a> ; forward if less to S-LOOP 4808 4809 CP $06 ; test the upper limit for nonsense also 4810 JR NC,<A href="#L10BC">L10BC</a> ; forward if so to S-LOOP 4811 4812 ADD A,$03 ; increase by 3 to give combined operators of 4813 4814 ; $00 '-' 4815 ; $01 '*' 4816 ; $02 '/' 4817 4818 ; $03 '**' 4819 ; $04 'OR' 4820 ; $05 'AND' 4821 ; $06 '<=' 4822 ; $07 '>=' 4823 ; $08 '<>' 4824 4825 ; $09 '>' 4826 ; $0A '<' 4827 ; $0B '=' 4828 ; $0C '+' 4829 4830 <a name="L10B5"></a>;; <b>GET-PRIO</b> 4831 L10B5: ADD A,C ; add to default operation 'sub' ($C3) 4832 LD C,A ; and place in operator byte - C. 4833 4834 LD HL,<A href="#L110F">L110F</a> - $C3 ; theoretical base of the priorities table. 4835 ADD HL,BC ; add C ( B is zero) 4836 LD B,(HL) ; pick up the priority in B 4837 4838 <a name="L10BC"></a>;; <b>S-LOOP</b> 4839 L10BC: POP DE ; restore previous 4840 LD A,D ; load A with priority. 4841 CP B ; is present priority higher 4842 JR C,<A href="#L10ED">L10ED</a> ; forward if so to S-TIGHTER 4843 4844 AND A ; are both priorities zero 4845 JP Z,<A href="#L0018">L0018</a> ; exit if zero via GET-CHAR 4846 4847 PUSH BC ; stack present values 4848 PUSH DE ; stack last values 4849 CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 4850 JR Z,<A href="#L10D5">L10D5</a> ; forward is checking syntax to S-SYNTEST 4851 4852 LD A,E ; fetch last operation 4853 AND $3F ; mask off the indicator bits to give true 4854 ; calculator literal. 4855 LD B,A ; place in the B register for BREG 4856 4857 ; perform the single operation 4858 4859 RST 28H ;; FP-CALC 4860 DEFB $37 ;;fp-calc-2 4861 DEFB $34 ;;end-calc 4862 4863 JR <A href="#L10DE">L10DE</a> ; forward to S-RUNTEST 4864 4865 ; --- 4866 4867 <a name="L10D5"></a>;; <b>S-SYNTEST</b> 4868 L10D5: LD A,E ; transfer masked operator to A 4869 XOR (IY+$01) ; XOR with FLAGS like results will reset bit 6 4870 AND $40 ; test bit 6 4871 4872 <a name="L10DB"></a>;; <b>S-RPORT-C</b> 4873 L10DB: JP NZ,<A href="#L0D9A">L0D9A</a> ; back to REPORT-C if results do not agree. 4874 4875 ; --- 4876 4877 ; in run-time impose bit 7 of the operator onto bit 6 of the FLAGS 4878 4879 <a name="L10DE"></a>;; <b>S-RUNTEST</b> 4880 L10DE: POP DE ; restore last operation. 4881 LD HL,$4001 ; address system variable FLAGS 4882 SET 6,(HL) ; presume a numeric result 4883 BIT 7,E ; test expected result in operation 4884 JR NZ,<A href="#L10EA">L10EA</a> ; forward if numeric to S-LOOPEND 4885 4886 RES 6,(HL) ; reset to signal string result 4887 4888 <a name="L10EA"></a>;; <b>S-LOOPEND</b> 4889 L10EA: POP BC ; restore present values 4890 JR <A href="#L10BC">L10BC</a> ; back to S-LOOP 4891 4892 ; --- 4893 4894 <a name="L10ED"></a>;; <b>S-TIGHTER</b> 4895 L10ED: PUSH DE ; push last values and consider these 4896 4897 LD A,C ; get the present operator. 4898 BIT 6,(IY+$01) ; test FLAGS - Numeric or string result? 4899 JR NZ,<A href="#L110A">L110A</a> ; forward if numeric to S-NEXT 4900 4901 AND $3F ; strip indicator bits to give clear literal. 4902 ADD A,$08 ; add eight - augmenting numeric to equivalent 4903 ; string literals. 4904 LD C,A ; place plain literal back in C. 4905 CP $10 ; compare to 'AND' 4906 JR NZ,<A href="#L1102">L1102</a> ; forward if not to S-NOT-AND 4907 4908 SET 6,C ; set the numeric operand required for 'AND' 4909 JR <A href="#L110A">L110A</a> ; forward to S-NEXT 4910 4911 ; --- 4912 4913 <a name="L1102"></a>;; <b>S-NOT-AND</b> 4914 L1102: JR C,<A href="#L10DB">L10DB</a> ; back if less than 'AND' to S-RPORT-C 4915 ; Nonsense if '-', '*' etc. 4916 4917 CP $17 ; compare to 'strs-add' literal 4918 JR Z,<A href="#L110A">L110A</a> ; forward if so signaling string result 4919 4920 SET 7,C ; set bit to numeric (Boolean) for others. 4921 4922 <a name="L110A"></a>;; <b>S-NEXT</b> 4923 L110A: PUSH BC ; stack 'present' values 4924 4925 RST 20H ; NEXT-CHAR 4926 JP <A href="#L0F59">L0F59</a> ; jump back to S-LOOP-1 4927 4928 4929 4930 ; ------------------------- 4931 ; THE <b><font color=#333388>'TABLE OF PRIORITIES'</font></b> 4932 ; ------------------------- 4933 ; 4934 ; 4935 4936 <a name="L110F"></a>;; <b>tbl-pri</b> 4937 L110F: DEFB $06 ; '-' 4938 DEFB $08 ; '*' 4939 DEFB $08 ; '/' 4940 DEFB $0A ; '**' 4941 DEFB $02 ; 'OR' 4942 DEFB $03 ; 'AND' 4943 DEFB $05 ; '<=' 4944 DEFB $05 ; '>=' 4945 DEFB $05 ; '<>' 4946 DEFB $05 ; '>' 4947 DEFB $05 ; '<' 4948 DEFB $05 ; '=' 4949 DEFB $06 ; '+' 4950 4951 4952 ; -------------------------- 4953 ; THE <b><font color=#333388>'LOOK-VARS'</font></b> SUBROUTINE 4954 ; -------------------------- 4955 ; 4956 ; 4957 4958 <a name="L111C"></a>;; <b>LOOK-VARS</b> 4959 L111C: SET 6,(IY+$01) ; sv FLAGS - Signal numeric result 4960 4961 RST 18H ; GET-CHAR 4962 CALL <A href="#L14CE">L14CE</a> ; routine ALPHA 4963 JP NC,<A href="#L0D9A">L0D9A</a> ; to REPORT-C 4964 4965 PUSH HL ; 4966 LD C,A ; 4967 4968 RST 20H ; NEXT-CHAR 4969 PUSH HL ; 4970 RES 5,C ; 4971 CP $10 ; 4972 JR Z,<A href="#L1148">L1148</a> ; to V-SYN/RUN 4973 4974 SET 6,C ; 4975 CP $0D ; 4976 JR Z,<A href="#L1143">L1143</a> ; forward to V-STR-VAR 4977 4978 SET 5,C ; 4979 4980 <a name="L1139"></a>;; <b>V-CHAR</b> 4981 L1139: CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM 4982 JR NC,<A href="#L1148">L1148</a> ; forward when not to V-RUN/SYN 4983 4984 RES 6,C ; 4985 4986 RST 20H ; NEXT-CHAR 4987 JR <A href="#L1139">L1139</a> ; loop back to V-CHAR 4988 4989 ; --- 4990 4991 <a name="L1143"></a>;; <b>V-STR-VAR</b> 4992 L1143: RST 20H ; NEXT-CHAR 4993 RES 6,(IY+$01) ; sv FLAGS - Signal string result 4994 4995 <a name="L1148"></a>;; <b>V-RUN/SYN</b> 4996 L1148: LD B,C ; 4997 CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 4998 JR NZ,<A href="#L1156">L1156</a> ; forward to V-RUN 4999 5000 LD A,C ; 5001 AND $E0 ; 5002 SET 7,A ; 5003 LD C,A ; 5004 JR <A href="#L118A">L118A</a> ; forward to V-SYNTAX 5005 5006 ; --- 5007 5008 <a name="L1156"></a>;; <b>V-RUN</b> 5009 L1156: LD HL,($4010) ; sv VARS 5010 5011 <a name="L1159"></a>;; <b>V-EACH</b> 5012 L1159: LD A,(HL) ; 5013 AND $7F ; 5014 JR Z,<A href="#L1188">L1188</a> ; to V-80-BYTE 5015 5016 CP C ; 5017 JR NZ,<A href="#L1180">L1180</a> ; to V-NEXT 5018 5019 RLA ; 5020 ADD A,A ; 5021 JP P,<A href="#L1195">L1195</a> ; to V-FOUND-2 5022 5023 JR C,<A href="#L1195">L1195</a> ; to V-FOUND-2 5024 5025 POP DE ; 5026 PUSH DE ; 5027 PUSH HL ; 5028 5029 <a name="L116B"></a>;; <b>V-MATCHES</b> 5030 L116B: INC HL ; 5031 5032 <a name="L116C"></a>;; <b>V-SPACES</b> 5033 L116C: LD A,(DE) ; 5034 INC DE ; 5035 AND A ; 5036 JR Z,<A href="#L116C">L116C</a> ; back to V-SPACES 5037 5038 CP (HL) ; 5039 JR Z,<A href="#L116B">L116B</a> ; back to V-MATCHES 5040 5041 OR $80 ; 5042 CP (HL) ; 5043 JR NZ,<A href="#L117F">L117F</a> ; forward to V-GET-PTR 5044 5045 LD A,(DE) ; 5046 CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM 5047 JR NC,<A href="#L1194">L1194</a> ; forward to V-FOUND-1 5048 5049 <a name="L117F"></a>;; <b>V-GET-PTR</b> 5050 L117F: POP HL ; 5051 5052 <a name="L1180"></a>;; <b>V-NEXT</b> 5053 L1180: PUSH BC ; 5054 CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE 5055 EX DE,HL ; 5056 POP BC ; 5057 JR <A href="#L1159">L1159</a> ; back to V-EACH 5058 5059 ; --- 5060 5061 <a name="L1188"></a>;; <b>V-80-BYTE</b> 5062 L1188: SET 7,B ; 5063 5064 <a name="L118A"></a>;; <b>V-SYNTAX</b> 5065 L118A: POP DE ; 5066 5067 RST 18H ; GET-CHAR 5068 CP $10 ; 5069 JR Z,<A href="#L1199">L1199</a> ; forward to V-PASS 5070 5071 SET 5,B ; 5072 JR <A href="#L11A1">L11A1</a> ; forward to V-END 5073 5074 ; --- 5075 5076 <a name="L1194"></a>;; <b>V-FOUND-1</b> 5077 L1194: POP DE ; 5078 5079 <a name="L1195"></a>;; <b>V-FOUND-2</b> 5080 L1195: POP DE ; 5081 POP DE ; 5082 PUSH HL ; 5083 5084 RST 18H ; GET-CHAR 5085 5086 <a name="L1199"></a>;; <b>V-PASS</b> 5087 L1199: CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM 5088 JR NC,<A href="#L11A1">L11A1</a> ; forward if not alphanumeric to V-END 5089 5090 5091 RST 20H ; NEXT-CHAR 5092 JR <A href="#L1199">L1199</a> ; back to V-PASS 5093 5094 ; --- 5095 5096 <a name="L11A1"></a>;; <b>V-END</b> 5097 L11A1: POP HL ; 5098 RL B ; 5099 BIT 6,B ; 5100 RET ; 5101 5102 ; ------------------------ 5103 ; THE <b><font color=#333388>'STK-VAR'</font></b> SUBROUTINE 5104 ; ------------------------ 5105 ; 5106 ; 5107 5108 <a name="L11A7"></a>;; <b>STK-VAR</b> 5109 L11A7: XOR A ; 5110 LD B,A ; 5111 BIT 7,C ; 5112 JR NZ,<A href="#L11F8">L11F8</a> ; forward to SV-COUNT 5113 5114 BIT 7,(HL) ; 5115 JR NZ,<A href="#L11BF">L11BF</a> ; forward to SV-ARRAYS 5116 5117 INC A ; 5118 5119 <a name="L11B2"></a>;; <b>SV-SIMPLE$</b> 5120 L11B2: INC HL ; 5121 LD C,(HL) ; 5122 INC HL ; 5123 LD B,(HL) ; 5124 INC HL ; 5125 EX DE,HL ; 5126 CALL <A href="#L12C3">L12C3</a> ; routine STK-STO-$ 5127 5128 RST 18H ; GET-CHAR 5129 JP <A href="#L125A">L125A</a> ; jump forward to SV-SLICE? 5130 5131 ; --- 5132 5133 <a name="L11BF"></a>;; <b>SV-ARRAYS</b> 5134 L11BF: INC HL ; 5135 INC HL ; 5136 INC HL ; 5137 LD B,(HL) ; 5138 BIT 6,C ; 5139 JR Z,<A href="#L11D1">L11D1</a> ; forward to SV-PTR 5140 5141 DEC B ; 5142 JR Z,<A href="#L11B2">L11B2</a> ; forward to SV-SIMPLE$ 5143 5144 EX DE,HL ; 5145 5146 RST 18H ; GET-CHAR 5147 CP $10 ; 5148 JR NZ,<A href="#L1231">L1231</a> ; forward to REPORT-3 5149 5150 EX DE,HL ; 5151 5152 <a name="L11D1"></a>;; <b>SV-PTR</b> 5153 L11D1: EX DE,HL ; 5154 JR <A href="#L11F8">L11F8</a> ; forward to SV-COUNT 5155 5156 ; --- 5157 5158 <a name="L11D4"></a>;; <b>SV-COMMA</b> 5159 L11D4: PUSH HL ; 5160 5161 RST 18H ; GET-CHAR 5162 POP HL ; 5163 CP $1A ; 5164 JR Z,<A href="#L11FB">L11FB</a> ; forward to SV-LOOP 5165 5166 BIT 7,C ; 5167 JR Z,<A href="#L1231">L1231</a> ; forward to REPORT-3 5168 5169 BIT 6,C ; 5170 JR NZ,<A href="#L11E9">L11E9</a> ; forward to SV-CLOSE 5171 5172 CP $11 ; 5173 JR NZ,<A href="#L1223">L1223</a> ; forward to SV-RPT-C 5174 5175 5176 RST 20H ; NEXT-CHAR 5177 RET ; 5178 5179 ; --- 5180 5181 <a name="L11E9"></a>;; <b>SV-CLOSE</b> 5182 L11E9: CP $11 ; 5183 JR Z,<A href="#L1259">L1259</a> ; forward to SV-DIM 5184 5185 CP $DF ; 5186 JR NZ,<A href="#L1223">L1223</a> ; forward to SV-RPT-C 5187 5188 5189 <a name="L11F1"></a>;; <b>SV-CH-ADD</b> 5190 L11F1: RST 18H ; GET-CHAR 5191 DEC HL ; 5192 LD ($4016),HL ; sv CH_ADD 5193 JR <A href="#L1256">L1256</a> ; forward to SV-SLICE 5194 5195 ; --- 5196 5197 <a name="L11F8"></a>;; <b>SV-COUNT</b> 5198 L11F8: LD HL,$0000 ; 5199 5200 <a name="L11FB"></a>;; <b>SV-LOOP</b> 5201 L11FB: PUSH HL ; 5202 5203 RST 20H ; NEXT-CHAR 5204 POP HL ; 5205 LD A,C ; 5206 CP $C0 ; 5207 JR NZ,<A href="#L120C">L120C</a> ; forward to SV-MULT 5208 5209 5210 RST 18H ; GET-CHAR 5211 CP $11 ; 5212 JR Z,<A href="#L1259">L1259</a> ; forward to SV-DIM 5213 5214 CP $DF ; 5215 JR Z,<A href="#L11F1">L11F1</a> ; back to SV-CH-ADD 5216 5217 <a name="L120C"></a>;; <b>SV-MULT</b> 5218 L120C: PUSH BC ; 5219 PUSH HL ; 5220 CALL <A href="#L12FF">L12FF</a> ; routine DE,(DE+1) 5221 EX (SP),HL ; 5222 EX DE,HL ; 5223 CALL <A href="#L12DD">L12DD</a> ; routine INT-EXP1 5224 JR C,<A href="#L1231">L1231</a> ; forward to REPORT-3 5225 5226 DEC BC ; 5227 CALL <A href="#L1305">L1305</a> ; routine GET-HL*DE 5228 ADD HL,BC ; 5229 POP DE ; 5230 POP BC ; 5231 DJNZ <A href="#L11D4">L11D4</a> ; loop back to SV-COMMA 5232 5233 BIT 7,C ; 5234 5235 <a name="L1223"></a>;; <b>SV-RPT-C</b> 5236 L1223: JR NZ,<A href="#L128B">L128B</a> ; relative jump to SL-RPT-C 5237 5238 PUSH HL ; 5239 BIT 6,C ; 5240 JR NZ,<A href="#L123D">L123D</a> ; forward to SV-ELEM$ 5241 5242 LD B,D ; 5243 LD C,E ; 5244 5245 RST 18H ; GET-CHAR 5246 CP $11 ; is character a ')' ? 5247 JR Z,<A href="#L1233">L1233</a> ; skip forward to SV-NUMBER 5248 5249 5250 <a name="L1231"></a>;; <b>REPORT-3</b> 5251 L1231: RST 08H ; ERROR-1 5252 DEFB $02 ; Error Report: Subscript wrong 5253 5254 5255 <a name="L1233"></a>;; <b>SV-NUMBER</b> 5256 L1233: RST 20H ; NEXT-CHAR 5257 POP HL ; 5258 LD DE,$0005 ; 5259 CALL <A href="#L1305">L1305</a> ; routine GET-HL*DE 5260 ADD HL,BC ; 5261 RET ; return >> 5262 5263 ; --- 5264 5265 <a name="L123D"></a>;; <b>SV-ELEM$</b> 5266 L123D: CALL <A href="#L12FF">L12FF</a> ; routine DE,(DE+1) 5267 EX (SP),HL ; 5268 CALL <A href="#L1305">L1305</a> ; routine GET-HL*DE 5269 POP BC ; 5270 ADD HL,BC ; 5271 INC HL ; 5272 LD B,D ; 5273 LD C,E ; 5274 EX DE,HL ; 5275 CALL <A href="#L12C2">L12C2</a> ; routine STK-ST-0 5276 5277 RST 18H ; GET-CHAR 5278 CP $11 ; is it ')' ? 5279 JR Z,<A href="#L1259">L1259</a> ; forward if so to SV-DIM 5280 5281 CP $1A ; is it ',' ? 5282 JR NZ,<A href="#L1231">L1231</a> ; back if not to REPORT-3 5283 5284 <a name="L1256"></a>;; <b>SV-SLICE</b> 5285 L1256: CALL <A href="#L1263">L1263</a> ; routine SLICING 5286 5287 <a name="L1259"></a>;; <b>SV-DIM</b> 5288 L1259: RST 20H ; NEXT-CHAR 5289 5290 <a name="L125A"></a>;; <b>SV-SLICE?</b> 5291 L125A: CP $10 ; 5292 JR Z,<A href="#L1256">L1256</a> ; back to SV-SLICE 5293 5294 RES 6,(IY+$01) ; sv FLAGS - Signal string result 5295 RET ; return. 5296 5297 ; ------------------------ 5298 ; THE <b><font color=#333388>'SLICING'</font></b> SUBROUTINE 5299 ; ------------------------ 5300 ; 5301 ; 5302 5303 <a name="L1263"></a>;; <b>SLICING</b> 5304 L1263: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 5305 CALL NZ,<A href="#L13F8">L13F8</a> ; routine STK-FETCH 5306 5307 RST 20H ; NEXT-CHAR 5308 CP $11 ; is it ')' ? 5309 JR Z,<A href="#L12BE">L12BE</a> ; forward if so to SL-STORE 5310 5311 PUSH DE ; 5312 XOR A ; 5313 PUSH AF ; 5314 PUSH BC ; 5315 LD DE,$0001 ; 5316 5317 RST 18H ; GET-CHAR 5318 POP HL ; 5319 CP $DF ; is it 'TO' ? 5320 JR Z,<A href="#L1292">L1292</a> ; forward if so to SL-SECOND 5321 5322 POP AF ; 5323 CALL <A href="#L12DE">L12DE</a> ; routine INT-EXP2 5324 PUSH AF ; 5325 LD D,B ; 5326 LD E,C ; 5327 PUSH HL ; 5328 5329 RST 18H ; GET-CHAR 5330 POP HL ; 5331 CP $DF ; is it 'TO' ? 5332 JR Z,<A href="#L1292">L1292</a> ; forward if so to SL-SECOND 5333 5334 CP $11 ; 5335 5336 <a name="L128B"></a>;; <b>SL-RPT-C</b> 5337 L128B: JP NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C 5338 5339 LD H,D ; 5340 LD L,E ; 5341 JR <A href="#L12A5">L12A5</a> ; forward to SL-DEFINE 5342 5343 ; --- 5344 5345 <a name="L1292"></a>;; <b>SL-SECOND</b> 5346 L1292: PUSH HL ; 5347 5348 RST 20H ; NEXT-CHAR 5349 POP HL ; 5350 CP $11 ; is it ')' ? 5351 JR Z,<A href="#L12A5">L12A5</a> ; forward if so to SL-DEFINE 5352 5353 POP AF ; 5354 CALL <A href="#L12DE">L12DE</a> ; routine INT-EXP2 5355 PUSH AF ; 5356 5357 RST 18H ; GET-CHAR 5358 LD H,B ; 5359 LD L,C ; 5360 CP $11 ; is it ')' ? 5361 JR NZ,<A href="#L128B">L128B</a> ; back if not to SL-RPT-C 5362 5363 <a name="L12A5"></a>;; <b>SL-DEFINE</b> 5364 L12A5: POP AF ; 5365 EX (SP),HL ; 5366 ADD HL,DE ; 5367 DEC HL ; 5368 EX (SP),HL ; 5369 AND A ; 5370 SBC HL,DE ; 5371 LD BC,$0000 ; 5372 JR C,<A href="#L12B9">L12B9</a> ; forward to SL-OVER 5373 5374 INC HL ; 5375 AND A ; 5376 JP M,<A href="#L1231">L1231</a> ; jump back to REPORT-3 5377 5378 LD B,H ; 5379 LD C,L ; 5380 5381 <a name="L12B9"></a>;; <b>SL-OVER</b> 5382 L12B9: POP DE ; 5383 RES 6,(IY+$01) ; sv FLAGS - Signal string result 5384 5385 <a name="L12BE"></a>;; <b>SL-STORE</b> 5386 L12BE: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 5387 RET Z ; return if checking syntax. 5388 5389 ; -------------------------- 5390 ; THE <b><font color=#333388>'STK-STORE'</font></b> SUBROUTINE 5391 ; -------------------------- 5392 ; 5393 ; 5394 5395 <a name="L12C2"></a>;; <b>STK-ST-0</b> 5396 L12C2: XOR A ; 5397 5398 <a name="L12C3"></a>;; <b>STK-STO-$</b> 5399 L12C3: PUSH BC ; 5400 CALL <A href="#L19EB">L19EB</a> ; routine TEST-5-SP 5401 POP BC ; 5402 LD HL,($401C) ; sv STKEND 5403 LD (HL),A ; 5404 INC HL ; 5405 LD (HL),E ; 5406 INC HL ; 5407 LD (HL),D ; 5408 INC HL ; 5409 LD (HL),C ; 5410 INC HL ; 5411 LD (HL),B ; 5412 INC HL ; 5413 LD ($401C),HL ; sv STKEND 5414 RES 6,(IY+$01) ; update FLAGS - signal string result 5415 RET ; return. 5416 5417 ; ------------------------- 5418 ; THE <b><font color=#333388>'INT EXP'</font></b> SUBROUTINES 5419 ; ------------------------- 5420 ; 5421 ; 5422 5423 <a name="L12DD"></a>;; <b>INT-EXP1</b> 5424 L12DD: XOR A ; 5425 5426 <a name="L12DE"></a>;; <b>INT-EXP2</b> 5427 L12DE: PUSH DE ; 5428 PUSH HL ; 5429 PUSH AF ; 5430 CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6 5431 POP AF ; 5432 CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 5433 JR Z,<A href="#L12FC">L12FC</a> ; forward if checking syntax to I-RESTORE 5434 5435 PUSH AF ; 5436 CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT 5437 POP DE ; 5438 LD A,B ; 5439 OR C ; 5440 SCF ; Set Carry Flag 5441 JR Z,<A href="#L12F9">L12F9</a> ; forward to I-CARRY 5442 5443 POP HL ; 5444 PUSH HL ; 5445 AND A ; 5446 SBC HL,BC ; 5447 5448 <a name="L12F9"></a>;; <b>I-CARRY</b> 5449 L12F9: LD A,D ; 5450 SBC A,$00 ; 5451 5452 <a name="L12FC"></a>;; <b>I-RESTORE</b> 5453 L12FC: POP HL ; 5454 POP DE ; 5455 RET ; 5456 5457 ; -------------------------- 5458 ; THE <b><font color=#333388>'DE,(DE+1)'</font></b> SUBROUTINE 5459 ; -------------------------- 5460 ; INDEX and LOAD Z80 subroutine. 5461 ; This emulates the 6800 processor instruction LDX 1,X which loads a two-byte 5462 ; value from memory into the register indexing it. Often these are hardly worth 5463 ; the bother of writing as subroutines and this one doesn't save any time or 5464 ; memory. The timing and space overheads have to be offset against the ease of 5465 ; writing and the greater program readability from using such toolkit routines. 5466 5467 <a name="L12FF"></a>;; <b>DE,(DE+1)</b> 5468 L12FF: EX DE,HL ; move index address into HL. 5469 INC HL ; increment to address word. 5470 LD E,(HL) ; pick up word low-order byte. 5471 INC HL ; index high-order byte and 5472 LD D,(HL) ; pick it up. 5473 RET ; return with DE = word. 5474 5475 ; -------------------------- 5476 ; THE <b><font color=#333388>'GET-HL*DE'</font></b> SUBROUTINE 5477 ; -------------------------- 5478 ; 5479 5480 <a name="L1305"></a>;; <b>GET-HL*DE</b> 5481 L1305: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 5482 RET Z ; 5483 5484 PUSH BC ; 5485 LD B,$10 ; 5486 LD A,H ; 5487 LD C,L ; 5488 LD HL,$0000 ; 5489 5490 <a name="L1311"></a>;; <b>HL-LOOP</b> 5491 L1311: ADD HL,HL ; 5492 JR C,<A href="#L131A">L131A</a> ; forward with carry to HL-END 5493 5494 RL C ; 5495 RLA ; 5496 JR NC,<A href="#L131D">L131D</a> ; forward with no carry to HL-AGAIN 5497 5498 ADD HL,DE ; 5499 5500 <a name="L131A"></a>;; <b>HL-END</b> 5501 L131A: JP C,<A href="#L0ED3">L0ED3</a> ; to REPORT-4 5502 5503 <a name="L131D"></a>;; <b>HL-AGAIN</b> 5504 L131D: DJNZ <A href="#L1311">L1311</a> ; loop back to HL-LOOP 5505 5506 POP BC ; 5507 RET ; return. 5508 5509 ; -------------------- 5510 ; THE <b><font color=#333388>'LET'</font></b> SUBROUTINE 5511 ; -------------------- 5512 ; 5513 ; 5514 5515 <a name="L1321"></a>;; <b>LET</b> 5516 L1321: LD HL,($4012) ; sv DEST-lo 5517 BIT 1,(IY+$2D) ; sv FLAGX 5518 JR Z,<A href="#L136E">L136E</a> ; forward to L-EXISTS 5519 5520 LD BC,$0005 ; 5521 5522 <a name="L132D"></a>;; <b>L-EACH-CH</b> 5523 L132D: INC BC ; 5524 5525 ; check 5526 5527 <a name="L132E"></a>;; <b>L-NO-SP</b> 5528 L132E: INC HL ; 5529 LD A,(HL) ; 5530 AND A ; 5531 JR Z,<A href="#L132E">L132E</a> ; back to L-NO-SP 5532 5533 CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM 5534 JR C,<A href="#L132D">L132D</a> ; back to L-EACH-CH 5535 5536 CP $0D ; is it '$' ? 5537 JP Z,<A href="#L13C8">L13C8</a> ; forward if so to L-NEW$ 5538 5539 5540 RST 30H ; BC-SPACES 5541 PUSH DE ; 5542 LD HL,($4012) ; sv DEST 5543 DEC DE ; 5544 LD A,C ; 5545 SUB $06 ; 5546 LD B,A ; 5547 LD A,$40 ; 5548 JR Z,<A href="#L1359">L1359</a> ; forward to L-SINGLE 5549 5550 <a name="L134B"></a>;; <b>L-CHAR</b> 5551 L134B: INC HL ; 5552 LD A,(HL) ; 5553 AND A ; is it a space ? 5554 JR Z,<A href="#L134B">L134B</a> ; back to L-CHAR 5555 5556 INC DE ; 5557 LD (DE),A ; 5558 DJNZ <A href="#L134B">L134B</a> ; loop back to L-CHAR 5559 5560 OR $80 ; 5561 LD (DE),A ; 5562 LD A,$80 ; 5563 5564 <a name="L1359"></a>;; <b>L-SINGLE</b> 5565 L1359: LD HL,($4012) ; sv DEST-lo 5566 XOR (HL) ; 5567 POP HL ; 5568 CALL <A href="#L13E7">L13E7</a> ; routine L-FIRST 5569 5570 <a name="L1361"></a>;; <b>L-NUMERIC</b> 5571 L1361: PUSH HL ; 5572 5573 RST 28H ;; FP-CALC 5574 DEFB $02 ;;delete 5575 DEFB $34 ;;end-calc 5576 5577 POP HL ; 5578 LD BC,$0005 ; 5579 AND A ; 5580 SBC HL,BC ; 5581 JR <A href="#L13AE">L13AE</a> ; forward to L-ENTER 5582 5583 ; --- 5584 5585 <a name="L136E"></a>;; <b>L-EXISTS</b> 5586 L136E: BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? 5587 JR Z,<A href="#L137A">L137A</a> ; forward to L-DELETE$ 5588 5589 LD DE,$0006 ; 5590 ADD HL,DE ; 5591 JR <A href="#L1361">L1361</a> ; back to L-NUMERIC 5592 5593 ; --- 5594 5595 <a name="L137A"></a>;; <b>L-DELETE$</b> 5596 L137A: LD HL,($4012) ; sv DEST-lo 5597 LD BC,($402E) ; sv STRLEN_lo 5598 BIT 0,(IY+$2D) ; sv FLAGX 5599 JR NZ,<A href="#L13B7">L13B7</a> ; forward to L-ADD$ 5600 5601 LD A,B ; 5602 OR C ; 5603 RET Z ; 5604 5605 PUSH HL ; 5606 5607 RST 30H ; BC-SPACES 5608 PUSH DE ; 5609 PUSH BC ; 5610 LD D,H ; 5611 LD E,L ; 5612 INC HL ; 5613 LD (HL),$00 ; 5614 LDDR ; Copy Bytes 5615 PUSH HL ; 5616 CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH 5617 POP HL ; 5618 EX (SP),HL ; 5619 AND A ; 5620 SBC HL,BC ; 5621 ADD HL,BC ; 5622 JR NC,<A href="#L13A3">L13A3</a> ; forward to L-LENGTH 5623 5624 LD B,H ; 5625 LD C,L ; 5626 5627 <a name="L13A3"></a>;; <b>L-LENGTH</b> 5628 L13A3: EX (SP),HL ; 5629 EX DE,HL ; 5630 LD A,B ; 5631 OR C ; 5632 JR Z,<A href="#L13AB">L13AB</a> ; forward if zero to L-IN-W/S 5633 5634 LDIR ; Copy Bytes 5635 5636 <a name="L13AB"></a>;; <b>L-IN-W/S</b> 5637 L13AB: POP BC ; 5638 POP DE ; 5639 POP HL ; 5640 5641 ; ------------------------ 5642 ; THE <b><font color=#333388>'L-ENTER'</font></b> SUBROUTINE 5643 ; ------------------------ 5644 ; 5645 5646 <a name="L13AE"></a>;; <b>L-ENTER</b> 5647 L13AE: EX DE,HL ; 5648 LD A,B ; 5649 OR C ; 5650 RET Z ; 5651 5652 PUSH DE ; 5653 LDIR ; Copy Bytes 5654 POP HL ; 5655 RET ; return. 5656 5657 ; --- 5658 5659 <a name="L13B7"></a>;; <b>L-ADD$</b> 5660 L13B7: DEC HL ; 5661 DEC HL ; 5662 DEC HL ; 5663 LD A,(HL) ; 5664 PUSH HL ; 5665 PUSH BC ; 5666 5667 CALL <A href="#L13CE">L13CE</a> ; routine L-STRING 5668 5669 POP BC ; 5670 POP HL ; 5671 INC BC ; 5672 INC BC ; 5673 INC BC ; 5674 JP <A href="#L0A60">L0A60</a> ; jump back to exit via RECLAIM-2 5675 5676 ; --- 5677 5678 <a name="L13C8"></a>;; <b>L-NEW$</b> 5679 L13C8: LD A,$60 ; prepare mask %01100000 5680 LD HL,($4012) ; sv DEST-lo 5681 XOR (HL) ; 5682 5683 ; ------------------------- 5684 ; THE <b><font color=#333388>'L-STRING'</font></b> SUBROUTINE 5685 ; ------------------------- 5686 ; 5687 5688 <a name="L13CE"></a>;; <b>L-STRING</b> 5689 L13CE: PUSH AF ; 5690 CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH 5691 EX DE,HL ; 5692 ADD HL,BC ; 5693 PUSH HL ; 5694 INC BC ; 5695 INC BC ; 5696 INC BC ; 5697 5698 RST 30H ; BC-SPACES 5699 EX DE,HL ; 5700 POP HL ; 5701 DEC BC ; 5702 DEC BC ; 5703 PUSH BC ; 5704 LDDR ; Copy Bytes 5705 EX DE,HL ; 5706 POP BC ; 5707 DEC BC ; 5708 LD (HL),B ; 5709 DEC HL ; 5710 LD (HL),C ; 5711 POP AF ; 5712 5713 <a name="L13E7"></a>;; <b>L-FIRST</b> 5714 L13E7: PUSH AF ; 5715 CALL <A href="#L14C7">L14C7</a> ; routine REC-V80 5716 POP AF ; 5717 DEC HL ; 5718 LD (HL),A ; 5719 LD HL,($401A) ; sv STKBOT_lo 5720 LD ($4014),HL ; sv E_LINE_lo 5721 DEC HL ; 5722 LD (HL),$80 ; 5723 RET ; 5724 5725 ; -------------------------- 5726 ; THE <b><font color=#333388>'STK-FETCH'</font></b> SUBROUTINE 5727 ; -------------------------- 5728 ; This routine fetches a five-byte value from the calculator stack 5729 ; reducing the pointer to the end of the stack by five. 5730 ; For a floating-point number the exponent is in A and the mantissa 5731 ; is the thirty-two bits EDCB. 5732 ; For strings, the start of the string is in DE and the length in BC. 5733 ; A is unused. 5734 5735 <a name="L13F8"></a>;; <b>STK-FETCH</b> 5736 L13F8: LD HL,($401C) ; load HL from system variable STKEND 5737 5738 DEC HL ; 5739 LD B,(HL) ; 5740 DEC HL ; 5741 LD C,(HL) ; 5742 DEC HL ; 5743 LD D,(HL) ; 5744 DEC HL ; 5745 LD E,(HL) ; 5746 DEC HL ; 5747 LD A,(HL) ; 5748 5749 LD ($401C),HL ; set system variable STKEND to lower value. 5750 RET ; return. 5751 5752 ; ------------------------- 5753 ; THE <b><font color=#333388>'DIM'</font></b> COMMAND ROUTINE 5754 ; ------------------------- 5755 ; An array is created and initialized to zeros which is also the space 5756 ; character on the ZX81. 5757 5758 <a name="L1409"></a>;; <b>DIM</b> 5759 L1409: CALL <A href="#L111C">L111C</a> ; routine LOOK-VARS 5760 5761 <a name="L140C"></a>;; <b>D-RPORT-C</b> 5762 L140C: JP NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C 5763 5764 CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z 5765 JR NZ,<A href="#L141C">L141C</a> ; forward to D-RUN 5766 5767 RES 6,C ; 5768 CALL <A href="#L11A7">L11A7</a> ; routine STK-VAR 5769 CALL <A href="#L0D1D">L0D1D</a> ; routine CHECK-END 5770 5771 <a name="L141C"></a>;; <b>D-RUN</b> 5772 L141C: JR C,<A href="#L1426">L1426</a> ; forward to D-LETTER 5773 5774 PUSH BC ; 5775 CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE 5776 CALL <A href="#L0A60">L0A60</a> ; routine RECLAIM-2 5777 POP BC ; 5778 5779 <a name="L1426"></a>;; <b>D-LETTER</b> 5780 L1426: SET 7,C ; 5781 LD B,$00 ; 5782 PUSH BC ; 5783 LD HL,$0001 ; 5784 BIT 6,C ; 5785 JR NZ,<A href="#L1434">L1434</a> ; forward to D-SIZE 5786 5787 LD L,$05 ; 5788 5789 <a name="L1434"></a>;; <b>D-SIZE</b> 5790 L1434: EX DE,HL ; 5791 5792 <a name="L1435"></a>;; <b>D-NO-LOOP</b> 5793 L1435: RST 20H ; NEXT-CHAR 5794 LD H,$40 ; 5795 CALL <A href="#L12DD">L12DD</a> ; routine INT-EXP1 5796 JP C,<A href="#L1231">L1231</a> ; jump back to REPORT-3 5797 5798 POP HL ; 5799 PUSH BC ; 5800 INC H ; 5801 PUSH HL ; 5802 LD H,B ; 5803 LD L,C ; 5804 CALL <A href="#L1305">L1305</a> ; routine GET-HL*DE 5805 EX DE,HL ; 5806 5807 RST 18H ; GET-CHAR 5808 CP $1A ; 5809 JR Z,<A href="#L1435">L1435</a> ; back to D-NO-LOOP 5810 5811 CP $11 ; is it ')' ? 5812 JR NZ,<A href="#L140C">L140C</a> ; back if not to D-RPORT-C 5813 5814 5815 RST 20H ; NEXT-CHAR 5816 POP BC ; 5817 LD A,C ; 5818 LD L,B ; 5819 LD H,$00 ; 5820 INC HL ; 5821 INC HL ; 5822 ADD HL,HL ; 5823 ADD HL,DE ; 5824 JP C,<A href="#L0ED3">L0ED3</a> ; jump to REPORT-4 5825 5826 PUSH DE ; 5827 PUSH BC ; 5828 PUSH HL ; 5829 LD B,H ; 5830 LD C,L ; 5831 LD HL,($4014) ; sv E_LINE_lo 5832 DEC HL ; 5833 CALL <A href="#L099E">L099E</a> ; routine MAKE-ROOM 5834 INC HL ; 5835 LD (HL),A ; 5836 POP BC ; 5837 DEC BC ; 5838 DEC BC ; 5839 DEC BC ; 5840 INC HL ; 5841 LD (HL),C ; 5842 INC HL ; 5843 LD (HL),B ; 5844 POP AF ; 5845 INC HL ; 5846 LD (HL),A ; 5847 LD H,D ; 5848 LD L,E ; 5849 DEC DE ; 5850 LD (HL),$00 ; 5851 POP BC ; 5852 LDDR ; Copy Bytes 5853 5854 <a name="L147F"></a>;; <b>DIM-SIZES</b> 5855 L147F: POP BC ; 5856 LD (HL),B ; 5857 DEC HL ; 5858 LD (HL),C ; 5859 DEC HL ; 5860 DEC A ; 5861 JR NZ,<A href="#L147F">L147F</a> ; back to DIM-SIZES 5862 5863 RET ; return. 5864 5865 ; --------------------- 5866 ; THE <b><font color=#333388>'RESERVE'</font></b> ROUTINE 5867 ; --------------------- 5868 ; 5869 ; 5870 5871 <a name="L1488"></a>;; <b>RESERVE</b> 5872 L1488: LD HL,($401A) ; address STKBOT 5873 DEC HL ; now last byte of workspace 5874 CALL <A href="#L099E">L099E</a> ; routine MAKE-ROOM 5875 INC HL ; 5876 INC HL ; 5877 POP BC ; 5878 LD ($4014),BC ; sv E_LINE_lo 5879 POP BC ; 5880 EX DE,HL ; 5881 INC HL ; 5882 RET ; 5883 5884 ; --------------------------- 5885 ; THE <b><font color=#333388>'CLEAR'</font></b> COMMAND ROUTINE 5886 ; --------------------------- 5887 ; 5888 ; 5889 5890 <a name="L149A"></a>;; <b>CLEAR</b> 5891 L149A: LD HL,($4010) ; sv VARS_lo 5892 LD (HL),$80 ; 5893 INC HL ; 5894 LD ($4014),HL ; sv E_LINE_lo 5895 5896 ; ----------------------- 5897 ; THE <b><font color=#333388>'X-TEMP'</font></b> SUBROUTINE 5898 ; ----------------------- 5899 ; 5900 ; 5901 5902 <a name="L14A3"></a>;; <b>X-TEMP</b> 5903 L14A3: LD HL,($4014) ; sv E_LINE_lo 5904 5905 ; ---------------------- 5906 ; THE <b><font color=#333388>'SET-STK'</font></b> ROUTINES 5907 ; ---------------------- 5908 ; 5909 ; 5910 5911 <a name="L14A6"></a>;; <b>SET-STK-B</b> 5912 L14A6: LD ($401A),HL ; sv STKBOT 5913 5914 ; 5915 5916 <a name="L14A9"></a>;; <b>SET-STK-E</b> 5917 L14A9: LD ($401C),HL ; sv STKEND 5918 RET ; 5919 5920 ; ----------------------- 5921 ; THE <b><font color=#333388>'CURSOR-IN'</font></b> ROUTINE 5922 ; ----------------------- 5923 ; This routine is called to set the edit line to the minimum cursor/newline 5924 ; and to set STKEND, the start of free space, at the next position. 5925 5926 <a name="L14AD"></a>;; <b>CURSOR-IN</b> 5927 L14AD: LD HL,($4014) ; fetch start of edit line from E_LINE 5928 LD (HL),$7F ; insert cursor character 5929 5930 INC HL ; point to next location. 5931 LD (HL),$76 ; insert NEWLINE character 5932 INC HL ; point to next free location. 5933 5934 LD (IY+$22),$02 ; set lower screen display file size DF_SZ 5935 5936 JR <A href="#L14A6">L14A6</a> ; exit via SET-STK-B above 5937 5938 ; ------------------------ 5939 ; THE <b><font color=#333388>'SET-MIN'</font></b> SUBROUTINE 5940 ; ------------------------ 5941 ; 5942 ; 5943 5944 <a name="L14BC"></a>;; <b>SET-MIN</b> 5945 L14BC: LD HL,$405D ; normal location of calculator's memory area 5946 LD ($401F),HL ; update system variable MEM 5947 LD HL,($401A) ; fetch STKBOT 5948 JR <A href="#L14A9">L14A9</a> ; back to SET-STK-E 5949 5950 5951 ; ------------------------------------ 5952 ; THE <b><font color=#333388>'RECLAIM THE END-MARKER'</font></b> ROUTINE 5953 ; ------------------------------------ 5954 5955 <a name="L14C7"></a>;; <b>REC-V80</b> 5956 L14C7: LD DE,($4014) ; sv E_LINE_lo 5957 JP <A href="#L0A5D">L0A5D</a> ; to RECLAIM-1 5958 5959 ; ---------------------- 5960 ; THE <b><font color=#333388>'ALPHA'</font></b> SUBROUTINE 5961 ; ---------------------- 5962 5963 <a name="L14CE"></a>;; <b>ALPHA</b> 5964 L14CE: CP $26 ; 5965 JR <A href="#L14D4">L14D4</a> ; skip forward to ALPHA-2 5966 5967 5968 ; ------------------------- 5969 ; THE <b><font color=#333388>'ALPHANUM'</font></b> SUBROUTINE 5970 ; ------------------------- 5971 5972 <a name="L14D2"></a>;; <b>ALPHANUM</b> 5973 L14D2: CP $1C ; 5974 5975 5976 <a name="L14D4"></a>;; <b>ALPHA-2</b> 5977 L14D4: CCF ; Complement Carry Flag 5978 RET NC ; 5979 5980 CP $40 ; 5981 RET ; 5982 5983 5984 ; ------------------------------------------ 5985 ; THE <b><font color=#333388>'DECIMAL TO FLOATING POINT'</font></b> SUBROUTINE 5986 ; ------------------------------------------ 5987 ; 5988 5989 <a name="L14D9"></a>;; <b>DEC-TO-FP</b> 5990 L14D9: CALL <A href="#L1548">L1548</a> ; routine INT-TO-FP gets first part 5991 CP $1B ; is character a '.' ? 5992 JR NZ,<A href="#L14F5">L14F5</a> ; forward if not to E-FORMAT 5993 5994 5995 RST 28H ;; FP-CALC 5996 DEFB $A1 ;;stk-one 5997 DEFB $C0 ;;st-mem-0 5998 DEFB $02 ;;delete 5999 DEFB $34 ;;end-calc 6000 6001 6002 <a name="L14E5"></a>;; <b>NXT-DGT-1</b> 6003 L14E5: RST 20H ; NEXT-CHAR 6004 CALL <A href="#L1514">L1514</a> ; routine STK-DIGIT 6005 JR C,<A href="#L14F5">L14F5</a> ; forward to E-FORMAT 6006 6007 6008 RST 28H ;; FP-CALC 6009 DEFB $E0 ;;get-mem-0 6010 DEFB $A4 ;;stk-ten 6011 DEFB $05 ;;division 6012 DEFB $C0 ;;st-mem-0 6013 DEFB $04 ;;multiply 6014 DEFB $0F ;;addition 6015 DEFB $34 ;;end-calc 6016 6017 JR <A href="#L14E5">L14E5</a> ; loop back till exhausted to NXT-DGT-1 6018 6019 ; --- 6020 6021 <a name="L14F5"></a>;; <b>E-FORMAT</b> 6022 L14F5: CP $2A ; is character 'E' ? 6023 RET NZ ; return if not 6024 6025 LD (IY+$5D),$FF ; initialize sv MEM-0-1st to $FF TRUE 6026 6027 RST 20H ; NEXT-CHAR 6028 CP $15 ; is character a '+' ? 6029 JR Z,<A href="#L1508">L1508</a> ; forward if so to SIGN-DONE 6030 6031 CP $16 ; is it a '-' ? 6032 JR NZ,<A href="#L1509">L1509</a> ; forward if not to ST-E-PART 6033 6034 INC (IY+$5D) ; sv MEM-0-1st change to FALSE 6035 6036 <a name="L1508"></a>;; <b>SIGN-DONE</b> 6037 L1508: RST 20H ; NEXT-CHAR 6038 6039 <a name="L1509"></a>;; <b>ST-E-PART</b> 6040 L1509: CALL <A href="#L1548">L1548</a> ; routine INT-TO-FP 6041 6042 RST 28H ;; FP-CALC m, e. 6043 DEFB $E0 ;;get-mem-0 m, e, (1/0) TRUE/FALSE 6044 DEFB $00 ;;jump-true 6045 DEFB $02 ;;to <A href="#L1511">L1511</a>, E-POSTVE 6046 DEFB $18 ;;neg m, -e 6047 6048 <a name="L1511"></a>;; <b>E-POSTVE</b> 6049 L1511: DEFB $38 ;;e-to-fp x. 6050 DEFB $34 ;;end-calc x. 6051 6052 RET ; return. 6053 6054 6055 ; -------------------------- 6056 ; THE <b><font color=#333388>'STK-DIGIT'</font></b> SUBROUTINE 6057 ; -------------------------- 6058 ; 6059 6060 <a name="L1514"></a>;; <b>STK-DIGIT</b> 6061 L1514: CP $1C ; 6062 RET C ; 6063 6064 CP $26 ; 6065 CCF ; Complement Carry Flag 6066 RET C ; 6067 6068 SUB $1C ; 6069 6070 ; ------------------------ 6071 ; THE <b><font color=#333388>'STACK-A'</font></b> SUBROUTINE 6072 ; ------------------------ 6073 ; 6074 6075 6076 <a name="L151D"></a>;; <b>STACK-A</b> 6077 L151D: LD C,A ; 6078 LD B,$00 ; 6079 6080 ; ------------------------- 6081 ; THE <b><font color=#333388>'STACK-BC'</font></b> SUBROUTINE 6082 ; ------------------------- 6083 ; The ZX81 does not have an integer number format so the BC register contents 6084 ; must be converted to their full floating-point form. 6085 6086 <a name="L1520"></a>;; <b>STACK-BC</b> 6087 L1520: LD IY,$4000 ; re-initialize the system variables pointer. 6088 PUSH BC ; save the integer value. 6089 6090 ; now stack zero, five zero bytes as a starting point. 6091 6092 RST 28H ;; FP-CALC 6093 DEFB $A0 ;;stk-zero 0. 6094 DEFB $34 ;;end-calc 6095 6096 POP BC ; restore integer value. 6097 6098 LD (HL),$91 ; place $91 in exponent 65536. 6099 ; this is the maximum possible value 6100 6101 LD A,B ; fetch hi-byte. 6102 AND A ; test for zero. 6103 JR NZ,<A href="#L1536">L1536</a> ; forward if not zero to STK-BC-2 6104 6105 LD (HL),A ; else make exponent zero again 6106 OR C ; test lo-byte 6107 RET Z ; return if BC was zero - done. 6108 6109 ; else there has to be a set bit if only the value one. 6110 6111 LD B,C ; save C in B. 6112 LD C,(HL) ; fetch zero to C 6113 LD (HL),$89 ; make exponent $89 256. 6114 6115 <a name="L1536"></a>;; <b>STK-BC-2</b> 6116 L1536: DEC (HL) ; decrement exponent - halving number 6117 SLA C ; C<-76543210<-0 6118 RL B ; C<-76543210<-C 6119 JR NC,<A href="#L1536">L1536</a> ; loop back if no carry to STK-BC-2 6120 6121 SRL B ; 0->76543210->C 6122 RR C ; C->76543210->C 6123 6124 INC HL ; address first byte of mantissa 6125 LD (HL),B ; insert B 6126 INC HL ; address second byte of mantissa 6127 LD (HL),C ; insert C 6128 6129 DEC HL ; point to the 6130 DEC HL ; exponent again 6131 RET ; return. 6132 6133 ; ------------------------------------------ 6134 ; THE <b><font color=#333388>'INTEGER TO FLOATING POINT'</font></b> SUBROUTINE 6135 ; ------------------------------------------ 6136 ; 6137 ; 6138 6139 <a name="L1548"></a>;; <b>INT-TO-FP</b> 6140 L1548: PUSH AF ; 6141 6142 RST 28H ;; FP-CALC 6143 DEFB $A0 ;;stk-zero 6144 DEFB $34 ;;end-calc 6145 6146 POP AF ; 6147 6148 <a name="L154D"></a>;; <b>NXT-DGT-2</b> 6149 L154D: CALL <A href="#L1514">L1514</a> ; routine STK-DIGIT 6150 RET C ; 6151 6152 6153 RST 28H ;; FP-CALC 6154 DEFB $01 ;;exchange 6155 DEFB $A4 ;;stk-ten 6156 DEFB $04 ;;multiply 6157 DEFB $0F ;;addition 6158 DEFB $34 ;;end-calc 6159 6160 6161 RST 20H ; NEXT-CHAR 6162 JR <A href="#L154D">L154D</a> ; to NXT-DGT-2 6163 6164 6165 ; ------------------------------------------- 6166 ; THE <b><font color=#333388>'E-FORMAT TO FLOATING POINT'</font></b> SUBROUTINE 6167 ; ------------------------------------------- 6168 ; <font color=#339933>(Offset $38: 'e-to-fp')</font> 6169 ; invoked from DEC-TO-FP and PRINT-FP. 6170 ; e.g. 2.3E4 is 23000. 6171 ; This subroutine evaluates xEm where m is a positive or negative integer. 6172 ; At a simple level x is multiplied by ten for every unit of m. 6173 ; If the decimal exponent m is negative then x is divided by ten for each unit. 6174 ; A short-cut is taken if the exponent is greater than seven and in this 6175 ; case the exponent is reduced by seven and the value is multiplied or divided 6176 ; by ten million. 6177 ; <font color=#9900FF>Note.</font> for the ZX Spectrum an even cleverer method was adopted which involved 6178 ; shifting the bits out of the exponent so the result was achieved with six 6179 ; shifts at most. The routine below had to be completely re-written mostly 6180 ; in Z80 machine code. 6181 ; Although no longer operable, the calculator literal was retained for old 6182 ; times sake, the routine being invoked directly from a machine code CALL. 6183 ; 6184 ; On entry in the ZX81, m, the exponent, is the 'last value', and the 6185 ; floating-point decimal mantissa is beneath it. 6186 6187 6188 <a name="L155A"></a>;; <b>e-to-fp</b> 6189 L155A: RST 28H ;; FP-CALC x, m. 6190 DEFB $2D ;;duplicate x, m, m. 6191 DEFB $32 ;;less-0 x, m, (1/0). 6192 DEFB $C0 ;;st-mem-0 x, m, (1/0). 6193 DEFB $02 ;;delete x, m. 6194 DEFB $27 ;;abs x, +m. 6195 6196 <a name="L1560"></a>;; <b>E-LOOP</b> 6197 L1560: DEFB $A1 ;;stk-one x, m,1. 6198 DEFB $03 ;;subtract x, m-1. 6199 DEFB $2D ;;duplicate x, m-1,m-1. 6200 DEFB $32 ;;less-0 x, m-1, (1/0). 6201 DEFB $00 ;;jump-true x, m-1. 6202 DEFB $22 ;;to <A href="#L1587">L1587</a>, E-END x, m-1. 6203 6204 DEFB $2D ;;duplicate x, m-1, m-1. 6205 DEFB $30 ;;stk-data 6206 DEFB $33 ;;Exponent: $83, Bytes: 1 6207 6208 DEFB $40 ;;(+00,+00,+00) x, m-1, m-1, 6. 6209 DEFB $03 ;;subtract x, m-1, m-7. 6210 DEFB $2D ;;duplicate x, m-1, m-7, m-7. 6211 DEFB $32 ;;less-0 x, m-1, m-7, (1/0). 6212 DEFB $00 ;;jump-true x, m-1, m-7. 6213 DEFB $0C ;;to <A href="#L157A">L157A</a>, E-LOW 6214 6215 ; but if exponent m is higher than 7 do a bigger chunk. 6216 ; multiplying (or dividing if negative) by 10 million - 1e7. 6217 6218 DEFB $01 ;;exchange x, m-7, m-1. 6219 DEFB $02 ;;delete x, m-7. 6220 DEFB $01 ;;exchange m-7, x. 6221 DEFB $30 ;;stk-data 6222 DEFB $80 ;;Bytes: 3 6223 DEFB $48 ;;Exponent $98 6224 DEFB $18,$96,$80 ;;(+00) m-7, x, 10,000,000 (=f) 6225 DEFB $2F ;;jump 6226 DEFB $04 ;;to <A href="#L157D">L157D</a>, E-CHUNK 6227 6228 ; --- 6229 6230 <a name="L157A"></a>;; <b>E-LOW</b> 6231 L157A: DEFB $02 ;;delete x, m-1. 6232 DEFB $01 ;;exchange m-1, x. 6233 DEFB $A4 ;;stk-ten m-1, x, 10 (=f). 6234 6235 <a name="L157D"></a>;; <b>E-CHUNK</b> 6236 L157D: DEFB $E0 ;;get-mem-0 m-1, x, f, (1/0) 6237 DEFB $00 ;;jump-true m-1, x, f 6238 DEFB $04 ;;to <A href="#L1583">L1583</a>, E-DIVSN 6239 6240 DEFB $04 ;;multiply m-1, x*f. 6241 DEFB $2F ;;jump 6242 DEFB $02 ;;to <A href="#L1584">L1584</a>, E-SWAP 6243 6244 ; --- 6245 6246 <a name="L1583"></a>;; <b>E-DIVSN</b> 6247 L1583: DEFB $05 ;;division m-1, x/f (= new x). 6248 6249 <a name="L1584"></a>;; <b>E-SWAP</b> 6250 L1584: DEFB $01 ;;exchange x, m-1 (= new m). 6251 DEFB $2F ;;jump x, m. 6252 DEFB $DA ;;to <A href="#L1560">L1560</a>, E-LOOP 6253 6254 ; --- 6255 6256 <a name="L1587"></a>;; <b>E-END</b> 6257 L1587: DEFB $02 ;;delete x. (-1) 6258 DEFB $34 ;;end-calc x. 6259 6260 RET ; return. 6261 6262 ; ------------------------------------- 6263 ; THE <b><font color=#333388>'FLOATING-POINT TO BC'</font></b> SUBROUTINE 6264 ; ------------------------------------- 6265 ; The floating-point form on the calculator stack is compressed directly into 6266 ; the BC register rounding up if necessary. 6267 ; Valid range is 0 to 65535.4999 6268 6269 <a name="L158A"></a>;; <b>FP-TO-BC</b> 6270 L158A: CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH - exponent to A 6271 ; mantissa to EDCB. 6272 AND A ; test for value zero. 6273 JR NZ,<A href="#L1595">L1595</a> ; forward if not to FPBC-NZRO 6274 6275 ; else value is zero 6276 6277 LD B,A ; zero to B 6278 LD C,A ; also to C 6279 PUSH AF ; save the flags on machine stack 6280 JR <A href="#L15C6">L15C6</a> ; forward to FPBC-END 6281 6282 ; --- 6283 6284 ; EDCB => BCE 6285 6286 <a name="L1595"></a>;; <b>FPBC-NZRO</b> 6287 L1595: LD B,E ; transfer the mantissa from EDCB 6288 LD E,C ; to BCE. Bit 7 of E is the 17th bit which 6289 LD C,D ; will be significant for rounding if the 6290 ; number is already normalized. 6291 6292 SUB $91 ; subtract 65536 6293 CCF ; complement carry flag 6294 BIT 7,B ; test sign bit 6295 PUSH AF ; push the result 6296 6297 SET 7,B ; set the implied bit 6298 JR C,<A href="#L15C6">L15C6</a> ; forward with carry from SUB/CCF to FPBC-END 6299 ; number is too big. 6300 6301 INC A ; increment the exponent and 6302 NEG ; negate to make range $00 - $0F 6303 6304 CP $08 ; test if one or two bytes 6305 JR C,<A href="#L15AF">L15AF</a> ; forward with two to BIG-INT 6306 6307 LD E,C ; shift mantissa 6308 LD C,B ; 8 places right 6309 LD B,$00 ; insert a zero in B 6310 SUB $08 ; reduce exponent by eight 6311 6312 <a name="L15AF"></a>;; <b>BIG-INT</b> 6313 L15AF: AND A ; test the exponent 6314 LD D,A ; save exponent in D. 6315 6316 LD A,E ; fractional bits to A 6317 RLCA ; rotate most significant bit to carry for 6318 ; rounding of an already normal number. 6319 6320 JR Z,<A href="#L15BC">L15BC</a> ; forward if exponent zero to EXP-ZERO 6321 ; the number is normalized 6322 6323 <a name="L15B5"></a>;; <b>FPBC-NORM</b> 6324 L15B5: SRL B ; 0->76543210->C 6325 RR C ; C->76543210->C 6326 6327 DEC D ; decrement exponent 6328 6329 JR NZ,<A href="#L15B5">L15B5</a> ; loop back till zero to FPBC-NORM 6330 6331 <a name="L15BC"></a>;; <b>EXP-ZERO</b> 6332 L15BC: JR NC,<A href="#L15C6">L15C6</a> ; forward without carry to NO-ROUND 6333 6334 INC BC ; round up. 6335 LD A,B ; test result 6336 OR C ; for zero 6337 JR NZ,<A href="#L15C6">L15C6</a> ; forward if not to GRE-ZERO 6338 6339 POP AF ; restore sign flag 6340 SCF ; set carry flag to indicate overflow 6341 PUSH AF ; save combined flags again 6342 6343 <a name="L15C6"></a>;; <b>FPBC-END</b> 6344 L15C6: PUSH BC ; save BC value 6345 6346 ; set HL and DE to calculator stack pointers. 6347 6348 RST 28H ;; FP-CALC 6349 DEFB $34 ;;end-calc 6350 6351 6352 POP BC ; restore BC value 6353 POP AF ; restore flags 6354 LD A,C ; copy low byte to A also. 6355 RET ; return 6356 6357 ; ------------------------------------ 6358 ; THE <b><font color=#333388>'FLOATING-POINT TO A'</font></b> SUBROUTINE 6359 ; ------------------------------------ 6360 ; 6361 ; 6362 6363 <a name="L15CD"></a>;; <b>FP-TO-A</b> 6364 L15CD: CALL <A href="#L158A">L158A</a> ; routine FP-TO-BC 6365 RET C ; 6366 6367 PUSH AF ; 6368 DEC B ; 6369 INC B ; 6370 JR Z,<A href="#L15D9">L15D9</a> ; forward if in range to FP-A-END 6371 6372 POP AF ; fetch result 6373 SCF ; set carry flag signaling overflow 6374 RET ; return 6375 6376 <a name="L15D9"></a>;; <b>FP-A-END</b> 6377 L15D9: POP AF ; 6378 RET ; 6379 6380 6381 ; ---------------------------------------------- 6382 ; THE <b><font color=#333388>'PRINT A FLOATING-POINT NUMBER'</font></b> SUBROUTINE 6383 ; ---------------------------------------------- 6384 ; prints 'last value' x on calculator stack. 6385 ; There are a wide variety of formats see Chapter 4. 6386 ; e.g. 6387 ; PI prints as 3.1415927 6388 ; .123 prints as 0.123 6389 ; .0123 prints as .0123 6390 ; 999999999999 prints as 1000000000000 6391 ; 9876543210123 prints as 9876543200000 6392 6393 ; Begin by isolating zero and just printing the '0' character 6394 ; for that case. For negative numbers print a leading '-' and 6395 ; then form the absolute value of x. 6396 6397 <a name="L15DB"></a>;; <b>PRINT-FP</b> 6398 L15DB: RST 28H ;; FP-CALC x. 6399 DEFB $2D ;;duplicate x, x. 6400 DEFB $32 ;;less-0 x, (1/0). 6401 DEFB $00 ;;jump-true 6402 DEFB $0B ;;to <A href="#L15EA">L15EA</a>, PF-NGTVE x. 6403 6404 DEFB $2D ;;duplicate x, x 6405 DEFB $33 ;;greater-0 x, (1/0). 6406 DEFB $00 ;;jump-true 6407 DEFB $0D ;;to <A href="#L15F0">L15F0</a>, PF-POSTVE x. 6408 6409 DEFB $02 ;;delete . 6410 DEFB $34 ;;end-calc . 6411 6412 LD A,$1C ; load accumulator with character '0' 6413 6414 RST 10H ; PRINT-A 6415 RET ; return. >> 6416 6417 ; --- 6418 6419 <a name="L15EA"></a>;; <b>PF-NEGTVE</b> 6420 L15EA: DEFB $27 ; abs +x. 6421 DEFB $34 ;;end-calc x. 6422 6423 LD A,$16 ; load accumulator with '-' 6424 6425 RST 10H ; PRINT-A 6426 6427 RST 28H ;; FP-CALC x. 6428 6429 <a name="L15F0"></a>;; <b>PF-POSTVE</b> 6430 L15F0: DEFB $34 ;;end-calc x. 6431 6432 ; register HL addresses the exponent of the floating-point value. 6433 ; if positive, and point floats to left, then bit 7 is set. 6434 6435 LD A,(HL) ; pick up the exponent byte 6436 CALL <A href="#L151D">L151D</a> ; routine STACK-A places on calculator stack. 6437 6438 ; now calculate roughly the number of digits, n, before the decimal point by 6439 ; subtracting a half from true exponent and multiplying by log to 6440 ; the base 10 of 2. 6441 ; The true number could be one higher than n, the integer result. 6442 6443 RST 28H ;; FP-CALC x, e. 6444 DEFB $30 ;;stk-data 6445 DEFB $78 ;;Exponent: $88, Bytes: 2 6446 DEFB $00,$80 ;;(+00,+00) x, e, 128.5. 6447 DEFB $03 ;;subtract x, e -.5. 6448 DEFB $30 ;;stk-data 6449 DEFB $EF ;;Exponent: $7F, Bytes: 4 6450 DEFB $1A,$20,$9A,$85 ;; .30103 (log10 2) 6451 DEFB $04 ;;multiply x, 6452 DEFB $24 ;;int 6453 DEFB $C1 ;;st-mem-1 x, n. 6454 6455 6456 DEFB $30 ;;stk-data 6457 DEFB $34 ;;Exponent: $84, Bytes: 1 6458 DEFB $00 ;;(+00,+00,+00) x, n, 8. 6459 6460 DEFB $03 ;;subtract x, n-8. 6461 DEFB $18 ;;neg x, 8-n. 6462 DEFB $38 ;;e-to-fp x * (10^n) 6463 6464 ; finally the 8 or 9 digit decimal is rounded. 6465 ; a ten-digit integer can arise in the case of, say, 999999999.5 6466 ; which gives 1000000000. 6467 6468 DEFB $A2 ;;stk-half 6469 DEFB $0F ;;addition 6470 DEFB $24 ;;int i. 6471 DEFB $34 ;;end-calc 6472 6473 ; If there were 8 digits then final rounding will take place on the calculator 6474 ; stack above and the next two instructions insert a masked zero so that 6475 ; no further rounding occurs. If the result is a 9 digit integer then 6476 ; rounding takes place within the buffer. 6477 6478 LD HL,$406B ; address system variable MEM-2-5th 6479 ; which could be the 'ninth' digit. 6480 LD (HL),$90 ; insert the value $90 10010000 6481 6482 ; now starting from lowest digit lay down the 8, 9 or 10 digit integer 6483 ; which represents the significant portion of the number 6484 ; e.g. PI will be the nine-digit integer 314159265 6485 6486 LD B,$0A ; count is ten digits. 6487 6488 <a name="L1615"></a>;; <b>PF-LOOP</b> 6489 L1615: INC HL ; increase pointer 6490 6491 PUSH HL ; preserve buffer address. 6492 PUSH BC ; preserve counter. 6493 6494 RST 28H ;; FP-CALC i. 6495 DEFB $A4 ;;stk-ten i, 10. 6496 DEFB $2E ;;n-mod-m i mod 10, i/10 6497 DEFB $01 ;;exchange i/10, remainder. 6498 DEFB $34 ;;end-calc 6499 6500 CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A $00-$09 6501 6502 OR $90 ; make left hand nibble 9 6503 6504 POP BC ; restore counter 6505 POP HL ; restore buffer address. 6506 6507 LD (HL),A ; insert masked digit in buffer. 6508 DJNZ <A href="#L1615">L1615</a> ; loop back for all ten to PF-LOOP 6509 6510 ; the most significant digit will be last but if the number is exhausted then 6511 ; the last one or two positions will contain zero ($90). 6512 6513 ; e.g. for 'one' we have zero as estimate of leading digits. 6514 ; 1*10^8 100000000 as integer value 6515 ; 90 90 90 90 90 90 90 90 91 90 as buffer mem3/mem4 contents. 6516 6517 6518 INC HL ; advance pointer to one past buffer 6519 LD BC,$0008 ; set C to 8 ( B is already zero ) 6520 PUSH HL ; save pointer. 6521 6522 <a name="L162C"></a>;; <b>PF-NULL</b> 6523 L162C: DEC HL ; decrease pointer 6524 LD A,(HL) ; fetch masked digit 6525 CP $90 ; is it a leading zero ? 6526 JR Z,<A href="#L162C">L162C</a> ; loop back if so to PF-NULL 6527 6528 ; at this point a significant digit has been found. carry is reset. 6529 6530 SBC HL,BC ; subtract eight from the address. 6531 PUSH HL ; ** save this pointer too 6532 LD A,(HL) ; fetch addressed byte 6533 ADD A,$6B ; add $6B - forcing a round up ripple 6534 ; if $95 or over. 6535 PUSH AF ; save the carry result. 6536 6537 ; now enter a loop to round the number. After rounding has been considered 6538 ; a zero that has arisen from rounding or that was present at that position 6539 ; originally is changed from $90 to $80. 6540 6541 <a name="L1639"></a>;; <b>PF-RND-LP</b> 6542 L1639: POP AF ; retrieve carry from machine stack. 6543 INC HL ; increment address 6544 LD A,(HL) ; fetch new byte 6545 ADC A,$00 ; add in any carry 6546 6547 DAA ; decimal adjust accumulator 6548 ; carry will ripple through the '9' 6549 6550 PUSH AF ; save carry on machine stack. 6551 AND $0F ; isolate character 0 - 9 AND set zero flag 6552 ; if zero. 6553 LD (HL),A ; place back in location. 6554 SET 7,(HL) ; set bit 7 to show printable. 6555 ; but not if trailing zero after decimal point. 6556 JR Z,<A href="#L1639">L1639</a> ; back if a zero to PF-RND-LP 6557 ; to consider further rounding and/or trailing 6558 ; zero identification. 6559 6560 POP AF ; balance stack 6561 POP HL ; ** retrieve lower pointer 6562 6563 ; now insert 6 trailing zeros which are printed if before the decimal point 6564 ; but mark the end of printing if after decimal point. 6565 ; e.g. 9876543210123 is printed as 9876543200000 6566 ; 123.456001 is printed as 123.456 6567 6568 LD B,$06 ; the count is six. 6569 6570 <a name="L164B"></a>;; <b>PF-ZERO-6</b> 6571 L164B: LD (HL),$80 ; insert a masked zero 6572 DEC HL ; decrease pointer. 6573 DJNZ <A href="#L164B">L164B</a> ; loop back for all six to PF-ZERO-6 6574 6575 ; n-mod-m reduced the number to zero and this is now deleted from the calculator 6576 ; stack before fetching the original estimate of leading digits. 6577 6578 6579 RST 28H ;; FP-CALC 0. 6580 DEFB $02 ;;delete . 6581 DEFB $E1 ;;get-mem-1 n. 6582 DEFB $34 ;;end-calc n. 6583 6584 CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A 6585 JR Z,<A href="#L165B">L165B</a> ; skip forward if positive to PF-POS 6586 6587 NEG ; negate makes positive 6588 6589 <a name="L165B"></a>;; <b>PF-POS</b> 6590 L165B: LD E,A ; transfer count of digits to E 6591 INC E ; increment twice 6592 INC E ; 6593 POP HL ; * retrieve pointer to one past buffer. 6594 6595 <a name="L165F"></a>;; <b>GET-FIRST</b> 6596 L165F: DEC HL ; decrement address. 6597 DEC E ; decrement digit counter. 6598 LD A,(HL) ; fetch masked byte. 6599 AND $0F ; isolate right-hand nibble. 6600 JR Z,<A href="#L165F">L165F</a> ; back with leading zero to GET-FIRST 6601 6602 ; now determine if E-format printing is needed 6603 6604 LD A,E ; transfer now accurate number count to A. 6605 SUB $05 ; subtract five 6606 CP $08 ; compare with 8 as maximum digits is 13. 6607 JP P,<A href="#L1682">L1682</a> ; forward if positive to PF-E-FMT 6608 6609 CP $F6 ; test for more than four zeros after point. 6610 JP M,<A href="#L1682">L1682</a> ; forward if so to PF-E-FMT 6611 6612 ADD A,$06 ; test for zero leading digits, e.g. 0.5 6613 JR Z,<A href="#L16BF">L16BF</a> ; forward if so to PF-ZERO-1 6614 6615 JP M,<A href="#L16B2">L16B2</a> ; forward if more than one zero to PF-ZEROS 6616 6617 ; else digits before the decimal point are to be printed 6618 6619 LD B,A ; count of leading characters to B. 6620 6621 <a name="L167B"></a>;; <b>PF-NIB-LP</b> 6622 L167B: CALL <A href="#L16D0">L16D0</a> ; routine PF-NIBBLE 6623 DJNZ <A href="#L167B">L167B</a> ; loop back for counted numbers to PF-NIB-LP 6624 6625 JR <A href="#L16C2">L16C2</a> ; forward to consider decimal part to PF-DC-OUT 6626 6627 ; --- 6628 6629 <a name="L1682"></a>;; <b>PF-E-FMT</b> 6630 L1682: LD B,E ; count to B 6631 CALL <A href="#L16D0">L16D0</a> ; routine PF-NIBBLE prints one digit. 6632 CALL <A href="#L16C2">L16C2</a> ; routine PF-DC-OUT considers fractional part. 6633 6634 LD A,$2A ; prepare character 'E' 6635 RST 10H ; PRINT-A 6636 6637 LD A,B ; transfer exponent to A 6638 AND A ; test the sign. 6639 JP P,<A href="#L1698">L1698</a> ; forward if positive to PF-E-POS 6640 6641 NEG ; negate the negative exponent. 6642 LD B,A ; save positive exponent in B. 6643 6644 LD A,$16 ; prepare character '-' 6645 JR <A href="#L169A">L169A</a> ; skip forward to PF-E-SIGN 6646 6647 ; --- 6648 6649 <a name="L1698"></a>;; <b>PF-E-POS</b> 6650 L1698: LD A,$15 ; prepare character '+' 6651 6652 <a name="L169A"></a>;; <b>PF-E-SIGN</b> 6653 L169A: RST 10H ; PRINT-A 6654 6655 ; now convert the integer exponent in B to two characters. 6656 ; it will be less than 99. 6657 6658 LD A,B ; fetch positive exponent. 6659 LD B,$FF ; initialize left hand digit to minus one. 6660 6661 <a name="L169E"></a>;; <b>PF-E-TENS</b> 6662 L169E: INC B ; increment ten count 6663 SUB $0A ; subtract ten from exponent 6664 JR NC,<A href="#L169E">L169E</a> ; loop back if greater than ten to PF-E-TENS 6665 6666 ADD A,$0A ; reverse last subtraction 6667 LD C,A ; transfer remainder to C 6668 6669 LD A,B ; transfer ten value to A. 6670 AND A ; test for zero. 6671 JR Z,<A href="#L16AD">L16AD</a> ; skip forward if so to PF-E-LOW 6672 6673 CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE prints as digit '1' - '9' 6674 6675 <a name="L16AD"></a>;; <b>PF-E-LOW</b> 6676 L16AD: LD A,C ; low byte to A 6677 CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE prints final digit of the 6678 ; exponent. 6679 RET ; return. >> 6680 6681 ; --- 6682 6683 ; this branch deals with zeros after decimal point. 6684 ; e.g. .01 or .0000999 6685 6686 <a name="L16B2"></a>;; <b>PF-ZEROS</b> 6687 L16B2: NEG ; negate makes number positive 1 to 4. 6688 LD B,A ; zero count to B. 6689 6690 LD A,$1B ; prepare character '.' 6691 RST 10H ; PRINT-A 6692 6693 LD A,$1C ; prepare a '0' 6694 6695 <a name="L16BA"></a>;; <b>PF-ZRO-LP</b> 6696 L16BA: RST 10H ; PRINT-A 6697 DJNZ <A href="#L16BA">L16BA</a> ; loop back to PF-ZRO-LP 6698 6699 JR <A href="#L16C8">L16C8</a> ; forward to PF-FRAC-LP 6700 6701 ; --- 6702 6703 ; there is a need to print a leading zero e.g. 0.1 but not with .01 6704 6705 <a name="L16BF"></a>;; <b>PF-ZERO-1</b> 6706 L16BF: LD A,$1C ; prepare character '0'. 6707 RST 10H ; PRINT-A 6708 6709 ; this subroutine considers the decimal point and any trailing digits. 6710 ; if the next character is a marked zero, $80, then nothing more to print. 6711 6712 <a name="L16C2"></a>;; <b>PF-DC-OUT</b> 6713 L16C2: DEC (HL) ; decrement addressed character 6714 INC (HL) ; increment it again 6715 RET PE ; return with overflow (was 128) >> 6716 ; as no fractional part 6717 6718 ; else there is a fractional part so print the decimal point. 6719 6720 LD A,$1B ; prepare character '.' 6721 RST 10H ; PRINT-A 6722 6723 ; now enter a loop to print trailing digits 6724 6725 <a name="L16C8"></a>;; <b>PF-FRAC-LP</b> 6726 L16C8: DEC (HL) ; test for a marked zero. 6727 INC (HL) ; 6728 RET PE ; return when digits exhausted >> 6729 6730 CALL <A href="#L16D0">L16D0</a> ; routine PF-NIBBLE 6731 JR <A href="#L16C8">L16C8</a> ; back for all fractional digits to PF-FRAC-LP. 6732 6733 ; --- 6734 6735 ; subroutine to print right-hand nibble 6736 6737 <a name="L16D0"></a>;; <b>PF-NIBBLE</b> 6738 L16D0: LD A,(HL) ; fetch addressed byte 6739 AND $0F ; mask off lower 4 bits 6740 CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE 6741 DEC HL ; decrement pointer. 6742 RET ; return. 6743 6744 6745 ; ------------------------------- 6746 ; THE <b><font color=#333388>'PREPARE TO ADD'</font></b> SUBROUTINE 6747 ; ------------------------------- 6748 ; This routine is called twice to prepare each floating point number for 6749 ; addition, in situ, on the calculator stack. 6750 ; The exponent is picked up from the first byte which is then cleared to act 6751 ; as a sign byte and accept any overflow. 6752 ; If the exponent is zero then the number is zero and an early return is made. 6753 ; The now redundant sign bit of the mantissa is set and if the number is 6754 ; negative then all five bytes of the number are twos-complemented to prepare 6755 ; the number for addition. 6756 ; On the second invocation the exponent of the first number is in B. 6757 6758 6759 <a name="L16D8"></a>;; <b>PREP-ADD</b> 6760 L16D8: LD A,(HL) ; fetch exponent. 6761 LD (HL),$00 ; make this byte zero to take any overflow and 6762 ; default to positive. 6763 AND A ; test stored exponent for zero. 6764 RET Z ; return with zero flag set if number is zero. 6765 6766 INC HL ; point to first byte of mantissa. 6767 BIT 7,(HL) ; test the sign bit. 6768 SET 7,(HL) ; set it to its implied state. 6769 DEC HL ; set pointer to first byte again. 6770 RET Z ; return if bit indicated number is positive.>> 6771 6772 ; if negative then all five bytes are twos complemented starting at LSB. 6773 6774 PUSH BC ; save B register contents. 6775 LD BC,$0005 ; set BC to five. 6776 ADD HL,BC ; point to location after 5th byte. 6777 LD B,C ; set the B counter to five. 6778 LD C,A ; store original exponent in C. 6779 SCF ; set carry flag so that one is added. 6780 6781 ; now enter a loop to twos-complement the number. 6782 ; The first of the five bytes becomes $FF to denote a negative number. 6783 6784 <a name="L16EC"></a>;; <b>NEG-BYTE</b> 6785 L16EC: DEC HL ; point to first or more significant byte. 6786 LD A,(HL) ; fetch to accumulator. 6787 CPL ; complement. 6788 ADC A,$00 ; add in initial carry or any subsequent carry. 6789 LD (HL),A ; place number back. 6790 DJNZ <A href="#L16EC">L16EC</a> ; loop back five times to NEG-BYTE 6791 6792 LD A,C ; restore the exponent to accumulator. 6793 POP BC ; restore B register contents. 6794 6795 RET ; return. 6796 6797 ; ---------------------------------- 6798 ; THE <b><font color=#333388>'FETCH TWO NUMBERS'</font></b> SUBROUTINE 6799 ; ---------------------------------- 6800 ; This routine is used by addition, multiplication and division to fetch 6801 ; the two five-byte numbers addressed by HL and DE from the calculator stack 6802 ; into the Z80 registers. 6803 ; The HL register may no longer point to the first of the two numbers. 6804 ; Since the 32-bit addition operation is accomplished using two Z80 16-bit 6805 ; instructions, it is important that the lower two bytes of each mantissa are 6806 ; in one set of registers and the other bytes all in the alternate set. 6807 ; 6808 ; In: HL = highest number, DE= lowest number 6809 ; 6810 ; : alt': : 6811 ; Out: :H,B-C:C,B: num1 6812 ; :L,D-E:D-E: num2 6813 6814 <a name="L16F7"></a>;; <b>FETCH-TWO</b> 6815 L16F7: PUSH HL ; save HL 6816 PUSH AF ; save A - result sign when used from division. 6817 6818 LD C,(HL) ; 6819 INC HL ; 6820 LD B,(HL) ; 6821 LD (HL),A ; insert sign when used from multiplication. 6822 INC HL ; 6823 LD A,C ; m1 6824 LD C,(HL) ; 6825 PUSH BC ; PUSH m2 m3 6826 6827 INC HL ; 6828 LD C,(HL) ; m4 6829 INC HL ; 6830 LD B,(HL) ; m5 BC holds m5 m4 6831 6832 EX DE,HL ; make HL point to start of second number. 6833 6834 LD D,A ; m1 6835 LD E,(HL) ; 6836 PUSH DE ; PUSH m1 n1 6837 6838 INC HL ; 6839 LD D,(HL) ; 6840 INC HL ; 6841 LD E,(HL) ; 6842 PUSH DE ; PUSH n2 n3 6843 6844 EXX ; - - - - - - - 6845 6846 POP DE ; POP n2 n3 6847 POP HL ; POP m1 n1 6848 POP BC ; POP m2 m3 6849 6850 EXX ; - - - - - - - 6851 6852 INC HL ; 6853 LD D,(HL) ; 6854 INC HL ; 6855 LD E,(HL) ; DE holds n4 n5 6856 6857 POP AF ; restore saved 6858 POP HL ; registers. 6859 RET ; return. 6860 6861 ; ----------------------------- 6862 ; THE <b><font color=#333388>'SHIFT ADDEND'</font></b> SUBROUTINE 6863 ; ----------------------------- 6864 ; The accumulator A contains the difference between the two exponents. 6865 ; This is the lowest of the two numbers to be added 6866 6867 <a name="L171A"></a>;; <b>SHIFT-FP</b> 6868 L171A: AND A ; test difference between exponents. 6869 RET Z ; return if zero. both normal. 6870 6871 CP $21 ; compare with 33 bits. 6872 JR NC,<A href="#L1736">L1736</a> ; forward if greater than 32 to ADDEND-0 6873 6874 PUSH BC ; preserve BC - part 6875 LD B,A ; shift counter to B. 6876 6877 ; Now perform B right shifts on the addend L'D'E'D E 6878 ; to bring it into line with the augend H'B'C'C B 6879 6880 <a name="L1722"></a>;; <b>ONE-SHIFT</b> 6881 L1722: EXX ; - - - 6882 SRA L ; 76543210->C bit 7 unchanged. 6883 RR D ; C->76543210->C 6884 RR E ; C->76543210->C 6885 EXX ; - - - 6886 RR D ; C->76543210->C 6887 RR E ; C->76543210->C 6888 DJNZ <A href="#L1722">L1722</a> ; loop back B times to ONE-SHIFT 6889 6890 POP BC ; restore BC 6891 RET NC ; return if last shift produced no carry. >> 6892 6893 ; if carry flag was set then accuracy is being lost so round up the addend. 6894 6895 CALL <A href="#L1741">L1741</a> ; routine ADD-BACK 6896 RET NZ ; return if not FF 00 00 00 00 6897 6898 ; this branch makes all five bytes of the addend zero and is made during 6899 ; addition when the exponents are too far apart for the addend bits to 6900 ; affect the result. 6901 6902 <a name="L1736"></a>;; <b>ADDEND-0</b> 6903 L1736: EXX ; select alternate set for more significant 6904 ; bytes. 6905 XOR A ; clear accumulator. 6906 6907 6908 ; this entry point (from multiplication) sets four of the bytes to zero or if 6909 ; continuing from above, during addition, then all five bytes are set to zero. 6910 6911 <a name="L1738"></a>;; <b>ZEROS-4/5</b> 6912 L1738: LD L,$00 ; set byte 1 to zero. 6913 LD D,A ; set byte 2 to A. 6914 LD E,L ; set byte 3 to zero. 6915 EXX ; select main set 6916 LD DE,$0000 ; set lower bytes 4 and 5 to zero. 6917 RET ; return. 6918 6919 ; ------------------------- 6920 ; THE <b><font color=#333388>'ADD-BACK'</font></b> SUBROUTINE 6921 ; ------------------------- 6922 ; Called from SHIFT-FP above during addition and after normalization from 6923 ; multiplication. 6924 ; This is really a 32-bit increment routine which sets the zero flag according 6925 ; to the 32-bit result. 6926 ; During addition, only negative numbers like FF FF FF FF FF, 6927 ; the twos-complement version of xx 80 00 00 01 say 6928 ; will result in a full ripple FF 00 00 00 00. 6929 ; FF FF FF FF FF when shifted right is unchanged by SHIFT-FP but sets the 6930 ; carry invoking this routine. 6931 6932 <a name="L1741"></a>;; <b>ADD-BACK</b> 6933 L1741: INC E ; 6934 RET NZ ; 6935 6936 INC D ; 6937 RET NZ ; 6938 6939 EXX ; 6940 INC E ; 6941 JR NZ,<A href="#L174A">L174A</a> ; forward if no overflow to ALL-ADDED 6942 6943 INC D ; 6944 6945 <a name="L174A"></a>;; <b>ALL-ADDED</b> 6946 L174A: EXX ; 6947 RET ; return with zero flag set for zero mantissa. 6948 6949 6950 ; --------------------------- 6951 ; THE <b><font color=#333388>'SUBTRACTION'</font></b> OPERATION 6952 ; --------------------------- 6953 ; just switch the sign of subtrahend and do an add. 6954 6955 <a name="L174C"></a>;; <b>subtract</b> 6956 L174C: LD A,(DE) ; fetch exponent byte of second number the 6957 ; subtrahend. 6958 AND A ; test for zero 6959 RET Z ; return if zero - first number is result. 6960 6961 INC DE ; address the first mantissa byte. 6962 LD A,(DE) ; fetch to accumulator. 6963 XOR $80 ; toggle the sign bit. 6964 LD (DE),A ; place back on calculator stack. 6965 DEC DE ; point to exponent byte. 6966 ; continue into addition routine. 6967 6968 ; ------------------------ 6969 ; THE <b><font color=#333388>'ADDITION'</font></b> OPERATION 6970 ; ------------------------ 6971 ; The addition operation pulls out all the stops and uses most of the Z80's 6972 ; registers to add two floating-point numbers. 6973 ; This is a binary operation and on entry, HL points to the first number 6974 ; and DE to the second. 6975 6976 <a name="L1755"></a>;; <b>addition</b> 6977 L1755: EXX ; - - - 6978 PUSH HL ; save the pointer to the next literal. 6979 EXX ; - - - 6980 6981 PUSH DE ; save pointer to second number 6982 PUSH HL ; save pointer to first number - will be the 6983 ; result pointer on calculator stack. 6984 6985 CALL <A href="#L16D8">L16D8</a> ; routine PREP-ADD 6986 LD B,A ; save first exponent byte in B. 6987 EX DE,HL ; switch number pointers. 6988 CALL <A href="#L16D8">L16D8</a> ; routine PREP-ADD 6989 LD C,A ; save second exponent byte in C. 6990 CP B ; compare the exponent bytes. 6991 JR NC,<A href="#L1769">L1769</a> ; forward if second higher to SHIFT-LEN 6992 6993 LD A,B ; else higher exponent to A 6994 LD B,C ; lower exponent to B 6995 EX DE,HL ; switch the number pointers. 6996 6997 <a name="L1769"></a>;; <b>SHIFT-LEN</b> 6998 L1769: PUSH AF ; save higher exponent 6999 SUB B ; subtract lower exponent 7000 7001 CALL <A href="#L16F7">L16F7</a> ; routine FETCH-TWO 7002 CALL <A href="#L171A">L171A</a> ; routine SHIFT-FP 7003 7004 POP AF ; restore higher exponent. 7005 POP HL ; restore result pointer. 7006 LD (HL),A ; insert exponent byte. 7007 PUSH HL ; save result pointer again. 7008 7009 ; now perform the 32-bit addition using two 16-bit Z80 add instructions. 7010 7011 LD L,B ; transfer low bytes of mantissa individually 7012 LD H,C ; to HL register 7013 7014 ADD HL,DE ; the actual binary addition of lower bytes 7015 7016 ; now the two higher byte pairs that are in the alternate register sets. 7017 7018 EXX ; switch in set 7019 EX DE,HL ; transfer high mantissa bytes to HL register. 7020 7021 ADC HL,BC ; the actual addition of higher bytes with 7022 ; any carry from first stage. 7023 7024 EX DE,HL ; result in DE, sign bytes ($FF or $00) to HL 7025 7026 ; now consider the two sign bytes 7027 7028 LD A,H ; fetch sign byte of num1 7029 7030 ADC A,L ; add including any carry from mantissa 7031 ; addition. 00 or 01 or FE or FF 7032 7033 LD L,A ; result in L. 7034 7035 ; possible outcomes of signs and overflow from mantissa are 7036 ; 7037 ; H + L + carry = L RRA XOR L RRA 7038 ; ------------------------------------------------------------ 7039 ; 00 + 00 = 00 00 00 7040 ; 00 + 00 + carry = 01 00 01 carry 7041 ; FF + FF = FE C FF 01 carry 7042 ; FF + FF + carry = FF C FF 00 7043 ; FF + 00 = FF FF 00 7044 ; FF + 00 + carry = 00 C 80 80 7045 7046 RRA ; C->76543210->C 7047 XOR L ; set bit 0 if shifting required. 7048 7049 EXX ; switch back to main set 7050 EX DE,HL ; full mantissa result now in D'E'D E registers. 7051 POP HL ; restore pointer to result exponent on 7052 ; the calculator stack. 7053 7054 RRA ; has overflow occurred ? 7055 JR NC,<A href="#L1790">L1790</a> ; skip forward if not to TEST-NEG 7056 7057 ; if the addition of two positive mantissas produced overflow or if the 7058 ; addition of two negative mantissas did not then the result exponent has to 7059 ; be incremented and the mantissa shifted one place to the right. 7060 7061 LD A,$01 ; one shift required. 7062 CALL <A href="#L171A">L171A</a> ; routine SHIFT-FP performs a single shift 7063 ; rounding any lost bit 7064 INC (HL) ; increment the exponent. 7065 JR Z,<A href="#L17B3">L17B3</a> ; forward to ADD-REP-6 if the exponent 7066 ; wraps round from FF to zero as number is too 7067 ; big for the system. 7068 7069 ; at this stage the exponent on the calculator stack is correct. 7070 7071 <a name="L1790"></a>;; <b>TEST-NEG</b> 7072 L1790: EXX ; switch in the alternate set. 7073 LD A,L ; load result sign to accumulator. 7074 AND $80 ; isolate bit 7 from sign byte setting zero 7075 ; flag if positive. 7076 EXX ; back to main set. 7077 7078 INC HL ; point to first byte of mantissa 7079 LD (HL),A ; insert $00 positive or $80 negative at 7080 ; position on calculator stack. 7081 7082 DEC HL ; point to exponent again. 7083 JR Z,<A href="#L17B9">L17B9</a> ; forward if positive to GO-NC-MLT 7084 7085 ; a negative number has to be twos-complemented before being placed on stack. 7086 7087 LD A,E ; fetch lowest (rightmost) mantissa byte. 7088 NEG ; Negate 7089 CCF ; Complement Carry Flag 7090 LD E,A ; place back in register 7091 7092 LD A,D ; ditto 7093 CPL ; 7094 ADC A,$00 ; 7095 LD D,A ; 7096 7097 EXX ; switch to higher (leftmost) 16 bits. 7098 7099 LD A,E ; ditto 7100 CPL ; 7101 ADC A,$00 ; 7102 LD E,A ; 7103 7104 LD A,D ; ditto 7105 CPL ; 7106 ADC A,$00 ; 7107 JR NC,<A href="#L17B7">L17B7</a> ; forward without overflow to END-COMPL 7108 7109 ; else entire mantissa is now zero. 00 00 00 00 7110 7111 RRA ; set mantissa to 80 00 00 00 7112 EXX ; switch. 7113 INC (HL) ; increment the exponent. 7114 7115 <a name="L17B3"></a>;; <b>ADD-REP-6</b> 7116 L17B3: JP Z,<A href="#L1880">L1880</a> ; jump forward if exponent now zero to REPORT-6 7117 ; 'Number too big' 7118 7119 EXX ; switch back to alternate set. 7120 7121 <a name="L17B7"></a>;; <b>END-COMPL</b> 7122 L17B7: LD D,A ; put first byte of mantissa back in DE. 7123 EXX ; switch to main set. 7124 7125 <a name="L17B9"></a>;; <b>GO-NC-MLT</b> 7126 L17B9: XOR A ; clear carry flag and 7127 ; clear accumulator so no extra bits carried 7128 ; forward as occurs in multiplication. 7129 7130 JR <A href="#L1828">L1828</a> ; forward to common code at TEST-NORM 7131 ; but should go straight to NORMALIZE. 7132 7133 7134 ; ---------------------------------------------- 7135 ; THE <b><font color=#333388>'PREPARE TO MULTIPLY OR DIVIDE'</font></b> SUBROUTINE 7136 ; ---------------------------------------------- 7137 ; this routine is called twice from multiplication and twice from division 7138 ; to prepare each of the two numbers for the operation. 7139 ; Initially the accumulator holds zero and after the second invocation bit 7 7140 ; of the accumulator will be the sign bit of the result. 7141 7142 <a name="L17BC"></a>;; <b>PREP-M/D</b> 7143 L17BC: SCF ; set carry flag to signal number is zero. 7144 DEC (HL) ; test exponent 7145 INC (HL) ; for zero. 7146 RET Z ; return if zero with carry flag set. 7147 7148 INC HL ; address first mantissa byte. 7149 XOR (HL) ; exclusive or the running sign bit. 7150 SET 7,(HL) ; set the implied bit. 7151 DEC HL ; point to exponent byte. 7152 RET ; return. 7153 7154 ; ------------------------------ 7155 ; THE <b><font color=#333388>'MULTIPLICATION'</font></b> OPERATION 7156 ; ------------------------------ 7157 ; 7158 ; 7159 7160 <a name="L17C6"></a>;; <b>multiply</b> 7161 L17C6: XOR A ; reset bit 7 of running sign flag. 7162 CALL <A href="#L17BC">L17BC</a> ; routine PREP-M/D 7163 RET C ; return if number is zero. 7164 ; zero * anything = zero. 7165 7166 EXX ; - - - 7167 PUSH HL ; save pointer to 'next literal' 7168 EXX ; - - - 7169 7170 PUSH DE ; save pointer to second number 7171 7172 EX DE,HL ; make HL address second number. 7173 7174 CALL <A href="#L17BC">L17BC</a> ; routine PREP-M/D 7175 7176 EX DE,HL ; HL first number, DE - second number 7177 JR C,<A href="#L1830">L1830</a> ; forward with carry to ZERO-RSLT 7178 ; anything * zero = zero. 7179 7180 PUSH HL ; save pointer to first number. 7181 7182 CALL <A href="#L16F7">L16F7</a> ; routine FETCH-TWO fetches two mantissas from 7183 ; calc stack to B'C'C,B D'E'D E 7184 ; (HL will be overwritten but the result sign 7185 ; in A is inserted on the calculator stack) 7186 7187 LD A,B ; transfer low mantissa byte of first number 7188 AND A ; clear carry. 7189 SBC HL,HL ; a short form of LD HL,$0000 to take lower 7190 ; two bytes of result. (2 program bytes) 7191 EXX ; switch in alternate set 7192 PUSH HL ; preserve HL 7193 SBC HL,HL ; set HL to zero also to take higher two bytes 7194 ; of the result and clear carry. 7195 EXX ; switch back. 7196 7197 LD B,$21 ; register B can now be used to count thirty 7198 ; three shifts. 7199 JR <A href="#L17F8">L17F8</a> ; forward to loop entry point STRT-MLT 7200 7201 ; --- 7202 7203 ; The multiplication loop is entered at STRT-LOOP. 7204 7205 <a name="L17E7"></a>;; <b>MLT-LOOP</b> 7206 L17E7: JR NC,<A href="#L17EE">L17EE</a> ; forward if no carry to NO-ADD 7207 7208 ; else add in the multiplicand. 7209 7210 ADD HL,DE ; add the two low bytes to result 7211 EXX ; switch to more significant bytes. 7212 ADC HL,DE ; add high bytes of multiplicand and any carry. 7213 EXX ; switch to main set. 7214 7215 ; in either case shift result right into B'C'C A 7216 7217 <a name="L17EE"></a>;; <b>NO-ADD</b> 7218 L17EE: EXX ; switch to alternate set 7219 RR H ; C > 76543210 > C 7220 RR L ; C > 76543210 > C 7221 EXX ; 7222 RR H ; C > 76543210 > C 7223 RR L ; C > 76543210 > C 7224 7225 <a name="L17F8"></a>;; <b>STRT-MLT</b> 7226 L17F8: EXX ; switch in alternate set. 7227 RR B ; C > 76543210 > C 7228 RR C ; C > 76543210 > C 7229 EXX ; now main set 7230 RR C ; C > 76543210 > C 7231 RRA ; C > 76543210 > C 7232 DJNZ <A href="#L17E7">L17E7</a> ; loop back 33 times to MLT-LOOP 7233 7234 ; 7235 7236 EX DE,HL ; 7237 EXX ; 7238 EX DE,HL ; 7239 EXX ; 7240 POP BC ; 7241 POP HL ; 7242 LD A,B ; 7243 ADD A,C ; 7244 JR NZ,<A href="#L180E">L180E</a> ; forward to MAKE-EXPT 7245 7246 AND A ; 7247 7248 <a name="L180E"></a>;; <b>MAKE-EXPT</b> 7249 L180E: DEC A ; 7250 CCF ; Complement Carry Flag 7251 7252 <a name="L1810"></a>;; <b>DIVN-EXPT</b> 7253 L1810: RLA ; 7254 CCF ; Complement Carry Flag 7255 RRA ; 7256 JP P,<A href="#L1819">L1819</a> ; forward to OFLW1-CLR 7257 7258 JR NC,<A href="#L1880">L1880</a> ; forward to REPORT-6 7259 7260 AND A ; 7261 7262 <a name="L1819"></a>;; <b>OFLW1-CLR</b> 7263 L1819: INC A ; 7264 JR NZ,<A href="#L1824">L1824</a> ; forward to OFLW2-CLR 7265 7266 JR C,<A href="#L1824">L1824</a> ; forward to OFLW2-CLR 7267 7268 EXX ; 7269 BIT 7,D ; 7270 EXX ; 7271 JR NZ,<A href="#L1880">L1880</a> ; forward to REPORT-6 7272 7273 <a name="L1824"></a>;; <b>OFLW2-CLR</b> 7274 L1824: LD (HL),A ; 7275 EXX ; 7276 LD A,B ; 7277 EXX ; 7278 7279 ; addition joins here with carry flag clear. 7280 7281 <a name="L1828"></a>;; <b>TEST-NORM</b> 7282 L1828: JR NC,<A href="#L183F">L183F</a> ; forward to NORMALIZE 7283 7284 LD A,(HL) ; 7285 AND A ; 7286 7287 <a name="L182C"></a>;; <b>NEAR-ZERO</b> 7288 L182C: LD A,$80 ; prepare to rescue the most significant bit 7289 ; of the mantissa if it is set. 7290 JR Z,<A href="#L1831">L1831</a> ; skip forward to SKIP-ZERO 7291 7292 <a name="L1830"></a>;; <b>ZERO-RSLT</b> 7293 L1830: XOR A ; make mask byte zero signaling set five 7294 ; bytes to zero. 7295 7296 <a name="L1831"></a>;; <b>SKIP-ZERO</b> 7297 L1831: EXX ; switch in alternate set 7298 AND D ; isolate most significant bit (if A is $80). 7299 7300 CALL <A href="#L1738">L1738</a> ; routine ZEROS-4/5 sets mantissa without 7301 ; affecting any flags. 7302 7303 RLCA ; test if MSB set. bit 7 goes to bit 0. 7304 ; either $00 -> $00 or $80 -> $01 7305 LD (HL),A ; make exponent $01 (lowest) or $00 zero 7306 JR C,<A href="#L1868">L1868</a> ; forward if first case to OFLOW-CLR 7307 7308 INC HL ; address first mantissa byte on the 7309 ; calculator stack. 7310 LD (HL),A ; insert a zero for the sign bit. 7311 DEC HL ; point to zero exponent 7312 JR <A href="#L1868">L1868</a> ; forward to OFLOW-CLR 7313 7314 ; --- 7315 7316 ; this branch is common to addition and multiplication with the mantissa 7317 ; result still in registers D'E'D E . 7318 7319 <a name="L183F"></a>;; <b>NORMALIZE</b> 7320 L183F: LD B,$20 ; a maximum of thirty-two left shifts will be 7321 ; needed. 7322 7323 <a name="L1841"></a>;; <b>SHIFT-ONE</b> 7324 L1841: EXX ; address higher 16 bits. 7325 BIT 7,D ; test the leftmost bit 7326 EXX ; address lower 16 bits. 7327 7328 JR NZ,<A href="#L1859">L1859</a> ; forward if leftmost bit was set to NORML-NOW 7329 7330 RLCA ; this holds zero from addition, 33rd bit 7331 ; from multiplication. 7332 7333 RL E ; C < 76543210 < C 7334 RL D ; C < 76543210 < C 7335 7336 EXX ; address higher 16 bits. 7337 7338 RL E ; C < 76543210 < C 7339 RL D ; C < 76543210 < C 7340 7341 EXX ; switch to main set. 7342 7343 DEC (HL) ; decrement the exponent byte on the calculator 7344 ; stack. 7345 7346 JR Z,<A href="#L182C">L182C</a> ; back if exponent becomes zero to NEAR-ZERO 7347 ; it's just possible that the last rotation 7348 ; set bit 7 of D. We shall see. 7349 7350 DJNZ <A href="#L1841">L1841</a> ; loop back to SHIFT-ONE 7351 7352 ; if thirty-two left shifts were performed without setting the most significant 7353 ; bit then the result is zero. 7354 7355 JR <A href="#L1830">L1830</a> ; back to ZERO-RSLT 7356 7357 ; --- 7358 7359 <a name="L1859"></a>;; <b>NORML-NOW</b> 7360 L1859: RLA ; for the addition path, A is always zero. 7361 ; for the mult path, ... 7362 7363 JR NC,<A href="#L1868">L1868</a> ; forward to OFLOW-CLR 7364 7365 ; this branch is taken only with multiplication. 7366 7367 CALL <A href="#L1741">L1741</a> ; routine ADD-BACK 7368 7369 JR NZ,<A href="#L1868">L1868</a> ; forward to OFLOW-CLR 7370 7371 EXX ; 7372 LD D,$80 ; 7373 EXX ; 7374 INC (HL) ; 7375 JR Z,<A href="#L1880">L1880</a> ; forward to REPORT-6 7376 7377 ; now transfer the mantissa from the register sets to the calculator stack 7378 ; incorporating the sign bit already there. 7379 7380 <a name="L1868"></a>;; <b>OFLOW-CLR</b> 7381 L1868: PUSH HL ; save pointer to exponent on stack. 7382 INC HL ; address first byte of mantissa which was 7383 ; previously loaded with sign bit $00 or $80. 7384 7385 EXX ; - - - 7386 PUSH DE ; push the most significant two bytes. 7387 EXX ; - - - 7388 7389 POP BC ; pop - true mantissa is now BCDE. 7390 7391 ; now pick up the sign bit. 7392 7393 LD A,B ; first mantissa byte to A 7394 RLA ; rotate out bit 7 which is set 7395 RL (HL) ; rotate sign bit on stack into carry. 7396 RRA ; rotate sign bit into bit 7 of mantissa. 7397 7398 ; and transfer mantissa from main registers to calculator stack. 7399 7400 LD (HL),A ; 7401 INC HL ; 7402 LD (HL),C ; 7403 INC HL ; 7404 LD (HL),D ; 7405 INC HL ; 7406 LD (HL),E ; 7407 7408 POP HL ; restore pointer to num1 now result. 7409 POP DE ; restore pointer to num2 now STKEND. 7410 7411 EXX ; - - - 7412 POP HL ; restore pointer to next calculator literal. 7413 EXX ; - - - 7414 7415 RET ; return. 7416 7417 ; --- 7418 7419 <a name="L1880"></a>;; <b>REPORT-6</b> 7420 L1880: RST 08H ; ERROR-1 7421 DEFB $05 ; Error Report: Arithmetic overflow. 7422 7423 ; ------------------------ 7424 ; THE <b><font color=#333388>'DIVISION'</font></b> OPERATION 7425 ; ------------------------ 7426 ; "Of all the arithmetic subroutines, division is the most complicated and 7427 ; the least understood. It is particularly interesting to note that the 7428 ; Sinclair programmer himself has made a mistake in his programming ( or has 7429 ; copied over someone else's mistake!) for 7430 ; PRINT PEEK 6352 [ $18D0 ] ('unimproved' ROM, 6351 [ $18CF ] ) 7431 ; should give 218 not 225." 7432 ; - Dr. Ian Logan, Syntax magazine Jul/Aug 1982. 7433 ; [ i.e. the jump should be made to div-34th ] 7434 7435 ; First check for division by zero. 7436 7437 <a name="L1882"></a>;; <b>division</b> 7438 L1882: EX DE,HL ; consider the second number first. 7439 XOR A ; set the running sign flag. 7440 CALL <A href="#L17BC">L17BC</a> ; routine PREP-M/D 7441 JR C,<A href="#L1880">L1880</a> ; back if zero to REPORT-6 7442 ; 'Arithmetic overflow' 7443 7444 EX DE,HL ; now prepare first number and check for zero. 7445 CALL <A href="#L17BC">L17BC</a> ; routine PREP-M/D 7446 RET C ; return if zero, 0/anything is zero. 7447 7448 EXX ; - - - 7449 PUSH HL ; save pointer to the next calculator literal. 7450 EXX ; - - - 7451 7452 PUSH DE ; save pointer to divisor - will be STKEND. 7453 PUSH HL ; save pointer to dividend - will be result. 7454 7455 CALL <A href="#L16F7">L16F7</a> ; routine FETCH-TWO fetches the two numbers 7456 ; into the registers H'B'C'C B 7457 ; L'D'E'D E 7458 EXX ; - - - 7459 PUSH HL ; save the two exponents. 7460 7461 LD H,B ; transfer the dividend to H'L'H L 7462 LD L,C ; 7463 EXX ; 7464 LD H,C ; 7465 LD L,B ; 7466 7467 XOR A ; clear carry bit and accumulator. 7468 LD B,$DF ; count upwards from -33 decimal 7469 JR <A href="#L18B2">L18B2</a> ; forward to mid-loop entry point DIV-START 7470 7471 ; --- 7472 7473 <a name="L18A2"></a>;; <b>DIV-LOOP</b> 7474 L18A2: RLA ; multiply partial quotient by two 7475 RL C ; setting result bit from carry. 7476 EXX ; 7477 RL C ; 7478 RL B ; 7479 EXX ; 7480 7481 <a name="L18AB"></a>;; <b>div-34th</b> 7482 L18AB: ADD HL,HL ; 7483 EXX ; 7484 ADC HL,HL ; 7485 EXX ; 7486 JR C,<A href="#L18C2">L18C2</a> ; forward to SUBN-ONLY 7487 7488 <a name="L18B2"></a>;; <b>DIV-START</b> 7489 L18B2: SBC HL,DE ; subtract divisor part. 7490 EXX ; 7491 SBC HL,DE ; 7492 EXX ; 7493 JR NC,<A href="#L18C9">L18C9</a> ; forward if subtraction goes to NO-RSTORE 7494 7495 ADD HL,DE ; else restore 7496 EXX ; 7497 ADC HL,DE ; 7498 EXX ; 7499 AND A ; clear carry 7500 JR <A href="#L18CA">L18CA</a> ; forward to COUNT-ONE 7501 7502 ; --- 7503 7504 <a name="L18C2"></a>;; <b>SUBN-ONLY</b> 7505 L18C2: AND A ; 7506 SBC HL,DE ; 7507 EXX ; 7508 SBC HL,DE ; 7509 EXX ; 7510 7511 <a name="L18C9"></a>;; <b>NO-RSTORE</b> 7512 L18C9: SCF ; set carry flag 7513 7514 <a name="L18CA"></a>;; <b>COUNT-ONE</b> 7515 L18CA: INC B ; increment the counter 7516 JP M,<A href="#L18A2">L18A2</a> ; back while still minus to DIV-LOOP 7517 7518 PUSH AF ; 7519 JR Z,<A href="#L18B2">L18B2</a> ; back to DIV-START 7520 7521 ; "This jump is made to the wrong place. No 34th bit will ever be obtained 7522 ; without first shifting the dividend. Hence important results like 1/10 and 7523 ; 1/1000 are not rounded up as they should be. Rounding up never occurs when 7524 ; it depends on the 34th bit. The jump should be made to div-34th above." 7525 ; - Dr. Frank O'Hara, "The Complete Spectrum ROM Disassembly", 1983, 7526 ; published by Melbourne House. 7527 ; (<font color=#9900FF>Note.</font> on the ZX81 this would be JR Z,L18AB) 7528 ; 7529 ; However if you make this change, then while (1/2=.5) will now evaluate as 7530 ; true, (.25=1/4), which did evaluate as true, no longer does. 7531 7532 LD E,A ; 7533 LD D,C ; 7534 EXX ; 7535 LD E,C ; 7536 LD D,B ; 7537 7538 POP AF ; 7539 RR B ; 7540 POP AF ; 7541 RR B ; 7542 7543 EXX ; 7544 POP BC ; 7545 POP HL ; 7546 LD A,B ; 7547 SUB C ; 7548 JP <A href="#L1810">L1810</a> ; jump back to DIVN-EXPT 7549 7550 ; ------------------------------------------------ 7551 ; THE <b><font color=#333388>'INTEGER TRUNCATION TOWARDS ZERO'</font></b> SUBROUTINE 7552 ; ------------------------------------------------ 7553 ; 7554 7555 <a name="L18E4"></a>;; <b>truncate</b> 7556 L18E4: LD A,(HL) ; fetch exponent 7557 CP $81 ; compare to +1 7558 JR NC,<A href="#L18EF">L18EF</a> ; forward, if 1 or more, to T-GR-ZERO 7559 7560 ; else the number is smaller than plus or minus 1 and can be made zero. 7561 7562 LD (HL),$00 ; make exponent zero. 7563 LD A,$20 ; prepare to set 32 bits of mantissa to zero. 7564 JR <A href="#L18F4">L18F4</a> ; forward to NIL-BYTES 7565 7566 ; --- 7567 7568 <a name="L18EF"></a>;; <b>T-GR-ZERO</b> 7569 L18EF: SUB $A0 ; subtract +32 from exponent 7570 RET P ; return if result is positive as all 32 bits 7571 ; of the mantissa relate to the integer part. 7572 ; The floating point is somewhere to the right 7573 ; of the mantissa 7574 7575 NEG ; else negate to form number of rightmost bits 7576 ; to be blanked. 7577 7578 ; for instance, disregarding the sign bit, the number 3.5 is held as 7579 ; exponent $82 mantissa .11100000 00000000 00000000 00000000 7580 ; we need to set $82 - $A0 = $E2 NEG = $1E (thirty) bits to zero to form the 7581 ; integer. 7582 ; The sign of the number is never considered as the first bit of the mantissa 7583 ; must be part of the integer. 7584 7585 <a name="L18F4"></a>;; <b>NIL-BYTES</b> 7586 L18F4: PUSH DE ; save pointer to STKEND 7587 EX DE,HL ; HL points at STKEND 7588 DEC HL ; now at last byte of mantissa. 7589 LD B,A ; Transfer bit count to B register. 7590 SRL B ; divide by 7591 SRL B ; eight 7592 SRL B ; 7593 JR Z,<A href="#L1905">L1905</a> ; forward if zero to BITS-ZERO 7594 7595 ; else the original count was eight or more and whole bytes can be blanked. 7596 7597 <a name="L1900"></a>;; <b>BYTE-ZERO</b> 7598 L1900: LD (HL),$00 ; set eight bits to zero. 7599 DEC HL ; point to more significant byte of mantissa. 7600 DJNZ <A href="#L1900">L1900</a> ; loop back to BYTE-ZERO 7601 7602 ; now consider any residual bits. 7603 7604 <a name="L1905"></a>;; <b>BITS-ZERO</b> 7605 L1905: AND $07 ; isolate the remaining bits 7606 JR Z,<A href="#L1912">L1912</a> ; forward if none to IX-END 7607 7608 LD B,A ; transfer bit count to B counter. 7609 LD A,$FF ; form a mask 11111111 7610 7611 <a name="L190C"></a>;; <b>LESS-MASK</b> 7612 L190C: SLA A ; 1 <- 76543210 <- o slide mask leftwards. 7613 DJNZ <A href="#L190C">L190C</a> ; loop back for bit count to LESS-MASK 7614 7615 AND (HL) ; lose the unwanted rightmost bits 7616 LD (HL),A ; and place in mantissa byte. 7617 7618 <a name="L1912"></a>;; <b>IX-END</b> 7619 L1912: EX DE,HL ; restore result pointer from DE. 7620 POP DE ; restore STKEND from stack. 7621 RET ; return. 7622 7623 7624 ;******************************** 7625 ;** FLOATING-POINT CALCULATOR ** 7626 ;******************************** 7627 7628 ; As a general rule the calculator avoids using the IY register. 7629 ; Exceptions are val and str$. 7630 ; So an assembly language programmer who has disabled interrupts to use IY 7631 ; for other purposes can still use the calculator for mathematical 7632 ; purposes. 7633 7634 7635 ; ------------------------ 7636 ; THE <b><font color=#333388>'TABLE OF CONSTANTS'</font></b> 7637 ; ------------------------ 7638 ; The ZX81 has only floating-point number representation. 7639 ; Both the ZX80 and the ZX Spectrum have integer numbers in some form. 7640 7641 <a name="L1915"></a>;; <b>stk-zero</b> 00 00 00 00 00 7642 L1915: DEFB $00 ;;Bytes: 1 7643 DEFB $B0 ;;Exponent $00 7644 DEFB $00 ;;(+00,+00,+00) 7645 7646 <a name="L1918"></a>;; <b>stk-one</b> 81 00 00 00 00 7647 L1918: DEFB $31 ;;Exponent $81, Bytes: 1 7648 DEFB $00 ;;(+00,+00,+00) 7649 7650 7651 <a name="L191A"></a>;; <b>stk-half</b> 80 00 00 00 00 7652 L191A: DEFB $30 ;;Exponent: $80, Bytes: 1 7653 DEFB $00 ;;(+00,+00,+00) 7654 7655 7656 <a name="L191C"></a>;; <b>stk-pi/2</b> 81 49 0F DA A2 7657 L191C: DEFB $F1 ;;Exponent: $81, Bytes: 4 7658 DEFB $49,$0F,$DA,$A2 ;; 7659 7660 <a name="L1921"></a>;; <b>stk-ten</b> 84 20 00 00 00 7661 L1921: DEFB $34 ;;Exponent: $84, Bytes: 1 7662 DEFB $20 ;;(+00,+00,+00) 7663 7664 7665 ; ------------------------ 7666 ; THE <b><font color=#333388>'TABLE OF ADDRESSES'</font></b> 7667 ; ------------------------ 7668 ; 7669 ; starts with binary operations which have two operands and one result. 7670 ; three pseudo binary operations first. 7671 7672 <a name="L1923"></a>;; <b>tbl-addrs</b> 7673 L1923: DEFW <A href="#L1C2F">L1C2F</a> ; $00 Address: $1C2F - jump-true 7674 DEFW <A href="#L1A72">L1A72</a> ; $01 Address: $1A72 - exchange 7675 DEFW <A href="#L19E3">L19E3</a> ; $02 Address: $19E3 - delete 7676 7677 ; true binary operations. 7678 7679 DEFW <A href="#L174C">L174C</a> ; $03 Address: $174C - subtract 7680 DEFW <A href="#L17C6">L17C6</a> ; $04 Address: $176C - multiply 7681 DEFW <A href="#L1882">L1882</a> ; $05 Address: $1882 - division 7682 DEFW <A href="#L1DE2">L1DE2</a> ; $06 Address: $1DE2 - to-power 7683 DEFW <A href="#L1AED">L1AED</a> ; $07 Address: $1AED - or 7684 7685 DEFW <A href="#L1AF3">L1AF3</a> ; $08 Address: $1B03 - no-&-no 7686 DEFW <A href="#L1B03">L1B03</a> ; $09 Address: $1B03 - no-l-eql 7687 DEFW <A href="#L1B03">L1B03</a> ; $0A Address: $1B03 - no-gr-eql 7688 DEFW <A href="#L1B03">L1B03</a> ; $0B Address: $1B03 - nos-neql 7689 DEFW <A href="#L1B03">L1B03</a> ; $0C Address: $1B03 - no-grtr 7690 DEFW <A href="#L1B03">L1B03</a> ; $0D Address: $1B03 - no-less 7691 DEFW <A href="#L1B03">L1B03</a> ; $0E Address: $1B03 - nos-eql 7692 DEFW <A href="#L1755">L1755</a> ; $0F Address: $1755 - addition 7693 7694 DEFW <A href="#L1AF8">L1AF8</a> ; $10 Address: $1AF8 - str-&-no 7695 DEFW <A href="#L1B03">L1B03</a> ; $11 Address: $1B03 - str-l-eql 7696 DEFW <A href="#L1B03">L1B03</a> ; $12 Address: $1B03 - str-gr-eql 7697 DEFW <A href="#L1B03">L1B03</a> ; $13 Address: $1B03 - strs-neql 7698 DEFW <A href="#L1B03">L1B03</a> ; $14 Address: $1B03 - str-grtr 7699 DEFW <A href="#L1B03">L1B03</a> ; $15 Address: $1B03 - str-less 7700 DEFW <A href="#L1B03">L1B03</a> ; $16 Address: $1B03 - strs-eql 7701 DEFW <A href="#L1B62">L1B62</a> ; $17 Address: $1B62 - strs-add 7702 7703 ; unary follow 7704 7705 DEFW <A href="#L1AA0">L1AA0</a> ; $18 Address: $1AA0 - neg 7706 7707 DEFW <A href="#L1C06">L1C06</a> ; $19 Address: $1C06 - code 7708 DEFW <A href="#L1BA4">L1BA4</a> ; $1A Address: $1BA4 - val 7709 DEFW <A href="#L1C11">L1C11</a> ; $1B Address: $1C11 - len 7710 DEFW <A href="#L1D49">L1D49</a> ; $1C Address: $1D49 - sin 7711 DEFW <A href="#L1D3E">L1D3E</a> ; $1D Address: $1D3E - cos 7712 DEFW <A href="#L1D6E">L1D6E</a> ; $1E Address: $1D6E - tan 7713 DEFW <A href="#L1DC4">L1DC4</a> ; $1F Address: $1DC4 - asn 7714 DEFW <A href="#L1DD4">L1DD4</a> ; $20 Address: $1DD4 - acs 7715 DEFW <A href="#L1D76">L1D76</a> ; $21 Address: $1D76 - atn 7716 DEFW <A href="#L1CA9">L1CA9</a> ; $22 Address: $1CA9 - ln 7717 DEFW <A href="#L1C5B">L1C5B</a> ; $23 Address: $1C5B - exp 7718 DEFW <A href="#L1C46">L1C46</a> ; $24 Address: $1C46 - int 7719 DEFW <A href="#L1DDB">L1DDB</a> ; $25 Address: $1DDB - sqr 7720 DEFW <A href="#L1AAF">L1AAF</a> ; $26 Address: $1AAF - sgn 7721 DEFW <A href="#L1AAA">L1AAA</a> ; $27 Address: $1AAA - abs 7722 DEFW <A href="#L1ABE">L1ABE</a> ; $28 Address: $1A1B - peek 7723 DEFW <A href="#L1AC5">L1AC5</a> ; $29 Address: $1AC5 - usr-no 7724 DEFW <A href="#L1BD5">L1BD5</a> ; $2A Address: $1BD5 - str$ 7725 DEFW <A href="#L1B8F">L1B8F</a> ; $2B Address: $1B8F - chrs 7726 DEFW <A href="#L1AD5">L1AD5</a> ; $2C Address: $1AD5 - not 7727 7728 ; end of true unary 7729 7730 DEFW <A href="#L19F6">L19F6</a> ; $2D Address: $19F6 - duplicate 7731 DEFW <A href="#L1C37">L1C37</a> ; $2E Address: $1C37 - n-mod-m 7732 7733 DEFW <A href="#L1C23">L1C23</a> ; $2F Address: $1C23 - jump 7734 DEFW <A href="#L19FC">L19FC</a> ; $30 Address: $19FC - stk-data 7735 7736 DEFW <A href="#L1C17">L1C17</a> ; $31 Address: $1C17 - dec-jr-nz 7737 DEFW <A href="#L1ADB">L1ADB</a> ; $32 Address: $1ADB - less-0 7738 DEFW <A href="#L1ACE">L1ACE</a> ; $33 Address: $1ACE - greater-0 7739 DEFW <A href="#L002B">L002B</a> ; $34 Address: $002B - end-calc 7740 DEFW <A href="#L1D18">L1D18</a> ; $35 Address: $1D18 - get-argt 7741 DEFW <A href="#L18E4">L18E4</a> ; $36 Address: $18E4 - truncate 7742 DEFW <A href="#L19E4">L19E4</a> ; $37 Address: $19E4 - fp-calc-2 7743 DEFW <A href="#L155A">L155A</a> ; $38 Address: $155A - e-to-fp 7744 7745 ; the following are just the next available slots for the 128 compound literals 7746 ; which are in range $80 - $FF. 7747 7748 DEFW <A href="#L1A7F">L1A7F</a> ; $39 Address: $1A7F - series-xx $80 - $9F. 7749 DEFW <A href="#L1A51">L1A51</a> ; $3A Address: $1A51 - stk-const-xx $A0 - $BF. 7750 DEFW <A href="#L1A63">L1A63</a> ; $3B Address: $1A63 - st-mem-xx $C0 - $DF. 7751 DEFW <A href="#L1A45">L1A45</a> ; $3C Address: $1A45 - get-mem-xx $E0 - $FF. 7752 7753 ; Aside: 3D - 7F are therefore unused calculator literals. 7754 ; 39 - 7B would be available for expansion. 7755 7756 ; ------------------------------- 7757 ; THE <b><font color=#333388>'FLOATING POINT CALCULATOR'</font></b> 7758 ; ------------------------------- 7759 ; 7760 ; 7761 7762 <a name="L199D"></a>;; <b>CALCULATE</b> 7763 L199D: CALL <A href="#L1B85">L1B85</a> ; routine STK-PNTRS is called to set up the 7764 ; calculator stack pointers for a default 7765 ; unary operation. HL = last value on stack. 7766 ; DE = STKEND first location after stack. 7767 7768 ; the calculate routine is called at this point by the series generator... 7769 7770 <a name="L19A0"></a>;; <b>GEN-ENT-1</b> 7771 L19A0: LD A,B ; fetch the Z80 B register to A 7772 LD ($401E),A ; and store value in system variable BREG. 7773 ; this will be the counter for dec-jr-nz 7774 ; or if used from fp-calc2 the calculator 7775 ; instruction. 7776 7777 ; ... and again later at this point 7778 7779 <a name="L19A4"></a>;; <b>GEN-ENT-2</b> 7780 L19A4: EXX ; switch sets 7781 EX (SP),HL ; and store the address of next instruction, 7782 ; the return address, in H'L'. 7783 ; If this is a recursive call then the H'L' 7784 ; of the previous invocation goes on stack. 7785 ; c.f. end-calc. 7786 EXX ; switch back to main set. 7787 7788 ; this is the re-entry looping point when handling a string of literals. 7789 7790 <a name="L19A7"></a>;; <b>RE-ENTRY</b> 7791 L19A7: LD ($401C),DE ; save end of stack in system variable STKEND 7792 EXX ; switch to alt 7793 LD A,(HL) ; get next literal 7794 INC HL ; increase pointer' 7795 7796 ; single operation jumps back to here 7797 7798 <a name="L19AE"></a>;; <b>SCAN-ENT</b> 7799 L19AE: PUSH HL ; save pointer on stack * 7800 AND A ; now test the literal 7801 JP P,<A href="#L19C2">L19C2</a> ; forward to FIRST-3D if in range $00 - $3D 7802 ; anything with bit 7 set will be one of 7803 ; 128 compound literals. 7804 7805 ; compound literals have the following format. 7806 ; bit 7 set indicates compound. 7807 ; bits 6-5 the subgroup 0-3. 7808 ; bits 4-0 the embedded parameter $00 - $1F. 7809 ; The subgroup 0-3 needs to be manipulated to form the next available four 7810 ; address places after the simple literals in the address table. 7811 7812 LD D,A ; save literal in D 7813 AND $60 ; and with 01100000 to isolate subgroup 7814 RRCA ; rotate bits 7815 RRCA ; 4 places to right 7816 RRCA ; not five as we need offset * 2 7817 RRCA ; 00000xx0 7818 ADD A,$72 ; add ($39 * 2) to give correct offset. 7819 ; alter above if you add more literals. 7820 LD L,A ; store in L for later indexing. 7821 LD A,D ; bring back compound literal 7822 AND $1F ; use mask to isolate parameter bits 7823 JR <A href="#L19D0">L19D0</a> ; forward to ENT-TABLE 7824 7825 ; --- 7826 7827 ; the branch was here with simple literals. 7828 7829 <a name="L19C2"></a>;; <b>FIRST-3D</b> 7830 L19C2: CP $18 ; compare with first unary operations. 7831 JR NC,<A href="#L19CE">L19CE</a> ; to DOUBLE-A with unary operations 7832 7833 ; it is binary so adjust pointers. 7834 7835 EXX ; 7836 LD BC,$FFFB ; the value -5 7837 LD D,H ; transfer HL, the last value, to DE. 7838 LD E,L ; 7839 ADD HL,BC ; subtract 5 making HL point to second 7840 ; value. 7841 EXX ; 7842 7843 <a name="L19CE"></a>;; <b>DOUBLE-A</b> 7844 L19CE: RLCA ; double the literal 7845 LD L,A ; and store in L for indexing 7846 7847 <a name="L19D0"></a>;; <b>ENT-TABLE</b> 7848 L19D0: LD DE,<A href="#L1923">L1923</a> ; Address: tbl-addrs 7849 LD H,$00 ; prepare to index 7850 ADD HL,DE ; add to get address of routine 7851 LD E,(HL) ; low byte to E 7852 INC HL ; 7853 LD D,(HL) ; high byte to D 7854 7855 LD HL,<A href="#L19A7">L19A7</a> ; Address: RE-ENTRY 7856 EX (SP),HL ; goes on machine stack 7857 ; address of next literal goes to HL. * 7858 7859 7860 PUSH DE ; now the address of routine is stacked. 7861 EXX ; back to main set 7862 ; avoid using IY register. 7863 LD BC,($401D) ; STKEND_hi 7864 ; nothing much goes to C but BREG to B 7865 ; and continue into next ret instruction 7866 ; which has a dual identity 7867 7868 7869 ; ----------------------- 7870 ; THE <b><font color=#333388>'DELETE'</font></b> SUBROUTINE 7871 ; ----------------------- 7872 ; offset $02: 'delete' 7873 ; A simple return but when used as a calculator literal this 7874 ; deletes the last value from the calculator stack. 7875 ; On entry, as always with binary operations, 7876 ; HL=first number, DE=second number 7877 ; On exit, HL=result, DE=stkend. 7878 ; So nothing to do 7879 7880 <a name="L19E3"></a>;; <b>delete</b> 7881 L19E3: RET ; return - indirect jump if from above. 7882 7883 ; --------------------------------- 7884 ; THE <b><font color=#333388>'SINGLE OPERATION'</font></b> SUBROUTINE 7885 ; --------------------------------- 7886 ; offset $37: 'fp-calc-2' 7887 ; this single operation is used, in the first instance, to evaluate most 7888 ; of the mathematical and string functions found in BASIC expressions. 7889 7890 <a name="L19E4"></a>;; <b>fp-calc-2</b> 7891 L19E4: POP AF ; drop return address. 7892 LD A,($401E) ; load accumulator from system variable BREG 7893 ; value will be literal eg. 'tan' 7894 EXX ; switch to alt 7895 JR <A href="#L19AE">L19AE</a> ; back to SCAN-ENT 7896 ; next literal will be end-calc in scanning 7897 7898 ; ------------------------------ 7899 ; THE <b><font color=#333388>'TEST 5 SPACES'</font></b> SUBROUTINE 7900 ; ------------------------------ 7901 ; This routine is called from MOVE-FP, STK-CONST and STK-STORE to 7902 ; test that there is enough space between the calculator stack and the 7903 ; machine stack for another five-byte value. It returns with BC holding 7904 ; the value 5 ready for any subsequent LDIR. 7905 7906 <a name="L19EB"></a>;; <b>TEST-5-SP</b> 7907 L19EB: PUSH DE ; save 7908 PUSH HL ; registers 7909 LD BC,$0005 ; an overhead of five bytes 7910 CALL <A href="#L0EC5">L0EC5</a> ; routine TEST-ROOM tests free RAM raising 7911 ; an error if not. 7912 POP HL ; else restore 7913 POP DE ; registers. 7914 RET ; return with BC set at 5. 7915 7916 7917 ; --------------------------------------------- 7918 ; THE <b><font color=#333388>'MOVE A FLOATING POINT NUMBER'</font></b> SUBROUTINE 7919 ; --------------------------------------------- 7920 ; offset $2D: 'duplicate' 7921 ; This simple routine is a 5-byte LDIR instruction 7922 ; that incorporates a memory check. 7923 ; When used as a calculator literal it duplicates the last value on the 7924 ; calculator stack. 7925 ; Unary so on entry HL points to last value, DE to stkend 7926 7927 <a name="L19F6"></a>;; <b>duplicate</b> 7928 <a name="L19F6"></a>;; <b>MOVE-FP</b> 7929 L19F6: CALL <A href="#L19EB">L19EB</a> ; routine TEST-5-SP test free memory 7930 ; and sets BC to 5. 7931 LDIR ; copy the five bytes. 7932 RET ; return with DE addressing new STKEND 7933 ; and HL addressing new last value. 7934 7935 ; ------------------------------- 7936 ; THE <b><font color=#333388>'STACK LITERALS'</font></b> SUBROUTINE 7937 ; ------------------------------- 7938 ; offset $30: 'stk-data' 7939 ; When a calculator subroutine needs to put a value on the calculator 7940 ; stack that is not a regular constant this routine is called with a 7941 ; variable number of following data bytes that convey to the routine 7942 ; the floating point form as succinctly as is possible. 7943 7944 <a name="L19FC"></a>;; <b>stk-data</b> 7945 L19FC: LD H,D ; transfer STKEND 7946 LD L,E ; to HL for result. 7947 7948 <a name="L19FE"></a>;; <b>STK-CONST</b> 7949 L19FE: CALL <A href="#L19EB">L19EB</a> ; routine TEST-5-SP tests that room exists 7950 ; and sets BC to $05. 7951 7952 EXX ; switch to alternate set 7953 PUSH HL ; save the pointer to next literal on stack 7954 EXX ; switch back to main set 7955 7956 EX (SP),HL ; pointer to HL, destination to stack. 7957 7958 PUSH BC ; save BC - value 5 from test room ??. 7959 7960 LD A,(HL) ; fetch the byte following 'stk-data' 7961 AND $C0 ; isolate bits 7 and 6 7962 RLCA ; rotate 7963 RLCA ; to bits 1 and 0 range $00 - $03. 7964 LD C,A ; transfer to C 7965 INC C ; and increment to give number of bytes 7966 ; to read. $01 - $04 7967 LD A,(HL) ; reload the first byte 7968 AND $3F ; mask off to give possible exponent. 7969 JR NZ,<A href="#L1A14">L1A14</a> ; forward to FORM-EXP if it was possible to 7970 ; include the exponent. 7971 7972 ; else byte is just a byte count and exponent comes next. 7973 7974 INC HL ; address next byte and 7975 LD A,(HL) ; pick up the exponent ( - $50). 7976 7977 <a name="L1A14"></a>;; <b>FORM-EXP</b> 7978 L1A14: ADD A,$50 ; now add $50 to form actual exponent 7979 LD (DE),A ; and load into first destination byte. 7980 LD A,$05 ; load accumulator with $05 and 7981 SUB C ; subtract C to give count of trailing 7982 ; zeros plus one. 7983 INC HL ; increment source 7984 INC DE ; increment destination 7985 LD B,$00 ; prepare to copy 7986 LDIR ; copy C bytes 7987 7988 POP BC ; restore 5 counter to BC ??. 7989 7990 EX (SP),HL ; put HL on stack as next literal pointer 7991 ; and the stack value - result pointer - 7992 ; to HL. 7993 7994 EXX ; switch to alternate set. 7995 POP HL ; restore next literal pointer from stack 7996 ; to H'L'. 7997 EXX ; switch back to main set. 7998 7999 LD B,A ; zero count to B 8000 XOR A ; clear accumulator 8001 8002 <a name="L1A27"></a>;; <b>STK-ZEROS</b> 8003 L1A27: DEC B ; decrement B counter 8004 RET Z ; return if zero. >> 8005 ; DE points to new STKEND 8006 ; HL to new number. 8007 8008 LD (DE),A ; else load zero to destination 8009 INC DE ; increase destination 8010 JR <A href="#L1A27">L1A27</a> ; loop back to STK-ZEROS until done. 8011 8012 ; ------------------------------- 8013 ; THE <b><font color=#333388>'SKIP CONSTANTS'</font></b> SUBROUTINE 8014 ; ------------------------------- 8015 ; This routine traverses variable-length entries in the table of constants, 8016 ; stacking intermediate, unwanted constants onto a dummy calculator stack, 8017 ; in the first five bytes of the ZX81 ROM. 8018 8019 <a name="L1A2D"></a>;; <b>SKIP-CONS</b> 8020 L1A2D: AND A ; test if initially zero. 8021 8022 <a name="L1A2E"></a>;; <b>SKIP-NEXT</b> 8023 L1A2E: RET Z ; return if zero. >> 8024 8025 PUSH AF ; save count. 8026 PUSH DE ; and normal STKEND 8027 8028 LD DE,$0000 ; dummy value for STKEND at start of ROM 8029 ; <font color=#9900FF>Note.</font> not a fault but this has to be 8030 ; moved elsewhere when running in RAM. 8031 ; 8032 CALL <A href="#L19FE">L19FE</a> ; routine STK-CONST works through variable 8033 ; length records. 8034 8035 POP DE ; restore real STKEND 8036 POP AF ; restore count 8037 DEC A ; decrease 8038 JR <A href="#L1A2E">L1A2E</a> ; loop back to SKIP-NEXT 8039 8040 ; -------------------------------- 8041 ; THE <b><font color=#333388>'MEMORY LOCATION'</font></b> SUBROUTINE 8042 ; -------------------------------- 8043 ; This routine, when supplied with a base address in HL and an index in A, 8044 ; will calculate the address of the A'th entry, where each entry occupies 8045 ; five bytes. It is used for addressing floating-point numbers in the 8046 ; calculator's memory area. 8047 8048 <a name="L1A3C"></a>;; <b>LOC-MEM</b> 8049 L1A3C: LD C,A ; store the original number $00-$1F. 8050 RLCA ; double. 8051 RLCA ; quadruple. 8052 ADD A,C ; now add original value to multiply by five. 8053 8054 LD C,A ; place the result in C. 8055 LD B,$00 ; set B to 0. 8056 ADD HL,BC ; add to form address of start of number in HL. 8057 8058 RET ; return. 8059 8060 ; ------------------------------------- 8061 ; THE <b><font color=#333388>'GET FROM MEMORY AREA'</font></b> SUBROUTINE 8062 ; ------------------------------------- 8063 ; offsets $E0 to $FF: 'get-mem-0', 'get-mem-1' etc. 8064 ; A holds $00-$1F offset. 8065 ; The calculator stack increases by 5 bytes. 8066 8067 <a name="L1A45"></a>;; <b>get-mem-xx</b> 8068 L1A45: PUSH DE ; save STKEND 8069 LD HL,($401F) ; MEM is base address of the memory cells. 8070 CALL <A href="#L1A3C">L1A3C</a> ; routine LOC-MEM so that HL = first byte 8071 CALL <A href="#L19F6">L19F6</a> ; routine MOVE-FP moves 5 bytes with memory 8072 ; check. 8073 ; DE now points to new STKEND. 8074 POP HL ; the original STKEND is now RESULT pointer. 8075 RET ; return. 8076 8077 ; --------------------------------- 8078 ; THE <b><font color=#333388>'STACK A CONSTANT'</font></b> SUBROUTINE 8079 ; --------------------------------- 8080 ; offset $A0: 'stk-zero' 8081 ; offset $A1: 'stk-one' 8082 ; offset $A2: 'stk-half' 8083 ; offset $A3: 'stk-pi/2' 8084 ; offset $A4: 'stk-ten' 8085 ; This routine allows a one-byte instruction to stack up to 32 constants 8086 ; held in short form in a table of constants. In fact only 5 constants are 8087 ; required. On entry the A register holds the literal ANDed with $1F. 8088 ; It isn't very efficient and it would have been better to hold the 8089 ; numbers in full, five byte form and stack them in a similar manner 8090 ; to that which would be used later for semi-tone table values. 8091 8092 <a name="L1A51"></a>;; <b>stk-const-xx</b> 8093 L1A51: LD H,D ; save STKEND - required for result 8094 LD L,E ; 8095 EXX ; swap 8096 PUSH HL ; save pointer to next literal 8097 LD HL,<A href="#L1915">L1915</a> ; Address: stk-zero - start of table of 8098 ; constants 8099 EXX ; 8100 CALL <A href="#L1A2D">L1A2D</a> ; routine SKIP-CONS 8101 CALL <A href="#L19FE">L19FE</a> ; routine STK-CONST 8102 EXX ; 8103 POP HL ; restore pointer to next literal. 8104 EXX ; 8105 RET ; return. 8106 8107 ; --------------------------------------- 8108 ; THE <b><font color=#333388>'STORE IN A MEMORY AREA'</font></b> SUBROUTINE 8109 ; --------------------------------------- 8110 ; Offsets $C0 to $DF: 'st-mem-0', 'st-mem-1' etc. 8111 ; Although 32 memory storage locations can be addressed, only six 8112 ; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5) 8113 ; required for these are allocated. ZX81 programmers who wish to 8114 ; use the floating point routines from assembly language may wish to 8115 ; alter the system variable MEM to point to 160 bytes of RAM to have 8116 ; use the full range available. 8117 ; A holds derived offset $00-$1F. 8118 ; Unary so on entry HL points to last value, DE to STKEND. 8119 8120 <a name="L1A63"></a>;; <b>st-mem-xx</b> 8121 L1A63: PUSH HL ; save the result pointer. 8122 EX DE,HL ; transfer to DE. 8123 LD HL,($401F) ; fetch MEM the base of memory area. 8124 CALL <A href="#L1A3C">L1A3C</a> ; routine LOC-MEM sets HL to the destination. 8125 EX DE,HL ; swap - HL is start, DE is destination. 8126 CALL <A href="#L19F6">L19F6</a> ; routine MOVE-FP. 8127 ; note. a short ld bc,5; ldir 8128 ; the embedded memory check is not required 8129 ; so these instructions would be faster! 8130 EX DE,HL ; DE = STKEND 8131 POP HL ; restore original result pointer 8132 RET ; return. 8133 8134 ; ------------------------- 8135 ; THE <b><font color=#333388>'EXCHANGE'</font></b> SUBROUTINE 8136 ; ------------------------- 8137 ; offset $01: 'exchange' 8138 ; This routine exchanges the last two values on the calculator stack 8139 ; On entry, as always with binary operations, 8140 ; HL=first number, DE=second number 8141 ; On exit, HL=result, DE=stkend. 8142 8143 <a name="L1A72"></a>;; <b>exchange</b> 8144 L1A72: LD B,$05 ; there are five bytes to be swapped 8145 8146 ; start of loop. 8147 8148 <a name="L1A74"></a>;; <b>SWAP-BYTE</b> 8149 L1A74: LD A,(DE) ; each byte of second 8150 LD C,(HL) ; each byte of first 8151 EX DE,HL ; swap pointers 8152 LD (DE),A ; store each byte of first 8153 LD (HL),C ; store each byte of second 8154 INC HL ; advance both 8155 INC DE ; pointers. 8156 DJNZ <A href="#L1A74">L1A74</a> ; loop back to SWAP-BYTE until all 5 done. 8157 8158 EX DE,HL ; even up the exchanges 8159 ; so that DE addresses STKEND. 8160 RET ; return. 8161 8162 ; --------------------------------- 8163 ; THE <b><font color=#333388>'SERIES GENERATOR'</font></b> SUBROUTINE 8164 ; --------------------------------- 8165 ; offset $86: 'series-06' 8166 ; offset $88: 'series-08' 8167 ; offset $8C: 'series-0C' 8168 ; The ZX81 uses Chebyshev polynomials to generate approximations for 8169 ; SIN, ATN, LN and EXP. These are named after the Russian mathematician 8170 ; Pafnuty Chebyshev, born in 1821, who did much pioneering work on numerical 8171 ; series. As far as calculators are concerned, Chebyshev polynomials have an 8172 ; advantage over other series, for example the Taylor series, as they can 8173 ; reach an approximation in just six iterations for SIN, eight for EXP and 8174 ; twelve for LN and ATN. The mechanics of the routine are interesting but 8175 ; for full treatment of how these are generated with demonstrations in 8176 ; Sinclair BASIC see "The Complete Spectrum ROM Disassembly" by Dr Ian Logan 8177 ; and Dr Frank O'Hara, published 1983 by Melbourne House. 8178 8179 <a name="L1A7F"></a>;; <b>series-xx</b> 8180 L1A7F: LD B,A ; parameter $00 - $1F to B counter 8181 CALL <A href="#L19A0">L19A0</a> ; routine GEN-ENT-1 is called. 8182 ; A recursive call to a special entry point 8183 ; in the calculator that puts the B register 8184 ; in the system variable BREG. The return 8185 ; address is the next location and where 8186 ; the calculator will expect its first 8187 ; instruction - now pointed to by HL'. 8188 ; The previous pointer to the series of 8189 ; five-byte numbers goes on the machine stack. 8190 8191 ; The initialization phase. 8192 8193 DEFB $2D ;;duplicate x,x 8194 DEFB $0F ;;addition x+x 8195 DEFB $C0 ;;st-mem-0 x+x 8196 DEFB $02 ;;delete . 8197 DEFB $A0 ;;stk-zero 0 8198 DEFB $C2 ;;st-mem-2 0 8199 8200 ; a loop is now entered to perform the algebraic calculation for each of 8201 ; the numbers in the series 8202 8203 <a name="L1A89"></a>;; <b>G-LOOP</b> 8204 L1A89: DEFB $2D ;;duplicate v,v. 8205 DEFB $E0 ;;get-mem-0 v,v,x+2 8206 DEFB $04 ;;multiply v,v*x+2 8207 DEFB $E2 ;;get-mem-2 v,v*x+2,v 8208 DEFB $C1 ;;st-mem-1 8209 DEFB $03 ;;subtract 8210 DEFB $34 ;;end-calc 8211 8212 ; the previous pointer is fetched from the machine stack to H'L' where it 8213 ; addresses one of the numbers of the series following the series literal. 8214 8215 CALL <A href="#L19FC">L19FC</a> ; routine STK-DATA is called directly to 8216 ; push a value and advance H'L'. 8217 CALL <A href="#L19A4">L19A4</a> ; routine GEN-ENT-2 recursively re-enters 8218 ; the calculator without disturbing 8219 ; system variable BREG 8220 ; H'L' value goes on the machine stack and is 8221 ; then loaded as usual with the next address. 8222 8223 DEFB $0F ;;addition 8224 DEFB $01 ;;exchange 8225 DEFB $C2 ;;st-mem-2 8226 DEFB $02 ;;delete 8227 8228 DEFB $31 ;;dec-jr-nz 8229 DEFB $EE ;;back to <A href="#L1A89">L1A89</a>, G-LOOP 8230 8231 ; when the counted loop is complete the final subtraction yields the result 8232 ; for example SIN X. 8233 8234 DEFB $E1 ;;get-mem-1 8235 DEFB $03 ;;subtract 8236 DEFB $34 ;;end-calc 8237 8238 RET ; return with H'L' pointing to location 8239 ; after last number in series. 8240 8241 ; ----------------------- 8242 ; Handle unary minus (18) 8243 ; ----------------------- 8244 ; Unary so on entry HL points to last value, DE to STKEND. 8245 8246 <a name="L1AA0"></a>;; <b>NEGATE</b> 8247 <a name="L1AA0"></a>;; <b>negate</b> 8248 L1AA0: LD A, (HL) ; fetch exponent of last value on the 8249 ; calculator stack. 8250 AND A ; test it. 8251 RET Z ; return if zero. 8252 8253 INC HL ; address the byte with the sign bit. 8254 LD A,(HL) ; fetch to accumulator. 8255 XOR $80 ; toggle the sign bit. 8256 LD (HL),A ; put it back. 8257 DEC HL ; point to last value again. 8258 RET ; return. 8259 8260 ; ----------------------- 8261 ; Absolute magnitude (27) 8262 ; ----------------------- 8263 ; This calculator literal finds the absolute value of the last value, 8264 ; floating point, on calculator stack. 8265 8266 <a name="L1AAA"></a>;; <b>abs</b> 8267 L1AAA: INC HL ; point to byte with sign bit. 8268 RES 7,(HL) ; make the sign positive. 8269 DEC HL ; point to last value again. 8270 RET ; return. 8271 8272 ; ----------- 8273 ; Signum (26) 8274 ; ----------- 8275 ; This routine replaces the last value on the calculator stack, 8276 ; which is in floating point form, with one if positive and with -minus one 8277 ; if negative. If it is zero then it is left as such. 8278 8279 <a name="L1AAF"></a>;; <b>sgn</b> 8280 L1AAF: INC HL ; point to first byte of 4-byte mantissa. 8281 LD A,(HL) ; pick up the byte with the sign bit. 8282 DEC HL ; point to exponent. 8283 DEC (HL) ; test the exponent for 8284 INC (HL) ; the value zero. 8285 8286 SCF ; set the carry flag. 8287 CALL NZ,<A href="#L1AE0">L1AE0</a> ; routine FP-0/1 replaces last value with one 8288 ; if exponent indicates the value is non-zero. 8289 ; in either case mantissa is now four zeros. 8290 8291 INC HL ; point to first byte of 4-byte mantissa. 8292 RLCA ; rotate original sign bit to carry. 8293 RR (HL) ; rotate the carry into sign. 8294 DEC HL ; point to last value. 8295 RET ; return. 8296 8297 8298 ; ------------------------- 8299 ; Handle PEEK function (28) 8300 ; ------------------------- 8301 ; This function returns the contents of a memory address. 8302 ; The entire address space can be peeked including the ROM. 8303 8304 <a name="L1ABE"></a>;; <b>peek</b> 8305 L1ABE: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT puts address in BC. 8306 LD A,(BC) ; load contents into A register. 8307 8308 <a name="L1AC2"></a>;; <b>IN-PK-STK</b> 8309 L1AC2: JP <A href="#L151D">L151D</a> ; exit via STACK-A to put value on the 8310 ; calculator stack. 8311 8312 ; --------------- 8313 ; USR number (29) 8314 ; --------------- 8315 ; The USR function followed by a number 0-65535 is the method by which 8316 ; the ZX81 invokes machine code programs. This function returns the 8317 ; contents of the BC register pair. 8318 ; <font color=#9900FF>Note.</font> that STACK-BC re-initializes the IY register to $4000 if a user-written 8319 ; program has altered it. 8320 8321 <a name="L1AC5"></a>;; <b>usr-no</b> 8322 L1AC5: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT to fetch the 8323 ; supplied address into BC. 8324 8325 LD HL,<A href="#L1520">L1520</a> ; address: STACK-BC is 8326 PUSH HL ; pushed onto the machine stack. 8327 PUSH BC ; then the address of the machine code 8328 ; routine. 8329 8330 RET ; make an indirect jump to the routine 8331 ; and, hopefully, to STACK-BC also. 8332 8333 8334 ; ----------------------- 8335 ; Greater than zero ($33) 8336 ; ----------------------- 8337 ; Test if the last value on the calculator stack is greater than zero. 8338 ; This routine is also called directly from the end-tests of the comparison 8339 ; routine. 8340 8341 <a name="L1ACE"></a>;; <b>GREATER-0</b> 8342 <a name="L1ACE"></a>;; <b>greater-0</b> 8343 L1ACE: LD A,(HL) ; fetch exponent. 8344 AND A ; test it for zero. 8345 RET Z ; return if so. 8346 8347 8348 LD A,$FF ; prepare XOR mask for sign bit 8349 JR <A href="#L1ADC">L1ADC</a> ; forward to SIGN-TO-C 8350 ; to put sign in carry 8351 ; (carry will become set if sign is positive) 8352 ; and then overwrite location with 1 or 0 8353 ; as appropriate. 8354 8355 ; ------------------------ 8356 ; Handle NOT operator ($2C) 8357 ; ------------------------ 8358 ; This overwrites the last value with 1 if it was zero else with zero 8359 ; if it was any other value. 8360 ; 8361 ; e.g. NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0. 8362 ; 8363 ; The subroutine is also called directly from the end-tests of the comparison 8364 ; operator. 8365 8366 <a name="L1AD5"></a>;; <b>NOT</b> 8367 <a name="L1AD5"></a>;; <b>not</b> 8368 L1AD5: LD A,(HL) ; get exponent byte. 8369 NEG ; negate - sets carry if non-zero. 8370 CCF ; complement so carry set if zero, else reset. 8371 JR <A href="#L1AE0">L1AE0</a> ; forward to FP-0/1. 8372 8373 ; ------------------- 8374 ; Less than zero (32) 8375 ; ------------------- 8376 ; Destructively test if last value on calculator stack is less than zero. 8377 ; Bit 7 of second byte will be set if so. 8378 8379 <a name="L1ADB"></a>;; <b>less-0</b> 8380 L1ADB: XOR A ; set xor mask to zero 8381 ; (carry will become set if sign is negative). 8382 8383 ; transfer sign of mantissa to Carry Flag. 8384 8385 <a name="L1ADC"></a>;; <b>SIGN-TO-C</b> 8386 L1ADC: INC HL ; address 2nd byte. 8387 XOR (HL) ; bit 7 of HL will be set if number is negative. 8388 DEC HL ; address 1st byte again. 8389 RLCA ; rotate bit 7 of A to carry. 8390 8391 ; ----------- 8392 ; Zero or one 8393 ; ----------- 8394 ; This routine places an integer value zero or one at the addressed location 8395 ; of calculator stack or MEM area. The value one is written if carry is set on 8396 ; entry else zero. 8397 8398 <a name="L1AE0"></a>;; <b>FP-0/1</b> 8399 L1AE0: PUSH HL ; save pointer to the first byte 8400 LD B,$05 ; five bytes to do. 8401 8402 <a name="L1AE3"></a>;; <b>FP-loop</b> 8403 L1AE3: LD (HL),$00 ; insert a zero. 8404 INC HL ; 8405 DJNZ <A href="#L1AE3">L1AE3</a> ; repeat. 8406 8407 POP HL ; 8408 RET NC ; 8409 8410 LD (HL),$81 ; make value 1 8411 RET ; return. 8412 8413 8414 ; ----------------------- 8415 ; Handle OR operator (07) 8416 ; ----------------------- 8417 ; The Boolean OR operator. eg. X OR Y 8418 ; The result is zero if both values are zero else a non-zero value. 8419 ; 8420 ; e.g. 0 OR 0 returns 0. 8421 ; -3 OR 0 returns -3. 8422 ; 0 OR -3 returns 1. 8423 ; -3 OR 2 returns 1. 8424 ; 8425 ; A binary operation. 8426 ; On entry HL points to first operand (X) and DE to second operand (Y). 8427 8428 <a name="L1AED"></a>;; <b>or</b> 8429 L1AED: LD A,(DE) ; fetch exponent of second number 8430 AND A ; test it. 8431 RET Z ; return if zero. 8432 8433 SCF ; set carry flag 8434 JR <A href="#L1AE0">L1AE0</a> ; back to FP-0/1 to overwrite the first operand 8435 ; with the value 1. 8436 8437 8438 ; ----------------------------- 8439 ; Handle number AND number (08) 8440 ; ----------------------------- 8441 ; The Boolean AND operator. 8442 ; 8443 ; e.g. -3 AND 2 returns -3. 8444 ; -3 AND 0 returns 0. 8445 ; 0 and -2 returns 0. 8446 ; 0 and 0 returns 0. 8447 ; 8448 ; Compare with OR routine above. 8449 8450 <a name=""></a>;; <b>no-&-no</b> 8451 L1AF3: LD A,(DE) ; fetch exponent of second number. 8452 AND A ; test it. 8453 RET NZ ; return if not zero. 8454 8455 JR <A href="#L1AE0">L1AE0</a> ; back to FP-0/1 to overwrite the first operand 8456 ; with zero for return value. 8457 8458 ; ----------------------------- 8459 ; Handle string AND number (10) 8460 ; ----------------------------- 8461 ; e.g. "YOU WIN" AND SCORE>99 will return the string if condition is true 8462 ; or the null string if false. 8463 8464 <a name=""></a>;; <b>str-&-no</b> 8465 L1AF8: LD A,(DE) ; fetch exponent of second number. 8466 AND A ; test it. 8467 RET NZ ; return if number was not zero - the string 8468 ; is the result. 8469 8470 ; if the number was zero (false) then the null string must be returned by 8471 ; altering the length of the string on the calculator stack to zero. 8472 8473 PUSH DE ; save pointer to the now obsolete number 8474 ; (which will become the new STKEND) 8475 8476 DEC DE ; point to the 5th byte of string descriptor. 8477 XOR A ; clear the accumulator. 8478 LD (DE),A ; place zero in high byte of length. 8479 DEC DE ; address low byte of length. 8480 LD (DE),A ; place zero there - now the null string. 8481 8482 POP DE ; restore pointer - new STKEND. 8483 RET ; return. 8484 8485 ; ----------------------------------- 8486 ; Perform comparison ($09-$0E, $11-$16) 8487 ; ----------------------------------- 8488 ; True binary operations. 8489 ; 8490 ; A single entry point is used to evaluate six numeric and six string 8491 ; comparisons. On entry, the calculator literal is in the B register and 8492 ; the two numeric values, or the two string parameters, are on the 8493 ; calculator stack. 8494 ; The individual bits of the literal are manipulated to group similar 8495 ; operations although the SUB 8 instruction does nothing useful and merely 8496 ; alters the string test bit. 8497 ; Numbers are compared by subtracting one from the other, strings are 8498 ; compared by comparing every character until a mismatch, or the end of one 8499 ; or both, is reached. 8500 ; 8501 ; Numeric Comparisons. 8502 ; -------------------- 8503 ; The <b><font color=#333388>'x>y'</font></b> example is the easiest as it employs straight-thru logic. 8504 ; Number y is subtracted from x and the result tested for greater-0 yielding 8505 ; a final value 1 (true) or 0 (false). 8506 ; For 'x<y' the same logic is used but the two values are first swapped on the 8507 ; calculator stack. 8508 ; For 'x=y' NOT is applied to the subtraction result yielding true if the 8509 ; difference was zero and false with anything else. 8510 ; The first three numeric comparisons are just the opposite of the last three 8511 ; so the same processing steps are used and then a final NOT is applied. 8512 ; 8513 ; literal Test No sub 8 ExOrNot 1st RRCA exch sub ? End-Tests 8514 ; ========= ==== == ======== === ======== ======== ==== === = === === === 8515 ; no-l-eql x<=y 09 00000001 dec 00000000 00000000 ---- x-y ? --- >0? NOT 8516 ; no-gr-eql x>=y 0A 00000010 dec 00000001 10000000c swap y-x ? --- >0? NOT 8517 ; nos-neql x<>y 0B 00000011 dec 00000010 00000001 ---- x-y ? NOT --- NOT 8518 ; no-grtr x>y 0C 00000100 - 00000100 00000010 ---- x-y ? --- >0? --- 8519 ; no-less x<y 0D 00000101 - 00000101 10000010c swap y-x ? --- >0? --- 8520 ; nos-eql x=y 0E 00000110 - 00000110 00000011 ---- x-y ? NOT --- --- 8521 ; 8522 ; comp -> C/F 8523 ; ==== === 8524 ; str-l-eql x$<=y$ 11 00001001 dec 00001000 00000100 ---- x$y$ 0 !or >0? NOT 8525 ; str-gr-eql x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0 !or >0? NOT 8526 ; strs-neql x$<>y$ 13 00001011 dec 00001010 00000101 ---- x$y$ 0 !or >0? NOT 8527 ; str-grtr x$>y$ 14 00001100 - 00001100 00000110 ---- x$y$ 0 !or >0? --- 8528 ; str-less x$<y$ 15 00001101 - 00001101 10000110c swap y$x$ 0 !or >0? --- 8529 ; strs-eql x$=y$ 16 00001110 - 00001110 00000111 ---- x$y$ 0 !or >0? --- 8530 ; 8531 ; String comparisons are a little different in that the eql/neql carry flag 8532 ; from the 2nd RRCA is, as before, fed into the first of the end tests but 8533 ; along the way it gets modified by the comparison process. The result on the 8534 ; stack always starts off as zero and the carry fed in determines if NOT is 8535 ; applied to it. So the only time the greater-0 test is applied is if the 8536 ; stack holds zero which is not very efficient as the test will always yield 8537 ; zero. The most likely explanation is that there were once separate end tests 8538 ; for numbers and strings. 8539 8540 <a name="L1B03"></a>;; <b>no-l-eql,etc.</b> 8541 L1B03: LD A,B ; transfer literal to accumulator. 8542 SUB $08 ; subtract eight - which is not useful. 8543 8544 BIT 2,A ; isolate '>', '<', '='. 8545 8546 JR NZ,<A href="#L1B0B">L1B0B</a> ; skip to EX-OR-NOT with these. 8547 8548 DEC A ; else make $00-$02, $08-$0A to match bits 0-2. 8549 8550 <a name="L1B0B"></a>;; <b>EX-OR-NOT</b> 8551 L1B0B: RRCA ; the first RRCA sets carry for a swap. 8552 JR NC,<A href="#L1B16">L1B16</a> ; forward to NU-OR-STR with other 8 cases 8553 8554 ; for the other 4 cases the two values on the calculator stack are exchanged. 8555 8556 PUSH AF ; save A and carry. 8557 PUSH HL ; save HL - pointer to first operand. 8558 ; (DE points to second operand). 8559 8560 CALL <A href="#L1A72">L1A72</a> ; routine exchange swaps the two values. 8561 ; (HL = second operand, DE = STKEND) 8562 8563 POP DE ; DE = first operand 8564 EX DE,HL ; as we were. 8565 POP AF ; restore A and carry. 8566 8567 ; <font color=#9900FF>Note.</font> it would be better if the 2nd RRCA preceded the string test. 8568 ; It would save two duplicate bytes and if we also got rid of that sub 8 8569 ; at the beginning we wouldn't have to alter which bit we test. 8570 8571 <a name="L1B16"></a>;; <b>NU-OR-STR</b> 8572 L1B16: BIT 2,A ; test if a string comparison. 8573 JR NZ,<A href="#L1B21">L1B21</a> ; forward to STRINGS if so. 8574 8575 ; continue with numeric comparisons. 8576 8577 RRCA ; 2nd RRCA causes eql/neql to set carry. 8578 PUSH AF ; save A and carry 8579 8580 CALL <A href="#L174C">L174C</a> ; routine subtract leaves result on stack. 8581 JR <A href="#L1B54">L1B54</a> ; forward to END-TESTS 8582 8583 ; --- 8584 8585 <a name="L1B21"></a>;; <b>STRINGS</b> 8586 L1B21: RRCA ; 2nd RRCA causes eql/neql to set carry. 8587 PUSH AF ; save A and carry. 8588 8589 CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH gets 2nd string params 8590 PUSH DE ; save start2 *. 8591 PUSH BC ; and the length. 8592 8593 CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH gets 1st string 8594 ; parameters - start in DE, length in BC. 8595 POP HL ; restore length of second to HL. 8596 8597 ; A loop is now entered to compare, by subtraction, each corresponding character 8598 ; of the strings. For each successful match, the pointers are incremented and 8599 ; the lengths decreased and the branch taken back to here. If both string 8600 ; remainders become null at the same time, then an exact match exists. 8601 8602 <a name="L1B2C"></a>;; <b>BYTE-COMP</b> 8603 L1B2C: LD A,H ; test if the second string 8604 OR L ; is the null string and hold flags. 8605 8606 EX (SP),HL ; put length2 on stack, bring start2 to HL *. 8607 LD A,B ; hi byte of length1 to A 8608 8609 JR NZ,<A href="#L1B3D">L1B3D</a> ; forward to SEC-PLUS if second not null. 8610 8611 OR C ; test length of first string. 8612 8613 <a name="L1B33"></a>;; <b>SECND-LOW</b> 8614 L1B33: POP BC ; pop the second length off stack. 8615 JR Z,<A href="#L1B3A">L1B3A</a> ; forward to BOTH-NULL if first string is also 8616 ; of zero length. 8617 8618 ; the true condition - first is longer than second (SECND-LESS) 8619 8620 POP AF ; restore carry (set if eql/neql) 8621 CCF ; complement carry flag. 8622 ; <font color=#9900FF>Note.</font> equality becomes false. 8623 ; Inequality is true. By swapping or applying 8624 ; a terminal 'not', all comparisons have been 8625 ; manipulated so that this is success path. 8626 JR <A href="#L1B50">L1B50</a> ; forward to leave via STR-TEST 8627 8628 ; --- 8629 ; the branch was here with a match 8630 8631 <a name="L1B3A"></a>;; <b>BOTH-NULL</b> 8632 L1B3A: POP AF ; restore carry - set for eql/neql 8633 JR <A href="#L1B50">L1B50</a> ; forward to STR-TEST 8634 8635 ; --- 8636 ; the branch was here when 2nd string not null and low byte of first is yet 8637 ; to be tested. 8638 8639 8640 <a name="L1B3D"></a>;; <b>SEC-PLUS</b> 8641 L1B3D: OR C ; test the length of first string. 8642 JR Z,<A href="#L1B4D">L1B4D</a> ; forward to FRST-LESS if length is zero. 8643 8644 ; both strings have at least one character left. 8645 8646 LD A,(DE) ; fetch character of first string. 8647 SUB (HL) ; subtract with that of 2nd string. 8648 JR C,<A href="#L1B4D">L1B4D</a> ; forward to FRST-LESS if carry set 8649 8650 JR NZ,<A href="#L1B33">L1B33</a> ; back to SECND-LOW and then STR-TEST 8651 ; if not exact match. 8652 8653 DEC BC ; decrease length of 1st string. 8654 INC DE ; increment 1st string pointer. 8655 8656 INC HL ; increment 2nd string pointer. 8657 EX (SP),HL ; swap with length on stack 8658 DEC HL ; decrement 2nd string length 8659 JR <A href="#L1B2C">L1B2C</a> ; back to BYTE-COMP 8660 8661 ; --- 8662 ; the false condition. 8663 8664 <a name="L1B4D"></a>;; <b>FRST-LESS</b> 8665 L1B4D: POP BC ; discard length 8666 POP AF ; pop A 8667 AND A ; clear the carry for false result. 8668 8669 ; --- 8670 ; exact match and x$>y$ rejoin here 8671 8672 <a name="L1B50"></a>;; <b>STR-TEST</b> 8673 L1B50: PUSH AF ; save A and carry 8674 8675 RST 28H ;; FP-CALC 8676 DEFB $A0 ;;stk-zero an initial false value. 8677 DEFB $34 ;;end-calc 8678 8679 ; both numeric and string paths converge here. 8680 8681 <a name="L1B54"></a>;; <b>END-TESTS</b> 8682 L1B54: POP AF ; pop carry - will be set if eql/neql 8683 PUSH AF ; save it again. 8684 8685 CALL C,<A href="#L1AD5">L1AD5</a> ; routine NOT sets true(1) if equal(0) 8686 ; or, for strings, applies true result. 8687 CALL <A href="#L1ACE">L1ACE</a> ; greater-0 ?????????? 8688 8689 8690 POP AF ; pop A 8691 RRCA ; the third RRCA - test for '<=', '>=' or '<>'. 8692 CALL NC,<A href="#L1AD5">L1AD5</a> ; apply a terminal NOT if so. 8693 RET ; return. 8694 8695 ; ------------------------- 8696 ; String concatenation ($17) 8697 ; ------------------------- 8698 ; This literal combines two strings into one e.g. LET A$ = B$ + C$ 8699 ; The two parameters of the two strings to be combined are on the stack. 8700 8701 <a name="L1B62"></a>;; <b>strs-add</b> 8702 L1B62: CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH fetches string parameters 8703 ; and deletes calculator stack entry. 8704 PUSH DE ; save start address. 8705 PUSH BC ; and length. 8706 8707 CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH for first string 8708 POP HL ; re-fetch first length 8709 PUSH HL ; and save again 8710 PUSH DE ; save start of second string 8711 PUSH BC ; and its length. 8712 8713 ADD HL,BC ; add the two lengths. 8714 LD B,H ; transfer to BC 8715 LD C,L ; and create 8716 RST 30H ; BC-SPACES in workspace. 8717 ; DE points to start of space. 8718 8719 CALL <A href="#L12C3">L12C3</a> ; routine STK-STO-$ stores parameters 8720 ; of new string updating STKEND. 8721 8722 POP BC ; length of first 8723 POP HL ; address of start 8724 LD A,B ; test for 8725 OR C ; zero length. 8726 JR Z,<A href="#L1B7D">L1B7D</a> ; to OTHER-STR if null string 8727 8728 LDIR ; copy string to workspace. 8729 8730 <a name="L1B7D"></a>;; <b>OTHER-STR</b> 8731 L1B7D: POP BC ; now second length 8732 POP HL ; and start of string 8733 LD A,B ; test this one 8734 OR C ; for zero length 8735 JR Z,<A href="#L1B85">L1B85</a> ; skip forward to STK-PNTRS if so as complete. 8736 8737 LDIR ; else copy the bytes. 8738 ; and continue into next routine which 8739 ; sets the calculator stack pointers. 8740 8741 ; -------------------- 8742 ; Check stack pointers 8743 ; -------------------- 8744 ; Register DE is set to STKEND and HL, the result pointer, is set to five 8745 ; locations below this. 8746 ; This routine is used when it is inconvenient to save these values at the 8747 ; time the calculator stack is manipulated due to other activity on the 8748 ; machine stack. 8749 ; This routine is also used to terminate the VAL routine for 8750 ; the same reason and to initialize the calculator stack at the start of 8751 ; the CALCULATE routine. 8752 8753 <a name="L1B85"></a>;; <b>STK-PNTRS</b> 8754 L1B85: LD HL,($401C) ; fetch STKEND value from system variable. 8755 LD DE,$FFFB ; the value -5 8756 PUSH HL ; push STKEND value. 8757 8758 ADD HL,DE ; subtract 5 from HL. 8759 8760 POP DE ; pop STKEND to DE. 8761 RET ; return. 8762 8763 ; ---------------- 8764 ; Handle CHR$ (2B) 8765 ; ---------------- 8766 ; This function returns a single character string that is a result of 8767 ; converting a number in the range 0-255 to a string e.g. CHR$ 38 = "A". 8768 ; <font color=#9900FF>Note.</font> the ZX81 does not have an ASCII character set. 8769 8770 <a name="L1B8F"></a>;; <b>chrs</b> 8771 L1B8F: CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A puts the number in A. 8772 8773 JR C,<A href="#L1BA2">L1BA2</a> ; forward to REPORT-Bd if overflow 8774 JR NZ,<A href="#L1BA2">L1BA2</a> ; forward to REPORT-Bd if negative 8775 8776 PUSH AF ; save the argument. 8777 8778 LD BC,$0001 ; one space required. 8779 RST 30H ; BC-SPACES makes DE point to start 8780 8781 POP AF ; restore the number. 8782 8783 LD (DE),A ; and store in workspace 8784 8785 CALL <A href="#L12C3">L12C3</a> ; routine STK-STO-$ stacks descriptor. 8786 8787 EX DE,HL ; make HL point to result and DE to STKEND. 8788 RET ; return. 8789 8790 ; --- 8791 8792 <a name="L1BA2"></a>;; <b>REPORT-Bd</b> 8793 L1BA2: RST 08H ; ERROR-1 8794 DEFB $0A ; Error Report: Integer out of range 8795 8796 ; ---------------------------- 8797 ; Handle VAL ($1A) 8798 ; ---------------------------- 8799 ; VAL treats the characters in a string as a numeric expression. 8800 ; e.g. VAL "2.3" = 2.3, VAL "2+4" = 6, VAL ("2" + "4") = 24. 8801 8802 <a name="L1BA4"></a>;; <b>val</b> 8803 L1BA4: LD HL,($4016) ; fetch value of system variable CH_ADD 8804 PUSH HL ; and save on the machine stack. 8805 8806 CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH fetches the string operand 8807 ; from calculator stack. 8808 8809 PUSH DE ; save the address of the start of the string. 8810 INC BC ; increment the length for a carriage return. 8811 8812 RST 30H ; BC-SPACES creates the space in workspace. 8813 POP HL ; restore start of string to HL. 8814 LD ($4016),DE ; load CH_ADD with start DE in workspace. 8815 8816 PUSH DE ; save the start in workspace 8817 LDIR ; copy string from program or variables or 8818 ; workspace to the workspace area. 8819 EX DE,HL ; end of string + 1 to HL 8820 DEC HL ; decrement HL to point to end of new area. 8821 LD (HL),$76 ; insert a carriage return at end. 8822 ; ZX81 has a non-ASCII character set 8823 RES 7,(IY+$01) ; update FLAGS - signal checking syntax. 8824 CALL <A href="#L0D92">L0D92</a> ; routine CLASS-06 - SCANNING evaluates string 8825 ; expression and checks for integer result. 8826 8827 CALL <A href="#L0D22">L0D22</a> ; routine CHECK-2 checks for carriage return. 8828 8829 8830 POP HL ; restore start of string in workspace. 8831 8832 LD ($4016),HL ; set CH_ADD to the start of the string again. 8833 SET 7,(IY+$01) ; update FLAGS - signal running program. 8834 CALL <A href="#L0F55">L0F55</a> ; routine SCANNING evaluates the string 8835 ; in full leaving result on calculator stack. 8836 8837 POP HL ; restore saved character address in program. 8838 LD ($4016),HL ; and reset the system variable CH_ADD. 8839 8840 JR <A href="#L1B85">L1B85</a> ; back to exit via STK-PNTRS. 8841 ; resetting the calculator stack pointers 8842 ; HL and DE from STKEND as it wasn't possible 8843 ; to preserve them during this routine. 8844 8845 ; ---------------- 8846 ; Handle STR$ (2A) 8847 ; ---------------- 8848 ; This function returns a string representation of a numeric argument. 8849 ; The method used is to trick the PRINT-FP routine into thinking it 8850 ; is writing to a collapsed display file when in fact it is writing to 8851 ; string workspace. 8852 ; If there is already a newline at the intended print position and the 8853 ; column count has not been reduced to zero then the print routine 8854 ; assumes that there is only 1K of RAM and the screen memory, like the rest 8855 ; of dynamic memory, expands as necessary using calls to the ONE-SPACE 8856 ; routine. The screen is character-mapped not bit-mapped. 8857 8858 <a name="L1BD5"></a>;; <b>str$</b> 8859 L1BD5: LD BC,$0001 ; create an initial byte in workspace 8860 RST 30H ; using BC-SPACES restart. 8861 8862 LD (HL),$76 ; place a carriage return there. 8863 8864 LD HL,($4039) ; fetch value of S_POSN column/line 8865 PUSH HL ; and preserve on stack. 8866 8867 LD L,$FF ; make column value high to create a 8868 ; contrived buffer of length 254. 8869 LD ($4039),HL ; and store in system variable S_POSN. 8870 8871 LD HL,($400E) ; fetch value of DF_CC 8872 PUSH HL ; and preserve on stack also. 8873 8874 LD ($400E),DE ; now set DF_CC which normally addresses 8875 ; somewhere in the display file to the start 8876 ; of workspace. 8877 PUSH DE ; save the start of new string. 8878 8879 CALL <A href="#L15DB">L15DB</a> ; routine PRINT-FP. 8880 8881 POP DE ; retrieve start of string. 8882 8883 LD HL,($400E) ; fetch end of string from DF_CC. 8884 AND A ; prepare for true subtraction. 8885 SBC HL,DE ; subtract to give length. 8886 8887 LD B,H ; and transfer to the BC 8888 LD C,L ; register. 8889 8890 POP HL ; restore original 8891 LD ($400E),HL ; DF_CC value 8892 8893 POP HL ; restore original 8894 LD ($4039),HL ; S_POSN values. 8895 8896 CALL <A href="#L12C3">L12C3</a> ; routine STK-STO-$ stores the string 8897 ; descriptor on the calculator stack. 8898 8899 EX DE,HL ; HL = last value, DE = STKEND. 8900 RET ; return. 8901 8902 8903 ; ------------------- 8904 ; THE <b><font color=#333388>'CODE'</font></b> FUNCTION 8905 ; ------------------- 8906 ; <font color=#339933>(offset $19: 'code')</font> 8907 ; Returns the code of a character or first character of a string 8908 ; e.g. CODE "AARDVARK" = 38 (not 65 as the ZX81 does not have an ASCII 8909 ; character set). 8910 8911 8912 <a name="L1C06"></a>;; <b>code</b> 8913 L1C06: CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH to fetch and delete the 8914 ; string parameters. 8915 ; DE points to the start, BC holds the length. 8916 LD A,B ; test length 8917 OR C ; of the string. 8918 JR Z,<A href="#L1C0E">L1C0E</a> ; skip to STK-CODE with zero if the null string. 8919 8920 LD A,(DE) ; else fetch the first character. 8921 8922 <a name="L1C0E"></a>;; <b>STK-CODE</b> 8923 L1C0E: JP <A href="#L151D">L151D</a> ; jump back to STACK-A (with memory check) 8924 8925 ; -------------------- 8926 ; THE <b><font color=#333388>'LEN'</font></b> SUBROUTINE 8927 ; -------------------- 8928 ; <font color=#339933>(offset $1b: 'len')</font> 8929 ; Returns the length of a string. 8930 ; In Sinclair BASIC strings can be more than twenty thousand characters long 8931 ; so a sixteen-bit register is required to store the length 8932 8933 <a name="L1C11"></a>;; <b>len</b> 8934 L1C11: CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH to fetch and delete the 8935 ; string parameters from the calculator stack. 8936 ; register BC now holds the length of string. 8937 8938 JP <A href="#L1520">L1520</a> ; jump back to STACK-BC to save result on the 8939 ; calculator stack (with memory check). 8940 8941 ; ------------------------------------- 8942 ; THE <b><font color=#333388>'DECREASE THE COUNTER'</font></b> SUBROUTINE 8943 ; ------------------------------------- 8944 ; <font color=#339933>(offset $31: 'dec-jr-nz')</font> 8945 ; The calculator has an instruction that decrements a single-byte 8946 ; pseudo-register and makes consequential relative jumps just like 8947 ; the Z80's DJNZ instruction. 8948 8949 <a name="L1C17"></a>;; <b>dec-jr-nz</b> 8950 L1C17: EXX ; switch in set that addresses code 8951 8952 PUSH HL ; save pointer to offset byte 8953 LD HL,$401E ; address BREG in system variables 8954 DEC (HL) ; decrement it 8955 POP HL ; restore pointer 8956 8957 JR NZ,<A href="#L1C24">L1C24</a> ; to JUMP-2 if not zero 8958 8959 INC HL ; step past the jump length. 8960 EXX ; switch in the main set. 8961 RET ; return. 8962 8963 ; <font color=#9900FF>Note.</font> as a general rule the calculator avoids using the IY register 8964 ; otherwise the cumbersome 4 instructions in the middle could be replaced by 8965 ; dec (iy+$xx) - using three instruction bytes instead of six. 8966 8967 8968 ; --------------------- 8969 ; THE <b><font color=#333388>'JUMP'</font></b> SUBROUTINE 8970 ; --------------------- 8971 ; <font color=#339933>(Offset $2F; 'jump')</font> 8972 ; This enables the calculator to perform relative jumps just like 8973 ; the Z80 chip's JR instruction. 8974 ; This is one of the few routines to be polished for the ZX Spectrum. 8975 ; See, without looking at the ZX Spectrum ROM, if you can get rid of the 8976 ; relative jump. 8977 8978 <a name="L1C23"></a>;; <b>jump</b> 8979 <a name="L1C23"></a>;; <b>JUMP</b> 8980 L1C23: EXX ;switch in pointer set 8981 8982 <a name="L1C24"></a>;; <b>JUMP-2</b> 8983 L1C24: LD E,(HL) ; the jump byte 0-127 forward, 128-255 back. 8984 XOR A ; clear accumulator. 8985 BIT 7,E ; test if negative jump 8986 JR Z,<A href="#L1C2B">L1C2B</a> ; skip, if positive, to JUMP-3. 8987 8988 CPL ; else change to $FF. 8989 8990 <a name="L1C2B"></a>;; <b>JUMP-3</b> 8991 L1C2B: LD D,A ; transfer to high byte. 8992 ADD HL,DE ; advance calculator pointer forward or back. 8993 8994 EXX ; switch out pointer set. 8995 RET ; return. 8996 8997 ; ----------------------------- 8998 ; THE <b><font color=#333388>'JUMP ON TRUE'</font></b> SUBROUTINE 8999 ; ----------------------------- 9000 ; <font color=#339933>(Offset $00; 'jump-true')</font> 9001 ; This enables the calculator to perform conditional relative jumps 9002 ; dependent on whether the last test gave a true result 9003 ; On the ZX81, the exponent will be zero for zero or else $81 for one. 9004 9005 <a name="L1C2F"></a>;; <b>jump-true</b> 9006 L1C2F: LD A,(DE) ; collect exponent byte 9007 9008 AND A ; is result 0 or 1 ? 9009 JR NZ,<A href="#L1C23">L1C23</a> ; back to JUMP if true (1). 9010 9011 EXX ; else switch in the pointer set. 9012 INC HL ; step past the jump length. 9013 EXX ; switch in the main set. 9014 RET ; return. 9015 9016 9017 ; ------------------------ 9018 ; THE <b><font color=#333388>'MODULUS'</font></b> SUBROUTINE 9019 ; ------------------------ 9020 ; ( Offset $2E: 'n-mod-m' ) 9021 ; <font color=#CC00FF>( i1, i2 -- i3, i4 )</font> 9022 ; The subroutine calculate N mod M where M is the positive integer, the 9023 ; 'last value' on the calculator stack and N is the integer beneath. 9024 ; The subroutine returns the integer quotient as the last value and the 9025 ; remainder as the value beneath. 9026 ; e.g. 17 MOD 3 = 5 remainder 2 9027 ; It is invoked during the calculation of a random number and also by 9028 ; the PRINT-FP routine. 9029 9030 <a name="L1C37"></a>;; <b>n-mod-m</b> 9031 L1C37: RST 28H ;; FP-CALC 17, 3. 9032 DEFB $C0 ;;st-mem-0 17, 3. 9033 DEFB $02 ;;delete 17. 9034 DEFB $2D ;;duplicate 17, 17. 9035 DEFB $E0 ;;get-mem-0 17, 17, 3. 9036 DEFB $05 ;;division 17, 17/3. 9037 DEFB $24 ;;int 17, 5. 9038 DEFB $E0 ;;get-mem-0 17, 5, 3. 9039 DEFB $01 ;;exchange 17, 3, 5. 9040 DEFB $C0 ;;st-mem-0 17, 3, 5. 9041 DEFB $04 ;;multiply 17, 15. 9042 DEFB $03 ;;subtract 2. 9043 DEFB $E0 ;;get-mem-0 2, 5. 9044 DEFB $34 ;;end-calc 2, 5. 9045 9046 RET ; return. 9047 9048 9049 ; ---------------------- 9050 ; THE <b><font color=#333388>'INTEGER'</font></b> FUNCTION 9051 ; ---------------------- 9052 ; <font color=#339933>(offset $24: 'int')</font> 9053 ; This function returns the integer of x, which is just the same as truncate 9054 ; for positive numbers. The truncate literal truncates negative numbers 9055 ; upwards so that -3.4 gives -3 whereas the BASIC INT function has to 9056 ; truncate negative numbers down so that INT -3.4 is 4. 9057 ; It is best to work through using, say, plus or minus 3.4 as examples. 9058 9059 <a name="L1C46"></a>;; <b>int</b> 9060 L1C46: RST 28H ;; FP-CALC x. (= 3.4 or -3.4). 9061 DEFB $2D ;;duplicate x, x. 9062 DEFB $32 ;;less-0 x, (1/0) 9063 DEFB $00 ;;jump-true x, (1/0) 9064 DEFB $04 ;;to <A href="#L1C46">L1C46</a>, X-NEG 9065 9066 DEFB $36 ;;truncate trunc 3.4 = 3. 9067 DEFB $34 ;;end-calc 3. 9068 9069 RET ; return with + int x on stack. 9070 9071 9072 <a name="L1C4E"></a>;; <b>X-NEG</b> 9073 L1C4E: DEFB $2D ;;duplicate -3.4, -3.4. 9074 DEFB $36 ;;truncate -3.4, -3. 9075 DEFB $C0 ;;st-mem-0 -3.4, -3. 9076 DEFB $03 ;;subtract -.4 9077 DEFB $E0 ;;get-mem-0 -.4, -3. 9078 DEFB $01 ;;exchange -3, -.4. 9079 DEFB $2C ;;not -3, (0). 9080 DEFB $00 ;;jump-true -3. 9081 DEFB $03 ;;to <A href="#L1C59">L1C59</a>, EXIT -3. 9082 9083 DEFB $A1 ;;stk-one -3, 1. 9084 DEFB $03 ;;subtract -4. 9085 9086 <a name="L1C59"></a>;; <b>EXIT</b> 9087 L1C59: DEFB $34 ;;end-calc -4. 9088 9089 RET ; return. 9090 9091 9092 ; ---------------- 9093 ; Exponential (23) 9094 ; ---------------- 9095 ; 9096 ; 9097 9098 <a name="L1C5B"></a>;; <b>EXP</b> 9099 <a name="L1C5B"></a>;; <b>exp</b> 9100 L1C5B: RST 28H ;; FP-CALC 9101 DEFB $30 ;;stk-data 9102 DEFB $F1 ;;Exponent: $81, Bytes: 4 9103 DEFB $38,$AA,$3B,$29 ;; 9104 DEFB $04 ;;multiply 9105 DEFB $2D ;;duplicate 9106 DEFB $24 ;;int 9107 DEFB $C3 ;;st-mem-3 9108 DEFB $03 ;;subtract 9109 DEFB $2D ;;duplicate 9110 DEFB $0F ;;addition 9111 DEFB $A1 ;;stk-one 9112 DEFB $03 ;;subtract 9113 DEFB $88 ;;series-08 9114 DEFB $13 ;;Exponent: $63, Bytes: 1 9115 DEFB $36 ;;(+00,+00,+00) 9116 DEFB $58 ;;Exponent: $68, Bytes: 2 9117 DEFB $65,$66 ;;(+00,+00) 9118 DEFB $9D ;;Exponent: $6D, Bytes: 3 9119 DEFB $78,$65,$40 ;;(+00) 9120 DEFB $A2 ;;Exponent: $72, Bytes: 3 9121 DEFB $60,$32,$C9 ;;(+00) 9122 DEFB $E7 ;;Exponent: $77, Bytes: 4 9123 DEFB $21,$F7,$AF,$24 ;; 9124 DEFB $EB ;;Exponent: $7B, Bytes: 4 9125 DEFB $2F,$B0,$B0,$14 ;; 9126 DEFB $EE ;;Exponent: $7E, Bytes: 4 9127 DEFB $7E,$BB,$94,$58 ;; 9128 DEFB $F1 ;;Exponent: $81, Bytes: 4 9129 DEFB $3A,$7E,$F8,$CF ;; 9130 DEFB $E3 ;;get-mem-3 9131 DEFB $34 ;;end-calc 9132 9133 CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A 9134 JR NZ,<A href="#L1C9B">L1C9B</a> ; to N-NEGTV 9135 9136 JR C,<A href="#L1C99">L1C99</a> ; to REPORT-6b 9137 9138 ADD A,(HL) ; 9139 JR NC,<A href="#L1CA2">L1CA2</a> ; to RESULT-OK 9140 9141 9142 <a name="L1C99"></a>;; <b>REPORT-6b</b> 9143 L1C99: RST 08H ; ERROR-1 9144 DEFB $05 ; Error Report: Number too big 9145 9146 <a name="L1C9B"></a>;; <b>N-NEGTV</b> 9147 L1C9B: JR C,<A href="#L1CA4">L1CA4</a> ; to RSLT-ZERO 9148 9149 SUB (HL) ; 9150 JR NC,<A href="#L1CA4">L1CA4</a> ; to RSLT-ZERO 9151 9152 NEG ; Negate 9153 9154 <a name="L1CA2"></a>;; <b>RESULT-OK</b> 9155 L1CA2: LD (HL),A ; 9156 RET ; return. 9157 9158 9159 <a name="L1CA4"></a>;; <b>RSLT-ZERO</b> 9160 L1CA4: RST 28H ;; FP-CALC 9161 DEFB $02 ;;delete 9162 DEFB $A0 ;;stk-zero 9163 DEFB $34 ;;end-calc 9164 9165 RET ; return. 9166 9167 9168 ; -------------------------------- 9169 ; THE <b><font color=#333388>'NATURAL LOGARITHM'</font></b> FUNCTION 9170 ; -------------------------------- 9171 ; <font color=#339933>(offset $22: 'ln')</font> 9172 ; Like the ZX81 itself, 'natural' logarithms came from Scotland. 9173 ; They were devised in 1614 by well-traveled Scotsman John Napier who noted 9174 ; "Nothing doth more molest and hinder calculators than the multiplications, 9175 ; divisions, square and cubical extractions of great numbers". 9176 ; 9177 ; Napier's logarithms enabled the above operations to be accomplished by 9178 ; simple addition and subtraction simplifying the navigational and 9179 ; astronomical calculations which beset his age. 9180 ; Napier's logarithms were quickly overtaken by logarithms to the base 10 9181 ; devised, in conjunction with Napier, by Henry Briggs a Cambridge-educated 9182 ; professor of Geometry at Oxford University. These simplified the layout 9183 ; of the tables enabling humans to easily scale calculations. 9184 ; 9185 ; It is only recently with the introduction of pocket calculators and 9186 ; computers like the ZX81 that natural logarithms are once more at the fore, 9187 ; although some computers retain logarithms to the base ten. 9188 ; 'Natural' logarithms are powers to the base 'e', which like 'pi' is a 9189 ; naturally occurring number in branches of mathematics. 9190 ; Like 'pi' also, 'e' is an irrational number and starts 2.718281828... 9191 ; 9192 ; The tabular use of logarithms was that to multiply two numbers one looked 9193 ; up their two logarithms in the tables, added them together and then looked 9194 ; for the result in a table of antilogarithms to give the desired product. 9195 ; 9196 ; The EXP function is the BASIC equivalent of a calculator's 'antiln' function 9197 ; and by picking any two numbers, 1.72 and 6.89 say, 9198 ; 10 PRINT EXP ( LN 1.72 + LN 6.89 ) 9199 ; will give just the same result as 9200 ; 20 PRINT 1.72 * 6.89. 9201 ; Division is accomplished by subtracting the two logs. 9202 ; 9203 ; Napier also mentioned "square and cubicle extractions". 9204 ; To raise a number to the power 3, find its 'ln', multiply by 3 and find the 9205 ; 'antiln'. e.g. PRINT EXP( LN 4 * 3 ) gives 64. 9206 ; Similarly to find the n'th root divide the logarithm by 'n'. 9207 ; The ZX81 ROM used PRINT EXP ( LN 9 / 2 ) to find the square root of the 9208 ; number 9. The Napieran square root function is just a special case of 9209 ; the 'to_power' function. A cube root or indeed any root/power would be just 9210 ; as simple. 9211 9212 ; First test that the argument to LN is a positive, non-zero number. 9213 9214 <a name="L1CA9"></a>;; <b>ln</b> 9215 L1CA9: RST 28H ;; FP-CALC 9216 DEFB $2D ;;duplicate 9217 DEFB $33 ;;greater-0 9218 DEFB $00 ;;jump-true 9219 DEFB $04 ;;to <A href="#L1CB1">L1CB1</a>, VALID 9220 9221 DEFB $34 ;;end-calc 9222 9223 9224 <a name="L1CAF"></a>;; <b>REPORT-Ab</b> 9225 L1CAF: RST 08H ; ERROR-1 9226 DEFB $09 ; Error Report: Invalid argument 9227 9228 <a name="L1CB1"></a>;; <b>VALID</b> 9229 L1CB1: DEFB $A0 ;;stk-zero <font color=#9900FF>Note.</font> not 9230 DEFB $02 ;;delete necessary. 9231 DEFB $34 ;;end-calc 9232 LD A,(HL) ; 9233 9234 LD (HL),$80 ; 9235 CALL <A href="#L151D">L151D</a> ; routine STACK-A 9236 9237 RST 28H ;; FP-CALC 9238 DEFB $30 ;;stk-data 9239 DEFB $38 ;;Exponent: $88, Bytes: 1 9240 DEFB $00 ;;(+00,+00,+00) 9241 DEFB $03 ;;subtract 9242 DEFB $01 ;;exchange 9243 DEFB $2D ;;duplicate 9244 DEFB $30 ;;stk-data 9245 DEFB $F0 ;;Exponent: $80, Bytes: 4 9246 DEFB $4C,$CC,$CC,$CD ;; 9247 DEFB $03 ;;subtract 9248 DEFB $33 ;;greater-0 9249 DEFB $00 ;;jump-true 9250 DEFB $08 ;;to <A href="#L1CD2">L1CD2</a>, GRE.8 9251 9252 DEFB $01 ;;exchange 9253 DEFB $A1 ;;stk-one 9254 DEFB $03 ;;subtract 9255 DEFB $01 ;;exchange 9256 DEFB $34 ;;end-calc 9257 9258 INC (HL) ; 9259 9260 RST 28H ;; FP-CALC 9261 9262 <a name="L1CD2"></a>;; <b>GRE.8</b> 9263 L1CD2: DEFB $01 ;;exchange 9264 DEFB $30 ;;stk-data 9265 DEFB $F0 ;;Exponent: $80, Bytes: 4 9266 DEFB $31,$72,$17,$F8 ;; 9267 DEFB $04 ;;multiply 9268 DEFB $01 ;;exchange 9269 DEFB $A2 ;;stk-half 9270 DEFB $03 ;;subtract 9271 DEFB $A2 ;;stk-half 9272 DEFB $03 ;;subtract 9273 DEFB $2D ;;duplicate 9274 DEFB $30 ;;stk-data 9275 DEFB $32 ;;Exponent: $82, Bytes: 1 9276 DEFB $20 ;;(+00,+00,+00) 9277 DEFB $04 ;;multiply 9278 DEFB $A2 ;;stk-half 9279 DEFB $03 ;;subtract 9280 DEFB $8C ;;series-0C 9281 DEFB $11 ;;Exponent: $61, Bytes: 1 9282 DEFB $AC ;;(+00,+00,+00) 9283 DEFB $14 ;;Exponent: $64, Bytes: 1 9284 DEFB $09 ;;(+00,+00,+00) 9285 DEFB $56 ;;Exponent: $66, Bytes: 2 9286 DEFB $DA,$A5 ;;(+00,+00) 9287 DEFB $59 ;;Exponent: $69, Bytes: 2 9288 DEFB $30,$C5 ;;(+00,+00) 9289 DEFB $5C ;;Exponent: $6C, Bytes: 2 9290 DEFB $90,$AA ;;(+00,+00) 9291 DEFB $9E ;;Exponent: $6E, Bytes: 3 9292 DEFB $70,$6F,$61 ;;(+00) 9293 DEFB $A1 ;;Exponent: $71, Bytes: 3 9294 DEFB $CB,$DA,$96 ;;(+00) 9295 DEFB $A4 ;;Exponent: $74, Bytes: 3 9296 DEFB $31,$9F,$B4 ;;(+00) 9297 DEFB $E7 ;;Exponent: $77, Bytes: 4 9298 DEFB $A0,$FE,$5C,$FC ;; 9299 DEFB $EA ;;Exponent: $7A, Bytes: 4 9300 DEFB $1B,$43,$CA,$36 ;; 9301 DEFB $ED ;;Exponent: $7D, Bytes: 4 9302 DEFB $A7,$9C,$7E,$5E ;; 9303 DEFB $F0 ;;Exponent: $80, Bytes: 4 9304 DEFB $6E,$23,$80,$93 ;; 9305 DEFB $04 ;;multiply 9306 DEFB $0F ;;addition 9307 DEFB $34 ;;end-calc 9308 9309 RET ; return. 9310 9311 ; ----------------------------- 9312 ; THE <b><font color=#333388>'TRIGONOMETRIC'</font></b> FUNCTIONS 9313 ; ----------------------------- 9314 ; Trigonometry is rocket science. It is also used by carpenters and pyramid 9315 ; builders. 9316 ; Some uses can be quite abstract but the principles can be seen in simple 9317 ; right-angled triangles. Triangles have some special properties - 9318 ; 9319 ; 1) The sum of the three angles is always PI radians (180 degrees). 9320 ; Very helpful if you know two angles and wish to find the third. 9321 ; 2) In any right-angled triangle the sum of the squares of the two shorter 9322 ; sides is equal to the square of the longest side opposite the right-angle. 9323 ; Very useful if you know the length of two sides and wish to know the 9324 ; length of the third side. 9325 ; 3) Functions sine, cosine and tangent enable one to calculate the length 9326 ; of an unknown side when the length of one other side and an angle is 9327 ; known. 9328 ; 4) Functions arcsin, arccosine and arctan enable one to calculate an unknown 9329 ; angle when the length of two of the sides is known. 9330 9331 ; -------------------------------- 9332 ; THE <b><font color=#333388>'REDUCE ARGUMENT'</font></b> SUBROUTINE 9333 ; -------------------------------- 9334 ; <font color=#339933>(offset $35: 'get-argt')</font> 9335 ; 9336 ; This routine performs two functions on the angle, in radians, that forms 9337 ; the argument to the sine and cosine functions. 9338 ; First it ensures that the angle 'wraps round'. That if a ship turns through 9339 ; an angle of, say, 3*PI radians (540 degrees) then the net effect is to turn 9340 ; through an angle of PI radians (180 degrees). 9341 ; Secondly it converts the angle in radians to a fraction of a right angle, 9342 ; depending within which quadrant the angle lies, with the periodicity 9343 ; resembling that of the desired sine value. 9344 ; The result lies in the range -1 to +1. 9345 ; 9346 ; 90 deg. 9347 ; 9348 ; (pi/2) 9349 ; II +1 I 9350 ; | 9351 ; sin+ |\ | /| sin+ 9352 ; cos- | \ | / | cos+ 9353 ; tan- | \ | / | tan+ 9354 ; | \|/) | 9355 ; 180 deg. (pi) 0 -|----+----|-- 0 (0) 0 degrees 9356 ; | /|\ | 9357 ; sin- | / | \ | sin- 9358 ; cos- | / | \ | cos+ 9359 ; tan+ |/ | \| tan- 9360 ; | 9361 ; III -1 IV 9362 ; (3pi/2) 9363 ; 9364 ; 270 deg. 9365 9366 9367 <a name="L1D18"></a>;; <b>get-argt</b> 9368 L1D18: RST 28H ;; FP-CALC X. 9369 DEFB $30 ;;stk-data 9370 DEFB $EE ;;Exponent: $7E, 9371 ;;Bytes: 4 9372 DEFB $22,$F9,$83,$6E ;; X, 1/(2*PI) 9373 DEFB $04 ;;multiply X/(2*PI) = fraction 9374 9375 DEFB $2D ;;duplicate 9376 DEFB $A2 ;;stk-half 9377 DEFB $0F ;;addition 9378 DEFB $24 ;;int 9379 9380 DEFB $03 ;;subtract now range -.5 to .5 9381 9382 DEFB $2D ;;duplicate 9383 DEFB $0F ;;addition now range -1 to 1. 9384 DEFB $2D ;;duplicate 9385 DEFB $0F ;;addition now range -2 to 2. 9386 9387 ; quadrant I (0 to +1) and quadrant IV (-1 to 0) are now correct. 9388 ; quadrant II ranges +1 to +2. 9389 ; quadrant III ranges -2 to -1. 9390 9391 DEFB $2D ;;duplicate Y, Y. 9392 DEFB $27 ;;abs Y, abs(Y). range 1 to 2 9393 DEFB $A1 ;;stk-one Y, abs(Y), 1. 9394 DEFB $03 ;;subtract Y, abs(Y)-1. range 0 to 1 9395 DEFB $2D ;;duplicate Y, Z, Z. 9396 DEFB $33 ;;greater-0 Y, Z, (1/0). 9397 9398 DEFB $C0 ;;st-mem-0 store as possible sign 9399 ;; for cosine function. 9400 9401 DEFB $00 ;;jump-true 9402 DEFB $04 ;;to <A href="#L1D35">L1D35</a>, ZPLUS with quadrants II and III 9403 9404 ; else the angle lies in quadrant I or IV and value Y is already correct. 9405 9406 DEFB $02 ;;delete Y delete test value. 9407 DEFB $34 ;;end-calc Y. 9408 9409 RET ; return. with Q1 and Q4 >>> 9410 9411 ; The branch was here with quadrants II (0 to 1) and III (1 to 0). 9412 ; Y will hold -2 to -1 if this is quadrant III. 9413 9414 <a name="L1D35"></a>;; <b>ZPLUS</b> 9415 L1D35: DEFB $A1 ;;stk-one Y, Z, 1 9416 DEFB $03 ;;subtract Y, Z-1. Q3 = 0 to -1 9417 DEFB $01 ;;exchange Z-1, Y. 9418 DEFB $32 ;;less-0 Z-1, (1/0). 9419 DEFB $00 ;;jump-true Z-1. 9420 DEFB $02 ;;to <A href="#L1D3C">L1D3C</a>, YNEG 9421 ;;if angle in quadrant III 9422 9423 ; else angle is within quadrant II (-1 to 0) 9424 9425 DEFB $18 ;;negate range +1 to 0 9426 9427 9428 <a name="L1D3C"></a>;; <b>YNEG</b> 9429 L1D3C: DEFB $34 ;;end-calc quadrants II and III correct. 9430 9431 RET ; return. 9432 9433 9434 ; --------------------- 9435 ; THE <b><font color=#333388>'COSINE'</font></b> FUNCTION 9436 ; --------------------- 9437 ; <font color=#339933>(offset $1D: 'cos')</font> 9438 ; Cosines are calculated as the sine of the opposite angle rectifying the 9439 ; sign depending on the quadrant rules. 9440 ; 9441 ; 9442 ; /| 9443 ; h /y| 9444 ; / |o 9445 ; /x | 9446 ; /----| 9447 ; a 9448 ; 9449 ; The cosine of angle x is the adjacent side (a) divided by the hypotenuse 1. 9450 ; However if we examine angle y then a/h is the sine of that angle. 9451 ; Since angle x plus angle y equals a right-angle, we can find angle y by 9452 ; subtracting angle x from pi/2. 9453 ; However it's just as easy to reduce the argument first and subtract the 9454 ; reduced argument from the value 1 (a reduced right-angle). 9455 ; It's even easier to subtract 1 from the angle and rectify the sign. 9456 ; In fact, after reducing the argument, the absolute value of the argument 9457 ; is used and rectified using the test result stored in mem-0 by 'get-argt' 9458 ; for that purpose. 9459 9460 <a name="L1D3E"></a>;; <b>cos</b> 9461 L1D3E: RST 28H ;; FP-CALC angle in radians. 9462 DEFB $35 ;;get-argt X reduce -1 to +1 9463 9464 DEFB $27 ;;abs ABS X 0 to 1 9465 DEFB $A1 ;;stk-one ABS X, 1. 9466 DEFB $03 ;;subtract now opposite angle 9467 ;; though negative sign. 9468 DEFB $E0 ;;get-mem-0 fetch sign indicator. 9469 DEFB $00 ;;jump-true 9470 DEFB $06 ;;fwd to <A href="#L1D4B">L1D4B</a>, C-ENT 9471 ;;forward to common code if in QII or QIII 9472 9473 9474 DEFB $18 ;;negate else make positive. 9475 DEFB $2F ;;jump 9476 DEFB $03 ;;fwd to <A href="#L1D4B">L1D4B</a>, C-ENT 9477 ;;with quadrants QI and QIV 9478 9479 ; ------------------- 9480 ; THE <b><font color=#333388>'SINE'</font></b> FUNCTION 9481 ; ------------------- 9482 ; <font color=#339933>(offset $1C: 'sin')</font> 9483 ; This is a fundamental transcendental function from which others such as cos 9484 ; and tan are directly, or indirectly, derived. 9485 ; It uses the series generator to produce Chebyshev polynomials. 9486 ; 9487 ; 9488 ; /| 9489 ; 1 / | 9490 ; / |x 9491 ; /a | 9492 ; /----| 9493 ; y 9494 ; 9495 ; The 'get-argt' function is designed to modify the angle and its sign 9496 ; in line with the desired sine value and afterwards it can launch straight 9497 ; into common code. 9498 9499 <a name="L1D49"></a>;; <b>sin</b> 9500 L1D49: RST 28H ;; FP-CALC angle in radians 9501 DEFB $35 ;;get-argt reduce - sign now correct. 9502 9503 <a name="L1D4B"></a>;; <b>C-ENT</b> 9504 L1D4B: DEFB $2D ;;duplicate 9505 DEFB $2D ;;duplicate 9506 DEFB $04 ;;multiply 9507 DEFB $2D ;;duplicate 9508 DEFB $0F ;;addition 9509 DEFB $A1 ;;stk-one 9510 DEFB $03 ;;subtract 9511 9512 DEFB $86 ;;series-06 9513 DEFB $14 ;;Exponent: $64, Bytes: 1 9514 DEFB $E6 ;;(+00,+00,+00) 9515 DEFB $5C ;;Exponent: $6C, Bytes: 2 9516 DEFB $1F,$0B ;;(+00,+00) 9517 DEFB $A3 ;;Exponent: $73, Bytes: 3 9518 DEFB $8F,$38,$EE ;;(+00) 9519 DEFB $E9 ;;Exponent: $79, Bytes: 4 9520 DEFB $15,$63,$BB,$23 ;; 9521 DEFB $EE ;;Exponent: $7E, Bytes: 4 9522 DEFB $92,$0D,$CD,$ED ;; 9523 DEFB $F1 ;;Exponent: $81, Bytes: 4 9524 DEFB $23,$5D,$1B,$EA ;; 9525 9526 DEFB $04 ;;multiply 9527 DEFB $34 ;;end-calc 9528 9529 RET ; return. 9530 9531 9532 ; ---------------------- 9533 ; THE <b><font color=#333388>'TANGENT'</font></b> FUNCTION 9534 ; ---------------------- 9535 ; <font color=#339933>(offset $1E: 'tan')</font> 9536 ; 9537 ; Evaluates tangent x as sin(x) / cos(x). 9538 ; 9539 ; 9540 ; /| 9541 ; h / | 9542 ; / |o 9543 ; /x | 9544 ; /----| 9545 ; a 9546 ; 9547 ; The tangent of angle x is the ratio of the length of the opposite side 9548 ; divided by the length of the adjacent side. As the opposite length can 9549 ; be calculates using sin(x) and the adjacent length using cos(x) then 9550 ; the tangent can be defined in terms of the previous two functions. 9551 9552 ; Error 6 if the argument, in radians, is too close to one like pi/2 9553 ; which has an infinite tangent. e.g. PRINT TAN (PI/2) evaluates as 1/0. 9554 ; Similarly PRINT TAN (3*PI/2), TAN (5*PI/2) etc. 9555 9556 <a name="L1D6E"></a>;; <b>tan</b> 9557 L1D6E: RST 28H ;; FP-CALC x. 9558 DEFB $2D ;;duplicate x, x. 9559 DEFB $1C ;;sin x, sin x. 9560 DEFB $01 ;;exchange sin x, x. 9561 DEFB $1D ;;cos sin x, cos x. 9562 DEFB $05 ;;division sin x/cos x (= tan x). 9563 DEFB $34 ;;end-calc tan x. 9564 9565 RET ; return. 9566 9567 ; --------------------- 9568 ; THE <b><font color=#333388>'ARCTAN'</font></b> FUNCTION 9569 ; --------------------- 9570 ; <font color=#339933>(Offset $21: 'atn')</font> 9571 ; The inverse tangent function with the result in radians. 9572 ; This is a fundamental transcendental function from which others such as 9573 ; asn and acs are directly, or indirectly, derived. 9574 ; It uses the series generator to produce Chebyshev polynomials. 9575 9576 <a name="L1D76"></a>;; <b>atn</b> 9577 L1D76: LD A,(HL) ; fetch exponent 9578 CP $81 ; compare to that for 'one' 9579 JR C,<A href="#L1D89">L1D89</a> ; forward, if less, to SMALL 9580 9581 RST 28H ;; FP-CALC X. 9582 DEFB $A1 ;;stk-one 9583 DEFB $18 ;;negate 9584 DEFB $01 ;;exchange 9585 DEFB $05 ;;division 9586 DEFB $2D ;;duplicate 9587 DEFB $32 ;;less-0 9588 DEFB $A3 ;;stk-pi/2 9589 DEFB $01 ;;exchange 9590 DEFB $00 ;;jump-true 9591 DEFB $06 ;;to <A href="#L1D8B">L1D8B</a>, CASES 9592 9593 DEFB $18 ;;negate 9594 DEFB $2F ;;jump 9595 DEFB $03 ;;to <A href="#L1D8B">L1D8B</a>, CASES 9596 9597 ; --- 9598 9599 <a name="L1D89"></a>;; <b>SMALL</b> 9600 L1D89: RST 28H ;; FP-CALC 9601 DEFB $A0 ;;stk-zero 9602 9603 <a name="L1D8B"></a>;; <b>CASES</b> 9604 L1D8B: DEFB $01 ;;exchange 9605 DEFB $2D ;;duplicate 9606 DEFB $2D ;;duplicate 9607 DEFB $04 ;;multiply 9608 DEFB $2D ;;duplicate 9609 DEFB $0F ;;addition 9610 DEFB $A1 ;;stk-one 9611 DEFB $03 ;;subtract 9612 9613 DEFB $8C ;;series-0C 9614 DEFB $10 ;;Exponent: $60, Bytes: 1 9615 DEFB $B2 ;;(+00,+00,+00) 9616 DEFB $13 ;;Exponent: $63, Bytes: 1 9617 DEFB $0E ;;(+00,+00,+00) 9618 DEFB $55 ;;Exponent: $65, Bytes: 2 9619 DEFB $E4,$8D ;;(+00,+00) 9620 DEFB $58 ;;Exponent: $68, Bytes: 2 9621 DEFB $39,$BC ;;(+00,+00) 9622 DEFB $5B ;;Exponent: $6B, Bytes: 2 9623 DEFB $98,$FD ;;(+00,+00) 9624 DEFB $9E ;;Exponent: $6E, Bytes: 3 9625 DEFB $00,$36,$75 ;;(+00) 9626 DEFB $A0 ;;Exponent: $70, Bytes: 3 9627 DEFB $DB,$E8,$B4 ;;(+00) 9628 DEFB $63 ;;Exponent: $73, Bytes: 2 9629 DEFB $42,$C4 ;;(+00,+00) 9630 DEFB $E6 ;;Exponent: $76, Bytes: 4 9631 DEFB $B5,$09,$36,$BE ;; 9632 DEFB $E9 ;;Exponent: $79, Bytes: 4 9633 DEFB $36,$73,$1B,$5D ;; 9634 DEFB $EC ;;Exponent: $7C, Bytes: 4 9635 DEFB $D8,$DE,$63,$BE ;; 9636 DEFB $F0 ;;Exponent: $80, Bytes: 4 9637 DEFB $61,$A1,$B3,$0C ;; 9638 9639 DEFB $04 ;;multiply 9640 DEFB $0F ;;addition 9641 DEFB $34 ;;end-calc 9642 9643 RET ; return. 9644 9645 9646 ; --------------------- 9647 ; THE <b><font color=#333388>'ARCSIN'</font></b> FUNCTION 9648 ; --------------------- 9649 ; <font color=#339933>(Offset $1F: 'asn')</font> 9650 ; The inverse sine function with result in radians. 9651 ; Derived from arctan function above. 9652 ; Error A unless the argument is between -1 and +1 inclusive. 9653 ; Uses an adaptation of the formula asn(x) = atn(x/sqr(1-x*x)) 9654 ; 9655 ; 9656 ; /| 9657 ; / | 9658 ; 1/ |x 9659 ; /a | 9660 ; /----| 9661 ; y 9662 ; 9663 ; e.g. We know the opposite side (x) and hypotenuse (1) 9664 ; and we wish to find angle a in radians. 9665 ; We can derive length y by Pythagoras and then use ATN instead. 9666 ; Since y*y + x*x = 1*1 (Pythagoras Theorem) then 9667 ; y=sqr(1-x*x) - no need to multiply 1 by itself. 9668 ; So, asn(a) = atn(x/y) 9669 ; or more fully, 9670 ; asn(a) = atn(x/sqr(1-x*x)) 9671 9672 ; Close but no cigar. 9673 9674 ; While PRINT ATN (x/SQR (1-x*x)) gives the same results as PRINT ASN x, 9675 ; it leads to division by zero when x is 1 or -1. 9676 ; To overcome this, 1 is added to y giving half the required angle and the 9677 ; result is then doubled. 9678 ; That is, PRINT ATN (x/(SQR (1-x*x) +1)) *2 9679 ; 9680 ; 9681 ; . /| 9682 ; . c/ | 9683 ; . /1 |x 9684 ; . c b /a | 9685 ; ---------/----| 9686 ; 1 y 9687 ; 9688 ; By creating an isosceles triangle with two equal sides of 1, angles c and 9689 ; c are also equal. If b+c+d = 180 degrees and b+a = 180 degrees then c=a/2. 9690 ; 9691 ; A value higher than 1 gives the required error as attempting to find the 9692 ; square root of a negative number generates an error in Sinclair BASIC. 9693 9694 <a name="L1DC4"></a>;; <b>asn</b> 9695 L1DC4: RST 28H ;; FP-CALC x. 9696 DEFB $2D ;;duplicate x, x. 9697 DEFB $2D ;;duplicate x, x, x. 9698 DEFB $04 ;;multiply x, x*x. 9699 DEFB $A1 ;;stk-one x, x*x, 1. 9700 DEFB $03 ;;subtract x, x*x-1. 9701 DEFB $18 ;;negate x, 1-x*x. 9702 DEFB $25 ;;sqr x, sqr(1-x*x) = y. 9703 DEFB $A1 ;;stk-one x, y, 1. 9704 DEFB $0F ;;addition x, y+1. 9705 DEFB $05 ;;division x/y+1. 9706 DEFB $21 ;;atn a/2 (half the angle) 9707 DEFB $2D ;;duplicate a/2, a/2. 9708 DEFB $0F ;;addition a. 9709 DEFB $34 ;;end-calc a. 9710 9711 RET ; return. 9712 9713 9714 ; ------------------------ 9715 ; THE <b><font color=#333388>'ARCCOS'</font></b> FUNCTION 9716 ; ------------------------ 9717 ; <font color=#339933>(Offset $20: 'acs')</font> 9718 ; The inverse cosine function with the result in radians. 9719 ; Error A unless the argument is between -1 and +1. 9720 ; Result in range 0 to pi. 9721 ; Derived from asn above which is in turn derived from the preceding atn. It 9722 ; could have been derived directly from atn using acs(x) = atn(sqr(1-x*x)/x). 9723 ; However, as sine and cosine are horizontal translations of each other, 9724 ; uses acs(x) = pi/2 - asn(x) 9725 9726 ; e.g. the arccosine of a known x value will give the required angle b in 9727 ; radians. 9728 ; We know, from above, how to calculate the angle a using asn(x). 9729 ; Since the three angles of any triangle add up to 180 degrees, or pi radians, 9730 ; and the largest angle in this case is a right-angle (pi/2 radians), then 9731 ; we can calculate angle b as pi/2 (both angles) minus asn(x) (angle a). 9732 ; 9733 ; 9734 ; /| 9735 ; 1 /b| 9736 ; / |x 9737 ; /a | 9738 ; /----| 9739 ; y 9740 9741 <a name="L1DD4"></a>;; <b>acs</b> 9742 L1DD4: RST 28H ;; FP-CALC x. 9743 DEFB $1F ;;asn asn(x). 9744 DEFB $A3 ;;stk-pi/2 asn(x), pi/2. 9745 DEFB $03 ;;subtract asn(x) - pi/2. 9746 DEFB $18 ;;negate pi/2 - asn(x) = acs(x). 9747 DEFB $34 ;;end-calc acs(x) 9748 9749 RET ; return. 9750 9751 9752 ; -------------------------- 9753 ; THE <b><font color=#333388>'SQUARE ROOT'</font></b> FUNCTION 9754 ; -------------------------- 9755 ; <font color=#339933>(Offset $25: 'sqr')</font> 9756 ; Error A if argument is negative. 9757 ; This routine is remarkable for its brevity - 7 bytes. 9758 ; The ZX81 code was originally 9K and various techniques had to be 9759 ; used to shoe-horn it into an 8K Rom chip. 9760 9761 9762 <a name="L1DDB"></a>;; <b>sqr</b> 9763 L1DDB: RST 28H ;; FP-CALC x. 9764 DEFB $2D ;;duplicate x, x. 9765 DEFB $2C ;;not x, 1/0 9766 DEFB $00 ;;jump-true x, (1/0). 9767 DEFB $1E ;;to <A href="#L1DFD">L1DFD</a>, LAST exit if argument zero 9768 ;; with zero result. 9769 9770 ; else continue to calculate as x ** .5 9771 9772 DEFB $A2 ;;stk-half x, .5. 9773 DEFB $34 ;;end-calc x, .5. 9774 9775 9776 ; ------------------------------ 9777 ; THE <b><font color=#333388>'EXPONENTIATION'</font></b> OPERATION 9778 ; ------------------------------ 9779 ; <font color=#339933>(Offset $06: 'to-power')</font> 9780 ; This raises the first number X to the power of the second number Y. 9781 ; As with the ZX80, 9782 ; 0 ** 0 = 1 9783 ; 0 ** +n = 0 9784 ; 0 ** -n = arithmetic overflow. 9785 9786 <a name="L1DE2"></a>;; <b>to-power</b> 9787 L1DE2: RST 28H ;; FP-CALC X,Y. 9788 DEFB $01 ;;exchange Y,X. 9789 DEFB $2D ;;duplicate Y,X,X. 9790 DEFB $2C ;;not Y,X,(1/0). 9791 DEFB $00 ;;jump-true 9792 DEFB $07 ;;forward to <A href="#L1DEE">L1DEE</a>, XISO if X is zero. 9793 9794 ; else X is non-zero. function 'ln' will catch a negative value of X. 9795 9796 DEFB $22 ;;ln Y, LN X. 9797 DEFB $04 ;;multiply Y * LN X 9798 DEFB $34 ;;end-calc 9799 9800 JP <A href="#L1C5B">L1C5B</a> ; jump back to EXP routine. -> 9801 9802 ; --- 9803 9804 ; These routines form the three simple results when the number is zero. 9805 ; begin by deleting the known zero to leave Y the power factor. 9806 9807 <a name="L1DEE"></a>;; <b>XISO</b> 9808 L1DEE: DEFB $02 ;;delete Y. 9809 DEFB $2D ;;duplicate Y, Y. 9810 DEFB $2C ;;not Y, (1/0). 9811 DEFB $00 ;;jump-true 9812 DEFB $09 ;;forward to <A href="#L1DFB">L1DFB</a>, ONE if Y is zero. 9813 9814 ; the power factor is not zero. If negative then an error exists. 9815 9816 DEFB $A0 ;;stk-zero Y, 0. 9817 DEFB $01 ;;exchange 0, Y. 9818 DEFB $33 ;;greater-0 0, (1/0). 9819 DEFB $00 ;;jump-true 0 9820 DEFB $06 ;;to <A href="#L1DFD">L1DFD</a>, LAST if Y was any positive 9821 ;; number. 9822 9823 ; else force division by zero thereby raising an Arithmetic overflow error. 9824 ; There are some one and two-byte alternatives but perhaps the most formal 9825 ; might have been to use end-calc; rst 08; defb 05. 9826 9827 DEFB $A1 ;;stk-one 0, 1. 9828 DEFB $01 ;;exchange 1, 0. 9829 DEFB $05 ;;division 1/0 >> error 9830 9831 ; --- 9832 9833 <a name="L1DFB"></a>;; <b>ONE</b> 9834 L1DFB: DEFB $02 ;;delete . 9835 DEFB $A1 ;;stk-one 1. 9836 9837 <a name="L1DFD"></a>;; <b>LAST</b> 9838 L1DFD: DEFB $34 ;;end-calc last value 1 or 0. 9839 9840 RET ; return. 9841 9842 ; --------------------- 9843 ; THE <b><font color=#333388>'SPARE LOCATIONS'</font></b> 9844 ; --------------------- 9845 9846 <a name="L1DFF"></a>;; <b>SPARE</b> 9847 L1DFF: DEFB $FF ; That's all folks. 9848 9849 9850 9851 ; ------------------------ 9852 ; THE <b><font color=#333388>'ZX81 CHARACTER SET'</font></b> 9853 ; ------------------------ 9854 9855 <a name="L1E00"></a>;; <b>char-set</b> - begins with space character. 9856 9857 ; $00 - <b>Character: ' ' </b>CHR$(0) 9858 9859 L<B>1</B>E00: DEFB %00000000 9860 DEFB %00000000 9861 DEFB %00000000 9862 DEFB %00000000 9863 DEFB %00000000 9864 DEFB %00000000 9865 DEFB %00000000 9866 DEFB %00000000 9867 9868 ; $01 - <b>Character: mosaic </b>CHR$(1) 9869 9870 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9871 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9872 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9873 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9874 DEFB %00000000 9875 DEFB %00000000 9876 DEFB %00000000 9877 DEFB %00000000 9878 9879 9880 ; $02 - <b>Character: mosaic </b>CHR$(2) 9881 9882 DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> 9883 DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> 9884 DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> 9885 DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> 9886 DEFB %00000000 9887 DEFB %00000000 9888 DEFB %00000000 9889 DEFB %00000000 9890 9891 9892 ; $03 - <b>Character: mosaic </b>CHR$(3) 9893 9894 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> 9895 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> 9896 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> 9897 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> 9898 DEFB %00000000 9899 DEFB %00000000 9900 DEFB %00000000 9901 DEFB %00000000 9902 9903 ; $04 - <b>Character: mosaic </b>CHR$(4) 9904 9905 DEFB %00000000 9906 DEFB %00000000 9907 DEFB %00000000 9908 DEFB %00000000 9909 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9910 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9911 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9912 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9913 9914 ; $05 - <b>Character: mosaic </b>CHR$(1) 9915 9916 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9917 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9918 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9919 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9920 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9921 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9922 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9923 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9924 9925 ; $06 - <b>Character: mosaic </b>CHR$(1) 9926 9927 DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> 9928 DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> 9929 DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> 9930 DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> 9931 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9932 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9933 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9934 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9935 9936 ; $07 - <b>Character: mosaic </b>CHR$(1) 9937 9938 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> 9939 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> 9940 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> 9941 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> 9942 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9943 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9944 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9945 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 9946 9947 ; $08 - <b>Character: mosaic </b>CHR$(1) 9948 9949 DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 9950 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> 9951 DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 9952 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> 9953 DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 9954 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> 9955 DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 9956 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> 9957 9958 ; $09 - <b>Character: mosaic </b>CHR$(1) 9959 9960 DEFB %00000000 9961 DEFB %00000000 9962 DEFB %00000000 9963 DEFB %00000000 9964 DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 9965 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> 9966 DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 9967 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> 9968 9969 ; $0A - <b>Character: mosaic </b>CHR$(10) 9970 9971 DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 9972 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> 9973 DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 9974 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> 9975 DEFB %00000000 9976 DEFB %00000000 9977 DEFB %00000000 9978 DEFB %00000000 9979 9980 ; $0B - <b>Character: '"' </b>CHR$(11) 9981 9982 DEFB %00000000 9983 DEFB %00<B>1</B>00<B>1</B>00 9984 DEFB %00<B>1</B>00<B>1</B>00 9985 DEFB %00000000 9986 DEFB %00000000 9987 DEFB %00000000 9988 DEFB %00000000 9989 DEFB %00000000 9990 9991 ; $0B - <b>Character: £ </b>CHR$(12) 9992 9993 DEFB %00000000 9994 DEFB %000<B>1</B><B>1</B><B>1</B>00 9995 DEFB %00<B>1</B>000<B>1</B>0 9996 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B>000 9997 DEFB %00<B>1</B>00000 9998 DEFB %00<B>1</B>00000 9999 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10000 DEFB %00000000 10001 10002 ; $0B - <b>Character: '$' </b>CHR$(13) 10003 10004 DEFB %00000000 10005 DEFB %0000<B>1</B>000 10006 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10007 DEFB %00<B>1</B>0<B>1</B>000 10008 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10009 DEFB %0000<B>1</B>0<B>1</B>0 10010 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10011 DEFB %0000<B>1</B>000 10012 10013 ; $0B - <b>Character: ':' </b>CHR$(14) 10014 10015 DEFB %00000000 10016 DEFB %00000000 10017 DEFB %00000000 10018 DEFB %000<B>1</B>0000 10019 DEFB %00000000 10020 DEFB %00000000 10021 DEFB %000<B>1</B>0000 10022 DEFB %00000000 10023 10024 ; $0B - <b>Character: '?' </b>CHR$(15) 10025 10026 DEFB %00000000 10027 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10028 DEFB %0<B>1</B>0000<B>1</B>0 10029 DEFB %00000<B>1</B>00 10030 DEFB %0000<B>1</B>000 10031 DEFB %00000000 10032 DEFB %0000<B>1</B>000 10033 DEFB %00000000 10034 10035 ; $10 - <b>Character: '(' </b>CHR$(16) 10036 10037 DEFB %00000000 10038 DEFB %00000<B>1</B>00 10039 DEFB %0000<B>1</B>000 10040 DEFB %0000<B>1</B>000 10041 DEFB %0000<B>1</B>000 10042 DEFB %0000<B>1</B>000 10043 DEFB %00000<B>1</B>00 10044 DEFB %00000000 10045 10046 ; $11 - <b>Character: ')' </b>CHR$(17) 10047 10048 DEFB %00000000 10049 DEFB %00<B>1</B>00000 10050 DEFB %000<B>1</B>0000 10051 DEFB %000<B>1</B>0000 10052 DEFB %000<B>1</B>0000 10053 DEFB %000<B>1</B>0000 10054 DEFB %00<B>1</B>00000 10055 DEFB %00000000 10056 10057 ; $12 - <b>Character: '>' </b>CHR$(18) 10058 10059 DEFB %00000000 10060 DEFB %00000000 10061 DEFB %000<B>1</B>0000 10062 DEFB %0000<B>1</B>000 10063 DEFB %00000<B>1</B>00 10064 DEFB %0000<B>1</B>000 10065 DEFB %000<B>1</B>0000 10066 DEFB %00000000 10067 10068 ; $13 - <b>Character: '<' </b>CHR$(19) 10069 10070 DEFB %00000000 10071 DEFB %00000000 10072 DEFB %00000<B>1</B>00 10073 DEFB %0000<B>1</B>000 10074 DEFB %000<B>1</B>0000 10075 DEFB %0000<B>1</B>000 10076 DEFB %00000<B>1</B>00 10077 DEFB %00000000 10078 10079 ; $14 - <b>Character: '=' </b>CHR$(20) 10080 10081 DEFB %00000000 10082 DEFB %00000000 10083 DEFB %00000000 10084 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10085 DEFB %00000000 10086 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10087 DEFB %00000000 10088 DEFB %00000000 10089 10090 ; $15 - <b>Character: '+' </b>CHR$(21) 10091 10092 DEFB %00000000 10093 DEFB %00000000 10094 DEFB %0000<B>1</B>000 10095 DEFB %0000<B>1</B>000 10096 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10097 DEFB %0000<B>1</B>000 10098 DEFB %0000<B>1</B>000 10099 DEFB %00000000 10100 10101 ; $16 - <b>Character: '-' </b>CHR$(22) 10102 10103 DEFB %00000000 10104 DEFB %00000000 10105 DEFB %00000000 10106 DEFB %00000000 10107 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10108 DEFB %00000000 10109 DEFB %00000000 10110 DEFB %00000000 10111 10112 ; $17 - <b>Character: '*' </b>CHR$(23) 10113 10114 DEFB %00000000 10115 DEFB %00000000 10116 DEFB %000<B>1</B>0<B>1</B>00 10117 DEFB %0000<B>1</B>000 10118 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10119 DEFB %0000<B>1</B>000 10120 DEFB %000<B>1</B>0<B>1</B>00 10121 DEFB %00000000 10122 10123 ; $18 - <b>Character: '/' </b>CHR$(24) 10124 10125 DEFB %00000000 10126 DEFB %00000000 10127 DEFB %000000<B>1</B>0 10128 DEFB %00000<B>1</B>00 10129 DEFB %0000<B>1</B>000 10130 DEFB %000<B>1</B>0000 10131 DEFB %00<B>1</B>00000 10132 DEFB %00000000 10133 10134 ; $19 - <b>Character: ';' </b>CHR$(25) 10135 10136 DEFB %00000000 10137 DEFB %00000000 10138 DEFB %000<B>1</B>0000 10139 DEFB %00000000 10140 DEFB %00000000 10141 DEFB %000<B>1</B>0000 10142 DEFB %000<B>1</B>0000 10143 DEFB %00<B>1</B>00000 10144 10145 ; $1A - <b>Character: ',' </b>CHR$(26) 10146 10147 DEFB %00000000 10148 DEFB %00000000 10149 DEFB %00000000 10150 DEFB %00000000 10151 DEFB %00000000 10152 DEFB %0000<B>1</B>000 10153 DEFB %0000<B>1</B>000 10154 DEFB %000<B>1</B>0000 10155 10156 ; $1B - <b>Character: '"' </b>CHR$(27) 10157 10158 DEFB %00000000 10159 DEFB %00000000 10160 DEFB %00000000 10161 DEFB %00000000 10162 DEFB %00000000 10163 DEFB %000<B>1</B><B>1</B>000 10164 DEFB %000<B>1</B><B>1</B>000 10165 DEFB %00000000 10166 10167 ; $1C - <b>Character: '0' </b>CHR$(28) 10168 10169 DEFB %00000000 10170 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10171 DEFB %0<B>1</B>000<B>1</B><B>1</B>0 10172 DEFB %0<B>1</B>00<B>1</B>0<B>1</B>0 10173 DEFB %0<B>1</B>0<B>1</B>00<B>1</B>0 10174 DEFB %0<B>1</B><B>1</B>000<B>1</B>0 10175 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10176 DEFB %00000000 10177 10178 ; $1D - <b>Character: '1' </b>CHR$(29) 10179 10180 DEFB %00000000 10181 DEFB %000<B>1</B><B>1</B>000 10182 DEFB %00<B>1</B>0<B>1</B>000 10183 DEFB %0000<B>1</B>000 10184 DEFB %0000<B>1</B>000 10185 DEFB %0000<B>1</B>000 10186 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10187 DEFB %00000000 10188 10189 ; $1E - <b>Character: '2' </b>CHR$(30) 10190 10191 DEFB %00000000 10192 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10193 DEFB %0<B>1</B>0000<B>1</B>0 10194 DEFB %000000<B>1</B>0 10195 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10196 DEFB %0<B>1</B>000000 10197 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10198 DEFB %00000000 10199 10200 ; $1F - <b>Character: '3' </b>CHR$(31) 10201 10202 DEFB %00000000 10203 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10204 DEFB %0<B>1</B>0000<B>1</B>0 10205 DEFB %0000<B>1</B><B>1</B>00 10206 DEFB %000000<B>1</B>0 10207 DEFB %0<B>1</B>0000<B>1</B>0 10208 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10209 DEFB %00000000 10210 10211 ; $20 - <b>Character: '4' </b>CHR$(32) 10212 10213 DEFB %00000000 10214 DEFB %0000<B>1</B>000 10215 DEFB %000<B>1</B><B>1</B>000 10216 DEFB %00<B>1</B>0<B>1</B>000 10217 DEFB %0<B>1</B>00<B>1</B>000 10218 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10219 DEFB %0000<B>1</B>000 10220 DEFB %00000000 10221 10222 ; $21 - <b>Character: '5' </b>CHR$(33) 10223 10224 DEFB %00000000 10225 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10226 DEFB %0<B>1</B>000000 10227 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 10228 DEFB %000000<B>1</B>0 10229 DEFB %0<B>1</B>0000<B>1</B>0 10230 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10231 DEFB %00000000 10232 10233 ; $22 - <b>Character: '6' </b>CHR$(34) 10234 10235 DEFB %00000000 10236 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10237 DEFB %0<B>1</B>000000 10238 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 10239 DEFB %0<B>1</B>0000<B>1</B>0 10240 DEFB %0<B>1</B>0000<B>1</B>0 10241 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10242 DEFB %00000000 10243 10244 ; $23 - <b>Character: '7' </b>CHR$(35) 10245 10246 DEFB %00000000 10247 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10248 DEFB %000000<B>1</B>0 10249 DEFB %00000<B>1</B>00 10250 DEFB %0000<B>1</B>000 10251 DEFB %000<B>1</B>0000 10252 DEFB %000<B>1</B>0000 10253 DEFB %00000000 10254 10255 ; $24 - <b>Character: '8' </b>CHR$(36) 10256 10257 DEFB %00000000 10258 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10259 DEFB %0<B>1</B>0000<B>1</B>0 10260 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10261 DEFB %0<B>1</B>0000<B>1</B>0 10262 DEFB %0<B>1</B>0000<B>1</B>0 10263 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10264 DEFB %00000000 10265 10266 ; $25 - <b>Character: '9' </b>CHR$(37) 10267 10268 DEFB %00000000 10269 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10270 DEFB %0<B>1</B>0000<B>1</B>0 10271 DEFB %0<B>1</B>0000<B>1</B>0 10272 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10273 DEFB %000000<B>1</B>0 10274 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10275 DEFB %00000000 10276 10277 ; $26 - <b>Character: 'A' </b>CHR$(38) 10278 10279 DEFB %00000000 10280 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10281 DEFB %0<B>1</B>0000<B>1</B>0 10282 DEFB %0<B>1</B>0000<B>1</B>0 10283 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10284 DEFB %0<B>1</B>0000<B>1</B>0 10285 DEFB %0<B>1</B>0000<B>1</B>0 10286 DEFB %00000000 10287 10288 ; $27 - <b>Character: 'B' </b>CHR$(39) 10289 10290 DEFB %00000000 10291 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 10292 DEFB %0<B>1</B>0000<B>1</B>0 10293 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 10294 DEFB %0<B>1</B>0000<B>1</B>0 10295 DEFB %0<B>1</B>0000<B>1</B>0 10296 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 10297 DEFB %00000000 10298 10299 ; $28 - <b>Character: 'C' </b>CHR$(40) 10300 10301 DEFB %00000000 10302 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10303 DEFB %0<B>1</B>0000<B>1</B>0 10304 DEFB %0<B>1</B>000000 10305 DEFB %0<B>1</B>000000 10306 DEFB %0<B>1</B>0000<B>1</B>0 10307 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10308 DEFB %00000000 10309 10310 ; $29 - <b>Character: 'D' </b>CHR$(41) 10311 10312 DEFB %00000000 10313 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B>000 10314 DEFB %0<B>1</B>000<B>1</B>00 10315 DEFB %0<B>1</B>0000<B>1</B>0 10316 DEFB %0<B>1</B>0000<B>1</B>0 10317 DEFB %0<B>1</B>000<B>1</B>00 10318 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B>000 10319 DEFB %00000000 10320 10321 ; $2A - <b>Character: 'E' </b>CHR$(42) 10322 10323 DEFB %00000000 10324 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10325 DEFB %0<B>1</B>000000 10326 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 10327 DEFB %0<B>1</B>000000 10328 DEFB %0<B>1</B>000000 10329 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10330 DEFB %00000000 10331 10332 ; $2B - <b>Character: 'F' </b>CHR$(43) 10333 10334 DEFB %00000000 10335 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10336 DEFB %0<B>1</B>000000 10337 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 10338 DEFB %0<B>1</B>000000 10339 DEFB %0<B>1</B>000000 10340 DEFB %0<B>1</B>000000 10341 DEFB %00000000 10342 10343 ; $2C - <b>Character: 'G' </b>CHR$(44) 10344 10345 DEFB %00000000 10346 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10347 DEFB %0<B>1</B>0000<B>1</B>0 10348 DEFB %0<B>1</B>000000 10349 DEFB %0<B>1</B>00<B>1</B><B>1</B><B>1</B>0 10350 DEFB %0<B>1</B>0000<B>1</B>0 10351 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10352 DEFB %00000000 10353 10354 ; $2D - <b>Character: 'H' </b>CHR$(45) 10355 10356 DEFB %00000000 10357 DEFB %0<B>1</B>0000<B>1</B>0 10358 DEFB %0<B>1</B>0000<B>1</B>0 10359 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10360 DEFB %0<B>1</B>0000<B>1</B>0 10361 DEFB %0<B>1</B>0000<B>1</B>0 10362 DEFB %0<B>1</B>0000<B>1</B>0 10363 DEFB %00000000 10364 10365 ; $2E - <b>Character: 'I' </b>CHR$(46) 10366 10367 DEFB %00000000 10368 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10369 DEFB %0000<B>1</B>000 10370 DEFB %0000<B>1</B>000 10371 DEFB %0000<B>1</B>000 10372 DEFB %0000<B>1</B>000 10373 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10374 DEFB %00000000 10375 10376 ; $2F - <b>Character: 'J' </b>CHR$(47) 10377 10378 DEFB %00000000 10379 DEFB %000000<B>1</B>0 10380 DEFB %000000<B>1</B>0 10381 DEFB %000000<B>1</B>0 10382 DEFB %0<B>1</B>0000<B>1</B>0 10383 DEFB %0<B>1</B>0000<B>1</B>0 10384 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10385 DEFB %00000000 10386 10387 ; $30 - <b>Character: 'K' </b>CHR$(48) 10388 10389 DEFB %00000000 10390 DEFB %0<B>1</B>000<B>1</B>00 10391 DEFB %0<B>1</B>00<B>1</B>000 10392 DEFB %0<B>1</B><B>1</B><B>1</B>0000 10393 DEFB %0<B>1</B>00<B>1</B>000 10394 DEFB %0<B>1</B>000<B>1</B>00 10395 DEFB %0<B>1</B>0000<B>1</B>0 10396 DEFB %00000000 10397 10398 ; $31 - <b>Character: 'L' </b>CHR$(49) 10399 10400 DEFB %00000000 10401 DEFB %0<B>1</B>000000 10402 DEFB %0<B>1</B>000000 10403 DEFB %0<B>1</B>000000 10404 DEFB %0<B>1</B>000000 10405 DEFB %0<B>1</B>000000 10406 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10407 DEFB %00000000 10408 10409 ; $32 - <b>Character: 'M' </b>CHR$(50) 10410 10411 DEFB %00000000 10412 DEFB %0<B>1</B>0000<B>1</B>0 10413 DEFB %0<B>1</B><B>1</B>00<B>1</B><B>1</B>0 10414 DEFB %0<B>1</B>0<B>1</B><B>1</B>0<B>1</B>0 10415 DEFB %0<B>1</B>0000<B>1</B>0 10416 DEFB %0<B>1</B>0000<B>1</B>0 10417 DEFB %0<B>1</B>0000<B>1</B>0 10418 DEFB %00000000 10419 10420 ; $33 - <b>Character: 'N' </b>CHR$(51) 10421 10422 DEFB %00000000 10423 DEFB %0<B>1</B>0000<B>1</B>0 10424 DEFB %0<B>1</B><B>1</B>000<B>1</B>0 10425 DEFB %0<B>1</B>0<B>1</B>00<B>1</B>0 10426 DEFB %0<B>1</B>00<B>1</B>0<B>1</B>0 10427 DEFB %0<B>1</B>000<B>1</B><B>1</B>0 10428 DEFB %0<B>1</B>0000<B>1</B>0 10429 DEFB %00000000 10430 10431 ; $34 - <b>Character: 'O' </b>CHR$(52) 10432 10433 DEFB %00000000 10434 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10435 DEFB %0<B>1</B>0000<B>1</B>0 10436 DEFB %0<B>1</B>0000<B>1</B>0 10437 DEFB %0<B>1</B>0000<B>1</B>0 10438 DEFB %0<B>1</B>0000<B>1</B>0 10439 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10440 DEFB %00000000 10441 10442 ; $35 - <b>Character: 'P' </b>CHR$(53) 10443 10444 DEFB %00000000 10445 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 10446 DEFB %0<B>1</B>0000<B>1</B>0 10447 DEFB %0<B>1</B>0000<B>1</B>0 10448 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 10449 DEFB %0<B>1</B>000000 10450 DEFB %0<B>1</B>000000 10451 DEFB %00000000 10452 10453 ; $36 - <b>Character: 'Q' </b>CHR$(54) 10454 10455 DEFB %00000000 10456 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10457 DEFB %0<B>1</B>0000<B>1</B>0 10458 DEFB %0<B>1</B>0000<B>1</B>0 10459 DEFB %0<B>1</B>0<B>1</B>00<B>1</B>0 10460 DEFB %0<B>1</B>00<B>1</B>0<B>1</B>0 10461 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10462 DEFB %00000000 10463 10464 ; $37 - <b>Character: 'R' </b>CHR$(55) 10465 10466 DEFB %00000000 10467 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 10468 DEFB %0<B>1</B>0000<B>1</B>0 10469 DEFB %0<B>1</B>0000<B>1</B>0 10470 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 10471 DEFB %0<B>1</B>000<B>1</B>00 10472 DEFB %0<B>1</B>0000<B>1</B>0 10473 DEFB %00000000 10474 10475 ; $38 - <b>Character: 'S' </b>CHR$(56) 10476 10477 DEFB %00000000 10478 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10479 DEFB %0<B>1</B>000000 10480 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10481 DEFB %000000<B>1</B>0 10482 DEFB %0<B>1</B>0000<B>1</B>0 10483 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10484 DEFB %00000000 10485 10486 ; $39 - <b>Character: 'T' </b>CHR$(57) 10487 10488 DEFB %00000000 10489 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10490 DEFB %000<B>1</B>0000 10491 DEFB %000<B>1</B>0000 10492 DEFB %000<B>1</B>0000 10493 DEFB %000<B>1</B>0000 10494 DEFB %000<B>1</B>0000 10495 DEFB %00000000 10496 10497 ; $3A - <b>Character: 'U' </b>CHR$(58) 10498 10499 DEFB %00000000 10500 DEFB %0<B>1</B>0000<B>1</B>0 10501 DEFB %0<B>1</B>0000<B>1</B>0 10502 DEFB %0<B>1</B>0000<B>1</B>0 10503 DEFB %0<B>1</B>0000<B>1</B>0 10504 DEFB %0<B>1</B>0000<B>1</B>0 10505 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 10506 DEFB %00000000 10507 10508 ; $3B - <b>Character: 'V' </b>CHR$(59) 10509 10510 DEFB %00000000 10511 DEFB %0<B>1</B>0000<B>1</B>0 10512 DEFB %0<B>1</B>0000<B>1</B>0 10513 DEFB %0<B>1</B>0000<B>1</B>0 10514 DEFB %0<B>1</B>0000<B>1</B>0 10515 DEFB %00<B>1</B>00<B>1</B>00 10516 DEFB %000<B>1</B><B>1</B>000 10517 DEFB %00000000 10518 10519 ; $3C - <b>Character: 'W' </b>CHR$(60) 10520 10521 DEFB %00000000 10522 DEFB %0<B>1</B>0000<B>1</B>0 10523 DEFB %0<B>1</B>0000<B>1</B>0 10524 DEFB %0<B>1</B>0000<B>1</B>0 10525 DEFB %0<B>1</B>0000<B>1</B>0 10526 DEFB %0<B>1</B>0<B>1</B><B>1</B>0<B>1</B>0 10527 DEFB %00<B>1</B>00<B>1</B>00 10528 DEFB %00000000 10529 10530 ; $3D - <b>Character: 'X' </b>CHR$(61) 10531 10532 DEFB %00000000 10533 DEFB %0<B>1</B>0000<B>1</B>0 10534 DEFB %00<B>1</B>00<B>1</B>00 10535 DEFB %000<B>1</B><B>1</B>000 10536 DEFB %000<B>1</B><B>1</B>000 10537 DEFB %00<B>1</B>00<B>1</B>00 10538 DEFB %0<B>1</B>0000<B>1</B>0 10539 DEFB %00000000 10540 10541 ; $3E - <b>Character: 'Y' </b>CHR$(62) 10542 10543 DEFB %00000000 10544 DEFB %<B>1</B>00000<B>1</B>0 10545 DEFB %0<B>1</B>000<B>1</B>00 10546 DEFB %00<B>1</B>0<B>1</B>000 10547 DEFB %000<B>1</B>0000 10548 DEFB %000<B>1</B>0000 10549 DEFB %000<B>1</B>0000 10550 DEFB %00000000 10551 10552 ; $3F - <b>Character: 'Z' </b>CHR$(63) 10553 10554 DEFB %00000000 10555 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10556 DEFB %00000<B>1</B>00 10557 DEFB %0000<B>1</B>000 10558 DEFB %000<B>1</B>0000 10559 DEFB %00<B>1</B>00000 10560 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 10561 DEFB %00000000 10562 10563 .END ;TASM assembler instruction. 10564 10565 10566 </PRE> 10567 </BODY> 10568 </HTML>