assembly_listing_of_the_operating_system_of_the_sinclair_zx81
This is an old revision of the document!
; =========================================================== ; 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 <b><font color=#333388>'START'</font></b> ; ----------- ; All Z80 chips start at location zero. ; At start-up the Interrupt Mode is 0, ZX computers use Interrupt Mode 1. ; Interrupts are disabled . <a name="L0000"></a>;; <b>START</b> 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 <A href="#L03CB">L03CB</a> ; Jump forward to RAM-CHECK. ; ------------------- ; THE <b><font color=#333388>'ERROR'</font></b> 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. <a name="L0008"></a>;; <b>ERROR-1</b> L0008: LD HL,($4016) ; fetch character address from CH_ADD. LD ($4018),HL ; and set the error pointer X_PTR. JR <A href="#L0056">L0056</a> ; forward to continue at ERROR-2. ; ------------------------------- ; THE <b><font color=#333388>'PRINT A CHARACTER'</font></b> 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. <a name="L0010"></a>;; <b>PRINT-A</b> L0010: AND A ; test for zero - space. JP NZ,<A href="#L07F1">L07F1</a> ; jump forward if not to PRINT-CH. JP <A href="#L07F5">L07F5</a> ; jump forward to PRINT-SP. ; --- DEFB $FF ; unused location. ; --------------------------------- ; THE <b><font color=#333388>'COLLECT A CHARACTER'</font></b> 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. <a name="L0018"></a>;; <b>GET-CHAR</b> L0018: LD HL,($4016) ; set HL to character address CH_ADD. LD A,(HL) ; fetch addressed character to A. <a name="L001C"></a>;; <b>TEST-SP</b> L001C: AND A ; test for space. RET NZ ; return if not a space NOP ; else trickle through NOP ; to the next routine. ; ------------------------------------ ; THE <b><font color=#333388>'COLLECT NEXT CHARACTER'</font></b> RESTART ; ------------------------------------ ; The character address in incremented and the new addressed character is returned if not a space, or cursor, else the process is repeated. <a name="L0020"></a>;; <b>NEXT-CHAR</b> L0020: CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 gets next immediate character. JR <A href="#L001C">L001C</a> ; back to TEST-SP. ; --- DEFB $FF, $FF, $FF ; unused locations. ; --------------------------------------- ; THE <b><font color=#333388>'FLOATING POINT CALCULATOR'</font></b> 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. <a name="L0028"></a>;; <b>FP-CALC</b> L0028: JP <A href="#L199D">L199D</a> ; jump immediately to the CALCULATE routine. ; --- <a name="L002B"></a>;; <b>end-calc</b> 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 <b><font color=#333388>'MAKE BC SPACES'</font></b> RESTART ; ----------------------------- ; This restart is used eight times to create, in workspace, the number of spaces passed in the BC register. <a name="L0030"></a>;; <b>BC-SPACES</b> 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 <A href="#L1488">L1488</a> ; jump forward to continue at RESERVE. ; ----------------------- ; THE <b><font color=#333388>'INTERRUPT'</font></b> 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 . <a name="L0038"></a>;; <b>INTERRUPT</b> L0038: DEC C ; (4) decrement C - the scan line counter. JP NZ,<A href="#L0045">L0045</a> ; (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. ; <font color=#9900FF>Note.</font> LD C,$08 is 7 clock cycles which ; is way too fast. ; -> <a name="L0041"></a>;; <b>WAIT-INT</b> 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 ] ; --- <a name="L0045"></a>;; <b>SCAN-LINE</b> 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 <A href="#L0041">L0041</a> ; (12) back to WAIT-INT ; <font color=#9900FF>Note.</font> 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 <b><font color=#333388>'INCREMENT CH-ADD'</font></b> 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. <a name="L0049"></a>;; <b>CH-ADD+1</b> L0049: LD HL,($4016) ; fetch character address to CH_ADD. <a name="L004C"></a>;; <b>TEMP-PTR1</b> L004C: INC HL ; address next immediate location. <a name="L004D"></a>;; <b>TEMP-PTR2</b> 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 <A href="#L004C">L004C</a> ; back for next character to TEMP-PTR1. ; -------------------- ; THE <b><font color=#333388>'ERROR-2'</font></b> 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. <a name="L0056"></a>;; <b>ERROR-2</b> 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. <a name="L0058"></a>;; <b>ERROR-3</b> L0058: LD (IY+$00),L ; place error code in system variable ERR_NR LD SP,($4002) ; set the stack pointer from ERR_SP CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST selects slow mode. JP <A href="#L14BC">L14BC</a> ; exit to address on stack via routine SET-MIN. ; --- DEFB $FF ; unused. ; ------------------------------------ ; THE <b><font color=#333388>'NON MASKABLE INTERRUPT'</font></b> 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 ). <a name="L0066"></a>;; <b>NMI</b> L0066: EX AF,AF' ; (4) switch in the NMI's copy of the ; accumulator. INC A ; (4) increment. JP M,<A href="#L006D">L006D</a> ; (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,<A href="#L006F">L006F</a> ; (12) forward to NMI-CONT ; when line count has incremented to zero. ; <font color=#9900FF>Note.</font> the synchronizing NMI when A increments from zero to one takes this ; 7 clock cycle route making 39 clock cycles in all. <a name="L006D"></a>;; <b>NMI-RET</b> 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. <a name="L006F"></a>;; <b>NMI-CONT</b> 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 <A href="#L0281">L0281</a> up to and including the CALL = 43 cycles. ; The Called routine at <A href="#L02B5">L02B5</a> = 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 <b><font color=#333388>'UNSHIFTED'</font></b> CHARACTER CODES ; ------------------------------- <a name="L007E"></a>;; <b>K-UNSHIFT</b> 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 <b><font color=#333388>'SHIFTED'</font></b> CHARACTER CODES ; ----------------------------- <a name="L00A5"></a>;; <b>K-SHIFT</b> 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 <b><font color=#333388>'FUNCTION'</font></b> CHARACTER CODES ; ------------------------------ <a name="L00CC"></a>;; <b>K-FUNCT</b> 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 <b><font color=#333388>'GRAPHIC'</font></b> CHARACTER CODES ; ----------------------------- <a name="L00F3"></a>;; <b>K-GRAPH</b> 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 <b><font color=#333388>'TOKEN'</font></b> TABLES ; ------------------ <a name="L094B"></a>;; <b>TOKENS</b> 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 <b><font color=#333388>'LOAD-SAVE UPDATE'</font></b> ROUTINE ; ------------------------------ ; ; <a name="L01FC"></a>;; <b>LOAD/SAVE</b> 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 <b><font color=#333388>'DISPLAY'</font></b> ROUTINES ; ---------------------- ; ; <a name="L0207"></a>;; <b>SLOW/FAST</b> 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'. <a name="L0216"></a>;; <b>LOOP-11</b> L0216: DJNZ <A href="#L0216">L0216</a> ; 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,<A href="#L0226">L0226</a> ; 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 <A href="#L0229">L0229</a> ; skip forward - to DISPLAY-1. ; --- <a name="L0226"></a>;; <b>NO-SLOW</b> L0226: RES 6,(HL) ; reset bit 6 of CDFLAG. RET ; return. ; ----------------------- ; THE <b><font color=#333388>'MAIN DISPLAY'</font></b> LOOP ; ----------------------- ; This routine is executed once for every frame displayed. <a name="L0229"></a>;; <b>DISPLAY-1</b> L0229: LD HL,($4034) ; fetch two-byte system variable FRAMES. DEC HL ; decrement frames counter. <a name="L022D"></a>;; <b>DISPLAY-P</b> 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,<A href="#L0237">L0237</a> ; (12/7) forward if bits 14-0 are not zero ; to ANOTHER RLA ; (4) test bit 15 of FRAMES. JR <A href="#L0239">L0239</a> ; (12) forward with result to OVER-NC ; --- <a name="L0237"></a>;; <b>ANOTHER</b> L0237: LD B,(HL) ; (7) <font color=#9900FF>Note.</font> Harmless Nonsensical Timing weight. SCF ; (4) Set Carry Flag. ; <font color=#9900FF>Note.</font> the branch to here takes either (12)(7)(4) cyles or (7)(4)(12) cycles. <a name="L0239"></a>;; <b>OVER-NC</b> 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. <a name="L023E"></a>;; <b>DISPLAY-2</b> L023E: CALL <A href="#L02BB">L02BB</a> ; 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,<A href="#L0264">L0264</a> ; 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 <a name="L0264"></a>;; <b>NO-KEY</b> L0264: LD HL,$4027 ; sv DEBOUNCE CCF ; Complement Carry Flag RL B ; rotate left B picking up carry ; C<-76543210<-C <a name="L026A"></a>;; <b>LOOP-B</b> L026A: DJNZ <A href="#L026A">L026A</a> ; 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 <A href="#L0292">L0292</a> ; (17) routine DISPLAY-3 displays the top set ; of blank lines. ; --------------------- ; THE <b><font color=#333388>'VIDEO-1'</font></b> ROUTINE ; --------------------- <a name="L0281"></a>;; <b>R-IX-1</b> 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 <A href="#L02B5">L02B5</a> ; (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 <A href="#L0292">L0292</a> ; routine DISPLAY-3 displays the bottom set of ; blank lines. ; --- <a name="L028F"></a>;; <b>R-IX-2</b> L028F: JP <A href="#L0229">L0229</a> ; JUMP back to DISPLAY-1 ; --------------------------------- ; THE <b><font color=#333388>'DISPLAY BLANK LINES'</font></b> 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. <a name="L0292"></a>;; <b>DISPLAY-3</b> 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,<A href="#L02A9">L02A9</a> ; 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 <b><font color=#333388>'FAST MODE'</font></b> ROUTINES ; ------------------------ <a name="L02A9"></a>;; <b>DISPLAY-4</b> L02A9: LD A,$FC ; (7) load A with first R delay value LD B,$01 ; (7) one row only. CALL <A href="#L02B5">L02B5</a> ; (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 <b><font color=#333388>'DISPLAY-5'</font></b> 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) <a name="L02B5"></a>;; <b>DISPLAY-5</b> 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 <b><font color=#333388>'KEYBOARD SCANNING'</font></b> 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. <a name="L02BB"></a>;; <b>KEYBOARD</b> 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. <a name="L02C5"></a>;; <b>EACH-LINE</b> 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,<A href="#L02C5">L02C5</a> ; [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 <b><font color=#333388>'SET FAST MODE'</font></b> SUBROUTINE ; ------------------------------ ; ; <a name="L02E7"></a>;; <b>SET-FAST</b> 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 <b><font color=#333388>'REPORT-F'</font></b> ; -------------- <a name="L02F4"></a>;; <b>REPORT-F</b> L02F4: RST 08H ; ERROR-1 DEFB $0E ; Error Report: No Program Name supplied. ; -------------------------- ; THE <b><font color=#333388>'SAVE COMMAND'</font></b> ROUTINE ; -------------------------- ; ; <a name="L02F6"></a>;; <b>SAVE</b> L02F6: CALL <A href="#L03A8">L03A8</a> ; routine NAME JR C,<A href="#L02F4">L02F4</a> ; back with null name to REPORT-F above. EX DE,HL ; LD DE,$12CB ; five seconds timing value <a name="L02FF"></a>;; <b>HEADER</b> L02FF: CALL <A href="#L0F46">L0F46</a> ; routine BREAK-1 JR NC,<A href="#L0332">L0332</a> ; to BREAK-2 <a name="L0304"></a>;; <b>DELAY-1</b> L0304: DJNZ <A href="#L0304">L0304</a> ; to DELAY-1 DEC DE ; LD A,D ; OR E ; JR NZ,<A href="#L02FF">L02FF</a> ; back for delay to HEADER <a name="L030B"></a>;; <b>OUT-NAME</b> L030B: CALL <A href="#L031E">L031E</a> ; routine OUT-BYTE BIT 7,(HL) ; test for inverted bit. INC HL ; address next character of name. JR Z,<A href="#L030B">L030B</a> ; 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. <a name="L0316"></a>;; <b>OUT-PROG</b> L0316: CALL <A href="#L031E">L031E</a> ; routine OUT-BYTE CALL <A href="#L01FC">L01FC</a> ; routine LOAD/SAVE >> JR <A href="#L0316">L0316</a> ; loop back to OUT-PROG ; ------------------------- ; THE <b><font color=#333388>'OUT-BYTE'</font></b> SUBROUTINE ; ------------------------- ; This subroutine outputs a byte a bit at a time to a domestic tape recorder. <a name="L031E"></a>;; <b>OUT-BYTE</b> L031E: LD E,(HL) ; fetch byte to be saved. SCF ; set carry flag - as a marker. <a name="L0320"></a>;; <b>EACH-BIT</b> 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. <a name="L0329"></a>;; <b>PULSES</b> L0329: OUT ($FF),A ; pulse to cassette. LD B,$23 ; set timing constant <a name="L032D"></a>;; <b>DELAY-2</b> L032D: DJNZ <A href="#L032D">L032D</a> ; self-loop to DELAY-2 CALL <A href="#L0F46">L0F46</a> ; routine BREAK-1 test for BREAK key. <a name="L0332"></a>;; <b>BREAK-2</b> L0332: JR NC,<A href="#L03A6">L03A6</a> ; forward with break to REPORT-D LD B,$1E ; set timing value. <a name="L0336"></a>;; <b>DELAY-3</b> L0336: DJNZ <A href="#L0336">L0336</a> ; self-loop to DELAY-3 DEC C ; decrement counter JR NZ,<A href="#L0329">L0329</a> ; loop back to PULSES <a name="L033B"></a>;; <b>DELAY-4</b> L033B: AND A ; clear carry for next bit test. DJNZ <A href="#L033B">L033B</a> ; self loop to DELAY-4 (B is zero - 256) JR <A href="#L0320">L0320</a> ; loop back to EACH-BIT ; -------------------------- ; THE <b><font color=#333388>'LOAD COMMAND'</font></b> ROUTINE ; -------------------------- ; ; <a name="L0340"></a>;; <b>LOAD</b> L0340: CALL <A href="#L03A8">L03A8</a> ; routine NAME ; DE points to start of name in RAM. RL D ; pick up carry RRC D ; carry now in bit 7. <a name="L0347"></a>;; <b>NEXT-PROG</b> L0347: CALL <A href="#L034C">L034C</a> ; routine IN-BYTE JR <A href="#L0347">L0347</a> ; loop to NEXT-PROG ; ------------------------ ; THE <b><font color=#333388>'IN-BYTE'</font></b> SUBROUTINE ; ------------------------ <a name="L034C"></a>;; <b>IN-BYTE</b> L034C: LD C,$01 ; prepare an eight counter 00000001. <a name="L034E"></a>;; <b>NEXT-BIT</b> L034E: LD B,$00 ; set counter to 256 <a name="L0350"></a>;; <b>BREAK-3</b> 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,<A href="#L03A2">L03A2</a> ; forward if so to BREAK-4 RLA ; reverse above rotation RLA ; test tape bit. JR C,<A href="#L0385">L0385</a> ; forward if set to GET-BIT DJNZ <A href="#L0350">L0350</a> ; loop back to BREAK-3 POP AF ; drop the return address. CP D ; ugh. <a name="L0361"></a>;; <b>RESTART</b> L0361: JP NC,<A href="#L03E5">L03E5</a> ; 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 <a name="L0366"></a>;; <b>IN-NAME</b> L0366: CALL <A href="#L034C">L034C</a> ; 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,<A href="#L0371">L0371</a> ; forward with null string to MATCHING CP (HL) ; else compare with string in memory. JR NZ,<A href="#L0347">L0347</a> ; back with mis-match to NEXT-PROG ; (seemingly out of subroutine but return ; address has been dropped). <a name="L0371"></a>;; <b>MATCHING</b> L0371: INC HL ; address next character of name RLA ; test for inverted bit. JR NC,<A href="#L0366">L0366</a> ; 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. <a name="L037B"></a>;; <b>IN-PROG</b> L037B: LD D,B ; set D to zero as indicator. CALL <A href="#L034C">L034C</a> ; routine IN-BYTE loads a byte LD (HL),C ; insert assembled byte in memory. CALL <A href="#L01FC">L01FC</a> ; routine LOAD/SAVE >> JR <A href="#L037B">L037B</a> ; loop back to IN-PROG ; --- ; this branch assembles a full byte before exiting normally ; from the IN-BYTE subroutine. <a name="L0385"></a>;; <b>GET-BIT</b> L0385: PUSH DE ; save the LD E,$94 ; timing value. <a name="L0388"></a>;; <b>TRAILER</b> L0388: LD B,$1A ; counter to twenty six. <a name="L038A"></a>;; <b>COUNTER</b> L038A: DEC E ; decrement the measuring timer. IN A,($FE) ; read the RLA ; BIT 7,E ; LD A,E ; JR C,<A href="#L0388">L0388</a> ; loop back with carry to TRAILER DJNZ <A href="#L038A">L038A</a> ; to COUNTER POP DE ; JR NZ,<A href="#L039C">L039C</a> ; to BIT-DONE CP $56 ; JR NC,<A href="#L034E">L034E</a> ; to NEXT-BIT <a name="L039C"></a>;; <b>BIT-DONE</b> L039C: CCF ; complement carry flag RL C ; JR NC,<A href="#L034E">L034E</a> ; 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. <a name="L03A2"></a>;; <b>BREAK-4</b> L03A2: LD A,D ; transfer indicator to A. AND A ; test for zero. JR Z,<A href="#L0361">L0361</a> ; back if so to RESTART <a name="L03A6"></a>;; <b>REPORT-D</b> L03A6: RST 08H ; ERROR-1 DEFB $0C ; Error Report: BREAK - CONT repeats ; ----------------------------- ; THE <b><font color=#333388>'PROGRAM NAME'</font></b> SUBROUTINE ; ----------------------------- ; ; <a name="L03A8"></a>;; <b>NAME</b> L03A8: CALL <A href="#L0F55">L0F55</a> ; routine SCANNING LD A,($4001) ; sv FLAGS ADD A,A ; JP M,<A href="#L0D9A">L0D9A</a> ; to REPORT-C POP HL ; RET NC ; PUSH HL ; CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH LD H,D ; LD L,E ; DEC C ; RET M ; ADD HL,BC ; SET 7,(HL) ; RET ; ; ------------------------- ; THE <b><font color=#333388>'NEW'</font></b> COMMAND ROUTINE ; ------------------------- ; ; <a name="L03C3"></a>;; <b>NEW</b> L03C3: CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST LD BC,($4004) ; fetch value of system variable RAMTOP DEC BC ; point to last system byte. ; ----------------------- ; THE <b><font color=#333388>'RAM CHECK'</font></b> ROUTINE ; ----------------------- ; ; <a name="L03CB"></a>;; <b>RAM-CHECK</b> L03CB: LD H,B ; LD L,C ; LD A,$3F ; <a name="L03CF"></a>;; <b>RAM-FILL</b> L03CF: LD (HL),$02 ; DEC HL ; CP H ; JR NZ,<A href="#L03CF">L03CF</a> ; to RAM-FILL <a name="L03D5"></a>;; <b>RAM-READ</b> L03D5: AND A ; SBC HL,BC ; ADD HL,BC ; INC HL ; JR NC,<A href="#L03E2">L03E2</a> ; to SET-TOP DEC (HL) ; JR Z,<A href="#L03E2">L03E2</a> ; to SET-TOP DEC (HL) ; JR Z,<A href="#L03D5">L03D5</a> ; to RAM-READ <a name="L03E2"></a>;; <b>SET-TOP</b> L03E2: LD ($4004),HL ; set system variable RAMTOP to first byte ; above the BASIC system area. ; ---------------------------- ; THE <b><font color=#333388>'INITIALIZATION'</font></b> ROUTINE ; ---------------------------- ; ; <a name="L03E5"></a>;; <b>INITIAL</b> 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. <a name="L0408"></a>;; <b>LINE</b> L0408: LD (HL),$76 ; insert NEWLINE (HALT instruction) INC HL ; point to next location. DJNZ <A href="#L0408">L0408</a> ; loop back for all twenty five to LINE LD ($4010),HL ; set system variable VARS to next location CALL <A href="#L149A">L149A</a> ; routine CLEAR sets $80 end-marker and the ; dynamic memory pointers E_LINE, STKBOT and ; STKEND. <a name="L0413"></a>;; <b>N/L-ONLY</b> L0413: CALL <A href="#L14AD">L14AD</a> ; routine CURSOR-IN inserts the cursor and ; end-marker in the Edit Line also setting ; size of lower display to two lines. CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST selects COMPUTE and DISPLAY ; --------------------------- ; THE <b><font color=#333388>'BASIC LISTING'</font></b> SECTION ; --------------------------- ; ; <a name="L0419"></a>;; <b>UPPER</b> L0419: CALL <A href="#L0A2A">L0A2A</a> ; 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,<A href="#L042D">L042D</a> ; to ADDR-TOP ADD HL,DE ; LD ($4023),HL ; sv S_TOP_lo <a name="L042D"></a>;; <b>ADDR-TOP</b> L042D: CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR JR Z,<A href="#L0433">L0433</a> ; to LIST-TOP EX DE,HL ; <a name="L0433"></a>;; <b>LIST-TOP</b> L0433: CALL <A href="#L073E">L073E</a> ; routine LIST-PROG DEC (IY+$1E) ; sv BERG JR NZ,<A href="#L0472">L0472</a> ; to LOWER LD HL,($400A) ; sv E_PPC_lo CALL <A href="#L09D8">L09D8</a> ; 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,<A href="#L0457">L0457</a> ; to INC-LINE EX DE,HL ; LD A,(HL) ; INC HL ; LDI ; LD (DE),A ; JR <A href="#L0419">L0419</a> ; to UPPER ; --- <a name="L0454"></a>;; <b>DOWN-KEY</b> L0454: LD HL,$400A ; sv E_PPC_lo <a name="L0457"></a>;; <b>INC-LINE</b> L0457: LD E,(HL) ; INC HL ; LD D,(HL) ; PUSH HL ; EX DE,HL ; INC HL ; CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR CALL <A href="#L05BB">L05BB</a> ; routine LINE-NO POP HL ; <a name="L0464"></a>;; <b>KEY-INPUT</b> L0464: BIT 5,(IY+$2D) ; sv FLAGX JR NZ,<A href="#L0472">L0472</a> ; forward to LOWER LD (HL),D ; DEC HL ; LD (HL),E ; JR <A href="#L0419">L0419</a> ; to UPPER ; ---------------------------- ; THE <b><font color=#333388>'EDIT LINE COPY'</font></b> 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 <a name="L046F"></a>;; <b>EDIT-INP</b> L046F: CALL <A href="#L14AD">L14AD</a> ; routine CURSOR-IN sets cursor only edit line. ; -> <a name="L0472"></a>;; <b>LOWER</b> L0472: LD HL,($4014) ; fetch edit line start from E_LINE. <a name="L0475"></a>;; <b>EACH-CHAR</b> L0475: LD A,(HL) ; fetch a character from edit line. CP $7E ; compare to the number marker. JR NZ,<A href="#L0482">L0482</a> ; forward if not to END-LINE LD BC,$0006 ; else six invisible bytes to be removed. CALL <A href="#L0A60">L0A60</a> ; routine RECLAIM-2 JR <A href="#L0475">L0475</a> ; back to EACH-CHAR ; --- <a name="L0482"></a>;; <b>END-LINE</b> L0482: CP $76 ; INC HL ; JR NZ,<A href="#L0475">L0475</a> ; to EACH-CHAR <a name="L0487"></a>;; <b>EDIT-LINE</b> L0487: CALL <A href="#L0537">L0537</a> ; routine CURSOR sets cursor K or L. <a name="L048A"></a>;; <b>EDIT-ROOM</b> L048A: CALL <A href="#L0A1F">L0A1F</a> ; routine LINE-ENDS LD HL,($4014) ; sv E_LINE_lo LD (IY+$00),$FF ; sv ERR_NR CALL <A href="#L0766">L0766</a> ; routine COPY-LINE BIT 7,(IY+$00) ; sv ERR_NR JR NZ,<A href="#L04C1">L04C1</a> ; to DISPLAY-6 LD A,($4022) ; sv DF_SZ CP $18 ; JR NC,<A href="#L04C1">L04C1</a> ; to DISPLAY-6 INC A ; LD ($4022),A ; sv DF_SZ LD B,A ; LD C,$01 ; CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR LD D,H ; LD E,L ; LD A,(HL) ; <a name="L04B1"></a>;; <b>FREE-LINE</b> L04B1: DEC HL ; CP (HL) ; JR NZ,<A href="#L04B1">L04B1</a> ; to FREE-LINE INC HL ; EX DE,HL ; LD A,($4005) ; sv RAMTOP_hi CP $4D ; CALL C,<A href="#L0A5D">L0A5D</a> ; routine RECLAIM-1 JR <A href="#L048A">L048A</a> ; to EDIT-ROOM ; -------------------------- ; THE <b><font color=#333388>'WAIT FOR KEY'</font></b> SECTION ; -------------------------- ; ; <a name="L04C1"></a>;; <b>DISPLAY-6</b> L04C1: LD HL,$0000 ; LD ($4018),HL ; sv X_PTR_lo LD HL,$403B ; system variable CDFLAG BIT 7,(HL) ; CALL Z,<A href="#L0229">L0229</a> ; routine DISPLAY-1 <a name="L04CF"></a>;; <b>SLOW-DISP</b> L04CF: BIT 0,(HL) ; JR Z,<A href="#L04CF">L04CF</a> ; to SLOW-DISP LD BC,($4025) ; sv LAST_K CALL <A href="#L0F4B">L0F4B</a> ; routine DEBOUNCE CALL <A href="#L07BD">L07BD</a> ; routine DECODE JR NC,<A href="#L0472">L0472</a> ; back to LOWER ; ------------------------------- ; THE <b><font color=#333388>'KEYBOARD DECODING'</font></b> SECTION ; ------------------------------- ; The decoded key value is in E and HL points to the position in the ; key table. D contains zero. <a name="L04DF"></a>;; <b>K-DECODE</b> L04DF: LD A,($4006) ; Fetch value of system variable MODE DEC A ; test the three values together JP M,<A href="#L0508">L0508</a> ; forward, if was zero, to FETCH-2 JR NZ,<A href="#L04F7">L04F7</a> ; 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,<A href="#L04F2">L04F2</a> ; forward, if so, to FUNC-BASE LD E,A ; else set E to reduced value <a name="L04F2"></a>;; <b>FUNC-BASE</b> L04F2: LD HL,<A href="#L00CC">L00CC</a> ; address of K-FUNCT table for function keys. JR <A href="#L0505">L0505</a> ; forward to TABLE-ADD ; --- <a name="L04F7"></a>;; <b>FETCH-1</b> L04F7: LD A,(HL) ; CP $76 ; JR Z,<A href="#L052B">L052B</a> ; to K/L-KEY CP $40 ; SET 7,A ; JR C,<A href="#L051B">L051B</a> ; to ENTER LD HL,$00C7 ; (expr reqd) <a name="L0505"></a>;; <b>TABLE-ADD</b> L0505: ADD HL,DE ; JR <A href="#L0515">L0515</a> ; to FETCH-3 ; --- <a name="L0508"></a>;; <b>FETCH-2</b> L0508: LD A,(HL) ; BIT 2,(IY+$01) ; sv FLAGS - K or L mode ? JR NZ,<A href="#L0516">L0516</a> ; to TEST-CURS ADD A,$C0 ; CP $E6 ; JR NC,<A href="#L0516">L0516</a> ; to TEST-CURS <a name="L0515"></a>;; <b>FETCH-3</b> L0515: LD A,(HL) ; <a name="L0516"></a>;; <b>TEST-CURS</b> L0516: CP $F0 ; JP PE,<A href="#L052D">L052D</a> ; to KEY-SORT <a name="L051B"></a>;; <b>ENTER</b> L051B: LD E,A ; CALL <A href="#L0537">L0537</a> ; routine CURSOR LD A,E ; CALL <A href="#L0526">L0526</a> ; routine ADD-CHAR <a name="L0523"></a>;; <b>BACK-NEXT</b> L0523: JP <A href="#L0472">L0472</a> ; back to LOWER ; ------------------------------ ; THE <b><font color=#333388>'ADD CHARACTER'</font></b> SUBROUTINE ; ------------------------------ ; ; <a name="L0526"></a>;; <b>ADD-CHAR</b> L0526: CALL <A href="#L099B">L099B</a> ; routine ONE-SPACE LD (DE),A ; RET ; ; ------------------------- ; THE <b><font color=#333388>'CURSOR KEYS'</font></b> ROUTINE ; ------------------------- ; ; <a name="L052B"></a>;; <b>K/L-KEY</b> L052B: LD A,$78 ; <a name="L052D"></a>;; <b>KEY-SORT</b> 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 ; <a name="L0537"></a>;; <b>CURSOR</b> L0537: LD HL,($4014) ; sv E_LINE_lo BIT 5,(IY+$2D) ; sv FLAGX JR NZ,<A href="#L0556">L0556</a> ; to L-MODE <a name="L0540"></a>;; <b>K-MODE</b> L0540: RES 2,(IY+$01) ; sv FLAGS - Signal use K mode <a name="L0544"></a>;; <b>TEST-CHAR</b> L0544: LD A,(HL) ; CP $7F ; RET Z ; return INC HL ; CALL <A href="#L07B4">L07B4</a> ; routine NUMBER JR Z,<A href="#L0544">L0544</a> ; to TEST-CHAR CP $26 ; JR C,<A href="#L0544">L0544</a> ; to TEST-CHAR CP $DE ; JR Z,<A href="#L0540">L0540</a> ; to K-MODE <a name="L0556"></a>;; <b>L-MODE</b> L0556: SET 2,(IY+$01) ; sv FLAGS - Signal use L mode JR <A href="#L0544">L0544</a> ; to TEST-CHAR ; -------------------------- ; THE <b><font color=#333388>'CLEAR-ONE'</font></b> SUBROUTINE ; -------------------------- ; ; <a name="L055C"></a>;; <b>CLEAR-ONE</b> L055C: LD BC,$0001 ; JP <A href="#L0A60">L0A60</a> ; to RECLAIM-2 ; ------------------------ ; THE <b><font color=#333388>'EDITING KEYS'</font></b> TABLE ; ------------------------ ; ; <a name="L0562"></a>;; <b>ED-KEYS</b> L0562: DEFW <A href="#L059F">L059F</a> ; Address: $059F; Address: UP-KEY DEFW <A href="#L0454">L0454</a> ; Address: $0454; Address: DOWN-KEY DEFW <A href="#L0576">L0576</a> ; Address: $0576; Address: LEFT-KEY DEFW <A href="#L057F">L057F</a> ; Address: $057F; Address: RIGHT-KEY DEFW <A href="#L05AF">L05AF</a> ; Address: $05AF; Address: FUNCTION DEFW <A href="#L05C4">L05C4</a> ; Address: $05C4; Address: EDIT-KEY DEFW <A href="#L060C">L060C</a> ; Address: $060C; Address: N/L-KEY DEFW <A href="#L058B">L058B</a> ; Address: $058B; Address: RUBOUT DEFW <A href="#L05AF">L05AF</a> ; Address: $05AF; Address: FUNCTION DEFW <A href="#L05AF">L05AF</a> ; Address: $05AF; Address: FUNCTION ; ------------------------- ; THE <b><font color=#333388>'CURSOR LEFT'</font></b> ROUTINE ; ------------------------- ; ; <a name="L0576"></a>;; <b>LEFT-KEY</b> L0576: CALL <A href="#L0593">L0593</a> ; routine LEFT-EDGE LD A,(HL) ; LD (HL),$7F ; INC HL ; JR <A href="#L0588">L0588</a> ; to GET-CODE ; -------------------------- ; THE <b><font color=#333388>'CURSOR RIGHT'</font></b> ROUTINE ; -------------------------- ; ; <a name="L057F"></a>;; <b>RIGHT-KEY</b> L057F: INC HL ; LD A,(HL) ; CP $76 ; JR Z,<A href="#L059D">L059D</a> ; to ENDED-2 LD (HL),$7F ; DEC HL ; <a name="L0588"></a>;; <b>GET-CODE</b> L0588: LD (HL),A ; <a name="L0589"></a>;; <b>ENDED-1</b> L0589: JR <A href="#L0523">L0523</a> ; to BACK-NEXT ; -------------------- ; THE <b><font color=#333388>'RUBOUT'</font></b> ROUTINE ; -------------------- ; ; <a name="L058B"></a>;; <b>RUBOUT</b> L058B: CALL <A href="#L0593">L0593</a> ; routine LEFT-EDGE CALL <A href="#L055C">L055C</a> ; routine CLEAR-ONE JR <A href="#L0589">L0589</a> ; to ENDED-1 ; ------------------------ ; THE <b><font color=#333388>'ED-EDGE'</font></b> SUBROUTINE ; ------------------------ ; ; <a name="L0593"></a>;; <b>LEFT-EDGE</b> L0593: DEC HL ; LD DE,($4014) ; sv E_LINE_lo LD A,(DE) ; CP $7F ; RET NZ ; POP DE ; <a name="L059D"></a>;; <b>ENDED-2</b> L059D: JR <A href="#L0589">L0589</a> ; to ENDED-1 ; ----------------------- ; THE <b><font color=#333388>'CURSOR UP'</font></b> ROUTINE ; ----------------------- ; ; <a name="L059F"></a>;; <b>UP-KEY</b> L059F: LD HL,($400A) ; sv E_PPC_lo CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR EX DE,HL ; CALL <A href="#L05BB">L05BB</a> ; routine LINE-NO LD HL,$400B ; point to system variable E_PPC_hi JP <A href="#L0464">L0464</a> ; jump back to KEY-INPUT ; -------------------------- ; THE <b><font color=#333388>'FUNCTION KEY'</font></b> ROUTINE ; -------------------------- ; ; <a name="L05AF"></a>;; <b>FUNCTION</b> L05AF: LD A,E ; AND $07 ; LD ($4006),A ; sv MODE JR <A href="#L059D">L059D</a> ; back to ENDED-2 ; ------------------------------------ ; THE <b><font color=#333388>'COLLECT LINE NUMBER'</font></b> SUBROUTINE ; ------------------------------------ ; ; <a name="L05B7"></a>;; <b>ZERO-DE</b> L05B7: EX DE,HL ; LD DE,<A href="#L04C1">L04C1</a> + 1 ; $04C2 - a location addressing two zeros. ; -> <a name="L05BB"></a>;; <b>LINE-NO</b> L05BB: LD A,(HL) ; AND $C0 ; JR NZ,<A href="#L05B7">L05B7</a> ; to ZERO-DE LD D,(HL) ; INC HL ; LD E,(HL) ; RET ; ; ---------------------- ; THE <b><font color=#333388>'EDIT KEY'</font></b> ROUTINE ; ---------------------- ; ; <a name="L05C4"></a>;; <b>EDIT-KEY</b> L05C4: CALL <A href="#L0A1F">L0A1F</a> ; routine LINE-ENDS clears lower display. LD HL,<A href="#L046F">L046F</a> ; 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 <A href="#L046F">L046F</a>, 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 <A href="#L09D8">L09D8</a> ; routine LINE-ADDR gets address or that of ; the following line. CALL <A href="#L05BB">L05BB</a> ; 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 <A href="#L0AA5">L0AA5</a> ; 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. ; <font color=#9900FF>Note.</font> 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 <A href="#L14A6">L14A6</a> ; routine SET-STK-B sets STKEND from HL. JR <A href="#L059D">L059D</a> ; back to ENDED-2 and after 3 more jumps ; to <A href="#L0472">L0472</a>, LOWER. ; <font color=#9900FF>Note.</font> The LOWER routine removes the hidden ; floating-point numbers from the edit line. ; ------------------------- ; THE <b><font color=#333388>'NEWLINE KEY'</font></b> ROUTINE ; ------------------------- ; ; <a name="L060C"></a>;; <b>N/L-KEY</b> L060C: CALL <A href="#L0A1F">L0A1F</a> ; routine LINE-ENDS LD HL,<A href="#L0472">L0472</a> ; prepare address: LOWER BIT 5,(IY+$2D) ; sv FLAGX JR NZ,<A href="#L0629">L0629</a> ; to NOW-SCAN LD HL,($4014) ; sv E_LINE_lo LD A,(HL) ; CP $FF ; JR Z,<A href="#L0626">L0626</a> ; to STK-UPPER CALL <A href="#L08E2">L08E2</a> ; routine CLEAR-PRB CALL <A href="#L0A2A">L0A2A</a> ; routine CLS <a name="L0626"></a>;; <b>STK-UPPER</b> L0626: LD HL,<A href="#L0419">L0419</a> ; Address: UPPER <a name="L0629"></a>;; <b>NOW-SCAN</b> L0629: PUSH HL ; push routine address (LOWER or UPPER). CALL <A href="#L0CBA">L0CBA</a> ; routine LINE-SCAN POP HL ; CALL <A href="#L0537">L0537</a> ; routine CURSOR CALL <A href="#L055C">L055C</a> ; routine CLEAR-ONE CALL <A href="#L0A73">L0A73</a> ; routine E-LINE-NO JR NZ,<A href="#L064E">L064E</a> ; to N/L-INP LD A,B ; OR C ; JP NZ,<A href="#L06E0">L06E0</a> ; 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 <A href="#L0661">L0661</a> ; forward to TEST-NULL ; --- <a name="L064E"></a>;; <b>N/L-INP</b> L064E: CP $76 ; JR Z,<A href="#L0664">L0664</a> ; to N/L-NULL LD BC,($4030) ; sv T_ADDR_lo CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR LD DE,($4029) ; sv NXTLIN_lo LD (IY+$22),$02 ; sv DF_SZ <a name="L0661"></a>;; <b>TEST-NULL</b> L0661: RST 18H ; GET-CHAR CP $76 ; <a name="L0664"></a>;; <b>N/L-NULL</b> L0664: JP Z,<A href="#L0413">L0413</a> ; to N/L-ONLY LD (IY+$01),$80 ; sv FLAGS EX DE,HL ; <a name="L066C"></a>;; <b>NEXT-LINE</b> L066C: LD ($4029),HL ; sv NXTLIN_lo EX DE,HL ; CALL <A href="#L004D">L004D</a> ; routine TEMP-PTR-2 CALL <A href="#L0CC1">L0CC1</a> ; 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 <A href="#L14A3">L14A3</a> ; routine X-TEMP RES 5,(IY+$2D) ; sv FLAGX BIT 7,(IY+$00) ; sv ERR_NR JR Z,<A href="#L06AE">L06AE</a> ; to STOP-LINE LD HL,($4029) ; sv NXTLIN_lo AND (HL) ; JR NZ,<A href="#L06AE">L06AE</a> ; 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 <A href="#L0F46">L0F46</a> ; routine BREAK-1 JR C,<A href="#L066C">L066C</a> ; to NEXT-LINE LD HL,$4000 ; sv ERR_NR BIT 7,(HL) ; JR Z,<A href="#L06AE">L06AE</a> ; to STOP-LINE LD (HL),$0C ; <a name="L06AE"></a>;; <b>STOP-LINE</b> L06AE: BIT 7,(IY+$38) ; sv PR_CC CALL Z,<A href="#L0871">L0871</a> ; routine COPY-BUFF LD BC,$0121 ; CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR LD A,($4000) ; sv ERR_NR LD BC,($4007) ; sv PPC_lo INC A ; JR Z,<A href="#L06D1">L06D1</a> ; to REPORT CP $09 ; JR NZ,<A href="#L06CA">L06CA</a> ; to CONTINUE INC BC ; <a name="L06CA"></a>;; <b>CONTINUE</b> L06CA: LD ($402B),BC ; sv OLDPPC_lo JR NZ,<A href="#L06D1">L06D1</a> ; to REPORT DEC BC ; <a name="L06D1"></a>;; <b>REPORT</b> L06D1: CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE LD A,$18 ; RST 10H ; PRINT-A CALL <A href="#L0A98">L0A98</a> ; routine OUT-NUM CALL <A href="#L14AD">L14AD</a> ; routine CURSOR-IN JP <A href="#L04C1">L04C1</a> ; to DISPLAY-6 ; --- <a name="L06E0"></a>;; <b>N/L-LINE</b> L06E0: LD ($400A),BC ; sv E_PPC_lo LD HL,($4016) ; sv CH_ADD_lo EX DE,HL ; LD HL,<A href="#L0413">L0413</a> ; Address: N/L-ONLY PUSH HL ; LD HL,($401A) ; sv STKBOT_lo SBC HL,DE ; PUSH HL ; PUSH BC ; CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST CALL <A href="#L0A2A">L0A2A</a> ; routine CLS POP HL ; CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR JR NZ,<A href="#L0705">L0705</a> ; to COPY-OVER CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE CALL <A href="#L0A60">L0A60</a> ; routine RECLAIM-2 <a name="L0705"></a>;; <b>COPY-OVER</b> 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 <A href="#L099E">L099E</a> ; routine MAKE-ROOM CALL <A href="#L0207">L0207</a> ; 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 <b><font color=#333388>'LIST'</font></b> AND 'LLIST' COMMAND ROUTINES ; --------------------------------------- ; ; <a name="L072C"></a>;; <b>LLIST</b> L072C: SET 1,(IY+$01) ; sv FLAGS - signal printer in use <a name="L0730"></a>;; <b>LIST</b> L0730: CALL <A href="#L0EA7">L0EA7</a> ; 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 <A href="#L09D8">L09D8</a> ; routine LINE-ADDR <a name="L073E"></a>;; <b>LIST-PROG</b> L073E: LD E,$00 ; <a name="L0740"></a>;; <b>UNTIL-END</b> L0740: CALL <A href="#L0745">L0745</a> ; 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 <A href="#L0740">L0740</a> ; loop back to UNTIL-END ; ----------------------------------- ; THE <b><font color=#333388>'PRINT A BASIC LINE'</font></b> SUBROUTINE ; ----------------------------------- ; ; <a name="L0745"></a>;; <b>OUT-LINE</b> L0745: LD BC,($400A) ; sv E_PPC_lo CALL <A href="#L09EA">L09EA</a> ; routine CP-LINES LD D,$92 ; JR Z,<A href="#L0755">L0755</a> ; to TEST-END LD DE,$0000 ; RL E ; <a name="L0755"></a>;; <b>TEST-END</b> L0755: LD (IY+$1E),E ; sv BERG LD A,(HL) ; CP $40 ; POP BC ; RET NC ; PUSH BC ; CALL <A href="#L0AA5">L0AA5</a> ; routine OUT-NO INC HL ; LD A,D ; RST 10H ; PRINT-A INC HL ; INC HL ; <a name="L0766"></a>;; <b>COPY-LINE</b> L0766: LD ($4016),HL ; sv CH_ADD_lo SET 0,(IY+$01) ; sv FLAGS - Suppress leading space <a name="L076D"></a>;; <b>MORE-LINE</b> L076D: LD BC,($4018) ; sv X_PTR_lo LD HL,($4016) ; sv CH_ADD_lo AND A ; SBC HL,BC ; JR NZ,<A href="#L077C">L077C</a> ; to TEST-NUM LD A,$B8 ; RST 10H ; PRINT-A <a name="L077C"></a>;; <b>TEST-NUM</b> L077C: LD HL,($4016) ; sv CH_ADD_lo LD A,(HL) ; INC HL ; CALL <A href="#L07B4">L07B4</a> ; routine NUMBER LD ($4016),HL ; sv CH_ADD_lo JR Z,<A href="#L076D">L076D</a> ; to MORE-LINE CP $7F ; JR Z,<A href="#L079D">L079D</a> ; to OUT-CURS CP $76 ; JR Z,<A href="#L07EE">L07EE</a> ; to OUT-CH BIT 6,A ; JR Z,<A href="#L079A">L079A</a> ; to NOT-TOKEN CALL <A href="#L094B">L094B</a> ; routine TOKENS JR <A href="#L076D">L076D</a> ; to MORE-LINE ; --- <a name="L079A"></a>;; <b>NOT-TOKEN</b> L079A: RST 10H ; PRINT-A JR <A href="#L076D">L076D</a> ; to MORE-LINE ; --- <a name="L079D"></a>;; <b>OUT-CURS</b> 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,<A href="#L07AA">L07AA</a> ; forward if not to FLAGS-2 LD A,($4001) ; Fetch system variable FLAGS. LD B,$B0 ; Prepare an inverse [K] for keyword cursor. <a name="L07AA"></a>;; <b>FLAGS-2</b> L07AA: RRA ; 00000?00 -> 000000?0 RRA ; 000000?0 -> 0000000? AND $01 ; 0000000? 0000000x ADD A,B ; Possibly [F] -> [G] or [K] -> [L] CALL <A href="#L07F5">L07F5</a> ; routine PRINT-SP prints character JR <A href="#L076D">L076D</a> ; back to MORE-LINE ; ----------------------- ; THE <b><font color=#333388>'NUMBER'</font></b> SUBROUTINE ; ----------------------- ; ; <a name="L07B4"></a>;; <b>NUMBER</b> L07B4: CP $7E ; RET NZ ; INC HL ; INC HL ; INC HL ; INC HL ; INC HL ; RET ; ; -------------------------------- ; THE <b><font color=#333388>'KEYBOARD DECODE'</font></b> SUBROUTINE ; -------------------------------- ; ; <a name="L07BD"></a>;; <b>DECODE</b> L07BD: LD D,$00 ; SRA B ; SBC A,A ; OR $26 ; LD L,$05 ; SUB L ; <a name="L07C7"></a>;; <b>KEY-LINE</b> L07C7: ADD A,L ; SCF ; Set Carry Flag RR C ; JR C,<A href="#L07C7">L07C7</a> ; to KEY-LINE INC C ; RET NZ ; LD C,B ; DEC L ; LD L,$01 ; JR NZ,<A href="#L07C7">L07C7</a> ; to KEY-LINE LD HL,$007D ; (expr reqd) LD E,A ; ADD HL,DE ; SCF ; Set Carry Flag RET ; ; ------------------------- ; THE <b><font color=#333388>'PRINTING'</font></b> SUBROUTINE ; ------------------------- ; ; <a name="L07DC"></a>;; <b>LEAD-SP</b> L07DC: LD A,E ; AND A ; RET M ; JR <A href="#L07F1">L07F1</a> ; to PRINT-CH ; --- <a name="L07E1"></a>;; <b>OUT-DIGIT</b> L07E1: XOR A ; <a name="L07E2"></a>;; <b>DIGIT-INC</b> L07E2: ADD HL,BC ; INC A ; JR C,<A href="#L07E2">L07E2</a> ; to DIGIT-INC SBC HL,BC ; DEC A ; JR Z,<A href="#L07DC">L07DC</a> ; to LEAD-SP <a name="L07EB"></a>;; <b>OUT-CODE</b> L07EB: LD E,$1C ; ADD A,E ; <a name="L07EE"></a>;; <b>OUT-CH</b> L07EE: AND A ; JR Z,<A href="#L07F5">L07F5</a> ; to PRINT-SP <a name="L07F1"></a>;; <b>PRINT-CH</b> L07F1: RES 0,(IY+$01) ; update FLAGS - signal leading space permitted <a name="L07F5"></a>;; <b>PRINT-SP</b> L07F5: EXX ; PUSH HL ; BIT 1,(IY+$01) ; test FLAGS - is printer in use ? JR NZ,<A href="#L0802">L0802</a> ; to LPRINT-A CALL <A href="#L0808">L0808</a> ; routine ENTER-CH JR <A href="#L0805">L0805</a> ; to PRINT-EXX ; --- <a name="L0802"></a>;; <b>LPRINT-A</b> L0802: CALL <A href="#L0851">L0851</a> ; routine LPRINT-CH <a name="L0805"></a>;; <b>PRINT-EXX</b> L0805: POP HL ; EXX ; RET ; ; --- <a name="L0808"></a>;; <b>ENTER-CH</b> L0808: LD D,A ; LD BC,($4039) ; sv S_POSN_x LD A,C ; CP $21 ; JR Z,<A href="#L082C">L082C</a> ; to TEST-LOW <a name="L0812"></a>;; <b>TEST-N/L</b> L0812: LD A,$76 ; CP D ; JR Z,<A href="#L0847">L0847</a> ; to WRITE-N/L LD HL,($400E) ; sv DF_CC_lo CP (HL) ; LD A,D ; JR NZ,<A href="#L083E">L083E</a> ; to WRITE-CH DEC C ; JR NZ,<A href="#L083A">L083A</a> ; to EXPAND-1 INC HL ; LD ($400E),HL ; sv DF_CC_lo LD C,$21 ; DEC B ; LD ($4039),BC ; sv S_POSN_x <a name="L082C"></a>;; <b>TEST-LOW</b> L082C: LD A,B ; CP (IY+$22) ; sv DF_SZ JR Z,<A href="#L0835">L0835</a> ; to REPORT-5 AND A ; JR NZ,<A href="#L0812">L0812</a> ; to TEST-N/L <a name="L0835"></a>;; <b>REPORT-5</b> L0835: LD L,$04 ; 'No more room on screen' JP <A href="#L0058">L0058</a> ; to ERROR-3 ; --- <a name="L083A"></a>;; <b>EXPAND-1</b> L083A: CALL <A href="#L099B">L099B</a> ; routine ONE-SPACE EX DE,HL ; <a name="L083E"></a>;; <b>WRITE-CH</b> L083E: LD (HL),A ; INC HL ; LD ($400E),HL ; sv DF_CC_lo DEC (IY+$39) ; sv S_POSN_x RET ; ; --- <a name="L0847"></a>;; <b>WRITE-N/L</b> L0847: LD C,$21 ; DEC B ; SET 0,(IY+$01) ; sv FLAGS - Suppress leading space JP <A href="#L0918">L0918</a> ; to LOC-ADDR ; -------------------------- ; THE <b><font color=#333388>'LPRINT-CH'</font></b> SUBROUTINE ; -------------------------- ; This routine sends a character to the ZX-Printer placing the code for the ; character in the Printer Buffer. ; <font color=#9900FF>Note.</font> PR-CC contains the low byte of the buffer address. The high order byte ; is always constant. <a name="L0851"></a>;; <b>LPRINT-CH</b> L0851: CP $76 ; compare to NEWLINE. JR Z,<A href="#L0871">L0871</a> ; 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,<A href="#L0871">L0871</a> ; 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 <b><font color=#333388>'COPY'</font></b> COMMAND ROUTINE ; -------------------------- ; The full character-mapped screen is copied to the ZX-Printer. ; All twenty-four text/graphic lines are printed. <a name="L0869"></a>;; <b>COPY</b> 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 <A href="#L0876">L0876</a> ; forward to COPY*D ; --- ; A single character-mapped printer buffer is copied to the ZX-Printer. <a name="L0871"></a>;; <b>COPY-BUFF</b> 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. <a name="L0876"></a>;; <b>COPY*D</b> L0876: CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST PUSH BC ; *** preserve BC throughout. ; a pending character may be present ; in C from LPRINT-CH <a name="L087A"></a>;; <b>COPY-LOOP</b> 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. <a name="L087D"></a>;; <b>COPY-TIME</b> 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. <a name="L0880"></a>;; <b>COPY-BRK</b> L0880: CALL <A href="#L0F46">L0F46</a> ; routine BREAK-1 JR C,<A href="#L088A">L088A</a> ; 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. <a name="L0888"></a>;; <b>REPORT-D2</b> L0888: RST 08H ; ERROR-1 DEFB $0C ; Error Report: BREAK - CONT repeats ; --- <a name="L088A"></a>;; <b>COPY-CONT</b> L088A: IN A,($FB) ; read from printer port. ADD A,A ; test bit 6 and 7 JP M,<A href="#L08DE">L08DE</a> ; jump forward with no printer to COPY-END JR NC,<A href="#L0880">L0880</a> ; 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. <a name="L089C"></a>;; <b>COPY-NEXT</b> 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,<A href="#L08C7">L08C7</a> ; 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. <a name="L08B5"></a>;; <b>COPY-BITS</b> 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. <a name="L08BA"></a>;; <b>COPY-WAIT</b> L08BA: IN A,($FB) ; read the printer port RRA ; test for alignment signal from encoder. JR NC,<A href="#L08BA">L08BA</a> ; loop if not present to COPY-WAIT LD A,H ; control byte to A. OUT ($FB),A ; and output to printer port. DJNZ <A href="#L08B5">L08B5</a> ; loop for all eight bits to COPY-BITS POP HL ; * restore character pointer. JR <A href="#L089C">L089C</a> ; 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. <a name="L08C7"></a>;; <b>COPY-N/L</b> L08C7: IN A,($FB) ; read printer port. RRA ; wait for encoder signal. JR NC,<A href="#L08C7">L08C7</a> ; 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,<A href="#L087D">L087D</a> ; 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,<A href="#L087A">L087A</a> ; back if not zero to COPY-LOOP LD A,$04 ; stop the already slowed printer motor. OUT ($FB),A ; output to printer port. <a name="L08DE"></a>;; <b>COPY-END</b> L08DE: CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST POP BC ; *** restore preserved BC. ; ------------------------------------- ; THE <b><font color=#333388>'CLEAR PRINTER BUFFER'</font></b> 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. ; <font color=#9900FF>Note.</font> 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. <a name="L08E2"></a>;; <b>CLEAR-PRB</b> 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. <a name="L08E9"></a>;; <b>PRB-BYTES</b> L08E9: DEC HL ; decrement address - could be DEC L. LD (HL),$00 ; place a zero byte. DJNZ <A href="#L08E9">L08E9</a> ; 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 <b><font color=#333388>'PRINT AT'</font></b> SUBROUTINE ; ------------------------- ; ; <a name="L08F5"></a>;; <b>PRINT-AT</b> L08F5: LD A,$17 ; SUB B ; JR C,<A href="#L0905">L0905</a> ; to WRONG-VAL <a name="L08FA"></a>;; <b>TEST-VAL</b> L08FA: CP (IY+$22) ; sv DF_SZ JP C,<A href="#L0835">L0835</a> ; to REPORT-5 INC A ; LD B,A ; LD A,$1F ; SUB C ; <a name="L0905"></a>;; <b>WRONG-VAL</b> L0905: JP C,<A href="#L0EAD">L0EAD</a> ; to REPORT-B ADD A,$02 ; LD C,A ; <a name="L090B"></a>;; <b>SET-FIELD</b> L090B: BIT 1,(IY+$01) ; sv FLAGS - Is printer in use JR Z,<A href="#L0918">L0918</a> ; to LOC-ADDR LD A,$5D ; SUB C ; LD ($4038),A ; sv PR_CC RET ; ; ---------------------------- ; THE <b><font color=#333388>'LOCATE ADDRESS'</font></b> ROUTINE ; ---------------------------- ; ; <a name="L0918"></a>;; <b>LOC-ADDR</b> 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 ; <a name="L0927"></a>;; <b>LOOK-BACK</b> L0927: DEC HL ; CP (HL) ; JR NZ,<A href="#L0927">L0927</a> ; to LOOK-BACK DJNZ <A href="#L0927">L0927</a> ; 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 <A href="#L099E">L099E</a> ; routine MAKE-ROOM POP BC ; LD B,C ; LD H,D ; LD L,E ; <a name="L0940"></a>;; <b>EXPAND-2</b> L0940: LD (HL),$00 ; DEC HL ; DJNZ <A href="#L0940">L0940</a> ; to EXPAND-2 EX DE,HL ; INC HL ; LD ($400E),HL ; sv DF_CC_lo RET ; ; ------------------------------ ; THE <b><font color=#333388>'EXPAND TOKENS'</font></b> SUBROUTINE ; ------------------------------ ; ; <a name="L094B"></a>;; <b>TOKENS</b> L094B: PUSH AF ; CALL <A href="#L0975">L0975</a> ; routine TOKEN-ADD JR NC,<A href="#L0959">L0959</a> ; to ALL-CHARS BIT 0,(IY+$01) ; sv FLAGS - Leading space if set JR NZ,<A href="#L0959">L0959</a> ; to ALL-CHARS XOR A ; RST 10H ; PRINT-A <a name="L0959"></a>;; <b>ALL-CHARS</b> L0959: LD A,(BC) ; AND $3F ; RST 10H ; PRINT-A LD A,(BC) ; INC BC ; ADD A,A ; JR NC,<A href="#L0959">L0959</a> ; to ALL-CHARS POP BC ; BIT 7,B ; RET Z ; CP $1A ; JR Z,<A href="#L096D">L096D</a> ; to TRAIL-SP CP $38 ; RET C ; <a name="L096D"></a>;; <b>TRAIL-SP</b> L096D: XOR A ; SET 0,(IY+$01) ; sv FLAGS - Suppress leading space JP <A href="#L07F5">L07F5</a> ; to PRINT-SP ; --- <a name="L0975"></a>;; <b>TOKEN-ADD</b> L0975: PUSH HL ; LD HL,<A href="#L0111">L0111</a> ; Address of TOKENS BIT 7,A ; JR Z,<A href="#L097F">L097F</a> ; to TEST-HIGH AND $3F ; <a name="L097F"></a>;; <b>TEST-HIGH</b> L097F: CP $43 ; JR NC,<A href="#L0993">L0993</a> ; to FOUND LD B,A ; INC B ; <a name="L0985"></a>;; <b>WORDS</b> L0985: BIT 7,(HL) ; INC HL ; JR Z,<A href="#L0985">L0985</a> ; to WORDS DJNZ <A href="#L0985">L0985</a> ; to WORDS BIT 6,A ; JR NZ,<A href="#L0992">L0992</a> ; to COMP-FLAG CP $18 ; <a name="L0992"></a>;; <b>COMP-FLAG</b> L0992: CCF ; Complement Carry Flag <a name="L0993"></a>;; <b>FOUND</b> L0993: LD B,H ; LD C,L ; POP HL ; RET NC ; LD A,(BC) ; ADD A,$E4 ; RET ; ; -------------------------- ; THE <b><font color=#333388>'ONE SPACE'</font></b> SUBROUTINE ; -------------------------- ; ; <a name="L099B"></a>;; <b>ONE-SPACE</b> L099B: LD BC,$0001 ; ; -------------------------- ; THE <b><font color=#333388>'MAKE ROOM'</font></b> SUBROUTINE ; -------------------------- ; ; <a name="L099E"></a>;; <b>MAKE-ROOM</b> L099E: PUSH HL ; CALL <A href="#L0EC5">L0EC5</a> ; routine TEST-ROOM POP HL ; CALL <A href="#L09AD">L09AD</a> ; routine POINTERS LD HL,($401C) ; sv STKEND_lo EX DE,HL ; LDDR ; Copy Bytes RET ; ; ------------------------- ; THE <b><font color=#333388>'POINTERS'</font></b> SUBROUTINE ; ------------------------- ; ; <a name="L09AD"></a>;; <b>POINTERS</b> L09AD: PUSH AF ; PUSH HL ; LD HL,$400C ; sv D_FILE_lo LD A,$09 ; <a name="L09B4"></a>;; <b>NEXT-PTR</b> 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,<A href="#L09C8">L09C8</a> ; 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 ; <a name="L09C8"></a>;; <b>PTR-DONE</b> L09C8: INC HL ; DEC A ; JR NZ,<A href="#L09B4">L09B4</a> ; 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 <b><font color=#333388>'LINE ADDRESS'</font></b> SUBROUTINE ; ----------------------------- ; ; <a name="L09D8"></a>;; <b>LINE-ADDR</b> L09D8: PUSH HL ; LD HL,$407D ; LD D,H ; LD E,L ; <a name="L09DE"></a>;; <b>NEXT-TEST</b> L09DE: POP BC ; CALL <A href="#L09EA">L09EA</a> ; routine CP-LINES RET NC ; PUSH BC ; CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE EX DE,HL ; JR <A href="#L09DE">L09DE</a> ; to NEXT-TEST ; ------------------------------------- ; THE <b><font color=#333388>'COMPARE LINE NUMBERS'</font></b> SUBROUTINE ; ------------------------------------- ; ; <a name="L09EA"></a>;; <b>CP-LINES</b> L09EA: LD A,(HL) ; CP B ; RET NZ ; INC HL ; LD A,(HL) ; DEC HL ; CP C ; RET ; ; -------------------------------------- ; THE <b><font color=#333388>'NEXT LINE OR VARIABLE'</font></b> SUBROUTINE ; -------------------------------------- ; ; <a name="L09F2"></a>;; <b>NEXT-ONE</b> L09F2: PUSH HL ; LD A,(HL) ; CP $40 ; JR C,<A href="#L0A0F">L0A0F</a> ; to LINES BIT 5,A ; JR Z,<A href="#L0A10">L0A10</a> ; forward to NEXT-O-4 ADD A,A ; JP M,<A href="#L0A01">L0A01</a> ; to NEXT+FIVE CCF ; Complement Carry Flag <a name="L0A01"></a>;; <b>NEXT+FIVE</b> L0A01: LD BC,$0005 ; JR NC,<A href="#L0A08">L0A08</a> ; to NEXT-LETT LD C,$11 ; <a name="L0A08"></a>;; <b>NEXT-LETT</b> L0A08: RLA ; INC HL ; LD A,(HL) ; JR NC,<A href="#L0A08">L0A08</a> ; to NEXT-LETT JR <A href="#L0A15">L0A15</a> ; to NEXT-ADD ; --- <a name="L0A0F"></a>;; <b>LINES</b> L0A0F: INC HL ; <a name="L0A10"></a>;; <b>NEXT-O-4</b> L0A10: INC HL ; LD C,(HL) ; INC HL ; LD B,(HL) ; INC HL ; <a name="L0A15"></a>;; <b>NEXT-ADD</b> L0A15: ADD HL,BC ; POP DE ; ; --------------------------- ; THE <b><font color=#333388>'DIFFERENCE'</font></b> SUBROUTINE ; --------------------------- ; ; <a name="L0A17"></a>;; <b>DIFFER</b> L0A17: AND A ; SBC HL,DE ; LD B,H ; LD C,L ; ADD HL,DE ; EX DE,HL ; RET ; ; -------------------------- ; THE <b><font color=#333388>'LINE-ENDS'</font></b> SUBROUTINE ; -------------------------- ; ; <a name="L0A1F"></a>;; <b>LINE-ENDS</b> L0A1F: LD B,(IY+$22) ; sv DF_SZ PUSH BC ; CALL <A href="#L0A2C">L0A2C</a> ; routine B-LINES POP BC ; DEC B ; JR <A href="#L0A2C">L0A2C</a> ; to B-LINES ; ------------------------- ; THE <b><font color=#333388>'CLS'</font></b> COMMAND ROUTINE ; ------------------------- ; ; <a name="L0A2A"></a>;; <b>CLS</b> L0A2A: LD B,$18 ; <a name="L0A2C"></a>;; <b>B-LINES</b> L0A2C: RES 1,(IY+$01) ; sv FLAGS - Signal printer not in use LD C,$21 ; PUSH BC ; CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR POP BC ; LD A,($4005) ; sv RAMTOP_hi CP $4D ; JR C,<A href="#L0A52">L0A52</a> ; to COLLAPSED SET 7,(IY+$3A) ; sv S_POSN_y <a name="L0A42"></a>;; <b>CLEAR-LOC</b> L0A42: XOR A ; prepare a space CALL <A href="#L07F5">L07F5</a> ; routine PRINT-SP prints a space LD HL,($4039) ; sv S_POSN_x LD A,L ; OR H ; AND $7E ; JR NZ,<A href="#L0A42">L0A42</a> ; to CLEAR-LOC JP <A href="#L0918">L0918</a> ; to LOC-ADDR ; --- <a name="L0A52"></a>;; <b>COLLAPSED</b> 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 <b><font color=#333388>'RECLAIMING'</font></b> SUBROUTINES ; ---------------------------- ; ; <a name="L0A5D"></a>;; <b>RECLAIM-1</b> L0A5D: CALL <A href="#L0A17">L0A17</a> ; routine DIFFER <a name="L0A60"></a>;; <b>RECLAIM-2</b> L0A60: PUSH BC ; LD A,B ; CPL ; LD B,A ; LD A,C ; CPL ; LD C,A ; INC BC ; CALL <A href="#L09AD">L09AD</a> ; routine POINTERS EX DE,HL ; POP HL ; ADD HL,DE ; PUSH DE ; LDIR ; Copy Bytes POP HL ; RET ; ; ------------------------------ ; THE <b><font color=#333388>'E-LINE NUMBER'</font></b> SUBROUTINE ; ------------------------------ ; ; <a name="L0A73"></a>;; <b>E-LINE-NO</b> L0A73: LD HL,($4014) ; sv E_LINE_lo CALL <A href="#L004D">L004D</a> ; 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 <A href="#L1548">L1548</a> ; routine INT-TO-FP CALL <A href="#L158A">L158A</a> ; routine FP-TO-BC JR C,<A href="#L0A91">L0A91</a> ; to NO-NUMBER LD HL,$D8F0 ; value '-10000' ADD HL,BC ; <a name="L0A91"></a>;; <b>NO-NUMBER</b> L0A91: JP C,<A href="#L0D9A">L0D9A</a> ; to REPORT-C CP A ; JP <A href="#L14BC">L14BC</a> ; routine SET-MIN ; ------------------------------------------------- ; THE <b><font color=#333388>'REPORT AND LINE NUMBER'</font></b> PRINTING SUBROUTINES ; ------------------------------------------------- ; ; <a name="L0A98"></a>;; <b>OUT-NUM</b> L0A98: PUSH DE ; PUSH HL ; XOR A ; BIT 7,B ; JR NZ,<A href="#L0ABF">L0ABF</a> ; to UNITS LD H,B ; LD L,C ; LD E,$FF ; JR <A href="#L0AAD">L0AAD</a> ; to THOUSAND ; --- <a name="L0AA5"></a>;; <b>OUT-NO</b> L0AA5: PUSH DE ; LD D,(HL) ; INC HL ; LD E,(HL) ; PUSH HL ; EX DE,HL ; LD E,$00 ; set E to leading space. <a name="L0AAD"></a>;; <b>THOUSAND</b> L0AAD: LD BC,$FC18 ; CALL <A href="#L07E1">L07E1</a> ; routine OUT-DIGIT LD BC,$FF9C ; CALL <A href="#L07E1">L07E1</a> ; routine OUT-DIGIT LD C,$F6 ; CALL <A href="#L07E1">L07E1</a> ; routine OUT-DIGIT LD A,L ; <a name="L0ABF"></a>;; <b>UNITS</b> L0ABF: CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE POP HL ; POP DE ; RET ; ; -------------------------- ; THE <b><font color=#333388>'UNSTACK-Z'</font></b> 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. <a name="L0AC5"></a>;; <b>UNSTACK-Z</b> L0AC5: CALL <A href="#L0DA6">L0DA6</a> ; 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 <b><font color=#333388>'LPRINT'</font></b> COMMAND ROUTINE ; ---------------------------- ; ; <a name="L0ACB"></a>;; <b>LPRINT</b> L0ACB: SET 1,(IY+$01) ; sv FLAGS - Signal printer in use ; --------------------------- ; THE <b><font color=#333388>'PRINT'</font></b> COMMAND ROUTINE ; --------------------------- ; ; <a name="L0ACF"></a>;; <b>PRINT</b> L0ACF: LD A,(HL) ; CP $76 ; JP Z,<A href="#L0B84">L0B84</a> ; to PRINT-END <a name="L0AD5"></a>;; <b>PRINT-1</b> L0AD5: SUB $1A ; ADC A,$00 ; JR Z,<A href="#L0B44">L0B44</a> ; to SPACING CP $A7 ; JR NZ,<A href="#L0AFA">L0AFA</a> ; to NOT-AT RST 20H ; NEXT-CHAR CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6 CP $1A ; JP NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C RST 20H ; NEXT-CHAR CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6 CALL <A href="#L0B4E">L0B4E</a> ; routine SYNTAX-ON RST 28H ;; FP-CALC DEFB $01 ;;exchange DEFB $34 ;;end-calc CALL <A href="#L0BF5">L0BF5</a> ; routine STK-TO-BC CALL <A href="#L08F5">L08F5</a> ; routine PRINT-AT JR <A href="#L0B37">L0B37</a> ; to PRINT-ON ; --- <a name="L0AFA"></a>;; <b>NOT-AT</b> L0AFA: CP $A8 ; JR NZ,<A href="#L0B31">L0B31</a> ; to NOT-TAB RST 20H ; NEXT-CHAR CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6 CALL <A href="#L0B4E">L0B4E</a> ; routine SYNTAX-ON CALL <A href="#L0C02">L0C02</a> ; routine STK-TO-A JP NZ,<A href="#L0EAD">L0EAD</a> ; to REPORT-B AND $1F ; LD C,A ; BIT 1,(IY+$01) ; sv FLAGS - Is printer in use JR Z,<A href="#L0B1E">L0B1E</a> ; to TAB-TEST SUB (IY+$38) ; sv PR_CC SET 7,A ; ADD A,$3C ; CALL NC,<A href="#L0871">L0871</a> ; routine COPY-BUFF <a name="L0B1E"></a>;; <b>TAB-TEST</b> L0B1E: ADD A,(IY+$39) ; sv S_POSN_x CP $21 ; LD A,($403A) ; sv S_POSN_y SBC A,$01 ; CALL <A href="#L08FA">L08FA</a> ; routine TEST-VAL SET 0,(IY+$01) ; sv FLAGS - Suppress leading space JR <A href="#L0B37">L0B37</a> ; to PRINT-ON ; --- <a name="L0B31"></a>;; <b>NOT-TAB</b> L0B31: CALL <A href="#L0F55">L0F55</a> ; routine SCANNING CALL <A href="#L0B55">L0B55</a> ; routine PRINT-STK <a name="L0B37"></a>;; <b>PRINT-ON</b> L0B37: RST 18H ; GET-CHAR SUB $1A ; ADC A,$00 ; JR Z,<A href="#L0B44">L0B44</a> ; to SPACING CALL <A href="#L0D1D">L0D1D</a> ; routine CHECK-END JP <A href="#L0B84">L0B84</a> ;;; to PRINT-END ; --- <a name="L0B44"></a>;; <b>SPACING</b> L0B44: CALL NC,<A href="#L0B8B">L0B8B</a> ; routine FIELD RST 20H ; NEXT-CHAR CP $76 ; RET Z ; JP <A href="#L0AD5">L0AD5</a> ;;; to PRINT-1 ; --- <a name="L0B4E"></a>;; <b>SYNTAX-ON</b> L0B4E: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z RET NZ ; POP HL ; JR <A href="#L0B37">L0B37</a> ; to PRINT-ON ; --- <a name="L0B55"></a>;; <b>PRINT-STK</b> L0B55: CALL <A href="#L0AC5">L0AC5</a> ; routine UNSTACK-Z BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? CALL Z,<A href="#L13F8">L13F8</a> ; routine STK-FETCH JR Z,<A href="#L0B6B">L0B6B</a> ; to PR-STR-4 JP <A href="#L15DB">L15DB</a> ; jump forward to PRINT-FP ; --- <a name="L0B64"></a>;; <b>PR-STR-1</b> L0B64: LD A,$0B ; <a name="L0B66"></a>;; <b>PR-STR-2</b> L0B66: RST 10H ; PRINT-A <a name="L0B67"></a>;; <b>PR-STR-3</b> L0B67: LD DE,($4018) ; sv X_PTR_lo <a name="L0B6B"></a>;; <b>PR-STR-4</b> 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,<A href="#L0B66">L0B66</a> ; to PR-STR-2 CP $C0 ; JR Z,<A href="#L0B64">L0B64</a> ; to PR-STR-1 PUSH BC ; CALL <A href="#L094B">L094B</a> ; routine TOKENS POP BC ; JR <A href="#L0B67">L0B67</a> ; to PR-STR-3 ; --- <a name="L0B84"></a>;; <b>PRINT-END</b> L0B84: CALL <A href="#L0AC5">L0AC5</a> ; routine UNSTACK-Z LD A,$76 ; RST 10H ; PRINT-A RET ; ; --- <a name="L0B8B"></a>;; <b>FIELD</b> L0B8B: CALL <A href="#L0AC5">L0AC5</a> ; 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,<A href="#L0BA4">L0BA4</a> ; to CENTRE LD A,$5D ; SUB (IY+$38) ; sv PR_CC <a name="L0BA4"></a>;; <b>CENTRE</b> L0BA4: LD C,$11 ; CP C ; JR NC,<A href="#L0BAB">L0BAB</a> ; to RIGHT LD C,$01 ; <a name="L0BAB"></a>;; <b>RIGHT</b> L0BAB: CALL <A href="#L090B">L090B</a> ; routine SET-FIELD RET ; ; -------------------------------------- ; THE <b><font color=#333388>'PLOT AND UNPLOT'</font></b> COMMAND ROUTINES ; -------------------------------------- ; ; <a name="L0BAF"></a>;; <b>PLOT/UNP</b> L0BAF: CALL <A href="#L0BF5">L0BF5</a> ; routine STK-TO-BC LD ($4036),BC ; sv COORDS_x LD A,$2B ; SUB B ; JP C,<A href="#L0EAD">L0EAD</a> ; to REPORT-B LD B,A ; LD A,$01 ; SRA B ; JR NC,<A href="#L0BC5">L0BC5</a> ; to COLUMNS LD A,$04 ; <a name="L0BC5"></a>;; <b>COLUMNS</b> L0BC5: SRA C ; JR NC,<A href="#L0BCA">L0BCA</a> ; to FIND-ADDR RLCA ; <a name="L0BCA"></a>;; <b>FIND-ADDR</b> L0BCA: PUSH AF ; CALL <A href="#L08F5">L08F5</a> ; routine PRINT-AT LD A,(HL) ; RLCA ; CP $10 ; JR NC,<A href="#L0BDA">L0BDA</a> ; to TABLE-PTR RRCA ; JR NC,<A href="#L0BD9">L0BD9</a> ; to SQ-SAVED XOR $8F ; <a name="L0BD9"></a>;; <b>SQ-SAVED</b> L0BD9: LD B,A ; <a name="L0BDA"></a>;; <b>TABLE-PTR</b> L0BDA: LD DE,<A href="#L0C9E">L0C9E</a> ; Address: P-UNPLOT LD A,($4030) ; sv T_ADDR_lo SUB E ; JP M,<A href="#L0BE9">L0BE9</a> ; to PLOT POP AF ; CPL ; AND B ; JR <A href="#L0BEB">L0BEB</a> ; to UNPLOT ; --- <a name="L0BE9"></a>;; <b>PLOT</b> L0BE9: POP AF ; OR B ; <a name="L0BEB"></a>;; <b>UNPLOT</b> L0BEB: CP $08 ; JR C,<A href="#L0BF1">L0BF1</a> ; to PLOT-END XOR $8F ; <a name="L0BF1"></a>;; <b>PLOT-END</b> L0BF1: EXX ; RST 10H ; PRINT-A EXX ; RET ; ; ---------------------------- ; THE <b><font color=#333388>'STACK-TO-BC'</font></b> SUBROUTINE ; ---------------------------- ; ; <a name="L0BF5"></a>;; <b>STK-TO-BC</b> L0BF5: CALL <A href="#L0C02">L0C02</a> ; routine STK-TO-A LD B,A ; PUSH BC ; CALL <A href="#L0C02">L0C02</a> ; routine STK-TO-A LD E,C ; POP BC ; LD D,C ; LD C,A ; RET ; ; --------------------------- ; THE <b><font color=#333388>'STACK-TO-A'</font></b> SUBROUTINE ; --------------------------- ; ; <a name="L0C02"></a>;; <b>STK-TO-A</b> L0C02: CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A JP C,<A href="#L0EAD">L0EAD</a> ; to REPORT-B LD C,$01 ; RET Z ; LD C,$FF ; RET ; ; ----------------------- ; THE <b><font color=#333388>'SCROLL'</font></b> SUBROUTINE ; ----------------------- ; ; <a name="L0C0E"></a>;; <b>SCROLL</b> L0C0E: LD B,(IY+$22) ; sv DF_SZ LD C,$21 ; CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR CALL <A href="#L099B">L099B</a> ; 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 <A href="#L0A5D">L0A5D</a> ; to RECLAIM-1 ; ------------------- ; THE <b><font color=#333388>'SYNTAX'</font></b> TABLES ; ------------------- ; i) The Offset table <a name="L0C29"></a>;; <b>offset-t</b> L0C29: DEFB <A href="#L0CB4">L0CB4</a> - $ ; 8B offset to; Address: P-LPRINT DEFB <A href="#L0CB7">L0CB7</a> - $ ; 8D offset to; Address: P-LLIST DEFB <A href="#L0C58">L0C58</a> - $ ; 2D offset to; Address: P-STOP DEFB <A href="#L0CAB">L0CAB</a> - $ ; 7F offset to; Address: P-SLOW DEFB <A href="#L0CAE">L0CAE</a> - $ ; 81 offset to; Address: P-FAST DEFB <A href="#L0C77">L0C77</a> - $ ; 49 offset to; Address: P-NEW DEFB <A href="#L0CA4">L0CA4</a> - $ ; 75 offset to; Address: P-SCROLL DEFB <A href="#L0C8F">L0C8F</a> - $ ; 5F offset to; Address: P-CONT DEFB <A href="#L0C71">L0C71</a> - $ ; 40 offset to; Address: P-DIM DEFB <A href="#L0C74">L0C74</a> - $ ; 42 offset to; Address: P-REM DEFB <A href="#L0C5E">L0C5E</a> - $ ; 2B offset to; Address: P-FOR DEFB <A href="#L0C4B">L0C4B</a> - $ ; 17 offset to; Address: P-GOTO DEFB <A href="#L0C54">L0C54</a> - $ ; 1F offset to; Address: P-GOSUB DEFB <A href="#L0C6D">L0C6D</a> - $ ; 37 offset to; Address: P-INPUT DEFB <A href="#L0C89">L0C89</a> - $ ; 52 offset to; Address: P-LOAD DEFB <A href="#L0C7D">L0C7D</a> - $ ; 45 offset to; Address: P-LIST DEFB <A href="#L0C48">L0C48</a> - $ ; 0F offset to; Address: P-LET DEFB <A href="#L0CA7">L0CA7</a> - $ ; 6D offset to; Address: P-PAUSE DEFB <A href="#L0C66">L0C66</a> - $ ; 2B offset to; Address: P-NEXT DEFB <A href="#L0C80">L0C80</a> - $ ; 44 offset to; Address: P-POKE DEFB <A href="#L0C6A">L0C6A</a> - $ ; 2D offset to; Address: P-PRINT DEFB <A href="#L0C98">L0C98</a> - $ ; 5A offset to; Address: P-PLOT DEFB <A href="#L0C7A">L0C7A</a> - $ ; 3B offset to; Address: P-RUN DEFB <A href="#L0C8C">L0C8C</a> - $ ; 4C offset to; Address: P-SAVE DEFB <A href="#L0C86">L0C86</a> - $ ; 45 offset to; Address: P-RAND DEFB <A href="#L0C4F">L0C4F</a> - $ ; 0D offset to; Address: P-IF DEFB <A href="#L0C95">L0C95</a> - $ ; 52 offset to; Address: P-CLS DEFB <A href="#L0C9E">L0C9E</a> - $ ; 5A offset to; Address: P-UNPLOT DEFB <A href="#L0C92">L0C92</a> - $ ; 4D offset to; Address: P-CLEAR DEFB <A href="#L0C5B">L0C5B</a> - $ ; 15 offset to; Address: P-RETURN DEFB <A href="#L0CB1">L0CB1</a> - $ ; 6A offset to; Address: P-COPY ; ii) The parameter table. <a name="L0C48"></a>;; <b>P-LET</b> L0C48: DEFB $01 ; Class-01 - A variable is required. DEFB $14 ; Separator: '=' DEFB $02 ; Class-02 - An expression, numeric or string, ; must follow. <a name="L0C4B"></a>;; <b>P-GOTO</b> L0C4B: DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L0E81">L0E81</a> ; Address: $0E81; Address: GOTO <a name="L0C4F"></a>;; <b>P-IF</b> 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 <A href="#L0DAB">L0DAB</a> ; Address: $0DAB; Address: IF <a name="L0C54"></a>;; <b>P-GOSUB</b> L0C54: DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L0EB5">L0EB5</a> ; Address: $0EB5; Address: GOSUB <a name="L0C58"></a>;; <b>P-STOP</b> L0C58: DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L0CDC">L0CDC</a> ; Address: $0CDC; Address: STOP <a name="L0C5B"></a>;; <b>P-RETURN</b> L0C5B: DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L0ED8">L0ED8</a> ; Address: $0ED8; Address: RETURN <a name="L0C5E"></a>;; <b>P-FOR</b> 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 <A href="#L0DB9">L0DB9</a> ; Address: $0DB9; Address: FOR <a name="L0C66"></a>;; <b>P-NEXT</b> L0C66: DEFB $04 ; Class-04 - A single character variable must ; follow. DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L0E2E">L0E2E</a> ; Address: $0E2E; Address: NEXT <a name="L0C6A"></a>;; <b>P-PRINT</b> L0C6A: DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW <A href="#L0ACF">L0ACF</a> ; Address: $0ACF; Address: PRINT <a name="L0C6D"></a>;; <b>P-INPUT</b> L0C6D: DEFB $01 ; Class-01 - A variable is required. DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L0EE9">L0EE9</a> ; Address: $0EE9; Address: INPUT <a name="L0C71"></a>;; <b>P-DIM</b> L0C71: DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW <A href="#L1409">L1409</a> ; Address: $1409; Address: DIM <a name="L0C74"></a>;; <b>P-REM</b> L0C74: DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW <A href="#L0D6A">L0D6A</a> ; Address: $0D6A; Address: REM <a name="L0C77"></a>;; <b>P-NEW</b> L0C77: DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L03C3">L03C3</a> ; Address: $03C3; Address: NEW <a name="L0C7A"></a>;; <b>P-RUN</b> L0C7A: DEFB $03 ; Class-03 - A numeric expression may follow ; else default to zero. DEFW <A href="#L0EAF">L0EAF</a> ; Address: $0EAF; Address: RUN <a name="L0C7D"></a>;; <b>P-LIST</b> L0C7D: DEFB $03 ; Class-03 - A numeric expression may follow ; else default to zero. DEFW <A href="#L0730">L0730</a> ; Address: $0730; Address: LIST <a name="L0C80"></a>;; <b>P-POKE</b> 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 <A href="#L0E92">L0E92</a> ; Address: $0E92; Address: POKE <a name="L0C86"></a>;; <b>P-RAND</b> L0C86: DEFB $03 ; Class-03 - A numeric expression may follow ; else default to zero. DEFW <A href="#L0E6C">L0E6C</a> ; Address: $0E6C; Address: RAND <a name="L0C89"></a>;; <b>P-LOAD</b> L0C89: DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW <A href="#L0340">L0340</a> ; Address: $0340; Address: LOAD <a name="L0C8C"></a>;; <b>P-SAVE</b> L0C8C: DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW <A href="#L02F6">L02F6</a> ; Address: $02F6; Address: SAVE <a name="L0C8F"></a>;; <b>P-CONT</b> L0C8F: DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L0E7C">L0E7C</a> ; Address: $0E7C; Address: CONT <a name="L0C92"></a>;; <b>P-CLEAR</b> L0C92: DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L149A">L149A</a> ; Address: $149A; Address: CLEAR <a name="L0C95"></a>;; <b>P-CLS</b> L0C95: DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L0A2A">L0A2A</a> ; Address: $0A2A; Address: CLS <a name="L0C98"></a>;; <b>P-PLOT</b> 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 <A href="#L0BAF">L0BAF</a> ; Address: $0BAF; Address: PLOT/UNP <a name="L0C9E"></a>;; <b>P-UNPLOT</b> 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 <A href="#L0BAF">L0BAF</a> ; Address: $0BAF; Address: PLOT/UNP <a name="L0CA4"></a>;; <b>P-SCROLL</b> L0CA4: DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L0C0E">L0C0E</a> ; Address: $0C0E; Address: SCROLL <a name="L0CA7"></a>;; <b>P-PAUSE</b> L0CA7: DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L0F32">L0F32</a> ; Address: $0F32; Address: PAUSE <a name="L0CAB"></a>;; <b>P-SLOW</b> L0CAB: DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L0F2B">L0F2B</a> ; Address: $0F2B; Address: SLOW <a name="L0CAE"></a>;; <b>P-FAST</b> L0CAE: DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L0F23">L0F23</a> ; Address: $0F23; Address: FAST <a name="L0CB1"></a>;; <b>P-COPY</b> L0CB1: DEFB $00 ; Class-00 - No further operands. DEFW <A href="#L0869">L0869</a> ; Address: $0869; Address: COPY <a name="L0CB4"></a>;; <b>P-LPRINT</b> L0CB4: DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW <A href="#L0ACB">L0ACB</a> ; Address: $0ACB; Address: LPRINT <a name="L0CB7"></a>;; <b>P-LLIST</b> L0CB7: DEFB $03 ; Class-03 - A numeric expression may follow ; else default to zero. DEFW <A href="#L072C">L072C</a> ; Address: $072C; Address: LLIST ; --------------------------- ; THE <b><font color=#333388>'LINE SCANNING'</font></b> ROUTINE ; --------------------------- ; ; <a name="L0CBA"></a>;; <b>LINE-SCAN</b> L0CBA: LD (IY+$01),$01 ; sv FLAGS CALL <A href="#L0A73">L0A73</a> ; routine E-LINE-NO <a name="L0CC1"></a>;; <b>LINE-RUN</b> L0CC1: CALL <A href="#L14BC">L14BC</a> ; routine SET-MIN LD HL,$4000 ; sv ERR_NR LD (HL),$FF ; LD HL,$402D ; sv FLAGX BIT 5,(HL) ; JR Z,<A href="#L0CDE">L0CDE</a> ; to LINE-NULL CP $E3 ; 'STOP' ? LD A,(HL) ; JP NZ,<A href="#L0D6F">L0D6F</a> ; to INPUT-REP CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z RET Z ; RST 08H ; ERROR-1 DEFB $0C ; Error Report: BREAK - CONT repeats ; -------------------------- ; THE <b><font color=#333388>'STOP'</font></b> COMMAND ROUTINE ; -------------------------- ; ; <a name="L0CDC"></a>;; <b>STOP</b> 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). <a name="L0CDE"></a>;; <b>LINE-NULL</b> 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,<A href="#L0D26">L0D26</a> ; forward if less to REPORT-C2 LD C,A ; reduced token to C LD HL,<A href="#L0C29">L0C29</a> ; 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 <A href="#L0CF7">L0CF7</a> ; to GET-PARAM ; --- <a name="L0CF4"></a>;; <b>SCAN-LOOP</b> L0CF4: LD HL,($4030) ; sv T_ADDR_lo ; -> Entry Point to Scanning Loop <a name="L0CF7"></a>;; <b>GET-PARAM</b> L0CF7: LD A,(HL) ; INC HL ; LD ($4030),HL ; sv T_ADDR_lo LD BC,<A href="#L0CF4">L0CF4</a> ; Address: SCAN-LOOP PUSH BC ; is pushed on machine stack. LD C,A ; CP $0B ; JR NC,<A href="#L0D10">L0D10</a> ; to SEPARATOR LD HL,<A href="#L0D16">L0D16</a> ; 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 <b><font color=#333388>'SEPARATOR'</font></b> ROUTINE ; ----------------------- <a name="L0D10"></a>;; <b>SEPARATOR</b> L0D10: RST 18H ; GET-CHAR CP C ; JR NZ,<A href="#L0D26">L0D26</a> ; to REPORT-C2 ; 'Nonsense in BASIC' RST 20H ; NEXT-CHAR RET ; return ; ------------------------- ; THE <b><font color=#333388>'COMMAND CLASS'</font></b> TABLE ; ------------------------- ; <a name="L0D16"></a>;; <b>class-tbl</b> L0D16: DEFB <A href="#L0D2D">L0D2D</a> - $ ; 17 offset to; Address: CLASS-0 DEFB <A href="#L0D3C">L0D3C</a> - $ ; 25 offset to; Address: CLASS-1 DEFB <A href="#L0D6B">L0D6B</a> - $ ; 53 offset to; Address: CLASS-2 DEFB <A href="#L0D28">L0D28</a> - $ ; 0F offset to; Address: CLASS-3 DEFB <A href="#L0D85">L0D85</a> - $ ; 6B offset to; Address: CLASS-4 DEFB <A href="#L0D2E">L0D2E</a> - $ ; 13 offset to; Address: CLASS-5 DEFB <A href="#L0D92">L0D92</a> - $ ; 76 offset to; Address: CLASS-6 ; -------------------------- ; THE <b><font color=#333388>'CHECK END'</font></b> 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. ; <a name="L0D1D"></a>;; <b>CHECK-END</b> L0D1D: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z RET NZ ; return in runtime. POP BC ; else drop return address. <a name="L0D22"></a>;; <b>CHECK-2</b> L0D22: LD A,(HL) ; fetch character. CP $76 ; compare to NEWLINE. RET Z ; return if so. <a name="L0D26"></a>;; <b>REPORT-C2</b> L0D26: JR <A href="#L0D9A">L0D9A</a> ; to REPORT-C ; 'Nonsense in BASIC' ; -------------------------- ; COMMAND CLASSES 03, 00, 05 ; -------------------------- ; ; <a name="L0D28"></a>;; <b>CLASS-3</b> L0D28: CP $76 ; CALL <A href="#L0D9C">L0D9C</a> ; routine NO-TO-STK <a name="L0D2D"></a>;; <b>CLASS-0</b> L0D2D: CP A ; <a name="L0D2E"></a>;; <b>CLASS-5</b> L0D2E: POP BC ; CALL Z,<A href="#L0D1D">L0D1D</a> ; routine CHECK-END EX DE,HL ; LD HL,($4030) ; sv T_ADDR_lo LD C,(HL) ; INC HL ; LD B,(HL) ; EX DE,HL ; <a name="L0D3A"></a>;; <b>CLASS-END</b> L0D3A: PUSH BC ; RET ; ; ------------------------------ ; COMMAND CLASSES 01, 02, 04, 06 ; ------------------------------ ; ; <a name="L0D3C"></a>;; <b>CLASS-1</b> L0D3C: CALL <A href="#L111C">L111C</a> ; routine LOOK-VARS <a name="L0D3F"></a>;; <b>CLASS-4-2</b> L0D3F: LD (IY+$2D),$00 ; sv FLAGX JR NC,<A href="#L0D4D">L0D4D</a> ; to SET-STK SET 1,(IY+$2D) ; sv FLAGX JR NZ,<A href="#L0D63">L0D63</a> ; to SET-STRLN <a name="L0D4B"></a>;; <b>REPORT-2</b> L0D4B: RST 08H ; ERROR-1 DEFB $01 ; Error Report: Variable not found ; --- <a name="L0D4D"></a>;; <b>SET-STK</b> L0D4D: CALL Z,<A href="#L11A7">L11A7</a> ; routine STK-VAR BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? JR NZ,<A href="#L0D63">L0D63</a> ; to SET-STRLN XOR A ; CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z CALL NZ,<A href="#L13F8">L13F8</a> ; routine STK-FETCH LD HL,$402D ; sv FLAGX OR (HL) ; LD (HL),A ; EX DE,HL ; <a name="L0D63"></a>;; <b>SET-STRLN</b> L0D63: LD ($402E),BC ; sv STRLEN_lo LD ($4012),HL ; sv DEST-lo ; THE <b><font color=#333388>'REM'</font></b> COMMAND ROUTINE <a name="L0D6A"></a>;; <b>REM</b> L0D6A: RET ; ; --- <a name="L0D6B"></a>;; <b>CLASS-2</b> L0D6B: POP BC ; LD A,($4001) ; sv FLAGS <a name="L0D6F"></a>;; <b>INPUT-REP</b> L0D6F: PUSH AF ; CALL <A href="#L0F55">L0F55</a> ; routine SCANNING POP AF ; LD BC,<A href="#L1321">L1321</a> ; Address: LET LD D,(IY+$01) ; sv FLAGS XOR D ; AND $40 ; JR NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C BIT 7,D ; JR NZ,<A href="#L0D3A">L0D3A</a> ; to CLASS-END JR <A href="#L0D22">L0D22</a> ; to CHECK-2 ; --- <a name="L0D85"></a>;; <b>CLASS-4</b> L0D85: CALL <A href="#L111C">L111C</a> ; routine LOOK-VARS PUSH AF ; LD A,C ; OR $9F ; INC A ; JR NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C POP AF ; JR <A href="#L0D3F">L0D3F</a> ; to CLASS-4-2 ; --- <a name="L0D92"></a>;; <b>CLASS-6</b> L0D92: CALL <A href="#L0F55">L0F55</a> ; routine SCANNING BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? RET NZ ; <a name="L0D9A"></a>;; <b>REPORT-C</b> L0D9A: RST 08H ; ERROR-1 DEFB $0B ; Error Report: Nonsense in BASIC ; -------------------------------- ; THE <b><font color=#333388>'NUMBER TO STACK'</font></b> SUBROUTINE ; -------------------------------- ; ; <a name="L0D9C"></a>;; <b>NO-TO-STK</b> L0D9C: JR NZ,<A href="#L0D92">L0D92</a> ; back to CLASS-6 with a non-zero number. CALL <A href="#L0DA6">L0DA6</a> ; 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 <b><font color=#333388>'SYNTAX-Z'</font></b> 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. <a name="L0DA6"></a>;; <b>SYNTAX-Z</b> L0DA6: BIT 7,(IY+$01) ; test FLAGS - checking syntax only? RET ; return. ; ------------------------ ; THE <b><font color=#333388>'IF'</font></b> COMMAND ROUTINE ; ------------------------ ; In runtime, the class routines have evaluated the test expression and ; the result, true or false, is on the stack. <a name="L0DAB"></a>;; <b>IF</b> L0DAB: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z JR Z,<A href="#L0DB6">L0DB6</a> ; 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. <a name="L0DB6"></a>;; <b>IF-END</b> L0DB6: JP <A href="#L0CDE">L0CDE</a> ; jump back to LINE-NULL ; ------------------------- ; THE <b><font color=#333388>'FOR'</font></b> COMMAND ROUTINE ; ------------------------- ; ; <a name="L0DB9"></a>;; <b>FOR</b> L0DB9: CP $E0 ; is current character 'STEP' ? JR NZ,<A href="#L0DC6">L0DC6</a> ; forward if not to F-USE-ONE RST 20H ; NEXT-CHAR CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6 stacks the number CALL <A href="#L0D1D">L0D1D</a> ; routine CHECK-END JR <A href="#L0DCC">L0DCC</a> ; forward to F-REORDER ; --- <a name="L0DC6"></a>;; <b>F-USE-ONE</b> L0DC6: CALL <A href="#L0D1D">L0D1D</a> ; routine CHECK-END RST 28H ;; FP-CALC DEFB $A1 ;;stk-one DEFB $34 ;;end-calc <a name="L0DCC"></a>;; <b>F-REORDER</b> 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 <A href="#L1321">L1321</a> ; 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,<A href="#L0DEA">L0DEA</a> ; to F-LMT-STP SLA C ; CALL <A href="#L099E">L099E</a> ; routine MAKE-ROOM INC HL ; <a name="L0DEA"></a>;; <b>F-LMT-STP</b> 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 <A href="#L0E5A">L0E5A</a> ; 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. <a name="L0E0E"></a>;; <b>NXTLIN-NO</b> L0E0E: LD A,(HL) ; fetch high byte of line number. AND $C0 ; mask off low bits $3F JR NZ,<A href="#L0E2A">L0E2A</a> ; forward at end of program to FOR-END PUSH BC ; save letter CALL <A href="#L09F2">L09F2</a> ; 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 <A href="#L004C">L004C</a> ; routine TEMP-PTR1 sets CH_ADD RST 18H ; GET-CHAR CP $F3 ; compare to 'NEXT'. EX DE,HL ; next line to HL. JR NZ,<A href="#L0E0E">L0E0E</a> ; 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,<A href="#L0E0E">L0E0E</a> ; back with mismatch to NXTLIN-NO <a name="L0E2A"></a>;; <b>FOR-END</b> L0E2A: LD ($4029),HL ; update system variable NXTLIN RET ; return. ; -------------------------- ; THE <b><font color=#333388>'NEXT'</font></b> COMMAND ROUTINE ; -------------------------- ; ; <a name="L0E2E"></a>;; <b>NEXT</b> L0E2E: BIT 1,(IY+$2D) ; sv FLAGX JP NZ,<A href="#L0D4B">L0D4B</a> ; to REPORT-2 LD HL,($4012) ; DEST BIT 7,(HL) ; JR Z,<A href="#L0E58">L0E58</a> ; 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 <A href="#L0E5A">L0E5A</a> ; 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 <A href="#L0E86">L0E86</a> ; to GOTO-2 ; --- <a name="L0E58"></a>;; <b>REPORT-1</b> L0E58: RST 08H ; ERROR-1 DEFB $00 ; Error Report: NEXT without FOR ; -------------------------- ; THE <b><font color=#333388>'NEXT-LOOP'</font></b> SUBROUTINE ; -------------------------- ; ; <a name="L0E5A"></a>;; <b>NEXT-LOOP</b> 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 <A href="#L0E62">L0E62</a>, LMT-V-VAL DEFB $01 ;;exchange <a name="L0E62"></a>;; <b>LMT-V-VAL</b> L0E62: DEFB $03 ;;subtract DEFB $33 ;;greater-0 DEFB $00 ;;jump-true DEFB $04 ;;to <A href="#L0E69">L0E69</a>, IMPOSS DEFB $34 ;;end-calc AND A ; clear carry flag RET ; return. ; --- <a name="L0E69"></a>;; <b>IMPOSS</b> L0E69: DEFB $34 ;;end-calc SCF ; set carry flag RET ; return. ; -------------------------- ; THE <b><font color=#333388>'RAND'</font></b> COMMAND ROUTINE ; -------------------------- ; The keyword was <b><font color=#333388>'RANDOMISE'</font></b> 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. <a name="L0E6C"></a>;; <b>RAND</b> L0E6C: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT LD A,B ; test value OR C ; for zero JR NZ,<A href="#L0E77">L0E77</a> ; forward if not zero to SET-SEED LD BC,($4034) ; fetch value of FRAMES system variable. <a name="L0E77"></a>;; <b>SET-SEED</b> L0E77: LD ($4032),BC ; update the SEED system variable. RET ; return. ; -------------------------- ; THE <b><font color=#333388>'CONT'</font></b> 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. <a name="L0E7C"></a>;; <b>CONT</b> L0E7C: LD HL,($402B) ; set HL from system variable OLDPPC JR <A href="#L0E86">L0E86</a> ; forward to GOTO-2 ; -------------------------- ; THE <b><font color=#333388>'GOTO'</font></b> 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. <a name="L0E81"></a>;; <b>GOTO</b> L0E81: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT LD H,B ; LD L,C ; <a name="L0E86"></a>;; <b>GOTO-2</b> L0E86: LD A,H ; CP $F0 ; JR NC,<A href="#L0EAD">L0EAD</a> ; to REPORT-B CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR LD ($4029),HL ; sv NXTLIN_lo RET ; ; -------------------------- ; THE <b><font color=#333388>'POKE'</font></b> COMMAND ROUTINE ; -------------------------- ; ; <a name="L0E92"></a>;; <b>POKE</b> L0E92: CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A JR C,<A href="#L0EAD">L0EAD</a> ; forward, with overflow, to REPORT-B JR Z,<A href="#L0E9B">L0E9B</a> ; forward, if positive, to POKE-SAVE NEG ; negate <a name="L0E9B"></a>;; <b>POKE-SAVE</b> L0E9B: PUSH AF ; preserve value. CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT gets address in BC ; invoking the error routine with overflow ; or a negative number. POP AF ; restore value. ; <font color=#9900FF>Note.</font> 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 <b><font color=#333388>'FIND INTEGER'</font></b> SUBROUTINE ; ----------------------------- ; ; <a name="L0EA7"></a>;; <b>FIND-INT</b> L0EA7: CALL <A href="#L158A">L158A</a> ; routine FP-TO-BC JR C,<A href="#L0EAD">L0EAD</a> ; forward with overflow to REPORT-B RET Z ; return if positive (0-65535). <a name="L0EAD"></a>;; <b>REPORT-B</b> L0EAD: RST 08H ; ERROR-1 DEFB $0A ; Error Report: Integer out of range ; ------------------------- ; THE <b><font color=#333388>'RUN'</font></b> COMMAND ROUTINE ; ------------------------- ; ; <a name="L0EAF"></a>;; <b>RUN</b> L0EAF: CALL <A href="#L0E81">L0E81</a> ; routine GOTO JP <A href="#L149A">L149A</a> ; to CLEAR ; --------------------------- ; THE <b><font color=#333388>'GOSUB'</font></b> COMMAND ROUTINE ; --------------------------- ; ; <a name="L0EB5"></a>;; <b>GOSUB</b> 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 <A href="#L0E81">L0E81</a> ; routine GOTO LD BC,$0006 ; ; -------------------------- ; THE <b><font color=#333388>'TEST ROOM'</font></b> SUBROUTINE ; -------------------------- ; ; <a name="L0EC5"></a>;; <b>TEST-ROOM</b> L0EC5: LD HL,($401C) ; sv STKEND_lo ADD HL,BC ; JR C,<A href="#L0ED3">L0ED3</a> ; to REPORT-4 EX DE,HL ; LD HL,$0024 ; ADD HL,DE ; SBC HL,SP ; RET C ; <a name="L0ED3"></a>;; <b>REPORT-4</b> L0ED3: LD L,$03 ; JP <A href="#L0058">L0058</a> ; to ERROR-3 ; ---------------------------- ; THE <b><font color=#333388>'RETURN'</font></b> COMMAND ROUTINE ; ---------------------------- ; ; <a name="L0ED8"></a>;; <b>RETURN</b> L0ED8: POP HL ; EX (SP),HL ; LD A,H ; CP $3E ; JR Z,<A href="#L0EE5">L0EE5</a> ; to REPORT-7 LD ($4002),SP ; sv ERR_SP_lo JR <A href="#L0E86">L0E86</a> ; back to GOTO-2 ; --- <a name="L0EE5"></a>;; <b>REPORT-7</b> L0EE5: EX (SP),HL ; PUSH HL ; RST 08H ; ERROR-1 DEFB $06 ; Error Report: RETURN without GOSUB ; --------------------------- ; THE <b><font color=#333388>'INPUT'</font></b> COMMAND ROUTINE ; --------------------------- ; ; <a name="L0EE9"></a>;; <b>INPUT</b> L0EE9: BIT 7,(IY+$08) ; sv PPC_hi JR NZ,<A href="#L0F21">L0F21</a> ; to REPORT-8 CALL <A href="#L14A3">L14A3</a> ; 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,<A href="#L0F05">L0F05</a> ; to PROMPT LD C,$04 ; <a name="L0F05"></a>;; <b>PROMPT</b> L0F05: OR (HL) ; LD (HL),A ; RST 30H ; BC-SPACES LD (HL),$76 ; LD A,C ; RRCA ; RRCA ; JR C,<A href="#L0F14">L0F14</a> ; to ENTER-CUR LD A,$0B ; LD (DE),A ; DEC HL ; LD (HL),A ; <a name="L0F14"></a>;; <b>ENTER-CUR</b> L0F14: DEC HL ; LD (HL),$7F ; LD HL,($4039) ; sv S_POSN_x LD ($4030),HL ; sv T_ADDR_lo POP HL ; JP <A href="#L0472">L0472</a> ; to LOWER ; --- <a name="L0F21"></a>;; <b>REPORT-8</b> L0F21: RST 08H ; ERROR-1 DEFB $07 ; Error Report: End of file ; --------------------------- ; THE <b><font color=#333388>'PAUSE'</font></b> COMMAND ROUTINE ; --------------------------- ; ; <a name="L0F23"></a>;; <b>FAST</b> L0F23: CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST RES 6,(IY+$3B) ; sv CDFLAG RET ; return. ; -------------------------- ; THE <b><font color=#333388>'SLOW'</font></b> COMMAND ROUTINE ; -------------------------- ; ; <a name="L0F2B"></a>;; <b>SLOW</b> L0F2B: SET 6,(IY+$3B) ; sv CDFLAG JP <A href="#L0207">L0207</a> ; to SLOW/FAST ; --------------------------- ; THE <b><font color=#333388>'PAUSE'</font></b> COMMAND ROUTINE ; --------------------------- <a name="L0F32"></a>;; <b>PAUSE</b> L0F32: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST LD H,B ; LD L,C ; CALL <A href="#L022D">L022D</a> ; routine DISPLAY-P LD (IY+$35),$FF ; sv FRAMES_hi CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST JR <A href="#L0F4B">L0F4B</a> ; routine DEBOUNCE ; ---------------------- ; THE <b><font color=#333388>'BREAK'</font></b> SUBROUTINE ; ---------------------- ; ; <a name="L0F46"></a>;; <b>BREAK-1</b> 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 <b><font color=#333388>'DEBOUNCE'</font></b> SUBROUTINE ; ------------------------- ; ; <a name="L0F4B"></a>;; <b>DEBOUNCE</b> L0F4B: RES 0,(IY+$3B) ; update system variable CDFLAG LD A,$FF ; LD ($4027),A ; update system variable DEBOUNCE RET ; return. ; ------------------------- ; THE <b><font color=#333388>'SCANNING'</font></b> SUBROUTINE ; ------------------------- ; This recursive routine is where the ZX81 gets its power. Provided there is ; enough memory it can evaluate an expression of unlimited complexity. ; <font color=#9900FF>Note.</font> 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". <a name="L0F55"></a>;; <b>SCANNING</b> L0F55: RST 18H ; GET-CHAR LD B,$00 ; set B register to zero. PUSH BC ; stack zero as a priority end-marker. <a name="L0F59"></a>;; <b>S-LOOP-1</b> L0F59: CP $40 ; compare to the 'RND' character JR NZ,<A href="#L0F8C">L0F8C</a> ; forward, if not, to S-TEST-PI ; ------------------ ; THE <b><font color=#333388>'RND'</font></b> FUNCTION ; ------------------ CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z JR Z,<A href="#L0F8A">L0F8A</a> ; forward if checking syntax to S-JPI-END LD BC,($4032) ; sv SEED_lo CALL <A href="#L1520">L1520</a> ; 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 <A href="#L158A">L158A</a> ; 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,<A href="#L0F8A">L0F8A</a> ; forward, if so, to S-JPI-END SUB $10 ; else reduce exponent by sixteen LD (HL),A ; thus dividing by 65536 for last value. <a name="L0F8A"></a>;; <b>S-JPI-END</b> L0F8A: JR <A href="#L0F99">L0F99</a> ; forward to S-PI-END ; --- <a name="L0F8C"></a>;; <b>S-TEST-PI</b> L0F8C: CP $42 ; the 'PI' character JR NZ,<A href="#L0F9D">L0F9D</a> ; forward, if not, to S-TST-INK ; ------------------- ; THE <b><font color=#333388>'PI'</font></b> EVALUATION ; ------------------- CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z JR Z,<A href="#L0F99">L0F99</a> ; 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. <a name="L0F99"></a>;; <b>S-PI-END</b> L0F99: RST 20H ; NEXT-CHAR advances character pointer. JP <A href="#L1083">L1083</a> ; jump forward to S-NUMERIC to set the flag ; to signal numeric result before advancing. ; --- <a name="L0F9D"></a>;; <b>S-TST-INK</b> L0F9D: CP $41 ; compare to character 'INKEY$' JR NZ,<A href="#L0FB2">L0FB2</a> ; forward, if not, to S-ALPHANUM ; ----------------------- ; THE <b><font color=#333388>'INKEY$'</font></b> EVALUATION ; ----------------------- CALL <A href="#L02BB">L02BB</a> ; routine KEYBOARD LD B,H ; LD C,L ; LD D,C ; INC D ; CALL NZ,<A href="#L07BD">L07BD</a> ; routine DECODE LD A,D ; ADC A,D ; LD B,D ; LD C,A ; EX DE,HL ; JR <A href="#L0FED">L0FED</a> ; forward to S-STRING ; --- <a name="L0FB2"></a>;; <b>S-ALPHANUM</b> L0FB2: CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM JR C,<A href="#L1025">L1025</a> ; forward, if alphanumeric to S-LTR-DGT CP $1B ; is character a '.' ? JP Z,<A href="#L1047">L1047</a> ; jump forward if so to S-DECIMAL LD BC,$09D8 ; prepare priority 09, operation 'subtract' CP $16 ; is character unary minus '-' ? JR Z,<A href="#L1020">L1020</a> ; forward, if so, to S-PUSH-PO CP $10 ; is character a '(' ? JR NZ,<A href="#L0FD6">L0FD6</a> ; forward if not to S-QUOTE CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 advances character pointer. CALL <A href="#L0F55">L0F55</a> ; recursively call routine SCANNING to ; evaluate the sub-expression. CP $11 ; is subsequent character a ')' ? JR NZ,<A href="#L0FFF">L0FFF</a> ; forward if not to S-RPT-C CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 advances. JR <A href="#L0FF8">L0FF8</a> ; relative jump to S-JP-CONT3 and then S-CONT3 ; --- ; consider a quoted string e.g. PRINT "Hooray!" ; <font color=#9900FF>Note.</font> quotes are not allowed within a string. <a name="L0FD6"></a>;; <b>S-QUOTE</b> L0FD6: CP $0B ; is character a quote (") ? JR NZ,<A href="#L1002">L1002</a> ; forward, if not, to S-FUNCTION CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 advances PUSH HL ; * save start of string. JR <A href="#L0FE3">L0FE3</a> ; forward to S-QUOTE-S ; --- <a name="L0FE0"></a>;; <b>S-Q-AGAIN</b> L0FE0: CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 <a name="L0FE3"></a>;; <b>S-QUOTE-S</b> L0FE3: CP $0B ; is character a '"' ? JR NZ,<A href="#L0FFB">L0FFB</a> ; 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. <a name="L0FED"></a>;; <b>S-STRING</b> L0FED: LD HL,$4001 ; address system variable FLAGS RES 6,(HL) ; signal string result BIT 7,(HL) ; test if checking syntax. CALL NZ,<A href="#L12C3">L12C3</a> ; in run-time routine STK-STO-$ stacks the ; string descriptor - start DE, length BC. RST 20H ; NEXT-CHAR advances pointer. <a name="L0FF8"></a>;; <b>S-J-CONT-3</b> L0FF8: JP <A href="#L1088">L1088</a> ; jump to S-CONT-3 ; --- ; A string with no terminating quote has to be considered. <a name="L0FFB"></a>;; <b>S-Q-NL</b> L0FFB: CP $76 ; compare to NEWLINE JR NZ,<A href="#L0FE0">L0FE0</a> ; loop back if not to S-Q-AGAIN <a name="L0FFF"></a>;; <b>S-RPT-C</b> L0FFF: JP <A href="#L0D9A">L0D9A</a> ; to REPORT-C ; --- <a name="L1002"></a>;; <b>S-FUNCTION</b> L1002: SUB $C4 ; subtract 'CODE' reducing codes ; CODE thru '<>' to range $00 - $XX JR C,<A href="#L0FFF">L0FFF</a> ; 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,<A href="#L1020">L1020</a> ; forward, if so, to S-PUSH-PO JR NC,<A href="#L0FFF">L0FFF</a> ; 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,<A href="#L101A">L101A</a> ; skip forward if string operand to S-NO-TO-$ RES 6,C ; signal string operand. <a name="L101A"></a>;; <b>S-NO-TO-$</b> L101A: CP $EA ; isolate top of range 'STR$' and 'CHR$' JR C,<A href="#L1020">L1020</a> ; skip forward with others to S-PUSH-PO RES 7,C ; signal string result. <a name="L1020"></a>;; <b>S-PUSH-PO</b> L1020: PUSH BC ; push the priority/operation RST 20H ; NEXT-CHAR JP <A href="#L0F59">L0F59</a> ; jump back to S-LOOP-1 ; --- <a name="L1025"></a>;; <b>S-LTR-DGT</b> L1025: CP $26 ; compare to 'A'. JR C,<A href="#L1047">L1047</a> ; forward if less to S-DECIMAL CALL <A href="#L111C">L111C</a> ; routine LOOK-VARS JP C,<A href="#L0D4B">L0D4B</a> ; back if not found to REPORT-2 ; a variable is always 'found' when checking ; syntax. CALL Z,<A href="#L11A7">L11A7</a> ; 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,<A href="#L1087">L1087</a> ; forward if not numeric to S-CONT-2 INC HL ; address numeric contents of variable. LD DE,($401C) ; set destination to STKEND CALL <A href="#L19F6">L19F6</a> ; 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 <A href="#L1087">L1087</a> ; 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. <a name="L1047"></a>;; <b>S-DECIMAL</b> L1047: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z JR NZ,<A href="#L106F">L106F</a> ; forward in run-time to S-STK-DEC CALL <A href="#L14D9">L14D9</a> ; routine DEC-TO-FP RST 18H ; GET-CHAR advances HL past digits LD BC,$0006 ; six locations are required. CALL <A href="#L099E">L099E</a> ; 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 <A href="#L004C">L004C</a> ; routine TEMP-PTR1 advances the character ; address skipping any white-space. JR <A href="#L1083">L1083</a> ; forward to S-NUMERIC ; to signal a numeric result. ; --- ; In run-time the branch is here when a digit or point is encountered. <a name="L106F"></a>;; <b>S-STK-DEC</b> L106F: RST 20H ; NEXT-CHAR CP $7E ; compare to 'number marker' JR NZ,<A href="#L106F">L106F</a> ; 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 <A href="#L19F6">L19F6</a> ; routine MOVE-FP stacks the number. LD ($401C),DE ; update system variable STKEND. LD ($4016),HL ; update system variable CH_ADD. <a name="L1083"></a>;; <b>S-NUMERIC</b> L1083: SET 6,(IY+$01) ; update FLAGS - Signal numeric result <a name="L1087"></a>;; <b>S-CONT-2</b> L1087: RST 18H ; GET-CHAR <a name="L1088"></a>;; <b>S-CONT-3</b> L1088: CP $10 ; compare to opening bracket '(' JR NZ,<A href="#L1098">L1098</a> ; forward if not to S-OPERTR BIT 6,(IY+$01) ; test FLAGS - Numeric or string result? JR NZ,<A href="#L10BC">L10BC</a> ; forward if numeric to S-LOOP ; else is a string CALL <A href="#L1263">L1263</a> ; routine SLICING RST 20H ; NEXT-CHAR JR <A href="#L1088">L1088</a> ; 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. <a name="L1098"></a>;; <b>S-OPERTR</b> L1098: LD BC,$00C3 ; prepare operator 'subtract' as default. ; also set B to zero for later indexing. CP $12 ; is character '>' ? JR C,<A href="#L10BC">L10BC</a> ; forward if less to S-LOOP as ; we have reached end of meaningful expression SUB $16 ; is character '-' ? JR NC,<A href="#L10A7">L10A7</a> ; forward with - * / and '**' '<>' to SUBMLTDIV ADD A,$0D ; increase others by thirteen ; $09 '>' thru $0C '+' JR <A href="#L10B5">L10B5</a> ; forward to GET-PRIO ; --- <a name="L10A7"></a>;; <b>SUBMLTDIV</b> L10A7: CP $03 ; isolate $00 '-', $01 '*', $02 '/' JR C,<A href="#L10B5">L10B5</a> ; 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,<A href="#L10BC">L10BC</a> ; forward if less to S-LOOP CP $06 ; test the upper limit for nonsense also JR NC,<A href="#L10BC">L10BC</a> ; 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 '+' <a name="L10B5"></a>;; <b>GET-PRIO</b> L10B5: ADD A,C ; add to default operation 'sub' ($C3) LD C,A ; and place in operator byte - C. LD HL,<A href="#L110F">L110F</a> - $C3 ; theoretical base of the priorities table. ADD HL,BC ; add C ( B is zero) LD B,(HL) ; pick up the priority in B <a name="L10BC"></a>;; <b>S-LOOP</b> L10BC: POP DE ; restore previous LD A,D ; load A with priority. CP B ; is present priority higher JR C,<A href="#L10ED">L10ED</a> ; forward if so to S-TIGHTER AND A ; are both priorities zero JP Z,<A href="#L0018">L0018</a> ; exit if zero via GET-CHAR PUSH BC ; stack present values PUSH DE ; stack last values CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z JR Z,<A href="#L10D5">L10D5</a> ; 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 <A href="#L10DE">L10DE</a> ; forward to S-RUNTEST ; --- <a name="L10D5"></a>;; <b>S-SYNTEST</b> 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 <a name="L10DB"></a>;; <b>S-RPORT-C</b> L10DB: JP NZ,<A href="#L0D9A">L0D9A</a> ; back to REPORT-C if results do not agree. ; --- ; in run-time impose bit 7 of the operator onto bit 6 of the FLAGS <a name="L10DE"></a>;; <b>S-RUNTEST</b> 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,<A href="#L10EA">L10EA</a> ; forward if numeric to S-LOOPEND RES 6,(HL) ; reset to signal string result <a name="L10EA"></a>;; <b>S-LOOPEND</b> L10EA: POP BC ; restore present values JR <A href="#L10BC">L10BC</a> ; back to S-LOOP ; --- <a name="L10ED"></a>;; <b>S-TIGHTER</b> 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,<A href="#L110A">L110A</a> ; 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,<A href="#L1102">L1102</a> ; forward if not to S-NOT-AND SET 6,C ; set the numeric operand required for 'AND' JR <A href="#L110A">L110A</a> ; forward to S-NEXT ; --- <a name="L1102"></a>;; <b>S-NOT-AND</b> L1102: JR C,<A href="#L10DB">L10DB</a> ; back if less than 'AND' to S-RPORT-C ; Nonsense if '-', '*' etc. CP $17 ; compare to 'strs-add' literal JR Z,<A href="#L110A">L110A</a> ; forward if so signaling string result SET 7,C ; set bit to numeric (Boolean) for others. <a name="L110A"></a>;; <b>S-NEXT</b> L110A: PUSH BC ; stack 'present' values RST 20H ; NEXT-CHAR JP <A href="#L0F59">L0F59</a> ; jump back to S-LOOP-1 ; ------------------------- ; THE <b><font color=#333388>'TABLE OF PRIORITIES'</font></b> ; ------------------------- ; ; <a name="L110F"></a>;; <b>tbl-pri</b> 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 <b><font color=#333388>'LOOK-VARS'</font></b> SUBROUTINE ; -------------------------- ; ; <a name="L111C"></a>;; <b>LOOK-VARS</b> L111C: SET 6,(IY+$01) ; sv FLAGS - Signal numeric result RST 18H ; GET-CHAR CALL <A href="#L14CE">L14CE</a> ; routine ALPHA JP NC,<A href="#L0D9A">L0D9A</a> ; to REPORT-C PUSH HL ; LD C,A ; RST 20H ; NEXT-CHAR PUSH HL ; RES 5,C ; CP $10 ; JR Z,<A href="#L1148">L1148</a> ; to V-SYN/RUN SET 6,C ; CP $0D ; JR Z,<A href="#L1143">L1143</a> ; forward to V-STR-VAR SET 5,C ; <a name="L1139"></a>;; <b>V-CHAR</b> L1139: CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM JR NC,<A href="#L1148">L1148</a> ; forward when not to V-RUN/SYN RES 6,C ; RST 20H ; NEXT-CHAR JR <A href="#L1139">L1139</a> ; loop back to V-CHAR ; --- <a name="L1143"></a>;; <b>V-STR-VAR</b> L1143: RST 20H ; NEXT-CHAR RES 6,(IY+$01) ; sv FLAGS - Signal string result <a name="L1148"></a>;; <b>V-RUN/SYN</b> L1148: LD B,C ; CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z JR NZ,<A href="#L1156">L1156</a> ; forward to V-RUN LD A,C ; AND $E0 ; SET 7,A ; LD C,A ; JR <A href="#L118A">L118A</a> ; forward to V-SYNTAX ; --- <a name="L1156"></a>;; <b>V-RUN</b> L1156: LD HL,($4010) ; sv VARS <a name="L1159"></a>;; <b>V-EACH</b> L1159: LD A,(HL) ; AND $7F ; JR Z,<A href="#L1188">L1188</a> ; to V-80-BYTE CP C ; JR NZ,<A href="#L1180">L1180</a> ; to V-NEXT RLA ; ADD A,A ; JP P,<A href="#L1195">L1195</a> ; to V-FOUND-2 JR C,<A href="#L1195">L1195</a> ; to V-FOUND-2 POP DE ; PUSH DE ; PUSH HL ; <a name="L116B"></a>;; <b>V-MATCHES</b> L116B: INC HL ; <a name="L116C"></a>;; <b>V-SPACES</b> L116C: LD A,(DE) ; INC DE ; AND A ; JR Z,<A href="#L116C">L116C</a> ; back to V-SPACES CP (HL) ; JR Z,<A href="#L116B">L116B</a> ; back to V-MATCHES OR $80 ; CP (HL) ; JR NZ,<A href="#L117F">L117F</a> ; forward to V-GET-PTR LD A,(DE) ; CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM JR NC,<A href="#L1194">L1194</a> ; forward to V-FOUND-1 <a name="L117F"></a>;; <b>V-GET-PTR</b> L117F: POP HL ; <a name="L1180"></a>;; <b>V-NEXT</b> L1180: PUSH BC ; CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE EX DE,HL ; POP BC ; JR <A href="#L1159">L1159</a> ; back to V-EACH ; --- <a name="L1188"></a>;; <b>V-80-BYTE</b> L1188: SET 7,B ; <a name="L118A"></a>;; <b>V-SYNTAX</b> L118A: POP DE ; RST 18H ; GET-CHAR CP $10 ; JR Z,<A href="#L1199">L1199</a> ; forward to V-PASS SET 5,B ; JR <A href="#L11A1">L11A1</a> ; forward to V-END ; --- <a name="L1194"></a>;; <b>V-FOUND-1</b> L1194: POP DE ; <a name="L1195"></a>;; <b>V-FOUND-2</b> L1195: POP DE ; POP DE ; PUSH HL ; RST 18H ; GET-CHAR <a name="L1199"></a>;; <b>V-PASS</b> L1199: CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM JR NC,<A href="#L11A1">L11A1</a> ; forward if not alphanumeric to V-END RST 20H ; NEXT-CHAR JR <A href="#L1199">L1199</a> ; back to V-PASS ; --- <a name="L11A1"></a>;; <b>V-END</b> L11A1: POP HL ; RL B ; BIT 6,B ; RET ; ; ------------------------ ; THE <b><font color=#333388>'STK-VAR'</font></b> SUBROUTINE ; ------------------------ ; ; <a name="L11A7"></a>;; <b>STK-VAR</b> L11A7: XOR A ; LD B,A ; BIT 7,C ; JR NZ,<A href="#L11F8">L11F8</a> ; forward to SV-COUNT BIT 7,(HL) ; JR NZ,<A href="#L11BF">L11BF</a> ; forward to SV-ARRAYS INC A ; <a name="L11B2"></a>;; <b>SV-SIMPLE$</b> L11B2: INC HL ; LD C,(HL) ; INC HL ; LD B,(HL) ; INC HL ; EX DE,HL ; CALL <A href="#L12C3">L12C3</a> ; routine STK-STO-$ RST 18H ; GET-CHAR JP <A href="#L125A">L125A</a> ; jump forward to SV-SLICE? ; --- <a name="L11BF"></a>;; <b>SV-ARRAYS</b> L11BF: INC HL ; INC HL ; INC HL ; LD B,(HL) ; BIT 6,C ; JR Z,<A href="#L11D1">L11D1</a> ; forward to SV-PTR DEC B ; JR Z,<A href="#L11B2">L11B2</a> ; forward to SV-SIMPLE$ EX DE,HL ; RST 18H ; GET-CHAR CP $10 ; JR NZ,<A href="#L1231">L1231</a> ; forward to REPORT-3 EX DE,HL ; <a name="L11D1"></a>;; <b>SV-PTR</b> L11D1: EX DE,HL ; JR <A href="#L11F8">L11F8</a> ; forward to SV-COUNT ; --- <a name="L11D4"></a>;; <b>SV-COMMA</b> L11D4: PUSH HL ; RST 18H ; GET-CHAR POP HL ; CP $1A ; JR Z,<A href="#L11FB">L11FB</a> ; forward to SV-LOOP BIT 7,C ; JR Z,<A href="#L1231">L1231</a> ; forward to REPORT-3 BIT 6,C ; JR NZ,<A href="#L11E9">L11E9</a> ; forward to SV-CLOSE CP $11 ; JR NZ,<A href="#L1223">L1223</a> ; forward to SV-RPT-C RST 20H ; NEXT-CHAR RET ; ; --- <a name="L11E9"></a>;; <b>SV-CLOSE</b> L11E9: CP $11 ; JR Z,<A href="#L1259">L1259</a> ; forward to SV-DIM CP $DF ; JR NZ,<A href="#L1223">L1223</a> ; forward to SV-RPT-C <a name="L11F1"></a>;; <b>SV-CH-ADD</b> L11F1: RST 18H ; GET-CHAR DEC HL ; LD ($4016),HL ; sv CH_ADD JR <A href="#L1256">L1256</a> ; forward to SV-SLICE ; --- <a name="L11F8"></a>;; <b>SV-COUNT</b> L11F8: LD HL,$0000 ; <a name="L11FB"></a>;; <b>SV-LOOP</b> L11FB: PUSH HL ; RST 20H ; NEXT-CHAR POP HL ; LD A,C ; CP $C0 ; JR NZ,<A href="#L120C">L120C</a> ; forward to SV-MULT RST 18H ; GET-CHAR CP $11 ; JR Z,<A href="#L1259">L1259</a> ; forward to SV-DIM CP $DF ; JR Z,<A href="#L11F1">L11F1</a> ; back to SV-CH-ADD <a name="L120C"></a>;; <b>SV-MULT</b> L120C: PUSH BC ; PUSH HL ; CALL <A href="#L12FF">L12FF</a> ; routine DE,(DE+1) EX (SP),HL ; EX DE,HL ; CALL <A href="#L12DD">L12DD</a> ; routine INT-EXP1 JR C,<A href="#L1231">L1231</a> ; forward to REPORT-3 DEC BC ; CALL <A href="#L1305">L1305</a> ; routine GET-HL*DE ADD HL,BC ; POP DE ; POP BC ; DJNZ <A href="#L11D4">L11D4</a> ; loop back to SV-COMMA BIT 7,C ; <a name="L1223"></a>;; <b>SV-RPT-C</b> L1223: JR NZ,<A href="#L128B">L128B</a> ; relative jump to SL-RPT-C PUSH HL ; BIT 6,C ; JR NZ,<A href="#L123D">L123D</a> ; forward to SV-ELEM$ LD B,D ; LD C,E ; RST 18H ; GET-CHAR CP $11 ; is character a ')' ? JR Z,<A href="#L1233">L1233</a> ; skip forward to SV-NUMBER <a name="L1231"></a>;; <b>REPORT-3</b> L1231: RST 08H ; ERROR-1 DEFB $02 ; Error Report: Subscript wrong <a name="L1233"></a>;; <b>SV-NUMBER</b> L1233: RST 20H ; NEXT-CHAR POP HL ; LD DE,$0005 ; CALL <A href="#L1305">L1305</a> ; routine GET-HL*DE ADD HL,BC ; RET ; return >> ; --- <a name="L123D"></a>;; <b>SV-ELEM$</b> L123D: CALL <A href="#L12FF">L12FF</a> ; routine DE,(DE+1) EX (SP),HL ; CALL <A href="#L1305">L1305</a> ; routine GET-HL*DE POP BC ; ADD HL,BC ; INC HL ; LD B,D ; LD C,E ; EX DE,HL ; CALL <A href="#L12C2">L12C2</a> ; routine STK-ST-0 RST 18H ; GET-CHAR CP $11 ; is it ')' ? JR Z,<A href="#L1259">L1259</a> ; forward if so to SV-DIM CP $1A ; is it ',' ? JR NZ,<A href="#L1231">L1231</a> ; back if not to REPORT-3 <a name="L1256"></a>;; <b>SV-SLICE</b> L1256: CALL <A href="#L1263">L1263</a> ; routine SLICING <a name="L1259"></a>;; <b>SV-DIM</b> L1259: RST 20H ; NEXT-CHAR <a name="L125A"></a>;; <b>SV-SLICE?</b> L125A: CP $10 ; JR Z,<A href="#L1256">L1256</a> ; back to SV-SLICE RES 6,(IY+$01) ; sv FLAGS - Signal string result RET ; return. ; ------------------------ ; THE <b><font color=#333388>'SLICING'</font></b> SUBROUTINE ; ------------------------ ; ; <a name="L1263"></a>;; <b>SLICING</b> L1263: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z CALL NZ,<A href="#L13F8">L13F8</a> ; routine STK-FETCH RST 20H ; NEXT-CHAR CP $11 ; is it ')' ? JR Z,<A href="#L12BE">L12BE</a> ; 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,<A href="#L1292">L1292</a> ; forward if so to SL-SECOND POP AF ; CALL <A href="#L12DE">L12DE</a> ; 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,<A href="#L1292">L1292</a> ; forward if so to SL-SECOND CP $11 ; <a name="L128B"></a>;; <b>SL-RPT-C</b> L128B: JP NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C LD H,D ; LD L,E ; JR <A href="#L12A5">L12A5</a> ; forward to SL-DEFINE ; --- <a name="L1292"></a>;; <b>SL-SECOND</b> L1292: PUSH HL ; RST 20H ; NEXT-CHAR POP HL ; CP $11 ; is it ')' ? JR Z,<A href="#L12A5">L12A5</a> ; forward if so to SL-DEFINE POP AF ; CALL <A href="#L12DE">L12DE</a> ; routine INT-EXP2 PUSH AF ; RST 18H ; GET-CHAR LD H,B ; LD L,C ; CP $11 ; is it ')' ? JR NZ,<A href="#L128B">L128B</a> ; back if not to SL-RPT-C <a name="L12A5"></a>;; <b>SL-DEFINE</b> L12A5: POP AF ; EX (SP),HL ; ADD HL,DE ; DEC HL ; EX (SP),HL ; AND A ; SBC HL,DE ; LD BC,$0000 ; JR C,<A href="#L12B9">L12B9</a> ; forward to SL-OVER INC HL ; AND A ; JP M,<A href="#L1231">L1231</a> ; jump back to REPORT-3 LD B,H ; LD C,L ; <a name="L12B9"></a>;; <b>SL-OVER</b> L12B9: POP DE ; RES 6,(IY+$01) ; sv FLAGS - Signal string result <a name="L12BE"></a>;; <b>SL-STORE</b> L12BE: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z RET Z ; return if checking syntax. ; -------------------------- ; THE <b><font color=#333388>'STK-STORE'</font></b> SUBROUTINE ; -------------------------- ; ; <a name="L12C2"></a>;; <b>STK-ST-0</b> L12C2: XOR A ; <a name="L12C3"></a>;; <b>STK-STO-$</b> L12C3: PUSH BC ; CALL <A href="#L19EB">L19EB</a> ; 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 <b><font color=#333388>'INT EXP'</font></b> SUBROUTINES ; ------------------------- ; ; <a name="L12DD"></a>;; <b>INT-EXP1</b> L12DD: XOR A ; <a name="L12DE"></a>;; <b>INT-EXP2</b> L12DE: PUSH DE ; PUSH HL ; PUSH AF ; CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6 POP AF ; CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z JR Z,<A href="#L12FC">L12FC</a> ; forward if checking syntax to I-RESTORE PUSH AF ; CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT POP DE ; LD A,B ; OR C ; SCF ; Set Carry Flag JR Z,<A href="#L12F9">L12F9</a> ; forward to I-CARRY POP HL ; PUSH HL ; AND A ; SBC HL,BC ; <a name="L12F9"></a>;; <b>I-CARRY</b> L12F9: LD A,D ; SBC A,$00 ; <a name="L12FC"></a>;; <b>I-RESTORE</b> L12FC: POP HL ; POP DE ; RET ; ; -------------------------- ; THE <b><font color=#333388>'DE,(DE+1)'</font></b> 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. <a name="L12FF"></a>;; <b>DE,(DE+1)</b> 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 <b><font color=#333388>'GET-HL*DE'</font></b> SUBROUTINE ; -------------------------- ; <a name="L1305"></a>;; <b>GET-HL*DE</b> L1305: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z RET Z ; PUSH BC ; LD B,$10 ; LD A,H ; LD C,L ; LD HL,$0000 ; <a name="L1311"></a>;; <b>HL-LOOP</b> L1311: ADD HL,HL ; JR C,<A href="#L131A">L131A</a> ; forward with carry to HL-END RL C ; RLA ; JR NC,<A href="#L131D">L131D</a> ; forward with no carry to HL-AGAIN ADD HL,DE ; <a name="L131A"></a>;; <b>HL-END</b> L131A: JP C,<A href="#L0ED3">L0ED3</a> ; to REPORT-4 <a name="L131D"></a>;; <b>HL-AGAIN</b> L131D: DJNZ <A href="#L1311">L1311</a> ; loop back to HL-LOOP POP BC ; RET ; return. ; -------------------- ; THE <b><font color=#333388>'LET'</font></b> SUBROUTINE ; -------------------- ; ; <a name="L1321"></a>;; <b>LET</b> L1321: LD HL,($4012) ; sv DEST-lo BIT 1,(IY+$2D) ; sv FLAGX JR Z,<A href="#L136E">L136E</a> ; forward to L-EXISTS LD BC,$0005 ; <a name="L132D"></a>;; <b>L-EACH-CH</b> L132D: INC BC ; ; check <a name="L132E"></a>;; <b>L-NO-SP</b> L132E: INC HL ; LD A,(HL) ; AND A ; JR Z,<A href="#L132E">L132E</a> ; back to L-NO-SP CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM JR C,<A href="#L132D">L132D</a> ; back to L-EACH-CH CP $0D ; is it '$' ? JP Z,<A href="#L13C8">L13C8</a> ; 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,<A href="#L1359">L1359</a> ; forward to L-SINGLE <a name="L134B"></a>;; <b>L-CHAR</b> L134B: INC HL ; LD A,(HL) ; AND A ; is it a space ? JR Z,<A href="#L134B">L134B</a> ; back to L-CHAR INC DE ; LD (DE),A ; DJNZ <A href="#L134B">L134B</a> ; loop back to L-CHAR OR $80 ; LD (DE),A ; LD A,$80 ; <a name="L1359"></a>;; <b>L-SINGLE</b> L1359: LD HL,($4012) ; sv DEST-lo XOR (HL) ; POP HL ; CALL <A href="#L13E7">L13E7</a> ; routine L-FIRST <a name="L1361"></a>;; <b>L-NUMERIC</b> 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 <A href="#L13AE">L13AE</a> ; forward to L-ENTER ; --- <a name="L136E"></a>;; <b>L-EXISTS</b> L136E: BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result? JR Z,<A href="#L137A">L137A</a> ; forward to L-DELETE$ LD DE,$0006 ; ADD HL,DE ; JR <A href="#L1361">L1361</a> ; back to L-NUMERIC ; --- <a name="L137A"></a>;; <b>L-DELETE$</b> L137A: LD HL,($4012) ; sv DEST-lo LD BC,($402E) ; sv STRLEN_lo BIT 0,(IY+$2D) ; sv FLAGX JR NZ,<A href="#L13B7">L13B7</a> ; 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 <A href="#L13F8">L13F8</a> ; routine STK-FETCH POP HL ; EX (SP),HL ; AND A ; SBC HL,BC ; ADD HL,BC ; JR NC,<A href="#L13A3">L13A3</a> ; forward to L-LENGTH LD B,H ; LD C,L ; <a name="L13A3"></a>;; <b>L-LENGTH</b> L13A3: EX (SP),HL ; EX DE,HL ; LD A,B ; OR C ; JR Z,<A href="#L13AB">L13AB</a> ; forward if zero to L-IN-W/S LDIR ; Copy Bytes <a name="L13AB"></a>;; <b>L-IN-W/S</b> L13AB: POP BC ; POP DE ; POP HL ; ; ------------------------ ; THE <b><font color=#333388>'L-ENTER'</font></b> SUBROUTINE ; ------------------------ ; <a name="L13AE"></a>;; <b>L-ENTER</b> L13AE: EX DE,HL ; LD A,B ; OR C ; RET Z ; PUSH DE ; LDIR ; Copy Bytes POP HL ; RET ; return. ; --- <a name="L13B7"></a>;; <b>L-ADD$</b> L13B7: DEC HL ; DEC HL ; DEC HL ; LD A,(HL) ; PUSH HL ; PUSH BC ; CALL <A href="#L13CE">L13CE</a> ; routine L-STRING POP BC ; POP HL ; INC BC ; INC BC ; INC BC ; JP <A href="#L0A60">L0A60</a> ; jump back to exit via RECLAIM-2 ; --- <a name="L13C8"></a>;; <b>L-NEW$</b> L13C8: LD A,$60 ; prepare mask %01100000 LD HL,($4012) ; sv DEST-lo XOR (HL) ; ; ------------------------- ; THE <b><font color=#333388>'L-STRING'</font></b> SUBROUTINE ; ------------------------- ; <a name="L13CE"></a>;; <b>L-STRING</b> L13CE: PUSH AF ; CALL <A href="#L13F8">L13F8</a> ; 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 ; <a name="L13E7"></a>;; <b>L-FIRST</b> L13E7: PUSH AF ; CALL <A href="#L14C7">L14C7</a> ; 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 <b><font color=#333388>'STK-FETCH'</font></b> 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. <a name="L13F8"></a>;; <b>STK-FETCH</b> 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 <b><font color=#333388>'DIM'</font></b> COMMAND ROUTINE ; ------------------------- ; An array is created and initialized to zeros which is also the space ; character on the ZX81. <a name="L1409"></a>;; <b>DIM</b> L1409: CALL <A href="#L111C">L111C</a> ; routine LOOK-VARS <a name="L140C"></a>;; <b>D-RPORT-C</b> L140C: JP NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z JR NZ,<A href="#L141C">L141C</a> ; forward to D-RUN RES 6,C ; CALL <A href="#L11A7">L11A7</a> ; routine STK-VAR CALL <A href="#L0D1D">L0D1D</a> ; routine CHECK-END <a name="L141C"></a>;; <b>D-RUN</b> L141C: JR C,<A href="#L1426">L1426</a> ; forward to D-LETTER PUSH BC ; CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE CALL <A href="#L0A60">L0A60</a> ; routine RECLAIM-2 POP BC ; <a name="L1426"></a>;; <b>D-LETTER</b> L1426: SET 7,C ; LD B,$00 ; PUSH BC ; LD HL,$0001 ; BIT 6,C ; JR NZ,<A href="#L1434">L1434</a> ; forward to D-SIZE LD L,$05 ; <a name="L1434"></a>;; <b>D-SIZE</b> L1434: EX DE,HL ; <a name="L1435"></a>;; <b>D-NO-LOOP</b> L1435: RST 20H ; NEXT-CHAR LD H,$40 ; CALL <A href="#L12DD">L12DD</a> ; routine INT-EXP1 JP C,<A href="#L1231">L1231</a> ; jump back to REPORT-3 POP HL ; PUSH BC ; INC H ; PUSH HL ; LD H,B ; LD L,C ; CALL <A href="#L1305">L1305</a> ; routine GET-HL*DE EX DE,HL ; RST 18H ; GET-CHAR CP $1A ; JR Z,<A href="#L1435">L1435</a> ; back to D-NO-LOOP CP $11 ; is it ')' ? JR NZ,<A href="#L140C">L140C</a> ; 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,<A href="#L0ED3">L0ED3</a> ; 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 <A href="#L099E">L099E</a> ; 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 <a name="L147F"></a>;; <b>DIM-SIZES</b> L147F: POP BC ; LD (HL),B ; DEC HL ; LD (HL),C ; DEC HL ; DEC A ; JR NZ,<A href="#L147F">L147F</a> ; back to DIM-SIZES RET ; return. ; --------------------- ; THE <b><font color=#333388>'RESERVE'</font></b> ROUTINE ; --------------------- ; ; <a name="L1488"></a>;; <b>RESERVE</b> L1488: LD HL,($401A) ; address STKBOT DEC HL ; now last byte of workspace CALL <A href="#L099E">L099E</a> ; 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 <b><font color=#333388>'CLEAR'</font></b> COMMAND ROUTINE ; --------------------------- ; ; <a name="L149A"></a>;; <b>CLEAR</b> L149A: LD HL,($4010) ; sv VARS_lo LD (HL),$80 ; INC HL ; LD ($4014),HL ; sv E_LINE_lo ; ----------------------- ; THE <b><font color=#333388>'X-TEMP'</font></b> SUBROUTINE ; ----------------------- ; ; <a name="L14A3"></a>;; <b>X-TEMP</b> L14A3: LD HL,($4014) ; sv E_LINE_lo ; ---------------------- ; THE <b><font color=#333388>'SET-STK'</font></b> ROUTINES ; ---------------------- ; ; <a name="L14A6"></a>;; <b>SET-STK-B</b> L14A6: LD ($401A),HL ; sv STKBOT ; <a name="L14A9"></a>;; <b>SET-STK-E</b> L14A9: LD ($401C),HL ; sv STKEND RET ; ; ----------------------- ; THE <b><font color=#333388>'CURSOR-IN'</font></b> 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. <a name="L14AD"></a>;; <b>CURSOR-IN</b> 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 <A href="#L14A6">L14A6</a> ; exit via SET-STK-B above ; ------------------------ ; THE <b><font color=#333388>'SET-MIN'</font></b> SUBROUTINE ; ------------------------ ; ; <a name="L14BC"></a>;; <b>SET-MIN</b> L14BC: LD HL,$405D ; normal location of calculator's memory area LD ($401F),HL ; update system variable MEM LD HL,($401A) ; fetch STKBOT JR <A href="#L14A9">L14A9</a> ; back to SET-STK-E ; ------------------------------------ ; THE <b><font color=#333388>'RECLAIM THE END-MARKER'</font></b> ROUTINE ; ------------------------------------ <a name="L14C7"></a>;; <b>REC-V80</b> L14C7: LD DE,($4014) ; sv E_LINE_lo JP <A href="#L0A5D">L0A5D</a> ; to RECLAIM-1 ; ---------------------- ; THE <b><font color=#333388>'ALPHA'</font></b> SUBROUTINE ; ---------------------- <a name="L14CE"></a>;; <b>ALPHA</b> L14CE: CP $26 ; JR <A href="#L14D4">L14D4</a> ; skip forward to ALPHA-2 ; ------------------------- ; THE <b><font color=#333388>'ALPHANUM'</font></b> SUBROUTINE ; ------------------------- <a name="L14D2"></a>;; <b>ALPHANUM</b> L14D2: CP $1C ; <a name="L14D4"></a>;; <b>ALPHA-2</b> L14D4: CCF ; Complement Carry Flag RET NC ; CP $40 ; RET ; ; ------------------------------------------ ; THE <b><font color=#333388>'DECIMAL TO FLOATING POINT'</font></b> SUBROUTINE ; ------------------------------------------ ; <a name="L14D9"></a>;; <b>DEC-TO-FP</b> L14D9: CALL <A href="#L1548">L1548</a> ; routine INT-TO-FP gets first part CP $1B ; is character a '.' ? JR NZ,<A href="#L14F5">L14F5</a> ; 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 <a name="L14E5"></a>;; <b>NXT-DGT-1</b> L14E5: RST 20H ; NEXT-CHAR CALL <A href="#L1514">L1514</a> ; routine STK-DIGIT JR C,<A href="#L14F5">L14F5</a> ; 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 <A href="#L14E5">L14E5</a> ; loop back till exhausted to NXT-DGT-1 ; --- <a name="L14F5"></a>;; <b>E-FORMAT</b> 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,<A href="#L1508">L1508</a> ; forward if so to SIGN-DONE CP $16 ; is it a '-' ? JR NZ,<A href="#L1509">L1509</a> ; forward if not to ST-E-PART INC (IY+$5D) ; sv MEM-0-1st change to FALSE <a name="L1508"></a>;; <b>SIGN-DONE</b> L1508: RST 20H ; NEXT-CHAR <a name="L1509"></a>;; <b>ST-E-PART</b> L1509: CALL <A href="#L1548">L1548</a> ; 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 <A href="#L1511">L1511</a>, E-POSTVE DEFB $18 ;;neg m, -e <a name="L1511"></a>;; <b>E-POSTVE</b> L1511: DEFB $38 ;;e-to-fp x. DEFB $34 ;;end-calc x. RET ; return. ; -------------------------- ; THE <b><font color=#333388>'STK-DIGIT'</font></b> SUBROUTINE ; -------------------------- ; <a name="L1514"></a>;; <b>STK-DIGIT</b> L1514: CP $1C ; RET C ; CP $26 ; CCF ; Complement Carry Flag RET C ; SUB $1C ; ; ------------------------ ; THE <b><font color=#333388>'STACK-A'</font></b> SUBROUTINE ; ------------------------ ; <a name="L151D"></a>;; <b>STACK-A</b> L151D: LD C,A ; LD B,$00 ; ; ------------------------- ; THE <b><font color=#333388>'STACK-BC'</font></b> SUBROUTINE ; ------------------------- ; The ZX81 does not have an integer number format so the BC register contents ; must be converted to their full floating-point form. <a name="L1520"></a>;; <b>STACK-BC</b> 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,<A href="#L1536">L1536</a> ; 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. <a name="L1536"></a>;; <b>STK-BC-2</b> L1536: DEC (HL) ; decrement exponent - halving number SLA C ; C<-76543210<-0 RL B ; C<-76543210<-C JR NC,<A href="#L1536">L1536</a> ; 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 <b><font color=#333388>'INTEGER TO FLOATING POINT'</font></b> SUBROUTINE ; ------------------------------------------ ; ; <a name="L1548"></a>;; <b>INT-TO-FP</b> L1548: PUSH AF ; RST 28H ;; FP-CALC DEFB $A0 ;;stk-zero DEFB $34 ;;end-calc POP AF ; <a name="L154D"></a>;; <b>NXT-DGT-2</b> L154D: CALL <A href="#L1514">L1514</a> ; 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 <A href="#L154D">L154D</a> ; to NXT-DGT-2 ; ------------------------------------------- ; THE <b><font color=#333388>'E-FORMAT TO FLOATING POINT'</font></b> SUBROUTINE ; ------------------------------------------- ; <font color=#339933>(Offset $38: 'e-to-fp')</font> ; 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. ; <font color=#9900FF>Note.</font> 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. <a name="L155A"></a>;; <b>e-to-fp</b> 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. <a name="L1560"></a>;; <b>E-LOOP</b> 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 <A href="#L1587">L1587</a>, 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 <A href="#L157A">L157A</a>, 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 <A href="#L157D">L157D</a>, E-CHUNK ; --- <a name="L157A"></a>;; <b>E-LOW</b> L157A: DEFB $02 ;;delete x, m-1. DEFB $01 ;;exchange m-1, x. DEFB $A4 ;;stk-ten m-1, x, 10 (=f). <a name="L157D"></a>;; <b>E-CHUNK</b> L157D: DEFB $E0 ;;get-mem-0 m-1, x, f, (1/0) DEFB $00 ;;jump-true m-1, x, f DEFB $04 ;;to <A href="#L1583">L1583</a>, E-DIVSN DEFB $04 ;;multiply m-1, x*f. DEFB $2F ;;jump DEFB $02 ;;to <A href="#L1584">L1584</a>, E-SWAP ; --- <a name="L1583"></a>;; <b>E-DIVSN</b> L1583: DEFB $05 ;;division m-1, x/f (= new x). <a name="L1584"></a>;; <b>E-SWAP</b> L1584: DEFB $01 ;;exchange x, m-1 (= new m). DEFB $2F ;;jump x, m. DEFB $DA ;;to <A href="#L1560">L1560</a>, E-LOOP ; --- <a name="L1587"></a>;; <b>E-END</b> L1587: DEFB $02 ;;delete x. (-1) DEFB $34 ;;end-calc x. RET ; return. ; ------------------------------------- ; THE <b><font color=#333388>'FLOATING-POINT TO BC'</font></b> 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 <a name="L158A"></a>;; <b>FP-TO-BC</b> L158A: CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH - exponent to A ; mantissa to EDCB. AND A ; test for value zero. JR NZ,<A href="#L1595">L1595</a> ; 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 <A href="#L15C6">L15C6</a> ; forward to FPBC-END ; --- ; EDCB => BCE <a name="L1595"></a>;; <b>FPBC-NZRO</b> 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,<A href="#L15C6">L15C6</a> ; 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,<A href="#L15AF">L15AF</a> ; 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 <a name="L15AF"></a>;; <b>BIG-INT</b> 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,<A href="#L15BC">L15BC</a> ; forward if exponent zero to EXP-ZERO ; the number is normalized <a name="L15B5"></a>;; <b>FPBC-NORM</b> L15B5: SRL B ; 0->76543210->C RR C ; C->76543210->C DEC D ; decrement exponent JR NZ,<A href="#L15B5">L15B5</a> ; loop back till zero to FPBC-NORM <a name="L15BC"></a>;; <b>EXP-ZERO</b> L15BC: JR NC,<A href="#L15C6">L15C6</a> ; forward without carry to NO-ROUND INC BC ; round up. LD A,B ; test result OR C ; for zero JR NZ,<A href="#L15C6">L15C6</a> ; forward if not to GRE-ZERO POP AF ; restore sign flag SCF ; set carry flag to indicate overflow PUSH AF ; save combined flags again <a name="L15C6"></a>;; <b>FPBC-END</b> 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 <b><font color=#333388>'FLOATING-POINT TO A'</font></b> SUBROUTINE ; ------------------------------------ ; ; <a name="L15CD"></a>;; <b>FP-TO-A</b> L15CD: CALL <A href="#L158A">L158A</a> ; routine FP-TO-BC RET C ; PUSH AF ; DEC B ; INC B ; JR Z,<A href="#L15D9">L15D9</a> ; forward if in range to FP-A-END POP AF ; fetch result SCF ; set carry flag signaling overflow RET ; return <a name="L15D9"></a>;; <b>FP-A-END</b> L15D9: POP AF ; RET ; ; ---------------------------------------------- ; THE <b><font color=#333388>'PRINT A FLOATING-POINT NUMBER'</font></b> 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. <a name="L15DB"></a>;; <b>PRINT-FP</b> 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 <A href="#L15EA">L15EA</a>, PF-NGTVE x. DEFB $2D ;;duplicate x, x DEFB $33 ;;greater-0 x, (1/0). DEFB $00 ;;jump-true DEFB $0D ;;to <A href="#L15F0">L15F0</a>, PF-POSTVE x. DEFB $02 ;;delete . DEFB $34 ;;end-calc . LD A,$1C ; load accumulator with character '0' RST 10H ; PRINT-A RET ; return. >> ; --- <a name="L15EA"></a>;; <b>PF-NEGTVE</b> 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. <a name="L15F0"></a>;; <b>PF-POSTVE</b> 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 <A href="#L151D">L151D</a> ; 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. <a name="L1615"></a>;; <b>PF-LOOP</b> 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 <A href="#L15CD">L15CD</a> ; 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 <A href="#L1615">L1615</a> ; 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. <a name="L162C"></a>;; <b>PF-NULL</b> L162C: DEC HL ; decrease pointer LD A,(HL) ; fetch masked digit CP $90 ; is it a leading zero ? JR Z,<A href="#L162C">L162C</a> ; 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. <a name="L1639"></a>;; <b>PF-RND-LP</b> 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,<A href="#L1639">L1639</a> ; 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. <a name="L164B"></a>;; <b>PF-ZERO-6</b> L164B: LD (HL),$80 ; insert a masked zero DEC HL ; decrease pointer. DJNZ <A href="#L164B">L164B</a> ; 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 <A href="#L15CD">L15CD</a> ; routine FP-TO-A JR Z,<A href="#L165B">L165B</a> ; skip forward if positive to PF-POS NEG ; negate makes positive <a name="L165B"></a>;; <b>PF-POS</b> L165B: LD E,A ; transfer count of digits to E INC E ; increment twice INC E ; POP HL ; * retrieve pointer to one past buffer. <a name="L165F"></a>;; <b>GET-FIRST</b> L165F: DEC HL ; decrement address. DEC E ; decrement digit counter. LD A,(HL) ; fetch masked byte. AND $0F ; isolate right-hand nibble. JR Z,<A href="#L165F">L165F</a> ; 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,<A href="#L1682">L1682</a> ; forward if positive to PF-E-FMT CP $F6 ; test for more than four zeros after point. JP M,<A href="#L1682">L1682</a> ; forward if so to PF-E-FMT ADD A,$06 ; test for zero leading digits, e.g. 0.5 JR Z,<A href="#L16BF">L16BF</a> ; forward if so to PF-ZERO-1 JP M,<A href="#L16B2">L16B2</a> ; 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. <a name="L167B"></a>;; <b>PF-NIB-LP</b> L167B: CALL <A href="#L16D0">L16D0</a> ; routine PF-NIBBLE DJNZ <A href="#L167B">L167B</a> ; loop back for counted numbers to PF-NIB-LP JR <A href="#L16C2">L16C2</a> ; forward to consider decimal part to PF-DC-OUT ; --- <a name="L1682"></a>;; <b>PF-E-FMT</b> L1682: LD B,E ; count to B CALL <A href="#L16D0">L16D0</a> ; routine PF-NIBBLE prints one digit. CALL <A href="#L16C2">L16C2</a> ; 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,<A href="#L1698">L1698</a> ; 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 <A href="#L169A">L169A</a> ; skip forward to PF-E-SIGN ; --- <a name="L1698"></a>;; <b>PF-E-POS</b> L1698: LD A,$15 ; prepare character '+' <a name="L169A"></a>;; <b>PF-E-SIGN</b> 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. <a name="L169E"></a>;; <b>PF-E-TENS</b> L169E: INC B ; increment ten count SUB $0A ; subtract ten from exponent JR NC,<A href="#L169E">L169E</a> ; 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,<A href="#L16AD">L16AD</a> ; skip forward if so to PF-E-LOW CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE prints as digit '1' - '9' <a name="L16AD"></a>;; <b>PF-E-LOW</b> L16AD: LD A,C ; low byte to A CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE prints final digit of the ; exponent. RET ; return. >> ; --- ; this branch deals with zeros after decimal point. ; e.g. .01 or .0000999 <a name="L16B2"></a>;; <b>PF-ZEROS</b> 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' <a name="L16BA"></a>;; <b>PF-ZRO-LP</b> L16BA: RST 10H ; PRINT-A DJNZ <A href="#L16BA">L16BA</a> ; loop back to PF-ZRO-LP JR <A href="#L16C8">L16C8</a> ; forward to PF-FRAC-LP ; --- ; there is a need to print a leading zero e.g. 0.1 but not with .01 <a name="L16BF"></a>;; <b>PF-ZERO-1</b> 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. <a name="L16C2"></a>;; <b>PF-DC-OUT</b> 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 <a name="L16C8"></a>;; <b>PF-FRAC-LP</b> L16C8: DEC (HL) ; test for a marked zero. INC (HL) ; RET PE ; return when digits exhausted >> CALL <A href="#L16D0">L16D0</a> ; routine PF-NIBBLE JR <A href="#L16C8">L16C8</a> ; back for all fractional digits to PF-FRAC-LP. ; --- ; subroutine to print right-hand nibble <a name="L16D0"></a>;; <b>PF-NIBBLE</b> L16D0: LD A,(HL) ; fetch addressed byte AND $0F ; mask off lower 4 bits CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE DEC HL ; decrement pointer. RET ; return. ; ------------------------------- ; THE <b><font color=#333388>'PREPARE TO ADD'</font></b> 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. <a name="L16D8"></a>;; <b>PREP-ADD</b> 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. <a name="L16EC"></a>;; <b>NEG-BYTE</b> 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 <A href="#L16EC">L16EC</a> ; loop back five times to NEG-BYTE LD A,C ; restore the exponent to accumulator. POP BC ; restore B register contents. RET ; return. ; ---------------------------------- ; THE <b><font color=#333388>'FETCH TWO NUMBERS'</font></b> 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 <a name="L16F7"></a>;; <b>FETCH-TWO</b> 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 <b><font color=#333388>'SHIFT ADDEND'</font></b> SUBROUTINE ; ----------------------------- ; The accumulator A contains the difference between the two exponents. ; This is the lowest of the two numbers to be added <a name="L171A"></a>;; <b>SHIFT-FP</b> L171A: AND A ; test difference between exponents. RET Z ; return if zero. both normal. CP $21 ; compare with 33 bits. JR NC,<A href="#L1736">L1736</a> ; 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 <a name="L1722"></a>;; <b>ONE-SHIFT</b> 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 <A href="#L1722">L1722</a> ; 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 <A href="#L1741">L1741</a> ; 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. <a name="L1736"></a>;; <b>ADDEND-0</b> 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. <a name="L1738"></a>;; <b>ZEROS-4/5</b> 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 <b><font color=#333388>'ADD-BACK'</font></b> 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. <a name="L1741"></a>;; <b>ADD-BACK</b> L1741: INC E ; RET NZ ; INC D ; RET NZ ; EXX ; INC E ; JR NZ,<A href="#L174A">L174A</a> ; forward if no overflow to ALL-ADDED INC D ; <a name="L174A"></a>;; <b>ALL-ADDED</b> L174A: EXX ; RET ; return with zero flag set for zero mantissa. ; --------------------------- ; THE <b><font color=#333388>'SUBTRACTION'</font></b> OPERATION ; --------------------------- ; just switch the sign of subtrahend and do an add. <a name="L174C"></a>;; <b>subtract</b> 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 <b><font color=#333388>'ADDITION'</font></b> 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. <a name="L1755"></a>;; <b>addition</b> 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 <A href="#L16D8">L16D8</a> ; routine PREP-ADD LD B,A ; save first exponent byte in B. EX DE,HL ; switch number pointers. CALL <A href="#L16D8">L16D8</a> ; routine PREP-ADD LD C,A ; save second exponent byte in C. CP B ; compare the exponent bytes. JR NC,<A href="#L1769">L1769</a> ; 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. <a name="L1769"></a>;; <b>SHIFT-LEN</b> L1769: PUSH AF ; save higher exponent SUB B ; subtract lower exponent CALL <A href="#L16F7">L16F7</a> ; routine FETCH-TWO CALL <A href="#L171A">L171A</a> ; 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,<A href="#L1790">L1790</a> ; 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 <A href="#L171A">L171A</a> ; routine SHIFT-FP performs a single shift ; rounding any lost bit INC (HL) ; increment the exponent. JR Z,<A href="#L17B3">L17B3</a> ; 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. <a name="L1790"></a>;; <b>TEST-NEG</b> 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,<A href="#L17B9">L17B9</a> ; 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,<A href="#L17B7">L17B7</a> ; 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. <a name="L17B3"></a>;; <b>ADD-REP-6</b> L17B3: JP Z,<A href="#L1880">L1880</a> ; jump forward if exponent now zero to REPORT-6 ; 'Number too big' EXX ; switch back to alternate set. <a name="L17B7"></a>;; <b>END-COMPL</b> L17B7: LD D,A ; put first byte of mantissa back in DE. EXX ; switch to main set. <a name="L17B9"></a>;; <b>GO-NC-MLT</b> L17B9: XOR A ; clear carry flag and ; clear accumulator so no extra bits carried ; forward as occurs in multiplication. JR <A href="#L1828">L1828</a> ; forward to common code at TEST-NORM ; but should go straight to NORMALIZE. ; ---------------------------------------------- ; THE <b><font color=#333388>'PREPARE TO MULTIPLY OR DIVIDE'</font></b> 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. <a name="L17BC"></a>;; <b>PREP-M/D</b> 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 <b><font color=#333388>'MULTIPLICATION'</font></b> OPERATION ; ------------------------------ ; ; <a name="L17C6"></a>;; <b>multiply</b> L17C6: XOR A ; reset bit 7 of running sign flag. CALL <A href="#L17BC">L17BC</a> ; 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 <A href="#L17BC">L17BC</a> ; routine PREP-M/D EX DE,HL ; HL first number, DE - second number JR C,<A href="#L1830">L1830</a> ; forward with carry to ZERO-RSLT ; anything * zero = zero. PUSH HL ; save pointer to first number. CALL <A href="#L16F7">L16F7</a> ; 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 <A href="#L17F8">L17F8</a> ; forward to loop entry point STRT-MLT ; --- ; The multiplication loop is entered at STRT-LOOP. <a name="L17E7"></a>;; <b>MLT-LOOP</b> L17E7: JR NC,<A href="#L17EE">L17EE</a> ; 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 <a name="L17EE"></a>;; <b>NO-ADD</b> 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 <a name="L17F8"></a>;; <b>STRT-MLT</b> 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 <A href="#L17E7">L17E7</a> ; 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,<A href="#L180E">L180E</a> ; forward to MAKE-EXPT AND A ; <a name="L180E"></a>;; <b>MAKE-EXPT</b> L180E: DEC A ; CCF ; Complement Carry Flag <a name="L1810"></a>;; <b>DIVN-EXPT</b> L1810: RLA ; CCF ; Complement Carry Flag RRA ; JP P,<A href="#L1819">L1819</a> ; forward to OFLW1-CLR JR NC,<A href="#L1880">L1880</a> ; forward to REPORT-6 AND A ; <a name="L1819"></a>;; <b>OFLW1-CLR</b> L1819: INC A ; JR NZ,<A href="#L1824">L1824</a> ; forward to OFLW2-CLR JR C,<A href="#L1824">L1824</a> ; forward to OFLW2-CLR EXX ; BIT 7,D ; EXX ; JR NZ,<A href="#L1880">L1880</a> ; forward to REPORT-6 <a name="L1824"></a>;; <b>OFLW2-CLR</b> L1824: LD (HL),A ; EXX ; LD A,B ; EXX ; ; addition joins here with carry flag clear. <a name="L1828"></a>;; <b>TEST-NORM</b> L1828: JR NC,<A href="#L183F">L183F</a> ; forward to NORMALIZE LD A,(HL) ; AND A ; <a name="L182C"></a>;; <b>NEAR-ZERO</b> L182C: LD A,$80 ; prepare to rescue the most significant bit ; of the mantissa if it is set. JR Z,<A href="#L1831">L1831</a> ; skip forward to SKIP-ZERO <a name="L1830"></a>;; <b>ZERO-RSLT</b> L1830: XOR A ; make mask byte zero signaling set five ; bytes to zero. <a name="L1831"></a>;; <b>SKIP-ZERO</b> L1831: EXX ; switch in alternate set AND D ; isolate most significant bit (if A is $80). CALL <A href="#L1738">L1738</a> ; 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,<A href="#L1868">L1868</a> ; 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 <A href="#L1868">L1868</a> ; forward to OFLOW-CLR ; --- ; this branch is common to addition and multiplication with the mantissa ; result still in registers D'E'D E . <a name="L183F"></a>;; <b>NORMALIZE</b> L183F: LD B,$20 ; a maximum of thirty-two left shifts will be ; needed. <a name="L1841"></a>;; <b>SHIFT-ONE</b> L1841: EXX ; address higher 16 bits. BIT 7,D ; test the leftmost bit EXX ; address lower 16 bits. JR NZ,<A href="#L1859">L1859</a> ; 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,<A href="#L182C">L182C</a> ; 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 <A href="#L1841">L1841</a> ; loop back to SHIFT-ONE ; if thirty-two left shifts were performed without setting the most significant ; bit then the result is zero. JR <A href="#L1830">L1830</a> ; back to ZERO-RSLT ; --- <a name="L1859"></a>;; <b>NORML-NOW</b> L1859: RLA ; for the addition path, A is always zero. ; for the mult path, ... JR NC,<A href="#L1868">L1868</a> ; forward to OFLOW-CLR ; this branch is taken only with multiplication. CALL <A href="#L1741">L1741</a> ; routine ADD-BACK JR NZ,<A href="#L1868">L1868</a> ; forward to OFLOW-CLR EXX ; LD D,$80 ; EXX ; INC (HL) ; JR Z,<A href="#L1880">L1880</a> ; forward to REPORT-6 ; now transfer the mantissa from the register sets to the calculator stack ; incorporating the sign bit already there. <a name="L1868"></a>;; <b>OFLOW-CLR</b> 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. ; --- <a name="L1880"></a>;; <b>REPORT-6</b> L1880: RST 08H ; ERROR-1 DEFB $05 ; Error Report: Arithmetic overflow. ; ------------------------ ; THE <b><font color=#333388>'DIVISION'</font></b> 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. <a name="L1882"></a>;; <b>division</b> L1882: EX DE,HL ; consider the second number first. XOR A ; set the running sign flag. CALL <A href="#L17BC">L17BC</a> ; routine PREP-M/D JR C,<A href="#L1880">L1880</a> ; back if zero to REPORT-6 ; 'Arithmetic overflow' EX DE,HL ; now prepare first number and check for zero. CALL <A href="#L17BC">L17BC</a> ; 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 <A href="#L16F7">L16F7</a> ; 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 <A href="#L18B2">L18B2</a> ; forward to mid-loop entry point DIV-START ; --- <a name="L18A2"></a>;; <b>DIV-LOOP</b> L18A2: RLA ; multiply partial quotient by two RL C ; setting result bit from carry. EXX ; RL C ; RL B ; EXX ; <a name="L18AB"></a>;; <b>div-34th</b> L18AB: ADD HL,HL ; EXX ; ADC HL,HL ; EXX ; JR C,<A href="#L18C2">L18C2</a> ; forward to SUBN-ONLY <a name="L18B2"></a>;; <b>DIV-START</b> L18B2: SBC HL,DE ; subtract divisor part. EXX ; SBC HL,DE ; EXX ; JR NC,<A href="#L18C9">L18C9</a> ; forward if subtraction goes to NO-RSTORE ADD HL,DE ; else restore EXX ; ADC HL,DE ; EXX ; AND A ; clear carry JR <A href="#L18CA">L18CA</a> ; forward to COUNT-ONE ; --- <a name="L18C2"></a>;; <b>SUBN-ONLY</b> L18C2: AND A ; SBC HL,DE ; EXX ; SBC HL,DE ; EXX ; <a name="L18C9"></a>;; <b>NO-RSTORE</b> L18C9: SCF ; set carry flag <a name="L18CA"></a>;; <b>COUNT-ONE</b> L18CA: INC B ; increment the counter JP M,<A href="#L18A2">L18A2</a> ; back while still minus to DIV-LOOP PUSH AF ; JR Z,<A href="#L18B2">L18B2</a> ; 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. ; (<font color=#9900FF>Note.</font> 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 <A href="#L1810">L1810</a> ; jump back to DIVN-EXPT ; ------------------------------------------------ ; THE <b><font color=#333388>'INTEGER TRUNCATION TOWARDS ZERO'</font></b> SUBROUTINE ; ------------------------------------------------ ; <a name="L18E4"></a>;; <b>truncate</b> L18E4: LD A,(HL) ; fetch exponent CP $81 ; compare to +1 JR NC,<A href="#L18EF">L18EF</a> ; 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 <A href="#L18F4">L18F4</a> ; forward to NIL-BYTES ; --- <a name="L18EF"></a>;; <b>T-GR-ZERO</b> 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. <a name="L18F4"></a>;; <b>NIL-BYTES</b> 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,<A href="#L1905">L1905</a> ; forward if zero to BITS-ZERO ; else the original count was eight or more and whole bytes can be blanked. <a name="L1900"></a>;; <b>BYTE-ZERO</b> L1900: LD (HL),$00 ; set eight bits to zero. DEC HL ; point to more significant byte of mantissa. DJNZ <A href="#L1900">L1900</a> ; loop back to BYTE-ZERO ; now consider any residual bits. <a name="L1905"></a>;; <b>BITS-ZERO</b> L1905: AND $07 ; isolate the remaining bits JR Z,<A href="#L1912">L1912</a> ; forward if none to IX-END LD B,A ; transfer bit count to B counter. LD A,$FF ; form a mask 11111111 <a name="L190C"></a>;; <b>LESS-MASK</b> L190C: SLA A ; 1 <- 76543210 <- o slide mask leftwards. DJNZ <A href="#L190C">L190C</a> ; loop back for bit count to LESS-MASK AND (HL) ; lose the unwanted rightmost bits LD (HL),A ; and place in mantissa byte. <a name="L1912"></a>;; <b>IX-END</b> 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 <b><font color=#333388>'TABLE OF CONSTANTS'</font></b> ; ------------------------ ; The ZX81 has only floating-point number representation. ; Both the ZX80 and the ZX Spectrum have integer numbers in some form. <a name="L1915"></a>;; <b>stk-zero</b> 00 00 00 00 00 L1915: DEFB $00 ;;Bytes: 1 DEFB $B0 ;;Exponent $00 DEFB $00 ;;(+00,+00,+00) <a name="L1918"></a>;; <b>stk-one</b> 81 00 00 00 00 L1918: DEFB $31 ;;Exponent $81, Bytes: 1 DEFB $00 ;;(+00,+00,+00) <a name="L191A"></a>;; <b>stk-half</b> 80 00 00 00 00 L191A: DEFB $30 ;;Exponent: $80, Bytes: 1 DEFB $00 ;;(+00,+00,+00) <a name="L191C"></a>;; <b>stk-pi/2</b> 81 49 0F DA A2 L191C: DEFB $F1 ;;Exponent: $81, Bytes: 4 DEFB $49,$0F,$DA,$A2 ;; <a name="L1921"></a>;; <b>stk-ten</b> 84 20 00 00 00 L1921: DEFB $34 ;;Exponent: $84, Bytes: 1 DEFB $20 ;;(+00,+00,+00) ; ------------------------ ; THE <b><font color=#333388>'TABLE OF ADDRESSES'</font></b> ; ------------------------ ; ; starts with binary operations which have two operands and one result. ; three pseudo binary operations first. <a name="L1923"></a>;; <b>tbl-addrs</b> L1923: DEFW <A href="#L1C2F">L1C2F</a> ; $00 Address: $1C2F - jump-true DEFW <A href="#L1A72">L1A72</a> ; $01 Address: $1A72 - exchange DEFW <A href="#L19E3">L19E3</a> ; $02 Address: $19E3 - delete ; true binary operations. DEFW <A href="#L174C">L174C</a> ; $03 Address: $174C - subtract DEFW <A href="#L17C6">L17C6</a> ; $04 Address: $176C - multiply DEFW <A href="#L1882">L1882</a> ; $05 Address: $1882 - division DEFW <A href="#L1DE2">L1DE2</a> ; $06 Address: $1DE2 - to-power DEFW <A href="#L1AED">L1AED</a> ; $07 Address: $1AED - or DEFW <A href="#L1AF3">L1AF3</a> ; $08 Address: $1B03 - no-&-no DEFW <A href="#L1B03">L1B03</a> ; $09 Address: $1B03 - no-l-eql DEFW <A href="#L1B03">L1B03</a> ; $0A Address: $1B03 - no-gr-eql DEFW <A href="#L1B03">L1B03</a> ; $0B Address: $1B03 - nos-neql DEFW <A href="#L1B03">L1B03</a> ; $0C Address: $1B03 - no-grtr DEFW <A href="#L1B03">L1B03</a> ; $0D Address: $1B03 - no-less DEFW <A href="#L1B03">L1B03</a> ; $0E Address: $1B03 - nos-eql DEFW <A href="#L1755">L1755</a> ; $0F Address: $1755 - addition DEFW <A href="#L1AF8">L1AF8</a> ; $10 Address: $1AF8 - str-&-no DEFW <A href="#L1B03">L1B03</a> ; $11 Address: $1B03 - str-l-eql DEFW <A href="#L1B03">L1B03</a> ; $12 Address: $1B03 - str-gr-eql DEFW <A href="#L1B03">L1B03</a> ; $13 Address: $1B03 - strs-neql DEFW <A href="#L1B03">L1B03</a> ; $14 Address: $1B03 - str-grtr DEFW <A href="#L1B03">L1B03</a> ; $15 Address: $1B03 - str-less DEFW <A href="#L1B03">L1B03</a> ; $16 Address: $1B03 - strs-eql DEFW <A href="#L1B62">L1B62</a> ; $17 Address: $1B62 - strs-add ; unary follow DEFW <A href="#L1AA0">L1AA0</a> ; $18 Address: $1AA0 - neg DEFW <A href="#L1C06">L1C06</a> ; $19 Address: $1C06 - code DEFW <A href="#L1BA4">L1BA4</a> ; $1A Address: $1BA4 - val DEFW <A href="#L1C11">L1C11</a> ; $1B Address: $1C11 - len DEFW <A href="#L1D49">L1D49</a> ; $1C Address: $1D49 - sin DEFW <A href="#L1D3E">L1D3E</a> ; $1D Address: $1D3E - cos DEFW <A href="#L1D6E">L1D6E</a> ; $1E Address: $1D6E - tan DEFW <A href="#L1DC4">L1DC4</a> ; $1F Address: $1DC4 - asn DEFW <A href="#L1DD4">L1DD4</a> ; $20 Address: $1DD4 - acs DEFW <A href="#L1D76">L1D76</a> ; $21 Address: $1D76 - atn DEFW <A href="#L1CA9">L1CA9</a> ; $22 Address: $1CA9 - ln DEFW <A href="#L1C5B">L1C5B</a> ; $23 Address: $1C5B - exp DEFW <A href="#L1C46">L1C46</a> ; $24 Address: $1C46 - int DEFW <A href="#L1DDB">L1DDB</a> ; $25 Address: $1DDB - sqr DEFW <A href="#L1AAF">L1AAF</a> ; $26 Address: $1AAF - sgn DEFW <A href="#L1AAA">L1AAA</a> ; $27 Address: $1AAA - abs DEFW <A href="#L1ABE">L1ABE</a> ; $28 Address: $1A1B - peek DEFW <A href="#L1AC5">L1AC5</a> ; $29 Address: $1AC5 - usr-no DEFW <A href="#L1BD5">L1BD5</a> ; $2A Address: $1BD5 - str$ DEFW <A href="#L1B8F">L1B8F</a> ; $2B Address: $1B8F - chrs DEFW <A href="#L1AD5">L1AD5</a> ; $2C Address: $1AD5 - not ; end of true unary DEFW <A href="#L19F6">L19F6</a> ; $2D Address: $19F6 - duplicate DEFW <A href="#L1C37">L1C37</a> ; $2E Address: $1C37 - n-mod-m DEFW <A href="#L1C23">L1C23</a> ; $2F Address: $1C23 - jump DEFW <A href="#L19FC">L19FC</a> ; $30 Address: $19FC - stk-data DEFW <A href="#L1C17">L1C17</a> ; $31 Address: $1C17 - dec-jr-nz DEFW <A href="#L1ADB">L1ADB</a> ; $32 Address: $1ADB - less-0 DEFW <A href="#L1ACE">L1ACE</a> ; $33 Address: $1ACE - greater-0 DEFW <A href="#L002B">L002B</a> ; $34 Address: $002B - end-calc DEFW <A href="#L1D18">L1D18</a> ; $35 Address: $1D18 - get-argt DEFW <A href="#L18E4">L18E4</a> ; $36 Address: $18E4 - truncate DEFW <A href="#L19E4">L19E4</a> ; $37 Address: $19E4 - fp-calc-2 DEFW <A href="#L155A">L155A</a> ; $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 <A href="#L1A7F">L1A7F</a> ; $39 Address: $1A7F - series-xx $80 - $9F. DEFW <A href="#L1A51">L1A51</a> ; $3A Address: $1A51 - stk-const-xx $A0 - $BF. DEFW <A href="#L1A63">L1A63</a> ; $3B Address: $1A63 - st-mem-xx $C0 - $DF. DEFW <A href="#L1A45">L1A45</a> ; $3C Address: $1A45 - get-mem-xx $E0 - $FF. ; Aside: 3D - 7F are therefore unused calculator literals. ; 39 - 7B would be available for expansion. ; ------------------------------- ; THE <b><font color=#333388>'FLOATING POINT CALCULATOR'</font></b> ; ------------------------------- ; ; <a name="L199D"></a>;; <b>CALCULATE</b> L199D: CALL <A href="#L1B85">L1B85</a> ; 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... <a name="L19A0"></a>;; <b>GEN-ENT-1</b> 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 <a name="L19A4"></a>;; <b>GEN-ENT-2</b> 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. <a name="L19A7"></a>;; <b>RE-ENTRY</b> 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 <a name="L19AE"></a>;; <b>SCAN-ENT</b> L19AE: PUSH HL ; save pointer on stack * AND A ; now test the literal JP P,<A href="#L19C2">L19C2</a> ; 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 <A href="#L19D0">L19D0</a> ; forward to ENT-TABLE ; --- ; the branch was here with simple literals. <a name="L19C2"></a>;; <b>FIRST-3D</b> L19C2: CP $18 ; compare with first unary operations. JR NC,<A href="#L19CE">L19CE</a> ; 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 ; <a name="L19CE"></a>;; <b>DOUBLE-A</b> L19CE: RLCA ; double the literal LD L,A ; and store in L for indexing <a name="L19D0"></a>;; <b>ENT-TABLE</b> L19D0: LD DE,<A href="#L1923">L1923</a> ; 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,<A href="#L19A7">L19A7</a> ; 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 <b><font color=#333388>'DELETE'</font></b> 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 <a name="L19E3"></a>;; <b>delete</b> L19E3: RET ; return - indirect jump if from above. ; --------------------------------- ; THE <b><font color=#333388>'SINGLE OPERATION'</font></b> 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. <a name="L19E4"></a>;; <b>fp-calc-2</b> 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 <A href="#L19AE">L19AE</a> ; back to SCAN-ENT ; next literal will be end-calc in scanning ; ------------------------------ ; THE <b><font color=#333388>'TEST 5 SPACES'</font></b> 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. <a name="L19EB"></a>;; <b>TEST-5-SP</b> L19EB: PUSH DE ; save PUSH HL ; registers LD BC,$0005 ; an overhead of five bytes CALL <A href="#L0EC5">L0EC5</a> ; 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 <b><font color=#333388>'MOVE A FLOATING POINT NUMBER'</font></b> 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 <a name="L19F6"></a>;; <b>duplicate</b> <a name="L19F6"></a>;; <b>MOVE-FP</b> L19F6: CALL <A href="#L19EB">L19EB</a> ; 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 <b><font color=#333388>'STACK LITERALS'</font></b> 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. <a name="L19FC"></a>;; <b>stk-data</b> L19FC: LD H,D ; transfer STKEND LD L,E ; to HL for result. <a name="L19FE"></a>;; <b>STK-CONST</b> L19FE: CALL <A href="#L19EB">L19EB</a> ; 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,<A href="#L1A14">L1A14</a> ; 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). <a name="L1A14"></a>;; <b>FORM-EXP</b> 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 <a name="L1A27"></a>;; <b>STK-ZEROS</b> 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 <A href="#L1A27">L1A27</a> ; loop back to STK-ZEROS until done. ; ------------------------------- ; THE <b><font color=#333388>'SKIP CONSTANTS'</font></b> 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. <a name="L1A2D"></a>;; <b>SKIP-CONS</b> L1A2D: AND A ; test if initially zero. <a name="L1A2E"></a>;; <b>SKIP-NEXT</b> 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 ; <font color=#9900FF>Note.</font> not a fault but this has to be ; moved elsewhere when running in RAM. ; CALL <A href="#L19FE">L19FE</a> ; routine STK-CONST works through variable ; length records. POP DE ; restore real STKEND POP AF ; restore count DEC A ; decrease JR <A href="#L1A2E">L1A2E</a> ; loop back to SKIP-NEXT ; -------------------------------- ; THE <b><font color=#333388>'MEMORY LOCATION'</font></b> 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. <a name="L1A3C"></a>;; <b>LOC-MEM</b> 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 <b><font color=#333388>'GET FROM MEMORY AREA'</font></b> SUBROUTINE ; ------------------------------------- ; offsets $E0 to $FF: 'get-mem-0', 'get-mem-1' etc. ; A holds $00-$1F offset. ; The calculator stack increases by 5 bytes. <a name="L1A45"></a>;; <b>get-mem-xx</b> L1A45: PUSH DE ; save STKEND LD HL,($401F) ; MEM is base address of the memory cells. CALL <A href="#L1A3C">L1A3C</a> ; routine LOC-MEM so that HL = first byte CALL <A href="#L19F6">L19F6</a> ; 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 <b><font color=#333388>'STACK A CONSTANT'</font></b> 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. <a name="L1A51"></a>;; <b>stk-const-xx</b> L1A51: LD H,D ; save STKEND - required for result LD L,E ; EXX ; swap PUSH HL ; save pointer to next literal LD HL,<A href="#L1915">L1915</a> ; Address: stk-zero - start of table of ; constants EXX ; CALL <A href="#L1A2D">L1A2D</a> ; routine SKIP-CONS CALL <A href="#L19FE">L19FE</a> ; routine STK-CONST EXX ; POP HL ; restore pointer to next literal. EXX ; RET ; return. ; --------------------------------------- ; THE <b><font color=#333388>'STORE IN A MEMORY AREA'</font></b> 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. <a name="L1A63"></a>;; <b>st-mem-xx</b> L1A63: PUSH HL ; save the result pointer. EX DE,HL ; transfer to DE. LD HL,($401F) ; fetch MEM the base of memory area. CALL <A href="#L1A3C">L1A3C</a> ; routine LOC-MEM sets HL to the destination. EX DE,HL ; swap - HL is start, DE is destination. CALL <A href="#L19F6">L19F6</a> ; 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 <b><font color=#333388>'EXCHANGE'</font></b> 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. <a name="L1A72"></a>;; <b>exchange</b> L1A72: LD B,$05 ; there are five bytes to be swapped ; start of loop. <a name="L1A74"></a>;; <b>SWAP-BYTE</b> 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 <A href="#L1A74">L1A74</a> ; loop back to SWAP-BYTE until all 5 done. EX DE,HL ; even up the exchanges ; so that DE addresses STKEND. RET ; return. ; --------------------------------- ; THE <b><font color=#333388>'SERIES GENERATOR'</font></b> 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. <a name="L1A7F"></a>;; <b>series-xx</b> L1A7F: LD B,A ; parameter $00 - $1F to B counter CALL <A href="#L19A0">L19A0</a> ; 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 <a name="L1A89"></a>;; <b>G-LOOP</b> 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 <A href="#L19FC">L19FC</a> ; routine STK-DATA is called directly to ; push a value and advance H'L'. CALL <A href="#L19A4">L19A4</a> ; 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 <A href="#L1A89">L1A89</a>, 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. <a name="L1AA0"></a>;; <b>NEGATE</b> <a name="L1AA0"></a>;; <b>negate</b> 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. <a name="L1AAA"></a>;; <b>abs</b> 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. <a name="L1AAF"></a>;; <b>sgn</b> 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,<A href="#L1AE0">L1AE0</a> ; 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. <a name="L1ABE"></a>;; <b>peek</b> L1ABE: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT puts address in BC. LD A,(BC) ; load contents into A register. <a name="L1AC2"></a>;; <b>IN-PK-STK</b> L1AC2: JP <A href="#L151D">L151D</a> ; 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. ; <font color=#9900FF>Note.</font> that STACK-BC re-initializes the IY register to $4000 if a user-written ; program has altered it. <a name="L1AC5"></a>;; <b>usr-no</b> L1AC5: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT to fetch the ; supplied address into BC. LD HL,<A href="#L1520">L1520</a> ; 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. <a name="L1ACE"></a>;; <b>GREATER-0</b> <a name="L1ACE"></a>;; <b>greater-0</b> 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 <A href="#L1ADC">L1ADC</a> ; 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. <a name="L1AD5"></a>;; <b>NOT</b> <a name="L1AD5"></a>;; <b>not</b> L1AD5: LD A,(HL) ; get exponent byte. NEG ; negate - sets carry if non-zero. CCF ; complement so carry set if zero, else reset. JR <A href="#L1AE0">L1AE0</a> ; 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. <a name="L1ADB"></a>;; <b>less-0</b> L1ADB: XOR A ; set xor mask to zero ; (carry will become set if sign is negative). ; transfer sign of mantissa to Carry Flag. <a name="L1ADC"></a>;; <b>SIGN-TO-C</b> 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. <a name="L1AE0"></a>;; <b>FP-0/1</b> L1AE0: PUSH HL ; save pointer to the first byte LD B,$05 ; five bytes to do. <a name="L1AE3"></a>;; <b>FP-loop</b> L1AE3: LD (HL),$00 ; insert a zero. INC HL ; DJNZ <A href="#L1AE3">L1AE3</a> ; 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). <a name="L1AED"></a>;; <b>or</b> L1AED: LD A,(DE) ; fetch exponent of second number AND A ; test it. RET Z ; return if zero. SCF ; set carry flag JR <A href="#L1AE0">L1AE0</a> ; 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. <a name=""></a>;; <b>no-&-no</b> L1AF3: LD A,(DE) ; fetch exponent of second number. AND A ; test it. RET NZ ; return if not zero. JR <A href="#L1AE0">L1AE0</a> ; 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. <a name=""></a>;; <b>str-&-no</b> 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 <b><font color=#333388>'x>y'</font></b> 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. <a name="L1B03"></a>;; <b>no-l-eql,etc.</b> L1B03: LD A,B ; transfer literal to accumulator. SUB $08 ; subtract eight - which is not useful. BIT 2,A ; isolate '>', '<', '='. JR NZ,<A href="#L1B0B">L1B0B</a> ; skip to EX-OR-NOT with these. DEC A ; else make $00-$02, $08-$0A to match bits 0-2. <a name="L1B0B"></a>;; <b>EX-OR-NOT</b> L1B0B: RRCA ; the first RRCA sets carry for a swap. JR NC,<A href="#L1B16">L1B16</a> ; 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 <A href="#L1A72">L1A72</a> ; 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. ; <font color=#9900FF>Note.</font> 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. <a name="L1B16"></a>;; <b>NU-OR-STR</b> L1B16: BIT 2,A ; test if a string comparison. JR NZ,<A href="#L1B21">L1B21</a> ; 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 <A href="#L174C">L174C</a> ; routine subtract leaves result on stack. JR <A href="#L1B54">L1B54</a> ; forward to END-TESTS ; --- <a name="L1B21"></a>;; <b>STRINGS</b> L1B21: RRCA ; 2nd RRCA causes eql/neql to set carry. PUSH AF ; save A and carry. CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH gets 2nd string params PUSH DE ; save start2 *. PUSH BC ; and the length. CALL <A href="#L13F8">L13F8</a> ; 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. <a name="L1B2C"></a>;; <b>BYTE-COMP</b> 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,<A href="#L1B3D">L1B3D</a> ; forward to SEC-PLUS if second not null. OR C ; test length of first string. <a name="L1B33"></a>;; <b>SECND-LOW</b> L1B33: POP BC ; pop the second length off stack. JR Z,<A href="#L1B3A">L1B3A</a> ; 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. ; <font color=#9900FF>Note.</font> 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 <A href="#L1B50">L1B50</a> ; forward to leave via STR-TEST ; --- ; the branch was here with a match <a name="L1B3A"></a>;; <b>BOTH-NULL</b> L1B3A: POP AF ; restore carry - set for eql/neql JR <A href="#L1B50">L1B50</a> ; forward to STR-TEST ; --- ; the branch was here when 2nd string not null and low byte of first is yet ; to be tested. <a name="L1B3D"></a>;; <b>SEC-PLUS</b> L1B3D: OR C ; test the length of first string. JR Z,<A href="#L1B4D">L1B4D</a> ; 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,<A href="#L1B4D">L1B4D</a> ; forward to FRST-LESS if carry set JR NZ,<A href="#L1B33">L1B33</a> ; 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 <A href="#L1B2C">L1B2C</a> ; back to BYTE-COMP ; --- ; the false condition. <a name="L1B4D"></a>;; <b>FRST-LESS</b> L1B4D: POP BC ; discard length POP AF ; pop A AND A ; clear the carry for false result. ; --- ; exact match and x$>y$ rejoin here <a name="L1B50"></a>;; <b>STR-TEST</b> 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. <a name="L1B54"></a>;; <b>END-TESTS</b> L1B54: POP AF ; pop carry - will be set if eql/neql PUSH AF ; save it again. CALL C,<A href="#L1AD5">L1AD5</a> ; routine NOT sets true(1) if equal(0) ; or, for strings, applies true result. CALL <A href="#L1ACE">L1ACE</a> ; greater-0 ?????????? POP AF ; pop A RRCA ; the third RRCA - test for '<=', '>=' or '<>'. CALL NC,<A href="#L1AD5">L1AD5</a> ; 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. <a name="L1B62"></a>;; <b>strs-add</b> L1B62: CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH fetches string parameters ; and deletes calculator stack entry. PUSH DE ; save start address. PUSH BC ; and length. CALL <A href="#L13F8">L13F8</a> ; 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 <A href="#L12C3">L12C3</a> ; 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,<A href="#L1B7D">L1B7D</a> ; to OTHER-STR if null string LDIR ; copy string to workspace. <a name="L1B7D"></a>;; <b>OTHER-STR</b> 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,<A href="#L1B85">L1B85</a> ; 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. <a name="L1B85"></a>;; <b>STK-PNTRS</b> 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". ; <font color=#9900FF>Note.</font> the ZX81 does not have an ASCII character set. <a name="L1B8F"></a>;; <b>chrs</b> L1B8F: CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A puts the number in A. JR C,<A href="#L1BA2">L1BA2</a> ; forward to REPORT-Bd if overflow JR NZ,<A href="#L1BA2">L1BA2</a> ; 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 <A href="#L12C3">L12C3</a> ; routine STK-STO-$ stacks descriptor. EX DE,HL ; make HL point to result and DE to STKEND. RET ; return. ; --- <a name="L1BA2"></a>;; <b>REPORT-Bd</b> 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. <a name="L1BA4"></a>;; <b>val</b> L1BA4: LD HL,($4016) ; fetch value of system variable CH_ADD PUSH HL ; and save on the machine stack. CALL <A href="#L13F8">L13F8</a> ; 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 <A href="#L0D92">L0D92</a> ; routine CLASS-06 - SCANNING evaluates string ; expression and checks for integer result. CALL <A href="#L0D22">L0D22</a> ; 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 <A href="#L0F55">L0F55</a> ; 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 <A href="#L1B85">L1B85</a> ; 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. <a name="L1BD5"></a>;; <b>str$</b> 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 <A href="#L15DB">L15DB</a> ; 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 <A href="#L12C3">L12C3</a> ; routine STK-STO-$ stores the string ; descriptor on the calculator stack. EX DE,HL ; HL = last value, DE = STKEND. RET ; return. ; ------------------- ; THE <b><font color=#333388>'CODE'</font></b> FUNCTION ; ------------------- ; <font color=#339933>(offset $19: 'code')</font> ; 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). <a name="L1C06"></a>;; <b>code</b> L1C06: CALL <A href="#L13F8">L13F8</a> ; 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,<A href="#L1C0E">L1C0E</a> ; skip to STK-CODE with zero if the null string. LD A,(DE) ; else fetch the first character. <a name="L1C0E"></a>;; <b>STK-CODE</b> L1C0E: JP <A href="#L151D">L151D</a> ; jump back to STACK-A (with memory check) ; -------------------- ; THE <b><font color=#333388>'LEN'</font></b> SUBROUTINE ; -------------------- ; <font color=#339933>(offset $1b: 'len')</font> ; 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 <a name="L1C11"></a>;; <b>len</b> L1C11: CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH to fetch and delete the ; string parameters from the calculator stack. ; register BC now holds the length of string. JP <A href="#L1520">L1520</a> ; jump back to STACK-BC to save result on the ; calculator stack (with memory check). ; ------------------------------------- ; THE <b><font color=#333388>'DECREASE THE COUNTER'</font></b> SUBROUTINE ; ------------------------------------- ; <font color=#339933>(offset $31: 'dec-jr-nz')</font> ; The calculator has an instruction that decrements a single-byte ; pseudo-register and makes consequential relative jumps just like ; the Z80's DJNZ instruction. <a name="L1C17"></a>;; <b>dec-jr-nz</b> 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,<A href="#L1C24">L1C24</a> ; to JUMP-2 if not zero INC HL ; step past the jump length. EXX ; switch in the main set. RET ; return. ; <font color=#9900FF>Note.</font> 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 <b><font color=#333388>'JUMP'</font></b> SUBROUTINE ; --------------------- ; <font color=#339933>(Offset $2F; 'jump')</font> ; 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. <a name="L1C23"></a>;; <b>jump</b> <a name="L1C23"></a>;; <b>JUMP</b> L1C23: EXX ;switch in pointer set <a name="L1C24"></a>;; <b>JUMP-2</b> 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,<A href="#L1C2B">L1C2B</a> ; skip, if positive, to JUMP-3. CPL ; else change to $FF. <a name="L1C2B"></a>;; <b>JUMP-3</b> 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 <b><font color=#333388>'JUMP ON TRUE'</font></b> SUBROUTINE ; ----------------------------- ; <font color=#339933>(Offset $00; 'jump-true')</font> ; 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. <a name="L1C2F"></a>;; <b>jump-true</b> L1C2F: LD A,(DE) ; collect exponent byte AND A ; is result 0 or 1 ? JR NZ,<A href="#L1C23">L1C23</a> ; 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 <b><font color=#333388>'MODULUS'</font></b> SUBROUTINE ; ------------------------ ; ( Offset $2E: 'n-mod-m' ) ; <font color=#CC00FF>( i1, i2 -- i3, i4 )</font> ; 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. <a name="L1C37"></a>;; <b>n-mod-m</b> 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 <b><font color=#333388>'INTEGER'</font></b> FUNCTION ; ---------------------- ; <font color=#339933>(offset $24: 'int')</font> ; 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. <a name="L1C46"></a>;; <b>int</b> 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 <A href="#L1C46">L1C46</a>, X-NEG DEFB $36 ;;truncate trunc 3.4 = 3. DEFB $34 ;;end-calc 3. RET ; return with + int x on stack. <a name="L1C4E"></a>;; <b>X-NEG</b> 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 <A href="#L1C59">L1C59</a>, EXIT -3. DEFB $A1 ;;stk-one -3, 1. DEFB $03 ;;subtract -4. <a name="L1C59"></a>;; <b>EXIT</b> L1C59: DEFB $34 ;;end-calc -4. RET ; return. ; ---------------- ; Exponential (23) ; ---------------- ; ; <a name="L1C5B"></a>;; <b>EXP</b> <a name="L1C5B"></a>;; <b>exp</b> 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 <A href="#L15CD">L15CD</a> ; routine FP-TO-A JR NZ,<A href="#L1C9B">L1C9B</a> ; to N-NEGTV JR C,<A href="#L1C99">L1C99</a> ; to REPORT-6b ADD A,(HL) ; JR NC,<A href="#L1CA2">L1CA2</a> ; to RESULT-OK <a name="L1C99"></a>;; <b>REPORT-6b</b> L1C99: RST 08H ; ERROR-1 DEFB $05 ; Error Report: Number too big <a name="L1C9B"></a>;; <b>N-NEGTV</b> L1C9B: JR C,<A href="#L1CA4">L1CA4</a> ; to RSLT-ZERO SUB (HL) ; JR NC,<A href="#L1CA4">L1CA4</a> ; to RSLT-ZERO NEG ; Negate <a name="L1CA2"></a>;; <b>RESULT-OK</b> L1CA2: LD (HL),A ; RET ; return. <a name="L1CA4"></a>;; <b>RSLT-ZERO</b> L1CA4: RST 28H ;; FP-CALC DEFB $02 ;;delete DEFB $A0 ;;stk-zero DEFB $34 ;;end-calc RET ; return. ; -------------------------------- ; THE <b><font color=#333388>'NATURAL LOGARITHM'</font></b> FUNCTION ; -------------------------------- ; <font color=#339933>(offset $22: 'ln')</font> ; 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. <a name="L1CA9"></a>;; <b>ln</b> L1CA9: RST 28H ;; FP-CALC DEFB $2D ;;duplicate DEFB $33 ;;greater-0 DEFB $00 ;;jump-true DEFB $04 ;;to <A href="#L1CB1">L1CB1</a>, VALID DEFB $34 ;;end-calc <a name="L1CAF"></a>;; <b>REPORT-Ab</b> L1CAF: RST 08H ; ERROR-1 DEFB $09 ; Error Report: Invalid argument <a name="L1CB1"></a>;; <b>VALID</b> L1CB1: DEFB $A0 ;;stk-zero <font color=#9900FF>Note.</font> not DEFB $02 ;;delete necessary. DEFB $34 ;;end-calc LD A,(HL) ; LD (HL),$80 ; CALL <A href="#L151D">L151D</a> ; 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 <A href="#L1CD2">L1CD2</a>, 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 <a name="L1CD2"></a>;; <b>GRE.8</b> 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 <b><font color=#333388>'TRIGONOMETRIC'</font></b> 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 <b><font color=#333388>'REDUCE ARGUMENT'</font></b> SUBROUTINE ; -------------------------------- ; <font color=#339933>(offset $35: 'get-argt')</font> ; ; 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. <a name="L1D18"></a>;; <b>get-argt</b> 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 <A href="#L1D35">L1D35</a>, 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. <a name="L1D35"></a>;; <b>ZPLUS</b> 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 <A href="#L1D3C">L1D3C</a>, YNEG ;;if angle in quadrant III ; else angle is within quadrant II (-1 to 0) DEFB $18 ;;negate range +1 to 0 <a name="L1D3C"></a>;; <b>YNEG</b> L1D3C: DEFB $34 ;;end-calc quadrants II and III correct. RET ; return. ; --------------------- ; THE <b><font color=#333388>'COSINE'</font></b> FUNCTION ; --------------------- ; <font color=#339933>(offset $1D: 'cos')</font> ; 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. <a name="L1D3E"></a>;; <b>cos</b> 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 <A href="#L1D4B">L1D4B</a>, C-ENT ;;forward to common code if in QII or QIII DEFB $18 ;;negate else make positive. DEFB $2F ;;jump DEFB $03 ;;fwd to <A href="#L1D4B">L1D4B</a>, C-ENT ;;with quadrants QI and QIV ; ------------------- ; THE <b><font color=#333388>'SINE'</font></b> FUNCTION ; ------------------- ; <font color=#339933>(offset $1C: 'sin')</font> ; 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. <a name="L1D49"></a>;; <b>sin</b> L1D49: RST 28H ;; FP-CALC angle in radians DEFB $35 ;;get-argt reduce - sign now correct. <a name="L1D4B"></a>;; <b>C-ENT</b> 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 <b><font color=#333388>'TANGENT'</font></b> FUNCTION ; ---------------------- ; <font color=#339933>(offset $1E: 'tan')</font> ; ; 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. <a name="L1D6E"></a>;; <b>tan</b> 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 <b><font color=#333388>'ARCTAN'</font></b> FUNCTION ; --------------------- ; <font color=#339933>(Offset $21: 'atn')</font> ; 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. <a name="L1D76"></a>;; <b>atn</b> L1D76: LD A,(HL) ; fetch exponent CP $81 ; compare to that for 'one' JR C,<A href="#L1D89">L1D89</a> ; 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 <A href="#L1D8B">L1D8B</a>, CASES DEFB $18 ;;negate DEFB $2F ;;jump DEFB $03 ;;to <A href="#L1D8B">L1D8B</a>, CASES ; --- <a name="L1D89"></a>;; <b>SMALL</b> L1D89: RST 28H ;; FP-CALC DEFB $A0 ;;stk-zero <a name="L1D8B"></a>;; <b>CASES</b> 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 <b><font color=#333388>'ARCSIN'</font></b> FUNCTION ; --------------------- ; <font color=#339933>(Offset $1F: 'asn')</font> ; 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. <a name="L1DC4"></a>;; <b>asn</b> 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 <b><font color=#333388>'ARCCOS'</font></b> FUNCTION ; ------------------------ ; <font color=#339933>(Offset $20: 'acs')</font> ; 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 <a name="L1DD4"></a>;; <b>acs</b> 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 <b><font color=#333388>'SQUARE ROOT'</font></b> FUNCTION ; -------------------------- ; <font color=#339933>(Offset $25: 'sqr')</font> ; 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. <a name="L1DDB"></a>;; <b>sqr</b> 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 <A href="#L1DFD">L1DFD</a>, 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 <b><font color=#333388>'EXPONENTIATION'</font></b> OPERATION ; ------------------------------ ; <font color=#339933>(Offset $06: 'to-power')</font> ; 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. <a name="L1DE2"></a>;; <b>to-power</b> 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 <A href="#L1DEE">L1DEE</a>, 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 <A href="#L1C5B">L1C5B</a> ; 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. <a name="L1DEE"></a>;; <b>XISO</b> L1DEE: DEFB $02 ;;delete Y. DEFB $2D ;;duplicate Y, Y. DEFB $2C ;;not Y, (1/0). DEFB $00 ;;jump-true DEFB $09 ;;forward to <A href="#L1DFB">L1DFB</a>, 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 <A href="#L1DFD">L1DFD</a>, 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 ; --- <a name="L1DFB"></a>;; <b>ONE</b> L1DFB: DEFB $02 ;;delete . DEFB $A1 ;;stk-one 1. <a name="L1DFD"></a>;; <b>LAST</b> L1DFD: DEFB $34 ;;end-calc last value 1 or 0. RET ; return. ; --------------------- ; THE <b><font color=#333388>'SPARE LOCATIONS'</font></b> ; --------------------- <a name="L1DFF"></a>;; <b>SPARE</b> L1DFF: DEFB $FF ; That's all folks. ; ------------------------ ; THE <b><font color=#333388>'ZX81 CHARACTER SET'</font></b> ; ------------------------ <a name="L1E00"></a>;; <b>char-set</b> - begins with space character. ; $00 - <b>Character: ' ' </b>CHR$(0) L<B>1</B>E00: DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $01 - <b>Character: mosaic </b>CHR$(1) DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $02 - <b>Character: mosaic </b>CHR$(2) DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $03 - <b>Character: mosaic </b>CHR$(3) DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $04 - <b>Character: mosaic </b>CHR$(4) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 ; $05 - <b>Character: mosaic </b>CHR$(1) DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 ; $06 - <b>Character: mosaic </b>CHR$(1) DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B> DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 ; $07 - <b>Character: mosaic </b>CHR$(1) DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B> DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000 ; $08 - <b>Character: mosaic </b>CHR$(1) DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> ; $09 - <b>Character: mosaic </b>CHR$(1) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> ; $0A - <b>Character: mosaic </b>CHR$(10) DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0 DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B> DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $0B - <b>Character: '"' </b>CHR$(11) DEFB %00000000 DEFB %00<B>1</B>00<B>1</B>00 DEFB %00<B>1</B>00<B>1</B>00 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $0B - <b>Character: £ </b>CHR$(12) DEFB %00000000 DEFB %000<B>1</B><B>1</B><B>1</B>00 DEFB %00<B>1</B>000<B>1</B>0 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B>000 DEFB %00<B>1</B>00000 DEFB %00<B>1</B>00000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %00000000 ; $0B - <b>Character: '$' </b>CHR$(13) DEFB %00000000 DEFB %0000<B>1</B>000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %00<B>1</B>0<B>1</B>000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %0000<B>1</B>0<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %0000<B>1</B>000 ; $0B - <b>Character: ':' </b>CHR$(14) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %000<B>1</B>0000 DEFB %00000000 DEFB %00000000 DEFB %000<B>1</B>0000 DEFB %00000000 ; $0B - <b>Character: '?' </b>CHR$(15) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00000<B>1</B>00 DEFB %0000<B>1</B>000 DEFB %00000000 DEFB %0000<B>1</B>000 DEFB %00000000 ; $10 - <b>Character: '(' </b>CHR$(16) DEFB %00000000 DEFB %00000<B>1</B>00 DEFB %0000<B>1</B>000 DEFB %0000<B>1</B>000 DEFB %0000<B>1</B>000 DEFB %0000<B>1</B>000 DEFB %00000<B>1</B>00 DEFB %00000000 ; $11 - <b>Character: ')' </b>CHR$(17) DEFB %00000000 DEFB %00<B>1</B>00000 DEFB %000<B>1</B>0000 DEFB %000<B>1</B>0000 DEFB %000<B>1</B>0000 DEFB %000<B>1</B>0000 DEFB %00<B>1</B>00000 DEFB %00000000 ; $12 - <b>Character: '>' </b>CHR$(18) DEFB %00000000 DEFB %00000000 DEFB %000<B>1</B>0000 DEFB %0000<B>1</B>000 DEFB %00000<B>1</B>00 DEFB %0000<B>1</B>000 DEFB %000<B>1</B>0000 DEFB %00000000 ; $13 - <b>Character: '<' </b>CHR$(19) DEFB %00000000 DEFB %00000000 DEFB %00000<B>1</B>00 DEFB %0000<B>1</B>000 DEFB %000<B>1</B>0000 DEFB %0000<B>1</B>000 DEFB %00000<B>1</B>00 DEFB %00000000 ; $14 - <b>Character: '=' </b>CHR$(20) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %00000000 DEFB %00000000 ; $15 - <b>Character: '+' </b>CHR$(21) DEFB %00000000 DEFB %00000000 DEFB %0000<B>1</B>000 DEFB %0000<B>1</B>000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %0000<B>1</B>000 DEFB %0000<B>1</B>000 DEFB %00000000 ; $16 - <b>Character: '-' </b>CHR$(22) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $17 - <b>Character: '*' </b>CHR$(23) DEFB %00000000 DEFB %00000000 DEFB %000<B>1</B>0<B>1</B>00 DEFB %0000<B>1</B>000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %0000<B>1</B>000 DEFB %000<B>1</B>0<B>1</B>00 DEFB %00000000 ; $18 - <b>Character: '/' </b>CHR$(24) DEFB %00000000 DEFB %00000000 DEFB %000000<B>1</B>0 DEFB %00000<B>1</B>00 DEFB %0000<B>1</B>000 DEFB %000<B>1</B>0000 DEFB %00<B>1</B>00000 DEFB %00000000 ; $19 - <b>Character: ';' </b>CHR$(25) DEFB %00000000 DEFB %00000000 DEFB %000<B>1</B>0000 DEFB %00000000 DEFB %00000000 DEFB %000<B>1</B>0000 DEFB %000<B>1</B>0000 DEFB %00<B>1</B>00000 ; $1A - <b>Character: ',' </b>CHR$(26) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %0000<B>1</B>000 DEFB %0000<B>1</B>000 DEFB %000<B>1</B>0000 ; $1B - <b>Character: '"' </b>CHR$(27) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %000<B>1</B><B>1</B>000 DEFB %000<B>1</B><B>1</B>000 DEFB %00000000 ; $1C - <b>Character: '0' </b>CHR$(28) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>000<B>1</B><B>1</B>0 DEFB %0<B>1</B>00<B>1</B>0<B>1</B>0 DEFB %0<B>1</B>0<B>1</B>00<B>1</B>0 DEFB %0<B>1</B><B>1</B>000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $1D - <b>Character: '1' </b>CHR$(29) DEFB %00000000 DEFB %000<B>1</B><B>1</B>000 DEFB %00<B>1</B>0<B>1</B>000 DEFB %0000<B>1</B>000 DEFB %0000<B>1</B>000 DEFB %0000<B>1</B>000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %00000000 ; $1E - <b>Character: '2' </b>CHR$(30) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %000000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %00000000 ; $1F - <b>Character: '3' </b>CHR$(31) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0000<B>1</B><B>1</B>00 DEFB %000000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $20 - <b>Character: '4' </b>CHR$(32) DEFB %00000000 DEFB %0000<B>1</B>000 DEFB %000<B>1</B><B>1</B>000 DEFB %00<B>1</B>0<B>1</B>000 DEFB %0<B>1</B>00<B>1</B>000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %0000<B>1</B>000 DEFB %00000000 ; $21 - <b>Character: '5' </b>CHR$(33) DEFB %00000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %0<B>1</B>000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %000000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $22 - <b>Character: '6' </b>CHR$(34) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $23 - <b>Character: '7' </b>CHR$(35) DEFB %00000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %000000<B>1</B>0 DEFB %00000<B>1</B>00 DEFB %0000<B>1</B>000 DEFB %000<B>1</B>0000 DEFB %000<B>1</B>0000 DEFB %00000000 ; $24 - <b>Character: '8' </b>CHR$(36) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $25 - <b>Character: '9' </b>CHR$(37) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %000000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $26 - <b>Character: 'A' </b>CHR$(38) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00000000 ; $27 - <b>Character: 'B' </b>CHR$(39) DEFB %00000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $28 - <b>Character: 'C' </b>CHR$(40) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>000000 DEFB %0<B>1</B>000000 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $29 - <b>Character: 'D' </b>CHR$(41) DEFB %00000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B>000 DEFB %0<B>1</B>000<B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>000<B>1</B>00 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B>000 DEFB %00000000 ; $2A - <b>Character: 'E' </b>CHR$(42) DEFB %00000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %0<B>1</B>000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>000000 DEFB %0<B>1</B>000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %00000000 ; $2B - <b>Character: 'F' </b>CHR$(43) DEFB %00000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %0<B>1</B>000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>000000 DEFB %0<B>1</B>000000 DEFB %0<B>1</B>000000 DEFB %00000000 ; $2C - <b>Character: 'G' </b>CHR$(44) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>000000 DEFB %0<B>1</B>00<B>1</B><B>1</B><B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $2D - <b>Character: 'H' </b>CHR$(45) DEFB %00000000 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00000000 ; $2E - <b>Character: 'I' </b>CHR$(46) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %0000<B>1</B>000 DEFB %0000<B>1</B>000 DEFB %0000<B>1</B>000 DEFB %0000<B>1</B>000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %00000000 ; $2F - <b>Character: 'J' </b>CHR$(47) DEFB %00000000 DEFB %000000<B>1</B>0 DEFB %000000<B>1</B>0 DEFB %000000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $30 - <b>Character: 'K' </b>CHR$(48) DEFB %00000000 DEFB %0<B>1</B>000<B>1</B>00 DEFB %0<B>1</B>00<B>1</B>000 DEFB %0<B>1</B><B>1</B><B>1</B>0000 DEFB %0<B>1</B>00<B>1</B>000 DEFB %0<B>1</B>000<B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00000000 ; $31 - <b>Character: 'L' </b>CHR$(49) DEFB %00000000 DEFB %0<B>1</B>000000 DEFB %0<B>1</B>000000 DEFB %0<B>1</B>000000 DEFB %0<B>1</B>000000 DEFB %0<B>1</B>000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %00000000 ; $32 - <b>Character: 'M' </b>CHR$(50) DEFB %00000000 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B><B>1</B>00<B>1</B><B>1</B>0 DEFB %0<B>1</B>0<B>1</B><B>1</B>0<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00000000 ; $33 - <b>Character: 'N' </b>CHR$(51) DEFB %00000000 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B><B>1</B>000<B>1</B>0 DEFB %0<B>1</B>0<B>1</B>00<B>1</B>0 DEFB %0<B>1</B>00<B>1</B>0<B>1</B>0 DEFB %0<B>1</B>000<B>1</B><B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00000000 ; $34 - <b>Character: 'O' </b>CHR$(52) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $35 - <b>Character: 'P' </b>CHR$(53) DEFB %00000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>000000 DEFB %0<B>1</B>000000 DEFB %00000000 ; $36 - <b>Character: 'Q' </b>CHR$(54) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0<B>1</B>00<B>1</B>0 DEFB %0<B>1</B>00<B>1</B>0<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $37 - <b>Character: 'R' </b>CHR$(55) DEFB %00000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>000<B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00000000 ; $38 - <b>Character: 'S' </b>CHR$(56) DEFB %00000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %0<B>1</B>000000 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %000000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $39 - <b>Character: 'T' </b>CHR$(57) DEFB %00000000 DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %000<B>1</B>0000 DEFB %000<B>1</B>0000 DEFB %000<B>1</B>0000 DEFB %000<B>1</B>0000 DEFB %000<B>1</B>0000 DEFB %00000000 ; $3A - <b>Character: 'U' </b>CHR$(58) DEFB %00000000 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00 DEFB %00000000 ; $3B - <b>Character: 'V' </b>CHR$(59) DEFB %00000000 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B>00<B>1</B>00 DEFB %000<B>1</B><B>1</B>000 DEFB %00000000 ; $3C - <b>Character: 'W' </b>CHR$(60) DEFB %00000000 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %0<B>1</B>0<B>1</B><B>1</B>0<B>1</B>0 DEFB %00<B>1</B>00<B>1</B>00 DEFB %00000000 ; $3D - <b>Character: 'X' </b>CHR$(61) DEFB %00000000 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00<B>1</B>00<B>1</B>00 DEFB %000<B>1</B><B>1</B>000 DEFB %000<B>1</B><B>1</B>000 DEFB %00<B>1</B>00<B>1</B>00 DEFB %0<B>1</B>0000<B>1</B>0 DEFB %00000000 ; $3E - <b>Character: 'Y' </b>CHR$(62) DEFB %00000000 DEFB %<B>1</B>00000<B>1</B>0 DEFB %0<B>1</B>000<B>1</B>00 DEFB %00<B>1</B>0<B>1</B>000 DEFB %000<B>1</B>0000 DEFB %000<B>1</B>0000 DEFB %000<B>1</B>0000 DEFB %00000000 ; $3F - <b>Character: 'Z' </b>CHR$(63) DEFB %00000000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %00000<B>1</B>00 DEFB %0000<B>1</B>000 DEFB %000<B>1</B>0000 DEFB %00<B>1</B>00000 DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0 DEFB %00000000 .END ;TASM assembler instruction.
assembly_listing_of_the_operating_system_of_the_sinclair_zx81.1647867269.txt.gz ยท Last modified: 2022/03/21 12:54 by evert