; =========================================================== ; An Assembly Listing of the Operating System of the ZX81 ROM ; =========================================================== ; ------------------------- ; Last updated: 13-DEC-2004 ; ------------------------- ; ; Work in progress. ; This file will cross-assemble an original version of the "Improved" ; ZX81 ROM. The file can be modified to change the behaviour of the ROM ; when used in emulators although there is no spare space available. ; ; The documentation is incomplete and if you can find a copy ; of "The Complete Spectrum ROM Disassembly" then many routines ; such as POINTERS and most of the mathematical routines are ; similar and often identical. ; ; I've used the labels from the above book in this file and also ; some from the more elusive Complete ZX81 ROM Disassembly ; by the same publishers, Melbourne House. #define DEFB .BYTE ; TASM cross-assembler definitions #define DEFW .WORD #define EQU .EQU ;***************************************** ;** Part 1. RESTART ROUTINES AND TABLES ** ;***************************************** ; ----------- ; THE 'START' ; ----------- ; All Z80 chips start at location zero. ; At start-up the Interrupt Mode is 0, ZX computers use Interrupt Mode 1. ; Interrupts are disabled . ;; START L0000: OUT ($FD),A ; Turn off the NMI generator if this ROM is ; running in ZX81 hardware. This does nothing ; if this ROM is running within an upgraded ; ZX80. LD BC,$7FFF ; Set BC to the top of possible RAM. ; The higher unpopulated addresses are used for ; video generation. JP L03CB ; Jump forward to RAM-CHECK. ; ------------------- ; THE 'ERROR' RESTART ; ------------------- ; The error restart deals immediately with an error. ZX computers execute the ; same code in runtime as when checking syntax. If the error occurred while ; running a program then a brief report is produced. If the error occurred ; while entering a BASIC line or in input etc., then the error marker indicates ; the exact point at which the error lies. ;; ERROR-1 L0008: LD HL,($4016) ; fetch character address from CH_ADD. LD ($4018),HL ; and set the error pointer X_PTR. JR L0056 ; forward to continue at ERROR-2. ; ------------------------------- ; THE 'PRINT A CHARACTER' RESTART ; ------------------------------- ; This restart prints the character in the accumulator using the alternate ; register set so there is no requirement to save the main registers. ; There is sufficient room available to separate a space (zero) from other ; characters as leading spaces need not be considered with a space. ;; PRINT-A L0010: AND A ; test for zero - space. JP NZ,L07F1 ; jump forward if not to PRINT-CH. JP L07F5 ; jump forward to PRINT-SP. ; --- DEFB $FF ; unused location. ; --------------------------------- ; THE 'COLLECT A CHARACTER' RESTART ; --------------------------------- ; The character addressed by the system variable CH_ADD is fetched and if it ; is a non-space, non-cursor character it is returned else CH_ADD is ; incremented and the new addressed character tested until it is not a space. ;; GET-CHAR L0018: LD HL,($4016) ; set HL to character address CH_ADD. LD A,(HL) ; fetch addressed character to A. ;; TEST-SP L001C: AND A ; test for space. RET NZ ; return if not a space NOP ; else trickle through NOP ; to the next routine. ; ------------------------------------ ; THE 'COLLECT NEXT CHARACTER' RESTART ; ------------------------------------ ; The character address in incremented and the new addressed character is ; returned if not a space, or cursor, else the process is repeated. ;; NEXT-CHAR L0020: CALL L0049 ; routine CH-ADD+1 gets next immediate ; character. JR L001C ; back to TEST-SP. ; --- DEFB $FF, $FF, $FF ; unused locations. ; --------------------------------------- ; THE 'FLOATING POINT CALCULATOR' RESTART ; --------------------------------------- ; this restart jumps to the recursive floating-point calculator. ; the ZX81's internal, FORTH-like, stack-based language. ; ; In the five remaining bytes there is, appropriately, enough room for the ; end-calc literal - the instruction which exits the calculator. ;; FP-CALC L0028: JP L199D ; jump immediately to the CALCULATE routine. ; --- ;; end-calc L002B: POP AF ; drop the calculator return address RE-ENTRY EXX ; switch to the other set. EX (SP),HL ; transfer H'L' to machine stack for the ; return address. ; when exiting recursion then the previous ; pointer is transferred to H'L'. EXX ; back to main set. RET ; return. ; ----------------------------- ; THE 'MAKE BC SPACES' RESTART ; ----------------------------- ; This restart is used eight times to create, in workspace, the number of ; spaces passed in the BC register. ;; BC-SPACES L0030: PUSH BC ; push number of spaces on stack. LD HL,($4014) ; fetch edit line location from E_LINE. PUSH HL ; save this value on stack. JP L1488 ; jump forward to continue at RESERVE. ; ----------------------- ; THE 'INTERRUPT' RESTART ; ----------------------- ; The Mode 1 Interrupt routine is concerned solely with generating the central ; television picture. ; On the ZX81 interrupts are enabled only during the interrupt routine, ; although the interrupt ; This Interrupt Service Routine automatically disables interrupts at the ; outset and the last interrupt in a cascade exits before the interrupts are ; enabled. ; There is no DI instruction in the ZX81 ROM. ; An maskable interrupt is triggered when bit 6 of the Z80's Refresh register ; changes from set to reset. ; The Z80 will always be executing a HALT (NEWLINE) when the interrupt occurs. ; A HALT instruction repeatedly executes NOPS but the seven lower bits ; of the Refresh register are incremented each time as they are when any ; simple instruction is executed. (The lower 7 bits are incremented twice for ; a prefixed instruction) ; This is controlled by the Sinclair Computer Logic Chip - manufactured from ; a Ferranti Uncommitted Logic Array. ; ; When a Mode 1 Interrupt occurs the Program Counter, which is the address in ; the upper echo display following the NEWLINE/HALT instruction, goes on the ; machine stack. 193 interrupts are required to generate the last part of ; the 56th border line and then the 192 lines of the central TV picture and, ; although each interrupt interrupts the previous one, there are no stack ; problems as the 'return address' is discarded each time. ; ; The scan line counter in C counts down from 8 to 1 within the generation of ; each text line. For the first interrupt in a cascade the initial value of ; C is set to 1 for the last border line. ; Timing is of the utmost importance as the RH border, horizontal retrace ; and LH border are mostly generated in the 58 clock cycles this routine ; takes . ;; INTERRUPT L0038: DEC C ; (4) decrement C - the scan line counter. JP NZ,L0045 ; (10/10) JUMP forward if not zero to SCAN-LINE POP HL ; (10) point to start of next row in display ; file. DEC B ; (4) decrement the row counter. (4) RET Z ; (11/5) return when picture complete to L028B ; with interrupts disabled. SET 3,C ; (8) Load the scan line counter with eight. ; Note. LD C,$08 is 7 clock cycles which ; is way too fast. ; -> ;; WAIT-INT L0041: LD R,A ; (9) Load R with initial rising value $DD. EI ; (4) Enable Interrupts. [ R is now $DE ]. JP (HL) ; (4) jump to the echo display file in upper ; memory and execute characters $00 - $3F ; as NOP instructions. The video hardware ; is able to read these characters and, ; with the I register is able to convert ; the character bitmaps in this ROM into a ; line of bytes. Eventually the NEWLINE/HALT ; will be encountered before R reaches $FF. ; It is however the transition from $FF to ; $80 that triggers the next interrupt. ; [ The Refresh register is now $DF ] ; --- ;; SCAN-LINE L0045: POP DE ; (10) discard the address after NEWLINE as the ; same text line has to be done again ; eight times. RET Z ; (5) Harmless Nonsensical Timing. ; (condition never met) JR L0041 ; (12) back to WAIT-INT ; Note. that a computer with less than 4K or RAM will have a collapsed ; display file and the above mechanism deals with both types of display. ; ; With a full display, the 32 characters in the line are treated as NOPS ; and the Refresh register rises from $E0 to $FF and, at the next instruction ; - HALT, the interrupt occurs. ; With a collapsed display and an initial NEWLINE/HALT, it is the NOPs ; generated by the HALT that cause the Refresh value to rise from $E0 to $FF, ; triggering an Interrupt on the next transition. ; This works happily for all display lines between these extremes and the ; generation of the 32 character, 1 pixel high, line will always take 128 ; clock cycles. ; --------------------------------- ; THE 'INCREMENT CH-ADD' SUBROUTINE ; --------------------------------- ; This is the subroutine that increments the character address system variable ; and returns if it is not the cursor character. The ZX81 has an actual ; character at the cursor position rather than a pointer system variable ; as is the case with prior and subsequent ZX computers. ;; CH-ADD+1 L0049: LD HL,($4016) ; fetch character address to CH_ADD. ;; TEMP-PTR1 L004C: INC HL ; address next immediate location. ;; TEMP-PTR2 L004D: LD ($4016),HL ; update system variable CH_ADD. LD A,(HL) ; fetch the character. CP $7F ; compare to cursor character. RET NZ ; return if not the cursor. JR L004C ; back for next character to TEMP-PTR1. ; -------------------- ; THE 'ERROR-2' BRANCH ; -------------------- ; This is a continuation of the error restart. ; If the error occurred in runtime then the error stack pointer will probably ; lead to an error report being printed unless it occurred during input. ; If the error occurred when checking syntax then the error stack pointer ; will be an editing routine and the position of the error will be shown ; when the lower screen is reprinted. ;; ERROR-2 L0056: POP HL ; pop the return address which points to the ; DEFB, error code, after the RST 08. LD L,(HL) ; load L with the error code. HL is not needed ; anymore. ;; ERROR-3 L0058: LD (IY+$00),L ; place error code in system variable ERR_NR LD SP,($4002) ; set the stack pointer from ERR_SP CALL L0207 ; routine SLOW/FAST selects slow mode. JP L14BC ; exit to address on stack via routine SET-MIN. ; --- DEFB $FF ; unused. ; ------------------------------------ ; THE 'NON MASKABLE INTERRUPT' ROUTINE ; ------------------------------------ ; Jim Westwood's technical dodge using Non-Maskable Interrupts solved the ; flicker problem of the ZX80 and gave the ZX81 a multi-tasking SLOW mode ; with a steady display. Note that the AF' register is reserved for this ; function and its interaction with the display routines. When counting ; TV lines, the NMI makes no use of the main registers. ; The circuitry for the NMI generator is contained within the SCL (Sinclair ; Computer Logic) chip. ; ( It takes 32 clock cycles while incrementing towards zero ). ;; NMI L0066: EX AF,AF' ; (4) switch in the NMI's copy of the ; accumulator. INC A ; (4) increment. JP M,L006D ; (10/10) jump, if minus, to NMI-RET as this is ; part of a test to see if the NMI ; generation is working or an intermediate ; value for the ascending negated blank ; line counter. JR Z,L006F ; (12) forward to NMI-CONT ; when line count has incremented to zero. ; Note. the synchronizing NMI when A increments from zero to one takes this ; 7 clock cycle route making 39 clock cycles in all. ;; NMI-RET L006D: EX AF,AF' ; (4) switch out the incremented line counter ; or test result $80 RET ; (10) return to User application for a while. ; --- ; This branch is taken when the 55 (or 31) lines have been drawn. ;; NMI-CONT L006F: EX AF,AF' ; (4) restore the main accumulator. PUSH AF ; (11) * Save Main Registers PUSH BC ; (11) ** PUSH DE ; (11) *** PUSH HL ; (11) **** ; the next set-up procedure is only really applicable when the top set of ; blank lines have been generated. LD HL,($400C) ; (16) fetch start of Display File from D_FILE ; points to the HALT at beginning. SET 7,H ; (8) point to upper 32K 'echo display file' HALT ; (1) HALT synchronizes with NMI. ; Used with special hardware connected to the ; Z80 HALT and WAIT lines to take 1 clock cycle. ; ---------------------------------------------------------------------------- ; the NMI has been generated - start counting. The cathode ray is at the RH ; side of the TV. ; First the NMI servicing, similar to CALL = 17 clock cycles. ; Then the time taken by the NMI for zero-to-one path = 39 cycles ; The HALT above = 01 cycles. ; The two instructions below = 19 cycles. ; The code at L0281 up to and including the CALL = 43 cycles. ; The Called routine at L02B5 = 24 cycles. ; -------------------------------------- --- ; Total Z80 instructions = 143 cycles. ; ; Meanwhile in TV world, ; Horizontal retrace = 15 cycles. ; Left blanking border 8 character positions = 32 cycles ; Generation of 75% scanline from the first NEWLINE = 96 cycles ; --------------------------------------- --- ; 143 cycles ; ; Since at the time the first JP (HL) is encountered to execute the echo ; display another 8 character positions have to be put out, then the ; Refresh register need to hold $F8. Working back and counteracting ; the fact that every instruction increments the Refresh register then ; the value that is loaded into R needs to be $F5. :-) ; ; OUT ($FD),A ; (11) Stop the NMI generator. JP (IX) ; (8) forward to L0281 (after top) or L028F ; **************** ; ** KEY TABLES ** ; **************** ; ------------------------------- ; THE 'UNSHIFTED' CHARACTER CODES ; ------------------------------- ;; K-UNSHIFT L007E: DEFB $3F ; Z DEFB $3D ; X DEFB $28 ; C DEFB $3B ; V DEFB $26 ; A DEFB $38 ; S DEFB $29 ; D DEFB $2B ; F DEFB $2C ; G DEFB $36 ; Q DEFB $3C ; W DEFB $2A ; E DEFB $37 ; R DEFB $39 ; T DEFB $1D ; 1 DEFB $1E ; 2 DEFB $1F ; 3 DEFB $20 ; 4 DEFB $21 ; 5 DEFB $1C ; 0 DEFB $25 ; 9 DEFB $24 ; 8 DEFB $23 ; 7 DEFB $22 ; 6 DEFB $35 ; P DEFB $34 ; O DEFB $2E ; I DEFB $3A ; U DEFB $3E ; Y DEFB $76 ; NEWLINE DEFB $31 ; L DEFB $30 ; K DEFB $2F ; J DEFB $2D ; H DEFB $00 ; SPACE DEFB $1B ; . DEFB $32 ; M DEFB $33 ; N DEFB $27 ; B ; ----------------------------- ; THE 'SHIFTED' CHARACTER CODES ; ----------------------------- ;; K-SHIFT L00A5: DEFB $0E ; : DEFB $19 ; ; DEFB $0F ; ? DEFB $18 ; / DEFB $E3 ; STOP DEFB $E1 ; LPRINT DEFB $E4 ; SLOW DEFB $E5 ; FAST DEFB $E2 ; LLIST DEFB $C0 ; "" DEFB $D9 ; OR DEFB $E0 ; STEP DEFB $DB ; <= DEFB $DD ; <> DEFB $75 ; EDIT DEFB $DA ; AND DEFB $DE ; THEN DEFB $DF ; TO DEFB $72 ; cursor-left DEFB $77 ; RUBOUT DEFB $74 ; GRAPHICS DEFB $73 ; cursor-right DEFB $70 ; cursor-up DEFB $71 ; cursor-down DEFB $0B ; " DEFB $11 ; ) DEFB $10 ; ( DEFB $0D ; $ DEFB $DC ; >= DEFB $79 ; FUNCTION DEFB $14 ; = DEFB $15 ; + DEFB $16 ; - DEFB $D8 ; ** DEFB $0C ; ukp DEFB $1A ; , DEFB $12 ; > DEFB $13 ; < DEFB $17 ; * ; ------------------------------ ; THE 'FUNCTION' CHARACTER CODES ; ------------------------------ ;; K-FUNCT L00CC: DEFB $CD ; LN DEFB $CE ; EXP DEFB $C1 ; AT DEFB $78 ; KL DEFB $CA ; ASN DEFB $CB ; ACS DEFB $CC ; ATN DEFB $D1 ; SGN DEFB $D2 ; ABS DEFB $C7 ; SIN DEFB $C8 ; COS DEFB $C9 ; TAN DEFB $CF ; INT DEFB $40 ; RND DEFB $78 ; KL DEFB $78 ; KL DEFB $78 ; KL DEFB $78 ; KL DEFB $78 ; KL DEFB $78 ; KL DEFB $78 ; KL DEFB $78 ; KL DEFB $78 ; KL DEFB $78 ; KL DEFB $C2 ; TAB DEFB $D3 ; PEEK DEFB $C4 ; CODE DEFB $D6 ; CHR$ DEFB $D5 ; STR$ DEFB $78 ; KL DEFB $D4 ; USR DEFB $C6 ; LEN DEFB $C5 ; VAL DEFB $D0 ; SQR DEFB $78 ; KL DEFB $78 ; KL DEFB $42 ; PI DEFB $D7 ; NOT DEFB $41 ; INKEY$ ; ----------------------------- ; THE 'GRAPHIC' CHARACTER CODES ; ----------------------------- ;; K-GRAPH L00F3: DEFB $08 ; graphic DEFB $0A ; graphic DEFB $09 ; graphic DEFB $8A ; graphic DEFB $89 ; graphic DEFB $81 ; graphic DEFB $82 ; graphic DEFB $07 ; graphic DEFB $84 ; graphic DEFB $06 ; graphic DEFB $01 ; graphic DEFB $02 ; graphic DEFB $87 ; graphic DEFB $04 ; graphic DEFB $05 ; graphic DEFB $77 ; RUBOUT DEFB $78 ; KL DEFB $85 ; graphic DEFB $03 ; graphic DEFB $83 ; graphic DEFB $8B ; graphic DEFB $91 ; inverse ) DEFB $90 ; inverse ( DEFB $8D ; inverse $ DEFB $86 ; graphic DEFB $78 ; KL DEFB $92 ; inverse > DEFB $95 ; inverse + DEFB $96 ; inverse - DEFB $88 ; graphic ; ------------------ ; THE 'TOKEN' TABLES ; ------------------ ;; TOKENS L0111: DEFB $0F+$80 ; '?'+$80 DEFB $0B,$0B+$80 ; "" DEFB $26,$39+$80 ; AT DEFB $39,$26,$27+$80 ; TAB DEFB $0F+$80 ; '?'+$80 DEFB $28,$34,$29,$2A+$80 ; CODE DEFB $3B,$26,$31+$80 ; VAL DEFB $31,$2A,$33+$80 ; LEN DEFB $38,$2E,$33+$80 ; SIN DEFB $28,$34,$38+$80 ; COS DEFB $39,$26,$33+$80 ; TAN DEFB $26,$38,$33+$80 ; ASN DEFB $26,$28,$38+$80 ; ACS DEFB $26,$39,$33+$80 ; ATN DEFB $31,$33+$80 ; LN DEFB $2A,$3D,$35+$80 ; EXP DEFB $2E,$33,$39+$80 ; INT DEFB $38,$36,$37+$80 ; SQR DEFB $38,$2C,$33+$80 ; SGN DEFB $26,$27,$38+$80 ; ABS DEFB $35,$2A,$2A,$30+$80 ; PEEK DEFB $3A,$38,$37+$80 ; USR DEFB $38,$39,$37,$0D+$80 ; STR$ DEFB $28,$2D,$37,$0D+$80 ; CHR$ DEFB $33,$34,$39+$80 ; NOT DEFB $17,$17+$80 ; ** DEFB $34,$37+$80 ; OR DEFB $26,$33,$29+$80 ; AND DEFB $13,$14+$80 ; <= DEFB $12,$14+$80 ; >= DEFB $13,$12+$80 ; <> DEFB $39,$2D,$2A,$33+$80 ; THEN DEFB $39,$34+$80 ; TO DEFB $38,$39,$2A,$35+$80 ; STEP DEFB $31,$35,$37,$2E,$33,$39+$80 ; LPRINT DEFB $31,$31,$2E,$38,$39+$80 ; LLIST DEFB $38,$39,$34,$35+$80 ; STOP DEFB $38,$31,$34,$3C+$80 ; SLOW DEFB $2B,$26,$38,$39+$80 ; FAST DEFB $33,$2A,$3C+$80 ; NEW DEFB $38,$28,$37,$34,$31,$31+$80 ; SCROLL DEFB $28,$34,$33,$39+$80 ; CONT DEFB $29,$2E,$32+$80 ; DIM DEFB $37,$2A,$32+$80 ; REM DEFB $2B,$34,$37+$80 ; FOR DEFB $2C,$34,$39,$34+$80 ; GOTO DEFB $2C,$34,$38,$3A,$27+$80 ; GOSUB DEFB $2E,$33,$35,$3A,$39+$80 ; INPUT DEFB $31,$34,$26,$29+$80 ; LOAD DEFB $31,$2E,$38,$39+$80 ; LIST DEFB $31,$2A,$39+$80 ; LET DEFB $35,$26,$3A,$38,$2A+$80 ; PAUSE DEFB $33,$2A,$3D,$39+$80 ; NEXT DEFB $35,$34,$30,$2A+$80 ; POKE DEFB $35,$37,$2E,$33,$39+$80 ; PRINT DEFB $35,$31,$34,$39+$80 ; PLOT DEFB $37,$3A,$33+$80 ; RUN DEFB $38,$26,$3B,$2A+$80 ; SAVE DEFB $37,$26,$33,$29+$80 ; RAND DEFB $2E,$2B+$80 ; IF DEFB $28,$31,$38+$80 ; CLS DEFB $3A,$33,$35,$31,$34,$39+$80 ; UNPLOT DEFB $28,$31,$2A,$26,$37+$80 ; CLEAR DEFB $37,$2A,$39,$3A,$37,$33+$80 ; RETURN DEFB $28,$34,$35,$3E+$80 ; COPY DEFB $37,$33,$29+$80 ; RND DEFB $2E,$33,$30,$2A,$3E,$0D+$80 ; INKEY$ DEFB $35,$2E+$80 ; PI ; ------------------------------ ; THE 'LOAD-SAVE UPDATE' ROUTINE ; ------------------------------ ; ; ;; LOAD/SAVE L01FC: INC HL ; EX DE,HL ; LD HL,($4014) ; system variable edit line E_LINE. SCF ; set carry flag SBC HL,DE ; EX DE,HL ; RET NC ; return if more bytes to load/save. POP HL ; else drop return address ; ---------------------- ; THE 'DISPLAY' ROUTINES ; ---------------------- ; ; ;; SLOW/FAST L0207: LD HL,$403B ; Address the system variable CDFLAG. LD A,(HL) ; Load value to the accumulator. RLA ; rotate bit 6 to position 7. XOR (HL) ; exclusive or with original bit 7. RLA ; rotate result out to carry. RET NC ; return if both bits were the same. ; Now test if this really is a ZX81 or a ZX80 running the upgraded ROM. ; The standard ZX80 did not have an NMI generator. LD A,$7F ; Load accumulator with %011111111 EX AF,AF' ; save in AF' LD B,$11 ; A counter within which an NMI should occur ; if this is a ZX81. OUT ($FE),A ; start the NMI generator. ; Note that if this is a ZX81 then the NMI will increment AF'. ;; LOOP-11 L0216: DJNZ L0216 ; self loop to give the NMI a chance to kick in. ; = 16*13 clock cycles + 8 = 216 clock cycles. OUT ($FD),A ; Turn off the NMI generator. EX AF,AF' ; bring back the AF' value. RLA ; test bit 7. JR NC,L0226 ; forward, if bit 7 is still reset, to NO-SLOW. ; If the AF' was incremented then the NMI generator works and SLOW mode can ; be set. SET 7,(HL) ; Indicate SLOW mode - Compute and Display. PUSH AF ; * Save Main Registers PUSH BC ; ** PUSH DE ; *** PUSH HL ; **** JR L0229 ; skip forward - to DISPLAY-1. ; --- ;; NO-SLOW L0226: RES 6,(HL) ; reset bit 6 of CDFLAG. RET ; return. ; ----------------------- ; THE 'MAIN DISPLAY' LOOP ; ----------------------- ; This routine is executed once for every frame displayed. ;; DISPLAY-1 L0229: LD HL,($4034) ; fetch two-byte system variable FRAMES. DEC HL ; decrement frames counter. ;; DISPLAY-P L022D: LD A,$7F ; prepare a mask AND H ; pick up bits 6-0 of H. OR L ; and any bits of L. LD A,H ; reload A with all bits of H for PAUSE test. ; Note both branches must take the same time. JR NZ,L0237 ; (12/7) forward if bits 14-0 are not zero ; to ANOTHER RLA ; (4) test bit 15 of FRAMES. JR L0239 ; (12) forward with result to OVER-NC ; --- ;; ANOTHER L0237: LD B,(HL) ; (7) Note. Harmless Nonsensical Timing weight. SCF ; (4) Set Carry Flag. ; Note. the branch to here takes either (12)(7)(4) cyles or (7)(4)(12) cycles. ;; OVER-NC L0239: LD H,A ; (4) set H to zero LD ($4034),HL ; (16) update system variable FRAMES RET NC ; (11/5) return if FRAMES is in use by PAUSE ; command. ;; DISPLAY-2 L023E: CALL L02BB ; routine KEYBOARD gets the key row in H and ; the column in L. Reading the ports also starts ; the TV frame synchronization pulse. (VSYNC) LD BC,($4025) ; fetch the last key values read from LAST_K LD ($4025),HL ; update LAST_K with new values. LD A,B ; load A with previous column - will be $FF if ; there was no key. ADD A,$02 ; adding two will set carry if no previous key. SBC HL,BC ; subtract with the carry the two key values. ; If the same key value has been returned twice then HL will be zero. LD A,($4027) ; fetch system variable DEBOUNCE OR H ; and OR with both bytes of the difference OR L ; setting the zero flag for the upcoming branch. LD E,B ; transfer the column value to E LD B,$0B ; and load B with eleven LD HL,$403B ; address system variable CDFLAG RES 0,(HL) ; reset the rightmost bit of CDFLAG JR NZ,L0264 ; skip forward if debounce/diff >0 to NO-KEY BIT 7,(HL) ; test compute and display bit of CDFLAG SET 0,(HL) ; set the rightmost bit of CDFLAG. RET Z ; return if bit 7 indicated fast mode. DEC B ; (4) decrement the counter. NOP ; (4) Timing - 4 clock cycles. ?? SCF ; (4) Set Carry Flag ;; NO-KEY L0264: LD HL,$4027 ; sv DEBOUNCE CCF ; Complement Carry Flag RL B ; rotate left B picking up carry ; C<-76543210<-C ;; LOOP-B L026A: DJNZ L026A ; self-loop while B>0 to LOOP-B LD B,(HL) ; fetch value of DEBOUNCE to B LD A,E ; transfer column value CP $FE ; SBC A,A ; LD B,$1F ; OR (HL) ; AND B ; RRA ; LD (HL),A ; OUT ($FF),A ; end the TV frame synchronization pulse. LD HL,($400C) ; (12) set HL to the Display File from D_FILE SET 7,H ; (8) set bit 15 to address the echo display. CALL L0292 ; (17) routine DISPLAY-3 displays the top set ; of blank lines. ; --------------------- ; THE 'VIDEO-1' ROUTINE ; --------------------- ;; R-IX-1 L0281: LD A,R ; (9) Harmless Nonsensical Timing or something ; very clever? LD BC,$1901 ; (10) 25 lines, 1 scanline in first. LD A,$F5 ; (7) This value will be loaded into R and ; ensures that the cycle starts at the right ; part of the display - after 32nd character ; position. CALL L02B5 ; (17) routine DISPLAY-5 completes the current ; blank line and then generates the display of ; the live picture using INT interrupts ; The final interrupt returns to the next ; address. L028B: DEC HL ; point HL to the last NEWLINE/HALT. CALL L0292 ; routine DISPLAY-3 displays the bottom set of ; blank lines. ; --- ;; R-IX-2 L028F: JP L0229 ; JUMP back to DISPLAY-1 ; --------------------------------- ; THE 'DISPLAY BLANK LINES' ROUTINE ; --------------------------------- ; This subroutine is called twice (see above) to generate first the blank ; lines at the top of the television display and then the blank lines at the ; bottom of the display. ;; DISPLAY-3 L0292: POP IX ; pop the return address to IX register. ; will be either L0281 or L028F - see above. LD C,(IY+$28) ; load C with value of system constant MARGIN. BIT 7,(IY+$3B) ; test CDFLAG for compute and display. JR Z,L02A9 ; forward, with FAST mode, to DISPLAY-4 LD A,C ; move MARGIN to A - 31d or 55d. NEG ; Negate INC A ; EX AF,AF' ; place negative count of blank lines in A' OUT ($FE),A ; enable the NMI generator. POP HL ; **** POP DE ; *** POP BC ; ** POP AF ; * Restore Main Registers RET ; return - end of interrupt. Return is to ; user's program - BASIC or machine code. ; which will be interrupted by every NMI. ; ------------------------ ; THE 'FAST MODE' ROUTINES ; ------------------------ ;; DISPLAY-4 L02A9: LD A,$FC ; (7) load A with first R delay value LD B,$01 ; (7) one row only. CALL L02B5 ; (17) routine DISPLAY-5 DEC HL ; (6) point back to the HALT. EX (SP),HL ; (19) Harmless Nonsensical Timing if paired. EX (SP),HL ; (19) Harmless Nonsensical Timing. JP (IX) ; (8) to L0281 or L028F ; -------------------------- ; THE 'DISPLAY-5' SUBROUTINE ; -------------------------- ; This subroutine is called from SLOW mode and FAST mode to generate the ; central TV picture. With SLOW mode the R register is incremented, with ; each instruction, to $F7 by the time it completes. With fast mode, the ; final R value will be $FF and an interrupt will occur as soon as the ; Program Counter reaches the HALT. (24 clock cycles) ;; DISPLAY-5 L02B5: LD R,A ; (9) Load R from A. R = slow: $F5 fast: $FC LD A,$DD ; (7) load future R value. $F6 $FD EI ; (4) Enable Interrupts $F7 $FE JP (HL) ; (4) jump to the echo display. $F8 $FF ; ---------------------------------- ; THE 'KEYBOARD SCANNING' SUBROUTINE ; ---------------------------------- ; The keyboard is read during the vertical sync interval while no video is ; being displayed. Reading a port with address bit 0 low i.e. $FE starts the ; vertical sync pulse. ;; KEYBOARD L02BB: LD HL,$FFFF ; (16) prepare a buffer to take key. LD BC,$FEFE ; (20) set BC to port $FEFE. The B register, ; with its single reset bit also acts as ; an 8-counter. IN A,(C) ; (11) read the port - all 16 bits are put on ; the address bus. Start VSYNC pulse. OR $01 ; (7) set the rightmost bit so as to ignore ; the SHIFT key. ;; EACH-LINE L02C5: OR $E0 ; [7] OR %11100000 LD D,A ; [4] transfer to D. CPL ; [4] complement - only bits 4-0 meaningful now. CP $01 ; [7] sets carry if A is zero. SBC A,A ; [4] $FF if $00 else zero. OR B ; [7] $FF or port FE,FD,FB.... AND L ; [4] unless more than one key, L will still be ; $FF. if more than one key is pressed then A is ; now invalid. LD L,A ; [4] transfer to L. ; now consider the column identifier. LD A,H ; [4] will be $FF if no previous keys. AND D ; [4] 111xxxxx LD H,A ; [4] transfer A to H ; since only one key may be pressed, H will, if valid, be one of ; 11111110, 11111101, 11111011, 11110111, 11101111 ; reading from the outer column, say Q, to the inner column, say T. RLC B ; [8] rotate the 8-counter/port address. ; sets carry if more to do. IN A,(C) ; [10] read another half-row. ; all five bits this time. JR C,L02C5 ; [12](7) loop back, until done, to EACH-LINE ; The last row read is SHIFT,Z,X,C,V for the second time. RRA ; (4) test the shift key - carry will be reset ; if the key is pressed. RL H ; (8) rotate left H picking up the carry giving ; column values - ; $FD, $FB, $F7, $EF, $DF. ; or $FC, $FA, $F6, $EE, $DE if shifted. ; We now have H identifying the column and L identifying the row in the ; keyboard matrix. ; This is a good time to test if this is an American or British machine. ; The US machine has an extra diode that causes bit 6 of a byte read from ; a port to be reset. RLA ; (4) compensate for the shift test. RLA ; (4) rotate bit 7 out. RLA ; (4) test bit 6. SBC A,A ; (4) $FF or $00 {USA} AND $18 ; (7) $18 or $00 ADD A,$1F ; (7) $37 or $1F ; result is either 31 (USA) or 55 (UK) blank lines above and below the TV ; picture. LD ($4028),A ; (13) update system variable MARGIN RET ; (10) return ; ------------------------------ ; THE 'SET FAST MODE' SUBROUTINE ; ------------------------------ ; ; ;; SET-FAST L02E7: BIT 7,(IY+$3B) ; sv CDFLAG RET Z ; HALT ; Wait for Interrupt OUT ($FD),A ; RES 7,(IY+$3B) ; sv CDFLAG RET ; return. ; -------------- ; THE 'REPORT-F' ; -------------- ;; REPORT-F L02F4: RST 08H ; ERROR-1 DEFB $0E ; Error Report: No Program Name supplied. ; -------------------------- ; THE 'SAVE COMMAND' ROUTINE ; -------------------------- ; ; ;; SAVE L02F6: CALL L03A8 ; routine NAME JR C,L02F4 ; back with null name to REPORT-F above. EX DE,HL ; LD DE,$12CB ; five seconds timing value ;; HEADER L02FF: CALL L0F46 ; routine BREAK-1 JR NC,L0332 ; to BREAK-2 ;; DELAY-1 L0304: DJNZ L0304 ; to DELAY-1 DEC DE ; LD A,D ; OR E ; JR NZ,L02FF ; back for delay to HEADER ;; OUT-NAME L030B: CALL L031E ; routine OUT-BYTE BIT 7,(HL) ; test for inverted bit. INC HL ; address next character of name. JR Z,L030B ; back if not inverted to OUT-NAME ; now start saving the system variables onwards. LD HL,$4009 ; set start of area to VERSN thereby ; preserving RAMTOP etc. ;; OUT-PROG L0316: CALL L031E ; routine OUT-BYTE CALL L01FC ; routine LOAD/SAVE >> JR L0316 ; loop back to OUT-PROG ; ------------------------- ; THE 'OUT-BYTE' SUBROUTINE ; ------------------------- ; This subroutine outputs a byte a bit at a time to a domestic tape recorder. ;; OUT-BYTE L031E: LD E,(HL) ; fetch byte to be saved. SCF ; set carry flag - as a marker. ;; EACH-BIT L0320: RL E ; C < 76543210 < C RET Z ; return when the marker bit has passed ; right through. >> SBC A,A ; $FF if set bit or $00 with no carry. AND $05 ; $05 $00 ADD A,$04 ; $09 $04 LD C,A ; transfer timer to C. a set bit has a longer ; pulse than a reset bit. ;; PULSES L0329: OUT ($FF),A ; pulse to cassette. LD B,$23 ; set timing constant ;; DELAY-2 L032D: DJNZ L032D ; self-loop to DELAY-2 CALL L0F46 ; routine BREAK-1 test for BREAK key. ;; BREAK-2 L0332: JR NC,L03A6 ; forward with break to REPORT-D LD B,$1E ; set timing value. ;; DELAY-3 L0336: DJNZ L0336 ; self-loop to DELAY-3 DEC C ; decrement counter JR NZ,L0329 ; loop back to PULSES ;; DELAY-4 L033B: AND A ; clear carry for next bit test. DJNZ L033B ; self loop to DELAY-4 (B is zero - 256) JR L0320 ; loop back to EACH-BIT ; -------------------------- ; THE 'LOAD COMMAND' ROUTINE ; -------------------------- ; ; ;; LOAD L0340: CALL L03A8 ; routine NAME ; DE points to start of name in RAM. RL D ; pick up carry RRC D ; carry now in bit 7. ;; NEXT-PROG L0347: CALL L034C ; routine IN-BYTE JR L0347 ; loop to NEXT-PROG ; ------------------------ ; THE 'IN-BYTE' SUBROUTINE ; ------------------------ ;; IN-BYTE L034C: LD C,$01 ; prepare an eight counter 00000001. ;; NEXT-BIT L034E: LD B,$00 ; set counter to 256 ;; BREAK-3 L0350: LD A,$7F ; read the keyboard row IN A,($FE) ; with the SPACE key. OUT ($FF),A ; output signal to screen. RRA ; test for SPACE pressed. JR NC,L03A2 ; forward if so to BREAK-4 RLA ; reverse above rotation RLA ; test tape bit. JR C,L0385 ; forward if set to GET-BIT DJNZ L0350 ; loop back to BREAK-3 POP AF ; drop the return address. CP D ; ugh. ;; RESTART L0361: JP NC,L03E5 ; jump forward to INITIAL if D is zero ; to reset the system ; if the tape signal has timed out for example ; if the tape is stopped. Not just a simple ; report as some system variables will have ; been overwritten. LD H,D ; else transfer the start of name LD L,E ; to the HL register ;; IN-NAME L0366: CALL L034C ; routine IN-BYTE is sort of recursion for name ; part. received byte in C. BIT 7,D ; is name the null string ? LD A,C ; transfer byte to A. JR NZ,L0371 ; forward with null string to MATCHING CP (HL) ; else compare with string in memory. JR NZ,L0347 ; back with mis-match to NEXT-PROG ; (seemingly out of subroutine but return ; address has been dropped). ;; MATCHING L0371: INC HL ; address next character of name RLA ; test for inverted bit. JR NC,L0366 ; back if not to IN-NAME ; the name has been matched in full. ; proceed to load the data but first increment the high byte of E_LINE, which ; is one of the system variables to be loaded in. Since the low byte is loaded ; before the high byte, it is possible that, at the in-between stage, a false ; value could cause the load to end prematurely - see LOAD/SAVE check. INC (IY+$15) ; increment system variable E_LINE_hi. LD HL,$4009 ; start loading at system variable VERSN. ;; IN-PROG L037B: LD D,B ; set D to zero as indicator. CALL L034C ; routine IN-BYTE loads a byte LD (HL),C ; insert assembled byte in memory. CALL L01FC ; routine LOAD/SAVE >> JR L037B ; loop back to IN-PROG ; --- ; this branch assembles a full byte before exiting normally ; from the IN-BYTE subroutine. ;; GET-BIT L0385: PUSH DE ; save the LD E,$94 ; timing value. ;; TRAILER L0388: LD B,$1A ; counter to twenty six. ;; COUNTER L038A: DEC E ; decrement the measuring timer. IN A,($FE) ; read the RLA ; BIT 7,E ; LD A,E ; JR C,L0388 ; loop back with carry to TRAILER DJNZ L038A ; to COUNTER POP DE ; JR NZ,L039C ; to BIT-DONE CP $56 ; JR NC,L034E ; to NEXT-BIT ;; BIT-DONE L039C: CCF ; complement carry flag RL C ; JR NC,L034E ; to NEXT-BIT RET ; return with full byte. ; --- ; if break is pressed while loading data then perform a reset. ; if break pressed while waiting for program on tape then OK to break. ;; BREAK-4 L03A2: LD A,D ; transfer indicator to A. AND A ; test for zero. JR Z,L0361 ; back if so to RESTART ;; REPORT-D L03A6: RST 08H ; ERROR-1 DEFB $0C ; Error Report: BREAK - CONT repeats ; ----------------------------- ; THE 'PROGRAM NAME' SUBROUTINE ; ----------------------------- ; ; ;; NAME L03A8: CALL L0F55 ; routine SCANNING LD A,($4001) ; sv FLAGS ADD A,A ; JP M,L0D9A ; to REPORT-C POP HL ; RET NC ; PUSH HL ; CALL L02E7 ; routine SET-FAST CALL L13F8 ; routine STK-FETCH LD H,D ; LD L,E ; DEC C ; RET M ; ADD HL,BC ; SET 7,(HL) ; RET ; ; ------------------------- ; THE 'NEW' COMMAND ROUTINE ; ------------------------- ; ; ;; NEW L03C3: CALL L02E7 ; routine SET-FAST LD BC,($4004) ; fetch value of system variable RAMTOP DEC BC ; point to last system byte. ; ----------------------- ; THE 'RAM CHECK' ROUTINE ; ----------------------- ; ; ;; RAM-CHECK L03CB: LD H,B ; LD L,C ; LD A,$3F ; ;; RAM-FILL L03CF: LD (HL),$02 ; DEC HL ; CP H ; JR NZ,L03CF ; to RAM-FILL ;; RAM-READ L03D5: AND A ; SBC HL,BC ; ADD HL,BC ; INC HL ; JR NC,L03E2 ; to SET-TOP DEC (HL) ; JR Z,L03E2 ; to SET-TOP DEC (HL) ; JR Z,L03D5 ; to RAM-READ ;; SET-TOP L03E2: LD ($4004),HL ; set system variable RAMTOP to first byte ; above the BASIC system area. ; ---------------------------- ; THE 'INITIALIZATION' ROUTINE ; ---------------------------- ; ; ;; INITIAL L03E5: LD HL,($4004) ; fetch system variable RAMTOP. DEC HL ; point to last system byte. LD (HL),$3E ; make GO SUB end-marker $3E - too high for ; high order byte of line number. ; (was $3F on ZX80) DEC HL ; point to unimportant low-order byte. LD SP,HL ; and initialize the stack-pointer to this ; location. DEC HL ; point to first location on the machine stack DEC HL ; which will be filled by next CALL/PUSH. LD ($4002),HL ; set the error stack pointer ERR_SP to ; the base of the now empty machine stack. ; Now set the I register so that the video hardware knows where to find the ; character set. This ROM only uses the character set when printing to ; the ZX Printer. The TV picture is formed by the external video hardware. ; Consider also, that this 8K ROM can be retro-fitted to the ZX80 instead of ; its original 4K ROM so the video hardware could be on the ZX80. LD A,$1E ; address for this ROM is $1E00. LD I,A ; set I register from A. IM 1 ; select Z80 Interrupt Mode 1. LD IY,$4000 ; set IY to the start of RAM so that the ; system variables can be indexed. LD (IY+$3B),$40 ; set CDFLAG 0100 0000. Bit 6 indicates ; Compute nad Display required. LD HL,$407D ; The first location after System Variables - ; 16509 decimal. LD ($400C),HL ; set system variable D_FILE to this value. LD B,$19 ; prepare minimal screen of 24 NEWLINEs ; following an initial NEWLINE. ;; LINE L0408: LD (HL),$76 ; insert NEWLINE (HALT instruction) INC HL ; point to next location. DJNZ L0408 ; loop back for all twenty five to LINE LD ($4010),HL ; set system variable VARS to next location CALL L149A ; routine CLEAR sets $80 end-marker and the ; dynamic memory pointers E_LINE, STKBOT and ; STKEND. ;; N/L-ONLY L0413: CALL L14AD ; routine CURSOR-IN inserts the cursor and ; end-marker in the Edit Line also setting ; size of lower display to two lines. CALL L0207 ; routine SLOW/FAST selects COMPUTE and DISPLAY ; --------------------------- ; THE 'BASIC LISTING' SECTION ; --------------------------- ; ; ;; UPPER L0419: CALL L0A2A ; routine CLS LD HL,($400A) ; sv E_PPC_lo LD DE,($4023) ; sv S_TOP_lo AND A ; SBC HL,DE ; EX DE,HL ; JR NC,L042D ; to ADDR-TOP ADD HL,DE ; LD ($4023),HL ; sv S_TOP_lo ;; ADDR-TOP L042D: CALL L09D8 ; routine LINE-ADDR JR Z,L0433 ; to LIST-TOP EX DE,HL ; ;; LIST-TOP L0433: CALL L073E ; routine LIST-PROG DEC (IY+$1E) ; sv BERG JR NZ,L0472 ; to LOWER LD HL,($400A) ; sv E_PPC_lo CALL L09D8 ; routine LINE-ADDR LD HL,($4016) ; sv CH_ADD_lo SCF ; Set Carry Flag SBC HL,DE ; LD HL,$4023 ; sv S_TOP_lo JR NC,L0457 ; to INC-LINE EX DE,HL ; LD A,(HL) ; INC HL ; LDI ; LD (DE),A ; JR L0419 ; to UPPER ; --- ;; DOWN-KEY L0454: LD HL,$400A ; sv E_PPC_lo ;; INC-LINE L0457: LD E,(HL) ; INC HL ; LD D,(HL) ; PUSH HL ; EX DE,HL ; INC HL ; CALL L09D8 ; routine LINE-ADDR CALL L05BB ; routine LINE-NO POP HL ; ;; KEY-INPUT L0464: BIT 5,(IY+$2D) ; sv FLAGX JR NZ,L0472 ; forward to LOWER LD (HL),D ; DEC HL ; LD (HL),E ; JR L0419 ; to UPPER ; ---------------------------- ; THE 'EDIT LINE COPY' SECTION ; ---------------------------- ; This routine sets the edit line to just the cursor when ; 1) There is not enough memory to edit a BASIC line. ; 2) The edit key is used during input. ; The entry point LOWER ;; EDIT-INP L046F: CALL L14AD ; routine CURSOR-IN sets cursor only edit line. ; -> ;; LOWER L0472: LD HL,($4014) ; fetch edit line start from E_LINE. ;; EACH-CHAR L0475: LD A,(HL) ; fetch a character from edit line. CP $7E ; compare to the number marker. JR NZ,L0482 ; forward if not to END-LINE LD BC,$0006 ; else six invisible bytes to be removed. CALL L0A60 ; routine RECLAIM-2 JR L0475 ; back to EACH-CHAR ; --- ;; END-LINE L0482: CP $76 ; INC HL ; JR NZ,L0475 ; to EACH-CHAR ;; EDIT-LINE L0487: CALL L0537 ; routine CURSOR sets cursor K or L. ;; EDIT-ROOM L048A: CALL L0A1F ; routine LINE-ENDS LD HL,($4014) ; sv E_LINE_lo LD (IY+$00),$FF ; sv ERR_NR CALL L0766 ; routine COPY-LINE BIT 7,(IY+$00) ; sv ERR_NR JR NZ,L04C1 ; to DISPLAY-6 LD A,($4022) ; sv DF_SZ CP $18 ; JR NC,L04C1 ; to DISPLAY-6 INC A ; LD ($4022),A ; sv DF_SZ LD B,A ; LD C,$01 ; CALL L0918 ; routine LOC-ADDR LD D,H ; LD E,L ; LD A,(HL) ; ;; FREE-LINE L04B1: DEC HL ; CP (HL) ; JR NZ,L04B1 ; to FREE-LINE INC HL ; EX DE,HL ; LD A,($4005) ; sv RAMTOP_hi CP $4D ; CALL C,L0A5D ; routine RECLAIM-1 JR L048A ; to EDIT-ROOM ; -------------------------- ; THE 'WAIT FOR KEY' SECTION ; -------------------------- ; ; ;; DISPLAY-6 L04C1: LD HL,$0000 ; LD ($4018),HL ; sv X_PTR_lo LD HL,$403B ; system variable CDFLAG BIT 7,(HL) ; CALL Z,L0229 ; routine DISPLAY-1 ;; SLOW-DISP L04CF: BIT 0,(HL) ; JR Z,L04CF ; to SLOW-DISP LD BC,($4025) ; sv LAST_K CALL L0F4B ; routine DEBOUNCE CALL L07BD ; routine DECODE JR NC,L0472 ; back to LOWER ; ------------------------------- ; THE 'KEYBOARD DECODING' SECTION ; ------------------------------- ; The decoded key value is in E and HL points to the position in the ; key table. D contains zero. ;; K-DECODE L04DF: LD A,($4006) ; Fetch value of system variable MODE DEC A ; test the three values together JP M,L0508 ; forward, if was zero, to FETCH-2 JR NZ,L04F7 ; forward, if was 2, to FETCH-1 ; The original value was one and is now zero. LD ($4006),A ; update the system variable MODE DEC E ; reduce E to range $00 - $7F LD A,E ; place in A SUB $27 ; subtract 39 setting carry if range 00 - 38 JR C,L04F2 ; forward, if so, to FUNC-BASE LD E,A ; else set E to reduced value ;; FUNC-BASE L04F2: LD HL,L00CC ; address of K-FUNCT table for function keys. JR L0505 ; forward to TABLE-ADD ; --- ;; FETCH-1 L04F7: LD A,(HL) ; CP $76 ; JR Z,L052B ; to K/L-KEY CP $40 ; SET 7,A ; JR C,L051B ; to ENTER LD HL,$00C7 ; (expr reqd) ;; TABLE-ADD L0505: ADD HL,DE ; JR L0515 ; to FETCH-3 ; --- ;; FETCH-2 L0508: LD A,(HL) ; BIT 2,(IY+$01) ; sv FLAGS - K or L mode ? JR NZ,L0516 ; to TEST-CURS ADD A,$C0 ; CP $E6 ; JR NC,L0516 ; to TEST-CURS ;; FETCH-3 L0515: LD A,(HL) ; ;; TEST-CURS L0516: CP $F0 ; JP PE,L052D ; to KEY-SORT ;; ENTER L051B: LD E,A ; CALL L0537 ; routine CURSOR LD A,E ; CALL L0526 ; routine ADD-CHAR ;; BACK-NEXT L0523: JP L0472 ; back to LOWER ; ------------------------------ ; THE 'ADD CHARACTER' SUBROUTINE ; ------------------------------ ; ; ;; ADD-CHAR L0526: CALL L099B ; routine ONE-SPACE LD (DE),A ; RET ; ; ------------------------- ; THE 'CURSOR KEYS' ROUTINE ; ------------------------- ; ; ;; K/L-KEY L052B: LD A,$78 ; ;; KEY-SORT L052D: LD E,A ; LD HL,$0482 ; base address of ED-KEYS (exp reqd) ADD HL,DE ; ADD HL,DE ; LD C,(HL) ; INC HL ; LD B,(HL) ; PUSH BC ; ;; CURSOR L0537: LD HL,($4014) ; sv E_LINE_lo BIT 5,(IY+$2D) ; sv FLAGX JR NZ,L0556 ; to L-MODE ;; K-MODE L0540: RES 2,(IY+$01) ; sv FLAGS - Signal use K mode ;; TEST-CHAR L0544: LD A,(HL) ; CP $7F ; RET Z ; return INC HL ; CALL L07B4 ; routine NUMBER JR Z,L0544 ; to TEST-CHAR CP $26 ; JR C,L0544 ; to TEST-CHAR CP $DE ; JR Z,L0540 ; to K-MODE ;; L-MODE L0556: SET 2,(IY+$01) ; sv FLAGS - Signal use L mode JR L0544 ; to TEST-CHAR ; -------------------------- ; THE 'CLEAR-ONE' SUBROUTINE ; -------------------------- ; ; ;; CLEAR-ONE L055C: LD BC,$0001 ; JP L0A60 ; to RECLAIM-2 ; ------------------------ ; THE 'EDITING KEYS' TABLE ; ------------------------ ; ; ;; ED-KEYS L0562: DEFW L059F ; Address: $059F; Address: UP-KEY DEFW L0454 ; Address: $0454; Address: DOWN-KEY DEFW L0576 ; Address: $0576; Address: LEFT-KEY DEFW L057F ; Address: $057F; Address: RIGHT-KEY DEFW L05AF ; Address: $05AF; Address: FUNCTION DEFW L05C4 ; Address: $05C4; Address: EDIT-KEY DEFW L060C ; Address: $060C; Address: N/L-KEY DEFW L058B ; Address: $058B; Address: RUBOUT DEFW L05AF ; Address: $05AF; Address: FUNCTION DEFW L05AF ; Address: $05AF; Address: FUNCTION ; ------------------------- ; THE 'CURSOR LEFT' ROUTINE ; ------------------------- ; ; ;; LEFT-KEY L0576: CALL L0593 ; routine LEFT-EDGE LD A,(HL) ; LD (HL),$7F ; INC HL ; JR L0588 ; to GET-CODE ; -------------------------- ; THE 'CURSOR RIGHT' ROUTINE ; -------------------------- ; ; ;; RIGHT-KEY L057F: INC HL ; LD A,(HL) ; CP $76 ; JR Z,L059D ; to ENDED-2 LD (HL),$7F ; DEC HL ; ;; GET-CODE L0588: LD (HL),A ; ;; ENDED-1 L0589: JR L0523 ; to BACK-NEXT ; -------------------- ; THE 'RUBOUT' ROUTINE ; -------------------- ; ; ;; RUBOUT L058B: CALL L0593 ; routine LEFT-EDGE CALL L055C ; routine CLEAR-ONE JR L0589 ; to ENDED-1 ; ------------------------ ; THE 'ED-EDGE' SUBROUTINE ; ------------------------ ; ; ;; LEFT-EDGE L0593: DEC HL ; LD DE,($4014) ; sv E_LINE_lo LD A,(DE) ; CP $7F ; RET NZ ; POP DE ; ;; ENDED-2 L059D: JR L0589 ; to ENDED-1 ; ----------------------- ; THE 'CURSOR UP' ROUTINE ; ----------------------- ; ; ;; UP-KEY L059F: LD HL,($400A) ; sv E_PPC_lo CALL L09D8 ; routine LINE-ADDR EX DE,HL ; CALL L05BB ; routine LINE-NO LD HL,$400B ; point to system variable E_PPC_hi JP L0464 ; jump back to KEY-INPUT ; -------------------------- ; THE 'FUNCTION KEY' ROUTINE ; -------------------------- ; ; ;; FUNCTION L05AF: LD A,E ; AND $07 ; LD ($4006),A ; sv MODE JR L059D ; back to ENDED-2 ; ------------------------------------ ; THE 'COLLECT LINE NUMBER' SUBROUTINE ; ------------------------------------ ; ; ;; ZERO-DE L05B7: EX DE,HL ; LD DE,L04C1 + 1 ; $04C2 - a location addressing two zeros. ; -> ;; LINE-NO L05BB: LD A,(HL) ; AND $C0 ; JR NZ,L05B7 ; to ZERO-DE LD D,(HL) ; INC HL ; LD E,(HL) ; RET ; ; ---------------------- ; THE 'EDIT KEY' ROUTINE ; ---------------------- ; ; ;; EDIT-KEY L05C4: CALL L0A1F ; routine LINE-ENDS clears lower display. LD HL,L046F ; Address: EDIT-INP PUSH HL ; ** is pushed as an error looping address. BIT 5,(IY+$2D) ; test FLAGX RET NZ ; indirect jump if in input mode ; to L046F, EDIT-INP (begin again). ; LD HL,($4014) ; fetch E_LINE LD ($400E),HL ; and use to update the screen cursor DF_CC ; so now RST $10 will print the line numbers to the edit line instead of screen. ; first make sure that no newline/out of screen can occur while sprinting the ; line numbers to the edit line. LD HL,$1821 ; prepare line 0, column 0. LD ($4039),HL ; update S_POSN with these dummy values. LD HL,($400A) ; fetch current line from E_PPC may be a ; non-existent line e.g. last line deleted. CALL L09D8 ; routine LINE-ADDR gets address or that of ; the following line. CALL L05BB ; routine LINE-NO gets line number if any in DE ; leaving HL pointing at second low byte. LD A,D ; test the line number for zero. OR E ; RET Z ; return if no line number - no program to edit. DEC HL ; point to high byte. CALL L0AA5 ; routine OUT-NO writes number to edit line. INC HL ; point to length bytes. LD C,(HL) ; low byte to C. INC HL ; LD B,(HL) ; high byte to B. INC HL ; point to first character in line. LD DE,($400E) ; fetch display file cursor DF_CC LD A,$7F ; prepare the cursor character. LD (DE),A ; and insert in edit line. INC DE ; increment intended destination. PUSH HL ; * save start of BASIC. LD HL,$001D ; set an overhead of 29 bytes. ADD HL,DE ; add in the address of cursor. ADD HL,BC ; add the length of the line. SBC HL,SP ; subtract the stack pointer. POP HL ; * restore pointer to start of BASIC. RET NC ; return if not enough room to L046F EDIT-INP. ; the edit key appears not to work. LDIR ; else copy bytes from program to edit line. ; Note. hidden floating point forms are also ; copied to edit line. EX DE,HL ; transfer free location pointer to HL POP DE ; ** remove address EDIT-INP from stack. CALL L14A6 ; routine SET-STK-B sets STKEND from HL. JR L059D ; back to ENDED-2 and after 3 more jumps ; to L0472, LOWER. ; Note. The LOWER routine removes the hidden ; floating-point numbers from the edit line. ; ------------------------- ; THE 'NEWLINE KEY' ROUTINE ; ------------------------- ; ; ;; N/L-KEY L060C: CALL L0A1F ; routine LINE-ENDS LD HL,L0472 ; prepare address: LOWER BIT 5,(IY+$2D) ; sv FLAGX JR NZ,L0629 ; to NOW-SCAN LD HL,($4014) ; sv E_LINE_lo LD A,(HL) ; CP $FF ; JR Z,L0626 ; to STK-UPPER CALL L08E2 ; routine CLEAR-PRB CALL L0A2A ; routine CLS ;; STK-UPPER L0626: LD HL,L0419 ; Address: UPPER ;; NOW-SCAN L0629: PUSH HL ; push routine address (LOWER or UPPER). CALL L0CBA ; routine LINE-SCAN POP HL ; CALL L0537 ; routine CURSOR CALL L055C ; routine CLEAR-ONE CALL L0A73 ; routine E-LINE-NO JR NZ,L064E ; to N/L-INP LD A,B ; OR C ; JP NZ,L06E0 ; to N/L-LINE DEC BC ; DEC BC ; LD ($4007),BC ; sv PPC_lo LD (IY+$22),$02 ; sv DF_SZ LD DE,($400C) ; sv D_FILE_lo JR L0661 ; forward to TEST-NULL ; --- ;; N/L-INP L064E: CP $76 ; JR Z,L0664 ; to N/L-NULL LD BC,($4030) ; sv T_ADDR_lo CALL L0918 ; routine LOC-ADDR LD DE,($4029) ; sv NXTLIN_lo LD (IY+$22),$02 ; sv DF_SZ ;; TEST-NULL L0661: RST 18H ; GET-CHAR CP $76 ; ;; N/L-NULL L0664: JP Z,L0413 ; to N/L-ONLY LD (IY+$01),$80 ; sv FLAGS EX DE,HL ; ;; NEXT-LINE L066C: LD ($4029),HL ; sv NXTLIN_lo EX DE,HL ; CALL L004D ; routine TEMP-PTR-2 CALL L0CC1 ; routine LINE-RUN RES 1,(IY+$01) ; sv FLAGS - Signal printer not in use LD A,$C0 ; LD (IY+$19),A ; sv X_PTR_lo CALL L14A3 ; routine X-TEMP RES 5,(IY+$2D) ; sv FLAGX BIT 7,(IY+$00) ; sv ERR_NR JR Z,L06AE ; to STOP-LINE LD HL,($4029) ; sv NXTLIN_lo AND (HL) ; JR NZ,L06AE ; to STOP-LINE LD D,(HL) ; INC HL ; LD E,(HL) ; LD ($4007),DE ; sv PPC_lo INC HL ; LD E,(HL) ; INC HL ; LD D,(HL) ; INC HL ; EX DE,HL ; ADD HL,DE ; CALL L0F46 ; routine BREAK-1 JR C,L066C ; to NEXT-LINE LD HL,$4000 ; sv ERR_NR BIT 7,(HL) ; JR Z,L06AE ; to STOP-LINE LD (HL),$0C ; ;; STOP-LINE L06AE: BIT 7,(IY+$38) ; sv PR_CC CALL Z,L0871 ; routine COPY-BUFF LD BC,$0121 ; CALL L0918 ; routine LOC-ADDR LD A,($4000) ; sv ERR_NR LD BC,($4007) ; sv PPC_lo INC A ; JR Z,L06D1 ; to REPORT CP $09 ; JR NZ,L06CA ; to CONTINUE INC BC ; ;; CONTINUE L06CA: LD ($402B),BC ; sv OLDPPC_lo JR NZ,L06D1 ; to REPORT DEC BC ; ;; REPORT L06D1: CALL L07EB ; routine OUT-CODE LD A,$18 ; RST 10H ; PRINT-A CALL L0A98 ; routine OUT-NUM CALL L14AD ; routine CURSOR-IN JP L04C1 ; to DISPLAY-6 ; --- ;; N/L-LINE L06E0: LD ($400A),BC ; sv E_PPC_lo LD HL,($4016) ; sv CH_ADD_lo EX DE,HL ; LD HL,L0413 ; Address: N/L-ONLY PUSH HL ; LD HL,($401A) ; sv STKBOT_lo SBC HL,DE ; PUSH HL ; PUSH BC ; CALL L02E7 ; routine SET-FAST CALL L0A2A ; routine CLS POP HL ; CALL L09D8 ; routine LINE-ADDR JR NZ,L0705 ; to COPY-OVER CALL L09F2 ; routine NEXT-ONE CALL L0A60 ; routine RECLAIM-2 ;; COPY-OVER L0705: POP BC ; LD A,C ; DEC A ; OR B ; RET Z ; PUSH BC ; INC BC ; INC BC ; INC BC ; INC BC ; DEC HL ; CALL L099E ; routine MAKE-ROOM CALL L0207 ; routine SLOW/FAST POP BC ; PUSH BC ; INC DE ; LD HL,($401A) ; sv STKBOT_lo DEC HL ; LDDR ; copy bytes LD HL,($400A) ; sv E_PPC_lo EX DE,HL ; POP BC ; LD (HL),B ; DEC HL ; LD (HL),C ; DEC HL ; LD (HL),E ; DEC HL ; LD (HL),D ; RET ; return. ; --------------------------------------- ; THE 'LIST' AND 'LLIST' COMMAND ROUTINES ; --------------------------------------- ; ; ;; LLIST L072C: SET 1,(IY+$01) ; sv FLAGS - signal printer in use ;; LIST L0730: CALL L0EA7 ; routine FIND-INT LD A,B ; fetch high byte of user-supplied line number. AND $3F ; and crudely limit to range 1-16383. LD H,A ; LD L,C ; LD ($400A),HL ; sv E_PPC_lo CALL L09D8 ; routine LINE-ADDR ;; LIST-PROG L073E: LD E,$00 ; ;; UNTIL-END L0740: CALL L0745 ; routine OUT-LINE lists one line of BASIC ; making an early return when the screen is ; full or the end of program is reached. >> JR L0740 ; loop back to UNTIL-END ; ----------------------------------- ; THE 'PRINT A BASIC LINE' SUBROUTINE ; ----------------------------------- ; ; ;; OUT-LINE L0745: LD BC,($400A) ; sv E_PPC_lo CALL L09EA ; routine CP-LINES LD D,$92 ; JR Z,L0755 ; to TEST-END LD DE,$0000 ; RL E ; ;; TEST-END L0755: LD (IY+$1E),E ; sv BERG LD A,(HL) ; CP $40 ; POP BC ; RET NC ; PUSH BC ; CALL L0AA5 ; routine OUT-NO INC HL ; LD A,D ; RST 10H ; PRINT-A INC HL ; INC HL ; ;; COPY-LINE L0766: LD ($4016),HL ; sv CH_ADD_lo SET 0,(IY+$01) ; sv FLAGS - Suppress leading space ;; MORE-LINE L076D: LD BC,($4018) ; sv X_PTR_lo LD HL,($4016) ; sv CH_ADD_lo AND A ; SBC HL,BC ; JR NZ,L077C ; to TEST-NUM LD A,$B8 ; RST 10H ; PRINT-A ;; TEST-NUM L077C: LD HL,($4016) ; sv CH_ADD_lo LD A,(HL) ; INC HL ; CALL L07B4 ; routine NUMBER LD ($4016),HL ; sv CH_ADD_lo JR Z,L076D ; to MORE-LINE CP $7F ; JR Z,L079D ; to OUT-CURS CP $76 ; JR Z,L07EE ; to OUT-CH BIT 6,A ; JR Z,L079A ; to NOT-TOKEN CALL L094B ; routine TOKENS JR L076D ; to MORE-LINE ; --- ;; NOT-TOKEN L079A: RST 10H ; PRINT-A JR L076D ; to MORE-LINE ; --- ;; OUT-CURS L079D: LD A,($4006) ; Fetch value of system variable MODE LD B,$AB ; Prepare an inverse [F] for function cursor. AND A ; Test for zero - JR NZ,L07AA ; forward if not to FLAGS-2 LD A,($4001) ; Fetch system variable FLAGS. LD B,$B0 ; Prepare an inverse [K] for keyword cursor. ;; FLAGS-2 L07AA: RRA ; 00000?00 -> 000000?0 RRA ; 000000?0 -> 0000000? AND $01 ; 0000000? 0000000x ADD A,B ; Possibly [F] -> [G] or [K] -> [L] CALL L07F5 ; routine PRINT-SP prints character JR L076D ; back to MORE-LINE ; ----------------------- ; THE 'NUMBER' SUBROUTINE ; ----------------------- ; ; ;; NUMBER L07B4: CP $7E ; RET NZ ; INC HL ; INC HL ; INC HL ; INC HL ; INC HL ; RET ; ; -------------------------------- ; THE 'KEYBOARD DECODE' SUBROUTINE ; -------------------------------- ; ; ;; DECODE L07BD: LD D,$00 ; SRA B ; SBC A,A ; OR $26 ; LD L,$05 ; SUB L ; ;; KEY-LINE L07C7: ADD A,L ; SCF ; Set Carry Flag RR C ; JR C,L07C7 ; to KEY-LINE INC C ; RET NZ ; LD C,B ; DEC L ; LD L,$01 ; JR NZ,L07C7 ; to KEY-LINE LD HL,$007D ; (expr reqd) LD E,A ; ADD HL,DE ; SCF ; Set Carry Flag RET ; ; ------------------------- ; THE 'PRINTING' SUBROUTINE ; ------------------------- ; ; ;; LEAD-SP L07DC: LD A,E ; AND A ; RET M ; JR L07F1 ; to PRINT-CH ; --- ;; OUT-DIGIT L07E1: XOR A ; ;; DIGIT-INC L07E2: ADD HL,BC ; INC A ; JR C,L07E2 ; to DIGIT-INC SBC HL,BC ; DEC A ; JR Z,L07DC ; to LEAD-SP ;; OUT-CODE L07EB: LD E,$1C ; ADD A,E ; ;; OUT-CH L07EE: AND A ; JR Z,L07F5 ; to PRINT-SP ;; PRINT-CH L07F1: RES 0,(IY+$01) ; update FLAGS - signal leading space permitted ;; PRINT-SP L07F5: EXX ; PUSH HL ; BIT 1,(IY+$01) ; test FLAGS - is printer in use ? JR NZ,L0802 ; to LPRINT-A CALL L0808 ; routine ENTER-CH JR L0805 ; to PRINT-EXX ; --- ;; LPRINT-A L0802: CALL L0851 ; routine LPRINT-CH ;; PRINT-EXX L0805: POP HL ; EXX ; RET ; ; --- ;; ENTER-CH L0808: LD D,A ; LD BC,($4039) ; sv S_POSN_x LD A,C ; CP $21 ; JR Z,L082C ; to TEST-LOW ;; TEST-N/L L0812: LD A,$76 ; CP D ; JR Z,L0847 ; to WRITE-N/L LD HL,($400E) ; sv DF_CC_lo CP (HL) ; LD A,D ; JR NZ,L083E ; to WRITE-CH DEC C ; JR NZ,L083A ; to EXPAND-1 INC HL ; LD ($400E),HL ; sv DF_CC_lo LD C,$21 ; DEC B ; LD ($4039),BC ; sv S_POSN_x ;; TEST-LOW L082C: LD A,B ; CP (IY+$22) ; sv DF_SZ JR Z,L0835 ; to REPORT-5 AND A ; JR NZ,L0812 ; to TEST-N/L ;; REPORT-5 L0835: LD L,$04 ; 'No more room on screen' JP L0058 ; to ERROR-3 ; --- ;; EXPAND-1 L083A: CALL L099B ; routine ONE-SPACE EX DE,HL ; ;; WRITE-CH L083E: LD (HL),A ; INC HL ; LD ($400E),HL ; sv DF_CC_lo DEC (IY+$39) ; sv S_POSN_x RET ; ; --- ;; WRITE-N/L L0847: LD C,$21 ; DEC B ; SET 0,(IY+$01) ; sv FLAGS - Suppress leading space JP L0918 ; to LOC-ADDR ; -------------------------- ; THE 'LPRINT-CH' SUBROUTINE ; -------------------------- ; This routine sends a character to the ZX-Printer placing the code for the ; character in the Printer Buffer. ; Note. PR-CC contains the low byte of the buffer address. The high order byte ; is always constant. ;; LPRINT-CH L0851: CP $76 ; compare to NEWLINE. JR Z,L0871 ; forward if so to COPY-BUFF LD C,A ; take a copy of the character in C. LD A,($4038) ; fetch print location from PR_CC AND $7F ; ignore bit 7 to form true position. CP $5C ; compare to 33rd location LD L,A ; form low-order byte. LD H,$40 ; the high-order byte is fixed. CALL Z,L0871 ; routine COPY-BUFF to send full buffer to ; the printer if first 32 bytes full. ; (this will reset HL to start.) LD (HL),C ; place character at location. INC L ; increment - will not cross a 256 boundary. LD (IY+$38),L ; update system variable PR_CC ; automatically resetting bit 7 to show that ; the buffer is not empty. RET ; return. ; -------------------------- ; THE 'COPY' COMMAND ROUTINE ; -------------------------- ; The full character-mapped screen is copied to the ZX-Printer. ; All twenty-four text/graphic lines are printed. ;; COPY L0869: LD D,$16 ; prepare to copy twenty four text lines. LD HL,($400C) ; set HL to start of display file from D_FILE. INC HL ; JR L0876 ; forward to COPY*D ; --- ; A single character-mapped printer buffer is copied to the ZX-Printer. ;; COPY-BUFF L0871: LD D,$01 ; prepare to copy a single text line. LD HL,$403C ; set HL to start of printer buffer PRBUFF. ; both paths converge here. ;; COPY*D L0876: CALL L02E7 ; routine SET-FAST PUSH BC ; *** preserve BC throughout. ; a pending character may be present ; in C from LPRINT-CH ;; COPY-LOOP L087A: PUSH HL ; save first character of line pointer. (*) XOR A ; clear accumulator. LD E,A ; set pixel line count, range 0-7, to zero. ; this inner loop deals with each horizontal pixel line. ;; COPY-TIME L087D: OUT ($FB),A ; bit 2 reset starts the printer motor ; with an inactive stylus - bit 7 reset. POP HL ; pick up first character of line pointer (*) ; on inner loop. ;; COPY-BRK L0880: CALL L0F46 ; routine BREAK-1 JR C,L088A ; forward with no keypress to COPY-CONT ; else A will hold 11111111 0 RRA ; 0111 1111 OUT ($FB),A ; stop ZX printer motor, de-activate stylus. ;; REPORT-D2 L0888: RST 08H ; ERROR-1 DEFB $0C ; Error Report: BREAK - CONT repeats ; --- ;; COPY-CONT L088A: IN A,($FB) ; read from printer port. ADD A,A ; test bit 6 and 7 JP M,L08DE ; jump forward with no printer to COPY-END JR NC,L0880 ; back if stylus not in position to COPY-BRK PUSH HL ; save first character of line pointer (*) PUSH DE ; ** preserve character line and pixel line. LD A,D ; text line count to A? CP $02 ; sets carry if last line. SBC A,A ; now $FF if last line else zero. ; now cleverly prepare a printer control mask setting bit 2 (later moved to 1) ; of D to slow printer for the last two pixel lines ( E = 6 and 7) AND E ; and with pixel line offset 0-7 RLCA ; shift to left. AND E ; and again. LD D,A ; store control mask in D. ;; COPY-NEXT L089C: LD C,(HL) ; load character from screen or buffer. LD A,C ; save a copy in C for later inverse test. INC HL ; update pointer for next time. CP $76 ; is character a NEWLINE ? JR Z,L08C7 ; forward, if so, to COPY-N/L PUSH HL ; * else preserve the character pointer. SLA A ; (?) multiply by two ADD A,A ; multiply by four ADD A,A ; multiply by eight LD H,$0F ; load H with half the address of character set. RL H ; now $1E or $1F (with carry) ADD A,E ; add byte offset 0-7 LD L,A ; now HL addresses character source byte RL C ; test character, setting carry if inverse. SBC A,A ; accumulator now $00 if normal, $FF if inverse. XOR (HL) ; combine with bit pattern at end or ROM. LD C,A ; transfer the byte to C. LD B,$08 ; count eight bits to output. ;; COPY-BITS L08B5: LD A,D ; fetch speed control mask from D. RLC C ; rotate a bit from output byte to carry. RRA ; pick up in bit 7, speed bit to bit 1 LD H,A ; store aligned mask in H register. ;; COPY-WAIT L08BA: IN A,($FB) ; read the printer port RRA ; test for alignment signal from encoder. JR NC,L08BA ; loop if not present to COPY-WAIT LD A,H ; control byte to A. OUT ($FB),A ; and output to printer port. DJNZ L08B5 ; loop for all eight bits to COPY-BITS POP HL ; * restore character pointer. JR L089C ; back for adjacent character line to COPY-NEXT ; --- ; A NEWLINE has been encountered either following a text line or as the ; first character of the screen or printer line. ;; COPY-N/L L08C7: IN A,($FB) ; read printer port. RRA ; wait for encoder signal. JR NC,L08C7 ; loop back if not to COPY-N/L LD A,D ; transfer speed mask to A. RRCA ; rotate speed bit to bit 1. ; bit 7, stylus control is reset. OUT ($FB),A ; set the printer speed. POP DE ; ** restore character line and pixel line. INC E ; increment pixel line 0-7. BIT 3,E ; test if value eight reached. JR Z,L087D ; back if not to COPY-TIME ; eight pixel lines, a text line have been completed. POP BC ; lose the now redundant first character ; pointer DEC D ; decrease text line count. JR NZ,L087A ; back if not zero to COPY-LOOP LD A,$04 ; stop the already slowed printer motor. OUT ($FB),A ; output to printer port. ;; COPY-END L08DE: CALL L0207 ; routine SLOW/FAST POP BC ; *** restore preserved BC. ; ------------------------------------- ; THE 'CLEAR PRINTER BUFFER' SUBROUTINE ; ------------------------------------- ; This subroutine sets 32 bytes of the printer buffer to zero (space) and ; the 33rd character is set to a NEWLINE. ; This occurs after the printer buffer is sent to the printer but in addition ; after the 24 lines of the screen are sent to the printer. ; Note. This is a logic error as the last operation does not involve the ; buffer at all. Logically one should be able to use ; 10 LPRINT "HELLO "; ; 20 COPY ; 30 LPRINT ; "WORLD" ; and expect to see the entire greeting emerge from the printer. ; Surprisingly this logic error was never discovered and although one can argue ; if the above is a bug, the repetition of this error on the Spectrum was most ; definitely a bug. ; Since the printer buffer is fixed at the end of the system variables, and ; the print position is in the range $3C - $5C, then bit 7 of the system ; variable is set to show the buffer is empty and automatically reset when ; the variable is updated with any print position - neat. ;; CLEAR-PRB L08E2: LD HL,$405C ; address fixed end of PRBUFF LD (HL),$76 ; place a newline at last position. LD B,$20 ; prepare to blank 32 preceding characters. ;; PRB-BYTES L08E9: DEC HL ; decrement address - could be DEC L. LD (HL),$00 ; place a zero byte. DJNZ L08E9 ; loop for all thirty-two to PRB-BYTES LD A,L ; fetch character print position. SET 7,A ; signal the printer buffer is clear. LD ($4038),A ; update one-byte system variable PR_CC RET ; return. ; ------------------------- ; THE 'PRINT AT' SUBROUTINE ; ------------------------- ; ; ;; PRINT-AT L08F5: LD A,$17 ; SUB B ; JR C,L0905 ; to WRONG-VAL ;; TEST-VAL L08FA: CP (IY+$22) ; sv DF_SZ JP C,L0835 ; to REPORT-5 INC A ; LD B,A ; LD A,$1F ; SUB C ; ;; WRONG-VAL L0905: JP C,L0EAD ; to REPORT-B ADD A,$02 ; LD C,A ; ;; SET-FIELD L090B: BIT 1,(IY+$01) ; sv FLAGS - Is printer in use JR Z,L0918 ; to LOC-ADDR LD A,$5D ; SUB C ; LD ($4038),A ; sv PR_CC RET ; ; ---------------------------- ; THE 'LOCATE ADDRESS' ROUTINE ; ---------------------------- ; ; ;; LOC-ADDR L0918: LD ($4039),BC ; sv S_POSN_x LD HL,($4010) ; sv VARS_lo LD D,C ; LD A,$22 ; SUB C ; LD C,A ; LD A,$76 ; INC B ; ;; LOOK-BACK L0927: DEC HL ; CP (HL) ; JR NZ,L0927 ; to LOOK-BACK DJNZ L0927 ; to LOOK-BACK INC HL ; CPIR ; DEC HL ; LD ($400E),HL ; sv DF_CC_lo SCF ; Set Carry Flag RET PO ; DEC D ; RET Z ; PUSH BC ; CALL L099E ; routine MAKE-ROOM POP BC ; LD B,C ; LD H,D ; LD L,E ; ;; EXPAND-2 L0940: LD (HL),$00 ; DEC HL ; DJNZ L0940 ; to EXPAND-2 EX DE,HL ; INC HL ; LD ($400E),HL ; sv DF_CC_lo RET ; ; ------------------------------ ; THE 'EXPAND TOKENS' SUBROUTINE ; ------------------------------ ; ; ;; TOKENS L094B: PUSH AF ; CALL L0975 ; routine TOKEN-ADD JR NC,L0959 ; to ALL-CHARS BIT 0,(IY+$01) ; sv FLAGS - Leading space if set JR NZ,L0959 ; to ALL-CHARS XOR A ; RST 10H ; PRINT-A ;; ALL-CHARS L0959: LD A,(BC) ; AND $3F ; RST 10H ; PRINT-A LD A,(BC) ; INC BC ; ADD A,A ; JR NC,L0959 ; to ALL-CHARS POP BC ; BIT 7,B ; RET Z ; CP $1A ; JR Z,L096D ; to TRAIL-SP CP $38 ; RET C ; ;; TRAIL-SP L096D: XOR A ; SET 0,(IY+$01) ; sv FLAGS - Suppress leading space JP L07F5 ; to PRINT-SP ; --- ;; TOKEN-ADD L0975: PUSH HL ; LD HL,L0111 ; Address of TOKENS BIT 7,A ; JR Z,L097F ; to TEST-HIGH AND $3F ; ;; TEST-HIGH L097F: CP $43 ; JR NC,L0993 ; to FOUND LD B,A ; INC B ; ;; WORDS L0985: BIT 7,(HL) ; INC HL ; JR Z,L0985 ; to WORDS DJNZ L0985 ; to WORDS BIT 6,A ; JR NZ,L0992 ; to COMP-FLAG CP $18 ; ;; COMP-FLAG L0992: CCF ; Complement Carry Flag ;; FOUND L0993: LD B,H ; LD C,L ; POP HL ; RET NC ; LD A,(BC) ; ADD A,$E4 ; RET ; ; -------------------------- ; THE 'ONE SPACE' SUBROUTINE ; -------------------------- ; ; ;; ONE-SPACE L099B: LD BC,$0001 ; ; -------------------------- ; THE 'MAKE ROOM' SUBROUTINE ; -------------------------- ; ; ;; MAKE-ROOM L099E: PUSH HL ; CALL L0EC5 ; routine TEST-ROOM POP HL ; CALL L09AD ; routine POINTERS LD HL,($401C) ; sv STKEND_lo EX DE,HL ; LDDR ; Copy Bytes RET ; ; ------------------------- ; THE 'POINTERS' SUBROUTINE ; ------------------------- ; ; ;; POINTERS L09AD: PUSH AF ; PUSH HL ; LD HL,$400C ; sv D_FILE_lo LD A,$09 ; ;; NEXT-PTR L09B4: LD E,(HL) ; INC HL ; LD D,(HL) ; EX (SP),HL ; AND A ; SBC HL,DE ; ADD HL,DE ; EX (SP),HL ; JR NC,L09C8 ; to PTR-DONE PUSH DE ; EX DE,HL ; ADD HL,BC ; EX DE,HL ; LD (HL),D ; DEC HL ; LD (HL),E ; INC HL ; POP DE ; ;; PTR-DONE L09C8: INC HL ; DEC A ; JR NZ,L09B4 ; to NEXT-PTR EX DE,HL ; POP DE ; POP AF ; AND A ; SBC HL,DE ; LD B,H ; LD C,L ; INC BC ; ADD HL,DE ; EX DE,HL ; RET ; ; ----------------------------- ; THE 'LINE ADDRESS' SUBROUTINE ; ----------------------------- ; ; ;; LINE-ADDR L09D8: PUSH HL ; LD HL,$407D ; LD D,H ; LD E,L ; ;; NEXT-TEST L09DE: POP BC ; CALL L09EA ; routine CP-LINES RET NC ; PUSH BC ; CALL L09F2 ; routine NEXT-ONE EX DE,HL ; JR L09DE ; to NEXT-TEST ; ------------------------------------- ; THE 'COMPARE LINE NUMBERS' SUBROUTINE ; ------------------------------------- ; ; ;; CP-LINES L09EA: LD A,(HL) ; CP B ; RET NZ ; INC HL ; LD A,(HL) ; DEC HL ; CP C ; RET ; ; -------------------------------------- ; THE 'NEXT LINE OR VARIABLE' SUBROUTINE ; -------------------------------------- ; ; ;; NEXT-ONE L09F2: PUSH HL ; LD A,(HL) ; CP $40 ; JR C,L0A0F ; to LINES BIT 5,A ; JR Z,L0A10 ; forward to NEXT-O-4 ADD A,A ; JP M,L0A01 ; to NEXT+FIVE CCF ; Complement Carry Flag ;; NEXT+FIVE L0A01: LD BC,$0005 ; JR NC,L0A08 ; to NEXT-LETT LD C,$11 ; ;; NEXT-LETT L0A08: RLA ; INC HL ; LD A,(HL) ; JR NC,L0A08 ; to NEXT-LETT JR L0A15 ; to NEXT-ADD ; --- ;; LINES L0A0F: INC HL ; ;; NEXT-O-4 L0A10: INC HL ; LD C,(HL) ; INC HL ; LD B,(HL) ; INC HL ; ;; NEXT-ADD L0A15: ADD HL,BC ; POP DE ; ; --------------------------- ; THE 'DIFFERENCE' SUBROUTINE ; --------------------------- ; ; ;; DIFFER L0A17: AND A ; SBC HL,DE ; LD B,H ; LD C,L ; ADD HL,DE ; EX DE,HL ; RET ; ; -------------------------- ; THE 'LINE-ENDS' SUBROUTINE ; -------------------------- ; ; ;; LINE-ENDS L0A1F: LD B,(IY+$22) ; sv DF_SZ PUSH BC ; CALL L0A2C ; routine B-LINES POP BC ; DEC B ; JR L0A2C ; to B-LINES ; ------------------------- ; THE 'CLS' COMMAND ROUTINE ; ------------------------- ; ; ;; CLS L0A2A: LD B,$18 ; ;; B-LINES L0A2C: RES 1,(IY+$01) ; sv FLAGS - Signal printer not in use LD C,$21 ; PUSH BC ; CALL L0918 ; routine LOC-ADDR POP BC ; LD A,($4005) ; sv RAMTOP_hi CP $4D ; JR C,L0A52 ; to COLLAPSED SET 7,(IY+$3A) ; sv S_POSN_y ;; CLEAR-LOC L0A42: XOR A ; prepare a space CALL L07F5 ; routine PRINT-SP prints a space LD HL,($4039) ; sv S_POSN_x LD A,L ; OR H ; AND $7E ; JR NZ,L0A42 ; to CLEAR-LOC JP L0918 ; to LOC-ADDR ; --- ;; COLLAPSED L0A52: LD D,H ; LD E,L ; DEC HL ; LD C,B ; LD B,$00 ; LDIR ; Copy Bytes LD HL,($4010) ; sv VARS_lo ; ---------------------------- ; THE 'RECLAIMING' SUBROUTINES ; ---------------------------- ; ; ;; RECLAIM-1 L0A5D: CALL L0A17 ; routine DIFFER ;; RECLAIM-2 L0A60: PUSH BC ; LD A,B ; CPL ; LD B,A ; LD A,C ; CPL ; LD C,A ; INC BC ; CALL L09AD ; routine POINTERS EX DE,HL ; POP HL ; ADD HL,DE ; PUSH DE ; LDIR ; Copy Bytes POP HL ; RET ; ; ------------------------------ ; THE 'E-LINE NUMBER' SUBROUTINE ; ------------------------------ ; ; ;; E-LINE-NO L0A73: LD HL,($4014) ; sv E_LINE_lo CALL L004D ; routine TEMP-PTR-2 RST 18H ; GET-CHAR BIT 5,(IY+$2D) ; sv FLAGX RET NZ ; LD HL,$405D ; sv MEM-0-1st LD ($401C),HL ; sv STKEND_lo CALL L1548 ; routine INT-TO-FP CALL L158A ; routine FP-TO-BC JR C,L0A91 ; to NO-NUMBER LD HL,$D8F0 ; value '-10000' ADD HL,BC ; ;; NO-NUMBER L0A91: JP C,L0D9A ; to REPORT-C CP A ; JP L14BC ; routine SET-MIN ; ------------------------------------------------- ; THE 'REPORT AND LINE NUMBER' PRINTING SUBROUTINES ; ------------------------------------------------- ; ; ;; OUT-NUM L0A98: PUSH DE ; PUSH HL ; XOR A ; BIT 7,B ; JR NZ,L0ABF ; to UNITS LD H,B ; LD L,C ; LD E,$FF ; JR L0AAD ; to THOUSAND ; --- ;; OUT-NO L0AA5: PUSH DE ; LD D,(HL) ; INC HL ; LD E,(HL) ; PUSH HL ; EX DE,HL ; LD E,$00 ; set E to leading space. ;; THOUSAND L0AAD: LD BC,$FC18 ; CALL L07E1 ; routine OUT-DIGIT LD BC,$FF9C ; CALL L07E1 ; routine OUT-DIGIT LD C,$F6 ; CALL L07E1 ; routine OUT-DIGIT LD A,L ; ;; UNITS L0ABF: CALL L07EB ; routine OUT-CODE POP HL ; POP DE ; RET ; ; -------------------------- ; THE 'UNSTACK-Z' SUBROUTINE ; -------------------------- ; This subroutine is used to return early from a routine when checking syntax. ; On the ZX81 the same routines that execute commands also check the syntax ; on line entry. This enables precise placement of the error marker in a line ; that fails syntax. ; The sequence CALL SYNTAX-Z ; RET Z can be replaced by a call to this routine ; although it has not replaced every occurrence of the above two instructions. ; Even on the ZX-80 this routine was not fully utilized. ;; UNSTACK-Z L0AC5: CALL L0DA6 ; routine SYNTAX-Z resets the ZERO flag if ; checking syntax. POP HL ; drop the return address. RET Z ; return to previous calling routine if ; checking syntax. JP (HL) ; else jump to the continuation address in ; the calling routine as RET would have done. ; ---------------------------- ; THE 'LPRINT' COMMAND ROUTINE ; ---------------------------- ; ; ;; LPRINT L0ACB: SET 1,(IY+$01) ; sv FLAGS - Signal printer in use ; --------------------------- ; THE 'PRINT' COMMAND ROUTINE ; --------------------------- ; ; ;; PRINT L0ACF: LD A,(HL) ; CP $76 ; JP Z,L0B84 ; to PRINT-END ;; PRINT-1 L0AD5: SUB $1A ; ADC A,$00 ; JR Z,L0B44 ; to SPACING CP $A7 ; JR NZ,L0AFA ; to NOT-AT RST 20H ; NEXT-CHAR CALL L0D92 ; routine CLASS-6 CP $1A ; JP NZ,L0D9A ; to REPORT-C RST 20H ; NEXT-CHAR CALL L0D92 ; routine CLASS-6 CALL L0B4E ; routine SYNTAX-ON RST 28H ;; FP-CALC DEFB $01 ;;exchange DEFB $34 ;;end-calc CALL L0BF5 ; routine STK-TO-BC CALL L08F5 ; routine PRINT-AT JR L0B37 ; to PRINT-ON ; --- ;; NOT-AT L0AFA: CP $A8 ; JR NZ,L0B31 ; to NOT-TAB RST 20H ; NEXT-CHAR CALL L0D92 ; routine CLASS-6 CALL L0B4E ; routine SYNTAX-ON CALL L0C02 ; routine STK-TO-A JP NZ,L0EAD ; to REPORT-B AND $1F ; LD C,A ; BIT 1,(IY+$01) ; sv FLAGS - Is printer in use JR Z,L0B1E ; to TAB-TEST SUB (IY+$38) ; sv PR_CC SET 7,A ; ADD A,$3C ; CALL NC,L0871 ; routine COPY-BUFF ;; TAB-TEST L0B1E: ADD A,(IY+$39) ; sv S_POSN_x CP $21 ; LD A,($403A) ; sv S_POSN_y SBC A,$01 ; CALL L08FA ; routine TEST-VAL SET 0,(IY+$01) ; sv FLAGS - Suppress leading space JR L0B37 ; to PRINT-ON ; --- ;; NOT-TAB L0B31: CALL L0F55 ; routine SCANNING CALL L0B55 ; routine PRINT-STK ;; PRINT-ON L0B37: RST 18H ; GET-CHAR SUB $1A ; ADC A,$00 ; JR Z,L0B44 ; to SPACING CALL L0D1D ; routine CHECK-END JP L0B84 ;;; to PRINT-END ; --- ;; SPACING L0B44: CALL NC,L0B8B ; routine FIELD RST 20H ; NEXT-CHAR CP $76 ; RET Z ; JP L0AD5 ;;; to PRINT-1 ; --- ;; SYNTAX-ON L0B4E: CALL L0DA6 ; routine SYNTAX-Z RET NZ ; POP HL ; JR L0B37 ; to PRINT-ON ; --- ;; PRINT-STK L0B55: CALL L0AC5 ; routine UNSTACK-Z BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? CALL Z,L13F8 ; routine STK-FETCH JR Z,L0B6B ; to PR-STR-4 JP L15DB ; jump forward to PRINT-FP ; --- ;; PR-STR-1 L0B64: LD A,$0B ; ;; PR-STR-2 L0B66: RST 10H ; PRINT-A ;; PR-STR-3 L0B67: LD DE,($4018) ; sv X_PTR_lo ;; PR-STR-4 L0B6B: LD A,B ; OR C ; DEC BC ; RET Z ; LD A,(DE) ; INC DE ; LD ($4018),DE ; sv X_PTR_lo BIT 6,A ; JR Z,L0B66 ; to PR-STR-2 CP $C0 ; JR Z,L0B64 ; to PR-STR-1 PUSH BC ; CALL L094B ; routine TOKENS POP BC ; JR L0B67 ; to PR-STR-3 ; --- ;; PRINT-END L0B84: CALL L0AC5 ; routine UNSTACK-Z LD A,$76 ; RST 10H ; PRINT-A RET ; ; --- ;; FIELD L0B8B: CALL L0AC5 ; routine UNSTACK-Z SET 0,(IY+$01) ; sv FLAGS - Suppress leading space XOR A ; RST 10H ; PRINT-A LD BC,($4039) ; sv S_POSN_x LD A,C ; BIT 1,(IY+$01) ; sv FLAGS - Is printer in use JR Z,L0BA4 ; to CENTRE LD A,$5D ; SUB (IY+$38) ; sv PR_CC ;; CENTRE L0BA4: LD C,$11 ; CP C ; JR NC,L0BAB ; to RIGHT LD C,$01 ; ;; RIGHT L0BAB: CALL L090B ; routine SET-FIELD RET ; ; -------------------------------------- ; THE 'PLOT AND UNPLOT' COMMAND ROUTINES ; -------------------------------------- ; ; ;; PLOT/UNP L0BAF: CALL L0BF5 ; routine STK-TO-BC LD ($4036),BC ; sv COORDS_x LD A,$2B ; SUB B ; JP C,L0EAD ; to REPORT-B LD B,A ; LD A,$01 ; SRA B ; JR NC,L0BC5 ; to COLUMNS LD A,$04 ; ;; COLUMNS L0BC5: SRA C ; JR NC,L0BCA ; to FIND-ADDR RLCA ; ;; FIND-ADDR L0BCA: PUSH AF ; CALL L08F5 ; routine PRINT-AT LD A,(HL) ; RLCA ; CP $10 ; JR NC,L0BDA ; to TABLE-PTR RRCA ; JR NC,L0BD9 ; to SQ-SAVED XOR $8F ; ;; SQ-SAVED L0BD9: LD B,A ; ;; TABLE-PTR L0BDA: LD DE,L0C9E ; Address: P-UNPLOT LD A,($4030) ; sv T_ADDR_lo SUB E ; JP M,L0BE9 ; to PLOT POP AF ; CPL ; AND B ; JR L0BEB ; to UNPLOT ; --- ;; PLOT L0BE9: POP AF ; OR B ; ;; UNPLOT L0BEB: CP $08 ; JR C,L0BF1 ; to PLOT-END XOR $8F ; ;; PLOT-END L0BF1: EXX ; RST 10H ; PRINT-A EXX ; RET ; ; ---------------------------- ; THE 'STACK-TO-BC' SUBROUTINE ; ---------------------------- ; ; ;; STK-TO-BC L0BF5: CALL L0C02 ; routine STK-TO-A LD B,A ; PUSH BC ; CALL L0C02 ; routine STK-TO-A LD E,C ; POP BC ; LD D,C ; LD C,A ; RET ; ; --------------------------- ; THE 'STACK-TO-A' SUBROUTINE ; --------------------------- ; ; ;; STK-TO-A L0C02: CALL L15CD ; routine FP-TO-A JP C,L0EAD ; to REPORT-B LD C,$01 ; RET Z ; LD C,$FF ; RET ; ; ----------------------- ; THE 'SCROLL' SUBROUTINE ; ----------------------- ; ; ;; SCROLL L0C0E: LD B,(IY+$22) ; sv DF_SZ LD C,$21 ; CALL L0918 ; routine LOC-ADDR CALL L099B ; routine ONE-SPACE LD A,(HL) ; LD (DE),A ; INC (IY+$3A) ; sv S_POSN_y LD HL,($400C) ; sv D_FILE_lo INC HL ; LD D,H ; LD E,L ; CPIR ; JP L0A5D ; to RECLAIM-1 ; ------------------- ; THE 'SYNTAX' TABLES ; ------------------- ; i) The Offset table ;; offset-t L0C29: DEFB L0CB4 - $ ; 8B offset to; Address: P-LPRINT DEFB L0CB7 - $ ; 8D offset to; Address: P-LLIST DEFB L0C58 - $ ; 2D offset to; Address: P-STOP DEFB L0CAB - $ ; 7F offset to; Address: P-SLOW DEFB L0CAE - $ ; 81 offset to; Address: P-FAST DEFB L0C77 - $ ; 49 offset to; Address: P-NEW DEFB L0CA4 - $ ; 75 offset to; Address: P-SCROLL DEFB L0C8F - $ ; 5F offset to; Address: P-CONT DEFB L0C71 - $ ; 40 offset to; Address: P-DIM DEFB L0C74 - $ ; 42 offset to; Address: P-REM DEFB L0C5E - $ ; 2B offset to; Address: P-FOR DEFB L0C4B - $ ; 17 offset to; Address: P-GOTO DEFB L0C54 - $ ; 1F offset to; Address: P-GOSUB DEFB L0C6D - $ ; 37 offset to; Address: P-INPUT DEFB L0C89 - $ ; 52 offset to; Address: P-LOAD DEFB L0C7D - $ ; 45 offset to; Address: P-LIST DEFB L0C48 - $ ; 0F offset to; Address: P-LET DEFB L0CA7 - $ ; 6D offset to; Address: P-PAUSE DEFB L0C66 - $ ; 2B offset to; Address: P-NEXT DEFB L0C80 - $ ; 44 offset to; Address: P-POKE DEFB L0C6A - $ ; 2D offset to; Address: P-PRINT DEFB L0C98 - $ ; 5A offset to; Address: P-PLOT DEFB L0C7A - $ ; 3B offset to; Address: P-RUN DEFB L0C8C - $ ; 4C offset to; Address: P-SAVE DEFB L0C86 - $ ; 45 offset to; Address: P-RAND DEFB L0C4F - $ ; 0D offset to; Address: P-IF DEFB L0C95 - $ ; 52 offset to; Address: P-CLS DEFB L0C9E - $ ; 5A offset to; Address: P-UNPLOT DEFB L0C92 - $ ; 4D offset to; Address: P-CLEAR DEFB L0C5B - $ ; 15 offset to; Address: P-RETURN DEFB L0CB1 - $ ; 6A offset to; Address: P-COPY ; ii) The parameter table. ;; P-LET L0C48: DEFB $01 ; Class-01 - A variable is required. DEFB $14 ; Separator: '=' DEFB $02 ; Class-02 - An expression, numeric or string, ; must follow. ;; P-GOTO L0C4B: DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW L0E81 ; Address: $0E81; Address: GOTO ;; P-IF L0C4F: DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $DE ; Separator: 'THEN' DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW L0DAB ; Address: $0DAB; Address: IF ;; P-GOSUB L0C54: DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW L0EB5 ; Address: $0EB5; Address: GOSUB ;; P-STOP L0C58: DEFB $00 ; Class-00 - No further operands. DEFW L0CDC ; Address: $0CDC; Address: STOP ;; P-RETURN L0C5B: DEFB $00 ; Class-00 - No further operands. DEFW L0ED8 ; Address: $0ED8; Address: RETURN ;; P-FOR L0C5E: DEFB $04 ; Class-04 - A single character variable must ; follow. DEFB $14 ; Separator: '=' DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $DF ; Separator: 'TO' DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW L0DB9 ; Address: $0DB9; Address: FOR ;; P-NEXT L0C66: DEFB $04 ; Class-04 - A single character variable must ; follow. DEFB $00 ; Class-00 - No further operands. DEFW L0E2E ; Address: $0E2E; Address: NEXT ;; P-PRINT L0C6A: DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW L0ACF ; Address: $0ACF; Address: PRINT ;; P-INPUT L0C6D: DEFB $01 ; Class-01 - A variable is required. DEFB $00 ; Class-00 - No further operands. DEFW L0EE9 ; Address: $0EE9; Address: INPUT ;; P-DIM L0C71: DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW L1409 ; Address: $1409; Address: DIM ;; P-REM L0C74: DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW L0D6A ; Address: $0D6A; Address: REM ;; P-NEW L0C77: DEFB $00 ; Class-00 - No further operands. DEFW L03C3 ; Address: $03C3; Address: NEW ;; P-RUN L0C7A: DEFB $03 ; Class-03 - A numeric expression may follow ; else default to zero. DEFW L0EAF ; Address: $0EAF; Address: RUN ;; P-LIST L0C7D: DEFB $03 ; Class-03 - A numeric expression may follow ; else default to zero. DEFW L0730 ; Address: $0730; Address: LIST ;; P-POKE L0C80: DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $1A ; Separator: ',' DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW L0E92 ; Address: $0E92; Address: POKE ;; P-RAND L0C86: DEFB $03 ; Class-03 - A numeric expression may follow ; else default to zero. DEFW L0E6C ; Address: $0E6C; Address: RAND ;; P-LOAD L0C89: DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW L0340 ; Address: $0340; Address: LOAD ;; P-SAVE L0C8C: DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW L02F6 ; Address: $02F6; Address: SAVE ;; P-CONT L0C8F: DEFB $00 ; Class-00 - No further operands. DEFW L0E7C ; Address: $0E7C; Address: CONT ;; P-CLEAR L0C92: DEFB $00 ; Class-00 - No further operands. DEFW L149A ; Address: $149A; Address: CLEAR ;; P-CLS L0C95: DEFB $00 ; Class-00 - No further operands. DEFW L0A2A ; Address: $0A2A; Address: CLS ;; P-PLOT L0C98: DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $1A ; Separator: ',' DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW L0BAF ; Address: $0BAF; Address: PLOT/UNP ;; P-UNPLOT L0C9E: DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $1A ; Separator: ',' DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW L0BAF ; Address: $0BAF; Address: PLOT/UNP ;; P-SCROLL L0CA4: DEFB $00 ; Class-00 - No further operands. DEFW L0C0E ; Address: $0C0E; Address: SCROLL ;; P-PAUSE L0CA7: DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW L0F32 ; Address: $0F32; Address: PAUSE ;; P-SLOW L0CAB: DEFB $00 ; Class-00 - No further operands. DEFW L0F2B ; Address: $0F2B; Address: SLOW ;; P-FAST L0CAE: DEFB $00 ; Class-00 - No further operands. DEFW L0F23 ; Address: $0F23; Address: FAST ;; P-COPY L0CB1: DEFB $00 ; Class-00 - No further operands. DEFW L0869 ; Address: $0869; Address: COPY ;; P-LPRINT L0CB4: DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW L0ACB ; Address: $0ACB; Address: LPRINT ;; P-LLIST L0CB7: DEFB $03 ; Class-03 - A numeric expression may follow ; else default to zero. DEFW L072C ; Address: $072C; Address: LLIST ; --------------------------- ; THE 'LINE SCANNING' ROUTINE ; --------------------------- ; ; ;; LINE-SCAN L0CBA: LD (IY+$01),$01 ; sv FLAGS CALL L0A73 ; routine E-LINE-NO ;; LINE-RUN L0CC1: CALL L14BC ; routine SET-MIN LD HL,$4000 ; sv ERR_NR LD (HL),$FF ; LD HL,$402D ; sv FLAGX BIT 5,(HL) ; JR Z,L0CDE ; to LINE-NULL CP $E3 ; 'STOP' ? LD A,(HL) ; JP NZ,L0D6F ; to INPUT-REP CALL L0DA6 ; routine SYNTAX-Z RET Z ; RST 08H ; ERROR-1 DEFB $0C ; Error Report: BREAK - CONT repeats ; -------------------------- ; THE 'STOP' COMMAND ROUTINE ; -------------------------- ; ; ;; STOP L0CDC: RST 08H ; ERROR-1 DEFB $08 ; Error Report: STOP statement ; --- ; the interpretation of a line continues with a check for just spaces ; followed by a carriage return. ; The IF command also branches here with a true value to execute the ; statement after the THEN but the statement can be null so ; 10 IF 1 = 1 THEN ; passes syntax (on all ZX computers). ;; LINE-NULL L0CDE: RST 18H ; GET-CHAR LD B,$00 ; prepare to index - early. CP $76 ; compare to NEWLINE. RET Z ; return if so. LD C,A ; transfer character to C. RST 20H ; NEXT-CHAR advances. LD A,C ; character to A SUB $E1 ; subtract 'LPRINT' - lowest command. JR C,L0D26 ; forward if less to REPORT-C2 LD C,A ; reduced token to C LD HL,L0C29 ; set HL to address of offset table. ADD HL,BC ; index into offset table. LD C,(HL) ; fetch offset ADD HL,BC ; index into parameter table. JR L0CF7 ; to GET-PARAM ; --- ;; SCAN-LOOP L0CF4: LD HL,($4030) ; sv T_ADDR_lo ; -> Entry Point to Scanning Loop ;; GET-PARAM L0CF7: LD A,(HL) ; INC HL ; LD ($4030),HL ; sv T_ADDR_lo LD BC,L0CF4 ; Address: SCAN-LOOP PUSH BC ; is pushed on machine stack. LD C,A ; CP $0B ; JR NC,L0D10 ; to SEPARATOR LD HL,L0D16 ; class-tbl - the address of the class table. LD B,$00 ; ADD HL,BC ; LD C,(HL) ; ADD HL,BC ; PUSH HL ; RST 18H ; GET-CHAR RET ; indirect jump to class routine and ; by subsequent RET to SCAN-LOOP. ; ----------------------- ; THE 'SEPARATOR' ROUTINE ; ----------------------- ;; SEPARATOR L0D10: RST 18H ; GET-CHAR CP C ; JR NZ,L0D26 ; to REPORT-C2 ; 'Nonsense in BASIC' RST 20H ; NEXT-CHAR RET ; return ; ------------------------- ; THE 'COMMAND CLASS' TABLE ; ------------------------- ; ;; class-tbl L0D16: DEFB L0D2D - $ ; 17 offset to; Address: CLASS-0 DEFB L0D3C - $ ; 25 offset to; Address: CLASS-1 DEFB L0D6B - $ ; 53 offset to; Address: CLASS-2 DEFB L0D28 - $ ; 0F offset to; Address: CLASS-3 DEFB L0D85 - $ ; 6B offset to; Address: CLASS-4 DEFB L0D2E - $ ; 13 offset to; Address: CLASS-5 DEFB L0D92 - $ ; 76 offset to; Address: CLASS-6 ; -------------------------- ; THE 'CHECK END' SUBROUTINE ; -------------------------- ; Check for end of statement and that no spurious characters occur after ; a correctly parsed statement. Since only one statement is allowed on each ; line, the only character that may follow a statement is a NEWLINE. ; ;; CHECK-END L0D1D: CALL L0DA6 ; routine SYNTAX-Z RET NZ ; return in runtime. POP BC ; else drop return address. ;; CHECK-2 L0D22: LD A,(HL) ; fetch character. CP $76 ; compare to NEWLINE. RET Z ; return if so. ;; REPORT-C2 L0D26: JR L0D9A ; to REPORT-C ; 'Nonsense in BASIC' ; -------------------------- ; COMMAND CLASSES 03, 00, 05 ; -------------------------- ; ; ;; CLASS-3 L0D28: CP $76 ; CALL L0D9C ; routine NO-TO-STK ;; CLASS-0 L0D2D: CP A ; ;; CLASS-5 L0D2E: POP BC ; CALL Z,L0D1D ; routine CHECK-END EX DE,HL ; LD HL,($4030) ; sv T_ADDR_lo LD C,(HL) ; INC HL ; LD B,(HL) ; EX DE,HL ; ;; CLASS-END L0D3A: PUSH BC ; RET ; ; ------------------------------ ; COMMAND CLASSES 01, 02, 04, 06 ; ------------------------------ ; ; ;; CLASS-1 L0D3C: CALL L111C ; routine LOOK-VARS ;; CLASS-4-2 L0D3F: LD (IY+$2D),$00 ; sv FLAGX JR NC,L0D4D ; to SET-STK SET 1,(IY+$2D) ; sv FLAGX JR NZ,L0D63 ; to SET-STRLN ;; REPORT-2 L0D4B: RST 08H ; ERROR-1 DEFB $01 ; Error Report: Variable not found ; --- ;; SET-STK L0D4D: CALL Z,L11A7 ; routine STK-VAR BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? JR NZ,L0D63 ; to SET-STRLN XOR A ; CALL L0DA6 ; routine SYNTAX-Z CALL NZ,L13F8 ; routine STK-FETCH LD HL,$402D ; sv FLAGX OR (HL) ; LD (HL),A ; EX DE,HL ; ;; SET-STRLN L0D63: LD ($402E),BC ; sv STRLEN_lo LD ($4012),HL ; sv DEST-lo ; THE 'REM' COMMAND ROUTINE ;; REM L0D6A: RET ; ; --- ;; CLASS-2 L0D6B: POP BC ; LD A,($4001) ; sv FLAGS ;; INPUT-REP L0D6F: PUSH AF ; CALL L0F55 ; routine SCANNING POP AF ; LD BC,L1321 ; Address: LET LD D,(IY+$01) ; sv FLAGS XOR D ; AND $40 ; JR NZ,L0D9A ; to REPORT-C BIT 7,D ; JR NZ,L0D3A ; to CLASS-END JR L0D22 ; to CHECK-2 ; --- ;; CLASS-4 L0D85: CALL L111C ; routine LOOK-VARS PUSH AF ; LD A,C ; OR $9F ; INC A ; JR NZ,L0D9A ; to REPORT-C POP AF ; JR L0D3F ; to CLASS-4-2 ; --- ;; CLASS-6 L0D92: CALL L0F55 ; routine SCANNING BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? RET NZ ; ;; REPORT-C L0D9A: RST 08H ; ERROR-1 DEFB $0B ; Error Report: Nonsense in BASIC ; -------------------------------- ; THE 'NUMBER TO STACK' SUBROUTINE ; -------------------------------- ; ; ;; NO-TO-STK L0D9C: JR NZ,L0D92 ; back to CLASS-6 with a non-zero number. CALL L0DA6 ; routine SYNTAX-Z RET Z ; return if checking syntax. ; in runtime a zero default is placed on the calculator stack. RST 28H ;; FP-CALC DEFB $A0 ;;stk-zero DEFB $34 ;;end-calc RET ; return. ; ------------------------- ; THE 'SYNTAX-Z' SUBROUTINE ; ------------------------- ; This routine returns with zero flag set if checking syntax. ; Calling this routine uses three instruction bytes compared to four if the ; bit test is implemented inline. ;; SYNTAX-Z L0DA6: BIT 7,(IY+$01) ; test FLAGS - checking syntax only? RET ; return. ; ------------------------ ; THE 'IF' COMMAND ROUTINE ; ------------------------ ; In runtime, the class routines have evaluated the test expression and ; the result, true or false, is on the stack. ;; IF L0DAB: CALL L0DA6 ; routine SYNTAX-Z JR Z,L0DB6 ; forward if checking syntax to IF-END ; else delete the Boolean value on the calculator stack. RST 28H ;; FP-CALC DEFB $02 ;;delete DEFB $34 ;;end-calc ; register DE points to exponent of floating point value. LD A,(DE) ; fetch exponent. AND A ; test for zero - FALSE. RET Z ; return if so. ;; IF-END L0DB6: JP L0CDE ; jump back to LINE-NULL ; ------------------------- ; THE 'FOR' COMMAND ROUTINE ; ------------------------- ; ; ;; FOR L0DB9: CP $E0 ; is current character 'STEP' ? JR NZ,L0DC6 ; forward if not to F-USE-ONE RST 20H ; NEXT-CHAR CALL L0D92 ; routine CLASS-6 stacks the number CALL L0D1D ; routine CHECK-END JR L0DCC ; forward to F-REORDER ; --- ;; F-USE-ONE L0DC6: CALL L0D1D ; routine CHECK-END RST 28H ;; FP-CALC DEFB $A1 ;;stk-one DEFB $34 ;;end-calc ;; F-REORDER L0DCC: RST 28H ;; FP-CALC v, l, s. DEFB $C0 ;;st-mem-0 v, l, s. DEFB $02 ;;delete v, l. DEFB $01 ;;exchange l, v. DEFB $E0 ;;get-mem-0 l, v, s. DEFB $01 ;;exchange l, s, v. DEFB $34 ;;end-calc l, s, v. CALL L1321 ; routine LET LD ($401F),HL ; set MEM to address variable. DEC HL ; point to letter. LD A,(HL) ; SET 7,(HL) ; LD BC,$0006 ; ADD HL,BC ; RLCA ; JR C,L0DEA ; to F-LMT-STP SLA C ; CALL L099E ; routine MAKE-ROOM INC HL ; ;; F-LMT-STP L0DEA: PUSH HL ; RST 28H ;; FP-CALC DEFB $02 ;;delete DEFB $02 ;;delete DEFB $34 ;;end-calc POP HL ; EX DE,HL ; LD C,$0A ; ten bytes to be moved. LDIR ; copy bytes LD HL,($4007) ; set HL to system variable PPC current line. EX DE,HL ; transfer to DE, variable pointer to HL. INC DE ; loop start will be this line + 1 at least. LD (HL),E ; INC HL ; LD (HL),D ; CALL L0E5A ; routine NEXT-LOOP considers an initial pass. RET NC ; return if possible. ; else program continues from point following matching NEXT. BIT 7,(IY+$08) ; test PPC_hi RET NZ ; return if over 32767 ??? LD B,(IY+$2E) ; fetch variable name from STRLEN_lo RES 6,B ; make a true letter. LD HL,($4029) ; set HL from NXTLIN ; now enter a loop to look for matching next. ;; NXTLIN-NO L0E0E: LD A,(HL) ; fetch high byte of line number. AND $C0 ; mask off low bits $3F JR NZ,L0E2A ; forward at end of program to FOR-END PUSH BC ; save letter CALL L09F2 ; routine NEXT-ONE finds next line. POP BC ; restore letter INC HL ; step past low byte INC HL ; past the INC HL ; line length. CALL L004C ; routine TEMP-PTR1 sets CH_ADD RST 18H ; GET-CHAR CP $F3 ; compare to 'NEXT'. EX DE,HL ; next line to HL. JR NZ,L0E0E ; back with no match to NXTLIN-NO ; EX DE,HL ; restore pointer. RST 20H ; NEXT-CHAR advances and gets letter in A. EX DE,HL ; save pointer CP B ; compare to variable name. JR NZ,L0E0E ; back with mismatch to NXTLIN-NO ;; FOR-END L0E2A: LD ($4029),HL ; update system variable NXTLIN RET ; return. ; -------------------------- ; THE 'NEXT' COMMAND ROUTINE ; -------------------------- ; ; ;; NEXT L0E2E: BIT 1,(IY+$2D) ; sv FLAGX JP NZ,L0D4B ; to REPORT-2 LD HL,($4012) ; DEST BIT 7,(HL) ; JR Z,L0E58 ; to REPORT-1 INC HL ; LD ($401F),HL ; sv MEM_lo RST 28H ;; FP-CALC DEFB $E0 ;;get-mem-0 DEFB $E2 ;;get-mem-2 DEFB $0F ;;addition DEFB $C0 ;;st-mem-0 DEFB $02 ;;delete DEFB $34 ;;end-calc CALL L0E5A ; routine NEXT-LOOP RET C ; LD HL,($401F) ; sv MEM_lo LD DE,$000F ; ADD HL,DE ; LD E,(HL) ; INC HL ; LD D,(HL) ; EX DE,HL ; JR L0E86 ; to GOTO-2 ; --- ;; REPORT-1 L0E58: RST 08H ; ERROR-1 DEFB $00 ; Error Report: NEXT without FOR ; -------------------------- ; THE 'NEXT-LOOP' SUBROUTINE ; -------------------------- ; ; ;; NEXT-LOOP L0E5A: RST 28H ;; FP-CALC DEFB $E1 ;;get-mem-1 DEFB $E0 ;;get-mem-0 DEFB $E2 ;;get-mem-2 DEFB $32 ;;less-0 DEFB $00 ;;jump-true DEFB $02 ;;to L0E62, LMT-V-VAL DEFB $01 ;;exchange ;; LMT-V-VAL L0E62: DEFB $03 ;;subtract DEFB $33 ;;greater-0 DEFB $00 ;;jump-true DEFB $04 ;;to L0E69, IMPOSS DEFB $34 ;;end-calc AND A ; clear carry flag RET ; return. ; --- ;; IMPOSS L0E69: DEFB $34 ;;end-calc SCF ; set carry flag RET ; return. ; -------------------------- ; THE 'RAND' COMMAND ROUTINE ; -------------------------- ; The keyword was 'RANDOMISE' on the ZX80, is 'RAND' here on the ZX81 and ; becomes 'RANDOMIZE' on the ZX Spectrum. ; In all invocations the procedure is the same - to set the SEED system variable ; with a supplied integer value or to use a time-based value if no number, or ; zero, is supplied. ;; RAND L0E6C: CALL L0EA7 ; routine FIND-INT LD A,B ; test value OR C ; for zero JR NZ,L0E77 ; forward if not zero to SET-SEED LD BC,($4034) ; fetch value of FRAMES system variable. ;; SET-SEED L0E77: LD ($4032),BC ; update the SEED system variable. RET ; return. ; -------------------------- ; THE 'CONT' COMMAND ROUTINE ; -------------------------- ; Another abbreviated command. ROM space was really tight. ; CONTINUE at the line number that was set when break was pressed. ; Sometimes the current line, sometimes the next line. ;; CONT L0E7C: LD HL,($402B) ; set HL from system variable OLDPPC JR L0E86 ; forward to GOTO-2 ; -------------------------- ; THE 'GOTO' COMMAND ROUTINE ; -------------------------- ; This token also suffered from the shortage of room and there is no space ; getween GO and TO as there is on the ZX80 and ZX Spectrum. The same also ; applies to the GOSUB keyword. ;; GOTO L0E81: CALL L0EA7 ; routine FIND-INT LD H,B ; LD L,C ; ;; GOTO-2 L0E86: LD A,H ; CP $F0 ; JR NC,L0EAD ; to REPORT-B CALL L09D8 ; routine LINE-ADDR LD ($4029),HL ; sv NXTLIN_lo RET ; ; -------------------------- ; THE 'POKE' COMMAND ROUTINE ; -------------------------- ; ; ;; POKE L0E92: CALL L15CD ; routine FP-TO-A JR C,L0EAD ; forward, with overflow, to REPORT-B JR Z,L0E9B ; forward, if positive, to POKE-SAVE NEG ; negate ;; POKE-SAVE L0E9B: PUSH AF ; preserve value. CALL L0EA7 ; routine FIND-INT gets address in BC ; invoking the error routine with overflow ; or a negative number. POP AF ; restore value. ; Note. the next two instructions are legacy code from the ZX80 and ; inappropriate here. BIT 7,(IY+$00) ; test ERR_NR - is it still $FF ? RET Z ; return with error. LD (BC),A ; update the address contents. RET ; return. ; ----------------------------- ; THE 'FIND INTEGER' SUBROUTINE ; ----------------------------- ; ; ;; FIND-INT L0EA7: CALL L158A ; routine FP-TO-BC JR C,L0EAD ; forward with overflow to REPORT-B RET Z ; return if positive (0-65535). ;; REPORT-B L0EAD: RST 08H ; ERROR-1 DEFB $0A ; Error Report: Integer out of range ; ------------------------- ; THE 'RUN' COMMAND ROUTINE ; ------------------------- ; ; ;; RUN L0EAF: CALL L0E81 ; routine GOTO JP L149A ; to CLEAR ; --------------------------- ; THE 'GOSUB' COMMAND ROUTINE ; --------------------------- ; ; ;; GOSUB L0EB5: LD HL,($4007) ; sv PPC_lo INC HL ; EX (SP),HL ; PUSH HL ; LD ($4002),SP ; set the error stack pointer - ERR_SP CALL L0E81 ; routine GOTO LD BC,$0006 ; ; -------------------------- ; THE 'TEST ROOM' SUBROUTINE ; -------------------------- ; ; ;; TEST-ROOM L0EC5: LD HL,($401C) ; sv STKEND_lo ADD HL,BC ; JR C,L0ED3 ; to REPORT-4 EX DE,HL ; LD HL,$0024 ; ADD HL,DE ; SBC HL,SP ; RET C ; ;; REPORT-4 L0ED3: LD L,$03 ; JP L0058 ; to ERROR-3 ; ---------------------------- ; THE 'RETURN' COMMAND ROUTINE ; ---------------------------- ; ; ;; RETURN L0ED8: POP HL ; EX (SP),HL ; LD A,H ; CP $3E ; JR Z,L0EE5 ; to REPORT-7 LD ($4002),SP ; sv ERR_SP_lo JR L0E86 ; back to GOTO-2 ; --- ;; REPORT-7 L0EE5: EX (SP),HL ; PUSH HL ; RST 08H ; ERROR-1 DEFB $06 ; Error Report: RETURN without GOSUB ; --------------------------- ; THE 'INPUT' COMMAND ROUTINE ; --------------------------- ; ; ;; INPUT L0EE9: BIT 7,(IY+$08) ; sv PPC_hi JR NZ,L0F21 ; to REPORT-8 CALL L14A3 ; routine X-TEMP LD HL,$402D ; sv FLAGX SET 5,(HL) ; RES 6,(HL) ; LD A,($4001) ; sv FLAGS AND $40 ; LD BC,$0002 ; JR NZ,L0F05 ; to PROMPT LD C,$04 ; ;; PROMPT L0F05: OR (HL) ; LD (HL),A ; RST 30H ; BC-SPACES LD (HL),$76 ; LD A,C ; RRCA ; RRCA ; JR C,L0F14 ; to ENTER-CUR LD A,$0B ; LD (DE),A ; DEC HL ; LD (HL),A ; ;; ENTER-CUR L0F14: DEC HL ; LD (HL),$7F ; LD HL,($4039) ; sv S_POSN_x LD ($4030),HL ; sv T_ADDR_lo POP HL ; JP L0472 ; to LOWER ; --- ;; REPORT-8 L0F21: RST 08H ; ERROR-1 DEFB $07 ; Error Report: End of file ; --------------------------- ; THE 'PAUSE' COMMAND ROUTINE ; --------------------------- ; ; ;; FAST L0F23: CALL L02E7 ; routine SET-FAST RES 6,(IY+$3B) ; sv CDFLAG RET ; return. ; -------------------------- ; THE 'SLOW' COMMAND ROUTINE ; -------------------------- ; ; ;; SLOW L0F2B: SET 6,(IY+$3B) ; sv CDFLAG JP L0207 ; to SLOW/FAST ; --------------------------- ; THE 'PAUSE' COMMAND ROUTINE ; --------------------------- ;; PAUSE L0F32: CALL L0EA7 ; routine FIND-INT CALL L02E7 ; routine SET-FAST LD H,B ; LD L,C ; CALL L022D ; routine DISPLAY-P LD (IY+$35),$FF ; sv FRAMES_hi CALL L0207 ; routine SLOW/FAST JR L0F4B ; routine DEBOUNCE ; ---------------------- ; THE 'BREAK' SUBROUTINE ; ---------------------- ; ; ;; BREAK-1 L0F46: LD A,$7F ; read port $7FFE - keys B,N,M,.,SPACE. IN A,($FE) ; RRA ; carry will be set if space not pressed. ; ------------------------- ; THE 'DEBOUNCE' SUBROUTINE ; ------------------------- ; ; ;; DEBOUNCE L0F4B: RES 0,(IY+$3B) ; update system variable CDFLAG LD A,$FF ; LD ($4027),A ; update system variable DEBOUNCE RET ; return. ; ------------------------- ; THE 'SCANNING' SUBROUTINE ; ------------------------- ; This recursive routine is where the ZX81 gets its power. Provided there is ; enough memory it can evaluate an expression of unlimited complexity. ; Note. there is no unary plus so, as on the ZX80, PRINT +1 gives a syntax error. ; PRINT +1 works on the Spectrum but so too does PRINT + "STRING". ;; SCANNING L0F55: RST 18H ; GET-CHAR LD B,$00 ; set B register to zero. PUSH BC ; stack zero as a priority end-marker. ;; S-LOOP-1 L0F59: CP $40 ; compare to the 'RND' character JR NZ,L0F8C ; forward, if not, to S-TEST-PI ; ------------------ ; THE 'RND' FUNCTION ; ------------------ CALL L0DA6 ; routine SYNTAX-Z JR Z,L0F8A ; forward if checking syntax to S-JPI-END LD BC,($4032) ; sv SEED_lo CALL L1520 ; routine STACK-BC RST 28H ;; FP-CALC DEFB $A1 ;;stk-one DEFB $0F ;;addition DEFB $30 ;;stk-data DEFB $37 ;;Exponent: $87, Bytes: 1 DEFB $16 ;;(+00,+00,+00) DEFB $04 ;;multiply DEFB $30 ;;stk-data DEFB $80 ;;Bytes: 3 DEFB $41 ;;Exponent $91 DEFB $00,$00,$80 ;;(+00) DEFB $2E ;;n-mod-m DEFB $02 ;;delete DEFB $A1 ;;stk-one DEFB $03 ;;subtract DEFB $2D ;;duplicate DEFB $34 ;;end-calc CALL L158A ; routine FP-TO-BC LD ($4032),BC ; update the SEED system variable. LD A,(HL) ; HL addresses the exponent of the last value. AND A ; test for zero JR Z,L0F8A ; forward, if so, to S-JPI-END SUB $10 ; else reduce exponent by sixteen LD (HL),A ; thus dividing by 65536 for last value. ;; S-JPI-END L0F8A: JR L0F99 ; forward to S-PI-END ; --- ;; S-TEST-PI L0F8C: CP $42 ; the 'PI' character JR NZ,L0F9D ; forward, if not, to S-TST-INK ; ------------------- ; THE 'PI' EVALUATION ; ------------------- CALL L0DA6 ; routine SYNTAX-Z JR Z,L0F99 ; forward if checking syntax to S-PI-END RST 28H ;; FP-CALC DEFB $A3 ;;stk-pi/2 DEFB $34 ;;end-calc INC (HL) ; double the exponent giving PI on the stack. ;; S-PI-END L0F99: RST 20H ; NEXT-CHAR advances character pointer. JP L1083 ; jump forward to S-NUMERIC to set the flag ; to signal numeric result before advancing. ; --- ;; S-TST-INK L0F9D: CP $41 ; compare to character 'INKEY$' JR NZ,L0FB2 ; forward, if not, to S-ALPHANUM ; ----------------------- ; THE 'INKEY$' EVALUATION ; ----------------------- CALL L02BB ; routine KEYBOARD LD B,H ; LD C,L ; LD D,C ; INC D ; CALL NZ,L07BD ; routine DECODE LD A,D ; ADC A,D ; LD B,D ; LD C,A ; EX DE,HL ; JR L0FED ; forward to S-STRING ; --- ;; S-ALPHANUM L0FB2: CALL L14D2 ; routine ALPHANUM JR C,L1025 ; forward, if alphanumeric to S-LTR-DGT CP $1B ; is character a '.' ? JP Z,L1047 ; jump forward if so to S-DECIMAL LD BC,$09D8 ; prepare priority 09, operation 'subtract' CP $16 ; is character unary minus '-' ? JR Z,L1020 ; forward, if so, to S-PUSH-PO CP $10 ; is character a '(' ? JR NZ,L0FD6 ; forward if not to S-QUOTE CALL L0049 ; routine CH-ADD+1 advances character pointer. CALL L0F55 ; recursively call routine SCANNING to ; evaluate the sub-expression. CP $11 ; is subsequent character a ')' ? JR NZ,L0FFF ; forward if not to S-RPT-C CALL L0049 ; routine CH-ADD+1 advances. JR L0FF8 ; relative jump to S-JP-CONT3 and then S-CONT3 ; --- ; consider a quoted string e.g. PRINT "Hooray!" ; Note. quotes are not allowed within a string. ;; S-QUOTE L0FD6: CP $0B ; is character a quote (") ? JR NZ,L1002 ; forward, if not, to S-FUNCTION CALL L0049 ; routine CH-ADD+1 advances PUSH HL ; * save start of string. JR L0FE3 ; forward to S-QUOTE-S ; --- ;; S-Q-AGAIN L0FE0: CALL L0049 ; routine CH-ADD+1 ;; S-QUOTE-S L0FE3: CP $0B ; is character a '"' ? JR NZ,L0FFB ; forward if not to S-Q-NL POP DE ; * retrieve start of string AND A ; prepare to subtract. SBC HL,DE ; subtract start from current position. LD B,H ; transfer this length LD C,L ; to the BC register pair. ;; S-STRING L0FED: LD HL,$4001 ; address system variable FLAGS RES 6,(HL) ; signal string result BIT 7,(HL) ; test if checking syntax. CALL NZ,L12C3 ; in run-time routine STK-STO-$ stacks the ; string descriptor - start DE, length BC. RST 20H ; NEXT-CHAR advances pointer. ;; S-J-CONT-3 L0FF8: JP L1088 ; jump to S-CONT-3 ; --- ; A string with no terminating quote has to be considered. ;; S-Q-NL L0FFB: CP $76 ; compare to NEWLINE JR NZ,L0FE0 ; loop back if not to S-Q-AGAIN ;; S-RPT-C L0FFF: JP L0D9A ; to REPORT-C ; --- ;; S-FUNCTION L1002: SUB $C4 ; subtract 'CODE' reducing codes ; CODE thru '<>' to range $00 - $XX JR C,L0FFF ; back, if less, to S-RPT-C ; test for NOT the last function in character set. LD BC,$04EC ; prepare priority $04, operation 'not' CP $13 ; compare to 'NOT' ( - CODE) JR Z,L1020 ; forward, if so, to S-PUSH-PO JR NC,L0FFF ; back with anything higher to S-RPT-C ; else is a function 'CODE' thru 'CHR$' LD B,$10 ; priority sixteen binds all functions to ; arguments removing the need for brackets. ADD A,$D9 ; add $D9 to give range $D9 thru $EB ; bit 6 is set to show numeric argument. ; bit 7 is set to show numeric result. ; now adjust these default argument/result indicators. LD C,A ; save code in C CP $DC ; separate 'CODE', 'VAL', 'LEN' JR NC,L101A ; skip forward if string operand to S-NO-TO-$ RES 6,C ; signal string operand. ;; S-NO-TO-$ L101A: CP $EA ; isolate top of range 'STR$' and 'CHR$' JR C,L1020 ; skip forward with others to S-PUSH-PO RES 7,C ; signal string result. ;; S-PUSH-PO L1020: PUSH BC ; push the priority/operation RST 20H ; NEXT-CHAR JP L0F59 ; jump back to S-LOOP-1 ; --- ;; S-LTR-DGT L1025: CP $26 ; compare to 'A'. JR C,L1047 ; forward if less to S-DECIMAL CALL L111C ; routine LOOK-VARS JP C,L0D4B ; back if not found to REPORT-2 ; a variable is always 'found' when checking ; syntax. CALL Z,L11A7 ; routine STK-VAR stacks string parameters or ; returns cell location if numeric. LD A,($4001) ; fetch FLAGS CP $C0 ; compare to numeric result/numeric operand JR C,L1087 ; forward if not numeric to S-CONT-2 INC HL ; address numeric contents of variable. LD DE,($401C) ; set destination to STKEND CALL L19F6 ; routine MOVE-FP stacks the five bytes EX DE,HL ; transfer new free location from DE to HL. LD ($401C),HL ; update STKEND system variable. JR L1087 ; forward to S-CONT-2 ; --- ; The Scanning Decimal routine is invoked when a decimal point or digit is ; found in the expression. ; When checking syntax, then the 'hidden floating point' form is placed ; after the number in the BASIC line. ; In run-time, the digits are skipped and the floating point number is picked ; up. ;; S-DECIMAL L1047: CALL L0DA6 ; routine SYNTAX-Z JR NZ,L106F ; forward in run-time to S-STK-DEC CALL L14D9 ; routine DEC-TO-FP RST 18H ; GET-CHAR advances HL past digits LD BC,$0006 ; six locations are required. CALL L099E ; routine MAKE-ROOM INC HL ; point to first new location LD (HL),$7E ; insert the number marker 126 decimal. INC HL ; increment EX DE,HL ; transfer destination to DE. LD HL,($401C) ; set HL from STKEND which points to the ; first location after the 'last value' LD C,$05 ; five bytes to move. AND A ; clear carry. SBC HL,BC ; subtract five pointing to 'last value'. LD ($401C),HL ; update STKEND thereby 'deleting the value. LDIR ; copy the five value bytes. EX DE,HL ; basic pointer to HL which may be white-space ; following the number. DEC HL ; now points to last of five bytes. CALL L004C ; routine TEMP-PTR1 advances the character ; address skipping any white-space. JR L1083 ; forward to S-NUMERIC ; to signal a numeric result. ; --- ; In run-time the branch is here when a digit or point is encountered. ;; S-STK-DEC L106F: RST 20H ; NEXT-CHAR CP $7E ; compare to 'number marker' JR NZ,L106F ; loop back until found to S-STK-DEC ; skipping all the digits. INC HL ; point to first of five hidden bytes. LD DE,($401C) ; set destination from STKEND system variable CALL L19F6 ; routine MOVE-FP stacks the number. LD ($401C),DE ; update system variable STKEND. LD ($4016),HL ; update system variable CH_ADD. ;; S-NUMERIC L1083: SET 6,(IY+$01) ; update FLAGS - Signal numeric result ;; S-CONT-2 L1087: RST 18H ; GET-CHAR ;; S-CONT-3 L1088: CP $10 ; compare to opening bracket '(' JR NZ,L1098 ; forward if not to S-OPERTR BIT 6,(IY+$01) ; test FLAGS - Numeric or string result? JR NZ,L10BC ; forward if numeric to S-LOOP ; else is a string CALL L1263 ; routine SLICING RST 20H ; NEXT-CHAR JR L1088 ; back to S-CONT-3 ; --- ; the character is now manipulated to form an equivalent in the table of ; calculator literals. This is quite cumbersome and in the ZX Spectrum a ; simple look-up table was introduced at this point. ;; S-OPERTR L1098: LD BC,$00C3 ; prepare operator 'subtract' as default. ; also set B to zero for later indexing. CP $12 ; is character '>' ? JR C,L10BC ; forward if less to S-LOOP as ; we have reached end of meaningful expression SUB $16 ; is character '-' ? JR NC,L10A7 ; forward with - * / and '**' '<>' to SUBMLTDIV ADD A,$0D ; increase others by thirteen ; $09 '>' thru $0C '+' JR L10B5 ; forward to GET-PRIO ; --- ;; SUBMLTDIV L10A7: CP $03 ; isolate $00 '-', $01 '*', $02 '/' JR C,L10B5 ; forward if so to GET-PRIO ; else possibly originally $D8 '**' thru $DD '<>' already reduced by $16 SUB $C2 ; giving range $00 to $05 JR C,L10BC ; forward if less to S-LOOP CP $06 ; test the upper limit for nonsense also JR NC,L10BC ; forward if so to S-LOOP ADD A,$03 ; increase by 3 to give combined operators of ; $00 '-' ; $01 '*' ; $02 '/' ; $03 '**' ; $04 'OR' ; $05 'AND' ; $06 '<=' ; $07 '>=' ; $08 '<>' ; $09 '>' ; $0A '<' ; $0B '=' ; $0C '+' ;; GET-PRIO L10B5: ADD A,C ; add to default operation 'sub' ($C3) LD C,A ; and place in operator byte - C. LD HL,L110F - $C3 ; theoretical base of the priorities table. ADD HL,BC ; add C ( B is zero) LD B,(HL) ; pick up the priority in B ;; S-LOOP L10BC: POP DE ; restore previous LD A,D ; load A with priority. CP B ; is present priority higher JR C,L10ED ; forward if so to S-TIGHTER AND A ; are both priorities zero JP Z,L0018 ; exit if zero via GET-CHAR PUSH BC ; stack present values PUSH DE ; stack last values CALL L0DA6 ; routine SYNTAX-Z JR Z,L10D5 ; forward is checking syntax to S-SYNTEST LD A,E ; fetch last operation AND $3F ; mask off the indicator bits to give true ; calculator literal. LD B,A ; place in the B register for BREG ; perform the single operation RST 28H ;; FP-CALC DEFB $37 ;;fp-calc-2 DEFB $34 ;;end-calc JR L10DE ; forward to S-RUNTEST ; --- ;; S-SYNTEST L10D5: LD A,E ; transfer masked operator to A XOR (IY+$01) ; XOR with FLAGS like results will reset bit 6 AND $40 ; test bit 6 ;; S-RPORT-C L10DB: JP NZ,L0D9A ; back to REPORT-C if results do not agree. ; --- ; in run-time impose bit 7 of the operator onto bit 6 of the FLAGS ;; S-RUNTEST L10DE: POP DE ; restore last operation. LD HL,$4001 ; address system variable FLAGS SET 6,(HL) ; presume a numeric result BIT 7,E ; test expected result in operation JR NZ,L10EA ; forward if numeric to S-LOOPEND RES 6,(HL) ; reset to signal string result ;; S-LOOPEND L10EA: POP BC ; restore present values JR L10BC ; back to S-LOOP ; --- ;; S-TIGHTER L10ED: PUSH DE ; push last values and consider these LD A,C ; get the present operator. BIT 6,(IY+$01) ; test FLAGS - Numeric or string result? JR NZ,L110A ; forward if numeric to S-NEXT AND $3F ; strip indicator bits to give clear literal. ADD A,$08 ; add eight - augmenting numeric to equivalent ; string literals. LD C,A ; place plain literal back in C. CP $10 ; compare to 'AND' JR NZ,L1102 ; forward if not to S-NOT-AND SET 6,C ; set the numeric operand required for 'AND' JR L110A ; forward to S-NEXT ; --- ;; S-NOT-AND L1102: JR C,L10DB ; back if less than 'AND' to S-RPORT-C ; Nonsense if '-', '*' etc. CP $17 ; compare to 'strs-add' literal JR Z,L110A ; forward if so signaling string result SET 7,C ; set bit to numeric (Boolean) for others. ;; S-NEXT L110A: PUSH BC ; stack 'present' values RST 20H ; NEXT-CHAR JP L0F59 ; jump back to S-LOOP-1 ; ------------------------- ; THE 'TABLE OF PRIORITIES' ; ------------------------- ; ; ;; tbl-pri L110F: DEFB $06 ; '-' DEFB $08 ; '*' DEFB $08 ; '/' DEFB $0A ; '**' DEFB $02 ; 'OR' DEFB $03 ; 'AND' DEFB $05 ; '<=' DEFB $05 ; '>=' DEFB $05 ; '<>' DEFB $05 ; '>' DEFB $05 ; '<' DEFB $05 ; '=' DEFB $06 ; '+' ; -------------------------- ; THE 'LOOK-VARS' SUBROUTINE ; -------------------------- ; ; ;; LOOK-VARS L111C: SET 6,(IY+$01) ; sv FLAGS - Signal numeric result RST 18H ; GET-CHAR CALL L14CE ; routine ALPHA JP NC,L0D9A ; to REPORT-C PUSH HL ; LD C,A ; RST 20H ; NEXT-CHAR PUSH HL ; RES 5,C ; CP $10 ; JR Z,L1148 ; to V-SYN/RUN SET 6,C ; CP $0D ; JR Z,L1143 ; forward to V-STR-VAR SET 5,C ; ;; V-CHAR L1139: CALL L14D2 ; routine ALPHANUM JR NC,L1148 ; forward when not to V-RUN/SYN RES 6,C ; RST 20H ; NEXT-CHAR JR L1139 ; loop back to V-CHAR ; --- ;; V-STR-VAR L1143: RST 20H ; NEXT-CHAR RES 6,(IY+$01) ; sv FLAGS - Signal string result ;; V-RUN/SYN L1148: LD B,C ; CALL L0DA6 ; routine SYNTAX-Z JR NZ,L1156 ; forward to V-RUN LD A,C ; AND $E0 ; SET 7,A ; LD C,A ; JR L118A ; forward to V-SYNTAX ; --- ;; V-RUN L1156: LD HL,($4010) ; sv VARS ;; V-EACH L1159: LD A,(HL) ; AND $7F ; JR Z,L1188 ; to V-80-BYTE CP C ; JR NZ,L1180 ; to V-NEXT RLA ; ADD A,A ; JP P,L1195 ; to V-FOUND-2 JR C,L1195 ; to V-FOUND-2 POP DE ; PUSH DE ; PUSH HL ; ;; V-MATCHES L116B: INC HL ; ;; V-SPACES L116C: LD A,(DE) ; INC DE ; AND A ; JR Z,L116C ; back to V-SPACES CP (HL) ; JR Z,L116B ; back to V-MATCHES OR $80 ; CP (HL) ; JR NZ,L117F ; forward to V-GET-PTR LD A,(DE) ; CALL L14D2 ; routine ALPHANUM JR NC,L1194 ; forward to V-FOUND-1 ;; V-GET-PTR L117F: POP HL ; ;; V-NEXT L1180: PUSH BC ; CALL L09F2 ; routine NEXT-ONE EX DE,HL ; POP BC ; JR L1159 ; back to V-EACH ; --- ;; V-80-BYTE L1188: SET 7,B ; ;; V-SYNTAX L118A: POP DE ; RST 18H ; GET-CHAR CP $10 ; JR Z,L1199 ; forward to V-PASS SET 5,B ; JR L11A1 ; forward to V-END ; --- ;; V-FOUND-1 L1194: POP DE ; ;; V-FOUND-2 L1195: POP DE ; POP DE ; PUSH HL ; RST 18H ; GET-CHAR ;; V-PASS L1199: CALL L14D2 ; routine ALPHANUM JR NC,L11A1 ; forward if not alphanumeric to V-END RST 20H ; NEXT-CHAR JR L1199 ; back to V-PASS ; --- ;; V-END L11A1: POP HL ; RL B ; BIT 6,B ; RET ; ; ------------------------ ; THE 'STK-VAR' SUBROUTINE ; ------------------------ ; ; ;; STK-VAR L11A7: XOR A ; LD B,A ; BIT 7,C ; JR NZ,L11F8 ; forward to SV-COUNT BIT 7,(HL) ; JR NZ,L11BF ; forward to SV-ARRAYS INC A ; ;; SV-SIMPLE$ L11B2: INC HL ; LD C,(HL) ; INC HL ; LD B,(HL) ; INC HL ; EX DE,HL ; CALL L12C3 ; routine STK-STO-$ RST 18H ; GET-CHAR JP L125A ; jump forward to SV-SLICE? ; --- ;; SV-ARRAYS L11BF: INC HL ; INC HL ; INC HL ; LD B,(HL) ; BIT 6,C ; JR Z,L11D1 ; forward to SV-PTR DEC B ; JR Z,L11B2 ; forward to SV-SIMPLE$ EX DE,HL ; RST 18H ; GET-CHAR CP $10 ; JR NZ,L1231 ; forward to REPORT-3 EX DE,HL ; ;; SV-PTR L11D1: EX DE,HL ; JR L11F8 ; forward to SV-COUNT ; --- ;; SV-COMMA L11D4: PUSH HL ; RST 18H ; GET-CHAR POP HL ; CP $1A ; JR Z,L11FB ; forward to SV-LOOP BIT 7,C ; JR Z,L1231 ; forward to REPORT-3 BIT 6,C ; JR NZ,L11E9 ; forward to SV-CLOSE CP $11 ; JR NZ,L1223 ; forward to SV-RPT-C RST 20H ; NEXT-CHAR RET ; ; --- ;; SV-CLOSE L11E9: CP $11 ; JR Z,L1259 ; forward to SV-DIM CP $DF ; JR NZ,L1223 ; forward to SV-RPT-C ;; SV-CH-ADD L11F1: RST 18H ; GET-CHAR DEC HL ; LD ($4016),HL ; sv CH_ADD JR L1256 ; forward to SV-SLICE ; --- ;; SV-COUNT L11F8: LD HL,$0000 ; ;; SV-LOOP L11FB: PUSH HL ; RST 20H ; NEXT-CHAR POP HL ; LD A,C ; CP $C0 ; JR NZ,L120C ; forward to SV-MULT RST 18H ; GET-CHAR CP $11 ; JR Z,L1259 ; forward to SV-DIM CP $DF ; JR Z,L11F1 ; back to SV-CH-ADD ;; SV-MULT L120C: PUSH BC ; PUSH HL ; CALL L12FF ; routine DE,(DE+1) EX (SP),HL ; EX DE,HL ; CALL L12DD ; routine INT-EXP1 JR C,L1231 ; forward to REPORT-3 DEC BC ; CALL L1305 ; routine GET-HL*DE ADD HL,BC ; POP DE ; POP BC ; DJNZ L11D4 ; loop back to SV-COMMA BIT 7,C ; ;; SV-RPT-C L1223: JR NZ,L128B ; relative jump to SL-RPT-C PUSH HL ; BIT 6,C ; JR NZ,L123D ; forward to SV-ELEM$ LD B,D ; LD C,E ; RST 18H ; GET-CHAR CP $11 ; is character a ')' ? JR Z,L1233 ; skip forward to SV-NUMBER ;; REPORT-3 L1231: RST 08H ; ERROR-1 DEFB $02 ; Error Report: Subscript wrong ;; SV-NUMBER L1233: RST 20H ; NEXT-CHAR POP HL ; LD DE,$0005 ; CALL L1305 ; routine GET-HL*DE ADD HL,BC ; RET ; return >> ; --- ;; SV-ELEM$ L123D: CALL L12FF ; routine DE,(DE+1) EX (SP),HL ; CALL L1305 ; routine GET-HL*DE POP BC ; ADD HL,BC ; INC HL ; LD B,D ; LD C,E ; EX DE,HL ; CALL L12C2 ; routine STK-ST-0 RST 18H ; GET-CHAR CP $11 ; is it ')' ? JR Z,L1259 ; forward if so to SV-DIM CP $1A ; is it ',' ? JR NZ,L1231 ; back if not to REPORT-3 ;; SV-SLICE L1256: CALL L1263 ; routine SLICING ;; SV-DIM L1259: RST 20H ; NEXT-CHAR ;; SV-SLICE? L125A: CP $10 ; JR Z,L1256 ; back to SV-SLICE RES 6,(IY+$01) ; sv FLAGS - Signal string result RET ; return. ; ------------------------ ; THE 'SLICING' SUBROUTINE ; ------------------------ ; ; ;; SLICING L1263: CALL L0DA6 ; routine SYNTAX-Z CALL NZ,L13F8 ; routine STK-FETCH RST 20H ; NEXT-CHAR CP $11 ; is it ')' ? JR Z,L12BE ; forward if so to SL-STORE PUSH DE ; XOR A ; PUSH AF ; PUSH BC ; LD DE,$0001 ; RST 18H ; GET-CHAR POP HL ; CP $DF ; is it 'TO' ? JR Z,L1292 ; forward if so to SL-SECOND POP AF ; CALL L12DE ; routine INT-EXP2 PUSH AF ; LD D,B ; LD E,C ; PUSH HL ; RST 18H ; GET-CHAR POP HL ; CP $DF ; is it 'TO' ? JR Z,L1292 ; forward if so to SL-SECOND CP $11 ; ;; SL-RPT-C L128B: JP NZ,L0D9A ; to REPORT-C LD H,D ; LD L,E ; JR L12A5 ; forward to SL-DEFINE ; --- ;; SL-SECOND L1292: PUSH HL ; RST 20H ; NEXT-CHAR POP HL ; CP $11 ; is it ')' ? JR Z,L12A5 ; forward if so to SL-DEFINE POP AF ; CALL L12DE ; routine INT-EXP2 PUSH AF ; RST 18H ; GET-CHAR LD H,B ; LD L,C ; CP $11 ; is it ')' ? JR NZ,L128B ; back if not to SL-RPT-C ;; SL-DEFINE L12A5: POP AF ; EX (SP),HL ; ADD HL,DE ; DEC HL ; EX (SP),HL ; AND A ; SBC HL,DE ; LD BC,$0000 ; JR C,L12B9 ; forward to SL-OVER INC HL ; AND A ; JP M,L1231 ; jump back to REPORT-3 LD B,H ; LD C,L ; ;; SL-OVER L12B9: POP DE ; RES 6,(IY+$01) ; sv FLAGS - Signal string result ;; SL-STORE L12BE: CALL L0DA6 ; routine SYNTAX-Z RET Z ; return if checking syntax. ; -------------------------- ; THE 'STK-STORE' SUBROUTINE ; -------------------------- ; ; ;; STK-ST-0 L12C2: XOR A ; ;; STK-STO-$ L12C3: PUSH BC ; CALL L19EB ; routine TEST-5-SP POP BC ; LD HL,($401C) ; sv STKEND LD (HL),A ; INC HL ; LD (HL),E ; INC HL ; LD (HL),D ; INC HL ; LD (HL),C ; INC HL ; LD (HL),B ; INC HL ; LD ($401C),HL ; sv STKEND RES 6,(IY+$01) ; update FLAGS - signal string result RET ; return. ; ------------------------- ; THE 'INT EXP' SUBROUTINES ; ------------------------- ; ; ;; INT-EXP1 L12DD: XOR A ; ;; INT-EXP2 L12DE: PUSH DE ; PUSH HL ; PUSH AF ; CALL L0D92 ; routine CLASS-6 POP AF ; CALL L0DA6 ; routine SYNTAX-Z JR Z,L12FC ; forward if checking syntax to I-RESTORE PUSH AF ; CALL L0EA7 ; routine FIND-INT POP DE ; LD A,B ; OR C ; SCF ; Set Carry Flag JR Z,L12F9 ; forward to I-CARRY POP HL ; PUSH HL ; AND A ; SBC HL,BC ; ;; I-CARRY L12F9: LD A,D ; SBC A,$00 ; ;; I-RESTORE L12FC: POP HL ; POP DE ; RET ; ; -------------------------- ; THE 'DE,(DE+1)' SUBROUTINE ; -------------------------- ; INDEX and LOAD Z80 subroutine. ; This emulates the 6800 processor instruction LDX 1,X which loads a two-byte ; value from memory into the register indexing it. Often these are hardly worth ; the bother of writing as subroutines and this one doesn't save any time or ; memory. The timing and space overheads have to be offset against the ease of ; writing and the greater program readability from using such toolkit routines. ;; DE,(DE+1) L12FF: EX DE,HL ; move index address into HL. INC HL ; increment to address word. LD E,(HL) ; pick up word low-order byte. INC HL ; index high-order byte and LD D,(HL) ; pick it up. RET ; return with DE = word. ; -------------------------- ; THE 'GET-HL*DE' SUBROUTINE ; -------------------------- ; ;; GET-HL*DE L1305: CALL L0DA6 ; routine SYNTAX-Z RET Z ; PUSH BC ; LD B,$10 ; LD A,H ; LD C,L ; LD HL,$0000 ; ;; HL-LOOP L1311: ADD HL,HL ; JR C,L131A ; forward with carry to HL-END RL C ; RLA ; JR NC,L131D ; forward with no carry to HL-AGAIN ADD HL,DE ; ;; HL-END L131A: JP C,L0ED3 ; to REPORT-4 ;; HL-AGAIN L131D: DJNZ L1311 ; loop back to HL-LOOP POP BC ; RET ; return. ; -------------------- ; THE 'LET' SUBROUTINE ; -------------------- ; ; ;; LET L1321: LD HL,($4012) ; sv DEST-lo BIT 1,(IY+$2D) ; sv FLAGX JR Z,L136E ; forward to L-EXISTS LD BC,$0005 ; ;; L-EACH-CH L132D: INC BC ; ; check ;; L-NO-SP L132E: INC HL ; LD A,(HL) ; AND A ; JR Z,L132E ; back to L-NO-SP CALL L14D2 ; routine ALPHANUM JR C,L132D ; back to L-EACH-CH CP $0D ; is it '$' ? JP Z,L13C8 ; forward if so to L-NEW$ RST 30H ; BC-SPACES PUSH DE ; LD HL,($4012) ; sv DEST DEC DE ; LD A,C ; SUB $06 ; LD B,A ; LD A,$40 ; JR Z,L1359 ; forward to L-SINGLE ;; L-CHAR L134B: INC HL ; LD A,(HL) ; AND A ; is it a space ? JR Z,L134B ; back to L-CHAR INC DE ; LD (DE),A ; DJNZ L134B ; loop back to L-CHAR OR $80 ; LD (DE),A ; LD A,$80 ; ;; L-SINGLE L1359: LD HL,($4012) ; sv DEST-lo XOR (HL) ; POP HL ; CALL L13E7 ; routine L-FIRST ;; L-NUMERIC L1361: PUSH HL ; RST 28H ;; FP-CALC DEFB $02 ;;delete DEFB $34 ;;end-calc POP HL ; LD BC,$0005 ; AND A ; SBC HL,BC ; JR L13AE ; forward to L-ENTER ; --- ;; L-EXISTS L136E: BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? JR Z,L137A ; forward to L-DELETE$ LD DE,$0006 ; ADD HL,DE ; JR L1361 ; back to L-NUMERIC ; --- ;; L-DELETE$ L137A: LD HL,($4012) ; sv DEST-lo LD BC,($402E) ; sv STRLEN_lo BIT 0,(IY+$2D) ; sv FLAGX JR NZ,L13B7 ; forward to L-ADD$ LD A,B ; OR C ; RET Z ; PUSH HL ; RST 30H ; BC-SPACES PUSH DE ; PUSH BC ; LD D,H ; LD E,L ; INC HL ; LD (HL),$00 ; LDDR ; Copy Bytes PUSH HL ; CALL L13F8 ; routine STK-FETCH POP HL ; EX (SP),HL ; AND A ; SBC HL,BC ; ADD HL,BC ; JR NC,L13A3 ; forward to L-LENGTH LD B,H ; LD C,L ; ;; L-LENGTH L13A3: EX (SP),HL ; EX DE,HL ; LD A,B ; OR C ; JR Z,L13AB ; forward if zero to L-IN-W/S LDIR ; Copy Bytes ;; L-IN-W/S L13AB: POP BC ; POP DE ; POP HL ; ; ------------------------ ; THE 'L-ENTER' SUBROUTINE ; ------------------------ ; ;; L-ENTER L13AE: EX DE,HL ; LD A,B ; OR C ; RET Z ; PUSH DE ; LDIR ; Copy Bytes POP HL ; RET ; return. ; --- ;; L-ADD$ L13B7: DEC HL ; DEC HL ; DEC HL ; LD A,(HL) ; PUSH HL ; PUSH BC ; CALL L13CE ; routine L-STRING POP BC ; POP HL ; INC BC ; INC BC ; INC BC ; JP L0A60 ; jump back to exit via RECLAIM-2 ; --- ;; L-NEW$ L13C8: LD A,$60 ; prepare mask %01100000 LD HL,($4012) ; sv DEST-lo XOR (HL) ; ; ------------------------- ; THE 'L-STRING' SUBROUTINE ; ------------------------- ; ;; L-STRING L13CE: PUSH AF ; CALL L13F8 ; routine STK-FETCH EX DE,HL ; ADD HL,BC ; PUSH HL ; INC BC ; INC BC ; INC BC ; RST 30H ; BC-SPACES EX DE,HL ; POP HL ; DEC BC ; DEC BC ; PUSH BC ; LDDR ; Copy Bytes EX DE,HL ; POP BC ; DEC BC ; LD (HL),B ; DEC HL ; LD (HL),C ; POP AF ; ;; L-FIRST L13E7: PUSH AF ; CALL L14C7 ; routine REC-V80 POP AF ; DEC HL ; LD (HL),A ; LD HL,($401A) ; sv STKBOT_lo LD ($4014),HL ; sv E_LINE_lo DEC HL ; LD (HL),$80 ; RET ; ; -------------------------- ; THE 'STK-FETCH' SUBROUTINE ; -------------------------- ; This routine fetches a five-byte value from the calculator stack ; reducing the pointer to the end of the stack by five. ; For a floating-point number the exponent is in A and the mantissa ; is the thirty-two bits EDCB. ; For strings, the start of the string is in DE and the length in BC. ; A is unused. ;; STK-FETCH L13F8: LD HL,($401C) ; load HL from system variable STKEND DEC HL ; LD B,(HL) ; DEC HL ; LD C,(HL) ; DEC HL ; LD D,(HL) ; DEC HL ; LD E,(HL) ; DEC HL ; LD A,(HL) ; LD ($401C),HL ; set system variable STKEND to lower value. RET ; return. ; ------------------------- ; THE 'DIM' COMMAND ROUTINE ; ------------------------- ; An array is created and initialized to zeros which is also the space ; character on the ZX81. ;; DIM L1409: CALL L111C ; routine LOOK-VARS ;; D-RPORT-C L140C: JP NZ,L0D9A ; to REPORT-C CALL L0DA6 ; routine SYNTAX-Z JR NZ,L141C ; forward to D-RUN RES 6,C ; CALL L11A7 ; routine STK-VAR CALL L0D1D ; routine CHECK-END ;; D-RUN L141C: JR C,L1426 ; forward to D-LETTER PUSH BC ; CALL L09F2 ; routine NEXT-ONE CALL L0A60 ; routine RECLAIM-2 POP BC ; ;; D-LETTER L1426: SET 7,C ; LD B,$00 ; PUSH BC ; LD HL,$0001 ; BIT 6,C ; JR NZ,L1434 ; forward to D-SIZE LD L,$05 ; ;; D-SIZE L1434: EX DE,HL ; ;; D-NO-LOOP L1435: RST 20H ; NEXT-CHAR LD H,$40 ; CALL L12DD ; routine INT-EXP1 JP C,L1231 ; jump back to REPORT-3 POP HL ; PUSH BC ; INC H ; PUSH HL ; LD H,B ; LD L,C ; CALL L1305 ; routine GET-HL*DE EX DE,HL ; RST 18H ; GET-CHAR CP $1A ; JR Z,L1435 ; back to D-NO-LOOP CP $11 ; is it ')' ? JR NZ,L140C ; back if not to D-RPORT-C RST 20H ; NEXT-CHAR POP BC ; LD A,C ; LD L,B ; LD H,$00 ; INC HL ; INC HL ; ADD HL,HL ; ADD HL,DE ; JP C,L0ED3 ; jump to REPORT-4 PUSH DE ; PUSH BC ; PUSH HL ; LD B,H ; LD C,L ; LD HL,($4014) ; sv E_LINE_lo DEC HL ; CALL L099E ; routine MAKE-ROOM INC HL ; LD (HL),A ; POP BC ; DEC BC ; DEC BC ; DEC BC ; INC HL ; LD (HL),C ; INC HL ; LD (HL),B ; POP AF ; INC HL ; LD (HL),A ; LD H,D ; LD L,E ; DEC DE ; LD (HL),$00 ; POP BC ; LDDR ; Copy Bytes ;; DIM-SIZES L147F: POP BC ; LD (HL),B ; DEC HL ; LD (HL),C ; DEC HL ; DEC A ; JR NZ,L147F ; back to DIM-SIZES RET ; return. ; --------------------- ; THE 'RESERVE' ROUTINE ; --------------------- ; ; ;; RESERVE L1488: LD HL,($401A) ; address STKBOT DEC HL ; now last byte of workspace CALL L099E ; routine MAKE-ROOM INC HL ; INC HL ; POP BC ; LD ($4014),BC ; sv E_LINE_lo POP BC ; EX DE,HL ; INC HL ; RET ; ; --------------------------- ; THE 'CLEAR' COMMAND ROUTINE ; --------------------------- ; ; ;; CLEAR L149A: LD HL,($4010) ; sv VARS_lo LD (HL),$80 ; INC HL ; LD ($4014),HL ; sv E_LINE_lo ; ----------------------- ; THE 'X-TEMP' SUBROUTINE ; ----------------------- ; ; ;; X-TEMP L14A3: LD HL,($4014) ; sv E_LINE_lo ; ---------------------- ; THE 'SET-STK' ROUTINES ; ---------------------- ; ; ;; SET-STK-B L14A6: LD ($401A),HL ; sv STKBOT ; ;; SET-STK-E L14A9: LD ($401C),HL ; sv STKEND RET ; ; ----------------------- ; THE 'CURSOR-IN' ROUTINE ; ----------------------- ; This routine is called to set the edit line to the minimum cursor/newline ; and to set STKEND, the start of free space, at the next position. ;; CURSOR-IN L14AD: LD HL,($4014) ; fetch start of edit line from E_LINE LD (HL),$7F ; insert cursor character INC HL ; point to next location. LD (HL),$76 ; insert NEWLINE character INC HL ; point to next free location. LD (IY+$22),$02 ; set lower screen display file size DF_SZ JR L14A6 ; exit via SET-STK-B above ; ------------------------ ; THE 'SET-MIN' SUBROUTINE ; ------------------------ ; ; ;; SET-MIN L14BC: LD HL,$405D ; normal location of calculator's memory area LD ($401F),HL ; update system variable MEM LD HL,($401A) ; fetch STKBOT JR L14A9 ; back to SET-STK-E ; ------------------------------------ ; THE 'RECLAIM THE END-MARKER' ROUTINE ; ------------------------------------ ;; REC-V80 L14C7: LD DE,($4014) ; sv E_LINE_lo JP L0A5D ; to RECLAIM-1 ; ---------------------- ; THE 'ALPHA' SUBROUTINE ; ---------------------- ;; ALPHA L14CE: CP $26 ; JR L14D4 ; skip forward to ALPHA-2 ; ------------------------- ; THE 'ALPHANUM' SUBROUTINE ; ------------------------- ;; ALPHANUM L14D2: CP $1C ; ;; ALPHA-2 L14D4: CCF ; Complement Carry Flag RET NC ; CP $40 ; RET ; ; ------------------------------------------ ; THE 'DECIMAL TO FLOATING POINT' SUBROUTINE ; ------------------------------------------ ; ;; DEC-TO-FP L14D9: CALL L1548 ; routine INT-TO-FP gets first part CP $1B ; is character a '.' ? JR NZ,L14F5 ; forward if not to E-FORMAT RST 28H ;; FP-CALC DEFB $A1 ;;stk-one DEFB $C0 ;;st-mem-0 DEFB $02 ;;delete DEFB $34 ;;end-calc ;; NXT-DGT-1 L14E5: RST 20H ; NEXT-CHAR CALL L1514 ; routine STK-DIGIT JR C,L14F5 ; forward to E-FORMAT RST 28H ;; FP-CALC DEFB $E0 ;;get-mem-0 DEFB $A4 ;;stk-ten DEFB $05 ;;division DEFB $C0 ;;st-mem-0 DEFB $04 ;;multiply DEFB $0F ;;addition DEFB $34 ;;end-calc JR L14E5 ; loop back till exhausted to NXT-DGT-1 ; --- ;; E-FORMAT L14F5: CP $2A ; is character 'E' ? RET NZ ; return if not LD (IY+$5D),$FF ; initialize sv MEM-0-1st to $FF TRUE RST 20H ; NEXT-CHAR CP $15 ; is character a '+' ? JR Z,L1508 ; forward if so to SIGN-DONE CP $16 ; is it a '-' ? JR NZ,L1509 ; forward if not to ST-E-PART INC (IY+$5D) ; sv MEM-0-1st change to FALSE ;; SIGN-DONE L1508: RST 20H ; NEXT-CHAR ;; ST-E-PART L1509: CALL L1548 ; routine INT-TO-FP RST 28H ;; FP-CALC m, e. DEFB $E0 ;;get-mem-0 m, e, (1/0) TRUE/FALSE DEFB $00 ;;jump-true DEFB $02 ;;to L1511, E-POSTVE DEFB $18 ;;neg m, -e ;; E-POSTVE L1511: DEFB $38 ;;e-to-fp x. DEFB $34 ;;end-calc x. RET ; return. ; -------------------------- ; THE 'STK-DIGIT' SUBROUTINE ; -------------------------- ; ;; STK-DIGIT L1514: CP $1C ; RET C ; CP $26 ; CCF ; Complement Carry Flag RET C ; SUB $1C ; ; ------------------------ ; THE 'STACK-A' SUBROUTINE ; ------------------------ ; ;; STACK-A L151D: LD C,A ; LD B,$00 ; ; ------------------------- ; THE 'STACK-BC' SUBROUTINE ; ------------------------- ; The ZX81 does not have an integer number format so the BC register contents ; must be converted to their full floating-point form. ;; STACK-BC L1520: LD IY,$4000 ; re-initialize the system variables pointer. PUSH BC ; save the integer value. ; now stack zero, five zero bytes as a starting point. RST 28H ;; FP-CALC DEFB $A0 ;;stk-zero 0. DEFB $34 ;;end-calc POP BC ; restore integer value. LD (HL),$91 ; place $91 in exponent 65536. ; this is the maximum possible value LD A,B ; fetch hi-byte. AND A ; test for zero. JR NZ,L1536 ; forward if not zero to STK-BC-2 LD (HL),A ; else make exponent zero again OR C ; test lo-byte RET Z ; return if BC was zero - done. ; else there has to be a set bit if only the value one. LD B,C ; save C in B. LD C,(HL) ; fetch zero to C LD (HL),$89 ; make exponent $89 256. ;; STK-BC-2 L1536: DEC (HL) ; decrement exponent - halving number SLA C ; C<-76543210<-0 RL B ; C<-76543210<-C JR NC,L1536 ; loop back if no carry to STK-BC-2 SRL B ; 0->76543210->C RR C ; C->76543210->C INC HL ; address first byte of mantissa LD (HL),B ; insert B INC HL ; address second byte of mantissa LD (HL),C ; insert C DEC HL ; point to the DEC HL ; exponent again RET ; return. ; ------------------------------------------ ; THE 'INTEGER TO FLOATING POINT' SUBROUTINE ; ------------------------------------------ ; ; ;; INT-TO-FP L1548: PUSH AF ; RST 28H ;; FP-CALC DEFB $A0 ;;stk-zero DEFB $34 ;;end-calc POP AF ; ;; NXT-DGT-2 L154D: CALL L1514 ; routine STK-DIGIT RET C ; RST 28H ;; FP-CALC DEFB $01 ;;exchange DEFB $A4 ;;stk-ten DEFB $04 ;;multiply DEFB $0F ;;addition DEFB $34 ;;end-calc RST 20H ; NEXT-CHAR JR L154D ; to NXT-DGT-2 ; ------------------------------------------- ; THE 'E-FORMAT TO FLOATING POINT' SUBROUTINE ; ------------------------------------------- ; (Offset $38: 'e-to-fp') ; invoked from DEC-TO-FP and PRINT-FP. ; e.g. 2.3E4 is 23000. ; This subroutine evaluates xEm where m is a positive or negative integer. ; At a simple level x is multiplied by ten for every unit of m. ; If the decimal exponent m is negative then x is divided by ten for each unit. ; A short-cut is taken if the exponent is greater than seven and in this ; case the exponent is reduced by seven and the value is multiplied or divided ; by ten million. ; Note. for the ZX Spectrum an even cleverer method was adopted which involved ; shifting the bits out of the exponent so the result was achieved with six ; shifts at most. The routine below had to be completely re-written mostly ; in Z80 machine code. ; Although no longer operable, the calculator literal was retained for old ; times sake, the routine being invoked directly from a machine code CALL. ; ; On entry in the ZX81, m, the exponent, is the 'last value', and the ; floating-point decimal mantissa is beneath it. ;; e-to-fp L155A: RST 28H ;; FP-CALC x, m. DEFB $2D ;;duplicate x, m, m. DEFB $32 ;;less-0 x, m, (1/0). DEFB $C0 ;;st-mem-0 x, m, (1/0). DEFB $02 ;;delete x, m. DEFB $27 ;;abs x, +m. ;; E-LOOP L1560: DEFB $A1 ;;stk-one x, m,1. DEFB $03 ;;subtract x, m-1. DEFB $2D ;;duplicate x, m-1,m-1. DEFB $32 ;;less-0 x, m-1, (1/0). DEFB $00 ;;jump-true x, m-1. DEFB $22 ;;to L1587, E-END x, m-1. DEFB $2D ;;duplicate x, m-1, m-1. DEFB $30 ;;stk-data DEFB $33 ;;Exponent: $83, Bytes: 1 DEFB $40 ;;(+00,+00,+00) x, m-1, m-1, 6. DEFB $03 ;;subtract x, m-1, m-7. DEFB $2D ;;duplicate x, m-1, m-7, m-7. DEFB $32 ;;less-0 x, m-1, m-7, (1/0). DEFB $00 ;;jump-true x, m-1, m-7. DEFB $0C ;;to L157A, E-LOW ; but if exponent m is higher than 7 do a bigger chunk. ; multiplying (or dividing if negative) by 10 million - 1e7. DEFB $01 ;;exchange x, m-7, m-1. DEFB $02 ;;delete x, m-7. DEFB $01 ;;exchange m-7, x. DEFB $30 ;;stk-data DEFB $80 ;;Bytes: 3 DEFB $48 ;;Exponent $98 DEFB $18,$96,$80 ;;(+00) m-7, x, 10,000,000 (=f) DEFB $2F ;;jump DEFB $04 ;;to L157D, E-CHUNK ; --- ;; E-LOW L157A: DEFB $02 ;;delete x, m-1. DEFB $01 ;;exchange m-1, x. DEFB $A4 ;;stk-ten m-1, x, 10 (=f). ;; E-CHUNK L157D: DEFB $E0 ;;get-mem-0 m-1, x, f, (1/0) DEFB $00 ;;jump-true m-1, x, f DEFB $04 ;;to L1583, E-DIVSN DEFB $04 ;;multiply m-1, x*f. DEFB $2F ;;jump DEFB $02 ;;to L1584, E-SWAP ; --- ;; E-DIVSN L1583: DEFB $05 ;;division m-1, x/f (= new x). ;; E-SWAP L1584: DEFB $01 ;;exchange x, m-1 (= new m). DEFB $2F ;;jump x, m. DEFB $DA ;;to L1560, E-LOOP ; --- ;; E-END L1587: DEFB $02 ;;delete x. (-1) DEFB $34 ;;end-calc x. RET ; return. ; ------------------------------------- ; THE 'FLOATING-POINT TO BC' SUBROUTINE ; ------------------------------------- ; The floating-point form on the calculator stack is compressed directly into ; the BC register rounding up if necessary. ; Valid range is 0 to 65535.4999 ;; FP-TO-BC L158A: CALL L13F8 ; routine STK-FETCH - exponent to A ; mantissa to EDCB. AND A ; test for value zero. JR NZ,L1595 ; forward if not to FPBC-NZRO ; else value is zero LD B,A ; zero to B LD C,A ; also to C PUSH AF ; save the flags on machine stack JR L15C6 ; forward to FPBC-END ; --- ; EDCB => BCE ;; FPBC-NZRO L1595: LD B,E ; transfer the mantissa from EDCB LD E,C ; to BCE. Bit 7 of E is the 17th bit which LD C,D ; will be significant for rounding if the ; number is already normalized. SUB $91 ; subtract 65536 CCF ; complement carry flag BIT 7,B ; test sign bit PUSH AF ; push the result SET 7,B ; set the implied bit JR C,L15C6 ; forward with carry from SUB/CCF to FPBC-END ; number is too big. INC A ; increment the exponent and NEG ; negate to make range $00 - $0F CP $08 ; test if one or two bytes JR C,L15AF ; forward with two to BIG-INT LD E,C ; shift mantissa LD C,B ; 8 places right LD B,$00 ; insert a zero in B SUB $08 ; reduce exponent by eight ;; BIG-INT L15AF: AND A ; test the exponent LD D,A ; save exponent in D. LD A,E ; fractional bits to A RLCA ; rotate most significant bit to carry for ; rounding of an already normal number. JR Z,L15BC ; forward if exponent zero to EXP-ZERO ; the number is normalized ;; FPBC-NORM L15B5: SRL B ; 0->76543210->C RR C ; C->76543210->C DEC D ; decrement exponent JR NZ,L15B5 ; loop back till zero to FPBC-NORM ;; EXP-ZERO L15BC: JR NC,L15C6 ; forward without carry to NO-ROUND INC BC ; round up. LD A,B ; test result OR C ; for zero JR NZ,L15C6 ; forward if not to GRE-ZERO POP AF ; restore sign flag SCF ; set carry flag to indicate overflow PUSH AF ; save combined flags again ;; FPBC-END L15C6: PUSH BC ; save BC value ; set HL and DE to calculator stack pointers. RST 28H ;; FP-CALC DEFB $34 ;;end-calc POP BC ; restore BC value POP AF ; restore flags LD A,C ; copy low byte to A also. RET ; return ; ------------------------------------ ; THE 'FLOATING-POINT TO A' SUBROUTINE ; ------------------------------------ ; ; ;; FP-TO-A L15CD: CALL L158A ; routine FP-TO-BC RET C ; PUSH AF ; DEC B ; INC B ; JR Z,L15D9 ; forward if in range to FP-A-END POP AF ; fetch result SCF ; set carry flag signaling overflow RET ; return ;; FP-A-END L15D9: POP AF ; RET ; ; ---------------------------------------------- ; THE 'PRINT A FLOATING-POINT NUMBER' SUBROUTINE ; ---------------------------------------------- ; prints 'last value' x on calculator stack. ; There are a wide variety of formats see Chapter 4. ; e.g. ; PI prints as 3.1415927 ; .123 prints as 0.123 ; .0123 prints as .0123 ; 999999999999 prints as 1000000000000 ; 9876543210123 prints as 9876543200000 ; Begin by isolating zero and just printing the '0' character ; for that case. For negative numbers print a leading '-' and ; then form the absolute value of x. ;; PRINT-FP L15DB: RST 28H ;; FP-CALC x. DEFB $2D ;;duplicate x, x. DEFB $32 ;;less-0 x, (1/0). DEFB $00 ;;jump-true DEFB $0B ;;to L15EA, PF-NGTVE x. DEFB $2D ;;duplicate x, x DEFB $33 ;;greater-0 x, (1/0). DEFB $00 ;;jump-true DEFB $0D ;;to L15F0, PF-POSTVE x. DEFB $02 ;;delete . DEFB $34 ;;end-calc . LD A,$1C ; load accumulator with character '0' RST 10H ; PRINT-A RET ; return. >> ; --- ;; PF-NEGTVE L15EA: DEFB $27 ; abs +x. DEFB $34 ;;end-calc x. LD A,$16 ; load accumulator with '-' RST 10H ; PRINT-A RST 28H ;; FP-CALC x. ;; PF-POSTVE L15F0: DEFB $34 ;;end-calc x. ; register HL addresses the exponent of the floating-point value. ; if positive, and point floats to left, then bit 7 is set. LD A,(HL) ; pick up the exponent byte CALL L151D ; routine STACK-A places on calculator stack. ; now calculate roughly the number of digits, n, before the decimal point by ; subtracting a half from true exponent and multiplying by log to ; the base 10 of 2. ; The true number could be one higher than n, the integer result. RST 28H ;; FP-CALC x, e. DEFB $30 ;;stk-data DEFB $78 ;;Exponent: $88, Bytes: 2 DEFB $00,$80 ;;(+00,+00) x, e, 128.5. DEFB $03 ;;subtract x, e -.5. DEFB $30 ;;stk-data DEFB $EF ;;Exponent: $7F, Bytes: 4 DEFB $1A,$20,$9A,$85 ;; .30103 (log10 2) DEFB $04 ;;multiply x, DEFB $24 ;;int DEFB $C1 ;;st-mem-1 x, n. DEFB $30 ;;stk-data DEFB $34 ;;Exponent: $84, Bytes: 1 DEFB $00 ;;(+00,+00,+00) x, n, 8. DEFB $03 ;;subtract x, n-8. DEFB $18 ;;neg x, 8-n. DEFB $38 ;;e-to-fp x * (10^n) ; finally the 8 or 9 digit decimal is rounded. ; a ten-digit integer can arise in the case of, say, 999999999.5 ; which gives 1000000000. DEFB $A2 ;;stk-half DEFB $0F ;;addition DEFB $24 ;;int i. DEFB $34 ;;end-calc ; If there were 8 digits then final rounding will take place on the calculator ; stack above and the next two instructions insert a masked zero so that ; no further rounding occurs. If the result is a 9 digit integer then ; rounding takes place within the buffer. LD HL,$406B ; address system variable MEM-2-5th ; which could be the 'ninth' digit. LD (HL),$90 ; insert the value $90 10010000 ; now starting from lowest digit lay down the 8, 9 or 10 digit integer ; which represents the significant portion of the number ; e.g. PI will be the nine-digit integer 314159265 LD B,$0A ; count is ten digits. ;; PF-LOOP L1615: INC HL ; increase pointer PUSH HL ; preserve buffer address. PUSH BC ; preserve counter. RST 28H ;; FP-CALC i. DEFB $A4 ;;stk-ten i, 10. DEFB $2E ;;n-mod-m i mod 10, i/10 DEFB $01 ;;exchange i/10, remainder. DEFB $34 ;;end-calc CALL L15CD ; routine FP-TO-A $00-$09 OR $90 ; make left hand nibble 9 POP BC ; restore counter POP HL ; restore buffer address. LD (HL),A ; insert masked digit in buffer. DJNZ L1615 ; loop back for all ten to PF-LOOP ; the most significant digit will be last but if the number is exhausted then ; the last one or two positions will contain zero ($90). ; e.g. for 'one' we have zero as estimate of leading digits. ; 1*10^8 100000000 as integer value ; 90 90 90 90 90 90 90 90 91 90 as buffer mem3/mem4 contents. INC HL ; advance pointer to one past buffer LD BC,$0008 ; set C to 8 ( B is already zero ) PUSH HL ; save pointer. ;; PF-NULL L162C: DEC HL ; decrease pointer LD A,(HL) ; fetch masked digit CP $90 ; is it a leading zero ? JR Z,L162C ; loop back if so to PF-NULL ; at this point a significant digit has been found. carry is reset. SBC HL,BC ; subtract eight from the address. PUSH HL ; ** save this pointer too LD A,(HL) ; fetch addressed byte ADD A,$6B ; add $6B - forcing a round up ripple ; if $95 or over. PUSH AF ; save the carry result. ; now enter a loop to round the number. After rounding has been considered ; a zero that has arisen from rounding or that was present at that position ; originally is changed from $90 to $80. ;; PF-RND-LP L1639: POP AF ; retrieve carry from machine stack. INC HL ; increment address LD A,(HL) ; fetch new byte ADC A,$00 ; add in any carry DAA ; decimal adjust accumulator ; carry will ripple through the '9' PUSH AF ; save carry on machine stack. AND $0F ; isolate character 0 - 9 AND set zero flag ; if zero. LD (HL),A ; place back in location. SET 7,(HL) ; set bit 7 to show printable. ; but not if trailing zero after decimal point. JR Z,L1639 ; back if a zero to PF-RND-LP ; to consider further rounding and/or trailing ; zero identification. POP AF ; balance stack POP HL ; ** retrieve lower pointer ; now insert 6 trailing zeros which are printed if before the decimal point ; but mark the end of printing if after decimal point. ; e.g. 9876543210123 is printed as 9876543200000 ; 123.456001 is printed as 123.456 LD B,$06 ; the count is six. ;; PF-ZERO-6 L164B: LD (HL),$80 ; insert a masked zero DEC HL ; decrease pointer. DJNZ L164B ; loop back for all six to PF-ZERO-6 ; n-mod-m reduced the number to zero and this is now deleted from the calculator ; stack before fetching the original estimate of leading digits. RST 28H ;; FP-CALC 0. DEFB $02 ;;delete . DEFB $E1 ;;get-mem-1 n. DEFB $34 ;;end-calc n. CALL L15CD ; routine FP-TO-A JR Z,L165B ; skip forward if positive to PF-POS NEG ; negate makes positive ;; PF-POS L165B: LD E,A ; transfer count of digits to E INC E ; increment twice INC E ; POP HL ; * retrieve pointer to one past buffer. ;; GET-FIRST L165F: DEC HL ; decrement address. DEC E ; decrement digit counter. LD A,(HL) ; fetch masked byte. AND $0F ; isolate right-hand nibble. JR Z,L165F ; back with leading zero to GET-FIRST ; now determine if E-format printing is needed LD A,E ; transfer now accurate number count to A. SUB $05 ; subtract five CP $08 ; compare with 8 as maximum digits is 13. JP P,L1682 ; forward if positive to PF-E-FMT CP $F6 ; test for more than four zeros after point. JP M,L1682 ; forward if so to PF-E-FMT ADD A,$06 ; test for zero leading digits, e.g. 0.5 JR Z,L16BF ; forward if so to PF-ZERO-1 JP M,L16B2 ; forward if more than one zero to PF-ZEROS ; else digits before the decimal point are to be printed LD B,A ; count of leading characters to B. ;; PF-NIB-LP L167B: CALL L16D0 ; routine PF-NIBBLE DJNZ L167B ; loop back for counted numbers to PF-NIB-LP JR L16C2 ; forward to consider decimal part to PF-DC-OUT ; --- ;; PF-E-FMT L1682: LD B,E ; count to B CALL L16D0 ; routine PF-NIBBLE prints one digit. CALL L16C2 ; routine PF-DC-OUT considers fractional part. LD A,$2A ; prepare character 'E' RST 10H ; PRINT-A LD A,B ; transfer exponent to A AND A ; test the sign. JP P,L1698 ; forward if positive to PF-E-POS NEG ; negate the negative exponent. LD B,A ; save positive exponent in B. LD A,$16 ; prepare character '-' JR L169A ; skip forward to PF-E-SIGN ; --- ;; PF-E-POS L1698: LD A,$15 ; prepare character '+' ;; PF-E-SIGN L169A: RST 10H ; PRINT-A ; now convert the integer exponent in B to two characters. ; it will be less than 99. LD A,B ; fetch positive exponent. LD B,$FF ; initialize left hand digit to minus one. ;; PF-E-TENS L169E: INC B ; increment ten count SUB $0A ; subtract ten from exponent JR NC,L169E ; loop back if greater than ten to PF-E-TENS ADD A,$0A ; reverse last subtraction LD C,A ; transfer remainder to C LD A,B ; transfer ten value to A. AND A ; test for zero. JR Z,L16AD ; skip forward if so to PF-E-LOW CALL L07EB ; routine OUT-CODE prints as digit '1' - '9' ;; PF-E-LOW L16AD: LD A,C ; low byte to A CALL L07EB ; routine OUT-CODE prints final digit of the ; exponent. RET ; return. >> ; --- ; this branch deals with zeros after decimal point. ; e.g. .01 or .0000999 ;; PF-ZEROS L16B2: NEG ; negate makes number positive 1 to 4. LD B,A ; zero count to B. LD A,$1B ; prepare character '.' RST 10H ; PRINT-A LD A,$1C ; prepare a '0' ;; PF-ZRO-LP L16BA: RST 10H ; PRINT-A DJNZ L16BA ; loop back to PF-ZRO-LP JR L16C8 ; forward to PF-FRAC-LP ; --- ; there is a need to print a leading zero e.g. 0.1 but not with .01 ;; PF-ZERO-1 L16BF: LD A,$1C ; prepare character '0'. RST 10H ; PRINT-A ; this subroutine considers the decimal point and any trailing digits. ; if the next character is a marked zero, $80, then nothing more to print. ;; PF-DC-OUT L16C2: DEC (HL) ; decrement addressed character INC (HL) ; increment it again RET PE ; return with overflow (was 128) >> ; as no fractional part ; else there is a fractional part so print the decimal point. LD A,$1B ; prepare character '.' RST 10H ; PRINT-A ; now enter a loop to print trailing digits ;; PF-FRAC-LP L16C8: DEC (HL) ; test for a marked zero. INC (HL) ; RET PE ; return when digits exhausted >> CALL L16D0 ; routine PF-NIBBLE JR L16C8 ; back for all fractional digits to PF-FRAC-LP. ; --- ; subroutine to print right-hand nibble ;; PF-NIBBLE L16D0: LD A,(HL) ; fetch addressed byte AND $0F ; mask off lower 4 bits CALL L07EB ; routine OUT-CODE DEC HL ; decrement pointer. RET ; return. ; ------------------------------- ; THE 'PREPARE TO ADD' SUBROUTINE ; ------------------------------- ; This routine is called twice to prepare each floating point number for ; addition, in situ, on the calculator stack. ; The exponent is picked up from the first byte which is then cleared to act ; as a sign byte and accept any overflow. ; If the exponent is zero then the number is zero and an early return is made. ; The now redundant sign bit of the mantissa is set and if the number is ; negative then all five bytes of the number are twos-complemented to prepare ; the number for addition. ; On the second invocation the exponent of the first number is in B. ;; PREP-ADD L16D8: LD A,(HL) ; fetch exponent. LD (HL),$00 ; make this byte zero to take any overflow and ; default to positive. AND A ; test stored exponent for zero. RET Z ; return with zero flag set if number is zero. INC HL ; point to first byte of mantissa. BIT 7,(HL) ; test the sign bit. SET 7,(HL) ; set it to its implied state. DEC HL ; set pointer to first byte again. RET Z ; return if bit indicated number is positive.>> ; if negative then all five bytes are twos complemented starting at LSB. PUSH BC ; save B register contents. LD BC,$0005 ; set BC to five. ADD HL,BC ; point to location after 5th byte. LD B,C ; set the B counter to five. LD C,A ; store original exponent in C. SCF ; set carry flag so that one is added. ; now enter a loop to twos-complement the number. ; The first of the five bytes becomes $FF to denote a negative number. ;; NEG-BYTE L16EC: DEC HL ; point to first or more significant byte. LD A,(HL) ; fetch to accumulator. CPL ; complement. ADC A,$00 ; add in initial carry or any subsequent carry. LD (HL),A ; place number back. DJNZ L16EC ; loop back five times to NEG-BYTE LD A,C ; restore the exponent to accumulator. POP BC ; restore B register contents. RET ; return. ; ---------------------------------- ; THE 'FETCH TWO NUMBERS' SUBROUTINE ; ---------------------------------- ; This routine is used by addition, multiplication and division to fetch ; the two five-byte numbers addressed by HL and DE from the calculator stack ; into the Z80 registers. ; The HL register may no longer point to the first of the two numbers. ; Since the 32-bit addition operation is accomplished using two Z80 16-bit ; instructions, it is important that the lower two bytes of each mantissa are ; in one set of registers and the other bytes all in the alternate set. ; ; In: HL = highest number, DE= lowest number ; ; : alt': : ; Out: :H,B-C:C,B: num1 ; :L,D-E:D-E: num2 ;; FETCH-TWO L16F7: PUSH HL ; save HL PUSH AF ; save A - result sign when used from division. LD C,(HL) ; INC HL ; LD B,(HL) ; LD (HL),A ; insert sign when used from multiplication. INC HL ; LD A,C ; m1 LD C,(HL) ; PUSH BC ; PUSH m2 m3 INC HL ; LD C,(HL) ; m4 INC HL ; LD B,(HL) ; m5 BC holds m5 m4 EX DE,HL ; make HL point to start of second number. LD D,A ; m1 LD E,(HL) ; PUSH DE ; PUSH m1 n1 INC HL ; LD D,(HL) ; INC HL ; LD E,(HL) ; PUSH DE ; PUSH n2 n3 EXX ; - - - - - - - POP DE ; POP n2 n3 POP HL ; POP m1 n1 POP BC ; POP m2 m3 EXX ; - - - - - - - INC HL ; LD D,(HL) ; INC HL ; LD E,(HL) ; DE holds n4 n5 POP AF ; restore saved POP HL ; registers. RET ; return. ; ----------------------------- ; THE 'SHIFT ADDEND' SUBROUTINE ; ----------------------------- ; The accumulator A contains the difference between the two exponents. ; This is the lowest of the two numbers to be added ;; SHIFT-FP L171A: AND A ; test difference between exponents. RET Z ; return if zero. both normal. CP $21 ; compare with 33 bits. JR NC,L1736 ; forward if greater than 32 to ADDEND-0 PUSH BC ; preserve BC - part LD B,A ; shift counter to B. ; Now perform B right shifts on the addend L'D'E'D E ; to bring it into line with the augend H'B'C'C B ;; ONE-SHIFT L1722: EXX ; - - - SRA L ; 76543210->C bit 7 unchanged. RR D ; C->76543210->C RR E ; C->76543210->C EXX ; - - - RR D ; C->76543210->C RR E ; C->76543210->C DJNZ L1722 ; loop back B times to ONE-SHIFT POP BC ; restore BC RET NC ; return if last shift produced no carry. >> ; if carry flag was set then accuracy is being lost so round up the addend. CALL L1741 ; routine ADD-BACK RET NZ ; return if not FF 00 00 00 00 ; this branch makes all five bytes of the addend zero and is made during ; addition when the exponents are too far apart for the addend bits to ; affect the result. ;; ADDEND-0 L1736: EXX ; select alternate set for more significant ; bytes. XOR A ; clear accumulator. ; this entry point (from multiplication) sets four of the bytes to zero or if ; continuing from above, during addition, then all five bytes are set to zero. ;; ZEROS-4/5 L1738: LD L,$00 ; set byte 1 to zero. LD D,A ; set byte 2 to A. LD E,L ; set byte 3 to zero. EXX ; select main set LD DE,$0000 ; set lower bytes 4 and 5 to zero. RET ; return. ; ------------------------- ; THE 'ADD-BACK' SUBROUTINE ; ------------------------- ; Called from SHIFT-FP above during addition and after normalization from ; multiplication. ; This is really a 32-bit increment routine which sets the zero flag according ; to the 32-bit result. ; During addition, only negative numbers like FF FF FF FF FF, ; the twos-complement version of xx 80 00 00 01 say ; will result in a full ripple FF 00 00 00 00. ; FF FF FF FF FF when shifted right is unchanged by SHIFT-FP but sets the ; carry invoking this routine. ;; ADD-BACK L1741: INC E ; RET NZ ; INC D ; RET NZ ; EXX ; INC E ; JR NZ,L174A ; forward if no overflow to ALL-ADDED INC D ; ;; ALL-ADDED L174A: EXX ; RET ; return with zero flag set for zero mantissa. ; --------------------------- ; THE 'SUBTRACTION' OPERATION ; --------------------------- ; just switch the sign of subtrahend and do an add. ;; subtract L174C: LD A,(DE) ; fetch exponent byte of second number the ; subtrahend. AND A ; test for zero RET Z ; return if zero - first number is result. INC DE ; address the first mantissa byte. LD A,(DE) ; fetch to accumulator. XOR $80 ; toggle the sign bit. LD (DE),A ; place back on calculator stack. DEC DE ; point to exponent byte. ; continue into addition routine. ; ------------------------ ; THE 'ADDITION' OPERATION ; ------------------------ ; The addition operation pulls out all the stops and uses most of the Z80's ; registers to add two floating-point numbers. ; This is a binary operation and on entry, HL points to the first number ; and DE to the second. ;; addition L1755: EXX ; - - - PUSH HL ; save the pointer to the next literal. EXX ; - - - PUSH DE ; save pointer to second number PUSH HL ; save pointer to first number - will be the ; result pointer on calculator stack. CALL L16D8 ; routine PREP-ADD LD B,A ; save first exponent byte in B. EX DE,HL ; switch number pointers. CALL L16D8 ; routine PREP-ADD LD C,A ; save second exponent byte in C. CP B ; compare the exponent bytes. JR NC,L1769 ; forward if second higher to SHIFT-LEN LD A,B ; else higher exponent to A LD B,C ; lower exponent to B EX DE,HL ; switch the number pointers. ;; SHIFT-LEN L1769: PUSH AF ; save higher exponent SUB B ; subtract lower exponent CALL L16F7 ; routine FETCH-TWO CALL L171A ; routine SHIFT-FP POP AF ; restore higher exponent. POP HL ; restore result pointer. LD (HL),A ; insert exponent byte. PUSH HL ; save result pointer again. ; now perform the 32-bit addition using two 16-bit Z80 add instructions. LD L,B ; transfer low bytes of mantissa individually LD H,C ; to HL register ADD HL,DE ; the actual binary addition of lower bytes ; now the two higher byte pairs that are in the alternate register sets. EXX ; switch in set EX DE,HL ; transfer high mantissa bytes to HL register. ADC HL,BC ; the actual addition of higher bytes with ; any carry from first stage. EX DE,HL ; result in DE, sign bytes ($FF or $00) to HL ; now consider the two sign bytes LD A,H ; fetch sign byte of num1 ADC A,L ; add including any carry from mantissa ; addition. 00 or 01 or FE or FF LD L,A ; result in L. ; possible outcomes of signs and overflow from mantissa are ; ; H + L + carry = L RRA XOR L RRA ; ------------------------------------------------------------ ; 00 + 00 = 00 00 00 ; 00 + 00 + carry = 01 00 01 carry ; FF + FF = FE C FF 01 carry ; FF + FF + carry = FF C FF 00 ; FF + 00 = FF FF 00 ; FF + 00 + carry = 00 C 80 80 RRA ; C->76543210->C XOR L ; set bit 0 if shifting required. EXX ; switch back to main set EX DE,HL ; full mantissa result now in D'E'D E registers. POP HL ; restore pointer to result exponent on ; the calculator stack. RRA ; has overflow occurred ? JR NC,L1790 ; skip forward if not to TEST-NEG ; if the addition of two positive mantissas produced overflow or if the ; addition of two negative mantissas did not then the result exponent has to ; be incremented and the mantissa shifted one place to the right. LD A,$01 ; one shift required. CALL L171A ; routine SHIFT-FP performs a single shift ; rounding any lost bit INC (HL) ; increment the exponent. JR Z,L17B3 ; forward to ADD-REP-6 if the exponent ; wraps round from FF to zero as number is too ; big for the system. ; at this stage the exponent on the calculator stack is correct. ;; TEST-NEG L1790: EXX ; switch in the alternate set. LD A,L ; load result sign to accumulator. AND $80 ; isolate bit 7 from sign byte setting zero ; flag if positive. EXX ; back to main set. INC HL ; point to first byte of mantissa LD (HL),A ; insert $00 positive or $80 negative at ; position on calculator stack. DEC HL ; point to exponent again. JR Z,L17B9 ; forward if positive to GO-NC-MLT ; a negative number has to be twos-complemented before being placed on stack. LD A,E ; fetch lowest (rightmost) mantissa byte. NEG ; Negate CCF ; Complement Carry Flag LD E,A ; place back in register LD A,D ; ditto CPL ; ADC A,$00 ; LD D,A ; EXX ; switch to higher (leftmost) 16 bits. LD A,E ; ditto CPL ; ADC A,$00 ; LD E,A ; LD A,D ; ditto CPL ; ADC A,$00 ; JR NC,L17B7 ; forward without overflow to END-COMPL ; else entire mantissa is now zero. 00 00 00 00 RRA ; set mantissa to 80 00 00 00 EXX ; switch. INC (HL) ; increment the exponent. ;; ADD-REP-6 L17B3: JP Z,L1880 ; jump forward if exponent now zero to REPORT-6 ; 'Number too big' EXX ; switch back to alternate set. ;; END-COMPL L17B7: LD D,A ; put first byte of mantissa back in DE. EXX ; switch to main set. ;; GO-NC-MLT L17B9: XOR A ; clear carry flag and ; clear accumulator so no extra bits carried ; forward as occurs in multiplication. JR L1828 ; forward to common code at TEST-NORM ; but should go straight to NORMALIZE. ; ---------------------------------------------- ; THE 'PREPARE TO MULTIPLY OR DIVIDE' SUBROUTINE ; ---------------------------------------------- ; this routine is called twice from multiplication and twice from division ; to prepare each of the two numbers for the operation. ; Initially the accumulator holds zero and after the second invocation bit 7 ; of the accumulator will be the sign bit of the result. ;; PREP-M/D L17BC: SCF ; set carry flag to signal number is zero. DEC (HL) ; test exponent INC (HL) ; for zero. RET Z ; return if zero with carry flag set. INC HL ; address first mantissa byte. XOR (HL) ; exclusive or the running sign bit. SET 7,(HL) ; set the implied bit. DEC HL ; point to exponent byte. RET ; return. ; ------------------------------ ; THE 'MULTIPLICATION' OPERATION ; ------------------------------ ; ; ;; multiply L17C6: XOR A ; reset bit 7 of running sign flag. CALL L17BC ; routine PREP-M/D RET C ; return if number is zero. ; zero * anything = zero. EXX ; - - - PUSH HL ; save pointer to 'next literal' EXX ; - - - PUSH DE ; save pointer to second number EX DE,HL ; make HL address second number. CALL L17BC ; routine PREP-M/D EX DE,HL ; HL first number, DE - second number JR C,L1830 ; forward with carry to ZERO-RSLT ; anything * zero = zero. PUSH HL ; save pointer to first number. CALL L16F7 ; routine FETCH-TWO fetches two mantissas from ; calc stack to B'C'C,B D'E'D E ; (HL will be overwritten but the result sign ; in A is inserted on the calculator stack) LD A,B ; transfer low mantissa byte of first number AND A ; clear carry. SBC HL,HL ; a short form of LD HL,$0000 to take lower ; two bytes of result. (2 program bytes) EXX ; switch in alternate set PUSH HL ; preserve HL SBC HL,HL ; set HL to zero also to take higher two bytes ; of the result and clear carry. EXX ; switch back. LD B,$21 ; register B can now be used to count thirty ; three shifts. JR L17F8 ; forward to loop entry point STRT-MLT ; --- ; The multiplication loop is entered at STRT-LOOP. ;; MLT-LOOP L17E7: JR NC,L17EE ; forward if no carry to NO-ADD ; else add in the multiplicand. ADD HL,DE ; add the two low bytes to result EXX ; switch to more significant bytes. ADC HL,DE ; add high bytes of multiplicand and any carry. EXX ; switch to main set. ; in either case shift result right into B'C'C A ;; NO-ADD L17EE: EXX ; switch to alternate set RR H ; C > 76543210 > C RR L ; C > 76543210 > C EXX ; RR H ; C > 76543210 > C RR L ; C > 76543210 > C ;; STRT-MLT L17F8: EXX ; switch in alternate set. RR B ; C > 76543210 > C RR C ; C > 76543210 > C EXX ; now main set RR C ; C > 76543210 > C RRA ; C > 76543210 > C DJNZ L17E7 ; loop back 33 times to MLT-LOOP ; EX DE,HL ; EXX ; EX DE,HL ; EXX ; POP BC ; POP HL ; LD A,B ; ADD A,C ; JR NZ,L180E ; forward to MAKE-EXPT AND A ; ;; MAKE-EXPT L180E: DEC A ; CCF ; Complement Carry Flag ;; DIVN-EXPT L1810: RLA ; CCF ; Complement Carry Flag RRA ; JP P,L1819 ; forward to OFLW1-CLR JR NC,L1880 ; forward to REPORT-6 AND A ; ;; OFLW1-CLR L1819: INC A ; JR NZ,L1824 ; forward to OFLW2-CLR JR C,L1824 ; forward to OFLW2-CLR EXX ; BIT 7,D ; EXX ; JR NZ,L1880 ; forward to REPORT-6 ;; OFLW2-CLR L1824: LD (HL),A ; EXX ; LD A,B ; EXX ; ; addition joins here with carry flag clear. ;; TEST-NORM L1828: JR NC,L183F ; forward to NORMALIZE LD A,(HL) ; AND A ; ;; NEAR-ZERO L182C: LD A,$80 ; prepare to rescue the most significant bit ; of the mantissa if it is set. JR Z,L1831 ; skip forward to SKIP-ZERO ;; ZERO-RSLT L1830: XOR A ; make mask byte zero signaling set five ; bytes to zero. ;; SKIP-ZERO L1831: EXX ; switch in alternate set AND D ; isolate most significant bit (if A is $80). CALL L1738 ; routine ZEROS-4/5 sets mantissa without ; affecting any flags. RLCA ; test if MSB set. bit 7 goes to bit 0. ; either $00 -> $00 or $80 -> $01 LD (HL),A ; make exponent $01 (lowest) or $00 zero JR C,L1868 ; forward if first case to OFLOW-CLR INC HL ; address first mantissa byte on the ; calculator stack. LD (HL),A ; insert a zero for the sign bit. DEC HL ; point to zero exponent JR L1868 ; forward to OFLOW-CLR ; --- ; this branch is common to addition and multiplication with the mantissa ; result still in registers D'E'D E . ;; NORMALIZE L183F: LD B,$20 ; a maximum of thirty-two left shifts will be ; needed. ;; SHIFT-ONE L1841: EXX ; address higher 16 bits. BIT 7,D ; test the leftmost bit EXX ; address lower 16 bits. JR NZ,L1859 ; forward if leftmost bit was set to NORML-NOW RLCA ; this holds zero from addition, 33rd bit ; from multiplication. RL E ; C < 76543210 < C RL D ; C < 76543210 < C EXX ; address higher 16 bits. RL E ; C < 76543210 < C RL D ; C < 76543210 < C EXX ; switch to main set. DEC (HL) ; decrement the exponent byte on the calculator ; stack. JR Z,L182C ; back if exponent becomes zero to NEAR-ZERO ; it's just possible that the last rotation ; set bit 7 of D. We shall see. DJNZ L1841 ; loop back to SHIFT-ONE ; if thirty-two left shifts were performed without setting the most significant ; bit then the result is zero. JR L1830 ; back to ZERO-RSLT ; --- ;; NORML-NOW L1859: RLA ; for the addition path, A is always zero. ; for the mult path, ... JR NC,L1868 ; forward to OFLOW-CLR ; this branch is taken only with multiplication. CALL L1741 ; routine ADD-BACK JR NZ,L1868 ; forward to OFLOW-CLR EXX ; LD D,$80 ; EXX ; INC (HL) ; JR Z,L1880 ; forward to REPORT-6 ; now transfer the mantissa from the register sets to the calculator stack ; incorporating the sign bit already there. ;; OFLOW-CLR L1868: PUSH HL ; save pointer to exponent on stack. INC HL ; address first byte of mantissa which was ; previously loaded with sign bit $00 or $80. EXX ; - - - PUSH DE ; push the most significant two bytes. EXX ; - - - POP BC ; pop - true mantissa is now BCDE. ; now pick up the sign bit. LD A,B ; first mantissa byte to A RLA ; rotate out bit 7 which is set RL (HL) ; rotate sign bit on stack into carry. RRA ; rotate sign bit into bit 7 of mantissa. ; and transfer mantissa from main registers to calculator stack. LD (HL),A ; INC HL ; LD (HL),C ; INC HL ; LD (HL),D ; INC HL ; LD (HL),E ; POP HL ; restore pointer to num1 now result. POP DE ; restore pointer to num2 now STKEND. EXX ; - - - POP HL ; restore pointer to next calculator literal. EXX ; - - - RET ; return. ; --- ;; REPORT-6 L1880: RST 08H ; ERROR-1 DEFB $05 ; Error Report: Arithmetic overflow. ; ------------------------ ; THE 'DIVISION' OPERATION ; ------------------------ ; "Of all the arithmetic subroutines, division is the most complicated and ; the least understood. It is particularly interesting to note that the ; Sinclair programmer himself has made a mistake in his programming ( or has ; copied over someone else's mistake!) for ; PRINT PEEK 6352 [ $18D0 ] ('unimproved' ROM, 6351 [ $18CF ] ) ; should give 218 not 225." ; - Dr. Ian Logan, Syntax magazine Jul/Aug 1982. ; [ i.e. the jump should be made to div-34th ] ; First check for division by zero. ;; division L1882: EX DE,HL ; consider the second number first. XOR A ; set the running sign flag. CALL L17BC ; routine PREP-M/D JR C,L1880 ; back if zero to REPORT-6 ; 'Arithmetic overflow' EX DE,HL ; now prepare first number and check for zero. CALL L17BC ; routine PREP-M/D RET C ; return if zero, 0/anything is zero. EXX ; - - - PUSH HL ; save pointer to the next calculator literal. EXX ; - - - PUSH DE ; save pointer to divisor - will be STKEND. PUSH HL ; save pointer to dividend - will be result. CALL L16F7 ; routine FETCH-TWO fetches the two numbers ; into the registers H'B'C'C B ; L'D'E'D E EXX ; - - - PUSH HL ; save the two exponents. LD H,B ; transfer the dividend to H'L'H L LD L,C ; EXX ; LD H,C ; LD L,B ; XOR A ; clear carry bit and accumulator. LD B,$DF ; count upwards from -33 decimal JR L18B2 ; forward to mid-loop entry point DIV-START ; --- ;; DIV-LOOP L18A2: RLA ; multiply partial quotient by two RL C ; setting result bit from carry. EXX ; RL C ; RL B ; EXX ; ;; div-34th L18AB: ADD HL,HL ; EXX ; ADC HL,HL ; EXX ; JR C,L18C2 ; forward to SUBN-ONLY ;; DIV-START L18B2: SBC HL,DE ; subtract divisor part. EXX ; SBC HL,DE ; EXX ; JR NC,L18C9 ; forward if subtraction goes to NO-RSTORE ADD HL,DE ; else restore EXX ; ADC HL,DE ; EXX ; AND A ; clear carry JR L18CA ; forward to COUNT-ONE ; --- ;; SUBN-ONLY L18C2: AND A ; SBC HL,DE ; EXX ; SBC HL,DE ; EXX ; ;; NO-RSTORE L18C9: SCF ; set carry flag ;; COUNT-ONE L18CA: INC B ; increment the counter JP M,L18A2 ; back while still minus to DIV-LOOP PUSH AF ; JR Z,L18B2 ; back to DIV-START ; "This jump is made to the wrong place. No 34th bit will ever be obtained ; without first shifting the dividend. Hence important results like 1/10 and ; 1/1000 are not rounded up as they should be. Rounding up never occurs when ; it depends on the 34th bit. The jump should be made to div-34th above." ; - Dr. Frank O'Hara, "The Complete Spectrum ROM Disassembly", 1983, ; published by Melbourne House. ; (Note. on the ZX81 this would be JR Z,L18AB) ; ; However if you make this change, then while (1/2=.5) will now evaluate as ; true, (.25=1/4), which did evaluate as true, no longer does. LD E,A ; LD D,C ; EXX ; LD E,C ; LD D,B ; POP AF ; RR B ; POP AF ; RR B ; EXX ; POP BC ; POP HL ; LD A,B ; SUB C ; JP L1810 ; jump back to DIVN-EXPT ; ------------------------------------------------ ; THE 'INTEGER TRUNCATION TOWARDS ZERO' SUBROUTINE ; ------------------------------------------------ ; ;; truncate L18E4: LD A,(HL) ; fetch exponent CP $81 ; compare to +1 JR NC,L18EF ; forward, if 1 or more, to T-GR-ZERO ; else the number is smaller than plus or minus 1 and can be made zero. LD (HL),$00 ; make exponent zero. LD A,$20 ; prepare to set 32 bits of mantissa to zero. JR L18F4 ; forward to NIL-BYTES ; --- ;; T-GR-ZERO L18EF: SUB $A0 ; subtract +32 from exponent RET P ; return if result is positive as all 32 bits ; of the mantissa relate to the integer part. ; The floating point is somewhere to the right ; of the mantissa NEG ; else negate to form number of rightmost bits ; to be blanked. ; for instance, disregarding the sign bit, the number 3.5 is held as ; exponent $82 mantissa .11100000 00000000 00000000 00000000 ; we need to set $82 - $A0 = $E2 NEG = $1E (thirty) bits to zero to form the ; integer. ; The sign of the number is never considered as the first bit of the mantissa ; must be part of the integer. ;; NIL-BYTES L18F4: PUSH DE ; save pointer to STKEND EX DE,HL ; HL points at STKEND DEC HL ; now at last byte of mantissa. LD B,A ; Transfer bit count to B register. SRL B ; divide by SRL B ; eight SRL B ; JR Z,L1905 ; forward if zero to BITS-ZERO ; else the original count was eight or more and whole bytes can be blanked. ;; BYTE-ZERO L1900: LD (HL),$00 ; set eight bits to zero. DEC HL ; point to more significant byte of mantissa. DJNZ L1900 ; loop back to BYTE-ZERO ; now consider any residual bits. ;; BITS-ZERO L1905: AND $07 ; isolate the remaining bits JR Z,L1912 ; forward if none to IX-END LD B,A ; transfer bit count to B counter. LD A,$FF ; form a mask 11111111 ;; LESS-MASK L190C: SLA A ; 1 <- 76543210 <- o slide mask leftwards. DJNZ L190C ; loop back for bit count to LESS-MASK AND (HL) ; lose the unwanted rightmost bits LD (HL),A ; and place in mantissa byte. ;; IX-END L1912: EX DE,HL ; restore result pointer from DE. POP DE ; restore STKEND from stack. RET ; return. ;******************************** ;** FLOATING-POINT CALCULATOR ** ;******************************** ; As a general rule the calculator avoids using the IY register. ; Exceptions are val and str$. ; So an assembly language programmer who has disabled interrupts to use IY ; for other purposes can still use the calculator for mathematical ; purposes. ; ------------------------ ; THE 'TABLE OF CONSTANTS' ; ------------------------ ; The ZX81 has only floating-point number representation. ; Both the ZX80 and the ZX Spectrum have integer numbers in some form. ;; stk-zero 00 00 00 00 00 L1915: DEFB $00 ;;Bytes: 1 DEFB $B0 ;;Exponent $00 DEFB $00 ;;(+00,+00,+00) ;; stk-one 81 00 00 00 00 L1918: DEFB $31 ;;Exponent $81, Bytes: 1 DEFB $00 ;;(+00,+00,+00) ;; stk-half 80 00 00 00 00 L191A: DEFB $30 ;;Exponent: $80, Bytes: 1 DEFB $00 ;;(+00,+00,+00) ;; stk-pi/2 81 49 0F DA A2 L191C: DEFB $F1 ;;Exponent: $81, Bytes: 4 DEFB $49,$0F,$DA,$A2 ;; ;; stk-ten 84 20 00 00 00 L1921: DEFB $34 ;;Exponent: $84, Bytes: 1 DEFB $20 ;;(+00,+00,+00) ; ------------------------ ; THE 'TABLE OF ADDRESSES' ; ------------------------ ; ; starts with binary operations which have two operands and one result. ; three pseudo binary operations first. ;; tbl-addrs L1923: DEFW L1C2F ; $00 Address: $1C2F - jump-true DEFW L1A72 ; $01 Address: $1A72 - exchange DEFW L19E3 ; $02 Address: $19E3 - delete ; true binary operations. DEFW L174C ; $03 Address: $174C - subtract DEFW L17C6 ; $04 Address: $176C - multiply DEFW L1882 ; $05 Address: $1882 - division DEFW L1DE2 ; $06 Address: $1DE2 - to-power DEFW L1AED ; $07 Address: $1AED - or DEFW L1AF3 ; $08 Address: $1B03 - no-&-no DEFW L1B03 ; $09 Address: $1B03 - no-l-eql DEFW L1B03 ; $0A Address: $1B03 - no-gr-eql DEFW L1B03 ; $0B Address: $1B03 - nos-neql DEFW L1B03 ; $0C Address: $1B03 - no-grtr DEFW L1B03 ; $0D Address: $1B03 - no-less DEFW L1B03 ; $0E Address: $1B03 - nos-eql DEFW L1755 ; $0F Address: $1755 - addition DEFW L1AF8 ; $10 Address: $1AF8 - str-&-no DEFW L1B03 ; $11 Address: $1B03 - str-l-eql DEFW L1B03 ; $12 Address: $1B03 - str-gr-eql DEFW L1B03 ; $13 Address: $1B03 - strs-neql DEFW L1B03 ; $14 Address: $1B03 - str-grtr DEFW L1B03 ; $15 Address: $1B03 - str-less DEFW L1B03 ; $16 Address: $1B03 - strs-eql DEFW L1B62 ; $17 Address: $1B62 - strs-add ; unary follow DEFW L1AA0 ; $18 Address: $1AA0 - neg DEFW L1C06 ; $19 Address: $1C06 - code DEFW L1BA4 ; $1A Address: $1BA4 - val DEFW L1C11 ; $1B Address: $1C11 - len DEFW L1D49 ; $1C Address: $1D49 - sin DEFW L1D3E ; $1D Address: $1D3E - cos DEFW L1D6E ; $1E Address: $1D6E - tan DEFW L1DC4 ; $1F Address: $1DC4 - asn DEFW L1DD4 ; $20 Address: $1DD4 - acs DEFW L1D76 ; $21 Address: $1D76 - atn DEFW L1CA9 ; $22 Address: $1CA9 - ln DEFW L1C5B ; $23 Address: $1C5B - exp DEFW L1C46 ; $24 Address: $1C46 - int DEFW L1DDB ; $25 Address: $1DDB - sqr DEFW L1AAF ; $26 Address: $1AAF - sgn DEFW L1AAA ; $27 Address: $1AAA - abs DEFW L1ABE ; $28 Address: $1A1B - peek DEFW L1AC5 ; $29 Address: $1AC5 - usr-no DEFW L1BD5 ; $2A Address: $1BD5 - str$ DEFW L1B8F ; $2B Address: $1B8F - chrs DEFW L1AD5 ; $2C Address: $1AD5 - not ; end of true unary DEFW L19F6 ; $2D Address: $19F6 - duplicate DEFW L1C37 ; $2E Address: $1C37 - n-mod-m DEFW L1C23 ; $2F Address: $1C23 - jump DEFW L19FC ; $30 Address: $19FC - stk-data DEFW L1C17 ; $31 Address: $1C17 - dec-jr-nz DEFW L1ADB ; $32 Address: $1ADB - less-0 DEFW L1ACE ; $33 Address: $1ACE - greater-0 DEFW L002B ; $34 Address: $002B - end-calc DEFW L1D18 ; $35 Address: $1D18 - get-argt DEFW L18E4 ; $36 Address: $18E4 - truncate DEFW L19E4 ; $37 Address: $19E4 - fp-calc-2 DEFW L155A ; $38 Address: $155A - e-to-fp ; the following are just the next available slots for the 128 compound literals ; which are in range $80 - $FF. DEFW L1A7F ; $39 Address: $1A7F - series-xx $80 - $9F. DEFW L1A51 ; $3A Address: $1A51 - stk-const-xx $A0 - $BF. DEFW L1A63 ; $3B Address: $1A63 - st-mem-xx $C0 - $DF. DEFW L1A45 ; $3C Address: $1A45 - get-mem-xx $E0 - $FF. ; Aside: 3D - 7F are therefore unused calculator literals. ; 39 - 7B would be available for expansion. ; ------------------------------- ; THE 'FLOATING POINT CALCULATOR' ; ------------------------------- ; ; ;; CALCULATE L199D: CALL L1B85 ; routine STK-PNTRS is called to set up the ; calculator stack pointers for a default ; unary operation. HL = last value on stack. ; DE = STKEND first location after stack. ; the calculate routine is called at this point by the series generator... ;; GEN-ENT-1 L19A0: LD A,B ; fetch the Z80 B register to A LD ($401E),A ; and store value in system variable BREG. ; this will be the counter for dec-jr-nz ; or if used from fp-calc2 the calculator ; instruction. ; ... and again later at this point ;; GEN-ENT-2 L19A4: EXX ; switch sets EX (SP),HL ; and store the address of next instruction, ; the return address, in H'L'. ; If this is a recursive call then the H'L' ; of the previous invocation goes on stack. ; c.f. end-calc. EXX ; switch back to main set. ; this is the re-entry looping point when handling a string of literals. ;; RE-ENTRY L19A7: LD ($401C),DE ; save end of stack in system variable STKEND EXX ; switch to alt LD A,(HL) ; get next literal INC HL ; increase pointer' ; single operation jumps back to here ;; SCAN-ENT L19AE: PUSH HL ; save pointer on stack * AND A ; now test the literal JP P,L19C2 ; forward to FIRST-3D if in range $00 - $3D ; anything with bit 7 set will be one of ; 128 compound literals. ; compound literals have the following format. ; bit 7 set indicates compound. ; bits 6-5 the subgroup 0-3. ; bits 4-0 the embedded parameter $00 - $1F. ; The subgroup 0-3 needs to be manipulated to form the next available four ; address places after the simple literals in the address table. LD D,A ; save literal in D AND $60 ; and with 01100000 to isolate subgroup RRCA ; rotate bits RRCA ; 4 places to right RRCA ; not five as we need offset * 2 RRCA ; 00000xx0 ADD A,$72 ; add ($39 * 2) to give correct offset. ; alter above if you add more literals. LD L,A ; store in L for later indexing. LD A,D ; bring back compound literal AND $1F ; use mask to isolate parameter bits JR L19D0 ; forward to ENT-TABLE ; --- ; the branch was here with simple literals. ;; FIRST-3D L19C2: CP $18 ; compare with first unary operations. JR NC,L19CE ; to DOUBLE-A with unary operations ; it is binary so adjust pointers. EXX ; LD BC,$FFFB ; the value -5 LD D,H ; transfer HL, the last value, to DE. LD E,L ; ADD HL,BC ; subtract 5 making HL point to second ; value. EXX ; ;; DOUBLE-A L19CE: RLCA ; double the literal LD L,A ; and store in L for indexing ;; ENT-TABLE L19D0: LD DE,L1923 ; Address: tbl-addrs LD H,$00 ; prepare to index ADD HL,DE ; add to get address of routine LD E,(HL) ; low byte to E INC HL ; LD D,(HL) ; high byte to D LD HL,L19A7 ; Address: RE-ENTRY EX (SP),HL ; goes on machine stack ; address of next literal goes to HL. * PUSH DE ; now the address of routine is stacked. EXX ; back to main set ; avoid using IY register. LD BC,($401D) ; STKEND_hi ; nothing much goes to C but BREG to B ; and continue into next ret instruction ; which has a dual identity ; ----------------------- ; THE 'DELETE' SUBROUTINE ; ----------------------- ; offset $02: 'delete' ; A simple return but when used as a calculator literal this ; deletes the last value from the calculator stack. ; On entry, as always with binary operations, ; HL=first number, DE=second number ; On exit, HL=result, DE=stkend. ; So nothing to do ;; delete L19E3: RET ; return - indirect jump if from above. ; --------------------------------- ; THE 'SINGLE OPERATION' SUBROUTINE ; --------------------------------- ; offset $37: 'fp-calc-2' ; this single operation is used, in the first instance, to evaluate most ; of the mathematical and string functions found in BASIC expressions. ;; fp-calc-2 L19E4: POP AF ; drop return address. LD A,($401E) ; load accumulator from system variable BREG ; value will be literal eg. 'tan' EXX ; switch to alt JR L19AE ; back to SCAN-ENT ; next literal will be end-calc in scanning ; ------------------------------ ; THE 'TEST 5 SPACES' SUBROUTINE ; ------------------------------ ; This routine is called from MOVE-FP, STK-CONST and STK-STORE to ; test that there is enough space between the calculator stack and the ; machine stack for another five-byte value. It returns with BC holding ; the value 5 ready for any subsequent LDIR. ;; TEST-5-SP L19EB: PUSH DE ; save PUSH HL ; registers LD BC,$0005 ; an overhead of five bytes CALL L0EC5 ; routine TEST-ROOM tests free RAM raising ; an error if not. POP HL ; else restore POP DE ; registers. RET ; return with BC set at 5. ; --------------------------------------------- ; THE 'MOVE A FLOATING POINT NUMBER' SUBROUTINE ; --------------------------------------------- ; offset $2D: 'duplicate' ; This simple routine is a 5-byte LDIR instruction ; that incorporates a memory check. ; When used as a calculator literal it duplicates the last value on the ; calculator stack. ; Unary so on entry HL points to last value, DE to stkend ;; duplicate ;; MOVE-FP L19F6: CALL L19EB ; routine TEST-5-SP test free memory ; and sets BC to 5. LDIR ; copy the five bytes. RET ; return with DE addressing new STKEND ; and HL addressing new last value. ; ------------------------------- ; THE 'STACK LITERALS' SUBROUTINE ; ------------------------------- ; offset $30: 'stk-data' ; When a calculator subroutine needs to put a value on the calculator ; stack that is not a regular constant this routine is called with a ; variable number of following data bytes that convey to the routine ; the floating point form as succinctly as is possible. ;; stk-data L19FC: LD H,D ; transfer STKEND LD L,E ; to HL for result. ;; STK-CONST L19FE: CALL L19EB ; routine TEST-5-SP tests that room exists ; and sets BC to $05. EXX ; switch to alternate set PUSH HL ; save the pointer to next literal on stack EXX ; switch back to main set EX (SP),HL ; pointer to HL, destination to stack. PUSH BC ; save BC - value 5 from test room ??. LD A,(HL) ; fetch the byte following 'stk-data' AND $C0 ; isolate bits 7 and 6 RLCA ; rotate RLCA ; to bits 1 and 0 range $00 - $03. LD C,A ; transfer to C INC C ; and increment to give number of bytes ; to read. $01 - $04 LD A,(HL) ; reload the first byte AND $3F ; mask off to give possible exponent. JR NZ,L1A14 ; forward to FORM-EXP if it was possible to ; include the exponent. ; else byte is just a byte count and exponent comes next. INC HL ; address next byte and LD A,(HL) ; pick up the exponent ( - $50). ;; FORM-EXP L1A14: ADD A,$50 ; now add $50 to form actual exponent LD (DE),A ; and load into first destination byte. LD A,$05 ; load accumulator with $05 and SUB C ; subtract C to give count of trailing ; zeros plus one. INC HL ; increment source INC DE ; increment destination LD B,$00 ; prepare to copy LDIR ; copy C bytes POP BC ; restore 5 counter to BC ??. EX (SP),HL ; put HL on stack as next literal pointer ; and the stack value - result pointer - ; to HL. EXX ; switch to alternate set. POP HL ; restore next literal pointer from stack ; to H'L'. EXX ; switch back to main set. LD B,A ; zero count to B XOR A ; clear accumulator ;; STK-ZEROS L1A27: DEC B ; decrement B counter RET Z ; return if zero. >> ; DE points to new STKEND ; HL to new number. LD (DE),A ; else load zero to destination INC DE ; increase destination JR L1A27 ; loop back to STK-ZEROS until done. ; ------------------------------- ; THE 'SKIP CONSTANTS' SUBROUTINE ; ------------------------------- ; This routine traverses variable-length entries in the table of constants, ; stacking intermediate, unwanted constants onto a dummy calculator stack, ; in the first five bytes of the ZX81 ROM. ;; SKIP-CONS L1A2D: AND A ; test if initially zero. ;; SKIP-NEXT L1A2E: RET Z ; return if zero. >> PUSH AF ; save count. PUSH DE ; and normal STKEND LD DE,$0000 ; dummy value for STKEND at start of ROM ; Note. not a fault but this has to be ; moved elsewhere when running in RAM. ; CALL L19FE ; routine STK-CONST works through variable ; length records. POP DE ; restore real STKEND POP AF ; restore count DEC A ; decrease JR L1A2E ; loop back to SKIP-NEXT ; -------------------------------- ; THE 'MEMORY LOCATION' SUBROUTINE ; -------------------------------- ; This routine, when supplied with a base address in HL and an index in A, ; will calculate the address of the A'th entry, where each entry occupies ; five bytes. It is used for addressing floating-point numbers in the ; calculator's memory area. ;; LOC-MEM L1A3C: LD C,A ; store the original number $00-$1F. RLCA ; double. RLCA ; quadruple. ADD A,C ; now add original value to multiply by five. LD C,A ; place the result in C. LD B,$00 ; set B to 0. ADD HL,BC ; add to form address of start of number in HL. RET ; return. ; ------------------------------------- ; THE 'GET FROM MEMORY AREA' SUBROUTINE ; ------------------------------------- ; offsets $E0 to $FF: 'get-mem-0', 'get-mem-1' etc. ; A holds $00-$1F offset. ; The calculator stack increases by 5 bytes. ;; get-mem-xx L1A45: PUSH DE ; save STKEND LD HL,($401F) ; MEM is base address of the memory cells. CALL L1A3C ; routine LOC-MEM so that HL = first byte CALL L19F6 ; routine MOVE-FP moves 5 bytes with memory ; check. ; DE now points to new STKEND. POP HL ; the original STKEND is now RESULT pointer. RET ; return. ; --------------------------------- ; THE 'STACK A CONSTANT' SUBROUTINE ; --------------------------------- ; offset $A0: 'stk-zero' ; offset $A1: 'stk-one' ; offset $A2: 'stk-half' ; offset $A3: 'stk-pi/2' ; offset $A4: 'stk-ten' ; This routine allows a one-byte instruction to stack up to 32 constants ; held in short form in a table of constants. In fact only 5 constants are ; required. On entry the A register holds the literal ANDed with $1F. ; It isn't very efficient and it would have been better to hold the ; numbers in full, five byte form and stack them in a similar manner ; to that which would be used later for semi-tone table values. ;; stk-const-xx L1A51: LD H,D ; save STKEND - required for result LD L,E ; EXX ; swap PUSH HL ; save pointer to next literal LD HL,L1915 ; Address: stk-zero - start of table of ; constants EXX ; CALL L1A2D ; routine SKIP-CONS CALL L19FE ; routine STK-CONST EXX ; POP HL ; restore pointer to next literal. EXX ; RET ; return. ; --------------------------------------- ; THE 'STORE IN A MEMORY AREA' SUBROUTINE ; --------------------------------------- ; Offsets $C0 to $DF: 'st-mem-0', 'st-mem-1' etc. ; Although 32 memory storage locations can be addressed, only six ; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5) ; required for these are allocated. ZX81 programmers who wish to ; use the floating point routines from assembly language may wish to ; alter the system variable MEM to point to 160 bytes of RAM to have ; use the full range available. ; A holds derived offset $00-$1F. ; Unary so on entry HL points to last value, DE to STKEND. ;; st-mem-xx L1A63: PUSH HL ; save the result pointer. EX DE,HL ; transfer to DE. LD HL,($401F) ; fetch MEM the base of memory area. CALL L1A3C ; routine LOC-MEM sets HL to the destination. EX DE,HL ; swap - HL is start, DE is destination. CALL L19F6 ; routine MOVE-FP. ; note. a short ld bc,5; ldir ; the embedded memory check is not required ; so these instructions would be faster! EX DE,HL ; DE = STKEND POP HL ; restore original result pointer RET ; return. ; ------------------------- ; THE 'EXCHANGE' SUBROUTINE ; ------------------------- ; offset $01: 'exchange' ; This routine exchanges the last two values on the calculator stack ; On entry, as always with binary operations, ; HL=first number, DE=second number ; On exit, HL=result, DE=stkend. ;; exchange L1A72: LD B,$05 ; there are five bytes to be swapped ; start of loop. ;; SWAP-BYTE L1A74: LD A,(DE) ; each byte of second LD C,(HL) ; each byte of first EX DE,HL ; swap pointers LD (DE),A ; store each byte of first LD (HL),C ; store each byte of second INC HL ; advance both INC DE ; pointers. DJNZ L1A74 ; loop back to SWAP-BYTE until all 5 done. EX DE,HL ; even up the exchanges ; so that DE addresses STKEND. RET ; return. ; --------------------------------- ; THE 'SERIES GENERATOR' SUBROUTINE ; --------------------------------- ; offset $86: 'series-06' ; offset $88: 'series-08' ; offset $8C: 'series-0C' ; The ZX81 uses Chebyshev polynomials to generate approximations for ; SIN, ATN, LN and EXP. These are named after the Russian mathematician ; Pafnuty Chebyshev, born in 1821, who did much pioneering work on numerical ; series. As far as calculators are concerned, Chebyshev polynomials have an ; advantage over other series, for example the Taylor series, as they can ; reach an approximation in just six iterations for SIN, eight for EXP and ; twelve for LN and ATN. The mechanics of the routine are interesting but ; for full treatment of how these are generated with demonstrations in ; Sinclair BASIC see "The Complete Spectrum ROM Disassembly" by Dr Ian Logan ; and Dr Frank O'Hara, published 1983 by Melbourne House. ;; series-xx L1A7F: LD B,A ; parameter $00 - $1F to B counter CALL L19A0 ; routine GEN-ENT-1 is called. ; A recursive call to a special entry point ; in the calculator that puts the B register ; in the system variable BREG. The return ; address is the next location and where ; the calculator will expect its first ; instruction - now pointed to by HL'. ; The previous pointer to the series of ; five-byte numbers goes on the machine stack. ; The initialization phase. DEFB $2D ;;duplicate x,x DEFB $0F ;;addition x+x DEFB $C0 ;;st-mem-0 x+x DEFB $02 ;;delete . DEFB $A0 ;;stk-zero 0 DEFB $C2 ;;st-mem-2 0 ; a loop is now entered to perform the algebraic calculation for each of ; the numbers in the series ;; G-LOOP L1A89: DEFB $2D ;;duplicate v,v. DEFB $E0 ;;get-mem-0 v,v,x+2 DEFB $04 ;;multiply v,v*x+2 DEFB $E2 ;;get-mem-2 v,v*x+2,v DEFB $C1 ;;st-mem-1 DEFB $03 ;;subtract DEFB $34 ;;end-calc ; the previous pointer is fetched from the machine stack to H'L' where it ; addresses one of the numbers of the series following the series literal. CALL L19FC ; routine STK-DATA is called directly to ; push a value and advance H'L'. CALL L19A4 ; routine GEN-ENT-2 recursively re-enters ; the calculator without disturbing ; system variable BREG ; H'L' value goes on the machine stack and is ; then loaded as usual with the next address. DEFB $0F ;;addition DEFB $01 ;;exchange DEFB $C2 ;;st-mem-2 DEFB $02 ;;delete DEFB $31 ;;dec-jr-nz DEFB $EE ;;back to L1A89, G-LOOP ; when the counted loop is complete the final subtraction yields the result ; for example SIN X. DEFB $E1 ;;get-mem-1 DEFB $03 ;;subtract DEFB $34 ;;end-calc RET ; return with H'L' pointing to location ; after last number in series. ; ----------------------- ; Handle unary minus (18) ; ----------------------- ; Unary so on entry HL points to last value, DE to STKEND. ;; NEGATE ;; negate L1AA0: LD A, (HL) ; fetch exponent of last value on the ; calculator stack. AND A ; test it. RET Z ; return if zero. INC HL ; address the byte with the sign bit. LD A,(HL) ; fetch to accumulator. XOR $80 ; toggle the sign bit. LD (HL),A ; put it back. DEC HL ; point to last value again. RET ; return. ; ----------------------- ; Absolute magnitude (27) ; ----------------------- ; This calculator literal finds the absolute value of the last value, ; floating point, on calculator stack. ;; abs L1AAA: INC HL ; point to byte with sign bit. RES 7,(HL) ; make the sign positive. DEC HL ; point to last value again. RET ; return. ; ----------- ; Signum (26) ; ----------- ; This routine replaces the last value on the calculator stack, ; which is in floating point form, with one if positive and with -minus one ; if negative. If it is zero then it is left as such. ;; sgn L1AAF: INC HL ; point to first byte of 4-byte mantissa. LD A,(HL) ; pick up the byte with the sign bit. DEC HL ; point to exponent. DEC (HL) ; test the exponent for INC (HL) ; the value zero. SCF ; set the carry flag. CALL NZ,L1AE0 ; routine FP-0/1 replaces last value with one ; if exponent indicates the value is non-zero. ; in either case mantissa is now four zeros. INC HL ; point to first byte of 4-byte mantissa. RLCA ; rotate original sign bit to carry. RR (HL) ; rotate the carry into sign. DEC HL ; point to last value. RET ; return. ; ------------------------- ; Handle PEEK function (28) ; ------------------------- ; This function returns the contents of a memory address. ; The entire address space can be peeked including the ROM. ;; peek L1ABE: CALL L0EA7 ; routine FIND-INT puts address in BC. LD A,(BC) ; load contents into A register. ;; IN-PK-STK L1AC2: JP L151D ; exit via STACK-A to put value on the ; calculator stack. ; --------------- ; USR number (29) ; --------------- ; The USR function followed by a number 0-65535 is the method by which ; the ZX81 invokes machine code programs. This function returns the ; contents of the BC register pair. ; Note. that STACK-BC re-initializes the IY register to $4000 if a user-written ; program has altered it. ;; usr-no L1AC5: CALL L0EA7 ; routine FIND-INT to fetch the ; supplied address into BC. LD HL,L1520 ; address: STACK-BC is PUSH HL ; pushed onto the machine stack. PUSH BC ; then the address of the machine code ; routine. RET ; make an indirect jump to the routine ; and, hopefully, to STACK-BC also. ; ----------------------- ; Greater than zero ($33) ; ----------------------- ; Test if the last value on the calculator stack is greater than zero. ; This routine is also called directly from the end-tests of the comparison ; routine. ;; GREATER-0 ;; greater-0 L1ACE: LD A,(HL) ; fetch exponent. AND A ; test it for zero. RET Z ; return if so. LD A,$FF ; prepare XOR mask for sign bit JR L1ADC ; forward to SIGN-TO-C ; to put sign in carry ; (carry will become set if sign is positive) ; and then overwrite location with 1 or 0 ; as appropriate. ; ------------------------ ; Handle NOT operator ($2C) ; ------------------------ ; This overwrites the last value with 1 if it was zero else with zero ; if it was any other value. ; ; e.g. NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0. ; ; The subroutine is also called directly from the end-tests of the comparison ; operator. ;; NOT ;; not L1AD5: LD A,(HL) ; get exponent byte. NEG ; negate - sets carry if non-zero. CCF ; complement so carry set if zero, else reset. JR L1AE0 ; forward to FP-0/1. ; ------------------- ; Less than zero (32) ; ------------------- ; Destructively test if last value on calculator stack is less than zero. ; Bit 7 of second byte will be set if so. ;; less-0 L1ADB: XOR A ; set xor mask to zero ; (carry will become set if sign is negative). ; transfer sign of mantissa to Carry Flag. ;; SIGN-TO-C L1ADC: INC HL ; address 2nd byte. XOR (HL) ; bit 7 of HL will be set if number is negative. DEC HL ; address 1st byte again. RLCA ; rotate bit 7 of A to carry. ; ----------- ; Zero or one ; ----------- ; This routine places an integer value zero or one at the addressed location ; of calculator stack or MEM area. The value one is written if carry is set on ; entry else zero. ;; FP-0/1 L1AE0: PUSH HL ; save pointer to the first byte LD B,$05 ; five bytes to do. ;; FP-loop L1AE3: LD (HL),$00 ; insert a zero. INC HL ; DJNZ L1AE3 ; repeat. POP HL ; RET NC ; LD (HL),$81 ; make value 1 RET ; return. ; ----------------------- ; Handle OR operator (07) ; ----------------------- ; The Boolean OR operator. eg. X OR Y ; The result is zero if both values are zero else a non-zero value. ; ; e.g. 0 OR 0 returns 0. ; -3 OR 0 returns -3. ; 0 OR -3 returns 1. ; -3 OR 2 returns 1. ; ; A binary operation. ; On entry HL points to first operand (X) and DE to second operand (Y). ;; or L1AED: LD A,(DE) ; fetch exponent of second number AND A ; test it. RET Z ; return if zero. SCF ; set carry flag JR L1AE0 ; back to FP-0/1 to overwrite the first operand ; with the value 1. ; ----------------------------- ; Handle number AND number (08) ; ----------------------------- ; The Boolean AND operator. ; ; e.g. -3 AND 2 returns -3. ; -3 AND 0 returns 0. ; 0 and -2 returns 0. ; 0 and 0 returns 0. ; ; Compare with OR routine above. ;; no-&-no L1AF3: LD A,(DE) ; fetch exponent of second number. AND A ; test it. RET NZ ; return if not zero. JR L1AE0 ; back to FP-0/1 to overwrite the first operand ; with zero for return value. ; ----------------------------- ; Handle string AND number (10) ; ----------------------------- ; e.g. "YOU WIN" AND SCORE>99 will return the string if condition is true ; or the null string if false. ;; str-&-no L1AF8: LD A,(DE) ; fetch exponent of second number. AND A ; test it. RET NZ ; return if number was not zero - the string ; is the result. ; if the number was zero (false) then the null string must be returned by ; altering the length of the string on the calculator stack to zero. PUSH DE ; save pointer to the now obsolete number ; (which will become the new STKEND) DEC DE ; point to the 5th byte of string descriptor. XOR A ; clear the accumulator. LD (DE),A ; place zero in high byte of length. DEC DE ; address low byte of length. LD (DE),A ; place zero there - now the null string. POP DE ; restore pointer - new STKEND. RET ; return. ; ----------------------------------- ; Perform comparison ($09-$0E, $11-$16) ; ----------------------------------- ; True binary operations. ; ; A single entry point is used to evaluate six numeric and six string ; comparisons. On entry, the calculator literal is in the B register and ; the two numeric values, or the two string parameters, are on the ; calculator stack. ; The individual bits of the literal are manipulated to group similar ; operations although the SUB 8 instruction does nothing useful and merely ; alters the string test bit. ; Numbers are compared by subtracting one from the other, strings are ; compared by comparing every character until a mismatch, or the end of one ; or both, is reached. ; ; Numeric Comparisons. ; -------------------- ; The 'x>y' example is the easiest as it employs straight-thru logic. ; Number y is subtracted from x and the result tested for greater-0 yielding ; a final value 1 (true) or 0 (false). ; For 'x0? NOT ; no-gr-eql x>=y 0A 00000010 dec 00000001 10000000c swap y-x ? --- >0? NOT ; nos-neql x<>y 0B 00000011 dec 00000010 00000001 ---- x-y ? NOT --- NOT ; no-grtr x>y 0C 00000100 - 00000100 00000010 ---- x-y ? --- >0? --- ; no-less x0? --- ; nos-eql x=y 0E 00000110 - 00000110 00000011 ---- x-y ? NOT --- --- ; ; comp -> C/F ; ==== === ; str-l-eql x$<=y$ 11 00001001 dec 00001000 00000100 ---- x$y$ 0 !or >0? NOT ; str-gr-eql x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0 !or >0? NOT ; strs-neql x$<>y$ 13 00001011 dec 00001010 00000101 ---- x$y$ 0 !or >0? NOT ; str-grtr x$>y$ 14 00001100 - 00001100 00000110 ---- x$y$ 0 !or >0? --- ; str-less x$0? --- ; strs-eql x$=y$ 16 00001110 - 00001110 00000111 ---- x$y$ 0 !or >0? --- ; ; String comparisons are a little different in that the eql/neql carry flag ; from the 2nd RRCA is, as before, fed into the first of the end tests but ; along the way it gets modified by the comparison process. The result on the ; stack always starts off as zero and the carry fed in determines if NOT is ; applied to it. So the only time the greater-0 test is applied is if the ; stack holds zero which is not very efficient as the test will always yield ; zero. The most likely explanation is that there were once separate end tests ; for numbers and strings. ;; no-l-eql,etc. L1B03: LD A,B ; transfer literal to accumulator. SUB $08 ; subtract eight - which is not useful. BIT 2,A ; isolate '>', '<', '='. JR NZ,L1B0B ; skip to EX-OR-NOT with these. DEC A ; else make $00-$02, $08-$0A to match bits 0-2. ;; EX-OR-NOT L1B0B: RRCA ; the first RRCA sets carry for a swap. JR NC,L1B16 ; forward to NU-OR-STR with other 8 cases ; for the other 4 cases the two values on the calculator stack are exchanged. PUSH AF ; save A and carry. PUSH HL ; save HL - pointer to first operand. ; (DE points to second operand). CALL L1A72 ; routine exchange swaps the two values. ; (HL = second operand, DE = STKEND) POP DE ; DE = first operand EX DE,HL ; as we were. POP AF ; restore A and carry. ; Note. it would be better if the 2nd RRCA preceded the string test. ; It would save two duplicate bytes and if we also got rid of that sub 8 ; at the beginning we wouldn't have to alter which bit we test. ;; NU-OR-STR L1B16: BIT 2,A ; test if a string comparison. JR NZ,L1B21 ; forward to STRINGS if so. ; continue with numeric comparisons. RRCA ; 2nd RRCA causes eql/neql to set carry. PUSH AF ; save A and carry CALL L174C ; routine subtract leaves result on stack. JR L1B54 ; forward to END-TESTS ; --- ;; STRINGS L1B21: RRCA ; 2nd RRCA causes eql/neql to set carry. PUSH AF ; save A and carry. CALL L13F8 ; routine STK-FETCH gets 2nd string params PUSH DE ; save start2 *. PUSH BC ; and the length. CALL L13F8 ; routine STK-FETCH gets 1st string ; parameters - start in DE, length in BC. POP HL ; restore length of second to HL. ; A loop is now entered to compare, by subtraction, each corresponding character ; of the strings. For each successful match, the pointers are incremented and ; the lengths decreased and the branch taken back to here. If both string ; remainders become null at the same time, then an exact match exists. ;; BYTE-COMP L1B2C: LD A,H ; test if the second string OR L ; is the null string and hold flags. EX (SP),HL ; put length2 on stack, bring start2 to HL *. LD A,B ; hi byte of length1 to A JR NZ,L1B3D ; forward to SEC-PLUS if second not null. OR C ; test length of first string. ;; SECND-LOW L1B33: POP BC ; pop the second length off stack. JR Z,L1B3A ; forward to BOTH-NULL if first string is also ; of zero length. ; the true condition - first is longer than second (SECND-LESS) POP AF ; restore carry (set if eql/neql) CCF ; complement carry flag. ; Note. equality becomes false. ; Inequality is true. By swapping or applying ; a terminal 'not', all comparisons have been ; manipulated so that this is success path. JR L1B50 ; forward to leave via STR-TEST ; --- ; the branch was here with a match ;; BOTH-NULL L1B3A: POP AF ; restore carry - set for eql/neql JR L1B50 ; forward to STR-TEST ; --- ; the branch was here when 2nd string not null and low byte of first is yet ; to be tested. ;; SEC-PLUS L1B3D: OR C ; test the length of first string. JR Z,L1B4D ; forward to FRST-LESS if length is zero. ; both strings have at least one character left. LD A,(DE) ; fetch character of first string. SUB (HL) ; subtract with that of 2nd string. JR C,L1B4D ; forward to FRST-LESS if carry set JR NZ,L1B33 ; back to SECND-LOW and then STR-TEST ; if not exact match. DEC BC ; decrease length of 1st string. INC DE ; increment 1st string pointer. INC HL ; increment 2nd string pointer. EX (SP),HL ; swap with length on stack DEC HL ; decrement 2nd string length JR L1B2C ; back to BYTE-COMP ; --- ; the false condition. ;; FRST-LESS L1B4D: POP BC ; discard length POP AF ; pop A AND A ; clear the carry for false result. ; --- ; exact match and x$>y$ rejoin here ;; STR-TEST L1B50: PUSH AF ; save A and carry RST 28H ;; FP-CALC DEFB $A0 ;;stk-zero an initial false value. DEFB $34 ;;end-calc ; both numeric and string paths converge here. ;; END-TESTS L1B54: POP AF ; pop carry - will be set if eql/neql PUSH AF ; save it again. CALL C,L1AD5 ; routine NOT sets true(1) if equal(0) ; or, for strings, applies true result. CALL L1ACE ; greater-0 ?????????? POP AF ; pop A RRCA ; the third RRCA - test for '<=', '>=' or '<>'. CALL NC,L1AD5 ; apply a terminal NOT if so. RET ; return. ; ------------------------- ; String concatenation ($17) ; ------------------------- ; This literal combines two strings into one e.g. LET A$ = B$ + C$ ; The two parameters of the two strings to be combined are on the stack. ;; strs-add L1B62: CALL L13F8 ; routine STK-FETCH fetches string parameters ; and deletes calculator stack entry. PUSH DE ; save start address. PUSH BC ; and length. CALL L13F8 ; routine STK-FETCH for first string POP HL ; re-fetch first length PUSH HL ; and save again PUSH DE ; save start of second string PUSH BC ; and its length. ADD HL,BC ; add the two lengths. LD B,H ; transfer to BC LD C,L ; and create RST 30H ; BC-SPACES in workspace. ; DE points to start of space. CALL L12C3 ; routine STK-STO-$ stores parameters ; of new string updating STKEND. POP BC ; length of first POP HL ; address of start LD A,B ; test for OR C ; zero length. JR Z,L1B7D ; to OTHER-STR if null string LDIR ; copy string to workspace. ;; OTHER-STR L1B7D: POP BC ; now second length POP HL ; and start of string LD A,B ; test this one OR C ; for zero length JR Z,L1B85 ; skip forward to STK-PNTRS if so as complete. LDIR ; else copy the bytes. ; and continue into next routine which ; sets the calculator stack pointers. ; -------------------- ; Check stack pointers ; -------------------- ; Register DE is set to STKEND and HL, the result pointer, is set to five ; locations below this. ; This routine is used when it is inconvenient to save these values at the ; time the calculator stack is manipulated due to other activity on the ; machine stack. ; This routine is also used to terminate the VAL routine for ; the same reason and to initialize the calculator stack at the start of ; the CALCULATE routine. ;; STK-PNTRS L1B85: LD HL,($401C) ; fetch STKEND value from system variable. LD DE,$FFFB ; the value -5 PUSH HL ; push STKEND value. ADD HL,DE ; subtract 5 from HL. POP DE ; pop STKEND to DE. RET ; return. ; ---------------- ; Handle CHR$ (2B) ; ---------------- ; This function returns a single character string that is a result of ; converting a number in the range 0-255 to a string e.g. CHR$ 38 = "A". ; Note. the ZX81 does not have an ASCII character set. ;; chrs L1B8F: CALL L15CD ; routine FP-TO-A puts the number in A. JR C,L1BA2 ; forward to REPORT-Bd if overflow JR NZ,L1BA2 ; forward to REPORT-Bd if negative PUSH AF ; save the argument. LD BC,$0001 ; one space required. RST 30H ; BC-SPACES makes DE point to start POP AF ; restore the number. LD (DE),A ; and store in workspace CALL L12C3 ; routine STK-STO-$ stacks descriptor. EX DE,HL ; make HL point to result and DE to STKEND. RET ; return. ; --- ;; REPORT-Bd L1BA2: RST 08H ; ERROR-1 DEFB $0A ; Error Report: Integer out of range ; ---------------------------- ; Handle VAL ($1A) ; ---------------------------- ; VAL treats the characters in a string as a numeric expression. ; e.g. VAL "2.3" = 2.3, VAL "2+4" = 6, VAL ("2" + "4") = 24. ;; val L1BA4: LD HL,($4016) ; fetch value of system variable CH_ADD PUSH HL ; and save on the machine stack. CALL L13F8 ; routine STK-FETCH fetches the string operand ; from calculator stack. PUSH DE ; save the address of the start of the string. INC BC ; increment the length for a carriage return. RST 30H ; BC-SPACES creates the space in workspace. POP HL ; restore start of string to HL. LD ($4016),DE ; load CH_ADD with start DE in workspace. PUSH DE ; save the start in workspace LDIR ; copy string from program or variables or ; workspace to the workspace area. EX DE,HL ; end of string + 1 to HL DEC HL ; decrement HL to point to end of new area. LD (HL),$76 ; insert a carriage return at end. ; ZX81 has a non-ASCII character set RES 7,(IY+$01) ; update FLAGS - signal checking syntax. CALL L0D92 ; routine CLASS-06 - SCANNING evaluates string ; expression and checks for integer result. CALL L0D22 ; routine CHECK-2 checks for carriage return. POP HL ; restore start of string in workspace. LD ($4016),HL ; set CH_ADD to the start of the string again. SET 7,(IY+$01) ; update FLAGS - signal running program. CALL L0F55 ; routine SCANNING evaluates the string ; in full leaving result on calculator stack. POP HL ; restore saved character address in program. LD ($4016),HL ; and reset the system variable CH_ADD. JR L1B85 ; back to exit via STK-PNTRS. ; resetting the calculator stack pointers ; HL and DE from STKEND as it wasn't possible ; to preserve them during this routine. ; ---------------- ; Handle STR$ (2A) ; ---------------- ; This function returns a string representation of a numeric argument. ; The method used is to trick the PRINT-FP routine into thinking it ; is writing to a collapsed display file when in fact it is writing to ; string workspace. ; If there is already a newline at the intended print position and the ; column count has not been reduced to zero then the print routine ; assumes that there is only 1K of RAM and the screen memory, like the rest ; of dynamic memory, expands as necessary using calls to the ONE-SPACE ; routine. The screen is character-mapped not bit-mapped. ;; str$ L1BD5: LD BC,$0001 ; create an initial byte in workspace RST 30H ; using BC-SPACES restart. LD (HL),$76 ; place a carriage return there. LD HL,($4039) ; fetch value of S_POSN column/line PUSH HL ; and preserve on stack. LD L,$FF ; make column value high to create a ; contrived buffer of length 254. LD ($4039),HL ; and store in system variable S_POSN. LD HL,($400E) ; fetch value of DF_CC PUSH HL ; and preserve on stack also. LD ($400E),DE ; now set DF_CC which normally addresses ; somewhere in the display file to the start ; of workspace. PUSH DE ; save the start of new string. CALL L15DB ; routine PRINT-FP. POP DE ; retrieve start of string. LD HL,($400E) ; fetch end of string from DF_CC. AND A ; prepare for true subtraction. SBC HL,DE ; subtract to give length. LD B,H ; and transfer to the BC LD C,L ; register. POP HL ; restore original LD ($400E),HL ; DF_CC value POP HL ; restore original LD ($4039),HL ; S_POSN values. CALL L12C3 ; routine STK-STO-$ stores the string ; descriptor on the calculator stack. EX DE,HL ; HL = last value, DE = STKEND. RET ; return. ; ------------------- ; THE 'CODE' FUNCTION ; ------------------- ; (offset $19: 'code') ; Returns the code of a character or first character of a string ; e.g. CODE "AARDVARK" = 38 (not 65 as the ZX81 does not have an ASCII ; character set). ;; code L1C06: CALL L13F8 ; routine STK-FETCH to fetch and delete the ; string parameters. ; DE points to the start, BC holds the length. LD A,B ; test length OR C ; of the string. JR Z,L1C0E ; skip to STK-CODE with zero if the null string. LD A,(DE) ; else fetch the first character. ;; STK-CODE L1C0E: JP L151D ; jump back to STACK-A (with memory check) ; -------------------- ; THE 'LEN' SUBROUTINE ; -------------------- ; (offset $1b: 'len') ; Returns the length of a string. ; In Sinclair BASIC strings can be more than twenty thousand characters long ; so a sixteen-bit register is required to store the length ;; len L1C11: CALL L13F8 ; routine STK-FETCH to fetch and delete the ; string parameters from the calculator stack. ; register BC now holds the length of string. JP L1520 ; jump back to STACK-BC to save result on the ; calculator stack (with memory check). ; ------------------------------------- ; THE 'DECREASE THE COUNTER' SUBROUTINE ; ------------------------------------- ; (offset $31: 'dec-jr-nz') ; The calculator has an instruction that decrements a single-byte ; pseudo-register and makes consequential relative jumps just like ; the Z80's DJNZ instruction. ;; dec-jr-nz L1C17: EXX ; switch in set that addresses code PUSH HL ; save pointer to offset byte LD HL,$401E ; address BREG in system variables DEC (HL) ; decrement it POP HL ; restore pointer JR NZ,L1C24 ; to JUMP-2 if not zero INC HL ; step past the jump length. EXX ; switch in the main set. RET ; return. ; Note. as a general rule the calculator avoids using the IY register ; otherwise the cumbersome 4 instructions in the middle could be replaced by ; dec (iy+$xx) - using three instruction bytes instead of six. ; --------------------- ; THE 'JUMP' SUBROUTINE ; --------------------- ; (Offset $2F; 'jump') ; This enables the calculator to perform relative jumps just like ; the Z80 chip's JR instruction. ; This is one of the few routines to be polished for the ZX Spectrum. ; See, without looking at the ZX Spectrum ROM, if you can get rid of the ; relative jump. ;; jump ;; JUMP L1C23: EXX ;switch in pointer set ;; JUMP-2 L1C24: LD E,(HL) ; the jump byte 0-127 forward, 128-255 back. XOR A ; clear accumulator. BIT 7,E ; test if negative jump JR Z,L1C2B ; skip, if positive, to JUMP-3. CPL ; else change to $FF. ;; JUMP-3 L1C2B: LD D,A ; transfer to high byte. ADD HL,DE ; advance calculator pointer forward or back. EXX ; switch out pointer set. RET ; return. ; ----------------------------- ; THE 'JUMP ON TRUE' SUBROUTINE ; ----------------------------- ; (Offset $00; 'jump-true') ; This enables the calculator to perform conditional relative jumps ; dependent on whether the last test gave a true result ; On the ZX81, the exponent will be zero for zero or else $81 for one. ;; jump-true L1C2F: LD A,(DE) ; collect exponent byte AND A ; is result 0 or 1 ? JR NZ,L1C23 ; back to JUMP if true (1). EXX ; else switch in the pointer set. INC HL ; step past the jump length. EXX ; switch in the main set. RET ; return. ; ------------------------ ; THE 'MODULUS' SUBROUTINE ; ------------------------ ; ( Offset $2E: 'n-mod-m' ) ; ( i1, i2 -- i3, i4 ) ; The subroutine calculate N mod M where M is the positive integer, the ; 'last value' on the calculator stack and N is the integer beneath. ; The subroutine returns the integer quotient as the last value and the ; remainder as the value beneath. ; e.g. 17 MOD 3 = 5 remainder 2 ; It is invoked during the calculation of a random number and also by ; the PRINT-FP routine. ;; n-mod-m L1C37: RST 28H ;; FP-CALC 17, 3. DEFB $C0 ;;st-mem-0 17, 3. DEFB $02 ;;delete 17. DEFB $2D ;;duplicate 17, 17. DEFB $E0 ;;get-mem-0 17, 17, 3. DEFB $05 ;;division 17, 17/3. DEFB $24 ;;int 17, 5. DEFB $E0 ;;get-mem-0 17, 5, 3. DEFB $01 ;;exchange 17, 3, 5. DEFB $C0 ;;st-mem-0 17, 3, 5. DEFB $04 ;;multiply 17, 15. DEFB $03 ;;subtract 2. DEFB $E0 ;;get-mem-0 2, 5. DEFB $34 ;;end-calc 2, 5. RET ; return. ; ---------------------- ; THE 'INTEGER' FUNCTION ; ---------------------- ; (offset $24: 'int') ; This function returns the integer of x, which is just the same as truncate ; for positive numbers. The truncate literal truncates negative numbers ; upwards so that -3.4 gives -3 whereas the BASIC INT function has to ; truncate negative numbers down so that INT -3.4 is 4. ; It is best to work through using, say, plus or minus 3.4 as examples. ;; int L1C46: RST 28H ;; FP-CALC x. (= 3.4 or -3.4). DEFB $2D ;;duplicate x, x. DEFB $32 ;;less-0 x, (1/0) DEFB $00 ;;jump-true x, (1/0) DEFB $04 ;;to L1C46, X-NEG DEFB $36 ;;truncate trunc 3.4 = 3. DEFB $34 ;;end-calc 3. RET ; return with + int x on stack. ;; X-NEG L1C4E: DEFB $2D ;;duplicate -3.4, -3.4. DEFB $36 ;;truncate -3.4, -3. DEFB $C0 ;;st-mem-0 -3.4, -3. DEFB $03 ;;subtract -.4 DEFB $E0 ;;get-mem-0 -.4, -3. DEFB $01 ;;exchange -3, -.4. DEFB $2C ;;not -3, (0). DEFB $00 ;;jump-true -3. DEFB $03 ;;to L1C59, EXIT -3. DEFB $A1 ;;stk-one -3, 1. DEFB $03 ;;subtract -4. ;; EXIT L1C59: DEFB $34 ;;end-calc -4. RET ; return. ; ---------------- ; Exponential (23) ; ---------------- ; ; ;; EXP ;; exp L1C5B: RST 28H ;; FP-CALC DEFB $30 ;;stk-data DEFB $F1 ;;Exponent: $81, Bytes: 4 DEFB $38,$AA,$3B,$29 ;; DEFB $04 ;;multiply DEFB $2D ;;duplicate DEFB $24 ;;int DEFB $C3 ;;st-mem-3 DEFB $03 ;;subtract DEFB $2D ;;duplicate DEFB $0F ;;addition DEFB $A1 ;;stk-one DEFB $03 ;;subtract DEFB $88 ;;series-08 DEFB $13 ;;Exponent: $63, Bytes: 1 DEFB $36 ;;(+00,+00,+00) DEFB $58 ;;Exponent: $68, Bytes: 2 DEFB $65,$66 ;;(+00,+00) DEFB $9D ;;Exponent: $6D, Bytes: 3 DEFB $78,$65,$40 ;;(+00) DEFB $A2 ;;Exponent: $72, Bytes: 3 DEFB $60,$32,$C9 ;;(+00) DEFB $E7 ;;Exponent: $77, Bytes: 4 DEFB $21,$F7,$AF,$24 ;; DEFB $EB ;;Exponent: $7B, Bytes: 4 DEFB $2F,$B0,$B0,$14 ;; DEFB $EE ;;Exponent: $7E, Bytes: 4 DEFB $7E,$BB,$94,$58 ;; DEFB $F1 ;;Exponent: $81, Bytes: 4 DEFB $3A,$7E,$F8,$CF ;; DEFB $E3 ;;get-mem-3 DEFB $34 ;;end-calc CALL L15CD ; routine FP-TO-A JR NZ,L1C9B ; to N-NEGTV JR C,L1C99 ; to REPORT-6b ADD A,(HL) ; JR NC,L1CA2 ; to RESULT-OK ;; REPORT-6b L1C99: RST 08H ; ERROR-1 DEFB $05 ; Error Report: Number too big ;; N-NEGTV L1C9B: JR C,L1CA4 ; to RSLT-ZERO SUB (HL) ; JR NC,L1CA4 ; to RSLT-ZERO NEG ; Negate ;; RESULT-OK L1CA2: LD (HL),A ; RET ; return. ;; RSLT-ZERO L1CA4: RST 28H ;; FP-CALC DEFB $02 ;;delete DEFB $A0 ;;stk-zero DEFB $34 ;;end-calc RET ; return. ; -------------------------------- ; THE 'NATURAL LOGARITHM' FUNCTION ; -------------------------------- ; (offset $22: 'ln') ; Like the ZX81 itself, 'natural' logarithms came from Scotland. ; They were devised in 1614 by well-traveled Scotsman John Napier who noted ; "Nothing doth more molest and hinder calculators than the multiplications, ; divisions, square and cubical extractions of great numbers". ; ; Napier's logarithms enabled the above operations to be accomplished by ; simple addition and subtraction simplifying the navigational and ; astronomical calculations which beset his age. ; Napier's logarithms were quickly overtaken by logarithms to the base 10 ; devised, in conjunction with Napier, by Henry Briggs a Cambridge-educated ; professor of Geometry at Oxford University. These simplified the layout ; of the tables enabling humans to easily scale calculations. ; ; It is only recently with the introduction of pocket calculators and ; computers like the ZX81 that natural logarithms are once more at the fore, ; although some computers retain logarithms to the base ten. ; 'Natural' logarithms are powers to the base 'e', which like 'pi' is a ; naturally occurring number in branches of mathematics. ; Like 'pi' also, 'e' is an irrational number and starts 2.718281828... ; ; The tabular use of logarithms was that to multiply two numbers one looked ; up their two logarithms in the tables, added them together and then looked ; for the result in a table of antilogarithms to give the desired product. ; ; The EXP function is the BASIC equivalent of a calculator's 'antiln' function ; and by picking any two numbers, 1.72 and 6.89 say, ; 10 PRINT EXP ( LN 1.72 + LN 6.89 ) ; will give just the same result as ; 20 PRINT 1.72 * 6.89. ; Division is accomplished by subtracting the two logs. ; ; Napier also mentioned "square and cubicle extractions". ; To raise a number to the power 3, find its 'ln', multiply by 3 and find the ; 'antiln'. e.g. PRINT EXP( LN 4 * 3 ) gives 64. ; Similarly to find the n'th root divide the logarithm by 'n'. ; The ZX81 ROM used PRINT EXP ( LN 9 / 2 ) to find the square root of the ; number 9. The Napieran square root function is just a special case of ; the 'to_power' function. A cube root or indeed any root/power would be just ; as simple. ; First test that the argument to LN is a positive, non-zero number. ;; ln L1CA9: RST 28H ;; FP-CALC DEFB $2D ;;duplicate DEFB $33 ;;greater-0 DEFB $00 ;;jump-true DEFB $04 ;;to L1CB1, VALID DEFB $34 ;;end-calc ;; REPORT-Ab L1CAF: RST 08H ; ERROR-1 DEFB $09 ; Error Report: Invalid argument ;; VALID L1CB1: DEFB $A0 ;;stk-zero Note. not DEFB $02 ;;delete necessary. DEFB $34 ;;end-calc LD A,(HL) ; LD (HL),$80 ; CALL L151D ; routine STACK-A RST 28H ;; FP-CALC DEFB $30 ;;stk-data DEFB $38 ;;Exponent: $88, Bytes: 1 DEFB $00 ;;(+00,+00,+00) DEFB $03 ;;subtract DEFB $01 ;;exchange DEFB $2D ;;duplicate DEFB $30 ;;stk-data DEFB $F0 ;;Exponent: $80, Bytes: 4 DEFB $4C,$CC,$CC,$CD ;; DEFB $03 ;;subtract DEFB $33 ;;greater-0 DEFB $00 ;;jump-true DEFB $08 ;;to L1CD2, GRE.8 DEFB $01 ;;exchange DEFB $A1 ;;stk-one DEFB $03 ;;subtract DEFB $01 ;;exchange DEFB $34 ;;end-calc INC (HL) ; RST 28H ;; FP-CALC ;; GRE.8 L1CD2: DEFB $01 ;;exchange DEFB $30 ;;stk-data DEFB $F0 ;;Exponent: $80, Bytes: 4 DEFB $31,$72,$17,$F8 ;; DEFB $04 ;;multiply DEFB $01 ;;exchange DEFB $A2 ;;stk-half DEFB $03 ;;subtract DEFB $A2 ;;stk-half DEFB $03 ;;subtract DEFB $2D ;;duplicate DEFB $30 ;;stk-data DEFB $32 ;;Exponent: $82, Bytes: 1 DEFB $20 ;;(+00,+00,+00) DEFB $04 ;;multiply DEFB $A2 ;;stk-half DEFB $03 ;;subtract DEFB $8C ;;series-0C DEFB $11 ;;Exponent: $61, Bytes: 1 DEFB $AC ;;(+00,+00,+00) DEFB $14 ;;Exponent: $64, Bytes: 1 DEFB $09 ;;(+00,+00,+00) DEFB $56 ;;Exponent: $66, Bytes: 2 DEFB $DA,$A5 ;;(+00,+00) DEFB $59 ;;Exponent: $69, Bytes: 2 DEFB $30,$C5 ;;(+00,+00) DEFB $5C ;;Exponent: $6C, Bytes: 2 DEFB $90,$AA ;;(+00,+00) DEFB $9E ;;Exponent: $6E, Bytes: 3 DEFB $70,$6F,$61 ;;(+00) DEFB $A1 ;;Exponent: $71, Bytes: 3 DEFB $CB,$DA,$96 ;;(+00) DEFB $A4 ;;Exponent: $74, Bytes: 3 DEFB $31,$9F,$B4 ;;(+00) DEFB $E7 ;;Exponent: $77, Bytes: 4 DEFB $A0,$FE,$5C,$FC ;; DEFB $EA ;;Exponent: $7A, Bytes: 4 DEFB $1B,$43,$CA,$36 ;; DEFB $ED ;;Exponent: $7D, Bytes: 4 DEFB $A7,$9C,$7E,$5E ;; DEFB $F0 ;;Exponent: $80, Bytes: 4 DEFB $6E,$23,$80,$93 ;; DEFB $04 ;;multiply DEFB $0F ;;addition DEFB $34 ;;end-calc RET ; return. ; ----------------------------- ; THE 'TRIGONOMETRIC' FUNCTIONS ; ----------------------------- ; Trigonometry is rocket science. It is also used by carpenters and pyramid ; builders. ; Some uses can be quite abstract but the principles can be seen in simple ; right-angled triangles. Triangles have some special properties - ; ; 1) The sum of the three angles is always PI radians (180 degrees). ; Very helpful if you know two angles and wish to find the third. ; 2) In any right-angled triangle the sum of the squares of the two shorter ; sides is equal to the square of the longest side opposite the right-angle. ; Very useful if you know the length of two sides and wish to know the ; length of the third side. ; 3) Functions sine, cosine and tangent enable one to calculate the length ; of an unknown side when the length of one other side and an angle is ; known. ; 4) Functions arcsin, arccosine and arctan enable one to calculate an unknown ; angle when the length of two of the sides is known. ; -------------------------------- ; THE 'REDUCE ARGUMENT' SUBROUTINE ; -------------------------------- ; (offset $35: 'get-argt') ; ; This routine performs two functions on the angle, in radians, that forms ; the argument to the sine and cosine functions. ; First it ensures that the angle 'wraps round'. That if a ship turns through ; an angle of, say, 3*PI radians (540 degrees) then the net effect is to turn ; through an angle of PI radians (180 degrees). ; Secondly it converts the angle in radians to a fraction of a right angle, ; depending within which quadrant the angle lies, with the periodicity ; resembling that of the desired sine value. ; The result lies in the range -1 to +1. ; ; 90 deg. ; ; (pi/2) ; II +1 I ; | ; sin+ |\ | /| sin+ ; cos- | \ | / | cos+ ; tan- | \ | / | tan+ ; | \|/) | ; 180 deg. (pi) 0 -|----+----|-- 0 (0) 0 degrees ; | /|\ | ; sin- | / | \ | sin- ; cos- | / | \ | cos+ ; tan+ |/ | \| tan- ; | ; III -1 IV ; (3pi/2) ; ; 270 deg. ;; get-argt L1D18: RST 28H ;; FP-CALC X. DEFB $30 ;;stk-data DEFB $EE ;;Exponent: $7E, ;;Bytes: 4 DEFB $22,$F9,$83,$6E ;; X, 1/(2*PI) DEFB $04 ;;multiply X/(2*PI) = fraction DEFB $2D ;;duplicate DEFB $A2 ;;stk-half DEFB $0F ;;addition DEFB $24 ;;int DEFB $03 ;;subtract now range -.5 to .5 DEFB $2D ;;duplicate DEFB $0F ;;addition now range -1 to 1. DEFB $2D ;;duplicate DEFB $0F ;;addition now range -2 to 2. ; quadrant I (0 to +1) and quadrant IV (-1 to 0) are now correct. ; quadrant II ranges +1 to +2. ; quadrant III ranges -2 to -1. DEFB $2D ;;duplicate Y, Y. DEFB $27 ;;abs Y, abs(Y). range 1 to 2 DEFB $A1 ;;stk-one Y, abs(Y), 1. DEFB $03 ;;subtract Y, abs(Y)-1. range 0 to 1 DEFB $2D ;;duplicate Y, Z, Z. DEFB $33 ;;greater-0 Y, Z, (1/0). DEFB $C0 ;;st-mem-0 store as possible sign ;; for cosine function. DEFB $00 ;;jump-true DEFB $04 ;;to L1D35, ZPLUS with quadrants II and III ; else the angle lies in quadrant I or IV and value Y is already correct. DEFB $02 ;;delete Y delete test value. DEFB $34 ;;end-calc Y. RET ; return. with Q1 and Q4 >>> ; The branch was here with quadrants II (0 to 1) and III (1 to 0). ; Y will hold -2 to -1 if this is quadrant III. ;; ZPLUS L1D35: DEFB $A1 ;;stk-one Y, Z, 1 DEFB $03 ;;subtract Y, Z-1. Q3 = 0 to -1 DEFB $01 ;;exchange Z-1, Y. DEFB $32 ;;less-0 Z-1, (1/0). DEFB $00 ;;jump-true Z-1. DEFB $02 ;;to L1D3C, YNEG ;;if angle in quadrant III ; else angle is within quadrant II (-1 to 0) DEFB $18 ;;negate range +1 to 0 ;; YNEG L1D3C: DEFB $34 ;;end-calc quadrants II and III correct. RET ; return. ; --------------------- ; THE 'COSINE' FUNCTION ; --------------------- ; (offset $1D: 'cos') ; Cosines are calculated as the sine of the opposite angle rectifying the ; sign depending on the quadrant rules. ; ; ; /| ; h /y| ; / |o ; /x | ; /----| ; a ; ; The cosine of angle x is the adjacent side (a) divided by the hypotenuse 1. ; However if we examine angle y then a/h is the sine of that angle. ; Since angle x plus angle y equals a right-angle, we can find angle y by ; subtracting angle x from pi/2. ; However it's just as easy to reduce the argument first and subtract the ; reduced argument from the value 1 (a reduced right-angle). ; It's even easier to subtract 1 from the angle and rectify the sign. ; In fact, after reducing the argument, the absolute value of the argument ; is used and rectified using the test result stored in mem-0 by 'get-argt' ; for that purpose. ;; cos L1D3E: RST 28H ;; FP-CALC angle in radians. DEFB $35 ;;get-argt X reduce -1 to +1 DEFB $27 ;;abs ABS X 0 to 1 DEFB $A1 ;;stk-one ABS X, 1. DEFB $03 ;;subtract now opposite angle ;; though negative sign. DEFB $E0 ;;get-mem-0 fetch sign indicator. DEFB $00 ;;jump-true DEFB $06 ;;fwd to L1D4B, C-ENT ;;forward to common code if in QII or QIII DEFB $18 ;;negate else make positive. DEFB $2F ;;jump DEFB $03 ;;fwd to L1D4B, C-ENT ;;with quadrants QI and QIV ; ------------------- ; THE 'SINE' FUNCTION ; ------------------- ; (offset $1C: 'sin') ; This is a fundamental transcendental function from which others such as cos ; and tan are directly, or indirectly, derived. ; It uses the series generator to produce Chebyshev polynomials. ; ; ; /| ; 1 / | ; / |x ; /a | ; /----| ; y ; ; The 'get-argt' function is designed to modify the angle and its sign ; in line with the desired sine value and afterwards it can launch straight ; into common code. ;; sin L1D49: RST 28H ;; FP-CALC angle in radians DEFB $35 ;;get-argt reduce - sign now correct. ;; C-ENT L1D4B: DEFB $2D ;;duplicate DEFB $2D ;;duplicate DEFB $04 ;;multiply DEFB $2D ;;duplicate DEFB $0F ;;addition DEFB $A1 ;;stk-one DEFB $03 ;;subtract DEFB $86 ;;series-06 DEFB $14 ;;Exponent: $64, Bytes: 1 DEFB $E6 ;;(+00,+00,+00) DEFB $5C ;;Exponent: $6C, Bytes: 2 DEFB $1F,$0B ;;(+00,+00) DEFB $A3 ;;Exponent: $73, Bytes: 3 DEFB $8F,$38,$EE ;;(+00) DEFB $E9 ;;Exponent: $79, Bytes: 4 DEFB $15,$63,$BB,$23 ;; DEFB $EE ;;Exponent: $7E, Bytes: 4 DEFB $92,$0D,$CD,$ED ;; DEFB $F1 ;;Exponent: $81, Bytes: 4 DEFB $23,$5D,$1B,$EA ;; DEFB $04 ;;multiply DEFB $34 ;;end-calc RET ; return. ; ---------------------- ; THE 'TANGENT' FUNCTION ; ---------------------- ; (offset $1E: 'tan') ; ; Evaluates tangent x as sin(x) / cos(x). ; ; ; /| ; h / | ; / |o ; /x | ; /----| ; a ; ; The tangent of angle x is the ratio of the length of the opposite side ; divided by the length of the adjacent side. As the opposite length can ; be calculates using sin(x) and the adjacent length using cos(x) then ; the tangent can be defined in terms of the previous two functions. ; Error 6 if the argument, in radians, is too close to one like pi/2 ; which has an infinite tangent. e.g. PRINT TAN (PI/2) evaluates as 1/0. ; Similarly PRINT TAN (3*PI/2), TAN (5*PI/2) etc. ;; tan L1D6E: RST 28H ;; FP-CALC x. DEFB $2D ;;duplicate x, x. DEFB $1C ;;sin x, sin x. DEFB $01 ;;exchange sin x, x. DEFB $1D ;;cos sin x, cos x. DEFB $05 ;;division sin x/cos x (= tan x). DEFB $34 ;;end-calc tan x. RET ; return. ; --------------------- ; THE 'ARCTAN' FUNCTION ; --------------------- ; (Offset $21: 'atn') ; The inverse tangent function with the result in radians. ; This is a fundamental transcendental function from which others such as ; asn and acs are directly, or indirectly, derived. ; It uses the series generator to produce Chebyshev polynomials. ;; atn L1D76: LD A,(HL) ; fetch exponent CP $81 ; compare to that for 'one' JR C,L1D89 ; forward, if less, to SMALL RST 28H ;; FP-CALC X. DEFB $A1 ;;stk-one DEFB $18 ;;negate DEFB $01 ;;exchange DEFB $05 ;;division DEFB $2D ;;duplicate DEFB $32 ;;less-0 DEFB $A3 ;;stk-pi/2 DEFB $01 ;;exchange DEFB $00 ;;jump-true DEFB $06 ;;to L1D8B, CASES DEFB $18 ;;negate DEFB $2F ;;jump DEFB $03 ;;to L1D8B, CASES ; --- ;; SMALL L1D89: RST 28H ;; FP-CALC DEFB $A0 ;;stk-zero ;; CASES L1D8B: DEFB $01 ;;exchange DEFB $2D ;;duplicate DEFB $2D ;;duplicate DEFB $04 ;;multiply DEFB $2D ;;duplicate DEFB $0F ;;addition DEFB $A1 ;;stk-one DEFB $03 ;;subtract DEFB $8C ;;series-0C DEFB $10 ;;Exponent: $60, Bytes: 1 DEFB $B2 ;;(+00,+00,+00) DEFB $13 ;;Exponent: $63, Bytes: 1 DEFB $0E ;;(+00,+00,+00) DEFB $55 ;;Exponent: $65, Bytes: 2 DEFB $E4,$8D ;;(+00,+00) DEFB $58 ;;Exponent: $68, Bytes: 2 DEFB $39,$BC ;;(+00,+00) DEFB $5B ;;Exponent: $6B, Bytes: 2 DEFB $98,$FD ;;(+00,+00) DEFB $9E ;;Exponent: $6E, Bytes: 3 DEFB $00,$36,$75 ;;(+00) DEFB $A0 ;;Exponent: $70, Bytes: 3 DEFB $DB,$E8,$B4 ;;(+00) DEFB $63 ;;Exponent: $73, Bytes: 2 DEFB $42,$C4 ;;(+00,+00) DEFB $E6 ;;Exponent: $76, Bytes: 4 DEFB $B5,$09,$36,$BE ;; DEFB $E9 ;;Exponent: $79, Bytes: 4 DEFB $36,$73,$1B,$5D ;; DEFB $EC ;;Exponent: $7C, Bytes: 4 DEFB $D8,$DE,$63,$BE ;; DEFB $F0 ;;Exponent: $80, Bytes: 4 DEFB $61,$A1,$B3,$0C ;; DEFB $04 ;;multiply DEFB $0F ;;addition DEFB $34 ;;end-calc RET ; return. ; --------------------- ; THE 'ARCSIN' FUNCTION ; --------------------- ; (Offset $1F: 'asn') ; The inverse sine function with result in radians. ; Derived from arctan function above. ; Error A unless the argument is between -1 and +1 inclusive. ; Uses an adaptation of the formula asn(x) = atn(x/sqr(1-x*x)) ; ; ; /| ; / | ; 1/ |x ; /a | ; /----| ; y ; ; e.g. We know the opposite side (x) and hypotenuse (1) ; and we wish to find angle a in radians. ; We can derive length y by Pythagoras and then use ATN instead. ; Since y*y + x*x = 1*1 (Pythagoras Theorem) then ; y=sqr(1-x*x) - no need to multiply 1 by itself. ; So, asn(a) = atn(x/y) ; or more fully, ; asn(a) = atn(x/sqr(1-x*x)) ; Close but no cigar. ; While PRINT ATN (x/SQR (1-x*x)) gives the same results as PRINT ASN x, ; it leads to division by zero when x is 1 or -1. ; To overcome this, 1 is added to y giving half the required angle and the ; result is then doubled. ; That is, PRINT ATN (x/(SQR (1-x*x) +1)) *2 ; ; ; . /| ; . c/ | ; . /1 |x ; . c b /a | ; ---------/----| ; 1 y ; ; By creating an isosceles triangle with two equal sides of 1, angles c and ; c are also equal. If b+c+d = 180 degrees and b+a = 180 degrees then c=a/2. ; ; A value higher than 1 gives the required error as attempting to find the ; square root of a negative number generates an error in Sinclair BASIC. ;; asn L1DC4: RST 28H ;; FP-CALC x. DEFB $2D ;;duplicate x, x. DEFB $2D ;;duplicate x, x, x. DEFB $04 ;;multiply x, x*x. DEFB $A1 ;;stk-one x, x*x, 1. DEFB $03 ;;subtract x, x*x-1. DEFB $18 ;;negate x, 1-x*x. DEFB $25 ;;sqr x, sqr(1-x*x) = y. DEFB $A1 ;;stk-one x, y, 1. DEFB $0F ;;addition x, y+1. DEFB $05 ;;division x/y+1. DEFB $21 ;;atn a/2 (half the angle) DEFB $2D ;;duplicate a/2, a/2. DEFB $0F ;;addition a. DEFB $34 ;;end-calc a. RET ; return. ; ------------------------ ; THE 'ARCCOS' FUNCTION ; ------------------------ ; (Offset $20: 'acs') ; The inverse cosine function with the result in radians. ; Error A unless the argument is between -1 and +1. ; Result in range 0 to pi. ; Derived from asn above which is in turn derived from the preceding atn. It ; could have been derived directly from atn using acs(x) = atn(sqr(1-x*x)/x). ; However, as sine and cosine are horizontal translations of each other, ; uses acs(x) = pi/2 - asn(x) ; e.g. the arccosine of a known x value will give the required angle b in ; radians. ; We know, from above, how to calculate the angle a using asn(x). ; Since the three angles of any triangle add up to 180 degrees, or pi radians, ; and the largest angle in this case is a right-angle (pi/2 radians), then ; we can calculate angle b as pi/2 (both angles) minus asn(x) (angle a). ; ; ; /| ; 1 /b| ; / |x ; /a | ; /----| ; y ;; acs L1DD4: RST 28H ;; FP-CALC x. DEFB $1F ;;asn asn(x). DEFB $A3 ;;stk-pi/2 asn(x), pi/2. DEFB $03 ;;subtract asn(x) - pi/2. DEFB $18 ;;negate pi/2 - asn(x) = acs(x). DEFB $34 ;;end-calc acs(x) RET ; return. ; -------------------------- ; THE 'SQUARE ROOT' FUNCTION ; -------------------------- ; (Offset $25: 'sqr') ; Error A if argument is negative. ; This routine is remarkable for its brevity - 7 bytes. ; The ZX81 code was originally 9K and various techniques had to be ; used to shoe-horn it into an 8K Rom chip. ;; sqr L1DDB: RST 28H ;; FP-CALC x. DEFB $2D ;;duplicate x, x. DEFB $2C ;;not x, 1/0 DEFB $00 ;;jump-true x, (1/0). DEFB $1E ;;to L1DFD, LAST exit if argument zero ;; with zero result. ; else continue to calculate as x ** .5 DEFB $A2 ;;stk-half x, .5. DEFB $34 ;;end-calc x, .5. ; ------------------------------ ; THE 'EXPONENTIATION' OPERATION ; ------------------------------ ; (Offset $06: 'to-power') ; This raises the first number X to the power of the second number Y. ; As with the ZX80, ; 0 ** 0 = 1 ; 0 ** +n = 0 ; 0 ** -n = arithmetic overflow. ;; to-power L1DE2: RST 28H ;; FP-CALC X,Y. DEFB $01 ;;exchange Y,X. DEFB $2D ;;duplicate Y,X,X. DEFB $2C ;;not Y,X,(1/0). DEFB $00 ;;jump-true DEFB $07 ;;forward to L1DEE, XISO if X is zero. ; else X is non-zero. function 'ln' will catch a negative value of X. DEFB $22 ;;ln Y, LN X. DEFB $04 ;;multiply Y * LN X DEFB $34 ;;end-calc JP L1C5B ; jump back to EXP routine. -> ; --- ; These routines form the three simple results when the number is zero. ; begin by deleting the known zero to leave Y the power factor. ;; XISO L1DEE: DEFB $02 ;;delete Y. DEFB $2D ;;duplicate Y, Y. DEFB $2C ;;not Y, (1/0). DEFB $00 ;;jump-true DEFB $09 ;;forward to L1DFB, ONE if Y is zero. ; the power factor is not zero. If negative then an error exists. DEFB $A0 ;;stk-zero Y, 0. DEFB $01 ;;exchange 0, Y. DEFB $33 ;;greater-0 0, (1/0). DEFB $00 ;;jump-true 0 DEFB $06 ;;to L1DFD, LAST if Y was any positive ;; number. ; else force division by zero thereby raising an Arithmetic overflow error. ; There are some one and two-byte alternatives but perhaps the most formal ; might have been to use end-calc; rst 08; defb 05. DEFB $A1 ;;stk-one 0, 1. DEFB $01 ;;exchange 1, 0. DEFB $05 ;;division 1/0 >> error ; --- ;; ONE L1DFB: DEFB $02 ;;delete . DEFB $A1 ;;stk-one 1. ;; LAST L1DFD: DEFB $34 ;;end-calc last value 1 or 0. RET ; return. ; --------------------- ; THE 'SPARE LOCATIONS' ; --------------------- ;; SPARE L1DFF: DEFB $FF ; That's all folks. ; ------------------------ ; THE 'ZX81 CHARACTER SET' ; ------------------------ ;; char-set - begins with space character. ; $00 - Character: ' ' CHR$(0) L1E00: DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $01 - Character: mosaic CHR$(1) DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $02 - Character: mosaic CHR$(2) DEFB %00001111 DEFB %00001111 DEFB %00001111 DEFB %00001111 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $03 - Character: mosaic CHR$(3) DEFB %11111111 DEFB %11111111 DEFB %11111111 DEFB %11111111 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $04 - Character: mosaic CHR$(4) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 ; $05 - Character: mosaic CHR$(5) DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 ; $06 - Character: mosaic CHR$(6) DEFB %00001111 DEFB %00001111 DEFB %00001111 DEFB %00001111 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 ; $07 - Character: mosaic CHR$(7) DEFB %11111111 DEFB %11111111 DEFB %11111111 DEFB %11111111 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 ; $08 - Character: mosaic CHR$(8) DEFB %10101010 DEFB %01010101 DEFB %10101010 DEFB %01010101 DEFB %10101010 DEFB %01010101 DEFB %10101010 DEFB %01010101 ; $09 - Character: mosaic CHR$(9) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %10101010 DEFB %01010101 DEFB %10101010 DEFB %01010101 ; $0A - Character: mosaic CHR$(10) DEFB %10101010 DEFB %01010101 DEFB %10101010 DEFB %01010101 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $0B - Character: '"' CHR$(11) DEFB %00000000 DEFB %00100100 DEFB %00100100 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $0B - Character: ukp CHR$(12) DEFB %00000000 DEFB %00011100 DEFB %00100010 DEFB %01111000 DEFB %00100000 DEFB %00100000 DEFB %01111110 DEFB %00000000 ; $0B - Character: '$' CHR$(13) DEFB %00000000 DEFB %00001000 DEFB %00111110 DEFB %00101000 DEFB %00111110 DEFB %00001010 DEFB %00111110 DEFB %00001000 ; $0B - Character: ':' CHR$(14) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00010000 DEFB %00000000 DEFB %00000000 DEFB %00010000 DEFB %00000000 ; $0B - Character: '?' CHR$(15) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %00000100 DEFB %00001000 DEFB %00000000 DEFB %00001000 DEFB %00000000 ; $10 - Character: '(' CHR$(16) DEFB %00000000 DEFB %00000100 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00000100 DEFB %00000000 ; $11 - Character: ')' CHR$(17) DEFB %00000000 DEFB %00100000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00100000 DEFB %00000000 ; $12 - Character: '>' CHR$(18) DEFB %00000000 DEFB %00000000 DEFB %00010000 DEFB %00001000 DEFB %00000100 DEFB %00001000 DEFB %00010000 DEFB %00000000 ; $13 - Character: '<' CHR$(19) DEFB %00000000 DEFB %00000000 DEFB %00000100 DEFB %00001000 DEFB %00010000 DEFB %00001000 DEFB %00000100 DEFB %00000000 ; $14 - Character: '=' CHR$(20) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00111110 DEFB %00000000 DEFB %00111110 DEFB %00000000 DEFB %00000000 ; $15 - Character: '+' CHR$(21) DEFB %00000000 DEFB %00000000 DEFB %00001000 DEFB %00001000 DEFB %00111110 DEFB %00001000 DEFB %00001000 DEFB %00000000 ; $16 - Character: '-' CHR$(22) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00111110 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $17 - Character: '*' CHR$(23) DEFB %00000000 DEFB %00000000 DEFB %00010100 DEFB %00001000 DEFB %00111110 DEFB %00001000 DEFB %00010100 DEFB %00000000 ; $18 - Character: '/' CHR$(24) DEFB %00000000 DEFB %00000000 DEFB %00000010 DEFB %00000100 DEFB %00001000 DEFB %00010000 DEFB %00100000 DEFB %00000000 ; $19 - Character: ';' CHR$(25) DEFB %00000000 DEFB %00000000 DEFB %00010000 DEFB %00000000 DEFB %00000000 DEFB %00010000 DEFB %00010000 DEFB %00100000 ; $1A - Character: ',' CHR$(26) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00001000 DEFB %00001000 DEFB %00010000 ; $1B - Character: '.' CHR$(27) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00011000 DEFB %00011000 DEFB %00000000 ; $1C - Character: '0' CHR$(28) DEFB %00000000 DEFB %00111100 DEFB %01000110 DEFB %01001010 DEFB %01010010 DEFB %01100010 DEFB %00111100 DEFB %00000000 ; $1D - Character: '1' CHR$(29) DEFB %00000000 DEFB %00011000 DEFB %00101000 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00111110 DEFB %00000000 ; $1E - Character: '2' CHR$(30) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %00000010 DEFB %00111100 DEFB %01000000 DEFB %01111110 DEFB %00000000 ; $1F - Character: '3' CHR$(31) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %00001100 DEFB %00000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $20 - Character: '4' CHR$(32) DEFB %00000000 DEFB %00001000 DEFB %00011000 DEFB %00101000 DEFB %01001000 DEFB %01111110 DEFB %00001000 DEFB %00000000 ; $21 - Character: '5' CHR$(33) DEFB %00000000 DEFB %01111110 DEFB %01000000 DEFB %01111100 DEFB %00000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $22 - Character: '6' CHR$(34) DEFB %00000000 DEFB %00111100 DEFB %01000000 DEFB %01111100 DEFB %01000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $23 - Character: '7' CHR$(35) DEFB %00000000 DEFB %01111110 DEFB %00000010 DEFB %00000100 DEFB %00001000 DEFB %00010000 DEFB %00010000 DEFB %00000000 ; $24 - Character: '8' CHR$(36) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %00111100 DEFB %01000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $25 - Character: '9' CHR$(37) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %01000010 DEFB %00111110 DEFB %00000010 DEFB %00111100 DEFB %00000000 ; $26 - Character: 'A' CHR$(38) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %01000010 DEFB %01111110 DEFB %01000010 DEFB %01000010 DEFB %00000000 ; $27 - Character: 'B' CHR$(39) DEFB %00000000 DEFB %01111100 DEFB %01000010 DEFB %01111100 DEFB %01000010 DEFB %01000010 DEFB %01111100 DEFB %00000000 ; $28 - Character: 'C' CHR$(40) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %01000000 DEFB %01000000 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $29 - Character: 'D' CHR$(41) DEFB %00000000 DEFB %01111000 DEFB %01000100 DEFB %01000010 DEFB %01000010 DEFB %01000100 DEFB %01111000 DEFB %00000000 ; $2A - Character: 'E' CHR$(42) DEFB %00000000 DEFB %01111110 DEFB %01000000 DEFB %01111100 DEFB %01000000 DEFB %01000000 DEFB %01111110 DEFB %00000000 ; $2B - Character: 'F' CHR$(43) DEFB %00000000 DEFB %01111110 DEFB %01000000 DEFB %01111100 DEFB %01000000 DEFB %01000000 DEFB %01000000 DEFB %00000000 ; $2C - Character: 'G' CHR$(44) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %01000000 DEFB %01001110 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $2D - Character: 'H' CHR$(45) DEFB %00000000 DEFB %01000010 DEFB %01000010 DEFB %01111110 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %00000000 ; $2E - Character: 'I' CHR$(46) DEFB %00000000 DEFB %00111110 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00111110 DEFB %00000000 ; $2F - Character: 'J' CHR$(47) DEFB %00000000 DEFB %00000010 DEFB %00000010 DEFB %00000010 DEFB %01000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $30 - Character: 'K' CHR$(48) DEFB %00000000 DEFB %01000100 DEFB %01001000 DEFB %01110000 DEFB %01001000 DEFB %01000100 DEFB %01000010 DEFB %00000000 ; $31 - Character: 'L' CHR$(49) DEFB %00000000 DEFB %01000000 DEFB %01000000 DEFB %01000000 DEFB %01000000 DEFB %01000000 DEFB %01111110 DEFB %00000000 ; $32 - Character: 'M' CHR$(50) DEFB %00000000 DEFB %01000010 DEFB %01100110 DEFB %01011010 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %00000000 ; $33 - Character: 'N' CHR$(51) DEFB %00000000 DEFB %01000010 DEFB %01100010 DEFB %01010010 DEFB %01001010 DEFB %01000110 DEFB %01000010 DEFB %00000000 ; $34 - Character: 'O' CHR$(52) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $35 - Character: 'P' CHR$(53) DEFB %00000000 DEFB %01111100 DEFB %01000010 DEFB %01000010 DEFB %01111100 DEFB %01000000 DEFB %01000000 DEFB %00000000 ; $36 - Character: 'Q' CHR$(54) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %01000010 DEFB %01010010 DEFB %01001010 DEFB %00111100 DEFB %00000000 ; $37 - Character: 'R' CHR$(55) DEFB %00000000 DEFB %01111100 DEFB %01000010 DEFB %01000010 DEFB %01111100 DEFB %01000100 DEFB %01000010 DEFB %00000000 ; $38 - Character: 'S' CHR$(56) DEFB %00000000 DEFB %00111100 DEFB %01000000 DEFB %00111100 DEFB %00000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $39 - Character: 'T' CHR$(57) DEFB %00000000 DEFB %11111110 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00000000 ; $3A - Character: 'U' CHR$(58) DEFB %00000000 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $3B - Character: 'V' CHR$(59) DEFB %00000000 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %00100100 DEFB %00011000 DEFB %00000000 ; $3C - Character: 'W' CHR$(60) DEFB %00000000 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %01011010 DEFB %00100100 DEFB %00000000 ; $3D - Character: 'X' CHR$(61) DEFB %00000000 DEFB %01000010 DEFB %00100100 DEFB %00011000 DEFB %00011000 DEFB %00100100 DEFB %01000010 DEFB %00000000 ; $3E - Character: 'Y' CHR$(62) DEFB %00000000 DEFB %10000010 DEFB %01000100 DEFB %00101000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00000000 ; $3F - Character: 'Z' CHR$(63) DEFB %00000000 DEFB %01111110 DEFB %00000100 DEFB %00001000 DEFB %00010000 DEFB %00100000 DEFB %01111110 DEFB %00000000 .END ;TASM assembler instruction.