commit e254b0de3432fdbf3b9c20f36537442cfc56c4f0
parent 7612f86a3c257c890d23a2eb835f6b0e9b20d85d
Author: Brian Swetland <swetland@frotz.net>
Date: Thu, 18 Aug 2022 23:13:19 -0700
check in mirror of original listings
Diffstat:
4 files changed, 40430 insertions(+), 0 deletions(-)
diff --git a/mirror/hackaday.io/zx81dual.html b/mirror/hackaday.io/zx81dual.html
@@ -0,0 +1,16082 @@
+; ===========================================================
+; An Assembly Listing of the Operating System of the ZX81 ROM
+; ===========================================================
+------------------------------------------------------------------------
+
+; Last updated: 13-DEC-2004
+; 2011 Updated to remove -, +, /, *, &,
+; characters from labels (which confuse assemblers)
+;
+; 2011 Updated for conditional assembly of ORIGINAL or "Shoulders of Giants" ROM
+;
+; 2014-08-01 Updated to add CHARS_PER_LINE_WINDOW which is normally 32.
+;
+; The ideal pixel rates for square pixels on a PAL system are
+; 14.75 MHz (interlaced) and
+; 7.375 MHz (non-interlaced, which the ZX80/ZX81 are).
+; These are not commonly available but fortunately one can buy
+; baud-rate generator frequencies such as
+; 14.7456 and 7.3728 MHz that are only 0.03% low
+; which is more than close enough.
+;
+; ZX video normally has 6.5 MHz pixel rate,
+; so 32 characters take 256 pixels in 39.4 microseconds.
+; A 7.3728 MHz clock and 40 characters produces
+; 320 pixels in 43.4 microseconds.
+;
+; ZX80 video generation is software defined so it is
+; easy to get square pixels simply by subtracting 8 from the bytes
+; at hex addresses 287, 2AA and 2B8.
+; The video will appear to the left of the screen but
+; the characters will be square and a diagonal graphic line
+; will be at 45 degrees.
+;
+; ZX81 video generation in fast mode exactly the same as the ZX80.
+;
+; ZX81 video generation in slow mode is problematic, in that
+; the NMI generator expects a 3.25 MHz CPU clock
+; (3.25MHz / 208 = 15.625 kHz = 64 microsecond line period)
+; It is inside the ULA where it cannot be modified.
+;
+; Simply fitting a 7.3728 MHz crystal would reduce the line period to
+; 57.3 microseconds. Slow mode would require the CPU clock to be
+; divided by 236.
+;
+; Square pixels on NTSC requires 11+3/11 = 11.272... MHz (interlaced)
+; or 5.63.. non-interlaced which is slower than the original 6.5 MHz.
+; The NTSC line period is still 64 microseconds, so 256 pixels
+; stretch over 45 microseconds, and 320 pixels over 56 microseconds.
+; Thus it is possible to get square pixels on an NTSC display,
+; it is not possible to get 40 column text as well.
+; That would require the PAL clock, but pixels would not be square.
+;
+; The ZX printer is fixed in hardware.
+; It will not work in 40-column mode.
+;
+;
+;
+; PIXEL_CLOCK equ 7372500
+;
+; on-line assembler complains about the line above
+;
+; CHARS_PER_LINE_WINDOW always 32 for 6.5 MHz pixel rate
+; always 40 for 7.375 MHz PAL square pixel rate
+;
+CHARS_PER_LINE_WINDOW equ 40 ; 32 originally
+;
+; CHARS_PER_LINE always 32 for 6.5 MHz pixel rate
+; but 32 or 40 if using PAL square pixel rate
+;
+CHARS_HORIZONTAL equ 40 ; 32 originally
+CHARS_VERTICAL equ 24
+;
+; 2014-08-01
+; Largely working but some bugs remain.
+; Working:
+; You can type text and it takes 40 characters before new line.
+; 40 characters are nicely centred in the screen.
+; PLOT X,Y accepts X from 0 to 79.
+; Faulty:
+; System crashing in an authentic ZX81 fashion,
+; I don't know if this is due to software bugs
+; or socket joint disturbance from key presses.
+;
+;
+; 2018-01-09 add org
+; Assembles using on-line assembler "zasm" at:
+;
+; http://k1.spdns.de/cgi-bin/zasm.cgi
+;
+ org 0
+
+FALSE equ 0
+
+ORIGINAL equ 0
+NOT_BODGED equ 1
+
+; 2018-02-09 CHARS_HORIZONTAL placed in SCROLL routine.
+; Thanks to Adam Klotblixt for testing code and spotting this bug.
+; Also added to some G007 routines.
+;
+
+------------------------------------------------------------------------
+
+;
+; 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.
+
+#if 0
+; zasm does not understand these:
+#define DEFB .BYTE ; TASM cross-assembler definitions
+#define DEFW .WORD
+#define EQU .EQU
+#endif
+
+; define stuff sensibly:
+;
+; I/O locations:
+;
+IO_PORT_TAPE equ $FF ; write
+IO_PORT_SCREEN equ $FF ; write
+
+IO_PORT_KEYBOARD_RD equ $FE ; A0 low
+IO_PORT_NMI_GEN_ON equ $FE ; A0 low
+IO_PORT_NMI_GEN_OFF equ $FD ; A1 low
+IO_PORT_PRINTER equ $FB ; A2 low
+------------------------------------------------------------------------
+
+;
+; System variables:
+;
+RAMBASE equ $4000
+ERR_NR equ $4000 ; The report code. Incremented before printing.
+FLAGS equ $4001 ; Bit 0: Suppression of leading space.
+ ; Bit 1: Control Flag for the printer.
+ ; Bit 2: Selects K or F mode; or, F or G
+ ; Bit 6: FP no. or string parameters.
+ ; Bit 7: Reset during syntax checking."
+ERR_SP equ $4002 ; Pointer to the GOSUB stack.
+RAMTOP equ $4004 ; The top of available RAM, or as specified.
+MODE equ $4006 ; Holds the code for K or F
+PPC equ $4007 ; Line number of the current statement.
+PPC_hi equ PPC+1
+VERSN equ $4009 ; Marks the start of the RAM that is saved.
+E_PPC equ $400A ; The BASIC line with the cursor
+D_FILE equ $400C ; Pointer to Display file
+DF_CC equ $400E ; Address for PRINT AT position
+VARS equ $4010 ; Pointer to variable area
+DEST equ $4012 ; Address of current variable in program area
+E_LINE equ $4014 ; Pointer to workspace
+E_LINE_hi equ E_LINE+1
+CH_ADD equ $4016 ; Pointer for scanning a line, in program or workspace
+X_PTR equ $4018 ; Pointer to syntax error.
+X_PTR_lo equ X_PTR
+X_PTR_hi equ X_PTR+1
+STKBOT equ $401A ; Pointer to calculator stack bottom.
+STKEND equ $401C ; Pointer to calculator stack end.
+BERG equ $401E ; Used for many different counting purposes
+MEM equ $401F ; Pointer to base of table of fp. nos, either in calc. stack or variable area.
+; ; Unused by ZX BASIC. Or FLAG Y for G007
+DF_SZ equ $4022 ; Number of lines in the lower screen
+S_TOP equ $4023 ; Current line number of automatic listing
+LAST_K equ $4025 ; Last Key pressed
+DEBOUNCE_VAR equ $4027 ; The de-bounce status
+MARGIN equ $4028 ; Adjusts for differing TV standards
+NXTLIN equ $4029 ; Next BASIC line to be interpreted
+OLDPPC equ $402B ; Last line number, in case needed.
+FLAGX equ $402D ; Bit 0: Reset indicates an arrayed variable
+ ; Bit 1: Reset indicates a given variable exists
+ ; Bit 5: Set during INPUT mode
+ ; Bit 7: Set when INPUT is to be numeric
+STRLEN equ $402E ; Length of a string, or a BASIC line
+STRLEN_lo equ STRLEN ;
+T_ADDR equ $4030 ; Pointer to parameter table. & distinguishes between PLOT & UNPLOT
+SEED equ $4032 ; For RANDOM function
+FRAMES equ $4034 ; Frame counter
+FRAMES_hi equ FRAMES+1 ;
+COORDS equ $4036 ; X & Y for PLOT
+COORDS_x equ COORDS ;
+PR_CC equ $4038 ; Print buffer counter
+S_POSN equ $4039 ; Line & Column for PRINT AT
+S_POSN_x equ $4039 ;
+S_POSN_y equ $403A ;
+CDFLAG equ $403B ; Bit 6 = the true fast/slow flag
+ ; Bit 7 = copy of the fast/slow flag. RESET when FAST needed
+PRBUFF equ $403C ; Printer buffer
+PRBUFF_END equ $405C ;
+MEM_0_1st equ $405D ; room for 5 floating point numbers (meme_0 to mem_ 5???)
+; $407B ; unused. Or RESTART to G007
+; $407D ; The BASIC program starts here
+; equ $40
+; equ $40
+; equ $40
+; First byte after system variables:
+USER_RAM equ $407D
+MAX_RAM equ $7FFF
+------------------------------------------------------------------------
+
+;===============================
+; ZX81 constants:
+;===============================
+; ZX characters (not the same as ASCII)
+;-------------------------------
+ZX_SPACE equ $00
+; ZX_graphic equ $01
+; ZX_graphic equ $02
+; ZX_graphic equ $03
+; ZX_graphic equ $04
+; ZX_graphic equ $05
+; ZX_graphic equ $06
+; ZX_graphic equ $07
+; ZX_graphic equ $08
+; ZX_graphic equ $09
+; ZX_graphic equ $0A
+ZX_QUOTE equ $0B
+ZX_POUND equ $0C
+ZX_DOLLAR equ $0D
+ZX_COLON equ $0E
+ZX_QUERY equ $0F
+ZX_BRACKET_LEFT equ $10
+ZX_BRACKET_RIGHT equ $11
+ZX_GREATER_THAN equ $12
+ZX_LESS_THAN equ $13
+ZX_EQUAL equ $14
+ZX_PLUS equ $15
+ZX_MINUS equ $16
+ZX_STAR equ $17
+ZX_SLASH equ $18
+ZX_SEMICOLON equ $19
+ZX_COMMA equ $1A
+ZX_PERIOD equ $1B
+ZX_0 equ $1C
+ZX_1 equ $1D
+ZX_2 equ $1E
+ZX_3 equ $1F
+ZX_4 equ $20
+ZX_5 equ $21
+ZX_6 equ $22
+ZX_7 equ $23
+ZX_8 equ $24
+ZX_9 equ $25
+ZX_A equ $26
+ZX_B equ $27
+ZX_C equ $28
+ZX_D equ $29
+ZX_E equ $2A
+ZX_F equ $2B
+ZX_G equ $2C
+ZX_H equ $2D
+ZX_I equ $2E
+ZX_J equ $2F
+ZX_K equ $30
+ZX_L equ $31
+ZX_M equ $32
+ZX_N equ $33
+ZX_O equ $34
+ZX_P equ $35
+ZX_Q equ $36
+ZX_R equ $37
+ZX_S equ $38
+ZX_T equ $39
+ZX_U equ $3A
+ZX_V equ $3B
+ZX_W equ $3C
+ZX_X equ $3D
+ZX_Y equ $3E
+ZX_Z equ $3F
+ZX_RND equ $40
+ZX_INKEY_STR equ $41
+ZX_PI equ $42
+;
+; $43 to $6F not used
+;
+ZX_cursor_up equ $70
+ZX_cursor_down equ $71
+ZX_cursor_left equ $72
+ZX_cursor_right equ $73
+
+ZX_GRAPHICS equ $74
+ZX_EDIT equ $75
+ZX_NEWLINE equ $76
+ZX_RUBOUT equ $77
+ZX_KL equ $78
+ZX_FUNCTION equ $79
+;
+; $7A to $7F not used
+;
+ZX_CURSOR equ $7F
+;
+; $80 to $BF are inverses of $00 to $3F
+;
+; ZX_graphic equ $80 ; inverse space
+; ZX_graphic equ $81
+; ZX_graphic equ $82
+; ZX_graphic equ $83
+; ZX_graphic equ $84
+; ZX_graphic equ $85
+; ZX_graphic equ $86
+; ZX_graphic equ $87
+; ZX_graphic equ $88
+; ZX_graphic equ $89
+; ZX_graphic equ $8A
+ZX_INV_QUOTE equ $8B
+ZX_INV_POUND equ $8C
+ZX_INV_DOLLAR equ $8D
+ZX_INV_COLON equ $8E
+ZX_INV_QUERY equ $8F
+ZX_INV_BRACKET_RIGHT equ $90
+ZX_INV_BRACKET_LEFT equ $91
+ZX_INV_GT equ $92
+
+ZX_INV_PLUS equ $95
+ZX_INV_MINUS equ $96
+
+ZX_INV_K equ $B0
+ZX_INV_S equ $B8
+
+ZX_DOUBLE_QUOTE equ $C0
+ZX_AT equ $C1
+ZX_TAB equ $C2
+; not used equ $C3
+ZX_CODE equ $C4
+ZX_VAL equ $C5
+ZX_LEN equ $C6
+ZX_SIN equ $C7
+ZX_COS equ $C8
+ZX_TAN equ $C9
+ZX_ASN equ $CA
+ZX_ACS equ $CB
+ZX_ATN equ $CC
+ZX_LN equ $CD
+ZX_EXP equ $CE
+ZX_INT equ $CF
+
+ZX_SQR equ $D0
+ZX_SGN equ $D1
+ZX_ABS equ $D2
+ZX_PEEK equ $D3
+ZX_USR equ $D4
+ZX_STR_STR equ $D5 ; STR$
+ZX_CHR_STR equ $D6 ; CHR$
+ZX_NOT equ $D7
+ZX_POWER equ $D8
+ZX_OR equ $D9
+ZX_AND equ $DA
+ZX_LESS_OR_EQUAL equ $DB
+ZX_GREATER_OR_EQUAL equ $DC
+ZX_NOT_EQUAL equ $DD
+ZX_THEN equ $DE
+ZX_TO equ $DF
+
+ZX_STEP equ $E0
+ZX_LPRINT equ $E1
+ZX_LLIST equ $E2
+ZX_STOP equ $E3
+ZX_SLOW equ $E4
+ZX_FAST equ $E5
+ZX_NEW equ $E6
+ZX_SCROLL equ $E7
+ZX_CONT equ $E8
+ZX_DIM equ $E9
+ZX_REM equ $EA
+ZX_FOR equ $EB
+ZX_GOTO equ $EC
+ZX_GOSUB equ $ED
+ZX_INPUT equ $EE
+ZX_LOAD equ $EF
+
+ZX_LIST equ $F0
+ZX_LET equ $F1
+ZX_PAUSE equ $F2
+ZX_NEXT equ $F3
+ZX_POKE equ $F4
+ZX_PRINT equ $F5
+ZX_PLOT equ $F6
+ZX_RUN equ $F7
+ZX_SAVE equ $F8
+ZX_RAND equ $F9
+ZX_IF equ $FA
+ZX_CLS equ $FB
+ZX_UNPLOT equ $FC
+ZX_CLEAR equ $FD
+ZX_RETURN equ $FE
+ZX_COPY equ $FF
+------------------------------------------------------------------------
+
+
+;
+_CLASS_00 equ 0
+_CLASS_01 equ 1
+_CLASS_02 equ 2
+_CLASS_03 equ 3
+_CLASS_04 equ 4
+_CLASS_05 equ 5
+_CLASS_06 equ 6
+------------------------------------------------------------------------
+
+
+
+; These values taken from BASIC manual
+;
+;
+ERROR_CODE_SUCCESS equ 0
+ERROR_CODE_CONTROL_VARIABLE equ 1
+ERROR_CODE_UNDEFINED_VARIABLE equ 2
+ERROR_CODE_SUBSCRIPT_OUT_OF_RANGE equ 3
+ERROR_CODE_NOT_ENOUGH_MEMORY equ 4
+ERROR_CODE_NO_ROOM_ON_SCREEN equ 5
+ERROR_CODE_ARITHMETIC_OVERFLOW equ 6
+ERROR_CODE_RETURN_WITHOUT_GOSUB equ 7
+ERROR_CODE_INPUT_AS_A_COMMAND equ 8
+ERROR_CODE_STOP equ 9
+ERROR_CODE_INVALID_ARGUMENT equ 10
+
+ERROR_CODE_INTEGER_OUT_OF_RANGE equ 11
+ERROR_CODE_VAL_STRING_INVALID equ 12
+ERROR_CODE_BREAK equ 13
+
+ERROR_CODE_EMPTY_PROGRAM_NAME equ 15
+------------------------------------------------------------------------
+
+;
+; codes for Forth-like calculator
+;
+__jump_true equ $00
+__exchange equ $01
+__delete equ $02
+__subtract equ $03
+__multiply equ $04
+__division equ $05
+__to_power equ $06
+__or equ $07
+__boolean_num_and_num equ $08
+__num_l_eql equ $09
+__num_gr_eql equ $0A
+__nums_neql equ $0B
+__num_grtr equ $0C
+__num_less equ $0D
+__nums_eql equ $0E
+__addition equ $0F
+__strs_and_num equ $10
+__str_l_eql equ $11
+__str_gr_eql equ $12
+__strs_neql equ $13
+__str_grtr equ $14
+__str_less equ $15
+__strs_eql equ $16
+__strs_add equ $17
+__negate equ $18
+__code equ $19
+__val equ $1A
+__len equ $1B
+__sin equ $1C
+__cos equ $1D
+__tan equ $1E
+__asn equ $1F
+__acs equ $20
+__atn equ $21
+__ln equ $22
+__exp equ $23
+__int equ $24
+__sqr equ $25
+__sgn equ $26
+__abs equ $27
+__peek equ $28
+__usr_num equ $29
+__str_dollar equ $2A
+__chr_dollar equ $2B
+__not equ $2C
+__duplicate equ $2D
+__n_mod_m equ $2E
+__jump equ $2F
+__stk_data equ $30
+__dec_jr_nz equ $31
+__less_0 equ $32
+__greater_0 equ $33
+__end_calc equ $34
+__get_argt equ $35
+__truncate equ $36
+__fp_calc_2 equ $37
+__e_to_fp equ $38
+
+;
+; __series_xx equ $39 : $80__$9F.
+; tells the stack machine to push
+; 0 to 31 floating-point values on the stack.
+;
+__series_06 equ $86
+__series_08 equ $88
+__series_0C equ $8C
+; __stk_const_xx equ $3A : $A0__$BF.
+; __st_mem_xx equ $3B : $C0__$DF.
+; __get_mem_xx equ $3C : $E0__$FF.
+
+__st_mem_0 equ $C0
+__st_mem_1 equ $C1
+__st_mem_2 equ $C2
+__st_mem_3 equ $C3
+__st_mem_4 equ $C4
+__st_mem_5 equ $C5
+__st_mem_6 equ $C6
+__st_mem_7 equ $C7
+
+
+__get_mem_0 equ $E0
+__get_mem_1 equ $E1
+__get_mem_2 equ $E2
+__get_mem_3 equ $E3
+__get_mem_4 equ $E4
+
+
+__stk_zero equ $A0
+__stk_one equ $A1
+__stk_half equ $A2
+__stk_half_pi equ $A3
+__stk_ten equ $A4
+------------------------------------------------------------------------
+
+;*****************************************
+;** 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 .
+
+mark_0000:
+*START:*
+ OUT (IO_PORT_NMI_GEN_OFF),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,MAX_RAM ; Set BC to the top of possible RAM.
+ ; The higher unpopulated addresses are used for
+ ; video generation.
+ JP RAM_CHECK <#RAM_CHECK> ; 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.
+
+mark_0008:
+*ERROR_1:*
+ LD HL,(CH_ADD) ; fetch character address from CH_ADD.
+ LD (X_PTR),HL ; and set the error pointer X_PTR.
+ JR ERROR_2 <#ERROR_2> ; 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.
+
+mark_0010:
+*PRINT_A:*
+ AND A ; test for zero - space.
+ JP NZ,PRINT_CH <#PRINT_CH> ; jump forward if not to PRINT_CH.
+
+ JP PRINT_SP <#PRINT_SP> ; jump forward to PRINT_SP.
+
+; ___
+#if ORIGINAL
+ DEFB $FF ; unused location.
+#else
+ DEFB $01 ;+ unused location. Version. PRINT PEEK 23
+#endif
+
+------------------------------------------------------------------------
+
+; 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.
+
+mark_0018:
+*GET_CHAR:*
+ LD HL,(CH_ADD) ; set HL to character address CH_ADD.
+ LD A,(HL) ; fetch addressed character to A.
+
+*TEST_SP:*
+ 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 is incremented and the new addressed character is
+; returned if not a space, or cursor, else the process is repeated.
+
+mark_0020:
+*NEXT_CHAR:*
+ CALL CH_ADD_PLUS_1 <#CH_ADD_PLUS_1> ; gets next immediate
+ ; character.
+ JR TEST_SP <#TEST_SP> ; back
+; ___
+
+ 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.
+
+mark_0028:
+*FP_CALC:*
+#if ORIGINAL
+ JP CALCULATE <#CALCULATE> ; jump immediately to the CALCULATE routine.
+#else
+
+ JP CALCULATE <#CALCULATE> ;+ jump to the NEW calculate routine address.
+#endif
+
+mark_002B:
+*end_calc:*
+ 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.
+
+mark_0030:
+*BC_SPACES:*
+ PUSH BC ; push number of spaces on stack.
+ LD HL,(E_LINE) ; fetch edit line location from E_LINE.
+ PUSH HL ; save this value on stack.
+ JP RESERVE <#RESERVE> ; jump forward to continue at RESERVE.
+
+
+------------------------------------------------------------------------
+
+_START equ $00
+_ERROR_1 equ $08
+_PRINT_A equ $10
+_GET_CHAR equ $18
+_NEXT_CHAR equ $20
+_FP_CALC equ $28
+_BC_SPACES equ $30
+------------------------------------------------------------------------
+
+; 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.
+;
+; A 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 .
+
+
+------------------------------------------------------------------------
+
+MARK_0038:
+*INTERRUPT:*
+ DEC C ; (4) decrement C - the scan line counter.
+ JP NZ,SCAN_LINE <#SCAN_LINE> ; (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 R_IX_1_LAST_NEWLINE
+ ; 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.
+
+; ->
+
+mark_0041:
+*WAIT_INT:*
+;
+; NB $DD is for 32-column display
+;
+ 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 ]
+
+; ___
+
+mark_0045:
+*SCAN_LINE:*
+ 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 WAIT_INT <#WAIT_INT> ; (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.
+
+mark_0049:
+CH_ADD_PLUS_1:
+ LD HL,(CH_ADD) ; fetch character address to CH_ADD.
+
+mark_004C:
+*TEMP_PTR1:*
+ INC HL ; address next immediate location.
+
+mark_004D:
+*TEMP_PTR2:*
+ LD (CH_ADD),HL ; update system variable CH_ADD.
+
+ LD A,(HL) ; fetch the character.
+ CP ZX_CURSOR ; compare to cursor character.
+ RET NZ ; return if not the cursor.
+
+ JR TEMP_PTR1 <#TEMP_PTR1> ; 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.
+
+mark_0056:
+*ERROR_2:*
+ 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.
+
+mark_0058:
+*ERROR_3:*
+ LD (IY+ERR_NR-RAMBASE),L ; place error code in system variable ERR_NR
+ LD SP,(ERR_SP) ; set the stack pointer from ERR_SP
+ CALL SLOW_FAST <#SLOW_FAST> ; selects slow mode.
+ JP SET_MIN <#SET_MIN> ; 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 ).
+
+mark_0066:
+*NMI:*
+ EX AF,AF' ; (4) switch in the NMI's copy of the
+ ; accumulator.
+ INC A ; (4) increment.
+ JP M,NMI_RET <#NMI_RET> ; (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,NMI_CONT <#NMI_CONT> ; (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.
+
+mark_006D:
+*NMI_RET:*
+ 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.
+
+mark_006F:
+*NMI_CONT:*
+ 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,(D_FILE) ; (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 R_IX_1 <#R_IX_1> up to and including the CALL = 43 cycles.
+; The Called routine at DISPLAY_5 <#DISPLAY_5> = 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 (IO_PORT_NMI_GEN_OFF),A ; (11) Stop the NMI generator.
+
+ JP (IX) ; (8) forward to R_IX_1 (after top) or R_IX_2
+
+; ****************
+; ** KEY TABLES **
+; ****************
+
+------------------------------------------------------------------------
+
+; THE *'UNSHIFTED'* CHARACTER CODES
+------------------------------------------------------------------------
+
+
+mark_007E:
+*K_UNSHIFT*:
+ DEFB ZX_Z
+ DEFB ZX_X
+ DEFB ZX_C
+ DEFB ZX_V
+
+ DEFB ZX_A
+ DEFB ZX_S
+ DEFB ZX_D
+ DEFB ZX_F
+ DEFB ZX_G
+
+ DEFB ZX_Q
+ DEFB ZX_W
+ DEFB ZX_E
+ DEFB ZX_R
+ DEFB ZX_T
+
+ DEFB ZX_1
+ DEFB ZX_2
+ DEFB ZX_3
+ DEFB ZX_4
+ DEFB ZX_5
+
+ DEFB ZX_0
+ DEFB ZX_9
+ DEFB ZX_8
+ DEFB ZX_7
+ DEFB ZX_6
+
+ DEFB ZX_P
+ DEFB ZX_O
+ DEFB ZX_I
+ DEFB ZX_U
+ DEFB ZX_Y
+
+ DEFB ZX_NEWLINE
+ DEFB ZX_L
+ DEFB ZX_K
+ DEFB ZX_J
+ DEFB ZX_H
+
+ DEFB ZX_SPACE
+ DEFB ZX_PERIOD
+ DEFB ZX_M
+ DEFB ZX_N
+ DEFB ZX_B
+
+
+------------------------------------------------------------------------
+
+; THE *'SHIFTED'* CHARACTER CODES
+------------------------------------------------------------------------
+
+
+
+mark_00A5:
+K_SHIFT:
+ DEFB ZX_COLON ; :
+ DEFB ZX_SEMICOLON ; ;
+ DEFB ZX_QUERY ; ?
+ DEFB ZX_SLASH ; /
+ DEFB ZX_STOP
+ DEFB ZX_LPRINT
+ DEFB ZX_SLOW
+ DEFB ZX_FAST
+ DEFB ZX_LLIST
+ DEFB $C0 ; ""
+ DEFB ZX_OR
+ DEFB ZX_STEP
+ DEFB $DB ; <=
+ DEFB $DD ; <>
+ DEFB ZX_EDIT
+ DEFB ZX_AND
+ DEFB ZX_THEN
+ DEFB ZX_TO
+ DEFB $72 ; cursor-left
+ DEFB ZX_RUBOUT
+ DEFB ZX_GRAPHICS
+ DEFB $73 ; cursor-right
+ DEFB $70 ; cursor-up
+ DEFB $71 ; cursor-down
+ DEFB ZX_QUOTE ; "
+ DEFB $11 ; )
+ DEFB $10 ; (
+ DEFB ZX_DOLLAR ; $
+ DEFB $DC ; >=
+ DEFB ZX_FUNCTION
+ DEFB ZX_EQUAL
+ DEFB ZX_PLUS
+ DEFB ZX_MINUS
+ DEFB ZX_POWER ; **
+ DEFB ZX_POUND ; £
+ DEFB ZX_COMMA ; ,
+ DEFB ZX_GREATER_THAN ; >
+ DEFB ZX_LESS_THAN ; <
+ DEFB ZX_STAR ; *
+
+------------------------------------------------------------------------
+
+; THE *'FUNCTION'* CHARACTER CODES
+------------------------------------------------------------------------
+
+
+
+mark_00CC:
+*K_FUNCT:*
+ DEFB ZX_LN
+ DEFB ZX_EXP
+ DEFB ZX_AT
+ DEFB ZX_KL
+ DEFB ZX_ASN
+ DEFB ZX_ACS
+ DEFB ZX_ATN
+ DEFB ZX_SGN
+ DEFB ZX_ABS
+ DEFB ZX_SIN
+ DEFB ZX_COS
+ DEFB ZX_TAN
+ DEFB ZX_INT
+ DEFB ZX_RND
+ DEFB ZX_KL
+ DEFB ZX_KL
+ DEFB ZX_KL
+ DEFB ZX_KL
+ DEFB ZX_KL
+ DEFB ZX_KL
+ DEFB ZX_KL
+ DEFB ZX_KL
+ DEFB ZX_KL
+ DEFB ZX_KL
+ DEFB ZX_TAB
+ DEFB ZX_PEEK
+ DEFB ZX_CODE
+ DEFB ZX_CHR_STR ; CHR$
+ DEFB ZX_STR_STR ; STR$
+ DEFB ZX_KL
+ DEFB ZX_USR
+ DEFB ZX_LEN
+ DEFB ZX_VAL
+ DEFB ZX_SQR
+ DEFB ZX_KL
+ DEFB ZX_KL
+ DEFB ZX_PI
+ DEFB ZX_NOT
+ DEFB ZX_INKEY_STR
+
+
+------------------------------------------------------------------------
+
+; THE *'GRAPHIC'* CHARACTER CODES
+------------------------------------------------------------------------
+
+
+
+mark_00F3:
+*K_GRAPH:*
+ 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 ZX_RUBOUT
+ DEFB ZX_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 ZX_KL
+ DEFB $92 ; inverse >
+ DEFB $95 ; inverse +
+ DEFB $96 ; inverse -
+ DEFB $88 ; graphic
+
+------------------------------------------------------------------------
+
+; THE *'TOKEN'* TABLES
+------------------------------------------------------------------------
+
+
+
+mark_0111:
+*TOKEN_TABLE:*
+ DEFB ZX_QUERY +$80; '?'
+ DEFB ZX_QUOTE, ZX_QUOTE +$80; ""
+ DEFB ZX_A, ZX_T +$80; AT
+ DEFB ZX_T, ZX_A, ZX_B +$80; TAB
+ DEFB ZX_QUERY +$80; '?'
+ DEFB ZX_C, ZX_O, ZX_D, ZX_E +$80; CODE
+ DEFB ZX_V, ZX_A, ZX_L +$80; VAL
+ DEFB ZX_L, ZX_E, ZX_N +$80; LEN
+ DEFB ZX_S, ZX_I, ZX_N +$80; SIN
+ DEFB ZX_C, ZX_O, ZX_S +$80; COS
+ DEFB ZX_T, ZX_A, ZX_N +$80; TAN
+ DEFB ZX_A, ZX_S, ZX_N +$80; ASN
+ DEFB ZX_A, ZX_C, ZX_S +$80; ACS
+ DEFB ZX_A, ZX_T, ZX_N +$80; ATN
+ DEFB ZX_L, ZX_N +$80; LN
+ DEFB ZX_E, ZX_X, ZX_P +$80; EXP
+ DEFB ZX_I, ZX_N, ZX_T +$80; INT
+ DEFB ZX_S, ZX_Q, ZX_R +$80; SQR
+ DEFB ZX_S, ZX_G, ZX_N +$80; SGN
+ DEFB ZX_A, ZX_B, ZX_S +$80; ABS
+ DEFB ZX_P, ZX_E, ZX_E, ZX_K +$80; PEEK
+ DEFB ZX_U, ZX_S, ZX_R +$80; USR
+ DEFB ZX_S, ZX_T, ZX_R, ZX_DOLLAR +$80; STR$
+ DEFB ZX_C, ZX_H, ZX_R, ZX_DOLLAR +$80; CHR$
+ DEFB ZX_N, ZX_O, ZX_T +$80; NOT
+ DEFB ZX_STAR, ZX_STAR +$80; **
+ DEFB ZX_O, ZX_R +$80; OR
+ DEFB ZX_A, ZX_N, ZX_D +$80; AND
+ DEFB ZX_LESS_THAN, ZX_EQUAL +$80; >=
+ DEFB ZX_GREATER_THAN, ZX_EQUAL +$80; <=
+ DEFB ZX_LESS_THAN, ZX_GREATER_THAN +$80; ><
+ DEFB ZX_T, ZX_H, ZX_E, ZX_N +$80; THEN
+ DEFB ZX_T, ZX_O +$80; TO
+ DEFB ZX_S, ZX_T, ZX_E, ZX_P +$80; STEP
+ DEFB ZX_L, ZX_P, ZX_R, ZX_I, ZX_N, ZX_T +$80; LPRINT
+ DEFB ZX_L, ZX_L, ZX_I, ZX_S, ZX_T +$80; LLIST
+ DEFB ZX_S, ZX_T, ZX_O, ZX_P +$80; STOP
+ DEFB ZX_S, ZX_L, ZX_O, ZX_W +$80; SLOW
+ DEFB ZX_F, ZX_A, ZX_S, ZX_T +$80; FAST
+ DEFB ZX_N, ZX_E, ZX_W +$80; NEW
+ DEFB ZX_S, ZX_C, ZX_R, ZX_O, ZX_L, ZX_L +$80; SCROLL
+ DEFB ZX_C, ZX_O, ZX_N, ZX_T +$80; CONT
+ DEFB ZX_D, ZX_I, ZX_M +$80; DIM
+ DEFB ZX_R, ZX_E, ZX_M +$80; REM
+ DEFB ZX_F, ZX_O, ZX_R +$80; FOR
+ DEFB ZX_G, ZX_O, ZX_T, ZX_O +$80; GOTO
+ DEFB ZX_G, ZX_O, ZX_S, ZX_U, ZX_B +$80; GOSUB
+ DEFB ZX_I, ZX_N, ZX_P, ZX_U, ZX_T +$80; INPUT
+ DEFB ZX_L, ZX_O, ZX_A, ZX_D +$80; LOAD
+ DEFB ZX_L, ZX_I, ZX_S, ZX_T +$80; LIST
+ DEFB ZX_L, ZX_E, ZX_T +$80; LET
+ DEFB ZX_P, ZX_A, ZX_U, ZX_S, ZX_E +$80; PAUSE
+ DEFB ZX_N, ZX_E, ZX_X, ZX_T +$80; NEXT
+ DEFB ZX_P, ZX_O, ZX_K, ZX_E +$80; POKE
+ DEFB ZX_P, ZX_R, ZX_I, ZX_N, ZX_T +$80; PRINT
+ DEFB ZX_P, ZX_L, ZX_O, ZX_T +$80; PLOT
+ DEFB ZX_R, ZX_U, ZX_N +$80; RUN
+ DEFB ZX_S, ZX_A, ZX_V, ZX_E +$80; SAVE
+ DEFB ZX_R, ZX_A, ZX_N, ZX_D +$80; RAND
+ DEFB ZX_I, ZX_F +$80; IF
+ DEFB ZX_C, ZX_L, ZX_S +$80; CLS
+ DEFB ZX_U, ZX_N, ZX_P, ZX_L, ZX_O, ZX_T +$80; UNPLOT
+ DEFB ZX_C, ZX_L, ZX_E, ZX_A, ZX_R +$80; CLEAR
+ DEFB ZX_R, ZX_E, ZX_T, ZX_U, ZX_R, ZX_N +$80; RETURN
+ DEFB ZX_C, ZX_O, ZX_P, ZX_Y +$80; COPY
+ DEFB ZX_R, ZX_N, ZX_D +$80; RND
+ DEFB ZX_I, ZX_N, ZX_K, ZX_E, ZX_Y, ZX_DOLLAR +$80; INKEY$
+ DEFB ZX_P, ZX_I +$80; PI
+
+------------------------------------------------------------------------
+
+; THE *'LOAD_SAVE UPDATE'* ROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_01FC:
+*LOAD_SAVE:*
+ INC HL ;
+ EX DE,HL ;
+ LD HL,(E_LINE) ; 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
+------------------------------------------------------------------------
+
+;
+;
+
+mark_0207:
+*SLOW_FAST:*
+ LD HL,CDFLAG ; 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,17 ; A counter within which an NMI should occur
+ ; if this is a ZX81.
+ OUT (IO_PORT_NMI_GEN_ON),A ; start the NMI generator.
+
+; Note that if this is a ZX81 then the NMI will increment AF'.
+
+mark_0216:
+*LOOP_11:*
+
+ DJNZ LOOP_11 <#LOOP_11> ; self loop to give the NMI a chance to kick in.
+ ; = 16*13 clock cycles + 8 = 216 clock cycles.
+
+ OUT (IO_PORT_NMI_GEN_OFF),A ; Turn off the NMI generator.
+ EX AF,AF' ; bring back the AF' value.
+ RLA ; test bit 7.
+ JR NC,NO_SLOW <#NO_SLOW> ; 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 DISPLAY_1 <#DISPLAY_1> ; skip forward - to DISPLAY_1.
+
+; ___
+
+mark_0226:
+*NO_SLOW:*
+ RES 6,(HL) ; reset bit 6 of CDFLAG.
+ RET ; return.
+
+------------------------------------------------------------------------
+
+; THE *'MAIN DISPLAY'* LOOP
+------------------------------------------------------------------------
+
+; This routine is executed once for every frame displayed.
+
+mark_0229:
+*DISPLAY_1:*
+
+ LD HL,(FRAMES) ; fetch two-byte system variable FRAMES.
+ DEC HL ; decrement frames counter.
+mark_022D:
+*DISPLAY_P:*
+ 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,ANOTHER <#ANOTHER> ; (12/7) forward if bits 14-0 are not zero
+ ; to ANOTHER
+
+ RLA ; (4) test bit 15 of FRAMES.
+ JR OVER_NC <#OVER_NC> ; (12) forward with result to OVER_NC
+
+; ___
+
+mark_0237:
+*ANOTHER:*
+ 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.
+
+mark_0239:
+*OVER_NC:*
+ LD H,A ; (4) set H to zero
+ LD (FRAMES),HL ; (16) update system variable FRAMES
+ RET NC ; (11/5) return if FRAMES is in use by PAUSE
+ ; command.
+
+mark_023E:
+*DISPLAY_2:*
+ CALL KEYBOARD <#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,(LAST_K) ; fetch the last key values
+ LD (LAST_K),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,2 ; 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,(DEBOUNCE_VAR)
+ 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,11 ; and load B with eleven
+
+ LD HL,CDFLAG ; address system variable CDFLAG
+ RES 0,(HL) ; reset the rightmost bit of CDFLAG
+ JR NZ,NO_KEY <#NO_KEY> ; 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
+
+mark_0264:
+*NO_KEY:*
+
+ LD HL,DEBOUNCE_VAR ;
+ CCF ; Complement Carry Flag
+ RL B ; rotate left B picking up carry
+ ; C<-76543210<-C
+
+
+
+
+
+
+mark_026A:
+*LOOP_B:*
+
+ DJNZ LOOP_B <#LOOP_B> ; self-loop while B>0 to LOOP_B
+
+ LD B,(HL) ; fetch value of DEBOUNCE_VAR to B
+ LD A,E ; transfer column value
+ CP $FE ;
+ SBC A,A ; A = A-A-C = 0-Carry
+#if 1
+; I think this truncating DEBOUNCE_VAR
+; which would explain why the VSYNC time didn't match
+; my calculations that assumed debouncing for 255 loops.
+;
+;
+ LD B,$1F ; binary 000 11111
+ OR (HL) ;
+ AND B ; truncate column, 0 to 31
+#endif
+ RRA ;
+ LD (HL),A ;
+
+ OUT (IO_PORT_SCREEN),A ; end the TV frame synchronization pulse.
+
+ LD HL,(D_FILE) ; (12) set HL to the Display File from D_FILE
+ SET 7,H ; (8) set bit 15 to address the echo display.
+
+ CALL DISPLAY_3 <#DISPLAY_3> ; (17) routine DISPLAY_3 displays the top set
+ ; of blank lines.
+
+------------------------------------------------------------------------
+
+; THE *'VIDEO_1'* ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0281:
+*R_IX_1:*
+ LD A,R ; (9) Harmless Nonsensical Timing
+ ; or something very clever?
+ LD BC,25*256+1 ; (10) 25 lines, 1 scanline in first. ($1901)
+
+; 32 characters, use $F5 (i.e. minus 11)
+; 40 characters, use $ED (i.e. minus 19)
+;
+
+mark_0286:
+ LD A,277-CHARS_PER_LINE_WINDOW ; $F5 for 6.5MHz clocked machines
+ ; (7) This value will be loaded into R and
+ ; ensures that the cycle starts at the right
+ ; part of the display - after last character
+ ; position.
+
+ CALL DISPLAY_5 <#DISPLAY_5> ; (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.
+*R_IX_1_LAST_NEWLINE:*
+ DEC HL ; point HL to the last NEWLINE/HALT.
+
+ CALL DISPLAY_3 <#DISPLAY_3> ; displays the bottom set of blank lines.
+
+; ___
+
+mark_028F:
+*R_IX_2:*
+ JP DISPLAY_1 <#DISPLAY_1> ; 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.
+;
+; It is actually pretty bad.
+; PAL or NTSC = 312 or
+; 1 to 5 = 5 long and 5 short sync
+; 6 to 23 = blank
+; 24 to 309 = image
+; 310 to 312 = 6 short sync
+;
+; The ZX80 generates either 62 or 110 blank lines
+;
+; 262 - 31 - 31 = 200
+; 312 - 55 - 55 = 202
+;
+; This does not include 'VSYNC' line periods.
+;
+
+mark_0292:
+*DISPLAY_3:*
+ POP IX ; pop the return address to IX register.
+ ; will be either R_IX_1 or R_IX_2 - see above.
+
+ LD C,(IY+MARGIN-RAMBASE) ; load C with value of system constant MARGIN.
+ BIT 7,(IY+CDFLAG-RAMBASE) ; test CDFLAG for compute and display.
+ JR Z,DISPLAY_4 <#DISPLAY_4> ; 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 (IO_PORT_NMI_GEN_ON),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
+------------------------------------------------------------------------
+
+
+mark_02A9:
+
+*DISPLAY_4:*
+
+ LD A,284-CHARS_PER_LINE_WINDOW ; $FC for 6.5MHz clocked machines
+ ; (7) load A with first R delay value
+
+ LD B,1 ; (7) one row only.
+
+ CALL DISPLAY_5 <#DISPLAY_5> ; (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 R_IX_1 or R_IX_2
+
+------------------------------------------------------------------------
+
+; 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)
+
+mark_02B5:
+*DISPLAY_5:*
+ LD R,A ; (9) Load R from A. R = slow: $F5 fast: $FC
+
+;; Original, for 32 column display:
+;;
+;; LD A,$DD ; (7) load future R value. $F6 $FD
+;;
+;; For other display widths,
+;; need to count down three instructions then the number of characters
+;;
+ LD A,256-3-CHARS_PER_LINE_WINDOW ; (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.
+
+mark_02BB:
+*KEYBOARD:*
+ 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.
+
+mark_02C5:
+*EACH_LINE:*
+ OR $E0 ; [7] OR %11100000
+ LD D,A ; [4] transfer to D.
+ CPL ; [4] complement - only bits 4-0 meaningful now.
+ CP 1 ; [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,EACH_LINE <#EACH_LINE> ; [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 0 {USA}
+ AND $18 ; (7) 24 or 0
+ ADD A,31 ; (7) 55 or 31
+
+; result is either 31 (USA) or 55 (UK) blank lines above and below the TV
+; picture.
+
+ LD (MARGIN),A ; (13) update system variable MARGIN
+
+ RET ; (10) return
+
+------------------------------------------------------------------------
+
+; THE *'SET FAST MODE'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_02E7:
+*SET_FAST:*
+ BIT 7,(IY+CDFLAG-RAMBASE)
+ RET Z ;
+
+ HALT ; Wait for Interrupt
+ OUT (IO_PORT_NMI_GEN_OFF),A ;
+ RES 7,(IY+CDFLAG-RAMBASE)
+ RET ; return.
+
+
+------------------------------------------------------------------------
+
+; THE *'REPORT_F'*
+------------------------------------------------------------------------
+
+
+mark_02F4:
+*REPORT_F:*
+ RST _ERROR_1
+ DEFB $0E ; Error Report: No Program Name supplied.
+
+------------------------------------------------------------------------
+
+; THE *'SAVE COMMAND'* ROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_02F6:
+*SAVE:*
+ CALL NAME <#NAME>
+ JR C,REPORT_F <#REPORT_F> ; back with null name
+
+ EX DE,HL ;
+
+
+
+
+;
+; The next 6 bytes differ
+;
+#if NOT_BODGED
+; what ZASM assembled:
+; 02FC: 11CB12
+ LD DE,$12CB ; five seconds timing value (4811 decimal)
+; 02FF: CD460F
+mark_02FF:
+*HEADER:*
+ CALL BREAK_1 <#BREAK_1>
+
+#else
+; what the SG ROM disassembled to:
+; 02FC ED;FD
+ LDIR ; Patch tape SAVE
+; 02FE C3;07;02
+ JP SLOW_FAST ; to $0207
+; 0301 0F
+ RRCA
+#endif
+
+
+mark_0302:
+ JR NC,BREAK_2 <#BREAK_2>
+
+mark_0304:
+*DELAY_1:*
+ DJNZ DELAY_1 <#DELAY_1>
+
+ DEC DE ;
+ LD A,D ;
+ OR E ;
+ JR NZ,HEADER <#HEADER> ; back for delay to HEADER
+
+mark_030B:
+*OUT_NAME:*
+ CALL OUT_BYTE <#OUT_BYTE>
+ BIT 7,(HL) ; test for inverted bit.
+ INC HL ; address next character of name.
+ JR Z,OUT_NAME <#OUT_NAME> ; back if not inverted to OUT_NAME
+
+; now start saving the system variables onwards.
+
+ LD HL,VERSN ; set start of area to VERSN thereby
+ ; preserving RAMTOP etc.
+
+mark_0316:
+*OUT_PROG:*
+ CALL OUT_BYTE <#OUT_BYTE>
+
+ CALL LOAD_SAVE <#LOAD_SAVE> ; >>
+ JR OUT_PROG <#OUT_PROG> ; loop back
+
+------------------------------------------------------------------------
+
+; THE *'OUT_BYTE'* SUBROUTINE
+------------------------------------------------------------------------
+
+; This subroutine outputs a byte a bit at a time to a domestic tape recorder.
+
+mark_031E:
+*OUT_BYTE:*
+ LD E,(HL) ; fetch byte to be saved.
+ SCF ; set carry flag - as a marker.
+
+mark_0320:
+*EACH_BIT:*
+ 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.
+
+mark_0329:
+*PULSES:*
+ OUT (IO_PORT_TAPE),A ; pulse to cassette.
+ LD B,$23 ; set timing constant
+
+mark_032D:
+*DELAY_2:*
+ DJNZ DELAY_2 <#DELAY_2> ; self-loop
+
+ CALL BREAK_1 <#BREAK_1> ; test for BREAK key.
+
+mark_0332:
+*BREAK_2:*
+ JR NC,REPORT_D <#REPORT_D> ; forward with break to REPORT_D
+
+ LD B,$1E ; set timing value.
+
+mark_0336:
+*DELAY_3:*
+
+ DJNZ DELAY_3 <#DELAY_3> ; self-loop
+
+ DEC C ; decrement counter
+ JR NZ,PULSES <#PULSES> ; loop back
+
+mark_033B:
+*DELAY_4:*
+ AND A ; clear carry for next bit test.
+ DJNZ DELAY_4 <#DELAY_4> ; self loop (B is zero - 256)
+
+ JR EACH_BIT <#EACH_BIT> ; loop back
+
+------------------------------------------------------------------------
+
+; THE *'LOAD COMMAND'* ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0340:
+*LOAD:*
+ CALL NAME <#NAME>
+
+; DE points to start of name in RAM.
+
+ RL D ; pick up carry
+ RRC D ; carry now in bit 7.
+
+mark_0347:
+
+
+
+#if NOT_BODGED
+
+*LNEXT_PROG:*
+ CALL IN_BYTE <#IN_BYTE>
+ JR LNEXT_PROG <#LNEXT_PROG> ; loop
+
+------------------------------------------------------------------------
+
+; THE *'IN_BYTE'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_034C:
+*IN_BYTE:*
+ LD C,$01 ; prepare an eight counter 00000001.
+
+mark_034E:
+*NEXT_BIT:*
+ LD B,$00 ; set counter to 256
+
+#else
+; what the SG ROM has:
+;0347 EB
+ EX DE,HL ; NEXT-PROG
+;0348 ED;FC
+ LDIR ; Patch tape LOAD
+;034A C3;07;02
+ JP SLOW_FAST
+;034D 01;06;00
+ LD BC,6
+#endif
+
+
+
+
+mark_0350:
+*BREAK_3:*
+ LD A,$7F ; read the keyboard row
+ IN A,(IO_PORT_KEYBOARD_RD) ; with the SPACE key.
+
+ OUT (IO_PORT_SCREEN),A ; output signal to screen.
+
+ RRA ; test for SPACE pressed.
+ JR NC,BREAK_4 <#BREAK_4> ; forward if so to BREAK_4
+
+ RLA ; reverse above rotation
+ RLA ; test tape bit.
+ JR C,GET_BIT <#GET_BIT> ; forward if set to GET_BIT
+
+ DJNZ BREAK_3 <#BREAK_3> ; loop back
+
+ POP AF ; drop the return address.
+ CP D ; ugh.
+
+mark_0361:
+*RESTART:*
+ JP NC,INITIAL <#INITIAL> ; 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
+
+mark_0366:
+*IN_NAME:*
+ CALL IN_BYTE <#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,MATCHING <#MATCHING> ; forward with null string
+
+ CP (HL) ; else compare with string in memory.
+ JR NZ,LNEXT_PROG <#LNEXT_PROG> ; back with mis-match
+ ; (seemingly out of subroutine but return
+ ; address has been dropped).
+
+
+mark_0371:
+*MATCHING:*
+ INC HL ; address next character of name
+ RLA ; test for inverted bit.
+ JR NC,IN_NAME <#IN_NAME> ; back if not
+
+; 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+E_LINE_hi-RAMBASE) ; increment E_LINE_hi.
+ LD HL,VERSN ; start loading at VERSN.
+
+mark_037B:
+*IN_PROG:*
+ LD D,B ; set D to zero as indicator.
+ CALL IN_BYTE <#IN_BYTE> ; loads a byte
+ LD (HL),C ; insert assembled byte in memory.
+ CALL LOAD_SAVE <#LOAD_SAVE> ; >>
+ JR IN_PROG <#IN_PROG> ; loop back
+
+; ___
+
+; this branch assembles a full byte before exiting normally
+; from the IN_BYTE subroutine.
+
+mark_0385:
+*GET_BIT:*
+ PUSH DE ; save the
+ LD E,$94 ; timing value.
+
+mark_0388:
+*TRAILER:*
+ LD B,26 ; counter to twenty six.
+
+mark_038A:
+*COUNTER:*
+ DEC E ; decrement the measuring timer.
+ IN A,(IO_PORT_KEYBOARD_RD) ; read the tape input
+ RLA ;
+ BIT 7,E ;
+ LD A,E ;
+ JR C,TRAILER <#TRAILER> ; loop back with carry to TRAILER
+
+ DJNZ COUNTER <#COUNTER>
+
+ POP DE ;
+ JR NZ,BIT_DONE <#BIT_DONE>
+
+ CP $56 ;
+ JR NC,NEXT_BIT <#NEXT_BIT>
+
+mark_039C:
+*BIT_DONE:*
+ CCF ; complement carry flag
+ RL C ;
+ JR NC,NEXT_BIT <#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.
+
+mark_03A2:
+*BREAK_4:*
+ LD A,D ; transfer indicator to A.
+ AND A ; test for zero.
+ JR Z,RESTART <#RESTART> ; back if so
+
+
+mark_03A6:
+*REPORT_D:*
+ RST _ERROR_1
+ DEFB $0C ; Error Report: BREAK - CONT repeats
+
+------------------------------------------------------------------------
+
+; THE *'PROGRAM NAME'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_03A8:
+*NAME:*
+ CALL SCANNING <#SCANNING>
+ LD A,(FLAGS) ; sv
+ ADD A,A ;
+ JP M,REPORT_C <#REPORT_C>
+
+ POP HL ;
+ RET NC ;
+
+ PUSH HL ;
+ CALL SET_FAST <#SET_FAST>
+ CALL STK_FETCH <#STK_FETCH>
+ LD H,D ;
+ LD L,E ;
+ DEC C ;
+ RET M ;
+
+ ADD HL,BC ;
+ SET 7,(HL) ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'NEW'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+
+mark_03C3:
+*NEW:*
+ CALL SET_FAST <#SET_FAST>
+ LD BC,(RAMTOP) ; fetch value of system variable RAMTOP
+ DEC BC ; point to last system byte.
+
+------------------------------------------------------------------------
+
+; THE *'RAM CHECK'* ROUTINE
+------------------------------------------------------------------------
+
+
+mark_03CB:
+*RAM_CHECK:*
+ LD H,B ;
+ LD L,C ;
+ LD A,$3F ;
+
+mark_03CF:
+*RAM_FILL:*
+ LD (HL),$02 ;
+ DEC HL ;
+ CP H ;
+ JR NZ,RAM_FILL <#RAM_FILL>
+
+mark_03D5:
+*RAM_READ:*
+ AND A ;
+ SBC HL,BC ;
+ ADD HL,BC ;
+ INC HL ;
+ JR NC,SET_TOP <#SET_TOP>
+
+ DEC (HL) ;
+ JR Z,SET_TOP <#SET_TOP>
+
+ DEC (HL) ;
+ JR Z,RAM_READ <#RAM_READ>
+
+mark_03E2:
+*SET_TOP:*
+ LD (RAMTOP),HL ; set system variable RAMTOP to first byte
+ ; above the BASIC system area.
+
+------------------------------------------------------------------------
+
+; THE *'INITIALIZATION'* ROUTINE
+------------------------------------------------------------------------
+
+
+mark_03E5:
+*INITIAL:*
+ LD HL,(RAMTOP) ; 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 (ERR_SP),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,ERR_NR ; set IY to the start of RAM so that the
+ ; system variables can be indexed.
+
+ LD (IY+CDFLAG-RAMBASE),%01000000
+ ; Bit 6 indicates Compute and Display required.
+
+ LD HL,USER_RAM ; The first location after System Variables -
+ ; 16509 decimal.
+ LD (D_FILE),HL ; set system variable D_FILE to this value.
+ LD B,$19 ; prepare minimal screen of 24 NEWLINEs
+ ; following an initial NEWLINE.
+
+mark_0408:
+*LINE:*
+ LD (HL),ZX_NEWLINE ; insert NEWLINE (HALT instruction)
+ INC HL ; point to next location.
+ DJNZ LINE <#LINE> ; loop back for all twenty five to LINE
+
+ LD (VARS),HL ; set system variable VARS to next location
+
+ CALL CLEAR <#CLEAR> ; sets $80 end-marker and the
+ ; dynamic memory pointers E_LINE, STKBOT and
+ ; STKEND.
+
+mark_0413:
+*N_L_ONLY:*
+ CALL CURSOR_IN <#CURSOR_IN> ; inserts the cursor and
+ ; end-marker in the Edit Line also setting
+ ; size of lower display to two lines.
+
+ CALL SLOW_FAST <#SLOW_FAST> ; selects COMPUTE and DISPLAY
+
+------------------------------------------------------------------------
+
+; THE *'BASIC LISTING'* SECTION
+------------------------------------------------------------------------
+
+
+mark_0419:
+*UPPER:*
+ CALL CLS <#CLS>
+ LD HL,(E_PPC) ; sv
+ LD DE,(S_TOP) ; sv
+ AND A ;
+ SBC HL,DE ;
+ EX DE,HL ;
+ JR NC,ADDR_TOP <#ADDR_TOP>
+
+ ADD HL,DE ;
+ LD (S_TOP),HL ; sv
+
+mark_042D:
+*ADDR_TOP:*
+ CALL LINE_ADDR <#LINE_ADDR>
+ JR Z,LIST_TOP <#LIST_TOP>
+
+ EX DE,HL ;
+
+mark_0433:
+*LIST_TOP:*
+ CALL LIST_PROG <#LIST_PROG>
+ DEC (IY+BERG-RAMBASE)
+ JR NZ,LOWER <#LOWER>
+
+ LD HL,(E_PPC) ; sv
+ CALL LINE_ADDR <#LINE_ADDR>
+ LD HL,(CH_ADD) ; sv
+ SCF ; Set Carry Flag
+ SBC HL,DE ;
+ LD HL,S_TOP ; sv
+ JR NC,INC_LINE <#INC_LINE>
+
+ EX DE,HL ;
+ LD A,(HL) ;
+ INC HL ;
+ LDI ;
+ LD (DE),A ;
+ JR UPPER <#UPPER>
+; ___
+
+mark_0454:
+*DOWN_KEY:*
+
+ LD HL,E_PPC ; sv
+
+mark_0457:
+*INC_LINE:*
+ LD E,(HL) ;
+ INC HL ;
+ LD D,(HL) ;
+ PUSH HL ;
+ EX DE,HL ;
+ INC HL ;
+ CALL LINE_ADDR <#LINE_ADDR>
+ CALL LINE_NUM <#LINE_NUM>
+ POP HL ;
+
+mark_0464:
+*KEY_INPUT:*
+ BIT 5,(IY+FLAGX-RAMBASE)
+ JR NZ,LOWER <#LOWER> ; forward
+
+ LD (HL),D ;
+ DEC HL ;
+ LD (HL),E ;
+ JR UPPER <#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
+
+
+mark_046F:
+*EDIT_INP:*
+ CALL CURSOR_IN <#CURSOR_IN> ; sets cursor only edit line.
+
+; ->
+
+mark_0472:
+*LOWER:*
+ LD HL,(E_LINE) ; fetch edit line start from E_LINE.
+
+mark_0475:
+*EACH_CHAR:*
+ LD A,(HL) ; fetch a character from edit line.
+ CP $7E ; compare to the number marker.
+ JR NZ,END_LINE <#END_LINE> ; forward if not
+
+ LD BC,6 ; else six invisible bytes to be removed.
+ CALL RECLAIM_2 <#RECLAIM_2>
+ JR EACH_CHAR <#EACH_CHAR> ; back
+; ___
+
+mark_0482:
+*END_LINE:*
+ CP ZX_NEWLINE ;
+ INC HL ;
+ JR NZ,EACH_CHAR <#EACH_CHAR>
+
+mark_0487:
+*EDIT_LINE:*
+ CALL CURSOR <#CURSOR> ; sets cursor K or L.
+
+mark_048A:
+*EDIT_ROOM:*
+ CALL LINE_ENDS <#LINE_ENDS>
+ LD HL,(E_LINE) ; sv
+ LD (IY+ERR_NR-RAMBASE),$FF
+ CALL COPY_LINE <#COPY_LINE>
+ BIT 7,(IY+ERR_NR-RAMBASE)
+ JR NZ,DISPLAY_6 <#DISPLAY_6>
+
+ LD A,(DF_SZ) ;
+ CP CHARS_VERTICAL ; $18 = 24
+ JR NC,DISPLAY_6 <#DISPLAY_6>
+
+ INC A ;
+ LD (DF_SZ),A ;
+ LD B,A ;
+ LD C,1 ;
+ CALL LOC_ADDR <#LOC_ADDR>
+ LD D,H ;
+ LD E,L ;
+ LD A,(HL) ;
+
+mark_04B1:
+*FREE_LINE:*
+ DEC HL ;
+ CP (HL) ;
+ JR NZ,FREE_LINE <#FREE_LINE>
+
+ INC HL ;
+ EX DE,HL ;
+ LD A,(RAMTOP+1) ; sv RAMTOP_hi
+ CP $4D ;
+ CALL C,RECLAIM_1 <#RECLAIM_1>
+ JR EDIT_ROOM <#EDIT_ROOM>
+
+------------------------------------------------------------------------
+
+; THE *'WAIT FOR KEY'* SECTION
+------------------------------------------------------------------------
+
+
+mark_04C1:
+*DISPLAY_6:*
+ LD HL,$0000 ;
+ LD (X_PTR),HL ; sv
+
+ LD HL,CDFLAG ; system variable CDFLAG
+
+
+
+
+#if NOT_BODGED
+ BIT 7,(HL) ;
+
+ CALL Z,DISPLAY_1 <#DISPLAY_1>
+
+mark_04CF:
+*SLOW_DISP:*
+ BIT 0,(HL) ;
+ JR Z,SLOW_DISP <#SLOW_DISP>
+
+#else
+; 04CA D3;00
+ OUT ($00),A ; PORT 0
+; 04CC CB;46
+L04CC:
+ BIT 0,(HL)
+; 04CE 28;FC
+ JR Z,L04CC
+; 04D0 D3;01
+ OUT ($01),A ; PORT 1
+; 04D2 00
+ NOP
+
+
+#endif
+
+
+
+
+ LD BC,(LAST_K) ; sv
+ CALL DEBOUNCE <#DEBOUNCE>
+ CALL DECODE <#DECODE>
+
+ JR NC,LOWER <#LOWER> ; back
+
+------------------------------------------------------------------------
+
+; THE *'KEYBOARD DECODING'* SECTION
+------------------------------------------------------------------------
+
+; The decoded key value is in E and HL points to the position in the
+; key table. D contains zero.
+
+mark_04DF:
+*K_DECODE:*
+ LD A,(MODE) ; Fetch value of system variable MODE
+ DEC A ; test the three values together
+
+ JP M,FETCH_2 <#FETCH_2> ; forward, if was zero
+
+ JR NZ,FETCH_1 <#FETCH_1> ; forward, if was 2
+
+; The original value was one and is now zero.
+
+ LD (MODE),A ; update the system variable MODE
+
+ DEC E ; reduce E to range $00 - $7F
+ LD A,E ; place in A
+ SUB 39 ; subtract 39 setting carry if range 00 - 38
+ JR C,FUNC_BASE <#FUNC_BASE> ; forward, if so
+
+ LD E,A ; else set E to reduced value
+
+mark_04F2:
+*FUNC_BASE:*
+ LD HL,K_FUNCT <#K_FUNCT> ; address of K_FUNCT table for function keys.
+ JR TABLE_ADD <#TABLE_ADD> ; forward
+; ___
+mark_04F7:
+*FETCH_1:*
+ LD A,(HL) ;
+ CP ZX_NEWLINE ;
+ JR Z,K_L_KEY <#K_L_KEY>
+
+ CP ZX_RND ; $40
+ SET 7,A ;
+ JR C,ENTER <#ENTER>
+
+ LD HL,$00C7 ; (expr reqd)
+
+mark_0505:
+*TABLE_ADD:*
+ ADD HL,DE ;
+ JR FETCH_3 <#FETCH_3>
+
+; ___
+
+mark_0508:
+*FETCH_2:*
+ LD A,(HL) ;
+ BIT 2,(IY+FLAGS-RAMBASE) ; K or L mode ?
+ JR NZ,TEST_CURS <#TEST_CURS>
+
+ ADD A,$C0 ;
+ CP $E6 ;
+ JR NC,TEST_CURS <#TEST_CURS>
+
+mark_0515:
+*FETCH_3:*
+ LD A,(HL) ;
+
+mark_0516:
+*TEST_CURS:*
+ CP $F0 ;
+ JP PE,KEY_SORT <#KEY_SORT>
+
+mark_051B:
+*ENTER:*
+ LD E,A ;
+ CALL CURSOR <#CURSOR>
+
+ LD A,E ;
+ CALL ADD_CHAR <#ADD_CHAR>
+
+mark_0523:
+*BACK_NEXT:*
+ JP LOWER <#LOWER> ; back
+
+------------------------------------------------------------------------
+
+; THE *'ADD CHARACTER'* SUBROUTINE
+------------------------------------------------------------------------
+
+mark_0526:
+*ADD_CHAR:*
+ CALL ONE_SPACE <#ONE_SPACE>
+ LD (DE),A ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'CURSOR KEYS'* ROUTINE
+------------------------------------------------------------------------
+
+mark_052B:
+*K_L_KEY:*
+ LD A,ZX_KL ;
+
+mark_052D:
+*KEY_SORT:*
+ 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 ;
+
+mark_0537:
+*CURSOR:*
+ LD HL,(E_LINE) ; sv
+ BIT 5,(IY+FLAGX-RAMBASE)
+ JR NZ,L_MODE <#L_MODE>
+
+mark_0540:
+*K_MODE:*
+ RES 2,(IY+FLAGS-RAMBASE) ; Signal use K mode
+
+mark_0544:
+*TEST_CHAR:*
+ LD A,(HL) ;
+ CP ZX_CURSOR ;
+ RET Z ; return
+
+ INC HL ;
+ CALL NUMBER <#NUMBER>
+ JR Z,TEST_CHAR <#TEST_CHAR>
+
+ CP ZX_A ; $26
+ JR C,TEST_CHAR <#TEST_CHAR>
+
+ CP $DE ; ZX_THEN ??
+ JR Z,K_MODE <#K_MODE>
+
+mark_0556:
+*L_MODE:*
+ SET 2,(IY+FLAGS-RAMBASE) ; Signal use L mode
+ JR TEST_CHAR <#TEST_CHAR>
+
+------------------------------------------------------------------------
+
+; THE *'CLEAR_ONE'* SUBROUTINE
+------------------------------------------------------------------------
+
+mark_055C:
+*CLEAR_ONE:*
+ LD BC,$0001 ;
+ JP RECLAIM_2 <#RECLAIM_2>
+
+------------------------------------------------------------------------
+
+; THE *'EDITING KEYS'* TABLE
+------------------------------------------------------------------------
+
+mark_0562:
+*ED_KEYS:*
+ DEFW UP_KEY <#UP_KEY>
+ DEFW DOWN_KEY <#DOWN_KEY>
+ DEFW LEFT_KEY <#LEFT_KEY>
+ DEFW RIGHT_KEY <#RIGHT_KEY>
+ DEFW FUNCTION <#FUNCTION>
+ DEFW EDIT_KEY <#EDIT_KEY>
+ DEFW N_L_KEY <#N_L_KEY>
+ DEFW RUBOUT <#RUBOUT>
+ DEFW FUNCTION <#FUNCTION>
+ DEFW FUNCTION <#FUNCTION>
+
+
+------------------------------------------------------------------------
+
+; THE *'CURSOR LEFT'* ROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_LEFT_KEY:
+*LEFT_KEY:*
+ CALL LEFT_EDGE <#LEFT_EDGE>
+ LD A,(HL) ;
+ LD (HL),ZX_CURSOR ;
+ INC HL ;
+ JR GET_CODE <#GET_CODE>
+
+------------------------------------------------------------------------
+
+; THE *'CURSOR RIGHT'* ROUTINE
+------------------------------------------------------------------------
+
+
+mark_RIGHT_KEY:
+*RIGHT_KEY:*
+ INC HL ;
+ LD A,(HL) ;
+ CP ZX_NEWLINE ;
+ JR Z,ENDED_2 <#ENDED_2>
+
+ LD (HL),ZX_CURSOR ;
+ DEC HL ;
+
+mark_0588:
+*GET_CODE:*
+ LD (HL),A ;
+
+mark_0589:
+*ENDED_1:*
+ JR BACK_NEXT <#BACK_NEXT>
+
+------------------------------------------------------------------------
+
+; THE *'RUBOUT'* ROUTINE
+------------------------------------------------------------------------
+
+
+mark_058B:
+*RUBOUT:*
+ CALL LEFT_EDGE <#LEFT_EDGE>
+ CALL CLEAR_ONE <#CLEAR_ONE>
+ JR ENDED_1 <#ENDED_1>
+
+------------------------------------------------------------------------
+
+; THE *'ED_EDGE'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_0593:
+*LEFT_EDGE:*
+ DEC HL ;
+ LD DE,(E_LINE) ; sv
+ LD A,(DE) ;
+ CP ZX_CURSOR ;
+ RET NZ ;
+
+ POP DE ;
+
+mark_059D:
+*ENDED_2:*
+ JR ENDED_1 <#ENDED_1>
+
+------------------------------------------------------------------------
+
+; THE *'CURSOR UP'* ROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_059F:
+*UP_KEY:*
+ LD HL,(E_PPC) ; sv
+ CALL LINE_ADDR <#LINE_ADDR>
+ EX DE,HL ;
+ CALL LINE_NUM <#LINE_NUM>
+ LD HL,E_PPC+1 ; point to system variable E_PPC_hi
+ JP KEY_INPUT <#KEY_INPUT> ; jump back
+
+------------------------------------------------------------------------
+
+; THE *'FUNCTION KEY'* ROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_FUNCTION:
+*FUNCTION:*
+ LD A,E ;
+ AND $07 ;
+ LD (MODE),A ; sv
+ JR ENDED_2 <#ENDED_2> ; back
+
+------------------------------------------------------------------------
+
+; THE *'COLLECT LINE NUMBER'* SUBROUTINE
+------------------------------------------------------------------------
+
+mark_05B7:
+*ZERO_DE:*
+ EX DE,HL ;
+ LD DE,DISPLAY_6 <#DISPLAY_6> + 1 ; $04C2 - a location addressing two zeros.
+
+; ->
+
+mark_05BB:
+*LINE_NUM:*
+ LD A,(HL) ;
+ AND $C0 ;
+ JR NZ,ZERO_DE <#ZERO_DE>
+
+ LD D,(HL) ;
+ INC HL ;
+ LD E,(HL) ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'EDIT KEY'* ROUTINE
+------------------------------------------------------------------------
+
+
+mark_EDIT_KEY:
+*EDIT_KEY:*
+ CALL LINE_ENDS <#LINE_ENDS> ; clears lower display.
+
+ LD HL,EDIT_INP <#EDIT_INP> ; Address: EDIT_INP
+ PUSH HL ; ** is pushed as an error looping address.
+
+ BIT 5,(IY+FLAGX-RAMBASE) ; test FLAGX
+ RET NZ ; indirect jump if in input mode
+ ; to EDIT_INP <#EDIT_INP> (begin again).
+
+;
+
+ LD HL,(E_LINE) ; fetch E_LINE
+ LD (DF_CC),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.
+
+ ; prepare line 0, column 0.
+
+ LD HL,256*CHARS_VERTICAL + CHARS_HORIZONTAL + 1
+;
+ LD (S_POSN),HL ; update S_POSN with these dummy values.
+
+ LD HL,(E_PPC) ; fetch current line from E_PPC may be a
+ ; non-existent line e.g. last line deleted.
+ CALL LINE_ADDR <#LINE_ADDR> ; gets address or that of
+ ; the following line.
+ CALL LINE_NUM <#LINE_NUM> ; 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 OUT_NO <#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,(DF_CC) ; fetch display file cursor DF_CC
+
+ LD A,ZX_CURSOR ; 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,29 ; 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 EDIT_INP 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 SET_STK_B <#SET_STK_B> ; sets STKEND from HL.
+
+ JR ENDED_2 <#ENDED_2> ; back to ENDED_2 and after 3 more jumps
+ ; to LOWER <#LOWER>, LOWER.
+ ; Note. The LOWER routine removes the hidden
+ ; floating-point numbers from the edit line.
+
+------------------------------------------------------------------------
+
+; THE *'NEWLINE KEY'* ROUTINE
+------------------------------------------------------------------------
+
+
+mark_060C:
+*N_L_KEY:*
+ CALL LINE_ENDS <#LINE_ENDS>
+
+ LD HL,LOWER <#LOWER> ; prepare address: LOWER
+
+ BIT 5,(IY+FLAGX-RAMBASE)
+ JR NZ,NOW_SCAN <#NOW_SCAN>
+
+ LD HL,(E_LINE) ; sv
+ LD A,(HL) ;
+ CP $FF ;
+ JR Z,STK_UPPER <#STK_UPPER>
+
+ CALL CLEAR_PRB <#CLEAR_PRB>
+ CALL CLS <#CLS>
+
+mark_0626:
+*STK_UPPER:*
+ LD HL,UPPER <#UPPER> ; Address: UPPER
+
+mark_0629:
+*NOW_SCAN:*
+ PUSH HL ; push routine address (LOWER or UPPER).
+ CALL LINE_SCAN <#LINE_SCAN>
+ POP HL ;
+ CALL CURSOR <#CURSOR>
+ CALL CLEAR_ONE <#CLEAR_ONE>
+ CALL E_LINE_NUM <#E_LINE_NUM>
+ JR NZ,N_L_INP <#N_L_INP>
+
+ LD A,B ;
+ OR C ;
+ JP NZ,N_L_LINE <#N_L_LINE>
+
+ DEC BC ;
+ DEC BC ;
+ LD (PPC),BC ; sv
+ LD (IY+DF_SZ-RAMBASE),2
+ LD DE,(D_FILE) ; sv
+
+ JR TEST_NULL <#TEST_NULL> ; forward
+
+; ___
+
+mark_064E:
+*N_L_INP:*
+ CP ZX_NEWLINE ;
+ JR Z,N_L_NULL <#N_L_NULL>
+
+ LD BC,(T_ADDR) ;
+ CALL LOC_ADDR <#LOC_ADDR>
+ LD DE,(NXTLIN) ;
+ LD (IY+DF_SZ-RAMBASE),2
+
+mark_0661:
+*TEST_NULL:*
+ RST _GET_CHAR
+ CP ZX_NEWLINE ;
+
+mark_0664:
+*N_L_NULL:*
+ JP Z,N_L_ONLY <#N_L_ONLY>
+
+ LD (IY+FLAGS-RAMBASE),$80
+ EX DE,HL ;
+
+mark_066C:
+*NEXT_LINE:*
+ LD (NXTLIN),HL ;
+ EX DE,HL ;
+ CALL TEMP_PTR2 <#TEMP_PTR2>
+ CALL LINE_RUN <#LINE_RUN>
+ RES 1,(IY+FLAGS-RAMBASE) ; Signal printer not in use
+ LD A,$C0 ;
+;; LD (IY+X_PTR_lo-RAMBASE),A ;; ERROR IN htm SOURCE! IY+$19 is X_PTR_hi
+ LD (IY+X_PTR_hi-RAMBASE),A
+ CALL X_TEMP <#X_TEMP>
+ RES 5,(IY+FLAGX-RAMBASE)
+ BIT 7,(IY+ERR_NR-RAMBASE)
+ JR Z,STOP_LINE <#STOP_LINE>
+
+ LD HL,(NXTLIN) ;
+ AND (HL) ;
+ JR NZ,STOP_LINE <#STOP_LINE>
+
+ LD D,(HL) ;
+ INC HL ;
+ LD E,(HL) ;
+ LD (PPC),DE ;
+ INC HL ;
+ LD E,(HL) ;
+ INC HL ;
+ LD D,(HL) ;
+ INC HL ;
+ EX DE,HL ;
+ ADD HL,DE ;
+ CALL BREAK_1 <#BREAK_1>
+ JR C,NEXT_LINE <#NEXT_LINE>
+
+ LD HL,ERR_NR
+ BIT 7,(HL)
+ JR Z,STOP_LINE <#STOP_LINE>
+
+ LD (HL),$0C
+
+mark_06AE:
+*STOP_LINE:*
+ BIT 7,(IY+PR_CC-RAMBASE)
+ CALL Z,COPY_BUFF <#COPY_BUFF>
+;
+#if 0
+ LD BC,$0121 ;
+#else
+ LD BC,256*1 + CHARS_HORIZONTAL + 1
+#endif
+;
+;
+ CALL LOC_ADDR <#LOC_ADDR>
+ LD A,(ERR_NR)
+ LD BC,(PPC)
+ INC A
+ JR Z,REPORT <#REPORT>
+
+ CP $09
+ JR NZ,CONTINUE <#CONTINUE>
+
+ INC BC
+
+mark_06CA:
+*CONTINUE:*
+ LD (OLDPPC),BC ;
+ JR NZ,REPORT <#REPORT>
+
+ DEC BC ;
+
+mark_06D1:
+*REPORT:*
+ CALL OUT_CODE <#OUT_CODE>
+ LD A,ZX_SLASH
+
+ RST _PRINT_A
+ CALL OUT_NUM <#OUT_NUM>
+ CALL CURSOR_IN <#CURSOR_IN>
+ JP DISPLAY_6 <#DISPLAY_6>
+
+; ___
+
+mark_06E0:
+*N_L_LINE:*
+ LD (E_PPC),BC ;
+ LD HL,(CH_ADD) ;
+ EX DE,HL ;
+ LD HL,N_L_ONLY <#N_L_ONLY>
+ PUSH HL ;
+ LD HL,(STKBOT) ;
+ SBC HL,DE ;
+ PUSH HL ;
+ PUSH BC ;
+ CALL SET_FAST <#SET_FAST>
+ CALL CLS <#CLS>
+ POP HL ;
+ CALL LINE_ADDR <#LINE_ADDR>
+ JR NZ,COPY_OVER <#COPY_OVER>
+
+ CALL NEXT_ONE <#NEXT_ONE>
+ CALL RECLAIM_2 <#RECLAIM_2>
+
+mark_0705:
+*COPY_OVER:*
+ POP BC ;
+ LD A,C ;
+ DEC A ;
+ OR B ;
+ RET Z ;
+
+ PUSH BC ;
+ INC BC ;
+ INC BC ;
+ INC BC ;
+ INC BC ;
+ DEC HL ;
+ CALL MAKE_ROOM <#MAKE_ROOM>
+ CALL SLOW_FAST <#SLOW_FAST>
+ POP BC ;
+ PUSH BC ;
+ INC DE ;
+ LD HL,(STKBOT) ;
+ DEC HL ;
+ LDDR ; copy bytes
+ LD HL,(E_PPC) ;
+ 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
+------------------------------------------------------------------------
+
+
+mark_072C:
+*LLIST:*
+ SET 1,(IY+FLAGS-RAMBASE) ; signal printer in use
+
+mark_0730:
+*LIST:*
+ CALL FIND_INT <#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 (E_PPC),HL ;
+ CALL LINE_ADDR <#LINE_ADDR>
+
+mark_073E:
+*LIST_PROG:*
+ LD E,$00 ;
+
+mark_0740:
+*UNTIL_END:*
+ CALL OUT_LINE <#OUT_LINE> ; lists one line of BASIC
+ ; making an early return when the screen is
+ ; full or the end of program is reached.
+ JR UNTIL_END <#UNTIL_END> ; loop back to UNTIL_END
+
+------------------------------------------------------------------------
+
+; THE *'PRINT A BASIC LINE'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_0745:
+*OUT_LINE:*
+ LD BC,(E_PPC) ; sv
+ CALL CP_LINES <#CP_LINES>
+ LD D,$92 ;
+ JR Z,TEST_END <#TEST_END>
+
+ LD DE,$0000 ;
+ RL E ;
+
+mark_0755:
+*TEST_END:*
+ LD (IY+BERG-RAMBASE),E
+ LD A,(HL) ;
+ CP $40 ;
+ POP BC ;
+ RET NC ;
+
+ PUSH BC ;
+ CALL OUT_NO <#OUT_NO>
+ INC HL ;
+ LD A,D ;
+
+ RST _PRINT_A
+ INC HL ;
+ INC HL ;
+
+mark_0766:
+*COPY_LINE:*
+ LD (CH_ADD),HL ;
+ SET 0,(IY+FLAGS-RAMBASE) ; Suppress leading space
+
+mark_076D:
+*MORE_LINE:*
+ LD BC,(X_PTR) ;
+ LD HL,(CH_ADD) ;
+ AND A ;
+ SBC HL,BC ;
+ JR NZ,TEST_NUM <#TEST_NUM>
+
+ LD A,ZX_INV_S ; $B8 ;
+
+ RST _PRINT_A
+
+mark_077C:
+*TEST_NUM:*
+ LD HL,(CH_ADD) ;
+ LD A,(HL) ;
+ INC HL ;
+ CALL NUMBER <#NUMBER>
+ LD (CH_ADD),HL ;
+ JR Z,MORE_LINE <#MORE_LINE>
+
+ CP ZX_CURSOR ;
+ JR Z,OUT_CURS <#OUT_CURS>
+
+ CP ZX_NEWLINE ;
+ JR Z,OUT_CH <#OUT_CH>
+
+ BIT 6,A ;
+ JR Z,NOT_TOKEN <#NOT_TOKEN>
+
+ CALL TOKENS <#TOKENS>
+ JR MORE_LINE <#MORE_LINE>
+; ___
+
+mark_079A:
+*NOT_TOKEN:*
+ RST _PRINT_A
+ JR MORE_LINE <#MORE_LINE>
+; ___
+
+mark_079D:
+*OUT_CURS:*
+ LD A,(MODE) ; Fetch value of system variable MODE
+ LD B,$AB ; Prepare an inverse [F] for function cursor.
+
+ AND A ; Test for zero -
+ JR NZ,FLAGS_2 <#FLAGS_2> ; forward if not to FLAGS_2
+
+ LD A,(FLAGS) ; Fetch system variable FLAGS.
+ LD B,ZX_INV_K ; Prepare an inverse [K] for keyword cursor.
+
+mark_07AA:
+*FLAGS_2:*
+ RRA ; 00000?00 -> 000000?0
+ RRA ; 000000?0 -> 0000000?
+ AND $01 ; 0000000? 0000000x
+
+ ADD A,B ; Possibly [F] -> [G] or [K] -> [L]
+
+ CALL PRINT_SP <#PRINT_SP>
+ JR MORE_LINE <#MORE_LINE>
+
+------------------------------------------------------------------------
+
+; THE *'NUMBER'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_07B4:
+*NUMBER:*
+ CP $7E ;
+ RET NZ ;
+
+ INC HL ;
+ INC HL ;
+ INC HL ;
+ INC HL ;
+ INC HL ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'KEYBOARD DECODE'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_07BD:
+*DECODE:*
+ LD D,0 ;
+ SRA B ; shift bit from B to Carry
+ SBC A,A ; A = 0 - Carry
+ OR $26 ; %00100110
+ LD L,5 ;
+ SUB L ;
+
+mark_07C7:
+*KEY_LINE:*
+ ADD A,L ;
+ SCF ; Set Carry Flag
+ RR C ;
+ JR C,KEY_LINE <#KEY_LINE>
+
+ INC C ;
+ RET NZ ;
+
+ LD C,B ;
+ DEC L ;
+ LD L,1 ;
+ JR NZ,KEY_LINE <#KEY_LINE>
+
+ LD HL,$007D ; (expr reqd)
+ LD E,A ;
+ ADD HL,DE ;
+ SCF ; Set Carry Flag
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'PRINTING'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_07DC:
+*LEAD_SP:*
+ LD A,E ;
+ AND A ;
+ RET M ;
+
+ JR PRINT_CH <#PRINT_CH>
+
+; ___
+; HL is typically -10000, -1000, -100, -10
+; and repeatedly subtracted from BC
+; i.e. it print
+;
+;
+mark_07E1:
+*OUT_DIGIT:*
+ XOR A ; assume the digit is zero to begin with
+
+mark_07E2:
+*DIGIT_INC:*
+ ADD HL,BC ; HL += -ve number
+ INC A ;
+ JR C,DIGIT_INC <#DIGIT_INC> ; loop
+
+ SBC HL,BC ; undo last iteration
+ DEC A ; undo last iteration
+ JR Z,LEAD_SP <#LEAD_SP> ; leading zeros shown as spaces
+
+mark_07EB:
+*OUT_CODE:*
+ LD E,ZX_0 ; $1C
+ ADD A,E ;
+
+mark_07EE:
+*OUT_CH:*
+ AND A ;
+ JR Z,PRINT_SP <#PRINT_SP>
+
+mark_07F1:
+*PRINT_CH:*
+ RES 0,(IY+FLAGS-RAMBASE) ; signal leading space permitted
+
+mark_07F5:
+*PRINT_SP:*
+ EXX ;
+ PUSH HL ;
+ BIT 1,(IY+FLAGS-RAMBASE) ; is printer in use ?
+ JR NZ,LPRINT_A <#LPRINT_A>
+
+ CALL ENTER_CH <#ENTER_CH>
+ JR PRINT_EXX <#PRINT_EXX>
+
+; ___
+
+mark_0802:
+*LPRINT_A:*
+ CALL LPRINT_CH <#LPRINT_CH>
+
+mark_0805:
+*PRINT_EXX:*
+ POP HL ;
+ EXX ;
+ RET ;
+
+; ___
+
+mark_0808:
+*ENTER_CH:*
+ LD D,A ;
+ LD BC,(S_POSN) ;
+ LD A,C ;
+ CP CHARS_HORIZONTAL+1 ;
+ JR Z,TEST_LOW <#TEST_LOW>
+
+mark_0812:
+*TEST_N_L:*
+ LD A,ZX_NEWLINE ;
+ CP D ;
+ JR Z,WRITE_N_L <#WRITE_N_L>
+
+ LD HL,(DF_CC) ;
+ CP (HL) ;
+ LD A,D ;
+ JR NZ,WRITE_CH <#WRITE_CH>
+
+ DEC C ;
+ JR NZ,EXPAND_1 <#EXPAND_1>
+
+ INC HL ;
+ LD (DF_CC),HL ;
+ LD C,CHARS_HORIZONTAL+1 ; $21 = 33 normally
+ DEC B ;
+ LD (S_POSN),BC ;
+
+mark_082C:
+*TEST_LOW:*
+ LD A,B ;
+ CP (IY+DF_SZ-RAMBASE)
+ JR Z,REPORT_5 <#REPORT_5>
+
+ AND A ;
+ JR NZ,TEST_N_L <#TEST_N_L>
+
+mark_0835:
+*REPORT_5:*
+ LD L,4 ; 'No more room on screen'
+ JP ERROR_3 <#ERROR_3>
+
+; ___
+
+mark_083A:
+*EXPAND_1:*
+ CALL ONE_SPACE <#ONE_SPACE>
+ EX DE,HL ;
+
+mark_083E:
+*WRITE_CH:*
+ LD (HL),A ;
+ INC HL ;
+ LD (DF_CC),HL ;
+ DEC (IY+S_POSN_x-RAMBASE)
+ RET ;
+
+; ___
+
+mark_0847:
+*WRITE_N_L:*
+ LD C,CHARS_HORIZONTAL+1 ; $21 = 33
+ DEC B ;
+ SET 0,(IY+FLAGS-RAMBASE) ; Suppress leading space
+ JP LOC_ADDR <#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.
+
+
+mark_0851:
+*LPRINT_CH:*
+ CP ZX_NEWLINE ; compare to NEWLINE.
+ JR Z,COPY_BUFF <#COPY_BUFF> ; forward if so
+
+ LD C,A ; take a copy of the character in C.
+ LD A,(PR_CC) ; 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,COPY_BUFF <#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+PR_CC-RAMBASE),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.
+
+mark_0869:
+*COPY:*
+;
+; check - is this $16==22 or 24?
+;
+;; LD D,$16 ; prepare to copy twenty four text lines.
+ LD D,22 ; prepare to copy twenty four text lines.
+ LD HL,(D_FILE) ; set HL to start of display file from D_FILE.
+ INC HL ;
+ JR COPY_D <#COPY_D> ; forward
+
+; ___
+
+; A single character-mapped printer buffer is copied to the ZX-Printer.
+
+mark_0871:
+*COPY_BUFF:*
+ LD D,1 ; prepare to copy a single text line.
+ LD HL,PRBUFF ; set HL to start of printer buffer PRBUFF.
+
+; both paths converge here.
+
+mark_0876:
+*COPY_D:*
+ CALL SET_FAST <#SET_FAST>
+
+ PUSH BC ; *** preserve BC throughout.
+ ; a pending character may be present
+ ; in C from LPRINT_CH
+
+mark_087A:
+*COPY_LOOP:*
+ 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.
+
+mark_087D:
+*COPY_TIME:*
+ OUT (IO_PORT_PRINTER),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.
+
+mark_0880:
+*COPY_BRK:*
+ CALL BREAK_1 <#BREAK_1>
+ JR C,COPY_CONT <#COPY_CONT> ; forward with no keypress to COPY_CONT
+
+; else A will hold 11111111 0
+
+ RRA ; 0111 1111
+ OUT (IO_PORT_PRINTER),A ; stop ZX printer motor, de-activate stylus.
+
+mark_0888:
+*REPORT_D2:*
+ RST _ERROR_1
+ DEFB $0C ; Error Report: BREAK - CONT repeats
+
+; ___
+
+mark_088A:
+*COPY_CONT:*
+ IN A,(IO_PORT_PRINTER) ; read from printer port.
+ ADD A,A ; test bit 6 and 7
+ JP M,COPY_END <#COPY_END> ; jump forward with no printer to COPY_END
+
+ JR NC,COPY_BRK <#COPY_BRK> ; 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 2 ; 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.
+
+mark_089C:
+*COPY_NEXT:*
+ 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 ZX_NEWLINE ; is character a NEWLINE ?
+ JR Z,COPY_N_L <#COPY_N_L> ; 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,8 ; count eight bits to output.
+
+mark_08B5:
+*COPY_BITS:*
+ 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.
+
+mark_08BA:
+*COPY_WAIT:*
+ IN A,(IO_PORT_PRINTER) ; read the printer port
+ RRA ; test for alignment signal from encoder.
+ JR NC,COPY_WAIT <#COPY_WAIT> ; loop if not present to COPY_WAIT
+
+ LD A,H ; control byte to A.
+ OUT (IO_PORT_PRINTER),A ; and output to printer port.
+ DJNZ COPY_BITS <#COPY_BITS> ; loop for all eight bits to COPY_BITS
+
+ POP HL ; * restore character pointer.
+ JR COPY_NEXT <#COPY_NEXT> ; 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.
+
+mark_08C7:
+*COPY_N_L:*
+ IN A,(IO_PORT_PRINTER) ; read printer port.
+ RRA ; wait for encoder signal.
+ JR NC,COPY_N_L <#COPY_N_L> ; 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 (IO_PORT_PRINTER),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,COPY_TIME <#COPY_TIME> ; back if not
+
+; 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,COPY_LOOP <#COPY_LOOP> ; back if not zero
+
+ LD A,$04 ; stop the already slowed printer motor.
+ OUT (IO_PORT_PRINTER),A ; output to printer port.
+
+mark_08DE:
+*COPY_END:*
+ CALL SLOW_FAST <#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.
+
+mark_08E2:
+*CLEAR_PRB:*
+ LD HL,PRBUFF_END ; address fixed end of PRBUFF
+ LD (HL),ZX_NEWLINE ; place a newline at last position.
+ LD B,32 ; prepare to blank 32 preceding characters.
+;
+; NB the printer is fixed at 32 characters, maybe it can be tweaked ???
+;
+mark_08E9:
+*PRB_BYTES:*
+ DEC HL ; decrement address - could be DEC L.
+ LD (HL),0 ; place a zero byte.
+ DJNZ PRB_BYTES <#PRB_BYTES> ; loop for all thirty-two
+
+ LD A,L ; fetch character print position.
+ SET 7,A ; signal the printer buffer is clear.
+ LD (PR_CC),A ; update one-byte system variable PR_CC
+ RET ; return.
+
+------------------------------------------------------------------------
+
+; THE *'PRINT AT'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+;
+;
+mark_08F5:
+*PRINT_AT:*
+
+ LD A,CHARS_VERTICAL-1 ; originally 23
+ SUB B ;
+ JR C,WRONG_VAL <#WRONG_VAL>
+
+mark_08FA:
+*TEST_VAL:*
+ CP (IY+DF_SZ-RAMBASE)
+ JP C,REPORT_5 <#REPORT_5>
+
+ INC A ;
+ LD B,A ;
+ LD A,CHARS_HORIZONTAL-1 ; originally 31
+
+ SUB C ;
+
+mark_0905:
+*WRONG_VAL:*
+ JP C,REPORT_B <#REPORT_B>
+
+ ADD A,2 ;
+ LD C,A ;
+
+mark_090B:
+*SET_FIELD:*
+ BIT 1,(IY+FLAGS-RAMBASE) ; Is printer in use?
+ JR Z,LOC_ADDR <#LOC_ADDR>
+
+ LD A,$5D ;
+ SUB C ;
+ LD (PR_CC),A ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'LOCATE ADDRESS'* ROUTINE
+------------------------------------------------------------------------
+
+;
+; I'm guessing this locates the address of a character at X,Y
+; on the screen, with 0,0 being on the bottom left?
+; S_POSN_x equ $4039
+; S_POSN_y equ $403A
+; so when BC is stored there, B is Y and C is X
+;
+mark_0918:
+*LOC_ADDR:*
+ LD (S_POSN),BC ;
+ LD HL,(VARS) ;
+ LD D,C ;
+ LD A,CHARS_HORIZONTAL+2 ; $22 == 34 originally.
+ SUB C ;
+ LD C,A ;
+ LD A,ZX_NEWLINE ;
+ INC B ;
+
+mark_0927:
+*LOOK_BACK:*
+ DEC HL ;
+ CP (HL) ;
+ JR NZ,LOOK_BACK <#LOOK_BACK>
+
+ DJNZ LOOK_BACK <#LOOK_BACK>
+
+ INC HL ;
+ CPIR ;
+ DEC HL ;
+ LD (DF_CC),HL ;
+ SCF ; Set Carry Flag
+ RET PO ;
+
+ DEC D ;
+ RET Z ;
+
+ PUSH BC ;
+ CALL MAKE_ROOM <#MAKE_ROOM>
+ POP BC ;
+ LD B,C ;
+ LD H,D ; HL := DE
+ LD L,E ;
+
+mark_0940:
+*EXPAND_2:*
+;
+; Writes B spaces to HL--
+;
+ LD (HL),ZX_SPACE ;
+ DEC HL ;
+ DJNZ EXPAND_2 <#EXPAND_2>
+
+ EX DE,HL ; restore HL
+ INC HL ;
+ LD (DF_CC),HL ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'EXPAND TOKENS'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_094B:
+*TOKENS:*
+ PUSH AF ;
+ CALL TOKEN_ADD <#TOKEN_ADD>
+ JR NC,ALL_CHARS <#ALL_CHARS>
+
+ BIT 0,(IY+FLAGS-RAMBASE) ; Leading space if set
+ JR NZ,ALL_CHARS <#ALL_CHARS>
+
+ XOR A ; A = 0 = ZX_SPACE
+
+ RST _PRINT_A
+
+mark_0959:
+*ALL_CHARS:*
+ LD A,(BC) ;
+ AND $3F ; truncate to printable values ???
+
+ RST _PRINT_A
+ LD A,(BC) ;
+ INC BC ;
+ ADD A,A ;
+ JR NC,ALL_CHARS <#ALL_CHARS>
+
+ POP BC ;
+ BIT 7,B ;
+ RET Z ;
+
+ CP ZX_COMMA ; $1A == 26
+ JR Z,TRAIL_SP <#TRAIL_SP>
+
+ CP ZX_S ; $38 == 56
+ RET C ;
+
+mark_096D:
+*TRAIL_SP:*
+ XOR A ;
+ SET 0,(IY+FLAGS-RAMBASE) ; Suppress leading space
+ JP PRINT_SP <#PRINT_SP>
+
+; ___
+
+mark_0975:
+*TOKEN_ADD:*
+ PUSH HL ;
+ LD HL,TOKEN_TABLE <#TOKEN_TABLE>
+ BIT 7,A ;
+ JR Z,TEST_HIGH <#TEST_HIGH>
+
+ AND $3F ;
+
+mark_097F:
+*TEST_HIGH:*
+ CP $43 ;
+ JR NC,FOUND <#FOUND>
+
+ LD B,A ;
+ INC B ;
+
+mark_0985:
+*WORDS:*
+ BIT 7,(HL) ;
+ INC HL ;
+ JR Z,WORDS <#WORDS>
+
+ DJNZ WORDS <#WORDS>
+
+ BIT 6,A ;
+ JR NZ,COMP_FLAG <#COMP_FLAG>
+
+ CP $18 ;
+
+mark_0992:
+*COMP_FLAG:*
+ CCF ; Complement Carry Flag
+
+mark_0993:
+*FOUND:*
+ LD B,H ;
+ LD C,L ;
+ POP HL ;
+ RET NC ;
+
+ LD A,(BC) ;
+ ADD A,$E4 ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'ONE_SPACE'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_099B:
+*ONE_SPACE:*
+ LD BC,$0001 ;
+
+------------------------------------------------------------------------
+
+; THE *'MAKE ROOM'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_099E:
+*MAKE_ROOM:*
+ PUSH HL ;
+ CALL TEST_ROOM <#TEST_ROOM>
+ POP HL ;
+ CALL POINTERS <#POINTERS>
+ LD HL,(STKEND) ;
+ EX DE,HL ;
+ LDDR ; Copy Bytes
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'POINTERS'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_09AD:
+*POINTERS:*
+ PUSH AF ;
+ PUSH HL ;
+ LD HL,D_FILE ;
+ LD A,$09 ;
+
+mark_09B4:
+*NEXT_PTR:*
+ LD E,(HL) ;
+ INC HL ;
+ LD D,(HL) ;
+ EX (SP),HL ;
+ AND A ;
+ SBC HL,DE ;
+ ADD HL,DE ;
+ EX (SP),HL ;
+ JR NC,PTR_DONE <#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 ;
+
+mark_09C8:
+*PTR_DONE:*
+ INC HL ;
+ DEC A ;
+ JR NZ,NEXT_PTR <#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
+------------------------------------------------------------------------
+
+
+mark_09D8:
+*LINE_ADDR:*
+ PUSH HL ;
+ LD HL,USER_RAM ;
+ LD D,H ;
+ LD E,L ;
+
+mark_09DE:
+*NEXT_TEST:*
+ POP BC ;
+ CALL CP_LINES <#CP_LINES>
+ RET NC ;
+
+ PUSH BC ;
+ CALL NEXT_ONE <#NEXT_ONE>
+ EX DE,HL ;
+ JR NEXT_TEST <#NEXT_TEST>
+
+------------------------------------------------------------------------
+
+; THE *'COMPARE LINE NUMBERS'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_09EA:
+*CP_LINES:*
+ LD A,(HL) ;
+ CP B ;
+ RET NZ ;
+
+ INC HL ;
+ LD A,(HL) ;
+ DEC HL ;
+ CP C ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'NEXT LINE OR VARIABLE'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_09F2:
+*NEXT_ONE:*
+ PUSH HL ;
+ LD A,(HL) ;
+ CP $40 ;
+ JR C,LINES <#LINES>
+
+ BIT 5,A ;
+ JR Z,NEXT_0_4 <#NEXT_0_4> ; skip forward
+
+ ADD A,A ;
+ JP M,NEXT_PLUS_FIVE <#NEXT_PLUS_FIVE>
+
+ CCF ; Complement Carry Flag
+
+mark_0A01:
+*NEXT_PLUS_FIVE:*
+ LD BC,$0005 ;
+ JR NC,NEXT_LETT <#NEXT_LETT>
+
+ LD C,$11 ; 17
+
+mark_0A08:
+*NEXT_LETT:*
+ RLA ;
+ INC HL ;
+ LD A,(HL) ;
+ JR NC,NEXT_LETT <#NEXT_LETT> ; loop
+
+ JR NEXT_ADD <#NEXT_ADD>
+; ___
+
+mark_0A0F:
+*LINES:*
+ INC HL ;
+
+mark_0A10:
+*NEXT_0_4:*
+ INC HL ; BC = word at HL++
+ LD C,(HL) ;
+ INC HL ;
+ LD B,(HL) ;
+ INC HL ;
+
+mark_0A15:
+*NEXT_ADD:*
+ ADD HL,BC ;
+ POP DE ;
+
+------------------------------------------------------------------------
+
+; THE *'DIFFERENCE'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_0A17:
+*DIFFER:*
+ AND A ;
+ SBC HL,DE ;
+ LD B,H ; BC := (HL-DE)
+ LD C,L ;
+ ADD HL,DE ;
+ EX DE,HL ; DE := old HL ???
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'LINE_ENDS'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_0A1F:
+*LINE_ENDS:*
+ LD B,(IY+DF_SZ-RAMBASE)
+ PUSH BC ;
+ CALL B_LINES <#B_LINES>
+ POP BC ;
+ DEC B ;
+ JR B_LINES <#B_LINES>
+
+------------------------------------------------------------------------
+
+; THE *'CLS'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0A2A:
+*CLS:*
+ LD B,CHARS_VERTICAL ; number of lines to clear. $18 = 24 originally.
+
+mark_0A2C:
+*B_LINES:*
+ RES 1,(IY+FLAGS-RAMBASE) ; Signal printer not in use
+ LD C,CHARS_HORIZONTAL+1 ; $21 ; extra 1 is for HALT opcode ?
+ PUSH BC ;
+ CALL LOC_ADDR <#LOC_ADDR>
+ POP BC ;
+ LD A,(RAMTOP+1) ; is RAMTOP_hi
+ CP $4D ;
+ JR C,COLLAPSED <#COLLAPSED>
+;
+; If RAMTOP less then 4D00, RAM less than D00 = 3.25 K,
+; uses collapsed display.
+;
+
+ SET 7,(IY+S_POSN_y-RAMBASE)
+
+mark_0A42:
+*CLEAR_LOC:*
+ XOR A ; prepare a space
+ CALL PRINT_SP <#PRINT_SP> ; prints a space
+ LD HL,(S_POSN) ;
+ LD A,L ;
+ OR H ;
+ AND $7E ;
+ JR NZ,CLEAR_LOC <#CLEAR_LOC>
+
+ JP LOC_ADDR <#LOC_ADDR>
+
+; ___
+
+mark_0A52:
+*COLLAPSED:*
+ LD D,H ; DE := HL
+ LD E,L ;
+ DEC HL ;
+ LD C,B ;
+ LD B,0 ; Will loop 256 times
+ LDIR ; Copy Bytes
+ LD HL,(VARS) ;
+
+------------------------------------------------------------------------
+
+; THE *'RECLAIMING'* SUBROUTINES
+------------------------------------------------------------------------
+
+
+mark_0A5D:
+*RECLAIM_1:*
+ CALL DIFFER <#DIFFER>
+
+mark_0A60:
+*RECLAIM_2:*
+ PUSH BC ;
+ LD A,B ;
+ CPL ;
+ LD B,A ;
+ LD A,C ;
+ CPL ;
+ LD C,A ;
+ INC BC ;
+ CALL POINTERS <#POINTERS>
+ EX DE,HL ;
+ POP HL ;
+ ADD HL,DE ;
+ PUSH DE ;
+ LDIR ; Copy Bytes
+ POP HL ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'E_LINE NUMBER'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_0A73:
+*E_LINE_NUM:*
+ LD HL,(E_LINE) ;
+ CALL TEMP_PTR2 <#TEMP_PTR2>
+
+ RST _GET_CHAR
+ BIT 5,(IY+FLAGX-RAMBASE)
+ RET NZ ;
+
+ LD HL,MEM_0_1st ;
+ LD (STKEND),HL ;
+ CALL INT_TO_FP <#INT_TO_FP>
+ CALL FP_TO_BC <#FP_TO_BC>
+ JR C,NO_NUMBER <#NO_NUMBER> ; to NO_NUMBER
+
+ LD HL,-10000 ; $D8F0 ; value '-10000'
+ ADD HL,BC ;
+
+mark_0A91:
+*NO_NUMBER:*
+ JP C,REPORT_C <#REPORT_C> ; to REPORT_C
+
+ CP A ;
+ JP SET_MIN <#SET_MIN>
+
+------------------------------------------------------------------------
+
+; THE *'REPORT AND LINE NUMBER'* PRINTING SUBROUTINES
+------------------------------------------------------------------------
+
+
+mark_0A98:
+*OUT_NUM:*
+ PUSH DE ;
+ PUSH HL ;
+ XOR A ;
+ BIT 7,B ;
+ JR NZ,UNITS <#UNITS>
+
+ LD H,B ; HL := BC
+ LD L,C ;
+ LD E,$FF ;
+ JR THOUSAND <#THOUSAND>
+; ___
+
+mark_0AA5:
+*OUT_NO:*
+ PUSH DE ;
+ LD D,(HL) ;
+ INC HL ;
+ LD E,(HL) ;
+ PUSH HL ;
+ EX DE,HL ;
+ LD E,ZX_SPACE ; set E to leading space.
+
+mark_0AAD:
+*THOUSAND:*
+ LD BC,-1000 ; $FC18 ;
+ CALL OUT_DIGIT <#OUT_DIGIT>
+ LD BC,-100 ; $FF9C ;
+ CALL OUT_DIGIT <#OUT_DIGIT>
+ LD C,-10 ; $F6 ; B is already FF, so saves a byte.
+ CALL OUT_DIGIT <#OUT_DIGIT>
+ LD A,L ;
+
+mark_0ABF:
+*UNITS:*
+ CALL OUT_CODE <#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 ZX80 this routine was not fully utilized.
+
+mark_0AC5:
+*UNSTACK_Z:*
+ CALL SYNTAX_Z <#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
+------------------------------------------------------------------------
+
+;
+;
+
+mark_0ACB:
+*LPRINT:*
+ SET 1,(IY+FLAGS-RAMBASE) ; Signal printer in use
+
+------------------------------------------------------------------------
+
+; THE *'PRINT'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0ACF:
+*PRINT:*
+ LD A,(HL) ;
+ CP ZX_NEWLINE ;
+ JP Z,PRINT_END <#PRINT_END> ; to PRINT_END
+
+mark_0AD5:
+*PRINT_1:*
+ SUB ZX_COMMA ; $1A == 26
+ ADC A,$00 ;
+ JR Z,SPACING <#SPACING> ; to SPACING
+ ;
+ ; Compare with AT,
+ ; less comma recently subtracted.
+ ;
+ CP ZX_AT-ZX_COMMA ; $A7 == 167
+ JR NZ,NOT_AT <#NOT_AT> ;
+
+
+ RST _NEXT_CHAR
+ CALL CLASS_6 <#CLASS_6>
+ CP ZX_COMMA ; $1A = 26
+ JP NZ,REPORT_C <#REPORT_C> ;
+
+ RST _NEXT_CHAR
+ CALL CLASS_6 <#CLASS_6>
+ CALL SYNTAX_ON <#SYNTAX_ON>
+
+ RST _FP_CALC ;;
+ DEFB __exchange ;;
+ DEFB __end_calc ;;
+
+ CALL STK_TO_BC <#STK_TO_BC>
+ CALL PRINT_AT <#PRINT_AT>
+ JR PRINT_ON <#PRINT_ON>
+; ___
+
+mark_0AFA:
+*NOT_AT:*
+ CP ZX_TAB-ZX_COMMA ; $A8 == 168
+ JR NZ,NOT_TAB <#NOT_TAB>
+
+
+ RST _NEXT_CHAR
+ CALL CLASS_6 <#CLASS_6>
+ CALL SYNTAX_ON <#SYNTAX_ON>
+ CALL STK_TO_A <#STK_TO_A>
+ JP NZ,REPORT_B <#REPORT_B>
+
+ AND $1F ; truncate to 0 to 31 characters ???
+ LD C,A ;
+ BIT 1,(IY+FLAGS-RAMBASE) ; Is printer in use
+ JR Z,TAB_TEST <#TAB_TEST>
+
+ SUB (IY+PR_CC-RAMBASE)
+ SET 7,A ;
+ ADD A,$3C ; 60
+ CALL NC,COPY_BUFF <#COPY_BUFF>
+
+mark_0B1E:
+*TAB_TEST:*
+ ADD A,(IY+S_POSN_x-RAMBASE) ; screen position X
+ CP CHARS_HORIZONTAL+1 ; 33 (characters horizontal plus newline ???)
+ LD A,(S_POSN_y) ; screen position Y
+ SBC A,1 ;
+ CALL TEST_VAL <#TEST_VAL>
+ SET 0,(IY+FLAGS-RAMBASE) ; sv FLAGS - Suppress leading space
+ JR PRINT_ON <#PRINT_ON>
+; ___
+
+mark_0B31:
+*NOT_TAB:*
+ CALL SCANNING <#SCANNING>
+ CALL PRINT_STK <#PRINT_STK>
+
+mark_0B37:
+*PRINT_ON:*
+ RST _GET_CHAR
+ SUB ZX_COMMA ; $1A
+ ADC A,0 ;
+ JR Z,SPACING <#SPACING>
+
+ CALL CHECK_END <#CHECK_END>
+ JP PRINT_END <#PRINT_END>
+; ___
+mark_0B44:
+*SPACING:*
+ CALL NC,FIELD <#FIELD>
+
+ RST _NEXT_CHAR
+ CP ZX_NEWLINE ;
+ RET Z ;
+
+ JP PRINT_1 <#PRINT_1>
+; ___
+mark_0B4E:
+*SYNTAX_ON:*
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ RET NZ ;
+
+ POP HL ;
+ JR PRINT_ON <#PRINT_ON>
+; ___
+mark_0B55:
+*PRINT_STK:*
+ CALL UNSTACK_Z <#UNSTACK_Z>
+ BIT 6,(IY+FLAGS-RAMBASE) ; Numeric or string result?
+ CALL Z,STK_FETCH <#STK_FETCH>
+ JR Z,PR_STR_4 <#PR_STR_4>
+
+ JP PRINT_FP <#PRINT_FP> ; jump forward
+; ___
+
+mark_0B64:
+*PR_STR_1:*
+ LD A,ZX_QUOTE ; $0B
+
+mark_0B66:
+*PR_STR_2:*
+ RST _PRINT_A
+
+mark_0B67:
+*PR_STR_3:*
+ LD DE,(X_PTR) ;
+
+mark_0B6B:
+*PR_STR_4:*
+ LD A,B ;
+ OR C ;
+ DEC BC ;
+ RET Z ;
+
+ LD A,(DE) ;
+ INC DE ;
+ LD (X_PTR),DE ;
+ BIT 6,A ;
+ JR Z,PR_STR_2 <#PR_STR_2>
+
+ CP $C0 ;
+ JR Z,PR_STR_1 <#PR_STR_1>
+
+ PUSH BC ;
+ CALL TOKENS <#TOKENS>
+ POP BC ;
+ JR PR_STR_3 <#PR_STR_3>
+
+; ___
+
+mark_0B84:
+*PRINT_END:*
+ CALL UNSTACK_Z <#UNSTACK_Z>
+ LD A,ZX_NEWLINE ;
+
+ RST _PRINT_A
+ RET ;
+
+; ___
+
+mark_0B8B:
+*FIELD:*
+ CALL UNSTACK_Z <#UNSTACK_Z>
+ SET 0,(IY+FLAGS-RAMBASE) ; Suppress leading space
+ XOR A ;
+
+ RST _PRINT_A
+ LD BC,(S_POSN) ;
+ LD A,C ;
+ BIT 1,(IY+FLAGS-RAMBASE) ; Is printer in use
+ JR Z,CENTRE <#CENTRE>
+
+ LD A,$5D ;
+ SUB (IY+PR_CC-RAMBASE)
+
+mark_0BA4:
+*CENTRE:*
+ LD C,$11 ;
+ CP C ;
+ JR NC,RIGHT <#RIGHT>
+
+ LD C,$01 ;
+
+mark_0BAB:
+*RIGHT:*
+ CALL SET_FIELD <#SET_FIELD>
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'PLOT AND UNPLOT'* COMMAND ROUTINES
+------------------------------------------------------------------------
+
+
+mark_0BAF:
+*PLOT_UNPLOT:*
+;
+; Of the 24 lines, only top 22 ar used for plotting.
+;
+ CALL STK_TO_BC <#STK_TO_BC>
+ LD (COORDS_x),BC ;
+;; LD A,$2B ; originally $2B == 32+11 = 43 = 2*22-1
+ LD A,2*(CHARS_VERTICAL-2)-1 ;
+ SUB B ;
+ JP C,REPORT_B <#REPORT_B>
+
+ LD B,A ;
+ LD A,$01 ;
+ SRA B ;
+ JR NC,COLUMNS <#COLUMNS>
+
+ LD A,$04 ;
+
+mark_0BC5:
+*COLUMNS:*
+ SRA C ;
+ JR NC,FIND_ADDR <#FIND_ADDR>
+
+ RLCA ;
+
+mark_0BCA:
+*FIND_ADDR:*
+ PUSH AF ;
+ CALL PRINT_AT <#PRINT_AT>
+ LD A,(HL) ;
+ RLCA ;
+ CP ZX_BRACKET_LEFT ; $10
+ JR NC,TABLE_PTR <#TABLE_PTR>
+
+ RRCA ;
+ JR NC,SQ_SAVED <#SQ_SAVED>
+
+ XOR $8F ;
+
+mark_0BD9:
+*SQ_SAVED:*
+ LD B,A ;
+
+mark_0BDA:
+*TABLE_PTR:*
+ LD DE,P_UNPLOT <#P_UNPLOT> ; Address: P_UNPLOT
+ LD A,(T_ADDR) ; get T_ADDR_lo
+ SUB E ;
+ JP M,PLOT <#PLOT>
+
+ POP AF ;
+ CPL ;
+ AND B ;
+ JR UNPLOT <#UNPLOT>
+
+; ___
+
+mark_0BE9:
+*PLOT:*
+ POP AF ;
+ OR B ;
+
+mark_0BEB:
+*UNPLOT:*
+ CP 8 ; Only apply to graphic characters (0 to 7)
+ JR C,PLOT_END <#PLOT_END>
+
+ XOR $8F ; binary 1000 1111
+
+mark_0BF1:
+*PLOT_END:*
+ EXX ;
+
+ RST _PRINT_A
+ EXX ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'STACK_TO_BC'* SUBROUTINE
+------------------------------------------------------------------------
+
+mark_0BF5:
+*STK_TO_BC:*
+ CALL STK_TO_A <#STK_TO_A>
+ LD B,A ;
+ PUSH BC ;
+ CALL STK_TO_A <#STK_TO_A>
+ LD E,C ;
+ POP BC ;
+ LD D,C ;
+ LD C,A ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'STACK_TO_A'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_0C02:
+*STK_TO_A:*
+ CALL FP_TO_A <#FP_TO_A>
+ JP C,REPORT_B <#REPORT_B>
+
+ LD C,$01 ;
+ RET Z ;
+
+ LD C,$FF ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'SCROLL'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_0C0E:
+*SCROLL:*
+ LD B,(IY+DF_SZ-RAMBASE)
+ LD C,CHARS_HORIZONTAL+1 ;
+ CALL LOC_ADDR <#LOC_ADDR>
+ CALL ONE_SPACE <#ONE_SPACE>
+ LD A,(HL) ;
+ LD (DE),A ;
+ INC (IY+S_POSN_y-RAMBASE)
+ LD HL,(D_FILE) ;
+ INC HL ;
+ LD D,H ;
+ LD E,L ;
+ CPIR ;
+ JP RECLAIM_1 <#RECLAIM_1>
+
+------------------------------------------------------------------------
+
+; THE *'SYNTAX'* TABLES
+------------------------------------------------------------------------
+
+
+; i) The Offset table
+
+mark_0C29:
+*offset_t:*
+ DEFB P_LPRINT <#P_LPRINT> - $ ; 8B offset
+ DEFB P_LLIST <#P_LLIST> - $ ; 8D offset
+ DEFB P_STOP <#P_STOP> - $ ; 2D offset
+ DEFB P_SLOW <#P_SLOW> - $ ; 7F offset
+ DEFB P_FAST <#P_FAST> - $ ; 81 offset
+ DEFB P_NEW <#P_NEW> - $ ; 49 offset
+ DEFB P_SCROLL <#P_SCROLL> - $ ; 75 offset
+ DEFB P_CONT <#P_CONT> - $ ; 5F offset
+ DEFB P_DIM <#P_DIM> - $ ; 40 offset
+ DEFB P_REM <#P_REM> - $ ; 42 offset
+ DEFB P_FOR <#P_FOR> - $ ; 2B offset
+ DEFB P_GOTO <#P_GOTO> - $ ; 17 offset
+ DEFB P_GOSUB <#P_GOSUB> - $ ; 1F offset
+ DEFB P_INPUT <#P_INPUT> - $ ; 37 offset
+ DEFB P_LOAD <#P_LOAD> - $ ; 52 offset
+ DEFB P_LIST <#P_LIST> - $ ; 45 offset
+ DEFB P_LET <#P_LET> - $ ; 0F offset
+ DEFB P_PAUSE <#P_PAUSE> - $ ; 6D offset
+ DEFB P_NEXT <#P_NEXT> - $ ; 2B offset
+ DEFB P_POKE <#P_POKE> - $ ; 44 offset
+ DEFB P_PRINT <#P_PRINT> - $ ; 2D offset
+ DEFB P_PLOT <#P_PLOT> - $ ; 5A offset
+ DEFB P_RUN <#P_RUN> - $ ; 3B offset
+ DEFB P_SAVE <#P_SAVE> - $ ; 4C offset
+ DEFB P_RAND <#P_RAND> - $ ; 45 offset
+ DEFB P_IF <#P_IF> - $ ; 0D offset
+ DEFB P_CLS <#P_CLS> - $ ; 52 offset
+ DEFB P_UNPLOT <#P_UNPLOT> - $ ; 5A offset
+ DEFB P_CLEAR <#P_CLEAR> - $ ; 4D offset
+ DEFB P_RETURN <#P_RETURN> - $ ; 15 offset
+ DEFB P_COPY <#P_COPY> - $ ; 6A offset
+------------------------------------------------------------------------
+
+; ii) The parameter table.
+
+mark_0C48:
+*P_LET:*
+ DEFB _CLASS_01 ; A variable is required.
+ DEFB ZX_EQUAL ; Separator: '='
+ DEFB _CLASS_02 ; An expression, numeric or string,
+ ; must follow.
+
+mark_0C4B:
+*P_GOTO:*
+ DEFB _CLASS_06 ; A numeric expression must follow.
+ DEFB _CLASS_00 ; No further operands.
+ DEFW GOTO <#GOTO>
+
+mark_0C4F:
+*P_IF:*
+ DEFB _CLASS_06 ; A numeric expression must follow.
+ DEFB ZX_THEN ; Separator: 'THEN'
+ DEFB _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+ DEFW IF <#IF>
+
+mark_0C54:
+*P_GOSUB:*
+ DEFB _CLASS_06 ; A numeric expression must follow.
+ DEFB _CLASS_00 ; No further operands.
+ DEFW GOSUB <#GOSUB>
+
+mark_0C58:
+*P_STOP:*
+ DEFB _CLASS_00 ; No further operands.
+ DEFW STOP <#STOP>
+
+mark_0C5B:
+*P_RETURN:*
+ DEFB _CLASS_00 ; No further operands.
+ DEFW RETURN <#RETURN>
+
+mark_0C5E:
+*P_FOR:*
+ DEFB _CLASS_04 ; A single character variable must
+ ; follow.
+ DEFB ZX_EQUAL ; Separator: '='
+ DEFB _CLASS_06 ; A numeric expression must follow.
+ DEFB ZX_TO ; Separator: 'TO'
+ DEFB _CLASS_06 ; A numeric expression must follow.
+ DEFB _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+ DEFW FOR <#FOR>
+
+mark_0C66:
+*P_NEXT:*
+ DEFB _CLASS_04 ; A single character variable must
+ ; follow.
+ DEFB _CLASS_00 ; No further operands.
+ DEFW NEXT <#NEXT>
+
+mark_0C6A:
+*P_PRINT:*
+ DEFB _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+ DEFW PRINT <#PRINT> ; not LPRINT ???
+
+mark_0C6D:
+*P_INPUT:*
+ DEFB _CLASS_01 ; A variable is required.
+ DEFB _CLASS_00 ; No further operands.
+ DEFW INPUT <#INPUT>
+
+mark_0C71:
+*P_DIM:*
+ DEFB _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+ DEFW DIM <#DIM>
+
+mark_0C74:
+*P_REM:*
+ DEFB _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+ DEFW REM <#REM>
+
+mark_0C77:
+*P_NEW:*
+ DEFB _CLASS_00 ; No further operands.
+ DEFW NEW <#NEW>
+
+mark_0C7A:
+*P_RUN:*
+ DEFB _CLASS_03 ; A numeric expression may follow
+ ; else default to zero.
+ DEFW RUN <#RUN>
+
+mark_0C7D:
+*P_LIST:*
+ DEFB _CLASS_03 ; A numeric expression may follow
+ ; else default to zero.
+ DEFW LIST <#LIST>
+
+mark_0C80:
+*P_POKE:*
+ DEFB _CLASS_06 ; A numeric expression must follow.
+ DEFB ZX_COMMA ; Separator: ','
+ DEFB _CLASS_06 ; A numeric expression must follow.
+ DEFB _CLASS_00 ; No further operands.
+ DEFW POKE <#POKE>
+
+mark_0C86:
+*P_RAND:*
+ DEFB _CLASS_03 ; A numeric expression may follow
+ ; else default to zero.
+ DEFW RAND <#RAND>
+
+mark_0C89:
+*P_LOAD:*
+ DEFB _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+ DEFW LOAD <#LOAD>
+
+mark_0C8C:
+*P_SAVE:*
+ DEFB _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+ DEFW SAVE <#SAVE>
+
+mark_0C8F:
+*P_CONT:*
+ DEFB _CLASS_00 ; No further operands.
+ DEFW CONT <#CONT>
+
+mark_0C92:
+*P_CLEAR:*
+ DEFB _CLASS_00 ; No further operands.
+ DEFW CLEAR <#CLEAR>
+
+mark_0C95:
+*P_CLS:*
+ DEFB _CLASS_00 ; No further operands.
+ DEFW CLS <#CLS>
+
+mark_0C98:
+*P_PLOT:*
+ DEFB _CLASS_06 ; A numeric expression must follow.
+ DEFB ZX_COMMA ; Separator: ','
+ DEFB _CLASS_06 ; A numeric expression must follow.
+ DEFB _CLASS_00 ; No further operands.
+ DEFW PLOT_UNPLOT <#PLOT_UNPLOT>
+
+mark_0C9E:
+*P_UNPLOT:*
+ DEFB _CLASS_06 ; A numeric expression must follow.
+ DEFB ZX_COMMA ; Separator: ','
+ DEFB _CLASS_06 ; A numeric expression must follow.
+ DEFB _CLASS_00 ; No further operands.
+ DEFW PLOT_UNPLOT <#PLOT_UNPLOT>
+
+mark_0CA4:
+*P_SCROLL:*
+ DEFB _CLASS_00 ; No further operands.
+ DEFW SCROLL <#SCROLL>
+
+mark_0CA7:
+*P_PAUSE:*
+ DEFB _CLASS_06 ; A numeric expression must follow.
+ DEFB _CLASS_00 ; No further operands.
+ DEFW PAUSE <#PAUSE>
+
+mark_0CAB:
+*P_SLOW:*
+ DEFB _CLASS_00 ; No further operands.
+ DEFW SLOW <#SLOW>
+
+mark_0CAE:
+*P_FAST:*
+ DEFB _CLASS_00 ; No further operands.
+ DEFW FAST <#FAST>
+
+mark_0CB1:
+*P_COPY:*
+ DEFB _CLASS_00 ; No further operands.
+ DEFW COPY <#COPY>
+
+mark_0CB4:
+*P_LPRINT:*
+ DEFB _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+ DEFW LPRINT <#LPRINT>
+
+mark_0CB7:
+*P_LLIST:*
+ DEFB _CLASS_03 ; A numeric expression may follow
+ ; else default to zero.
+ DEFW LLIST <#LLIST>
+
+
+------------------------------------------------------------------------
+
+; THE *'LINE SCANNING'* ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0CBA:
+*LINE_SCAN:*
+ LD (IY+FLAGS-RAMBASE),1
+ CALL E_LINE_NUM <#E_LINE_NUM>
+
+mark_0CC1:
+*LINE_RUN:*
+ CALL SET_MIN <#SET_MIN>
+ LD HL,ERR_NR ;
+ LD (HL),$FF ;
+ LD HL,FLAGX ;
+ BIT 5,(HL) ;
+ JR Z,LINE_NULL <#LINE_NULL>
+
+ CP $E3 ; 'STOP' ?
+ LD A,(HL) ;
+ JP NZ,INPUT_REP <#INPUT_REP>
+
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ RET Z ;
+
+
+ RST _ERROR_1
+ DEFB $0C ; Error Report: BREAK - CONT repeats
+
+
+------------------------------------------------------------------------
+
+; THE *'STOP'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_0CDC:
+*STOP:*
+ RST _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).
+
+mark_0CDE:
+*LINE_NULL:*
+ RST _GET_CHAR
+ LD B,$00 ; prepare to index - early.
+ CP ZX_NEWLINE ; compare to NEWLINE.
+ RET Z ; return if so.
+
+
+
+
+
+ LD C,A ; transfer character to C.
+
+ RST _NEXT_CHAR ; advances.
+ LD A,C ; character to A
+ SUB $E1 ; subtract 'LPRINT' - lowest command.
+ JR C,REPORT_C2 <#REPORT_C2> ; forward if less
+
+ LD C,A ; reduced token to C
+ LD HL,offset_t <#offset_t> ; 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 GET_PARAM <#GET_PARAM>
+; ___
+
+mark_0CF4:
+*SCAN_LOOP:*
+ LD HL,(T_ADDR) ;
+
+; -> Entry Point to Scanning Loop
+
+mark_0CF7:
+*GET_PARAM:*
+ LD A,(HL) ;
+ INC HL ;
+ LD (T_ADDR),HL ;
+
+ LD BC,SCAN_LOOP <#SCAN_LOOP>
+ PUSH BC ; is pushed on machine stack.
+
+ LD C,A ;
+ CP ZX_QUOTE ; $0B
+ JR NC,SEPARATOR <#SEPARATOR>
+
+ LD HL,class_tbl <#class_tbl> ; class_tbl - the address of the class table.
+ LD B,$00 ;
+ ADD HL,BC ;
+ LD C,(HL) ;
+ ADD HL,BC ;
+ PUSH HL ;
+
+ RST _GET_CHAR
+ RET ; indirect jump to class routine and
+ ; by subsequent RET to SCAN_LOOP.
+
+------------------------------------------------------------------------
+
+; THE *'SEPARATOR'* ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0D10:
+*SEPARATOR:*
+ RST _GET_CHAR
+ CP C ;
+ JR NZ,REPORT_C2 <#REPORT_C2>
+ ; 'Nonsense in BASIC'
+
+ RST _NEXT_CHAR
+ RET ; return
+
+
+------------------------------------------------------------------------
+
+; THE *'COMMAND CLASS'* TABLE
+------------------------------------------------------------------------
+
+;
+mark_0D16:
+*class_tbl:*
+ DEFB CLASS_0 <#CLASS_0> - $ ; 17 offset to; Address: CLASS_0
+ DEFB CLASS_1 <#CLASS_1> - $ ; 25 offset to; Address: CLASS_1
+ DEFB CLASS_2 <#CLASS_2> - $ ; 53 offset to; Address: CLASS_2
+ DEFB CLASS_3 <#CLASS_3> - $ ; 0F offset to; Address: CLASS_3
+ DEFB CLASS_4 <#CLASS_4> - $ ; 6B offset to; Address: CLASS_4
+ DEFB CLASS_5 <#CLASS_5> - $ ; 13 offset to; Address: CLASS_5
+ DEFB CLASS_6 <#CLASS_6> - $ ; 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.
+;
+mark_0D1D:
+*CHECK_END:*
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ RET NZ ; return in runtime.
+
+ POP BC ; else drop return address.
+
+mark_0D22:
+*CHECK_2:*
+ LD A,(HL) ; fetch character.
+ CP ZX_NEWLINE ; compare to NEWLINE.
+ RET Z ; return if so.
+
+mark_0D26:
+*REPORT_C2:*
+ JR REPORT_C <#REPORT_C>
+ ; 'Nonsense in BASIC'
+
+------------------------------------------------------------------------
+
+; COMMAND CLASSES 03, 00, 05
+------------------------------------------------------------------------
+
+
+mark_0D28:
+*CLASS_3:*
+ CP ZX_NEWLINE ;
+ CALL NUMBER_TO_STK <#NUMBER_TO_STK>
+
+mark_0D2D:
+*CLASS_0:*
+ CP A ;
+
+mark_0D2E:
+*CLASS_5:*
+ POP BC ;
+ CALL Z,CHECK_END <#CHECK_END>
+ EX DE,HL ;
+ LD HL,(T_ADDR) ;
+ LD C,(HL) ;
+ INC HL ;
+ LD B,(HL) ;
+ EX DE,HL ;
+
+mark_0D3A:
+*CLASS_END:*
+ PUSH BC ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; COMMAND CLASSES 01, 02, 04, 06
+------------------------------------------------------------------------
+
+
+mark_0D3C:
+*CLASS_1:*
+ CALL LOOK_VARS <#LOOK_VARS>
+
+mark_0D3F:
+*CLASS_4_2:*
+ LD (IY+FLAGX-RAMBASE),$00
+ JR NC,SET_STK <#SET_STK>
+
+ SET 1,(IY+FLAGX-RAMBASE)
+ JR NZ,SET_STRLN <#SET_STRLN>
+
+
+mark_0D4B:
+*REPORT_2:*
+ RST _ERROR_1
+ DEFB $01 ; Error Report: Variable not found
+; ___
+
+mark_0D4D:
+*SET_STK:*
+ CALL Z,STK_VAR <#STK_VAR>
+ BIT 6,(IY+FLAGS-RAMBASE) ; Numeric or string result?
+ JR NZ,SET_STRLN <#SET_STRLN>
+
+ XOR A ;
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ CALL NZ,STK_FETCH <#STK_FETCH>
+ LD HL,FLAGX ;
+ OR (HL) ;
+ LD (HL),A ;
+ EX DE,HL ;
+
+mark_0D63:
+*SET_STRLN:*
+ LD (STRLEN),BC ;
+ LD (DEST),HL ;
+
+; THE *'REM'* COMMAND ROUTINE
+
+mark_0D6A:
+*REM:*
+ RET ;
+
+; ___
+
+mark_0D6B:
+*CLASS_2:*
+ POP BC ;
+ LD A,(FLAGS) ; sv
+
+mark_0D6F:
+*INPUT_REP:*
+ PUSH AF ;
+ CALL SCANNING <#SCANNING>
+ POP AF ;
+ LD BC,LET <#LET> ; Address: LET
+ LD D,(IY+FLAGS-RAMBASE)
+ XOR D ;
+ AND $40 ;
+ JR NZ,REPORT_C <#REPORT_C> ; to REPORT_C
+
+ BIT 7,D ;
+ JR NZ,CLASS_END <#CLASS_END> ; to CLASS_END
+
+ JR CHECK_2 <#CHECK_2> ; to CHECK_2
+; ___
+
+mark_0D85:
+*CLASS_4:*
+ CALL LOOK_VARS <#LOOK_VARS>
+ PUSH AF ;
+ LD A,C ;
+ OR $9F ;
+ INC A ;
+ JR NZ,REPORT_C <#REPORT_C> ; to REPORT_C
+
+ POP AF ;
+ JR CLASS_4_2 <#CLASS_4_2> ; to CLASS_4_2
+
+; ___
+
+mark_0D92:
+*CLASS_6:*
+ CALL SCANNING <#SCANNING>
+ BIT 6,(IY+FLAGS-RAMBASE) ; Numeric or string result?
+ RET NZ ;
+
+
+mark_0D9A:
+*REPORT_C:*
+ RST _ERROR_1
+ DEFB $0B ; Error Report: Nonsense in BASIC
+
+------------------------------------------------------------------------
+
+; THE *'NUMBER TO STACK'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_0D9C:
+*NUMBER_TO_STK:*
+ JR NZ,CLASS_6 <#CLASS_6> ; back to CLASS_6 with a non-zero number.
+
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ RET Z ; return if checking syntax.
+
+; in runtime a zero default is placed on the calculator stack.
+
+ RST _FP_CALC ;;
+ DEFB __stk_zero ;;
+ DEFB __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.
+
+mark_0DA6:
+*SYNTAX_Z:*
+ BIT 7,(IY+FLAGS-RAMBASE) ; 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.
+
+mark_0DAB:
+*IF:*
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ JR Z,IF_END <#IF_END> ; forward if checking syntax
+
+; else delete the Boolean value on the calculator stack.
+
+ RST _FP_CALC ;;
+ DEFB __delete ;;
+ DEFB __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.
+
+mark_0DB6:
+*IF_END:*
+ JP LINE_NULL <#LINE_NULL> ; jump back
+
+------------------------------------------------------------------------
+
+; THE *'FOR'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_0DB9:
+*FOR:*
+ CP ZX_STEP ; is current character 'STEP' ?
+ JR NZ,F_USE_ONE <#F_USE_ONE> ; forward if not
+
+
+ RST _NEXT_CHAR
+ CALL CLASS_6 <#CLASS_6> ; stacks the number
+ CALL CHECK_END <#CHECK_END>
+ JR F_REORDER <#F_REORDER> ; forward to F_REORDER
+; ___
+
+mark_0DC6:
+*F_USE_ONE:*
+ CALL CHECK_END <#CHECK_END>
+
+ RST _FP_CALC ;;
+ DEFB __stk_one ;;
+ DEFB __end_calc ;;
+
+
+
+mark_0DCC:
+*F_REORDER:*
+ RST _FP_CALC ;; v, l, s.
+ DEFB __st_mem_0 ;; v, l, s.
+ DEFB __delete ;; v, l.
+ DEFB __exchange ;; l, v.
+ DEFB __get_mem_0 ;; l, v, s.
+ DEFB __exchange ;; l, s, v.
+ DEFB __end_calc ;; l, s, v.
+
+ CALL LET <#LET>
+
+ LD (MEM),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,F_LMT_STP <#F_LMT_STP>
+
+ SLA C ;
+ CALL MAKE_ROOM <#MAKE_ROOM>
+ INC HL ;
+
+mark_0DEA:
+*F_LMT_STP:*
+ PUSH HL ;
+
+ RST _FP_CALC ;;
+ DEFB __delete ;;
+ DEFB __delete ;;
+ DEFB __end_calc ;;
+
+ POP HL ;
+ EX DE,HL ;
+
+ LD C,$0A ; ten bytes to be moved.
+ LDIR ; copy bytes
+
+ LD HL,(PPC) ; 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 NEXT_LOOP <#NEXT_LOOP> ; considers an initial pass.
+ RET NC ; return if possible.
+
+; else program continues from point following matching NEXT.
+
+ BIT 7,(IY+PPC_hi-RAMBASE)
+ RET NZ ; return if over 32767 ???
+
+ LD B,(IY+STRLEN_lo-RAMBASE) ; fetch variable name from STRLEN_lo
+ RES 6,B ; make a true letter.
+ LD HL,(NXTLIN) ; set HL from NXTLIN
+
+; now enter a loop to look for matching next.
+
+mark_0E0E:
+*NXTLIN_NO:*
+ LD A,(HL) ; fetch high byte of line number.
+ AND $C0 ; mask off low bits $3F
+ JR NZ,FOR_END <#FOR_END> ; forward at end of program
+
+ PUSH BC ; save letter
+ CALL NEXT_ONE <#NEXT_ONE> ; finds next line.
+ POP BC ; restore letter
+
+ INC HL ; step past low byte
+ INC HL ; past the
+ INC HL ; line length.
+ CALL TEMP_PTR1 <#TEMP_PTR1> ; sets CH_ADD
+
+ RST _GET_CHAR
+ CP ZX_NEXT ;
+ EX DE,HL ; next line to HL.
+ JR NZ,NXTLIN_NO <#NXTLIN_NO> ; back with no match
+
+;
+
+ EX DE,HL ; restore pointer.
+
+ RST _NEXT_CHAR ; advances and gets letter in A.
+ EX DE,HL ; save pointer
+ CP B ; compare to variable name.
+ JR NZ,NXTLIN_NO <#NXTLIN_NO> ; back with mismatch
+
+mark_0E2A:
+*FOR_END:*
+ LD (NXTLIN),HL ; update system variable NXTLIN
+ RET ; return.
+
+------------------------------------------------------------------------
+
+; THE *'NEXT'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_0E2E:
+*NEXT:*
+ BIT 1,(IY+FLAGX-RAMBASE)
+ JP NZ,REPORT_2 <#REPORT_2>
+
+ LD HL,(DEST)
+ BIT 7,(HL)
+ JR Z,REPORT_1 <#REPORT_1>
+
+ INC HL ;
+ LD (MEM),HL ;
+
+ RST _FP_CALC ;;
+ DEFB __get_mem_0 ;;
+ DEFB __get_mem_2 ;;
+ DEFB __addition ;;
+ DEFB __st_mem_0 ;;
+ DEFB __delete ;;
+ DEFB __end_calc ;;
+
+ CALL NEXT_LOOP <#NEXT_LOOP>
+ RET C ;
+
+ LD HL,(MEM) ;
+ LD DE,$000F ;
+ ADD HL,DE ;
+ LD E,(HL) ;
+ INC HL ;
+ LD D,(HL) ;
+ EX DE,HL ;
+ JR GOTO_2 <#GOTO_2>
+; ___
+
+mark_0E58:
+*REPORT_1:*
+ RST _ERROR_1
+ DEFB $00 ; Error Report: NEXT without FOR
+
+
+------------------------------------------------------------------------
+
+; THE *'NEXT_LOOP'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_0E5A:
+*NEXT_LOOP:*
+ RST _FP_CALC ;;
+ DEFB __get_mem_1 ;;
+ DEFB __get_mem_0 ;;
+ DEFB __get_mem_2 ;;
+ DEFB __less_0 ;;
+ DEFB __jump_true ;;
+ DEFB LMT_V_VAL <#LMT_V_VAL> - $ ;;
+
+ DEFB __exchange ;;
+
+mark_0E62:
+*LMT_V_VAL:*
+ DEFB __subtract ;;
+ DEFB __greater_0 ;;
+ DEFB __jump_true ;;
+ DEFB IMPOSS <#IMPOSS> - $ ;;
+
+ DEFB __end_calc ;;
+
+ AND A ; clear carry flag
+ RET ; return.
+; ___
+
+mark_0E69:
+*IMPOSS:*
+ DEFB __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.
+
+mark_0E6C:
+*RAND:*
+ CALL FIND_INT <#FIND_INT>
+ LD A,B ; test value
+ OR C ; for zero
+ JR NZ,SET_SEED <#SET_SEED> ; forward if not zero
+
+ LD BC,(FRAMES) ; fetch value of FRAMES system variable.
+
+mark_0E77:
+*SET_SEED:*
+ LD (SEED),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.
+
+mark_0E7C:
+*CONT:*
+ LD HL,(OLDPPC) ; set HL from system variable OLDPPC
+ JR GOTO_2 <#GOTO_2> ; forward
+
+------------------------------------------------------------------------
+
+; 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.
+
+mark_0E81:
+*GOTO:*
+ CALL FIND_INT <#FIND_INT>
+ LD H,B ;
+ LD L,C ;
+
+mark_0E86:
+*GOTO_2:*
+ LD A,H ;
+ CP $F0 ; ZX_LIST ???
+ JR NC,REPORT_B <#REPORT_B>
+
+ CALL LINE_ADDR <#LINE_ADDR>
+ LD (NXTLIN),HL ; sv
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'POKE'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0E92:
+*POKE:*
+ CALL FP_TO_A <#FP_TO_A>
+ JR C,REPORT_B <#REPORT_B> ; forward, with overflow
+
+ JR Z,POKE_SAVE <#POKE_SAVE> ; forward, if positive
+
+ NEG ; negate
+
+mark_0E9B:
+*POKE_SAVE:*
+ PUSH AF ; preserve value.
+ CALL FIND_INT <#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+ERR_NR-RAMBASE) ; 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
+------------------------------------------------------------------------
+
+
+mark_0EA7:
+*FIND_INT:*
+ CALL FP_TO_BC <#FP_TO_BC>
+ JR C,REPORT_B <#REPORT_B> ; forward with overflow
+
+ RET Z ; return if positive (0-65535).
+
+
+mark_0EAD:
+*REPORT_B:*
+ RST _ERROR_1
+ DEFB $0A ; Error Report: Integer out of range
+;
+; Seems stupid, $0A is 10 but the ERROR_CODE_INTEGER_OUT_OF_RANGE is 11
+; maybe gets incremented ???
+
+------------------------------------------------------------------------
+
+; THE *'RUN'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0EAF:
+*RUN:*
+ CALL GOTO <#GOTO>
+ JP CLEAR <#CLEAR>
+
+------------------------------------------------------------------------
+
+; THE *'GOSUB'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0EB5:
+*GOSUB:*
+ LD HL,(PPC) ;
+ INC HL ;
+ EX (SP),HL ;
+ PUSH HL ;
+ LD (ERR_SP),SP ; set the error stack pointer - ERR_SP
+ CALL GOTO <#GOTO>
+ LD BC,6 ;
+
+------------------------------------------------------------------------
+
+; THE *'TEST ROOM'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+; checks ther is room for 36 bytes on the stack
+;
+mark_0EC5:
+*TEST_ROOM:*
+ LD HL,(STKEND) ;
+ ADD HL,BC ; HL = STKEND + BC
+ JR C,REPORT_4 <#REPORT_4>
+
+ EX DE,HL ; DE = STKEND + BC
+ LD HL,$0024 ; 36 decimal
+ ADD HL,DE ; HL = 36 + STKEND + BC
+ SBC HL,SP ; HL = 36 + STKEND + BC - SP
+ RET C ;
+
+mark_0ED3:
+*REPORT_4:*
+ LD L,3 ;
+ JP ERROR_3 <#ERROR_3>
+
+------------------------------------------------------------------------
+
+; THE *'RETURN'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0ED8:
+*RETURN:*
+ POP HL ;
+ EX (SP),HL ;
+ LD A,H ;
+ CP $3E ;
+ JR Z,REPORT_7 <#REPORT_7>
+
+ LD (ERR_SP),SP ;
+ JR GOTO_2 <#GOTO_2> ; back
+; ___
+
+mark_0EE5:
+*REPORT_7:*
+ EX (SP),HL ;
+ PUSH HL ;
+
+ RST _ERROR_1
+ DEFB 6 ; Error Report: RETURN without GOSUB
+
+;
+; Contradicts BASIC manual:
+; 7 is ERROR_CODE_RETURN_WITHOUT_GOSUB
+; 6 is ERROR_CODE_ARITHMETIC_OVERFLOW
+;
+
+------------------------------------------------------------------------
+
+; THE *'INPUT'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0EE9:
+*INPUT:*
+ BIT 7,(IY+PPC_hi-RAMBASE)
+ JR NZ,REPORT_8 <#REPORT_8> ; to REPORT_8
+
+ CALL X_TEMP <#X_TEMP>
+ LD HL,FLAGX ;
+ SET 5,(HL) ;
+ RES 6,(HL) ;
+ LD A,(FLAGS) ;
+ AND $40 ; 64
+ LD BC,2 ;
+ JR NZ,PROMPT <#PROMPT> ; to PROMPT
+
+ LD C,$04 ;
+
+mark_0F05:
+*PROMPT:*
+ OR (HL) ;
+ LD (HL),A ;
+
+ RST _BC_SPACES
+ LD (HL),ZX_NEWLINE
+ LD A,C ;
+ RRCA ;
+ RRCA ;
+ JR C,ENTER_CUR <#ENTER_CUR>
+
+ LD A,$0B ; ZX_QUOTE ???
+ LD (DE),A ;
+ DEC HL ;
+ LD (HL),A ;
+
+mark_0F14:
+*ENTER_CUR:*
+ DEC HL ;
+ LD (HL),ZX_CURSOR ;
+ LD HL,(S_POSN) ;
+ LD (T_ADDR),HL ;
+ POP HL ;
+ JP LOWER <#LOWER>
+
+; ___
+
+mark_0F21:
+*REPORT_8:*
+ RST _ERROR_1
+ DEFB 7 ; Error Report: End of file
+
+------------------------------------------------------------------------
+
+; THE *'PAUSE'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0F23:
+*FAST:*
+ CALL SET_FAST <#SET_FAST>
+ RES 6,(IY+CDFLAG-RAMBASE)
+ RET ; return.
+
+------------------------------------------------------------------------
+
+; THE *'SLOW'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0F2B:
+*SLOW:*
+ SET 6,(IY+CDFLAG-RAMBASE)
+ JP SLOW_FAST <#SLOW_FAST>
+
+------------------------------------------------------------------------
+
+; THE *'PAUSE'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+
+mark_0F32:
+*PAUSE:*
+ CALL FIND_INT <#FIND_INT>
+ CALL SET_FAST <#SET_FAST>
+ LD H,B ;
+ LD L,C ;
+ CALL DISPLAY_P <#DISPLAY_P>
+
+ LD (IY+FRAMES_hi-RAMBASE),$FF
+
+ CALL SLOW_FAST <#SLOW_FAST>
+ JR DEBOUNCE <#DEBOUNCE>
+
+------------------------------------------------------------------------
+
+; THE *'BREAK'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_0F46:
+*BREAK_1:*
+ LD A,$7F ; read port $7FFE - keys B,N,M,.,SPACE.
+ IN A,(IO_PORT_KEYBOARD_RD) ;
+ RRA ; carry will be set if space not pressed.
+
+------------------------------------------------------------------------
+
+; THE *'DEBOUNCE'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_0F4B:
+*DEBOUNCE:*
+ RES 0,(IY+CDFLAG-RAMBASE) ; update
+ LD A,$FF ;
+ LD (DEBOUNCE_VAR),A ; update
+ 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".
+
+mark_0F55:
+*SCANNING:*
+ RST _GET_CHAR
+ LD B,0 ; set B register to zero.
+ PUSH BC ; stack zero as a priority end-marker.
+
+mark_0F59:
+*S_LOOP_1:*
+ CP ZX_RND
+ JR NZ,S_TEST_PI <#S_TEST_PI> ; forward, if not, to S_TEST_PI
+
+------------------------------------------------------------------------
+
+; THE *'RND'* FUNCTION
+------------------------------------------------------------------------
+
+*RND:*
+
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ JR Z,S_JPI_END <#S_JPI_END> ; forward if checking syntax to S_JPI_END
+
+ LD BC,(SEED) ; sv
+ CALL STACK_BC <#STACK_BC>
+
+ RST _FP_CALC ;;
+ DEFB __stk_one ;;
+ DEFB __addition ;;
+ DEFB __stk_data ;;
+ DEFB $37 ;;Exponent: $87, Bytes: 1
+ DEFB $16 ;;(+00,+00,+00)
+ DEFB __multiply ;;
+ DEFB __stk_data ;;
+ DEFB $80 ;;Bytes: 3
+ DEFB $41 ;;Exponent $91
+ DEFB $00,$00,$80 ;;(+00)
+ DEFB __n_mod_m ;;
+ DEFB __delete ;;
+ DEFB __stk_one ;;
+ DEFB __subtract ;;
+ DEFB __duplicate ;;
+ DEFB __end_calc ;;
+
+ CALL FP_TO_BC <#FP_TO_BC>
+ LD (SEED),BC ; update the SEED system variable.
+ LD A,(HL) ; HL addresses the exponent of the last value.
+ AND A ; test for zero
+ JR Z,S_JPI_END <#S_JPI_END> ; forward, if so
+
+ SUB $10 ; else reduce exponent by sixteen
+ LD (HL),A ; thus dividing by 65536 for last value.
+
+mark_0F8A:
+*S_JPI_END:*
+ JR S_PI_END <#S_PI_END> ; forward
+
+; ___
+
+mark_0F8C:
+*S_TEST_PI:*
+ CP ZX_PI ; the 'PI' character
+ JR NZ,S_TST_INK <#S_TST_INK> ; forward, if not
+
+------------------------------------------------------------------------
+
+; THE *'PI'* EVALUATION
+------------------------------------------------------------------------
+
+
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ JR Z,S_PI_END <#S_PI_END> ; forward if checking syntax
+
+
+ RST _FP_CALC ;;
+ DEFB __stk_half_pi ;;
+ DEFB __end_calc ;;
+
+ INC (HL) ; double the exponent giving PI on the stack.
+
+mark_0F99:
+*S_PI_END:*
+ RST _NEXT_CHAR ; advances character pointer.
+
+ JP S_NUMERIC <#S_NUMERIC> ; jump forward to set the flag
+ ; to signal numeric result before advancing.
+
+; ___
+
+mark_0F9D:
+*S_TST_INK:*
+ CP ZX_INKEY_STR ;
+ JR NZ,S_ALPHANUM <#S_ALPHANUM> ; forward, if not
+
+------------------------------------------------------------------------
+
+; THE *'INKEY$'* EVALUATION
+------------------------------------------------------------------------
+
+
+ CALL KEYBOARD <#KEYBOARD>
+ LD B,H ;
+ LD C,L ;
+ LD D,C ;
+ INC D ;
+ CALL NZ,DECODE <#DECODE>
+ LD A,D ;
+ ADC A,D ;
+ LD B,D ;
+ LD C,A ;
+ EX DE,HL ;
+ JR S_STRING <#S_STRING> ; forward
+
+; ___
+
+mark_0FB2:
+*S_ALPHANUM:*
+ CALL ALPHANUM <#ALPHANUM>
+ JR C,S_LTR_DGT <#S_LTR_DGT> ; forward, if alphanumeric
+
+ CP ZX_PERIOD ; is character a '.' ?
+ JP Z,S_DECIMAL <#S_DECIMAL> ; jump forward if so
+
+ LD BC,$09D8 ; prepare priority 09, operation 'subtract'
+ CP ZX_MINUS ; is character unary minus '-' ?
+ JR Z,S_PUSH_PO <#S_PUSH_PO> ; forward, if so
+
+ CP ZX_BRACKET_LEFT ; is character a '(' ?
+ JR NZ,S_QUOTE <#S_QUOTE> ; forward if not
+
+ CALL CH_ADD_PLUS_1 <#CH_ADD_PLUS_1> ; advances character pointer.
+
+ CALL SCANNING <#SCANNING> ; recursively call to evaluate the sub_expression.
+
+ CP ZX_BRACKET_RIGHT; is subsequent character a ')' ?
+ JR NZ,S_RPT_C <#S_RPT_C> ; forward if not
+
+
+ CALL CH_ADD_PLUS_1 <#CH_ADD_PLUS_1> ; advances.
+ JR S_J_CONT_3 <#S_J_CONT_3> ; 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.
+
+mark_0FD6:
+*S_QUOTE:*
+ CP ZX_QUOTE ; is character a quote (") ?
+ JR NZ,S_FUNCTION <#S_FUNCTION> ; forward, if not
+
+ CALL CH_ADD_PLUS_1 <#CH_ADD_PLUS_1> ; advances
+ PUSH HL ; * save start of string.
+ JR S_QUOTE_S <#S_QUOTE_S> ; forward
+
+; ___
+
+
+mark_0FE0:
+*S_Q_AGAIN:*
+ CALL CH_ADD_PLUS_1 <#CH_ADD_PLUS_1>
+
+mark_0FE3:
+*S_QUOTE_S:*
+ CP ZX_QUOTE ; is character a '"' ?
+ JR NZ,S_Q_NL <#S_Q_NL> ; 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.
+
+mark_0FED:
+*S_STRING:*
+ LD HL,FLAGS ; address system variable FLAGS
+ RES 6,(HL) ; signal string result
+ BIT 7,(HL) ; test if checking syntax.
+
+ CALL NZ,STK_STO_STR <#STK_STO_STR> ; in run-time stacks the
+ ; string descriptor - start DE, length BC.
+
+ RST _NEXT_CHAR ; advances pointer.
+
+mark_0FF8:
+*S_J_CONT_3:*
+ JP S_CONT_3 <#S_CONT_3>
+
+; ___
+
+; A string with no terminating quote has to be considered.
+
+mark_0FFB:
+*S_Q_NL:*
+ CP ZX_NEWLINE
+ JR NZ,S_Q_AGAIN <#S_Q_AGAIN> ; loop back if not
+
+mark_0FFF:
+*S_RPT_C:*
+ JP REPORT_C <#REPORT_C>
+; ___
+
+mark_1002:
+*S_FUNCTION:*
+ SUB $C4 ; subtract 'CODE' reducing codes
+ ; CODE thru '<>' to range $00 - $XX
+ JR C,S_RPT_C <#S_RPT_C> ; back, if less
+
+; 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,S_PUSH_PO <#S_PUSH_PO> ; forward, if so
+
+ JR NC,S_RPT_C <#S_RPT_C> ; back with anything higher
+
+; 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,S_NUMBER_TO_STRING <#S_NUMBER_TO_STRING> ; skip forward if string operand
+
+ RES 6,C ; signal string operand.
+
+mark_101A:
+*S_NUMBER_TO_STRING:*
+ CP $EA ; isolate top of range 'STR$' and 'CHR$'
+ JR C,S_PUSH_PO <#S_PUSH_PO> ; skip forward with others
+
+ RES 7,C ; signal string result.
+
+mark_1020:
+*S_PUSH_PO:*
+ PUSH BC ; push the priority/operation
+
+ RST _NEXT_CHAR
+ JP S_LOOP_1 <#S_LOOP_1> ; jump back
+; ___
+
+mark_1025:
+*S_LTR_DGT:*
+ CP ZX_A ; compare to 'A'.
+ JR C,S_DECIMAL <#S_DECIMAL> ; forward if less to S_DECIMAL
+
+ CALL LOOK_VARS <#LOOK_VARS>
+ JP C,REPORT_2 <#REPORT_2> ; back if not found
+ ; a variable is always 'found' when checking
+ ; syntax.
+
+ CALL Z,STK_VAR <#STK_VAR> ; stacks string parameters or
+ ; returns cell location if numeric.
+
+ LD A,(FLAGS) ; fetch FLAGS
+ CP $C0 ; compare to numeric result/numeric operand
+ JR C,S_CONT_2 <#S_CONT_2> ; forward if not numeric
+
+ INC HL ; address numeric contents of variable.
+ LD DE,(STKEND) ; set destination to STKEND
+ CALL MOVE_FP <#MOVE_FP> ; stacks the five bytes
+ EX DE,HL ; transfer new free location from DE to HL.
+ LD (STKEND),HL ; update STKEND system variable.
+ JR S_CONT_2 <#S_CONT_2> ; forward
+; ___
+
+; 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.
+
+mark_1047:
+*S_DECIMAL:*
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ JR NZ,S_STK_DEC <#S_STK_DEC> ; forward in run-time
+
+ CALL DEC_TO_FP <#DEC_TO_FP>
+
+ RST _GET_CHAR ; advances HL past digits
+ LD BC,$0006 ; six locations are required.
+ CALL MAKE_ROOM <#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,(STKEND) ; 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 (STKEND),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 TEMP_PTR1 <#TEMP_PTR1> ; advances the character
+ ; address skipping any white-space.
+ JR S_NUMERIC <#S_NUMERIC> ; forward
+ ; to signal a numeric result.
+; ___
+; In run-time the branch is here when a digit or point is encountered.
+
+mark_106F:
+*S_STK_DEC:*
+ RST _NEXT_CHAR
+ CP $7E ; compare to 'number marker'
+ JR NZ,S_STK_DEC <#S_STK_DEC> ; loop back until found
+ ; skipping all the digits.
+
+ INC HL ; point to first of five hidden bytes.
+ LD DE,(STKEND) ; set destination from STKEND system variable
+ CALL MOVE_FP <#MOVE_FP> ; stacks the number.
+ LD (STKEND),DE ; update system variable STKEND.
+ LD (CH_ADD),HL ; update system variable CH_ADD.
+
+mark_1083:
+*S_NUMERIC:*
+ SET 6,(IY+FLAGS-RAMBASE) ; Signal numeric result
+
+mark_1087:
+*S_CONT_2:*
+ RST _GET_CHAR
+
+mark_1088:
+*S_CONT_3:*
+ CP ZX_BRACKET_LEFT ; compare to opening bracket '('
+ JR NZ,S_OPERTR <#S_OPERTR> ; forward if not
+
+ BIT 6,(IY+FLAGS-RAMBASE) ; Numeric or string result?
+ JR NZ,S_LOOP <#S_LOOP> ; forward if numeric
+
+; else is a string
+
+ CALL SLICING <#SLICING>
+
+ RST _NEXT_CHAR
+ JR S_CONT_3 <#S_CONT_3> ; back
+; ___
+; 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.
+
+mark_1098:
+*S_OPERTR:*
+ LD BC,$00C3 ; prepare operator 'subtract' as default.
+ ; also set B to zero for later indexing.
+
+ CP ZX_GREATER_THAN ; is character '>' ?
+ JR C,S_LOOP <#S_LOOP> ; forward if less, as
+ ; we have reached end of meaningful expression
+
+ SUB ZX_MINUS ; is character '-' ?
+ JR NC,SUBMLTDIV <#SUBMLTDIV> ; forward with - * / and '**' '<>'
+
+ ADD A,13 ; increase others by thirteen
+ ; $09 '>' thru $0C '+'
+ JR GET_PRIO <#GET_PRIO> ; forward
+
+; ___
+
+mark_10A7:
+*SUBMLTDIV:*
+ CP $03 ; isolate $00 '-', $01 '*', $02 '/'
+ JR C,GET_PRIO <#GET_PRIO> ; forward if so
+
+; else possibly originally $D8 '**' thru $DD '<>' already reduced by $16
+
+ SUB $C2 ; giving range $00 to $05
+ JR C,S_LOOP <#S_LOOP> ; forward if less
+
+ CP $06 ; test the upper limit for nonsense also
+ JR NC,S_LOOP <#S_LOOP> ; forward if so
+
+ 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 '+'
+
+mark_10B5:
+*GET_PRIO:*
+ ADD A,C ; add to default operation 'sub' ($C3)
+ LD C,A ; and place in operator byte - C.
+
+ LD HL,tbl_pri <#tbl_pri> - $C3 ; theoretical base of the priorities table.
+ ADD HL,BC ; add C ( B is zero)
+ LD B,(HL) ; pick up the priority in B
+
+mark_10BC:
+*S_LOOP:*
+ POP DE ; restore previous
+ LD A,D ; load A with priority.
+ CP B ; is present priority higher
+ JR C,S_TIGHTER <#S_TIGHTER> ; forward if so to S_TIGHTER
+
+ AND A ; are both priorities zero
+ JP Z,GET_CHAR <#GET_CHAR> ; exit if zero via GET_CHAR
+
+ PUSH BC ; stack present values
+ PUSH DE ; stack last values
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ JR Z,S_SYNTEST <#S_SYNTEST> ; forward is checking syntax
+
+ 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 BERG
+
+; perform the single operation
+
+ RST _FP_CALC ;;
+ DEFB __fp_calc_2 ;;
+ DEFB __end_calc ;;
+
+ JR S_RUNTEST <#S_RUNTEST> ; forward
+
+; ___
+
+mark_10D5:
+*S_SYNTEST:*
+ LD A,E ; transfer masked operator to A
+ XOR (IY+FLAGS-RAMBASE) ; XOR with FLAGS like results will reset bit 6
+ AND $40 ; test bit 6
+
+mark_10DB:
+*S_RPORT_C:*
+ JP NZ,REPORT_C <#REPORT_C> ; back if results do not agree.
+
+; ___
+
+; in run-time impose bit 7 of the operator onto bit 6 of the FLAGS
+
+mark_10DE:
+*S_RUNTEST:*
+ POP DE ; restore last operation.
+ LD HL,FLAGS ; address system variable FLAGS
+ SET 6,(HL) ; presume a numeric result
+ BIT 7,E ; test expected result in operation
+ JR NZ,S_LOOPEND <#S_LOOPEND> ; forward if numeric
+
+ RES 6,(HL) ; reset to signal string result
+
+mark_10EA:
+*S_LOOPEND:*
+ POP BC ; restore present values
+ JR S_LOOP <#S_LOOP> ; back
+
+; ___
+
+mark_10ED:
+*S_TIGHTER:*
+ PUSH DE ; push last values and consider these
+
+ LD A,C ; get the present operator.
+ BIT 6,(IY+FLAGS-RAMBASE) ; Numeric or string result?
+ JR NZ,S_NEXT <#S_NEXT> ; 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,S_NOT_AND <#S_NOT_AND> ; forward if not
+
+ SET 6,C ; set the numeric operand required for 'AND'
+ JR S_NEXT <#S_NEXT> ; forward to S_NEXT
+
+; ___
+
+mark_1102:
+*S_NOT_AND:*
+ JR C,S_RPORT_C <#S_RPORT_C> ; back if less than 'AND'
+ ; Nonsense if '-', '*' etc.
+
+ CP __strs_add ; compare to 'strs_add' literal
+ JR Z,S_NEXT <#S_NEXT> ; forward if so signaling string result
+
+ SET 7,C ; set bit to numeric (Boolean) for others.
+
+mark_110A:
+*S_NEXT:*
+ PUSH BC ; stack 'present' values
+
+ RST _NEXT_CHAR
+ JP S_LOOP_1 <#S_LOOP_1> ; jump back
+
+
+
+------------------------------------------------------------------------
+
+; THE *'TABLE OF PRIORITIES'*
+------------------------------------------------------------------------
+
+
+mark_110F:
+*tbl_pri:*
+ DEFB 6 ; '-'
+ DEFB 8 ; '*'
+ DEFB 8 ; '/'
+ DEFB 10 ; '**'
+ DEFB 2 ; 'OR'
+ DEFB 3 ; 'AND'
+ DEFB 5 ; '<='
+ DEFB 5 ; '>='
+ DEFB 5 ; '<>'
+ DEFB 5 ; '>'
+ DEFB 5 ; '<'
+ DEFB 5 ; '='
+ DEFB 6 ; '+'
+
+------------------------------------------------------------------------
+
+; THE *'LOOK_VARS'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_111C:
+*LOOK_VARS:*
+ SET 6,(IY+FLAGS-RAMBASE) ; Signal numeric result
+
+ RST _GET_CHAR
+ CALL ALPHA <#ALPHA>
+ JP NC,REPORT_C <#REPORT_C> ; to REPORT_C
+
+ PUSH HL ;
+ LD C,A ;
+
+ RST _NEXT_CHAR
+ PUSH HL ;
+ RES 5,C ;
+ CP $10 ; $10
+ JR Z,V_RUN_SYN <#V_RUN_SYN>
+
+ SET 6,C ;
+ CP ZX_DOLLAR ; $0D
+ JR Z,V_STR_VAR <#V_STR_VAR> ; forward
+
+ SET 5,C ;
+
+mark_1139:
+*V_CHAR:*
+ CALL ALPHANUM <#ALPHANUM>
+ JR NC,V_RUN_SYN <#V_RUN_SYN> ; forward when not
+
+ RES 6,C ;
+
+ RST _NEXT_CHAR
+ JR V_CHAR <#V_CHAR> ; loop back
+
+; ___
+
+mark_1143:
+*V_STR_VAR:*
+ RST _NEXT_CHAR
+ RES 6,(IY+FLAGS-RAMBASE) ; Signal string result
+
+mark_1148:
+*V_RUN_SYN:*
+ LD B,C ;
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ JR NZ,V_RUN <#V_RUN> ; forward
+
+ LD A,C ;
+ AND $E0 ;
+ SET 7,A ;
+ LD C,A ;
+ JR V_SYNTAX <#V_SYNTAX> ; forward
+
+; ___
+
+mark_1156:
+*V_RUN:*
+ LD HL,(VARS) ; sv
+
+mark_1159:
+*V_EACH:*
+ LD A,(HL) ;
+ AND $7F ;
+ JR Z,V_80_BYTE <#V_80_BYTE> ;
+
+ CP C ;
+ JR NZ,V_NEXT <#V_NEXT> ;
+
+ RLA ;
+ ADD A,A ;
+ JP P,V_FOUND_2 <#V_FOUND_2>
+
+ JR C,V_FOUND_2 <#V_FOUND_2>
+
+ POP DE ;
+ PUSH DE ;
+ PUSH HL ;
+
+mark_116B:
+*V_MATCHES:*
+ INC HL ;
+
+mark_116C:
+*V_SPACES:*
+ LD A,(DE) ;
+ INC DE ;
+ AND A ;
+ JR Z,V_SPACES <#V_SPACES> ; back
+
+ CP (HL) ;
+ JR Z,V_MATCHES <#V_MATCHES> ; back
+
+ OR $80 ;
+ CP (HL) ;
+ JR NZ,V_GET_PTR <#V_GET_PTR> ; forward
+
+ LD A,(DE) ;
+ CALL ALPHANUM <#ALPHANUM>
+ JR NC,V_FOUND_1 <#V_FOUND_1> ; forward
+
+mark_117F:
+*V_GET_PTR:*
+ POP HL ;
+
+mark_1180:
+*V_NEXT:*
+ PUSH BC ;
+ CALL NEXT_ONE <#NEXT_ONE>
+ EX DE,HL ;
+ POP BC ;
+ JR V_EACH <#V_EACH> ; back
+
+; ___
+
+mark_1188:
+*V_80_BYTE:*
+ SET 7,B ;
+
+mark_118A:
+*V_SYNTAX:*
+ POP DE ;
+
+ RST _GET_CHAR
+ CP $10 ;
+ JR Z,V_PASS <#V_PASS> ; forward
+
+ SET 5,B ;
+ JR V_END <#V_END> ; forward
+
+; ___
+
+mark_1194:
+*V_FOUND_1:*
+ POP DE ;
+
+mark_1195:
+*V_FOUND_2:*
+ POP DE ;
+ POP DE ;
+ PUSH HL ;
+
+ RST _GET_CHAR
+
+mark_1199:
+*V_PASS:*
+ CALL ALPHANUM <#ALPHANUM>
+ JR NC,V_END <#V_END> ; forward if not alphanumeric
+
+
+ RST _NEXT_CHAR
+ JR V_PASS <#V_PASS> ; back
+
+; ___
+
+mark_11A1:
+*V_END:*
+ POP HL ;
+ RL B ;
+ BIT 6,B ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'STK_VAR'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_11A7:
+*STK_VAR:*
+ XOR A ;
+ LD B,A ;
+ BIT 7,C ;
+ JR NZ,SV_COUNT <#SV_COUNT> ; forward
+
+ BIT 7,(HL) ;
+ JR NZ,SV_ARRAYS <#SV_ARRAYS> ; forward
+
+ INC A ;
+
+mark_11B2:
+*SV_SIMPLE_STR:*
+ INC HL ;
+ LD C,(HL) ;
+ INC HL ;
+ LD B,(HL) ;
+ INC HL ;
+ EX DE,HL ;
+ CALL STK_STO_STR <#STK_STO_STR>
+
+ RST _GET_CHAR
+ JP SV_SLICE_QUERY <#SV_SLICE_QUERY> ; jump forward
+
+; ___
+
+mark_11BF:
+*SV_ARRAYS:*
+ INC HL ;
+ INC HL ;
+ INC HL ;
+ LD B,(HL) ;
+ BIT 6,C ;
+ JR Z,SV_PTR <#SV_PTR> ; forward
+
+ DEC B ;
+ JR Z,SV_SIMPLE_STR <#SV_SIMPLE_STR> ; forward
+
+ EX DE,HL ;
+
+ RST _GET_CHAR
+ CP $10 ;
+ JR NZ,REPORT_3 <#REPORT_3> ; forward
+
+ EX DE,HL ;
+
+mark_11D1:
+*SV_PTR:*
+ EX DE,HL ;
+ JR SV_COUNT <#SV_COUNT> ; forward
+; ___
+mark_11D4:
+*SV_COMMA:*
+ PUSH HL ;
+
+ RST _GET_CHAR
+ POP HL ;
+ CP ZX_COMMA ; $1A == 26
+ JR Z,SV_LOOP <#SV_LOOP> ; forward
+
+ BIT 7,C ;
+ JR Z,REPORT_3 <#REPORT_3> ; forward
+
+ BIT 6,C ;
+ JR NZ,SV_CLOSE <#SV_CLOSE> ; forward
+
+ CP ZX_BRACKET_RIGHT ; $11
+ JR NZ,SV_RPT_C <#SV_RPT_C> ; forward
+
+
+ RST _NEXT_CHAR
+ RET ;
+; ___
+mark_11E9:
+*SV_CLOSE:*
+ CP ZX_BRACKET_RIGHT ; $11
+ JR Z,SV_DIM <#SV_DIM> ; forward
+
+ CP $DF ;
+ JR NZ,SV_RPT_C <#SV_RPT_C> ; forward
+
+mark_11F1:
+*SV_CH_ADD:*
+ RST _GET_CHAR
+ DEC HL ;
+ LD (CH_ADD),HL ; sv
+ JR SV_SLICE <#SV_SLICE> ; forward
+
+; ___
+
+mark_11F8:
+*SV_COUNT:*
+ LD HL,$0000 ;
+
+mark_11FB:
+*SV_LOOP:*
+ PUSH HL ;
+
+ RST _NEXT_CHAR
+ POP HL ;
+ LD A,C ;
+ CP ZX_DOUBLE_QUOTE ;
+ JR NZ,SV_MULT <#SV_MULT> ; forward
+
+
+ RST _GET_CHAR
+ CP ZX_BRACKET_RIGHT
+ JR Z,SV_DIM <#SV_DIM> ; forward
+
+ CP ZX_TO ;
+ JR Z,SV_CH_ADD <#SV_CH_ADD> ; back
+
+mark_120C:
+*SV_MULT:*
+ PUSH BC ;
+ PUSH HL ;
+ CALL DE_DE_PLUS_ONE <#DE_DE_PLUS_ONE>
+ EX (SP),HL ;
+ EX DE,HL ;
+ CALL INT_EXP1 <#INT_EXP1>
+ JR C,REPORT_3 <#REPORT_3>
+
+ DEC BC ;
+ CALL GET_HL_TIMES_DE <#GET_HL_TIMES_DE>
+ ADD HL,BC ;
+ POP DE ;
+ POP BC ;
+ DJNZ SV_COMMA <#SV_COMMA> ; loop back
+
+ BIT 7,C ;
+
+mark_1223:
+*SV_RPT_C:*
+ JR NZ,SL_RPT_C <#SL_RPT_C>
+
+ PUSH HL ;
+ BIT 6,C ;
+ JR NZ,SV_ELEM_STR <#SV_ELEM_STR>
+
+ LD B,D ;
+ LD C,E ;
+
+ RST _GET_CHAR
+ CP ZX_BRACKET_RIGHT; is character a ')' ?
+ JR Z,SV_NUMBER <#SV_NUMBER> ; skip forward
+
+
+mark_1231:
+*REPORT_3:*
+ RST _ERROR_1
+ DEFB $02 ; Error Report: Subscript wrong
+
+
+mark_1233:
+*SV_NUMBER:*
+ RST _NEXT_CHAR
+ POP HL ;
+ LD DE,$0005 ;
+ CALL GET_HL_TIMES_DE <#GET_HL_TIMES_DE>
+ ADD HL,BC ;
+ RET ; return >>
+
+; ___
+
+mark_123D:
+*SV_ELEM_STR:*
+ CALL DE_DE_PLUS_ONE <#DE_DE_PLUS_ONE>
+ EX (SP),HL ;
+ CALL GET_HL_TIMES_DE <#GET_HL_TIMES_DE>
+ POP BC ;
+ ADD HL,BC ;
+ INC HL ;
+ LD B,D ;
+ LD C,E ;
+ EX DE,HL ;
+ CALL STK_ST_0 <#STK_ST_0>
+
+ RST _GET_CHAR
+ CP ZX_BRACKET_RIGHT ; is it ')' ?
+ JR Z,SV_DIM <#SV_DIM> ; forward if so
+
+ CP ZX_COMMA ; $1A == 26 ; is it ',' ?
+ JR NZ,REPORT_3 <#REPORT_3> ; back if not
+
+mark_1256:
+*SV_SLICE:*
+ CALL SLICING <#SLICING>
+
+mark_1259:
+*SV_DIM:*
+ RST _NEXT_CHAR
+
+mark_125A:
+*SV_SLICE_QUERY:*
+ CP $10 ;
+ JR Z,SV_SLICE <#SV_SLICE> ; back
+
+ RES 6,(IY+FLAGS-RAMBASE) ; Signal string result
+ RET ; return.
+
+------------------------------------------------------------------------
+
+; THE *'SLICING'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_1263:
+*SLICING:*
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ CALL NZ,STK_FETCH <#STK_FETCH>
+
+ RST _NEXT_CHAR
+ CP ZX_BRACKET_RIGHT; is it ')' ?
+ JR Z,SL_STORE <#SL_STORE> ; forward if so
+
+ PUSH DE ;
+ XOR A ;
+ PUSH AF ;
+ PUSH BC ;
+ LD DE,$0001 ;
+
+ RST _GET_CHAR
+ POP HL ;
+ CP ZX_TO ; is it 'TO' ?
+ JR Z,SL_SECOND <#SL_SECOND> ; forward if so
+
+ POP AF ;
+ CALL INT_EXP2 <#INT_EXP2>
+ PUSH AF ;
+ LD D,B ;
+ LD E,C ;
+ PUSH HL ;
+
+ RST _GET_CHAR
+ POP HL ;
+ CP ZX_TO ; is it 'TO' ?
+ JR Z,SL_SECOND <#SL_SECOND> ; forward if so
+
+ CP ZX_BRACKET_RIGHT; $11
+
+mark_128B:
+*SL_RPT_C:*
+ JP NZ,REPORT_C <#REPORT_C>
+
+ LD H,D ;
+ LD L,E ;
+ JR SL_DEFINE <#SL_DEFINE> ; forward
+
+; ___
+
+mark_1292:
+*SL_SECOND:*
+ PUSH HL ;
+
+ RST _NEXT_CHAR
+ POP HL ;
+ CP ZX_BRACKET_RIGHT; is it ')' ?
+ JR Z,SL_DEFINE <#SL_DEFINE> ; forward if so
+
+ POP AF ;
+ CALL INT_EXP2 <#INT_EXP2>
+ PUSH AF ;
+
+ RST _GET_CHAR
+ LD H,B ;
+ LD L,C ;
+ CP ZX_BRACKET_RIGHT; is it ')' ?
+ JR NZ,SL_RPT_C <#SL_RPT_C> ; back if not
+
+mark_12A5:
+*SL_DEFINE:*
+ POP AF ;
+ EX (SP),HL ;
+ ADD HL,DE ;
+ DEC HL ;
+ EX (SP),HL ;
+ AND A ;
+ SBC HL,DE ;
+ LD BC,$0000 ;
+ JR C,SL_OVER <#SL_OVER> ; forward
+
+ INC HL ;
+ AND A ;
+ JP M,REPORT_3 <#REPORT_3> ; jump back
+
+ LD B,H ;
+ LD C,L ;
+
+mark_12B9:
+*SL_OVER:*
+ POP DE ;
+ RES 6,(IY+FLAGS-RAMBASE) ; Signal string result
+
+mark_12BE:
+*SL_STORE:*
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ RET Z ; return if checking syntax.
+
+------------------------------------------------------------------------
+
+; THE *'STK_STORE'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_12C2:
+*STK_ST_0:*
+ XOR A ;
+
+mark_12C3:
+*STK_STO_STR:*
+ PUSH BC ;
+ CALL TEST_5_SP <#TEST_5_SP>
+ POP BC ;
+ LD HL,(STKEND) ; sv
+ 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 (STKEND),HL ; sv
+ RES 6,(IY+FLAGS-RAMBASE) ; Signal string result
+ RET ; return.
+
+------------------------------------------------------------------------
+
+; THE *'INT EXP'* SUBROUTINES
+------------------------------------------------------------------------
+
+;
+;
+
+mark_12DD:
+*INT_EXP1:*
+ XOR A ;
+
+mark_12DE:
+*INT_EXP2:*
+ PUSH DE ;
+ PUSH HL ;
+ PUSH AF ;
+ CALL CLASS_6 <#CLASS_6>
+ POP AF ;
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ JR Z,I_RESTORE <#I_RESTORE> ; forward if checking syntax
+
+ PUSH AF ;
+ CALL FIND_INT <#FIND_INT>
+ POP DE ;
+ LD A,B ;
+ OR C ;
+ SCF ; Set Carry Flag
+ JR Z,I_CARRY <#I_CARRY> ; forward
+
+ POP HL ;
+ PUSH HL ;
+ AND A ;
+ SBC HL,BC ;
+
+mark_12F9:
+*I_CARRY:*
+ LD A,D ;
+ SBC A,$00 ;
+
+mark_12FC:
+*I_RESTORE:*
+ 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.
+
+mark_12FF:
+*DE_DE_PLUS_ONE:*
+ 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_TIMES_DE'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+
+mark_1305:
+*GET_HL_TIMES_DE:*
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ RET Z ;
+
+ PUSH BC ;
+ LD B,$10 ;
+ LD A,H ;
+ LD C,L ;
+ LD HL,$0000 ;
+
+mark_1311:
+*HL_LOOP:*
+ ADD HL,HL ;
+ JR C,HL_END <#HL_END> ; forward with carry
+
+ RL C ;
+ RLA ;
+ JR NC,HL_AGAIN <#HL_AGAIN> ; forward with no carry
+
+ ADD HL,DE ;
+
+mark_131A:
+*HL_END:*
+ JP C,REPORT_4 <#REPORT_4>
+
+mark_131D:
+*HL_AGAIN:*
+ DJNZ HL_LOOP <#HL_LOOP> ; loop back
+
+ POP BC ;
+ RET ; return.
+
+------------------------------------------------------------------------
+
+; THE *'LET'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_1321:
+*LET:*
+ LD HL,(DEST)
+ BIT 1,(IY+FLAGX-RAMBASE)
+ JR Z,L_EXISTS <#L_EXISTS> ; forward
+
+ LD BC,$0005 ;
+
+mark_132D:
+*L_EACH_CH:*
+ INC BC ;
+
+; check
+
+mark_132E:
+*L_NO_SP:*
+ INC HL ;
+ LD A,(HL) ;
+ AND A ;
+ JR Z,L_NO_SP <#L_NO_SP> ; back
+
+ CALL ALPHANUM <#ALPHANUM>
+ JR C,L_EACH_CH <#L_EACH_CH> ; back
+
+ CP ZX_DOLLAR ; is it '$' ?
+ JP Z,L_NEW_STR <#L_NEW_STR> ; forward if so
+
+
+ RST _BC_SPACES ; BC_SPACES
+ PUSH DE ;
+ LD HL,(DEST) ;
+ DEC DE ;
+ LD A,C ;
+ SUB $06 ;
+ LD B,A ;
+ LD A,$40 ;
+ JR Z,L_SINGLE <#L_SINGLE>
+
+mark_134B:
+*L_CHAR:*
+ INC HL ;
+ LD A,(HL) ;
+ AND A ; is it a space ?
+ JR Z,L_CHAR <#L_CHAR> ; back
+
+ INC DE ;
+ LD (DE),A ;
+ DJNZ L_CHAR <#L_CHAR> ; loop back
+
+ OR $80 ;
+ LD (DE),A ;
+ LD A,$80 ;
+
+mark_1359:
+*L_SINGLE:*
+ LD HL,(DEST) ;
+ XOR (HL) ;
+ POP HL ;
+ CALL L_FIRST <#L_FIRST>
+
+mark_1361:
+*L_NUMERIC:*
+ PUSH HL ;
+
+ RST _FP_CALC ;;
+ DEFB __delete ;;
+ DEFB __end_calc ;;
+
+ POP HL ;
+ LD BC,$0005 ;
+ AND A ;
+ SBC HL,BC ;
+ JR L_ENTER <#L_ENTER> ; forward
+
+; ___
+
+mark_136E:
+*L_EXISTS:*
+ BIT 6,(IY+FLAGS-RAMBASE) ; Numeric or string result?
+ JR Z,L_DELETE_STR <#L_DELETE_STR> ; forward
+
+ LD DE,$0006 ;
+ ADD HL,DE ;
+ JR L_NUMERIC <#L_NUMERIC> ; back
+
+; ___
+
+mark_137A:
+*L_DELETE_STR:*
+ LD HL,(DEST) ;
+ LD BC,(STRLEN) ;
+ BIT 0,(IY+FLAGX-RAMBASE)
+ JR NZ,L_ADD_STR <#L_ADD_STR> ; forward
+
+ LD A,B ;
+ OR C ;
+ RET Z ;
+
+ PUSH HL ;
+
+ RST _BC_SPACES
+ PUSH DE ;
+ PUSH BC ;
+ LD D,H ;
+ LD E,L ;
+ INC HL ;
+ LD (HL),$00 ;
+ LDDR ; Copy Bytes
+ PUSH HL ;
+ CALL STK_FETCH <#STK_FETCH>
+ POP HL ;
+ EX (SP),HL ;
+ AND A ;
+ SBC HL,BC ;
+ ADD HL,BC ;
+ JR NC,L_LENGTH <#L_LENGTH> ; forward
+
+ LD B,H ;
+ LD C,L ;
+
+mark_13A3:
+*L_LENGTH:*
+ EX (SP),HL ;
+ EX DE,HL ;
+ LD A,B ;
+ OR C ;
+ JR Z,L_IN_W_S <#L_IN_W_S> ; forward if zero
+
+ LDIR ; Copy Bytes
+
+mark_13AB:
+*L_IN_W_S:*
+ POP BC ;
+ POP DE ;
+ POP HL ;
+
+------------------------------------------------------------------------
+
+; THE *'L_ENTER'* SUBROUTINE
+;
+; Part of the LET command contains a natural subroutine which is a
+; conditional LDIR. The copy only occurs of BC is non-zero.
+------------------------------------------------------------------------
+
+mark_13AE:
+*L_ENTER:*
+ EX DE,HL ;
+#if ORIGINAL
+#else
+*COND_MV*
+#endif
+ LD A,B ;
+ OR C ;
+ RET Z ;
+
+ PUSH DE ;
+ LDIR ; Copy Bytes
+ POP HL ;
+ RET ; return.
+------------------------------------------------------------------------
+
+mark_13B7:
+*L_ADD_STR:*
+ DEC HL ;
+ DEC HL ;
+ DEC HL ;
+ LD A,(HL) ;
+ PUSH HL ;
+ PUSH BC ;
+
+ CALL L_STRING <#L_STRING>
+
+ POP BC ;
+ POP HL ;
+ INC BC ;
+ INC BC ;
+ INC BC ;
+ JP RECLAIM_2 <#RECLAIM_2> ; jump back to exit via RECLAIM_2
+
+; ___
+
+mark_13C8:
+*L_NEW_STR:*
+ LD A,$60 ; prepare mask %01100000
+ LD HL,(DEST) ;
+ XOR (HL) ;
+
+------------------------------------------------------------------------
+
+; THE *'L_STRING'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+
+mark_13CE:
+*L_STRING:*
+ PUSH AF ;
+ CALL STK_FETCH <#STK_FETCH>
+ EX DE,HL ;
+ ADD HL,BC ;
+ PUSH HL ;
+ INC BC ;
+ INC BC ;
+ INC BC ;
+
+ RST _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 ;
+
+mark_13E7:
+*L_FIRST:*
+ PUSH AF ;
+ CALL REC_V80 <#REC_V80>
+ POP AF ;
+ DEC HL ;
+ LD (HL),A ;
+ LD HL,(STKBOT) ; sv
+ LD (E_LINE),HL ; sv
+ 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.
+
+mark_13F8:
+*STK_FETCH:*
+ LD HL,(STKEND) ; 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 (STKEND),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.
+
+mark_1409:
+*DIM:*
+ CALL LOOK_VARS <#LOOK_VARS>
+
+mark_140C:
+*D_RPORT_C:*
+ JP NZ,REPORT_C <#REPORT_C>
+
+ CALL SYNTAX_Z <#SYNTAX_Z>
+ JR NZ,D_RUN <#D_RUN> ; forward
+
+ RES 6,C ;
+ CALL STK_VAR <#STK_VAR>
+ CALL CHECK_END <#CHECK_END>
+
+mark_141C:
+*D_RUN:*
+ JR C,D_LETTER <#D_LETTER> ; forward
+
+ PUSH BC ;
+ CALL NEXT_ONE <#NEXT_ONE>
+ CALL RECLAIM_2 <#RECLAIM_2>
+ POP BC ;
+
+mark_1426:
+*D_LETTER:*
+ SET 7,C ;
+ LD B,$00 ;
+ PUSH BC ;
+ LD HL,$0001 ;
+ BIT 6,C ;
+ JR NZ,D_SIZE <#D_SIZE> ; forward
+
+ LD L,$05 ;
+
+mark_1434:
+*D_SIZE:*
+ EX DE,HL ;
+
+mark_1435:
+*D_NO_LOOP:*
+ RST _NEXT_CHAR
+ LD H,$40 ;
+ CALL INT_EXP1 <#INT_EXP1>
+ JP C,REPORT_3 <#REPORT_3>
+
+ POP HL ;
+ PUSH BC ;
+ INC H ;
+ PUSH HL ;
+ LD H,B ;
+ LD L,C ;
+ CALL GET_HL_TIMES_DE <#GET_HL_TIMES_DE>
+ EX DE,HL ;
+
+ RST _GET_CHAR
+ CP ZX_COMMA ; $1A == 26
+ JR Z,D_NO_LOOP <#D_NO_LOOP> ; back
+
+ CP ZX_BRACKET_RIGHT; is it ')' ?
+ JR NZ,D_RPORT_C <#D_RPORT_C> ; back if not
+
+
+ RST _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,REPORT_4 <#REPORT_4>
+
+ PUSH DE ;
+ PUSH BC ;
+ PUSH HL ;
+ LD B,H ;
+ LD C,L ;
+ LD HL,(E_LINE) ; sv
+ DEC HL ;
+ CALL MAKE_ROOM <#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),0 ;
+ POP BC ;
+ LDDR ; Copy Bytes
+
+mark_147F:
+*DIM_SIZES:*
+ POP BC ;
+ LD (HL),B ;
+ DEC HL ;
+ LD (HL),C ;
+ DEC HL ;
+ DEC A ;
+ JR NZ,DIM_SIZES <#DIM_SIZES> ; back
+
+ RET ; return.
+
+------------------------------------------------------------------------
+
+; THE *'RESERVE'* ROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_1488:
+*RESERVE:*
+ LD HL,(STKBOT) ; address STKBOT
+ DEC HL ; now last byte of workspace
+ CALL MAKE_ROOM <#MAKE_ROOM>
+ INC HL ;
+ INC HL ;
+ POP BC ;
+ LD (E_LINE),BC ; sv
+ POP BC ;
+ EX DE,HL ;
+ INC HL ;
+ RET ;
+
+------------------------------------------------------------------------
+
+; THE *'CLEAR'* COMMAND ROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_149A:
+*CLEAR:*
+ LD HL,(VARS) ; sv
+ LD (HL),$80 ;
+ INC HL ;
+ LD (E_LINE),HL ; sv
+
+------------------------------------------------------------------------
+
+; THE *'X_TEMP'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_14A3:
+*X_TEMP:*
+ LD HL,(E_LINE) ; sv
+
+------------------------------------------------------------------------
+
+; THE *'SET_STK'* ROUTINES
+------------------------------------------------------------------------
+
+;
+;
+
+mark_14A6:
+*SET_STK_B:*
+ LD (STKBOT),HL ; sv
+
+;
+
+mark_14A9:
+*SET_STK_E:*
+ LD (STKEND),HL ; sv
+ 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.
+
+mark_14AD:
+*CURSOR_IN:*
+ LD HL,(E_LINE) ; fetch start of edit line
+ LD (HL),ZX_CURSOR ; insert cursor character
+
+ INC HL ; point to next location.
+ LD (HL),ZX_NEWLINE ; insert NEWLINE character
+ INC HL ; point to next free location.
+
+ LD (IY+DF_SZ-RAMBASE),2 ; set lower screen display file size
+
+ JR SET_STK_B <#SET_STK_B> ; exit via SET_STK_B above
+
+------------------------------------------------------------------------
+
+; THE *'SET_MIN'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+;
+
+mark_14BC:
+*SET_MIN:*
+ LD HL,$405D ; normal location of calculator's memory area
+ LD (MEM),HL ; update system variable MEM
+ LD HL,(STKBOT) ;
+ JR SET_STK_E <#SET_STK_E> ; back
+
+
+------------------------------------------------------------------------
+
+; THE *'RECLAIM THE END_MARKER'* ROUTINE
+------------------------------------------------------------------------
+
+
+mark_14C7:
+*REC_V80:*
+ LD DE,(E_LINE) ; sv
+ JP RECLAIM_1 <#RECLAIM_1>
+
+------------------------------------------------------------------------
+
+; THE *'ALPHA'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_14CE:
+*ALPHA:*
+ CP ZX_A ; $26
+ JR ALPHA_2 <#ALPHA_2> ; skip forward
+
+
+------------------------------------------------------------------------
+
+; THE *'ALPHANUM'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+mark_14D2:
+*ALPHANUM:*
+ CP ZX_0 ;
+
+
+mark_14D4:
+*ALPHA_2:*
+ CCF ; Complement Carry Flag
+ RET NC ;
+
+ CP $40 ;
+ RET ;
+
+
+------------------------------------------------------------------------
+
+; THE *'DECIMAL TO FLOATING POINT'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+
+mark_14D9:
+*DEC_TO_FP:*
+ CALL INT_TO_FP <#INT_TO_FP> ; gets first part
+ CP ZX_PERIOD ; is character a '.' ?
+ JR NZ,E_FORMAT <#E_FORMAT> ; forward if not
+
+
+ RST _FP_CALC ;;
+ DEFB __stk_one ;;
+ DEFB __st_mem_0 ;;
+ DEFB __delete ;;
+ DEFB __end_calc ;;
+
+
+mark_14E5:
+
+*NXT_DGT_1:*
+ RST _NEXT_CHAR
+ CALL STK_DIGIT <#STK_DIGIT>
+ JR C,E_FORMAT <#E_FORMAT> ; forward
+
+
+ RST _FP_CALC ;;
+ DEFB __get_mem_0 ;;
+ DEFB __stk_ten ;;
+#if ORIGINAL
+ DEFB __division ;
+ DEFB $C0 ;;st-mem-0
+ DEFB __multiply ;;
+#else
+ DEFB $04 ;;+multiply
+ DEFB $C0 ;;st-mem-0
+ DEFB $05 ;;+division
+#endif
+ DEFB __addition ;;
+ DEFB __end_calc ;;
+
+ JR NXT_DGT_1 <#NXT_DGT_1> ; loop back till exhausted
+
+; ___
+
+mark_14F5:
+*E_FORMAT:*
+ CP ZX_E ; is character 'E' ?
+ RET NZ ; return if not
+
+ LD (IY+MEM_0_1st-RAMBASE),$FF ; initialize sv MEM_0_1st to $FF TRUE
+
+ RST _NEXT_CHAR
+ CP ZX_PLUS ; is character a '+' ?
+ JR Z,SIGN_DONE <#SIGN_DONE> ; forward if so
+
+ CP ZX_MINUS ; is it a '-' ?
+ JR NZ,ST_E_PART <#ST_E_PART> ; forward if not
+
+ INC (IY+MEM_0_1st-RAMBASE) ; sv MEM_0_1st change to FALSE
+
+mark_1508:
+*SIGN_DONE:*
+ RST _NEXT_CHAR
+
+mark_1509:
+*ST_E_PART:*
+ CALL INT_TO_FP <#INT_TO_FP>
+
+ RST _FP_CALC ;; m, e.
+ DEFB __get_mem_0 ;; m, e, (1/0) TRUE/FALSE
+ DEFB __jump_true ;;
+ DEFB E_POSTVE <#E_POSTVE> - $ ;;
+ DEFB __negate ;; m, _e
+
+mark_1511:
+*E_POSTVE:*
+ DEFB __e_to_fp ;; x.
+ DEFB __end_calc ;; x.
+
+ RET ; return.
+
+
+------------------------------------------------------------------------
+
+; THE *'STK_DIGIT'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+
+mark_1514:
+*STK_DIGIT:*
+ CP ZX_0 ;
+ RET C ;
+
+ CP ZX_A ; $26
+ CCF ; Complement Carry Flag
+ RET C ;
+
+ SUB ZX_0 ;
+
+------------------------------------------------------------------------
+
+; THE *'STACK_A'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+
+
+mark_151D:
+*STACK_A:*
+ LD C,A ;
+ LD B,0 ;
+
+------------------------------------------------------------------------
+
+; 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.
+
+mark_1520:
+*STACK_BC:*
+ LD IY,ERR_NR ; re-initialize the system variables pointer.
+ PUSH BC ; save the integer value.
+
+; now stack zero, five zero bytes as a starting point.
+
+ RST _FP_CALC ;;
+ DEFB __stk_zero ;; 0.
+ DEFB __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,STK_BC_2 <#STK_BC_2> ; forward if not zero
+
+ 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.
+
+mark_1536:
+*STK_BC_2:*
+ DEC (HL) ; decrement exponent - halving number
+ SLA C ; C<-76543210<-0
+ RL B ; C<-76543210<-C
+ JR NC,STK_BC_2 <#STK_BC_2> ; loop back if no carry
+
+ 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
+------------------------------------------------------------------------
+
+;
+;
+
+mark_1548:
+*INT_TO_FP:*
+ PUSH AF ;
+
+ RST _FP_CALC ;;
+ DEFB __stk_zero ;;
+ DEFB __end_calc ;;
+
+ POP AF ;
+
+mark_154D:
+*NXT_DGT_2:*
+ CALL STK_DIGIT <#STK_DIGIT>
+ RET C ;
+
+ RST _FP_CALC ;;
+ DEFB __exchange ;;
+ DEFB __stk_ten ;;
+ DEFB __multiply ;;
+ DEFB __addition ;;
+ DEFB __end_calc ;;
+
+ RST _NEXT_CHAR
+ JR NXT_DGT_2 <#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.
+
+
+mark_155A:
+*e_to_fp:*
+ RST _FP_CALC ;; x, m.
+ DEFB __duplicate ;; x, m, m.
+ DEFB __less_0 ;; x, m, (1/0).
+ DEFB __st_mem_0 ;; x, m, (1/0).
+ DEFB __delete ;; x, m.
+ DEFB __abs ;; x, +m.
+
+mark_1560:
+*E_LOOP:*
+ DEFB __stk_one ;; x, m,1.
+ DEFB __subtract ;; x, m-1.
+ DEFB __duplicate ;; x, m-1,m-1.
+ DEFB __less_0 ;; x, m-1, (1/0).
+ DEFB __jump_true ;; x, m-1.
+ DEFB E_END <#E_END> - $ ;; x, m-1.
+
+ DEFB __duplicate ;; x, m-1, m-1.
+ DEFB __stk_data ;;
+ DEFB $33 ;;Exponent: $83, Bytes: 1
+
+ DEFB $40 ;;(+00,+00,+00) x, m-1, m-1, 6.
+ DEFB __subtract ;; x, m-1, m-7.
+ DEFB __duplicate ;; x, m-1, m-7, m-7.
+ DEFB __less_0 ;; x, m-1, m-7, (1/0).
+ DEFB __jump_true ;; x, m-1, m-7.
+ DEFB E_LOW <#E_LOW> - $ ;;
+
+; but if exponent m is higher than 7 do a bigger chunk.
+; multiplying (or dividing if negative) by 10 million - 1e7.
+
+ DEFB __exchange ;; x, m-7, m-1.
+ DEFB __delete ;; x, m-7.
+ DEFB __exchange ;; m-7, x.
+ DEFB __stk_data ;;
+ DEFB $80 ;;Bytes: 3
+ DEFB $48 ;;Exponent $98
+ DEFB $18,$96,$80 ;;(+00) m-7, x, 10,000,000 (=f)
+ DEFB __jump ;;
+ DEFB E_CHUNK <#E_CHUNK> - $ ;;
+
+; ___
+
+mark_157A:
+*E_LOW:*
+ DEFB __delete ;; x, m-1.
+ DEFB __exchange ;; m-1, x.
+ DEFB __stk_ten ;; m-1, x, 10 (=f).
+
+mark_157D:
+*E_CHUNK:*
+ DEFB __get_mem_0 ;; m-1, x, f, (1/0)
+ DEFB __jump_true ;; m-1, x, f
+ DEFB E_DIVSN <#E_DIVSN> - $ ;;
+
+ DEFB __multiply ;; m-1, x*f.
+ DEFB __jump ;;
+ DEFB E_SWAP <#E_SWAP> - $ ;;
+
+; ___
+
+mark_1583:
+*E_DIVSN:*
+ DEFB __division ;; m-1, x/f (= new x).
+
+mark_1584:
+*E_SWAP:*
+ DEFB __exchange ;; x, m-1 (= new m).
+ DEFB __jump ;; x, m.
+ DEFB E_LOOP <#E_LOOP> - $ ;;
+
+; ___
+
+mark_1587:
+*E_END:*
+ DEFB __delete ;; x. (-1)
+ DEFB __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
+
+mark_158A:
+*FP_TO_BC:*
+ CALL STK_FETCH <#STK_FETCH> ; exponent to A
+ ; mantissa to EDCB.
+ AND A ; test for value zero.
+ JR NZ,FPBC_NZRO <#FPBC_NZRO> ; forward if not
+
+; 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 FPBC_END <#FPBC_END> ; forward
+
+; ___
+
+; EDCB => BCE
+
+mark_1595:
+*FPBC_NZRO:*
+ 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,FPBC_END <#FPBC_END> ; forward with carry from SUB/CCF
+ ; 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,BIG_INT <#BIG_INT> ; forward with two
+
+ 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
+
+mark_15AF:
+*BIG_INT:*
+ 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,EXP_ZERO <#EXP_ZERO> ; forward if exponent zero
+ ; the number is normalized
+
+mark_15B5:
+*FPBC_NORM:*
+ SRL B ; 0->76543210->C
+ RR C ; C->76543210->C
+
+ DEC D ; decrement exponent
+
+ JR NZ,FPBC_NORM <#FPBC_NORM> ; loop back till zero
+
+mark_15BC:
+*EXP_ZERO:*
+ JR NC,FPBC_END <#FPBC_END> ; forward without carry to NO_ROUND ???
+
+ INC BC ; round up.
+ LD A,B ; test result
+ OR C ; for zero
+ JR NZ,FPBC_END <#FPBC_END> ; forward if not to GRE_ZERO ???
+
+ POP AF ; restore sign flag
+ SCF ; set carry flag to indicate overflow
+ PUSH AF ; save combined flags again
+
+mark_15C6:
+*FPBC_END:*
+ PUSH BC ; save BC value
+
+; set HL and DE to calculator stack pointers.
+
+ RST _FP_CALC ;;
+ DEFB __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
+------------------------------------------------------------------------
+
+;
+;
+
+mark_15CD:
+*FP_TO_A:*
+ CALL FP_TO_BC <#FP_TO_BC>
+ RET C ;
+
+ PUSH AF ;
+ DEC B ;
+ INC B ;
+ JR Z,FP_A_END <#FP_A_END> ; forward if in range
+
+ POP AF ; fetch result
+ SCF ; set carry flag signaling overflow
+ RET ; return
+
+mark_15D9:
+*FP_A_END:*
+ 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.
+
+mark_15DB:
+*PRINT_FP:*
+ RST _FP_CALC ;; x.
+ DEFB __duplicate ;; x, x.
+ DEFB __less_0 ;; x, (1/0).
+ DEFB __jump_true ;;
+ DEFB PF_NEGTVE <#PF_NEGTVE> - $ ;; x.
+
+ DEFB __duplicate ;; x, x
+ DEFB __greater_0 ;; x, (1/0).
+ DEFB __jump_true ;;
+ DEFB PF_POSTVE <#PF_POSTVE> - $ ;; x.
+
+ DEFB __delete ;; .
+ DEFB __end_calc ;; .
+
+ LD A,ZX_0 ; load accumulator with character '0'
+
+ RST _PRINT_A
+ RET ; return. >>
+
+; ___
+
+mark_15EA:
+*PF_NEGTVE:*
+ DEFB __abs ;; +x.
+ DEFB __end_calc ;; x.
+
+ LD A,ZX_MINUS ; load accumulator with '-'
+
+ RST _PRINT_A
+
+ RST _FP_CALC ;; x.
+
+mark_15F0:
+*PF_POSTVE:*
+ DEFB __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 STACK_A <#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 _FP_CALC ;; x, e.
+ DEFB __stk_data ;;
+ DEFB $78 ;;Exponent: $88, Bytes: 2
+ DEFB $00,$80 ;;(+00,+00) x, e, 128.5.
+ DEFB __subtract ;; x, e -.5.
+ DEFB __stk_data ;;
+ DEFB $EF ;;Exponent: $7F, Bytes: 4
+ DEFB $1A,$20,$9A,$85 ;; .30103 (log10 2)
+ DEFB __multiply ;; x,
+ DEFB __int ;;
+ DEFB __st_mem_1 ;; x, n.
+
+
+ DEFB __stk_data ;;
+ DEFB $34 ;;Exponent: $84, Bytes: 1
+ DEFB $00 ;;(+00,+00,+00) x, n, 8.
+
+ DEFB __subtract ;; x, n-8.
+ DEFB __negate ;; x, 8-n.
+ DEFB __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 __stk_half ;;
+ DEFB __addition ;;
+ DEFB __int ;; i.
+ DEFB __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,10 ; count is ten digits.
+
+mark_1615:
+*PF_LOOP:*
+ INC HL ; increase pointer
+
+ PUSH HL ; preserve buffer address.
+ PUSH BC ; preserve counter.
+
+ RST _FP_CALC ;; i.
+ DEFB __stk_ten ;; i, 10.
+ DEFB __n_mod_m ;; i mod 10, i/10
+ DEFB __exchange ;; i/10, remainder.
+ DEFB __end_calc ;;
+
+ CALL FP_TO_A <#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 PF_LOOP <#PF_LOOP> ; loop back for all ten
+
+; 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.
+
+mark_162C:
+*PF_NULL:*
+ DEC HL ; decrease pointer
+ LD A,(HL) ; fetch masked digit
+ CP $90 ; is it a leading zero ?
+ JR Z,PF_NULL <#PF_NULL> ; loop back if so
+
+; 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.
+
+mark_1639:
+*PF_RND_LP:*
+ POP AF ; retrieve carry from machine stack.
+ INC HL ; increment address
+ LD A,(HL) ; fetch new byte
+ ADC A,0 ; 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,PF_RND_LP <#PF_RND_LP> ; back if a zero
+ ; 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,6 ; the count is six.
+
+mark_164B:
+*PF_ZERO_6:*
+ LD (HL),$80 ; insert a masked zero
+ DEC HL ; decrease pointer.
+ DJNZ PF_ZERO_6 <#PF_ZERO_6> ; loop back for all six
+
+; 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 _FP_CALC ;; 0.
+ DEFB __delete ;; .
+ DEFB __get_mem_1 ;; n.
+ DEFB __end_calc ;; n.
+
+ CALL FP_TO_A <#FP_TO_A>
+ JR Z,PF_POS <#PF_POS> ; skip forward if positive
+
+ NEG ; negate makes positive
+
+mark_165B:
+*PF_POS:*
+ LD E,A ; transfer count of digits to E
+ INC E ; increment twice
+ INC E ;
+ POP HL ; * retrieve pointer to one past buffer.
+
+mark_165F:
+*GET_FIRST:*
+ DEC HL ; decrement address.
+ DEC E ; decrement digit counter.
+ LD A,(HL) ; fetch masked byte.
+ AND $0F ; isolate right-hand nibble.
+ JR Z,GET_FIRST <#GET_FIRST> ; back with leading zero
+
+; now determine if E-format printing is needed
+
+ LD A,E ; transfer now accurate number count to A.
+ SUB 5 ; subtract five
+ CP 8 ; compare with 8 as maximum digits is 13.
+ JP P,PF_E_FMT <#PF_E_FMT> ; forward if positive to PF_E_FMT
+
+ CP $F6 ; test for more than four zeros after point.
+ JP M,PF_E_FMT <#PF_E_FMT> ; forward if so to PF_E_FMT
+
+ ADD A,6 ; test for zero leading digits, e.g. 0.5
+ JR Z,PF_ZERO_1 <#PF_ZERO_1> ; forward if so to PF_ZERO_1
+
+ JP M,PF_ZEROS <#PF_ZEROS> ; 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.
+
+mark_167B:
+*PF_NIB_LP:*
+ CALL PF_NIBBLE <#PF_NIBBLE>
+ DJNZ PF_NIB_LP <#PF_NIB_LP> ; loop back for counted numbers
+
+ JR PF_DC_OUT <#PF_DC_OUT> ; forward to consider decimal part to PF_DC_OUT
+
+; ___
+
+mark_1682:
+*PF_E_FMT:*
+ LD B,E ; count to B
+ CALL PF_NIBBLE <#PF_NIBBLE> ; prints one digit.
+ CALL PF_DC_OUT <#PF_DC_OUT> ; considers fractional part.
+
+ LD A,ZX_E ;
+ RST _PRINT_A
+
+ LD A,B ; transfer exponent to A
+ AND A ; test the sign.
+ JP P,PF_E_POS <#PF_E_POS> ; forward if positive to PF_E_POS
+
+ NEG ; negate the negative exponent.
+ LD B,A ; save positive exponent in B.
+
+ LD A,ZX_MINUS ;
+ JR PF_E_SIGN <#PF_E_SIGN> ; skip forward to PF_E_SIGN
+
+; ___
+
+mark_1698:
+*PF_E_POS:*
+ LD A,ZX_PLUS ;
+
+mark_169A:
+*PF_E_SIGN:*
+ RST _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.
+
+mark_169E:
+*PF_E_TENS:*
+ INC B ; increment ten count
+ SUB 10 ; subtract ten from exponent
+ JR NC,PF_E_TENS <#PF_E_TENS> ; loop back if greater than ten
+
+ ADD A,10 ; 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,PF_E_LOW <#PF_E_LOW> ; skip forward if so to PF_E_LOW
+
+ CALL OUT_CODE <#OUT_CODE> ; prints as digit '1' - '9'
+
+mark_16AD:
+*PF_E_LOW:*
+ LD A,C ; low byte to A
+ CALL OUT_CODE <#OUT_CODE> ; prints final digit of the
+ ; exponent.
+ RET ; return. >>
+
+------------------------------------------------------------------------
+
+; THE *'FLOATING POINT PRINT ZEROS'* LOOP
+; -------------------------------------
+; This branch deals with zeros after decimal point.
+; e.g. .01 or .0000999
+; Note. that printing to the ZX Printer destroys A and that A should be
+; initialized to '0' at each stage of the loop.
+; Originally LPRINT .00001 printed as .0XYZ1
+------------------------------------------------------------------------
+
+mark_16B2:
+*PF_ZEROS:*
+ NEG ; negate makes number positive 1 to 4.
+ LD B,A ; zero count to B.
+
+ LD A,ZX_PERIOD ; prepare character '.'
+ RST _PRINT_A
+
+
+#if ORIGINAL
+ LD A,ZX_0 ; prepare a '0'
+*PFZROLP*
+ RST _PRINT_A
+ DJNZ PFZROLP <#PFZROLP> ; obsolete loop back to PFZROLP
+#else
+*PF_ZRO_LP*
+ LD A,ZX_0 ; prepare a '0' in the accumulator each time.
+ RST _PRINT_A
+ DJNZ PF_ZRO_LP <#PF_ZRO_LP> ;+ New loop back to PF-ZRO-LP
+#endif
+
+ JR PF_FRAC_LP <#PF_FRAC_LP> ; forward
+
+; there is a need to print a leading zero e.g. 0.1 but not with .01
+
+mark_16BF:
+*PF_ZERO_1:*
+ LD A,ZX_0 ; prepare character '0'.
+ RST _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.
+
+mark_16C2:
+*PF_DC_OUT:*
+ 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,ZX_PERIOD ; prepare character '.'
+ RST _PRINT_A
+
+; now enter a loop to print trailing digits
+
+mark_16C8:
+*PF_FRAC_LP:*
+ DEC (HL) ; test for a marked zero.
+ INC (HL) ;
+ RET PE ; return when digits exhausted >>
+
+ CALL PF_NIBBLE <#PF_NIBBLE>
+ JR PF_FRAC_LP <#PF_FRAC_LP> ; back for all fractional digits
+
+; ___
+
+; subroutine to print right-hand nibble
+
+mark_16D0:
+*PF_NIBBLE:*
+ LD A,(HL) ; fetch addressed byte
+ AND $0F ; mask off lower 4 bits
+ CALL OUT_CODE <#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.
+
+
+mark_16D8:
+*PREP_ADD:*
+ LD A,(HL) ; fetch exponent.
+ LD (HL),0 ; 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.
+
+mark_16EC:
+*NEG_BYTE:*
+ DEC HL ; point to first or more significant byte.
+ LD A,(HL) ; fetch to accumulator.
+ CPL ; complement.
+ ADC A,0 ; add in initial carry or any subsequent carry.
+ LD (HL),A ; place number back.
+ DJNZ NEG_BYTE <#NEG_BYTE> ; loop back five times
+
+ 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
+
+mark_16F7:
+*FETCH_TWO:*
+ 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
+
+mark_171A:
+*SHIFT_FP:*
+ AND A ; test difference between exponents.
+ RET Z ; return if zero. both normal.
+
+ CP 33 ; compare with 33 bits.
+ JR NC,ADDEND_0 <#ADDEND_0> ; forward if greater than 32
+
+ 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
+
+mark_1722:
+*ONE_SHIFT:*
+ 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 ONE_SHIFT <#ONE_SHIFT> ; loop back B times
+
+ 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 ADD_BACK <#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.
+
+mark_1736:
+*ADDEND_0:*
+ 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.
+
+mark_1738:
+*ZEROS_4_OR_5:*
+ LD L,0 ; 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.
+
+mark_1741:
+*ADD_BACK:*
+ INC E ;
+ RET NZ ;
+
+ INC D ;
+ RET NZ ;
+
+ EXX ;
+ INC E ;
+ JR NZ,ALL_ADDED <#ALL_ADDED> ; forward if no overflow
+
+ INC D ;
+
+mark_174A:
+*ALL_ADDED:*
+ EXX ;
+ RET ; return with zero flag set for zero mantissa.
+
+
+------------------------------------------------------------------------
+
+; THE *'SUBTRACTION'* OPERATION
+------------------------------------------------------------------------
+
+; just switch the sign of subtrahend and do an add.
+
+mark_174C:
+*SUBTRACT:*
+ 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.
+
+mark_1755:
+*ADDITION:*
+ 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 PREP_ADD <#PREP_ADD>
+ LD B,A ; save first exponent byte in B.
+ EX DE,HL ; switch number pointers.
+ CALL PREP_ADD <#PREP_ADD>
+ LD C,A ; save second exponent byte in C.
+ CP B ; compare the exponent bytes.
+ JR NC,SHIFT_LEN <#SHIFT_LEN> ; forward if second higher
+
+ LD A,B ; else higher exponent to A
+ LD B,C ; lower exponent to B
+ EX DE,HL ; switch the number pointers.
+
+mark_1769:
+*SHIFT_LEN:*
+ PUSH AF ; save higher exponent
+ SUB B ; subtract lower exponent
+
+ CALL FETCH_TWO <#FETCH_TWO>
+ CALL SHIFT_FP <#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,TEST_NEG <#TEST_NEG> ; skip forward if not
+
+; 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,1 ; one shift required.
+ CALL SHIFT_FP <#SHIFT_FP> ; performs a single shift
+ ; rounding any lost bit
+ INC (HL) ; increment the exponent.
+ JR Z,ADD_REP_6 <#ADD_REP_6> ; 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.
+
+mark_1790:
+*TEST_NEG:*
+ 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,GO_NC_MLT <#GO_NC_MLT> ; 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,0 ;
+ LD D,A ;
+
+ EXX ; switch to higher (leftmost) 16 bits.
+
+ LD A,E ; ditto
+ CPL ;
+ ADC A,0 ;
+ LD E,A ;
+
+ LD A,D ; ditto
+ CPL ;
+ ADC A,0 ;
+ JR NC,END_COMPL <#END_COMPL> ; 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.
+
+mark_17B3:
+*ADD_REP_6:*
+ JP Z,REPORT_6 <#REPORT_6> ; jump forward if exponent now zero to REPORT_6
+ ; 'Number too big'
+
+ EXX ; switch back to alternate set.
+
+mark_17B7:
+*END_COMPL:*
+ LD D,A ; put first byte of mantissa back in DE.
+ EXX ; switch to main set.
+
+mark_17B9:
+*GO_NC_MLT:*
+ XOR A ; clear carry flag and
+ ; clear accumulator so no extra bits carried
+ ; forward as occurs in multiplication.
+
+ JR TEST_NORM <#TEST_NORM> ; 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.
+
+mark_17BC:
+*PREP_MULTIPLY_OR_DIVIDE:*
+ 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
+------------------------------------------------------------------------
+
+;
+;
+
+mark_17C6:
+*MULTIPLY:*
+ XOR A ; reset bit 7 of running sign flag.
+ CALL PREP_MULTIPLY_OR_DIVIDE <#PREP_MULTIPLY_OR_DIVIDE>
+ 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 PREP_MULTIPLY_OR_DIVIDE <#PREP_MULTIPLY_OR_DIVIDE>
+
+ EX DE,HL ; HL first number, DE - second number
+ JR C,ZERO_RESULT <#ZERO_RESULT> ; forward with carry to ZERO_RESULT
+ ; anything * zero = zero.
+
+ PUSH HL ; save pointer to first number.
+
+ CALL FETCH_TWO <#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,33 ; register B can now be used to count 33 shifts.
+ JR STRT_MLT <#STRT_MLT> ; forward to loop entry point STRT_MLT
+
+; ___
+
+; The multiplication loop is entered at STRT_LOOP.
+
+mark_17E7:
+*MLT_LOOP:*
+ JR NC,NO_ADD <#NO_ADD> ; forward if no carry
+
+ ; 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
+
+mark_17EE:
+*NO_ADD:*
+ 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
+
+mark_17F8:
+*STRT_MLT:*
+ 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 MLT_LOOP <#MLT_LOOP> ; loop back 33 timeS
+
+;
+
+ EX DE,HL ;
+ EXX ;
+ EX DE,HL ;
+ EXX ;
+ POP BC ;
+ POP HL ;
+ LD A,B ;
+ ADD A,C ;
+ JR NZ,MAKE_EXPT <#MAKE_EXPT> ; forward
+
+ AND A ;
+
+mark_180E:
+*MAKE_EXPT:*
+ DEC A ;
+ CCF ; Complement Carry Flag
+
+mark_1810:
+*DIVN_EXPT:*
+ RLA ;
+ CCF ; Complement Carry Flag
+ RRA ;
+ JP P,OFLW1_CLR <#OFLW1_CLR>
+
+ JR NC,REPORT_6 <#REPORT_6>
+
+ AND A ;
+
+mark_1819:
+*OFLW1_CLR:*
+ INC A ;
+ JR NZ,OFLW2_CLR <#OFLW2_CLR>
+
+ JR C,OFLW2_CLR <#OFLW2_CLR>
+
+ EXX ;
+ BIT 7,D ;
+ EXX ;
+ JR NZ,REPORT_6 <#REPORT_6>
+
+mark_1824:
+*OFLW2_CLR:*
+ LD (HL),A ;
+ EXX ;
+ LD A,B ;
+ EXX ;
+
+; addition joins here with carry flag clear.
+
+mark_1828:
+*TEST_NORM:*
+ JR NC,NORMALIZE <#NORMALIZE> ; forward
+
+ LD A,(HL) ;
+ AND A ;
+
+mark_182C:
+*NEAR_ZERO:*
+ LD A,$80 ; prepare to rescue the most significant bit
+ ; of the mantissa if it is set.
+ JR Z,SKIP_ZERO <#SKIP_ZERO> ; skip forward
+
+mark_1830:
+*ZERO_RESULT:*
+ XOR A ; make mask byte zero signaling set five
+ ; bytes to zero.
+
+mark_1831:
+*SKIP_ZERO:*
+ EXX ; switch in alternate set
+ AND D ; isolate most significant bit (if A is $80).
+
+ CALL ZEROS_4_OR_5 <#ZEROS_4_OR_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,OFLOW_CLR <#OFLOW_CLR> ; forward if first case
+
+ 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 OFLOW_CLR <#OFLOW_CLR> ; forward
+
+; ___
+
+; this branch is common to addition and multiplication with the mantissa
+; result still in registers D'E'D E .
+
+mark_183F:
+*NORMALIZE:*
+ LD B,32 ; a maximum of thirty-two left shifts will be
+ ; needed.
+
+mark_1841:
+*SHIFT_ONE:*
+ EXX ; address higher 16 bits.
+ BIT 7,D ; test the leftmost bit
+ EXX ; address lower 16 bits.
+
+ JR NZ,NORML_NOW <#NORML_NOW> ; forward if leftmost bit was set
+
+ 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,NEAR_ZERO <#NEAR_ZERO> ; back if exponent becomes zero
+ ; it's just possible that the last rotation
+ ; set bit 7 of D. We shall see.
+
+ DJNZ SHIFT_ONE <#SHIFT_ONE> ; loop back
+
+; if thirty-two left shifts were performed without setting the most significant
+; bit then the result is zero.
+
+ JR ZERO_RESULT <#ZERO_RESULT> ; back
+
+; ___
+
+mark_1859:
+*NORML_NOW:*
+ RLA ; for the addition path, A is always zero.
+ ; for the mult path, ...
+
+ JR NC,OFLOW_CLR <#OFLOW_CLR> ; forward
+
+; this branch is taken only with multiplication.
+
+ CALL ADD_BACK <#ADD_BACK>
+
+ JR NZ,OFLOW_CLR <#OFLOW_CLR> ; forward
+
+ EXX ;
+ LD D,$80 ;
+ EXX ;
+ INC (HL) ;
+ JR Z,REPORT_6 <#REPORT_6> ; forward
+
+; now transfer the mantissa from the register sets to the calculator stack
+; incorporating the sign bit already there.
+
+mark_1868:
+*OFLOW_CLR:*
+ 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.
+
+; ___
+
+mark_1880:
+*REPORT_6:*
+ RST _ERROR_1
+ DEFB 5 ; 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.
+
+mark_1882:
+*DIVISION:*
+ EX DE,HL ; consider the second number first.
+ XOR A ; set the running sign flag.
+ CALL PREP_MULTIPLY_OR_DIVIDE <#PREP_MULTIPLY_OR_DIVIDE>
+ JR C,REPORT_6 <#REPORT_6> ; back if zero
+ ; 'Arithmetic overflow'
+
+ EX DE,HL ; now prepare first number and check for zero.
+ CALL PREP_MULTIPLY_OR_DIVIDE <#PREP_MULTIPLY_OR_DIVIDE>
+ 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 FETCH_TWO <#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 DIVISION_START <#DIVISION_START> ; forward to mid-loop entry point
+
+; ___
+
+mark_18A2:
+*DIV_LOOP:*
+ RLA ; multiply partial quotient by two
+ RL C ; setting result bit from carry.
+ EXX ;
+ RL C ;
+ RL B ;
+ EXX ;
+
+mark_18AB:
+*DIV_34TH:*
+ ADD HL,HL ;
+ EXX ;
+ ADC HL,HL ;
+ EXX ;
+ JR C,SUBN_ONLY <#SUBN_ONLY> ; forward
+
+mark_18B2:
+*DIVISION_START:*
+ SBC HL,DE ; subtract divisor part.
+ EXX ;
+ SBC HL,DE ;
+ EXX ;
+ JR NC,NUM_RESTORE <#NUM_RESTORE> ; forward if subtraction goes
+
+ ADD HL,DE ; else restore
+ EXX ;
+ ADC HL,DE ;
+ EXX ;
+ AND A ; clear carry
+ JR COUNT_ONE <#COUNT_ONE> ; forward
+
+; ___
+
+mark_18C2:
+*SUBN_ONLY:*
+ AND A ;
+ SBC HL,DE ;
+ EXX ;
+ SBC HL,DE ;
+ EXX ;
+
+mark_18C9:
+*NUM_RESTORE:*
+ SCF ; set carry flag
+
+mark_18CA:
+*COUNT_ONE:*
+ INC B ; increment the counter
+ JP M,DIV_LOOP <#DIV_LOOP> ; back while still minus to DIV_LOOP
+
+ PUSH AF ;
+ JR Z,DIVISION_START <#DIVISION_START> ; 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,DIV_34TH)
+;
+; 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 DIVN_EXPT <#DIVN_EXPT> ; jump back
+
+------------------------------------------------------------------------
+
+; THE *'INTEGER TRUNCATION TOWARDS ZERO'* SUBROUTINE
+------------------------------------------------------------------------
+
+;
+
+mark_18E4:
+*TRUNCATE:*
+ LD A,(HL) ; fetch exponent
+ CP $81 ; compare to +1
+ JR NC,T_GR_ZERO <#T_GR_ZERO> ; forward, if 1 or more
+
+; 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 NIL_BYTES <#NIL_BYTES> ; forward
+
+; ___
+
+mark_18EF:
+*T_GR_ZERO:*
+ 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.
+
+mark_18F4:
+*NIL_BYTES:*
+ 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,BITS_ZERO <#BITS_ZERO> ; forward if zero
+
+; else the original count was eight or more and whole bytes can be blanked.
+
+mark_1900:
+*BYTE_ZERO:*
+ LD (HL),0 ; set eight bits to zero.
+ DEC HL ; point to more significant byte of mantissa.
+ DJNZ BYTE_ZERO <#BYTE_ZERO> ; loop back
+
+; now consider any residual bits.
+
+mark_1905:
+*BITS_ZERO:*
+ AND $07 ; isolate the remaining bits
+ JR Z,IX_END <#IX_END> ; forward if none
+
+ LD B,A ; transfer bit count to B counter.
+ LD A,$FF ; form a mask 11111111
+
+mark_190C:
+*LESS_MASK:*
+ SLA A ; 1 <- 76543210 <- o slide mask leftwards.
+ DJNZ LESS_MASK <#LESS_MASK> ; loop back for bit count
+
+ AND (HL) ; lose the unwanted rightmost bits
+ LD (HL),A ; and place in mantissa byte.
+
+mark_1912:
+*IX_END:*
+ EX DE,HL ; restore result pointer from DE.
+ POP DE ; restore STKEND from stack.
+ RET ; return.
+
+------------------------------------------------------------------------
+
+; Up to this point all routine addresses have been maintained so that the
+; modified ROM is compatible with any machine-code software that uses ROM
+; routines.
+; The final section does not maintain address entry points as the routines
+; within are not generally called directly.
+------------------------------------------------------------------------
+
+;** 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.
+
+
+*TAB_CNST*
+
+#if ORIGINAL
+mark_1915:
+** ; 00 00 00 00 00
+stk_zero:
+ DEFB $00 ;;Bytes: 1
+ DEFB $B0 ;;Exponent $00
+ DEFB $00 ;;(+00,+00,+00)
+
+mark_1918:
+** ; 81 00 00 00 00
+stk_one:
+ DEFB $31 ;;Exponent $81, Bytes: 1
+ DEFB $00 ;;(+00,+00,+00)
+
+
+mark_191A:
+** ; 80 00 00 00 00
+stk_half:
+ DEFB $30 ;;Exponent: $80, Bytes: 1
+ DEFB $00 ;;(+00,+00,+00)
+
+
+mark_191C:
+** ; 81 49 0F DA A2
+stk_half_pi:
+ DEFB $F1 ;;Exponent: $81, Bytes: 4
+ DEFB $49,$0F,$DA,$A2 ;;
+
+mark_1921:
+** ; 84 20 00 00 00
+stk_ten:
+ DEFB $34 ;;Exponent: $84, Bytes: 1
+ DEFB $20 ;;(+00,+00,+00)
+#else
+; This table has been modified so that the constants are held in their
+; uncompressed, ready-to-use, 5-byte form.
+
+ DEFB $00 ; the value zero.
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+
+ DEFB $81 ; the floating point value 1.
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+
+ DEFB $80 ; the floating point value 1/2.
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+
+ DEFB $81 ; the floating point value pi/2.
+ DEFB $49 ;
+ DEFB $0F ;
+ DEFB $DA ;
+ DEFB $A2 ;
+
+ DEFB $84 ; the floating point value ten.
+ DEFB $20 ;
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+#endif
+
+------------------------------------------------------------------------
+
+; THE *'TABLE OF ADDRESSES'*
+------------------------------------------------------------------------
+
+;
+; starts with binary operations which have two operands and one result.
+; three pseudo binary operations first.
+
+#if ORIGINAL
+mark_1923:
+#else
+#endif
+
+*tbl_addrs:*
+
+ DEFW jump_true <#jump_true> ; $00 Address: $1C2F - jump_true
+ DEFW exchange <#exchange> ; $01 Address: $1A72 - exchange
+ DEFW delete <#delete> ; $02 Address: $19E3 - delete
+
+; true binary operations.
+
+ DEFW SUBTRACT <#SUBTRACT> ; $03 Address: $174C - subtract
+ DEFW MULTIPLY <#MULTIPLY> ; $04 Address: $176C - multiply
+ DEFW DIVISION <#DIVISION> ; $05 Address: $1882 - division
+ DEFW to_power <#to_power> ; $06 Address: $1DE2 - to_power
+ DEFW or <#or> ; $07 Address: $1AED - or
+
+ DEFW boolean_num_and_num <#boolean_num_and_num> ; $08 Address: $1AF3 - boolean_num_and_num
+ DEFW num_l_eql <#num_l_eql> ; $09 Address: $1B03 - num_l_eql
+ DEFW num_gr_eql <#num_gr_eql> ; $0A Address: $1B03 - num_gr_eql
+ DEFW nums_neql <#nums_neql> ; $0B Address: $1B03 - nums_neql
+ DEFW num_grtr <#num_grtr> ; $0C Address: $1B03 - num_grtr
+ DEFW num_less <#num_less> ; $0D Address: $1B03 - num_less
+ DEFW nums_eql <#nums_eql> ; $0E Address: $1B03 - nums_eql
+ DEFW ADDITION <#ADDITION> ; $0F Address: $1755 - addition
+
+ DEFW strs_and_num <#strs_and_num> ; $10 Address: $1AF8 - str_and_num
+ DEFW str_l_eql <#str_l_eql> ; $11 Address: $1B03 - str_l_eql
+ DEFW str_gr_eql <#str_gr_eql> ; $12 Address: $1B03 - str_gr_eql
+ DEFW strs_neql <#strs_neql> ; $13 Address: $1B03 - strs_neql
+ DEFW str_grtr <#str_grtr> ; $14 Address: $1B03 - str_grtr
+ DEFW str_less <#str_less> ; $15 Address: $1B03 - str_less
+ DEFW strs_eql <#strs_eql> ; $16 Address: $1B03 - strs_eql
+ DEFW strs_add <#strs_add> ; $17 Address: $1B62 - strs_add
+
+; unary follow
+
+ DEFW neg <#neg> ; $18
+ DEFW code <#code> ; $19
+ DEFW val <#val> ; $1A
+ DEFW len <#len> ; $1B
+ DEFW sin <#sin> ; $1C
+ DEFW cos <#cos> ; $1D
+ DEFW tan <#tan> ; $1E
+ DEFW asn <#asn> ; $1F
+ DEFW acs <#acs> ; $20
+ DEFW atn <#atn> ; $21
+ DEFW ln <#ln> ; $22
+ DEFW exp <#exp> ; $23
+ DEFW int <#int> ; $24
+ DEFW sqr <#sqr> ; $25
+ DEFW sgn <#sgn> ; $26
+ DEFW abs <#abs> ; $27
+ DEFW PEEK <#PEEK> ; $28 Address: $1A1B - peek !!!!
+ DEFW usr_num <#usr_num> ; $29
+ DEFW str_dollar <#str_dollar> ; $2A
+ DEFW chr_dollar <#chr_dollar> ; $2B
+ DEFW not <#not> ; $2C
+
+; end of true unary
+
+ DEFW duplicate <#duplicate> ; $2D
+ DEFW n_mod_m <#n_mod_m> ; $2E
+
+ DEFW jump <#jump> ; $2F
+ DEFW stk_data <#stk_data> ; $30
+
+ DEFW dec_jr_nz <#dec_jr_nz> ; $31
+ DEFW less_0 <#less_0> ; $32
+ DEFW greater_0 <#greater_0> ; $33
+ DEFW end_calc <#end_calc> ; $34
+ DEFW get_argt <#get_argt> ; $35
+ DEFW TRUNCATE <#TRUNCATE> ; $36
+ DEFW FP_CALC_2 <#FP_CALC_2> ; $37
+ DEFW e_to_fp <#e_to_fp> ; $38
+
+; the following are just the next available slots for the 128 compound literals
+; which are in range $80 - $FF.
+
+ DEFW series_xx <#series_xx> ; $39 : $80 - $9F.
+ DEFW stk_const_xx <#stk_const_xx> ; $3A : $A0 - $BF.
+ DEFW st_mem_xx <#st_mem_xx> ; $3B : $C0 - $DF.
+ DEFW get_mem_xx <#get_mem_xx> ; $3C : $E0 - $FF.
+
+; Aside: 3D - 7F are therefore unused calculator literals.
+; 39 - 7B would be available for expansion.
+
+------------------------------------------------------------------------
+
+; THE *'FLOATING POINT CALCULATOR'*
+------------------------------------------------------------------------
+
+;
+;
+
+mark_199D:
+*CALCULATE:*
+ CALL STACK_POINTERS <#STACK_POINTERS> ; 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...
+
+mark_19A0:
+*GEN_ENT_1:*
+ LD A,B ; fetch the Z80 B register to A
+ LD (BERG),A ; and store value in system variable BERG.
+ ; this will be the counter for dec_jr_nz
+ ; or if used from FP_CALC2 the calculator
+ ; instruction.
+
+; ... and again later at this point
+
+mark_19A4:
+*GEN_ENT_2:*
+ 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.
+
+mark_19A7:
+*RE_ENTRY:*
+ LD (STKEND),DE ; save end of stack
+ EXX ; switch to alt
+ LD A,(HL) ; get next literal
+ INC HL ; increase pointer'
+
+; single operation jumps back to here
+
+mark_19AE:
+*SCAN_ENT:*
+ PUSH HL ; save pointer on stack *
+ AND A ; now test the literal
+ JP P,FIRST_3D <#FIRST_3D> ; forward 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 ENT_TABLE <#ENT_TABLE> ; forward
+
+; ___
+
+; the branch was here with simple literals.
+
+mark_19C2:
+*FIRST_3D:*
+ CP $18 ; compare with first unary operations.
+ JR NC,DOUBLE_A <#DOUBLE_A> ; with unary operations
+
+; it is binary so adjust pointers.
+
+ EXX ;
+ LD BC,-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 ;
+
+mark_19CE:
+*DOUBLE_A:*
+ RLCA ; double the literal
+ LD L,A ; and store in L for indexing
+
+mark_19D0:
+*ENT_TABLE:*
+ LD DE,tbl_addrs <#tbl_addrs> ; 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,RE_ENTRY <#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,(STKEND+1) ; STKEND_hi
+ ; nothing much goes to C but BERG 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
+
+mark_19E3:
+*delete:*
+ 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.
+
+mark_19E4:
+*FP_CALC_2:*
+ POP AF ; drop return address.
+ LD A,(BERG) ; load accumulator from system variable BERG
+ ; value will be literal eg. 'tan'
+ EXX ; switch to alt
+ JR SCAN_ENT <#SCAN_ENT> ; back
+ ; 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.
+
+mark_19EB:
+*TEST_5_SP:*
+ PUSH DE ; save
+ PUSH HL ; registers
+ LD BC,5 ; an overhead of five bytes
+ CALL TEST_ROOM <#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
+
+mark_19F6:
+*duplicate:*
+*MOVE_FP:*
+ CALL TEST_5_SP <#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.
+
+mark_19FC:
+*stk_data:*
+ LD H,D ; transfer STKEND
+ LD L,E ; to HL for result.
+
+mark_19FE:
+*STK_CONST:*
+ CALL TEST_5_SP <#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.
+
+#if ORIGINAL
+ PUSH BC ; save BC - value 5 from test room ??.
+#else
+;; PUSH BC ; save BC - value 5 from test room. No need.
+#endif
+ 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,FORM_EXP <#FORM_EXP> ; 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).
+
+mark_1A14:
+*FORM_EXP:*
+ 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
+
+
+#if ORIGINAL
+ LD B,$00 ; prepare to copy. Note. B is zero.
+ LDIR ; copy C bytes
+ POP BC ; restore 5 counter to BC.
+#else
+ LDIR ; copy C bytes
+#endif
+
+ 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
+
+mark_1A27:
+*STK_ZEROS:*
+ 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 STK_ZEROS <#STK_ZEROS> ; loop back 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.
+
+#if ORIGINAL
+mark_1A2D:
+*SKIP_CONS:*
+ AND A ; test if initially zero.
+
+mark_1A2E:
+*SKIP_NEXT:*
+ 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 STK_CONST <#STK_CONST> ; works through variable
+ ; length records.
+
+ POP DE ; restore real STKEND
+ POP AF ; restore count
+ DEC A ; decrease
+ JR SKIP_NEXT <#SKIP_NEXT> ; loop back
+#else
+; Since the table now uses uncompressed values, some extra ROM space is
+; required for the table but much more is released by getting rid of routines
+; like this.
+#endif
+
+------------------------------------------------------------------------
+
+; 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.
+
+mark_1A3C:
+*LOC_MEM:*
+ 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.
+
+mark_1A45:
+*get_mem_xx:*
+
+#if ORIGINAL
+ PUSH DE ; save STKEND
+ LD HL,(MEM) ; MEM is base address of the memory cells.
+#else
+ ; Note. first two instructions have been swapped to create a subroutine.
+ LD HL,(MEM) ; MEM is base address of the memory cells.
+*INDEX_5* ; new label
+ PUSH DE ; save STKEND
+#endif
+ CALL LOC_MEM <#LOC_MEM> ; so that HL = first byte
+ CALL MOVE_FP <#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
+------------------------------------------------------------------------
+
+
+*stk_const_xx:*
+#if ORIGINAL
+
+; offset $A0: 'stk_zero'
+; offset $A1: 'stk_one'
+; offset $A2: 'stk_half'
+; offset $A3: 'stk_half_pi'
+; 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.
+
+mark_1A51:
+
+ LD H,D ; save STKEND - required for result
+ LD L,E ;
+ EXX ; swap
+ PUSH HL ; save pointer to next literal
+ LD HL,stk_zero <#stk_zero> ; Address: stk_zero - start of table of
+ ; constants
+ EXX ;
+ CALL SKIP_CONS <#SKIP_CONS>
+ CALL STK_CONST <#STK_CONST>
+ EXX ;
+ POP HL ; restore pointer to next literal.
+ EXX ;
+ RET ; return.
+#else
+*stk_con_x*
+ LD HL,TAB_CNST ; Address: Table of constants.
+
+ JR INDEX_5 <#INDEX_5> ; and join subroutine above.
+#endif
+
+
+
+------------------------------------------------------------------------
+
+; 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.
+
+mark_1A63:
+*st_mem_xx:*
+ PUSH HL ; save the result pointer.
+ EX DE,HL ; transfer to DE.
+ LD HL,(MEM) ; fetch MEM the base of memory area.
+ CALL LOC_MEM <#LOC_MEM> ; sets HL to the destination.
+ EX DE,HL ; swap - HL is start, DE is destination.
+
+#if ORIGINAL
+ CALL MOVE_FP <#MOVE_FP>
+ ; note. a short ld bc,5; ldir
+ ; the embedded memory check is not required
+ ; so these instructions would be faster!
+#else
+ LD C,5 ;+ one extra byte but
+ LDIR ;+ faster and no memory check.
+#endif
+
+
+ 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.
+
+mark_1A72:
+*exchange:*
+ LD B,$05 ; there are five bytes to be swapped
+
+; start of loop.
+
+mark_1A74:
+*SWAP_BYTE:*
+ LD A,(DE) ; each byte of second
+#if ORIGINAL
+ LD C,(HL) ; each byte of first
+ EX DE,HL ; swap pointers
+#else
+ LD C,A ;+
+ LD A,(HL)
+#endif
+ LD (DE),A ; store each byte of first
+ LD (HL),C ; store each byte of second
+ INC HL ; advance both
+ INC DE ; pointers.
+ DJNZ SWAP_BYTE <#SWAP_BYTE> ; loop back until all 5 done.
+
+#if ORIGINAL
+ EX DE,HL ; even up the exchanges so that DE addresses STKEND.
+#else
+; omit
+#endif
+ RET ; return.
+
+------------------------------------------------------------------------
+
+; THE *'SERIES GENERATOR'* SUBROUTINE
+------------------------------------------------------------------------
+
+
+; 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.
+
+mark_1A7F:
+*series_xx:*
+ LD B,A ; parameter $00 - $1F to B counter
+ CALL GEN_ENT_1 <#GEN_ENT_1>
+ ; A recursive call to a special entry point
+ ; in the calculator that puts the B register
+ ; in the system variable BERG. 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 __duplicate ;; x,x
+ DEFB __addition ;; x+x
+ DEFB __st_mem_0 ;; x+x
+ DEFB __delete ;; .
+ DEFB __stk_zero ;; 0
+ DEFB __st_mem_2 ;; 0
+
+; a loop is now entered to perform the algebraic calculation for each of
+; the numbers in the series
+
+mark_1A89:
+*G_LOOP:*
+ DEFB __duplicate ;; v,v.
+ DEFB __get_mem_0 ;; v,v,x+2
+ DEFB __multiply ;; v,v*x+2
+ DEFB __get_mem_2 ;; v,v*x+2,v
+ DEFB __st_mem_1 ;;
+ DEFB __subtract ;;
+ DEFB __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 stk_data <#stk_data> ; is called directly to
+ ; push a value and advance H'L'.
+ CALL GEN_ENT_2 <#GEN_ENT_2> ; recursively re-enters
+ ; the calculator without disturbing
+ ; system variable BERG
+ ; H'L' value goes on the machine stack and is
+ ; then loaded as usual with the next address.
+
+ DEFB __addition ;;
+ DEFB __exchange ;;
+ DEFB __st_mem_2 ;;
+ DEFB __delete ;;
+
+ DEFB __dec_jr_nz ;;
+ DEFB $EE ;;back to G_LOOP <#G_LOOP>, G_LOOP
+
+; when the counted loop is complete the final subtraction yields the result
+; for example SIN X.
+
+ DEFB __get_mem_1 ;;
+ DEFB __subtract ;;
+ DEFB __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.
+
+mark_1AA0:
+*mark_1AA0:*
+*neg:*
+ 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.
+
+mark_1AAA:
+*abs:*
+ 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.
+
+mark_1AAF:
+*sgn:*
+ 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,FP_0_OR_1 <#FP_0_OR_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.
+
+mark_1ABE:
+*PEEK:*
+ CALL FIND_INT <#FIND_INT> ; puts address in BC.
+ LD A,(BC) ; load contents into A register.
+
+mark_1AC2:
+*IN_PK_STK:*
+ JP STACK_A <#STACK_A> ; exit via STACK_A to put value on the
+ ; calculator stack.
+
+------------------------------------------------------------------------
+
+; USR number (29)
+------------------------------------------------------------------------
+
+; The USR function followed by a number 0-65535 is the method by which
+; the ZX81 invokes machine code programs. This function returns the
+; contents of the BC register pair.
+; Note. that STACK_BC re-initializes the IY register to ERR_NR if a user-written
+; program has altered it.
+
+mark_1AC5:
+*usr_num:*
+ CALL FIND_INT <#FIND_INT> ; to fetch the
+ ; supplied address into BC.
+
+ LD HL,STACK_BC <#STACK_BC> ; 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.
+
+mark_1ACE:
+*greater_0:*
+ 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 SIGN_TO_C <#SIGN_TO_C> ; 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.
+
+mark_1AD5:
+*not:*
+ LD A,(HL) ; get exponent byte.
+ NEG ; negate - sets carry if non-zero.
+ CCF ; complement so carry set if zero, else reset.
+ JR FP_0_OR_1 <#FP_0_OR_1> ; forward to FP_0_OR_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.
+
+mark_1ADB:
+*less_0:*
+ XOR A ; set xor mask to zero
+ ; (carry will become set if sign is negative).
+
+; transfer sign of mantissa to Carry Flag.
+
+mark_1ADC:
+*SIGN_TO_C:*
+ 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.
+
+mark_1AE0:
+*FP_0_OR_1:*
+ PUSH HL ; save pointer to the first byte
+ LD B,$05 ; five bytes to do.
+
+mark_1AE3:
+*FP_loop:*
+ LD (HL),$00 ; insert a zero.
+ INC HL ;
+ DJNZ FP_loop <#FP_loop> ; 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).
+
+mark_1AED:
+*or:*
+ LD A,(DE) ; fetch exponent of second number
+ AND A ; test it.
+ RET Z ; return if zero.
+
+ SCF ; set carry flag
+ JR FP_0_OR_1 <#FP_0_OR_1> ; back to FP_0_OR_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.
+
+*boolean_num_and_num:*
+ LD A,(DE) ; fetch exponent of second number.
+ AND A ; test it.
+ RET NZ ; return if not zero.
+
+ JR FP_0_OR_1 <#FP_0_OR_1> ; back to FP_0_OR_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.
+
+*strs_and_num:*
+ 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
+; ========= ==== == ======== === ======== ======== ==== === = === === ===
+; num_l_eql x<=y 09 00000001 dec 00000000 00000000 ---- x-y ? --- >0? NOT
+; num_gr_eql x>=y 0A 00000010 dec 00000001 10000000c swap y-x ? --- >0? NOT
+; nums_neql x<>y 0B 00000011 dec 00000010 00000001 ---- x-y ? NOT --- NOT
+; num_grtr x>y 0C 00000100 - 00000100 00000010 ---- x-y ? --- >0? ---
+; num_less x<y 0D 00000101 - 00000101 10000010c swap y-x ? --- >0? ---
+; nums_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.
+
+; $1B03 SAME ADDRESS FOR MULTIPLE ROUTINES ???
+
+*num_l_eql:*
+*num_gr_eql:*
+*nums_neql:*
+*num_grtr:*
+*num_less:*
+*nums_eql:*
+*str_l_eql:*
+*str_gr_eql:*
+*strs_neql:*
+*str_grtr:*
+*str_less:*
+*strs_eql:*
+*num_lt_eql:*
+#if ORIGINAL
+mark_1B03:
+ LD A,B ; transfer literal to accumulator.
+ SUB $08 ; subtract eight - which is not useful.
+#else
+ LD A,B ; transfer literal to accumulator.
+;; SUB $08 ; subtract eight - which is not useful.
+#endif
+ BIT 2,A ; isolate '>', '<', '='.
+
+ JR NZ,EX_OR_NOT <#EX_OR_NOT> ; skip to EX_OR_NOT with these.
+
+ DEC A ; else make $00-$02, $08-$0A to match bits 0-2.
+
+*EX_OR_NOT:*
+#if ORIGINAL
+mark_1B0B:
+#endif
+ RRCA ; the first RRCA sets carry for a swap.
+ JR NC,NUM_OR_STR <#NUM_OR_STR> ; forward to NUM_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 exchange <#exchange> ; 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.
+
+*NUM_OR_STR:*
+#if ORIGINAL
+mark_1B16:
+
+ BIT 2,A ; test if a string comparison.
+ JR NZ,STRINGS <#STRINGS> ; forward to STRINGS if so.
+
+; continue with numeric comparisons.
+
+ RRCA ; 2nd RRCA causes eql/neql to set carry.
+ PUSH AF ; save A and carry
+#else
+ RRCA ;+ causes 'eql/neql' to set carry.
+ PUSH AF ;+ save the carry flag.
+
+ BIT 2,A ; test if a string comparison.
+ JR NZ,STRINGS <#STRINGS> ; forward to STRINGS if so.
+
+#endif
+
+ CALL SUBTRACT <#SUBTRACT> ; leaves result on stack.
+ JR END_TESTS <#END_TESTS> ; forward to END_TESTS
+
+; ___
+
+
+*STRINGS:*
+#if ORIGINAL
+mark_1B21:
+ RRCA ; 2nd RRCA causes eql/neql to set carry.
+ PUSH AF ; save A and carry.
+#else
+;; RRCA ; 2nd RRCA causes eql/neql to set carry.
+;; PUSH AF ; save A and carry.
+#endif
+ CALL STK_FETCH <#STK_FETCH> ; gets 2nd string params
+ PUSH DE ; save start2 *.
+ PUSH BC ; and the length.
+
+ CALL STK_FETCH <#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.
+
+#if ORIGINAL
+mark_1B2C:
+#endif
+*BYTE_COMP:*
+ 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,SEC_PLUS <#SEC_PLUS> ; forward to SEC_PLUS if second not null.
+
+ OR C ; test length of first string.
+
+#if ORIGINAL
+mark_1B33:
+#endif
+
+*SECOND_LOW:*
+ POP BC ; pop the second length off stack.
+ JR Z,BOTH_NULL <#BOTH_NULL> ; forward if first string is also
+ ; of zero length.
+
+; the true condition - first is longer than second (SECOND_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 STR_TEST <#STR_TEST> ; forward to leave via STR_TEST
+
+; ___
+; the branch was here with a match
+
+#if ORIGINAL
+mark_1B3A:
+#endif
+
+*BOTH_NULL:*
+ POP AF ; restore carry - set for eql/neql
+ JR STR_TEST <#STR_TEST> ; forward to STR_TEST
+
+; ___
+; the branch was here when 2nd string not null and low byte of first is yet
+; to be tested.
+
+
+mark_1B3D:
+*SEC_PLUS:*
+ OR C ; test the length of first string.
+ JR Z,FRST_LESS <#FRST_LESS> ; 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,FRST_LESS <#FRST_LESS> ; forward to FRST_LESS if carry set
+
+ JR NZ,SECOND_LOW <#SECOND_LOW> ; back to SECOND_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 BYTE_COMP <#BYTE_COMP> ; back to BYTE_COMP
+
+; ___
+; the false condition.
+
+mark_1B4D:
+*FRST_LESS:*
+ POP BC ; discard length
+ POP AF ; pop A
+ AND A ; clear the carry for false result.
+
+; ___
+; exact match and x$>y$ rejoin here
+
+mark_1B50:
+*STR_TEST:*
+ PUSH AF ; save A and carry
+
+ RST _FP_CALC ;;
+ DEFB __stk_zero ;; an initial false value.
+ DEFB __end_calc ;;
+
+; both numeric and string paths converge here.
+
+mark_1B54:
+*END_TESTS:*
+ POP AF ; pop carry - will be set if eql/neql
+ PUSH AF ; save it again.
+
+ CALL C,not <#not> ; sets true(1) if equal(0)
+ ; or, for strings, applies true result.
+ CALL greater_0 <#greater_0> ; ??????????
+
+
+ POP AF ; pop A
+ RRCA ; the third RRCA - test for '<=', '>=' or '<>'.
+ CALL NC,not <#not> ; 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.
+
+mark_1B62:
+*strs_add:*
+ CALL STK_FETCH <#STK_FETCH> ; fetches string parameters
+ ; and deletes calculator stack entry.
+ PUSH DE ; save start address.
+ PUSH BC ; and length.
+
+ CALL STK_FETCH <#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 _BC_SPACES ; BC_SPACES in workspace.
+ ; DE points to start of space.
+
+ CALL STK_STO_STR <#STK_STO_STR> ; stores parameters
+ ; of new string updating STKEND.
+ POP BC ; length of first
+ POP HL ; address of start
+
+#if ORIGINAL
+ LD A,B ; test for
+ OR C ; zero length.
+ JR Z,OTHER_STR <#OTHER_STR> ; to OTHER_STR if null string
+ LDIR ; copy string to workspace.
+#else
+ CALL COND_MV <#COND_MV> ;+ a conditional (NZ) ldir routine.
+#endif
+
+mark_1B7D:
+*OTHER_STR:*
+ POP BC ; now second length
+ POP HL ; and start of string
+#if ORIGINAL
+ LD A,B ; test this one
+ OR C ; for zero length
+ JR Z,STACK_POINTERS <#STACK_POINTERS> ; skip forward to STACK_POINTERS if so as complete.
+
+ LDIR ; else copy the bytes.
+ ; and continue into next routine which
+ ; sets the calculator stack pointers.
+#else
+ CALL COND_MV <#COND_MV> ;+ a conditional (NZ) ldir routine.
+#endif
+
+------------------------------------------------------------------------
+
+; 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.
+
+mark_1B85:
+*STACK_POINTERS:*
+ LD HL,(STKEND) ; fetch STKEND value from system variable.
+ LD DE,-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.
+
+mark_1B8F:
+*chr_dollar:*
+ CALL FP_TO_A <#FP_TO_A> ; puts the number in A.
+
+ JR C,REPORT_Bd <#REPORT_Bd> ; forward if overflow
+ JR NZ,REPORT_Bd <#REPORT_Bd> ; forward if negative
+#if ORIGINAL
+ PUSH AF ; save the argument.
+#endif
+ LD BC,1 ; one space required.
+ RST _BC_SPACES ; BC_SPACES makes DE point to start
+#if ORIGINAL
+ POP AF ; restore the number.
+#endif
+ LD (DE),A ; and store in workspace
+
+#if ORIGINAL
+ CALL STK_STO_STR <#STK_STO_STR> ; stacks descriptor.
+
+ EX DE,HL ; make HL point to result and DE to STKEND.
+ RET ; return.
+#else
+ JR str_STK ;+ relative jump to similar sequence in str$.
+#endif
+; ___
+
+mark_1BA2:
+*REPORT_Bd:*
+ RST _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:*
+#if ORIGINAL
+mark_1BA4:
+ LD HL,(CH_ADD) ; fetch value of system variable CH_ADD
+#else
+ RST _GET_CHAR ;+ shorter way to fetch CH_ADD.
+#endif
+ PUSH HL ; and save on the machine stack.
+
+ CALL STK_FETCH <#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 _BC_SPACES ; BC_SPACES creates the space in workspace.
+ POP HL ; restore start of string to HL.
+ LD (CH_ADD),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),ZX_NEWLINE ; insert a carriage return at end.
+ ; ZX81 has a non-ASCII character set
+ RES 7,(IY+FLAGS-RAMBASE) ; signal checking syntax.
+ CALL CLASS_6 <#CLASS_6> ; evaluates string
+ ; expression and checks for integer result.
+
+ CALL CHECK_2 <#CHECK_2> ; checks for carriage return.
+
+
+ POP HL ; restore start of string in workspace.
+
+ LD (CH_ADD),HL ; set CH_ADD to the start of the string again.
+ SET 7,(IY+FLAGS-RAMBASE) ; signal running program.
+ CALL SCANNING <#SCANNING> ; evaluates the string
+ ; in full leaving result on calculator stack.
+
+ POP HL ; restore saved character address in program.
+ LD (CH_ADD),HL ; and reset the system variable CH_ADD.
+
+ JR STACK_POINTERS <#STACK_POINTERS> ; back to exit via STACK_POINTERS.
+ ; 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.
+
+mark_1BD5:
+*str_dollar:*
+ LD BC,1 ; create an initial byte in workspace
+ RST _BC_SPACES ; using BC_SPACES restart.
+
+ LD (HL),ZX_NEWLINE ; place a carriage return there.
+
+ LD HL,(S_POSN) ; 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 (S_POSN),HL ; and store in system variable S_POSN.
+
+ LD HL,(DF_CC) ; fetch value of DF_CC
+ PUSH HL ; and preserve on stack also.
+
+ LD (DF_CC),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 PRINT_FP <#PRINT_FP>
+
+ POP DE ; retrieve start of string.
+
+ LD HL,(DF_CC) ; 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 (DF_CC),HL ; DF_CC value
+
+ POP HL ; restore original
+ LD (S_POSN),HL ; S_POSN values.
+
+#if ORIGINAL
+#else
+str_STK: ; New entry-point to exploit similarities and save 3 bytes of code.
+#endif
+
+ CALL STK_STO_STR <#STK_STO_STR> ; 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).
+
+
+mark_1C06:
+*code:*
+ CALL STK_FETCH <#STK_FETCH> ; 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,STK_CODE <#STK_CODE> ; skip with zero if the null string.
+
+ LD A,(DE) ; else fetch the first character.
+
+mark_1C0E:
+*STK_CODE:*
+ JP STACK_A <#STACK_A> ; jump back (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
+
+mark_1C11:
+*len:*
+ CALL STK_FETCH <#STK_FETCH> ; fetch and delete the
+ ; string parameters from the calculator stack.
+ ; register BC now holds the length of string.
+
+ JP STACK_BC <#STACK_BC> ; jump back 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.
+
+mark_1C17:
+*dec_jr_nz:*
+ EXX ; switch in set that addresses code
+
+ PUSH HL ; save pointer to offset byte
+ LD HL,BERG ; address BERG in system variables
+ DEC (HL) ; decrement it
+ POP HL ; restore pointer
+
+ JR NZ,JUMP_2 <#JUMP_2> ; 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.
+
+mark_1C23:
+*jump:*
+ EXX ;switch in pointer set
+*JUMP_2:*
+ LD E,(HL) ; the jump byte 0-127 forward, 128-255 back.
+
+#if ORIGINAL
+mark_1C24:
+ XOR A ; clear accumulator.
+ BIT 7,E ; test if negative jump
+ JR Z,JUMP_3 <#JUMP_3> ; skip, if positive
+ CPL ; else change to $FF.
+#else
+ ; Note. Elegance from the ZX Spectrum.
+ LD A,E ;+
+ RLA ;+
+ SBC A,A ;+
+#endif
+
+mark_1C2B:
+*JUMP_3:*
+ 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.
+
+mark_1C2F:
+*jump_true:*
+ LD A,(DE) ; collect exponent byte
+
+ AND A ; is result 0 or 1 ?
+ JR NZ,jump <#jump> ; 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.
+
+mark_1C37:
+*n_mod_m:*
+ RST _FP_CALC ;; 17, 3.
+ DEFB __st_mem_0 ;; 17, 3.
+ DEFB __delete ;; 17.
+ DEFB __duplicate ;; 17, 17.
+ DEFB __get_mem_0 ;; 17, 17, 3.
+ DEFB __division ;; 17, 17/3.
+ DEFB __int ;; 17, 5.
+ DEFB __get_mem_0 ;; 17, 5, 3.
+ DEFB __exchange ;; 17, 3, 5.
+ DEFB __st_mem_0 ;; 17, 3, 5.
+ DEFB __multiply ;; 17, 15.
+ DEFB __subtract ;; 2.
+ DEFB __get_mem_0 ;; 2, 5.
+ DEFB __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.
+
+mark_1C46:
+*int:*
+ RST _FP_CALC ;; x. (= 3.4 or -3.4).
+ DEFB __duplicate ;; x, x.
+ DEFB __less_0 ;; x, (1/0)
+ DEFB __jump_true ;; x, (1/0)
+ DEFB int <#int> - $ ;; X_NEG
+
+ DEFB __truncate ;; trunc 3.4 = 3.
+ DEFB __end_calc ;; 3.
+
+ RET ; return with + int x on stack.
+
+
+mark_1C4E:
+*X_NEG:*
+ DEFB __duplicate ;; -3.4, -3.4.
+ DEFB __truncate ;; -3.4, -3.
+ DEFB __st_mem_0 ;; -3.4, -3.
+ DEFB __subtract ;; -.4
+ DEFB __get_mem_0 ;; -.4, -3.
+ DEFB __exchange ;; -3, -.4.
+ DEFB __not ;; -3, (0).
+ DEFB __jump_true ;; -3.
+ DEFB EXIT <#EXIT> - $ ;; -3.
+
+ DEFB __stk_one ;; -3, 1.
+ DEFB __subtract ;; -4.
+
+mark_1C59:
+*EXIT:*
+ DEFB __end_calc ;; -4.
+
+ RET ; return.
+
+
+------------------------------------------------------------------------
+
+; Exponential (23)
+------------------------------------------------------------------------
+
+;
+;
+
+mark_1C5B:
+*exp:*
+ RST _FP_CALC ;;
+ DEFB __stk_data ;;
+ DEFB $F1 ;;Exponent: $81, Bytes: 4
+ DEFB $38,$AA,$3B,$29 ;;
+ DEFB __multiply ;;
+ DEFB __duplicate ;;
+ DEFB __int ;;
+ DEFB $C3 ;;st_mem_3
+ DEFB __subtract ;;
+ DEFB __duplicate ;;
+ DEFB __addition ;;
+ DEFB __stk_one ;;
+ DEFB __subtract ;;
+ DEFB __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 __end_calc ;;
+
+ CALL FP_TO_A <#FP_TO_A>
+ JR NZ,N_NEGTV <#N_NEGTV>
+
+ JR C,REPORT_6b <#REPORT_6b>
+
+ ADD A,(HL) ;
+ JR NC,RESULT_OK <#RESULT_OK>
+
+
+mark_1C99:
+*REPORT_6b:*
+ RST _ERROR_1
+ DEFB $05 ; Error Report: Number too big
+
+mark_1C9B:
+*N_NEGTV:*
+ JR C,RESULT_ZERO <#RESULT_ZERO>
+
+ SUB (HL) ;
+ JR NC,RESULT_ZERO <#RESULT_ZERO>
+
+ NEG ; Negate
+
+mark_1CA2:
+*RESULT_OK:*
+ LD (HL),A ;
+ RET ; return.
+
+
+mark_1CA4:
+*RESULT_ZERO:*
+ RST _FP_CALC ;;
+ DEFB __delete ;;
+ DEFB __stk_zero ;;
+ DEFB __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.
+
+mark_1CA9:
+*ln:*
+ RST _FP_CALC ;;
+ DEFB __duplicate ;;
+ DEFB __greater_0 ;;
+ DEFB __jump_true ;;
+ DEFB VALID - $ ;;to VALID <#VALID>
+
+ DEFB __end_calc ;;
+
+
+mark_1CAF:
+*REPORT_Ab:*
+ RST _ERROR_1
+ DEFB $09 ; Error Report: Invalid argument
+
+*VALID:*
+#if ORIGINAL
+mark_1CB1:
+ DEFB __stk_zero ;; Note. not necessary.
+ DEFB __delete ;;
+#endif
+ DEFB __end_calc ;;
+ LD A,(HL) ;
+
+ LD (HL),$80 ;
+ CALL STACK_A <#STACK_A>
+
+ RST _FP_CALC ;;
+ DEFB __stk_data ;;
+ DEFB $38 ;;Exponent: $88, Bytes: 1
+ DEFB $00 ;;(+00,+00,+00)
+ DEFB __subtract ;;
+ DEFB __exchange ;;
+ DEFB __duplicate ;;
+ DEFB __stk_data ;;
+ DEFB $F0 ;;Exponent: $80, Bytes: 4
+ DEFB $4C,$CC,$CC,$CD ;;
+ DEFB __subtract ;;
+ DEFB __greater_0 ;;
+ DEFB __jump_true ;;
+ DEFB GRE_8 <#GRE_8> - $ ;;
+
+ DEFB __exchange ;;
+ DEFB __stk_one ;;
+ DEFB __subtract ;;
+ DEFB __exchange ;;
+ DEFB __end_calc ;;
+
+ INC (HL) ;
+
+ RST _FP_CALC ;;
+
+mark_1CD2:
+*GRE_8:*
+ DEFB __exchange ;;
+ DEFB __stk_data ;;
+ DEFB $F0 ;;Exponent: $80, Bytes: 4
+ DEFB $31,$72,$17,$F8 ;;
+ DEFB __multiply ;;
+ DEFB __exchange ;;
+ DEFB __stk_half ;;
+ DEFB __subtract ;;
+ DEFB __stk_half ;;
+ DEFB __subtract ;;
+ DEFB __duplicate ;;
+ DEFB __stk_data ;;
+ DEFB $32 ;;Exponent: $82, Bytes: 1
+ DEFB $20 ;;(+00,+00,+00)
+ DEFB __multiply ;;
+ DEFB __stk_half ;;
+ DEFB __subtract ;;
+ DEFB __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 __multiply ;;
+ DEFB __addition ;;
+ DEFB __end_calc ;;
+
+ RET ; return.
+------------------------------------------------------------------------
+
+#if ORIGINAL
+#else
+; ------------------------------
+; THE NEW *'SQUARE ROOT'* FUNCTION
+; ------------------------------
+; (Offset $25: 'sqr')
+; "If I have seen further, it is by standing on the shoulders of giants" -
+; Sir Isaac Newton, Cambridge 1676.
+; The sqr function has been re-written to use the Newton-Raphson method.
+; Joseph Raphson was a student of Sir Isaac Newton at Cambridge University
+; and helped publicize his work.
+; Although Newton's method is centuries old, this routine, appropriately, is
+; based on a FORTH word written by Steven Vickers in the Jupiter Ace manual.
+; Whereas that method uses an initial guess of one, this one manipulates
+; the exponent byte to obtain a better starting guess.
+; First test for zero and return zero, if so, as the result.
+; If the argument is negative, then produce an error.
+;
+*sqr* RST _FP_CALC ;; x
+ DEFB __st_mem_3 ;; x. (seed for guess)
+ DEFB __end_calc ;; x.
+
+; HL now points to exponent of argument on calculator stack.
+
+ LD A,(HL) ; Test for zero argument
+ AND A ;
+
+ RET Z ; Return with zero on the calculator stack.
+
+; Test for a positive argument
+
+ INC HL ; Address byte with sign bit.
+ BIT 7,(HL) ; Test the bit.
+
+ JR NZ,REPORT_Ab <#REPORT_Ab> ; back to REPORT_A
+ ; 'Invalid argument'
+
+; This guess is based on a Usenet discussion.
+; Halve the exponent to achieve a good guess.(accurate with .25 16 64 etc.)
+
+ LD HL,$4071 ; Address first byte of mem-3
+
+ LD A,(HL) ; fetch exponent of mem-3
+ XOR $80 ; toggle sign of exponent of mem-3
+ SRA A ; shift right, bit 7 unchanged.
+ INC A ;
+ JR Z,ASIS <#ASIS> ; forward with say .25 -> .5
+ JP P,ASIS <#ASIS> ; leave increment if value > .5
+ DEC A ; restore to shift only.
+*ASIS* XOR $80 ; restore sign.
+ LD (HL),A ; and put back 'halved' exponent.
+
+; Now re-enter the calculator.
+
+ RST 28H ;; FP-CALC x
+
+*SLOOP* DEFB __duplicate ;; x,x.
+ DEFB __get_mem_3 ;; x,x,guess
+ DEFB __st_mem_4 ;; x,x,guess
+ DEFB __division ;; x,x/guess.
+ DEFB __get_mem_3 ;; x,x/guess,guess
+ DEFB __addition ;; x,x/guess+guess
+ DEFB __stk_half ;; x,x/guess+guess,.5
+ DEFB __multiply ;; x,(x/guess+guess)*.5
+ DEFB __st_mem_3 ;; x,newguess
+ DEFB __get_mem_4 ;; x,newguess,oldguess
+ DEFB __subtract ;; x,newguess-oldguess
+ DEFB __abs ;; x,difference.
+ DEFB __greater_0 ;; x,(0/1).
+ DEFB __jump_true ;; x.
+
+ DEFB SLOOP <#SLOOP> - $ ;; x.
+
+ DEFB __delete ;; .
+ DEFB __get_mem_3 ;; retrieve final guess.
+ DEFB __end_calc ;; sqr x.
+
+ RET ; return with square root on stack
+
+; or in ZX81 BASIC
+;
+; 5 PRINT "NEWTON RAPHSON SQUARE ROOTS"
+; 10 INPUT "NUMBER ";N
+; 20 INPUT "GUESS ";G
+; 30 PRINT " NUMBER "; N ;" GUESS "; G
+; 40 FOR I = 1 TO 10
+; 50 LET B = N/G
+; 60 LET C = B+G
+; 70 LET G = C/2
+; 80 PRINT I; " VALUE "; G
+; 90 NEXT I
+; 100 PRINT "NAPIER METHOD"; SQR N
+#endif
+
+------------------------------------------------------------------------
+
+; 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.
+
+mark_1D18:
+*get_argt:*
+ RST _FP_CALC ;; X.
+ DEFB __stk_data ;;
+ DEFB $EE ;;Exponent: $7E,
+ ;;Bytes: 4
+ DEFB $22,$F9,$83,$6E ;; X, 1/(2*PI)
+ DEFB __multiply ;; X/(2*PI) = fraction
+
+ DEFB __duplicate ;;
+ DEFB __stk_half ;;
+ DEFB __addition ;;
+ DEFB __int ;;
+
+ DEFB __subtract ;; now range -.5 to .5
+
+ DEFB __duplicate ;;
+ DEFB __addition ;; now range -1 to 1.
+ DEFB __duplicate ;;
+ DEFB __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 __duplicate ;; Y, Y.
+ DEFB __abs ;; Y, abs(Y). range 1 to 2
+ DEFB __stk_one ;; Y, abs(Y), 1.
+ DEFB __subtract ;; Y, abs(Y)-1. range 0 to 1
+ DEFB __duplicate ;; Y, Z, Z.
+ DEFB __greater_0 ;; Y, Z, (1/0).
+
+ DEFB __st_mem_0 ;; store as possible sign
+ ;; for cosine function.
+
+ DEFB __jump_true ;;
+ DEFB Z_PLUS <#Z_PLUS> - $ ;; with quadrants II and III
+
+; else the angle lies in quadrant I or IV and value Y is already correct.
+
+ DEFB __delete ;; Y delete test value.
+ DEFB __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.
+
+mark_1D35:
+*Z_PLUS:*
+ DEFB __stk_one ;; Y, Z, 1
+ DEFB __subtract ;; Y, Z-1. Q3 = 0 to -1
+ DEFB __exchange ;; Z-1, Y.
+ DEFB __less_0 ;; Z-1, (1/0).
+ DEFB __jump_true ;; Z-1.
+ DEFB YNEG <#YNEG> - $ ;;
+ ;;if angle in quadrant III
+
+; else angle is within quadrant II (-1 to 0)
+
+ DEFB __negate ; range +1 to 0
+
+
+mark_1D3C:
+*YNEG:*
+ DEFB __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.
+
+mark_1D3E:
+*cos:*
+ RST _FP_CALC ;; angle in radians.
+ DEFB __get_argt ;; X reduce -1 to +1
+
+ DEFB __abs ;; ABS X 0 to 1
+ DEFB __stk_one ;; ABS X, 1.
+ DEFB __subtract ;; now opposite angle
+ ;; though negative sign.
+ DEFB __get_mem_0 ;; fetch sign indicator.
+ DEFB __jump_true ;;
+ DEFB C_ENT <#C_ENT> - $ ;;fwd to C_ENT
+ ;;forward to common code if in QII or QIII
+
+
+ DEFB __negate ;; else make positive.
+ DEFB __jump ;;
+ DEFB C_ENT <#C_ENT> - $ ;;fwd to 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.
+
+mark_1D49:
+*sin:*
+ RST _FP_CALC ;; angle in radians
+ DEFB __get_argt ;; reduce - sign now correct.
+
+mark_1D4B:
+*C_ENT:*
+ DEFB __duplicate ;;
+ DEFB __duplicate ;;
+ DEFB __multiply ;;
+ DEFB __duplicate ;;
+ DEFB __addition ;;
+ DEFB __stk_one ;;
+ DEFB __subtract ;;
+
+ DEFB __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 __multiply ;;
+ DEFB __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.
+
+mark_1D6E:
+*tan:*
+ RST _FP_CALC ;; x.
+ DEFB __duplicate ;; x, x.
+ DEFB __sin ;; x, sin x.
+ DEFB __exchange ;; sin x, x.
+ DEFB __cos ;; sin x, cos x.
+ DEFB __division ;; sin x/cos x (= tan x).
+ DEFB __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.
+
+mark_1D76:
+*atn:*
+ LD A,(HL) ; fetch exponent
+ CP $81 ; compare to that for 'one'
+ JR C,SMALL <#SMALL> ; forward, if less
+
+ RST _FP_CALC ;; X.
+ DEFB __stk_one ;;
+ DEFB __negate ;;
+ DEFB __exchange ;;
+ DEFB __division ;;
+ DEFB __duplicate ;;
+ DEFB __less_0 ;;
+ DEFB __stk_half_pi ;;
+ DEFB __exchange ;;
+ DEFB __jump_true ;;
+ DEFB CASES <#CASES> - $ ;;
+
+ DEFB __negate ;;
+ DEFB __jump ;;
+ DEFB CASES <#CASES> - $ ;;
+
+; ___
+
+mark_1D89:
+*SMALL:*
+ RST _FP_CALC ;;
+ DEFB __stk_zero ;;
+
+mark_1D8B:
+*CASES:*
+ DEFB __exchange ;;
+ DEFB __duplicate ;;
+ DEFB __duplicate ;;
+ DEFB __multiply ;;
+ DEFB __duplicate ;;
+ DEFB __addition ;;
+ DEFB __stk_one ;;
+ DEFB __subtract ;;
+
+ DEFB __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 __multiply ;;
+ DEFB __addition ;;
+ DEFB __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.
+
+mark_1DC4:
+*asn:*
+ RST _FP_CALC ;; x.
+ DEFB __duplicate ;; x, x.
+ DEFB __duplicate ;; x, x, x.
+ DEFB __multiply ;; x, x*x.
+ DEFB __stk_one ;; x, x*x, 1.
+ DEFB __subtract ;; x, x*x-1.
+ DEFB __negate ;; x, 1-x*x.
+ DEFB __sqr ;; x, sqr(1-x*x) = y.
+ DEFB __stk_one ;; x, y, 1.
+ DEFB __addition ;; x, y+1.
+ DEFB __division ;; x/y+1.
+ DEFB __atn ;; a/2 (half the angle)
+ DEFB __duplicate ;; a/2, a/2.
+ DEFB __addition ;; a.
+ DEFB __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
+
+mark_1DD4:
+*acs:*
+ RST _FP_CALC ;; x.
+ DEFB __asn ;; asn(x).
+ DEFB __stk_half_pi ;; asn(x), pi/2.
+ DEFB __subtract ;; asn(x) - pi/2.
+ DEFB __negate ;; pi/2 - asn(x) = acs(x).
+ DEFB __end_calc ;; acs(x)
+
+ RET ; return.
+
+#if ORIGINAL
+------------------------------------------------------------------------
+
+; 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.
+
+; This routine uses Napier's method for calculating square roots which was
+; devised in 1614 and calculates the value as EXP (LN 'x' * 0.5).
+;
+; This is a little on the slow side as it involves two polynomial series.
+; A series of 12 for LN and a series of 8 for EXP.
+; This was of no concern to John Napier since his tables were 'compiled forever'.
+
+mark_1DDB:
+*sqr:*
+ RST _FP_CALC ;; x.
+ DEFB __duplicate ;; x, x.
+ DEFB __not ;; x, 1/0
+ DEFB __jump_true ;; x, (1/0).
+ DEFB LAST <#LAST> - $ ;; exit if argument zero
+ ;; with zero result.
+
+; else continue to calculate as x ** .5
+
+ DEFB __stk_half ;; x, .5.
+ DEFB __end_calc ;; x, .5.
+
+#endif
+
+------------------------------------------------------------------------
+
+; 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.
+
+mark_1DE2:
+*to_power:*
+ RST _FP_CALC ;; X,Y.
+ DEFB __exchange ;; Y,X.
+ DEFB __duplicate ;; Y,X,X.
+ DEFB __not ;; Y,X,(1/0).
+ DEFB __jump_true ;;
+ DEFB XISO <#XISO> - $ ;;forward to XISO if X is zero.
+
+; else X is non-zero. function 'ln' will catch a negative value of X.
+
+ DEFB __ln ;; Y, LN X.
+ DEFB __multiply ;; Y * LN X
+ DEFB __end_calc ;;
+
+ JP exp <#exp> ; 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.
+
+mark_1DEE:
+*XISO:*
+ DEFB __delete ;; Y.
+ DEFB __duplicate ;; Y, Y.
+ DEFB __not ;; Y, (1/0).
+ DEFB __jump_true ;;
+ DEFB ONE <#ONE> - $ ;; if Y is zero.
+
+; the power factor is not zero. If negative then an error exists.
+
+ DEFB __stk_zero ;; Y, 0.
+ DEFB __exchange ;; 0, Y.
+ DEFB __greater_0 ;; 0, (1/0).
+ DEFB __jump_true ;; 0
+ DEFB LAST <#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.
+
+; #if ORIGINAL
+
+; the SG ROM seems to want it the old way!
+#if 1
+ DEFB __stk_one ;; 0, 1.
+ DEFB __exchange ;; 1, 0.
+ DEFB __division ;; 1/0 >> error
+#else
+ DEFB $34 ;+ end-calc
+*REPORT_6c*
+ RST 08H ;+ ERROR-1
+ DEFB $05 ;+ Error Report: Number too big
+#endif
+
+
+; ___
+
+mark_1DFB:
+*ONE:*
+ DEFB __delete ;; .
+ DEFB __stk_one ;; 1.
+
+mark_1DFD:
+*LAST:*
+ DEFB __end_calc ;; last value 1 or 0.
+
+ RET ; return.
+
+------------------------------------------------------------------------
+
+; THE *'SPARE LOCATIONS'*
+------------------------------------------------------------------------
+
+*SPARE:*
+
+#if ORIGINAL
+mark_1DFF:
+ DEFB $FF ; That's all folks.
+#else
+mark_1DFE:
+*L1DFE:*
+
+;; DEFB $FF, $FF ; Two spare bytes.
+ DEFB $00, $00 ; Two spare bytes (as per the Shoulders of Giants ROM)
+#endif
+
+
+------------------------------------------------------------------------
+
+; THE *'ZX81 CHARACTER SET'*
+------------------------------------------------------------------------
+
+
+mark_1E00:
+*char_set* ; - begins with space character.
+
+; $00 - *Character: ' '* CHR$(0)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $01 - *Character: mosaic* CHR$(1)
+
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+
+; $02 - *Character: mosaic* CHR$(2)
+
+ DEFB %0000*1111*
+ DEFB %0000*1111*
+ DEFB %0000*1111*
+ DEFB %0000*1111*
+ 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 %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+
+; $05 - *Character: mosaic* CHR$(5)
+
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+
+; $06 - *Character: mosaic* CHR$(6)
+
+ DEFB %0000*1111*
+ DEFB %0000*1111*
+ DEFB %0000*1111*
+ DEFB %0000*1111*
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+
+; $07 - *Character: mosaic* CHR$(7)
+
+ DEFB %*11111111*
+ DEFB %*11111111*
+ DEFB %*11111111*
+ DEFB %*11111111*
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+ DEFB %*1111*0000
+
+; $08 - *Character: mosaic* CHR$(8)
+
+ DEFB %*1*0*1*0*1*0*1*0
+ DEFB %0*1*0*1*0*1*0*1*
+ DEFB %*1*0*1*0*1*0*1*0
+ DEFB %0*1*0*1*0*1*0*1*
+ DEFB %*1*0*1*0*1*0*1*0
+ DEFB %0*1*0*1*0*1*0*1*
+ DEFB %*1*0*1*0*1*0*1*0
+ DEFB %0*1*0*1*0*1*0*1*
+; $09 - *Character: mosaic* CHR$(9)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %*1*0*1*0*1*0*1*0
+ DEFB %0*1*0*1*0*1*0*1*
+ DEFB %*1*0*1*0*1*0*1*0
+ DEFB %0*1*0*1*0*1*0*1*
+; $0A - *Character: mosaic* CHR$(10)
+
+ DEFB %*1*0*1*0*1*0*1*0
+ DEFB %0*1*0*1*0*1*0*1*
+ DEFB %*1*0*1*0*1*0*1*0
+ DEFB %0*1*0*1*0*1*0*1*
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $0B - *Character: '"'* CHR$(11)
+
+ DEFB %00000000
+ DEFB %00*1*00*1*00
+ DEFB %00*1*00*1*00
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $0C - *Character:* £ CHR$(12)
+
+ DEFB %00000000
+ DEFB %000*111*00
+ DEFB %00*1*000*1*0
+ DEFB %0*1111*000
+ DEFB %00*1*00000
+ DEFB %00*1*00000
+ DEFB %0*111111*0
+ DEFB %00000000
+
+; $0D - *Character: '$'* CHR$(13)
+
+ DEFB %00000000
+ DEFB %0000*1*000
+ DEFB %00*11111*0
+ DEFB %00*1*0*1*000
+ DEFB %00*11111*0
+ DEFB %0000*1*0*1*0
+ DEFB %00*11111*0
+ DEFB %0000*1*000
+
+; $0E - *Character: ':'* CHR$(14)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000*1*0000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000*1*0000
+ DEFB %00000000
+
+; $0F - *Character: '?'* CHR$(15)
+
+ DEFB %00000000
+ DEFB %00*1111*00
+ DEFB %0*1*0000*1*0
+ DEFB %00000*1*00
+ DEFB %0000*1*000
+ DEFB %00000000
+ DEFB %0000*1*000
+ DEFB %00000000
+
+; $10 - *Character: '('* CHR$(16)
+
+ DEFB %00000000
+ DEFB %00000*1*00
+ DEFB %0000*1*000
+ DEFB %0000*1*000
+ DEFB %0000*1*000
+ DEFB %0000*1*000
+ DEFB %00000*1*00
+ DEFB %00000000
+
+; $11 - *Character: ')'* CHR$(17)
+
+ DEFB %00000000
+ DEFB %00*1*00000
+ DEFB %000*1*0000
+ DEFB %000*1*0000
+ DEFB %000*1*0000
+ DEFB %000*1*0000
+ DEFB %00*1*00000
+ DEFB %00000000
+
+; $12 - *Character: '>'* CHR$(18)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000*1*0000
+ DEFB %0000*1*000
+ DEFB %00000*1*00
+ DEFB %0000*1*000
+ DEFB %000*1*0000
+ DEFB %00000000
+
+; $13 - *Character: '<'* CHR$(19)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000*1*00
+ DEFB %0000*1*000
+ DEFB %000*1*0000
+ DEFB %0000*1*000
+ DEFB %00000*1*00
+ DEFB %00000000
+
+; $14 - *Character: '='* CHR$(20)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00*11111*0
+ DEFB %00000000
+ DEFB %00*11111*0
+ DEFB %00000000
+ DEFB %00000000
+
+; $15 - *Character: '+'* CHR$(21)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %0000*1*000
+ DEFB %0000*1*000
+ DEFB %00*11111*0
+ DEFB %0000*1*000
+ DEFB %0000*1*000
+ DEFB %00000000
+
+; $16 - *Character: '-'* CHR$(22)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00*11111*0
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $17 - *Character: '*'* CHR$(23)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000*1*0*1*00
+ DEFB %0000*1*000
+ DEFB %00*11111*0
+ DEFB %0000*1*000
+ DEFB %000*1*0*1*00
+ DEFB %00000000
+
+; $18 - *Character: '/'* CHR$(24)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000000*1*0
+ DEFB %00000*1*00
+ DEFB %0000*1*000
+ DEFB %000*1*0000
+ DEFB %00*1*00000
+ DEFB %00000000
+
+; $19 - *Character: ';'* CHR$(25)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000*1*0000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000*1*0000
+ DEFB %000*1*0000
+ DEFB %00*1*00000
+
+; $1A - *Character: ','* CHR$(26)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %0000*1*000
+ DEFB %0000*1*000
+ DEFB %000*1*0000
+
+; $1B - *Character: '"'* CHR$(27)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000*11*000
+ DEFB %000*11*000
+ DEFB %00000000
+
+; $1C - *Character: '0'* CHR$(28)
+
+ DEFB %00000000
+ DEFB %00*1111*00
+ DEFB %0*1*000*11*0
+ DEFB %0*1*00*1*0*1*0
+ DEFB %0*1*0*1*00*1*0
+ DEFB %0*11*000*1*0
+ DEFB %00*1111*00
+ DEFB %00000000
+
+; $1D - *Character: '1'* CHR$(29)
+
+ DEFB %00000000
+ DEFB %000*11*000
+ DEFB %00*1*0*1*000
+ DEFB %0000*1*000
+ DEFB %0000*1*000
+ DEFB %0000*1*000
+ DEFB %00*11111*0
+ DEFB %00000000
+
+; $1E - *Character: '2'* CHR$(30)
+
+ DEFB %00000000
+ DEFB %00*1111*00
+ DEFB %0*1*0000*1*0
+ DEFB %000000*1*0
+ DEFB %00*1111*00
+ DEFB %0*1*000000
+ DEFB %0*111111*0
+ DEFB %00000000
+
+; $1F - *Character: '3'* CHR$(31)
+
+ DEFB %00000000
+ DEFB %00*1111*00
+ DEFB %0*1*0000*1*0
+ DEFB %0000*11*00
+ DEFB %000000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %00*1111*00
+ DEFB %00000000
+
+; $20 - *Character: '4'* CHR$(32)
+
+ DEFB %00000000
+ DEFB %0000*1*000
+ DEFB %000*11*000
+ DEFB %00*1*0*1*000
+ DEFB %0*1*00*1*000
+ DEFB %0*111111*0
+ DEFB %0000*1*000
+ DEFB %00000000
+
+; $21 - *Character: '5'* CHR$(33)
+
+ DEFB %00000000
+ DEFB %0*111111*0
+ DEFB %0*1*000000
+ DEFB %0*11111*00
+ DEFB %000000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %00*1111*00
+ DEFB %00000000
+
+; $22 - *Character: '6'* CHR$(34)
+
+ DEFB %00000000
+ DEFB %00*1111*00
+ DEFB %0*1*000000
+ DEFB %0*11111*00
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %00*1111*00
+ DEFB %00000000
+
+; $23 - *Character: '7'* CHR$(35)
+
+ DEFB %00000000
+ DEFB %0*111111*0
+ DEFB %000000*1*0
+ DEFB %00000*1*00
+ DEFB %0000*1*000
+ DEFB %000*1*0000
+ DEFB %000*1*0000
+ DEFB %00000000
+
+; $24 - *Character: '8'* CHR$(36)
+
+ DEFB %00000000
+ DEFB %00*1111*00
+ DEFB %0*1*0000*1*0
+ DEFB %00*1111*00
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %00*1111*00
+ DEFB %00000000
+
+; $25 - *Character: '9'* CHR$(37)
+
+ DEFB %00000000
+ DEFB %00*1111*00
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %00*11111*0
+ DEFB %000000*1*0
+ DEFB %00*1111*00
+ DEFB %00000000
+
+; $26 - *Character: 'A'* CHR$(38)
+
+ DEFB %00000000
+ DEFB %00*1111*00
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*111111*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %00000000
+
+; $27 - *Character: 'B'* CHR$(39)
+
+ DEFB %00000000
+ DEFB %0*11111*00
+ DEFB %0*1*0000*1*0
+ DEFB %0*11111*00
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*11111*00
+ DEFB %00000000
+
+; $28 - *Character: 'C'* CHR$(40)
+
+ DEFB %00000000
+ DEFB %00*1111*00
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*000000
+ DEFB %0*1*000000
+ DEFB %0*1*0000*1*0
+ DEFB %00*1111*00
+ DEFB %00000000
+
+; $29 - *Character: 'D'* CHR$(41)
+
+ DEFB %00000000
+ DEFB %0*1111*000
+ DEFB %0*1*000*1*00
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*000*1*00
+ DEFB %0*1111*000
+ DEFB %00000000
+
+; $2A - *Character: 'E'* CHR$(42)
+
+ DEFB %00000000
+ DEFB %0*111111*0
+ DEFB %0*1*000000
+ DEFB %0*11111*00
+ DEFB %0*1*000000
+ DEFB %0*1*000000
+ DEFB %0*111111*0
+ DEFB %00000000
+
+; $2B - *Character: 'F'* CHR$(43)
+
+ DEFB %00000000
+ DEFB %0*111111*0
+ DEFB %0*1*000000
+ DEFB %0*11111*00
+ DEFB %0*1*000000
+ DEFB %0*1*000000
+ DEFB %0*1*000000
+ DEFB %00000000
+
+; $2C - *Character: 'G'* CHR$(44)
+
+ DEFB %00000000
+ DEFB %00*1111*00
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*000000
+ DEFB %0*1*00*111*0
+ DEFB %0*1*0000*1*0
+ DEFB %00*1111*00
+ DEFB %00000000
+
+; $2D - *Character: 'H'* CHR$(45)
+
+ DEFB %00000000
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*111111*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %00000000
+
+; $2E - *Character: 'I'* CHR$(46)
+
+ DEFB %00000000
+ DEFB %00*11111*0
+ DEFB %0000*1*000
+ DEFB %0000*1*000
+ DEFB %0000*1*000
+ DEFB %0000*1*000
+ DEFB %00*11111*0
+ DEFB %00000000
+
+; $2F - *Character: 'J'* CHR$(47)
+
+ DEFB %00000000
+ DEFB %000000*1*0
+ DEFB %000000*1*0
+ DEFB %000000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %00*1111*00
+ DEFB %00000000
+
+; $30 - *Character: 'K'* CHR$(48)
+
+ DEFB %00000000
+ DEFB %0*1*000*1*00
+ DEFB %0*1*00*1*000
+ DEFB %0*111*0000
+ DEFB %0*1*00*1*000
+ DEFB %0*1*000*1*00
+ DEFB %0*1*0000*1*0
+ DEFB %00000000
+
+; $31 - *Character: 'L'* CHR$(49)
+
+ DEFB %00000000
+ DEFB %0*1*000000
+ DEFB %0*1*000000
+ DEFB %0*1*000000
+ DEFB %0*1*000000
+ DEFB %0*1*000000
+ DEFB %0*111111*0
+ DEFB %00000000
+
+; $32 - *Character: 'M'* CHR$(50)
+
+ DEFB %00000000
+ DEFB %0*1*0000*1*0
+ DEFB %0*11*00*11*0
+ DEFB %0*1*0*11*0*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %00000000
+
+; $33 - *Character: 'N'* CHR$(51)
+
+ DEFB %00000000
+ DEFB %0*1*0000*1*0
+ DEFB %0*11*000*1*0
+ DEFB %0*1*0*1*00*1*0
+ DEFB %0*1*00*1*0*1*0
+ DEFB %0*1*000*11*0
+ DEFB %0*1*0000*1*0
+ DEFB %00000000
+
+; $34 - *Character: 'O'* CHR$(52)
+
+ DEFB %00000000
+ DEFB %00*1111*00
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %00*1111*00
+ DEFB %00000000
+
+; $35 - *Character: 'P'* CHR$(53)
+
+ DEFB %00000000
+ DEFB %0*11111*00
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*11111*00
+ DEFB %0*1*000000
+ DEFB %0*1*000000
+ DEFB %00000000
+
+; $36 - *Character: 'Q'* CHR$(54)
+
+ DEFB %00000000
+ DEFB %00*1111*00
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0*1*00*1*0
+ DEFB %0*1*00*1*0*1*0
+ DEFB %00*1111*00
+ DEFB %00000000
+
+; $37 - *Character: 'R'* CHR$(55)
+
+ DEFB %00000000
+ DEFB %0*11111*00
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*11111*00
+ DEFB %0*1*000*1*00
+ DEFB %0*1*0000*1*0
+ DEFB %00000000
+
+; $38 - *Character: 'S'* CHR$(56)
+
+ DEFB %00000000
+ DEFB %00*1111*00
+ DEFB %0*1*000000
+ DEFB %00*1111*00
+ DEFB %000000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %00*1111*00
+ DEFB %00000000
+
+; $39 - *Character: 'T'* CHR$(57)
+
+ DEFB %00000000
+ DEFB %*1111111*0
+ DEFB %000*1*0000
+ DEFB %000*1*0000
+ DEFB %000*1*0000
+ DEFB %000*1*0000
+ DEFB %000*1*0000
+ DEFB %00000000
+
+; $3A - *Character: 'U'* CHR$(58)
+
+ DEFB %00000000
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %00*1111*00
+ DEFB %00000000
+
+; $3B - *Character: 'V'* CHR$(59)
+
+ DEFB %00000000
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %00*1*00*1*00
+ DEFB %000*11*000
+ DEFB %00000000
+
+; $3C - *Character: 'W'* CHR$(60)
+
+ DEFB %00000000
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0000*1*0
+ DEFB %0*1*0*11*0*1*0
+ DEFB %00*1*00*1*00
+ DEFB %00000000
+
+; $3D - *Character: 'X'* CHR$(61)
+
+ DEFB %00000000
+ DEFB %0*1*0000*1*0
+ DEFB %00*1*00*1*00
+ DEFB %000*11*000
+ DEFB %000*11*000
+ DEFB %00*1*00*1*00
+ DEFB %0*1*0000*1*0
+ DEFB %00000000
+
+; $3E - *Character: 'Y'* CHR$(62)
+
+ DEFB %00000000
+ DEFB %*1*00000*1*0
+ DEFB %0*1*000*1*00
+ DEFB %00*1*0*1*000
+ DEFB %000*1*0000
+ DEFB %000*1*0000
+ DEFB %000*1*0000
+ DEFB %00000000
+
+; $3F - *Character: 'Z'* CHR$(63)
+
+ DEFB %00000000
+ DEFB %0*111111*0
+ DEFB %00000*1*00
+ DEFB %0000*1*000
+ DEFB %000*1*0000
+ DEFB %00*1*00000
+ DEFB %0*111111*0
+ DEFB %00000000
+
+
+; .END ;TASM assembler instruction.
+
+
+
+;
+; This marks the end of the ZX81 ROM.
+;
+; As a bonus feature, I will now include the code for
+; the G007 graphics board and
+; the ZX81 monitor
+;
+; The 8K space divides into four 2K spaces like so:
+;
+; 2000 RAM (1K or 2K) remapped
+; 2800 G007 ROM
+; 3000
+; 3800 ZX81 Monitor
+;
+; The G007 uses some RAM
+; 2300 G007 RAM variables
+;
+; 2000
+#code $2000,$0800
+; RAM_2K
+; 2300
+; xxxx data 4 ; reserves 4 bytes from the #data segment for variable "Toto"
+
+#code $2800,$0800
+
+#if 0
+;
+; just copy bytes. Provides a reference for comparing code output.
+;
+; G007 Graphics
+; Start = 2800H
+; End = 2FFFH
+mark_2800: DEFB $2A, $23, $23, $3A, $25, $23, $67, $EB
+mark_2808: DEFB $3A, $18, $23, $3D, $92, $57, $3E, $07
+mark_2810: DEFB $A3, $6F, $26, $2D, $7E, $2A, $08, $23
+mark_2818: DEFB $4A, $06, $00, $09, $09, $CB, $3A, $CB
+mark_2820: DEFB $1B, $CB, $3A, $CB, $1B, $CB, $3A, $CB
+mark_2828: DEFB $1B, $19, $47, $C9, $3A, $21, $23, $2A
+mark_2830: DEFB $27, $23, $ED, $5B, $23, $23, $D9, $2A
+mark_2838: DEFB $25, $23, $ED, $5B, $29, $23, $CB, $77
+mark_2840: DEFB $28, $1C, $CB, $7F, $C0, $3A, $21, $40
+mark_2848: DEFB $F5, $06, $08, $0F, $FD, $CB, $21, $16
+mark_2850: DEFB $10, $F9, $EB, $D9, $EB, $D9, $CD, $5E
+mark_2858: DEFB $28, $F1, $32, $21, $40, $C9, $01, $DE
+mark_2860: DEFB $FF, $3A, $18, $23, $3D, $93, $ED, $52
+mark_2868: DEFB $F2, $76, $28, $01, $22, $00, $7B, $D5
+mark_2870: DEFB $19, $EB, $B7, $ED, $52, $D1, $E5, $63
+mark_2878: DEFB $5F, $D9, $01, $FB, $28, $7D, $D9, $6F
+mark_2880: DEFB $D9, $B7, $ED, $52, $F2, $90, $28, $01
+mark_2888: DEFB $04, $29, $2F, $19, $EB, $B7, $ED, $52
+mark_2890: DEFB $ED, $43, $1A, $23, $D1, $B7, $ED, $52
+mark_2898: DEFB $19, $30, $09, $EB, $01, $F6, $28, $D9
+mark_28A0: DEFB $53, $5F, $7A, $D9, $ED, $43, $1C, $23
+mark_28A8: DEFB $D9, $57, $D5, $D9, $C1, $3A, $21, $23
+mark_28B0: DEFB $FE, $40, $30, $02, $45, $4B, $04, $0C
+mark_28B8: DEFB $CB, $3C, $38, $02, $28, $08, $CB, $1D
+mark_28C0: DEFB $CB, $3A, $CB, $1B, $18, $F2, $55, $CB
+mark_28C8: DEFB $3D, $D9, $C5, $CD, $07, $28, $D1, $3A
+mark_28D0: DEFB $1F, $23, $4F, $FD, $CB, $21, $06, $38
+mark_28D8: DEFB $08, $3A, $1E, $23, $AE, $B1, $A0, $AE
+mark_28E0: DEFB $77, $D9, $7D, $05, $C8, $93, $30, $0A
+mark_28E8: DEFB $0D, $C8, $82, $D9, $19, $D9, $2A, $1A
+mark_28F0: DEFB $23, $E9, $2A, $1C, $23, $E9, $6F, $D9
+mark_28F8: DEFB $19, $18, $D8, $6F, $D9, $CB, $00, $30
+mark_2900: DEFB $D2, $2B, $18, $CF, $6F, $D9, $CB, $08
+mark_2908: DEFB $30, $C9, $23, $18, $C6, $2A, $A8, $0E
+mark_2910: DEFB $E9, $CD, $0D, $29, $38, $0E, $21, $00
+mark_2918: DEFB $00, $28, $06, $ED, $42, $F8, $C8, $18
+mark_2920: DEFB $03, $ED, $4A, $F0, $E1, $C9, $CD, $11
+mark_2928: DEFB $29, $22, $25, $23, $CD, $11, $29, $E5
+mark_2930: DEFB $CD, $02, $0C, $C1, $ED, $5B, $25, $23
+mark_2938: DEFB $28, $0C, $3D, $C0, $21, $9C, $0C, $22
+mark_2940: DEFB $30, $40, $43, $C3, $B2, $0B
+; The Plot Routine:
+; A == the plot number N
+; BC == screen X
+; DE == screen Y
+mark_2946: DEFB $B7, $28
+mark_2948: DEFB $F9, $3D, $D5, $C5, $F5, $CD, $1F, $2E
+mark_2950: DEFB $F1, $D1, $C1, $FE, $81, $20, $0F, $ED
+mark_2958: DEFB $53, $30, $23, $ED, $43, $32, $23, $01
+mark_2960: DEFB $00, $00, $50, $58, $3E, $0B, $CB, $57
+mark_2968: DEFB $28, $09, $2A, $29, $23, $E5, $2A, $27
+mark_2970: DEFB $23, $18, $07, $2A, $32, $23, $E5, $2A
+mark_2978: DEFB $30, $23, $B7, $ED, $5A, $D1, $E8, $22
+mark_2980: DEFB $23, $23, $EB, $B7, $ED, $4A, $E8, $22
+mark_2988: DEFB $25, $23, $5F, $3E, $C0, $A4, $E0, $3E
+mark_2990: DEFB $C0, $A2, $E0, $D9, $E5, $D5, $C5, $CD
+mark_2998: DEFB $9F, $29, $C1, $D1, $E1, $D9, $C9, $D9
+mark_29A0: DEFB $7C, $B2, $37, $20, $05, $3A, $18, $23
+mark_29A8: DEFB $3D, $BD, $3A, $21, $23, $1F, $32, $21
+mark_29B0: DEFB $23, $7B, $CB, $7F, $28, $04, $2A, $10
+mark_29B8: DEFB $23, $E9, $F5, $E6, $03, $1F, $3D, $2F
+mark_29C0: DEFB $67, $9F, $6F, $22, $1E, $23, $E5, $CB
+mark_29C8: DEFB $5B, $20, $28, $3A, $20, $23, $AB, $E6
+mark_29D0: DEFB $FB, $28, $0F, $21, $34, $23, $7B, $07
+mark_29D8: DEFB $07, $07, $E6, $03, $85, $6F, $7E, $32
+mark_29E0: DEFB $21, $40, $CD, $2C, $28, $E1, $FD, $CB
+mark_29E8: DEFB $21, $0E, $38, $26, $7C, $A5, $28, $22
+mark_29F0: DEFB $2C, $5D, $E5, $3A, $21, $23, $CB, $6B
+mark_29F8: DEFB $20, $3D, $CB, $73, $20, $3E, $E1, $CB
+mark_2A00: DEFB $7F, $20, $0F, $E5, $CD, $00, $28, $A6
+mark_2A08: DEFB $32, $17, $23, $D1, $7E, $B2, $AB, $A0
+mark_2A10: DEFB $AE, $77, $F1, $32, $20, $23, $21, $2A
+mark_2A18: DEFB $23, $11, $2E, $23, $01, $08, $00, $CB
+mark_2A20: DEFB $67, $28, $11, $3A, $21, $23, $E6, $C0
+mark_2A28: DEFB $17, $30, $02, $CB, $F7, $32, $21, $23
+mark_2A30: DEFB $2E, $26, $0E, $04, $ED, $B8, $C9, $21
+mark_2A38: DEFB $FF, $FF, $18, $03, $2A, $0A, $23, $D9
+mark_2A40: DEFB $E6, $E0, $C2, $AD, $0E, $21, $21, $23
+mark_2A48: DEFB $FD, $36, $21, $55, $06, $03, $23, $23
+mark_2A50: DEFB $5E, $23, $23, $56, $D5, $10, $F7, $C1
+mark_2A58: DEFB $D1, $E1, $B7, $28, $02, $44, $4D, $78
+mark_2A60: DEFB $BC, $30, $03, $C5, $E3, $C1, $7C, $BA
+mark_2A68: DEFB $30, $01, $EB, $7A, $D9, $E6, $07, $3C
+mark_2A70: DEFB $47, $7C, $CB, $05, $07, $07, $07, $10
+mark_2A78: DEFB $F9, $67, $22, $38, $23, $D9, $7C, $B8
+mark_2A80: DEFB $3E, $07, $30, $03, $C5, $E3, $C1, $EB
+mark_2A88: DEFB $F5, $79, $D9, $67, $6F, $4F, $22, $1A
+mark_2A90: DEFB $23, $06, $FE, $D9, $93, $D9, $30, $04
+mark_2A98: DEFB $06, $00, $ED, $44, $57, $D9, $7A, $90
+mark_2AA0: DEFB $D9, $67, $BA, $30, $02, $EB, $04, $6C
+mark_2AA8: DEFB $2C, $5C, $CB, $3B, $F1, $0F, $30, $09
+mark_2AB0: DEFB $E5, $D5, $C5, $0F, $D9, $38, $CD, $18
+mark_2AB8: DEFB $CE, $D9, $60, $2E, $01, $C1, $D1, $E3
+mark_2AC0: DEFB $2D, $20, $16, $2A, $1A, $23, $79, $BC
+mark_2AC8: DEFB $38, $01, $67, $BD, $30, $01, $6F, $22
+mark_2AD0: DEFB $1A, $23, $E1, $2D, $28, $E7, $E5, $18
+mark_2AD8: DEFB $15, $7B, $92, $38, $0A, $5F, $CB, $40
+mark_2AE0: DEFB $28, $0C, $79, $80, $4F, $18, $D9, $84
+mark_2AE8: DEFB $5F, $3E, $01, $B0, $81, $4F, $79, $D9
+mark_2AF0: DEFB $FD, $CB, $21, $0E, $38, $CA, $E3, $D5
+mark_2AF8: DEFB $C5, $E5, $ED, $5B, $1A, $23, $47, $B9
+mark_2B00: DEFB $30, $02, $41, $4F, $ED, $43, $1A, $23
+mark_2B08: DEFB $79, $BB, $3C, $38, $01, $7B, $6F, $7A
+mark_2B10: DEFB $B8, $30, $02, $78, $3D, $95, $3C, $F5
+mark_2B18: DEFB $CD, $07, $28, $F1, $4F, $EB, $21, $39
+mark_2B20: DEFB $23, $7E, $07, $07, $07, $77, $2B, $CB
+mark_2B28: DEFB $06, $B6, $2A, $1E, $23, $AD, $2F, $6F
+mark_2B30: DEFB $EB, $7B, $AE, $B2, $A0, $AE, $77, $0D
+mark_2B38: DEFB $20, $14, $E1, $24, $CB, $7D, $28, $94
+mark_2B40: DEFB $E1, $E1, $E1, $E1, $7C, $A5, $CA, $12
+mark_2B48: DEFB $2A, $2C, $E5, $C3, $45, $2A, $CB, $18
+mark_2B50: DEFB $30, $DF, $23, $41, $79, $E6, $07, $4F
+mark_2B58: DEFB $CB, $38, $CB, $38, $CB, $38, $28, $08
+mark_2B60: DEFB $7B, $AE, $B2, $AE, $77, $23, $10, $F8
+mark_2B68: DEFB $37, $0C, $18, $CB, $2A, $13, $23, $2D
+mark_2B70: DEFB $B5, $C2, $09, $08, $25, $C2, $B8, $23
+mark_2B78: DEFB $3A, $21, $23, $17, $D8, $00, $00, $2A
+mark_2B80: DEFB $28, $23, $3A, $27, $23, $CB, $72, $20
+mark_2B88: DEFB $05, $6F, $C6, $08, $30, $0D, $7C, $D6
+mark_2B90: DEFB $08, $30, $04, $3A, $18, $23, $3D, $32
+mark_2B98: DEFB $29, $23, $AF, $32, $27, $23, $CB, $72
+mark_2BA0: DEFB $C0, $CD, $EF, $2E, $7D, $FE, $F9, $38
+mark_2BA8: DEFB $02, $1E, $02, $2F, $E6, $07, $3C, $57
+mark_2BB0: DEFB $7C, $3C, $D9, $57, $D9, $D5, $CD, $07
+mark_2BB8: DEFB $28, $D9, $79, $AE, $D9, $EB, $C1, $C5
+mark_2BC0: DEFB $6F, $26, $00, $29, $10, $FD, $EB, $06
+mark_2BC8: DEFB $02, $3A, $7B, $40, $AE, $FD, $B6, $7C
+mark_2BD0: DEFB $A2, $AE, $0D, $28, $01, $77, $53, $23
+mark_2BD8: DEFB $10, $EF, $0E, $20, $09, $D9, $23, $15
+mark_2BE0: DEFB $28, $02, $10, $D6, $E1, $C3, $9A, $29
+mark_2BE8: DEFB $ED, $57, $0F, $30, $08, $AF, $32, $22
+mark_2BF0: DEFB $40, $3C, $32, $13, $23, $CD, $CF, $0A
+mark_2BF8: DEFB $AF, $32, $13, $23, $FD, $36, $22, $02
+mark_2C00: DEFB $4F, $C9, $CD, $A0, $0C, $DA, $AD, $0E
+mark_2C08: DEFB $0E, $01, $C8, $0E, $FF, $C9, $FD, $46
+mark_2C10: DEFB $22, $0E, $21, $CD, $18, $09, $CD, $9B
+mark_2C18: DEFB $09, $7E, $12, $FD, $34, $3A, $2A, $0C
+mark_2C20: DEFB $40, $23, $54, $5D, $ED, $B1, $C3, $5D
+mark_2C28: DEFB $0A, $8B, $8D, $2D, $7F, $81, $49, $75
+mark_2C30: DEFB $5F, $40, $42, $2B, $17, $1F, $37, $52
+mark_2C38: DEFB $45, $0F, $6D, $2B, $44, $2D, $5A, $3B
+mark_2C40: DEFB $4C, $45, $0D, $52, $54, $4D, $15, $6A
+mark_2C48: DEFB $01, $14, $02, $06, $00, $81, $0E, $06
+mark_2C50: DEFB $DE, $05, $AB, $0D, $06, $00, $B5, $0E
+mark_2C58: DEFB $00, $DC, $0C, $00, $D8, $0E, $04, $14
+mark_2C60: DEFB $06, $DF, $06, $05, $B9, $0D, $04, $00
+mark_2C68: DEFB $2E, $0E, $05, $E8, $2B, $01, $00, $E9
+mark_2C70: DEFB $0E, $05, $A7, $2E, $05, $6A, $0D, $00
+mark_2C78: DEFB $C3, $03, $03, $AF, $0E, $03, $30, $07
+mark_2C80: DEFB $06, $1A, $06, $00, $92, $0E, $03, $6C
+mark_2C88: DEFB $0E, $05, $40, $03, $05, $4D, $2F, $00
+mark_2C90: DEFB $7C, $0E, $00, $B2, $0E, $03, $4E, $2E
+mark_2C98: DEFB $06, $1A, $06, $1A, $06, $00, $26, $29
+mark_2CA0: DEFB $2A, $A8, $0E, $E9, $00, $0E, $0C, $06
+mark_2CA8: DEFB $00, $AE, $2E, $03, $B2, $2E, $03, $B6
+mark_2CB0: DEFB $2E, $03, $53, $2F, $05, $CB, $0A, $03
+mark_2CB8: DEFB $2C, $07, $FD, $36, $01, $01, $CD, $73
+mark_2CC0: DEFB $0A, $CD, $95, $0A, $21, $00, $40, $36
+mark_2CC8: DEFB $FF, $21, $2D, $40, $CB, $6E, $28, $0E
+mark_2CD0: DEFB $FE, $E3, $7E, $C2, $6F, $0D, $CD, $A6
+mark_2CD8: DEFB $0D, $C8, $CF, $0C, $CF, $08, $DF, $06
+mark_2CE0: DEFB $00, $FE, $76, $C8, $4F, $E7, $79, $D6
+mark_2CE8: DEFB $E1, $38, $3B, $4F, $21, $29, $0C, $09
+mark_2CF0: DEFB $4E, $09, $18, $03, $2A, $30, $40, $7E
+mark_2CF8: DEFB $23, $22, $30, $40, $01, $F4, $0C, $C5
+;
+; bits shifting right within a byte:
+;
+mark_2D00: DEFB $80, $40, $20, $10, $08, $04, $02, $01
+;
+mark_2D08: DEFB $CD, $F7, $2B, $C3, $07, $02, $32, $28
+mark_2D10: DEFB $40, $EB, $21, $0A, $00, $39, $7E, $3C
+mark_2D18: DEFB $E6, $F0, $D6, $D0, $4F, $23, $7E, $D6
+mark_2D20: DEFB $04, $B1, $4F, $3A, $3B, $40, $07, $9F
+mark_2D28: DEFB $A1, $20, $10, $2A, $10, $40, $01, $DF
+mark_2D30: DEFB $FF, $09, $CB, $FC, $22, $04, $23, $3E
+mark_2D38: DEFB $01, $18, $0E, $2A, $0C, $40, $ED, $4B
+mark_2D40: DEFB $00, $23, $09, $CB, $FC, $22, $06, $23
+mark_2D48: DEFB $AF, $32, $19, $23, $2B, $7E, $EB, $C9
+mark_2D50: DEFB $3A, $19, $23, $3D, $C2, $73, $2D, $3E
+mark_2D58: DEFB $1E, $ED, $47, $ED, $6A, $2A, $04, $23
+mark_2D60: DEFB $01, $08, $01, $3E, $FE, $CD, $B5, $02
+mark_2D68: DEFB $3E, $1F, $ED, $47, $3A, $28, $40, $D6
+mark_2D70: DEFB $08, $18, $04, $2B, $3A, $28, $40, $4F
+mark_2D78: DEFB $DD, $E1, $FD, $CB, $3B, $7E, $C2, $9D
+mark_2D80: DEFB $02, $3E, $FE, $06, $01, $21, $9A, $2D
+mark_2D88: DEFB $CD, $95, $2D, $29, $00, $5F, $2A, $06
+mark_2D90: DEFB $23, $CB, $FC, $DD, $E9, $ED, $4F, $3E
+mark_2D98: DEFB $DD, $FB, $76, $21, $00, $22, $3E, $24
+mark_2DA0: DEFB $36, $01, $35, $28, $02, $CF, $1A, $23
+mark_2DA8: DEFB $BC, $20, $F5, $65, $11, $00, $20, $01
+mark_2DB0: DEFB $00, $01, $ED, $B0, $24, $14, $04, $ED
+mark_2DB8: DEFB $B0, $21, $F1, $07, $11, $A0, $23, $01
+mark_2DC0: DEFB $60, $00, $ED, $B0, $16, $20, $21, $B4
+mark_2DC8: DEFB $2F, $46, $18, $04, $5E, $23, $7E, $12
+mark_2DD0: DEFB $23, $10, $F9, $14, $CB, $52, $28, $F1
+mark_2DD8: DEFB $C9
+
+; Delete Display File:
+
+mark_2DD9: DEFB $CD, $E7, $02, $21, $87, $3E, $CD
+mark_2DE0: DEFB $D8, $09, $C0, $EB, $2A, $29, $40, $CB
+mark_2DE8: DEFB $76, $28, $04, $ED, $53, $29, $40, $2A
+mark_2DF0: DEFB $0C, $40, $C3, $5D, $0A, $CD, $D9, $2D
+mark_2DF8: DEFB $01, $92, $19, $2A, $0C, $40, $2B, $CD
+mark_2E00: DEFB $9E, $09, $3E, $76, $12, $13, $12, $23
+mark_2E08: DEFB $23, $36, $3E, $23, $36, $87, $23, $36
+mark_2E10: DEFB $8D, $23, $36, $19, $23, $77, $23, $77
+mark_2E18: DEFB $CD, $07, $02, $3E, $01, $18, $37
+; Check & Set Up Display File:
+mark_2E1F: DEFB $2A
+mark_2E20: DEFB $65, $22, $11, $D9, $BF, $19, $3A, $64
+mark_2E28: DEFB $22, $D6, $21, $B4, $B5, $C4, $9B, $2D
+mark_2E30: DEFB $2A, $0C, $40, $3E, $76, $2B, $2B, $BE
+mark_2E38: DEFB $C4, $F5, $2D, $2A, $0C, $40, $ED, $5B
+mark_2E40: DEFB $00, $23, $19, $22, $06, $23, $11, $09
+mark_2E48: DEFB $00, $19, $22, $08, $23, $C9, $CD, $02
+mark_2E50: DEFB $0C, $C0
+; Clear The Screen:
+mark_2E52: DEFB $3D, $FA, $2A, $0A, $F5, $CD
+mark_2E58: DEFB $1F, $2E, $F1, $FE, $02, $ED, $4B, $18
+mark_2E60: DEFB $23, $2A, $0C, $40, $30, $30, $3D, $23
+mark_2E68: DEFB $22, $0E, $40, $2B, $2B, $2B, $1E, $00
+mark_2E70: DEFB $06, $10, $2B, $73, $2B, $73, $2B, $77
+mark_2E78: DEFB $2B, $77, $10, $FA, $0D, $20, $F1, $06
+mark_2E80: DEFB $09, $3E, $01, $2B, $73, $10, $FC, $21
+mark_2E88: DEFB $34, $23, $06, $14, $3D, $28, $F4, $21
+mark_2E90: DEFB $21, $18, $22, $39, $40, $C9, $C0, $2B
+mark_2E98: DEFB $2B, $06, $20, $2B, $2B, $2B, $7E, $2F
+mark_2EA0: DEFB $77, $10, $FA, $0D, $20, $F3, $C9, $2A
+mark_2EA8: DEFB $96, $0A, $3E, $4D, $18, $35, $3E, $DD
+mark_2EB0: DEFB $18, $2E, $3E, $D6, $18, $02, $3E, $CE
+mark_2EB8: DEFB $F5, $CD, $02, $0C, $06, $1E, $3D, $FE
+mark_2EC0: DEFB $06, $30, $19, $CB, $3F, $67, $28, $02
+mark_2EC8: DEFB $3E, $01, $F5, $9F, $6F, $CB, $8C, $25
+mark_2ED0: DEFB $22, $7B, $40, $CD, $1F, $2E, $06, $1F
+mark_2ED8: DEFB $F1, $32, $14, $23, $78, $ED, $47, $F1
+mark_2EE0: DEFB $2A, $71, $0D, $85, $6F, $E9, $57, $3A
+mark_2EE8: DEFB $39, $40, $E6, $80, $C3, $6C, $2B, $7A
+mark_2EF0: DEFB $D1, $D9, $E5, $D5, $C5, $2A, $0C, $23
+mark_2EF8: DEFB $87, $30, $0B, $2A, $0E, $23, $CB, $77
+mark_2F00: DEFB $28, $04, $2A, $15, $23, $3F, $EB, $6F
+mark_2F08: DEFB $26, $00, $9F, $4F, $3A, $7B, $40, $2F
+mark_2F10: DEFB $FD, $A6, $7C, $A9, $4F, $29, $29, $19
+mark_2F18: DEFB $06, $08, $D9, $D5, $C9, $FD, $35, $39
+mark_2F20: DEFB $3E, $18, $90, $47, $87, $87, $87, $6F
+mark_2F28: DEFB $3A, $18, $23, $95, $D8, $3E, $21, $91
+mark_2F30: DEFB $4F, $26, $00, $29, $09, $ED, $4B, $08
+mark_2F38: DEFB $23, $09, $CD, $EF, $2E, $01, $22, $00
+mark_2F40: DEFB $D9, $79, $AE, $D9, $77, $09, $D9, $23
+mark_2F48: DEFB $10, $F7, $C3, $9A, $29, $CD, $D9, $2D
+mark_2F50: DEFB $C3, $F6, $02, $CD, $02, $0C, $C0, $3D
+mark_2F58: DEFB $FA, $69, $08, $CD, $1F, $2E, $CD, $E7
+mark_2F60: DEFB $02, $3A, $18, $23, $47, $2A, $08, $23
+mark_2F68: DEFB $AF, $5F, $D3, $FB, $3E, $7F, $DB, $FE
+mark_2F70: DEFB $0F, $D2, $86, $08, $DB, $FB, $87, $FA
+mark_2F78: DEFB $AD, $2F, $30, $F0, $0E, $20, $C5, $4E
+mark_2F80: DEFB $06, $08, $CB, $01, $1F, $B3, $57, $DB
+mark_2F88: DEFB $FB, $1F, $30, $FB, $7A, $D3, $FB, $10
+mark_2F90: DEFB $F1, $23, $C1, $0D, $20, $E8, $23, $23
+mark_2F98: DEFB $3E, $03, $B8, $38, $02, $5F, $1D, $DB
+mark_2FA0: DEFB $FB, $1F, $30, $FB, $7B, $D3, $FB, $10
+mark_2FA8: DEFB $C3, $3E, $04, $D3, $FB, $C3, $07, $02
+mark_2FB0: DEFB $FB, $10, $C3, $3E, $0A, $12, $A0, $13
+mark_2FB8: DEFB $23, $15, $A4, $16, $23, $40, $C1, $60
+mark_2FC0: DEFB $08, $61, $2D, $75, $06, $76, $23, $01
+mark_2FC8: DEFB $0A, $54, $02, $85, $C1, $7F, $73, $80
+mark_2FD0: DEFB $2D, $8D, $50, $8E, $2D, $E3, $C3, $E4
+mark_2FD8: DEFB $0E, $E5, $2D, $13, $00, $75, $01, $E6
+mark_2FE0: DEFB $0A, $55, $0D, $1E, $0F, $1E, $16, $20
+mark_2FE8: DEFB $10, $07, $11, $08, $18, $C0, $35, $EE
+mark_2FF0: DEFB $36, $55, $37, $C6, $AD, $E6, $AE, $2E
+mark_2FF8: DEFB $F2, $C3, $F3, $1D, $F4, $2F, $ED, $00
+;
+#else
+; G007 source code, reverse engineered.
+;
+; The ZX81 labels will have been generated already.
+; No need to include ZX definitions:
+;
+
+
+;===============================
+; G007 Hi-Res graphics board for the ZX81
+;
+; Source code partially reverse-engineered.
+; A work in progress...
+;
+; 2011-05-15 Assembles to create correct ROM image.
+;
+; Verifed by comparing the hex files,
+; the known-good reference generated by
+; 2048 defb statements containing the original bytes.
+;
+; The source code below is not guaranteed to create the ROM image
+; exactly the way the original author had in mind,
+; as I'm not him and I don't have the original source code.
+;
+; This file was created from a disassembly generated by the
+; impressive VB81 emulator program.
+;
+; It was already know that the G007 switched out pages of
+; the ZX81 BASIC ROM and patched in replacements from
+; the G007 ROM and the ZX81's internal 1K (or 2K) RAM.
+; This is a thrifty use of RAM that expansion RAM packs
+; usually just disabled.
+;
+; Memory map:
+;
+; 0000-0FFF
+; 2000-23FF 1K RAM inside ZX81, remapped here.
+; 2400-27FF 1K RAM more RAM if ZX81 has a 2K RAM chip
+; 2800-2FFF 2K G007
+; 3000-3FFF Empty
+; 4000-7FFF External RAM pack
+;
+; Patching:
+;
+; 2C00-2CFF (ROM) also appears at 0C00-0CFF
+; 2000-20FF (RAM) also appears at 0000-00FF
+; 2200-22FF (RAM) also appears at 0200-02FF
+;
+; The ROM patching is active all the time.
+; The RAM patching is active only in hi-res mode.
+;
+; The patches didn't cover every modification needed,
+; so one routine is copied from ROM to RAM and
+; then individual bytes are modified there
+; by the initialisation routine which also
+; initialises some variables.
+;
+; Graphics routines:
+;
+; These have not yet been analysed.
+; Bresenham's algorithm will be there is some form.
+;
+; Triangle-filling is a sophisticated feature,
+; using 8-bit maths for a practical speed.
+;
+; Future enhancements
+;
+; Programmers may like to try writing faster routines,
+; or adding more commands now that memory is cheap.
+;
+; The bit-mask array at $2D00 looks like this:
+; 10000000
+; 01000000
+; 00100000
+; 00010000
+; 00001000
+; 00000100
+; 00000010
+; 00000001
+;
+; and suggests that pixels
+; may be plotted one at a time.
+; When I wrote a triangle-filling algorithm for the Atom,
+; I made frequent use of horizontal lines.
+; I optimised these by working out the partially-filled
+; bytes at the left and right sides, and writing
+; whole bytes (of 8 pixels) between the partial bytes.
+; This used two overlapping tables like so:
+;
+; 10000000 ; BIT_MASK_R
+; 11000000
+; 11100000
+; 11110000
+; 11111000
+; 11111100
+; 11111110
+; 11111111 ; BIT_MASK_L
+; 01111111
+; 00111111
+; 00011111
+; 00001111
+; 00000111
+; 00000011
+; 00000001
+;
+; This technique might be able to increase the triangle filling speed.
+;
+; A proper ellipse algorithm would also be welcome,
+; not one of those approximations using polygons!
+;
+;===============================
+; Assembly was done by a very handy online tool:
+; http://k1.dyndns.org/cgi-bin/zasm.cgi
+; which avoids the chore of installing it
+; on one's own machine.
+; The online tool is limited to one source file and
+; one include file, but that's not a big deal
+; for a tiny 2K ROM like this one.
+;
+;===============================
+; Problems
+; The G007 ROM had several instances of opcdoes
+; beginning with FD CB
+; involving the Y register.
+; VB81 disassembled them into statements
+; that looked mangled and would not re-assemble.
+; So I've just added them with defb statements.
+;
+;
+;===============================
+; Global constants:
+;===============================
+FALSE equ 0
+NOT_G007 equ FALSE
+
+
+
+;===============================
+; ZX81 constants:
+;===============================
+; ZX characters (not the same as ASCII)
+;-------------------------------
+ZX_EQU equ $14
+ZX_COMMA equ $1A
+ZX_THEN equ $DE
+ZX_TO equ $DF
+ZX_INV_K equ $B0
+ZX_NEWLINE equ $76
+HRG_BYTES_PER_LINE equ 34
+ALL_BITS_SET equ -1
+;-------------------------------
+; tokens
+;-------------------------------
+_CLASS_00 equ 0
+_CLASS_01 equ 1
+_CLASS_02 equ 2
+_CLASS_03 equ 3
+_CLASS_04 equ 4
+_CLASS_05 equ 5
+_CLASS_06 equ 6
+;===============================
+; ZX81 I/O locations:
+;===============================
+IO_PORT_KEYBOARD_RD equ $FE ; A0 low
+ZX_NMI_GEN equ $FD ; A1 low
+ZX_PRINTER_PORT equ $FB ; A2 low
+;===============================
+; ZX81 RAM variables
+;===============================
+RAMBASE equ $4000
+ERR_NR equ $4000
+FLAGS equ $4001
+ERR_SP equ $4002
+RAMTOP equ $4004
+MODE equ $4006
+PPC equ $4007
+VERSN equ $4009
+E_PPC equ $400A
+D_FILE equ $400C
+DF_CC equ $400E
+VARS equ $4010
+DEST equ $4012
+E_LINE equ $4014
+CH_ADD equ $4016
+X_PTR equ $4018
+STKBOT equ $401A
+STKEND equ $401C
+BERG equ $401E
+MEM equ $401F
+UNUSED_8 equ $4021
+G007_FLAG_Y equ UNUSED_8 ;
+
+DF_SZ equ $4022
+S_TOP equ $4023
+LAST_K equ $4025
+DEBOUNCE equ $4027
+MARGIN equ $4028
+NXTLIN equ $4029
+NXT_LINE equ $4029
+OLDPPC equ $402B
+FLAGX equ $402D
+
+STRLEN equ $402E
+T_ADDR equ $4030
+SEED equ $4032
+FRAMES equ $4034
+COORDS equ $4036
+PR_CC equ $4038
+S_POSN equ $4039
+S_POSN_hi equ S_POSN+1
+CDFLAG equ $403B
+PRBUFF equ $403C
+MEMBOT equ $407B
+PROGRAM equ $407D
+UNUSED_16 equ $407B
+UNUSED_16_hi equ UNUSED_16+1
+
+G007_RESTART equ UNUSED_16
+
+; First byte after system variables:
+USER_RAM equ $407D
+MAX_RAM equ $7FFF
+
+;===============================
+; ZX BASIC ROM addresses
+;===============================
+; restart constants
+START equ $0000 ; = 0
+ERROR_1 equ $0008 ; = 8
+PRINT_A equ $0010 ; = 16
+GET_CHAR equ $0018 ; = 24
+TEST_SP equ $001C ; = 28
+NEXT_CH equ $0020 ; = 32
+FP_CALC equ $0028 ; = 40
+;-------------------------------
+L0108 equ $0108
+SLOW_FAST equ $0207 ;
+DISPLAY_5 equ $02B5 ;
+L029D equ $029D ; Inside the 'LOC_ADDR' subroutine
+SET_FAST equ $02E7
+LOAD equ $0340
+LIST equ $0730
+COPY equ $0869
+SAVE equ $02F6
+NEW equ $03C3
+LLIST equ $072C
+PRINT_CH equ $07F1 ; old, replaced
+L0809 equ $0809
+LOC_ADDR equ $0918
+ONE_SPACE equ $099B
+MAKE_ROOM equ $099E
+LINE_ADDR equ $09D8
+E_LINE_NO equ $0A73
+L0A95 equ $0A95 ; []*BIOS ROM*. Part way into 088A COPY_CONT
+PRINT equ $0ACF
+CLS equ $0A2A
+RECLAIM_1 equ $0A5D
+LPRINT equ $0ACB
+PRINT equ $0ACF
+PLOT_UNPLOT equ $0BAF
+L0BB2 equ $0BB2 ;
+STK_TO_A equ $0C02
+SCROLL equ $0C0E
+
+;-------------------------------
+; Parameter table addresses:
+; Checked in ROM disassembly book:
+;-------------------------------
+P_LET equ $0C48
+P_GOTO equ $0C4B
+P_IF equ $0C4F
+P_GOSUB equ $0C54
+P_STOP equ $0C58
+P_RETURN equ $0C5B
+P_FOR equ $0C5E
+P_NEXT equ $0C66
+P_PRINT equ $0C6A
+P_INPUT equ $0C6D
+P_DIM equ $0C71
+P_REM equ $0C74
+P_NEW equ $0C77
+P_RUN equ $0C7A
+P_LIST equ $0C7D
+P_POKE equ $0C80
+P_RAND equ $0C86
+P_LOAD equ $0C89
+P_SAVE equ $0C8C
+P_CONT equ $0C8F
+P_CLEAR equ $0C92
+P_CLS equ $0C95
+
+P_PLOT equ $0C98 ; redefined in G007 patch
+P_UNPLOT equ $0C9E ; redefined in G007 patch
+P_SCROLL equ $0CA4
+
+P_PAUSE equ $0CA7
+;P_SLOW equ $0CAB
+;P_FAST equ $0CAE
+;P_COPY equ $0CB1
+;P_LPRINT equ $0CB4
+;P_LLIST equ $0CB7
+;-------------------------------
+
+STOP equ $0CDC ; defined in this file
+
+REM equ $0D6A
+INPUT_RE equ $0D6F
+
+REPORT_C equ $0D9A ; according to the book
+REPORT_C_007 equ $0D26 ; seems the right one
+SYNTAX_Z equ $0DA6
+IF equ $0DAB
+FOR equ $0DB9
+
+NEXT equ $0E2E
+RAND equ $0E6C
+CONT equ $0E7C
+GOTO equ $0E81
+POKE equ $0E92
+L0EA8 equ $0EA8 ; Inside the 'FIND_INT.' subroutine
+REPORT_B equ $0EAD
+ ; check this!!!
+RUN equ $0EAF
+CLEAR_007 equ $0EB2 ; goes to JP CLEAR
+GOSUB equ $0EB5
+RETURN equ $0ED8
+INPUT equ $0EE9
+
+FAST equ $0F23
+SLOW equ $0F2B
+PAUSE equ $0F32
+
+DIM equ $1409
+CLEAR equ $149A
+SET_MEM equ $14BC
+
+
+;===============================
+; G007 Memory patch addresses
+;===============================
+; These patches only appear in hi-res mode
+;
+RAM_PATCH_0000 equ $0000
+RAM_PATCH_0200 equ $0200
+ROM_PATCH_0C00 equ $0C00
+;
+; Their aliases are always present:
+;
+RAM_PATCH_2000 equ $2000
+RAM_PATCH_2200 equ $2200
+;===============================
+; G007 Plot number notes (a work in prgress)
+;===============================
+; N-1
+;
+; 76543 210
+; ..... .00 Line in white.
+; ..... .01 Line black.
+; ..... .10 Line inverting.
+; ..... .11 Line inverting, omit last pixel.
+;
+; ..... 0.. Absolute co-ordinates
+; ..... 1.. Relative co-ordinates
+;
+; ....0 ... Line
+; ....1 ... Single pixel
+;
+; .0100 ... Coarse dotted line
+; .0101 ... Add 40: triangle, plain
+; .1001.... Add 72: triangle, textured (not available in invert mode)
+; .1000 ... Add 64: fine dotted line
+; .1100 ... Add 96: chain dotted line
+;
+; Note that PLOT 12 and PLOT 16 miss out the pixel, so simply move the PLOT position.
+;
+
+
+
+
+
+;===============================
+; G007 Byte constants
+;===============================
+
+
+
+
+
+G007_INT_REG_VALUE_FOR_HI_RES_GRAPHICS equ $1F
+G007_INT_REG_VALUE_FOR_LO_RES_GRAPHICS equ $1E
+
+; Dec. Hex. Bytes System Variables: G007
+
+; 8448 2100 Reserved for user defined characters
+; 8703 21FF
+;
+; 8704 2200 Another page, possibly
+; 8959 22FF
+
+;===============================
+; G007 Byte constants
+;===============================
+MEM_PATCH_SIZE equ $0100
+;===============================
+; G007 RAM variables
+;===============================
+
+V2265 equ $2265
+V2264 equ $2264
+
+; Dec. Hex. Bytes System Variables: G007
+; 8960 2300 2 Offset of hi-res display file, less 9, from the D-FILE variable
+; 8962 2302 2 Not used
+; 8964 2304 2 Start address of last line of lo-res display file
+
+G007_DISPLAY_OFFSET_FROM_DFILE_LESS_9 equ $2300 ; conflict!
+
+G007_UNUSED_2302 equ $2302
+G007_DISPLAY_ADDRESS_LO_RES_LAST_LINE equ $2304
+G007_DISPLAY_ADDRESS_LESS_9 equ $2306 ; 8966 2306 2 Start address of hi-res display file, less 9 (used for video)
+G007_DISPLAY_ADDRESS equ $2308 ; 8968 2308 2 Start address of hi-res display file
+G007_TRIANGLE_TEXTURE equ $230A ; 8970 230A 2 Bytes defining triangle texture
+G007_CHAR_TABLE_ADDR_0_63 equ $230C ; 8972 230C 2 Character table address for CHR$0-63
+G007_CHAR_TABLE_ADDR_128_159 equ $230E ; 8974 230E 2 Character table address for CHR$128-159
+G007_PLOT_ROUTINES_VECTOR equ $2310 ; 8976 2310 2 Vector for additional plot routines
+G007_FLAG_0 equ $2312 ; 8978 2312 3 * Various flags
+G007_FLAG_1 equ $2313
+G007_FLAG_2 equ $2314
+G007_USR_DEF_CHR_TAB_LESS_256 equ $2315 ; 8981 2315 2 Address of user-defined character table, less 256
+G007_READ_POINT_BYTE equ $2317 ; 8983 2317 1 Read-point byte. Non-zero if pixel is set.
+G007_DISPLAY_HEIGHT equ $2318 ; 8984 2318 1 * Display height, normally 192
+G007_FLAG_3 equ $2319 ; 8985 2319 1 Flags
+
+;G007_TEMP_WORD_0 equ $231C ;
+G007_TEMP_BYTE_0 equ $231A ; 9886 231A 7 Temporary variables for PLOT routine.
+G007_TEMP_BYTE_1 equ $231B
+
+G007_TEMP_WORD_1 equ $231C ;
+;G007_TEMP_BYTE_2 equ $231C
+;G007_TEMP_BYTE_3 equ $231D
+
+G007_TEMP_WORD_2 equ $231E ;
+G007_TEMP_BYTE_4 equ $231E
+G007_TEMP_BYTE_5 equ $231F
+
+G007_TEMP_BYTE_6 equ $2320
+G007_OUT_OF_RANGE_FLAGS equ $2321 ; 8993 2321 1 Plot out of range flags. Bit 7 = latest statement
+G007_UNUSED equ $2322 ; 8994 2322 1 Not used
+G007_PLOT_X equ $2323 ; 8995 2323 2 X co-ordinate for PLOT. Signed 16-bit
+G007_PLOT_Y equ $2325 ; 8997 2325 2 Y co-ordinate for PLOT. Signed 16-bit
+G007_PLOT_X_PREVIOUS_N1 equ $2327 ; 8999 2327 8 X and Y co-ordinates for previous two statements
+G007_PLOT_Y_PREVIOUS_N1 equ $2329
+G007_PLOT_X_PREVIOUS_N2 equ $232B
+G007_PLOT_Y_PREVIOUS_N2 equ $232D
+G007_FLAG_4 equ $232F ; 9007 232F 1 Flags
+G007_ORIGIN_Y equ $2330 ; 9008 2330 2 Y co-ordinate of graphics origin
+G007_ORIGIN_X equ $2332 ; 9010 2332 2 X co-ordinate of graphics origin
+G007_LINE_TYPE equ $2334 ; 9012 2334 4 Bytes defining four line types
+G007_TEMP_BYTE_7 equ $2338 ; 9016 2338 2 Temporary variable for PLOT
+G007_TEMP_BYTE_8 equ $2339 ;
+G007_V23A0 equ $23A0
+;===============================
+; G007 RAM routines
+;===============================
+; Yes, there is such a thing!
+L23B8 equ $23B8
+;===============================
+; G007 ROM routines
+;===============================
+L2BF7 equ $2BF7 ; invalid opcode address
+SLOW_FAST_007 equ $2D08 ; new!
+;===============================
+; Needed by zasm:
+#target rom ; declare target file format
+#code $2800,$0800 ; declare code segment start and size
+;
+;===============================
+; G007 ROM assembly code
+;===============================
+; Start of ROM contents;
+; 10240/12287 : 2800/2FFF
+;===============================
+G007_GET_PIXEL_ADDRESS_AND_MASK: ;
+ LD HL,(G007_PLOT_X) ; X co-ordinate for PLOT. Signed 16-bit. Fetch 16 bits
+L2803:
+ LD A,(G007_PLOT_Y) ; Y co-ordinate for PLOT. Signed 16-bit. Fetch 8 bits
+ LD H,A ; and store in H
+L2807:
+ EX DE,HL ; then swap it into D
+ LD A,(G007_DISPLAY_HEIGHT)
+ DEC A;
+ SUB D ;
+ LD D,A
+ LD A,7 ; A must be 0 to 7
+ AND A,E ; E is the LS byte of the X co-ordinate
+ LD L,A ; L = A = selects bit-mask
+ LD H,$2D ; bit-mask array is at $2D00
+ LD A,(HL) ; get byte with bit set at appropriate position
+
+ LD HL,(G007_DISPLAY_ADDRESS) ; Start address of hi-res display file
+;-------------------------------
+; Add two bytes for every line
+;
+ LD C,D ; BC = Y coordinate
+ LD B,0
+ ADD HL,BC ; HL += BC*2
+ ADD HL,BC
+;-------------------------------
+; DE /= 8 gets byte offset from left of screen
+;
+ SRL D ; shift DE right
+ RR E
+ SRL D ; shift DE right
+ RR E
+ SRL D ; shift DE right
+ RR E
+
+ ADD HL,DE ; HL = G007_DISPLAY_ADDRESS + byte offset of XY-co-ordinates
+ LD B,A ; A and B hold the bitmask
+ RET ; return
+;===============================
+L282C:
+ LD A,(G007_OUT_OF_RANGE_FLAGS) ; Plot out of range flags. Bit 7 = latest statement
+
+ LD HL,(G007_PLOT_X_PREVIOUS_N1)
+ LD DE,(G007_PLOT_X) ; X co-ordinate for PLOT. Signed 16-bit
+
+ EXX
+
+ LD HL,(G007_PLOT_Y)
+ LD DE,(G007_PLOT_Y_PREVIOUS_N1)
+
+ ; test two most recent out-of-range flag bits:
+ BIT 6,A
+ JR Z,L285E
+ BIT 7,A
+ RET NZ
+
+ LD A,(G007_FLAG_Y);
+ PUSH AF
+ LD B,8
+;-------------------------------
+loop_284B:
+ RRCA
+
+;284C FD;CB;21;16 LD C,SLA (IY+CH_ADD-RAMBASE) output from VB81 disassembler
+
+#if 1
+ RL (IY+G007_FLAG_Y-RAMBASE) ; makes FD CB 21 16 - correct!
+#else ; force bytes
+ defb $FD
+ defb $CB
+ defb $21
+ defb $16
+#endif
+ DJNZ loop_284B
+;-------------------------------
+ EX DE,HL
+ EXX
+ EX DE,HL
+ EXX
+ CALL L285E
+ POP AF
+ LD (G007_FLAG_Y),A;
+ RET
+;===============================
+L285E:
+ LD BC,-HRG_BYTES_PER_LINE ; NB negative number = $FFDE
+ LD A,(G007_DISPLAY_HEIGHT)
+ DEC A
+ SUB E
+ SBC HL,DE
+ JP P,L2876
+;-------------------------------
+ LD BC,HRG_BYTES_PER_LINE
+ LD A,E
+
+ PUSH DE
+ ADD HL,DE
+ EX DE,HL
+ OR A,A
+ SBC HL,DE
+ POP DE
+;-------------------------------
+L2876:
+ PUSH HL
+ LD H,E
+ LD E,A
+ EXX
+
+ LD BC,L28FB
+ LD A,L
+ EXX
+ LD L,A
+ EXX
+ OR A,A
+ SBC HL,DE
+ JP P,L2890 ; [10384]
+;-------------------------------
+ LD BC,L2904
+ CPL
+ ADD HL,DE
+ EX DE,HL
+ OR A,A
+ SBC HL,DE
+L2890:
+ LD (G007_TEMP_BYTE_0),BC ; Temporary variables for PLOT routine.
+ POP DE
+ OR A,A
+ SBC HL,DE
+ ADD HL,DE
+ JR NC,L28A4
+;-------------------------------
+ EX DE,HL
+
+ LD BC,L28F6
+ EXX
+ LD D,E
+ LD E,A
+ LD A,D
+ EXX
+L28A4:
+ LD (G007_TEMP_WORD_1),BC
+ EXX
+ LD D,A
+;-------------------------------
+ PUSH DE
+ EXX
+ POP BC
+;-------------------------------
+ LD A,(G007_OUT_OF_RANGE_FLAGS) ; Plot out of range flags. Bit 7 = latest statement
+ CP $40
+ JR NC,L28B6
+;-------------------------------
+ LD B,L ; BC = LE
+ LD C,E
+;-------------------------------
+L28B6:
+ INC B
+ INC C
+;-------------------------------
+L28B8:
+ SRL H
+ JR C,L28BE
+
+ JR Z,L28C6
+;-------------------------------
+L28BE:
+ RR L
+ SRL D
+ RR E
+ JR L28B8
+;-------------------------------
+L28C6:
+ LD D,L
+ SRL L
+ EXX
+ PUSH BC
+ CALL L2807
+ POP DE
+ LD A,(G007_TEMP_BYTE_5)
+ LD C,A
+;-------------------------------
+L28D3:
+; Bytes from disassembler:
+;28D3 FD;CB;21;06 LD C,SLA (IY+6)
+#if 1
+ RLC (IY+G007_FLAG_Y-RAMBASE) ; makes FD CB 21 06
+#else
+; force bytes
+ defb $FD
+ defb $CB
+ defb $21
+ defb $06
+#endif
+
+ JR C,L28E1
+;-------------------------------
+ LD A,(G007_TEMP_BYTE_4)
+ XOR A,(HL)
+ OR A,C
+ AND A,B
+ XOR A,(HL)
+ LD (HL),A
+;-------------------------------
+L28E1:
+ EXX
+
+ LD A,L
+ DEC B
+ RET Z
+;-------------------------------
+ SUB E
+ JR NC,L28F2
+;-------------------------------
+ DEC C
+ RET Z
+;-------------------------------
+ ADD A,D
+ EXX
+ ADD HL,DE
+ EXX
+ LD HL,(G007_TEMP_BYTE_0) ; Temporary variables for PLOT routine.
+ JP (HL)
+;-------------------------------
+L28F2:
+ LD HL,(G007_TEMP_WORD_1)
+ JP (HL)
+;-------------------------------
+L28F6:
+ LD L,A
+ EXX
+ ADD HL,DE
+ JR L28D3
+;-------------------------------
+L28FB:
+ LD L,A
+ EXX
+ RLC B
+ JR NC,L28D3
+;-------------------------------
+ DEC HL
+ JR L28D3
+;-------------------------------
+L2904:
+ LD L,A
+ EXX
+
+ RRC B
+ JR NC,L28D3
+;-------------------------------
+ INC HL
+ JR L28D3
+;-------------------------------
+G007_INTEGER_FROM_STACK_TO_BC:
+ LD HL,(L0EA8) ; Inside the 'FIND_INT.' subroutine
+ ; 0EA7 FIND_INT CALL 158A,FP_TO_BC
+ ; so 0EA8 should contain $158A, pointing to the FP_TO_BC routine
+ JP (HL) ; exit
+;===============================
+G007_INTEGER_FROM_STACK_TO_HL:
+ CALL G007_INTEGER_FROM_STACK_TO_BC ; get an integer
+ JR C,L2924
+;-------------------------------
+ LD HL,0
+ JR Z,L2921
+;-------------------------------
+ SBC HL,BC ; HL = 0 - BC
+ RET M
+ RET Z
+;-------------------------------
+ JR L2924
+;-------------------------------
+L2921:
+ ADC HL,BC
+ RET P
+;-------------------------------
+L2924:
+ POP HL
+ RET
+;===============================
+;
+G007_PLOT_UNPLOT_N_X_Y: ; takes parameters from the stack
+;
+ CALL G007_INTEGER_FROM_STACK_TO_HL ; get Y
+ LD (G007_PLOT_Y),HL
+ CALL G007_INTEGER_FROM_STACK_TO_HL ; get X
+ PUSH HL
+ CALL STK_TO_A ; get N
+ ;
+ POP BC ; BC = X
+ LD DE,(G007_PLOT_Y) ; DE = Y
+ JR Z,G007_PLOT ;
+ DEC A ; if (N-1) is zero
+ RET NZ
+;-------------------------------
+ LD HL,L0C9C ; then T_ADDR = HL = L0C9C
+ LD (T_ADDR),HL ;
+;-------------------------------
+L2942:
+ LD B,E
+ JP L0BB2 ; []*BIOS ROM*
+;===============================
+; The Plot Routine:
+; A == the plot number N
+; BC == screen X
+; DE == screen Y
+;-------------------------------
+G007_PLOT:
+ OR A,A
+ JR Z,L2942
+;-------------------------------
+ DEC A ; when PLOT N value is decremented, bits make more sense
+;-------------------------------
+ PUSH DE ; push screen Y
+ PUSH BC ; push screen X
+ PUSH AF ; push plot number-1
+
+ CALL G007_CHECK_AND_SET_UP_DISPLAY_FILE
+
+ POP AF
+ POP DE
+ POP BC ; NB BC and DE are swapped
+;-------------------------------
+ CP $81 ; Was A=129 (PLOT 130 sets graphics origin)
+ JR NZ,G007_PLOT_XY_TO_HISTORY
+
+;-------------------------------
+G007_ORIGIN_SET:
+ ;
+ LD (G007_ORIGIN_Y),DE ; Y co-ordinate of graphics origin
+ LD (G007_ORIGIN_X),BC ; X co-ordinate of graphics origin
+ LD BC,$0000 ; BC = 0
+ LD D,B ; DE = BC = 0
+ LD E,B
+ LD A,$0B
+
+;-------------------------------
+G007_PLOT_XY_TO_HISTORY:
+ ;
+ BIT 2,A; ; the (PLOT_N -1)
+ JR Z,G007_PLOT_ABSOLUTE
+
+;-------------------------------
+G007_PLOT_RELATIVE: ;
+ LD HL,(G007_PLOT_Y_PREVIOUS_N1)
+ PUSH HL
+ LD HL,(G007_PLOT_X_PREVIOUS_N1)
+ JR G007_PLOT_ABSOLUTE_OR_RELATIVE
+;===============================
+G007_PLOT_ABSOLUTE:
+ LD HL,(G007_ORIGIN_X) ; X co-ordinate of graphics origin
+ PUSH HL
+ LD HL,(G007_ORIGIN_Y) ; Y co-ordinate of graphics origin
+;------------------------------- ;
+ ;
+G007_PLOT_ABSOLUTE_OR_RELATIVE: ;
+ OR A,A ; update flags
+ ADC HL,DE ; HL = G007_PLOT_Y + G007_ORIGIN_Y
+ POP DE ; DE = G007_PLOT_X co-ordinate of graphics origin
+ RET PE
+;-------------------------------
+ LD (G007_PLOT_X),HL ; record plot X
+ EX DE,HL
+ OR A,A ; restore Flags
+ ADC HL,BC ; HL = G007_PLOT_X + G007_ORIGIN_X
+ RET PE
+;-------------------------------
+ LD (G007_PLOT_Y),HL ; record plot Y
+ LD E,A
+ LD A,%11000000 ; $C0
+ AND A,H ;
+ RET PO;
+;-------------------------------
+ LD A,%11000000 ; $C0
+ AND A,D
+ RET PO
+;------------------------------- ; push alternate HL,DE,BC
+ EXX
+ PUSH HL
+ PUSH DE
+ PUSH BC
+ CALL G007_RANGE_CHECK
+;------------------------------- ; pop alternate BC,DE,HL
+L299A:
+ POP BC
+ POP DE
+ POP HL
+ EXX
+ RET
+;===============================
+G007_RANGE_CHECK:
+ EXX
+ LD A,H ; A = H OR D
+ OR A,D
+ SCF
+ JR NZ,G007_RANGE_CHECK_UPDATE ; if not zero, out of range already so ignore display height
+;-------------------------------
+ LD A,(G007_DISPLAY_HEIGHT) ; check Y coordinate
+ DEC A ; if (G007_DISPLAY_HEIGHT - Y ) is less than zero,
+ CP L ; set the Carry flag
+;-------------------------------
+G007_RANGE_CHECK_UPDATE: ; latest flag in Carry is shifted into history flags
+ LD A,(G007_OUT_OF_RANGE_FLAGS) ;
+ RRA ; shift bits right. Bit 7 = latest statement
+ LD (G007_OUT_OF_RANGE_FLAGS),A ;
+ LD A,E ; E bit 7
+ BIT 7,A
+ JR Z,L29BA
+;------------------------------- ; gets here if PLOT_N is over 130
+ LD HL,(G007_PLOT_ROUTINES_VECTOR) ; Vector for additional plot routines
+ JP (HL) ; This looks very promising,
+ ; makes it easy to bolt-on extra graphics routines
+;===============================
+L29BA:
+ PUSH AF
+ AND 3
+ RRA
+ DEC A
+ CPL
+ LD H,A
+ SBC A,A
+ LD L,A
+ LD (G007_TEMP_WORD_2),HL
+ PUSH HL
+ BIT 3,E
+ JR NZ,L29F3
+;-------------------------------
+ LD A,(G007_TEMP_BYTE_6)
+ XOR A,E
+ AND %11111011 ; $FB. Bit 2 ignored
+ JR Z,L29E2
+;-------------------------------
+ LD HL,G007_LINE_TYPE
+ LD A,E
+;------------------------------- ; A *= 8
+ RLCA
+ RLCA
+ RLCA
+;-------------------------------
+ AND $03
+ ADD A,L
+ LD L,A
+ LD A,(HL)
+ LD (G007_FLAG_Y),A;
+;-------------------------------
+L29E2:
+ CALL L282C;
+ POP HL
+
+;-------------------------------
+; Bytes from disassembler: 29E6 FD;CB;21;0E LD C,SLA (IY+14)
+
+ RRC (IY+G007_FLAG_Y-RAMBASE) ; makes FD CB 21 0E
+ JR C,L2A12
+;===============================
+ LD A,H ; A = H and L
+ AND A,L
+ JR Z,L2A12
+;-------------------------------
+ INC L
+ LD E,L
+ PUSH HL
+;-------------------------------
+L29F3:
+ LD A,(G007_OUT_OF_RANGE_FLAGS) ; Bit 7 = latest statement
+ BIT 5,E
+ JR NZ,G007_TRIANGLE_PLAIN
+;-------------------------------
+ BIT 6,E
+ JR NZ,G007_TRIANGLE_TEXTURED
+;-------------------------------
+ POP HL
+ BIT 7,A
+ JR NZ,L2A12
+;-------------------------------
+ PUSH HL
+ CALL G007_GET_PIXEL_ADDRESS_AND_MASK
+ AND A,(HL)
+ LD (G007_READ_POINT_BYTE),A ; "Read-point" byte. Non-zero if pixel is set.
+ POP DE
+ LD A,(HL)
+ OR A,D
+ XOR A,E
+ AND A,B
+ XOR A,(HL)
+ LD (HL),A
+;-------------------------------
+L2A12:
+ POP AF
+ LD (G007_TEMP_BYTE_6),A
+ LD HL,G007_PLOT_Y_PREVIOUS_N1+1
+ LD DE,G007_PLOT_Y_PREVIOUS_N2+1
+ LD BC,8
+ BIT 4,A
+ JR Z,L2A34
+;-------------------------------
+ LD A,(G007_OUT_OF_RANGE_FLAGS) ; Plot out of range flags. Bit 7 = latest statement
+ AND $C0 ; only want most recent two bits
+ RLA
+ JR NC,L2A2D
+ SET 6,A ; carry flag into bit 6 of A
+;-------------------------------
+L2A2D:
+ LD (G007_OUT_OF_RANGE_FLAGS),A
+ LD L,$26
+ LD C,4
+;-------------------------------
+L2A34:
+ LDDR ; (DE--)=(HL--); BC-- UNTIL BC IS ZERO
+ RET
+;===============================
+G007_TRIANGLE_PLAIN:
+ LD HL,ALL_BITS_SET
+ JR G007_TRIANGLE_TEXTURED_BY_HL
+;===============================
+G007_TRIANGLE_TEXTURED:
+ LD HL,(G007_TRIANGLE_TEXTURE) ; Bytes defining triangle texture
+;-------------------------------
+G007_TRIANGLE_TEXTURED_BY_HL:
+ EXX
+ AND $E0 ; = 224
+ JP NZ,REPORT_B;
+;-------------------------------
+L2A45:
+ LD HL,G007_OUT_OF_RANGE_FLAGS
+ LD (IY+G007_FLAG_Y-RAMBASE),$55
+ LD B,3
+;-------------------------------
+loop_2A4E:
+ INC HL ; HL+=2
+ INC HL
+ LD E,(HL)
+ INC HL ; HL+=2
+ INC HL
+ LD D,(HL)
+ PUSH DE
+ DJNZ loop_2A4E ; BC--
+;-------------------------------
+ POP BC ; restore register pairs
+ POP DE
+ POP HL
+;-------------------------------
+ OR A,A
+ JR Z,L2A5F
+;-------------------------------
+ LD B,H ; BC=HL
+ LD C,L
+;-------------------------------
+L2A5F:
+ LD A,B
+ CP H
+ JR NC,L2A66
+;-------------------------------
+ PUSH BC
+ EX (SP),HL
+ POP BC
+;-------------------------------
+L2A66:
+ LD A,H
+ CP D
+ JR NC,L2A6B
+;-------------------------------
+ EX DE,HL
+;-------------------------------
+L2A6B:
+ LD A,D
+ EXX
+ AND 7
+ INC A
+ LD B,A
+ LD A,H
+;-------------------------------
+loop_2A72:
+ RLC L ; L *= 2
+;-------------------------------
+ RLCA ; A *= 8
+ RLCA
+ RLCA
+;-------------------------------
+ DJNZ loop_2A72 ; loop while BC-- is not zero
+;-------------------------------
+ LD H,A
+ LD (G007_TEMP_BYTE_7),HL ; Temporary variable for PLOT
+ EXX
+;-------------------------------
+ LD A,H
+ CP B
+ LD A,7
+ JR NC,L2A87
+;-------------------------------
+loop_2A84:
+ PUSH BC
+ EX (SP),HL
+ POP BC
+;-------------------------------
+L2A87:
+ EX DE,HL
+ PUSH AF
+ LD A,C
+ EXX
+ LD H,A
+ LD L,A
+ LD C,A
+ LD (G007_TEMP_BYTE_0),HL ; Temporary variables for PLOT routine.
+ LD B,$FE
+ EXX
+ SUB E
+ EXX
+;-------------------------------
+ JR NC,skip_2A9C
+ LD B,$00
+ NEG
+skip_2A9C:
+;-------------------------------
+ LD D,A
+ EXX
+ LD A,D
+ SUB B
+ EXX
+ LD H,A
+;-------------------------------
+ CP D
+ JR NC,skip_2AA7
+ EX DE,HL
+ INC B
+skip_2AA7:
+;-------------------------------
+ LD L,H
+ INC L
+ LD E,H
+ SRL E
+
+ POP AF
+ RRCA
+ JR NC,L2AB9
+;-------------------------------
+ PUSH HL
+;-------------------------------
+ PUSH DE
+ PUSH BC
+;-------------------------------
+ RRCA
+ EXX
+;-------------------------------
+ JR C,loop_2A84
+ JR L2A87
+;===============================
+L2AB9:
+ EXX
+ LD H,B
+ LD L,1
+;-------------------------------
+loop_2ABD:
+ POP BC
+ POP DE
+;-------------------------------
+ EX (SP),HL
+;-------------------------------
+L2AC0:
+ DEC L
+ JR NZ,L2AD9
+;-------------------------------
+ LD HL,(G007_TEMP_BYTE_0) ; Temporary variables for PLOT routine.
+ LD A,C
+;-------------------------------
+ CP H
+ JR C,skip_2ACB
+ LD H,A
+skip_2ACB:
+;-------------------------------
+ CP L
+ JR NC,skip_2ACF
+ LD L,A
+skip_2ACF:
+;-------------------------------
+ LD (G007_TEMP_BYTE_0),HL ; Temporary variables for PLOT routine.
+ POP HL
+ DEC L
+;-------------------------------
+L2AD4:
+
+ JR Z,loop_2ABD
+
+ PUSH HL
+ JR L2AEE
+;-------------------------------
+L2AD9:
+ LD A,E
+ SUB D
+ JR C,L2AE7
+;-------------------------------
+ LD E,A
+ BIT 0,B
+ JR Z,L2AEE
+;-------------------------------
+ LD A,C
+ ADD A,B
+ LD C,A
+ JR L2AC0
+;-------------------------------
+L2AE7:
+ ADD A,H
+ LD E,A
+ LD A,1
+ OR A,B
+ ADD A,C
+ LD C,A
+;-------------------------------
+L2AEE:
+ LD A,C
+ EXX
+;-------------------------------
+ RRC (IY+G007_FLAG_Y-RAMBASE) ; makes FD CB 21 0E
+
+ JR C,L2AC0 ; if
+;-------------------------------
+ EX (SP),HL
+;-------------------------------
+ PUSH DE
+ PUSH BC
+ PUSH HL
+;-------------------------------
+ LD DE,(G007_TEMP_BYTE_0)
+ LD B,A
+;-------------------------------
+ CP C
+ JR NC,skip_2B04
+ LD B,C
+ LD C,A
+skip_2B04:
+;-------------------------------
+ LD (G007_TEMP_BYTE_0),BC
+ LD A,C
+;-------------------------------
+ CP E
+ INC A
+ JR C,skip_2B0E
+ LD A,E
+skip_2B0E:
+;-------------------------------
+ LD L,A
+ LD A,D
+;-------------------------------
+ CP B
+ JR NC,skip_2B15
+ LD A,B
+ DEC A
+skip_2B15:
+;-------------------------------
+ SUB L
+ INC A
+ PUSH AF
+ CALL L2807
+
+ POP AF
+ LD C,A
+ EX DE,HL
+ LD HL,G007_TEMP_BYTE_8
+ LD A,(HL)
+;-------------------------------
+ RLCA
+ RLCA
+ RLCA
+;-------------------------------
+ LD (HL),A
+ DEC HL
+ RLC (HL)
+ OR A,(HL)
+ LD HL,(G007_TEMP_WORD_2)
+ XOR A,L
+ CPL
+ LD L,A
+ EX DE,HL
+;-------------------------------
+loop_2B31:
+ LD A,E
+ XOR A,(HL)
+ OR A,D
+ AND A,B
+ XOR A,(HL)
+ LD (HL),A
+;-------------------------------
+loop_2B37:
+ DEC C
+ JR NZ,L2B4E
+;-------------------------------
+ POP HL
+ INC H
+ BIT 7,L
+ JR Z,L2AD4
+;------------------------------- ; discard 3 words from stack
+ POP HL
+ POP HL
+ POP HL
+;-------------------------------
+ POP HL
+ LD A,H
+ AND A,L
+ JP Z,L2A12
+;-------------------------------
+ INC L
+ PUSH HL
+ JP L2A45
+;-------------------------------
+L2B4E:
+ RR B
+ JR NC,loop_2B31
+;-------------------------------
+ INC HL
+ LD B,C
+ LD A,C
+ AND $07
+ LD C,A
+;-------------------------------
+ SRL B ; B *= 8
+ SRL B
+ SRL B
+;-------------------------------
+ JR Z,L2B68
+;-------------------------------
+loop_2B60:
+ LD A,E
+ XOR A,(HL)
+ OR A,D
+ XOR A,(HL)
+ LD (HL),A
+ INC HL
+ DJNZ loop_2B60
+;-------------------------------
+L2B68:
+ SCF
+ INC C
+ JR loop_2B37
+;-------------------------------
+L2B6C:
+ LD HL,(G007_FLAG_1)
+ DEC L
+ OR A,L
+ JP NZ,L0809 ; iii) Testing S-POSN: 0808 ENTER-CH LD D,A
+ ; G007 skips that first instruction though.
+;-------------------------------
+
+ DEC H ; if --H,
+ JP NZ,L23B8 ; then jump to modified copy of a ZX81 routine, in RAM.
+;------------------------------- ;
+ LD A,(G007_OUT_OF_RANGE_FLAGS) ; Plot out of range flags. Bit 7 = latest statement
+ RLA
+ RET C
+;-------------------------------
+ NOP
+ NOP
+ LD HL,(G007_PLOT_X_PREVIOUS_N1+1)
+ LD A, (G007_PLOT_X_PREVIOUS_N1)
+ BIT 6,D
+;-------------------------------
+mark_2B87:
+ JR NZ,L2B8E ; 20;05
+
+ LD L,A
+ ADD A,8
+ JR NC,L2B9B
+;-------------------------------
+L2B8E:
+ LD A,H
+;-------------------------------
+ SUB 8
+ JR NC,skip_2B97
+ LD A,(G007_DISPLAY_HEIGHT)
+ DEC A
+skip_2B97:
+;-------------------------------
+ LD (G007_PLOT_Y_PREVIOUS_N1),A;
+ XOR A,A ; A = 0
+;-------------------------------
+L2B9B:
+ LD (G007_PLOT_X_PREVIOUS_N1),A
+ BIT 6,D
+ RET NZ
+;-------------------------------
+ CALL L2EEF
+
+ LD A,L
+;-------------------------------
+ CP $F9
+ JR C,skip_2BAB
+ LD E,2
+skip_2BAB:
+;-------------------------------
+ CPL
+ AND 7
+ INC A
+ LD D,A
+ LD A,H
+ INC A
+ EXX
+
+ LD D,A
+ EXX
+ PUSH DE
+ CALL L2807
+ EXX
+;-------------------------------
+L2BBA:
+ LD A,C
+ XOR A,(HL)
+ EXX
+ EX DE,HL
+LXXX:
+ POP BC
+ PUSH BC
+ LD L,A
+ LD H,$00
+;-------------------------------
+loop_2BC3:
+ ADD HL,HL
+ DJNZ loop_2BC3
+;-------------------------------
+ EX DE,HL
+ LD B,2
+;-------------------------------
+L2BC9:
+ LD A,(G007_RESTART);
+ XOR A,(HL)
+ OR A,(IY+G007_RESTART+1-RAMBASE)
+ AND A,D
+ XOR A,(HL)
+;-------------------------------
+ DEC C
+ JR Z,skip_2BD6
+ LD (HL),A
+skip_2BD6:
+;-------------------------------
+ LD D,E
+ INC HL
+ DJNZ L2BC9
+;-------------------------------
+ LD C,$20
+ ADD HL,BC
+ EXX
+ INC HL
+;-------------------------------
+ DEC D
+ JR Z,skip_2BE4
+;-------------------------------
+ DJNZ L2BBA
+;-------------------------------
+skip_2BE4:
+;-------------------------------
+ POP HL
+ JP L299A
+;===============================
+PRINT_007:
+ LD A,I ; read graphics mode
+ RRCA
+;-------------------------------
+ JR NC,skip_2BF5
+ XOR A,A ; A = 0
+ LD (DF_SZ),A ; SET DF_SZ
+ INC A
+ LD (G007_FLAG_1),A
+skip_2BF5:
+;-------------------------------
+ CALL PRINT ; [PRINT]
+ XOR A,A ; A = 0
+ LD (G007_FLAG_1),A
+ LD (IY+DF_SZ-RAMBASE),2 ; The lines above have no return or jump statements
+; They will fall into copy of the end of the STK_TO_BC routine
+; Perhaps a cunning trick to save two bytes? :-)
+;===============================
+;===============================
+;===============================
+
+ org ROM_PATCH_0C00
+;
+; 256-byte block patched in to ZX81 BASIC at 0C00 hex
+; This cleverly alters the language syntax,
+; adding parameters and/or pointing to new routines.
+;
+ LD C,A ; from the end of the STK_TO_BC routine
+ RET
+;===============================
+; THE 'STK_TO_A' SUBROUTINE (duplicated for the paged ROM)
+
+; This subroutine 'loads' the A register with the floating point number held at the top of the calculator stack. The number must be in the range 00-FF.
+;-------------------------------
+STK_TO_A:
+
+#if NOT_G007
+; CALL 15CD,FP_TO_A ; This is what the disassembly book says
+#else
+ CALL L0CA0 ; new in G007
+#endif
+ JP C,REPORT_B
+;-------------------------------
+ LD C,$01
+ RET Z
+ LD C,$FF
+ RET
+;===============================
+
+; THE 'SCROLL' COMMAND ROUTINE (duplicated for the paged ROM)
+
+; The first part of the routine sets the correct values of DF_CC and S_POSN to allow for the next printing to occur at the start of the bottom line + 1.
+
+; Next the end address of the first line in the display file is identified and the whole of the display file moved to overwrite this line.
+;-------------------------------
+
+SCROLL:
+mark_0C0E:
+ LD B,(IY+DF_SZ-RAMBASE) ; ??? Disassembly book says LD B,(DF_SZ)
+ LD C,CHARS_HORIZONTAL + 1 ;change here, $21 originally
+ CALL LOC_ADDR
+ CALL ONE_SPACE
+ LD A,(HL)
+ LD (DE),A
+
+ INC (IY+S_POSN_hi-RAMBASE) ;
+
+ LD HL,(D_FILE);
+ INC HL
+ LD D,H
+ LD E,L
+ CPIR
+ JP RECLAIM_1
+;===============================
+;
+; THE SYNTAX TABLES
+;
+; i) The offset table
+;
+; There is an offset value for each of the BASIC commands and by
+; adding this offset to the value of the address where it is found,
+; the correct address for the command in the parameter table is
+; obtained.
+
+; 2C29: 8B 8D 2D 7F 81 49 75
+
+mark_0C29:
+offset_t:
+
+; expression address byte offset expected
+ defb P_LPRINT-$ ; 0CB4 $8B
+ defb P_LLIST-$ ; 0CB1 ; $8D ;
+ defb P_STOP-$ ; 0C58 ; $2D ;
+ defb P_SLOW-$ ; 0CAB ; $7F ;
+ defb P_FAST-$ ; 0CAE ; $81 ;
+ defb P_NEW-$ ; 0C77 ; $49 ;
+ defb P_SCROLL_007-$ ; 0CA4 ; $75 ;
+ ; 2C30: 5F 40 42 2B 17 1F 37 52
+ defb P_CONT-$ ; 0CBF ; $5F ;
+ defb P_DIM-$ ; 0C71 ; $40 ;
+ defb P_REM-$ ; 0C74 ; $42 ;
+ defb P_FOR-$ ; 0C5E ; $2B ;
+ defb P_GOTO-$ ; 0C4B ; $17 ;
+ defb P_GOSUB-$ ; 0C54 ; $1F ;
+ defb P_INPUT-$ ; 0C6D ; $37 ;
+ defb P_LOAD-$ ; 0C89 ; $52 ;
+ ; 2C38: 45 0F 6D 2B 44 2D 5A 3B
+ defb P_LIST-$ ; 0C7D ; $45 ;
+ defb P_LET-$ ; 0C48 ; $0F ;
+ defb P_PAUSE-$ ; 0CA7 ; $6D ;
+ defb P_NEXT-$ ; 0C66 ; $2B ;
+ defb P_POKE-$ ; 0C80 ; $44 ;
+ defb P_PRINT-$ ; 0C6A ; $2D ; Same as normal ZX81
+ defb P_PLOT_007-$ ; 0C98 ; $5A ;
+ defb P_RUN-$ ; 0C7A ; $3B ;
+ ; 2C40: 4C 45 0D 52 54 4D 15 6A
+ defb P_SAVE-$ ; 0C8C ; $4C ;
+ defb P_RAND-$ ; 0C86 ; $45 ;
+ defb P_IF-$ ; 0C4F ; $0D ;
+ defb P_CLS-$ ; 0C95 ; $52 ;
+ defb P_UNPLOT_007-$ ; 0C98 ; $54 ; This byte is 5A, an offset to 0C9E, in normal ZX81
+ ; NB same address as PLOT
+ defb P_CLEAR-$ ; 0C92 ; $4D ;
+ defb P_RETURN-$ ; 0C5B ; $15 ;
+ defb P_COPY-$ ; 0CB1 ; $6A ;
+;
+; ii) The parameter table.
+;
+; For each of the BASIC commands there are between 3 and 8
+; entries in the parameter table. The command classes for each of
+; the commands are given, together with the required separators and
+; these are followed by the address of the appropriate routine.
+
+
+ ; 2C48: 01 14 02
+mark_0C48:
+P_LET:
+ defb _CLASS_01 ; A variable is required.
+ defb ZX_EQU ; Separator: '='
+ defb _CLASS_02 ; An expression, numeric or string,
+ ; must follow.
+
+; 244B: 06 00 81 0E 06
+
+P_GOTO:
+mark_0C4B:
+ defb _CLASS_06 ; A numeric expression must follow.
+ defb _CLASS_00 ; No further operands.
+ defw GOTO
+
+
+P_IF:
+mark_0C4F:
+ defb _CLASS_06 ; A numeric expression must follow.
+mark_0C50 ; 2C50: DE 05 AB 0D
+ defb ZX_THEN ; Separator: 'THEN'
+ defb _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+ defw IF
+
+
+P_GOSUB: ; mark_0C54:
+ defb _CLASS_06 ; A numeric expression must follow.
+ defb _CLASS_00 ; No further operands.
+ defw GOSUB ; 0EB5
+
+ ; 2C58: 00 DC 0C
+
+P_STOP: ; mark_0C58:
+ ; 2C54: 06 00 B5 0E
+ defb _CLASS_00 ; No further operands.
+ defw STOP
+
+ ; 2c5B: 00 D8 0E
+
+P_RETURN
+ defb _CLASS_00 ; No further operands.
+ defw RETURN
+
+
+ ; 2c5e: 04 14
+
+
+P_FOR:
+#if 0
+mark_0C5E:
+#else
+#endif
+ defb _CLASS_04 ; A single character variable must
+ ; follow.
+ defb ZX_EQU ; Separator: '='
+ defb _CLASS_06 ; A numeric expression must follow.
+ defb ZX_TO ; Separator: 'TO'
+ defb _CLASS_06 ; A numeric expression must follow.
+ defb _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+ defw FOR
+
+ ; 0C66: 04 00 2E 0E
+
+P_NEXT: ; at $0C66:
+
+ defb _CLASS_04 ; A single character variable must follow.
+ defb _CLASS_00 ; No further operands.
+ defw NEXT
+
+
+; 2C6A: 05 E8 2B
+
+P_PRINT:
+
+mark_0C6A:
+
+
+
+ defb _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+#if NOT_G007
+ defw PRINT ; This is the original routine
+#else
+ defw PRINT_007 ; 2BE8 This is the new routine!
+#endif
+
+; ; 2C6D: 01 00 E9 0E
+
+
+mark_0C6D:
+
+
+P_INPUT:
+ defb _CLASS_01 ; A variable is required.
+ defb _CLASS_00 ; No further operands.
+ defw INPUT
+
+P_DIM:
+mark_0C71:
+ defb _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+#if NOT_G007
+ defw DIM ; 1409 Original ZX81 replaced by
+#else
+ defw DIM_007 ; 2EA7 new routine
+#endif
+;
+; ; 2c74: 05 6A 0D
+;
+mark_0C74:
+P_REM:
+
+ defb _CLASS_05 ; Variable syntax checked entirely by routine.
+ defw REM
+
+mark_0C77:
+P_NEW:
+ defb _CLASS_00 ; No further operands.
+ defw NEW
+
+P_RUN:
+mark_0C7A:
+
+P_RUN:
+ defb _CLASS_03 ; A numeric expression may follow
+ ; else default to zero.
+ defw RUN
+
+P_LIST:
+#if 0
+mark_0C7D:
+#else
+#endif
+ defb _CLASS_03 ; A numeric expression may follow
+ ; else default to zero.
+ defw LIST
+
+P_POKE: ; mark_0C80:
+ defb _CLASS_06 ; A numeric expression must follow.
+ defb ZX_COMMA ; Separator: ','
+ defb _CLASS_06 ; A numeric expression must follow.
+ defb _CLASS_00 ; No further operands.
+ defw POKE
+
+P_RAND: ; mark_0C86:
+ defb _CLASS_03 ; A numeric expression may follow
+ ; else default to zero.
+ defw RAND
+
+P_LOAD: ; mark_0C89:
+ defb _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+ defw LOAD
+
+P_SAVE: ; mark_0C8C:
+ defb _CLASS_05 ; Variable syntax checked entirely
+ ; by routine.
+#if NOT_G007
+ defw SAVE ; 02F6 original
+#else
+ defw SAVE_007 ; 2F4D new!
+#endif
+;
+P_CONT:
+#if 0
+#else
+#endif
+mark_0C8F:
+ defb _CLASS_00 ; No further operands.
+ defw CONT ; 0E7C
+;
+P_CLEAR: ; mark_0C92:
+ defb _CLASS_00
+#if NOT_G007
+ defw CLEAR ; 149A original
+#else
+ defw CLEAR_007 ; 0EB2 new. this points outside the G007 ROM
+#endif
+
+
+P_CLS: ; mark_0C95:
+#if NOT_G007
+ defb _CLASS_00 ; No further operands.
+;; defw CLS ; original
+#else
+ defb _CLASS_03 ; A numeric expression may follow
+ ; else default to zero.
+ defw G007_CLS_N ; 2E4E new!
+#endif
+;
+;
+;
+mark_0C98:
+
+#if NOT_G007
+ ; originally the ZX81 does this:
+P_PLOT: ; original: plot X,Y
+ defb _CLASS_06 ; A numeric expression must follow. X
+ defb ZX_COMMA ; Separator: ','
+ defb _CLASS_06 ; A numeric expression must follow. Y
+ defb _CLASS_00 ; No further operands.
+ defw PLOT_UNPLOT ; 0BAF
+
+P_UNPLOT: ; original: plot X,Y
+ defb _CLASS_06 ; A numeric expression must follow. X
+ defb ZX_COMMA ; Separator: ','
+ defb _CLASS_06 ; A numeric expression must follow. Y
+ defb _CLASS_00 ; No further operands.
+ defw PLOT_UNPLOT ; 0BAF
+
+ ; These are identical, so they could overlap
+#else
+ ; The G007 saves bytes by having these
+ ; identical parameter table entries overlapping:
+ ; 0C98 / 2C98: 06 1A 06 1A 06 00 26 29
+P_PLOT_007:
+P_UNPLOT_007:
+ ; new: plot N,X,Y
+ defb _CLASS_06 ; A numeric expression must follow. N
+ defb ZX_COMMA ; Separator: ','
+ defb _CLASS_06 ; A numeric expression must follow. X
+ defb ZX_COMMA ; Separator: ','
+L0C9C:
+ defb _CLASS_06 ; A numeric expression must follow. Y
+ defb _CLASS_00 ; No further operands.
+ defw G007_PLOT_UNPLOT_N_X_Y ; 2926 new!
+ ;
+ ; by saving those bytes, can put a tiny routine here:
+L0CA0:
+ LD HL,(L0EA8) ; Inside the 'FIND_INT.' subroutine
+ JP (HL)
+#endif
+;
+; Now back to the table!
+;
+P_SCROLL_007
+mark_0CA4:
+ defb _CLASS_00
+ defw SCROLL ; 0C0E
+
+
+
+P_PAUSE:
+ defb _CLASS_06
+ defb _CLASS_00
+#if NOT_G007
+mark_0CA9:
+; 2CA9: 0F 32
+ defw PAUSE ; 0F32 original
+#else
+mark_0CA9:
+; 2CA9: AE 2E
+; 0CA7
+ defw PAUSE_007 ; 2EAE new!
+#endif
+;
+; 2CAB: 03 B2 2E
+; 0CAB
+
+
+
+P_SLOW:
+mark_0CAB:
+#if NOT_G007
+ defb _CLASS_00 ; No further operands.
+ defw SLOW ; 2B 0F SLOW,0F2B original
+#else
+ defb _CLASS_03 ; new! Extra parameter sets graphic mode
+ defw SLOW_007 ; 2EB2 new!
+#endif
+
+
+P_FAST:
+mark_0CAE:
+#if NOT_G007
+ defb _CLASS_00 ; No further operands.
+ defw FAST ; 23 0F FAST,0F23 original
+#else
+ defb _CLASS_03 ; new! Extra parameter sets graphic mode
+ defw FAST_007 ; 2EB6 new!
+#endif
+
+
+
+
+
+
+
+
+;
+; 2CB1: 03 53 2F
+;
+; 0CB1
+
+P_COPY:
+#if NOT_G007
+ defb _CLASS_00 ; original
+ defw COPY ; 0869 original
+#else
+ defb _CLASS_03 ; new! Extra parameter sets graphic mode
+;;; defw COPY_007 ; 2EB6 new but wrong ???!
+ defw L2F53 ; what the disassembler said
+#endif
+
+mark_0CB4:
+
+
+P_LPRINT:
+
+ defb _CLASS_05
+ defw LPRINT ; 0ACB
+;
+; ; 2CB7: 03 2C 07
+; 0CB7
+P_LLIST:
+ defb _CLASS_03
+ defw LLIST ; 072C
+;
+;
+; the rest of this page is just a copy of the usual ZX81 code
+
+LINE_SCAN:
+L0CBA:
+; 2CBA: FD 36 01 01 CD 73
+; 2CC0: 0A CD 95 0A 21 00 40 36
+; 2CC8: FF 21 2D 40 CB 6E 28 0E
+; 2CD0: FE E3 7E C2 6F 0D CD A6
+; 2CD8: 0D C8 CF 0C CF 08 DF 06
+; 2CE0: 00 FE 76 C8 4F E7 79 D6
+; 2CE8: E1 38 3B 4F 21 29 0C 09
+; 2CF0: 4E 09 18 03 2A 30 40 7E
+; 2CF8: 23 22 30 40 01 F4 0C C5
+;
+; which is described as follows in the ZX81 disassembly book:
+;
+; THE 'LINE SCANNING' ROUTINE
+;
+; The BASIC interpreter scans each line for BASIC commands and as each one is found
+; the appropriate command routine is followed.
+; The different parts of the routine are:
+;-------------------------------
+; i) The LINE_SCAN entry point leads to the line number being checked for validity.
+
+ LD (IY+FLAGS-RAMBASE),$01 ; FLAGS = 1
+ CALL E_LINE_NO ;
+;-------------------------------
+; ii) The LINE_RUN entry point is used when replying to an INPUT prompt
+; and this fact has be identified.
+;-------------------------------
+LINE_RUN
+#if NOT_G007
+ CALL SET_MEM ; at $14BC
+#else
+ CALL L0A95 ; JP 14BC,SET_MEM then return
+ ; why it does this I do not know - KH
+#endif
+ LD HL,ERR_NR
+ LD (HL),$FF
+ LD HL,FLAGX
+ BIT 5,(HL)
+ JR Z,LINE_NULL
+;-------------------------------
+; iii) The INPUT reply is tested to see if STOP was entered.
+
+ CP $E3
+ LD A,(HL)
+ JP NZ,INPUT_RE
+ CALL SYNTAX_Z
+ RET Z
+
+; iv) If appropriate, report D is given.
+
+ RST ERROR_1
+ defb $0C
+;-------------------------------
+ ; THE 'STOP' COMMAND ROUTINE
+ ; The only action is to give report 9.
+;-------------------------------
+STOP
+ RST ERROR_1
+ defb 8
+;-------------------------------
+ ; v) A return is made if the line is 'null'.
+;-------------------------------
+LINE_NULL:
+
+mark_0CDE:
+
+; old software from disassembly book:
+
+ RST GET_CHAR
+ LD B,0
+ CP ZX_NEWLINE
+ RET Z
+
+ ; vi) The first character is tested so as to check that it is a command.
+
+ LD C,A
+ RST NEXT_CH
+ LD A,C
+ SUB $E1
+#if NOT_G007
+ JR C,REPORT_C ; $0D9A as per the book
+#else
+ JR C,REPORT_C_007 ; $0D26 in G007 systems
+#endif
+;-------------------------------
+ ; vii) The offset for the command is found from the offset table.
+
+ LD C,A
+ LD HL,offset_t ; $0C29
+ ADD HL,BC
+ LD C,(HL)
+ ADD HL,BC
+ JR GET_PARAM
+
+ ; viii) The parameters are fetched in turn by a loc that returns to 0CF4.
+ ; The separators are identitied by the test against +0B.
+;-------------------------------
+mark_0CF4:
+
+SCAN_LOOP:
+ LD HL,(T_ADDR)
+GET_PARAM:
+ LD A,(HL)
+ INC HL
+ LD (T_ADDR),HL
+ LD BC,SCAN_LOOP
+ PUSH BC
+
+;
+; there is more to this routine but the patch ends here
+;
+; end of patch
+;-------------------------------
+ org $2D00
+
+
+; bits shifting right within a byte:
+;
+ defb %10000000 ; $80
+ defb %01000000 ; $40
+ defb %00100000 ; $20
+ defb %00010000 ; $10
+ defb %00001000 ; $08
+ defb %00000100 ; $04
+ defb %00000010 ; $02
+ defb %00000001 ; $01
+;-------------------------------
+L2D08:
+
+SLOW_FAST_007: ; at $2D08
+
+ CALL L2BF7 ; ??? not a valid opcode address?
+ JP SLOW_FAST ; old routine
+;-------------------------------
+L2D0E:
+ LD (MARGIN),A ;
+ EX DE,HL
+ LD HL,10
+ ADD HL,SP
+ LD A,(HL)
+ INC A
+ AND $F0
+ SUB $D0
+ LD C,A
+ INC HL
+ LD A,(HL)
+ SUB 4
+ OR A,C
+ LD C,A
+ LD A,(CDFLAG) ;
+ RLCA
+ SBC A,A
+ AND A,C
+ JR NZ,L2D3B
+;-------------------------------
+ LD HL,(VARS) ;
+ LD BC,-(CHARS_HORIZONTAL+1) ; $FFDF
+ ADD HL,BC
+ SET 7,H
+ LD (G007_DISPLAY_ADDRESS_LO_RES_LAST_LINE),HL
+ LD A,1
+ JR L2D49
+;-------------------------------
+L2D3B:
+ LD HL,(D_FILE) ; GET D_FILE
+ LD BC,(G007_DISPLAY_OFFSET_FROM_DFILE_LESS_9)
+ ADD HL,BC
+ SET 7,H
+ LD (G007_DISPLAY_ADDRESS_LESS_9),HL
+ XOR A,A ; A = 0
+;-------------------------------
+L2D49:
+ LD (G007_FLAG_3),A
+ DEC HL
+ LD A,(HL)
+ EX DE,HL
+ RET
+;-------------------------------
+ LD A,(G007_FLAG_3)
+ DEC A
+ JP NZ,L2D73 ; [11635]
+;-------------------------------
+ LD A,G007_INT_REG_VALUE_FOR_LO_RES_GRAPHICS
+ LD I,A ; Interrupt register = 0x1E sets low res mode
+ ADC HL,HL
+ LD HL,(G007_DISPLAY_ADDRESS_LO_RES_LAST_LINE)
+
+ LD BC,$0108
+ LD A,$FE
+ CALL DISPLAY_5;
+ LD A,G007_INT_REG_VALUE_FOR_HI_RES_GRAPHICS
+ LD I,A ; Interrupt register = 0x1F sets high res mode
+ LD A,(MARGIN) ; GET MARGIN
+ SUB 8
+ JR L2D77
+;-------------------------------
+L2D73:
+ DEC HL
+ LD A,(MARGIN) ; GET MARGIN
+;-------------------------------
+L2D77:
+ LD C,A
+ POP IX
+;-------------------------------
+ BIT 7,(IY+CDFLAG-RAMBASE) ; makes FD CB 3B 7E
+ JP NZ,L029D ; []*BIOS ROM*
+;-------------------------------
+
+; This jumps into the middle of the DISPLAY_3, where it meets this code:
+;029D 79 LD A,C
+;029E ED;44 NEG
+;02A0 3C INC A
+;02A1 08 EX AF,AF'
+;02A2 D3;FE OUT (IO_PORT_KEYBOARD_RD),A ; ZX81 NMI GENERATOR on, for SLOW mode
+;02A4 E1 POP HL ; restore registers
+;02A5 D1 POP DE
+;02A6 C1 POP BC
+;02A7 F1 POP AF
+;02A8 C9 RET
+;-------------------------------
+ LD A,$FE
+ LD B,$01
+ LD HL,HALT_AT_2D9A
+ CALL LOAD_R_AND_WAIT_FOR_INT
+ ADD HL,HL ; double HL
+ NOP
+ LD E,A
+ LD HL,(G007_DISPLAY_ADDRESS_LESS_9)
+ SET 7,H
+ JP (IX)
+;===============================
+LOAD_R_AND_WAIT_FOR_INT ; mark_2D95
+ ; Sets up the refresh register and waits for an interrupt:
+ LD R,A ; Refresh row counter := accumulator
+ LD A,221 ; 221 = $DD
+ EI ; Enable interrupts, then drop into HALT
+;-------------------------------
+HALT_AT_2D9A:
+
+ HALT
+;===============================
+; Copy two pages of ZX81 BASIC ROM to RAM patch areas,
+; then modify bytes as controlled by a table of offsets and values
+; This uses less memory than two whole pages of ROM
+; If the RAM patches are not changed thereafter,
+; one might be able to use a 16K ROM to hold two different versions of the ZX81 BASIC space,
+; one with the 'RAM' patch and one without.
+; The RAM testing would have to be disabled, because the ROM would cause it to fail.
+;-------------------------------
+#if NOT_G007
+ZX81_COPY:
+#else
+G007_COPY:
+#endif
+;-------------------------------
+; First check RAM by loading 512 bytes RAM from $2200 to $23FF with value 1,
+; and decrement them to zero to test they are working RAM
+;
+ LD HL,RAM_PATCH_2200 ; destination RAM patch 2
+ LD A,$24
+;-------------------------------
+mark_2DA0:
+G007_COPY_LOOP:
+ LD (HL),1 ; try writing the value 1 to a byte in RAM patch 2
+ DEC (HL) ; try decrementing it to zero
+ JR Z,G007_COPY_SKIP ; if result is zero, skip error code report
+;-------------------------------
+ RST $08
+ defb $1A ; RST8 Arg ; Error Code:'R' (ZX81 on-board 1K/2K RAM not found)
+;-------------------------------
+G007_COPY_SKIP
+mark_2DA7:
+ INC HL ; next address
+ CP H ; has HL reached $2400 (yet?
+ JR NZ,G007_COPY_LOOP ; no, repeat.
+;-------------------------------
+ ; HL is now $2400
+ ; Copy 256 bytes from BASIC ROM to RAM patch 1:
+ LD H,L ; HL is now $0000 (data source is start of ZX81 BASIC ROM)
+ LD DE,RAM_PATCH_2000 ; data destination
+ LD BC,$0100 ; 256 bytes
+ LDIR ; (HL) -> (DE) 256 times
+;-------------------------------
+ ; HL is now $0100
+ ; DE is now $2100
+ ; BC is now $0000
+;-------------------------------
+ INC H ; HL is now $0200
+ INC D ; DE is now $2200
+ INC B ; BC is now $0100
+ LDIR ; copy another 256 bytes to RAM patch 2
+;-------------------------------
+ LD HL,PRINT_CH ; src = the original ZX81 print character routine
+ LD DE,G007_V23A0 ; dst =
+ LD BC,$0060 ; 60hex = 96 bytes, so stops just before 0851 (the 'LPRINT_CH routine)
+ LDIR ; move
+ ; BC is now $0000
+ LD D,$20 ; DE is now $20??
+ LD HL,TABLE_ONE ; copy data from this table:
+LOOP_2DC9:
+ LD B,(HL) ; BC is now $0A00 (seems way too many bytes)
+ JR G007_TABLE_END_TEST ; branch to end-of-table test
+;-------------------------------
+G007_TABLE_ONE_LOOP:
+ LD E,(HL) ; Get the offset
+ INC HL ; next byte is data
+ LD A,(HL) ; Get the data byte
+ LD (DE),A ; ($2000+offset) = data byte
+;-------------------------------
+G007_TABLE_END_TEST:
+mark_2DD0:
+ INC HL ; next offset
+ DJNZ G007_TABLE_ONE_LOOP ; repeat until BC is zero
+;-------------------------------
+ INC D ; D becomes $21
+ BIT 2,D ; test bit 2 (has D incremented to $23 ?)
+ JR Z,LOOP_2DC9
+
+ RET
+;===============================
+; Delete Display File:
+;
+G007_DELETE_DISPLAY_FILE:
+ CALL SET_FAST;
+ LD HL,$3E87
+ CALL LINE_ADDR;
+ RET NZ
+;-------------------------------
+ EX DE,HL
+ LD HL,(NXT_LINE) ;
+ BIT 6,(HL)
+ JR Z,L2DEF
+;-------------------------------
+ LD (NXT_LINE),DE ;
+;-------------------------------
+L2DEF:
+ LD HL,(D_FILE) ;
+ JP RECLAIM_1 ; exit
+;-------------------------------
+L2DF5:
+ CALL G007_DELETE_DISPLAY_FILE
+ LD BC,$1992 ; 6546 decimal =
+ LD HL,(D_FILE) ;
+ DEC HL
+ CALL MAKE_ROOM
+
+ LD A,ZX_NEWLINE
+ LD (DE),A ; to DE
+ INC DE
+ LD (DE),A ; and DE+1
+
+ INC HL ; HL += 2
+ INC HL
+
+ LD (HL),$3E ; (HL++) = $3E 'Y'
+ INC HL
+ LD (HL),$87 ; (HL++) = $87
+ INC HL
+ LD (HL),$8D ; (HL++) = $8D
+ INC HL
+ LD (HL),$19 ; (HL++) = $19 ';'
+ INC HL
+ LD (HL),A ; (HL++) = ZX_NEWLINE
+ INC HL
+ LD (HL),A ; (HL++) = ZX_NEWLINE
+;-------------------------------
+L2E18:
+ CALL SLOW_FAST ;
+ LD A,1
+ JR G007_CLS_HI_RES
+;-------------------------------
+G007_CHECK_AND_SET_UP_DISPLAY_FILE:
+ ;
+ LD HL,(V2265) ; in the RAM page 2 area ! Usually $4027
+ LD DE,$BFD9 ; 3FD9 + 32K, or -16423 = 16K - 39 bytes
+ ADD HL,DE
+
+ LD A,(V2264)
+ SUB CHARS_HORIZONTAL+1 ; bytes per screen line
+
+ OR A,H
+ OR A,L
+
+ CALL NZ,G007_COPY
+ LD HL,(D_FILE) ; GET D_FILE
+ LD A,ZX_NEWLINE
+
+ DEC HL
+ DEC HL
+ CP (HL) ; pointing to a HALT?
+
+ CALL NZ,L2DF5 ; no,
+ ; else yes
+ LD HL,(D_FILE) ; GET D_FILE
+ LD DE,(G007_DISPLAY_OFFSET_FROM_DFILE_LESS_9)
+ ADD HL,DE
+ LD (G007_DISPLAY_ADDRESS_LESS_9),HL
+
+ LD DE,9 ; HL += 9
+ ADD HL,DE
+
+ LD (G007_DISPLAY_ADDRESS),HL
+ RET
+;-------------------------------
+G007_CLS_N:
+;
+ CALL STK_TO_A
+ RET NZ ; drop through if zero flag set
+;-------------------------------
+; Clear The Screen:
+;
+G007_CLS_A:
+ DEC A
+ JP M,CLS ; if A was zero
+;-------------------------------
+G007_CLS_HI_RES:
+ PUSH AF
+ CALL G007_CHECK_AND_SET_UP_DISPLAY_FILE
+ POP AF
+;-------------------------------
+ CP 2
+ LD BC,(G007_DISPLAY_HEIGHT)
+ LD HL,(D_FILE)
+ JR NC,L2E96
+;-------------------------------
+ DEC A
+
+ INC HL
+ LD (DF_CC),HL ; Addr. for PRINT AT position
+ DEC HL
+
+ DEC HL
+ DEC HL
+
+ LD E,0 ; E = 0 is byte to fill screen
+;-------------------------------
+loop_2E70:
+ LD B,16 ; 16
+ DEC HL
+ LD (HL),E ; but writes 2 bytes for each loop
+ DEC HL
+ LD (HL),E ; perhaps to reduce loop overhead?
+;-------------------------------
+loop_2E76:
+ DEC HL
+ LD (HL),A ; writes A twice over
+ DEC HL
+ LD (HL),A
+ DJNZ loop_2E76
+;-------------------------------
+ DEC C
+ JR NZ,loop_2E70
+;------------------------------- ; C is now zero
+ LD B,9 ; BC is now $0900
+ LD A,1
+;-------------------------------
+loop_2E83:
+ DEC HL
+ LD (HL),E ; (--HL) = E while --BC
+ DJNZ loop_2E83
+;------------------------------- ; BC is now zero
+ LD HL,G007_LINE_TYPE
+ LD B,20 ; decimal 20
+ DEC A
+ JR Z,loop_2E83
+;-------------------------------
+ LD HL,256*CHARS_VERTICAL + CHARS_HORIZONTAL + 1
+ LD (S_POSN),HL ; SET S_POSN
+ RET
+;===============================
+L2E96:
+ RET NZ
+
+ DEC HL ; HL -= 2
+ DEC HL
+;------------------------------- outer loop
+loop_2E99:
+ LD B,32 ; 32 bytes to invert
+ DEC HL ; HL -= 2
+ DEC HL ; skips past 2 HALT characters
+
+;------------------------------- inner loop
+loop_2E9D:
+ DEC HL
+
+ LD A,(HL) ; read
+ CPL ; invert (one's complement)
+ LD (HL),A ; write
+
+ DJNZ loop_2E9D
+;-------------------------------
+ DEC C ; C is obviously the number of horizontal lines to invert
+ JR NZ,loop_2E99
+;-------------------------------
+ RET
+;-------------------------------
+mark_2EA7:
+DIM_007: ; 2EA7
+ LD HL,($0A96)
+ LD A,$4D
+ JR L2EE3
+;-------------------------------
+PAUSE_007:
+ LD A,$DD
+ JR skip_2EE0
+;-------------------------------
+SLOW_007: ; 2EB2
+ LD A,$D6
+ JR skip_2EB8
+;-------------------------------
+FAST_007: ; 2EB6
+ LD A,$CE
+;-------------------------------
+skip_2EB8:
+ PUSH AF
+
+ CALL STK_TO_A
+ LD B,$1E
+ DEC A
+ CP 6
+ JR NC,skip_2EDC
+;-------------------------------
+ SRL A
+ LD H,A
+;-------------------------------
+ JR Z,skip_2ECA
+ LD A,1
+skip_2ECA:
+;-------------------------------
+ PUSH AF
+ SBC A,A
+ LD L,A
+ RES 1,H
+ DEC H
+ LD (G007_RESTART),HL
+ CALL G007_CHECK_AND_SET_UP_DISPLAY_FILE
+ LD B,G007_INT_REG_VALUE_FOR_HI_RES_GRAPHICS
+ POP AF
+
+ LD (G007_FLAG_2),A
+;-------------------------------
+skip_2EDC:
+ LD A,B ;
+ LD I,A ; I = B = G007_INT_REG_VALUE_FOR_HI_RES_GRAPHICS = set video mode
+ POP AF
+;-------------------------------
+skip_2EE0:
+ LD HL,($0D71) ; inside the 'COMMAND CLASS 2' routine of the ZX BASIC ROM
+;-------------------------------
+L2EE3:
+ ADD A,L
+ LD L,A
+ JP (HL)
+
+ LD D,A
+ LD A,(S_POSN) ;
+ AND $80
+ JP L2B6C
+;===============================
+L2EEF: ; print a character on high-res screen perhaps?
+ LD A,D
+ POP DE
+
+ EXX
+;-------------------------------
+ PUSH HL
+ PUSH DE
+ PUSH BC
+;-------------------------------
+ LD HL,(G007_CHAR_TABLE_ADDR_0_63)
+ ADD A,A ; if (A < 128) goto
+ JR NC,skip_2F06
+;------------------------------- ;
+ LD HL,(G007_CHAR_TABLE_ADDR_128_159)
+ BIT 6,A
+ JR Z,skip_2F06
+;-------------------------------
+ LD HL,(G007_USR_DEF_CHR_TAB_LESS_256)
+ CCF
+;-------------------------------
+skip_2F06:
+ EX DE,HL ; DE now points to the selected charater table
+
+ LD L,A ; HL = A
+ LD H,0
+
+ SBC A,A ; A = carry
+ LD C,A ;
+;-------------------------------
+ LD A,(G007_RESTART) ; invert this variable
+ CPL
+ AND A,(IY+G007_RESTART+1-RAMBASE)
+;-------------------------------
+ XOR A,C
+ LD C,A
+
+ ADD HL,HL ; HL *= 4
+ ADD HL,HL
+ ADD HL,DE ; HD += DE
+
+ LD B,8
+
+ EXX
+ PUSH DE
+ RET
+;===============================
+L2F1D: ; The copied and modified PRINT_CH / WRITE_CH jumps here from $23FF
+ DEC (IY+S_POSN-RAMBASE) ; Line and Column for PRINT AT
+ LD A,24 ; 24 character rows per screen
+ SUB B
+ LD B,A
+;
+ ADD A,A
+ ADD A,A
+ ADD A,A
+ LD L,A ; L = A * 8
+;
+ LD A,(G007_DISPLAY_HEIGHT)
+ SUB L ; A = G007_DISPLAY_HEIGHT - something
+ RET C ; return if beyond limit
+;-------------------------------
+ LD A,CHARS_HORIZONTAL+1 ; 32 video bytes plus HALT ?
+ SUB C
+ LD C,A
+;-------------------------------
+ LD H,0
+ ADD HL,HL
+ ADD HL,BC
+ LD BC,(G007_DISPLAY_ADDRESS)
+ ADD HL,BC ; HL = L*2 + BC + G007_DISPLAY_ADDRESS:
+;-------------------------------
+ CALL L2EEF
+ LD BC,$0022 ; B = 0, C = 34
+ EXX
+;-------------------------------
+COPY_007:
+loop_2F41: ;
+ LD A,C
+ XOR A,(HL)
+ EXX
+ LD (HL),A
+ ADD HL,BC
+ EXX
+ INC HL
+ DJNZ loop_2F41
+;-------------------------------
+ JP L299A
+;-------------------------------
+SAVE_007: ; 2F4D
+ CALL G007_DELETE_DISPLAY_FILE
+ JP SAVE
+;-------------------------------
+L2F53:
+ CALL STK_TO_A
+ RET NZ
+
+ DEC A
+ JP M,COPY ; A was zero, jump to low-res copy-to-printer
+;-------------------------------
+ CALL G007_CHECK_AND_SET_UP_DISPLAY_FILE ; check we have a display
+ CALL SET_FAST ; print in FAST mode!
+ LD A,(G007_DISPLAY_HEIGHT)
+ LD B,A ; B = (G007_DISPLAY_HEIGHT)
+ LD HL,(G007_DISPLAY_ADDRESS)
+ XOR A,A ; A = 0
+ LD E,A ; E = 0
+ OUT (ZX_PRINTER_PORT),A
+;-------------------------------
+loop_2F6C:
+ LD A,$7F ; looks pointless
+ IN A,(IO_PORT_KEYBOARD_RD)
+ RRCA
+ JP NC,$0886 ; []*BIOS ROM* between 0880 COPY-BRK and 0888 REPORT-D2
+ IN A,(ZX_PRINTER_PORT)
+;-------------------------------
+loop_2F76:
+ ADD A,A
+ JP M,L2FAD
+;-------------------------------
+ JR NC,loop_2F6C
+;-------------------------------
+ LD C,$20 ; 32
+;-------------------------------
+loop_2F7E:
+ PUSH BC
+ LD C,(HL)
+ LD B,8
+;------------------------------- ; outer loop
+loop_2F82:
+ RLC C
+ RRA
+ OR A,E
+ LD D,A
+;------------------------------- ; inner loop
+loop_2F87:
+ IN A,(ZX_PRINTER_PORT) ; read printer port bit 0 into carry flag
+ RRA
+ JR NC,loop_2F87 ; repeat while bit is zero
+;-------------------------------
+ LD A,D
+ OUT (ZX_PRINTER_PORT),A ; D register to printer
+ DJNZ loop_2F82
+;-------------------------------
+ INC HL
+ POP BC
+ DEC C
+ JR NZ,loop_2F7E
+;-------------------------------
+ INC HL
+ INC HL
+ LD A,3
+;-------------------------------
+ CP B
+ JR C,skip_2F9F
+;-------------------------------
+ LD E,A
+ DEC E
+skip_2F9F:
+;-------------------------------
+loop_2F9F:
+ IN A,(ZX_PRINTER_PORT) ; read printer port bit 0 into carry flag
+ RRA
+ JR NC,loop_2F9F ; repeat while bit is zero
+;-------------------------------
+ LD A,E
+ OUT (ZX_PRINTER_PORT),A ; E register to printer
+ DJNZ loop_2F6C
+;-------------------------------
+ LD A,4
+ OUT (ZX_PRINTER_PORT),A
+;-------------------------------
+L2FAD:
+ JP SLOW_FAST ; normal
+ EI
+ DJNZ loop_2F76
+;-------------------------------
+ defb $3E ; something to do with the table below?
+;-------------------------------
+TABLE_ONE:
+;
+; this table is copied to offsets from $2000, $2200, and $2300
+;-------------------------------
+; Modify 9 bytes in page 20xx / 00xx:
+;-------------------------------
+L2FB4 :
+ defb (9+1) ; Modify 9 bytes in page 20xx / 00xx:
+;-------------------------------
+; Original routine Modifications made in page 00xx
+;
+L2FB5:
+; 0011 C2;F1;07 JP NZ,PRINT_CH ; old
+; 0011 C2;A0;23 JP NZ,L23A0 ; new, jump somewhere in RAM ???
+
+ defb $12
+ defb $A0
+ defb $13
+ defb $23
+;-------------------------------
+L2FB9
+; 0014 F5 07 JP PRINT_SP ; $07F5
+; 2014 A4 23 JP L23A4 ; new, jumps to somewhere in RAM
+
+ defb $15
+ defb $A4
+ defb $16
+ defb $23
+;-------------------------------
+; 003F CB;D9 SET 3,C ; old
+; 003F CB;C1 SET 0,C ; new
+
+L2FBD: defb $40
+L2FBE: defb $C1
+;-------------------------------
+; 005F CD;07;02 CALL SLOW_FAST ; 0207 is old
+; 005F CD;08;2D CALL SLOW_FAST_007 ; 2D08 is new
+
+L2FBF: defb $60
+L2FC0: defb $08
+L2FC1: defb $61
+L2FC2: defb $2D
+;-------------------------------
+; 0074 2A;0C;40 LD HL,(D_FILE)
+; 0074 2A;06:23 LD HL,(G007_DISPLAY_ADDRESS_LESS_9) ; new
+
+L2FC3: defb $75
+L2FC4: defb $06
+ defb $76
+L2FC6: defb $23
+;-------------------------------
+; Modifications made in page 02xx
+;-------------------------------
+L2FC7: defb $01
+ defb $0A
+
+; 0253 06;0B LD B,$0B
+; 2253 06;02 LD B,$02
+
+L2FC9 defb $54
+ defb $02
+;-------------------------------
+; 0283 01;01;19 LD BC,$1901
+; 2283 01;01;C1 LD BC,$C101
+L2FCB: defb $85
+ defb $C1
+;-------------------------------
+; 027E CD;92;02 CALL DISPLAY_3
+; 227E CD;73;2D CALL L2D73
+;
+L2FCD: defb $7F
+ defb $73
+L2FCF: defb $80
+ defb $2D
+;-------------------------------
+; 028C CD;92;02 CALL $0292 ; [DISPLAY-3]
+; 228C CD;50;2D CALL $2D50
+L2FD1: defb $8D
+L2FD2: defb $50
+L2FD3: defb $8E
+L2FD4: defb $2D
+;-------------------------------
+; 02E3 32;28;40 LD ($4028),A ; SET MARGIN
+; 22E3 C3;0E;2D JP L2D0E
+L2FD5: defb $E3
+L2FD6: defb $C3
+ defb $E4
+ defb $0E
+L2FD9: defb $E5
+L2FDA: defb $2D
+;-------------------------------
+L2FDB: defb $13 ; some kind of marker?
+;-------------------------------
+;
+; Original routine Modifications made to the copy of the PRINT-CH routines:
+;
+;
+; Variables in the sparsely populated G007 RAM areas
+;
+; Initialise 18 (decimal, = 12 in hex)RAM variables at $23xx:
+;
+; 2FE0 E6 0A ; 23E6 0A
+; 2FE2 55 0D ; 2355 0D
+; 2FE4 1E 0F ; 231E 0F
+; 2FE6 16 20 ; 2316 20
+; 2FE8 10 07 ; 2310 07
+; 2FEA 11 08 ; 2311 08
+; 2FEC 18 C0 ; 2318 C0
+;
+;------------------ ; G007_DISPLAY_OFFSET_FROM_DFILE_LESS_9 = E675 (6675 echoed in top 32K ???)
+L2FDC: defb $00 ; 2300 75
+ defb $75
+;------------------
+L2FDE: defb $01 ; 2301 E6
+ defb $E6
+;------------------
+L2FE0: defb $0A
+;------------------
+L2FE1: defb $55 ; 2355 0D
+L2FE2: defb $0D
+;------------------
+L2FE3: defb $1E ; 231E 0F
+L2FE4: defb $0F
+;------------------
+ defb $1E ; some kind of marker?
+;------------------
+L2FE6: defb $16 ; 2316 20
+ defb $20
+;------------------ ; G007_PLOT_ROUTINES_VECTOR = G007_PLOT_ROUTINES_VECTOR_DEFAULT = $0807
+L2FE8: defb $10 ; 2310 07
+ defb $07
+;------------------
+L2FEA: defb $11 ; 2311 08
+ defb $08
+;------------------
+L2FEC: defb $18 ; 2318 C0
+ defb $C0
+;------------------
+L2FEE: defb $35 ; 2335 EE
+ defb $EE
+;------------------
+L2FF0: defb $36 ; 2336 55
+ defb $55
+;------------------
+L2FF2: defb $37 ; 2337 C6
+ defb $C6
+;------------------
+; The values below were seen in RAM but are not initialised from this table:
+;
+; 2306 84 4084 G007_DISPLAY_ADDRESS_LESS_9
+; 2307 40
+; 2308 8D 408D G007_DISPLAY_ADDRESS
+; 2309 40
+; 230A 55 00 55,00 G007_TRIANGLE_TEXTURE
+; 230C 00 1E00 Character table address for CHR$0-63
+; 230D 1E
+; 230E 00 1E00 Character table address for CHR$128-159
+; 230F 1E
+;------------------
+; Modding offsets in copied code:
+;------------------
+; 07FD CD 08 08 CALL $0808 ; [ENTER-CH]
+; 23AC CD E6 2E CALL $2EE6
+;
+L2FF4: defb $AD
+ defb $E6
+ defb $AE
+ defb $2E
+;------------------
+; 0843 FD 35 39 DEC (IY+SPOSN-RAMBASE)
+; 23F2 C3 1D 2F JP $2F1D
+;
+L2FF8: defb $F2
+ defb $C3
+
+ defb $F3
+ defb $1D
+
+ defb $F4
+ defb $2F
+;------------------
+;
+; 083E 77 LD (HL),A ; WRITE-CH
+; 23ED 00 NOP ; WRITE-CH modified!
+;
+L2FFE: defb $ED
+ defb $00
+;------------------
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+; end of g007 stuff
+;
+#endif
+
+
+
+#code $3800,$0800
+
+
+
+
+#if 1
+
+mark_3800: DEFB $21, $00, $38 ; ld hl,Source
+mark_3803: DEFB $11, $00, $78 ; ld de,Destination
+mark_3806: DEFB $01, $00, $08 ; ld bc,MonitorSize
+mark_3809: DEFB $ED, $B0 ; ldir
+mark_380B: DEFB $3E, $74 ; ld a,74
+mark_380D: DEFB $32, $05, $40 ; ld (RamtopHi),a
+mark_3810: DEFB $CD, $C3, $03 ; call New
+
+mark_3813: DEFB $3E, $01 ; ld a,01
+mark_3815: DEFB $01, $93, $7B ; ld bc,Input_Prompt_Data
+mark_3818: DEFB $CD, $02, $79 ; call Get_A_addresses
+mark_381B: DEFB $CD, $2A, $0A ; call Cls
+mark_381E: DEFB $ED, $6B, $F8, $7F ; ld hl,Next_Address
+mark_3822: DEFB $E9 ; jp (hl)
+
+; Routine 0 the disassembler
+mark_3823: DEFB $CD, $FD, $78, $CD, $09
+mark_3828: DEFB $79, $18, $05, $16, $13, $CD, $53, $7B
+mark_3830: DEFB $CD, $81, $7B, $30, $05, $AF, $32, $21
+mark_3838: DEFB $40, $C9
+mark_383A: DEFB $21, $7B, $40, $36, $30, $23
+mark_3840: DEFB $36, $78, $CD, $2E, $7A, $CD, $72, $7A
+mark_3848: DEFB $78, $FE, $76, $20, $08, $21, $F5, $7C
+mark_3850: DEFB $CD, $A4, $7B, $18, $D6, $FE, $CB, $28
+mark_3858: DEFB $32, $FE, $ED, $28, $38, $FE, $DD, $28
+mark_3860: DEFB $44, $FE, $FD, $28, $44, $CD, $4F, $7A
+mark_3868: DEFB $2E, $24, $FE, $00, $28, $11, $2E, $2C
+mark_3870: DEFB $FE, $01, $28, $0E, $2C, $FE, $02, $28
+mark_3878: DEFB $09, $3E, $5E, $32, $42, $7D, $2C, $7D
+mark_3880: DEFB $81, $6F, $26, $7D, $6E, $EB, $CD, $D4
+mark_3888: DEFB $7A, $18, $A0, $CD, $72, $7A, $CD, $4F
+mark_3890: DEFB $7A, $C6, $36, $18, $EC, $CD, $72, $7A
+mark_3898: DEFB $CD, $4F, $7A, $2E, $18, $FE, $01, $28
+mark_38A0: DEFB $DE, $2E, $20, $18, $DA, $3E, $0B, $18
+mark_38A8: DEFB $02, $3E, $0D, $32, $41, $7D, $3E, $12
+mark_38B0: DEFB $32, $40, $7D, $2A, $F8, $7F, $23, $7E
+mark_38B8: DEFB $21, $16, $7D, $CD, $89, $7A, $23, $CB
+mark_38C0: DEFB $BE, $CD, $72, $7A, $78, $FE, $CB, $20
+mark_38C8: DEFB $05, $CD, $72, $7A, $18, $BD, $CD, $4F
+mark_38D0: DEFB $7A, $FE, $03, $28, $93, $F5, $C5, $FE
+mark_38D8: DEFB $00, $20, $05, $3E, $06, $B8, $20, $03
+mark_38E0: DEFB $CD, $72, $7A, $C1, $F1, $18, $81
+
+; Spare bytes
+mark_38E7: DEFB $00
+mark_38E8: DEFB $00, $00, $00, $00, $00, $00, $00, $00
+mark_38F0: DEFB $00, $00, $00, $00, $00, $00, $00, $00
+mark_38F8: DEFB $00, $00, $00, $00, $00
+
+; Start/Finish Addresses
+; prints request for input then calls input address routine
+mark_38FD: DEFB $01, $93, $7B
+mark_3900: DEFB $3E, $02
+
+; Get_A_addresses
+mark_3902: DEFB $11, $F8, $7F, $CD, $14, $7A, $C9
+
+; Check printer
+mark_3909: DEFB $11, $E1, $10, $CD, $3B, $7B, $2B
+mark_3910: DEFB $7E, $21, $21, $40, $36, $83, $FD, $CB
+mark_3918: DEFB $01, $CE, $FE, $1D, $C4, $2A, $0A, $C9
+
+; routine 1: DEFB hex dump
+mark_3920: DEFB $CD, $FD, $78, $CD, $09, $79, $21, $F9
+mark_3928: DEFB $7C, $CD, $9F, $7B, $21, $7B, $40, $36
+mark_3930: DEFB $33, $23, $36, $79, $CD, $81, $7B, $F8
+mark_3938: DEFB $CD, $3D, $7A, $0E, $08, $CD, $72, $7A
+mark_3940: DEFB $0D, $28, $0B, $CD, $81, $7B, $30, $F5
+mark_3948: DEFB $16, $0B, $CD, $53, $7B, $C9
+mark_394E: DEFB $CD, $48, $79, $18, $E1
+
+; routine 2: DEFB write
+mark_3953: DEFB $3E, $01, $01, $93, $7B
+mark_3958: DEFB $CD, $02, $79, $CD, $2A, $0A, $CD, $0E
+mark_3960: DEFB $0C, $CD, $3D, $7A, $11, $E8, $1C, $CD
+mark_3968: DEFB $A5, $7F, $CB, $45, $28, $05, $CD, $AD
+mark_3970: DEFB $7F, $18, $F7, $ED, $5B, $F8, $7F, $CD
+mark_3978: DEFB $0B, $7B, $ED, $53, $F8, $7F, $3E, $76
+mark_3980: DEFB $D7, $18, $DB
+
+; prints data associated with RST 08 or RST 28
+mark_3983: DEFB $0D, $20, $24, $0E, $04
+mark_3988: DEFB $16, $13, $CD, $53, $7B, $18, $18, $78
+mark_3990: DEFB $FE, $01, $20, $1A, $21, $7B, $40, $36
+mark_3998: DEFB $62, $23, $36, $7A, $16, $13, $CD, $53
+mark_39A0: DEFB $7B, $21, $F9, $7C, $CD, $9F, $7B, $CD
+mark_39A8: DEFB $3D, $7A, $CD, $72, $7A, $C9
+mark_39AE: DEFB $FE, $05
+mark_39B0: DEFB $C0, $21, $7B, $40, $36, $68, $23, $36
+mark_39B8: DEFB $7A, $0E, $04, $CD, $9C, $79, $78, $FE
+mark_39C0: DEFB $34, $C8, $CD, $83, $79, $18, $F7
+
+; Data Calculates absolute address for JR instructions
+; and adds number and addresses to mnemonic
+mark_39C7: DEFB $CD
+mark_39C8: DEFB $72, $7A, $AF, $CB, $78, $28, $01, $2F
+mark_39D0: DEFB $48, $47, $2A, $F8, $7F, $09, $EB, $21
+mark_39D8: DEFB $00, $7D, $7B, $CD, $89, $7A, $2B, $7A
+mark_39E0: DEFB $CD, $89, $7A, $23, $CB, $BE, $2B, $18
+mark_39E8: DEFB $1B, $CD, $72, $7A, $2B, $18, $15, $CD
+mark_39F0: DEFB $07, $7A, $18, $10, $CD, $72, $7A, $2B
+mark_39F8: DEFB $18, $03, $CD, $07, $7A, $2B, $CD, $A4
+mark_3A00: DEFB $7B, $21, $0D, $7C, $C3, $A4, $7B, $21
+mark_3A08: DEFB $00, $7D, $CD, $75, $7A, $CD, $72, $7A
+mark_3A10: DEFB $CB, $BE, $2B, $C9
+
+; Input_Address
+mark_3A14: DEFB $F5, $D5, $11, $E4
+mark_3A18: DEFB $10, $CD, $3B, $7B, $7D, $BB, $28, $05
+mark_3A20: DEFB $CD, $AD, $7F, $18, $F7, $D1, $CD, $21
+mark_3A28: DEFB $7B, $F1, $3D, $20, $E7, $C9
+
+; Initial
+mark_3A2E: DEFB $21, $42
+mark_3A30: DEFB $7D, $36, $5C, $2B, $36, $09, $2B, $36
+mark_3A38: DEFB $0F, $2B, $2B, $36, $E0
+
+; Next_Address
+mark_3A3D: DEFB $11, $F9, $7F
+mark_3A40: DEFB $21, $FE, $7C, $1A, $CD, $7F, $7A, $1B
+mark_3A48: DEFB $1A, $CD, $7F, $7A, $AF, $D7, $C9
+
+; Octal
+mark_3A4F: DEFB $78
+mark_3A50: DEFB $E6, $07, $4F, $78, $F5, $E6, $38, $0F
+mark_3A58: DEFB $0F, $0F, $47, $F1, $E6, $C0, $07, $CB
+mark_3A60: DEFB $07, $C9
+
+; Cont, $RST
+mark_3A62: DEFB $CD, $A1, $79, $C3, $2B, $78
+mark_3A68: DEFB $0E, $04, $CD, $A1, $79, $CD, $BE, $79
+mark_3A70: DEFB $18, $F3
+
+; Next_Byte
+mark_3A72: DEFB $21, $FE, $7C, $ED, $5B, $F8
+mark_3A78: DEFB $7F, $1A, $13, $ED, $53, $F8, $7F, $CD
+mark_3A80: DEFB $89, $7A, $D7, $23, $7E, $CB, $BF, $D7
+mark_3A88: DEFB $C9
+mark_3A89: DEFB $47, $E6, $0F, $C6, $1C, $CB, $FF
+mark_3A90: DEFB $77, $2B, $78, $E6, $F0, $1F, $1F, $1F
+mark_3A98: DEFB $1F, $C6, $1C, $77, $C9
+
+; Offsets
+mark_3A9D: DEFB $CB, $40, $20
+mark_3AA0: DEFB $19, $CD, $B3, $7A, $13, $C9
+mark_3AA6: DEFB $3E, $01
+mark_3AA8: DEFB $CB, $40, $20, $1E, $18, $05, $CB, $40
+mark_3AB0: DEFB $28, $0F, $13, $AF, $18, $14, $CB, $40
+mark_3AB8: DEFB $28, $07, $13, $78, $CB, $87, $0F, $18
+mark_3AC0: DEFB $09, $CD, $BB, $7A, $13, $C9
+mark_3AC7: DEFB $78, $18
+mark_3AC8: DEFB $01, $79, $13, $62, $6B, $6E, $26, $7C
+mark_3AD0: DEFB $CD, $A5, $7B, $C9
+
+; Control
+mark_3AD4: DEFB $1A, $F5, $E6, $07
+mark_3AD8: DEFB $21, $DD, $7A, $18, $1E, $F1, $F5, $CB
+mark_3AE0: DEFB $77, $28, $0D, $2A, $3E, $7D, $CB, $55
+mark_3AE8: DEFB $36, $00, $23, $28, $F9, $22, $3E, $7D
+mark_3AF0: DEFB $E6, $38, $0F, $0F, $CB, $0F, $28, $0C
+mark_3AF8: DEFB $21, $04, $7B, $E5, $3C, $26, $7D, $6F
+mark_3B00: DEFB $6E, $26, $7A, $E9, $F1, $CB, $7F, $C0
+mark_3B08: DEFB $13, $18, $C9
+
+; Transfer
+mark_3B0B: DEFB $C5, $7D, $2E, $E0, $95
+mark_3B10: DEFB $0F, $47, $7E, $CD, $8C, $7B, $23, $86
+mark_3B18: DEFB $D6, $1C, $12, $13, $23, $10, $F3, $C1
+mark_3B20: DEFB $C9
+mark_3B21: DEFB $C5, $06, $02, $2B, $4E, $2B, $7E
+mark_3B28: DEFB $CD, $8C, $7B, $81, $D6, $1C, $12, $13
+mark_3B30: DEFB $10, $F2, $C1, $3E, $76, $D7, $D7, $C9
+
+mark_3B38: DEFB $11, $EF, $10, $CD, $33, $78, $26, $7E
+mark_3B40: DEFB $0A, $6F, $CD, $9F, $7B, $03, $0A, $6F
+mark_3B48: DEFB $03, $CD, $A4, $7B, $CD, $53, $7B, $CD
+mark_3B50: DEFB $A5, $7F, $C9
+
+; Print_String
+mark_3B53: DEFB $C5, $D5, $E5, $FD, $CB
+mark_3B58: DEFB $21, $46, $28, $08, $ED, $4B, $39, $40
+mark_3B60: DEFB $4A, $CD, $0B, $09, $11, $E0, $7F, $ED
+mark_3B68: DEFB $4B, $3E, $7D, $06, $00, $79, $D6, $E0
+mark_3B70: DEFB $4F, $CD, $6B, $0B, $FD, $CB, $21, $4E
+mark_3B78: DEFB $28, $03, $3E, $76, $D7, $E1, $D1, $C1
+mark_3B80: DEFB $C9
+
+; Check_Finish
+mark_3B81: DEFB $2A, $FA, $7F, $ED, $5B, $F8, $7F
+mark_3B88: DEFB $A7, $ED, $52, $C9
+mark_3B8C: DEFB $D6, $1C, $07, $07
+mark_3B90: DEFB $07, $07, $C9
+
+; data for input prompt messages
+mark_3B93: DEFB $DD, $E3, $EB, $E3, $F2
+mark_3B98: DEFB $F8, $D5, $DC, $30, $E3, $D0, $E3
+
+; Add_String, for building mnemonic
+mark_3B9F: DEFB $3E
+mark_3BA0: DEFB $E0, $32, $3E, $7D, $AF, $C5, $D5, $A7
+mark_3BA8: DEFB $28, $0B, $CB, $7E, $20, $03, $23, $18
+mark_3BB0: DEFB $F9, $3D, $23, $18, $F2, $CD, $BB, $7B
+mark_3BB8: DEFB $D1, $C1, $C9
+mark_3BBB: DEFB $ED, $5B, $3E, $7D, $7E
+mark_3BC0: DEFB $CB, $7F, $20, $05, $CD, $CB, $7B, $18
+mark_3BC8: DEFB $F2, $CB, $BF, $FE, $40, $30, $08, $12
+mark_3BD0: DEFB $13, $ED, $53, $3E, $7D, $23, $C9
+mark_3BD7: DEFB $23
+mark_3BD8: DEFB $ED, $53, $3E, $7D, $E5, $FE, $43, $30
+mark_3BE0: DEFB $06, $26, $7D, $6F, $6E, $18, $14, $FE
+mark_3BE8: DEFB $64, $30, $05, $26, $7D, $6F, $18, $0B
+mark_3BF0: DEFB $21, $FE, $7B, $E5, $26, $7D, $6F, $6E
+mark_3BF8: DEFB $26, $79, $E9, $CD, $BB, $7B, $E1, $C9
+;
+; data for mnemonics
+; lower case are ZX inverse characters
+;
+mark_3C00: DEFB $A7, $A8, $A9, $AA, $AD, $B1, $C0, $A6
+mark_3C08: DEFB $A6, $C1, $A6, $10, $43, $91, $10, $45
+mark_3C10: DEFB $91, $E7, $E7, $C3, $C5, $C1, $C2, $62
+mark_3C18: DEFB $A8, $45, $A8, $47, $D6, $49, $D6, $47
+mark_3C20: DEFB $A6, $49, $A6, $29, $26, $A6, $28, $35
+mark_3C28: DEFB $B1, $38, $28, $AB, $28, $28, $AB, $9C
+mark_3C30: DEFB $9D, $9E, $9F, $A0, $A1, $A2, $A3, $35
+mark_3C38: DEFB $3A, $38, $AD, $56, $31, $B1, $37, $2A
+mark_3C40: DEFB $B9, $4B, $BD, $2F, $B5, $CD, $58, $A9
+mark_3C48: DEFB $58, $A8, $38, $3A, $A7, $38, $C3, $26
+mark_3C50: DEFB $33, $A9, $3D, $34, $B7, $34, $B7, $28
+mark_3C58: DEFB $B5, $35, $34, $B5, $37, $38, $B9, $2F
+mark_3C60: DEFB $B5, $80, $D3, $E2, $CB, $CB, $29, $AE
+mark_3C68: DEFB $2A, $AE, $E5, $E8, $66, $1A, $A6, $4F
+mark_3C70: DEFB $E6, $10, $5C, $11, $DA, $45, $DA, $80
+mark_3C78: DEFB $80, $10, $41, $91, $5C, $DA, $CF, $CF
+mark_3C80: DEFB $80, $CF, $80, $80, $80, $80, $33, $BF
+mark_3C88: DEFB $BF, $33, $A8, $A8, $35, $B4, $35, $AA
+mark_3C90: DEFB $B5, $B2, $47, $A8, $49, $A8, $C7, $C9
+mark_3C98: DEFB $38, $31, $A6, $38, $37, $A6, $E4, $38
+mark_3CA0: DEFB $C7, $27, $2E, $B9, $37, $2A, $B8, $38
+mark_3CA8: DEFB $2A, $B9, $10, $28, $91, $33, $2A, $AC
+mark_3CB0: DEFB $B3, $AE, $38, $C3, $58, $A8, $2E, $B2
+mark_3CB8: DEFB $9C, $A4, $9D, $9E, $CD, $CD, $CD, $CD
+mark_3CC0: DEFB $49, $A9, $47, $A9, $2E, $9A, $37, $9A
+mark_3CC8: DEFB $CF, $CF, $80, $80, $5E, $1A, $DE, $E9
+mark_3CD0: DEFB $E9, $E0, $E0, $E0, $E0, $A6, $A6, $AE
+mark_3CD8: DEFB $B7, $80, $80, $AE, $A9, $2E, $B7, $29
+mark_3CE0: DEFB $B7, $CD, $28, $B5, $E2, $D3, $34, $B9
+mark_3CE8: DEFB $33, $34, $B5, $CB, $29, $2F, $33, $BF
+mark_3CF0: DEFB $D1, $D1, $D1, $D1, $D1, $2D, $26, $31
+mark_3CF8: DEFB $B9, $45, $2B, $A7, $10, $1D, $A9, $27
+;
+; data and data pointers for disassembler
+;
+mark_3D00: DEFB $9F, $A6, $C9, $B3, $AE, $BB, $9D, $B6
+mark_3D08: DEFB $C6, $2D, $B1, $2E, $BD, $2E, $BE, $10
+mark_3D10: DEFB $41, $91, $10, $41, $15, $2A, $27, $91
+mark_3D18: DEFB $CD, $D3, $D9, $DF, $3C, $E8, $EB, $EE
+mark_3D20: DEFB $F3, $F3, $F3, $F5, $91, $81, $89, $6D
+mark_3D28: DEFB $6A, $F9, $7B, $3A, $70, $9C, $A1, $76
+mark_3D30: DEFB $A4, $AA, $AD, $FC, $B3, $96, $B8, $BB
+mark_3D38: DEFB $C1, $C7, $87, $1B, $81, $A1, $E4, $7F
+mark_3D40: DEFB $0F, $09, $5C, $27, $A8, $29, $AA, $37
+mark_3D48: DEFB $B1, $37, $B7, $2A, $BD, $31, $A9, $26
+mark_3D50: DEFB $9A, $2F, $B7, $34, $3A, $B9, $28, $A6
+mark_3D58: DEFB $26, $A9, $1A, $C1, $38, $B5, $26, $AB
+mark_3D60: DEFB $1A, $E9, $2E, $B3, $E9, $EF, $F4, $FA
+mark_3D68: DEFB $8F, $C7, $FA, $17, $00, $E0, $17, $13
+mark_3D70: DEFB $7A, $45, $00, $8A, $C5, $00, $F5, $59
+mark_3D78: DEFB $3E, $13, $77, $7A, $45, $00, $92, $C5
+mark_3D80: DEFB $9E, $58, $45, $13, $15, $AA, $C5, $6A
+mark_3D88: DEFB $13, $72, $45, $0B, $07, $B2, $C5, $07
+mark_3D90: DEFB $0B, $7F, $E8, $82, $87, $CB, $62, $5C
+mark_3D98: DEFB $2F, $90, $B8, $6B, $7F, $46, $7E, $81
+mark_3DA0: DEFB $00, $FA, $3E, $86, $7A, $43, $86, $92
+mark_3DA8: DEFB $C5, $6A, $FF, $5F, $6A, $7A, $3B, $86
+mark_3DB0: DEFB $92, $C5, $6A, $7F, $46, $7E, $82, $9E
+mark_3DB8: DEFB $CF, $92, $00, $7A, $A1, $2F, $8A, $C5
+mark_3DC0: DEFB $00, $7A, $A4, $2F, $8A, $C5, $00, $7A
+mark_3DC8: DEFB $A7, $2F, $8A, $C5, $00, $7A, $63, $00
+mark_3DD0: DEFB $92, $C5, $AA, $52, $62, $AA, $BA, $C5
+mark_3DD8: DEFB $00, $50, $B2, $15, $A2, $C5, $13, $6A
+mark_3DE0: DEFB $45, $11, $13, $9A, $C5, $13, $11, $00
+mark_3DE8: DEFB $BA, $3E, $B0, $FA, $B6, $B8, $7F, $BC
+mark_3DF0: DEFB $C4, $87, $D5, $B9, $E1, $D7, $BC, $E2
+mark_3DF8: DEFB $D7, $FA, $19, $00, $D8, $37, $13, $6A
+;
+; print data for menu & routines
+;
+mark_3E00: DEFB $00, $00, $00, $00, $32, $2A, $33, $BA
+mark_3E08: DEFB $00, $00, $00, $00, $14, $14, $14, $94
+mark_3E10: DEFB $1C, $00, $35, $37, $2E, $33, $39, $00
+mark_3E18: DEFB $28, $34, $29, $AA, $1D, $00, $2D, $2A
+mark_3E20: DEFB $3D, $00, $29, $3A, $32, $B5, $1E, $00
+mark_3E28: DEFB $3C, $37, $2E, $39, $AA, $1F, $00, $2E
+mark_3E30: DEFB $33, $38, $2A, $37, $B9, $20, $00, $29
+mark_3E38: DEFB $2A, $31, $2A, $39, $AA, $21, $00, $39
+mark_3E40: DEFB $37, $26, $33, $38, $2B, $2A, $B7, $22
+mark_3E48: DEFB $00, $38, $2A, $26, $37, $28, $AD, $23
+mark_3E50: DEFB $00, $37, $2A, $35, $31, $26, $28, $AA
+mark_3E58: DEFB $24, $00, $26, $38, $38, $2A, $32, $27
+mark_3E60: DEFB $31, $2A, $B7, $25, $00, $37, $3A, $33
+mark_3E68: DEFB $00, $28, $34, $29, $AA, $26, $00, $28
+mark_3E70: DEFB $26, $31, $28, $3A, $31, $26, $39, $34
+mark_3E78: DEFB $B7, $27, $00, $28, $2D, $37, $0D, $00
+mark_3E80: DEFB $29, $3A, $32, $B5, $28, $00, $26, $38
+mark_3E88: DEFB $28, $2E, $2E, $00, $29, $3A, $32, $B5
+mark_3E90: DEFB $29, $00, $37, $2A, $33, $3A, $32, $27
+mark_3E98: DEFB $2A, $B7, $2A, $00, $2E, $32, $26, $2C
+mark_3EA0: DEFB $2A, $B7, $2B, $00, $32, $2A, $33, $3A
+mark_3EA8: DEFB $00, $9E, $80, $80, $00, $00, $00, $00
+mark_3EB0: DEFB $00, $00, $00, $00, $00, $00, $00, $00
+mark_3EB8: DEFB $00, $00, $00, $00, $00, $00, $00, $00
+mark_3EC0: DEFB $00, $00, $00, $00, $00, $00, $00, $00
+mark_3EC8: DEFB $00, $00, $00, $00, $00, $00, $00, $00
+mark_3ED0: DEFB $31, $2E, $32, $2E, $B9, $37, $34, $3A
+mark_3ED8: DEFB $39, $2E, $33, $2A, $80, $38, $39, $26
+mark_3EE0: DEFB $37, $39, $80, $26, $29, $29, $37, $2A
+mark_3EE8: DEFB $38, $38, $80, $2B, $2E, $33, $2E, $38
+mark_3EF0: DEFB $2D, $80, $1D, $00, $2B, $34, $37, $80
+mark_3EF8: DEFB $35, $37, $2E, $33, $39, $2A, $37, $80
+
+; addresses of routines
+mark_3F00: DEFB $23, $78 ;, $.dw, $7823
+mark_3F02: DEFB $20, $79 ; , $.dw, $7902
+mark_3F04: DEFB $53, $79 ;, $.dw, $7953
+mark_3F06: DEFB $FF, $FF
+mark_3F08: DEFB $FF, $FF
+mark_3F0A: DEFB $FF, $FF
+mark_3F0C: DEFB $FF, $FF
+mark_3F0E: DEFB $FF, $FF
+mark_3F10: DEFB $FF, $FF
+mark_3F12: DEFB $13, $38 ;, $.dw, $3813
+mark_3F14: DEFB $FF, $FF
+mark_3F16: DEFB $FF, $FF
+mark_3F18: DEFB $FF, $FF
+mark_3F1A: DEFB $FF, $FF
+mark_3F1C: DEFB $FF, $FF
+mark_3F1E: DEFB $FF, $FF
+
+; Read_Keyboard
+mark_3F20: DEFB $D5, $C5, $E5, $2A, $25, $40, $E5, $ED
+mark_3F28: DEFB $4B, $25, $40, $E1, $C5, $A7, $ED, $42
+mark_3F30: DEFB $28, $F5, $79, $3C, $28, $F1, $E1, $CD
+mark_3F38: DEFB $BD, $07, $7E, $E1, $C1, $D1, $FE, $76
+mark_3F40: DEFB $C8, $FE, $77, $C8, $FE, $00, $20, $05
+mark_3F48: DEFB $CD, $2A, $0A, $CF, $0C, $FE, $1C, $38
+mark_3F50: DEFB $CF, $FE, $2C, $30, $CB, $C9
+;
+; Menu
+;
+mark_3F56: DEFB $21, $21
+mark_3F58: DEFB $40, $CB, $7E, $28, $04, $2A, $7B, $40
+mark_3F60: DEFB $E9, $21, $00, $7E, $06, $14, $3E, $03
+mark_3F68: DEFB $32, $21, $40, $11, $E1, $18, $CD, $9F
+mark_3F70: DEFB $7B, $CD, $53, $7B, $10, $F8, $01, $99
+mark_3F78: DEFB $7B, $CD, $3B, $7B, $2B, $7E, $D6, $1C
+mark_3F80: DEFB $47, $07, $6F, $26, $7F, $7E, $23, $66
+mark_3F88: DEFB $6F, $E5, $C5, $CD, $2A, $0A, $C1, $3E
+mark_3F90: DEFB $E0, $32, $3E, $7D, $78, $21, $10, $7E
+mark_3F98: DEFB $CD, $A5, $7B, $16, $1A, $CD, $53, $7B
+mark_3FA0: DEFB $3E, $76, $D7, $D7, $C9
+;
+; InputString, the heart of all routines
+;
+mark_3FA5: DEFB $3E, $01, $32
+mark_3FA8: DEFB $21, $40, $21, $E0, $7F, $36, $17, $CD
+mark_3FB0: DEFB $C0, $7F, $CD, $20, $7F, $FE, $76, $20
+mark_3FB8: DEFB $10, $3E, $E0, $BD, $28, $F4, $36, $00
+mark_3FC0: DEFB $23, $22, $3E, $7D, $CD, $53, $7B, $2B
+mark_3FC8: DEFB $C9
+mark_3FC9: DEFB $FE, $77, $20, $0B, $3E, $E0, $BD
+mark_3FD0: DEFB $28, $DB, $CD, $BE, $7F, $2B, $18, $D5
+mark_3FD8: DEFB $77, $7B, $BD, $28, $D0, $23, $18, $CD
+;
+; mnemonic string, ram area for mnemonic to be built up
+;
+mark_3FE0: DEFB $00, $00, $00, $00, $00, $00, $00, $00
+mark_3FE8: DEFB $00, $00, $00, $00, $00, $00, $00, $00
+;
+; spare bytes
+;
+mark_3FF0: DEFB $00, $00, $00, $00, $00, $00, $00, $00
+;
+; next address for routine
+;
+mark_3FF8: DEFB $00, $00
+;
+; finish address for routine
+;
+mark_3FFA: DEFB $00, $00
+;
+; spare bytes
+;
+mark_3FFC: DEFB $00, $00, $00
+mark_3FFF: DEFB $C9 ; ret
+
+
+#else
+;
+;
+;
+Input_Prompt_Data equ $7B93
+Get_A_addresses equ $7902
+Next_Address equ $7FFB
+#endif
+
+
+
+
+
+
+
+
+#end ; required by zasm
+
+
diff --git a/mirror/tablix.org/sg81.html b/mirror/tablix.org/sg81.html
@@ -0,0 +1,3224 @@
+<HTML>
+<HEAD>
+<TITLE>
+Assembly Listing of the Shoulders of Giants ZX81 ROM.
+</TITLE>
+</HEAD>
+<BODY>
+<font face = "Courier"> </font>
+<PRE>
+; =========================================================
+; An Assembly Listing of the "Shoulders of Giants" ZX81 ROM
+; =========================================================
+; -------------------------
+; Last updated: 23-OCT-2003
+; -------------------------
+;
+; The "Shoulders of Giants" ZX81 ROM.
+; This file shows the altered sections of the ZX81/TS1000 ROM that produced
+; the customized sg81.rom.
+; The main feature is the inclusion of Newton Raphson square roots.
+; The square roots are executed 3 times faster than those in the
+; standard ROM. They are more accurate also and
+;
+; PRINT SQR 100 = INT SQR 100 gives the result 1 (true) not 0 (false)
+;
+; The input and storage of fractional numbers is improved
+;
+; PRINT 1/2 = .5 gives the result 1 (true) and not 0 (false)
+;
+; The output of fractional numbers to the ZX Printer is corrected
+;
+; LPRINT .00001 gives the output .00001 and not .0XYZ1
+;
+; Other alterations have been made to create the space required by the
+; new square root routine and some are obscure and would not otherwise have
+; been made.
+; Using uncompressed constants rectifies a logic error and improves speed.
+
+#define DEFB .BYTE ; TASM cross-assembler definitions
+#define DEFW .WORD
+#define EQU .EQU
+#define ORG .ORG
+
+
+; the backward references
+
+<a name="subtract"></a><b>subtract</b> EQU $174C ; SUBTRACT
+<a name="multiply"></a><b>multiply</b> EQU $176C ; multiply
+<a name="division"></a><b>division</b> EQU $1882 ; division
+<a name="addition"></a><b>addition</b> EQU $1755 ; addition
+<a name="truncate"></a><b>truncate</b> EQU $18E4 ; truncate
+<a name="e_to_fp"></a><b>e_to_fp</b> EQU $155A ; e-to-fp
+<a name="TEST_ROOM"></a><b>TEST_ROOM</b> EQU $0EC5 ; TEST-ROOM
+<a name="FIND_INT"></a><b>FIND_INT</b> EQU $0EA7 ; FIND-INT
+<a name="STACK_A"></a><b>STACK_A</b> EQU $151D ; STACK-A
+<a name="STACK_BC"></a><b>STACK_BC</b> EQU $1520 ; STACK-BC
+<a name="STK_FETCH"></a><b>STK_FETCH</b> EQU $13F8 ; STK-FETCH
+<a name="STK_STO_s"></a><b>STK_STO_s</b> EQU $12C3 ; STK-STO-$
+<a name="FP_TO_A"></a><b>FP_TO_A</b> EQU $15CD ; FP-TO-A
+<a name="CLASS_06"></a><b>CLASS_06</b> EQU $0D92 ; CLASS-06
+<a name="CHECK_2"></a><b>CHECK_2</b> EQU $0D22 ; CHECK-2
+<a name="SCANNING"></a><b>SCANNING</b> EQU $0F55 ; SCANNING
+<a name="PRINT_FP"></a><b>PRINT_FP</b> EQU $15DB ; PRINT-FP
+
+; -----------------------------------------------------------------------------
+
+<a name="ORG"></a><b>ORG</b> $0010
+
+;--------------------------------
+; THE <b><font color=#333388>'PRINT A CHARACTER'</font></b> RESTART
+;--------------------------------
+; This restart prints the character in the accumulator using the alternate
+; register set so there is no requirement to save the main registers.
+; There is sufficient room available to separate a space (zero) from other
+; characters as leading spaces need not be considered with a space.
+; <font color=#9900FF>Note.</font> the accumulator is preserved only when printing to the screen.
+
+<a name="PRINT_A"></a><b>PRINT_A</b> AND A ; test for zero - space.
+ JP NZ,<A href="#PRINT_CH">PRINT_CH</a> ; jump forward if not to PRINT-CH.
+
+ JP <A href="#PRINT_SP">PRINT_SP</a> ; jump forward to PRINT-SP.
+
+; ---
+
+ <font color=#3333FF> DEFB $01 ;+ unused location. Version. PRINT PEEK 23</font>
+
+; -----------------------------------------------------------------------------
+
+<a name="ORG"></a><b>ORG</b> $0028
+
+
+; -----------------------
+; THE <b><font color=#333388>'CALCULATE'</font></b> RESTART
+; -----------------------
+; An immediate jump is made to the CALCULATE routine the address of which
+; has changed.
+
+<a name="FP_CALC"></a><b>FP_CALC</b> <font color=#3333FF> JP <A href="#CALCULATE">CALCULATE</a> ;+ jump to the NEW calculate routine address.</font>
+
+<a name="end_calc"></a><b>end_calc</b> 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.
+
+; -----------------------------------------------------------------------------
+
+<a name="ORG"></a><b>ORG</b> $13AE
+
+; ------------------------
+; THE <b><font color=#333388>'L-ENTER'</font></b> SUBROUTINE
+; ------------------------
+; Part of the LET command contains a natural subroutine which is a
+; conditional LDIR. The copy only occurs of BC is non-zero.
+
+<a name="L_ENTER"></a><b>L_ENTER</b> EX DE,HL ;
+
+
+<a name="COND_MV"></a><b>COND_MV</b> LD A,B ;
+ OR C ;
+ RET Z ;
+
+ PUSH DE ;
+
+ LDIR ; Copy Bytes
+
+ POP HL ;
+ RET ; Return.
+
+; -----------------------------------------------------------------------------
+
+<a name="ORG"></a><b>ORG</b> $14E5
+
+; ---------------------
+; THE <b><font color=#333388>'NEXT DIGIT'</font></b> LOOP
+; ---------------------
+; Within the 'DECIMAL TO FLOATING POINT' routine, swapping the multiply and
+; divide literals preserves accuracy and ensures that .5 is evaluated
+; as 5/10 and not as .1 * 5.
+
+<a name="NXT_DGT_1"></a><b>NXT_DGT_1</b> RST 20H ; NEXT-CHAR
+ CALL $1514 ; routine STK-DIGIT
+ JR C,$14F5 ; forward to E-FORMAT
+
+
+ RST 28H ;; FP-CALC
+ DEFB $E0 ;;get-mem-0
+ DEFB $A4 ;;stk-ten
+<font color=#FF3333>;;; DEFB $05 ;;division</font>
+ <font color=#3333FF> DEFB $04 ;;+multiply</font>
+ DEFB $C0 ;;st-mem-0
+<font color=#FF3333>;;; DEFB $04 ;;multiply</font>
+ <font color=#3333FF> DEFB $05 ;;+division</font>
+ DEFB $0F ;;addition
+ DEFB $34 ;;end-calc
+
+ JR NXT_DGT_1 ; loop back till exhausted to NXT-DGT-1
+
+; -----------------------------------------------------------------------------
+
+<a name="ORG"></a><b>ORG</b> $16B2
+
+; -------------------------------------
+; THE <b><font color=#333388>'FLOATING POINT PRINT ZEROS'</font></b> LOOP
+; -------------------------------------
+
+; This branch deals with zeros after decimal point.
+; e.g. .01 or .0000999
+; <font color=#9900FF>Note.</font> that printing to the ZX Printer destroys A and that A should be
+; initialized to '0' at each stage of the loop.
+; Originally LPRINT .00001 printed as .0XYZ1
+
+<a name="PF_ZEROS"></a><b>PF_ZEROS</b> NEG ; negate makes number positive 1 to 4.
+ LD B,A ; zero count to B.
+
+ LD A,$1B ; prepare character '.'
+ RST 10H ; PRINT-A
+
+<a name="PF_ZRO_LP"></a><b>PF_ZRO_LP</b> LD A,$1C ; prepare a '0' in the accumulator each time.
+
+<a name="PFZROLP"></a><b>PFZROLP</b> RST 10H ; PRINT-A
+
+ <font color=#3333FF> DJNZ <A href="#PF_ZRO_LP">PF_ZRO_LP</a> ;+ New loop back to PF-ZRO-LP</font>
+
+<font color=#FF3333>;;; DJNZ <A href="#PFZROLP">PFZROLP</a> ; obsolete loop back to PFZROLP</font>
+
+
+; and continue with trailing fractional digits...
+
+; -----------------------------------------------------------------------------
+
+<a name="ORG"></a><b>ORG</b> $1915
+
+
+; Up to this point all routine addresses have been maintained so that the
+; modified ROM is compatible with any machine-code software that uses ROM
+; routines.
+; The final section does not maintain address entry points as the routines
+; within are not generally called directly.
+
+;********************************
+;** FLOATING-POINT CALCULATOR **
+;********************************
+
+; As a general rule the calculator avoids using the IY register.
+; The exception is the 'val' function.
+; So an assembly language programmer who has disabled interrupts to use IY
+; for other purposes can still use the calculator for mathematical
+; purposes.
+
+
+; ------------------------
+; THE <b><font color=#333388>'TABLE OF CONSTANTS'</font></b>
+; ------------------------
+; The ZX81 has only floating-point number representation.
+; Both the ZX80 and the ZX Spectrum have integer numbers in some form.
+; This table has been modified so that the constants are held in their
+; uncompressed, ready-to-party, 5-byte form.
+
+<font color=#FF3333>;;; L1915: DEFB $00 ;;Bytes: 1</font>
+<font color=#FF3333>;;; DEFB $B0 ;;Exponent $00</font>
+<font color=#FF3333>;;; DEFB $00 ;;(+00,+00,+00)</font>
+<font color=#FF3333>;;; L1918: DEFB $31 ;;Exponent $81, Bytes: 1</font>
+<font color=#FF3333>;;; DEFB $00 ;;(+00,+00,+00)</font>
+<font color=#FF3333>;;; L191A: DEFB $30 ;;Exponent: $80, Bytes: 1</font>
+<font color=#FF3333>;;; DEFB $00 ;;(+00,+00,+00)</font>
+<font color=#FF3333>;;; L191C: DEFB $F1 ;;Exponent: $81, Bytes: 4</font>
+<font color=#FF3333>;;; DEFB $49,$0F,$DA,$A2 ;;</font>
+<font color=#FF3333>;;; L1921: DEFB $34 ;;Exponent: $84, Bytes: 1</font>
+<font color=#FF3333>;;; DEFB $20 ;;(+00,+00,+00)</font>
+
+<a name="TAB_CNST"></a><b>TAB_CNST</b> DEFB $00 ; the value zero.
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+
+ DEFB $81 ; the floating point value 1.
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+
+ DEFB $80 ; the floating point value 1/2.
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+
+ DEFB $81 ; the floating point value pi/2.
+ DEFB $49 ;
+ DEFB $0F ;
+ DEFB $DA ;
+ DEFB $A2 ;
+
+ DEFB $84 ; the floating point value ten.
+ DEFB $20 ;
+ DEFB $00 ;
+ DEFB $00 ;
+ DEFB $00 ;
+
+; ------------------------
+; THE <b><font color=#333388>'TABLE OF ADDRESSES'</font></b>
+; ------------------------
+;
+; Starts with binary operations which have two operands and one result.
+; three pseudo binary operations first.
+
+<a name="tbl_addrs"></a><b>tbl_addrs</b> DEFW jump_true ; $00 Address: $1C2F - jump-true
+ DEFW exchange ; $01 Address: $1A72 - exchange
+ DEFW delete ; $02 Address: $19E3 - delete
+
+; true binary operations.
+
+ DEFW subtract ; $03 Address: $174C - subtract
+ DEFW multiply ; $04 Address: $176C - multiply
+ DEFW division ; $05 Address: $1882 - division
+ DEFW to_power ; $06 Address: $1DE2 - to-power
+ DEFW or ; $07 Address: $1AED - or
+
+ DEFW no_v_no ; $08 Address: $1B03 - no-&-no
+ DEFW no_l_eql ; $09 Address: $1B03 - no-l-eql
+ DEFW no_l_eql ; $0A Address: $1B03 - no-gr-eql
+ DEFW no_l_eql ; $0B Address: $1B03 - nos-neql
+ DEFW no_l_eql ; $0C Address: $1B03 - no-grtr
+ DEFW no_l_eql ; $0D Address: $1B03 - no-less
+ DEFW no_l_eql ; $0E Address: $1B03 - nos-eql
+ DEFW addition ; $0F Address: $1755 - addition
+
+ DEFW str_v_no ; $10 Address: $1AF8 - str-&-no
+ DEFW no_l_eql ; $11 Address: $1B03 - str-l-eql
+ DEFW no_l_eql ; $12 Address: $1B03 - str-gr-eql
+ DEFW no_l_eql ; $13 Address: $1B03 - strs-neql
+ DEFW no_l_eql ; $14 Address: $1B03 - str-grtr
+ DEFW no_l_eql ; $15 Address: $1B03 - str-less
+ DEFW no_l_eql ; $16 Address: $1B03 - strs-eql
+ DEFW strs_add ; $17 Address: $1B62 - strs-add
+
+; unary follow
+
+ DEFW negate ; $18 Address: $1AA0 - neg
+
+ DEFW code ; $19 Address: $1C06 - code
+ DEFW val ; $1A Address: $1BA4 - val
+ DEFW len ; $1B Address: $1C11 - len
+ DEFW sin ; $1C Address: $1D49 - sin
+ DEFW cos ; $1D Address: $1D3E - cos
+ DEFW tan ; $1E Address: $1D6E - tan
+ DEFW asn ; $1F Address: $1DC4 - asn
+ DEFW acs ; $20 Address: $1DD4 - acs
+ DEFW atn ; $21 Address: $1D76 - atn
+ DEFW ln ; $22 Address: $1CA9 - ln
+ DEFW exp ; $23 Address: $1C5B - exp
+ DEFW int ; $24 Address: $1C46 - int
+ DEFW sqr ; $25 Address: $1DDB - sqr
+ DEFW sgn ; $26 Address: $1AAF - sgn
+ DEFW abs ; $27 Address: $1AAA - abs
+ DEFW peek ; $28 Address: $1A1B - peek
+ DEFW usr_no ; $29 Address: $1AC5 - usr-no
+ DEFW strS ; $2A Address: $1BD5 - str$
+ DEFW chrS ; $2B Address: $1B8F - chrs
+ DEFW not ; $2C Address: $1AD5 - not
+
+; end of true unary
+
+ DEFW MOVE_FP ; $2D Address: $19F6 - duplicate
+ DEFW n_mod_m ; $2E Address: $1C37 - n-mod-m
+
+ DEFW JUMP ; $2F Address: $1C23 - jump
+ DEFW stk_data ; $30 Address: $19FC - stk-data
+
+ DEFW dec_jr_nz ; $31 Address: $1C17 - dec-jr-nz
+ DEFW less_0 ; $32 Address: $1ADB - less-0
+ DEFW greater_0 ; $33 Address: $1ACE - greater-0
+ DEFW end_calc ; $34 Address: $002B - end-calc
+ DEFW get_argt ; $35 Address: $1D18 - get-argt
+ DEFW truncate ; $36 Address: $18E4 - truncate
+ DEFW fp_calc_2 ; $37 Address: $19E4 - fp-calc-2
+ DEFW e_to_fp ; $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 seriesg_x ; $39 Address: $1A7F - series-xx $80 - $9F.
+ DEFW stk_con_x ; $3A Address: $1A51 - stk-const-xx $A0 - $BF.
+ DEFW sto_mem_x ; $3B Address: $1A63 - st-mem-xx $C0 - $DF.
+ DEFW get_mem_x ; $3C Address: $1A45 - get-mem-xx $E0 - $FF.
+
+; -------------------------------
+; THE <b><font color=#333388>'FLOATING POINT CALCULATOR'</font></b>
+; -------------------------------
+;
+;
+
+<a name="CALCULATE"></a><b>CALCULATE</b> CALL <A href="#STK_PNTRS">STK_PNTRS</a> ; routine STK-PNTRS is called to set up the
+ ; calculator stack pointers for a default
+ ; unary operation. HL = last value on stack.
+ ; DE = STKEND first location after stack.
+
+; the calculate routine is called at this point by the series generator...
+
+<a name="GEN_ENT_1"></a><b>GEN_ENT_1</b> LD A,B ; fetch the Z80 B register to A
+ LD ($401E),A ; and store value in system variable BREG.
+ ; this will be the counter for dec-jr-nz
+ ; or if used from fp-calc2 the calculator
+ ; instruction.
+
+; ... and again later at this point
+
+<a name="GEN_ENT_2"></a><b>GEN_ENT_2</b> EXX ; switch sets
+ EX (SP),HL ; and store the address of next instruction,
+ ; the return address, in H'L'.
+ ; If this is a recursive call then the H'L'
+ ; of the previous invocation goes on stack.
+ ; c.f. end-calc.
+ EXX ; switch back to main set.
+
+; this is the re-entry looping point when handling a string of literals.
+
+<a name="RE_ENTRY"></a><b>RE_ENTRY</b> LD ($401C),DE ; save end of stack in system variable STKEND
+ EXX ; switch to alt
+ LD A,(HL) ; get next literal
+ INC HL ; increase pointer'
+
+; single operation jumps back to here
+
+<a name="SCAN_ENT"></a><b>SCAN_ENT</b> PUSH HL ; save pointer on stack *
+ AND A ; now test the literal
+ JP P,<A href="#FIRST_3D">FIRST_3D</a> ; forward to FIRST-3D if in range $00 - $3D
+ ; anything with bit 7 set will be one of
+ ; 128 compound literals.
+
+; Compound literals have the following format.
+; bit 7 set indicates compound.
+; bits 6-5 the subgroup 0-3.
+; bits 4-0 the embedded parameter $00 - $1F.
+; The subgroup 0-3 needs to be manipulated to form the next available four
+; address places after the simple literals in the address table.
+
+ LD D,A ; save literal in D
+ AND $60 ; and with 01100000 to isolate subgroup
+ RRCA ; rotate bits
+ RRCA ; 4 places to right
+ RRCA ; not five as we need offset * 2
+ RRCA ; 00000xx0
+ ADD A,$72 ; add ($39 * 2) to give correct offset.
+ ; alter above if you add more literals.
+ LD L,A ; store in L for later indexing.
+ LD A,D ; bring back compound literal
+ AND $1F ; use mask to isolate parameter bits
+ JR <A href="#ENT_TABLE">ENT_TABLE</a> ; forward to ENT-TABLE
+
+; ---
+
+; the branch was here with simple literals.
+
+<a name="FIRST_3D"></a><b>FIRST_3D</b> CP $18 ; compare with first unary operations.
+ JR NC,<A href="#DOUBLE_A">DOUBLE_A</a> ; to DOUBLE-A with unary operations
+
+; it is binary so adjust pointers.
+
+ EXX ;
+ LD BC,$FFFB ; the value -5
+ LD D,H ; transfer HL, the last value, to DE.
+ LD E,L ;
+ ADD HL,BC ; subtract 5 making HL point to second
+ ; value.
+ EXX ;
+
+<a name="DOUBLE_A"></a><b>DOUBLE_A</b> RLCA ; double the literal
+ LD L,A ; and store in L for indexing
+
+<a name="ENT_TABLE"></a><b>ENT_TABLE</b> LD DE,tbl_addrs ; 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,RE_ENTRY ; Address: RE-ENTRY
+ EX (SP),HL ; goes on machine stack
+ ; address of next literal goes to HL. *
+
+
+ PUSH DE ; now the address of routine is stacked.
+ EXX ; back to main set
+ ; avoid using IY register.
+ LD BC,($401D) ; STKEND_hi
+ ; nothing much goes to C but BREG to B
+ ; and continue into next ret instruction
+ ; which has a dual identity
+
+
+; -----------------------
+; THE <b><font color=#333388>'DELETE'</font></b> SUBROUTINE
+; -----------------------
+; <font color=#339933>(offset $02: 'delete')</font>
+; A simple return but when used as a calculator literal this
+; deletes the last value from the calculator stack.
+; On entry, as always with binary operations,
+; HL=first number, DE=second number
+; On exit, HL=result, DE=stkend.
+; So nothing to do
+
+<a name="delete"></a><b>delete</b> RET ; return - indirect jump if from above.
+
+; ---------------------------------
+; THE <b><font color=#333388>'SINGLE OPERATION'</font></b> SUBROUTINE
+; ---------------------------------
+; offset $37: 'fp-calc-2'
+; this single operation is used, in the first instance, to evaluate most
+; of the mathematical and string functions found in BASIC expressions.
+
+<a name="fp_calc_2"></a><b>fp_calc_2</b> POP AF ; drop return address.
+ LD A,($401E) ; load accumulator from system variable BREG
+ ; value will be literal eg. 'tan'
+ EXX ; switch to alt
+ JR <A href="#SCAN_ENT">SCAN_ENT</a> ; back to SCAN-ENT
+ ; next literal will be end-calc in scanning
+
+; ------------------------------
+; THE <b><font color=#333388>'TEST 5 SPACES'</font></b> SUBROUTINE
+; ------------------------------
+; This routine is called from MOVE-FP, STK-CONST and STK-STORE to
+; test that there is enough space between the calculator stack and the
+; machine stack for another five-byte value. It returns with BC holding
+; the value 5 ready for any subsequent LDIR.
+
+<a name="TEST_5_SP"></a><b>TEST_5_SP</b> PUSH DE ; save
+ PUSH HL ; registers
+ LD BC,$0005 ; an overhead of five bytes
+ CALL <A href="#TEST_ROOM">TEST_ROOM</a> ; routine TEST-ROOM tests free RAM raising
+ ; an error if not.
+ POP HL ; else restore
+ POP DE ; registers.
+ RET ; return with BC set at 5.
+
+
+; ---------------------------------------------
+; THE <b><font color=#333388>'MOVE A FLOATING POINT NUMBER'</font></b> SUBROUTINE
+; ---------------------------------------------
+; offset $2D: 'duplicate'
+; This simple routine is a 5-byte LDIR instruction
+; that incorporates a memory check.
+; When used as a calculator literal it duplicates the last value on the
+; calculator stack.
+; Unary so on entry HL points to last value, DE to stkend
+
+<a name="MOVE_FP"></a><b>MOVE_FP</b> CALL <A href="#TEST_5_SP">TEST_5_SP</a> ; routine TEST-5-SP test free memory
+ ; and sets BC to 5.
+
+ LDIR ; copy the five bytes.
+ RET ; return with DE addressing new STKEND
+ ; and HL addressing new last value.
+
+; -------------------------------
+; THE <b><font color=#333388>'STACK LITERALS'</font></b> SUBROUTINE
+; -------------------------------
+; offset $30: 'stk-data'
+; When a calculator subroutine needs to put a value on the calculator
+; stack that is not a regular constant this routine is called with a
+; variable number of following data bytes that convey to the routine
+; the floating point form as succinctly as is possible.
+
+<a name="stk_data"></a><b>stk_data</b> LD H,D ; transfer STKEND
+ LD L,E ; to HL for result.
+
+<a name="STK_CONST"></a><b>STK_CONST</b> CALL <A href="#TEST_5_SP">TEST_5_SP</a> ; routine TEST-5-SP tests that room exists
+ ; and sets BC to $05.
+
+ EXX ; switch to alternate set
+ PUSH HL ; save the pointer to next literal on stack
+ EXX ; switch back to main set
+
+ EX (SP),HL ; pointer to HL, destination to stack.
+
+<font color=#FF3333>;;; PUSH BC ; save BC - value 5 from test room. No need.</font>
+
+ LD A,(HL) ; fetch the byte following 'stk-data'
+ AND $C0 ; isolate bits 7 and 6
+ RLCA ; rotate
+ RLCA ; to bits 1 and 0 range $00 - $03.
+ LD C,A ; transfer to C
+ INC C ; and increment to give number of bytes
+ ; to read. $01 - $04
+ LD A,(HL) ; reload the first byte
+ AND $3F ; mask off to give possible exponent.
+ JR NZ,<A href="#FORM_EXP">FORM_EXP</a> ; forward to FORM-EXP if it was possible to
+ ; include the exponent.
+
+; else byte is just a byte count and exponent comes next.
+
+ INC HL ; address next byte and
+ LD A,(HL) ; pick up the exponent ( - $50).
+
+<a name="FORM_EXP"></a><b>FORM_EXP</b> 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
+<font color=#FF3333>;;; LD B,$00 ; prepare to copy. <font color=#9900FF>Note.</font> B is zero.</font>
+ LDIR ; copy C bytes
+
+<font color=#FF3333>;;; POP BC ; restore 5 counter to BC.</font>
+
+ EX (SP),HL ; put HL on stack as next literal pointer
+ ; and the stack value - result pointer -
+ ; to HL.
+
+ EXX ; switch to alternate set.
+ POP HL ; restore next literal pointer from stack
+ ; to H'L'.
+ EXX ; switch back to main set.
+
+ LD B,A ; zero count to B
+ XOR A ; clear accumulator
+
+<a name="STK_ZEROS"></a><b>STK_ZEROS</b> DEC B ; decrement B counter
+ RET Z ; return if zero. >>
+ ; DE points to new STKEND
+ ; HL to new number.
+
+ LD (DE),A ; else load zero to destination
+ INC DE ; increase destination
+ JR <A href="#STK_ZEROS">STK_ZEROS</a> ; loop back to STK-ZEROS until done.
+
+; -------------------------------
+; THE <b><font color=#333388>'SKIP CONSTANTS'</font></b> SUBROUTINE
+; -------------------------------
+; This routine traversed 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.
+; Since the table now uses uncompressed values, some extra ROM space is
+; required for the table but much more is released by getting rid of routines
+; like this.
+
+<font color=#FF3333>;;; L1A2D: AND A ; test if initially zero.</font>
+<font color=#FF3333>;;; L1A2E: RET Z ; return if zero. >></font>
+<font color=#FF3333>;;; PUSH AF ; save count.</font>
+<font color=#FF3333>;;; PUSH DE ; and normal STKEND</font>
+<font color=#FF3333>;;; LD DE,$0000 ; dummy value for STKEND at start of ROM</font>
+<font color=#FF3333>;;; CALL STK_CONST ; routine STK-CONST works through variable</font>
+<font color=#FF3333>;;; ; length records.</font>
+<font color=#FF3333>;;; POP DE ; restore real STKEND</font>
+<font color=#FF3333>;;; POP AF ; restore count</font>
+<font color=#FF3333>;;; DEC A ; decrease</font>
+<font color=#FF3333>;;; JR L1A2E ; loop back to SKIP-NEXT</font>
+
+; --------------------------------
+; THE <b><font color=#333388>'MEMORY LOCATION'</font></b> SUBROUTINE
+; --------------------------------
+; This routine, when supplied with a base address in HL and an index in A,
+; will calculate the address of the A'th entry, where each entry occupies
+; five bytes. It is used for addressing floating-point numbers in the
+; calculator's memory area.
+
+<a name="LOC_MEM"></a><b>LOC_MEM</b> LD C,A ; store the original number $00-$1F.
+ RLCA ; double.
+ RLCA ; quadruple.
+ ADD A,C ; now add original value to multiply by five.
+
+ LD C,A ; place the result in C.
+ LD B,$00 ; set B to 0.
+ ADD HL,BC ; add to form address of start of number in HL.
+
+ RET ; return.
+
+; -------------------------------------
+; THE <b><font color=#333388>'GET FROM MEMORY AREA'</font></b> SUBROUTINE
+; -------------------------------------
+; offsets $E0 to $FF: 'get-mem-0', 'get-mem-1' etc.
+; A holds $00-$1F offset.
+; The calculator stack increases by 5 bytes.
+; <font color=#9900FF>Note.</font> first two instructions have been swapped to create a subroutine.
+
+<a name="get_mem_x"></a><b>get_mem_x</b> LD HL,($401F) ; MEM is base address of the memory cells.
+
+<a name="INDEX_5"></a><b>INDEX_5</b> PUSH DE ; save STKEND
+
+ CALL <A href="#LOC_MEM">LOC_MEM</a> ; routine LOC-MEM so that HL = first byte
+ CALL <A href="#MOVE_FP">MOVE_FP</a> ; routine MOVE-FP moves 5 bytes with memory
+ ; check.
+ ; DE now points to new STKEND.
+ POP HL ; the original STKEND is now RESULT pointer.
+ RET ; return.
+
+; ---------------------------------
+; THE <b><font color=#333388>'STACK A CONSTANT'</font></b> SUBROUTINE
+; ---------------------------------
+; <font color=#339933>(offset $A0: 'stk-zero')</font>
+; <font color=#339933>(offset $A1: 'stk-one')</font>
+; <font color=#339933>(offset $A2: 'stk-half')</font>
+; <font color=#339933>(offset $A3: 'stk-pi/2')</font>
+; <font color=#339933>(offset $A4: 'stk-ten')</font>
+; 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 wasn't very efficient and it is better to hold the
+; numbers in full, five byte form and stack them in a similar manner
+; to that which which is used by the above routine.
+
+<a name="stk_con_x"></a><b>stk_con_x</b> LD HL,TAB_CNST ; Address: Table of constants.
+
+ JR <A href="#INDEX_5">INDEX_5</a> ; and join subsroutine above.
+
+; ---
+
+<font color=#FF3333>;;; LD H,D ; save STKEND - required for result</font>
+<font color=#FF3333>;;; LD L,E ;</font>
+<font color=#FF3333>;;; EXX ; swap</font>
+<font color=#FF3333>;;; PUSH HL ; save pointer to next literal</font>
+<font color=#FF3333>;;; LD HL,L1515 ; Address: stk-zero - start of table of</font>
+<font color=#FF3333>;;; ; constants</font>
+<font color=#FF3333>;;; EXX ;</font>
+<font color=#FF3333>;;; CALL SKIP_CONS ; routine SKIP-CONS</font>
+<font color=#FF3333>;;; CALL STK_CONST ; routine STK-CONST</font>
+<font color=#FF3333>;;; EXX ;</font>
+<font color=#FF3333>;;; POP HL ; restore pointer to next literal.</font>
+<font color=#FF3333>;;; EXX ;</font>
+<font color=#FF3333>;;; RET ; return.</font>
+
+; ---------------------------------------
+; THE <b><font color=#333388>'STORE IN A MEMORY AREA'</font></b> SUBROUTINE
+; ---------------------------------------
+; Offsets $C0 to $DF: 'st-mem-0', 'st-mem-1' etc.
+; Although 32 memory storage locations can be addressed, only six
+; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5)
+; required for these are allocated. ZX81 programmers who wish to
+; use the floating point routines from assembly language may wish to
+; alter the system variable MEM to point to 160 bytes of RAM to have
+; use the full range available.
+; A holds derived offset $00-$1F.
+; Unary so on entry HL points to last value, DE to STKEND.
+
+<a name="sto_mem_x"></a><b>sto_mem_x</b> PUSH HL ; save the result pointer.
+ EX DE,HL ; transfer to DE.
+ LD HL,($401F) ; fetch MEM the base of memory area.
+ CALL <A href="#LOC_MEM">LOC_MEM</a> ; routine LOC-MEM sets HL to the destination.
+ EX DE,HL ; swap - HL is start, DE is destination.
+
+<font color=#FF3333>;;; CALL <A href="#MOVE_FP">MOVE_FP</a> ; routine MOVE-FP.</font>
+<font color=#FF3333>;;; ; <font color=#9900FF>Note.</font> a short ld bc,5; ldir</font>
+<font color=#FF3333>;;; ; the embedded memory check is not required</font>
+<font color=#FF3333>;;; ; so these instructions would be faster!</font>
+
+ <font color=#3333FF> LD C,$05 ;+ one extra byte but </font>
+ <font color=#3333FF> LDIR ;+ faster and no memory check.</font>
+
+ EX DE,HL ; DE = STKEND
+ POP HL ; restore original result pointer
+ RET ; return.
+
+; -------------------------
+; THE <b><font color=#333388>'EXCHANGE'</font></b> SUBROUTINE
+; -------------------------
+; offset $01: 'exchange'
+; This routine exchanges the last two values on the calculator stack
+; On entry, as always with binary operations,
+; HL=first number, DE=second number
+; On exit, HL=result, DE=stkend.
+
+<a name="exchange"></a><b>exchange</b> LD B,$05 ; there are five bytes to be swapped
+
+; start of loop.
+
+<a name="SWAP_BYTE"></a><b>SWAP_BYTE</b> LD A,(DE) ; each byte of second
+<font color=#FF3333>;;; LD C,(HL) ; each byte of first</font>
+<font color=#FF3333>;;; EX DE,HL ; swap pointers</font>
+ <font color=#3333FF> ld c,a ;+</font>
+ <font color=#3333FF> ld a,(hl) ;+</font>
+ LD (DE),A ; store each byte of first
+ LD (HL),C ; store each byte of second
+ INC HL ; advance both
+ INC DE ; pointers.
+ DJNZ <A href="#SWAP_BYTE">SWAP_BYTE</a> ; loop back to SWAP-BYTE until all 5 done.
+
+<font color=#FF3333>;;; EX DE,HL ; even up the exchanges (one byte saved)</font>
+
+ RET ; return.
+
+; ---------------------------------
+; THE <b><font color=#333388>'SERIES GENERATOR'</font></b> SUBROUTINE
+; ---------------------------------
+; offset $86: 'series-06'
+; offset $88: 'series-08'
+; offset $8C: 'series-0C'
+; The ZX81 uses Chebyshev polynomials to generate approximations for
+; SIN, ATN, LN and EXP. These are named after the Russian mathematician
+; Pafnuty Chebyshev, born in 1821, who did much pioneering work on numerical
+; series. As far as calculators are concerned, Chebyshev polynomials have an
+; advantage over other series, for example the Taylor series, as they can
+; reach an approximation in just six iterations for SIN, eight for EXP and
+; twelve for LN and ATN. The mechanics of the routine are interesting but
+; for full treatment of how these are generated with demonstrations in
+; Sinclair BASIC see "The Complete Spectrum ROM Disassembly" by Dr Ian Logan
+; and Dr Frank O'Hara, published 1983 by Melbourne House.
+
+<a name="seriesg_x"></a><b>seriesg_x</b> LD B,A ; parameter $00 - $1F to B counter
+ CALL <A href="#GEN_ENT_1">GEN_ENT_1</a> ; routine GEN-ENT-1 is called.
+ ; A recursive call to a special entry point
+ ; in the calculator that puts the B register
+ ; in the system variable BREG. The return
+ ; address is the next location and where
+ ; the calculator will expect its first
+ ; instruction - now pointed to by HL'.
+ ; The previous pointer to the series of
+ ; five-byte numbers goes on the machine stack.
+
+; The initialization phase.
+
+ DEFB $2D ;;duplicate x,x
+ DEFB $0F ;;addition x+x
+ DEFB $C0 ;;st-mem-0 x+x
+ DEFB $02 ;;delete .
+ DEFB $A0 ;;stk-zero 0
+ DEFB $C2 ;;st-mem-2 0
+
+; a loop is now entered to perform the algebraic calculation for each of
+; the numbers in the series
+
+<a name="G_LOOP"></a><b>G_LOOP</b> 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 stk_data ; routine STK-DATA is called directly to
+ ; push a value and advance H'L'.
+ CALL <A href="#GEN_ENT_2">GEN_ENT_2</a> ; routine GEN-ENT-2 recursively re-enters
+ ; the calculator without disturbing
+ ; system variable BREG
+ ; H'L' value goes on the machine stack and is
+ ; then loaded as usual with the next address.
+
+ DEFB $0F ;;addition
+ DEFB $01 ;;exchange
+ DEFB $C2 ;;st-mem-2
+ DEFB $02 ;;delete
+
+ DEFB $31 ;;dec-jr-nz
+ DEFB G_LOOP - $ ;;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.
+
+<a name="negate"></a><b>negate</b> LD A,(HL) ; fetch exponent of last value on the
+ ; calculator stack.
+ AND A ; test it.
+ RET Z ; return if zero.
+
+ INC HL ; address the byte with the sign bit.
+ LD A,(HL) ; fetch to accumulator.
+ XOR $80 ; toggle the sign bit.
+ LD (HL),A ; put it back.
+ DEC HL ; point to last value again.
+ RET ; return.
+
+; -----------------------
+; Absolute magnitude (27)
+; -----------------------
+; This calculator literal finds the absolute value of the last value,
+; floating point, on calculator stack.
+
+<a name="abs"></a><b>abs</b> 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 it is negative. If it is zero then it is left unchanged.
+
+<a name="sgn"></a><b>sgn</b> INC HL ; point to first byte of 4-byte mantissa.
+ LD A,(HL) ; pick up the byte with the sign bit.
+ DEC HL ; point to exponent.
+ DEC (HL) ; test the exponent for
+ INC (HL) ; the value zero.
+
+ SCF ; Set the carry flag.
+ CALL NZ,<A href="#FP_0_1">FP_0_1</a> ; Routine FP-0/1 replaces last value with one
+ ; if exponent indicates the value is non-zero.
+ ; In either case mantissa is now four zeros.
+
+ INC HL ; Point to first byte of 4-byte mantissa.
+ RLCA ; Rotate original sign bit to carry.
+ RR (HL) ; Rotate the carry into sign.
+ DEC HL ; Point to last value.
+ RET ; Return.
+
+
+; -------------------------
+; Handle PEEK function (28)
+; -------------------------
+; This function returns the contents of a memory address.
+; The entire address space can be peeked including the ROM.
+
+<a name="peek"></a><b>peek</b> CALL <A href="#FIND_INT">FIND_INT</a> ; routine FIND-INT puts address in BC.
+ LD A,(BC) ; load contents into A register.
+
+<a name="IN_PK_STK"></a><b>IN_PK_STK</b> JP <A href="#STACK_A">STACK_A</a> ; exit via STACK-A to put value on the
+ ; calculator stack.
+
+; ---------------
+; USR number (29)
+; ---------------
+; The USR function followed by a number 0-65535 is the method by which
+; the ZX81 invokes machine code programs. This function returns the
+; contents of the BC register pair.
+; <font color=#9900FF>Note.</font> that STACK-BC re-initializes the IY register to $4000 if a user-written
+; program has altered it.
+
+<a name="usr_no"></a><b>usr_no</b> CALL <A href="#FIND_INT">FIND_INT</a> ; routine FIND-INT to fetch the
+ ; supplied address into BC.
+
+ LD HL,STACK_BC ; 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 user's routine
+ ; and, hopefully, to STACK-BC also.
+
+
+; -----------------------
+; Greater than zero ($33)
+; -----------------------
+; Test if the last value on the calculator stack is greater than zero.
+; This routine is also called directly from the end-tests of the comparison
+; routine.
+
+<a name="greater_0"></a><b>greater_0</b> LD A,(HL) ; fetch exponent.
+ AND A ; test it for zero.
+ RET Z ; return if so.
+
+
+ LD A,$FF ; prepare XOR mask for sign bit
+ JR <A href="#SIGN_TO_C">SIGN_TO_C</a> ; forward to SIGN-TO-C
+ ; to put sign in carry
+ ; (carry will become set if sign is positive)
+ ; and then overwrite location with 1 or 0
+ ; as appropriate.
+
+; ------------------------
+; Handle NOT operator ($2C)
+; ------------------------
+; This overwrites the last value with 1 if it was zero else with zero
+; if it was any other value.
+;
+; e.g. NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0.
+;
+; The subroutine is also called directly from the end-tests of the comparison
+; operator.
+
+<a name="not"></a><b>not</b> LD A,(HL) ; get exponent byte.
+ NEG ; negate - sets carry if non-zero.
+ CCF ; complement so carry set if zero, else reset.
+ JR <A href="#FP_0_1">FP_0_1</a> ; forward to FP-0/1.
+
+; -------------------
+; Less than zero (32)
+; -------------------
+; Destructively test if last value on calculator stack is less than zero.
+; Bit 7 of second byte will be set if so.
+
+<a name="less_0"></a><b>less_0</b> XOR A ; set xor mask to zero
+ ; (carry will become set if sign is negative).
+
+; transfer sign of mantissa to Carry Flag.
+
+<a name="SIGN_TO_C"></a><b>SIGN_TO_C</b> INC HL ; address 2nd byte.
+ XOR (HL) ; bit 7 of HL will be set if number is negative.
+ DEC HL ; address 1st byte again.
+ RLCA ; rotate bit 7 of A to carry.
+
+; -----------
+; Zero or one
+; -----------
+; This routine places an integer value zero or one at the addressed location
+; of calculator stack or MEM area. The value one is written if carry is set on
+; entry else zero.
+
+<a name="FP_0_1"></a><b>FP_0_1</b> PUSH HL ; save pointer to the first byte
+ LD B,$05 ; five bytes to do.
+
+<a name="FP_loop"></a><b>FP_loop</b> LD (HL),$00 ; insert a zero.
+ INC HL ;
+ DJNZ <A href="#FP_loop">FP_loop</a> ; repeat.
+
+ POP HL ;
+ RET NC ;
+
+ LD (HL),$81 ; make value 1
+ RET ; return.
+
+
+; -----------------------
+; Handle OR operator (07)
+; -----------------------
+; The Boolean OR operator. eg. X OR Y
+; The result is zero if both values are zero else a non-zero value.
+;
+; e.g. 0 OR 0 returns 0.
+; -3 OR 0 returns -3.
+; 0 OR -3 returns 1.
+; -3 OR 2 returns 1.
+;
+; A binary operation.
+; On entry HL points to first operand (X) and DE to second operand (Y).
+
+<a name="or"></a><b>or</b> LD A,(DE) ; fetch exponent of second number
+ AND A ; test it.
+ RET Z ; return if zero.
+
+ SCF ; set carry flag
+ JR <A href="#FP_0_1">FP_0_1</a> ; back to FP-0/1 to overwrite the first operand
+ ; with the value 1.
+
+
+; -----------------------------
+; Handle number AND number (08)
+; -----------------------------
+; The Boolean AND operator.
+;
+; e.g. -3 AND 2 returns -3.
+; -3 AND 0 returns 0.
+; 0 and -2 returns 0.
+; 0 and 0 returns 0.
+;
+; Compare with OR routine above.
+
+<a name="no_v_no"></a><b>no_v_no</b> LD A,(DE) ; fetch exponent of second number.
+ AND A ; test it.
+ RET NZ ; return if not zero.
+
+ JR <A href="#FP_0_1">FP_0_1</a> ; back to FP-0/1 to overwrite the first operand
+ ; with zero for return value.
+
+; -----------------------------
+; Handle string AND number (10)
+; -----------------------------
+; e.g. "YOU WIN" AND SCORE>99 will return the string if condition is true
+; or the null string if false.
+
+<a name="str_v_no"></a><b>str_v_no</b> LD A,(DE) ; fetch exponent of second number.
+ AND A ; test it.
+ RET NZ ; return if number was not zero - the string
+ ; is the result.
+
+; if the number was zero (false) then the null string must be returned by
+; altering the length of the string on the calculator stack to zero.
+
+ PUSH DE ; save pointer to the now obsolete number
+ ; (which will become the new STKEND)
+
+ DEC DE ; point to the 5th byte of string descriptor.
+ XOR A ; clear the accumulator.
+ LD (DE),A ; place zero in high byte of length.
+ DEC DE ; address low byte of length.
+ LD (DE),A ; place zero there - now the null string.
+
+ POP DE ; restore pointer - new STKEND.
+ RET ; return.
+
+; -------------------------------------
+; Perform comparison ($09-$0E, $11-$16)
+; -------------------------------------
+; True binary operations.
+;
+; A single entry point is used to evaluate six numeric and six string
+; comparisons. On entry, the calculator literal is in the B register and
+; the two numeric values, or the two string parameters, are on the
+; calculator stack.
+; The individual bits of the literal are manipulated to group similar
+; operations although the SUB 8 instruction does nothing useful and merely
+; alters the string test bit.
+; Numbers are compared by subtracting one from the other, strings are
+; compared by comparing every character until a mismatch, or the end of one
+; or both, is reached.
+;
+; Numeric Comparisons.
+; --------------------
+; The <b><font color=#333388>'x>y'</font></b> example is the easiest as it employs straight-thru logic.
+; Number y is subtracted from x and the result tested for greater-0 yielding
+; a final value 1 (true) or 0 (false).
+; For 'x<y' the same logic is used but the two values are first swapped on the
+; calculator stack.
+; For 'x=y' NOT is applied to the subtraction result yielding true if the
+; difference was zero and false with anything else.
+; The first three numeric comparisons are just the opposite of the last three
+; so the same processing steps are used and then a final NOT is applied.
+;
+; literal Test No sub 8 ExOrNot 1st RRCA exch sub ? End-Tests
+; ========= ==== == ======== === ======== ======== ==== === = === === ===
+; no-l-eql x<=y 09 00000001 dec 00000000 00000000 ---- x-y ? --- >0? NOT
+; no-gr-eql x>=y 0A 00000010 dec 00000001 10000000c swap y-x ? --- >0? NOT
+; nos-neql x<>y 0B 00000011 dec 00000010 00000001 ---- x-y ? NOT --- NOT
+; no-grtr x>y 0C 00000100 - 00000100 00000010 ---- x-y ? --- >0? ---
+; no-less x<y 0D 00000101 - 00000101 10000010c swap y-x ? --- >0? ---
+; nos-eql x=y 0E 00000110 - 00000110 00000011 ---- x-y ? NOT --- ---
+;
+; comp -> C/F
+; ==== ===
+; str-l-eql x$<=y$ 11 00001001 dec 00001000 00000100 ---- x$y$ 0 !or >0? NOT
+; str-gr-eql x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0 !or >0? NOT
+; strs-neql x$<>y$ 13 00001011 dec 00001010 00000101 ---- x$y$ 0 !or >0? NOT
+; str-grtr x$>y$ 14 00001100 - 00001100 00000110 ---- x$y$ 0 !or >0? ---
+; str-less x$<y$ 15 00001101 - 00001101 10000110c swap y$x$ 0 !or >0? ---
+; strs-eql x$=y$ 16 00001110 - 00001110 00000111 ---- x$y$ 0 !or >0? ---
+;
+; String comparisons are a little different in that the eql/neql carry flag
+; from the 2nd RRCA is, as before, fed into the first of the end tests but
+; along the way it gets modified by the comparison process. The result on the
+; stack always starts off as zero and the carry fed in determines if NOT is
+; applied to it. So the only time the greater-0 test is applied is if the
+; stack holds zero which is not very efficient as the test will always yield
+; zero. The most likely explanation is that there were once separate end tests
+; for numbers and strings.
+
+<a name="no_l_eql"></a><b>no_l_eql</b> LD A,B ; transfer literal to accumulator.
+
+<font color=#FF3333>;;; SUB $08 ; subtract eight - which is not useful.</font>
+
+ BIT 2,A ; isolate '>', '<', '='.
+
+ JR NZ,<A href="#EX_OR_NOT">EX_OR_NOT</a> ; skip to EX-OR-NOT with these.
+
+ DEC A ; else make $00-$02, $08-$0A to match bits 0-2.
+
+<a name="EX_OR_NOT"></a><b>EX_OR_NOT</b> RRCA ; the first RRCA sets carry for a swap.
+ JR NC,<A href="#NU_OR_STR">NU_OR_STR</a> ; forward to NU-OR-STR with other 8 cases
+
+; for the other 4 cases the two values on the calculator stack are exchanged.
+
+ PUSH AF ; save A and carry.
+ PUSH HL ; save HL - pointer to first operand.
+ ; (DE points to second operand).
+
+ CALL exchange ; routine exchange swaps the two values.
+ ; (HL = second operand, DE = STKEND)
+
+ POP DE ; DE = first operand
+ EX DE,HL ; as we were.
+ POP AF ; restore A and carry.
+
+; <font color=#9900FF>Note.</font> it would be better if the 2nd RRCA preceded the string test.
+; It would save two duplicate bytes and if we also got rid of that sub 8
+; at the beginning we wouldn't have to alter which bit we test.
+
+<a name="NU_OR_STR"></a><b>NU_OR_STR</b> <font color=#3333FF>RRCA ;+ causes 'eql/neql' to set carry.</font>
+ <font color=#3333FF> PUSH AF ;+ save the carry flag.</font>
+ BIT 2,A ; test if a string comparison.
+ JR NZ,<A href="#STRINGS">STRINGS</a> ; forward to STRINGS if so.
+
+; continue with numeric comparisons.
+
+<font color=#FF3333>;;; RRCA ; 2nd RRCA causes eql/neql to set carry.</font>
+<font color=#FF3333>;;; PUSH AF ; save A and carry</font>
+
+ CALL subtract ; routine subtract leaves result on stack.
+ JR <A href="#END_TESTS">END_TESTS</a> ; forward to END-TESTS
+
+; ---
+
+<a name="STRINGS"></a><b>STRINGS</b>
+<font color=#FF3333>;;; RRCA ; 2nd RRCA causes eql/neql to set carry.</font>
+<font color=#FF3333>;;; PUSH AF ; save A and carry.</font>
+
+ CALL <A href="#STK_FETCH">STK_FETCH</a> ; routine STK-FETCH gets 2nd string params
+ PUSH DE ; save start2 *.
+ PUSH BC ; and the length.
+
+ CALL <A href="#STK_FETCH">STK_FETCH</a> ; routine STK-FETCH gets 1st string
+ ; parameters - start in DE, length in BC.
+ POP HL ; restore length of second to HL.
+
+; A loop is now entered to compare, by subtraction, each corresponding character
+; of the strings. For each successful match, the pointers are incremented and
+; the lengths decreased and the branch taken back to here. If both string
+; remainders become null at the same time, then an exact match exists.
+
+<a name="BYTE_COMP"></a><b>BYTE_COMP</b> LD A,H ; test if the second string
+ OR L ; is the null string and hold flags.
+
+ EX (SP),HL ; put length2 on stack, bring start2 to HL *.
+ LD A,B ; hi byte of length1 to A
+
+ JR NZ,<A href="#SEC_PLUS">SEC_PLUS</a> ; forward to SEC-PLUS if second not null.
+
+ OR C ; test length of first string.
+
+<a name="SECND_LOW"></a><b>SECND_LOW</b> POP BC ; pop the second length off stack.
+ JR Z,<A href="#BOTH_NULL">BOTH_NULL</a> ; forward to BOTH-NULL if first string is also
+ ; of zero length.
+
+; the true condition - first is longer than second (SECND-LESS)
+
+ POP AF ; restore carry (set if eql/neql)
+ CCF ; complement carry flag.
+ ; <font color=#9900FF>Note.</font> equality becomes false.
+ ; Inequality is true. By swapping or applying
+ ; a terminal 'not', all comparisons have been
+ ; manipulated so that this is success path.
+ JR <A href="#STR_TEST">STR_TEST</a> ; forward to leave via STR-TEST
+
+; ---
+; the branch was here with a match
+
+<a name="BOTH_NULL"></a><b>BOTH_NULL</b> POP AF ; restore carry - set for eql/neql
+ JR <A href="#STR_TEST">STR_TEST</a> ; forward to STR-TEST
+
+; ---
+; the branch was here when 2nd string not null and low byte of first is yet
+; to be tested.
+
+
+<a name="SEC_PLUS"></a><b>SEC_PLUS</b> OR C ; test the length of first string.
+ JR Z,<A href="#FRST_LESS">FRST_LESS</a> ; forward to FRST-LESS if length is zero.
+
+; both strings have at least one character left.
+
+ LD A,(DE) ; fetch character of first string.
+ SUB (HL) ; subtract with that of 2nd string.
+ JR C,<A href="#FRST_LESS">FRST_LESS</a> ; forward to FRST-LESS if carry set
+
+ JR NZ,<A href="#SECND_LOW">SECND_LOW</a> ; back to SECND-LOW and then STR-TEST
+ ; if not exact match.
+
+ DEC BC ; decrease length of 1st string.
+ INC DE ; increment 1st string pointer.
+
+ INC HL ; increment 2nd string pointer.
+ EX (SP),HL ; swap with length on stack
+ DEC HL ; decrement 2nd string length
+ JR <A href="#BYTE_COMP">BYTE_COMP</a> ; back to BYTE-COMP
+
+; ---
+; the false condition.
+
+<a name="FRST_LESS"></a><b>FRST_LESS</b> POP BC ; discard length
+ POP AF ; pop A
+ AND A ; clear the carry for false result.
+
+; ---
+; exact match and x$>y$ rejoin here
+
+<a name="STR_TEST"></a><b>STR_TEST</b> PUSH AF ; save A and carry
+
+ RST 28H ;; FP-CALC
+ DEFB $A0 ;;stk-zero an initial false value.
+ DEFB $34 ;;end-calc
+
+; both numeric and string paths converge here.
+
+<a name="END_TESTS"></a><b>END_TESTS</b> POP AF ; pop carry - will be set if eql/neql
+ PUSH AF ; save it again.
+
+ CALL C,not ; routine NOT sets true(1) if equal(0)
+ ; or, for strings, applies true result.
+ CALL greater_0 ; greater-0
+
+
+ POP AF ; pop A
+ RRCA ; the third RRCA - test for '<=', '>=' or '<>'.
+ CALL NC,not ; apply a terminal NOT if so.
+ RET ; return.
+
+; -----------------------------------
+; THE <b><font color=#333388>'STRING CONCATENATION'</font></b> OPERATOR
+; -----------------------------------
+; <font color=#339933>(offset $17: 'strs_add')</font>
+; This literal combines two strings into one e.g. LET A$ = B$ + C$
+; The two parameters of the two strings to be combined are on the stack.
+
+<a name="strs_add"></a><b>strs_add</b>
+ CALL <A href="#STK_FETCH">STK_FETCH</a> ; routine STK-FETCH fetches string parameters
+ ; and deletes calculator stack entry.
+ PUSH DE ; save start address.
+ PUSH BC ; and length.
+
+ CALL <A href="#STK_FETCH">STK_FETCH</a> ; routine STK-FETCH for first string
+ POP HL ; re-fetch first length
+ PUSH HL ; and save again
+ PUSH DE ; save start of second string
+ PUSH BC ; and its length.
+
+ ADD HL,BC ; add the two lengths.
+ LD B,H ; transfer to BC
+ LD C,L ; and create
+ RST 30H ; BC-SPACES in workspace.
+ ; DE points to start of space.
+
+ CALL <A href="#STK_STO_s">STK_STO_s</a> ; routine STK-STO-$ stores parameters
+ ; of new string updating STKEND.
+
+ POP BC ; length of first
+ POP HL ; address of start
+
+<font color=#FF3333>;;; LD A,B ; test for</font>
+<font color=#FF3333>;;; OR C ; zero length.</font>
+<font color=#FF3333>;;; JR Z,OTHER_STR ; to OTHER-STR if null string</font>
+<font color=#FF3333>;;; LDIR ; copy string to workspace.</font>
+
+ <font color=#3333FF> CALL <A href="#COND_MV">COND_MV</a> ;+ a conditional (NZ) ldir routine. </font>
+
+<a name="OTHER_STR"></a><b>OTHER_STR</b> POP BC ; now second length
+ POP HL ; and start of string
+
+<font color=#FF3333>;;; LD A,B ; test this one</font>
+<font color=#FF3333>;;; OR C ; for zero length</font>
+<font color=#FF3333>;;; JR Z,<A href="#STK_PNTRS">STK_PNTRS</a> ; skip forward to STK-PNTRS if so as complete.</font>
+<font color=#FF3333>;;; LDIR ; else copy the bytes.</font>
+
+ <font color=#3333FF> CALL <A href="#COND_MV">COND_MV</a> ;+ a conditional (NZ) ldir routine. </font>
+
+; Continue into next routine which sets the calculator stack pointers.
+
+; ----------------------------
+; THE <b><font color=#333388>'STACK POINTERS'</font></b> ROUTINE
+; ----------------------------
+; Register DE is set to STKEND and HL, the result pointer, is set to five
+; locations below this - the 'last value'.
+; This routine is used when it is inconvenient to save these values at the
+; time the calculator stack is manipulated due to other activity on the
+; machine stack.
+; This routine is also used to terminate the VAL routine for
+; the same reason and to initialize the calculator stack at the start of
+; the CALCULATE routine.
+
+<a name="STK_PNTRS"></a><b>STK_PNTRS</b> 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.
+
+; -------------------
+; THE <b><font color=#333388>'CHR$'</font></b> FUNCTION
+; -------------------
+; <font color=#339933>(offset $2B: 'chr$')</font>
+; This function returns a single character string that is a result of
+; converting a number in the range 0-255 to a string e.g. CHR$ 38 = "A".
+; <font color=#9900FF>Note.</font> the ZX81 does not have an ASCII character set.
+
+<a name="chrS"></a><b>chrS</b> CALL <A href="#FP_TO_A">FP_TO_A</a> ; routine FP-TO-A puts the number in A.
+
+ JR C,<A href="#REPORT_Bd">REPORT_Bd</a> ; forward to REPORT-Bd if overflow
+ JR NZ,<A href="#REPORT_Bd">REPORT_Bd</a> ; forward to REPORT-Bd if negative
+
+<font color=#FF3333>;;; PUSH AF ; save the argument.</font>
+
+ LD BC,$0001 ; one space required.
+ RST 30H ; BC-SPACES makes DE point to start
+
+<font color=#FF3333>;;; POP AF ; restore the number.</font>
+
+ LD (DE),A ; and store in workspace
+
+ <font color=#3333FF> JR str_STK ;+ relative jump to similar sequence in str$.</font>
+
+<font color=#FF3333>;;; CALL <A href="#STK_STO_s">STK_STO_s</a> ; routine STK-STO-$ stacks descriptor.</font>
+<font color=#FF3333>;;; EX DE,HL ; make HL point to result and DE to STKEND.</font>
+<font color=#FF3333>;;; RET ; return.</font>
+
+; ---
+
+<a name="REPORT_Bd"></a><b>REPORT_Bd</b> RST 08H ; ERROR-1
+ DEFB $0A ; Error Report: Integer out of range
+
+; ------------------
+; THE <b><font color=#333388>'VAL'</font></b> FUNCTION
+; ------------------
+; <font color=#339933>(offset $1A: 'val')</font>
+; VAL treats the characters in a string as a numeric expression.
+; e.g. VAL "2.3" = 2.3, VAL "2+4" = 6, VAL ("2" + "4") = 24.
+
+<a name="val"></a><b>val</b> <font color=#3333FF> RST 18H ;+ shorter way to fetch CH_ADD.</font>
+
+<font color=#FF3333>;;; LD HL,($4016) ; fetch value of system variable CH_ADD</font>
+ PUSH HL ; and save on the machine stack.
+
+ CALL <A href="#STK_FETCH">STK_FETCH</a> ; routine STK-FETCH fetches the string operand
+ ; from calculator stack.
+
+ PUSH DE ; save the address of the start of the string.
+ INC BC ; increment the length for a carriage return.
+
+ RST 30H ; BC-SPACES creates the space in workspace.
+ POP HL ; restore start of string to HL.
+ LD ($4016),DE ; load CH_ADD with start DE in workspace.
+
+ PUSH DE ; save the start in workspace
+ LDIR ; copy string from program or variables or
+ ; workspace to the workspace area.
+ EX DE,HL ; end of string + 1 to HL
+ DEC HL ; decrement HL to point to end of new area.
+ LD (HL),$76 ; insert a carriage return at end.
+ ; ZX81 has a non-ASCII character set
+ RES 7,(IY+$01) ; update FLAGS - signal checking syntax.
+ CALL <A href="#CLASS_06">CLASS_06</a> ; routine CLASS-06 - SCANNING evaluates string
+ ; expression and checks for integer result.
+
+ CALL <A href="#CHECK_2">CHECK_2</a> ; routine CHECK-2 checks for carriage return.
+
+
+ POP HL ; restore start of string in workspace.
+
+ LD ($4016),HL ; set CH_ADD to the start of the string again.
+ SET 7,(IY+$01) ; update FLAGS - signal running program.
+ CALL <A href="#SCANNING">SCANNING</a> ; routine SCANNING evaluates the string
+ ; in full leaving result on calculator stack.
+
+ POP HL ; restore saved character address in program.
+ LD ($4016),HL ; and reset the system variable CH_ADD.
+
+ JR <A href="#STK_PNTRS">STK_PNTRS</a> ; back to exit via STK-PNTRS.
+ ; resetting the calculator stack pointers
+ ; HL and DE from STKEND as it wasn't possible
+ ; to preserve them during this routine.
+
+; -------------------
+; THE <b><font color=#333388>'STR$'</font></b> FUNCTION
+; -------------------
+; <font color=#339933>(offset $2A: 'str$')</font>
+; This function returns a string representation of a numeric argument.
+; The method used is to trick the PRINT-FP routine into thinking it
+; is writing to a collapsed display file when in fact it is writing to
+; string workspace.
+; If there is already a newline at the intended print position and the
+; column count has not been reduced to zero then the print routine
+; assumes that there is only 1K of RAM and the screen memory, like the rest
+; of dynamic memory, expands as necessary using calls to the ONE-SPACE
+; routine. The screen is character-mapped not bit-mapped.
+
+<a name="strS"></a><b>strS</b> LD BC,$0001 ; create an initial byte in workspace
+ RST 30H ; using BC-SPACES restart.
+
+ LD (HL),$76 ; place a carriage return there.
+
+ LD HL,($4039) ; fetch value of S_POSN column/line
+ PUSH HL ; and preserve on stack.
+
+ LD L,$FF ; make column value high to create a
+ ; contrived buffer of length 254.
+ LD ($4039),HL ; and store in system variable S_POSN.
+
+ LD HL,($400E) ; fetch value of DF_CC
+ PUSH HL ; and preserve on stack also.
+
+ LD ($400E),DE ; now set DF_CC which normally addresses
+ ; somewhere in the display file to the start
+ ; of workspace.
+ PUSH DE ; save the start of new string.
+
+ CALL <A href="#PRINT_FP">PRINT_FP</a> ; routine PRINT-FP.
+
+ POP DE ; retrieve start of string.
+
+ LD HL,($400E) ; fetch end of string from DF_CC.
+ AND A ; prepare for true subtraction.
+ SBC HL,DE ; subtract to give length.
+
+ LD B,H ; and transfer to the BC
+ LD C,L ; register.
+
+ POP HL ; restore original
+ LD ($400E),HL ; DF_CC value
+
+ POP HL ; restore original
+ LD ($4039),HL ; S_POSN values.
+
+; New entry-point to exploit similarities and save 3 bytes of code.
+
+<a name="str_STK"></a><b>str_STK</b> CALL STK_STO_s ; routine STK-STO-$ stores the string
+ ; descriptor on the calculator stack.
+
+ EX DE,HL ; HL = last value, DE = STKEND.
+ RET ; return.
+
+
+; -------------------
+; THE <b><font color=#333388>'CODE'</font></b> FUNCTION
+; -------------------
+; <font color=#339933>(offset $19: 'code')</font>
+; Returns the code of a character or first character of a string
+; e.g. CODE "AARDVARK" = 38 (not 65 as the ZX81 does not have an ASCII
+; character set).
+
+
+<a name="code"></a><b>code</b> CALL <A href="#STK_FETCH">STK_FETCH</a> ; routine STK-FETCH to fetch and delete the
+ ; string parameters.
+ ; DE points to the start, BC holds the length.
+ LD A,B ; test length
+ OR C ; of the string.
+ JR Z,<A href="#STK_CODE">STK_CODE</a> ; skip to STK-CODE with zero if the null string.
+
+ LD A,(DE) ; else fetch the first character.
+
+<a name="STK_CODE"></a><b>STK_CODE</b> JP <A href="#STACK_A">STACK_A</a> ; jump back to STACK-A (with memory check)
+
+; --------------------
+; THE <b><font color=#333388>'LEN'</font></b> SUBROUTINE
+; --------------------
+; <font color=#339933>(offset $1b: 'len')</font>
+; Returns the length of a string.
+; In Sinclair BASIC strings can be more than twenty thousand characters long
+; so a sixteen-bit register is required to store the length
+
+<a name="len"></a><b>len</b> CALL <A href="#STK_FETCH">STK_FETCH</a> ; routine STK-FETCH to fetch and delete the
+ ; string parameters from the calculator stack.
+ ; register BC now holds the length of string.
+
+ JP <A href="#STACK_BC">STACK_BC</a> ; jump back to STACK-BC to save result on the
+ ; calculator stack (with memory check).
+
+; -------------------------------------
+; THE <b><font color=#333388>'DECREASE THE COUNTER'</font></b> SUBROUTINE
+; -------------------------------------
+; <font color=#339933>(offset $31: 'dec-jr-nz')</font>
+; The calculator has an instruction that decrements a single-byte
+; pseudo-register and makes consequential relative jumps just like
+; the Z80's DJNZ instruction.
+
+<a name="dec_jr_nz"></a><b>dec_jr_nz</b> EXX ; switch in set that addresses code
+
+ PUSH HL ; save pointer to offset byte
+ LD HL,$401E ; address BREG in system variables
+ DEC (HL) ; decrement it
+ POP HL ; restore pointer
+
+ JR NZ,<A href="#JUMP_2">JUMP_2</a> ; to JUMP-2 if not zero
+
+ INC HL ; step past the jump length.
+ EXX ; switch in the main set.
+ RET ; return.
+
+; <font color=#9900FF>Note.</font> as a general rule the calculator avoids using the IY register
+; otherwise the cumbersome 4 instructions in the middle could be replaced by
+; dec (iy+$xx) - using three instruction bytes instead of six.
+
+
+; ---------------------
+; THE <b><font color=#333388>'JUMP'</font></b> SUBROUTINE
+; ---------------------
+; <font color=#339933>(Offset $2F; 'jump')</font>
+; This enables the calculator to perform relative jumps just like
+; the Z80 chip's JR instruction.
+; This is one of the few routines that was polished for the ZX Spectrum.
+
+<a name="JUMP"></a><b>JUMP</b> EXX ;switch in pointer set
+
+<a name="JUMP_2"></a><b>JUMP_2</b> LD E,(HL) ; the jump byte 0-127 forward, 128-255 back.
+
+; <font color=#9900FF>Note.</font> Elegance from the ZX Spectrum.
+
+ <font color=#3333FF> LD A,E ;+</font>
+ <font color=#3333FF> RLA ;+</font>
+ <font color=#3333FF> SBC A,A ;+</font>
+
+; The original ZX81 code.
+
+<font color=#FF3333>;;; XOR A ; clear accumulator.</font>
+<font color=#FF3333>;;; BIT 7,E ; test if negative jump</font>
+<font color=#FF3333>;;; JR Z,<A href="#JUMP_3">JUMP_3</a> ; skip, if positive, to JUMP-3.</font>
+<font color=#FF3333>;;; CPL ; else change to $FF.</font>
+
+<a name="JUMP_3"></a><b>JUMP_3</b> LD D,A ; transfer to high byte.
+ ADD HL,DE ; advance calculator pointer forward or back.
+
+ EXX ; switch out pointer set.
+ RET ; return.
+
+; -----------------------------
+; THE <b><font color=#333388>'JUMP ON TRUE'</font></b> SUBROUTINE
+; -----------------------------
+; <font color=#339933>(Offset $00; 'jump-true')</font>
+; This enables the calculator to perform conditional relative jumps
+; dependent on whether the last test gave a true result
+; On the ZX81, the exponent will be zero for zero or else $81 for one.
+
+<a name="jump_true"></a><b>jump_true</b> LD A,(DE) ; collect exponent byte
+
+ AND A ; is result 0 or 1 ?
+ JR NZ,<A href="#JUMP">JUMP</a> ; back to JUMP if true (1).
+
+ EXX ; else switch in the pointer set.
+ INC HL ; step past the jump length.
+ EXX ; switch in the main set.
+ RET ; return.
+
+
+; ------------------------
+; THE <b><font color=#333388>'MODULUS'</font></b> SUBROUTINE
+; ------------------------
+; ( Offset $2E: 'n-mod-m' )
+; <font color=#CC00FF>( i1, i2 -- i3, i4 )</font>
+; The subroutine calculate N mod M where M is the positive integer, the
+; 'last value' on the calculator stack and N is the integer beneath.
+; The subroutine returns the integer quotient as the last value and the
+; remainder as the value beneath.
+; e.g. 17 MOD 3 = 5 remainder 2
+; It is invoked during the calculation of a random number and also by
+; the PRINT-FP routine.
+
+<a name="n_mod_m"></a><b>n_mod_m</b> RST 28H ;; FP-CALC 17, 3.
+ DEFB $C0 ;;st-mem-0 17, 3.
+ DEFB $02 ;;delete 17.
+ DEFB $2D ;;duplicate 17, 17.
+ DEFB $E0 ;;get-mem-0 17, 17, 3.
+ DEFB $05 ;;division 17, 17/3.
+ DEFB $24 ;;int 17, 5.
+ DEFB $E0 ;;get-mem-0 17, 5, 3.
+ DEFB $01 ;;exchange 17, 3, 5.
+ DEFB $C0 ;;st-mem-0 17, 3, 5.
+ DEFB $04 ;;multiply 17, 15.
+ DEFB $03 ;;subtract 2.
+ DEFB $E0 ;;get-mem-0 2, 5.
+ DEFB $34 ;;end-calc 2, 5.
+
+ RET ; return.
+
+
+; ----------------------
+; THE <b><font color=#333388>'INTEGER'</font></b> FUNCTION
+; ----------------------
+; <font color=#339933>(offset $24: 'int')</font>
+; This function returns the integer of x, which is just the same as truncate
+; for positive numbers. The truncate literal truncates negative numbers
+; upwards so that -3.4 gives -3 whereas the BASIC INT function has to
+; truncate negative numbers down so that INT -3.4 is 4.
+; It is best to work through using, say, plus and minus 3.4 as examples.
+
+<a name="int"></a><b>int</b> 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.
+
+
+<a name="X_NEG"></a><b>X_NEG</b> 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.
+
+<a name="EXIT"></a><b>EXIT</b> DEFB $34 ;;end-calc -4.
+
+ RET ; return.
+
+
+; --------------------------
+; THE <b><font color=#333388>'EXPONENTIAL'</font></b> FUNCTION
+; --------------------------
+; <font color=#339933>(Offset $23: 'exp')</font>
+; The exponential function returns the exponential of the argument, or the
+; value of 'e' (2.7182818...) raised to the power of the argument.
+; PRINT EXP 1 gives 2.7182818
+;
+; EXP is the opposite of the LN function (see below) and is equivalent to
+; the 'antiln' function found on pocket calculators or the 'Inverse ln'
+; function found on the Windows scientific calculator.
+; So PRINT EXP LN 5.3 will give 5.3 as will PRINT LN EXP 5.3 or indeed
+; any number e.g. PRINT EXP LN PI.
+;
+; The applications of the exponential function are in areas where exponential
+; growth is experienced, calculus, population growth and compound interest.
+;
+; Error 6 if the argument is above 88.
+
+<a name="exp"></a><b>exp</b> RST 28H ;; FP-CALC
+ DEFB $30 ;;stk-data 1/LN 2
+ DEFB $F1 ;;Exponent: $81, Bytes: 4
+ DEFB $38,$AA,$3B,$29 ;;
+ DEFB $04 ;;multiply
+ DEFB $2D ;;duplicate
+ DEFB $24 ;;int
+ DEFB $C3 ;;st-mem-3
+ DEFB $03 ;;subtract
+ DEFB $2D ;;duplicate
+ DEFB $0F ;;addition
+ DEFB $A1 ;;stk-one
+ DEFB $03 ;;subtract
+ DEFB $88 ;;series-08
+ DEFB $13 ;;Exponent: $63, Bytes: 1
+ DEFB $36 ;;(+00,+00,+00)
+ DEFB $58 ;;Exponent: $68, Bytes: 2
+ DEFB $65,$66 ;;(+00,+00)
+ DEFB $9D ;;Exponent: $6D, Bytes: 3
+ DEFB $78,$65,$40 ;;(+00)
+ DEFB $A2 ;;Exponent: $72, Bytes: 3
+ DEFB $60,$32,$C9 ;;(+00)
+ DEFB $E7 ;;Exponent: $77, Bytes: 4
+ DEFB $21,$F7,$AF,$24 ;;
+ DEFB $EB ;;Exponent: $7B, Bytes: 4
+ DEFB $2F,$B0,$B0,$14 ;;
+ DEFB $EE ;;Exponent: $7E, Bytes: 4
+ DEFB $7E,$BB,$94,$58 ;;
+ DEFB $F1 ;;Exponent: $81, Bytes: 4
+ DEFB $3A,$7E,$F8,$CF ;;
+ DEFB $E3 ;;get-mem-3
+ DEFB $34 ;;end-calc
+
+ CALL <A href="#FP_TO_A">FP_TO_A</a> ; routine FP-TO-A
+ JR NZ,<A href="#N_NEGTV">N_NEGTV</a> ; to N-NEGTV
+
+ JR C,<A href="#REPORT_6b">REPORT_6b</a> ; to REPORT-6b
+
+ ADD A,(HL) ;
+ JR NC,<A href="#RESULT_OK">RESULT_OK</a> ; to RESULT-OK
+
+
+<a name="REPORT_6b"></a><b>REPORT_6b</b> RST 08H ; ERROR-1
+ DEFB $05 ; Error Report: Number too big
+
+<a name="N_NEGTV"></a><b>N_NEGTV</b> JR C,<A href="#RSLT_ZERO">RSLT_ZERO</a> ; to RSLT-ZERO
+
+ SUB (HL) ;
+ JR NC,<A href="#RSLT_ZERO">RSLT_ZERO</a> ; to RSLT-ZERO
+
+ NEG ; Negate
+
+<a name="RESULT_OK"></a><b>RESULT_OK</b> LD (HL),A ;
+ RET ; return.
+
+
+<a name="RSLT_ZERO"></a><b>RSLT_ZERO</b> RST 28H ;; FP-CALC
+ DEFB $02 ;;delete
+ DEFB $A0 ;;stk-zero
+ DEFB $34 ;;end-calc
+
+ RET ; return.
+
+
+; --------------------------------
+; THE <b><font color=#333388>'NATURAL LOGARITHM'</font></b> FUNCTION
+; --------------------------------
+; <font color=#339933>(offset $22: 'ln')</font>
+; Like the ZX81 itself, 'natural' logarithms came from Scotland.
+; They were devised in 1614 by well-traveled Scotsman John Napier who noted
+; "Nothing doth more molest and hinder calculators than the multiplications,
+; divisions, square and cubical extractions of great numbers".
+; Napier's logarithms enabled the above operations to be accomplished by
+; simple addition and subtraction simplifying the navigational and
+; astronomical calculations which beset his age.
+; Napier's logarithms were quickly overtaken by logarithms to the base 10
+; devised, in conjunction with Napier, by Henry Briggs a Cambridge-educated
+; professor of Geometry at Oxford University. These simplified the layout
+; of the tables enabling humans to easily scale calculations.
+;
+; It is only recently with the introduction of pocket calculators and
+; computers like the ZX81 that natural logarithms are once more at the fore,
+; although some computers retain logarithms to the base ten.
+; 'Natural' logarithms are powers to the base 'e', which like 'pi' is a
+; naturally occurring number in branches of mathematics.
+; Like 'pi' also, 'e' is an irrational number and starts 2.718281828...
+;
+; The tabular use of logarithms was that to multiply two numbers one looked
+; up their two logarithms in the tables, added them together and then looked
+; for the result in a table of antilogarithms to give the desired product.
+;
+; The EXP function is the BASIC equivalent of a calculator's 'antiln' function
+; and by picking any two numbers, 1.72 and 6.89 say,
+; 10 PRINT EXP ( LN 1.72 + LN 6.89 )
+; will give just the same result as
+; 20 PRINT 1.72 * 6.89.
+; Division is accomplished by subtracting the two logs.
+;
+; Napier also mentioned "square and cubicle extractions".
+; To raise a number to the power 3, find its 'ln', multiply by 3 and find the
+; 'antiln'. e.g. PRINT EXP( LN 4 * 3 ) gives 64.
+; Similarly to find the n'th root divide the logarithm by 'n'.
+; The ZX81 ROM used PRINT EXP ( LN 9 / 2 ) to find the square root of the
+; number 9. The Napieran square root function is just a special case of
+; the 'to_power' function. A cube root or indeed any root/power would be just
+; as simple.
+
+; First test that the argument to LN is a positive, non-zero number.
+
+
+<a name="ln"></a><b>ln</b> RST 28H ;; FP-CALC x.
+ DEFB $2D ;;duplicate x,x.
+ DEFB $33 ;;greater-0 x,(0/1).
+ DEFB $00 ;;jump-true x.
+ DEFB $04 ;;to L1CB1, VALID
+
+ DEFB $34 ;;end-calc x.
+
+
+<a name="REPORT_Ab"></a><b>REPORT_Ab</b> RST 08H ; ERROR-1
+ DEFB $09 ; Error Report: Invalid argument
+
+<a name="VALID"></a><b>VALID</b>
+<font color=#FF3333>;;; DEFB $A0 ;;stk-zero </font>
+<font color=#FF3333>;;; DEFB $02 ;;delete</font>
+ DEFB $34 ;;end-calc x.
+
+; Register HL addresses the 'last value' x.
+
+ LD A,(HL) ; Fetch exponent to A.
+
+ LD (HL),$80 ; Insert 'plus zero' as exponent.
+ CALL <A href="#STACK_A">STACK_A</a> ; routine STACK-A stacks true binary exponent.
+
+ 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
+
+<a name="GRE_8"></a><b>GRE_8</b> DEFB $01 ;;exchange
+ DEFB $30 ;;stk-data LN 2
+ 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 NEW <b><font color=#333388>'SQUARE ROOT'</font></b> FUNCTION
+; ------------------------------
+; <font color=#339933>(Offset $25: 'sqr')</font>
+; "If I have seen further, it is by standing on the shoulders of giants" -
+; Sir Isaac Newton, Cambridge 1676.
+; The sqr function has been re-written to use the Newton-Raphson method.
+; Joseph Raphson was a student of Sir Isaac Newton at Cambridge University
+; and helped publicize his work.
+; Although Newton's method is centuries old, this routine, appropriately, is
+; based on a FORTH word written by Steven Vickers in the Jupiter Ace manual.
+; Whereas that method uses an initial guess of one, this one manipulates
+; the exponent byte to obtain a better starting guess.
+; First test for zero and return zero, if so, as the result.
+; If the argument is negative, then produce an error.
+
+<a name="sqr"></a><b>sqr</b> RST 28H ;; FP-CALC x
+ DEFB $C3 ;;st-mem-3 x. (seed for guess)
+ DEFB $34 ;;end-calc x.
+
+; HL now points to exponent of argument on calculator stack.
+
+ LD A,(HL) ; Test for zero argument
+ AND A ;
+
+ RET Z ; Return with zero on the calculator stack.
+
+; Test for a positive argument
+
+ INC HL ; Address byte with sign bit.
+ BIT 7,(HL) ; Test the bit.
+
+ JR NZ,<A href="#REPORT_Ab">REPORT_Ab</a> ; back to REPORT_A
+ ; 'Invalid argument'
+
+; This guess is based on a Usenet discussion.
+; Halve the exponent to achieve a good guess.(accurate with .25 16 64 etc.)
+
+ LD HL,$4071 ; Address first byte of mem-3
+
+ LD A,(HL) ; fetch exponent of mem-3
+ XOR $80 ; toggle sign of exponent of mem-3
+ SRA A ; shift right, bit 7 unchanged.
+ INC A ;
+ JR Z,<A href="#ASIS">ASIS</a> ; forward with say .25 -> .5
+ JP P,<A href="#ASIS">ASIS</a> ; leave increment if value > .5
+ DEC A ; restore to shift only.
+<a name="ASIS"></a><b>ASIS</b> XOR $80 ; restore sign.
+ LD (HL),A ; and put back 'halved' exponent.
+
+; Now re-enter the calculator.
+
+ RST 28H ;; FP-CALC x
+
+<a name="SLOOP"></a><b>SLOOP</b> DEFB $2D ;;duplicate x,x.
+ DEFB $E3 ;;get-mem-3 x,x,guess
+ DEFB $C4 ;;st-mem-4 x,x,guess
+ DEFB $05 ;;div x,x/guess.
+ DEFB $E3 ;;get-mem-3 x,x/guess,guess
+ DEFB $0F ;;addition x,x/guess+guess
+ DEFB $A2 ;;stk-half x,x/guess+guess,.5
+ DEFB $04 ;;multiply x,(x/guess+guess)*.5
+ DEFB $C3 ;;st-mem-3 x,newguess
+ DEFB $E4 ;;get-mem-4 x,newguess,oldguess
+ DEFB $03 ;;subtract x,newguess-oldguess
+ DEFB $27 ;;abs x,difference.
+ DEFB $33 ;;greater-0 x,(0/1).
+ DEFB $00 ;;jump-true x.
+
+ DEFB SLOOP - $ ;;to sloop x.
+
+ DEFB $02 ;;delete .
+ DEFB $E3 ;;get-mem-3 retrieve final guess.
+ DEFB $34 ;;end-calc sqr x.
+
+ RET ; return with square root on stack
+
+; or in ZX81 BASIC
+;
+; 5 PRINT "NEWTON RAPHSON SQUARE ROOTS"
+; 10 INPUT "NUMBER ";N
+; 20 INPUT "GUESS ";G
+; 30 PRINT " NUMBER "; N ;" GUESS "; G
+; 40 FOR I = 1 TO 10
+; 50 LET B = N/G
+; 60 LET C = B+G
+; 70 LET G = C/2
+; 80 PRINT I; " VALUE "; G
+; 90 NEXT I
+; 100 PRINT "NAPIER METHOD"; SQR N
+
+; -----------------------------
+; THE <b><font color=#333388>'TRIGONOMETRIC'</font></b> FUNCTIONS
+; -----------------------------
+; Trigonometry is rocket science. It is also used by carpenters and pyramid
+; builders.
+; Some uses can be quite abstract but the principles can be seen in simple
+; right-angled triangles. Triangles have some special properties -
+;
+; 1) The sum of the three angles is always PI radians (180 degrees).
+; Very helpful if you know two angles and wish to find the third.
+; 2) In any right-angled triangle the sum of the squares of the two shorter
+; sides is equal to the square of the longest side opposite the right-angle.
+; Very useful if you know the length of two sides and wish to know the
+; length of the third side.
+; 3) Functions sine, cosine and tangent enable one to calculate the length
+; of an unknown side when the length of one other side and an angle is
+; known.
+; 4) Functions arcsin, arccosine and arctan enable one to calculate an unknown
+; angle when the length of two of the sides is known.
+
+; --------------------------------
+; THE <b><font color=#333388>'REDUCE ARGUMENT'</font></b> SUBROUTINE
+; --------------------------------
+; <font color=#339933>(offset $35: 'get-argt')</font>
+;
+; This routine performs two functions on the angle, in radians, that forms
+; the argument to the sine and cosine functions.
+; First it ensures that the angle 'wraps round'. That if a ship turns through
+; an angle of, say, 3*PI radians (540 degrees) then the net effect is to turn
+; through an angle of PI radians (180 degrees).
+; Secondly it converts the angle in radians to a fraction of a right angle,
+; depending within which quadrant the angle lies, with the periodicity
+; resembling that of the desired sine value.
+; The result lies in the range -1 to +1.
+;
+; 90 deg.
+;
+; (pi/2)
+; II +1 I
+; |
+;<font color=#339933> sin+ |\ | /| sin+</font>
+;<font color=#339933> cos- | \ | / | cos+</font>
+;<font color=#339933> tan- | \ | / | tan+</font>
+;<font color=#339933> | \|/) | </font>
+;<font color=#339933> 180 deg. (pi) 0 -|----+----|-- 0 (0) 0 degrees</font>
+;<font color=#339933> | /|\ |</font>
+;<font color=#339933> sin- | / | \ | sin-</font>
+;<font color=#339933> cos- | / | \ | cos+</font>
+;<font color=#339933> tan+ |/ | \| tan-</font>
+;<font color=#339933> |</font>
+;<font color=#339933> III -1 IV</font>
+;<font color=#339933> (3pi/2)</font>
+;<font color=#339933></font>
+; 270 deg.
+
+
+<a name="get_argt"></a><b>get_argt</b> 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.
+
+<a name="ZPLUS"></a><b>ZPLUS</b> 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
+
+
+<a name="YNEG"></a><b>YNEG</b> DEFB $34 ;;end-calc quadrants II and III correct.
+
+ RET ; return.
+
+
+; ---------------------
+; THE <b><font color=#333388>'COSINE'</font></b> FUNCTION
+; ---------------------
+; <font color=#339933>(offset $1D: 'cos')</font>
+; Cosines are calculated as the sine of the opposite angle rectifying the
+; sign depending on the quadrant rules.
+;
+;
+;<font color=#339933> /|</font>
+;<font color=#339933> h /y|</font>
+;<font color=#339933> / |o</font>
+;<font color=#339933> /x |</font>
+;<font color=#339933> /----| </font>
+;<font color=#339933> a</font>
+;<font color=#339933></font>
+; The cosine of angle x is the adjacent side (a) divided by the hypotenuse 1.
+; However if we examine angle y then a/h is the sine of that angle.
+; Since angle x plus angle y equals a right-angle, we can find angle y by
+; subtracting angle x from pi/2.
+; However it's just as easy to reduce the argument first and subtract the
+; reduced argument from the value 1 (a reduced right-angle).
+; It's even easier to subtract 1 from the angle and rectify the sign.
+; In fact, after reducing the argument, the absolute value of the argument
+; is used and rectified using the test result stored in mem-0 by 'get-argt'
+; for that purpose.
+
+<a name="cos"></a><b>cos</b> 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 <b><font color=#333388>'SINE'</font></b> FUNCTION
+; -------------------
+; <font color=#339933>(offset $1C: 'sin')</font>
+; This is a fundamental transcendental function from which others such as cos
+; and tan are directly, or indirectly, derived.
+; It uses the series generator to produce Chebyshev polynomials.
+;
+;
+;<font color=#339933> /|</font>
+;<font color=#339933> 1 / |</font>
+;<font color=#339933> / |x</font>
+;<font color=#339933> /a |</font>
+;<font color=#339933> /----| </font>
+;<font color=#339933> y</font>
+;<font color=#339933></font>
+; The 'get-argt' function is designed to modify the angle and its sign
+; in line with the desired sine value and afterwards it can launch straight
+; into common code.
+
+<a name="sin"></a><b>sin</b> RST 28H ;; FP-CALC angle in radians
+ DEFB $35 ;;get-argt reduce - sign now correct.
+
+<a name="C_ENT"></a><b>C_ENT</b> DEFB $2D ;;duplicate
+ DEFB $2D ;;duplicate
+ DEFB $04 ;;multiply
+ DEFB $2D ;;duplicate
+ DEFB $0F ;;addition
+ DEFB $A1 ;;stk-one
+ DEFB $03 ;;subtract
+
+ DEFB $86 ;;series-06
+ DEFB $14 ;;Exponent: $64, Bytes: 1
+ DEFB $E6 ;;(+00,+00,+00)
+ DEFB $5C ;;Exponent: $6C, Bytes: 2
+ DEFB $1F,$0B ;;(+00,+00)
+ DEFB $A3 ;;Exponent: $73, Bytes: 3
+ DEFB $8F,$38,$EE ;;(+00)
+ DEFB $E9 ;;Exponent: $79, Bytes: 4
+ DEFB $15,$63,$BB,$23 ;;
+ DEFB $EE ;;Exponent: $7E, Bytes: 4
+ DEFB $92,$0D,$CD,$ED ;;
+ DEFB $F1 ;;Exponent: $81, Bytes: 4
+ DEFB $23,$5D,$1B,$EA ;;
+
+ DEFB $04 ;;multiply
+ DEFB $34 ;;end-calc
+
+ RET ; return.
+
+
+; ----------------------
+; THE <b><font color=#333388>'TANGENT'</font></b> FUNCTION
+; ----------------------
+; <font color=#339933>(offset $1E: 'tan')</font>
+;
+; Evaluates tangent x as sin(x) / cos(x).
+;
+;
+;<font color=#339933> /|</font>
+;<font color=#339933> h / |</font>
+;<font color=#339933> / |o</font>
+;<font color=#339933> /x |</font>
+;<font color=#339933> /----| </font>
+;<font color=#339933> a</font>
+;<font color=#339933></font>
+; The tangent of angle x is the ratio of the length of the opposite side
+; divided by the length of the adjacent side. As the opposite length can
+; be calculates using sin(x) and the adjacent length using cos(x) then
+; the tangent can be defined in terms of the previous two functions.
+
+; Error 6 if the argument, in radians, is too close to one like pi/2
+; which has an infinite tangent. e.g. PRINT TAN (PI/2) evaluates as 1/0.
+; Similarly PRINT TAN (3*PI/2), TAN (5*PI/2) etc.
+
+<a name="tan"></a><b>tan</b> RST 28H ;; FP-CALC x.
+ DEFB $2D ;;duplicate x, x.
+ DEFB $1C ;;sin x, sin x.
+ DEFB $01 ;;exchange sin x, x.
+ DEFB $1D ;;cos sin x, cos x.
+ DEFB $05 ;;division sin x/cos x (= tan x).
+ DEFB $34 ;;end-calc tan x.
+
+ RET ; return.
+
+; ---------------------
+; THE <b><font color=#333388>'ARCTAN'</font></b> FUNCTION
+; ---------------------
+; <font color=#339933>(Offset $21: 'atn')</font>
+; The inverse tangent function with the result in radians.
+; This is a fundamental transcendental function from which others such as asn
+; and acs are directly, or indirectly, derived.
+; It uses the series generator to produce Chebyshev polynomials.
+
+<a name="atn"></a><b>atn</b> LD A,(HL) ; fetch exponent
+ CP $81 ; compare to that for 'one'
+ JR C,<A href="#SMALL">SMALL</a> ; forward, if less, to SMALL
+
+ RST 28H ;; FP-CALC X.
+ DEFB $A1 ;;stk-one
+ DEFB $18 ;;negate
+ DEFB $01 ;;exchange
+ DEFB $05 ;;division
+ DEFB $2D ;;duplicate
+ DEFB $32 ;;less-0
+ DEFB $A3 ;;stk-pi/2
+ DEFB $01 ;;exchange
+ DEFB $00 ;;jump-true
+ DEFB $06 ;;to L1D8B, CASES
+
+ DEFB $18 ;;negate
+ DEFB $2F ;;jump
+ DEFB $03 ;;to L1D8B, CASES
+
+; ---
+
+<a name="SMALL"></a><b>SMALL</b> RST 28H ;; FP-CALC
+ DEFB $A0 ;;stk-zero
+
+<a name="CASES"></a><b>CASES</b> DEFB $01 ;;exchange
+ DEFB $2D ;;duplicate
+ DEFB $2D ;;duplicate
+ DEFB $04 ;;multiply
+ DEFB $2D ;;duplicate
+ DEFB $0F ;;addition
+ DEFB $A1 ;;stk-one
+ DEFB $03 ;;subtract
+
+ DEFB $8C ;;series-0C
+ DEFB $10 ;;Exponent: $60, Bytes: 1
+ DEFB $B2 ;;(+00,+00,+00)
+ DEFB $13 ;;Exponent: $63, Bytes: 1
+ DEFB $0E ;;(+00,+00,+00)
+ DEFB $55 ;;Exponent: $65, Bytes: 2
+ DEFB $E4,$8D ;;(+00,+00)
+ DEFB $58 ;;Exponent: $68, Bytes: 2
+ DEFB $39,$BC ;;(+00,+00)
+ DEFB $5B ;;Exponent: $6B, Bytes: 2
+ DEFB $98,$FD ;;(+00,+00)
+ DEFB $9E ;;Exponent: $6E, Bytes: 3
+ DEFB $00,$36,$75 ;;(+00)
+ DEFB $A0 ;;Exponent: $70, Bytes: 3
+ DEFB $DB,$E8,$B4 ;;(+00)
+ DEFB $63 ;;Exponent: $73, Bytes: 2
+ DEFB $42,$C4 ;;(+00,+00)
+ DEFB $E6 ;;Exponent: $76, Bytes: 4
+ DEFB $B5,$09,$36,$BE ;;
+ DEFB $E9 ;;Exponent: $79, Bytes: 4
+ DEFB $36,$73,$1B,$5D ;;
+ DEFB $EC ;;Exponent: $7C, Bytes: 4
+ DEFB $D8,$DE,$63,$BE ;;
+ DEFB $F0 ;;Exponent: $80, Bytes: 4
+ DEFB $61,$A1,$B3,$0C ;;
+
+ DEFB $04 ;;multiply
+ DEFB $0F ;;addition
+ DEFB $34 ;;end-calc
+
+ RET ; return.
+
+
+; ---------------------
+; THE <b><font color=#333388>'ARCSIN'</font></b> FUNCTION
+; ---------------------
+; <font color=#339933>(Offset $1F: 'asn')</font>
+; The inverse sine function with result in radians.
+; Derived from arctan function above.
+; Error A unless the argument is between -1 and +1 inclusive.
+; Uses an adaptation of the formula asn(x) = atn(x/sqr(1-x*x))
+;
+;
+;<font color=#339933> /|</font>
+;<font color=#339933> / |</font>
+;<font color=#339933> 1/ |x</font>
+;<font color=#339933> /a |</font>
+;<font color=#339933> /----| </font>
+;<font color=#339933> y</font>
+;<font color=#339933></font>
+; 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
+;
+;
+;<font color=#339933> . /|</font>
+;<font color=#339933> . c/ |</font>
+;<font color=#339933> . /1 |x</font>
+;<font color=#339933> . c b /a |</font>
+;<font color=#339933> ---------/----| </font>
+;<font color=#339933> 1 y</font>
+;<font color=#339933></font>
+; By creating an isosceles triangle with two equal sides of 1, angles c and
+; c are also equal. If b+c+c = 180 degrees and b+a = 180 degress then c=a/2.
+;
+; A value higher than 1 gives the required error as attempting to find the
+; square root of a negative number generates an error in Sinclair BASIC.
+
+<a name="asn"></a><b>asn</b> RST 28H ;; FP-CALC x.
+ DEFB $2D ;;duplicate x, x.
+ DEFB $2D ;;duplicate x, x, x.
+ DEFB $04 ;;multiply x, x*x.
+ DEFB $A1 ;;stk-one x, x*x, 1.
+ DEFB $03 ;;subtract x, x*x-1.
+ DEFB $18 ;;negate x, 1-x*x.
+ DEFB $25 ;;sqr x, sqr(1-x*x) = y.
+ DEFB $A1 ;;stk-one x, y, 1.
+ DEFB $0F ;;addition x, y+1.
+ DEFB $05 ;;division x/y+1.
+ DEFB $21 ;;atn a/2 (half the angle)
+ DEFB $2D ;;duplicate a/2, a/2.
+ DEFB $0F ;;addition a.
+ DEFB $34 ;;end-calc a.
+
+ RET ; return.
+
+
+; ------------------------
+; THE <b><font color=#333388>'ARCCOS'</font></b> FUNCTION
+; ------------------------
+; <font color=#339933>(Offset $20: 'acs')</font>
+; the inverse cosine function with the result in radians.
+; Error A unless the argument is between -1 and +1.
+; Result in range 0 to pi.
+; Derived from asn above which is in turn derived from the preceding atn.
+; It could have been derived directly from atn using acs(x) = atn(sqr(1-x*x)/x).
+; However, as sine and cosine are horizontal translations of each other,
+; uses acs(x) = pi/2 - asn(x)
+
+; e.g. the arccosine of a known x value will give the required angle b in
+; radians.
+; We know, from above, how to calculate the angle a using asn(x).
+; Since the three angles of any triangle add up to 180 degrees, or pi radians,
+; and the largest angle in this case is a right-angle (pi/2 radians), then
+; we can calculate angle b as pi/2 (both angles) minus asn(x) (angle a).
+;
+;
+;<font color=#339933> /|</font>
+;<font color=#339933> 1 /b|</font>
+;<font color=#339933> / |x</font>
+;<font color=#339933> /a |</font>
+;<font color=#339933> /----| </font>
+;<font color=#339933> y</font>
+;<font color=#339933></font>
+
+<a name="acs"></a><b>acs</b> 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 OLD <b><font color=#333388>'SQUARE ROOT'</font></b> FUNCTION
+; --------------------------
+; <font color=#339933>(Offset $25: 'sqr')</font>
+; Error A if argument is negative.
+; This routine is remarkable for its brevity - 7 bytes.
+; This routine uses Napier's method for calculating square roots which was
+; devised in 1614 and calculates the value as EXP (LN 'x' * 0.5).
+;
+; This is a little on the slow side as it involves two polynomial series.
+; A series of 12 for LN and a series of 8 for EXP. This was of no concern
+; to John Napier since his tables were 'compiled forever'.
+;
+<font color=#FF3333>;;; L1DDB: RST 28H ;; FP-CALC x.</font>
+<font color=#FF3333>;;; DEFB $2D ;;duplicate x, x.</font>
+<font color=#FF3333>;;; DEFB $2C ;;not x, 1/0</font>
+<font color=#FF3333>;;; DEFB $00 ;;jump-true x, (1/0).</font>
+<font color=#FF3333>;;; DEFB $1E ;;to L1DFD, LAST exit if argument zero</font>
+<font color=#FF3333>;;; ;; with zero result.</font>
+;;;
+<font color=#FF3333>;;; else continue to calculate as x ** .5</font>
+;;;
+<font color=#FF3333>;;; DEFB $A2 ;;stk-half x, .5.</font>
+<font color=#FF3333>;;; DEFB $34 ;;end-calc x, .5.</font>
+
+
+; ------------------------
+; THE <b><font color=#333388>'TO POWER'</font></b> OPERATION
+; ------------------------
+; <font color=#339933>(Offset $06: 'to-power')</font>
+; The 'Exponential' operation.
+; This raises the first number X to the power of the second number Y.
+; e.g. PRINT 2 ** 3 gives the result 8
+; As with the ZX80,
+; 0 ** 0 = 1
+; 0 ** +n = 0
+; 0 ** -n = arithmetic overflow.
+
+<a name="to_power"></a><b>to_power</b> 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.
+
+; Multiply the power by the logarithm of the argument.
+
+ DEFB $04 ;;multiply Y * LN X
+ DEFB $34 ;;end-calc
+
+ JP exp ; jump back to EXP routine ->>
+ ; to find the 'antiln'
+
+; ---
+
+; these routines form the three simple results when the number is zero.
+; begin by deleting the known zero to leave Y the power factor.
+
+<a name="XISO"></a><b>XISO</b> 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.
+; As an alternative, this now raises an error directly.
+
+<font color=#FF3333>;;; DEFB $A1 ;;stk-one 0, 1.</font>
+<font color=#FF3333>;;; DEFB $01 ;;exchange 1, 0.</font>
+<font color=#FF3333>;;; DEFB $05 ;;division 1/0 >> error </font>
+
+ <font color=#3333FF> DEFB $34 ;+ end-calc</font>
+<a name="REPORT_6c"></a><b>REPORT_6c</b> <font color=#3333FF>RST 08H ;+ ERROR-1</font>
+ <font color=#3333FF> DEFB $05 ;+ Error Report: Number too big</font>
+
+; ---
+
+<a name="ONE"></a><b>ONE</b> DEFB $02 ;;delete .
+ DEFB $A1 ;;stk-one 1.
+
+<a name="LAST"></a><b>LAST</b> DEFB $34 ;;end-calc last value 1 or 0.
+
+ RET ; return.
+
+; ---------------------
+; THE <b><font color=#333388>'SPARE LOCATIONS'</font></b>
+; ---------------------
+
+<a name="L1DFE:"></a><b>L1DFE:</b>
+
+ DEFB $FF, $FF ; Two spare bytes.
+
+
+<a name="ORG"></a><b>ORG</b> $1E00
+
+; ------------------------
+; THE <b><font color=#333388>'ZX81 CHARACTER SET'</font></b>
+; ------------------------
+
+
+; $00 - <b>Character: ' ' </b>CHR$(0)
+
+<a name="char_set"></a><b>char_set</b> DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $01 - <b>Character: mosaic </b>CHR$(1)
+
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+
+; $02 - <b>Character: mosaic </b>CHR$(2)
+
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+
+; $03 - <b>Character: mosaic </b>CHR$(3)
+
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $04 - <b>Character: mosaic </b>CHR$(4)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+
+; $05 - <b>Character: mosaic </b>CHR$(1)
+
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+
+; $06 - <b>Character: mosaic </b>CHR$(1)
+
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+
+; $07 - <b>Character: mosaic </b>CHR$(1)
+
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+
+; $08 - <b>Character: mosaic </b>CHR$(1)
+
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+
+; $09 - <b>Character: mosaic </b>CHR$(1)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+
+; $0A - <b>Character: mosaic </b>CHR$(10)
+
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $0B - <b>Character: '"' </b>CHR$(11)
+
+ DEFB %00000000
+ DEFB %00<B>1</B>00<B>1</B>00
+ DEFB %00<B>1</B>00<B>1</B>00
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $0B - <b>Character: 'œ' </b>CHR$(12)
+
+ DEFB %00000000
+ DEFB %000<B>1</B><B>1</B><B>1</B>00
+ DEFB %00<B>1</B>000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B>000
+ DEFB %00<B>1</B>00000
+ DEFB %00<B>1</B>00000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+; $0B - <b>Character: '$' </b>CHR$(13)
+
+ DEFB %00000000
+ DEFB %0000<B>1</B>000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00<B>1</B>0<B>1</B>000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0000<B>1</B>0<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0000<B>1</B>000
+
+; $0B - <b>Character: ':' </b>CHR$(14)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+
+; $0B - <b>Character: '?' </b>CHR$(15)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %00000000
+ DEFB %0000<B>1</B>000
+ DEFB %00000000
+
+; $10 - <b>Character: '(' </b>CHR$(16)
+
+ DEFB %00000000
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %00000<B>1</B>00
+ DEFB %00000000
+
+; $11 - <b>Character: ')' </b>CHR$(17)
+
+ DEFB %00000000
+ DEFB %00<B>1</B>00000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %00<B>1</B>00000
+ DEFB %00000000
+
+; $12 - <b>Character: '>' </b>CHR$(18)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B>0000
+ DEFB %0000<B>1</B>000
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+
+; $13 - <b>Character: '<' </b>CHR$(19)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0000
+ DEFB %0000<B>1</B>000
+ DEFB %00000<B>1</B>00
+ DEFB %00000000
+
+; $14 - <b>Character: '=' </b>CHR$(20)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+ DEFB %00000000
+
+; $15 - <b>Character: '+' </b>CHR$(21)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %00000000
+
+; $16 - <b>Character: '-' </b>CHR$(22)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $17 - <b>Character: '*' </b>CHR$(23)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B>0<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0<B>1</B>00
+ DEFB %00000000
+
+; $18 - <b>Character: '/' </b>CHR$(24)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000000<B>1</B>0
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0000
+ DEFB %00<B>1</B>00000
+ DEFB %00000000
+
+; $19 - <b>Character: ';' </b>CHR$(25)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %00<B>1</B>00000
+
+; $1A - <b>Character: ',' </b>CHR$(26)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0000
+
+; $1B - <b>Character: '"' </b>CHR$(27)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %00000000
+
+; $1C - <b>Character: '0' </b>CHR$(28)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000<B>1</B><B>1</B>0
+ DEFB %0<B>1</B>00<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>00<B>1</B>0
+ DEFB %0<B>1</B><B>1</B>000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $1D - <b>Character: '1' </b>CHR$(29)
+
+ DEFB %00000000
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %00<B>1</B>0<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+; $1E - <b>Character: '2' </b>CHR$(30)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %000000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+; $1F - <b>Character: '3' </b>CHR$(31)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0000<B>1</B><B>1</B>00
+ DEFB %000000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $20 - <b>Character: '4' </b>CHR$(32)
+
+ DEFB %00000000
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %00<B>1</B>0<B>1</B>000
+ DEFB %0<B>1</B>00<B>1</B>000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0000<B>1</B>000
+ DEFB %00000000
+
+; $21 - <b>Character: '5' </b>CHR$(33)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %000000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $22 - <b>Character: '6' </b>CHR$(34)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $23 - <b>Character: '7' </b>CHR$(35)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %000000<B>1</B>0
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+
+; $24 - <b>Character: '8' </b>CHR$(36)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $25 - <b>Character: '9' </b>CHR$(37)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %000000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $26 - <b>Character: 'A' </b>CHR$(38)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $27 - <b>Character: 'B' </b>CHR$(39)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $28 - <b>Character: 'C' </b>CHR$(40)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $29 - <b>Character: 'D' </b>CHR$(41)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B>000
+ DEFB %0<B>1</B>000<B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>000<B>1</B>00
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B>000
+ DEFB %00000000
+
+; $2A - <b>Character: 'E' </b>CHR$(42)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+; $2B - <b>Character: 'F' </b>CHR$(43)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %00000000
+
+; $2C - <b>Character: 'G' </b>CHR$(44)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>00<B>1</B><B>1</B><B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $2D - <b>Character: 'H' </b>CHR$(45)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $2E - <b>Character: 'I' </b>CHR$(46)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+; $2F - <b>Character: 'J' </b>CHR$(47)
+
+ DEFB %00000000
+ DEFB %000000<B>1</B>0
+ DEFB %000000<B>1</B>0
+ DEFB %000000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $30 - <b>Character: 'K' </b>CHR$(48)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>000<B>1</B>00
+ DEFB %0<B>1</B>00<B>1</B>000
+ DEFB %0<B>1</B><B>1</B><B>1</B>0000
+ DEFB %0<B>1</B>00<B>1</B>000
+ DEFB %0<B>1</B>000<B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $31 - <b>Character: 'L' </b>CHR$(49)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+; $32 - <b>Character: 'M' </b>CHR$(50)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B>00<B>1</B><B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B><B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $33 - <b>Character: 'N' </b>CHR$(51)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B>000<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>00<B>1</B>0
+ DEFB %0<B>1</B>00<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>000<B>1</B><B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $34 - <b>Character: 'O' </b>CHR$(52)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $35 - <b>Character: 'P' </b>CHR$(53)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %00000000
+
+; $36 - <b>Character: 'Q' </b>CHR$(54)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>00<B>1</B>0
+ DEFB %0<B>1</B>00<B>1</B>0<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $37 - <b>Character: 'R' </b>CHR$(55)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000<B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $38 - <b>Character: 'S' </b>CHR$(56)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %000000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $39 - <b>Character: 'T' </b>CHR$(57)
+
+ DEFB %00000000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+
+; $3A - <b>Character: 'U' </b>CHR$(58)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $3B - <b>Character: 'V' </b>CHR$(59)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B>00<B>1</B>00
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %00000000
+
+; $3C - <b>Character: 'W' </b>CHR$(60)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B><B>1</B>0<B>1</B>0
+ DEFB %00<B>1</B>00<B>1</B>00
+ DEFB %00000000
+
+; $3D - <b>Character: 'X' </b>CHR$(61)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B>00<B>1</B>00
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %00<B>1</B>00<B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $3E - <b>Character: 'Y' </b>CHR$(62)
+
+ DEFB %00000000
+ DEFB %<B>1</B>00000<B>1</B>0
+ DEFB %0<B>1</B>000<B>1</B>00
+ DEFB %00<B>1</B>0<B>1</B>000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+
+; $3F - <b>Character: 'Z' </b>CHR$(63)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0000
+ DEFB %00<B>1</B>00000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+.END ;TASM assembler instruction.
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/mirror/tablix.org/zx81.html b/mirror/tablix.org/zx81.html
@@ -0,0 +1,10568 @@
+<HTML>
+<HEAD>
+<TITLE>
+Assembly Listing of the Operating System of the Sinclair ZX81.
+</TITLE>
+</HEAD>
+<BODY>
+<font face = "Courier"> </font>
+<PRE>
+; ===========================================================
+; An Assembly Listing of the Operating System of the ZX81 ROM
+; ===========================================================
+; -------------------------
+; Last updated: 13-DEC-2004
+; -------------------------
+;
+; Work in progress.
+; This file will cross-assemble an original version of the "Improved"
+; ZX81 ROM. The file can be modified to change the behaviour of the ROM
+; when used in emulators although there is no spare space available.
+;
+; The documentation is incomplete and if you can find a copy
+; of "The Complete Spectrum ROM Disassembly" then many routines
+; such as POINTERS and most of the mathematical routines are
+; similar and often identical.
+;
+; I've used the labels from the above book in this file and also
+; some from the more elusive Complete ZX81 ROM Disassembly
+; by the same publishers, Melbourne House.
+
+
+#define DEFB .BYTE ; TASM cross-assembler definitions
+#define DEFW .WORD
+#define EQU .EQU
+
+
+;*****************************************
+;** Part 1. RESTART ROUTINES AND TABLES **
+;*****************************************
+
+; -----------
+; THE <b><font color=#333388>'START'</font></b>
+; -----------
+; All Z80 chips start at location zero.
+; At start-up the Interrupt Mode is 0, ZX computers use Interrupt Mode 1.
+; Interrupts are disabled .
+
+<a name="L0000"></a>;; <b>START</b>
+L0000: OUT ($FD),A ; Turn off the NMI generator if this ROM is
+ ; running in ZX81 hardware. This does nothing
+ ; if this ROM is running within an upgraded
+ ; ZX80.
+ LD BC,$7FFF ; Set BC to the top of possible RAM.
+ ; The higher unpopulated addresses are used for
+ ; video generation.
+ JP <A href="#L03CB">L03CB</a> ; Jump forward to RAM-CHECK.
+
+; -------------------
+; THE <b><font color=#333388>'ERROR'</font></b> RESTART
+; -------------------
+; The error restart deals immediately with an error. ZX computers execute the
+; same code in runtime as when checking syntax. If the error occurred while
+; running a program then a brief report is produced. If the error occurred
+; while entering a BASIC line or in input etc., then the error marker indicates
+; the exact point at which the error lies.
+
+<a name="L0008"></a>;; <b>ERROR-1</b>
+L0008: LD HL,($4016) ; fetch character address from CH_ADD.
+ LD ($4018),HL ; and set the error pointer X_PTR.
+ JR <A href="#L0056">L0056</a> ; forward to continue at ERROR-2.
+
+; -------------------------------
+; THE <b><font color=#333388>'PRINT A CHARACTER'</font></b> RESTART
+; -------------------------------
+; This restart prints the character in the accumulator using the alternate
+; register set so there is no requirement to save the main registers.
+; There is sufficient room available to separate a space (zero) from other
+; characters as leading spaces need not be considered with a space.
+
+<a name="L0010"></a>;; <b>PRINT-A</b>
+L0010: AND A ; test for zero - space.
+ JP NZ,<A href="#L07F1">L07F1</a> ; jump forward if not to PRINT-CH.
+
+ JP <A href="#L07F5">L07F5</a> ; jump forward to PRINT-SP.
+
+; ---
+
+ DEFB $FF ; unused location.
+
+; ---------------------------------
+; THE <b><font color=#333388>'COLLECT A CHARACTER'</font></b> RESTART
+; ---------------------------------
+; The character addressed by the system variable CH_ADD is fetched and if it
+; is a non-space, non-cursor character it is returned else CH_ADD is
+; incremented and the new addressed character tested until it is not a space.
+
+<a name="L0018"></a>;; <b>GET-CHAR</b>
+L0018: LD HL,($4016) ; set HL to character address CH_ADD.
+ LD A,(HL) ; fetch addressed character to A.
+
+<a name="L001C"></a>;; <b>TEST-SP</b>
+L001C: AND A ; test for space.
+ RET NZ ; return if not a space
+
+ NOP ; else trickle through
+ NOP ; to the next routine.
+
+; ------------------------------------
+; THE <b><font color=#333388>'COLLECT NEXT CHARACTER'</font></b> RESTART
+; ------------------------------------
+; The character address in incremented and the new addressed character is
+; returned if not a space, or cursor, else the process is repeated.
+
+<a name="L0020"></a>;; <b>NEXT-CHAR</b>
+L0020: CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 gets next immediate
+ ; character.
+ JR <A href="#L001C">L001C</a> ; back to TEST-SP.
+
+; ---
+
+ DEFB $FF, $FF, $FF ; unused locations.
+
+; ---------------------------------------
+; THE <b><font color=#333388>'FLOATING POINT CALCULATOR'</font></b> RESTART
+; ---------------------------------------
+; this restart jumps to the recursive floating-point calculator.
+; the ZX81's internal, FORTH-like, stack-based language.
+;
+; In the five remaining bytes there is, appropriately, enough room for the
+; end-calc literal - the instruction which exits the calculator.
+
+<a name="L0028"></a>;; <b>FP-CALC</b>
+L0028: JP <A href="#L199D">L199D</a> ; jump immediately to the CALCULATE routine.
+
+; ---
+
+<a name="L002B"></a>;; <b>end-calc</b>
+L002B: POP AF ; drop the calculator return address RE-ENTRY
+ EXX ; switch to the other set.
+
+ EX (SP),HL ; transfer H'L' to machine stack for the
+ ; return address.
+ ; when exiting recursion then the previous
+ ; pointer is transferred to H'L'.
+
+ EXX ; back to main set.
+ RET ; return.
+
+
+; -----------------------------
+; THE <b><font color=#333388>'MAKE BC SPACES'</font></b> RESTART
+; -----------------------------
+; This restart is used eight times to create, in workspace, the number of
+; spaces passed in the BC register.
+
+<a name="L0030"></a>;; <b>BC-SPACES</b>
+L0030: PUSH BC ; push number of spaces on stack.
+ LD HL,($4014) ; fetch edit line location from E_LINE.
+ PUSH HL ; save this value on stack.
+ JP <A href="#L1488">L1488</a> ; jump forward to continue at RESERVE.
+
+; -----------------------
+; THE <b><font color=#333388>'INTERRUPT'</font></b> RESTART
+; -----------------------
+; The Mode 1 Interrupt routine is concerned solely with generating the central
+; television picture.
+; On the ZX81 interrupts are enabled only during the interrupt routine,
+; although the interrupt
+; This Interrupt Service Routine automatically disables interrupts at the
+; outset and the last interrupt in a cascade exits before the interrupts are
+; enabled.
+; There is no DI instruction in the ZX81 ROM.
+; An maskable interrupt is triggered when bit 6 of the Z80's Refresh register
+; changes from set to reset.
+; The Z80 will always be executing a HALT (NEWLINE) when the interrupt occurs.
+; A HALT instruction repeatedly executes NOPS but the seven lower bits
+; of the Refresh register are incremented each time as they are when any
+; simple instruction is executed. (The lower 7 bits are incremented twice for
+; a prefixed instruction)
+; This is controlled by the Sinclair Computer Logic Chip - manufactured from
+; a Ferranti Uncommitted Logic Array.
+;
+; When a Mode 1 Interrupt occurs the Program Counter, which is the address in
+; the upper echo display following the NEWLINE/HALT instruction, goes on the
+; machine stack. 193 interrupts are required to generate the last part of
+; the 56th border line and then the 192 lines of the central TV picture and,
+; although each interrupt interrupts the previous one, there are no stack
+; problems as the 'return address' is discarded each time.
+;
+; The scan line counter in C counts down from 8 to 1 within the generation of
+; each text line. For the first interrupt in a cascade the initial value of
+; C is set to 1 for the last border line.
+; Timing is of the utmost importance as the RH border, horizontal retrace
+; and LH border are mostly generated in the 58 clock cycles this routine
+; takes .
+
+<a name="L0038"></a>;; <b>INTERRUPT</b>
+L0038: DEC C ; (4) decrement C - the scan line counter.
+ JP NZ,<A href="#L0045">L0045</a> ; (10/10) JUMP forward if not zero to SCAN-LINE
+
+ POP HL ; (10) point to start of next row in display
+ ; file.
+
+ DEC B ; (4) decrement the row counter. (4)
+ RET Z ; (11/5) return when picture complete to L028B
+ ; with interrupts disabled.
+
+ SET 3,C ; (8) Load the scan line counter with eight.
+ ; <font color=#9900FF>Note.</font> LD C,$08 is 7 clock cycles which
+ ; is way too fast.
+
+; ->
+
+<a name="L0041"></a>;; <b>WAIT-INT</b>
+L0041: LD R,A ; (9) Load R with initial rising value $DD.
+
+ EI ; (4) Enable Interrupts. [ R is now $DE ].
+
+ JP (HL) ; (4) jump to the echo display file in upper
+ ; memory and execute characters $00 - $3F
+ ; as NOP instructions. The video hardware
+ ; is able to read these characters and,
+ ; with the I register is able to convert
+ ; the character bitmaps in this ROM into a
+ ; line of bytes. Eventually the NEWLINE/HALT
+ ; will be encountered before R reaches $FF.
+ ; It is however the transition from $FF to
+ ; $80 that triggers the next interrupt.
+ ; [ The Refresh register is now $DF ]
+
+; ---
+
+<a name="L0045"></a>;; <b>SCAN-LINE</b>
+L0045: POP DE ; (10) discard the address after NEWLINE as the
+ ; same text line has to be done again
+ ; eight times.
+
+ RET Z ; (5) Harmless Nonsensical Timing.
+ ; (condition never met)
+
+ JR <A href="#L0041">L0041</a> ; (12) back to WAIT-INT
+
+; <font color=#9900FF>Note.</font> that a computer with less than 4K or RAM will have a collapsed
+; display file and the above mechanism deals with both types of display.
+;
+; With a full display, the 32 characters in the line are treated as NOPS
+; and the Refresh register rises from $E0 to $FF and, at the next instruction
+; - HALT, the interrupt occurs.
+; With a collapsed display and an initial NEWLINE/HALT, it is the NOPs
+; generated by the HALT that cause the Refresh value to rise from $E0 to $FF,
+; triggering an Interrupt on the next transition.
+; This works happily for all display lines between these extremes and the
+; generation of the 32 character, 1 pixel high, line will always take 128
+; clock cycles.
+
+; ---------------------------------
+; THE <b><font color=#333388>'INCREMENT CH-ADD'</font></b> SUBROUTINE
+; ---------------------------------
+; This is the subroutine that increments the character address system variable
+; and returns if it is not the cursor character. The ZX81 has an actual
+; character at the cursor position rather than a pointer system variable
+; as is the case with prior and subsequent ZX computers.
+
+<a name="L0049"></a>;; <b>CH-ADD+1</b>
+L0049: LD HL,($4016) ; fetch character address to CH_ADD.
+
+<a name="L004C"></a>;; <b>TEMP-PTR1</b>
+L004C: INC HL ; address next immediate location.
+
+<a name="L004D"></a>;; <b>TEMP-PTR2</b>
+L004D: LD ($4016),HL ; update system variable CH_ADD.
+
+ LD A,(HL) ; fetch the character.
+ CP $7F ; compare to cursor character.
+ RET NZ ; return if not the cursor.
+
+ JR <A href="#L004C">L004C</a> ; back for next character to TEMP-PTR1.
+
+; --------------------
+; THE <b><font color=#333388>'ERROR-2'</font></b> BRANCH
+; --------------------
+; This is a continuation of the error restart.
+; If the error occurred in runtime then the error stack pointer will probably
+; lead to an error report being printed unless it occurred during input.
+; If the error occurred when checking syntax then the error stack pointer
+; will be an editing routine and the position of the error will be shown
+; when the lower screen is reprinted.
+
+<a name="L0056"></a>;; <b>ERROR-2</b>
+L0056: POP HL ; pop the return address which points to the
+ ; DEFB, error code, after the RST 08.
+ LD L,(HL) ; load L with the error code. HL is not needed
+ ; anymore.
+
+<a name="L0058"></a>;; <b>ERROR-3</b>
+L0058: LD (IY+$00),L ; place error code in system variable ERR_NR
+ LD SP,($4002) ; set the stack pointer from ERR_SP
+ CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST selects slow mode.
+ JP <A href="#L14BC">L14BC</a> ; exit to address on stack via routine SET-MIN.
+
+; ---
+
+ DEFB $FF ; unused.
+
+; ------------------------------------
+; THE <b><font color=#333388>'NON MASKABLE INTERRUPT'</font></b> ROUTINE
+; ------------------------------------
+; Jim Westwood's technical dodge using Non-Maskable Interrupts solved the
+; flicker problem of the ZX80 and gave the ZX81 a multi-tasking SLOW mode
+; with a steady display. Note that the AF' register is reserved for this
+; function and its interaction with the display routines. When counting
+; TV lines, the NMI makes no use of the main registers.
+; The circuitry for the NMI generator is contained within the SCL (Sinclair
+; Computer Logic) chip.
+; ( It takes 32 clock cycles while incrementing towards zero ).
+
+<a name="L0066"></a>;; <b>NMI</b>
+L0066: EX AF,AF' ; (4) switch in the NMI's copy of the
+ ; accumulator.
+ INC A ; (4) increment.
+ JP M,<A href="#L006D">L006D</a> ; (10/10) jump, if minus, to NMI-RET as this is
+ ; part of a test to see if the NMI
+ ; generation is working or an intermediate
+ ; value for the ascending negated blank
+ ; line counter.
+
+ JR Z,<A href="#L006F">L006F</a> ; (12) forward to NMI-CONT
+ ; when line count has incremented to zero.
+
+; <font color=#9900FF>Note.</font> the synchronizing NMI when A increments from zero to one takes this
+; 7 clock cycle route making 39 clock cycles in all.
+
+<a name="L006D"></a>;; <b>NMI-RET</b>
+L006D: EX AF,AF' ; (4) switch out the incremented line counter
+ ; or test result $80
+ RET ; (10) return to User application for a while.
+
+; ---
+
+; This branch is taken when the 55 (or 31) lines have been drawn.
+
+<a name="L006F"></a>;; <b>NMI-CONT</b>
+L006F: EX AF,AF' ; (4) restore the main accumulator.
+
+ PUSH AF ; (11) * Save Main Registers
+ PUSH BC ; (11) **
+ PUSH DE ; (11) ***
+ PUSH HL ; (11) ****
+
+; the next set-up procedure is only really applicable when the top set of
+; blank lines have been generated.
+
+ LD HL,($400C) ; (16) fetch start of Display File from D_FILE
+ ; points to the HALT at beginning.
+ SET 7,H ; (8) point to upper 32K 'echo display file'
+
+ HALT ; (1) HALT synchronizes with NMI.
+ ; Used with special hardware connected to the
+ ; Z80 HALT and WAIT lines to take 1 clock cycle.
+
+; ----------------------------------------------------------------------------
+; the NMI has been generated - start counting. The cathode ray is at the RH
+; side of the TV.
+; First the NMI servicing, similar to CALL = 17 clock cycles.
+; Then the time taken by the NMI for zero-to-one path = 39 cycles
+; The HALT above = 01 cycles.
+; The two instructions below = 19 cycles.
+; The code at <A href="#L0281">L0281</a> up to and including the CALL = 43 cycles.
+; The Called routine at <A href="#L02B5">L02B5</a> = 24 cycles.
+; -------------------------------------- ---
+; Total Z80 instructions = 143 cycles.
+;
+; Meanwhile in TV world,
+; Horizontal retrace = 15 cycles.
+; Left blanking border 8 character positions = 32 cycles
+; Generation of 75% scanline from the first NEWLINE = 96 cycles
+; --------------------------------------- ---
+; 143 cycles
+;
+; Since at the time the first JP (HL) is encountered to execute the echo
+; display another 8 character positions have to be put out, then the
+; Refresh register need to hold $F8. Working back and counteracting
+; the fact that every instruction increments the Refresh register then
+; the value that is loaded into R needs to be $F5. :-)
+;
+;
+ OUT ($FD),A ; (11) Stop the NMI generator.
+
+ JP (IX) ; (8) forward to L0281 (after top) or L028F
+
+; ****************
+; ** KEY TABLES **
+; ****************
+
+; -------------------------------
+; THE <b><font color=#333388>'UNSHIFTED'</font></b> CHARACTER CODES
+; -------------------------------
+
+<a name="L007E"></a>;; <b>K-UNSHIFT</b>
+L007E: DEFB $3F ; Z
+ DEFB $3D ; X
+ DEFB $28 ; C
+ DEFB $3B ; V
+ DEFB $26 ; A
+ DEFB $38 ; S
+ DEFB $29 ; D
+ DEFB $2B ; F
+ DEFB $2C ; G
+ DEFB $36 ; Q
+ DEFB $3C ; W
+ DEFB $2A ; E
+ DEFB $37 ; R
+ DEFB $39 ; T
+ DEFB $1D ; 1
+ DEFB $1E ; 2
+ DEFB $1F ; 3
+ DEFB $20 ; 4
+ DEFB $21 ; 5
+ DEFB $1C ; 0
+ DEFB $25 ; 9
+ DEFB $24 ; 8
+ DEFB $23 ; 7
+ DEFB $22 ; 6
+ DEFB $35 ; P
+ DEFB $34 ; O
+ DEFB $2E ; I
+ DEFB $3A ; U
+ DEFB $3E ; Y
+ DEFB $76 ; NEWLINE
+ DEFB $31 ; L
+ DEFB $30 ; K
+ DEFB $2F ; J
+ DEFB $2D ; H
+ DEFB $00 ; SPACE
+ DEFB $1B ; .
+ DEFB $32 ; M
+ DEFB $33 ; N
+ DEFB $27 ; B
+
+; -----------------------------
+; THE <b><font color=#333388>'SHIFTED'</font></b> CHARACTER CODES
+; -----------------------------
+
+
+<a name="L00A5"></a>;; <b>K-SHIFT</b>
+L00A5: DEFB $0E ; :
+ DEFB $19 ; ;
+ DEFB $0F ; ?
+ DEFB $18 ; /
+ DEFB $E3 ; STOP
+ DEFB $E1 ; LPRINT
+ DEFB $E4 ; SLOW
+ DEFB $E5 ; FAST
+ DEFB $E2 ; LLIST
+ DEFB $C0 ; ""
+ DEFB $D9 ; OR
+ DEFB $E0 ; STEP
+ DEFB $DB ; <=
+ DEFB $DD ; <>
+ DEFB $75 ; EDIT
+ DEFB $DA ; AND
+ DEFB $DE ; THEN
+ DEFB $DF ; TO
+ DEFB $72 ; cursor-left
+ DEFB $77 ; RUBOUT
+ DEFB $74 ; GRAPHICS
+ DEFB $73 ; cursor-right
+ DEFB $70 ; cursor-up
+ DEFB $71 ; cursor-down
+ DEFB $0B ; "
+ DEFB $11 ; )
+ DEFB $10 ; (
+ DEFB $0D ; $
+ DEFB $DC ; >=
+ DEFB $79 ; FUNCTION
+ DEFB $14 ; =
+ DEFB $15 ; +
+ DEFB $16 ; -
+ DEFB $D8 ; **
+ DEFB $0C ; £
+ DEFB $1A ; ,
+ DEFB $12 ; >
+ DEFB $13 ; <
+ DEFB $17 ; *
+
+; ------------------------------
+; THE <b><font color=#333388>'FUNCTION'</font></b> CHARACTER CODES
+; ------------------------------
+
+
+<a name="L00CC"></a>;; <b>K-FUNCT</b>
+L00CC: DEFB $CD ; LN
+ DEFB $CE ; EXP
+ DEFB $C1 ; AT
+ DEFB $78 ; KL
+ DEFB $CA ; ASN
+ DEFB $CB ; ACS
+ DEFB $CC ; ATN
+ DEFB $D1 ; SGN
+ DEFB $D2 ; ABS
+ DEFB $C7 ; SIN
+ DEFB $C8 ; COS
+ DEFB $C9 ; TAN
+ DEFB $CF ; INT
+ DEFB $40 ; RND
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $C2 ; TAB
+ DEFB $D3 ; PEEK
+ DEFB $C4 ; CODE
+ DEFB $D6 ; CHR$
+ DEFB $D5 ; STR$
+ DEFB $78 ; KL
+ DEFB $D4 ; USR
+ DEFB $C6 ; LEN
+ DEFB $C5 ; VAL
+ DEFB $D0 ; SQR
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $42 ; PI
+ DEFB $D7 ; NOT
+ DEFB $41 ; INKEY$
+
+; -----------------------------
+; THE <b><font color=#333388>'GRAPHIC'</font></b> CHARACTER CODES
+; -----------------------------
+
+
+<a name="L00F3"></a>;; <b>K-GRAPH</b>
+L00F3: DEFB $08 ; graphic
+ DEFB $0A ; graphic
+ DEFB $09 ; graphic
+ DEFB $8A ; graphic
+ DEFB $89 ; graphic
+ DEFB $81 ; graphic
+ DEFB $82 ; graphic
+ DEFB $07 ; graphic
+ DEFB $84 ; graphic
+ DEFB $06 ; graphic
+ DEFB $01 ; graphic
+ DEFB $02 ; graphic
+ DEFB $87 ; graphic
+ DEFB $04 ; graphic
+ DEFB $05 ; graphic
+ DEFB $77 ; RUBOUT
+ DEFB $78 ; KL
+ DEFB $85 ; graphic
+ DEFB $03 ; graphic
+ DEFB $83 ; graphic
+ DEFB $8B ; graphic
+ DEFB $91 ; inverse )
+ DEFB $90 ; inverse (
+ DEFB $8D ; inverse $
+ DEFB $86 ; graphic
+ DEFB $78 ; KL
+ DEFB $92 ; inverse >
+ DEFB $95 ; inverse +
+ DEFB $96 ; inverse -
+ DEFB $88 ; graphic
+
+; ------------------
+; THE <b><font color=#333388>'TOKEN'</font></b> TABLES
+; ------------------
+
+
+<a name="L094B"></a>;; <b>TOKENS</b>
+L0111: DEFB $0F+$80 ; '?'+$80
+ DEFB $0B,$0B+$80 ; ""
+ DEFB $26,$39+$80 ; AT
+ DEFB $39,$26,$27+$80 ; TAB
+ DEFB $0F+$80 ; '?'+$80
+ DEFB $28,$34,$29,$2A+$80 ; CODE
+ DEFB $3B,$26,$31+$80 ; VAL
+ DEFB $31,$2A,$33+$80 ; LEN
+ DEFB $38,$2E,$33+$80 ; SIN
+ DEFB $28,$34,$38+$80 ; COS
+ DEFB $39,$26,$33+$80 ; TAN
+ DEFB $26,$38,$33+$80 ; ASN
+ DEFB $26,$28,$38+$80 ; ACS
+ DEFB $26,$39,$33+$80 ; ATN
+ DEFB $31,$33+$80 ; LN
+ DEFB $2A,$3D,$35+$80 ; EXP
+ DEFB $2E,$33,$39+$80 ; INT
+ DEFB $38,$36,$37+$80 ; SQR
+ DEFB $38,$2C,$33+$80 ; SGN
+ DEFB $26,$27,$38+$80 ; ABS
+ DEFB $35,$2A,$2A,$30+$80 ; PEEK
+ DEFB $3A,$38,$37+$80 ; USR
+ DEFB $38,$39,$37,$0D+$80 ; STR$
+ DEFB $28,$2D,$37,$0D+$80 ; CHR$
+ DEFB $33,$34,$39+$80 ; NOT
+ DEFB $17,$17+$80 ; **
+ DEFB $34,$37+$80 ; OR
+ DEFB $26,$33,$29+$80 ; AND
+ DEFB $13,$14+$80 ; <=
+ DEFB $12,$14+$80 ; >=
+ DEFB $13,$12+$80 ; <>
+ DEFB $39,$2D,$2A,$33+$80 ; THEN
+ DEFB $39,$34+$80 ; TO
+ DEFB $38,$39,$2A,$35+$80 ; STEP
+ DEFB $31,$35,$37,$2E,$33,$39+$80 ; LPRINT
+ DEFB $31,$31,$2E,$38,$39+$80 ; LLIST
+ DEFB $38,$39,$34,$35+$80 ; STOP
+ DEFB $38,$31,$34,$3C+$80 ; SLOW
+ DEFB $2B,$26,$38,$39+$80 ; FAST
+ DEFB $33,$2A,$3C+$80 ; NEW
+ DEFB $38,$28,$37,$34,$31,$31+$80 ; SCROLL
+ DEFB $28,$34,$33,$39+$80 ; CONT
+ DEFB $29,$2E,$32+$80 ; DIM
+ DEFB $37,$2A,$32+$80 ; REM
+ DEFB $2B,$34,$37+$80 ; FOR
+ DEFB $2C,$34,$39,$34+$80 ; GOTO
+ DEFB $2C,$34,$38,$3A,$27+$80 ; GOSUB
+ DEFB $2E,$33,$35,$3A,$39+$80 ; INPUT
+ DEFB $31,$34,$26,$29+$80 ; LOAD
+ DEFB $31,$2E,$38,$39+$80 ; LIST
+ DEFB $31,$2A,$39+$80 ; LET
+ DEFB $35,$26,$3A,$38,$2A+$80 ; PAUSE
+ DEFB $33,$2A,$3D,$39+$80 ; NEXT
+ DEFB $35,$34,$30,$2A+$80 ; POKE
+ DEFB $35,$37,$2E,$33,$39+$80 ; PRINT
+ DEFB $35,$31,$34,$39+$80 ; PLOT
+ DEFB $37,$3A,$33+$80 ; RUN
+ DEFB $38,$26,$3B,$2A+$80 ; SAVE
+ DEFB $37,$26,$33,$29+$80 ; RAND
+ DEFB $2E,$2B+$80 ; IF
+ DEFB $28,$31,$38+$80 ; CLS
+ DEFB $3A,$33,$35,$31,$34,$39+$80 ; UNPLOT
+ DEFB $28,$31,$2A,$26,$37+$80 ; CLEAR
+ DEFB $37,$2A,$39,$3A,$37,$33+$80 ; RETURN
+ DEFB $28,$34,$35,$3E+$80 ; COPY
+ DEFB $37,$33,$29+$80 ; RND
+ DEFB $2E,$33,$30,$2A,$3E,$0D+$80 ; INKEY$
+ DEFB $35,$2E+$80 ; PI
+
+
+; ------------------------------
+; THE <b><font color=#333388>'LOAD-SAVE UPDATE'</font></b> ROUTINE
+; ------------------------------
+;
+;
+
+<a name="L01FC"></a>;; <b>LOAD/SAVE</b>
+L01FC: INC HL ;
+ EX DE,HL ;
+ LD HL,($4014) ; system variable edit line E_LINE.
+ SCF ; set carry flag
+ SBC HL,DE ;
+ EX DE,HL ;
+ RET NC ; return if more bytes to load/save.
+
+ POP HL ; else drop return address
+
+; ----------------------
+; THE <b><font color=#333388>'DISPLAY'</font></b> ROUTINES
+; ----------------------
+;
+;
+
+<a name="L0207"></a>;; <b>SLOW/FAST</b>
+L0207: LD HL,$403B ; Address the system variable CDFLAG.
+ LD A,(HL) ; Load value to the accumulator.
+ RLA ; rotate bit 6 to position 7.
+ XOR (HL) ; exclusive or with original bit 7.
+ RLA ; rotate result out to carry.
+ RET NC ; return if both bits were the same.
+
+; Now test if this really is a ZX81 or a ZX80 running the upgraded ROM.
+; The standard ZX80 did not have an NMI generator.
+
+ LD A,$7F ; Load accumulator with %011111111
+ EX AF,AF' ; save in AF'
+
+ LD B,$11 ; A counter within which an NMI should occur
+ ; if this is a ZX81.
+ OUT ($FE),A ; start the NMI generator.
+
+; Note that if this is a ZX81 then the NMI will increment AF'.
+
+<a name="L0216"></a>;; <b>LOOP-11</b>
+L0216: DJNZ <A href="#L0216">L0216</a> ; self loop to give the NMI a chance to kick in.
+ ; = 16*13 clock cycles + 8 = 216 clock cycles.
+
+ OUT ($FD),A ; Turn off the NMI generator.
+ EX AF,AF' ; bring back the AF' value.
+ RLA ; test bit 7.
+ JR NC,<A href="#L0226">L0226</a> ; forward, if bit 7 is still reset, to NO-SLOW.
+
+; If the AF' was incremented then the NMI generator works and SLOW mode can
+; be set.
+
+ SET 7,(HL) ; Indicate SLOW mode - Compute and Display.
+
+ PUSH AF ; * Save Main Registers
+ PUSH BC ; **
+ PUSH DE ; ***
+ PUSH HL ; ****
+
+ JR <A href="#L0229">L0229</a> ; skip forward - to DISPLAY-1.
+
+; ---
+
+<a name="L0226"></a>;; <b>NO-SLOW</b>
+L0226: RES 6,(HL) ; reset bit 6 of CDFLAG.
+ RET ; return.
+
+; -----------------------
+; THE <b><font color=#333388>'MAIN DISPLAY'</font></b> LOOP
+; -----------------------
+; This routine is executed once for every frame displayed.
+
+<a name="L0229"></a>;; <b>DISPLAY-1</b>
+L0229: LD HL,($4034) ; fetch two-byte system variable FRAMES.
+ DEC HL ; decrement frames counter.
+
+<a name="L022D"></a>;; <b>DISPLAY-P</b>
+L022D: LD A,$7F ; prepare a mask
+ AND H ; pick up bits 6-0 of H.
+ OR L ; and any bits of L.
+ LD A,H ; reload A with all bits of H for PAUSE test.
+
+; Note both branches must take the same time.
+
+ JR NZ,<A href="#L0237">L0237</a> ; (12/7) forward if bits 14-0 are not zero
+ ; to ANOTHER
+
+ RLA ; (4) test bit 15 of FRAMES.
+ JR <A href="#L0239">L0239</a> ; (12) forward with result to OVER-NC
+
+; ---
+
+<a name="L0237"></a>;; <b>ANOTHER</b>
+L0237: LD B,(HL) ; (7) <font color=#9900FF>Note.</font> Harmless Nonsensical Timing weight.
+ SCF ; (4) Set Carry Flag.
+
+; <font color=#9900FF>Note.</font> the branch to here takes either (12)(7)(4) cyles or (7)(4)(12) cycles.
+
+<a name="L0239"></a>;; <b>OVER-NC</b>
+L0239: LD H,A ; (4) set H to zero
+ LD ($4034),HL ; (16) update system variable FRAMES
+ RET NC ; (11/5) return if FRAMES is in use by PAUSE
+ ; command.
+
+<a name="L023E"></a>;; <b>DISPLAY-2</b>
+L023E: CALL <A href="#L02BB">L02BB</a> ; routine KEYBOARD gets the key row in H and
+ ; the column in L. Reading the ports also starts
+ ; the TV frame synchronization pulse. (VSYNC)
+
+ LD BC,($4025) ; fetch the last key values read from LAST_K
+ LD ($4025),HL ; update LAST_K with new values.
+
+ LD A,B ; load A with previous column - will be $FF if
+ ; there was no key.
+ ADD A,$02 ; adding two will set carry if no previous key.
+
+ SBC HL,BC ; subtract with the carry the two key values.
+
+; If the same key value has been returned twice then HL will be zero.
+
+ LD A,($4027) ; fetch system variable DEBOUNCE
+ OR H ; and OR with both bytes of the difference
+ OR L ; setting the zero flag for the upcoming branch.
+
+ LD E,B ; transfer the column value to E
+ LD B,$0B ; and load B with eleven
+
+ LD HL,$403B ; address system variable CDFLAG
+ RES 0,(HL) ; reset the rightmost bit of CDFLAG
+ JR NZ,<A href="#L0264">L0264</a> ; skip forward if debounce/diff >0 to NO-KEY
+
+ BIT 7,(HL) ; test compute and display bit of CDFLAG
+ SET 0,(HL) ; set the rightmost bit of CDFLAG.
+ RET Z ; return if bit 7 indicated fast mode.
+
+ DEC B ; (4) decrement the counter.
+ NOP ; (4) Timing - 4 clock cycles. ??
+ SCF ; (4) Set Carry Flag
+
+<a name="L0264"></a>;; <b>NO-KEY</b>
+L0264: LD HL,$4027 ; sv DEBOUNCE
+ CCF ; Complement Carry Flag
+ RL B ; rotate left B picking up carry
+ ; C<-76543210<-C
+
+<a name="L026A"></a>;; <b>LOOP-B</b>
+L026A: DJNZ <A href="#L026A">L026A</a> ; self-loop while B>0 to LOOP-B
+
+ LD B,(HL) ; fetch value of DEBOUNCE to B
+ LD A,E ; transfer column value
+ CP $FE ;
+ SBC A,A ;
+ LD B,$1F ;
+ OR (HL) ;
+ AND B ;
+ RRA ;
+ LD (HL),A ;
+
+ OUT ($FF),A ; end the TV frame synchronization pulse.
+
+ LD HL,($400C) ; (12) set HL to the Display File from D_FILE
+ SET 7,H ; (8) set bit 15 to address the echo display.
+
+ CALL <A href="#L0292">L0292</a> ; (17) routine DISPLAY-3 displays the top set
+ ; of blank lines.
+
+; ---------------------
+; THE <b><font color=#333388>'VIDEO-1'</font></b> ROUTINE
+; ---------------------
+
+<a name="L0281"></a>;; <b>R-IX-1</b>
+L0281: LD A,R ; (9) Harmless Nonsensical Timing or something
+ ; very clever?
+ LD BC,$1901 ; (10) 25 lines, 1 scanline in first.
+ LD A,$F5 ; (7) This value will be loaded into R and
+ ; ensures that the cycle starts at the right
+ ; part of the display - after 32nd character
+ ; position.
+
+ CALL <A href="#L02B5">L02B5</a> ; (17) routine DISPLAY-5 completes the current
+ ; blank line and then generates the display of
+ ; the live picture using INT interrupts
+ ; The final interrupt returns to the next
+ ; address.
+
+L028B: DEC HL ; point HL to the last NEWLINE/HALT.
+
+ CALL <A href="#L0292">L0292</a> ; routine DISPLAY-3 displays the bottom set of
+ ; blank lines.
+
+; ---
+
+<a name="L028F"></a>;; <b>R-IX-2</b>
+L028F: JP <A href="#L0229">L0229</a> ; JUMP back to DISPLAY-1
+
+; ---------------------------------
+; THE <b><font color=#333388>'DISPLAY BLANK LINES'</font></b> ROUTINE
+; ---------------------------------
+; This subroutine is called twice (see above) to generate first the blank
+; lines at the top of the television display and then the blank lines at the
+; bottom of the display.
+
+<a name="L0292"></a>;; <b>DISPLAY-3</b>
+L0292: POP IX ; pop the return address to IX register.
+ ; will be either L0281 or L028F - see above.
+
+ LD C,(IY+$28) ; load C with value of system constant MARGIN.
+ BIT 7,(IY+$3B) ; test CDFLAG for compute and display.
+ JR Z,<A href="#L02A9">L02A9</a> ; forward, with FAST mode, to DISPLAY-4
+
+ LD A,C ; move MARGIN to A - 31d or 55d.
+ NEG ; Negate
+ INC A ;
+ EX AF,AF' ; place negative count of blank lines in A'
+
+ OUT ($FE),A ; enable the NMI generator.
+
+ POP HL ; ****
+ POP DE ; ***
+ POP BC ; **
+ POP AF ; * Restore Main Registers
+
+ RET ; return - end of interrupt. Return is to
+ ; user's program - BASIC or machine code.
+ ; which will be interrupted by every NMI.
+
+; ------------------------
+; THE <b><font color=#333388>'FAST MODE'</font></b> ROUTINES
+; ------------------------
+
+<a name="L02A9"></a>;; <b>DISPLAY-4</b>
+L02A9: LD A,$FC ; (7) load A with first R delay value
+ LD B,$01 ; (7) one row only.
+
+ CALL <A href="#L02B5">L02B5</a> ; (17) routine DISPLAY-5
+
+ DEC HL ; (6) point back to the HALT.
+ EX (SP),HL ; (19) Harmless Nonsensical Timing if paired.
+ EX (SP),HL ; (19) Harmless Nonsensical Timing.
+ JP (IX) ; (8) to L0281 or L028F
+
+; --------------------------
+; THE <b><font color=#333388>'DISPLAY-5'</font></b> SUBROUTINE
+; --------------------------
+; This subroutine is called from SLOW mode and FAST mode to generate the
+; central TV picture. With SLOW mode the R register is incremented, with
+; each instruction, to $F7 by the time it completes. With fast mode, the
+; final R value will be $FF and an interrupt will occur as soon as the
+; Program Counter reaches the HALT. (24 clock cycles)
+
+<a name="L02B5"></a>;; <b>DISPLAY-5</b>
+L02B5: LD R,A ; (9) Load R from A. R = slow: $F5 fast: $FC
+ LD A,$DD ; (7) load future R value. $F6 $FD
+
+ EI ; (4) Enable Interrupts $F7 $FE
+
+ JP (HL) ; (4) jump to the echo display. $F8 $FF
+
+; ----------------------------------
+; THE <b><font color=#333388>'KEYBOARD SCANNING'</font></b> SUBROUTINE
+; ----------------------------------
+; The keyboard is read during the vertical sync interval while no video is
+; being displayed. Reading a port with address bit 0 low i.e. $FE starts the
+; vertical sync pulse.
+
+<a name="L02BB"></a>;; <b>KEYBOARD</b>
+L02BB: LD HL,$FFFF ; (16) prepare a buffer to take key.
+ LD BC,$FEFE ; (20) set BC to port $FEFE. The B register,
+ ; with its single reset bit also acts as
+ ; an 8-counter.
+ IN A,(C) ; (11) read the port - all 16 bits are put on
+ ; the address bus. Start VSYNC pulse.
+ OR $01 ; (7) set the rightmost bit so as to ignore
+ ; the SHIFT key.
+
+<a name="L02C5"></a>;; <b>EACH-LINE</b>
+L02C5: OR $E0 ; [7] OR %11100000
+ LD D,A ; [4] transfer to D.
+ CPL ; [4] complement - only bits 4-0 meaningful now.
+ CP $01 ; [7] sets carry if A is zero.
+ SBC A,A ; [4] $FF if $00 else zero.
+ OR B ; [7] $FF or port FE,FD,FB....
+ AND L ; [4] unless more than one key, L will still be
+ ; $FF. if more than one key is pressed then A is
+ ; now invalid.
+ LD L,A ; [4] transfer to L.
+
+; now consider the column identifier.
+
+ LD A,H ; [4] will be $FF if no previous keys.
+ AND D ; [4] 111xxxxx
+ LD H,A ; [4] transfer A to H
+
+; since only one key may be pressed, H will, if valid, be one of
+; 11111110, 11111101, 11111011, 11110111, 11101111
+; reading from the outer column, say Q, to the inner column, say T.
+
+ RLC B ; [8] rotate the 8-counter/port address.
+ ; sets carry if more to do.
+ IN A,(C) ; [10] read another half-row.
+ ; all five bits this time.
+
+ JR C,<A href="#L02C5">L02C5</a> ; [12](7) loop back, until done, to EACH-LINE
+
+; The last row read is SHIFT,Z,X,C,V for the second time.
+
+ RRA ; (4) test the shift key - carry will be reset
+ ; if the key is pressed.
+ RL H ; (8) rotate left H picking up the carry giving
+ ; column values -
+ ; $FD, $FB, $F7, $EF, $DF.
+ ; or $FC, $FA, $F6, $EE, $DE if shifted.
+
+; We now have H identifying the column and L identifying the row in the
+; keyboard matrix.
+
+; This is a good time to test if this is an American or British machine.
+; The US machine has an extra diode that causes bit 6 of a byte read from
+; a port to be reset.
+
+ RLA ; (4) compensate for the shift test.
+ RLA ; (4) rotate bit 7 out.
+ RLA ; (4) test bit 6.
+
+ SBC A,A ; (4) $FF or $00 {USA}
+ AND $18 ; (7) $18 or $00
+ ADD A,$1F ; (7) $37 or $1F
+
+; result is either 31 (USA) or 55 (UK) blank lines above and below the TV
+; picture.
+
+ LD ($4028),A ; (13) update system variable MARGIN
+
+ RET ; (10) return
+
+; ------------------------------
+; THE <b><font color=#333388>'SET FAST MODE'</font></b> SUBROUTINE
+; ------------------------------
+;
+;
+
+<a name="L02E7"></a>;; <b>SET-FAST</b>
+L02E7: BIT 7,(IY+$3B) ; sv CDFLAG
+ RET Z ;
+
+ HALT ; Wait for Interrupt
+ OUT ($FD),A ;
+ RES 7,(IY+$3B) ; sv CDFLAG
+ RET ; return.
+
+
+; --------------
+; THE <b><font color=#333388>'REPORT-F'</font></b>
+; --------------
+
+<a name="L02F4"></a>;; <b>REPORT-F</b>
+L02F4: RST 08H ; ERROR-1
+ DEFB $0E ; Error Report: No Program Name supplied.
+
+; --------------------------
+; THE <b><font color=#333388>'SAVE COMMAND'</font></b> ROUTINE
+; --------------------------
+;
+;
+
+<a name="L02F6"></a>;; <b>SAVE</b>
+L02F6: CALL <A href="#L03A8">L03A8</a> ; routine NAME
+ JR C,<A href="#L02F4">L02F4</a> ; back with null name to REPORT-F above.
+
+ EX DE,HL ;
+ LD DE,$12CB ; five seconds timing value
+
+<a name="L02FF"></a>;; <b>HEADER</b>
+L02FF: CALL <A href="#L0F46">L0F46</a> ; routine BREAK-1
+ JR NC,<A href="#L0332">L0332</a> ; to BREAK-2
+
+<a name="L0304"></a>;; <b>DELAY-1</b>
+L0304: DJNZ <A href="#L0304">L0304</a> ; to DELAY-1
+
+ DEC DE ;
+ LD A,D ;
+ OR E ;
+ JR NZ,<A href="#L02FF">L02FF</a> ; back for delay to HEADER
+
+<a name="L030B"></a>;; <b>OUT-NAME</b>
+L030B: CALL <A href="#L031E">L031E</a> ; routine OUT-BYTE
+ BIT 7,(HL) ; test for inverted bit.
+ INC HL ; address next character of name.
+ JR Z,<A href="#L030B">L030B</a> ; back if not inverted to OUT-NAME
+
+; now start saving the system variables onwards.
+
+ LD HL,$4009 ; set start of area to VERSN thereby
+ ; preserving RAMTOP etc.
+
+<a name="L0316"></a>;; <b>OUT-PROG</b>
+L0316: CALL <A href="#L031E">L031E</a> ; routine OUT-BYTE
+
+ CALL <A href="#L01FC">L01FC</a> ; routine LOAD/SAVE >>
+ JR <A href="#L0316">L0316</a> ; loop back to OUT-PROG
+
+; -------------------------
+; THE <b><font color=#333388>'OUT-BYTE'</font></b> SUBROUTINE
+; -------------------------
+; This subroutine outputs a byte a bit at a time to a domestic tape recorder.
+
+<a name="L031E"></a>;; <b>OUT-BYTE</b>
+L031E: LD E,(HL) ; fetch byte to be saved.
+ SCF ; set carry flag - as a marker.
+
+<a name="L0320"></a>;; <b>EACH-BIT</b>
+L0320: RL E ; C < 76543210 < C
+ RET Z ; return when the marker bit has passed
+ ; right through. >>
+
+ SBC A,A ; $FF if set bit or $00 with no carry.
+ AND $05 ; $05 $00
+ ADD A,$04 ; $09 $04
+ LD C,A ; transfer timer to C. a set bit has a longer
+ ; pulse than a reset bit.
+
+<a name="L0329"></a>;; <b>PULSES</b>
+L0329: OUT ($FF),A ; pulse to cassette.
+ LD B,$23 ; set timing constant
+
+<a name="L032D"></a>;; <b>DELAY-2</b>
+L032D: DJNZ <A href="#L032D">L032D</a> ; self-loop to DELAY-2
+
+ CALL <A href="#L0F46">L0F46</a> ; routine BREAK-1 test for BREAK key.
+
+<a name="L0332"></a>;; <b>BREAK-2</b>
+L0332: JR NC,<A href="#L03A6">L03A6</a> ; forward with break to REPORT-D
+
+ LD B,$1E ; set timing value.
+
+<a name="L0336"></a>;; <b>DELAY-3</b>
+L0336: DJNZ <A href="#L0336">L0336</a> ; self-loop to DELAY-3
+
+ DEC C ; decrement counter
+ JR NZ,<A href="#L0329">L0329</a> ; loop back to PULSES
+
+<a name="L033B"></a>;; <b>DELAY-4</b>
+L033B: AND A ; clear carry for next bit test.
+ DJNZ <A href="#L033B">L033B</a> ; self loop to DELAY-4 (B is zero - 256)
+
+ JR <A href="#L0320">L0320</a> ; loop back to EACH-BIT
+
+; --------------------------
+; THE <b><font color=#333388>'LOAD COMMAND'</font></b> ROUTINE
+; --------------------------
+;
+;
+
+<a name="L0340"></a>;; <b>LOAD</b>
+L0340: CALL <A href="#L03A8">L03A8</a> ; routine NAME
+
+; DE points to start of name in RAM.
+
+ RL D ; pick up carry
+ RRC D ; carry now in bit 7.
+
+<a name="L0347"></a>;; <b>NEXT-PROG</b>
+L0347: CALL <A href="#L034C">L034C</a> ; routine IN-BYTE
+ JR <A href="#L0347">L0347</a> ; loop to NEXT-PROG
+
+; ------------------------
+; THE <b><font color=#333388>'IN-BYTE'</font></b> SUBROUTINE
+; ------------------------
+
+<a name="L034C"></a>;; <b>IN-BYTE</b>
+L034C: LD C,$01 ; prepare an eight counter 00000001.
+
+<a name="L034E"></a>;; <b>NEXT-BIT</b>
+L034E: LD B,$00 ; set counter to 256
+
+<a name="L0350"></a>;; <b>BREAK-3</b>
+L0350: LD A,$7F ; read the keyboard row
+ IN A,($FE) ; with the SPACE key.
+
+ OUT ($FF),A ; output signal to screen.
+
+ RRA ; test for SPACE pressed.
+ JR NC,<A href="#L03A2">L03A2</a> ; forward if so to BREAK-4
+
+ RLA ; reverse above rotation
+ RLA ; test tape bit.
+ JR C,<A href="#L0385">L0385</a> ; forward if set to GET-BIT
+
+ DJNZ <A href="#L0350">L0350</a> ; loop back to BREAK-3
+
+ POP AF ; drop the return address.
+ CP D ; ugh.
+
+<a name="L0361"></a>;; <b>RESTART</b>
+L0361: JP NC,<A href="#L03E5">L03E5</a> ; jump forward to INITIAL if D is zero
+ ; to reset the system
+ ; if the tape signal has timed out for example
+ ; if the tape is stopped. Not just a simple
+ ; report as some system variables will have
+ ; been overwritten.
+
+ LD H,D ; else transfer the start of name
+ LD L,E ; to the HL register
+
+<a name="L0366"></a>;; <b>IN-NAME</b>
+L0366: CALL <A href="#L034C">L034C</a> ; routine IN-BYTE is sort of recursion for name
+ ; part. received byte in C.
+ BIT 7,D ; is name the null string ?
+ LD A,C ; transfer byte to A.
+ JR NZ,<A href="#L0371">L0371</a> ; forward with null string to MATCHING
+
+ CP (HL) ; else compare with string in memory.
+ JR NZ,<A href="#L0347">L0347</a> ; back with mis-match to NEXT-PROG
+ ; (seemingly out of subroutine but return
+ ; address has been dropped).
+
+
+<a name="L0371"></a>;; <b>MATCHING</b>
+L0371: INC HL ; address next character of name
+ RLA ; test for inverted bit.
+ JR NC,<A href="#L0366">L0366</a> ; back if not to IN-NAME
+
+; the name has been matched in full.
+; proceed to load the data but first increment the high byte of E_LINE, which
+; is one of the system variables to be loaded in. Since the low byte is loaded
+; before the high byte, it is possible that, at the in-between stage, a false
+; value could cause the load to end prematurely - see LOAD/SAVE check.
+
+ INC (IY+$15) ; increment system variable E_LINE_hi.
+ LD HL,$4009 ; start loading at system variable VERSN.
+
+<a name="L037B"></a>;; <b>IN-PROG</b>
+L037B: LD D,B ; set D to zero as indicator.
+ CALL <A href="#L034C">L034C</a> ; routine IN-BYTE loads a byte
+ LD (HL),C ; insert assembled byte in memory.
+ CALL <A href="#L01FC">L01FC</a> ; routine LOAD/SAVE >>
+ JR <A href="#L037B">L037B</a> ; loop back to IN-PROG
+
+; ---
+
+; this branch assembles a full byte before exiting normally
+; from the IN-BYTE subroutine.
+
+<a name="L0385"></a>;; <b>GET-BIT</b>
+L0385: PUSH DE ; save the
+ LD E,$94 ; timing value.
+
+<a name="L0388"></a>;; <b>TRAILER</b>
+L0388: LD B,$1A ; counter to twenty six.
+
+<a name="L038A"></a>;; <b>COUNTER</b>
+L038A: DEC E ; decrement the measuring timer.
+ IN A,($FE) ; read the
+ RLA ;
+ BIT 7,E ;
+ LD A,E ;
+ JR C,<A href="#L0388">L0388</a> ; loop back with carry to TRAILER
+
+ DJNZ <A href="#L038A">L038A</a> ; to COUNTER
+
+ POP DE ;
+ JR NZ,<A href="#L039C">L039C</a> ; to BIT-DONE
+
+ CP $56 ;
+ JR NC,<A href="#L034E">L034E</a> ; to NEXT-BIT
+
+<a name="L039C"></a>;; <b>BIT-DONE</b>
+L039C: CCF ; complement carry flag
+ RL C ;
+ JR NC,<A href="#L034E">L034E</a> ; to NEXT-BIT
+
+ RET ; return with full byte.
+
+; ---
+
+; if break is pressed while loading data then perform a reset.
+; if break pressed while waiting for program on tape then OK to break.
+
+<a name="L03A2"></a>;; <b>BREAK-4</b>
+L03A2: LD A,D ; transfer indicator to A.
+ AND A ; test for zero.
+ JR Z,<A href="#L0361">L0361</a> ; back if so to RESTART
+
+
+<a name="L03A6"></a>;; <b>REPORT-D</b>
+L03A6: RST 08H ; ERROR-1
+ DEFB $0C ; Error Report: BREAK - CONT repeats
+
+; -----------------------------
+; THE <b><font color=#333388>'PROGRAM NAME'</font></b> SUBROUTINE
+; -----------------------------
+;
+;
+
+<a name="L03A8"></a>;; <b>NAME</b>
+L03A8: CALL <A href="#L0F55">L0F55</a> ; routine SCANNING
+ LD A,($4001) ; sv FLAGS
+ ADD A,A ;
+ JP M,<A href="#L0D9A">L0D9A</a> ; to REPORT-C
+
+ POP HL ;
+ RET NC ;
+
+ PUSH HL ;
+ CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST
+ CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH
+ LD H,D ;
+ LD L,E ;
+ DEC C ;
+ RET M ;
+
+ ADD HL,BC ;
+ SET 7,(HL) ;
+ RET ;
+
+; -------------------------
+; THE <b><font color=#333388>'NEW'</font></b> COMMAND ROUTINE
+; -------------------------
+;
+;
+
+<a name="L03C3"></a>;; <b>NEW</b>
+L03C3: CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST
+ LD BC,($4004) ; fetch value of system variable RAMTOP
+ DEC BC ; point to last system byte.
+
+; -----------------------
+; THE <b><font color=#333388>'RAM CHECK'</font></b> ROUTINE
+; -----------------------
+;
+;
+
+<a name="L03CB"></a>;; <b>RAM-CHECK</b>
+L03CB: LD H,B ;
+ LD L,C ;
+ LD A,$3F ;
+
+<a name="L03CF"></a>;; <b>RAM-FILL</b>
+L03CF: LD (HL),$02 ;
+ DEC HL ;
+ CP H ;
+ JR NZ,<A href="#L03CF">L03CF</a> ; to RAM-FILL
+
+<a name="L03D5"></a>;; <b>RAM-READ</b>
+L03D5: AND A ;
+ SBC HL,BC ;
+ ADD HL,BC ;
+ INC HL ;
+ JR NC,<A href="#L03E2">L03E2</a> ; to SET-TOP
+
+ DEC (HL) ;
+ JR Z,<A href="#L03E2">L03E2</a> ; to SET-TOP
+
+ DEC (HL) ;
+ JR Z,<A href="#L03D5">L03D5</a> ; to RAM-READ
+
+<a name="L03E2"></a>;; <b>SET-TOP</b>
+L03E2: LD ($4004),HL ; set system variable RAMTOP to first byte
+ ; above the BASIC system area.
+
+; ----------------------------
+; THE <b><font color=#333388>'INITIALIZATION'</font></b> ROUTINE
+; ----------------------------
+;
+;
+
+<a name="L03E5"></a>;; <b>INITIAL</b>
+L03E5: LD HL,($4004) ; fetch system variable RAMTOP.
+ DEC HL ; point to last system byte.
+ LD (HL),$3E ; make GO SUB end-marker $3E - too high for
+ ; high order byte of line number.
+ ; (was $3F on ZX80)
+ DEC HL ; point to unimportant low-order byte.
+ LD SP,HL ; and initialize the stack-pointer to this
+ ; location.
+ DEC HL ; point to first location on the machine stack
+ DEC HL ; which will be filled by next CALL/PUSH.
+ LD ($4002),HL ; set the error stack pointer ERR_SP to
+ ; the base of the now empty machine stack.
+
+; Now set the I register so that the video hardware knows where to find the
+; character set. This ROM only uses the character set when printing to
+; the ZX Printer. The TV picture is formed by the external video hardware.
+; Consider also, that this 8K ROM can be retro-fitted to the ZX80 instead of
+; its original 4K ROM so the video hardware could be on the ZX80.
+
+ LD A,$1E ; address for this ROM is $1E00.
+ LD I,A ; set I register from A.
+ IM 1 ; select Z80 Interrupt Mode 1.
+
+ LD IY,$4000 ; set IY to the start of RAM so that the
+ ; system variables can be indexed.
+ LD (IY+$3B),$40 ; set CDFLAG 0100 0000. Bit 6 indicates
+ ; Compute nad Display required.
+
+ LD HL,$407D ; The first location after System Variables -
+ ; 16509 decimal.
+ LD ($400C),HL ; set system variable D_FILE to this value.
+ LD B,$19 ; prepare minimal screen of 24 NEWLINEs
+ ; following an initial NEWLINE.
+
+<a name="L0408"></a>;; <b>LINE</b>
+L0408: LD (HL),$76 ; insert NEWLINE (HALT instruction)
+ INC HL ; point to next location.
+ DJNZ <A href="#L0408">L0408</a> ; loop back for all twenty five to LINE
+
+ LD ($4010),HL ; set system variable VARS to next location
+
+ CALL <A href="#L149A">L149A</a> ; routine CLEAR sets $80 end-marker and the
+ ; dynamic memory pointers E_LINE, STKBOT and
+ ; STKEND.
+
+<a name="L0413"></a>;; <b>N/L-ONLY</b>
+L0413: CALL <A href="#L14AD">L14AD</a> ; routine CURSOR-IN inserts the cursor and
+ ; end-marker in the Edit Line also setting
+ ; size of lower display to two lines.
+
+ CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST selects COMPUTE and DISPLAY
+
+; ---------------------------
+; THE <b><font color=#333388>'BASIC LISTING'</font></b> SECTION
+; ---------------------------
+;
+;
+
+<a name="L0419"></a>;; <b>UPPER</b>
+L0419: CALL <A href="#L0A2A">L0A2A</a> ; routine CLS
+ LD HL,($400A) ; sv E_PPC_lo
+ LD DE,($4023) ; sv S_TOP_lo
+ AND A ;
+ SBC HL,DE ;
+ EX DE,HL ;
+ JR NC,<A href="#L042D">L042D</a> ; to ADDR-TOP
+
+ ADD HL,DE ;
+ LD ($4023),HL ; sv S_TOP_lo
+
+<a name="L042D"></a>;; <b>ADDR-TOP</b>
+L042D: CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR
+ JR Z,<A href="#L0433">L0433</a> ; to LIST-TOP
+
+ EX DE,HL ;
+
+<a name="L0433"></a>;; <b>LIST-TOP</b>
+L0433: CALL <A href="#L073E">L073E</a> ; routine LIST-PROG
+ DEC (IY+$1E) ; sv BERG
+ JR NZ,<A href="#L0472">L0472</a> ; to LOWER
+
+ LD HL,($400A) ; sv E_PPC_lo
+ CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR
+ LD HL,($4016) ; sv CH_ADD_lo
+ SCF ; Set Carry Flag
+ SBC HL,DE ;
+ LD HL,$4023 ; sv S_TOP_lo
+ JR NC,<A href="#L0457">L0457</a> ; to INC-LINE
+
+ EX DE,HL ;
+ LD A,(HL) ;
+ INC HL ;
+ LDI ;
+ LD (DE),A ;
+ JR <A href="#L0419">L0419</a> ; to UPPER
+
+; ---
+
+<a name="L0454"></a>;; <b>DOWN-KEY</b>
+L0454: LD HL,$400A ; sv E_PPC_lo
+
+<a name="L0457"></a>;; <b>INC-LINE</b>
+L0457: LD E,(HL) ;
+ INC HL ;
+ LD D,(HL) ;
+ PUSH HL ;
+ EX DE,HL ;
+ INC HL ;
+ CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR
+ CALL <A href="#L05BB">L05BB</a> ; routine LINE-NO
+ POP HL ;
+
+<a name="L0464"></a>;; <b>KEY-INPUT</b>
+L0464: BIT 5,(IY+$2D) ; sv FLAGX
+ JR NZ,<A href="#L0472">L0472</a> ; forward to LOWER
+
+ LD (HL),D ;
+ DEC HL ;
+ LD (HL),E ;
+ JR <A href="#L0419">L0419</a> ; to UPPER
+
+; ----------------------------
+; THE <b><font color=#333388>'EDIT LINE COPY'</font></b> SECTION
+; ----------------------------
+; This routine sets the edit line to just the cursor when
+; 1) There is not enough memory to edit a BASIC line.
+; 2) The edit key is used during input.
+; The entry point LOWER
+
+
+<a name="L046F"></a>;; <b>EDIT-INP</b>
+L046F: CALL <A href="#L14AD">L14AD</a> ; routine CURSOR-IN sets cursor only edit line.
+
+; ->
+
+<a name="L0472"></a>;; <b>LOWER</b>
+L0472: LD HL,($4014) ; fetch edit line start from E_LINE.
+
+<a name="L0475"></a>;; <b>EACH-CHAR</b>
+L0475: LD A,(HL) ; fetch a character from edit line.
+ CP $7E ; compare to the number marker.
+ JR NZ,<A href="#L0482">L0482</a> ; forward if not to END-LINE
+
+ LD BC,$0006 ; else six invisible bytes to be removed.
+ CALL <A href="#L0A60">L0A60</a> ; routine RECLAIM-2
+ JR <A href="#L0475">L0475</a> ; back to EACH-CHAR
+
+; ---
+
+<a name="L0482"></a>;; <b>END-LINE</b>
+L0482: CP $76 ;
+ INC HL ;
+ JR NZ,<A href="#L0475">L0475</a> ; to EACH-CHAR
+
+<a name="L0487"></a>;; <b>EDIT-LINE</b>
+L0487: CALL <A href="#L0537">L0537</a> ; routine CURSOR sets cursor K or L.
+
+<a name="L048A"></a>;; <b>EDIT-ROOM</b>
+L048A: CALL <A href="#L0A1F">L0A1F</a> ; routine LINE-ENDS
+ LD HL,($4014) ; sv E_LINE_lo
+ LD (IY+$00),$FF ; sv ERR_NR
+ CALL <A href="#L0766">L0766</a> ; routine COPY-LINE
+ BIT 7,(IY+$00) ; sv ERR_NR
+ JR NZ,<A href="#L04C1">L04C1</a> ; to DISPLAY-6
+
+ LD A,($4022) ; sv DF_SZ
+ CP $18 ;
+ JR NC,<A href="#L04C1">L04C1</a> ; to DISPLAY-6
+
+ INC A ;
+ LD ($4022),A ; sv DF_SZ
+ LD B,A ;
+ LD C,$01 ;
+ CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR
+ LD D,H ;
+ LD E,L ;
+ LD A,(HL) ;
+
+<a name="L04B1"></a>;; <b>FREE-LINE</b>
+L04B1: DEC HL ;
+ CP (HL) ;
+ JR NZ,<A href="#L04B1">L04B1</a> ; to FREE-LINE
+
+ INC HL ;
+ EX DE,HL ;
+ LD A,($4005) ; sv RAMTOP_hi
+ CP $4D ;
+ CALL C,<A href="#L0A5D">L0A5D</a> ; routine RECLAIM-1
+ JR <A href="#L048A">L048A</a> ; to EDIT-ROOM
+
+; --------------------------
+; THE <b><font color=#333388>'WAIT FOR KEY'</font></b> SECTION
+; --------------------------
+;
+;
+
+<a name="L04C1"></a>;; <b>DISPLAY-6</b>
+L04C1: LD HL,$0000 ;
+ LD ($4018),HL ; sv X_PTR_lo
+
+ LD HL,$403B ; system variable CDFLAG
+ BIT 7,(HL) ;
+
+ CALL Z,<A href="#L0229">L0229</a> ; routine DISPLAY-1
+
+<a name="L04CF"></a>;; <b>SLOW-DISP</b>
+L04CF: BIT 0,(HL) ;
+ JR Z,<A href="#L04CF">L04CF</a> ; to SLOW-DISP
+
+ LD BC,($4025) ; sv LAST_K
+ CALL <A href="#L0F4B">L0F4B</a> ; routine DEBOUNCE
+ CALL <A href="#L07BD">L07BD</a> ; routine DECODE
+
+ JR NC,<A href="#L0472">L0472</a> ; back to LOWER
+
+; -------------------------------
+; THE <b><font color=#333388>'KEYBOARD DECODING'</font></b> SECTION
+; -------------------------------
+; The decoded key value is in E and HL points to the position in the
+; key table. D contains zero.
+
+<a name="L04DF"></a>;; <b>K-DECODE</b>
+L04DF: LD A,($4006) ; Fetch value of system variable MODE
+ DEC A ; test the three values together
+
+ JP M,<A href="#L0508">L0508</a> ; forward, if was zero, to FETCH-2
+
+ JR NZ,<A href="#L04F7">L04F7</a> ; forward, if was 2, to FETCH-1
+
+; The original value was one and is now zero.
+
+ LD ($4006),A ; update the system variable MODE
+
+ DEC E ; reduce E to range $00 - $7F
+ LD A,E ; place in A
+ SUB $27 ; subtract 39 setting carry if range 00 - 38
+ JR C,<A href="#L04F2">L04F2</a> ; forward, if so, to FUNC-BASE
+
+ LD E,A ; else set E to reduced value
+
+<a name="L04F2"></a>;; <b>FUNC-BASE</b>
+L04F2: LD HL,<A href="#L00CC">L00CC</a> ; address of K-FUNCT table for function keys.
+ JR <A href="#L0505">L0505</a> ; forward to TABLE-ADD
+
+; ---
+
+<a name="L04F7"></a>;; <b>FETCH-1</b>
+L04F7: LD A,(HL) ;
+ CP $76 ;
+ JR Z,<A href="#L052B">L052B</a> ; to K/L-KEY
+
+ CP $40 ;
+ SET 7,A ;
+ JR C,<A href="#L051B">L051B</a> ; to ENTER
+
+ LD HL,$00C7 ; (expr reqd)
+
+<a name="L0505"></a>;; <b>TABLE-ADD</b>
+L0505: ADD HL,DE ;
+ JR <A href="#L0515">L0515</a> ; to FETCH-3
+
+; ---
+
+<a name="L0508"></a>;; <b>FETCH-2</b>
+L0508: LD A,(HL) ;
+ BIT 2,(IY+$01) ; sv FLAGS - K or L mode ?
+ JR NZ,<A href="#L0516">L0516</a> ; to TEST-CURS
+
+ ADD A,$C0 ;
+ CP $E6 ;
+ JR NC,<A href="#L0516">L0516</a> ; to TEST-CURS
+
+<a name="L0515"></a>;; <b>FETCH-3</b>
+L0515: LD A,(HL) ;
+
+<a name="L0516"></a>;; <b>TEST-CURS</b>
+L0516: CP $F0 ;
+ JP PE,<A href="#L052D">L052D</a> ; to KEY-SORT
+
+<a name="L051B"></a>;; <b>ENTER</b>
+L051B: LD E,A ;
+ CALL <A href="#L0537">L0537</a> ; routine CURSOR
+
+ LD A,E ;
+ CALL <A href="#L0526">L0526</a> ; routine ADD-CHAR
+
+<a name="L0523"></a>;; <b>BACK-NEXT</b>
+L0523: JP <A href="#L0472">L0472</a> ; back to LOWER
+
+; ------------------------------
+; THE <b><font color=#333388>'ADD CHARACTER'</font></b> SUBROUTINE
+; ------------------------------
+;
+;
+
+<a name="L0526"></a>;; <b>ADD-CHAR</b>
+L0526: CALL <A href="#L099B">L099B</a> ; routine ONE-SPACE
+ LD (DE),A ;
+ RET ;
+
+; -------------------------
+; THE <b><font color=#333388>'CURSOR KEYS'</font></b> ROUTINE
+; -------------------------
+;
+;
+
+<a name="L052B"></a>;; <b>K/L-KEY</b>
+L052B: LD A,$78 ;
+
+<a name="L052D"></a>;; <b>KEY-SORT</b>
+L052D: LD E,A ;
+ LD HL,$0482 ; base address of ED-KEYS (exp reqd)
+ ADD HL,DE ;
+ ADD HL,DE ;
+ LD C,(HL) ;
+ INC HL ;
+ LD B,(HL) ;
+ PUSH BC ;
+
+<a name="L0537"></a>;; <b>CURSOR</b>
+L0537: LD HL,($4014) ; sv E_LINE_lo
+ BIT 5,(IY+$2D) ; sv FLAGX
+ JR NZ,<A href="#L0556">L0556</a> ; to L-MODE
+
+<a name="L0540"></a>;; <b>K-MODE</b>
+L0540: RES 2,(IY+$01) ; sv FLAGS - Signal use K mode
+
+<a name="L0544"></a>;; <b>TEST-CHAR</b>
+L0544: LD A,(HL) ;
+ CP $7F ;
+ RET Z ; return
+
+ INC HL ;
+ CALL <A href="#L07B4">L07B4</a> ; routine NUMBER
+ JR Z,<A href="#L0544">L0544</a> ; to TEST-CHAR
+
+ CP $26 ;
+ JR C,<A href="#L0544">L0544</a> ; to TEST-CHAR
+
+ CP $DE ;
+ JR Z,<A href="#L0540">L0540</a> ; to K-MODE
+
+<a name="L0556"></a>;; <b>L-MODE</b>
+L0556: SET 2,(IY+$01) ; sv FLAGS - Signal use L mode
+ JR <A href="#L0544">L0544</a> ; to TEST-CHAR
+
+; --------------------------
+; THE <b><font color=#333388>'CLEAR-ONE'</font></b> SUBROUTINE
+; --------------------------
+;
+;
+
+<a name="L055C"></a>;; <b>CLEAR-ONE</b>
+L055C: LD BC,$0001 ;
+ JP <A href="#L0A60">L0A60</a> ; to RECLAIM-2
+
+
+
+; ------------------------
+; THE <b><font color=#333388>'EDITING KEYS'</font></b> TABLE
+; ------------------------
+;
+;
+
+<a name="L0562"></a>;; <b>ED-KEYS</b>
+L0562: DEFW <A href="#L059F">L059F</a> ; Address: $059F; Address: UP-KEY
+ DEFW <A href="#L0454">L0454</a> ; Address: $0454; Address: DOWN-KEY
+ DEFW <A href="#L0576">L0576</a> ; Address: $0576; Address: LEFT-KEY
+ DEFW <A href="#L057F">L057F</a> ; Address: $057F; Address: RIGHT-KEY
+ DEFW <A href="#L05AF">L05AF</a> ; Address: $05AF; Address: FUNCTION
+ DEFW <A href="#L05C4">L05C4</a> ; Address: $05C4; Address: EDIT-KEY
+ DEFW <A href="#L060C">L060C</a> ; Address: $060C; Address: N/L-KEY
+ DEFW <A href="#L058B">L058B</a> ; Address: $058B; Address: RUBOUT
+ DEFW <A href="#L05AF">L05AF</a> ; Address: $05AF; Address: FUNCTION
+ DEFW <A href="#L05AF">L05AF</a> ; Address: $05AF; Address: FUNCTION
+
+
+; -------------------------
+; THE <b><font color=#333388>'CURSOR LEFT'</font></b> ROUTINE
+; -------------------------
+;
+;
+
+<a name="L0576"></a>;; <b>LEFT-KEY</b>
+L0576: CALL <A href="#L0593">L0593</a> ; routine LEFT-EDGE
+ LD A,(HL) ;
+ LD (HL),$7F ;
+ INC HL ;
+ JR <A href="#L0588">L0588</a> ; to GET-CODE
+
+; --------------------------
+; THE <b><font color=#333388>'CURSOR RIGHT'</font></b> ROUTINE
+; --------------------------
+;
+;
+
+<a name="L057F"></a>;; <b>RIGHT-KEY</b>
+L057F: INC HL ;
+ LD A,(HL) ;
+ CP $76 ;
+ JR Z,<A href="#L059D">L059D</a> ; to ENDED-2
+
+ LD (HL),$7F ;
+ DEC HL ;
+
+<a name="L0588"></a>;; <b>GET-CODE</b>
+L0588: LD (HL),A ;
+
+<a name="L0589"></a>;; <b>ENDED-1</b>
+L0589: JR <A href="#L0523">L0523</a> ; to BACK-NEXT
+
+; --------------------
+; THE <b><font color=#333388>'RUBOUT'</font></b> ROUTINE
+; --------------------
+;
+;
+
+<a name="L058B"></a>;; <b>RUBOUT</b>
+L058B: CALL <A href="#L0593">L0593</a> ; routine LEFT-EDGE
+ CALL <A href="#L055C">L055C</a> ; routine CLEAR-ONE
+ JR <A href="#L0589">L0589</a> ; to ENDED-1
+
+; ------------------------
+; THE <b><font color=#333388>'ED-EDGE'</font></b> SUBROUTINE
+; ------------------------
+;
+;
+
+<a name="L0593"></a>;; <b>LEFT-EDGE</b>
+L0593: DEC HL ;
+ LD DE,($4014) ; sv E_LINE_lo
+ LD A,(DE) ;
+ CP $7F ;
+ RET NZ ;
+
+ POP DE ;
+
+<a name="L059D"></a>;; <b>ENDED-2</b>
+L059D: JR <A href="#L0589">L0589</a> ; to ENDED-1
+
+; -----------------------
+; THE <b><font color=#333388>'CURSOR UP'</font></b> ROUTINE
+; -----------------------
+;
+;
+
+<a name="L059F"></a>;; <b>UP-KEY</b>
+L059F: LD HL,($400A) ; sv E_PPC_lo
+ CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR
+ EX DE,HL ;
+ CALL <A href="#L05BB">L05BB</a> ; routine LINE-NO
+ LD HL,$400B ; point to system variable E_PPC_hi
+ JP <A href="#L0464">L0464</a> ; jump back to KEY-INPUT
+
+; --------------------------
+; THE <b><font color=#333388>'FUNCTION KEY'</font></b> ROUTINE
+; --------------------------
+;
+;
+
+<a name="L05AF"></a>;; <b>FUNCTION</b>
+L05AF: LD A,E ;
+ AND $07 ;
+ LD ($4006),A ; sv MODE
+ JR <A href="#L059D">L059D</a> ; back to ENDED-2
+
+; ------------------------------------
+; THE <b><font color=#333388>'COLLECT LINE NUMBER'</font></b> SUBROUTINE
+; ------------------------------------
+;
+;
+
+<a name="L05B7"></a>;; <b>ZERO-DE</b>
+L05B7: EX DE,HL ;
+ LD DE,<A href="#L04C1">L04C1</a> + 1 ; $04C2 - a location addressing two zeros.
+
+; ->
+
+<a name="L05BB"></a>;; <b>LINE-NO</b>
+L05BB: LD A,(HL) ;
+ AND $C0 ;
+ JR NZ,<A href="#L05B7">L05B7</a> ; to ZERO-DE
+
+ LD D,(HL) ;
+ INC HL ;
+ LD E,(HL) ;
+ RET ;
+
+; ----------------------
+; THE <b><font color=#333388>'EDIT KEY'</font></b> ROUTINE
+; ----------------------
+;
+;
+
+<a name="L05C4"></a>;; <b>EDIT-KEY</b>
+L05C4: CALL <A href="#L0A1F">L0A1F</a> ; routine LINE-ENDS clears lower display.
+
+ LD HL,<A href="#L046F">L046F</a> ; Address: EDIT-INP
+ PUSH HL ; ** is pushed as an error looping address.
+
+ BIT 5,(IY+$2D) ; test FLAGX
+ RET NZ ; indirect jump if in input mode
+ ; to <A href="#L046F">L046F</a>, EDIT-INP (begin again).
+
+;
+
+ LD HL,($4014) ; fetch E_LINE
+ LD ($400E),HL ; and use to update the screen cursor DF_CC
+
+; so now RST $10 will print the line numbers to the edit line instead of screen.
+; first make sure that no newline/out of screen can occur while sprinting the
+; line numbers to the edit line.
+
+ LD HL,$1821 ; prepare line 0, column 0.
+ LD ($4039),HL ; update S_POSN with these dummy values.
+
+ LD HL,($400A) ; fetch current line from E_PPC may be a
+ ; non-existent line e.g. last line deleted.
+ CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR gets address or that of
+ ; the following line.
+ CALL <A href="#L05BB">L05BB</a> ; routine LINE-NO gets line number if any in DE
+ ; leaving HL pointing at second low byte.
+
+ LD A,D ; test the line number for zero.
+ OR E ;
+ RET Z ; return if no line number - no program to edit.
+
+ DEC HL ; point to high byte.
+ CALL <A href="#L0AA5">L0AA5</a> ; routine OUT-NO writes number to edit line.
+
+ INC HL ; point to length bytes.
+ LD C,(HL) ; low byte to C.
+ INC HL ;
+ LD B,(HL) ; high byte to B.
+
+ INC HL ; point to first character in line.
+ LD DE,($400E) ; fetch display file cursor DF_CC
+
+ LD A,$7F ; prepare the cursor character.
+ LD (DE),A ; and insert in edit line.
+ INC DE ; increment intended destination.
+
+ PUSH HL ; * save start of BASIC.
+
+ LD HL,$001D ; set an overhead of 29 bytes.
+ ADD HL,DE ; add in the address of cursor.
+ ADD HL,BC ; add the length of the line.
+ SBC HL,SP ; subtract the stack pointer.
+
+ POP HL ; * restore pointer to start of BASIC.
+
+ RET NC ; return if not enough room to L046F EDIT-INP.
+ ; the edit key appears not to work.
+
+ LDIR ; else copy bytes from program to edit line.
+ ; <font color=#9900FF>Note.</font> hidden floating point forms are also
+ ; copied to edit line.
+
+ EX DE,HL ; transfer free location pointer to HL
+
+ POP DE ; ** remove address EDIT-INP from stack.
+
+ CALL <A href="#L14A6">L14A6</a> ; routine SET-STK-B sets STKEND from HL.
+
+ JR <A href="#L059D">L059D</a> ; back to ENDED-2 and after 3 more jumps
+ ; to <A href="#L0472">L0472</a>, LOWER.
+ ; <font color=#9900FF>Note.</font> The LOWER routine removes the hidden
+ ; floating-point numbers from the edit line.
+
+; -------------------------
+; THE <b><font color=#333388>'NEWLINE KEY'</font></b> ROUTINE
+; -------------------------
+;
+;
+
+<a name="L060C"></a>;; <b>N/L-KEY</b>
+L060C: CALL <A href="#L0A1F">L0A1F</a> ; routine LINE-ENDS
+
+ LD HL,<A href="#L0472">L0472</a> ; prepare address: LOWER
+
+ BIT 5,(IY+$2D) ; sv FLAGX
+ JR NZ,<A href="#L0629">L0629</a> ; to NOW-SCAN
+
+ LD HL,($4014) ; sv E_LINE_lo
+ LD A,(HL) ;
+ CP $FF ;
+ JR Z,<A href="#L0626">L0626</a> ; to STK-UPPER
+
+ CALL <A href="#L08E2">L08E2</a> ; routine CLEAR-PRB
+ CALL <A href="#L0A2A">L0A2A</a> ; routine CLS
+
+<a name="L0626"></a>;; <b>STK-UPPER</b>
+L0626: LD HL,<A href="#L0419">L0419</a> ; Address: UPPER
+
+<a name="L0629"></a>;; <b>NOW-SCAN</b>
+L0629: PUSH HL ; push routine address (LOWER or UPPER).
+ CALL <A href="#L0CBA">L0CBA</a> ; routine LINE-SCAN
+ POP HL ;
+ CALL <A href="#L0537">L0537</a> ; routine CURSOR
+ CALL <A href="#L055C">L055C</a> ; routine CLEAR-ONE
+ CALL <A href="#L0A73">L0A73</a> ; routine E-LINE-NO
+ JR NZ,<A href="#L064E">L064E</a> ; to N/L-INP
+
+ LD A,B ;
+ OR C ;
+ JP NZ,<A href="#L06E0">L06E0</a> ; to N/L-LINE
+
+ DEC BC ;
+ DEC BC ;
+ LD ($4007),BC ; sv PPC_lo
+ LD (IY+$22),$02 ; sv DF_SZ
+ LD DE,($400C) ; sv D_FILE_lo
+
+ JR <A href="#L0661">L0661</a> ; forward to TEST-NULL
+
+; ---
+
+<a name="L064E"></a>;; <b>N/L-INP</b>
+L064E: CP $76 ;
+ JR Z,<A href="#L0664">L0664</a> ; to N/L-NULL
+
+ LD BC,($4030) ; sv T_ADDR_lo
+ CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR
+ LD DE,($4029) ; sv NXTLIN_lo
+ LD (IY+$22),$02 ; sv DF_SZ
+
+<a name="L0661"></a>;; <b>TEST-NULL</b>
+L0661: RST 18H ; GET-CHAR
+ CP $76 ;
+
+<a name="L0664"></a>;; <b>N/L-NULL</b>
+L0664: JP Z,<A href="#L0413">L0413</a> ; to N/L-ONLY
+
+ LD (IY+$01),$80 ; sv FLAGS
+ EX DE,HL ;
+
+<a name="L066C"></a>;; <b>NEXT-LINE</b>
+L066C: LD ($4029),HL ; sv NXTLIN_lo
+ EX DE,HL ;
+ CALL <A href="#L004D">L004D</a> ; routine TEMP-PTR-2
+ CALL <A href="#L0CC1">L0CC1</a> ; routine LINE-RUN
+ RES 1,(IY+$01) ; sv FLAGS - Signal printer not in use
+ LD A,$C0 ;
+ LD (IY+$19),A ; sv X_PTR_lo
+ CALL <A href="#L14A3">L14A3</a> ; routine X-TEMP
+ RES 5,(IY+$2D) ; sv FLAGX
+ BIT 7,(IY+$00) ; sv ERR_NR
+ JR Z,<A href="#L06AE">L06AE</a> ; to STOP-LINE
+
+ LD HL,($4029) ; sv NXTLIN_lo
+ AND (HL) ;
+ JR NZ,<A href="#L06AE">L06AE</a> ; to STOP-LINE
+
+ LD D,(HL) ;
+ INC HL ;
+ LD E,(HL) ;
+ LD ($4007),DE ; sv PPC_lo
+ INC HL ;
+ LD E,(HL) ;
+ INC HL ;
+ LD D,(HL) ;
+ INC HL ;
+ EX DE,HL ;
+ ADD HL,DE ;
+ CALL <A href="#L0F46">L0F46</a> ; routine BREAK-1
+ JR C,<A href="#L066C">L066C</a> ; to NEXT-LINE
+
+ LD HL,$4000 ; sv ERR_NR
+ BIT 7,(HL) ;
+ JR Z,<A href="#L06AE">L06AE</a> ; to STOP-LINE
+
+ LD (HL),$0C ;
+
+<a name="L06AE"></a>;; <b>STOP-LINE</b>
+L06AE: BIT 7,(IY+$38) ; sv PR_CC
+ CALL Z,<A href="#L0871">L0871</a> ; routine COPY-BUFF
+ LD BC,$0121 ;
+ CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR
+ LD A,($4000) ; sv ERR_NR
+ LD BC,($4007) ; sv PPC_lo
+ INC A ;
+ JR Z,<A href="#L06D1">L06D1</a> ; to REPORT
+
+ CP $09 ;
+ JR NZ,<A href="#L06CA">L06CA</a> ; to CONTINUE
+
+ INC BC ;
+
+<a name="L06CA"></a>;; <b>CONTINUE</b>
+L06CA: LD ($402B),BC ; sv OLDPPC_lo
+ JR NZ,<A href="#L06D1">L06D1</a> ; to REPORT
+
+ DEC BC ;
+
+<a name="L06D1"></a>;; <b>REPORT</b>
+L06D1: CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE
+ LD A,$18 ;
+
+ RST 10H ; PRINT-A
+ CALL <A href="#L0A98">L0A98</a> ; routine OUT-NUM
+ CALL <A href="#L14AD">L14AD</a> ; routine CURSOR-IN
+ JP <A href="#L04C1">L04C1</a> ; to DISPLAY-6
+
+; ---
+
+<a name="L06E0"></a>;; <b>N/L-LINE</b>
+L06E0: LD ($400A),BC ; sv E_PPC_lo
+ LD HL,($4016) ; sv CH_ADD_lo
+ EX DE,HL ;
+ LD HL,<A href="#L0413">L0413</a> ; Address: N/L-ONLY
+ PUSH HL ;
+ LD HL,($401A) ; sv STKBOT_lo
+ SBC HL,DE ;
+ PUSH HL ;
+ PUSH BC ;
+ CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST
+ CALL <A href="#L0A2A">L0A2A</a> ; routine CLS
+ POP HL ;
+ CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR
+ JR NZ,<A href="#L0705">L0705</a> ; to COPY-OVER
+
+ CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE
+ CALL <A href="#L0A60">L0A60</a> ; routine RECLAIM-2
+
+<a name="L0705"></a>;; <b>COPY-OVER</b>
+L0705: POP BC ;
+ LD A,C ;
+ DEC A ;
+ OR B ;
+ RET Z ;
+
+ PUSH BC ;
+ INC BC ;
+ INC BC ;
+ INC BC ;
+ INC BC ;
+ DEC HL ;
+ CALL <A href="#L099E">L099E</a> ; routine MAKE-ROOM
+ CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST
+ POP BC ;
+ PUSH BC ;
+ INC DE ;
+ LD HL,($401A) ; sv STKBOT_lo
+ DEC HL ;
+ LDDR ; copy bytes
+ LD HL,($400A) ; sv E_PPC_lo
+ EX DE,HL ;
+ POP BC ;
+ LD (HL),B ;
+ DEC HL ;
+ LD (HL),C ;
+ DEC HL ;
+ LD (HL),E ;
+ DEC HL ;
+ LD (HL),D ;
+
+ RET ; return.
+
+; ---------------------------------------
+; THE <b><font color=#333388>'LIST'</font></b> AND 'LLIST' COMMAND ROUTINES
+; ---------------------------------------
+;
+;
+
+<a name="L072C"></a>;; <b>LLIST</b>
+L072C: SET 1,(IY+$01) ; sv FLAGS - signal printer in use
+
+<a name="L0730"></a>;; <b>LIST</b>
+L0730: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT
+
+ LD A,B ; fetch high byte of user-supplied line number.
+ AND $3F ; and crudely limit to range 1-16383.
+
+ LD H,A ;
+ LD L,C ;
+ LD ($400A),HL ; sv E_PPC_lo
+ CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR
+
+<a name="L073E"></a>;; <b>LIST-PROG</b>
+L073E: LD E,$00 ;
+
+<a name="L0740"></a>;; <b>UNTIL-END</b>
+L0740: CALL <A href="#L0745">L0745</a> ; routine OUT-LINE lists one line of BASIC
+ ; making an early return when the screen is
+ ; full or the end of program is reached. >>
+ JR <A href="#L0740">L0740</a> ; loop back to UNTIL-END
+
+; -----------------------------------
+; THE <b><font color=#333388>'PRINT A BASIC LINE'</font></b> SUBROUTINE
+; -----------------------------------
+;
+;
+
+<a name="L0745"></a>;; <b>OUT-LINE</b>
+L0745: LD BC,($400A) ; sv E_PPC_lo
+ CALL <A href="#L09EA">L09EA</a> ; routine CP-LINES
+ LD D,$92 ;
+ JR Z,<A href="#L0755">L0755</a> ; to TEST-END
+
+ LD DE,$0000 ;
+ RL E ;
+
+<a name="L0755"></a>;; <b>TEST-END</b>
+L0755: LD (IY+$1E),E ; sv BERG
+ LD A,(HL) ;
+ CP $40 ;
+ POP BC ;
+ RET NC ;
+
+ PUSH BC ;
+ CALL <A href="#L0AA5">L0AA5</a> ; routine OUT-NO
+ INC HL ;
+ LD A,D ;
+
+ RST 10H ; PRINT-A
+ INC HL ;
+ INC HL ;
+
+<a name="L0766"></a>;; <b>COPY-LINE</b>
+L0766: LD ($4016),HL ; sv CH_ADD_lo
+ SET 0,(IY+$01) ; sv FLAGS - Suppress leading space
+
+<a name="L076D"></a>;; <b>MORE-LINE</b>
+L076D: LD BC,($4018) ; sv X_PTR_lo
+ LD HL,($4016) ; sv CH_ADD_lo
+ AND A ;
+ SBC HL,BC ;
+ JR NZ,<A href="#L077C">L077C</a> ; to TEST-NUM
+
+ LD A,$B8 ;
+
+ RST 10H ; PRINT-A
+
+<a name="L077C"></a>;; <b>TEST-NUM</b>
+L077C: LD HL,($4016) ; sv CH_ADD_lo
+ LD A,(HL) ;
+ INC HL ;
+ CALL <A href="#L07B4">L07B4</a> ; routine NUMBER
+ LD ($4016),HL ; sv CH_ADD_lo
+ JR Z,<A href="#L076D">L076D</a> ; to MORE-LINE
+
+ CP $7F ;
+ JR Z,<A href="#L079D">L079D</a> ; to OUT-CURS
+
+ CP $76 ;
+ JR Z,<A href="#L07EE">L07EE</a> ; to OUT-CH
+
+ BIT 6,A ;
+ JR Z,<A href="#L079A">L079A</a> ; to NOT-TOKEN
+
+ CALL <A href="#L094B">L094B</a> ; routine TOKENS
+ JR <A href="#L076D">L076D</a> ; to MORE-LINE
+
+; ---
+
+
+<a name="L079A"></a>;; <b>NOT-TOKEN</b>
+L079A: RST 10H ; PRINT-A
+ JR <A href="#L076D">L076D</a> ; to MORE-LINE
+
+; ---
+
+<a name="L079D"></a>;; <b>OUT-CURS</b>
+L079D: LD A,($4006) ; Fetch value of system variable MODE
+ LD B,$AB ; Prepare an inverse [F] for function cursor.
+
+ AND A ; Test for zero -
+ JR NZ,<A href="#L07AA">L07AA</a> ; forward if not to FLAGS-2
+
+ LD A,($4001) ; Fetch system variable FLAGS.
+ LD B,$B0 ; Prepare an inverse [K] for keyword cursor.
+
+<a name="L07AA"></a>;; <b>FLAGS-2</b>
+L07AA: RRA ; 00000?00 -> 000000?0
+ RRA ; 000000?0 -> 0000000?
+ AND $01 ; 0000000? 0000000x
+
+ ADD A,B ; Possibly [F] -> [G] or [K] -> [L]
+
+ CALL <A href="#L07F5">L07F5</a> ; routine PRINT-SP prints character
+ JR <A href="#L076D">L076D</a> ; back to MORE-LINE
+
+; -----------------------
+; THE <b><font color=#333388>'NUMBER'</font></b> SUBROUTINE
+; -----------------------
+;
+;
+
+<a name="L07B4"></a>;; <b>NUMBER</b>
+L07B4: CP $7E ;
+ RET NZ ;
+
+ INC HL ;
+ INC HL ;
+ INC HL ;
+ INC HL ;
+ INC HL ;
+ RET ;
+
+; --------------------------------
+; THE <b><font color=#333388>'KEYBOARD DECODE'</font></b> SUBROUTINE
+; --------------------------------
+;
+;
+
+<a name="L07BD"></a>;; <b>DECODE</b>
+L07BD: LD D,$00 ;
+ SRA B ;
+ SBC A,A ;
+ OR $26 ;
+ LD L,$05 ;
+ SUB L ;
+
+<a name="L07C7"></a>;; <b>KEY-LINE</b>
+L07C7: ADD A,L ;
+ SCF ; Set Carry Flag
+ RR C ;
+ JR C,<A href="#L07C7">L07C7</a> ; to KEY-LINE
+
+ INC C ;
+ RET NZ ;
+
+ LD C,B ;
+ DEC L ;
+ LD L,$01 ;
+ JR NZ,<A href="#L07C7">L07C7</a> ; to KEY-LINE
+
+ LD HL,$007D ; (expr reqd)
+ LD E,A ;
+ ADD HL,DE ;
+ SCF ; Set Carry Flag
+ RET ;
+
+; -------------------------
+; THE <b><font color=#333388>'PRINTING'</font></b> SUBROUTINE
+; -------------------------
+;
+;
+
+<a name="L07DC"></a>;; <b>LEAD-SP</b>
+L07DC: LD A,E ;
+ AND A ;
+ RET M ;
+
+ JR <A href="#L07F1">L07F1</a> ; to PRINT-CH
+
+; ---
+
+<a name="L07E1"></a>;; <b>OUT-DIGIT</b>
+L07E1: XOR A ;
+
+<a name="L07E2"></a>;; <b>DIGIT-INC</b>
+L07E2: ADD HL,BC ;
+ INC A ;
+ JR C,<A href="#L07E2">L07E2</a> ; to DIGIT-INC
+
+ SBC HL,BC ;
+ DEC A ;
+ JR Z,<A href="#L07DC">L07DC</a> ; to LEAD-SP
+
+<a name="L07EB"></a>;; <b>OUT-CODE</b>
+L07EB: LD E,$1C ;
+ ADD A,E ;
+
+<a name="L07EE"></a>;; <b>OUT-CH</b>
+L07EE: AND A ;
+ JR Z,<A href="#L07F5">L07F5</a> ; to PRINT-SP
+
+<a name="L07F1"></a>;; <b>PRINT-CH</b>
+L07F1: RES 0,(IY+$01) ; update FLAGS - signal leading space permitted
+
+<a name="L07F5"></a>;; <b>PRINT-SP</b>
+L07F5: EXX ;
+ PUSH HL ;
+ BIT 1,(IY+$01) ; test FLAGS - is printer in use ?
+ JR NZ,<A href="#L0802">L0802</a> ; to LPRINT-A
+
+ CALL <A href="#L0808">L0808</a> ; routine ENTER-CH
+ JR <A href="#L0805">L0805</a> ; to PRINT-EXX
+
+; ---
+
+<a name="L0802"></a>;; <b>LPRINT-A</b>
+L0802: CALL <A href="#L0851">L0851</a> ; routine LPRINT-CH
+
+<a name="L0805"></a>;; <b>PRINT-EXX</b>
+L0805: POP HL ;
+ EXX ;
+ RET ;
+
+; ---
+
+<a name="L0808"></a>;; <b>ENTER-CH</b>
+L0808: LD D,A ;
+ LD BC,($4039) ; sv S_POSN_x
+ LD A,C ;
+ CP $21 ;
+ JR Z,<A href="#L082C">L082C</a> ; to TEST-LOW
+
+<a name="L0812"></a>;; <b>TEST-N/L</b>
+L0812: LD A,$76 ;
+ CP D ;
+ JR Z,<A href="#L0847">L0847</a> ; to WRITE-N/L
+
+ LD HL,($400E) ; sv DF_CC_lo
+ CP (HL) ;
+ LD A,D ;
+ JR NZ,<A href="#L083E">L083E</a> ; to WRITE-CH
+
+ DEC C ;
+ JR NZ,<A href="#L083A">L083A</a> ; to EXPAND-1
+
+ INC HL ;
+ LD ($400E),HL ; sv DF_CC_lo
+ LD C,$21 ;
+ DEC B ;
+ LD ($4039),BC ; sv S_POSN_x
+
+<a name="L082C"></a>;; <b>TEST-LOW</b>
+L082C: LD A,B ;
+ CP (IY+$22) ; sv DF_SZ
+ JR Z,<A href="#L0835">L0835</a> ; to REPORT-5
+
+ AND A ;
+ JR NZ,<A href="#L0812">L0812</a> ; to TEST-N/L
+
+<a name="L0835"></a>;; <b>REPORT-5</b>
+L0835: LD L,$04 ; 'No more room on screen'
+ JP <A href="#L0058">L0058</a> ; to ERROR-3
+
+; ---
+
+<a name="L083A"></a>;; <b>EXPAND-1</b>
+L083A: CALL <A href="#L099B">L099B</a> ; routine ONE-SPACE
+ EX DE,HL ;
+
+<a name="L083E"></a>;; <b>WRITE-CH</b>
+L083E: LD (HL),A ;
+ INC HL ;
+ LD ($400E),HL ; sv DF_CC_lo
+ DEC (IY+$39) ; sv S_POSN_x
+ RET ;
+
+; ---
+
+<a name="L0847"></a>;; <b>WRITE-N/L</b>
+L0847: LD C,$21 ;
+ DEC B ;
+ SET 0,(IY+$01) ; sv FLAGS - Suppress leading space
+ JP <A href="#L0918">L0918</a> ; to LOC-ADDR
+
+; --------------------------
+; THE <b><font color=#333388>'LPRINT-CH'</font></b> SUBROUTINE
+; --------------------------
+; This routine sends a character to the ZX-Printer placing the code for the
+; character in the Printer Buffer.
+; <font color=#9900FF>Note.</font> PR-CC contains the low byte of the buffer address. The high order byte
+; is always constant.
+
+
+<a name="L0851"></a>;; <b>LPRINT-CH</b>
+L0851: CP $76 ; compare to NEWLINE.
+ JR Z,<A href="#L0871">L0871</a> ; forward if so to COPY-BUFF
+
+ LD C,A ; take a copy of the character in C.
+ LD A,($4038) ; fetch print location from PR_CC
+ AND $7F ; ignore bit 7 to form true position.
+ CP $5C ; compare to 33rd location
+
+ LD L,A ; form low-order byte.
+ LD H,$40 ; the high-order byte is fixed.
+
+ CALL Z,<A href="#L0871">L0871</a> ; routine COPY-BUFF to send full buffer to
+ ; the printer if first 32 bytes full.
+ ; (this will reset HL to start.)
+
+ LD (HL),C ; place character at location.
+ INC L ; increment - will not cross a 256 boundary.
+ LD (IY+$38),L ; update system variable PR_CC
+ ; automatically resetting bit 7 to show that
+ ; the buffer is not empty.
+ RET ; return.
+
+; --------------------------
+; THE <b><font color=#333388>'COPY'</font></b> COMMAND ROUTINE
+; --------------------------
+; The full character-mapped screen is copied to the ZX-Printer.
+; All twenty-four text/graphic lines are printed.
+
+<a name="L0869"></a>;; <b>COPY</b>
+L0869: LD D,$16 ; prepare to copy twenty four text lines.
+ LD HL,($400C) ; set HL to start of display file from D_FILE.
+ INC HL ;
+ JR <A href="#L0876">L0876</a> ; forward to COPY*D
+
+; ---
+
+; A single character-mapped printer buffer is copied to the ZX-Printer.
+
+<a name="L0871"></a>;; <b>COPY-BUFF</b>
+L0871: LD D,$01 ; prepare to copy a single text line.
+ LD HL,$403C ; set HL to start of printer buffer PRBUFF.
+
+; both paths converge here.
+
+<a name="L0876"></a>;; <b>COPY*D</b>
+L0876: CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST
+
+ PUSH BC ; *** preserve BC throughout.
+ ; a pending character may be present
+ ; in C from LPRINT-CH
+
+<a name="L087A"></a>;; <b>COPY-LOOP</b>
+L087A: PUSH HL ; save first character of line pointer. (*)
+ XOR A ; clear accumulator.
+ LD E,A ; set pixel line count, range 0-7, to zero.
+
+; this inner loop deals with each horizontal pixel line.
+
+<a name="L087D"></a>;; <b>COPY-TIME</b>
+L087D: OUT ($FB),A ; bit 2 reset starts the printer motor
+ ; with an inactive stylus - bit 7 reset.
+ POP HL ; pick up first character of line pointer (*)
+ ; on inner loop.
+
+<a name="L0880"></a>;; <b>COPY-BRK</b>
+L0880: CALL <A href="#L0F46">L0F46</a> ; routine BREAK-1
+ JR C,<A href="#L088A">L088A</a> ; forward with no keypress to COPY-CONT
+
+; else A will hold 11111111 0
+
+ RRA ; 0111 1111
+ OUT ($FB),A ; stop ZX printer motor, de-activate stylus.
+
+<a name="L0888"></a>;; <b>REPORT-D2</b>
+L0888: RST 08H ; ERROR-1
+ DEFB $0C ; Error Report: BREAK - CONT repeats
+
+; ---
+
+<a name="L088A"></a>;; <b>COPY-CONT</b>
+L088A: IN A,($FB) ; read from printer port.
+ ADD A,A ; test bit 6 and 7
+ JP M,<A href="#L08DE">L08DE</a> ; jump forward with no printer to COPY-END
+
+ JR NC,<A href="#L0880">L0880</a> ; back if stylus not in position to COPY-BRK
+
+ PUSH HL ; save first character of line pointer (*)
+ PUSH DE ; ** preserve character line and pixel line.
+
+ LD A,D ; text line count to A?
+ CP $02 ; sets carry if last line.
+ SBC A,A ; now $FF if last line else zero.
+
+; now cleverly prepare a printer control mask setting bit 2 (later moved to 1)
+; of D to slow printer for the last two pixel lines ( E = 6 and 7)
+
+ AND E ; and with pixel line offset 0-7
+ RLCA ; shift to left.
+ AND E ; and again.
+ LD D,A ; store control mask in D.
+
+<a name="L089C"></a>;; <b>COPY-NEXT</b>
+L089C: LD C,(HL) ; load character from screen or buffer.
+ LD A,C ; save a copy in C for later inverse test.
+ INC HL ; update pointer for next time.
+ CP $76 ; is character a NEWLINE ?
+ JR Z,<A href="#L08C7">L08C7</a> ; forward, if so, to COPY-N/L
+
+ PUSH HL ; * else preserve the character pointer.
+
+ SLA A ; (?) multiply by two
+ ADD A,A ; multiply by four
+ ADD A,A ; multiply by eight
+
+ LD H,$0F ; load H with half the address of character set.
+ RL H ; now $1E or $1F (with carry)
+ ADD A,E ; add byte offset 0-7
+ LD L,A ; now HL addresses character source byte
+
+ RL C ; test character, setting carry if inverse.
+ SBC A,A ; accumulator now $00 if normal, $FF if inverse.
+
+ XOR (HL) ; combine with bit pattern at end or ROM.
+ LD C,A ; transfer the byte to C.
+ LD B,$08 ; count eight bits to output.
+
+<a name="L08B5"></a>;; <b>COPY-BITS</b>
+L08B5: LD A,D ; fetch speed control mask from D.
+ RLC C ; rotate a bit from output byte to carry.
+ RRA ; pick up in bit 7, speed bit to bit 1
+ LD H,A ; store aligned mask in H register.
+
+<a name="L08BA"></a>;; <b>COPY-WAIT</b>
+L08BA: IN A,($FB) ; read the printer port
+ RRA ; test for alignment signal from encoder.
+ JR NC,<A href="#L08BA">L08BA</a> ; loop if not present to COPY-WAIT
+
+ LD A,H ; control byte to A.
+ OUT ($FB),A ; and output to printer port.
+ DJNZ <A href="#L08B5">L08B5</a> ; loop for all eight bits to COPY-BITS
+
+ POP HL ; * restore character pointer.
+ JR <A href="#L089C">L089C</a> ; back for adjacent character line to COPY-NEXT
+
+; ---
+
+; A NEWLINE has been encountered either following a text line or as the
+; first character of the screen or printer line.
+
+<a name="L08C7"></a>;; <b>COPY-N/L</b>
+L08C7: IN A,($FB) ; read printer port.
+ RRA ; wait for encoder signal.
+ JR NC,<A href="#L08C7">L08C7</a> ; loop back if not to COPY-N/L
+
+ LD A,D ; transfer speed mask to A.
+ RRCA ; rotate speed bit to bit 1.
+ ; bit 7, stylus control is reset.
+ OUT ($FB),A ; set the printer speed.
+
+ POP DE ; ** restore character line and pixel line.
+ INC E ; increment pixel line 0-7.
+ BIT 3,E ; test if value eight reached.
+ JR Z,<A href="#L087D">L087D</a> ; back if not to COPY-TIME
+
+; eight pixel lines, a text line have been completed.
+
+ POP BC ; lose the now redundant first character
+ ; pointer
+ DEC D ; decrease text line count.
+ JR NZ,<A href="#L087A">L087A</a> ; back if not zero to COPY-LOOP
+
+ LD A,$04 ; stop the already slowed printer motor.
+ OUT ($FB),A ; output to printer port.
+
+<a name="L08DE"></a>;; <b>COPY-END</b>
+L08DE: CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST
+ POP BC ; *** restore preserved BC.
+
+; -------------------------------------
+; THE <b><font color=#333388>'CLEAR PRINTER BUFFER'</font></b> SUBROUTINE
+; -------------------------------------
+; This subroutine sets 32 bytes of the printer buffer to zero (space) and
+; the 33rd character is set to a NEWLINE.
+; This occurs after the printer buffer is sent to the printer but in addition
+; after the 24 lines of the screen are sent to the printer.
+; <font color=#9900FF>Note.</font> This is a logic error as the last operation does not involve the
+; buffer at all. Logically one should be able to use
+; 10 LPRINT "HELLO ";
+; 20 COPY
+; 30 LPRINT ; "WORLD"
+; and expect to see the entire greeting emerge from the printer.
+; Surprisingly this logic error was never discovered and although one can argue
+; if the above is a bug, the repetition of this error on the Spectrum was most
+; definitely a bug.
+; Since the printer buffer is fixed at the end of the system variables, and
+; the print position is in the range $3C - $5C, then bit 7 of the system
+; variable is set to show the buffer is empty and automatically reset when
+; the variable is updated with any print position - neat.
+
+<a name="L08E2"></a>;; <b>CLEAR-PRB</b>
+L08E2: LD HL,$405C ; address fixed end of PRBUFF
+ LD (HL),$76 ; place a newline at last position.
+ LD B,$20 ; prepare to blank 32 preceding characters.
+
+<a name="L08E9"></a>;; <b>PRB-BYTES</b>
+L08E9: DEC HL ; decrement address - could be DEC L.
+ LD (HL),$00 ; place a zero byte.
+ DJNZ <A href="#L08E9">L08E9</a> ; loop for all thirty-two to PRB-BYTES
+
+ LD A,L ; fetch character print position.
+ SET 7,A ; signal the printer buffer is clear.
+ LD ($4038),A ; update one-byte system variable PR_CC
+ RET ; return.
+
+; -------------------------
+; THE <b><font color=#333388>'PRINT AT'</font></b> SUBROUTINE
+; -------------------------
+;
+;
+
+<a name="L08F5"></a>;; <b>PRINT-AT</b>
+L08F5: LD A,$17 ;
+ SUB B ;
+ JR C,<A href="#L0905">L0905</a> ; to WRONG-VAL
+
+<a name="L08FA"></a>;; <b>TEST-VAL</b>
+L08FA: CP (IY+$22) ; sv DF_SZ
+ JP C,<A href="#L0835">L0835</a> ; to REPORT-5
+
+ INC A ;
+ LD B,A ;
+ LD A,$1F ;
+ SUB C ;
+
+<a name="L0905"></a>;; <b>WRONG-VAL</b>
+L0905: JP C,<A href="#L0EAD">L0EAD</a> ; to REPORT-B
+
+ ADD A,$02 ;
+ LD C,A ;
+
+<a name="L090B"></a>;; <b>SET-FIELD</b>
+L090B: BIT 1,(IY+$01) ; sv FLAGS - Is printer in use
+ JR Z,<A href="#L0918">L0918</a> ; to LOC-ADDR
+
+ LD A,$5D ;
+ SUB C ;
+ LD ($4038),A ; sv PR_CC
+ RET ;
+
+; ----------------------------
+; THE <b><font color=#333388>'LOCATE ADDRESS'</font></b> ROUTINE
+; ----------------------------
+;
+;
+
+<a name="L0918"></a>;; <b>LOC-ADDR</b>
+L0918: LD ($4039),BC ; sv S_POSN_x
+ LD HL,($4010) ; sv VARS_lo
+ LD D,C ;
+ LD A,$22 ;
+ SUB C ;
+ LD C,A ;
+ LD A,$76 ;
+ INC B ;
+
+<a name="L0927"></a>;; <b>LOOK-BACK</b>
+L0927: DEC HL ;
+ CP (HL) ;
+ JR NZ,<A href="#L0927">L0927</a> ; to LOOK-BACK
+
+ DJNZ <A href="#L0927">L0927</a> ; to LOOK-BACK
+
+ INC HL ;
+ CPIR ;
+ DEC HL ;
+ LD ($400E),HL ; sv DF_CC_lo
+ SCF ; Set Carry Flag
+ RET PO ;
+
+ DEC D ;
+ RET Z ;
+
+ PUSH BC ;
+ CALL <A href="#L099E">L099E</a> ; routine MAKE-ROOM
+ POP BC ;
+ LD B,C ;
+ LD H,D ;
+ LD L,E ;
+
+<a name="L0940"></a>;; <b>EXPAND-2</b>
+L0940: LD (HL),$00 ;
+ DEC HL ;
+ DJNZ <A href="#L0940">L0940</a> ; to EXPAND-2
+
+ EX DE,HL ;
+ INC HL ;
+ LD ($400E),HL ; sv DF_CC_lo
+ RET ;
+
+; ------------------------------
+; THE <b><font color=#333388>'EXPAND TOKENS'</font></b> SUBROUTINE
+; ------------------------------
+;
+;
+
+<a name="L094B"></a>;; <b>TOKENS</b>
+L094B: PUSH AF ;
+ CALL <A href="#L0975">L0975</a> ; routine TOKEN-ADD
+ JR NC,<A href="#L0959">L0959</a> ; to ALL-CHARS
+
+ BIT 0,(IY+$01) ; sv FLAGS - Leading space if set
+ JR NZ,<A href="#L0959">L0959</a> ; to ALL-CHARS
+
+ XOR A ;
+
+ RST 10H ; PRINT-A
+
+<a name="L0959"></a>;; <b>ALL-CHARS</b>
+L0959: LD A,(BC) ;
+ AND $3F ;
+
+ RST 10H ; PRINT-A
+ LD A,(BC) ;
+ INC BC ;
+ ADD A,A ;
+ JR NC,<A href="#L0959">L0959</a> ; to ALL-CHARS
+
+ POP BC ;
+ BIT 7,B ;
+ RET Z ;
+
+ CP $1A ;
+ JR Z,<A href="#L096D">L096D</a> ; to TRAIL-SP
+
+ CP $38 ;
+ RET C ;
+
+<a name="L096D"></a>;; <b>TRAIL-SP</b>
+L096D: XOR A ;
+ SET 0,(IY+$01) ; sv FLAGS - Suppress leading space
+ JP <A href="#L07F5">L07F5</a> ; to PRINT-SP
+
+; ---
+
+<a name="L0975"></a>;; <b>TOKEN-ADD</b>
+L0975: PUSH HL ;
+ LD HL,<A href="#L0111">L0111</a> ; Address of TOKENS
+ BIT 7,A ;
+ JR Z,<A href="#L097F">L097F</a> ; to TEST-HIGH
+
+ AND $3F ;
+
+<a name="L097F"></a>;; <b>TEST-HIGH</b>
+L097F: CP $43 ;
+ JR NC,<A href="#L0993">L0993</a> ; to FOUND
+
+ LD B,A ;
+ INC B ;
+
+<a name="L0985"></a>;; <b>WORDS</b>
+L0985: BIT 7,(HL) ;
+ INC HL ;
+ JR Z,<A href="#L0985">L0985</a> ; to WORDS
+
+ DJNZ <A href="#L0985">L0985</a> ; to WORDS
+
+ BIT 6,A ;
+ JR NZ,<A href="#L0992">L0992</a> ; to COMP-FLAG
+
+ CP $18 ;
+
+<a name="L0992"></a>;; <b>COMP-FLAG</b>
+L0992: CCF ; Complement Carry Flag
+
+<a name="L0993"></a>;; <b>FOUND</b>
+L0993: LD B,H ;
+ LD C,L ;
+ POP HL ;
+ RET NC ;
+
+ LD A,(BC) ;
+ ADD A,$E4 ;
+ RET ;
+
+; --------------------------
+; THE <b><font color=#333388>'ONE SPACE'</font></b> SUBROUTINE
+; --------------------------
+;
+;
+
+<a name="L099B"></a>;; <b>ONE-SPACE</b>
+L099B: LD BC,$0001 ;
+
+; --------------------------
+; THE <b><font color=#333388>'MAKE ROOM'</font></b> SUBROUTINE
+; --------------------------
+;
+;
+
+<a name="L099E"></a>;; <b>MAKE-ROOM</b>
+L099E: PUSH HL ;
+ CALL <A href="#L0EC5">L0EC5</a> ; routine TEST-ROOM
+ POP HL ;
+ CALL <A href="#L09AD">L09AD</a> ; routine POINTERS
+ LD HL,($401C) ; sv STKEND_lo
+ EX DE,HL ;
+ LDDR ; Copy Bytes
+ RET ;
+
+; -------------------------
+; THE <b><font color=#333388>'POINTERS'</font></b> SUBROUTINE
+; -------------------------
+;
+;
+
+<a name="L09AD"></a>;; <b>POINTERS</b>
+L09AD: PUSH AF ;
+ PUSH HL ;
+ LD HL,$400C ; sv D_FILE_lo
+ LD A,$09 ;
+
+<a name="L09B4"></a>;; <b>NEXT-PTR</b>
+L09B4: LD E,(HL) ;
+ INC HL ;
+ LD D,(HL) ;
+ EX (SP),HL ;
+ AND A ;
+ SBC HL,DE ;
+ ADD HL,DE ;
+ EX (SP),HL ;
+ JR NC,<A href="#L09C8">L09C8</a> ; to PTR-DONE
+
+ PUSH DE ;
+ EX DE,HL ;
+ ADD HL,BC ;
+ EX DE,HL ;
+ LD (HL),D ;
+ DEC HL ;
+ LD (HL),E ;
+ INC HL ;
+ POP DE ;
+
+<a name="L09C8"></a>;; <b>PTR-DONE</b>
+L09C8: INC HL ;
+ DEC A ;
+ JR NZ,<A href="#L09B4">L09B4</a> ; to NEXT-PTR
+
+ EX DE,HL ;
+ POP DE ;
+ POP AF ;
+ AND A ;
+ SBC HL,DE ;
+ LD B,H ;
+ LD C,L ;
+ INC BC ;
+ ADD HL,DE ;
+ EX DE,HL ;
+ RET ;
+
+; -----------------------------
+; THE <b><font color=#333388>'LINE ADDRESS'</font></b> SUBROUTINE
+; -----------------------------
+;
+;
+
+<a name="L09D8"></a>;; <b>LINE-ADDR</b>
+L09D8: PUSH HL ;
+ LD HL,$407D ;
+ LD D,H ;
+ LD E,L ;
+
+<a name="L09DE"></a>;; <b>NEXT-TEST</b>
+L09DE: POP BC ;
+ CALL <A href="#L09EA">L09EA</a> ; routine CP-LINES
+ RET NC ;
+
+ PUSH BC ;
+ CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE
+ EX DE,HL ;
+ JR <A href="#L09DE">L09DE</a> ; to NEXT-TEST
+
+; -------------------------------------
+; THE <b><font color=#333388>'COMPARE LINE NUMBERS'</font></b> SUBROUTINE
+; -------------------------------------
+;
+;
+
+<a name="L09EA"></a>;; <b>CP-LINES</b>
+L09EA: LD A,(HL) ;
+ CP B ;
+ RET NZ ;
+
+ INC HL ;
+ LD A,(HL) ;
+ DEC HL ;
+ CP C ;
+ RET ;
+
+; --------------------------------------
+; THE <b><font color=#333388>'NEXT LINE OR VARIABLE'</font></b> SUBROUTINE
+; --------------------------------------
+;
+;
+
+<a name="L09F2"></a>;; <b>NEXT-ONE</b>
+L09F2: PUSH HL ;
+ LD A,(HL) ;
+ CP $40 ;
+ JR C,<A href="#L0A0F">L0A0F</a> ; to LINES
+
+ BIT 5,A ;
+ JR Z,<A href="#L0A10">L0A10</a> ; forward to NEXT-O-4
+
+ ADD A,A ;
+ JP M,<A href="#L0A01">L0A01</a> ; to NEXT+FIVE
+
+ CCF ; Complement Carry Flag
+
+<a name="L0A01"></a>;; <b>NEXT+FIVE</b>
+L0A01: LD BC,$0005 ;
+ JR NC,<A href="#L0A08">L0A08</a> ; to NEXT-LETT
+
+ LD C,$11 ;
+
+<a name="L0A08"></a>;; <b>NEXT-LETT</b>
+L0A08: RLA ;
+ INC HL ;
+ LD A,(HL) ;
+ JR NC,<A href="#L0A08">L0A08</a> ; to NEXT-LETT
+
+ JR <A href="#L0A15">L0A15</a> ; to NEXT-ADD
+
+; ---
+
+<a name="L0A0F"></a>;; <b>LINES</b>
+L0A0F: INC HL ;
+
+<a name="L0A10"></a>;; <b>NEXT-O-4</b>
+L0A10: INC HL ;
+ LD C,(HL) ;
+ INC HL ;
+ LD B,(HL) ;
+ INC HL ;
+
+<a name="L0A15"></a>;; <b>NEXT-ADD</b>
+L0A15: ADD HL,BC ;
+ POP DE ;
+
+; ---------------------------
+; THE <b><font color=#333388>'DIFFERENCE'</font></b> SUBROUTINE
+; ---------------------------
+;
+;
+
+<a name="L0A17"></a>;; <b>DIFFER</b>
+L0A17: AND A ;
+ SBC HL,DE ;
+ LD B,H ;
+ LD C,L ;
+ ADD HL,DE ;
+ EX DE,HL ;
+ RET ;
+
+; --------------------------
+; THE <b><font color=#333388>'LINE-ENDS'</font></b> SUBROUTINE
+; --------------------------
+;
+;
+
+<a name="L0A1F"></a>;; <b>LINE-ENDS</b>
+L0A1F: LD B,(IY+$22) ; sv DF_SZ
+ PUSH BC ;
+ CALL <A href="#L0A2C">L0A2C</a> ; routine B-LINES
+ POP BC ;
+ DEC B ;
+ JR <A href="#L0A2C">L0A2C</a> ; to B-LINES
+
+; -------------------------
+; THE <b><font color=#333388>'CLS'</font></b> COMMAND ROUTINE
+; -------------------------
+;
+;
+
+<a name="L0A2A"></a>;; <b>CLS</b>
+L0A2A: LD B,$18 ;
+
+<a name="L0A2C"></a>;; <b>B-LINES</b>
+L0A2C: RES 1,(IY+$01) ; sv FLAGS - Signal printer not in use
+ LD C,$21 ;
+ PUSH BC ;
+ CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR
+ POP BC ;
+ LD A,($4005) ; sv RAMTOP_hi
+ CP $4D ;
+ JR C,<A href="#L0A52">L0A52</a> ; to COLLAPSED
+
+ SET 7,(IY+$3A) ; sv S_POSN_y
+
+<a name="L0A42"></a>;; <b>CLEAR-LOC</b>
+L0A42: XOR A ; prepare a space
+ CALL <A href="#L07F5">L07F5</a> ; routine PRINT-SP prints a space
+ LD HL,($4039) ; sv S_POSN_x
+ LD A,L ;
+ OR H ;
+ AND $7E ;
+ JR NZ,<A href="#L0A42">L0A42</a> ; to CLEAR-LOC
+
+ JP <A href="#L0918">L0918</a> ; to LOC-ADDR
+
+; ---
+
+<a name="L0A52"></a>;; <b>COLLAPSED</b>
+L0A52: LD D,H ;
+ LD E,L ;
+ DEC HL ;
+ LD C,B ;
+ LD B,$00 ;
+ LDIR ; Copy Bytes
+ LD HL,($4010) ; sv VARS_lo
+
+; ----------------------------
+; THE <b><font color=#333388>'RECLAIMING'</font></b> SUBROUTINES
+; ----------------------------
+;
+;
+
+<a name="L0A5D"></a>;; <b>RECLAIM-1</b>
+L0A5D: CALL <A href="#L0A17">L0A17</a> ; routine DIFFER
+
+<a name="L0A60"></a>;; <b>RECLAIM-2</b>
+L0A60: PUSH BC ;
+ LD A,B ;
+ CPL ;
+ LD B,A ;
+ LD A,C ;
+ CPL ;
+ LD C,A ;
+ INC BC ;
+ CALL <A href="#L09AD">L09AD</a> ; routine POINTERS
+ EX DE,HL ;
+ POP HL ;
+ ADD HL,DE ;
+ PUSH DE ;
+ LDIR ; Copy Bytes
+ POP HL ;
+ RET ;
+
+; ------------------------------
+; THE <b><font color=#333388>'E-LINE NUMBER'</font></b> SUBROUTINE
+; ------------------------------
+;
+;
+
+<a name="L0A73"></a>;; <b>E-LINE-NO</b>
+L0A73: LD HL,($4014) ; sv E_LINE_lo
+ CALL <A href="#L004D">L004D</a> ; routine TEMP-PTR-2
+
+ RST 18H ; GET-CHAR
+ BIT 5,(IY+$2D) ; sv FLAGX
+ RET NZ ;
+
+ LD HL,$405D ; sv MEM-0-1st
+ LD ($401C),HL ; sv STKEND_lo
+ CALL <A href="#L1548">L1548</a> ; routine INT-TO-FP
+ CALL <A href="#L158A">L158A</a> ; routine FP-TO-BC
+ JR C,<A href="#L0A91">L0A91</a> ; to NO-NUMBER
+
+ LD HL,$D8F0 ; value '-10000'
+ ADD HL,BC ;
+
+<a name="L0A91"></a>;; <b>NO-NUMBER</b>
+L0A91: JP C,<A href="#L0D9A">L0D9A</a> ; to REPORT-C
+
+ CP A ;
+ JP <A href="#L14BC">L14BC</a> ; routine SET-MIN
+
+; -------------------------------------------------
+; THE <b><font color=#333388>'REPORT AND LINE NUMBER'</font></b> PRINTING SUBROUTINES
+; -------------------------------------------------
+;
+;
+
+<a name="L0A98"></a>;; <b>OUT-NUM</b>
+L0A98: PUSH DE ;
+ PUSH HL ;
+ XOR A ;
+ BIT 7,B ;
+ JR NZ,<A href="#L0ABF">L0ABF</a> ; to UNITS
+
+ LD H,B ;
+ LD L,C ;
+ LD E,$FF ;
+ JR <A href="#L0AAD">L0AAD</a> ; to THOUSAND
+
+; ---
+
+<a name="L0AA5"></a>;; <b>OUT-NO</b>
+L0AA5: PUSH DE ;
+ LD D,(HL) ;
+ INC HL ;
+ LD E,(HL) ;
+ PUSH HL ;
+ EX DE,HL ;
+ LD E,$00 ; set E to leading space.
+
+<a name="L0AAD"></a>;; <b>THOUSAND</b>
+L0AAD: LD BC,$FC18 ;
+ CALL <A href="#L07E1">L07E1</a> ; routine OUT-DIGIT
+ LD BC,$FF9C ;
+ CALL <A href="#L07E1">L07E1</a> ; routine OUT-DIGIT
+ LD C,$F6 ;
+ CALL <A href="#L07E1">L07E1</a> ; routine OUT-DIGIT
+ LD A,L ;
+
+<a name="L0ABF"></a>;; <b>UNITS</b>
+L0ABF: CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE
+ POP HL ;
+ POP DE ;
+ RET ;
+
+; --------------------------
+; THE <b><font color=#333388>'UNSTACK-Z'</font></b> SUBROUTINE
+; --------------------------
+; This subroutine is used to return early from a routine when checking syntax.
+; On the ZX81 the same routines that execute commands also check the syntax
+; on line entry. This enables precise placement of the error marker in a line
+; that fails syntax.
+; The sequence CALL SYNTAX-Z ; RET Z can be replaced by a call to this routine
+; although it has not replaced every occurrence of the above two instructions.
+; Even on the ZX-80 this routine was not fully utilized.
+
+<a name="L0AC5"></a>;; <b>UNSTACK-Z</b>
+L0AC5: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z resets the ZERO flag if
+ ; checking syntax.
+ POP HL ; drop the return address.
+ RET Z ; return to previous calling routine if
+ ; checking syntax.
+
+ JP (HL) ; else jump to the continuation address in
+ ; the calling routine as RET would have done.
+
+; ----------------------------
+; THE <b><font color=#333388>'LPRINT'</font></b> COMMAND ROUTINE
+; ----------------------------
+;
+;
+
+<a name="L0ACB"></a>;; <b>LPRINT</b>
+L0ACB: SET 1,(IY+$01) ; sv FLAGS - Signal printer in use
+
+; ---------------------------
+; THE <b><font color=#333388>'PRINT'</font></b> COMMAND ROUTINE
+; ---------------------------
+;
+;
+
+<a name="L0ACF"></a>;; <b>PRINT</b>
+L0ACF: LD A,(HL) ;
+ CP $76 ;
+ JP Z,<A href="#L0B84">L0B84</a> ; to PRINT-END
+
+<a name="L0AD5"></a>;; <b>PRINT-1</b>
+L0AD5: SUB $1A ;
+ ADC A,$00 ;
+ JR Z,<A href="#L0B44">L0B44</a> ; to SPACING
+
+ CP $A7 ;
+ JR NZ,<A href="#L0AFA">L0AFA</a> ; to NOT-AT
+
+
+ RST 20H ; NEXT-CHAR
+ CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6
+ CP $1A ;
+ JP NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C
+
+
+ RST 20H ; NEXT-CHAR
+ CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6
+ CALL <A href="#L0B4E">L0B4E</a> ; routine SYNTAX-ON
+
+ RST 28H ;; FP-CALC
+ DEFB $01 ;;exchange
+ DEFB $34 ;;end-calc
+
+ CALL <A href="#L0BF5">L0BF5</a> ; routine STK-TO-BC
+ CALL <A href="#L08F5">L08F5</a> ; routine PRINT-AT
+ JR <A href="#L0B37">L0B37</a> ; to PRINT-ON
+
+; ---
+
+<a name="L0AFA"></a>;; <b>NOT-AT</b>
+L0AFA: CP $A8 ;
+ JR NZ,<A href="#L0B31">L0B31</a> ; to NOT-TAB
+
+
+ RST 20H ; NEXT-CHAR
+ CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6
+ CALL <A href="#L0B4E">L0B4E</a> ; routine SYNTAX-ON
+ CALL <A href="#L0C02">L0C02</a> ; routine STK-TO-A
+ JP NZ,<A href="#L0EAD">L0EAD</a> ; to REPORT-B
+
+ AND $1F ;
+ LD C,A ;
+ BIT 1,(IY+$01) ; sv FLAGS - Is printer in use
+ JR Z,<A href="#L0B1E">L0B1E</a> ; to TAB-TEST
+
+ SUB (IY+$38) ; sv PR_CC
+ SET 7,A ;
+ ADD A,$3C ;
+ CALL NC,<A href="#L0871">L0871</a> ; routine COPY-BUFF
+
+<a name="L0B1E"></a>;; <b>TAB-TEST</b>
+L0B1E: ADD A,(IY+$39) ; sv S_POSN_x
+ CP $21 ;
+ LD A,($403A) ; sv S_POSN_y
+ SBC A,$01 ;
+ CALL <A href="#L08FA">L08FA</a> ; routine TEST-VAL
+ SET 0,(IY+$01) ; sv FLAGS - Suppress leading space
+ JR <A href="#L0B37">L0B37</a> ; to PRINT-ON
+
+; ---
+
+<a name="L0B31"></a>;; <b>NOT-TAB</b>
+L0B31: CALL <A href="#L0F55">L0F55</a> ; routine SCANNING
+ CALL <A href="#L0B55">L0B55</a> ; routine PRINT-STK
+
+<a name="L0B37"></a>;; <b>PRINT-ON</b>
+L0B37: RST 18H ; GET-CHAR
+ SUB $1A ;
+ ADC A,$00 ;
+ JR Z,<A href="#L0B44">L0B44</a> ; to SPACING
+
+ CALL <A href="#L0D1D">L0D1D</a> ; routine CHECK-END
+ JP <A href="#L0B84">L0B84</a> ;;; to PRINT-END
+
+; ---
+
+<a name="L0B44"></a>;; <b>SPACING</b>
+L0B44: CALL NC,<A href="#L0B8B">L0B8B</a> ; routine FIELD
+
+ RST 20H ; NEXT-CHAR
+ CP $76 ;
+ RET Z ;
+
+ JP <A href="#L0AD5">L0AD5</a> ;;; to PRINT-1
+
+; ---
+
+<a name="L0B4E"></a>;; <b>SYNTAX-ON</b>
+L0B4E: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ RET NZ ;
+
+ POP HL ;
+ JR <A href="#L0B37">L0B37</a> ; to PRINT-ON
+
+; ---
+
+<a name="L0B55"></a>;; <b>PRINT-STK</b>
+L0B55: CALL <A href="#L0AC5">L0AC5</a> ; routine UNSTACK-Z
+ BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result?
+ CALL Z,<A href="#L13F8">L13F8</a> ; routine STK-FETCH
+ JR Z,<A href="#L0B6B">L0B6B</a> ; to PR-STR-4
+
+ JP <A href="#L15DB">L15DB</a> ; jump forward to PRINT-FP
+
+; ---
+
+<a name="L0B64"></a>;; <b>PR-STR-1</b>
+L0B64: LD A,$0B ;
+
+<a name="L0B66"></a>;; <b>PR-STR-2</b>
+L0B66: RST 10H ; PRINT-A
+
+<a name="L0B67"></a>;; <b>PR-STR-3</b>
+L0B67: LD DE,($4018) ; sv X_PTR_lo
+
+<a name="L0B6B"></a>;; <b>PR-STR-4</b>
+L0B6B: LD A,B ;
+ OR C ;
+ DEC BC ;
+ RET Z ;
+
+ LD A,(DE) ;
+ INC DE ;
+ LD ($4018),DE ; sv X_PTR_lo
+ BIT 6,A ;
+ JR Z,<A href="#L0B66">L0B66</a> ; to PR-STR-2
+
+ CP $C0 ;
+ JR Z,<A href="#L0B64">L0B64</a> ; to PR-STR-1
+
+ PUSH BC ;
+ CALL <A href="#L094B">L094B</a> ; routine TOKENS
+ POP BC ;
+ JR <A href="#L0B67">L0B67</a> ; to PR-STR-3
+
+; ---
+
+<a name="L0B84"></a>;; <b>PRINT-END</b>
+L0B84: CALL <A href="#L0AC5">L0AC5</a> ; routine UNSTACK-Z
+ LD A,$76 ;
+
+ RST 10H ; PRINT-A
+ RET ;
+
+; ---
+
+<a name="L0B8B"></a>;; <b>FIELD</b>
+L0B8B: CALL <A href="#L0AC5">L0AC5</a> ; routine UNSTACK-Z
+ SET 0,(IY+$01) ; sv FLAGS - Suppress leading space
+ XOR A ;
+
+ RST 10H ; PRINT-A
+ LD BC,($4039) ; sv S_POSN_x
+ LD A,C ;
+ BIT 1,(IY+$01) ; sv FLAGS - Is printer in use
+ JR Z,<A href="#L0BA4">L0BA4</a> ; to CENTRE
+
+ LD A,$5D ;
+ SUB (IY+$38) ; sv PR_CC
+
+<a name="L0BA4"></a>;; <b>CENTRE</b>
+L0BA4: LD C,$11 ;
+ CP C ;
+ JR NC,<A href="#L0BAB">L0BAB</a> ; to RIGHT
+
+ LD C,$01 ;
+
+<a name="L0BAB"></a>;; <b>RIGHT</b>
+L0BAB: CALL <A href="#L090B">L090B</a> ; routine SET-FIELD
+ RET ;
+
+; --------------------------------------
+; THE <b><font color=#333388>'PLOT AND UNPLOT'</font></b> COMMAND ROUTINES
+; --------------------------------------
+;
+;
+
+<a name="L0BAF"></a>;; <b>PLOT/UNP</b>
+L0BAF: CALL <A href="#L0BF5">L0BF5</a> ; routine STK-TO-BC
+ LD ($4036),BC ; sv COORDS_x
+ LD A,$2B ;
+ SUB B ;
+ JP C,<A href="#L0EAD">L0EAD</a> ; to REPORT-B
+
+ LD B,A ;
+ LD A,$01 ;
+ SRA B ;
+ JR NC,<A href="#L0BC5">L0BC5</a> ; to COLUMNS
+
+ LD A,$04 ;
+
+<a name="L0BC5"></a>;; <b>COLUMNS</b>
+L0BC5: SRA C ;
+ JR NC,<A href="#L0BCA">L0BCA</a> ; to FIND-ADDR
+
+ RLCA ;
+
+<a name="L0BCA"></a>;; <b>FIND-ADDR</b>
+L0BCA: PUSH AF ;
+ CALL <A href="#L08F5">L08F5</a> ; routine PRINT-AT
+ LD A,(HL) ;
+ RLCA ;
+ CP $10 ;
+ JR NC,<A href="#L0BDA">L0BDA</a> ; to TABLE-PTR
+
+ RRCA ;
+ JR NC,<A href="#L0BD9">L0BD9</a> ; to SQ-SAVED
+
+ XOR $8F ;
+
+<a name="L0BD9"></a>;; <b>SQ-SAVED</b>
+L0BD9: LD B,A ;
+
+<a name="L0BDA"></a>;; <b>TABLE-PTR</b>
+L0BDA: LD DE,<A href="#L0C9E">L0C9E</a> ; Address: P-UNPLOT
+ LD A,($4030) ; sv T_ADDR_lo
+ SUB E ;
+ JP M,<A href="#L0BE9">L0BE9</a> ; to PLOT
+
+ POP AF ;
+ CPL ;
+ AND B ;
+ JR <A href="#L0BEB">L0BEB</a> ; to UNPLOT
+
+; ---
+
+<a name="L0BE9"></a>;; <b>PLOT</b>
+L0BE9: POP AF ;
+ OR B ;
+
+<a name="L0BEB"></a>;; <b>UNPLOT</b>
+L0BEB: CP $08 ;
+ JR C,<A href="#L0BF1">L0BF1</a> ; to PLOT-END
+
+ XOR $8F ;
+
+<a name="L0BF1"></a>;; <b>PLOT-END</b>
+L0BF1: EXX ;
+
+ RST 10H ; PRINT-A
+ EXX ;
+ RET ;
+
+; ----------------------------
+; THE <b><font color=#333388>'STACK-TO-BC'</font></b> SUBROUTINE
+; ----------------------------
+;
+;
+
+<a name="L0BF5"></a>;; <b>STK-TO-BC</b>
+L0BF5: CALL <A href="#L0C02">L0C02</a> ; routine STK-TO-A
+ LD B,A ;
+ PUSH BC ;
+ CALL <A href="#L0C02">L0C02</a> ; routine STK-TO-A
+ LD E,C ;
+ POP BC ;
+ LD D,C ;
+ LD C,A ;
+ RET ;
+
+; ---------------------------
+; THE <b><font color=#333388>'STACK-TO-A'</font></b> SUBROUTINE
+; ---------------------------
+;
+;
+
+<a name="L0C02"></a>;; <b>STK-TO-A</b>
+L0C02: CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A
+ JP C,<A href="#L0EAD">L0EAD</a> ; to REPORT-B
+
+ LD C,$01 ;
+ RET Z ;
+
+ LD C,$FF ;
+ RET ;
+
+; -----------------------
+; THE <b><font color=#333388>'SCROLL'</font></b> SUBROUTINE
+; -----------------------
+;
+;
+
+<a name="L0C0E"></a>;; <b>SCROLL</b>
+L0C0E: LD B,(IY+$22) ; sv DF_SZ
+ LD C,$21 ;
+ CALL <A href="#L0918">L0918</a> ; routine LOC-ADDR
+ CALL <A href="#L099B">L099B</a> ; routine ONE-SPACE
+ LD A,(HL) ;
+ LD (DE),A ;
+ INC (IY+$3A) ; sv S_POSN_y
+ LD HL,($400C) ; sv D_FILE_lo
+ INC HL ;
+ LD D,H ;
+ LD E,L ;
+ CPIR ;
+ JP <A href="#L0A5D">L0A5D</a> ; to RECLAIM-1
+
+; -------------------
+; THE <b><font color=#333388>'SYNTAX'</font></b> TABLES
+; -------------------
+
+; i) The Offset table
+
+<a name="L0C29"></a>;; <b>offset-t</b>
+L0C29: DEFB <A href="#L0CB4">L0CB4</a> - $ ; 8B offset to; Address: P-LPRINT
+ DEFB <A href="#L0CB7">L0CB7</a> - $ ; 8D offset to; Address: P-LLIST
+ DEFB <A href="#L0C58">L0C58</a> - $ ; 2D offset to; Address: P-STOP
+ DEFB <A href="#L0CAB">L0CAB</a> - $ ; 7F offset to; Address: P-SLOW
+ DEFB <A href="#L0CAE">L0CAE</a> - $ ; 81 offset to; Address: P-FAST
+ DEFB <A href="#L0C77">L0C77</a> - $ ; 49 offset to; Address: P-NEW
+ DEFB <A href="#L0CA4">L0CA4</a> - $ ; 75 offset to; Address: P-SCROLL
+ DEFB <A href="#L0C8F">L0C8F</a> - $ ; 5F offset to; Address: P-CONT
+ DEFB <A href="#L0C71">L0C71</a> - $ ; 40 offset to; Address: P-DIM
+ DEFB <A href="#L0C74">L0C74</a> - $ ; 42 offset to; Address: P-REM
+ DEFB <A href="#L0C5E">L0C5E</a> - $ ; 2B offset to; Address: P-FOR
+ DEFB <A href="#L0C4B">L0C4B</a> - $ ; 17 offset to; Address: P-GOTO
+ DEFB <A href="#L0C54">L0C54</a> - $ ; 1F offset to; Address: P-GOSUB
+ DEFB <A href="#L0C6D">L0C6D</a> - $ ; 37 offset to; Address: P-INPUT
+ DEFB <A href="#L0C89">L0C89</a> - $ ; 52 offset to; Address: P-LOAD
+ DEFB <A href="#L0C7D">L0C7D</a> - $ ; 45 offset to; Address: P-LIST
+ DEFB <A href="#L0C48">L0C48</a> - $ ; 0F offset to; Address: P-LET
+ DEFB <A href="#L0CA7">L0CA7</a> - $ ; 6D offset to; Address: P-PAUSE
+ DEFB <A href="#L0C66">L0C66</a> - $ ; 2B offset to; Address: P-NEXT
+ DEFB <A href="#L0C80">L0C80</a> - $ ; 44 offset to; Address: P-POKE
+ DEFB <A href="#L0C6A">L0C6A</a> - $ ; 2D offset to; Address: P-PRINT
+ DEFB <A href="#L0C98">L0C98</a> - $ ; 5A offset to; Address: P-PLOT
+ DEFB <A href="#L0C7A">L0C7A</a> - $ ; 3B offset to; Address: P-RUN
+ DEFB <A href="#L0C8C">L0C8C</a> - $ ; 4C offset to; Address: P-SAVE
+ DEFB <A href="#L0C86">L0C86</a> - $ ; 45 offset to; Address: P-RAND
+ DEFB <A href="#L0C4F">L0C4F</a> - $ ; 0D offset to; Address: P-IF
+ DEFB <A href="#L0C95">L0C95</a> - $ ; 52 offset to; Address: P-CLS
+ DEFB <A href="#L0C9E">L0C9E</a> - $ ; 5A offset to; Address: P-UNPLOT
+ DEFB <A href="#L0C92">L0C92</a> - $ ; 4D offset to; Address: P-CLEAR
+ DEFB <A href="#L0C5B">L0C5B</a> - $ ; 15 offset to; Address: P-RETURN
+ DEFB <A href="#L0CB1">L0CB1</a> - $ ; 6A offset to; Address: P-COPY
+
+; ii) The parameter table.
+
+
+<a name="L0C48"></a>;; <b>P-LET</b>
+L0C48: DEFB $01 ; Class-01 - A variable is required.
+ DEFB $14 ; Separator: '='
+ DEFB $02 ; Class-02 - An expression, numeric or string,
+ ; must follow.
+
+<a name="L0C4B"></a>;; <b>P-GOTO</b>
+L0C4B: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0E81">L0E81</a> ; Address: $0E81; Address: GOTO
+
+<a name="L0C4F"></a>;; <b>P-IF</b>
+L0C4F: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $DE ; Separator: 'THEN'
+ DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW <A href="#L0DAB">L0DAB</a> ; Address: $0DAB; Address: IF
+
+<a name="L0C54"></a>;; <b>P-GOSUB</b>
+L0C54: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0EB5">L0EB5</a> ; Address: $0EB5; Address: GOSUB
+
+<a name="L0C58"></a>;; <b>P-STOP</b>
+L0C58: DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0CDC">L0CDC</a> ; Address: $0CDC; Address: STOP
+
+<a name="L0C5B"></a>;; <b>P-RETURN</b>
+L0C5B: DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0ED8">L0ED8</a> ; Address: $0ED8; Address: RETURN
+
+<a name="L0C5E"></a>;; <b>P-FOR</b>
+L0C5E: DEFB $04 ; Class-04 - A single character variable must
+ ; follow.
+ DEFB $14 ; Separator: '='
+ DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $DF ; Separator: 'TO'
+ DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW <A href="#L0DB9">L0DB9</a> ; Address: $0DB9; Address: FOR
+
+<a name="L0C66"></a>;; <b>P-NEXT</b>
+L0C66: DEFB $04 ; Class-04 - A single character variable must
+ ; follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0E2E">L0E2E</a> ; Address: $0E2E; Address: NEXT
+
+<a name="L0C6A"></a>;; <b>P-PRINT</b>
+L0C6A: DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW <A href="#L0ACF">L0ACF</a> ; Address: $0ACF; Address: PRINT
+
+<a name="L0C6D"></a>;; <b>P-INPUT</b>
+L0C6D: DEFB $01 ; Class-01 - A variable is required.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0EE9">L0EE9</a> ; Address: $0EE9; Address: INPUT
+
+<a name="L0C71"></a>;; <b>P-DIM</b>
+L0C71: DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW <A href="#L1409">L1409</a> ; Address: $1409; Address: DIM
+
+<a name="L0C74"></a>;; <b>P-REM</b>
+L0C74: DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW <A href="#L0D6A">L0D6A</a> ; Address: $0D6A; Address: REM
+
+<a name="L0C77"></a>;; <b>P-NEW</b>
+L0C77: DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L03C3">L03C3</a> ; Address: $03C3; Address: NEW
+
+<a name="L0C7A"></a>;; <b>P-RUN</b>
+L0C7A: DEFB $03 ; Class-03 - A numeric expression may follow
+ ; else default to zero.
+ DEFW <A href="#L0EAF">L0EAF</a> ; Address: $0EAF; Address: RUN
+
+<a name="L0C7D"></a>;; <b>P-LIST</b>
+L0C7D: DEFB $03 ; Class-03 - A numeric expression may follow
+ ; else default to zero.
+ DEFW <A href="#L0730">L0730</a> ; Address: $0730; Address: LIST
+
+<a name="L0C80"></a>;; <b>P-POKE</b>
+L0C80: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $1A ; Separator: ','
+ DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0E92">L0E92</a> ; Address: $0E92; Address: POKE
+
+<a name="L0C86"></a>;; <b>P-RAND</b>
+L0C86: DEFB $03 ; Class-03 - A numeric expression may follow
+ ; else default to zero.
+ DEFW <A href="#L0E6C">L0E6C</a> ; Address: $0E6C; Address: RAND
+
+<a name="L0C89"></a>;; <b>P-LOAD</b>
+L0C89: DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW <A href="#L0340">L0340</a> ; Address: $0340; Address: LOAD
+
+<a name="L0C8C"></a>;; <b>P-SAVE</b>
+L0C8C: DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW <A href="#L02F6">L02F6</a> ; Address: $02F6; Address: SAVE
+
+<a name="L0C8F"></a>;; <b>P-CONT</b>
+L0C8F: DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0E7C">L0E7C</a> ; Address: $0E7C; Address: CONT
+
+<a name="L0C92"></a>;; <b>P-CLEAR</b>
+L0C92: DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L149A">L149A</a> ; Address: $149A; Address: CLEAR
+
+<a name="L0C95"></a>;; <b>P-CLS</b>
+L0C95: DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0A2A">L0A2A</a> ; Address: $0A2A; Address: CLS
+
+<a name="L0C98"></a>;; <b>P-PLOT</b>
+L0C98: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $1A ; Separator: ','
+ DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0BAF">L0BAF</a> ; Address: $0BAF; Address: PLOT/UNP
+
+<a name="L0C9E"></a>;; <b>P-UNPLOT</b>
+L0C9E: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $1A ; Separator: ','
+ DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0BAF">L0BAF</a> ; Address: $0BAF; Address: PLOT/UNP
+
+<a name="L0CA4"></a>;; <b>P-SCROLL</b>
+L0CA4: DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0C0E">L0C0E</a> ; Address: $0C0E; Address: SCROLL
+
+<a name="L0CA7"></a>;; <b>P-PAUSE</b>
+L0CA7: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0F32">L0F32</a> ; Address: $0F32; Address: PAUSE
+
+<a name="L0CAB"></a>;; <b>P-SLOW</b>
+L0CAB: DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0F2B">L0F2B</a> ; Address: $0F2B; Address: SLOW
+
+<a name="L0CAE"></a>;; <b>P-FAST</b>
+L0CAE: DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0F23">L0F23</a> ; Address: $0F23; Address: FAST
+
+<a name="L0CB1"></a>;; <b>P-COPY</b>
+L0CB1: DEFB $00 ; Class-00 - No further operands.
+ DEFW <A href="#L0869">L0869</a> ; Address: $0869; Address: COPY
+
+<a name="L0CB4"></a>;; <b>P-LPRINT</b>
+L0CB4: DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW <A href="#L0ACB">L0ACB</a> ; Address: $0ACB; Address: LPRINT
+
+<a name="L0CB7"></a>;; <b>P-LLIST</b>
+L0CB7: DEFB $03 ; Class-03 - A numeric expression may follow
+ ; else default to zero.
+ DEFW <A href="#L072C">L072C</a> ; Address: $072C; Address: LLIST
+
+
+; ---------------------------
+; THE <b><font color=#333388>'LINE SCANNING'</font></b> ROUTINE
+; ---------------------------
+;
+;
+
+<a name="L0CBA"></a>;; <b>LINE-SCAN</b>
+L0CBA: LD (IY+$01),$01 ; sv FLAGS
+ CALL <A href="#L0A73">L0A73</a> ; routine E-LINE-NO
+
+<a name="L0CC1"></a>;; <b>LINE-RUN</b>
+L0CC1: CALL <A href="#L14BC">L14BC</a> ; routine SET-MIN
+ LD HL,$4000 ; sv ERR_NR
+ LD (HL),$FF ;
+ LD HL,$402D ; sv FLAGX
+ BIT 5,(HL) ;
+ JR Z,<A href="#L0CDE">L0CDE</a> ; to LINE-NULL
+
+ CP $E3 ; 'STOP' ?
+ LD A,(HL) ;
+ JP NZ,<A href="#L0D6F">L0D6F</a> ; to INPUT-REP
+
+ CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ RET Z ;
+
+
+ RST 08H ; ERROR-1
+ DEFB $0C ; Error Report: BREAK - CONT repeats
+
+
+; --------------------------
+; THE <b><font color=#333388>'STOP'</font></b> COMMAND ROUTINE
+; --------------------------
+;
+;
+
+<a name="L0CDC"></a>;; <b>STOP</b>
+L0CDC: RST 08H ; ERROR-1
+ DEFB $08 ; Error Report: STOP statement
+
+; ---
+
+; the interpretation of a line continues with a check for just spaces
+; followed by a carriage return.
+; The IF command also branches here with a true value to execute the
+; statement after the THEN but the statement can be null so
+; 10 IF 1 = 1 THEN
+; passes syntax (on all ZX computers).
+
+<a name="L0CDE"></a>;; <b>LINE-NULL</b>
+L0CDE: RST 18H ; GET-CHAR
+ LD B,$00 ; prepare to index - early.
+ CP $76 ; compare to NEWLINE.
+ RET Z ; return if so.
+
+ LD C,A ; transfer character to C.
+
+ RST 20H ; NEXT-CHAR advances.
+ LD A,C ; character to A
+ SUB $E1 ; subtract 'LPRINT' - lowest command.
+ JR C,<A href="#L0D26">L0D26</a> ; forward if less to REPORT-C2
+
+ LD C,A ; reduced token to C
+ LD HL,<A href="#L0C29">L0C29</a> ; set HL to address of offset table.
+ ADD HL,BC ; index into offset table.
+ LD C,(HL) ; fetch offset
+ ADD HL,BC ; index into parameter table.
+ JR <A href="#L0CF7">L0CF7</a> ; to GET-PARAM
+
+; ---
+
+<a name="L0CF4"></a>;; <b>SCAN-LOOP</b>
+L0CF4: LD HL,($4030) ; sv T_ADDR_lo
+
+; -> Entry Point to Scanning Loop
+
+<a name="L0CF7"></a>;; <b>GET-PARAM</b>
+L0CF7: LD A,(HL) ;
+ INC HL ;
+ LD ($4030),HL ; sv T_ADDR_lo
+
+ LD BC,<A href="#L0CF4">L0CF4</a> ; Address: SCAN-LOOP
+ PUSH BC ; is pushed on machine stack.
+
+ LD C,A ;
+ CP $0B ;
+ JR NC,<A href="#L0D10">L0D10</a> ; to SEPARATOR
+
+ LD HL,<A href="#L0D16">L0D16</a> ; class-tbl - the address of the class table.
+ LD B,$00 ;
+ ADD HL,BC ;
+ LD C,(HL) ;
+ ADD HL,BC ;
+ PUSH HL ;
+
+ RST 18H ; GET-CHAR
+ RET ; indirect jump to class routine and
+ ; by subsequent RET to SCAN-LOOP.
+
+; -----------------------
+; THE <b><font color=#333388>'SEPARATOR'</font></b> ROUTINE
+; -----------------------
+
+<a name="L0D10"></a>;; <b>SEPARATOR</b>
+L0D10: RST 18H ; GET-CHAR
+ CP C ;
+ JR NZ,<A href="#L0D26">L0D26</a> ; to REPORT-C2
+ ; 'Nonsense in BASIC'
+
+ RST 20H ; NEXT-CHAR
+ RET ; return
+
+
+; -------------------------
+; THE <b><font color=#333388>'COMMAND CLASS'</font></b> TABLE
+; -------------------------
+;
+
+<a name="L0D16"></a>;; <b>class-tbl</b>
+L0D16: DEFB <A href="#L0D2D">L0D2D</a> - $ ; 17 offset to; Address: CLASS-0
+ DEFB <A href="#L0D3C">L0D3C</a> - $ ; 25 offset to; Address: CLASS-1
+ DEFB <A href="#L0D6B">L0D6B</a> - $ ; 53 offset to; Address: CLASS-2
+ DEFB <A href="#L0D28">L0D28</a> - $ ; 0F offset to; Address: CLASS-3
+ DEFB <A href="#L0D85">L0D85</a> - $ ; 6B offset to; Address: CLASS-4
+ DEFB <A href="#L0D2E">L0D2E</a> - $ ; 13 offset to; Address: CLASS-5
+ DEFB <A href="#L0D92">L0D92</a> - $ ; 76 offset to; Address: CLASS-6
+
+
+; --------------------------
+; THE <b><font color=#333388>'CHECK END'</font></b> SUBROUTINE
+; --------------------------
+; Check for end of statement and that no spurious characters occur after
+; a correctly parsed statement. Since only one statement is allowed on each
+; line, the only character that may follow a statement is a NEWLINE.
+;
+
+<a name="L0D1D"></a>;; <b>CHECK-END</b>
+L0D1D: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ RET NZ ; return in runtime.
+
+ POP BC ; else drop return address.
+
+<a name="L0D22"></a>;; <b>CHECK-2</b>
+L0D22: LD A,(HL) ; fetch character.
+ CP $76 ; compare to NEWLINE.
+ RET Z ; return if so.
+
+<a name="L0D26"></a>;; <b>REPORT-C2</b>
+L0D26: JR <A href="#L0D9A">L0D9A</a> ; to REPORT-C
+ ; 'Nonsense in BASIC'
+
+; --------------------------
+; COMMAND CLASSES 03, 00, 05
+; --------------------------
+;
+;
+
+<a name="L0D28"></a>;; <b>CLASS-3</b>
+L0D28: CP $76 ;
+ CALL <A href="#L0D9C">L0D9C</a> ; routine NO-TO-STK
+
+<a name="L0D2D"></a>;; <b>CLASS-0</b>
+L0D2D: CP A ;
+
+<a name="L0D2E"></a>;; <b>CLASS-5</b>
+L0D2E: POP BC ;
+ CALL Z,<A href="#L0D1D">L0D1D</a> ; routine CHECK-END
+ EX DE,HL ;
+ LD HL,($4030) ; sv T_ADDR_lo
+ LD C,(HL) ;
+ INC HL ;
+ LD B,(HL) ;
+ EX DE,HL ;
+
+<a name="L0D3A"></a>;; <b>CLASS-END</b>
+L0D3A: PUSH BC ;
+ RET ;
+
+; ------------------------------
+; COMMAND CLASSES 01, 02, 04, 06
+; ------------------------------
+;
+;
+
+<a name="L0D3C"></a>;; <b>CLASS-1</b>
+L0D3C: CALL <A href="#L111C">L111C</a> ; routine LOOK-VARS
+
+<a name="L0D3F"></a>;; <b>CLASS-4-2</b>
+L0D3F: LD (IY+$2D),$00 ; sv FLAGX
+ JR NC,<A href="#L0D4D">L0D4D</a> ; to SET-STK
+
+ SET 1,(IY+$2D) ; sv FLAGX
+ JR NZ,<A href="#L0D63">L0D63</a> ; to SET-STRLN
+
+
+<a name="L0D4B"></a>;; <b>REPORT-2</b>
+L0D4B: RST 08H ; ERROR-1
+ DEFB $01 ; Error Report: Variable not found
+
+; ---
+
+<a name="L0D4D"></a>;; <b>SET-STK</b>
+L0D4D: CALL Z,<A href="#L11A7">L11A7</a> ; routine STK-VAR
+ BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result?
+ JR NZ,<A href="#L0D63">L0D63</a> ; to SET-STRLN
+
+ XOR A ;
+ CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ CALL NZ,<A href="#L13F8">L13F8</a> ; routine STK-FETCH
+ LD HL,$402D ; sv FLAGX
+ OR (HL) ;
+ LD (HL),A ;
+ EX DE,HL ;
+
+<a name="L0D63"></a>;; <b>SET-STRLN</b>
+L0D63: LD ($402E),BC ; sv STRLEN_lo
+ LD ($4012),HL ; sv DEST-lo
+
+; THE <b><font color=#333388>'REM'</font></b> COMMAND ROUTINE
+
+<a name="L0D6A"></a>;; <b>REM</b>
+L0D6A: RET ;
+
+; ---
+
+<a name="L0D6B"></a>;; <b>CLASS-2</b>
+L0D6B: POP BC ;
+ LD A,($4001) ; sv FLAGS
+
+<a name="L0D6F"></a>;; <b>INPUT-REP</b>
+L0D6F: PUSH AF ;
+ CALL <A href="#L0F55">L0F55</a> ; routine SCANNING
+ POP AF ;
+ LD BC,<A href="#L1321">L1321</a> ; Address: LET
+ LD D,(IY+$01) ; sv FLAGS
+ XOR D ;
+ AND $40 ;
+ JR NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C
+
+ BIT 7,D ;
+ JR NZ,<A href="#L0D3A">L0D3A</a> ; to CLASS-END
+
+ JR <A href="#L0D22">L0D22</a> ; to CHECK-2
+
+; ---
+
+<a name="L0D85"></a>;; <b>CLASS-4</b>
+L0D85: CALL <A href="#L111C">L111C</a> ; routine LOOK-VARS
+ PUSH AF ;
+ LD A,C ;
+ OR $9F ;
+ INC A ;
+ JR NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C
+
+ POP AF ;
+ JR <A href="#L0D3F">L0D3F</a> ; to CLASS-4-2
+
+; ---
+
+<a name="L0D92"></a>;; <b>CLASS-6</b>
+L0D92: CALL <A href="#L0F55">L0F55</a> ; routine SCANNING
+ BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result?
+ RET NZ ;
+
+
+<a name="L0D9A"></a>;; <b>REPORT-C</b>
+L0D9A: RST 08H ; ERROR-1
+ DEFB $0B ; Error Report: Nonsense in BASIC
+
+; --------------------------------
+; THE <b><font color=#333388>'NUMBER TO STACK'</font></b> SUBROUTINE
+; --------------------------------
+;
+;
+
+<a name="L0D9C"></a>;; <b>NO-TO-STK</b>
+L0D9C: JR NZ,<A href="#L0D92">L0D92</a> ; back to CLASS-6 with a non-zero number.
+
+ CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ RET Z ; return if checking syntax.
+
+; in runtime a zero default is placed on the calculator stack.
+
+ RST 28H ;; FP-CALC
+ DEFB $A0 ;;stk-zero
+ DEFB $34 ;;end-calc
+
+ RET ; return.
+
+; -------------------------
+; THE <b><font color=#333388>'SYNTAX-Z'</font></b> SUBROUTINE
+; -------------------------
+; This routine returns with zero flag set if checking syntax.
+; Calling this routine uses three instruction bytes compared to four if the
+; bit test is implemented inline.
+
+<a name="L0DA6"></a>;; <b>SYNTAX-Z</b>
+L0DA6: BIT 7,(IY+$01) ; test FLAGS - checking syntax only?
+ RET ; return.
+
+; ------------------------
+; THE <b><font color=#333388>'IF'</font></b> COMMAND ROUTINE
+; ------------------------
+; In runtime, the class routines have evaluated the test expression and
+; the result, true or false, is on the stack.
+
+<a name="L0DAB"></a>;; <b>IF</b>
+L0DAB: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ JR Z,<A href="#L0DB6">L0DB6</a> ; forward if checking syntax to IF-END
+
+; else delete the Boolean value on the calculator stack.
+
+ RST 28H ;; FP-CALC
+ DEFB $02 ;;delete
+ DEFB $34 ;;end-calc
+
+; register DE points to exponent of floating point value.
+
+ LD A,(DE) ; fetch exponent.
+ AND A ; test for zero - FALSE.
+ RET Z ; return if so.
+
+<a name="L0DB6"></a>;; <b>IF-END</b>
+L0DB6: JP <A href="#L0CDE">L0CDE</a> ; jump back to LINE-NULL
+
+; -------------------------
+; THE <b><font color=#333388>'FOR'</font></b> COMMAND ROUTINE
+; -------------------------
+;
+;
+
+<a name="L0DB9"></a>;; <b>FOR</b>
+L0DB9: CP $E0 ; is current character 'STEP' ?
+ JR NZ,<A href="#L0DC6">L0DC6</a> ; forward if not to F-USE-ONE
+
+
+ RST 20H ; NEXT-CHAR
+ CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6 stacks the number
+ CALL <A href="#L0D1D">L0D1D</a> ; routine CHECK-END
+ JR <A href="#L0DCC">L0DCC</a> ; forward to F-REORDER
+
+; ---
+
+<a name="L0DC6"></a>;; <b>F-USE-ONE</b>
+L0DC6: CALL <A href="#L0D1D">L0D1D</a> ; routine CHECK-END
+
+ RST 28H ;; FP-CALC
+ DEFB $A1 ;;stk-one
+ DEFB $34 ;;end-calc
+
+
+
+<a name="L0DCC"></a>;; <b>F-REORDER</b>
+L0DCC: RST 28H ;; FP-CALC v, l, s.
+ DEFB $C0 ;;st-mem-0 v, l, s.
+ DEFB $02 ;;delete v, l.
+ DEFB $01 ;;exchange l, v.
+ DEFB $E0 ;;get-mem-0 l, v, s.
+ DEFB $01 ;;exchange l, s, v.
+ DEFB $34 ;;end-calc l, s, v.
+
+ CALL <A href="#L1321">L1321</a> ; routine LET
+
+ LD ($401F),HL ; set MEM to address variable.
+ DEC HL ; point to letter.
+ LD A,(HL) ;
+ SET 7,(HL) ;
+ LD BC,$0006 ;
+ ADD HL,BC ;
+ RLCA ;
+ JR C,<A href="#L0DEA">L0DEA</a> ; to F-LMT-STP
+
+ SLA C ;
+ CALL <A href="#L099E">L099E</a> ; routine MAKE-ROOM
+ INC HL ;
+
+<a name="L0DEA"></a>;; <b>F-LMT-STP</b>
+L0DEA: PUSH HL ;
+
+ RST 28H ;; FP-CALC
+ DEFB $02 ;;delete
+ DEFB $02 ;;delete
+ DEFB $34 ;;end-calc
+
+ POP HL ;
+ EX DE,HL ;
+
+ LD C,$0A ; ten bytes to be moved.
+ LDIR ; copy bytes
+
+ LD HL,($4007) ; set HL to system variable PPC current line.
+ EX DE,HL ; transfer to DE, variable pointer to HL.
+ INC DE ; loop start will be this line + 1 at least.
+ LD (HL),E ;
+ INC HL ;
+ LD (HL),D ;
+ CALL <A href="#L0E5A">L0E5A</a> ; routine NEXT-LOOP considers an initial pass.
+ RET NC ; return if possible.
+
+; else program continues from point following matching NEXT.
+
+ BIT 7,(IY+$08) ; test PPC_hi
+ RET NZ ; return if over 32767 ???
+
+ LD B,(IY+$2E) ; fetch variable name from STRLEN_lo
+ RES 6,B ; make a true letter.
+ LD HL,($4029) ; set HL from NXTLIN
+
+; now enter a loop to look for matching next.
+
+<a name="L0E0E"></a>;; <b>NXTLIN-NO</b>
+L0E0E: LD A,(HL) ; fetch high byte of line number.
+ AND $C0 ; mask off low bits $3F
+ JR NZ,<A href="#L0E2A">L0E2A</a> ; forward at end of program to FOR-END
+
+ PUSH BC ; save letter
+ CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE finds next line.
+ POP BC ; restore letter
+
+ INC HL ; step past low byte
+ INC HL ; past the
+ INC HL ; line length.
+ CALL <A href="#L004C">L004C</a> ; routine TEMP-PTR1 sets CH_ADD
+
+ RST 18H ; GET-CHAR
+ CP $F3 ; compare to 'NEXT'.
+ EX DE,HL ; next line to HL.
+ JR NZ,<A href="#L0E0E">L0E0E</a> ; back with no match to NXTLIN-NO
+
+;
+
+ EX DE,HL ; restore pointer.
+
+ RST 20H ; NEXT-CHAR advances and gets letter in A.
+ EX DE,HL ; save pointer
+ CP B ; compare to variable name.
+ JR NZ,<A href="#L0E0E">L0E0E</a> ; back with mismatch to NXTLIN-NO
+
+<a name="L0E2A"></a>;; <b>FOR-END</b>
+L0E2A: LD ($4029),HL ; update system variable NXTLIN
+ RET ; return.
+
+; --------------------------
+; THE <b><font color=#333388>'NEXT'</font></b> COMMAND ROUTINE
+; --------------------------
+;
+;
+
+<a name="L0E2E"></a>;; <b>NEXT</b>
+L0E2E: BIT 1,(IY+$2D) ; sv FLAGX
+ JP NZ,<A href="#L0D4B">L0D4B</a> ; to REPORT-2
+
+ LD HL,($4012) ; DEST
+ BIT 7,(HL) ;
+ JR Z,<A href="#L0E58">L0E58</a> ; to REPORT-1
+
+ INC HL ;
+ LD ($401F),HL ; sv MEM_lo
+
+ RST 28H ;; FP-CALC
+ DEFB $E0 ;;get-mem-0
+ DEFB $E2 ;;get-mem-2
+ DEFB $0F ;;addition
+ DEFB $C0 ;;st-mem-0
+ DEFB $02 ;;delete
+ DEFB $34 ;;end-calc
+
+ CALL <A href="#L0E5A">L0E5A</a> ; routine NEXT-LOOP
+ RET C ;
+
+ LD HL,($401F) ; sv MEM_lo
+ LD DE,$000F ;
+ ADD HL,DE ;
+ LD E,(HL) ;
+ INC HL ;
+ LD D,(HL) ;
+ EX DE,HL ;
+ JR <A href="#L0E86">L0E86</a> ; to GOTO-2
+
+; ---
+
+
+<a name="L0E58"></a>;; <b>REPORT-1</b>
+L0E58: RST 08H ; ERROR-1
+ DEFB $00 ; Error Report: NEXT without FOR
+
+
+; --------------------------
+; THE <b><font color=#333388>'NEXT-LOOP'</font></b> SUBROUTINE
+; --------------------------
+;
+;
+
+<a name="L0E5A"></a>;; <b>NEXT-LOOP</b>
+L0E5A: RST 28H ;; FP-CALC
+ DEFB $E1 ;;get-mem-1
+ DEFB $E0 ;;get-mem-0
+ DEFB $E2 ;;get-mem-2
+ DEFB $32 ;;less-0
+ DEFB $00 ;;jump-true
+ DEFB $02 ;;to <A href="#L0E62">L0E62</a>, LMT-V-VAL
+
+ DEFB $01 ;;exchange
+
+<a name="L0E62"></a>;; <b>LMT-V-VAL</b>
+L0E62: DEFB $03 ;;subtract
+ DEFB $33 ;;greater-0
+ DEFB $00 ;;jump-true
+ DEFB $04 ;;to <A href="#L0E69">L0E69</a>, IMPOSS
+
+ DEFB $34 ;;end-calc
+
+ AND A ; clear carry flag
+ RET ; return.
+
+; ---
+
+
+<a name="L0E69"></a>;; <b>IMPOSS</b>
+L0E69: DEFB $34 ;;end-calc
+
+ SCF ; set carry flag
+ RET ; return.
+
+; --------------------------
+; THE <b><font color=#333388>'RAND'</font></b> COMMAND ROUTINE
+; --------------------------
+; The keyword was <b><font color=#333388>'RANDOMISE'</font></b> on the ZX80, is 'RAND' here on the ZX81 and
+; becomes 'RANDOMIZE' on the ZX Spectrum.
+; In all invocations the procedure is the same - to set the SEED system variable
+; with a supplied integer value or to use a time-based value if no number, or
+; zero, is supplied.
+
+<a name="L0E6C"></a>;; <b>RAND</b>
+L0E6C: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT
+ LD A,B ; test value
+ OR C ; for zero
+ JR NZ,<A href="#L0E77">L0E77</a> ; forward if not zero to SET-SEED
+
+ LD BC,($4034) ; fetch value of FRAMES system variable.
+
+<a name="L0E77"></a>;; <b>SET-SEED</b>
+L0E77: LD ($4032),BC ; update the SEED system variable.
+ RET ; return.
+
+; --------------------------
+; THE <b><font color=#333388>'CONT'</font></b> COMMAND ROUTINE
+; --------------------------
+; Another abbreviated command. ROM space was really tight.
+; CONTINUE at the line number that was set when break was pressed.
+; Sometimes the current line, sometimes the next line.
+
+<a name="L0E7C"></a>;; <b>CONT</b>
+L0E7C: LD HL,($402B) ; set HL from system variable OLDPPC
+ JR <A href="#L0E86">L0E86</a> ; forward to GOTO-2
+
+; --------------------------
+; THE <b><font color=#333388>'GOTO'</font></b> COMMAND ROUTINE
+; --------------------------
+; This token also suffered from the shortage of room and there is no space
+; getween GO and TO as there is on the ZX80 and ZX Spectrum. The same also
+; applies to the GOSUB keyword.
+
+<a name="L0E81"></a>;; <b>GOTO</b>
+L0E81: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT
+ LD H,B ;
+ LD L,C ;
+
+<a name="L0E86"></a>;; <b>GOTO-2</b>
+L0E86: LD A,H ;
+ CP $F0 ;
+ JR NC,<A href="#L0EAD">L0EAD</a> ; to REPORT-B
+
+ CALL <A href="#L09D8">L09D8</a> ; routine LINE-ADDR
+ LD ($4029),HL ; sv NXTLIN_lo
+ RET ;
+
+; --------------------------
+; THE <b><font color=#333388>'POKE'</font></b> COMMAND ROUTINE
+; --------------------------
+;
+;
+
+<a name="L0E92"></a>;; <b>POKE</b>
+L0E92: CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A
+ JR C,<A href="#L0EAD">L0EAD</a> ; forward, with overflow, to REPORT-B
+
+ JR Z,<A href="#L0E9B">L0E9B</a> ; forward, if positive, to POKE-SAVE
+
+ NEG ; negate
+
+<a name="L0E9B"></a>;; <b>POKE-SAVE</b>
+L0E9B: PUSH AF ; preserve value.
+ CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT gets address in BC
+ ; invoking the error routine with overflow
+ ; or a negative number.
+ POP AF ; restore value.
+
+; <font color=#9900FF>Note.</font> the next two instructions are legacy code from the ZX80 and
+; inappropriate here.
+
+ BIT 7,(IY+$00) ; test ERR_NR - is it still $FF ?
+ RET Z ; return with error.
+
+ LD (BC),A ; update the address contents.
+ RET ; return.
+
+; -----------------------------
+; THE <b><font color=#333388>'FIND INTEGER'</font></b> SUBROUTINE
+; -----------------------------
+;
+;
+
+<a name="L0EA7"></a>;; <b>FIND-INT</b>
+L0EA7: CALL <A href="#L158A">L158A</a> ; routine FP-TO-BC
+ JR C,<A href="#L0EAD">L0EAD</a> ; forward with overflow to REPORT-B
+
+ RET Z ; return if positive (0-65535).
+
+
+<a name="L0EAD"></a>;; <b>REPORT-B</b>
+L0EAD: RST 08H ; ERROR-1
+ DEFB $0A ; Error Report: Integer out of range
+
+; -------------------------
+; THE <b><font color=#333388>'RUN'</font></b> COMMAND ROUTINE
+; -------------------------
+;
+;
+
+<a name="L0EAF"></a>;; <b>RUN</b>
+L0EAF: CALL <A href="#L0E81">L0E81</a> ; routine GOTO
+ JP <A href="#L149A">L149A</a> ; to CLEAR
+
+; ---------------------------
+; THE <b><font color=#333388>'GOSUB'</font></b> COMMAND ROUTINE
+; ---------------------------
+;
+;
+
+<a name="L0EB5"></a>;; <b>GOSUB</b>
+L0EB5: LD HL,($4007) ; sv PPC_lo
+ INC HL ;
+ EX (SP),HL ;
+ PUSH HL ;
+ LD ($4002),SP ; set the error stack pointer - ERR_SP
+ CALL <A href="#L0E81">L0E81</a> ; routine GOTO
+ LD BC,$0006 ;
+
+; --------------------------
+; THE <b><font color=#333388>'TEST ROOM'</font></b> SUBROUTINE
+; --------------------------
+;
+;
+
+<a name="L0EC5"></a>;; <b>TEST-ROOM</b>
+L0EC5: LD HL,($401C) ; sv STKEND_lo
+ ADD HL,BC ;
+ JR C,<A href="#L0ED3">L0ED3</a> ; to REPORT-4
+
+ EX DE,HL ;
+ LD HL,$0024 ;
+ ADD HL,DE ;
+ SBC HL,SP ;
+ RET C ;
+
+<a name="L0ED3"></a>;; <b>REPORT-4</b>
+L0ED3: LD L,$03 ;
+ JP <A href="#L0058">L0058</a> ; to ERROR-3
+
+; ----------------------------
+; THE <b><font color=#333388>'RETURN'</font></b> COMMAND ROUTINE
+; ----------------------------
+;
+;
+
+<a name="L0ED8"></a>;; <b>RETURN</b>
+L0ED8: POP HL ;
+ EX (SP),HL ;
+ LD A,H ;
+ CP $3E ;
+ JR Z,<A href="#L0EE5">L0EE5</a> ; to REPORT-7
+
+ LD ($4002),SP ; sv ERR_SP_lo
+ JR <A href="#L0E86">L0E86</a> ; back to GOTO-2
+
+; ---
+
+<a name="L0EE5"></a>;; <b>REPORT-7</b>
+L0EE5: EX (SP),HL ;
+ PUSH HL ;
+
+ RST 08H ; ERROR-1
+ DEFB $06 ; Error Report: RETURN without GOSUB
+
+; ---------------------------
+; THE <b><font color=#333388>'INPUT'</font></b> COMMAND ROUTINE
+; ---------------------------
+;
+;
+
+<a name="L0EE9"></a>;; <b>INPUT</b>
+L0EE9: BIT 7,(IY+$08) ; sv PPC_hi
+ JR NZ,<A href="#L0F21">L0F21</a> ; to REPORT-8
+
+ CALL <A href="#L14A3">L14A3</a> ; routine X-TEMP
+ LD HL,$402D ; sv FLAGX
+ SET 5,(HL) ;
+ RES 6,(HL) ;
+ LD A,($4001) ; sv FLAGS
+ AND $40 ;
+ LD BC,$0002 ;
+ JR NZ,<A href="#L0F05">L0F05</a> ; to PROMPT
+
+ LD C,$04 ;
+
+<a name="L0F05"></a>;; <b>PROMPT</b>
+L0F05: OR (HL) ;
+ LD (HL),A ;
+
+ RST 30H ; BC-SPACES
+ LD (HL),$76 ;
+ LD A,C ;
+ RRCA ;
+ RRCA ;
+ JR C,<A href="#L0F14">L0F14</a> ; to ENTER-CUR
+
+ LD A,$0B ;
+ LD (DE),A ;
+ DEC HL ;
+ LD (HL),A ;
+
+<a name="L0F14"></a>;; <b>ENTER-CUR</b>
+L0F14: DEC HL ;
+ LD (HL),$7F ;
+ LD HL,($4039) ; sv S_POSN_x
+ LD ($4030),HL ; sv T_ADDR_lo
+ POP HL ;
+ JP <A href="#L0472">L0472</a> ; to LOWER
+
+; ---
+
+<a name="L0F21"></a>;; <b>REPORT-8</b>
+L0F21: RST 08H ; ERROR-1
+ DEFB $07 ; Error Report: End of file
+
+; ---------------------------
+; THE <b><font color=#333388>'PAUSE'</font></b> COMMAND ROUTINE
+; ---------------------------
+;
+;
+
+<a name="L0F23"></a>;; <b>FAST</b>
+L0F23: CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST
+ RES 6,(IY+$3B) ; sv CDFLAG
+ RET ; return.
+
+; --------------------------
+; THE <b><font color=#333388>'SLOW'</font></b> COMMAND ROUTINE
+; --------------------------
+;
+;
+
+<a name="L0F2B"></a>;; <b>SLOW</b>
+L0F2B: SET 6,(IY+$3B) ; sv CDFLAG
+ JP <A href="#L0207">L0207</a> ; to SLOW/FAST
+
+; ---------------------------
+; THE <b><font color=#333388>'PAUSE'</font></b> COMMAND ROUTINE
+; ---------------------------
+
+<a name="L0F32"></a>;; <b>PAUSE</b>
+L0F32: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT
+ CALL <A href="#L02E7">L02E7</a> ; routine SET-FAST
+ LD H,B ;
+ LD L,C ;
+ CALL <A href="#L022D">L022D</a> ; routine DISPLAY-P
+
+ LD (IY+$35),$FF ; sv FRAMES_hi
+
+ CALL <A href="#L0207">L0207</a> ; routine SLOW/FAST
+ JR <A href="#L0F4B">L0F4B</a> ; routine DEBOUNCE
+
+; ----------------------
+; THE <b><font color=#333388>'BREAK'</font></b> SUBROUTINE
+; ----------------------
+;
+;
+
+<a name="L0F46"></a>;; <b>BREAK-1</b>
+L0F46: LD A,$7F ; read port $7FFE - keys B,N,M,.,SPACE.
+ IN A,($FE) ;
+ RRA ; carry will be set if space not pressed.
+
+; -------------------------
+; THE <b><font color=#333388>'DEBOUNCE'</font></b> SUBROUTINE
+; -------------------------
+;
+;
+
+<a name="L0F4B"></a>;; <b>DEBOUNCE</b>
+L0F4B: RES 0,(IY+$3B) ; update system variable CDFLAG
+ LD A,$FF ;
+ LD ($4027),A ; update system variable DEBOUNCE
+ RET ; return.
+
+
+; -------------------------
+; THE <b><font color=#333388>'SCANNING'</font></b> SUBROUTINE
+; -------------------------
+; This recursive routine is where the ZX81 gets its power. Provided there is
+; enough memory it can evaluate an expression of unlimited complexity.
+; <font color=#9900FF>Note.</font> there is no unary plus so, as on the ZX80, PRINT +1 gives a syntax error.
+; PRINT +1 works on the Spectrum but so too does PRINT + "STRING".
+
+<a name="L0F55"></a>;; <b>SCANNING</b>
+L0F55: RST 18H ; GET-CHAR
+ LD B,$00 ; set B register to zero.
+ PUSH BC ; stack zero as a priority end-marker.
+
+<a name="L0F59"></a>;; <b>S-LOOP-1</b>
+L0F59: CP $40 ; compare to the 'RND' character
+ JR NZ,<A href="#L0F8C">L0F8C</a> ; forward, if not, to S-TEST-PI
+
+; ------------------
+; THE <b><font color=#333388>'RND'</font></b> FUNCTION
+; ------------------
+
+ CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ JR Z,<A href="#L0F8A">L0F8A</a> ; forward if checking syntax to S-JPI-END
+
+ LD BC,($4032) ; sv SEED_lo
+ CALL <A href="#L1520">L1520</a> ; routine STACK-BC
+
+ RST 28H ;; FP-CALC
+ DEFB $A1 ;;stk-one
+ DEFB $0F ;;addition
+ DEFB $30 ;;stk-data
+ DEFB $37 ;;Exponent: $87, Bytes: 1
+ DEFB $16 ;;(+00,+00,+00)
+ DEFB $04 ;;multiply
+ DEFB $30 ;;stk-data
+ DEFB $80 ;;Bytes: 3
+ DEFB $41 ;;Exponent $91
+ DEFB $00,$00,$80 ;;(+00)
+ DEFB $2E ;;n-mod-m
+ DEFB $02 ;;delete
+ DEFB $A1 ;;stk-one
+ DEFB $03 ;;subtract
+ DEFB $2D ;;duplicate
+ DEFB $34 ;;end-calc
+
+ CALL <A href="#L158A">L158A</a> ; routine FP-TO-BC
+ LD ($4032),BC ; update the SEED system variable.
+ LD A,(HL) ; HL addresses the exponent of the last value.
+ AND A ; test for zero
+ JR Z,<A href="#L0F8A">L0F8A</a> ; forward, if so, to S-JPI-END
+
+ SUB $10 ; else reduce exponent by sixteen
+ LD (HL),A ; thus dividing by 65536 for last value.
+
+<a name="L0F8A"></a>;; <b>S-JPI-END</b>
+L0F8A: JR <A href="#L0F99">L0F99</a> ; forward to S-PI-END
+
+; ---
+
+<a name="L0F8C"></a>;; <b>S-TEST-PI</b>
+L0F8C: CP $42 ; the 'PI' character
+ JR NZ,<A href="#L0F9D">L0F9D</a> ; forward, if not, to S-TST-INK
+
+; -------------------
+; THE <b><font color=#333388>'PI'</font></b> EVALUATION
+; -------------------
+
+ CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ JR Z,<A href="#L0F99">L0F99</a> ; forward if checking syntax to S-PI-END
+
+
+ RST 28H ;; FP-CALC
+ DEFB $A3 ;;stk-pi/2
+ DEFB $34 ;;end-calc
+
+ INC (HL) ; double the exponent giving PI on the stack.
+
+<a name="L0F99"></a>;; <b>S-PI-END</b>
+L0F99: RST 20H ; NEXT-CHAR advances character pointer.
+
+ JP <A href="#L1083">L1083</a> ; jump forward to S-NUMERIC to set the flag
+ ; to signal numeric result before advancing.
+
+; ---
+
+<a name="L0F9D"></a>;; <b>S-TST-INK</b>
+L0F9D: CP $41 ; compare to character 'INKEY$'
+ JR NZ,<A href="#L0FB2">L0FB2</a> ; forward, if not, to S-ALPHANUM
+
+; -----------------------
+; THE <b><font color=#333388>'INKEY$'</font></b> EVALUATION
+; -----------------------
+
+ CALL <A href="#L02BB">L02BB</a> ; routine KEYBOARD
+ LD B,H ;
+ LD C,L ;
+ LD D,C ;
+ INC D ;
+ CALL NZ,<A href="#L07BD">L07BD</a> ; routine DECODE
+ LD A,D ;
+ ADC A,D ;
+ LD B,D ;
+ LD C,A ;
+ EX DE,HL ;
+ JR <A href="#L0FED">L0FED</a> ; forward to S-STRING
+
+; ---
+
+<a name="L0FB2"></a>;; <b>S-ALPHANUM</b>
+L0FB2: CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM
+ JR C,<A href="#L1025">L1025</a> ; forward, if alphanumeric to S-LTR-DGT
+
+ CP $1B ; is character a '.' ?
+ JP Z,<A href="#L1047">L1047</a> ; jump forward if so to S-DECIMAL
+
+ LD BC,$09D8 ; prepare priority 09, operation 'subtract'
+ CP $16 ; is character unary minus '-' ?
+ JR Z,<A href="#L1020">L1020</a> ; forward, if so, to S-PUSH-PO
+
+ CP $10 ; is character a '(' ?
+ JR NZ,<A href="#L0FD6">L0FD6</a> ; forward if not to S-QUOTE
+
+ CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 advances character pointer.
+
+ CALL <A href="#L0F55">L0F55</a> ; recursively call routine SCANNING to
+ ; evaluate the sub-expression.
+
+ CP $11 ; is subsequent character a ')' ?
+ JR NZ,<A href="#L0FFF">L0FFF</a> ; forward if not to S-RPT-C
+
+
+ CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 advances.
+ JR <A href="#L0FF8">L0FF8</a> ; relative jump to S-JP-CONT3 and then S-CONT3
+
+; ---
+
+; consider a quoted string e.g. PRINT "Hooray!"
+; <font color=#9900FF>Note.</font> quotes are not allowed within a string.
+
+<a name="L0FD6"></a>;; <b>S-QUOTE</b>
+L0FD6: CP $0B ; is character a quote (") ?
+ JR NZ,<A href="#L1002">L1002</a> ; forward, if not, to S-FUNCTION
+
+ CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1 advances
+ PUSH HL ; * save start of string.
+ JR <A href="#L0FE3">L0FE3</a> ; forward to S-QUOTE-S
+
+; ---
+
+
+<a name="L0FE0"></a>;; <b>S-Q-AGAIN</b>
+L0FE0: CALL <A href="#L0049">L0049</a> ; routine CH-ADD+1
+
+<a name="L0FE3"></a>;; <b>S-QUOTE-S</b>
+L0FE3: CP $0B ; is character a '"' ?
+ JR NZ,<A href="#L0FFB">L0FFB</a> ; forward if not to S-Q-NL
+
+ POP DE ; * retrieve start of string
+ AND A ; prepare to subtract.
+ SBC HL,DE ; subtract start from current position.
+ LD B,H ; transfer this length
+ LD C,L ; to the BC register pair.
+
+<a name="L0FED"></a>;; <b>S-STRING</b>
+L0FED: LD HL,$4001 ; address system variable FLAGS
+ RES 6,(HL) ; signal string result
+ BIT 7,(HL) ; test if checking syntax.
+
+ CALL NZ,<A href="#L12C3">L12C3</a> ; in run-time routine STK-STO-$ stacks the
+ ; string descriptor - start DE, length BC.
+
+ RST 20H ; NEXT-CHAR advances pointer.
+
+<a name="L0FF8"></a>;; <b>S-J-CONT-3</b>
+L0FF8: JP <A href="#L1088">L1088</a> ; jump to S-CONT-3
+
+; ---
+
+; A string with no terminating quote has to be considered.
+
+<a name="L0FFB"></a>;; <b>S-Q-NL</b>
+L0FFB: CP $76 ; compare to NEWLINE
+ JR NZ,<A href="#L0FE0">L0FE0</a> ; loop back if not to S-Q-AGAIN
+
+<a name="L0FFF"></a>;; <b>S-RPT-C</b>
+L0FFF: JP <A href="#L0D9A">L0D9A</a> ; to REPORT-C
+
+; ---
+
+<a name="L1002"></a>;; <b>S-FUNCTION</b>
+L1002: SUB $C4 ; subtract 'CODE' reducing codes
+ ; CODE thru '<>' to range $00 - $XX
+ JR C,<A href="#L0FFF">L0FFF</a> ; back, if less, to S-RPT-C
+
+; test for NOT the last function in character set.
+
+ LD BC,$04EC ; prepare priority $04, operation 'not'
+ CP $13 ; compare to 'NOT' ( - CODE)
+ JR Z,<A href="#L1020">L1020</a> ; forward, if so, to S-PUSH-PO
+
+ JR NC,<A href="#L0FFF">L0FFF</a> ; back with anything higher to S-RPT-C
+
+; else is a function 'CODE' thru 'CHR$'
+
+ LD B,$10 ; priority sixteen binds all functions to
+ ; arguments removing the need for brackets.
+
+ ADD A,$D9 ; add $D9 to give range $D9 thru $EB
+ ; bit 6 is set to show numeric argument.
+ ; bit 7 is set to show numeric result.
+
+; now adjust these default argument/result indicators.
+
+ LD C,A ; save code in C
+
+ CP $DC ; separate 'CODE', 'VAL', 'LEN'
+ JR NC,<A href="#L101A">L101A</a> ; skip forward if string operand to S-NO-TO-$
+
+ RES 6,C ; signal string operand.
+
+<a name="L101A"></a>;; <b>S-NO-TO-$</b>
+L101A: CP $EA ; isolate top of range 'STR$' and 'CHR$'
+ JR C,<A href="#L1020">L1020</a> ; skip forward with others to S-PUSH-PO
+
+ RES 7,C ; signal string result.
+
+<a name="L1020"></a>;; <b>S-PUSH-PO</b>
+L1020: PUSH BC ; push the priority/operation
+
+ RST 20H ; NEXT-CHAR
+ JP <A href="#L0F59">L0F59</a> ; jump back to S-LOOP-1
+
+; ---
+
+<a name="L1025"></a>;; <b>S-LTR-DGT</b>
+L1025: CP $26 ; compare to 'A'.
+ JR C,<A href="#L1047">L1047</a> ; forward if less to S-DECIMAL
+
+ CALL <A href="#L111C">L111C</a> ; routine LOOK-VARS
+ JP C,<A href="#L0D4B">L0D4B</a> ; back if not found to REPORT-2
+ ; a variable is always 'found' when checking
+ ; syntax.
+
+ CALL Z,<A href="#L11A7">L11A7</a> ; routine STK-VAR stacks string parameters or
+ ; returns cell location if numeric.
+
+ LD A,($4001) ; fetch FLAGS
+ CP $C0 ; compare to numeric result/numeric operand
+ JR C,<A href="#L1087">L1087</a> ; forward if not numeric to S-CONT-2
+
+ INC HL ; address numeric contents of variable.
+ LD DE,($401C) ; set destination to STKEND
+ CALL <A href="#L19F6">L19F6</a> ; routine MOVE-FP stacks the five bytes
+ EX DE,HL ; transfer new free location from DE to HL.
+ LD ($401C),HL ; update STKEND system variable.
+ JR <A href="#L1087">L1087</a> ; forward to S-CONT-2
+
+; ---
+
+; The Scanning Decimal routine is invoked when a decimal point or digit is
+; found in the expression.
+; When checking syntax, then the 'hidden floating point' form is placed
+; after the number in the BASIC line.
+; In run-time, the digits are skipped and the floating point number is picked
+; up.
+
+<a name="L1047"></a>;; <b>S-DECIMAL</b>
+L1047: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ JR NZ,<A href="#L106F">L106F</a> ; forward in run-time to S-STK-DEC
+
+ CALL <A href="#L14D9">L14D9</a> ; routine DEC-TO-FP
+
+ RST 18H ; GET-CHAR advances HL past digits
+ LD BC,$0006 ; six locations are required.
+ CALL <A href="#L099E">L099E</a> ; routine MAKE-ROOM
+ INC HL ; point to first new location
+ LD (HL),$7E ; insert the number marker 126 decimal.
+ INC HL ; increment
+ EX DE,HL ; transfer destination to DE.
+ LD HL,($401C) ; set HL from STKEND which points to the
+ ; first location after the 'last value'
+ LD C,$05 ; five bytes to move.
+ AND A ; clear carry.
+ SBC HL,BC ; subtract five pointing to 'last value'.
+ LD ($401C),HL ; update STKEND thereby 'deleting the value.
+
+ LDIR ; copy the five value bytes.
+
+ EX DE,HL ; basic pointer to HL which may be white-space
+ ; following the number.
+ DEC HL ; now points to last of five bytes.
+ CALL <A href="#L004C">L004C</a> ; routine TEMP-PTR1 advances the character
+ ; address skipping any white-space.
+ JR <A href="#L1083">L1083</a> ; forward to S-NUMERIC
+ ; to signal a numeric result.
+
+; ---
+
+; In run-time the branch is here when a digit or point is encountered.
+
+<a name="L106F"></a>;; <b>S-STK-DEC</b>
+L106F: RST 20H ; NEXT-CHAR
+ CP $7E ; compare to 'number marker'
+ JR NZ,<A href="#L106F">L106F</a> ; loop back until found to S-STK-DEC
+ ; skipping all the digits.
+
+ INC HL ; point to first of five hidden bytes.
+ LD DE,($401C) ; set destination from STKEND system variable
+ CALL <A href="#L19F6">L19F6</a> ; routine MOVE-FP stacks the number.
+ LD ($401C),DE ; update system variable STKEND.
+ LD ($4016),HL ; update system variable CH_ADD.
+
+<a name="L1083"></a>;; <b>S-NUMERIC</b>
+L1083: SET 6,(IY+$01) ; update FLAGS - Signal numeric result
+
+<a name="L1087"></a>;; <b>S-CONT-2</b>
+L1087: RST 18H ; GET-CHAR
+
+<a name="L1088"></a>;; <b>S-CONT-3</b>
+L1088: CP $10 ; compare to opening bracket '('
+ JR NZ,<A href="#L1098">L1098</a> ; forward if not to S-OPERTR
+
+ BIT 6,(IY+$01) ; test FLAGS - Numeric or string result?
+ JR NZ,<A href="#L10BC">L10BC</a> ; forward if numeric to S-LOOP
+
+; else is a string
+
+ CALL <A href="#L1263">L1263</a> ; routine SLICING
+
+ RST 20H ; NEXT-CHAR
+ JR <A href="#L1088">L1088</a> ; back to S-CONT-3
+
+; ---
+
+; the character is now manipulated to form an equivalent in the table of
+; calculator literals. This is quite cumbersome and in the ZX Spectrum a
+; simple look-up table was introduced at this point.
+
+<a name="L1098"></a>;; <b>S-OPERTR</b>
+L1098: LD BC,$00C3 ; prepare operator 'subtract' as default.
+ ; also set B to zero for later indexing.
+
+ CP $12 ; is character '>' ?
+ JR C,<A href="#L10BC">L10BC</a> ; forward if less to S-LOOP as
+ ; we have reached end of meaningful expression
+
+ SUB $16 ; is character '-' ?
+ JR NC,<A href="#L10A7">L10A7</a> ; forward with - * / and '**' '<>' to SUBMLTDIV
+
+ ADD A,$0D ; increase others by thirteen
+ ; $09 '>' thru $0C '+'
+ JR <A href="#L10B5">L10B5</a> ; forward to GET-PRIO
+
+; ---
+
+<a name="L10A7"></a>;; <b>SUBMLTDIV</b>
+L10A7: CP $03 ; isolate $00 '-', $01 '*', $02 '/'
+ JR C,<A href="#L10B5">L10B5</a> ; forward if so to GET-PRIO
+
+; else possibly originally $D8 '**' thru $DD '<>' already reduced by $16
+
+ SUB $C2 ; giving range $00 to $05
+ JR C,<A href="#L10BC">L10BC</a> ; forward if less to S-LOOP
+
+ CP $06 ; test the upper limit for nonsense also
+ JR NC,<A href="#L10BC">L10BC</a> ; forward if so to S-LOOP
+
+ ADD A,$03 ; increase by 3 to give combined operators of
+
+ ; $00 '-'
+ ; $01 '*'
+ ; $02 '/'
+
+ ; $03 '**'
+ ; $04 'OR'
+ ; $05 'AND'
+ ; $06 '<='
+ ; $07 '>='
+ ; $08 '<>'
+
+ ; $09 '>'
+ ; $0A '<'
+ ; $0B '='
+ ; $0C '+'
+
+<a name="L10B5"></a>;; <b>GET-PRIO</b>
+L10B5: ADD A,C ; add to default operation 'sub' ($C3)
+ LD C,A ; and place in operator byte - C.
+
+ LD HL,<A href="#L110F">L110F</a> - $C3 ; theoretical base of the priorities table.
+ ADD HL,BC ; add C ( B is zero)
+ LD B,(HL) ; pick up the priority in B
+
+<a name="L10BC"></a>;; <b>S-LOOP</b>
+L10BC: POP DE ; restore previous
+ LD A,D ; load A with priority.
+ CP B ; is present priority higher
+ JR C,<A href="#L10ED">L10ED</a> ; forward if so to S-TIGHTER
+
+ AND A ; are both priorities zero
+ JP Z,<A href="#L0018">L0018</a> ; exit if zero via GET-CHAR
+
+ PUSH BC ; stack present values
+ PUSH DE ; stack last values
+ CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ JR Z,<A href="#L10D5">L10D5</a> ; forward is checking syntax to S-SYNTEST
+
+ LD A,E ; fetch last operation
+ AND $3F ; mask off the indicator bits to give true
+ ; calculator literal.
+ LD B,A ; place in the B register for BREG
+
+; perform the single operation
+
+ RST 28H ;; FP-CALC
+ DEFB $37 ;;fp-calc-2
+ DEFB $34 ;;end-calc
+
+ JR <A href="#L10DE">L10DE</a> ; forward to S-RUNTEST
+
+; ---
+
+<a name="L10D5"></a>;; <b>S-SYNTEST</b>
+L10D5: LD A,E ; transfer masked operator to A
+ XOR (IY+$01) ; XOR with FLAGS like results will reset bit 6
+ AND $40 ; test bit 6
+
+<a name="L10DB"></a>;; <b>S-RPORT-C</b>
+L10DB: JP NZ,<A href="#L0D9A">L0D9A</a> ; back to REPORT-C if results do not agree.
+
+; ---
+
+; in run-time impose bit 7 of the operator onto bit 6 of the FLAGS
+
+<a name="L10DE"></a>;; <b>S-RUNTEST</b>
+L10DE: POP DE ; restore last operation.
+ LD HL,$4001 ; address system variable FLAGS
+ SET 6,(HL) ; presume a numeric result
+ BIT 7,E ; test expected result in operation
+ JR NZ,<A href="#L10EA">L10EA</a> ; forward if numeric to S-LOOPEND
+
+ RES 6,(HL) ; reset to signal string result
+
+<a name="L10EA"></a>;; <b>S-LOOPEND</b>
+L10EA: POP BC ; restore present values
+ JR <A href="#L10BC">L10BC</a> ; back to S-LOOP
+
+; ---
+
+<a name="L10ED"></a>;; <b>S-TIGHTER</b>
+L10ED: PUSH DE ; push last values and consider these
+
+ LD A,C ; get the present operator.
+ BIT 6,(IY+$01) ; test FLAGS - Numeric or string result?
+ JR NZ,<A href="#L110A">L110A</a> ; forward if numeric to S-NEXT
+
+ AND $3F ; strip indicator bits to give clear literal.
+ ADD A,$08 ; add eight - augmenting numeric to equivalent
+ ; string literals.
+ LD C,A ; place plain literal back in C.
+ CP $10 ; compare to 'AND'
+ JR NZ,<A href="#L1102">L1102</a> ; forward if not to S-NOT-AND
+
+ SET 6,C ; set the numeric operand required for 'AND'
+ JR <A href="#L110A">L110A</a> ; forward to S-NEXT
+
+; ---
+
+<a name="L1102"></a>;; <b>S-NOT-AND</b>
+L1102: JR C,<A href="#L10DB">L10DB</a> ; back if less than 'AND' to S-RPORT-C
+ ; Nonsense if '-', '*' etc.
+
+ CP $17 ; compare to 'strs-add' literal
+ JR Z,<A href="#L110A">L110A</a> ; forward if so signaling string result
+
+ SET 7,C ; set bit to numeric (Boolean) for others.
+
+<a name="L110A"></a>;; <b>S-NEXT</b>
+L110A: PUSH BC ; stack 'present' values
+
+ RST 20H ; NEXT-CHAR
+ JP <A href="#L0F59">L0F59</a> ; jump back to S-LOOP-1
+
+
+
+; -------------------------
+; THE <b><font color=#333388>'TABLE OF PRIORITIES'</font></b>
+; -------------------------
+;
+;
+
+<a name="L110F"></a>;; <b>tbl-pri</b>
+L110F: DEFB $06 ; '-'
+ DEFB $08 ; '*'
+ DEFB $08 ; '/'
+ DEFB $0A ; '**'
+ DEFB $02 ; 'OR'
+ DEFB $03 ; 'AND'
+ DEFB $05 ; '<='
+ DEFB $05 ; '>='
+ DEFB $05 ; '<>'
+ DEFB $05 ; '>'
+ DEFB $05 ; '<'
+ DEFB $05 ; '='
+ DEFB $06 ; '+'
+
+
+; --------------------------
+; THE <b><font color=#333388>'LOOK-VARS'</font></b> SUBROUTINE
+; --------------------------
+;
+;
+
+<a name="L111C"></a>;; <b>LOOK-VARS</b>
+L111C: SET 6,(IY+$01) ; sv FLAGS - Signal numeric result
+
+ RST 18H ; GET-CHAR
+ CALL <A href="#L14CE">L14CE</a> ; routine ALPHA
+ JP NC,<A href="#L0D9A">L0D9A</a> ; to REPORT-C
+
+ PUSH HL ;
+ LD C,A ;
+
+ RST 20H ; NEXT-CHAR
+ PUSH HL ;
+ RES 5,C ;
+ CP $10 ;
+ JR Z,<A href="#L1148">L1148</a> ; to V-SYN/RUN
+
+ SET 6,C ;
+ CP $0D ;
+ JR Z,<A href="#L1143">L1143</a> ; forward to V-STR-VAR
+
+ SET 5,C ;
+
+<a name="L1139"></a>;; <b>V-CHAR</b>
+L1139: CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM
+ JR NC,<A href="#L1148">L1148</a> ; forward when not to V-RUN/SYN
+
+ RES 6,C ;
+
+ RST 20H ; NEXT-CHAR
+ JR <A href="#L1139">L1139</a> ; loop back to V-CHAR
+
+; ---
+
+<a name="L1143"></a>;; <b>V-STR-VAR</b>
+L1143: RST 20H ; NEXT-CHAR
+ RES 6,(IY+$01) ; sv FLAGS - Signal string result
+
+<a name="L1148"></a>;; <b>V-RUN/SYN</b>
+L1148: LD B,C ;
+ CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ JR NZ,<A href="#L1156">L1156</a> ; forward to V-RUN
+
+ LD A,C ;
+ AND $E0 ;
+ SET 7,A ;
+ LD C,A ;
+ JR <A href="#L118A">L118A</a> ; forward to V-SYNTAX
+
+; ---
+
+<a name="L1156"></a>;; <b>V-RUN</b>
+L1156: LD HL,($4010) ; sv VARS
+
+<a name="L1159"></a>;; <b>V-EACH</b>
+L1159: LD A,(HL) ;
+ AND $7F ;
+ JR Z,<A href="#L1188">L1188</a> ; to V-80-BYTE
+
+ CP C ;
+ JR NZ,<A href="#L1180">L1180</a> ; to V-NEXT
+
+ RLA ;
+ ADD A,A ;
+ JP P,<A href="#L1195">L1195</a> ; to V-FOUND-2
+
+ JR C,<A href="#L1195">L1195</a> ; to V-FOUND-2
+
+ POP DE ;
+ PUSH DE ;
+ PUSH HL ;
+
+<a name="L116B"></a>;; <b>V-MATCHES</b>
+L116B: INC HL ;
+
+<a name="L116C"></a>;; <b>V-SPACES</b>
+L116C: LD A,(DE) ;
+ INC DE ;
+ AND A ;
+ JR Z,<A href="#L116C">L116C</a> ; back to V-SPACES
+
+ CP (HL) ;
+ JR Z,<A href="#L116B">L116B</a> ; back to V-MATCHES
+
+ OR $80 ;
+ CP (HL) ;
+ JR NZ,<A href="#L117F">L117F</a> ; forward to V-GET-PTR
+
+ LD A,(DE) ;
+ CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM
+ JR NC,<A href="#L1194">L1194</a> ; forward to V-FOUND-1
+
+<a name="L117F"></a>;; <b>V-GET-PTR</b>
+L117F: POP HL ;
+
+<a name="L1180"></a>;; <b>V-NEXT</b>
+L1180: PUSH BC ;
+ CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE
+ EX DE,HL ;
+ POP BC ;
+ JR <A href="#L1159">L1159</a> ; back to V-EACH
+
+; ---
+
+<a name="L1188"></a>;; <b>V-80-BYTE</b>
+L1188: SET 7,B ;
+
+<a name="L118A"></a>;; <b>V-SYNTAX</b>
+L118A: POP DE ;
+
+ RST 18H ; GET-CHAR
+ CP $10 ;
+ JR Z,<A href="#L1199">L1199</a> ; forward to V-PASS
+
+ SET 5,B ;
+ JR <A href="#L11A1">L11A1</a> ; forward to V-END
+
+; ---
+
+<a name="L1194"></a>;; <b>V-FOUND-1</b>
+L1194: POP DE ;
+
+<a name="L1195"></a>;; <b>V-FOUND-2</b>
+L1195: POP DE ;
+ POP DE ;
+ PUSH HL ;
+
+ RST 18H ; GET-CHAR
+
+<a name="L1199"></a>;; <b>V-PASS</b>
+L1199: CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM
+ JR NC,<A href="#L11A1">L11A1</a> ; forward if not alphanumeric to V-END
+
+
+ RST 20H ; NEXT-CHAR
+ JR <A href="#L1199">L1199</a> ; back to V-PASS
+
+; ---
+
+<a name="L11A1"></a>;; <b>V-END</b>
+L11A1: POP HL ;
+ RL B ;
+ BIT 6,B ;
+ RET ;
+
+; ------------------------
+; THE <b><font color=#333388>'STK-VAR'</font></b> SUBROUTINE
+; ------------------------
+;
+;
+
+<a name="L11A7"></a>;; <b>STK-VAR</b>
+L11A7: XOR A ;
+ LD B,A ;
+ BIT 7,C ;
+ JR NZ,<A href="#L11F8">L11F8</a> ; forward to SV-COUNT
+
+ BIT 7,(HL) ;
+ JR NZ,<A href="#L11BF">L11BF</a> ; forward to SV-ARRAYS
+
+ INC A ;
+
+<a name="L11B2"></a>;; <b>SV-SIMPLE$</b>
+L11B2: INC HL ;
+ LD C,(HL) ;
+ INC HL ;
+ LD B,(HL) ;
+ INC HL ;
+ EX DE,HL ;
+ CALL <A href="#L12C3">L12C3</a> ; routine STK-STO-$
+
+ RST 18H ; GET-CHAR
+ JP <A href="#L125A">L125A</a> ; jump forward to SV-SLICE?
+
+; ---
+
+<a name="L11BF"></a>;; <b>SV-ARRAYS</b>
+L11BF: INC HL ;
+ INC HL ;
+ INC HL ;
+ LD B,(HL) ;
+ BIT 6,C ;
+ JR Z,<A href="#L11D1">L11D1</a> ; forward to SV-PTR
+
+ DEC B ;
+ JR Z,<A href="#L11B2">L11B2</a> ; forward to SV-SIMPLE$
+
+ EX DE,HL ;
+
+ RST 18H ; GET-CHAR
+ CP $10 ;
+ JR NZ,<A href="#L1231">L1231</a> ; forward to REPORT-3
+
+ EX DE,HL ;
+
+<a name="L11D1"></a>;; <b>SV-PTR</b>
+L11D1: EX DE,HL ;
+ JR <A href="#L11F8">L11F8</a> ; forward to SV-COUNT
+
+; ---
+
+<a name="L11D4"></a>;; <b>SV-COMMA</b>
+L11D4: PUSH HL ;
+
+ RST 18H ; GET-CHAR
+ POP HL ;
+ CP $1A ;
+ JR Z,<A href="#L11FB">L11FB</a> ; forward to SV-LOOP
+
+ BIT 7,C ;
+ JR Z,<A href="#L1231">L1231</a> ; forward to REPORT-3
+
+ BIT 6,C ;
+ JR NZ,<A href="#L11E9">L11E9</a> ; forward to SV-CLOSE
+
+ CP $11 ;
+ JR NZ,<A href="#L1223">L1223</a> ; forward to SV-RPT-C
+
+
+ RST 20H ; NEXT-CHAR
+ RET ;
+
+; ---
+
+<a name="L11E9"></a>;; <b>SV-CLOSE</b>
+L11E9: CP $11 ;
+ JR Z,<A href="#L1259">L1259</a> ; forward to SV-DIM
+
+ CP $DF ;
+ JR NZ,<A href="#L1223">L1223</a> ; forward to SV-RPT-C
+
+
+<a name="L11F1"></a>;; <b>SV-CH-ADD</b>
+L11F1: RST 18H ; GET-CHAR
+ DEC HL ;
+ LD ($4016),HL ; sv CH_ADD
+ JR <A href="#L1256">L1256</a> ; forward to SV-SLICE
+
+; ---
+
+<a name="L11F8"></a>;; <b>SV-COUNT</b>
+L11F8: LD HL,$0000 ;
+
+<a name="L11FB"></a>;; <b>SV-LOOP</b>
+L11FB: PUSH HL ;
+
+ RST 20H ; NEXT-CHAR
+ POP HL ;
+ LD A,C ;
+ CP $C0 ;
+ JR NZ,<A href="#L120C">L120C</a> ; forward to SV-MULT
+
+
+ RST 18H ; GET-CHAR
+ CP $11 ;
+ JR Z,<A href="#L1259">L1259</a> ; forward to SV-DIM
+
+ CP $DF ;
+ JR Z,<A href="#L11F1">L11F1</a> ; back to SV-CH-ADD
+
+<a name="L120C"></a>;; <b>SV-MULT</b>
+L120C: PUSH BC ;
+ PUSH HL ;
+ CALL <A href="#L12FF">L12FF</a> ; routine DE,(DE+1)
+ EX (SP),HL ;
+ EX DE,HL ;
+ CALL <A href="#L12DD">L12DD</a> ; routine INT-EXP1
+ JR C,<A href="#L1231">L1231</a> ; forward to REPORT-3
+
+ DEC BC ;
+ CALL <A href="#L1305">L1305</a> ; routine GET-HL*DE
+ ADD HL,BC ;
+ POP DE ;
+ POP BC ;
+ DJNZ <A href="#L11D4">L11D4</a> ; loop back to SV-COMMA
+
+ BIT 7,C ;
+
+<a name="L1223"></a>;; <b>SV-RPT-C</b>
+L1223: JR NZ,<A href="#L128B">L128B</a> ; relative jump to SL-RPT-C
+
+ PUSH HL ;
+ BIT 6,C ;
+ JR NZ,<A href="#L123D">L123D</a> ; forward to SV-ELEM$
+
+ LD B,D ;
+ LD C,E ;
+
+ RST 18H ; GET-CHAR
+ CP $11 ; is character a ')' ?
+ JR Z,<A href="#L1233">L1233</a> ; skip forward to SV-NUMBER
+
+
+<a name="L1231"></a>;; <b>REPORT-3</b>
+L1231: RST 08H ; ERROR-1
+ DEFB $02 ; Error Report: Subscript wrong
+
+
+<a name="L1233"></a>;; <b>SV-NUMBER</b>
+L1233: RST 20H ; NEXT-CHAR
+ POP HL ;
+ LD DE,$0005 ;
+ CALL <A href="#L1305">L1305</a> ; routine GET-HL*DE
+ ADD HL,BC ;
+ RET ; return >>
+
+; ---
+
+<a name="L123D"></a>;; <b>SV-ELEM$</b>
+L123D: CALL <A href="#L12FF">L12FF</a> ; routine DE,(DE+1)
+ EX (SP),HL ;
+ CALL <A href="#L1305">L1305</a> ; routine GET-HL*DE
+ POP BC ;
+ ADD HL,BC ;
+ INC HL ;
+ LD B,D ;
+ LD C,E ;
+ EX DE,HL ;
+ CALL <A href="#L12C2">L12C2</a> ; routine STK-ST-0
+
+ RST 18H ; GET-CHAR
+ CP $11 ; is it ')' ?
+ JR Z,<A href="#L1259">L1259</a> ; forward if so to SV-DIM
+
+ CP $1A ; is it ',' ?
+ JR NZ,<A href="#L1231">L1231</a> ; back if not to REPORT-3
+
+<a name="L1256"></a>;; <b>SV-SLICE</b>
+L1256: CALL <A href="#L1263">L1263</a> ; routine SLICING
+
+<a name="L1259"></a>;; <b>SV-DIM</b>
+L1259: RST 20H ; NEXT-CHAR
+
+<a name="L125A"></a>;; <b>SV-SLICE?</b>
+L125A: CP $10 ;
+ JR Z,<A href="#L1256">L1256</a> ; back to SV-SLICE
+
+ RES 6,(IY+$01) ; sv FLAGS - Signal string result
+ RET ; return.
+
+; ------------------------
+; THE <b><font color=#333388>'SLICING'</font></b> SUBROUTINE
+; ------------------------
+;
+;
+
+<a name="L1263"></a>;; <b>SLICING</b>
+L1263: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ CALL NZ,<A href="#L13F8">L13F8</a> ; routine STK-FETCH
+
+ RST 20H ; NEXT-CHAR
+ CP $11 ; is it ')' ?
+ JR Z,<A href="#L12BE">L12BE</a> ; forward if so to SL-STORE
+
+ PUSH DE ;
+ XOR A ;
+ PUSH AF ;
+ PUSH BC ;
+ LD DE,$0001 ;
+
+ RST 18H ; GET-CHAR
+ POP HL ;
+ CP $DF ; is it 'TO' ?
+ JR Z,<A href="#L1292">L1292</a> ; forward if so to SL-SECOND
+
+ POP AF ;
+ CALL <A href="#L12DE">L12DE</a> ; routine INT-EXP2
+ PUSH AF ;
+ LD D,B ;
+ LD E,C ;
+ PUSH HL ;
+
+ RST 18H ; GET-CHAR
+ POP HL ;
+ CP $DF ; is it 'TO' ?
+ JR Z,<A href="#L1292">L1292</a> ; forward if so to SL-SECOND
+
+ CP $11 ;
+
+<a name="L128B"></a>;; <b>SL-RPT-C</b>
+L128B: JP NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C
+
+ LD H,D ;
+ LD L,E ;
+ JR <A href="#L12A5">L12A5</a> ; forward to SL-DEFINE
+
+; ---
+
+<a name="L1292"></a>;; <b>SL-SECOND</b>
+L1292: PUSH HL ;
+
+ RST 20H ; NEXT-CHAR
+ POP HL ;
+ CP $11 ; is it ')' ?
+ JR Z,<A href="#L12A5">L12A5</a> ; forward if so to SL-DEFINE
+
+ POP AF ;
+ CALL <A href="#L12DE">L12DE</a> ; routine INT-EXP2
+ PUSH AF ;
+
+ RST 18H ; GET-CHAR
+ LD H,B ;
+ LD L,C ;
+ CP $11 ; is it ')' ?
+ JR NZ,<A href="#L128B">L128B</a> ; back if not to SL-RPT-C
+
+<a name="L12A5"></a>;; <b>SL-DEFINE</b>
+L12A5: POP AF ;
+ EX (SP),HL ;
+ ADD HL,DE ;
+ DEC HL ;
+ EX (SP),HL ;
+ AND A ;
+ SBC HL,DE ;
+ LD BC,$0000 ;
+ JR C,<A href="#L12B9">L12B9</a> ; forward to SL-OVER
+
+ INC HL ;
+ AND A ;
+ JP M,<A href="#L1231">L1231</a> ; jump back to REPORT-3
+
+ LD B,H ;
+ LD C,L ;
+
+<a name="L12B9"></a>;; <b>SL-OVER</b>
+L12B9: POP DE ;
+ RES 6,(IY+$01) ; sv FLAGS - Signal string result
+
+<a name="L12BE"></a>;; <b>SL-STORE</b>
+L12BE: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ RET Z ; return if checking syntax.
+
+; --------------------------
+; THE <b><font color=#333388>'STK-STORE'</font></b> SUBROUTINE
+; --------------------------
+;
+;
+
+<a name="L12C2"></a>;; <b>STK-ST-0</b>
+L12C2: XOR A ;
+
+<a name="L12C3"></a>;; <b>STK-STO-$</b>
+L12C3: PUSH BC ;
+ CALL <A href="#L19EB">L19EB</a> ; routine TEST-5-SP
+ POP BC ;
+ LD HL,($401C) ; sv STKEND
+ LD (HL),A ;
+ INC HL ;
+ LD (HL),E ;
+ INC HL ;
+ LD (HL),D ;
+ INC HL ;
+ LD (HL),C ;
+ INC HL ;
+ LD (HL),B ;
+ INC HL ;
+ LD ($401C),HL ; sv STKEND
+ RES 6,(IY+$01) ; update FLAGS - signal string result
+ RET ; return.
+
+; -------------------------
+; THE <b><font color=#333388>'INT EXP'</font></b> SUBROUTINES
+; -------------------------
+;
+;
+
+<a name="L12DD"></a>;; <b>INT-EXP1</b>
+L12DD: XOR A ;
+
+<a name="L12DE"></a>;; <b>INT-EXP2</b>
+L12DE: PUSH DE ;
+ PUSH HL ;
+ PUSH AF ;
+ CALL <A href="#L0D92">L0D92</a> ; routine CLASS-6
+ POP AF ;
+ CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ JR Z,<A href="#L12FC">L12FC</a> ; forward if checking syntax to I-RESTORE
+
+ PUSH AF ;
+ CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT
+ POP DE ;
+ LD A,B ;
+ OR C ;
+ SCF ; Set Carry Flag
+ JR Z,<A href="#L12F9">L12F9</a> ; forward to I-CARRY
+
+ POP HL ;
+ PUSH HL ;
+ AND A ;
+ SBC HL,BC ;
+
+<a name="L12F9"></a>;; <b>I-CARRY</b>
+L12F9: LD A,D ;
+ SBC A,$00 ;
+
+<a name="L12FC"></a>;; <b>I-RESTORE</b>
+L12FC: POP HL ;
+ POP DE ;
+ RET ;
+
+; --------------------------
+; THE <b><font color=#333388>'DE,(DE+1)'</font></b> SUBROUTINE
+; --------------------------
+; INDEX and LOAD Z80 subroutine.
+; This emulates the 6800 processor instruction LDX 1,X which loads a two-byte
+; value from memory into the register indexing it. Often these are hardly worth
+; the bother of writing as subroutines and this one doesn't save any time or
+; memory. The timing and space overheads have to be offset against the ease of
+; writing and the greater program readability from using such toolkit routines.
+
+<a name="L12FF"></a>;; <b>DE,(DE+1)</b>
+L12FF: EX DE,HL ; move index address into HL.
+ INC HL ; increment to address word.
+ LD E,(HL) ; pick up word low-order byte.
+ INC HL ; index high-order byte and
+ LD D,(HL) ; pick it up.
+ RET ; return with DE = word.
+
+; --------------------------
+; THE <b><font color=#333388>'GET-HL*DE'</font></b> SUBROUTINE
+; --------------------------
+;
+
+<a name="L1305"></a>;; <b>GET-HL*DE</b>
+L1305: CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ RET Z ;
+
+ PUSH BC ;
+ LD B,$10 ;
+ LD A,H ;
+ LD C,L ;
+ LD HL,$0000 ;
+
+<a name="L1311"></a>;; <b>HL-LOOP</b>
+L1311: ADD HL,HL ;
+ JR C,<A href="#L131A">L131A</a> ; forward with carry to HL-END
+
+ RL C ;
+ RLA ;
+ JR NC,<A href="#L131D">L131D</a> ; forward with no carry to HL-AGAIN
+
+ ADD HL,DE ;
+
+<a name="L131A"></a>;; <b>HL-END</b>
+L131A: JP C,<A href="#L0ED3">L0ED3</a> ; to REPORT-4
+
+<a name="L131D"></a>;; <b>HL-AGAIN</b>
+L131D: DJNZ <A href="#L1311">L1311</a> ; loop back to HL-LOOP
+
+ POP BC ;
+ RET ; return.
+
+; --------------------
+; THE <b><font color=#333388>'LET'</font></b> SUBROUTINE
+; --------------------
+;
+;
+
+<a name="L1321"></a>;; <b>LET</b>
+L1321: LD HL,($4012) ; sv DEST-lo
+ BIT 1,(IY+$2D) ; sv FLAGX
+ JR Z,<A href="#L136E">L136E</a> ; forward to L-EXISTS
+
+ LD BC,$0005 ;
+
+<a name="L132D"></a>;; <b>L-EACH-CH</b>
+L132D: INC BC ;
+
+; check
+
+<a name="L132E"></a>;; <b>L-NO-SP</b>
+L132E: INC HL ;
+ LD A,(HL) ;
+ AND A ;
+ JR Z,<A href="#L132E">L132E</a> ; back to L-NO-SP
+
+ CALL <A href="#L14D2">L14D2</a> ; routine ALPHANUM
+ JR C,<A href="#L132D">L132D</a> ; back to L-EACH-CH
+
+ CP $0D ; is it '$' ?
+ JP Z,<A href="#L13C8">L13C8</a> ; forward if so to L-NEW$
+
+
+ RST 30H ; BC-SPACES
+ PUSH DE ;
+ LD HL,($4012) ; sv DEST
+ DEC DE ;
+ LD A,C ;
+ SUB $06 ;
+ LD B,A ;
+ LD A,$40 ;
+ JR Z,<A href="#L1359">L1359</a> ; forward to L-SINGLE
+
+<a name="L134B"></a>;; <b>L-CHAR</b>
+L134B: INC HL ;
+ LD A,(HL) ;
+ AND A ; is it a space ?
+ JR Z,<A href="#L134B">L134B</a> ; back to L-CHAR
+
+ INC DE ;
+ LD (DE),A ;
+ DJNZ <A href="#L134B">L134B</a> ; loop back to L-CHAR
+
+ OR $80 ;
+ LD (DE),A ;
+ LD A,$80 ;
+
+<a name="L1359"></a>;; <b>L-SINGLE</b>
+L1359: LD HL,($4012) ; sv DEST-lo
+ XOR (HL) ;
+ POP HL ;
+ CALL <A href="#L13E7">L13E7</a> ; routine L-FIRST
+
+<a name="L1361"></a>;; <b>L-NUMERIC</b>
+L1361: PUSH HL ;
+
+ RST 28H ;; FP-CALC
+ DEFB $02 ;;delete
+ DEFB $34 ;;end-calc
+
+ POP HL ;
+ LD BC,$0005 ;
+ AND A ;
+ SBC HL,BC ;
+ JR <A href="#L13AE">L13AE</a> ; forward to L-ENTER
+
+; ---
+
+<a name="L136E"></a>;; <b>L-EXISTS</b>
+L136E: BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result?
+ JR Z,<A href="#L137A">L137A</a> ; forward to L-DELETE$
+
+ LD DE,$0006 ;
+ ADD HL,DE ;
+ JR <A href="#L1361">L1361</a> ; back to L-NUMERIC
+
+; ---
+
+<a name="L137A"></a>;; <b>L-DELETE$</b>
+L137A: LD HL,($4012) ; sv DEST-lo
+ LD BC,($402E) ; sv STRLEN_lo
+ BIT 0,(IY+$2D) ; sv FLAGX
+ JR NZ,<A href="#L13B7">L13B7</a> ; forward to L-ADD$
+
+ LD A,B ;
+ OR C ;
+ RET Z ;
+
+ PUSH HL ;
+
+ RST 30H ; BC-SPACES
+ PUSH DE ;
+ PUSH BC ;
+ LD D,H ;
+ LD E,L ;
+ INC HL ;
+ LD (HL),$00 ;
+ LDDR ; Copy Bytes
+ PUSH HL ;
+ CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH
+ POP HL ;
+ EX (SP),HL ;
+ AND A ;
+ SBC HL,BC ;
+ ADD HL,BC ;
+ JR NC,<A href="#L13A3">L13A3</a> ; forward to L-LENGTH
+
+ LD B,H ;
+ LD C,L ;
+
+<a name="L13A3"></a>;; <b>L-LENGTH</b>
+L13A3: EX (SP),HL ;
+ EX DE,HL ;
+ LD A,B ;
+ OR C ;
+ JR Z,<A href="#L13AB">L13AB</a> ; forward if zero to L-IN-W/S
+
+ LDIR ; Copy Bytes
+
+<a name="L13AB"></a>;; <b>L-IN-W/S</b>
+L13AB: POP BC ;
+ POP DE ;
+ POP HL ;
+
+; ------------------------
+; THE <b><font color=#333388>'L-ENTER'</font></b> SUBROUTINE
+; ------------------------
+;
+
+<a name="L13AE"></a>;; <b>L-ENTER</b>
+L13AE: EX DE,HL ;
+ LD A,B ;
+ OR C ;
+ RET Z ;
+
+ PUSH DE ;
+ LDIR ; Copy Bytes
+ POP HL ;
+ RET ; return.
+
+; ---
+
+<a name="L13B7"></a>;; <b>L-ADD$</b>
+L13B7: DEC HL ;
+ DEC HL ;
+ DEC HL ;
+ LD A,(HL) ;
+ PUSH HL ;
+ PUSH BC ;
+
+ CALL <A href="#L13CE">L13CE</a> ; routine L-STRING
+
+ POP BC ;
+ POP HL ;
+ INC BC ;
+ INC BC ;
+ INC BC ;
+ JP <A href="#L0A60">L0A60</a> ; jump back to exit via RECLAIM-2
+
+; ---
+
+<a name="L13C8"></a>;; <b>L-NEW$</b>
+L13C8: LD A,$60 ; prepare mask %01100000
+ LD HL,($4012) ; sv DEST-lo
+ XOR (HL) ;
+
+; -------------------------
+; THE <b><font color=#333388>'L-STRING'</font></b> SUBROUTINE
+; -------------------------
+;
+
+<a name="L13CE"></a>;; <b>L-STRING</b>
+L13CE: PUSH AF ;
+ CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH
+ EX DE,HL ;
+ ADD HL,BC ;
+ PUSH HL ;
+ INC BC ;
+ INC BC ;
+ INC BC ;
+
+ RST 30H ; BC-SPACES
+ EX DE,HL ;
+ POP HL ;
+ DEC BC ;
+ DEC BC ;
+ PUSH BC ;
+ LDDR ; Copy Bytes
+ EX DE,HL ;
+ POP BC ;
+ DEC BC ;
+ LD (HL),B ;
+ DEC HL ;
+ LD (HL),C ;
+ POP AF ;
+
+<a name="L13E7"></a>;; <b>L-FIRST</b>
+L13E7: PUSH AF ;
+ CALL <A href="#L14C7">L14C7</a> ; routine REC-V80
+ POP AF ;
+ DEC HL ;
+ LD (HL),A ;
+ LD HL,($401A) ; sv STKBOT_lo
+ LD ($4014),HL ; sv E_LINE_lo
+ DEC HL ;
+ LD (HL),$80 ;
+ RET ;
+
+; --------------------------
+; THE <b><font color=#333388>'STK-FETCH'</font></b> SUBROUTINE
+; --------------------------
+; This routine fetches a five-byte value from the calculator stack
+; reducing the pointer to the end of the stack by five.
+; For a floating-point number the exponent is in A and the mantissa
+; is the thirty-two bits EDCB.
+; For strings, the start of the string is in DE and the length in BC.
+; A is unused.
+
+<a name="L13F8"></a>;; <b>STK-FETCH</b>
+L13F8: LD HL,($401C) ; load HL from system variable STKEND
+
+ DEC HL ;
+ LD B,(HL) ;
+ DEC HL ;
+ LD C,(HL) ;
+ DEC HL ;
+ LD D,(HL) ;
+ DEC HL ;
+ LD E,(HL) ;
+ DEC HL ;
+ LD A,(HL) ;
+
+ LD ($401C),HL ; set system variable STKEND to lower value.
+ RET ; return.
+
+; -------------------------
+; THE <b><font color=#333388>'DIM'</font></b> COMMAND ROUTINE
+; -------------------------
+; An array is created and initialized to zeros which is also the space
+; character on the ZX81.
+
+<a name="L1409"></a>;; <b>DIM</b>
+L1409: CALL <A href="#L111C">L111C</a> ; routine LOOK-VARS
+
+<a name="L140C"></a>;; <b>D-RPORT-C</b>
+L140C: JP NZ,<A href="#L0D9A">L0D9A</a> ; to REPORT-C
+
+ CALL <A href="#L0DA6">L0DA6</a> ; routine SYNTAX-Z
+ JR NZ,<A href="#L141C">L141C</a> ; forward to D-RUN
+
+ RES 6,C ;
+ CALL <A href="#L11A7">L11A7</a> ; routine STK-VAR
+ CALL <A href="#L0D1D">L0D1D</a> ; routine CHECK-END
+
+<a name="L141C"></a>;; <b>D-RUN</b>
+L141C: JR C,<A href="#L1426">L1426</a> ; forward to D-LETTER
+
+ PUSH BC ;
+ CALL <A href="#L09F2">L09F2</a> ; routine NEXT-ONE
+ CALL <A href="#L0A60">L0A60</a> ; routine RECLAIM-2
+ POP BC ;
+
+<a name="L1426"></a>;; <b>D-LETTER</b>
+L1426: SET 7,C ;
+ LD B,$00 ;
+ PUSH BC ;
+ LD HL,$0001 ;
+ BIT 6,C ;
+ JR NZ,<A href="#L1434">L1434</a> ; forward to D-SIZE
+
+ LD L,$05 ;
+
+<a name="L1434"></a>;; <b>D-SIZE</b>
+L1434: EX DE,HL ;
+
+<a name="L1435"></a>;; <b>D-NO-LOOP</b>
+L1435: RST 20H ; NEXT-CHAR
+ LD H,$40 ;
+ CALL <A href="#L12DD">L12DD</a> ; routine INT-EXP1
+ JP C,<A href="#L1231">L1231</a> ; jump back to REPORT-3
+
+ POP HL ;
+ PUSH BC ;
+ INC H ;
+ PUSH HL ;
+ LD H,B ;
+ LD L,C ;
+ CALL <A href="#L1305">L1305</a> ; routine GET-HL*DE
+ EX DE,HL ;
+
+ RST 18H ; GET-CHAR
+ CP $1A ;
+ JR Z,<A href="#L1435">L1435</a> ; back to D-NO-LOOP
+
+ CP $11 ; is it ')' ?
+ JR NZ,<A href="#L140C">L140C</a> ; back if not to D-RPORT-C
+
+
+ RST 20H ; NEXT-CHAR
+ POP BC ;
+ LD A,C ;
+ LD L,B ;
+ LD H,$00 ;
+ INC HL ;
+ INC HL ;
+ ADD HL,HL ;
+ ADD HL,DE ;
+ JP C,<A href="#L0ED3">L0ED3</a> ; jump to REPORT-4
+
+ PUSH DE ;
+ PUSH BC ;
+ PUSH HL ;
+ LD B,H ;
+ LD C,L ;
+ LD HL,($4014) ; sv E_LINE_lo
+ DEC HL ;
+ CALL <A href="#L099E">L099E</a> ; routine MAKE-ROOM
+ INC HL ;
+ LD (HL),A ;
+ POP BC ;
+ DEC BC ;
+ DEC BC ;
+ DEC BC ;
+ INC HL ;
+ LD (HL),C ;
+ INC HL ;
+ LD (HL),B ;
+ POP AF ;
+ INC HL ;
+ LD (HL),A ;
+ LD H,D ;
+ LD L,E ;
+ DEC DE ;
+ LD (HL),$00 ;
+ POP BC ;
+ LDDR ; Copy Bytes
+
+<a name="L147F"></a>;; <b>DIM-SIZES</b>
+L147F: POP BC ;
+ LD (HL),B ;
+ DEC HL ;
+ LD (HL),C ;
+ DEC HL ;
+ DEC A ;
+ JR NZ,<A href="#L147F">L147F</a> ; back to DIM-SIZES
+
+ RET ; return.
+
+; ---------------------
+; THE <b><font color=#333388>'RESERVE'</font></b> ROUTINE
+; ---------------------
+;
+;
+
+<a name="L1488"></a>;; <b>RESERVE</b>
+L1488: LD HL,($401A) ; address STKBOT
+ DEC HL ; now last byte of workspace
+ CALL <A href="#L099E">L099E</a> ; routine MAKE-ROOM
+ INC HL ;
+ INC HL ;
+ POP BC ;
+ LD ($4014),BC ; sv E_LINE_lo
+ POP BC ;
+ EX DE,HL ;
+ INC HL ;
+ RET ;
+
+; ---------------------------
+; THE <b><font color=#333388>'CLEAR'</font></b> COMMAND ROUTINE
+; ---------------------------
+;
+;
+
+<a name="L149A"></a>;; <b>CLEAR</b>
+L149A: LD HL,($4010) ; sv VARS_lo
+ LD (HL),$80 ;
+ INC HL ;
+ LD ($4014),HL ; sv E_LINE_lo
+
+; -----------------------
+; THE <b><font color=#333388>'X-TEMP'</font></b> SUBROUTINE
+; -----------------------
+;
+;
+
+<a name="L14A3"></a>;; <b>X-TEMP</b>
+L14A3: LD HL,($4014) ; sv E_LINE_lo
+
+; ----------------------
+; THE <b><font color=#333388>'SET-STK'</font></b> ROUTINES
+; ----------------------
+;
+;
+
+<a name="L14A6"></a>;; <b>SET-STK-B</b>
+L14A6: LD ($401A),HL ; sv STKBOT
+
+;
+
+<a name="L14A9"></a>;; <b>SET-STK-E</b>
+L14A9: LD ($401C),HL ; sv STKEND
+ RET ;
+
+; -----------------------
+; THE <b><font color=#333388>'CURSOR-IN'</font></b> ROUTINE
+; -----------------------
+; This routine is called to set the edit line to the minimum cursor/newline
+; and to set STKEND, the start of free space, at the next position.
+
+<a name="L14AD"></a>;; <b>CURSOR-IN</b>
+L14AD: LD HL,($4014) ; fetch start of edit line from E_LINE
+ LD (HL),$7F ; insert cursor character
+
+ INC HL ; point to next location.
+ LD (HL),$76 ; insert NEWLINE character
+ INC HL ; point to next free location.
+
+ LD (IY+$22),$02 ; set lower screen display file size DF_SZ
+
+ JR <A href="#L14A6">L14A6</a> ; exit via SET-STK-B above
+
+; ------------------------
+; THE <b><font color=#333388>'SET-MIN'</font></b> SUBROUTINE
+; ------------------------
+;
+;
+
+<a name="L14BC"></a>;; <b>SET-MIN</b>
+L14BC: LD HL,$405D ; normal location of calculator's memory area
+ LD ($401F),HL ; update system variable MEM
+ LD HL,($401A) ; fetch STKBOT
+ JR <A href="#L14A9">L14A9</a> ; back to SET-STK-E
+
+
+; ------------------------------------
+; THE <b><font color=#333388>'RECLAIM THE END-MARKER'</font></b> ROUTINE
+; ------------------------------------
+
+<a name="L14C7"></a>;; <b>REC-V80</b>
+L14C7: LD DE,($4014) ; sv E_LINE_lo
+ JP <A href="#L0A5D">L0A5D</a> ; to RECLAIM-1
+
+; ----------------------
+; THE <b><font color=#333388>'ALPHA'</font></b> SUBROUTINE
+; ----------------------
+
+<a name="L14CE"></a>;; <b>ALPHA</b>
+L14CE: CP $26 ;
+ JR <A href="#L14D4">L14D4</a> ; skip forward to ALPHA-2
+
+
+; -------------------------
+; THE <b><font color=#333388>'ALPHANUM'</font></b> SUBROUTINE
+; -------------------------
+
+<a name="L14D2"></a>;; <b>ALPHANUM</b>
+L14D2: CP $1C ;
+
+
+<a name="L14D4"></a>;; <b>ALPHA-2</b>
+L14D4: CCF ; Complement Carry Flag
+ RET NC ;
+
+ CP $40 ;
+ RET ;
+
+
+; ------------------------------------------
+; THE <b><font color=#333388>'DECIMAL TO FLOATING POINT'</font></b> SUBROUTINE
+; ------------------------------------------
+;
+
+<a name="L14D9"></a>;; <b>DEC-TO-FP</b>
+L14D9: CALL <A href="#L1548">L1548</a> ; routine INT-TO-FP gets first part
+ CP $1B ; is character a '.' ?
+ JR NZ,<A href="#L14F5">L14F5</a> ; forward if not to E-FORMAT
+
+
+ RST 28H ;; FP-CALC
+ DEFB $A1 ;;stk-one
+ DEFB $C0 ;;st-mem-0
+ DEFB $02 ;;delete
+ DEFB $34 ;;end-calc
+
+
+<a name="L14E5"></a>;; <b>NXT-DGT-1</b>
+L14E5: RST 20H ; NEXT-CHAR
+ CALL <A href="#L1514">L1514</a> ; routine STK-DIGIT
+ JR C,<A href="#L14F5">L14F5</a> ; forward to E-FORMAT
+
+
+ RST 28H ;; FP-CALC
+ DEFB $E0 ;;get-mem-0
+ DEFB $A4 ;;stk-ten
+ DEFB $05 ;;division
+ DEFB $C0 ;;st-mem-0
+ DEFB $04 ;;multiply
+ DEFB $0F ;;addition
+ DEFB $34 ;;end-calc
+
+ JR <A href="#L14E5">L14E5</a> ; loop back till exhausted to NXT-DGT-1
+
+; ---
+
+<a name="L14F5"></a>;; <b>E-FORMAT</b>
+L14F5: CP $2A ; is character 'E' ?
+ RET NZ ; return if not
+
+ LD (IY+$5D),$FF ; initialize sv MEM-0-1st to $FF TRUE
+
+ RST 20H ; NEXT-CHAR
+ CP $15 ; is character a '+' ?
+ JR Z,<A href="#L1508">L1508</a> ; forward if so to SIGN-DONE
+
+ CP $16 ; is it a '-' ?
+ JR NZ,<A href="#L1509">L1509</a> ; forward if not to ST-E-PART
+
+ INC (IY+$5D) ; sv MEM-0-1st change to FALSE
+
+<a name="L1508"></a>;; <b>SIGN-DONE</b>
+L1508: RST 20H ; NEXT-CHAR
+
+<a name="L1509"></a>;; <b>ST-E-PART</b>
+L1509: CALL <A href="#L1548">L1548</a> ; routine INT-TO-FP
+
+ RST 28H ;; FP-CALC m, e.
+ DEFB $E0 ;;get-mem-0 m, e, (1/0) TRUE/FALSE
+ DEFB $00 ;;jump-true
+ DEFB $02 ;;to <A href="#L1511">L1511</a>, E-POSTVE
+ DEFB $18 ;;neg m, -e
+
+<a name="L1511"></a>;; <b>E-POSTVE</b>
+L1511: DEFB $38 ;;e-to-fp x.
+ DEFB $34 ;;end-calc x.
+
+ RET ; return.
+
+
+; --------------------------
+; THE <b><font color=#333388>'STK-DIGIT'</font></b> SUBROUTINE
+; --------------------------
+;
+
+<a name="L1514"></a>;; <b>STK-DIGIT</b>
+L1514: CP $1C ;
+ RET C ;
+
+ CP $26 ;
+ CCF ; Complement Carry Flag
+ RET C ;
+
+ SUB $1C ;
+
+; ------------------------
+; THE <b><font color=#333388>'STACK-A'</font></b> SUBROUTINE
+; ------------------------
+;
+
+
+<a name="L151D"></a>;; <b>STACK-A</b>
+L151D: LD C,A ;
+ LD B,$00 ;
+
+; -------------------------
+; THE <b><font color=#333388>'STACK-BC'</font></b> SUBROUTINE
+; -------------------------
+; The ZX81 does not have an integer number format so the BC register contents
+; must be converted to their full floating-point form.
+
+<a name="L1520"></a>;; <b>STACK-BC</b>
+L1520: LD IY,$4000 ; re-initialize the system variables pointer.
+ PUSH BC ; save the integer value.
+
+; now stack zero, five zero bytes as a starting point.
+
+ RST 28H ;; FP-CALC
+ DEFB $A0 ;;stk-zero 0.
+ DEFB $34 ;;end-calc
+
+ POP BC ; restore integer value.
+
+ LD (HL),$91 ; place $91 in exponent 65536.
+ ; this is the maximum possible value
+
+ LD A,B ; fetch hi-byte.
+ AND A ; test for zero.
+ JR NZ,<A href="#L1536">L1536</a> ; forward if not zero to STK-BC-2
+
+ LD (HL),A ; else make exponent zero again
+ OR C ; test lo-byte
+ RET Z ; return if BC was zero - done.
+
+; else there has to be a set bit if only the value one.
+
+ LD B,C ; save C in B.
+ LD C,(HL) ; fetch zero to C
+ LD (HL),$89 ; make exponent $89 256.
+
+<a name="L1536"></a>;; <b>STK-BC-2</b>
+L1536: DEC (HL) ; decrement exponent - halving number
+ SLA C ; C<-76543210<-0
+ RL B ; C<-76543210<-C
+ JR NC,<A href="#L1536">L1536</a> ; loop back if no carry to STK-BC-2
+
+ SRL B ; 0->76543210->C
+ RR C ; C->76543210->C
+
+ INC HL ; address first byte of mantissa
+ LD (HL),B ; insert B
+ INC HL ; address second byte of mantissa
+ LD (HL),C ; insert C
+
+ DEC HL ; point to the
+ DEC HL ; exponent again
+ RET ; return.
+
+; ------------------------------------------
+; THE <b><font color=#333388>'INTEGER TO FLOATING POINT'</font></b> SUBROUTINE
+; ------------------------------------------
+;
+;
+
+<a name="L1548"></a>;; <b>INT-TO-FP</b>
+L1548: PUSH AF ;
+
+ RST 28H ;; FP-CALC
+ DEFB $A0 ;;stk-zero
+ DEFB $34 ;;end-calc
+
+ POP AF ;
+
+<a name="L154D"></a>;; <b>NXT-DGT-2</b>
+L154D: CALL <A href="#L1514">L1514</a> ; routine STK-DIGIT
+ RET C ;
+
+
+ RST 28H ;; FP-CALC
+ DEFB $01 ;;exchange
+ DEFB $A4 ;;stk-ten
+ DEFB $04 ;;multiply
+ DEFB $0F ;;addition
+ DEFB $34 ;;end-calc
+
+
+ RST 20H ; NEXT-CHAR
+ JR <A href="#L154D">L154D</a> ; to NXT-DGT-2
+
+
+; -------------------------------------------
+; THE <b><font color=#333388>'E-FORMAT TO FLOATING POINT'</font></b> SUBROUTINE
+; -------------------------------------------
+; <font color=#339933>(Offset $38: 'e-to-fp')</font>
+; invoked from DEC-TO-FP and PRINT-FP.
+; e.g. 2.3E4 is 23000.
+; This subroutine evaluates xEm where m is a positive or negative integer.
+; At a simple level x is multiplied by ten for every unit of m.
+; If the decimal exponent m is negative then x is divided by ten for each unit.
+; A short-cut is taken if the exponent is greater than seven and in this
+; case the exponent is reduced by seven and the value is multiplied or divided
+; by ten million.
+; <font color=#9900FF>Note.</font> for the ZX Spectrum an even cleverer method was adopted which involved
+; shifting the bits out of the exponent so the result was achieved with six
+; shifts at most. The routine below had to be completely re-written mostly
+; in Z80 machine code.
+; Although no longer operable, the calculator literal was retained for old
+; times sake, the routine being invoked directly from a machine code CALL.
+;
+; On entry in the ZX81, m, the exponent, is the 'last value', and the
+; floating-point decimal mantissa is beneath it.
+
+
+<a name="L155A"></a>;; <b>e-to-fp</b>
+L155A: RST 28H ;; FP-CALC x, m.
+ DEFB $2D ;;duplicate x, m, m.
+ DEFB $32 ;;less-0 x, m, (1/0).
+ DEFB $C0 ;;st-mem-0 x, m, (1/0).
+ DEFB $02 ;;delete x, m.
+ DEFB $27 ;;abs x, +m.
+
+<a name="L1560"></a>;; <b>E-LOOP</b>
+L1560: DEFB $A1 ;;stk-one x, m,1.
+ DEFB $03 ;;subtract x, m-1.
+ DEFB $2D ;;duplicate x, m-1,m-1.
+ DEFB $32 ;;less-0 x, m-1, (1/0).
+ DEFB $00 ;;jump-true x, m-1.
+ DEFB $22 ;;to <A href="#L1587">L1587</a>, E-END x, m-1.
+
+ DEFB $2D ;;duplicate x, m-1, m-1.
+ DEFB $30 ;;stk-data
+ DEFB $33 ;;Exponent: $83, Bytes: 1
+
+ DEFB $40 ;;(+00,+00,+00) x, m-1, m-1, 6.
+ DEFB $03 ;;subtract x, m-1, m-7.
+ DEFB $2D ;;duplicate x, m-1, m-7, m-7.
+ DEFB $32 ;;less-0 x, m-1, m-7, (1/0).
+ DEFB $00 ;;jump-true x, m-1, m-7.
+ DEFB $0C ;;to <A href="#L157A">L157A</a>, E-LOW
+
+; but if exponent m is higher than 7 do a bigger chunk.
+; multiplying (or dividing if negative) by 10 million - 1e7.
+
+ DEFB $01 ;;exchange x, m-7, m-1.
+ DEFB $02 ;;delete x, m-7.
+ DEFB $01 ;;exchange m-7, x.
+ DEFB $30 ;;stk-data
+ DEFB $80 ;;Bytes: 3
+ DEFB $48 ;;Exponent $98
+ DEFB $18,$96,$80 ;;(+00) m-7, x, 10,000,000 (=f)
+ DEFB $2F ;;jump
+ DEFB $04 ;;to <A href="#L157D">L157D</a>, E-CHUNK
+
+; ---
+
+<a name="L157A"></a>;; <b>E-LOW</b>
+L157A: DEFB $02 ;;delete x, m-1.
+ DEFB $01 ;;exchange m-1, x.
+ DEFB $A4 ;;stk-ten m-1, x, 10 (=f).
+
+<a name="L157D"></a>;; <b>E-CHUNK</b>
+L157D: DEFB $E0 ;;get-mem-0 m-1, x, f, (1/0)
+ DEFB $00 ;;jump-true m-1, x, f
+ DEFB $04 ;;to <A href="#L1583">L1583</a>, E-DIVSN
+
+ DEFB $04 ;;multiply m-1, x*f.
+ DEFB $2F ;;jump
+ DEFB $02 ;;to <A href="#L1584">L1584</a>, E-SWAP
+
+; ---
+
+<a name="L1583"></a>;; <b>E-DIVSN</b>
+L1583: DEFB $05 ;;division m-1, x/f (= new x).
+
+<a name="L1584"></a>;; <b>E-SWAP</b>
+L1584: DEFB $01 ;;exchange x, m-1 (= new m).
+ DEFB $2F ;;jump x, m.
+ DEFB $DA ;;to <A href="#L1560">L1560</a>, E-LOOP
+
+; ---
+
+<a name="L1587"></a>;; <b>E-END</b>
+L1587: DEFB $02 ;;delete x. (-1)
+ DEFB $34 ;;end-calc x.
+
+ RET ; return.
+
+; -------------------------------------
+; THE <b><font color=#333388>'FLOATING-POINT TO BC'</font></b> SUBROUTINE
+; -------------------------------------
+; The floating-point form on the calculator stack is compressed directly into
+; the BC register rounding up if necessary.
+; Valid range is 0 to 65535.4999
+
+<a name="L158A"></a>;; <b>FP-TO-BC</b>
+L158A: CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH - exponent to A
+ ; mantissa to EDCB.
+ AND A ; test for value zero.
+ JR NZ,<A href="#L1595">L1595</a> ; forward if not to FPBC-NZRO
+
+; else value is zero
+
+ LD B,A ; zero to B
+ LD C,A ; also to C
+ PUSH AF ; save the flags on machine stack
+ JR <A href="#L15C6">L15C6</a> ; forward to FPBC-END
+
+; ---
+
+; EDCB => BCE
+
+<a name="L1595"></a>;; <b>FPBC-NZRO</b>
+L1595: LD B,E ; transfer the mantissa from EDCB
+ LD E,C ; to BCE. Bit 7 of E is the 17th bit which
+ LD C,D ; will be significant for rounding if the
+ ; number is already normalized.
+
+ SUB $91 ; subtract 65536
+ CCF ; complement carry flag
+ BIT 7,B ; test sign bit
+ PUSH AF ; push the result
+
+ SET 7,B ; set the implied bit
+ JR C,<A href="#L15C6">L15C6</a> ; forward with carry from SUB/CCF to FPBC-END
+ ; number is too big.
+
+ INC A ; increment the exponent and
+ NEG ; negate to make range $00 - $0F
+
+ CP $08 ; test if one or two bytes
+ JR C,<A href="#L15AF">L15AF</a> ; forward with two to BIG-INT
+
+ LD E,C ; shift mantissa
+ LD C,B ; 8 places right
+ LD B,$00 ; insert a zero in B
+ SUB $08 ; reduce exponent by eight
+
+<a name="L15AF"></a>;; <b>BIG-INT</b>
+L15AF: AND A ; test the exponent
+ LD D,A ; save exponent in D.
+
+ LD A,E ; fractional bits to A
+ RLCA ; rotate most significant bit to carry for
+ ; rounding of an already normal number.
+
+ JR Z,<A href="#L15BC">L15BC</a> ; forward if exponent zero to EXP-ZERO
+ ; the number is normalized
+
+<a name="L15B5"></a>;; <b>FPBC-NORM</b>
+L15B5: SRL B ; 0->76543210->C
+ RR C ; C->76543210->C
+
+ DEC D ; decrement exponent
+
+ JR NZ,<A href="#L15B5">L15B5</a> ; loop back till zero to FPBC-NORM
+
+<a name="L15BC"></a>;; <b>EXP-ZERO</b>
+L15BC: JR NC,<A href="#L15C6">L15C6</a> ; forward without carry to NO-ROUND
+
+ INC BC ; round up.
+ LD A,B ; test result
+ OR C ; for zero
+ JR NZ,<A href="#L15C6">L15C6</a> ; forward if not to GRE-ZERO
+
+ POP AF ; restore sign flag
+ SCF ; set carry flag to indicate overflow
+ PUSH AF ; save combined flags again
+
+<a name="L15C6"></a>;; <b>FPBC-END</b>
+L15C6: PUSH BC ; save BC value
+
+; set HL and DE to calculator stack pointers.
+
+ RST 28H ;; FP-CALC
+ DEFB $34 ;;end-calc
+
+
+ POP BC ; restore BC value
+ POP AF ; restore flags
+ LD A,C ; copy low byte to A also.
+ RET ; return
+
+; ------------------------------------
+; THE <b><font color=#333388>'FLOATING-POINT TO A'</font></b> SUBROUTINE
+; ------------------------------------
+;
+;
+
+<a name="L15CD"></a>;; <b>FP-TO-A</b>
+L15CD: CALL <A href="#L158A">L158A</a> ; routine FP-TO-BC
+ RET C ;
+
+ PUSH AF ;
+ DEC B ;
+ INC B ;
+ JR Z,<A href="#L15D9">L15D9</a> ; forward if in range to FP-A-END
+
+ POP AF ; fetch result
+ SCF ; set carry flag signaling overflow
+ RET ; return
+
+<a name="L15D9"></a>;; <b>FP-A-END</b>
+L15D9: POP AF ;
+ RET ;
+
+
+; ----------------------------------------------
+; THE <b><font color=#333388>'PRINT A FLOATING-POINT NUMBER'</font></b> SUBROUTINE
+; ----------------------------------------------
+; prints 'last value' x on calculator stack.
+; There are a wide variety of formats see Chapter 4.
+; e.g.
+; PI prints as 3.1415927
+; .123 prints as 0.123
+; .0123 prints as .0123
+; 999999999999 prints as 1000000000000
+; 9876543210123 prints as 9876543200000
+
+; Begin by isolating zero and just printing the '0' character
+; for that case. For negative numbers print a leading '-' and
+; then form the absolute value of x.
+
+<a name="L15DB"></a>;; <b>PRINT-FP</b>
+L15DB: RST 28H ;; FP-CALC x.
+ DEFB $2D ;;duplicate x, x.
+ DEFB $32 ;;less-0 x, (1/0).
+ DEFB $00 ;;jump-true
+ DEFB $0B ;;to <A href="#L15EA">L15EA</a>, PF-NGTVE x.
+
+ DEFB $2D ;;duplicate x, x
+ DEFB $33 ;;greater-0 x, (1/0).
+ DEFB $00 ;;jump-true
+ DEFB $0D ;;to <A href="#L15F0">L15F0</a>, PF-POSTVE x.
+
+ DEFB $02 ;;delete .
+ DEFB $34 ;;end-calc .
+
+ LD A,$1C ; load accumulator with character '0'
+
+ RST 10H ; PRINT-A
+ RET ; return. >>
+
+; ---
+
+<a name="L15EA"></a>;; <b>PF-NEGTVE</b>
+L15EA: DEFB $27 ; abs +x.
+ DEFB $34 ;;end-calc x.
+
+ LD A,$16 ; load accumulator with '-'
+
+ RST 10H ; PRINT-A
+
+ RST 28H ;; FP-CALC x.
+
+<a name="L15F0"></a>;; <b>PF-POSTVE</b>
+L15F0: DEFB $34 ;;end-calc x.
+
+; register HL addresses the exponent of the floating-point value.
+; if positive, and point floats to left, then bit 7 is set.
+
+ LD A,(HL) ; pick up the exponent byte
+ CALL <A href="#L151D">L151D</a> ; routine STACK-A places on calculator stack.
+
+; now calculate roughly the number of digits, n, before the decimal point by
+; subtracting a half from true exponent and multiplying by log to
+; the base 10 of 2.
+; The true number could be one higher than n, the integer result.
+
+ RST 28H ;; FP-CALC x, e.
+ DEFB $30 ;;stk-data
+ DEFB $78 ;;Exponent: $88, Bytes: 2
+ DEFB $00,$80 ;;(+00,+00) x, e, 128.5.
+ DEFB $03 ;;subtract x, e -.5.
+ DEFB $30 ;;stk-data
+ DEFB $EF ;;Exponent: $7F, Bytes: 4
+ DEFB $1A,$20,$9A,$85 ;; .30103 (log10 2)
+ DEFB $04 ;;multiply x,
+ DEFB $24 ;;int
+ DEFB $C1 ;;st-mem-1 x, n.
+
+
+ DEFB $30 ;;stk-data
+ DEFB $34 ;;Exponent: $84, Bytes: 1
+ DEFB $00 ;;(+00,+00,+00) x, n, 8.
+
+ DEFB $03 ;;subtract x, n-8.
+ DEFB $18 ;;neg x, 8-n.
+ DEFB $38 ;;e-to-fp x * (10^n)
+
+; finally the 8 or 9 digit decimal is rounded.
+; a ten-digit integer can arise in the case of, say, 999999999.5
+; which gives 1000000000.
+
+ DEFB $A2 ;;stk-half
+ DEFB $0F ;;addition
+ DEFB $24 ;;int i.
+ DEFB $34 ;;end-calc
+
+; If there were 8 digits then final rounding will take place on the calculator
+; stack above and the next two instructions insert a masked zero so that
+; no further rounding occurs. If the result is a 9 digit integer then
+; rounding takes place within the buffer.
+
+ LD HL,$406B ; address system variable MEM-2-5th
+ ; which could be the 'ninth' digit.
+ LD (HL),$90 ; insert the value $90 10010000
+
+; now starting from lowest digit lay down the 8, 9 or 10 digit integer
+; which represents the significant portion of the number
+; e.g. PI will be the nine-digit integer 314159265
+
+ LD B,$0A ; count is ten digits.
+
+<a name="L1615"></a>;; <b>PF-LOOP</b>
+L1615: INC HL ; increase pointer
+
+ PUSH HL ; preserve buffer address.
+ PUSH BC ; preserve counter.
+
+ RST 28H ;; FP-CALC i.
+ DEFB $A4 ;;stk-ten i, 10.
+ DEFB $2E ;;n-mod-m i mod 10, i/10
+ DEFB $01 ;;exchange i/10, remainder.
+ DEFB $34 ;;end-calc
+
+ CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A $00-$09
+
+ OR $90 ; make left hand nibble 9
+
+ POP BC ; restore counter
+ POP HL ; restore buffer address.
+
+ LD (HL),A ; insert masked digit in buffer.
+ DJNZ <A href="#L1615">L1615</a> ; loop back for all ten to PF-LOOP
+
+; the most significant digit will be last but if the number is exhausted then
+; the last one or two positions will contain zero ($90).
+
+; e.g. for 'one' we have zero as estimate of leading digits.
+; 1*10^8 100000000 as integer value
+; 90 90 90 90 90 90 90 90 91 90 as buffer mem3/mem4 contents.
+
+
+ INC HL ; advance pointer to one past buffer
+ LD BC,$0008 ; set C to 8 ( B is already zero )
+ PUSH HL ; save pointer.
+
+<a name="L162C"></a>;; <b>PF-NULL</b>
+L162C: DEC HL ; decrease pointer
+ LD A,(HL) ; fetch masked digit
+ CP $90 ; is it a leading zero ?
+ JR Z,<A href="#L162C">L162C</a> ; loop back if so to PF-NULL
+
+; at this point a significant digit has been found. carry is reset.
+
+ SBC HL,BC ; subtract eight from the address.
+ PUSH HL ; ** save this pointer too
+ LD A,(HL) ; fetch addressed byte
+ ADD A,$6B ; add $6B - forcing a round up ripple
+ ; if $95 or over.
+ PUSH AF ; save the carry result.
+
+; now enter a loop to round the number. After rounding has been considered
+; a zero that has arisen from rounding or that was present at that position
+; originally is changed from $90 to $80.
+
+<a name="L1639"></a>;; <b>PF-RND-LP</b>
+L1639: POP AF ; retrieve carry from machine stack.
+ INC HL ; increment address
+ LD A,(HL) ; fetch new byte
+ ADC A,$00 ; add in any carry
+
+ DAA ; decimal adjust accumulator
+ ; carry will ripple through the '9'
+
+ PUSH AF ; save carry on machine stack.
+ AND $0F ; isolate character 0 - 9 AND set zero flag
+ ; if zero.
+ LD (HL),A ; place back in location.
+ SET 7,(HL) ; set bit 7 to show printable.
+ ; but not if trailing zero after decimal point.
+ JR Z,<A href="#L1639">L1639</a> ; back if a zero to PF-RND-LP
+ ; to consider further rounding and/or trailing
+ ; zero identification.
+
+ POP AF ; balance stack
+ POP HL ; ** retrieve lower pointer
+
+; now insert 6 trailing zeros which are printed if before the decimal point
+; but mark the end of printing if after decimal point.
+; e.g. 9876543210123 is printed as 9876543200000
+; 123.456001 is printed as 123.456
+
+ LD B,$06 ; the count is six.
+
+<a name="L164B"></a>;; <b>PF-ZERO-6</b>
+L164B: LD (HL),$80 ; insert a masked zero
+ DEC HL ; decrease pointer.
+ DJNZ <A href="#L164B">L164B</a> ; loop back for all six to PF-ZERO-6
+
+; n-mod-m reduced the number to zero and this is now deleted from the calculator
+; stack before fetching the original estimate of leading digits.
+
+
+ RST 28H ;; FP-CALC 0.
+ DEFB $02 ;;delete .
+ DEFB $E1 ;;get-mem-1 n.
+ DEFB $34 ;;end-calc n.
+
+ CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A
+ JR Z,<A href="#L165B">L165B</a> ; skip forward if positive to PF-POS
+
+ NEG ; negate makes positive
+
+<a name="L165B"></a>;; <b>PF-POS</b>
+L165B: LD E,A ; transfer count of digits to E
+ INC E ; increment twice
+ INC E ;
+ POP HL ; * retrieve pointer to one past buffer.
+
+<a name="L165F"></a>;; <b>GET-FIRST</b>
+L165F: DEC HL ; decrement address.
+ DEC E ; decrement digit counter.
+ LD A,(HL) ; fetch masked byte.
+ AND $0F ; isolate right-hand nibble.
+ JR Z,<A href="#L165F">L165F</a> ; back with leading zero to GET-FIRST
+
+; now determine if E-format printing is needed
+
+ LD A,E ; transfer now accurate number count to A.
+ SUB $05 ; subtract five
+ CP $08 ; compare with 8 as maximum digits is 13.
+ JP P,<A href="#L1682">L1682</a> ; forward if positive to PF-E-FMT
+
+ CP $F6 ; test for more than four zeros after point.
+ JP M,<A href="#L1682">L1682</a> ; forward if so to PF-E-FMT
+
+ ADD A,$06 ; test for zero leading digits, e.g. 0.5
+ JR Z,<A href="#L16BF">L16BF</a> ; forward if so to PF-ZERO-1
+
+ JP M,<A href="#L16B2">L16B2</a> ; forward if more than one zero to PF-ZEROS
+
+; else digits before the decimal point are to be printed
+
+ LD B,A ; count of leading characters to B.
+
+<a name="L167B"></a>;; <b>PF-NIB-LP</b>
+L167B: CALL <A href="#L16D0">L16D0</a> ; routine PF-NIBBLE
+ DJNZ <A href="#L167B">L167B</a> ; loop back for counted numbers to PF-NIB-LP
+
+ JR <A href="#L16C2">L16C2</a> ; forward to consider decimal part to PF-DC-OUT
+
+; ---
+
+<a name="L1682"></a>;; <b>PF-E-FMT</b>
+L1682: LD B,E ; count to B
+ CALL <A href="#L16D0">L16D0</a> ; routine PF-NIBBLE prints one digit.
+ CALL <A href="#L16C2">L16C2</a> ; routine PF-DC-OUT considers fractional part.
+
+ LD A,$2A ; prepare character 'E'
+ RST 10H ; PRINT-A
+
+ LD A,B ; transfer exponent to A
+ AND A ; test the sign.
+ JP P,<A href="#L1698">L1698</a> ; forward if positive to PF-E-POS
+
+ NEG ; negate the negative exponent.
+ LD B,A ; save positive exponent in B.
+
+ LD A,$16 ; prepare character '-'
+ JR <A href="#L169A">L169A</a> ; skip forward to PF-E-SIGN
+
+; ---
+
+<a name="L1698"></a>;; <b>PF-E-POS</b>
+L1698: LD A,$15 ; prepare character '+'
+
+<a name="L169A"></a>;; <b>PF-E-SIGN</b>
+L169A: RST 10H ; PRINT-A
+
+; now convert the integer exponent in B to two characters.
+; it will be less than 99.
+
+ LD A,B ; fetch positive exponent.
+ LD B,$FF ; initialize left hand digit to minus one.
+
+<a name="L169E"></a>;; <b>PF-E-TENS</b>
+L169E: INC B ; increment ten count
+ SUB $0A ; subtract ten from exponent
+ JR NC,<A href="#L169E">L169E</a> ; loop back if greater than ten to PF-E-TENS
+
+ ADD A,$0A ; reverse last subtraction
+ LD C,A ; transfer remainder to C
+
+ LD A,B ; transfer ten value to A.
+ AND A ; test for zero.
+ JR Z,<A href="#L16AD">L16AD</a> ; skip forward if so to PF-E-LOW
+
+ CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE prints as digit '1' - '9'
+
+<a name="L16AD"></a>;; <b>PF-E-LOW</b>
+L16AD: LD A,C ; low byte to A
+ CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE prints final digit of the
+ ; exponent.
+ RET ; return. >>
+
+; ---
+
+; this branch deals with zeros after decimal point.
+; e.g. .01 or .0000999
+
+<a name="L16B2"></a>;; <b>PF-ZEROS</b>
+L16B2: NEG ; negate makes number positive 1 to 4.
+ LD B,A ; zero count to B.
+
+ LD A,$1B ; prepare character '.'
+ RST 10H ; PRINT-A
+
+ LD A,$1C ; prepare a '0'
+
+<a name="L16BA"></a>;; <b>PF-ZRO-LP</b>
+L16BA: RST 10H ; PRINT-A
+ DJNZ <A href="#L16BA">L16BA</a> ; loop back to PF-ZRO-LP
+
+ JR <A href="#L16C8">L16C8</a> ; forward to PF-FRAC-LP
+
+; ---
+
+; there is a need to print a leading zero e.g. 0.1 but not with .01
+
+<a name="L16BF"></a>;; <b>PF-ZERO-1</b>
+L16BF: LD A,$1C ; prepare character '0'.
+ RST 10H ; PRINT-A
+
+; this subroutine considers the decimal point and any trailing digits.
+; if the next character is a marked zero, $80, then nothing more to print.
+
+<a name="L16C2"></a>;; <b>PF-DC-OUT</b>
+L16C2: DEC (HL) ; decrement addressed character
+ INC (HL) ; increment it again
+ RET PE ; return with overflow (was 128) >>
+ ; as no fractional part
+
+; else there is a fractional part so print the decimal point.
+
+ LD A,$1B ; prepare character '.'
+ RST 10H ; PRINT-A
+
+; now enter a loop to print trailing digits
+
+<a name="L16C8"></a>;; <b>PF-FRAC-LP</b>
+L16C8: DEC (HL) ; test for a marked zero.
+ INC (HL) ;
+ RET PE ; return when digits exhausted >>
+
+ CALL <A href="#L16D0">L16D0</a> ; routine PF-NIBBLE
+ JR <A href="#L16C8">L16C8</a> ; back for all fractional digits to PF-FRAC-LP.
+
+; ---
+
+; subroutine to print right-hand nibble
+
+<a name="L16D0"></a>;; <b>PF-NIBBLE</b>
+L16D0: LD A,(HL) ; fetch addressed byte
+ AND $0F ; mask off lower 4 bits
+ CALL <A href="#L07EB">L07EB</a> ; routine OUT-CODE
+ DEC HL ; decrement pointer.
+ RET ; return.
+
+
+; -------------------------------
+; THE <b><font color=#333388>'PREPARE TO ADD'</font></b> SUBROUTINE
+; -------------------------------
+; This routine is called twice to prepare each floating point number for
+; addition, in situ, on the calculator stack.
+; The exponent is picked up from the first byte which is then cleared to act
+; as a sign byte and accept any overflow.
+; If the exponent is zero then the number is zero and an early return is made.
+; The now redundant sign bit of the mantissa is set and if the number is
+; negative then all five bytes of the number are twos-complemented to prepare
+; the number for addition.
+; On the second invocation the exponent of the first number is in B.
+
+
+<a name="L16D8"></a>;; <b>PREP-ADD</b>
+L16D8: LD A,(HL) ; fetch exponent.
+ LD (HL),$00 ; make this byte zero to take any overflow and
+ ; default to positive.
+ AND A ; test stored exponent for zero.
+ RET Z ; return with zero flag set if number is zero.
+
+ INC HL ; point to first byte of mantissa.
+ BIT 7,(HL) ; test the sign bit.
+ SET 7,(HL) ; set it to its implied state.
+ DEC HL ; set pointer to first byte again.
+ RET Z ; return if bit indicated number is positive.>>
+
+; if negative then all five bytes are twos complemented starting at LSB.
+
+ PUSH BC ; save B register contents.
+ LD BC,$0005 ; set BC to five.
+ ADD HL,BC ; point to location after 5th byte.
+ LD B,C ; set the B counter to five.
+ LD C,A ; store original exponent in C.
+ SCF ; set carry flag so that one is added.
+
+; now enter a loop to twos-complement the number.
+; The first of the five bytes becomes $FF to denote a negative number.
+
+<a name="L16EC"></a>;; <b>NEG-BYTE</b>
+L16EC: DEC HL ; point to first or more significant byte.
+ LD A,(HL) ; fetch to accumulator.
+ CPL ; complement.
+ ADC A,$00 ; add in initial carry or any subsequent carry.
+ LD (HL),A ; place number back.
+ DJNZ <A href="#L16EC">L16EC</a> ; loop back five times to NEG-BYTE
+
+ LD A,C ; restore the exponent to accumulator.
+ POP BC ; restore B register contents.
+
+ RET ; return.
+
+; ----------------------------------
+; THE <b><font color=#333388>'FETCH TWO NUMBERS'</font></b> SUBROUTINE
+; ----------------------------------
+; This routine is used by addition, multiplication and division to fetch
+; the two five-byte numbers addressed by HL and DE from the calculator stack
+; into the Z80 registers.
+; The HL register may no longer point to the first of the two numbers.
+; Since the 32-bit addition operation is accomplished using two Z80 16-bit
+; instructions, it is important that the lower two bytes of each mantissa are
+; in one set of registers and the other bytes all in the alternate set.
+;
+; In: HL = highest number, DE= lowest number
+;
+; : alt': :
+; Out: :H,B-C:C,B: num1
+; :L,D-E:D-E: num2
+
+<a name="L16F7"></a>;; <b>FETCH-TWO</b>
+L16F7: PUSH HL ; save HL
+ PUSH AF ; save A - result sign when used from division.
+
+ LD C,(HL) ;
+ INC HL ;
+ LD B,(HL) ;
+ LD (HL),A ; insert sign when used from multiplication.
+ INC HL ;
+ LD A,C ; m1
+ LD C,(HL) ;
+ PUSH BC ; PUSH m2 m3
+
+ INC HL ;
+ LD C,(HL) ; m4
+ INC HL ;
+ LD B,(HL) ; m5 BC holds m5 m4
+
+ EX DE,HL ; make HL point to start of second number.
+
+ LD D,A ; m1
+ LD E,(HL) ;
+ PUSH DE ; PUSH m1 n1
+
+ INC HL ;
+ LD D,(HL) ;
+ INC HL ;
+ LD E,(HL) ;
+ PUSH DE ; PUSH n2 n3
+
+ EXX ; - - - - - - -
+
+ POP DE ; POP n2 n3
+ POP HL ; POP m1 n1
+ POP BC ; POP m2 m3
+
+ EXX ; - - - - - - -
+
+ INC HL ;
+ LD D,(HL) ;
+ INC HL ;
+ LD E,(HL) ; DE holds n4 n5
+
+ POP AF ; restore saved
+ POP HL ; registers.
+ RET ; return.
+
+; -----------------------------
+; THE <b><font color=#333388>'SHIFT ADDEND'</font></b> SUBROUTINE
+; -----------------------------
+; The accumulator A contains the difference between the two exponents.
+; This is the lowest of the two numbers to be added
+
+<a name="L171A"></a>;; <b>SHIFT-FP</b>
+L171A: AND A ; test difference between exponents.
+ RET Z ; return if zero. both normal.
+
+ CP $21 ; compare with 33 bits.
+ JR NC,<A href="#L1736">L1736</a> ; forward if greater than 32 to ADDEND-0
+
+ PUSH BC ; preserve BC - part
+ LD B,A ; shift counter to B.
+
+; Now perform B right shifts on the addend L'D'E'D E
+; to bring it into line with the augend H'B'C'C B
+
+<a name="L1722"></a>;; <b>ONE-SHIFT</b>
+L1722: EXX ; - - -
+ SRA L ; 76543210->C bit 7 unchanged.
+ RR D ; C->76543210->C
+ RR E ; C->76543210->C
+ EXX ; - - -
+ RR D ; C->76543210->C
+ RR E ; C->76543210->C
+ DJNZ <A href="#L1722">L1722</a> ; loop back B times to ONE-SHIFT
+
+ POP BC ; restore BC
+ RET NC ; return if last shift produced no carry. >>
+
+; if carry flag was set then accuracy is being lost so round up the addend.
+
+ CALL <A href="#L1741">L1741</a> ; routine ADD-BACK
+ RET NZ ; return if not FF 00 00 00 00
+
+; this branch makes all five bytes of the addend zero and is made during
+; addition when the exponents are too far apart for the addend bits to
+; affect the result.
+
+<a name="L1736"></a>;; <b>ADDEND-0</b>
+L1736: EXX ; select alternate set for more significant
+ ; bytes.
+ XOR A ; clear accumulator.
+
+
+; this entry point (from multiplication) sets four of the bytes to zero or if
+; continuing from above, during addition, then all five bytes are set to zero.
+
+<a name="L1738"></a>;; <b>ZEROS-4/5</b>
+L1738: LD L,$00 ; set byte 1 to zero.
+ LD D,A ; set byte 2 to A.
+ LD E,L ; set byte 3 to zero.
+ EXX ; select main set
+ LD DE,$0000 ; set lower bytes 4 and 5 to zero.
+ RET ; return.
+
+; -------------------------
+; THE <b><font color=#333388>'ADD-BACK'</font></b> SUBROUTINE
+; -------------------------
+; Called from SHIFT-FP above during addition and after normalization from
+; multiplication.
+; This is really a 32-bit increment routine which sets the zero flag according
+; to the 32-bit result.
+; During addition, only negative numbers like FF FF FF FF FF,
+; the twos-complement version of xx 80 00 00 01 say
+; will result in a full ripple FF 00 00 00 00.
+; FF FF FF FF FF when shifted right is unchanged by SHIFT-FP but sets the
+; carry invoking this routine.
+
+<a name="L1741"></a>;; <b>ADD-BACK</b>
+L1741: INC E ;
+ RET NZ ;
+
+ INC D ;
+ RET NZ ;
+
+ EXX ;
+ INC E ;
+ JR NZ,<A href="#L174A">L174A</a> ; forward if no overflow to ALL-ADDED
+
+ INC D ;
+
+<a name="L174A"></a>;; <b>ALL-ADDED</b>
+L174A: EXX ;
+ RET ; return with zero flag set for zero mantissa.
+
+
+; ---------------------------
+; THE <b><font color=#333388>'SUBTRACTION'</font></b> OPERATION
+; ---------------------------
+; just switch the sign of subtrahend and do an add.
+
+<a name="L174C"></a>;; <b>subtract</b>
+L174C: LD A,(DE) ; fetch exponent byte of second number the
+ ; subtrahend.
+ AND A ; test for zero
+ RET Z ; return if zero - first number is result.
+
+ INC DE ; address the first mantissa byte.
+ LD A,(DE) ; fetch to accumulator.
+ XOR $80 ; toggle the sign bit.
+ LD (DE),A ; place back on calculator stack.
+ DEC DE ; point to exponent byte.
+ ; continue into addition routine.
+
+; ------------------------
+; THE <b><font color=#333388>'ADDITION'</font></b> OPERATION
+; ------------------------
+; The addition operation pulls out all the stops and uses most of the Z80's
+; registers to add two floating-point numbers.
+; This is a binary operation and on entry, HL points to the first number
+; and DE to the second.
+
+<a name="L1755"></a>;; <b>addition</b>
+L1755: EXX ; - - -
+ PUSH HL ; save the pointer to the next literal.
+ EXX ; - - -
+
+ PUSH DE ; save pointer to second number
+ PUSH HL ; save pointer to first number - will be the
+ ; result pointer on calculator stack.
+
+ CALL <A href="#L16D8">L16D8</a> ; routine PREP-ADD
+ LD B,A ; save first exponent byte in B.
+ EX DE,HL ; switch number pointers.
+ CALL <A href="#L16D8">L16D8</a> ; routine PREP-ADD
+ LD C,A ; save second exponent byte in C.
+ CP B ; compare the exponent bytes.
+ JR NC,<A href="#L1769">L1769</a> ; forward if second higher to SHIFT-LEN
+
+ LD A,B ; else higher exponent to A
+ LD B,C ; lower exponent to B
+ EX DE,HL ; switch the number pointers.
+
+<a name="L1769"></a>;; <b>SHIFT-LEN</b>
+L1769: PUSH AF ; save higher exponent
+ SUB B ; subtract lower exponent
+
+ CALL <A href="#L16F7">L16F7</a> ; routine FETCH-TWO
+ CALL <A href="#L171A">L171A</a> ; routine SHIFT-FP
+
+ POP AF ; restore higher exponent.
+ POP HL ; restore result pointer.
+ LD (HL),A ; insert exponent byte.
+ PUSH HL ; save result pointer again.
+
+; now perform the 32-bit addition using two 16-bit Z80 add instructions.
+
+ LD L,B ; transfer low bytes of mantissa individually
+ LD H,C ; to HL register
+
+ ADD HL,DE ; the actual binary addition of lower bytes
+
+; now the two higher byte pairs that are in the alternate register sets.
+
+ EXX ; switch in set
+ EX DE,HL ; transfer high mantissa bytes to HL register.
+
+ ADC HL,BC ; the actual addition of higher bytes with
+ ; any carry from first stage.
+
+ EX DE,HL ; result in DE, sign bytes ($FF or $00) to HL
+
+; now consider the two sign bytes
+
+ LD A,H ; fetch sign byte of num1
+
+ ADC A,L ; add including any carry from mantissa
+ ; addition. 00 or 01 or FE or FF
+
+ LD L,A ; result in L.
+
+; possible outcomes of signs and overflow from mantissa are
+;
+; H + L + carry = L RRA XOR L RRA
+; ------------------------------------------------------------
+; 00 + 00 = 00 00 00
+; 00 + 00 + carry = 01 00 01 carry
+; FF + FF = FE C FF 01 carry
+; FF + FF + carry = FF C FF 00
+; FF + 00 = FF FF 00
+; FF + 00 + carry = 00 C 80 80
+
+ RRA ; C->76543210->C
+ XOR L ; set bit 0 if shifting required.
+
+ EXX ; switch back to main set
+ EX DE,HL ; full mantissa result now in D'E'D E registers.
+ POP HL ; restore pointer to result exponent on
+ ; the calculator stack.
+
+ RRA ; has overflow occurred ?
+ JR NC,<A href="#L1790">L1790</a> ; skip forward if not to TEST-NEG
+
+; if the addition of two positive mantissas produced overflow or if the
+; addition of two negative mantissas did not then the result exponent has to
+; be incremented and the mantissa shifted one place to the right.
+
+ LD A,$01 ; one shift required.
+ CALL <A href="#L171A">L171A</a> ; routine SHIFT-FP performs a single shift
+ ; rounding any lost bit
+ INC (HL) ; increment the exponent.
+ JR Z,<A href="#L17B3">L17B3</a> ; forward to ADD-REP-6 if the exponent
+ ; wraps round from FF to zero as number is too
+ ; big for the system.
+
+; at this stage the exponent on the calculator stack is correct.
+
+<a name="L1790"></a>;; <b>TEST-NEG</b>
+L1790: EXX ; switch in the alternate set.
+ LD A,L ; load result sign to accumulator.
+ AND $80 ; isolate bit 7 from sign byte setting zero
+ ; flag if positive.
+ EXX ; back to main set.
+
+ INC HL ; point to first byte of mantissa
+ LD (HL),A ; insert $00 positive or $80 negative at
+ ; position on calculator stack.
+
+ DEC HL ; point to exponent again.
+ JR Z,<A href="#L17B9">L17B9</a> ; forward if positive to GO-NC-MLT
+
+; a negative number has to be twos-complemented before being placed on stack.
+
+ LD A,E ; fetch lowest (rightmost) mantissa byte.
+ NEG ; Negate
+ CCF ; Complement Carry Flag
+ LD E,A ; place back in register
+
+ LD A,D ; ditto
+ CPL ;
+ ADC A,$00 ;
+ LD D,A ;
+
+ EXX ; switch to higher (leftmost) 16 bits.
+
+ LD A,E ; ditto
+ CPL ;
+ ADC A,$00 ;
+ LD E,A ;
+
+ LD A,D ; ditto
+ CPL ;
+ ADC A,$00 ;
+ JR NC,<A href="#L17B7">L17B7</a> ; forward without overflow to END-COMPL
+
+; else entire mantissa is now zero. 00 00 00 00
+
+ RRA ; set mantissa to 80 00 00 00
+ EXX ; switch.
+ INC (HL) ; increment the exponent.
+
+<a name="L17B3"></a>;; <b>ADD-REP-6</b>
+L17B3: JP Z,<A href="#L1880">L1880</a> ; jump forward if exponent now zero to REPORT-6
+ ; 'Number too big'
+
+ EXX ; switch back to alternate set.
+
+<a name="L17B7"></a>;; <b>END-COMPL</b>
+L17B7: LD D,A ; put first byte of mantissa back in DE.
+ EXX ; switch to main set.
+
+<a name="L17B9"></a>;; <b>GO-NC-MLT</b>
+L17B9: XOR A ; clear carry flag and
+ ; clear accumulator so no extra bits carried
+ ; forward as occurs in multiplication.
+
+ JR <A href="#L1828">L1828</a> ; forward to common code at TEST-NORM
+ ; but should go straight to NORMALIZE.
+
+
+; ----------------------------------------------
+; THE <b><font color=#333388>'PREPARE TO MULTIPLY OR DIVIDE'</font></b> SUBROUTINE
+; ----------------------------------------------
+; this routine is called twice from multiplication and twice from division
+; to prepare each of the two numbers for the operation.
+; Initially the accumulator holds zero and after the second invocation bit 7
+; of the accumulator will be the sign bit of the result.
+
+<a name="L17BC"></a>;; <b>PREP-M/D</b>
+L17BC: SCF ; set carry flag to signal number is zero.
+ DEC (HL) ; test exponent
+ INC (HL) ; for zero.
+ RET Z ; return if zero with carry flag set.
+
+ INC HL ; address first mantissa byte.
+ XOR (HL) ; exclusive or the running sign bit.
+ SET 7,(HL) ; set the implied bit.
+ DEC HL ; point to exponent byte.
+ RET ; return.
+
+; ------------------------------
+; THE <b><font color=#333388>'MULTIPLICATION'</font></b> OPERATION
+; ------------------------------
+;
+;
+
+<a name="L17C6"></a>;; <b>multiply</b>
+L17C6: XOR A ; reset bit 7 of running sign flag.
+ CALL <A href="#L17BC">L17BC</a> ; routine PREP-M/D
+ RET C ; return if number is zero.
+ ; zero * anything = zero.
+
+ EXX ; - - -
+ PUSH HL ; save pointer to 'next literal'
+ EXX ; - - -
+
+ PUSH DE ; save pointer to second number
+
+ EX DE,HL ; make HL address second number.
+
+ CALL <A href="#L17BC">L17BC</a> ; routine PREP-M/D
+
+ EX DE,HL ; HL first number, DE - second number
+ JR C,<A href="#L1830">L1830</a> ; forward with carry to ZERO-RSLT
+ ; anything * zero = zero.
+
+ PUSH HL ; save pointer to first number.
+
+ CALL <A href="#L16F7">L16F7</a> ; routine FETCH-TWO fetches two mantissas from
+ ; calc stack to B'C'C,B D'E'D E
+ ; (HL will be overwritten but the result sign
+ ; in A is inserted on the calculator stack)
+
+ LD A,B ; transfer low mantissa byte of first number
+ AND A ; clear carry.
+ SBC HL,HL ; a short form of LD HL,$0000 to take lower
+ ; two bytes of result. (2 program bytes)
+ EXX ; switch in alternate set
+ PUSH HL ; preserve HL
+ SBC HL,HL ; set HL to zero also to take higher two bytes
+ ; of the result and clear carry.
+ EXX ; switch back.
+
+ LD B,$21 ; register B can now be used to count thirty
+ ; three shifts.
+ JR <A href="#L17F8">L17F8</a> ; forward to loop entry point STRT-MLT
+
+; ---
+
+; The multiplication loop is entered at STRT-LOOP.
+
+<a name="L17E7"></a>;; <b>MLT-LOOP</b>
+L17E7: JR NC,<A href="#L17EE">L17EE</a> ; forward if no carry to NO-ADD
+
+ ; else add in the multiplicand.
+
+ ADD HL,DE ; add the two low bytes to result
+ EXX ; switch to more significant bytes.
+ ADC HL,DE ; add high bytes of multiplicand and any carry.
+ EXX ; switch to main set.
+
+; in either case shift result right into B'C'C A
+
+<a name="L17EE"></a>;; <b>NO-ADD</b>
+L17EE: EXX ; switch to alternate set
+ RR H ; C > 76543210 > C
+ RR L ; C > 76543210 > C
+ EXX ;
+ RR H ; C > 76543210 > C
+ RR L ; C > 76543210 > C
+
+<a name="L17F8"></a>;; <b>STRT-MLT</b>
+L17F8: EXX ; switch in alternate set.
+ RR B ; C > 76543210 > C
+ RR C ; C > 76543210 > C
+ EXX ; now main set
+ RR C ; C > 76543210 > C
+ RRA ; C > 76543210 > C
+ DJNZ <A href="#L17E7">L17E7</a> ; loop back 33 times to MLT-LOOP
+
+;
+
+ EX DE,HL ;
+ EXX ;
+ EX DE,HL ;
+ EXX ;
+ POP BC ;
+ POP HL ;
+ LD A,B ;
+ ADD A,C ;
+ JR NZ,<A href="#L180E">L180E</a> ; forward to MAKE-EXPT
+
+ AND A ;
+
+<a name="L180E"></a>;; <b>MAKE-EXPT</b>
+L180E: DEC A ;
+ CCF ; Complement Carry Flag
+
+<a name="L1810"></a>;; <b>DIVN-EXPT</b>
+L1810: RLA ;
+ CCF ; Complement Carry Flag
+ RRA ;
+ JP P,<A href="#L1819">L1819</a> ; forward to OFLW1-CLR
+
+ JR NC,<A href="#L1880">L1880</a> ; forward to REPORT-6
+
+ AND A ;
+
+<a name="L1819"></a>;; <b>OFLW1-CLR</b>
+L1819: INC A ;
+ JR NZ,<A href="#L1824">L1824</a> ; forward to OFLW2-CLR
+
+ JR C,<A href="#L1824">L1824</a> ; forward to OFLW2-CLR
+
+ EXX ;
+ BIT 7,D ;
+ EXX ;
+ JR NZ,<A href="#L1880">L1880</a> ; forward to REPORT-6
+
+<a name="L1824"></a>;; <b>OFLW2-CLR</b>
+L1824: LD (HL),A ;
+ EXX ;
+ LD A,B ;
+ EXX ;
+
+; addition joins here with carry flag clear.
+
+<a name="L1828"></a>;; <b>TEST-NORM</b>
+L1828: JR NC,<A href="#L183F">L183F</a> ; forward to NORMALIZE
+
+ LD A,(HL) ;
+ AND A ;
+
+<a name="L182C"></a>;; <b>NEAR-ZERO</b>
+L182C: LD A,$80 ; prepare to rescue the most significant bit
+ ; of the mantissa if it is set.
+ JR Z,<A href="#L1831">L1831</a> ; skip forward to SKIP-ZERO
+
+<a name="L1830"></a>;; <b>ZERO-RSLT</b>
+L1830: XOR A ; make mask byte zero signaling set five
+ ; bytes to zero.
+
+<a name="L1831"></a>;; <b>SKIP-ZERO</b>
+L1831: EXX ; switch in alternate set
+ AND D ; isolate most significant bit (if A is $80).
+
+ CALL <A href="#L1738">L1738</a> ; routine ZEROS-4/5 sets mantissa without
+ ; affecting any flags.
+
+ RLCA ; test if MSB set. bit 7 goes to bit 0.
+ ; either $00 -> $00 or $80 -> $01
+ LD (HL),A ; make exponent $01 (lowest) or $00 zero
+ JR C,<A href="#L1868">L1868</a> ; forward if first case to OFLOW-CLR
+
+ INC HL ; address first mantissa byte on the
+ ; calculator stack.
+ LD (HL),A ; insert a zero for the sign bit.
+ DEC HL ; point to zero exponent
+ JR <A href="#L1868">L1868</a> ; forward to OFLOW-CLR
+
+; ---
+
+; this branch is common to addition and multiplication with the mantissa
+; result still in registers D'E'D E .
+
+<a name="L183F"></a>;; <b>NORMALIZE</b>
+L183F: LD B,$20 ; a maximum of thirty-two left shifts will be
+ ; needed.
+
+<a name="L1841"></a>;; <b>SHIFT-ONE</b>
+L1841: EXX ; address higher 16 bits.
+ BIT 7,D ; test the leftmost bit
+ EXX ; address lower 16 bits.
+
+ JR NZ,<A href="#L1859">L1859</a> ; forward if leftmost bit was set to NORML-NOW
+
+ RLCA ; this holds zero from addition, 33rd bit
+ ; from multiplication.
+
+ RL E ; C < 76543210 < C
+ RL D ; C < 76543210 < C
+
+ EXX ; address higher 16 bits.
+
+ RL E ; C < 76543210 < C
+ RL D ; C < 76543210 < C
+
+ EXX ; switch to main set.
+
+ DEC (HL) ; decrement the exponent byte on the calculator
+ ; stack.
+
+ JR Z,<A href="#L182C">L182C</a> ; back if exponent becomes zero to NEAR-ZERO
+ ; it's just possible that the last rotation
+ ; set bit 7 of D. We shall see.
+
+ DJNZ <A href="#L1841">L1841</a> ; loop back to SHIFT-ONE
+
+; if thirty-two left shifts were performed without setting the most significant
+; bit then the result is zero.
+
+ JR <A href="#L1830">L1830</a> ; back to ZERO-RSLT
+
+; ---
+
+<a name="L1859"></a>;; <b>NORML-NOW</b>
+L1859: RLA ; for the addition path, A is always zero.
+ ; for the mult path, ...
+
+ JR NC,<A href="#L1868">L1868</a> ; forward to OFLOW-CLR
+
+; this branch is taken only with multiplication.
+
+ CALL <A href="#L1741">L1741</a> ; routine ADD-BACK
+
+ JR NZ,<A href="#L1868">L1868</a> ; forward to OFLOW-CLR
+
+ EXX ;
+ LD D,$80 ;
+ EXX ;
+ INC (HL) ;
+ JR Z,<A href="#L1880">L1880</a> ; forward to REPORT-6
+
+; now transfer the mantissa from the register sets to the calculator stack
+; incorporating the sign bit already there.
+
+<a name="L1868"></a>;; <b>OFLOW-CLR</b>
+L1868: PUSH HL ; save pointer to exponent on stack.
+ INC HL ; address first byte of mantissa which was
+ ; previously loaded with sign bit $00 or $80.
+
+ EXX ; - - -
+ PUSH DE ; push the most significant two bytes.
+ EXX ; - - -
+
+ POP BC ; pop - true mantissa is now BCDE.
+
+; now pick up the sign bit.
+
+ LD A,B ; first mantissa byte to A
+ RLA ; rotate out bit 7 which is set
+ RL (HL) ; rotate sign bit on stack into carry.
+ RRA ; rotate sign bit into bit 7 of mantissa.
+
+; and transfer mantissa from main registers to calculator stack.
+
+ LD (HL),A ;
+ INC HL ;
+ LD (HL),C ;
+ INC HL ;
+ LD (HL),D ;
+ INC HL ;
+ LD (HL),E ;
+
+ POP HL ; restore pointer to num1 now result.
+ POP DE ; restore pointer to num2 now STKEND.
+
+ EXX ; - - -
+ POP HL ; restore pointer to next calculator literal.
+ EXX ; - - -
+
+ RET ; return.
+
+; ---
+
+<a name="L1880"></a>;; <b>REPORT-6</b>
+L1880: RST 08H ; ERROR-1
+ DEFB $05 ; Error Report: Arithmetic overflow.
+
+; ------------------------
+; THE <b><font color=#333388>'DIVISION'</font></b> OPERATION
+; ------------------------
+; "Of all the arithmetic subroutines, division is the most complicated and
+; the least understood. It is particularly interesting to note that the
+; Sinclair programmer himself has made a mistake in his programming ( or has
+; copied over someone else's mistake!) for
+; PRINT PEEK 6352 [ $18D0 ] ('unimproved' ROM, 6351 [ $18CF ] )
+; should give 218 not 225."
+; - Dr. Ian Logan, Syntax magazine Jul/Aug 1982.
+; [ i.e. the jump should be made to div-34th ]
+
+; First check for division by zero.
+
+<a name="L1882"></a>;; <b>division</b>
+L1882: EX DE,HL ; consider the second number first.
+ XOR A ; set the running sign flag.
+ CALL <A href="#L17BC">L17BC</a> ; routine PREP-M/D
+ JR C,<A href="#L1880">L1880</a> ; back if zero to REPORT-6
+ ; 'Arithmetic overflow'
+
+ EX DE,HL ; now prepare first number and check for zero.
+ CALL <A href="#L17BC">L17BC</a> ; routine PREP-M/D
+ RET C ; return if zero, 0/anything is zero.
+
+ EXX ; - - -
+ PUSH HL ; save pointer to the next calculator literal.
+ EXX ; - - -
+
+ PUSH DE ; save pointer to divisor - will be STKEND.
+ PUSH HL ; save pointer to dividend - will be result.
+
+ CALL <A href="#L16F7">L16F7</a> ; routine FETCH-TWO fetches the two numbers
+ ; into the registers H'B'C'C B
+ ; L'D'E'D E
+ EXX ; - - -
+ PUSH HL ; save the two exponents.
+
+ LD H,B ; transfer the dividend to H'L'H L
+ LD L,C ;
+ EXX ;
+ LD H,C ;
+ LD L,B ;
+
+ XOR A ; clear carry bit and accumulator.
+ LD B,$DF ; count upwards from -33 decimal
+ JR <A href="#L18B2">L18B2</a> ; forward to mid-loop entry point DIV-START
+
+; ---
+
+<a name="L18A2"></a>;; <b>DIV-LOOP</b>
+L18A2: RLA ; multiply partial quotient by two
+ RL C ; setting result bit from carry.
+ EXX ;
+ RL C ;
+ RL B ;
+ EXX ;
+
+<a name="L18AB"></a>;; <b>div-34th</b>
+L18AB: ADD HL,HL ;
+ EXX ;
+ ADC HL,HL ;
+ EXX ;
+ JR C,<A href="#L18C2">L18C2</a> ; forward to SUBN-ONLY
+
+<a name="L18B2"></a>;; <b>DIV-START</b>
+L18B2: SBC HL,DE ; subtract divisor part.
+ EXX ;
+ SBC HL,DE ;
+ EXX ;
+ JR NC,<A href="#L18C9">L18C9</a> ; forward if subtraction goes to NO-RSTORE
+
+ ADD HL,DE ; else restore
+ EXX ;
+ ADC HL,DE ;
+ EXX ;
+ AND A ; clear carry
+ JR <A href="#L18CA">L18CA</a> ; forward to COUNT-ONE
+
+; ---
+
+<a name="L18C2"></a>;; <b>SUBN-ONLY</b>
+L18C2: AND A ;
+ SBC HL,DE ;
+ EXX ;
+ SBC HL,DE ;
+ EXX ;
+
+<a name="L18C9"></a>;; <b>NO-RSTORE</b>
+L18C9: SCF ; set carry flag
+
+<a name="L18CA"></a>;; <b>COUNT-ONE</b>
+L18CA: INC B ; increment the counter
+ JP M,<A href="#L18A2">L18A2</a> ; back while still minus to DIV-LOOP
+
+ PUSH AF ;
+ JR Z,<A href="#L18B2">L18B2</a> ; back to DIV-START
+
+; "This jump is made to the wrong place. No 34th bit will ever be obtained
+; without first shifting the dividend. Hence important results like 1/10 and
+; 1/1000 are not rounded up as they should be. Rounding up never occurs when
+; it depends on the 34th bit. The jump should be made to div-34th above."
+; - Dr. Frank O'Hara, "The Complete Spectrum ROM Disassembly", 1983,
+; published by Melbourne House.
+; (<font color=#9900FF>Note.</font> on the ZX81 this would be JR Z,L18AB)
+;
+; However if you make this change, then while (1/2=.5) will now evaluate as
+; true, (.25=1/4), which did evaluate as true, no longer does.
+
+ LD E,A ;
+ LD D,C ;
+ EXX ;
+ LD E,C ;
+ LD D,B ;
+
+ POP AF ;
+ RR B ;
+ POP AF ;
+ RR B ;
+
+ EXX ;
+ POP BC ;
+ POP HL ;
+ LD A,B ;
+ SUB C ;
+ JP <A href="#L1810">L1810</a> ; jump back to DIVN-EXPT
+
+; ------------------------------------------------
+; THE <b><font color=#333388>'INTEGER TRUNCATION TOWARDS ZERO'</font></b> SUBROUTINE
+; ------------------------------------------------
+;
+
+<a name="L18E4"></a>;; <b>truncate</b>
+L18E4: LD A,(HL) ; fetch exponent
+ CP $81 ; compare to +1
+ JR NC,<A href="#L18EF">L18EF</a> ; forward, if 1 or more, to T-GR-ZERO
+
+; else the number is smaller than plus or minus 1 and can be made zero.
+
+ LD (HL),$00 ; make exponent zero.
+ LD A,$20 ; prepare to set 32 bits of mantissa to zero.
+ JR <A href="#L18F4">L18F4</a> ; forward to NIL-BYTES
+
+; ---
+
+<a name="L18EF"></a>;; <b>T-GR-ZERO</b>
+L18EF: SUB $A0 ; subtract +32 from exponent
+ RET P ; return if result is positive as all 32 bits
+ ; of the mantissa relate to the integer part.
+ ; The floating point is somewhere to the right
+ ; of the mantissa
+
+ NEG ; else negate to form number of rightmost bits
+ ; to be blanked.
+
+; for instance, disregarding the sign bit, the number 3.5 is held as
+; exponent $82 mantissa .11100000 00000000 00000000 00000000
+; we need to set $82 - $A0 = $E2 NEG = $1E (thirty) bits to zero to form the
+; integer.
+; The sign of the number is never considered as the first bit of the mantissa
+; must be part of the integer.
+
+<a name="L18F4"></a>;; <b>NIL-BYTES</b>
+L18F4: PUSH DE ; save pointer to STKEND
+ EX DE,HL ; HL points at STKEND
+ DEC HL ; now at last byte of mantissa.
+ LD B,A ; Transfer bit count to B register.
+ SRL B ; divide by
+ SRL B ; eight
+ SRL B ;
+ JR Z,<A href="#L1905">L1905</a> ; forward if zero to BITS-ZERO
+
+; else the original count was eight or more and whole bytes can be blanked.
+
+<a name="L1900"></a>;; <b>BYTE-ZERO</b>
+L1900: LD (HL),$00 ; set eight bits to zero.
+ DEC HL ; point to more significant byte of mantissa.
+ DJNZ <A href="#L1900">L1900</a> ; loop back to BYTE-ZERO
+
+; now consider any residual bits.
+
+<a name="L1905"></a>;; <b>BITS-ZERO</b>
+L1905: AND $07 ; isolate the remaining bits
+ JR Z,<A href="#L1912">L1912</a> ; forward if none to IX-END
+
+ LD B,A ; transfer bit count to B counter.
+ LD A,$FF ; form a mask 11111111
+
+<a name="L190C"></a>;; <b>LESS-MASK</b>
+L190C: SLA A ; 1 <- 76543210 <- o slide mask leftwards.
+ DJNZ <A href="#L190C">L190C</a> ; loop back for bit count to LESS-MASK
+
+ AND (HL) ; lose the unwanted rightmost bits
+ LD (HL),A ; and place in mantissa byte.
+
+<a name="L1912"></a>;; <b>IX-END</b>
+L1912: EX DE,HL ; restore result pointer from DE.
+ POP DE ; restore STKEND from stack.
+ RET ; return.
+
+
+;********************************
+;** FLOATING-POINT CALCULATOR **
+;********************************
+
+; As a general rule the calculator avoids using the IY register.
+; Exceptions are val and str$.
+; So an assembly language programmer who has disabled interrupts to use IY
+; for other purposes can still use the calculator for mathematical
+; purposes.
+
+
+; ------------------------
+; THE <b><font color=#333388>'TABLE OF CONSTANTS'</font></b>
+; ------------------------
+; The ZX81 has only floating-point number representation.
+; Both the ZX80 and the ZX Spectrum have integer numbers in some form.
+
+<a name="L1915"></a>;; <b>stk-zero</b> 00 00 00 00 00
+L1915: DEFB $00 ;;Bytes: 1
+ DEFB $B0 ;;Exponent $00
+ DEFB $00 ;;(+00,+00,+00)
+
+<a name="L1918"></a>;; <b>stk-one</b> 81 00 00 00 00
+L1918: DEFB $31 ;;Exponent $81, Bytes: 1
+ DEFB $00 ;;(+00,+00,+00)
+
+
+<a name="L191A"></a>;; <b>stk-half</b> 80 00 00 00 00
+L191A: DEFB $30 ;;Exponent: $80, Bytes: 1
+ DEFB $00 ;;(+00,+00,+00)
+
+
+<a name="L191C"></a>;; <b>stk-pi/2</b> 81 49 0F DA A2
+L191C: DEFB $F1 ;;Exponent: $81, Bytes: 4
+ DEFB $49,$0F,$DA,$A2 ;;
+
+<a name="L1921"></a>;; <b>stk-ten</b> 84 20 00 00 00
+L1921: DEFB $34 ;;Exponent: $84, Bytes: 1
+ DEFB $20 ;;(+00,+00,+00)
+
+
+; ------------------------
+; THE <b><font color=#333388>'TABLE OF ADDRESSES'</font></b>
+; ------------------------
+;
+; starts with binary operations which have two operands and one result.
+; three pseudo binary operations first.
+
+<a name="L1923"></a>;; <b>tbl-addrs</b>
+L1923: DEFW <A href="#L1C2F">L1C2F</a> ; $00 Address: $1C2F - jump-true
+ DEFW <A href="#L1A72">L1A72</a> ; $01 Address: $1A72 - exchange
+ DEFW <A href="#L19E3">L19E3</a> ; $02 Address: $19E3 - delete
+
+; true binary operations.
+
+ DEFW <A href="#L174C">L174C</a> ; $03 Address: $174C - subtract
+ DEFW <A href="#L17C6">L17C6</a> ; $04 Address: $176C - multiply
+ DEFW <A href="#L1882">L1882</a> ; $05 Address: $1882 - division
+ DEFW <A href="#L1DE2">L1DE2</a> ; $06 Address: $1DE2 - to-power
+ DEFW <A href="#L1AED">L1AED</a> ; $07 Address: $1AED - or
+
+ DEFW <A href="#L1AF3">L1AF3</a> ; $08 Address: $1B03 - no-&-no
+ DEFW <A href="#L1B03">L1B03</a> ; $09 Address: $1B03 - no-l-eql
+ DEFW <A href="#L1B03">L1B03</a> ; $0A Address: $1B03 - no-gr-eql
+ DEFW <A href="#L1B03">L1B03</a> ; $0B Address: $1B03 - nos-neql
+ DEFW <A href="#L1B03">L1B03</a> ; $0C Address: $1B03 - no-grtr
+ DEFW <A href="#L1B03">L1B03</a> ; $0D Address: $1B03 - no-less
+ DEFW <A href="#L1B03">L1B03</a> ; $0E Address: $1B03 - nos-eql
+ DEFW <A href="#L1755">L1755</a> ; $0F Address: $1755 - addition
+
+ DEFW <A href="#L1AF8">L1AF8</a> ; $10 Address: $1AF8 - str-&-no
+ DEFW <A href="#L1B03">L1B03</a> ; $11 Address: $1B03 - str-l-eql
+ DEFW <A href="#L1B03">L1B03</a> ; $12 Address: $1B03 - str-gr-eql
+ DEFW <A href="#L1B03">L1B03</a> ; $13 Address: $1B03 - strs-neql
+ DEFW <A href="#L1B03">L1B03</a> ; $14 Address: $1B03 - str-grtr
+ DEFW <A href="#L1B03">L1B03</a> ; $15 Address: $1B03 - str-less
+ DEFW <A href="#L1B03">L1B03</a> ; $16 Address: $1B03 - strs-eql
+ DEFW <A href="#L1B62">L1B62</a> ; $17 Address: $1B62 - strs-add
+
+; unary follow
+
+ DEFW <A href="#L1AA0">L1AA0</a> ; $18 Address: $1AA0 - neg
+
+ DEFW <A href="#L1C06">L1C06</a> ; $19 Address: $1C06 - code
+ DEFW <A href="#L1BA4">L1BA4</a> ; $1A Address: $1BA4 - val
+ DEFW <A href="#L1C11">L1C11</a> ; $1B Address: $1C11 - len
+ DEFW <A href="#L1D49">L1D49</a> ; $1C Address: $1D49 - sin
+ DEFW <A href="#L1D3E">L1D3E</a> ; $1D Address: $1D3E - cos
+ DEFW <A href="#L1D6E">L1D6E</a> ; $1E Address: $1D6E - tan
+ DEFW <A href="#L1DC4">L1DC4</a> ; $1F Address: $1DC4 - asn
+ DEFW <A href="#L1DD4">L1DD4</a> ; $20 Address: $1DD4 - acs
+ DEFW <A href="#L1D76">L1D76</a> ; $21 Address: $1D76 - atn
+ DEFW <A href="#L1CA9">L1CA9</a> ; $22 Address: $1CA9 - ln
+ DEFW <A href="#L1C5B">L1C5B</a> ; $23 Address: $1C5B - exp
+ DEFW <A href="#L1C46">L1C46</a> ; $24 Address: $1C46 - int
+ DEFW <A href="#L1DDB">L1DDB</a> ; $25 Address: $1DDB - sqr
+ DEFW <A href="#L1AAF">L1AAF</a> ; $26 Address: $1AAF - sgn
+ DEFW <A href="#L1AAA">L1AAA</a> ; $27 Address: $1AAA - abs
+ DEFW <A href="#L1ABE">L1ABE</a> ; $28 Address: $1A1B - peek
+ DEFW <A href="#L1AC5">L1AC5</a> ; $29 Address: $1AC5 - usr-no
+ DEFW <A href="#L1BD5">L1BD5</a> ; $2A Address: $1BD5 - str$
+ DEFW <A href="#L1B8F">L1B8F</a> ; $2B Address: $1B8F - chrs
+ DEFW <A href="#L1AD5">L1AD5</a> ; $2C Address: $1AD5 - not
+
+; end of true unary
+
+ DEFW <A href="#L19F6">L19F6</a> ; $2D Address: $19F6 - duplicate
+ DEFW <A href="#L1C37">L1C37</a> ; $2E Address: $1C37 - n-mod-m
+
+ DEFW <A href="#L1C23">L1C23</a> ; $2F Address: $1C23 - jump
+ DEFW <A href="#L19FC">L19FC</a> ; $30 Address: $19FC - stk-data
+
+ DEFW <A href="#L1C17">L1C17</a> ; $31 Address: $1C17 - dec-jr-nz
+ DEFW <A href="#L1ADB">L1ADB</a> ; $32 Address: $1ADB - less-0
+ DEFW <A href="#L1ACE">L1ACE</a> ; $33 Address: $1ACE - greater-0
+ DEFW <A href="#L002B">L002B</a> ; $34 Address: $002B - end-calc
+ DEFW <A href="#L1D18">L1D18</a> ; $35 Address: $1D18 - get-argt
+ DEFW <A href="#L18E4">L18E4</a> ; $36 Address: $18E4 - truncate
+ DEFW <A href="#L19E4">L19E4</a> ; $37 Address: $19E4 - fp-calc-2
+ DEFW <A href="#L155A">L155A</a> ; $38 Address: $155A - e-to-fp
+
+; the following are just the next available slots for the 128 compound literals
+; which are in range $80 - $FF.
+
+ DEFW <A href="#L1A7F">L1A7F</a> ; $39 Address: $1A7F - series-xx $80 - $9F.
+ DEFW <A href="#L1A51">L1A51</a> ; $3A Address: $1A51 - stk-const-xx $A0 - $BF.
+ DEFW <A href="#L1A63">L1A63</a> ; $3B Address: $1A63 - st-mem-xx $C0 - $DF.
+ DEFW <A href="#L1A45">L1A45</a> ; $3C Address: $1A45 - get-mem-xx $E0 - $FF.
+
+; Aside: 3D - 7F are therefore unused calculator literals.
+; 39 - 7B would be available for expansion.
+
+; -------------------------------
+; THE <b><font color=#333388>'FLOATING POINT CALCULATOR'</font></b>
+; -------------------------------
+;
+;
+
+<a name="L199D"></a>;; <b>CALCULATE</b>
+L199D: CALL <A href="#L1B85">L1B85</a> ; routine STK-PNTRS is called to set up the
+ ; calculator stack pointers for a default
+ ; unary operation. HL = last value on stack.
+ ; DE = STKEND first location after stack.
+
+; the calculate routine is called at this point by the series generator...
+
+<a name="L19A0"></a>;; <b>GEN-ENT-1</b>
+L19A0: LD A,B ; fetch the Z80 B register to A
+ LD ($401E),A ; and store value in system variable BREG.
+ ; this will be the counter for dec-jr-nz
+ ; or if used from fp-calc2 the calculator
+ ; instruction.
+
+; ... and again later at this point
+
+<a name="L19A4"></a>;; <b>GEN-ENT-2</b>
+L19A4: EXX ; switch sets
+ EX (SP),HL ; and store the address of next instruction,
+ ; the return address, in H'L'.
+ ; If this is a recursive call then the H'L'
+ ; of the previous invocation goes on stack.
+ ; c.f. end-calc.
+ EXX ; switch back to main set.
+
+; this is the re-entry looping point when handling a string of literals.
+
+<a name="L19A7"></a>;; <b>RE-ENTRY</b>
+L19A7: LD ($401C),DE ; save end of stack in system variable STKEND
+ EXX ; switch to alt
+ LD A,(HL) ; get next literal
+ INC HL ; increase pointer'
+
+; single operation jumps back to here
+
+<a name="L19AE"></a>;; <b>SCAN-ENT</b>
+L19AE: PUSH HL ; save pointer on stack *
+ AND A ; now test the literal
+ JP P,<A href="#L19C2">L19C2</a> ; forward to FIRST-3D if in range $00 - $3D
+ ; anything with bit 7 set will be one of
+ ; 128 compound literals.
+
+; compound literals have the following format.
+; bit 7 set indicates compound.
+; bits 6-5 the subgroup 0-3.
+; bits 4-0 the embedded parameter $00 - $1F.
+; The subgroup 0-3 needs to be manipulated to form the next available four
+; address places after the simple literals in the address table.
+
+ LD D,A ; save literal in D
+ AND $60 ; and with 01100000 to isolate subgroup
+ RRCA ; rotate bits
+ RRCA ; 4 places to right
+ RRCA ; not five as we need offset * 2
+ RRCA ; 00000xx0
+ ADD A,$72 ; add ($39 * 2) to give correct offset.
+ ; alter above if you add more literals.
+ LD L,A ; store in L for later indexing.
+ LD A,D ; bring back compound literal
+ AND $1F ; use mask to isolate parameter bits
+ JR <A href="#L19D0">L19D0</a> ; forward to ENT-TABLE
+
+; ---
+
+; the branch was here with simple literals.
+
+<a name="L19C2"></a>;; <b>FIRST-3D</b>
+L19C2: CP $18 ; compare with first unary operations.
+ JR NC,<A href="#L19CE">L19CE</a> ; to DOUBLE-A with unary operations
+
+; it is binary so adjust pointers.
+
+ EXX ;
+ LD BC,$FFFB ; the value -5
+ LD D,H ; transfer HL, the last value, to DE.
+ LD E,L ;
+ ADD HL,BC ; subtract 5 making HL point to second
+ ; value.
+ EXX ;
+
+<a name="L19CE"></a>;; <b>DOUBLE-A</b>
+L19CE: RLCA ; double the literal
+ LD L,A ; and store in L for indexing
+
+<a name="L19D0"></a>;; <b>ENT-TABLE</b>
+L19D0: LD DE,<A href="#L1923">L1923</a> ; Address: tbl-addrs
+ LD H,$00 ; prepare to index
+ ADD HL,DE ; add to get address of routine
+ LD E,(HL) ; low byte to E
+ INC HL ;
+ LD D,(HL) ; high byte to D
+
+ LD HL,<A href="#L19A7">L19A7</a> ; Address: RE-ENTRY
+ EX (SP),HL ; goes on machine stack
+ ; address of next literal goes to HL. *
+
+
+ PUSH DE ; now the address of routine is stacked.
+ EXX ; back to main set
+ ; avoid using IY register.
+ LD BC,($401D) ; STKEND_hi
+ ; nothing much goes to C but BREG to B
+ ; and continue into next ret instruction
+ ; which has a dual identity
+
+
+; -----------------------
+; THE <b><font color=#333388>'DELETE'</font></b> SUBROUTINE
+; -----------------------
+; offset $02: 'delete'
+; A simple return but when used as a calculator literal this
+; deletes the last value from the calculator stack.
+; On entry, as always with binary operations,
+; HL=first number, DE=second number
+; On exit, HL=result, DE=stkend.
+; So nothing to do
+
+<a name="L19E3"></a>;; <b>delete</b>
+L19E3: RET ; return - indirect jump if from above.
+
+; ---------------------------------
+; THE <b><font color=#333388>'SINGLE OPERATION'</font></b> SUBROUTINE
+; ---------------------------------
+; offset $37: 'fp-calc-2'
+; this single operation is used, in the first instance, to evaluate most
+; of the mathematical and string functions found in BASIC expressions.
+
+<a name="L19E4"></a>;; <b>fp-calc-2</b>
+L19E4: POP AF ; drop return address.
+ LD A,($401E) ; load accumulator from system variable BREG
+ ; value will be literal eg. 'tan'
+ EXX ; switch to alt
+ JR <A href="#L19AE">L19AE</a> ; back to SCAN-ENT
+ ; next literal will be end-calc in scanning
+
+; ------------------------------
+; THE <b><font color=#333388>'TEST 5 SPACES'</font></b> SUBROUTINE
+; ------------------------------
+; This routine is called from MOVE-FP, STK-CONST and STK-STORE to
+; test that there is enough space between the calculator stack and the
+; machine stack for another five-byte value. It returns with BC holding
+; the value 5 ready for any subsequent LDIR.
+
+<a name="L19EB"></a>;; <b>TEST-5-SP</b>
+L19EB: PUSH DE ; save
+ PUSH HL ; registers
+ LD BC,$0005 ; an overhead of five bytes
+ CALL <A href="#L0EC5">L0EC5</a> ; routine TEST-ROOM tests free RAM raising
+ ; an error if not.
+ POP HL ; else restore
+ POP DE ; registers.
+ RET ; return with BC set at 5.
+
+
+; ---------------------------------------------
+; THE <b><font color=#333388>'MOVE A FLOATING POINT NUMBER'</font></b> SUBROUTINE
+; ---------------------------------------------
+; offset $2D: 'duplicate'
+; This simple routine is a 5-byte LDIR instruction
+; that incorporates a memory check.
+; When used as a calculator literal it duplicates the last value on the
+; calculator stack.
+; Unary so on entry HL points to last value, DE to stkend
+
+<a name="L19F6"></a>;; <b>duplicate</b>
+<a name="L19F6"></a>;; <b>MOVE-FP</b>
+L19F6: CALL <A href="#L19EB">L19EB</a> ; routine TEST-5-SP test free memory
+ ; and sets BC to 5.
+ LDIR ; copy the five bytes.
+ RET ; return with DE addressing new STKEND
+ ; and HL addressing new last value.
+
+; -------------------------------
+; THE <b><font color=#333388>'STACK LITERALS'</font></b> SUBROUTINE
+; -------------------------------
+; offset $30: 'stk-data'
+; When a calculator subroutine needs to put a value on the calculator
+; stack that is not a regular constant this routine is called with a
+; variable number of following data bytes that convey to the routine
+; the floating point form as succinctly as is possible.
+
+<a name="L19FC"></a>;; <b>stk-data</b>
+L19FC: LD H,D ; transfer STKEND
+ LD L,E ; to HL for result.
+
+<a name="L19FE"></a>;; <b>STK-CONST</b>
+L19FE: CALL <A href="#L19EB">L19EB</a> ; routine TEST-5-SP tests that room exists
+ ; and sets BC to $05.
+
+ EXX ; switch to alternate set
+ PUSH HL ; save the pointer to next literal on stack
+ EXX ; switch back to main set
+
+ EX (SP),HL ; pointer to HL, destination to stack.
+
+ PUSH BC ; save BC - value 5 from test room ??.
+
+ LD A,(HL) ; fetch the byte following 'stk-data'
+ AND $C0 ; isolate bits 7 and 6
+ RLCA ; rotate
+ RLCA ; to bits 1 and 0 range $00 - $03.
+ LD C,A ; transfer to C
+ INC C ; and increment to give number of bytes
+ ; to read. $01 - $04
+ LD A,(HL) ; reload the first byte
+ AND $3F ; mask off to give possible exponent.
+ JR NZ,<A href="#L1A14">L1A14</a> ; forward to FORM-EXP if it was possible to
+ ; include the exponent.
+
+; else byte is just a byte count and exponent comes next.
+
+ INC HL ; address next byte and
+ LD A,(HL) ; pick up the exponent ( - $50).
+
+<a name="L1A14"></a>;; <b>FORM-EXP</b>
+L1A14: ADD A,$50 ; now add $50 to form actual exponent
+ LD (DE),A ; and load into first destination byte.
+ LD A,$05 ; load accumulator with $05 and
+ SUB C ; subtract C to give count of trailing
+ ; zeros plus one.
+ INC HL ; increment source
+ INC DE ; increment destination
+ LD B,$00 ; prepare to copy
+ LDIR ; copy C bytes
+
+ POP BC ; restore 5 counter to BC ??.
+
+ EX (SP),HL ; put HL on stack as next literal pointer
+ ; and the stack value - result pointer -
+ ; to HL.
+
+ EXX ; switch to alternate set.
+ POP HL ; restore next literal pointer from stack
+ ; to H'L'.
+ EXX ; switch back to main set.
+
+ LD B,A ; zero count to B
+ XOR A ; clear accumulator
+
+<a name="L1A27"></a>;; <b>STK-ZEROS</b>
+L1A27: DEC B ; decrement B counter
+ RET Z ; return if zero. >>
+ ; DE points to new STKEND
+ ; HL to new number.
+
+ LD (DE),A ; else load zero to destination
+ INC DE ; increase destination
+ JR <A href="#L1A27">L1A27</a> ; loop back to STK-ZEROS until done.
+
+; -------------------------------
+; THE <b><font color=#333388>'SKIP CONSTANTS'</font></b> SUBROUTINE
+; -------------------------------
+; This routine traverses variable-length entries in the table of constants,
+; stacking intermediate, unwanted constants onto a dummy calculator stack,
+; in the first five bytes of the ZX81 ROM.
+
+<a name="L1A2D"></a>;; <b>SKIP-CONS</b>
+L1A2D: AND A ; test if initially zero.
+
+<a name="L1A2E"></a>;; <b>SKIP-NEXT</b>
+L1A2E: RET Z ; return if zero. >>
+
+ PUSH AF ; save count.
+ PUSH DE ; and normal STKEND
+
+ LD DE,$0000 ; dummy value for STKEND at start of ROM
+ ; <font color=#9900FF>Note.</font> not a fault but this has to be
+ ; moved elsewhere when running in RAM.
+ ;
+ CALL <A href="#L19FE">L19FE</a> ; routine STK-CONST works through variable
+ ; length records.
+
+ POP DE ; restore real STKEND
+ POP AF ; restore count
+ DEC A ; decrease
+ JR <A href="#L1A2E">L1A2E</a> ; loop back to SKIP-NEXT
+
+; --------------------------------
+; THE <b><font color=#333388>'MEMORY LOCATION'</font></b> SUBROUTINE
+; --------------------------------
+; This routine, when supplied with a base address in HL and an index in A,
+; will calculate the address of the A'th entry, where each entry occupies
+; five bytes. It is used for addressing floating-point numbers in the
+; calculator's memory area.
+
+<a name="L1A3C"></a>;; <b>LOC-MEM</b>
+L1A3C: LD C,A ; store the original number $00-$1F.
+ RLCA ; double.
+ RLCA ; quadruple.
+ ADD A,C ; now add original value to multiply by five.
+
+ LD C,A ; place the result in C.
+ LD B,$00 ; set B to 0.
+ ADD HL,BC ; add to form address of start of number in HL.
+
+ RET ; return.
+
+; -------------------------------------
+; THE <b><font color=#333388>'GET FROM MEMORY AREA'</font></b> SUBROUTINE
+; -------------------------------------
+; offsets $E0 to $FF: 'get-mem-0', 'get-mem-1' etc.
+; A holds $00-$1F offset.
+; The calculator stack increases by 5 bytes.
+
+<a name="L1A45"></a>;; <b>get-mem-xx</b>
+L1A45: PUSH DE ; save STKEND
+ LD HL,($401F) ; MEM is base address of the memory cells.
+ CALL <A href="#L1A3C">L1A3C</a> ; routine LOC-MEM so that HL = first byte
+ CALL <A href="#L19F6">L19F6</a> ; routine MOVE-FP moves 5 bytes with memory
+ ; check.
+ ; DE now points to new STKEND.
+ POP HL ; the original STKEND is now RESULT pointer.
+ RET ; return.
+
+; ---------------------------------
+; THE <b><font color=#333388>'STACK A CONSTANT'</font></b> SUBROUTINE
+; ---------------------------------
+; offset $A0: 'stk-zero'
+; offset $A1: 'stk-one'
+; offset $A2: 'stk-half'
+; offset $A3: 'stk-pi/2'
+; offset $A4: 'stk-ten'
+; This routine allows a one-byte instruction to stack up to 32 constants
+; held in short form in a table of constants. In fact only 5 constants are
+; required. On entry the A register holds the literal ANDed with $1F.
+; It isn't very efficient and it would have been better to hold the
+; numbers in full, five byte form and stack them in a similar manner
+; to that which would be used later for semi-tone table values.
+
+<a name="L1A51"></a>;; <b>stk-const-xx</b>
+L1A51: LD H,D ; save STKEND - required for result
+ LD L,E ;
+ EXX ; swap
+ PUSH HL ; save pointer to next literal
+ LD HL,<A href="#L1915">L1915</a> ; Address: stk-zero - start of table of
+ ; constants
+ EXX ;
+ CALL <A href="#L1A2D">L1A2D</a> ; routine SKIP-CONS
+ CALL <A href="#L19FE">L19FE</a> ; routine STK-CONST
+ EXX ;
+ POP HL ; restore pointer to next literal.
+ EXX ;
+ RET ; return.
+
+; ---------------------------------------
+; THE <b><font color=#333388>'STORE IN A MEMORY AREA'</font></b> SUBROUTINE
+; ---------------------------------------
+; Offsets $C0 to $DF: 'st-mem-0', 'st-mem-1' etc.
+; Although 32 memory storage locations can be addressed, only six
+; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5)
+; required for these are allocated. ZX81 programmers who wish to
+; use the floating point routines from assembly language may wish to
+; alter the system variable MEM to point to 160 bytes of RAM to have
+; use the full range available.
+; A holds derived offset $00-$1F.
+; Unary so on entry HL points to last value, DE to STKEND.
+
+<a name="L1A63"></a>;; <b>st-mem-xx</b>
+L1A63: PUSH HL ; save the result pointer.
+ EX DE,HL ; transfer to DE.
+ LD HL,($401F) ; fetch MEM the base of memory area.
+ CALL <A href="#L1A3C">L1A3C</a> ; routine LOC-MEM sets HL to the destination.
+ EX DE,HL ; swap - HL is start, DE is destination.
+ CALL <A href="#L19F6">L19F6</a> ; routine MOVE-FP.
+ ; note. a short ld bc,5; ldir
+ ; the embedded memory check is not required
+ ; so these instructions would be faster!
+ EX DE,HL ; DE = STKEND
+ POP HL ; restore original result pointer
+ RET ; return.
+
+; -------------------------
+; THE <b><font color=#333388>'EXCHANGE'</font></b> SUBROUTINE
+; -------------------------
+; offset $01: 'exchange'
+; This routine exchanges the last two values on the calculator stack
+; On entry, as always with binary operations,
+; HL=first number, DE=second number
+; On exit, HL=result, DE=stkend.
+
+<a name="L1A72"></a>;; <b>exchange</b>
+L1A72: LD B,$05 ; there are five bytes to be swapped
+
+; start of loop.
+
+<a name="L1A74"></a>;; <b>SWAP-BYTE</b>
+L1A74: LD A,(DE) ; each byte of second
+ LD C,(HL) ; each byte of first
+ EX DE,HL ; swap pointers
+ LD (DE),A ; store each byte of first
+ LD (HL),C ; store each byte of second
+ INC HL ; advance both
+ INC DE ; pointers.
+ DJNZ <A href="#L1A74">L1A74</a> ; loop back to SWAP-BYTE until all 5 done.
+
+ EX DE,HL ; even up the exchanges
+ ; so that DE addresses STKEND.
+ RET ; return.
+
+; ---------------------------------
+; THE <b><font color=#333388>'SERIES GENERATOR'</font></b> SUBROUTINE
+; ---------------------------------
+; offset $86: 'series-06'
+; offset $88: 'series-08'
+; offset $8C: 'series-0C'
+; The ZX81 uses Chebyshev polynomials to generate approximations for
+; SIN, ATN, LN and EXP. These are named after the Russian mathematician
+; Pafnuty Chebyshev, born in 1821, who did much pioneering work on numerical
+; series. As far as calculators are concerned, Chebyshev polynomials have an
+; advantage over other series, for example the Taylor series, as they can
+; reach an approximation in just six iterations for SIN, eight for EXP and
+; twelve for LN and ATN. The mechanics of the routine are interesting but
+; for full treatment of how these are generated with demonstrations in
+; Sinclair BASIC see "The Complete Spectrum ROM Disassembly" by Dr Ian Logan
+; and Dr Frank O'Hara, published 1983 by Melbourne House.
+
+<a name="L1A7F"></a>;; <b>series-xx</b>
+L1A7F: LD B,A ; parameter $00 - $1F to B counter
+ CALL <A href="#L19A0">L19A0</a> ; routine GEN-ENT-1 is called.
+ ; A recursive call to a special entry point
+ ; in the calculator that puts the B register
+ ; in the system variable BREG. The return
+ ; address is the next location and where
+ ; the calculator will expect its first
+ ; instruction - now pointed to by HL'.
+ ; The previous pointer to the series of
+ ; five-byte numbers goes on the machine stack.
+
+; The initialization phase.
+
+ DEFB $2D ;;duplicate x,x
+ DEFB $0F ;;addition x+x
+ DEFB $C0 ;;st-mem-0 x+x
+ DEFB $02 ;;delete .
+ DEFB $A0 ;;stk-zero 0
+ DEFB $C2 ;;st-mem-2 0
+
+; a loop is now entered to perform the algebraic calculation for each of
+; the numbers in the series
+
+<a name="L1A89"></a>;; <b>G-LOOP</b>
+L1A89: DEFB $2D ;;duplicate v,v.
+ DEFB $E0 ;;get-mem-0 v,v,x+2
+ DEFB $04 ;;multiply v,v*x+2
+ DEFB $E2 ;;get-mem-2 v,v*x+2,v
+ DEFB $C1 ;;st-mem-1
+ DEFB $03 ;;subtract
+ DEFB $34 ;;end-calc
+
+; the previous pointer is fetched from the machine stack to H'L' where it
+; addresses one of the numbers of the series following the series literal.
+
+ CALL <A href="#L19FC">L19FC</a> ; routine STK-DATA is called directly to
+ ; push a value and advance H'L'.
+ CALL <A href="#L19A4">L19A4</a> ; routine GEN-ENT-2 recursively re-enters
+ ; the calculator without disturbing
+ ; system variable BREG
+ ; H'L' value goes on the machine stack and is
+ ; then loaded as usual with the next address.
+
+ DEFB $0F ;;addition
+ DEFB $01 ;;exchange
+ DEFB $C2 ;;st-mem-2
+ DEFB $02 ;;delete
+
+ DEFB $31 ;;dec-jr-nz
+ DEFB $EE ;;back to <A href="#L1A89">L1A89</a>, G-LOOP
+
+; when the counted loop is complete the final subtraction yields the result
+; for example SIN X.
+
+ DEFB $E1 ;;get-mem-1
+ DEFB $03 ;;subtract
+ DEFB $34 ;;end-calc
+
+ RET ; return with H'L' pointing to location
+ ; after last number in series.
+
+; -----------------------
+; Handle unary minus (18)
+; -----------------------
+; Unary so on entry HL points to last value, DE to STKEND.
+
+<a name="L1AA0"></a>;; <b>NEGATE</b>
+<a name="L1AA0"></a>;; <b>negate</b>
+L1AA0: LD A, (HL) ; fetch exponent of last value on the
+ ; calculator stack.
+ AND A ; test it.
+ RET Z ; return if zero.
+
+ INC HL ; address the byte with the sign bit.
+ LD A,(HL) ; fetch to accumulator.
+ XOR $80 ; toggle the sign bit.
+ LD (HL),A ; put it back.
+ DEC HL ; point to last value again.
+ RET ; return.
+
+; -----------------------
+; Absolute magnitude (27)
+; -----------------------
+; This calculator literal finds the absolute value of the last value,
+; floating point, on calculator stack.
+
+<a name="L1AAA"></a>;; <b>abs</b>
+L1AAA: INC HL ; point to byte with sign bit.
+ RES 7,(HL) ; make the sign positive.
+ DEC HL ; point to last value again.
+ RET ; return.
+
+; -----------
+; Signum (26)
+; -----------
+; This routine replaces the last value on the calculator stack,
+; which is in floating point form, with one if positive and with -minus one
+; if negative. If it is zero then it is left as such.
+
+<a name="L1AAF"></a>;; <b>sgn</b>
+L1AAF: INC HL ; point to first byte of 4-byte mantissa.
+ LD A,(HL) ; pick up the byte with the sign bit.
+ DEC HL ; point to exponent.
+ DEC (HL) ; test the exponent for
+ INC (HL) ; the value zero.
+
+ SCF ; set the carry flag.
+ CALL NZ,<A href="#L1AE0">L1AE0</a> ; routine FP-0/1 replaces last value with one
+ ; if exponent indicates the value is non-zero.
+ ; in either case mantissa is now four zeros.
+
+ INC HL ; point to first byte of 4-byte mantissa.
+ RLCA ; rotate original sign bit to carry.
+ RR (HL) ; rotate the carry into sign.
+ DEC HL ; point to last value.
+ RET ; return.
+
+
+; -------------------------
+; Handle PEEK function (28)
+; -------------------------
+; This function returns the contents of a memory address.
+; The entire address space can be peeked including the ROM.
+
+<a name="L1ABE"></a>;; <b>peek</b>
+L1ABE: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT puts address in BC.
+ LD A,(BC) ; load contents into A register.
+
+<a name="L1AC2"></a>;; <b>IN-PK-STK</b>
+L1AC2: JP <A href="#L151D">L151D</a> ; exit via STACK-A to put value on the
+ ; calculator stack.
+
+; ---------------
+; USR number (29)
+; ---------------
+; The USR function followed by a number 0-65535 is the method by which
+; the ZX81 invokes machine code programs. This function returns the
+; contents of the BC register pair.
+; <font color=#9900FF>Note.</font> that STACK-BC re-initializes the IY register to $4000 if a user-written
+; program has altered it.
+
+<a name="L1AC5"></a>;; <b>usr-no</b>
+L1AC5: CALL <A href="#L0EA7">L0EA7</a> ; routine FIND-INT to fetch the
+ ; supplied address into BC.
+
+ LD HL,<A href="#L1520">L1520</a> ; address: STACK-BC is
+ PUSH HL ; pushed onto the machine stack.
+ PUSH BC ; then the address of the machine code
+ ; routine.
+
+ RET ; make an indirect jump to the routine
+ ; and, hopefully, to STACK-BC also.
+
+
+; -----------------------
+; Greater than zero ($33)
+; -----------------------
+; Test if the last value on the calculator stack is greater than zero.
+; This routine is also called directly from the end-tests of the comparison
+; routine.
+
+<a name="L1ACE"></a>;; <b>GREATER-0</b>
+<a name="L1ACE"></a>;; <b>greater-0</b>
+L1ACE: LD A,(HL) ; fetch exponent.
+ AND A ; test it for zero.
+ RET Z ; return if so.
+
+
+ LD A,$FF ; prepare XOR mask for sign bit
+ JR <A href="#L1ADC">L1ADC</a> ; forward to SIGN-TO-C
+ ; to put sign in carry
+ ; (carry will become set if sign is positive)
+ ; and then overwrite location with 1 or 0
+ ; as appropriate.
+
+; ------------------------
+; Handle NOT operator ($2C)
+; ------------------------
+; This overwrites the last value with 1 if it was zero else with zero
+; if it was any other value.
+;
+; e.g. NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0.
+;
+; The subroutine is also called directly from the end-tests of the comparison
+; operator.
+
+<a name="L1AD5"></a>;; <b>NOT</b>
+<a name="L1AD5"></a>;; <b>not</b>
+L1AD5: LD A,(HL) ; get exponent byte.
+ NEG ; negate - sets carry if non-zero.
+ CCF ; complement so carry set if zero, else reset.
+ JR <A href="#L1AE0">L1AE0</a> ; forward to FP-0/1.
+
+; -------------------
+; Less than zero (32)
+; -------------------
+; Destructively test if last value on calculator stack is less than zero.
+; Bit 7 of second byte will be set if so.
+
+<a name="L1ADB"></a>;; <b>less-0</b>
+L1ADB: XOR A ; set xor mask to zero
+ ; (carry will become set if sign is negative).
+
+; transfer sign of mantissa to Carry Flag.
+
+<a name="L1ADC"></a>;; <b>SIGN-TO-C</b>
+L1ADC: INC HL ; address 2nd byte.
+ XOR (HL) ; bit 7 of HL will be set if number is negative.
+ DEC HL ; address 1st byte again.
+ RLCA ; rotate bit 7 of A to carry.
+
+; -----------
+; Zero or one
+; -----------
+; This routine places an integer value zero or one at the addressed location
+; of calculator stack or MEM area. The value one is written if carry is set on
+; entry else zero.
+
+<a name="L1AE0"></a>;; <b>FP-0/1</b>
+L1AE0: PUSH HL ; save pointer to the first byte
+ LD B,$05 ; five bytes to do.
+
+<a name="L1AE3"></a>;; <b>FP-loop</b>
+L1AE3: LD (HL),$00 ; insert a zero.
+ INC HL ;
+ DJNZ <A href="#L1AE3">L1AE3</a> ; repeat.
+
+ POP HL ;
+ RET NC ;
+
+ LD (HL),$81 ; make value 1
+ RET ; return.
+
+
+; -----------------------
+; Handle OR operator (07)
+; -----------------------
+; The Boolean OR operator. eg. X OR Y
+; The result is zero if both values are zero else a non-zero value.
+;
+; e.g. 0 OR 0 returns 0.
+; -3 OR 0 returns -3.
+; 0 OR -3 returns 1.
+; -3 OR 2 returns 1.
+;
+; A binary operation.
+; On entry HL points to first operand (X) and DE to second operand (Y).
+
+<a name="L1AED"></a>;; <b>or</b>
+L1AED: LD A,(DE) ; fetch exponent of second number
+ AND A ; test it.
+ RET Z ; return if zero.
+
+ SCF ; set carry flag
+ JR <A href="#L1AE0">L1AE0</a> ; back to FP-0/1 to overwrite the first operand
+ ; with the value 1.
+
+
+; -----------------------------
+; Handle number AND number (08)
+; -----------------------------
+; The Boolean AND operator.
+;
+; e.g. -3 AND 2 returns -3.
+; -3 AND 0 returns 0.
+; 0 and -2 returns 0.
+; 0 and 0 returns 0.
+;
+; Compare with OR routine above.
+
+<a name=""></a>;; <b>no-&-no</b>
+L1AF3: LD A,(DE) ; fetch exponent of second number.
+ AND A ; test it.
+ RET NZ ; return if not zero.
+
+ JR <A href="#L1AE0">L1AE0</a> ; back to FP-0/1 to overwrite the first operand
+ ; with zero for return value.
+
+; -----------------------------
+; Handle string AND number (10)
+; -----------------------------
+; e.g. "YOU WIN" AND SCORE>99 will return the string if condition is true
+; or the null string if false.
+
+<a name=""></a>;; <b>str-&-no</b>
+L1AF8: LD A,(DE) ; fetch exponent of second number.
+ AND A ; test it.
+ RET NZ ; return if number was not zero - the string
+ ; is the result.
+
+; if the number was zero (false) then the null string must be returned by
+; altering the length of the string on the calculator stack to zero.
+
+ PUSH DE ; save pointer to the now obsolete number
+ ; (which will become the new STKEND)
+
+ DEC DE ; point to the 5th byte of string descriptor.
+ XOR A ; clear the accumulator.
+ LD (DE),A ; place zero in high byte of length.
+ DEC DE ; address low byte of length.
+ LD (DE),A ; place zero there - now the null string.
+
+ POP DE ; restore pointer - new STKEND.
+ RET ; return.
+
+; -----------------------------------
+; Perform comparison ($09-$0E, $11-$16)
+; -----------------------------------
+; True binary operations.
+;
+; A single entry point is used to evaluate six numeric and six string
+; comparisons. On entry, the calculator literal is in the B register and
+; the two numeric values, or the two string parameters, are on the
+; calculator stack.
+; The individual bits of the literal are manipulated to group similar
+; operations although the SUB 8 instruction does nothing useful and merely
+; alters the string test bit.
+; Numbers are compared by subtracting one from the other, strings are
+; compared by comparing every character until a mismatch, or the end of one
+; or both, is reached.
+;
+; Numeric Comparisons.
+; --------------------
+; The <b><font color=#333388>'x>y'</font></b> example is the easiest as it employs straight-thru logic.
+; Number y is subtracted from x and the result tested for greater-0 yielding
+; a final value 1 (true) or 0 (false).
+; For 'x<y' the same logic is used but the two values are first swapped on the
+; calculator stack.
+; For 'x=y' NOT is applied to the subtraction result yielding true if the
+; difference was zero and false with anything else.
+; The first three numeric comparisons are just the opposite of the last three
+; so the same processing steps are used and then a final NOT is applied.
+;
+; literal Test No sub 8 ExOrNot 1st RRCA exch sub ? End-Tests
+; ========= ==== == ======== === ======== ======== ==== === = === === ===
+; no-l-eql x<=y 09 00000001 dec 00000000 00000000 ---- x-y ? --- >0? NOT
+; no-gr-eql x>=y 0A 00000010 dec 00000001 10000000c swap y-x ? --- >0? NOT
+; nos-neql x<>y 0B 00000011 dec 00000010 00000001 ---- x-y ? NOT --- NOT
+; no-grtr x>y 0C 00000100 - 00000100 00000010 ---- x-y ? --- >0? ---
+; no-less x<y 0D 00000101 - 00000101 10000010c swap y-x ? --- >0? ---
+; nos-eql x=y 0E 00000110 - 00000110 00000011 ---- x-y ? NOT --- ---
+;
+; comp -> C/F
+; ==== ===
+; str-l-eql x$<=y$ 11 00001001 dec 00001000 00000100 ---- x$y$ 0 !or >0? NOT
+; str-gr-eql x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0 !or >0? NOT
+; strs-neql x$<>y$ 13 00001011 dec 00001010 00000101 ---- x$y$ 0 !or >0? NOT
+; str-grtr x$>y$ 14 00001100 - 00001100 00000110 ---- x$y$ 0 !or >0? ---
+; str-less x$<y$ 15 00001101 - 00001101 10000110c swap y$x$ 0 !or >0? ---
+; strs-eql x$=y$ 16 00001110 - 00001110 00000111 ---- x$y$ 0 !or >0? ---
+;
+; String comparisons are a little different in that the eql/neql carry flag
+; from the 2nd RRCA is, as before, fed into the first of the end tests but
+; along the way it gets modified by the comparison process. The result on the
+; stack always starts off as zero and the carry fed in determines if NOT is
+; applied to it. So the only time the greater-0 test is applied is if the
+; stack holds zero which is not very efficient as the test will always yield
+; zero. The most likely explanation is that there were once separate end tests
+; for numbers and strings.
+
+<a name="L1B03"></a>;; <b>no-l-eql,etc.</b>
+L1B03: LD A,B ; transfer literal to accumulator.
+ SUB $08 ; subtract eight - which is not useful.
+
+ BIT 2,A ; isolate '>', '<', '='.
+
+ JR NZ,<A href="#L1B0B">L1B0B</a> ; skip to EX-OR-NOT with these.
+
+ DEC A ; else make $00-$02, $08-$0A to match bits 0-2.
+
+<a name="L1B0B"></a>;; <b>EX-OR-NOT</b>
+L1B0B: RRCA ; the first RRCA sets carry for a swap.
+ JR NC,<A href="#L1B16">L1B16</a> ; forward to NU-OR-STR with other 8 cases
+
+; for the other 4 cases the two values on the calculator stack are exchanged.
+
+ PUSH AF ; save A and carry.
+ PUSH HL ; save HL - pointer to first operand.
+ ; (DE points to second operand).
+
+ CALL <A href="#L1A72">L1A72</a> ; routine exchange swaps the two values.
+ ; (HL = second operand, DE = STKEND)
+
+ POP DE ; DE = first operand
+ EX DE,HL ; as we were.
+ POP AF ; restore A and carry.
+
+; <font color=#9900FF>Note.</font> it would be better if the 2nd RRCA preceded the string test.
+; It would save two duplicate bytes and if we also got rid of that sub 8
+; at the beginning we wouldn't have to alter which bit we test.
+
+<a name="L1B16"></a>;; <b>NU-OR-STR</b>
+L1B16: BIT 2,A ; test if a string comparison.
+ JR NZ,<A href="#L1B21">L1B21</a> ; forward to STRINGS if so.
+
+; continue with numeric comparisons.
+
+ RRCA ; 2nd RRCA causes eql/neql to set carry.
+ PUSH AF ; save A and carry
+
+ CALL <A href="#L174C">L174C</a> ; routine subtract leaves result on stack.
+ JR <A href="#L1B54">L1B54</a> ; forward to END-TESTS
+
+; ---
+
+<a name="L1B21"></a>;; <b>STRINGS</b>
+L1B21: RRCA ; 2nd RRCA causes eql/neql to set carry.
+ PUSH AF ; save A and carry.
+
+ CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH gets 2nd string params
+ PUSH DE ; save start2 *.
+ PUSH BC ; and the length.
+
+ CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH gets 1st string
+ ; parameters - start in DE, length in BC.
+ POP HL ; restore length of second to HL.
+
+; A loop is now entered to compare, by subtraction, each corresponding character
+; of the strings. For each successful match, the pointers are incremented and
+; the lengths decreased and the branch taken back to here. If both string
+; remainders become null at the same time, then an exact match exists.
+
+<a name="L1B2C"></a>;; <b>BYTE-COMP</b>
+L1B2C: LD A,H ; test if the second string
+ OR L ; is the null string and hold flags.
+
+ EX (SP),HL ; put length2 on stack, bring start2 to HL *.
+ LD A,B ; hi byte of length1 to A
+
+ JR NZ,<A href="#L1B3D">L1B3D</a> ; forward to SEC-PLUS if second not null.
+
+ OR C ; test length of first string.
+
+<a name="L1B33"></a>;; <b>SECND-LOW</b>
+L1B33: POP BC ; pop the second length off stack.
+ JR Z,<A href="#L1B3A">L1B3A</a> ; forward to BOTH-NULL if first string is also
+ ; of zero length.
+
+; the true condition - first is longer than second (SECND-LESS)
+
+ POP AF ; restore carry (set if eql/neql)
+ CCF ; complement carry flag.
+ ; <font color=#9900FF>Note.</font> equality becomes false.
+ ; Inequality is true. By swapping or applying
+ ; a terminal 'not', all comparisons have been
+ ; manipulated so that this is success path.
+ JR <A href="#L1B50">L1B50</a> ; forward to leave via STR-TEST
+
+; ---
+; the branch was here with a match
+
+<a name="L1B3A"></a>;; <b>BOTH-NULL</b>
+L1B3A: POP AF ; restore carry - set for eql/neql
+ JR <A href="#L1B50">L1B50</a> ; forward to STR-TEST
+
+; ---
+; the branch was here when 2nd string not null and low byte of first is yet
+; to be tested.
+
+
+<a name="L1B3D"></a>;; <b>SEC-PLUS</b>
+L1B3D: OR C ; test the length of first string.
+ JR Z,<A href="#L1B4D">L1B4D</a> ; forward to FRST-LESS if length is zero.
+
+; both strings have at least one character left.
+
+ LD A,(DE) ; fetch character of first string.
+ SUB (HL) ; subtract with that of 2nd string.
+ JR C,<A href="#L1B4D">L1B4D</a> ; forward to FRST-LESS if carry set
+
+ JR NZ,<A href="#L1B33">L1B33</a> ; back to SECND-LOW and then STR-TEST
+ ; if not exact match.
+
+ DEC BC ; decrease length of 1st string.
+ INC DE ; increment 1st string pointer.
+
+ INC HL ; increment 2nd string pointer.
+ EX (SP),HL ; swap with length on stack
+ DEC HL ; decrement 2nd string length
+ JR <A href="#L1B2C">L1B2C</a> ; back to BYTE-COMP
+
+; ---
+; the false condition.
+
+<a name="L1B4D"></a>;; <b>FRST-LESS</b>
+L1B4D: POP BC ; discard length
+ POP AF ; pop A
+ AND A ; clear the carry for false result.
+
+; ---
+; exact match and x$>y$ rejoin here
+
+<a name="L1B50"></a>;; <b>STR-TEST</b>
+L1B50: PUSH AF ; save A and carry
+
+ RST 28H ;; FP-CALC
+ DEFB $A0 ;;stk-zero an initial false value.
+ DEFB $34 ;;end-calc
+
+; both numeric and string paths converge here.
+
+<a name="L1B54"></a>;; <b>END-TESTS</b>
+L1B54: POP AF ; pop carry - will be set if eql/neql
+ PUSH AF ; save it again.
+
+ CALL C,<A href="#L1AD5">L1AD5</a> ; routine NOT sets true(1) if equal(0)
+ ; or, for strings, applies true result.
+ CALL <A href="#L1ACE">L1ACE</a> ; greater-0 ??????????
+
+
+ POP AF ; pop A
+ RRCA ; the third RRCA - test for '<=', '>=' or '<>'.
+ CALL NC,<A href="#L1AD5">L1AD5</a> ; apply a terminal NOT if so.
+ RET ; return.
+
+; -------------------------
+; String concatenation ($17)
+; -------------------------
+; This literal combines two strings into one e.g. LET A$ = B$ + C$
+; The two parameters of the two strings to be combined are on the stack.
+
+<a name="L1B62"></a>;; <b>strs-add</b>
+L1B62: CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH fetches string parameters
+ ; and deletes calculator stack entry.
+ PUSH DE ; save start address.
+ PUSH BC ; and length.
+
+ CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH for first string
+ POP HL ; re-fetch first length
+ PUSH HL ; and save again
+ PUSH DE ; save start of second string
+ PUSH BC ; and its length.
+
+ ADD HL,BC ; add the two lengths.
+ LD B,H ; transfer to BC
+ LD C,L ; and create
+ RST 30H ; BC-SPACES in workspace.
+ ; DE points to start of space.
+
+ CALL <A href="#L12C3">L12C3</a> ; routine STK-STO-$ stores parameters
+ ; of new string updating STKEND.
+
+ POP BC ; length of first
+ POP HL ; address of start
+ LD A,B ; test for
+ OR C ; zero length.
+ JR Z,<A href="#L1B7D">L1B7D</a> ; to OTHER-STR if null string
+
+ LDIR ; copy string to workspace.
+
+<a name="L1B7D"></a>;; <b>OTHER-STR</b>
+L1B7D: POP BC ; now second length
+ POP HL ; and start of string
+ LD A,B ; test this one
+ OR C ; for zero length
+ JR Z,<A href="#L1B85">L1B85</a> ; skip forward to STK-PNTRS if so as complete.
+
+ LDIR ; else copy the bytes.
+ ; and continue into next routine which
+ ; sets the calculator stack pointers.
+
+; --------------------
+; Check stack pointers
+; --------------------
+; Register DE is set to STKEND and HL, the result pointer, is set to five
+; locations below this.
+; This routine is used when it is inconvenient to save these values at the
+; time the calculator stack is manipulated due to other activity on the
+; machine stack.
+; This routine is also used to terminate the VAL routine for
+; the same reason and to initialize the calculator stack at the start of
+; the CALCULATE routine.
+
+<a name="L1B85"></a>;; <b>STK-PNTRS</b>
+L1B85: LD HL,($401C) ; fetch STKEND value from system variable.
+ LD DE,$FFFB ; the value -5
+ PUSH HL ; push STKEND value.
+
+ ADD HL,DE ; subtract 5 from HL.
+
+ POP DE ; pop STKEND to DE.
+ RET ; return.
+
+; ----------------
+; Handle CHR$ (2B)
+; ----------------
+; This function returns a single character string that is a result of
+; converting a number in the range 0-255 to a string e.g. CHR$ 38 = "A".
+; <font color=#9900FF>Note.</font> the ZX81 does not have an ASCII character set.
+
+<a name="L1B8F"></a>;; <b>chrs</b>
+L1B8F: CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A puts the number in A.
+
+ JR C,<A href="#L1BA2">L1BA2</a> ; forward to REPORT-Bd if overflow
+ JR NZ,<A href="#L1BA2">L1BA2</a> ; forward to REPORT-Bd if negative
+
+ PUSH AF ; save the argument.
+
+ LD BC,$0001 ; one space required.
+ RST 30H ; BC-SPACES makes DE point to start
+
+ POP AF ; restore the number.
+
+ LD (DE),A ; and store in workspace
+
+ CALL <A href="#L12C3">L12C3</a> ; routine STK-STO-$ stacks descriptor.
+
+ EX DE,HL ; make HL point to result and DE to STKEND.
+ RET ; return.
+
+; ---
+
+<a name="L1BA2"></a>;; <b>REPORT-Bd</b>
+L1BA2: RST 08H ; ERROR-1
+ DEFB $0A ; Error Report: Integer out of range
+
+; ----------------------------
+; Handle VAL ($1A)
+; ----------------------------
+; VAL treats the characters in a string as a numeric expression.
+; e.g. VAL "2.3" = 2.3, VAL "2+4" = 6, VAL ("2" + "4") = 24.
+
+<a name="L1BA4"></a>;; <b>val</b>
+L1BA4: LD HL,($4016) ; fetch value of system variable CH_ADD
+ PUSH HL ; and save on the machine stack.
+
+ CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH fetches the string operand
+ ; from calculator stack.
+
+ PUSH DE ; save the address of the start of the string.
+ INC BC ; increment the length for a carriage return.
+
+ RST 30H ; BC-SPACES creates the space in workspace.
+ POP HL ; restore start of string to HL.
+ LD ($4016),DE ; load CH_ADD with start DE in workspace.
+
+ PUSH DE ; save the start in workspace
+ LDIR ; copy string from program or variables or
+ ; workspace to the workspace area.
+ EX DE,HL ; end of string + 1 to HL
+ DEC HL ; decrement HL to point to end of new area.
+ LD (HL),$76 ; insert a carriage return at end.
+ ; ZX81 has a non-ASCII character set
+ RES 7,(IY+$01) ; update FLAGS - signal checking syntax.
+ CALL <A href="#L0D92">L0D92</a> ; routine CLASS-06 - SCANNING evaluates string
+ ; expression and checks for integer result.
+
+ CALL <A href="#L0D22">L0D22</a> ; routine CHECK-2 checks for carriage return.
+
+
+ POP HL ; restore start of string in workspace.
+
+ LD ($4016),HL ; set CH_ADD to the start of the string again.
+ SET 7,(IY+$01) ; update FLAGS - signal running program.
+ CALL <A href="#L0F55">L0F55</a> ; routine SCANNING evaluates the string
+ ; in full leaving result on calculator stack.
+
+ POP HL ; restore saved character address in program.
+ LD ($4016),HL ; and reset the system variable CH_ADD.
+
+ JR <A href="#L1B85">L1B85</a> ; back to exit via STK-PNTRS.
+ ; resetting the calculator stack pointers
+ ; HL and DE from STKEND as it wasn't possible
+ ; to preserve them during this routine.
+
+; ----------------
+; Handle STR$ (2A)
+; ----------------
+; This function returns a string representation of a numeric argument.
+; The method used is to trick the PRINT-FP routine into thinking it
+; is writing to a collapsed display file when in fact it is writing to
+; string workspace.
+; If there is already a newline at the intended print position and the
+; column count has not been reduced to zero then the print routine
+; assumes that there is only 1K of RAM and the screen memory, like the rest
+; of dynamic memory, expands as necessary using calls to the ONE-SPACE
+; routine. The screen is character-mapped not bit-mapped.
+
+<a name="L1BD5"></a>;; <b>str$</b>
+L1BD5: LD BC,$0001 ; create an initial byte in workspace
+ RST 30H ; using BC-SPACES restart.
+
+ LD (HL),$76 ; place a carriage return there.
+
+ LD HL,($4039) ; fetch value of S_POSN column/line
+ PUSH HL ; and preserve on stack.
+
+ LD L,$FF ; make column value high to create a
+ ; contrived buffer of length 254.
+ LD ($4039),HL ; and store in system variable S_POSN.
+
+ LD HL,($400E) ; fetch value of DF_CC
+ PUSH HL ; and preserve on stack also.
+
+ LD ($400E),DE ; now set DF_CC which normally addresses
+ ; somewhere in the display file to the start
+ ; of workspace.
+ PUSH DE ; save the start of new string.
+
+ CALL <A href="#L15DB">L15DB</a> ; routine PRINT-FP.
+
+ POP DE ; retrieve start of string.
+
+ LD HL,($400E) ; fetch end of string from DF_CC.
+ AND A ; prepare for true subtraction.
+ SBC HL,DE ; subtract to give length.
+
+ LD B,H ; and transfer to the BC
+ LD C,L ; register.
+
+ POP HL ; restore original
+ LD ($400E),HL ; DF_CC value
+
+ POP HL ; restore original
+ LD ($4039),HL ; S_POSN values.
+
+ CALL <A href="#L12C3">L12C3</a> ; routine STK-STO-$ stores the string
+ ; descriptor on the calculator stack.
+
+ EX DE,HL ; HL = last value, DE = STKEND.
+ RET ; return.
+
+
+; -------------------
+; THE <b><font color=#333388>'CODE'</font></b> FUNCTION
+; -------------------
+; <font color=#339933>(offset $19: 'code')</font>
+; Returns the code of a character or first character of a string
+; e.g. CODE "AARDVARK" = 38 (not 65 as the ZX81 does not have an ASCII
+; character set).
+
+
+<a name="L1C06"></a>;; <b>code</b>
+L1C06: CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH to fetch and delete the
+ ; string parameters.
+ ; DE points to the start, BC holds the length.
+ LD A,B ; test length
+ OR C ; of the string.
+ JR Z,<A href="#L1C0E">L1C0E</a> ; skip to STK-CODE with zero if the null string.
+
+ LD A,(DE) ; else fetch the first character.
+
+<a name="L1C0E"></a>;; <b>STK-CODE</b>
+L1C0E: JP <A href="#L151D">L151D</a> ; jump back to STACK-A (with memory check)
+
+; --------------------
+; THE <b><font color=#333388>'LEN'</font></b> SUBROUTINE
+; --------------------
+; <font color=#339933>(offset $1b: 'len')</font>
+; Returns the length of a string.
+; In Sinclair BASIC strings can be more than twenty thousand characters long
+; so a sixteen-bit register is required to store the length
+
+<a name="L1C11"></a>;; <b>len</b>
+L1C11: CALL <A href="#L13F8">L13F8</a> ; routine STK-FETCH to fetch and delete the
+ ; string parameters from the calculator stack.
+ ; register BC now holds the length of string.
+
+ JP <A href="#L1520">L1520</a> ; jump back to STACK-BC to save result on the
+ ; calculator stack (with memory check).
+
+; -------------------------------------
+; THE <b><font color=#333388>'DECREASE THE COUNTER'</font></b> SUBROUTINE
+; -------------------------------------
+; <font color=#339933>(offset $31: 'dec-jr-nz')</font>
+; The calculator has an instruction that decrements a single-byte
+; pseudo-register and makes consequential relative jumps just like
+; the Z80's DJNZ instruction.
+
+<a name="L1C17"></a>;; <b>dec-jr-nz</b>
+L1C17: EXX ; switch in set that addresses code
+
+ PUSH HL ; save pointer to offset byte
+ LD HL,$401E ; address BREG in system variables
+ DEC (HL) ; decrement it
+ POP HL ; restore pointer
+
+ JR NZ,<A href="#L1C24">L1C24</a> ; to JUMP-2 if not zero
+
+ INC HL ; step past the jump length.
+ EXX ; switch in the main set.
+ RET ; return.
+
+; <font color=#9900FF>Note.</font> as a general rule the calculator avoids using the IY register
+; otherwise the cumbersome 4 instructions in the middle could be replaced by
+; dec (iy+$xx) - using three instruction bytes instead of six.
+
+
+; ---------------------
+; THE <b><font color=#333388>'JUMP'</font></b> SUBROUTINE
+; ---------------------
+; <font color=#339933>(Offset $2F; 'jump')</font>
+; This enables the calculator to perform relative jumps just like
+; the Z80 chip's JR instruction.
+; This is one of the few routines to be polished for the ZX Spectrum.
+; See, without looking at the ZX Spectrum ROM, if you can get rid of the
+; relative jump.
+
+<a name="L1C23"></a>;; <b>jump</b>
+<a name="L1C23"></a>;; <b>JUMP</b>
+L1C23: EXX ;switch in pointer set
+
+<a name="L1C24"></a>;; <b>JUMP-2</b>
+L1C24: LD E,(HL) ; the jump byte 0-127 forward, 128-255 back.
+ XOR A ; clear accumulator.
+ BIT 7,E ; test if negative jump
+ JR Z,<A href="#L1C2B">L1C2B</a> ; skip, if positive, to JUMP-3.
+
+ CPL ; else change to $FF.
+
+<a name="L1C2B"></a>;; <b>JUMP-3</b>
+L1C2B: LD D,A ; transfer to high byte.
+ ADD HL,DE ; advance calculator pointer forward or back.
+
+ EXX ; switch out pointer set.
+ RET ; return.
+
+; -----------------------------
+; THE <b><font color=#333388>'JUMP ON TRUE'</font></b> SUBROUTINE
+; -----------------------------
+; <font color=#339933>(Offset $00; 'jump-true')</font>
+; This enables the calculator to perform conditional relative jumps
+; dependent on whether the last test gave a true result
+; On the ZX81, the exponent will be zero for zero or else $81 for one.
+
+<a name="L1C2F"></a>;; <b>jump-true</b>
+L1C2F: LD A,(DE) ; collect exponent byte
+
+ AND A ; is result 0 or 1 ?
+ JR NZ,<A href="#L1C23">L1C23</a> ; back to JUMP if true (1).
+
+ EXX ; else switch in the pointer set.
+ INC HL ; step past the jump length.
+ EXX ; switch in the main set.
+ RET ; return.
+
+
+; ------------------------
+; THE <b><font color=#333388>'MODULUS'</font></b> SUBROUTINE
+; ------------------------
+; ( Offset $2E: 'n-mod-m' )
+; <font color=#CC00FF>( i1, i2 -- i3, i4 )</font>
+; The subroutine calculate N mod M where M is the positive integer, the
+; 'last value' on the calculator stack and N is the integer beneath.
+; The subroutine returns the integer quotient as the last value and the
+; remainder as the value beneath.
+; e.g. 17 MOD 3 = 5 remainder 2
+; It is invoked during the calculation of a random number and also by
+; the PRINT-FP routine.
+
+<a name="L1C37"></a>;; <b>n-mod-m</b>
+L1C37: RST 28H ;; FP-CALC 17, 3.
+ DEFB $C0 ;;st-mem-0 17, 3.
+ DEFB $02 ;;delete 17.
+ DEFB $2D ;;duplicate 17, 17.
+ DEFB $E0 ;;get-mem-0 17, 17, 3.
+ DEFB $05 ;;division 17, 17/3.
+ DEFB $24 ;;int 17, 5.
+ DEFB $E0 ;;get-mem-0 17, 5, 3.
+ DEFB $01 ;;exchange 17, 3, 5.
+ DEFB $C0 ;;st-mem-0 17, 3, 5.
+ DEFB $04 ;;multiply 17, 15.
+ DEFB $03 ;;subtract 2.
+ DEFB $E0 ;;get-mem-0 2, 5.
+ DEFB $34 ;;end-calc 2, 5.
+
+ RET ; return.
+
+
+; ----------------------
+; THE <b><font color=#333388>'INTEGER'</font></b> FUNCTION
+; ----------------------
+; <font color=#339933>(offset $24: 'int')</font>
+; This function returns the integer of x, which is just the same as truncate
+; for positive numbers. The truncate literal truncates negative numbers
+; upwards so that -3.4 gives -3 whereas the BASIC INT function has to
+; truncate negative numbers down so that INT -3.4 is 4.
+; It is best to work through using, say, plus or minus 3.4 as examples.
+
+<a name="L1C46"></a>;; <b>int</b>
+L1C46: RST 28H ;; FP-CALC x. (= 3.4 or -3.4).
+ DEFB $2D ;;duplicate x, x.
+ DEFB $32 ;;less-0 x, (1/0)
+ DEFB $00 ;;jump-true x, (1/0)
+ DEFB $04 ;;to <A href="#L1C46">L1C46</a>, X-NEG
+
+ DEFB $36 ;;truncate trunc 3.4 = 3.
+ DEFB $34 ;;end-calc 3.
+
+ RET ; return with + int x on stack.
+
+
+<a name="L1C4E"></a>;; <b>X-NEG</b>
+L1C4E: DEFB $2D ;;duplicate -3.4, -3.4.
+ DEFB $36 ;;truncate -3.4, -3.
+ DEFB $C0 ;;st-mem-0 -3.4, -3.
+ DEFB $03 ;;subtract -.4
+ DEFB $E0 ;;get-mem-0 -.4, -3.
+ DEFB $01 ;;exchange -3, -.4.
+ DEFB $2C ;;not -3, (0).
+ DEFB $00 ;;jump-true -3.
+ DEFB $03 ;;to <A href="#L1C59">L1C59</a>, EXIT -3.
+
+ DEFB $A1 ;;stk-one -3, 1.
+ DEFB $03 ;;subtract -4.
+
+<a name="L1C59"></a>;; <b>EXIT</b>
+L1C59: DEFB $34 ;;end-calc -4.
+
+ RET ; return.
+
+
+; ----------------
+; Exponential (23)
+; ----------------
+;
+;
+
+<a name="L1C5B"></a>;; <b>EXP</b>
+<a name="L1C5B"></a>;; <b>exp</b>
+L1C5B: RST 28H ;; FP-CALC
+ DEFB $30 ;;stk-data
+ DEFB $F1 ;;Exponent: $81, Bytes: 4
+ DEFB $38,$AA,$3B,$29 ;;
+ DEFB $04 ;;multiply
+ DEFB $2D ;;duplicate
+ DEFB $24 ;;int
+ DEFB $C3 ;;st-mem-3
+ DEFB $03 ;;subtract
+ DEFB $2D ;;duplicate
+ DEFB $0F ;;addition
+ DEFB $A1 ;;stk-one
+ DEFB $03 ;;subtract
+ DEFB $88 ;;series-08
+ DEFB $13 ;;Exponent: $63, Bytes: 1
+ DEFB $36 ;;(+00,+00,+00)
+ DEFB $58 ;;Exponent: $68, Bytes: 2
+ DEFB $65,$66 ;;(+00,+00)
+ DEFB $9D ;;Exponent: $6D, Bytes: 3
+ DEFB $78,$65,$40 ;;(+00)
+ DEFB $A2 ;;Exponent: $72, Bytes: 3
+ DEFB $60,$32,$C9 ;;(+00)
+ DEFB $E7 ;;Exponent: $77, Bytes: 4
+ DEFB $21,$F7,$AF,$24 ;;
+ DEFB $EB ;;Exponent: $7B, Bytes: 4
+ DEFB $2F,$B0,$B0,$14 ;;
+ DEFB $EE ;;Exponent: $7E, Bytes: 4
+ DEFB $7E,$BB,$94,$58 ;;
+ DEFB $F1 ;;Exponent: $81, Bytes: 4
+ DEFB $3A,$7E,$F8,$CF ;;
+ DEFB $E3 ;;get-mem-3
+ DEFB $34 ;;end-calc
+
+ CALL <A href="#L15CD">L15CD</a> ; routine FP-TO-A
+ JR NZ,<A href="#L1C9B">L1C9B</a> ; to N-NEGTV
+
+ JR C,<A href="#L1C99">L1C99</a> ; to REPORT-6b
+
+ ADD A,(HL) ;
+ JR NC,<A href="#L1CA2">L1CA2</a> ; to RESULT-OK
+
+
+<a name="L1C99"></a>;; <b>REPORT-6b</b>
+L1C99: RST 08H ; ERROR-1
+ DEFB $05 ; Error Report: Number too big
+
+<a name="L1C9B"></a>;; <b>N-NEGTV</b>
+L1C9B: JR C,<A href="#L1CA4">L1CA4</a> ; to RSLT-ZERO
+
+ SUB (HL) ;
+ JR NC,<A href="#L1CA4">L1CA4</a> ; to RSLT-ZERO
+
+ NEG ; Negate
+
+<a name="L1CA2"></a>;; <b>RESULT-OK</b>
+L1CA2: LD (HL),A ;
+ RET ; return.
+
+
+<a name="L1CA4"></a>;; <b>RSLT-ZERO</b>
+L1CA4: RST 28H ;; FP-CALC
+ DEFB $02 ;;delete
+ DEFB $A0 ;;stk-zero
+ DEFB $34 ;;end-calc
+
+ RET ; return.
+
+
+; --------------------------------
+; THE <b><font color=#333388>'NATURAL LOGARITHM'</font></b> FUNCTION
+; --------------------------------
+; <font color=#339933>(offset $22: 'ln')</font>
+; Like the ZX81 itself, 'natural' logarithms came from Scotland.
+; They were devised in 1614 by well-traveled Scotsman John Napier who noted
+; "Nothing doth more molest and hinder calculators than the multiplications,
+; divisions, square and cubical extractions of great numbers".
+;
+; Napier's logarithms enabled the above operations to be accomplished by
+; simple addition and subtraction simplifying the navigational and
+; astronomical calculations which beset his age.
+; Napier's logarithms were quickly overtaken by logarithms to the base 10
+; devised, in conjunction with Napier, by Henry Briggs a Cambridge-educated
+; professor of Geometry at Oxford University. These simplified the layout
+; of the tables enabling humans to easily scale calculations.
+;
+; It is only recently with the introduction of pocket calculators and
+; computers like the ZX81 that natural logarithms are once more at the fore,
+; although some computers retain logarithms to the base ten.
+; 'Natural' logarithms are powers to the base 'e', which like 'pi' is a
+; naturally occurring number in branches of mathematics.
+; Like 'pi' also, 'e' is an irrational number and starts 2.718281828...
+;
+; The tabular use of logarithms was that to multiply two numbers one looked
+; up their two logarithms in the tables, added them together and then looked
+; for the result in a table of antilogarithms to give the desired product.
+;
+; The EXP function is the BASIC equivalent of a calculator's 'antiln' function
+; and by picking any two numbers, 1.72 and 6.89 say,
+; 10 PRINT EXP ( LN 1.72 + LN 6.89 )
+; will give just the same result as
+; 20 PRINT 1.72 * 6.89.
+; Division is accomplished by subtracting the two logs.
+;
+; Napier also mentioned "square and cubicle extractions".
+; To raise a number to the power 3, find its 'ln', multiply by 3 and find the
+; 'antiln'. e.g. PRINT EXP( LN 4 * 3 ) gives 64.
+; Similarly to find the n'th root divide the logarithm by 'n'.
+; The ZX81 ROM used PRINT EXP ( LN 9 / 2 ) to find the square root of the
+; number 9. The Napieran square root function is just a special case of
+; the 'to_power' function. A cube root or indeed any root/power would be just
+; as simple.
+
+; First test that the argument to LN is a positive, non-zero number.
+
+<a name="L1CA9"></a>;; <b>ln</b>
+L1CA9: RST 28H ;; FP-CALC
+ DEFB $2D ;;duplicate
+ DEFB $33 ;;greater-0
+ DEFB $00 ;;jump-true
+ DEFB $04 ;;to <A href="#L1CB1">L1CB1</a>, VALID
+
+ DEFB $34 ;;end-calc
+
+
+<a name="L1CAF"></a>;; <b>REPORT-Ab</b>
+L1CAF: RST 08H ; ERROR-1
+ DEFB $09 ; Error Report: Invalid argument
+
+<a name="L1CB1"></a>;; <b>VALID</b>
+L1CB1: DEFB $A0 ;;stk-zero <font color=#9900FF>Note.</font> not
+ DEFB $02 ;;delete necessary.
+ DEFB $34 ;;end-calc
+ LD A,(HL) ;
+
+ LD (HL),$80 ;
+ CALL <A href="#L151D">L151D</a> ; routine STACK-A
+
+ RST 28H ;; FP-CALC
+ DEFB $30 ;;stk-data
+ DEFB $38 ;;Exponent: $88, Bytes: 1
+ DEFB $00 ;;(+00,+00,+00)
+ DEFB $03 ;;subtract
+ DEFB $01 ;;exchange
+ DEFB $2D ;;duplicate
+ DEFB $30 ;;stk-data
+ DEFB $F0 ;;Exponent: $80, Bytes: 4
+ DEFB $4C,$CC,$CC,$CD ;;
+ DEFB $03 ;;subtract
+ DEFB $33 ;;greater-0
+ DEFB $00 ;;jump-true
+ DEFB $08 ;;to <A href="#L1CD2">L1CD2</a>, GRE.8
+
+ DEFB $01 ;;exchange
+ DEFB $A1 ;;stk-one
+ DEFB $03 ;;subtract
+ DEFB $01 ;;exchange
+ DEFB $34 ;;end-calc
+
+ INC (HL) ;
+
+ RST 28H ;; FP-CALC
+
+<a name="L1CD2"></a>;; <b>GRE.8</b>
+L1CD2: DEFB $01 ;;exchange
+ DEFB $30 ;;stk-data
+ DEFB $F0 ;;Exponent: $80, Bytes: 4
+ DEFB $31,$72,$17,$F8 ;;
+ DEFB $04 ;;multiply
+ DEFB $01 ;;exchange
+ DEFB $A2 ;;stk-half
+ DEFB $03 ;;subtract
+ DEFB $A2 ;;stk-half
+ DEFB $03 ;;subtract
+ DEFB $2D ;;duplicate
+ DEFB $30 ;;stk-data
+ DEFB $32 ;;Exponent: $82, Bytes: 1
+ DEFB $20 ;;(+00,+00,+00)
+ DEFB $04 ;;multiply
+ DEFB $A2 ;;stk-half
+ DEFB $03 ;;subtract
+ DEFB $8C ;;series-0C
+ DEFB $11 ;;Exponent: $61, Bytes: 1
+ DEFB $AC ;;(+00,+00,+00)
+ DEFB $14 ;;Exponent: $64, Bytes: 1
+ DEFB $09 ;;(+00,+00,+00)
+ DEFB $56 ;;Exponent: $66, Bytes: 2
+ DEFB $DA,$A5 ;;(+00,+00)
+ DEFB $59 ;;Exponent: $69, Bytes: 2
+ DEFB $30,$C5 ;;(+00,+00)
+ DEFB $5C ;;Exponent: $6C, Bytes: 2
+ DEFB $90,$AA ;;(+00,+00)
+ DEFB $9E ;;Exponent: $6E, Bytes: 3
+ DEFB $70,$6F,$61 ;;(+00)
+ DEFB $A1 ;;Exponent: $71, Bytes: 3
+ DEFB $CB,$DA,$96 ;;(+00)
+ DEFB $A4 ;;Exponent: $74, Bytes: 3
+ DEFB $31,$9F,$B4 ;;(+00)
+ DEFB $E7 ;;Exponent: $77, Bytes: 4
+ DEFB $A0,$FE,$5C,$FC ;;
+ DEFB $EA ;;Exponent: $7A, Bytes: 4
+ DEFB $1B,$43,$CA,$36 ;;
+ DEFB $ED ;;Exponent: $7D, Bytes: 4
+ DEFB $A7,$9C,$7E,$5E ;;
+ DEFB $F0 ;;Exponent: $80, Bytes: 4
+ DEFB $6E,$23,$80,$93 ;;
+ DEFB $04 ;;multiply
+ DEFB $0F ;;addition
+ DEFB $34 ;;end-calc
+
+ RET ; return.
+
+; -----------------------------
+; THE <b><font color=#333388>'TRIGONOMETRIC'</font></b> FUNCTIONS
+; -----------------------------
+; Trigonometry is rocket science. It is also used by carpenters and pyramid
+; builders.
+; Some uses can be quite abstract but the principles can be seen in simple
+; right-angled triangles. Triangles have some special properties -
+;
+; 1) The sum of the three angles is always PI radians (180 degrees).
+; Very helpful if you know two angles and wish to find the third.
+; 2) In any right-angled triangle the sum of the squares of the two shorter
+; sides is equal to the square of the longest side opposite the right-angle.
+; Very useful if you know the length of two sides and wish to know the
+; length of the third side.
+; 3) Functions sine, cosine and tangent enable one to calculate the length
+; of an unknown side when the length of one other side and an angle is
+; known.
+; 4) Functions arcsin, arccosine and arctan enable one to calculate an unknown
+; angle when the length of two of the sides is known.
+
+; --------------------------------
+; THE <b><font color=#333388>'REDUCE ARGUMENT'</font></b> SUBROUTINE
+; --------------------------------
+; <font color=#339933>(offset $35: 'get-argt')</font>
+;
+; This routine performs two functions on the angle, in radians, that forms
+; the argument to the sine and cosine functions.
+; First it ensures that the angle 'wraps round'. That if a ship turns through
+; an angle of, say, 3*PI radians (540 degrees) then the net effect is to turn
+; through an angle of PI radians (180 degrees).
+; Secondly it converts the angle in radians to a fraction of a right angle,
+; depending within which quadrant the angle lies, with the periodicity
+; resembling that of the desired sine value.
+; The result lies in the range -1 to +1.
+;
+; 90 deg.
+;
+; (pi/2)
+; II +1 I
+; |
+; sin+ |\ | /| sin+
+; cos- | \ | / | cos+
+; tan- | \ | / | tan+
+; | \|/) |
+; 180 deg. (pi) 0 -|----+----|-- 0 (0) 0 degrees
+; | /|\ |
+; sin- | / | \ | sin-
+; cos- | / | \ | cos+
+; tan+ |/ | \| tan-
+; |
+; III -1 IV
+; (3pi/2)
+;
+; 270 deg.
+
+
+<a name="L1D18"></a>;; <b>get-argt</b>
+L1D18: RST 28H ;; FP-CALC X.
+ DEFB $30 ;;stk-data
+ DEFB $EE ;;Exponent: $7E,
+ ;;Bytes: 4
+ DEFB $22,$F9,$83,$6E ;; X, 1/(2*PI)
+ DEFB $04 ;;multiply X/(2*PI) = fraction
+
+ DEFB $2D ;;duplicate
+ DEFB $A2 ;;stk-half
+ DEFB $0F ;;addition
+ DEFB $24 ;;int
+
+ DEFB $03 ;;subtract now range -.5 to .5
+
+ DEFB $2D ;;duplicate
+ DEFB $0F ;;addition now range -1 to 1.
+ DEFB $2D ;;duplicate
+ DEFB $0F ;;addition now range -2 to 2.
+
+; quadrant I (0 to +1) and quadrant IV (-1 to 0) are now correct.
+; quadrant II ranges +1 to +2.
+; quadrant III ranges -2 to -1.
+
+ DEFB $2D ;;duplicate Y, Y.
+ DEFB $27 ;;abs Y, abs(Y). range 1 to 2
+ DEFB $A1 ;;stk-one Y, abs(Y), 1.
+ DEFB $03 ;;subtract Y, abs(Y)-1. range 0 to 1
+ DEFB $2D ;;duplicate Y, Z, Z.
+ DEFB $33 ;;greater-0 Y, Z, (1/0).
+
+ DEFB $C0 ;;st-mem-0 store as possible sign
+ ;; for cosine function.
+
+ DEFB $00 ;;jump-true
+ DEFB $04 ;;to <A href="#L1D35">L1D35</a>, ZPLUS with quadrants II and III
+
+; else the angle lies in quadrant I or IV and value Y is already correct.
+
+ DEFB $02 ;;delete Y delete test value.
+ DEFB $34 ;;end-calc Y.
+
+ RET ; return. with Q1 and Q4 >>>
+
+; The branch was here with quadrants II (0 to 1) and III (1 to 0).
+; Y will hold -2 to -1 if this is quadrant III.
+
+<a name="L1D35"></a>;; <b>ZPLUS</b>
+L1D35: DEFB $A1 ;;stk-one Y, Z, 1
+ DEFB $03 ;;subtract Y, Z-1. Q3 = 0 to -1
+ DEFB $01 ;;exchange Z-1, Y.
+ DEFB $32 ;;less-0 Z-1, (1/0).
+ DEFB $00 ;;jump-true Z-1.
+ DEFB $02 ;;to <A href="#L1D3C">L1D3C</a>, YNEG
+ ;;if angle in quadrant III
+
+; else angle is within quadrant II (-1 to 0)
+
+ DEFB $18 ;;negate range +1 to 0
+
+
+<a name="L1D3C"></a>;; <b>YNEG</b>
+L1D3C: DEFB $34 ;;end-calc quadrants II and III correct.
+
+ RET ; return.
+
+
+; ---------------------
+; THE <b><font color=#333388>'COSINE'</font></b> FUNCTION
+; ---------------------
+; <font color=#339933>(offset $1D: 'cos')</font>
+; Cosines are calculated as the sine of the opposite angle rectifying the
+; sign depending on the quadrant rules.
+;
+;
+; /|
+; h /y|
+; / |o
+; /x |
+; /----|
+; a
+;
+; The cosine of angle x is the adjacent side (a) divided by the hypotenuse 1.
+; However if we examine angle y then a/h is the sine of that angle.
+; Since angle x plus angle y equals a right-angle, we can find angle y by
+; subtracting angle x from pi/2.
+; However it's just as easy to reduce the argument first and subtract the
+; reduced argument from the value 1 (a reduced right-angle).
+; It's even easier to subtract 1 from the angle and rectify the sign.
+; In fact, after reducing the argument, the absolute value of the argument
+; is used and rectified using the test result stored in mem-0 by 'get-argt'
+; for that purpose.
+
+<a name="L1D3E"></a>;; <b>cos</b>
+L1D3E: RST 28H ;; FP-CALC angle in radians.
+ DEFB $35 ;;get-argt X reduce -1 to +1
+
+ DEFB $27 ;;abs ABS X 0 to 1
+ DEFB $A1 ;;stk-one ABS X, 1.
+ DEFB $03 ;;subtract now opposite angle
+ ;; though negative sign.
+ DEFB $E0 ;;get-mem-0 fetch sign indicator.
+ DEFB $00 ;;jump-true
+ DEFB $06 ;;fwd to <A href="#L1D4B">L1D4B</a>, C-ENT
+ ;;forward to common code if in QII or QIII
+
+
+ DEFB $18 ;;negate else make positive.
+ DEFB $2F ;;jump
+ DEFB $03 ;;fwd to <A href="#L1D4B">L1D4B</a>, C-ENT
+ ;;with quadrants QI and QIV
+
+; -------------------
+; THE <b><font color=#333388>'SINE'</font></b> FUNCTION
+; -------------------
+; <font color=#339933>(offset $1C: 'sin')</font>
+; This is a fundamental transcendental function from which others such as cos
+; and tan are directly, or indirectly, derived.
+; It uses the series generator to produce Chebyshev polynomials.
+;
+;
+; /|
+; 1 / |
+; / |x
+; /a |
+; /----|
+; y
+;
+; The 'get-argt' function is designed to modify the angle and its sign
+; in line with the desired sine value and afterwards it can launch straight
+; into common code.
+
+<a name="L1D49"></a>;; <b>sin</b>
+L1D49: RST 28H ;; FP-CALC angle in radians
+ DEFB $35 ;;get-argt reduce - sign now correct.
+
+<a name="L1D4B"></a>;; <b>C-ENT</b>
+L1D4B: DEFB $2D ;;duplicate
+ DEFB $2D ;;duplicate
+ DEFB $04 ;;multiply
+ DEFB $2D ;;duplicate
+ DEFB $0F ;;addition
+ DEFB $A1 ;;stk-one
+ DEFB $03 ;;subtract
+
+ DEFB $86 ;;series-06
+ DEFB $14 ;;Exponent: $64, Bytes: 1
+ DEFB $E6 ;;(+00,+00,+00)
+ DEFB $5C ;;Exponent: $6C, Bytes: 2
+ DEFB $1F,$0B ;;(+00,+00)
+ DEFB $A3 ;;Exponent: $73, Bytes: 3
+ DEFB $8F,$38,$EE ;;(+00)
+ DEFB $E9 ;;Exponent: $79, Bytes: 4
+ DEFB $15,$63,$BB,$23 ;;
+ DEFB $EE ;;Exponent: $7E, Bytes: 4
+ DEFB $92,$0D,$CD,$ED ;;
+ DEFB $F1 ;;Exponent: $81, Bytes: 4
+ DEFB $23,$5D,$1B,$EA ;;
+
+ DEFB $04 ;;multiply
+ DEFB $34 ;;end-calc
+
+ RET ; return.
+
+
+; ----------------------
+; THE <b><font color=#333388>'TANGENT'</font></b> FUNCTION
+; ----------------------
+; <font color=#339933>(offset $1E: 'tan')</font>
+;
+; Evaluates tangent x as sin(x) / cos(x).
+;
+;
+; /|
+; h / |
+; / |o
+; /x |
+; /----|
+; a
+;
+; The tangent of angle x is the ratio of the length of the opposite side
+; divided by the length of the adjacent side. As the opposite length can
+; be calculates using sin(x) and the adjacent length using cos(x) then
+; the tangent can be defined in terms of the previous two functions.
+
+; Error 6 if the argument, in radians, is too close to one like pi/2
+; which has an infinite tangent. e.g. PRINT TAN (PI/2) evaluates as 1/0.
+; Similarly PRINT TAN (3*PI/2), TAN (5*PI/2) etc.
+
+<a name="L1D6E"></a>;; <b>tan</b>
+L1D6E: RST 28H ;; FP-CALC x.
+ DEFB $2D ;;duplicate x, x.
+ DEFB $1C ;;sin x, sin x.
+ DEFB $01 ;;exchange sin x, x.
+ DEFB $1D ;;cos sin x, cos x.
+ DEFB $05 ;;division sin x/cos x (= tan x).
+ DEFB $34 ;;end-calc tan x.
+
+ RET ; return.
+
+; ---------------------
+; THE <b><font color=#333388>'ARCTAN'</font></b> FUNCTION
+; ---------------------
+; <font color=#339933>(Offset $21: 'atn')</font>
+; The inverse tangent function with the result in radians.
+; This is a fundamental transcendental function from which others such as
+; asn and acs are directly, or indirectly, derived.
+; It uses the series generator to produce Chebyshev polynomials.
+
+<a name="L1D76"></a>;; <b>atn</b>
+L1D76: LD A,(HL) ; fetch exponent
+ CP $81 ; compare to that for 'one'
+ JR C,<A href="#L1D89">L1D89</a> ; forward, if less, to SMALL
+
+ RST 28H ;; FP-CALC X.
+ DEFB $A1 ;;stk-one
+ DEFB $18 ;;negate
+ DEFB $01 ;;exchange
+ DEFB $05 ;;division
+ DEFB $2D ;;duplicate
+ DEFB $32 ;;less-0
+ DEFB $A3 ;;stk-pi/2
+ DEFB $01 ;;exchange
+ DEFB $00 ;;jump-true
+ DEFB $06 ;;to <A href="#L1D8B">L1D8B</a>, CASES
+
+ DEFB $18 ;;negate
+ DEFB $2F ;;jump
+ DEFB $03 ;;to <A href="#L1D8B">L1D8B</a>, CASES
+
+; ---
+
+<a name="L1D89"></a>;; <b>SMALL</b>
+L1D89: RST 28H ;; FP-CALC
+ DEFB $A0 ;;stk-zero
+
+<a name="L1D8B"></a>;; <b>CASES</b>
+L1D8B: DEFB $01 ;;exchange
+ DEFB $2D ;;duplicate
+ DEFB $2D ;;duplicate
+ DEFB $04 ;;multiply
+ DEFB $2D ;;duplicate
+ DEFB $0F ;;addition
+ DEFB $A1 ;;stk-one
+ DEFB $03 ;;subtract
+
+ DEFB $8C ;;series-0C
+ DEFB $10 ;;Exponent: $60, Bytes: 1
+ DEFB $B2 ;;(+00,+00,+00)
+ DEFB $13 ;;Exponent: $63, Bytes: 1
+ DEFB $0E ;;(+00,+00,+00)
+ DEFB $55 ;;Exponent: $65, Bytes: 2
+ DEFB $E4,$8D ;;(+00,+00)
+ DEFB $58 ;;Exponent: $68, Bytes: 2
+ DEFB $39,$BC ;;(+00,+00)
+ DEFB $5B ;;Exponent: $6B, Bytes: 2
+ DEFB $98,$FD ;;(+00,+00)
+ DEFB $9E ;;Exponent: $6E, Bytes: 3
+ DEFB $00,$36,$75 ;;(+00)
+ DEFB $A0 ;;Exponent: $70, Bytes: 3
+ DEFB $DB,$E8,$B4 ;;(+00)
+ DEFB $63 ;;Exponent: $73, Bytes: 2
+ DEFB $42,$C4 ;;(+00,+00)
+ DEFB $E6 ;;Exponent: $76, Bytes: 4
+ DEFB $B5,$09,$36,$BE ;;
+ DEFB $E9 ;;Exponent: $79, Bytes: 4
+ DEFB $36,$73,$1B,$5D ;;
+ DEFB $EC ;;Exponent: $7C, Bytes: 4
+ DEFB $D8,$DE,$63,$BE ;;
+ DEFB $F0 ;;Exponent: $80, Bytes: 4
+ DEFB $61,$A1,$B3,$0C ;;
+
+ DEFB $04 ;;multiply
+ DEFB $0F ;;addition
+ DEFB $34 ;;end-calc
+
+ RET ; return.
+
+
+; ---------------------
+; THE <b><font color=#333388>'ARCSIN'</font></b> FUNCTION
+; ---------------------
+; <font color=#339933>(Offset $1F: 'asn')</font>
+; The inverse sine function with result in radians.
+; Derived from arctan function above.
+; Error A unless the argument is between -1 and +1 inclusive.
+; Uses an adaptation of the formula asn(x) = atn(x/sqr(1-x*x))
+;
+;
+; /|
+; / |
+; 1/ |x
+; /a |
+; /----|
+; y
+;
+; e.g. We know the opposite side (x) and hypotenuse (1)
+; and we wish to find angle a in radians.
+; We can derive length y by Pythagoras and then use ATN instead.
+; Since y*y + x*x = 1*1 (Pythagoras Theorem) then
+; y=sqr(1-x*x) - no need to multiply 1 by itself.
+; So, asn(a) = atn(x/y)
+; or more fully,
+; asn(a) = atn(x/sqr(1-x*x))
+
+; Close but no cigar.
+
+; While PRINT ATN (x/SQR (1-x*x)) gives the same results as PRINT ASN x,
+; it leads to division by zero when x is 1 or -1.
+; To overcome this, 1 is added to y giving half the required angle and the
+; result is then doubled.
+; That is, PRINT ATN (x/(SQR (1-x*x) +1)) *2
+;
+;
+; . /|
+; . c/ |
+; . /1 |x
+; . c b /a |
+; ---------/----|
+; 1 y
+;
+; By creating an isosceles triangle with two equal sides of 1, angles c and
+; c are also equal. If b+c+d = 180 degrees and b+a = 180 degrees then c=a/2.
+;
+; A value higher than 1 gives the required error as attempting to find the
+; square root of a negative number generates an error in Sinclair BASIC.
+
+<a name="L1DC4"></a>;; <b>asn</b>
+L1DC4: RST 28H ;; FP-CALC x.
+ DEFB $2D ;;duplicate x, x.
+ DEFB $2D ;;duplicate x, x, x.
+ DEFB $04 ;;multiply x, x*x.
+ DEFB $A1 ;;stk-one x, x*x, 1.
+ DEFB $03 ;;subtract x, x*x-1.
+ DEFB $18 ;;negate x, 1-x*x.
+ DEFB $25 ;;sqr x, sqr(1-x*x) = y.
+ DEFB $A1 ;;stk-one x, y, 1.
+ DEFB $0F ;;addition x, y+1.
+ DEFB $05 ;;division x/y+1.
+ DEFB $21 ;;atn a/2 (half the angle)
+ DEFB $2D ;;duplicate a/2, a/2.
+ DEFB $0F ;;addition a.
+ DEFB $34 ;;end-calc a.
+
+ RET ; return.
+
+
+; ------------------------
+; THE <b><font color=#333388>'ARCCOS'</font></b> FUNCTION
+; ------------------------
+; <font color=#339933>(Offset $20: 'acs')</font>
+; The inverse cosine function with the result in radians.
+; Error A unless the argument is between -1 and +1.
+; Result in range 0 to pi.
+; Derived from asn above which is in turn derived from the preceding atn. It
+; could have been derived directly from atn using acs(x) = atn(sqr(1-x*x)/x).
+; However, as sine and cosine are horizontal translations of each other,
+; uses acs(x) = pi/2 - asn(x)
+
+; e.g. the arccosine of a known x value will give the required angle b in
+; radians.
+; We know, from above, how to calculate the angle a using asn(x).
+; Since the three angles of any triangle add up to 180 degrees, or pi radians,
+; and the largest angle in this case is a right-angle (pi/2 radians), then
+; we can calculate angle b as pi/2 (both angles) minus asn(x) (angle a).
+;
+;
+; /|
+; 1 /b|
+; / |x
+; /a |
+; /----|
+; y
+
+<a name="L1DD4"></a>;; <b>acs</b>
+L1DD4: RST 28H ;; FP-CALC x.
+ DEFB $1F ;;asn asn(x).
+ DEFB $A3 ;;stk-pi/2 asn(x), pi/2.
+ DEFB $03 ;;subtract asn(x) - pi/2.
+ DEFB $18 ;;negate pi/2 - asn(x) = acs(x).
+ DEFB $34 ;;end-calc acs(x)
+
+ RET ; return.
+
+
+; --------------------------
+; THE <b><font color=#333388>'SQUARE ROOT'</font></b> FUNCTION
+; --------------------------
+; <font color=#339933>(Offset $25: 'sqr')</font>
+; Error A if argument is negative.
+; This routine is remarkable for its brevity - 7 bytes.
+; The ZX81 code was originally 9K and various techniques had to be
+; used to shoe-horn it into an 8K Rom chip.
+
+
+<a name="L1DDB"></a>;; <b>sqr</b>
+L1DDB: RST 28H ;; FP-CALC x.
+ DEFB $2D ;;duplicate x, x.
+ DEFB $2C ;;not x, 1/0
+ DEFB $00 ;;jump-true x, (1/0).
+ DEFB $1E ;;to <A href="#L1DFD">L1DFD</a>, LAST exit if argument zero
+ ;; with zero result.
+
+; else continue to calculate as x ** .5
+
+ DEFB $A2 ;;stk-half x, .5.
+ DEFB $34 ;;end-calc x, .5.
+
+
+; ------------------------------
+; THE <b><font color=#333388>'EXPONENTIATION'</font></b> OPERATION
+; ------------------------------
+; <font color=#339933>(Offset $06: 'to-power')</font>
+; This raises the first number X to the power of the second number Y.
+; As with the ZX80,
+; 0 ** 0 = 1
+; 0 ** +n = 0
+; 0 ** -n = arithmetic overflow.
+
+<a name="L1DE2"></a>;; <b>to-power</b>
+L1DE2: RST 28H ;; FP-CALC X,Y.
+ DEFB $01 ;;exchange Y,X.
+ DEFB $2D ;;duplicate Y,X,X.
+ DEFB $2C ;;not Y,X,(1/0).
+ DEFB $00 ;;jump-true
+ DEFB $07 ;;forward to <A href="#L1DEE">L1DEE</a>, XISO if X is zero.
+
+; else X is non-zero. function 'ln' will catch a negative value of X.
+
+ DEFB $22 ;;ln Y, LN X.
+ DEFB $04 ;;multiply Y * LN X
+ DEFB $34 ;;end-calc
+
+ JP <A href="#L1C5B">L1C5B</a> ; jump back to EXP routine. ->
+
+; ---
+
+; These routines form the three simple results when the number is zero.
+; begin by deleting the known zero to leave Y the power factor.
+
+<a name="L1DEE"></a>;; <b>XISO</b>
+L1DEE: DEFB $02 ;;delete Y.
+ DEFB $2D ;;duplicate Y, Y.
+ DEFB $2C ;;not Y, (1/0).
+ DEFB $00 ;;jump-true
+ DEFB $09 ;;forward to <A href="#L1DFB">L1DFB</a>, ONE if Y is zero.
+
+; the power factor is not zero. If negative then an error exists.
+
+ DEFB $A0 ;;stk-zero Y, 0.
+ DEFB $01 ;;exchange 0, Y.
+ DEFB $33 ;;greater-0 0, (1/0).
+ DEFB $00 ;;jump-true 0
+ DEFB $06 ;;to <A href="#L1DFD">L1DFD</a>, LAST if Y was any positive
+ ;; number.
+
+; else force division by zero thereby raising an Arithmetic overflow error.
+; There are some one and two-byte alternatives but perhaps the most formal
+; might have been to use end-calc; rst 08; defb 05.
+
+ DEFB $A1 ;;stk-one 0, 1.
+ DEFB $01 ;;exchange 1, 0.
+ DEFB $05 ;;division 1/0 >> error
+
+; ---
+
+<a name="L1DFB"></a>;; <b>ONE</b>
+L1DFB: DEFB $02 ;;delete .
+ DEFB $A1 ;;stk-one 1.
+
+<a name="L1DFD"></a>;; <b>LAST</b>
+L1DFD: DEFB $34 ;;end-calc last value 1 or 0.
+
+ RET ; return.
+
+; ---------------------
+; THE <b><font color=#333388>'SPARE LOCATIONS'</font></b>
+; ---------------------
+
+<a name="L1DFF"></a>;; <b>SPARE</b>
+L1DFF: DEFB $FF ; That's all folks.
+
+
+
+; ------------------------
+; THE <b><font color=#333388>'ZX81 CHARACTER SET'</font></b>
+; ------------------------
+
+<a name="L1E00"></a>;; <b>char-set</b> - begins with space character.
+
+; $00 - <b>Character: ' ' </b>CHR$(0)
+
+L<B>1</B>E00: DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $01 - <b>Character: mosaic </b>CHR$(1)
+
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+
+; $02 - <b>Character: mosaic </b>CHR$(2)
+
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+
+; $03 - <b>Character: mosaic </b>CHR$(3)
+
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $04 - <b>Character: mosaic </b>CHR$(4)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+
+; $05 - <b>Character: mosaic </b>CHR$(1)
+
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+
+; $06 - <b>Character: mosaic </b>CHR$(1)
+
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %0000<B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+
+; $07 - <b>Character: mosaic </b>CHR$(1)
+
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B>0000
+
+; $08 - <b>Character: mosaic </b>CHR$(1)
+
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+
+; $09 - <b>Character: mosaic </b>CHR$(1)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+
+; $0A - <b>Character: mosaic </b>CHR$(10)
+
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+ DEFB %<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>0<B>1</B>0<B>1</B>
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $0B - <b>Character: '"' </b>CHR$(11)
+
+ DEFB %00000000
+ DEFB %00<B>1</B>00<B>1</B>00
+ DEFB %00<B>1</B>00<B>1</B>00
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $0B - <b>Character: £ </b>CHR$(12)
+
+ DEFB %00000000
+ DEFB %000<B>1</B><B>1</B><B>1</B>00
+ DEFB %00<B>1</B>000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B>000
+ DEFB %00<B>1</B>00000
+ DEFB %00<B>1</B>00000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+; $0B - <b>Character: '$' </b>CHR$(13)
+
+ DEFB %00000000
+ DEFB %0000<B>1</B>000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00<B>1</B>0<B>1</B>000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0000<B>1</B>0<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0000<B>1</B>000
+
+; $0B - <b>Character: ':' </b>CHR$(14)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+
+; $0B - <b>Character: '?' </b>CHR$(15)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %00000000
+ DEFB %0000<B>1</B>000
+ DEFB %00000000
+
+; $10 - <b>Character: '(' </b>CHR$(16)
+
+ DEFB %00000000
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %00000<B>1</B>00
+ DEFB %00000000
+
+; $11 - <b>Character: ')' </b>CHR$(17)
+
+ DEFB %00000000
+ DEFB %00<B>1</B>00000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %00<B>1</B>00000
+ DEFB %00000000
+
+; $12 - <b>Character: '>' </b>CHR$(18)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B>0000
+ DEFB %0000<B>1</B>000
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+
+; $13 - <b>Character: '<' </b>CHR$(19)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0000
+ DEFB %0000<B>1</B>000
+ DEFB %00000<B>1</B>00
+ DEFB %00000000
+
+; $14 - <b>Character: '=' </b>CHR$(20)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+ DEFB %00000000
+
+; $15 - <b>Character: '+' </b>CHR$(21)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %00000000
+
+; $16 - <b>Character: '-' </b>CHR$(22)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $17 - <b>Character: '*' </b>CHR$(23)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B>0<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0<B>1</B>00
+ DEFB %00000000
+
+; $18 - <b>Character: '/' </b>CHR$(24)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000000<B>1</B>0
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0000
+ DEFB %00<B>1</B>00000
+ DEFB %00000000
+
+; $19 - <b>Character: ';' </b>CHR$(25)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %00<B>1</B>00000
+
+; $1A - <b>Character: ',' </b>CHR$(26)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0000
+
+; $1B - <b>Character: '"' </b>CHR$(27)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %00000000
+
+; $1C - <b>Character: '0' </b>CHR$(28)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000<B>1</B><B>1</B>0
+ DEFB %0<B>1</B>00<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>00<B>1</B>0
+ DEFB %0<B>1</B><B>1</B>000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $1D - <b>Character: '1' </b>CHR$(29)
+
+ DEFB %00000000
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %00<B>1</B>0<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+; $1E - <b>Character: '2' </b>CHR$(30)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %000000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+; $1F - <b>Character: '3' </b>CHR$(31)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0000<B>1</B><B>1</B>00
+ DEFB %000000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $20 - <b>Character: '4' </b>CHR$(32)
+
+ DEFB %00000000
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %00<B>1</B>0<B>1</B>000
+ DEFB %0<B>1</B>00<B>1</B>000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0000<B>1</B>000
+ DEFB %00000000
+
+; $21 - <b>Character: '5' </b>CHR$(33)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %000000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $22 - <b>Character: '6' </b>CHR$(34)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $23 - <b>Character: '7' </b>CHR$(35)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %000000<B>1</B>0
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+
+; $24 - <b>Character: '8' </b>CHR$(36)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $25 - <b>Character: '9' </b>CHR$(37)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %000000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $26 - <b>Character: 'A' </b>CHR$(38)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $27 - <b>Character: 'B' </b>CHR$(39)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $28 - <b>Character: 'C' </b>CHR$(40)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $29 - <b>Character: 'D' </b>CHR$(41)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B>000
+ DEFB %0<B>1</B>000<B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>000<B>1</B>00
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B>000
+ DEFB %00000000
+
+; $2A - <b>Character: 'E' </b>CHR$(42)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+; $2B - <b>Character: 'F' </b>CHR$(43)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %00000000
+
+; $2C - <b>Character: 'G' </b>CHR$(44)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>00<B>1</B><B>1</B><B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $2D - <b>Character: 'H' </b>CHR$(45)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $2E - <b>Character: 'I' </b>CHR$(46)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %0000<B>1</B>000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+; $2F - <b>Character: 'J' </b>CHR$(47)
+
+ DEFB %00000000
+ DEFB %000000<B>1</B>0
+ DEFB %000000<B>1</B>0
+ DEFB %000000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $30 - <b>Character: 'K' </b>CHR$(48)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>000<B>1</B>00
+ DEFB %0<B>1</B>00<B>1</B>000
+ DEFB %0<B>1</B><B>1</B><B>1</B>0000
+ DEFB %0<B>1</B>00<B>1</B>000
+ DEFB %0<B>1</B>000<B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $31 - <b>Character: 'L' </b>CHR$(49)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+; $32 - <b>Character: 'M' </b>CHR$(50)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B>00<B>1</B><B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B><B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $33 - <b>Character: 'N' </b>CHR$(51)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B>000<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>00<B>1</B>0
+ DEFB %0<B>1</B>00<B>1</B>0<B>1</B>0
+ DEFB %0<B>1</B>000<B>1</B><B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $34 - <b>Character: 'O' </b>CHR$(52)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $35 - <b>Character: 'P' </b>CHR$(53)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000000
+ DEFB %0<B>1</B>000000
+ DEFB %00000000
+
+; $36 - <b>Character: 'Q' </b>CHR$(54)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B>00<B>1</B>0
+ DEFB %0<B>1</B>00<B>1</B>0<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $37 - <b>Character: 'R' </b>CHR$(55)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000<B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $38 - <b>Character: 'S' </b>CHR$(56)
+
+ DEFB %00000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %0<B>1</B>000000
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %000000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $39 - <b>Character: 'T' </b>CHR$(57)
+
+ DEFB %00000000
+ DEFB %<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+
+; $3A - <b>Character: 'U' </b>CHR$(58)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B><B>1</B><B>1</B><B>1</B>00
+ DEFB %00000000
+
+; $3B - <b>Character: 'V' </b>CHR$(59)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B>00<B>1</B>00
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %00000000
+
+; $3C - <b>Character: 'W' </b>CHR$(60)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %0<B>1</B>0<B>1</B><B>1</B>0<B>1</B>0
+ DEFB %00<B>1</B>00<B>1</B>00
+ DEFB %00000000
+
+; $3D - <b>Character: 'X' </b>CHR$(61)
+
+ DEFB %00000000
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00<B>1</B>00<B>1</B>00
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %000<B>1</B><B>1</B>000
+ DEFB %00<B>1</B>00<B>1</B>00
+ DEFB %0<B>1</B>0000<B>1</B>0
+ DEFB %00000000
+
+; $3E - <b>Character: 'Y' </b>CHR$(62)
+
+ DEFB %00000000
+ DEFB %<B>1</B>00000<B>1</B>0
+ DEFB %0<B>1</B>000<B>1</B>00
+ DEFB %00<B>1</B>0<B>1</B>000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %000<B>1</B>0000
+ DEFB %00000000
+
+; $3F - <b>Character: 'Z' </b>CHR$(63)
+
+ DEFB %00000000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000<B>1</B>00
+ DEFB %0000<B>1</B>000
+ DEFB %000<B>1</B>0000
+ DEFB %00<B>1</B>00000
+ DEFB %0<B>1</B><B>1</B><B>1</B><B>1</B><B>1</B><B>1</B>0
+ DEFB %00000000
+
+.END ;TASM assembler instruction.
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/mirror/tablix.org/zx81.txt b/mirror/tablix.org/zx81.txt
@@ -0,0 +1,10556 @@
+; ===========================================================
+; An Assembly Listing of the Operating System of the ZX81 ROM
+; ===========================================================
+; -------------------------
+; Last updated: 13-DEC-2004
+; -------------------------
+;
+; Work in progress.
+; This file will cross-assemble an original version of the "Improved"
+; ZX81 ROM. The file can be modified to change the behaviour of the ROM
+; when used in emulators although there is no spare space available.
+;
+; The documentation is incomplete and if you can find a copy
+; of "The Complete Spectrum ROM Disassembly" then many routines
+; such as POINTERS and most of the mathematical routines are
+; similar and often identical.
+;
+; I've used the labels from the above book in this file and also
+; some from the more elusive Complete ZX81 ROM Disassembly
+; by the same publishers, Melbourne House.
+
+
+#define DEFB .BYTE ; TASM cross-assembler definitions
+#define DEFW .WORD
+#define EQU .EQU
+
+
+;*****************************************
+;** Part 1. RESTART ROUTINES AND TABLES **
+;*****************************************
+
+; -----------
+; THE 'START'
+; -----------
+; All Z80 chips start at location zero.
+; At start-up the Interrupt Mode is 0, ZX computers use Interrupt Mode 1.
+; Interrupts are disabled .
+
+;; START
+L0000: OUT ($FD),A ; Turn off the NMI generator if this ROM is
+ ; running in ZX81 hardware. This does nothing
+ ; if this ROM is running within an upgraded
+ ; ZX80.
+ LD BC,$7FFF ; Set BC to the top of possible RAM.
+ ; The higher unpopulated addresses are used for
+ ; video generation.
+ JP L03CB ; Jump forward to RAM-CHECK.
+
+; -------------------
+; THE 'ERROR' RESTART
+; -------------------
+; The error restart deals immediately with an error. ZX computers execute the
+; same code in runtime as when checking syntax. If the error occurred while
+; running a program then a brief report is produced. If the error occurred
+; while entering a BASIC line or in input etc., then the error marker indicates
+; the exact point at which the error lies.
+
+;; ERROR-1
+L0008: LD HL,($4016) ; fetch character address from CH_ADD.
+ LD ($4018),HL ; and set the error pointer X_PTR.
+ JR L0056 ; forward to continue at ERROR-2.
+
+; -------------------------------
+; THE 'PRINT A CHARACTER' RESTART
+; -------------------------------
+; This restart prints the character in the accumulator using the alternate
+; register set so there is no requirement to save the main registers.
+; There is sufficient room available to separate a space (zero) from other
+; characters as leading spaces need not be considered with a space.
+
+;; PRINT-A
+L0010: AND A ; test for zero - space.
+ JP NZ,L07F1 ; jump forward if not to PRINT-CH.
+
+ JP L07F5 ; jump forward to PRINT-SP.
+
+; ---
+
+ DEFB $FF ; unused location.
+
+; ---------------------------------
+; THE 'COLLECT A CHARACTER' RESTART
+; ---------------------------------
+; The character addressed by the system variable CH_ADD is fetched and if it
+; is a non-space, non-cursor character it is returned else CH_ADD is
+; incremented and the new addressed character tested until it is not a space.
+
+;; GET-CHAR
+L0018: LD HL,($4016) ; set HL to character address CH_ADD.
+ LD A,(HL) ; fetch addressed character to A.
+
+;; TEST-SP
+L001C: AND A ; test for space.
+ RET NZ ; return if not a space
+
+ NOP ; else trickle through
+ NOP ; to the next routine.
+
+; ------------------------------------
+; THE 'COLLECT NEXT CHARACTER' RESTART
+; ------------------------------------
+; The character address in incremented and the new addressed character is
+; returned if not a space, or cursor, else the process is repeated.
+
+;; NEXT-CHAR
+L0020: CALL L0049 ; routine CH-ADD+1 gets next immediate
+ ; character.
+ JR L001C ; back to TEST-SP.
+
+; ---
+
+ DEFB $FF, $FF, $FF ; unused locations.
+
+; ---------------------------------------
+; THE 'FLOATING POINT CALCULATOR' RESTART
+; ---------------------------------------
+; this restart jumps to the recursive floating-point calculator.
+; the ZX81's internal, FORTH-like, stack-based language.
+;
+; In the five remaining bytes there is, appropriately, enough room for the
+; end-calc literal - the instruction which exits the calculator.
+
+;; FP-CALC
+L0028: JP L199D ; jump immediately to the CALCULATE routine.
+
+; ---
+
+;; end-calc
+L002B: POP AF ; drop the calculator return address RE-ENTRY
+ EXX ; switch to the other set.
+
+ EX (SP),HL ; transfer H'L' to machine stack for the
+ ; return address.
+ ; when exiting recursion then the previous
+ ; pointer is transferred to H'L'.
+
+ EXX ; back to main set.
+ RET ; return.
+
+
+; -----------------------------
+; THE 'MAKE BC SPACES' RESTART
+; -----------------------------
+; This restart is used eight times to create, in workspace, the number of
+; spaces passed in the BC register.
+
+;; BC-SPACES
+L0030: PUSH BC ; push number of spaces on stack.
+ LD HL,($4014) ; fetch edit line location from E_LINE.
+ PUSH HL ; save this value on stack.
+ JP L1488 ; jump forward to continue at RESERVE.
+
+; -----------------------
+; THE 'INTERRUPT' RESTART
+; -----------------------
+; The Mode 1 Interrupt routine is concerned solely with generating the central
+; television picture.
+; On the ZX81 interrupts are enabled only during the interrupt routine,
+; although the interrupt
+; This Interrupt Service Routine automatically disables interrupts at the
+; outset and the last interrupt in a cascade exits before the interrupts are
+; enabled.
+; There is no DI instruction in the ZX81 ROM.
+; An maskable interrupt is triggered when bit 6 of the Z80's Refresh register
+; changes from set to reset.
+; The Z80 will always be executing a HALT (NEWLINE) when the interrupt occurs.
+; A HALT instruction repeatedly executes NOPS but the seven lower bits
+; of the Refresh register are incremented each time as they are when any
+; simple instruction is executed. (The lower 7 bits are incremented twice for
+; a prefixed instruction)
+; This is controlled by the Sinclair Computer Logic Chip - manufactured from
+; a Ferranti Uncommitted Logic Array.
+;
+; When a Mode 1 Interrupt occurs the Program Counter, which is the address in
+; the upper echo display following the NEWLINE/HALT instruction, goes on the
+; machine stack. 193 interrupts are required to generate the last part of
+; the 56th border line and then the 192 lines of the central TV picture and,
+; although each interrupt interrupts the previous one, there are no stack
+; problems as the 'return address' is discarded each time.
+;
+; The scan line counter in C counts down from 8 to 1 within the generation of
+; each text line. For the first interrupt in a cascade the initial value of
+; C is set to 1 for the last border line.
+; Timing is of the utmost importance as the RH border, horizontal retrace
+; and LH border are mostly generated in the 58 clock cycles this routine
+; takes .
+
+;; INTERRUPT
+L0038: DEC C ; (4) decrement C - the scan line counter.
+ JP NZ,L0045 ; (10/10) JUMP forward if not zero to SCAN-LINE
+
+ POP HL ; (10) point to start of next row in display
+ ; file.
+
+ DEC B ; (4) decrement the row counter. (4)
+ RET Z ; (11/5) return when picture complete to L028B
+ ; with interrupts disabled.
+
+ SET 3,C ; (8) Load the scan line counter with eight.
+ ; Note. LD C,$08 is 7 clock cycles which
+ ; is way too fast.
+
+; ->
+
+;; WAIT-INT
+L0041: LD R,A ; (9) Load R with initial rising value $DD.
+
+ EI ; (4) Enable Interrupts. [ R is now $DE ].
+
+ JP (HL) ; (4) jump to the echo display file in upper
+ ; memory and execute characters $00 - $3F
+ ; as NOP instructions. The video hardware
+ ; is able to read these characters and,
+ ; with the I register is able to convert
+ ; the character bitmaps in this ROM into a
+ ; line of bytes. Eventually the NEWLINE/HALT
+ ; will be encountered before R reaches $FF.
+ ; It is however the transition from $FF to
+ ; $80 that triggers the next interrupt.
+ ; [ The Refresh register is now $DF ]
+
+; ---
+
+;; SCAN-LINE
+L0045: POP DE ; (10) discard the address after NEWLINE as the
+ ; same text line has to be done again
+ ; eight times.
+
+ RET Z ; (5) Harmless Nonsensical Timing.
+ ; (condition never met)
+
+ JR L0041 ; (12) back to WAIT-INT
+
+; Note. that a computer with less than 4K or RAM will have a collapsed
+; display file and the above mechanism deals with both types of display.
+;
+; With a full display, the 32 characters in the line are treated as NOPS
+; and the Refresh register rises from $E0 to $FF and, at the next instruction
+; - HALT, the interrupt occurs.
+; With a collapsed display and an initial NEWLINE/HALT, it is the NOPs
+; generated by the HALT that cause the Refresh value to rise from $E0 to $FF,
+; triggering an Interrupt on the next transition.
+; This works happily for all display lines between these extremes and the
+; generation of the 32 character, 1 pixel high, line will always take 128
+; clock cycles.
+
+; ---------------------------------
+; THE 'INCREMENT CH-ADD' SUBROUTINE
+; ---------------------------------
+; This is the subroutine that increments the character address system variable
+; and returns if it is not the cursor character. The ZX81 has an actual
+; character at the cursor position rather than a pointer system variable
+; as is the case with prior and subsequent ZX computers.
+
+;; CH-ADD+1
+L0049: LD HL,($4016) ; fetch character address to CH_ADD.
+
+;; TEMP-PTR1
+L004C: INC HL ; address next immediate location.
+
+;; TEMP-PTR2
+L004D: LD ($4016),HL ; update system variable CH_ADD.
+
+ LD A,(HL) ; fetch the character.
+ CP $7F ; compare to cursor character.
+ RET NZ ; return if not the cursor.
+
+ JR L004C ; back for next character to TEMP-PTR1.
+
+; --------------------
+; THE 'ERROR-2' BRANCH
+; --------------------
+; This is a continuation of the error restart.
+; If the error occurred in runtime then the error stack pointer will probably
+; lead to an error report being printed unless it occurred during input.
+; If the error occurred when checking syntax then the error stack pointer
+; will be an editing routine and the position of the error will be shown
+; when the lower screen is reprinted.
+
+;; ERROR-2
+L0056: POP HL ; pop the return address which points to the
+ ; DEFB, error code, after the RST 08.
+ LD L,(HL) ; load L with the error code. HL is not needed
+ ; anymore.
+
+;; ERROR-3
+L0058: LD (IY+$00),L ; place error code in system variable ERR_NR
+ LD SP,($4002) ; set the stack pointer from ERR_SP
+ CALL L0207 ; routine SLOW/FAST selects slow mode.
+ JP L14BC ; exit to address on stack via routine SET-MIN.
+
+; ---
+
+ DEFB $FF ; unused.
+
+; ------------------------------------
+; THE 'NON MASKABLE INTERRUPT' ROUTINE
+; ------------------------------------
+; Jim Westwood's technical dodge using Non-Maskable Interrupts solved the
+; flicker problem of the ZX80 and gave the ZX81 a multi-tasking SLOW mode
+; with a steady display. Note that the AF' register is reserved for this
+; function and its interaction with the display routines. When counting
+; TV lines, the NMI makes no use of the main registers.
+; The circuitry for the NMI generator is contained within the SCL (Sinclair
+; Computer Logic) chip.
+; ( It takes 32 clock cycles while incrementing towards zero ).
+
+;; NMI
+L0066: EX AF,AF' ; (4) switch in the NMI's copy of the
+ ; accumulator.
+ INC A ; (4) increment.
+ JP M,L006D ; (10/10) jump, if minus, to NMI-RET as this is
+ ; part of a test to see if the NMI
+ ; generation is working or an intermediate
+ ; value for the ascending negated blank
+ ; line counter.
+
+ JR Z,L006F ; (12) forward to NMI-CONT
+ ; when line count has incremented to zero.
+
+; Note. the synchronizing NMI when A increments from zero to one takes this
+; 7 clock cycle route making 39 clock cycles in all.
+
+;; NMI-RET
+L006D: EX AF,AF' ; (4) switch out the incremented line counter
+ ; or test result $80
+ RET ; (10) return to User application for a while.
+
+; ---
+
+; This branch is taken when the 55 (or 31) lines have been drawn.
+
+;; NMI-CONT
+L006F: EX AF,AF' ; (4) restore the main accumulator.
+
+ PUSH AF ; (11) * Save Main Registers
+ PUSH BC ; (11) **
+ PUSH DE ; (11) ***
+ PUSH HL ; (11) ****
+
+; the next set-up procedure is only really applicable when the top set of
+; blank lines have been generated.
+
+ LD HL,($400C) ; (16) fetch start of Display File from D_FILE
+ ; points to the HALT at beginning.
+ SET 7,H ; (8) point to upper 32K 'echo display file'
+
+ HALT ; (1) HALT synchronizes with NMI.
+ ; Used with special hardware connected to the
+ ; Z80 HALT and WAIT lines to take 1 clock cycle.
+
+; ----------------------------------------------------------------------------
+; the NMI has been generated - start counting. The cathode ray is at the RH
+; side of the TV.
+; First the NMI servicing, similar to CALL = 17 clock cycles.
+; Then the time taken by the NMI for zero-to-one path = 39 cycles
+; The HALT above = 01 cycles.
+; The two instructions below = 19 cycles.
+; The code at L0281 up to and including the CALL = 43 cycles.
+; The Called routine at L02B5 = 24 cycles.
+; -------------------------------------- ---
+; Total Z80 instructions = 143 cycles.
+;
+; Meanwhile in TV world,
+; Horizontal retrace = 15 cycles.
+; Left blanking border 8 character positions = 32 cycles
+; Generation of 75% scanline from the first NEWLINE = 96 cycles
+; --------------------------------------- ---
+; 143 cycles
+;
+; Since at the time the first JP (HL) is encountered to execute the echo
+; display another 8 character positions have to be put out, then the
+; Refresh register need to hold $F8. Working back and counteracting
+; the fact that every instruction increments the Refresh register then
+; the value that is loaded into R needs to be $F5. :-)
+;
+;
+ OUT ($FD),A ; (11) Stop the NMI generator.
+
+ JP (IX) ; (8) forward to L0281 (after top) or L028F
+
+; ****************
+; ** KEY TABLES **
+; ****************
+
+; -------------------------------
+; THE 'UNSHIFTED' CHARACTER CODES
+; -------------------------------
+
+;; K-UNSHIFT
+L007E: DEFB $3F ; Z
+ DEFB $3D ; X
+ DEFB $28 ; C
+ DEFB $3B ; V
+ DEFB $26 ; A
+ DEFB $38 ; S
+ DEFB $29 ; D
+ DEFB $2B ; F
+ DEFB $2C ; G
+ DEFB $36 ; Q
+ DEFB $3C ; W
+ DEFB $2A ; E
+ DEFB $37 ; R
+ DEFB $39 ; T
+ DEFB $1D ; 1
+ DEFB $1E ; 2
+ DEFB $1F ; 3
+ DEFB $20 ; 4
+ DEFB $21 ; 5
+ DEFB $1C ; 0
+ DEFB $25 ; 9
+ DEFB $24 ; 8
+ DEFB $23 ; 7
+ DEFB $22 ; 6
+ DEFB $35 ; P
+ DEFB $34 ; O
+ DEFB $2E ; I
+ DEFB $3A ; U
+ DEFB $3E ; Y
+ DEFB $76 ; NEWLINE
+ DEFB $31 ; L
+ DEFB $30 ; K
+ DEFB $2F ; J
+ DEFB $2D ; H
+ DEFB $00 ; SPACE
+ DEFB $1B ; .
+ DEFB $32 ; M
+ DEFB $33 ; N
+ DEFB $27 ; B
+
+; -----------------------------
+; THE 'SHIFTED' CHARACTER CODES
+; -----------------------------
+
+
+;; K-SHIFT
+L00A5: DEFB $0E ; :
+ DEFB $19 ; ;
+ DEFB $0F ; ?
+ DEFB $18 ; /
+ DEFB $E3 ; STOP
+ DEFB $E1 ; LPRINT
+ DEFB $E4 ; SLOW
+ DEFB $E5 ; FAST
+ DEFB $E2 ; LLIST
+ DEFB $C0 ; ""
+ DEFB $D9 ; OR
+ DEFB $E0 ; STEP
+ DEFB $DB ; <=
+ DEFB $DD ; <>
+ DEFB $75 ; EDIT
+ DEFB $DA ; AND
+ DEFB $DE ; THEN
+ DEFB $DF ; TO
+ DEFB $72 ; cursor-left
+ DEFB $77 ; RUBOUT
+ DEFB $74 ; GRAPHICS
+ DEFB $73 ; cursor-right
+ DEFB $70 ; cursor-up
+ DEFB $71 ; cursor-down
+ DEFB $0B ; "
+ DEFB $11 ; )
+ DEFB $10 ; (
+ DEFB $0D ; $
+ DEFB $DC ; >=
+ DEFB $79 ; FUNCTION
+ DEFB $14 ; =
+ DEFB $15 ; +
+ DEFB $16 ; -
+ DEFB $D8 ; **
+ DEFB $0C ; ukp
+ DEFB $1A ; ,
+ DEFB $12 ; >
+ DEFB $13 ; <
+ DEFB $17 ; *
+
+; ------------------------------
+; THE 'FUNCTION' CHARACTER CODES
+; ------------------------------
+
+
+;; K-FUNCT
+L00CC: DEFB $CD ; LN
+ DEFB $CE ; EXP
+ DEFB $C1 ; AT
+ DEFB $78 ; KL
+ DEFB $CA ; ASN
+ DEFB $CB ; ACS
+ DEFB $CC ; ATN
+ DEFB $D1 ; SGN
+ DEFB $D2 ; ABS
+ DEFB $C7 ; SIN
+ DEFB $C8 ; COS
+ DEFB $C9 ; TAN
+ DEFB $CF ; INT
+ DEFB $40 ; RND
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $C2 ; TAB
+ DEFB $D3 ; PEEK
+ DEFB $C4 ; CODE
+ DEFB $D6 ; CHR$
+ DEFB $D5 ; STR$
+ DEFB $78 ; KL
+ DEFB $D4 ; USR
+ DEFB $C6 ; LEN
+ DEFB $C5 ; VAL
+ DEFB $D0 ; SQR
+ DEFB $78 ; KL
+ DEFB $78 ; KL
+ DEFB $42 ; PI
+ DEFB $D7 ; NOT
+ DEFB $41 ; INKEY$
+
+; -----------------------------
+; THE 'GRAPHIC' CHARACTER CODES
+; -----------------------------
+
+
+;; K-GRAPH
+L00F3: DEFB $08 ; graphic
+ DEFB $0A ; graphic
+ DEFB $09 ; graphic
+ DEFB $8A ; graphic
+ DEFB $89 ; graphic
+ DEFB $81 ; graphic
+ DEFB $82 ; graphic
+ DEFB $07 ; graphic
+ DEFB $84 ; graphic
+ DEFB $06 ; graphic
+ DEFB $01 ; graphic
+ DEFB $02 ; graphic
+ DEFB $87 ; graphic
+ DEFB $04 ; graphic
+ DEFB $05 ; graphic
+ DEFB $77 ; RUBOUT
+ DEFB $78 ; KL
+ DEFB $85 ; graphic
+ DEFB $03 ; graphic
+ DEFB $83 ; graphic
+ DEFB $8B ; graphic
+ DEFB $91 ; inverse )
+ DEFB $90 ; inverse (
+ DEFB $8D ; inverse $
+ DEFB $86 ; graphic
+ DEFB $78 ; KL
+ DEFB $92 ; inverse >
+ DEFB $95 ; inverse +
+ DEFB $96 ; inverse -
+ DEFB $88 ; graphic
+
+; ------------------
+; THE 'TOKEN' TABLES
+; ------------------
+
+
+;; TOKENS
+L0111: DEFB $0F+$80 ; '?'+$80
+ DEFB $0B,$0B+$80 ; ""
+ DEFB $26,$39+$80 ; AT
+ DEFB $39,$26,$27+$80 ; TAB
+ DEFB $0F+$80 ; '?'+$80
+ DEFB $28,$34,$29,$2A+$80 ; CODE
+ DEFB $3B,$26,$31+$80 ; VAL
+ DEFB $31,$2A,$33+$80 ; LEN
+ DEFB $38,$2E,$33+$80 ; SIN
+ DEFB $28,$34,$38+$80 ; COS
+ DEFB $39,$26,$33+$80 ; TAN
+ DEFB $26,$38,$33+$80 ; ASN
+ DEFB $26,$28,$38+$80 ; ACS
+ DEFB $26,$39,$33+$80 ; ATN
+ DEFB $31,$33+$80 ; LN
+ DEFB $2A,$3D,$35+$80 ; EXP
+ DEFB $2E,$33,$39+$80 ; INT
+ DEFB $38,$36,$37+$80 ; SQR
+ DEFB $38,$2C,$33+$80 ; SGN
+ DEFB $26,$27,$38+$80 ; ABS
+ DEFB $35,$2A,$2A,$30+$80 ; PEEK
+ DEFB $3A,$38,$37+$80 ; USR
+ DEFB $38,$39,$37,$0D+$80 ; STR$
+ DEFB $28,$2D,$37,$0D+$80 ; CHR$
+ DEFB $33,$34,$39+$80 ; NOT
+ DEFB $17,$17+$80 ; **
+ DEFB $34,$37+$80 ; OR
+ DEFB $26,$33,$29+$80 ; AND
+ DEFB $13,$14+$80 ; <=
+ DEFB $12,$14+$80 ; >=
+ DEFB $13,$12+$80 ; <>
+ DEFB $39,$2D,$2A,$33+$80 ; THEN
+ DEFB $39,$34+$80 ; TO
+ DEFB $38,$39,$2A,$35+$80 ; STEP
+ DEFB $31,$35,$37,$2E,$33,$39+$80 ; LPRINT
+ DEFB $31,$31,$2E,$38,$39+$80 ; LLIST
+ DEFB $38,$39,$34,$35+$80 ; STOP
+ DEFB $38,$31,$34,$3C+$80 ; SLOW
+ DEFB $2B,$26,$38,$39+$80 ; FAST
+ DEFB $33,$2A,$3C+$80 ; NEW
+ DEFB $38,$28,$37,$34,$31,$31+$80 ; SCROLL
+ DEFB $28,$34,$33,$39+$80 ; CONT
+ DEFB $29,$2E,$32+$80 ; DIM
+ DEFB $37,$2A,$32+$80 ; REM
+ DEFB $2B,$34,$37+$80 ; FOR
+ DEFB $2C,$34,$39,$34+$80 ; GOTO
+ DEFB $2C,$34,$38,$3A,$27+$80 ; GOSUB
+ DEFB $2E,$33,$35,$3A,$39+$80 ; INPUT
+ DEFB $31,$34,$26,$29+$80 ; LOAD
+ DEFB $31,$2E,$38,$39+$80 ; LIST
+ DEFB $31,$2A,$39+$80 ; LET
+ DEFB $35,$26,$3A,$38,$2A+$80 ; PAUSE
+ DEFB $33,$2A,$3D,$39+$80 ; NEXT
+ DEFB $35,$34,$30,$2A+$80 ; POKE
+ DEFB $35,$37,$2E,$33,$39+$80 ; PRINT
+ DEFB $35,$31,$34,$39+$80 ; PLOT
+ DEFB $37,$3A,$33+$80 ; RUN
+ DEFB $38,$26,$3B,$2A+$80 ; SAVE
+ DEFB $37,$26,$33,$29+$80 ; RAND
+ DEFB $2E,$2B+$80 ; IF
+ DEFB $28,$31,$38+$80 ; CLS
+ DEFB $3A,$33,$35,$31,$34,$39+$80 ; UNPLOT
+ DEFB $28,$31,$2A,$26,$37+$80 ; CLEAR
+ DEFB $37,$2A,$39,$3A,$37,$33+$80 ; RETURN
+ DEFB $28,$34,$35,$3E+$80 ; COPY
+ DEFB $37,$33,$29+$80 ; RND
+ DEFB $2E,$33,$30,$2A,$3E,$0D+$80 ; INKEY$
+ DEFB $35,$2E+$80 ; PI
+
+
+; ------------------------------
+; THE 'LOAD-SAVE UPDATE' ROUTINE
+; ------------------------------
+;
+;
+
+;; LOAD/SAVE
+L01FC: INC HL ;
+ EX DE,HL ;
+ LD HL,($4014) ; system variable edit line E_LINE.
+ SCF ; set carry flag
+ SBC HL,DE ;
+ EX DE,HL ;
+ RET NC ; return if more bytes to load/save.
+
+ POP HL ; else drop return address
+
+; ----------------------
+; THE 'DISPLAY' ROUTINES
+; ----------------------
+;
+;
+
+;; SLOW/FAST
+L0207: LD HL,$403B ; Address the system variable CDFLAG.
+ LD A,(HL) ; Load value to the accumulator.
+ RLA ; rotate bit 6 to position 7.
+ XOR (HL) ; exclusive or with original bit 7.
+ RLA ; rotate result out to carry.
+ RET NC ; return if both bits were the same.
+
+; Now test if this really is a ZX81 or a ZX80 running the upgraded ROM.
+; The standard ZX80 did not have an NMI generator.
+
+ LD A,$7F ; Load accumulator with %011111111
+ EX AF,AF' ; save in AF'
+
+ LD B,$11 ; A counter within which an NMI should occur
+ ; if this is a ZX81.
+ OUT ($FE),A ; start the NMI generator.
+
+; Note that if this is a ZX81 then the NMI will increment AF'.
+
+;; LOOP-11
+L0216: DJNZ L0216 ; self loop to give the NMI a chance to kick in.
+ ; = 16*13 clock cycles + 8 = 216 clock cycles.
+
+ OUT ($FD),A ; Turn off the NMI generator.
+ EX AF,AF' ; bring back the AF' value.
+ RLA ; test bit 7.
+ JR NC,L0226 ; forward, if bit 7 is still reset, to NO-SLOW.
+
+; If the AF' was incremented then the NMI generator works and SLOW mode can
+; be set.
+
+ SET 7,(HL) ; Indicate SLOW mode - Compute and Display.
+
+ PUSH AF ; * Save Main Registers
+ PUSH BC ; **
+ PUSH DE ; ***
+ PUSH HL ; ****
+
+ JR L0229 ; skip forward - to DISPLAY-1.
+
+; ---
+
+;; NO-SLOW
+L0226: RES 6,(HL) ; reset bit 6 of CDFLAG.
+ RET ; return.
+
+; -----------------------
+; THE 'MAIN DISPLAY' LOOP
+; -----------------------
+; This routine is executed once for every frame displayed.
+
+;; DISPLAY-1
+L0229: LD HL,($4034) ; fetch two-byte system variable FRAMES.
+ DEC HL ; decrement frames counter.
+
+;; DISPLAY-P
+L022D: LD A,$7F ; prepare a mask
+ AND H ; pick up bits 6-0 of H.
+ OR L ; and any bits of L.
+ LD A,H ; reload A with all bits of H for PAUSE test.
+
+; Note both branches must take the same time.
+
+ JR NZ,L0237 ; (12/7) forward if bits 14-0 are not zero
+ ; to ANOTHER
+
+ RLA ; (4) test bit 15 of FRAMES.
+ JR L0239 ; (12) forward with result to OVER-NC
+
+; ---
+
+;; ANOTHER
+L0237: LD B,(HL) ; (7) Note. Harmless Nonsensical Timing weight.
+ SCF ; (4) Set Carry Flag.
+
+; Note. the branch to here takes either (12)(7)(4) cyles or (7)(4)(12) cycles.
+
+;; OVER-NC
+L0239: LD H,A ; (4) set H to zero
+ LD ($4034),HL ; (16) update system variable FRAMES
+ RET NC ; (11/5) return if FRAMES is in use by PAUSE
+ ; command.
+
+;; DISPLAY-2
+L023E: CALL L02BB ; routine KEYBOARD gets the key row in H and
+ ; the column in L. Reading the ports also starts
+ ; the TV frame synchronization pulse. (VSYNC)
+
+ LD BC,($4025) ; fetch the last key values read from LAST_K
+ LD ($4025),HL ; update LAST_K with new values.
+
+ LD A,B ; load A with previous column - will be $FF if
+ ; there was no key.
+ ADD A,$02 ; adding two will set carry if no previous key.
+
+ SBC HL,BC ; subtract with the carry the two key values.
+
+; If the same key value has been returned twice then HL will be zero.
+
+ LD A,($4027) ; fetch system variable DEBOUNCE
+ OR H ; and OR with both bytes of the difference
+ OR L ; setting the zero flag for the upcoming branch.
+
+ LD E,B ; transfer the column value to E
+ LD B,$0B ; and load B with eleven
+
+ LD HL,$403B ; address system variable CDFLAG
+ RES 0,(HL) ; reset the rightmost bit of CDFLAG
+ JR NZ,L0264 ; skip forward if debounce/diff >0 to NO-KEY
+
+ BIT 7,(HL) ; test compute and display bit of CDFLAG
+ SET 0,(HL) ; set the rightmost bit of CDFLAG.
+ RET Z ; return if bit 7 indicated fast mode.
+
+ DEC B ; (4) decrement the counter.
+ NOP ; (4) Timing - 4 clock cycles. ??
+ SCF ; (4) Set Carry Flag
+
+;; NO-KEY
+L0264: LD HL,$4027 ; sv DEBOUNCE
+ CCF ; Complement Carry Flag
+ RL B ; rotate left B picking up carry
+ ; C<-76543210<-C
+
+;; LOOP-B
+L026A: DJNZ L026A ; self-loop while B>0 to LOOP-B
+
+ LD B,(HL) ; fetch value of DEBOUNCE to B
+ LD A,E ; transfer column value
+ CP $FE ;
+ SBC A,A ;
+ LD B,$1F ;
+ OR (HL) ;
+ AND B ;
+ RRA ;
+ LD (HL),A ;
+
+ OUT ($FF),A ; end the TV frame synchronization pulse.
+
+ LD HL,($400C) ; (12) set HL to the Display File from D_FILE
+ SET 7,H ; (8) set bit 15 to address the echo display.
+
+ CALL L0292 ; (17) routine DISPLAY-3 displays the top set
+ ; of blank lines.
+
+; ---------------------
+; THE 'VIDEO-1' ROUTINE
+; ---------------------
+
+;; R-IX-1
+L0281: LD A,R ; (9) Harmless Nonsensical Timing or something
+ ; very clever?
+ LD BC,$1901 ; (10) 25 lines, 1 scanline in first.
+ LD A,$F5 ; (7) This value will be loaded into R and
+ ; ensures that the cycle starts at the right
+ ; part of the display - after 32nd character
+ ; position.
+
+ CALL L02B5 ; (17) routine DISPLAY-5 completes the current
+ ; blank line and then generates the display of
+ ; the live picture using INT interrupts
+ ; The final interrupt returns to the next
+ ; address.
+
+L028B: DEC HL ; point HL to the last NEWLINE/HALT.
+
+ CALL L0292 ; routine DISPLAY-3 displays the bottom set of
+ ; blank lines.
+
+; ---
+
+;; R-IX-2
+L028F: JP L0229 ; JUMP back to DISPLAY-1
+
+; ---------------------------------
+; THE 'DISPLAY BLANK LINES' ROUTINE
+; ---------------------------------
+; This subroutine is called twice (see above) to generate first the blank
+; lines at the top of the television display and then the blank lines at the
+; bottom of the display.
+
+;; DISPLAY-3
+L0292: POP IX ; pop the return address to IX register.
+ ; will be either L0281 or L028F - see above.
+
+ LD C,(IY+$28) ; load C with value of system constant MARGIN.
+ BIT 7,(IY+$3B) ; test CDFLAG for compute and display.
+ JR Z,L02A9 ; forward, with FAST mode, to DISPLAY-4
+
+ LD A,C ; move MARGIN to A - 31d or 55d.
+ NEG ; Negate
+ INC A ;
+ EX AF,AF' ; place negative count of blank lines in A'
+
+ OUT ($FE),A ; enable the NMI generator.
+
+ POP HL ; ****
+ POP DE ; ***
+ POP BC ; **
+ POP AF ; * Restore Main Registers
+
+ RET ; return - end of interrupt. Return is to
+ ; user's program - BASIC or machine code.
+ ; which will be interrupted by every NMI.
+
+; ------------------------
+; THE 'FAST MODE' ROUTINES
+; ------------------------
+
+;; DISPLAY-4
+L02A9: LD A,$FC ; (7) load A with first R delay value
+ LD B,$01 ; (7) one row only.
+
+ CALL L02B5 ; (17) routine DISPLAY-5
+
+ DEC HL ; (6) point back to the HALT.
+ EX (SP),HL ; (19) Harmless Nonsensical Timing if paired.
+ EX (SP),HL ; (19) Harmless Nonsensical Timing.
+ JP (IX) ; (8) to L0281 or L028F
+
+; --------------------------
+; THE 'DISPLAY-5' SUBROUTINE
+; --------------------------
+; This subroutine is called from SLOW mode and FAST mode to generate the
+; central TV picture. With SLOW mode the R register is incremented, with
+; each instruction, to $F7 by the time it completes. With fast mode, the
+; final R value will be $FF and an interrupt will occur as soon as the
+; Program Counter reaches the HALT. (24 clock cycles)
+
+;; DISPLAY-5
+L02B5: LD R,A ; (9) Load R from A. R = slow: $F5 fast: $FC
+ LD A,$DD ; (7) load future R value. $F6 $FD
+
+ EI ; (4) Enable Interrupts $F7 $FE
+
+ JP (HL) ; (4) jump to the echo display. $F8 $FF
+
+; ----------------------------------
+; THE 'KEYBOARD SCANNING' SUBROUTINE
+; ----------------------------------
+; The keyboard is read during the vertical sync interval while no video is
+; being displayed. Reading a port with address bit 0 low i.e. $FE starts the
+; vertical sync pulse.
+
+;; KEYBOARD
+L02BB: LD HL,$FFFF ; (16) prepare a buffer to take key.
+ LD BC,$FEFE ; (20) set BC to port $FEFE. The B register,
+ ; with its single reset bit also acts as
+ ; an 8-counter.
+ IN A,(C) ; (11) read the port - all 16 bits are put on
+ ; the address bus. Start VSYNC pulse.
+ OR $01 ; (7) set the rightmost bit so as to ignore
+ ; the SHIFT key.
+
+;; EACH-LINE
+L02C5: OR $E0 ; [7] OR %11100000
+ LD D,A ; [4] transfer to D.
+ CPL ; [4] complement - only bits 4-0 meaningful now.
+ CP $01 ; [7] sets carry if A is zero.
+ SBC A,A ; [4] $FF if $00 else zero.
+ OR B ; [7] $FF or port FE,FD,FB....
+ AND L ; [4] unless more than one key, L will still be
+ ; $FF. if more than one key is pressed then A is
+ ; now invalid.
+ LD L,A ; [4] transfer to L.
+
+; now consider the column identifier.
+
+ LD A,H ; [4] will be $FF if no previous keys.
+ AND D ; [4] 111xxxxx
+ LD H,A ; [4] transfer A to H
+
+; since only one key may be pressed, H will, if valid, be one of
+; 11111110, 11111101, 11111011, 11110111, 11101111
+; reading from the outer column, say Q, to the inner column, say T.
+
+ RLC B ; [8] rotate the 8-counter/port address.
+ ; sets carry if more to do.
+ IN A,(C) ; [10] read another half-row.
+ ; all five bits this time.
+
+ JR C,L02C5 ; [12](7) loop back, until done, to EACH-LINE
+
+; The last row read is SHIFT,Z,X,C,V for the second time.
+
+ RRA ; (4) test the shift key - carry will be reset
+ ; if the key is pressed.
+ RL H ; (8) rotate left H picking up the carry giving
+ ; column values -
+ ; $FD, $FB, $F7, $EF, $DF.
+ ; or $FC, $FA, $F6, $EE, $DE if shifted.
+
+; We now have H identifying the column and L identifying the row in the
+; keyboard matrix.
+
+; This is a good time to test if this is an American or British machine.
+; The US machine has an extra diode that causes bit 6 of a byte read from
+; a port to be reset.
+
+ RLA ; (4) compensate for the shift test.
+ RLA ; (4) rotate bit 7 out.
+ RLA ; (4) test bit 6.
+
+ SBC A,A ; (4) $FF or $00 {USA}
+ AND $18 ; (7) $18 or $00
+ ADD A,$1F ; (7) $37 or $1F
+
+; result is either 31 (USA) or 55 (UK) blank lines above and below the TV
+; picture.
+
+ LD ($4028),A ; (13) update system variable MARGIN
+
+ RET ; (10) return
+
+; ------------------------------
+; THE 'SET FAST MODE' SUBROUTINE
+; ------------------------------
+;
+;
+
+;; SET-FAST
+L02E7: BIT 7,(IY+$3B) ; sv CDFLAG
+ RET Z ;
+
+ HALT ; Wait for Interrupt
+ OUT ($FD),A ;
+ RES 7,(IY+$3B) ; sv CDFLAG
+ RET ; return.
+
+
+; --------------
+; THE 'REPORT-F'
+; --------------
+
+;; REPORT-F
+L02F4: RST 08H ; ERROR-1
+ DEFB $0E ; Error Report: No Program Name supplied.
+
+; --------------------------
+; THE 'SAVE COMMAND' ROUTINE
+; --------------------------
+;
+;
+
+;; SAVE
+L02F6: CALL L03A8 ; routine NAME
+ JR C,L02F4 ; back with null name to REPORT-F above.
+
+ EX DE,HL ;
+ LD DE,$12CB ; five seconds timing value
+
+;; HEADER
+L02FF: CALL L0F46 ; routine BREAK-1
+ JR NC,L0332 ; to BREAK-2
+
+;; DELAY-1
+L0304: DJNZ L0304 ; to DELAY-1
+
+ DEC DE ;
+ LD A,D ;
+ OR E ;
+ JR NZ,L02FF ; back for delay to HEADER
+
+;; OUT-NAME
+L030B: CALL L031E ; routine OUT-BYTE
+ BIT 7,(HL) ; test for inverted bit.
+ INC HL ; address next character of name.
+ JR Z,L030B ; back if not inverted to OUT-NAME
+
+; now start saving the system variables onwards.
+
+ LD HL,$4009 ; set start of area to VERSN thereby
+ ; preserving RAMTOP etc.
+
+;; OUT-PROG
+L0316: CALL L031E ; routine OUT-BYTE
+
+ CALL L01FC ; routine LOAD/SAVE >>
+ JR L0316 ; loop back to OUT-PROG
+
+; -------------------------
+; THE 'OUT-BYTE' SUBROUTINE
+; -------------------------
+; This subroutine outputs a byte a bit at a time to a domestic tape recorder.
+
+;; OUT-BYTE
+L031E: LD E,(HL) ; fetch byte to be saved.
+ SCF ; set carry flag - as a marker.
+
+;; EACH-BIT
+L0320: RL E ; C < 76543210 < C
+ RET Z ; return when the marker bit has passed
+ ; right through. >>
+
+ SBC A,A ; $FF if set bit or $00 with no carry.
+ AND $05 ; $05 $00
+ ADD A,$04 ; $09 $04
+ LD C,A ; transfer timer to C. a set bit has a longer
+ ; pulse than a reset bit.
+
+;; PULSES
+L0329: OUT ($FF),A ; pulse to cassette.
+ LD B,$23 ; set timing constant
+
+;; DELAY-2
+L032D: DJNZ L032D ; self-loop to DELAY-2
+
+ CALL L0F46 ; routine BREAK-1 test for BREAK key.
+
+;; BREAK-2
+L0332: JR NC,L03A6 ; forward with break to REPORT-D
+
+ LD B,$1E ; set timing value.
+
+;; DELAY-3
+L0336: DJNZ L0336 ; self-loop to DELAY-3
+
+ DEC C ; decrement counter
+ JR NZ,L0329 ; loop back to PULSES
+
+;; DELAY-4
+L033B: AND A ; clear carry for next bit test.
+ DJNZ L033B ; self loop to DELAY-4 (B is zero - 256)
+
+ JR L0320 ; loop back to EACH-BIT
+
+; --------------------------
+; THE 'LOAD COMMAND' ROUTINE
+; --------------------------
+;
+;
+
+;; LOAD
+L0340: CALL L03A8 ; routine NAME
+
+; DE points to start of name in RAM.
+
+ RL D ; pick up carry
+ RRC D ; carry now in bit 7.
+
+;; NEXT-PROG
+L0347: CALL L034C ; routine IN-BYTE
+ JR L0347 ; loop to NEXT-PROG
+
+; ------------------------
+; THE 'IN-BYTE' SUBROUTINE
+; ------------------------
+
+;; IN-BYTE
+L034C: LD C,$01 ; prepare an eight counter 00000001.
+
+;; NEXT-BIT
+L034E: LD B,$00 ; set counter to 256
+
+;; BREAK-3
+L0350: LD A,$7F ; read the keyboard row
+ IN A,($FE) ; with the SPACE key.
+
+ OUT ($FF),A ; output signal to screen.
+
+ RRA ; test for SPACE pressed.
+ JR NC,L03A2 ; forward if so to BREAK-4
+
+ RLA ; reverse above rotation
+ RLA ; test tape bit.
+ JR C,L0385 ; forward if set to GET-BIT
+
+ DJNZ L0350 ; loop back to BREAK-3
+
+ POP AF ; drop the return address.
+ CP D ; ugh.
+
+;; RESTART
+L0361: JP NC,L03E5 ; jump forward to INITIAL if D is zero
+ ; to reset the system
+ ; if the tape signal has timed out for example
+ ; if the tape is stopped. Not just a simple
+ ; report as some system variables will have
+ ; been overwritten.
+
+ LD H,D ; else transfer the start of name
+ LD L,E ; to the HL register
+
+;; IN-NAME
+L0366: CALL L034C ; routine IN-BYTE is sort of recursion for name
+ ; part. received byte in C.
+ BIT 7,D ; is name the null string ?
+ LD A,C ; transfer byte to A.
+ JR NZ,L0371 ; forward with null string to MATCHING
+
+ CP (HL) ; else compare with string in memory.
+ JR NZ,L0347 ; back with mis-match to NEXT-PROG
+ ; (seemingly out of subroutine but return
+ ; address has been dropped).
+
+
+;; MATCHING
+L0371: INC HL ; address next character of name
+ RLA ; test for inverted bit.
+ JR NC,L0366 ; back if not to IN-NAME
+
+; the name has been matched in full.
+; proceed to load the data but first increment the high byte of E_LINE, which
+; is one of the system variables to be loaded in. Since the low byte is loaded
+; before the high byte, it is possible that, at the in-between stage, a false
+; value could cause the load to end prematurely - see LOAD/SAVE check.
+
+ INC (IY+$15) ; increment system variable E_LINE_hi.
+ LD HL,$4009 ; start loading at system variable VERSN.
+
+;; IN-PROG
+L037B: LD D,B ; set D to zero as indicator.
+ CALL L034C ; routine IN-BYTE loads a byte
+ LD (HL),C ; insert assembled byte in memory.
+ CALL L01FC ; routine LOAD/SAVE >>
+ JR L037B ; loop back to IN-PROG
+
+; ---
+
+; this branch assembles a full byte before exiting normally
+; from the IN-BYTE subroutine.
+
+;; GET-BIT
+L0385: PUSH DE ; save the
+ LD E,$94 ; timing value.
+
+;; TRAILER
+L0388: LD B,$1A ; counter to twenty six.
+
+;; COUNTER
+L038A: DEC E ; decrement the measuring timer.
+ IN A,($FE) ; read the
+ RLA ;
+ BIT 7,E ;
+ LD A,E ;
+ JR C,L0388 ; loop back with carry to TRAILER
+
+ DJNZ L038A ; to COUNTER
+
+ POP DE ;
+ JR NZ,L039C ; to BIT-DONE
+
+ CP $56 ;
+ JR NC,L034E ; to NEXT-BIT
+
+;; BIT-DONE
+L039C: CCF ; complement carry flag
+ RL C ;
+ JR NC,L034E ; to NEXT-BIT
+
+ RET ; return with full byte.
+
+; ---
+
+; if break is pressed while loading data then perform a reset.
+; if break pressed while waiting for program on tape then OK to break.
+
+;; BREAK-4
+L03A2: LD A,D ; transfer indicator to A.
+ AND A ; test for zero.
+ JR Z,L0361 ; back if so to RESTART
+
+
+;; REPORT-D
+L03A6: RST 08H ; ERROR-1
+ DEFB $0C ; Error Report: BREAK - CONT repeats
+
+; -----------------------------
+; THE 'PROGRAM NAME' SUBROUTINE
+; -----------------------------
+;
+;
+
+;; NAME
+L03A8: CALL L0F55 ; routine SCANNING
+ LD A,($4001) ; sv FLAGS
+ ADD A,A ;
+ JP M,L0D9A ; to REPORT-C
+
+ POP HL ;
+ RET NC ;
+
+ PUSH HL ;
+ CALL L02E7 ; routine SET-FAST
+ CALL L13F8 ; routine STK-FETCH
+ LD H,D ;
+ LD L,E ;
+ DEC C ;
+ RET M ;
+
+ ADD HL,BC ;
+ SET 7,(HL) ;
+ RET ;
+
+; -------------------------
+; THE 'NEW' COMMAND ROUTINE
+; -------------------------
+;
+;
+
+;; NEW
+L03C3: CALL L02E7 ; routine SET-FAST
+ LD BC,($4004) ; fetch value of system variable RAMTOP
+ DEC BC ; point to last system byte.
+
+; -----------------------
+; THE 'RAM CHECK' ROUTINE
+; -----------------------
+;
+;
+
+;; RAM-CHECK
+L03CB: LD H,B ;
+ LD L,C ;
+ LD A,$3F ;
+
+;; RAM-FILL
+L03CF: LD (HL),$02 ;
+ DEC HL ;
+ CP H ;
+ JR NZ,L03CF ; to RAM-FILL
+
+;; RAM-READ
+L03D5: AND A ;
+ SBC HL,BC ;
+ ADD HL,BC ;
+ INC HL ;
+ JR NC,L03E2 ; to SET-TOP
+
+ DEC (HL) ;
+ JR Z,L03E2 ; to SET-TOP
+
+ DEC (HL) ;
+ JR Z,L03D5 ; to RAM-READ
+
+;; SET-TOP
+L03E2: LD ($4004),HL ; set system variable RAMTOP to first byte
+ ; above the BASIC system area.
+
+; ----------------------------
+; THE 'INITIALIZATION' ROUTINE
+; ----------------------------
+;
+;
+
+;; INITIAL
+L03E5: LD HL,($4004) ; fetch system variable RAMTOP.
+ DEC HL ; point to last system byte.
+ LD (HL),$3E ; make GO SUB end-marker $3E - too high for
+ ; high order byte of line number.
+ ; (was $3F on ZX80)
+ DEC HL ; point to unimportant low-order byte.
+ LD SP,HL ; and initialize the stack-pointer to this
+ ; location.
+ DEC HL ; point to first location on the machine stack
+ DEC HL ; which will be filled by next CALL/PUSH.
+ LD ($4002),HL ; set the error stack pointer ERR_SP to
+ ; the base of the now empty machine stack.
+
+; Now set the I register so that the video hardware knows where to find the
+; character set. This ROM only uses the character set when printing to
+; the ZX Printer. The TV picture is formed by the external video hardware.
+; Consider also, that this 8K ROM can be retro-fitted to the ZX80 instead of
+; its original 4K ROM so the video hardware could be on the ZX80.
+
+ LD A,$1E ; address for this ROM is $1E00.
+ LD I,A ; set I register from A.
+ IM 1 ; select Z80 Interrupt Mode 1.
+
+ LD IY,$4000 ; set IY to the start of RAM so that the
+ ; system variables can be indexed.
+ LD (IY+$3B),$40 ; set CDFLAG 0100 0000. Bit 6 indicates
+ ; Compute nad Display required.
+
+ LD HL,$407D ; The first location after System Variables -
+ ; 16509 decimal.
+ LD ($400C),HL ; set system variable D_FILE to this value.
+ LD B,$19 ; prepare minimal screen of 24 NEWLINEs
+ ; following an initial NEWLINE.
+
+;; LINE
+L0408: LD (HL),$76 ; insert NEWLINE (HALT instruction)
+ INC HL ; point to next location.
+ DJNZ L0408 ; loop back for all twenty five to LINE
+
+ LD ($4010),HL ; set system variable VARS to next location
+
+ CALL L149A ; routine CLEAR sets $80 end-marker and the
+ ; dynamic memory pointers E_LINE, STKBOT and
+ ; STKEND.
+
+;; N/L-ONLY
+L0413: CALL L14AD ; routine CURSOR-IN inserts the cursor and
+ ; end-marker in the Edit Line also setting
+ ; size of lower display to two lines.
+
+ CALL L0207 ; routine SLOW/FAST selects COMPUTE and DISPLAY
+
+; ---------------------------
+; THE 'BASIC LISTING' SECTION
+; ---------------------------
+;
+;
+
+;; UPPER
+L0419: CALL L0A2A ; routine CLS
+ LD HL,($400A) ; sv E_PPC_lo
+ LD DE,($4023) ; sv S_TOP_lo
+ AND A ;
+ SBC HL,DE ;
+ EX DE,HL ;
+ JR NC,L042D ; to ADDR-TOP
+
+ ADD HL,DE ;
+ LD ($4023),HL ; sv S_TOP_lo
+
+;; ADDR-TOP
+L042D: CALL L09D8 ; routine LINE-ADDR
+ JR Z,L0433 ; to LIST-TOP
+
+ EX DE,HL ;
+
+;; LIST-TOP
+L0433: CALL L073E ; routine LIST-PROG
+ DEC (IY+$1E) ; sv BERG
+ JR NZ,L0472 ; to LOWER
+
+ LD HL,($400A) ; sv E_PPC_lo
+ CALL L09D8 ; routine LINE-ADDR
+ LD HL,($4016) ; sv CH_ADD_lo
+ SCF ; Set Carry Flag
+ SBC HL,DE ;
+ LD HL,$4023 ; sv S_TOP_lo
+ JR NC,L0457 ; to INC-LINE
+
+ EX DE,HL ;
+ LD A,(HL) ;
+ INC HL ;
+ LDI ;
+ LD (DE),A ;
+ JR L0419 ; to UPPER
+
+; ---
+
+;; DOWN-KEY
+L0454: LD HL,$400A ; sv E_PPC_lo
+
+;; INC-LINE
+L0457: LD E,(HL) ;
+ INC HL ;
+ LD D,(HL) ;
+ PUSH HL ;
+ EX DE,HL ;
+ INC HL ;
+ CALL L09D8 ; routine LINE-ADDR
+ CALL L05BB ; routine LINE-NO
+ POP HL ;
+
+;; KEY-INPUT
+L0464: BIT 5,(IY+$2D) ; sv FLAGX
+ JR NZ,L0472 ; forward to LOWER
+
+ LD (HL),D ;
+ DEC HL ;
+ LD (HL),E ;
+ JR L0419 ; to UPPER
+
+; ----------------------------
+; THE 'EDIT LINE COPY' SECTION
+; ----------------------------
+; This routine sets the edit line to just the cursor when
+; 1) There is not enough memory to edit a BASIC line.
+; 2) The edit key is used during input.
+; The entry point LOWER
+
+
+;; EDIT-INP
+L046F: CALL L14AD ; routine CURSOR-IN sets cursor only edit line.
+
+; ->
+
+;; LOWER
+L0472: LD HL,($4014) ; fetch edit line start from E_LINE.
+
+;; EACH-CHAR
+L0475: LD A,(HL) ; fetch a character from edit line.
+ CP $7E ; compare to the number marker.
+ JR NZ,L0482 ; forward if not to END-LINE
+
+ LD BC,$0006 ; else six invisible bytes to be removed.
+ CALL L0A60 ; routine RECLAIM-2
+ JR L0475 ; back to EACH-CHAR
+
+; ---
+
+;; END-LINE
+L0482: CP $76 ;
+ INC HL ;
+ JR NZ,L0475 ; to EACH-CHAR
+
+;; EDIT-LINE
+L0487: CALL L0537 ; routine CURSOR sets cursor K or L.
+
+;; EDIT-ROOM
+L048A: CALL L0A1F ; routine LINE-ENDS
+ LD HL,($4014) ; sv E_LINE_lo
+ LD (IY+$00),$FF ; sv ERR_NR
+ CALL L0766 ; routine COPY-LINE
+ BIT 7,(IY+$00) ; sv ERR_NR
+ JR NZ,L04C1 ; to DISPLAY-6
+
+ LD A,($4022) ; sv DF_SZ
+ CP $18 ;
+ JR NC,L04C1 ; to DISPLAY-6
+
+ INC A ;
+ LD ($4022),A ; sv DF_SZ
+ LD B,A ;
+ LD C,$01 ;
+ CALL L0918 ; routine LOC-ADDR
+ LD D,H ;
+ LD E,L ;
+ LD A,(HL) ;
+
+;; FREE-LINE
+L04B1: DEC HL ;
+ CP (HL) ;
+ JR NZ,L04B1 ; to FREE-LINE
+
+ INC HL ;
+ EX DE,HL ;
+ LD A,($4005) ; sv RAMTOP_hi
+ CP $4D ;
+ CALL C,L0A5D ; routine RECLAIM-1
+ JR L048A ; to EDIT-ROOM
+
+; --------------------------
+; THE 'WAIT FOR KEY' SECTION
+; --------------------------
+;
+;
+
+;; DISPLAY-6
+L04C1: LD HL,$0000 ;
+ LD ($4018),HL ; sv X_PTR_lo
+
+ LD HL,$403B ; system variable CDFLAG
+ BIT 7,(HL) ;
+
+ CALL Z,L0229 ; routine DISPLAY-1
+
+;; SLOW-DISP
+L04CF: BIT 0,(HL) ;
+ JR Z,L04CF ; to SLOW-DISP
+
+ LD BC,($4025) ; sv LAST_K
+ CALL L0F4B ; routine DEBOUNCE
+ CALL L07BD ; routine DECODE
+
+ JR NC,L0472 ; back to LOWER
+
+; -------------------------------
+; THE 'KEYBOARD DECODING' SECTION
+; -------------------------------
+; The decoded key value is in E and HL points to the position in the
+; key table. D contains zero.
+
+;; K-DECODE
+L04DF: LD A,($4006) ; Fetch value of system variable MODE
+ DEC A ; test the three values together
+
+ JP M,L0508 ; forward, if was zero, to FETCH-2
+
+ JR NZ,L04F7 ; forward, if was 2, to FETCH-1
+
+; The original value was one and is now zero.
+
+ LD ($4006),A ; update the system variable MODE
+
+ DEC E ; reduce E to range $00 - $7F
+ LD A,E ; place in A
+ SUB $27 ; subtract 39 setting carry if range 00 - 38
+ JR C,L04F2 ; forward, if so, to FUNC-BASE
+
+ LD E,A ; else set E to reduced value
+
+;; FUNC-BASE
+L04F2: LD HL,L00CC ; address of K-FUNCT table for function keys.
+ JR L0505 ; forward to TABLE-ADD
+
+; ---
+
+;; FETCH-1
+L04F7: LD A,(HL) ;
+ CP $76 ;
+ JR Z,L052B ; to K/L-KEY
+
+ CP $40 ;
+ SET 7,A ;
+ JR C,L051B ; to ENTER
+
+ LD HL,$00C7 ; (expr reqd)
+
+;; TABLE-ADD
+L0505: ADD HL,DE ;
+ JR L0515 ; to FETCH-3
+
+; ---
+
+;; FETCH-2
+L0508: LD A,(HL) ;
+ BIT 2,(IY+$01) ; sv FLAGS - K or L mode ?
+ JR NZ,L0516 ; to TEST-CURS
+
+ ADD A,$C0 ;
+ CP $E6 ;
+ JR NC,L0516 ; to TEST-CURS
+
+;; FETCH-3
+L0515: LD A,(HL) ;
+
+;; TEST-CURS
+L0516: CP $F0 ;
+ JP PE,L052D ; to KEY-SORT
+
+;; ENTER
+L051B: LD E,A ;
+ CALL L0537 ; routine CURSOR
+
+ LD A,E ;
+ CALL L0526 ; routine ADD-CHAR
+
+;; BACK-NEXT
+L0523: JP L0472 ; back to LOWER
+
+; ------------------------------
+; THE 'ADD CHARACTER' SUBROUTINE
+; ------------------------------
+;
+;
+
+;; ADD-CHAR
+L0526: CALL L099B ; routine ONE-SPACE
+ LD (DE),A ;
+ RET ;
+
+; -------------------------
+; THE 'CURSOR KEYS' ROUTINE
+; -------------------------
+;
+;
+
+;; K/L-KEY
+L052B: LD A,$78 ;
+
+;; KEY-SORT
+L052D: LD E,A ;
+ LD HL,$0482 ; base address of ED-KEYS (exp reqd)
+ ADD HL,DE ;
+ ADD HL,DE ;
+ LD C,(HL) ;
+ INC HL ;
+ LD B,(HL) ;
+ PUSH BC ;
+
+;; CURSOR
+L0537: LD HL,($4014) ; sv E_LINE_lo
+ BIT 5,(IY+$2D) ; sv FLAGX
+ JR NZ,L0556 ; to L-MODE
+
+;; K-MODE
+L0540: RES 2,(IY+$01) ; sv FLAGS - Signal use K mode
+
+;; TEST-CHAR
+L0544: LD A,(HL) ;
+ CP $7F ;
+ RET Z ; return
+
+ INC HL ;
+ CALL L07B4 ; routine NUMBER
+ JR Z,L0544 ; to TEST-CHAR
+
+ CP $26 ;
+ JR C,L0544 ; to TEST-CHAR
+
+ CP $DE ;
+ JR Z,L0540 ; to K-MODE
+
+;; L-MODE
+L0556: SET 2,(IY+$01) ; sv FLAGS - Signal use L mode
+ JR L0544 ; to TEST-CHAR
+
+; --------------------------
+; THE 'CLEAR-ONE' SUBROUTINE
+; --------------------------
+;
+;
+
+;; CLEAR-ONE
+L055C: LD BC,$0001 ;
+ JP L0A60 ; to RECLAIM-2
+
+
+
+; ------------------------
+; THE 'EDITING KEYS' TABLE
+; ------------------------
+;
+;
+
+;; ED-KEYS
+L0562: DEFW L059F ; Address: $059F; Address: UP-KEY
+ DEFW L0454 ; Address: $0454; Address: DOWN-KEY
+ DEFW L0576 ; Address: $0576; Address: LEFT-KEY
+ DEFW L057F ; Address: $057F; Address: RIGHT-KEY
+ DEFW L05AF ; Address: $05AF; Address: FUNCTION
+ DEFW L05C4 ; Address: $05C4; Address: EDIT-KEY
+ DEFW L060C ; Address: $060C; Address: N/L-KEY
+ DEFW L058B ; Address: $058B; Address: RUBOUT
+ DEFW L05AF ; Address: $05AF; Address: FUNCTION
+ DEFW L05AF ; Address: $05AF; Address: FUNCTION
+
+
+; -------------------------
+; THE 'CURSOR LEFT' ROUTINE
+; -------------------------
+;
+;
+
+;; LEFT-KEY
+L0576: CALL L0593 ; routine LEFT-EDGE
+ LD A,(HL) ;
+ LD (HL),$7F ;
+ INC HL ;
+ JR L0588 ; to GET-CODE
+
+; --------------------------
+; THE 'CURSOR RIGHT' ROUTINE
+; --------------------------
+;
+;
+
+;; RIGHT-KEY
+L057F: INC HL ;
+ LD A,(HL) ;
+ CP $76 ;
+ JR Z,L059D ; to ENDED-2
+
+ LD (HL),$7F ;
+ DEC HL ;
+
+;; GET-CODE
+L0588: LD (HL),A ;
+
+;; ENDED-1
+L0589: JR L0523 ; to BACK-NEXT
+
+; --------------------
+; THE 'RUBOUT' ROUTINE
+; --------------------
+;
+;
+
+;; RUBOUT
+L058B: CALL L0593 ; routine LEFT-EDGE
+ CALL L055C ; routine CLEAR-ONE
+ JR L0589 ; to ENDED-1
+
+; ------------------------
+; THE 'ED-EDGE' SUBROUTINE
+; ------------------------
+;
+;
+
+;; LEFT-EDGE
+L0593: DEC HL ;
+ LD DE,($4014) ; sv E_LINE_lo
+ LD A,(DE) ;
+ CP $7F ;
+ RET NZ ;
+
+ POP DE ;
+
+;; ENDED-2
+L059D: JR L0589 ; to ENDED-1
+
+; -----------------------
+; THE 'CURSOR UP' ROUTINE
+; -----------------------
+;
+;
+
+;; UP-KEY
+L059F: LD HL,($400A) ; sv E_PPC_lo
+ CALL L09D8 ; routine LINE-ADDR
+ EX DE,HL ;
+ CALL L05BB ; routine LINE-NO
+ LD HL,$400B ; point to system variable E_PPC_hi
+ JP L0464 ; jump back to KEY-INPUT
+
+; --------------------------
+; THE 'FUNCTION KEY' ROUTINE
+; --------------------------
+;
+;
+
+;; FUNCTION
+L05AF: LD A,E ;
+ AND $07 ;
+ LD ($4006),A ; sv MODE
+ JR L059D ; back to ENDED-2
+
+; ------------------------------------
+; THE 'COLLECT LINE NUMBER' SUBROUTINE
+; ------------------------------------
+;
+;
+
+;; ZERO-DE
+L05B7: EX DE,HL ;
+ LD DE,L04C1 + 1 ; $04C2 - a location addressing two zeros.
+
+; ->
+
+;; LINE-NO
+L05BB: LD A,(HL) ;
+ AND $C0 ;
+ JR NZ,L05B7 ; to ZERO-DE
+
+ LD D,(HL) ;
+ INC HL ;
+ LD E,(HL) ;
+ RET ;
+
+; ----------------------
+; THE 'EDIT KEY' ROUTINE
+; ----------------------
+;
+;
+
+;; EDIT-KEY
+L05C4: CALL L0A1F ; routine LINE-ENDS clears lower display.
+
+ LD HL,L046F ; Address: EDIT-INP
+ PUSH HL ; ** is pushed as an error looping address.
+
+ BIT 5,(IY+$2D) ; test FLAGX
+ RET NZ ; indirect jump if in input mode
+ ; to L046F, EDIT-INP (begin again).
+
+;
+
+ LD HL,($4014) ; fetch E_LINE
+ LD ($400E),HL ; and use to update the screen cursor DF_CC
+
+; so now RST $10 will print the line numbers to the edit line instead of screen.
+; first make sure that no newline/out of screen can occur while sprinting the
+; line numbers to the edit line.
+
+ LD HL,$1821 ; prepare line 0, column 0.
+ LD ($4039),HL ; update S_POSN with these dummy values.
+
+ LD HL,($400A) ; fetch current line from E_PPC may be a
+ ; non-existent line e.g. last line deleted.
+ CALL L09D8 ; routine LINE-ADDR gets address or that of
+ ; the following line.
+ CALL L05BB ; routine LINE-NO gets line number if any in DE
+ ; leaving HL pointing at second low byte.
+
+ LD A,D ; test the line number for zero.
+ OR E ;
+ RET Z ; return if no line number - no program to edit.
+
+ DEC HL ; point to high byte.
+ CALL L0AA5 ; routine OUT-NO writes number to edit line.
+
+ INC HL ; point to length bytes.
+ LD C,(HL) ; low byte to C.
+ INC HL ;
+ LD B,(HL) ; high byte to B.
+
+ INC HL ; point to first character in line.
+ LD DE,($400E) ; fetch display file cursor DF_CC
+
+ LD A,$7F ; prepare the cursor character.
+ LD (DE),A ; and insert in edit line.
+ INC DE ; increment intended destination.
+
+ PUSH HL ; * save start of BASIC.
+
+ LD HL,$001D ; set an overhead of 29 bytes.
+ ADD HL,DE ; add in the address of cursor.
+ ADD HL,BC ; add the length of the line.
+ SBC HL,SP ; subtract the stack pointer.
+
+ POP HL ; * restore pointer to start of BASIC.
+
+ RET NC ; return if not enough room to L046F EDIT-INP.
+ ; the edit key appears not to work.
+
+ LDIR ; else copy bytes from program to edit line.
+ ; Note. hidden floating point forms are also
+ ; copied to edit line.
+
+ EX DE,HL ; transfer free location pointer to HL
+
+ POP DE ; ** remove address EDIT-INP from stack.
+
+ CALL L14A6 ; routine SET-STK-B sets STKEND from HL.
+
+ JR L059D ; back to ENDED-2 and after 3 more jumps
+ ; to L0472, LOWER.
+ ; Note. The LOWER routine removes the hidden
+ ; floating-point numbers from the edit line.
+
+; -------------------------
+; THE 'NEWLINE KEY' ROUTINE
+; -------------------------
+;
+;
+
+;; N/L-KEY
+L060C: CALL L0A1F ; routine LINE-ENDS
+
+ LD HL,L0472 ; prepare address: LOWER
+
+ BIT 5,(IY+$2D) ; sv FLAGX
+ JR NZ,L0629 ; to NOW-SCAN
+
+ LD HL,($4014) ; sv E_LINE_lo
+ LD A,(HL) ;
+ CP $FF ;
+ JR Z,L0626 ; to STK-UPPER
+
+ CALL L08E2 ; routine CLEAR-PRB
+ CALL L0A2A ; routine CLS
+
+;; STK-UPPER
+L0626: LD HL,L0419 ; Address: UPPER
+
+;; NOW-SCAN
+L0629: PUSH HL ; push routine address (LOWER or UPPER).
+ CALL L0CBA ; routine LINE-SCAN
+ POP HL ;
+ CALL L0537 ; routine CURSOR
+ CALL L055C ; routine CLEAR-ONE
+ CALL L0A73 ; routine E-LINE-NO
+ JR NZ,L064E ; to N/L-INP
+
+ LD A,B ;
+ OR C ;
+ JP NZ,L06E0 ; to N/L-LINE
+
+ DEC BC ;
+ DEC BC ;
+ LD ($4007),BC ; sv PPC_lo
+ LD (IY+$22),$02 ; sv DF_SZ
+ LD DE,($400C) ; sv D_FILE_lo
+
+ JR L0661 ; forward to TEST-NULL
+
+; ---
+
+;; N/L-INP
+L064E: CP $76 ;
+ JR Z,L0664 ; to N/L-NULL
+
+ LD BC,($4030) ; sv T_ADDR_lo
+ CALL L0918 ; routine LOC-ADDR
+ LD DE,($4029) ; sv NXTLIN_lo
+ LD (IY+$22),$02 ; sv DF_SZ
+
+;; TEST-NULL
+L0661: RST 18H ; GET-CHAR
+ CP $76 ;
+
+;; N/L-NULL
+L0664: JP Z,L0413 ; to N/L-ONLY
+
+ LD (IY+$01),$80 ; sv FLAGS
+ EX DE,HL ;
+
+;; NEXT-LINE
+L066C: LD ($4029),HL ; sv NXTLIN_lo
+ EX DE,HL ;
+ CALL L004D ; routine TEMP-PTR-2
+ CALL L0CC1 ; routine LINE-RUN
+ RES 1,(IY+$01) ; sv FLAGS - Signal printer not in use
+ LD A,$C0 ;
+ LD (IY+$19),A ; sv X_PTR_lo
+ CALL L14A3 ; routine X-TEMP
+ RES 5,(IY+$2D) ; sv FLAGX
+ BIT 7,(IY+$00) ; sv ERR_NR
+ JR Z,L06AE ; to STOP-LINE
+
+ LD HL,($4029) ; sv NXTLIN_lo
+ AND (HL) ;
+ JR NZ,L06AE ; to STOP-LINE
+
+ LD D,(HL) ;
+ INC HL ;
+ LD E,(HL) ;
+ LD ($4007),DE ; sv PPC_lo
+ INC HL ;
+ LD E,(HL) ;
+ INC HL ;
+ LD D,(HL) ;
+ INC HL ;
+ EX DE,HL ;
+ ADD HL,DE ;
+ CALL L0F46 ; routine BREAK-1
+ JR C,L066C ; to NEXT-LINE
+
+ LD HL,$4000 ; sv ERR_NR
+ BIT 7,(HL) ;
+ JR Z,L06AE ; to STOP-LINE
+
+ LD (HL),$0C ;
+
+;; STOP-LINE
+L06AE: BIT 7,(IY+$38) ; sv PR_CC
+ CALL Z,L0871 ; routine COPY-BUFF
+ LD BC,$0121 ;
+ CALL L0918 ; routine LOC-ADDR
+ LD A,($4000) ; sv ERR_NR
+ LD BC,($4007) ; sv PPC_lo
+ INC A ;
+ JR Z,L06D1 ; to REPORT
+
+ CP $09 ;
+ JR NZ,L06CA ; to CONTINUE
+
+ INC BC ;
+
+;; CONTINUE
+L06CA: LD ($402B),BC ; sv OLDPPC_lo
+ JR NZ,L06D1 ; to REPORT
+
+ DEC BC ;
+
+;; REPORT
+L06D1: CALL L07EB ; routine OUT-CODE
+ LD A,$18 ;
+
+ RST 10H ; PRINT-A
+ CALL L0A98 ; routine OUT-NUM
+ CALL L14AD ; routine CURSOR-IN
+ JP L04C1 ; to DISPLAY-6
+
+; ---
+
+;; N/L-LINE
+L06E0: LD ($400A),BC ; sv E_PPC_lo
+ LD HL,($4016) ; sv CH_ADD_lo
+ EX DE,HL ;
+ LD HL,L0413 ; Address: N/L-ONLY
+ PUSH HL ;
+ LD HL,($401A) ; sv STKBOT_lo
+ SBC HL,DE ;
+ PUSH HL ;
+ PUSH BC ;
+ CALL L02E7 ; routine SET-FAST
+ CALL L0A2A ; routine CLS
+ POP HL ;
+ CALL L09D8 ; routine LINE-ADDR
+ JR NZ,L0705 ; to COPY-OVER
+
+ CALL L09F2 ; routine NEXT-ONE
+ CALL L0A60 ; routine RECLAIM-2
+
+;; COPY-OVER
+L0705: POP BC ;
+ LD A,C ;
+ DEC A ;
+ OR B ;
+ RET Z ;
+
+ PUSH BC ;
+ INC BC ;
+ INC BC ;
+ INC BC ;
+ INC BC ;
+ DEC HL ;
+ CALL L099E ; routine MAKE-ROOM
+ CALL L0207 ; routine SLOW/FAST
+ POP BC ;
+ PUSH BC ;
+ INC DE ;
+ LD HL,($401A) ; sv STKBOT_lo
+ DEC HL ;
+ LDDR ; copy bytes
+ LD HL,($400A) ; sv E_PPC_lo
+ EX DE,HL ;
+ POP BC ;
+ LD (HL),B ;
+ DEC HL ;
+ LD (HL),C ;
+ DEC HL ;
+ LD (HL),E ;
+ DEC HL ;
+ LD (HL),D ;
+
+ RET ; return.
+
+; ---------------------------------------
+; THE 'LIST' AND 'LLIST' COMMAND ROUTINES
+; ---------------------------------------
+;
+;
+
+;; LLIST
+L072C: SET 1,(IY+$01) ; sv FLAGS - signal printer in use
+
+;; LIST
+L0730: CALL L0EA7 ; routine FIND-INT
+
+ LD A,B ; fetch high byte of user-supplied line number.
+ AND $3F ; and crudely limit to range 1-16383.
+
+ LD H,A ;
+ LD L,C ;
+ LD ($400A),HL ; sv E_PPC_lo
+ CALL L09D8 ; routine LINE-ADDR
+
+;; LIST-PROG
+L073E: LD E,$00 ;
+
+;; UNTIL-END
+L0740: CALL L0745 ; routine OUT-LINE lists one line of BASIC
+ ; making an early return when the screen is
+ ; full or the end of program is reached. >>
+ JR L0740 ; loop back to UNTIL-END
+
+; -----------------------------------
+; THE 'PRINT A BASIC LINE' SUBROUTINE
+; -----------------------------------
+;
+;
+
+;; OUT-LINE
+L0745: LD BC,($400A) ; sv E_PPC_lo
+ CALL L09EA ; routine CP-LINES
+ LD D,$92 ;
+ JR Z,L0755 ; to TEST-END
+
+ LD DE,$0000 ;
+ RL E ;
+
+;; TEST-END
+L0755: LD (IY+$1E),E ; sv BERG
+ LD A,(HL) ;
+ CP $40 ;
+ POP BC ;
+ RET NC ;
+
+ PUSH BC ;
+ CALL L0AA5 ; routine OUT-NO
+ INC HL ;
+ LD A,D ;
+
+ RST 10H ; PRINT-A
+ INC HL ;
+ INC HL ;
+
+;; COPY-LINE
+L0766: LD ($4016),HL ; sv CH_ADD_lo
+ SET 0,(IY+$01) ; sv FLAGS - Suppress leading space
+
+;; MORE-LINE
+L076D: LD BC,($4018) ; sv X_PTR_lo
+ LD HL,($4016) ; sv CH_ADD_lo
+ AND A ;
+ SBC HL,BC ;
+ JR NZ,L077C ; to TEST-NUM
+
+ LD A,$B8 ;
+
+ RST 10H ; PRINT-A
+
+;; TEST-NUM
+L077C: LD HL,($4016) ; sv CH_ADD_lo
+ LD A,(HL) ;
+ INC HL ;
+ CALL L07B4 ; routine NUMBER
+ LD ($4016),HL ; sv CH_ADD_lo
+ JR Z,L076D ; to MORE-LINE
+
+ CP $7F ;
+ JR Z,L079D ; to OUT-CURS
+
+ CP $76 ;
+ JR Z,L07EE ; to OUT-CH
+
+ BIT 6,A ;
+ JR Z,L079A ; to NOT-TOKEN
+
+ CALL L094B ; routine TOKENS
+ JR L076D ; to MORE-LINE
+
+; ---
+
+
+;; NOT-TOKEN
+L079A: RST 10H ; PRINT-A
+ JR L076D ; to MORE-LINE
+
+; ---
+
+;; OUT-CURS
+L079D: LD A,($4006) ; Fetch value of system variable MODE
+ LD B,$AB ; Prepare an inverse [F] for function cursor.
+
+ AND A ; Test for zero -
+ JR NZ,L07AA ; forward if not to FLAGS-2
+
+ LD A,($4001) ; Fetch system variable FLAGS.
+ LD B,$B0 ; Prepare an inverse [K] for keyword cursor.
+
+;; FLAGS-2
+L07AA: RRA ; 00000?00 -> 000000?0
+ RRA ; 000000?0 -> 0000000?
+ AND $01 ; 0000000? 0000000x
+
+ ADD A,B ; Possibly [F] -> [G] or [K] -> [L]
+
+ CALL L07F5 ; routine PRINT-SP prints character
+ JR L076D ; back to MORE-LINE
+
+; -----------------------
+; THE 'NUMBER' SUBROUTINE
+; -----------------------
+;
+;
+
+;; NUMBER
+L07B4: CP $7E ;
+ RET NZ ;
+
+ INC HL ;
+ INC HL ;
+ INC HL ;
+ INC HL ;
+ INC HL ;
+ RET ;
+
+; --------------------------------
+; THE 'KEYBOARD DECODE' SUBROUTINE
+; --------------------------------
+;
+;
+
+;; DECODE
+L07BD: LD D,$00 ;
+ SRA B ;
+ SBC A,A ;
+ OR $26 ;
+ LD L,$05 ;
+ SUB L ;
+
+;; KEY-LINE
+L07C7: ADD A,L ;
+ SCF ; Set Carry Flag
+ RR C ;
+ JR C,L07C7 ; to KEY-LINE
+
+ INC C ;
+ RET NZ ;
+
+ LD C,B ;
+ DEC L ;
+ LD L,$01 ;
+ JR NZ,L07C7 ; to KEY-LINE
+
+ LD HL,$007D ; (expr reqd)
+ LD E,A ;
+ ADD HL,DE ;
+ SCF ; Set Carry Flag
+ RET ;
+
+; -------------------------
+; THE 'PRINTING' SUBROUTINE
+; -------------------------
+;
+;
+
+;; LEAD-SP
+L07DC: LD A,E ;
+ AND A ;
+ RET M ;
+
+ JR L07F1 ; to PRINT-CH
+
+; ---
+
+;; OUT-DIGIT
+L07E1: XOR A ;
+
+;; DIGIT-INC
+L07E2: ADD HL,BC ;
+ INC A ;
+ JR C,L07E2 ; to DIGIT-INC
+
+ SBC HL,BC ;
+ DEC A ;
+ JR Z,L07DC ; to LEAD-SP
+
+;; OUT-CODE
+L07EB: LD E,$1C ;
+ ADD A,E ;
+
+;; OUT-CH
+L07EE: AND A ;
+ JR Z,L07F5 ; to PRINT-SP
+
+;; PRINT-CH
+L07F1: RES 0,(IY+$01) ; update FLAGS - signal leading space permitted
+
+;; PRINT-SP
+L07F5: EXX ;
+ PUSH HL ;
+ BIT 1,(IY+$01) ; test FLAGS - is printer in use ?
+ JR NZ,L0802 ; to LPRINT-A
+
+ CALL L0808 ; routine ENTER-CH
+ JR L0805 ; to PRINT-EXX
+
+; ---
+
+;; LPRINT-A
+L0802: CALL L0851 ; routine LPRINT-CH
+
+;; PRINT-EXX
+L0805: POP HL ;
+ EXX ;
+ RET ;
+
+; ---
+
+;; ENTER-CH
+L0808: LD D,A ;
+ LD BC,($4039) ; sv S_POSN_x
+ LD A,C ;
+ CP $21 ;
+ JR Z,L082C ; to TEST-LOW
+
+;; TEST-N/L
+L0812: LD A,$76 ;
+ CP D ;
+ JR Z,L0847 ; to WRITE-N/L
+
+ LD HL,($400E) ; sv DF_CC_lo
+ CP (HL) ;
+ LD A,D ;
+ JR NZ,L083E ; to WRITE-CH
+
+ DEC C ;
+ JR NZ,L083A ; to EXPAND-1
+
+ INC HL ;
+ LD ($400E),HL ; sv DF_CC_lo
+ LD C,$21 ;
+ DEC B ;
+ LD ($4039),BC ; sv S_POSN_x
+
+;; TEST-LOW
+L082C: LD A,B ;
+ CP (IY+$22) ; sv DF_SZ
+ JR Z,L0835 ; to REPORT-5
+
+ AND A ;
+ JR NZ,L0812 ; to TEST-N/L
+
+;; REPORT-5
+L0835: LD L,$04 ; 'No more room on screen'
+ JP L0058 ; to ERROR-3
+
+; ---
+
+;; EXPAND-1
+L083A: CALL L099B ; routine ONE-SPACE
+ EX DE,HL ;
+
+;; WRITE-CH
+L083E: LD (HL),A ;
+ INC HL ;
+ LD ($400E),HL ; sv DF_CC_lo
+ DEC (IY+$39) ; sv S_POSN_x
+ RET ;
+
+; ---
+
+;; WRITE-N/L
+L0847: LD C,$21 ;
+ DEC B ;
+ SET 0,(IY+$01) ; sv FLAGS - Suppress leading space
+ JP L0918 ; to LOC-ADDR
+
+; --------------------------
+; THE 'LPRINT-CH' SUBROUTINE
+; --------------------------
+; This routine sends a character to the ZX-Printer placing the code for the
+; character in the Printer Buffer.
+; Note. PR-CC contains the low byte of the buffer address. The high order byte
+; is always constant.
+
+
+;; LPRINT-CH
+L0851: CP $76 ; compare to NEWLINE.
+ JR Z,L0871 ; forward if so to COPY-BUFF
+
+ LD C,A ; take a copy of the character in C.
+ LD A,($4038) ; fetch print location from PR_CC
+ AND $7F ; ignore bit 7 to form true position.
+ CP $5C ; compare to 33rd location
+
+ LD L,A ; form low-order byte.
+ LD H,$40 ; the high-order byte is fixed.
+
+ CALL Z,L0871 ; routine COPY-BUFF to send full buffer to
+ ; the printer if first 32 bytes full.
+ ; (this will reset HL to start.)
+
+ LD (HL),C ; place character at location.
+ INC L ; increment - will not cross a 256 boundary.
+ LD (IY+$38),L ; update system variable PR_CC
+ ; automatically resetting bit 7 to show that
+ ; the buffer is not empty.
+ RET ; return.
+
+; --------------------------
+; THE 'COPY' COMMAND ROUTINE
+; --------------------------
+; The full character-mapped screen is copied to the ZX-Printer.
+; All twenty-four text/graphic lines are printed.
+
+;; COPY
+L0869: LD D,$16 ; prepare to copy twenty four text lines.
+ LD HL,($400C) ; set HL to start of display file from D_FILE.
+ INC HL ;
+ JR L0876 ; forward to COPY*D
+
+; ---
+
+; A single character-mapped printer buffer is copied to the ZX-Printer.
+
+;; COPY-BUFF
+L0871: LD D,$01 ; prepare to copy a single text line.
+ LD HL,$403C ; set HL to start of printer buffer PRBUFF.
+
+; both paths converge here.
+
+;; COPY*D
+L0876: CALL L02E7 ; routine SET-FAST
+
+ PUSH BC ; *** preserve BC throughout.
+ ; a pending character may be present
+ ; in C from LPRINT-CH
+
+;; COPY-LOOP
+L087A: PUSH HL ; save first character of line pointer. (*)
+ XOR A ; clear accumulator.
+ LD E,A ; set pixel line count, range 0-7, to zero.
+
+; this inner loop deals with each horizontal pixel line.
+
+;; COPY-TIME
+L087D: OUT ($FB),A ; bit 2 reset starts the printer motor
+ ; with an inactive stylus - bit 7 reset.
+ POP HL ; pick up first character of line pointer (*)
+ ; on inner loop.
+
+;; COPY-BRK
+L0880: CALL L0F46 ; routine BREAK-1
+ JR C,L088A ; forward with no keypress to COPY-CONT
+
+; else A will hold 11111111 0
+
+ RRA ; 0111 1111
+ OUT ($FB),A ; stop ZX printer motor, de-activate stylus.
+
+;; REPORT-D2
+L0888: RST 08H ; ERROR-1
+ DEFB $0C ; Error Report: BREAK - CONT repeats
+
+; ---
+
+;; COPY-CONT
+L088A: IN A,($FB) ; read from printer port.
+ ADD A,A ; test bit 6 and 7
+ JP M,L08DE ; jump forward with no printer to COPY-END
+
+ JR NC,L0880 ; back if stylus not in position to COPY-BRK
+
+ PUSH HL ; save first character of line pointer (*)
+ PUSH DE ; ** preserve character line and pixel line.
+
+ LD A,D ; text line count to A?
+ CP $02 ; sets carry if last line.
+ SBC A,A ; now $FF if last line else zero.
+
+; now cleverly prepare a printer control mask setting bit 2 (later moved to 1)
+; of D to slow printer for the last two pixel lines ( E = 6 and 7)
+
+ AND E ; and with pixel line offset 0-7
+ RLCA ; shift to left.
+ AND E ; and again.
+ LD D,A ; store control mask in D.
+
+;; COPY-NEXT
+L089C: LD C,(HL) ; load character from screen or buffer.
+ LD A,C ; save a copy in C for later inverse test.
+ INC HL ; update pointer for next time.
+ CP $76 ; is character a NEWLINE ?
+ JR Z,L08C7 ; forward, if so, to COPY-N/L
+
+ PUSH HL ; * else preserve the character pointer.
+
+ SLA A ; (?) multiply by two
+ ADD A,A ; multiply by four
+ ADD A,A ; multiply by eight
+
+ LD H,$0F ; load H with half the address of character set.
+ RL H ; now $1E or $1F (with carry)
+ ADD A,E ; add byte offset 0-7
+ LD L,A ; now HL addresses character source byte
+
+ RL C ; test character, setting carry if inverse.
+ SBC A,A ; accumulator now $00 if normal, $FF if inverse.
+
+ XOR (HL) ; combine with bit pattern at end or ROM.
+ LD C,A ; transfer the byte to C.
+ LD B,$08 ; count eight bits to output.
+
+;; COPY-BITS
+L08B5: LD A,D ; fetch speed control mask from D.
+ RLC C ; rotate a bit from output byte to carry.
+ RRA ; pick up in bit 7, speed bit to bit 1
+ LD H,A ; store aligned mask in H register.
+
+;; COPY-WAIT
+L08BA: IN A,($FB) ; read the printer port
+ RRA ; test for alignment signal from encoder.
+ JR NC,L08BA ; loop if not present to COPY-WAIT
+
+ LD A,H ; control byte to A.
+ OUT ($FB),A ; and output to printer port.
+ DJNZ L08B5 ; loop for all eight bits to COPY-BITS
+
+ POP HL ; * restore character pointer.
+ JR L089C ; back for adjacent character line to COPY-NEXT
+
+; ---
+
+; A NEWLINE has been encountered either following a text line or as the
+; first character of the screen or printer line.
+
+;; COPY-N/L
+L08C7: IN A,($FB) ; read printer port.
+ RRA ; wait for encoder signal.
+ JR NC,L08C7 ; loop back if not to COPY-N/L
+
+ LD A,D ; transfer speed mask to A.
+ RRCA ; rotate speed bit to bit 1.
+ ; bit 7, stylus control is reset.
+ OUT ($FB),A ; set the printer speed.
+
+ POP DE ; ** restore character line and pixel line.
+ INC E ; increment pixel line 0-7.
+ BIT 3,E ; test if value eight reached.
+ JR Z,L087D ; back if not to COPY-TIME
+
+; eight pixel lines, a text line have been completed.
+
+ POP BC ; lose the now redundant first character
+ ; pointer
+ DEC D ; decrease text line count.
+ JR NZ,L087A ; back if not zero to COPY-LOOP
+
+ LD A,$04 ; stop the already slowed printer motor.
+ OUT ($FB),A ; output to printer port.
+
+;; COPY-END
+L08DE: CALL L0207 ; routine SLOW/FAST
+ POP BC ; *** restore preserved BC.
+
+; -------------------------------------
+; THE 'CLEAR PRINTER BUFFER' SUBROUTINE
+; -------------------------------------
+; This subroutine sets 32 bytes of the printer buffer to zero (space) and
+; the 33rd character is set to a NEWLINE.
+; This occurs after the printer buffer is sent to the printer but in addition
+; after the 24 lines of the screen are sent to the printer.
+; Note. This is a logic error as the last operation does not involve the
+; buffer at all. Logically one should be able to use
+; 10 LPRINT "HELLO ";
+; 20 COPY
+; 30 LPRINT ; "WORLD"
+; and expect to see the entire greeting emerge from the printer.
+; Surprisingly this logic error was never discovered and although one can argue
+; if the above is a bug, the repetition of this error on the Spectrum was most
+; definitely a bug.
+; Since the printer buffer is fixed at the end of the system variables, and
+; the print position is in the range $3C - $5C, then bit 7 of the system
+; variable is set to show the buffer is empty and automatically reset when
+; the variable is updated with any print position - neat.
+
+;; CLEAR-PRB
+L08E2: LD HL,$405C ; address fixed end of PRBUFF
+ LD (HL),$76 ; place a newline at last position.
+ LD B,$20 ; prepare to blank 32 preceding characters.
+
+;; PRB-BYTES
+L08E9: DEC HL ; decrement address - could be DEC L.
+ LD (HL),$00 ; place a zero byte.
+ DJNZ L08E9 ; loop for all thirty-two to PRB-BYTES
+
+ LD A,L ; fetch character print position.
+ SET 7,A ; signal the printer buffer is clear.
+ LD ($4038),A ; update one-byte system variable PR_CC
+ RET ; return.
+
+; -------------------------
+; THE 'PRINT AT' SUBROUTINE
+; -------------------------
+;
+;
+
+;; PRINT-AT
+L08F5: LD A,$17 ;
+ SUB B ;
+ JR C,L0905 ; to WRONG-VAL
+
+;; TEST-VAL
+L08FA: CP (IY+$22) ; sv DF_SZ
+ JP C,L0835 ; to REPORT-5
+
+ INC A ;
+ LD B,A ;
+ LD A,$1F ;
+ SUB C ;
+
+;; WRONG-VAL
+L0905: JP C,L0EAD ; to REPORT-B
+
+ ADD A,$02 ;
+ LD C,A ;
+
+;; SET-FIELD
+L090B: BIT 1,(IY+$01) ; sv FLAGS - Is printer in use
+ JR Z,L0918 ; to LOC-ADDR
+
+ LD A,$5D ;
+ SUB C ;
+ LD ($4038),A ; sv PR_CC
+ RET ;
+
+; ----------------------------
+; THE 'LOCATE ADDRESS' ROUTINE
+; ----------------------------
+;
+;
+
+;; LOC-ADDR
+L0918: LD ($4039),BC ; sv S_POSN_x
+ LD HL,($4010) ; sv VARS_lo
+ LD D,C ;
+ LD A,$22 ;
+ SUB C ;
+ LD C,A ;
+ LD A,$76 ;
+ INC B ;
+
+;; LOOK-BACK
+L0927: DEC HL ;
+ CP (HL) ;
+ JR NZ,L0927 ; to LOOK-BACK
+
+ DJNZ L0927 ; to LOOK-BACK
+
+ INC HL ;
+ CPIR ;
+ DEC HL ;
+ LD ($400E),HL ; sv DF_CC_lo
+ SCF ; Set Carry Flag
+ RET PO ;
+
+ DEC D ;
+ RET Z ;
+
+ PUSH BC ;
+ CALL L099E ; routine MAKE-ROOM
+ POP BC ;
+ LD B,C ;
+ LD H,D ;
+ LD L,E ;
+
+;; EXPAND-2
+L0940: LD (HL),$00 ;
+ DEC HL ;
+ DJNZ L0940 ; to EXPAND-2
+
+ EX DE,HL ;
+ INC HL ;
+ LD ($400E),HL ; sv DF_CC_lo
+ RET ;
+
+; ------------------------------
+; THE 'EXPAND TOKENS' SUBROUTINE
+; ------------------------------
+;
+;
+
+;; TOKENS
+L094B: PUSH AF ;
+ CALL L0975 ; routine TOKEN-ADD
+ JR NC,L0959 ; to ALL-CHARS
+
+ BIT 0,(IY+$01) ; sv FLAGS - Leading space if set
+ JR NZ,L0959 ; to ALL-CHARS
+
+ XOR A ;
+
+ RST 10H ; PRINT-A
+
+;; ALL-CHARS
+L0959: LD A,(BC) ;
+ AND $3F ;
+
+ RST 10H ; PRINT-A
+ LD A,(BC) ;
+ INC BC ;
+ ADD A,A ;
+ JR NC,L0959 ; to ALL-CHARS
+
+ POP BC ;
+ BIT 7,B ;
+ RET Z ;
+
+ CP $1A ;
+ JR Z,L096D ; to TRAIL-SP
+
+ CP $38 ;
+ RET C ;
+
+;; TRAIL-SP
+L096D: XOR A ;
+ SET 0,(IY+$01) ; sv FLAGS - Suppress leading space
+ JP L07F5 ; to PRINT-SP
+
+; ---
+
+;; TOKEN-ADD
+L0975: PUSH HL ;
+ LD HL,L0111 ; Address of TOKENS
+ BIT 7,A ;
+ JR Z,L097F ; to TEST-HIGH
+
+ AND $3F ;
+
+;; TEST-HIGH
+L097F: CP $43 ;
+ JR NC,L0993 ; to FOUND
+
+ LD B,A ;
+ INC B ;
+
+;; WORDS
+L0985: BIT 7,(HL) ;
+ INC HL ;
+ JR Z,L0985 ; to WORDS
+
+ DJNZ L0985 ; to WORDS
+
+ BIT 6,A ;
+ JR NZ,L0992 ; to COMP-FLAG
+
+ CP $18 ;
+
+;; COMP-FLAG
+L0992: CCF ; Complement Carry Flag
+
+;; FOUND
+L0993: LD B,H ;
+ LD C,L ;
+ POP HL ;
+ RET NC ;
+
+ LD A,(BC) ;
+ ADD A,$E4 ;
+ RET ;
+
+; --------------------------
+; THE 'ONE SPACE' SUBROUTINE
+; --------------------------
+;
+;
+
+;; ONE-SPACE
+L099B: LD BC,$0001 ;
+
+; --------------------------
+; THE 'MAKE ROOM' SUBROUTINE
+; --------------------------
+;
+;
+
+;; MAKE-ROOM
+L099E: PUSH HL ;
+ CALL L0EC5 ; routine TEST-ROOM
+ POP HL ;
+ CALL L09AD ; routine POINTERS
+ LD HL,($401C) ; sv STKEND_lo
+ EX DE,HL ;
+ LDDR ; Copy Bytes
+ RET ;
+
+; -------------------------
+; THE 'POINTERS' SUBROUTINE
+; -------------------------
+;
+;
+
+;; POINTERS
+L09AD: PUSH AF ;
+ PUSH HL ;
+ LD HL,$400C ; sv D_FILE_lo
+ LD A,$09 ;
+
+;; NEXT-PTR
+L09B4: LD E,(HL) ;
+ INC HL ;
+ LD D,(HL) ;
+ EX (SP),HL ;
+ AND A ;
+ SBC HL,DE ;
+ ADD HL,DE ;
+ EX (SP),HL ;
+ JR NC,L09C8 ; to PTR-DONE
+
+ PUSH DE ;
+ EX DE,HL ;
+ ADD HL,BC ;
+ EX DE,HL ;
+ LD (HL),D ;
+ DEC HL ;
+ LD (HL),E ;
+ INC HL ;
+ POP DE ;
+
+;; PTR-DONE
+L09C8: INC HL ;
+ DEC A ;
+ JR NZ,L09B4 ; to NEXT-PTR
+
+ EX DE,HL ;
+ POP DE ;
+ POP AF ;
+ AND A ;
+ SBC HL,DE ;
+ LD B,H ;
+ LD C,L ;
+ INC BC ;
+ ADD HL,DE ;
+ EX DE,HL ;
+ RET ;
+
+; -----------------------------
+; THE 'LINE ADDRESS' SUBROUTINE
+; -----------------------------
+;
+;
+
+;; LINE-ADDR
+L09D8: PUSH HL ;
+ LD HL,$407D ;
+ LD D,H ;
+ LD E,L ;
+
+;; NEXT-TEST
+L09DE: POP BC ;
+ CALL L09EA ; routine CP-LINES
+ RET NC ;
+
+ PUSH BC ;
+ CALL L09F2 ; routine NEXT-ONE
+ EX DE,HL ;
+ JR L09DE ; to NEXT-TEST
+
+; -------------------------------------
+; THE 'COMPARE LINE NUMBERS' SUBROUTINE
+; -------------------------------------
+;
+;
+
+;; CP-LINES
+L09EA: LD A,(HL) ;
+ CP B ;
+ RET NZ ;
+
+ INC HL ;
+ LD A,(HL) ;
+ DEC HL ;
+ CP C ;
+ RET ;
+
+; --------------------------------------
+; THE 'NEXT LINE OR VARIABLE' SUBROUTINE
+; --------------------------------------
+;
+;
+
+;; NEXT-ONE
+L09F2: PUSH HL ;
+ LD A,(HL) ;
+ CP $40 ;
+ JR C,L0A0F ; to LINES
+
+ BIT 5,A ;
+ JR Z,L0A10 ; forward to NEXT-O-4
+
+ ADD A,A ;
+ JP M,L0A01 ; to NEXT+FIVE
+
+ CCF ; Complement Carry Flag
+
+;; NEXT+FIVE
+L0A01: LD BC,$0005 ;
+ JR NC,L0A08 ; to NEXT-LETT
+
+ LD C,$11 ;
+
+;; NEXT-LETT
+L0A08: RLA ;
+ INC HL ;
+ LD A,(HL) ;
+ JR NC,L0A08 ; to NEXT-LETT
+
+ JR L0A15 ; to NEXT-ADD
+
+; ---
+
+;; LINES
+L0A0F: INC HL ;
+
+;; NEXT-O-4
+L0A10: INC HL ;
+ LD C,(HL) ;
+ INC HL ;
+ LD B,(HL) ;
+ INC HL ;
+
+;; NEXT-ADD
+L0A15: ADD HL,BC ;
+ POP DE ;
+
+; ---------------------------
+; THE 'DIFFERENCE' SUBROUTINE
+; ---------------------------
+;
+;
+
+;; DIFFER
+L0A17: AND A ;
+ SBC HL,DE ;
+ LD B,H ;
+ LD C,L ;
+ ADD HL,DE ;
+ EX DE,HL ;
+ RET ;
+
+; --------------------------
+; THE 'LINE-ENDS' SUBROUTINE
+; --------------------------
+;
+;
+
+;; LINE-ENDS
+L0A1F: LD B,(IY+$22) ; sv DF_SZ
+ PUSH BC ;
+ CALL L0A2C ; routine B-LINES
+ POP BC ;
+ DEC B ;
+ JR L0A2C ; to B-LINES
+
+; -------------------------
+; THE 'CLS' COMMAND ROUTINE
+; -------------------------
+;
+;
+
+;; CLS
+L0A2A: LD B,$18 ;
+
+;; B-LINES
+L0A2C: RES 1,(IY+$01) ; sv FLAGS - Signal printer not in use
+ LD C,$21 ;
+ PUSH BC ;
+ CALL L0918 ; routine LOC-ADDR
+ POP BC ;
+ LD A,($4005) ; sv RAMTOP_hi
+ CP $4D ;
+ JR C,L0A52 ; to COLLAPSED
+
+ SET 7,(IY+$3A) ; sv S_POSN_y
+
+;; CLEAR-LOC
+L0A42: XOR A ; prepare a space
+ CALL L07F5 ; routine PRINT-SP prints a space
+ LD HL,($4039) ; sv S_POSN_x
+ LD A,L ;
+ OR H ;
+ AND $7E ;
+ JR NZ,L0A42 ; to CLEAR-LOC
+
+ JP L0918 ; to LOC-ADDR
+
+; ---
+
+;; COLLAPSED
+L0A52: LD D,H ;
+ LD E,L ;
+ DEC HL ;
+ LD C,B ;
+ LD B,$00 ;
+ LDIR ; Copy Bytes
+ LD HL,($4010) ; sv VARS_lo
+
+; ----------------------------
+; THE 'RECLAIMING' SUBROUTINES
+; ----------------------------
+;
+;
+
+;; RECLAIM-1
+L0A5D: CALL L0A17 ; routine DIFFER
+
+;; RECLAIM-2
+L0A60: PUSH BC ;
+ LD A,B ;
+ CPL ;
+ LD B,A ;
+ LD A,C ;
+ CPL ;
+ LD C,A ;
+ INC BC ;
+ CALL L09AD ; routine POINTERS
+ EX DE,HL ;
+ POP HL ;
+ ADD HL,DE ;
+ PUSH DE ;
+ LDIR ; Copy Bytes
+ POP HL ;
+ RET ;
+
+; ------------------------------
+; THE 'E-LINE NUMBER' SUBROUTINE
+; ------------------------------
+;
+;
+
+;; E-LINE-NO
+L0A73: LD HL,($4014) ; sv E_LINE_lo
+ CALL L004D ; routine TEMP-PTR-2
+
+ RST 18H ; GET-CHAR
+ BIT 5,(IY+$2D) ; sv FLAGX
+ RET NZ ;
+
+ LD HL,$405D ; sv MEM-0-1st
+ LD ($401C),HL ; sv STKEND_lo
+ CALL L1548 ; routine INT-TO-FP
+ CALL L158A ; routine FP-TO-BC
+ JR C,L0A91 ; to NO-NUMBER
+
+ LD HL,$D8F0 ; value '-10000'
+ ADD HL,BC ;
+
+;; NO-NUMBER
+L0A91: JP C,L0D9A ; to REPORT-C
+
+ CP A ;
+ JP L14BC ; routine SET-MIN
+
+; -------------------------------------------------
+; THE 'REPORT AND LINE NUMBER' PRINTING SUBROUTINES
+; -------------------------------------------------
+;
+;
+
+;; OUT-NUM
+L0A98: PUSH DE ;
+ PUSH HL ;
+ XOR A ;
+ BIT 7,B ;
+ JR NZ,L0ABF ; to UNITS
+
+ LD H,B ;
+ LD L,C ;
+ LD E,$FF ;
+ JR L0AAD ; to THOUSAND
+
+; ---
+
+;; OUT-NO
+L0AA5: PUSH DE ;
+ LD D,(HL) ;
+ INC HL ;
+ LD E,(HL) ;
+ PUSH HL ;
+ EX DE,HL ;
+ LD E,$00 ; set E to leading space.
+
+;; THOUSAND
+L0AAD: LD BC,$FC18 ;
+ CALL L07E1 ; routine OUT-DIGIT
+ LD BC,$FF9C ;
+ CALL L07E1 ; routine OUT-DIGIT
+ LD C,$F6 ;
+ CALL L07E1 ; routine OUT-DIGIT
+ LD A,L ;
+
+;; UNITS
+L0ABF: CALL L07EB ; routine OUT-CODE
+ POP HL ;
+ POP DE ;
+ RET ;
+
+; --------------------------
+; THE 'UNSTACK-Z' SUBROUTINE
+; --------------------------
+; This subroutine is used to return early from a routine when checking syntax.
+; On the ZX81 the same routines that execute commands also check the syntax
+; on line entry. This enables precise placement of the error marker in a line
+; that fails syntax.
+; The sequence CALL SYNTAX-Z ; RET Z can be replaced by a call to this routine
+; although it has not replaced every occurrence of the above two instructions.
+; Even on the ZX-80 this routine was not fully utilized.
+
+;; UNSTACK-Z
+L0AC5: CALL L0DA6 ; routine SYNTAX-Z resets the ZERO flag if
+ ; checking syntax.
+ POP HL ; drop the return address.
+ RET Z ; return to previous calling routine if
+ ; checking syntax.
+
+ JP (HL) ; else jump to the continuation address in
+ ; the calling routine as RET would have done.
+
+; ----------------------------
+; THE 'LPRINT' COMMAND ROUTINE
+; ----------------------------
+;
+;
+
+;; LPRINT
+L0ACB: SET 1,(IY+$01) ; sv FLAGS - Signal printer in use
+
+; ---------------------------
+; THE 'PRINT' COMMAND ROUTINE
+; ---------------------------
+;
+;
+
+;; PRINT
+L0ACF: LD A,(HL) ;
+ CP $76 ;
+ JP Z,L0B84 ; to PRINT-END
+
+;; PRINT-1
+L0AD5: SUB $1A ;
+ ADC A,$00 ;
+ JR Z,L0B44 ; to SPACING
+
+ CP $A7 ;
+ JR NZ,L0AFA ; to NOT-AT
+
+
+ RST 20H ; NEXT-CHAR
+ CALL L0D92 ; routine CLASS-6
+ CP $1A ;
+ JP NZ,L0D9A ; to REPORT-C
+
+
+ RST 20H ; NEXT-CHAR
+ CALL L0D92 ; routine CLASS-6
+ CALL L0B4E ; routine SYNTAX-ON
+
+ RST 28H ;; FP-CALC
+ DEFB $01 ;;exchange
+ DEFB $34 ;;end-calc
+
+ CALL L0BF5 ; routine STK-TO-BC
+ CALL L08F5 ; routine PRINT-AT
+ JR L0B37 ; to PRINT-ON
+
+; ---
+
+;; NOT-AT
+L0AFA: CP $A8 ;
+ JR NZ,L0B31 ; to NOT-TAB
+
+
+ RST 20H ; NEXT-CHAR
+ CALL L0D92 ; routine CLASS-6
+ CALL L0B4E ; routine SYNTAX-ON
+ CALL L0C02 ; routine STK-TO-A
+ JP NZ,L0EAD ; to REPORT-B
+
+ AND $1F ;
+ LD C,A ;
+ BIT 1,(IY+$01) ; sv FLAGS - Is printer in use
+ JR Z,L0B1E ; to TAB-TEST
+
+ SUB (IY+$38) ; sv PR_CC
+ SET 7,A ;
+ ADD A,$3C ;
+ CALL NC,L0871 ; routine COPY-BUFF
+
+;; TAB-TEST
+L0B1E: ADD A,(IY+$39) ; sv S_POSN_x
+ CP $21 ;
+ LD A,($403A) ; sv S_POSN_y
+ SBC A,$01 ;
+ CALL L08FA ; routine TEST-VAL
+ SET 0,(IY+$01) ; sv FLAGS - Suppress leading space
+ JR L0B37 ; to PRINT-ON
+
+; ---
+
+;; NOT-TAB
+L0B31: CALL L0F55 ; routine SCANNING
+ CALL L0B55 ; routine PRINT-STK
+
+;; PRINT-ON
+L0B37: RST 18H ; GET-CHAR
+ SUB $1A ;
+ ADC A,$00 ;
+ JR Z,L0B44 ; to SPACING
+
+ CALL L0D1D ; routine CHECK-END
+ JP L0B84 ;;; to PRINT-END
+
+; ---
+
+;; SPACING
+L0B44: CALL NC,L0B8B ; routine FIELD
+
+ RST 20H ; NEXT-CHAR
+ CP $76 ;
+ RET Z ;
+
+ JP L0AD5 ;;; to PRINT-1
+
+; ---
+
+;; SYNTAX-ON
+L0B4E: CALL L0DA6 ; routine SYNTAX-Z
+ RET NZ ;
+
+ POP HL ;
+ JR L0B37 ; to PRINT-ON
+
+; ---
+
+;; PRINT-STK
+L0B55: CALL L0AC5 ; routine UNSTACK-Z
+ BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result?
+ CALL Z,L13F8 ; routine STK-FETCH
+ JR Z,L0B6B ; to PR-STR-4
+
+ JP L15DB ; jump forward to PRINT-FP
+
+; ---
+
+;; PR-STR-1
+L0B64: LD A,$0B ;
+
+;; PR-STR-2
+L0B66: RST 10H ; PRINT-A
+
+;; PR-STR-3
+L0B67: LD DE,($4018) ; sv X_PTR_lo
+
+;; PR-STR-4
+L0B6B: LD A,B ;
+ OR C ;
+ DEC BC ;
+ RET Z ;
+
+ LD A,(DE) ;
+ INC DE ;
+ LD ($4018),DE ; sv X_PTR_lo
+ BIT 6,A ;
+ JR Z,L0B66 ; to PR-STR-2
+
+ CP $C0 ;
+ JR Z,L0B64 ; to PR-STR-1
+
+ PUSH BC ;
+ CALL L094B ; routine TOKENS
+ POP BC ;
+ JR L0B67 ; to PR-STR-3
+
+; ---
+
+;; PRINT-END
+L0B84: CALL L0AC5 ; routine UNSTACK-Z
+ LD A,$76 ;
+
+ RST 10H ; PRINT-A
+ RET ;
+
+; ---
+
+;; FIELD
+L0B8B: CALL L0AC5 ; routine UNSTACK-Z
+ SET 0,(IY+$01) ; sv FLAGS - Suppress leading space
+ XOR A ;
+
+ RST 10H ; PRINT-A
+ LD BC,($4039) ; sv S_POSN_x
+ LD A,C ;
+ BIT 1,(IY+$01) ; sv FLAGS - Is printer in use
+ JR Z,L0BA4 ; to CENTRE
+
+ LD A,$5D ;
+ SUB (IY+$38) ; sv PR_CC
+
+;; CENTRE
+L0BA4: LD C,$11 ;
+ CP C ;
+ JR NC,L0BAB ; to RIGHT
+
+ LD C,$01 ;
+
+;; RIGHT
+L0BAB: CALL L090B ; routine SET-FIELD
+ RET ;
+
+; --------------------------------------
+; THE 'PLOT AND UNPLOT' COMMAND ROUTINES
+; --------------------------------------
+;
+;
+
+;; PLOT/UNP
+L0BAF: CALL L0BF5 ; routine STK-TO-BC
+ LD ($4036),BC ; sv COORDS_x
+ LD A,$2B ;
+ SUB B ;
+ JP C,L0EAD ; to REPORT-B
+
+ LD B,A ;
+ LD A,$01 ;
+ SRA B ;
+ JR NC,L0BC5 ; to COLUMNS
+
+ LD A,$04 ;
+
+;; COLUMNS
+L0BC5: SRA C ;
+ JR NC,L0BCA ; to FIND-ADDR
+
+ RLCA ;
+
+;; FIND-ADDR
+L0BCA: PUSH AF ;
+ CALL L08F5 ; routine PRINT-AT
+ LD A,(HL) ;
+ RLCA ;
+ CP $10 ;
+ JR NC,L0BDA ; to TABLE-PTR
+
+ RRCA ;
+ JR NC,L0BD9 ; to SQ-SAVED
+
+ XOR $8F ;
+
+;; SQ-SAVED
+L0BD9: LD B,A ;
+
+;; TABLE-PTR
+L0BDA: LD DE,L0C9E ; Address: P-UNPLOT
+ LD A,($4030) ; sv T_ADDR_lo
+ SUB E ;
+ JP M,L0BE9 ; to PLOT
+
+ POP AF ;
+ CPL ;
+ AND B ;
+ JR L0BEB ; to UNPLOT
+
+; ---
+
+;; PLOT
+L0BE9: POP AF ;
+ OR B ;
+
+;; UNPLOT
+L0BEB: CP $08 ;
+ JR C,L0BF1 ; to PLOT-END
+
+ XOR $8F ;
+
+;; PLOT-END
+L0BF1: EXX ;
+
+ RST 10H ; PRINT-A
+ EXX ;
+ RET ;
+
+; ----------------------------
+; THE 'STACK-TO-BC' SUBROUTINE
+; ----------------------------
+;
+;
+
+;; STK-TO-BC
+L0BF5: CALL L0C02 ; routine STK-TO-A
+ LD B,A ;
+ PUSH BC ;
+ CALL L0C02 ; routine STK-TO-A
+ LD E,C ;
+ POP BC ;
+ LD D,C ;
+ LD C,A ;
+ RET ;
+
+; ---------------------------
+; THE 'STACK-TO-A' SUBROUTINE
+; ---------------------------
+;
+;
+
+;; STK-TO-A
+L0C02: CALL L15CD ; routine FP-TO-A
+ JP C,L0EAD ; to REPORT-B
+
+ LD C,$01 ;
+ RET Z ;
+
+ LD C,$FF ;
+ RET ;
+
+; -----------------------
+; THE 'SCROLL' SUBROUTINE
+; -----------------------
+;
+;
+
+;; SCROLL
+L0C0E: LD B,(IY+$22) ; sv DF_SZ
+ LD C,$21 ;
+ CALL L0918 ; routine LOC-ADDR
+ CALL L099B ; routine ONE-SPACE
+ LD A,(HL) ;
+ LD (DE),A ;
+ INC (IY+$3A) ; sv S_POSN_y
+ LD HL,($400C) ; sv D_FILE_lo
+ INC HL ;
+ LD D,H ;
+ LD E,L ;
+ CPIR ;
+ JP L0A5D ; to RECLAIM-1
+
+; -------------------
+; THE 'SYNTAX' TABLES
+; -------------------
+
+; i) The Offset table
+
+;; offset-t
+L0C29: DEFB L0CB4 - $ ; 8B offset to; Address: P-LPRINT
+ DEFB L0CB7 - $ ; 8D offset to; Address: P-LLIST
+ DEFB L0C58 - $ ; 2D offset to; Address: P-STOP
+ DEFB L0CAB - $ ; 7F offset to; Address: P-SLOW
+ DEFB L0CAE - $ ; 81 offset to; Address: P-FAST
+ DEFB L0C77 - $ ; 49 offset to; Address: P-NEW
+ DEFB L0CA4 - $ ; 75 offset to; Address: P-SCROLL
+ DEFB L0C8F - $ ; 5F offset to; Address: P-CONT
+ DEFB L0C71 - $ ; 40 offset to; Address: P-DIM
+ DEFB L0C74 - $ ; 42 offset to; Address: P-REM
+ DEFB L0C5E - $ ; 2B offset to; Address: P-FOR
+ DEFB L0C4B - $ ; 17 offset to; Address: P-GOTO
+ DEFB L0C54 - $ ; 1F offset to; Address: P-GOSUB
+ DEFB L0C6D - $ ; 37 offset to; Address: P-INPUT
+ DEFB L0C89 - $ ; 52 offset to; Address: P-LOAD
+ DEFB L0C7D - $ ; 45 offset to; Address: P-LIST
+ DEFB L0C48 - $ ; 0F offset to; Address: P-LET
+ DEFB L0CA7 - $ ; 6D offset to; Address: P-PAUSE
+ DEFB L0C66 - $ ; 2B offset to; Address: P-NEXT
+ DEFB L0C80 - $ ; 44 offset to; Address: P-POKE
+ DEFB L0C6A - $ ; 2D offset to; Address: P-PRINT
+ DEFB L0C98 - $ ; 5A offset to; Address: P-PLOT
+ DEFB L0C7A - $ ; 3B offset to; Address: P-RUN
+ DEFB L0C8C - $ ; 4C offset to; Address: P-SAVE
+ DEFB L0C86 - $ ; 45 offset to; Address: P-RAND
+ DEFB L0C4F - $ ; 0D offset to; Address: P-IF
+ DEFB L0C95 - $ ; 52 offset to; Address: P-CLS
+ DEFB L0C9E - $ ; 5A offset to; Address: P-UNPLOT
+ DEFB L0C92 - $ ; 4D offset to; Address: P-CLEAR
+ DEFB L0C5B - $ ; 15 offset to; Address: P-RETURN
+ DEFB L0CB1 - $ ; 6A offset to; Address: P-COPY
+
+; ii) The parameter table.
+
+
+;; P-LET
+L0C48: DEFB $01 ; Class-01 - A variable is required.
+ DEFB $14 ; Separator: '='
+ DEFB $02 ; Class-02 - An expression, numeric or string,
+ ; must follow.
+
+;; P-GOTO
+L0C4B: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW L0E81 ; Address: $0E81; Address: GOTO
+
+;; P-IF
+L0C4F: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $DE ; Separator: 'THEN'
+ DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW L0DAB ; Address: $0DAB; Address: IF
+
+;; P-GOSUB
+L0C54: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW L0EB5 ; Address: $0EB5; Address: GOSUB
+
+;; P-STOP
+L0C58: DEFB $00 ; Class-00 - No further operands.
+ DEFW L0CDC ; Address: $0CDC; Address: STOP
+
+;; P-RETURN
+L0C5B: DEFB $00 ; Class-00 - No further operands.
+ DEFW L0ED8 ; Address: $0ED8; Address: RETURN
+
+;; P-FOR
+L0C5E: DEFB $04 ; Class-04 - A single character variable must
+ ; follow.
+ DEFB $14 ; Separator: '='
+ DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $DF ; Separator: 'TO'
+ DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW L0DB9 ; Address: $0DB9; Address: FOR
+
+;; P-NEXT
+L0C66: DEFB $04 ; Class-04 - A single character variable must
+ ; follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW L0E2E ; Address: $0E2E; Address: NEXT
+
+;; P-PRINT
+L0C6A: DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW L0ACF ; Address: $0ACF; Address: PRINT
+
+;; P-INPUT
+L0C6D: DEFB $01 ; Class-01 - A variable is required.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW L0EE9 ; Address: $0EE9; Address: INPUT
+
+;; P-DIM
+L0C71: DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW L1409 ; Address: $1409; Address: DIM
+
+;; P-REM
+L0C74: DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW L0D6A ; Address: $0D6A; Address: REM
+
+;; P-NEW
+L0C77: DEFB $00 ; Class-00 - No further operands.
+ DEFW L03C3 ; Address: $03C3; Address: NEW
+
+;; P-RUN
+L0C7A: DEFB $03 ; Class-03 - A numeric expression may follow
+ ; else default to zero.
+ DEFW L0EAF ; Address: $0EAF; Address: RUN
+
+;; P-LIST
+L0C7D: DEFB $03 ; Class-03 - A numeric expression may follow
+ ; else default to zero.
+ DEFW L0730 ; Address: $0730; Address: LIST
+
+;; P-POKE
+L0C80: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $1A ; Separator: ','
+ DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW L0E92 ; Address: $0E92; Address: POKE
+
+;; P-RAND
+L0C86: DEFB $03 ; Class-03 - A numeric expression may follow
+ ; else default to zero.
+ DEFW L0E6C ; Address: $0E6C; Address: RAND
+
+;; P-LOAD
+L0C89: DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW L0340 ; Address: $0340; Address: LOAD
+
+;; P-SAVE
+L0C8C: DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW L02F6 ; Address: $02F6; Address: SAVE
+
+;; P-CONT
+L0C8F: DEFB $00 ; Class-00 - No further operands.
+ DEFW L0E7C ; Address: $0E7C; Address: CONT
+
+;; P-CLEAR
+L0C92: DEFB $00 ; Class-00 - No further operands.
+ DEFW L149A ; Address: $149A; Address: CLEAR
+
+;; P-CLS
+L0C95: DEFB $00 ; Class-00 - No further operands.
+ DEFW L0A2A ; Address: $0A2A; Address: CLS
+
+;; P-PLOT
+L0C98: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $1A ; Separator: ','
+ DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW L0BAF ; Address: $0BAF; Address: PLOT/UNP
+
+;; P-UNPLOT
+L0C9E: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $1A ; Separator: ','
+ DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW L0BAF ; Address: $0BAF; Address: PLOT/UNP
+
+;; P-SCROLL
+L0CA4: DEFB $00 ; Class-00 - No further operands.
+ DEFW L0C0E ; Address: $0C0E; Address: SCROLL
+
+;; P-PAUSE
+L0CA7: DEFB $06 ; Class-06 - A numeric expression must follow.
+ DEFB $00 ; Class-00 - No further operands.
+ DEFW L0F32 ; Address: $0F32; Address: PAUSE
+
+;; P-SLOW
+L0CAB: DEFB $00 ; Class-00 - No further operands.
+ DEFW L0F2B ; Address: $0F2B; Address: SLOW
+
+;; P-FAST
+L0CAE: DEFB $00 ; Class-00 - No further operands.
+ DEFW L0F23 ; Address: $0F23; Address: FAST
+
+;; P-COPY
+L0CB1: DEFB $00 ; Class-00 - No further operands.
+ DEFW L0869 ; Address: $0869; Address: COPY
+
+;; P-LPRINT
+L0CB4: DEFB $05 ; Class-05 - Variable syntax checked entirely
+ ; by routine.
+ DEFW L0ACB ; Address: $0ACB; Address: LPRINT
+
+;; P-LLIST
+L0CB7: DEFB $03 ; Class-03 - A numeric expression may follow
+ ; else default to zero.
+ DEFW L072C ; Address: $072C; Address: LLIST
+
+
+; ---------------------------
+; THE 'LINE SCANNING' ROUTINE
+; ---------------------------
+;
+;
+
+;; LINE-SCAN
+L0CBA: LD (IY+$01),$01 ; sv FLAGS
+ CALL L0A73 ; routine E-LINE-NO
+
+;; LINE-RUN
+L0CC1: CALL L14BC ; routine SET-MIN
+ LD HL,$4000 ; sv ERR_NR
+ LD (HL),$FF ;
+ LD HL,$402D ; sv FLAGX
+ BIT 5,(HL) ;
+ JR Z,L0CDE ; to LINE-NULL
+
+ CP $E3 ; 'STOP' ?
+ LD A,(HL) ;
+ JP NZ,L0D6F ; to INPUT-REP
+
+ CALL L0DA6 ; routine SYNTAX-Z
+ RET Z ;
+
+
+ RST 08H ; ERROR-1
+ DEFB $0C ; Error Report: BREAK - CONT repeats
+
+
+; --------------------------
+; THE 'STOP' COMMAND ROUTINE
+; --------------------------
+;
+;
+
+;; STOP
+L0CDC: RST 08H ; ERROR-1
+ DEFB $08 ; Error Report: STOP statement
+
+; ---
+
+; the interpretation of a line continues with a check for just spaces
+; followed by a carriage return.
+; The IF command also branches here with a true value to execute the
+; statement after the THEN but the statement can be null so
+; 10 IF 1 = 1 THEN
+; passes syntax (on all ZX computers).
+
+;; LINE-NULL
+L0CDE: RST 18H ; GET-CHAR
+ LD B,$00 ; prepare to index - early.
+ CP $76 ; compare to NEWLINE.
+ RET Z ; return if so.
+
+ LD C,A ; transfer character to C.
+
+ RST 20H ; NEXT-CHAR advances.
+ LD A,C ; character to A
+ SUB $E1 ; subtract 'LPRINT' - lowest command.
+ JR C,L0D26 ; forward if less to REPORT-C2
+
+ LD C,A ; reduced token to C
+ LD HL,L0C29 ; set HL to address of offset table.
+ ADD HL,BC ; index into offset table.
+ LD C,(HL) ; fetch offset
+ ADD HL,BC ; index into parameter table.
+ JR L0CF7 ; to GET-PARAM
+
+; ---
+
+;; SCAN-LOOP
+L0CF4: LD HL,($4030) ; sv T_ADDR_lo
+
+; -> Entry Point to Scanning Loop
+
+;; GET-PARAM
+L0CF7: LD A,(HL) ;
+ INC HL ;
+ LD ($4030),HL ; sv T_ADDR_lo
+
+ LD BC,L0CF4 ; Address: SCAN-LOOP
+ PUSH BC ; is pushed on machine stack.
+
+ LD C,A ;
+ CP $0B ;
+ JR NC,L0D10 ; to SEPARATOR
+
+ LD HL,L0D16 ; class-tbl - the address of the class table.
+ LD B,$00 ;
+ ADD HL,BC ;
+ LD C,(HL) ;
+ ADD HL,BC ;
+ PUSH HL ;
+
+ RST 18H ; GET-CHAR
+ RET ; indirect jump to class routine and
+ ; by subsequent RET to SCAN-LOOP.
+
+; -----------------------
+; THE 'SEPARATOR' ROUTINE
+; -----------------------
+
+;; SEPARATOR
+L0D10: RST 18H ; GET-CHAR
+ CP C ;
+ JR NZ,L0D26 ; to REPORT-C2
+ ; 'Nonsense in BASIC'
+
+ RST 20H ; NEXT-CHAR
+ RET ; return
+
+
+; -------------------------
+; THE 'COMMAND CLASS' TABLE
+; -------------------------
+;
+
+;; class-tbl
+L0D16: DEFB L0D2D - $ ; 17 offset to; Address: CLASS-0
+ DEFB L0D3C - $ ; 25 offset to; Address: CLASS-1
+ DEFB L0D6B - $ ; 53 offset to; Address: CLASS-2
+ DEFB L0D28 - $ ; 0F offset to; Address: CLASS-3
+ DEFB L0D85 - $ ; 6B offset to; Address: CLASS-4
+ DEFB L0D2E - $ ; 13 offset to; Address: CLASS-5
+ DEFB L0D92 - $ ; 76 offset to; Address: CLASS-6
+
+
+; --------------------------
+; THE 'CHECK END' SUBROUTINE
+; --------------------------
+; Check for end of statement and that no spurious characters occur after
+; a correctly parsed statement. Since only one statement is allowed on each
+; line, the only character that may follow a statement is a NEWLINE.
+;
+
+;; CHECK-END
+L0D1D: CALL L0DA6 ; routine SYNTAX-Z
+ RET NZ ; return in runtime.
+
+ POP BC ; else drop return address.
+
+;; CHECK-2
+L0D22: LD A,(HL) ; fetch character.
+ CP $76 ; compare to NEWLINE.
+ RET Z ; return if so.
+
+;; REPORT-C2
+L0D26: JR L0D9A ; to REPORT-C
+ ; 'Nonsense in BASIC'
+
+; --------------------------
+; COMMAND CLASSES 03, 00, 05
+; --------------------------
+;
+;
+
+;; CLASS-3
+L0D28: CP $76 ;
+ CALL L0D9C ; routine NO-TO-STK
+
+;; CLASS-0
+L0D2D: CP A ;
+
+;; CLASS-5
+L0D2E: POP BC ;
+ CALL Z,L0D1D ; routine CHECK-END
+ EX DE,HL ;
+ LD HL,($4030) ; sv T_ADDR_lo
+ LD C,(HL) ;
+ INC HL ;
+ LD B,(HL) ;
+ EX DE,HL ;
+
+;; CLASS-END
+L0D3A: PUSH BC ;
+ RET ;
+
+; ------------------------------
+; COMMAND CLASSES 01, 02, 04, 06
+; ------------------------------
+;
+;
+
+;; CLASS-1
+L0D3C: CALL L111C ; routine LOOK-VARS
+
+;; CLASS-4-2
+L0D3F: LD (IY+$2D),$00 ; sv FLAGX
+ JR NC,L0D4D ; to SET-STK
+
+ SET 1,(IY+$2D) ; sv FLAGX
+ JR NZ,L0D63 ; to SET-STRLN
+
+
+;; REPORT-2
+L0D4B: RST 08H ; ERROR-1
+ DEFB $01 ; Error Report: Variable not found
+
+; ---
+
+;; SET-STK
+L0D4D: CALL Z,L11A7 ; routine STK-VAR
+ BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result?
+ JR NZ,L0D63 ; to SET-STRLN
+
+ XOR A ;
+ CALL L0DA6 ; routine SYNTAX-Z
+ CALL NZ,L13F8 ; routine STK-FETCH
+ LD HL,$402D ; sv FLAGX
+ OR (HL) ;
+ LD (HL),A ;
+ EX DE,HL ;
+
+;; SET-STRLN
+L0D63: LD ($402E),BC ; sv STRLEN_lo
+ LD ($4012),HL ; sv DEST-lo
+
+; THE 'REM' COMMAND ROUTINE
+
+;; REM
+L0D6A: RET ;
+
+; ---
+
+;; CLASS-2
+L0D6B: POP BC ;
+ LD A,($4001) ; sv FLAGS
+
+;; INPUT-REP
+L0D6F: PUSH AF ;
+ CALL L0F55 ; routine SCANNING
+ POP AF ;
+ LD BC,L1321 ; Address: LET
+ LD D,(IY+$01) ; sv FLAGS
+ XOR D ;
+ AND $40 ;
+ JR NZ,L0D9A ; to REPORT-C
+
+ BIT 7,D ;
+ JR NZ,L0D3A ; to CLASS-END
+
+ JR L0D22 ; to CHECK-2
+
+; ---
+
+;; CLASS-4
+L0D85: CALL L111C ; routine LOOK-VARS
+ PUSH AF ;
+ LD A,C ;
+ OR $9F ;
+ INC A ;
+ JR NZ,L0D9A ; to REPORT-C
+
+ POP AF ;
+ JR L0D3F ; to CLASS-4-2
+
+; ---
+
+;; CLASS-6
+L0D92: CALL L0F55 ; routine SCANNING
+ BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result?
+ RET NZ ;
+
+
+;; REPORT-C
+L0D9A: RST 08H ; ERROR-1
+ DEFB $0B ; Error Report: Nonsense in BASIC
+
+; --------------------------------
+; THE 'NUMBER TO STACK' SUBROUTINE
+; --------------------------------
+;
+;
+
+;; NO-TO-STK
+L0D9C: JR NZ,L0D92 ; back to CLASS-6 with a non-zero number.
+
+ CALL L0DA6 ; routine SYNTAX-Z
+ RET Z ; return if checking syntax.
+
+; in runtime a zero default is placed on the calculator stack.
+
+ RST 28H ;; FP-CALC
+ DEFB $A0 ;;stk-zero
+ DEFB $34 ;;end-calc
+
+ RET ; return.
+
+; -------------------------
+; THE 'SYNTAX-Z' SUBROUTINE
+; -------------------------
+; This routine returns with zero flag set if checking syntax.
+; Calling this routine uses three instruction bytes compared to four if the
+; bit test is implemented inline.
+
+;; SYNTAX-Z
+L0DA6: BIT 7,(IY+$01) ; test FLAGS - checking syntax only?
+ RET ; return.
+
+; ------------------------
+; THE 'IF' COMMAND ROUTINE
+; ------------------------
+; In runtime, the class routines have evaluated the test expression and
+; the result, true or false, is on the stack.
+
+;; IF
+L0DAB: CALL L0DA6 ; routine SYNTAX-Z
+ JR Z,L0DB6 ; forward if checking syntax to IF-END
+
+; else delete the Boolean value on the calculator stack.
+
+ RST 28H ;; FP-CALC
+ DEFB $02 ;;delete
+ DEFB $34 ;;end-calc
+
+; register DE points to exponent of floating point value.
+
+ LD A,(DE) ; fetch exponent.
+ AND A ; test for zero - FALSE.
+ RET Z ; return if so.
+
+;; IF-END
+L0DB6: JP L0CDE ; jump back to LINE-NULL
+
+; -------------------------
+; THE 'FOR' COMMAND ROUTINE
+; -------------------------
+;
+;
+
+;; FOR
+L0DB9: CP $E0 ; is current character 'STEP' ?
+ JR NZ,L0DC6 ; forward if not to F-USE-ONE
+
+
+ RST 20H ; NEXT-CHAR
+ CALL L0D92 ; routine CLASS-6 stacks the number
+ CALL L0D1D ; routine CHECK-END
+ JR L0DCC ; forward to F-REORDER
+
+; ---
+
+;; F-USE-ONE
+L0DC6: CALL L0D1D ; routine CHECK-END
+
+ RST 28H ;; FP-CALC
+ DEFB $A1 ;;stk-one
+ DEFB $34 ;;end-calc
+
+
+
+;; F-REORDER
+L0DCC: RST 28H ;; FP-CALC v, l, s.
+ DEFB $C0 ;;st-mem-0 v, l, s.
+ DEFB $02 ;;delete v, l.
+ DEFB $01 ;;exchange l, v.
+ DEFB $E0 ;;get-mem-0 l, v, s.
+ DEFB $01 ;;exchange l, s, v.
+ DEFB $34 ;;end-calc l, s, v.
+
+ CALL L1321 ; routine LET
+
+ LD ($401F),HL ; set MEM to address variable.
+ DEC HL ; point to letter.
+ LD A,(HL) ;
+ SET 7,(HL) ;
+ LD BC,$0006 ;
+ ADD HL,BC ;
+ RLCA ;
+ JR C,L0DEA ; to F-LMT-STP
+
+ SLA C ;
+ CALL L099E ; routine MAKE-ROOM
+ INC HL ;
+
+;; F-LMT-STP
+L0DEA: PUSH HL ;
+
+ RST 28H ;; FP-CALC
+ DEFB $02 ;;delete
+ DEFB $02 ;;delete
+ DEFB $34 ;;end-calc
+
+ POP HL ;
+ EX DE,HL ;
+
+ LD C,$0A ; ten bytes to be moved.
+ LDIR ; copy bytes
+
+ LD HL,($4007) ; set HL to system variable PPC current line.
+ EX DE,HL ; transfer to DE, variable pointer to HL.
+ INC DE ; loop start will be this line + 1 at least.
+ LD (HL),E ;
+ INC HL ;
+ LD (HL),D ;
+ CALL L0E5A ; routine NEXT-LOOP considers an initial pass.
+ RET NC ; return if possible.
+
+; else program continues from point following matching NEXT.
+
+ BIT 7,(IY+$08) ; test PPC_hi
+ RET NZ ; return if over 32767 ???
+
+ LD B,(IY+$2E) ; fetch variable name from STRLEN_lo
+ RES 6,B ; make a true letter.
+ LD HL,($4029) ; set HL from NXTLIN
+
+; now enter a loop to look for matching next.
+
+;; NXTLIN-NO
+L0E0E: LD A,(HL) ; fetch high byte of line number.
+ AND $C0 ; mask off low bits $3F
+ JR NZ,L0E2A ; forward at end of program to FOR-END
+
+ PUSH BC ; save letter
+ CALL L09F2 ; routine NEXT-ONE finds next line.
+ POP BC ; restore letter
+
+ INC HL ; step past low byte
+ INC HL ; past the
+ INC HL ; line length.
+ CALL L004C ; routine TEMP-PTR1 sets CH_ADD
+
+ RST 18H ; GET-CHAR
+ CP $F3 ; compare to 'NEXT'.
+ EX DE,HL ; next line to HL.
+ JR NZ,L0E0E ; back with no match to NXTLIN-NO
+
+;
+
+ EX DE,HL ; restore pointer.
+
+ RST 20H ; NEXT-CHAR advances and gets letter in A.
+ EX DE,HL ; save pointer
+ CP B ; compare to variable name.
+ JR NZ,L0E0E ; back with mismatch to NXTLIN-NO
+
+;; FOR-END
+L0E2A: LD ($4029),HL ; update system variable NXTLIN
+ RET ; return.
+
+; --------------------------
+; THE 'NEXT' COMMAND ROUTINE
+; --------------------------
+;
+;
+
+;; NEXT
+L0E2E: BIT 1,(IY+$2D) ; sv FLAGX
+ JP NZ,L0D4B ; to REPORT-2
+
+ LD HL,($4012) ; DEST
+ BIT 7,(HL) ;
+ JR Z,L0E58 ; to REPORT-1
+
+ INC HL ;
+ LD ($401F),HL ; sv MEM_lo
+
+ RST 28H ;; FP-CALC
+ DEFB $E0 ;;get-mem-0
+ DEFB $E2 ;;get-mem-2
+ DEFB $0F ;;addition
+ DEFB $C0 ;;st-mem-0
+ DEFB $02 ;;delete
+ DEFB $34 ;;end-calc
+
+ CALL L0E5A ; routine NEXT-LOOP
+ RET C ;
+
+ LD HL,($401F) ; sv MEM_lo
+ LD DE,$000F ;
+ ADD HL,DE ;
+ LD E,(HL) ;
+ INC HL ;
+ LD D,(HL) ;
+ EX DE,HL ;
+ JR L0E86 ; to GOTO-2
+
+; ---
+
+
+;; REPORT-1
+L0E58: RST 08H ; ERROR-1
+ DEFB $00 ; Error Report: NEXT without FOR
+
+
+; --------------------------
+; THE 'NEXT-LOOP' SUBROUTINE
+; --------------------------
+;
+;
+
+;; NEXT-LOOP
+L0E5A: RST 28H ;; FP-CALC
+ DEFB $E1 ;;get-mem-1
+ DEFB $E0 ;;get-mem-0
+ DEFB $E2 ;;get-mem-2
+ DEFB $32 ;;less-0
+ DEFB $00 ;;jump-true
+ DEFB $02 ;;to L0E62, LMT-V-VAL
+
+ DEFB $01 ;;exchange
+
+;; LMT-V-VAL
+L0E62: DEFB $03 ;;subtract
+ DEFB $33 ;;greater-0
+ DEFB $00 ;;jump-true
+ DEFB $04 ;;to L0E69, IMPOSS
+
+ DEFB $34 ;;end-calc
+
+ AND A ; clear carry flag
+ RET ; return.
+
+; ---
+
+
+;; IMPOSS
+L0E69: DEFB $34 ;;end-calc
+
+ SCF ; set carry flag
+ RET ; return.
+
+; --------------------------
+; THE 'RAND' COMMAND ROUTINE
+; --------------------------
+; The keyword was 'RANDOMISE' on the ZX80, is 'RAND' here on the ZX81 and
+; becomes 'RANDOMIZE' on the ZX Spectrum.
+; In all invocations the procedure is the same - to set the SEED system variable
+; with a supplied integer value or to use a time-based value if no number, or
+; zero, is supplied.
+
+;; RAND
+L0E6C: CALL L0EA7 ; routine FIND-INT
+ LD A,B ; test value
+ OR C ; for zero
+ JR NZ,L0E77 ; forward if not zero to SET-SEED
+
+ LD BC,($4034) ; fetch value of FRAMES system variable.
+
+;; SET-SEED
+L0E77: LD ($4032),BC ; update the SEED system variable.
+ RET ; return.
+
+; --------------------------
+; THE 'CONT' COMMAND ROUTINE
+; --------------------------
+; Another abbreviated command. ROM space was really tight.
+; CONTINUE at the line number that was set when break was pressed.
+; Sometimes the current line, sometimes the next line.
+
+;; CONT
+L0E7C: LD HL,($402B) ; set HL from system variable OLDPPC
+ JR L0E86 ; forward to GOTO-2
+
+; --------------------------
+; THE 'GOTO' COMMAND ROUTINE
+; --------------------------
+; This token also suffered from the shortage of room and there is no space
+; getween GO and TO as there is on the ZX80 and ZX Spectrum. The same also
+; applies to the GOSUB keyword.
+
+;; GOTO
+L0E81: CALL L0EA7 ; routine FIND-INT
+ LD H,B ;
+ LD L,C ;
+
+;; GOTO-2
+L0E86: LD A,H ;
+ CP $F0 ;
+ JR NC,L0EAD ; to REPORT-B
+
+ CALL L09D8 ; routine LINE-ADDR
+ LD ($4029),HL ; sv NXTLIN_lo
+ RET ;
+
+; --------------------------
+; THE 'POKE' COMMAND ROUTINE
+; --------------------------
+;
+;
+
+;; POKE
+L0E92: CALL L15CD ; routine FP-TO-A
+ JR C,L0EAD ; forward, with overflow, to REPORT-B
+
+ JR Z,L0E9B ; forward, if positive, to POKE-SAVE
+
+ NEG ; negate
+
+;; POKE-SAVE
+L0E9B: PUSH AF ; preserve value.
+ CALL L0EA7 ; routine FIND-INT gets address in BC
+ ; invoking the error routine with overflow
+ ; or a negative number.
+ POP AF ; restore value.
+
+; Note. the next two instructions are legacy code from the ZX80 and
+; inappropriate here.
+
+ BIT 7,(IY+$00) ; test ERR_NR - is it still $FF ?
+ RET Z ; return with error.
+
+ LD (BC),A ; update the address contents.
+ RET ; return.
+
+; -----------------------------
+; THE 'FIND INTEGER' SUBROUTINE
+; -----------------------------
+;
+;
+
+;; FIND-INT
+L0EA7: CALL L158A ; routine FP-TO-BC
+ JR C,L0EAD ; forward with overflow to REPORT-B
+
+ RET Z ; return if positive (0-65535).
+
+
+;; REPORT-B
+L0EAD: RST 08H ; ERROR-1
+ DEFB $0A ; Error Report: Integer out of range
+
+; -------------------------
+; THE 'RUN' COMMAND ROUTINE
+; -------------------------
+;
+;
+
+;; RUN
+L0EAF: CALL L0E81 ; routine GOTO
+ JP L149A ; to CLEAR
+
+; ---------------------------
+; THE 'GOSUB' COMMAND ROUTINE
+; ---------------------------
+;
+;
+
+;; GOSUB
+L0EB5: LD HL,($4007) ; sv PPC_lo
+ INC HL ;
+ EX (SP),HL ;
+ PUSH HL ;
+ LD ($4002),SP ; set the error stack pointer - ERR_SP
+ CALL L0E81 ; routine GOTO
+ LD BC,$0006 ;
+
+; --------------------------
+; THE 'TEST ROOM' SUBROUTINE
+; --------------------------
+;
+;
+
+;; TEST-ROOM
+L0EC5: LD HL,($401C) ; sv STKEND_lo
+ ADD HL,BC ;
+ JR C,L0ED3 ; to REPORT-4
+
+ EX DE,HL ;
+ LD HL,$0024 ;
+ ADD HL,DE ;
+ SBC HL,SP ;
+ RET C ;
+
+;; REPORT-4
+L0ED3: LD L,$03 ;
+ JP L0058 ; to ERROR-3
+
+; ----------------------------
+; THE 'RETURN' COMMAND ROUTINE
+; ----------------------------
+;
+;
+
+;; RETURN
+L0ED8: POP HL ;
+ EX (SP),HL ;
+ LD A,H ;
+ CP $3E ;
+ JR Z,L0EE5 ; to REPORT-7
+
+ LD ($4002),SP ; sv ERR_SP_lo
+ JR L0E86 ; back to GOTO-2
+
+; ---
+
+;; REPORT-7
+L0EE5: EX (SP),HL ;
+ PUSH HL ;
+
+ RST 08H ; ERROR-1
+ DEFB $06 ; Error Report: RETURN without GOSUB
+
+; ---------------------------
+; THE 'INPUT' COMMAND ROUTINE
+; ---------------------------
+;
+;
+
+;; INPUT
+L0EE9: BIT 7,(IY+$08) ; sv PPC_hi
+ JR NZ,L0F21 ; to REPORT-8
+
+ CALL L14A3 ; routine X-TEMP
+ LD HL,$402D ; sv FLAGX
+ SET 5,(HL) ;
+ RES 6,(HL) ;
+ LD A,($4001) ; sv FLAGS
+ AND $40 ;
+ LD BC,$0002 ;
+ JR NZ,L0F05 ; to PROMPT
+
+ LD C,$04 ;
+
+;; PROMPT
+L0F05: OR (HL) ;
+ LD (HL),A ;
+
+ RST 30H ; BC-SPACES
+ LD (HL),$76 ;
+ LD A,C ;
+ RRCA ;
+ RRCA ;
+ JR C,L0F14 ; to ENTER-CUR
+
+ LD A,$0B ;
+ LD (DE),A ;
+ DEC HL ;
+ LD (HL),A ;
+
+;; ENTER-CUR
+L0F14: DEC HL ;
+ LD (HL),$7F ;
+ LD HL,($4039) ; sv S_POSN_x
+ LD ($4030),HL ; sv T_ADDR_lo
+ POP HL ;
+ JP L0472 ; to LOWER
+
+; ---
+
+;; REPORT-8
+L0F21: RST 08H ; ERROR-1
+ DEFB $07 ; Error Report: End of file
+
+; ---------------------------
+; THE 'PAUSE' COMMAND ROUTINE
+; ---------------------------
+;
+;
+
+;; FAST
+L0F23: CALL L02E7 ; routine SET-FAST
+ RES 6,(IY+$3B) ; sv CDFLAG
+ RET ; return.
+
+; --------------------------
+; THE 'SLOW' COMMAND ROUTINE
+; --------------------------
+;
+;
+
+;; SLOW
+L0F2B: SET 6,(IY+$3B) ; sv CDFLAG
+ JP L0207 ; to SLOW/FAST
+
+; ---------------------------
+; THE 'PAUSE' COMMAND ROUTINE
+; ---------------------------
+
+;; PAUSE
+L0F32: CALL L0EA7 ; routine FIND-INT
+ CALL L02E7 ; routine SET-FAST
+ LD H,B ;
+ LD L,C ;
+ CALL L022D ; routine DISPLAY-P
+
+ LD (IY+$35),$FF ; sv FRAMES_hi
+
+ CALL L0207 ; routine SLOW/FAST
+ JR L0F4B ; routine DEBOUNCE
+
+; ----------------------
+; THE 'BREAK' SUBROUTINE
+; ----------------------
+;
+;
+
+;; BREAK-1
+L0F46: LD A,$7F ; read port $7FFE - keys B,N,M,.,SPACE.
+ IN A,($FE) ;
+ RRA ; carry will be set if space not pressed.
+
+; -------------------------
+; THE 'DEBOUNCE' SUBROUTINE
+; -------------------------
+;
+;
+
+;; DEBOUNCE
+L0F4B: RES 0,(IY+$3B) ; update system variable CDFLAG
+ LD A,$FF ;
+ LD ($4027),A ; update system variable DEBOUNCE
+ RET ; return.
+
+
+; -------------------------
+; THE 'SCANNING' SUBROUTINE
+; -------------------------
+; This recursive routine is where the ZX81 gets its power. Provided there is
+; enough memory it can evaluate an expression of unlimited complexity.
+; Note. there is no unary plus so, as on the ZX80, PRINT +1 gives a syntax error.
+; PRINT +1 works on the Spectrum but so too does PRINT + "STRING".
+
+;; SCANNING
+L0F55: RST 18H ; GET-CHAR
+ LD B,$00 ; set B register to zero.
+ PUSH BC ; stack zero as a priority end-marker.
+
+;; S-LOOP-1
+L0F59: CP $40 ; compare to the 'RND' character
+ JR NZ,L0F8C ; forward, if not, to S-TEST-PI
+
+; ------------------
+; THE 'RND' FUNCTION
+; ------------------
+
+ CALL L0DA6 ; routine SYNTAX-Z
+ JR Z,L0F8A ; forward if checking syntax to S-JPI-END
+
+ LD BC,($4032) ; sv SEED_lo
+ CALL L1520 ; routine STACK-BC
+
+ RST 28H ;; FP-CALC
+ DEFB $A1 ;;stk-one
+ DEFB $0F ;;addition
+ DEFB $30 ;;stk-data
+ DEFB $37 ;;Exponent: $87, Bytes: 1
+ DEFB $16 ;;(+00,+00,+00)
+ DEFB $04 ;;multiply
+ DEFB $30 ;;stk-data
+ DEFB $80 ;;Bytes: 3
+ DEFB $41 ;;Exponent $91
+ DEFB $00,$00,$80 ;;(+00)
+ DEFB $2E ;;n-mod-m
+ DEFB $02 ;;delete
+ DEFB $A1 ;;stk-one
+ DEFB $03 ;;subtract
+ DEFB $2D ;;duplicate
+ DEFB $34 ;;end-calc
+
+ CALL L158A ; routine FP-TO-BC
+ LD ($4032),BC ; update the SEED system variable.
+ LD A,(HL) ; HL addresses the exponent of the last value.
+ AND A ; test for zero
+ JR Z,L0F8A ; forward, if so, to S-JPI-END
+
+ SUB $10 ; else reduce exponent by sixteen
+ LD (HL),A ; thus dividing by 65536 for last value.
+
+;; S-JPI-END
+L0F8A: JR L0F99 ; forward to S-PI-END
+
+; ---
+
+;; S-TEST-PI
+L0F8C: CP $42 ; the 'PI' character
+ JR NZ,L0F9D ; forward, if not, to S-TST-INK
+
+; -------------------
+; THE 'PI' EVALUATION
+; -------------------
+
+ CALL L0DA6 ; routine SYNTAX-Z
+ JR Z,L0F99 ; forward if checking syntax to S-PI-END
+
+
+ RST 28H ;; FP-CALC
+ DEFB $A3 ;;stk-pi/2
+ DEFB $34 ;;end-calc
+
+ INC (HL) ; double the exponent giving PI on the stack.
+
+;; S-PI-END
+L0F99: RST 20H ; NEXT-CHAR advances character pointer.
+
+ JP L1083 ; jump forward to S-NUMERIC to set the flag
+ ; to signal numeric result before advancing.
+
+; ---
+
+;; S-TST-INK
+L0F9D: CP $41 ; compare to character 'INKEY$'
+ JR NZ,L0FB2 ; forward, if not, to S-ALPHANUM
+
+; -----------------------
+; THE 'INKEY$' EVALUATION
+; -----------------------
+
+ CALL L02BB ; routine KEYBOARD
+ LD B,H ;
+ LD C,L ;
+ LD D,C ;
+ INC D ;
+ CALL NZ,L07BD ; routine DECODE
+ LD A,D ;
+ ADC A,D ;
+ LD B,D ;
+ LD C,A ;
+ EX DE,HL ;
+ JR L0FED ; forward to S-STRING
+
+; ---
+
+;; S-ALPHANUM
+L0FB2: CALL L14D2 ; routine ALPHANUM
+ JR C,L1025 ; forward, if alphanumeric to S-LTR-DGT
+
+ CP $1B ; is character a '.' ?
+ JP Z,L1047 ; jump forward if so to S-DECIMAL
+
+ LD BC,$09D8 ; prepare priority 09, operation 'subtract'
+ CP $16 ; is character unary minus '-' ?
+ JR Z,L1020 ; forward, if so, to S-PUSH-PO
+
+ CP $10 ; is character a '(' ?
+ JR NZ,L0FD6 ; forward if not to S-QUOTE
+
+ CALL L0049 ; routine CH-ADD+1 advances character pointer.
+
+ CALL L0F55 ; recursively call routine SCANNING to
+ ; evaluate the sub-expression.
+
+ CP $11 ; is subsequent character a ')' ?
+ JR NZ,L0FFF ; forward if not to S-RPT-C
+
+
+ CALL L0049 ; routine CH-ADD+1 advances.
+ JR L0FF8 ; relative jump to S-JP-CONT3 and then S-CONT3
+
+; ---
+
+; consider a quoted string e.g. PRINT "Hooray!"
+; Note. quotes are not allowed within a string.
+
+;; S-QUOTE
+L0FD6: CP $0B ; is character a quote (") ?
+ JR NZ,L1002 ; forward, if not, to S-FUNCTION
+
+ CALL L0049 ; routine CH-ADD+1 advances
+ PUSH HL ; * save start of string.
+ JR L0FE3 ; forward to S-QUOTE-S
+
+; ---
+
+
+;; S-Q-AGAIN
+L0FE0: CALL L0049 ; routine CH-ADD+1
+
+;; S-QUOTE-S
+L0FE3: CP $0B ; is character a '"' ?
+ JR NZ,L0FFB ; forward if not to S-Q-NL
+
+ POP DE ; * retrieve start of string
+ AND A ; prepare to subtract.
+ SBC HL,DE ; subtract start from current position.
+ LD B,H ; transfer this length
+ LD C,L ; to the BC register pair.
+
+;; S-STRING
+L0FED: LD HL,$4001 ; address system variable FLAGS
+ RES 6,(HL) ; signal string result
+ BIT 7,(HL) ; test if checking syntax.
+
+ CALL NZ,L12C3 ; in run-time routine STK-STO-$ stacks the
+ ; string descriptor - start DE, length BC.
+
+ RST 20H ; NEXT-CHAR advances pointer.
+
+;; S-J-CONT-3
+L0FF8: JP L1088 ; jump to S-CONT-3
+
+; ---
+
+; A string with no terminating quote has to be considered.
+
+;; S-Q-NL
+L0FFB: CP $76 ; compare to NEWLINE
+ JR NZ,L0FE0 ; loop back if not to S-Q-AGAIN
+
+;; S-RPT-C
+L0FFF: JP L0D9A ; to REPORT-C
+
+; ---
+
+;; S-FUNCTION
+L1002: SUB $C4 ; subtract 'CODE' reducing codes
+ ; CODE thru '<>' to range $00 - $XX
+ JR C,L0FFF ; back, if less, to S-RPT-C
+
+; test for NOT the last function in character set.
+
+ LD BC,$04EC ; prepare priority $04, operation 'not'
+ CP $13 ; compare to 'NOT' ( - CODE)
+ JR Z,L1020 ; forward, if so, to S-PUSH-PO
+
+ JR NC,L0FFF ; back with anything higher to S-RPT-C
+
+; else is a function 'CODE' thru 'CHR$'
+
+ LD B,$10 ; priority sixteen binds all functions to
+ ; arguments removing the need for brackets.
+
+ ADD A,$D9 ; add $D9 to give range $D9 thru $EB
+ ; bit 6 is set to show numeric argument.
+ ; bit 7 is set to show numeric result.
+
+; now adjust these default argument/result indicators.
+
+ LD C,A ; save code in C
+
+ CP $DC ; separate 'CODE', 'VAL', 'LEN'
+ JR NC,L101A ; skip forward if string operand to S-NO-TO-$
+
+ RES 6,C ; signal string operand.
+
+;; S-NO-TO-$
+L101A: CP $EA ; isolate top of range 'STR$' and 'CHR$'
+ JR C,L1020 ; skip forward with others to S-PUSH-PO
+
+ RES 7,C ; signal string result.
+
+;; S-PUSH-PO
+L1020: PUSH BC ; push the priority/operation
+
+ RST 20H ; NEXT-CHAR
+ JP L0F59 ; jump back to S-LOOP-1
+
+; ---
+
+;; S-LTR-DGT
+L1025: CP $26 ; compare to 'A'.
+ JR C,L1047 ; forward if less to S-DECIMAL
+
+ CALL L111C ; routine LOOK-VARS
+ JP C,L0D4B ; back if not found to REPORT-2
+ ; a variable is always 'found' when checking
+ ; syntax.
+
+ CALL Z,L11A7 ; routine STK-VAR stacks string parameters or
+ ; returns cell location if numeric.
+
+ LD A,($4001) ; fetch FLAGS
+ CP $C0 ; compare to numeric result/numeric operand
+ JR C,L1087 ; forward if not numeric to S-CONT-2
+
+ INC HL ; address numeric contents of variable.
+ LD DE,($401C) ; set destination to STKEND
+ CALL L19F6 ; routine MOVE-FP stacks the five bytes
+ EX DE,HL ; transfer new free location from DE to HL.
+ LD ($401C),HL ; update STKEND system variable.
+ JR L1087 ; forward to S-CONT-2
+
+; ---
+
+; The Scanning Decimal routine is invoked when a decimal point or digit is
+; found in the expression.
+; When checking syntax, then the 'hidden floating point' form is placed
+; after the number in the BASIC line.
+; In run-time, the digits are skipped and the floating point number is picked
+; up.
+
+;; S-DECIMAL
+L1047: CALL L0DA6 ; routine SYNTAX-Z
+ JR NZ,L106F ; forward in run-time to S-STK-DEC
+
+ CALL L14D9 ; routine DEC-TO-FP
+
+ RST 18H ; GET-CHAR advances HL past digits
+ LD BC,$0006 ; six locations are required.
+ CALL L099E ; routine MAKE-ROOM
+ INC HL ; point to first new location
+ LD (HL),$7E ; insert the number marker 126 decimal.
+ INC HL ; increment
+ EX DE,HL ; transfer destination to DE.
+ LD HL,($401C) ; set HL from STKEND which points to the
+ ; first location after the 'last value'
+ LD C,$05 ; five bytes to move.
+ AND A ; clear carry.
+ SBC HL,BC ; subtract five pointing to 'last value'.
+ LD ($401C),HL ; update STKEND thereby 'deleting the value.
+
+ LDIR ; copy the five value bytes.
+
+ EX DE,HL ; basic pointer to HL which may be white-space
+ ; following the number.
+ DEC HL ; now points to last of five bytes.
+ CALL L004C ; routine TEMP-PTR1 advances the character
+ ; address skipping any white-space.
+ JR L1083 ; forward to S-NUMERIC
+ ; to signal a numeric result.
+
+; ---
+
+; In run-time the branch is here when a digit or point is encountered.
+
+;; S-STK-DEC
+L106F: RST 20H ; NEXT-CHAR
+ CP $7E ; compare to 'number marker'
+ JR NZ,L106F ; loop back until found to S-STK-DEC
+ ; skipping all the digits.
+
+ INC HL ; point to first of five hidden bytes.
+ LD DE,($401C) ; set destination from STKEND system variable
+ CALL L19F6 ; routine MOVE-FP stacks the number.
+ LD ($401C),DE ; update system variable STKEND.
+ LD ($4016),HL ; update system variable CH_ADD.
+
+;; S-NUMERIC
+L1083: SET 6,(IY+$01) ; update FLAGS - Signal numeric result
+
+;; S-CONT-2
+L1087: RST 18H ; GET-CHAR
+
+;; S-CONT-3
+L1088: CP $10 ; compare to opening bracket '('
+ JR NZ,L1098 ; forward if not to S-OPERTR
+
+ BIT 6,(IY+$01) ; test FLAGS - Numeric or string result?
+ JR NZ,L10BC ; forward if numeric to S-LOOP
+
+; else is a string
+
+ CALL L1263 ; routine SLICING
+
+ RST 20H ; NEXT-CHAR
+ JR L1088 ; back to S-CONT-3
+
+; ---
+
+; the character is now manipulated to form an equivalent in the table of
+; calculator literals. This is quite cumbersome and in the ZX Spectrum a
+; simple look-up table was introduced at this point.
+
+;; S-OPERTR
+L1098: LD BC,$00C3 ; prepare operator 'subtract' as default.
+ ; also set B to zero for later indexing.
+
+ CP $12 ; is character '>' ?
+ JR C,L10BC ; forward if less to S-LOOP as
+ ; we have reached end of meaningful expression
+
+ SUB $16 ; is character '-' ?
+ JR NC,L10A7 ; forward with - * / and '**' '<>' to SUBMLTDIV
+
+ ADD A,$0D ; increase others by thirteen
+ ; $09 '>' thru $0C '+'
+ JR L10B5 ; forward to GET-PRIO
+
+; ---
+
+;; SUBMLTDIV
+L10A7: CP $03 ; isolate $00 '-', $01 '*', $02 '/'
+ JR C,L10B5 ; forward if so to GET-PRIO
+
+; else possibly originally $D8 '**' thru $DD '<>' already reduced by $16
+
+ SUB $C2 ; giving range $00 to $05
+ JR C,L10BC ; forward if less to S-LOOP
+
+ CP $06 ; test the upper limit for nonsense also
+ JR NC,L10BC ; forward if so to S-LOOP
+
+ ADD A,$03 ; increase by 3 to give combined operators of
+
+ ; $00 '-'
+ ; $01 '*'
+ ; $02 '/'
+
+ ; $03 '**'
+ ; $04 'OR'
+ ; $05 'AND'
+ ; $06 '<='
+ ; $07 '>='
+ ; $08 '<>'
+
+ ; $09 '>'
+ ; $0A '<'
+ ; $0B '='
+ ; $0C '+'
+
+;; GET-PRIO
+L10B5: ADD A,C ; add to default operation 'sub' ($C3)
+ LD C,A ; and place in operator byte - C.
+
+ LD HL,L110F - $C3 ; theoretical base of the priorities table.
+ ADD HL,BC ; add C ( B is zero)
+ LD B,(HL) ; pick up the priority in B
+
+;; S-LOOP
+L10BC: POP DE ; restore previous
+ LD A,D ; load A with priority.
+ CP B ; is present priority higher
+ JR C,L10ED ; forward if so to S-TIGHTER
+
+ AND A ; are both priorities zero
+ JP Z,L0018 ; exit if zero via GET-CHAR
+
+ PUSH BC ; stack present values
+ PUSH DE ; stack last values
+ CALL L0DA6 ; routine SYNTAX-Z
+ JR Z,L10D5 ; forward is checking syntax to S-SYNTEST
+
+ LD A,E ; fetch last operation
+ AND $3F ; mask off the indicator bits to give true
+ ; calculator literal.
+ LD B,A ; place in the B register for BREG
+
+; perform the single operation
+
+ RST 28H ;; FP-CALC
+ DEFB $37 ;;fp-calc-2
+ DEFB $34 ;;end-calc
+
+ JR L10DE ; forward to S-RUNTEST
+
+; ---
+
+;; S-SYNTEST
+L10D5: LD A,E ; transfer masked operator to A
+ XOR (IY+$01) ; XOR with FLAGS like results will reset bit 6
+ AND $40 ; test bit 6
+
+;; S-RPORT-C
+L10DB: JP NZ,L0D9A ; back to REPORT-C if results do not agree.
+
+; ---
+
+; in run-time impose bit 7 of the operator onto bit 6 of the FLAGS
+
+;; S-RUNTEST
+L10DE: POP DE ; restore last operation.
+ LD HL,$4001 ; address system variable FLAGS
+ SET 6,(HL) ; presume a numeric result
+ BIT 7,E ; test expected result in operation
+ JR NZ,L10EA ; forward if numeric to S-LOOPEND
+
+ RES 6,(HL) ; reset to signal string result
+
+;; S-LOOPEND
+L10EA: POP BC ; restore present values
+ JR L10BC ; back to S-LOOP
+
+; ---
+
+;; S-TIGHTER
+L10ED: PUSH DE ; push last values and consider these
+
+ LD A,C ; get the present operator.
+ BIT 6,(IY+$01) ; test FLAGS - Numeric or string result?
+ JR NZ,L110A ; forward if numeric to S-NEXT
+
+ AND $3F ; strip indicator bits to give clear literal.
+ ADD A,$08 ; add eight - augmenting numeric to equivalent
+ ; string literals.
+ LD C,A ; place plain literal back in C.
+ CP $10 ; compare to 'AND'
+ JR NZ,L1102 ; forward if not to S-NOT-AND
+
+ SET 6,C ; set the numeric operand required for 'AND'
+ JR L110A ; forward to S-NEXT
+
+; ---
+
+;; S-NOT-AND
+L1102: JR C,L10DB ; back if less than 'AND' to S-RPORT-C
+ ; Nonsense if '-', '*' etc.
+
+ CP $17 ; compare to 'strs-add' literal
+ JR Z,L110A ; forward if so signaling string result
+
+ SET 7,C ; set bit to numeric (Boolean) for others.
+
+;; S-NEXT
+L110A: PUSH BC ; stack 'present' values
+
+ RST 20H ; NEXT-CHAR
+ JP L0F59 ; jump back to S-LOOP-1
+
+
+
+; -------------------------
+; THE 'TABLE OF PRIORITIES'
+; -------------------------
+;
+;
+
+;; tbl-pri
+L110F: DEFB $06 ; '-'
+ DEFB $08 ; '*'
+ DEFB $08 ; '/'
+ DEFB $0A ; '**'
+ DEFB $02 ; 'OR'
+ DEFB $03 ; 'AND'
+ DEFB $05 ; '<='
+ DEFB $05 ; '>='
+ DEFB $05 ; '<>'
+ DEFB $05 ; '>'
+ DEFB $05 ; '<'
+ DEFB $05 ; '='
+ DEFB $06 ; '+'
+
+
+; --------------------------
+; THE 'LOOK-VARS' SUBROUTINE
+; --------------------------
+;
+;
+
+;; LOOK-VARS
+L111C: SET 6,(IY+$01) ; sv FLAGS - Signal numeric result
+
+ RST 18H ; GET-CHAR
+ CALL L14CE ; routine ALPHA
+ JP NC,L0D9A ; to REPORT-C
+
+ PUSH HL ;
+ LD C,A ;
+
+ RST 20H ; NEXT-CHAR
+ PUSH HL ;
+ RES 5,C ;
+ CP $10 ;
+ JR Z,L1148 ; to V-SYN/RUN
+
+ SET 6,C ;
+ CP $0D ;
+ JR Z,L1143 ; forward to V-STR-VAR
+
+ SET 5,C ;
+
+;; V-CHAR
+L1139: CALL L14D2 ; routine ALPHANUM
+ JR NC,L1148 ; forward when not to V-RUN/SYN
+
+ RES 6,C ;
+
+ RST 20H ; NEXT-CHAR
+ JR L1139 ; loop back to V-CHAR
+
+; ---
+
+;; V-STR-VAR
+L1143: RST 20H ; NEXT-CHAR
+ RES 6,(IY+$01) ; sv FLAGS - Signal string result
+
+;; V-RUN/SYN
+L1148: LD B,C ;
+ CALL L0DA6 ; routine SYNTAX-Z
+ JR NZ,L1156 ; forward to V-RUN
+
+ LD A,C ;
+ AND $E0 ;
+ SET 7,A ;
+ LD C,A ;
+ JR L118A ; forward to V-SYNTAX
+
+; ---
+
+;; V-RUN
+L1156: LD HL,($4010) ; sv VARS
+
+;; V-EACH
+L1159: LD A,(HL) ;
+ AND $7F ;
+ JR Z,L1188 ; to V-80-BYTE
+
+ CP C ;
+ JR NZ,L1180 ; to V-NEXT
+
+ RLA ;
+ ADD A,A ;
+ JP P,L1195 ; to V-FOUND-2
+
+ JR C,L1195 ; to V-FOUND-2
+
+ POP DE ;
+ PUSH DE ;
+ PUSH HL ;
+
+;; V-MATCHES
+L116B: INC HL ;
+
+;; V-SPACES
+L116C: LD A,(DE) ;
+ INC DE ;
+ AND A ;
+ JR Z,L116C ; back to V-SPACES
+
+ CP (HL) ;
+ JR Z,L116B ; back to V-MATCHES
+
+ OR $80 ;
+ CP (HL) ;
+ JR NZ,L117F ; forward to V-GET-PTR
+
+ LD A,(DE) ;
+ CALL L14D2 ; routine ALPHANUM
+ JR NC,L1194 ; forward to V-FOUND-1
+
+;; V-GET-PTR
+L117F: POP HL ;
+
+;; V-NEXT
+L1180: PUSH BC ;
+ CALL L09F2 ; routine NEXT-ONE
+ EX DE,HL ;
+ POP BC ;
+ JR L1159 ; back to V-EACH
+
+; ---
+
+;; V-80-BYTE
+L1188: SET 7,B ;
+
+;; V-SYNTAX
+L118A: POP DE ;
+
+ RST 18H ; GET-CHAR
+ CP $10 ;
+ JR Z,L1199 ; forward to V-PASS
+
+ SET 5,B ;
+ JR L11A1 ; forward to V-END
+
+; ---
+
+;; V-FOUND-1
+L1194: POP DE ;
+
+;; V-FOUND-2
+L1195: POP DE ;
+ POP DE ;
+ PUSH HL ;
+
+ RST 18H ; GET-CHAR
+
+;; V-PASS
+L1199: CALL L14D2 ; routine ALPHANUM
+ JR NC,L11A1 ; forward if not alphanumeric to V-END
+
+
+ RST 20H ; NEXT-CHAR
+ JR L1199 ; back to V-PASS
+
+; ---
+
+;; V-END
+L11A1: POP HL ;
+ RL B ;
+ BIT 6,B ;
+ RET ;
+
+; ------------------------
+; THE 'STK-VAR' SUBROUTINE
+; ------------------------
+;
+;
+
+;; STK-VAR
+L11A7: XOR A ;
+ LD B,A ;
+ BIT 7,C ;
+ JR NZ,L11F8 ; forward to SV-COUNT
+
+ BIT 7,(HL) ;
+ JR NZ,L11BF ; forward to SV-ARRAYS
+
+ INC A ;
+
+;; SV-SIMPLE$
+L11B2: INC HL ;
+ LD C,(HL) ;
+ INC HL ;
+ LD B,(HL) ;
+ INC HL ;
+ EX DE,HL ;
+ CALL L12C3 ; routine STK-STO-$
+
+ RST 18H ; GET-CHAR
+ JP L125A ; jump forward to SV-SLICE?
+
+; ---
+
+;; SV-ARRAYS
+L11BF: INC HL ;
+ INC HL ;
+ INC HL ;
+ LD B,(HL) ;
+ BIT 6,C ;
+ JR Z,L11D1 ; forward to SV-PTR
+
+ DEC B ;
+ JR Z,L11B2 ; forward to SV-SIMPLE$
+
+ EX DE,HL ;
+
+ RST 18H ; GET-CHAR
+ CP $10 ;
+ JR NZ,L1231 ; forward to REPORT-3
+
+ EX DE,HL ;
+
+;; SV-PTR
+L11D1: EX DE,HL ;
+ JR L11F8 ; forward to SV-COUNT
+
+; ---
+
+;; SV-COMMA
+L11D4: PUSH HL ;
+
+ RST 18H ; GET-CHAR
+ POP HL ;
+ CP $1A ;
+ JR Z,L11FB ; forward to SV-LOOP
+
+ BIT 7,C ;
+ JR Z,L1231 ; forward to REPORT-3
+
+ BIT 6,C ;
+ JR NZ,L11E9 ; forward to SV-CLOSE
+
+ CP $11 ;
+ JR NZ,L1223 ; forward to SV-RPT-C
+
+
+ RST 20H ; NEXT-CHAR
+ RET ;
+
+; ---
+
+;; SV-CLOSE
+L11E9: CP $11 ;
+ JR Z,L1259 ; forward to SV-DIM
+
+ CP $DF ;
+ JR NZ,L1223 ; forward to SV-RPT-C
+
+
+;; SV-CH-ADD
+L11F1: RST 18H ; GET-CHAR
+ DEC HL ;
+ LD ($4016),HL ; sv CH_ADD
+ JR L1256 ; forward to SV-SLICE
+
+; ---
+
+;; SV-COUNT
+L11F8: LD HL,$0000 ;
+
+;; SV-LOOP
+L11FB: PUSH HL ;
+
+ RST 20H ; NEXT-CHAR
+ POP HL ;
+ LD A,C ;
+ CP $C0 ;
+ JR NZ,L120C ; forward to SV-MULT
+
+
+ RST 18H ; GET-CHAR
+ CP $11 ;
+ JR Z,L1259 ; forward to SV-DIM
+
+ CP $DF ;
+ JR Z,L11F1 ; back to SV-CH-ADD
+
+;; SV-MULT
+L120C: PUSH BC ;
+ PUSH HL ;
+ CALL L12FF ; routine DE,(DE+1)
+ EX (SP),HL ;
+ EX DE,HL ;
+ CALL L12DD ; routine INT-EXP1
+ JR C,L1231 ; forward to REPORT-3
+
+ DEC BC ;
+ CALL L1305 ; routine GET-HL*DE
+ ADD HL,BC ;
+ POP DE ;
+ POP BC ;
+ DJNZ L11D4 ; loop back to SV-COMMA
+
+ BIT 7,C ;
+
+;; SV-RPT-C
+L1223: JR NZ,L128B ; relative jump to SL-RPT-C
+
+ PUSH HL ;
+ BIT 6,C ;
+ JR NZ,L123D ; forward to SV-ELEM$
+
+ LD B,D ;
+ LD C,E ;
+
+ RST 18H ; GET-CHAR
+ CP $11 ; is character a ')' ?
+ JR Z,L1233 ; skip forward to SV-NUMBER
+
+
+;; REPORT-3
+L1231: RST 08H ; ERROR-1
+ DEFB $02 ; Error Report: Subscript wrong
+
+
+;; SV-NUMBER
+L1233: RST 20H ; NEXT-CHAR
+ POP HL ;
+ LD DE,$0005 ;
+ CALL L1305 ; routine GET-HL*DE
+ ADD HL,BC ;
+ RET ; return >>
+
+; ---
+
+;; SV-ELEM$
+L123D: CALL L12FF ; routine DE,(DE+1)
+ EX (SP),HL ;
+ CALL L1305 ; routine GET-HL*DE
+ POP BC ;
+ ADD HL,BC ;
+ INC HL ;
+ LD B,D ;
+ LD C,E ;
+ EX DE,HL ;
+ CALL L12C2 ; routine STK-ST-0
+
+ RST 18H ; GET-CHAR
+ CP $11 ; is it ')' ?
+ JR Z,L1259 ; forward if so to SV-DIM
+
+ CP $1A ; is it ',' ?
+ JR NZ,L1231 ; back if not to REPORT-3
+
+;; SV-SLICE
+L1256: CALL L1263 ; routine SLICING
+
+;; SV-DIM
+L1259: RST 20H ; NEXT-CHAR
+
+;; SV-SLICE?
+L125A: CP $10 ;
+ JR Z,L1256 ; back to SV-SLICE
+
+ RES 6,(IY+$01) ; sv FLAGS - Signal string result
+ RET ; return.
+
+; ------------------------
+; THE 'SLICING' SUBROUTINE
+; ------------------------
+;
+;
+
+;; SLICING
+L1263: CALL L0DA6 ; routine SYNTAX-Z
+ CALL NZ,L13F8 ; routine STK-FETCH
+
+ RST 20H ; NEXT-CHAR
+ CP $11 ; is it ')' ?
+ JR Z,L12BE ; forward if so to SL-STORE
+
+ PUSH DE ;
+ XOR A ;
+ PUSH AF ;
+ PUSH BC ;
+ LD DE,$0001 ;
+
+ RST 18H ; GET-CHAR
+ POP HL ;
+ CP $DF ; is it 'TO' ?
+ JR Z,L1292 ; forward if so to SL-SECOND
+
+ POP AF ;
+ CALL L12DE ; routine INT-EXP2
+ PUSH AF ;
+ LD D,B ;
+ LD E,C ;
+ PUSH HL ;
+
+ RST 18H ; GET-CHAR
+ POP HL ;
+ CP $DF ; is it 'TO' ?
+ JR Z,L1292 ; forward if so to SL-SECOND
+
+ CP $11 ;
+
+;; SL-RPT-C
+L128B: JP NZ,L0D9A ; to REPORT-C
+
+ LD H,D ;
+ LD L,E ;
+ JR L12A5 ; forward to SL-DEFINE
+
+; ---
+
+;; SL-SECOND
+L1292: PUSH HL ;
+
+ RST 20H ; NEXT-CHAR
+ POP HL ;
+ CP $11 ; is it ')' ?
+ JR Z,L12A5 ; forward if so to SL-DEFINE
+
+ POP AF ;
+ CALL L12DE ; routine INT-EXP2
+ PUSH AF ;
+
+ RST 18H ; GET-CHAR
+ LD H,B ;
+ LD L,C ;
+ CP $11 ; is it ')' ?
+ JR NZ,L128B ; back if not to SL-RPT-C
+
+;; SL-DEFINE
+L12A5: POP AF ;
+ EX (SP),HL ;
+ ADD HL,DE ;
+ DEC HL ;
+ EX (SP),HL ;
+ AND A ;
+ SBC HL,DE ;
+ LD BC,$0000 ;
+ JR C,L12B9 ; forward to SL-OVER
+
+ INC HL ;
+ AND A ;
+ JP M,L1231 ; jump back to REPORT-3
+
+ LD B,H ;
+ LD C,L ;
+
+;; SL-OVER
+L12B9: POP DE ;
+ RES 6,(IY+$01) ; sv FLAGS - Signal string result
+
+;; SL-STORE
+L12BE: CALL L0DA6 ; routine SYNTAX-Z
+ RET Z ; return if checking syntax.
+
+; --------------------------
+; THE 'STK-STORE' SUBROUTINE
+; --------------------------
+;
+;
+
+;; STK-ST-0
+L12C2: XOR A ;
+
+;; STK-STO-$
+L12C3: PUSH BC ;
+ CALL L19EB ; routine TEST-5-SP
+ POP BC ;
+ LD HL,($401C) ; sv STKEND
+ LD (HL),A ;
+ INC HL ;
+ LD (HL),E ;
+ INC HL ;
+ LD (HL),D ;
+ INC HL ;
+ LD (HL),C ;
+ INC HL ;
+ LD (HL),B ;
+ INC HL ;
+ LD ($401C),HL ; sv STKEND
+ RES 6,(IY+$01) ; update FLAGS - signal string result
+ RET ; return.
+
+; -------------------------
+; THE 'INT EXP' SUBROUTINES
+; -------------------------
+;
+;
+
+;; INT-EXP1
+L12DD: XOR A ;
+
+;; INT-EXP2
+L12DE: PUSH DE ;
+ PUSH HL ;
+ PUSH AF ;
+ CALL L0D92 ; routine CLASS-6
+ POP AF ;
+ CALL L0DA6 ; routine SYNTAX-Z
+ JR Z,L12FC ; forward if checking syntax to I-RESTORE
+
+ PUSH AF ;
+ CALL L0EA7 ; routine FIND-INT
+ POP DE ;
+ LD A,B ;
+ OR C ;
+ SCF ; Set Carry Flag
+ JR Z,L12F9 ; forward to I-CARRY
+
+ POP HL ;
+ PUSH HL ;
+ AND A ;
+ SBC HL,BC ;
+
+;; I-CARRY
+L12F9: LD A,D ;
+ SBC A,$00 ;
+
+;; I-RESTORE
+L12FC: POP HL ;
+ POP DE ;
+ RET ;
+
+; --------------------------
+; THE 'DE,(DE+1)' SUBROUTINE
+; --------------------------
+; INDEX and LOAD Z80 subroutine.
+; This emulates the 6800 processor instruction LDX 1,X which loads a two-byte
+; value from memory into the register indexing it. Often these are hardly worth
+; the bother of writing as subroutines and this one doesn't save any time or
+; memory. The timing and space overheads have to be offset against the ease of
+; writing and the greater program readability from using such toolkit routines.
+
+;; DE,(DE+1)
+L12FF: EX DE,HL ; move index address into HL.
+ INC HL ; increment to address word.
+ LD E,(HL) ; pick up word low-order byte.
+ INC HL ; index high-order byte and
+ LD D,(HL) ; pick it up.
+ RET ; return with DE = word.
+
+; --------------------------
+; THE 'GET-HL*DE' SUBROUTINE
+; --------------------------
+;
+
+;; GET-HL*DE
+L1305: CALL L0DA6 ; routine SYNTAX-Z
+ RET Z ;
+
+ PUSH BC ;
+ LD B,$10 ;
+ LD A,H ;
+ LD C,L ;
+ LD HL,$0000 ;
+
+;; HL-LOOP
+L1311: ADD HL,HL ;
+ JR C,L131A ; forward with carry to HL-END
+
+ RL C ;
+ RLA ;
+ JR NC,L131D ; forward with no carry to HL-AGAIN
+
+ ADD HL,DE ;
+
+;; HL-END
+L131A: JP C,L0ED3 ; to REPORT-4
+
+;; HL-AGAIN
+L131D: DJNZ L1311 ; loop back to HL-LOOP
+
+ POP BC ;
+ RET ; return.
+
+; --------------------
+; THE 'LET' SUBROUTINE
+; --------------------
+;
+;
+
+;; LET
+L1321: LD HL,($4012) ; sv DEST-lo
+ BIT 1,(IY+$2D) ; sv FLAGX
+ JR Z,L136E ; forward to L-EXISTS
+
+ LD BC,$0005 ;
+
+;; L-EACH-CH
+L132D: INC BC ;
+
+; check
+
+;; L-NO-SP
+L132E: INC HL ;
+ LD A,(HL) ;
+ AND A ;
+ JR Z,L132E ; back to L-NO-SP
+
+ CALL L14D2 ; routine ALPHANUM
+ JR C,L132D ; back to L-EACH-CH
+
+ CP $0D ; is it '$' ?
+ JP Z,L13C8 ; forward if so to L-NEW$
+
+
+ RST 30H ; BC-SPACES
+ PUSH DE ;
+ LD HL,($4012) ; sv DEST
+ DEC DE ;
+ LD A,C ;
+ SUB $06 ;
+ LD B,A ;
+ LD A,$40 ;
+ JR Z,L1359 ; forward to L-SINGLE
+
+;; L-CHAR
+L134B: INC HL ;
+ LD A,(HL) ;
+ AND A ; is it a space ?
+ JR Z,L134B ; back to L-CHAR
+
+ INC DE ;
+ LD (DE),A ;
+ DJNZ L134B ; loop back to L-CHAR
+
+ OR $80 ;
+ LD (DE),A ;
+ LD A,$80 ;
+
+;; L-SINGLE
+L1359: LD HL,($4012) ; sv DEST-lo
+ XOR (HL) ;
+ POP HL ;
+ CALL L13E7 ; routine L-FIRST
+
+;; L-NUMERIC
+L1361: PUSH HL ;
+
+ RST 28H ;; FP-CALC
+ DEFB $02 ;;delete
+ DEFB $34 ;;end-calc
+
+ POP HL ;
+ LD BC,$0005 ;
+ AND A ;
+ SBC HL,BC ;
+ JR L13AE ; forward to L-ENTER
+
+; ---
+
+;; L-EXISTS
+L136E: BIT 6,(IY+$01) ; sv FLAGS - Numeric or string result?
+ JR Z,L137A ; forward to L-DELETE$
+
+ LD DE,$0006 ;
+ ADD HL,DE ;
+ JR L1361 ; back to L-NUMERIC
+
+; ---
+
+;; L-DELETE$
+L137A: LD HL,($4012) ; sv DEST-lo
+ LD BC,($402E) ; sv STRLEN_lo
+ BIT 0,(IY+$2D) ; sv FLAGX
+ JR NZ,L13B7 ; forward to L-ADD$
+
+ LD A,B ;
+ OR C ;
+ RET Z ;
+
+ PUSH HL ;
+
+ RST 30H ; BC-SPACES
+ PUSH DE ;
+ PUSH BC ;
+ LD D,H ;
+ LD E,L ;
+ INC HL ;
+ LD (HL),$00 ;
+ LDDR ; Copy Bytes
+ PUSH HL ;
+ CALL L13F8 ; routine STK-FETCH
+ POP HL ;
+ EX (SP),HL ;
+ AND A ;
+ SBC HL,BC ;
+ ADD HL,BC ;
+ JR NC,L13A3 ; forward to L-LENGTH
+
+ LD B,H ;
+ LD C,L ;
+
+;; L-LENGTH
+L13A3: EX (SP),HL ;
+ EX DE,HL ;
+ LD A,B ;
+ OR C ;
+ JR Z,L13AB ; forward if zero to L-IN-W/S
+
+ LDIR ; Copy Bytes
+
+;; L-IN-W/S
+L13AB: POP BC ;
+ POP DE ;
+ POP HL ;
+
+; ------------------------
+; THE 'L-ENTER' SUBROUTINE
+; ------------------------
+;
+
+;; L-ENTER
+L13AE: EX DE,HL ;
+ LD A,B ;
+ OR C ;
+ RET Z ;
+
+ PUSH DE ;
+ LDIR ; Copy Bytes
+ POP HL ;
+ RET ; return.
+
+; ---
+
+;; L-ADD$
+L13B7: DEC HL ;
+ DEC HL ;
+ DEC HL ;
+ LD A,(HL) ;
+ PUSH HL ;
+ PUSH BC ;
+
+ CALL L13CE ; routine L-STRING
+
+ POP BC ;
+ POP HL ;
+ INC BC ;
+ INC BC ;
+ INC BC ;
+ JP L0A60 ; jump back to exit via RECLAIM-2
+
+; ---
+
+;; L-NEW$
+L13C8: LD A,$60 ; prepare mask %01100000
+ LD HL,($4012) ; sv DEST-lo
+ XOR (HL) ;
+
+; -------------------------
+; THE 'L-STRING' SUBROUTINE
+; -------------------------
+;
+
+;; L-STRING
+L13CE: PUSH AF ;
+ CALL L13F8 ; routine STK-FETCH
+ EX DE,HL ;
+ ADD HL,BC ;
+ PUSH HL ;
+ INC BC ;
+ INC BC ;
+ INC BC ;
+
+ RST 30H ; BC-SPACES
+ EX DE,HL ;
+ POP HL ;
+ DEC BC ;
+ DEC BC ;
+ PUSH BC ;
+ LDDR ; Copy Bytes
+ EX DE,HL ;
+ POP BC ;
+ DEC BC ;
+ LD (HL),B ;
+ DEC HL ;
+ LD (HL),C ;
+ POP AF ;
+
+;; L-FIRST
+L13E7: PUSH AF ;
+ CALL L14C7 ; routine REC-V80
+ POP AF ;
+ DEC HL ;
+ LD (HL),A ;
+ LD HL,($401A) ; sv STKBOT_lo
+ LD ($4014),HL ; sv E_LINE_lo
+ DEC HL ;
+ LD (HL),$80 ;
+ RET ;
+
+; --------------------------
+; THE 'STK-FETCH' SUBROUTINE
+; --------------------------
+; This routine fetches a five-byte value from the calculator stack
+; reducing the pointer to the end of the stack by five.
+; For a floating-point number the exponent is in A and the mantissa
+; is the thirty-two bits EDCB.
+; For strings, the start of the string is in DE and the length in BC.
+; A is unused.
+
+;; STK-FETCH
+L13F8: LD HL,($401C) ; load HL from system variable STKEND
+
+ DEC HL ;
+ LD B,(HL) ;
+ DEC HL ;
+ LD C,(HL) ;
+ DEC HL ;
+ LD D,(HL) ;
+ DEC HL ;
+ LD E,(HL) ;
+ DEC HL ;
+ LD A,(HL) ;
+
+ LD ($401C),HL ; set system variable STKEND to lower value.
+ RET ; return.
+
+; -------------------------
+; THE 'DIM' COMMAND ROUTINE
+; -------------------------
+; An array is created and initialized to zeros which is also the space
+; character on the ZX81.
+
+;; DIM
+L1409: CALL L111C ; routine LOOK-VARS
+
+;; D-RPORT-C
+L140C: JP NZ,L0D9A ; to REPORT-C
+
+ CALL L0DA6 ; routine SYNTAX-Z
+ JR NZ,L141C ; forward to D-RUN
+
+ RES 6,C ;
+ CALL L11A7 ; routine STK-VAR
+ CALL L0D1D ; routine CHECK-END
+
+;; D-RUN
+L141C: JR C,L1426 ; forward to D-LETTER
+
+ PUSH BC ;
+ CALL L09F2 ; routine NEXT-ONE
+ CALL L0A60 ; routine RECLAIM-2
+ POP BC ;
+
+;; D-LETTER
+L1426: SET 7,C ;
+ LD B,$00 ;
+ PUSH BC ;
+ LD HL,$0001 ;
+ BIT 6,C ;
+ JR NZ,L1434 ; forward to D-SIZE
+
+ LD L,$05 ;
+
+;; D-SIZE
+L1434: EX DE,HL ;
+
+;; D-NO-LOOP
+L1435: RST 20H ; NEXT-CHAR
+ LD H,$40 ;
+ CALL L12DD ; routine INT-EXP1
+ JP C,L1231 ; jump back to REPORT-3
+
+ POP HL ;
+ PUSH BC ;
+ INC H ;
+ PUSH HL ;
+ LD H,B ;
+ LD L,C ;
+ CALL L1305 ; routine GET-HL*DE
+ EX DE,HL ;
+
+ RST 18H ; GET-CHAR
+ CP $1A ;
+ JR Z,L1435 ; back to D-NO-LOOP
+
+ CP $11 ; is it ')' ?
+ JR NZ,L140C ; back if not to D-RPORT-C
+
+
+ RST 20H ; NEXT-CHAR
+ POP BC ;
+ LD A,C ;
+ LD L,B ;
+ LD H,$00 ;
+ INC HL ;
+ INC HL ;
+ ADD HL,HL ;
+ ADD HL,DE ;
+ JP C,L0ED3 ; jump to REPORT-4
+
+ PUSH DE ;
+ PUSH BC ;
+ PUSH HL ;
+ LD B,H ;
+ LD C,L ;
+ LD HL,($4014) ; sv E_LINE_lo
+ DEC HL ;
+ CALL L099E ; routine MAKE-ROOM
+ INC HL ;
+ LD (HL),A ;
+ POP BC ;
+ DEC BC ;
+ DEC BC ;
+ DEC BC ;
+ INC HL ;
+ LD (HL),C ;
+ INC HL ;
+ LD (HL),B ;
+ POP AF ;
+ INC HL ;
+ LD (HL),A ;
+ LD H,D ;
+ LD L,E ;
+ DEC DE ;
+ LD (HL),$00 ;
+ POP BC ;
+ LDDR ; Copy Bytes
+
+;; DIM-SIZES
+L147F: POP BC ;
+ LD (HL),B ;
+ DEC HL ;
+ LD (HL),C ;
+ DEC HL ;
+ DEC A ;
+ JR NZ,L147F ; back to DIM-SIZES
+
+ RET ; return.
+
+; ---------------------
+; THE 'RESERVE' ROUTINE
+; ---------------------
+;
+;
+
+;; RESERVE
+L1488: LD HL,($401A) ; address STKBOT
+ DEC HL ; now last byte of workspace
+ CALL L099E ; routine MAKE-ROOM
+ INC HL ;
+ INC HL ;
+ POP BC ;
+ LD ($4014),BC ; sv E_LINE_lo
+ POP BC ;
+ EX DE,HL ;
+ INC HL ;
+ RET ;
+
+; ---------------------------
+; THE 'CLEAR' COMMAND ROUTINE
+; ---------------------------
+;
+;
+
+;; CLEAR
+L149A: LD HL,($4010) ; sv VARS_lo
+ LD (HL),$80 ;
+ INC HL ;
+ LD ($4014),HL ; sv E_LINE_lo
+
+; -----------------------
+; THE 'X-TEMP' SUBROUTINE
+; -----------------------
+;
+;
+
+;; X-TEMP
+L14A3: LD HL,($4014) ; sv E_LINE_lo
+
+; ----------------------
+; THE 'SET-STK' ROUTINES
+; ----------------------
+;
+;
+
+;; SET-STK-B
+L14A6: LD ($401A),HL ; sv STKBOT
+
+;
+
+;; SET-STK-E
+L14A9: LD ($401C),HL ; sv STKEND
+ RET ;
+
+; -----------------------
+; THE 'CURSOR-IN' ROUTINE
+; -----------------------
+; This routine is called to set the edit line to the minimum cursor/newline
+; and to set STKEND, the start of free space, at the next position.
+
+;; CURSOR-IN
+L14AD: LD HL,($4014) ; fetch start of edit line from E_LINE
+ LD (HL),$7F ; insert cursor character
+
+ INC HL ; point to next location.
+ LD (HL),$76 ; insert NEWLINE character
+ INC HL ; point to next free location.
+
+ LD (IY+$22),$02 ; set lower screen display file size DF_SZ
+
+ JR L14A6 ; exit via SET-STK-B above
+
+; ------------------------
+; THE 'SET-MIN' SUBROUTINE
+; ------------------------
+;
+;
+
+;; SET-MIN
+L14BC: LD HL,$405D ; normal location of calculator's memory area
+ LD ($401F),HL ; update system variable MEM
+ LD HL,($401A) ; fetch STKBOT
+ JR L14A9 ; back to SET-STK-E
+
+
+; ------------------------------------
+; THE 'RECLAIM THE END-MARKER' ROUTINE
+; ------------------------------------
+
+;; REC-V80
+L14C7: LD DE,($4014) ; sv E_LINE_lo
+ JP L0A5D ; to RECLAIM-1
+
+; ----------------------
+; THE 'ALPHA' SUBROUTINE
+; ----------------------
+
+;; ALPHA
+L14CE: CP $26 ;
+ JR L14D4 ; skip forward to ALPHA-2
+
+
+; -------------------------
+; THE 'ALPHANUM' SUBROUTINE
+; -------------------------
+
+;; ALPHANUM
+L14D2: CP $1C ;
+
+
+;; ALPHA-2
+L14D4: CCF ; Complement Carry Flag
+ RET NC ;
+
+ CP $40 ;
+ RET ;
+
+
+; ------------------------------------------
+; THE 'DECIMAL TO FLOATING POINT' SUBROUTINE
+; ------------------------------------------
+;
+
+;; DEC-TO-FP
+L14D9: CALL L1548 ; routine INT-TO-FP gets first part
+ CP $1B ; is character a '.' ?
+ JR NZ,L14F5 ; forward if not to E-FORMAT
+
+
+ RST 28H ;; FP-CALC
+ DEFB $A1 ;;stk-one
+ DEFB $C0 ;;st-mem-0
+ DEFB $02 ;;delete
+ DEFB $34 ;;end-calc
+
+
+;; NXT-DGT-1
+L14E5: RST 20H ; NEXT-CHAR
+ CALL L1514 ; routine STK-DIGIT
+ JR C,L14F5 ; forward to E-FORMAT
+
+
+ RST 28H ;; FP-CALC
+ DEFB $E0 ;;get-mem-0
+ DEFB $A4 ;;stk-ten
+ DEFB $05 ;;division
+ DEFB $C0 ;;st-mem-0
+ DEFB $04 ;;multiply
+ DEFB $0F ;;addition
+ DEFB $34 ;;end-calc
+
+ JR L14E5 ; loop back till exhausted to NXT-DGT-1
+
+; ---
+
+;; E-FORMAT
+L14F5: CP $2A ; is character 'E' ?
+ RET NZ ; return if not
+
+ LD (IY+$5D),$FF ; initialize sv MEM-0-1st to $FF TRUE
+
+ RST 20H ; NEXT-CHAR
+ CP $15 ; is character a '+' ?
+ JR Z,L1508 ; forward if so to SIGN-DONE
+
+ CP $16 ; is it a '-' ?
+ JR NZ,L1509 ; forward if not to ST-E-PART
+
+ INC (IY+$5D) ; sv MEM-0-1st change to FALSE
+
+;; SIGN-DONE
+L1508: RST 20H ; NEXT-CHAR
+
+;; ST-E-PART
+L1509: CALL L1548 ; routine INT-TO-FP
+
+ RST 28H ;; FP-CALC m, e.
+ DEFB $E0 ;;get-mem-0 m, e, (1/0) TRUE/FALSE
+ DEFB $00 ;;jump-true
+ DEFB $02 ;;to L1511, E-POSTVE
+ DEFB $18 ;;neg m, -e
+
+;; E-POSTVE
+L1511: DEFB $38 ;;e-to-fp x.
+ DEFB $34 ;;end-calc x.
+
+ RET ; return.
+
+
+; --------------------------
+; THE 'STK-DIGIT' SUBROUTINE
+; --------------------------
+;
+
+;; STK-DIGIT
+L1514: CP $1C ;
+ RET C ;
+
+ CP $26 ;
+ CCF ; Complement Carry Flag
+ RET C ;
+
+ SUB $1C ;
+
+; ------------------------
+; THE 'STACK-A' SUBROUTINE
+; ------------------------
+;
+
+
+;; STACK-A
+L151D: LD C,A ;
+ LD B,$00 ;
+
+; -------------------------
+; THE 'STACK-BC' SUBROUTINE
+; -------------------------
+; The ZX81 does not have an integer number format so the BC register contents
+; must be converted to their full floating-point form.
+
+;; STACK-BC
+L1520: LD IY,$4000 ; re-initialize the system variables pointer.
+ PUSH BC ; save the integer value.
+
+; now stack zero, five zero bytes as a starting point.
+
+ RST 28H ;; FP-CALC
+ DEFB $A0 ;;stk-zero 0.
+ DEFB $34 ;;end-calc
+
+ POP BC ; restore integer value.
+
+ LD (HL),$91 ; place $91 in exponent 65536.
+ ; this is the maximum possible value
+
+ LD A,B ; fetch hi-byte.
+ AND A ; test for zero.
+ JR NZ,L1536 ; forward if not zero to STK-BC-2
+
+ LD (HL),A ; else make exponent zero again
+ OR C ; test lo-byte
+ RET Z ; return if BC was zero - done.
+
+; else there has to be a set bit if only the value one.
+
+ LD B,C ; save C in B.
+ LD C,(HL) ; fetch zero to C
+ LD (HL),$89 ; make exponent $89 256.
+
+;; STK-BC-2
+L1536: DEC (HL) ; decrement exponent - halving number
+ SLA C ; C<-76543210<-0
+ RL B ; C<-76543210<-C
+ JR NC,L1536 ; loop back if no carry to STK-BC-2
+
+ SRL B ; 0->76543210->C
+ RR C ; C->76543210->C
+
+ INC HL ; address first byte of mantissa
+ LD (HL),B ; insert B
+ INC HL ; address second byte of mantissa
+ LD (HL),C ; insert C
+
+ DEC HL ; point to the
+ DEC HL ; exponent again
+ RET ; return.
+
+; ------------------------------------------
+; THE 'INTEGER TO FLOATING POINT' SUBROUTINE
+; ------------------------------------------
+;
+;
+
+;; INT-TO-FP
+L1548: PUSH AF ;
+
+ RST 28H ;; FP-CALC
+ DEFB $A0 ;;stk-zero
+ DEFB $34 ;;end-calc
+
+ POP AF ;
+
+;; NXT-DGT-2
+L154D: CALL L1514 ; routine STK-DIGIT
+ RET C ;
+
+
+ RST 28H ;; FP-CALC
+ DEFB $01 ;;exchange
+ DEFB $A4 ;;stk-ten
+ DEFB $04 ;;multiply
+ DEFB $0F ;;addition
+ DEFB $34 ;;end-calc
+
+
+ RST 20H ; NEXT-CHAR
+ JR L154D ; to NXT-DGT-2
+
+
+; -------------------------------------------
+; THE 'E-FORMAT TO FLOATING POINT' SUBROUTINE
+; -------------------------------------------
+; (Offset $38: 'e-to-fp')
+; invoked from DEC-TO-FP and PRINT-FP.
+; e.g. 2.3E4 is 23000.
+; This subroutine evaluates xEm where m is a positive or negative integer.
+; At a simple level x is multiplied by ten for every unit of m.
+; If the decimal exponent m is negative then x is divided by ten for each unit.
+; A short-cut is taken if the exponent is greater than seven and in this
+; case the exponent is reduced by seven and the value is multiplied or divided
+; by ten million.
+; Note. for the ZX Spectrum an even cleverer method was adopted which involved
+; shifting the bits out of the exponent so the result was achieved with six
+; shifts at most. The routine below had to be completely re-written mostly
+; in Z80 machine code.
+; Although no longer operable, the calculator literal was retained for old
+; times sake, the routine being invoked directly from a machine code CALL.
+;
+; On entry in the ZX81, m, the exponent, is the 'last value', and the
+; floating-point decimal mantissa is beneath it.
+
+
+;; e-to-fp
+L155A: RST 28H ;; FP-CALC x, m.
+ DEFB $2D ;;duplicate x, m, m.
+ DEFB $32 ;;less-0 x, m, (1/0).
+ DEFB $C0 ;;st-mem-0 x, m, (1/0).
+ DEFB $02 ;;delete x, m.
+ DEFB $27 ;;abs x, +m.
+
+;; E-LOOP
+L1560: DEFB $A1 ;;stk-one x, m,1.
+ DEFB $03 ;;subtract x, m-1.
+ DEFB $2D ;;duplicate x, m-1,m-1.
+ DEFB $32 ;;less-0 x, m-1, (1/0).
+ DEFB $00 ;;jump-true x, m-1.
+ DEFB $22 ;;to L1587, E-END x, m-1.
+
+ DEFB $2D ;;duplicate x, m-1, m-1.
+ DEFB $30 ;;stk-data
+ DEFB $33 ;;Exponent: $83, Bytes: 1
+
+ DEFB $40 ;;(+00,+00,+00) x, m-1, m-1, 6.
+ DEFB $03 ;;subtract x, m-1, m-7.
+ DEFB $2D ;;duplicate x, m-1, m-7, m-7.
+ DEFB $32 ;;less-0 x, m-1, m-7, (1/0).
+ DEFB $00 ;;jump-true x, m-1, m-7.
+ DEFB $0C ;;to L157A, E-LOW
+
+; but if exponent m is higher than 7 do a bigger chunk.
+; multiplying (or dividing if negative) by 10 million - 1e7.
+
+ DEFB $01 ;;exchange x, m-7, m-1.
+ DEFB $02 ;;delete x, m-7.
+ DEFB $01 ;;exchange m-7, x.
+ DEFB $30 ;;stk-data
+ DEFB $80 ;;Bytes: 3
+ DEFB $48 ;;Exponent $98
+ DEFB $18,$96,$80 ;;(+00) m-7, x, 10,000,000 (=f)
+ DEFB $2F ;;jump
+ DEFB $04 ;;to L157D, E-CHUNK
+
+; ---
+
+;; E-LOW
+L157A: DEFB $02 ;;delete x, m-1.
+ DEFB $01 ;;exchange m-1, x.
+ DEFB $A4 ;;stk-ten m-1, x, 10 (=f).
+
+;; E-CHUNK
+L157D: DEFB $E0 ;;get-mem-0 m-1, x, f, (1/0)
+ DEFB $00 ;;jump-true m-1, x, f
+ DEFB $04 ;;to L1583, E-DIVSN
+
+ DEFB $04 ;;multiply m-1, x*f.
+ DEFB $2F ;;jump
+ DEFB $02 ;;to L1584, E-SWAP
+
+; ---
+
+;; E-DIVSN
+L1583: DEFB $05 ;;division m-1, x/f (= new x).
+
+;; E-SWAP
+L1584: DEFB $01 ;;exchange x, m-1 (= new m).
+ DEFB $2F ;;jump x, m.
+ DEFB $DA ;;to L1560, E-LOOP
+
+; ---
+
+;; E-END
+L1587: DEFB $02 ;;delete x. (-1)
+ DEFB $34 ;;end-calc x.
+
+ RET ; return.
+
+; -------------------------------------
+; THE 'FLOATING-POINT TO BC' SUBROUTINE
+; -------------------------------------
+; The floating-point form on the calculator stack is compressed directly into
+; the BC register rounding up if necessary.
+; Valid range is 0 to 65535.4999
+
+;; FP-TO-BC
+L158A: CALL L13F8 ; routine STK-FETCH - exponent to A
+ ; mantissa to EDCB.
+ AND A ; test for value zero.
+ JR NZ,L1595 ; forward if not to FPBC-NZRO
+
+; else value is zero
+
+ LD B,A ; zero to B
+ LD C,A ; also to C
+ PUSH AF ; save the flags on machine stack
+ JR L15C6 ; forward to FPBC-END
+
+; ---
+
+; EDCB => BCE
+
+;; FPBC-NZRO
+L1595: LD B,E ; transfer the mantissa from EDCB
+ LD E,C ; to BCE. Bit 7 of E is the 17th bit which
+ LD C,D ; will be significant for rounding if the
+ ; number is already normalized.
+
+ SUB $91 ; subtract 65536
+ CCF ; complement carry flag
+ BIT 7,B ; test sign bit
+ PUSH AF ; push the result
+
+ SET 7,B ; set the implied bit
+ JR C,L15C6 ; forward with carry from SUB/CCF to FPBC-END
+ ; number is too big.
+
+ INC A ; increment the exponent and
+ NEG ; negate to make range $00 - $0F
+
+ CP $08 ; test if one or two bytes
+ JR C,L15AF ; forward with two to BIG-INT
+
+ LD E,C ; shift mantissa
+ LD C,B ; 8 places right
+ LD B,$00 ; insert a zero in B
+ SUB $08 ; reduce exponent by eight
+
+;; BIG-INT
+L15AF: AND A ; test the exponent
+ LD D,A ; save exponent in D.
+
+ LD A,E ; fractional bits to A
+ RLCA ; rotate most significant bit to carry for
+ ; rounding of an already normal number.
+
+ JR Z,L15BC ; forward if exponent zero to EXP-ZERO
+ ; the number is normalized
+
+;; FPBC-NORM
+L15B5: SRL B ; 0->76543210->C
+ RR C ; C->76543210->C
+
+ DEC D ; decrement exponent
+
+ JR NZ,L15B5 ; loop back till zero to FPBC-NORM
+
+;; EXP-ZERO
+L15BC: JR NC,L15C6 ; forward without carry to NO-ROUND
+
+ INC BC ; round up.
+ LD A,B ; test result
+ OR C ; for zero
+ JR NZ,L15C6 ; forward if not to GRE-ZERO
+
+ POP AF ; restore sign flag
+ SCF ; set carry flag to indicate overflow
+ PUSH AF ; save combined flags again
+
+;; FPBC-END
+L15C6: PUSH BC ; save BC value
+
+; set HL and DE to calculator stack pointers.
+
+ RST 28H ;; FP-CALC
+ DEFB $34 ;;end-calc
+
+
+ POP BC ; restore BC value
+ POP AF ; restore flags
+ LD A,C ; copy low byte to A also.
+ RET ; return
+
+; ------------------------------------
+; THE 'FLOATING-POINT TO A' SUBROUTINE
+; ------------------------------------
+;
+;
+
+;; FP-TO-A
+L15CD: CALL L158A ; routine FP-TO-BC
+ RET C ;
+
+ PUSH AF ;
+ DEC B ;
+ INC B ;
+ JR Z,L15D9 ; forward if in range to FP-A-END
+
+ POP AF ; fetch result
+ SCF ; set carry flag signaling overflow
+ RET ; return
+
+;; FP-A-END
+L15D9: POP AF ;
+ RET ;
+
+
+; ----------------------------------------------
+; THE 'PRINT A FLOATING-POINT NUMBER' SUBROUTINE
+; ----------------------------------------------
+; prints 'last value' x on calculator stack.
+; There are a wide variety of formats see Chapter 4.
+; e.g.
+; PI prints as 3.1415927
+; .123 prints as 0.123
+; .0123 prints as .0123
+; 999999999999 prints as 1000000000000
+; 9876543210123 prints as 9876543200000
+
+; Begin by isolating zero and just printing the '0' character
+; for that case. For negative numbers print a leading '-' and
+; then form the absolute value of x.
+
+;; PRINT-FP
+L15DB: RST 28H ;; FP-CALC x.
+ DEFB $2D ;;duplicate x, x.
+ DEFB $32 ;;less-0 x, (1/0).
+ DEFB $00 ;;jump-true
+ DEFB $0B ;;to L15EA, PF-NGTVE x.
+
+ DEFB $2D ;;duplicate x, x
+ DEFB $33 ;;greater-0 x, (1/0).
+ DEFB $00 ;;jump-true
+ DEFB $0D ;;to L15F0, PF-POSTVE x.
+
+ DEFB $02 ;;delete .
+ DEFB $34 ;;end-calc .
+
+ LD A,$1C ; load accumulator with character '0'
+
+ RST 10H ; PRINT-A
+ RET ; return. >>
+
+; ---
+
+;; PF-NEGTVE
+L15EA: DEFB $27 ; abs +x.
+ DEFB $34 ;;end-calc x.
+
+ LD A,$16 ; load accumulator with '-'
+
+ RST 10H ; PRINT-A
+
+ RST 28H ;; FP-CALC x.
+
+;; PF-POSTVE
+L15F0: DEFB $34 ;;end-calc x.
+
+; register HL addresses the exponent of the floating-point value.
+; if positive, and point floats to left, then bit 7 is set.
+
+ LD A,(HL) ; pick up the exponent byte
+ CALL L151D ; routine STACK-A places on calculator stack.
+
+; now calculate roughly the number of digits, n, before the decimal point by
+; subtracting a half from true exponent and multiplying by log to
+; the base 10 of 2.
+; The true number could be one higher than n, the integer result.
+
+ RST 28H ;; FP-CALC x, e.
+ DEFB $30 ;;stk-data
+ DEFB $78 ;;Exponent: $88, Bytes: 2
+ DEFB $00,$80 ;;(+00,+00) x, e, 128.5.
+ DEFB $03 ;;subtract x, e -.5.
+ DEFB $30 ;;stk-data
+ DEFB $EF ;;Exponent: $7F, Bytes: 4
+ DEFB $1A,$20,$9A,$85 ;; .30103 (log10 2)
+ DEFB $04 ;;multiply x,
+ DEFB $24 ;;int
+ DEFB $C1 ;;st-mem-1 x, n.
+
+
+ DEFB $30 ;;stk-data
+ DEFB $34 ;;Exponent: $84, Bytes: 1
+ DEFB $00 ;;(+00,+00,+00) x, n, 8.
+
+ DEFB $03 ;;subtract x, n-8.
+ DEFB $18 ;;neg x, 8-n.
+ DEFB $38 ;;e-to-fp x * (10^n)
+
+; finally the 8 or 9 digit decimal is rounded.
+; a ten-digit integer can arise in the case of, say, 999999999.5
+; which gives 1000000000.
+
+ DEFB $A2 ;;stk-half
+ DEFB $0F ;;addition
+ DEFB $24 ;;int i.
+ DEFB $34 ;;end-calc
+
+; If there were 8 digits then final rounding will take place on the calculator
+; stack above and the next two instructions insert a masked zero so that
+; no further rounding occurs. If the result is a 9 digit integer then
+; rounding takes place within the buffer.
+
+ LD HL,$406B ; address system variable MEM-2-5th
+ ; which could be the 'ninth' digit.
+ LD (HL),$90 ; insert the value $90 10010000
+
+; now starting from lowest digit lay down the 8, 9 or 10 digit integer
+; which represents the significant portion of the number
+; e.g. PI will be the nine-digit integer 314159265
+
+ LD B,$0A ; count is ten digits.
+
+;; PF-LOOP
+L1615: INC HL ; increase pointer
+
+ PUSH HL ; preserve buffer address.
+ PUSH BC ; preserve counter.
+
+ RST 28H ;; FP-CALC i.
+ DEFB $A4 ;;stk-ten i, 10.
+ DEFB $2E ;;n-mod-m i mod 10, i/10
+ DEFB $01 ;;exchange i/10, remainder.
+ DEFB $34 ;;end-calc
+
+ CALL L15CD ; routine FP-TO-A $00-$09
+
+ OR $90 ; make left hand nibble 9
+
+ POP BC ; restore counter
+ POP HL ; restore buffer address.
+
+ LD (HL),A ; insert masked digit in buffer.
+ DJNZ L1615 ; loop back for all ten to PF-LOOP
+
+; the most significant digit will be last but if the number is exhausted then
+; the last one or two positions will contain zero ($90).
+
+; e.g. for 'one' we have zero as estimate of leading digits.
+; 1*10^8 100000000 as integer value
+; 90 90 90 90 90 90 90 90 91 90 as buffer mem3/mem4 contents.
+
+
+ INC HL ; advance pointer to one past buffer
+ LD BC,$0008 ; set C to 8 ( B is already zero )
+ PUSH HL ; save pointer.
+
+;; PF-NULL
+L162C: DEC HL ; decrease pointer
+ LD A,(HL) ; fetch masked digit
+ CP $90 ; is it a leading zero ?
+ JR Z,L162C ; loop back if so to PF-NULL
+
+; at this point a significant digit has been found. carry is reset.
+
+ SBC HL,BC ; subtract eight from the address.
+ PUSH HL ; ** save this pointer too
+ LD A,(HL) ; fetch addressed byte
+ ADD A,$6B ; add $6B - forcing a round up ripple
+ ; if $95 or over.
+ PUSH AF ; save the carry result.
+
+; now enter a loop to round the number. After rounding has been considered
+; a zero that has arisen from rounding or that was present at that position
+; originally is changed from $90 to $80.
+
+;; PF-RND-LP
+L1639: POP AF ; retrieve carry from machine stack.
+ INC HL ; increment address
+ LD A,(HL) ; fetch new byte
+ ADC A,$00 ; add in any carry
+
+ DAA ; decimal adjust accumulator
+ ; carry will ripple through the '9'
+
+ PUSH AF ; save carry on machine stack.
+ AND $0F ; isolate character 0 - 9 AND set zero flag
+ ; if zero.
+ LD (HL),A ; place back in location.
+ SET 7,(HL) ; set bit 7 to show printable.
+ ; but not if trailing zero after decimal point.
+ JR Z,L1639 ; back if a zero to PF-RND-LP
+ ; to consider further rounding and/or trailing
+ ; zero identification.
+
+ POP AF ; balance stack
+ POP HL ; ** retrieve lower pointer
+
+; now insert 6 trailing zeros which are printed if before the decimal point
+; but mark the end of printing if after decimal point.
+; e.g. 9876543210123 is printed as 9876543200000
+; 123.456001 is printed as 123.456
+
+ LD B,$06 ; the count is six.
+
+;; PF-ZERO-6
+L164B: LD (HL),$80 ; insert a masked zero
+ DEC HL ; decrease pointer.
+ DJNZ L164B ; loop back for all six to PF-ZERO-6
+
+; n-mod-m reduced the number to zero and this is now deleted from the calculator
+; stack before fetching the original estimate of leading digits.
+
+
+ RST 28H ;; FP-CALC 0.
+ DEFB $02 ;;delete .
+ DEFB $E1 ;;get-mem-1 n.
+ DEFB $34 ;;end-calc n.
+
+ CALL L15CD ; routine FP-TO-A
+ JR Z,L165B ; skip forward if positive to PF-POS
+
+ NEG ; negate makes positive
+
+;; PF-POS
+L165B: LD E,A ; transfer count of digits to E
+ INC E ; increment twice
+ INC E ;
+ POP HL ; * retrieve pointer to one past buffer.
+
+;; GET-FIRST
+L165F: DEC HL ; decrement address.
+ DEC E ; decrement digit counter.
+ LD A,(HL) ; fetch masked byte.
+ AND $0F ; isolate right-hand nibble.
+ JR Z,L165F ; back with leading zero to GET-FIRST
+
+; now determine if E-format printing is needed
+
+ LD A,E ; transfer now accurate number count to A.
+ SUB $05 ; subtract five
+ CP $08 ; compare with 8 as maximum digits is 13.
+ JP P,L1682 ; forward if positive to PF-E-FMT
+
+ CP $F6 ; test for more than four zeros after point.
+ JP M,L1682 ; forward if so to PF-E-FMT
+
+ ADD A,$06 ; test for zero leading digits, e.g. 0.5
+ JR Z,L16BF ; forward if so to PF-ZERO-1
+
+ JP M,L16B2 ; forward if more than one zero to PF-ZEROS
+
+; else digits before the decimal point are to be printed
+
+ LD B,A ; count of leading characters to B.
+
+;; PF-NIB-LP
+L167B: CALL L16D0 ; routine PF-NIBBLE
+ DJNZ L167B ; loop back for counted numbers to PF-NIB-LP
+
+ JR L16C2 ; forward to consider decimal part to PF-DC-OUT
+
+; ---
+
+;; PF-E-FMT
+L1682: LD B,E ; count to B
+ CALL L16D0 ; routine PF-NIBBLE prints one digit.
+ CALL L16C2 ; routine PF-DC-OUT considers fractional part.
+
+ LD A,$2A ; prepare character 'E'
+ RST 10H ; PRINT-A
+
+ LD A,B ; transfer exponent to A
+ AND A ; test the sign.
+ JP P,L1698 ; forward if positive to PF-E-POS
+
+ NEG ; negate the negative exponent.
+ LD B,A ; save positive exponent in B.
+
+ LD A,$16 ; prepare character '-'
+ JR L169A ; skip forward to PF-E-SIGN
+
+; ---
+
+;; PF-E-POS
+L1698: LD A,$15 ; prepare character '+'
+
+;; PF-E-SIGN
+L169A: RST 10H ; PRINT-A
+
+; now convert the integer exponent in B to two characters.
+; it will be less than 99.
+
+ LD A,B ; fetch positive exponent.
+ LD B,$FF ; initialize left hand digit to minus one.
+
+;; PF-E-TENS
+L169E: INC B ; increment ten count
+ SUB $0A ; subtract ten from exponent
+ JR NC,L169E ; loop back if greater than ten to PF-E-TENS
+
+ ADD A,$0A ; reverse last subtraction
+ LD C,A ; transfer remainder to C
+
+ LD A,B ; transfer ten value to A.
+ AND A ; test for zero.
+ JR Z,L16AD ; skip forward if so to PF-E-LOW
+
+ CALL L07EB ; routine OUT-CODE prints as digit '1' - '9'
+
+;; PF-E-LOW
+L16AD: LD A,C ; low byte to A
+ CALL L07EB ; routine OUT-CODE prints final digit of the
+ ; exponent.
+ RET ; return. >>
+
+; ---
+
+; this branch deals with zeros after decimal point.
+; e.g. .01 or .0000999
+
+;; PF-ZEROS
+L16B2: NEG ; negate makes number positive 1 to 4.
+ LD B,A ; zero count to B.
+
+ LD A,$1B ; prepare character '.'
+ RST 10H ; PRINT-A
+
+ LD A,$1C ; prepare a '0'
+
+;; PF-ZRO-LP
+L16BA: RST 10H ; PRINT-A
+ DJNZ L16BA ; loop back to PF-ZRO-LP
+
+ JR L16C8 ; forward to PF-FRAC-LP
+
+; ---
+
+; there is a need to print a leading zero e.g. 0.1 but not with .01
+
+;; PF-ZERO-1
+L16BF: LD A,$1C ; prepare character '0'.
+ RST 10H ; PRINT-A
+
+; this subroutine considers the decimal point and any trailing digits.
+; if the next character is a marked zero, $80, then nothing more to print.
+
+;; PF-DC-OUT
+L16C2: DEC (HL) ; decrement addressed character
+ INC (HL) ; increment it again
+ RET PE ; return with overflow (was 128) >>
+ ; as no fractional part
+
+; else there is a fractional part so print the decimal point.
+
+ LD A,$1B ; prepare character '.'
+ RST 10H ; PRINT-A
+
+; now enter a loop to print trailing digits
+
+;; PF-FRAC-LP
+L16C8: DEC (HL) ; test for a marked zero.
+ INC (HL) ;
+ RET PE ; return when digits exhausted >>
+
+ CALL L16D0 ; routine PF-NIBBLE
+ JR L16C8 ; back for all fractional digits to PF-FRAC-LP.
+
+; ---
+
+; subroutine to print right-hand nibble
+
+;; PF-NIBBLE
+L16D0: LD A,(HL) ; fetch addressed byte
+ AND $0F ; mask off lower 4 bits
+ CALL L07EB ; routine OUT-CODE
+ DEC HL ; decrement pointer.
+ RET ; return.
+
+
+; -------------------------------
+; THE 'PREPARE TO ADD' SUBROUTINE
+; -------------------------------
+; This routine is called twice to prepare each floating point number for
+; addition, in situ, on the calculator stack.
+; The exponent is picked up from the first byte which is then cleared to act
+; as a sign byte and accept any overflow.
+; If the exponent is zero then the number is zero and an early return is made.
+; The now redundant sign bit of the mantissa is set and if the number is
+; negative then all five bytes of the number are twos-complemented to prepare
+; the number for addition.
+; On the second invocation the exponent of the first number is in B.
+
+
+;; PREP-ADD
+L16D8: LD A,(HL) ; fetch exponent.
+ LD (HL),$00 ; make this byte zero to take any overflow and
+ ; default to positive.
+ AND A ; test stored exponent for zero.
+ RET Z ; return with zero flag set if number is zero.
+
+ INC HL ; point to first byte of mantissa.
+ BIT 7,(HL) ; test the sign bit.
+ SET 7,(HL) ; set it to its implied state.
+ DEC HL ; set pointer to first byte again.
+ RET Z ; return if bit indicated number is positive.>>
+
+; if negative then all five bytes are twos complemented starting at LSB.
+
+ PUSH BC ; save B register contents.
+ LD BC,$0005 ; set BC to five.
+ ADD HL,BC ; point to location after 5th byte.
+ LD B,C ; set the B counter to five.
+ LD C,A ; store original exponent in C.
+ SCF ; set carry flag so that one is added.
+
+; now enter a loop to twos-complement the number.
+; The first of the five bytes becomes $FF to denote a negative number.
+
+;; NEG-BYTE
+L16EC: DEC HL ; point to first or more significant byte.
+ LD A,(HL) ; fetch to accumulator.
+ CPL ; complement.
+ ADC A,$00 ; add in initial carry or any subsequent carry.
+ LD (HL),A ; place number back.
+ DJNZ L16EC ; loop back five times to NEG-BYTE
+
+ LD A,C ; restore the exponent to accumulator.
+ POP BC ; restore B register contents.
+
+ RET ; return.
+
+; ----------------------------------
+; THE 'FETCH TWO NUMBERS' SUBROUTINE
+; ----------------------------------
+; This routine is used by addition, multiplication and division to fetch
+; the two five-byte numbers addressed by HL and DE from the calculator stack
+; into the Z80 registers.
+; The HL register may no longer point to the first of the two numbers.
+; Since the 32-bit addition operation is accomplished using two Z80 16-bit
+; instructions, it is important that the lower two bytes of each mantissa are
+; in one set of registers and the other bytes all in the alternate set.
+;
+; In: HL = highest number, DE= lowest number
+;
+; : alt': :
+; Out: :H,B-C:C,B: num1
+; :L,D-E:D-E: num2
+
+;; FETCH-TWO
+L16F7: PUSH HL ; save HL
+ PUSH AF ; save A - result sign when used from division.
+
+ LD C,(HL) ;
+ INC HL ;
+ LD B,(HL) ;
+ LD (HL),A ; insert sign when used from multiplication.
+ INC HL ;
+ LD A,C ; m1
+ LD C,(HL) ;
+ PUSH BC ; PUSH m2 m3
+
+ INC HL ;
+ LD C,(HL) ; m4
+ INC HL ;
+ LD B,(HL) ; m5 BC holds m5 m4
+
+ EX DE,HL ; make HL point to start of second number.
+
+ LD D,A ; m1
+ LD E,(HL) ;
+ PUSH DE ; PUSH m1 n1
+
+ INC HL ;
+ LD D,(HL) ;
+ INC HL ;
+ LD E,(HL) ;
+ PUSH DE ; PUSH n2 n3
+
+ EXX ; - - - - - - -
+
+ POP DE ; POP n2 n3
+ POP HL ; POP m1 n1
+ POP BC ; POP m2 m3
+
+ EXX ; - - - - - - -
+
+ INC HL ;
+ LD D,(HL) ;
+ INC HL ;
+ LD E,(HL) ; DE holds n4 n5
+
+ POP AF ; restore saved
+ POP HL ; registers.
+ RET ; return.
+
+; -----------------------------
+; THE 'SHIFT ADDEND' SUBROUTINE
+; -----------------------------
+; The accumulator A contains the difference between the two exponents.
+; This is the lowest of the two numbers to be added
+
+;; SHIFT-FP
+L171A: AND A ; test difference between exponents.
+ RET Z ; return if zero. both normal.
+
+ CP $21 ; compare with 33 bits.
+ JR NC,L1736 ; forward if greater than 32 to ADDEND-0
+
+ PUSH BC ; preserve BC - part
+ LD B,A ; shift counter to B.
+
+; Now perform B right shifts on the addend L'D'E'D E
+; to bring it into line with the augend H'B'C'C B
+
+;; ONE-SHIFT
+L1722: EXX ; - - -
+ SRA L ; 76543210->C bit 7 unchanged.
+ RR D ; C->76543210->C
+ RR E ; C->76543210->C
+ EXX ; - - -
+ RR D ; C->76543210->C
+ RR E ; C->76543210->C
+ DJNZ L1722 ; loop back B times to ONE-SHIFT
+
+ POP BC ; restore BC
+ RET NC ; return if last shift produced no carry. >>
+
+; if carry flag was set then accuracy is being lost so round up the addend.
+
+ CALL L1741 ; routine ADD-BACK
+ RET NZ ; return if not FF 00 00 00 00
+
+; this branch makes all five bytes of the addend zero and is made during
+; addition when the exponents are too far apart for the addend bits to
+; affect the result.
+
+;; ADDEND-0
+L1736: EXX ; select alternate set for more significant
+ ; bytes.
+ XOR A ; clear accumulator.
+
+
+; this entry point (from multiplication) sets four of the bytes to zero or if
+; continuing from above, during addition, then all five bytes are set to zero.
+
+;; ZEROS-4/5
+L1738: LD L,$00 ; set byte 1 to zero.
+ LD D,A ; set byte 2 to A.
+ LD E,L ; set byte 3 to zero.
+ EXX ; select main set
+ LD DE,$0000 ; set lower bytes 4 and 5 to zero.
+ RET ; return.
+
+; -------------------------
+; THE 'ADD-BACK' SUBROUTINE
+; -------------------------
+; Called from SHIFT-FP above during addition and after normalization from
+; multiplication.
+; This is really a 32-bit increment routine which sets the zero flag according
+; to the 32-bit result.
+; During addition, only negative numbers like FF FF FF FF FF,
+; the twos-complement version of xx 80 00 00 01 say
+; will result in a full ripple FF 00 00 00 00.
+; FF FF FF FF FF when shifted right is unchanged by SHIFT-FP but sets the
+; carry invoking this routine.
+
+;; ADD-BACK
+L1741: INC E ;
+ RET NZ ;
+
+ INC D ;
+ RET NZ ;
+
+ EXX ;
+ INC E ;
+ JR NZ,L174A ; forward if no overflow to ALL-ADDED
+
+ INC D ;
+
+;; ALL-ADDED
+L174A: EXX ;
+ RET ; return with zero flag set for zero mantissa.
+
+
+; ---------------------------
+; THE 'SUBTRACTION' OPERATION
+; ---------------------------
+; just switch the sign of subtrahend and do an add.
+
+;; subtract
+L174C: LD A,(DE) ; fetch exponent byte of second number the
+ ; subtrahend.
+ AND A ; test for zero
+ RET Z ; return if zero - first number is result.
+
+ INC DE ; address the first mantissa byte.
+ LD A,(DE) ; fetch to accumulator.
+ XOR $80 ; toggle the sign bit.
+ LD (DE),A ; place back on calculator stack.
+ DEC DE ; point to exponent byte.
+ ; continue into addition routine.
+
+; ------------------------
+; THE 'ADDITION' OPERATION
+; ------------------------
+; The addition operation pulls out all the stops and uses most of the Z80's
+; registers to add two floating-point numbers.
+; This is a binary operation and on entry, HL points to the first number
+; and DE to the second.
+
+;; addition
+L1755: EXX ; - - -
+ PUSH HL ; save the pointer to the next literal.
+ EXX ; - - -
+
+ PUSH DE ; save pointer to second number
+ PUSH HL ; save pointer to first number - will be the
+ ; result pointer on calculator stack.
+
+ CALL L16D8 ; routine PREP-ADD
+ LD B,A ; save first exponent byte in B.
+ EX DE,HL ; switch number pointers.
+ CALL L16D8 ; routine PREP-ADD
+ LD C,A ; save second exponent byte in C.
+ CP B ; compare the exponent bytes.
+ JR NC,L1769 ; forward if second higher to SHIFT-LEN
+
+ LD A,B ; else higher exponent to A
+ LD B,C ; lower exponent to B
+ EX DE,HL ; switch the number pointers.
+
+;; SHIFT-LEN
+L1769: PUSH AF ; save higher exponent
+ SUB B ; subtract lower exponent
+
+ CALL L16F7 ; routine FETCH-TWO
+ CALL L171A ; routine SHIFT-FP
+
+ POP AF ; restore higher exponent.
+ POP HL ; restore result pointer.
+ LD (HL),A ; insert exponent byte.
+ PUSH HL ; save result pointer again.
+
+; now perform the 32-bit addition using two 16-bit Z80 add instructions.
+
+ LD L,B ; transfer low bytes of mantissa individually
+ LD H,C ; to HL register
+
+ ADD HL,DE ; the actual binary addition of lower bytes
+
+; now the two higher byte pairs that are in the alternate register sets.
+
+ EXX ; switch in set
+ EX DE,HL ; transfer high mantissa bytes to HL register.
+
+ ADC HL,BC ; the actual addition of higher bytes with
+ ; any carry from first stage.
+
+ EX DE,HL ; result in DE, sign bytes ($FF or $00) to HL
+
+; now consider the two sign bytes
+
+ LD A,H ; fetch sign byte of num1
+
+ ADC A,L ; add including any carry from mantissa
+ ; addition. 00 or 01 or FE or FF
+
+ LD L,A ; result in L.
+
+; possible outcomes of signs and overflow from mantissa are
+;
+; H + L + carry = L RRA XOR L RRA
+; ------------------------------------------------------------
+; 00 + 00 = 00 00 00
+; 00 + 00 + carry = 01 00 01 carry
+; FF + FF = FE C FF 01 carry
+; FF + FF + carry = FF C FF 00
+; FF + 00 = FF FF 00
+; FF + 00 + carry = 00 C 80 80
+
+ RRA ; C->76543210->C
+ XOR L ; set bit 0 if shifting required.
+
+ EXX ; switch back to main set
+ EX DE,HL ; full mantissa result now in D'E'D E registers.
+ POP HL ; restore pointer to result exponent on
+ ; the calculator stack.
+
+ RRA ; has overflow occurred ?
+ JR NC,L1790 ; skip forward if not to TEST-NEG
+
+; if the addition of two positive mantissas produced overflow or if the
+; addition of two negative mantissas did not then the result exponent has to
+; be incremented and the mantissa shifted one place to the right.
+
+ LD A,$01 ; one shift required.
+ CALL L171A ; routine SHIFT-FP performs a single shift
+ ; rounding any lost bit
+ INC (HL) ; increment the exponent.
+ JR Z,L17B3 ; forward to ADD-REP-6 if the exponent
+ ; wraps round from FF to zero as number is too
+ ; big for the system.
+
+; at this stage the exponent on the calculator stack is correct.
+
+;; TEST-NEG
+L1790: EXX ; switch in the alternate set.
+ LD A,L ; load result sign to accumulator.
+ AND $80 ; isolate bit 7 from sign byte setting zero
+ ; flag if positive.
+ EXX ; back to main set.
+
+ INC HL ; point to first byte of mantissa
+ LD (HL),A ; insert $00 positive or $80 negative at
+ ; position on calculator stack.
+
+ DEC HL ; point to exponent again.
+ JR Z,L17B9 ; forward if positive to GO-NC-MLT
+
+; a negative number has to be twos-complemented before being placed on stack.
+
+ LD A,E ; fetch lowest (rightmost) mantissa byte.
+ NEG ; Negate
+ CCF ; Complement Carry Flag
+ LD E,A ; place back in register
+
+ LD A,D ; ditto
+ CPL ;
+ ADC A,$00 ;
+ LD D,A ;
+
+ EXX ; switch to higher (leftmost) 16 bits.
+
+ LD A,E ; ditto
+ CPL ;
+ ADC A,$00 ;
+ LD E,A ;
+
+ LD A,D ; ditto
+ CPL ;
+ ADC A,$00 ;
+ JR NC,L17B7 ; forward without overflow to END-COMPL
+
+; else entire mantissa is now zero. 00 00 00 00
+
+ RRA ; set mantissa to 80 00 00 00
+ EXX ; switch.
+ INC (HL) ; increment the exponent.
+
+;; ADD-REP-6
+L17B3: JP Z,L1880 ; jump forward if exponent now zero to REPORT-6
+ ; 'Number too big'
+
+ EXX ; switch back to alternate set.
+
+;; END-COMPL
+L17B7: LD D,A ; put first byte of mantissa back in DE.
+ EXX ; switch to main set.
+
+;; GO-NC-MLT
+L17B9: XOR A ; clear carry flag and
+ ; clear accumulator so no extra bits carried
+ ; forward as occurs in multiplication.
+
+ JR L1828 ; forward to common code at TEST-NORM
+ ; but should go straight to NORMALIZE.
+
+
+; ----------------------------------------------
+; THE 'PREPARE TO MULTIPLY OR DIVIDE' SUBROUTINE
+; ----------------------------------------------
+; this routine is called twice from multiplication and twice from division
+; to prepare each of the two numbers for the operation.
+; Initially the accumulator holds zero and after the second invocation bit 7
+; of the accumulator will be the sign bit of the result.
+
+;; PREP-M/D
+L17BC: SCF ; set carry flag to signal number is zero.
+ DEC (HL) ; test exponent
+ INC (HL) ; for zero.
+ RET Z ; return if zero with carry flag set.
+
+ INC HL ; address first mantissa byte.
+ XOR (HL) ; exclusive or the running sign bit.
+ SET 7,(HL) ; set the implied bit.
+ DEC HL ; point to exponent byte.
+ RET ; return.
+
+; ------------------------------
+; THE 'MULTIPLICATION' OPERATION
+; ------------------------------
+;
+;
+
+;; multiply
+L17C6: XOR A ; reset bit 7 of running sign flag.
+ CALL L17BC ; routine PREP-M/D
+ RET C ; return if number is zero.
+ ; zero * anything = zero.
+
+ EXX ; - - -
+ PUSH HL ; save pointer to 'next literal'
+ EXX ; - - -
+
+ PUSH DE ; save pointer to second number
+
+ EX DE,HL ; make HL address second number.
+
+ CALL L17BC ; routine PREP-M/D
+
+ EX DE,HL ; HL first number, DE - second number
+ JR C,L1830 ; forward with carry to ZERO-RSLT
+ ; anything * zero = zero.
+
+ PUSH HL ; save pointer to first number.
+
+ CALL L16F7 ; routine FETCH-TWO fetches two mantissas from
+ ; calc stack to B'C'C,B D'E'D E
+ ; (HL will be overwritten but the result sign
+ ; in A is inserted on the calculator stack)
+
+ LD A,B ; transfer low mantissa byte of first number
+ AND A ; clear carry.
+ SBC HL,HL ; a short form of LD HL,$0000 to take lower
+ ; two bytes of result. (2 program bytes)
+ EXX ; switch in alternate set
+ PUSH HL ; preserve HL
+ SBC HL,HL ; set HL to zero also to take higher two bytes
+ ; of the result and clear carry.
+ EXX ; switch back.
+
+ LD B,$21 ; register B can now be used to count thirty
+ ; three shifts.
+ JR L17F8 ; forward to loop entry point STRT-MLT
+
+; ---
+
+; The multiplication loop is entered at STRT-LOOP.
+
+;; MLT-LOOP
+L17E7: JR NC,L17EE ; forward if no carry to NO-ADD
+
+ ; else add in the multiplicand.
+
+ ADD HL,DE ; add the two low bytes to result
+ EXX ; switch to more significant bytes.
+ ADC HL,DE ; add high bytes of multiplicand and any carry.
+ EXX ; switch to main set.
+
+; in either case shift result right into B'C'C A
+
+;; NO-ADD
+L17EE: EXX ; switch to alternate set
+ RR H ; C > 76543210 > C
+ RR L ; C > 76543210 > C
+ EXX ;
+ RR H ; C > 76543210 > C
+ RR L ; C > 76543210 > C
+
+;; STRT-MLT
+L17F8: EXX ; switch in alternate set.
+ RR B ; C > 76543210 > C
+ RR C ; C > 76543210 > C
+ EXX ; now main set
+ RR C ; C > 76543210 > C
+ RRA ; C > 76543210 > C
+ DJNZ L17E7 ; loop back 33 times to MLT-LOOP
+
+;
+
+ EX DE,HL ;
+ EXX ;
+ EX DE,HL ;
+ EXX ;
+ POP BC ;
+ POP HL ;
+ LD A,B ;
+ ADD A,C ;
+ JR NZ,L180E ; forward to MAKE-EXPT
+
+ AND A ;
+
+;; MAKE-EXPT
+L180E: DEC A ;
+ CCF ; Complement Carry Flag
+
+;; DIVN-EXPT
+L1810: RLA ;
+ CCF ; Complement Carry Flag
+ RRA ;
+ JP P,L1819 ; forward to OFLW1-CLR
+
+ JR NC,L1880 ; forward to REPORT-6
+
+ AND A ;
+
+;; OFLW1-CLR
+L1819: INC A ;
+ JR NZ,L1824 ; forward to OFLW2-CLR
+
+ JR C,L1824 ; forward to OFLW2-CLR
+
+ EXX ;
+ BIT 7,D ;
+ EXX ;
+ JR NZ,L1880 ; forward to REPORT-6
+
+;; OFLW2-CLR
+L1824: LD (HL),A ;
+ EXX ;
+ LD A,B ;
+ EXX ;
+
+; addition joins here with carry flag clear.
+
+;; TEST-NORM
+L1828: JR NC,L183F ; forward to NORMALIZE
+
+ LD A,(HL) ;
+ AND A ;
+
+;; NEAR-ZERO
+L182C: LD A,$80 ; prepare to rescue the most significant bit
+ ; of the mantissa if it is set.
+ JR Z,L1831 ; skip forward to SKIP-ZERO
+
+;; ZERO-RSLT
+L1830: XOR A ; make mask byte zero signaling set five
+ ; bytes to zero.
+
+;; SKIP-ZERO
+L1831: EXX ; switch in alternate set
+ AND D ; isolate most significant bit (if A is $80).
+
+ CALL L1738 ; routine ZEROS-4/5 sets mantissa without
+ ; affecting any flags.
+
+ RLCA ; test if MSB set. bit 7 goes to bit 0.
+ ; either $00 -> $00 or $80 -> $01
+ LD (HL),A ; make exponent $01 (lowest) or $00 zero
+ JR C,L1868 ; forward if first case to OFLOW-CLR
+
+ INC HL ; address first mantissa byte on the
+ ; calculator stack.
+ LD (HL),A ; insert a zero for the sign bit.
+ DEC HL ; point to zero exponent
+ JR L1868 ; forward to OFLOW-CLR
+
+; ---
+
+; this branch is common to addition and multiplication with the mantissa
+; result still in registers D'E'D E .
+
+;; NORMALIZE
+L183F: LD B,$20 ; a maximum of thirty-two left shifts will be
+ ; needed.
+
+;; SHIFT-ONE
+L1841: EXX ; address higher 16 bits.
+ BIT 7,D ; test the leftmost bit
+ EXX ; address lower 16 bits.
+
+ JR NZ,L1859 ; forward if leftmost bit was set to NORML-NOW
+
+ RLCA ; this holds zero from addition, 33rd bit
+ ; from multiplication.
+
+ RL E ; C < 76543210 < C
+ RL D ; C < 76543210 < C
+
+ EXX ; address higher 16 bits.
+
+ RL E ; C < 76543210 < C
+ RL D ; C < 76543210 < C
+
+ EXX ; switch to main set.
+
+ DEC (HL) ; decrement the exponent byte on the calculator
+ ; stack.
+
+ JR Z,L182C ; back if exponent becomes zero to NEAR-ZERO
+ ; it's just possible that the last rotation
+ ; set bit 7 of D. We shall see.
+
+ DJNZ L1841 ; loop back to SHIFT-ONE
+
+; if thirty-two left shifts were performed without setting the most significant
+; bit then the result is zero.
+
+ JR L1830 ; back to ZERO-RSLT
+
+; ---
+
+;; NORML-NOW
+L1859: RLA ; for the addition path, A is always zero.
+ ; for the mult path, ...
+
+ JR NC,L1868 ; forward to OFLOW-CLR
+
+; this branch is taken only with multiplication.
+
+ CALL L1741 ; routine ADD-BACK
+
+ JR NZ,L1868 ; forward to OFLOW-CLR
+
+ EXX ;
+ LD D,$80 ;
+ EXX ;
+ INC (HL) ;
+ JR Z,L1880 ; forward to REPORT-6
+
+; now transfer the mantissa from the register sets to the calculator stack
+; incorporating the sign bit already there.
+
+;; OFLOW-CLR
+L1868: PUSH HL ; save pointer to exponent on stack.
+ INC HL ; address first byte of mantissa which was
+ ; previously loaded with sign bit $00 or $80.
+
+ EXX ; - - -
+ PUSH DE ; push the most significant two bytes.
+ EXX ; - - -
+
+ POP BC ; pop - true mantissa is now BCDE.
+
+; now pick up the sign bit.
+
+ LD A,B ; first mantissa byte to A
+ RLA ; rotate out bit 7 which is set
+ RL (HL) ; rotate sign bit on stack into carry.
+ RRA ; rotate sign bit into bit 7 of mantissa.
+
+; and transfer mantissa from main registers to calculator stack.
+
+ LD (HL),A ;
+ INC HL ;
+ LD (HL),C ;
+ INC HL ;
+ LD (HL),D ;
+ INC HL ;
+ LD (HL),E ;
+
+ POP HL ; restore pointer to num1 now result.
+ POP DE ; restore pointer to num2 now STKEND.
+
+ EXX ; - - -
+ POP HL ; restore pointer to next calculator literal.
+ EXX ; - - -
+
+ RET ; return.
+
+; ---
+
+;; REPORT-6
+L1880: RST 08H ; ERROR-1
+ DEFB $05 ; Error Report: Arithmetic overflow.
+
+; ------------------------
+; THE 'DIVISION' OPERATION
+; ------------------------
+; "Of all the arithmetic subroutines, division is the most complicated and
+; the least understood. It is particularly interesting to note that the
+; Sinclair programmer himself has made a mistake in his programming ( or has
+; copied over someone else's mistake!) for
+; PRINT PEEK 6352 [ $18D0 ] ('unimproved' ROM, 6351 [ $18CF ] )
+; should give 218 not 225."
+; - Dr. Ian Logan, Syntax magazine Jul/Aug 1982.
+; [ i.e. the jump should be made to div-34th ]
+
+; First check for division by zero.
+
+;; division
+L1882: EX DE,HL ; consider the second number first.
+ XOR A ; set the running sign flag.
+ CALL L17BC ; routine PREP-M/D
+ JR C,L1880 ; back if zero to REPORT-6
+ ; 'Arithmetic overflow'
+
+ EX DE,HL ; now prepare first number and check for zero.
+ CALL L17BC ; routine PREP-M/D
+ RET C ; return if zero, 0/anything is zero.
+
+ EXX ; - - -
+ PUSH HL ; save pointer to the next calculator literal.
+ EXX ; - - -
+
+ PUSH DE ; save pointer to divisor - will be STKEND.
+ PUSH HL ; save pointer to dividend - will be result.
+
+ CALL L16F7 ; routine FETCH-TWO fetches the two numbers
+ ; into the registers H'B'C'C B
+ ; L'D'E'D E
+ EXX ; - - -
+ PUSH HL ; save the two exponents.
+
+ LD H,B ; transfer the dividend to H'L'H L
+ LD L,C ;
+ EXX ;
+ LD H,C ;
+ LD L,B ;
+
+ XOR A ; clear carry bit and accumulator.
+ LD B,$DF ; count upwards from -33 decimal
+ JR L18B2 ; forward to mid-loop entry point DIV-START
+
+; ---
+
+;; DIV-LOOP
+L18A2: RLA ; multiply partial quotient by two
+ RL C ; setting result bit from carry.
+ EXX ;
+ RL C ;
+ RL B ;
+ EXX ;
+
+;; div-34th
+L18AB: ADD HL,HL ;
+ EXX ;
+ ADC HL,HL ;
+ EXX ;
+ JR C,L18C2 ; forward to SUBN-ONLY
+
+;; DIV-START
+L18B2: SBC HL,DE ; subtract divisor part.
+ EXX ;
+ SBC HL,DE ;
+ EXX ;
+ JR NC,L18C9 ; forward if subtraction goes to NO-RSTORE
+
+ ADD HL,DE ; else restore
+ EXX ;
+ ADC HL,DE ;
+ EXX ;
+ AND A ; clear carry
+ JR L18CA ; forward to COUNT-ONE
+
+; ---
+
+;; SUBN-ONLY
+L18C2: AND A ;
+ SBC HL,DE ;
+ EXX ;
+ SBC HL,DE ;
+ EXX ;
+
+;; NO-RSTORE
+L18C9: SCF ; set carry flag
+
+;; COUNT-ONE
+L18CA: INC B ; increment the counter
+ JP M,L18A2 ; back while still minus to DIV-LOOP
+
+ PUSH AF ;
+ JR Z,L18B2 ; back to DIV-START
+
+; "This jump is made to the wrong place. No 34th bit will ever be obtained
+; without first shifting the dividend. Hence important results like 1/10 and
+; 1/1000 are not rounded up as they should be. Rounding up never occurs when
+; it depends on the 34th bit. The jump should be made to div-34th above."
+; - Dr. Frank O'Hara, "The Complete Spectrum ROM Disassembly", 1983,
+; published by Melbourne House.
+; (Note. on the ZX81 this would be JR Z,L18AB)
+;
+; However if you make this change, then while (1/2=.5) will now evaluate as
+; true, (.25=1/4), which did evaluate as true, no longer does.
+
+ LD E,A ;
+ LD D,C ;
+ EXX ;
+ LD E,C ;
+ LD D,B ;
+
+ POP AF ;
+ RR B ;
+ POP AF ;
+ RR B ;
+
+ EXX ;
+ POP BC ;
+ POP HL ;
+ LD A,B ;
+ SUB C ;
+ JP L1810 ; jump back to DIVN-EXPT
+
+; ------------------------------------------------
+; THE 'INTEGER TRUNCATION TOWARDS ZERO' SUBROUTINE
+; ------------------------------------------------
+;
+
+;; truncate
+L18E4: LD A,(HL) ; fetch exponent
+ CP $81 ; compare to +1
+ JR NC,L18EF ; forward, if 1 or more, to T-GR-ZERO
+
+; else the number is smaller than plus or minus 1 and can be made zero.
+
+ LD (HL),$00 ; make exponent zero.
+ LD A,$20 ; prepare to set 32 bits of mantissa to zero.
+ JR L18F4 ; forward to NIL-BYTES
+
+; ---
+
+;; T-GR-ZERO
+L18EF: SUB $A0 ; subtract +32 from exponent
+ RET P ; return if result is positive as all 32 bits
+ ; of the mantissa relate to the integer part.
+ ; The floating point is somewhere to the right
+ ; of the mantissa
+
+ NEG ; else negate to form number of rightmost bits
+ ; to be blanked.
+
+; for instance, disregarding the sign bit, the number 3.5 is held as
+; exponent $82 mantissa .11100000 00000000 00000000 00000000
+; we need to set $82 - $A0 = $E2 NEG = $1E (thirty) bits to zero to form the
+; integer.
+; The sign of the number is never considered as the first bit of the mantissa
+; must be part of the integer.
+
+;; NIL-BYTES
+L18F4: PUSH DE ; save pointer to STKEND
+ EX DE,HL ; HL points at STKEND
+ DEC HL ; now at last byte of mantissa.
+ LD B,A ; Transfer bit count to B register.
+ SRL B ; divide by
+ SRL B ; eight
+ SRL B ;
+ JR Z,L1905 ; forward if zero to BITS-ZERO
+
+; else the original count was eight or more and whole bytes can be blanked.
+
+;; BYTE-ZERO
+L1900: LD (HL),$00 ; set eight bits to zero.
+ DEC HL ; point to more significant byte of mantissa.
+ DJNZ L1900 ; loop back to BYTE-ZERO
+
+; now consider any residual bits.
+
+;; BITS-ZERO
+L1905: AND $07 ; isolate the remaining bits
+ JR Z,L1912 ; forward if none to IX-END
+
+ LD B,A ; transfer bit count to B counter.
+ LD A,$FF ; form a mask 11111111
+
+;; LESS-MASK
+L190C: SLA A ; 1 <- 76543210 <- o slide mask leftwards.
+ DJNZ L190C ; loop back for bit count to LESS-MASK
+
+ AND (HL) ; lose the unwanted rightmost bits
+ LD (HL),A ; and place in mantissa byte.
+
+;; IX-END
+L1912: EX DE,HL ; restore result pointer from DE.
+ POP DE ; restore STKEND from stack.
+ RET ; return.
+
+
+;********************************
+;** FLOATING-POINT CALCULATOR **
+;********************************
+
+; As a general rule the calculator avoids using the IY register.
+; Exceptions are val and str$.
+; So an assembly language programmer who has disabled interrupts to use IY
+; for other purposes can still use the calculator for mathematical
+; purposes.
+
+
+; ------------------------
+; THE 'TABLE OF CONSTANTS'
+; ------------------------
+; The ZX81 has only floating-point number representation.
+; Both the ZX80 and the ZX Spectrum have integer numbers in some form.
+
+;; stk-zero 00 00 00 00 00
+L1915: DEFB $00 ;;Bytes: 1
+ DEFB $B0 ;;Exponent $00
+ DEFB $00 ;;(+00,+00,+00)
+
+;; stk-one 81 00 00 00 00
+L1918: DEFB $31 ;;Exponent $81, Bytes: 1
+ DEFB $00 ;;(+00,+00,+00)
+
+
+;; stk-half 80 00 00 00 00
+L191A: DEFB $30 ;;Exponent: $80, Bytes: 1
+ DEFB $00 ;;(+00,+00,+00)
+
+
+;; stk-pi/2 81 49 0F DA A2
+L191C: DEFB $F1 ;;Exponent: $81, Bytes: 4
+ DEFB $49,$0F,$DA,$A2 ;;
+
+;; stk-ten 84 20 00 00 00
+L1921: DEFB $34 ;;Exponent: $84, Bytes: 1
+ DEFB $20 ;;(+00,+00,+00)
+
+
+; ------------------------
+; THE 'TABLE OF ADDRESSES'
+; ------------------------
+;
+; starts with binary operations which have two operands and one result.
+; three pseudo binary operations first.
+
+;; tbl-addrs
+L1923: DEFW L1C2F ; $00 Address: $1C2F - jump-true
+ DEFW L1A72 ; $01 Address: $1A72 - exchange
+ DEFW L19E3 ; $02 Address: $19E3 - delete
+
+; true binary operations.
+
+ DEFW L174C ; $03 Address: $174C - subtract
+ DEFW L17C6 ; $04 Address: $176C - multiply
+ DEFW L1882 ; $05 Address: $1882 - division
+ DEFW L1DE2 ; $06 Address: $1DE2 - to-power
+ DEFW L1AED ; $07 Address: $1AED - or
+
+ DEFW L1AF3 ; $08 Address: $1B03 - no-&-no
+ DEFW L1B03 ; $09 Address: $1B03 - no-l-eql
+ DEFW L1B03 ; $0A Address: $1B03 - no-gr-eql
+ DEFW L1B03 ; $0B Address: $1B03 - nos-neql
+ DEFW L1B03 ; $0C Address: $1B03 - no-grtr
+ DEFW L1B03 ; $0D Address: $1B03 - no-less
+ DEFW L1B03 ; $0E Address: $1B03 - nos-eql
+ DEFW L1755 ; $0F Address: $1755 - addition
+
+ DEFW L1AF8 ; $10 Address: $1AF8 - str-&-no
+ DEFW L1B03 ; $11 Address: $1B03 - str-l-eql
+ DEFW L1B03 ; $12 Address: $1B03 - str-gr-eql
+ DEFW L1B03 ; $13 Address: $1B03 - strs-neql
+ DEFW L1B03 ; $14 Address: $1B03 - str-grtr
+ DEFW L1B03 ; $15 Address: $1B03 - str-less
+ DEFW L1B03 ; $16 Address: $1B03 - strs-eql
+ DEFW L1B62 ; $17 Address: $1B62 - strs-add
+
+; unary follow
+
+ DEFW L1AA0 ; $18 Address: $1AA0 - neg
+
+ DEFW L1C06 ; $19 Address: $1C06 - code
+ DEFW L1BA4 ; $1A Address: $1BA4 - val
+ DEFW L1C11 ; $1B Address: $1C11 - len
+ DEFW L1D49 ; $1C Address: $1D49 - sin
+ DEFW L1D3E ; $1D Address: $1D3E - cos
+ DEFW L1D6E ; $1E Address: $1D6E - tan
+ DEFW L1DC4 ; $1F Address: $1DC4 - asn
+ DEFW L1DD4 ; $20 Address: $1DD4 - acs
+ DEFW L1D76 ; $21 Address: $1D76 - atn
+ DEFW L1CA9 ; $22 Address: $1CA9 - ln
+ DEFW L1C5B ; $23 Address: $1C5B - exp
+ DEFW L1C46 ; $24 Address: $1C46 - int
+ DEFW L1DDB ; $25 Address: $1DDB - sqr
+ DEFW L1AAF ; $26 Address: $1AAF - sgn
+ DEFW L1AAA ; $27 Address: $1AAA - abs
+ DEFW L1ABE ; $28 Address: $1A1B - peek
+ DEFW L1AC5 ; $29 Address: $1AC5 - usr-no
+ DEFW L1BD5 ; $2A Address: $1BD5 - str$
+ DEFW L1B8F ; $2B Address: $1B8F - chrs
+ DEFW L1AD5 ; $2C Address: $1AD5 - not
+
+; end of true unary
+
+ DEFW L19F6 ; $2D Address: $19F6 - duplicate
+ DEFW L1C37 ; $2E Address: $1C37 - n-mod-m
+
+ DEFW L1C23 ; $2F Address: $1C23 - jump
+ DEFW L19FC ; $30 Address: $19FC - stk-data
+
+ DEFW L1C17 ; $31 Address: $1C17 - dec-jr-nz
+ DEFW L1ADB ; $32 Address: $1ADB - less-0
+ DEFW L1ACE ; $33 Address: $1ACE - greater-0
+ DEFW L002B ; $34 Address: $002B - end-calc
+ DEFW L1D18 ; $35 Address: $1D18 - get-argt
+ DEFW L18E4 ; $36 Address: $18E4 - truncate
+ DEFW L19E4 ; $37 Address: $19E4 - fp-calc-2
+ DEFW L155A ; $38 Address: $155A - e-to-fp
+
+; the following are just the next available slots for the 128 compound literals
+; which are in range $80 - $FF.
+
+ DEFW L1A7F ; $39 Address: $1A7F - series-xx $80 - $9F.
+ DEFW L1A51 ; $3A Address: $1A51 - stk-const-xx $A0 - $BF.
+ DEFW L1A63 ; $3B Address: $1A63 - st-mem-xx $C0 - $DF.
+ DEFW L1A45 ; $3C Address: $1A45 - get-mem-xx $E0 - $FF.
+
+; Aside: 3D - 7F are therefore unused calculator literals.
+; 39 - 7B would be available for expansion.
+
+; -------------------------------
+; THE 'FLOATING POINT CALCULATOR'
+; -------------------------------
+;
+;
+
+;; CALCULATE
+L199D: CALL L1B85 ; routine STK-PNTRS is called to set up the
+ ; calculator stack pointers for a default
+ ; unary operation. HL = last value on stack.
+ ; DE = STKEND first location after stack.
+
+; the calculate routine is called at this point by the series generator...
+
+;; GEN-ENT-1
+L19A0: LD A,B ; fetch the Z80 B register to A
+ LD ($401E),A ; and store value in system variable BREG.
+ ; this will be the counter for dec-jr-nz
+ ; or if used from fp-calc2 the calculator
+ ; instruction.
+
+; ... and again later at this point
+
+;; GEN-ENT-2
+L19A4: EXX ; switch sets
+ EX (SP),HL ; and store the address of next instruction,
+ ; the return address, in H'L'.
+ ; If this is a recursive call then the H'L'
+ ; of the previous invocation goes on stack.
+ ; c.f. end-calc.
+ EXX ; switch back to main set.
+
+; this is the re-entry looping point when handling a string of literals.
+
+;; RE-ENTRY
+L19A7: LD ($401C),DE ; save end of stack in system variable STKEND
+ EXX ; switch to alt
+ LD A,(HL) ; get next literal
+ INC HL ; increase pointer'
+
+; single operation jumps back to here
+
+;; SCAN-ENT
+L19AE: PUSH HL ; save pointer on stack *
+ AND A ; now test the literal
+ JP P,L19C2 ; forward to FIRST-3D if in range $00 - $3D
+ ; anything with bit 7 set will be one of
+ ; 128 compound literals.
+
+; compound literals have the following format.
+; bit 7 set indicates compound.
+; bits 6-5 the subgroup 0-3.
+; bits 4-0 the embedded parameter $00 - $1F.
+; The subgroup 0-3 needs to be manipulated to form the next available four
+; address places after the simple literals in the address table.
+
+ LD D,A ; save literal in D
+ AND $60 ; and with 01100000 to isolate subgroup
+ RRCA ; rotate bits
+ RRCA ; 4 places to right
+ RRCA ; not five as we need offset * 2
+ RRCA ; 00000xx0
+ ADD A,$72 ; add ($39 * 2) to give correct offset.
+ ; alter above if you add more literals.
+ LD L,A ; store in L for later indexing.
+ LD A,D ; bring back compound literal
+ AND $1F ; use mask to isolate parameter bits
+ JR L19D0 ; forward to ENT-TABLE
+
+; ---
+
+; the branch was here with simple literals.
+
+;; FIRST-3D
+L19C2: CP $18 ; compare with first unary operations.
+ JR NC,L19CE ; to DOUBLE-A with unary operations
+
+; it is binary so adjust pointers.
+
+ EXX ;
+ LD BC,$FFFB ; the value -5
+ LD D,H ; transfer HL, the last value, to DE.
+ LD E,L ;
+ ADD HL,BC ; subtract 5 making HL point to second
+ ; value.
+ EXX ;
+
+;; DOUBLE-A
+L19CE: RLCA ; double the literal
+ LD L,A ; and store in L for indexing
+
+;; ENT-TABLE
+L19D0: LD DE,L1923 ; Address: tbl-addrs
+ LD H,$00 ; prepare to index
+ ADD HL,DE ; add to get address of routine
+ LD E,(HL) ; low byte to E
+ INC HL ;
+ LD D,(HL) ; high byte to D
+
+ LD HL,L19A7 ; Address: RE-ENTRY
+ EX (SP),HL ; goes on machine stack
+ ; address of next literal goes to HL. *
+
+
+ PUSH DE ; now the address of routine is stacked.
+ EXX ; back to main set
+ ; avoid using IY register.
+ LD BC,($401D) ; STKEND_hi
+ ; nothing much goes to C but BREG to B
+ ; and continue into next ret instruction
+ ; which has a dual identity
+
+
+; -----------------------
+; THE 'DELETE' SUBROUTINE
+; -----------------------
+; offset $02: 'delete'
+; A simple return but when used as a calculator literal this
+; deletes the last value from the calculator stack.
+; On entry, as always with binary operations,
+; HL=first number, DE=second number
+; On exit, HL=result, DE=stkend.
+; So nothing to do
+
+;; delete
+L19E3: RET ; return - indirect jump if from above.
+
+; ---------------------------------
+; THE 'SINGLE OPERATION' SUBROUTINE
+; ---------------------------------
+; offset $37: 'fp-calc-2'
+; this single operation is used, in the first instance, to evaluate most
+; of the mathematical and string functions found in BASIC expressions.
+
+;; fp-calc-2
+L19E4: POP AF ; drop return address.
+ LD A,($401E) ; load accumulator from system variable BREG
+ ; value will be literal eg. 'tan'
+ EXX ; switch to alt
+ JR L19AE ; back to SCAN-ENT
+ ; next literal will be end-calc in scanning
+
+; ------------------------------
+; THE 'TEST 5 SPACES' SUBROUTINE
+; ------------------------------
+; This routine is called from MOVE-FP, STK-CONST and STK-STORE to
+; test that there is enough space between the calculator stack and the
+; machine stack for another five-byte value. It returns with BC holding
+; the value 5 ready for any subsequent LDIR.
+
+;; TEST-5-SP
+L19EB: PUSH DE ; save
+ PUSH HL ; registers
+ LD BC,$0005 ; an overhead of five bytes
+ CALL L0EC5 ; routine TEST-ROOM tests free RAM raising
+ ; an error if not.
+ POP HL ; else restore
+ POP DE ; registers.
+ RET ; return with BC set at 5.
+
+
+; ---------------------------------------------
+; THE 'MOVE A FLOATING POINT NUMBER' SUBROUTINE
+; ---------------------------------------------
+; offset $2D: 'duplicate'
+; This simple routine is a 5-byte LDIR instruction
+; that incorporates a memory check.
+; When used as a calculator literal it duplicates the last value on the
+; calculator stack.
+; Unary so on entry HL points to last value, DE to stkend
+
+;; duplicate
+;; MOVE-FP
+L19F6: CALL L19EB ; routine TEST-5-SP test free memory
+ ; and sets BC to 5.
+ LDIR ; copy the five bytes.
+ RET ; return with DE addressing new STKEND
+ ; and HL addressing new last value.
+
+; -------------------------------
+; THE 'STACK LITERALS' SUBROUTINE
+; -------------------------------
+; offset $30: 'stk-data'
+; When a calculator subroutine needs to put a value on the calculator
+; stack that is not a regular constant this routine is called with a
+; variable number of following data bytes that convey to the routine
+; the floating point form as succinctly as is possible.
+
+;; stk-data
+L19FC: LD H,D ; transfer STKEND
+ LD L,E ; to HL for result.
+
+;; STK-CONST
+L19FE: CALL L19EB ; routine TEST-5-SP tests that room exists
+ ; and sets BC to $05.
+
+ EXX ; switch to alternate set
+ PUSH HL ; save the pointer to next literal on stack
+ EXX ; switch back to main set
+
+ EX (SP),HL ; pointer to HL, destination to stack.
+
+ PUSH BC ; save BC - value 5 from test room ??.
+
+ LD A,(HL) ; fetch the byte following 'stk-data'
+ AND $C0 ; isolate bits 7 and 6
+ RLCA ; rotate
+ RLCA ; to bits 1 and 0 range $00 - $03.
+ LD C,A ; transfer to C
+ INC C ; and increment to give number of bytes
+ ; to read. $01 - $04
+ LD A,(HL) ; reload the first byte
+ AND $3F ; mask off to give possible exponent.
+ JR NZ,L1A14 ; forward to FORM-EXP if it was possible to
+ ; include the exponent.
+
+; else byte is just a byte count and exponent comes next.
+
+ INC HL ; address next byte and
+ LD A,(HL) ; pick up the exponent ( - $50).
+
+;; FORM-EXP
+L1A14: ADD A,$50 ; now add $50 to form actual exponent
+ LD (DE),A ; and load into first destination byte.
+ LD A,$05 ; load accumulator with $05 and
+ SUB C ; subtract C to give count of trailing
+ ; zeros plus one.
+ INC HL ; increment source
+ INC DE ; increment destination
+ LD B,$00 ; prepare to copy
+ LDIR ; copy C bytes
+
+ POP BC ; restore 5 counter to BC ??.
+
+ EX (SP),HL ; put HL on stack as next literal pointer
+ ; and the stack value - result pointer -
+ ; to HL.
+
+ EXX ; switch to alternate set.
+ POP HL ; restore next literal pointer from stack
+ ; to H'L'.
+ EXX ; switch back to main set.
+
+ LD B,A ; zero count to B
+ XOR A ; clear accumulator
+
+;; STK-ZEROS
+L1A27: DEC B ; decrement B counter
+ RET Z ; return if zero. >>
+ ; DE points to new STKEND
+ ; HL to new number.
+
+ LD (DE),A ; else load zero to destination
+ INC DE ; increase destination
+ JR L1A27 ; loop back to STK-ZEROS until done.
+
+; -------------------------------
+; THE 'SKIP CONSTANTS' SUBROUTINE
+; -------------------------------
+; This routine traverses variable-length entries in the table of constants,
+; stacking intermediate, unwanted constants onto a dummy calculator stack,
+; in the first five bytes of the ZX81 ROM.
+
+;; SKIP-CONS
+L1A2D: AND A ; test if initially zero.
+
+;; SKIP-NEXT
+L1A2E: RET Z ; return if zero. >>
+
+ PUSH AF ; save count.
+ PUSH DE ; and normal STKEND
+
+ LD DE,$0000 ; dummy value for STKEND at start of ROM
+ ; Note. not a fault but this has to be
+ ; moved elsewhere when running in RAM.
+ ;
+ CALL L19FE ; routine STK-CONST works through variable
+ ; length records.
+
+ POP DE ; restore real STKEND
+ POP AF ; restore count
+ DEC A ; decrease
+ JR L1A2E ; loop back to SKIP-NEXT
+
+; --------------------------------
+; THE 'MEMORY LOCATION' SUBROUTINE
+; --------------------------------
+; This routine, when supplied with a base address in HL and an index in A,
+; will calculate the address of the A'th entry, where each entry occupies
+; five bytes. It is used for addressing floating-point numbers in the
+; calculator's memory area.
+
+;; LOC-MEM
+L1A3C: LD C,A ; store the original number $00-$1F.
+ RLCA ; double.
+ RLCA ; quadruple.
+ ADD A,C ; now add original value to multiply by five.
+
+ LD C,A ; place the result in C.
+ LD B,$00 ; set B to 0.
+ ADD HL,BC ; add to form address of start of number in HL.
+
+ RET ; return.
+
+; -------------------------------------
+; THE 'GET FROM MEMORY AREA' SUBROUTINE
+; -------------------------------------
+; offsets $E0 to $FF: 'get-mem-0', 'get-mem-1' etc.
+; A holds $00-$1F offset.
+; The calculator stack increases by 5 bytes.
+
+;; get-mem-xx
+L1A45: PUSH DE ; save STKEND
+ LD HL,($401F) ; MEM is base address of the memory cells.
+ CALL L1A3C ; routine LOC-MEM so that HL = first byte
+ CALL L19F6 ; routine MOVE-FP moves 5 bytes with memory
+ ; check.
+ ; DE now points to new STKEND.
+ POP HL ; the original STKEND is now RESULT pointer.
+ RET ; return.
+
+; ---------------------------------
+; THE 'STACK A CONSTANT' SUBROUTINE
+; ---------------------------------
+; offset $A0: 'stk-zero'
+; offset $A1: 'stk-one'
+; offset $A2: 'stk-half'
+; offset $A3: 'stk-pi/2'
+; offset $A4: 'stk-ten'
+; This routine allows a one-byte instruction to stack up to 32 constants
+; held in short form in a table of constants. In fact only 5 constants are
+; required. On entry the A register holds the literal ANDed with $1F.
+; It isn't very efficient and it would have been better to hold the
+; numbers in full, five byte form and stack them in a similar manner
+; to that which would be used later for semi-tone table values.
+
+;; stk-const-xx
+L1A51: LD H,D ; save STKEND - required for result
+ LD L,E ;
+ EXX ; swap
+ PUSH HL ; save pointer to next literal
+ LD HL,L1915 ; Address: stk-zero - start of table of
+ ; constants
+ EXX ;
+ CALL L1A2D ; routine SKIP-CONS
+ CALL L19FE ; routine STK-CONST
+ EXX ;
+ POP HL ; restore pointer to next literal.
+ EXX ;
+ RET ; return.
+
+; ---------------------------------------
+; THE 'STORE IN A MEMORY AREA' SUBROUTINE
+; ---------------------------------------
+; Offsets $C0 to $DF: 'st-mem-0', 'st-mem-1' etc.
+; Although 32 memory storage locations can be addressed, only six
+; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5)
+; required for these are allocated. ZX81 programmers who wish to
+; use the floating point routines from assembly language may wish to
+; alter the system variable MEM to point to 160 bytes of RAM to have
+; use the full range available.
+; A holds derived offset $00-$1F.
+; Unary so on entry HL points to last value, DE to STKEND.
+
+;; st-mem-xx
+L1A63: PUSH HL ; save the result pointer.
+ EX DE,HL ; transfer to DE.
+ LD HL,($401F) ; fetch MEM the base of memory area.
+ CALL L1A3C ; routine LOC-MEM sets HL to the destination.
+ EX DE,HL ; swap - HL is start, DE is destination.
+ CALL L19F6 ; routine MOVE-FP.
+ ; note. a short ld bc,5; ldir
+ ; the embedded memory check is not required
+ ; so these instructions would be faster!
+ EX DE,HL ; DE = STKEND
+ POP HL ; restore original result pointer
+ RET ; return.
+
+; -------------------------
+; THE 'EXCHANGE' SUBROUTINE
+; -------------------------
+; offset $01: 'exchange'
+; This routine exchanges the last two values on the calculator stack
+; On entry, as always with binary operations,
+; HL=first number, DE=second number
+; On exit, HL=result, DE=stkend.
+
+;; exchange
+L1A72: LD B,$05 ; there are five bytes to be swapped
+
+; start of loop.
+
+;; SWAP-BYTE
+L1A74: LD A,(DE) ; each byte of second
+ LD C,(HL) ; each byte of first
+ EX DE,HL ; swap pointers
+ LD (DE),A ; store each byte of first
+ LD (HL),C ; store each byte of second
+ INC HL ; advance both
+ INC DE ; pointers.
+ DJNZ L1A74 ; loop back to SWAP-BYTE until all 5 done.
+
+ EX DE,HL ; even up the exchanges
+ ; so that DE addresses STKEND.
+ RET ; return.
+
+; ---------------------------------
+; THE 'SERIES GENERATOR' SUBROUTINE
+; ---------------------------------
+; offset $86: 'series-06'
+; offset $88: 'series-08'
+; offset $8C: 'series-0C'
+; The ZX81 uses Chebyshev polynomials to generate approximations for
+; SIN, ATN, LN and EXP. These are named after the Russian mathematician
+; Pafnuty Chebyshev, born in 1821, who did much pioneering work on numerical
+; series. As far as calculators are concerned, Chebyshev polynomials have an
+; advantage over other series, for example the Taylor series, as they can
+; reach an approximation in just six iterations for SIN, eight for EXP and
+; twelve for LN and ATN. The mechanics of the routine are interesting but
+; for full treatment of how these are generated with demonstrations in
+; Sinclair BASIC see "The Complete Spectrum ROM Disassembly" by Dr Ian Logan
+; and Dr Frank O'Hara, published 1983 by Melbourne House.
+
+;; series-xx
+L1A7F: LD B,A ; parameter $00 - $1F to B counter
+ CALL L19A0 ; routine GEN-ENT-1 is called.
+ ; A recursive call to a special entry point
+ ; in the calculator that puts the B register
+ ; in the system variable BREG. The return
+ ; address is the next location and where
+ ; the calculator will expect its first
+ ; instruction - now pointed to by HL'.
+ ; The previous pointer to the series of
+ ; five-byte numbers goes on the machine stack.
+
+; The initialization phase.
+
+ DEFB $2D ;;duplicate x,x
+ DEFB $0F ;;addition x+x
+ DEFB $C0 ;;st-mem-0 x+x
+ DEFB $02 ;;delete .
+ DEFB $A0 ;;stk-zero 0
+ DEFB $C2 ;;st-mem-2 0
+
+; a loop is now entered to perform the algebraic calculation for each of
+; the numbers in the series
+
+;; G-LOOP
+L1A89: DEFB $2D ;;duplicate v,v.
+ DEFB $E0 ;;get-mem-0 v,v,x+2
+ DEFB $04 ;;multiply v,v*x+2
+ DEFB $E2 ;;get-mem-2 v,v*x+2,v
+ DEFB $C1 ;;st-mem-1
+ DEFB $03 ;;subtract
+ DEFB $34 ;;end-calc
+
+; the previous pointer is fetched from the machine stack to H'L' where it
+; addresses one of the numbers of the series following the series literal.
+
+ CALL L19FC ; routine STK-DATA is called directly to
+ ; push a value and advance H'L'.
+ CALL L19A4 ; routine GEN-ENT-2 recursively re-enters
+ ; the calculator without disturbing
+ ; system variable BREG
+ ; H'L' value goes on the machine stack and is
+ ; then loaded as usual with the next address.
+
+ DEFB $0F ;;addition
+ DEFB $01 ;;exchange
+ DEFB $C2 ;;st-mem-2
+ DEFB $02 ;;delete
+
+ DEFB $31 ;;dec-jr-nz
+ DEFB $EE ;;back to L1A89, G-LOOP
+
+; when the counted loop is complete the final subtraction yields the result
+; for example SIN X.
+
+ DEFB $E1 ;;get-mem-1
+ DEFB $03 ;;subtract
+ DEFB $34 ;;end-calc
+
+ RET ; return with H'L' pointing to location
+ ; after last number in series.
+
+; -----------------------
+; Handle unary minus (18)
+; -----------------------
+; Unary so on entry HL points to last value, DE to STKEND.
+
+;; NEGATE
+;; negate
+L1AA0: LD A, (HL) ; fetch exponent of last value on the
+ ; calculator stack.
+ AND A ; test it.
+ RET Z ; return if zero.
+
+ INC HL ; address the byte with the sign bit.
+ LD A,(HL) ; fetch to accumulator.
+ XOR $80 ; toggle the sign bit.
+ LD (HL),A ; put it back.
+ DEC HL ; point to last value again.
+ RET ; return.
+
+; -----------------------
+; Absolute magnitude (27)
+; -----------------------
+; This calculator literal finds the absolute value of the last value,
+; floating point, on calculator stack.
+
+;; abs
+L1AAA: INC HL ; point to byte with sign bit.
+ RES 7,(HL) ; make the sign positive.
+ DEC HL ; point to last value again.
+ RET ; return.
+
+; -----------
+; Signum (26)
+; -----------
+; This routine replaces the last value on the calculator stack,
+; which is in floating point form, with one if positive and with -minus one
+; if negative. If it is zero then it is left as such.
+
+;; sgn
+L1AAF: INC HL ; point to first byte of 4-byte mantissa.
+ LD A,(HL) ; pick up the byte with the sign bit.
+ DEC HL ; point to exponent.
+ DEC (HL) ; test the exponent for
+ INC (HL) ; the value zero.
+
+ SCF ; set the carry flag.
+ CALL NZ,L1AE0 ; routine FP-0/1 replaces last value with one
+ ; if exponent indicates the value is non-zero.
+ ; in either case mantissa is now four zeros.
+
+ INC HL ; point to first byte of 4-byte mantissa.
+ RLCA ; rotate original sign bit to carry.
+ RR (HL) ; rotate the carry into sign.
+ DEC HL ; point to last value.
+ RET ; return.
+
+
+; -------------------------
+; Handle PEEK function (28)
+; -------------------------
+; This function returns the contents of a memory address.
+; The entire address space can be peeked including the ROM.
+
+;; peek
+L1ABE: CALL L0EA7 ; routine FIND-INT puts address in BC.
+ LD A,(BC) ; load contents into A register.
+
+;; IN-PK-STK
+L1AC2: JP L151D ; exit via STACK-A to put value on the
+ ; calculator stack.
+
+; ---------------
+; USR number (29)
+; ---------------
+; The USR function followed by a number 0-65535 is the method by which
+; the ZX81 invokes machine code programs. This function returns the
+; contents of the BC register pair.
+; Note. that STACK-BC re-initializes the IY register to $4000 if a user-written
+; program has altered it.
+
+;; usr-no
+L1AC5: CALL L0EA7 ; routine FIND-INT to fetch the
+ ; supplied address into BC.
+
+ LD HL,L1520 ; address: STACK-BC is
+ PUSH HL ; pushed onto the machine stack.
+ PUSH BC ; then the address of the machine code
+ ; routine.
+
+ RET ; make an indirect jump to the routine
+ ; and, hopefully, to STACK-BC also.
+
+
+; -----------------------
+; Greater than zero ($33)
+; -----------------------
+; Test if the last value on the calculator stack is greater than zero.
+; This routine is also called directly from the end-tests of the comparison
+; routine.
+
+;; GREATER-0
+;; greater-0
+L1ACE: LD A,(HL) ; fetch exponent.
+ AND A ; test it for zero.
+ RET Z ; return if so.
+
+
+ LD A,$FF ; prepare XOR mask for sign bit
+ JR L1ADC ; forward to SIGN-TO-C
+ ; to put sign in carry
+ ; (carry will become set if sign is positive)
+ ; and then overwrite location with 1 or 0
+ ; as appropriate.
+
+; ------------------------
+; Handle NOT operator ($2C)
+; ------------------------
+; This overwrites the last value with 1 if it was zero else with zero
+; if it was any other value.
+;
+; e.g. NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0.
+;
+; The subroutine is also called directly from the end-tests of the comparison
+; operator.
+
+;; NOT
+;; not
+L1AD5: LD A,(HL) ; get exponent byte.
+ NEG ; negate - sets carry if non-zero.
+ CCF ; complement so carry set if zero, else reset.
+ JR L1AE0 ; forward to FP-0/1.
+
+; -------------------
+; Less than zero (32)
+; -------------------
+; Destructively test if last value on calculator stack is less than zero.
+; Bit 7 of second byte will be set if so.
+
+;; less-0
+L1ADB: XOR A ; set xor mask to zero
+ ; (carry will become set if sign is negative).
+
+; transfer sign of mantissa to Carry Flag.
+
+;; SIGN-TO-C
+L1ADC: INC HL ; address 2nd byte.
+ XOR (HL) ; bit 7 of HL will be set if number is negative.
+ DEC HL ; address 1st byte again.
+ RLCA ; rotate bit 7 of A to carry.
+
+; -----------
+; Zero or one
+; -----------
+; This routine places an integer value zero or one at the addressed location
+; of calculator stack or MEM area. The value one is written if carry is set on
+; entry else zero.
+
+;; FP-0/1
+L1AE0: PUSH HL ; save pointer to the first byte
+ LD B,$05 ; five bytes to do.
+
+;; FP-loop
+L1AE3: LD (HL),$00 ; insert a zero.
+ INC HL ;
+ DJNZ L1AE3 ; repeat.
+
+ POP HL ;
+ RET NC ;
+
+ LD (HL),$81 ; make value 1
+ RET ; return.
+
+
+; -----------------------
+; Handle OR operator (07)
+; -----------------------
+; The Boolean OR operator. eg. X OR Y
+; The result is zero if both values are zero else a non-zero value.
+;
+; e.g. 0 OR 0 returns 0.
+; -3 OR 0 returns -3.
+; 0 OR -3 returns 1.
+; -3 OR 2 returns 1.
+;
+; A binary operation.
+; On entry HL points to first operand (X) and DE to second operand (Y).
+
+;; or
+L1AED: LD A,(DE) ; fetch exponent of second number
+ AND A ; test it.
+ RET Z ; return if zero.
+
+ SCF ; set carry flag
+ JR L1AE0 ; back to FP-0/1 to overwrite the first operand
+ ; with the value 1.
+
+
+; -----------------------------
+; Handle number AND number (08)
+; -----------------------------
+; The Boolean AND operator.
+;
+; e.g. -3 AND 2 returns -3.
+; -3 AND 0 returns 0.
+; 0 and -2 returns 0.
+; 0 and 0 returns 0.
+;
+; Compare with OR routine above.
+
+;; no-&-no
+L1AF3: LD A,(DE) ; fetch exponent of second number.
+ AND A ; test it.
+ RET NZ ; return if not zero.
+
+ JR L1AE0 ; back to FP-0/1 to overwrite the first operand
+ ; with zero for return value.
+
+; -----------------------------
+; Handle string AND number (10)
+; -----------------------------
+; e.g. "YOU WIN" AND SCORE>99 will return the string if condition is true
+; or the null string if false.
+
+;; str-&-no
+L1AF8: LD A,(DE) ; fetch exponent of second number.
+ AND A ; test it.
+ RET NZ ; return if number was not zero - the string
+ ; is the result.
+
+; if the number was zero (false) then the null string must be returned by
+; altering the length of the string on the calculator stack to zero.
+
+ PUSH DE ; save pointer to the now obsolete number
+ ; (which will become the new STKEND)
+
+ DEC DE ; point to the 5th byte of string descriptor.
+ XOR A ; clear the accumulator.
+ LD (DE),A ; place zero in high byte of length.
+ DEC DE ; address low byte of length.
+ LD (DE),A ; place zero there - now the null string.
+
+ POP DE ; restore pointer - new STKEND.
+ RET ; return.
+
+; -----------------------------------
+; Perform comparison ($09-$0E, $11-$16)
+; -----------------------------------
+; True binary operations.
+;
+; A single entry point is used to evaluate six numeric and six string
+; comparisons. On entry, the calculator literal is in the B register and
+; the two numeric values, or the two string parameters, are on the
+; calculator stack.
+; The individual bits of the literal are manipulated to group similar
+; operations although the SUB 8 instruction does nothing useful and merely
+; alters the string test bit.
+; Numbers are compared by subtracting one from the other, strings are
+; compared by comparing every character until a mismatch, or the end of one
+; or both, is reached.
+;
+; Numeric Comparisons.
+; --------------------
+; The 'x>y' example is the easiest as it employs straight-thru logic.
+; Number y is subtracted from x and the result tested for greater-0 yielding
+; a final value 1 (true) or 0 (false).
+; For '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: ukp CHR$(12)
+
+ DEFB %00000000
+ DEFB %00011100
+ DEFB %00100010
+ DEFB %01111000
+ DEFB %00100000
+ DEFB %00100000
+ DEFB %01111110
+ DEFB %00000000
+
+; $0B - Character: '$' CHR$(13)
+
+ DEFB %00000000
+ DEFB %00001000
+ DEFB %00111110
+ DEFB %00101000
+ DEFB %00111110
+ DEFB %00001010
+ DEFB %00111110
+ DEFB %00001000
+
+; $0B - Character: ':' CHR$(14)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00010000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00010000
+ DEFB %00000000
+
+; $0B - Character: '?' CHR$(15)
+
+ DEFB %00000000
+ DEFB %00111100
+ DEFB %01000010
+ DEFB %00000100
+ DEFB %00001000
+ DEFB %00000000
+ DEFB %00001000
+ DEFB %00000000
+
+; $10 - Character: '(' CHR$(16)
+
+ DEFB %00000000
+ DEFB %00000100
+ DEFB %00001000
+ DEFB %00001000
+ DEFB %00001000
+ DEFB %00001000
+ DEFB %00000100
+ DEFB %00000000
+
+; $11 - Character: ')' CHR$(17)
+
+ DEFB %00000000
+ DEFB %00100000
+ DEFB %00010000
+ DEFB %00010000
+ DEFB %00010000
+ DEFB %00010000
+ DEFB %00100000
+ DEFB %00000000
+
+; $12 - Character: '>' CHR$(18)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00010000
+ DEFB %00001000
+ DEFB %00000100
+ DEFB %00001000
+ DEFB %00010000
+ DEFB %00000000
+
+; $13 - Character: '<' CHR$(19)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000100
+ DEFB %00001000
+ DEFB %00010000
+ DEFB %00001000
+ DEFB %00000100
+ DEFB %00000000
+
+; $14 - Character: '=' CHR$(20)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00111110
+ DEFB %00000000
+ DEFB %00111110
+ DEFB %00000000
+ DEFB %00000000
+
+; $15 - Character: '+' CHR$(21)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00001000
+ DEFB %00001000
+ DEFB %00111110
+ DEFB %00001000
+ DEFB %00001000
+ DEFB %00000000
+
+; $16 - Character: '-' CHR$(22)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00111110
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+
+; $17 - Character: '*' CHR$(23)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00010100
+ DEFB %00001000
+ DEFB %00111110
+ DEFB %00001000
+ DEFB %00010100
+ DEFB %00000000
+
+; $18 - Character: '/' CHR$(24)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000010
+ DEFB %00000100
+ DEFB %00001000
+ DEFB %00010000
+ DEFB %00100000
+ DEFB %00000000
+
+; $19 - Character: ';' CHR$(25)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00010000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00010000
+ DEFB %00010000
+ DEFB %00100000
+
+; $1A - Character: ',' CHR$(26)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00001000
+ DEFB %00001000
+ DEFB %00010000
+
+; $1B - Character: '"' CHR$(27)
+
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00000000
+ DEFB %00011000
+ DEFB %00011000
+ DEFB %00000000
+
+; $1C - Character: '0' CHR$(28)
+
+ DEFB %00000000
+ DEFB %00111100
+ DEFB %01000110
+ DEFB %01001010
+ DEFB %01010010
+ DEFB %01100010
+ DEFB %00111100
+ DEFB %00000000
+
+; $1D - Character: '1' CHR$(29)
+
+ DEFB %00000000
+ DEFB %00011000
+ DEFB %00101000
+ DEFB %00001000
+ DEFB %00001000
+ DEFB %00001000
+ DEFB %00111110
+ DEFB %00000000
+
+; $1E - Character: '2' CHR$(30)
+
+ DEFB %00000000
+ DEFB %00111100
+ DEFB %01000010
+ DEFB %00000010
+ DEFB %00111100
+ DEFB %01000000
+ DEFB %01111110
+ DEFB %00000000
+
+; $1F - Character: '3' CHR$(31)
+
+ DEFB %00000000
+ DEFB %00111100
+ DEFB %01000010
+ DEFB %00001100
+ DEFB %00000010
+ DEFB %01000010
+ DEFB %00111100
+ DEFB %00000000
+
+; $20 - Character: '4' CHR$(32)
+
+ DEFB %00000000
+ DEFB %00001000
+ DEFB %00011000
+ DEFB %00101000
+ DEFB %01001000
+ DEFB %01111110
+ DEFB %00001000
+ DEFB %00000000
+
+; $21 - Character: '5' CHR$(33)
+
+ DEFB %00000000
+ DEFB %01111110
+ DEFB %01000000
+ DEFB %01111100
+ DEFB %00000010
+ DEFB %01000010
+ DEFB %00111100
+ DEFB %00000000
+
+; $22 - Character: '6' CHR$(34)
+
+ DEFB %00000000
+ DEFB %00111100
+ DEFB %01000000
+ DEFB %01111100
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %00111100
+ DEFB %00000000
+
+; $23 - Character: '7' CHR$(35)
+
+ DEFB %00000000
+ DEFB %01111110
+ DEFB %00000010
+ DEFB %00000100
+ DEFB %00001000
+ DEFB %00010000
+ DEFB %00010000
+ DEFB %00000000
+
+; $24 - Character: '8' CHR$(36)
+
+ DEFB %00000000
+ DEFB %00111100
+ DEFB %01000010
+ DEFB %00111100
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %00111100
+ DEFB %00000000
+
+; $25 - Character: '9' CHR$(37)
+
+ DEFB %00000000
+ DEFB %00111100
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %00111110
+ DEFB %00000010
+ DEFB %00111100
+ DEFB %00000000
+
+; $26 - Character: 'A' CHR$(38)
+
+ DEFB %00000000
+ DEFB %00111100
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01111110
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %00000000
+
+; $27 - Character: 'B' CHR$(39)
+
+ DEFB %00000000
+ DEFB %01111100
+ DEFB %01000010
+ DEFB %01111100
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01111100
+ DEFB %00000000
+
+; $28 - Character: 'C' CHR$(40)
+
+ DEFB %00000000
+ DEFB %00111100
+ DEFB %01000010
+ DEFB %01000000
+ DEFB %01000000
+ DEFB %01000010
+ DEFB %00111100
+ DEFB %00000000
+
+; $29 - Character: 'D' CHR$(41)
+
+ DEFB %00000000
+ DEFB %01111000
+ DEFB %01000100
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01000100
+ DEFB %01111000
+ DEFB %00000000
+
+; $2A - Character: 'E' CHR$(42)
+
+ DEFB %00000000
+ DEFB %01111110
+ DEFB %01000000
+ DEFB %01111100
+ DEFB %01000000
+ DEFB %01000000
+ DEFB %01111110
+ DEFB %00000000
+
+; $2B - Character: 'F' CHR$(43)
+
+ DEFB %00000000
+ DEFB %01111110
+ DEFB %01000000
+ DEFB %01111100
+ DEFB %01000000
+ DEFB %01000000
+ DEFB %01000000
+ DEFB %00000000
+
+; $2C - Character: 'G' CHR$(44)
+
+ DEFB %00000000
+ DEFB %00111100
+ DEFB %01000010
+ DEFB %01000000
+ DEFB %01001110
+ DEFB %01000010
+ DEFB %00111100
+ DEFB %00000000
+
+; $2D - Character: 'H' CHR$(45)
+
+ DEFB %00000000
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01111110
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %00000000
+
+; $2E - Character: 'I' CHR$(46)
+
+ DEFB %00000000
+ DEFB %00111110
+ DEFB %00001000
+ DEFB %00001000
+ DEFB %00001000
+ DEFB %00001000
+ DEFB %00111110
+ DEFB %00000000
+
+; $2F - Character: 'J' CHR$(47)
+
+ DEFB %00000000
+ DEFB %00000010
+ DEFB %00000010
+ DEFB %00000010
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %00111100
+ DEFB %00000000
+
+; $30 - Character: 'K' CHR$(48)
+
+ DEFB %00000000
+ DEFB %01000100
+ DEFB %01001000
+ DEFB %01110000
+ DEFB %01001000
+ DEFB %01000100
+ DEFB %01000010
+ DEFB %00000000
+
+; $31 - Character: 'L' CHR$(49)
+
+ DEFB %00000000
+ DEFB %01000000
+ DEFB %01000000
+ DEFB %01000000
+ DEFB %01000000
+ DEFB %01000000
+ DEFB %01111110
+ DEFB %00000000
+
+; $32 - Character: 'M' CHR$(50)
+
+ DEFB %00000000
+ DEFB %01000010
+ DEFB %01100110
+ DEFB %01011010
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %00000000
+
+; $33 - Character: 'N' CHR$(51)
+
+ DEFB %00000000
+ DEFB %01000010
+ DEFB %01100010
+ DEFB %01010010
+ DEFB %01001010
+ DEFB %01000110
+ DEFB %01000010
+ DEFB %00000000
+
+; $34 - Character: 'O' CHR$(52)
+
+ DEFB %00000000
+ DEFB %00111100
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %00111100
+ DEFB %00000000
+
+; $35 - Character: 'P' CHR$(53)
+
+ DEFB %00000000
+ DEFB %01111100
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01111100
+ DEFB %01000000
+ DEFB %01000000
+ DEFB %00000000
+
+; $36 - Character: 'Q' CHR$(54)
+
+ DEFB %00000000
+ DEFB %00111100
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01010010
+ DEFB %01001010
+ DEFB %00111100
+ DEFB %00000000
+
+; $37 - Character: 'R' CHR$(55)
+
+ DEFB %00000000
+ DEFB %01111100
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01111100
+ DEFB %01000100
+ DEFB %01000010
+ DEFB %00000000
+
+; $38 - Character: 'S' CHR$(56)
+
+ DEFB %00000000
+ DEFB %00111100
+ DEFB %01000000
+ DEFB %00111100
+ DEFB %00000010
+ DEFB %01000010
+ DEFB %00111100
+ DEFB %00000000
+
+; $39 - Character: 'T' CHR$(57)
+
+ DEFB %00000000
+ DEFB %11111110
+ DEFB %00010000
+ DEFB %00010000
+ DEFB %00010000
+ DEFB %00010000
+ DEFB %00010000
+ DEFB %00000000
+
+; $3A - Character: 'U' CHR$(58)
+
+ DEFB %00000000
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %00111100
+ DEFB %00000000
+
+; $3B - Character: 'V' CHR$(59)
+
+ DEFB %00000000
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %00100100
+ DEFB %00011000
+ DEFB %00000000
+
+; $3C - Character: 'W' CHR$(60)
+
+ DEFB %00000000
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01000010
+ DEFB %01011010
+ DEFB %00100100
+ DEFB %00000000
+
+; $3D - Character: 'X' CHR$(61)
+
+ DEFB %00000000
+ DEFB %01000010
+ DEFB %00100100
+ DEFB %00011000
+ DEFB %00011000
+ DEFB %00100100
+ DEFB %01000010
+ DEFB %00000000
+
+; $3E - Character: 'Y' CHR$(62)
+
+ DEFB %00000000
+ DEFB %10000010
+ DEFB %01000100
+ DEFB %00101000
+ DEFB %00010000
+ DEFB %00010000
+ DEFB %00010000
+ DEFB %00000000
+
+; $3F - Character: 'Z' CHR$(63)
+
+ DEFB %00000000
+ DEFB %01111110
+ DEFB %00000100
+ DEFB %00001000
+ DEFB %00010000
+ DEFB %00100000
+ DEFB %01111110
+ DEFB %00000000
+
+.END ;TASM assembler instruction.
+
+
