torpes.asm

        define  consta  $69
        org     $0000
        output  torpes.rom

;*****************************************
;** Part 1. RESTART ROUTINES AND TABLES **
;*****************************************

; -----------
; THE 'START'
; -----------
;   At switch on, the Z80 chip is in Interrupt Mode 0.
;   The Spectrum uses Interrupt Mode 1.
;   This location can also be 'called' to reset the machine.
;   Typically with PRINT USR 0.

;; START
L0000:  DI                      ; Disable Interrupts.
        XOR     A               ; Signal coming from START.
        ld      hl, $ffff       ; Set pointer to top of possible physical RAM.
        jp      L11C8           ; Jump forward to common code at START-NEW.

; -------------------
; THE 'ERROR' RESTART
; -------------------
;   The error pointer is made to point to the position of the error to enable
;   the editor to highlight the error position if it occurred during syntax 
;   checking.  It is used at 37 places in the program.  An instruction fetch 
;   on address $0008 may page in a peripheral ROM such as the Sinclair 
;   Interface 1 or Disciple Disk Interface.  This was not an original design 
;   concept and not all errors pass through here.

;; ERROR-1
L0008:  LD      HL,($5C5D)      ; Fetch the character address from CH_ADD.
        LD      ($5C5F),HL      ; Copy it to the error pointer X_PTR.
        JR      L0053           ; Forward to continue at ERROR-2.

; -----------------------------
; THE 'PRINT CHARACTER' RESTART
; -----------------------------
;   The A register holds the code of the character that is to be sent to
;   the output stream of the current channel.  The alternate register set is 
;   used to output a character in the A register so there is no need to 
;   preserve any of the current main registers (HL, DE, BC).  
;   This restart is used 21 times.

;; PRINT-A
L0010:  JP      L15F2           ; Jump forward to continue at PRINT-A-2.

; ---

        DEFB    $FF, $FF, $FF   ; Five unused locations.
        DEFB    $FF, $FF        ;

; -------------------------------
; THE 'COLLECT CHARACTER' RESTART
; -------------------------------
;   The contents of the location currently addressed by CH_ADD are fetched.
;   A return is made if the value represents a character that has
;   relevance to the BASIC parser. Otherwise CH_ADD is incremented and the
;   tests repeated. CH_ADD will be addressing somewhere -
;   1) in the BASIC program area during line execution.
;   2) in workspace if evaluating, for example, a string expression.
;   3) in the edit buffer if parsing a direct command or a new BASIC line.
;   4) in workspace if accepting input but not that from INPUT LINE.

;; GET-CHAR
L0018:  LD      HL,($5C5D)      ; fetch the address from CH_ADD.
        LD      A,(HL)          ; use it to pick up current character.

;; TEST-CHAR
L001C:  CALL    L007D           ; routine SKIP-OVER tests if the character is
                                ; relevant.
        RET     NC              ; Return if it is significant.

; ------------------------------------
; THE 'COLLECT NEXT CHARACTER' RESTART
; ------------------------------------
;   As the BASIC commands and expressions are interpreted, this routine is
;   called repeatedly to step along the line.  It is used 83 times.

;; NEXT-CHAR
L0020:  CALL    L0074           ; routine CH-ADD+1 fetches the next immediate
                                ; character.
        JR      L001C           ; jump back to TEST-CHAR until a valid
                                ; character is found.

; ---

        DEFB    $FF, $FF, $FF   ; unused

; -----------------------
; THE 'CALCULATE' RESTART
; -----------------------
;   This restart enters the Spectrum's internal, floating-point, stack-based, 
;   FORTH-like language.
;   It is further used recursively from within the calculator.
;   It is used on 77 occasions.

;; FP-CALC
L0028:  JP      L335B           ; jump forward to the CALCULATE routine.

; ---

        DEFB    $FF, $FF, $FF   ; spare - note that on the ZX81, space being a 
        DEFB    $FF, $FF        ; little cramped, these same locations were
                                ; used for the five-byte end-calc literal.

; ------------------------------
; THE 'CREATE BC SPACES' RESTART
; ------------------------------
;   This restart is used on only 12 occasions to create BC spaces
;   between workspace and the calculator stack.

;; BC-SPACES
L0030:  PUSH    BC              ; Save number of spaces.
        LD      HL,($5C61)      ; Fetch WORKSP.
        PUSH    HL              ; Save address of workspace.
        JP      L169E           ; Jump forward to continuation code RESERVE.

; --------------------------------
; THE 'MASKABLE INTERRUPT' ROUTINE
; --------------------------------
;   This routine increments the Spectrum's three-byte FRAMES counter fifty 
;   times a second (sixty times a second in the USA ).
;   Both this routine and the called KEYBOARD subroutine use the IY register 
;   to access system variables and flags so a user-written program must 
;   disable interrupts to make use of the IY register.

;; MASK-INT
L0038:  PUSH    AF              ; Save the registers that will be used but not
        PUSH    HL              ; the IY register unfortunately.
        LD      HL,($5C78)      ; Fetch the first two bytes at FRAMES1.
        INC     HL              ; Increment lowest two bytes of counter.
        LD      ($5C78),HL      ; Place back in FRAMES1.
        LD      A,H             ; Test if the result was zero.
        OR      L               ;            
        JR      NZ,L0048        ; Forward, if not, to KEY-INT

        INC     (IY+$40)        ; otherwise increment FRAMES3 the third byte.

;   Now save the rest of the main registers and read and decode the keyboard.

;; KEY-INT
L0048:  PUSH    BC              ; Save the other main registers.
        PUSH    DE              ;                 

        CALL    L02BF           ; Routine KEYBOARD executes a stage in the 
                                ; process of reading a key-press.
        POP     DE              ;
        POP     BC              ; Restore registers.

        POP     HL              ;
        POP     AF              ;

        EI                      ; Enable Interrupts.
        RET                     ; Return.

; ---------------------
; THE 'ERROR-2' ROUTINE
; ---------------------
;   A continuation of the code at 0008.
;   The error code is stored and after clearing down stacks, an indirect jump 
;   is made to MAIN-4, etc. to handle the error.

;; ERROR-2
L0053:  POP     HL              ; drop the return address - the location
                                ; after the RST 08H instruction.
        LD      L,(HL)          ; fetch the error code that follows.
                                ; (nice to see this instruction used.)

;   Note. this entry point is used when out of memory at REPORT-4.
;   The L register has been loaded with the report code but X-PTR is not
;   updated.

;; ERROR-3
L0055:  LD      (IY+$00),L      ; Store it in the system variable ERR_NR.
        LD      SP,($5C3D)      ; ERR_SP points to an error handler on the
                                ; machine stack. There may be a hierarchy
                                ; of routines.
                                ; To MAIN-4 initially at base.
                                ; or REPORT-G on line entry.
                                ; or  ED-ERROR when editing.
                                ; or   ED-FULL during ed-enter.
                                ; or  IN-VAR-1 during runtime input etc.

        JP      L16C5           ; Jump to SET-STK to clear the calculator stack 
                                ; and reset MEM to usual place in the systems 
                                ; variables area and then indirectly to MAIN-4, 
                                ; etc.

; ---

        DEFB    $FF, $FF, $FF   ; Unused locations
        DEFB    $FF, $FF, $FF   ; before the fixed-position
        DEFB    $FF             ; NMI routine.

; ------------------------------------
; THE 'NON-MASKABLE INTERRUPT' ROUTINE
; ------------------------------------
;   
;   There is no NMI switch on the standard Spectrum or its peripherals.
;   When the NMI line is held low, then no matter what the Z80 was doing at 
;   the time, it will now execute the code at 66 Hex.
;   This Interrupt Service Routine will jump to location zero if the contents 
;   of the system variable NMIADD are zero or return if the location holds a
;   non-zero address.   So attaching a simple switch to the NMI as in the book 
;   "Spectrum Hardware Manual" causes a reset.  The logic was obviously 
;   intended to work the other way.  Sinclair Research said that, since they
;   had never advertised the NMI, they had no plans to fix the error "until 
;   the opportunity arose".
;   
;   Note. The location NMIADD was, in fact, later used by Sinclair Research 
;   to enhance the text channel on the ZX Interface 1.
;   On later Amstrad-made Spectrums, and the Brazilian Spectrum, the logic of 
;   this routine was indeed reversed but not as at first intended.
;
;   It can be deduced by looking elsewhere in this ROM that the NMIADD system
;   variable pointed to L121C and that this enabled a Warm Restart to be 
;   performed at any time, even while playing machine code games, or while 
;   another Spectrum has been allowed to gain control of this one. 
;
;   Software houses would have been able to protect their games from attack by
;   placing two zeros in the NMIADD system variable.

;; RESET
L0066:  PUSH    AF              ; save the
        PUSH    HL              ; registers.
        LD      HL,($5CB0)      ; fetch the system variable NMIADD.
        LD      A,H             ; test address
        OR      L               ; for zero.

        JR      NZ,L0070        ; skip to NO-RESET if NOT ZERO

        JP      (HL)            ; jump to routine ( i.e. L0000 )

;; NO-RESET
L0070:  POP     HL              ; restore the
        POP     AF              ; registers.
        RETN                    ; return to previous interrupt state.

; ---------------------------
; THE 'CH ADD + 1' SUBROUTINE
; ---------------------------
;   This subroutine is called from RST 20, and three times from elsewhere
;   to fetch the next immediate character following the current valid character
;   address and update the associated system variable.
;   The entry point TEMP-PTR1 is used from the SCANNING routine.
;   Both TEMP-PTR1 and TEMP-PTR2 are used by the READ command routine.

;; CH-ADD+1
L0074:  LD      HL,($5C5D)      ; fetch address from CH_ADD.

;; TEMP-PTR1
L0077:  INC     HL              ; increase the character address by one.

;; TEMP-PTR2
L0078:  LD      ($5C5D),HL      ; update CH_ADD with character address.

X007B:  LD      A,(HL)          ; load character to A from HL.
        RET                     ; and return.

; --------------------------
; THE 'SKIP OVER' SUBROUTINE
; --------------------------
;   This subroutine is called once from RST 18 to skip over white-space and
;   other characters irrelevant to the parsing of a BASIC line etc. .
;   Initially the A register holds the character to be considered
;   and HL holds its address which will not be within quoted text
;   when a BASIC line is parsed.
;   Although the 'tab' and 'at' characters will not appear in a BASIC line,
;   they could be present in a string expression, and in other situations.
;   Note. although white-space is usually placed in a program to indent loops
;   and make it more readable, it can also be used for the opposite effect and
;   spaces may appear in variable names although the parser never sees them.
;   It is this routine that helps make the variables 'Anum bEr5 3BUS' and
;   'a number 53 bus' appear the same to the parser.

;; SKIP-OVER
L007D:  CP      $21             ; test if higher than space.
        RET     NC              ; return with carry clear if so.

        CP      $0D             ; carriage return ?
        RET     Z               ; return also with carry clear if so.

                                ; all other characters have no relevance
                                ; to the parser and must be returned with
                                ; carry set.

        CP      $10             ; test if 0-15d
        RET     C               ; return, if so, with carry set.

        CP      $18             ; test if 24-32d
        CCF                     ; complement carry flag.
        RET     C               ; return with carry set if so.

                                ; now leaves 16d-23d

        INC     HL              ; all above have at least one extra character
                                ; to be stepped over.

        CP      $16             ; controls 22d ('at') and 23d ('tab') have two.
        JR      C,L0090         ; forward to SKIPS with ink, paper, flash,
                                ; bright, inverse or over controls.
                                ; Note. the high byte of tab is for RS232 only.
                                ; it has no relevance on this machine.

        INC     HL              ; step over the second character of 'at'/'tab'.

;; SKIPS
L0090:  SCF                     ; set the carry flag
        LD      ($5C5D),HL      ; update the CH_ADD system variable.
        RET                     ; return with carry set.


; ------------------
; THE 'TOKEN' TABLES
; ------------------
;   The tokenized characters 134d (RND) to 255d (COPY) are expanded using
;   this table. The last byte of a token is inverted to denote the end of
;   the word. The first is an inverted step-over byte.

;; TKN-TABLE
L0095:  DEFB    '?'+$80
        DEFM    "RN"
        DEFB    'D'+$80
        DEFM    "INKEY"
        DEFB    '$'+$80
        DEFB    'P','I'+$80
        DEFB    'F','N'+$80
        DEFM    "POIN"
        DEFB    'T'+$80
        DEFM    "SCREEN"
        DEFB    '$'+$80
        DEFM    "ATT"
        DEFB    'R'+$80
        DEFB    'A','T'+$80
        DEFM    "TA"
        DEFB    'B'+$80
        DEFM    "VAL"
        DEFB    '$'+$80
        DEFM    "COD"
        DEFB    'E'+$80
        DEFM    "VA"
        DEFB    'L'+$80
        DEFM    "LE"
        DEFB    'N'+$80
        DEFM    "SI"
        DEFB    'N'+$80
        DEFM    "CO"
        DEFB    'S'+$80
        DEFM    "TA"
        DEFB    'N'+$80
        DEFM    "AS"
        DEFB    'N'+$80
        DEFM    "AC"
        DEFB    'S'+$80
        DEFM    "AT"
        DEFB    'N'+$80
        DEFB    'L','N'+$80
        DEFM    "EX"
        DEFB    'P'+$80
        DEFM    "IN"
        DEFB    'T'+$80
        DEFM    "SQ"
        DEFB    'R'+$80
        DEFM    "SG"
        DEFB    'N'+$80
        DEFM    "AB"
        DEFB    'S'+$80
        DEFM    "PEE"
        DEFB    'K'+$80
        DEFB    'I','N'+$80
        DEFM    "US"
        DEFB    'R'+$80
        DEFM    "STR"
        DEFB    '$'+$80
        DEFM    "CHR"
        DEFB    '$'+$80
        DEFM    "NO"
        DEFB    'T'+$80
        DEFM    "BI"
        DEFB    'N'+$80

;   The previous 32 function-type words are printed without a leading space
;   The following have a leading space if they begin with a letter

        DEFB    'O','R'+$80
        DEFM    "AN"
        DEFB    'D'+$80
        DEFB    $3C,'='+$80             ; <=
        DEFB    $3E,'='+$80             ; >=
        DEFB    $3C,$3E+$80             ; <>
        DEFM    "LIN"
        DEFB    'E'+$80
        DEFM    "THE"
        DEFB    'N'+$80
        DEFB    'T','O'+$80
        DEFM    "STE"
        DEFB    'P'+$80
        DEFM    "DEF F"
        DEFB    'N'+$80
        DEFM    "CA"
        DEFB    'T'+$80
        DEFM    "FORMA"
        DEFB    'T'+$80
        DEFM    "MOV"
        DEFB    'E'+$80
        DEFM    "ERAS"
        DEFB    'E'+$80
        DEFM    "OPEN "
        DEFB    '#'+$80
        DEFM    "CLOSE "
        DEFB    '#'+$80
        DEFM    "MERG"
        DEFB    'E'+$80
        DEFM    "VERIF"
        DEFB    'Y'+$80
        DEFM    "BEE"
        DEFB    'P'+$80
        DEFM    "CIRCL"
        DEFB    'E'+$80
        DEFM    "IN"
        DEFB    'K'+$80
        DEFM    "PAPE"
        DEFB    'R'+$80
        DEFM    "FLAS"
        DEFB    'H'+$80
        DEFM    "BRIGH"
        DEFB    'T'+$80
        DEFM    "INVERS"
        DEFB    'E'+$80
        DEFM    "OVE"
        DEFB    'R'+$80
        DEFM    "OU"
        DEFB    'T'+$80
        DEFM    "LPRIN"
        DEFB    'T'+$80
        DEFM    "LLIS"
        DEFB    'T'+$80
        DEFM    "STO"
        DEFB    'P'+$80
        DEFM    "REA"
        DEFB    'D'+$80
        DEFM    "DAT"
        DEFB    'A'+$80
        DEFM    "RESTOR"
        DEFB    'E'+$80
        DEFM    "NE"
        DEFB    'W'+$80
        DEFM    "BORDE"
        DEFB    'R'+$80
        DEFM    "CONTINU"
        DEFB    'E'+$80
        DEFM    "DI"
        DEFB    'M'+$80
        DEFM    "RE"
        DEFB    'M'+$80
        DEFM    "FO"
        DEFB    'R'+$80
        DEFM    "GO T"
        DEFB    'O'+$80
        DEFM    "GO SU"
        DEFB    'B'+$80
        DEFM    "INPU"
        DEFB    'T'+$80
        DEFM    "LOA"
        DEFB    'D'+$80
        DEFM    "LIS"
        DEFB    'T'+$80
        DEFM    "LE"
        DEFB    'T'+$80
        DEFM    "PAUS"
        DEFB    'E'+$80
        DEFM    "NEX"
        DEFB    'T'+$80
        DEFM    "POK"
        DEFB    'E'+$80
        DEFM    "PRIN"
        DEFB    'T'+$80
        DEFM    "PLO"
        DEFB    'T'+$80
        DEFM    "RU"
        DEFB    'N'+$80
        DEFM    "SAV"
        DEFB    'E'+$80
        DEFM    "RANDOMIZ"
        DEFB    'E'+$80
        DEFB    'I','F'+$80
        DEFM    "CL"
        DEFB    'S'+$80
        DEFM    "DRA"
        DEFB    'W'+$80
        DEFM    "CLEA"
        DEFB    'R'+$80
        DEFM    "RETUR"
        DEFB    'N'+$80
        DEFM    "COP"
        DEFB    'Y'+$80

; ----------------
; THE 'KEY' TABLES
; ----------------
;   These six look-up tables are used by the keyboard reading routine
;   to decode the key values.
;
;   The first table contains the maps for the 39 keys of the standard
;   40-key Spectrum keyboard. The remaining key [SHIFT $27] is read directly.
;   The keys consist of the 26 upper-case alphabetic characters, the 10 digit
;   keys and the space, ENTER and symbol shift key.
;   Unshifted alphabetic keys have $20 added to the value.
;   The keywords for the main alphabetic keys are obtained by adding $A5 to
;   the values obtained from this table.

;; MAIN-KEYS
L0205:  DEFB    $42             ; B
        DEFB    $48             ; H
        DEFB    $59             ; Y
        DEFB    $36             ; 6
        DEFB    $35             ; 5
        DEFB    $54             ; T
        DEFB    $47             ; G
        DEFB    $56             ; V
        DEFB    $4E             ; N
        DEFB    $4A             ; J
        DEFB    $55             ; U
        DEFB    $37             ; 7
        DEFB    $34             ; 4
        DEFB    $52             ; R
        DEFB    $46             ; F
        DEFB    $43             ; C
        DEFB    $4D             ; M
        DEFB    $4B             ; K
        DEFB    $49             ; I
        DEFB    $38             ; 8
        DEFB    $33             ; 3
        DEFB    $45             ; E
        DEFB    $44             ; D
        DEFB    $58             ; X
        DEFB    $0E             ; SYMBOL SHIFT
        DEFB    $4C             ; L
        DEFB    $4F             ; O
        DEFB    $39             ; 9
        DEFB    $32             ; 2
        DEFB    $57             ; W
        DEFB    $53             ; S
        DEFB    $5A             ; Z
        DEFB    $20             ; SPACE
        DEFB    $0D             ; ENTER
        DEFB    $50             ; P
        DEFB    $30             ; 0
        DEFB    $31             ; 1
        DEFB    $51             ; Q
        DEFB    $41             ; A


;; E-UNSHIFT
;  The 26 unshifted extended mode keys for the alphabetic characters.
;  The green keywords on the original keyboard.
L022C:  DEFB    $E3             ; READ
        DEFB    $C4             ; BIN
        DEFB    $E0             ; LPRINT
        DEFB    $E4             ; DATA
        DEFB    $B4             ; TAN
        DEFB    $BC             ; SGN
        DEFB    $BD             ; ABS
        DEFB    $BB             ; SQR
        DEFB    $AF             ; CODE
        DEFB    $B0             ; VAL
        DEFB    $B1             ; LEN
        DEFB    $C0             ; USR
        DEFB    $A7             ; PI
        DEFB    $A6             ; INKEY$
        DEFB    $BE             ; PEEK
        DEFB    $AD             ; TAB
        DEFB    $B2             ; SIN
        DEFB    $BA             ; INT
        DEFB    $E5             ; RESTORE
        DEFB    $A5             ; RND
        DEFB    $C2             ; CHR$
        DEFB    $E1             ; LLIST
        DEFB    $B3             ; COS
        DEFB    $B9             ; EXP
        DEFB    $C1             ; STR$
        DEFB    $B8             ; LN


;; EXT-SHIFT
;  The 26 shifted extended mode keys for the alphabetic characters.
;  The red keywords below keys on the original keyboard.
L0246:  DEFB    $7E             ; ~
        DEFB    $DC             ; BRIGHT
        DEFB    $DA             ; PAPER
        DEFB    $5C             ; \
        DEFB    $B7             ; ATN
        DEFB    $7B             ; {
        DEFB    $7D             ; }
        DEFB    $D8             ; CIRCLE
        DEFB    $BF             ; IN
        DEFB    $AE             ; VAL$
        DEFB    $AA             ; SCREEN$
        DEFB    $AB             ; ATTR
        DEFB    $DD             ; INVERSE
        DEFB    $DE             ; OVER
        DEFB    $DF             ; OUT
        DEFB    $7F             ; (Copyright character)
        DEFB    $B5             ; ASN
        DEFB    $D6             ; VERIFY
        DEFB    $7C             ; |
        DEFB    $D5             ; MERGE
        DEFB    $5D             ; ]
        DEFB    $DB             ; FLASH
        DEFB    $B6             ; ACS
        DEFB    $D9             ; INK
        DEFB    $5B             ; [
        DEFB    $D7             ; BEEP


;; CTL-CODES
;  The ten control codes assigned to the top line of digits when the shift 
;  key is pressed.
L0260:  DEFB    $0C             ; DELETE
        DEFB    $07             ; EDIT
        DEFB    $06             ; CAPS LOCK
        DEFB    $04             ; TRUE VIDEO
        DEFB    $05             ; INVERSE VIDEO
        DEFB    $08             ; CURSOR LEFT
        DEFB    $0A             ; CURSOR DOWN
        DEFB    $0B             ; CURSOR UP
        DEFB    $09             ; CURSOR RIGHT
        DEFB    $0F             ; GRAPHICS


;; SYM-CODES
;  The 26 red symbols assigned to the alphabetic characters of the keyboard.
;  The ten single-character digit symbols are converted without the aid of
;  a table using subtraction and minor manipulation. 
L026A:  DEFB    $E2             ; STOP
        DEFB    $2A             ; *
        DEFB    $3F             ; ?
        DEFB    $CD             ; STEP
        DEFB    $C8             ; >=
        DEFB    $CC             ; TO
        DEFB    $CB             ; THEN
        DEFB    $5E             ; ^
        DEFB    $AC             ; AT
        DEFB    $2D             ; -
        DEFB    $2B             ; +
        DEFB    $3D             ; =
        DEFB    $2E             ; .
        DEFB    $2C             ; ,
        DEFB    $3B             ; ;
        DEFB    $22             ; "
        DEFB    $C7             ; <=
        DEFB    $3C             ; <
        DEFB    $C3             ; NOT
        DEFB    $3E             ; >
        DEFB    $C5             ; OR
        DEFB    $2F             ; /
        DEFB    $C9             ; <>
        DEFB    $60             ; pound
        DEFB    $C6             ; AND
        DEFB    $3A             ; :

;; E-DIGITS
;  The ten keywords assigned to the digits in extended mode.
;  The remaining red keywords below the keys.
L0284:  DEFB    $D0             ; FORMAT
        DEFB    $CE             ; DEF FN
        DEFB    $A8             ; FN
        DEFB    $CA             ; LINE
        DEFB    $D3             ; OPEN #
        DEFB    $D4             ; CLOSE #
        DEFB    $D1             ; MOVE
        DEFB    $D2             ; ERASE
        DEFB    $A9             ; POINT
        DEFB    $CF             ; CAT


;*******************************
;** Part 2. KEYBOARD ROUTINES **
;*******************************

;   Using shift keys and a combination of modes the Spectrum 40-key keyboard
;   can be mapped to 256 input characters

; ---------------------------------------------------------------------------
;
;         0     1     2     3     4 -Bits-  4     3     2     1     0
; PORT                                                                    PORT
;
; F7FE  [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ]  |  [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 0 ]   EFFE
;  ^                                   |                                   v
; FBFE  [ Q ] [ W ] [ E ] [ R ] [ T ]  |  [ Y ] [ U ] [ I ] [ O ] [ P ]   DFFE
;  ^                                   |                                   v
; FDFE  [ A ] [ S ] [ D ] [ F ] [ G ]  |  [ H ] [ J ] [ K ] [ L ] [ ENT ] BFFE
;  ^                                   |                                   v
; FEFE  [SHI] [ Z ] [ X ] [ C ] [ V ]  |  [ B ] [ N ] [ M ] [sym] [ SPC ] 7FFE
;  ^     $27                                                 $18           v
; Start                                                                   End
;        00100111                                            00011000
;
; ---------------------------------------------------------------------------
;   The above map may help in reading.
;   The neat arrangement of ports means that the B register need only be
;   rotated left to work up the left hand side and then down the right
;   hand side of the keyboard. When the reset bit drops into the carry
;   then all 8 half-rows have been read. Shift is the first key to be
;   read. The lower six bits of the shifts are unambiguous.

; -------------------------------
; THE 'KEYBOARD SCANNING' ROUTINE
; -------------------------------
;   From keyboard and s-inkey$
;   Returns 1 or 2 keys in DE, most significant shift first if any
;   key values 0-39 else 255

;; KEY-SCAN
L028E:  LD      L,$2F           ; initial key value
                                ; valid values are obtained by subtracting
                                ; eight five times.
        LD      DE,$FFFF        ; a buffer to receive 2 keys.

        LD      BC,$FEFE        ; the commencing port address
                                ; B holds 11111110 initially and is also
                                ; used to count the 8 half-rows
;; KEY-LINE
L0296:  IN      A,(C)           ; read the port to A - bits will be reset
                                ; if a key is pressed else set.
        CPL                     ; complement - pressed key-bits are now set
        AND     $1F             ; apply 00011111 mask to pick up the
                                ; relevant set bits.

        JR      Z,L02AB         ; forward to KEY-DONE if zero and therefore
                                ; no keys pressed in row at all.

        LD      H,A             ; transfer row bits to H
        LD      A,L             ; load the initial key value to A

;; KEY-3KEYS
L029F:  INC     D               ; now test the key buffer
        RET     NZ              ; if we have collected 2 keys already
                                ; then too many so quit.

;; KEY-BITS
L02A1:  SUB     $08             ; subtract 8 from the key value
                                ; cycling through key values (top = $27)
                                ; e.g. 2F>   27>1F>17>0F>07
                                ;      2E>   26>1E>16>0E>06
        SRL     H               ; shift key bits right into carry.
        JR      NC,L02A1        ; back to KEY-BITS if not pressed
                                ; but if pressed we have a value (0-39d)

        LD      D,E             ; transfer a possible previous key to D
        LD      E,A             ; transfer the new key to E
        JR      NZ,L029F        ; back to KEY-3KEYS if there were more
                                ; set bits - H was not yet zero.

;; KEY-DONE
L02AB:  DEC     L               ; cycles 2F>2E>2D>2C>2B>2A>29>28 for
                                ; each half-row.
        RLC     B               ; form next port address e.g. FEFE > FDFE
        JR      C,L0296         ; back to KEY-LINE if still more rows to do.

        LD      A,D             ; now test if D is still FF ?
        INC     A               ; if it is zero we have at most 1 key
                                ; range now $01-$28  (1-40d)
        RET     Z               ; return if one key or no key.

        CP      $28             ; is it capsshift (was $27) ?
        RET     Z               ; return if so.

        CP      $19             ; is it symbol shift (was $18) ?
        RET     Z               ; return also

        LD      A,E             ; now test E
        LD      E,D             ; but first switch
        LD      D,A             ; the two keys.
        CP      $18             ; is it symbol shift ?
        RET                     ; return (with zero set if it was).
                                ; but with symbol shift now in D

; ----------------------
; THE 'KEYBOARD' ROUTINE
; ----------------------
;   Called from the interrupt 50 times a second.
;

;; KEYBOARD
L02BF:  CALL    L028E           ; routine KEY-SCAN
        RET     NZ              ; return if invalid combinations

;   then decrease the counters within the two key-state maps
;   as this could cause one to become free.
;   if the keyboard has not been pressed during the last five interrupts
;   then both sets will be free.


        LD      HL,$5C00        ; point to KSTATE-0

;; K-ST-LOOP
L02C6:  BIT     7,(HL)          ; is it free ?  (i.e. $FF)
        JR      NZ,L02D1        ; forward to K-CH-SET if so

        INC     HL              ; address the 5-counter
        DEC     (HL)            ; decrease the counter
        DEC     HL              ; step back

        JR      NZ,L02D1        ; forward to K-CH-SET if not at end of count

        LD      (HL),$FF        ; else mark this particular map free.

;; K-CH-SET
L02D1:  LD      A,L             ; make a copy of the low address byte.
        LD      HL,$5C04        ; point to KSTATE-4
                                ; (ld l,$04 would do)
        CP      L               ; have both sets been considered ?
        JR      NZ,L02C6        ; back to K-ST-LOOP to consider this 2nd set

;   now the raw key (0-38d) is converted to a main key (uppercase).

        CALL    L031E           ; routine K-TEST to get main key in A

        RET     NC              ; return if just a single shift

        LD      HL,$5C00        ; point to KSTATE-0
        CP      (HL)            ; does the main key code match ?
        JR      Z,L0310         ; forward to K-REPEAT if so

;   if not consider the second key map.

        EX      DE,HL           ; save kstate-0 in de
        LD      HL,$5C04        ; point to KSTATE-4
        CP      (HL)            ; does the main key code match ?
        JR      Z,L0310         ; forward to K-REPEAT if so

;   having excluded a repeating key we can now consider a new key.
;   the second set is always examined before the first.

        BIT     7,(HL)          ; is the key map free ?
        JR      NZ,L02F1        ; forward to K-NEW if so.

        EX      DE,HL           ; bring back KSTATE-0
        BIT     7,(HL)          ; is it free ?
        RET     Z               ; return if not.
                                ; as we have a key but nowhere to put it yet.

;   continue or jump to here if one of the buffers was free.

;; K-NEW
L02F1:  LD      E,A             ; store key in E
        LD      (HL),A          ; place in free location
        INC     HL              ; advance to the interrupt counter
        LD      (HL),$05        ; and initialize counter to 5
        INC     HL              ; advance to the delay
        LD      A,($5C09)       ; pick up the system variable REPDEL
        LD      (HL),A          ; and insert that for first repeat delay.
        INC     HL              ; advance to last location of state map.

        LD      C,(IY+$07)      ; pick up MODE  (3 bytes)
        LD      D,(IY+$01)      ; pick up FLAGS (3 bytes)
        PUSH    HL              ; save state map location
                                ; Note. could now have used, to avoid IY,
                                ; ld l,$41; ld c,(hl); ld l,$3B; ld d,(hl).
                                ; six and two threes of course.

        CALL    L0333           ; routine K-DECODE

        POP     HL              ; restore map pointer
        LD      (HL),A          ; put the decoded key in last location of map.

;; K-END
L0308:  LD      ($5C08),A       ; update LASTK system variable.
        SET     5,(IY+$01)      ; update FLAGS  - signal a new key.
        RET                     ; return to interrupt routine.

; -----------------------
; THE 'REPEAT KEY' BRANCH
; -----------------------
;   A possible repeat has been identified. HL addresses the raw key.
;   The last location of the key map holds the decoded key from the first 
;   context.  This could be a keyword and, with the exception of NOT a repeat 
;   is syntactically incorrect and not really desirable.

;; K-REPEAT
L0310:  INC     HL              ; increment the map pointer to second location.
        LD      (HL),$05        ; maintain interrupt counter at 5.
        INC     HL              ; now point to third location.
        DEC     (HL)            ; decrease the REPDEL value which is used to
                                ; time the delay of a repeat key.

        RET     NZ              ; return if not yet zero.

        LD      A,($5C0A)       ; fetch the system variable value REPPER.
        LD      (HL),A          ; for subsequent repeats REPPER will be used.

        INC     HL              ; advance
                                ;
        LD      A,(HL)          ; pick up the key decoded possibly in another
                                ; context.
                                ; Note. should compare with $A5 (RND) and make
                                ; a simple return if this is a keyword.
                                ; e.g. cp $a5; ret nc; (3 extra bytes)
        JR      L0308           ; back to K-END

; ----------------------
; THE 'KEY-TEST' ROUTINE
; ----------------------
;   also called from s-inkey$
;   begin by testing for a shift with no other.

;; K-TEST
L031E:  LD      B,D             ; load most significant key to B
                                ; will be $FF if not shift.
        LD      D,$00           ; and reset D to index into main table
        LD      A,E             ; load least significant key from E
        CP      $27             ; is it higher than 39d   i.e. FF
        RET     NC              ; return with just a shift (in B now)

        CP      $18             ; is it symbol shift ?
        JR      NZ,L032C        ; forward to K-MAIN if not

;   but we could have just symbol shift and no other

        BIT     7,B             ; is other key $FF (ie not shift)
        RET     NZ              ; return with solitary symbol shift


;; K-MAIN
L032C:  LD      HL,L0205        ; address: MAIN-KEYS
        ADD     HL,DE           ; add offset 0-38
        LD      A,(HL)          ; pick up main key value
        SCF                     ; set carry flag
        RET                     ; return    (B has other key still)

; ----------------------------------
; THE 'KEYBOARD DECODING' SUBROUTINE
; ----------------------------------
;   also called from s-inkey$

;; K-DECODE
L0333:  LD      A,E             ; pick up the stored main key
        CP      $3A             ; an arbitrary point between digits and letters
        JR      C,L0367         ; forward to K-DIGIT with digits, space, enter.

        DEC     C               ; decrease MODE ( 0='KLC', 1='E', 2='G')

        JP      M,L034F         ; to K-KLC-LET if was zero

        JR      Z,L0341         ; to K-E-LET if was 1 for extended letters.

;   proceed with graphic codes.
;   Note. should selectively drop return address if code > 'U' ($55).
;   i.e. abort the KEYBOARD call.
;   e.g. cp 'V'; jr c,addit; pop af ;pop af ;;addit etc. (6 extra bytes).
;   (s-inkey$ never gets into graphics mode.)
  
;; addit
        ADD     A,$4F           ; add offset to augment 'A' to graphics A say.
        RET                     ; return.
                                ; Note. ( but [GRAPH] V gives RND, etc ).

; ---

;   the jump was to here with extended mode with uppercase A-Z.

;; K-E-LET
L0341:  LD      HL,L022C-$41    ; base address of E-UNSHIFT L022c.
                                ; ( $01EB in standard ROM ).
        INC     B               ; test B is it empty i.e. not a shift.
        JR      Z,L034A         ; forward to K-LOOK-UP if neither shift.

        LD      HL,L0246-$41    ; Address: $0205 L0246-$41 EXT-SHIFT base

;; K-LOOK-UP
L034A:  LD      D,$00           ; prepare to index.
        ADD     HL,DE           ; add the main key value.
        LD      A,(HL)          ; pick up other mode value.
        RET                     ; return.

; ---

;   the jump was here with mode = 0

;; K-KLC-LET
L034F:  LD      HL,L026A-$41    ; prepare base of sym-codes
        BIT     0,B             ; shift=$27 sym-shift=$18
        JR      Z,L034A         ; back to K-LOOK-UP with symbol-shift

        BIT     3,D             ; test FLAGS is it 'K' mode (from OUT-CURS)
        JR      Z,L0364         ; skip to K-TOKENS if so

        BIT     3,(IY+$30)      ; test FLAGS2 - consider CAPS LOCK ?
        RET     NZ              ; return if so with main code.

        INC     B               ; is shift being pressed ?
                                ; result zero if not
        RET     NZ              ; return if shift pressed.

        ADD     A,$20           ; else convert the code to lower case.
        RET                     ; return.

; ---

;   the jump was here for tokens

;; K-TOKENS
L0364:  ADD     A,$A5           ; add offset to main code so that 'A'
                                ; becomes 'NEW' etc.

        RET                     ; return.

; ---

;   the jump was here with digits, space, enter and symbol shift (< $xx)

;; K-DIGIT
L0367:  CP      $30             ; is it '0' or higher ?
        RET     C               ; return with space, enter and symbol-shift

        DEC     C               ; test MODE (was 0='KLC', 1='E', 2='G')
        JP      M,L039D         ; jump to K-KLC-DGT if was 0.

        JR      NZ,L0389        ; forward to K-GRA-DGT if mode was 2.

;   continue with extended digits 0-9.

        LD      HL,L0284-$30    ; $0254 - base of E-DIGITS
        BIT     5,B             ; test - shift=$27 sym-shift=$18
        JR      Z,L034A         ; to K-LOOK-UP if sym-shift

        CP      $38             ; is character '8' ?
        JR      NC,L0382        ; to K-8-&-9 if greater than '7'

        SUB     $20             ; reduce to ink range $10-$17
        INC     B               ; shift ?
        RET     Z               ; return if not.

        ADD     A,$08           ; add 8 to give paper range $18 - $1F
        RET                     ; return

; ---

;   89

;; K-8-&-9
L0382:  SUB     $36             ; reduce to 02 and 03  bright codes
        INC     B               ; test if shift pressed.
        RET     Z               ; return if not.

        ADD     A,$FE           ; subtract 2 setting carry
        RET                     ; to give 0 and 1    flash codes.

; ---

;   graphics mode with digits

;; K-GRA-DGT
L0389:  LD      HL,L0260-$30    ; $0230 base address of CTL-CODES

        CP      $39             ; is key '9' ?
        JR      Z,L034A         ; back to K-LOOK-UP - changed to $0F, GRAPHICS.

        CP      $30             ; is key '0' ?
        JR      Z,L034A         ; back to K-LOOK-UP - changed to $0C, delete.

;   for keys '0' - '7' we assign a mosaic character depending on shift.

        AND     $07             ; convert character to number. 0 - 7.
        ADD     A,$80           ; add offset - they start at $80

        INC     B               ; destructively test for shift
        RET     Z               ; and return if not pressed.

        XOR     $0F             ; toggle bits becomes range $88-$8F
        RET                     ; return.

; ---

;   now digits in 'KLC' mode

;; K-KLC-DGT
L039D:  INC     B               ; return with digit codes if neither
        RET     Z               ; shift key pressed.

        BIT     5,B             ; test for caps shift.

        LD      HL,L0260-$30    ; prepare base of table CTL-CODES.
        JR      NZ,L034A        ; back to K-LOOK-UP if shift pressed.

;   must have been symbol shift

        SUB     $10             ; for ASCII most will now be correct
                                ; on a standard typewriter.

        CP      $22             ; but '@' is not - see below.
        JR      Z,L03B2         ; forward to K-@-CHAR if so

        CP      $20             ; '_' is the other one that fails
        RET     NZ              ; return if not.

        LD      A,$5F           ; substitute ASCII '_'
        RET                     ; return.

; ---

;; K-@-CHAR
L03B2:  LD      A,$40           ; substitute ASCII '@'
        RET                     ; return.


; ------------------------------------------------------------------------
;   The Spectrum Input character keys. One or two are abbreviated.
;   From $00 Flash 0 to $FF COPY. The routine above has decoded all these.

;  | 00 Fl0| 01 Fl1| 02 Br0| 03 Br1| 04 In0| 05 In1| 06 CAP| 07 EDT|
;  | 08 LFT| 09 RIG| 0A DWN| 0B UP | 0C DEL| 0D ENT| 0E SYM| 0F GRA|
;  | 10 Ik0| 11 Ik1| 12 Ik2| 13 Ik3| 14 Ik4| 15 Ik5| 16 Ik6| 17 Ik7|
;  | 18 Pa0| 19 Pa1| 1A Pa2| 1B Pa3| 1C Pa4| 1D Pa5| 1E Pa6| 1F Pa7|
;  | 20 SP | 21  ! | 22  " | 23  # | 24  $ | 25  % | 26  & | 27  ' |
;  | 28  ( | 29  ) | 2A  * | 2B  + | 2C  , | 2D  - | 2E  . | 2F  / |
;  | 30  0 | 31  1 | 32  2 | 33  3 | 34  4 | 35  5 | 36  6 | 37  7 |
;  | 38  8 | 39  9 | 3A  : | 3B  ; | 3C  < | 3D  = | 3E  > | 3F  ? |
;  | 40  @ | 41  A | 42  B | 43  C | 44  D | 45  E | 46  F | 47  G |
;  | 48  H | 49  I | 4A  J | 4B  K | 4C  L | 4D  M | 4E  N | 4F  O |
;  | 50  P | 51  Q | 52  R | 53  S | 54  T | 55  U | 56  V | 57  W |
;  | 58  X | 59  Y | 5A  Z | 5B  [ | 5C  \ | 5D  ] | 5E  ^ | 5F  _ |
;  | 60  £ | 61  a | 62  b | 63  c | 64  d | 65  e | 66  f | 67  g |
;  | 68  h | 69  i | 6A  j | 6B  k | 6C  l | 6D  m | 6E  n | 6F  o |
;  | 70  p | 71  q | 72  r | 73  s | 74  t | 75  u | 76  v | 77  w |
;  | 78  x | 79  y | 7A  z | 7B  { | 7C  | | 7D  } | 7E  ~ | 7F  © |
;  | 80 128| 81 129| 82 130| 83 131| 84 132| 85 133| 86 134| 87 135|
;  | 88 136| 89 137| 8A 138| 8B 139| 8C 140| 8D 141| 8E 142| 8F 143|
;  | 90 [A]| 91 [B]| 92 [C]| 93 [D]| 94 [E]| 95 [F]| 96 [G]| 97 [H]|
;  | 98 [I]| 99 [J]| 9A [K]| 9B [L]| 9C [M]| 9D [N]| 9E [O]| 9F [P]|
;  | A0 [Q]| A1 [R]| A2 [S]| A3 [T]| A4 [U]| A5 RND| A6 IK$| A7 PI |
;  | A8 FN | A9 PNT| AA SC$| AB ATT| AC AT | AD TAB| AE VL$| AF COD|
;  | B0 VAL| B1 LEN| B2 SIN| B3 COS| B4 TAN| B5 ASN| B6 ACS| B7 ATN|
;  | B8 LN | B9 EXP| BA INT| BB SQR| BC SGN| BD ABS| BE PEK| BF IN |
;  | C0 USR| C1 ST$| C2 CH$| C3 NOT| C4 BIN| C5 OR | C6 AND| C7 <= |
;  | C8 >= | C9 <> | CA LIN| CB THN| CC TO | CD STP| CE DEF| CF CAT|
;  | D0 FMT| D1 MOV| D2 ERS| D3 OPN| D4 CLO| D5 MRG| D6 VFY| D7 BEP|
;  | D8 CIR| D9 INK| DA PAP| DB FLA| DC BRI| DD INV| DE OVR| DF OUT|
;  | E0 LPR| E1 LLI| E2 STP| E3 REA| E4 DAT| E5 RES| E6 NEW| E7 BDR|
;  | E8 CON| E9 DIM| EA REM| EB FOR| EC GTO| ED GSB| EE INP| EF LOA|
;  | F0 LIS| F1 LET| F2 PAU| F3 NXT| F4 POK| F5 PRI| F6 PLO| F7 RUN|
;  | F8 SAV| F9 RAN| FA IF | FB CLS| FC DRW| FD CLR| FE RET| FF CPY|

;   Note that for simplicity, Sinclair have located all the control codes
;   below the space character.
;   ASCII DEL, $7F, has been made a copyright symbol.
;   Also $60, '`', not used in BASIC but used in other languages, has been
;   allocated the local currency symbol for the relevant country -
;    £  in most Spectrums.

; ------------------------------------------------------------------------


;**********************************
;** Part 3. LOUDSPEAKER ROUTINES **
;**********************************

; Documented by Alvin Albrecht.

; ------------------------------
; Routine to control loudspeaker
; ------------------------------
; Outputs a square wave of given duration and frequency
; to the loudspeaker.
;   Enter with: DE = #cycles - 1
;               HL = tone period as described next
;
; The tone period is measured in T states and consists of
; three parts: a coarse part (H register), a medium part
; (bits 7..2 of L) and a fine part (bits 1..0 of L) which
; contribute to the waveform timing as follows:
;
;                          coarse    medium       fine
; duration of low  = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3)
; duration of hi   = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3)
; Tp = tone period = 236 + 2048*H + 32*(L>>2) + 8*(L&0x3)
;                  = 236 + 2048*H + 8*L = 236 + 8*HL
;
; As an example, to output five seconds of middle C (261.624 Hz):
;   (a) Tone period = 1/261.624 = 3.822ms
;   (b) Tone period in T-States = 3.822ms*fCPU = 13378
;         where fCPU = clock frequency of the CPU = 3.5MHz
;    ©  Find H and L for desired tone period:
;         HL = (Tp - 236) / 8 = (13378 - 236) / 8 = 1643 = 0x066B
;   (d) Tone duration in cycles = 5s/3.822ms = 1308 cycles
;         DE = 1308 - 1 = 0x051B
;
; The resulting waveform has a duty ratio of exactly 50%.
;
;
;; BEEPER
L03B5:  DI                      ; Disable Interrupts so they don't disturb timing
        LD      A,L             ;
        SRL     L               ;
        SRL     L               ; L = medium part of tone period
        CPL                     ;
        AND     $03             ; A = 3 - fine part of tone period
        LD      C,A             ;
        LD      B,$00           ;
        LD      IX,L03D1        ; Address: BE-IX+3
        ADD     IX,BC           ;   IX holds address of entry into the loop
                                ;   the loop will contain 0-3 NOPs, implementing
                                ;   the fine part of the tone period.
        LD      A,($5C48)       ; BORDCR
        AND     $38             ; bits 5..3 contain border colour
        RRCA                    ; border colour bits moved to 2..0
        RRCA                    ;   to match border bits on port #FE
        RRCA                    ;
        OR       $08            ; bit 3 set (tape output bit on port #FE)
                                ;   for loud sound output
;; BE-IX+3
L03D1:  NOP              ;(4)   ; optionally executed NOPs for small
                                ;   adjustments to tone period
;; BE-IX+2
L03D2:  NOP              ;(4)   ;

;; BE-IX+1
L03D3:  NOP              ;(4)   ;

;; BE-IX+0
L03D4:  INC     B        ;(4)   ;
        INC     C        ;(4)   ;

;; BE-H&L-LP
L03D6:  DEC     C        ;(4)   ; timing loop for duration of
        JR      NZ,L03D6 ;(12/7);   high or low pulse of waveform

        LD      C,$3F    ;(7)   ;
        DEC     B        ;(4)   ;
        JP      NZ,L03D6 ;(10)  ; to BE-H&L-LP

        XOR     $10      ;(7)   ; toggle output beep bit
        OUT     ($FE),A  ;(11)  ; output pulse
        LD      B,H      ;(4)   ; B = coarse part of tone period
        LD      C,A      ;(4)   ; save port #FE output byte
        BIT     4,A      ;(8)   ; if new output bit is high, go
        JR      NZ,L03F2 ;(12/7);   to BE-AGAIN

        LD      A,D      ;(4)   ; one cycle of waveform has completed
        OR      E        ;(4)   ;   (low->low). if cycle countdown = 0
        JR      Z,L03F6  ;(12/7);   go to BE-END

        LD      A,C      ;(4)   ; restore output byte for port #FE
        LD      C,L      ;(4)   ; C = medium part of tone period
        DEC     DE       ;(6)   ; decrement cycle count
        JP      (IX)     ;(8)   ; do another cycle

;; BE-AGAIN                     ; halfway through cycle
L03F2:  LD      C,L      ;(4)   ; C = medium part of tone period
        INC     C        ;(4)   ; adds 16 cycles to make duration of high = duration of low
        JP      (IX)     ;(8)   ; do high pulse of tone

;; BE-END
L03F6:  EI                      ; Enable Interrupts
        RET                     ;


; ------------------
; THE 'BEEP' COMMAND
; ------------------
; BASIC interface to BEEPER subroutine.
; Invoked in BASIC with:
;   BEEP dur, pitch
;   where dur   = duration in seconds
;         pitch = # of semitones above/below middle C
;
; Enter with: pitch on top of calculator stack
;             duration next on calculator stack
;
;; beep
L03F8:  RST     28H             ;; FP-CALC
        DEFB    $31             ;;duplicate                  ; duplicate pitch
        DEFB    $27             ;;int                        ; convert to integer
        DEFB    $C0             ;;st-mem-0                   ; store integer pitch to memory 0
        DEFB    $03             ;;subtract                   ; calculate fractional part of pitch = fp_pitch - int_pitch
        DEFB    $34             ;;stk-data                   ; push constant
        DEFB    $EC             ;;Exponent: $7C, Bytes: 4    ; constant = 0.05762265
        DEFB    $6C,$98,$1F,$F5 ;;($6C,$98,$1F,$F5)
        DEFB    $04             ;;multiply                   ; compute:
        DEFB    $A1             ;;stk-one                    ; 1 + 0.05762265 * fraction_part(pitch)
        DEFB    $0F             ;;addition
        DEFB    $38             ;;end-calc                   ; leave on calc stack

        LD      HL,$5C92        ; MEM-0: number stored here is in 16 bit integer format (pitch)
                                ;   0, 0/FF (pos/neg), LSB, MSB, 0
                                ;   LSB/MSB is stored in two's complement
                                ; In the following, the pitch is checked if it is in the range -128<=p<=127
        LD      A,(HL)          ; First byte must be zero, otherwise
        AND     A               ;   error in integer conversion
        JR      NZ,L046C        ; to REPORT-B

        INC     HL              ;
        LD      C,(HL)          ; C = pos/neg flag = 0/FF
        INC     HL              ;
        LD      B,(HL)          ; B = LSB, two's complement
        LD      A,B             ;
        RLA                     ;
        SBC     A,A             ; A = 0/FF if B is pos/neg
        CP      C               ; must be the same as C if the pitch is -128<=p<=127
        JR      NZ,L046C        ; if no, error REPORT-B

        INC     HL              ; if -128<=p<=127, MSB will be 0/FF if B is pos/neg
        CP      (HL)            ; verify this
        JR      NZ,L046C        ; if no, error REPORT-B
                                ; now we know -128<=p<=127
        LD      A,B             ; A = pitch + 60
        ADD     A,$3C           ; if -60<=pitch<=67,
        JP      P,L0425         ;   goto BE-i-OK

        JP      PO,L046C        ; if pitch <= 67 goto REPORT-B
                                ;   lower bound of pitch set at -60

;; BE-I-OK                      ; here, -60<=pitch<=127
                                ; and A=pitch+60 -> 0<=A<=187

L0425:  LD      B,$FA           ; 6 octaves below middle C

;; BE-OCTAVE                    ; A=# semitones above 5 octaves below middle C
L0427:  INC     B               ; increment octave
        SUB     $0C             ; 12 semitones = one octave
        JR      NC,L0427        ; to BE-OCTAVE

        ADD     A,$0C           ; A = # semitones above C (0-11)
        PUSH    BC              ; B = octave displacement from middle C, 2's complement: -5<=B<=10
        LD      HL,L046E        ; Address: semi-tone
        CALL    L3406           ; routine LOC-MEM
                                ;   HL = 5*A + $046E
        CALL    L33B4           ; routine STACK-NUM
                                ;   read FP value (freq) from semitone table (HL) and push onto calc stack

        RST     28H             ;; FP-CALC
        DEFB    $04             ;;multiply   mult freq by 1 + 0.0576 * fraction_part(pitch) stacked earlier
                                ;;             thus taking into account fractional part of pitch.
                                ;;           the number 0.0576*frequency is the distance in Hz to the next
                                ;;             note (verify with the frequencies recorded in the semitone
                                ;;             table below) so that the fraction_part of the pitch does
                                ;;             indeed represent a fractional distance to the next note.
        DEFB    $38             ;;end-calc   HL points to first byte of fp num on stack = middle frequency to generate

        POP     AF              ; A = octave displacement from middle C, 2's complement: -5<=A<=10
        ADD     A,(HL)          ; increase exponent by A (equivalent to multiplying by 2^A)
        LD      (HL),A          ;

        RST     28H             ;; FP-CALC
        DEFB    $C0             ;;st-mem-0          ; store frequency in memory 0
        DEFB    $02             ;;delete            ; remove from calc stack
        DEFB    $31             ;;duplicate         ; duplicate duration (seconds)
        DEFB    $38             ;;end-calc

        CALL    L1E94           ; routine FIND-INT1 ; FP duration to A
        CP      $0B             ; if dur > 10 seconds,
        JR      NC,L046C        ;   goto REPORT-B

        ;;; The following calculation finds the tone period for HL and the cycle count
        ;;; for DE expected in the BEEPER subroutine.  From the example in the BEEPER comments,
        ;;;
        ;;; HL = ((fCPU / f) - 236) / 8 = fCPU/8/f - 236/8 = 437500/f -29.5
        ;;; DE = duration * frequency - 1
        ;;;
        ;;; Note the different constant (30.125) used in the calculation of HL
        ;;; below.  This is probably an error.

        RST     28H             ;; FP-CALC
        DEFB    $E0             ;;get-mem-0                 ; push frequency
        DEFB    $04             ;;multiply                  ; result1: #cycles = duration * frequency
        DEFB    $E0             ;;get-mem-0                 ; push frequency
        DEFB    $34             ;;stk-data                  ; push constant
        DEFB    $80             ;;Exponent $93, Bytes: 3    ; constant = 437500
        DEFB    $43,$55,$9F,$80 ;;($55,$9F,$80,$00)
        DEFB    $01             ;;exchange                  ; frequency on top
        DEFB    $05             ;;division                  ; 437500 / frequency
        DEFB    $34             ;;stk-data                  ; push constant
        DEFB    $35             ;;Exponent: $85, Bytes: 1   ; constant = 30.125
        DEFB    $71             ;;($71,$00,$00,$00)
        DEFB    $03             ;;subtract                  ; result2: tone_period(HL) = 437500 / freq - 30.125
        DEFB    $38             ;;end-calc

        CALL    L1E99           ; routine FIND-INT2
        PUSH    BC              ;   BC = tone_period(HL)
        CALL    L1E99           ; routine FIND-INT2, BC = #cycles to generate
        POP     HL              ; HL = tone period
        LD      D,B             ;
        LD      E,C             ; DE = #cycles
        LD      A,D             ;
        OR      E               ;
        RET     Z               ; if duration = 0, skip BEEP and avoid 65536 cycle
                                ;   boondoggle that would occur next
        DEC     DE              ; DE = #cycles - 1
        JP      L03B5           ; to BEEPER

; ---


;; REPORT-B
L046C:  RST     08H             ; ERROR-1
        DEFB    $0A             ; Error Report: Integer out of range



; ---------------------
; THE 'SEMI-TONE' TABLE
; ---------------------
;
;   Holds frequencies corresponding to semitones in middle octave.
;   To move n octaves higher or lower, frequencies are multiplied by 2^n.

;; semi-tone         five byte fp         decimal freq     note (middle)
L046E:  DEFB    $89, $02, $D0, $12, $86;  261.625565290         C
        DEFB    $89, $0A, $97, $60, $75;  277.182631135         C#
        DEFB    $89, $12, $D5, $17, $1F;  293.664768100         D
        DEFB    $89, $1B, $90, $41, $02;  311.126983881         D#
        DEFB    $89, $24, $D0, $53, $CA;  329.627557039         E
        DEFB    $89, $2E, $9D, $36, $B1;  349.228231549         F
        DEFB    $89, $38, $FF, $49, $3E;  369.994422674         F#
        DEFB    $89, $43, $FF, $6A, $73;  391.995436072         G
        DEFB    $89, $4F, $A7, $00, $54;  415.304697513         G#
        DEFB    $89, $5C, $00, $00, $00;  440.000000000         A
        DEFB    $89, $69, $14, $F6, $24;  466.163761616         A#
        DEFB    $89, $76, $F1, $10, $05;  493.883301378         B


;   "Music is the hidden mathematical endeavour of a soul unconscious it 
;    is calculating" - Gottfried Wilhelm Liebnitz 1646 - 1716


;****************************************
;** Part 4. CASSETTE HANDLING ROUTINES **
;****************************************

;   These routines begin with the service routines followed by a single
;   command entry point.
;   The first of these service routines is a curiosity.

; -----------------------
; THE 'ZX81 NAME' ROUTINE
; -----------------------
;   This routine fetches a filename in ZX81 format and is not used by the 
;   cassette handling routines in this ROM.

;; zx81-name
L04AA:  CALL    L24FB           ; routine SCANNING to evaluate expression.
        LD      A,($5C3B)       ; fetch system variable FLAGS.
        ADD     A,A             ; test bit 7 - syntax, bit 6 - result type.
        JP      M,L1C8A         ; to REPORT-C if not string result
                                ; 'Nonsense in BASIC'.

        POP     HL              ; drop return address.
        RET     NC              ; return early if checking syntax.

        PUSH    HL              ; re-save return address.
        CALL    L2BF1           ; routine STK-FETCH fetches string parameters.
        LD      H,D             ; transfer start of filename
        LD      L,E             ; to the HL register.
        DEC     C               ; adjust to point to last character and
        RET     M               ; return if the null string.
                                ; or multiple of 256!

        ADD     HL,BC           ; find last character of the filename.
                                ; and also clear carry.
        SET     7,(HL)          ; invert it.
        RET                     ; return.

; =========================================
;
; PORT 254 ($FE)
;
;                      spk mic { border  }  
;          ___ ___ ___ ___ ___ ___ ___ ___ 
; PORT    |   |   |   |   |   |   |   |   |
; 254     |   |   |   |   |   |   |   |   |
; $FE     |___|___|___|___|___|___|___|___|
;           7   6   5   4   3   2   1   0
;

; ----------------------------------
; Save header and program/data bytes
; ----------------------------------
;   This routine saves a section of data. It is called from SA-CTRL to save the
;   seventeen bytes of header data. It is also the exit route from that routine
;   when it is set up to save the actual data.
;   On entry -
;   HL points to start of data.
;   IX points to descriptor.
;   The accumulator is set to  $00 for a header, $FF for data.

;; SA-BYTES
L04C2:  LD      HL,L053F        ; address: SA/LD-RET
        PUSH    HL              ; is pushed as common exit route.
                                ; however there is only one non-terminal exit 
                                ; point.

        LD      HL,$1F80        ; a timing constant H=$1F, L=$80
                                ; inner and outer loop counters
                                ; a five second lead-in is used for a header.

        BIT     7,A             ; test one bit of accumulator.
                                ; (AND A ?)
        JR      Z,L04D0         ; skip to SA-FLAG if a header is being saved.

;   else is data bytes and a shorter lead-in is used.

        LD      HL,$0C98        ; another timing value H=$0C, L=$98.
                                ; a two second lead-in is used for the data.


;; SA-FLAG
L04D0:  EX      AF,AF'          ; save flag
        INC     DE              ; increase length by one.
        DEC     IX              ; decrease start.

        DI                      ; disable interrupts

        LD      A,$02           ; select red for border, microphone bit on.
        LD      B,A             ; also does as an initial slight counter value.

;; SA-LEADER
L04D8:  DJNZ    L04D8           ; self loop to SA-LEADER for delay.
                                ; after initial loop, count is $A4 (or $A3)

        OUT     ($FE),A         ; output byte $02/$0D to tape port.

        XOR     $0F             ; switch from RED (mic on) to CYAN (mic off).

        LD      B,$A4           ; hold count. also timed instruction.

        DEC     L               ; originally $80 or $98.
                                ; but subsequently cycles 256 times.
        JR      NZ,L04D8        ; back to SA-LEADER until L is zero.

;   the outer loop is counted by H

        DEC     B               ; decrement count
        DEC     H               ; originally  twelve or thirty-one.
        JP      P,L04D8         ; back to SA-LEADER until H becomes $FF

;   now send a sync pulse. At this stage mic is off and A holds value
;   for mic on.
;   A sync pulse is much shorter than the steady pulses of the lead-in.

        LD      B,$2F           ; another short timed delay.

;; SA-SYNC-1
L04EA:  DJNZ    L04EA           ; self loop to SA-SYNC-1

        OUT     ($FE),A         ; switch to mic on and red.
        LD      A,$0D           ; prepare mic off - cyan
        LD      B,$37           ; another short timed delay.

;; SA-SYNC-2
L04F2:  DJNZ    L04F2           ; self loop to SA-SYNC-2

        OUT     ($FE),A         ; output mic off, cyan border.
        LD      BC,$3B0E        ; B=$3B time(*), C=$0E, YELLOW, MIC OFF.

; 

        EX      AF,AF'          ; restore saved flag
                                ; which is 1st byte to be saved.

        LD      L,A             ; and transfer to L.
                                ; the initial parity is A, $FF or $00.
        JP      L0507           ; JUMP forward to SA-START     ->
                                ; the mid entry point of loop.

; -------------------------
;   During the save loop a parity byte is maintained in H.
;   the save loop begins by testing if reduced length is zero and if so
;   the final parity byte is saved reducing count to $FFFF.

;; SA-LOOP
L04FE:  LD      A,D             ; fetch high byte
        OR      E               ; test against low byte.
        JR      Z,L050E         ; forward to SA-PARITY if zero.

        LD      L,(IX+$00)      ; load currently addressed byte to L.

;; SA-LOOP-P
L0505:  LD      A,H             ; fetch parity byte.
        XOR     L               ; exclusive or with new byte.

; -> the mid entry point of loop.

;; SA-START
L0507:  LD      H,A             ; put parity byte in H.
        LD      A,$01           ; prepare blue, mic=on.
        SCF                     ; set carry flag ready to rotate in.
        JP      L0525           ; JUMP forward to SA-8-BITS            -8->

; ---

;; SA-PARITY
L050E:  LD      L,H             ; transfer the running parity byte to L and
        JR      L0505           ; back to SA-LOOP-P 
                                ; to output that byte before quitting normally.

; ---

;   The entry point to save yellow part of bit.
;   A bit consists of a period with mic on and blue border followed by 
;   a period of mic off with yellow border. 
;   Note. since the DJNZ instruction does not affect flags, the zero flag is 
;   used to indicate which of the two passes is in effect and the carry 
;   maintains the state of the bit to be saved.

;; SA-BIT-2
L0511:  LD      A,C             ; fetch 'mic on and yellow' which is 
                                ; held permanently in C.
        BIT     7,B             ; set the zero flag. B holds $3E.

;   The entry point to save 1 entire bit. For first bit B holds $3B(*).
;   Carry is set if saved bit is 1. zero is reset NZ on entry.

;; SA-BIT-1
L0514:  DJNZ    L0514           ; self loop for delay to SA-BIT-1

        JR      NC,L051C        ; forward to SA-OUT if bit is 0.

;   but if bit is 1 then the mic state is held for longer.

        LD      B,$42           ; set timed delay. (66 decimal)

;; SA-SET
L051A:  DJNZ    L051A           ; self loop to SA-SET 
                                ; (roughly an extra 66*13 clock cycles)

;; SA-OUT
L051C:  OUT     ($FE),A         ; blue and mic on OR  yellow and mic off.

        LD      B,$3E           ; set up delay
        JR      NZ,L0511        ; back to SA-BIT-2 if zero reset NZ (first pass)

;   proceed when the blue and yellow bands have been output.

        DEC     B               ; change value $3E to $3D.
        XOR     A               ; clear carry flag (ready to rotate in).
        INC     A               ; reset zero flag i.e. NZ.

; -8-> 

;; SA-8-BITS
L0525:  RL      L               ; rotate left through carry
                                ; C<76543210<C  
        JP      NZ,L0514        ; JUMP back to SA-BIT-1 
                                ; until all 8 bits done.

;   when the initial set carry is passed out again then a byte is complete.

        DEC     DE              ; decrease length
        INC     IX              ; increase byte pointer
        LD      B,$31           ; set up timing.

        LD      A,$7F           ; test the space key and
        IN      A,($FE)         ; return to common exit (to restore border)
        RRA                     ; if a space is pressed
        RET     NC              ; return to SA/LD-RET.   - - >

;   now test if byte counter has reached $FFFF.

        LD      A,D             ; fetch high byte
        INC     A               ; increment.
        JP      NZ,L04FE        ; JUMP to SA-LOOP if more bytes.

        LD      B,$3B           ; a final delay. 

;; SA-DELAY
L053C:  DJNZ    L053C           ; self loop to SA-DELAY

        RET                     ; return - - >

; ------------------------------
; THE 'SAVE/LOAD RETURN' ROUTINE
; ------------------------------
;   The address of this routine is pushed on the stack prior to any load/save
;   operation and it handles normal completion with the restoration of the
;   border and also abnormal termination when the break key, or to be more
;   precise the space key is pressed during a tape operation.
;
; - - >

;; SA/LD-RET
L053F:  PUSH    AF              ; preserve accumulator throughout.
        LD      A,($5C48)       ; fetch border colour from BORDCR.
        AND     $38             ; mask off paper bits.
        RRCA                    ; rotate
        RRCA                    ; to the
        RRCA                    ; range 0-7.

        OUT     ($FE),A         ; change the border colour.

        LD      A,$7F           ; read from port address $7FFE the
        IN      A,($FE)         ; row with the space key at outside.
 
        RRA                     ; test for space key pressed.
        EI                      ; enable interrupts
        JR      C,L0554         ; forward to SA/LD-END if not


;; REPORT-Da
L0552:  RST     08H             ; ERROR-1
        DEFB    $0C             ; Error Report: BREAK - CONT repeats

; ---

;; SA/LD-END
L0554:  POP     AF              ; restore the accumulator.
        RET                     ; return.

; ------------------------------------
; Load header or block of information
; ------------------------------------
;   This routine is used to load bytes and on entry A is set to $00 for a 
;   header or to $FF for data.  IX points to the start of receiving location 
;   and DE holds the length of bytes to be loaded. If, on entry the carry flag 
;   is set then data is loaded, if reset then it is verified.

;; LD-BYTES
L0556:  INC     D               ; reset the zero flag without disturbing carry.
        EX      AF,AF'          ; preserve entry flags.
        DEC     D               ; restore high byte of length.

        DI                      ; disable interrupts

        LD      A,$0F           ; make the border white and mic off.
        OUT     ($FE),A         ; output to port.

        LD      HL,L053F        ; Address: SA/LD-RET
        PUSH    HL              ; is saved on stack as terminating routine.

;   the reading of the EAR bit (D6) will always be preceded by a test of the 
;   space key (D0), so store the initial post-test state.

        IN      A,($FE)         ; read the ear state - bit 6.
        RRA                     ; rotate to bit 5.
        AND     $20             ; isolate this bit.
        call    ultra

        CP      A               ; set the zero flag.

; 

;; LD-BREAK
L056B:  RET     NZ              ; return if at any time space is pressed.

;; LD-START
L056C:  CALL    L05E7           ; routine LD-EDGE-1
        JR      NC,L056B        ; back to LD-BREAK with time out and no
                                ; edge present on tape.

;   but continue when a transition is found on tape.

        LD      HL,$0415        ; set up 16-bit outer loop counter for 
                                ; approx 1 second delay.

;; LD-WAIT
L0574:  DJNZ    L0574           ; self loop to LD-WAIT (for 256 times)

        DEC     HL              ; decrease outer loop counter.
        LD      A,H             ; test for
        OR      L               ; zero.
        JR      NZ,L0574        ; back to LD-WAIT, if not zero, with zero in B.

;   continue after delay with H holding zero and B also.
;   sample 256 edges to check that we are in the middle of a lead-in section. 

        CALL    L05E3           ; routine LD-EDGE-2
        JR      NC,L056B        ; back to LD-BREAK
                                ; if no edges at all.

;; LD-LEADER
L0580:  LD      B,$9C           ; set timing value.
        CALL    L05E3           ; routine LD-EDGE-2
        JR      NC,L056B        ; back to LD-BREAK if time-out

        LD      A,$C6           ; two edges must be spaced apart.
        CP      B               ; compare
        JR      NC,L056C        ; back to LD-START if too close together for a 
                                ; lead-in.

        INC     H               ; proceed to test 256 edged sample.
        JR      NZ,L0580        ; back to LD-LEADER while more to do.

;   sample indicates we are in the middle of a two or five second lead-in.
;   Now test every edge looking for the terminal sync signal.

;; LD-SYNC
L058F:  LD      B,$C9           ; initial timing value in B.
        CALL    L05E7           ; routine LD-EDGE-1
        JR      NC,L056B        ; back to LD-BREAK with time-out.

        LD      A,B             ; fetch augmented timing value from B.
        CP      $D4             ; compare 
        JR      NC,L058F        ; back to LD-SYNC if gap too big, that is,
                                ; a normal lead-in edge gap.

;   but a short gap will be the sync pulse.
;   in which case another edge should appear before B rises to $FF

        CALL    L05E7           ; routine LD-EDGE-1
        RET     NC              ; return with time-out.

; proceed when the sync at the end of the lead-in is found.
; We are about to load data so change the border colours.

        LD      A,C             ; fetch long-term mask from C
        XOR     $03             ; and make blue/yellow.

        LD      C,A             ; store the new long-term byte.

        LD      H,$00           ; set up parity byte as zero.
        LD      B,$B0           ; timing.
        JR      L05C8           ; forward to LD-MARKER 
                                ; the loop mid entry point with the alternate 
                                ; zero flag reset to indicate first byte 
                                ; is discarded.

; --------------
;   the loading loop loads each byte and is entered at the mid point.

;; LD-LOOP
L05A9:  EX      AF,AF'          ; restore entry flags and type in A.
        JR      NZ,L05B3        ; forward to LD-FLAG if awaiting initial flag
                                ; which is to be discarded.

        JR      NC,L05BD        ; forward to LD-VERIFY if not to be loaded.

        LD      (IX+$00),L      ; place loaded byte at memory location.
        JR      L05C2           ; forward to LD-NEXT

; ---

;; LD-FLAG
L05B3:  RL      C               ; preserve carry (verify) flag in long-term
                                ; state byte. Bit 7 can be lost.

        XOR     L               ; compare type in A with first byte in L.
        RET     NZ              ; return if no match e.g. CODE vs. DATA.

;   continue when data type matches.

        LD      A,C             ; fetch byte with stored carry
        RRA                     ; rotate it to carry flag again
        LD      C,A             ; restore long-term port state.

        INC     DE              ; increment length ??
        JR      L05C4           ; forward to LD-DEC.
                                ; but why not to location after ?

; ---
;   for verification the byte read from tape is compared with that in memory.

;; LD-VERIFY
L05BD:  LD      A,(IX+$00)      ; fetch byte from memory.
        XOR     L               ; compare with that on tape
        RET     NZ              ; return if not zero. 

;; LD-NEXT
L05C2:  INC     IX              ; increment byte pointer.

;; LD-DEC
L05C4:  DEC     DE              ; decrement length.
        EX      AF,AF'          ; store the flags.
        LD      B,$B2           ; timing.

;   when starting to read 8 bits the receiving byte is marked with bit at right.
;   when this is rotated out again then 8 bits have been read.

;; LD-MARKER
L05C8:  LD      L,$01           ; initialize as %00000001

;; LD-8-BITS
L05CA:  CALL    L05E3           ; routine LD-EDGE-2 increments B relative to
                                ; gap between 2 edges.
        RET     NC              ; return with time-out.

        LD      A,$CB           ; the comparison byte.
        CP      B               ; compare to incremented value of B.
                                ; if B is higher then bit on tape was set.
                                ; if <= then bit on tape is reset. 

        RL      L               ; rotate the carry bit into L.

        LD      B,$B0           ; reset the B timer byte.
        JP      NC,L05CA        ; JUMP back to LD-8-BITS

;   when carry set then marker bit has been passed out and byte is complete.

        LD      A,H             ; fetch the running parity byte.
        XOR     L               ; include the new byte.
        LD      H,A             ; and store back in parity register.

        LD      A,D             ; check length of
        OR      E               ; expected bytes.
        JR      NZ,L05A9        ; back to LD-LOOP 
                                ; while there are more.

;   when all bytes loaded then parity byte should be zero.

        LD      A,H             ; fetch parity byte.
        CP      $01             ; set carry if zero.
        RET                     ; return
                                ; in no carry then error as checksum disagrees.

; -------------------------
; Check signal being loaded
; -------------------------
;   An edge is a transition from one mic state to another.
;   More specifically a change in bit 6 of value input from port $FE.
;   Graphically it is a change of border colour, say, blue to yellow.
;   The first entry point looks for two adjacent edges. The second entry point
;   is used to find a single edge.
;   The B register holds a count, up to 256, within which the edge (or edges) 
;   must be found. The gap between two edges will be more for a '1' than a '0'
;   so the value of B denotes the state of the bit (two edges) read from tape.

; ->

;; LD-EDGE-2
L05E3:  CALL    L05E7           ; call routine LD-EDGE-1 below.
        RET     NC              ; return if space pressed or time-out.
                                ; else continue and look for another adjacent 
                                ; edge which together represent a bit on the 
                                ; tape.

; -> 
;   this entry point is used to find a single edge from above but also 
;   when detecting a read-in signal on the tape.

;; LD-EDGE-1
L05E7:  LD      A,$16           ; a delay value of twenty two.

;; LD-DELAY
L05E9:  DEC     A               ; decrement counter
        JR      NZ,L05E9        ; loop back to LD-DELAY 22 times.

        AND      A              ; clear carry.

;; LD-SAMPLE
L05ED:  INC     B               ; increment the time-out counter.
        RET     Z               ; return with failure when $FF passed.

        LD      A,$7F           ; prepare to read keyboard and EAR port
        IN      A,($FE)         ; row $7FFE. bit 6 is EAR, bit 0 is SPACE key.
        RRA                     ; test outer key the space. (bit 6 moves to 5)
        RET     NC              ; return if space pressed.  >>>

        XOR     C               ; compare with initial long-term state.
        AND     $20             ; isolate bit 5
        JR      Z,L05ED         ; back to LD-SAMPLE if no edge.

;   but an edge, a transition of the EAR bit, has been found so switch the
;   long-term comparison byte containing both border colour and EAR bit. 

        LD      A,C             ; fetch comparison value.
        CPL                     ; switch the bits
        LD      C,A             ; and put back in C for long-term.

        AND     $07             ; isolate new colour bits.
        OR      $08             ; set bit 3 - MIC off.
        OUT     ($FE),A         ; send to port to effect the change of colour. 

        SCF                     ; set carry flag signaling edge found within
                                ; time allowed.
        RET                     ; return.

; ---------------------------------
; Entry point for all tape commands
; ---------------------------------
;   This is the single entry point for the four tape commands.
;   The routine first determines in what context it has been called by examining
;   the low byte of the Syntax table entry which was stored in T_ADDR.
;   Subtracting $EO (the present arrangement) gives a value of
;   $00 - SAVE
;   $01 - LOAD
;   $02 - VERIFY
;   $03 - MERGE
;   As with all commands the address STMT-RET is on the stack.

;; SAVE-ETC
L0605:  POP     AF              ; discard address STMT-RET.
        LD      A,($5C74)       ; fetch T_ADDR

;   Now reduce the low byte of the Syntax table entry to give command.
;   Note. For ZASM use SUB $E0 as next instruction.

L0609:  SUB     (L1ADF+1) % 256 ; subtract the known offset.
                                ; ( is SUB $E0 in standard ROM )

        LD      ($5C74),A       ; and put back in T_ADDR as 0,1,2, or 3
                                ; for future reference.

        CALL    L1C8C           ; routine EXPT-EXP checks that a string
                                ; expression follows and stacks the
                                ; parameters in run-time.

        CALL    L2530           ; routine SYNTAX-Z
        JR      Z,L0652         ; forward to SA-DATA if checking syntax.

        LD      BC,$0011        ; presume seventeen bytes for a header.
        LD      A,($5C74)       ; fetch command from T_ADDR.
        AND     A               ; test for zero - SAVE.
        JR      Z,L0621         ; forward to SA-SPACE if so.

        LD      C,$22           ; else double length to thirty four.

;; SA-SPACE
L0621:  RST     30H             ; BC-SPACES creates 17/34 bytes in workspace.

        PUSH    DE              ; transfer the start of new space to
        POP     IX              ; the available index register.

;   ten spaces are required for the default filename but it is simpler to
;   overwrite the first file-type indicator byte as well.

        LD      B,$0B           ; set counter to eleven.
        LD      A,$20           ; prepare a space.

;; SA-BLANK
L0629:  LD      (DE),A          ; set workspace location to space.
        INC     DE              ; next location.
        DJNZ    L0629           ; loop back to SA-BLANK till all eleven done.

        LD      (IX+$01),$FF    ; set first byte of ten character filename
                                ; to $FF as a default to signal null string.

        CALL    L2BF1           ; routine STK-FETCH fetches the filename
                                ; parameters from the calculator stack.
                                ; length of string in BC.
                                ; start of string in DE.

        LD      HL,$FFF6        ; prepare the value minus ten.
        DEC     BC              ; decrement length.
                                ; ten becomes nine, zero becomes $FFFF.
        ADD     HL,BC           ; trial addition.
        INC     BC              ; restore true length.
        JR      NC,L064B        ; forward to SA-NAME if length is one to ten.

;   the filename is more than ten characters in length or the null string.

        LD      A,($5C74)       ; fetch command from T_ADDR.
        AND     A               ; test for zero - SAVE.
        JR      NZ,L0644        ; forward to SA-NULL if not the SAVE command.

;   but no more than ten characters are allowed for SAVE.
;   The first ten characters of any other command parameter are acceptable.
;   Weird, but necessary, if saving to sectors.
;   Note. the golden rule that there are no restriction on anything is broken.

;; REPORT-Fa
L0642:  RST     08H             ; ERROR-1
        DEFB    $0E             ; Error Report: Invalid file name

;   continue with LOAD, MERGE, VERIFY and also SAVE within ten character limit.

;; SA-NULL
L0644:  LD      A,B             ; test length of filename
        OR      C               ; for zero.
        JR      Z,L0652         ; forward to SA-DATA if so using the 255 
                                ; indicator followed by spaces.

        LD      BC,$000A        ; else trim length to ten.

;   other paths rejoin here with BC holding length in range 1 - 10.

;; SA-NAME
L064B:  PUSH    IX              ; push start of file descriptor.
        POP     HL              ; and pop into HL.

        INC     HL              ; HL now addresses first byte of filename.
        EX      DE,HL           ; transfer destination address to DE, start
                                ; of string in command to HL.
        LDIR                    ; copy up to ten bytes
                                ; if less than ten then trailing spaces follow.

;   the case for the null string rejoins here.

;; SA-DATA
L0652:  RST     18H             ; GET-CHAR
        CP      $E4             ; is character after filename the token 'DATA' ?
        JR      NZ,L06A0        ; forward to SA-SCR$ to consider SCREEN$ if
                                ; not.

;   continue to consider DATA.

        LD      A,($5C74)       ; fetch command from T_ADDR
        CP      $03             ; is it 'VERIFY' ?
        JP      Z,L1C8A         ; jump forward to REPORT-C if so.
                                ; 'Nonsense in BASIC'
                                ; VERIFY "d" DATA is not allowed.

;   continue with SAVE, LOAD, MERGE of DATA.

        RST     20H             ; NEXT-CHAR
        CALL    L28B2           ; routine LOOK-VARS searches variables area
                                ; returning with carry reset if found or
                                ; checking syntax.
        SET     7,C             ; this converts a simple string to a 
                                ; string array. The test for an array or string
                                ; comes later.
        JR      NC,L0672        ; forward to SA-V-OLD if variable found.

        LD      HL,$0000        ; set destination to zero as not fixed.
        LD      A,($5C74)       ; fetch command from T_ADDR
        DEC     A               ; test for 1 - LOAD
        JR      Z,L0685         ; forward to SA-V-NEW with LOAD DATA.
                                ; to load a new array.

;   otherwise the variable was not found in run-time with SAVE/MERGE.

;; REPORT-2a
L0670:  RST     08H             ; ERROR-1
        DEFB    $01             ; Error Report: Variable not found

;   continue with SAVE/LOAD  DATA

;; SA-V-OLD
L0672:  JP      NZ,L1C8A        ; to REPORT-C if not an array variable.
                                ; or erroneously a simple string.
                                ; 'Nonsense in BASIC'


        CALL    L2530           ; routine SYNTAX-Z
        JR      Z,L0692         ; forward to SA-DATA-1 if checking syntax.

        INC     HL              ; step past single character variable name.
        LD      A,(HL)          ; fetch low byte of length.
        LD      (IX+$0B),A      ; place in descriptor.
        INC     HL              ; point to high byte.
        LD      A,(HL)          ; and transfer that
        LD      (IX+$0C),A      ; to descriptor.
        INC     HL              ; increase pointer within variable.

;; SA-V-NEW
L0685:  LD      (IX+$0E),C      ; place character array name in  header.
        LD      A,$01           ; default to type numeric.
        BIT     6,C             ; test result from look-vars.
        JR      Z,L068F         ; forward to SA-V-TYPE if numeric.

        INC     A               ; set type to 2 - string array.

;; SA-V-TYPE
L068F:  LD      (IX+$00),A      ; place type 0, 1 or 2 in descriptor.

;; SA-DATA-1
L0692:  EX      DE,HL           ; save var pointer in DE

        RST     20H             ; NEXT-CHAR
        CP      $29             ; is character ')' ?
        JR      NZ,L0672        ; back if not to SA-V-OLD to report
                                ; 'Nonsense in BASIC'

        RST     20H             ; NEXT-CHAR advances character address.
        CALL    L1BEE           ; routine CHECK-END errors if not end of
                                ; the statement.

        EX      DE,HL           ; bring back variables data pointer.
        JP      L075A           ; jump forward to SA-ALL

; ---
;   the branch was here to consider a 'SCREEN$', the display file.

;; SA-SCR$
L06A0:  CP      $AA             ; is character the token 'SCREEN$' ?
        JR      NZ,L06C3        ; forward to SA-CODE if not.

        LD      A,($5C74)       ; fetch command from T_ADDR
        CP      $03             ; is it MERGE ?
        JP       Z,L1C8A        ; jump to REPORT-C if so.
                                ; 'Nonsense in BASIC'

;   continue with SAVE/LOAD/VERIFY SCREEN$.

        RST     20H             ; NEXT-CHAR
        CALL    L1BEE           ; routine CHECK-END errors if not at end of
                                ; statement.

;   continue in runtime.

        LD      (IX+$0B),$00    ; set descriptor length
        LD      (IX+$0C),$1B    ; to $1b00 to include bitmaps and attributes.

        LD      HL,$4000        ; set start to display file start.
        LD      (IX+$0D),L      ; place start in
        LD      (IX+$0E),H      ; the descriptor.
        JR      L0710           ; forward to SA-TYPE-3

; ---
;   the branch was here to consider CODE.

;; SA-CODE
L06C3:  CP      $AF             ; is character the token 'CODE' ?
        JR      NZ,L0716        ; forward if not to SA-LINE to consider an
                                ; auto-started BASIC program.

        LD      A,($5C74)       ; fetch command from T_ADDR
        CP      $03             ; is it MERGE ?
        JP      Z,L1C8A         ; jump forward to REPORT-C if so.
                                ; 'Nonsense in BASIC'


        RST     20H             ; NEXT-CHAR advances character address.
        CALL    L2048           ; routine PR-ST-END checks if a carriage
                                ; return or ':' follows.
        JR      NZ,L06E1        ; forward to SA-CODE-1 if there are parameters.

        LD      A,($5C74)       ; else fetch the command from T_ADDR.
        AND     A               ; test for zero - SAVE without a specification.
        JP      Z,L1C8A         ; jump to REPORT-C if so.
                                ; 'Nonsense in BASIC'

;   for LOAD/VERIFY put zero on stack to signify handle at location saved from.

        CALL    L1CE6           ; routine USE-ZERO
        JR      L06F0           ; forward to SA-CODE-2

; ---

;   if there are more characters after CODE expect start and possibly length.

;; SA-CODE-1
L06E1:  CALL    L1C82           ; routine EXPT-1NUM checks for numeric
                                ; expression and stacks it in run-time.

        RST     18H             ; GET-CHAR
        CP      $2C             ; does a comma follow ?
        JR      Z,L06F5         ; forward if so to SA-CODE-3

;   else allow saved code to be loaded to a specified address.

        LD      A,($5C74)       ; fetch command from T_ADDR.
        AND     A               ; is the command SAVE which requires length ?
        JP      Z,L1C8A         ; jump to REPORT-C if so.
                                ; 'Nonsense in BASIC'

;   the command LOAD code may rejoin here with zero stacked as start.

;; SA-CODE-2
L06F0:  CALL    L1CE6           ; routine USE-ZERO stacks zero for length.
        JR      L06F9           ; forward to SA-CODE-4

; ---
;   the branch was here with SAVE CODE start, 

;; SA-CODE-3
L06F5:  RST     20H             ; NEXT-CHAR advances character address.
        CALL    L1C82           ; routine EXPT-1NUM checks for expression
                                ; and stacks in run-time.

;   paths converge here and nothing must follow.

;; SA-CODE-4
L06F9:  CALL    L1BEE           ; routine CHECK-END errors with extraneous
                                ; characters and quits if checking syntax.

;   in run-time there are two 16-bit parameters on the calculator stack.

        CALL    L1E99           ; routine FIND-INT2 gets length.
        LD      (IX+$0B),C      ; place length 
        LD      (IX+$0C),B      ; in descriptor.
        CALL    L1E99           ; routine FIND-INT2 gets start.
        LD      (IX+$0D),C      ; place start
        LD      (IX+$0E),B      ; in descriptor.
        LD      H,B             ; transfer the
        LD      L,C             ; start to HL also.

;; SA-TYPE-3
L0710:  LD      (IX+$00),$03    ; place type 3 - code in descriptor. 
        JR      L075A           ; forward to SA-ALL.

; ---
;   the branch was here with BASIC to consider an optional auto-start line
;   number.

;; SA-LINE
L0716:  CP      $CA             ; is character the token 'LINE' ?
        JR      Z,L0723         ; forward to SA-LINE-1 if so.

;   else all possibilities have been considered and nothing must follow.

        CALL    L1BEE           ; routine CHECK-END

;   continue in run-time to save BASIC without auto-start.

        LD      (IX+$0E),$80    ; place high line number in descriptor to
                                ; disable auto-start.
        JR      L073A           ; forward to SA-TYPE-0 to save program.

; ---
;   the branch was here to consider auto-start.

;; SA-LINE-1
L0723:  LD      A,($5C74)       ; fetch command from T_ADDR
        AND     A               ; test for SAVE.
        JP      NZ,L1C8A        ; jump forward to REPORT-C with anything else.
                                ; 'Nonsense in BASIC'

; 

        RST     20H             ; NEXT-CHAR
        CALL    L1C82           ; routine EXPT-1NUM checks for numeric
                                ; expression and stacks in run-time.
        CALL    L1BEE           ; routine CHECK-END quits if syntax path.
        CALL    L1E99           ; routine FIND-INT2 fetches the numeric
                                ; expression.
        LD      (IX+$0D),C      ; place the auto-start
        LD      (IX+$0E),B      ; line number in the descriptor.

;   Note. this isn't checked, but is subsequently handled by the system.
;   If the user typed 40000 instead of 4000 then it won't auto-start
;   at line 4000, or indeed, at all.

;   continue to save program and any variables.

;; SA-TYPE-0
L073A:  LD      (IX+$00),$00    ; place type zero - program in descriptor.
        LD      HL,($5C59)      ; fetch E_LINE to HL.
        LD      DE,($5C53)      ; fetch PROG to DE.
        SCF                     ; set carry flag to calculate from end of
                                ; variables E_LINE -1.
        SBC     HL,DE           ; subtract to give total length.

        LD      (IX+$0B),L      ; place total length
        LD      (IX+$0C),H      ; in descriptor.
        LD      HL,($5C4B)      ; load HL from system variable VARS
        SBC     HL,DE           ; subtract to give program length.
        LD      (IX+$0F),L      ; place length of program
        LD      (IX+$10),H      ; in the descriptor.
        EX      DE,HL           ; start to HL, length to DE.

;; SA-ALL
L075A:  LD      A,($5C74)       ; fetch command from T_ADDR
        AND     A               ; test for zero - SAVE.
        JP      Z,L0970         ; jump forward to SA-CONTRL with SAVE  ->

; ---
;   continue with LOAD, MERGE and VERIFY.

        PUSH    HL              ; save start.
        LD      BC,$0011        ; prepare to add seventeen
        ADD     IX,BC           ; to point IX at second descriptor.

;; LD-LOOK-H
L0767:  PUSH    IX              ; save IX
        LD      DE,$0011        ; seventeen bytes
        XOR     A               ; reset zero flag
        SCF                     ; set carry flag
        CALL    L0556           ; routine LD-BYTES loads a header from tape
                                ; to second descriptor.
        POP     IX              ; restore IX.
        JR      NC,L0767        ; loop back to LD-LOOK-H until header found.

        LD      A,$FE           ; select system channel 'S'
        CALL    L1601           ; routine CHAN-OPEN opens it.

        LD      (IY+$52),$03    ; set SCR_CT to 3 lines.

        LD      C,$80           ; C has bit 7 set to indicate type mismatch as
                                ; a default startpoint.

        LD      A,(IX+$00)      ; fetch loaded header type to A
        CP      (IX-$11)        ; compare with expected type.
        JR      NZ,L078A        ; forward to LD-TYPE with mis-match.

        LD      C,$F6           ; set C to minus ten - will count characters
                                ; up to zero.

;; LD-TYPE
L078A:  CP      $04             ; check if type in acceptable range 0 - 3.
        JR      NC,L0767        ; back to LD-LOOK-H with 4 and over.

;   else A indicates type 0-3.

        LD      DE,L09C0        ; address base of last 4 tape messages
        PUSH    BC              ; save BC
        CALL    L0C0A           ; routine PO-MSG outputs relevant message.
                                ; Note. all messages have a leading newline.
        POP     BC              ; restore BC

        PUSH    IX              ; transfer IX,
        POP     DE              ; the 2nd descriptor, to DE.
        LD      HL,$FFF0        ; prepare minus seventeen.
        ADD     HL,DE           ; add to point HL to 1st descriptor.
        LD      B,$0A           ; the count will be ten characters for the
                                ; filename.

        LD      A,(HL)          ; fetch first character and test for 
        INC     A               ; value 255.
        JR      NZ,L07A6        ; forward to LD-NAME if not the wildcard.

;   but if it is the wildcard, then add ten to C which is minus ten for a type
;   match or -128 for a type mismatch. Although characters have to be counted
;   bit 7 of C will not alter from state set here.

        LD      A,C             ; transfer $F6 or $80 to A
        ADD     A,B             ; add $0A
        LD      C,A             ; place result, zero or -118, in C.

;   At this point we have either a type mismatch, a wildcard match or ten
;   characters to be counted. The characters must be shown on the screen.

;; LD-NAME
L07A6:  INC     DE              ; address next input character
        LD      A,(DE)          ; fetch character
        CP      (HL)            ; compare to expected
        INC     HL              ; address next expected character
        JR      NZ,L07AD        ; forward to LD-CH-PR with mismatch

        INC     C               ; increment matched character count

;; LD-CH-PR
L07AD:  RST     10H             ; PRINT-A prints character
        DJNZ    L07A6           ; loop back to LD-NAME for ten characters.

;   if ten characters matched and the types previously matched then C will 
;   now hold zero.

        BIT     7,C             ; test if all matched
        JR      NZ,L0767        ; back to LD-LOOK-H if not

;   else print a terminal carriage return.

        LD      A,$0D           ; prepare carriage return.
        RST     10H             ; PRINT-A outputs it.

;   The various control routines for LOAD, VERIFY and MERGE are executed 
;   during the one-second gap following the header on tape.

        POP     HL              ; restore xx
        LD      A,(IX+$00)      ; fetch incoming type 
        CP      $03             ; compare with CODE
        JR      Z,L07CB         ; forward to VR-CONTRL if it is CODE.

;  type is a program or an array.

        LD      A,($5C74)       ; fetch command from T_ADDR
        DEC     A               ; was it LOAD ?
        JP      Z,L0808         ; JUMP forward to LD-CONTRL if so to 
                                ; load BASIC or variables.

        CP      $02             ; was command MERGE ?
        JP      Z,L08B6         ; jump forward to ME-CONTRL if so.

;   else continue into VERIFY control routine to verify.

; ----------------------------
; THE 'VERIFY CONTROL' ROUTINE
; ----------------------------
;   There are two branches to this routine.
;   1) From above to verify a program or array
;   2) from earlier with no carry to load or verify code.

;; VR-CONTRL
L07CB:  PUSH    HL              ; save pointer to data.
        LD      L,(IX-$06)      ; fetch length of old data 
        LD      H,(IX-$05)      ; to HL.
        LD      E,(IX+$0B)      ; fetch length of new data
        LD      D,(IX+$0C)      ; to DE.
        LD      A,H             ; check length of old
        OR      L               ; for zero.
        JR      Z,L07E9         ; forward to VR-CONT-1 if length unspecified
                                ; e.g. LOAD "x" CODE

;   as opposed to, say, LOAD 'x' CODE 32768,300.

        SBC     HL,DE           ; subtract the two lengths.
        JR      C,L0806         ; forward to REPORT-R if the length on tape is 
                                ; larger than that specified in command.
                                ; 'Tape loading error'

        JR      Z,L07E9         ; forward to VR-CONT-1 if lengths match.

;   a length on tape shorter than expected is not allowed for CODE

        LD      A,(IX+$00)      ; else fetch type from tape.
        CP      $03             ; is it CODE ?
        JR      NZ,L0806        ; forward to REPORT-R if so
                                ; 'Tape loading error'

;; VR-CONT-1
L07E9:  POP     HL              ; pop pointer to data
        LD      A,H             ; test for zero
        OR      L               ; e.g. LOAD 'x' CODE
        JR      NZ,L07F4        ; forward to VR-CONT-2 if destination specified.

        LD      L,(IX+$0D)      ; else use the destination in the header
        LD      H,(IX+$0E)      ; and load code at address saved from.

;; VR-CONT-2
L07F4:  PUSH    HL              ; push pointer to start of data block.
        POP     IX              ; transfer to IX.
        LD      A,($5C74)       ; fetch reduced command from T_ADDR
        CP      $02             ; is it VERIFY ?
        SCF                     ; prepare a set carry flag
        JR      NZ,L0800        ; skip to VR-CONT-3 if not

        AND     A               ; clear carry flag for VERIFY so that 
                                ; data is not loaded.

;; VR-CONT-3
L0800:  LD      A,$FF           ; signal data block to be loaded

; -----------------
; Load a data block
; -----------------
;   This routine is called from 3 places other than above to load a data block.
;   In all cases the accumulator is first set to $FF so the routine could be 
;   called at the previous instruction.

;; LD-BLOCK
L0802:  CALL    L0556           ; routine LD-BYTES
        RET     C               ; return if successful.


;; REPORT-R
L0806:  RST     08H             ; ERROR-1
        DEFB    $1A             ; Error Report: Tape loading error

; --------------------------
; THE 'LOAD CONTROL' ROUTINE
; --------------------------
;   This branch is taken when the command is LOAD with type 0, 1 or 2. 

;; LD-CONTRL
L0808:  LD      E,(IX+$0B)      ; fetch length of found data block 
        LD      D,(IX+$0C)      ; from 2nd descriptor.
        PUSH    HL              ; save destination
        LD      A,H             ; test for zero
        OR      L               ;
        JR      NZ,L0819        ; forward if not to LD-CONT-1

        INC     DE              ; increase length
        INC     DE              ; for letter name
        INC     DE              ; and 16-bit length
        EX      DE,HL           ; length to HL, 
        JR      L0825           ; forward to LD-CONT-2

; ---

;; LD-CONT-1
L0819:  LD      L,(IX-$06)      ; fetch length from 
        LD      H,(IX-$05)      ; the first header.
        EX      DE,HL           ;
        SCF                     ; set carry flag
        SBC     HL,DE           ;
        JR      C,L082E         ; to LD-DATA

;; LD-CONT-2
L0825:  LD      DE,$0005        ; allow overhead of five bytes.
        ADD     HL,DE           ; add in the difference in data lengths.
        LD      B,H             ; transfer to
        LD      C,L             ; the BC register pair
        CALL    L1F05           ; routine TEST-ROOM fails if not enough room.

;; LD-DATA
L082E:  POP     HL              ; pop destination
        LD      A,(IX+$00)      ; fetch type 0, 1 or 2.
        AND     A               ; test for program and variables.
        JR      Z,L0873         ; forward if so to LD-PROG

;   the type is a numeric or string array.

        LD      A,H             ; test the destination for zero
        OR      L               ; indicating variable does not already exist.
        JR      Z,L084C         ; forward if so to LD-DATA-1

;   else the destination is the first dimension within the array structure

        DEC     HL              ; address high byte of total length
        LD      B,(HL)          ; transfer to B.
        DEC     HL              ; address low byte of total length.
        LD      C,(HL)          ; transfer to C.
        DEC     HL              ; point to letter of variable.
        INC     BC              ; adjust length to
        INC     BC              ; include these
        INC     BC              ; three bytes also.
        LD      ($5C5F),IX      ; save header pointer in X_PTR.
        CALL    L19E8           ; routine RECLAIM-2 reclaims the old variable
                                ; sliding workspace including the two headers 
                                ; downwards.
        LD      IX,($5C5F)      ; reload IX from X_PTR which will have been
                                ; adjusted down by POINTERS routine.

;; LD-DATA-1
L084C:  LD      HL,($5C59)      ; address E_LINE
        DEC     HL              ; now point to the $80 variables end-marker.
        LD      C,(IX+$0B)      ; fetch new data length 
        LD      B,(IX+$0C)      ; from 2nd header.
        PUSH    BC              ; * save it.
        INC     BC              ; adjust the 
        INC     BC              ; length to include
        INC     BC              ; letter name and total length.
        LD      A,(IX-$03)      ; fetch letter name from old header.
        PUSH    AF              ; preserve accumulator though not corrupted.

        CALL    L1655           ; routine MAKE-ROOM creates space for variable
                                ; sliding workspace up. IX no longer addresses
                                ; anywhere meaningful.
        INC     HL              ; point to first new location.

        POP     AF              ; fetch back the letter name.
        LD      (HL),A          ; place in first new location.
        POP     DE              ; * pop the data length.
        INC     HL              ; address 2nd location
        LD      (HL),E          ; store low byte of length.
        INC     HL              ; address next.
        LD      (HL),D          ; store high byte.
        INC     HL              ; address start of data.
        PUSH    HL              ; transfer address
        POP     IX              ; to IX register pair.
        SCF                     ; set carry flag indicating load not verify.
        LD      A,$FF           ; signal data not header.
        JP      L0802           ; JUMP back to LD-BLOCK

; -----------------
;   the branch is here when a program as opposed to an array is to be loaded.

;; LD-PROG
L0873:  EX      DE,HL           ; transfer dest to DE.
        LD      HL,($5C59)      ; address E_LINE
        DEC     HL              ; now variables end-marker.
        LD      ($5C5F),IX      ; place the IX header pointer in X_PTR
        LD      C,(IX+$0B)      ; get new length
        LD      B,(IX+$0C)      ; from 2nd header
        PUSH    BC              ; and save it.

        CALL    L19E5           ; routine RECLAIM-1 reclaims program and vars.
                                ; adjusting X-PTR.

        POP     BC              ; restore new length.
        PUSH    HL              ; * save start
        PUSH    BC              ; ** and length.

        CALL    L1655           ; routine MAKE-ROOM creates the space.

        LD      IX,($5C5F)      ; reload IX from adjusted X_PTR
        INC     HL              ; point to start of new area.
        LD      C,(IX+$0F)      ; fetch length of BASIC on tape
        LD      B,(IX+$10)      ; from 2nd descriptor
        ADD     HL,BC           ; add to address the start of variables.
        LD      ($5C4B),HL      ; set system variable VARS

        LD      H,(IX+$0E)      ; fetch high byte of autostart line number.
        LD      A,H             ; transfer to A
        AND     $C0             ; test if greater than $3F.
        JR      NZ,L08AD        ; forward to LD-PROG-1 if so with no autostart.

        LD      L,(IX+$0D)      ; else fetch the low byte.
        LD      ($5C42),HL      ; set system variable to line number NEWPPC
        LD      (IY+$0A),$00    ; set statement NSPPC to zero.

;; LD-PROG-1
L08AD:  POP     DE              ; ** pop the length
        POP     IX              ; * and start.
        SCF                     ; set carry flag
        LD      A,$FF           ; signal data as opposed to a header.
        JP      L0802           ; jump back to LD-BLOCK

; ---------------------------
; THE 'MERGE CONTROL' ROUTINE
; ---------------------------
;   the branch was here to merge a program and its variables or an array.
;

;; ME-CONTRL
L08B6:  LD      C,(IX+$0B)      ; fetch length
        LD      B,(IX+$0C)      ; of data block on tape.
        PUSH    BC              ; save it.
        INC     BC              ; one for the pot.

        RST     30H             ; BC-SPACES creates room in workspace.
                                ; HL addresses last new location.
        LD      (HL),$80        ; place end-marker at end.
        EX      DE,HL           ; transfer first location to HL.
        POP     DE              ; restore length to DE.
        PUSH    HL              ; save start.

        PUSH    HL              ; and transfer it
        POP     IX              ; to IX register.
        SCF                     ; set carry flag to load data on tape.
        LD      A,$FF           ; signal data not a header.
        CALL    L0802           ; routine LD-BLOCK loads to workspace.
        POP     HL              ; restore first location in workspace to HL.
X08CE   LD      DE,($5C53)      ; set DE from system variable PROG.

;   now enter a loop to merge the data block in workspace with the program and 
;   variables. 

;; ME-NEW-LP
L08D2:  LD      A,(HL)          ; fetch next byte from workspace.
        AND     $C0             ; compare with $3F.
        JR      NZ,L08F0        ; forward to ME-VAR-LP if a variable or 
                                ; end-marker.

;   continue when HL addresses a BASIC line number.

;; ME-OLD-LP
L08D7:  LD      A,(DE)          ; fetch high byte from program area.
        INC     DE              ; bump prog address.
        CP      (HL)            ; compare with that in workspace.
        INC     HL              ; bump workspace address.
        JR      NZ,L08DF        ; forward to ME-OLD-L1 if high bytes don't match

        LD      A,(DE)          ; fetch the low byte of program line number.
        CP      (HL)            ; compare with that in workspace.

;; ME-OLD-L1
L08DF:  DEC     DE              ; point to start of
        DEC     HL              ; respective lines again.
        JR      NC,L08EB        ; forward to ME-NEW-L2 if line number in 
                                ; workspace is less than or equal to current
                                ; program line as has to be added to program.

        PUSH    HL              ; else save workspace pointer. 
        EX      DE,HL           ; transfer prog pointer to HL
        CALL    L19B8           ; routine NEXT-ONE finds next line in DE.
        POP     HL              ; restore workspace pointer
        JR      L08D7           ; back to ME-OLD-LP until destination position 
                                ; in program area found.

; ---
;   the branch was here with an insertion or replacement point.

;; ME-NEW-L2
L08EB:  CALL    L092C           ; routine ME-ENTER enters the line
        JR      L08D2           ; loop back to ME-NEW-LP.

; ---
;   the branch was here when the location in workspace held a variable.

;; ME-VAR-LP
L08F0:  LD      A,(HL)          ; fetch first byte of workspace variable.
        LD      C,A             ; copy to C also.
        CP      $80             ; is it the end-marker ?
        RET     Z               ; return if so as complete.  >>>>>

        PUSH    HL              ; save workspace area pointer.
        LD      HL,($5C4B)      ; load HL with VARS - start of variables area.

;; ME-OLD-VP
L08F9:  LD      A,(HL)          ; fetch first byte.
        CP      $80             ; is it the end-marker ?
        JR      Z,L0923         ; forward if so to ME-VAR-L2 to add
                                ; variable at end of variables area.

        CP      C               ; compare with variable in workspace area.
        JR      Z,L0909         ; forward to ME-OLD-V2 if a match to replace.

;   else entire variables area has to be searched.

;; ME-OLD-V1
L0901:  PUSH    BC              ; save character in C.
        CALL    L19B8           ; routine NEXT-ONE gets following variable 
                                ; address in DE.
        POP     BC              ; restore character in C
        EX      DE,HL           ; transfer next address to HL.
        JR      L08F9           ; loop back to ME-OLD-VP

; --- 
;   the branch was here when first characters of name matched. 

;; ME-OLD-V2
L0909:  AND     $E0             ; keep bits 11100000
        CP      $A0             ; compare   10100000 - a long-named variable.

        JR      NZ,L0921        ; forward to ME-VAR-L1 if just one-character.

;   but long-named variables have to be matched character by character.

        POP     DE              ; fetch workspace 1st character pointer
        PUSH    DE              ; and save it on the stack again.
        PUSH    HL              ; save variables area pointer on stack.

;; ME-OLD-V3
L0912:  INC     HL              ; address next character in vars area.
        INC     DE              ; address next character in workspace area.
        LD      A,(DE)          ; fetch workspace character.
        CP      (HL)            ; compare to variables character.
        JR      NZ,L091E        ; forward to ME-OLD-V4 with a mismatch.

        RLA                     ; test if the terminal inverted character.
        JR      NC,L0912        ; loop back to ME-OLD-V3 if more to test.

;   otherwise the long name matches in its entirety.

        POP     HL              ; restore pointer to first character of variable
        JR      L0921           ; forward to ME-VAR-L1

; ---
;   the branch is here when two characters don't match

;; ME-OLD-V4
L091E:  POP     HL              ; restore the prog/vars pointer.
        JR      L0901           ; back to ME-OLD-V1 to resume search.

; ---
;   branch here when variable is to replace an existing one

;; ME-VAR-L1
L0921:  LD      A,$FF           ; indicate a replacement.

;   this entry point is when A holds $80 indicating a new variable.

;; ME-VAR-L2
L0923:  POP     DE              ; pop workspace pointer.
        EX      DE,HL           ; now make HL workspace pointer, DE vars pointer
        INC     A               ; zero flag set if replacement.
        SCF                     ; set carry flag indicating a variable not a
                                ; program line.
        CALL    L092C           ; routine ME-ENTER copies variable in.
        JR      L08F0           ; loop back to ME-VAR-LP

; ------------------------
; Merge a Line or Variable
; ------------------------
;   A BASIC line or variable is inserted at the current point. If the line 
;   number or variable names match (zero flag set) then a replacement takes 
;   place.

;; ME-ENTER
L092C:  JR      NZ,L093E        ; forward to ME-ENT-1 for insertion only.

;   but the program line or variable matches so old one is reclaimed.

        EX      AF,AF'          ; save flag??
        LD      ($5C5F),HL      ; preserve workspace pointer in dynamic X_PTR
        EX      DE,HL           ; transfer program dest pointer to HL.
        CALL    L19B8           ; routine NEXT-ONE finds following location
                                ; in program or variables area.
        CALL    L19E8           ; routine RECLAIM-2 reclaims the space between.
        EX      DE,HL           ; transfer program dest pointer back to DE.
        LD      HL,($5C5F)      ; fetch adjusted workspace pointer from X_PTR
        EX      AF,AF'          ; restore flags.

;   now the new line or variable is entered.

;; ME-ENT-1
L093E:  EX      AF,AF'          ; save or re-save flags.
        PUSH    DE              ; save dest pointer in prog/vars area.
        CALL    L19B8           ; routine NEXT-ONE finds next in workspace.
                                ; gets next in DE, difference in BC.
                                ; prev addr in HL
        LD      ($5C5F),HL      ; store pointer in X_PTR
        LD      HL,($5C53)      ; load HL from system variable PROG
        EX      (SP),HL         ; swap with prog/vars pointer on stack. 
        PUSH    BC              ; ** save length of new program line/variable.
        EX      AF,AF'          ; fetch flags back.
        JR      C,L0955         ; skip to ME-ENT-2 if variable

        DEC     HL              ; address location before pointer
        CALL    L1655           ; routine MAKE-ROOM creates room for BASIC line
        INC     HL              ; address next.
        JR      L0958           ; forward to ME-ENT-3

; ---

;; ME-ENT-2
L0955:  CALL    L1655           ; routine MAKE-ROOM creates room for variable.

;; ME-ENT-3
L0958:  INC     HL              ; address next?

        POP     BC              ; ** pop length
        POP     DE              ; * pop value for PROG which may have been 
                                ; altered by POINTERS if first line.
        LD      ($5C53),DE      ; set PROG to original value.
        LD      DE,($5C5F)      ; fetch adjusted workspace pointer from X_PTR
        PUSH    BC              ; save length
        PUSH    DE              ; and workspace pointer
        EX      DE,HL           ; make workspace pointer source, prog/vars
                                ; pointer the destination
        LDIR                    ; copy bytes of line or variable into new area.
        POP     HL              ; restore workspace pointer.
        POP     BC              ; restore length.
        PUSH    DE              ; save new prog/vars pointer.
        CALL    L19E8           ; routine RECLAIM-2 reclaims the space used
                                ; by the line or variable in workspace block
                                ; as no longer required and space could be 
                                ; useful for adding more lines.
        POP     DE              ; restore the prog/vars pointer
        RET                     ; return.

; --------------------------
; THE 'SAVE CONTROL' ROUTINE
; --------------------------
;   A branch from the main SAVE-ETC routine at SAVE-ALL.
;   First the header data is saved. Then after a wait of 1 second
;   the data itself is saved.
;   HL points to start of data.
;   IX points to start of descriptor.

;; SA-CONTRL
L0970:  PUSH    HL              ; save start of data

        LD      A,$FD           ; select system channel 'S'
        CALL    L1601           ; routine CHAN-OPEN

        XOR     A               ; clear to address table directly
        LD      DE,L09A1        ; address: tape-msgs
        CALL    L0C0A           ; routine PO-MSG -
                                ; 'Start tape then press any key.'

        SET     5,(IY+$02)      ; TV_FLAG  - Signal lower screen requires
                                ; clearing
        CALL    L15D4           ; routine WAIT-KEY

        PUSH    IX              ; save pointer to descriptor.
        LD      DE,$0011        ; there are seventeen bytes.
        XOR     A               ; signal a header.
        CALL    L04C2           ; routine SA-BYTES

        POP     IX              ; restore descriptor pointer.

        LD      B,$32           ; wait for a second - 50 interrupts.

;; SA-1-SEC
L0991:  HALT                    ; wait for interrupt
        DJNZ    L0991           ; back to SA-1-SEC until pause complete.

        LD      E,(IX+$0B)      ; fetch length of bytes from the
        LD      D,(IX+$0C)      ; descriptor.

        LD      A,$FF           ; signal data bytes.

        POP     IX              ; retrieve pointer to start
        JP      L04C2           ; jump back to SA-BYTES


;   Arrangement of two headers in workspace.
;   Originally IX addresses first location and only one header is required
;   when saving.
;
;   OLD     NEW         PROG   DATA  DATA  CODE 
;   HEADER  HEADER             num   chr          NOTES.
;   ------  ------      ----   ----  ----  ----   -----------------------------
;   IX-$11  IX+$00      0      1     2     3      Type.
;   IX-$10  IX+$01      x      x     x     x      F  ($FF if filename is null).
;   IX-$0F  IX+$02      x      x     x     x      i
;   IX-$0E  IX+$03      x      x     x     x      l
;   IX-$0D  IX+$04      x      x     x     x      e
;   IX-$0C  IX+$05      x      x     x     x      n
;   IX-$0B  IX+$06      x      x     x     x      a
;   IX-$0A  IX+$07      x      x     x     x      m
;   IX-$09  IX+$08      x      x     x     x      e
;   IX-$08  IX+$09      x      x     x     x      .
;   IX-$07  IX+$0A      x      x     x     x      (terminal spaces).
;   IX-$06  IX+$0B      lo     lo    lo    lo     Total  
;   IX-$05  IX+$0C      hi     hi    hi    hi     Length of datablock.
;   IX-$04  IX+$0D      Auto   -     -     Start  Various
;   IX-$03  IX+$0E      Start  a-z   a-z   addr   ($80 if no autostart).
;   IX-$02  IX+$0F      lo     -     -     -      Length of Program 
;   IX-$01  IX+$10      hi     -     -     -      only i.e. without variables.
;


; ------------------------
; Canned cassette messages
; ------------------------
;   The last-character-inverted Cassette messages.
;   Starts with normal initial step-over byte.

;; tape-msgs
L09A1:  DEFB    $80
        DEFM    "Start tape, then press any key"
L09C0:  DEFB    '.'+$80
        DEFB    $0D
        DEFM    "Program:"
        DEFB    ' '+$80
        DEFB    $0D
        DEFM    "Number array:"
        DEFB    ' '+$80
        DEFB    $0D
        DEFM    "Character array:"
        DEFB    ' '+$80
        DEFB    $0D
        DEFM    "Bytes:"
        DEFB    ' '+$80


;**************************************************
;** Part 5. SCREEN AND PRINTER HANDLING ROUTINES **
;**************************************************

; --------------------------
; THE 'PRINT OUTPUT' ROUTINE
; --------------------------
;   This is the routine most often used by the RST 10 restart although the
;   subroutine is on two occasions called directly when it is known that
;   output will definitely be to the lower screen.

;; PRINT-OUT
L09F4:  CALL    L0B03           ; routine PO-FETCH fetches print position
                                ; to HL register pair.
        CP      $20             ; is character a space or higher ?
        JP      NC,L0AD9        ; jump forward to PO-ABLE if so.

        CP      $06             ; is character in range 00-05 ?
        JR      C,L0A69         ; to PO-QUEST to print '?' if so.

        CP      $18             ; is character in range 24d - 31d ?
        JR      NC,L0A69        ; to PO-QUEST to also print '?' if so.

        LD      HL,L0A11 - 6    ; address 0A0B - the base address of control
                                ; character table - where zero would be.
        LD      E,A             ; control character 06 - 23d
        LD      D,$00           ; is transferred to DE.

        ADD     HL,DE           ; index into table.

        LD      E,(HL)          ; fetch the offset to routine.
        ADD     HL,DE           ; add to make HL the address.
        PUSH    HL              ; push the address.

        JP      L0B03           ; Jump forward to PO-FETCH, 
                                ; as the screen/printer position has been 
                                ; disturbed, and then indirectly to the PO-STORE
                                ; routine on stack.

; -----------------------------
; THE 'CONTROL CHARACTER' TABLE
; -----------------------------
;   For control characters in the range 6 - 23d the following table
;   is indexed to provide an offset to the handling routine that
;   follows the table.

;; ctlchrtab
L0A11:  DEFB    L0A5F - $       ; 06d offset $4E to Address: PO-COMMA
        DEFB    L0A69 - $       ; 07d offset $57 to Address: PO-QUEST
        DEFB    L0A23 - $       ; 08d offset $10 to Address: PO-BACK-1
        DEFB    L0A3D - $       ; 09d offset $29 to Address: PO-RIGHT
        DEFB    L0A69 - $       ; 10d offset $54 to Address: PO-QUEST
        DEFB    L0A69 - $       ; 11d offset $53 to Address: PO-QUEST
        DEFB    L0A69 - $       ; 12d offset $52 to Address: PO-QUEST
        DEFB    L0A4F - $       ; 13d offset $37 to Address: PO-ENTER
        DEFB    L0A69 - $       ; 14d offset $50 to Address: PO-QUEST
        DEFB    L0A69 - $       ; 15d offset $4F to Address: PO-QUEST
        DEFB    L0A7A - $       ; 16d offset $5F to Address: PO-1-OPER
        DEFB    L0A7A - $       ; 17d offset $5E to Address: PO-1-OPER
        DEFB    L0A7A - $       ; 18d offset $5D to Address: PO-1-OPER
        DEFB    L0A7A - $       ; 19d offset $5C to Address: PO-1-OPER
        DEFB    L0A7A - $       ; 20d offset $5B to Address: PO-1-OPER
        DEFB    L0A7A - $       ; 21d offset $5A to Address: PO-1-OPER
        DEFB    L0A75 - $       ; 22d offset $54 to Address: PO-2-OPER
        DEFB    L0A75 - $       ; 23d offset $53 to Address: PO-2-OPER


; -------------------------
; THE 'CURSOR LEFT' ROUTINE
; -------------------------
;   Backspace and up a line if that action is from the left of screen.
;   For ZX printer backspace up to first column but not beyond.

;; PO-BACK-1
L0A23:  INC     C               ; move left one column.
        LD      A,$22           ; value $21 is leftmost column.
        CP      C               ; have we passed ?
        JR      NZ,L0A3A        ; to PO-BACK-3 if not and store new position.

        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
        JR      NZ,L0A38        ; to PO-BACK-2 if so, as we are unable to
                                ; backspace from the leftmost position.


        INC     B               ; move up one screen line
        LD      C,$02           ; the rightmost column position.
        LD      A,$18           ; Note. This should be $19
                                ; credit. Dr. Frank O'Hara, 1982

        CP      B               ; has position moved past top of screen ?
        JR      NZ,L0A3A        ; to PO-BACK-3 if not and store new position.

        DEC     B               ; else back to $18.

;; PO-BACK-2
L0A38:  LD      C,$21           ; the leftmost column position.

;; PO-BACK-3
L0A3A:  JP      L0DD9           ; to CL-SET and PO-STORE to save new
                                ; position in system variables.

; --------------------------
; THE 'CURSOR RIGHT' ROUTINE
; --------------------------
;   This moves the print position to the right leaving a trail in the
;   current background colour.
;   "However the programmer has failed to store the new print position
;   so CHR$ 9 will only work if the next print position is at a newly
;   defined place.
;   e.g. PRINT PAPER 2; CHR$ 9; AT 4,0;
;   does work but is not very helpful"
;   - Dr. Ian Logan, Understanding Your Spectrum, 1982.

;; PO-RIGHT
L0A3D:  LD      A,($5C91)       ; fetch P_FLAG value
        PUSH    AF              ; and save it on stack.

        LD      (IY+$57),$01    ; temporarily set P_FLAG 'OVER 1'.
        LD      A,$20           ; prepare a space.
        CALL    L0B65           ; routine PO-CHAR to print it.
                                ; Note. could be PO-ABLE which would update
                                ; the column position.

        POP     AF              ; restore the permanent flag.
        LD      ($5C91),A       ; and restore system variable P_FLAG

        RET                     ; return without updating column position

; -----------------------
; Perform carriage return
; -----------------------
; A carriage return is 'printed' to screen or printer buffer.

;; PO-ENTER
L0A4F:  BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
        JP      NZ,L0ECD        ; to COPY-BUFF if so, to flush buffer and reset
                                ; the print position.

        LD      C,$21           ; the leftmost column position.
        CALL    L0C55           ; routine PO-SCR handles any scrolling required.
        DEC     B               ; to next screen line.
        JP      L0DD9           ; jump forward to CL-SET to store new position.

; -----------
; Print comma
; -----------
; The comma control character. The 32 column screen has two 16 character
; tabstops.  The routine is only reached via the control character table.

;; PO-COMMA
L0A5F:  CALL    L0B03           ; routine PO-FETCH - seems unnecessary.

        LD      A,C             ; the column position. $21-$01
        DEC     A               ; move right. $20-$00
        DEC     A               ; and again   $1F-$00 or $FF if trailing
        AND     $10             ; will be $00 or $10.
        JR      L0AC3           ; forward to PO-FILL

; -------------------
; Print question mark
; -------------------
; This routine prints a question mark which is commonly
; used to print an unassigned control character in range 0-31d.
; there are a surprising number yet to be assigned.

;; PO-QUEST
L0A69:  LD      A,$3F           ; prepare the character '?'.
        JR      L0AD9           ; forward to PO-ABLE.

; --------------------------------
; Control characters with operands
; --------------------------------
; Certain control characters are followed by 1 or 2 operands.
; The entry points from control character table are PO-2-OPER and PO-1-OPER.
; The routines alter the output address of the current channel so that
; subsequent RST $10 instructions take the appropriate action
; before finally resetting the output address back to PRINT-OUT.

;; PO-TV-2
L0A6D:  LD      DE,L0A87        ; address: PO-CONT will be next output routine
        LD      ($5C0F),A       ; store first operand in TVDATA-hi
        JR      L0A80           ; forward to PO-CHANGE >>

; ---

; -> This initial entry point deals with two operands - AT or TAB.

;; PO-2-OPER
L0A75:  LD      DE,L0A6D        ; address: PO-TV-2 will be next output routine
        JR      L0A7D           ; forward to PO-TV-1

; ---

; -> This initial entry point deals with one operand INK to OVER.

;; PO-1-OPER
L0A7A:  LD      DE,L0A87        ; address: PO-CONT will be next output routine

;; PO-TV-1
L0A7D:  LD      ($5C0E),A       ; store control code in TVDATA-lo

;; PO-CHANGE
L0A80:  LD      HL,($5C51)      ; use CURCHL to find current output channel.
        LD      (HL),E          ; make it
        INC     HL              ; the supplied
        LD      (HL),D          ; address from DE.
        RET                     ; return.

; ---

;; PO-CONT
L0A87:  LD      DE,L09F4        ; Address: PRINT-OUT
        CALL    L0A80           ; routine PO-CHANGE to restore normal channel.
        LD      HL,($5C0E)      ; TVDATA gives control code and possible
                                ; subsequent character
        LD      D,A             ; save current character
        LD      A,L             ; the stored control code
        CP      $16             ; was it INK to OVER (1 operand) ?
        JP      C,L2211         ; to CO-TEMP-5

        JR      NZ,L0AC2        ; to PO-TAB if not 22d i.e. 23d TAB.

                                ; else must have been 22d AT.
        LD      B,H             ; line to H   (0-23d)
        LD      C,D             ; column to C (0-31d)
        LD      A,$1F           ; the value 31d
        SUB     C               ; reverse the column number.
        JR      C,L0AAC         ; to PO-AT-ERR if C was greater than 31d.

        ADD     A,$02           ; transform to system range $02-$21
        LD      C,A             ; and place in column register.

        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
        JR      NZ,L0ABF        ; to PO-AT-SET as line can be ignored.

        LD      A,$16           ; 22 decimal
        SUB     B               ; subtract line number to reverse
                                ; 0 - 22 becomes 22 - 0.

;; PO-AT-ERR
L0AAC:  JP      C,L1E9F         ; to REPORT-B if higher than 22 decimal
                                ; Integer out of range.

        INC     A               ; adjust for system range $01-$17
        LD      B,A             ; place in line register
        INC     B               ; adjust to system range  $02-$18
        BIT     0,(IY+$02)      ; TV_FLAG  - Lower screen in use ?
        JP      NZ,L0C55        ; exit to PO-SCR to test for scrolling

        CP      (IY+$31)        ; Compare against DF_SZ
        JP      C,L0C86         ; to REPORT-5 if too low
                                ; Out of screen.

;; PO-AT-SET
L0ABF:  JP      L0DD9           ; print position is valid so exit via CL-SET

; ---

; Continue here when dealing with TAB.
; Note. In BASIC, TAB is followed by a 16-bit number and was initially
; designed to work with any output device.

;; PO-TAB
L0AC2:  LD      A,H             ; transfer parameter to A
                                ; Losing current character -
                                ; High byte of TAB parameter.


;; PO-FILL
L0AC3:  CALL    L0B03           ; routine PO-FETCH, HL-addr, BC=line/column.
                                ; column 1 (right), $21 (left)
        ADD     A,C             ; add operand to current column
        DEC     A               ; range 0 - 31+
        AND     $1F             ; make range 0 - 31d
        RET     Z               ; return if result zero

        LD      D,A             ; Counter to D
        SET     0,(IY+$01)      ; update FLAGS  - signal suppress leading space.

;; PO-SPACE
L0AD0:  LD      A,$20           ; space character.

        CALL    L0C3B           ; routine PO-SAVE prints the character
                                ; using alternate set (normal output routine)

        DEC     D               ; decrement counter.
        JR      NZ,L0AD0        ; to PO-SPACE until done

        RET                     ; return

; ----------------------
; Printable character(s)
; ----------------------
; This routine prints printable characters and continues into
; the position store routine

;; PO-ABLE
L0AD9:  CALL    L0B24           ; routine PO-ANY
                                ; and continue into position store routine.

; ----------------------------
; THE 'POSITION STORE' ROUTINE
; ----------------------------
;   This routine updates the system variables associated with the main screen, 
;   the lower screen/input buffer or the ZX printer.

;; PO-STORE
L0ADC:  BIT     1,(IY+$01)      ; Test FLAGS - is printer in use ?
        JR      NZ,L0AFC        ; Forward, if so, to PO-ST-PR

        BIT     0,(IY+$02)      ; Test TV_FLAG - is lower screen in use ?
        JR      NZ,L0AF0        ; Forward, if so, to PO-ST-E

;   This section deals with the upper screen.

        LD      ($5C88),BC      ; Update S_POSN - line/column upper screen
        LD      ($5C84),HL      ; Update DF_CC - upper display file address

        RET                     ; Return.

; ---

;   This section deals with the lower screen.

;; PO-ST-E
L0AF0:  LD      ($5C8A),BC      ; Update SPOSNL line/column lower screen
        LD      ($5C82),BC      ; Update ECHO_E line/column input buffer
        LD      ($5C86),HL      ; Update DFCCL  lower screen memory address
        RET                     ; Return.

; ---

;   This section deals with the ZX Printer.

;; PO-ST-PR
L0AFC:  LD      (IY+$45),C      ; Update P_POSN column position printer
        LD      ($5C80),HL      ; Update PR_CC - full printer buffer memory 
                                ; address
        RET                     ; Return.

;   Note. that any values stored in location 23681 will be overwritten with 
;   the value 91 decimal. 
;   Credit April 1983, Dilwyn Jones. "Delving Deeper into your ZX Spectrum".

; ----------------------------
; THE 'POSITION FETCH' ROUTINE
; ----------------------------
;   This routine fetches the line/column and display file address of the upper 
;   and lower screen or, if the printer is in use, the column position and 
;   absolute memory address.
;   Note. that PR-CC-hi (23681) is used by this routine and if, in accordance 
;   with the manual (that says this is unused), the location has been used for 
;   other purposes, then subsequent output to the printer buffer could corrupt 
;   a 256-byte section of memory.

;; PO-FETCH
L0B03:  BIT     1,(IY+$01)      ; Test FLAGS - is printer in use ?
        JR      NZ,L0B1D        ; Forward, if so, to PO-F-PR

;   assume upper screen in use and thus optimize for path that requires speed.

        LD      BC,($5C88)      ; Fetch line/column from S_POSN
        LD      HL,($5C84)      ; Fetch DF_CC display file address

        BIT     0,(IY+$02)      ; Test TV_FLAG - lower screen in use ?
        RET     Z               ; Return if upper screen in use.

;   Overwrite registers with values for lower screen.

        LD      BC,($5C8A)      ; Fetch line/column from SPOSNL
        LD      HL,($5C86)      ; Fetch display file address from DFCCL
        RET                     ; Return.

; ---

;   This section deals with the ZX Printer.

;; PO-F-PR
L0B1D:  LD      C,(IY+$45)      ; Fetch column from P_POSN.
        LD      HL,($5C80)      ; Fetch printer buffer address from PR_CC.
        RET                     ; Return.

; ---------------------------------
; THE 'PRINT ANY CHARACTER' ROUTINE
; ---------------------------------
;   This routine is used to print any character in range 32d - 255d
;   It is only called from PO-ABLE which continues into PO-STORE

;; PO-ANY
L0B24:  CP      $80             ; ASCII ?
        JR      C,L0B65         ; to PO-CHAR is so.

        CP      $90             ; test if a block graphic character.
        JR      NC,L0B52        ; to PO-T&UDG to print tokens and UDGs

; The 16 2*2 mosaic characters 128-143 decimal are formed from
; bits 0-3 of the character.

        LD      B,A             ; save character
        CALL    L0B38           ; routine PO-GR-1 to construct top half
                                ; then bottom half.
        CALL    L0B03           ; routine PO-FETCH fetches print position.
        LD      DE,$5C92        ; MEM-0 is location of 8 bytes of character
        JR      L0B7F           ; to PR-ALL to print to screen or printer

; ---

;; PO-GR-1
L0B38:  LD      HL,$5C92        ; address MEM-0 - a temporary buffer in
                                ; systems variables which is normally used
                                ; by the calculator.
        CALL    L0B3E           ; routine PO-GR-2 to construct top half
                                ; and continue into routine to construct
                                ; bottom half.

;; PO-GR-2
L0B3E:  RR      B               ; rotate bit 0/2 to carry
        SBC     A,A             ; result $00 or $FF
        AND     $0F             ; mask off right hand side
        LD      C,A             ; store part in C
        RR      B               ; rotate bit 1/3 of original chr to carry
        SBC     A,A             ; result $00 or $FF
        AND     $F0             ; mask off left hand side
        OR      C               ; combine with stored pattern
        LD      C,$04           ; four bytes for top/bottom half

;; PO-GR-3
L0B4C:  LD      (HL),A          ; store bit patterns in temporary buffer
        INC     HL              ; next address
        DEC     C               ; jump back to
        JR      NZ,L0B4C        ; to PO-GR-3 until byte is stored 4 times

        RET                     ; return

; ---

; Tokens and User defined graphics are now separated.

;; PO-T&UDG
L0B52:  SUB     $A5             ; the 'RND' character
        JR      NC,L0B5F        ; to PO-T to print tokens

        ADD     A,$15           ; add 21d to restore to 0 - 20
        PUSH    BC              ; save current print position
        LD      BC,($5C7B)      ; fetch UDG to address bit patterns
        JR      L0B6A           ; to PO-CHAR-2 - common code to lay down
                                ; a bit patterned character

; ---

;; PO-T
L0B5F:  CALL    L0C10           ; routine PO-TOKENS prints tokens
        JP      L0B03           ; exit via a JUMP to PO-FETCH as this routine 
                                ; must continue into PO-STORE. 
                                ; A JR instruction could be used.

; This point is used to print ASCII characters  32d - 127d.

;; PO-CHAR
L0B65:  PUSH    BC              ; save print position
        LD      BC,($5C36)      ; address CHARS

; This common code is used to transfer the character bytes to memory.

;; PO-CHAR-2
L0B6A:  EX      DE,HL           ; transfer destination address to DE
        LD      HL,$5C3B        ; point to FLAGS
        RES     0,(HL)          ; allow for leading space
        CP      $20             ; is it a space ?
        JR      NZ,L0B76        ; to PO-CHAR-3 if not

        SET     0,(HL)          ; signal no leading space to FLAGS

;; PO-CHAR-3
L0B76:  LD      H,$00           ; set high byte to 0
        LD      L,A             ; character to A
                                ; 0-21 UDG or 32-127 ASCII.
        ADD     HL,HL           ; multiply
        ADD     HL,HL           ; by
        ADD     HL,HL           ; eight
        ADD     HL,BC           ; HL now points to first byte of character
        POP     BC              ; the source address CHARS or UDG
        EX      DE,HL           ; character address to DE

; ----------------------------------
; THE 'PRINT ALL CHARACTERS' ROUTINE
; ----------------------------------
;   This entry point entered from above to print ASCII and UDGs but also from 
;   earlier to print mosaic characters.
;   HL=destination
;   DE=character source
;   BC=line/column

;; PR-ALL
L0B7F:  LD      A,C             ; column to A
        DEC     A               ; move right
        LD      A,$21           ; pre-load with leftmost position
        JR      NZ,L0B93        ; but if not zero to PR-ALL-1

        DEC     B               ; down one line
        LD      C,A             ; load C with $21
        BIT     1,(IY+$01)      ; test FLAGS  - Is printer in use
        JR      Z,L0B93         ; to PR-ALL-1 if not

        PUSH    DE              ; save source address
        CALL    L0ECD           ; routine COPY-BUFF outputs line to printer
        POP     DE              ; restore character source address
        LD      A,C             ; the new column number ($21) to C

;; PR-ALL-1
L0B93:  CP      C               ; this test is really for screen - new line ?
        PUSH    DE              ; save source

        CALL    Z,L0C55         ; routine PO-SCR considers scrolling

        POP     DE              ; restore source
        PUSH    BC              ; save line/column
        PUSH    HL              ; and destination
        LD      A,($5C91)       ; fetch P_FLAG to accumulator
        LD      B,$FF           ; prepare OVER mask in B.
        RRA                     ; bit 0 set if OVER 1
        JR      C,L0BA4         ; to PR-ALL-2

        INC     B               ; set OVER mask to 0

;; PR-ALL-2
L0BA4:  RRA                     ; skip bit 1 of P_FLAG
        RRA                     ; bit 2 is INVERSE
        SBC     A,A             ; will be FF for INVERSE 1 else zero
        LD      C,A             ; transfer INVERSE mask to C
        LD      A,$08           ; prepare to count 8 bytes
        AND     A               ; clear carry to signal screen
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
        JR      Z,L0BB6         ; to PR-ALL-3 if screen

        SET     1,(IY+$30)      ; update FLAGS2  - signal printer buffer has 
                                ; been used.
        SCF                     ; set carry flag to signal printer.

;; PR-ALL-3
L0BB6:  EX      DE,HL           ; now HL=source, DE=destination

;; PR-ALL-4
L0BB7:  EX      AF,AF'          ; save printer/screen flag
        LD      A,(DE)          ; fetch existing destination byte
        AND     B               ; consider OVER
        XOR     (HL)            ; now XOR with source
        XOR     C               ; now with INVERSE MASK
        LD      (DE),A          ; update screen/printer
        EX      AF,AF'          ; restore flag
        JR      C,L0BD3         ; to PR-ALL-6 - printer address update

        INC     D               ; gives next pixel line down screen

;; PR-ALL-5
L0BC1:  INC     HL              ; address next character byte
        DEC     A               ; the byte count is decremented
        JR      NZ,L0BB7        ; back to PR-ALL-4 for all 8 bytes

        EX      DE,HL           ; destination to HL
        DEC     H               ; bring back to last updated screen position
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
        CALL    Z,L0BDB         ; if not, call routine PO-ATTR to update
                                ; corresponding colour attribute.
        POP     HL              ; restore original screen/printer position
        POP     BC              ; and line column
        DEC     C               ; move column to right
        INC     HL              ; increase screen/printer position
        RET                     ; return and continue into PO-STORE
                                ; within PO-ABLE

; ---

;   This branch is used to update the printer position by 32 places
;   Note. The high byte of the address D remains constant (which it should).

;; PR-ALL-6
L0BD3:  EX      AF,AF'          ; save the flag
        LD      A,$20           ; load A with 32 decimal
        ADD     A,E             ; add this to E
        LD      E,A             ; and store result in E
        EX      AF,AF'          ; fetch the flag
        JR      L0BC1           ; back to PR-ALL-5

; -----------------------------------
; THE 'GET ATTRIBUTE ADDRESS' ROUTINE
; -----------------------------------
;   This routine is entered with the HL register holding the last screen
;   address to be updated by PRINT or PLOT.
;   The Spectrum screen arrangement leads to the L register holding the correct
;   value for the attribute file and it is only necessary to manipulate H to 
;   form the correct colour attribute address.

;; PO-ATTR
L0BDB:  LD       A,H            ; fetch high byte $40 - $57
        RRCA                    ; shift
        RRCA                    ; bits 3 and 4
        RRCA                    ; to right.
        AND     $03             ; range is now 0 - 2
        OR      $58             ; form correct high byte for third of screen
        LD      H,A             ; HL is now correct
        LD      DE,($5C8F)      ; make D hold ATTR_T, E hold MASK-T
        LD      A,(HL)          ; fetch existing attribute
        XOR     E               ; apply masks
        AND     D               ;
        XOR     E               ;
        BIT     6,(IY+$57)      ; test P_FLAG  - is this PAPER 9 ??
        JR      Z,L0BFA         ; skip to PO-ATTR-1 if not.

        AND     $C7             ; set paper
        BIT     2,A             ; to contrast with ink
        JR      NZ,L0BFA        ; skip to PO-ATTR-1

        XOR     $38             ;

;; PO-ATTR-1
L0BFA:  BIT     4,(IY+$57)      ; test P_FLAG  - Is this INK 9 ??
        JR      Z,L0C08         ; skip to PO-ATTR-2 if not

        AND     $F8             ; make ink
        BIT     5,A             ; contrast with paper.
        JR      NZ,L0C08        ; to PO-ATTR-2

        XOR     $07             ;

;; PO-ATTR-2
L0C08:  LD      (HL),A          ; save the new attribute.
        RET                     ; return.

; ---------------------------------
; THE 'MESSAGE PRINTING' SUBROUTINE
; ---------------------------------
;   This entry point is used to print tape, boot-up, scroll? and error messages.
;   On entry the DE register points to an initial step-over byte or the 
;   inverted end-marker of the previous entry in the table.
;   Register A contains the message number, often zero to print first message.
;   (HL has nothing important usually P_FLAG)

;; PO-MSG
L0C0A:  PUSH    HL              ; put hi-byte zero on stack to suppress
        LD      H,$00           ; trailing spaces
        EX      (SP),HL         ; ld h,0; push hl would have done ?.
        JR      L0C14           ; forward to PO-TABLE.

; ---

;   This entry point prints the BASIC keywords, '<>' etc. from alt set

;; PO-TOKENS
L0C10:  LD      DE,L0095        ; address: TKN-TABLE
        PUSH    AF              ; save the token number to control
                                ; trailing spaces - see later *

; ->

;; PO-TABLE
L0C14:  CALL    L0C41           ; routine PO-SEARCH will set carry for
                                ; all messages and function words.

        JR      C,L0C22         ; forward to PO-EACH if not a command, '<>' etc.

        LD      A,$20           ; prepare leading space
        BIT     0,(IY+$01)      ; test FLAGS  - leading space if not set

        CALL    Z,L0C3B         ; routine PO-SAVE to print a space without 
                                ; disturbing registers.

;; PO-EACH
L0C22:  LD      A,(DE)          ; Fetch character from the table.
        AND     $7F             ; Cancel any inverted bit.

        CALL    L0C3B           ; Routine PO-SAVE to print using the alternate
                                ; set of registers.

        LD      A,(DE)          ; Re-fetch character from table.
        INC     DE              ; Address next character in the table.

        ADD     A,A             ; Was character inverted ?
                                ; (this also doubles character)
        JR      NC,L0C22        ; back to PO-EACH if not.

        POP     DE              ; * re-fetch trailing space byte to D 

        CP      $48             ; was the last character '$' ?
        JR      Z,L0C35         ; forward to PO-TR-SP to consider trailing
                                ; space if so.

        CP      $82             ; was it < 'A' i.e. '#','>','=' from tokens
                                ; or ' ','.' (from tape) or '?' from scroll

        RET     C               ; Return if so as no trailing space required.

;; PO-TR-SP
L0C35:  LD      A,D             ; The trailing space flag (zero if an error msg)

        CP      $03             ; Test against RND, INKEY$ and PI which have no
                                ; parameters and therefore no trailing space.

        RET     C               ; Return if no trailing space.

        LD      A,$20           ; Prepare the space character and continue to
                                ; print and make an indirect return.

; -----------------------------------
; THE 'RECURSIVE PRINTING' SUBROUTINE
; -----------------------------------
;   This routine which is part of PRINT-OUT allows RST $10 to be used 
;   recursively to print tokens and the spaces associated with them.
;   It is called on three occasions when the value of DE must be preserved.

;; PO-SAVE
L0C3B:  PUSH    DE              ; Save DE value.
        EXX                     ; Switch in main set

        RST     10H             ; PRINT-A prints using this alternate set.

        EXX                     ; Switch back to this alternate set.
        POP     DE              ; Restore the initial DE value.

        RET                     ; Return.

; ------------
; Table search
; ------------
; This subroutine searches a message or the token table for the
; message number held in A. DE holds the address of the table.

;; PO-SEARCH
L0C41:  PUSH    AF              ; save the message/token number
        EX      DE,HL           ; transfer DE to HL
        INC     A               ; adjust for initial step-over byte

;; PO-STEP
L0C44:  BIT     7,(HL)          ; is character inverted ?
        INC     HL              ; address next
        JR      Z,L0C44         ; back to PO-STEP if not inverted.

        DEC     A               ; decrease counter
        JR      NZ,L0C44        ; back to PO-STEP if not zero

        EX      DE,HL           ; transfer address to DE
        POP     AF              ; restore message/token number
        CP      $20             ; return with carry set
        RET     C               ; for all messages and function tokens

        LD      A,(DE)          ; test first character of token
        SUB     $41             ; and return with carry set
        RET                     ; if it is less that 'A'
                                ; i.e. '<>', '<=', '>='

; ---------------
; Test for scroll
; ---------------
; This test routine is called when printing carriage return, when considering
; PRINT AT and from the general PRINT ALL characters routine to test if
; scrolling is required, prompting the user if necessary.
; This is therefore using the alternate set.
; The B register holds the current line.

;; PO-SCR
L0C55:  BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
        RET     NZ              ; return immediately if so.

        LD      DE,L0DD9        ; set DE to address: CL-SET
        PUSH    DE              ; and push for return address.

        LD      A,B             ; transfer the line to A.
        BIT     0,(IY+$02)      ; test TV_FLAG - lower screen in use ?
        JP      NZ,L0D02        ; jump forward to PO-SCR-4 if so.

        CP      (IY+$31)        ; greater than DF_SZ display file size ?
        JR      C,L0C86         ; forward to REPORT-5 if less.
                                ; 'Out of screen'

        RET     NZ              ; return (via CL-SET) if greater

        BIT     4,(IY+$02)      ; test TV_FLAG  - Automatic listing ?
        JR      Z,L0C88         ; forward to PO-SCR-2 if not.

        LD      E,(IY+$2D)      ; fetch BREG - the count of scroll lines to E.
        DEC     E               ; decrease and jump
        JR      Z,L0CD2         ; to PO-SCR-3 if zero and scrolling required.

        LD      A,$00           ; explicit - select channel zero.
        CALL    L1601           ; routine CHAN-OPEN opens it.

        LD      SP,($5C3F)      ; set stack pointer to LIST_SP

        RES     4,(IY+$02)      ; reset TV_FLAG  - signal auto listing finished.
        RET                     ; return ignoring pushed value, CL-SET
                                ; to MAIN or EDITOR without updating
                                ; print position                         >>

; ---


;; REPORT-5
L0C86:  RST     08H             ; ERROR-1
        DEFB    $04             ; Error Report: Out of screen

; continue here if not an automatic listing.

;; PO-SCR-2
L0C88:  DEC     (IY+$52)        ; decrease SCR_CT
        JR      NZ,L0CD2        ; forward to PO-SCR-3 to scroll display if
                                ; result not zero.

; now produce prompt.

        LD      A,$18           ; reset
        SUB     B               ; the
        LD      ($5C8C),A       ; SCR_CT scroll count
        LD      HL,($5C8F)      ; L=ATTR_T, H=MASK_T
        PUSH    HL              ; save on stack
        LD      A,($5C91)       ; P_FLAG
        PUSH    AF              ; save on stack to prevent lower screen
                                ; attributes (BORDCR etc.) being applied.
        LD      A,$FD           ; select system channel 'K'
        CALL    L1601           ; routine CHAN-OPEN opens it
        XOR     A               ; clear to address message directly
        LD      DE,L0CF8        ; make DE address: scrl-mssg
        CALL    L0C0A           ; routine PO-MSG prints to lower screen
        SET     5,(IY+$02)      ; set TV_FLAG  - signal lower screen requires
                                ; clearing
        LD      HL,$5C3B        ; make HL address FLAGS
        SET     3,(HL)          ; signal 'L' mode.
        RES     5,(HL)          ; signal 'no new key'.
        EXX                     ; switch to main set.
                                ; as calling chr input from alternative set.
        CALL    L15D4           ; routine WAIT-KEY waits for new key
                                ; Note. this is the right routine but the
                                ; stream in use is unsatisfactory. From the
                                ; choices available, it is however the best.

        EXX                     ; switch back to alternate set.
        CP      $20             ; space is considered as BREAK
        JR      Z,L0D00         ; forward to REPORT-D if so
                                ; 'BREAK - CONT repeats'

        CP      $E2             ; is character 'STOP' ?
        JR      Z,L0D00         ; forward to REPORT-D if so

        OR      $20             ; convert to lower-case
        CP      $6E             ; is character 'n' ?
        JR      Z,L0D00         ; forward to REPORT-D if so else scroll.

        LD      A,$FE           ; select system channel 'S'
        CALL    L1601           ; routine CHAN-OPEN
        POP     AF              ; restore original P_FLAG
        LD      ($5C91),A       ; and save in P_FLAG.
        POP     HL              ; restore original ATTR_T, MASK_T
        LD      ($5C8F),HL      ; and reset ATTR_T, MASK-T as 'scroll?' has
                                ; been printed.

;; PO-SCR-3
L0CD2:  CALL    L0DFE           ; routine CL-SC-ALL to scroll whole display
        LD      B,(IY+$31)      ; fetch DF_SZ to B
        INC     B               ; increase to address last line of display
        LD      C,$21           ; set C to $21 (was $21 from above routine)
        PUSH    BC              ; save the line and column in BC.

        CALL    L0E9B           ; routine CL-ADDR finds display address.

        LD      A,H             ; now find the corresponding attribute byte
        RRCA                    ; (this code sequence is used twice
        RRCA                    ; elsewhere and is a candidate for
        RRCA                    ; a subroutine.)
        AND     $03             ;
        OR      $58             ;
        LD      H,A             ;

        LD      DE,$5AE0        ; start of last 'line' of attribute area
        LD      A,(DE)          ; get attribute for last line
        LD      C,(HL)          ; transfer to base line of upper part
        LD      B,$20           ; there are thirty two bytes
        EX      DE,HL           ; swap the pointers.

;; PO-SCR-3A
L0CF0:  LD      (DE),A          ; transfer
        LD      (HL),C          ; attributes.
        INC     DE              ; address next.
        INC     HL              ; address next.
        DJNZ    L0CF0           ; loop back to PO-SCR-3A for all adjacent
                                ; attribute lines.

        POP     BC              ; restore the line/column.
        RET                     ; return via CL-SET (was pushed on stack).

; ---

; The message 'scroll?' appears here with last byte inverted.

;; scrl-mssg
L0CF8:  DEFB    $80             ; initial step-over byte.
        DEFM    "scroll"
        DEFB    '?'+$80

;; REPORT-D
L0D00:  RST     08H             ; ERROR-1
        DEFB    $0C             ; Error Report: BREAK - CONT repeats

; continue here if using lower display - A holds line number.

;; PO-SCR-4
L0D02:  CP      $02             ; is line number less than 2 ?
        JR      C,L0C86         ; to REPORT-5 if so
                                ; 'Out of Screen'.

        ADD     A,(IY+$31)      ; add DF_SZ
        SUB     $19             ;
        RET     NC              ; return if scrolling unnecessary

        NEG                     ; Negate to give number of scrolls required.
        PUSH    BC              ; save line/column
        LD      B,A             ; count to B
        LD      HL,($5C8F)      ; fetch current ATTR_T, MASK_T to HL.
        PUSH    HL              ; and save
        LD      HL,($5C91)      ; fetch P_FLAG
        PUSH    HL              ; and save.
                                ; to prevent corruption by input AT

        CALL    L0D4D           ; routine TEMPS sets to BORDCR etc
        LD      A,B             ; transfer scroll number to A.

;; PO-SCR-4A
L0D1C:  PUSH    AF              ; save scroll number.
        LD      HL,$5C6B        ; address DF_SZ
        LD      B,(HL)          ; fetch old value
        LD      A,B             ; transfer to A
        INC     A               ; and increment
        LD      (HL),A          ; then put back.
        LD      HL,$5C89        ; address S_POSN_hi - line
        CP      (HL)            ; compare
        JR      C,L0D2D         ; forward to PO-SCR-4B if scrolling required

        INC     (HL)            ; else increment S_POSN_hi
        LD      B,$18           ; set count to whole display ??
                                ; Note. should be $17 and the top line will be 
                                ; scrolled into the ROM which is harmless on 
                                ; the standard set up.
                                ; credit P.Giblin 1984.

;; PO-SCR-4B
L0D2D:  CALL    L0E00           ; routine CL-SCROLL scrolls B lines
        POP     AF              ; restore scroll counter.
        DEC     A               ; decrease
        JR      NZ,L0D1C        ; back to PO-SCR-4A until done

        POP     HL              ; restore original P_FLAG.
        LD      (IY+$57),L      ; and overwrite system variable P_FLAG.

        POP     HL              ; restore original ATTR_T/MASK_T.
        LD      ($5C8F),HL      ; and update system variables.

        LD      BC,($5C88)      ; fetch S_POSN to BC.
        RES     0,(IY+$02)      ; signal to TV_FLAG  - main screen in use.
        CALL    L0DD9           ; call routine CL-SET for upper display.

        SET     0,(IY+$02)      ; signal to TV_FLAG  - lower screen in use.
        POP     BC              ; restore line/column
        RET                     ; return via CL-SET for lower display.

; ----------------------
; Temporary colour items
; ----------------------
; This subroutine is called 11 times to copy the permanent colour items
; to the temporary ones.

;; TEMPS
L0D4D:  XOR     A               ; clear the accumulator
        LD      HL,($5C8D)      ; fetch L=ATTR_P and H=MASK_P
        BIT     0,(IY+$02)      ; test TV_FLAG  - is lower screen in use ?
        JR      Z,L0D5B         ; skip to TEMPS-1 if not

        LD      H,A             ; set H, MASK P, to 00000000.
        LD      L,(IY+$0E)      ; fetch BORDCR to L which is used for lower
                                ; screen.

;; TEMPS-1
L0D5B:  LD      ($5C8F),HL      ; transfer values to ATTR_T and MASK_T

; for the print flag the permanent values are odd bits, temporary even bits.

        LD      HL,$5C91        ; address P_FLAG.
        JR      NZ,L0D65        ; skip to TEMPS-2 if lower screen using A=0.

        LD      A,(HL)          ; else pick up flag bits.
        RRCA                    ; rotate permanent bits to temporary bits.

;; TEMPS-2
L0D65:  XOR     (HL)            ;
        AND     $55             ; BIN 01010101
        XOR     (HL)            ; permanent now as original
        LD      (HL),A          ; apply permanent bits to temporary bits.
        RET                     ; and return.

; -----------------
; THE 'CLS' COMMAND 
; -----------------
;    This command clears the display.
;    The routine is also called during initialization and by the CLEAR command.
;    If it's difficult to write it should be difficult to read.

;; CLS
L0D6B:  CALL    L0DAF           ; Routine CL-ALL clears the entire display and
                                ; sets the attributes to the permanent ones
                                ; from ATTR-P.

;   Having cleared all 24 lines of the display area, continue into the 
;   subroutine that clears the lower display area.  Note that at the moment 
;   the attributes for the lower lines are the same as upper ones and have 
;   to be changed to match the BORDER colour.

; --------------------------
; THE 'CLS-LOWER' SUBROUTINE 
; --------------------------
;   This routine is called from INPUT, and from the MAIN execution loop.
;   This is very much a housekeeping routine which clears between 2 and 23
;   lines of the display, setting attributes and correcting situations where
;   errors have occurred while the normal input and output routines have been
;   temporarily diverted to deal with, say colour control codes. 

;; CLS-LOWER
L0D6E:  LD      HL,$5C3C        ; address System Variable TV_FLAG.
        RES     5,(HL)          ; TV_FLAG - signal do not clear lower screen.
        SET     0,(HL)          ; TV_FLAG - signal lower screen in use.

        CALL    L0D4D           ; routine TEMPS applies permanent attributes,
                                ; in this case BORDCR to ATTR_T.
                                ; Note. this seems unnecessary and is repeated 
                                ; within CL-LINE.

        LD      B,(IY+$31)      ; fetch lower screen display file size DF_SZ

        CALL    L0E44           ; routine CL-LINE clears lines to bottom of the
                                ; display and sets attributes from BORDCR while
                                ; preserving the B register.

        LD      HL,$5AC0        ; set initial attribute address to the leftmost 
                                ; cell of second line up.

        LD      A,($5C8D)       ; fetch permanent attribute from ATTR_P.

        DEC     B               ; decrement lower screen display file size.

        JR      L0D8E           ; forward to enter the backfill loop at CLS-3 
                                ; where B is decremented again.

; ---

;   The backfill loop is entered at midpoint and ensures, if more than 2
;   lines have been cleared, that any other lines take the permanent screen
;   attributes.

;; CLS-1
L0D87:  LD      C,$20           ; set counter to 32 character cells per line

;; CLS-2
L0D89:  DEC     HL              ; decrease attribute address.
        LD      (HL),A          ; and place attributes in next line up.
        DEC     C               ; decrease the 32 counter.
        JR      NZ,L0D89        ; loop back to CLS-2 until all 32 cells done.

;; CLS-3
L0D8E:  DJNZ    L0D87           ; decrease B counter and back to CLS-1
                                ; if not zero.

        LD      (IY+$31),$02    ; now set DF_SZ lower screen to 2

; This entry point is also called from CL-ALL below to
; reset the system channel input and output addresses to normal.

;; CL-CHAN
L0D94:  LD      A,$FD           ; select system channel 'K'

        CALL    L1601           ; routine CHAN-OPEN opens it.

        LD      HL,($5C51)      ; fetch CURCHL to HL to address current channel
        LD      DE,L09F4        ; set address to PRINT-OUT for first pass.
        AND     A               ; clear carry for first pass.

;; CL-CHAN-A
L0DA0:  LD      (HL),E          ; Insert the output address on the first pass 
        INC     HL              ; or the input address on the second pass.
        LD      (HL),D          ;
        INC     HL              ;

        LD      DE,L10A8        ; fetch address KEY-INPUT for second pass
        CCF                     ; complement carry flag - will set on pass 1.

        JR      C,L0DA0         ; back to CL-CHAN-A if first pass else done.

        LD      BC,$1721        ; line 23 for lower screen
        JR      L0DD9           ; exit via CL-SET to set column
                                ; for lower display

; ---------------------------
; Clearing whole display area
; ---------------------------
; This subroutine called from CLS, AUTO-LIST and MAIN-3
; clears 24 lines of the display and resets the relevant system variables.
; This routine also recovers from an error situation where, for instance, an 
; invalid colour or position control code has left the output routine addressing
; PO-TV-2 or PO-CONT.

;; CL-ALL
L0DAF:  LD      HL,$0000        ; Initialize plot coordinates.
        LD      ($5C7D),HL      ; Set system variable COORDS to 0,0.

        RES     0,(IY+$30)      ; update FLAGS2  - signal main screen is clear.

        CALL    L0D94           ; routine CL-CHAN makes channel 'K' 'normal'.

        LD      A,$FE           ; select system channel 'S'
        CALL    L1601           ; routine CHAN-OPEN opens it.

        CALL    L0D4D           ; routine TEMPS applies permanent attributes,
                                ; in this case ATTR_P, to ATTR_T. 
                                ; Note. this seems unnecessary.

        LD      B,$18           ; There are 24 lines.

        CALL    L0E44           ; routine CL-LINE clears 24 text lines and sets
                                ; attributes from ATTR-P.
                                ; This routine preserves B and sets C to $21.

        LD      HL,($5C51)      ; fetch CURCHL make HL address output routine.

        LD      DE,L09F4        ; address: PRINT-OUT
        LD      (HL),E          ; is made
        INC     HL              ; the normal
        LD      (HL),D          ; output address.

        LD      (IY+$52),$01    ; set SCR_CT - scroll count - to default.

;   Note. BC already contains $1821.

        LD      BC,$1821        ; reset column and line to 0,0
                                ; and continue into CL-SET, below, exiting
                                ; via PO-STORE (for the upper screen).

; --------------------
; THE 'CL-SET' ROUTINE
; --------------------
; This important subroutine is used to calculate the character output
; address for screens or printer based on the line/column for screens
; or the column for printer.

;; CL-SET
L0DD9:  LD      HL,$5B00        ; the base address of printer buffer
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
        JR      NZ,L0DF4        ; forward to CL-SET-2 if so.

        LD      A,B             ; transfer line to A.
        BIT     0,(IY+$02)      ; test TV_FLAG  - lower screen in use ?
        JR      Z,L0DEE         ; skip to CL-SET-1 if handling upper part

        ADD     A,(IY+$31)      ; add DF_SZ for lower screen
        SUB     $18             ; and adjust.

;; CL-SET-1
L0DEE:  PUSH    BC              ; save the line/column.
        LD      B,A             ; transfer line to B
                                ; (adjusted if lower screen)

        CALL    L0E9B           ; routine CL-ADDR calculates address at left
                                ; of screen.
        POP     BC              ; restore the line/column.

;; CL-SET-2
L0DF4:  LD      A,$21           ; the column $01-$21 is reversed
        SUB     C               ; to range $00 - $20
        LD      E,A             ; now transfer to DE
        LD      D,$00           ; prepare for addition
        ADD     HL,DE           ; and add to base address

        JP      L0ADC           ; exit via PO-STORE to update the relevant
                                ; system variables.
; ----------------
; Handle scrolling
; ----------------
; The routine CL-SC-ALL is called once from PO to scroll all the display
; and from the routine CL-SCROLL, once, to scroll part of the display.

;; CL-SC-ALL
L0DFE:  LD      B,$17           ; scroll 23 lines, after 'scroll?'.

;; CL-SCROLL
L0E00:  CALL    L0E9B           ; routine CL-ADDR gets screen address in HL.
        LD      C,$08           ; there are 8 pixel lines to scroll.

;; CL-SCR-1
L0E05:  PUSH    BC              ; save counters.
        PUSH    HL              ; and initial address.
        LD      A,B             ; get line count.
        AND     $07             ; will set zero if all third to be scrolled.
        LD      A,B             ; re-fetch the line count.
        JR      NZ,L0E19        ; forward to CL-SCR-3 if partial scroll.

; HL points to top line of third and must be copied to bottom of previous 3rd.
; ( so HL = $4800 or $5000 ) ( but also sometimes $4000 )

;; CL-SCR-2
L0E0D:  EX      DE,HL           ; copy HL to DE.
        LD      HL,$F8E0        ; subtract $08 from H and add $E0 to L -
        ADD     HL,DE           ; to make destination bottom line of previous
                                ; third.
        EX      DE,HL           ; restore the source and destination.
        LD      BC,$0020        ; thirty-two bytes are to be copied.
        DEC     A               ; decrement the line count.
        LDIR                    ; copy a pixel line to previous third.

;; CL-SCR-3
L0E19:  EX      DE,HL           ; save source in DE.
        LD      HL,$FFE0        ; load the value -32.
        ADD     HL,DE           ; add to form destination in HL.
        EX      DE,HL           ; switch source and destination
        LD      B,A             ; save the count in B.
        AND     $07             ; mask to find count applicable to current
        RRCA                    ; third and
        RRCA                    ; multiply by
        RRCA                    ; thirty two (same as 5 RLCAs)

        LD      C,A             ; transfer byte count to C ($E0 at most)
        LD      A,B             ; store line count to A
        LD      B,$00           ; make B zero
        LDIR                    ; copy bytes (BC=0, H incremented, L=0)
        LD      B,$07           ; set B to 7, C is zero.
        ADD     HL,BC           ; add 7 to H to address next third.
        AND     $F8             ; has last third been done ?
        JR      NZ,L0E0D        ; back to CL-SCR-2 if not.

        POP     HL              ; restore topmost address.
        INC     H               ; next pixel line down.
        POP     BC              ; restore counts.
        DEC     C               ; reduce pixel line count.
        JR      NZ,L0E05        ; back to CL-SCR-1 if all eight not done.

        CALL    L0E88           ; routine CL-ATTR gets address in attributes
                                ; from current 'ninth line', count in BC.

        LD      HL,$FFE0        ; set HL to the 16-bit value -32.
        ADD     HL,DE           ; and add to form destination address.
        EX      DE,HL           ; swap source and destination addresses.
        LDIR                    ; copy bytes scrolling the linear attributes.
        LD      B,$01           ; continue to clear the bottom line.

; ------------------------------
; THE 'CLEAR TEXT LINES' ROUTINE
; ------------------------------
; This subroutine, called from CL-ALL, CLS-LOWER and AUTO-LIST and above,
; clears text lines at bottom of display.
; The B register holds on entry the number of lines to be cleared 1-24.

;; CL-LINE
L0E44:  PUSH    BC              ; save line count
        CALL    L0E9B           ; routine CL-ADDR gets top address
        LD      C,$08           ; there are eight screen lines to a text line.

;; CL-LINE-1
L0E4A:  PUSH    BC              ; save pixel line count
        PUSH    HL              ; and save the address
        LD      A,B             ; transfer the line to A (1-24).

;; CL-LINE-2
L0E4D:  AND     $07             ; mask 0-7 to consider thirds at a time
        RRCA                    ; multiply
        RRCA                    ; by 32  (same as five RLCA instructions)
        RRCA                    ; now 32 - 256(0)
        LD      C,A             ; store result in C
        LD      A,B             ; save line in A (1-24)
        LD      B,$00           ; set high byte to 0, prepare for ldir.
        DEC     C               ; decrement count 31-255.
        LD      D,H             ; copy HL
        LD      E,L             ; to DE.
        LD      (HL),$00        ; blank the first byte.
        INC     DE              ; make DE point to next byte.
        LDIR                    ; ldir will clear lines.
        LD      DE,$0701        ; now address next third adjusting
        ADD     HL,DE           ; register E to address left hand side
        DEC     A               ; decrease the line count.
        AND     $F8             ; will be 16, 8 or 0  (AND $18 will do).
        LD      B,A             ; transfer count to B.
        JR      NZ,L0E4D        ; back to CL-LINE-2 if 16 or 8 to do
                                ; the next third.

        POP     HL              ; restore start address.
        INC     H               ; address next line down.
        POP     BC              ; fetch counts.
        DEC     C               ; decrement pixel line count
        JR      NZ,L0E4A        ; back to CL-LINE-1 till all done.

        CALL    L0E88           ; routine CL-ATTR gets attribute address
                                ; in DE and B * 32 in BC.

        LD      H,D             ; transfer the address
        LD      L,E             ; to HL.

        INC     DE              ; make DE point to next location.

        LD      A,($5C8D)       ; fetch ATTR_P - permanent attributes
        BIT     0,(IY+$02)      ; test TV_FLAG  - lower screen in use ?
        JR      Z,L0E80         ; skip to CL-LINE-3 if not.

        LD      A,($5C48)       ; else lower screen uses BORDCR as attribute.

;; CL-LINE-3
L0E80:  LD      (HL),A          ; put attribute in first byte.
        DEC     BC              ; decrement the counter.
        LDIR                    ; copy bytes to set all attributes.
        POP     BC              ; restore the line $01-$24.
        LD      C,$21           ; make column $21. (No use is made of this)
        RET                     ; return to the calling routine.

; ------------------
; Attribute handling
; ------------------
; This subroutine is called from CL-LINE or CL-SCROLL with the HL register
; pointing to the 'ninth' line and H needs to be decremented before or after
; the division. Had it been done first then either present code or that used
; at the start of PO-ATTR could have been used.
; The Spectrum screen arrangement leads to the L register already holding 
; the correct value for the attribute file and it is only necessary
; to manipulate H to form the correct colour attribute address.

;; CL-ATTR
L0E88:  LD      A,H             ; fetch H to A - $48, $50, or $58.
        RRCA                    ; divide by
        RRCA                    ; eight.
        RRCA                    ; $09, $0A or $0B.
        DEC     A               ; $08, $09 or $0A.
        OR      $50             ; $58, $59 or $5A.
        LD      H,A             ; save high byte of attributes.

        EX      DE,HL           ; transfer attribute address to DE
        LD      H,C             ; set H to zero - from last LDIR.
        LD      L,B             ; load L with the line from B.
        ADD     HL,HL           ; multiply
        ADD     HL,HL           ; by
        ADD     HL,HL           ; thirty two
        ADD     HL,HL           ; to give count of attribute
        ADD     HL,HL           ; cells to the end of display.

        LD      B,H             ; transfer the result
        LD      C,L             ; to register BC.

        RET                     ; return.

; -------------------------------
; Handle display with line number
; -------------------------------
; This subroutine is called from four places to calculate the address
; of the start of a screen character line which is supplied in B.

;; CL-ADDR
L0E9B:  LD      A,$18           ; reverse the line number
        SUB     B               ; to range $00 - $17.
        LD      D,A             ; save line in D for later.
        RRCA                    ; multiply
        RRCA                    ; by
        RRCA                    ; thirty-two.

        AND     $E0             ; mask off low bits to make
        LD      L,A             ; L a multiple of 32.

        LD      A,D             ; bring back the line to A.

        AND     $18             ; now $00, $08 or $10.

        OR      $40             ; add the base address of screen.

        LD      H,A             ; HL now has the correct address.
        RET                     ; return.

; -------------------
; Handle COPY command
; -------------------
; This command copies the top 176 lines to the ZX Printer
; It is popular to call this from machine code at point
; L0EAF with B holding 192 (and interrupts disabled) for a full-screen
; copy. This particularly applies to 16K Spectrums as time-critical
; machine code routines cannot be written in the first 16K of RAM as
; it is shared with the ULA which has precedence over the Z80 chip.

;; COPY
L0EAC:  DI                      ; disable interrupts as this is time-critical.

        LD      B,$B0           ; top 176 lines.
L0EAF:  LD      HL,$4000        ; address start of the display file.

; now enter a loop to handle each pixel line.

;; COPY-1
L0EB2:  PUSH    HL              ; save the screen address.
        PUSH    BC              ; and the line counter.

        CALL    L0EF4           ; routine COPY-LINE outputs one line.

        POP     BC              ; restore the line counter.
        POP     HL              ; and display address.
        INC     H               ; next line down screen within 'thirds'.
        LD      A,H             ; high byte to A.
        AND     $07             ; result will be zero if we have left third.
        JR      NZ,L0EC9        ; forward to COPY-2 if not to continue loop.

        LD      A,L             ; consider low byte first.
        ADD     A,$20           ; increase by 32 - sets carry if back to zero.
        LD      L,A             ; will be next group of 8.
        CCF                     ; complement - carry set if more lines in
                                ; the previous third.
        SBC     A,A             ; will be FF, if more, else 00.
        AND     $F8             ; will be F8 (-8) or 00.
        ADD     A,H             ; that is subtract 8, if more to do in third.
        LD      H,A             ; and reset address.

;; COPY-2
L0EC9:  DJNZ    L0EB2           ; back to COPY-1 for all lines.

        JR      L0EDA           ; forward to COPY-END to switch off the printer
                                ; motor and enable interrupts.
                                ; Note. Nothing else is required.

; ------------------------------
; Pass printer buffer to printer
; ------------------------------
; This routine is used to copy 8 text lines from the printer buffer
; to the ZX Printer. These text lines are mapped linearly so HL does
; not need to be adjusted at the end of each line.

;; COPY-BUFF
L0ECD:  DI                      ; disable interrupts
        LD      HL,$5B00        ; the base address of the Printer Buffer.
        LD      B,$08           ; set count to 8 lines of 32 bytes.

;; COPY-3
L0ED3:  PUSH    BC              ; save counter.

        CALL    L0EF4           ; routine COPY-LINE outputs 32 bytes

        POP     BC              ; restore counter.
        DJNZ    L0ED3           ; loop back to COPY-3 for all 8 lines.
                                ; then stop motor and clear buffer.

; Note. the COPY command rejoins here, essentially to execute the next
; three instructions.

;; COPY-END
L0EDA:  LD      A,$04           ; output value 4 to port
        OUT     ($FB),A         ; to stop the slowed printer motor.
        EI                      ; enable interrupts.

; --------------------
; Clear Printer Buffer
; --------------------
; This routine clears an arbitrary 256 bytes of memory.
; Note. The routine seems designed to clear a buffer that follows the
; system variables.
; The routine should check a flag or HL address and simply return if COPY
; is in use.
; As a consequence of this omission the buffer will needlessly
; be cleared when COPY is used and the screen/printer position may be set to
; the start of the buffer and the line number to 0 (B)
; giving an 'Out of Screen' error.
; There seems to have been an unsuccessful attempt to circumvent the use
; of PR_CC_hi.

;; CLEAR-PRB
L0EDF:  LD      HL,$5B00        ; the location of the buffer.
        LD      (IY+$46),L      ; update PR_CC_lo - set to zero - superfluous.
        XOR     A               ; clear the accumulator.
        LD      B,A             ; set count to 256 bytes.

;; PRB-BYTES
L0EE7:  LD      (HL),A          ; set addressed location to zero.
        INC     HL              ; address next byte - Note. not INC L.
        DJNZ    L0EE7           ; back to PRB-BYTES. repeat for 256 bytes.

        RES     1,(IY+$30)      ; set FLAGS2 - signal printer buffer is clear.
        LD      C,$21           ; set the column position .
        JP      L0DD9           ; exit via CL-SET and then PO-STORE.

; -----------------
; Copy line routine
; -----------------
; This routine is called from COPY and COPY-BUFF to output a line of
; 32 bytes to the ZX Printer.
; Output to port $FB -
; bit 7 set - activate stylus.
; bit 7 low - deactivate stylus.
; bit 2 set - stops printer.
; bit 2 reset - starts printer
; bit 1 set - slows printer.
; bit 1 reset - normal speed.

;; COPY-LINE
L0EF4:  LD      A,B             ; fetch the counter 1-8 or 1-176
        CP      $03             ; is it 01 or 02 ?.
        SBC     A,A             ; result is $FF if so else $00.
        AND     $02             ; result is 02 now else 00.
                                ; bit 1 set slows the printer.
        OUT     ($FB),A         ; slow the printer for the
                                ; last two lines.
        LD      D,A             ; save the mask to control the printer later.

;; COPY-L-1
L0EFD:  CALL    L1F54           ; call BREAK-KEY to read keyboard immediately.
        JR      C,L0F0C         ; forward to COPY-L-2 if 'break' not pressed.

        LD      A,$04           ; else stop the
        OUT     ($FB),A         ; printer motor.
        EI                      ; enable interrupts.
        CALL    L0EDF           ; call routine CLEAR-PRB.
                                ; Note. should not be cleared if COPY in use.

;; REPORT-Dc
L0F0A:  RST     08H             ; ERROR-1
        DEFB    $0C             ; Error Report: BREAK - CONT repeats

;; COPY-L-2
L0F0C:  IN      A,($FB)         ; test now to see if
        ADD     A,A             ; a printer is attached.
        RET     M               ; return if not - but continue with parent
                                ; command.

        JR      NC,L0EFD        ; back to COPY-L-1 if stylus of printer not
                                ; in position.

        LD      C,$20           ; set count to 32 bytes.

;; COPY-L-3
L0F14:  LD      E,(HL)          ; fetch a byte from line.
        INC     HL              ; address next location. Note. not INC L.
        LD      B,$08           ; count the bits.

;; COPY-L-4
L0F18:  RL      D               ; prepare mask to receive bit.
        RL      E               ; rotate leftmost print bit to carry
        RR      D               ; and back to bit 7 of D restoring bit 1

;; COPY-L-5
L0F1E:  IN      A,($FB)         ; read the port.
        RRA                     ; bit 0 to carry.
        JR      NC,L0F1E        ; back to COPY-L-5 if stylus not in position.

        LD      A,D             ; transfer command bits to A.
        OUT     ($FB),A         ; and output to port.
        DJNZ    L0F18           ; loop back to COPY-L-4 for all 8 bits.

        DEC     C               ; decrease the byte count.
        JR      NZ,L0F14        ; back to COPY-L-3 until 256 bits done.

        RET                     ; return to calling routine COPY/COPY-BUFF.


; ----------------------------------
; Editor routine for BASIC and INPUT
; ----------------------------------
; The editor is called to prepare or edit a BASIC line.
; It is also called from INPUT to input a numeric or string expression.
; The behaviour and options are quite different in the various modes
; and distinguished by bit 5 of FLAGX.
;
; This is a compact and highly versatile routine.

;; EDITOR
L0F2C:  LD      HL,($5C3D)      ; fetch ERR_SP
        PUSH    HL              ; save on stack

;; ED-AGAIN
L0F30:  LD      HL,L107F        ; address: ED-ERROR
        PUSH    HL              ; save address on stack and
        LD      ($5C3D),SP      ; make ERR_SP point to it.

; Note. While in editing/input mode should an error occur then RST 08 will
; update X_PTR to the location reached by CH_ADD and jump to ED-ERROR
; where the error will be cancelled and the loop begin again from ED-AGAIN
; above. The position of the error will be apparent when the lower screen is
; reprinted. If no error then the re-iteration is to ED-LOOP below when
; input is arriving from the keyboard.

;; ED-LOOP
L0F38:  CALL    L15D4           ; routine WAIT-KEY gets key possibly
                                ; changing the mode.
        PUSH    AF              ; save key.
        LD      D,$00           ; and give a short click based
        LD      E,(IY-$01)      ; on PIP value for duration.
        LD      HL,$00C8        ; and pitch.
        CALL    L03B5           ; routine BEEPER gives click - effective
                                ; with rubber keyboard.
        POP     AF              ; get saved key value.
        LD      HL,L0F38        ; address: ED-LOOP is loaded to HL.
        PUSH    HL              ; and pushed onto stack.

; At this point there is a looping return address on the stack, an error
; handler and an input stream set up to supply characters.
; The character that has been received can now be processed.

        CP      $18             ; range 24 to 255 ?
        JR      NC,L0F81        ; forward to ADD-CHAR if so.

        CP      $07             ; lower than 7 ?
        JR      C,L0F81         ; forward to ADD-CHAR also.
                                ; Note. This is a 'bug' and chr$ 6, the comma
                                ; control character, should have had an
                                ; entry in the ED-KEYS table.
                                ; Steven Vickers, 1984, Pitman.

        CP      $10             ; less than 16 ?
        JR      C,L0F92         ; forward to ED-KEYS if editing control
                                ; range 7 to 15 dealt with by a table

        LD      BC,$0002        ; prepare for ink/paper etc.
        LD      D,A             ; save character in D
        CP      $16             ; is it ink/paper/bright etc. ?
        JR      C,L0F6C         ; forward to ED-CONTR if so

                                ; leaves 22d AT and 23d TAB
                                ; which can't be entered via KEY-INPUT.
                                ; so this code is never normally executed
                                ; when the keyboard is used for input.

        INC     BC              ; if it was AT/TAB - 3 locations required
        BIT     7,(IY+$37)      ; test FLAGX  - Is this INPUT LINE ?
        JP      Z,L101E         ; jump to ED-IGNORE if not, else 

        CALL    L15D4           ; routine WAIT-KEY - input address is KEY-NEXT
                                ; but is reset to KEY-INPUT
        LD      E,A             ; save first in E

;; ED-CONTR
L0F6C:  CALL    L15D4           ; routine WAIT-KEY for control.
                                ; input address will be key-next.

        PUSH    DE              ; saved code/parameters
        LD      HL,($5C5B)      ; fetch address of keyboard cursor from K_CUR
        RES     0,(IY+$07)      ; set MODE to 'L'

        CALL    L1655           ; routine MAKE-ROOM makes 2/3 spaces at cursor

        POP     BC              ; restore code/parameters
        INC     HL              ; address first location
        LD      (HL),B          ; place code (ink etc.)
        INC     HL              ; address next
        LD      (HL),C          ; place possible parameter. If only one
                                ; then DE points to this location also.
        JR      L0F8B           ; forward to ADD-CH-1

; ------------------------
; Add code to current line
; ------------------------
; this is the branch used to add normal non-control characters
; with ED-LOOP as the stacked return address.
; it is also the OUTPUT service routine for system channel 'R'.

;; ADD-CHAR
L0F81:  RES     0,(IY+$07)      ; set MODE to 'L'

X0F85:  LD      HL,($5C5B)      ; fetch address of keyboard cursor from K_CUR

        CALL    L1652           ; routine ONE-SPACE creates one space.

; either a continuation of above or from ED-CONTR with ED-LOOP on stack.

;; ADD-CH-1
L0F8B:  LD      (DE),A          ; load current character to last new location.
        INC     DE              ; address next
        LD      ($5C5B),DE      ; and update K_CUR system variable.
        RET                     ; return - either a simple return
                                ; from ADD-CHAR or to ED-LOOP on stack.

; ---

; a branch of the editing loop to deal with control characters
; using a look-up table.

;; ED-KEYS
L0F92:  LD      E,A             ; character to E.
        LD      D,$00           ; prepare to add.
        LD      HL,L0FA0 - 7    ; base address of editing keys table. $0F99
        ADD     HL,DE           ; add E
        LD      E,(HL)          ; fetch offset to E
        ADD     HL,DE           ; add offset for address of handling routine.
        PUSH    HL              ; push the address on machine stack.
        LD      HL,($5C5B)      ; load address of cursor from K_CUR.
        RET                     ; Make an indirect jump forward to routine.

; ------------------
; Editing keys table
; ------------------
; For each code in the range $07 to $0F this table contains a
; single offset byte to the routine that services that code.
; Note. for what was intended there should also have been an
; entry for chr$ 6 with offset to ed-symbol.

;; ed-keys-t
L0FA0:  DEFB    L0FA9 - $  ; 07d offset $09 to Address: ED-EDIT
        DEFB    L1007 - $  ; 08d offset $66 to Address: ED-LEFT
        DEFB    L100C - $  ; 09d offset $6A to Address: ED-RIGHT
        DEFB    L0FF3 - $  ; 10d offset $50 to Address: ED-DOWN
        DEFB    L1059 - $  ; 11d offset $B5 to Address: ED-UP
        DEFB    L1015 - $  ; 12d offset $70 to Address: ED-DELETE
        DEFB    L1024 - $  ; 13d offset $7E to Address: ED-ENTER
        DEFB    L1076 - $  ; 14d offset $CF to Address: ED-SYMBOL
        DEFB    L107C - $  ; 15d offset $D4 to Address: ED-GRAPH

; ---------------
; Handle EDIT key
; ---------------
; The user has pressed SHIFT 1 to bring edit line down to bottom of screen.
; Alternatively the user wishes to clear the input buffer and start again.
; Alternatively ...

;; ED-EDIT
L0FA9:  LD      HL,($5C49)      ; fetch E_PPC the last line number entered.
                                ; Note. may not exist and may follow program.
        BIT     5,(IY+$37)      ; test FLAGX  - input mode ?
        JP      NZ,L1097        ; jump forward to CLEAR-SP if not in editor.

        CALL    L196E           ; routine LINE-ADDR to find address of line
                                ; or following line if it doesn't exist.
        CALL    L1695           ; routine LINE-NO will get line number from
                                ; address or previous line if at end-marker.
        LD      A,D             ; if there is no program then DE will
        OR      E               ; contain zero so test for this.
        JP      Z,L1097         ; jump to CLEAR-SP if so.

; Note. at this point we have a validated line number, not just an
; approximation and it would be best to update E_PPC with the true
; cursor line value which would enable the line cursor to be suppressed
; in all situations - see shortly.

        PUSH    HL              ; save address of line.
        INC     HL              ; address low byte of length.
        LD      C,(HL)          ; transfer to C
        INC     HL              ; next to high byte
        LD      B,(HL)          ; transfer to B.
        LD      HL,$000A        ; an overhead of ten bytes
        ADD     HL,BC           ; is added to length.
        LD      B,H             ; transfer adjusted value
        LD      C,L             ; to BC register.
        CALL    L1F05           ; routine TEST-ROOM checks free memory.
        CALL    L1097           ; routine CLEAR-SP clears editing area.
        LD      HL,($5C51)      ; address CURCHL
        EX      (SP),HL         ; swap with line address on stack
        PUSH    HL              ; save line address underneath

        LD      A,$FF           ; select system channel 'R'
        CALL    L1601           ; routine CHAN-OPEN opens it

        POP     HL              ; drop line address
        DEC     HL              ; make it point to first byte of line num.
        DEC     (IY+$0F)        ; decrease E_PPC_lo to suppress line cursor.
                                ; Note. ineffective when E_PPC is one
                                ; greater than last line of program perhaps
                                ; as a result of a delete.
                                ; credit. Paul Harrison 1982.

        CALL    L1855           ; routine OUT-LINE outputs the BASIC line
                                ; to the editing area.
        INC     (IY+$0F)        ; restore E_PPC_lo to the previous value.
        LD      HL,($5C59)      ; address E_LINE in editing area.
        INC     HL              ; advance
        INC     HL              ; past space
        INC     HL              ; and digit characters
        INC     HL              ; of line number.

        LD      ($5C5B),HL      ; update K_CUR to address start of BASIC.
        POP     HL              ; restore the address of CURCHL.
        CALL    L1615           ; routine CHAN-FLAG sets flags for it.

        RET                     ; RETURN to ED-LOOP.

; -------------------
; Cursor down editing
; -------------------
;   The BASIC lines are displayed at the top of the screen and the user
;   wishes to move the cursor down one line in edit mode.
;   With INPUT LINE, this key must be used instead of entering STOP.

;; ED-DOWN
L0FF3:  BIT     5,(IY+$37)      ; test FLAGX  - Input Mode ?
        JR      NZ,L1001        ; skip to ED-STOP if so

        LD      HL,$5C49        ; address E_PPC - 'current line'
        CALL    L190F           ; routine LN-FETCH fetches number of next
                                ; line or same if at end of program.
        JR      L106E           ; forward to ED-LIST to produce an
                                ; automatic listing.

; ---

;; ED-STOP
L1001:  LD      (IY+$00),$10    ; set ERR_NR to 'STOP in INPUT' code
        JR      L1024           ; forward to ED-ENTER to produce error.

; -------------------
; Cursor left editing
; -------------------
; This acts on the cursor in the lower section of the screen in both
; editing and input mode.

;; ED-LEFT
L1007:  CALL    L1031           ; routine ED-EDGE moves left if possible
        JR      L1011           ; forward to ED-CUR to update K-CUR
                                ; and return to ED-LOOP.

; --------------------
; Cursor right editing
; --------------------
; This acts on the cursor in the lower screen in both editing and input
; mode and moves it to the right.

;; ED-RIGHT
L100C:  LD      A,(HL)          ; fetch addressed character.
        CP      $0D             ; is it carriage return ?
        RET     Z               ; return if so to ED-LOOP

        INC     HL              ; address next character

;; ED-CUR
L1011:  LD      ($5C5B),HL      ; update K_CUR system variable
        RET                     ; return to ED-LOOP

; --------------
; DELETE editing
; --------------
; This acts on the lower screen and deletes the character to left of
; cursor. If control characters are present these are deleted first
; leaving the naked parameter (0-7) which appears as a '?' except in the
; case of chr$ 6 which is the comma control character. It is not mandatory
; to delete these second characters.

;; ED-DELETE
L1015:  CALL    L1031           ; routine ED-EDGE moves cursor to left.
        LD      BC,$0001        ; of character to be deleted.
        JP      L19E8           ; to RECLAIM-2 reclaim the character.

; ------------------------------------------
; Ignore next 2 codes from key-input routine
; ------------------------------------------
; Since AT and TAB cannot be entered this point is never reached
; from the keyboard. If inputting from a tape device or network then
; the control and two following characters are ignored and processing
; continues as if a carriage return had been received.
; Here, perhaps, another Spectrum has said print #15; AT 0,0; "This is yellow"
; and this one is interpreting input #15; a$.

;; ED-IGNORE
L101E:  CALL    L15D4           ; routine WAIT-KEY to ignore keystroke.
        CALL    L15D4           ; routine WAIT-KEY to ignore next key.

; -------------
; Enter/newline
; -------------
; The enter key has been pressed to have BASIC line or input accepted.

;; ED-ENTER
L1024:  POP     HL              ; discard address ED-LOOP
        POP     HL              ; drop address ED-ERROR

;; ED-END
L1026:  POP     HL              ; the previous value of ERR_SP
        LD      ($5C3D),HL      ; is restored to ERR_SP system variable
        BIT     7,(IY+$00)      ; is ERR_NR $FF (= 'OK') ?
        RET     NZ              ; return if so

        LD      SP,HL           ; else put error routine on stack
        RET                     ; and make an indirect jump to it.

; -----------------------------
; Move cursor left when editing
; -----------------------------
; This routine moves the cursor left. The complication is that it must
; not position the cursor between control codes and their parameters.
; It is further complicated in that it deals with TAB and AT characters
; which are never present from the keyboard.
; The method is to advance from the beginning of the line each time,
; jumping one, two, or three characters as necessary saving the original
; position at each jump in DE. Once it arrives at the cursor then the next
; legitimate leftmost position is in DE.

;; ED-EDGE
L1031:  SCF                     ; carry flag must be set to call the nested
        CALL    L1195           ; subroutine SET-DE.
                                ; if input   then DE=WORKSP
                                ; if editing then DE=E_LINE
        SBC     HL,DE           ; subtract address from start of line
        ADD     HL,DE           ; and add back.
        INC     HL              ; adjust for carry.
        POP     BC              ; drop return address
        RET     C               ; return to ED-LOOP if already at left
                                ; of line.

        PUSH    BC              ; resave return address - ED-LOOP.
        LD      B,H             ; transfer HL - cursor address
        LD      C,L             ; to BC register pair.
                                ; at this point DE addresses start of line.

;; ED-EDGE-1
L103E:  LD      H,D             ; transfer DE - leftmost pointer
        LD      L,E             ; to HL
        INC     HL              ; address next leftmost character to
                                ; advance position each time.
        LD      A,(DE)          ; pick up previous in A
        AND     $F0             ; lose the low bits
        CP      $10             ; is it INK to TAB $10-$1F ?
                                ; that is, is it followed by a parameter ?
        JR      NZ,L1051        ; to ED-EDGE-2 if not
                                ; HL has been incremented once

        INC     HL              ; address next as at least one parameter.

; in fact since 'tab' and 'at' cannot be entered the next section seems
; superfluous.
; The test will always fail and the jump to ED-EDGE-2 will be taken.

        LD      A,(DE)          ; reload leftmost character
        SUB     $17             ; decimal 23 ('tab')
        ADC     A,$00           ; will be 0 for 'tab' and 'at'.
        JR      NZ,L1051        ; forward to ED-EDGE-2 if not
                                ; HL has been incremented twice

        INC     HL              ; increment a third time for 'at'/'tab'

;; ED-EDGE-2
L1051:  AND     A               ; prepare for true subtraction
        SBC     HL,BC           ; subtract cursor address from pointer
        ADD     HL,BC           ; and add back
                                ; Note when HL matches the cursor position BC,
                                ; there is no carry and the previous
                                ; position is in DE.
        EX      DE,HL           ; transfer result to DE if looping again.
                                ; transfer DE to HL to be used as K-CUR
                                ; if exiting loop.
        JR      C,L103E         ; back to ED-EDGE-1 if cursor not matched.

        RET                     ; return.

; -----------------
; Cursor up editing
; -----------------
; The main screen displays part of the BASIC program and the user wishes
; to move up one line scrolling if necessary.
; This has no alternative use in input mode.

;; ED-UP
L1059:  BIT     5,(IY+$37)      ; test FLAGX  - input mode ?
        RET     NZ              ; return if not in editor - to ED-LOOP.

        LD      HL,($5C49)      ; get current line from E_PPC
        CALL    L196E           ; routine LINE-ADDR gets address
        EX      DE,HL           ; and previous in DE
        CALL    L1695           ; routine LINE-NO gets prev line number
        LD      HL,$5C4A        ; set HL to E_PPC_hi as next routine stores
                                ; top first.
        CALL    L191C           ; routine LN-STORE loads DE value to HL
                                ; high byte first - E_PPC_lo takes E

; this branch is also taken from ed-down.

;; ED-LIST
L106E:  CALL    L1795           ; routine AUTO-LIST lists to upper screen
                                ; including adjusted current line.
        LD      A,$00           ; select lower screen again
        JP      L1601           ; exit via CHAN-OPEN to ED-LOOP

; --------------------------------
; Use of symbol and graphics codes
; --------------------------------
; These will not be encountered with the keyboard but would be handled
; otherwise as follows.
; As noted earlier, Vickers says there should have been an entry in
; the KEYS table for chr$ 6 which also pointed here.
; If, for simplicity, two Spectrums were both using #15 as a bi-directional
; channel connected to each other:-
; then when the other Spectrum has said PRINT #15; x, y
; input #15; i ; j  would treat the comma control as a newline and the
; control would skip to input j.
; You can get round the missing chr$ 6 handler by sending multiple print
; items separated by a newline '.

; chr$14 would have the same functionality.

; This is chr$ 14.
;; ED-SYMBOL
L1076:  BIT     7,(IY+$37)      ; test FLAGX - is this INPUT LINE ?
        JR      Z,L1024         ; back to ED-ENTER if not to treat as if
                                ; enter had been pressed.
                                ; else continue and add code to buffer.

; Next is chr$ 15
; Note that ADD-CHAR precedes the table so we can't offset to it directly.

;; ED-GRAPH
L107C:  JP      L0F81           ; jump back to ADD-CHAR

; --------------------
; Editor error routine
; --------------------
; If an error occurs while editing, or inputting, then ERR_SP
; points to the stack location holding address ED_ERROR.

;; ED-ERROR
L107F:  BIT     4,(IY+$30)      ; test FLAGS2  - is K channel in use ?
        JR      Z,L1026         ; back to ED-END if not.

; but as long as we're editing lines or inputting from the keyboard, then
; we've run out of memory so give a short rasp.

        LD      (IY+$00),$FF    ; reset ERR_NR to 'OK'.
        LD      D,$00           ; prepare for beeper.
        LD      E,(IY-$02)      ; use RASP value.
        LD      HL,$1A90        ; set the pitch - or tone period.
        CALL    L03B5           ; routine BEEPER emits a warning rasp.
        JP      L0F30           ; to ED-AGAIN to re-stack address of
                                ; this routine and make ERR_SP point to it.

; ---------------------
; Clear edit/work space
; ---------------------
; The editing area or workspace is cleared depending on context.
; This is called from ED-EDIT to clear workspace if edit key is
; used during input, to clear editing area if no program exists
; and to clear editing area prior to copying the edit line to it.
; It is also used by the error routine to clear the respective
; area depending on FLAGX.

;; CLEAR-SP
L1097:  PUSH    HL              ; preserve HL
        CALL    L1190           ; routine SET-HL
                                ; if in edit   HL = WORKSP-1, DE = E_LINE
                                ; if in input  HL = STKBOT,   DE = WORKSP
        DEC     HL              ; adjust
        CALL    L19E5           ; routine RECLAIM-1 reclaims space
        LD      ($5C5B),HL      ; set K_CUR to start of empty area
        LD      (IY+$07),$00    ; set MODE to 'KLC'
        POP     HL              ; restore HL.
        RET                     ; return.

; ----------------------------
; THE 'KEYBOARD INPUT' ROUTINE
; ----------------------------
; This is the service routine for the input stream of the keyboard channel 'K'.

;; KEY-INPUT
L10A8:  BIT     3,(IY+$02)      ; test TV_FLAG  - has a key been pressed in
                                ; editor ?

        CALL    NZ,L111D        ; routine ED-COPY, if so, to reprint the lower
                                ; screen at every keystroke/mode change.

        AND     A               ; clear carry flag - required exit condition.

        BIT     5,(IY+$01)      ; test FLAGS  - has a new key been pressed ?
        RET     Z               ; return if not.                        >>

        LD      A,($5C08)       ; system variable LASTK will hold last key -
                                ; from the interrupt routine.

        RES     5,(IY+$01)      ; update FLAGS  - reset the new key flag.
        PUSH    AF              ; save the input character.

        BIT     5,(IY+$02)      ; test TV_FLAG  - clear lower screen ?

        CALL    NZ,L0D6E        ; routine CLS-LOWER if so.

        POP     AF              ; restore the character code.

        CP      $20             ; if space or higher then
        JR      NC,L111B        ; forward to KEY-DONE2 and return with carry
                                ; set to signal key-found.

        CP      $10             ; with 16d INK and higher skip
        JR      NC,L10FA        ; forward to KEY-CONTR.

        CP      $06             ; for 6 - 15d
        JR      NC,L10DB        ; skip forward to KEY-M-CL to handle Modes
                                ; and CapsLock.

; that only leaves 0-5, the flash bright inverse switches.

        LD      B,A             ; save character in B
        AND     $01             ; isolate the embedded parameter (0/1).
        LD      C,A             ; and store in C
        LD      A,B             ; re-fetch copy (0-5)
        RRA                     ; halve it 0, 1 or 2.
        ADD     A,$12           ; add 18d gives 'flash', 'bright'
                                ; and 'inverse'.
        JR      L1105           ; forward to KEY-DATA with the 
                                ; parameter (0/1) in C.

; ---

; Now separate capslock 06 from modes 7-15.

;; KEY-M-CL
L10DB:  JR      NZ,L10E6        ; forward to KEY-MODE if not 06 (capslock)

        LD      HL,$5C6A        ; point to FLAGS2
        LD      A,$08           ; value 00001000
        XOR     (HL)            ; toggle BIT 3 of FLAGS2 the capslock bit
        LD      (HL),A          ; and store result in FLAGS2 again.
        JR      L10F4           ; forward to KEY-FLAG to signal no-key.

; ---

;; KEY-MODE
L10E6:  CP      $0E             ; compare with chr 14d
        RET     C               ; return with carry set "key found" for
                                ; codes 7 - 13d leaving 14d and 15d
                                ; which are converted to mode codes.

        SUB     $0D             ; subtract 13d leaving 1 and 2
                                ; 1 is 'E' mode, 2 is 'G' mode.
        LD      HL,$5C41        ; address the MODE system variable.
        CP      (HL)            ; compare with existing value before
        LD      (HL),A          ; inserting the new value.
        JR      NZ,L10F4        ; forward to KEY-FLAG if it has changed.

        LD      (HL),$00        ; else make MODE zero - KLC mode
                                ; Note. while in Extended/Graphics mode,
                                ; the Extended Mode/Graphics key is pressed
                                ; again to get out.

;; KEY-FLAG
L10F4:  SET     3,(IY+$02)      ; update TV_FLAG  - show key state has changed
        CP      A               ; clear carry and reset zero flags -
                                ; no actual key returned.
        RET                     ; make the return.

; ---

; now deal with colour controls - 16-23 ink, 24-31 paper

;; KEY-CONTR
L10FA:  LD      B,A             ; make a copy of character.
        AND     $07             ; mask to leave bits 0-7
        LD      C,A             ; and store in C.
        LD      A,$10           ; initialize to 16d - INK.
        BIT     3,B             ; was it paper ?
        JR      NZ,L1105        ; forward to KEY-DATA with INK 16d and
                                ; colour in C.

        INC     A               ; else change from INK to PAPER (17d) if so.

;; KEY-DATA
L1105:  LD      (IY-$2D),C      ; put the colour (0-7)/state(0/1) in KDATA
        LD      DE,L110D        ; address: KEY-NEXT will be next input stream
        JR      L1113           ; forward to KEY-CHAN to change it ...

; ---

; ... so that INPUT_AD directs control to here at next call to WAIT-KEY

;; KEY-NEXT
L110D:  LD      A,($5C0D)       ; pick up the parameter stored in KDATA.
        LD      DE,L10A8        ; address: KEY-INPUT will be next input stream
                                ; continue to restore default channel and
                                ; make a return with the control code.

;; KEY-CHAN
L1113:  LD      HL,($5C4F)      ; address start of CHANNELS area using CHANS
                                ; system variable.
                                ; Note. One might have expected CURCHL to
                                ; have been used.
        INC     HL              ; step over the
        INC     HL              ; output address
        LD      (HL),E          ; and update the input
        INC     HL              ; routine address for
        LD      (HL),D          ; the next call to WAIT-KEY.

;; KEY-DONE2
L111B:  SCF                     ; set carry flag to show a key has been found
        RET                     ; and return.

; --------------------
; Lower screen copying
; --------------------
; This subroutine is called whenever the line in the editing area or
; input workspace is required to be printed to the lower screen.
; It is by calling this routine after any change that the cursor, for
; instance, appears to move to the left.
; Remember the edit line will contain characters and tokens
; e.g. "1000 LET a=1" is 8 characters.

;; ED-COPY
L111D:  CALL    L0D4D           ; routine TEMPS sets temporary attributes.
        RES     3,(IY+$02)      ; update TV_FLAG  - signal no change in mode
        RES     5,(IY+$02)      ; update TV_FLAG  - signal don't clear lower
                                ; screen.
        LD      HL,($5C8A)      ; fetch SPOSNL
        PUSH    HL              ; and save on stack.

        LD      HL,($5C3D)      ; fetch ERR_SP
        PUSH    HL              ; and save also
        LD      HL,L1167        ; address: ED-FULL
        PUSH    HL              ; is pushed as the error routine
        LD      ($5C3D),SP      ; and ERR_SP made to point to it.

        LD      HL,($5C82)      ; fetch ECHO_E
        PUSH    HL              ; and push also

        SCF                     ; set carry flag to control SET-DE
        CALL    L1195           ; call routine SET-DE
                                ; if in input DE = WORKSP
                                ; if in edit  DE = E_LINE
        EX      DE,HL           ; start address to HL

        CALL    L187D           ; routine OUT-LINE2 outputs entire line up to
                                ; carriage return including initial
                                ; characterized line number when present.
        EX      DE,HL           ; transfer new address to DE
        CALL    L18E1           ; routine OUT-CURS considers a
                                ; terminating cursor.

        LD      HL,($5C8A)      ; fetch updated SPOSNL
        EX      (SP),HL         ; exchange with ECHO_E on stack
        EX      DE,HL           ; transfer ECHO_E to DE
        CALL    L0D4D           ; routine TEMPS to re-set attributes
                                ; if altered.

; the lower screen was not cleared, at the outset, so if deleting then old
; text from a previous print may follow this line and requires blanking.

;; ED-BLANK
L1150:  LD      A,($5C8B)       ; fetch SPOSNL_hi is current line
        SUB     D               ; compare with old
        JR      C,L117C         ; forward to ED-C-DONE if no blanking

        JR      NZ,L115E        ; forward to ED-SPACES if line has changed

        LD      A,E             ; old column to A
        SUB     (IY+$50)        ; subtract new in SPOSNL_lo
        JR      NC,L117C        ; forward to ED-C-DONE if no backfilling.

;; ED-SPACES
L115E:  LD      A,$20           ; prepare a space.
        PUSH    DE              ; save old line/column.
        CALL    L09F4           ; routine PRINT-OUT prints a space over
                                ; any text from previous print.
                                ; Note. Since the blanking only occurs when
                                ; using $09F4 to print to the lower screen,
                                ; there is no need to vector via a RST 10
                                ; and we can use this alternate set.
        POP     DE              ; restore the old line column.
        JR      L1150           ; back to ED-BLANK until all old text blanked.

; -------------------------------
; THE 'EDITOR-FULL' ERROR ROUTINE
; -------------------------------
;   This is the error routine addressed by ERR_SP.  This is not for the out of
;   memory situation as we're just printing.  The pitch and duration are exactly
;   the same as used by ED-ERROR from which this has been augmented.  The
;   situation is that the lower screen is full and a rasp is given to suggest
;   that this is perhaps not the best idea you've had that day.

;; ED-FULL
L1167:  LD      D,$00           ; prepare to moan.
        LD      E,(IY-$02)      ; fetch RASP value.
        LD      HL,$1A90        ; set pitch or tone period.

        CALL    L03B5           ; routine BEEPER.

        LD      (IY+$00),$FF    ; clear ERR_NR.
        LD      DE,($5C8A)      ; fetch SPOSNL.
        JR      L117E           ; forward to ED-C-END

; -------

; the exit point from line printing continues here.

;; ED-C-DONE
L117C:  POP     DE              ; fetch new line/column.
        POP     HL              ; fetch the error address.

; the error path rejoins here.

;; ED-C-END
L117E:  POP     HL              ; restore the old value of ERR_SP.
        LD      ($5C3D),HL      ; update the system variable ERR_SP

        POP     BC              ; old value of SPOSN_L
        PUSH    DE              ; save new value

        CALL    L0DD9           ; routine CL-SET and PO-STORE
                                ; update ECHO_E and SPOSN_L from BC

        POP     HL              ; restore new value
        LD      ($5C82),HL      ; and overwrite ECHO_E

        LD      (IY+$26),$00    ; make error pointer X_PTR_hi out of bounds

        RET                     ; return

; -----------------------------------------------
; Point to first and last locations of work space
; -----------------------------------------------
;   These two nested routines ensure that the appropriate pointers are
;   selected for the editing area or workspace. The routines that call
;   these routines are designed to work on either area.

; this routine is called once

;; SET-HL
L1190:  LD      HL,($5C61)      ; fetch WORKSP to HL.
        DEC     HL              ; point to last location of editing area.
        AND     A               ; clear carry to limit exit points to first
                                ; or last.

; this routine is called with carry set and exits at a conditional return.

;; SET-DE
L1195:  LD      DE,($5C59)      ; fetch E_LINE to DE
        BIT     5,(IY+$37)      ; test FLAGX  - Input Mode ?
        RET     Z               ; return now if in editing mode

        LD      DE,($5C61)      ; fetch WORKSP to DE
        RET     C               ; return if carry set ( entry = set-de)

        LD      HL,($5C63)      ; fetch STKBOT to HL as well
        RET                     ; and return  (entry = set-hl (in input))

; -----------------------------------
; THE 'REMOVE FLOATING POINT' ROUTINE
; -----------------------------------
;   When a BASIC LINE or the INPUT BUFFER is parsed any numbers will have
;   an invisible chr 14d inserted after them and the 5-byte integer or
;   floating point form inserted after that.  Similar invisible value holders
;   are also created after the numeric and string variables in a DEF FN list.
;   This routine removes these 'compiled' numbers from the edit line or
;   input workspace.

;; REMOVE-FP
L11A7:  LD      A,(HL)          ; fetch character
        CP      $0E             ; is it the CHR$ 14 number marker ?
        LD      BC,$0006        ; prepare to strip six bytes

        CALL    Z,L19E8         ; routine RECLAIM-2 reclaims bytes if CHR$ 14.

        LD      A,(HL)          ; reload next (or same) character
        INC     HL              ; and advance address
        CP      $0D             ; end of line or input buffer ?
        JR      NZ,L11A7        ; back to REMOVE-FP until entire line done.

        RET                     ; return.


; *********************************
; ** Part 6. EXECUTIVE ROUTINES  **
; *********************************


; The memory.
;
; +---------+-----------+------------+--------------+-------------+--
; | BASIC   |  Display  | Attributes | ZX Printer   |    System   | 
; |  ROM    |   File    |    File    |   Buffer     |  Variables  | 
; +---------+-----------+------------+--------------+-------------+--
; ^         ^           ^            ^              ^             ^
; $0000   $4000       $5800        $5B00          $5C00         $5CB6 = CHANS 
;
;
;  --+----------+---+---------+-----------+---+------------+--+---+--
;    | Channel  |$80|  BASIC  | Variables |$80| Edit Line  |NL|$80|
;    |   Info   |   | Program |   Area    |   | or Command |  |   |
;  --+----------+---+---------+-----------+---+------------+--+---+--
;    ^              ^         ^               ^                   ^
;  CHANS           PROG      VARS           E_LINE              WORKSP
;
;
;                             ---5-->         <---2---  <--3---
;  --+-------+--+------------+-------+-------+---------+-------+-+---+------+
;    | INPUT |NL| Temporary  | Calc. | Spare | Machine | GOSUB |?|$3E| UDGs |
;    | data  |  | Work Space | Stack |       |  Stack  | Stack | |   |      |
;  --+-------+--+------------+-------+-------+---------+-------+-+---+------+
;    ^                       ^       ^       ^                   ^   ^      ^
;  WORKSP                  STKBOT  STKEND   sp               RAMTOP UDG  P_RAMT
;                                                                         

; -----------------
; THE 'NEW' COMMAND
; -----------------
;   The NEW command is about to set all RAM below RAMTOP to zero and then
;   re-initialize the system.  All RAM above RAMTOP should, and will be,
;   preserved.
;   There is nowhere to store values in RAM or on the stack which becomes
;   inoperable. Similarly PUSH and CALL instructions cannot be used to store
;   values or section common code. The alternate register set is the only place
;   available to store 3 persistent 16-bit system variables.

;; NEW
L11B7:  DI                      ; Disable Interrupts - machine stack will be
                                ; cleared.
        LD      hl, ($5cb2)     ; Fetch RAMTOP as top value.
        EXX                     ; Switch in alternate set.
        LD      BC,($5CB4)      ; Fetch P-RAMT differs on 16K/48K machines.
        LD      DE,($5C38)      ; Fetch RASP/PIP.
        LD      HL,($5C7B)      ; Fetch UDG    differs on 16K/48K machines.
        EXX                     ; Switch back to main set and continue into...

; ----------------------
; THE 'START-NEW' BRANCH     
; ----------------------
;   This branch is taken from above and from RST 00h.
;   The common code tests RAM and sets it to zero re-initializing all the 
;   non-zero system variables and channel information.  The A register flags 
;   if coming from START or NEW.

;; START-NEW
L11C8:  ex      af, af'         ; Save the flag to control later branching.

        ld      a, $3f          ; select a white border
        OUT     ($FE),A         ; and set it now by writing to a port.

        LD      I,A             ; Set the I register - this remains constant
                                ; and can't be in the range $40 - $7F as 'snow'
                                ; appears on the screen.

; -----------------------
; THE 'RAM CHECK' SECTION
; -----------------------
;   Typically, a Spectrum will have 16K or 48K of RAM and this code will test
;   it all till it finds an unpopulated location or, less likely, a faulty 
;   location.  Usually it stops when it reaches the top $FFFF, or in the case 
;   of NEW the supplied top value.  The entire screen turns black with 
;   sometimes red stripes on black paper just visible.

;; ram-check
;; RAM-FILL
L11CF:  ld      (hl), $01       ; Load memory with $01 - blue ink on black paper.
        DEC     HL              ; Decrement memory address.
        CP      H               ; Have we reached ROM - $3F ?
        JR      NZ,L11CF        ; Back to RAM-FILL if not.

;; RAM-READ
L11D5:  INC     HL              ; and increment for next iteration.

        DEC     (HL)            ; decrement to zero.
        JR      Z,L11D5         ; back to RAM-READ if zero flag was set.

;; RAM-DONE
        DEC     HL              ; step back to last valid location.
        ld      b, (hl)         ; B=0
        EXX                     ; regardless of state, set up possibly
                                ; stored system variables in case from NEW.
        LD      ($5CB4),BC      ; insert P-RAMT.
        LD      ($5C38),DE      ; insert RASP/PIP.
        LD      ($5C7B),HL      ; insert UDG.
        EXX                     ; switch in main set.
        ex      af, af'         ; now test if we arrived here from NEW.
        LD      DE,$3EAF        ; address of last byte of 'U' bitmap in ROM.
        JR      NZ,L1201        ; forward to RAM-SET if we did.

;   This section applies to START only.

        LD      ($5CB4),HL      ; set P-RAMT to the highest working RAM
                                ; address.
        ld      c, $a7          ; there are 21 user defined graphics.
        EX      DE,HL           ; switch pointers and make the UDGs a
        LDDR                    ; copy of the standard characters A - U.
        EX      DE,HL           ; switch the pointer to HL.

        LD      ($5C7B),HL      ; make UDG system variable address the first
                                ; bitmap.
        DEC     HL              ; point at RAMTOP again.

        ld      c, $40          ; set the values of
        LD      ($5C38),BC      ; the PIP and RASP system variables.

;   The NEW command path rejoins here.

;; RAM-SET
L1201:  LD      ($5CB2),HL      ; set system variable RAMTOP to HL.

;   
;   Note. this entry point is a disabled Warm Restart that was almost certainly
;   once pointed to by the System Variable NMIADD.  It would be essential that
;   any NMI Handler would perform the tasks from here to the EI instruction 
;   below.

;; NMI_VECT
        ld      (hl), d         ; top of user ram holds GOSUB end marker
                                ; an impossible line number - see RETURN.
                                ; no significance in the number $3E. It has
                                ; been traditional since the ZX80.

        DEC     HL              ; followed by empty byte (not important).
        LD      SP,HL           ; set up the machine stack pointer.
        DEC     HL              ;
        DEC     HL              ;
        LD      ($5C3D),HL      ; ERR_SP is where the error pointer is
                                ; at moment empty - will take address MAIN-4
                                ; at the call preceding that address,
                                ; although interrupts and calls will make use
                                ; of this location in meantime.

        IM      1               ; select interrupt mode 1.

        LD      IY,$5C3A        ; set IY to ERR_NR. IY can reach all standard
                                ; system variables but shadow ROM system
                                ; variables will be mostly out of range.

        EI                      ; enable interrupts now that we have a stack.

;   If, as suggested above, the NMI service routine pointed to this section of
;   code then a decision would have to be made at this point to jump forward, 
;   in a Warm Restart scenario, to produce a report code, leaving any program 
;   intact.

        ld      (iy-3), $3c     ; The address of the channels - initially
                                ; following system variables.
        ld      hl, $5cb6        ; The address of the channels - initially
                                ; following system variables.
        LD      ($5C4F),HL      ; Set the CHANS system variable.

        LD      DE,L15AF        ; Address: init-chan in ROM.
        ld      c, d            ; There are 21 bytes of initial data in ROM.
        EX      DE,HL           ; swap the pointers.
        LDIR                    ; Copy the bytes to RAM.

        ld      e, $0e          ; set destination to system variable STRMS-FD
        ld      c, $10          ; copy the 14 bytes of initial 7 streams data
        ldir                    ; from ROM to RAM.

        LD      HL,$0523        ; The keyboard repeat and delay values are 
        ld      c, h
        ld      (iy+$31), c     ; set DF_SZ the lower screen display size to

        LD      ($5C09),HL      ; loaded to REPDEL and REPPER.

        ld      hl, $5cca
        LD      ($5C57),HL      ; Set DATADD to location before program area.
        INC     L               ; Increment again.
        LD      ($5C53),HL      ; Set PROG the location where BASIC starts.
        LD      ($5C4B),HL      ; Set VARS to same location with a
        LD      (HL),$80        ; put $80 marker at (HL)
        INC     L               ; Increment again.
        LD      ($5C59),HL      ; Set E_LINE, where the edit line
                                ; will be created.
                                ; Note. it is not strictly necessary to
                                ; execute the next fifteen bytes of code
                                ; as this will be done by the call to SET-MIN.
                                ; --

        ld      de, L129D
        ex      de, hl
        ldir
        ex      de, hl

        LD      ($5C61),HL      ; set WORKSP - empty workspace.
        LD      ($5C63),HL      ; set STKBOT - bottom of the empty stack.
        LD      ($5C65),HL      ; set STKEND to the end of the empty stack.
                                ; --
        LD      A,$38           ; the colour system is set to white paper,
                                ; black ink, no flash or bright.
        LD      ($5C8D),A       ; set ATTR_P permanent colour attributes.
        LD      ($5C48),A       ; set BORDCR the border colour/lower screen
                                ; attributes.

        DEC     (IY-$3A)        ; set KSTATE-0 to $FF - keyboard map available.
        DEC     (IY-$36)        ; set KSTATE-4 to $FF - keyboard map available.

        call    L164D           ; update FLAGS  - signal printer in use.
        call    L0EDF           ; call routine CLEAR-PRB to initialize system
                                ; variables associated with printer.
                                ; The buffer is clear.
        ld      (iy+$01), $8c   ; update FLAGS again

        CALL    L0D6B           ; call routine CLS to set up system
                                ; variables associated with screen and clear
                                ; the screen and set attributes.
        LD      DE,L1539 - 1    ; the message table directly.
        CALL    L0C0A           ; routine PO-MSG puts
                                ; ' ©  1982 Sinclair Research Ltd'
                                ; at bottom of display.
        call    L0308+3         ; update TV_FLAG  - signal lower screen will
                                ; require clearing.

        JR      L1303-11        ; jump to one instruction before MAIN-4

        DEFM    'Reset&Play, Antonio Villena 2012'; 32 bytes

L129D:  DEFB    $EF, $22, $22, $0D, $80; LOAD "" + Enter + $80

; -------------------------
; THE 'MAIN EXECUTION LOOP'
; -------------------------
;
;

;; MAIN-EXEC
L12A2:  LD      (IY+$31),$02    ; set DF_SZ lower screen display file size to 
                                ; two lines.
        CALL    L1795           ; routine AUTO-LIST

;; MAIN-1
L12A9:  CALL    L16B0           ; routine SET-MIN clears work areas.

;; MAIN-2
L12AC:  LD      A,$00           ; select channel 'K' the keyboard

        CALL    L1601           ; routine CHAN-OPEN opens it

        CALL    L0F2C           ; routine EDITOR is called.
                                ; Note the above routine is where the Spectrum
                                ; waits for user-interaction. Perhaps the
                                ; most common input at this stage
                                ; is LOAD "".

        CALL    L1B17           ; routine LINE-SCAN scans the input.

        BIT     7,(IY+$00)      ; test ERR_NR - will be $FF if syntax is OK.
        JR      NZ,L12CF        ; forward, if correct, to MAIN-3.

; 

        BIT     4,(IY+$30)      ; test FLAGS2 - K channel in use ?
        JR      Z,L1303         ; forward to MAIN-4 if not.

;

        LD      HL,($5C59)      ; an editing error so address E_LINE.
        CALL    L11A7           ; routine REMOVE-FP removes the hidden
                                ; floating-point forms.
        LD      (IY+$00),$FF    ; system variable ERR_NR is reset to 'OK'.
        JR      L12AC           ; back to MAIN-2 to allow user to correct.

; ---

; the branch was here if syntax has passed test.

;; MAIN-3
L12CF:  LD      HL,($5C59)      ; fetch the edit line address from E_LINE.

        LD      ($5C5D),HL      ; system variable CH_ADD is set to first
                                ; character of edit line.
                                ; Note. the above two instructions are a little
                                ; inadequate. 
                                ; They are repeated with a subtle difference 
                                ; at the start of the next subroutine and are 
                                ; therefore not required above.

        CALL    L19FB           ; routine E-LINE-NO will fetch any line
                                ; number to BC if this is a program line.

        LD      A,B             ; test if the number of
        OR      C               ; the line is non-zero.
        JP      NZ,L155D        ; jump forward to MAIN-ADD if so to add the 
                                ; line to the BASIC program.

; Has the user just pressed the ENTER key ?

        RST     18H             ; GET-CHAR gets character addressed by CH_ADD.
        CP      $0D             ; is it a carriage return ?
        JR      Z,L12A2         ; back to MAIN-EXEC if so for an automatic
                                ; listing.

; this must be a direct command.

        BIT     0,(IY+$30)      ; test FLAGS2 - clear the main screen ?

        CALL    NZ,L0DAF        ; routine CL-ALL, if so, e.g. after listing.

        CALL    L0D6E           ; routine CLS-LOWER anyway.

        LD      A,$19           ; compute scroll count as 25 minus
        SUB     (IY+$4F)        ; value of S_POSN_hi.
        LD      ($5C8C),A       ; update SCR_CT system variable.
        SET     7,(IY+$01)      ; update FLAGS - signal running program.
        LD      (IY+$00),$FF    ; set ERR_NR to 'OK'.
        LD      (IY+$0A),$01    ; set NSPPC to one for first statement.
        CALL    L1B8A           ; call routine LINE-RUN to run the line.
                                ; sysvar ERR_SP therefore addresses MAIN-4

; Examples of direct commands are RUN, CLS, LOAD "", PRINT USR 40000,
; LPRINT "A"; etc..
; If a user written machine-code program disables interrupts then it
; must enable them to pass the next step. We also jumped to here if the
; keyboard was not being used.

;; MAIN-4
L1303:  HALT                    ; wait for interrupt the only routine that can
                                ; set bit 5 of FLAGS.

        RES     5,(IY+$01)      ; update bit 5 of FLAGS - signal no new key.

        BIT     1,(IY+$30)      ; test FLAGS2 - is printer buffer clear ?
        CALL    NZ,L0ECD        ; call routine COPY-BUFF if not.
                                ; Note. the programmer has neglected
                                ; to set bit 1 of FLAGS first.

        LD      A,($5C3A)       ; fetch ERR_NR
        INC     A               ; increment to give true code.

; Now deal with a runtime error as opposed to an editing error.
; However if the error code is now zero then the OK message will be printed.

;; MAIN-G
L1313:  PUSH    AF              ; save the error number.

        LD      HL,$0000        ; prepare to clear some system variables.
        LD      (IY+$37),H      ; clear all the bits of FLAGX.
        LD      (IY+$26),H      ; blank X_PTR_hi to suppress error marker.
        LD      ($5C0B),HL      ; blank DEFADD to signal that no defined
                                ; function is currently being evaluated.

        LD      HL,$0001        ; explicit - inc hl would do.
        LD      ($5C16),HL      ; ensure STRMS-00 is keyboard.

        CALL    L16B0           ; routine SET-MIN clears workspace etc.
        RES     5,(IY+$37)      ; update FLAGX - signal in EDIT not INPUT mode.
                                ; Note. all the bits were reset earlier.

        CALL    L0D6E           ; call routine CLS-LOWER.

        SET     5,(IY+$02)      ; update TV_FLAG - signal lower screen
                                ; requires clearing.

        POP     AF              ; bring back the true error number
        LD      B,A             ; and make a copy in B.
        CP      $0A             ; is it a print-ready digit ?
        JR      C,L133C         ; forward to MAIN-5 if so.

        ADD     A,$07           ; add ASCII offset to letters.

;; MAIN-5
L133C:  CALL    L15EF           ; call routine OUT-CODE to print the code.

        LD      A,$20           ; followed by a space.
        RST     10H             ; PRINT-A

        LD      A,B             ; fetch stored report code.
        LD      DE,L1391        ; address: rpt-mesgs.

        CALL    L0C0A           ; call routine PO-MSG to print the message.

X1349:  XOR     A               ; clear accumulator to directly
        LD      DE,L1537 - 1    ; address the comma and space message.  

        CALL    L0C0A           ; routine PO-MSG prints ', ' although it would
                                ; be more succinct to use RST $10.

        LD      BC,($5C45)      ; fetch PPC the current line number.
        CALL    L1A1B           ; routine OUT-NUM-1 will print that

        LD      A,$3A           ; then a ':' character.
        RST     10H             ; PRINT-A

        LD      C,(IY+$0D)      ; then SUBPPC for statement
        LD      B,$00           ; limited to 127
        CALL    L1A1B           ; routine OUT-NUM-1 prints BC.

        CALL    L1097           ; routine CLEAR-SP clears editing area which 
                                ; probably contained 'RUN'.

        LD      A,($5C3A)       ; fetch ERR_NR again
        INC     A               ; test for no error originally $FF.
        JR      Z,L1386         ; forward to MAIN-9 if no error.

        CP      $09             ; is code Report 9 STOP ?
        JR      Z,L1373         ; forward to MAIN-6 if so

        CP      $15             ; is code Report L Break ?
        JR      NZ,L1376        ; forward to MAIN-7 if not

; Stop or Break was encountered so consider CONTINUE.

;; MAIN-6
L1373:  INC     (IY+$0D)        ; increment SUBPPC to next statement.

;; MAIN-7
L1376:  LD      BC,$0003        ; prepare to copy 3 system variables to
        LD      DE,$5C70        ; address OSPPC - statement for CONTINUE.
                                ; also updating OLDPPC line number below.

        LD      HL,$5C44        ; set source top to NSPPC next statement.
        BIT     7,(HL)          ; did BREAK occur before the jump ?
                                ; e.g. between GO TO and next statement.
        JR      Z,L1384         ; skip forward to MAIN-8, if not, as set-up
                                ; is correct.

        ADD     HL,BC           ; set source to SUBPPC number of current
                                ; statement/line which will be repeated.

;; MAIN-8
L1384:  LDDR                    ; copy PPC to OLDPPC and SUBPPC to OSPCC
                                ; or NSPPC to OLDPPC and NEWPPC to OSPCC

;; MAIN-9
L1386:  LD      (IY+$0A),$FF    ; update NSPPC - signal 'no jump'.
        RES     3,(IY+$01)      ; update FLAGS - signal use 'K' mode for
                                ; the first character in the editor and

        JP      L12AC           ; jump back to MAIN-2.


; ----------------------
; Canned report messages
; ----------------------
; The Error reports with the last byte inverted. The first entry
; is a dummy entry. The last, which begins with $7F, the Spectrum
; character for copyright symbol, is placed here for convenience
; as is the preceding comma and space.
; The report line must accommodate a 4-digit line number and a 3-digit
; statement number which limits the length of the message text to twenty 
; characters.
; e.g.  "B Integer out of range, 1000:127"

;; rpt-mesgs
L1391:  DEFB    $80
        DEFB    'O','K'+$80                             ; 0
        DEFM    "NEXT without FO"
        DEFB    'R'+$80                                 ; 1
        DEFM    "Variable not foun"
        DEFB    'd'+$80                                 ; 2
        DEFM    "Subscript wron"
        DEFB    'g'+$80                                 ; 3
        DEFM    "Out of memor"
        DEFB    'y'+$80                                 ; 4
        DEFM    "Out of scree"
        DEFB    'n'+$80                                 ; 5
        DEFM    "Number too bi"
        DEFB    'g'+$80                                 ; 6
        DEFM    "RETURN without GOSU"
        DEFB    'B'+$80                                 ; 7
        DEFM    "End of fil"
        DEFB    'e'+$80                                 ; 8
        DEFM    "STOP statemen"
        DEFB    't'+$80                                 ; 9
        DEFM    "Invalid argumen"
        DEFB    't'+$80                                 ; A
        DEFM    "Integer out of rang"
        DEFB    'e'+$80                                 ; B
        DEFM    "Nonsense in BASI"
        DEFB    'C'+$80                                 ; C
        DEFM    "BREAK - CONT repeat"
        DEFB    's'+$80                                 ; D
        DEFM    "Out of DAT"
        DEFB    'A'+$80                                 ; E
        DEFM    "Invalid file nam"
        DEFB    'e'+$80                                 ; F
        DEFM    "No room for lin"
        DEFB    'e'+$80                                 ; G
        DEFM    "STOP in INPU"
        DEFB    'T'+$80                                 ; H
        DEFM    "FOR without NEX"
        DEFB    'T'+$80                                 ; I
        DEFM    "Invalid I/O devic"
        DEFB    'e'+$80                                 ; J
        DEFM    "Invalid colou"
        DEFB    'r'+$80                                 ; K
        DEFM    "BREAK into progra"
        DEFB    'm'+$80                                 ; L
        DEFM    "RAMTOP no goo"
        DEFB    'd'+$80                                 ; M
        DEFM    "Statement los"
        DEFB    't'+$80                                 ; N
        DEFM    "Invalid strea"
        DEFB    'm'+$80                                 ; O
        DEFM    "FN without DE"
        DEFB    'F'+$80                                 ; P
        DEFM    "Parameter erro"
        DEFB    'r'+$80                                 ; Q
        DEFM    "Tape loading erro"
        DEFB    'r'+$80                                 ; R
;; comma-sp   
L1537:  DEFB    ',',' '+$80                             ; used in report line.
;; copyright
L1539:  DEFM    "Press PLAY or SPACE to brea"
        DEFB    'k'+$80


; -------------
; REPORT-G
; -------------
; Note ERR_SP points here during line entry which allows the
; normal 'Out of Memory' report to be augmented to the more
; precise 'No Room for line' report.

;; REPORT-G
; No Room for line
L1555:  LD      A,$10           ; i.e. 'G' -$30 -$07
        LD      BC,$0000        ; this seems unnecessary.
        JP      L1313           ; jump back to MAIN-G

; -----------------------------
; Handle addition of BASIC line
; -----------------------------
; Note this is not a subroutine but a branch of the main execution loop.
; System variable ERR_SP still points to editing error handler.
; A new line is added to the BASIC program at the appropriate place.
; An existing line with same number is deleted first.
; Entering an existing line number deletes that line.
; Entering a non-existent line allows the subsequent line to be edited next.

;; MAIN-ADD
L155D:  LD      ($5C49),BC      ; set E_PPC to extracted line number.
        LD      HL,($5C5D)      ; fetch CH_ADD - points to location after the
                                ; initial digits (set in E_LINE_NO).
        EX      DE,HL           ; save start of BASIC in DE.

        LD      HL,L1555        ; Address: REPORT-G
        PUSH    HL              ; is pushed on stack and addressed by ERR_SP.
                                ; the only error that can occur is
                                ; 'Out of memory'.

        LD      HL,($5C61)      ; fetch WORKSP - end of line.
        SCF                     ; prepare for true subtraction.
        SBC     HL,DE           ; find length of BASIC and
        PUSH    HL              ; save it on stack.
        LD      H,B             ; transfer line number
        LD      L,C             ; to HL register.
        CALL    L196E           ; routine LINE-ADDR will see if
                                ; a line with the same number exists.
        JR      NZ,L157D        ; forward if no existing line to MAIN-ADD1.

        CALL    L19B8           ; routine NEXT-ONE finds the existing line.
        CALL    L19E8           ; routine RECLAIM-2 reclaims it.

;; MAIN-ADD1
L157D:  POP     BC              ; retrieve the length of the new line.
        LD      A,C             ; and test if carriage return only
        DEC     A               ; i.e. one byte long.
        OR      B               ; result would be zero.
        JR      Z,L15AB         ; forward to MAIN-ADD2 is so.

        PUSH    BC              ; save the length again.
        INC     BC              ; adjust for inclusion
        INC     BC              ; of line number (two bytes)
        INC     BC              ; and line length
        INC     BC              ; (two bytes).
        DEC     HL              ; HL points to location before the destination

        LD      DE,($5C53)      ; fetch the address of PROG
        PUSH    DE              ; and save it on the stack
        CALL    L1655           ; routine MAKE-ROOM creates BC spaces in
                                ; program area and updates pointers.
        POP     HL              ; restore old program pointer.
        LD      ($5C53),HL      ; and put back in PROG as it may have been
                                ; altered by the POINTERS routine.

        POP     BC              ; retrieve BASIC length
        PUSH    BC              ; and save again.

        INC     DE              ; points to end of new area.
        LD      HL,($5C61)      ; set HL to WORKSP - location after edit line.
        DEC     HL              ; decrement to address end marker.
        DEC     HL              ; decrement to address carriage return.
        LDDR                    ; copy the BASIC line back to initial command.

        LD      HL,($5C49)      ; fetch E_PPC - line number.
        EX      DE,HL           ; swap it to DE, HL points to last of
                                ; four locations.
        POP     BC              ; retrieve length of line.
        LD      (HL),B          ; high byte last.
        DEC     HL              ;
        LD      (HL),C          ; then low byte of length.
        DEC     HL              ;
        LD      (HL),E          ; then low byte of line number.
        DEC     HL              ;
        LD      (HL),D          ; then high byte range $0 - $27 (1-9999).

;; MAIN-ADD2
L15AB:  POP     AF              ; drop the address of Report G
        JP      L12A2           ; and back to MAIN-EXEC producing a listing
                                ; and to reset ERR_SP in EDITOR.


; ---------------------------------
; THE 'INITIAL CHANNEL' INFORMATION
; ---------------------------------
;   This initial channel information is copied from ROM to RAM, during 
;   initialization.  It's new location is after the system variables and is 
;   addressed by the system variable CHANS which means that it can slide up and
;   down in memory.  The table is never searched, by this ROM, and the last 
;   character, which could be anything other than a comma, provides a 
;   convenient resting place for DATADD.

;; init-chan
L15AF:  DEFW    L09F4           ; PRINT-OUT
        DEFW    L10A8           ; KEY-INPUT
        DEFB    $4B             ; 'K'
        DEFW    L09F4           ; PRINT-OUT
        DEFW    L15C4           ; REPORT-J
        DEFB    $53             ; 'S'
        DEFW    L0F81           ; ADD-CHAR
        DEFW    L15C4           ; REPORT-J
        DEFB    $52             ; 'R'
        DEFW    L09F4           ; PRINT-OUT
        DEFW    L15C4           ; REPORT-J
        DEFB    $50             ; 'P'

        DEFB    $80             ; End Marker

;; REPORT-J
L15C4:  RST     08H             ; ERROR-1
        DEFB    $12             ; Error Report: Invalid I/O device


; -------------------------
; THE 'INITIAL STREAM' DATA
; -------------------------
;   This is the initial stream data for the seven streams $FD - $03 that is
;   copied from ROM to the STRMS system variables area during initialization.
;   There are reserved locations there for another 12 streams.  Each location 
;   contains an offset to the second byte of a channel.  The first byte of a 
;   channel can't be used as that would result in an offset of zero for some 
;   and zero is used to denote that a stream is closed.

;; init-strm
L15C6:  DEFB    $01, $00        ; stream $FD offset to channel 'K'
        DEFB    $06, $00        ; stream $FE offset to channel 'S'
        DEFB    $0B, $00        ; stream $FF offset to channel 'R'

        DEFB    $01, $00        ; stream $00 offset to channel 'K'
        DEFB    $01, $00        ; stream $01 offset to channel 'K'
        DEFB    $06, $00        ; stream $02 offset to channel 'S'
        DEFB    $10, $00        ; stream $03 offset to channel 'P'

; ------------------------------
; THE 'INPUT CONTROL' SUBROUTINE
; ------------------------------
;

;; WAIT-KEY
L15D4:  BIT     5,(IY+$02)      ; test TV_FLAG - clear lower screen ?
        JR      NZ,L15DE        ; forward to WAIT-KEY1 if so.

        SET     3,(IY+$02)      ; update TV_FLAG - signal reprint the edit
                                ; line to the lower screen.

;; WAIT-KEY1
L15DE:  CALL    L15E6           ; routine INPUT-AD is called.

        RET     C               ; return with acceptable keys.

        JR      Z,L15DE         ; back to WAIT-KEY1 if no key is pressed
                                ; or it has been handled within INPUT-AD.

;   Note. When inputting from the keyboard all characters are returned with
;   above conditions so this path is never taken.

;; REPORT-8
L15E4:  RST     08H             ; ERROR-1
        DEFB    $07             ; Error Report: End of file

; ---------------------------
; THE 'INPUT ADDRESS' ROUTINE
; ---------------------------
;   This routine fetches the address of the input stream from the current 
;   channel area using the system variable CURCHL.

;; INPUT-AD
L15E6:  EXX                     ; switch in alternate set.
        PUSH    HL              ; save HL register
        LD      HL,($5C51)      ; fetch address of CURCHL - current channel.
        INC     HL              ; step over output routine
        INC     HL              ; to point to low byte of input routine.
        JR      L15F7           ; forward to CALL-SUB.

; -------------------------
; THE 'CODE OUTPUT' ROUTINE
; -------------------------
;   This routine is called on five occasions to print the ASCII equivalent of 
;   a value 0-9.

;; OUT-CODE
L15EF:  LD      E,$30           ; add 48 decimal to give the ASCII character 
        ADD     A,E             ; '0' to '9' and continue into the main output
                                ; routine.

; -------------------------
; THE 'MAIN OUTPUT' ROUTINE
; -------------------------
;   PRINT-A-2 is a continuation of the RST 10 restart that prints any character.
;   The routine prints to the current channel and the printing of control codes
;   may alter that channel to divert subsequent RST 10 instructions to temporary
;   routines. The normal channel is $09F4.

;; PRINT-A-2
L15F2:  EXX                     ; switch in alternate set
        PUSH    HL              ; save HL register
        LD      HL,($5C51)      ; fetch CURCHL the current channel.

; input-ad rejoins here also.

;; CALL-SUB
L15F7:  LD      E,(HL)          ; put the low byte in E.
        INC     HL              ; advance address.
        LD      D,(HL)          ; put the high byte to D.
        EX      DE,HL           ; transfer the stream to HL.
        CALL    L162C           ; use routine CALL-JUMP.
                                ; in effect CALL (HL).

        POP     HL              ; restore saved HL register.
        EXX                     ; switch back to the main set and
        RET                     ; return.

; --------------------------
; THE 'OPEN CHANNEL' ROUTINE
; --------------------------
;   This subroutine is used by the ROM to open a channel 'K', 'S', 'R' or 'P'.
;   This is either for its own use or in response to a user's request, for
;   example, when '#' is encountered with output - PRINT, LIST etc.
;   or with input - INPUT, INKEY$ etc.
;   It is entered with a system stream $FD - $FF, or a user stream $00 - $0F
;   in the accumulator.

;; CHAN-OPEN
L1601:  ADD     A,A             ; double the stream ($FF will become $FE etc.)
        ADD     A,$16           ; add the offset to stream 0 from $5C00
        LD      L,A             ; result to L
        LD      H,$5C           ; now form the address in STRMS area.
        LD      E,(HL)          ; fetch low byte of CHANS offset
        INC     HL              ; address next
        LD      D,(HL)          ; fetch high byte of offset
        LD      A,D             ; test that the stream is open.
        OR      E               ; zero if closed.
        JR      NZ,L1610        ; forward to CHAN-OP-1 if open.

;; REPORT-Oa
L160E:  RST     08H             ; ERROR-1
        DEFB    $17             ; Error Report: Invalid stream

; continue here if stream was open. Note that the offset is from CHANS
; to the second byte of the channel.

;; CHAN-OP-1
L1610:  DEC     DE              ; reduce offset so it points to the channel.
        LD      HL,($5C4F)      ; fetch CHANS the location of the base of
                                ; the channel information area
        ADD     HL,DE           ; and add the offset to address the channel.
                                ; and continue to set flags.

; -----------------
; Set channel flags
; -----------------
; This subroutine is used from ED-EDIT, str$ and read-in to reset the
; current channel when it has been temporarily altered.

;; CHAN-FLAG
L1615:  LD      ($5C51),HL      ; set CURCHL system variable to the
                                ; address in HL
        RES     4,(IY+$30)      ; update FLAGS2  - signal K channel not in use.
                                ; Note. provide a default for channel 'R'.
        INC     HL              ; advance past
        INC     HL              ; output routine.
        INC     HL              ; advance past
        INC     HL              ; input routine.
        LD      C,(HL)          ; pick up the letter.
        LD      HL,L162D        ; address: chn-cd-lu
        CALL    L16DC           ; routine INDEXER finds offset to a
                                ; flag-setting routine.

        RET     NC              ; but if the letter wasn't found in the
                                ; table just return now. - channel 'R'.

        LD      D,$00           ; prepare to add
        LD      E,(HL)          ; offset to E
        ADD     HL,DE           ; add offset to location of offset to form
                                ; address of routine

;; CALL-JUMP
L162C:  JP      (HL)            ; jump to the routine

; Footnote. calling any location that holds JP (HL) is the equivalent to
; a pseudo Z80 instruction CALL (HL). The ROM uses the instruction above.

; --------------------------
; Channel code look-up table
; --------------------------
; This table is used by the routine above to find one of the three
; flag setting routines below it.
; A zero end-marker is required as channel 'R' is not present.

;; chn-cd-lu
L162D:  DEFB    'K', L1634-$-1  ; offset $06 to CHAN-K
        DEFB    'S', L1642-$-1  ; offset $12 to CHAN-S
        DEFB    'P', L164D-$-1  ; offset $1B to CHAN-P

        DEFB    $00             ; end marker.

; --------------
; Channel K flag
; --------------
; routine to set flags for lower screen/keyboard channel.

;; CHAN-K
L1634:  SET     0,(IY+$02)      ; update TV_FLAG  - signal lower screen in use
        RES     5,(IY+$01)      ; update FLAGS    - signal no new key
        SET     4,(IY+$30)      ; update FLAGS2   - signal K channel in use
        JR      L1646           ; forward to CHAN-S-1 for indirect exit

; --------------
; Channel S flag
; --------------
; routine to set flags for upper screen channel.

;; CHAN-S
L1642:  RES     0,(IY+$02)      ; TV_FLAG  - signal main screen in use

;; CHAN-S-1
L1646:  RES     1,(IY+$01)      ; update FLAGS  - signal printer not in use
        JP      L0D4D           ; jump back to TEMPS and exit via that
                                ; routine after setting temporary attributes.
; --------------
; Channel P flag
; --------------
; This routine sets a flag so that subsequent print related commands
; print to printer or update the relevant system variables.
; This status remains in force until reset by the routine above.

;; CHAN-P
L164D:  SET     1,(IY+$01)      ; update FLAGS  - signal printer in use
        RET                     ; return

; --------------------------
; THE 'ONE SPACE' SUBROUTINE
; --------------------------
; This routine is called once only to create a single space
; in workspace by ADD-CHAR. 

;; ONE-SPACE
L1652:  LD      BC,$0001        ; create space for a single character.

; ---------
; Make Room
; ---------
; This entry point is used to create BC spaces in various areas such as
; program area, variables area, workspace etc..
; The entire free RAM is available to each BASIC statement.
; On entry, HL addresses where the first location is to be created.
; Afterwards, HL will point to the location before this.

;; MAKE-ROOM
L1655:  PUSH    HL              ; save the address pointer.
        CALL    L1F05           ; routine TEST-ROOM checks if room
                                ; exists and generates an error if not.
        POP     HL              ; restore the address pointer.
        CALL    L1664           ; routine POINTERS updates the
                                ; dynamic memory location pointers.
                                ; DE now holds the old value of STKEND.
        LD      HL,($5C65)      ; fetch new STKEND the top destination.

        EX      DE,HL           ; HL now addresses the top of the area to
                                ; be moved up - old STKEND.
        LDDR                    ; the program, variables, etc are moved up.
        RET                     ; return with new area ready to be populated.
                                ; HL points to location before new area,
                                ; and DE to last of new locations.

; -----------------------------------------------
; Adjust pointers before making or reclaiming room
; -----------------------------------------------
; This routine is called by MAKE-ROOM to adjust upwards and by RECLAIM to
; adjust downwards the pointers within dynamic memory.
; The fourteen pointers to dynamic memory, starting with VARS and ending 
; with STKEND, are updated adding BC if they are higher than the position
; in HL.  
; The system variables are in no particular order except that STKEND, the first
; free location after dynamic memory must be the last encountered.

;; POINTERS
L1664:  PUSH    AF              ; preserve accumulator.
        PUSH    HL              ; put pos pointer on stack.
        LD      HL,$5C4B        ; address VARS the first of the
        LD      A,$0E           ; fourteen variables to consider.

;; PTR-NEXT
L166B:  LD      E,(HL)          ; fetch the low byte of the system variable.
        INC     HL              ; advance address.
        LD      D,(HL)          ; fetch high byte of the system variable.
        EX      (SP),HL         ; swap pointer on stack with the variable
                                ; pointer.
        AND     A               ; prepare to subtract.
        SBC     HL,DE           ; subtract variable address
        ADD     HL,DE           ; and add back
        EX      (SP),HL         ; swap pos with system variable pointer
        JR      NC,L167F        ; forward to PTR-DONE if var before pos

        PUSH    DE              ; save system variable address.
        EX      DE,HL           ; transfer to HL
        ADD     HL,BC           ; add the offset
        EX      DE,HL           ; back to DE
        LD      (HL),D          ; load high byte
        DEC     HL              ; move back
        LD      (HL),E          ; load low byte
        INC     HL              ; advance to high byte
        POP     DE              ; restore old system variable address.

;; PTR-DONE
L167F:  INC     HL              ; address next system variable.
        DEC     A               ; decrease counter.
        JR      NZ,L166B        ; back to PTR-NEXT if more.
        EX      DE,HL           ; transfer old value of STKEND to HL.
                                ; Note. this has always been updated.
        POP     DE              ; pop the address of the position.

        POP     AF              ; pop preserved accumulator.
        AND     A               ; clear carry flag preparing to subtract.

        SBC     HL,DE           ; subtract position from old stkend 
        LD      B,H             ; to give number of data bytes
        LD      C,L             ; to be moved.
        INC     BC              ; increment as we also copy byte at old STKEND.
        ADD     HL,DE           ; recompute old stkend.
        EX      DE,HL           ; transfer to DE.
        RET                     ; return.



; -------------------
; Collect line number
; -------------------
; This routine extracts a line number, at an address that has previously
; been found using LINE-ADDR, and it is entered at LINE-NO. If it encounters
; the program 'end-marker' then the previous line is used and if that
; should also be unacceptable then zero is used as it must be a direct
; command. The program end-marker is the variables end-marker $80, or
; if variables exist, then the first character of any variable name.

;; LINE-ZERO
L168F:  DEFB    $00, $00        ; dummy line number used for direct commands


;; LINE-NO-A
L1691:  EX      DE,HL           ; fetch the previous line to HL and set
        LD      DE,L168F        ; DE to LINE-ZERO should HL also fail.

; -> The Entry Point.

;; LINE-NO
L1695:  LD      A,(HL)          ; fetch the high byte - max $2F
        AND     $C0             ; mask off the invalid bits.
        JR      NZ,L1691        ; to LINE-NO-A if an end-marker.

        LD      D,(HL)          ; reload the high byte.
        INC     HL              ; advance address.
        LD      E,(HL)          ; pick up the low byte.
        RET                     ; return from here.

; -------------------
; Handle reserve room
; -------------------
; This is a continuation of the restart BC-SPACES

;; RESERVE
L169E:  LD      HL,($5C63)      ; STKBOT first location of calculator stack
        DEC     HL              ; make one less than new location
        CALL    L1655           ; routine MAKE-ROOM creates the room.
        INC     HL              ; address the first new location
        INC     HL              ; advance to second
        POP     BC              ; restore old WORKSP
        LD      ($5C61),BC      ; system variable WORKSP was perhaps
                                ; changed by POINTERS routine.
        POP     BC              ; restore count for return value.
        EX      DE,HL           ; switch. DE = location after first new space
        INC     HL              ; HL now location after new space
        RET                     ; return.

; ---------------------------
; Clear various editing areas
; ---------------------------
; This routine sets the editing area, workspace and calculator stack
; to their minimum configurations as at initialization and indeed this
; routine could have been relied on to perform that task.
; This routine uses HL only and returns with that register holding
; WORKSP/STKBOT/STKEND though no use is made of this. The routines also
; reset MEM to its usual place in the systems variable area should it
; have been relocated to a FOR-NEXT variable. The main entry point
; SET-MIN is called at the start of the MAIN-EXEC loop and prior to
; displaying an error.

;; SET-MIN
L16B0:  LD      HL,($5C59)      ; fetch E_LINE
        LD      (HL),$0D        ; insert carriage return
        LD      ($5C5B),HL      ; make K_CUR keyboard cursor point there.
        INC     HL              ; next location
        LD      (HL),$80        ; holds end-marker $80
        INC     HL              ; next location becomes
        LD      ($5C61),HL      ; start of WORKSP

; This entry point is used prior to input and prior to the execution,
; or parsing, of each statement.

;; SET-WORK
L16BF:  LD      HL,($5C61)      ; fetch WORKSP value
        LD      ($5C63),HL      ; and place in STKBOT

; This entry point is used to move the stack back to its normal place
; after temporary relocation during line entry and also from ERROR-3

;; SET-STK
L16C5:  LD      HL,($5C63)      ; fetch STKBOT value 
        LD      ($5C65),HL      ; and place in STKEND.

        PUSH    HL              ; perhaps an obsolete entry point.
        LD      HL,$5C92        ; normal location of MEM-0
        LD      ($5C68),HL      ; is restored to system variable MEM.
        POP     HL              ; saved value not required.
        RET                     ; return.

; ------------------
; Reclaim edit-line?
; ------------------
; This seems to be legacy code from the ZX80/ZX81 as it is 
; not used in this ROM.
; That task, in fact, is performed here by the dual-area routine CLEAR-SP.
; This routine is designed to deal with something that is known to be in the
; edit buffer and not workspace.
; On entry, HL must point to the end of the something to be deleted.

;; REC-EDIT
L16D4:  LD      DE,($5C59)      ; fetch start of edit line from E_LINE.
        JP      L19E5           ; jump forward to RECLAIM-1.

; --------------------------
; The Table INDEXING routine
; --------------------------
; This routine is used to search two-byte hash tables for a character
; held in C, returning the address of the following offset byte.
; if it is known that the character is in the table e.g. for priorities,
; then the table requires no zero end-marker. If this is not known at the
; outset then a zero end-marker is required and carry is set to signal
; success.

;; INDEXER-1
L16DB:  INC     HL              ; address the next pair of values.

; -> The Entry Point.

;; INDEXER
L16DC:  LD      A,(HL)          ; fetch the first byte of pair
        AND     A               ; is it the end-marker ?
        RET     Z               ; return with carry reset if so.

        CP      C               ; is it the required character ?
        INC     HL              ; address next location.
        JR      NZ,L16DB        ; back to INDEXER-1 if no match.

        SCF                     ; else set the carry flag.
        RET                     ; return with carry set

; --------------------------------
; The Channel and Streams Routines
; --------------------------------
; A channel is an input/output route to a hardware device
; and is identified to the system by a single letter e.g. 'K' for
; the keyboard. A channel can have an input and output route
; associated with it in which case it is bi-directional like
; the keyboard. Others like the upper screen 'S' are output
; only and the input routine usually points to a report message.
; Channels 'K' and 'S' are system channels and it would be inappropriate
; to close the associated streams so a mechanism is provided to
; re-attach them. When the re-attachment is no longer required, then
; closing these streams resets them as at initialization.
; Early adverts said that the network and RS232 were in this ROM. 
; Channels 'N' and 'B' are user channels and have been removed successfully 
; if, as seems possible, they existed.
; Ironically the tape streamer is not accessed through streams and
; channels.
; Early demonstrations of the Spectrum showed a single microdrive being
; controlled by the main ROM.

; ---------------------
; THE 'CLOSE #' COMMAND
; ---------------------
;   This command allows streams to be closed after use.
;   Any temporary memory areas used by the stream would be reclaimed and
;   finally flags set or reset if necessary.

;; CLOSE
L16E5:  CALL    L171E           ; routine STR-DATA fetches parameter
                                ; from calculator stack and gets the
                                ; existing STRMS data pointer address in HL
                                ; and stream offset from CHANS in BC.

                                ; Note. this offset could be zero if the
                                ; stream is already closed. A check for this
                                ; should occur now and an error should be
                                ; generated, for example,
                                ; Report S 'Stream status closed'.

        CALL    L1701           ; routine CLOSE-2 would perform any actions
                                ; peculiar to that stream without disturbing
                                ; data pointer to STRMS entry in HL.

        LD      BC,$0000        ; the stream is to be blanked.
        LD      DE,$A3E2        ; the number of bytes from stream 4, $5C1E,
                                ; to $10000
        EX      DE,HL           ; transfer offset to HL, STRMS data pointer
                                ; to DE.
        ADD     HL,DE           ; add the offset to the data pointer.  
        JR      C,L16FC         ; forward to CLOSE-1 if a non-system stream.
                                ; i.e. higher than 3. 

; proceed with a negative result.

        LD      BC,L15C6 + 14   ; prepare the address of the byte after
                                ; the initial stream data in ROM. ($15D4)
        ADD     HL,BC           ; index into the data table with negative value.
        LD      C,(HL)          ; low byte to C
        INC     HL              ; address next.
        LD      B,(HL)          ; high byte to B.

;   and for streams 0 - 3 just enter the initial data back into the STRMS entry
;   streams 0 - 2 can't be closed as they are shared by the operating system.
;   -> for streams 4 - 15 then blank the entry.

;; CLOSE-1
L16FC:  EX      DE,HL           ; address of stream to HL.
        LD      (HL),C          ; place zero (or low byte).
        INC     HL              ; next address.
        LD      (HL),B          ; place zero (or high byte).
        RET                     ; return.

; ------------------------
; THE 'CLOSE-2' SUBROUTINE
; ------------------------
;   There is not much point in coming here.
;   The purpose was once to find the offset to a special closing routine,
;   in this ROM and within 256 bytes of the close stream look up table that
;   would reclaim any buffers associated with a stream. At least one has been
;   removed.
;   Any attempt to CLOSE streams $00 to $04, without first opening the stream,
;   will lead to either a system restart or the production of a strange report.
;   credit: Martin Wren-Hilton 1982.

;; CLOSE-2
L1701:  PUSH    HL              ; * save address of stream data pointer
                                ; in STRMS on the machine stack.
        LD      HL,($5C4F)      ; fetch CHANS address to HL
        ADD     HL,BC           ; add the offset to address the second
                                ; byte of the output routine hopefully.
        INC     HL              ; step past
        INC     HL              ; the input routine.

;    Note. When the Sinclair Interface1 is fitted then an instruction fetch 
;    on the next address pages this ROM out and the shadow ROM in.

;; ROM_TRAP
L1708:  INC     HL              ; to address channel's letter
        LD      C,(HL)          ; pick it up in C.
                                ; Note. but if stream is already closed we
                                ; get the value $10 (the byte preceding 'K').

        EX      DE,HL           ; save the pointer to the letter in DE.

;   Note. The string pointer is saved but not used!!

        LD      HL,L1716        ; address: cl-str-lu in ROM.
        CALL    L16DC           ; routine INDEXER uses the code to get 
                                ; the 8-bit offset from the current point to
                                ; the address of the closing routine in ROM.
                                ; Note. it won't find $10 there!

        LD      C,(HL)          ; transfer the offset to C.
        LD      B,$00           ; prepare to add.
        ADD     HL,BC           ; add offset to point to the address of the
                                ; routine that closes the stream.
                                ; (and presumably removes any buffers that
                                ; are associated with it.)
        JP      (HL)            ; jump to that routine.

; --------------------------------
; THE 'CLOSE STREAM LOOK-UP' TABLE
; --------------------------------
;   This table contains an entry for a letter found in the CHANS area.
;   followed by an 8-bit displacement, from that byte's address in the
;   table to the routine that performs any ancillary actions associated
;   with closing the stream of that channel.
;   The table doesn't require a zero end-marker as the letter has been
;   picked up from a channel that has an open stream.

;; cl-str-lu
L1716:  DEFB    'K', L171C-$-1  ; offset 5 to CLOSE-STR
        DEFB    'S', L171C-$-1  ; offset 3 to CLOSE-STR
        DEFB    'P', L171C-$-1  ; offset 1 to CLOSE-STR


; ------------------------------
; THE 'CLOSE STREAM' SUBROUTINES
; ------------------------------
; The close stream routines in fact have no ancillary actions to perform
; which is not surprising with regard to 'K' and 'S'.

;; CLOSE-STR                    
L171C:  POP     HL              ; * now just restore the stream data pointer
        RET                     ; in STRMS and return.

; -----------
; Stream data
; -----------
; This routine finds the data entry in the STRMS area for the specified
; stream which is passed on the calculator stack. It returns with HL
; pointing to this system variable and BC holding a displacement from
; the CHANS area to the second byte of the stream's channel. If BC holds
; zero, then that signifies that the stream is closed.

;; STR-DATA
L171E:  CALL    L1E94           ; routine FIND-INT1 fetches parameter to A
        CP      $10             ; is it less than 16d ?
        JR      C,L1727         ; skip forward to STR-DATA1 if so.

;; REPORT-Ob
L1725:  RST     08H             ; ERROR-1
        DEFB    $17             ; Error Report: Invalid stream

;; STR-DATA1
L1727:  ADD     A,$03           ; add the offset for 3 system streams.
                                ; range 00 - 15d becomes 3 - 18d.
        RLCA                    ; double as there are two bytes per 
                                ; stream - now 06 - 36d
        LD      HL,$5C10        ; address STRMS - the start of the streams
                                ; data area in system variables.
        LD      C,A             ; transfer the low byte to A.
        LD      B,$00           ; prepare to add offset.
        ADD     HL,BC           ; add to address the data entry in STRMS.

; the data entry itself contains an offset from CHANS to the address of the
; stream

        LD      C,(HL)          ; low byte of displacement to C.
        INC     HL              ; address next.
        LD      B,(HL)          ; high byte of displacement to B.
        DEC     HL              ; step back to leave HL pointing to STRMS
                                ; data entry.
        RET                     ; return with CHANS displacement in BC
                                ; and address of stream data entry in HL.

; --------------------
; Handle OPEN# command
; --------------------
; Command syntax example: OPEN #5,"s"
; On entry the channel code entry is on the calculator stack with the next
; value containing the stream identifier. They have to swapped.

;; OPEN
L1736:  RST     28H             ;; FP-CALC    ;s,c.
        DEFB    $01             ;;exchange    ;c,s.
        DEFB    $38             ;;end-calc

        CALL    L171E           ; routine STR-DATA fetches the stream off
                                ; the stack and returns with the CHANS
                                ; displacement in BC and HL addressing 
                                ; the STRMS data entry.
        LD      A,B             ; test for zero which
        OR      C               ; indicates the stream is closed.
        JR      Z,L1756         ; skip forward to OPEN-1 if so.

; if it is a system channel then it can re-attached.

        EX      DE,HL           ; save STRMS address in DE.
        LD      HL,($5C4F)      ; fetch CHANS.
        ADD     HL,BC           ; add the offset to address the second 
                                ; byte of the channel.
        INC     HL              ; skip over the
        INC     HL              ; input routine.
        INC     HL              ; and address the letter.
        LD      A,(HL)          ; pick up the letter.
        EX      DE,HL           ; save letter pointer and bring back
                                ; the STRMS pointer.

        CP      $4B             ; is it 'K' ?
        JR      Z,L1756         ; forward to OPEN-1 if so

        CP      $53             ; is it 'S' ?
        JR      Z,L1756         ; forward to OPEN-1 if so

        CP      $50             ; is it 'P' ?
        JR      NZ,L1725        ; back to REPORT-Ob if not.
                                ; to report 'Invalid stream'.

; continue if one of the upper-case letters was found.
; and rejoin here from above if stream was closed.

;; OPEN-1
L1756:  CALL    L175D           ; routine OPEN-2 opens the stream.

; it now remains to update the STRMS variable.

        LD      (HL),E          ; insert or overwrite the low byte.
        INC     HL              ; address high byte in STRMS.
        LD      (HL),D          ; insert or overwrite the high byte.
        RET                     ; return.

; -----------------
; OPEN-2 Subroutine
; -----------------
; There is some point in coming here as, as well as once creating buffers,
; this routine also sets flags.

;; OPEN-2
L175D:  PUSH    HL              ; * save the STRMS data entry pointer.
        CALL    L2BF1           ; routine STK-FETCH now fetches the
                                ; parameters of the channel string.
                                ; start in DE, length in BC.

        LD      A,B             ; test that it is not
        OR      C               ; the null string.
        JR      NZ,L1767        ; skip forward to OPEN-3 with 1 character
                                ; or more!

;; REPORT-Fb
L1765:  RST     08H             ; ERROR-1
        DEFB    $0E             ; Error Report: Invalid file name

;; OPEN-3
L1767:  PUSH    BC              ; save the length of the string.
        LD      A,(DE)          ; pick up the first character.
                                ; Note. There can be more than one character.
        AND     $DF             ; make it upper-case.
        LD      C,A             ; place it in C.
        LD      HL,L177A        ; address: op-str-lu is loaded.
        CALL    L16DC           ; routine INDEXER will search for letter.
        JR      NC,L1765        ; back to REPORT-F if not found
                                ; 'Invalid filename'

        LD      C,(HL)          ; fetch the displacement to opening routine.
        LD      B,$00           ; prepare to add.
        ADD     HL,BC           ; now form address of opening routine.
        POP     BC              ; restore the length of string.
        JP      (HL)            ; now jump forward to the relevant routine.

; -------------------------
; OPEN stream look-up table
; -------------------------
; The open stream look-up table consists of matched pairs.
; The channel letter is followed by an 8-bit displacement to the
; associated stream-opening routine in this ROM.
; The table requires a zero end-marker as the letter has been
; provided by the user and not the operating system.

;; op-str-lu
L177A:  DEFB    'K', L1781-$-1  ; $06 offset to OPEN-K
        DEFB    'S', L1785-$-1  ; $08 offset to OPEN-S
        DEFB    'P', L1789-$-1  ; $0A offset to OPEN-P

        DEFB    $00             ; end-marker.

; ----------------------------
; The Stream Opening Routines.
; ----------------------------
; These routines would have opened any buffers associated with the stream
; before jumping forward to OPEN-END with the displacement value in E
; and perhaps a modified value in BC. The strange pathing does seem to
; provide for flexibility in this respect.
;
; There is no need to open the printer buffer as it is there already
; even if you are still saving up for a ZX Printer or have moved onto
; something bigger. In any case it would have to be created after
; the system variables but apart from that it is a simple task
; and all but one of the ROM routines can handle a buffer in that position.
; (PR-ALL-6 would require an extra 3 bytes of code).
; However it wouldn't be wise to have two streams attached to the ZX Printer
; as you can now, so one assumes that if PR_CC_hi was non-zero then
; the OPEN-P routine would have refused to attach a stream if another
; stream was attached.

; Something of significance is being passed to these ghost routines in the
; second character. Strings 'RB', 'RT' perhaps or a drive/station number.
; The routine would have to deal with that and exit to OPEN_END with BC
; containing $0001 or more likely there would be an exit within the routine.
; Anyway doesn't matter, these routines are long gone.

; -----------------
; OPEN-K Subroutine
; -----------------
; Open Keyboard stream.

;; OPEN-K
L1781:  LD      E,$01           ; 01 is offset to second byte of channel 'K'.
        JR      L178B           ; forward to OPEN-END

; -----------------
; OPEN-S Subroutine
; -----------------
; Open Screen stream.

;; OPEN-S
L1785:  LD      E,$06           ; 06 is offset to 2nd byte of channel 'S'
        JR      L178B           ; to OPEN-END

; -----------------
; OPEN-P Subroutine
; -----------------
; Open Printer stream.

;; OPEN-P
L1789:  LD      E,$10           ; 16d is offset to 2nd byte of channel 'P'

;; OPEN-END
L178B:  DEC     BC              ; the stored length of 'K','S','P' or
                                ; whatever is now tested. ??
        LD      A,B             ; test now if initial or residual length
        OR      C               ; is one character.
        JR      NZ,L1765        ; to REPORT-Fb 'Invalid file name' if not.

        LD      D,A             ; load D with zero to form the displacement
                                ; in the DE register.
        POP     HL              ; * restore the saved STRMS pointer.
        RET                     ; return to update STRMS entry thereby 
                                ; signaling stream is open.

; ----------------------------------------
; Handle CAT, ERASE, FORMAT, MOVE commands
; ----------------------------------------
; These just generate an error report as the ROM is 'incomplete'.
;
; Luckily this provides a mechanism for extending these in a shadow ROM
; but without the powerful mechanisms set up in this ROM.
; An instruction fetch on $0008 may page in a peripheral ROM,
; e.g. the Sinclair Interface 1 ROM, to handle these commands.
; However that wasn't the plan.
; Development of this ROM continued for another three months until the cost
; of replacing it and the manual became unfeasible.
; The ultimate power of channels and streams died at birth.

;; CAT-ETC
L1793:  JR      L1725           ; to REPORT-Ob

; -----------------
; Perform AUTO-LIST
; -----------------
; This produces an automatic listing in the upper screen.

;; AUTO-LIST
L1795:  LD      ($5C3F),SP      ; save stack pointer in LIST_SP
        LD      (IY+$02),$10    ; update TV_FLAG set bit 3
        CALL    L0DAF           ; routine CL-ALL.
        SET     0,(IY+$02)      ; update TV_FLAG  - signal lower screen in use

        LD      B,(IY+$31)      ; fetch DF_SZ to B.
        CALL    L0E44           ; routine CL-LINE clears lower display
                                ; preserving B.
        RES     0,(IY+$02)      ; update TV_FLAG  - signal main screen in use
        SET     0,(IY+$30)      ; update FLAGS2 - signal will be necessary to
                                ; clear main screen.
        LD      HL,($5C49)      ; fetch E_PPC current edit line to HL.
        LD      DE,($5C6C)      ; fetch S_TOP to DE, the current top line
                                ; (initially zero)
        AND     A               ; prepare for true subtraction.
        SBC     HL,DE           ; subtract and
        ADD     HL,DE           ; add back.
        JR      C,L17E1         ; to AUTO-L-2 if S_TOP higher than E_PPC
                                ; to set S_TOP to E_PPC

        PUSH    DE              ; save the top line number.
        CALL    L196E           ; routine LINE-ADDR gets address of E_PPC.
        LD      DE,$02C0        ; prepare known number of characters in
                                ; the default upper screen.
        EX      DE,HL           ; offset to HL, program address to DE.
        SBC     HL,DE           ; subtract high value from low to obtain
                                ; negated result used in addition.
        EX      (SP),HL         ; swap result with top line number on stack.
        CALL    L196E           ; routine LINE-ADDR  gets address of that
                                ; top line in HL and next line in DE.
        POP     BC              ; restore the result to balance stack.

;; AUTO-L-1
L17CE:  PUSH    BC              ; save the result.
        CALL    L19B8           ; routine NEXT-ONE gets address in HL of
                                ; line after auto-line (in DE).
        POP     BC              ; restore result.
        ADD     HL,BC           ; compute back.
        JR      C,L17E4         ; to AUTO-L-3 if line 'should' appear

        EX      DE,HL           ; address of next line to HL.
        LD      D,(HL)          ; get line
        INC     HL              ; number
        LD      E,(HL)          ; in DE.
        DEC     HL              ; adjust back to start.
        LD      ($5C6C),DE      ; update S_TOP.
        JR      L17CE           ; to AUTO-L-1 until estimate reached.

; ---

; the jump was to here if S_TOP was greater than E_PPC

;; AUTO-L-2
L17E1:  LD      ($5C6C),HL      ; make S_TOP the same as E_PPC.

; continue here with valid starting point from above or good estimate
; from computation

;; AUTO-L-3
L17E4:  LD      HL,($5C6C)      ; fetch S_TOP line number to HL.
        CALL    L196E           ; routine LINE-ADDR gets address in HL.
                                ; address of next in DE.
        JR      Z,L17ED         ; to AUTO-L-4 if line exists.

        EX      DE,HL           ; else use address of next line.

;; AUTO-L-4
L17ED:  CALL    L1833           ; routine LIST-ALL                >>>

; The return will be to here if no scrolling occurred

        RES     4,(IY+$02)      ; update TV_FLAG  - signal no auto listing.
        RET                     ; return.

; ------------
; Handle LLIST
; ------------
; A short form of LIST #3. The listing goes to stream 3 - default printer.

;; LLIST
L17F5:  LD      A,$03           ; the usual stream for ZX Printer
        JR      L17FB           ; forward to LIST-1

; -----------
; Handle LIST
; -----------
; List to any stream.
; Note. While a starting line can be specified it is
; not possible to specify an end line.
; Just listing a line makes it the current edit line.

;; LIST
L17F9:  LD      A,$02           ; default is stream 2 - the upper screen.

;; LIST-1
L17FB:  LD      (IY+$02),$00    ; the TV_FLAG is initialized with bit 0 reset
                                ; indicating upper screen in use.
        CALL    L2530           ; routine SYNTAX-Z - checking syntax ?
        CALL    NZ,L1601        ; routine CHAN-OPEN if in run-time.

        RST     18H             ; GET-CHAR
        CALL    L2070           ; routine STR-ALTER will alter if '#'.
        JR      C,L181F         ; forward to LIST-4 not a '#' .


        RST     18H             ; GET-CHAR
        CP      $3B             ; is it ';' ?
        JR      Z,L1814         ; skip to LIST-2 if so.

        CP      $2C             ; is it ',' ?
        JR      NZ,L181A        ; forward to LIST-3 if neither separator.

; we have, say,  LIST #15, and a number must follow the separator.

;; LIST-2
L1814:  RST     20H             ; NEXT-CHAR
        CALL    L1C82           ; routine EXPT-1NUM
        JR      L1822           ; forward to LIST-5

; ---

; the branch was here with just LIST #3 etc.

;; LIST-3
L181A:  CALL    L1CE6           ; routine USE-ZERO
        JR      L1822           ; forward to LIST-5

; ---

; the branch was here with LIST

;; LIST-4
L181F:  CALL    L1CDE           ; routine FETCH-NUM checks if a number 
                                ; follows else uses zero.

;; LIST-5
L1822:  CALL    L1BEE           ; routine CHECK-END quits if syntax OK >>>

        CALL    L1E99           ; routine FIND-INT2 fetches the number
                                ; from the calculator stack in run-time.
        LD      A,B             ; fetch high byte of line number and
        AND     $3F             ; make less than $40 so that NEXT-ONE
                                ; (from LINE-ADDR) doesn't lose context.
                                ; Note. this is not satisfactory and the typo
                                ; LIST 20000 will list an entirely different
                                ; section than LIST 2000. Such typos are not
                                ; available for checking if they are direct
                                ; commands.

        LD      H,A             ; transfer the modified
        LD      L,C             ; line number to HL.
        LD      ($5C49),HL      ; update E_PPC to new line number.
        CALL    L196E           ; routine LINE-ADDR gets the address of the
                                ; line.

; This routine is called from AUTO-LIST

;; LIST-ALL
L1833:  LD      E,$01           ; signal current line not yet printed

;; LIST-ALL-2
L1835:  CALL    L1855           ; routine OUT-LINE outputs a BASIC line
                                ; using PRINT-OUT and makes an early return
                                ; when no more lines to print. >>>

        RST     10H             ; PRINT-A prints the carriage return (in A)

        BIT     4,(IY+$02)      ; test TV_FLAG  - automatic listing ?
        JR      Z,L1835         ; back to LIST-ALL-2 if not
                                ; (loop exit is via OUT-LINE)

; continue here if an automatic listing required.

        LD      A,($5C6B)       ; fetch DF_SZ lower display file size.
        SUB     (IY+$4F)        ; subtract S_POSN_hi ithe current line number.
        JR      NZ,L1835        ; back to LIST-ALL-2 if upper screen not full.

        XOR     E               ; A contains zero, E contains one if the
                                ; current edit line has not been printed
                                ; or zero if it has (from OUT-LINE).
        RET     Z               ; return if the screen is full and the line
                                ; has been printed.

; continue with automatic listings if the screen is full and the current
; edit line is missing. OUT-LINE will scroll automatically.

        PUSH    HL              ; save the pointer address.
        PUSH    DE              ; save the E flag.
        LD      HL,$5C6C        ; fetch S_TOP the rough estimate.
        CALL    L190F           ; routine LN-FETCH updates S_TOP with
                                ; the number of the next line.
        POP     DE              ; restore the E flag.
        POP     HL              ; restore the address of the next line.
        JR      L1835           ; back to LIST-ALL-2.

; ------------------------
; Print a whole BASIC line
; ------------------------
; This routine prints a whole BASIC line and it is called
; from LIST-ALL to output the line to current channel
; and from ED-EDIT to 'sprint' the line to the edit buffer.

;; OUT-LINE
L1855:  LD      BC,($5C49)      ; fetch E_PPC the current line which may be
                                ; unchecked and not exist.
        CALL    L1980           ; routine CP-LINES finds match or line after.
        LD      D,$3E           ; prepare cursor '>' in D.
        JR      Z,L1865         ; to OUT-LINE1 if matched or line after.

        LD      DE,$0000        ; put zero in D, to suppress line cursor.
        RL      E               ; pick up carry in E if line before current
                                ; leave E zero if same or after.

;; OUT-LINE1
L1865:  LD      (IY+$2D),E      ; save flag in BREG which is spare.
        LD      A,(HL)          ; get high byte of line number.
        CP      $40             ; is it too high ($2F is maximum possible) ?
        POP     BC              ; drop the return address and
        RET     NC              ; make an early return if so >>>

        PUSH    BC              ; save return address
        CALL    L1A28           ; routine OUT-NUM-2 to print addressed number
                                ; with leading space.
        INC     HL              ; skip low number byte.
        INC     HL              ; and the two
        INC     HL              ; length bytes.
        RES     0,(IY+$01)      ; update FLAGS - signal leading space required.
        LD      A,D             ; fetch the cursor.
        AND     A               ; test for zero.
        JR      Z,L1881         ; to OUT-LINE3 if zero.


        RST     10H             ; PRINT-A prints '>' the current line cursor.

; this entry point is called from ED-COPY

;; OUT-LINE2
L187D:  SET     0,(IY+$01)      ; update FLAGS - suppress leading space.

;; OUT-LINE3
L1881:  PUSH    DE              ; save flag E for a return value.
        EX      DE,HL           ; save HL address in DE.
        RES     2,(IY+$30)      ; update FLAGS2 - signal NOT in QUOTES.

        LD      HL,$5C3B        ; point to FLAGS.
        RES     2,(HL)          ; signal 'K' mode. (starts before keyword)
        BIT     5,(IY+$37)      ; test FLAGX - input mode ?
        JR      Z,L1894         ; forward to OUT-LINE4 if not.

        SET     2,(HL)          ; signal 'L' mode. (used for input)

;; OUT-LINE4
L1894:  LD      HL,($5C5F)      ; fetch X_PTR - possibly the error pointer
                                ; address.
        AND     A               ; clear the carry flag.
        SBC     HL,DE           ; test if an error address has been reached.
        JR      NZ,L18A1        ; forward to OUT-LINE5 if not.

        LD      A,$3F           ; load A with '?' the error marker.
        CALL    L18C1           ; routine OUT-FLASH to print flashing marker.

;; OUT-LINE5
L18A1:  CALL    L18E1           ; routine OUT-CURS will print the cursor if
                                ; this is the right position.
        EX      DE,HL           ; restore address pointer to HL.
        LD      A,(HL)          ; fetch the addressed character.
        CALL    L18B6           ; routine NUMBER skips a hidden floating 
                                ; point number if present.
        INC     HL              ; now increment the pointer.
        CP      $0D             ; is character end-of-line ?
        JR      Z,L18B4         ; to OUT-LINE6, if so, as line is finished.

        EX      DE,HL           ; save the pointer in DE.
        CALL    L1937           ; routine OUT-CHAR to output character/token.

        JR      L1894           ; back to OUT-LINE4 until entire line is done.

; ---

;; OUT-LINE6
L18B4:  POP     DE              ; bring back the flag E, zero if current
                                ; line printed else 1 if still to print.
        RET                     ; return with A holding $0D

; -------------------------
; Check for a number marker
; -------------------------
; this subroutine is called from two processes. while outputting BASIC lines
; and while searching statements within a BASIC line.
; during both, this routine will pass over an invisible number indicator
; and the five bytes floating-point number that follows it.
; Note that this causes floating point numbers to be stripped from
; the BASIC line when it is fetched to the edit buffer by OUT_LINE.
; the number marker also appears after the arguments of a DEF FN statement
; and may mask old 5-byte string parameters.

;; NUMBER
L18B6:  CP      $0E             ; character fourteen ?
        RET     NZ              ; return if not.

        INC     HL              ; skip the character
        INC     HL              ; and five bytes
        INC     HL              ; following.
        INC     HL              ;
        INC     HL              ;
        INC     HL              ;
        LD      A,(HL)          ; fetch the following character
        RET                     ; for return value.

; --------------------------
; Print a flashing character
; --------------------------
; This subroutine is called from OUT-LINE to print a flashing error
; marker '?' or from the next routine to print a flashing cursor e.g. 'L'.
; However, this only gets called from OUT-LINE when printing the edit line
; or the input buffer to the lower screen so a direct call to $09F4 can
; be used, even though out-line outputs to other streams.
; In fact the alternate set is used for the whole routine.

;; OUT-FLASH
L18C1:  EXX                     ; switch in alternate set

        LD      HL,($5C8F)      ; fetch L = ATTR_T, H = MASK-T
        PUSH    HL              ; save masks.
        RES     7,H             ; reset flash mask bit so active. 
        SET     7,L             ; make attribute FLASH.
        LD      ($5C8F),HL      ; resave ATTR_T and MASK-T

        LD      HL,$5C91        ; address P_FLAG
        LD      D,(HL)          ; fetch to D
        PUSH    DE              ; and save.
        LD      (HL),$00        ; clear inverse, over, ink/paper 9

        CALL    L09F4           ; routine PRINT-OUT outputs character
                                ; without the need to vector via RST 10.

        POP     HL              ; pop P_FLAG to H.
        LD      (IY+$57),H      ; and restore system variable P_FLAG.
        POP     HL              ; restore temporary masks
        LD      ($5C8F),HL      ; and restore system variables ATTR_T/MASK_T

        EXX                     ; switch back to main set
        RET                     ; return

; ----------------
; Print the cursor
; ----------------
; This routine is called before any character is output while outputting
; a BASIC line or the input buffer. This includes listing to a printer
; or screen, copying a BASIC line to the edit buffer and printing the
; input buffer or edit buffer to the lower screen. It is only in the
; latter two cases that it has any relevance and in the last case it
; performs another very important function also.

;; OUT-CURS
L18E1:  LD      HL,($5C5B)      ; fetch K_CUR the current cursor address
        AND     A               ; prepare for true subtraction.
        SBC     HL,DE           ; test against pointer address in DE and
        RET     NZ              ; return if not at exact position.

; the value of MODE, maintained by KEY-INPUT, is tested and if non-zero
; then this value 'E' or 'G' will take precedence.

        LD      A,($5C41)       ; fetch MODE  0='KLC', 1='E', 2='G'.
        RLC     A               ; double the value and set flags.
        JR      Z,L18F3         ; to OUT-C-1 if still zero ('KLC').

        ADD     A,$43           ; add 'C' - will become 'E' if originally 1
                                ; or 'G' if originally 2.
        JR      L1909           ; forward to OUT-C-2 to print.

; ---

; If mode was zero then, while printing a BASIC line, bit 2 of flags has been
; set if 'THEN' or ':' was encountered as a main character and reset otherwise.
; This is now used to determine if the 'K' cursor is to be printed but this
; transient state is also now transferred permanently to bit 3 of FLAGS
; to let the interrupt routine know how to decode the next key.

;; OUT-C-1
L18F3:  LD      HL,$5C3B        ; Address FLAGS
        RES     3,(HL)          ; signal 'K' mode initially.
        LD      A,$4B           ; prepare letter 'K'.
        BIT     2,(HL)          ; test FLAGS - was the
                                ; previous main character ':' or 'THEN' ?
        JR      Z,L1909         ; forward to OUT-C-2 if so to print.

        SET     3,(HL)          ; signal 'L' mode to interrupt routine.
                                ; Note. transient bit has been made permanent.
        INC     A               ; augment from 'K' to 'L'.

        BIT     3,(IY+$30)      ; test FLAGS2 - consider caps lock ?
                                ; which is maintained by KEY-INPUT.
        JR      Z,L1909         ; forward to OUT-C-2 if not set to print.

        LD      A,$43           ; alter 'L' to 'C'.

;; OUT-C-2
L1909:  PUSH    DE              ; save address pointer but OK as OUT-FLASH
                                ; uses alternate set without RST 10.

        CALL    L18C1           ; routine OUT-FLASH to print.

        POP     DE              ; restore and
        RET                     ; return.

; ----------------------------
; Get line number of next line
; ----------------------------
; These two subroutines are called while editing.
; This entry point is from ED-DOWN with HL addressing E_PPC
; to fetch the next line number.
; Also from AUTO-LIST with HL addressing S_TOP just to update S_TOP
; with the value of the next line number. It gets fetched but is discarded.
; These routines never get called while the editor is being used for input.

;; LN-FETCH
L190F:  LD      E,(HL)          ; fetch low byte
        INC     HL              ; address next
        LD      D,(HL)          ; fetch high byte.
        PUSH    HL              ; save system variable hi pointer.
        EX      DE,HL           ; line number to HL,
        INC     HL              ; increment as a starting point.
        CALL    L196E           ; routine LINE-ADDR gets address in HL.
        CALL    L1695           ; routine LINE-NO gets line number in DE.
        POP     HL              ; restore system variable hi pointer.

; This entry point is from the ED-UP with HL addressing E_PPC_hi

;; LN-STORE
L191C:  BIT     5,(IY+$37)      ; test FLAGX - input mode ?
        RET     NZ              ; return if so.
                                ; Note. above already checked by ED-UP/ED-DOWN.

        LD      (HL),D          ; save high byte of line number.
        DEC     HL              ; address lower
        LD      (HL),E          ; save low byte of line number.
        RET                     ; return.

; -----------------------------------------
; Outputting numbers at start of BASIC line
; -----------------------------------------
; This routine entered at OUT-SP-NO is used to compute then output the first
; three digits of a 4-digit BASIC line printing a space if necessary.
; The line number, or residual part, is held in HL and the BC register
; holds a subtraction value -1000, -100 or -10.
; Note. for example line number 200 -
; space(out_char), 2(out_code), 0(out_char) final number always out-code.

;; OUT-SP-2
L1925:  LD      A,E             ; will be space if OUT-CODE not yet called.
                                ; or $FF if spaces are suppressed.
                                ; else $30 ('0').
                                ; (from the first instruction at OUT-CODE)
                                ; this guy is just too clever.
        AND     A               ; test bit 7 of A.
        RET     M               ; return if $FF, as leading spaces not
                                ; required. This is set when printing line
                                ; number and statement in MAIN-5.

        JR      L1937           ; forward to exit via OUT-CHAR.

; ---

; -> the single entry point.

;; OUT-SP-NO
L192A:  XOR     A               ; initialize digit to 0

;; OUT-SP-1
L192B:  ADD     HL,BC           ; add negative number to HL.
        INC     A               ; increment digit
        JR      C,L192B         ; back to OUT-SP-1 until no carry from
                                ; the addition.

        SBC     HL,BC           ; cancel the last addition
        DEC     A               ; and decrement the digit.
        JR      Z,L1925         ; back to OUT-SP-2 if it is zero.

        JP      L15EF           ; jump back to exit via OUT-CODE.    ->


; -------------------------------------
; Outputting characters in a BASIC line
; -------------------------------------
; This subroutine ...

;; OUT-CHAR
L1937:  CALL    L2D1B           ; routine NUMERIC tests if it is a digit ?
        JR      NC,L196C        ; to OUT-CH-3 to print digit without
                                ; changing mode. Will be 'K' mode if digits
                                ; are at beginning of edit line.

        CP      $21             ; less than quote character ?
        JR      C,L196C         ; to OUT-CH-3 to output controls and space.

        RES     2,(IY+$01)      ; initialize FLAGS to 'K' mode and leave
                                ; unchanged if this character would precede
                                ; a keyword.

        CP      $CB             ; is character 'THEN' token ?
        JR      Z,L196C         ; to OUT-CH-3 to output if so.

        CP      $3A             ; is it ':' ?
        JR      NZ,L195A        ; to OUT-CH-1 if not statement separator
                                ; to change mode back to 'L'.

        BIT     5,(IY+$37)      ; FLAGX  - Input Mode ??
        JR      NZ,L1968        ; to OUT-CH-2 if in input as no statements.
                                ; Note. this check should seemingly be at
                                ; the start. Commands seem inappropriate in
                                ; INPUT mode and are rejected by the syntax
                                ; checker anyway.
                                ; unless INPUT LINE is being used.

        BIT     2,(IY+$30)      ; test FLAGS2 - is the ':' within quotes ?
        JR      Z,L196C         ; to OUT-CH-3 if ':' is outside quoted text.

        JR      L1968           ; to OUT-CH-2 as ':' is within quotes

; ---

;; OUT-CH-1
L195A:  CP      $22             ; is it quote character '"'  ?
        JR      NZ,L1968        ; to OUT-CH-2 with others to set 'L' mode.

        PUSH    AF              ; save character.
        LD      A,($5C6A)       ; fetch FLAGS2.
        XOR     $04             ; toggle the quotes flag.
        LD      ($5C6A),A       ; update FLAGS2
        POP     AF              ; and restore character.

;; OUT-CH-2
L1968:  SET     2,(IY+$01)      ; update FLAGS - signal L mode if the cursor
                                ; is next.

;; OUT-CH-3
L196C:  RST     10H             ; PRINT-A vectors the character to
                                ; channel 'S', 'K', 'R' or 'P'.
        RET                     ; return.

; -------------------------------------------
; Get starting address of line, or line after
; -------------------------------------------
; This routine is used often to get the address, in HL, of a BASIC line
; number supplied in HL, or failing that the address of the following line
; and the address of the previous line in DE.

;; LINE-ADDR
L196E:  PUSH    HL              ; save line number in HL register
        LD      HL,($5C53)      ; fetch start of program from PROG
        LD      D,H             ; transfer address to
        LD      E,L             ; the DE register pair.

;; LINE-AD-1
L1974:  POP     BC              ; restore the line number to BC
        CALL    L1980           ; routine CP-LINES compares with that
                                ; addressed by HL
        RET     NC              ; return if line has been passed or matched.
                                ; if NZ, address of previous is in DE

        PUSH    BC              ; save the current line number
        CALL    L19B8           ; routine NEXT-ONE finds address of next
                                ; line number in DE, previous in HL.
        EX      DE,HL           ; switch so next in HL
        JR      L1974           ; back to LINE-AD-1 for another comparison

; --------------------
; Compare line numbers
; --------------------
; This routine compares a line number supplied in BC with an addressed
; line number pointed to by HL.

;; CP-LINES
L1980:  LD      A,(HL)          ; Load the high byte of line number and
        CP      B               ; compare with that of supplied line number.
        RET     NZ              ; return if yet to match (carry will be set).

        INC     HL              ; address low byte of
        LD      A,(HL)          ; number and pick up in A.
        DEC     HL              ; step back to first position.
        CP      C               ; now compare.
        RET                     ; zero set if exact match.
                                ; carry set if yet to match.
                                ; no carry indicates a match or
                                ; next available BASIC line or
                                ; program end marker.

; -------------------
; Find each statement
; -------------------
; The single entry point EACH-STMT is used to
; 1) To find the D'th statement in a line.
; 2) To find a token in held E.

;; not-used
L1988:  INC     HL              ;
        INC     HL              ;
        INC     HL              ;

; -> entry point.

;; EACH-STMT
L198B:  LD      ($5C5D),HL      ; save HL in CH_ADD
        LD      C,$00           ; initialize quotes flag

;; EACH-S-1
L1990:  DEC     D               ; decrease statement count
        RET     Z               ; return if zero


        RST     20H             ; NEXT-CHAR
        CP      E               ; is it the search token ?
        JR      NZ,L199A        ; forward to EACH-S-3 if not

        AND     A               ; clear carry
        RET                     ; return signalling success.

; ---

;; EACH-S-2
L1998:  INC     HL              ; next address
        LD      A,(HL)          ; next character

;; EACH-S-3
L199A:  CALL    L18B6           ; routine NUMBER skips if number marker
        LD      ($5C5D),HL      ; save in CH_ADD
        CP      $22             ; is it quotes '"' ?
        JR      NZ,L19A5        ; to EACH-S-4 if not

        DEC     C               ; toggle bit 0 of C

;; EACH-S-4
L19A5:  CP      $3A             ; is it ':'
        JR      Z,L19AD         ; to EACH-S-5

        CP      $CB             ; 'THEN'
        JR      NZ,L19B1        ; to EACH-S-6

;; EACH-S-5
L19AD:  BIT     0,C             ; is it in quotes
        JR      Z,L1990         ; to EACH-S-1 if not

;; EACH-S-6
L19B1:  CP      $0D             ; end of line ?
        JR      NZ,L1998        ; to EACH-S-2

        DEC     D               ; decrease the statement counter
                                ; which should be zero else
                                ; 'Statement Lost'.
        SCF                     ; set carry flag - not found
        RET                     ; return

; -----------------------------------------------------------------------
; Storage of variables. For full details - see chapter 24.
; ZX Spectrum BASIC Programming by Steven Vickers 1982.
; It is bits 7-5 of the first character of a variable that allow
; the six types to be distinguished. Bits 4-0 are the reduced letter.
; So any variable name is higher that $3F and can be distinguished
; also from the variables area end-marker $80.
;
; 76543210 meaning                               brief outline of format.
; -------- ------------------------              -----------------------
; 010      string variable.                      2 byte length + contents.
; 110      string array.                         2 byte length + contents.
; 100      array of numbers.                     2 byte length + contents.
; 011      simple numeric variable.              5 bytes.
; 101      variable length named numeric.        5 bytes.
; 111      for-next loop variable.               18 bytes.
; 10000000 the variables area end-marker.
;
; Note. any of the above seven will serve as a program end-marker.
;
; -----------------------------------------------------------------------

; ------------
; Get next one
; ------------
; This versatile routine is used to find the address of the next line
; in the program area or the next variable in the variables area.
; The reason one routine is made to handle two apparently unrelated tasks
; is that it can be called indiscriminately when merging a line or a
; variable.

;; NEXT-ONE
L19B8:  PUSH    HL              ; save the pointer address.
        LD      A,(HL)          ; get first byte.
        CP      $40             ; compare with upper limit for line numbers.
        JR      C,L19D5         ; forward to NEXT-O-3 if within BASIC area.

; the continuation here is for the next variable unless the supplied
; line number was erroneously over 16383. see RESTORE command.

        BIT     5,A             ; is it a string or an array variable ?
        JR      Z,L19D6         ; forward to NEXT-O-4 to compute length.

        ADD     A,A             ; test bit 6 for single-character variables.
        JP      M,L19C7         ; forward to NEXT-O-1 if so

        CCF                     ; clear the carry for long-named variables.
                                ; it remains set for for-next loop variables.

;; NEXT-O-1
L19C7:  LD      BC,$0005        ; set BC to 5 for floating point number
        JR      NC,L19CE        ; forward to NEXT-O-2 if not a for/next
                                ; variable.

        LD      C,$12           ; set BC to eighteen locations.
                                ; value, limit, step, line and statement.

; now deal with long-named variables

;; NEXT-O-2
L19CE:  RLA                     ; test if character inverted. carry will also
                                ; be set for single character variables
        INC     HL              ; address next location.
        LD      A,(HL)          ; and load character.
        JR      NC,L19CE        ; back to NEXT-O-2 if not inverted bit.
                                ; forward immediately with single character
                                ; variable names.

        JR      L19DB           ; forward to NEXT-O-5 to add length of
                                ; floating point number(s etc.).

; ---

; this branch is for line numbers.

;; NEXT-O-3
L19D5:  INC     HL              ; increment pointer to low byte of line no.

; strings and arrays rejoin here

;; NEXT-O-4
L19D6:  INC     HL              ; increment to address the length low byte.
        LD      C,(HL)          ; transfer to C and
        INC     HL              ; point to high byte of length.
        LD      B,(HL)          ; transfer that to B
        INC     HL              ; point to start of BASIC/variable contents.

; the three types of numeric variables rejoin here

;; NEXT-O-5
L19DB:  ADD     HL,BC           ; add the length to give address of next
                                ; line/variable in HL.
        POP     DE              ; restore previous address to DE.

; ------------------
; Difference routine
; ------------------
; This routine terminates the above routine and is also called from the
; start of the next routine to calculate the length to reclaim.

;; DIFFER
L19DD:  AND     A               ; prepare for true subtraction.
        SBC     HL,DE           ; subtract the two pointers.
        LD      B,H             ; transfer result
        LD      C,L             ; to BC register pair.
        ADD     HL,DE           ; add back
        EX      DE,HL           ; and switch pointers
        RET                     ; return values are the length of area in BC,
                                ; low pointer (previous) in HL,
                                ; high pointer (next) in DE.

; -----------------------
; Handle reclaiming space
; -----------------------
;

;; RECLAIM-1
L19E5:  CALL    L19DD           ; routine DIFFER immediately above

;; RECLAIM-2
L19E8:  PUSH    BC              ;

        LD      A,B             ;
        CPL                     ;
        LD      B,A             ;
        LD      A,C             ;
        CPL                     ;
        LD      C,A             ;
        INC     BC              ;

        CALL    L1664           ; routine POINTERS
        EX      DE,HL           ;
        POP     HL              ;

        ADD     HL,DE           ;
        PUSH    DE              ;
        LDIR                    ; copy bytes

        POP     HL              ;
        RET                     ;

; ----------------------------------------
; Read line number of line in editing area
; ----------------------------------------
; This routine reads a line number in the editing area returning the number
; in the BC register or zero if no digits exist before commands.
; It is called from LINE-SCAN to check the syntax of the digits.
; It is called from MAIN-3 to extract the line number in preparation for
; inclusion of the line in the BASIC program area.
;
; Interestingly the calculator stack is moved from its normal place at the
; end of dynamic memory to an adequate area within the system variables area.
; This ensures that in a low memory situation, that valid line numbers can
; be extracted without raising an error and that memory can be reclaimed
; by deleting lines. If the stack was in its normal place then a situation
; arises whereby the Spectrum becomes locked with no means of reclaiming space.

;; E-LINE-NO
L19FB:  LD      HL,($5C59)      ; load HL from system variable E_LINE.

        DEC     HL              ; decrease so that NEXT_CHAR can be used
                                ; without skipping the first digit.

        LD      ($5C5D),HL      ; store in the system variable CH_ADD.

        RST     20H             ; NEXT-CHAR skips any noise and white-space
                                ; to point exactly at the first digit.

        LD      HL,$5C92        ; use MEM-0 as a temporary calculator stack
                                ; an overhead of three locations are needed.
        LD      ($5C65),HL      ; set new STKEND.

        CALL    L2D3B           ; routine INT-TO-FP will read digits till
                                ; a non-digit found.
        CALL    L2DA2           ; routine FP-TO-BC will retrieve number
                                ; from stack at membot.
        JR      C,L1A15         ; forward to E-L-1 if overflow i.e. > 65535.
                                ; 'Nonsense in BASIC'

        LD      HL,$D8F0        ; load HL with value -9999
        ADD     HL,BC           ; add to line number in BC

;; E-L-1
L1A15:  JP      C,L1C8A         ; to REPORT-C 'Nonsense in BASIC' if over.
                                ; Note. As ERR_SP points to ED_ERROR
                                ; the report is never produced although
                                ; the RST $08 will update X_PTR leading to
                                ; the error marker being displayed when
                                ; the ED_LOOP is reiterated.
                                ; in fact, since it is immediately
                                ; cancelled, any report will do.

; a line in the range 0 - 9999 has been entered.

        JP      L16C5           ; jump back to SET-STK to set the calculator 
                                ; stack back to its normal place and exit 
                                ; from there.

; ---------------------------------
; Report and line number outputting
; ---------------------------------
; Entry point OUT-NUM-1 is used by the Error Reporting code to print
; the line number and later the statement number held in BC.
; If the statement was part of a direct command then -2 is used as a
; dummy line number so that zero will be printed in the report.
; This routine is also used to print the exponent of E-format numbers.
;
; Entry point OUT-NUM-2 is used from OUT-LINE to output the line number
; addressed by HL with leading spaces if necessary.

;; OUT-NUM-1
L1A1B:  PUSH    DE              ; save the
        PUSH    HL              ; registers.
        XOR     A               ; set A to zero.
        BIT     7,B             ; is the line number minus two ?
        JR      NZ,L1A42        ; forward to OUT-NUM-4 if so to print zero 
                                ; for a direct command.

        LD      H,B             ; transfer the
        LD      L,C             ; number to HL.
        LD      E,$FF           ; signal 'no leading zeros'.
        JR      L1A30           ; forward to continue at OUT-NUM-3

; ---

; from OUT-LINE - HL addresses line number.

;; OUT-NUM-2
L1A28:  PUSH    DE              ; save flags
        LD      D,(HL)          ; high byte to D
        INC     HL              ; address next
        LD      E,(HL)          ; low byte to E
        PUSH    HL              ; save pointer
        EX      DE,HL           ; transfer number to HL
        LD      E,$20           ; signal 'output leading spaces'

;; OUT-NUM-3
L1A30:  LD      BC,$FC18        ; value -1000
        CALL    L192A           ; routine OUT-SP-NO outputs space or number
        LD      BC,$FF9C        ; value -100
        CALL    L192A           ; routine OUT-SP-NO
        LD      C,$F6           ; value -10 ( B is still $FF )
        CALL    L192A           ; routine OUT-SP-NO
        LD      A,L             ; remainder to A.

;; OUT-NUM-4
L1A42:  CALL    L15EF           ; routine OUT-CODE for final digit.
                                ; else report code zero wouldn't get
                                ; printed.
        POP     HL              ; restore the
        POP     DE              ; registers and
        RET                     ; return.


;***************************************************
;** Part 7. BASIC LINE AND COMMAND INTERPRETATION **
;***************************************************

; ----------------
; The offset table
; ----------------
; The BASIC interpreter has found a command code $CE - $FF
; which is then reduced to range $00 - $31 and added to the base address
; of this table to give the address of an offset which, when added to
; the offset therein, gives the location in the following parameter table
; where a list of class codes, separators and addresses relevant to the
; command exists.

;; offst-tbl
L1A48:  DEFB    L1AF9 - $       ; B1 offset to Address: P-DEF-FN
        DEFB    L1B14 - $       ; CB offset to Address: P-CAT
        DEFB    L1B06 - $       ; BC offset to Address: P-FORMAT
        DEFB    L1B0A - $       ; BF offset to Address: P-MOVE
        DEFB    L1B10 - $       ; C4 offset to Address: P-ERASE
        DEFB    L1AFC - $       ; AF offset to Address: P-OPEN
        DEFB    L1B02 - $       ; B4 offset to Address: P-CLOSE
        DEFB    L1AE2 - $       ; 93 offset to Address: P-MERGE
        DEFB    L1AE1 - $       ; 91 offset to Address: P-VERIFY
        DEFB    L1AE3 - $       ; 92 offset to Address: P-BEEP
        DEFB    L1AE7 - $       ; 95 offset to Address: P-CIRCLE
        DEFB    L1AEB - $       ; 98 offset to Address: P-INK
        DEFB    L1AEC - $       ; 98 offset to Address: P-PAPER
        DEFB    L1AED - $       ; 98 offset to Address: P-FLASH
        DEFB    L1AEE - $       ; 98 offset to Address: P-BRIGHT
        DEFB    L1AEF - $       ; 98 offset to Address: P-INVERSE
        DEFB    L1AF0 - $       ; 98 offset to Address: P-OVER
        DEFB    L1AF1 - $       ; 98 offset to Address: P-OUT
        DEFB    L1AD9 - $       ; 7F offset to Address: P-LPRINT
        DEFB    L1ADC - $       ; 81 offset to Address: P-LLIST
        DEFB    L1A8A - $       ; 2E offset to Address: P-STOP
        DEFB    L1AC9 - $       ; 6C offset to Address: P-READ
        DEFB    L1ACC - $       ; 6E offset to Address: P-DATA
        DEFB    L1ACF - $       ; 70 offset to Address: P-RESTORE
        DEFB    L1AA8 - $       ; 48 offset to Address: P-NEW
        DEFB    L1AF5 - $       ; 94 offset to Address: P-BORDER
        DEFB    L1AB8 - $       ; 56 offset to Address: P-CONT
        DEFB    L1AA2 - $       ; 3F offset to Address: P-DIM
        DEFB    L1AA5 - $       ; 41 offset to Address: P-REM
        DEFB    L1A90 - $       ; 2B offset to Address: P-FOR
        DEFB    L1A7D - $       ; 17 offset to Address: P-GO-TO
        DEFB    L1A86 - $       ; 1F offset to Address: P-GO-SUB
        DEFB    L1A9F - $       ; 37 offset to Address: P-INPUT
        DEFB    L1AE0 - $       ; 77 offset to Address: P-LOAD
        DEFB    L1AAE - $       ; 44 offset to Address: P-LIST
        DEFB    L1A7A - $       ; 0F offset to Address: P-LET
        DEFB    L1AC5 - $       ; 59 offset to Address: P-PAUSE
        DEFB    L1A98 - $       ; 2B offset to Address: P-NEXT
        DEFB    L1AB1 - $       ; 43 offset to Address: P-POKE
        DEFB    L1A9C - $       ; 2D offset to Address: P-PRINT
        DEFB    L1AC1 - $       ; 51 offset to Address: P-PLOT
        DEFB    L1AAB - $       ; 3A offset to Address: P-RUN
        DEFB    L1ADF - $       ; 6D offset to Address: P-SAVE
        DEFB    L1AB5 - $       ; 42 offset to Address: P-RANDOM
        DEFB    L1A81 - $       ; 0D offset to Address: P-IF
        DEFB    L1ABE - $       ; 49 offset to Address: P-CLS
        DEFB    L1AD2 - $       ; 5C offset to Address: P-DRAW
        DEFB    L1ABB - $       ; 44 offset to Address: P-CLEAR
        DEFB    L1A8D - $       ; 15 offset to Address: P-RETURN
        DEFB    L1AD6 - $       ; 5D offset to Address: P-COPY


; -------------------------------
; The parameter or "Syntax" table
; -------------------------------
; For each command there exists a variable list of parameters.
; If the character is greater than a space it is a required separator.
; If less, then it is a command class in the range 00 - 0B.
; Note that classes 00, 03 and 05 will fetch the addresses from this table.
; Some classes e.g. 07 and 0B have the same address in all invocations
; and the command is re-computed from the low-byte of the parameter address.
; Some e.g. 02 are only called once so a call to the command is made from
; within the class routine rather than holding the address within the table.
; Some class routines check syntax entirely and some leave this task for the
; command itself.
; Others for example CIRCLE (x,y,z) check the first part (x,y) using the
; class routine and the final part (,z) within the command.
; The last few commands appear to have been added in a rush but their syntax
; is rather simple e.g. MOVE "M1","M2"

;; P-LET
L1A7A:  DEFB    $01             ; Class-01 - A variable is required.
        DEFB    $3D             ; Separator:  '='
        DEFB    $02             ; Class-02 - An expression, numeric or string,
                                ; must follow.

;; P-GO-TO
L1A7D:  DEFB    $06             ; Class-06 - A numeric expression must follow.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1E67           ; Address: $1E67; Address: GO-TO

;; P-IF
L1A81:  DEFB    $06             ; Class-06 - A numeric expression must follow.
        DEFB    $CB             ; Separator:  'THEN'
        DEFB    $05             ; Class-05 - Variable syntax checked
                                ; by routine.
        DEFW    L1CF0           ; Address: $1CF0; Address: IF

;; P-GO-SUB
L1A86:  DEFB    $06             ; Class-06 - A numeric expression must follow.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1EED           ; Address: $1EED; Address: GO-SUB

;; P-STOP
L1A8A:  DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1CEE           ; Address: $1CEE; Address: STOP

;; P-RETURN
L1A8D:  DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1F23           ; Address: $1F23; Address: RETURN

;; P-FOR
L1A90:  DEFB    $04             ; Class-04 - A single character variable must
                                ; follow.
        DEFB    $3D             ; Separator:  '='
        DEFB    $06             ; Class-06 - A numeric expression must follow.
        DEFB    $CC             ; Separator:  'TO'
        DEFB    $06             ; Class-06 - A numeric expression must follow.
        DEFB    $05             ; Class-05 - Variable syntax checked
                                ; by routine.
        DEFW    L1D03           ; Address: $1D03; Address: FOR

;; P-NEXT
L1A98:  DEFB    $04             ; Class-04 - A single character variable must
                                ; follow.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1DAB           ; Address: $1DAB; Address: NEXT

;; P-PRINT
L1A9C:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
                                ; by routine.
        DEFW    L1FCD           ; Address: $1FCD; Address: PRINT

;; P-INPUT
L1A9F:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
                                ; by routine.
        DEFW    L2089           ; Address: $2089; Address: INPUT

;; P-DIM
L1AA2:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
                                ; by routine.
        DEFW    L2C02           ; Address: $2C02; Address: DIM

;; P-REM
L1AA5:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
                                ; by routine.
        DEFW    L1BB2           ; Address: $1BB2; Address: REM

;; P-NEW
L1AA8:  DEFB    $00             ; Class-00 - No further operands.
        DEFW    L11B7           ; Address: $11B7; Address: NEW

;; P-RUN
L1AAB:  DEFB    $03             ; Class-03 - A numeric expression may follow
                                ; else default to zero.
        DEFW    L1EA1           ; Address: $1EA1; Address: RUN

;; P-LIST
L1AAE:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
                                ; by routine.
        DEFW    L17F9           ; Address: $17F9; Address: LIST

;; P-POKE
L1AB1:  DEFB    $08             ; Class-08 - Two comma-separated numeric
                                ; expressions required.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1E80           ; Address: $1E80; Address: POKE

;; P-RANDOM
L1AB5:  DEFB    $03             ; Class-03 - A numeric expression may follow
                                ; else default to zero.
        DEFW    L1E4F           ; Address: $1E4F; Address: RANDOMIZE

;; P-CONT
L1AB8:  DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1E5F           ; Address: $1E5F; Address: CONTINUE

;; P-CLEAR
L1ABB:  DEFB    $03             ; Class-03 - A numeric expression may follow
                                ; else default to zero.
        DEFW    L1EAC           ; Address: $1EAC; Address: CLEAR

;; P-CLS
L1ABE:  DEFB    $00             ; Class-00 - No further operands.
        DEFW    L0D6B           ; Address: $0D6B; Address: CLS

;; P-PLOT
L1AC1:  DEFB    $09             ; Class-09 - Two comma-separated numeric
                                ; expressions required with optional colour
                                ; items.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L22DC           ; Address: $22DC; Address: PLOT

;; P-PAUSE
L1AC5:  DEFB    $06             ; Class-06 - A numeric expression must follow.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1F3A           ; Address: $1F3A; Address: PAUSE

;; P-READ
L1AC9:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
                                ; by routine.
        DEFW    L1DED           ; Address: $1DED; Address: READ

;; P-DATA
L1ACC:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
                                ; by routine.
        DEFW    L1E27           ; Address: $1E27; Address: DATA

;; P-RESTORE
L1ACF:  DEFB    $03             ; Class-03 - A numeric expression may follow
                                ; else default to zero.
        DEFW    L1E42           ; Address: $1E42; Address: RESTORE

;; P-DRAW
L1AD2:  DEFB    $09             ; Class-09 - Two comma-separated numeric
                                ; expressions required with optional colour
                                ; items.
        DEFB    $05             ; Class-05 - Variable syntax checked
                                ; by routine.
        DEFW    L2382           ; Address: $2382; Address: DRAW

;; P-COPY
L1AD6:  DEFB    $00             ; Class-00 - No further operands.
        DEFW    L0EAC           ; Address: $0EAC; Address: COPY

;; P-LPRINT
L1AD9:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
                                ; by routine.
        DEFW    L1FC9           ; Address: $1FC9; Address: LPRINT

;; P-LLIST
L1ADC:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
                                ; by routine.
        DEFW    L17F5           ; Address: $17F5; Address: LLIST

;; P-SAVE
L1ADF:  DEFB    $0B             ; Class-0B - Offset address converted to tape
                                ; command.

;; P-LOAD
L1AE0:  DEFB    $0B             ; Class-0B - Offset address converted to tape
                                ; command.

;; P-VERIFY
L1AE1:  DEFB    $0B             ; Class-0B - Offset address converted to tape
                                ; command.

;; P-MERGE
L1AE2:  DEFB    $0B             ; Class-0B - Offset address converted to tape
                                ; command.

;; P-BEEP
L1AE3:  DEFB    $08             ; Class-08 - Two comma-separated numeric
                                ; expressions required.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L03F8           ; Address: $03F8; Address: BEEP

;; P-CIRCLE
L1AE7:  DEFB    $09             ; Class-09 - Two comma-separated numeric
                                ; expressions required with optional colour
                                ; items.
        DEFB    $05             ; Class-05 - Variable syntax checked
                                ; by routine.
        DEFW    L2320           ; Address: $2320; Address: CIRCLE

;; P-INK
L1AEB:  DEFB    $07             ; Class-07 - Offset address is converted to
                                ; colour code.

;; P-PAPER
L1AEC:  DEFB    $07             ; Class-07 - Offset address is converted to
                                ; colour code.

;; P-FLASH
L1AED:  DEFB    $07             ; Class-07 - Offset address is converted to
                                ; colour code.

;; P-BRIGHT
L1AEE:  DEFB    $07             ; Class-07 - Offset address is converted to
                                ; colour code.

;; P-INVERSE
L1AEF:  DEFB    $07             ; Class-07 - Offset address is converted to
                                ; colour code.

;; P-OVER
L1AF0:  DEFB    $07             ; Class-07 - Offset address is converted to
                                ; colour code.

;; P-OUT
L1AF1:  DEFB    $08             ; Class-08 - Two comma-separated numeric
                                ; expressions required.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1E7A           ; Address: $1E7A; Address: OUT

;; P-BORDER
L1AF5:  DEFB    $06             ; Class-06 - A numeric expression must follow.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L2294           ; Address: $2294; Address: BORDER

;; P-DEF-FN
L1AF9:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
                                ; by routine.
        DEFW    L1F60           ; Address: $1F60; Address: DEF-FN

;; P-OPEN
L1AFC:  DEFB    $06             ; Class-06 - A numeric expression must follow.
        DEFB    $2C             ; Separator:  ','          see Footnote *
        DEFB    $0A             ; Class-0A - A string expression must follow.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1736           ; Address: $1736; Address: OPEN

;; P-CLOSE
L1B02:  DEFB    $06             ; Class-06 - A numeric expression must follow.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L16E5           ; Address: $16E5; Address: CLOSE

;; P-FORMAT
L1B06:  DEFB    $0A             ; Class-0A - A string expression must follow.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1793           ; Address: $1793; Address: CAT-ETC

;; P-MOVE
L1B0A:  DEFB    $0A             ; Class-0A - A string expression must follow.
        DEFB    $2C             ; Separator:  ','
        DEFB    $0A             ; Class-0A - A string expression must follow.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1793           ; Address: $1793; Address: CAT-ETC

;; P-ERASE
L1B10:  DEFB    $0A             ; Class-0A - A string expression must follow.
        DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1793           ; Address: $1793; Address: CAT-ETC

;; P-CAT
L1B14:  DEFB    $00             ; Class-00 - No further operands.
        DEFW    L1793           ; Address: $1793; Address: CAT-ETC

; * Note that a comma is required as a separator with the OPEN command
; but the Interface 1 programmers relaxed this allowing ';' as an
; alternative for their channels creating a confusing mixture of
; allowable syntax as it is this ROM which opens or re-opens the
; normal channels.

; -------------------------------
; Main parser (BASIC interpreter)
; -------------------------------
; This routine is called once from MAIN-2 when the BASIC line is to
; be entered or re-entered into the Program area and the syntax
; requires checking.

;; LINE-SCAN
L1B17:  RES     7,(IY+$01)      ; update FLAGS - signal checking syntax
        CALL    L19FB           ; routine E-LINE-NO              >>
                                ; fetches the line number if in range.

        XOR     A               ; clear the accumulator.
        LD      ($5C47),A       ; set statement number SUBPPC to zero.
        DEC     A               ; set accumulator to $FF.
        LD      ($5C3A),A       ; set ERR_NR to 'OK' - 1.
        JR      L1B29           ; forward to continue at STMT-L-1.

; --------------
; Statement loop
; --------------
;
;

;; STMT-LOOP
L1B28:  RST     20H             ; NEXT-CHAR

; -> the entry point from above or LINE-RUN
;; STMT-L-1
L1B29:  CALL    L16BF           ; routine SET-WORK clears workspace etc.

        INC     (IY+$0D)        ; increment statement number SUBPPC
        JP      M,L1C8A         ; to REPORT-C to raise
                                ; 'Nonsense in BASIC' if over 127.

        RST     18H             ; GET-CHAR

        LD      B,$00           ; set B to zero for later indexing.
                                ; early so any other reason ???

        CP      $0D             ; is character carriage return ?
                                ; i.e. an empty statement.
        JR      Z,L1BB3         ; forward to LINE-END if so.

        CP      $3A             ; is it statement end marker ':' ?
                                ; i.e. another type of empty statement.
        JR      Z,L1B28         ; back to STMT-LOOP if so.

        LD      HL,L1B76        ; address: STMT-RET
        PUSH    HL              ; is now pushed as a return address
        LD      C,A             ; transfer the current character to C.

; advance CH_ADD to a position after command and test if it is a command.

        RST     20H             ; NEXT-CHAR to advance pointer
        LD      A,C             ; restore current character
        SUB     $CE             ; subtract 'DEF FN' - first command
        JP      C,L1C8A         ; jump to REPORT-C if less than a command
                                ; raising 
                                ; 'Nonsense in BASIC'

        LD      C,A             ; put the valid command code back in C.
                                ; register B is zero.
        LD      HL,L1A48        ; address: offst-tbl
        ADD     HL,BC           ; index into table with one of 50 commands.
        LD      C,(HL)          ; pick up displacement to syntax table entry.
        ADD     HL,BC           ; add to address the relevant entry.
        JR      L1B55           ; forward to continue at GET-PARAM

; ----------------------
; The main scanning loop
; ----------------------
; not documented properly
;

;; SCAN-LOOP
L1B52:  LD      HL,($5C74)      ; fetch temporary address from T_ADDR
                                ; during subsequent loops.

; -> the initial entry point with HL addressing start of syntax table entry.

;; GET-PARAM
L1B55:  LD      A,(HL)          ; pick up the parameter.
        INC     HL              ; address next one.
        LD      ($5C74),HL      ; save pointer in system variable T_ADDR

        LD      BC,L1B52        ; address: SCAN-LOOP
        PUSH    BC              ; is now pushed on stack as looping address.
        LD      C,A             ; store parameter in C.
        CP      $20             ; is it greater than ' '  ?
        JR      NC,L1B6F        ; forward to SEPARATOR to check that correct
                                ; separator appears in statement if so.

        LD      HL,L1C01        ; address: class-tbl.
        LD      B,$00           ; prepare to index into the class table.
        ADD     HL,BC           ; index to find displacement to routine.
        LD      C,(HL)          ; displacement to BC
        ADD     HL,BC           ; add to address the CLASS routine.
        PUSH    HL              ; push the address on the stack.

        RST     18H             ; GET-CHAR - HL points to place in statement.

        DEC     B               ; reset the zero flag - the initial state
                                ; for all class routines.

        RET                     ; and make an indirect jump to routine
                                ; and then SCAN-LOOP (also on stack).

; Note. one of the class routines will eventually drop the return address
; off the stack breaking out of the above seemingly endless loop.

; -----------------------
; THE 'SEPARATOR' ROUTINE
; -----------------------
;   This routine is called once to verify that the mandatory separator
;   present in the parameter table is also present in the correct
;   location following the command.  For example, the 'THEN' token after
;   the 'IF' token and expression.

;; SEPARATOR
L1B6F:  RST     18H             ; GET-CHAR
        CP      C               ; does it match the character in C ?
        JP      NZ,L1C8A        ; jump forward to REPORT-C if not
                                ; 'Nonsense in BASIC'.

        RST     20H             ; NEXT-CHAR advance to next character
        RET                     ; return.

; ------------------------------
; Come here after interpretation
; ------------------------------
;
;

;; STMT-RET
L1B76:  CALL    L1F54           ; routine BREAK-KEY is tested after every
                                ; statement.
        JR      C,L1B7D         ; step forward to STMT-R-1 if not pressed.

;; REPORT-L
L1B7B:  RST     08H             ; ERROR-1
        DEFB    $14             ; Error Report: BREAK into program

;; STMT-R-1
L1B7D:  BIT     7,(IY+$0A)      ; test NSPPC - will be set if $FF -
                                ; no jump to be made.
        JR      NZ,L1BF4        ; forward to STMT-NEXT if a program line.

        LD      HL,($5C42)      ; fetch line number from NEWPPC
        BIT     7,H             ; will be set if minus two - direct command(s)
        JR      Z,L1B9E         ; forward to LINE-NEW if a jump is to be
                                ; made to a new program line/statement.

; --------------------
; Run a direct command
; --------------------
; A direct command is to be run or, if continuing from above,
; the next statement of a direct command is to be considered.

;; LINE-RUN
L1B8A:  LD      HL,$FFFE        ; The dummy value minus two
        LD      ($5C45),HL      ; is set/reset as line number in PPC.
        LD      HL,($5C61)      ; point to end of line + 1 - WORKSP.
        DEC     HL              ; now point to $80 end-marker.
        LD      DE,($5C59)      ; address the start of line E_LINE.
        DEC     DE              ; now location before - for GET-CHAR.
        LD      A,($5C44)       ; load statement to A from NSPPC.
        JR      L1BD1           ; forward to NEXT-LINE.

; ------------------------------
; Find start address of new line
; ------------------------------
; The branch was to here if a jump is to made to a new line number
; and statement.
; That is the previous statement was a GO TO, GO SUB, RUN, RETURN, NEXT etc..

;; LINE-NEW
L1B9E:  CALL    L196E           ; routine LINE-ADDR gets address of line
                                ; returning zero flag set if line found.
        LD      A,($5C44)       ; fetch new statement from NSPPC
        JR      Z,L1BBF         ; forward to LINE-USE if line matched.

; continue as must be a direct command.

        AND     A               ; test statement which should be zero
        JR      NZ,L1BEC        ; forward to REPORT-N if not.
                                ; 'Statement lost'

; 

        LD      B,A             ; save statement in B.??
        LD      A,(HL)          ; fetch high byte of line number.
        AND     $C0             ; test if using direct command
                                ; a program line is less than $3F
        LD      A,B             ; retrieve statement.
                                ; (we can assume it is zero).
        JR      Z,L1BBF         ; forward to LINE-USE if was a program line

; Alternatively a direct statement has finished correctly.

;; REPORT-0
L1BB0:  RST     08H             ; ERROR-1
        DEFB    $FF             ; Error Report: OK

; -----------------
; THE 'REM' COMMAND
; -----------------
; The REM command routine.
; The return address STMT-RET is dropped and the rest of line ignored.

;; REM
L1BB2:  POP     BC              ; drop return address STMT-RET and
                                ; continue ignoring rest of line.

; ------------
; End of line?
; ------------
;
;

;; LINE-END
L1BB3:  CALL    L2530           ; routine SYNTAX-Z  (UNSTACK-Z?)
        RET     Z               ; return if checking syntax.

        LD      HL,($5C55)      ; fetch NXTLIN to HL.
        LD      A,$C0           ; test against the
        AND     (HL)            ; system limit $3F.
        RET     NZ              ; return if more as must be
                                ; end of program.
                                ; (or direct command)

        XOR     A               ; set statement to zero.

; and continue to set up the next following line and then consider this new one.

; ---------------------
; General line checking
; ---------------------
; The branch was here from LINE-NEW if BASIC is branching.
; or a continuation from above if dealing with a new sequential line.
; First make statement zero number one leaving others unaffected.

;; LINE-USE
L1BBF:  CP      $01             ; will set carry if zero.
        ADC     A,$00           ; add in any carry.

        LD      D,(HL)          ; high byte of line number to D.
        INC     HL              ; advance pointer.
        LD      E,(HL)          ; low byte of line number to E.
        LD      ($5C45),DE      ; set system variable PPC.

        INC     HL              ; advance pointer.
        LD      E,(HL)          ; low byte of line length to E.
        INC     HL              ; advance pointer.
        LD      D,(HL)          ; high byte of line length to D.

        EX      DE,HL           ; swap pointer to DE before
        ADD     HL,DE           ; adding to address the end of line.
        INC     HL              ; advance to start of next line.

; -----------------------------
; Update NEXT LINE but consider
; previous line or edit line.
; -----------------------------
; The pointer will be the next line if continuing from above or to
; edit line end-marker ($80) if from LINE-RUN.

;; NEXT-LINE
L1BD1:  LD      ($5C55),HL      ; store pointer in system variable NXTLIN

        EX      DE,HL           ; bring back pointer to previous or edit line
        LD      ($5C5D),HL      ; and update CH_ADD with character address.

        LD      D,A             ; store statement in D.
        LD      E,$00           ; set E to zero to suppress token searching
                                ; if EACH-STMT is to be called.
        LD      (IY+$0A),$FF    ; set statement NSPPC to $FF signalling
                                ; no jump to be made.
        DEC     D               ; decrement and test statement
        LD      (IY+$0D),D      ; set SUBPPC to decremented statement number.
        JP      Z,L1B28         ; to STMT-LOOP if result zero as statement is
                                ; at start of line and address is known.

        INC     D               ; else restore statement.
        CALL    L198B           ; routine EACH-STMT finds the D'th statement
                                ; address as E does not contain a token.
        JR      Z,L1BF4         ; forward to STMT-NEXT if address found.

;; REPORT-N
L1BEC:  RST     08H             ; ERROR-1
        DEFB    $16             ; Error Report: Statement lost

; -----------------
; End of statement?
; -----------------
; This combination of routines is called from 20 places when
; the end of a statement should have been reached and all preceding
; syntax is in order.

;; CHECK-END
L1BEE:  CALL    L2530           ; routine SYNTAX-Z
        RET     NZ              ; return immediately in runtime

        POP     BC              ; drop address of calling routine.
        POP     BC              ; drop address STMT-RET.
                                ; and continue to find next statement.

; --------------------
; Go to next statement
; --------------------
; Acceptable characters at this point are carriage return and ':'.
; If so go to next statement which in the first case will be on next line.

;; STMT-NEXT
L1BF4:  RST     18H             ; GET-CHAR - ignoring white space etc.

        CP      $0D             ; is it carriage return ?
        JR      Z,L1BB3         ; back to LINE-END if so.

        CP      $3A             ; is it ':' ?
        JP      Z,L1B28         ; jump back to STMT-LOOP to consider
                                ; further statements

        JP      L1C8A           ; jump to REPORT-C with any other character
                                ; 'Nonsense in BASIC'.

; Note. the two-byte sequence 'rst 08; defb $0b' could replace the above jp.

; -------------------
; Command class table
; -------------------
;

;; class-tbl
L1C01:  DEFB    L1C10 - $       ; 0F offset to Address: CLASS-00
        DEFB    L1C1F - $       ; 1D offset to Address: CLASS-01
        DEFB    L1C4E - $       ; 4B offset to Address: CLASS-02
        DEFB    L1C0D - $       ; 09 offset to Address: CLASS-03
        DEFB    L1C6C - $       ; 67 offset to Address: CLASS-04
        DEFB    L1C11 - $       ; 0B offset to Address: CLASS-05
        DEFB    L1C82 - $       ; 7B offset to Address: CLASS-06
        DEFB    L1C96 - $       ; 8E offset to Address: CLASS-07
        DEFB    L1C7A - $       ; 71 offset to Address: CLASS-08
        DEFB    L1CBE - $       ; B4 offset to Address: CLASS-09
        DEFB    L1C8C - $       ; 81 offset to Address: CLASS-0A
        DEFB    L1CDB - $       ; CF offset to Address: CLASS-0B


; --------------------------------
; Command classes---00, 03, and 05
; --------------------------------
; class-03 e.g. RUN or RUN 200   ;  optional operand
; class-00 e.g. CONTINUE         ;  no operand
; class-05 e.g. PRINT            ;  variable syntax checked by routine

;; CLASS-03
L1C0D:  CALL    L1CDE           ; routine FETCH-NUM

;; CLASS-00

L1C10:  CP      A               ; reset zero flag.

; if entering here then all class routines are entered with zero reset.

;; CLASS-05
L1C11:  POP     BC              ; drop address SCAN-LOOP.
        CALL    Z,L1BEE         ; if zero set then call routine CHECK-END >>>
                                ; as should be no further characters.

        EX      DE,HL           ; save HL to DE.
        LD      HL,($5C74)      ; fetch T_ADDR
        LD      C,(HL)          ; fetch low byte of routine
        INC     HL              ; address next.
        LD      B,(HL)          ; fetch high byte of routine.
        EX      DE,HL           ; restore HL from DE
        PUSH    BC              ; push the address
        RET                     ; and make an indirect jump to the command.

; --------------------------------
; Command classes---01, 02, and 04
; --------------------------------
; class-01  e.g. LET A = 2*3     ; a variable is reqd

; This class routine is also called from INPUT and READ to find the
; destination variable for an assignment.

;; CLASS-01
L1C1F:  CALL    L28B2           ; routine LOOK-VARS returns carry set if not
                                ; found in runtime.

; ----------------------
; Variable in assignment
; ----------------------
;
;

;; VAR-A-1
L1C22:  LD      (IY+$37),$00    ; set FLAGX to zero
        JR      NC,L1C30        ; forward to VAR-A-2 if found or checking
                                ; syntax.

        SET     1,(IY+$37)      ; FLAGX  - Signal a new variable
        JR      NZ,L1C46        ; to VAR-A-3 if not assigning to an array
                                ; e.g. LET a$(3,3) = "X"

;; REPORT-2
L1C2E:  RST     08H             ; ERROR-1
        DEFB    $01             ; Error Report: Variable not found

;; VAR-A-2
L1C30:  CALL    Z,L2996         ; routine STK-VAR considers a subscript/slice
        BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
        JR      NZ,L1C46        ; to VAR-A-3 if numeric

        XOR     A               ; default to array/slice - to be retained.
        CALL    L2530           ; routine SYNTAX-Z
        CALL    NZ,L2BF1        ; routine STK-FETCH is called in runtime
                                ; may overwrite A with 1.
        LD      HL,$5C71        ; address system variable FLAGX
        OR      (HL)            ; set bit 0 if simple variable to be reclaimed
        LD      (HL),A          ; update FLAGX
        EX      DE,HL           ; start of string/subscript to DE

;; VAR-A-3
L1C46:  LD      ($5C72),BC      ; update STRLEN
        LD      ($5C4D),HL      ; and DEST of assigned string.
        RET                     ; return.

; -------------------------------------------------
; class-02 e.g. LET a = 1 + 1   ; an expression must follow

;; CLASS-02
L1C4E:  POP     BC              ; drop return address SCAN-LOOP
        CALL    L1C56           ; routine VAL-FET-1 is called to check
                                ; expression and assign result in runtime
        CALL    L1BEE           ; routine CHECK-END checks nothing else
                                ; is present in statement.
        RET                     ; Return

; -------------
; Fetch a value
; -------------
;
;

;; VAL-FET-1
L1C56:  LD      A,($5C3B)       ; initial FLAGS to A

;; VAL-FET-2
L1C59:  PUSH    AF              ; save A briefly
        CALL    L24FB           ; routine SCANNING evaluates expression.
        POP     AF              ; restore A
        LD      D,(IY+$01)      ; post-SCANNING FLAGS to D
        XOR     D               ; xor the two sets of flags
        AND     $40             ; pick up bit 6 of xored FLAGS should be zero
        JR      NZ,L1C8A        ; forward to REPORT-C if not zero
                                ; 'Nonsense in BASIC' - results don't agree.

        BIT     7,D             ; test FLAGS - is syntax being checked ?
        JP      NZ,L2AFF        ; jump forward to LET to make the assignment
                                ; in runtime.

        RET                     ; but return from here if checking syntax.

; ------------------
; Command class---04
; ------------------
; class-04 e.g. FOR i            ; a single character variable must follow

;; CLASS-04
L1C6C:  CALL    L28B2           ; routine LOOK-VARS
        PUSH    AF              ; preserve flags.
        LD      A,C             ; fetch type - should be 011xxxxx
        OR      $9F             ; combine with 10011111.
        INC     A               ; test if now $FF by incrementing.
        JR      NZ,L1C8A        ; forward to REPORT-C if result not zero.

        POP     AF              ; else restore flags.
        JR      L1C22           ; back to VAR-A-1


; --------------------------------
; Expect numeric/string expression
; --------------------------------
; This routine is used to get the two coordinates of STRING$, ATTR and POINT.
; It is also called from PRINT-ITEM to get the two numeric expressions that
; follow the AT ( in PRINT AT, INPUT AT).

;; NEXT-2NUM
L1C79:  RST     20H             ; NEXT-CHAR advance past 'AT' or '('.

; --------
; class-08 e.g. POKE 65535,2     ; two numeric expressions separated by comma
;; CLASS-08
;; EXPT-2NUM
L1C7A:  CALL    L1C82           ; routine EXPT-1NUM is called for first
                                ; numeric expression
        CP      $2C             ; is character ',' ?
        JR      NZ,L1C8A        ; to REPORT-C if not required separator.
                                ; 'Nonsense in BASIC'.

        RST     20H             ; NEXT-CHAR

; ->
;  class-06  e.g. GOTO a*1000   ; a numeric expression must follow
;; CLASS-06
;; EXPT-1NUM
L1C82:  CALL    L24FB           ; routine SCANNING
        BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
        RET     NZ              ; return if result is numeric.

;; REPORT-C
L1C8A:  RST     08H             ; ERROR-1
        DEFB    $0B             ; Error Report: Nonsense in BASIC

; ---------------------------------------------------------------
; class-0A e.g. ERASE "????"    ; a string expression must follow.
;                               ; these only occur in unimplemented commands
;                               ; although the routine expt-exp is called
;                               ; from SAVE-ETC

;; CLASS-0A
;; EXPT-EXP
L1C8C:  CALL    L24FB           ; routine SCANNING
        BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
        RET     Z               ; return if string result.

        JR      L1C8A           ; back to REPORT-C if numeric.

; ---------------------
; Set permanent colours
; class 07
; ---------------------
; class-07 e.g. PAPER 6          ; a single class for a collection of
;                               ; similar commands. Clever.
;
; Note. these commands should ensure that current channel is 'S'

;; CLASS-07
L1C96:  BIT     7,(IY+$01)      ; test FLAGS - checking syntax only ?
                                ; Note. there is a subroutine to do this.
        RES     0,(IY+$02)      ; update TV_FLAG - signal main screen in use
        CALL    NZ,L0D4D        ; routine TEMPS is called in runtime.
        POP     AF              ; drop return address SCAN-LOOP
        LD      A,($5C74)       ; T_ADDR_lo to accumulator.
                                ; points to '$07' entry + 1
                                ; e.g. for INK points to $EC now

; Note if you move alter the syntax table next line may have to be altered.

; Note. For ZASM assembler replace following expression with SUB $13.

L1CA5:  SUB     (L1AEB-$D8)%256 ; convert $EB to $D8 ('INK') etc.
                                ; ( is SUB $13 in standard ROM )

        CALL    L21FC           ; routine CO-TEMP-4
        CALL    L1BEE           ; routine CHECK-END check that nothing else
                                ; in statement.

; return here in runtime.

        LD      HL,($5C8F)      ; pick up ATTR_T and MASK_T
        LD      ($5C8D),HL      ; and store in ATTR_P and MASK_P
        LD      HL,$5C91        ; point to P_FLAG.
        LD      A,(HL)          ; pick up in A
        RLCA                    ; rotate to left
        XOR     (HL)            ; combine with HL
        AND     $AA             ; 10101010
        XOR     (HL)            ; only permanent bits affected
        LD      (HL),A          ; reload into P_FLAG.
        RET                     ; return.

; ------------------
; Command class---09
; ------------------
; e.g. PLOT PAPER 0; 128,88     ; two coordinates preceded by optional
;                               ; embedded colour items.
;
; Note. this command should ensure that current channel is actually 'S'.

;; CLASS-09
L1CBE:  CALL    L2530           ; routine SYNTAX-Z
        JR      Z,L1CD6         ; forward to CL-09-1 if checking syntax.

        RES     0,(IY+$02)      ; update TV_FLAG - signal main screen in use
        CALL    L0D4D           ; routine TEMPS is called.
        LD      HL,$5C90        ; point to MASK_T
        LD      A,(HL)          ; fetch mask to accumulator.
        OR      $F8             ; or with 11111000 paper/bright/flash 8
        LD      (HL),A          ; mask back to MASK_T system variable.
        RES     6,(IY+$57)      ; reset P_FLAG  - signal NOT PAPER 9 ?

        RST     18H             ; GET-CHAR

;; CL-09-1
L1CD6:  CALL    L21E2           ; routine CO-TEMP-2 deals with any embedded
                                ; colour items.
        JR      L1C7A           ; exit via EXPT-2NUM to check for x,y.

; Note. if either of the numeric expressions contain STR$ then the flag setting 
; above will be undone when the channel flags are reset during STR$.
; e.g. 
; 10 BORDER 3 : PLOT VAL STR$ 128, VAL STR$ 100
; credit John Elliott.

; ------------------
; Command class---0B
; ------------------
; Again a single class for four commands.
; This command just jumps back to SAVE-ETC to handle the four tape commands.
; The routine itself works out which command has called it by examining the
; address in T_ADDR_lo. Note therefore that the syntax table has to be
; located where these and other sequential command addresses are not split
; over a page boundary.

;; CLASS-0B
L1CDB:  JP      L0605           ; jump way back to SAVE-ETC

; --------------
; Fetch a number
; --------------
; This routine is called from CLASS-03 when a command may be followed by
; an optional numeric expression e.g. RUN. If the end of statement has
; been reached then zero is used as the default.
; Also called from LIST-4.

;; FETCH-NUM
L1CDE:  CP      $0D             ; is character a carriage return ?
        JR      Z,L1CE6         ; forward to USE-ZERO if so

        CP      $3A             ; is it ':' ?
        JR      NZ,L1C82        ; forward to EXPT-1NUM if not.
                                ; else continue and use zero.

; ----------------
; Use zero routine
; ----------------
; This routine is called four times to place the value zero on the
; calculator stack as a default value in runtime.

;; USE-ZERO
L1CE6:  CALL    L2530           ; routine SYNTAX-Z  (UNSTACK-Z?)
        RET     Z               ;

        RST     28H             ;; FP-CALC
        DEFB    $A0             ;;stk-zero       ;0.
        DEFB    $38             ;;end-calc

        RET                     ; return.

; -------------------
; Handle STOP command
; -------------------
; Command Syntax: STOP
; One of the shortest and least used commands. As with 'OK' not an error.

;; REPORT-9
;; STOP
L1CEE:  RST     08H             ; ERROR-1
        DEFB    $08             ; Error Report: STOP statement

; -----------------
; Handle IF command
; -----------------
; e.g. IF score>100 THEN PRINT "You Win"
; The parser has already checked the expression the result of which is on
; the calculator stack. The presence of the 'THEN' separator has also been
; checked and CH-ADD points to the command after THEN.
;

;; IF
L1CF0:  POP     BC              ; drop return address - STMT-RET
        CALL    L2530           ; routine SYNTAX-Z
        JR      Z,L1D00         ; forward to IF-1 if checking syntax
                                ; to check syntax of PRINT "You Win"


        RST     28H             ;; FP-CALC    score>100 (1=TRUE 0=FALSE)
        DEFB    $02             ;;delete      .
        DEFB    $38             ;;end-calc

        EX      DE,HL           ; make HL point to deleted value
        CALL    L34E9           ; routine TEST-ZERO
        JP      C,L1BB3         ; jump to LINE-END if FALSE (0)

;; IF-1
L1D00:  JP      L1B29           ; to STMT-L-1, if true (1) to execute command
                                ; after 'THEN' token.

; ------------------
; Handle FOR command
; ------------------
; e.g. FOR i = 0 TO 1 STEP 0.1
; Using the syntax tables, the parser has already checked for a start and
; limit value and also for the intervening separator.
; the two values v,l are on the calculator stack.
; CLASS-04 has also checked the variable and the name is in STRLEN_lo.
; The routine begins by checking for an optional STEP.

;; FOR
L1D03:  CP      $CD             ; is there a 'STEP' ?
        JR      NZ,L1D10        ; to F-USE-1 if not to use 1 as default.

        RST     20H             ; NEXT-CHAR
        CALL    L1C82           ; routine EXPT-1NUM
        CALL    L1BEE           ; routine CHECK-END
        JR      L1D16           ; to F-REORDER

; ---

;; F-USE-1
L1D10:  CALL    L1BEE           ; routine CHECK-END

        RST     28H             ;; FP-CALC      v,l.
        DEFB    $A1             ;;stk-one       v,l,1=s.
        DEFB    $38             ;;end-calc


;; F-REORDER
L1D16:  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    $38             ;;end-calc

        CALL    L2AFF           ; routine LET assigns the initial value v to
                                ; the variable altering type if necessary.
        LD      ($5C68),HL      ; The system variable MEM is made to point to
                                ; the variable instead of its normal
                                ; location MEMBOT
        DEC     HL              ; point to single-character name
        LD      A,(HL)          ; fetch name
        SET     7,(HL)          ; set bit 7 at location
        LD      BC,$0006        ; add six to HL
        ADD     HL,BC           ; to address where limit should be.
        RLCA                    ; test bit 7 of original name.
        JR      C,L1D34         ; forward to F-L-S if already a FOR/NEXT
                                ; variable

        LD      C,$0D           ; otherwise an additional 13 bytes are needed.
                                ; 5 for each value, two for line number and
                                ; 1 byte for looping statement.
        CALL    L1655           ; routine MAKE-ROOM creates them.
        INC     HL              ; make HL address limit.

;; F-L-S
L1D34:  PUSH    HL              ; save position.

        RST     28H             ;; FP-CALC         l,s.
        DEFB    $02             ;;delete           l.
        DEFB    $02             ;;delete           .
        DEFB    $38             ;;end-calc
                                ; DE points to STKEND, l.

        POP     HL              ; restore variable position
        EX      DE,HL           ; swap pointers
        LD      C,$0A           ; ten bytes to move
        LDIR                    ; Copy 'deleted' values to variable.
        LD      HL,($5C45)      ; Load with current line number from PPC
        EX      DE,HL           ; exchange pointers.
        LD      (HL),E          ; save the looping line
        INC     HL              ; in the next
        LD      (HL),D          ; two locations.
        LD      D,(IY+$0D)      ; fetch statement from SUBPPC system variable.
        INC     D               ; increment statement.
        INC     HL              ; and pointer
        LD      (HL),D          ; and store the looping statement.
                                ;
        CALL    L1DDA           ; routine NEXT-LOOP considers an initial
        RET     NC              ; iteration. Return to STMT-RET if a loop is
                                ; possible to execute next statement.

; no loop is possible so execution continues after the matching 'NEXT'

        LD      B,(IY+$38)      ; get single-character name from STRLEN_lo
        LD      HL,($5C45)      ; get the current line from PPC
        LD      ($5C42),HL      ; and store it in NEWPPC
        LD      A,($5C47)       ; fetch current statement from SUBPPC
        NEG                     ; Negate as counter decrements from zero
                                ; initially and we are in the middle of a
                                ; line.
        LD      D,A             ; Store result in D.
        LD      HL,($5C5D)      ; get current address from CH_ADD
        LD      E,$F3           ; search will be for token 'NEXT'

;; F-LOOP
L1D64:  PUSH    BC              ; save variable name.
        LD      BC,($5C55)      ; fetch NXTLIN
        CALL    L1D86           ; routine LOOK-PROG searches for 'NEXT' token.
        LD      ($5C55),BC      ; update NXTLIN
        POP     BC              ; and fetch the letter
        JR      C,L1D84         ; forward to REPORT-I if the end of program
                                ; was reached by LOOK-PROG.
                                ; 'FOR without NEXT'

        RST     20H             ; NEXT-CHAR fetches character after NEXT
        OR      $20             ; ensure it is upper-case.
        CP      B               ; compare with FOR variable name
        JR      Z,L1D7C         ; forward to F-FOUND if it matches.

; but if no match i.e. nested FOR/NEXT loops then continue search.

        RST     20H             ; NEXT-CHAR
        JR      L1D64           ; back to F-LOOP

; ---


;; F-FOUND
L1D7C:  RST     20H             ; NEXT-CHAR
        LD      A,$01           ; subtract the negated counter from 1
        SUB     D               ; to give the statement after the NEXT
        LD      ($5C44),A       ; set system variable NSPPC
        RET                     ; return to STMT-RET to branch to new
                                ; line and statement. ->
; ---

;; REPORT-I
L1D84:  RST     08H             ; ERROR-1
        DEFB    $11             ; Error Report: FOR without NEXT

; ---------
; LOOK-PROG
; ---------
; Find DATA, DEF FN or NEXT.
; This routine searches the program area for one of the above three keywords.
; On entry, HL points to start of search area.
; The token is in E, and D holds a statement count, decremented from zero.

;; LOOK-PROG
L1D86:  LD      A,(HL)          ; fetch current character
        CP      $3A             ; is it ':' a statement separator ?
        JR      Z,L1DA3         ; forward to LOOK-P-2 if so.

; The starting point was PROG - 1 or the end of a line.

;; LOOK-P-1
L1D8B:  INC     HL              ; increment pointer to address
        LD      A,(HL)          ; the high byte of line number
        AND     $C0             ; test for program end marker $80 or a
                                ; variable
        SCF                     ; Set Carry Flag
        RET     NZ              ; return with carry set if at end
                                ; of program.           ->

        LD      B,(HL)          ; high byte of line number to B
        INC     HL              ;
        LD      C,(HL)          ; low byte to C.
        LD      ($5C42),BC      ; set system variable NEWPPC.
        INC     HL              ;
        LD      C,(HL)          ; low byte of line length to C.
        INC     HL              ;
        LD      B,(HL)          ; high byte to B.
        PUSH    HL              ; save address
        ADD     HL,BC           ; add length to position.
        LD      B,H             ; and save result
        LD      C,L             ; in BC.
        POP     HL              ; restore address.
        LD      D,$00           ; initialize statement counter to zero.

;; LOOK-P-2
L1DA3:  PUSH    BC              ; save address of next line
        CALL    L198B           ; routine EACH-STMT searches current line.
        POP     BC              ; restore address.
        RET     NC              ; return if match was found. ->

        JR      L1D8B           ; back to LOOK-P-1 for next line.

; -------------------
; Handle NEXT command
; -------------------
; e.g. NEXT i
; The parameter tables have already evaluated the presence of a variable

;; NEXT
L1DAB:  BIT     1,(IY+$37)      ; test FLAGX - handling a new variable ?
        JP      NZ,L1C2E        ; jump back to REPORT-2 if so
                                ; 'Variable not found'

; now test if found variable is a simple variable uninitialized by a FOR.

        LD      HL,($5C4D)      ; load address of variable from DEST
        BIT     7,(HL)          ; is it correct type ?
        JR      Z,L1DD8         ; forward to REPORT-1 if not
                                ; 'NEXT without FOR'

        INC     HL              ; step past variable name
        LD      ($5C68),HL      ; and set MEM to point to three 5-byte values
                                ; value, limit, step.

        RST     28H             ;; FP-CALC     add step and re-store
        DEFB    $E0             ;;get-mem-0    v.
        DEFB    $E2             ;;get-mem-2    v,s.
        DEFB    $0F             ;;addition     v+s.
        DEFB    $C0             ;;st-mem-0     v+s.
        DEFB    $02             ;;delete       .
        DEFB    $38             ;;end-calc

        CALL    L1DDA           ; routine NEXT-LOOP tests against limit.
        RET     C               ; return if no more iterations possible.

        LD      HL,($5C68)      ; find start of variable contents from MEM.
        LD      DE,$000F        ; add 3*5 to
        ADD     HL,DE           ; address the looping line number
        LD      E,(HL)          ; low byte to E
        INC     HL              ;
        LD      D,(HL)          ; high byte to D
        INC     HL              ; address looping statement
        LD      H,(HL)          ; and store in H
        EX      DE,HL           ; swap registers
        JP      L1E73           ; exit via GO-TO-2 to execute another loop.

; ---

;; REPORT-1
L1DD8:  RST     08H             ; ERROR-1
        DEFB    $00             ; Error Report: NEXT without FOR


; -----------------
; Perform NEXT loop
; -----------------
; This routine is called from the FOR command to test for an initial
; iteration and from the NEXT command to test for all subsequent iterations.
; the system variable MEM addresses the variable's contents which, in the
; latter case, have had the step, possibly negative, added to the value.

;; NEXT-LOOP
L1DDA:  RST     28H             ;; FP-CALC
        DEFB    $E1             ;;get-mem-1        l.
        DEFB    $E0             ;;get-mem-0        l,v.
        DEFB    $E2             ;;get-mem-2        l,v,s.
        DEFB    $36             ;;less-0           l,v,(1/0) negative step ?
        DEFB    $00             ;;jump-true        l,v.(1/0)

        DEFB    $02             ;;to L1DE2, NEXT-1 if step negative

        DEFB    $01             ;;exchange         v,l.

;; NEXT-1
L1DE2:  DEFB    $03             ;;subtract         l-v OR v-l.
        DEFB    $37             ;;greater-0        (1/0)
        DEFB    $00             ;;jump-true        .

        DEFB    $04             ;;to L1DE9, NEXT-2 if no more iterations.

        DEFB    $38             ;;end-calc         .

        AND     A               ; clear carry flag signalling another loop.
        RET                     ; return

; ---

;; NEXT-2
L1DE9:  DEFB    $38             ;;end-calc         .

        SCF                     ; set carry flag signalling looping exhausted.
        RET                     ; return


; -------------------
; Handle READ command
; -------------------
; e.g. READ a, b$, c$(1000 TO 3000)
; A list of comma-separated variables is assigned from a list of
; comma-separated expressions.
; As it moves along the first list, the character address CH_ADD is stored
; in X_PTR while CH_ADD is used to read the second list.

;; READ-3
L1DEC:  RST     20H             ; NEXT-CHAR

; -> Entry point.
;; READ
L1DED:  CALL    L1C1F           ; routine CLASS-01 checks variable.
        CALL    L2530           ; routine SYNTAX-Z
        JR      Z,L1E1E         ; forward to READ-2 if checking syntax


        RST     18H             ; GET-CHAR
        LD      ($5C5F),HL      ; save character position in X_PTR.
        LD      HL,($5C57)      ; load HL with Data Address DATADD, which is
                                ; the start of the program or the address
                                ; after the last expression that was read or
                                ; the address of the line number of the 
                                ; last RESTORE command.
        LD      A,(HL)          ; fetch character
        CP      $2C             ; is it a comma ?
        JR      Z,L1E0A         ; forward to READ-1 if so.

; else all data in this statement has been read so look for next DATA token

        LD      E,$E4           ; token 'DATA'
        CALL    L1D86           ; routine LOOK-PROG
        JR      NC,L1E0A        ; forward to READ-1 if DATA found

; else report the error.

;; REPORT-E
L1E08:  RST     08H             ; ERROR-1
        DEFB    $0D             ; Error Report: Out of DATA

;; READ-1
L1E0A:  CALL    L0077           ; routine TEMP-PTR1 advances updating CH_ADD
                                ; with new DATADD position.
        CALL    L1C56           ; routine VAL-FET-1 assigns value to variable
                                ; checking type match and adjusting CH_ADD.

        RST     18H             ; GET-CHAR fetches adjusted character position
        LD      ($5C57),HL      ; store back in DATADD
        LD      HL,($5C5F)      ; fetch X_PTR  the original READ CH_ADD
        LD      (IY+$26),$00    ; now nullify X_PTR_hi
        CALL    L0078           ; routine TEMP-PTR2 restores READ CH_ADD

;; READ-2
L1E1E:  RST     18H             ; GET-CHAR
        CP      $2C             ; is it ',' indicating more variables to read ?
        JR      Z,L1DEC         ; back to READ-3 if so

        CALL    L1BEE           ; routine CHECK-END
        RET                     ; return from here in runtime to STMT-RET.

; -------------------
; Handle DATA command
; -------------------
; In runtime this 'command' is passed by but the syntax is checked when such
; a statement is found while parsing a line.
; e.g. DATA 1, 2, "text", score-1, a$(location, room, object), FN r(49),
;         wages - tax, TRUE, The meaning of life

;; DATA
L1E27:  CALL    L2530           ; routine SYNTAX-Z to check status
        JR      NZ,L1E37        ; forward to DATA-2 if in runtime

;; DATA-1
L1E2C:  CALL    L24FB           ; routine SCANNING to check syntax of
                                ; expression
        CP      $2C             ; is it a comma ?
        CALL    NZ,L1BEE        ; routine CHECK-END checks that statement
                                ; is complete. Will make an early exit if
                                ; so. >>>
        RST     20H             ; NEXT-CHAR
        JR      L1E2C           ; back to DATA-1

; ---

;; DATA-2
L1E37:  LD      A,$E4           ; set token to 'DATA' and continue into
                                ; the PASS-BY routine.


; ----------------------------------
; Check statement for DATA or DEF FN
; ----------------------------------
; This routine is used to backtrack to a command token and then
; forward to the next statement in runtime.

;; PASS-BY
L1E39:  LD      B,A             ; Give BC enough space to find token.
        CPDR                    ; Compare decrement and repeat. (Only use).
                                ; Work backwards till keyword is found which
                                ; is start of statement before any quotes.
                                ; HL points to location before keyword.
        LD      DE,$0200        ; count 1+1 statements, dummy value in E to
                                ; inhibit searching for a token.
        JP      L198B           ; to EACH-STMT to find next statement

; -----------------------------------------------------------------------
; A General Note on Invalid Line Numbers.
; =======================================
; One of the revolutionary concepts of Sinclair BASIC was that it supported
; virtual line numbers. That is the destination of a GO TO, RESTORE etc. need
; not exist. It could be a point before or after an actual line number.
; Zero suffices for a before but the after should logically be infinity.
; Since the maximum actual line limit is 9999 then the system limit, 16383
; when variables kick in, would serve fine as a virtual end point.
; However, ironically, only the LOAD command gets it right. It will not
; autostart a program that has been saved with a line higher than 16383.
; All the other commands deal with the limit unsatisfactorily.
; LIST, RUN, GO TO, GO SUB and RESTORE have problems and the latter may
; crash the machine when supplied with an inappropriate virtual line number.
; This is puzzling as very careful consideration must have been given to
; this point when the new variable types were allocated their masks and also
; when the routine NEXT-ONE was successfully re-written to reflect this.
; An enigma.
; -------------------------------------------------------------------------

; ----------------------
; Handle RESTORE command
; ----------------------
; The restore command sets the system variable for the data address to
; point to the location before the supplied line number or first line
; thereafter.
; This alters the position where subsequent READ commands look for data.
; Note. If supplied with inappropriate high numbers the system may crash
; in the LINE-ADDR routine as it will pass the program/variables end-marker
; and then lose control of what it is looking for - variable or line number.
; - observation, Steven Vickers, 1984, Pitman.

;; RESTORE
L1E42:  CALL    L1E99           ; routine FIND-INT2 puts integer in BC.
                                ; Note. B should be checked against limit $3F
                                ; and an error generated if higher.

; this entry point is used from RUN command with BC holding zero

;; REST-RUN
L1E45:  LD      H,B             ; transfer the line
        LD      L,C             ; number to the HL register.
        CALL    L196E           ; routine LINE-ADDR to fetch the address.
        DEC     HL              ; point to the location before the line.
        LD      ($5C57),HL      ; update system variable DATADD.
        RET                     ; return to STMT-RET (or RUN)

; ------------------------
; Handle RANDOMIZE command
; ------------------------
; This command sets the SEED for the RND function to a fixed value.
; With the parameter zero, a random start point is used depending on
; how long the computer has been switched on.

;; RANDOMIZE
L1E4F:  CALL    L1E99           ; routine FIND-INT2 puts parameter in BC.
        LD      A,B             ; test this
        OR      C               ; for zero.
        JR      NZ,L1E5A        ; forward to RAND-1 if not zero.

        LD      BC,($5C78)      ; use the lower two bytes at FRAMES1.

;; RAND-1
L1E5A:  LD      ($5C76),BC      ; place in SEED system variable.
        RET                     ; return to STMT-RET

; -----------------------
; Handle CONTINUE command
; -----------------------
; The CONTINUE command transfers the OLD (but incremented) values of
; line number and statement to the equivalent "NEW VALUE" system variables
; by using the last part of GO TO and exits indirectly to STMT-RET.

;; CONTINUE
L1E5F:  LD      HL,($5C6E)      ; fetch OLDPPC line number.
        LD      D,(IY+$36)      ; fetch OSPPC statement.
        JR      L1E73           ; forward to GO-TO-2

; --------------------
; Handle GO TO command
; --------------------
; The GO TO command routine is also called by GO SUB and RUN routines
; to evaluate the parameters of both commands.
; It updates the system variables used to fetch the next line/statement.
; It is at STMT-RET that the actual change in control takes place.
; Unlike some BASICs the line number need not exist.
; Note. the high byte of the line number is incorrectly compared with $F0
; instead of $3F. This leads to commands with operands greater than 32767
; being considered as having been run from the editing area and the
; error report 'Statement Lost' is given instead of 'OK'.
; - Steven Vickers, 1984.

;; GO-TO
L1E67:  CALL    L1E99           ; routine FIND-INT2 puts operand in BC
        LD      H,B             ; transfer line
        LD      L,C             ; number to HL.
        LD      D,$00           ; set statement to 0 - first.
        LD      A,H             ; compare high byte only
        CP      $F0             ; to $F0 i.e. 61439 in full.
        JR      NC,L1E9F        ; forward to REPORT-B if above.

; This call entry point is used to update the system variables e.g. by RETURN.

;; GO-TO-2
L1E73:  LD      ($5C42),HL      ; save line number in NEWPPC
        LD      (IY+$0A),D      ; and statement in NSPPC
        RET                     ; to STMT-RET (or GO-SUB command)

; ------------------
; Handle OUT command
; ------------------
; Syntax has been checked and the two comma-separated values are on the
; calculator stack.

;; OUT
L1E7A:  CALL    L1E85           ; routine TWO-PARAM fetches values
                                ; to BC and A.
        OUT     (C),A           ; perform the operation.
        RET                     ; return to STMT-RET.

; -------------------
; Handle POKE command
; -------------------
; This routine alters a single byte in the 64K address space.
; Happily no check is made as to whether ROM or RAM is addressed.
; Sinclair BASIC requires no poking of system variables.

;; POKE
L1E80:  CALL    L1E85           ; routine TWO-PARAM fetches values
                                ; to BC and A.
        LD      (BC),A          ; load memory location with A.
        RET                     ; return to STMT-RET.

; ------------------------------------
; Fetch two  parameters from calculator stack
; ------------------------------------
; This routine fetches a byte and word from the calculator stack
; producing an error if either is out of range.

;; TWO-PARAM
L1E85:  CALL    L2DD5           ; routine FP-TO-A
        JR      C,L1E9F         ; forward to REPORT-B if overflow occurred

        JR      Z,L1E8E         ; forward to TWO-P-1 if positive

        NEG                     ; negative numbers are made positive

;; TWO-P-1
L1E8E:  PUSH    AF              ; save the value
        CALL    L1E99           ; routine FIND-INT2 gets integer to BC
        POP     AF              ; restore the value
        RET                     ; return

; -------------
; Find integers
; -------------
; The first of these routines fetches a 8-bit integer (range 0-255) from the
; calculator stack to the accumulator and is used for colours, streams,
; durations and coordinates.
; The second routine fetches 16-bit integers to the BC register pair 
; and is used to fetch command and function arguments involving line numbers
; or memory addresses and also array subscripts and tab arguments.
; ->

;; FIND-INT1
L1E94:  CALL    L2DD5           ; routine FP-TO-A
        JR      L1E9C           ; forward to FIND-I-1 for common exit routine.

; ---

; ->

;; FIND-INT2
L1E99:  CALL    L2DA2           ; routine FP-TO-BC

;; FIND-I-1
L1E9C:  JR      C,L1E9F         ; to REPORT-Bb with overflow.

        RET     Z               ; return if positive.


;; REPORT-Bb
L1E9F:  RST     08H             ; ERROR-1
        DEFB    $0A             ; Error Report: Integer out of range

; ------------------
; Handle RUN command
; ------------------
; This command runs a program starting at an optional line.
; It performs a 'RESTORE 0' then CLEAR

;; RUN
L1EA1:  CALL    L1E67           ; routine GO-TO puts line number in
                                ; system variables.
        LD      BC,$0000        ; prepare to set DATADD to first line.
        CALL    L1E45           ; routine REST-RUN does the 'restore'.
                                ; Note BC still holds zero.
        JR      L1EAF           ; forward to CLEAR-RUN to clear variables
                                ; without disturbing RAMTOP and
                                ; exit indirectly to STMT-RET

; --------------------
; Handle CLEAR command
; --------------------
; This command reclaims the space used by the variables.
; It also clears the screen and the GO SUB stack.
; With an integer expression, it sets the uppermost memory
; address within the BASIC system.
; "Contrary to the manual, CLEAR doesn't execute a RESTORE" -
; Steven Vickers, Pitman Pocket Guide to the Spectrum, 1984.

;; CLEAR
L1EAC:  CALL    L1E99           ; routine FIND-INT2 fetches to BC.

;; CLEAR-RUN
L1EAF:  LD      A,B             ; test for
        OR      C               ; zero.
        JR      NZ,L1EB7        ; skip to CLEAR-1 if not zero.

        LD      BC,($5CB2)      ; use the existing value of RAMTOP if zero.

;; CLEAR-1
L1EB7:  PUSH    BC              ; save ramtop value.

        LD      DE,($5C4B)      ; fetch VARS
        LD      HL,($5C59)      ; fetch E_LINE
        DEC     HL              ; adjust to point at variables end-marker.
        CALL    L19E5           ; routine RECLAIM-1 reclaims the space used by
                                ; the variables.

        CALL    L0D6B           ; routine CLS to clear screen.

        LD      HL,($5C65)      ; fetch STKEND the start of free memory.
        LD      DE,$0032        ; allow for another 50 bytes.
        ADD     HL,DE           ; add the overhead to HL.

        POP     DE              ; restore the ramtop value.
        SBC     HL,DE           ; if HL is greater than the value then jump
        JR      NC,L1EDA        ; forward to REPORT-M
                                ; 'RAMTOP no good'

        LD      HL,($5CB4)      ; now P-RAMT ($7FFF on 16K RAM machine)
        AND     A               ; exact this time.
        SBC     HL,DE           ; new ramtop must be lower or the same.
        JR      NC,L1EDC        ; skip to CLEAR-2 if in actual RAM.

;; REPORT-M
L1EDA:  RST     08H             ; ERROR-1
        DEFB    $15             ; Error Report: RAMTOP no good

;; CLEAR-2
L1EDC:  EX      DE,HL           ; transfer ramtop value to HL.
        LD      ($5CB2),HL      ; update system variable RAMTOP.
        POP     DE              ; pop the return address STMT-RET.
        POP     BC              ; pop the Error Address.
        LD      (HL),$3E        ; now put the GO SUB end-marker at RAMTOP.
        DEC     HL              ; leave a location beneath it.
        LD      SP,HL           ; initialize the machine stack pointer.
        PUSH    BC              ; push the error address.
        LD      ($5C3D),SP      ; make ERR_SP point to location.
        EX      DE,HL           ; put STMT-RET in HL.
        JP      (HL)            ; and go there directly.

; ---------------------
; Handle GO SUB command
; ---------------------
; The GO SUB command diverts BASIC control to a new line number
; in a very similar manner to GO TO but
; the current line number and current statement + 1
; are placed on the GO SUB stack as a RETURN point.

;; GO-SUB
L1EED:  POP     DE              ; drop the address STMT-RET
        LD      H,(IY+$0D)      ; fetch statement from SUBPPC and
        INC     H               ; increment it
        EX      (SP),HL         ; swap - error address to HL,
                                ; H (statement) at top of stack,
                                ; L (unimportant) beneath.
        INC     SP              ; adjust to overwrite unimportant byte
        LD      BC,($5C45)      ; fetch the current line number from PPC
        PUSH    BC              ; and PUSH onto GO SUB stack.
                                ; the empty machine-stack can be rebuilt
        PUSH    HL              ; push the error address.
        LD      ($5C3D),SP      ; make system variable ERR_SP point to it.
        PUSH    DE              ; push the address STMT-RET.
        CALL    L1E67           ; call routine GO-TO to update the system
                                ; variables NEWPPC and NSPPC.
                                ; then make an indirect exit to STMT-RET via
        LD      BC,$0014        ; a 20-byte overhead memory check.

; ----------------------
; Check available memory
; ----------------------
; This routine is used on many occasions when extending a dynamic area
; upwards or the GO SUB stack downwards.

;; TEST-ROOM
L1F05:  LD      HL,($5C65)      ; fetch STKEND
        ADD     HL,BC           ; add the supplied test value
        JR      C,L1F15         ; forward to REPORT-4 if over $FFFF

        EX      DE,HL           ; was less so transfer to DE
        LD      HL,$0050        ; test against another 80 bytes
        ADD     HL,DE           ; anyway
        JR      C,L1F15         ; forward to REPORT-4 if this passes $FFFF

        SBC     HL,SP           ; if less than the machine stack pointer
        RET     C               ; then return - OK.

;; REPORT-4
L1F15:  LD      L,$03           ; prepare 'Out of Memory' 
        JP      L0055           ; jump back to ERROR-3 at $0055
                                ; Note. this error can't be trapped at $0008

; ------------------------------
; THE 'FREE MEMORY' USER ROUTINE
; ------------------------------
; This routine is not used by the ROM but allows users to evaluate
; approximate free memory with PRINT 65536 - USR 7962.

;; free-mem
L1F1A:  LD      BC,$0000        ; allow no overhead.

        CALL    L1F05           ; routine TEST-ROOM.

        LD      B,H             ; transfer the result
        LD      C,L             ; to the BC register.
        RET                     ; the USR function returns value of BC.

; --------------------
; THE 'RETURN' COMMAND
; --------------------
; As with any command, there are two values on the machine stack at the time 
; it is invoked.  The machine stack is below the GOSUB stack.  Both grow 
; downwards, the machine stack by two bytes, the GOSUB stack by 3 bytes. 
; The highest location is a statement byte followed by a two-byte line number.

;; RETURN
L1F23:  POP     BC              ; drop the address STMT-RET.
        POP     HL              ; now the error address.
        POP     DE              ; now a possible BASIC return line.
        LD      A,D             ; the high byte $00 - $27 is 
        CP      $3E             ; compared with the traditional end-marker $3E.
        JR      Z,L1F36         ; forward to REPORT-7 with a match.
                                ; 'RETURN without GOSUB'

; It was not the end-marker so a single statement byte remains at the base of 
; the calculator stack. It can't be popped off.

        DEC     SP              ; adjust stack pointer to create room for two 
                                ; bytes.
        EX      (SP),HL         ; statement to H, error address to base of
                                ; new machine stack.
        EX      DE,HL           ; statement to D,  BASIC line number to HL.
        LD      ($5C3D),SP      ; adjust ERR_SP to point to new stack pointer
        PUSH    BC              ; now re-stack the address STMT-RET
        JP      L1E73           ; to GO-TO-2 to update statement and line
                                ; system variables and exit indirectly to the
                                ; address just pushed on stack.

; ---

;; REPORT-7
L1F36:  PUSH    DE              ; replace the end-marker.
        PUSH    HL              ; now restore the error address
                                ; as will be required in a few clock cycles.

        RST     08H             ; ERROR-1
        DEFB    $06             ; Error Report: RETURN without GOSUB

; --------------------
; Handle PAUSE command
; --------------------
; The pause command takes as its parameter the number of interrupts
; for which to wait. PAUSE 50 pauses for about a second.
; PAUSE 0 pauses indefinitely.
; Both forms can be finished by pressing a key.

;; PAUSE
L1F3A:  CALL    L1E99           ; routine FIND-INT2 puts value in BC

;; PAUSE-1
L1F3D:  HALT                    ; wait for interrupt.
        DEC     BC              ; decrease counter.
        LD      A,B             ; test if
        OR      C               ; result is zero.
        JR      Z,L1F4F         ; forward to PAUSE-END if so.

        LD      A,B             ; test if
        AND     C               ; now $FFFF
        INC     A               ; that is, initially zero.
        JR      NZ,L1F49        ; skip forward to PAUSE-2 if not.

        INC     BC              ; restore counter to zero.

;; PAUSE-2
L1F49:  BIT     5,(IY+$01)      ; test FLAGS - has a new key been pressed ?
        JR      Z,L1F3D         ; back to PAUSE-1 if not.

;; PAUSE-END
L1F4F:  RES     5,(IY+$01)      ; update FLAGS - signal no new key
        RET                     ; and return.

; -------------------
; Check for BREAK key
; -------------------
; This routine is called from COPY-LINE, when interrupts are disabled,
; to test if BREAK (SHIFT - SPACE) is being pressed.
; It is also called at STMT-RET after every statement.

;; BREAK-KEY
L1F54:  LD      A,$7F           ; Input address: $7FFE
        IN      A,($FE)         ; read lower right keys
        RRA                     ; rotate bit 0 - SPACE
        RET     C               ; return if not reset

        LD      A,$FE           ; Input address: $FEFE
        IN      A,($FE)         ; read lower left keys
        RRA                     ; rotate bit 0 - SHIFT
        RET                     ; carry will be set if not pressed.
                                ; return with no carry if both keys
                                ; pressed.

; ---------------------
; Handle DEF FN command
; ---------------------
; e.g. DEF FN r$(a$,a) = a$(a TO )
; this 'command' is ignored in runtime but has its syntax checked
; during line-entry.

;; DEF-FN
L1F60:  CALL    L2530           ; routine SYNTAX-Z
        JR      Z,L1F6A         ; forward to DEF-FN-1 if parsing

        LD      A,$CE           ; else load A with 'DEF FN' and
        JP      L1E39           ; jump back to PASS-BY

; ---

; continue here if checking syntax.

;; DEF-FN-1
L1F6A:  SET      6,(IY+$01)     ; set FLAGS  - Assume numeric result
        CALL    L2C8D           ; call routine ALPHA
        JR      NC,L1F89        ; if not then to DEF-FN-4 to jump to
                                ; 'Nonsense in BASIC'


        RST     20H             ; NEXT-CHAR
        CP      $24             ; is it '$' ?
        JR      NZ,L1F7D        ; to DEF-FN-2 if not as numeric.

        RES     6,(IY+$01)      ; set FLAGS  - Signal string result

        RST     20H             ; get NEXT-CHAR

;; DEF-FN-2
L1F7D:  CP      $28             ; is it '(' ?
        JR      NZ,L1FBD        ; to DEF-FN-7 'Nonsense in BASIC'


        RST     20H             ; NEXT-CHAR
        CP      $29             ; is it ')' ?
        JR      Z,L1FA6         ; to DEF-FN-6 if null argument

;; DEF-FN-3
L1F86:  CALL    L2C8D           ; routine ALPHA checks that it is the expected
                                ; alphabetic character.

;; DEF-FN-4
L1F89:  JP      NC,L1C8A        ; to REPORT-C  if not
                                ; 'Nonsense in BASIC'.

        EX      DE,HL           ; save pointer in DE

        RST     20H             ; NEXT-CHAR re-initializes HL from CH_ADD
                                ; and advances.
        CP      $24             ; '$' ? is it a string argument.
        JR      NZ,L1F94        ; forward to DEF-FN-5 if not.

        EX      DE,HL           ; save pointer to '$' in DE

        RST     20H             ; NEXT-CHAR re-initializes HL and advances

;; DEF-FN-5
L1F94:  EX      DE,HL           ; bring back pointer.
        LD      BC,$0006        ; the function requires six hidden bytes for
                                ; each parameter passed.
                                ; The first byte will be $0E
                                ; then 5-byte numeric value
                                ; or 5-byte string pointer.

        CALL    L1655           ; routine MAKE-ROOM creates space in program
                                ; area.

        INC     HL              ; adjust HL (set by LDDR)
        INC     HL              ; to point to first location.
        LD      (HL),$0E        ; insert the 'hidden' marker.

; Note. these invisible storage locations hold nothing meaningful for the
; moment. They will be used every time the corresponding function is
; evaluated in runtime.
; Now consider the following character fetched earlier.

        CP      $2C             ; is it ',' ? (more than one parameter)
        JR      NZ,L1FA6        ; to DEF-FN-6 if not


        RST     20H             ; else NEXT-CHAR
        JR      L1F86           ; and back to DEF-FN-3

; ---

;; DEF-FN-6
L1FA6:  CP      $29             ; should close with a ')'
        JR      NZ,L1FBD        ; to DEF-FN-7 if not
                                ; 'Nonsense in BASIC'


        RST     20H             ; get NEXT-CHAR
        CP      $3D             ; is it '=' ?
        JR      NZ,L1FBD        ; to DEF-FN-7 if not 'Nonsense...'


        RST     20H             ; address NEXT-CHAR
        LD      A,($5C3B)       ; get FLAGS which has been set above
        PUSH    AF              ; and preserve

        CALL    L24FB           ; routine SCANNING checks syntax of expression
                                ; and also sets flags.

        POP     AF              ; restore previous flags
        XOR     (IY+$01)        ; xor with FLAGS - bit 6 should be same 
                                ; therefore will be reset.
        AND     $40             ; isolate bit 6.

;; DEF-FN-7
L1FBD:  JP      NZ,L1C8A        ; jump back to REPORT-C if the expected result 
                                ; is not the same type.
                                ; 'Nonsense in BASIC'

        CALL    L1BEE           ; routine CHECK-END will return early if
                                ; at end of statement and move onto next
                                ; else produce error report. >>>

                                ; There will be no return to here.

; -------------------------------
; Returning early from subroutine
; -------------------------------
; All routines are capable of being run in two modes - syntax checking mode
; and runtime mode.  This routine is called often to allow a routine to return 
; early if checking syntax.

;; UNSTACK-Z
L1FC3:  CALL    L2530           ; routine SYNTAX-Z sets zero flag if syntax
                                ; is being checked.

        POP     HL              ; drop the return address.
        RET      Z              ; return to previous call in chain if checking
                                ; syntax.

        JP      (HL)            ; jump to return address as BASIC program is
                                ; actually running.

; ---------------------
; Handle LPRINT command
; ---------------------
; A simple form of 'PRINT #3' although it can output to 16 streams.
; Probably for compatibility with other BASICs particularly ZX81 BASIC.
; An extra UDG might have been better.

;; LPRINT
L1FC9:  LD      A,$03           ; the printer channel
        JR      L1FCF           ; forward to PRINT-1

; ---------------------
; Handle PRINT commands
; ---------------------
; The Spectrum's main stream output command.
; The default stream is stream 2 which is normally the upper screen
; of the computer. However the stream can be altered in range 0 - 15.

;; PRINT
L1FCD:  LD      A,$02           ; the stream for the upper screen.

; The LPRINT command joins here.

;; PRINT-1
L1FCF:  CALL    L2530           ; routine SYNTAX-Z checks if program running
        CALL    NZ,L1601        ; routine CHAN-OPEN if so
        CALL    L0D4D           ; routine TEMPS sets temporary colours.
        CALL    L1FDF           ; routine PRINT-2 - the actual item
        CALL    L1BEE           ; routine CHECK-END gives error if not at end
                                ; of statement
        RET                     ; and return >>>

; ------------------------------------
; this subroutine is called from above
; and also from INPUT.

;; PRINT-2
L1FDF:  RST     18H             ; GET-CHAR gets printable character
        CALL    L2045           ; routine PR-END-Z checks if more printing
        JR      Z,L1FF2         ; to PRINT-4 if not     e.g. just 'PRINT :'

; This tight loop deals with combinations of positional controls and
; print items. An early return can be made from within the loop
; if the end of a print sequence is reached.

;; PRINT-3
L1FE5:  CALL    L204E           ; routine PR-POSN-1 returns zero if more
                                ; but returns early at this point if
                                ; at end of statement!
                                ; 
        JR      Z,L1FE5         ; to PRINT-3 if consecutive positioners

        CALL    L1FFC           ; routine PR-ITEM-1 deals with strings etc.
        CALL    L204E           ; routine PR-POSN-1 for more position codes
        JR      Z,L1FE5         ; loop back to PRINT-3 if so

;; PRINT-4
L1FF2:  CP      $29             ; return now if this is ')' from input-item.
                                ; (see INPUT.)
        RET     Z               ; or continue and print carriage return in
                                ; runtime

; ---------------------
; Print carriage return
; ---------------------
; This routine which continues from above prints a carriage return
; in run-time. It is also called once from PRINT-POSN.

;; PRINT-CR
L1FF5:  CALL    L1FC3           ; routine UNSTACK-Z

        LD      A,$0D           ; prepare a carriage return

        RST     10H             ; PRINT-A
        RET                     ; return


; -----------
; Print items
; -----------
; This routine deals with print items as in
; PRINT AT 10,0;"The value of A is ";a
; It returns once a single item has been dealt with as it is part
; of a tight loop that considers sequences of positional and print items

;; PR-ITEM-1
L1FFC:  RST     18H             ; GET-CHAR
        CP      $AC             ; is character 'AT' ?
        JR      NZ,L200E        ; forward to PR-ITEM-2 if not.

        CALL    L1C79           ; routine NEXT-2NUM  check for two comma 
                                ; separated numbers placing them on the 
                                ; calculator stack in runtime. 
        CALL    L1FC3           ; routine UNSTACK-Z quits if checking syntax.

        CALL    L2307           ; routine STK-TO-BC get the numbers in B and C.
        LD      A,$16           ; prepare the 'at' control.
        JR      L201E           ; forward to PR-AT-TAB to print the sequence.

; ---

;; PR-ITEM-2
L200E:  CP      $AD             ; is character 'TAB' ?
        JR      NZ,L2024        ; to PR-ITEM-3 if not


        RST     20H             ; NEXT-CHAR to address next character
        CALL    L1C82           ; routine EXPT-1NUM
        CALL    L1FC3           ; routine UNSTACK-Z quits if checking syntax.

        CALL    L1E99           ; routine FIND-INT2 puts integer in BC.
        LD      A,$17           ; prepare the 'tab' control.

;; PR-AT-TAB
L201E:  RST     10H             ; PRINT-A outputs the control

        LD      A,C             ; first value to A
        RST     10H             ; PRINT-A outputs it.

        LD      A,B             ; second value
        RST     10H             ; PRINT-A

        RET                     ; return - item finished >>>

; ---

; Now consider paper 2; #2; a$

;; PR-ITEM-3
L2024:  CALL    L21F2           ; routine CO-TEMP-3 will print any colour
        RET     NC              ; items - return if success.

        CALL    L2070           ; routine STR-ALTER considers new stream
        RET     NC              ; return if altered.

        CALL    L24FB           ; routine SCANNING now to evaluate expression
        CALL    L1FC3           ; routine UNSTACK-Z if not runtime.

        BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
        CALL    Z,L2BF1         ; routine STK-FETCH if string.
                                ; note no flags affected.
        JP      NZ,L2DE3        ; to PRINT-FP to print if numeric >>>

; It was a string expression - start in DE, length in BC
; Now enter a loop to print it

;; PR-STRING
L203C:  LD      A,B             ; this tests if the
        OR      C               ; length is zero and sets flag accordingly.
        DEC     BC              ; this doesn't but decrements counter.
        RET     Z               ; return if zero.

        LD      A,(DE)          ; fetch character.
        INC     DE              ; address next location.

        RST     10H             ; PRINT-A.

        JR      L203C           ; loop back to PR-STRING.

; ---------------
; End of printing
; ---------------
; This subroutine returns zero if no further printing is required
; in the current statement.
; The first terminator is found in  escaped input items only,
; the others in print_items.

;; PR-END-Z
L2045:  CP      $29             ; is character a ')' ?
        RET     Z               ; return if so -        e.g. INPUT (p$); a$

;; PR-ST-END
L2048:  CP      $0D             ; is it a carriage return ?
        RET     Z               ; return also -         e.g. PRINT a

        CP      $3A             ; is character a ':' ?
        RET                     ; return - zero flag will be set if so.
                                ;                       e.g. PRINT a :

; --------------
; Print position
; --------------
; This routine considers a single positional character ';', ',', '''

;; PR-POSN-1
L204E:  RST     18H             ; GET-CHAR
        CP      $3B             ; is it ';' ?             
                                ; i.e. print from last position.
        JR      Z,L2067         ; forward to PR-POSN-3 if so.
                                ; i.e. do nothing.

        CP      $2C             ; is it ',' ?
                                ; i.e. print at next tabstop.
        JR      NZ,L2061        ; forward to PR-POSN-2 if anything else.

        CALL    L2530           ; routine SYNTAX-Z
        JR      Z,L2067         ; forward to PR-POSN-3 if checking syntax.

        LD      A,$06           ; prepare the 'comma' control character.

        RST     10H             ; PRINT-A  outputs to current channel in
                                ; run-time.

        JR      L2067           ; skip to PR-POSN-3.

; ---

; check for newline.

;; PR-POSN-2
L2061:  CP      $27             ; is character a "'" ? (newline)
        RET     NZ              ; return if no match              >>>

        CALL    L1FF5           ; routine PRINT-CR outputs a carriage return
                                ; in runtime only.

;; PR-POSN-3
L2067:  RST     20H             ; NEXT-CHAR to A.
        CALL    L2045           ; routine PR-END-Z checks if at end.
        JR      NZ,L206E        ; to PR-POSN-4 if not.

        POP     BC              ; drop return address if at end.

;; PR-POSN-4
L206E:  CP      A               ; reset the zero flag.
        RET                     ; and return to loop or quit.

; ------------
; Alter stream
; ------------
; This routine is called from PRINT ITEMS above, and also LIST as in
; LIST #15

;; STR-ALTER
L2070:  CP      $23             ; is character '#' ?
        SCF                     ; set carry flag.
        RET     NZ              ; return if no match.


        RST      20H            ; NEXT-CHAR
        CALL    L1C82           ; routine EXPT-1NUM gets stream number
        AND     A               ; prepare to exit early with carry reset
        CALL    L1FC3           ; routine UNSTACK-Z exits early if parsing
        CALL    L1E94           ; routine FIND-INT1 gets number off stack
        CP      $10             ; must be range 0 - 15 decimal.
        JP      NC,L160E        ; jump back to REPORT-Oa if not
                                ; 'Invalid stream'.

        CALL    L1601           ; routine CHAN-OPEN
        AND     A               ; clear carry - signal item dealt with.
        RET                     ; return

; -------------------
; THE 'INPUT' COMMAND 
; -------------------
; This command is mysterious.
;

;; INPUT
L2089:  CALL    L2530           ; routine SYNTAX-Z to check if in runtime.

        JR      Z,L2096         ; forward to INPUT-1 if checking syntax.

        LD      A,$01           ; select channel 'K' the keyboard for input.
        CALL    L1601           ; routine CHAN-OPEN opens the channel and sets
                                ; bit 0 of TV_FLAG.

;   Note. As a consequence of clearing the lower screen channel 0 is made 
;   the current channel so the above two instructions are superfluous.

        CALL    L0D6E           ; routine CLS-LOWER clears the lower screen
                                ; and sets DF_SZ to two and TV_FLAG to $01.

;; INPUT-1
L2096:  LD      (IY+$02),$01    ; update TV_FLAG - signal lower screen in use
                                ; ensuring that the correct set of system 
                                ; variables are updated and that the border 
                                ; colour is used. 

;   Note. The Complete Spectrum ROM Disassembly incorrectly names DF-SZ as the
;   system variable that is updated above and if, as some have done, you make 
;   this unnecessary alteration then there will be two blank lines between the
;   lower screen and the upper screen areas which will also scroll wrongly.

        CALL    L20C1           ; routine IN-ITEM-1 to handle the input.

        CALL    L1BEE           ; routine CHECK-END will make an early exit
                                ; if checking syntax. >>>

;   Keyboard input has been made and it remains to adjust the upper
;   screen in case the lower two lines have been extended upwards.

        LD      BC,($5C88)      ; fetch S_POSN current line/column of
                                ; the upper screen.
        LD      A,($5C6B)       ; fetch DF_SZ the display file size of
                                ; the lower screen.
        CP      B               ; test that lower screen does not overlap
        JR      C,L20AD         ; forward to INPUT-2 if not.

; the two screens overlap so adjust upper screen.

        LD      C,$21           ; set column of upper screen to leftmost.
        LD      B,A             ; and line to one above lower screen.
                                ; continue forward to update upper screen
                                ; print position.

;; INPUT-2
L20AD:  LD      ($5C88),BC      ; set S_POSN update upper screen line/column.
        LD      A,$19           ; subtract from twenty five
        SUB     B               ; the new line number.
        LD      ($5C8C),A       ; and place result in SCR_CT - scroll count.
        RES     0,(IY+$02)      ; update TV_FLAG - signal main screen in use.

        CALL    L0DD9           ; routine CL-SET sets the print position
                                ; system variables for the upper screen.

        JP      L0D6E           ; jump back to CLS-LOWER and make
                                ; an indirect exit >>.

; ---------------------
; INPUT ITEM subroutine
; ---------------------
;   This subroutine deals with the input items and print items.
;   from  the current input channel.
;   It is only called from the above INPUT routine but was obviously
;   once called from somewhere else in another context.

;; IN-ITEM-1
L20C1:  CALL    L204E           ; routine PR-POSN-1 deals with a single
                                ; position item at each call.
        JR      Z,L20C1         ; back to IN-ITEM-1 until no more in a
                                ; sequence.

        CP      $28             ; is character '(' ?
        JR      NZ,L20D8        ; forward to IN-ITEM-2 if not.

;   any variables within braces will be treated as part, or all, of the prompt
;   instead of being used as destination variables.

        RST     20H             ; NEXT-CHAR
        CALL    L1FDF           ; routine PRINT-2 to output the dynamic
                                ; prompt.

        RST     18H             ; GET-CHAR
        CP      $29             ; is character a matching ')' ?
        JP      NZ,L1C8A        ; jump back to REPORT-C if not.
                                ; 'Nonsense in BASIC'.

        RST     20H             ; NEXT-CHAR
        JP      L21B2           ; forward to IN-NEXT-2

; ---

;; IN-ITEM-2
L20D8:  CP      $CA             ; is the character the token 'LINE' ?
        JR      NZ,L20ED        ; forward to IN-ITEM-3 if not.

        RST     20H             ; NEXT-CHAR - variable must come next.
        CALL    L1C1F           ; routine CLASS-01 returns destination
                                ; address of variable to be assigned.
                                ; or generates an error if no variable
                                ; at this position.

        SET     7,(IY+$37)      ; update FLAGX  - signal handling INPUT LINE
        BIT     6,(IY+$01)      ; test FLAGS  - numeric or string result ?
        JP      NZ,L1C8A        ; jump back to REPORT-C if not string
                                ; 'Nonsense in BASIC'.

        JR      L20FA           ; forward to IN-PROMPT to set up workspace.

; ---

;   the jump was here for other variables.

;; IN-ITEM-3
L20ED:  CALL     L2C8D          ; routine ALPHA checks if character is
                                ; a suitable variable name.
        JP      NC,L21AF        ; forward to IN-NEXT-1 if not

        CALL    L1C1F           ; routine CLASS-01 returns destination
                                ; address of variable to be assigned.
        RES     7,(IY+$37)      ; update FLAGX  - signal not INPUT LINE.

;; IN-PROMPT
L20FA:  CALL    L2530           ; routine SYNTAX-Z
        JP      Z,L21B2         ; forward to IN-NEXT-2 if checking syntax.

        CALL    L16BF           ; routine SET-WORK clears workspace.
        LD      HL,$5C71        ; point to system variable FLAGX
        RES     6,(HL)          ; signal string result.
        SET     5,(HL)          ; signal in Input Mode for editor.
        LD      BC,$0001        ; initialize space required to one for
                                ; the carriage return.
        BIT     7,(HL)          ; test FLAGX - INPUT LINE in use ?
        JR      NZ,L211C        ; forward to IN-PR-2 if so as that is
                                ; all the space that is required.

        LD      A,($5C3B)       ; load accumulator from FLAGS
        AND     $40             ; mask to test BIT 6 of FLAGS and clear
                                ; the other bits in A.
                                ; numeric result expected ?
        JR      NZ,L211A        ; forward to IN-PR-1 if so

        LD      C,$03           ; increase space to three bytes for the
                                ; pair of surrounding quotes.

;; IN-PR-1
L211A:  OR      (HL)            ; if numeric result, set bit 6 of FLAGX.
        LD      (HL),A          ; and update system variable

;; IN-PR-2
L211C:  RST     30H             ; BC-SPACES opens 1 or 3 bytes in workspace
        LD      (HL),$0D        ; insert carriage return at last new location.
        LD      A,C             ; fetch the length, one or three.
        RRCA                    ; lose bit 0.
        RRCA                    ; test if quotes required.
        JR      NC,L2129        ; forward to IN-PR-3 if not.

        LD      A,$22           ; load the '"' character
        LD      (DE),A          ; place quote in first new location at DE.
        DEC     HL              ; decrease HL - from carriage return.
        LD      (HL),A          ; and place a quote in second location.

;; IN-PR-3
L2129:  LD      ($5C5B),HL      ; set keyboard cursor K_CUR to HL
        BIT     7,(IY+$37)      ; test FLAGX  - is this INPUT LINE ??
        JR      NZ,L215E        ; forward to IN-VAR-3 if so as input will
                                ; be accepted without checking its syntax.

        LD      HL,($5C5D)      ; fetch CH_ADD
        PUSH    HL              ; and save on stack.
        LD      HL,($5C3D)      ; fetch ERR_SP
        PUSH    HL              ; and save on stack

;; IN-VAR-1
L213A:  LD      HL,L213A        ; address: IN-VAR-1 - this address
        PUSH    HL              ; is saved on stack to handle errors.
        BIT     4,(IY+$30)      ; test FLAGS2  - is K channel in use ?
        JR      Z,L2148         ; forward to IN-VAR-2 if not using the
                                ; keyboard for input. (??)

        LD      ($5C3D),SP      ; set ERR_SP to point to IN-VAR-1 on stack.

;; IN-VAR-2
L2148:  LD      HL,($5C61)      ; set HL to WORKSP - start of workspace.
        CALL    L11A7           ; routine REMOVE-FP removes floating point
                                ; forms when looping in error condition.
        LD      (IY+$00),$FF    ; set ERR_NR to 'OK' cancelling the error.
                                ; but X_PTR causes flashing error marker
                                ; to be displayed at each call to the editor.
        CALL    L0F2C           ; routine EDITOR allows input to be entered
                                ; or corrected if this is second time around.

; if we pass to next then there are no system errors

        RES     7,(IY+$01)      ; update FLAGS  - signal checking syntax
        CALL    L21B9           ; routine IN-ASSIGN checks syntax using
                                ; the VAL-FET-2 and powerful SCANNING routines.
                                ; any syntax error and its back to IN-VAR-1.
                                ; but with the flashing error marker showing
                                ; where the error is.
                                ; Note. the syntax of string input has to be
                                ; checked as the user may have removed the
                                ; bounding quotes or escaped them as with
                                ; "hat" + "stand" for example.
; proceed if syntax passed.

        JR      L2161           ; jump forward to IN-VAR-4

; ---

; the jump was to here when using INPUT LINE.

;; IN-VAR-3
L215E:  CALL    L0F2C           ; routine EDITOR is called for input

; when ENTER received rejoin other route but with no syntax check.

; INPUT and INPUT LINE converge here.

;; IN-VAR-4
L2161:  LD      (IY+$22),$00    ; set K_CUR_hi to a low value so that the cursor
                                ; no longer appears in the input line.

        CALL    L21D6           ; routine IN-CHAN-K tests if the keyboard
                                ; is being used for input.
        JR      NZ,L2174        ; forward to IN-VAR-5 if using another input 
                                ; channel.

; continue here if using the keyboard.

        CALL    L111D           ; routine ED-COPY overprints the edit line
                                ; to the lower screen. The only visible
                                ; affect is that the cursor disappears.
                                ; if you're inputting more than one item in
                                ; a statement then that becomes apparent.

        LD      BC,($5C82)      ; fetch line and column from ECHO_E
        CALL    L0DD9           ; routine CL-SET sets S-POSNL to those
                                ; values.

; if using another input channel rejoin here.

;; IN-VAR-5
L2174:  LD      HL,$5C71        ; point HL to FLAGX
        RES     5,(HL)          ; signal not in input mode
        BIT     7,(HL)          ; is this INPUT LINE ?
        RES     7,(HL)          ; cancel the bit anyway.
        JR      NZ,L219B        ; forward to IN-VAR-6 if INPUT LINE.

        POP     HL              ; drop the looping address
        POP     HL              ; drop the address of previous
                                ; error handler.
        LD      ($5C3D),HL      ; set ERR_SP to point to it.
        POP     HL              ; drop original CH_ADD which points to
                                ; INPUT command in BASIC line.
        LD      ($5C5F),HL      ; save in X_PTR while input is assigned.
        SET     7,(IY+$01)      ; update FLAGS - Signal running program
        CALL    L21B9           ; routine IN-ASSIGN is called again
                                ; this time the variable will be assigned
                                ; the input value without error.
                                ; Note. the previous example now
                                ; becomes "hatstand"

        LD      HL,($5C5F)      ; fetch stored CH_ADD value from X_PTR.
        LD      (IY+$26),$00    ; set X_PTR_hi so that iy is no longer relevant.
        LD      ($5C5D),HL      ; put restored value back in CH_ADD
        JR      L21B2           ; forward to IN-NEXT-2 to see if anything
                                ; more in the INPUT list.

; ---

; the jump was to here with INPUT LINE only

;; IN-VAR-6
L219B:  LD      HL,($5C63)      ; STKBOT points to the end of the input.
        LD      DE,($5C61)      ; WORKSP points to the beginning.
        SCF                     ; prepare for true subtraction.
        SBC     HL,DE           ; subtract to get length
        LD      B,H             ; transfer it to
        LD      C,L             ; the BC register pair.
        CALL    L2AB2           ; routine STK-STO-$ stores parameters on
                                ; the calculator stack.
        CALL    L2AFF           ; routine LET assigns it to destination.
        JR      L21B2           ; forward to IN-NEXT-2 as print items
                                ; not allowed with INPUT LINE.
                                ; Note. that "hat" + "stand" will, for
                                ; example, be unchanged as also would
                                ; 'PRINT "Iris was here"'.

; ---

; the jump was to here when ALPHA found more items while looking for
; a variable name.

;; IN-NEXT-1
L21AF:  CALL    L1FFC           ; routine PR-ITEM-1 considers further items.

;; IN-NEXT-2
L21B2:  CALL    L204E           ; routine PR-POSN-1 handles a position item.
        JP      Z,L20C1         ; jump back to IN-ITEM-1 if the zero flag
                                ; indicates more items are present.

        RET                     ; return.

; ---------------------------
; INPUT ASSIGNMENT Subroutine
; ---------------------------
; This subroutine is called twice from the INPUT command when normal
; keyboard input is assigned. On the first occasion syntax is checked
; using SCANNING. The final call with the syntax flag reset is to make
; the assignment.

;; IN-ASSIGN
L21B9:  LD      HL,($5C61)      ; fetch WORKSP start of input
        LD      ($5C5D),HL      ; set CH_ADD to first character

        RST     18H             ; GET-CHAR ignoring leading white-space.
        CP      $E2             ; is it 'STOP'
        JR      Z,L21D0         ; forward to IN-STOP if so.

        LD      A,($5C71)       ; load accumulator from FLAGX
        CALL    L1C59           ; routine VAL-FET-2 makes assignment
                                ; or goes through the motions if checking
                                ; syntax. SCANNING is used.

        RST     18H             ; GET-CHAR
        CP      $0D             ; is it carriage return ?
        RET     Z               ; return if so
                                ; either syntax is OK
                                ; or assignment has been made.

; if another character was found then raise an error.
; User doesn't see report but the flashing error marker
; appears in the lower screen.

;; REPORT-Cb
L21CE:  RST     08H             ; ERROR-1
        DEFB    $0B             ; Error Report: Nonsense in BASIC

;; IN-STOP
L21D0:  CALL    L2530           ; routine SYNTAX-Z (UNSTACK-Z?)
        RET     Z               ; return if checking syntax
                                ; as user wouldn't see error report.
                                ; but generate visible error report
                                ; on second invocation.

;; REPORT-H
L21D4:  RST     08H             ; ERROR-1
        DEFB    $10             ; Error Report: STOP in INPUT

; -----------------------------------
; THE 'TEST FOR CHANNEL K' SUBROUTINE
; -----------------------------------
;   This subroutine is called once from the keyboard INPUT command to check if 
;   the input routine in use is the one for the keyboard.

;; IN-CHAN-K
L21D6:  LD      HL,($5C51)      ; fetch address of current channel CURCHL
        INC     HL              ;
        INC     HL              ; advance past
        INC     HL              ; input and
        INC     HL              ; output streams
        LD      A,(HL)          ; fetch the channel identifier.
        CP      $4B             ; test for 'K'
        RET                     ; return with zero set if keyboard is use.

; --------------------
; Colour Item Routines
; --------------------
;
; These routines have 3 entry points -
; 1) CO-TEMP-2 to handle a series of embedded Graphic colour items.
; 2) CO-TEMP-3 to handle a single embedded print colour item.
; 3) CO TEMP-4 to handle a colour command such as FLASH 1
;
; "Due to a bug, if you bring in a peripheral channel and later use a colour
;  statement, colour controls will be sent to it by mistake." - Steven Vickers
;  Pitman Pocket Guide, 1984.
;
; To be fair, this only applies if the last channel was other than 'K', 'S'
; or 'P', which are all that are supported by this ROM, but if that last
; channel was a microdrive file, network channel etc. then
; PAPER 6; CLS will not turn the screen yellow and
; CIRCLE INK 2; 128,88,50 will not draw a red circle.
;
; This bug does not apply to embedded PRINT items as it is quite permissible
; to mix stream altering commands and colour items.
; The fix therefore would be to ensure that CLASS-07 and CLASS-09 make
; channel 'S' the current channel when not checking syntax.
; -----------------------------------------------------------------

;; CO-TEMP-1
L21E1:  RST     20H             ; NEXT-CHAR

; -> Entry point from CLASS-09. Embedded Graphic colour items.
; e.g. PLOT INK 2; PAPER 8; 128,88
; Loops till all colour items output, finally addressing the coordinates.

;; CO-TEMP-2
L21E2:  CALL    L21F2           ; routine CO-TEMP-3 to output colour control.
        RET     C               ; return if nothing more to output. ->


        RST     18H             ; GET-CHAR
        CP      $2C             ; is it ',' separator ?
        JR      Z,L21E1         ; back if so to CO-TEMP-1

        CP      $3B             ; is it ';' separator ?
        JR      Z,L21E1         ; back to CO-TEMP-1 for more.

        JP      L1C8A           ; to REPORT-C (REPORT-Cb is within range)
                                ; 'Nonsense in BASIC'

; -------------------
; CO-TEMP-3
; -------------------
; -> this routine evaluates and outputs a colour control and parameter.
; It is called from above and also from PR-ITEM-3 to handle a single embedded
; print item e.g. PRINT PAPER 6; "Hi". In the latter case, the looping for
; multiple items is within the PR-ITEM routine.
; It is quite permissible to send these to any stream.

;; CO-TEMP-3
L21F2:  CP      $D9             ; is it 'INK' ?
        RET     C               ; return if less.

        CP      $DF             ; compare with 'OUT'
        CCF                     ; Complement Carry Flag
        RET     C               ; return if greater than 'OVER', $DE.

        PUSH    AF              ; save the colour token.

        RST     20H             ; address NEXT-CHAR
        POP     AF              ; restore token and continue.

; -> this entry point used by CLASS-07. e.g. the command PAPER 6.

;; CO-TEMP-4
L21FC:  SUB     $C9             ; reduce to control character $10 (INK)
                                ; thru $15 (OVER).
        PUSH    AF              ; save control.
        CALL    L1C82           ; routine EXPT-1NUM stacks addressed
                                ; parameter on calculator stack.
        POP     AF              ; restore control.
        AND     A               ; clear carry

        CALL    L1FC3           ; routine UNSTACK-Z returns if checking syntax.

        PUSH    AF              ; save again
        CALL    L1E94           ; routine FIND-INT1 fetches parameter to A.
        LD      D,A             ; transfer now to D
        POP     AF              ; restore control.

        RST     10H             ; PRINT-A outputs the control to current
                                ; channel.
        LD      A,D             ; transfer parameter to A.

        RST     10H             ; PRINT-A outputs parameter.
        RET                     ; return. ->

; -------------------------------------------------------------------------
;
;         {fl}{br}{   paper   }{  ink    }    The temporary colour attributes
;          ___ ___ ___ ___ ___ ___ ___ ___    system variable.
; ATTR_T  |   |   |   |   |   |   |   |   |
;         |   |   |   |   |   |   |   |   |
; 23695   |___|___|___|___|___|___|___|___|
;           7   6   5   4   3   2   1   0
;
;
;         {fl}{br}{   paper   }{  ink    }    The temporary mask used for
;          ___ ___ ___ ___ ___ ___ ___ ___    transparent colours. Any bit
; MASK_T  |   |   |   |   |   |   |   |   |   that is 1 shows that the
;         |   |   |   |   |   |   |   |   |   corresponding attribute is
; 23696   |___|___|___|___|___|___|___|___|   taken not from ATTR-T but from
;           7   6   5   4   3   2   1   0     what is already on the screen.
;
;
;         {paper9 }{ ink9 }{ inv1 }{ over1}   The print flags. Even bits are
;          ___ ___ ___ ___ ___ ___ ___ ___    temporary flags. The odd bits
; P_FLAG  |   |   |   |   |   |   |   |   |   are the permanent flags.
;         | p | t | p | t | p | t | p | t |
; 23697   |___|___|___|___|___|___|___|___|
;           7   6   5   4   3   2   1   0
;
; -----------------------------------------------------------------------

; ------------------------------------
;  The colour system variable handler.
; ------------------------------------
; This is an exit branch from PO-1-OPER, PO-2-OPER
; A holds control $10 (INK) to $15 (OVER)
; D holds parameter 0-9 for ink/paper 0,1 or 8 for bright/flash,
; 0 or 1 for over/inverse.

;; CO-TEMP-5
L2211:  SUB     $11             ; reduce range $FF-$04
        ADC     A,$00           ; add in carry if INK
        JR      Z,L2234         ; forward to CO-TEMP-7 with INK and PAPER.

        SUB     $02             ; reduce range $FF-$02
        ADC     A,$00           ; add carry if FLASH
        JR      Z,L2273         ; forward to CO-TEMP-C with FLASH and BRIGHT.

        CP      $01             ; is it 'INVERSE' ?
        LD      A,D             ; fetch parameter for INVERSE/OVER
        LD      B,$01           ; prepare OVER mask setting bit 0.
        JR      NZ,L2228        ; forward to CO-TEMP-6 if OVER

        RLCA                    ; shift bit 0
        RLCA                    ; to bit 2
        LD      B,$04           ; set bit 2 of mask for inverse.

;; CO-TEMP-6
L2228:  LD      C,A             ; save the A
        LD      A,D             ; re-fetch parameter
        CP      $02             ; is it less than 2
        JR      NC,L2244        ; to REPORT-K if not 0 or 1.
                                ; 'Invalid colour'.

        LD      A,C             ; restore A
        LD      HL,$5C91        ; address system variable P_FLAG
        JR      L226C           ; forward to exit via routine CO-CHANGE

; ---

; the branch was here with INK/PAPER and carry set for INK.

;; CO-TEMP-7
L2234:  LD      A,D             ; fetch parameter
        LD      B,$07           ; set ink mask 00000111
        JR      C,L223E         ; forward to CO-TEMP-8 with INK

        RLCA                    ; shift bits 0-2
        RLCA                    ; to
        RLCA                    ; bits 3-5
        LD      B,$38           ; set paper mask 00111000

; both paper and ink rejoin here

;; CO-TEMP-8
L223E:  LD      C,A             ; value to C
        LD      A,D             ; fetch parameter
        CP      $0A             ; is it less than 10d ?
        JR      C,L2246         ; forward to CO-TEMP-9 if so.

; ink 10 etc. is not allowed.

;; REPORT-K
L2244:  RST     08H             ; ERROR-1
        DEFB    $13             ; Error Report: Invalid colour

;; CO-TEMP-9
L2246:  LD      HL,$5C8F        ; address system variable ATTR_T initially.
        CP      $08             ; compare with 8
        JR      C,L2258         ; forward to CO-TEMP-B with 0-7.

        LD      A,(HL)          ; fetch temporary attribute as no change.
        JR      Z,L2257         ; forward to CO-TEMP-A with INK/PAPER 8

; it is either ink 9 or paper 9 (contrasting)

        OR      B               ; or with mask to make white
        CPL                     ; make black and change other to dark
        AND     $24             ; 00100100
        JR      Z,L2257         ; forward to CO-TEMP-A if black and
                                ; originally light.

        LD      A,B             ; else just use the mask (white)

;; CO-TEMP-A
L2257:  LD      C,A             ; save A in C

;; CO-TEMP-B
L2258:  LD      A,C             ; load colour to A
        CALL    L226C           ; routine CO-CHANGE addressing ATTR-T

        LD      A,$07           ; put 7 in accumulator
        CP      D               ; compare with parameter
        SBC     A,A             ; $00 if 0-7, $FF if 8
        CALL    L226C           ; routine CO-CHANGE addressing MASK-T
                                ; mask returned in A.

; now consider P-FLAG.

        RLCA                    ; 01110000 or 00001110
        RLCA                    ; 11100000 or 00011100
        AND     $50             ; 01000000 or 00010000  (AND 01010000)
        LD      B,A             ; transfer to mask
        LD      A,$08           ; load A with 8
        CP      D               ; compare with parameter
        SBC     A,A             ; $FF if was 9,  $00 if 0-8
                                ; continue while addressing P-FLAG
                                ; setting bit 4 if ink 9
                                ; setting bit 6 if paper 9

; -----------------------
; Handle change of colour
; -----------------------
; This routine addresses a system variable ATTR_T, MASK_T or P-FLAG in HL.
; colour value in A, mask in B.

;; CO-CHANGE
L226C:  XOR     (HL)            ; impress bits specified
        AND     B               ; by mask
        XOR     (HL)            ; on system variable.
        LD      (HL),A          ; update system variable.
        INC     HL              ; address next location.
        LD      A,B             ; put current value of mask in A
        RET                     ; return.

; ---

; the branch was here with flash and bright

;; CO-TEMP-C
L2273:  SBC     A,A             ; set zero flag for bright.
        LD      A,D             ; fetch original parameter 0,1 or 8
        RRCA                    ; rotate bit 0 to bit 7
        LD      B,$80           ; mask for flash 10000000
        JR      NZ,L227D        ; forward to CO-TEMP-D if flash

        RRCA                    ; rotate bit 7 to bit 6
        LD      B,$40           ; mask for bright 01000000

;; CO-TEMP-D
L227D:  LD      C,A             ; store value in C
        LD      A,D             ; fetch parameter
        CP      $08             ; compare with 8
        JR      Z,L2287         ; forward to CO-TEMP-E if 8

        CP      $02             ; test if 0 or 1
        JR      NC,L2244        ; back to REPORT-K if not
                                ; 'Invalid colour'

;; CO-TEMP-E
L2287:  LD      A,C             ; value to A
        LD      HL,$5C8F        ; address ATTR_T
        CALL    L226C           ; routine CO-CHANGE addressing ATTR_T
        LD      A,C             ; fetch value
        RRCA                    ; for flash8/bright8 complete
        RRCA                    ; rotations to put set bit in
        RRCA                    ; bit 7 (flash) bit 6 (bright)
        JR      L226C           ; back to CO-CHANGE addressing MASK_T
                                ; and indirect return.

; ---------------------
; Handle BORDER command
; ---------------------
; Command syntax example: BORDER 7
; This command routine sets the border to one of the eight colours.
; The colours used for the lower screen are based on this.

;; BORDER
L2294:  CALL    L1E94           ; routine FIND-INT1
        CP      $08             ; must be in range 0 (black) to 7 (white)
        JR      NC,L2244        ; back to REPORT-K if not
                                ; 'Invalid colour'.

        OUT     ($FE),A         ; outputting to port effects an immediate
                                ; change.
        RLCA                    ; shift the colour to
        RLCA                    ; the paper bits setting the
        RLCA                    ; ink colour black.
        BIT     5,A             ; is the number light coloured ?
                                ; i.e. in the range green to white.
        JR      NZ,L22A6        ; skip to BORDER-1 if so

        XOR     $07             ; make the ink white.

;; BORDER-1
L22A6:  LD      ($5C48),A       ; update BORDCR with new paper/ink
        RET                     ; return.

; -----------------
; Get pixel address
; -----------------
;
;

;; PIXEL-ADD
L22AA:  LD      A,$AF           ; load with 175 decimal.
        SUB     B               ; subtract the y value.
        JP      C,L24F9         ; jump forward to REPORT-Bc if greater.
                                ; 'Integer out of range'

; the high byte is derived from Y only.
; the first 3 bits are always 010
; the next 2 bits denote in which third of the screen the byte is.
; the last 3 bits denote in which of the 8 scan lines within a third
; the byte is located. There are 24 discrete values.


        LD      B,A             ; the line number from top of screen to B.
        AND     A               ; clear carry (already clear)
        RRA                     ;                     0xxxxxxx
        SCF                     ; set carry flag
        RRA                     ;                     10xxxxxx
        AND     A               ; clear carry flag
        RRA                     ;                     010xxxxx

        XOR     B               ;
        AND     $F8             ; keep the top 5 bits 11111000
        XOR     B               ;                     010xxbbb
        LD      H,A             ; transfer high byte to H.

; the low byte is derived from both X and Y.

        LD      A,C             ; the x value 0-255.
        RLCA                    ;
        RLCA                    ;
        RLCA                    ;
        XOR     B               ; the y value
        AND     $C7             ; apply mask             11000111
        XOR     B               ; restore unmasked bits  xxyyyxxx
        RLCA                    ; rotate to              xyyyxxxx
        RLCA                    ; required position.     yyyxxxxx
        LD      L,A             ; low byte to L.

; finally form the pixel position in A.

        LD      A,C             ; x value to A
        AND     $07             ; mod 8
        RET                     ; return

; ----------------
; Point Subroutine
; ----------------
; The point subroutine is called from s-point via the scanning functions
; table.

;; POINT-SUB
L22CB:  CALL    L2307           ; routine STK-TO-BC
        CALL    L22AA           ; routine PIXEL-ADD finds address of pixel.
        LD      B,A             ; pixel position to B, 0-7.
        INC     B               ; increment to give rotation count 1-8.
        LD      A,(HL)          ; fetch byte from screen.

;; POINT-LP
L22D4:  RLCA                    ; rotate and loop back
        DJNZ    L22D4           ; to POINT-LP until pixel at right.

        AND      $01            ; test to give zero or one.
        JP      L2D28           ; jump forward to STACK-A to save result.

; -------------------
; Handle PLOT command
; -------------------
; Command Syntax example: PLOT 128,88
;

;; PLOT
L22DC:  CALL    L2307           ; routine STK-TO-BC
        CALL    L22E5           ; routine PLOT-SUB
        JP      L0D4D           ; to TEMPS

; -------------------
; The Plot subroutine
; -------------------
; A screen byte holds 8 pixels so it is necessary to rotate a mask
; into the correct position to leave the other 7 pixels unaffected.
; However all 64 pixels in the character cell take any embedded colour
; items.
; A pixel can be reset (inverse 1), toggled (over 1), or set ( with inverse
; and over switches off). With both switches on, the byte is simply put
; back on the screen though the colours may change.

;; PLOT-SUB
L22E5:  LD      ($5C7D),BC      ; store new x/y values in COORDS
        CALL    L22AA           ; routine PIXEL-ADD gets address in HL,
                                ; count from left 0-7 in B.
        LD      B,A             ; transfer count to B.
        INC     B               ; increase 1-8.
        LD      A,$FE           ; 11111110 in A.

;; PLOT-LOOP
L22F0:  RRCA                    ; rotate mask.
        DJNZ    L22F0           ; to PLOT-LOOP until B circular rotations.

        LD      B,A             ; load mask to B
        LD      A,(HL)          ; fetch screen byte to A

        LD      C,(IY+$57)      ; P_FLAG to C
        BIT     0,C             ; is it to be OVER 1 ?
        JR      NZ,L22FD        ; forward to PL-TST-IN if so.

; was over 0

        AND     B               ; combine with mask to blank pixel.

;; PL-TST-IN
L22FD:  BIT     2,C             ; is it inverse 1 ?
        JR      NZ,L2303        ; to PLOT-END if so.

        XOR     B               ; switch the pixel
        CPL                     ; restore other 7 bits

;; PLOT-END
L2303:  LD      (HL),A          ; load byte to the screen.
        JP      L0BDB           ; exit to PO-ATTR to set colours for cell.

; ------------------------------
; Put two numbers in BC register
; ------------------------------
;
;

;; STK-TO-BC
L2307:  CALL    L2314           ; routine STK-TO-A
        LD      B,A             ;
        PUSH    BC              ;
        CALL    L2314           ; routine STK-TO-A
        LD      E,C             ;
        POP     BC              ;
        LD      D,C             ;
        LD      C,A             ;
        RET                     ;

; -----------------------
; Put stack in A register
; -----------------------
; This routine puts the last value on the calculator stack into the accumulator
; deleting the last value.

;; STK-TO-A
L2314:  CALL    L2DD5           ; routine FP-TO-A compresses last value into
                                ; accumulator. e.g. PI would become 3. 
                                ; zero flag set if positive.
        JP      C,L24F9         ; jump forward to REPORT-Bc if >= 255.5.

        LD      C,$01           ; prepare a positive sign byte.
        RET     Z               ; return if FP-TO-BC indicated positive.

        LD      C,$FF           ; prepare negative sign byte and
        RET                     ; return.


; --------------------
; THE 'CIRCLE' COMMAND
; --------------------
;   "Goe not Thou about to Square eyther circle" -
;   - John Donne, Cambridge educated theologian, 1624
;
;   The CIRCLE command draws a circle as a series of straight lines.
;   In some ways it can be regarded as a polygon, but the first line is drawn 
;   as a tangent, taking the radius as its distance from the centre.
;
;   Both the CIRCLE algorithm and the ARC drawing algorithm make use of the
;   'ROTATION FORMULA' (see later).  It is only necessary to work out where 
;   the first line will be drawn and how long it is and then the rotation 
;   formula takes over and calculates all other rotated points.
;
;   All Spectrum circles consist of two vertical lines at each side and two 
;   horizontal lines at the top and bottom. The number of lines is calculated
;   from the radius of the circle and is always divisible by 4. For complete 
;   circles it will range from 4 for a square circle to 32 for a circle of 
;   radius 87. The Spectrum can attempt larger circles e.g. CIRCLE 0,14,255
;   but these will error as they go off-screen after four lines are drawn.
;   At the opposite end, CIRCLE 128,88,1.23 will draw a circle as a perfect 3x3
;   square using 4 straight lines although very small circles are just drawn as 
;   a dot on the screen.
;
;   The first chord drawn is the vertical chord on the right of the circle.
;   The starting point is at the base of this chord which is drawn upwards and
;   the circle continues in an anti-clockwise direction. As noted earlier the 
;   x-coordinate of this point measured from the centre of the circle is the 
;   radius. 
;
;   The CIRCLE command makes extensive use of the calculator and as part of
;   process of drawing a large circle, free memory is checked 1315 times.
;   When drawing a large arc, free memory is checked 928 times.
;   A single call to 'sin' involves 63 memory checks and so values of sine 
;   and cosine are pre-calculated and held in the mem locations. As a 
;   clever trick 'cos' is derived from 'sin' using simple arithmetic operations
;   instead of the more expensive 'cos' function.
;
;   Initially, the syntax has been partly checked using the class for the DRAW 
;   command which stacks the origin of the circle (X,Y).

;; CIRCLE
L2320:  RST     18H             ; GET-CHAR              x, y.
        CP      $2C             ; Is character the required comma ?
        JP      NZ,L1C8A        ; Jump, if not, to REPORT-C
                                ; 'Nonsense in basic'

        RST     20H             ; NEXT-CHAR advances the parsed character address.
        CALL    L1C82           ; routine EXPT-1NUM stacks radius in runtime.
        CALL    L1BEE           ; routine CHECK-END will return here in runtime
                                ; if nothing follows the command.

;   Now make the radius positive and ensure that it is in floating point form 
;   so that the exponent byte can be accessed for quick testing.

        RST     28H             ;; FP-CALC              x, y, r.
        DEFB    $2A             ;;abs                   x, y, r.
        DEFB    $3D             ;;re-stack              x, y, r.
        DEFB    $38             ;;end-calc              x, y, r.

        LD      A,(HL)          ; Fetch first, floating-point, exponent byte.
        CP      $81             ; Compare to one.
        JR      NC,L233B        ; Forward to C-R-GRE-1 
                                ; if circle radius is greater than one.

;    The circle is no larger than a single pixel so delete the radius from the
;    calculator stack and plot a point at the centre.

        RST     28H             ;; FP-CALC              x, y, r.
        DEFB    $02             ;;delete                x, y.                  
        DEFB    $38             ;;end-calc              x, y.

        JR      L22DC           ; back to PLOT routine to just plot x,y.

; ---

;   Continue when the circle's radius measures greater than one by forming 
;   the angle 2 * PI radians which is 360 degrees.

;; C-R-GRE-1
L233B:  RST     28H             ;; FP-CALC      x, y, r
        DEFB    $A3             ;;stk-pi/2      x, y, r, pi/2.
        DEFB    $38             ;;end-calc      x, y, r, pi/2.

;   Change the exponent of pi/2 from $81 to $83 giving 2*PI the central angle.
;   This is quicker than multiplying by four.

        LD      (HL),$83        ;               x, y, r, 2*PI.

;   Now store this important constant in mem-5 and delete so that other 
;   parameters can be derived from it, by a routine shared with DRAW.

        RST     28H             ;; FP-CALC      x, y, r, 2*PI.
        DEFB    $C5             ;;st-mem-5      store 2*PI in mem-5
        DEFB    $02             ;;delete        x, y, r.
        DEFB    $38             ;;end-calc      x, y, r.

;   The parameters derived from mem-5 (A) and from the radius are set up in 
;   four of the other mem locations by the CIRCLE DRAW PARAMETERS routine which 
;   also returns the number of straight lines in the B register.

        CALL    L247D           ; routine CD-PRMS1

                                ; mem-0 ; A/No of lines (=a)            unused  
                                ; mem-1 ; sin(a/2)  will be moving x    var
                                ; mem-2 ; -         will be moving y    var
                                ; mem-3 ; cos(a)                        const
                                ; mem-4 ; sin(a)                        const
                                ; mem-5 ; Angle of rotation (A) (2*PI)  const
                                ; B     ; Number of straight lines.

        PUSH    BC              ; Preserve the number of lines in B.

;   Next calculate the length of half a chord by multiplying the sine of half 
;   the central angle by the radius of the circle.

        RST     28H             ;; FP-CALC      x, y, r.
        DEFB    $31             ;;duplicate     x, y, r, r.
        DEFB    $E1             ;;get-mem-1     x, y, r, r, sin(a/2).
        DEFB    $04             ;;multiply      x, y, r, half-chord.
        DEFB    $38             ;;end-calc      x, y, r, half-chord.

        LD      A,(HL)          ; fetch exponent  of the half arc to A.
        CP      $80             ; compare to a half pixel
        JR      NC,L235A        ; forward, if greater than .5, to C-ARC-GE1

;   If the first line is less than .5 then 4 'lines' would be drawn on the same 
;   spot so tidy the calculator stack and machine stack and plot the centre.

        RST     28H             ;; FP-CALC      x, y, r, hc.
        DEFB    $02             ;;delete        x, y, r.
        DEFB    $02             ;;delete        x, y.
        DEFB    $38             ;;end-calc      x, y.

        POP     BC              ; Balance machine stack by taking chord-count.

        JP      L22DC           ; JUMP to PLOT

; ---

;   The arc is greater than 0.5 so the circle can be drawn.

;; C-ARC-GE1
L235A:  RST     28H             ;; FP-CALC      x, y, r, hc.
        DEFB    $C2             ;;st-mem-2      x, y, r, half chord to mem-2.
        DEFB    $01             ;;exchange      x, y, hc, r.
        DEFB    $C0             ;;st-mem-0      x, y, hc, r.
        DEFB    $02             ;;delete        x, y, hc.

;   Subtract the length of the half-chord from the absolute y coordinate to
;   give the starting y coordinate sy. 
;   Note that for a circle this is also the end coordinate.

        DEFB    $03             ;;subtract      x, y-hc.  (The start y-coord)
        DEFB    $01             ;;exchange      sy, x.

;   Next simply add the radius to the x coordinate to give a fuzzy x-coordinate.
;   Strictly speaking, the radius should be multiplied by cos(a/2) first but
;   doing it this way makes the circle slightly larger.

        DEFB    $E0             ;;get-mem-0     sy, x, r.
        DEFB    $0F             ;;addition      sy, x+r.  (The start x-coord)

;   We now want three copies of this pair of values on the calculator stack.
;   The first pair remain on the stack throughout the circle routine and are 
;   the end points. The next pair will be the moving absolute values of x and y
;   that are updated after each line is drawn. The final pair will be loaded 
;   into the COORDS system variable so that the first vertical line starts at 
;   the right place.

        DEFB    $C0             ;;st-mem-0      sy, sx.
        DEFB    $01             ;;exchange      sx, sy.
        DEFB    $31             ;;duplicate     sx, sy, sy.
        DEFB    $E0             ;;get-mem-0     sx, sy, sy, sx.
        DEFB    $01             ;;exchange      sx, sy, sx, sy.
        DEFB    $31             ;;duplicate     sx, sy, sx, sy, sy.
        DEFB    $E0             ;;get-mem-0     sx, sy, sx, sy, sy, sx.

;   Locations mem-1 and mem-2 are the relative x and y values which are updated
;   after each line is drawn. Since we are drawing a vertical line then the rx
;   value in mem-1 is zero and the ry value in mem-2 is the full chord.

        DEFB    $A0             ;;stk-zero      sx, sy, sx, sy, sy, sx, 0.
        DEFB    $C1             ;;st-mem-1      sx, sy, sx, sy, sy, sx, 0.
        DEFB    $02             ;;delete        sx, sy, sx, sy, sy, sx.

;   Although the three pairs of x/y values are the same for a circle, they 
;   will be labelled terminating, absolute and start coordinates.

        DEFB    $38             ;;end-calc      tx, ty, ax, ay, sy, sx.

;   Use the exponent manipulating trick again to double the value of mem-2.

        INC     (IY+$62)        ; Increment MEM-2-1st doubling half chord.

;   Note. this first vertical chord is drawn at the radius so circles are
;   slightly displaced to the right.
;   It is only necessary to place the values (sx) and (sy) in the system 
;   variable COORDS to ensure that drawing commences at the correct pixel.
;   Note. a couple of LD (COORDS),A instructions would have been quicker, and 
;   simpler, than using LD (COORDS),HL.

        CALL    L1E94           ; routine FIND-INT1 fetches sx from stack to A.

        LD      L,A             ; place X value in L.
        PUSH    HL              ; save the holding register.

        CALL    L1E94           ; routine FIND-INT1 fetches sy to A

        POP     HL              ; restore the holding register.
        LD      H,A             ; and place y value in high byte.

        LD      ($5C7D),HL      ; Update the COORDS system variable.
                                ;
                                ;               tx, ty, ax, ay.

        POP     BC              ; restore the chord count  
                                ; values 4,8,12,16,20,24,28 or 32.

        JP      L2420           ; forward to DRW-STEPS
                                ;               tx, ty, ax, ay.

;   Note. the jump to DRW-STEPS is just to decrement B and jump into the 
;   middle of the arc-drawing loop. The arc count which includes the first 
;   vertical arc draws one less than the perceived number of arcs. 
;   The final arc offsets are obtained by subtracting the final COORDS value
;   from the initial sx and sy values which are kept at the base of the
;   calculator stack throughout the arc loop. 
;   This ensures that the final line finishes exactly at the starting pixel 
;   removing the possibility of any inaccuracy.
;   Since the initial sx and sy values are not required until the final arc
;   is drawn, they are not shown until then.
;   As the calculator stack is quite busy, only the active parts are shown in 
;   each section.


; ------------------
; THE 'DRAW' COMMAND
; ------------------
;   The Spectrum's DRAW command is overloaded and can take two parameters sets.
;
;   With two parameters, it simply draws an approximation to a straight line
;   at offset x,y using the LINE-DRAW routine.
;
;   With three parameters, an arc is drawn to the point at offset x,y turning 
;   through an angle, in radians, supplied by the third parameter.
;   The arc will consist of 4 to 252 straight lines each one of which is drawn 
;   by calls to the DRAW-LINE routine.

;; DRAW
L2382:  RST     18H             ; GET-CHAR
        CP      $2C             ; is it the comma character ?
        JR      Z,L238D         ; forward, if so, to DR-3-PRMS

;   There are two parameters e.g. DRAW 255,175

        CALL    L1BEE           ; routine CHECK-END

        JP      L2477           ; jump forward to LINE-DRAW

; ---

;    There are three parameters e.g. DRAW 255, 175, .5
;    The first two are relative coordinates and the third is the angle of 
;    rotation in radians (A).

;; DR-3-PRMS
L238D:  RST     20H             ; NEXT-CHAR skips over the 'comma'.

        CALL    L1C82           ; routine EXPT-1NUM stacks the rotation angle.

        CALL    L1BEE           ; routine CHECK-END

;   Now enter the calculator and store the complete rotation angle in mem-5 

        RST     28H             ;; FP-CALC      x, y, A.
        DEFB    $C5             ;;st-mem-5      x, y, A.

;   Test the angle for the special case of 360 degrees.

        DEFB    $A2             ;;stk-half      x, y, A, 1/2.
        DEFB    $04             ;;multiply      x, y, A/2.
        DEFB    $1F             ;;sin           x, y, sin(A/2).
        DEFB    $31             ;;duplicate     x, y, sin(A/2),sin(A/2)
        DEFB    $30             ;;not           x, y, sin(A/2), (0/1).
        DEFB    $30             ;;not           x, y, sin(A/2), (1/0).
        DEFB    $00             ;;jump-true     x, y, sin(A/2).

        DEFB    $06             ;;forward to L23A3, DR-SIN-NZ
                                ; if sin(r/2) is not zero.

;   The third parameter is 2*PI (or a multiple of 2*PI) so a 360 degrees turn
;   would just be a straight line.  Eliminating this case here prevents 
;   division by zero at later stage.

        DEFB    $02             ;;delete        x, y.
        DEFB    $38             ;;end-calc      x, y.

        JP      L2477           ; forward to LINE-DRAW

; ---

;   An arc can be drawn.

;; DR-SIN-NZ
L23A3:  DEFB    $C0             ;;st-mem-0      x, y, sin(A/2).   store mem-0
        DEFB    $02             ;;delete        x, y.

;   The next step calculates (roughly) the diameter of the circle of which the 
;   arc will form part.  This value does not have to be too accurate as it is
;   only used to evaluate the number of straight lines and then discarded.
;   After all for a circle, the radius is used. Consequently, a circle of 
;   radius 50 will have 24 straight lines but an arc of radius 50 will have 20
;   straight lines - when drawn in any direction.
;   So that simple arithmetic can be used, the length of the chord can be 
;   calculated as X+Y rather than by Pythagoras Theorem and the sine of the
;   nearest angle within reach is used.

        DEFB    $C1             ;;st-mem-1      x, y.             store mem-1
        DEFB    $02             ;;delete        x.

        DEFB    $31             ;;duplicate     x, x.
        DEFB    $2A             ;;abs           x, x (+ve).
        DEFB    $E1             ;;get-mem-1     x, X, y.
        DEFB    $01             ;;exchange      x, y, X.
        DEFB    $E1             ;;get-mem-1     x, y, X, y.
        DEFB    $2A             ;;abs           x, y, X, Y (+ve).
        DEFB    $0F             ;;addition      x, y, X+Y.
        DEFB    $E0             ;;get-mem-0     x, y, X+Y, sin(A/2).
        DEFB    $05             ;;division      x, y, X+Y/sin(A/2).
        DEFB    $2A             ;;abs           x, y, X+Y/sin(A/2) = D.

;    Bring back sin(A/2) from mem-0 which will shortly get trashed.
;    Then bring D to the top of the stack again.

        DEFB    $E0             ;;get-mem-0     x, y, D, sin(A/2).
        DEFB    $01             ;;exchange      x, y, sin(A/2), D.

;   Note. that since the value at the top of the stack has arisen as a result
;   of division then it can no longer be in integer form and the next re-stack
;   is unnecessary. Only the Sinclair ZX80 had integer division.

        DEFB    $3D             ;;re-stack      (unnecessary)

        DEFB    $38             ;;end-calc      x, y, sin(A/2), D.

;   The next test avoids drawing 4 straight lines when the start and end pixels
;   are adjacent (or the same) but is probably best dispensed with.

        LD      A,(HL)          ; fetch exponent byte of D.
        CP      $81             ; compare to 1
        JR      NC,L23C1        ; forward, if > 1,  to DR-PRMS

;   else delete the top two stack values and draw a simple straight line.

        RST     28H             ;; FP-CALC
        DEFB    $02             ;;delete
        DEFB    $02             ;;delete
        DEFB    $38             ;;end-calc      x, y.

        JP      L2477           ; to LINE-DRAW

; ---

;   The ARC will consist of multiple straight lines so call the CIRCLE-DRAW
;   PARAMETERS ROUTINE to pre-calculate sine values from the angle (in mem-5)
;   and determine also the number of straight lines from that value and the
;   'diameter' which is at the top of the calculator stack.

;; DR-PRMS
L23C1:  CALL    L247D           ; routine CD-PRMS1

                                ; mem-0 ; (A)/No. of lines (=a) (step angle)
                                ; mem-1 ; sin(a/2) 
                                ; mem-2 ; -
                                ; mem-3 ; cos(a)                        const
                                ; mem-4 ; sin(a)                        const
                                ; mem-5 ; Angle of rotation (A)         in
                                ; B     ; Count of straight lines - max 252.

        PUSH    BC              ; Save the line count on the machine stack.

;   Remove the now redundant diameter value D.

        RST     28H             ;; FP-CALC      x, y, sin(A/2), D.
        DEFB    $02             ;;delete        x, y, sin(A/2).

;   Dividing the sine of the step angle by the sine of the total angle gives
;   the length of the initial chord on a unary circle. This factor f is used
;   to scale the coordinates of the first line which still points in the 
;   direction of the end point and may be larger.

        DEFB    $E1             ;;get-mem-1     x, y, sin(A/2), sin(a/2)
        DEFB    $01             ;;exchange      x, y, sin(a/2), sin(A/2)
        DEFB    $05             ;;division      x, y, sin(a/2)/sin(A/2)
        DEFB    $C1             ;;st-mem-1      x, y. f.
        DEFB    $02             ;;delete        x, y.

;   With the factor stored, scale the x coordinate first.

        DEFB    $01             ;;exchange      y, x.
        DEFB    $31             ;;duplicate     y, x, x.
        DEFB    $E1             ;;get-mem-1     y, x, x, f.
        DEFB    $04             ;;multiply      y, x, x*f    (=xx)
        DEFB    $C2             ;;st-mem-2      y, x, xx.
        DEFB    $02             ;;delete        y. x.

;   Now scale the y coordinate.

        DEFB    $01             ;;exchange      x, y.
        DEFB    $31             ;;duplicate     x, y, y.
        DEFB    $E1             ;;get-mem-1     x, y, y, f
        DEFB    $04             ;;multiply      x, y, y*f    (=yy)

;   Note. 'sin' and 'cos' trash locations mem-0 to mem-2 so fetch mem-2 to the 
;   calculator stack for safe keeping.

        DEFB    $E2             ;;get-mem-2     x, y, yy, xx.

;   Once we get the coordinates of the first straight line then the 'ROTATION
;   FORMULA' used in the arc loop will take care of all other points, but we
;   now use a variation of that formula to rotate the first arc through (A-a)/2
;   radians. 
;   
;       xRotated = y * sin(angle) + x * cos(angle)
;       yRotated = y * cos(angle) - x * sin(angle)
;
 
        DEFB    $E5             ;;get-mem-5     x, y, yy, xx, A.
        DEFB    $E0             ;;get-mem-0     x, y, yy, xx, A, a.
        DEFB    $03             ;;subtract      x, y, yy, xx, A-a.
        DEFB    $A2             ;;stk-half      x, y, yy, xx, A-a, 1/2.
        DEFB    $04             ;;multiply      x, y, yy, xx, (A-a)/2. (=angle)
        DEFB    $31             ;;duplicate     x, y, yy, xx, angle, angle.
        DEFB    $1F             ;;sin           x, y, yy, xx, angle, sin(angle)
        DEFB    $C5             ;;st-mem-5      x, y, yy, xx, angle, sin(angle)
        DEFB    $02             ;;delete        x, y, yy, xx, angle

        DEFB    $20             ;;cos           x, y, yy, xx, cos(angle).

;   Note. mem-0, mem-1 and mem-2 can be used again now...

        DEFB    $C0             ;;st-mem-0      x, y, yy, xx, cos(angle).
        DEFB    $02             ;;delete        x, y, yy, xx.

        DEFB    $C2             ;;st-mem-2      x, y, yy, xx.
        DEFB    $02             ;;delete        x, y, yy.

        DEFB    $C1             ;;st-mem-1      x, y, yy.
        DEFB    $E5             ;;get-mem-5     x, y, yy, sin(angle)
        DEFB    $04             ;;multiply      x, y, yy*sin(angle).
        DEFB    $E0             ;;get-mem-0     x, y, yy*sin(angle), cos(angle)
        DEFB    $E2             ;;get-mem-2     x, y, yy*sin(angle), cos(angle), xx.
        DEFB    $04             ;;multiply      x, y, yy*sin(angle), xx*cos(angle).
        DEFB    $0F             ;;addition      x, y, xRotated.
        DEFB    $E1             ;;get-mem-1     x, y, xRotated, yy.
        DEFB    $01             ;;exchange      x, y, yy, xRotated.
        DEFB    $C1             ;;st-mem-1      x, y, yy, xRotated.
        DEFB    $02             ;;delete        x, y, yy.

        DEFB    $E0             ;;get-mem-0     x, y, yy, cos(angle).
        DEFB    $04             ;;multiply      x, y, yy*cos(angle).
        DEFB    $E2             ;;get-mem-2     x, y, yy*cos(angle), xx.
        DEFB    $E5             ;;get-mem-5     x, y, yy*cos(angle), xx, sin(angle).
        DEFB    $04             ;;multiply      x, y, yy*cos(angle), xx*sin(angle).
        DEFB    $03             ;;subtract      x, y, yRotated.
        DEFB    $C2             ;;st-mem-2      x, y, yRotated.

;   Now the initial x and y coordinates are made positive and summed to see 
;   if they measure up to anything significant.

        DEFB    $2A             ;;abs           x, y, yRotated'.
        DEFB    $E1             ;;get-mem-1     x, y, yRotated', xRotated.
        DEFB    $2A             ;;abs           x, y, yRotated', xRotated'.
        DEFB    $0F             ;;addition      x, y, yRotated+xRotated.
        DEFB    $02             ;;delete        x, y. 

        DEFB    $38             ;;end-calc      x, y. 

;   Although the test value has been deleted it is still above the calculator
;   stack in memory and conveniently DE which points to the first free byte
;   addresses the exponent of the test value.

        LD      A,(DE)          ; Fetch exponent of the length indicator.
        CP      $81             ; Compare to that for 1

        POP     BC              ; Balance the machine stack

        JP      C,L2477         ; forward, if the coordinates of first line
                                ; don't add up to more than 1, to LINE-DRAW 

;   Continue when the arc will have a discernable shape.

        PUSH    BC              ; Restore line counter to the machine stack.

;   The parameters of the DRAW command were relative and they are now converted 
;   to absolute coordinates by adding to the coordinates of the last point 
;   plotted. The first two values on the stack are the terminal tx and ty 
;   coordinates.  The x-coordinate is converted first but first the last point 
;   plotted is saved as it will initialize the moving ax, value. 

        RST     28H             ;; FP-CALC      x, y.
        DEFB    $01             ;;exchange      y, x.
        DEFB    $38             ;;end-calc      y, x.

        LD      A,($5C7D)       ; Fetch System Variable COORDS-x
        CALL    L2D28           ; routine STACK-A

        RST     28H             ;; FP-CALC      y, x, last-x.

;   Store the last point plotted to initialize the moving ax value.

        DEFB    $C0             ;;st-mem-0      y, x, last-x.
        DEFB    $0F             ;;addition      y, absolute x.
        DEFB    $01             ;;exchange      tx, y.
        DEFB    $38             ;;end-calc      tx, y.

        LD      A,($5C7E)       ; Fetch System Variable COORDS-y
        CALL    L2D28           ; routine STACK-A

        RST     28H             ;; FP-CALC      tx, y, last-y.

;   Store the last point plotted to initialize the moving ay value.

        DEFB    $C5             ;;st-mem-5      tx, y, last-y.
        DEFB    $0F             ;;addition      tx, ty.

;   Fetch the moving ax and ay to the calculator stack.

        DEFB    $E0             ;;get-mem-0     tx, ty, ax.
        DEFB    $E5             ;;get-mem-5     tx, ty, ax, ay.
        DEFB    $38             ;;end-calc      tx, ty, ax, ay.

        POP     BC              ; Restore the straight line count.

; -----------------------------------
; THE 'CIRCLE/DRAW CONVERGENCE POINT'
; -----------------------------------
;   The CIRCLE and ARC-DRAW commands converge here. 
;
;   Note. for both the CIRCLE and ARC commands the minimum initial line count 
;   is 4 (as set up by the CD_PARAMS routine) and so the zero flag will never 
;   be set and the loop is always entered.  The first test is superfluous and
;   the jump will always be made to ARC-START.

;; DRW-STEPS
L2420:  DEC     B               ; decrement the arc count (4,8,12,16...).            

        JR      Z,L245F         ; forward, if zero (not possible), to ARC-END

        JR      L2439           ; forward to ARC-START

; --------------
; THE 'ARC LOOP'
; --------------
;
;   The arc drawing loop will draw up to 31 straight lines for a circle and up 
;   251 straight lines for an arc between two points. In both cases the final
;   closing straight line is drawn at ARC_END, but it otherwise loops back to 
;   here to calculate the next coordinate using the ROTATION FORMULA where (a)
;   is the previously calculated, constant CENTRAL ANGLE of the arcs.
;
;       Xrotated = x * cos(a) - y * sin(a)
;       Yrotated = x * sin(a) + y * cos(a)
;
;   The values cos(a) and sin(a) are pre-calculated and held in mem-3 and mem-4 
;   for the duration of the routine.
;   Memory location mem-1 holds the last relative x value (rx) and mem-2 holds
;   the last relative y value (ry) used by DRAW.
;
;   Note. that this is a very clever twist on what is after all a very clever,
;   well-used formula.  Normally the rotation formula is used with the x and y
;   coordinates from the centre of the circle (or arc) and a supplied angle to 
;   produce two new x and y coordinates in an anticlockwise direction on the 
;   circumference of the circle.
;   What is being used here, instead, is the relative X and Y parameters from
;   the last point plotted that are required to get to the current point and 
;   the formula returns the next relative coordinates to use. 

;; ARC-LOOP
L2425:  RST     28H             ;; FP-CALC      
        DEFB    $E1             ;;get-mem-1     rx.
        DEFB    $31             ;;duplicate     rx, rx.
        DEFB    $E3             ;;get-mem-3     cos(a)
        DEFB    $04             ;;multiply      rx, rx*cos(a).
        DEFB    $E2             ;;get-mem-2     rx, rx*cos(a), ry.
        DEFB    $E4             ;;get-mem-4     rx, rx*cos(a), ry, sin(a). 
        DEFB    $04             ;;multiply      rx, rx*cos(a), ry*sin(a).
        DEFB    $03             ;;subtract      rx, rx*cos(a) - ry*sin(a)
        DEFB    $C1             ;;st-mem-1      rx, new relative x rotated.
        DEFB    $02             ;;delete        rx.

        DEFB    $E4             ;;get-mem-4     rx, sin(a).
        DEFB    $04             ;;multiply      rx*sin(a)
        DEFB    $E2             ;;get-mem-2     rx*sin(a), ry.
        DEFB    $E3             ;;get-mem-3     rx*sin(a), ry, cos(a).
        DEFB    $04             ;;multiply      rx*sin(a), ry*cos(a).
        DEFB    $0F             ;;addition      rx*sin(a) + ry*cos(a).
        DEFB    $C2             ;;st-mem-2      new relative y rotated.
        DEFB    $02             ;;delete        .
        DEFB    $38             ;;end-calc      .  

;   Note. the calculator stack actually holds   tx, ty, ax, ay
;   and the last absolute values of x and y 
;   are now brought into play.
;
;   Magically, the two new rotated coordinates rx and ry are all that we would
;   require to draw a circle or arc - on paper!
;   The Spectrum DRAW routine draws to the rounded x and y coordinate and so 
;   repetitions of values like 3.49 would mean that the fractional parts 
;   would be lost until eventually the draw coordinates might differ from the 
;   floating point values used above by several pixels.
;   For this reason the accurate offsets calculated above are added to the 
;   accurate, absolute coordinates maintained in ax and ay and these new 
;   coordinates have the integer coordinates of the last plot position 
;   ( from System Variable COORDS ) subtracted from them to give the relative 
;   coordinates required by the DRAW routine.

;   The mid entry point.

;; ARC-START
L2439:  PUSH    BC              ; Preserve the arc counter on the machine stack.

;   Store the absolute ay in temporary variable mem-0 for the moment.

        RST     28H             ;; FP-CALC      ax, ay.
        DEFB    $C0             ;;st-mem-0      ax, ay.
        DEFB    $02             ;;delete        ax.

;   Now add the fractional relative x coordinate to the fractional absolute
;   x coordinate to obtain a new fractional x-coordinate.

        DEFB    $E1             ;;get-mem-1     ax, xr.
        DEFB    $0F             ;;addition      ax+xr (= new ax).  
        DEFB    $31             ;;duplicate     ax, ax.
        DEFB    $38             ;;end-calc      ax, ax. 

        LD      A,($5C7D)       ; COORDS-x      last x    (integer ix 0-255)
        CALL    L2D28           ; routine STACK-A

        RST     28H             ;; FP-CALC      ax, ax, ix.
        DEFB    $03             ;;subtract      ax, ax-ix  = relative DRAW Dx.

;   Having calculated the x value for DRAW do the same for the y value.

        DEFB    $E0             ;;get-mem-0     ax, Dx, ay.
        DEFB    $E2             ;;get-mem-2     ax, Dx, ay, ry.
        DEFB    $0F             ;;addition      ax, Dx, ay+ry (= new ay).
        DEFB    $C0             ;;st-mem-0      ax, Dx, ay.
        DEFB    $01             ;;exchange      ax, ay, Dx,
        DEFB    $E0             ;;get-mem-0     ax, ay, Dx, ay.
        DEFB    $38             ;;end-calc      ax, ay, Dx, ay.

        LD      A,($5C7E)       ; COORDS-y      last y (integer iy 0-175)
        CALL    L2D28           ; routine STACK-A

        RST     28H             ;; FP-CALC      ax, ay, Dx, ay, iy.
        DEFB    $03             ;;subtract      ax, ay, Dx, ay-iy ( = Dy).
        DEFB    $38             ;;end-calc      ax, ay, Dx, Dy.

        CALL    L24B7           ; Routine DRAW-LINE draws (Dx,Dy) relative to
                                ; the last pixel plotted leaving absolute x 
                                ; and y on the calculator stack.
                                ;               ax, ay.

        POP     BC              ; Restore the arc counter from the machine stack.

        DJNZ    L2425           ; Decrement and loop while > 0 to ARC-LOOP

; -------------
; THE 'ARC END'
; -------------

;   To recap the full calculator stack is       tx, ty, ax, ay.

;   Just as one would do if drawing the curve on paper, the final line would
;   be drawn by joining the last point plotted to the initial start point 
;   in the case of a CIRCLE or to the calculated end point in the case of 
;   an ARC.
;   The moving absolute values of x and y are no longer required and they
;   can be deleted to expose the closing coordinates.

;; ARC-END
L245F:  RST     28H             ;; FP-CALC      tx, ty, ax, ay.
        DEFB    $02             ;;delete        tx, ty, ax.
        DEFB    $02             ;;delete        tx, ty.
        DEFB    $01             ;;exchange      ty, tx.
        DEFB    $38             ;;end-calc      ty, tx.

;   First calculate the relative x coordinate to the end-point.

        LD      A,($5C7D)       ; COORDS-x
        CALL    L2D28           ; routine STACK-A

        RST     28H             ;; FP-CALC      ty, tx, coords_x.
        DEFB    $03             ;;subtract      ty, rx.

;   Next calculate the relative y coordinate to the end-point.

        DEFB    $01             ;;exchange      rx, ty.
        DEFB    $38             ;;end-calc      rx, ty.

        LD      A,($5C7E)       ; COORDS-y
        CALL    L2D28           ; routine STACK-A

        RST     28H             ;; FP-CALC      rx, ty, coords_y
        DEFB    $03             ;;subtract      rx, ry.
        DEFB    $38             ;;end-calc      rx, ry.

;   Finally draw the last straight line.

;; LINE-DRAW
L2477:  CALL    L24B7           ; routine DRAW-LINE draws to the relative 
                                ; coordinates (rx, ry).

        JP      L0D4D           ; jump back and exit via TEMPS          >>>


; --------------------------------------------
; THE 'INITIAL CIRCLE/DRAW PARAMETERS' ROUTINE
; --------------------------------------------
;   Begin by calculating the number of chords which will be returned in B.
;   A rule of thumb is employed that uses a value z which for a circle is the
;   radius and for an arc is the diameter with, as it happens, a pinch more if 
;   the arc is on a slope.
;
;   NUMBER OF STRAIGHT LINES = ANGLE OF ROTATION * SQUARE ROOT ( Z ) / 2

;; CD-PRMS1
L247D:  RST     28H             ;; FP-CALC      z.
        DEFB    $31             ;;duplicate     z, z.
        DEFB    $28             ;;sqr           z, sqr(z).
        DEFB    $34             ;;stk-data      z, sqr(z), 2.
        DEFB    $32             ;;Exponent: $82, Bytes: 1
        DEFB    $00             ;;(+00,+00,+00)
        DEFB    $01             ;;exchange      z, 2, sqr(z).
        DEFB    $05             ;;division      z, 2/sqr(z).
        DEFB    $E5             ;;get-mem-5     z, 2/sqr(z), ANGLE.
        DEFB    $01             ;;exchange      z, ANGLE, 2/sqr (z)
        DEFB    $05             ;;division      z, ANGLE*sqr(z)/2 (= No. of lines)
        DEFB    $2A             ;;abs           (for arc only)
        DEFB    $38             ;;end-calc      z, number of lines.

;    As an example for a circle of radius 87 the number of lines will be 29.

        CALL    L2DD5           ; routine FP-TO-A

;    The value is compressed into A register, no carry with valid circle.

        JR      C,L2495         ; forward, if over 256, to USE-252

;    now make a multiple of 4 e.g. 29 becomes 28

        AND     $FC             ; AND 252

;    Adding 4 could set carry for arc, for the circle example, 28 becomes 32.

        ADD     A,$04           ; adding 4 could set carry if result is 256.
        
        JR      NC,L2497        ; forward if less than 256 to DRAW-SAVE

;    For an arc, a limit of 252 is imposed.

;; USE-252
L2495:  LD      A,$FC           ; Use a value of 252 (for arc).


;   For both arcs and circles, constants derived from the central angle are
;   stored in the 'mem' locations.  Some are not relevant for the circle.

;; DRAW-SAVE
L2497:  PUSH    AF              ; Save the line count (A) on the machine stack.

        CALL    L2D28           ; Routine STACK-A stacks the modified count(A).

        RST     28H             ;; FP-CALC      z, A.
        DEFB    $E5             ;;get-mem-5     z, A, ANGLE.
        DEFB    $01             ;;exchange      z, ANGLE, A.
        DEFB    $05             ;;division      z, ANGLE/A. (Angle/count = a)
        DEFB    $31             ;;duplicate     z, a, a. 

;  Note. that cos (a) could be formed here directly using 'cos' and stored in 
;  mem-3 but that would spoil a good story and be slightly slower, as also 
;  would using square roots to form cos (a) from sin (a).

        DEFB    $1F             ;;sin           z, a, sin(a)
        DEFB    $C4             ;;st-mem-4      z, a, sin(a)
        DEFB    $02             ;;delete        z, a.
        DEFB    $31             ;;duplicate     z, a, a.            
        DEFB    $A2             ;;stk-half      z, a, a, 1/2.
        DEFB    $04             ;;multiply      z, a, a/2.
        DEFB    $1F             ;;sin           z, a, sin(a/2).

;   Note. after second sin, mem-0 and mem-1 become free.

        DEFB    $C1             ;;st-mem-1      z, a, sin(a/2).
        DEFB    $01             ;;exchange      z, sin(a/2), a.
        DEFB    $C0             ;;st-mem-0      z, sin(a/2), a.  (for arc only)

;   Now form cos(a) from sin(a/2) using the 'DOUBLE ANGLE FORMULA'.

        DEFB    $02             ;;delete        z, sin(a/2).
        DEFB    $31             ;;duplicate     z, sin(a/2), sin(a/2).
        DEFB    $04             ;;multiply      z, sin(a/2)*sin(a/2).
        DEFB    $31             ;;duplicate     z, sin(a/2)*sin(a/2),
                                ;;                           sin(a/2)*sin(a/2).
        DEFB    $0F             ;;addition      z, 2*sin(a/2)*sin(a/2).
        DEFB    $A1             ;;stk-one       z, 2*sin(a/2)*sin(a/2), 1.
        DEFB    $03             ;;subtract      z, 2*sin(a/2)*sin(a/2)-1.

        DEFB    $1B             ;;negate        z, 1-2*sin(a/2)*sin(a/2).  

        DEFB    $C3             ;;st-mem-3      z, cos(a).
        DEFB    $02             ;;delete        z.
        DEFB    $38             ;;end-calc      z.

;   The radius/diameter is left on the calculator stack.

        POP     BC              ; Restore the line count to the B register.

        RET                     ; Return.

; --------------------------
; THE 'DOUBLE ANGLE FORMULA'
; --------------------------
;   This formula forms cos(a) from sin(a/2) using simple arithmetic.
;
;   THE GEOMETRIC PROOF OF FORMULA   cos (a) = 1 - 2 * sin(a/2) * sin(a/2)
;                                                                    
;                                                                   
;                                            A                     
;                                                                 
;                                         . /|\                      
;                                     .    / | \                     
;                                  .      /  |  \                    
;                               .        /   |a/2\                   
;                            .          /    |    \                  
;                         .          1 /     |     \                 
;                      .              /      |      \                
;                   .                /       |       \               
;                .                  /        |        \              
;             .  a/2             D / a      E|-+       \             
;          B ---------------------/----------+-+--------\ C
;            <-         1       -><-       1           ->           
;
;   cos a = 1 - 2 * sin(a/2) * sin(a/2)
;
;   The figure shows a right triangle that inscribes a circle of radius 1 with
;   centre, or origin, D.  Line BC is the diameter of length 2 and A is a point 
;   on the circle. The periphery angle BAC is therefore a right angle by the 
;   Rule of Thales.
;   Line AC is a chord touching two points on the circle and the angle at the 
;   centre is (a).
;   Since the vertex of the largest triangle B touches the circle, the 
;   inscribed angle (a/2) is half the central angle (a).
;   The cosine of (a) is the length DE as the hypotenuse is of length 1.
;   This can also be expressed as 1-length CE.  Examining the triangle at the
;   right, the top angle is also (a/2) as angle BAE and EBA add to give a right
;   angle as do BAE and EAC.
;   So cos (a) = 1 - AC * sin(a/2) 
;   Looking at the largest triangle, side AC can be expressed as 
;   AC = 2 * sin(a/2)   and so combining these we get 
;   cos (a) = 1 - 2 * sin(a/2) * sin(a/2).
;
;   "I will be sufficiently rewarded if when telling it to others, you will 
;    not claim the discovery as your own, but will say it is mine."
;   - Thales, 640 - 546 B.C.
;
; --------------------------
; THE 'LINE DRAWING' ROUTINE
; --------------------------
;
;

;; DRAW-LINE
L24B7:  CALL    L2307           ; routine STK-TO-BC
        LD      A,C             ;
        CP      B               ;
        JR      NC,L24C4        ; to DL-X-GE-Y

        LD      L,C             ;
        PUSH    DE              ;
        XOR     A               ;
        LD      E,A             ;
        JR      L24CB           ; to DL-LARGER

; ---

;; DL-X-GE-Y
L24C4:  OR      C               ;
        RET     Z               ;

        LD      L,B             ;
        LD      B,C             ;
        PUSH    DE              ;
        LD      D,$00           ;

;; DL-LARGER
L24CB:  LD      H,B             ;
        LD      A,B             ;
        RRA                     ;

;; D-L-LOOP
L24CE:  ADD     A,L             ;
        JR      C,L24D4         ; to D-L-DIAG

        CP      H               ;
        JR      C,L24DB         ; to D-L-HR-VT

;; D-L-DIAG
L24D4:  SUB     H               ;
        LD      C,A             ;
        EXX                     ;
        POP     BC              ;
        PUSH    BC              ;
        JR      L24DF           ; to D-L-STEP

; ---

;; D-L-HR-VT
L24DB:  LD      C,A             ;
        PUSH    DE              ;
        EXX                     ;
        POP     BC              ;

;; D-L-STEP
L24DF:  LD      HL,($5C7D)      ; COORDS
        LD      A,B             ;
        ADD     A,H             ;
        LD      B,A             ;
        LD      A,C             ;
        INC     A               ;
        ADD     A,L             ;
        JR      C,L24F7         ; to D-L-RANGE

        JR      Z,L24F9         ; to REPORT-Bc

;; D-L-PLOT
L24EC:  DEC     A               ;
        LD      C,A             ;
        CALL    L22E5           ; routine PLOT-SUB
        EXX                     ;
        LD      A,C             ;
        DJNZ    L24CE           ; to D-L-LOOP

        POP     DE              ;
        RET                     ;

; ---

;; D-L-RANGE
L24F7:  JR      Z,L24EC         ; to D-L-PLOT


;; REPORT-Bc
L24F9:  RST     08H             ; ERROR-1
        DEFB    $0A             ; Error Report: Integer out of range



;***********************************
;** Part 8. EXPRESSION EVALUATION **
;***********************************
;
; It is a this stage of the ROM that the Spectrum ceases altogether to be
; just a colourful novelty. One remarkable feature is that in all previous
; commands when the Spectrum is expecting a number or a string then an
; expression of the same type can be substituted ad infinitum.
; This is the routine that evaluates that expression.
; This is what causes 2 + 2 to give the answer 4.
; That is quite easy to understand. However you don't have to make it much
; more complex to start a remarkable juggling act.
; e.g. PRINT 2 * (VAL "2+2" + TAN 3)
; In fact, provided there is enough free RAM, the Spectrum can evaluate
; an expression of unlimited complexity.
; Apart from a couple of minor glitches, which you can now correct, the
; system is remarkably robust.


; ---------------------------------
; Scan expression or sub-expression
; ---------------------------------
;
;

;; SCANNING
L24FB:  RST     18H             ; GET-CHAR
        LD      B,$00           ; priority marker zero is pushed on stack
                                ; to signify end of expression when it is
                                ; popped off again.
        PUSH    BC              ; put in on stack.
                                ; and proceed to consider the first character
                                ; of the expression.

;; S-LOOP-1
L24FF:  LD      C,A             ; store the character while a look up is done.
        LD      HL,L2596        ; Address: scan-func
        CALL    L16DC           ; routine INDEXER is called to see if it is
                                ; part of a limited range '+', '(', 'ATTR' etc.

        LD      A,C             ; fetch the character back
        JP      NC,L2684        ; jump forward to S-ALPHNUM if not in primary
                                ; operators and functions to consider in the
                                ; first instance a digit or a variable and
                                ; then anything else.                >>>

        LD      B,$00           ; but here if it was found in table so
        LD      C,(HL)          ; fetch offset from table and make B zero.
        ADD     HL,BC           ; add the offset to position found
        JP      (HL)            ; and jump to the routine e.g. S-BIN
                                ; making an indirect exit from there.

; -------------------------------------------------------------------------
; The four service subroutines for routines in the scanning function table
; -------------------------------------------------------------------------

; PRINT """Hooray!"" he cried."

;; S-QUOTE-S
L250F:  CALL    L0074           ; routine CH-ADD+1 points to next character
                                ; and fetches that character.
        INC     BC              ; increase length counter.
        CP      $0D             ; is it carriage return ?
                                ; inside a quote.
        JP      Z,L1C8A         ; jump back to REPORT-C if so.
                                ; 'Nonsense in BASIC'.

        CP      $22             ; is it a quote '"' ?
        JR      NZ,L250F        ; back to S-QUOTE-S if not for more.

        CALL    L0074           ; routine CH-ADD+1
        CP      $22             ; compare with possible adjacent quote
        RET                     ; return. with zero set if two together.

; ---

; This subroutine is used to get two coordinate expressions for the three
; functions SCREEN$, ATTR and POINT that have two fixed parameters and
; therefore require surrounding braces.

;; S-2-COORD
L2522:  RST     20H             ; NEXT-CHAR
        CP      $28             ; is it the opening '(' ?
        JR      NZ,L252D        ; forward to S-RPORT-C if not
                                ; 'Nonsense in BASIC'.

        CALL    L1C79           ; routine NEXT-2NUM gets two comma-separated
                                ; numeric expressions. Note. this could cause
                                ; many more recursive calls to SCANNING but
                                ; the parent function will be evaluated fully
                                ; before rejoining the main juggling act.

        RST     18H             ; GET-CHAR
        CP      $29             ; is it the closing ')' ?

;; S-RPORT-C
L252D:  JP      NZ,L1C8A        ; jump back to REPORT-C if not.
                                ; 'Nonsense in BASIC'.

; ------------
; Check syntax
; ------------
; This routine is called on a number of occasions to check if syntax is being
; checked or if the program is being run. To test the flag inline would use
; four bytes of code, but a call instruction only uses 3 bytes of code.

;; SYNTAX-Z
L2530:  BIT     7,(IY+$01)      ; test FLAGS  - checking syntax only ?
        RET                     ; return.

; ----------------
; Scanning SCREEN$
; ----------------
; This function returns the code of a bit-mapped character at screen
; position at line C, column B. It is unable to detect the mosaic characters
; which are not bit-mapped but detects the ASCII 32 - 127 range.
; The bit-mapped UDGs are ignored which is curious as it requires only a
; few extra bytes of code. As usual, anything to do with CHARS is weird.
; If no match is found a null string is returned.
; No actual check on ranges is performed - that's up to the BASIC programmer.
; No real harm can come from SCREEN$(255,255) although the BASIC manual
; says that invalid values will be trapped.
; Interestingly, in the Pitman pocket guide, 1984, Vickers says that the
; range checking will be performed. 

;; S-SCRN$-S
L2535:  CALL    L2307           ; routine STK-TO-BC.
        LD      HL,($5C36)      ; fetch address of CHARS.
        LD      DE,$0100        ; fetch offset to chr$ 32
        ADD     HL,DE           ; and find start of bitmaps.
                                ; Note. not inc h. ??
        LD      A,C             ; transfer line to A.
        RRCA                    ; multiply
        RRCA                    ; by
        RRCA                    ; thirty-two.
        AND     $E0             ; and with 11100000
        XOR     B               ; combine with column $00 - $1F
        LD      E,A             ; to give the low byte of top line
        LD      A,C             ; column to A range 00000000 to 00011111
        AND     $18             ; and with 00011000
        XOR     $40             ; xor with 01000000 (high byte screen start)
        LD      D,A             ; register DE now holds start address of cell.
        LD      B,$60           ; there are 96 characters in ASCII set.

;; S-SCRN-LP
L254F:  PUSH    BC              ; save count
        PUSH    DE              ; save screen start address
        PUSH    HL              ; save bitmap start
        LD      A,(DE)          ; first byte of screen to A
        XOR     (HL)            ; xor with corresponding character byte
        JR      Z,L255A         ; forward to S-SC-MTCH if they match
                                ; if inverse result would be $FF
                                ; if any other then mismatch

        INC     A               ; set to $00 if inverse
        JR      NZ,L2573        ; forward to S-SCR-NXT if a mismatch

        DEC     A               ; restore $FF

; a match has been found so seven more to test.

;; S-SC-MTCH
L255A:  LD      C,A             ; load C with inverse mask $00 or $FF
        LD      B,$07           ; count seven more bytes

;; S-SC-ROWS
L255D:  INC     D               ; increment screen address.
        INC     HL              ; increment bitmap address.
        LD      A,(DE)          ; byte to A
        XOR     (HL)            ; will give $00 or $FF (inverse)
        XOR     C               ; xor with inverse mask
        JR      NZ,L2573        ; forward to S-SCR-NXT if no match.

        DJNZ    L255D           ; back to S-SC-ROWS until all eight matched.

; continue if a match of all eight bytes was found

        POP     BC              ; discard the
        POP     BC              ; saved
        POP     BC              ; pointers
        LD      A,$80           ; the endpoint of character set
        SUB     B               ; subtract the counter
                                ; to give the code 32-127
        LD      BC,$0001        ; make one space in workspace.

        RST     30H             ; BC-SPACES creates the space sliding
                                ; the calculator stack upwards.
        LD      (DE),A          ; start is addressed by DE, so insert code
        JR      L257D           ; forward to S-SCR-STO

; ---

; the jump was here if no match and more bitmaps to test.

;; S-SCR-NXT
L2573:  POP     HL              ; restore the last bitmap start
        LD      DE,$0008        ; and prepare to add 8.
        ADD     HL,DE           ; now addresses next character bitmap.
        POP     DE              ; restore screen address
        POP     BC              ; and character counter in B
        DJNZ    L254F           ; back to S-SCRN-LP if more characters.

        LD      C,B             ; B is now zero, so BC now zero.

;; S-SCR-STO
L257D:  JP      L2AB2           ; to STK-STO-$ to store the string in
                                ; workspace or a string with zero length.
                                ; (value of DE doesn't matter in last case)

; Note. this exit seems correct but the general-purpose routine S-STRING
; that calls this one will also stack any of its string results so this
; leads to a double storing of the result in this case.
; The instruction at L257D should just be a RET.
; credit Stephen Kelly and others, 1982.

; -------------
; Scanning ATTR
; -------------
; This function subroutine returns the attributes of a screen location -
; a numeric result.
; Again it's up to the BASIC programmer to supply valid values of line/column.

;; S-ATTR-S
L2580:  CALL    L2307           ; routine STK-TO-BC fetches line to C,
                                ; and column to B.
        LD      A,C             ; line to A $00 - $17   (max 00010111)
        RRCA                    ; rotate
        RRCA                    ; bits
        RRCA                    ; left.
        LD      C,A             ; store in C as an intermediate value.

        AND     $E0             ; pick up bits 11100000 ( was 00011100 )
        XOR     B               ; combine with column $00 - $1F
        LD      L,A             ; low byte now correct.

        LD      A,C             ; bring back intermediate result from C
        AND     $03             ; mask to give correct third of
                                ; screen $00 - $02
        XOR     $58             ; combine with base address.
        LD      H,A             ; high byte correct.
        LD      A,(HL)          ; pick up the colour attribute.
        JP      L2D28           ; forward to STACK-A to store result
                                ; and make an indirect exit.

; -----------------------
; Scanning function table
; -----------------------
; This table is used by INDEXER routine to find the offsets to
; four operators and eight functions. e.g. $A8 is the token 'FN'.
; This table is used in the first instance for the first character of an
; expression or by a recursive call to SCANNING for the first character of
; any sub-expression. It eliminates functions that have no argument or
; functions that can have more than one argument and therefore require
; braces. By eliminating and dealing with these now it can later take a
; simplistic approach to all other functions and assume that they have
; one argument.
; Similarly by eliminating BIN and '.' now it is later able to assume that
; all numbers begin with a digit and that the presence of a number or
; variable can be detected by a call to ALPHANUM.
; By default all expressions are positive and the spurious '+' is eliminated
; now as in print +2. This should not be confused with the operator '+'.
; Note. this does allow a degree of nonsense to be accepted as in
; PRINT +"3 is the greatest.".
; An acquired programming skill is the ability to include brackets where
; they are not necessary.
; A bracket at the start of a sub-expression may be spurious or necessary
; to denote that the contained expression is to be evaluated as an entity.
; In either case this is dealt with by recursive calls to SCANNING.
; An expression that begins with a quote requires special treatment.

;; scan-func
L2596:  DEFB    $22, L25B3-$-1  ; $1C offset to S-QUOTE
        DEFB    '(', L25E8-$-1  ; $4F offset to S-BRACKET
        DEFB    '.', L268D-$-1  ; $F2 offset to S-DECIMAL
        DEFB    '+', L25AF-$-1  ; $12 offset to S-U-PLUS

        DEFB    $A8, L25F5-$-1  ; $56 offset to S-FN
        DEFB    $A5, L25F8-$-1  ; $57 offset to S-RND
        DEFB    $A7, L2627-$-1  ; $84 offset to S-PI
        DEFB    $A6, L2634-$-1  ; $8F offset to S-INKEY$
        DEFB    $C4, L268D-$-1  ; $E6 offset to S-BIN
        DEFB    $AA, L2668-$-1  ; $BF offset to S-SCREEN$
        DEFB    $AB, L2672-$-1  ; $C7 offset to S-ATTR
        DEFB    $A9, L267B-$-1  ; $CE offset to S-POINT

        DEFB    $00             ; zero end marker

; --------------------------
; Scanning function routines
; --------------------------
; These are the 11 subroutines accessed by the above table.
; S-BIN and S-DECIMAL are the same
; The 1-byte offset limits their location to within 255 bytes of their
; entry in the table.

; ->
;; S-U-PLUS
L25AF:  RST     20H             ; NEXT-CHAR just ignore
        JP      L24FF           ; to S-LOOP-1

; ---

; ->
;; S-QUOTE
L25B3:  RST     18H             ; GET-CHAR
        INC     HL              ; address next character (first in quotes)
        PUSH    HL              ; save start of quoted text.
        LD      BC,$0000        ; initialize length of string to zero.
        CALL    L250F           ; routine S-QUOTE-S
        JR      NZ,L25D9        ; forward to S-Q-PRMS if

;; S-Q-AGAIN
L25BE:  CALL    L250F           ; routine S-QUOTE-S copies string until a
                                ; quote is encountered
        JR      Z,L25BE         ; back to S-Q-AGAIN if two quotes WERE
                                ; together.

; but if just an isolated quote then that terminates the string.

        CALL    L2530           ; routine SYNTAX-Z
        JR      Z,L25D9         ; forward to S-Q-PRMS if checking syntax.


        RST     30H             ; BC-SPACES creates the space for true
                                ; copy of string in workspace.
        POP     HL              ; re-fetch start of quoted text.
        PUSH    DE              ; save start in workspace.

;; S-Q-COPY
L25CB:  LD      A,(HL)          ; fetch a character from source.
        INC     HL              ; advance source address.
        LD      (DE),A          ; place in destination.
        INC     DE              ; advance destination address.
        CP      $22             ; was it a '"' just copied ?
        JR      NZ,L25CB        ; back to S-Q-COPY to copy more if not

        LD      A,(HL)          ; fetch adjacent character from source.
        INC     HL              ; advance source address.
        CP      $22             ; is this '"' ? - i.e. two quotes together ?
        JR      Z,L25CB         ; to S-Q-COPY if so including just one of the
                                ; pair of quotes.

; proceed when terminating quote encountered.

;; S-Q-PRMS
L25D9:  DEC     BC              ; decrease count by 1.
        POP     DE              ; restore start of string in workspace.

;; S-STRING
L25DB:  LD      HL,$5C3B        ; Address FLAGS system variable.
        RES     6,(HL)          ; signal string result.
        BIT     7,(HL)          ; is syntax being checked.
        CALL    NZ,L2AB2        ; routine STK-STO-$ is called in runtime.
        JP      L2712           ; jump forward to S-CONT-2          ===>

; ---

; ->
;; S-BRACKET
L25E8:  RST     20H             ; NEXT-CHAR
        CALL    L24FB           ; routine SCANNING is called recursively.
        CP      $29             ; is it the closing ')' ?
        JP      NZ,L1C8A        ; jump back to REPORT-C if not
                                ; 'Nonsense in BASIC'

        RST     20H             ; NEXT-CHAR
        JP      L2712           ; jump forward to S-CONT-2          ===>

; ---

; ->
;; S-FN
L25F5:  JP      L27BD           ; jump forward to S-FN-SBRN.

; --------------------------------------------------------------------
;
;   RANDOM THEORY from the ZX81 manual by Steven Vickers
;
;   (same algorithm as the ZX Spectrum).
; 
;   Chapter 5. Exercise 6. (For mathematicians only.)
;
;   Let p be a [large] prime, & let a be a primitive root modulo p.
;   Then if b_i is the residue of a^i modulo p (1<=b_i<p-1), the 
;   sequence             
;   
;                           (b_i-1)/(p-1)
;               
;   is a cyclical sequence of p-1 distinct numbers in the range 0 to 1
;   (excluding 1). By choosing a suitably, these can be made to look 
;   fairly random.
;
;     65537 is a Mersenne prime 2^16-1. Note.
;
;   Use this, & Gauss' law of quadratic reciprocity, to show that 75 
;   is a primitive root modulo 65537.
;
;     The ZX81 uses p=65537 & a=75, & stores some b_i-1 in memory. 
;   The function RND involves replacing b_i-1 in memory by b_(i+1)-1, 
;   & yielding the result (b_(i+1)-1)/(p-1). RAND n (with 1<=n<=65535)
;   makes b_i equal to n+1.
;
; --------------------------------------------------------------------
;
; Steven Vickers writing in comp.sys.sinclair on 20-DEC-1993
; 
;   Note. (Of course, 65537 is 2^16 + 1, not -1.)
;
;   Consider arithmetic modulo a prime p. There are p residue classes, and the
;   non-zero ones are all invertible. Hence under multiplication they form a
;   group (Fp*, say) of order p-1; moreover (and not so obvious) Fp* is cyclic.
;   Its generators are the "primitive roots". The "quadratic residues modulo p"
;   are the squares in Fp*, and the "Legendre symbol" (d/p) is defined (when p
;   does not divide d) as +1 or -1, according as d is or is not a quadratic
;   residue mod p.
;
;   In the case when p = 65537, we can show that d is a primitive root if and
;   only if it's not a quadratic residue. For let w be a primitive root, d
;   congruent to w^r (mod p). If d is not primitive, then its order is a proper
;   factor of 65536: hence w^{32768*r} = 1 (mod p), so 65536 divides 32768*r,
;   and hence r is even and d is a square (mod p). Conversely, the squares in
;   Fp* form a subgroup of (Fp*)^2 of index 2, and so cannot be generators.
;
;   Hence to check whether 75 is primitive mod 65537, we want to calculate that
;   (75/65537) = -1. There is a multiplicative formula (ab/p) = (a/p)(b/p) (mod
;   p), so (75/65537) = (5/65537)^2 * (3/65537) = (3/65537). Now the law of
;   quadratic reciprocity says that if p and q are distinct odd primes, then
;
;    (p/q)(q/p) = (-1)^{(p-1)(q-1)/4}
;
;   Hence (3/65537) = (65537/3) * (-1)^{65536*2/4} = (65537/3)
;            = (2/3)  (because 65537 = 2 mod 3)
;            = -1
;
;   (I referred to Pierre Samuel's "Algebraic Theory of Numbers".)
;
; ->

;; S-RND
L25F8:  CALL    L2530           ; routine SYNTAX-Z
        JR      Z,L2625         ; forward to S-RND-END if checking syntax.

        LD      BC,($5C76)      ; fetch system variable SEED
        CALL    L2D2B           ; routine STACK-BC places on calculator stack

        RST     28H             ;; FP-CALC           ;s.
        DEFB    $A1             ;;stk-one            ;s,1.
        DEFB    $0F             ;;addition           ;s+1.
        DEFB    $34             ;;stk-data           ;
        DEFB    $37             ;;Exponent: $87,
                                ;;Bytes: 1
        DEFB    $16             ;;(+00,+00,+00)      ;s+1,75.
        DEFB    $04             ;;multiply           ;(s+1)*75 = v
        DEFB    $34             ;;stk-data           ;v.
        DEFB    $80             ;;Bytes: 3
        DEFB    $41             ;;Exponent $91
        DEFB    $00,$00,$80     ;;(+00)              ;v,65537.
        DEFB    $32             ;;n-mod-m            ;remainder, result.
        DEFB    $02             ;;delete             ;remainder.
        DEFB    $A1             ;;stk-one            ;remainder, 1.
        DEFB    $03             ;;subtract           ;remainder - 1. = rnd
        DEFB    $31             ;;duplicate          ;rnd,rnd.
        DEFB    $38             ;;end-calc

        CALL    L2DA2           ; routine FP-TO-BC
        LD      ($5C76),BC      ; store in SEED for next starting point.
        LD      A,(HL)          ; fetch exponent
        AND     A               ; is it zero ?
        JR      Z,L2625         ; forward if so to S-RND-END

        SUB     $10             ; reduce exponent by 2^16
        LD      (HL),A          ; place back

;; S-RND-END
L2625:  JR      L2630           ; forward to S-PI-END

; ---

; the number PI 3.14159...

; ->
;; S-PI
L2627:  CALL    L2530           ; routine SYNTAX-Z
        JR      Z,L2630         ; to S-PI-END if checking syntax.

        RST     28H             ;; FP-CALC
        DEFB    $A3             ;;stk-pi/2                          pi/2.
        DEFB    $38             ;;end-calc

        INC     (HL)            ; increment the exponent leaving pi
                                ; on the calculator stack.

;; S-PI-END
L2630:  RST     20H             ; NEXT-CHAR
        JP      L26C3           ; jump forward to S-NUMERIC

; ---

; ->
;; S-INKEY$
L2634:  LD      BC,$105A        ; priority $10, operation code $1A ('read-in')
                                ; +$40 for string result, numeric operand.
                                ; set this up now in case we need to use the
                                ; calculator.
        RST     20H             ; NEXT-CHAR
        CP      $23             ; '#' ?
        JP      Z,L270D         ; to S-PUSH-PO if so to use the calculator
                                ; single operation
                                ; to read from network/RS232 etc. .

; else read a key from the keyboard.

        LD      HL,$5C3B        ; fetch FLAGS
        RES     6,(HL)          ; signal string result.
        BIT     7,(HL)          ; checking syntax ?
        JR      Z,L2665         ; forward to S-INK$-EN if so

        CALL    L028E           ; routine KEY-SCAN key in E, shift in D.
        LD      C,$00           ; the length of an empty string
        JR      NZ,L2660        ; to S-IK$-STK to store empty string if
                                ; no key returned.

        CALL    L031E           ; routine K-TEST get main code in A
        JR      NC,L2660        ; to S-IK$-STK to stack null string if
                                ; invalid

        DEC     D               ; D is expected to be FLAGS so set bit 3 $FF
                                ; 'L' Mode so no keywords.
        LD      E,A             ; main key to A
                                ; C is MODE 0 'KLC' from above still.
        CALL    L0333           ; routine K-DECODE
        PUSH    AF              ; save the code
        LD      BC,$0001        ; make room for one character

        RST     30H             ; BC-SPACES
        POP     AF              ; bring the code back
        LD      (DE),A          ; put the key in workspace
        LD      C,$01           ; set C length to one

;; S-IK$-STK
L2660:  LD      B,$00           ; set high byte of length to zero
        CALL    L2AB2           ; routine STK-STO-$

;; S-INK$-EN
L2665:  JP      L2712           ; to S-CONT-2            ===>

; ---

; ->
;; S-SCREEN$
L2668:  CALL    L2522           ; routine S-2-COORD
        CALL    NZ,L2535        ; routine S-SCRN$-S

        RST     20H             ; NEXT-CHAR
        JP      L25DB           ; forward to S-STRING to stack result

; ---

; ->
;; S-ATTR
L2672:  CALL    L2522           ; routine S-2-COORD
        CALL    NZ,L2580        ; routine S-ATTR-S

        RST     20H             ; NEXT-CHAR
        JR      L26C3           ; forward to S-NUMERIC

; ---

; ->
;; S-POINT
L267B:  CALL    L2522           ; routine S-2-COORD
        CALL    NZ,L22CB        ; routine POINT-SUB

        RST     20H             ; NEXT-CHAR
        JR      L26C3           ; forward to S-NUMERIC

; -----------------------------

; ==> The branch was here if not in table.

;; S-ALPHNUM
L2684:  CALL    L2C88           ; routine ALPHANUM checks if variable or
                                ; a digit.
        JR      NC,L26DF        ; forward to S-NEGATE if not to consider
                                ; a '-' character then functions.

        CP      $41             ; compare 'A'
        JR      NC,L26C9        ; forward to S-LETTER if alpha       ->
                                ; else must have been numeric so continue
                                ; into that routine.

; This important routine is called during runtime and from LINE-SCAN
; when a BASIC line is checked for syntax. It is this routine that
; inserts, during syntax checking, the invisible floating point numbers
; after the numeric expression. During runtime it just picks these
; numbers up. It also handles BIN format numbers.

; ->
;; S-BIN
;; S-DECIMAL
L268D:  CALL    L2530           ; routine SYNTAX-Z
        JR      NZ,L26B5        ; to S-STK-DEC in runtime

; this route is taken when checking syntax.

        CALL    L2C9B           ; routine DEC-TO-FP to evaluate number

        RST     18H             ; GET-CHAR to fetch HL
        LD      BC,$0006        ; six locations required
        CALL    L1655           ; routine MAKE-ROOM
        INC     HL              ; to first new location
        LD      (HL),$0E        ; insert number marker
        INC     HL              ; address next
        EX      DE,HL           ; make DE destination.
        LD      HL,($5C65)      ; STKEND points to end of stack.
        LD      C,$05           ; result is five locations lower
        AND     A               ; prepare for true subtraction
        SBC     HL,BC           ; point to start of value.
        LD      ($5C65),HL      ; update STKEND as we are taking number.
        LDIR                    ; Copy five bytes to program location
        EX      DE,HL           ; transfer pointer to HL
        DEC     HL              ; adjust
        CALL    L0077           ; routine TEMP-PTR1 sets CH-ADD
        JR      L26C3           ; to S-NUMERIC to record nature of result

; ---

; branch here in runtime.

;; S-STK-DEC
L26B5:  RST     18H             ; GET-CHAR positions HL at digit.

;; S-SD-SKIP
L26B6:  INC     HL              ; advance pointer
        LD      A,(HL)          ; until we find
        CP      $0E             ; chr 14d - the number indicator
        JR      NZ,L26B6        ; to S-SD-SKIP until a match
                                ; it has to be here.

        INC     HL              ; point to first byte of number
        CALL    L33B4           ; routine STACK-NUM stacks it
        LD      ($5C5D),HL      ; update system variable CH_ADD

;; S-NUMERIC
L26C3:  SET     6,(IY+$01)      ; update FLAGS  - Signal numeric result
        JR      L26DD           ; forward to S-CONT-1               ===>
                                ; actually S-CONT-2 is destination but why
                                ; waste a byte on a jump when a JR will do.
                                ; Actually a JR L2712 can be used. Rats.

; end of functions accessed from scanning functions table.

; --------------------------
; Scanning variable routines
; --------------------------
;
;

;; S-LETTER
L26C9:  CALL    L28B2           ; routine LOOK-VARS

        JP      C,L1C2E         ; jump back to REPORT-2 if variable not found
                                ; 'Variable not found'
                                ; but a variable is always 'found' if syntax
                                ; is being checked.

        CALL    Z,L2996         ; routine STK-VAR considers a subscript/slice
        LD      A,($5C3B)       ; fetch FLAGS value
        CP      $C0             ; compare 11000000
        JR      C,L26DD         ; step forward to S-CONT-1 if string  ===>

        INC     HL              ; advance pointer
        CALL    L33B4           ; routine STACK-NUM

;; S-CONT-1
L26DD:  JR      L2712           ; forward to S-CONT-2                 ===>

; ----------------------------------------
; -> the scanning branch was here if not alphanumeric.
; All the remaining functions will be evaluated by a single call to the
; calculator. The correct priority for the operation has to be placed in
; the B register and the operation code, calculator literal in the C register.
; the operation code has bit 7 set if result is numeric and bit 6 is
; set if operand is numeric. so
; $C0 = numeric result, numeric operand.            e.g. 'sin'
; $80 = numeric result, string operand.             e.g. 'code'
; $40 = string result, numeric operand.             e.g. 'str$'
; $00 = string result, string operand.              e.g. 'val$'

;; S-NEGATE
L26DF:  LD      BC,$09DB        ; prepare priority 09, operation code $C0 + 
                                ; 'negate' ($1B) - bits 6 and 7 set for numeric
                                ; result and numeric operand.

        CP      $2D             ; is it '-' ?
        JR      Z,L270D         ; forward if so to S-PUSH-PO

        LD      BC,$1018        ; prepare priority $10, operation code 'val$' -
                                ; bits 6 and 7 reset for string result and
                                ; string operand.
        
        CP      $AE             ; is it 'VAL$' ?
        JR      Z,L270D         ; forward if so to S-PUSH-PO

        SUB     $AF             ; subtract token 'CODE' value to reduce
                                ; functions 'CODE' to 'NOT' although the
                                ; upper range is, as yet, unchecked.
                                ; valid range would be $00 - $14.

        JP      C,L1C8A         ; jump back to REPORT-C with anything else
                                ; 'Nonsense in BASIC'

        LD      BC,$04F0        ; prepare priority $04, operation $C0 + 
                                ; 'not' ($30)

        CP      $14             ; is it 'NOT'
        JR      Z,L270D         ; forward to S-PUSH-PO if so

        JP      NC,L1C8A        ; to REPORT-C if higher
                                ; 'Nonsense in BASIC'

        LD      B,$10           ; priority $10 for all the rest
        ADD     A,$DC           ; make range $DC - $EF
                                ; $C0 + 'code'($1C) thru 'chr$' ($2F)

        LD      C,A             ; transfer 'function' to C
        CP      $DF             ; is it 'sin' ?
        JR      NC,L2707        ; forward to S-NO-TO-$  with 'sin' through
                                ; 'chr$' as operand is numeric.

; all the rest 'cos' through 'chr$' give a numeric result except 'str$'
; and 'chr$'.

        RES     6,C             ; signal string operand for 'code', 'val' and
                                ; 'len'.

;; S-NO-TO-$
L2707:  CP      $EE             ; compare 'str$'
        JR      C,L270D         ; forward to S-PUSH-PO if lower as result
                                ; is numeric.

        RES     7,C             ; reset bit 7 of op code for 'str$', 'chr$'
                                ; as result is string.

; >> This is where they were all headed for.

;; S-PUSH-PO
L270D:  PUSH    BC              ; push the priority and calculator operation
                                ; code.

        RST     20H             ; NEXT-CHAR
        JP      L24FF           ; jump back to S-LOOP-1 to go round the loop
                                ; again with the next character.

; --------------------------------

; ===>  there were many branches forward to here

;   An important step after the evaluation of an expression is to test for
;   a string expression and allow it to be sliced.  If a numeric expression is 
;   followed by a '(' then the numeric expression is complete.
;   Since a string slice can itself be sliced then loop repeatedly 
;   e.g. (STR$ PI) (3 TO) (TO 2)    or "nonsense" (4 TO )

;; S-CONT-2
L2712:  RST     18H             ; GET-CHAR

;; S-CONT-3
L2713:  CP      $28             ; is it '(' ?
        JR      NZ,L2723        ; forward, if not, to S-OPERTR 

        BIT     6,(IY+$01)      ; test FLAGS - numeric or string result ?
        JR      NZ,L2734        ; forward, if numeric, to S-LOOP

;   if a string expression preceded the '(' then slice it.

        CALL    L2A52           ; routine SLICING

        RST     20H             ; NEXT-CHAR
        JR      L2713           ; loop back to S-CONT-3

; ---------------------------

;   the branch was here when possibility of a '(' has been excluded.

;; S-OPERTR
L2723:  LD      B,$00           ; prepare to add
        LD      C,A             ; possible operator to C
        LD      HL,L2795        ; Address: $2795 - tbl-of-ops
        CALL    L16DC           ; routine INDEXER
        JR      NC,L2734        ; forward to S-LOOP if not in table

;   but if found in table the priority has to be looked up.

        LD      C,(HL)          ; operation code to C ( B is still zero )
        LD      HL,L27B0 - $C3  ; $26ED is base of table
        ADD     HL,BC           ; index into table.
        LD      B,(HL)          ; priority to B.

; ------------------
; Scanning main loop
; ------------------
; the juggling act

;; S-LOOP
L2734:  POP     DE              ; fetch last priority and operation
        LD      A,D             ; priority to A
        CP      B               ; compare with this one
        JR      C,L2773         ; forward to S-TIGHTER to execute the
                                ; last operation before this one as it has
                                ; higher priority.

; the last priority was greater or equal this one.

        AND     A               ; if it is zero then so is this
        JP      Z,L0018         ; jump to exit via get-char pointing at
                                ; next character.
                                ; This may be the character after the
                                ; expression or, if exiting a recursive call,
                                ; the next part of the expression to be
                                ; evaluated.

        PUSH    BC              ; save current priority/operation
                                ; as it has lower precedence than the one
                                ; now in DE.

; the 'USR' function is special in that it is overloaded to give two types
; of result.

        LD      HL,$5C3B        ; address FLAGS
        LD      A,E             ; new operation to A register
        CP      $ED             ; is it $C0 + 'usr-no' ($2D)  ?
        JR      NZ,L274C        ; forward to S-STK-LST if not

        BIT     6,(HL)          ; string result expected ?
                                ; (from the lower priority operand we've
                                ; just pushed on stack )
        JR      NZ,L274C        ; forward to S-STK-LST if numeric
                                ; as operand bits match.

        LD      E,$99           ; reset bit 6 and substitute $19 'usr-$'
                                ; for string operand.

;; S-STK-LST
L274C:  PUSH    DE              ; now stack this priority/operation
        CALL    L2530           ; routine SYNTAX-Z
        JR      Z,L275B         ; forward to S-SYNTEST if checking syntax.

        LD      A,E             ; fetch the operation code
        AND     $3F             ; mask off the result/operand bits to leave
                                ; a calculator literal.
        LD      B,A             ; transfer to B register

; now use the calculator to perform the single operation - operand is on
; the calculator stack.
; Note. although the calculator is performing a single operation most
; functions e.g. TAN are written using other functions and literals and
; these in turn are written using further strings of calculator literals so
; another level of magical recursion joins the juggling act for a while
; as the calculator too is calling itself.

        RST     28H             ;; FP-CALC
        DEFB    $3B             ;;fp-calc-2
L2758:  DEFB    $38             ;;end-calc

        JR      L2764           ; forward to S-RUNTEST

; ---

; the branch was here if checking syntax only. 

;; S-SYNTEST
L275B:  LD      A,E             ; fetch the operation code to accumulator
        XOR     (IY+$01)        ; compare with bits of FLAGS
        AND     $40             ; bit 6 will be zero now if operand
                                ; matched expected result.

;; S-RPORT-C2
L2761:  JP      NZ,L1C8A        ; to REPORT-C if mismatch
                                ; 'Nonsense in BASIC'
                                ; else continue to set flags for next

; the branch is to here in runtime after a successful operation.

;; S-RUNTEST
L2764:  POP     DE              ; fetch the last operation from stack
        LD      HL,$5C3B        ; address FLAGS
        SET     6,(HL)          ; set default to numeric result in FLAGS
        BIT     7,E             ; test the operational result
        JR      NZ,L2770        ; forward to S-LOOPEND if numeric

        RES     6,(HL)          ; reset bit 6 of FLAGS to show string result.

;; S-LOOPEND
L2770:  POP     BC              ; fetch the previous priority/operation
        JR      L2734           ; back to S-LOOP to perform these

; ---

; the branch was here when a stacked priority/operator had higher priority
; than the current one.

;; S-TIGHTER
L2773:  PUSH    DE              ; save high priority op on stack again
        LD      A,C             ; fetch lower priority operation code
        BIT     6,(IY+$01)      ; test FLAGS - Numeric or string result ?
        JR      NZ,L2790        ; forward to S-NEXT if numeric result

; if this is lower priority yet has string then must be a comparison.
; Since these can only be evaluated in context and were defaulted to
; numeric in operator look up they must be changed to string equivalents.

        AND     $3F             ; mask to give true calculator literal
        ADD     A,$08           ; augment numeric literals to string
                                ; equivalents.
                                ; 'no-&-no'  => 'str-&-no'
                                ; 'no-l-eql' => 'str-l-eql'
                                ; 'no-gr-eq' => 'str-gr-eq'
                                ; 'nos-neql' => 'strs-neql'
                                ; 'no-grtr'  => 'str-grtr'
                                ; 'no-less'  => 'str-less'
                                ; 'nos-eql'  => 'strs-eql'
                                ; 'addition' => 'strs-add'
        LD      C,A             ; put modified comparison operator back
        CP      $10             ; is it now 'str-&-no' ?
        JR      NZ,L2788        ; forward to S-NOT-AND  if not.

        SET     6,C             ; set numeric operand bit
        JR      L2790           ; forward to S-NEXT

; ---

;; S-NOT-AND
L2788:  JR      C,L2761         ; back to S-RPORT-C2 if less
                                ; 'Nonsense in BASIC'.
                                ; e.g. a$ * b$

        CP      $17             ; is it 'strs-add' ?
        JR      Z,L2790         ; forward to S-NEXT if so
                                ; (bit 6 and 7 are reset)

        SET     7,C             ; set numeric (Boolean) result for all others

;; S-NEXT
L2790:  PUSH    BC              ; now save this priority/operation on stack

        RST     20H             ; NEXT-CHAR
        JP      L24FF           ; jump back to S-LOOP-1

; ------------------
; Table of operators
; ------------------
; This table is used to look up the calculator literals associated with
; the operator character. The thirteen calculator operations $03 - $0F
; have bits 6 and 7 set to signify a numeric result.
; Some of these codes and bits may be altered later if the context suggests
; a string comparison or operation.
; that is '+', '=', '>', '<', '<=', '>=' or '<>'.

;; tbl-of-ops
L2795:  DEFB    '+', $CF        ;        $C0 + 'addition'
        DEFB    '-', $C3        ;        $C0 + 'subtract'
        DEFB    '*', $C4        ;        $C0 + 'multiply'
        DEFB    '/', $C5        ;        $C0 + 'division'
        DEFB    '^', $C6        ;        $C0 + 'to-power'
        DEFB    '=', $CE        ;        $C0 + 'nos-eql'
        DEFB    '>', $CC        ;        $C0 + 'no-grtr'
        DEFB    '<', $CD        ;        $C0 + 'no-less'

        DEFB    $C7, $C9        ; '<='   $C0 + 'no-l-eql'
        DEFB    $C8, $CA        ; '>='   $C0 + 'no-gr-eql'
        DEFB    $C9, $CB        ; '<>'   $C0 + 'nos-neql'
        DEFB    $C5, $C7        ; 'OR'   $C0 + 'or'
        DEFB    $C6, $C8        ; 'AND'  $C0 + 'no-&-no'

        DEFB    $00             ; zero end-marker.


; -------------------
; Table of priorities
; -------------------
; This table is indexed with the operation code obtained from the above
; table $C3 - $CF to obtain the priority for the respective operation.

;; tbl-priors
L27B0:  DEFB    $06             ; '-'   opcode $C3
        DEFB    $08             ; '*'   opcode $C4
        DEFB    $08             ; '/'   opcode $C5
        DEFB    $0A             ; '^'   opcode $C6
        DEFB    $02             ; 'OR'  opcode $C7
        DEFB    $03             ; 'AND' opcode $C8
        DEFB    $05             ; '<='  opcode $C9
        DEFB    $05             ; '>='  opcode $CA
        DEFB    $05             ; '<>'  opcode $CB
        DEFB    $05             ; '>'   opcode $CC
        DEFB    $05             ; '<'   opcode $CD
        DEFB    $05             ; '='   opcode $CE
        DEFB    $06             ; '+'   opcode $CF

; ----------------------
; Scanning function (FN)
; ----------------------
; This routine deals with user-defined functions.
; The definition can be anywhere in the program area but these are best
; placed near the start of the program as we shall see.
; The evaluation process is quite complex as the Spectrum has to parse two
; statements at the same time. Syntax of both has been checked previously
; and hidden locations have been created immediately after each argument
; of the DEF FN statement. Each of the arguments of the FN function is
; evaluated by SCANNING and placed in the hidden locations. Then the
; expression to the right of the DEF FN '=' is evaluated by SCANNING and for
; any variables encountered, a search is made in the DEF FN variable list
; in the program area before searching in the normal variables area.
;
; Recursion is not allowed: i.e. the definition of a function should not use
; the same function, either directly or indirectly ( through another function).
; You'll normally get error 4, ('Out of memory'), although sometimes the system
; will crash. - Vickers, Pitman 1984.
;
; As the definition is just an expression, there would seem to be no means
; of breaking out of such recursion.
; However, by the clever use of string expressions and VAL, such recursion is
; possible.
; e.g. DEF FN a(n) = VAL "n+FN a(n-1)+0" ((n<1) * 10 + 1 TO )
; will evaluate the full 11-character expression for all values where n is
; greater than zero but just the 11th character, "0", when n drops to zero
; thereby ending the recursion producing the correct result.
; Recursive string functions are possible using VAL$ instead of VAL and the
; null string as the final addend.
; - from a turn of the century newsgroup discussion initiated by Mike Wynne.

;; S-FN-SBRN
L27BD:  CALL    L2530           ; routine SYNTAX-Z
        JR      NZ,L27F7        ; forward to SF-RUN in runtime


        RST     20H             ; NEXT-CHAR
        CALL    L2C8D           ; routine ALPHA check for letters A-Z a-z
        JP      NC,L1C8A        ; jump back to REPORT-C if not
                                ; 'Nonsense in BASIC'


        RST     20H             ; NEXT-CHAR
        CP      $24             ; is it '$' ?
        PUSH    AF              ; save character and flags
        JR      NZ,L27D0        ; forward to SF-BRKT-1 with numeric function


        RST     20H             ; NEXT-CHAR

;; SF-BRKT-1
L27D0:  CP      $28             ; is '(' ?
        JR      NZ,L27E6        ; forward to SF-RPRT-C if not
                                ; 'Nonsense in BASIC'


        RST     20H             ; NEXT-CHAR
        CP      $29             ; is it ')' ?
        JR      Z,L27E9         ; forward to SF-FLAG-6 if no arguments.

;; SF-ARGMTS
L27D9:  CALL    L24FB           ; routine SCANNING checks each argument
                                ; which may be an expression.

        RST     18H             ; GET-CHAR
        CP      $2C             ; is it a ',' ?
        JR      NZ,L27E4        ; forward if not to SF-BRKT-2 to test bracket


        RST     20H             ; NEXT-CHAR if a comma was found
        JR      L27D9           ; back to SF-ARGMTS to parse all arguments.

; ---

;; SF-BRKT-2
L27E4:  CP      $29             ; is character the closing ')' ?

;; SF-RPRT-C
L27E6:  JP      NZ,L1C8A        ; jump to REPORT-C
                                ; 'Nonsense in BASIC'

; at this point any optional arguments have had their syntax checked.

;; SF-FLAG-6
L27E9:  RST     20H             ; NEXT-CHAR
        LD      HL,$5C3B        ; address system variable FLAGS
        RES     6,(HL)          ; signal string result
        POP     AF              ; restore test against '$'.
        JR      Z,L27F4         ; forward to SF-SYN-EN if string function.

        SET     6,(HL)          ; signal numeric result

;; SF-SYN-EN
L27F4:  JP      L2712           ; jump back to S-CONT-2 to continue scanning.

; ---

; the branch was here in runtime.

;; SF-RUN
L27F7:  RST     20H             ; NEXT-CHAR fetches name
        AND     $DF             ; AND 11101111 - reset bit 5 - upper-case.
        LD      B,A             ; save in B

        RST     20H             ; NEXT-CHAR
        SUB     $24             ; subtract '$'
        LD      C,A             ; save result in C
        JR      NZ,L2802        ; forward if not '$' to SF-ARGMT1

        RST     20H             ; NEXT-CHAR advances to bracket

;; SF-ARGMT1
L2802:  RST     20H             ; NEXT-CHAR advances to start of argument
        PUSH    HL              ; save address
        LD      HL,($5C53)      ; fetch start of program area from PROG
        DEC     HL              ; the search starting point is the previous
                                ; location.

;; SF-FND-DF
L2808:  LD      DE,$00CE        ; search is for token 'DEF FN' in E,
                                ; statement count in D.
        PUSH    BC              ; save C the string test, and B the letter.
        CALL    L1D86           ; routine LOOK-PROG will search for token.
        POP     BC              ; restore BC.
        JR      NC,L2814        ; forward to SF-CP-DEF if a match was found.


;; REPORT-P
L2812:  RST     08H             ; ERROR-1
        DEFB    $18             ; Error Report: FN without DEF

;; SF-CP-DEF
L2814:  PUSH    HL              ; save address of DEF FN
        CALL    L28AB           ; routine FN-SKPOVR skips over white-space etc.
                                ; without disturbing CH-ADD.
        AND     $DF             ; make fetched character upper-case.
        CP      B               ; compare with FN name
        JR      NZ,L2825        ; forward to SF-NOT-FD if no match.

; the letters match so test the type.

        CALL    L28AB           ; routine FN-SKPOVR skips white-space
        SUB     $24             ; subtract '$' from fetched character
        CP      C               ; compare with saved result of same operation
                                ; on FN name.
        JR      Z,L2831         ; forward to SF-VALUES with a match.

; the letters matched but one was string and the other numeric.

;; SF-NOT-FD
L2825:  POP     HL              ; restore search point.
        DEC     HL              ; make location before
        LD      DE,$0200        ; the search is to be for the end of the
                                ; current definition - 2 statements forward.
        PUSH    BC              ; save the letter/type
        CALL    L198B           ; routine EACH-STMT steps past rejected
                                ; definition.
        POP     BC              ; restore letter/type
        JR      L2808           ; back to SF-FND-DF to continue search

; ---

; Success!
; the branch was here with matching letter and numeric/string type.

;; SF-VALUES
L2831:  AND     A               ; test A ( will be zero if string '$' - '$' )

        CALL    Z,L28AB         ; routine FN-SKPOVR advances HL past '$'.

        POP     DE              ; discard pointer to 'DEF FN'.
        POP     DE              ; restore pointer to first FN argument.
        LD      ($5C5D),DE      ; save in CH_ADD

        CALL    L28AB           ; routine FN-SKPOVR advances HL past '('
        PUSH    HL              ; save start address in DEF FN  ***
        CP      $29             ; is character a ')' ?
        JR      Z,L2885         ; forward to SF-R-BR-2 if no arguments.

;; SF-ARG-LP
L2843:  INC     HL              ; point to next character.
        LD      A,(HL)          ; fetch it.
        CP      $0E             ; is it the number marker
        LD      D,$40           ; signal numeric in D.
        JR      Z,L2852         ; forward to SF-ARG-VL if numeric.

        DEC     HL              ; back to letter
        CALL    L28AB           ; routine FN-SKPOVR skips any white-space
        INC     HL              ; advance past the expected '$' to 
                                ; the 'hidden' marker.
        LD      D,$00           ; signal string.

;; SF-ARG-VL
L2852:  INC     HL              ; now address first of 5-byte location.
        PUSH    HL              ; save address in DEF FN statement
        PUSH    DE              ; save D - result type

        CALL    L24FB           ; routine SCANNING evaluates expression in
                                ; the FN statement setting FLAGS and leaving
                                ; result as last value on calculator stack.

        POP     AF              ; restore saved result type to A

        XOR     (IY+$01)        ; xor with FLAGS
        AND     $40             ; and with 01000000 to test bit 6
        JR      NZ,L288B        ; forward to REPORT-Q if type mismatch.
                                ; 'Parameter error'

        POP     HL              ; pop the start address in DEF FN statement
        EX      DE,HL           ; transfer to DE ?? pop straight into de ?

        LD      HL,($5C65)      ; set HL to STKEND location after value
        LD      BC,$0005        ; five bytes to move
        SBC     HL,BC           ; decrease HL by 5 to point to start.
        LD      ($5C65),HL      ; set STKEND 'removing' value from stack.

        LDIR                    ; copy value into DEF FN statement
        EX      DE,HL           ; set HL to location after value in DEF FN
        DEC     HL              ; step back one
        CALL    L28AB           ; routine FN-SKPOVR gets next valid character
        CP      $29             ; is it ')' end of arguments ?
        JR      Z,L2885         ; forward to SF-R-BR-2 if so.

; a comma separator has been encountered in the DEF FN argument list.

        PUSH    HL              ; save position in DEF FN statement

        RST     18H             ; GET-CHAR from FN statement
        CP      $2C             ; is it ',' ?
        JR      NZ,L288B        ; forward to REPORT-Q if not
                                ; 'Parameter error'

        RST     20H             ; NEXT-CHAR in FN statement advances to next
                                ; argument.

        POP     HL              ; restore DEF FN pointer
        CALL    L28AB           ; routine FN-SKPOVR advances to corresponding
                                ; argument.

        JR      L2843           ; back to SF-ARG-LP looping until all
                                ; arguments are passed into the DEF FN
                                ; hidden locations.

; ---

; the branch was here when all arguments passed.

;; SF-R-BR-2
L2885:  PUSH    HL              ; save location of ')' in DEF FN

        RST     18H             ; GET-CHAR gets next character in FN
        CP      $29             ; is it a ')' also ?
        JR      Z,L288D         ; forward to SF-VALUE if so.


;; REPORT-Q
L288B:  RST     08H             ; ERROR-1
        DEFB    $19             ; Error Report: Parameter error

;; SF-VALUE
L288D:  POP     DE              ; location of ')' in DEF FN to DE.
        EX      DE,HL           ; now to HL, FN ')' pointer to DE.
        LD      ($5C5D),HL      ; initialize CH_ADD to this value.

; At this point the start of the DEF FN argument list is on the machine stack.
; We also have to consider that this defined function may form part of the
; definition of another defined function (though not itself).
; As this defined function may be part of a hierarchy of defined functions
; currently being evaluated by recursive calls to SCANNING, then we have to
; preserve the original value of DEFADD and not assume that it is zero.

        LD      HL,($5C0B)      ; get original DEFADD address
        EX      (SP),HL         ; swap with DEF FN address on stack ***
        LD      ($5C0B),HL      ; set DEFADD to point to this argument list
                                ; during scanning.

        PUSH    DE              ; save FN ')' pointer.

        RST     20H             ; NEXT-CHAR advances past ')' in define

        RST     20H             ; NEXT-CHAR advances past '=' to expression

        CALL    L24FB           ; routine SCANNING evaluates but searches
                                ; initially for variables at DEFADD

        POP     HL              ; pop the FN ')' pointer
        LD      ($5C5D),HL      ; set CH_ADD to this
        POP     HL              ; pop the original DEFADD value
        LD      ($5C0B),HL      ; and re-insert into DEFADD system variable.

        RST     20H             ; NEXT-CHAR advances to character after ')'
        JP      L2712           ; to S-CONT-2 - to continue current
                                ; invocation of scanning

; --------------------
; Used to parse DEF FN
; --------------------
; e.g. DEF FN     s $ ( x )     =  b     $ (  TO  x  ) : REM exaggerated
;
; This routine is used 10 times to advance along a DEF FN statement
; skipping spaces and colour control codes. It is similar to NEXT-CHAR
; which is, at the same time, used to skip along the corresponding FN function
; except the latter has to deal with AT and TAB characters in string
; expressions. These cannot occur in a program area so this routine is
; simpler as both colour controls and their parameters are less than space.

;; FN-SKPOVR
L28AB:  INC     HL              ; increase pointer
        LD      A,(HL)          ; fetch addressed character
        CP      $21             ; compare with space + 1
        JR      C,L28AB         ; back to FN-SKPOVR if less

        RET                     ; return pointing to a valid character.

; ---------
; LOOK-VARS
; ---------
;
;

;; LOOK-VARS
L28B2:  SET     6,(IY+$01)      ; update FLAGS - presume numeric result

        RST     18H             ; GET-CHAR
        CALL    L2C8D           ; routine ALPHA tests for A-Za-z
        JP      NC,L1C8A        ; jump to REPORT-C if not.
                                ; 'Nonsense in BASIC'

        PUSH    HL              ; save pointer to first letter       ^1
        AND     $1F             ; mask lower bits, 1 - 26 decimal     000xxxxx
        LD      C,A             ; store in C.

        RST     20H             ; NEXT-CHAR
        PUSH    HL              ; save pointer to second character   ^2
        CP      $28             ; is it '(' - an array ?
        JR      Z,L28EF         ; forward to V-RUN/SYN if so.

        SET     6,C             ; set 6 signaling string if solitary  010
        CP      $24             ; is character a '$' ?
        JR      Z,L28DE         ; forward to V-STR-VAR

        SET     5,C             ; signal numeric                       011
        CALL    L2C88           ; routine ALPHANUM sets carry if second
                                ; character is alphanumeric.
        JR      NC,L28E3        ; forward to V-TEST-FN if just one character

; It is more than one character but re-test current character so that 6 reset
; This loop renders the similar loop at V-PASS redundant.

;; V-CHAR
L28D4:  CALL    L2C88           ; routine ALPHANUM
        JR      NC,L28EF        ; to V-RUN/SYN when no more

        RES     6,C             ; make long named type                 001

        RST     20H             ; NEXT-CHAR
        JR      L28D4           ; loop back to V-CHAR

; ---


;; V-STR-VAR
L28DE:  RST     20H             ; NEXT-CHAR advances past '$'
        RES     6,(IY+$01)      ; update FLAGS - signal string result.

;; V-TEST-FN
L28E3:  LD      A,($5C0C)       ; load A with DEFADD_hi
        AND     A               ; and test for zero.
        JR      Z,L28EF         ; forward to V-RUN/SYN if a defined function
                                ; is not being evaluated.

; Note.

        CALL    L2530           ; routine SYNTAX-Z
        JP      NZ,L2951        ; JUMP to STK-F-ARG in runtime and then
                                ; back to this point if no variable found.

;; V-RUN/SYN
L28EF:  LD      B,C             ; save flags in B
        CALL    L2530           ; routine SYNTAX-Z
        JR      NZ,L28FD        ; to V-RUN to look for the variable in runtime

; if checking syntax the letter is not returned

        LD      A,C             ; copy letter/flags to A
        AND     $E0             ; and with 11100000 to get rid of the letter
        SET     7,A             ; use spare bit to signal checking syntax.
        LD      C,A             ; and transfer to C.
        JR      L2934           ; forward to V-SYNTAX

; ---

; but in runtime search for the variable.

;; V-RUN
L28FD:  LD      HL,($5C4B)      ; set HL to start of variables from VARS

;; V-EACH
L2900:  LD      A,(HL)          ; get first character
        AND     $7F             ; and with 01111111
                                ; ignoring bit 7 which distinguishes
                                ; arrays or for/next variables.

        JR      Z,L2932         ; to V-80-BYTE if zero as must be 10000000
                                ; the variables end-marker.

        CP      C               ; compare with supplied value.
        JR      NZ,L292A        ; forward to V-NEXT if no match.

        RLA                     ; destructively test
        ADD     A,A             ; bits 5 and 6 of A
                                ; jumping if bit 5 reset or 6 set

        JP      P,L293F         ; to V-FOUND-2  strings and arrays

        JR      C,L293F         ; to V-FOUND-2  simple and for next

; leaving long name variables.

        POP     DE              ; pop pointer to 2nd. char
        PUSH    DE              ; save it again
        PUSH    HL              ; save variable first character pointer

;; V-MATCHES
L2912:  INC     HL              ; address next character in vars area

;; V-SPACES
L2913:  LD      A,(DE)          ; pick up letter from prog area
        INC     DE              ; and advance address
        CP      $20             ; is it a space
        JR      Z,L2913         ; back to V-SPACES until non-space

        OR      $20             ; convert to range 1 - 26.
        CP      (HL)            ; compare with addressed variables character
        JR      Z,L2912         ; loop back to V-MATCHES if a match on an
                                ; intermediate letter.

        OR      $80             ; now set bit 7 as last character of long
                                ; names are inverted.
        CP      (HL)            ; compare again
        JR      NZ,L2929        ; forward to V-GET-PTR if no match

; but if they match check that this is also last letter in prog area

        LD      A,(DE)          ; fetch next character
        CALL    L2C88           ; routine ALPHANUM sets carry if not alphanum
        JR      NC,L293E        ; forward to V-FOUND-1 with a full match.

;; V-GET-PTR
L2929:  POP     HL              ; pop saved pointer to char 1

;; V-NEXT
L292A:  PUSH    BC              ; save flags
        CALL    L19B8           ; routine NEXT-ONE gets next variable in DE
        EX      DE,HL           ; transfer to HL.
        POP     BC              ; restore the flags
        JR      L2900           ; loop back to V-EACH
                                ; to compare each variable

; ---

;; V-80-BYTE
L2932:  SET     7,B             ; will signal not found

; the branch was here when checking syntax

;; V-SYNTAX
L2934:  POP     DE              ; discard the pointer to 2nd. character  v2
                                ; in BASIC line/workspace.

        RST     18H             ; GET-CHAR gets character after variable name.
        CP      $28             ; is it '(' ?
        JR      Z,L2943         ; forward to V-PASS
                                ; Note. could go straight to V-END ?

        SET     5,B             ; signal not an array
        JR      L294B           ; forward to V-END

; ---------------------------

; the jump was here when a long name matched and HL pointing to last character
; in variables area.

;; V-FOUND-1
L293E:  POP     DE              ; discard pointer to first var letter

; the jump was here with all other matches HL points to first var char.

;; V-FOUND-2
L293F:  POP     DE              ; discard pointer to 2nd prog char       v2
        POP     DE              ; drop pointer to 1st prog char          v1
        PUSH    HL              ; save pointer to last char in vars

        RST     18H             ; GET-CHAR

;; V-PASS
L2943:  CALL    L2C88           ; routine ALPHANUM
        JR      NC,L294B        ; forward to V-END if not

; but it never will be as we advanced past long-named variables earlier.

        RST     20H             ; NEXT-CHAR
        JR      L2943           ; back to V-PASS

; ---

;; V-END
L294B:  POP     HL              ; pop the pointer to first character in
                                ; BASIC line/workspace.
        RL      B               ; rotate the B register left
                                ; bit 7 to carry
        BIT     6,B             ; test the array indicator bit.
        RET                     ; return

; -----------------------
; Stack function argument
; -----------------------
; This branch is taken from LOOK-VARS when a defined function is currently
; being evaluated.
; Scanning is evaluating the expression after the '=' and the variable
; found could be in the argument list to the left of the '=' or in the
; normal place after the program. Preference will be given to the former.
; The variable name to be matched is in C.

;; STK-F-ARG
L2951:  LD      HL,($5C0B)      ; set HL to DEFADD
        LD      A,(HL)          ; load the first character
        CP      $29             ; is it ')' ?
        JP      Z,L28EF         ; JUMP back to V-RUN/SYN, if so, as there are
                                ; no arguments.

; but proceed to search argument list of defined function first if not empty.

;; SFA-LOOP
L295A:  LD      A,(HL)          ; fetch character again.
        OR      $60             ; or with 01100000 presume a simple variable.
        LD      B,A             ; save result in B.
        INC     HL              ; address next location.
        LD      A,(HL)          ; pick up byte.
        CP      $0E             ; is it the number marker ?
        JR      Z,L296B         ; forward to SFA-CP-VR if so.

; it was a string. White-space may be present but syntax has been checked.

        DEC     HL              ; point back to letter.
        CALL    L28AB           ; routine FN-SKPOVR skips to the '$'
        INC     HL              ; now address the hidden marker.
        RES     5,B             ; signal a string variable.

;; SFA-CP-VR
L296B:  LD      A,B             ; transfer found variable letter to A.
        CP      C               ; compare with expected.
        JR      Z,L2981         ; forward to SFA-MATCH with a match.

        INC     HL              ; step
        INC     HL              ; past
        INC     HL              ; the
        INC     HL              ; five
        INC     HL              ; bytes.

        CALL    L28AB           ; routine FN-SKPOVR skips to next character
        CP      $29             ; is it ')' ?
        JP      Z,L28EF         ; jump back if so to V-RUN/SYN to look in
                                ; normal variables area.

        CALL    L28AB           ; routine FN-SKPOVR skips past the ','
                                ; all syntax has been checked and these
                                ; things can be taken as read.
        JR      L295A           ; back to SFA-LOOP while there are more
                                ; arguments.

; ---

;; SFA-MATCH
L2981:  BIT     5,C             ; test if numeric
        JR      NZ,L2991        ; to SFA-END if so as will be stacked
                                ; by scanning

        INC     HL              ; point to start of string descriptor
        LD      DE,($5C65)      ; set DE to STKEND
        CALL    L33C0           ; routine MOVE-FP puts parameters on stack.
        EX      DE,HL           ; new free location to HL.
        LD      ($5C65),HL      ; use it to set STKEND system variable.

;; SFA-END
L2991:  POP     DE              ; discard
        POP     DE              ; pointers.
        XOR     A               ; clear carry flag.
        INC     A               ; and zero flag.
        RET                     ; return.

; ------------------------
; Stack variable component
; ------------------------
; This is called to evaluate a complex structure that has been found, in
; runtime, by LOOK-VARS in the variables area.
; In this case HL points to the initial letter, bits 7-5
; of which indicate the type of variable.
; 010 - simple string, 110 - string array, 100 - array of numbers.
;
; It is called from CLASS-01 when assigning to a string or array including
; a slice.
; It is called from SCANNING to isolate the required part of the structure.
;
; An important part of the runtime process is to check that the number of
; dimensions of the variable match the number of subscripts supplied in the
; BASIC line.
;
; If checking syntax,
; the B register, which counts dimensions is set to zero (256) to allow
; the loop to continue till all subscripts are checked. While doing this it
; is reading dimension sizes from some arbitrary area of memory. Although
; these are meaningless it is of no concern as the limit is never checked by
; int-exp during syntax checking.
;
; The routine is also called from the syntax path of DIM command to check the
; syntax of both string and numeric arrays definitions except that bit 6 of C
; is reset so both are checked as numeric arrays. This ruse avoids a terminal
; slice being accepted as part of the DIM command.
; All that is being checked is that there are a valid set of comma-separated
; expressions before a terminal ')', although, as above, it will still go
; through the motions of checking dummy dimension sizes.

;; STK-VAR
L2996:  XOR     A               ; clear A
        LD      B,A             ; and B, the syntax dimension counter (256)
        BIT     7,C             ; checking syntax ?
        JR      NZ,L29E7        ; forward to SV-COUNT if so.

; runtime evaluation.

        BIT     7,(HL)          ; will be reset if a simple string.
        JR      NZ,L29AE        ; forward to SV-ARRAYS otherwise

        INC     A               ; set A to 1, simple string.

;; SV-SIMPLE$
L29A1:  INC     HL              ; address length low
        LD      C,(HL)          ; place in C
        INC     HL              ; address length high
        LD      B,(HL)          ; place in B
        INC     HL              ; address start of string
        EX      DE,HL           ; DE = start now.
        CALL    L2AB2           ; routine STK-STO-$ stacks string parameters
                                ; DE start in variables area,
                                ; BC length, A=1 simple string

; the only thing now is to consider if a slice is required.

        RST     18H             ; GET-CHAR puts character at CH_ADD in A
        JP      L2A49           ; jump forward to SV-SLICE? to test for '('

; --------------------------------------------------------

; the branch was here with string and numeric arrays in runtime.

;; SV-ARRAYS
L29AE:  INC     HL              ; step past
        INC     HL              ; the total length
        INC     HL              ; to address Number of dimensions.
        LD      B,(HL)          ; transfer to B overwriting zero.
        BIT     6,C             ; a numeric array ?
        JR      Z,L29C0         ; forward to SV-PTR with numeric arrays

        DEC     B               ; ignore the final element of a string array
                                ; the fixed string size.

        JR      Z,L29A1         ; back to SV-SIMPLE$ if result is zero as has
                                ; been created with DIM a$(10) for instance
                                ; and can be treated as a simple string.

; proceed with multi-dimensioned string arrays in runtime.

        EX      DE,HL           ; save pointer to dimensions in DE

        RST     18H             ; GET-CHAR looks at the BASIC line
        CP      $28             ; is character '(' ?
        JR      NZ,L2A20        ; to REPORT-3 if not
                                ; 'Subscript wrong'

        EX      DE,HL           ; dimensions pointer to HL to synchronize
                                ; with next instruction.

; runtime numeric arrays path rejoins here.

;; SV-PTR
L29C0:  EX      DE,HL           ; save dimension pointer in DE
        JR      L29E7           ; forward to SV-COUNT with true no of dims 
                                ; in B. As there is no initial comma the 
                                ; loop is entered at the midpoint.

; ----------------------------------------------------------
; the dimension counting loop which is entered at mid-point.

;; SV-COMMA
L29C3:  PUSH    HL              ; save counter

        RST     18H             ; GET-CHAR

        POP     HL              ; pop counter
        CP      $2C             ; is character ',' ?
        JR      Z,L29EA         ; forward to SV-LOOP if so

; in runtime the variable definition indicates a comma should appear here

        BIT     7,C             ; checking syntax ?
        JR      Z,L2A20         ; forward to REPORT-3 if not
                                ; 'Subscript error'

; proceed if checking syntax of an array?

        BIT     6,C             ; array of strings
        JR      NZ,L29D8        ; forward to SV-CLOSE if so

; an array of numbers.

        CP      $29             ; is character ')' ?
        JR      NZ,L2A12        ; forward to SV-RPT-C if not
                                ; 'Nonsense in BASIC'

        RST     20H             ; NEXT-CHAR moves CH-ADD past the statement
        RET                     ; return ->

; ---

; the branch was here with an array of strings.

;; SV-CLOSE
L29D8:  CP      $29             ; as above ')' could follow the expression
        JR      Z,L2A48         ; forward to SV-DIM if so

        CP      $CC             ; is it 'TO' ?
        JR      NZ,L2A12        ; to SV-RPT-C with anything else
                                ; 'Nonsense in BASIC'

; now backtrack CH_ADD to set up for slicing routine.
; Note. in a BASIC line we can safely backtrack to a colour parameter.

;; SV-CH-ADD
L29E0:  RST     18H             ; GET-CHAR
        DEC     HL              ; backtrack HL
        LD      ($5C5D),HL      ; to set CH_ADD up for slicing routine
        JR      L2A45           ; forward to SV-SLICE and make a return
                                ; when all slicing complete.

; ----------------------------------------
; -> the mid-point entry point of the loop

;; SV-COUNT
L29E7:  LD      HL,$0000        ; initialize data pointer to zero.

;; SV-LOOP
L29EA:  PUSH    HL              ; save the data pointer.

        RST     20H             ; NEXT-CHAR in BASIC area points to an
                                ; expression.

        POP     HL              ; restore the data pointer.
        LD      A,C             ; transfer name/type to A.
        CP      $C0             ; is it 11000000 ?
                                ; Note. the letter component is absent if
                                ; syntax checking.
        JR      NZ,L29FB        ; forward to SV-MULT if not an array of
                                ; strings.

; proceed to check string arrays during syntax.

        RST     18H             ; GET-CHAR
        CP      $29             ; ')'  end of subscripts ?
        JR      Z,L2A48         ; forward to SV-DIM to consider further slice

        CP      $CC             ; is it 'TO' ?
        JR      Z,L29E0         ; back to SV-CH-ADD to consider a slice.
                                ; (no need to repeat get-char at L29E0)

; if neither, then an expression is required so rejoin runtime loop ??
; registers HL and DE only point to somewhere meaningful in runtime so 
; comments apply to that situation.

;; SV-MULT
L29FB:  PUSH    BC              ; save dimension number.
        PUSH    HL              ; push data pointer/rubbish.
                                ; DE points to current dimension.
        CALL    L2AEE           ; routine DE,(DE+1) gets next dimension in DE
                                ; and HL points to it.
        EX      (SP),HL         ; dim pointer to stack, data pointer to HL (*)
        EX      DE,HL           ; data pointer to DE, dim size to HL.

        CALL    L2ACC           ; routine INT-EXP1 checks integer expression
                                ; and gets result in BC in runtime.
        JR      C,L2A20         ; to REPORT-3 if > HL
                                ; 'Subscript out of range'

        DEC     BC              ; adjust returned result from 1-x to 0-x
        CALL    L2AF4           ; routine GET-HL*DE multiplies data pointer by
                                ; dimension size.
        ADD     HL,BC           ; add the integer returned by expression.
        POP     DE              ; pop the dimension pointer.                              ***
        POP     BC              ; pop dimension counter.
        DJNZ    L29C3           ; back to SV-COMMA if more dimensions
                                ; Note. during syntax checking, unless there
                                ; are more than 256 subscripts, the branch
                                ; back to SV-COMMA is always taken.

        BIT     7,C             ; are we checking syntax ?
                                ; then we've got a joker here.

;; SV-RPT-C
L2A12:  JR      NZ,L2A7A        ; forward to SL-RPT-C if so
                                ; 'Nonsense in BASIC'
                                ; more than 256 subscripts in BASIC line.

; but in runtime the number of subscripts are at least the same as dims

        PUSH    HL              ; save data pointer.
        BIT     6,C             ; is it a string array ?
        JR      NZ,L2A2C        ; forward to SV-ELEM$ if so.

; a runtime numeric array subscript.

        LD      B,D             ; register DE has advanced past all dimensions
        LD      C,E             ; and points to start of data in variable.
                                ; transfer it to BC.

        RST     18H             ; GET-CHAR checks BASIC line
        CP      $29             ; must be a ')' ?
        JR      Z,L2A22         ; skip to SV-NUMBER if so

; else more subscripts in BASIC line than the variable definition.

;; REPORT-3
L2A20:  RST     08H             ; ERROR-1
        DEFB    $02             ; Error Report: Subscript wrong

; continue if subscripts matched the numeric array.

;; SV-NUMBER
L2A22:  RST     20H             ; NEXT-CHAR moves CH_ADD to next statement
                                ; - finished parsing.

        POP     HL              ; pop the data pointer.
        LD      DE,$0005        ; each numeric element is 5 bytes.
        CALL    L2AF4           ; routine GET-HL*DE multiplies.
        ADD     HL,BC           ; now add to start of data in the variable.

        RET                     ; return with HL pointing at the numeric
                                ; array subscript.                       ->

; ---------------------------------------------------------------

; the branch was here for string subscripts when the number of subscripts
; in the BASIC line was one less than in variable definition.

;; SV-ELEM$
L2A2C:  CALL    L2AEE           ; routine DE,(DE+1) gets final dimension
                                ; the length of strings in this array.
        EX      (SP),HL         ; start pointer to stack, data pointer to HL.
        CALL    L2AF4           ; routine GET-HL*DE multiplies by element
                                ; size.
        POP     BC              ; the start of data pointer is added
        ADD     HL,BC           ; in - now points to location before.
        INC     HL              ; point to start of required string.
        LD      B,D             ; transfer the length (final dimension size)
        LD      C,E             ; from DE to BC.
        EX      DE,HL           ; put start in DE.
        CALL    L2AB1           ; routine STK-ST-0 stores the string parameters
                                ; with A=0 - a slice or subscript.

; now check that there were no more subscripts in the BASIC line.

        RST     18H             ; GET-CHAR
        CP      $29             ; is it ')' ?
        JR      Z,L2A48         ; forward to SV-DIM to consider a separate
                                ; subscript or/and a slice.

        CP      $2C             ; a comma is allowed if the final subscript
                                ; is to be sliced e.g. a$(2,3,4 TO 6).
        JR      NZ,L2A20        ; to REPORT-3 with anything else
                                ; 'Subscript error'

;; SV-SLICE
L2A45:  CALL    L2A52           ; routine SLICING slices the string.

; but a slice of a simple string can itself be sliced.

;; SV-DIM
L2A48:  RST     20H             ; NEXT-CHAR

;; SV-SLICE?
L2A49:  CP      $28             ; is character '(' ?
        JR      Z,L2A45         ; loop back if so to SV-SLICE

        RES     6,(IY+$01)      ; update FLAGS  - Signal string result
        RET                     ; and return.

; ---

; The above section deals with the flexible syntax allowed.
; DIM a$(3,3,10) can be considered as two dimensional array of ten-character
; strings or a 3-dimensional array of characters.
; a$(1,1) will return a 10-character string as will a$(1,1,1 TO 10)
; a$(1,1,1) will return a single character.
; a$(1,1) (1 TO 6) is the same as a$(1,1,1 TO 6)
; A slice can itself be sliced ad infinitum
; b$ () () () () () () (2 TO 10) (2 TO 9) (3) is the same as b$(5)



; -------------------------
; Handle slicing of strings
; -------------------------
; The syntax of string slicing is very natural and it is as well to reflect
; on the permutations possible.
; a$() and a$( TO ) indicate the entire string although just a$ would do
; and would avoid coming here.
; h$(16) indicates the single character at position 16.
; a$( TO 32) indicates the first 32 characters.
; a$(257 TO) indicates all except the first 256 characters.
; a$(19000 TO 19999) indicates the thousand characters at position 19000.
; Also a$(9 TO 5) returns a null string not an error.
; This enables a$(2 TO) to return a null string if the passed string is
; of length zero or 1.
; A string expression in brackets can be sliced. e.g. (STR$ PI) (3 TO )
; We arrived here from SCANNING with CH-ADD pointing to the initial '('
; or from above.

;; SLICING
L2A52:  CALL    L2530           ; routine SYNTAX-Z
        CALL    NZ,L2BF1        ; routine STK-FETCH fetches parameters of
                                ; string at runtime, start in DE, length 
                                ; in BC. This could be an array subscript.

        RST     20H             ; NEXT-CHAR
        CP      $29             ; is it ')' ?     e.g. a$()
        JR      Z,L2AAD         ; forward to SL-STORE to store entire string.

        PUSH    DE              ; else save start address of string

        XOR     A               ; clear accumulator to use as a running flag.
        PUSH    AF              ; and save on stack before any branching.

        PUSH    BC              ; save length of string to be sliced.
        LD      DE,$0001        ; default the start point to position 1.

        RST     18H             ; GET-CHAR

        POP     HL              ; pop length to HL as default end point
                                ; and limit.

        CP      $CC             ; is it 'TO' ?    e.g. a$( TO 10000)
        JR      Z,L2A81         ; to SL-SECOND to evaluate second parameter.

        POP     AF              ; pop the running flag.

        CALL    L2ACD           ; routine INT-EXP2 fetches first parameter.

        PUSH    AF              ; save flag (will be $FF if parameter>limit)

        LD      D,B             ; transfer the start
        LD      E,C             ; to DE overwriting 0001.
        PUSH    HL              ; save original length.

        RST     18H             ; GET-CHAR
        POP     HL              ; pop the limit length.
        CP      $CC             ; is it 'TO' after a start ?
        JR      Z,L2A81         ; to SL-SECOND to evaluate second parameter

        CP      $29             ; is it ')' ?       e.g. a$(365)

;; SL-RPT-C
L2A7A:  JP      NZ,L1C8A        ; jump to REPORT-C with anything else
                                ; 'Nonsense in BASIC'

        LD      H,D             ; copy start
        LD      L,E             ; to end - just a one character slice.
        JR      L2A94           ; forward to SL-DEFINE.

; ---------------------

;; SL-SECOND
L2A81:  PUSH    HL              ; save limit length.

        RST     20H             ; NEXT-CHAR

        POP     HL              ; pop the length.

        CP      $29             ; is character ')' ?        e.g. a$(7 TO )
        JR      Z,L2A94         ; to SL-DEFINE using length as end point.

        POP     AF              ; else restore flag.
        CALL    L2ACD           ; routine INT-EXP2 gets second expression.

        PUSH    AF              ; save the running flag.

        RST     18H             ; GET-CHAR

        LD      H,B             ; transfer second parameter
        LD      L,C             ; to HL.              e.g. a$(42 to 99)
        CP      $29             ; is character a ')' ?
        JR      NZ,L2A7A        ; to SL-RPT-C if not
                                ; 'Nonsense in BASIC'

; we now have start in DE and an end in HL.

;; SL-DEFINE
L2A94:  POP     AF              ; pop the running flag.
        EX      (SP),HL         ; put end point on stack, start address to HL
        ADD     HL,DE           ; add address of string to the start point.
        DEC     HL              ; point to first character of slice.
        EX      (SP),HL         ; start address to stack, end point to HL (*)
        AND     A               ; prepare to subtract.
        SBC     HL,DE           ; subtract start point from end point.
        LD      BC,$0000        ; default the length result to zero.
        JR      C,L2AA8         ; forward to SL-OVER if start > end.

        INC     HL              ; increment the length for inclusive byte.

        AND     A               ; now test the running flag.
        JP      M,L2A20         ; jump back to REPORT-3 if $FF.
                                ; 'Subscript out of range'

        LD      B,H             ; transfer the length
        LD      C,L             ; to BC.

;; SL-OVER
L2AA8:  POP     DE              ; restore start address from machine stack ***
        RES     6,(IY+$01)      ; update FLAGS - signal string result for
                                ; syntax.

;; SL-STORE
L2AAD:  CALL    L2530           ; routine SYNTAX-Z  (UNSTACK-Z?)
        RET     Z               ; return if checking syntax.
                                ; but continue to store the string in runtime.

; ------------------------------------
; other than from above, this routine is called from STK-VAR to stack
; a known string array element.
; ------------------------------------

;; STK-ST-0
L2AB1:  XOR     A               ; clear to signal a sliced string or element.

; -------------------------
; this routine is called from chr$, scrn$ etc. to store a simple string result.
; --------------------------

;; STK-STO-$
L2AB2:  RES     6,(IY+$01)      ; update FLAGS - signal string result.
                                ; and continue to store parameters of string.

; ---------------------------------------
; Pass five registers to calculator stack
; ---------------------------------------
; This subroutine puts five registers on the calculator stack.

;; STK-STORE
L2AB6:  PUSH    BC              ; save two registers
        CALL    L33A9           ; routine TEST-5-SP checks room and puts 5 
                                ; in BC.
        POP     BC              ; fetch the saved registers.
        LD      HL,($5C65)      ; make HL point to first empty location STKEND
        LD      (HL),A          ; place the 5 registers.
        INC     HL              ;
        LD      (HL),E          ;
        INC     HL              ;
        LD      (HL),D          ;
        INC     HL              ;
        LD      (HL),C          ;
        INC     HL              ;
        LD      (HL),B          ;
        INC     HL              ;
        LD      ($5C65),HL      ; update system variable STKEND.
        RET                     ; and return.

; -------------------------------------------
; Return result of evaluating next expression
; -------------------------------------------
; This clever routine is used to check and evaluate an integer expression
; which is returned in BC, setting A to $FF, if greater than a limit supplied
; in HL. It is used to check array subscripts, parameters of a string slice
; and the arguments of the DIM command. In the latter case, the limit check
; is not required and H is set to $FF. When checking optional string slice
; parameters, it is entered at the second entry point so as not to disturb
; the running flag A, which may be $00 or $FF from a previous invocation.

;; INT-EXP1
L2ACC:  XOR     A               ; set result flag to zero.

; -> The entry point is here if A is used as a running flag.

;; INT-EXP2
L2ACD:  PUSH    DE              ; preserve DE register throughout.
        PUSH    HL              ; save the supplied limit.
        PUSH    AF              ; save the flag.

        CALL    L1C82           ; routine EXPT-1NUM evaluates expression
                                ; at CH_ADD returning if numeric result,
                                ; with value on calculator stack.

        POP     AF              ; pop the flag.
        CALL    L2530           ; routine SYNTAX-Z
        JR      Z,L2AEB         ; forward to I-RESTORE if checking syntax so
                                ; avoiding a comparison with supplied limit.

        PUSH    AF              ; save the flag.

        CALL    L1E99           ; routine FIND-INT2 fetches value from
                                ; calculator stack to BC producing an error
                                ; if too high.

        POP     DE              ; pop the flag to D.
        LD      A,B             ; test value for zero and reject
        OR      C               ; as arrays and strings begin at 1.
        SCF                     ; set carry flag.
        JR      Z,L2AE8         ; forward to I-CARRY if zero.

        POP     HL              ; restore the limit.
        PUSH    HL              ; and save.
        AND     A               ; prepare to subtract.
        SBC     HL,BC           ; subtract value from limit.

;; I-CARRY
L2AE8:  LD      A,D             ; move flag to accumulator $00 or $FF.
        SBC     A,$00           ; will set to $FF if carry set.

;; I-RESTORE
L2AEB:  POP     HL              ; restore the limit.
        POP     DE              ; and DE register.
        RET                     ; return.


; -----------------------
; LD DE,(DE+1) Subroutine
; -----------------------
; This routine just loads the DE register with the contents of the two
; locations following the location addressed by DE.
; It is used to step along the 16-bit dimension sizes in array definitions.
; Note. Such code is made into subroutines to make programs easier to
; write and it would use less space to include the five instructions in-line.
; However, there are so many exchanges going on at the places this is invoked
; that to implement it in-line would make the code hard to follow.
; It probably had a zippier label though as the intention is to simplify the
; program.

;; DE,(DE+1)
L2AEE:  EX      DE,HL           ;
        INC     HL              ;
        LD      E,(HL)          ;
        INC     HL              ;
        LD      D,(HL)          ;
        RET                     ;

; -------------------
; HL=HL*DE Subroutine
; -------------------
; This routine calls the mathematical routine to multiply HL by DE in runtime.
; It is called from STK-VAR and from DIM. In the latter case syntax is not
; being checked so the entry point could have been at the second CALL
; instruction to save a few clock-cycles.

;; GET-HL*DE
L2AF4:  CALL    L2530           ; routine SYNTAX-Z.
        RET     Z               ; return if checking syntax.

        CALL    L30A9           ; routine HL-HL*DE.
        JP      C,L1F15         ; jump back to REPORT-4 if over 65535.

        RET                     ; else return with 16-bit result in HL.

; -----------------
; THE 'LET' COMMAND
; -----------------
; Sinclair BASIC adheres to the ANSI-78 standard and a LET is required in
; assignments e.g. LET a = 1  :   LET h$ = "hat".
;
; Long names may contain spaces but not colour controls (when assigned).
; a substring can appear to the left of the equals sign.

; An earlier mathematician Lewis Carroll may have been pleased that
; 10 LET Babies cannot manage crocodiles = Babies are illogical AND
;    Nobody is despised who can manage a crocodile AND Illogical persons
;    are despised
; does not give the 'Nonsense..' error if the three variables exist.
; I digress.

;; LET
L2AFF:  LD      HL,($5C4D)      ; fetch system variable DEST to HL.
        BIT     1,(IY+$37)      ; test FLAGX - handling a new variable ?
        JR      Z,L2B66         ; forward to L-EXISTS if not.

; continue for a new variable. DEST points to start in BASIC line.
; from the CLASS routines.

        LD      BC,$0005        ; assume numeric and assign an initial 5 bytes

;; L-EACH-CH
L2B0B:  INC     BC              ; increase byte count for each relevant
                                ; character

;; L-NO-SP
L2B0C:  INC     HL              ; increase pointer.
        LD      A,(HL)          ; fetch character.
        CP      $20             ; is it a space ?
        JR      Z,L2B0C         ; back to L-NO-SP is so.

        JR      NC,L2B1F        ; forward to L-TEST-CH if higher.

        CP      $10             ; is it $00 - $0F ?
        JR      C,L2B29         ; forward to L-SPACES if so.

        CP      $16             ; is it $16 - $1F ?
        JR      NC,L2B29        ; forward to L-SPACES if so.

; it was $10 - $15  so step over a colour code.

        INC     HL              ; increase pointer.
        JR      L2B0C           ; loop back to L-NO-SP.

; ---

; the branch was to here if higher than space.

;; L-TEST-CH
L2B1F:  CALL    L2C88           ; routine ALPHANUM sets carry if alphanumeric
        JR      C,L2B0B         ; loop back to L-EACH-CH for more if so.

        CP      $24             ; is it '$' ?
        JP      Z,L2BC0         ; jump forward if so, to L-NEW$
                                ; with a new string.

;; L-SPACES
L2B29:  LD      A,C             ; save length lo in A.
        LD      HL,($5C59)      ; fetch E_LINE to HL.
        DEC     HL              ; point to location before, the variables
                                ; end-marker.
        CALL    L1655           ; routine MAKE-ROOM creates BC spaces
                                ; for name and numeric value.
        INC     HL              ; advance to first new location.
        INC     HL              ; then to second.
        EX      DE,HL           ; set DE to second location.
        PUSH    DE              ; save this pointer.
        LD      HL,($5C4D)      ; reload HL with DEST.
        DEC     DE              ; point to first.
        SUB     $06             ; subtract six from length_lo.
        LD      B,A             ; save count in B.
        JR      Z,L2B4F         ; forward to L-SINGLE if it was just
                                ; one character.

; HL points to start of variable name after 'LET' in BASIC line.

;; L-CHAR
L2B3E:  INC     HL              ; increase pointer.
        LD      A,(HL)          ; pick up character.
        CP      $21             ; is it space or higher ?
        JR      C,L2B3E         ; back to L-CHAR with space and less.

        OR      $20             ; make variable lower-case.
        INC     DE              ; increase destination pointer.
        LD      (DE),A          ; and load to edit line.
        DJNZ    L2B3E           ; loop back to L-CHAR until B is zero.

        OR      $80             ; invert the last character.
        LD      (DE),A          ; and overwrite that in edit line.

; now consider first character which has bit 6 set

        LD      A,$C0           ; set A 11000000 is xor mask for a long name.
                                ; %101      is xor/or  result

; single character numerics rejoin here with %00000000 in mask.
;                                            %011      will be xor/or result

;; L-SINGLE
L2B4F:  LD      HL,($5C4D)      ; fetch DEST - HL addresses first character.
        XOR     (HL)            ; apply variable type indicator mask (above).
        OR      $20             ; make lowercase - set bit 5.
        POP     HL              ; restore pointer to 2nd character.
        CALL    L2BEA           ; routine L-FIRST puts A in first character.
                                ; and returns with HL holding
                                ; new E_LINE-1  the $80 vars end-marker.

;; L-NUMERIC
L2B59:  PUSH    HL              ; save the pointer.

; the value of variable is deleted but remains after calculator stack.

        RST     28H             ;; FP-CALC
        DEFB    $02             ;;delete      ; delete variable value
        DEFB    $38             ;;end-calc

; DE (STKEND) points to start of value.

        POP     HL              ; restore the pointer.
        LD      BC,$0005        ; start of number is five bytes before.
        AND     A               ; prepare for true subtraction.
        SBC     HL,BC           ; HL points to start of value.
        JR      L2BA6           ; forward to L-ENTER  ==>

; ---


; the jump was to here if the variable already existed.

;; L-EXISTS
L2B66:  BIT     6,(IY+$01)      ; test FLAGS - numeric or string result ?
        JR      Z,L2B72         ; skip forward to L-DELETE$   -*->
                                ; if string result.

; A numeric variable could be simple or an array element.
; They are treated the same and the old value is overwritten.

        LD      DE,$0006        ; six bytes forward points to loc past value.
        ADD     HL,DE           ; add to start of number.
        JR      L2B59           ; back to L-NUMERIC to overwrite value.

; ---

; -*-> the branch was here if a string existed.

;; L-DELETE$
L2B72:  LD      HL,($5C4D)      ; fetch DEST to HL.
                                ; (still set from first instruction)
        LD      BC,($5C72)      ; fetch STRLEN to BC.
        BIT     0,(IY+$37)      ; test FLAGX - handling a complete simple
                                ; string ?
        JR      NZ,L2BAF        ; forward to L-ADD$ if so.

; must be a string array or a slice in workspace.
; Note. LET a$(3 TO 6) = h$   will assign "hat " if h$ = "hat"
;                                  and    "hats" if h$ = "hatstand".
;
; This is known as Procrustean lengthening and shortening after a
; character Procrustes in Greek legend who made travellers sleep in his bed,
; cutting off their feet or stretching them so they fitted the bed perfectly.
; The bloke was hatstand and slain by Theseus.

        LD      A,B             ; test if length
        OR      C               ; is zero and
        RET     Z               ; return if so.

        PUSH    HL              ; save pointer to start.

        RST     30H             ; BC-SPACES creates room.
        PUSH    DE              ; save pointer to first new location.
        PUSH    BC              ; and length            (*)
        LD      D,H             ; set DE to point to last location.
        LD      E,L             ;
        INC     HL              ; set HL to next location.
        LD      (HL),$20        ; place a space there.
        LDDR                    ; copy bytes filling with spaces.

        PUSH    HL              ; save pointer to start.
        CALL    L2BF1           ; routine STK-FETCH start to DE,
                                ; length to BC.
        POP     HL              ; restore the pointer.
        EX      (SP),HL         ; (*) length to HL, pointer to stack.
        AND     A               ; prepare for true subtraction.
        SBC     HL,BC           ; subtract old length from new.
        ADD     HL,BC           ; and add back.
        JR      NC,L2B9B        ; forward if it fits to L-LENGTH.

        LD      B,H             ; otherwise set
        LD      C,L             ; length to old length.
                                ; "hatstand" becomes "hats"

;; L-LENGTH
L2B9B:  EX      (SP),HL         ; (*) length to stack, pointer to HL.
        EX      DE,HL           ; pointer to DE, start of string to HL.
        LD      A,B             ; is the length zero ?
        OR      C               ;
        JR      Z,L2BA3         ; forward to L-IN-W/S if so
                                ; leaving prepared spaces.

        LDIR                    ; else copy bytes overwriting some spaces.

;; L-IN-W/S
L2BA3:  POP     BC              ; pop the new length.  (*)
        POP     DE              ; pop pointer to new area.
        POP     HL              ; pop pointer to variable in assignment.
                                ; and continue copying from workspace
                                ; to variables area.

; ==> branch here from  L-NUMERIC

;; L-ENTER
L2BA6:  EX      DE,HL           ; exchange pointers HL=STKEND DE=end of vars.
        LD      A,B             ; test the length
        OR      C               ; and make a 
        RET     Z               ; return if zero (strings only).

        PUSH    DE              ; save start of destination.
        LDIR                    ; copy bytes.
        POP     HL              ; address the start.
        RET                     ; and return.

; ---

; the branch was here from L-DELETE$ if an existing simple string.
; register HL addresses start of string in variables area.

;; L-ADD$
L2BAF:  DEC     HL              ; point to high byte of length.
        DEC     HL              ; to low byte.
        DEC     HL              ; to letter.
        LD      A,(HL)          ; fetch masked letter to A.
        PUSH    HL              ; save the pointer on stack.
        PUSH    BC              ; save new length.
        CALL    L2BC6           ; routine L-STRING adds new string at end
                                ; of variables area.
                                ; if no room we still have old one.
        POP     BC              ; restore length.
        POP     HL              ; restore start.
        INC     BC              ; increase
        INC     BC              ; length by three
        INC     BC              ; to include character and length bytes.
        JP      L19E8           ; jump to indirect exit via RECLAIM-2
                                ; deleting old version and adjusting pointers.

; ---

; the jump was here with a new string variable.

;; L-NEW$
L2BC0:  LD      A,$DF           ; indicator mask %11011111 for
                                ;                %010xxxxx will be result
        LD      HL,($5C4D)      ; address DEST first character.
        AND     (HL)            ; combine mask with character.

;; L-STRING
L2BC6:  PUSH    AF              ; save first character and mask.
        CALL    L2BF1           ; routine STK-FETCH fetches parameters of
                                ; the string.
        EX      DE,HL           ; transfer start to HL.
        ADD     HL,BC           ; add to length.
        PUSH    BC              ; save the length.
        DEC     HL              ; point to end of string.
        LD      ($5C4D),HL      ; save pointer in DEST.
                                ; (updated by POINTERS if in workspace)
        INC     BC              ; extra byte for letter.
        INC     BC              ; two bytes
        INC     BC              ; for the length of string.
        LD      HL,($5C59)      ; address E_LINE.
        DEC     HL              ; now end of VARS area.
        CALL    L1655           ; routine MAKE-ROOM makes room for string.
                                ; updating pointers including DEST.
        LD      HL,($5C4D)      ; pick up pointer to end of string from DEST.
        POP     BC              ; restore length from stack.
        PUSH    BC              ; and save again on stack.
        INC     BC              ; add a byte.
        LDDR                    ; copy bytes from end to start.
        EX      DE,HL           ; HL addresses length low
        INC     HL              ; increase to address high byte
        POP     BC              ; restore length to BC
        LD      (HL),B          ; insert high byte
        DEC     HL              ; address low byte location
        LD      (HL),C          ; insert that byte
        POP     AF              ; restore character and mask

;; L-FIRST
L2BEA:  DEC     HL              ; address variable name
        LD      (HL),A          ; and insert character.
        LD      HL,($5C59)      ; load HL with E_LINE.
        DEC     HL              ; now end of VARS area.
        RET                     ; return

; ------------------------------------
; Get last value from calculator stack
; ------------------------------------
;
;

;; STK-FETCH
L2BF1:  LD      HL,($5C65)      ; 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      ($5C65),HL      ; STKEND
        RET                     ;

; ------------------
; Handle DIM command
; ------------------
; e.g. DIM a(2,3,4,7): DIM a$(32) : DIM b$(20,2,768) : DIM c$(20000)
; the only limit to dimensions is memory so, for example,
; DIM a(2,2,2,2,2,2,2,2,2,2,2,2,2) is possible and creates a multi-
; dimensional array of zeros. String arrays are initialized to spaces.
; It is not possible to erase an array, but it can be re-dimensioned to
; a minimal size of 1, after use, to free up memory.

;; DIM
L2C02:  CALL    L28B2           ; routine LOOK-VARS

;; D-RPORT-C
L2C05:  JP      NZ,L1C8A        ; jump to REPORT-C if a long-name variable.
                                ; DIM lottery numbers(49) doesn't work.

        CALL    L2530           ; routine SYNTAX-Z
        JR      NZ,L2C15        ; forward to D-RUN in runtime.

        RES     6,C             ; signal 'numeric' array even if string as
                                ; this simplifies the syntax checking.

        CALL    L2996           ; routine STK-VAR checks syntax.
        CALL    L1BEE           ; routine CHECK-END performs early exit ->

; the branch was here in runtime.

;; D-RUN
L2C15:  JR      C,L2C1F         ; skip to D-LETTER if variable did not exist.
                                ; else reclaim the old one.

        PUSH    BC              ; save type in C.
        CALL    L19B8           ; routine NEXT-ONE find following variable
                                ; or position of $80 end-marker.
        CALL    L19E8           ; routine RECLAIM-2 reclaims the 
                                ; space between.
        POP     BC              ; pop the type.

;; D-LETTER
L2C1F:  SET     7,C             ; signal array.
        LD      B,$00           ; initialize dimensions to zero and
        PUSH    BC              ; save with the type.
        LD      HL,$0001        ; make elements one character presuming string
        BIT     6,C             ; is it a string ?
        JR      NZ,L2C2D        ; forward to D-SIZE if so.

        LD      L,$05           ; make elements 5 bytes as is numeric.

;; D-SIZE
L2C2D:  EX      DE,HL           ; save the element size in DE.

; now enter a loop to parse each of the integers in the list.

;; D-NO-LOOP
L2C2E:  RST     20H             ; NEXT-CHAR
        LD      H,$FF           ; disable limit check by setting HL high
        CALL    L2ACC           ; routine INT-EXP1
        JP      C,L2A20         ; to REPORT-3 if > 65280 and then some
                                ; 'Subscript out of range'

        POP     HL              ; pop dimension counter, array type
        PUSH    BC              ; save dimension size                     ***
        INC     H               ; increment the dimension counter
        PUSH    HL              ; save the dimension counter
        LD      H,B             ; transfer size
        LD      L,C             ; to HL
        CALL    L2AF4           ; routine GET-HL*DE multiplies dimension by
                                ; running total of size required initially
                                ; 1 or 5.
        EX      DE,HL           ; save running total in DE

        RST     18H             ; GET-CHAR
        CP      $2C             ; is it ',' ?
        JR      Z,L2C2E         ; loop back to D-NO-LOOP until all dimensions
                                ; have been considered

; when loop complete continue.

        CP      $29             ; is it ')' ?
        JR      NZ,L2C05        ; to D-RPORT-C with anything else
                                ; 'Nonsense in BASIC'


        RST     20H             ; NEXT-CHAR advances to next statement/CR

        POP     BC              ; pop dimension counter/type
        LD      A,C             ; type to A

; now calculate space required for array variable

        LD      L,B             ; dimensions to L since these require 16 bits
                                ; then this value will be doubled
        LD      H,$00           ; set high byte to zero

; another four bytes are required for letter(1), total length(2), number of
; dimensions(1) but since we have yet to double allow for two

        INC     HL              ; increment
        INC     HL              ; increment

        ADD     HL,HL           ; now double giving 4 + dimensions * 2

        ADD     HL,DE           ; add to space required for array contents

        JP      C,L1F15         ; to REPORT-4 if > 65535
                                ; 'Out of memory'

        PUSH    DE              ; save data space
        PUSH    BC              ; save dimensions/type
        PUSH    HL              ; save total space
        LD      B,H             ; total space
        LD      C,L             ; to BC
        LD      HL,($5C59)      ; address E_LINE - first location after
                                ; variables area
        DEC     HL              ; point to location before - the $80 end-marker
        CALL    L1655           ; routine MAKE-ROOM creates the space if
                                ; memory is available.

        INC     HL              ; point to first new location and
        LD      (HL),A          ; store letter/type

        POP     BC              ; pop total space
        DEC     BC              ; exclude name
        DEC     BC              ; exclude the 16-bit
        DEC     BC              ; counter itself
        INC     HL              ; point to next location the 16-bit counter
        LD      (HL),C          ; insert low byte
        INC     HL              ; address next
        LD      (HL),B          ; insert high byte

        POP     BC              ; pop the number of dimensions.
        LD      A,B             ; dimensions to A
        INC     HL              ; address next
        LD      (HL),A          ; and insert "No. of dims"

        LD      H,D             ; transfer DE space + 1 from make-room
        LD      L,E             ; to HL
        DEC     DE              ; set DE to next location down.
        LD      (HL),$00        ; presume numeric and insert a zero
        BIT     6,C             ; test bit 6 of C. numeric or string ?
        JR      Z,L2C7C         ; skip to DIM-CLEAR if numeric

        LD      (HL),$20        ; place a space character in HL

;; DIM-CLEAR
L2C7C:  POP     BC              ; pop the data length

        LDDR                    ; LDDR sets to zeros or spaces

; The number of dimensions is still in A.
; A loop is now entered to insert the size of each dimension that was pushed
; during the D-NO-LOOP working downwards from position before start of data.

;; DIM-SIZES
L2C7F:  POP     BC              ; pop a dimension size                    ***
        LD      (HL),B          ; insert high byte at position
        DEC     HL              ; next location down
        LD      (HL),C          ; insert low byte
        DEC     HL              ; next location down
        DEC     A               ; decrement dimension counter
        JR      NZ,L2C7F        ; back to DIM-SIZES until all done.

        RET                     ; return.

; -----------------------------
; Check whether digit or letter
; -----------------------------
; This routine checks that the character in A is alphanumeric
; returning with carry set if so.

;; ALPHANUM
L2C88:  CALL    L2D1B           ; routine NUMERIC will reset carry if so.
        CCF                     ; Complement Carry Flag
        RET     C               ; Return if numeric else continue into
                                ; next routine.

; This routine checks that the character in A is alphabetic

;; ALPHA
L2C8D:  CP      $41             ; less than 'A' ?
        CCF                     ; Complement Carry Flag
        RET     NC              ; return if so

        CP      $5B             ; less than 'Z'+1 ?
        RET     C               ; is within first range

        CP      $61             ; less than 'a' ?
        CCF                     ; Complement Carry Flag
        RET     NC              ; return if so.

        CP      $7B             ; less than 'z'+1 ?
        RET                     ; carry set if within a-z.

; -------------------------
; Decimal to floating point
; -------------------------
; This routine finds the floating point number represented by an expression
; beginning with BIN, '.' or a digit.
; Note that BIN need not have any '0's or '1's after it.
; BIN is really just a notational symbol and not a function.

;; DEC-TO-FP
L2C9B:  CP      $C4             ; 'BIN' token ?
        JR      NZ,L2CB8        ; to NOT-BIN if not

        LD      DE,$0000        ; initialize 16 bit buffer register.

;; BIN-DIGIT
L2CA2:  RST     20H             ; NEXT-CHAR
        SUB     $31             ; '1'
        ADC     A,$00           ; will be zero if '1' or '0'
                                ; carry will be set if was '0'
        JR      NZ,L2CB3        ; forward to BIN-END if result not zero

        EX      DE,HL           ; buffer to HL
        CCF                     ; Carry now set if originally '1'
        ADC     HL,HL           ; shift the carry into HL
        JP      C,L31AD         ; to REPORT-6 if overflow - too many digits
                                ; after first '1'. There can be an unlimited
                                ; number of leading zeros.
                                ; 'Number too big' - raise an error

        EX      DE,HL           ; save the buffer
        JR      L2CA2           ; back to BIN-DIGIT for more digits

; ---

;; BIN-END
L2CB3:  LD      B,D             ; transfer 16 bit buffer
        LD      C,E             ; to BC register pair.
        JP      L2D2B           ; JUMP to STACK-BC to put on calculator stack

; ---

; continue here with .1,  42, 3.14, 5., 2.3 E -4

;; NOT-BIN
L2CB8:  CP      $2E             ; '.' - leading decimal point ?
        JR      Z,L2CCB         ; skip to DECIMAL if so.

        CALL    L2D3B           ; routine INT-TO-FP to evaluate all digits
                                ; This number 'x' is placed on stack.
        CP      $2E             ; '.' - mid decimal point ?

        JR      NZ,L2CEB        ; to E-FORMAT if not to consider that format

        RST     20H             ; NEXT-CHAR
        CALL    L2D1B           ; routine NUMERIC returns carry reset if 0-9

        JR      C,L2CEB         ; to E-FORMAT if not a digit e.g. '1.'

        JR      L2CD5           ; to DEC-STO-1 to add the decimal part to 'x'

; ---

; a leading decimal point has been found in a number.

;; DECIMAL
L2CCB:  RST     20H             ; NEXT-CHAR
        CALL    L2D1B           ; routine NUMERIC will reset carry if digit

;; DEC-RPT-C
L2CCF:  JP      C,L1C8A         ; to REPORT-C if just a '.'
                                ; raise 'Nonsense in BASIC'

; since there is no leading zero put one on the calculator stack.

        RST     28H             ;; FP-CALC
        DEFB    $A0             ;;stk-zero  ; 0.
        DEFB    $38             ;;end-calc

; If rejoining from earlier there will be a value 'x' on stack.
; If continuing from above the value zero.
; Now store 1 in mem-0.
; Note. At each pass of the digit loop this will be divided by ten.

;; DEC-STO-1
L2CD5:  RST     28H             ;; FP-CALC
        DEFB    $A1             ;;stk-one   ;x or 0,1.
        DEFB    $C0             ;;st-mem-0  ;x or 0,1.
        DEFB    $02             ;;delete    ;x or 0.
        DEFB    $38             ;;end-calc


;; NXT-DGT-1
L2CDA:  RST     18H             ; GET-CHAR
        CALL    L2D22           ; routine STK-DIGIT stacks single digit 'd'
        JR      C,L2CEB         ; exit to E-FORMAT when digits exhausted  >


        RST     28H             ;; FP-CALC   ;x or 0,d.           first pass.
        DEFB    $E0             ;;get-mem-0  ;x or 0,d,1.
        DEFB    $A4             ;;stk-ten    ;x or 0,d,1,10.
        DEFB    $05             ;;division   ;x or 0,d,1/10.
        DEFB    $C0             ;;st-mem-0   ;x or 0,d,1/10.
        DEFB    $04             ;;multiply   ;x or 0,d/10.
        DEFB    $0F             ;;addition   ;x or 0 + d/10.
        DEFB    $38             ;;end-calc   last value.

        RST     20H             ; NEXT-CHAR  moves to next character
        JR      L2CDA           ; back to NXT-DGT-1

; ---

; although only the first pass is shown it can be seen that at each pass
; the new less significant digit is multiplied by an increasingly smaller
; factor (1/100, 1/1000, 1/10000 ... ) before being added to the previous
; last value to form a new last value.

; Finally see if an exponent has been input.

;; E-FORMAT
L2CEB:  CP      $45             ; is character 'E' ?
        JR      Z,L2CF2         ; to SIGN-FLAG if so

        CP      $65             ; 'e' is acceptable as well.
        RET     NZ              ; return as no exponent.

;; SIGN-FLAG
L2CF2:  LD      B,$FF           ; initialize temporary sign byte to $FF

        RST     20H             ; NEXT-CHAR
        CP      $2B             ; is character '+' ?
        JR      Z,L2CFE         ; to SIGN-DONE

        CP      $2D             ; is character '-' ?
        JR      NZ,L2CFF        ; to ST-E-PART as no sign

        INC     B               ; set sign to zero

; now consider digits of exponent.
; Note. incidentally this is the only occasion in Spectrum BASIC when an
; expression may not be used when a number is expected.

;; SIGN-DONE
L2CFE:  RST     20H             ; NEXT-CHAR

;; ST-E-PART
L2CFF:  CALL    L2D1B           ; routine NUMERIC
        JR      C,L2CCF         ; to DEC-RPT-C if not
                                ; raise 'Nonsense in BASIC'.

        PUSH    BC              ; save sign (in B)
        CALL    L2D3B           ; routine INT-TO-FP places exponent on stack
        CALL    L2DD5           ; routine FP-TO-A  transfers it to A
        POP     BC              ; restore sign
        JP      C,L31AD         ; to REPORT-6 if overflow (over 255)
                                ; raise 'Number too big'.

        AND     A               ; set flags
        JP      M,L31AD         ; to REPORT-6 if over '127'.
                                ; raise 'Number too big'.
                                ; 127 is still way too high and it is
                                ; impossible to enter an exponent greater
                                ; than 39 from the keyboard. The error gets
                                ; raised later in E-TO-FP so two different
                                ; error messages depending how high A is.

        INC     B               ; $FF to $00 or $00 to $01 - expendable now.
        JR      Z,L2D18         ; forward to E-FP-JUMP if exponent positive

        NEG                     ; Negate the exponent.

;; E-FP-JUMP
L2D18:  JP      L2D4F           ; JUMP forward to E-TO-FP to assign to
                                ; last value x on stack x * 10 to power A
                                ; a relative jump would have done.

; ---------------------
; Check for valid digit
; ---------------------
; This routine checks that the ASCII character in A is numeric
; returning with carry reset if so.

;; NUMERIC
L2D1B:  CP      $30             ; '0'
        RET     C               ; return if less than zero character.

        CP      $3A             ; The upper test is '9'
        CCF                     ; Complement Carry Flag
        RET                     ; Return - carry clear if character '0' - '9'

; -----------
; Stack Digit
; -----------
; This subroutine is called from INT-TO-FP and DEC-TO-FP to stack a digit
; on the calculator stack.

;; STK-DIGIT
L2D22:  CALL    L2D1B           ; routine NUMERIC
        RET     C               ; return if not numeric character

        SUB     $30             ; convert from ASCII to digit

; -----------------
; Stack accumulator
; -----------------
;
;

;; STACK-A
L2D28:  LD      C,A             ; transfer to C
        LD      B,$00           ; and make B zero

; ----------------------
; Stack BC register pair
; ----------------------
;

;; STACK-BC
L2D2B:  LD      IY,$5C3A        ; re-initialize ERR_NR

        XOR     A               ; clear to signal small integer
        LD      E,A             ; place in E for sign
        LD      D,C             ; LSB to D
        LD      C,B             ; MSB to C
        LD      B,A             ; last byte not used
        CALL    L2AB6           ; routine STK-STORE

        RST     28H             ;; FP-CALC
        DEFB    $38             ;;end-calc  make HL = STKEND-5

        AND     A               ; clear carry
        RET                     ; before returning

; -------------------------
; Integer to floating point
; -------------------------
; This routine places one or more digits found in a BASIC line
; on the calculator stack multiplying the previous value by ten each time
; before adding in the new digit to form a last value on calculator stack.

;; INT-TO-FP
L2D3B:  PUSH    AF              ; save first character

        RST     28H             ;; FP-CALC
        DEFB    $A0             ;;stk-zero    ; v=0. initial value
        DEFB    $38             ;;end-calc

        POP     AF              ; fetch first character back.

;; NXT-DGT-2
L2D40:  CALL    L2D22           ; routine STK-DIGIT puts 0-9 on stack
        RET     C               ; will return when character is not numeric >

        RST     28H             ;; FP-CALC    ; v, d.
        DEFB    $01             ;;exchange    ; d, v.
        DEFB    $A4             ;;stk-ten     ; d, v, 10.
        DEFB    $04             ;;multiply    ; d, v*10.
        DEFB    $0F             ;;addition    ; d + v*10 = newvalue
        DEFB    $38             ;;end-calc    ; v.

        CALL    L0074           ; routine CH-ADD+1 get next character
        JR      L2D40           ; back to NXT-DGT-2 to process as a digit


;*********************************
;** Part 9. ARITHMETIC ROUTINES **
;*********************************

; --------------------------
; E-format to floating point
; --------------------------
; This subroutine is used by the PRINT-FP routine and the decimal to FP
; routines to stack a number expressed in exponent format.
; Note. Though not used by the ROM as such, it has also been set up as
; a unary calculator literal but this will not work as the accumulator
; is not available from within the calculator.

; on entry there is a value x on the calculator stack and an exponent of ten
; in A.    The required value is x + 10 ^ A

;; e-to-fp
;; E-TO-FP
L2D4F:  RLCA                    ; this will set the          x.
        RRCA                    ; carry if bit 7 is set

        JR      NC,L2D55        ; to E-SAVE  if positive.

        CPL                     ; make negative positive
        INC     A               ; without altering carry.

;; E-SAVE
L2D55:  PUSH    AF              ; save positive exp and sign in carry

        LD      HL,$5C92        ; address MEM-0

        CALL    L350B           ; routine FP-0/1
                                ; places an integer zero, if no carry,
                                ; else a one in mem-0 as a sign flag

        RST     28H             ;; FP-CALC
        DEFB    $A4             ;;stk-ten                    x, 10.
        DEFB    $38             ;;end-calc

        POP     AF              ; pop the exponent.

; now enter a loop

;; E-LOOP
L2D60:  SRL     A               ; 0>76543210>C

        JR      NC,L2D71        ; forward to E-TST-END if no bit

        PUSH    AF              ; save shifted exponent.

        RST     28H             ;; FP-CALC
        DEFB    $C1             ;;st-mem-1                   x, 10.
        DEFB    $E0             ;;get-mem-0                  x, 10, (0/1).
        DEFB    $00             ;;jump-true

        DEFB    $04             ;;to L2D6D, E-DIVSN

        DEFB    $04             ;;multiply                   x*10.
        DEFB    $33             ;;jump

        DEFB    $02             ;;to L2D6E, E-FETCH

;; E-DIVSN
L2D6D:  DEFB    $05             ;;division                   x/10.

;; E-FETCH
L2D6E:  DEFB    $E1             ;;get-mem-1                  x/10 or x*10, 10.
        DEFB    $38             ;;end-calc                   new x, 10.

        POP     AF              ; restore shifted exponent

; the loop branched to here with no carry

;; E-TST-END
L2D71:  JR      Z,L2D7B         ; forward to E-END  if A emptied of bits

        PUSH    AF              ; re-save shifted exponent

        RST     28H             ;; FP-CALC
        DEFB    $31             ;;duplicate                  new x, 10, 10.
        DEFB    $04             ;;multiply                   new x, 100.
        DEFB    $38             ;;end-calc

        POP     AF              ; restore shifted exponent
        JR      L2D60           ; back to E-LOOP  until all bits done.

; ---

; although only the first pass is shown it can be seen that for each set bit
; representing a power of two, x is multiplied or divided by the
; corresponding power of ten.

;; E-END
L2D7B:  RST     28H             ;; FP-CALC                   final x, factor.
        DEFB    $02             ;;delete                     final x.
        DEFB    $38             ;;end-calc                   x.

        RET                     ; return




; -------------
; Fetch integer
; -------------
; This routine is called by the mathematical routines - FP-TO-BC, PRINT-FP,
; mult, re-stack and negate to fetch an integer from address HL.
; HL points to the stack or a location in MEM and no deletion occurs.
; If the number is negative then a similar process to that used in INT-STORE
; is used to restore the twos complement number to normal in DE and a sign
; in C.

;; INT-FETCH
L2D7F:  INC     HL              ; skip zero indicator.
        LD      C,(HL)          ; fetch sign to C
        INC     HL              ; address low byte
        LD      A,(HL)          ; fetch to A
        XOR     C               ; two's complement
        SUB     C               ;
        LD      E,A             ; place in E
        INC     HL              ; address high byte
        LD      A,(HL)          ; fetch to A
        ADC     A,C             ; two's complement
        XOR     C               ;
        LD      D,A             ; place in D
        RET                     ; return

; ------------------------
; Store a positive integer
; ------------------------
; This entry point is not used in this ROM but would
; store any integer as positive.

;; p-int-sto
L2D8C:  LD      C,$00           ; make sign byte positive and continue

; -------------
; Store integer
; -------------
; this routine stores an integer in DE at address HL.
; It is called from mult, truncate, negate and sgn.
; The sign byte $00 +ve or $FF -ve is in C.
; If negative, the number is stored in 2's complement form so that it is
; ready to be added.

;; INT-STORE
L2D8E:  PUSH    HL              ; preserve HL

        LD      (HL),$00        ; first byte zero shows integer not exponent
        INC     HL              ;
        LD      (HL),C          ; then store the sign byte
        INC     HL              ;
                                ; e.g.             +1             -1
        LD      A,E             ; fetch low byte   00000001       00000001
        XOR     C               ; xor sign         00000000   or  11111111
                                ; gives            00000001   or  11111110
        SUB     C               ; sub sign         00000000   or  11111111
                                ; gives            00000001>0 or  11111111>C
        LD      (HL),A          ; store 2's complement.
        INC     HL              ;
        LD      A,D             ; high byte        00000000       00000000
        ADC     A,C             ; sign             00000000<0     11111111<C
                                ; gives            00000000   or  00000000
        XOR     C               ; xor sign         00000000       11111111
        LD      (HL),A          ; store 2's complement.
        INC     HL              ;
        LD      (HL),$00        ; last byte always zero for integers.
                                ; is not used and need not be looked at when
                                ; testing for zero but comes into play should
                                ; an integer be converted to fp.
        POP     HL              ; restore HL
        RET                     ; return.


; -----------------------------
; Floating point to BC register
; -----------------------------
; This routine gets a floating point number e.g. 127.4 from the calculator
; stack to the BC register.

;; FP-TO-BC
L2DA2:  RST     28H             ;; FP-CALC            set HL to
        DEFB    $38             ;;end-calc            point to last value.

        LD      A,(HL)          ; get first of 5 bytes
        AND     A               ; and test
        JR      Z,L2DAD         ; forward to FP-DELETE if an integer

; The value is first rounded up and then converted to integer.

        RST     28H             ;; FP-CALC           x.
        DEFB    $A2             ;;stk-half           x. 1/2.
        DEFB    $0F             ;;addition           x + 1/2.
        DEFB    $27             ;;int                int(x + .5)
        DEFB    $38             ;;end-calc

; now delete but leave HL pointing at integer

;; FP-DELETE
L2DAD:  RST     28H             ;; FP-CALC
        DEFB    $02             ;;delete
        DEFB    $38             ;;end-calc

        PUSH    HL              ; save pointer.
        PUSH    DE              ; and STKEND.
        EX      DE,HL           ; make HL point to exponent/zero indicator
        LD      B,(HL)          ; indicator to B
        CALL    L2D7F           ; routine INT-FETCH
                                ; gets int in DE sign byte to C
                                ; but meaningless values if a large integer

        XOR     A               ; clear A
        SUB     B               ; subtract indicator byte setting carry
                                ; if not a small integer.

        BIT     7,C             ; test a bit of the sign byte setting zero
                                ; if positive.

        LD      B,D             ; transfer int
        LD      C,E             ; to BC
        LD      A,E             ; low byte to A as a useful return value.

        POP     DE              ; pop STKEND
        POP     HL              ; and pointer to last value
        RET                     ; return
                                ; if carry is set then the number was too big.

; ------------
; LOG(2^A)
; ------------
; This routine is used when printing floating point numbers to calculate
; the number of digits before the decimal point.

; first convert a one-byte signed integer to its five byte form.

;; LOG(2^A)
L2DC1:  LD      D,A             ; store a copy of A in D.
        RLA                     ; test sign bit of A.
        SBC     A,A             ; now $FF if negative or $00
        LD      E,A             ; sign byte to E.
        LD      C,A             ; and to C
        XOR     A               ; clear A
        LD      B,A             ; and B.
        CALL    L2AB6           ; routine STK-STORE stacks number AEDCB

;  so 00 00 XX 00 00 (positive) or 00 FF XX FF 00 (negative).
;  i.e. integer indicator, sign byte, low, high, unused.

; now multiply exponent by log to the base 10 of two.

        RST      28H            ;; FP-CALC

        DEFB    $34             ;;stk-data                      .30103 (log 2)
        DEFB    $EF             ;;Exponent: $7F, Bytes: 4
        DEFB    $1A,$20,$9A,$85 ;;
        DEFB    $04             ;;multiply

        DEFB    $27             ;;int

        DEFB    $38             ;;end-calc

; -------------------
; Floating point to A
; -------------------
; this routine collects a floating point number from the stack into the
; accumulator returning carry set if not in range 0 - 255.
; Not all the calling routines raise an error with overflow so no attempt
; is made to produce an error report here.

;; FP-TO-A
L2DD5:  CALL    L2DA2           ; routine FP-TO-BC returns with C in A also.
        RET     C               ; return with carry set if > 65535, overflow

        PUSH    AF              ; save the value and flags
        DEC     B               ; and test that
        INC     B               ; the high byte is zero.
        JR      Z,L2DE1         ; forward  FP-A-END if zero

; else there has been 8-bit overflow

        POP     AF              ; retrieve the value
        SCF                     ; set carry flag to show overflow
        RET                     ; and return.

; ---

;; FP-A-END
L2DE1:  POP     AF              ; restore value and success flag and
        RET                     ; return.


; -----------------------------
; Print a floating point number
; -----------------------------
; Not a trivial task.
; Begin by considering whether to print a leading sign for negative numbers.

;; PRINT-FP
L2DE3:  RST     28H             ;; FP-CALC
        DEFB    $31             ;;duplicate
        DEFB    $36             ;;less-0
        DEFB    $00             ;;jump-true

        DEFB    $0B             ;;to L2DF2, PF-NEGTVE

        DEFB    $31             ;;duplicate
        DEFB    $37             ;;greater-0
        DEFB    $00             ;;jump-true

        DEFB    $0D             ;;to L2DF8, PF-POSTVE

; must be zero itself

        DEFB    $02             ;;delete
        DEFB    $38             ;;end-calc

        LD      A,$30           ; prepare the character '0'

        RST     10H             ; PRINT-A
        RET                     ; return.                 ->
; ---

;; PF-NEGTVE
L2DF2:  DEFB    $2A             ;;abs
        DEFB    $38             ;;end-calc

        LD      A,$2D           ; the character '-'

        RST     10H             ; PRINT-A

; and continue to print the now positive number.

        RST     28H             ;; FP-CALC

;; PF-POSTVE
L2DF8:  DEFB    $A0             ;;stk-zero     x,0.     begin by
        DEFB    $C3             ;;st-mem-3     x,0.     clearing a temporary
        DEFB    $C4             ;;st-mem-4     x,0.     output buffer to
        DEFB    $C5             ;;st-mem-5     x,0.     fifteen zeros.
        DEFB    $02             ;;delete       x.
        DEFB    $38             ;;end-calc     x.

        EXX                     ; in case called from 'str$' then save the
        PUSH    HL              ; pointer to whatever comes after
        EXX                     ; str$ as H'L' will be used.

; now enter a loop?

;; PF-LOOP
L2E01:  RST     28H             ;; FP-CALC
        DEFB    $31             ;;duplicate    x,x.
        DEFB    $27             ;;int          x,int x.
        DEFB    $C2             ;;st-mem-2     x,int x.
        DEFB    $03             ;;subtract     x-int x.     fractional part.
        DEFB    $E2             ;;get-mem-2    x-int x, int x.
        DEFB    $01             ;;exchange     int x, x-int x.
        DEFB    $C2             ;;st-mem-2     int x, x-int x.
        DEFB    $02             ;;delete       int x.
        DEFB    $38             ;;end-calc     int x.
                                ;
                                ; mem-2 holds the fractional part.

; HL points to last value int x

        LD      A,(HL)          ; fetch exponent of int x.
        AND     A               ; test
        JR      NZ,L2E56        ; forward to PF-LARGE if a large integer
                                ; > 65535

; continue with small positive integer components in range 0 - 65535 
; if original number was say .999 then this integer component is zero. 

        CALL    L2D7F           ; routine INT-FETCH gets x in DE
                                ; (but x is not deleted)

        LD      B,$10           ; set B, bit counter, to 16d

        LD      A,D             ; test if
        AND     A               ; high byte is zero
        JR      NZ,L2E1E        ; forward to PF-SAVE if 16-bit integer.

; and continue with integer in range 0 - 255.

        OR      E               ; test the low byte for zero
                                ; i.e. originally just point something or other.
        JR      Z,L2E24         ; forward if so to PF-SMALL 

; 

        LD      D,E             ; transfer E to D
        LD      B,$08           ; and reduce the bit counter to 8.

;; PF-SAVE
L2E1E:  PUSH    DE              ; save the part before decimal point.
        EXX                     ;
        POP     DE              ; and pop in into D'E'
        EXX                     ;
        JR      L2E7B           ; forward to PF-BITS

; ---------------------

; the branch was here when 'int x' was found to be zero as in say 0.5.
; The zero has been fetched from the calculator stack but not deleted and
; this should occur now. This omission leaves the stack unbalanced and while
; that causes no problems with a simple PRINT statement, it will if str$ is
; being used in an expression e.g. "2" + STR$ 0.5 gives the result "0.5"
; instead of the expected result "20.5".
; credit Tony Stratton, 1982.
; A DEFB 02 delete is required immediately on using the calculator.

;; PF-SMALL
L2E24:  RST     28H             ;; FP-CALC       int x = 0.
L2E25:  DEFB    $E2             ;;get-mem-2      int x = 0, x-int x.
        DEFB    $38             ;;end-calc

        LD      A,(HL)          ; fetch exponent of positive fractional number
        SUB     $7E             ; subtract 

        CALL    L2DC1           ; routine LOG(2^A) calculates leading digits.

        LD      D,A             ; transfer count to D
        LD      A,($5CAC)       ; fetch total MEM-5-1
        SUB     D               ;
        LD      ($5CAC),A       ; MEM-5-1
        LD      A,D             ; 
        CALL    L2D4F           ; routine E-TO-FP

        RST     28H             ;; FP-CALC
        DEFB    $31             ;;duplicate
        DEFB    $27             ;;int
        DEFB    $C1             ;;st-mem-1
        DEFB    $03             ;;subtract
        DEFB    $E1             ;;get-mem-1
        DEFB    $38             ;;end-calc

        CALL    L2DD5           ; routine FP-TO-A

        PUSH    HL              ; save HL
        LD      ($5CA1),A       ; MEM-3-1
        DEC     A               ;
        RLA                     ;
        SBC     A,A             ;
        INC     A               ;

        LD      HL,$5CAB        ; address MEM-5-1 leading digit counter
        LD      (HL),A          ; store counter
        INC     HL              ; address MEM-5-2 total digits
        ADD     A,(HL)          ; add counter to contents
        LD      (HL),A          ; and store updated value
        POP     HL              ; restore HL

        JP      L2ECF           ; JUMP forward to PF-FRACTN

; ---

; Note. while it would be pedantic to comment on every occasion a JP
; instruction could be replaced with a JR instruction, this applies to the
; above, which is useful if you wish to correct the unbalanced stack error
; by inserting a 'DEFB 02 delete' at L2E25, and maintain main addresses.

; the branch was here with a large positive integer > 65535 e.g. 123456789
; the accumulator holds the exponent.

;; PF-LARGE
L2E56:  SUB     $80             ; make exponent positive
        CP      $1C             ; compare to 28
        JR      C,L2E6F         ; to PF-MEDIUM if integer <= 2^27

        CALL    L2DC1           ; routine LOG(2^A)
        SUB     $07             ;
        LD      B,A             ;
        LD      HL,$5CAC        ; address MEM-5-1 the leading digits counter.
        ADD     A,(HL)          ; add A to contents
        LD      (HL),A          ; store updated value.
        LD      A,B             ; 
        NEG                     ; negate
        CALL    L2D4F           ; routine E-TO-FP
        JR      L2E01           ; back to PF-LOOP

; ----------------------------

;; PF-MEDIUM
L2E6F:  EX      DE,HL           ;
        CALL    L2FBA           ; routine FETCH-TWO
        EXX                     ;
        SET     7,D             ;
        LD      A,L             ;
        EXX                     ;
        SUB     $80             ;
        LD      B,A             ;

; the branch was here to handle bits in DE with 8 or 16 in B  if small int
; and integer in D'E', 6 nibbles will accommodate 065535 but routine does
; 32-bit numbers as well from above

;; PF-BITS
L2E7B:  SLA     E               ;  C<xxxxxxxx<0
        RL      D               ;  C<xxxxxxxx<C
        EXX                     ;
        RL      E               ;  C<xxxxxxxx<C
        RL      D               ;  C<xxxxxxxx<C
        EXX                     ;

        LD      HL,$5CAA        ; set HL to mem-4-5th last byte of buffer
        LD      C,$05           ; set byte count to 5 -  10 nibbles

;; PF-BYTES
L2E8A:  LD      A,(HL)          ; fetch 0 or prev value
        ADC     A,A             ; shift left add in carry    C<xxxxxxxx<C

        DAA                     ; Decimal Adjust Accumulator.
                                ; if greater than 9 then the left hand
                                ; nibble is incremented. If greater than
                                ; 99 then adjusted and carry set.
                                ; so if we'd built up 7 and a carry came in
                                ;      0000 0111 < C
                                ;      0000 1111
                                ; daa     1 0101  which is 15 in BCD

        LD      (HL),A          ; put back
        DEC     HL              ; work down thru mem 4
        DEC     C               ; decrease the 5 counter.
        JR      NZ,L2E8A        ; back to PF-BYTES until the ten nibbles rolled

        DJNZ    L2E7B           ; back to PF-BITS until 8 or 16 (or 32) done

; at most 9 digits for 32-bit number will have been loaded with digits
; each of the 9 nibbles in mem 4 is placed into ten bytes in mem-3 and mem 4
; unless the nibble is zero as the buffer is already zero.
; ( or in the case of mem-5 will become zero as a result of RLD instruction )

        XOR     A               ; clear to accept
        LD      HL,$5CA6        ; address MEM-4-0 byte destination.
        LD      DE,$5CA1        ; address MEM-3-0 nibble source.
        LD      B,$09           ; the count is 9 (not ten) as the first 
                                ; nibble is known to be blank.

        RLD                     ; shift RH nibble to left in (HL)
                                ;    A           (HL)
                                ; 0000 0000 < 0000 3210
                                ; 0000 0000   3210 0000
                                ; A picks up the blank nibble


        LD      C,$FF           ; set a flag to indicate when a significant
                                ; digit has been encountered.

;; PF-DIGITS
L2EA1:  RLD                     ; pick up leftmost nibble from (HL)
                                ;    A           (HL)
                                ; 0000 0000 < 7654 3210
                                ; 0000 7654   3210 0000


        JR      NZ,L2EA9        ; to PF-INSERT if non-zero value picked up.

        DEC     C               ; test
        INC     C               ; flag
        JR      NZ,L2EB3        ; skip forward to PF-TEST-2 if flag still $FF
                                ; indicating this is a leading zero.

; but if the zero is a significant digit e.g. 10 then include in digit totals.
; the path for non-zero digits rejoins here.

;; PF-INSERT
L2EA9:  LD      (DE),A          ; insert digit at destination
        INC     DE              ; increase the destination pointer
        INC     (IY+$71)        ; increment MEM-5-1st  digit counter
        INC     (IY+$72)        ; increment MEM-5-2nd  leading digit counter
        LD      C,$00           ; set flag to zero indicating that any 
                                ; subsequent zeros are significant and not 
                                ; leading.

;; PF-TEST-2
L2EB3:  BIT     0,B             ; test if the nibble count is even
        JR      Z,L2EB8         ; skip to PF-ALL-9 if so to deal with the
                                ; other nibble in the same byte

        INC     HL              ; point to next source byte if not

;; PF-ALL-9
L2EB8:  DJNZ    L2EA1           ; decrement the nibble count, back to PF-DIGITS
                                ; if all nine not done.

; For 8-bit integers there will be at most 3 digits.
; For 16-bit integers there will be at most 5 digits. 
; but for larger integers there could be nine leading digits.
; if nine digits complete then the last one is rounded up as the number will
; be printed using E-format notation

        LD      A,($5CAB)       ; fetch digit count from MEM-5-1st
        SUB     $09             ; subtract 9 - max possible
        JR      C,L2ECB         ; forward if less to PF-MORE

        DEC     (IY+$71)        ; decrement digit counter MEM-5-1st to 8
        LD      A,$04           ; load A with the value 4.
        CP      (IY+$6F)        ; compare with MEM-4-4th - the ninth digit
        JR      L2F0C           ; forward to PF-ROUND
                                ; to consider rounding.

; ---------------------------------------
 
; now delete int x from calculator stack and fetch fractional part.

;; PF-MORE
L2ECB:  RST     28H             ;; FP-CALC        int x.
        DEFB    $02             ;;delete          .
        DEFB    $E2             ;;get-mem-2       x - int x = f.
        DEFB    $38             ;;end-calc        f.

;; PF-FRACTN
L2ECF:  EX      DE,HL           ;
        CALL    L2FBA           ; routine FETCH-TWO
        EXX                     ;
        LD      A,$80           ;
        SUB     L               ;
        LD      L,$00           ;
        SET     7,D             ;
        EXX                     ;
        CALL    L2FDD           ; routine SHIFT-FP

;; PF-FRN-LP
L2EDF:  LD      A,(IY+$71)      ; MEM-5-1st
        CP      $08             ;
        JR      C,L2EEC         ; to PF-FR-DGT

        EXX                     ;
        RL      D               ;
        EXX                     ;
        JR      L2F0C           ; to PF-ROUND

; ---

;; PF-FR-DGT
L2EEC:  LD      BC,$0200        ;

;; PF-FR-EXX
L2EEF:  LD      A,E             ;
        CALL    L2F8B           ; routine CA-10*A+C
        LD      E,A             ;
        LD      A,D             ;
        CALL    L2F8B           ; routine CA-10*A+C
        LD      D,A             ;
        PUSH    BC              ;
        EXX                     ;
        POP     BC              ;
        DJNZ    L2EEF           ; to PF-FR-EXX

        LD      HL,$5CA1        ; MEM-3
        LD      A,C             ;
        LD      C,(IY+$71)      ; MEM-5-1st
        ADD     HL,BC           ;
        LD      (HL),A          ;
        INC     (IY+$71)        ; MEM-5-1st
        JR      L2EDF           ; to PF-FRN-LP

; ----------------

; 1) with 9 digits but 8 in mem-5-1 and A holding 4, carry set if rounding up.
; e.g. 
;      999999999 is printed as 1E+9
;      100000001 is printed as 1E+8
;      100000009 is printed as 1.0000001E+8

;; PF-ROUND
L2F0C:  PUSH    AF              ; save A and flags
        LD      HL,$5CA1        ; address MEM-3 start of digits
        LD      C,(IY+$71)      ; MEM-5-1st No. of digits to C
        LD      B,$00           ; prepare to add
        ADD     HL,BC           ; address last digit + 1
        LD      B,C             ; No. of digits to B counter
        POP     AF              ; restore A and carry flag from comparison.

;; PF-RND-LP
L2F18:  DEC     HL              ; address digit at rounding position.
        LD      A,(HL)          ; fetch it
        ADC     A,$00           ; add carry from the comparison
        LD      (HL),A          ; put back result even if $0A.
        AND     A               ; test A
        JR      Z,L2F25         ; skip to PF-R-BACK if ZERO?

        CP      $0A             ; compare to 'ten' - overflow
        CCF                     ; complement carry flag so that set if ten.
        JR      NC,L2F2D        ; forward to PF-COUNT with 1 - 9.

;; PF-R-BACK
L2F25:  DJNZ    L2F18           ; loop back to PF-RND-LP

; if B counts down to zero then we've rounded right back as in 999999995.
; and the first 8 locations all hold $0A.


        LD      (HL),$01        ; load first location with digit 1.
        INC     B               ; make B hold 1 also.
                                ; could save an instruction byte here.
        INC     (IY+$72)        ; make MEM-5-2nd hold 1.
                                ; and proceed to initialize total digits to 1.

;; PF-COUNT
L2F2D:  LD      (IY+$71),B      ; MEM-5-1st

; now balance the calculator stack by deleting  it

        RST     28H             ;; FP-CALC
        DEFB    $02             ;;delete
        DEFB    $38             ;;end-calc

; note if used from str$ then other values may be on the calculator stack.
; we can also restore the next literal pointer from its position on the
; machine stack.

        EXX                     ;
        POP     HL              ; restore next literal pointer.
        EXX                     ;

        LD      BC,($5CAB)      ; set C to MEM-5-1st digit counter.
                                ; set B to MEM-5-2nd leading digit counter.
        LD      HL,$5CA1        ; set HL to start of digits at MEM-3-1
        LD      A,B             ;
        CP      $09             ;
        JR      C,L2F46         ; to PF-NOT-E

        CP      $FC             ;
        JR      C,L2F6C         ; to PF-E-FRMT

;; PF-NOT-E
L2F46:  AND     A               ; test for zero leading digits as in .123

        CALL    Z,L15EF         ; routine OUT-CODE prints a zero e.g. 0.123

;; PF-E-SBRN
L2F4A:  XOR     A               ;
        SUB     B               ;
        JP      M,L2F52         ; skip forward to PF-OUT-LP if originally +ve

        LD      B,A             ; else negative count now +ve
        JR      L2F5E           ; forward to PF-DC-OUT       ->

; ---

;; PF-OUT-LP
L2F52:  LD      A,C             ; fetch total digit count
        AND     A               ; test for zero
        JR      Z,L2F59         ; forward to PF-OUT-DT if so

        LD      A,(HL)          ; fetch digit
        INC     HL              ; address next digit
        DEC     C               ; decrease total digit counter

;; PF-OUT-DT
L2F59:  CALL    L15EF           ; routine OUT-CODE outputs it.
        DJNZ    L2F52           ; loop back to PF-OUT-LP until B leading 
                                ; digits output.

;; PF-DC-OUT
L2F5E:  LD      A,C             ; fetch total digits and
        AND     A               ; test if also zero
        RET     Z               ; return if so              -->

; 

        INC     B               ; increment B
        LD      A,$2E           ; prepare the character '.'

;; PF-DEC-0S
L2F64:  RST     10H             ; PRINT-A outputs the character '.' or '0'

        LD      A,$30           ; prepare the character '0'
                                ; (for cases like .000012345678)
        DJNZ    L2F64           ; loop back to PF-DEC-0S for B times.

        LD      B,C             ; load B with now trailing digit counter.
        JR      L2F52           ; back to PF-OUT-LP

; ---------------------------------

; the branch was here for E-format printing e.g. 123456789 => 1.2345679e+8

;; PF-E-FRMT
L2F6C:  LD      D,B             ; counter to D
        DEC     D               ; decrement
        LD      B,$01           ; load B with 1.

        CALL    L2F4A           ; routine PF-E-SBRN above

        LD      A,$45           ; prepare character 'e'
        RST     10H             ; PRINT-A

        LD      C,D             ; exponent to C
        LD      A,C             ; and to A
        AND     A               ; test exponent
        JP      P,L2F83         ; to PF-E-POS if positive

        NEG                     ; negate
        LD      C,A             ; positive exponent to C
        LD      A,$2D           ; prepare character '-'
        JR      L2F85           ; skip to PF-E-SIGN

; ---

;; PF-E-POS
L2F83:  LD      A,$2B           ; prepare character '+'

;; PF-E-SIGN
L2F85:  RST     10H             ; PRINT-A outputs the sign

        LD      B,$00           ; make the high byte zero.
        JP      L1A1B           ; exit via OUT-NUM-1 to print exponent in BC

; ------------------------------
; Handle printing floating point
; ------------------------------
; This subroutine is called twice from above when printing floating-point
; numbers. It returns 10*A +C in registers C and A

;; CA-10*A+C
L2F8B:  PUSH    DE              ; preserve DE.
        LD      L,A             ; transfer A to L
        LD      H,$00           ; zero high byte.
        LD      E,L             ; copy HL
        LD      D,H             ; to DE.
        ADD     HL,HL           ; double (*2)
        ADD     HL,HL           ; double (*4)
        ADD     HL,DE           ; add DE (*5)
        ADD     HL,HL           ; double (*10)
        LD      E,C             ; copy C to E    (D is 0)
        ADD     HL,DE           ; and add to give required result.
        LD      C,H             ; transfer to
        LD      A,L             ; destination registers.
        POP     DE              ; restore DE
        RET                     ; return with result.

; --------------
; Prepare to add
; --------------
; This routine is called twice by addition to prepare the two numbers. The
; exponent is picked up in A and the location made zero. Then the sign bit
; is tested before being set to the implied state. Negative numbers are twos
; complemented.

;; PREP-ADD
L2F9B:  LD      A,(HL)          ; pick up exponent
        LD      (HL),$00        ; make location zero
        AND     A               ; test if number is zero
        RET     Z               ; return if so

        INC     HL              ; address mantissa
        BIT     7,(HL)          ; test the sign bit
        SET     7,(HL)          ; set it to implied state
        DEC     HL              ; point to exponent
        RET     Z               ; return if positive number.

        PUSH    BC              ; preserve BC
        LD      BC,$0005        ; length of number
        ADD     HL,BC           ; point HL past end
        LD      B,C             ; set B to 5 counter
        LD      C,A             ; store exponent in C
        SCF                     ; set carry flag

;; NEG-BYTE
L2FAF:  DEC     HL              ; work from LSB to MSB
        LD      A,(HL)          ; fetch byte
        CPL                     ; complement
        ADC     A,$00           ; add in initial carry or from prev operation
        LD      (HL),A          ; put back
        DJNZ    L2FAF           ; loop to NEG-BYTE till all 5 done

        LD      A,C             ; stored exponent to A
        POP     BC              ; restore original BC
        RET                     ; return

; -----------------
; Fetch two numbers
; -----------------
; This routine is called twice when printing floating point numbers and also
; to fetch two numbers by the addition, multiply and division routines.
; HL addresses the first number, DE addresses the second number.
; For arithmetic only, A holds the sign of the result which is stored in
; the second location. 

;; FETCH-TWO
L2FBA:  PUSH    HL              ; save pointer to first number, result if math.
        PUSH    AF              ; save result sign.

        LD      C,(HL)          ;
        INC     HL              ;

        LD      B,(HL)          ;
        LD      (HL),A          ; store the sign at correct location in 
                                ; destination 5 bytes for arithmetic only.
        INC     HL              ;

        LD      A,C             ;
        LD      C,(HL)          ;
        PUSH    BC              ;
        INC     HL              ;
        LD      C,(HL)          ;
        INC     HL              ;
        LD      B,(HL)          ;
        EX      DE,HL           ;
        LD      D,A             ;
        LD      E,(HL)          ;
        PUSH    DE              ;
        INC     HL              ;
        LD      D,(HL)          ;
        INC     HL              ;
        LD      E,(HL)          ;
        PUSH    DE              ;
        EXX                     ;
        POP     DE              ;
        POP     HL              ;
        POP     BC              ;
        EXX                     ;
        INC     HL              ;
        LD      D,(HL)          ;
        INC     HL              ;
        LD      E,(HL)          ;

        POP     AF              ; restore possible result sign.
        POP     HL              ; and pointer to possible result.
        RET                     ; return.

; ---------------------------------
; Shift floating point number right
; ---------------------------------
;
;

;; SHIFT-FP
L2FDD:  AND     A               ;
        RET     Z               ;

        CP      $21             ;
        JR      NC,L2FF9        ; to ADDEND-0

        PUSH    BC              ;
        LD      B,A             ;

;; ONE-SHIFT
L2FE5:  EXX                     ;
        SRA     L               ;
        RR      D               ;
        RR      E               ;
        EXX                     ;
        RR      D               ;
        RR      E               ;
        DJNZ    L2FE5           ; to ONE-SHIFT

        POP     BC              ;
        RET     NC              ;

        CALL    L3004           ; routine ADD-BACK
        RET     NZ              ;

;; ADDEND-0
L2FF9:  EXX                     ;
        XOR     A               ;

;; ZEROS-4/5
L2FFB:  LD      L,$00           ;
        LD      D,A             ;
        LD      E,L             ;
        EXX                     ;
        LD      DE,$0000        ;
        RET                     ;

; ------------------
; Add back any carry
; ------------------
;
;

;; ADD-BACK
L3004:  INC     E               ;
        RET     NZ              ;

        INC      D              ;
        RET     NZ              ;

        EXX                     ;
        INC     E               ;
        JR      NZ,L300D        ; to ALL-ADDED

        INC     D               ;

;; ALL-ADDED
L300D:  EXX                     ;
        RET                     ;

; -----------------------
; Handle subtraction (03)
; -----------------------
; Subtraction is done by switching the sign byte/bit of the second number
; which may be integer of floating point and continuing into addition.

;; subtract
L300F:  EX      DE,HL           ; address second number with HL

        CALL    L346E           ; routine NEGATE switches sign

        EX      DE,HL           ; address first number again
                                ; and continue.

; --------------------
; Handle addition (0F)
; --------------------
; HL points to first number, DE to second.
; If they are both integers, then go for the easy route.

;; addition
L3014:  LD      A,(DE)          ; fetch first byte of second
        OR      (HL)            ; combine with first byte of first
        JR      NZ,L303E        ; forward to FULL-ADDN if at least one was
                                ; in floating point form.

; continue if both were small integers.

        PUSH    DE              ; save pointer to lowest number for result.

        INC     HL              ; address sign byte and
        PUSH    HL              ; push the pointer.

        INC     HL              ; address low byte
        LD      E,(HL)          ; to E
        INC     HL              ; address high byte
        LD      D,(HL)          ; to D
        INC     HL              ; address unused byte

        INC     HL              ; address known zero indicator of 1st number
        INC     HL              ; address sign byte

        LD      A,(HL)          ; sign to A, $00 or $FF

        INC     HL              ; address low byte
        LD      C,(HL)          ; to C
        INC     HL              ; address high byte
        LD      B,(HL)          ; to B

        POP     HL              ; pop result sign pointer
        EX      DE,HL           ; integer to HL

        ADD     HL,BC           ; add to the other one in BC
                                ; setting carry if overflow.

        EX      DE,HL           ; save result in DE bringing back sign pointer

        ADC     A,(HL)          ; if pos/pos A=01 with overflow else 00
                                ; if neg/neg A=FF with overflow else FE
                                ; if mixture A=00 with overflow else FF

        RRCA                    ; bit 0 to (C)

        ADC     A,$00           ; both acceptable signs now zero

        JR      NZ,L303C        ; forward to ADDN-OFLW if not

        SBC     A,A             ; restore a negative result sign

        LD      (HL),A          ;
        INC     HL              ;
        LD      (HL),E          ;
        INC     HL              ;
        LD      (HL),D          ;
        DEC     HL              ;
        DEC     HL              ;
        DEC     HL              ;

        POP     DE              ; STKEND
        RET                     ;

; ---

;; ADDN-OFLW
L303C:  DEC     HL              ;
        POP     DE              ;

;; FULL-ADDN
L303E:  CALL    L3293           ; routine RE-ST-TWO
        EXX                     ;
        PUSH    HL              ;
        EXX                     ;
        PUSH    DE              ;
        PUSH    HL              ;
        CALL    L2F9B           ; routine PREP-ADD
        LD      B,A             ;
        EX      DE,HL           ;
        CALL    L2F9B           ; routine PREP-ADD
        LD       C,A            ;
        CP      B               ;
        JR      NC,L3055        ; to SHIFT-LEN

        LD      A,B             ;
        LD      B,C             ;
        EX      DE,HL           ;

;; SHIFT-LEN
L3055:  PUSH    AF              ;
        SUB     B               ;
        CALL    L2FBA           ; routine FETCH-TWO
        CALL    L2FDD           ; routine SHIFT-FP
        POP     AF              ;
        POP     HL              ;
        LD      (HL),A          ;
        PUSH    HL              ;
        LD      L,B             ;
        LD      H,C             ;
        ADD     HL,DE           ;
        EXX                     ;
        EX      DE,HL           ;
        ADC     HL,BC           ;
        EX      DE,HL           ;
        LD      A,H             ;
        ADC     A,L             ;
        LD      L,A             ;
        RRA                     ;
        XOR     L               ;
        EXX                     ;
        EX      DE,HL           ;
        POP     HL              ;
        RRA                     ;
        JR      NC,L307C        ; to TEST-NEG

        LD      A,$01           ;
        CALL    L2FDD           ; routine SHIFT-FP
        INC     (HL)            ;
        JR      Z,L309F         ; to ADD-REP-6

;; TEST-NEG
L307C:  EXX                     ;
        LD      A,L             ;
        AND     $80             ;
        EXX                     ;
        INC     HL              ;
        LD      (HL),A          ;
        DEC     HL              ;
        JR      Z,L30A5         ; to GO-NC-MLT

        LD      A,E             ;
        NEG                     ; Negate
        CCF                     ; Complement Carry Flag
        LD      E,A             ;
        LD      A,D             ;
        CPL                     ;
        ADC     A,$00           ;
        LD      D,A             ;
        EXX                     ;
        LD      A,E             ;
        CPL                     ;
        ADC     A,$00           ;
        LD      E,A             ;
        LD      A,D             ;
        CPL                     ;
        ADC     A,$00           ;
        JR      NC,L30A3        ; to END-COMPL

        RRA                     ;
        EXX                     ;
        INC     (HL)            ;

;; ADD-REP-6
L309F:  JP      Z,L31AD         ; to REPORT-6

        EXX                     ;

;; END-COMPL
L30A3:  LD      D,A             ;
        EXX                     ;

;; GO-NC-MLT
L30A5:  XOR     A               ;
        JP      L3155           ; to TEST-NORM

; -----------------------------
; Used in 16 bit multiplication
; -----------------------------
; This routine is used, in the first instance, by the multiply calculator
; literal to perform an integer multiplication in preference to
; 32-bit multiplication to which it will resort if this overflows.
;
; It is also used by STK-VAR to calculate array subscripts and by DIM to
; calculate the space required for multi-dimensional arrays.

;; HL-HL*DE
L30A9:  PUSH    BC              ; preserve BC throughout
        LD      B,$10           ; set B to 16
        LD      A,H             ; save H in A high byte
        LD      C,L             ; save L in C low byte
        LD      HL,$0000        ; initialize result to zero

; now enter a loop.

;; HL-LOOP
L30B1:  ADD     HL,HL           ; double result
        JR      C,L30BE         ; to HL-END if overflow

        RL      C               ; shift AC left into carry
        RLA                     ;
        JR      NC,L30BC        ; to HL-AGAIN to skip addition if no carry

        ADD     HL,DE           ; add in DE
        JR      C,L30BE         ; to HL-END if overflow

;; HL-AGAIN
L30BC:  DJNZ    L30B1           ; back to HL-LOOP for all 16 bits

;; HL-END
L30BE:  POP     BC              ; restore preserved BC
        RET                     ; return with carry reset if successful
                                ; and result in HL.

; ----------------------------------------------
; THE 'PREPARE TO MULTIPLY OR DIVIDE' SUBROUTINE
; ----------------------------------------------
;   This routine is called in succession from multiply and divide to prepare
;   two mantissas by setting the leftmost bit that is used for the sign.
;   On the first call A holds zero and picks up the sign bit. On the second
;   call the two bits are XORed to form the result sign - minus * minus giving
;   plus etc. If either number is zero then this is flagged.
;   HL addresses the exponent.

;; PREP-M/D
L30C0:  CALL    L34E9           ; routine TEST-ZERO  preserves accumulator.
        RET     C               ; return carry set if zero

        INC     HL              ; address first byte of mantissa
        XOR     (HL)            ; pick up the first or xor with first.
        SET     7,(HL)          ; now set to give true 32-bit mantissa
        DEC     HL              ; point to exponent
        RET                     ; return with carry reset

; ----------------------
; THE 'MULTIPLY' ROUTINE     
; ----------------------
; (offset: $04 'multiply')
;
;
;   "He said go forth and something about mathematics, I wasn't really 
;    listening" - overheard conversation between two unicorns.
;    [ The Odd Streak ].

;; multiply
L30CA:  LD      A,(DE)          ;
        OR      (HL)            ;
        JR      NZ,L30F0        ; to MULT-LONG

        PUSH    DE              ;
        PUSH    HL              ;
        PUSH    DE              ;
        CALL    L2D7F           ; routine INT-FETCH
        EX      DE,HL           ;
        EX      (SP),HL         ;
        LD      B,C             ;
        CALL    L2D7F           ; routine INT-FETCH
        LD      A,B             ;
        XOR     C               ;
        LD      C,A             ;
        POP     HL              ;
        CALL    L30A9           ; routine HL-HL*DE
        EX      DE,HL           ;
        POP     HL              ;
        JR      C,L30EF         ; to MULT-OFLW

        LD      A,D             ;
        OR      E               ;
        JR      NZ,L30EA        ; to MULT-RSLT

        LD      C,A             ;

;; MULT-RSLT
L30EA:  CALL    L2D8E           ; routine INT-STORE
        POP      DE             ;
        RET                     ;

; ---

;; MULT-OFLW
L30EF:  POP     DE              ;

;; MULT-LONG
L30F0:  CALL    L3293           ; routine RE-ST-TWO
        XOR     A               ;
        CALL    L30C0           ; routine PREP-M/D
        RET     C               ;

        EXX                     ;
        PUSH    HL              ;
        EXX                     ;
        PUSH    DE              ;
        EX      DE,HL           ;
        CALL    L30C0           ; routine PREP-M/D
        EX      DE,HL           ;
        JR      C,L315D         ; to ZERO-RSLT

        PUSH    HL              ;
        CALL    L2FBA           ; routine FETCH-TWO
        LD      A,B             ;
        AND     A               ;
        SBC     HL,HL           ;
        EXX                     ;
        PUSH    HL              ;
        SBC     HL,HL           ;
        EXX                     ;
        LD      B,$21           ;
        JR      L3125           ; to STRT-MLT

; ---

;; MLT-LOOP
L3114:  JR      NC,L311B        ; to NO-ADD

        ADD     HL,DE           ;
        EXX                     ;
        ADC     HL,DE           ;
        EXX                     ;

;; NO-ADD
L311B:  EXX                     ;
        RR      H               ;
        RR      L               ;
        EXX                     ;
        RR      H               ;
        RR      L               ;

;; STRT-MLT
L3125:  EXX                     ;
        RR      B               ;
        RR      C               ;
        EXX                     ;
        RR      C               ;
        RRA                     ;
        DJNZ    L3114           ; to MLT-LOOP

        EX      DE,HL           ;
        EXX                     ;
        EX      DE,HL           ;
        EXX                     ;
        POP     BC              ;
        POP     HL              ;
        LD      A,B             ;
        ADD     A,C             ;
        JR      NZ,L313B        ; to MAKE-EXPT

        AND     A               ;

;; MAKE-EXPT
L313B:  DEC     A               ;
        CCF                     ; Complement Carry Flag

;; DIVN-EXPT
L313D:  RLA                     ;
        CCF                     ; Complement Carry Flag
        RRA                     ;
        JP      P,L3146         ; to OFLW1-CLR

        JR      NC,L31AD        ; to REPORT-6

        AND     A               ;

;; OFLW1-CLR
L3146:  INC     A               ;
        JR      NZ,L3151        ; to OFLW2-CLR

        JR      C,L3151         ; to OFLW2-CLR

        EXX                     ;
        BIT     7,D             ;
        EXX                     ;
        JR      NZ,L31AD        ; to REPORT-6

;; OFLW2-CLR
L3151:  LD      (HL),A          ;
        EXX                     ;
        LD      A,B             ;
        EXX                     ;

;; TEST-NORM
L3155:  JR      NC,L316C        ; to NORMALISE

        LD      A,(HL)          ;
        AND     A               ;

;; NEAR-ZERO
L3159:  LD      A,$80           ;
        JR      Z,L315E         ; to SKIP-ZERO

;; ZERO-RSLT
L315D:  XOR     A               ;

;; SKIP-ZERO
L315E:  EXX                     ;
        AND     D               ;
        CALL    L2FFB           ; routine ZEROS-4/5
        RLCA                    ;
        LD      (HL),A          ;
        JR      C,L3195         ; to OFLOW-CLR

        INC     HL              ;
        LD      (HL),A          ;
        DEC     HL              ;
        JR      L3195           ; to OFLOW-CLR

; ---

;; NORMALISE
L316C:  LD      B,$20           ;

;; SHIFT-ONE
L316E:  EXX                     ;
        BIT     7,D             ;
        EXX                     ;
        JR      NZ,L3186        ; to NORML-NOW

        RLCA                    ;
        RL      E               ;
        RL      D               ;
        EXX                     ;
        RL      E               ;
        RL      D               ;
        EXX                     ;
        DEC     (HL)            ;
        JR      Z,L3159         ; to NEAR-ZERO

        DJNZ    L316E           ; to SHIFT-ONE

        JR      L315D           ; to ZERO-RSLT

; ---

;; NORML-NOW
L3186:  RLA                     ;
        JR      NC,L3195        ; to OFLOW-CLR

        CALL    L3004           ; routine ADD-BACK
        JR      NZ,L3195        ; to OFLOW-CLR

        EXX                     ;
        LD       D,$80          ;
        EXX                     ;
        INC     (HL)            ;
        JR      Z,L31AD         ; to REPORT-6

;; OFLOW-CLR
L3195:  PUSH    HL              ;
        INC     HL              ;
        EXX                     ;
        PUSH    DE              ;
        EXX                     ;
        POP     BC              ;
        LD      A,B             ;
        RLA                     ;
        RL      (HL)            ;
        RRA                     ;
        LD      (HL),A          ;
        INC     HL              ;
        LD      (HL),C          ;
        INC     HL              ;
        LD      (HL),D          ;
        INC     HL              ;
        LD      (HL),E          ;
        POP     HL              ;
        POP     DE              ;
        EXX                     ;
        POP     HL              ;
        EXX                     ;
        RET                     ;

; ---

;; REPORT-6
L31AD:  RST     08H             ; ERROR-1
        DEFB    $05             ; Error Report: Number too big

; ----------------------
; THE 'DIVISION' ROUTINE
; ----------------------
; (offset: $05 'division')
;
;   "He who can properly define and divide is to be considered a god"
;   - Plato,  429 - 347 B.C.

;; division
L31AF:  CALL    L3293           ; routine RE-ST-TWO
        EX      DE,HL           ;
        XOR     A               ;
        CALL    L30C0           ; routine PREP-M/D
        JR      C,L31AD         ; to REPORT-6

        EX      DE,HL           ;
        CALL    L30C0           ; routine PREP-M/D
        RET     C               ;

        EXX                     ;
        PUSH    HL              ;
        EXX                     ;
        PUSH    DE              ;
        PUSH    HL              ;
        CALL    L2FBA           ; routine FETCH-TWO
        EXX                     ;
        PUSH    HL              ;
        LD      H,B             ;
        LD      L,C             ;
        EXX                     ;
        LD      H,C             ;
        LD      L,B             ;
        XOR     A               ;
        LD      B,$DF           ;
        JR      L31E2           ; to DIV-START

; ---

;; DIV-LOOP
L31D2:  RLA                     ;
        RL      C               ;
        EXX                     ;
        RL      C               ;
        RL      B               ;
        EXX                     ;

;; div-34th
L31DB:  ADD     HL,HL           ;
        EXX                     ;
        ADC     HL,HL           ;
        EXX                     ;
        JR      C,L31F2         ; to SUBN-ONLY

;; DIV-START
L31E2:  SBC     HL,DE           ;
        EXX                     ;
        SBC     HL,DE           ;
        EXX                     ;
        JR      NC,L31F9        ; to NO-RSTORE

        ADD     HL,DE           ;
        EXX                     ;
        ADC     HL,DE           ;
        EXX                     ;
        AND     A               ;
        JR      L31FA           ; to COUNT-ONE

; ---

;; SUBN-ONLY
L31F2:  AND     A               ;
        SBC     HL,DE           ;
        EXX                     ;
        SBC     HL,DE           ;
        EXX                     ;

;; NO-RSTORE
L31F9:  SCF                     ; Set Carry Flag

;; COUNT-ONE
L31FA:  INC     B               ;
        JP      M,L31D2         ; to DIV-LOOP

        PUSH    AF              ;
        JR      Z,L31E2         ; to DIV-START

;
;
;
;

        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      L313D           ; jump back to DIVN-EXPT

; ------------------------------------
; Integer truncation towards zero ($3A)
; ------------------------------------
;
;

;; truncate
L3214:  LD      A,(HL)          ;
        AND     A               ;
        RET     Z               ;

        CP      $81             ;
        JR      NC,L3221        ; to T-GR-ZERO

        LD      (HL),$00        ;
        LD      A,$20           ;
        JR      L3272           ; to NIL-BYTES

; ---

;; T-GR-ZERO
L3221:  CP      $91             ;
        JR      NZ,L323F        ; to T-SMALL

        INC     HL              ;
        INC     HL              ;
        INC     HL              ;
        LD      A,$80           ;
        AND     (HL)            ;
        DEC     HL              ;
        OR      (HL)            ;
        DEC     HL              ;
        JR      NZ,L3233        ; to T-FIRST

        LD      A,$80           ;
        XOR     (HL)            ;

;; T-FIRST
L3233:  DEC     HL              ;
        JR      NZ,L326C        ; to T-EXPNENT

        LD      (HL),A          ;
        INC     HL              ;
        LD      (HL),$FF        ;
        DEC     HL              ;
        LD      A,$18           ;
        JR      L3272           ; to NIL-BYTES

; ---

;; T-SMALL
L323F:  JR      NC,L326D        ; to X-LARGE

        PUSH    DE              ;
        CPL                     ;
        ADD     A,$91           ;
        INC     HL              ;
        LD      D,(HL)          ;
        INC     HL              ;
        LD      E,(HL)          ;
        DEC     HL              ;
        DEC     HL              ;
        LD      C,$00           ;
        BIT     7,D             ;
        JR      Z,L3252         ; to T-NUMERIC

        DEC     C               ;

;; T-NUMERIC
L3252:  SET     7,D             ;
        LD      B,$08           ;
        SUB     B               ;
        ADD     A,B             ;
        JR      C,L325E         ; to T-TEST

        LD      E,D             ;
        LD      D,$00           ;
        SUB     B               ;

;; T-TEST
L325E:  JR      Z,L3267         ; to T-STORE

        LD      B,A             ;

;; T-SHIFT
L3261:  SRL     D               ;
        RR      E               ;
        DJNZ    L3261           ; to T-SHIFT

;; T-STORE
L3267:  CALL    L2D8E           ; routine INT-STORE
        POP     DE              ;
        RET                     ;

; ---

;; T-EXPNENT
L326C:  LD      A,(HL)          ;

;; X-LARGE
L326D:  SUB     $A0             ;
        RET     P               ;

        NEG                     ; Negate

;; NIL-BYTES
L3272:  PUSH    DE              ;
        EX      DE,HL           ;
        DEC     HL              ;
        LD      B,A             ;
        SRL     B               ;
        SRL     B               ;
        SRL     B               ;
        JR      Z,L3283         ; to BITS-ZERO

;; BYTE-ZERO
L327E:  LD      (HL),$00        ;
        DEC     HL              ;
        DJNZ    L327E           ; to BYTE-ZERO

;; BITS-ZERO
L3283:  AND     $07             ;
        JR      Z,L3290         ; to IX-END

        LD      B,A             ;
        LD      A,$FF           ;

;; LESS-MASK
L328A:  SLA     A               ;
        DJNZ    L328A           ; to LESS-MASK

        AND     (HL)            ;
        LD      (HL),A          ;

;; IX-END
L3290:  EX      DE,HL           ;
        POP     DE              ;
        RET                     ;

; ----------------------------------
; Storage of numbers in 5 byte form.
; ==================================
; Both integers and floating-point numbers can be stored in five bytes.
; Zero is a special case stored as 5 zeros.
; For integers the form is
; Byte 1 - zero,
; Byte 2 - sign byte, $00 +ve, $FF -ve.
; Byte 3 - Low byte of integer.
; Byte 4 - High byte
; Byte 5 - unused but always zero.
;
; it seems unusual to store the low byte first but it is just as easy either
; way. Statistically it just increases the chances of trailing zeros which
; is an advantage elsewhere in saving ROM code.
;
;             zero     sign     low      high    unused
; So +1 is  00000000 00000000 00000001 00000000 00000000
;
; and -1 is 00000000 11111111 11111111 11111111 00000000
;
; much of the arithmetic found in BASIC lines can be done using numbers
; in this form using the Z80's 16 bit register operation ADD.
; (multiplication is done by a sequence of additions).
;
; Storing -ve integers in two's complement form, means that they are ready for
; addition and you might like to add the numbers above to prove that the
; answer is zero. If, as in this case, the carry is set then that denotes that
; the result is positive. This only applies when the signs don't match.
; With positive numbers a carry denotes the result is out of integer range.
; With negative numbers a carry denotes the result is within range.
; The exception to the last rule is when the result is -65536
;
; Floating point form is an alternative method of storing numbers which can
; be used for integers and larger (or fractional) numbers.
;
; In this form 1 is stored as
;           10000001 00000000 00000000 00000000 00000000
;
; When a small integer is converted to a floating point number the last two
; bytes are always blank so they are omitted in the following steps
;
; first make exponent +1 +16d  (bit 7 of the exponent is set if positive)

; 10010001 00000000 00000001
; 10010000 00000000 00000010 <-  now shift left and decrement exponent
; ...
; 10000010 01000000 00000000 <-  until a 1 abuts the imaginary point
; 10000001 10000000 00000000     to the left of the mantissa.
;
; however since the leftmost bit of the mantissa is always set then it can
; be used to denote the sign of the mantissa and put back when needed by the
; PREP routines which gives
;
; 10000001 00000000 00000000

; ----------------------------------------------
; THE 'RE-STACK TWO "SMALL" INTEGERS' SUBROUTINE
; ----------------------------------------------
;   This routine is called to re-stack two numbers in full floating point form
;   e.g. from mult when integer multiplication has overflowed.

;; RE-ST-TWO
L3293:  CALL    L3296           ; routine RESTK-SUB  below and continue
                                ; into the routine to do the other one.

;; RESTK-SUB
L3296:  EX      DE,HL           ; swap pointers

; ---------------------------------------------
; THE 'RE-STACK ONE "SMALL" INTEGER' SUBROUTINE
; ---------------------------------------------
; (offset: $3D 're-stack')
;   This routine re-stacks an integer, usually on the calculator stack, in full 
;   floating point form.  HL points to first byte.

;; re-stack
L3297:  LD      A,(HL)          ; Fetch Exponent byte to A
        AND     A               ; test it
        RET     NZ              ; return if not zero as already in full
                                ; floating-point form.

        PUSH    DE              ; preserve DE.
        CALL    L2D7F           ; routine INT-FETCH
                                ; integer to DE, sign to C.

; HL points to 4th byte.

        XOR     A               ; clear accumulator.
        INC     HL              ; point to 5th.
        LD      (HL),A          ; and blank.
        DEC     HL              ; point to 4th.
        LD      (HL),A          ; and blank.

        LD      B,$91           ; set exponent byte +ve $81
                                ; and imaginary dec point 16 bits to right
                                ; of first bit.

;   we could skip to normalize now but it's quicker to avoid normalizing 
;   through an empty D.

        LD      A,D             ; fetch the high byte D
        AND     A               ; is it zero ?
        JR      NZ,L32B1        ; skip to RS-NRMLSE if not.

        OR      E               ; low byte E to A and test for zero
        LD      B,D             ; set B exponent to 0
        JR      Z,L32BD         ; forward to RS-STORE if value is zero.

        LD      D,E             ; transfer E to D
        LD      E,B             ; set E to 0
        LD      B,$89           ; reduce the initial exponent by eight.


;; RS-NRMLSE
L32B1:  EX      DE,HL           ; integer to HL, addr of 4th byte to DE.

;; RSTK-LOOP
L32B2:  DEC     B               ; decrease exponent
        ADD     HL,HL           ; shift DE left
        JR      NC,L32B2        ; loop back to RSTK-LOOP
                                ; until a set bit pops into carry

        RRC     C               ; now rotate the sign byte $00 or $FF
                                ; into carry to give a sign bit

        RR      H               ; rotate the sign bit to left of H
        RR      L               ; rotate any carry into L

        EX      DE,HL           ; address 4th byte, normalized int to DE

;; RS-STORE
L32BD:  DEC     HL              ; address 3rd byte
        LD      (HL),E          ; place E
        DEC     HL              ; address 2nd byte
        LD      (HL),D          ; place D
        DEC     HL              ; address 1st byte
        LD      (HL),B          ; store the exponent

        POP     DE              ; restore initial DE.
        RET                     ; return.

;****************************************
;** Part 10. FLOATING-POINT CALCULATOR **
;****************************************

; As a general rule the calculator avoids using the IY register.
; exceptions are val, 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'
; ------------------------
;
;

; used 11 times
;; stk-zero                                                 00 00 00 00 00
L32C5:  DEFB    $00             ;;Bytes: 1
        DEFB    $B0             ;;Exponent $00
        DEFB    $00             ;;(+00,+00,+00)

; used 19 times
;; stk-one                                                  00 00 01 00 00
L32C8:  DEFB    $40             ;;Bytes: 2
        DEFB    $B0             ;;Exponent $00
        DEFB    $00,$01         ;;(+00,+00)

; used 9 times
;; stk-half                                                 80 00 00 00 00
L32CC:  DEFB    $30             ;;Exponent: $80, Bytes: 1
        DEFB    $00             ;;(+00,+00,+00)

; used 4 times.
;; stk-pi/2                                                 81 49 0F DA A2
L32CE:  DEFB    $F1             ;;Exponent: $81, Bytes: 4
        DEFB    $49,$0F,$DA,$A2 ;;

; used 3 times.
;; stk-ten                                                  00 00 0A 00 00
L32D3:  DEFB    $40             ;;Bytes: 2
        DEFB    $B0             ;;Exponent $00
        DEFB    $00,$0A         ;;(+00,+00)


; ------------------------
; THE 'TABLE OF ADDRESSES'
; ------------------------
;  "Each problem that I solved became a rule which served afterwards to solve 
;   other problems" - Rene Descartes 1596 - 1650.
;
;   Starts with binary operations which have two operands and one result.
;   Three pseudo binary operations first.

;; tbl-addrs
L32D7:  DEFW    L368F           ; $00 Address: $368F - jump-true
        DEFW    L343C           ; $01 Address: $343C - exchange
        DEFW    L33A1           ; $02 Address: $33A1 - delete

;   True binary operations.

        DEFW    L300F           ; $03 Address: $300F - subtract
        DEFW    L30CA           ; $04 Address: $30CA - multiply
        DEFW    L31AF           ; $05 Address: $31AF - division
        DEFW    L3851           ; $06 Address: $3851 - to-power
        DEFW    L351B           ; $07 Address: $351B - or

        DEFW    L3524           ; $08 Address: $3524 - no-&-no
        DEFW    L353B           ; $09 Address: $353B - no-l-eql
        DEFW    L353B           ; $0A Address: $353B - no-gr-eql
        DEFW    L353B           ; $0B Address: $353B - nos-neql
        DEFW    L353B           ; $0C Address: $353B - no-grtr
        DEFW    L353B           ; $0D Address: $353B - no-less
        DEFW    L353B           ; $0E Address: $353B - nos-eql
        DEFW    L3014           ; $0F Address: $3014 - addition

        DEFW    L352D           ; $10 Address: $352D - str-&-no
        DEFW    L353B           ; $11 Address: $353B - str-l-eql
        DEFW    L353B           ; $12 Address: $353B - str-gr-eql
        DEFW    L353B           ; $13 Address: $353B - strs-neql
        DEFW    L353B           ; $14 Address: $353B - str-grtr
        DEFW    L353B           ; $15 Address: $353B - str-less
        DEFW    L353B           ; $16 Address: $353B - strs-eql
        DEFW    L359C           ; $17 Address: $359C - strs-add

;   Unary follow.

        DEFW    L35DE           ; $18 Address: $35DE - val$
        DEFW    L34BC           ; $19 Address: $34BC - usr-$
        DEFW    L3645           ; $1A Address: $3645 - read-in
        DEFW    L346E           ; $1B Address: $346E - negate

        DEFW    L3669           ; $1C Address: $3669 - code
        DEFW    L35DE           ; $1D Address: $35DE - val
        DEFW    L3674           ; $1E Address: $3674 - len
        DEFW    L37B5           ; $1F Address: $37B5 - sin
        DEFW    L37AA           ; $20 Address: $37AA - cos
        DEFW    L37DA           ; $21 Address: $37DA - tan
        DEFW    L3833           ; $22 Address: $3833 - asn
        DEFW    L3843           ; $23 Address: $3843 - acs
        DEFW    L37E2           ; $24 Address: $37E2 - atn
        DEFW    L3713           ; $25 Address: $3713 - ln
        DEFW    L36C4           ; $26 Address: $36C4 - exp
        DEFW    L36AF           ; $27 Address: $36AF - int
        DEFW    L384A           ; $28 Address: $384A - sqr
        DEFW    L3492           ; $29 Address: $3492 - sgn
        DEFW    L346A           ; $2A Address: $346A - abs
        DEFW    L34AC           ; $2B Address: $34AC - peek
        DEFW    L34A5           ; $2C Address: $34A5 - in
        DEFW    L34B3           ; $2D Address: $34B3 - usr-no
        DEFW    L361F           ; $2E Address: $361F - str$
        DEFW    L35C9           ; $2F Address: $35C9 - chrs
        DEFW    L3501           ; $30 Address: $3501 - not

;   End of true unary.

        DEFW    L33C0           ; $31 Address: $33C0 - duplicate
        DEFW    L36A0           ; $32 Address: $36A0 - n-mod-m
        DEFW    L3686           ; $33 Address: $3686 - jump
        DEFW    L33C6           ; $34 Address: $33C6 - stk-data
        DEFW    L367A           ; $35 Address: $367A - dec-jr-nz
        DEFW    L3506           ; $36 Address: $3506 - less-0
        DEFW    L34F9           ; $37 Address: $34F9 - greater-0
        DEFW    L369B           ; $38 Address: $369B - end-calc
        DEFW    L3783           ; $39 Address: $3783 - get-argt
        DEFW    L3214           ; $3A Address: $3214 - truncate
        DEFW    L33A2           ; $3B Address: $33A2 - fp-calc-2
        DEFW    L2D4F           ; $3C Address: $2D4F - e-to-fp
        DEFW    L3297           ; $3D Address: $3297 - re-stack

;   The following are just the next available slots for the 128 compound 
;   literals which are in range $80 - $FF.

        DEFW    L3449           ;     Address: $3449 - series-xx    $80 - $9F.
        DEFW    L341B           ;     Address: $341B - stk-const-xx $A0 - $BF.
        DEFW    L342D           ;     Address: $342D - st-mem-xx    $C0 - $DF.
        DEFW    L340F           ;     Address: $340F - get-mem-xx   $E0 - $FF.

;   Aside: 3E - 3F are therefore unused calculator literals.
;   If the literal has to be also usable as a function then bits 6 and 7 are 
;   used to show type of arguments and result.

; --------------
; The Calculator
; --------------
;  "A good calculator does not need artificial aids"
;  Lao Tze 604 - 531 B.C.

;; CALCULATE
L335B:  CALL    L35BF           ; 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
L335E:  LD      A,B             ; fetch the Z80 B register to A
        LD      ($5C67),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
L3362:  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 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
L3365:  LD      ($5C65),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
L336C:  PUSH    HL              ; save pointer on stack
        AND     A               ; now test the literal
        JP      P,L3380         ; 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,$7C           ; add ($3E * 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      L338E           ; forward to ENT-TABLE

; ---

; the branch was here with simple literals.

;; FIRST-3D
L3380:  CP      $18             ; compare with first unary operations.
        JR      NC,L338C        ; 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
L338C:  RLCA                    ; double the literal
        LD      L,A             ; and store in L for indexing

;; ENT-TABLE
L338E:  LD      DE,L32D7        ; 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,L3365        ; Address: RE-ENTRY
        EX      (SP),HL         ; goes to stack
        PUSH    DE              ; now address of routine
        EXX                     ; main set
                                ; avoid using IY register.
        LD      BC,($5C66)      ; STKEND_hi
                                ; nothing much goes to C but BREG to B
                                ; and continue into next ret instruction
                                ; which has a dual identity


; ------------------
; Handle delete (02)
; ------------------
; 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
L33A1:  RET                     ; return - indirect jump if from above.

; ---------------------
; Single operation (3B)
; ---------------------
;   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
L33A2:  POP     AF              ; drop return address.
        LD      A,($5C67)       ; load accumulator from system variable BREG
                                ; value will be literal e.g. 'tan'
        EXX                     ; switch to alt
        JR      L336C           ; back to SCAN-ENT
                                ; next literal will be end-calc at L2758

; ---------------------------------
; THE 'TEST FIVE 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
L33A9:  PUSH    DE              ; save
        PUSH    HL              ; registers
        LD      BC,$0005        ; an overhead of five bytes
        CALL    L1F05           ; 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 'STACK NUMBER' SUBROUTINE
; -----------------------------
;   This routine is called to stack a hidden floating point number found in
;   a BASIC line.  It is also called to stack a numeric variable value, and
;   from BEEP, to stack an entry in the semi-tone table.  It is not part of the
;   calculator suite of routines.  On entry, HL points to the number to be 
;   stacked.

;; STACK-NUM
L33B4:  LD      DE,($5C65)      ; Load destination from STKEND system variable.

        CALL    L33C0           ; Routine MOVE-FP puts on calculator stack 
                                ; with a memory check.
        LD      ($5C65),DE      ; Set STKEND to next free location.

        RET                     ; Return.

; ---------------------------------
; Move a floating point number (31)
; ---------------------------------

; 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
L33C0:  CALL    L33A9           ; 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.

; -------------------
; Stack literals ($34)
; -------------------
; 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 integer or floating point form as succinctly as is possible.

;; stk-data
L33C6:  LD      H,D             ; transfer STKEND
        LD      L,E             ; to HL for result.

;; STK-CONST
L33C8:  CALL    L33A9           ; 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,L33DE        ; 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
L33DE:  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
L33F1:  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      L33F1           ; 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 ROM.  The destination DE normally points to the
;   end of the calculator stack which might be in the normal place or in the
;   system variables area during E-LINE-NO; INT-TO-FP; stk-ten.  In any case,
;   it would be simpler all round if the routine just shoved unwanted values 
;   where it is going to stick the wanted value.  The instruction LD DE, $0000 
;   can be removed.

;; SKIP-CONS
L33F7:  AND     A               ; test if initially zero.

;; SKIP-NEXT
L33F8:  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.
                                ; e.g. with Expandor Systems 'Soft ROM'.
                                ; Better still, write to the normal place.
        CALL    L33C8           ; routine STK-CONST works through variable
                                ; length records.

        POP     DE              ; restore real STKEND
        POP     AF              ; restore count
        DEC     A               ; decrease
        JR      L33F8           ; loop back to SKIP-NEXT

; ------------------------------
; THE 'LOCATE MEMORY' 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 reading the semi-tone table and addressing
;   floating-point numbers in the calculator's memory area.
;   It is not possible to use this routine for the table of constants as these
;   six values are held in compressed format.

;; LOC-MEM
L3406:  LD      C,A             ; store the original number $00-$1F.
        RLCA                    ; X2 - double.
        RLCA                    ; X4 - quadruple.
        ADD     A,C             ; X5 - now add original to multiply by five.

        LD      C,A             ; place the result in the low byte.
        LD      B,$00           ; set high byte to zero.
        ADD     HL,BC           ; add to form address of start of number in HL.

        RET                     ; return.

; ------------------------------
; Get from memory area ($E0 etc.)
; ------------------------------
; Literals $E0 to $FF
; A holds $00-$1F offset.
; The calculator stack increases by 5 bytes.

;; get-mem-xx
L340F:  PUSH    DE              ; save STKEND
        LD      HL,($5C68)      ; MEM is base address of the memory cells.
        CALL    L3406           ; routine LOC-MEM so that HL = first byte
        CALL    L33C0           ; routine MOVE-FP moves 5 bytes with memory
                                ; check.
                                ; DE now points to new STKEND.
        POP     HL              ; original STKEND is now RESULT pointer.
        RET                     ; return.

; --------------------------
; Stack a constant (A0 etc.)
; --------------------------
; 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 used for semi-tone table values.

;; stk-const-xx
L341B:  LD      H,D             ; save STKEND - required for result
        LD      L,E             ;
        EXX                     ; swap
        PUSH    HL              ; save pointer to next literal
        LD      HL,L32C5        ; Address: stk-zero - start of table of
                                ; constants
        EXX                     ;
        CALL    L33F7           ; routine SKIP-CONS
        CALL    L33C8           ; routine STK-CONST
        EXX                     ;
        POP     HL              ; restore pointer to next literal.
        EXX                     ;
        RET                     ; return.

; --------------------------------
; Store in a memory area ($C0 etc.)
; --------------------------------
; Offsets $C0 to $DF
; 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. Spectrum 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 the derived offset $00-$1F.
; This is a unary operation, so on entry HL points to the last value and DE 
; points to STKEND.

;; st-mem-xx
L342D:  PUSH    HL              ; save the result pointer.
        EX      DE,HL           ; transfer to DE.
        LD      HL,($5C68)      ; fetch MEM the base of memory area.
        CALL    L3406           ; routine LOC-MEM sets HL to the destination.
        EX      DE,HL           ; swap - HL is start, DE is destination.
        CALL    L33C0           ; 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 swaps 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
L343C:  LD      B,$05           ; there are five bytes to be swapped

; start of loop.

;; SWAP-BYTE
L343E:  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    L343E           ; 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' ROUTINE
; ------------------------------
; (offset: $86 'series-06')
; (offset: $88 'series-08')
; (offset: $8C 'series-0C')
;   The Spectrum 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
L3449:  LD      B,A             ; parameter $00 - $1F to B counter
        CALL    L335E           ; 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    $31             ;;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
L3453:  DEFB    $31             ;;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    $38             ;;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    L33C6           ; routine STK-DATA is called directly to
                                ; push a value and advance H'L'.
        CALL    L3362           ; 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    $35             ;;dec-jr-nz
        DEFB    $EE             ;;back to L3453, 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    $38             ;;end-calc

        RET                     ; return with H'L' pointing to location
                                ; after last number in series.

; ---------------------------------
; THE 'ABSOLUTE MAGNITUDE' FUNCTION
; ---------------------------------
; (offset: $2A 'abs')
;   This calculator literal finds the absolute value of the last value,
;   integer or floating point, on calculator stack.

;; abs
L346A:  LD      B,$FF           ; signal abs
        JR      L3474           ; forward to NEG-TEST

; ---------------------------
; THE 'UNARY MINUS' OPERATION
; ---------------------------
; (offset: $1B 'negate')
;   Unary so on entry HL points to last value, DE to STKEND.

;; NEGATE
;; negate
L346E:  CALL    L34E9           ; call routine TEST-ZERO and
        RET     C               ; return if so leaving zero unchanged.

        LD      B,$00           ; signal negate required before joining
                                ; common code.

;; NEG-TEST
L3474:  LD      A,(HL)          ; load first byte and 
        AND     A               ; test for zero
        JR      Z,L3483         ; forward to INT-CASE if a small integer

; for floating point numbers a single bit denotes the sign.

        INC     HL              ; address the first byte of mantissa.
        LD      A,B             ; action flag $FF=abs, $00=neg.
        AND     $80             ; now         $80      $00
        OR      (HL)            ; sets bit 7 for abs
        RLA                     ; sets carry for abs and if number negative
        CCF                     ; complement carry flag
        RRA                     ; and rotate back in altering sign
        LD      (HL),A          ; put the altered adjusted number back
        DEC     HL              ; HL points to result
        RET                     ; return with DE unchanged

; ---

; for integer numbers an entire byte denotes the sign.

;; INT-CASE
L3483:  PUSH    DE              ; save STKEND.

        PUSH    HL              ; save pointer to the last value/result.

        CALL    L2D7F           ; routine INT-FETCH puts integer in DE
                                ; and the sign in C.

        POP     HL              ; restore the result pointer.

        LD      A,B             ; $FF=abs, $00=neg
        OR      C               ; $FF for abs, no change neg
        CPL                     ; $00 for abs, switched for neg
        LD      C,A             ; transfer result to sign byte.

        CALL    L2D8E           ; routine INT-STORE to re-write the integer.

        POP     DE              ; restore STKEND.
        RET                     ; return.

; ---------------------
; THE 'SIGNUM' FUNCTION
; ---------------------
; (offset: $29 'sgn')
;   This routine replaces the last value on the calculator stack,
;   which may be in floating point or integer form, with the integer values
;   zero if zero, with one if positive and  with -minus one if negative.

;; sgn
L3492:  CALL    L34E9           ; call routine TEST-ZERO and
        RET     C               ; exit if so as no change is required.

        PUSH    DE              ; save pointer to STKEND.

        LD      DE,$0001        ; the result will be 1.
        INC     HL              ; skip over the exponent.
        RL      (HL)            ; rotate the sign bit into the carry flag.
        DEC     HL              ; step back to point to the result.
        SBC     A,A             ; byte will be $FF if negative, $00 if positive.
        LD      C,A             ; store the sign byte in the C register.
        CALL    L2D8E           ; routine INT-STORE to overwrite the last
                                ; value with 0001 and sign.

        POP     DE              ; restore STKEND.
        RET                     ; return.

; -----------------
; THE 'IN' FUNCTION
; -----------------
; (offset: $2C 'in')
;   This function reads a byte from an input port.

;; in
L34A5:  CALL    L1E99           ; Routine FIND-INT2 puts port address in BC.
                                ; All 16 bits are put on the address line.

        IN      A,(C)           ; Read the port.

        JR      L34B0           ; exit to STACK-A (via IN-PK-STK to save a byte 
                                ; of instruction code).

; -------------------
; THE 'PEEK' FUNCTION
; -------------------
; (offset: $2B 'peek')
;   This function returns the contents of a memory address.
;   The entire address space can be peeked including the ROM.

;; peek
L34AC:  CALL    L1E99           ; routine FIND-INT2 puts address in BC.
        LD      A,(BC)          ; load contents into A register.

;; IN-PK-STK
L34B0:  JP      L2D28           ; exit via STACK-A to put the value on the 
                                ; calculator stack.

; ------------------
; THE 'USR' FUNCTION
; ------------------
; (offset: $2d 'usr-no')
;   The USR function followed by a number 0-65535 is the method by which
;   the Spectrum invokes machine code programs. This function returns the
;   contents of the BC register pair.
;   Note. that STACK-BC re-initializes the IY register if a user-written
;   program has altered it.

;; usr-no
L34B3:  CALL    L1E99           ; routine FIND-INT2 to fetch the
                                ; supplied address into BC.

        LD      HL,L2D2B        ; 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.

; -------------------------
; THE 'USR STRING' FUNCTION
; -------------------------
; (offset: $19 'usr-$')
;   The user function with a one-character string argument, calculates the
;   address of the User Defined Graphic character that is in the string.
;   As an alternative, the ASCII equivalent, upper or lower case,
;   may be supplied. This provides a user-friendly method of redefining
;   the 21 User Definable Graphics e.g.
;   POKE USR "a", BIN 10000000 will put a dot in the top left corner of the
;   character 144.
;   Note. the curious double check on the range. With 26 UDGs the first check
;   only is necessary. With anything less the second check only is required.
;   It is highly likely that the first check was written by Steven Vickers.

;; usr-$
L34BC:  CALL    L2BF1           ; routine STK-FETCH fetches the string
                                ; parameters.
        DEC     BC              ; decrease BC by
        LD      A,B             ; one to test
        OR      C               ; the length.
        JR      NZ,L34E7        ; to REPORT-A if not a single character.

        LD      A,(DE)          ; fetch the character
        CALL    L2C8D           ; routine ALPHA sets carry if 'A-Z' or 'a-z'.
        JR      C,L34D3         ; forward to USR-RANGE if ASCII.

        SUB     $90             ; make UDGs range 0-20d
        JR      C,L34E7         ; to REPORT-A if too low. e.g. usr " ".

        CP      $15             ; Note. this test is not necessary.
        JR      NC,L34E7        ; to REPORT-A if higher than 20.

        INC     A               ; make range 1-21d to match LSBs of ASCII

;; USR-RANGE
L34D3:  DEC     A               ; make range of bits 0-4 start at zero
        ADD     A,A             ; multiply by eight
        ADD     A,A             ; and lose any set bits
        ADD     A,A             ; range now 0 - 25*8
        CP      $A8             ; compare to 21*8
        JR      NC,L34E7        ; to REPORT-A if originally higher 
                                ; than 'U','u' or graphics U.

        LD      BC,($5C7B)      ; fetch the UDG system variable value.
        ADD     A,C             ; add the offset to character
        LD      C,A             ; and store back in register C.
        JR      NC,L34E4        ; forward to USR-STACK if no overflow.

        INC     B               ; increment high byte.

;; USR-STACK
L34E4:  JP      L2D2B           ; jump back and exit via STACK-BC to store

; ---

;; REPORT-A
L34E7:  RST     08H             ; ERROR-1
        DEFB    $09             ; Error Report: Invalid argument

; ------------------------------
; THE 'TEST FOR ZERO' SUBROUTINE
; ------------------------------
;   Test if top value on calculator stack is zero.  The carry flag is set if 
;   the last value is zero but no registers are altered.
;   All five bytes will be zero but first four only need be tested.
;   On entry, HL points to the exponent the first byte of the value.

;; TEST-ZERO
L34E9:  PUSH    HL              ; preserve HL which is used to address.
        PUSH    BC              ; preserve BC which is used as a store.
        LD      B,A             ; preserve A in B.

        LD      A,(HL)          ; load first byte to accumulator
        INC     HL              ; advance.
        OR      (HL)            ; OR with second byte and clear carry.
        INC     HL              ; advance.
        OR      (HL)            ; OR with third byte.
        INC     HL              ; advance.
        OR      (HL)            ; OR with fourth byte.

        LD      A,B             ; restore A without affecting flags.
        POP     BC              ; restore the saved
        POP     HL              ; registers.

        RET     NZ              ; return if not zero and with carry reset.

        SCF                     ; set the carry flag.
        RET                     ; return with carry set if zero.

; --------------------------------
; THE 'GREATER THAN ZERO' OPERATOR
; --------------------------------
; (offset: $37 'greater-0' )
;   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
L34F9:  CALL    L34E9           ; routine TEST-ZERO
        RET     C               ; return if was zero as this
                                ; is also the Boolean 'false' value.

        LD      A,$FF           ; prepare XOR mask for sign bit
        JR      L3507           ; 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.

; ------------------
; THE 'NOT' FUNCTION
; ------------------
; (offset: $30 'not')
;   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
L3501:  CALL    L34E9           ; routine TEST-ZERO sets carry if zero

        JR      L350B           ; to FP-0/1 to overwrite operand with
                                ; 1 if carry is set else to overwrite with zero.

; ------------------------------
; THE 'LESS THAN ZERO' OPERATION
; ------------------------------
; (offset: $36 'less-0' )
;   Destructively test if last value on calculator stack is less than zero.
;   Bit 7 of second byte will be set if so.

;; less-0
L3506:  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
L3507:  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.

; ----------------------------
; THE 'ZERO OR ONE' SUBROUTINE
; ----------------------------
;   This routine places an integer value of zero or one at the addressed 
;   location of the calculator stack or MEM area.  The value one is written if 
;   carry is set on entry else zero.

;; FP-0/1
L350B:  PUSH    HL              ; save pointer to the first byte
        LD      A,$00           ; load accumulator with zero - without
                                ; disturbing flags.
        LD      (HL),A          ; zero to first byte
        INC     HL              ; address next
        LD      (HL),A          ; zero to 2nd byte
        INC     HL              ; address low byte of integer
        RLA                     ; carry to bit 0 of A
        LD      (HL),A          ; load one or zero to low byte.
        RRA                     ; restore zero to accumulator.
        INC     HL              ; address high byte of integer.
        LD      (HL),A          ; put a zero there.
        INC     HL              ; address fifth byte.
        LD      (HL),A          ; put a zero there.
        POP     HL              ; restore pointer to the first byte.
        RET                     ; return.

; -----------------
; THE 'OR' OPERATOR
; -----------------
; (offset: $07 'or' )
; The Boolean OR operator. e.g. 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
L351B:  EX      DE,HL           ; make HL point to second number
        CALL    L34E9           ; routine TEST-ZERO
        EX      DE,HL           ; restore pointers
        RET     C               ; return if result was zero - first operand, 
                                ; now the last value, is the result.

        SCF                     ; set carry flag
        JR      L350B           ; back to FP-0/1 to overwrite the first operand
                                ; with the value 1.


; ---------------------------------
; THE 'NUMBER AND NUMBER' OPERATION
; ---------------------------------
; (offset: $08 'no-&-no')
;   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
L3524:  EX      DE,HL           ; make HL address second operand.

        CALL    L34E9           ; routine TEST-ZERO sets carry if zero.

        EX      DE,HL           ; restore pointers.
        RET     NC              ; return if second non-zero, first is result.

;

        AND     A               ; else clear carry.
        JR      L350B           ; back to FP-0/1 to overwrite first operand
                                ; with zero for return value.

; ---------------------------------
; THE 'STRING AND NUMBER' OPERATION
; ---------------------------------
; (offset: $10 'str-&-no')
;   e.g. "You Win" AND score>99 will return the string if condition is true
;   or the null string if false.

;; str-&-no
L352D:  EX      DE,HL           ; make HL point to the number.
        CALL    L34E9           ; routine TEST-ZERO.
        EX      DE,HL           ; restore pointers. 
        RET     NC              ; 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.

; ---------------------------
; THE 'COMPARISON' OPERATIONS
; ---------------------------
; (offset: $0A 'no-gr-eql')
; (offset: $0B 'nos-neql')
; (offset: $0C 'no-grtr')
; (offset: $0D 'no-less')
; (offset: $0E 'nos-eql')
; (offset: $11 'str-l-eql')
; (offset: $12 'str-gr-eql')
; (offset: $13 'strs-neql')
; (offset: $14 'str-grtr')
; (offset: $15 'str-less')
; (offset: $16 'strs-eql')

;   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.
L353B:  LD      A,B             ; transfer literal to accumulator.
        SUB     $08             ; subtract eight - which is not useful. 

        BIT     2,A             ; isolate '>', '<', '='.

        JR      NZ,L3543        ; skip to EX-OR-NOT with these.

        DEC     A               ; else make $00-$02, $08-$0A to match bits 0-2.

;; EX-OR-NOT
L3543:  RRCA                    ; the first RRCA sets carry for a swap. 
        JR      NC,L354E        ; 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    L343C           ; 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
L354E:  BIT     2,A             ; test if a string comparison.
        JR      NZ,L3559        ; 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    L300F           ; routine subtract leaves result on stack.
        JR      L358C           ; forward to END-TESTS

; ---

;; STRINGS
L3559:  RRCA                    ; 2nd RRCA causes eql/neql to set carry.
        PUSH    AF              ; save A and carry.

        CALL    L2BF1           ; routine STK-FETCH gets 2nd string params
        PUSH    DE              ; save start2 *.
        PUSH    BC              ; and the length.

        CALL    L2BF1           ; 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
L3564:  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,L3575        ; forward to SEC-PLUS if second not null.

        OR      C               ; test length of first string.

;; SECND-LOW
L356B:  POP     BC              ; pop the second length off stack.
        JR      Z,L3572         ; 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      L3588           ; forward to leave via STR-TEST

; ---
; the branch was here with a match

;; BOTH-NULL
L3572:  POP     AF              ; restore carry - set for eql/neql
        JR      L3588           ; 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
L3575:  OR      C               ; test the length of first string.
        JR      Z,L3585         ; 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,L3585         ; forward to FRST-LESS if carry set

        JR      NZ,L356B        ; 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      L3564           ; back to BYTE-COMP

; ---
; the false condition.

;; FRST-LESS
L3585:  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
L3588:  PUSH    AF              ; save A and carry

        RST     28H             ;; FP-CALC
        DEFB    $A0             ;;stk-zero      an initial false value.
        DEFB    $38             ;;end-calc

; both numeric and string paths converge here.

;; END-TESTS
L358C:  POP     AF              ; pop carry  - will be set if eql/neql
        PUSH    AF              ; save it again.

        CALL    C,L3501         ; routine NOT sets true(1) if equal(0)
                                ; or, for strings, applies true result.

        POP     AF              ; pop carry and
        PUSH    AF              ; save A

        CALL    NC,L34F9        ; routine GREATER-0 tests numeric subtraction 
                                ; result but also needlessly tests the string 
                                ; value for zero - it must be.

        POP     AF              ; pop A 
        RRCA                    ; the third RRCA - test for '<=', '>=' or '<>'.
        CALL    NC,L3501        ; apply a terminal NOT if so.
        RET                     ; return.

; ------------------------------------
; THE 'STRING CONCATENATION' OPERATION
; ------------------------------------
; (offset: $17 'strs-add')
;   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
L359C:  CALL    L2BF1           ; routine STK-FETCH fetches string parameters
                                ; and deletes calculator stack entry.
        PUSH    DE              ; save start address.
        PUSH    BC              ; and length.

        CALL    L2BF1           ; 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    L2AB2           ; 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,L35B7         ; to OTHER-STR if null string

        LDIR                    ; copy string to workspace.

;; OTHER-STR
L35B7:  POP     BC              ; now second length
        POP     HL              ; and start of string
        LD      A,B             ; test this one
        OR      C               ; for zero length
        JR      Z,L35BF         ; 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.

; -----------------------------------
; THE 'SET STACK POINTERS' SUBROUTINE
; -----------------------------------
;   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 and READ-IN  routines for
;   the same reason and to initialize the calculator stack at the start of
;   the CALCULATE routine.

;; STK-PNTRS
L35BF:  LD      HL,($5C65)      ; 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 'CHR$' FUNCTION
; -------------------
; (offset: $2f 'chr$')
;   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$ 65 = "A".

;; chrs
L35C9:  CALL    L2DD5           ; routine FP-TO-A puts the number in A.

        JR      C,L35DC         ; forward to REPORT-Bd if overflow
        JR      NZ,L35DC        ; 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    L2AB2           ; routine STK-STO-$ stacks descriptor.

        EX      DE,HL           ; make HL point to result and DE to STKEND.
        RET                     ; return.

; ---

;; REPORT-Bd
L35DC:  RST     08H             ; ERROR-1
        DEFB    $0A             ; Error Report: Integer out of range

; ----------------------------
; THE 'VAL and VAL$' FUNCTIONS
; ----------------------------
; (offset: $1d 'val')
; (offset: $18 'val$')
;   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$ treats the characters in a string as a string expression.
;   e.g. VAL$ (z$+"(2)") = a$(2) if z$ happens to be "a$".

;; val
;; val$
L35DE:  LD      HL,($5C5D)      ; fetch value of system variable CH_ADD
        PUSH    HL              ; and save on the machine stack.
        LD      A,B             ; fetch the literal (either $1D or $18).
        ADD     A,$E3           ; add $E3 to form $00 (setting carry) or $FB.
        SBC     A,A             ; now form $FF bit 6 = numeric result
                                ; or $00 bit 6 = string result.
        PUSH    AF              ; save this mask on the stack

        CALL    L2BF1           ; 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      ($5C5D),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),$0D        ; insert a carriage return at end.
        RES     7,(IY+$01)      ; update FLAGS  - signal checking syntax.
        CALL    L24FB           ; routine SCANNING evaluates string
                                ; expression and result.

        RST     18H             ; GET-CHAR fetches next character.
        CP      $0D             ; is it the expected carriage return ?
        JR      NZ,L360C        ; forward to V-RPORT-C if not
                                ; 'Nonsense in BASIC'.

        POP     HL              ; restore start of string in workspace.
        POP     AF              ; restore expected result flag (bit 6).
        XOR     (IY+$01)        ; xor with FLAGS now updated by SCANNING.
        AND     $40             ; test bit 6 - should be zero if result types
                                ; match.

;; V-RPORT-C
L360C:  JP      NZ,L1C8A        ; jump back to REPORT-C with a result mismatch.

        LD      ($5C5D),HL      ; set CH_ADD to the start of the string again.
        SET     7,(IY+$01)      ; update FLAGS  - signal running program.
        CALL    L24FB           ; routine SCANNING evaluates the string
                                ; in full leaving result on calculator stack.

        POP     HL              ; restore saved character address in program.
        LD      ($5C5D),HL      ; and reset the system variable CH_ADD.

        JR      L35BF           ; 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 'STR$' FUNCTION
; -------------------
; (offset: $2e 'str$')
;   This function produces a string comprising the characters that would appear
;   if the numeric argument were printed.
;   e.g. STR$ (1/10) produces "0.1".

;; str$
L361F:  LD      BC,$0001        ; create an initial byte in workspace
        RST     30H             ; using BC-SPACES restart.

        LD      ($5C5B),HL      ; set system variable K_CUR to new location.
        PUSH    HL              ; and save start on machine stack also.

        LD      HL,($5C51)      ; fetch value of system variable CURCHL
        PUSH    HL              ; and save that too.

        LD      A,$FF           ; select system channel 'R'.
        CALL    L1601           ; routine CHAN-OPEN opens it.
        CALL    L2DE3           ; routine PRINT-FP outputs the number to
                                ; workspace updating K-CUR.

        POP     HL              ; restore current channel.
        CALL    L1615           ; routine CHAN-FLAG resets flags.

        POP     DE              ; fetch saved start of string to DE.
        LD      HL,($5C5B)      ; load HL with end of string from K_CUR.

        AND     A               ; prepare for true subtraction.
        SBC     HL,DE           ; subtract start from end to give length.
        LD      B,H             ; transfer the length to
        LD      C,L             ; the BC register pair.

        CALL    L2AB2           ; routine STK-STO-$ stores string parameters
                                ; on the calculator stack.

        EX      DE,HL           ; HL = last value, DE = STKEND.
        RET                     ; return.

; ------------------------
; THE 'READ-IN' SUBROUTINE
; ------------------------
; (offset: $1a 'read-in')
;   This is the calculator literal used by the INKEY$ function when a '#'
;   is encountered after the keyword.
;   INKEY$ # does not interact correctly with the keyboard, #0 or #1, and
;   its uses are for other channels.

;; read-in
L3645:  CALL    L1E94           ; routine FIND-INT1 fetches stream to A
        CP      $10             ; compare with 16 decimal.
        JP      NC,L1E9F        ; JUMP to REPORT-Bb if not in range 0 - 15.
                                ; 'Integer out of range'
                                ; (REPORT-Bd is within range)

        LD      HL,($5C51)      ; fetch current channel CURCHL
        PUSH    HL              ; save it

        CALL    L1601           ; routine CHAN-OPEN opens channel

        CALL    L15E6           ; routine INPUT-AD - the channel must have an
                                ; input stream or else error here from stream
                                ; stub.
        LD      BC,$0000        ; initialize length of string to zero
        JR      NC,L365F        ; forward to R-I-STORE if no key detected.

        INC     C               ; increase length to one.

        RST     30H             ; BC-SPACES creates space for one character
                                ; in workspace.
        LD      (DE),A          ; the character is inserted.

;; R-I-STORE
L365F:  CALL    L2AB2           ; routine STK-STO-$ stacks the string
                                ; parameters.
        POP     HL              ; restore current channel address

        CALL    L1615           ; routine CHAN-FLAG resets current channel
                                ; system variable and flags.

        JP      L35BF           ; jump back to STK-PNTRS

; -------------------
; THE 'CODE' FUNCTION
; -------------------
; (offset: $1c 'code')
;   Returns the ASCII code of a character or first character of a string
;   e.g. CODE "Aardvark" = 65, CODE "" = 0.

;; code
L3669:  CALL    L2BF1           ; 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,L3671         ; skip to STK-CODE with zero if the null string.

        LD      A,(DE)          ; else fetch the first character.

;; STK-CODE
L3671:  JP      L2D28           ; jump back to STACK-A (with memory check)

; ------------------
; THE 'LEN' FUNCTION
; ------------------
; (offset: $1e '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
L3674:  CALL    L2BF1           ; Routine STK-FETCH to fetch and delete the
                                ; string parameters from the calculator stack.
                                ; Register BC now holds the length of string.

        JP      L2D2B           ; Jump back to STACK-BC to save result on the
                                ; calculator stack (with memory check).

; -------------------------------------
; THE 'DECREASE THE COUNTER' SUBROUTINE
; -------------------------------------
; (offset: $35 '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
L367A:  EXX                     ; switch in set that addresses code

        PUSH    HL              ; save pointer to offset byte
        LD      HL,$5C67        ; address BREG in system variables
        DEC     (HL)            ; decrement it
        POP     HL              ; restore pointer

        JR      NZ,L3687        ; 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+$2d) - three bytes instead of six.


; ---------------------
; THE 'JUMP' SUBROUTINE
; ---------------------
; (offset: $33 'jump')
;   This enables the calculator to perform relative jumps just like the Z80 
;   chip's JR instruction.

;; jump
;; JUMP
L3686:  EXX                     ; switch in pointer set

;; JUMP-2
L3687:  LD      E,(HL)          ; the jump byte 0-127 forward, 128-255 back.
        LD      A,E             ; transfer to accumulator.
        RLA                     ; if backward jump, carry is set.
        SBC     A,A             ; will be $FF if backward or $00 if forward.
        LD      D,A             ; transfer to high byte.
        ADD     HL,DE           ; advance calculator pointer forward or back.

        EXX                     ; switch back.
        RET                     ; return.

; --------------------------
; THE 'JUMP-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.

;; jump-true
L368F:  INC     DE              ; Collect the 
        INC     DE              ; third byte
        LD      A,(DE)          ; of the test
        DEC     DE              ; result and
        DEC     DE              ; backtrack.

        AND     A               ; Is result 0 or 1 ? 
        JR      NZ,L3686        ; 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 'END-CALC' SUBROUTINE
; -------------------------
; (offset: $38 'end-calc')
;   The end-calc literal terminates a mini-program written in the Spectrum's
;   internal language.

;; end-calc
L369B:  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                     ; Switch back to main set.
        RET                     ; Return.


; ------------------------
; THE 'MODULUS' SUBROUTINE 
; ------------------------
; (offset: $32 'n-mod-m')
; (n1,n2 -- r,q)  
;   Similar to FORTH's 'divide mod' /MOD
;   On the Spectrum, this is only used internally by the RND function and could
;   have been implemented inline.  On the ZX81, this calculator routine was also
;   used by PRINT-FP.

;; n-mod-m
L36A0:  RST     28H             ;; FP-CALC          17, 3.
        DEFB    $C0             ;;st-mem-0          17, 3.
        DEFB    $02             ;;delete            17.
        DEFB    $31             ;;duplicate         17, 17.
        DEFB    $E0             ;;get-mem-0         17, 17, 3.
        DEFB    $05             ;;division          17, 17/3.
        DEFB    $27             ;;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    $38             ;;end-calc          2, 5.

        RET                     ; return.


; ------------------
; THE 'INT' FUNCTION
; ------------------
; (offset $27: '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, +-3.4 as examples.

;; int
L36AF:  RST     28H             ;; FP-CALC              x.    (= 3.4 or -3.4).
        DEFB    $31             ;;duplicate             x, x.
        DEFB    $36             ;;less-0                x, (1/0)
        DEFB    $00             ;;jump-true             x, (1/0)
        DEFB    $04             ;;to L36B7, X-NEG

        DEFB    $3A             ;;truncate              trunc 3.4 = 3.
        DEFB    $38             ;;end-calc              3.

        RET                     ; return with + int x on stack.

; ---


;; X-NEG
L36B7:  DEFB    $31             ;;duplicate             -3.4, -3.4.
        DEFB    $3A             ;;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    $30             ;;not                   -3, (0).
        DEFB    $00             ;;jump-true             -3.
        DEFB    $03             ;;to L36C2, EXIT        -3.

        DEFB    $A1             ;;stk-one               -3, 1.
        DEFB    $03             ;;subtract              -4.

;; EXIT
L36C2:  DEFB    $38             ;;end-calc              -4.

        RET                     ; return.


; ------------------
; THE 'EXP' FUNCTION
; ------------------
; (offset $26: 'exp')
;   The exponential function EXP x is equal to e^x, where e is the mathematical
;   name for a number approximated to 2.718281828.
;   ERROR 6 if argument is more than about 88.

;; EXP
;; exp
L36C4:  RST     28H             ;; FP-CALC
        DEFB    $3D             ;;re-stack      (not required - mult will do)
        DEFB    $34             ;;stk-data
        DEFB    $F1             ;;Exponent: $81, Bytes: 4
        DEFB    $38,$AA,$3B,$29 ;;
        DEFB    $04             ;;multiply
        DEFB    $31             ;;duplicate
        DEFB    $27             ;;int
        DEFB    $C3             ;;st-mem-3
        DEFB    $03             ;;subtract
        DEFB    $31             ;;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    $38             ;;end-calc

        CALL    L2DD5           ; routine FP-TO-A
        JR      NZ,L3705        ; to N-NEGTV

        JR      C,L3703         ; to REPORT-6b
                                ; 'Number too big'

        ADD     A,(HL)          ;
        JR      NC,L370C        ; to RESULT-OK


;; REPORT-6b
L3703:  RST     08H             ; ERROR-1
        DEFB    $05             ; Error Report: Number too big

; ---

;; N-NEGTV
L3705:  JR      C,L370E         ; to RSLT-ZERO

        SUB     (HL)            ;
        JR      NC,L370E        ; to RSLT-ZERO

        NEG                     ; Negate

;; RESULT-OK
L370C:  LD      (HL),A          ;
        RET                     ; return.

; ---


;; RSLT-ZERO
L370E:  RST     28H             ;; FP-CALC
        DEFB    $02             ;;delete
        DEFB    $A0             ;;stk-zero
        DEFB    $38             ;;end-calc

        RET                     ; return.


; --------------------------------
; THE 'NATURAL LOGARITHM' FUNCTION 
; --------------------------------
; (offset $25: 'ln')
;   Function to calculate the natural logarithm (to the base e ). 
;   Natural logarithms 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 machines
;   like the ZX Spectrum 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.
;   Error A if the argument is 0 or negative.

;; ln
L3713:  RST     28H             ;; FP-CALC
        DEFB    $3D             ;;re-stack
        DEFB    $31             ;;duplicate
        DEFB    $37             ;;greater-0
        DEFB    $00             ;;jump-true
        DEFB    $04             ;;to L371C, VALID

        DEFB    $38             ;;end-calc


;; REPORT-Ab
L371A:  RST     08H             ; ERROR-1
        DEFB    $09             ; Error Report: Invalid argument

;; VALID
L371C:  DEFB    $A0             ;;stk-zero              Note. not 
        DEFB    $02             ;;delete                necessary.
        DEFB    $38             ;;end-calc
        LD      A,(HL)          ;

        LD      (HL),$80        ;
        CALL    L2D28           ; routine STACK-A

        RST     28H             ;; FP-CALC
        DEFB    $34             ;;stk-data
        DEFB    $38             ;;Exponent: $88, Bytes: 1
        DEFB    $00             ;;(+00,+00,+00)
        DEFB    $03             ;;subtract
        DEFB    $01             ;;exchange
        DEFB    $31             ;;duplicate
        DEFB    $34             ;;stk-data
        DEFB    $F0             ;;Exponent: $80, Bytes: 4
        DEFB    $4C,$CC,$CC,$CD ;;
        DEFB    $03             ;;subtract
        DEFB    $37             ;;greater-0
        DEFB    $00             ;;jump-true
        DEFB    $08             ;;to L373D, GRE.8

        DEFB    $01             ;;exchange
        DEFB    $A1             ;;stk-one
        DEFB    $03             ;;subtract
        DEFB    $01             ;;exchange
        DEFB    $38             ;;end-calc

        INC     (HL)            ;

        RST     28H             ;; FP-CALC

;; GRE.8
L373D:  DEFB    $01             ;;exchange
        DEFB    $34             ;;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    $31             ;;duplicate
        DEFB    $34             ;;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    $38             ;;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 $39: '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
L3783:  RST     28H             ;; FP-CALC      X.
        DEFB    $3D             ;;re-stack      (not rquired done by mult)
        DEFB    $34             ;;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    $31             ;;duplicate
        DEFB    $A2             ;;stk-half
        DEFB    $0F             ;;addition
        DEFB    $27             ;;int

        DEFB    $03             ;;subtract      now range -.5 to .5

        DEFB    $31             ;;duplicate
        DEFB    $0F             ;;addition      now range -1 to 1.
        DEFB    $31             ;;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    $31             ;;duplicate     Y, Y.
        DEFB    $2A             ;;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    $31             ;;duplicate     Y, Z, Z.
        DEFB    $37             ;;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 L37A1, 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 the test value.
        DEFB    $38             ;;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
L37A1:  DEFB    $A1             ;;stk-one         Y, Z, 1.
        DEFB    $03             ;;subtract        Y, Z-1.       Q3 = 0 to -1
        DEFB    $01             ;;exchange        Z-1, Y.
        DEFB    $36             ;;less-0          Z-1, (1/0).
        DEFB    $00             ;;jump-true       Z-1.
        DEFB    $02             ;;to L37A8, YNEG
                                ;;if angle in quadrant III

; else angle is within quadrant II (-1 to 0)

        DEFB    $1B             ;;negate          range +1 to 0.

;; YNEG
L37A8:  DEFB    $38             ;;end-calc        quadrants II and III correct.

        RET                     ; return.


; ---------------------
; THE 'COSINE' FUNCTION
; ---------------------
; (offset $20: '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
L37AA:  RST     28H             ;; FP-CALC              angle in radians.
        DEFB    $39             ;;get-argt              X     reduce -1 to +1 

        DEFB    $2A             ;;abs                   ABS X.   0 to 1
        DEFB    $A1             ;;stk-one               ABS X, 1.
        DEFB    $03             ;;subtract              now opposite angle
                                ;;                      although sign is -ve.

        DEFB    $E0             ;;get-mem-0             fetch the sign indicator
        DEFB    $00             ;;jump-true
        DEFB    $06             ;;fwd to L37B7, C-ENT
                                ;;forward to common code if in QII or QIII.

        DEFB    $1B             ;;negate                else make sign +ve.
        DEFB    $33             ;;jump
        DEFB    $03             ;;fwd to L37B7, C-ENT
                                ;; with quadrants I and IV.

; -------------------
; THE 'SINE' FUNCTION
; -------------------
; (offset $1F: '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
L37B5:  RST     28H             ;; FP-CALC      angle in radians
        DEFB    $39             ;;get-argt      reduce - sign now correct.

;; C-ENT
L37B7:  DEFB    $31             ;;duplicate
        DEFB    $31             ;;duplicate
        DEFB    $04             ;;multiply
        DEFB    $31             ;;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    $38             ;;end-calc

        RET                     ; return.

; ----------------------
; THE 'TANGENT' FUNCTION
; ----------------------
; (offset $21: '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
L37DA:  RST     28H             ;; FP-CALC          x.
        DEFB    $31             ;;duplicate         x, x.
        DEFB    $1F             ;;sin               x, sin x.
        DEFB    $01             ;;exchange          sin x, x.
        DEFB    $20             ;;cos               sin x, cos x.
        DEFB    $05             ;;division          sin x/cos x (= tan x).
        DEFB    $38             ;;end-calc          tan x.

        RET                     ; return.

; ---------------------
; THE 'ARCTAN' FUNCTION
; ---------------------
; (Offset $24: '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
L37E2:  CALL    L3297           ; routine re-stack
        LD      A,(HL)          ; fetch exponent byte.
        CP      $81             ; compare to that for 'one'
        JR      C,L37F8         ; forward, if less, to SMALL

        RST     28H             ;; FP-CALC
        DEFB    $A1             ;;stk-one
        DEFB    $1B             ;;negate
        DEFB    $01             ;;exchange
        DEFB    $05             ;;division
        DEFB    $31             ;;duplicate
        DEFB    $36             ;;less-0
        DEFB    $A3             ;;stk-pi/2
        DEFB    $01             ;;exchange
        DEFB    $00             ;;jump-true
        DEFB    $06             ;;to L37FA, CASES

        DEFB    $1B             ;;negate
        DEFB    $33             ;;jump
        DEFB    $03             ;;to L37FA, CASES

;; SMALL
L37F8:  RST     28H             ;; FP-CALC
        DEFB    $A0             ;;stk-zero

;; CASES
L37FA:  DEFB    $01             ;;exchange
        DEFB    $31             ;;duplicate
        DEFB    $31             ;;duplicate
        DEFB    $04             ;;multiply
        DEFB    $31             ;;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    $38             ;;end-calc

        RET                     ; return.


; ---------------------
; THE 'ARCSIN' FUNCTION
; ---------------------
; (Offset $22: '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
;
;   GEOMETRIC PROOF.
;
;
;               . /|
;            .  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+c = 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
L3833:  RST     28H             ;; FP-CALC      x.
        DEFB    $31             ;;duplicate     x, x.
        DEFB    $31             ;;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    $1B             ;;negate        x, 1-x*x.
        DEFB    $28             ;;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    $24             ;;atn           a/2       (half the angle)
        DEFB    $31             ;;duplicate     a/2, a/2.
        DEFB    $0F             ;;addition      a.
        DEFB    $38             ;;end-calc      a.

        RET                     ; return.


; ---------------------
; THE 'ARCCOS' FUNCTION
; ---------------------
; (Offset $23: '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
L3843:  RST     28H             ;; FP-CALC      x.
        DEFB    $22             ;;asn           asn(x).
        DEFB    $A3             ;;stk-pi/2      asn(x), pi/2.
        DEFB    $03             ;;subtract      asn(x) - pi/2.
        DEFB    $1B             ;;negate        pi/2 -asn(x)  =  acs(x).
        DEFB    $38             ;;end-calc      acs(x).

        RET                     ; return.


; --------------------------
; THE 'SQUARE ROOT' FUNCTION
; --------------------------
; (Offset $28: 'sqr')
; This routine is remarkable for its brevity - 7 bytes.
; It wasn't written here but in the ZX81 where the programmers had to squeeze
; a bulky operating system into an 8K ROM. It simply calculates 
; the square root by stacking the value .5 and continuing into the 'to-power'
; routine. With more space available the much faster Newton-Raphson method
; could have been used as on the Jupiter Ace.

;; sqr
L384A:  RST     28H             ;; FP-CALC
        DEFB    $31             ;;duplicate
        DEFB    $30             ;;not
        DEFB    $00             ;;jump-true
        DEFB    $1E             ;;to L386C, LAST

        DEFB    $A2             ;;stk-half
        DEFB    $38             ;;end-calc


; ------------------------------
; 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
L3851:  RST     28H             ;; FP-CALC              X, Y.
        DEFB    $01             ;;exchange              Y, X.
        DEFB    $31             ;;duplicate             Y, X, X.
        DEFB    $30             ;;not                   Y, X, (1/0).
        DEFB    $00             ;;jump-true
        DEFB    $07             ;;to L385D, XIS0   if X is zero.

;   else X is non-zero. Function 'ln' will catch a negative value of X.

        DEFB    $25             ;;ln                    Y, LN X.
        DEFB    $04             ;;multiply              Y * LN X.
        DEFB    $38             ;;end-calc

        JP      L36C4           ; 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.

;; XIS0
L385D:  DEFB    $02             ;;delete                Y.
        DEFB    $31             ;;duplicate             Y, Y.
        DEFB    $30             ;;not                   Y, (1/0).
        DEFB    $00             ;;jump-true
        DEFB    $09             ;;to L386A, ONE         if Y is zero.

        DEFB    $A0             ;;stk-zero              Y, 0.
        DEFB    $01             ;;exchange              0, Y.
        DEFB    $37             ;;greater-0             0, (1/0).
        DEFB    $00             ;;jump-true             0.
        DEFB    $06             ;;to L386C, 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        ouch!

; ---

;; ONE
L386A:  DEFB    $02             ;;delete                .
        DEFB    $A1             ;;stk-one               1.

;; LAST
L386C:  DEFB    $38             ;;end-calc              last value is 1 or 0.

        RET                     ; return.               

;   "Everything should be made as simple as possible, but not simpler"
;   - Albert Einstein, 1879-1955.

ultra   push    ix              ; 133 bytes
        pop     hl              ; pongo la direccion de comienzo en hl
        exx                     ; salvo de, en caso de volver al cargador estandar y para hacer luego el checksum
        ld      e, 0
        ld      c, e
ultr0   defb    $2a
ultr1   jr      nz, ultr3       ; return if at any time space is pressed.
ultr2   ld      b, e
        call    L05ED           ; leo la duracion de un pulso (positivo o negativo)
        jr      nc, ultr1       ; si el pulso es muy largo retorno a bucle
        ld      a, b
        cp      40              ; si el contador esta entre 24 y 40
        jr      nc, ultr4       ; y se reciben 8 pulsos (me falta inicializar hl a 00ff)
        cp      24
        rl      l
        jr      nz, ultr4
ultr3   exx
        ld      c, 2
        ret
ultr4   add     a, -16          ; si el contador esta entre 10 y 16 es el tono guia
        rr      h               ; de las ultracargas, si los ultimos 8 pulsos
        add     a, 6            ; son de tono guia h debe valer ff
        jr      c, ultr2
        ld      l, h
        dec     h
        jr      nz, ultr0       ; si detecto sincronismo sin 8 pulsos de tono guia retorno a bucle
        ld      ix, ramab1
        call    L05ED           ; leo pulso negativo de sincronismo
ultra5  ld      b, e            ; 16 bytes
        call    L05ED           ; esta rutina lee 2 pulsos e inicializa el contador de pulsos
        call    L05ED
        ld      a, b
        cp      12
        adc     hl, hl
        jr      nc, ultra5
        pop     af              ; machaco la direccion de retorno de la carga estandar
        ex      af, af'         ; a es el byte flag que espero
        cp      l               ; lo comparo con el que me encuentro en la ultracarga
        ret     nz              ; salgo si no coinciden
        xor     h               ; xoreo el checksum con en byte flag, resultado en a
        exx
        ld      c, a            ; guardo checksum en c'
        push    hl              ; pongo direccion de comienzo en pila
        exx
        pop     de              ; recupero en de la direccion de comienzo del bloque
        dec     de
        ld      a, $d8          ; a' tiene que valer esto para entrar en raudo
        ex      af, af'
        ld      h, table>>8
        call    $05ed
        inc     c               ; pongo en flag z el signo del pulso
        ld      bc, $effe       ; este valor es el que necesita b para entrar en raudo
        call    nz, lee2
        jp      nz, ramab2
        ld      ixl, ramaa1 & 255
        call    lee1
        jr      ramaa2          ; salto a raudo segun el signo del pulso en flag z

        block   $3901-$, $ff

table   defb    $ec     ; 01
        jp      0       
        defb    $ec     ; 05*
        jp      0       
        defb    $ec     ; 09*
        jp      0       
        defb    $ec     ; 0d
        jp      0       
        defb    $ed     ; 11
        jp      0       
        defb    $ed     ; 15*
        jp      0       
        defb    $ed     ; 19*
        jp      0       
        defb    $ee     ; 1d
        jp      0       
        defb    $ee     ; 21*
        jp      0       
        defb    $ee     ; 25*
        jp      0       
        defb    $ef     ; 29
        jp      0       
        defb    $ef     ; 2d*
        jp      0       
        defb    $ef     ; 31*
        jp      0       
        defb    $ef     ; 35 

ramaa   nop                     ;4
        out     (c), b          ;12
        dec     hl              ;6
        xor     b               ;4
        add     a, a            ;4
        add     a, a            ;4
        call    lee1            ;17
ramaa1  ex      af, af'         ;7+4      64
        ld      a, r            ;9
        ld      l, a            ;4
        ld      b, (hl)         ;7
ramaa2  ld      a, consta       ;7
        ld      r, a            ;9
        call    lee2            ;17
        ex      af, af'         ;7+4      72/72
        jp      nc, ramaa       ;10
        xor     b               ;4
        xor     $9c             ;7
        inc     de              ;6
        ld      (de), a         ;7
        ld      a, $dc          ;7
        push    ix              ;15
        ret     c               ;5
lee1    defb    $ed, $70, $e0
        .9      defb    $6e, $ed, $70, $e0
        jr      ultra6

ramab   nop                     ;4
        out     (c), b          ;12
        dec     hl              ;6
        xor     b               ;4
        add     a, a            ;4
        add     a, a            ;4
        call    lee2            ;17
ramab1  ex      af, af'         ;7+4      64
        ld      a, r            ;9
        ld      l, a            ;4
        ld      b, (hl)         ;7
ramab2  ld      a, consta       ;7
        ld      r, a            ;9
        call    lee1            ;17
        ex      af, af'         ;7+4      72/72
        jp      nc, ramab       ;10
        xor     b               ;4
        xor     $9c             ;7
        inc     de              ;6
        ld      (de), a         ;7
        ld      a, $dc          ;7
        push    ix              ;15
        ret     c               ;5
lee2    defb    $ed, $70, $e8
        .9      defb    $6e, $ed, $70, $e8

ultra6  pop     hl
        exx                     ; ya se ha acabado la ultracarga (raudo)
        ld      b, e
        dec     de
        inc     d
ultra7  xor     (hl)
        inc     hl
        djnz    ultra7
        dec     d
        jr      nz, ultra7      ; con JP ahorro algunos ciclos
        push    hl              ; ha ido bien
        xor     c
        ld      h, b
        ld      l, c
        ld      d, b
        ld      e, b
        pop     ix              ; ix debe apuntar al siguiente byte despues del bloque
        ret     nz              ; si no coincide el checksum salgo con carry desactivado
        scf
        ret

; ---------------------
; THE 'SPARE' LOCATIONS
; ---------------------

;; spare
        block   $3d00-$, $ff

; -------------------------------
; THE 'ZX SPECTRUM CHARACTER SET'
; -------------------------------

;; char-set

; $20 - Character: ' '          CHR$(32)

L3D00:  DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000

; $21 - Character: '!'          CHR$(33)

        DEFB    %00000000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00000000
        DEFB    %00010000
        DEFB    %00000000

; $22 - Character: '"'          CHR$(34)

        DEFB    %00000000
        DEFB    %00100100
        DEFB    %00100100
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000

; $23 - Character: '#'          CHR$(35)

        DEFB    %00000000
        DEFB    %00100100
        DEFB    %01111110
        DEFB    %00100100
        DEFB    %00100100
        DEFB    %01111110
        DEFB    %00100100
        DEFB    %00000000

; $24 - Character: '$'          CHR$(36)

        DEFB    %00000000
        DEFB    %00001000
        DEFB    %00111110
        DEFB    %00101000
        DEFB    %00111110
        DEFB    %00001010
        DEFB    %00111110
        DEFB    %00001000

; $25 - Character: '%'          CHR$(37)

        DEFB    %00000000
        DEFB    %01100010
        DEFB    %01100100
        DEFB    %00001000
        DEFB    %00010000
        DEFB    %00100110
        DEFB    %01000110
        DEFB    %00000000

; $26 - Character: '&'          CHR$(38)

        DEFB    %00000000
        DEFB    %00010000
        DEFB    %00101000
        DEFB    %00010000
        DEFB    %00101010
        DEFB    %01000100
        DEFB    %00111010
        DEFB    %00000000

; $27 - Character: '''          CHR$(39)

        DEFB    %00000000
        DEFB    %00001000
        DEFB    %00010000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000

; $28 - Character: '('          CHR$(40)

        DEFB    %00000000
        DEFB    %00000100
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00000100
        DEFB    %00000000

; $29 - Character: ')'          CHR$(41)

        DEFB    %00000000
        DEFB    %00100000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00100000
        DEFB    %00000000

; $2A - Character: '*'          CHR$(42)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00010100
        DEFB    %00001000
        DEFB    %00111110
        DEFB    %00001000
        DEFB    %00010100
        DEFB    %00000000

; $2B - Character: '+'          CHR$(43)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00111110
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00000000

; $2C - Character: ','          CHR$(44)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00010000

; $2D - Character: '-'          CHR$(45)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00111110
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000

; $2E - Character: '.'          CHR$(46)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00011000
        DEFB    %00011000
        DEFB    %00000000

; $2F - Character: '/'          CHR$(47)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000010
        DEFB    %00000100
        DEFB    %00001000
        DEFB    %00010000
        DEFB    %00100000
        DEFB    %00000000

; $30 - Character: '0'          CHR$(48)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000110
        DEFB    %01001010
        DEFB    %01010010
        DEFB    %01100010
        DEFB    %00111100
        DEFB    %00000000

; $31 - Character: '1'          CHR$(49)

        DEFB    %00000000
        DEFB    %00011000
        DEFB    %00101000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00111110
        DEFB    %00000000

; $32 - Character: '2'          CHR$(50)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000010
        DEFB    %00000010
        DEFB    %00111100
        DEFB    %01000000
        DEFB    %01111110
        DEFB    %00000000

; $33 - Character: '3'          CHR$(51)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000010
        DEFB    %00001100
        DEFB    %00000010
        DEFB    %01000010
        DEFB    %00111100
        DEFB    %00000000

; $34 - Character: '4'          CHR$(52)

        DEFB    %00000000
        DEFB    %00001000
        DEFB    %00011000
        DEFB    %00101000
        DEFB    %01001000
        DEFB    %01111110
        DEFB    %00001000
        DEFB    %00000000

; $35 - Character: '5'          CHR$(53)

        DEFB    %00000000
        DEFB    %01111110
        DEFB    %01000000
        DEFB    %01111100
        DEFB    %00000010
        DEFB    %01000010
        DEFB    %00111100
        DEFB    %00000000

; $36 - Character: '6'          CHR$(54)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000000
        DEFB    %01111100
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %00111100
        DEFB    %00000000

; $37 - Character: '7'          CHR$(55)

        DEFB    %00000000
        DEFB    %01111110
        DEFB    %00000010
        DEFB    %00000100
        DEFB    %00001000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00000000

; $38 - Character: '8'          CHR$(56)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000010
        DEFB    %00111100
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %00111100
        DEFB    %00000000

; $39 - Character: '9'          CHR$(57)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %00111110
        DEFB    %00000010
        DEFB    %00111100
        DEFB    %00000000

; $3A - Character: ':'          CHR$(58)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00010000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00010000
        DEFB    %00000000

; $3B - Character: ';'          CHR$(59)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00010000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00100000

; $3C - Character: '<'          CHR$(60)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000100
        DEFB    %00001000
        DEFB    %00010000
        DEFB    %00001000
        DEFB    %00000100
        DEFB    %00000000

; $3D - Character: '='          CHR$(61)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00111110
        DEFB    %00000000
        DEFB    %00111110
        DEFB    %00000000
        DEFB    %00000000

; $3E - Character: '>'          CHR$(62)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00010000
        DEFB    %00001000
        DEFB    %00000100
        DEFB    %00001000
        DEFB    %00010000
        DEFB    %00000000

; $3F - Character: '?'          CHR$(63)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000010
        DEFB    %00000100
        DEFB    %00001000
        DEFB    %00000000
        DEFB    %00001000
        DEFB    %00000000

; $40 - Character: '@'          CHR$(64)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01001010
        DEFB    %01010110
        DEFB    %01011110
        DEFB    %01000000
        DEFB    %00111100
        DEFB    %00000000

; $41 - Character: 'A'          CHR$(65)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01111110
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %00000000

; $42 - Character: 'B'          CHR$(66)

        DEFB    %00000000
        DEFB    %01111100
        DEFB    %01000010
        DEFB    %01111100
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01111100
        DEFB    %00000000

; $43 - Character: 'C'          CHR$(67)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000010
        DEFB    %01000000
        DEFB    %01000000
        DEFB    %01000010
        DEFB    %00111100
        DEFB    %00000000

; $44 - Character: 'D'          CHR$(68)

        DEFB    %00000000
        DEFB    %01111000
        DEFB    %01000100
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01000100
        DEFB    %01111000
        DEFB    %00000000

; $45 - Character: 'E'          CHR$(69)

        DEFB    %00000000
        DEFB    %01111110
        DEFB    %01000000
        DEFB    %01111100
        DEFB    %01000000
        DEFB    %01000000
        DEFB    %01111110
        DEFB    %00000000

; $46 - Character: 'F'          CHR$(70)

        DEFB    %00000000
        DEFB    %01111110
        DEFB    %01000000
        DEFB    %01111100
        DEFB    %01000000
        DEFB    %01000000
        DEFB    %01000000
        DEFB    %00000000

; $47 - Character: 'G'          CHR$(71)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000010
        DEFB    %01000000
        DEFB    %01001110
        DEFB    %01000010
        DEFB    %00111100
        DEFB    %00000000

; $48 - Character: 'H'          CHR$(72)

        DEFB    %00000000
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01111110
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %00000000

; $49 - Character: 'I'          CHR$(73)

        DEFB    %00000000
        DEFB    %00111110
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00111110
        DEFB    %00000000

; $4A - Character: 'J'          CHR$(74)

        DEFB    %00000000
        DEFB    %00000010
        DEFB    %00000010
        DEFB    %00000010
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %00111100
        DEFB    %00000000

; $4B - Character: 'K'          CHR$(75)

        DEFB    %00000000
        DEFB    %01000100
        DEFB    %01001000
        DEFB    %01110000
        DEFB    %01001000
        DEFB    %01000100
        DEFB    %01000010
        DEFB    %00000000

; $4C - Character: 'L'          CHR$(76)

        DEFB    %00000000
        DEFB    %01000000
        DEFB    %01000000
        DEFB    %01000000
        DEFB    %01000000
        DEFB    %01000000
        DEFB    %01111110
        DEFB    %00000000

; $4D - Character: 'M'          CHR$(77)

        DEFB    %00000000
        DEFB    %01000010
        DEFB    %01100110
        DEFB    %01011010
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %00000000

; $4E - Character: 'N'          CHR$(78)

        DEFB    %00000000
        DEFB    %01000010
        DEFB    %01100010
        DEFB    %01010010
        DEFB    %01001010
        DEFB    %01000110
        DEFB    %01000010
        DEFB    %00000000

; $4F - Character: 'O'          CHR$(79)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %00111100
        DEFB    %00000000

; $50 - Character: 'P'          CHR$(80)

        DEFB    %00000000
        DEFB    %01111100
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01111100
        DEFB    %01000000
        DEFB    %01000000
        DEFB    %00000000

; $51 - Character: 'Q'          CHR$(81)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01010010
        DEFB    %01001010
        DEFB    %00111100
        DEFB    %00000000

; $52 - Character: 'R'          CHR$(82)

        DEFB    %00000000
        DEFB    %01111100
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01111100
        DEFB    %01000100
        DEFB    %01000010
        DEFB    %00000000

; $53 - Character: 'S'          CHR$(83)

        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000000
        DEFB    %00111100
        DEFB    %00000010
        DEFB    %01000010
        DEFB    %00111100
        DEFB    %00000000

; $54 - Character: 'T'          CHR$(84)

        DEFB    %00000000
        DEFB    %11111110
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00000000

; $55 - Character: 'U'          CHR$(85)

        DEFB    %00000000
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %00111100
        DEFB    %00000000

; $56 - Character: 'V'          CHR$(86)

        DEFB    %00000000
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %00100100
        DEFB    %00011000
        DEFB    %00000000

; $57 - Character: 'W'          CHR$(87)

        DEFB    %00000000
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01000010
        DEFB    %01011010
        DEFB    %00100100
        DEFB    %00000000

; $58 - Character: 'X'          CHR$(88)

        DEFB    %00000000
        DEFB    %01000010
        DEFB    %00100100
        DEFB    %00011000
        DEFB    %00011000
        DEFB    %00100100
        DEFB    %01000010
        DEFB    %00000000

; $59 - Character: 'Y'          CHR$(89)

        DEFB    %00000000
        DEFB    %10000010
        DEFB    %01000100
        DEFB    %00101000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00000000

; $5A - Character: 'Z'          CHR$(90)

        DEFB    %00000000
        DEFB    %01111110
        DEFB    %00000100
        DEFB    %00001000
        DEFB    %00010000
        DEFB    %00100000
        DEFB    %01111110
        DEFB    %00000000

; $5B - Character: '['          CHR$(91)

        DEFB    %00000000
        DEFB    %00001110
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00001110
        DEFB    %00000000

; $5C - Character: '\'          CHR$(92)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %01000000
        DEFB    %00100000
        DEFB    %00010000
        DEFB    %00001000
        DEFB    %00000100
        DEFB    %00000000

; $5D - Character: ']'          CHR$(93)

        DEFB    %00000000
        DEFB    %01110000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %01110000
        DEFB    %00000000

; $5E - Character: '^'          CHR$(94)

        DEFB    %00000000
        DEFB    %00010000
        DEFB    %00111000
        DEFB    %01010100
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00000000

; $5F - Character: '_'          CHR$(95)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %11111111

; $60 - Character: ' £ '        CHR$(96)

        DEFB    %00000000
        DEFB    %00011100
        DEFB    %00100010
        DEFB    %01111000
        DEFB    %00100000
        DEFB    %00100000
        DEFB    %01111110
        DEFB    %00000000

; $61 - Character: 'a'          CHR$(97)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00111000
        DEFB    %00000100
        DEFB    %00111100
        DEFB    %01000100
        DEFB    %00111100
        DEFB    %00000000

; $62 - Character: 'b'          CHR$(98)

        DEFB    %00000000
        DEFB    %00100000
        DEFB    %00100000
        DEFB    %00111100
        DEFB    %00100010
        DEFB    %00100010
        DEFB    %00111100
        DEFB    %00000000

; $63 - Character: 'c'          CHR$(99)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00011100
        DEFB    %00100000
        DEFB    %00100000
        DEFB    %00100000
        DEFB    %00011100
        DEFB    %00000000

; $64 - Character: 'd'          CHR$(100)

        DEFB    %00000000
        DEFB    %00000100
        DEFB    %00000100
        DEFB    %00111100
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %00111100
        DEFB    %00000000

; $65 - Character: 'e'          CHR$(101)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00111000
        DEFB    %01000100
        DEFB    %01111000
        DEFB    %01000000
        DEFB    %00111100
        DEFB    %00000000

; $66 - Character: 'f'          CHR$(102)

        DEFB    %00000000
        DEFB    %00001100
        DEFB    %00010000
        DEFB    %00011000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00000000

; $67 - Character: 'g'          CHR$(103)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %00111100
        DEFB    %00000100
        DEFB    %00111000

; $68 - Character: 'h'          CHR$(104)

        DEFB    %00000000
        DEFB    %01000000
        DEFB    %01000000
        DEFB    %01111000
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %00000000

; $69 - Character: 'i'          CHR$(105)

        DEFB    %00000000
        DEFB    %00010000
        DEFB    %00000000
        DEFB    %00110000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00111000
        DEFB    %00000000

; $6A - Character: 'j'          CHR$(106)

        DEFB    %00000000
        DEFB    %00000100
        DEFB    %00000000
        DEFB    %00000100
        DEFB    %00000100
        DEFB    %00000100
        DEFB    %00100100
        DEFB    %00011000

; $6B - Character: 'k'          CHR$(107)

        DEFB    %00000000
        DEFB    %00100000
        DEFB    %00101000
        DEFB    %00110000
        DEFB    %00110000
        DEFB    %00101000
        DEFB    %00100100
        DEFB    %00000000

; $6C - Character: 'l'          CHR$(108)

        DEFB    %00000000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00001100
        DEFB    %00000000

; $6D - Character: 'm'          CHR$(109)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %01101000
        DEFB    %01010100
        DEFB    %01010100
        DEFB    %01010100
        DEFB    %01010100
        DEFB    %00000000

; $6E - Character: 'n'          CHR$(110)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %01111000
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %00000000

; $6F - Character: 'o'          CHR$(111)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00111000
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %00111000
        DEFB    %00000000

; $70 - Character: 'p'          CHR$(112)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %01111000
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %01111000
        DEFB    %01000000
        DEFB    %01000000

; $71 - Character: 'q'          CHR$(113)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00111100
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %00111100
        DEFB    %00000100
        DEFB    %00000110

; $72 - Character: 'r'          CHR$(114)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00011100
        DEFB    %00100000
        DEFB    %00100000
        DEFB    %00100000
        DEFB    %00100000
        DEFB    %00000000

; $73 - Character: 's'          CHR$(115)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00111000
        DEFB    %01000000
        DEFB    %00111000
        DEFB    %00000100
        DEFB    %01111000
        DEFB    %00000000

; $74 - Character: 't'          CHR$(116)

        DEFB    %00000000
        DEFB    %00010000
        DEFB    %00111000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %00001100
        DEFB    %00000000

; $75 - Character: 'u'          CHR$(117)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %00111000
        DEFB    %00000000

; $76 - Character: 'v'          CHR$(118)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %00101000
        DEFB    %00101000
        DEFB    %00010000
        DEFB    %00000000

; $77 - Character: 'w'          CHR$(119)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %01000100
        DEFB    %01010100
        DEFB    %01010100
        DEFB    %01010100
        DEFB    %00101000
        DEFB    %00000000

; $78 - Character: 'x'          CHR$(120)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %01000100
        DEFB    %00101000
        DEFB    %00010000
        DEFB    %00101000
        DEFB    %01000100
        DEFB    %00000000

; $79 - Character: 'y'          CHR$(121)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %01000100
        DEFB    %00111100
        DEFB    %00000100
        DEFB    %00111000

; $7A - Character: 'z'          CHR$(122)

        DEFB    %00000000
        DEFB    %00000000
        DEFB    %01111100
        DEFB    %00001000
        DEFB    %00010000
        DEFB    %00100000
        DEFB    %01111100
        DEFB    %00000000

; $7B - Character: '{'          CHR$(123)

        DEFB    %00000000
        DEFB    %00001110
        DEFB    %00001000
        DEFB    %00110000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00001110
        DEFB    %00000000

; $7C - Character: '|'          CHR$(124)

        DEFB    %00000000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00001000
        DEFB    %00000000

; $7D - Character: '}'          CHR$(125)

        DEFB    %00000000
        DEFB    %01110000
        DEFB    %00010000
        DEFB    %00001100
        DEFB    %00010000
        DEFB    %00010000
        DEFB    %01110000
        DEFB    %00000000

; $7E - Character: '~'          CHR$(126)

        DEFB    %00000000
        DEFB    %00010100
        DEFB    %00101000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000
        DEFB    %00000000

; $7F - Character: ' © '        CHR$(127)

        DEFB    %00111100
        DEFB    %01000010
        DEFB    %10011001
        DEFB    %10100001
        DEFB    %10100001
        DEFB    %10011001
        DEFB    %01000010
        DEFB    %00111100

; Acknowledgements
; -----------------
; Sean Irvine               for default list of section headings
; Dr. Ian Logan             for labels and functional disassembly.
; Dr. Frank O'Hara          for labels and functional disassembly.
;
; Credits
; -------
; Alex Pallero Gonzales     for corrections.
; Mike Dailly               for comments.
; Alvin Albrecht            for comments.
; Andy Styles               for full relocatability implementation and testing.                    testing.
; Andrew Owen               for ZASM compatibility and format improvements.
; Francisco Villa           for CgLeches main ultraloader code.
; Antonio Villena           for CgLeches rest of code.