franke/ZX81_Rom_Listing
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
ZX81_Rom_Listing/zx81 rom listing

10554 lines
354 KiB
Plaintext
Raw Normal View History

2017-12-12 20:30:31 +00:00
; ===========================================================
; 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.
Reference in New Issue Copy Permalink