wearmouth:assembly_listing_of_the_operating_system_of_the_sinclair_zx81
; =========================================================== ; 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 ; £ 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 'x<y' the same logic is used but the two values are first swapped on the ; calculator stack. ; For 'x=y' NOT is applied to the subtraction result yielding true if the ; difference was zero and false with anything else. ; The first three numeric comparisons are just the opposite of the last three ; so the same processing steps are used and then a final NOT is applied. ; ; literal Test No sub 8 ExOrNot 1st RRCA exch sub ? End-Tests ; ========= ==== == ======== === ======== ======== ==== === = === === === ; no-l-eql x<=y 09 00000001 dec 00000000 00000000 ---- x-y ? --- >0? 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 x<y 0D 00000101 - 00000101 10000010c swap y-x ? --- >0? --- ; 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$<y$ 15 00001101 - 00001101 10000110c swap y$x$ 0 !or >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$(1) DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 ; $06 - Character: mosaic CHR$(1) DEFB %00001111 DEFB %00001111 DEFB %00001111 DEFB %00001111 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 ; $07 - Character: mosaic CHR$(1) DEFB %11111111 DEFB %11111111 DEFB %11111111 DEFB %11111111 DEFB %11110000 DEFB %11110000 DEFB %11110000 DEFB %11110000 ; $08 - Character: mosaic CHR$(1) DEFB %10101010 DEFB %01010101 DEFB %10101010 DEFB %01010101 DEFB %10101010 DEFB %01010101 DEFB %10101010 DEFB %01010101 ; $09 - Character: mosaic CHR$(1) 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: £ 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.
wearmouth/assembly_listing_of_the_operating_system_of_the_sinclair_zx81.txt · Last modified: 2022/03/21 13:06 by 127.0.0.1