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