Skip to content

Instantly share code, notes, and snippets.

@0xcafed00d

0xcafed00d/zx81 rom listing

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

I reverse engineered the difference between this rom listing, which is the second revision rom, and the third revision rom. The difference is the location of the instruction CALL L0207. In the third revision rom, this instruction occurs immediately after the CALL L022D, in the second revision it occurs further down, just before the JR L0F4B. I don't have a listing yet for the first revision rom.

--- roma.asm	2022-06-26 04:28:25.000000000 -0400
+++ romb.asm	2022-07-02 02:08:24.000000000 -0400
@@ -4404,8 +4404,8 @@
         LD      L,C             ;
         CALL    L022D           ; routine DISPLAY-P
+        CALL    L0207           ; routine SLOW/FAST
 
         LD      (IY+$35),$FF    ; sv FRAMES_hi
 
-        CALL    L0207           ; routine SLOW/FAST
         JR      L0F4B           ; routine DEBOUNCE

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment