zx81-rom

ZX81 rom source mirror
git clone http://frotz.net/git/zx81-rom.git
Log | Files | Refs

zx81.txt (362497B)


      1 ; ===========================================================
      2 ; An Assembly Listing of the Operating System of the ZX81 ROM
      3 ; ===========================================================
      4 ; -------------------------
      5 ; Last updated: 13-DEC-2004
      6 ; -------------------------
      7 ;
      8 ; Work in progress.
      9 ; This file will cross-assemble an original version of the "Improved"
     10 ; ZX81 ROM.  The file can be modified to change the behaviour of the ROM
     11 ; when used in emulators although there is no spare space available.
     12 ;
     13 ; The documentation is incomplete and if you can find a copy
     14 ; of "The Complete Spectrum ROM Disassembly" then many routines
     15 ; such as POINTERS and most of the mathematical routines are
     16 ; similar and often identical.
     17 ;
     18 ; I've used the labels from the above book in this file and also
     19 ; some from the more elusive Complete ZX81 ROM Disassembly
     20 ; by the same publishers, Melbourne House.
     21 
     22 
     23 #define DEFB .BYTE      ; TASM cross-assembler definitions
     24 #define DEFW .WORD
     25 #define EQU  .EQU
     26 
     27 
     28 ;*****************************************
     29 ;** Part 1. RESTART ROUTINES AND TABLES **
     30 ;*****************************************
     31 
     32 ; -----------
     33 ; THE 'START'
     34 ; -----------
     35 ; All Z80 chips start at location zero.
     36 ; At start-up the Interrupt Mode is 0, ZX computers use Interrupt Mode 1.
     37 ; Interrupts are disabled .
     38 
     39 ;; START
     40 L0000:  OUT     ($FD),A         ; Turn off the NMI generator if this ROM is 
     41                                 ; running in ZX81 hardware. This does nothing 
     42                                 ; if this ROM is running within an upgraded
     43                                 ; ZX80.
     44         LD      BC,$7FFF        ; Set BC to the top of possible RAM.
     45                                 ; The higher unpopulated addresses are used for
     46                                 ; video generation.
     47         JP      L03CB           ; Jump forward to RAM-CHECK.
     48 
     49 ; -------------------
     50 ; THE 'ERROR' RESTART
     51 ; -------------------
     52 ; The error restart deals immediately with an error. ZX computers execute the 
     53 ; same code in runtime as when checking syntax. If the error occurred while 
     54 ; running a program then a brief report is produced. If the error occurred
     55 ; while entering a BASIC line or in input etc., then the error marker indicates
     56 ; the exact point at which the error lies.
     57 
     58 ;; ERROR-1
     59 L0008:  LD      HL,($4016)      ; fetch character address from CH_ADD.
     60         LD      ($4018),HL      ; and set the error pointer X_PTR.
     61         JR      L0056           ; forward to continue at ERROR-2.
     62 
     63 ; -------------------------------
     64 ; THE 'PRINT A CHARACTER' RESTART
     65 ; -------------------------------
     66 ; This restart prints the character in the accumulator using the alternate
     67 ; register set so there is no requirement to save the main registers.
     68 ; There is sufficient room available to separate a space (zero) from other
     69 ; characters as leading spaces need not be considered with a space.
     70 
     71 ;; PRINT-A
     72 L0010:  AND     A               ; test for zero - space.
     73         JP      NZ,L07F1        ; jump forward if not to PRINT-CH.
     74 
     75         JP      L07F5           ; jump forward to PRINT-SP.
     76 
     77 ; ---
     78 
     79         DEFB    $FF             ; unused location.
     80 
     81 ; ---------------------------------
     82 ; THE 'COLLECT A CHARACTER' RESTART
     83 ; ---------------------------------
     84 ; The character addressed by the system variable CH_ADD is fetched and if it
     85 ; is a non-space, non-cursor character it is returned else CH_ADD is 
     86 ; incremented and the new addressed character tested until it is not a space.
     87 
     88 ;; GET-CHAR
     89 L0018:  LD      HL,($4016)      ; set HL to character address CH_ADD.
     90         LD      A,(HL)          ; fetch addressed character to A.
     91 
     92 ;; TEST-SP
     93 L001C:  AND     A               ; test for space.
     94         RET     NZ              ; return if not a space
     95 
     96         NOP                     ; else trickle through
     97         NOP                     ; to the next routine.
     98 
     99 ; ------------------------------------
    100 ; THE 'COLLECT NEXT CHARACTER' RESTART
    101 ; ------------------------------------
    102 ; The character address in incremented and the new addressed character is 
    103 ; returned if not a space, or cursor, else the process is repeated.
    104 
    105 ;; NEXT-CHAR
    106 L0020:  CALL    L0049           ; routine CH-ADD+1 gets next immediate
    107                                 ; character.
    108         JR      L001C           ; back to TEST-SP.
    109 
    110 ; ---
    111 
    112         DEFB    $FF, $FF, $FF   ; unused locations.
    113 
    114 ; ---------------------------------------
    115 ; THE 'FLOATING POINT CALCULATOR' RESTART
    116 ; ---------------------------------------
    117 ; this restart jumps to the recursive floating-point calculator.
    118 ; the ZX81's internal, FORTH-like, stack-based language.
    119 ;
    120 ; In the five remaining bytes there is, appropriately, enough room for the
    121 ; end-calc literal - the instruction which exits the calculator.
    122 
    123 ;; FP-CALC
    124 L0028:  JP      L199D           ; jump immediately to the CALCULATE routine.
    125 
    126 ; ---
    127 
    128 ;; end-calc
    129 L002B:  POP     AF              ; drop the calculator return address RE-ENTRY
    130         EXX                     ; switch to the other set.
    131 
    132         EX      (SP),HL         ; transfer H'L' to machine stack for the
    133                                 ; return address.
    134                                 ; when exiting recursion then the previous
    135                                 ; pointer is transferred to H'L'.
    136 
    137         EXX                     ; back to main set.
    138         RET                     ; return.
    139 
    140 
    141 ; -----------------------------
    142 ; THE 'MAKE BC SPACES'  RESTART
    143 ; -----------------------------
    144 ; This restart is used eight times to create, in workspace, the number of
    145 ; spaces passed in the BC register.
    146 
    147 ;; BC-SPACES
    148 L0030:  PUSH    BC              ; push number of spaces on stack.
    149         LD      HL,($4014)      ; fetch edit line location from E_LINE.
    150         PUSH    HL              ; save this value on stack.
    151         JP      L1488           ; jump forward to continue at RESERVE.
    152 
    153 ; -----------------------
    154 ; THE 'INTERRUPT' RESTART
    155 ; -----------------------
    156 ;   The Mode 1 Interrupt routine is concerned solely with generating the central
    157 ;   television picture.
    158 ;   On the ZX81 interrupts are enabled only during the interrupt routine, 
    159 ;   although the interrupt 
    160 ;   This Interrupt Service Routine automatically disables interrupts at the 
    161 ;   outset and the last interrupt in a cascade exits before the interrupts are
    162 ;   enabled.
    163 ;   There is no DI instruction in the ZX81 ROM.
    164 ;   An maskable interrupt is triggered when bit 6 of the Z80's Refresh register
    165 ;   changes from set to reset.
    166 ;   The Z80 will always be executing a HALT (NEWLINE) when the interrupt occurs.
    167 ;   A HALT instruction repeatedly executes NOPS but the seven lower bits
    168 ;   of the Refresh register are incremented each time as they are when any 
    169 ;   simple instruction is executed. (The lower 7 bits are incremented twice for
    170 ;   a prefixed instruction)
    171 ;   This is controlled by the Sinclair Computer Logic Chip - manufactured from 
    172 ;   a Ferranti Uncommitted Logic Array.
    173 ;
    174 ;   When a Mode 1 Interrupt occurs the Program Counter, which is the address in
    175 ;   the upper echo display following the NEWLINE/HALT instruction, goes on the 
    176 ;   machine stack.  193 interrupts are required to generate the last part of
    177 ;   the 56th border line and then the 192 lines of the central TV picture and, 
    178 ;   although each interrupt interrupts the previous one, there are no stack 
    179 ;   problems as the 'return address' is discarded each time.
    180 ;
    181 ;   The scan line counter in C counts down from 8 to 1 within the generation of
    182 ;   each text line. For the first interrupt in a cascade the initial value of 
    183 ;   C is set to 1 for the last border line.
    184 ;   Timing is of the utmost importance as the RH border, horizontal retrace
    185 ;   and LH border are mostly generated in the 58 clock cycles this routine 
    186 ;   takes .
    187 
    188 ;; INTERRUPT
    189 L0038:  DEC     C               ; (4)  decrement C - the scan line counter.
    190         JP      NZ,L0045        ; (10/10) JUMP forward if not zero to SCAN-LINE
    191 
    192         POP     HL              ; (10) point to start of next row in display 
    193                                 ;      file.
    194 
    195         DEC     B               ; (4)  decrement the row counter. (4)
    196         RET     Z               ; (11/5) return when picture complete to L028B
    197                                 ;      with interrupts disabled.
    198 
    199         SET     3,C             ; (8)  Load the scan line counter with eight.  
    200                                 ;      Note. LD C,$08 is 7 clock cycles which 
    201                                 ;      is way too fast.
    202 
    203 ; ->
    204 
    205 ;; WAIT-INT
    206 L0041:  LD      R,A             ; (9) Load R with initial rising value $DD.
    207 
    208         EI                      ; (4) Enable Interrupts.  [ R is now $DE ].
    209 
    210         JP      (HL)            ; (4) jump to the echo display file in upper
    211                                 ;     memory and execute characters $00 - $3F 
    212                                 ;     as NOP instructions.  The video hardware 
    213                                 ;     is able to read these characters and, 
    214                                 ;     with the I register is able to convert 
    215                                 ;     the character bitmaps in this ROM into a 
    216                                 ;     line of bytes. Eventually the NEWLINE/HALT
    217                                 ;     will be encountered before R reaches $FF. 
    218                                 ;     It is however the transition from $FF to 
    219                                 ;     $80 that triggers the next interrupt.
    220                                 ;     [ The Refresh register is now $DF ]
    221 
    222 ; ---
    223 
    224 ;; SCAN-LINE
    225 L0045:  POP     DE              ; (10) discard the address after NEWLINE as the 
    226                                 ;      same text line has to be done again
    227                                 ;      eight times. 
    228 
    229         RET     Z               ; (5)  Harmless Nonsensical Timing.
    230                                 ;      (condition never met)
    231 
    232         JR      L0041           ; (12) back to WAIT-INT
    233 
    234 ;   Note. that a computer with less than 4K or RAM will have a collapsed
    235 ;   display file and the above mechanism deals with both types of display.
    236 ;
    237 ;   With a full display, the 32 characters in the line are treated as NOPS
    238 ;   and the Refresh register rises from $E0 to $FF and, at the next instruction 
    239 ;   - HALT, the interrupt occurs.
    240 ;   With a collapsed display and an initial NEWLINE/HALT, it is the NOPs 
    241 ;   generated by the HALT that cause the Refresh value to rise from $E0 to $FF,
    242 ;   triggering an Interrupt on the next transition.
    243 ;   This works happily for all display lines between these extremes and the 
    244 ;   generation of the 32 character, 1 pixel high, line will always take 128 
    245 ;   clock cycles.
    246 
    247 ; ---------------------------------
    248 ; THE 'INCREMENT CH-ADD' SUBROUTINE
    249 ; ---------------------------------
    250 ; This is the subroutine that increments the character address system variable
    251 ; and returns if it is not the cursor character. The ZX81 has an actual 
    252 ; character at the cursor position rather than a pointer system variable
    253 ; as is the case with prior and subsequent ZX computers.
    254 
    255 ;; CH-ADD+1
    256 L0049:  LD      HL,($4016)      ; fetch character address to CH_ADD.
    257 
    258 ;; TEMP-PTR1
    259 L004C:  INC     HL              ; address next immediate location.
    260 
    261 ;; TEMP-PTR2
    262 L004D:  LD      ($4016),HL      ; update system variable CH_ADD.
    263 
    264         LD      A,(HL)          ; fetch the character.
    265         CP      $7F             ; compare to cursor character.
    266         RET     NZ              ; return if not the cursor.
    267 
    268         JR      L004C           ; back for next character to TEMP-PTR1.
    269 
    270 ; --------------------
    271 ; THE 'ERROR-2' BRANCH
    272 ; --------------------
    273 ; This is a continuation of the error restart.
    274 ; If the error occurred in runtime then the error stack pointer will probably
    275 ; lead to an error report being printed unless it occurred during input.
    276 ; If the error occurred when checking syntax then the error stack pointer
    277 ; will be an editing routine and the position of the error will be shown
    278 ; when the lower screen is reprinted.
    279 
    280 ;; ERROR-2
    281 L0056:  POP     HL              ; pop the return address which points to the
    282                                 ; DEFB, error code, after the RST 08.
    283         LD      L,(HL)          ; load L with the error code. HL is not needed
    284                                 ; anymore.
    285 
    286 ;; ERROR-3
    287 L0058:  LD      (IY+$00),L      ; place error code in system variable ERR_NR
    288         LD      SP,($4002)      ; set the stack pointer from ERR_SP
    289         CALL    L0207           ; routine SLOW/FAST selects slow mode.
    290         JP      L14BC           ; exit to address on stack via routine SET-MIN.
    291 
    292 ; ---
    293 
    294         DEFB    $FF             ; unused.
    295 
    296 ; ------------------------------------
    297 ; THE 'NON MASKABLE INTERRUPT' ROUTINE
    298 ; ------------------------------------
    299 ;   Jim Westwood's technical dodge using Non-Maskable Interrupts solved the
    300 ;   flicker problem of the ZX80 and gave the ZX81 a multi-tasking SLOW mode 
    301 ;   with a steady display.  Note that the AF' register is reserved for this 
    302 ;   function and its interaction with the display routines.  When counting 
    303 ;   TV lines, the NMI makes no use of the main registers.
    304 ;   The circuitry for the NMI generator is contained within the SCL (Sinclair 
    305 ;   Computer Logic) chip. 
    306 ;   ( It takes 32 clock cycles while incrementing towards zero ). 
    307 
    308 ;; NMI
    309 L0066:  EX      AF,AF'          ; (4) switch in the NMI's copy of the 
    310                                 ;     accumulator.
    311         INC     A               ; (4) increment.
    312         JP      M,L006D         ; (10/10) jump, if minus, to NMI-RET as this is
    313                                 ;     part of a test to see if the NMI 
    314                                 ;     generation is working or an intermediate 
    315                                 ;     value for the ascending negated blank 
    316                                 ;     line counter.
    317 
    318         JR      Z,L006F         ; (12) forward to NMI-CONT
    319                                 ;      when line count has incremented to zero.
    320 
    321 ; Note. the synchronizing NMI when A increments from zero to one takes this
    322 ; 7 clock cycle route making 39 clock cycles in all.
    323 
    324 ;; NMI-RET
    325 L006D:  EX      AF,AF'          ; (4)  switch out the incremented line counter
    326                                 ;      or test result $80
    327         RET                     ; (10) return to User application for a while.
    328 
    329 ; ---
    330 
    331 ;   This branch is taken when the 55 (or 31) lines have been drawn.
    332 
    333 ;; NMI-CONT
    334 L006F:  EX      AF,AF'          ; (4) restore the main accumulator.
    335 
    336         PUSH    AF              ; (11) *             Save Main Registers
    337         PUSH    BC              ; (11) **
    338         PUSH    DE              ; (11) ***
    339         PUSH    HL              ; (11) ****
    340 
    341 ;   the next set-up procedure is only really applicable when the top set of 
    342 ;   blank lines have been generated.
    343 
    344         LD      HL,($400C)      ; (16) fetch start of Display File from D_FILE
    345                                 ;      points to the HALT at beginning.
    346         SET     7,H             ; (8) point to upper 32K 'echo display file'
    347 
    348         HALT                    ; (1) HALT synchronizes with NMI.  
    349                                 ; Used with special hardware connected to the
    350                                 ; Z80 HALT and WAIT lines to take 1 clock cycle.
    351 
    352 ; ----------------------------------------------------------------------------
    353 ;   the NMI has been generated - start counting. The cathode ray is at the RH 
    354 ;   side of the TV.
    355 ;   First the NMI servicing, similar to CALL            =  17 clock cycles.
    356 ;   Then the time taken by the NMI for zero-to-one path =  39 cycles
    357 ;   The HALT above                                      =  01 cycles.
    358 ;   The two instructions below                          =  19 cycles.
    359 ;   The code at L0281 up to and including the CALL      =  43 cycles.
    360 ;   The Called routine at L02B5                         =  24 cycles.
    361 ;   --------------------------------------                ---
    362 ;   Total Z80 instructions                              = 143 cycles.
    363 ;
    364 ;   Meanwhile in TV world,
    365 ;   Horizontal retrace                                  =  15 cycles.
    366 ;   Left blanking border 8 character positions          =  32 cycles
    367 ;   Generation of 75% scanline from the first NEWLINE   =  96 cycles
    368 ;   ---------------------------------------               ---
    369 ;                                                         143 cycles
    370 ;
    371 ;   Since at the time the first JP (HL) is encountered to execute the echo
    372 ;   display another 8 character positions have to be put out, then the
    373 ;   Refresh register need to hold $F8. Working back and counteracting 
    374 ;   the fact that every instruction increments the Refresh register then
    375 ;   the value that is loaded into R needs to be $F5.      :-)
    376 ;
    377 ;
    378         OUT     ($FD),A         ; (11) Stop the NMI generator.
    379 
    380         JP      (IX)            ; (8) forward to L0281 (after top) or L028F
    381 
    382 ; ****************
    383 ; ** KEY TABLES **
    384 ; ****************
    385 
    386 ; -------------------------------
    387 ; THE 'UNSHIFTED' CHARACTER CODES
    388 ; -------------------------------
    389 
    390 ;; K-UNSHIFT
    391 L007E:  DEFB    $3F             ; Z
    392         DEFB    $3D             ; X
    393         DEFB    $28             ; C
    394         DEFB    $3B             ; V
    395         DEFB    $26             ; A
    396         DEFB    $38             ; S
    397         DEFB    $29             ; D
    398         DEFB    $2B             ; F
    399         DEFB    $2C             ; G
    400         DEFB    $36             ; Q
    401         DEFB    $3C             ; W
    402         DEFB    $2A             ; E
    403         DEFB    $37             ; R
    404         DEFB    $39             ; T
    405         DEFB    $1D             ; 1
    406         DEFB    $1E             ; 2
    407         DEFB    $1F             ; 3
    408         DEFB    $20             ; 4
    409         DEFB    $21             ; 5
    410         DEFB    $1C             ; 0
    411         DEFB    $25             ; 9
    412         DEFB    $24             ; 8
    413         DEFB    $23             ; 7
    414         DEFB    $22             ; 6
    415         DEFB    $35             ; P
    416         DEFB    $34             ; O
    417         DEFB    $2E             ; I
    418         DEFB    $3A             ; U
    419         DEFB    $3E             ; Y
    420         DEFB    $76             ; NEWLINE
    421         DEFB    $31             ; L
    422         DEFB    $30             ; K
    423         DEFB    $2F             ; J
    424         DEFB    $2D             ; H
    425         DEFB    $00             ; SPACE
    426         DEFB    $1B             ; .
    427         DEFB    $32             ; M
    428         DEFB    $33             ; N
    429         DEFB    $27             ; B
    430 
    431 ; -----------------------------
    432 ; THE 'SHIFTED' CHARACTER CODES
    433 ; -----------------------------
    434 
    435 
    436 ;; K-SHIFT
    437 L00A5:  DEFB    $0E             ; :
    438         DEFB    $19             ; ;
    439         DEFB    $0F             ; ?
    440         DEFB    $18             ; /
    441         DEFB    $E3             ; STOP
    442         DEFB    $E1             ; LPRINT
    443         DEFB    $E4             ; SLOW
    444         DEFB    $E5             ; FAST
    445         DEFB    $E2             ; LLIST
    446         DEFB    $C0             ; ""
    447         DEFB    $D9             ; OR
    448         DEFB    $E0             ; STEP
    449         DEFB    $DB             ; <=
    450         DEFB    $DD             ; <>
    451         DEFB    $75             ; EDIT
    452         DEFB    $DA             ; AND
    453         DEFB    $DE             ; THEN
    454         DEFB    $DF             ; TO
    455         DEFB    $72             ; cursor-left
    456         DEFB    $77             ; RUBOUT
    457         DEFB    $74             ; GRAPHICS
    458         DEFB    $73             ; cursor-right
    459         DEFB    $70             ; cursor-up
    460         DEFB    $71             ; cursor-down
    461         DEFB    $0B             ; "
    462         DEFB    $11             ; )
    463         DEFB    $10             ; (
    464         DEFB    $0D             ; $
    465         DEFB    $DC             ; >=
    466         DEFB    $79             ; FUNCTION
    467         DEFB    $14             ; =
    468         DEFB    $15             ; +
    469         DEFB    $16             ; -
    470         DEFB    $D8             ; **
    471         DEFB    $0C             ; ukp
    472         DEFB    $1A             ; ,
    473         DEFB    $12             ; >
    474         DEFB    $13             ; <
    475         DEFB    $17             ; *
    476 
    477 ; ------------------------------
    478 ; THE 'FUNCTION' CHARACTER CODES
    479 ; ------------------------------
    480 
    481 
    482 ;; K-FUNCT
    483 L00CC:  DEFB    $CD             ; LN
    484         DEFB    $CE             ; EXP
    485         DEFB    $C1             ; AT
    486         DEFB    $78             ; KL
    487         DEFB    $CA             ; ASN
    488         DEFB    $CB             ; ACS
    489         DEFB    $CC             ; ATN
    490         DEFB    $D1             ; SGN
    491         DEFB    $D2             ; ABS
    492         DEFB    $C7             ; SIN
    493         DEFB    $C8             ; COS
    494         DEFB    $C9             ; TAN
    495         DEFB    $CF             ; INT
    496         DEFB    $40             ; RND
    497         DEFB    $78             ; KL
    498         DEFB    $78             ; KL
    499         DEFB    $78             ; KL
    500         DEFB    $78             ; KL
    501         DEFB    $78             ; KL
    502         DEFB    $78             ; KL
    503         DEFB    $78             ; KL
    504         DEFB    $78             ; KL
    505         DEFB    $78             ; KL
    506         DEFB    $78             ; KL
    507         DEFB    $C2             ; TAB
    508         DEFB    $D3             ; PEEK
    509         DEFB    $C4             ; CODE
    510         DEFB    $D6             ; CHR$
    511         DEFB    $D5             ; STR$
    512         DEFB    $78             ; KL
    513         DEFB    $D4             ; USR
    514         DEFB    $C6             ; LEN
    515         DEFB    $C5             ; VAL
    516         DEFB    $D0             ; SQR
    517         DEFB    $78             ; KL
    518         DEFB    $78             ; KL
    519         DEFB    $42             ; PI
    520         DEFB    $D7             ; NOT
    521         DEFB    $41             ; INKEY$
    522 
    523 ; -----------------------------
    524 ; THE 'GRAPHIC' CHARACTER CODES
    525 ; -----------------------------
    526 
    527 
    528 ;; K-GRAPH
    529 L00F3:  DEFB    $08             ; graphic
    530         DEFB    $0A             ; graphic
    531         DEFB    $09             ; graphic
    532         DEFB    $8A             ; graphic
    533         DEFB    $89             ; graphic
    534         DEFB    $81             ; graphic
    535         DEFB    $82             ; graphic
    536         DEFB    $07             ; graphic
    537         DEFB    $84             ; graphic
    538         DEFB    $06             ; graphic
    539         DEFB    $01             ; graphic
    540         DEFB    $02             ; graphic
    541         DEFB    $87             ; graphic
    542         DEFB    $04             ; graphic
    543         DEFB    $05             ; graphic
    544         DEFB    $77             ; RUBOUT
    545         DEFB    $78             ; KL
    546         DEFB    $85             ; graphic
    547         DEFB    $03             ; graphic
    548         DEFB    $83             ; graphic
    549         DEFB    $8B             ; graphic
    550         DEFB    $91             ; inverse )
    551         DEFB    $90             ; inverse (
    552         DEFB    $8D             ; inverse $
    553         DEFB    $86             ; graphic
    554         DEFB    $78             ; KL
    555         DEFB    $92             ; inverse >
    556         DEFB    $95             ; inverse +
    557         DEFB    $96             ; inverse -
    558         DEFB    $88             ; graphic
    559 
    560 ; ------------------
    561 ; THE 'TOKEN' TABLES
    562 ; ------------------
    563 
    564 
    565 ;; TOKENS
    566 L0111:  DEFB    $0F+$80                         ; '?'+$80
    567         DEFB    $0B,$0B+$80                     ; ""
    568         DEFB    $26,$39+$80                     ; AT
    569         DEFB    $39,$26,$27+$80                 ; TAB
    570         DEFB    $0F+$80                         ; '?'+$80
    571         DEFB    $28,$34,$29,$2A+$80             ; CODE
    572         DEFB    $3B,$26,$31+$80                 ; VAL
    573         DEFB    $31,$2A,$33+$80                 ; LEN
    574         DEFB    $38,$2E,$33+$80                 ; SIN
    575         DEFB    $28,$34,$38+$80                 ; COS
    576         DEFB    $39,$26,$33+$80                 ; TAN
    577         DEFB    $26,$38,$33+$80                 ; ASN
    578         DEFB    $26,$28,$38+$80                 ; ACS
    579         DEFB    $26,$39,$33+$80                 ; ATN
    580         DEFB    $31,$33+$80                     ; LN
    581         DEFB    $2A,$3D,$35+$80                 ; EXP
    582         DEFB    $2E,$33,$39+$80                 ; INT
    583         DEFB    $38,$36,$37+$80                 ; SQR
    584         DEFB    $38,$2C,$33+$80                 ; SGN
    585         DEFB    $26,$27,$38+$80                 ; ABS
    586         DEFB    $35,$2A,$2A,$30+$80             ; PEEK
    587         DEFB    $3A,$38,$37+$80                 ; USR
    588         DEFB    $38,$39,$37,$0D+$80             ; STR$
    589         DEFB    $28,$2D,$37,$0D+$80             ; CHR$
    590         DEFB    $33,$34,$39+$80                 ; NOT
    591         DEFB    $17,$17+$80                     ; **
    592         DEFB    $34,$37+$80                     ; OR
    593         DEFB    $26,$33,$29+$80                 ; AND
    594         DEFB    $13,$14+$80                     ; <=
    595         DEFB    $12,$14+$80                     ; >=
    596         DEFB    $13,$12+$80                     ; <>
    597         DEFB    $39,$2D,$2A,$33+$80             ; THEN
    598         DEFB    $39,$34+$80                     ; TO
    599         DEFB    $38,$39,$2A,$35+$80             ; STEP
    600         DEFB    $31,$35,$37,$2E,$33,$39+$80     ; LPRINT
    601         DEFB    $31,$31,$2E,$38,$39+$80         ; LLIST
    602         DEFB    $38,$39,$34,$35+$80             ; STOP
    603         DEFB    $38,$31,$34,$3C+$80             ; SLOW
    604         DEFB    $2B,$26,$38,$39+$80             ; FAST
    605         DEFB    $33,$2A,$3C+$80                 ; NEW
    606         DEFB    $38,$28,$37,$34,$31,$31+$80     ; SCROLL
    607         DEFB    $28,$34,$33,$39+$80             ; CONT
    608         DEFB    $29,$2E,$32+$80                 ; DIM
    609         DEFB    $37,$2A,$32+$80                 ; REM
    610         DEFB    $2B,$34,$37+$80                 ; FOR
    611         DEFB    $2C,$34,$39,$34+$80             ; GOTO
    612         DEFB    $2C,$34,$38,$3A,$27+$80         ; GOSUB
    613         DEFB    $2E,$33,$35,$3A,$39+$80         ; INPUT
    614         DEFB    $31,$34,$26,$29+$80             ; LOAD
    615         DEFB    $31,$2E,$38,$39+$80             ; LIST
    616         DEFB    $31,$2A,$39+$80                 ; LET
    617         DEFB    $35,$26,$3A,$38,$2A+$80         ; PAUSE
    618         DEFB    $33,$2A,$3D,$39+$80             ; NEXT
    619         DEFB    $35,$34,$30,$2A+$80             ; POKE
    620         DEFB    $35,$37,$2E,$33,$39+$80         ; PRINT
    621         DEFB    $35,$31,$34,$39+$80             ; PLOT
    622         DEFB    $37,$3A,$33+$80                 ; RUN
    623         DEFB    $38,$26,$3B,$2A+$80             ; SAVE
    624         DEFB    $37,$26,$33,$29+$80             ; RAND
    625         DEFB    $2E,$2B+$80                     ; IF
    626         DEFB    $28,$31,$38+$80                 ; CLS
    627         DEFB    $3A,$33,$35,$31,$34,$39+$80     ; UNPLOT
    628         DEFB    $28,$31,$2A,$26,$37+$80         ; CLEAR
    629         DEFB    $37,$2A,$39,$3A,$37,$33+$80     ; RETURN
    630         DEFB    $28,$34,$35,$3E+$80             ; COPY
    631         DEFB    $37,$33,$29+$80                 ; RND
    632         DEFB    $2E,$33,$30,$2A,$3E,$0D+$80     ; INKEY$
    633         DEFB    $35,$2E+$80                     ; PI
    634 
    635 
    636 ; ------------------------------
    637 ; THE 'LOAD-SAVE UPDATE' ROUTINE
    638 ; ------------------------------
    639 ;
    640 ;
    641 
    642 ;; LOAD/SAVE
    643 L01FC:  INC     HL              ;
    644         EX      DE,HL           ;
    645         LD      HL,($4014)      ; system variable edit line E_LINE.
    646         SCF                     ; set carry flag
    647         SBC     HL,DE           ;
    648         EX      DE,HL           ;
    649         RET     NC              ; return if more bytes to load/save.
    650 
    651         POP     HL              ; else drop return address
    652 
    653 ; ----------------------
    654 ; THE 'DISPLAY' ROUTINES
    655 ; ----------------------
    656 ;
    657 ;
    658 
    659 ;; SLOW/FAST
    660 L0207:  LD      HL,$403B        ; Address the system variable CDFLAG.
    661         LD      A,(HL)          ; Load value to the accumulator.
    662         RLA                     ; rotate bit 6 to position 7.
    663         XOR     (HL)            ; exclusive or with original bit 7.
    664         RLA                     ; rotate result out to carry.
    665         RET     NC              ; return if both bits were the same.
    666 
    667 ;   Now test if this really is a ZX81 or a ZX80 running the upgraded ROM.
    668 ;   The standard ZX80 did not have an NMI generator.
    669 
    670         LD      A,$7F           ; Load accumulator with %011111111
    671         EX      AF,AF'          ; save in AF'
    672 
    673         LD      B,$11           ; A counter within which an NMI should occur
    674                                 ; if this is a ZX81.
    675         OUT     ($FE),A         ; start the NMI generator.
    676 
    677 ;  Note that if this is a ZX81 then the NMI will increment AF'.
    678 
    679 ;; LOOP-11
    680 L0216:  DJNZ    L0216           ; self loop to give the NMI a chance to kick in.
    681                                 ; = 16*13 clock cycles + 8 = 216 clock cycles.
    682 
    683         OUT     ($FD),A         ; Turn off the NMI generator.
    684         EX      AF,AF'          ; bring back the AF' value.
    685         RLA                     ; test bit 7.
    686         JR      NC,L0226        ; forward, if bit 7 is still reset, to NO-SLOW.
    687 
    688 ;   If the AF' was incremented then the NMI generator works and SLOW mode can
    689 ;   be set.
    690 
    691         SET     7,(HL)          ; Indicate SLOW mode - Compute and Display.
    692 
    693         PUSH    AF              ; *             Save Main Registers
    694         PUSH    BC              ; **
    695         PUSH    DE              ; ***
    696         PUSH    HL              ; ****
    697 
    698         JR      L0229           ; skip forward - to DISPLAY-1.
    699 
    700 ; ---
    701 
    702 ;; NO-SLOW
    703 L0226:  RES     6,(HL)          ; reset bit 6 of CDFLAG.
    704         RET                     ; return.
    705 
    706 ; -----------------------
    707 ; THE 'MAIN DISPLAY' LOOP
    708 ; -----------------------
    709 ; This routine is executed once for every frame displayed.
    710 
    711 ;; DISPLAY-1
    712 L0229:  LD      HL,($4034)      ; fetch two-byte system variable FRAMES.
    713         DEC     HL              ; decrement frames counter.
    714 
    715 ;; DISPLAY-P
    716 L022D:  LD      A,$7F           ; prepare a mask
    717         AND     H               ; pick up bits 6-0 of H.
    718         OR      L               ; and any bits of L.
    719         LD      A,H             ; reload A with all bits of H for PAUSE test.
    720 
    721 ;   Note both branches must take the same time.
    722 
    723         JR      NZ,L0237        ; (12/7) forward if bits 14-0 are not zero 
    724                                 ; to ANOTHER
    725 
    726         RLA                     ; (4) test bit 15 of FRAMES.
    727         JR      L0239           ; (12) forward with result to OVER-NC
    728 
    729 ; ---
    730 
    731 ;; ANOTHER
    732 L0237:  LD      B,(HL)          ; (7) Note. Harmless Nonsensical Timing weight.
    733         SCF                     ; (4) Set Carry Flag.
    734 
    735 ; Note. the branch to here takes either (12)(7)(4) cyles or (7)(4)(12) cycles.
    736 
    737 ;; OVER-NC
    738 L0239:  LD      H,A             ; (4)  set H to zero
    739         LD      ($4034),HL      ; (16) update system variable FRAMES 
    740         RET     NC              ; (11/5) return if FRAMES is in use by PAUSE 
    741                                 ; command.
    742 
    743 ;; DISPLAY-2
    744 L023E:  CALL    L02BB           ; routine KEYBOARD gets the key row in H and 
    745                                 ; the column in L. Reading the ports also starts
    746                                 ; the TV frame synchronization pulse. (VSYNC)
    747 
    748         LD      BC,($4025)      ; fetch the last key values read from LAST_K
    749         LD      ($4025),HL      ; update LAST_K with new values.
    750 
    751         LD      A,B             ; load A with previous column - will be $FF if
    752                                 ; there was no key.
    753         ADD     A,$02           ; adding two will set carry if no previous key.
    754 
    755         SBC     HL,BC           ; subtract with the carry the two key values.
    756 
    757 ; If the same key value has been returned twice then HL will be zero.
    758 
    759         LD      A,($4027)       ; fetch system variable DEBOUNCE
    760         OR      H               ; and OR with both bytes of the difference
    761         OR      L               ; setting the zero flag for the upcoming branch.
    762 
    763         LD      E,B             ; transfer the column value to E
    764         LD      B,$0B           ; and load B with eleven 
    765 
    766         LD      HL,$403B        ; address system variable CDFLAG
    767         RES     0,(HL)          ; reset the rightmost bit of CDFLAG
    768         JR      NZ,L0264        ; skip forward if debounce/diff >0 to NO-KEY
    769 
    770         BIT     7,(HL)          ; test compute and display bit of CDFLAG
    771         SET     0,(HL)          ; set the rightmost bit of CDFLAG.
    772         RET     Z               ; return if bit 7 indicated fast mode.
    773 
    774         DEC     B               ; (4) decrement the counter.
    775         NOP                     ; (4) Timing - 4 clock cycles. ??
    776         SCF                     ; (4) Set Carry Flag
    777 
    778 ;; NO-KEY
    779 L0264:  LD      HL,$4027        ; sv DEBOUNCE
    780         CCF                     ; Complement Carry Flag
    781         RL      B               ; rotate left B picking up carry
    782                                 ;  C<-76543210<-C
    783 
    784 ;; LOOP-B
    785 L026A:  DJNZ    L026A           ; self-loop while B>0 to LOOP-B
    786 
    787         LD      B,(HL)          ; fetch value of DEBOUNCE to B
    788         LD      A,E             ; transfer column value
    789         CP      $FE             ;
    790         SBC     A,A             ;
    791         LD      B,$1F           ;
    792         OR      (HL)            ;
    793         AND     B               ;
    794         RRA                     ;
    795         LD      (HL),A          ;
    796 
    797         OUT     ($FF),A         ; end the TV frame synchronization pulse.
    798 
    799         LD      HL,($400C)      ; (12) set HL to the Display File from D_FILE
    800         SET     7,H             ; (8) set bit 15 to address the echo display.
    801 
    802         CALL    L0292           ; (17) routine DISPLAY-3 displays the top set 
    803                                 ; of blank lines.
    804 
    805 ; ---------------------
    806 ; THE 'VIDEO-1' ROUTINE
    807 ; ---------------------
    808 
    809 ;; R-IX-1
    810 L0281:  LD      A,R             ; (9)  Harmless Nonsensical Timing or something
    811                                 ;      very clever?
    812         LD      BC,$1901        ; (10) 25 lines, 1 scanline in first.
    813         LD      A,$F5           ; (7)  This value will be loaded into R and 
    814                                 ; ensures that the cycle starts at the right 
    815                                 ; part of the display  - after 32nd character 
    816                                 ; position.
    817 
    818         CALL    L02B5           ; (17) routine DISPLAY-5 completes the current 
    819                                 ; blank line and then generates the display of 
    820                                 ; the live picture using INT interrupts
    821                                 ; The final interrupt returns to the next 
    822                                 ; address.
    823 
    824 L028B:  DEC     HL              ; point HL to the last NEWLINE/HALT.
    825 
    826         CALL    L0292           ; routine DISPLAY-3 displays the bottom set of
    827                                 ; blank lines.
    828 
    829 ; ---
    830 
    831 ;; R-IX-2
    832 L028F:  JP      L0229           ; JUMP back to DISPLAY-1
    833 
    834 ; ---------------------------------
    835 ; THE 'DISPLAY BLANK LINES' ROUTINE 
    836 ; ---------------------------------
    837 ;   This subroutine is called twice (see above) to generate first the blank 
    838 ;   lines at the top of the television display and then the blank lines at the
    839 ;   bottom of the display. 
    840 
    841 ;; DISPLAY-3
    842 L0292:  POP     IX              ; pop the return address to IX register.
    843                                 ; will be either L0281 or L028F - see above.
    844 
    845         LD      C,(IY+$28)      ; load C with value of system constant MARGIN.
    846         BIT     7,(IY+$3B)      ; test CDFLAG for compute and display.
    847         JR      Z,L02A9         ; forward, with FAST mode, to DISPLAY-4
    848 
    849         LD      A,C             ; move MARGIN to A  - 31d or 55d.
    850         NEG                     ; Negate
    851         INC     A               ;
    852         EX      AF,AF'          ; place negative count of blank lines in A'
    853 
    854         OUT     ($FE),A         ; enable the NMI generator.
    855 
    856         POP     HL              ; ****
    857         POP     DE              ; ***
    858         POP     BC              ; **
    859         POP     AF              ; *             Restore Main Registers
    860 
    861         RET                     ; return - end of interrupt.  Return is to 
    862                                 ; user's program - BASIC or machine code.
    863                                 ; which will be interrupted by every NMI.
    864 
    865 ; ------------------------
    866 ; THE 'FAST MODE' ROUTINES
    867 ; ------------------------
    868 
    869 ;; DISPLAY-4
    870 L02A9:  LD      A,$FC           ; (7)  load A with first R delay value
    871         LD      B,$01           ; (7)  one row only.
    872 
    873         CALL    L02B5           ; (17) routine DISPLAY-5
    874 
    875         DEC     HL              ; (6)  point back to the HALT.
    876         EX      (SP),HL         ; (19) Harmless Nonsensical Timing if paired.
    877         EX      (SP),HL         ; (19) Harmless Nonsensical Timing.
    878         JP      (IX)            ; (8)  to L0281 or L028F
    879 
    880 ; --------------------------
    881 ; THE 'DISPLAY-5' SUBROUTINE
    882 ; --------------------------
    883 ;   This subroutine is called from SLOW mode and FAST mode to generate the 
    884 ;   central TV picture. With SLOW mode the R register is incremented, with
    885 ;   each instruction, to $F7 by the time it completes.  With fast mode, the 
    886 ;   final R value will be $FF and an interrupt will occur as soon as the 
    887 ;   Program Counter reaches the HALT.  (24 clock cycles)
    888 
    889 ;; DISPLAY-5
    890 L02B5:  LD      R,A             ; (9) Load R from A.    R = slow: $F5 fast: $FC
    891         LD      A,$DD           ; (7) load future R value.        $F6       $FD
    892 
    893         EI                      ; (4) Enable Interrupts           $F7       $FE
    894 
    895         JP      (HL)            ; (4) jump to the echo display.   $F8       $FF
    896 
    897 ; ----------------------------------
    898 ; THE 'KEYBOARD SCANNING' SUBROUTINE
    899 ; ----------------------------------
    900 ; The keyboard is read during the vertical sync interval while no video is 
    901 ; being displayed.  Reading a port with address bit 0 low i.e. $FE starts the 
    902 ; vertical sync pulse.
    903 
    904 ;; KEYBOARD
    905 L02BB:  LD      HL,$FFFF        ; (16) prepare a buffer to take key.
    906         LD      BC,$FEFE        ; (20) set BC to port $FEFE. The B register, 
    907                                 ;      with its single reset bit also acts as 
    908                                 ;      an 8-counter.
    909         IN      A,(C)           ; (11) read the port - all 16 bits are put on 
    910                                 ;      the address bus.  Start VSYNC pulse.
    911         OR      $01             ; (7)  set the rightmost bit so as to ignore 
    912                                 ;      the SHIFT key.
    913 
    914 ;; EACH-LINE
    915 L02C5:  OR      $E0             ; [7] OR %11100000
    916         LD      D,A             ; [4] transfer to D.
    917         CPL                     ; [4] complement - only bits 4-0 meaningful now.
    918         CP      $01             ; [7] sets carry if A is zero.
    919         SBC     A,A             ; [4] $FF if $00 else zero.
    920         OR      B               ; [7] $FF or port FE,FD,FB....
    921         AND     L               ; [4] unless more than one key, L will still be 
    922                                 ;     $FF. if more than one key is pressed then A is 
    923                                 ;     now invalid.
    924         LD      L,A             ; [4] transfer to L.
    925 
    926 ; now consider the column identifier.
    927 
    928         LD      A,H             ; [4] will be $FF if no previous keys.
    929         AND     D               ; [4] 111xxxxx
    930         LD      H,A             ; [4] transfer A to H
    931 
    932 ; since only one key may be pressed, H will, if valid, be one of
    933 ; 11111110, 11111101, 11111011, 11110111, 11101111
    934 ; reading from the outer column, say Q, to the inner column, say T.
    935 
    936         RLC     B               ; [8]  rotate the 8-counter/port address.
    937                                 ;      sets carry if more to do.
    938         IN      A,(C)           ; [10] read another half-row.
    939                                 ;      all five bits this time.
    940 
    941         JR      C,L02C5         ; [12](7) loop back, until done, to EACH-LINE
    942 
    943 ;   The last row read is SHIFT,Z,X,C,V  for the second time.
    944 
    945         RRA                     ; (4) test the shift key - carry will be reset
    946                                 ;     if the key is pressed.
    947         RL      H               ; (8) rotate left H picking up the carry giving
    948                                 ;     column values -
    949                                 ;        $FD, $FB, $F7, $EF, $DF.
    950                                 ;     or $FC, $FA, $F6, $EE, $DE if shifted.
    951 
    952 ;   We now have H identifying the column and L identifying the row in the
    953 ;   keyboard matrix.
    954 
    955 ;   This is a good time to test if this is an American or British machine.
    956 ;   The US machine has an extra diode that causes bit 6 of a byte read from
    957 ;   a port to be reset.
    958 
    959         RLA                     ; (4) compensate for the shift test.
    960         RLA                     ; (4) rotate bit 7 out.
    961         RLA                     ; (4) test bit 6.
    962 
    963         SBC     A,A             ; (4)           $FF or $00 {USA}
    964         AND     $18             ; (7)           $18 or $00
    965         ADD     A,$1F           ; (7)           $37 or $1F
    966 
    967 ;   result is either 31 (USA) or 55 (UK) blank lines above and below the TV 
    968 ;   picture.
    969 
    970         LD      ($4028),A       ; (13) update system variable MARGIN
    971 
    972         RET                     ; (10) return
    973 
    974 ; ------------------------------
    975 ; THE 'SET FAST MODE' SUBROUTINE
    976 ; ------------------------------
    977 ;
    978 ;
    979 
    980 ;; SET-FAST
    981 L02E7:  BIT     7,(IY+$3B)      ; sv CDFLAG
    982         RET     Z               ;
    983 
    984         HALT                    ; Wait for Interrupt
    985         OUT     ($FD),A         ;
    986         RES     7,(IY+$3B)      ; sv CDFLAG
    987         RET                     ; return.
    988 
    989 
    990 ; --------------
    991 ; THE 'REPORT-F'
    992 ; --------------
    993 
    994 ;; REPORT-F
    995 L02F4:  RST     08H             ; ERROR-1
    996         DEFB    $0E             ; Error Report: No Program Name supplied.
    997 
    998 ; --------------------------
    999 ; THE 'SAVE COMMAND' ROUTINE
   1000 ; --------------------------
   1001 ;
   1002 ;
   1003 
   1004 ;; SAVE
   1005 L02F6:  CALL    L03A8           ; routine NAME
   1006         JR      C,L02F4         ; back with null name to REPORT-F above.
   1007 
   1008         EX      DE,HL           ;
   1009         LD      DE,$12CB        ; five seconds timing value
   1010 
   1011 ;; HEADER
   1012 L02FF:  CALL    L0F46           ; routine BREAK-1
   1013         JR      NC,L0332        ; to BREAK-2
   1014 
   1015 ;; DELAY-1
   1016 L0304:  DJNZ    L0304           ; to DELAY-1
   1017 
   1018         DEC     DE              ;
   1019         LD      A,D             ;
   1020         OR      E               ;
   1021         JR      NZ,L02FF        ; back for delay to HEADER
   1022 
   1023 ;; OUT-NAME
   1024 L030B:  CALL    L031E           ; routine OUT-BYTE
   1025         BIT     7,(HL)          ; test for inverted bit.
   1026         INC     HL              ; address next character of name.
   1027         JR      Z,L030B         ; back if not inverted to OUT-NAME
   1028 
   1029 ; now start saving the system variables onwards.
   1030 
   1031         LD      HL,$4009        ; set start of area to VERSN thereby
   1032                                 ; preserving RAMTOP etc.
   1033 
   1034 ;; OUT-PROG
   1035 L0316:  CALL    L031E           ; routine OUT-BYTE
   1036 
   1037         CALL    L01FC           ; routine LOAD/SAVE                     >>
   1038         JR      L0316           ; loop back to OUT-PROG
   1039 
   1040 ; -------------------------
   1041 ; THE 'OUT-BYTE' SUBROUTINE
   1042 ; -------------------------
   1043 ; This subroutine outputs a byte a bit at a time to a domestic tape recorder.
   1044 
   1045 ;; OUT-BYTE
   1046 L031E:  LD      E,(HL)          ; fetch byte to be saved.
   1047         SCF                     ; set carry flag - as a marker.
   1048 
   1049 ;; EACH-BIT
   1050 L0320:  RL      E               ;  C < 76543210 < C
   1051         RET     Z               ; return when the marker bit has passed 
   1052                                 ; right through.                        >>
   1053 
   1054         SBC     A,A             ; $FF if set bit or $00 with no carry.
   1055         AND     $05             ; $05               $00
   1056         ADD     A,$04           ; $09               $04
   1057         LD      C,A             ; transfer timer to C. a set bit has a longer
   1058                                 ; pulse than a reset bit.
   1059 
   1060 ;; PULSES
   1061 L0329:  OUT     ($FF),A         ; pulse to cassette.
   1062         LD      B,$23           ; set timing constant
   1063 
   1064 ;; DELAY-2
   1065 L032D:  DJNZ    L032D           ; self-loop to DELAY-2
   1066 
   1067         CALL    L0F46           ; routine BREAK-1 test for BREAK key.
   1068 
   1069 ;; BREAK-2
   1070 L0332:  JR      NC,L03A6        ; forward with break to REPORT-D
   1071 
   1072         LD      B,$1E           ; set timing value.
   1073 
   1074 ;; DELAY-3
   1075 L0336:  DJNZ    L0336           ; self-loop to DELAY-3
   1076 
   1077         DEC     C               ; decrement counter
   1078         JR      NZ,L0329        ; loop back to PULSES
   1079 
   1080 ;; DELAY-4
   1081 L033B:  AND     A               ; clear carry for next bit test.
   1082         DJNZ    L033B           ; self loop to DELAY-4 (B is zero - 256)
   1083 
   1084         JR      L0320           ; loop back to EACH-BIT
   1085 
   1086 ; --------------------------
   1087 ; THE 'LOAD COMMAND' ROUTINE
   1088 ; --------------------------
   1089 ;
   1090 ;
   1091 
   1092 ;; LOAD
   1093 L0340:  CALL    L03A8           ; routine NAME
   1094 
   1095 ; DE points to start of name in RAM.
   1096 
   1097         RL      D               ; pick up carry 
   1098         RRC     D               ; carry now in bit 7.
   1099 
   1100 ;; NEXT-PROG
   1101 L0347:  CALL    L034C           ; routine IN-BYTE
   1102         JR      L0347           ; loop to NEXT-PROG
   1103 
   1104 ; ------------------------
   1105 ; THE 'IN-BYTE' SUBROUTINE
   1106 ; ------------------------
   1107 
   1108 ;; IN-BYTE
   1109 L034C:  LD      C,$01           ; prepare an eight counter 00000001.
   1110 
   1111 ;; NEXT-BIT
   1112 L034E:  LD      B,$00           ; set counter to 256
   1113 
   1114 ;; BREAK-3
   1115 L0350:  LD      A,$7F           ; read the keyboard row 
   1116         IN      A,($FE)         ; with the SPACE key.
   1117 
   1118         OUT     ($FF),A         ; output signal to screen.
   1119 
   1120         RRA                     ; test for SPACE pressed.
   1121         JR      NC,L03A2        ; forward if so to BREAK-4
   1122 
   1123         RLA                     ; reverse above rotation
   1124         RLA                     ; test tape bit.
   1125         JR      C,L0385         ; forward if set to GET-BIT
   1126 
   1127         DJNZ    L0350           ; loop back to BREAK-3
   1128 
   1129         POP     AF              ; drop the return address.
   1130         CP      D               ; ugh.
   1131 
   1132 ;; RESTART
   1133 L0361:  JP      NC,L03E5        ; jump forward to INITIAL if D is zero 
   1134                                 ; to reset the system
   1135                                 ; if the tape signal has timed out for example
   1136                                 ; if the tape is stopped. Not just a simple 
   1137                                 ; report as some system variables will have
   1138                                 ; been overwritten.
   1139 
   1140         LD      H,D             ; else transfer the start of name
   1141         LD      L,E             ; to the HL register
   1142 
   1143 ;; IN-NAME
   1144 L0366:  CALL    L034C           ; routine IN-BYTE is sort of recursion for name
   1145                                 ; part. received byte in C.
   1146         BIT     7,D             ; is name the null string ?
   1147         LD      A,C             ; transfer byte to A.
   1148         JR      NZ,L0371        ; forward with null string to MATCHING
   1149 
   1150         CP      (HL)            ; else compare with string in memory.
   1151         JR      NZ,L0347        ; back with mis-match to NEXT-PROG
   1152                                 ; (seemingly out of subroutine but return 
   1153                                 ; address has been dropped).
   1154 
   1155 
   1156 ;; MATCHING
   1157 L0371:  INC     HL              ; address next character of name
   1158         RLA                     ; test for inverted bit.
   1159         JR      NC,L0366        ; back if not to IN-NAME
   1160 
   1161 ; the name has been matched in full. 
   1162 ; proceed to load the data but first increment the high byte of E_LINE, which
   1163 ; is one of the system variables to be loaded in. Since the low byte is loaded
   1164 ; before the high byte, it is possible that, at the in-between stage, a false
   1165 ; value could cause the load to end prematurely - see  LOAD/SAVE check.
   1166 
   1167         INC     (IY+$15)        ; increment system variable E_LINE_hi.
   1168         LD      HL,$4009        ; start loading at system variable VERSN.
   1169 
   1170 ;; IN-PROG
   1171 L037B:  LD      D,B             ; set D to zero as indicator.
   1172         CALL    L034C           ; routine IN-BYTE loads a byte
   1173         LD      (HL),C          ; insert assembled byte in memory.
   1174         CALL    L01FC           ; routine LOAD/SAVE                     >>
   1175         JR      L037B           ; loop back to IN-PROG
   1176 
   1177 ; ---
   1178 
   1179 ; this branch assembles a full byte before exiting normally
   1180 ; from the IN-BYTE subroutine.
   1181 
   1182 ;; GET-BIT
   1183 L0385:  PUSH    DE              ; save the 
   1184         LD      E,$94           ; timing value.
   1185 
   1186 ;; TRAILER
   1187 L0388:  LD      B,$1A           ; counter to twenty six.
   1188 
   1189 ;; COUNTER
   1190 L038A:  DEC     E               ; decrement the measuring timer.
   1191         IN      A,($FE)         ; read the
   1192         RLA                     ;
   1193         BIT     7,E             ;
   1194         LD      A,E             ;
   1195         JR      C,L0388         ; loop back with carry to TRAILER
   1196 
   1197         DJNZ    L038A           ; to COUNTER
   1198 
   1199         POP     DE              ;
   1200         JR      NZ,L039C        ; to BIT-DONE
   1201 
   1202         CP      $56             ;
   1203         JR      NC,L034E        ; to NEXT-BIT
   1204 
   1205 ;; BIT-DONE
   1206 L039C:  CCF                     ; complement carry flag
   1207         RL      C               ;
   1208         JR      NC,L034E        ; to NEXT-BIT
   1209 
   1210         RET                     ; return with full byte.
   1211 
   1212 ; ---
   1213 
   1214 ; if break is pressed while loading data then perform a reset.
   1215 ; if break pressed while waiting for program on tape then OK to break.
   1216 
   1217 ;; BREAK-4
   1218 L03A2:  LD      A,D             ; transfer indicator to A.
   1219         AND     A               ; test for zero.
   1220         JR      Z,L0361         ; back if so to RESTART
   1221 
   1222 
   1223 ;; REPORT-D
   1224 L03A6:  RST     08H             ; ERROR-1
   1225         DEFB    $0C             ; Error Report: BREAK - CONT repeats
   1226 
   1227 ; -----------------------------
   1228 ; THE 'PROGRAM NAME' SUBROUTINE
   1229 ; -----------------------------
   1230 ;
   1231 ;
   1232 
   1233 ;; NAME
   1234 L03A8:  CALL    L0F55           ; routine SCANNING
   1235         LD      A,($4001)       ; sv FLAGS
   1236         ADD     A,A             ;
   1237         JP      M,L0D9A         ; to REPORT-C
   1238 
   1239         POP     HL              ;
   1240         RET     NC              ;
   1241 
   1242         PUSH    HL              ;
   1243         CALL    L02E7           ; routine SET-FAST
   1244         CALL    L13F8           ; routine STK-FETCH
   1245         LD      H,D             ;
   1246         LD      L,E             ;
   1247         DEC     C               ;
   1248         RET     M               ;
   1249 
   1250         ADD     HL,BC           ;
   1251         SET     7,(HL)          ;
   1252         RET                     ;
   1253 
   1254 ; -------------------------
   1255 ; THE 'NEW' COMMAND ROUTINE
   1256 ; -------------------------
   1257 ;
   1258 ;
   1259 
   1260 ;; NEW
   1261 L03C3:  CALL    L02E7           ; routine SET-FAST
   1262         LD      BC,($4004)      ; fetch value of system variable RAMTOP
   1263         DEC     BC              ; point to last system byte.
   1264 
   1265 ; -----------------------
   1266 ; THE 'RAM CHECK' ROUTINE
   1267 ; -----------------------
   1268 ;
   1269 ;
   1270 
   1271 ;; RAM-CHECK
   1272 L03CB:  LD      H,B             ;
   1273         LD      L,C             ;
   1274         LD      A,$3F           ;
   1275 
   1276 ;; RAM-FILL
   1277 L03CF:  LD      (HL),$02        ;
   1278         DEC     HL              ;
   1279         CP      H               ;
   1280         JR      NZ,L03CF        ; to RAM-FILL
   1281 
   1282 ;; RAM-READ
   1283 L03D5:  AND     A               ;
   1284         SBC     HL,BC           ;
   1285         ADD     HL,BC           ;
   1286         INC     HL              ;
   1287         JR      NC,L03E2        ; to SET-TOP
   1288 
   1289         DEC     (HL)            ;
   1290         JR      Z,L03E2         ; to SET-TOP
   1291 
   1292         DEC     (HL)            ;
   1293         JR      Z,L03D5         ; to RAM-READ
   1294 
   1295 ;; SET-TOP
   1296 L03E2:  LD      ($4004),HL      ; set system variable RAMTOP to first byte 
   1297                                 ; above the BASIC system area.
   1298 
   1299 ; ----------------------------
   1300 ; THE 'INITIALIZATION' ROUTINE
   1301 ; ----------------------------
   1302 ;
   1303 ;
   1304 
   1305 ;; INITIAL
   1306 L03E5:  LD      HL,($4004)      ; fetch system variable RAMTOP.
   1307         DEC     HL              ; point to last system byte.
   1308         LD      (HL),$3E        ; make GO SUB end-marker $3E - too high for
   1309                                 ; high order byte of line number.
   1310                                 ; (was $3F on ZX80)
   1311         DEC     HL              ; point to unimportant low-order byte.
   1312         LD      SP,HL           ; and initialize the stack-pointer to this
   1313                                 ; location.
   1314         DEC     HL              ; point to first location on the machine stack
   1315         DEC     HL              ; which will be filled by next CALL/PUSH.
   1316         LD      ($4002),HL      ; set the error stack pointer ERR_SP to
   1317                                 ; the base of the now empty machine stack.
   1318 
   1319 ; Now set the I register so that the video hardware knows where to find the
   1320 ; character set. This ROM only uses the character set when printing to 
   1321 ; the ZX Printer. The TV picture is formed by the external video hardware. 
   1322 ; Consider also, that this 8K ROM can be retro-fitted to the ZX80 instead of 
   1323 ; its original 4K ROM so the video hardware could be on the ZX80.
   1324 
   1325         LD      A,$1E           ; address for this ROM is $1E00.
   1326         LD      I,A             ; set I register from A.
   1327         IM      1               ; select Z80 Interrupt Mode 1.
   1328 
   1329         LD      IY,$4000        ; set IY to the start of RAM so that the 
   1330                                 ; system variables can be indexed.
   1331         LD      (IY+$3B),$40    ; set CDFLAG 0100 0000. Bit 6 indicates 
   1332                                 ; Compute nad Display required.
   1333 
   1334         LD      HL,$407D        ; The first location after System Variables -
   1335                                 ; 16509 decimal.
   1336         LD      ($400C),HL      ; set system variable D_FILE to this value.
   1337         LD      B,$19           ; prepare minimal screen of 24 NEWLINEs
   1338                                 ; following an initial NEWLINE.
   1339 
   1340 ;; LINE
   1341 L0408:  LD      (HL),$76        ; insert NEWLINE (HALT instruction)
   1342         INC     HL              ; point to next location.
   1343         DJNZ    L0408           ; loop back for all twenty five to LINE
   1344 
   1345         LD      ($4010),HL      ; set system variable VARS to next location
   1346 
   1347         CALL    L149A           ; routine CLEAR sets $80 end-marker and the 
   1348                                 ; dynamic memory pointers E_LINE, STKBOT and
   1349                                 ; STKEND.
   1350 
   1351 ;; N/L-ONLY
   1352 L0413:  CALL    L14AD           ; routine CURSOR-IN inserts the cursor and 
   1353                                 ; end-marker in the Edit Line also setting
   1354                                 ; size of lower display to two lines.
   1355 
   1356         CALL    L0207           ; routine SLOW/FAST selects COMPUTE and DISPLAY
   1357 
   1358 ; ---------------------------
   1359 ; THE 'BASIC LISTING' SECTION
   1360 ; ---------------------------
   1361 ;
   1362 ;
   1363 
   1364 ;; UPPER
   1365 L0419:  CALL    L0A2A           ; routine CLS
   1366         LD      HL,($400A)      ; sv E_PPC_lo
   1367         LD      DE,($4023)      ; sv S_TOP_lo
   1368         AND     A               ;
   1369         SBC     HL,DE           ;
   1370         EX      DE,HL           ;
   1371         JR      NC,L042D        ; to ADDR-TOP
   1372 
   1373         ADD     HL,DE           ;
   1374         LD      ($4023),HL      ; sv S_TOP_lo
   1375 
   1376 ;; ADDR-TOP
   1377 L042D:  CALL    L09D8           ; routine LINE-ADDR
   1378         JR      Z,L0433         ; to LIST-TOP
   1379 
   1380         EX      DE,HL           ;
   1381 
   1382 ;; LIST-TOP
   1383 L0433:  CALL    L073E           ; routine LIST-PROG
   1384         DEC     (IY+$1E)        ; sv BERG
   1385         JR      NZ,L0472        ; to LOWER
   1386 
   1387         LD      HL,($400A)      ; sv E_PPC_lo
   1388         CALL    L09D8           ; routine LINE-ADDR
   1389         LD      HL,($4016)      ; sv CH_ADD_lo
   1390         SCF                     ; Set Carry Flag
   1391         SBC     HL,DE           ;
   1392         LD      HL,$4023        ; sv S_TOP_lo
   1393         JR      NC,L0457        ; to INC-LINE
   1394 
   1395         EX      DE,HL           ;
   1396         LD      A,(HL)          ;
   1397         INC     HL              ;
   1398         LDI                     ;
   1399         LD      (DE),A          ;
   1400         JR       L0419          ; to UPPER
   1401 
   1402 ; ---
   1403 
   1404 ;; DOWN-KEY
   1405 L0454:  LD      HL,$400A        ; sv E_PPC_lo
   1406 
   1407 ;; INC-LINE
   1408 L0457:  LD      E,(HL)          ;
   1409         INC     HL              ;
   1410         LD      D,(HL)          ;
   1411         PUSH    HL              ;
   1412         EX      DE,HL           ;
   1413         INC     HL              ;
   1414         CALL    L09D8           ; routine LINE-ADDR
   1415         CALL    L05BB           ; routine LINE-NO
   1416         POP     HL              ;
   1417 
   1418 ;; KEY-INPUT
   1419 L0464:  BIT     5,(IY+$2D)      ; sv FLAGX
   1420         JR      NZ,L0472        ; forward to LOWER
   1421 
   1422         LD      (HL),D          ;
   1423         DEC     HL              ;
   1424         LD      (HL),E          ;
   1425         JR      L0419           ; to UPPER
   1426 
   1427 ; ----------------------------
   1428 ; THE 'EDIT LINE COPY' SECTION
   1429 ; ----------------------------
   1430 ; This routine sets the edit line to just the cursor when
   1431 ; 1) There is not enough memory to edit a BASIC line.
   1432 ; 2) The edit key is used during input.
   1433 ; The entry point LOWER
   1434 
   1435 
   1436 ;; EDIT-INP
   1437 L046F:  CALL    L14AD           ; routine CURSOR-IN sets cursor only edit line.
   1438 
   1439 ; ->
   1440 
   1441 ;; LOWER
   1442 L0472:  LD      HL,($4014)      ; fetch edit line start from E_LINE.
   1443 
   1444 ;; EACH-CHAR
   1445 L0475:  LD      A,(HL)          ; fetch a character from edit line.
   1446         CP      $7E             ; compare to the number marker.
   1447         JR      NZ,L0482        ; forward if not to END-LINE
   1448 
   1449         LD      BC,$0006        ; else six invisible bytes to be removed.
   1450         CALL    L0A60           ; routine RECLAIM-2
   1451         JR      L0475           ; back to EACH-CHAR
   1452 
   1453 ; ---
   1454 
   1455 ;; END-LINE
   1456 L0482:  CP      $76             ;
   1457         INC     HL              ;
   1458         JR      NZ,L0475        ; to EACH-CHAR
   1459 
   1460 ;; EDIT-LINE
   1461 L0487:  CALL    L0537           ; routine CURSOR sets cursor K or L.
   1462 
   1463 ;; EDIT-ROOM
   1464 L048A:  CALL    L0A1F           ; routine LINE-ENDS
   1465         LD      HL,($4014)      ; sv E_LINE_lo
   1466         LD      (IY+$00),$FF    ; sv ERR_NR
   1467         CALL    L0766           ; routine COPY-LINE
   1468         BIT     7,(IY+$00)      ; sv ERR_NR
   1469         JR      NZ,L04C1        ; to DISPLAY-6
   1470 
   1471         LD      A,($4022)       ; sv DF_SZ
   1472         CP      $18             ;
   1473         JR      NC,L04C1        ; to DISPLAY-6
   1474 
   1475         INC     A               ;
   1476         LD      ($4022),A       ; sv DF_SZ
   1477         LD      B,A             ;
   1478         LD      C,$01           ;
   1479         CALL    L0918           ; routine LOC-ADDR
   1480         LD      D,H             ;
   1481         LD      E,L             ;
   1482         LD      A,(HL)          ;
   1483 
   1484 ;; FREE-LINE
   1485 L04B1:  DEC     HL              ;
   1486         CP      (HL)            ;
   1487         JR      NZ,L04B1        ; to FREE-LINE
   1488 
   1489         INC     HL              ;
   1490         EX      DE,HL           ;
   1491         LD      A,($4005)       ; sv RAMTOP_hi
   1492         CP      $4D             ;
   1493         CALL    C,L0A5D         ; routine RECLAIM-1
   1494         JR      L048A           ; to EDIT-ROOM
   1495 
   1496 ; --------------------------
   1497 ; THE 'WAIT FOR KEY' SECTION
   1498 ; --------------------------
   1499 ;
   1500 ;
   1501 
   1502 ;; DISPLAY-6
   1503 L04C1:  LD      HL,$0000        ;
   1504         LD      ($4018),HL      ; sv X_PTR_lo
   1505 
   1506         LD      HL,$403B        ; system variable CDFLAG
   1507         BIT     7,(HL)          ;
   1508 
   1509         CALL    Z,L0229         ; routine DISPLAY-1
   1510 
   1511 ;; SLOW-DISP
   1512 L04CF:  BIT     0,(HL)          ;
   1513         JR      Z,L04CF         ; to SLOW-DISP
   1514 
   1515         LD      BC,($4025)      ; sv LAST_K
   1516         CALL    L0F4B           ; routine DEBOUNCE
   1517         CALL    L07BD           ; routine DECODE
   1518 
   1519         JR      NC,L0472        ; back to LOWER
   1520 
   1521 ; -------------------------------
   1522 ; THE 'KEYBOARD DECODING' SECTION
   1523 ; -------------------------------
   1524 ;   The decoded key value is in E and HL points to the position in the 
   1525 ;   key table. D contains zero.
   1526 
   1527 ;; K-DECODE 
   1528 L04DF:  LD      A,($4006)       ; Fetch value of system variable MODE
   1529         DEC     A               ; test the three values together
   1530 
   1531         JP      M,L0508         ; forward, if was zero, to FETCH-2
   1532 
   1533         JR      NZ,L04F7        ; forward, if was 2, to FETCH-1
   1534 
   1535 ;   The original value was one and is now zero.
   1536 
   1537         LD      ($4006),A       ; update the system variable MODE
   1538 
   1539         DEC     E               ; reduce E to range $00 - $7F
   1540         LD      A,E             ; place in A
   1541         SUB     $27             ; subtract 39 setting carry if range 00 - 38
   1542         JR      C,L04F2         ; forward, if so, to FUNC-BASE
   1543 
   1544         LD      E,A             ; else set E to reduced value
   1545 
   1546 ;; FUNC-BASE
   1547 L04F2:  LD      HL,L00CC        ; address of K-FUNCT table for function keys.
   1548         JR      L0505           ; forward to TABLE-ADD
   1549 
   1550 ; ---
   1551 
   1552 ;; FETCH-1
   1553 L04F7:  LD      A,(HL)          ;
   1554         CP      $76             ;
   1555         JR      Z,L052B         ; to K/L-KEY
   1556 
   1557         CP      $40             ;
   1558         SET     7,A             ;
   1559         JR      C,L051B         ; to ENTER
   1560 
   1561         LD      HL,$00C7        ; (expr reqd)
   1562 
   1563 ;; TABLE-ADD
   1564 L0505:  ADD     HL,DE           ;
   1565         JR      L0515           ; to FETCH-3
   1566 
   1567 ; ---
   1568 
   1569 ;; FETCH-2
   1570 L0508:  LD      A,(HL)          ;
   1571         BIT     2,(IY+$01)      ; sv FLAGS  - K or L mode ?
   1572         JR      NZ,L0516        ; to TEST-CURS
   1573 
   1574         ADD     A,$C0           ;
   1575         CP      $E6             ;
   1576         JR      NC,L0516        ; to TEST-CURS
   1577 
   1578 ;; FETCH-3
   1579 L0515:  LD      A,(HL)          ;
   1580 
   1581 ;; TEST-CURS
   1582 L0516:  CP      $F0             ;
   1583         JP      PE,L052D        ; to KEY-SORT
   1584 
   1585 ;; ENTER
   1586 L051B:  LD      E,A             ;
   1587         CALL    L0537           ; routine CURSOR
   1588 
   1589         LD      A,E             ;
   1590         CALL    L0526           ; routine ADD-CHAR
   1591 
   1592 ;; BACK-NEXT
   1593 L0523:  JP      L0472           ; back to LOWER
   1594 
   1595 ; ------------------------------
   1596 ; THE 'ADD CHARACTER' SUBROUTINE
   1597 ; ------------------------------
   1598 ;
   1599 ;
   1600 
   1601 ;; ADD-CHAR
   1602 L0526:  CALL    L099B           ; routine ONE-SPACE
   1603         LD      (DE),A          ;
   1604         RET                     ;
   1605 
   1606 ; -------------------------
   1607 ; THE 'CURSOR KEYS' ROUTINE
   1608 ; -------------------------
   1609 ;
   1610 ;
   1611 
   1612 ;; K/L-KEY
   1613 L052B:  LD      A,$78           ;
   1614 
   1615 ;; KEY-SORT
   1616 L052D:  LD      E,A             ;
   1617         LD      HL,$0482        ; base address of ED-KEYS (exp reqd)
   1618         ADD     HL,DE           ;
   1619         ADD     HL,DE           ;
   1620         LD      C,(HL)          ;
   1621         INC     HL              ;
   1622         LD      B,(HL)          ;
   1623         PUSH    BC              ;
   1624 
   1625 ;; CURSOR
   1626 L0537:  LD      HL,($4014)      ; sv E_LINE_lo
   1627         BIT     5,(IY+$2D)      ; sv FLAGX
   1628         JR      NZ,L0556        ; to L-MODE
   1629 
   1630 ;; K-MODE
   1631 L0540:  RES     2,(IY+$01)      ; sv FLAGS  - Signal use K mode
   1632 
   1633 ;; TEST-CHAR
   1634 L0544:  LD      A,(HL)          ;
   1635         CP      $7F             ;
   1636         RET     Z               ; return
   1637 
   1638         INC     HL              ;
   1639         CALL    L07B4           ; routine NUMBER
   1640         JR      Z,L0544         ; to TEST-CHAR
   1641 
   1642         CP      $26             ;
   1643         JR      C,L0544         ; to TEST-CHAR
   1644 
   1645         CP      $DE             ;
   1646         JR      Z,L0540         ; to K-MODE
   1647 
   1648 ;; L-MODE
   1649 L0556:  SET     2,(IY+$01)      ; sv FLAGS  - Signal use L mode
   1650         JR      L0544           ; to TEST-CHAR
   1651 
   1652 ; --------------------------
   1653 ; THE 'CLEAR-ONE' SUBROUTINE
   1654 ; --------------------------
   1655 ;
   1656 ;
   1657 
   1658 ;; CLEAR-ONE
   1659 L055C:  LD      BC,$0001        ;
   1660         JP      L0A60           ; to RECLAIM-2
   1661 
   1662 
   1663 
   1664 ; ------------------------
   1665 ; THE 'EDITING KEYS' TABLE
   1666 ; ------------------------
   1667 ;
   1668 ;
   1669 
   1670 ;; ED-KEYS
   1671 L0562:  DEFW    L059F           ; Address: $059F; Address: UP-KEY
   1672         DEFW    L0454           ; Address: $0454; Address: DOWN-KEY
   1673         DEFW    L0576           ; Address: $0576; Address: LEFT-KEY
   1674         DEFW    L057F           ; Address: $057F; Address: RIGHT-KEY
   1675         DEFW    L05AF           ; Address: $05AF; Address: FUNCTION
   1676         DEFW    L05C4           ; Address: $05C4; Address: EDIT-KEY
   1677         DEFW    L060C           ; Address: $060C; Address: N/L-KEY
   1678         DEFW    L058B           ; Address: $058B; Address: RUBOUT
   1679         DEFW    L05AF           ; Address: $05AF; Address: FUNCTION
   1680         DEFW    L05AF           ; Address: $05AF; Address: FUNCTION
   1681 
   1682 
   1683 ; -------------------------
   1684 ; THE 'CURSOR LEFT' ROUTINE
   1685 ; -------------------------
   1686 ;
   1687 ;
   1688 
   1689 ;; LEFT-KEY
   1690 L0576:  CALL    L0593           ; routine LEFT-EDGE
   1691         LD      A,(HL)          ;
   1692         LD      (HL),$7F        ;
   1693         INC     HL              ;
   1694         JR      L0588           ; to GET-CODE
   1695 
   1696 ; --------------------------
   1697 ; THE 'CURSOR RIGHT' ROUTINE
   1698 ; --------------------------
   1699 ;
   1700 ;
   1701 
   1702 ;; RIGHT-KEY
   1703 L057F:  INC     HL              ;
   1704         LD      A,(HL)          ;
   1705         CP      $76             ;
   1706         JR      Z,L059D         ; to ENDED-2
   1707 
   1708         LD      (HL),$7F        ;
   1709         DEC     HL              ;
   1710 
   1711 ;; GET-CODE
   1712 L0588:  LD      (HL),A          ;
   1713 
   1714 ;; ENDED-1
   1715 L0589:  JR      L0523           ; to BACK-NEXT
   1716 
   1717 ; --------------------
   1718 ; THE 'RUBOUT' ROUTINE
   1719 ; --------------------
   1720 ;
   1721 ;
   1722 
   1723 ;; RUBOUT
   1724 L058B:  CALL    L0593           ; routine LEFT-EDGE
   1725         CALL    L055C           ; routine CLEAR-ONE
   1726         JR      L0589           ; to ENDED-1
   1727 
   1728 ; ------------------------
   1729 ; THE 'ED-EDGE' SUBROUTINE
   1730 ; ------------------------
   1731 ;
   1732 ;
   1733 
   1734 ;; LEFT-EDGE
   1735 L0593:  DEC     HL              ;
   1736         LD      DE,($4014)      ; sv E_LINE_lo
   1737         LD      A,(DE)          ;
   1738         CP      $7F             ;
   1739         RET     NZ              ;
   1740 
   1741         POP     DE              ;
   1742 
   1743 ;; ENDED-2
   1744 L059D:  JR      L0589           ; to ENDED-1
   1745 
   1746 ; -----------------------
   1747 ; THE 'CURSOR UP' ROUTINE
   1748 ; -----------------------
   1749 ;
   1750 ;
   1751 
   1752 ;; UP-KEY
   1753 L059F:  LD      HL,($400A)      ; sv E_PPC_lo
   1754         CALL    L09D8           ; routine LINE-ADDR
   1755         EX      DE,HL           ;
   1756         CALL    L05BB           ; routine LINE-NO
   1757         LD      HL,$400B        ; point to system variable E_PPC_hi
   1758         JP      L0464           ; jump back to KEY-INPUT
   1759 
   1760 ; --------------------------
   1761 ; THE 'FUNCTION KEY' ROUTINE
   1762 ; --------------------------
   1763 ;
   1764 ;
   1765 
   1766 ;; FUNCTION
   1767 L05AF:  LD      A,E             ;
   1768         AND     $07             ;
   1769         LD      ($4006),A       ; sv MODE
   1770         JR      L059D           ; back to ENDED-2
   1771 
   1772 ; ------------------------------------
   1773 ; THE 'COLLECT LINE NUMBER' SUBROUTINE
   1774 ; ------------------------------------
   1775 ;
   1776 ;
   1777 
   1778 ;; ZERO-DE
   1779 L05B7:  EX      DE,HL           ;
   1780         LD      DE,L04C1 + 1    ; $04C2 - a location addressing two zeros.
   1781 
   1782 ; ->
   1783 
   1784 ;; LINE-NO
   1785 L05BB:  LD      A,(HL)          ;
   1786         AND     $C0             ;
   1787         JR      NZ,L05B7        ; to ZERO-DE
   1788 
   1789         LD      D,(HL)          ;
   1790         INC     HL              ;
   1791         LD      E,(HL)          ;
   1792         RET                     ;
   1793 
   1794 ; ----------------------
   1795 ; THE 'EDIT KEY' ROUTINE
   1796 ; ----------------------
   1797 ;
   1798 ;
   1799 
   1800 ;; EDIT-KEY
   1801 L05C4:  CALL    L0A1F           ; routine LINE-ENDS clears lower display.
   1802 
   1803         LD      HL,L046F        ; Address: EDIT-INP
   1804         PUSH    HL              ; ** is pushed as an error looping address.
   1805 
   1806         BIT     5,(IY+$2D)      ; test FLAGX
   1807         RET     NZ              ; indirect jump if in input mode
   1808                                 ; to L046F, EDIT-INP (begin again).
   1809 
   1810 ;
   1811 
   1812         LD      HL,($4014)      ; fetch E_LINE
   1813         LD      ($400E),HL      ; and use to update the screen cursor DF_CC
   1814 
   1815 ; so now RST $10 will print the line numbers to the edit line instead of screen.
   1816 ; first make sure that no newline/out of screen can occur while sprinting the
   1817 ; line numbers to the edit line.
   1818 
   1819         LD      HL,$1821        ; prepare line 0, column 0.
   1820         LD      ($4039),HL      ; update S_POSN with these dummy values.
   1821 
   1822         LD      HL,($400A)      ; fetch current line from E_PPC may be a 
   1823                                 ; non-existent line e.g. last line deleted.
   1824         CALL    L09D8           ; routine LINE-ADDR gets address or that of
   1825                                 ; the following line.
   1826         CALL    L05BB           ; routine LINE-NO gets line number if any in DE
   1827                                 ; leaving HL pointing at second low byte.
   1828 
   1829         LD      A,D             ; test the line number for zero.
   1830         OR      E               ;
   1831         RET     Z               ; return if no line number - no program to edit.
   1832 
   1833         DEC     HL              ; point to high byte.
   1834         CALL    L0AA5           ; routine OUT-NO writes number to edit line.
   1835 
   1836         INC     HL              ; point to length bytes.
   1837         LD      C,(HL)          ; low byte to C.
   1838         INC     HL              ;
   1839         LD      B,(HL)          ; high byte to B.
   1840 
   1841         INC     HL              ; point to first character in line.
   1842         LD      DE,($400E)      ; fetch display file cursor DF_CC
   1843 
   1844         LD      A,$7F           ; prepare the cursor character.
   1845         LD      (DE),A          ; and insert in edit line.
   1846         INC     DE              ; increment intended destination.
   1847 
   1848         PUSH    HL              ; * save start of BASIC.
   1849 
   1850         LD      HL,$001D        ; set an overhead of 29 bytes.
   1851         ADD     HL,DE           ; add in the address of cursor.
   1852         ADD     HL,BC           ; add the length of the line.
   1853         SBC     HL,SP           ; subtract the stack pointer.
   1854 
   1855         POP     HL              ; * restore pointer to start of BASIC.
   1856 
   1857         RET     NC              ; return if not enough room to L046F EDIT-INP.
   1858                                 ; the edit key appears not to work.
   1859 
   1860         LDIR                    ; else copy bytes from program to edit line.
   1861                                 ; Note. hidden floating point forms are also
   1862                                 ; copied to edit line.
   1863 
   1864         EX      DE,HL           ; transfer free location pointer to HL
   1865 
   1866         POP     DE              ; ** remove address EDIT-INP from stack.
   1867 
   1868         CALL    L14A6           ; routine SET-STK-B sets STKEND from HL.
   1869 
   1870         JR      L059D           ; back to ENDED-2 and after 3 more jumps
   1871                                 ; to L0472, LOWER.
   1872                                 ; Note. The LOWER routine removes the hidden 
   1873                                 ; floating-point numbers from the edit line.
   1874 
   1875 ; -------------------------
   1876 ; THE 'NEWLINE KEY' ROUTINE
   1877 ; -------------------------
   1878 ;
   1879 ;
   1880 
   1881 ;; N/L-KEY
   1882 L060C:  CALL    L0A1F           ; routine LINE-ENDS
   1883 
   1884         LD      HL,L0472        ; prepare address: LOWER
   1885 
   1886         BIT     5,(IY+$2D)      ; sv FLAGX
   1887         JR      NZ,L0629        ; to NOW-SCAN
   1888 
   1889         LD      HL,($4014)      ; sv E_LINE_lo
   1890         LD      A,(HL)          ;
   1891         CP      $FF             ;
   1892         JR      Z,L0626         ; to STK-UPPER
   1893 
   1894         CALL    L08E2           ; routine CLEAR-PRB
   1895         CALL    L0A2A           ; routine CLS
   1896 
   1897 ;; STK-UPPER
   1898 L0626:  LD      HL,L0419        ; Address: UPPER
   1899 
   1900 ;; NOW-SCAN
   1901 L0629:  PUSH    HL              ; push routine address (LOWER or UPPER).
   1902         CALL    L0CBA           ; routine LINE-SCAN
   1903         POP     HL              ;
   1904         CALL    L0537           ; routine CURSOR
   1905         CALL    L055C           ; routine CLEAR-ONE
   1906         CALL    L0A73           ; routine E-LINE-NO
   1907         JR      NZ,L064E        ; to N/L-INP
   1908 
   1909         LD      A,B             ;
   1910         OR      C               ;
   1911         JP      NZ,L06E0        ; to N/L-LINE
   1912 
   1913         DEC     BC              ;
   1914         DEC     BC              ;
   1915         LD      ($4007),BC      ; sv PPC_lo
   1916         LD      (IY+$22),$02    ; sv DF_SZ
   1917         LD      DE,($400C)      ; sv D_FILE_lo
   1918 
   1919         JR      L0661           ; forward to TEST-NULL
   1920 
   1921 ; ---
   1922 
   1923 ;; N/L-INP
   1924 L064E:  CP      $76             ;
   1925         JR      Z,L0664         ; to N/L-NULL
   1926 
   1927         LD      BC,($4030)      ; sv T_ADDR_lo
   1928         CALL    L0918           ; routine LOC-ADDR
   1929         LD      DE,($4029)      ; sv NXTLIN_lo
   1930         LD      (IY+$22),$02    ; sv DF_SZ
   1931 
   1932 ;; TEST-NULL
   1933 L0661:  RST     18H             ; GET-CHAR
   1934         CP      $76             ;
   1935 
   1936 ;; N/L-NULL
   1937 L0664:  JP      Z,L0413         ; to N/L-ONLY
   1938 
   1939         LD      (IY+$01),$80    ; sv FLAGS
   1940         EX      DE,HL           ;
   1941 
   1942 ;; NEXT-LINE
   1943 L066C:  LD      ($4029),HL      ; sv NXTLIN_lo
   1944         EX      DE,HL           ;
   1945         CALL    L004D           ; routine TEMP-PTR-2
   1946         CALL    L0CC1           ; routine LINE-RUN
   1947         RES     1,(IY+$01)      ; sv FLAGS  - Signal printer not in use
   1948         LD      A,$C0           ;
   1949         LD      (IY+$19),A      ; sv X_PTR_lo
   1950         CALL    L14A3           ; routine X-TEMP
   1951         RES     5,(IY+$2D)      ; sv FLAGX
   1952         BIT     7,(IY+$00)      ; sv ERR_NR
   1953         JR      Z,L06AE         ; to STOP-LINE
   1954 
   1955         LD      HL,($4029)      ; sv NXTLIN_lo
   1956         AND     (HL)            ;
   1957         JR       NZ,L06AE       ; to STOP-LINE
   1958 
   1959         LD      D,(HL)          ;
   1960         INC     HL              ;
   1961         LD      E,(HL)          ;
   1962         LD      ($4007),DE      ; sv PPC_lo
   1963         INC     HL              ;
   1964         LD      E,(HL)          ;
   1965         INC     HL              ;
   1966         LD      D,(HL)          ;
   1967         INC     HL              ;
   1968         EX      DE,HL           ;
   1969         ADD     HL,DE           ;
   1970         CALL    L0F46           ; routine BREAK-1
   1971         JR      C,L066C         ; to NEXT-LINE
   1972 
   1973         LD      HL,$4000        ; sv ERR_NR
   1974         BIT     7,(HL)          ;
   1975         JR      Z,L06AE         ; to STOP-LINE
   1976 
   1977         LD      (HL),$0C        ;
   1978 
   1979 ;; STOP-LINE
   1980 L06AE:  BIT     7,(IY+$38)      ; sv PR_CC
   1981         CALL    Z,L0871         ; routine COPY-BUFF
   1982         LD      BC,$0121        ;
   1983         CALL    L0918           ; routine LOC-ADDR
   1984         LD      A,($4000)       ; sv ERR_NR
   1985         LD      BC,($4007)      ; sv PPC_lo
   1986         INC     A               ;
   1987         JR      Z,L06D1         ; to REPORT
   1988 
   1989         CP      $09             ;
   1990         JR      NZ,L06CA        ; to CONTINUE
   1991 
   1992         INC     BC              ;
   1993 
   1994 ;; CONTINUE
   1995 L06CA:  LD      ($402B),BC      ; sv OLDPPC_lo
   1996         JR      NZ,L06D1        ; to REPORT
   1997 
   1998         DEC     BC              ;
   1999 
   2000 ;; REPORT
   2001 L06D1:  CALL    L07EB           ; routine OUT-CODE
   2002         LD      A,$18           ;
   2003 
   2004         RST     10H             ; PRINT-A
   2005         CALL    L0A98           ; routine OUT-NUM
   2006         CALL    L14AD           ; routine CURSOR-IN
   2007         JP      L04C1           ; to DISPLAY-6
   2008 
   2009 ; ---
   2010 
   2011 ;; N/L-LINE
   2012 L06E0:  LD      ($400A),BC      ; sv E_PPC_lo
   2013         LD      HL,($4016)      ; sv CH_ADD_lo
   2014         EX      DE,HL           ;
   2015         LD      HL,L0413        ; Address: N/L-ONLY
   2016         PUSH    HL              ;
   2017         LD      HL,($401A)      ; sv STKBOT_lo
   2018         SBC     HL,DE           ;
   2019         PUSH    HL              ;
   2020         PUSH    BC              ;
   2021         CALL    L02E7           ; routine SET-FAST
   2022         CALL    L0A2A           ; routine CLS
   2023         POP     HL              ;
   2024         CALL    L09D8           ; routine LINE-ADDR
   2025         JR      NZ,L0705        ; to COPY-OVER
   2026 
   2027         CALL    L09F2           ; routine NEXT-ONE
   2028         CALL    L0A60           ; routine RECLAIM-2
   2029 
   2030 ;; COPY-OVER
   2031 L0705:  POP     BC              ;
   2032         LD      A,C             ;
   2033         DEC     A               ;
   2034         OR      B               ;
   2035         RET     Z               ;
   2036 
   2037         PUSH    BC              ;
   2038         INC     BC              ;
   2039         INC     BC              ;
   2040         INC     BC              ;
   2041         INC     BC              ;
   2042         DEC     HL              ;
   2043         CALL    L099E           ; routine MAKE-ROOM
   2044         CALL    L0207           ; routine SLOW/FAST
   2045         POP     BC              ;
   2046         PUSH    BC              ;
   2047         INC     DE              ;
   2048         LD      HL,($401A)      ; sv STKBOT_lo
   2049         DEC     HL              ;
   2050         LDDR                    ; copy bytes
   2051         LD      HL,($400A)      ; sv E_PPC_lo
   2052         EX      DE,HL           ;
   2053         POP     BC              ;
   2054         LD      (HL),B          ;
   2055         DEC     HL              ;
   2056         LD      (HL),C          ;
   2057         DEC     HL              ;
   2058         LD      (HL),E          ;
   2059         DEC     HL              ;
   2060         LD      (HL),D          ;
   2061 
   2062         RET                     ; return.
   2063 
   2064 ; ---------------------------------------
   2065 ; THE 'LIST' AND 'LLIST' COMMAND ROUTINES
   2066 ; ---------------------------------------
   2067 ;
   2068 ;
   2069 
   2070 ;; LLIST
   2071 L072C:  SET     1,(IY+$01)      ; sv FLAGS  - signal printer in use
   2072 
   2073 ;; LIST
   2074 L0730:  CALL    L0EA7           ; routine FIND-INT
   2075 
   2076         LD      A,B             ; fetch high byte of user-supplied line number.
   2077         AND     $3F             ; and crudely limit to range 1-16383.
   2078 
   2079         LD      H,A             ;
   2080         LD      L,C             ;
   2081         LD      ($400A),HL      ; sv E_PPC_lo
   2082         CALL    L09D8           ; routine LINE-ADDR
   2083 
   2084 ;; LIST-PROG
   2085 L073E:  LD      E,$00           ;
   2086 
   2087 ;; UNTIL-END
   2088 L0740:  CALL    L0745           ; routine OUT-LINE lists one line of BASIC
   2089                                 ; making an early return when the screen is
   2090                                 ; full or the end of program is reached.    >>
   2091         JR      L0740           ; loop back to UNTIL-END
   2092 
   2093 ; -----------------------------------
   2094 ; THE 'PRINT A BASIC LINE' SUBROUTINE
   2095 ; -----------------------------------
   2096 ;
   2097 ;
   2098 
   2099 ;; OUT-LINE
   2100 L0745:  LD      BC,($400A)      ; sv E_PPC_lo
   2101         CALL    L09EA           ; routine CP-LINES
   2102         LD      D,$92           ;
   2103         JR      Z,L0755         ; to TEST-END
   2104 
   2105         LD      DE,$0000        ;
   2106         RL      E               ;
   2107 
   2108 ;; TEST-END
   2109 L0755:  LD      (IY+$1E),E      ; sv BERG
   2110         LD      A,(HL)          ;
   2111         CP      $40             ;
   2112         POP     BC              ;
   2113         RET     NC              ;
   2114 
   2115         PUSH    BC              ;
   2116         CALL    L0AA5           ; routine OUT-NO
   2117         INC     HL              ;
   2118         LD      A,D             ;
   2119 
   2120         RST     10H             ; PRINT-A
   2121         INC     HL              ;
   2122         INC     HL              ;
   2123 
   2124 ;; COPY-LINE
   2125 L0766:  LD      ($4016),HL      ; sv CH_ADD_lo
   2126         SET     0,(IY+$01)      ; sv FLAGS  - Suppress leading space
   2127 
   2128 ;; MORE-LINE
   2129 L076D:  LD      BC,($4018)      ; sv X_PTR_lo
   2130         LD      HL,($4016)      ; sv CH_ADD_lo
   2131         AND      A              ;
   2132         SBC     HL,BC           ;
   2133         JR      NZ,L077C        ; to TEST-NUM
   2134 
   2135         LD      A,$B8           ;
   2136 
   2137         RST     10H             ; PRINT-A
   2138 
   2139 ;; TEST-NUM
   2140 L077C:  LD      HL,($4016)      ; sv CH_ADD_lo
   2141         LD      A,(HL)          ;
   2142         INC     HL              ;
   2143         CALL    L07B4           ; routine NUMBER
   2144         LD      ($4016),HL      ; sv CH_ADD_lo
   2145         JR      Z,L076D         ; to MORE-LINE
   2146 
   2147         CP      $7F             ;
   2148         JR      Z,L079D         ; to OUT-CURS
   2149 
   2150         CP      $76             ;
   2151         JR      Z,L07EE         ; to OUT-CH
   2152 
   2153         BIT     6,A             ;
   2154         JR      Z,L079A         ; to NOT-TOKEN
   2155 
   2156         CALL    L094B           ; routine TOKENS
   2157         JR      L076D           ; to MORE-LINE
   2158 
   2159 ; ---
   2160 
   2161 
   2162 ;; NOT-TOKEN
   2163 L079A:  RST     10H             ; PRINT-A
   2164         JR      L076D           ; to MORE-LINE
   2165 
   2166 ; ---
   2167 
   2168 ;; OUT-CURS
   2169 L079D:  LD      A,($4006)       ; Fetch value of system variable MODE
   2170         LD      B,$AB           ; Prepare an inverse [F] for function cursor.
   2171 
   2172         AND     A               ; Test for zero -
   2173         JR      NZ,L07AA        ; forward if not to FLAGS-2
   2174 
   2175         LD      A,($4001)       ; Fetch system variable FLAGS.
   2176         LD      B,$B0           ; Prepare an inverse [K] for keyword cursor.
   2177 
   2178 ;; FLAGS-2
   2179 L07AA:  RRA                     ; 00000?00 -> 000000?0
   2180         RRA                     ; 000000?0 -> 0000000?
   2181         AND     $01             ; 0000000?    0000000x
   2182 
   2183         ADD     A,B             ; Possibly [F] -> [G]  or  [K] -> [L]
   2184 
   2185         CALL    L07F5           ; routine PRINT-SP prints character 
   2186         JR      L076D           ; back to MORE-LINE
   2187 
   2188 ; -----------------------
   2189 ; THE 'NUMBER' SUBROUTINE
   2190 ; -----------------------
   2191 ;
   2192 ;
   2193 
   2194 ;; NUMBER
   2195 L07B4:  CP      $7E             ;
   2196         RET     NZ              ;
   2197 
   2198         INC     HL              ;
   2199         INC     HL              ;
   2200         INC     HL              ;
   2201         INC     HL              ;
   2202         INC     HL              ;
   2203         RET                     ;
   2204 
   2205 ; --------------------------------
   2206 ; THE 'KEYBOARD DECODE' SUBROUTINE
   2207 ; --------------------------------
   2208 ;
   2209 ;
   2210 
   2211 ;; DECODE
   2212 L07BD:  LD      D,$00           ;
   2213         SRA     B               ;
   2214         SBC     A,A             ;
   2215         OR      $26             ;
   2216         LD      L,$05           ;
   2217         SUB     L               ;
   2218 
   2219 ;; KEY-LINE
   2220 L07C7:  ADD     A,L             ;
   2221         SCF                     ; Set Carry Flag
   2222         RR      C               ;
   2223         JR      C,L07C7         ; to KEY-LINE
   2224 
   2225         INC     C               ;
   2226         RET      NZ             ;
   2227 
   2228         LD      C,B             ;
   2229         DEC     L               ;
   2230         LD      L,$01           ;
   2231         JR      NZ,L07C7        ; to KEY-LINE
   2232 
   2233         LD      HL,$007D        ; (expr reqd)
   2234         LD      E,A             ;
   2235         ADD     HL,DE           ;
   2236         SCF                     ; Set Carry Flag
   2237         RET                     ;
   2238 
   2239 ; -------------------------
   2240 ; THE 'PRINTING' SUBROUTINE
   2241 ; -------------------------
   2242 ;
   2243 ;
   2244 
   2245 ;; LEAD-SP
   2246 L07DC:  LD      A,E             ;
   2247         AND     A               ;
   2248         RET     M               ;
   2249 
   2250         JR      L07F1           ; to PRINT-CH
   2251 
   2252 ; ---
   2253 
   2254 ;; OUT-DIGIT
   2255 L07E1:  XOR     A               ;
   2256 
   2257 ;; DIGIT-INC
   2258 L07E2:  ADD     HL,BC           ;
   2259         INC     A               ;
   2260         JR      C,L07E2         ; to DIGIT-INC
   2261 
   2262         SBC     HL,BC           ;
   2263         DEC     A               ;
   2264         JR      Z,L07DC         ; to LEAD-SP
   2265 
   2266 ;; OUT-CODE
   2267 L07EB:  LD      E,$1C           ;
   2268         ADD     A,E             ;
   2269 
   2270 ;; OUT-CH
   2271 L07EE:  AND     A               ;
   2272         JR      Z,L07F5         ; to PRINT-SP
   2273 
   2274 ;; PRINT-CH
   2275 L07F1:  RES     0,(IY+$01)      ; update FLAGS - signal leading space permitted
   2276 
   2277 ;; PRINT-SP
   2278 L07F5:  EXX                     ;
   2279         PUSH    HL              ;
   2280         BIT     1,(IY+$01)      ; test FLAGS - is printer in use ?
   2281         JR      NZ,L0802        ; to LPRINT-A
   2282 
   2283         CALL    L0808           ; routine ENTER-CH
   2284         JR      L0805           ; to PRINT-EXX
   2285 
   2286 ; ---
   2287 
   2288 ;; LPRINT-A
   2289 L0802:  CALL    L0851           ; routine LPRINT-CH
   2290 
   2291 ;; PRINT-EXX
   2292 L0805:  POP     HL              ;
   2293         EXX                     ;
   2294         RET                     ;
   2295 
   2296 ; ---
   2297 
   2298 ;; ENTER-CH
   2299 L0808:  LD      D,A             ;
   2300         LD      BC,($4039)      ; sv S_POSN_x
   2301         LD      A,C             ;
   2302         CP      $21             ;
   2303         JR      Z,L082C         ; to TEST-LOW
   2304 
   2305 ;; TEST-N/L
   2306 L0812:  LD      A,$76           ;
   2307         CP      D               ;
   2308         JR      Z,L0847         ; to WRITE-N/L
   2309 
   2310         LD      HL,($400E)      ; sv DF_CC_lo
   2311         CP      (HL)            ;
   2312         LD      A,D             ;
   2313         JR      NZ,L083E        ; to WRITE-CH
   2314 
   2315         DEC     C               ;
   2316         JR      NZ,L083A        ; to EXPAND-1
   2317 
   2318         INC     HL              ;
   2319         LD       ($400E),HL     ; sv DF_CC_lo
   2320         LD      C,$21           ;
   2321         DEC     B               ;
   2322         LD      ($4039),BC      ; sv S_POSN_x
   2323 
   2324 ;; TEST-LOW
   2325 L082C:  LD      A,B             ;
   2326         CP      (IY+$22)        ; sv DF_SZ
   2327         JR      Z,L0835         ; to REPORT-5
   2328 
   2329         AND     A               ;
   2330         JR      NZ,L0812        ; to TEST-N/L
   2331 
   2332 ;; REPORT-5
   2333 L0835:  LD      L,$04           ; 'No more room on screen'
   2334         JP      L0058           ; to ERROR-3
   2335 
   2336 ; ---
   2337 
   2338 ;; EXPAND-1
   2339 L083A:  CALL    L099B           ; routine ONE-SPACE
   2340         EX      DE,HL           ;
   2341 
   2342 ;; WRITE-CH
   2343 L083E:  LD      (HL),A          ;
   2344         INC     HL              ;
   2345         LD      ($400E),HL      ; sv DF_CC_lo
   2346         DEC     (IY+$39)        ; sv S_POSN_x
   2347         RET                     ;
   2348 
   2349 ; ---
   2350 
   2351 ;; WRITE-N/L
   2352 L0847:  LD      C,$21           ;
   2353         DEC     B               ;
   2354         SET     0,(IY+$01)      ; sv FLAGS  - Suppress leading space
   2355         JP      L0918           ; to LOC-ADDR
   2356 
   2357 ; --------------------------
   2358 ; THE 'LPRINT-CH' SUBROUTINE
   2359 ; --------------------------
   2360 ; This routine sends a character to the ZX-Printer placing the code for the
   2361 ; character in the Printer Buffer.
   2362 ; Note. PR-CC contains the low byte of the buffer address. The high order byte 
   2363 ; is always constant. 
   2364 
   2365 
   2366 ;; LPRINT-CH
   2367 L0851:  CP      $76             ; compare to NEWLINE.
   2368         JR      Z,L0871         ; forward if so to COPY-BUFF
   2369 
   2370         LD      C,A             ; take a copy of the character in C.
   2371         LD      A,($4038)       ; fetch print location from PR_CC
   2372         AND     $7F             ; ignore bit 7 to form true position.
   2373         CP      $5C             ; compare to 33rd location
   2374 
   2375         LD      L,A             ; form low-order byte.
   2376         LD      H,$40           ; the high-order byte is fixed.
   2377 
   2378         CALL    Z,L0871         ; routine COPY-BUFF to send full buffer to 
   2379                                 ; the printer if first 32 bytes full.
   2380                                 ; (this will reset HL to start.)
   2381 
   2382         LD      (HL),C          ; place character at location.
   2383         INC     L               ; increment - will not cross a 256 boundary.
   2384         LD      (IY+$38),L      ; update system variable PR_CC
   2385                                 ; automatically resetting bit 7 to show that
   2386                                 ; the buffer is not empty.
   2387         RET                     ; return.
   2388 
   2389 ; --------------------------
   2390 ; THE 'COPY' COMMAND ROUTINE
   2391 ; --------------------------
   2392 ; The full character-mapped screen is copied to the ZX-Printer.
   2393 ; All twenty-four text/graphic lines are printed.
   2394 
   2395 ;; COPY
   2396 L0869:  LD      D,$16           ; prepare to copy twenty four text lines.
   2397         LD      HL,($400C)      ; set HL to start of display file from D_FILE.
   2398         INC     HL              ; 
   2399         JR      L0876           ; forward to COPY*D
   2400 
   2401 ; ---
   2402 
   2403 ; A single character-mapped printer buffer is copied to the ZX-Printer.
   2404 
   2405 ;; COPY-BUFF
   2406 L0871:  LD      D,$01           ; prepare to copy a single text line.
   2407         LD      HL,$403C        ; set HL to start of printer buffer PRBUFF.
   2408 
   2409 ; both paths converge here.
   2410 
   2411 ;; COPY*D
   2412 L0876:  CALL    L02E7           ; routine SET-FAST
   2413 
   2414         PUSH    BC              ; *** preserve BC throughout.
   2415                                 ; a pending character may be present 
   2416                                 ; in C from LPRINT-CH
   2417 
   2418 ;; COPY-LOOP
   2419 L087A:  PUSH    HL              ; save first character of line pointer. (*)
   2420         XOR     A               ; clear accumulator.
   2421         LD      E,A             ; set pixel line count, range 0-7, to zero.
   2422 
   2423 ; this inner loop deals with each horizontal pixel line.
   2424 
   2425 ;; COPY-TIME
   2426 L087D:  OUT     ($FB),A         ; bit 2 reset starts the printer motor
   2427                                 ; with an inactive stylus - bit 7 reset.
   2428         POP     HL              ; pick up first character of line pointer (*)
   2429                                 ; on inner loop.
   2430 
   2431 ;; COPY-BRK
   2432 L0880:  CALL    L0F46           ; routine BREAK-1
   2433         JR      C,L088A         ; forward with no keypress to COPY-CONT
   2434 
   2435 ; else A will hold 11111111 0
   2436 
   2437         RRA                     ; 0111 1111
   2438         OUT     ($FB),A         ; stop ZX printer motor, de-activate stylus.
   2439 
   2440 ;; REPORT-D2
   2441 L0888:  RST     08H             ; ERROR-1
   2442         DEFB    $0C             ; Error Report: BREAK - CONT repeats
   2443 
   2444 ; ---
   2445 
   2446 ;; COPY-CONT
   2447 L088A:  IN      A,($FB)         ; read from printer port.
   2448         ADD     A,A             ; test bit 6 and 7
   2449         JP      M,L08DE         ; jump forward with no printer to COPY-END
   2450 
   2451         JR      NC,L0880        ; back if stylus not in position to COPY-BRK
   2452 
   2453         PUSH    HL              ; save first character of line pointer (*)
   2454         PUSH    DE              ; ** preserve character line and pixel line.
   2455 
   2456         LD      A,D             ; text line count to A?
   2457         CP      $02             ; sets carry if last line.
   2458         SBC     A,A             ; now $FF if last line else zero.
   2459 
   2460 ; now cleverly prepare a printer control mask setting bit 2 (later moved to 1)
   2461 ; of D to slow printer for the last two pixel lines ( E = 6 and 7)
   2462 
   2463         AND     E               ; and with pixel line offset 0-7
   2464         RLCA                    ; shift to left.
   2465         AND     E               ; and again.
   2466         LD      D,A             ; store control mask in D.
   2467 
   2468 ;; COPY-NEXT
   2469 L089C:  LD      C,(HL)          ; load character from screen or buffer.
   2470         LD      A,C             ; save a copy in C for later inverse test.
   2471         INC     HL              ; update pointer for next time.
   2472         CP      $76             ; is character a NEWLINE ?
   2473         JR      Z,L08C7         ; forward, if so, to COPY-N/L
   2474 
   2475         PUSH    HL              ; * else preserve the character pointer.
   2476 
   2477         SLA     A               ; (?) multiply by two
   2478         ADD     A,A             ; multiply by four
   2479         ADD     A,A             ; multiply by eight
   2480 
   2481         LD      H,$0F           ; load H with half the address of character set.
   2482         RL      H               ; now $1E or $1F (with carry)
   2483         ADD     A,E             ; add byte offset 0-7
   2484         LD      L,A             ; now HL addresses character source byte
   2485 
   2486         RL      C               ; test character, setting carry if inverse.
   2487         SBC     A,A             ; accumulator now $00 if normal, $FF if inverse.
   2488 
   2489         XOR     (HL)            ; combine with bit pattern at end or ROM.
   2490         LD      C,A             ; transfer the byte to C.
   2491         LD      B,$08           ; count eight bits to output.
   2492 
   2493 ;; COPY-BITS
   2494 L08B5:  LD      A,D             ; fetch speed control mask from D.
   2495         RLC     C               ; rotate a bit from output byte to carry.
   2496         RRA                     ; pick up in bit 7, speed bit to bit 1
   2497         LD      H,A             ; store aligned mask in H register.
   2498 
   2499 ;; COPY-WAIT
   2500 L08BA:  IN      A,($FB)         ; read the printer port
   2501         RRA                     ; test for alignment signal from encoder.
   2502         JR      NC,L08BA        ; loop if not present to COPY-WAIT
   2503 
   2504         LD      A,H             ; control byte to A.
   2505         OUT     ($FB),A         ; and output to printer port.
   2506         DJNZ    L08B5           ; loop for all eight bits to COPY-BITS
   2507 
   2508         POP     HL              ; * restore character pointer.
   2509         JR      L089C           ; back for adjacent character line to COPY-NEXT
   2510 
   2511 ; ---
   2512 
   2513 ; A NEWLINE has been encountered either following a text line or as the 
   2514 ; first character of the screen or printer line.
   2515 
   2516 ;; COPY-N/L
   2517 L08C7:  IN      A,($FB)         ; read printer port.
   2518         RRA                     ; wait for encoder signal.
   2519         JR      NC,L08C7        ; loop back if not to COPY-N/L
   2520 
   2521         LD      A,D             ; transfer speed mask to A.
   2522         RRCA                    ; rotate speed bit to bit 1. 
   2523                                 ; bit 7, stylus control is reset.
   2524         OUT     ($FB),A         ; set the printer speed.
   2525 
   2526         POP     DE              ; ** restore character line and pixel line.
   2527         INC     E               ; increment pixel line 0-7.
   2528         BIT     3,E             ; test if value eight reached.
   2529         JR      Z,L087D         ; back if not to COPY-TIME
   2530 
   2531 ; eight pixel lines, a text line have been completed.
   2532 
   2533         POP     BC              ; lose the now redundant first character 
   2534                                 ; pointer
   2535         DEC     D               ; decrease text line count.
   2536         JR      NZ,L087A        ; back if not zero to COPY-LOOP
   2537 
   2538         LD      A,$04           ; stop the already slowed printer motor.
   2539         OUT     ($FB),A         ; output to printer port.
   2540 
   2541 ;; COPY-END
   2542 L08DE:  CALL    L0207           ; routine SLOW/FAST
   2543         POP     BC              ; *** restore preserved BC.
   2544 
   2545 ; -------------------------------------
   2546 ; THE 'CLEAR PRINTER BUFFER' SUBROUTINE
   2547 ; -------------------------------------
   2548 ; This subroutine sets 32 bytes of the printer buffer to zero (space) and
   2549 ; the 33rd character is set to a NEWLINE.
   2550 ; This occurs after the printer buffer is sent to the printer but in addition
   2551 ; after the 24 lines of the screen are sent to the printer. 
   2552 ; Note. This is a logic error as the last operation does not involve the 
   2553 ; buffer at all. Logically one should be able to use 
   2554 ; 10 LPRINT "HELLO ";
   2555 ; 20 COPY
   2556 ; 30 LPRINT ; "WORLD"
   2557 ; and expect to see the entire greeting emerge from the printer.
   2558 ; Surprisingly this logic error was never discovered and although one can argue
   2559 ; if the above is a bug, the repetition of this error on the Spectrum was most
   2560 ; definitely a bug.
   2561 ; Since the printer buffer is fixed at the end of the system variables, and
   2562 ; the print position is in the range $3C - $5C, then bit 7 of the system
   2563 ; variable is set to show the buffer is empty and automatically reset when
   2564 ; the variable is updated with any print position - neat.
   2565 
   2566 ;; CLEAR-PRB
   2567 L08E2:  LD      HL,$405C        ; address fixed end of PRBUFF
   2568         LD      (HL),$76        ; place a newline at last position.
   2569         LD      B,$20           ; prepare to blank 32 preceding characters. 
   2570 
   2571 ;; PRB-BYTES
   2572 L08E9:  DEC     HL              ; decrement address - could be DEC L.
   2573         LD      (HL),$00        ; place a zero byte.
   2574         DJNZ    L08E9           ; loop for all thirty-two to PRB-BYTES
   2575 
   2576         LD      A,L             ; fetch character print position.
   2577         SET     7,A             ; signal the printer buffer is clear.
   2578         LD      ($4038),A       ; update one-byte system variable PR_CC
   2579         RET                     ; return.
   2580 
   2581 ; -------------------------
   2582 ; THE 'PRINT AT' SUBROUTINE
   2583 ; -------------------------
   2584 ;
   2585 ;
   2586 
   2587 ;; PRINT-AT
   2588 L08F5:  LD      A,$17           ;
   2589         SUB     B               ;
   2590         JR      C,L0905         ; to WRONG-VAL
   2591 
   2592 ;; TEST-VAL
   2593 L08FA:  CP      (IY+$22)        ; sv DF_SZ
   2594         JP      C,L0835         ; to REPORT-5
   2595 
   2596         INC     A               ;
   2597         LD      B,A             ;
   2598         LD      A,$1F           ;
   2599         SUB     C               ;
   2600 
   2601 ;; WRONG-VAL
   2602 L0905:  JP      C,L0EAD         ; to REPORT-B
   2603 
   2604         ADD     A,$02           ;
   2605         LD      C,A             ;
   2606 
   2607 ;; SET-FIELD
   2608 L090B:  BIT     1,(IY+$01)      ; sv FLAGS  - Is printer in use
   2609         JR      Z,L0918         ; to LOC-ADDR
   2610 
   2611         LD      A,$5D           ;
   2612         SUB     C               ;
   2613         LD      ($4038),A       ; sv PR_CC
   2614         RET                     ;
   2615 
   2616 ; ----------------------------
   2617 ; THE 'LOCATE ADDRESS' ROUTINE
   2618 ; ----------------------------
   2619 ;
   2620 ;
   2621 
   2622 ;; LOC-ADDR
   2623 L0918:  LD      ($4039),BC      ; sv S_POSN_x
   2624         LD      HL,($4010)      ; sv VARS_lo
   2625         LD      D,C             ;
   2626         LD      A,$22           ;
   2627         SUB     C               ;
   2628         LD      C,A             ;
   2629         LD      A,$76           ;
   2630         INC     B               ;
   2631 
   2632 ;; LOOK-BACK
   2633 L0927:  DEC     HL              ;
   2634         CP      (HL)            ;
   2635         JR      NZ,L0927        ; to LOOK-BACK
   2636 
   2637         DJNZ    L0927           ; to LOOK-BACK
   2638 
   2639         INC     HL              ;
   2640         CPIR                    ;
   2641         DEC     HL              ;
   2642         LD      ($400E),HL      ; sv DF_CC_lo
   2643         SCF                     ; Set Carry Flag
   2644         RET     PO              ;
   2645 
   2646         DEC     D               ;
   2647         RET     Z               ;
   2648 
   2649         PUSH    BC              ;
   2650         CALL    L099E           ; routine MAKE-ROOM
   2651         POP     BC              ;
   2652         LD      B,C             ;
   2653         LD      H,D             ;
   2654         LD       L,E            ;
   2655 
   2656 ;; EXPAND-2
   2657 L0940:  LD      (HL),$00        ;
   2658         DEC     HL              ;
   2659         DJNZ    L0940           ; to EXPAND-2
   2660 
   2661         EX      DE,HL           ;
   2662         INC     HL              ;
   2663         LD      ($400E),HL      ; sv DF_CC_lo
   2664         RET                     ;
   2665 
   2666 ; ------------------------------
   2667 ; THE 'EXPAND TOKENS' SUBROUTINE
   2668 ; ------------------------------
   2669 ;
   2670 ;
   2671 
   2672 ;; TOKENS
   2673 L094B:  PUSH    AF              ;
   2674         CALL    L0975           ; routine TOKEN-ADD
   2675         JR      NC,L0959        ; to ALL-CHARS
   2676 
   2677         BIT     0,(IY+$01)      ; sv FLAGS  - Leading space if set
   2678         JR      NZ,L0959        ; to ALL-CHARS
   2679 
   2680         XOR     A               ;
   2681 
   2682         RST     10H             ; PRINT-A
   2683 
   2684 ;; ALL-CHARS
   2685 L0959:  LD      A,(BC)          ;
   2686         AND     $3F             ;
   2687 
   2688         RST     10H             ; PRINT-A
   2689         LD      A,(BC)          ;
   2690         INC     BC              ;
   2691         ADD     A,A             ;
   2692         JR      NC,L0959        ; to ALL-CHARS
   2693 
   2694         POP     BC              ;
   2695         BIT     7,B             ;
   2696         RET     Z               ;
   2697 
   2698         CP      $1A             ;
   2699         JR      Z,L096D         ; to TRAIL-SP
   2700 
   2701         CP      $38             ;
   2702         RET     C               ;
   2703 
   2704 ;; TRAIL-SP
   2705 L096D:  XOR     A               ;
   2706         SET     0,(IY+$01)      ; sv FLAGS  - Suppress leading space
   2707         JP      L07F5           ; to PRINT-SP
   2708 
   2709 ; ---
   2710 
   2711 ;; TOKEN-ADD
   2712 L0975:  PUSH    HL              ;
   2713         LD      HL,L0111        ; Address of TOKENS
   2714         BIT     7,A             ;
   2715         JR      Z,L097F         ; to TEST-HIGH
   2716 
   2717         AND     $3F             ;
   2718 
   2719 ;; TEST-HIGH
   2720 L097F:  CP      $43             ;
   2721         JR      NC,L0993        ; to FOUND
   2722 
   2723         LD      B,A             ;
   2724         INC     B               ;
   2725 
   2726 ;; WORDS
   2727 L0985:  BIT     7,(HL)          ;
   2728         INC     HL              ;
   2729         JR      Z,L0985         ; to WORDS
   2730 
   2731         DJNZ    L0985           ; to WORDS
   2732 
   2733         BIT     6,A             ;
   2734         JR      NZ,L0992        ; to COMP-FLAG
   2735 
   2736         CP      $18             ;
   2737 
   2738 ;; COMP-FLAG
   2739 L0992:  CCF                     ; Complement Carry Flag
   2740 
   2741 ;; FOUND
   2742 L0993:  LD      B,H             ;
   2743         LD       C,L            ;
   2744         POP     HL              ;
   2745         RET     NC              ;
   2746 
   2747         LD      A,(BC)          ;
   2748         ADD     A,$E4           ;
   2749         RET                     ;
   2750 
   2751 ; --------------------------
   2752 ; THE 'ONE SPACE' SUBROUTINE
   2753 ; --------------------------
   2754 ;
   2755 ;
   2756 
   2757 ;; ONE-SPACE
   2758 L099B:  LD      BC,$0001        ;
   2759 
   2760 ; --------------------------
   2761 ; THE 'MAKE ROOM' SUBROUTINE
   2762 ; --------------------------
   2763 ;
   2764 ;
   2765 
   2766 ;; MAKE-ROOM
   2767 L099E:  PUSH    HL              ;
   2768         CALL    L0EC5           ; routine TEST-ROOM
   2769         POP     HL              ;
   2770         CALL    L09AD           ; routine POINTERS
   2771         LD      HL,($401C)      ; sv STKEND_lo
   2772         EX      DE,HL           ;
   2773         LDDR                    ; Copy Bytes
   2774         RET                     ;
   2775 
   2776 ; -------------------------
   2777 ; THE 'POINTERS' SUBROUTINE
   2778 ; -------------------------
   2779 ;
   2780 ;
   2781 
   2782 ;; POINTERS
   2783 L09AD:  PUSH    AF              ;
   2784         PUSH    HL              ;
   2785         LD      HL,$400C        ; sv D_FILE_lo
   2786         LD      A,$09           ;
   2787 
   2788 ;; NEXT-PTR
   2789 L09B4:  LD      E,(HL)          ;
   2790         INC     HL              ;
   2791         LD      D,(HL)          ;
   2792         EX      (SP),HL         ;
   2793         AND     A               ;
   2794         SBC     HL,DE           ;
   2795         ADD     HL,DE           ;
   2796         EX      (SP),HL         ;
   2797         JR      NC,L09C8        ; to PTR-DONE
   2798 
   2799         PUSH    DE              ;
   2800         EX      DE,HL           ;
   2801         ADD     HL,BC           ;
   2802         EX      DE,HL           ;
   2803         LD      (HL),D          ;
   2804         DEC     HL              ;
   2805         LD      (HL),E          ;
   2806         INC     HL              ;
   2807         POP     DE              ;
   2808 
   2809 ;; PTR-DONE
   2810 L09C8:  INC     HL              ;
   2811         DEC     A               ;
   2812         JR      NZ,L09B4        ; to NEXT-PTR
   2813 
   2814         EX      DE,HL           ;
   2815         POP     DE              ;
   2816         POP     AF              ;
   2817         AND     A               ;
   2818         SBC     HL,DE           ;
   2819         LD      B,H             ;
   2820         LD      C,L             ;
   2821         INC     BC              ;
   2822         ADD     HL,DE           ;
   2823         EX      DE,HL           ;
   2824         RET                     ;
   2825 
   2826 ; -----------------------------
   2827 ; THE 'LINE ADDRESS' SUBROUTINE
   2828 ; -----------------------------
   2829 ;
   2830 ;
   2831 
   2832 ;; LINE-ADDR
   2833 L09D8:  PUSH    HL              ;
   2834         LD      HL,$407D        ;
   2835         LD      D,H             ;
   2836         LD      E,L             ;
   2837 
   2838 ;; NEXT-TEST
   2839 L09DE:  POP     BC              ;
   2840         CALL    L09EA           ; routine CP-LINES
   2841         RET     NC              ;
   2842 
   2843         PUSH    BC              ;
   2844         CALL     L09F2          ; routine NEXT-ONE
   2845         EX      DE,HL           ;
   2846         JR      L09DE           ; to NEXT-TEST
   2847 
   2848 ; -------------------------------------
   2849 ; THE 'COMPARE LINE NUMBERS' SUBROUTINE
   2850 ; -------------------------------------
   2851 ;
   2852 ;
   2853 
   2854 ;; CP-LINES
   2855 L09EA:  LD      A,(HL)          ;
   2856         CP      B               ;
   2857         RET     NZ              ;
   2858 
   2859         INC     HL              ;
   2860         LD      A,(HL)          ;
   2861         DEC     HL              ;
   2862         CP      C               ;
   2863         RET                     ;
   2864 
   2865 ; --------------------------------------
   2866 ; THE 'NEXT LINE OR VARIABLE' SUBROUTINE
   2867 ; --------------------------------------
   2868 ;
   2869 ;
   2870 
   2871 ;; NEXT-ONE
   2872 L09F2:  PUSH    HL              ;
   2873         LD      A,(HL)          ;
   2874         CP      $40             ;
   2875         JR      C,L0A0F         ; to LINES
   2876 
   2877         BIT     5,A             ;
   2878         JR      Z,L0A10         ; forward to NEXT-O-4
   2879 
   2880         ADD     A,A             ;
   2881         JP      M,L0A01         ; to NEXT+FIVE
   2882 
   2883         CCF                     ; Complement Carry Flag
   2884 
   2885 ;; NEXT+FIVE
   2886 L0A01:  LD      BC,$0005        ;
   2887         JR      NC,L0A08        ; to NEXT-LETT
   2888 
   2889         LD      C,$11           ;
   2890 
   2891 ;; NEXT-LETT
   2892 L0A08:  RLA                     ;
   2893         INC     HL              ;
   2894         LD      A,(HL)          ;
   2895         JR      NC,L0A08        ; to NEXT-LETT
   2896 
   2897         JR      L0A15           ; to NEXT-ADD
   2898 
   2899 ; ---
   2900 
   2901 ;; LINES
   2902 L0A0F:  INC     HL              ;
   2903 
   2904 ;; NEXT-O-4
   2905 L0A10:  INC     HL              ;
   2906         LD      C,(HL)          ;
   2907         INC     HL              ;
   2908         LD      B,(HL)          ;
   2909         INC     HL              ;
   2910 
   2911 ;; NEXT-ADD
   2912 L0A15:  ADD     HL,BC           ;
   2913         POP     DE              ;
   2914 
   2915 ; ---------------------------
   2916 ; THE 'DIFFERENCE' SUBROUTINE
   2917 ; ---------------------------
   2918 ;
   2919 ;
   2920 
   2921 ;; DIFFER
   2922 L0A17:  AND     A               ;
   2923         SBC     HL,DE           ;
   2924         LD      B,H             ;
   2925         LD      C,L             ;
   2926         ADD     HL,DE           ;
   2927         EX      DE,HL           ;
   2928         RET                     ;
   2929 
   2930 ; --------------------------
   2931 ; THE 'LINE-ENDS' SUBROUTINE
   2932 ; --------------------------
   2933 ;
   2934 ;
   2935 
   2936 ;; LINE-ENDS
   2937 L0A1F:  LD      B,(IY+$22)      ; sv DF_SZ
   2938         PUSH    BC              ;
   2939         CALL    L0A2C           ; routine B-LINES
   2940         POP     BC              ;
   2941         DEC     B               ;
   2942         JR      L0A2C           ; to B-LINES
   2943 
   2944 ; -------------------------
   2945 ; THE 'CLS' COMMAND ROUTINE
   2946 ; -------------------------
   2947 ;
   2948 ;
   2949 
   2950 ;; CLS
   2951 L0A2A:  LD      B,$18           ;
   2952 
   2953 ;; B-LINES
   2954 L0A2C:  RES     1,(IY+$01)      ; sv FLAGS  - Signal printer not in use
   2955         LD      C,$21           ;
   2956         PUSH    BC              ;
   2957         CALL    L0918           ; routine LOC-ADDR
   2958         POP     BC              ;
   2959         LD      A,($4005)       ; sv RAMTOP_hi
   2960         CP      $4D             ;
   2961         JR      C,L0A52         ; to COLLAPSED
   2962 
   2963         SET     7,(IY+$3A)      ; sv S_POSN_y
   2964 
   2965 ;; CLEAR-LOC
   2966 L0A42:  XOR     A               ; prepare a space
   2967         CALL    L07F5           ; routine PRINT-SP prints a space
   2968         LD      HL,($4039)      ; sv S_POSN_x
   2969         LD      A,L             ;
   2970         OR      H               ;
   2971         AND     $7E             ;
   2972         JR      NZ,L0A42        ; to CLEAR-LOC
   2973 
   2974         JP      L0918           ; to LOC-ADDR
   2975 
   2976 ; ---
   2977 
   2978 ;; COLLAPSED
   2979 L0A52:  LD      D,H             ;
   2980         LD      E,L             ;
   2981         DEC     HL              ;
   2982         LD      C,B             ;
   2983         LD      B,$00           ;
   2984         LDIR                    ; Copy Bytes
   2985         LD      HL,($4010)      ; sv VARS_lo
   2986 
   2987 ; ----------------------------
   2988 ; THE 'RECLAIMING' SUBROUTINES
   2989 ; ----------------------------
   2990 ;
   2991 ;
   2992 
   2993 ;; RECLAIM-1
   2994 L0A5D:  CALL    L0A17           ; routine DIFFER
   2995 
   2996 ;; RECLAIM-2
   2997 L0A60:  PUSH    BC              ;
   2998         LD      A,B             ;
   2999         CPL                     ;
   3000         LD      B,A             ;
   3001         LD      A,C             ;
   3002         CPL                     ;
   3003         LD      C,A             ;
   3004         INC     BC              ;
   3005         CALL    L09AD           ; routine POINTERS
   3006         EX      DE,HL           ;
   3007         POP     HL              ;
   3008         ADD     HL,DE           ;
   3009         PUSH    DE              ;
   3010         LDIR                    ; Copy Bytes
   3011         POP     HL              ;
   3012         RET                     ;
   3013 
   3014 ; ------------------------------
   3015 ; THE 'E-LINE NUMBER' SUBROUTINE
   3016 ; ------------------------------
   3017 ;
   3018 ;
   3019 
   3020 ;; E-LINE-NO
   3021 L0A73:  LD      HL,($4014)      ; sv E_LINE_lo
   3022         CALL    L004D           ; routine TEMP-PTR-2
   3023 
   3024         RST     18H             ; GET-CHAR
   3025         BIT     5,(IY+$2D)      ; sv FLAGX
   3026         RET     NZ              ;
   3027 
   3028         LD      HL,$405D        ; sv MEM-0-1st
   3029         LD      ($401C),HL      ; sv STKEND_lo
   3030         CALL    L1548           ; routine INT-TO-FP
   3031         CALL    L158A           ; routine FP-TO-BC
   3032         JR      C,L0A91         ; to NO-NUMBER
   3033 
   3034         LD      HL,$D8F0        ; value '-10000'
   3035         ADD     HL,BC           ;
   3036 
   3037 ;; NO-NUMBER
   3038 L0A91:  JP      C,L0D9A         ; to REPORT-C
   3039 
   3040         CP      A               ;
   3041         JP      L14BC           ; routine SET-MIN
   3042 
   3043 ; -------------------------------------------------
   3044 ; THE 'REPORT AND LINE NUMBER' PRINTING SUBROUTINES
   3045 ; -------------------------------------------------
   3046 ;
   3047 ;
   3048 
   3049 ;; OUT-NUM
   3050 L0A98:  PUSH    DE              ;
   3051         PUSH    HL              ;
   3052         XOR     A               ;
   3053         BIT     7,B             ;
   3054         JR      NZ,L0ABF        ; to UNITS
   3055 
   3056         LD       H,B            ;
   3057         LD      L,C             ;
   3058         LD      E,$FF           ;
   3059         JR      L0AAD           ; to THOUSAND
   3060 
   3061 ; ---
   3062 
   3063 ;; OUT-NO
   3064 L0AA5:  PUSH    DE              ;
   3065         LD      D,(HL)          ;
   3066         INC     HL              ;
   3067         LD      E,(HL)          ;
   3068         PUSH    HL              ;
   3069         EX      DE,HL           ;
   3070         LD      E,$00           ; set E to leading space.
   3071 
   3072 ;; THOUSAND
   3073 L0AAD:  LD      BC,$FC18        ;
   3074         CALL    L07E1           ; routine OUT-DIGIT
   3075         LD      BC,$FF9C        ;
   3076         CALL    L07E1           ; routine OUT-DIGIT
   3077         LD      C,$F6           ;
   3078         CALL    L07E1           ; routine OUT-DIGIT
   3079         LD      A,L             ;
   3080 
   3081 ;; UNITS
   3082 L0ABF:  CALL    L07EB           ; routine OUT-CODE
   3083         POP     HL              ;
   3084         POP     DE              ;
   3085         RET                     ;
   3086 
   3087 ; --------------------------
   3088 ; THE 'UNSTACK-Z' SUBROUTINE
   3089 ; --------------------------
   3090 ; This subroutine is used to return early from a routine when checking syntax.
   3091 ; On the ZX81 the same routines that execute commands also check the syntax
   3092 ; on line entry. This enables precise placement of the error marker in a line
   3093 ; that fails syntax.
   3094 ; The sequence CALL SYNTAX-Z ; RET Z can be replaced by a call to this routine
   3095 ; although it has not replaced every occurrence of the above two instructions.
   3096 ; Even on the ZX-80 this routine was not fully utilized.
   3097 
   3098 ;; UNSTACK-Z
   3099 L0AC5:  CALL    L0DA6           ; routine SYNTAX-Z resets the ZERO flag if
   3100                                 ; checking syntax.
   3101         POP     HL              ; drop the return address.
   3102         RET     Z               ; return to previous calling routine if 
   3103                                 ; checking syntax.
   3104 
   3105         JP      (HL)            ; else jump to the continuation address in
   3106                                 ; the calling routine as RET would have done.
   3107 
   3108 ; ----------------------------
   3109 ; THE 'LPRINT' COMMAND ROUTINE
   3110 ; ----------------------------
   3111 ;
   3112 ;
   3113 
   3114 ;; LPRINT
   3115 L0ACB:  SET     1,(IY+$01)      ; sv FLAGS  - Signal printer in use
   3116 
   3117 ; ---------------------------
   3118 ; THE 'PRINT' COMMAND ROUTINE
   3119 ; ---------------------------
   3120 ;
   3121 ;
   3122 
   3123 ;; PRINT
   3124 L0ACF:  LD      A,(HL)          ;
   3125         CP      $76             ;
   3126         JP      Z,L0B84         ; to PRINT-END
   3127 
   3128 ;; PRINT-1
   3129 L0AD5:  SUB     $1A             ;
   3130         ADC     A,$00           ;
   3131         JR      Z,L0B44         ; to SPACING
   3132 
   3133         CP      $A7             ;
   3134         JR      NZ,L0AFA        ; to NOT-AT
   3135 
   3136 
   3137         RST     20H             ; NEXT-CHAR
   3138         CALL    L0D92           ; routine CLASS-6
   3139         CP      $1A             ;
   3140         JP      NZ,L0D9A        ; to REPORT-C
   3141 
   3142 
   3143         RST     20H             ; NEXT-CHAR
   3144         CALL    L0D92           ; routine CLASS-6
   3145         CALL    L0B4E           ; routine SYNTAX-ON
   3146 
   3147         RST     28H             ;; FP-CALC
   3148         DEFB    $01             ;;exchange
   3149         DEFB    $34             ;;end-calc
   3150 
   3151         CALL    L0BF5           ; routine STK-TO-BC
   3152         CALL    L08F5           ; routine PRINT-AT
   3153         JR      L0B37           ; to PRINT-ON
   3154 
   3155 ; ---
   3156 
   3157 ;; NOT-AT
   3158 L0AFA:  CP      $A8             ;
   3159         JR      NZ,L0B31        ; to NOT-TAB
   3160 
   3161 
   3162         RST     20H             ; NEXT-CHAR
   3163         CALL    L0D92           ; routine CLASS-6
   3164         CALL    L0B4E           ; routine SYNTAX-ON
   3165         CALL    L0C02           ; routine STK-TO-A
   3166         JP      NZ,L0EAD        ; to REPORT-B
   3167 
   3168         AND     $1F             ;
   3169         LD      C,A             ;
   3170         BIT     1,(IY+$01)      ; sv FLAGS  - Is printer in use
   3171         JR      Z,L0B1E         ; to TAB-TEST
   3172 
   3173         SUB     (IY+$38)        ; sv PR_CC
   3174         SET     7,A             ;
   3175         ADD     A,$3C           ;
   3176         CALL    NC,L0871        ; routine COPY-BUFF
   3177 
   3178 ;; TAB-TEST
   3179 L0B1E:  ADD     A,(IY+$39)      ; sv S_POSN_x
   3180         CP      $21             ;
   3181         LD      A,($403A)       ; sv S_POSN_y
   3182         SBC     A,$01           ;
   3183         CALL    L08FA           ; routine TEST-VAL
   3184         SET     0,(IY+$01)      ; sv FLAGS  - Suppress leading space
   3185         JR      L0B37           ; to PRINT-ON
   3186 
   3187 ; ---
   3188 
   3189 ;; NOT-TAB
   3190 L0B31:  CALL    L0F55           ; routine SCANNING
   3191         CALL    L0B55           ; routine PRINT-STK
   3192 
   3193 ;; PRINT-ON
   3194 L0B37:  RST     18H             ; GET-CHAR
   3195         SUB     $1A             ;
   3196         ADC     A,$00           ;
   3197         JR      Z,L0B44         ; to SPACING
   3198 
   3199         CALL    L0D1D           ; routine CHECK-END
   3200         JP      L0B84           ;;; to PRINT-END
   3201 
   3202 ; ---
   3203 
   3204 ;; SPACING
   3205 L0B44:  CALL    NC,L0B8B        ; routine FIELD
   3206 
   3207         RST     20H             ; NEXT-CHAR
   3208         CP      $76             ;
   3209         RET     Z               ;
   3210 
   3211         JP      L0AD5           ;;; to PRINT-1
   3212 
   3213 ; ---
   3214 
   3215 ;; SYNTAX-ON
   3216 L0B4E:  CALL    L0DA6           ; routine SYNTAX-Z
   3217         RET     NZ              ;
   3218 
   3219         POP     HL              ;
   3220         JR      L0B37           ; to PRINT-ON
   3221 
   3222 ; ---
   3223 
   3224 ;; PRINT-STK
   3225 L0B55:  CALL    L0AC5           ; routine UNSTACK-Z
   3226         BIT     6,(IY+$01)      ; sv FLAGS  - Numeric or string result?
   3227         CALL    Z,L13F8         ; routine STK-FETCH
   3228         JR      Z,L0B6B         ; to PR-STR-4
   3229 
   3230         JP      L15DB           ; jump forward to PRINT-FP
   3231 
   3232 ; ---
   3233 
   3234 ;; PR-STR-1
   3235 L0B64:  LD      A,$0B           ;
   3236 
   3237 ;; PR-STR-2
   3238 L0B66:  RST     10H             ; PRINT-A
   3239 
   3240 ;; PR-STR-3
   3241 L0B67:  LD      DE,($4018)      ; sv X_PTR_lo
   3242 
   3243 ;; PR-STR-4
   3244 L0B6B:  LD      A,B             ;
   3245         OR      C               ;
   3246         DEC     BC              ;
   3247         RET     Z               ;
   3248 
   3249         LD      A,(DE)          ;
   3250         INC     DE              ;
   3251         LD      ($4018),DE      ; sv X_PTR_lo
   3252         BIT      6,A            ;
   3253         JR      Z,L0B66         ; to PR-STR-2
   3254 
   3255         CP      $C0             ;
   3256         JR      Z,L0B64         ; to PR-STR-1
   3257 
   3258         PUSH    BC              ;
   3259         CALL    L094B           ; routine TOKENS
   3260         POP     BC              ;
   3261         JR      L0B67           ; to PR-STR-3
   3262 
   3263 ; ---
   3264 
   3265 ;; PRINT-END
   3266 L0B84:  CALL    L0AC5           ; routine UNSTACK-Z
   3267         LD      A,$76           ;
   3268 
   3269         RST     10H             ; PRINT-A
   3270         RET                     ;
   3271 
   3272 ; ---
   3273 
   3274 ;; FIELD
   3275 L0B8B:  CALL    L0AC5           ; routine UNSTACK-Z
   3276         SET     0,(IY+$01)      ; sv FLAGS  - Suppress leading space
   3277         XOR     A               ;
   3278 
   3279         RST     10H             ; PRINT-A
   3280         LD      BC,($4039)      ; sv S_POSN_x
   3281         LD      A,C             ;
   3282         BIT     1,(IY+$01)      ; sv FLAGS  - Is printer in use
   3283         JR      Z,L0BA4         ; to CENTRE
   3284 
   3285         LD      A,$5D           ;
   3286         SUB     (IY+$38)        ; sv PR_CC
   3287 
   3288 ;; CENTRE
   3289 L0BA4:  LD      C,$11           ;
   3290         CP      C               ;
   3291         JR      NC,L0BAB        ; to RIGHT
   3292 
   3293         LD      C,$01           ;
   3294 
   3295 ;; RIGHT
   3296 L0BAB:  CALL    L090B           ; routine SET-FIELD
   3297         RET                     ;
   3298 
   3299 ; --------------------------------------
   3300 ; THE 'PLOT AND UNPLOT' COMMAND ROUTINES
   3301 ; --------------------------------------
   3302 ;
   3303 ;
   3304 
   3305 ;; PLOT/UNP
   3306 L0BAF:  CALL    L0BF5           ; routine STK-TO-BC
   3307         LD      ($4036),BC      ; sv COORDS_x
   3308         LD      A,$2B           ;
   3309         SUB     B               ;
   3310         JP      C,L0EAD         ; to REPORT-B
   3311 
   3312         LD      B,A             ;
   3313         LD      A,$01           ;
   3314         SRA     B               ;
   3315         JR      NC,L0BC5        ; to COLUMNS
   3316 
   3317         LD      A,$04           ;
   3318 
   3319 ;; COLUMNS
   3320 L0BC5:  SRA     C               ;
   3321         JR      NC,L0BCA        ; to FIND-ADDR
   3322 
   3323         RLCA                    ;
   3324 
   3325 ;; FIND-ADDR
   3326 L0BCA:  PUSH    AF              ;
   3327         CALL    L08F5           ; routine PRINT-AT
   3328         LD      A,(HL)          ;
   3329         RLCA                    ;
   3330         CP      $10             ;
   3331         JR      NC,L0BDA        ; to TABLE-PTR
   3332 
   3333         RRCA                    ;
   3334         JR      NC,L0BD9        ; to SQ-SAVED
   3335 
   3336         XOR     $8F             ;
   3337 
   3338 ;; SQ-SAVED
   3339 L0BD9:  LD      B,A             ;
   3340 
   3341 ;; TABLE-PTR
   3342 L0BDA:  LD      DE,L0C9E        ; Address: P-UNPLOT
   3343         LD      A,($4030)       ; sv T_ADDR_lo
   3344         SUB     E               ;
   3345         JP      M,L0BE9         ; to PLOT
   3346 
   3347         POP     AF              ;
   3348         CPL                     ;
   3349         AND     B               ;
   3350         JR      L0BEB           ; to UNPLOT
   3351 
   3352 ; ---
   3353 
   3354 ;; PLOT
   3355 L0BE9:  POP     AF              ;
   3356         OR      B               ;
   3357 
   3358 ;; UNPLOT
   3359 L0BEB:  CP      $08             ;
   3360         JR      C,L0BF1         ; to PLOT-END
   3361 
   3362         XOR     $8F             ;
   3363 
   3364 ;; PLOT-END
   3365 L0BF1:  EXX                     ;
   3366 
   3367         RST     10H             ; PRINT-A
   3368         EXX                     ;
   3369         RET                     ;
   3370 
   3371 ; ----------------------------
   3372 ; THE 'STACK-TO-BC' SUBROUTINE
   3373 ; ----------------------------
   3374 ;
   3375 ;
   3376 
   3377 ;; STK-TO-BC
   3378 L0BF5:  CALL    L0C02           ; routine STK-TO-A
   3379         LD      B,A             ;
   3380         PUSH    BC              ;
   3381         CALL    L0C02           ; routine STK-TO-A
   3382         LD      E,C             ;
   3383         POP     BC              ;
   3384         LD      D,C             ;
   3385         LD      C,A             ;
   3386         RET                     ;
   3387 
   3388 ; ---------------------------
   3389 ; THE 'STACK-TO-A' SUBROUTINE
   3390 ; ---------------------------
   3391 ;
   3392 ;
   3393 
   3394 ;; STK-TO-A
   3395 L0C02:  CALL    L15CD           ; routine FP-TO-A
   3396         JP      C,L0EAD         ; to REPORT-B
   3397 
   3398         LD      C,$01           ;
   3399         RET     Z               ;
   3400 
   3401         LD      C,$FF           ;
   3402         RET                     ;
   3403 
   3404 ; -----------------------
   3405 ; THE 'SCROLL' SUBROUTINE
   3406 ; -----------------------
   3407 ;
   3408 ;
   3409 
   3410 ;; SCROLL
   3411 L0C0E:  LD      B,(IY+$22)      ; sv DF_SZ
   3412         LD      C,$21           ;
   3413         CALL    L0918           ; routine LOC-ADDR
   3414         CALL    L099B           ; routine ONE-SPACE
   3415         LD      A,(HL)          ;
   3416         LD      (DE),A          ;
   3417         INC     (IY+$3A)        ; sv S_POSN_y
   3418         LD      HL,($400C)      ; sv D_FILE_lo
   3419         INC     HL              ;
   3420         LD      D,H             ;
   3421         LD      E,L             ;
   3422         CPIR                    ;
   3423         JP      L0A5D           ; to RECLAIM-1
   3424 
   3425 ; -------------------
   3426 ; THE 'SYNTAX' TABLES
   3427 ; -------------------
   3428 
   3429 ; i) The Offset table
   3430 
   3431 ;; offset-t
   3432 L0C29:  DEFB    L0CB4 - $       ; 8B offset to; Address: P-LPRINT
   3433         DEFB    L0CB7 - $       ; 8D offset to; Address: P-LLIST
   3434         DEFB    L0C58 - $       ; 2D offset to; Address: P-STOP
   3435         DEFB    L0CAB - $       ; 7F offset to; Address: P-SLOW
   3436         DEFB    L0CAE - $       ; 81 offset to; Address: P-FAST
   3437         DEFB    L0C77 - $       ; 49 offset to; Address: P-NEW
   3438         DEFB    L0CA4 - $       ; 75 offset to; Address: P-SCROLL
   3439         DEFB    L0C8F - $       ; 5F offset to; Address: P-CONT
   3440         DEFB    L0C71 - $       ; 40 offset to; Address: P-DIM
   3441         DEFB    L0C74 - $       ; 42 offset to; Address: P-REM
   3442         DEFB    L0C5E - $       ; 2B offset to; Address: P-FOR
   3443         DEFB    L0C4B - $       ; 17 offset to; Address: P-GOTO
   3444         DEFB    L0C54 - $       ; 1F offset to; Address: P-GOSUB
   3445         DEFB    L0C6D - $       ; 37 offset to; Address: P-INPUT
   3446         DEFB    L0C89 - $       ; 52 offset to; Address: P-LOAD
   3447         DEFB    L0C7D - $       ; 45 offset to; Address: P-LIST
   3448         DEFB    L0C48 - $       ; 0F offset to; Address: P-LET
   3449         DEFB    L0CA7 - $       ; 6D offset to; Address: P-PAUSE
   3450         DEFB    L0C66 - $       ; 2B offset to; Address: P-NEXT
   3451         DEFB    L0C80 - $       ; 44 offset to; Address: P-POKE
   3452         DEFB    L0C6A - $       ; 2D offset to; Address: P-PRINT
   3453         DEFB    L0C98 - $       ; 5A offset to; Address: P-PLOT
   3454         DEFB    L0C7A - $       ; 3B offset to; Address: P-RUN
   3455         DEFB    L0C8C - $       ; 4C offset to; Address: P-SAVE
   3456         DEFB    L0C86 - $       ; 45 offset to; Address: P-RAND
   3457         DEFB    L0C4F - $       ; 0D offset to; Address: P-IF
   3458         DEFB    L0C95 - $       ; 52 offset to; Address: P-CLS
   3459         DEFB    L0C9E - $       ; 5A offset to; Address: P-UNPLOT
   3460         DEFB    L0C92 - $       ; 4D offset to; Address: P-CLEAR
   3461         DEFB    L0C5B - $       ; 15 offset to; Address: P-RETURN
   3462         DEFB    L0CB1 - $       ; 6A offset to; Address: P-COPY
   3463 
   3464 ; ii) The parameter table.
   3465 
   3466 
   3467 ;; P-LET
   3468 L0C48:  DEFB    $01             ; Class-01 - A variable is required.
   3469         DEFB    $14             ; Separator:  '='
   3470         DEFB    $02             ; Class-02 - An expression, numeric or string,
   3471                                 ; must follow.
   3472 
   3473 ;; P-GOTO
   3474 L0C4B:  DEFB    $06             ; Class-06 - A numeric expression must follow.
   3475         DEFB    $00             ; Class-00 - No further operands.
   3476         DEFW    L0E81           ; Address: $0E81; Address: GOTO
   3477 
   3478 ;; P-IF
   3479 L0C4F:  DEFB    $06             ; Class-06 - A numeric expression must follow.
   3480         DEFB    $DE             ; Separator:  'THEN'
   3481         DEFB    $05             ; Class-05 - Variable syntax checked entirely
   3482                                 ; by routine.
   3483         DEFW    L0DAB           ; Address: $0DAB; Address: IF
   3484 
   3485 ;; P-GOSUB
   3486 L0C54:  DEFB    $06             ; Class-06 - A numeric expression must follow.
   3487         DEFB    $00             ; Class-00 - No further operands.
   3488         DEFW    L0EB5           ; Address: $0EB5; Address: GOSUB
   3489 
   3490 ;; P-STOP
   3491 L0C58:  DEFB    $00             ; Class-00 - No further operands.
   3492         DEFW    L0CDC           ; Address: $0CDC; Address: STOP
   3493 
   3494 ;; P-RETURN
   3495 L0C5B:  DEFB    $00             ; Class-00 - No further operands.
   3496         DEFW    L0ED8           ; Address: $0ED8; Address: RETURN
   3497 
   3498 ;; P-FOR
   3499 L0C5E:  DEFB    $04             ; Class-04 - A single character variable must
   3500                                 ; follow.
   3501         DEFB    $14             ; Separator:  '='
   3502         DEFB    $06             ; Class-06 - A numeric expression must follow.
   3503         DEFB    $DF             ; Separator:  'TO'
   3504         DEFB    $06             ; Class-06 - A numeric expression must follow.
   3505         DEFB    $05             ; Class-05 - Variable syntax checked entirely
   3506                                 ; by routine.
   3507         DEFW    L0DB9           ; Address: $0DB9; Address: FOR
   3508 
   3509 ;; P-NEXT
   3510 L0C66:  DEFB    $04             ; Class-04 - A single character variable must
   3511                                 ; follow.
   3512         DEFB    $00             ; Class-00 - No further operands.
   3513         DEFW    L0E2E           ; Address: $0E2E; Address: NEXT
   3514 
   3515 ;; P-PRINT
   3516 L0C6A:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
   3517                                 ; by routine.
   3518         DEFW    L0ACF           ; Address: $0ACF; Address: PRINT
   3519 
   3520 ;; P-INPUT
   3521 L0C6D:  DEFB    $01             ; Class-01 - A variable is required.
   3522         DEFB    $00             ; Class-00 - No further operands.
   3523         DEFW    L0EE9           ; Address: $0EE9; Address: INPUT
   3524 
   3525 ;; P-DIM
   3526 L0C71:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
   3527                                 ; by routine.
   3528         DEFW    L1409           ; Address: $1409; Address: DIM
   3529 
   3530 ;; P-REM
   3531 L0C74:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
   3532                                 ; by routine.
   3533         DEFW    L0D6A           ; Address: $0D6A; Address: REM
   3534 
   3535 ;; P-NEW
   3536 L0C77:  DEFB    $00             ; Class-00 - No further operands.
   3537         DEFW    L03C3           ; Address: $03C3; Address: NEW
   3538 
   3539 ;; P-RUN
   3540 L0C7A:  DEFB    $03             ; Class-03 - A numeric expression may follow
   3541                                 ; else default to zero.
   3542         DEFW    L0EAF           ; Address: $0EAF; Address: RUN
   3543 
   3544 ;; P-LIST
   3545 L0C7D:  DEFB    $03             ; Class-03 - A numeric expression may follow
   3546                                 ; else default to zero.
   3547         DEFW    L0730           ; Address: $0730; Address: LIST
   3548 
   3549 ;; P-POKE
   3550 L0C80:  DEFB    $06             ; Class-06 - A numeric expression must follow.
   3551         DEFB    $1A             ; Separator:  ','
   3552         DEFB    $06             ; Class-06 - A numeric expression must follow.
   3553         DEFB    $00             ; Class-00 - No further operands.
   3554         DEFW    L0E92           ; Address: $0E92; Address: POKE
   3555 
   3556 ;; P-RAND
   3557 L0C86:  DEFB    $03             ; Class-03 - A numeric expression may follow
   3558                                 ; else default to zero.
   3559         DEFW    L0E6C           ; Address: $0E6C; Address: RAND
   3560 
   3561 ;; P-LOAD
   3562 L0C89:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
   3563                                 ; by routine.
   3564         DEFW    L0340           ; Address: $0340; Address: LOAD
   3565 
   3566 ;; P-SAVE
   3567 L0C8C:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
   3568                                 ; by routine.
   3569         DEFW    L02F6           ; Address: $02F6; Address: SAVE
   3570 
   3571 ;; P-CONT
   3572 L0C8F:  DEFB    $00             ; Class-00 - No further operands.
   3573         DEFW    L0E7C           ; Address: $0E7C; Address: CONT
   3574 
   3575 ;; P-CLEAR
   3576 L0C92:  DEFB    $00             ; Class-00 - No further operands.
   3577         DEFW    L149A           ; Address: $149A; Address: CLEAR
   3578 
   3579 ;; P-CLS
   3580 L0C95:  DEFB    $00             ; Class-00 - No further operands.
   3581         DEFW    L0A2A           ; Address: $0A2A; Address: CLS
   3582 
   3583 ;; P-PLOT
   3584 L0C98:  DEFB    $06             ; Class-06 - A numeric expression must follow.
   3585         DEFB    $1A             ; Separator:  ','
   3586         DEFB    $06             ; Class-06 - A numeric expression must follow.
   3587         DEFB    $00             ; Class-00 - No further operands.
   3588         DEFW    L0BAF           ; Address: $0BAF; Address: PLOT/UNP
   3589 
   3590 ;; P-UNPLOT
   3591 L0C9E:  DEFB    $06             ; Class-06 - A numeric expression must follow.
   3592         DEFB    $1A             ; Separator:  ','
   3593         DEFB    $06             ; Class-06 - A numeric expression must follow.
   3594         DEFB    $00             ; Class-00 - No further operands.
   3595         DEFW    L0BAF           ; Address: $0BAF; Address: PLOT/UNP
   3596 
   3597 ;; P-SCROLL
   3598 L0CA4:  DEFB    $00             ; Class-00 - No further operands.
   3599         DEFW    L0C0E           ; Address: $0C0E; Address: SCROLL
   3600 
   3601 ;; P-PAUSE
   3602 L0CA7:  DEFB    $06             ; Class-06 - A numeric expression must follow.
   3603         DEFB    $00             ; Class-00 - No further operands.
   3604         DEFW    L0F32           ; Address: $0F32; Address: PAUSE
   3605 
   3606 ;; P-SLOW
   3607 L0CAB:  DEFB    $00             ; Class-00 - No further operands.
   3608         DEFW    L0F2B           ; Address: $0F2B; Address: SLOW
   3609 
   3610 ;; P-FAST
   3611 L0CAE:  DEFB    $00             ; Class-00 - No further operands.
   3612         DEFW    L0F23           ; Address: $0F23; Address: FAST
   3613 
   3614 ;; P-COPY
   3615 L0CB1:  DEFB    $00             ; Class-00 - No further operands.
   3616         DEFW    L0869           ; Address: $0869; Address: COPY
   3617 
   3618 ;; P-LPRINT
   3619 L0CB4:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
   3620                                 ; by routine.
   3621         DEFW    L0ACB           ; Address: $0ACB; Address: LPRINT
   3622 
   3623 ;; P-LLIST
   3624 L0CB7:  DEFB    $03             ; Class-03 - A numeric expression may follow
   3625                                 ; else default to zero.
   3626         DEFW    L072C           ; Address: $072C; Address: LLIST
   3627 
   3628 
   3629 ; ---------------------------
   3630 ; THE 'LINE SCANNING' ROUTINE
   3631 ; ---------------------------
   3632 ;
   3633 ;
   3634 
   3635 ;; LINE-SCAN
   3636 L0CBA:  LD      (IY+$01),$01    ; sv FLAGS
   3637         CALL    L0A73           ; routine E-LINE-NO
   3638 
   3639 ;; LINE-RUN
   3640 L0CC1:  CALL    L14BC           ; routine SET-MIN
   3641         LD      HL,$4000        ; sv ERR_NR
   3642         LD      (HL),$FF        ;
   3643         LD      HL,$402D        ; sv FLAGX
   3644         BIT     5,(HL)          ;
   3645         JR      Z,L0CDE         ; to LINE-NULL
   3646 
   3647         CP      $E3             ; 'STOP' ?
   3648         LD      A,(HL)          ;
   3649         JP      NZ,L0D6F        ; to INPUT-REP
   3650 
   3651         CALL    L0DA6           ; routine SYNTAX-Z
   3652         RET     Z               ;
   3653 
   3654 
   3655         RST     08H             ; ERROR-1
   3656         DEFB    $0C             ; Error Report: BREAK - CONT repeats
   3657 
   3658 
   3659 ; --------------------------
   3660 ; THE 'STOP' COMMAND ROUTINE
   3661 ; --------------------------
   3662 ;
   3663 ;
   3664 
   3665 ;; STOP
   3666 L0CDC:  RST     08H             ; ERROR-1
   3667         DEFB    $08             ; Error Report: STOP statement
   3668 
   3669 ; ---
   3670 
   3671 ; the interpretation of a line continues with a check for just spaces
   3672 ; followed by a carriage return.
   3673 ; The IF command also branches here with a true value to execute the
   3674 ; statement after the THEN but the statement can be null so
   3675 ; 10 IF 1 = 1 THEN
   3676 ; passes syntax (on all ZX computers).
   3677 
   3678 ;; LINE-NULL
   3679 L0CDE:  RST     18H             ; GET-CHAR
   3680         LD      B,$00           ; prepare to index - early.
   3681         CP      $76             ; compare to NEWLINE.
   3682         RET     Z               ; return if so.
   3683 
   3684         LD      C,A             ; transfer character to C.
   3685 
   3686         RST     20H             ; NEXT-CHAR advances.
   3687         LD      A,C             ; character to A
   3688         SUB     $E1             ; subtract 'LPRINT' - lowest command.
   3689         JR      C,L0D26         ; forward if less to REPORT-C2
   3690 
   3691         LD      C,A             ; reduced token to C
   3692         LD      HL,L0C29        ; set HL to address of offset table.
   3693         ADD     HL,BC           ; index into offset table.
   3694         LD      C,(HL)          ; fetch offset
   3695         ADD     HL,BC           ; index into parameter table.
   3696         JR      L0CF7           ; to GET-PARAM
   3697 
   3698 ; ---
   3699 
   3700 ;; SCAN-LOOP
   3701 L0CF4:  LD      HL,($4030)      ; sv T_ADDR_lo
   3702 
   3703 ; -> Entry Point to Scanning Loop
   3704 
   3705 ;; GET-PARAM
   3706 L0CF7:  LD      A,(HL)          ;
   3707         INC     HL              ;
   3708         LD      ($4030),HL      ; sv T_ADDR_lo
   3709 
   3710         LD      BC,L0CF4        ; Address: SCAN-LOOP
   3711         PUSH    BC              ; is pushed on machine stack.
   3712 
   3713         LD      C,A             ;
   3714         CP      $0B             ;
   3715         JR      NC,L0D10        ; to SEPARATOR
   3716 
   3717         LD      HL,L0D16        ; class-tbl - the address of the class table.
   3718         LD      B,$00           ;
   3719         ADD     HL,BC           ;
   3720         LD      C,(HL)          ;
   3721         ADD     HL,BC           ;
   3722         PUSH    HL              ;
   3723 
   3724         RST     18H             ; GET-CHAR
   3725         RET                     ; indirect jump to class routine and
   3726                                 ; by subsequent RET to SCAN-LOOP.
   3727 
   3728 ; -----------------------
   3729 ; THE 'SEPARATOR' ROUTINE
   3730 ; -----------------------
   3731 
   3732 ;; SEPARATOR
   3733 L0D10:  RST     18H             ; GET-CHAR
   3734         CP      C               ;
   3735         JR      NZ,L0D26        ; to REPORT-C2
   3736                                 ; 'Nonsense in BASIC'
   3737 
   3738         RST     20H             ; NEXT-CHAR
   3739         RET                     ; return
   3740 
   3741 
   3742 ; -------------------------
   3743 ; THE 'COMMAND CLASS' TABLE
   3744 ; -------------------------
   3745 ;
   3746 
   3747 ;; class-tbl
   3748 L0D16:  DEFB    L0D2D - $       ; 17 offset to; Address: CLASS-0
   3749         DEFB    L0D3C - $       ; 25 offset to; Address: CLASS-1
   3750         DEFB    L0D6B - $       ; 53 offset to; Address: CLASS-2
   3751         DEFB    L0D28 - $       ; 0F offset to; Address: CLASS-3
   3752         DEFB    L0D85 - $       ; 6B offset to; Address: CLASS-4
   3753         DEFB    L0D2E - $       ; 13 offset to; Address: CLASS-5
   3754         DEFB    L0D92 - $       ; 76 offset to; Address: CLASS-6
   3755 
   3756 
   3757 ; --------------------------
   3758 ; THE 'CHECK END' SUBROUTINE
   3759 ; --------------------------
   3760 ; Check for end of statement and that no spurious characters occur after
   3761 ; a correctly parsed statement. Since only one statement is allowed on each
   3762 ; line, the only character that may follow a statement is a NEWLINE.
   3763 ;
   3764 
   3765 ;; CHECK-END
   3766 L0D1D:  CALL    L0DA6           ; routine SYNTAX-Z
   3767         RET     NZ              ; return in runtime.
   3768 
   3769         POP     BC              ; else drop return address.
   3770 
   3771 ;; CHECK-2
   3772 L0D22:  LD      A,(HL)          ; fetch character.
   3773         CP      $76             ; compare to NEWLINE.
   3774         RET     Z               ; return if so.
   3775 
   3776 ;; REPORT-C2
   3777 L0D26:  JR      L0D9A           ; to REPORT-C
   3778                                 ; 'Nonsense in BASIC'
   3779 
   3780 ; --------------------------
   3781 ; COMMAND CLASSES 03, 00, 05
   3782 ; --------------------------
   3783 ;
   3784 ;
   3785 
   3786 ;; CLASS-3
   3787 L0D28:  CP      $76             ;
   3788         CALL    L0D9C           ; routine NO-TO-STK
   3789 
   3790 ;; CLASS-0
   3791 L0D2D:  CP      A               ;
   3792 
   3793 ;; CLASS-5
   3794 L0D2E:  POP     BC              ;
   3795         CALL    Z,L0D1D         ; routine CHECK-END
   3796         EX      DE,HL           ;
   3797         LD      HL,($4030)      ; sv T_ADDR_lo
   3798         LD      C,(HL)          ;
   3799         INC     HL              ;
   3800         LD      B,(HL)          ;
   3801         EX      DE,HL           ;
   3802 
   3803 ;; CLASS-END
   3804 L0D3A:  PUSH    BC              ;
   3805         RET                     ;
   3806 
   3807 ; ------------------------------
   3808 ; COMMAND CLASSES 01, 02, 04, 06
   3809 ; ------------------------------
   3810 ;
   3811 ;
   3812 
   3813 ;; CLASS-1
   3814 L0D3C:  CALL    L111C           ; routine LOOK-VARS
   3815 
   3816 ;; CLASS-4-2
   3817 L0D3F:  LD      (IY+$2D),$00    ; sv FLAGX
   3818         JR      NC,L0D4D        ; to SET-STK
   3819 
   3820         SET     1,(IY+$2D)      ; sv FLAGX
   3821         JR      NZ,L0D63        ; to SET-STRLN
   3822 
   3823 
   3824 ;; REPORT-2
   3825 L0D4B:  RST     08H             ; ERROR-1
   3826         DEFB    $01             ; Error Report: Variable not found
   3827 
   3828 ; ---
   3829 
   3830 ;; SET-STK
   3831 L0D4D:  CALL    Z,L11A7         ; routine STK-VAR
   3832         BIT     6,(IY+$01)      ; sv FLAGS  - Numeric or string result?
   3833         JR      NZ,L0D63        ; to SET-STRLN
   3834 
   3835         XOR     A               ;
   3836         CALL    L0DA6           ; routine SYNTAX-Z
   3837         CALL    NZ,L13F8        ; routine STK-FETCH
   3838         LD      HL,$402D        ; sv FLAGX
   3839         OR      (HL)            ;
   3840         LD      (HL),A          ;
   3841         EX      DE,HL           ;
   3842 
   3843 ;; SET-STRLN
   3844 L0D63:  LD      ($402E),BC      ; sv STRLEN_lo
   3845         LD      ($4012),HL      ; sv DEST-lo
   3846 
   3847 ; THE 'REM' COMMAND ROUTINE
   3848 
   3849 ;; REM
   3850 L0D6A:  RET                     ;
   3851 
   3852 ; ---
   3853 
   3854 ;; CLASS-2
   3855 L0D6B:  POP     BC              ;
   3856         LD      A,($4001)       ; sv FLAGS
   3857 
   3858 ;; INPUT-REP
   3859 L0D6F:  PUSH    AF              ;
   3860         CALL    L0F55           ; routine SCANNING
   3861         POP     AF              ;
   3862         LD      BC,L1321        ; Address: LET
   3863         LD      D,(IY+$01)      ; sv FLAGS
   3864         XOR     D               ;
   3865         AND     $40             ;
   3866         JR      NZ,L0D9A        ; to REPORT-C
   3867 
   3868         BIT     7,D             ;
   3869         JR      NZ,L0D3A        ; to CLASS-END
   3870 
   3871         JR      L0D22           ; to CHECK-2
   3872 
   3873 ; ---
   3874 
   3875 ;; CLASS-4
   3876 L0D85:  CALL    L111C           ; routine LOOK-VARS
   3877         PUSH    AF              ;
   3878         LD      A,C             ;
   3879         OR      $9F             ;
   3880         INC     A               ;
   3881         JR       NZ,L0D9A       ; to REPORT-C
   3882 
   3883         POP     AF              ;
   3884         JR      L0D3F           ; to CLASS-4-2
   3885 
   3886 ; ---
   3887 
   3888 ;; CLASS-6
   3889 L0D92:  CALL    L0F55           ; routine SCANNING
   3890         BIT     6,(IY+$01)      ; sv FLAGS  - Numeric or string result?
   3891         RET     NZ              ;
   3892 
   3893 
   3894 ;; REPORT-C
   3895 L0D9A:  RST     08H             ; ERROR-1
   3896         DEFB    $0B             ; Error Report: Nonsense in BASIC
   3897 
   3898 ; --------------------------------
   3899 ; THE 'NUMBER TO STACK' SUBROUTINE
   3900 ; --------------------------------
   3901 ;
   3902 ;
   3903 
   3904 ;; NO-TO-STK
   3905 L0D9C:  JR      NZ,L0D92        ; back to CLASS-6 with a non-zero number.
   3906 
   3907         CALL    L0DA6           ; routine SYNTAX-Z
   3908         RET     Z               ; return if checking syntax.
   3909 
   3910 ; in runtime a zero default is placed on the calculator stack.
   3911 
   3912         RST     28H             ;; FP-CALC
   3913         DEFB    $A0             ;;stk-zero
   3914         DEFB    $34             ;;end-calc
   3915 
   3916         RET                     ; return.
   3917 
   3918 ; -------------------------
   3919 ; THE 'SYNTAX-Z' SUBROUTINE
   3920 ; -------------------------
   3921 ; This routine returns with zero flag set if checking syntax.
   3922 ; Calling this routine uses three instruction bytes compared to four if the
   3923 ; bit test is implemented inline.
   3924 
   3925 ;; SYNTAX-Z
   3926 L0DA6:  BIT     7,(IY+$01)      ; test FLAGS  - checking syntax only?
   3927         RET                     ; return.
   3928 
   3929 ; ------------------------
   3930 ; THE 'IF' COMMAND ROUTINE
   3931 ; ------------------------
   3932 ; In runtime, the class routines have evaluated the test expression and
   3933 ; the result, true or false, is on the stack.
   3934 
   3935 ;; IF
   3936 L0DAB:  CALL    L0DA6           ; routine SYNTAX-Z
   3937         JR      Z,L0DB6         ; forward if checking syntax to IF-END
   3938 
   3939 ; else delete the Boolean value on the calculator stack.
   3940 
   3941         RST     28H             ;; FP-CALC
   3942         DEFB    $02             ;;delete
   3943         DEFB    $34             ;;end-calc
   3944 
   3945 ; register DE points to exponent of floating point value.
   3946 
   3947         LD      A,(DE)          ; fetch exponent.
   3948         AND     A               ; test for zero - FALSE.
   3949         RET     Z               ; return if so.
   3950 
   3951 ;; IF-END
   3952 L0DB6:  JP      L0CDE           ; jump back to LINE-NULL
   3953 
   3954 ; -------------------------
   3955 ; THE 'FOR' COMMAND ROUTINE
   3956 ; -------------------------
   3957 ;
   3958 ;
   3959 
   3960 ;; FOR
   3961 L0DB9:  CP      $E0             ; is current character 'STEP' ?
   3962         JR      NZ,L0DC6        ; forward if not to F-USE-ONE
   3963 
   3964 
   3965         RST     20H             ; NEXT-CHAR
   3966         CALL    L0D92           ; routine CLASS-6 stacks the number
   3967         CALL    L0D1D           ; routine CHECK-END
   3968         JR      L0DCC           ; forward to F-REORDER
   3969 
   3970 ; ---
   3971 
   3972 ;; F-USE-ONE
   3973 L0DC6:  CALL    L0D1D           ; routine CHECK-END
   3974 
   3975         RST     28H             ;; FP-CALC
   3976         DEFB    $A1             ;;stk-one
   3977         DEFB    $34             ;;end-calc
   3978 
   3979 
   3980 
   3981 ;; F-REORDER
   3982 L0DCC:  RST     28H             ;; FP-CALC      v, l, s.
   3983         DEFB    $C0             ;;st-mem-0      v, l, s.
   3984         DEFB    $02             ;;delete        v, l.
   3985         DEFB    $01             ;;exchange      l, v.
   3986         DEFB    $E0             ;;get-mem-0     l, v, s.
   3987         DEFB    $01             ;;exchange      l, s, v.
   3988         DEFB    $34             ;;end-calc      l, s, v.
   3989 
   3990         CALL    L1321           ; routine LET
   3991 
   3992         LD      ($401F),HL      ; set MEM to address variable.
   3993         DEC     HL              ; point to letter.
   3994         LD      A,(HL)          ;
   3995         SET     7,(HL)          ;
   3996         LD      BC,$0006        ;
   3997         ADD     HL,BC           ;
   3998         RLCA                    ;
   3999         JR      C,L0DEA         ; to F-LMT-STP
   4000 
   4001         SLA     C               ;
   4002         CALL    L099E           ; routine MAKE-ROOM
   4003         INC     HL              ;
   4004 
   4005 ;; F-LMT-STP
   4006 L0DEA:  PUSH    HL              ;
   4007 
   4008         RST     28H             ;; FP-CALC
   4009         DEFB    $02             ;;delete
   4010         DEFB    $02             ;;delete
   4011         DEFB    $34             ;;end-calc
   4012 
   4013         POP     HL              ;
   4014         EX      DE,HL           ;
   4015 
   4016         LD      C,$0A           ; ten bytes to be moved.
   4017         LDIR                    ; copy bytes
   4018 
   4019         LD      HL,($4007)      ; set HL to system variable PPC current line.
   4020         EX      DE,HL           ; transfer to DE, variable pointer to HL.
   4021         INC     DE              ; loop start will be this line + 1 at least.
   4022         LD      (HL),E          ;
   4023         INC     HL              ;
   4024         LD      (HL),D          ;
   4025         CALL    L0E5A           ; routine NEXT-LOOP considers an initial pass.
   4026         RET     NC              ; return if possible.
   4027 
   4028 ; else program continues from point following matching NEXT.
   4029 
   4030         BIT     7,(IY+$08)      ; test PPC_hi
   4031         RET     NZ              ; return if over 32767 ???
   4032 
   4033         LD      B,(IY+$2E)      ; fetch variable name from STRLEN_lo
   4034         RES     6,B             ; make a true letter.
   4035         LD      HL,($4029)      ; set HL from NXTLIN
   4036 
   4037 ; now enter a loop to look for matching next.
   4038 
   4039 ;; NXTLIN-NO
   4040 L0E0E:  LD      A,(HL)          ; fetch high byte of line number.
   4041         AND     $C0             ; mask off low bits $3F
   4042         JR      NZ,L0E2A        ; forward at end of program to FOR-END
   4043 
   4044         PUSH    BC              ; save letter
   4045         CALL    L09F2           ; routine NEXT-ONE finds next line.
   4046         POP     BC              ; restore letter
   4047 
   4048         INC     HL              ; step past low byte
   4049         INC     HL              ; past the
   4050         INC     HL              ; line length.
   4051         CALL    L004C           ; routine TEMP-PTR1 sets CH_ADD
   4052 
   4053         RST     18H             ; GET-CHAR
   4054         CP      $F3             ; compare to 'NEXT'.
   4055         EX      DE,HL           ; next line to HL.
   4056         JR      NZ,L0E0E        ; back with no match to NXTLIN-NO
   4057 
   4058 ;
   4059 
   4060         EX      DE,HL           ; restore pointer.
   4061 
   4062         RST     20H             ; NEXT-CHAR advances and gets letter in A.
   4063         EX      DE,HL           ; save pointer
   4064         CP      B               ; compare to variable name.
   4065         JR      NZ,L0E0E        ; back with mismatch to NXTLIN-NO
   4066 
   4067 ;; FOR-END
   4068 L0E2A:  LD      ($4029),HL      ; update system variable NXTLIN
   4069         RET                     ; return.
   4070 
   4071 ; --------------------------
   4072 ; THE 'NEXT' COMMAND ROUTINE
   4073 ; --------------------------
   4074 ;
   4075 ;
   4076 
   4077 ;; NEXT
   4078 L0E2E:  BIT     1,(IY+$2D)      ; sv FLAGX
   4079         JP      NZ,L0D4B        ; to REPORT-2
   4080 
   4081         LD      HL,($4012)      ; DEST
   4082         BIT     7,(HL)          ;
   4083         JR      Z,L0E58         ; to REPORT-1
   4084 
   4085         INC     HL              ;
   4086         LD      ($401F),HL      ; sv MEM_lo
   4087 
   4088         RST     28H             ;; FP-CALC
   4089         DEFB    $E0             ;;get-mem-0
   4090         DEFB    $E2             ;;get-mem-2
   4091         DEFB    $0F             ;;addition
   4092         DEFB    $C0             ;;st-mem-0
   4093         DEFB    $02             ;;delete
   4094         DEFB    $34             ;;end-calc
   4095 
   4096         CALL    L0E5A           ; routine NEXT-LOOP
   4097         RET     C               ;
   4098 
   4099         LD      HL,($401F)      ; sv MEM_lo
   4100         LD      DE,$000F        ;
   4101         ADD     HL,DE           ;
   4102         LD      E,(HL)          ;
   4103         INC     HL              ;
   4104         LD      D,(HL)          ;
   4105         EX      DE,HL           ;
   4106         JR      L0E86           ; to GOTO-2
   4107 
   4108 ; ---
   4109 
   4110 
   4111 ;; REPORT-1
   4112 L0E58:  RST     08H             ; ERROR-1
   4113         DEFB    $00             ; Error Report: NEXT without FOR
   4114 
   4115 
   4116 ; --------------------------
   4117 ; THE 'NEXT-LOOP' SUBROUTINE
   4118 ; --------------------------
   4119 ;
   4120 ;
   4121 
   4122 ;; NEXT-LOOP
   4123 L0E5A:  RST     28H             ;; FP-CALC
   4124         DEFB    $E1             ;;get-mem-1
   4125         DEFB    $E0             ;;get-mem-0
   4126         DEFB    $E2             ;;get-mem-2
   4127         DEFB    $32             ;;less-0
   4128         DEFB    $00             ;;jump-true
   4129         DEFB    $02             ;;to L0E62, LMT-V-VAL
   4130 
   4131         DEFB    $01             ;;exchange
   4132 
   4133 ;; LMT-V-VAL
   4134 L0E62:  DEFB    $03             ;;subtract
   4135         DEFB    $33             ;;greater-0
   4136         DEFB    $00             ;;jump-true
   4137         DEFB    $04             ;;to L0E69, IMPOSS
   4138 
   4139         DEFB    $34             ;;end-calc
   4140 
   4141         AND     A               ; clear carry flag
   4142         RET                     ; return.
   4143 
   4144 ; ---
   4145 
   4146 
   4147 ;; IMPOSS
   4148 L0E69:  DEFB    $34             ;;end-calc
   4149 
   4150         SCF                     ; set carry flag
   4151         RET                     ; return.
   4152 
   4153 ; --------------------------
   4154 ; THE 'RAND' COMMAND ROUTINE
   4155 ; --------------------------
   4156 ; The keyword was 'RANDOMISE' on the ZX80, is 'RAND' here on the ZX81 and
   4157 ; becomes 'RANDOMIZE' on the ZX Spectrum.
   4158 ; In all invocations the procedure is the same - to set the SEED system variable
   4159 ; with a supplied integer value or to use a time-based value if no number, or
   4160 ; zero, is supplied.
   4161 
   4162 ;; RAND
   4163 L0E6C:  CALL    L0EA7           ; routine FIND-INT
   4164         LD      A,B             ; test value
   4165         OR      C               ; for zero
   4166         JR      NZ,L0E77        ; forward if not zero to SET-SEED
   4167 
   4168         LD      BC,($4034)      ; fetch value of FRAMES system variable.
   4169 
   4170 ;; SET-SEED
   4171 L0E77:  LD       ($4032),BC     ; update the SEED system variable.
   4172         RET                     ; return.
   4173 
   4174 ; --------------------------
   4175 ; THE 'CONT' COMMAND ROUTINE
   4176 ; --------------------------
   4177 ; Another abbreviated command. ROM space was really tight.
   4178 ; CONTINUE at the line number that was set when break was pressed.
   4179 ; Sometimes the current line, sometimes the next line.
   4180 
   4181 ;; CONT
   4182 L0E7C:  LD      HL,($402B)      ; set HL from system variable OLDPPC
   4183         JR      L0E86           ; forward to GOTO-2
   4184 
   4185 ; --------------------------
   4186 ; THE 'GOTO' COMMAND ROUTINE
   4187 ; --------------------------
   4188 ; This token also suffered from the shortage of room and there is no space
   4189 ; getween GO and TO as there is on the ZX80 and ZX Spectrum. The same also 
   4190 ; applies to the GOSUB keyword.
   4191 
   4192 ;; GOTO
   4193 L0E81:  CALL    L0EA7           ; routine FIND-INT
   4194         LD      H,B             ;
   4195         LD      L,C             ;
   4196 
   4197 ;; GOTO-2
   4198 L0E86:  LD      A,H             ;
   4199         CP      $F0             ;
   4200         JR      NC,L0EAD        ; to REPORT-B
   4201 
   4202         CALL    L09D8           ; routine LINE-ADDR
   4203         LD      ($4029),HL      ; sv NXTLIN_lo
   4204         RET                     ;
   4205 
   4206 ; --------------------------
   4207 ; THE 'POKE' COMMAND ROUTINE
   4208 ; --------------------------
   4209 ;
   4210 ;
   4211 
   4212 ;; POKE
   4213 L0E92:  CALL    L15CD           ; routine FP-TO-A
   4214         JR      C,L0EAD         ; forward, with overflow, to REPORT-B
   4215 
   4216         JR      Z,L0E9B         ; forward, if positive, to POKE-SAVE
   4217 
   4218         NEG                     ; negate
   4219 
   4220 ;; POKE-SAVE
   4221 L0E9B:  PUSH    AF              ; preserve value.
   4222         CALL    L0EA7           ; routine FIND-INT gets address in BC
   4223                                 ; invoking the error routine with overflow
   4224                                 ; or a negative number.
   4225         POP     AF              ; restore value.
   4226 
   4227 ; Note. the next two instructions are legacy code from the ZX80 and
   4228 ; inappropriate here.
   4229 
   4230         BIT     7,(IY+$00)      ; test ERR_NR - is it still $FF ?
   4231         RET     Z               ; return with error.
   4232 
   4233         LD      (BC),A          ; update the address contents.
   4234         RET                     ; return.
   4235 
   4236 ; -----------------------------
   4237 ; THE 'FIND INTEGER' SUBROUTINE
   4238 ; -----------------------------
   4239 ;
   4240 ;
   4241 
   4242 ;; FIND-INT
   4243 L0EA7:  CALL    L158A           ; routine FP-TO-BC
   4244         JR      C,L0EAD         ; forward with overflow to REPORT-B
   4245 
   4246         RET     Z               ; return if positive (0-65535).
   4247 
   4248 
   4249 ;; REPORT-B
   4250 L0EAD:  RST     08H             ; ERROR-1
   4251         DEFB    $0A             ; Error Report: Integer out of range
   4252 
   4253 ; -------------------------
   4254 ; THE 'RUN' COMMAND ROUTINE
   4255 ; -------------------------
   4256 ;
   4257 ;
   4258 
   4259 ;; RUN
   4260 L0EAF:  CALL    L0E81           ; routine GOTO
   4261         JP      L149A           ; to CLEAR
   4262 
   4263 ; ---------------------------
   4264 ; THE 'GOSUB' COMMAND ROUTINE
   4265 ; ---------------------------
   4266 ;
   4267 ;
   4268 
   4269 ;; GOSUB
   4270 L0EB5:  LD      HL,($4007)      ; sv PPC_lo
   4271         INC     HL              ;
   4272         EX      (SP),HL         ;
   4273         PUSH    HL              ;
   4274         LD      ($4002),SP      ; set the error stack pointer - ERR_SP
   4275         CALL    L0E81           ; routine GOTO
   4276         LD      BC,$0006        ;
   4277 
   4278 ; --------------------------
   4279 ; THE 'TEST ROOM' SUBROUTINE
   4280 ; --------------------------
   4281 ;
   4282 ;
   4283 
   4284 ;; TEST-ROOM
   4285 L0EC5:  LD      HL,($401C)      ; sv STKEND_lo
   4286         ADD     HL,BC           ;
   4287         JR      C,L0ED3         ; to REPORT-4
   4288 
   4289         EX      DE,HL           ;
   4290         LD      HL,$0024        ;
   4291         ADD     HL,DE           ;
   4292         SBC     HL,SP           ;
   4293         RET     C               ;
   4294 
   4295 ;; REPORT-4
   4296 L0ED3:  LD      L,$03           ;
   4297         JP      L0058           ; to ERROR-3
   4298 
   4299 ; ----------------------------
   4300 ; THE 'RETURN' COMMAND ROUTINE
   4301 ; ----------------------------
   4302 ;
   4303 ;
   4304 
   4305 ;; RETURN
   4306 L0ED8:  POP     HL              ;
   4307         EX      (SP),HL         ;
   4308         LD      A,H             ;
   4309         CP      $3E             ;
   4310         JR      Z,L0EE5         ; to REPORT-7
   4311 
   4312         LD      ($4002),SP      ; sv ERR_SP_lo
   4313         JR      L0E86           ; back to GOTO-2
   4314 
   4315 ; ---
   4316 
   4317 ;; REPORT-7
   4318 L0EE5:  EX      (SP),HL         ;
   4319         PUSH    HL              ;
   4320 
   4321         RST     08H             ; ERROR-1
   4322         DEFB    $06             ; Error Report: RETURN without GOSUB
   4323 
   4324 ; ---------------------------
   4325 ; THE 'INPUT' COMMAND ROUTINE
   4326 ; ---------------------------
   4327 ;
   4328 ;
   4329 
   4330 ;; INPUT
   4331 L0EE9:  BIT     7,(IY+$08)      ; sv PPC_hi
   4332         JR      NZ,L0F21        ; to REPORT-8
   4333 
   4334         CALL    L14A3           ; routine X-TEMP
   4335         LD      HL,$402D        ; sv FLAGX
   4336         SET     5,(HL)          ;
   4337         RES     6,(HL)          ;
   4338         LD      A,($4001)       ; sv FLAGS
   4339         AND     $40             ;
   4340         LD      BC,$0002        ;
   4341         JR      NZ,L0F05        ; to PROMPT
   4342 
   4343         LD      C,$04           ;
   4344 
   4345 ;; PROMPT
   4346 L0F05:  OR      (HL)            ;
   4347         LD      (HL),A          ;
   4348 
   4349         RST     30H             ; BC-SPACES
   4350         LD      (HL),$76        ;
   4351         LD      A,C             ;
   4352         RRCA                    ;
   4353         RRCA                    ;
   4354         JR      C,L0F14         ; to ENTER-CUR
   4355 
   4356         LD      A,$0B           ;
   4357         LD      (DE),A          ;
   4358         DEC     HL              ;
   4359         LD      (HL),A          ;
   4360 
   4361 ;; ENTER-CUR
   4362 L0F14:  DEC     HL              ;
   4363         LD      (HL),$7F        ;
   4364         LD      HL,($4039)      ; sv S_POSN_x
   4365         LD      ($4030),HL      ; sv T_ADDR_lo
   4366         POP     HL              ;
   4367         JP      L0472           ; to LOWER
   4368 
   4369 ; ---
   4370 
   4371 ;; REPORT-8
   4372 L0F21:  RST     08H             ; ERROR-1
   4373         DEFB    $07             ; Error Report: End of file
   4374 
   4375 ; ---------------------------
   4376 ; THE 'PAUSE' COMMAND ROUTINE
   4377 ; ---------------------------
   4378 ;
   4379 ;
   4380 
   4381 ;; FAST
   4382 L0F23:  CALL    L02E7           ; routine SET-FAST
   4383         RES     6,(IY+$3B)      ; sv CDFLAG
   4384         RET                     ; return.
   4385 
   4386 ; --------------------------
   4387 ; THE 'SLOW' COMMAND ROUTINE
   4388 ; --------------------------
   4389 ;
   4390 ;
   4391 
   4392 ;; SLOW
   4393 L0F2B:  SET     6,(IY+$3B)      ; sv CDFLAG
   4394         JP      L0207           ; to SLOW/FAST
   4395 
   4396 ; ---------------------------
   4397 ; THE 'PAUSE' COMMAND ROUTINE
   4398 ; ---------------------------
   4399 
   4400 ;; PAUSE
   4401 L0F32:  CALL    L0EA7           ; routine FIND-INT
   4402         CALL    L02E7           ; routine SET-FAST
   4403         LD      H,B             ;
   4404         LD      L,C             ;
   4405         CALL    L022D           ; routine DISPLAY-P
   4406 
   4407         LD      (IY+$35),$FF    ; sv FRAMES_hi
   4408 
   4409         CALL    L0207           ; routine SLOW/FAST
   4410         JR      L0F4B           ; routine DEBOUNCE
   4411 
   4412 ; ----------------------
   4413 ; THE 'BREAK' SUBROUTINE
   4414 ; ----------------------
   4415 ;
   4416 ;
   4417 
   4418 ;; BREAK-1
   4419 L0F46:  LD      A,$7F           ; read port $7FFE - keys B,N,M,.,SPACE.
   4420         IN      A,($FE)         ;
   4421         RRA                     ; carry will be set if space not pressed.
   4422 
   4423 ; -------------------------
   4424 ; THE 'DEBOUNCE' SUBROUTINE
   4425 ; -------------------------
   4426 ;
   4427 ;
   4428 
   4429 ;; DEBOUNCE
   4430 L0F4B:  RES     0,(IY+$3B)      ; update system variable CDFLAG
   4431         LD      A,$FF           ;
   4432         LD      ($4027),A       ; update system variable DEBOUNCE
   4433         RET                     ; return.
   4434 
   4435 
   4436 ; -------------------------
   4437 ; THE 'SCANNING' SUBROUTINE
   4438 ; -------------------------
   4439 ; This recursive routine is where the ZX81 gets its power. Provided there is
   4440 ; enough memory it can evaluate an expression of unlimited complexity.
   4441 ; Note. there is no unary plus so, as on the ZX80, PRINT +1 gives a syntax error.
   4442 ; PRINT +1 works on the Spectrum but so too does PRINT + "STRING".
   4443 
   4444 ;; SCANNING
   4445 L0F55:  RST     18H             ; GET-CHAR
   4446         LD      B,$00           ; set B register to zero.
   4447         PUSH    BC              ; stack zero as a priority end-marker.
   4448 
   4449 ;; S-LOOP-1
   4450 L0F59:  CP      $40             ; compare to the 'RND' character
   4451         JR      NZ,L0F8C        ; forward, if not, to S-TEST-PI
   4452 
   4453 ; ------------------
   4454 ; THE 'RND' FUNCTION
   4455 ; ------------------
   4456 
   4457         CALL    L0DA6           ; routine SYNTAX-Z
   4458         JR      Z,L0F8A         ; forward if checking syntax to S-JPI-END
   4459 
   4460         LD      BC,($4032)      ; sv SEED_lo
   4461         CALL    L1520           ; routine STACK-BC
   4462 
   4463         RST     28H             ;; FP-CALC
   4464         DEFB    $A1             ;;stk-one
   4465         DEFB    $0F             ;;addition
   4466         DEFB    $30             ;;stk-data
   4467         DEFB    $37             ;;Exponent: $87, Bytes: 1
   4468         DEFB    $16             ;;(+00,+00,+00)
   4469         DEFB    $04             ;;multiply
   4470         DEFB    $30             ;;stk-data
   4471         DEFB    $80             ;;Bytes: 3
   4472         DEFB    $41             ;;Exponent $91
   4473         DEFB    $00,$00,$80     ;;(+00)
   4474         DEFB    $2E             ;;n-mod-m
   4475         DEFB    $02             ;;delete
   4476         DEFB    $A1             ;;stk-one
   4477         DEFB    $03             ;;subtract
   4478         DEFB    $2D             ;;duplicate
   4479         DEFB    $34             ;;end-calc
   4480 
   4481         CALL    L158A           ; routine FP-TO-BC
   4482         LD      ($4032),BC      ; update the SEED system variable.
   4483         LD      A,(HL)          ; HL addresses the exponent of the last value.
   4484         AND     A               ; test for zero
   4485         JR      Z,L0F8A         ; forward, if so, to S-JPI-END
   4486 
   4487         SUB     $10             ; else reduce exponent by sixteen
   4488         LD      (HL),A          ; thus dividing by 65536 for last value.
   4489 
   4490 ;; S-JPI-END
   4491 L0F8A:  JR      L0F99           ; forward to S-PI-END
   4492 
   4493 ; ---
   4494 
   4495 ;; S-TEST-PI
   4496 L0F8C:  CP      $42             ; the 'PI' character
   4497         JR      NZ,L0F9D        ; forward, if not, to S-TST-INK
   4498 
   4499 ; -------------------
   4500 ; THE 'PI' EVALUATION
   4501 ; -------------------
   4502 
   4503         CALL    L0DA6           ; routine SYNTAX-Z
   4504         JR      Z,L0F99         ; forward if checking syntax to S-PI-END
   4505 
   4506 
   4507         RST     28H             ;; FP-CALC
   4508         DEFB    $A3             ;;stk-pi/2
   4509         DEFB    $34             ;;end-calc
   4510 
   4511         INC     (HL)            ; double the exponent giving PI on the stack.
   4512 
   4513 ;; S-PI-END
   4514 L0F99:  RST     20H             ; NEXT-CHAR advances character pointer.
   4515 
   4516         JP      L1083           ; jump forward to S-NUMERIC to set the flag
   4517                                 ; to signal numeric result before advancing.
   4518 
   4519 ; ---
   4520 
   4521 ;; S-TST-INK
   4522 L0F9D:  CP      $41             ; compare to character 'INKEY$'
   4523         JR      NZ,L0FB2        ; forward, if not, to S-ALPHANUM
   4524 
   4525 ; -----------------------
   4526 ; THE 'INKEY$' EVALUATION
   4527 ; -----------------------
   4528 
   4529         CALL    L02BB           ; routine KEYBOARD
   4530         LD      B,H             ;
   4531         LD      C,L             ;
   4532         LD      D,C             ;
   4533         INC     D               ;
   4534         CALL    NZ,L07BD        ; routine DECODE
   4535         LD      A,D             ;
   4536         ADC     A,D             ;
   4537         LD      B,D             ;
   4538         LD      C,A             ;
   4539         EX      DE,HL           ;
   4540         JR      L0FED           ; forward to S-STRING
   4541 
   4542 ; ---
   4543 
   4544 ;; S-ALPHANUM
   4545 L0FB2:  CALL    L14D2           ; routine ALPHANUM
   4546         JR      C,L1025         ; forward, if alphanumeric to S-LTR-DGT
   4547 
   4548         CP      $1B             ; is character a '.' ?
   4549         JP      Z,L1047         ; jump forward if so to S-DECIMAL
   4550 
   4551         LD      BC,$09D8        ; prepare priority 09, operation 'subtract'
   4552         CP      $16             ; is character unary minus '-' ?
   4553         JR      Z,L1020         ; forward, if so, to S-PUSH-PO
   4554 
   4555         CP      $10             ; is character a '(' ?
   4556         JR      NZ,L0FD6        ; forward if not to S-QUOTE
   4557 
   4558         CALL    L0049           ; routine CH-ADD+1 advances character pointer.
   4559 
   4560         CALL    L0F55           ; recursively call routine SCANNING to
   4561                                 ; evaluate the sub-expression.
   4562 
   4563         CP      $11             ; is subsequent character a ')' ?
   4564         JR      NZ,L0FFF        ; forward if not to S-RPT-C
   4565 
   4566 
   4567         CALL    L0049           ; routine CH-ADD+1  advances.
   4568         JR      L0FF8           ; relative jump to S-JP-CONT3 and then S-CONT3
   4569 
   4570 ; ---
   4571 
   4572 ; consider a quoted string e.g. PRINT "Hooray!"
   4573 ; Note. quotes are not allowed within a string.
   4574 
   4575 ;; S-QUOTE
   4576 L0FD6:  CP      $0B             ; is character a quote (") ?
   4577         JR      NZ,L1002        ; forward, if not, to S-FUNCTION
   4578 
   4579         CALL    L0049           ; routine CH-ADD+1 advances
   4580         PUSH    HL              ; * save start of string.
   4581         JR      L0FE3           ; forward to S-QUOTE-S
   4582 
   4583 ; ---
   4584 
   4585 
   4586 ;; S-Q-AGAIN
   4587 L0FE0:  CALL    L0049           ; routine CH-ADD+1
   4588 
   4589 ;; S-QUOTE-S
   4590 L0FE3:  CP      $0B             ; is character a '"' ?
   4591         JR      NZ,L0FFB        ; forward if not to S-Q-NL
   4592 
   4593         POP     DE              ; * retrieve start of string
   4594         AND     A               ; prepare to subtract.
   4595         SBC     HL,DE           ; subtract start from current position.
   4596         LD      B,H             ; transfer this length
   4597         LD      C,L             ; to the BC register pair.
   4598 
   4599 ;; S-STRING
   4600 L0FED:  LD      HL,$4001        ; address system variable FLAGS
   4601         RES     6,(HL)          ; signal string result
   4602         BIT     7,(HL)          ; test if checking syntax.
   4603 
   4604         CALL    NZ,L12C3        ; in run-time routine STK-STO-$ stacks the
   4605                                 ; string descriptor - start DE, length BC.
   4606 
   4607         RST     20H             ; NEXT-CHAR advances pointer.
   4608 
   4609 ;; S-J-CONT-3
   4610 L0FF8:  JP      L1088           ; jump to S-CONT-3
   4611 
   4612 ; ---
   4613 
   4614 ; A string with no terminating quote has to be considered.
   4615 
   4616 ;; S-Q-NL
   4617 L0FFB:  CP      $76             ; compare to NEWLINE
   4618         JR      NZ,L0FE0        ; loop back if not to S-Q-AGAIN
   4619 
   4620 ;; S-RPT-C
   4621 L0FFF:  JP      L0D9A           ; to REPORT-C
   4622 
   4623 ; ---
   4624 
   4625 ;; S-FUNCTION
   4626 L1002:  SUB     $C4             ; subtract 'CODE' reducing codes
   4627                                 ; CODE thru '<>' to range $00 - $XX
   4628         JR      C,L0FFF         ; back, if less, to S-RPT-C
   4629 
   4630 ; test for NOT the last function in character set.
   4631 
   4632         LD      BC,$04EC        ; prepare priority $04, operation 'not'
   4633         CP      $13             ; compare to 'NOT'  ( - CODE)
   4634         JR      Z,L1020         ; forward, if so, to S-PUSH-PO
   4635 
   4636         JR      NC,L0FFF        ; back with anything higher to S-RPT-C
   4637 
   4638 ; else is a function 'CODE' thru 'CHR$'
   4639 
   4640         LD      B,$10           ; priority sixteen binds all functions to
   4641                                 ; arguments removing the need for brackets.
   4642 
   4643         ADD     A,$D9           ; add $D9 to give range $D9 thru $EB
   4644                                 ; bit 6 is set to show numeric argument.
   4645                                 ; bit 7 is set to show numeric result.
   4646 
   4647 ; now adjust these default argument/result indicators.
   4648 
   4649         LD      C,A             ; save code in C
   4650 
   4651         CP      $DC             ; separate 'CODE', 'VAL', 'LEN'
   4652         JR      NC,L101A        ; skip forward if string operand to S-NO-TO-$
   4653 
   4654         RES     6,C             ; signal string operand.
   4655 
   4656 ;; S-NO-TO-$
   4657 L101A:  CP      $EA             ; isolate top of range 'STR$' and 'CHR$'
   4658         JR      C,L1020         ; skip forward with others to S-PUSH-PO
   4659 
   4660         RES     7,C             ; signal string result.
   4661 
   4662 ;; S-PUSH-PO
   4663 L1020:  PUSH    BC              ; push the priority/operation
   4664 
   4665         RST     20H             ; NEXT-CHAR
   4666         JP      L0F59           ; jump back to S-LOOP-1
   4667 
   4668 ; ---
   4669 
   4670 ;; S-LTR-DGT
   4671 L1025:  CP      $26             ; compare to 'A'.
   4672         JR      C,L1047         ; forward if less to S-DECIMAL
   4673 
   4674         CALL    L111C           ; routine LOOK-VARS
   4675         JP      C,L0D4B         ; back if not found to REPORT-2
   4676                                 ; a variable is always 'found' when checking
   4677                                 ; syntax.
   4678 
   4679         CALL    Z,L11A7         ; routine STK-VAR stacks string parameters or
   4680                                 ; returns cell location if numeric.
   4681 
   4682         LD      A,($4001)       ; fetch FLAGS
   4683         CP      $C0             ; compare to numeric result/numeric operand
   4684         JR      C,L1087         ; forward if not numeric to S-CONT-2
   4685 
   4686         INC     HL              ; address numeric contents of variable.
   4687         LD      DE,($401C)      ; set destination to STKEND
   4688         CALL    L19F6           ; routine MOVE-FP stacks the five bytes
   4689         EX      DE,HL           ; transfer new free location from DE to HL.
   4690         LD      ($401C),HL      ; update STKEND system variable.
   4691         JR      L1087           ; forward to S-CONT-2
   4692 
   4693 ; ---
   4694 
   4695 ; The Scanning Decimal routine is invoked when a decimal point or digit is
   4696 ; found in the expression.
   4697 ; When checking syntax, then the 'hidden floating point' form is placed
   4698 ; after the number in the BASIC line.
   4699 ; In run-time, the digits are skipped and the floating point number is picked
   4700 ; up.
   4701 
   4702 ;; S-DECIMAL
   4703 L1047:  CALL    L0DA6           ; routine SYNTAX-Z
   4704         JR      NZ,L106F        ; forward in run-time to S-STK-DEC
   4705 
   4706         CALL    L14D9           ; routine DEC-TO-FP
   4707 
   4708         RST     18H             ; GET-CHAR advances HL past digits
   4709         LD      BC,$0006        ; six locations are required.
   4710         CALL    L099E           ; routine MAKE-ROOM
   4711         INC     HL              ; point to first new location
   4712         LD      (HL),$7E        ; insert the number marker 126 decimal.
   4713         INC     HL              ; increment
   4714         EX      DE,HL           ; transfer destination to DE.
   4715         LD      HL,($401C)      ; set HL from STKEND which points to the
   4716                                 ; first location after the 'last value'
   4717         LD      C,$05           ; five bytes to move.
   4718         AND     A               ; clear carry.
   4719         SBC     HL,BC           ; subtract five pointing to 'last value'.
   4720         LD      ($401C),HL      ; update STKEND thereby 'deleting the value.
   4721 
   4722         LDIR                    ; copy the five value bytes.
   4723 
   4724         EX      DE,HL           ; basic pointer to HL which may be white-space
   4725                                 ; following the number.
   4726         DEC     HL              ; now points to last of five bytes.
   4727         CALL    L004C           ; routine TEMP-PTR1 advances the character
   4728                                 ; address skipping any white-space.
   4729         JR      L1083           ; forward to S-NUMERIC
   4730                                 ; to signal a numeric result.
   4731 
   4732 ; ---
   4733 
   4734 ; In run-time the branch is here when a digit or point is encountered.
   4735 
   4736 ;; S-STK-DEC
   4737 L106F:  RST     20H             ; NEXT-CHAR
   4738         CP      $7E             ; compare to 'number marker'
   4739         JR      NZ,L106F        ; loop back until found to S-STK-DEC
   4740                                 ; skipping all the digits.
   4741 
   4742         INC     HL              ; point to first of five hidden bytes.
   4743         LD      DE,($401C)      ; set destination from STKEND system variable
   4744         CALL    L19F6           ; routine MOVE-FP stacks the number.
   4745         LD      ($401C),DE      ; update system variable STKEND.
   4746         LD      ($4016),HL      ; update system variable CH_ADD.
   4747 
   4748 ;; S-NUMERIC
   4749 L1083:  SET     6,(IY+$01)      ; update FLAGS  - Signal numeric result
   4750 
   4751 ;; S-CONT-2
   4752 L1087:  RST     18H             ; GET-CHAR
   4753 
   4754 ;; S-CONT-3
   4755 L1088:  CP      $10             ; compare to opening bracket '('
   4756         JR      NZ,L1098        ; forward if not to S-OPERTR
   4757 
   4758         BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result?
   4759         JR      NZ,L10BC        ; forward if numeric to S-LOOP
   4760 
   4761 ; else is a string
   4762 
   4763         CALL    L1263           ; routine SLICING
   4764 
   4765         RST     20H             ; NEXT-CHAR
   4766         JR      L1088           ; back to S-CONT-3
   4767 
   4768 ; ---
   4769 
   4770 ; the character is now manipulated to form an equivalent in the table of
   4771 ; calculator literals. This is quite cumbersome and in the ZX Spectrum a
   4772 ; simple look-up table was introduced at this point.
   4773 
   4774 ;; S-OPERTR
   4775 L1098:  LD      BC,$00C3        ; prepare operator 'subtract' as default.
   4776                                 ; also set B to zero for later indexing.
   4777 
   4778         CP      $12             ; is character '>' ?
   4779         JR      C,L10BC         ; forward if less to S-LOOP as
   4780                                 ; we have reached end of meaningful expression
   4781 
   4782         SUB     $16             ; is character '-' ?
   4783         JR      NC,L10A7        ; forward with - * / and '**' '<>' to SUBMLTDIV
   4784 
   4785         ADD     A,$0D           ; increase others by thirteen
   4786                                 ; $09 '>' thru $0C '+'
   4787         JR      L10B5           ; forward to GET-PRIO
   4788 
   4789 ; ---
   4790 
   4791 ;; SUBMLTDIV
   4792 L10A7:  CP      $03             ; isolate $00 '-', $01 '*', $02 '/'
   4793         JR      C,L10B5         ; forward if so to GET-PRIO
   4794 
   4795 ; else possibly originally $D8 '**' thru $DD '<>' already reduced by $16
   4796 
   4797         SUB     $C2             ; giving range $00 to $05
   4798         JR      C,L10BC         ; forward if less to S-LOOP
   4799 
   4800         CP      $06             ; test the upper limit for nonsense also
   4801         JR      NC,L10BC        ; forward if so to S-LOOP
   4802 
   4803         ADD     A,$03           ; increase by 3 to give combined operators of
   4804 
   4805                                 ; $00 '-'
   4806                                 ; $01 '*'
   4807                                 ; $02 '/'
   4808 
   4809                                 ; $03 '**'
   4810                                 ; $04 'OR'
   4811                                 ; $05 'AND'
   4812                                 ; $06 '<='
   4813                                 ; $07 '>='
   4814                                 ; $08 '<>'
   4815 
   4816                                 ; $09 '>'
   4817                                 ; $0A '<'
   4818                                 ; $0B '='
   4819                                 ; $0C '+'
   4820 
   4821 ;; GET-PRIO
   4822 L10B5:  ADD     A,C             ; add to default operation 'sub' ($C3)
   4823         LD      C,A             ; and place in operator byte - C.
   4824 
   4825         LD      HL,L110F - $C3  ; theoretical base of the priorities table.
   4826         ADD     HL,BC           ; add C ( B is zero)
   4827         LD      B,(HL)          ; pick up the priority in B
   4828 
   4829 ;; S-LOOP
   4830 L10BC:  POP     DE              ; restore previous
   4831         LD      A,D             ; load A with priority.
   4832         CP      B               ; is present priority higher
   4833         JR      C,L10ED         ; forward if so to S-TIGHTER
   4834 
   4835         AND     A               ; are both priorities zero
   4836         JP      Z,L0018         ; exit if zero via GET-CHAR
   4837 
   4838         PUSH    BC              ; stack present values
   4839         PUSH    DE              ; stack last values
   4840         CALL    L0DA6           ; routine SYNTAX-Z
   4841         JR      Z,L10D5         ; forward is checking syntax to S-SYNTEST
   4842 
   4843         LD      A,E             ; fetch last operation
   4844         AND     $3F             ; mask off the indicator bits to give true
   4845                                 ; calculator literal.
   4846         LD      B,A             ; place in the B register for BREG
   4847 
   4848 ; perform the single operation
   4849 
   4850         RST     28H             ;; FP-CALC
   4851         DEFB    $37             ;;fp-calc-2
   4852         DEFB    $34             ;;end-calc
   4853 
   4854         JR      L10DE           ; forward to S-RUNTEST
   4855 
   4856 ; ---
   4857 
   4858 ;; S-SYNTEST
   4859 L10D5:  LD      A,E             ; transfer masked operator to A
   4860         XOR     (IY+$01)        ; XOR with FLAGS like results will reset bit 6
   4861         AND     $40             ; test bit 6
   4862 
   4863 ;; S-RPORT-C
   4864 L10DB:  JP      NZ,L0D9A        ; back to REPORT-C if results do not agree.
   4865 
   4866 ; ---
   4867 
   4868 ; in run-time impose bit 7 of the operator onto bit 6 of the FLAGS
   4869 
   4870 ;; S-RUNTEST
   4871 L10DE:  POP     DE              ; restore last operation.
   4872         LD      HL,$4001        ; address system variable FLAGS
   4873         SET     6,(HL)          ; presume a numeric result
   4874         BIT     7,E             ; test expected result in operation
   4875         JR      NZ,L10EA        ; forward if numeric to S-LOOPEND
   4876 
   4877         RES     6,(HL)          ; reset to signal string result
   4878 
   4879 ;; S-LOOPEND
   4880 L10EA:  POP     BC              ; restore present values
   4881         JR      L10BC           ; back to S-LOOP
   4882 
   4883 ; ---
   4884 
   4885 ;; S-TIGHTER
   4886 L10ED:  PUSH    DE              ; push last values and consider these
   4887 
   4888         LD      A,C             ; get the present operator.
   4889         BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result?
   4890         JR      NZ,L110A        ; forward if numeric to S-NEXT
   4891 
   4892         AND     $3F             ; strip indicator bits to give clear literal.
   4893         ADD     A,$08           ; add eight - augmenting numeric to equivalent
   4894                                 ; string literals.
   4895         LD      C,A             ; place plain literal back in C.
   4896         CP      $10             ; compare to 'AND'
   4897         JR      NZ,L1102        ; forward if not to S-NOT-AND
   4898 
   4899         SET     6,C             ; set the numeric operand required for 'AND'
   4900         JR      L110A           ; forward to S-NEXT
   4901 
   4902 ; ---
   4903 
   4904 ;; S-NOT-AND
   4905 L1102:  JR      C,L10DB         ; back if less than 'AND' to S-RPORT-C
   4906                                 ; Nonsense if '-', '*' etc.
   4907 
   4908         CP      $17             ; compare to 'strs-add' literal
   4909         JR      Z,L110A         ; forward if so signaling string result
   4910 
   4911         SET     7,C             ; set bit to numeric (Boolean) for others.
   4912 
   4913 ;; S-NEXT
   4914 L110A:  PUSH    BC              ; stack 'present' values
   4915 
   4916         RST     20H             ; NEXT-CHAR
   4917         JP      L0F59           ; jump back to S-LOOP-1
   4918 
   4919 
   4920 
   4921 ; -------------------------
   4922 ; THE 'TABLE OF PRIORITIES'
   4923 ; -------------------------
   4924 ;
   4925 ;
   4926 
   4927 ;; tbl-pri
   4928 L110F:  DEFB    $06             ;       '-'
   4929         DEFB    $08             ;       '*'
   4930         DEFB    $08             ;       '/'
   4931         DEFB    $0A             ;       '**'
   4932         DEFB    $02             ;       'OR'
   4933         DEFB    $03             ;       'AND'
   4934         DEFB    $05             ;       '<='
   4935         DEFB    $05             ;       '>='
   4936         DEFB    $05             ;       '<>'
   4937         DEFB    $05             ;       '>'
   4938         DEFB    $05             ;       '<'
   4939         DEFB    $05             ;       '='
   4940         DEFB    $06             ;       '+'
   4941 
   4942 
   4943 ; --------------------------
   4944 ; THE 'LOOK-VARS' SUBROUTINE
   4945 ; --------------------------
   4946 ;
   4947 ;
   4948 
   4949 ;; LOOK-VARS
   4950 L111C:  SET     6,(IY+$01)      ; sv FLAGS  - Signal numeric result
   4951 
   4952         RST     18H             ; GET-CHAR
   4953         CALL    L14CE           ; routine ALPHA
   4954         JP      NC,L0D9A        ; to REPORT-C
   4955 
   4956         PUSH    HL              ;
   4957         LD      C,A             ;
   4958 
   4959         RST     20H             ; NEXT-CHAR
   4960         PUSH    HL              ;
   4961         RES     5,C             ;
   4962         CP      $10             ;
   4963         JR      Z,L1148         ; to V-SYN/RUN
   4964 
   4965         SET     6,C             ;
   4966         CP      $0D             ;
   4967         JR      Z,L1143         ; forward to V-STR-VAR
   4968 
   4969         SET     5,C             ;
   4970 
   4971 ;; V-CHAR
   4972 L1139:  CALL    L14D2           ; routine ALPHANUM
   4973         JR      NC,L1148        ; forward when not to V-RUN/SYN
   4974 
   4975         RES     6,C             ;
   4976 
   4977         RST     20H             ; NEXT-CHAR
   4978         JR      L1139           ; loop back to V-CHAR
   4979 
   4980 ; ---
   4981 
   4982 ;; V-STR-VAR
   4983 L1143:  RST     20H             ; NEXT-CHAR
   4984         RES     6,(IY+$01)      ; sv FLAGS  - Signal string result
   4985 
   4986 ;; V-RUN/SYN
   4987 L1148:  LD      B,C             ;
   4988         CALL    L0DA6           ; routine SYNTAX-Z
   4989         JR      NZ,L1156        ; forward to V-RUN
   4990 
   4991         LD      A,C             ;
   4992         AND     $E0             ;
   4993         SET     7,A             ;
   4994         LD      C,A             ;
   4995         JR      L118A           ; forward to V-SYNTAX
   4996 
   4997 ; ---
   4998 
   4999 ;; V-RUN
   5000 L1156:  LD      HL,($4010)      ; sv VARS
   5001 
   5002 ;; V-EACH
   5003 L1159:  LD      A,(HL)          ;
   5004         AND     $7F             ;
   5005         JR      Z,L1188         ; to V-80-BYTE
   5006 
   5007         CP      C               ;
   5008         JR      NZ,L1180        ; to V-NEXT
   5009 
   5010         RLA                     ;
   5011         ADD     A,A             ;
   5012         JP      P,L1195         ; to V-FOUND-2
   5013 
   5014         JR      C,L1195         ; to V-FOUND-2
   5015 
   5016         POP     DE              ;
   5017         PUSH    DE              ;
   5018         PUSH    HL              ;
   5019 
   5020 ;; V-MATCHES
   5021 L116B:  INC     HL              ;
   5022 
   5023 ;; V-SPACES
   5024 L116C:  LD      A,(DE)          ;
   5025         INC     DE              ;
   5026         AND     A               ;
   5027         JR      Z,L116C         ; back to V-SPACES
   5028 
   5029         CP      (HL)            ;
   5030         JR      Z,L116B         ; back to V-MATCHES
   5031 
   5032         OR      $80             ;
   5033         CP      (HL)            ;
   5034         JR       NZ,L117F       ; forward to V-GET-PTR
   5035 
   5036         LD      A,(DE)          ;
   5037         CALL    L14D2           ; routine ALPHANUM
   5038         JR      NC,L1194        ; forward to V-FOUND-1
   5039 
   5040 ;; V-GET-PTR
   5041 L117F:  POP     HL              ;
   5042 
   5043 ;; V-NEXT
   5044 L1180:  PUSH    BC              ;
   5045         CALL    L09F2           ; routine NEXT-ONE
   5046         EX      DE,HL           ;
   5047         POP     BC              ;
   5048         JR      L1159           ; back to V-EACH
   5049 
   5050 ; ---
   5051 
   5052 ;; V-80-BYTE
   5053 L1188:  SET     7,B             ;
   5054 
   5055 ;; V-SYNTAX
   5056 L118A:  POP     DE              ;
   5057 
   5058         RST     18H             ; GET-CHAR
   5059         CP      $10             ;
   5060         JR      Z,L1199         ; forward to V-PASS
   5061 
   5062         SET     5,B             ;
   5063         JR      L11A1           ; forward to V-END
   5064 
   5065 ; ---
   5066 
   5067 ;; V-FOUND-1
   5068 L1194:  POP     DE              ;
   5069 
   5070 ;; V-FOUND-2
   5071 L1195:  POP     DE              ;
   5072         POP     DE              ;
   5073         PUSH    HL              ;
   5074 
   5075         RST     18H             ; GET-CHAR
   5076 
   5077 ;; V-PASS
   5078 L1199:  CALL    L14D2           ; routine ALPHANUM
   5079         JR      NC,L11A1        ; forward if not alphanumeric to V-END
   5080 
   5081 
   5082         RST     20H             ; NEXT-CHAR
   5083         JR      L1199           ; back to V-PASS
   5084 
   5085 ; ---
   5086 
   5087 ;; V-END
   5088 L11A1:  POP     HL              ;
   5089         RL      B               ;
   5090         BIT     6,B             ;
   5091         RET                     ;
   5092 
   5093 ; ------------------------
   5094 ; THE 'STK-VAR' SUBROUTINE
   5095 ; ------------------------
   5096 ;
   5097 ;
   5098 
   5099 ;; STK-VAR
   5100 L11A7:  XOR     A               ;
   5101         LD      B,A             ;
   5102         BIT     7,C             ;
   5103         JR      NZ,L11F8        ; forward to SV-COUNT
   5104 
   5105         BIT     7,(HL)          ;
   5106         JR      NZ,L11BF        ; forward to SV-ARRAYS
   5107 
   5108         INC     A               ;
   5109 
   5110 ;; SV-SIMPLE$
   5111 L11B2:  INC     HL              ;
   5112         LD      C,(HL)          ;
   5113         INC     HL              ;
   5114         LD      B,(HL)          ;
   5115         INC     HL              ;
   5116         EX      DE,HL           ;
   5117         CALL    L12C3           ; routine STK-STO-$
   5118 
   5119         RST     18H             ; GET-CHAR
   5120         JP      L125A           ; jump forward to SV-SLICE?
   5121 
   5122 ; ---
   5123 
   5124 ;; SV-ARRAYS
   5125 L11BF:  INC     HL              ;
   5126         INC     HL              ;
   5127         INC     HL              ;
   5128         LD      B,(HL)          ;
   5129         BIT     6,C             ;
   5130         JR      Z,L11D1         ; forward to SV-PTR
   5131 
   5132         DEC     B               ;
   5133         JR      Z,L11B2         ; forward to SV-SIMPLE$
   5134 
   5135         EX      DE,HL           ;
   5136 
   5137         RST     18H             ; GET-CHAR
   5138         CP      $10             ;
   5139         JR      NZ,L1231        ; forward to REPORT-3
   5140 
   5141         EX      DE,HL           ;
   5142 
   5143 ;; SV-PTR
   5144 L11D1:  EX      DE,HL           ;
   5145         JR      L11F8           ; forward to SV-COUNT
   5146 
   5147 ; ---
   5148 
   5149 ;; SV-COMMA
   5150 L11D4:  PUSH    HL              ;
   5151 
   5152         RST     18H             ; GET-CHAR
   5153         POP     HL              ;
   5154         CP      $1A             ;
   5155         JR      Z,L11FB         ; forward to SV-LOOP
   5156 
   5157         BIT     7,C             ;
   5158         JR      Z,L1231         ; forward to REPORT-3
   5159 
   5160         BIT     6,C             ;
   5161         JR      NZ,L11E9        ; forward to SV-CLOSE
   5162 
   5163         CP      $11             ;
   5164         JR      NZ,L1223        ; forward to SV-RPT-C
   5165 
   5166 
   5167         RST     20H             ; NEXT-CHAR
   5168         RET                     ;
   5169 
   5170 ; ---
   5171 
   5172 ;; SV-CLOSE
   5173 L11E9:  CP      $11             ;
   5174         JR      Z,L1259         ; forward to SV-DIM
   5175 
   5176         CP      $DF             ;
   5177         JR      NZ,L1223        ; forward to SV-RPT-C
   5178 
   5179 
   5180 ;; SV-CH-ADD
   5181 L11F1:  RST     18H             ; GET-CHAR
   5182         DEC     HL              ;
   5183         LD      ($4016),HL      ; sv CH_ADD
   5184         JR      L1256           ; forward to SV-SLICE
   5185 
   5186 ; ---
   5187 
   5188 ;; SV-COUNT
   5189 L11F8:  LD      HL,$0000        ;
   5190 
   5191 ;; SV-LOOP
   5192 L11FB:  PUSH    HL              ;
   5193 
   5194         RST     20H             ; NEXT-CHAR
   5195         POP     HL              ;
   5196         LD      A,C             ;
   5197         CP      $C0             ;
   5198         JR      NZ,L120C        ; forward to SV-MULT
   5199 
   5200 
   5201         RST     18H             ; GET-CHAR
   5202         CP      $11             ;
   5203         JR      Z,L1259         ; forward to SV-DIM
   5204 
   5205         CP      $DF             ;
   5206         JR      Z,L11F1         ; back to SV-CH-ADD
   5207 
   5208 ;; SV-MULT
   5209 L120C:  PUSH    BC              ;
   5210         PUSH    HL              ;
   5211         CALL    L12FF           ; routine DE,(DE+1)
   5212         EX      (SP),HL         ;
   5213         EX      DE,HL           ;
   5214         CALL    L12DD           ; routine INT-EXP1
   5215         JR      C,L1231         ; forward to REPORT-3
   5216 
   5217         DEC     BC              ;
   5218         CALL    L1305           ; routine GET-HL*DE
   5219         ADD     HL,BC           ;
   5220         POP     DE              ;
   5221         POP     BC              ;
   5222         DJNZ    L11D4           ; loop back to SV-COMMA
   5223 
   5224         BIT     7,C             ;
   5225 
   5226 ;; SV-RPT-C
   5227 L1223:  JR      NZ,L128B        ; relative jump to SL-RPT-C
   5228 
   5229         PUSH    HL              ;
   5230         BIT     6,C             ;
   5231         JR      NZ,L123D        ; forward to SV-ELEM$
   5232 
   5233         LD      B,D             ;
   5234         LD      C,E             ;
   5235 
   5236         RST     18H             ; GET-CHAR
   5237         CP      $11             ; is character a ')' ?
   5238         JR      Z,L1233         ; skip forward to SV-NUMBER
   5239 
   5240 
   5241 ;; REPORT-3
   5242 L1231:  RST     08H             ; ERROR-1
   5243         DEFB    $02             ; Error Report: Subscript wrong
   5244 
   5245 
   5246 ;; SV-NUMBER
   5247 L1233:  RST     20H             ; NEXT-CHAR
   5248         POP     HL              ;
   5249         LD      DE,$0005        ;
   5250         CALL    L1305           ; routine GET-HL*DE
   5251         ADD     HL,BC           ;
   5252         RET                     ; return                            >>
   5253 
   5254 ; ---
   5255 
   5256 ;; SV-ELEM$
   5257 L123D:  CALL    L12FF           ; routine DE,(DE+1)
   5258         EX      (SP),HL         ;
   5259         CALL    L1305           ; routine GET-HL*DE
   5260         POP     BC              ;
   5261         ADD     HL,BC           ;
   5262         INC     HL              ;
   5263         LD      B,D             ;
   5264         LD      C,E             ;
   5265         EX      DE,HL           ;
   5266         CALL    L12C2           ; routine STK-ST-0
   5267 
   5268         RST     18H             ; GET-CHAR
   5269         CP      $11             ; is it ')' ?
   5270         JR      Z,L1259         ; forward if so to SV-DIM
   5271 
   5272         CP      $1A             ; is it ',' ?
   5273         JR      NZ,L1231        ; back if not to REPORT-3
   5274 
   5275 ;; SV-SLICE
   5276 L1256:  CALL    L1263           ; routine SLICING
   5277 
   5278 ;; SV-DIM
   5279 L1259:  RST     20H             ; NEXT-CHAR
   5280 
   5281 ;; SV-SLICE?
   5282 L125A:  CP      $10             ;
   5283         JR      Z,L1256         ; back to SV-SLICE
   5284 
   5285         RES     6,(IY+$01)      ; sv FLAGS  - Signal string result
   5286         RET                     ; return.
   5287 
   5288 ; ------------------------
   5289 ; THE 'SLICING' SUBROUTINE
   5290 ; ------------------------
   5291 ;
   5292 ;
   5293 
   5294 ;; SLICING
   5295 L1263:  CALL    L0DA6           ; routine SYNTAX-Z
   5296         CALL    NZ,L13F8        ; routine STK-FETCH
   5297 
   5298         RST     20H             ; NEXT-CHAR
   5299         CP      $11             ; is it ')' ?
   5300         JR      Z,L12BE         ; forward if so to SL-STORE
   5301 
   5302         PUSH    DE              ;
   5303         XOR     A               ;
   5304         PUSH    AF              ;
   5305         PUSH    BC              ;
   5306         LD      DE,$0001        ;
   5307 
   5308         RST     18H             ; GET-CHAR
   5309         POP     HL              ;
   5310         CP      $DF             ; is it 'TO' ?
   5311         JR      Z,L1292         ; forward if so to SL-SECOND
   5312 
   5313         POP     AF              ;
   5314         CALL    L12DE           ; routine INT-EXP2
   5315         PUSH    AF              ;
   5316         LD      D,B             ;
   5317         LD      E,C             ;
   5318         PUSH    HL              ;
   5319 
   5320         RST     18H             ; GET-CHAR
   5321         POP     HL              ;
   5322         CP      $DF             ; is it 'TO' ?
   5323         JR      Z,L1292         ; forward if so to SL-SECOND
   5324 
   5325         CP      $11             ;
   5326 
   5327 ;; SL-RPT-C
   5328 L128B:  JP      NZ,L0D9A        ; to REPORT-C
   5329 
   5330         LD      H,D             ;
   5331         LD      L,E             ;
   5332         JR      L12A5           ; forward to SL-DEFINE
   5333 
   5334 ; ---
   5335 
   5336 ;; SL-SECOND
   5337 L1292:  PUSH    HL              ;
   5338 
   5339         RST     20H             ; NEXT-CHAR
   5340         POP     HL              ;
   5341         CP      $11             ; is it ')' ?
   5342         JR      Z,L12A5         ; forward if so to SL-DEFINE
   5343 
   5344         POP     AF              ;
   5345         CALL    L12DE           ; routine INT-EXP2
   5346         PUSH    AF              ;
   5347 
   5348         RST     18H             ; GET-CHAR
   5349         LD      H,B             ;
   5350         LD      L,C             ;
   5351         CP      $11             ; is it ')' ?
   5352         JR      NZ,L128B        ; back if not to SL-RPT-C
   5353 
   5354 ;; SL-DEFINE
   5355 L12A5:  POP     AF              ;
   5356         EX      (SP),HL         ;
   5357         ADD     HL,DE           ;
   5358         DEC     HL              ;
   5359         EX      (SP),HL         ;
   5360         AND     A               ;
   5361         SBC     HL,DE           ;
   5362         LD      BC,$0000        ;
   5363         JR      C,L12B9         ; forward to SL-OVER
   5364 
   5365         INC     HL              ;
   5366         AND     A               ;
   5367         JP      M,L1231         ; jump back to REPORT-3
   5368 
   5369         LD      B,H             ;
   5370         LD      C,L             ;
   5371 
   5372 ;; SL-OVER
   5373 L12B9:  POP     DE              ;
   5374         RES     6,(IY+$01)      ; sv FLAGS  - Signal string result
   5375 
   5376 ;; SL-STORE
   5377 L12BE:  CALL    L0DA6           ; routine SYNTAX-Z
   5378         RET     Z               ; return if checking syntax.
   5379 
   5380 ; --------------------------
   5381 ; THE 'STK-STORE' SUBROUTINE
   5382 ; --------------------------
   5383 ;
   5384 ;
   5385 
   5386 ;; STK-ST-0
   5387 L12C2:  XOR     A               ;
   5388 
   5389 ;; STK-STO-$
   5390 L12C3:  PUSH    BC              ;
   5391         CALL    L19EB           ; routine TEST-5-SP
   5392         POP     BC              ;
   5393         LD      HL,($401C)      ; sv STKEND
   5394         LD      (HL),A          ;
   5395         INC     HL              ;
   5396         LD      (HL),E          ;
   5397         INC     HL              ;
   5398         LD      (HL),D          ;
   5399         INC     HL              ;
   5400         LD      (HL),C          ;
   5401         INC     HL              ;
   5402         LD      (HL),B          ;
   5403         INC     HL              ;
   5404         LD      ($401C),HL      ; sv STKEND
   5405         RES     6,(IY+$01)      ; update FLAGS - signal string result
   5406         RET                     ; return.
   5407 
   5408 ; -------------------------
   5409 ; THE 'INT EXP' SUBROUTINES
   5410 ; -------------------------
   5411 ;
   5412 ;
   5413 
   5414 ;; INT-EXP1
   5415 L12DD:  XOR     A               ;
   5416 
   5417 ;; INT-EXP2
   5418 L12DE:  PUSH    DE              ;
   5419         PUSH    HL              ;
   5420         PUSH    AF              ;
   5421         CALL    L0D92           ; routine CLASS-6
   5422         POP     AF              ;
   5423         CALL    L0DA6           ; routine SYNTAX-Z
   5424         JR      Z,L12FC         ; forward if checking syntax to I-RESTORE
   5425 
   5426         PUSH    AF              ;
   5427         CALL    L0EA7           ; routine FIND-INT
   5428         POP     DE              ;
   5429         LD      A,B             ;
   5430         OR      C               ;
   5431         SCF                     ; Set Carry Flag
   5432         JR      Z,L12F9         ; forward to I-CARRY
   5433 
   5434         POP     HL              ;
   5435         PUSH    HL              ;
   5436         AND     A               ;
   5437         SBC     HL,BC           ;
   5438 
   5439 ;; I-CARRY
   5440 L12F9:  LD      A,D             ;
   5441         SBC     A,$00           ;
   5442 
   5443 ;; I-RESTORE
   5444 L12FC:  POP     HL              ;
   5445         POP     DE              ;
   5446         RET                     ;
   5447 
   5448 ; --------------------------
   5449 ; THE 'DE,(DE+1)' SUBROUTINE
   5450 ; --------------------------
   5451 ; INDEX and LOAD Z80 subroutine. 
   5452 ; This emulates the 6800 processor instruction LDX 1,X which loads a two-byte
   5453 ; value from memory into the register indexing it. Often these are hardly worth
   5454 ; the bother of writing as subroutines and this one doesn't save any time or 
   5455 ; memory. The timing and space overheads have to be offset against the ease of
   5456 ; writing and the greater program readability from using such toolkit routines.
   5457 
   5458 ;; DE,(DE+1)
   5459 L12FF:  EX      DE,HL           ; move index address into HL.
   5460         INC     HL              ; increment to address word.
   5461         LD      E,(HL)          ; pick up word low-order byte.
   5462         INC     HL              ; index high-order byte and 
   5463         LD      D,(HL)          ; pick it up.
   5464         RET                     ; return with DE = word.
   5465 
   5466 ; --------------------------
   5467 ; THE 'GET-HL*DE' SUBROUTINE
   5468 ; --------------------------
   5469 ;
   5470 
   5471 ;; GET-HL*DE
   5472 L1305:  CALL    L0DA6           ; routine SYNTAX-Z
   5473         RET     Z               ;
   5474 
   5475         PUSH    BC              ;
   5476         LD      B,$10           ;
   5477         LD      A,H             ;
   5478         LD      C,L             ;
   5479         LD      HL,$0000        ;
   5480 
   5481 ;; HL-LOOP
   5482 L1311:  ADD     HL,HL           ;
   5483         JR      C,L131A         ; forward with carry to HL-END
   5484 
   5485         RL      C               ;
   5486         RLA                     ;
   5487         JR      NC,L131D        ; forward with no carry to HL-AGAIN
   5488 
   5489         ADD     HL,DE           ;
   5490 
   5491 ;; HL-END
   5492 L131A:  JP      C,L0ED3         ; to REPORT-4
   5493 
   5494 ;; HL-AGAIN
   5495 L131D:  DJNZ    L1311           ; loop back to HL-LOOP
   5496 
   5497         POP     BC              ;
   5498         RET                     ; return.
   5499 
   5500 ; --------------------
   5501 ; THE 'LET' SUBROUTINE
   5502 ; --------------------
   5503 ;
   5504 ;
   5505 
   5506 ;; LET
   5507 L1321:  LD      HL,($4012)      ; sv DEST-lo
   5508         BIT     1,(IY+$2D)      ; sv FLAGX
   5509         JR      Z,L136E         ; forward to L-EXISTS
   5510 
   5511         LD      BC,$0005        ;
   5512 
   5513 ;; L-EACH-CH
   5514 L132D:  INC     BC              ;
   5515 
   5516 ; check
   5517 
   5518 ;; L-NO-SP
   5519 L132E:  INC     HL              ;
   5520         LD      A,(HL)          ;
   5521         AND     A               ;
   5522         JR      Z,L132E         ; back to L-NO-SP
   5523 
   5524         CALL    L14D2           ; routine ALPHANUM
   5525         JR      C,L132D         ; back to L-EACH-CH
   5526 
   5527         CP      $0D             ; is it '$' ?
   5528         JP      Z,L13C8         ; forward if so to L-NEW$
   5529 
   5530 
   5531         RST     30H             ; BC-SPACES
   5532         PUSH    DE              ;
   5533         LD      HL,($4012)      ; sv DEST
   5534         DEC     DE              ;
   5535         LD      A,C             ;
   5536         SUB     $06             ;
   5537         LD      B,A             ;
   5538         LD      A,$40           ;
   5539         JR      Z,L1359         ; forward to L-SINGLE
   5540 
   5541 ;; L-CHAR
   5542 L134B:  INC     HL              ;
   5543         LD      A,(HL)          ;
   5544         AND     A               ; is it a space ?
   5545         JR      Z,L134B         ; back to L-CHAR
   5546 
   5547         INC     DE              ;
   5548         LD      (DE),A          ;
   5549         DJNZ    L134B           ; loop back to L-CHAR
   5550 
   5551         OR      $80             ;
   5552         LD      (DE),A          ;
   5553         LD      A,$80           ;
   5554 
   5555 ;; L-SINGLE
   5556 L1359:  LD      HL,($4012)      ; sv DEST-lo
   5557         XOR     (HL)            ;
   5558         POP     HL              ;
   5559         CALL    L13E7           ; routine L-FIRST
   5560 
   5561 ;; L-NUMERIC
   5562 L1361:  PUSH    HL              ;
   5563 
   5564         RST     28H             ;; FP-CALC
   5565         DEFB    $02             ;;delete
   5566         DEFB    $34             ;;end-calc
   5567 
   5568         POP     HL              ;
   5569         LD      BC,$0005        ;
   5570         AND     A               ;
   5571         SBC     HL,BC           ;
   5572         JR      L13AE           ; forward to L-ENTER
   5573 
   5574 ; ---
   5575 
   5576 ;; L-EXISTS
   5577 L136E:  BIT     6,(IY+$01)      ; sv FLAGS  - Numeric or string result?
   5578         JR      Z,L137A         ; forward to L-DELETE$
   5579 
   5580         LD      DE,$0006        ;
   5581         ADD     HL,DE           ;
   5582         JR      L1361           ; back to L-NUMERIC
   5583 
   5584 ; ---
   5585 
   5586 ;; L-DELETE$
   5587 L137A:  LD      HL,($4012)      ; sv DEST-lo
   5588         LD      BC,($402E)      ; sv STRLEN_lo
   5589         BIT     0,(IY+$2D)      ; sv FLAGX
   5590         JR      NZ,L13B7        ; forward to L-ADD$
   5591 
   5592         LD      A,B             ;
   5593         OR      C               ;
   5594         RET     Z               ;
   5595 
   5596         PUSH    HL              ;
   5597 
   5598         RST     30H             ; BC-SPACES
   5599         PUSH    DE              ;
   5600         PUSH    BC              ;
   5601         LD      D,H             ;
   5602         LD      E,L             ;
   5603         INC     HL              ;
   5604         LD      (HL),$00        ;
   5605         LDDR                    ; Copy Bytes
   5606         PUSH    HL              ;
   5607         CALL    L13F8           ; routine STK-FETCH
   5608         POP     HL              ;
   5609         EX      (SP),HL         ;
   5610         AND     A               ;
   5611         SBC     HL,BC           ;
   5612         ADD     HL,BC           ;
   5613         JR      NC,L13A3        ; forward to L-LENGTH
   5614 
   5615         LD      B,H             ;
   5616         LD      C,L             ;
   5617 
   5618 ;; L-LENGTH
   5619 L13A3:  EX      (SP),HL         ;
   5620         EX      DE,HL           ;
   5621         LD      A,B             ;
   5622         OR      C               ;
   5623         JR      Z,L13AB         ; forward if zero to L-IN-W/S
   5624 
   5625         LDIR                    ; Copy Bytes
   5626 
   5627 ;; L-IN-W/S
   5628 L13AB:  POP     BC              ;
   5629         POP     DE              ;
   5630         POP     HL              ;
   5631 
   5632 ; ------------------------
   5633 ; THE 'L-ENTER' SUBROUTINE
   5634 ; ------------------------
   5635 ;
   5636 
   5637 ;; L-ENTER
   5638 L13AE:  EX      DE,HL           ;
   5639         LD      A,B             ;
   5640         OR      C               ;
   5641         RET     Z               ;
   5642 
   5643         PUSH    DE              ;
   5644         LDIR                    ; Copy Bytes
   5645         POP     HL              ;
   5646         RET                     ; return.
   5647 
   5648 ; ---
   5649 
   5650 ;; L-ADD$
   5651 L13B7:  DEC     HL              ;
   5652         DEC     HL              ;
   5653         DEC     HL              ;
   5654         LD      A,(HL)          ;
   5655         PUSH    HL              ;
   5656         PUSH    BC              ;
   5657 
   5658         CALL    L13CE           ; routine L-STRING
   5659 
   5660         POP     BC              ;
   5661         POP     HL              ;
   5662         INC     BC              ;
   5663         INC     BC              ;
   5664         INC     BC              ;
   5665         JP      L0A60           ; jump back to exit via RECLAIM-2
   5666 
   5667 ; ---
   5668 
   5669 ;; L-NEW$
   5670 L13C8:  LD      A,$60           ; prepare mask %01100000
   5671         LD      HL,($4012)      ; sv DEST-lo
   5672         XOR     (HL)            ;
   5673 
   5674 ; -------------------------
   5675 ; THE 'L-STRING' SUBROUTINE
   5676 ; -------------------------
   5677 ;
   5678 
   5679 ;; L-STRING
   5680 L13CE:  PUSH    AF              ;
   5681         CALL    L13F8           ; routine STK-FETCH
   5682         EX      DE,HL           ;
   5683         ADD     HL,BC           ;
   5684         PUSH    HL              ;
   5685         INC     BC              ;
   5686         INC     BC              ;
   5687         INC     BC              ;
   5688 
   5689         RST     30H             ; BC-SPACES
   5690         EX      DE,HL           ;
   5691         POP     HL              ;
   5692         DEC     BC              ;
   5693         DEC     BC              ;
   5694         PUSH    BC              ;
   5695         LDDR                    ; Copy Bytes
   5696         EX      DE,HL           ;
   5697         POP     BC              ;
   5698         DEC     BC              ;
   5699         LD      (HL),B          ;
   5700         DEC     HL              ;
   5701         LD      (HL),C          ;
   5702         POP     AF              ;
   5703 
   5704 ;; L-FIRST
   5705 L13E7:  PUSH    AF              ;
   5706         CALL    L14C7           ; routine REC-V80
   5707         POP     AF              ;
   5708         DEC     HL              ;
   5709         LD      (HL),A          ;
   5710         LD      HL,($401A)      ; sv STKBOT_lo
   5711         LD      ($4014),HL      ; sv E_LINE_lo
   5712         DEC     HL              ;
   5713         LD      (HL),$80        ;
   5714         RET                     ;
   5715 
   5716 ; --------------------------
   5717 ; THE 'STK-FETCH' SUBROUTINE
   5718 ; --------------------------
   5719 ; This routine fetches a five-byte value from the calculator stack
   5720 ; reducing the pointer to the end of the stack by five.
   5721 ; For a floating-point number the exponent is in A and the mantissa
   5722 ; is the thirty-two bits EDCB.
   5723 ; For strings, the start of the string is in DE and the length in BC.
   5724 ; A is unused.
   5725 
   5726 ;; STK-FETCH
   5727 L13F8:  LD      HL,($401C)      ; load HL from system variable STKEND
   5728 
   5729         DEC     HL              ;
   5730         LD      B,(HL)          ;
   5731         DEC     HL              ;
   5732         LD      C,(HL)          ;
   5733         DEC     HL              ;
   5734         LD      D,(HL)          ;
   5735         DEC     HL              ;
   5736         LD      E,(HL)          ;
   5737         DEC     HL              ;
   5738         LD      A,(HL)          ;
   5739 
   5740         LD      ($401C),HL      ; set system variable STKEND to lower value.
   5741         RET                     ; return.
   5742 
   5743 ; -------------------------
   5744 ; THE 'DIM' COMMAND ROUTINE
   5745 ; -------------------------
   5746 ; An array is created and initialized to zeros which is also the space
   5747 ; character on the ZX81.
   5748 
   5749 ;; DIM
   5750 L1409:  CALL    L111C           ; routine LOOK-VARS
   5751 
   5752 ;; D-RPORT-C
   5753 L140C:  JP      NZ,L0D9A        ; to REPORT-C
   5754 
   5755         CALL    L0DA6           ; routine SYNTAX-Z
   5756         JR      NZ,L141C        ; forward to D-RUN
   5757 
   5758         RES     6,C             ;
   5759         CALL    L11A7           ; routine STK-VAR
   5760         CALL    L0D1D           ; routine CHECK-END
   5761 
   5762 ;; D-RUN
   5763 L141C:  JR      C,L1426         ; forward to D-LETTER
   5764 
   5765         PUSH    BC              ;
   5766         CALL    L09F2           ; routine NEXT-ONE
   5767         CALL    L0A60           ; routine RECLAIM-2
   5768         POP     BC              ;
   5769 
   5770 ;; D-LETTER
   5771 L1426:  SET     7,C             ;
   5772         LD      B,$00           ;
   5773         PUSH    BC              ;
   5774         LD      HL,$0001        ;
   5775         BIT     6,C             ;
   5776         JR      NZ,L1434        ; forward to D-SIZE
   5777 
   5778         LD      L,$05           ;
   5779 
   5780 ;; D-SIZE
   5781 L1434:  EX      DE,HL           ;
   5782 
   5783 ;; D-NO-LOOP
   5784 L1435:  RST     20H             ; NEXT-CHAR
   5785         LD      H,$40           ;
   5786         CALL    L12DD           ; routine INT-EXP1
   5787         JP      C,L1231         ; jump back to REPORT-3
   5788 
   5789         POP     HL              ;
   5790         PUSH    BC              ;
   5791         INC     H               ;
   5792         PUSH    HL              ;
   5793         LD      H,B             ;
   5794         LD      L,C             ;
   5795         CALL    L1305           ; routine GET-HL*DE
   5796         EX      DE,HL           ;
   5797 
   5798         RST     18H             ; GET-CHAR
   5799         CP      $1A             ;
   5800         JR      Z,L1435         ; back to D-NO-LOOP
   5801 
   5802         CP      $11             ; is it ')' ?
   5803         JR      NZ,L140C        ; back if not to D-RPORT-C
   5804 
   5805 
   5806         RST     20H             ; NEXT-CHAR
   5807         POP     BC              ;
   5808         LD      A,C             ;
   5809         LD      L,B             ;
   5810         LD      H,$00           ;
   5811         INC     HL              ;
   5812         INC     HL              ;
   5813         ADD     HL,HL           ;
   5814         ADD     HL,DE           ;
   5815         JP      C,L0ED3         ; jump to REPORT-4
   5816 
   5817         PUSH    DE              ;
   5818         PUSH    BC              ;
   5819         PUSH    HL              ;
   5820         LD      B,H             ;
   5821         LD      C,L             ;
   5822         LD      HL,($4014)      ; sv E_LINE_lo
   5823         DEC     HL              ;
   5824         CALL    L099E           ; routine MAKE-ROOM
   5825         INC     HL              ;
   5826         LD       (HL),A         ;
   5827         POP     BC              ;
   5828         DEC     BC              ;
   5829         DEC     BC              ;
   5830         DEC     BC              ;
   5831         INC     HL              ;
   5832         LD      (HL),C          ;
   5833         INC     HL              ;
   5834         LD      (HL),B          ;
   5835         POP     AF              ;
   5836         INC     HL              ;
   5837         LD      (HL),A          ;
   5838         LD      H,D             ;
   5839         LD      L,E             ;
   5840         DEC     DE              ;
   5841         LD      (HL),$00        ;
   5842         POP     BC              ;
   5843         LDDR                    ; Copy Bytes
   5844 
   5845 ;; DIM-SIZES
   5846 L147F:  POP     BC              ;
   5847         LD      (HL),B          ;
   5848         DEC     HL              ;
   5849         LD      (HL),C          ;
   5850         DEC     HL              ;
   5851         DEC     A               ;
   5852         JR      NZ,L147F        ; back to DIM-SIZES
   5853 
   5854         RET                     ; return.
   5855 
   5856 ; ---------------------
   5857 ; THE 'RESERVE' ROUTINE
   5858 ; ---------------------
   5859 ;
   5860 ;
   5861 
   5862 ;; RESERVE
   5863 L1488:  LD      HL,($401A)      ; address STKBOT
   5864         DEC     HL              ; now last byte of workspace
   5865         CALL    L099E           ; routine MAKE-ROOM
   5866         INC     HL              ;
   5867         INC     HL              ;
   5868         POP     BC              ;
   5869         LD      ($4014),BC      ; sv E_LINE_lo
   5870         POP     BC              ;
   5871         EX      DE,HL           ;
   5872         INC     HL              ;
   5873         RET                     ;
   5874 
   5875 ; ---------------------------
   5876 ; THE 'CLEAR' COMMAND ROUTINE
   5877 ; ---------------------------
   5878 ;
   5879 ;
   5880 
   5881 ;; CLEAR
   5882 L149A:  LD      HL,($4010)      ; sv VARS_lo
   5883         LD      (HL),$80        ;
   5884         INC     HL              ;
   5885         LD      ($4014),HL      ; sv E_LINE_lo
   5886 
   5887 ; -----------------------
   5888 ; THE 'X-TEMP' SUBROUTINE
   5889 ; -----------------------
   5890 ;
   5891 ;
   5892 
   5893 ;; X-TEMP
   5894 L14A3:  LD      HL,($4014)      ; sv E_LINE_lo
   5895 
   5896 ; ----------------------
   5897 ; THE 'SET-STK' ROUTINES
   5898 ; ----------------------
   5899 ;
   5900 ;
   5901 
   5902 ;; SET-STK-B
   5903 L14A6:  LD      ($401A),HL      ; sv STKBOT
   5904 
   5905 ;
   5906 
   5907 ;; SET-STK-E
   5908 L14A9:  LD      ($401C),HL      ; sv STKEND
   5909         RET                     ;
   5910 
   5911 ; -----------------------
   5912 ; THE 'CURSOR-IN' ROUTINE
   5913 ; -----------------------
   5914 ; This routine is called to set the edit line to the minimum cursor/newline
   5915 ; and to set STKEND, the start of free space, at the next position.
   5916 
   5917 ;; CURSOR-IN
   5918 L14AD:  LD      HL,($4014)      ; fetch start of edit line from E_LINE
   5919         LD      (HL),$7F        ; insert cursor character
   5920 
   5921         INC     HL              ; point to next location.
   5922         LD      (HL),$76        ; insert NEWLINE character
   5923         INC     HL              ; point to next free location.
   5924 
   5925         LD      (IY+$22),$02    ; set lower screen display file size DF_SZ
   5926 
   5927         JR      L14A6           ; exit via SET-STK-B above
   5928 
   5929 ; ------------------------
   5930 ; THE 'SET-MIN' SUBROUTINE
   5931 ; ------------------------
   5932 ;
   5933 ;
   5934 
   5935 ;; SET-MIN
   5936 L14BC:  LD      HL,$405D        ; normal location of calculator's memory area
   5937         LD      ($401F),HL      ; update system variable MEM
   5938         LD      HL,($401A)      ; fetch STKBOT
   5939         JR      L14A9           ; back to SET-STK-E
   5940 
   5941 
   5942 ; ------------------------------------
   5943 ; THE 'RECLAIM THE END-MARKER' ROUTINE
   5944 ; ------------------------------------
   5945 
   5946 ;; REC-V80
   5947 L14C7:  LD      DE,($4014)      ; sv E_LINE_lo
   5948         JP      L0A5D           ; to RECLAIM-1
   5949 
   5950 ; ----------------------
   5951 ; THE 'ALPHA' SUBROUTINE
   5952 ; ----------------------
   5953 
   5954 ;; ALPHA
   5955 L14CE:  CP      $26             ;
   5956         JR      L14D4           ; skip forward to ALPHA-2
   5957 
   5958 
   5959 ; -------------------------
   5960 ; THE 'ALPHANUM' SUBROUTINE
   5961 ; -------------------------
   5962 
   5963 ;; ALPHANUM
   5964 L14D2:  CP      $1C             ;
   5965 
   5966 
   5967 ;; ALPHA-2
   5968 L14D4:  CCF                     ; Complement Carry Flag
   5969         RET     NC              ;
   5970 
   5971         CP      $40             ;
   5972         RET                     ;
   5973 
   5974 
   5975 ; ------------------------------------------
   5976 ; THE 'DECIMAL TO FLOATING POINT' SUBROUTINE
   5977 ; ------------------------------------------
   5978 ;
   5979 
   5980 ;; DEC-TO-FP
   5981 L14D9:  CALL    L1548           ; routine INT-TO-FP gets first part
   5982         CP      $1B             ; is character a '.' ?
   5983         JR      NZ,L14F5        ; forward if not to E-FORMAT
   5984 
   5985 
   5986         RST     28H             ;; FP-CALC
   5987         DEFB    $A1             ;;stk-one
   5988         DEFB    $C0             ;;st-mem-0
   5989         DEFB    $02             ;;delete
   5990         DEFB    $34             ;;end-calc
   5991 
   5992 
   5993 ;; NXT-DGT-1
   5994 L14E5:  RST     20H             ; NEXT-CHAR
   5995         CALL    L1514           ; routine STK-DIGIT
   5996         JR      C,L14F5         ; forward to E-FORMAT
   5997 
   5998 
   5999         RST     28H             ;; FP-CALC
   6000         DEFB    $E0             ;;get-mem-0
   6001         DEFB    $A4             ;;stk-ten
   6002         DEFB    $05             ;;division
   6003         DEFB    $C0             ;;st-mem-0
   6004         DEFB    $04             ;;multiply
   6005         DEFB    $0F             ;;addition
   6006         DEFB    $34             ;;end-calc
   6007 
   6008         JR      L14E5           ; loop back till exhausted to NXT-DGT-1
   6009 
   6010 ; ---
   6011 
   6012 ;; E-FORMAT
   6013 L14F5:  CP      $2A             ; is character 'E' ?
   6014         RET     NZ              ; return if not
   6015 
   6016         LD      (IY+$5D),$FF    ; initialize sv MEM-0-1st to $FF TRUE
   6017 
   6018         RST     20H             ; NEXT-CHAR
   6019         CP      $15             ; is character a '+' ?
   6020         JR      Z,L1508         ; forward if so to SIGN-DONE
   6021 
   6022         CP      $16             ; is it a '-' ?
   6023         JR      NZ,L1509        ; forward if not to ST-E-PART
   6024 
   6025         INC     (IY+$5D)        ; sv MEM-0-1st change to FALSE
   6026 
   6027 ;; SIGN-DONE
   6028 L1508:  RST     20H             ; NEXT-CHAR
   6029 
   6030 ;; ST-E-PART
   6031 L1509:  CALL    L1548           ; routine INT-TO-FP
   6032 
   6033         RST     28H             ;; FP-CALC              m, e.
   6034         DEFB    $E0             ;;get-mem-0             m, e, (1/0) TRUE/FALSE
   6035         DEFB    $00             ;;jump-true
   6036         DEFB    $02             ;;to L1511, E-POSTVE
   6037         DEFB    $18             ;;neg                   m, -e
   6038 
   6039 ;; E-POSTVE
   6040 L1511:  DEFB    $38             ;;e-to-fp               x.
   6041         DEFB    $34             ;;end-calc              x.
   6042 
   6043         RET                     ; return.
   6044 
   6045 
   6046 ; --------------------------
   6047 ; THE 'STK-DIGIT' SUBROUTINE
   6048 ; --------------------------
   6049 ;
   6050 
   6051 ;; STK-DIGIT
   6052 L1514:  CP      $1C             ;
   6053         RET     C               ;
   6054 
   6055         CP      $26             ;
   6056         CCF                     ; Complement Carry Flag
   6057         RET     C               ;
   6058 
   6059         SUB     $1C             ;
   6060 
   6061 ; ------------------------
   6062 ; THE 'STACK-A' SUBROUTINE
   6063 ; ------------------------
   6064 ;
   6065 
   6066 
   6067 ;; STACK-A
   6068 L151D:  LD      C,A             ;
   6069         LD      B,$00           ;
   6070 
   6071 ; -------------------------
   6072 ; THE 'STACK-BC' SUBROUTINE
   6073 ; -------------------------
   6074 ; The ZX81 does not have an integer number format so the BC register contents
   6075 ; must be converted to their full floating-point form.
   6076 
   6077 ;; STACK-BC
   6078 L1520:  LD      IY,$4000        ; re-initialize the system variables pointer.
   6079         PUSH    BC              ; save the integer value.
   6080 
   6081 ; now stack zero, five zero bytes as a starting point.
   6082 
   6083         RST     28H             ;; FP-CALC
   6084         DEFB    $A0             ;;stk-zero                      0.
   6085         DEFB    $34             ;;end-calc
   6086 
   6087         POP     BC              ; restore integer value.
   6088 
   6089         LD      (HL),$91        ; place $91 in exponent         65536.
   6090                                 ; this is the maximum possible value
   6091 
   6092         LD      A,B             ; fetch hi-byte.
   6093         AND     A               ; test for zero.
   6094         JR      NZ,L1536        ; forward if not zero to STK-BC-2
   6095 
   6096         LD      (HL),A          ; else make exponent zero again
   6097         OR      C               ; test lo-byte
   6098         RET     Z               ; return if BC was zero - done.
   6099 
   6100 ; else  there has to be a set bit if only the value one.
   6101 
   6102         LD      B,C             ; save C in B.
   6103         LD      C,(HL)          ; fetch zero to C
   6104         LD      (HL),$89        ; make exponent $89             256.
   6105 
   6106 ;; STK-BC-2
   6107 L1536:  DEC     (HL)            ; decrement exponent - halving number
   6108         SLA     C               ;  C<-76543210<-0
   6109         RL      B               ;  C<-76543210<-C
   6110         JR      NC,L1536        ; loop back if no carry to STK-BC-2
   6111 
   6112         SRL     B               ;  0->76543210->C
   6113         RR      C               ;  C->76543210->C
   6114 
   6115         INC     HL              ; address first byte of mantissa
   6116         LD      (HL),B          ; insert B
   6117         INC     HL              ; address second byte of mantissa
   6118         LD      (HL),C          ; insert C
   6119 
   6120         DEC     HL              ; point to the
   6121         DEC     HL              ; exponent again
   6122         RET                     ; return.
   6123 
   6124 ; ------------------------------------------
   6125 ; THE 'INTEGER TO FLOATING POINT' SUBROUTINE
   6126 ; ------------------------------------------
   6127 ;
   6128 ;
   6129 
   6130 ;; INT-TO-FP
   6131 L1548:  PUSH    AF              ;
   6132 
   6133         RST     28H             ;; FP-CALC
   6134         DEFB    $A0             ;;stk-zero
   6135         DEFB    $34             ;;end-calc
   6136 
   6137         POP     AF              ;
   6138 
   6139 ;; NXT-DGT-2
   6140 L154D:  CALL    L1514           ; routine STK-DIGIT
   6141         RET     C               ;
   6142 
   6143 
   6144         RST     28H             ;; FP-CALC
   6145         DEFB    $01             ;;exchange
   6146         DEFB    $A4             ;;stk-ten
   6147         DEFB    $04             ;;multiply
   6148         DEFB    $0F             ;;addition
   6149         DEFB    $34             ;;end-calc
   6150 
   6151 
   6152         RST     20H             ; NEXT-CHAR
   6153         JR      L154D           ; to NXT-DGT-2
   6154 
   6155 
   6156 ; -------------------------------------------
   6157 ; THE 'E-FORMAT TO FLOATING POINT' SUBROUTINE
   6158 ; -------------------------------------------
   6159 ; (Offset $38: 'e-to-fp')
   6160 ; invoked from DEC-TO-FP and PRINT-FP.
   6161 ; e.g. 2.3E4 is 23000.
   6162 ; This subroutine evaluates xEm where m is a positive or negative integer.
   6163 ; At a simple level x is multiplied by ten for every unit of m.
   6164 ; If the decimal exponent m is negative then x is divided by ten for each unit.
   6165 ; A short-cut is taken if the exponent is greater than seven and in this
   6166 ; case the exponent is reduced by seven and the value is multiplied or divided
   6167 ; by ten million.
   6168 ; Note. for the ZX Spectrum an even cleverer method was adopted which involved
   6169 ; shifting the bits out of the exponent so the result was achieved with six
   6170 ; shifts at most. The routine below had to be completely re-written mostly
   6171 ; in Z80 machine code.
   6172 ; Although no longer operable, the calculator literal was retained for old
   6173 ; times sake, the routine being invoked directly from a machine code CALL.
   6174 ;
   6175 ; On entry in the ZX81, m, the exponent, is the 'last value', and the
   6176 ; floating-point decimal mantissa is beneath it.
   6177 
   6178 
   6179 ;; e-to-fp
   6180 L155A:  RST     28H             ;; FP-CALC              x, m.
   6181         DEFB    $2D             ;;duplicate             x, m, m.
   6182         DEFB    $32             ;;less-0                x, m, (1/0).
   6183         DEFB    $C0             ;;st-mem-0              x, m, (1/0).
   6184         DEFB    $02             ;;delete                x, m.
   6185         DEFB    $27             ;;abs                   x, +m.
   6186 
   6187 ;; E-LOOP
   6188 L1560:  DEFB    $A1             ;;stk-one               x, m,1.
   6189         DEFB    $03             ;;subtract              x, m-1.
   6190         DEFB    $2D             ;;duplicate             x, m-1,m-1.
   6191         DEFB    $32             ;;less-0                x, m-1, (1/0).
   6192         DEFB    $00             ;;jump-true             x, m-1.
   6193         DEFB    $22             ;;to L1587, E-END       x, m-1.
   6194 
   6195         DEFB    $2D             ;;duplicate             x, m-1, m-1.
   6196         DEFB    $30             ;;stk-data
   6197         DEFB    $33             ;;Exponent: $83, Bytes: 1
   6198 
   6199         DEFB    $40             ;;(+00,+00,+00)         x, m-1, m-1, 6.
   6200         DEFB    $03             ;;subtract              x, m-1, m-7.
   6201         DEFB    $2D             ;;duplicate             x, m-1, m-7, m-7.
   6202         DEFB    $32             ;;less-0                x, m-1, m-7, (1/0).
   6203         DEFB    $00             ;;jump-true             x, m-1, m-7.
   6204         DEFB    $0C             ;;to L157A, E-LOW
   6205 
   6206 ; but if exponent m is higher than 7 do a bigger chunk.
   6207 ; multiplying (or dividing if negative) by 10 million - 1e7.
   6208 
   6209         DEFB    $01             ;;exchange              x, m-7, m-1.
   6210         DEFB    $02             ;;delete                x, m-7.
   6211         DEFB    $01             ;;exchange              m-7, x.
   6212         DEFB    $30             ;;stk-data
   6213         DEFB    $80             ;;Bytes: 3
   6214         DEFB    $48             ;;Exponent $98
   6215         DEFB    $18,$96,$80     ;;(+00)                 m-7, x, 10,000,000 (=f)
   6216         DEFB    $2F             ;;jump
   6217         DEFB    $04             ;;to L157D, E-CHUNK
   6218 
   6219 ; ---
   6220 
   6221 ;; E-LOW
   6222 L157A:  DEFB    $02             ;;delete                x, m-1.
   6223         DEFB    $01             ;;exchange              m-1, x.
   6224         DEFB    $A4             ;;stk-ten               m-1, x, 10 (=f).
   6225 
   6226 ;; E-CHUNK
   6227 L157D:  DEFB    $E0             ;;get-mem-0             m-1, x, f, (1/0)
   6228         DEFB    $00             ;;jump-true             m-1, x, f
   6229         DEFB    $04             ;;to L1583, E-DIVSN
   6230 
   6231         DEFB    $04             ;;multiply              m-1, x*f.
   6232         DEFB    $2F             ;;jump
   6233         DEFB    $02             ;;to L1584, E-SWAP
   6234 
   6235 ; ---
   6236 
   6237 ;; E-DIVSN
   6238 L1583:  DEFB    $05             ;;division              m-1, x/f (= new x).
   6239 
   6240 ;; E-SWAP
   6241 L1584:  DEFB    $01             ;;exchange              x, m-1 (= new m).
   6242         DEFB    $2F             ;;jump                  x, m.
   6243         DEFB    $DA             ;;to L1560, E-LOOP
   6244 
   6245 ; ---
   6246 
   6247 ;; E-END
   6248 L1587:  DEFB    $02             ;;delete                x. (-1)
   6249         DEFB    $34             ;;end-calc              x.
   6250 
   6251         RET                     ; return.
   6252 
   6253 ; -------------------------------------
   6254 ; THE 'FLOATING-POINT TO BC' SUBROUTINE
   6255 ; -------------------------------------
   6256 ; The floating-point form on the calculator stack is compressed directly into
   6257 ; the BC register rounding up if necessary.
   6258 ; Valid range is 0 to 65535.4999
   6259 
   6260 ;; FP-TO-BC
   6261 L158A:  CALL    L13F8           ; routine STK-FETCH - exponent to A
   6262                                 ; mantissa to EDCB.
   6263         AND     A               ; test for value zero.
   6264         JR      NZ,L1595        ; forward if not to FPBC-NZRO
   6265 
   6266 ; else value is zero
   6267 
   6268         LD      B,A             ; zero to B
   6269         LD      C,A             ; also to C
   6270         PUSH    AF              ; save the flags on machine stack
   6271         JR      L15C6           ; forward to FPBC-END
   6272 
   6273 ; ---
   6274 
   6275 ; EDCB  =>  BCE
   6276 
   6277 ;; FPBC-NZRO
   6278 L1595:  LD      B,E             ; transfer the mantissa from EDCB
   6279         LD      E,C             ; to BCE. Bit 7 of E is the 17th bit which
   6280         LD      C,D             ; will be significant for rounding if the
   6281                                 ; number is already normalized.
   6282 
   6283         SUB     $91             ; subtract 65536
   6284         CCF                     ; complement carry flag
   6285         BIT     7,B             ; test sign bit
   6286         PUSH    AF              ; push the result
   6287 
   6288         SET     7,B             ; set the implied bit
   6289         JR      C,L15C6         ; forward with carry from SUB/CCF to FPBC-END
   6290                                 ; number is too big.
   6291 
   6292         INC     A               ; increment the exponent and
   6293         NEG                     ; negate to make range $00 - $0F
   6294 
   6295         CP      $08             ; test if one or two bytes
   6296         JR      C,L15AF         ; forward with two to BIG-INT
   6297 
   6298         LD      E,C             ; shift mantissa
   6299         LD      C,B             ; 8 places right
   6300         LD      B,$00           ; insert a zero in B
   6301         SUB     $08             ; reduce exponent by eight
   6302 
   6303 ;; BIG-INT
   6304 L15AF:  AND     A               ; test the exponent
   6305         LD      D,A             ; save exponent in D.
   6306 
   6307         LD      A,E             ; fractional bits to A
   6308         RLCA                    ; rotate most significant bit to carry for
   6309                                 ; rounding of an already normal number.
   6310 
   6311         JR      Z,L15BC         ; forward if exponent zero to EXP-ZERO
   6312                                 ; the number is normalized
   6313 
   6314 ;; FPBC-NORM
   6315 L15B5:  SRL     B               ;   0->76543210->C
   6316         RR      C               ;   C->76543210->C
   6317 
   6318         DEC     D               ; decrement exponent
   6319 
   6320         JR      NZ,L15B5        ; loop back till zero to FPBC-NORM
   6321 
   6322 ;; EXP-ZERO
   6323 L15BC:  JR      NC,L15C6        ; forward without carry to NO-ROUND
   6324 
   6325         INC     BC              ; round up.
   6326         LD      A,B             ; test result
   6327         OR      C               ; for zero
   6328         JR      NZ,L15C6        ; forward if not to GRE-ZERO
   6329 
   6330         POP     AF              ; restore sign flag
   6331         SCF                     ; set carry flag to indicate overflow
   6332         PUSH    AF              ; save combined flags again
   6333 
   6334 ;; FPBC-END
   6335 L15C6:  PUSH    BC              ; save BC value
   6336 
   6337 ; set HL and DE to calculator stack pointers.
   6338 
   6339         RST     28H             ;; FP-CALC
   6340         DEFB    $34             ;;end-calc
   6341 
   6342 
   6343         POP     BC              ; restore BC value
   6344         POP     AF              ; restore flags
   6345         LD      A,C             ; copy low byte to A also.
   6346         RET                     ; return
   6347 
   6348 ; ------------------------------------
   6349 ; THE 'FLOATING-POINT TO A' SUBROUTINE
   6350 ; ------------------------------------
   6351 ;
   6352 ;
   6353 
   6354 ;; FP-TO-A
   6355 L15CD:  CALL    L158A           ; routine FP-TO-BC
   6356         RET     C               ;
   6357 
   6358         PUSH    AF              ;
   6359         DEC     B               ;
   6360         INC     B               ;
   6361         JR      Z,L15D9         ; forward if in range to FP-A-END
   6362 
   6363         POP     AF              ; fetch result
   6364         SCF                     ; set carry flag signaling overflow
   6365         RET                     ; return
   6366 
   6367 ;; FP-A-END
   6368 L15D9:  POP     AF              ;
   6369         RET                     ;
   6370 
   6371 
   6372 ; ----------------------------------------------
   6373 ; THE 'PRINT A FLOATING-POINT NUMBER' SUBROUTINE
   6374 ; ----------------------------------------------
   6375 ; prints 'last value' x on calculator stack.
   6376 ; There are a wide variety of formats see Chapter 4.
   6377 ; e.g. 
   6378 ; PI            prints as       3.1415927
   6379 ; .123          prints as       0.123
   6380 ; .0123         prints as       .0123
   6381 ; 999999999999  prints as       1000000000000
   6382 ; 9876543210123 prints as       9876543200000
   6383 
   6384 ; Begin by isolating zero and just printing the '0' character
   6385 ; for that case. For negative numbers print a leading '-' and
   6386 ; then form the absolute value of x.
   6387 
   6388 ;; PRINT-FP
   6389 L15DB:  RST     28H             ;; FP-CALC              x.
   6390         DEFB    $2D             ;;duplicate             x, x.
   6391         DEFB    $32             ;;less-0                x, (1/0).
   6392         DEFB    $00             ;;jump-true
   6393         DEFB    $0B             ;;to L15EA, PF-NGTVE    x.
   6394 
   6395         DEFB    $2D             ;;duplicate             x, x
   6396         DEFB    $33             ;;greater-0             x, (1/0).
   6397         DEFB    $00             ;;jump-true
   6398         DEFB    $0D             ;;to L15F0, PF-POSTVE   x.
   6399 
   6400         DEFB    $02             ;;delete                .
   6401         DEFB    $34             ;;end-calc              .
   6402 
   6403         LD      A,$1C           ; load accumulator with character '0'
   6404 
   6405         RST     10H             ; PRINT-A
   6406         RET                     ; return.                               >>
   6407 
   6408 ; ---
   6409 
   6410 ;; PF-NEGTVE
   6411 L15EA:  DEFB    $27             ; abs                   +x.
   6412         DEFB    $34             ;;end-calc              x.
   6413 
   6414         LD      A,$16           ; load accumulator with '-'
   6415 
   6416         RST     10H             ; PRINT-A
   6417 
   6418         RST     28H             ;; FP-CALC              x.
   6419 
   6420 ;; PF-POSTVE
   6421 L15F0:  DEFB    $34             ;;end-calc              x.
   6422 
   6423 ; register HL addresses the exponent of the floating-point value.
   6424 ; if positive, and point floats to left, then bit 7 is set.
   6425 
   6426         LD      A,(HL)          ; pick up the exponent byte
   6427         CALL    L151D           ; routine STACK-A places on calculator stack.
   6428 
   6429 ; now calculate roughly the number of digits, n, before the decimal point by
   6430 ; subtracting a half from true exponent and multiplying by log to 
   6431 ; the base 10 of 2. 
   6432 ; The true number could be one higher than n, the integer result.
   6433 
   6434         RST     28H             ;; FP-CALC              x, e.
   6435         DEFB    $30             ;;stk-data
   6436         DEFB    $78             ;;Exponent: $88, Bytes: 2
   6437         DEFB    $00,$80         ;;(+00,+00)             x, e, 128.5.
   6438         DEFB    $03             ;;subtract              x, e -.5.
   6439         DEFB    $30             ;;stk-data
   6440         DEFB    $EF             ;;Exponent: $7F, Bytes: 4
   6441         DEFB    $1A,$20,$9A,$85 ;;                      .30103 (log10 2)
   6442         DEFB    $04             ;;multiply              x,
   6443         DEFB    $24             ;;int
   6444         DEFB    $C1             ;;st-mem-1              x, n.
   6445 
   6446 
   6447         DEFB    $30             ;;stk-data
   6448         DEFB    $34             ;;Exponent: $84, Bytes: 1
   6449         DEFB    $00             ;;(+00,+00,+00)         x, n, 8.
   6450 
   6451         DEFB    $03             ;;subtract              x, n-8.
   6452         DEFB    $18             ;;neg                   x, 8-n.
   6453         DEFB    $38             ;;e-to-fp               x * (10^n)
   6454 
   6455 ; finally the 8 or 9 digit decimal is rounded.
   6456 ; a ten-digit integer can arise in the case of, say, 999999999.5
   6457 ; which gives 1000000000.
   6458 
   6459         DEFB    $A2             ;;stk-half
   6460         DEFB    $0F             ;;addition
   6461         DEFB    $24             ;;int                   i.
   6462         DEFB    $34             ;;end-calc
   6463 
   6464 ; If there were 8 digits then final rounding will take place on the calculator 
   6465 ; stack above and the next two instructions insert a masked zero so that
   6466 ; no further rounding occurs. If the result is a 9 digit integer then
   6467 ; rounding takes place within the buffer.
   6468 
   6469         LD      HL,$406B        ; address system variable MEM-2-5th
   6470                                 ; which could be the 'ninth' digit.
   6471         LD      (HL),$90        ; insert the value $90  10010000
   6472 
   6473 ; now starting from lowest digit lay down the 8, 9 or 10 digit integer
   6474 ; which represents the significant portion of the number
   6475 ; e.g. PI will be the nine-digit integer 314159265
   6476 
   6477         LD      B,$0A           ; count is ten digits.
   6478 
   6479 ;; PF-LOOP
   6480 L1615:  INC     HL              ; increase pointer
   6481 
   6482         PUSH    HL              ; preserve buffer address.
   6483         PUSH    BC              ; preserve counter.
   6484 
   6485         RST     28H             ;; FP-CALC              i.
   6486         DEFB    $A4             ;;stk-ten               i, 10.
   6487         DEFB    $2E             ;;n-mod-m               i mod 10, i/10
   6488         DEFB    $01             ;;exchange              i/10, remainder.
   6489         DEFB    $34             ;;end-calc
   6490 
   6491         CALL    L15CD           ; routine FP-TO-A  $00-$09
   6492 
   6493         OR      $90             ; make left hand nibble 9 
   6494 
   6495         POP     BC              ; restore counter
   6496         POP     HL              ; restore buffer address.
   6497 
   6498         LD      (HL),A          ; insert masked digit in buffer.
   6499         DJNZ    L1615           ; loop back for all ten to PF-LOOP
   6500 
   6501 ; the most significant digit will be last but if the number is exhausted then
   6502 ; the last one or two positions will contain zero ($90).
   6503 
   6504 ; e.g. for 'one' we have zero as estimate of leading digits.
   6505 ; 1*10^8 100000000 as integer value
   6506 ; 90 90 90 90 90   90 90 90 91 90 as buffer mem3/mem4 contents.
   6507 
   6508 
   6509         INC     HL              ; advance pointer to one past buffer 
   6510         LD      BC,$0008        ; set C to 8 ( B is already zero )
   6511         PUSH    HL              ; save pointer.
   6512 
   6513 ;; PF-NULL
   6514 L162C:  DEC     HL              ; decrease pointer
   6515         LD      A,(HL)          ; fetch masked digit
   6516         CP      $90             ; is it a leading zero ?
   6517         JR      Z,L162C         ; loop back if so to PF-NULL
   6518 
   6519 ; at this point a significant digit has been found. carry is reset.
   6520 
   6521         SBC     HL,BC           ; subtract eight from the address.
   6522         PUSH    HL              ; ** save this pointer too
   6523         LD      A,(HL)          ; fetch addressed byte
   6524         ADD     A,$6B           ; add $6B - forcing a round up ripple
   6525                                 ; if  $95 or over.
   6526         PUSH    AF              ; save the carry result.
   6527 
   6528 ; now enter a loop to round the number. After rounding has been considered
   6529 ; a zero that has arisen from rounding or that was present at that position
   6530 ; originally is changed from $90 to $80.
   6531 
   6532 ;; PF-RND-LP
   6533 L1639:  POP     AF              ; retrieve carry from machine stack.
   6534         INC     HL              ; increment address
   6535         LD      A,(HL)          ; fetch new byte
   6536         ADC     A,$00           ; add in any carry
   6537 
   6538         DAA                     ; decimal adjust accumulator
   6539                                 ; carry will ripple through the '9'
   6540 
   6541         PUSH    AF              ; save carry on machine stack.
   6542         AND     $0F             ; isolate character 0 - 9 AND set zero flag
   6543                                 ; if zero.
   6544         LD      (HL),A          ; place back in location.
   6545         SET     7,(HL)          ; set bit 7 to show printable.
   6546                                 ; but not if trailing zero after decimal point.
   6547         JR      Z,L1639         ; back if a zero to PF-RND-LP
   6548                                 ; to consider further rounding and/or trailing
   6549                                 ; zero identification.
   6550 
   6551         POP     AF              ; balance stack
   6552         POP     HL              ; ** retrieve lower pointer
   6553 
   6554 ; now insert 6 trailing zeros which are printed if before the decimal point
   6555 ; but mark the end of printing if after decimal point.
   6556 ; e.g. 9876543210123 is printed as 9876543200000
   6557 ; 123.456001 is printed as 123.456
   6558 
   6559         LD      B,$06           ; the count is six.
   6560 
   6561 ;; PF-ZERO-6
   6562 L164B:  LD      (HL),$80        ; insert a masked zero
   6563         DEC     HL              ; decrease pointer.
   6564         DJNZ    L164B           ; loop back for all six to PF-ZERO-6
   6565 
   6566 ; n-mod-m reduced the number to zero and this is now deleted from the calculator
   6567 ; stack before fetching the original estimate of leading digits.
   6568 
   6569 
   6570         RST     28H             ;; FP-CALC              0.
   6571         DEFB    $02             ;;delete                .
   6572         DEFB    $E1             ;;get-mem-1             n.
   6573         DEFB    $34             ;;end-calc              n.
   6574 
   6575         CALL    L15CD           ; routine FP-TO-A
   6576         JR      Z,L165B         ; skip forward if positive to PF-POS
   6577 
   6578         NEG                     ; negate makes positive
   6579 
   6580 ;; PF-POS
   6581 L165B:  LD      E,A             ; transfer count of digits to E
   6582         INC     E               ; increment twice 
   6583         INC     E               ; 
   6584         POP     HL              ; * retrieve pointer to one past buffer.
   6585 
   6586 ;; GET-FIRST
   6587 L165F:  DEC     HL              ; decrement address.
   6588         DEC     E               ; decrement digit counter.
   6589         LD      A,(HL)          ; fetch masked byte.
   6590         AND     $0F             ; isolate right-hand nibble.
   6591         JR      Z,L165F         ; back with leading zero to GET-FIRST
   6592 
   6593 ; now determine if E-format printing is needed
   6594 
   6595         LD      A,E             ; transfer now accurate number count to A.
   6596         SUB     $05             ; subtract five
   6597         CP      $08             ; compare with 8 as maximum digits is 13.
   6598         JP      P,L1682         ; forward if positive to PF-E-FMT
   6599 
   6600         CP      $F6             ; test for more than four zeros after point.
   6601         JP      M,L1682         ; forward if so to PF-E-FMT
   6602 
   6603         ADD     A,$06           ; test for zero leading digits, e.g. 0.5
   6604         JR      Z,L16BF         ; forward if so to PF-ZERO-1 
   6605 
   6606         JP      M,L16B2         ; forward if more than one zero to PF-ZEROS
   6607 
   6608 ; else digits before the decimal point are to be printed
   6609 
   6610         LD      B,A             ; count of leading characters to B.
   6611 
   6612 ;; PF-NIB-LP
   6613 L167B:  CALL    L16D0           ; routine PF-NIBBLE
   6614         DJNZ    L167B           ; loop back for counted numbers to PF-NIB-LP
   6615 
   6616         JR      L16C2           ; forward to consider decimal part to PF-DC-OUT
   6617 
   6618 ; ---
   6619 
   6620 ;; PF-E-FMT
   6621 L1682:  LD      B,E             ; count to B
   6622         CALL    L16D0           ; routine PF-NIBBLE prints one digit.
   6623         CALL    L16C2           ; routine PF-DC-OUT considers fractional part.
   6624 
   6625         LD      A,$2A           ; prepare character 'E'
   6626         RST     10H             ; PRINT-A
   6627 
   6628         LD      A,B             ; transfer exponent to A
   6629         AND     A               ; test the sign.
   6630         JP      P,L1698         ; forward if positive to PF-E-POS
   6631 
   6632         NEG                     ; negate the negative exponent.
   6633         LD      B,A             ; save positive exponent in B.
   6634 
   6635         LD      A,$16           ; prepare character '-'
   6636         JR      L169A           ; skip forward to PF-E-SIGN
   6637 
   6638 ; ---
   6639 
   6640 ;; PF-E-POS
   6641 L1698:  LD      A,$15           ; prepare character '+'
   6642 
   6643 ;; PF-E-SIGN
   6644 L169A:  RST     10H             ; PRINT-A
   6645 
   6646 ; now convert the integer exponent in B to two characters.
   6647 ; it will be less than 99.
   6648 
   6649         LD      A,B             ; fetch positive exponent.
   6650         LD      B,$FF           ; initialize left hand digit to minus one.
   6651 
   6652 ;; PF-E-TENS
   6653 L169E:  INC     B               ; increment ten count
   6654         SUB     $0A             ; subtract ten from exponent
   6655         JR      NC,L169E        ; loop back if greater than ten to PF-E-TENS
   6656 
   6657         ADD     A,$0A           ; reverse last subtraction
   6658         LD      C,A             ; transfer remainder to C
   6659 
   6660         LD      A,B             ; transfer ten value to A.
   6661         AND     A               ; test for zero.
   6662         JR      Z,L16AD         ; skip forward if so to PF-E-LOW
   6663 
   6664         CALL    L07EB           ; routine OUT-CODE prints as digit '1' - '9'
   6665 
   6666 ;; PF-E-LOW
   6667 L16AD:  LD      A,C             ; low byte to A
   6668         CALL    L07EB           ; routine OUT-CODE prints final digit of the
   6669                                 ; exponent.
   6670         RET                     ; return.                               >>
   6671 
   6672 ; ---
   6673 
   6674 ; this branch deals with zeros after decimal point.
   6675 ; e.g.      .01 or .0000999
   6676 
   6677 ;; PF-ZEROS
   6678 L16B2:  NEG                     ; negate makes number positive 1 to 4.
   6679         LD      B,A             ; zero count to B.
   6680 
   6681         LD      A,$1B           ; prepare character '.'
   6682         RST     10H             ; PRINT-A
   6683 
   6684         LD      A,$1C           ; prepare a '0'
   6685 
   6686 ;; PF-ZRO-LP
   6687 L16BA:  RST     10H             ; PRINT-A
   6688         DJNZ    L16BA           ; loop back to PF-ZRO-LP
   6689 
   6690         JR      L16C8           ; forward to PF-FRAC-LP
   6691 
   6692 ; ---
   6693 
   6694 ; there is  a need to print a leading zero e.g. 0.1 but not with .01
   6695 
   6696 ;; PF-ZERO-1
   6697 L16BF:  LD      A,$1C           ; prepare character '0'.
   6698         RST     10H             ; PRINT-A
   6699 
   6700 ; this subroutine considers the decimal point and any trailing digits.
   6701 ; if the next character is a marked zero, $80, then nothing more to print.
   6702 
   6703 ;; PF-DC-OUT
   6704 L16C2:  DEC     (HL)            ; decrement addressed character
   6705         INC     (HL)            ; increment it again
   6706         RET     PE              ; return with overflow  (was 128) >>
   6707                                 ; as no fractional part
   6708 
   6709 ; else there is a fractional part so print the decimal point.
   6710 
   6711         LD      A,$1B           ; prepare character '.'
   6712         RST     10H             ; PRINT-A
   6713 
   6714 ; now enter a loop to print trailing digits
   6715 
   6716 ;; PF-FRAC-LP
   6717 L16C8:  DEC     (HL)            ; test for a marked zero.
   6718         INC     (HL)            ;
   6719         RET     PE              ; return when digits exhausted          >>
   6720 
   6721         CALL    L16D0           ; routine PF-NIBBLE
   6722         JR      L16C8           ; back for all fractional digits to PF-FRAC-LP.
   6723 
   6724 ; ---
   6725 
   6726 ; subroutine to print right-hand nibble
   6727 
   6728 ;; PF-NIBBLE
   6729 L16D0:  LD      A,(HL)          ; fetch addressed byte
   6730         AND     $0F             ; mask off lower 4 bits
   6731         CALL    L07EB           ; routine OUT-CODE
   6732         DEC     HL              ; decrement pointer.
   6733         RET                     ; return.
   6734 
   6735 
   6736 ; -------------------------------
   6737 ; THE 'PREPARE TO ADD' SUBROUTINE
   6738 ; -------------------------------
   6739 ; This routine is called twice to prepare each floating point number for
   6740 ; addition, in situ, on the calculator stack.
   6741 ; The exponent is picked up from the first byte which is then cleared to act
   6742 ; as a sign byte and accept any overflow.
   6743 ; If the exponent is zero then the number is zero and an early return is made.
   6744 ; The now redundant sign bit of the mantissa is set and if the number is 
   6745 ; negative then all five bytes of the number are twos-complemented to prepare 
   6746 ; the number for addition.
   6747 ; On the second invocation the exponent of the first number is in B.
   6748 
   6749 
   6750 ;; PREP-ADD
   6751 L16D8:  LD      A,(HL)          ; fetch exponent.
   6752         LD      (HL),$00        ; make this byte zero to take any overflow and
   6753                                 ; default to positive.
   6754         AND     A               ; test stored exponent for zero.
   6755         RET     Z               ; return with zero flag set if number is zero.
   6756 
   6757         INC     HL              ; point to first byte of mantissa.
   6758         BIT     7,(HL)          ; test the sign bit.
   6759         SET     7,(HL)          ; set it to its implied state.
   6760         DEC     HL              ; set pointer to first byte again.
   6761         RET     Z               ; return if bit indicated number is positive.>>
   6762 
   6763 ; if negative then all five bytes are twos complemented starting at LSB.
   6764 
   6765         PUSH    BC              ; save B register contents.
   6766         LD      BC,$0005        ; set BC to five.
   6767         ADD     HL,BC           ; point to location after 5th byte.
   6768         LD      B,C             ; set the B counter to five.
   6769         LD      C,A             ; store original exponent in C.
   6770         SCF                     ; set carry flag so that one is added.
   6771 
   6772 ; now enter a loop to twos-complement the number.
   6773 ; The first of the five bytes becomes $FF to denote a negative number.
   6774 
   6775 ;; NEG-BYTE
   6776 L16EC:  DEC     HL              ; point to first or more significant byte.
   6777         LD      A,(HL)          ; fetch to accumulator.
   6778         CPL                     ; complement.
   6779         ADC     A,$00           ; add in initial carry or any subsequent carry.
   6780         LD      (HL),A          ; place number back.
   6781         DJNZ    L16EC           ; loop back five times to NEG-BYTE
   6782 
   6783         LD      A,C             ; restore the exponent to accumulator.
   6784         POP     BC              ; restore B register contents.
   6785 
   6786         RET                     ; return.
   6787 
   6788 ; ----------------------------------
   6789 ; THE 'FETCH TWO NUMBERS' SUBROUTINE
   6790 ; ----------------------------------
   6791 ; This routine is used by addition, multiplication and division to fetch
   6792 ; the two five-byte numbers addressed by HL and DE from the calculator stack
   6793 ; into the Z80 registers.
   6794 ; The HL register may no longer point to the first of the two numbers.
   6795 ; Since the 32-bit addition operation is accomplished using two Z80 16-bit
   6796 ; instructions, it is important that the lower two bytes of each mantissa are
   6797 ; in one set of registers and the other bytes all in the alternate set.
   6798 ;
   6799 ; In: HL = highest number, DE= lowest number
   6800 ;
   6801 ;         : alt':   :
   6802 ; Out:    :H,B-C:C,B: num1
   6803 ;         :L,D-E:D-E: num2
   6804 
   6805 ;; FETCH-TWO
   6806 L16F7:  PUSH    HL              ; save HL 
   6807         PUSH    AF              ; save A - result sign when used from division.
   6808 
   6809         LD      C,(HL)          ;
   6810         INC     HL              ;
   6811         LD      B,(HL)          ;
   6812         LD      (HL),A          ; insert sign when used from multiplication.
   6813         INC     HL              ;
   6814         LD      A,C             ; m1
   6815         LD      C,(HL)          ;
   6816         PUSH    BC              ; PUSH m2 m3
   6817 
   6818         INC     HL              ;
   6819         LD      C,(HL)          ; m4
   6820         INC     HL              ;
   6821         LD      B,(HL)          ; m5  BC holds m5 m4
   6822 
   6823         EX      DE,HL           ; make HL point to start of second number.
   6824 
   6825         LD      D,A             ; m1
   6826         LD      E,(HL)          ;
   6827         PUSH    DE              ; PUSH m1 n1
   6828 
   6829         INC     HL              ;
   6830         LD      D,(HL)          ;
   6831         INC     HL              ;
   6832         LD      E,(HL)          ;
   6833         PUSH    DE              ; PUSH n2 n3
   6834 
   6835         EXX                     ; - - - - - - -
   6836 
   6837         POP     DE              ; POP n2 n3
   6838         POP     HL              ; POP m1 n1
   6839         POP     BC              ; POP m2 m3
   6840 
   6841         EXX                     ; - - - - - - -
   6842 
   6843         INC     HL              ;
   6844         LD      D,(HL)          ;
   6845         INC     HL              ;
   6846         LD      E,(HL)          ; DE holds n4 n5
   6847 
   6848         POP     AF              ; restore saved
   6849         POP     HL              ; registers.
   6850         RET                     ; return.
   6851 
   6852 ; -----------------------------
   6853 ; THE 'SHIFT ADDEND' SUBROUTINE
   6854 ; -----------------------------
   6855 ; The accumulator A contains the difference between the two exponents.
   6856 ; This is the lowest of the two numbers to be added 
   6857 
   6858 ;; SHIFT-FP
   6859 L171A:  AND     A               ; test difference between exponents.
   6860         RET     Z               ; return if zero. both normal.
   6861 
   6862         CP      $21             ; compare with 33 bits.
   6863         JR      NC,L1736        ; forward if greater than 32 to ADDEND-0
   6864 
   6865         PUSH    BC              ; preserve BC - part 
   6866         LD      B,A             ; shift counter to B.
   6867 
   6868 ; Now perform B right shifts on the addend  L'D'E'D E
   6869 ; to bring it into line with the augend     H'B'C'C B
   6870 
   6871 ;; ONE-SHIFT
   6872 L1722:  EXX                     ; - - -
   6873         SRA     L               ;    76543210->C    bit 7 unchanged.
   6874         RR      D               ; C->76543210->C
   6875         RR      E               ; C->76543210->C
   6876         EXX                     ; - - - 
   6877         RR      D               ; C->76543210->C
   6878         RR      E               ; C->76543210->C
   6879         DJNZ    L1722           ; loop back B times to ONE-SHIFT
   6880 
   6881         POP     BC              ; restore BC
   6882         RET     NC              ; return if last shift produced no carry.   >>
   6883 
   6884 ; if carry flag was set then accuracy is being lost so round up the addend.
   6885 
   6886         CALL    L1741           ; routine ADD-BACK
   6887         RET     NZ              ; return if not FF 00 00 00 00
   6888 
   6889 ; this branch makes all five bytes of the addend zero and is made during
   6890 ; addition when the exponents are too far apart for the addend bits to 
   6891 ; affect the result.
   6892 
   6893 ;; ADDEND-0
   6894 L1736:  EXX                     ; select alternate set for more significant 
   6895                                 ; bytes.
   6896         XOR     A               ; clear accumulator.
   6897 
   6898 
   6899 ; this entry point (from multiplication) sets four of the bytes to zero or if 
   6900 ; continuing from above, during addition, then all five bytes are set to zero.
   6901 
   6902 ;; ZEROS-4/5
   6903 L1738:  LD      L,$00           ; set byte 1 to zero.
   6904         LD      D,A             ; set byte 2 to A.
   6905         LD      E,L             ; set byte 3 to zero.
   6906         EXX                     ; select main set 
   6907         LD      DE,$0000        ; set lower bytes 4 and 5 to zero.
   6908         RET                     ; return.
   6909 
   6910 ; -------------------------
   6911 ; THE 'ADD-BACK' SUBROUTINE
   6912 ; -------------------------
   6913 ; Called from SHIFT-FP above during addition and after normalization from
   6914 ; multiplication.
   6915 ; This is really a 32-bit increment routine which sets the zero flag according
   6916 ; to the 32-bit result.
   6917 ; During addition, only negative numbers like FF FF FF FF FF,
   6918 ; the twos-complement version of xx 80 00 00 01 say 
   6919 ; will result in a full ripple FF 00 00 00 00.
   6920 ; FF FF FF FF FF when shifted right is unchanged by SHIFT-FP but sets the 
   6921 ; carry invoking this routine.
   6922 
   6923 ;; ADD-BACK
   6924 L1741:  INC     E               ;
   6925         RET     NZ              ;
   6926 
   6927         INC     D               ;
   6928         RET     NZ              ;
   6929 
   6930         EXX                     ;
   6931         INC     E               ;
   6932         JR      NZ,L174A        ; forward if no overflow to ALL-ADDED
   6933 
   6934         INC     D               ;
   6935 
   6936 ;; ALL-ADDED
   6937 L174A:  EXX                     ;
   6938         RET                     ; return with zero flag set for zero mantissa.
   6939 
   6940 
   6941 ; ---------------------------
   6942 ; THE 'SUBTRACTION' OPERATION
   6943 ; ---------------------------
   6944 ; just switch the sign of subtrahend and do an add.
   6945 
   6946 ;; subtract
   6947 L174C:  LD      A,(DE)          ; fetch exponent byte of second number the
   6948                                 ; subtrahend. 
   6949         AND     A               ; test for zero
   6950         RET     Z               ; return if zero - first number is result.
   6951 
   6952         INC     DE              ; address the first mantissa byte.
   6953         LD      A,(DE)          ; fetch to accumulator.
   6954         XOR     $80             ; toggle the sign bit.
   6955         LD      (DE),A          ; place back on calculator stack.
   6956         DEC     DE              ; point to exponent byte.
   6957                                 ; continue into addition routine.
   6958 
   6959 ; ------------------------
   6960 ; THE 'ADDITION' OPERATION
   6961 ; ------------------------
   6962 ; The addition operation pulls out all the stops and uses most of the Z80's
   6963 ; registers to add two floating-point numbers.
   6964 ; This is a binary operation and on entry, HL points to the first number
   6965 ; and DE to the second.
   6966 
   6967 ;; addition
   6968 L1755:  EXX                     ; - - -
   6969         PUSH    HL              ; save the pointer to the next literal.
   6970         EXX                     ; - - -
   6971 
   6972         PUSH    DE              ; save pointer to second number
   6973         PUSH    HL              ; save pointer to first number - will be the
   6974                                 ; result pointer on calculator stack.
   6975 
   6976         CALL    L16D8           ; routine PREP-ADD
   6977         LD      B,A             ; save first exponent byte in B.
   6978         EX      DE,HL           ; switch number pointers.
   6979         CALL    L16D8           ; routine PREP-ADD
   6980         LD      C,A             ; save second exponent byte in C.
   6981         CP      B               ; compare the exponent bytes.
   6982         JR      NC,L1769        ; forward if second higher to SHIFT-LEN
   6983 
   6984         LD      A,B             ; else higher exponent to A
   6985         LD      B,C             ; lower exponent to B
   6986         EX      DE,HL           ; switch the number pointers.
   6987 
   6988 ;; SHIFT-LEN
   6989 L1769:  PUSH    AF              ; save higher exponent
   6990         SUB     B               ; subtract lower exponent
   6991 
   6992         CALL    L16F7           ; routine FETCH-TWO
   6993         CALL    L171A           ; routine SHIFT-FP
   6994 
   6995         POP     AF              ; restore higher exponent.
   6996         POP     HL              ; restore result pointer.
   6997         LD      (HL),A          ; insert exponent byte.
   6998         PUSH    HL              ; save result pointer again.
   6999 
   7000 ; now perform the 32-bit addition using two 16-bit Z80 add instructions.
   7001 
   7002         LD      L,B             ; transfer low bytes of mantissa individually
   7003         LD      H,C             ; to HL register
   7004 
   7005         ADD     HL,DE           ; the actual binary addition of lower bytes
   7006 
   7007 ; now the two higher byte pairs that are in the alternate register sets.
   7008 
   7009         EXX                     ; switch in set 
   7010         EX      DE,HL           ; transfer high mantissa bytes to HL register.
   7011 
   7012         ADC     HL,BC           ; the actual addition of higher bytes with
   7013                                 ; any carry from first stage.
   7014 
   7015         EX      DE,HL           ; result in DE, sign bytes ($FF or $00) to HL
   7016 
   7017 ; now consider the two sign bytes
   7018 
   7019         LD      A,H             ; fetch sign byte of num1
   7020 
   7021         ADC     A,L             ; add including any carry from mantissa 
   7022                                 ; addition. 00 or 01 or FE or FF
   7023 
   7024         LD      L,A             ; result in L.
   7025 
   7026 ; possible outcomes of signs and overflow from mantissa are
   7027 ;
   7028 ;  H +  L + carry =  L    RRA  XOR L  RRA
   7029 ; ------------------------------------------------------------
   7030 ; 00 + 00         = 00    00   00
   7031 ; 00 + 00 + carry = 01    00   01     carry
   7032 ; FF + FF         = FE C  FF   01     carry
   7033 ; FF + FF + carry = FF C  FF   00
   7034 ; FF + 00         = FF    FF   00
   7035 ; FF + 00 + carry = 00 C  80   80
   7036 
   7037         RRA                     ; C->76543210->C
   7038         XOR     L               ; set bit 0 if shifting required.
   7039 
   7040         EXX                     ; switch back to main set
   7041         EX      DE,HL           ; full mantissa result now in D'E'D E registers.
   7042         POP     HL              ; restore pointer to result exponent on 
   7043                                 ; the calculator stack.
   7044 
   7045         RRA                     ; has overflow occurred ?
   7046         JR      NC,L1790        ; skip forward if not to TEST-NEG
   7047 
   7048 ; if the addition of two positive mantissas produced overflow or if the
   7049 ; addition of two negative mantissas did not then the result exponent has to
   7050 ; be incremented and the mantissa shifted one place to the right.
   7051 
   7052         LD      A,$01           ; one shift required.
   7053         CALL    L171A           ; routine SHIFT-FP performs a single shift 
   7054                                 ; rounding any lost bit
   7055         INC     (HL)            ; increment the exponent.
   7056         JR      Z,L17B3         ; forward to ADD-REP-6 if the exponent
   7057                                 ; wraps round from FF to zero as number is too
   7058                                 ; big for the system.
   7059 
   7060 ; at this stage the exponent on the calculator stack is correct.
   7061 
   7062 ;; TEST-NEG
   7063 L1790:  EXX                     ; switch in the alternate set.
   7064         LD      A,L             ; load result sign to accumulator.
   7065         AND     $80             ; isolate bit 7 from sign byte setting zero
   7066                                 ; flag if positive.
   7067         EXX                     ; back to main set.
   7068 
   7069         INC     HL              ; point to first byte of mantissa
   7070         LD      (HL),A          ; insert $00 positive or $80 negative at 
   7071                                 ; position on calculator stack.
   7072 
   7073         DEC     HL              ; point to exponent again.
   7074         JR      Z,L17B9         ; forward if positive to GO-NC-MLT
   7075 
   7076 ; a negative number has to be twos-complemented before being placed on stack.
   7077 
   7078         LD      A,E             ; fetch lowest (rightmost) mantissa byte.
   7079         NEG                     ; Negate
   7080         CCF                     ; Complement Carry Flag
   7081         LD      E,A             ; place back in register
   7082 
   7083         LD      A,D             ; ditto
   7084         CPL                     ;
   7085         ADC     A,$00           ;
   7086         LD      D,A             ;
   7087 
   7088         EXX                     ; switch to higher (leftmost) 16 bits.
   7089 
   7090         LD      A,E             ; ditto
   7091         CPL                     ;
   7092         ADC     A,$00           ;
   7093         LD      E,A             ;
   7094 
   7095         LD      A,D             ; ditto
   7096         CPL                     ;
   7097         ADC     A,$00           ;
   7098         JR      NC,L17B7        ; forward without overflow to END-COMPL
   7099 
   7100 ; else entire mantissa is now zero.  00 00 00 00
   7101 
   7102         RRA                     ; set mantissa to 80 00 00 00
   7103         EXX                     ; switch.
   7104         INC     (HL)            ; increment the exponent.
   7105 
   7106 ;; ADD-REP-6
   7107 L17B3:  JP      Z,L1880         ; jump forward if exponent now zero to REPORT-6
   7108                                 ; 'Number too big'
   7109 
   7110         EXX                     ; switch back to alternate set.
   7111 
   7112 ;; END-COMPL
   7113 L17B7:  LD      D,A             ; put first byte of mantissa back in DE.
   7114         EXX                     ; switch to main set.
   7115 
   7116 ;; GO-NC-MLT
   7117 L17B9:  XOR     A               ; clear carry flag and
   7118                                 ; clear accumulator so no extra bits carried
   7119                                 ; forward as occurs in multiplication.
   7120 
   7121         JR      L1828           ; forward to common code at TEST-NORM 
   7122                                 ; but should go straight to NORMALIZE.
   7123 
   7124 
   7125 ; ----------------------------------------------
   7126 ; THE 'PREPARE TO MULTIPLY OR DIVIDE' SUBROUTINE
   7127 ; ----------------------------------------------
   7128 ; this routine is called twice from multiplication and twice from division
   7129 ; to prepare each of the two numbers for the operation.
   7130 ; Initially the accumulator holds zero and after the second invocation bit 7
   7131 ; of the accumulator will be the sign bit of the result.
   7132 
   7133 ;; PREP-M/D
   7134 L17BC:  SCF                     ; set carry flag to signal number is zero.
   7135         DEC     (HL)            ; test exponent
   7136         INC     (HL)            ; for zero.
   7137         RET     Z               ; return if zero with carry flag set.
   7138 
   7139         INC     HL              ; address first mantissa byte.
   7140         XOR     (HL)            ; exclusive or the running sign bit.
   7141         SET     7,(HL)          ; set the implied bit.
   7142         DEC     HL              ; point to exponent byte.
   7143         RET                     ; return.
   7144 
   7145 ; ------------------------------
   7146 ; THE 'MULTIPLICATION' OPERATION
   7147 ; ------------------------------
   7148 ;
   7149 ;
   7150 
   7151 ;; multiply
   7152 L17C6:  XOR     A               ; reset bit 7 of running sign flag.
   7153         CALL    L17BC           ; routine PREP-M/D
   7154         RET     C               ; return if number is zero.
   7155                                 ; zero * anything = zero.
   7156 
   7157         EXX                     ; - - -
   7158         PUSH    HL              ; save pointer to 'next literal'
   7159         EXX                     ; - - -
   7160 
   7161         PUSH    DE              ; save pointer to second number 
   7162 
   7163         EX      DE,HL           ; make HL address second number.
   7164 
   7165         CALL    L17BC           ; routine PREP-M/D
   7166 
   7167         EX      DE,HL           ; HL first number, DE - second number
   7168         JR      C,L1830         ; forward with carry to ZERO-RSLT
   7169                                 ; anything * zero = zero.
   7170 
   7171         PUSH    HL              ; save pointer to first number.
   7172 
   7173         CALL    L16F7           ; routine FETCH-TWO fetches two mantissas from
   7174                                 ; calc stack to B'C'C,B  D'E'D E
   7175                                 ; (HL will be overwritten but the result sign
   7176                                 ; in A is inserted on the calculator stack)
   7177 
   7178         LD      A,B             ; transfer low mantissa byte of first number
   7179         AND     A               ; clear carry.
   7180         SBC     HL,HL           ; a short form of LD HL,$0000 to take lower
   7181                                 ; two bytes of result. (2 program bytes)
   7182         EXX                     ; switch in alternate set
   7183         PUSH    HL              ; preserve HL
   7184         SBC     HL,HL           ; set HL to zero also to take higher two bytes
   7185                                 ; of the result and clear carry.
   7186         EXX                     ; switch back.
   7187 
   7188         LD      B,$21           ; register B can now be used to count thirty 
   7189                                 ; three shifts.
   7190         JR      L17F8           ; forward to loop entry point STRT-MLT
   7191 
   7192 ; ---
   7193 
   7194 ; The multiplication loop is entered at  STRT-LOOP.
   7195 
   7196 ;; MLT-LOOP
   7197 L17E7:  JR      NC,L17EE        ; forward if no carry to NO-ADD
   7198 
   7199                                 ; else add in the multiplicand.
   7200 
   7201         ADD     HL,DE           ; add the two low bytes to result
   7202         EXX                     ; switch to more significant bytes.
   7203         ADC     HL,DE           ; add high bytes of multiplicand and any carry.
   7204         EXX                     ; switch to main set.
   7205 
   7206 ; in either case shift result right into B'C'C A
   7207 
   7208 ;; NO-ADD
   7209 L17EE:  EXX                     ; switch to alternate set
   7210         RR      H               ; C > 76543210 > C
   7211         RR      L               ; C > 76543210 > C
   7212         EXX                     ;
   7213         RR      H               ; C > 76543210 > C
   7214         RR      L               ; C > 76543210 > C
   7215 
   7216 ;; STRT-MLT
   7217 L17F8:  EXX                     ; switch in alternate set.
   7218         RR      B               ; C > 76543210 > C
   7219         RR      C               ; C > 76543210 > C
   7220         EXX                     ; now main set
   7221         RR      C               ; C > 76543210 > C
   7222         RRA                     ; C > 76543210 > C
   7223         DJNZ    L17E7           ; loop back 33 times to MLT-LOOP
   7224 
   7225 ;
   7226 
   7227         EX      DE,HL           ;
   7228         EXX                     ;
   7229         EX      DE,HL           ;
   7230         EXX                     ;
   7231         POP     BC              ;
   7232         POP     HL              ;
   7233         LD      A,B             ;
   7234         ADD     A,C             ;
   7235         JR      NZ,L180E        ; forward to MAKE-EXPT
   7236 
   7237         AND     A               ;
   7238 
   7239 ;; MAKE-EXPT
   7240 L180E:  DEC     A               ;
   7241         CCF                     ; Complement Carry Flag
   7242 
   7243 ;; DIVN-EXPT
   7244 L1810:  RLA                     ;
   7245         CCF                     ; Complement Carry Flag
   7246         RRA                     ;
   7247         JP      P,L1819         ; forward to OFLW1-CLR
   7248 
   7249         JR      NC,L1880        ; forward to REPORT-6
   7250 
   7251         AND     A               ;
   7252 
   7253 ;; OFLW1-CLR
   7254 L1819:  INC     A               ;
   7255         JR      NZ,L1824        ; forward to OFLW2-CLR
   7256 
   7257         JR      C,L1824         ; forward to OFLW2-CLR
   7258 
   7259         EXX                     ;
   7260         BIT     7,D             ;
   7261         EXX                     ;
   7262         JR      NZ,L1880        ; forward to REPORT-6
   7263 
   7264 ;; OFLW2-CLR
   7265 L1824:  LD      (HL),A          ;
   7266         EXX                     ;
   7267         LD      A,B             ;
   7268         EXX                     ;
   7269 
   7270 ; addition joins here with carry flag clear.
   7271 
   7272 ;; TEST-NORM
   7273 L1828:  JR      NC,L183F        ; forward to NORMALIZE
   7274 
   7275         LD      A,(HL)          ;
   7276         AND     A               ;
   7277 
   7278 ;; NEAR-ZERO
   7279 L182C:  LD      A,$80           ; prepare to rescue the most significant bit 
   7280                                 ; of the mantissa if it is set.
   7281         JR      Z,L1831         ; skip forward to SKIP-ZERO
   7282 
   7283 ;; ZERO-RSLT
   7284 L1830:  XOR     A               ; make mask byte zero signaling set five
   7285                                 ; bytes to zero.
   7286 
   7287 ;; SKIP-ZERO
   7288 L1831:  EXX                     ; switch in alternate set
   7289         AND     D               ; isolate most significant bit (if A is $80).
   7290 
   7291         CALL    L1738           ; routine ZEROS-4/5 sets mantissa without 
   7292                                 ; affecting any flags.
   7293 
   7294         RLCA                    ; test if MSB set. bit 7 goes to bit 0.
   7295                                 ; either $00 -> $00 or $80 -> $01
   7296         LD      (HL),A          ; make exponent $01 (lowest) or $00 zero
   7297         JR      C,L1868         ; forward if first case to OFLOW-CLR
   7298 
   7299         INC     HL              ; address first mantissa byte on the
   7300                                 ; calculator stack.
   7301         LD      (HL),A          ; insert a zero for the sign bit.
   7302         DEC     HL              ; point to zero exponent
   7303         JR      L1868           ; forward to OFLOW-CLR
   7304 
   7305 ; ---
   7306 
   7307 ; this branch is common to addition and multiplication with the mantissa
   7308 ; result still in registers D'E'D E .
   7309 
   7310 ;; NORMALIZE
   7311 L183F:  LD      B,$20           ; a maximum of thirty-two left shifts will be 
   7312                                 ; needed.
   7313 
   7314 ;; SHIFT-ONE
   7315 L1841:  EXX                     ; address higher 16 bits.
   7316         BIT     7,D             ; test the leftmost bit
   7317         EXX                     ; address lower 16 bits.
   7318 
   7319         JR      NZ,L1859        ; forward if leftmost bit was set to NORML-NOW
   7320 
   7321         RLCA                    ; this holds zero from addition, 33rd bit 
   7322                                 ; from multiplication.
   7323 
   7324         RL      E               ; C < 76543210 < C
   7325         RL      D               ; C < 76543210 < C
   7326 
   7327         EXX                     ; address higher 16 bits.
   7328 
   7329         RL      E               ; C < 76543210 < C
   7330         RL      D               ; C < 76543210 < C
   7331 
   7332         EXX                     ; switch to main set.
   7333 
   7334         DEC     (HL)            ; decrement the exponent byte on the calculator
   7335                                 ; stack.
   7336 
   7337         JR      Z,L182C         ; back if exponent becomes zero to NEAR-ZERO
   7338                                 ; it's just possible that the last rotation
   7339                                 ; set bit 7 of D. We shall see.
   7340 
   7341         DJNZ    L1841           ; loop back to SHIFT-ONE
   7342 
   7343 ; if thirty-two left shifts were performed without setting the most significant 
   7344 ; bit then the result is zero.
   7345 
   7346         JR      L1830           ; back to ZERO-RSLT
   7347 
   7348 ; ---
   7349 
   7350 ;; NORML-NOW
   7351 L1859:  RLA                     ; for the addition path, A is always zero.
   7352                                 ; for the mult path, ...
   7353 
   7354         JR      NC,L1868        ; forward to OFLOW-CLR
   7355 
   7356 ; this branch is taken only with multiplication.
   7357 
   7358         CALL    L1741           ; routine ADD-BACK
   7359 
   7360         JR      NZ,L1868        ; forward to OFLOW-CLR
   7361 
   7362         EXX                     ;
   7363         LD      D,$80           ;
   7364         EXX                     ;
   7365         INC     (HL)            ;
   7366         JR      Z,L1880         ; forward to REPORT-6
   7367 
   7368 ; now transfer the mantissa from the register sets to the calculator stack
   7369 ; incorporating the sign bit already there.
   7370 
   7371 ;; OFLOW-CLR
   7372 L1868:  PUSH    HL              ; save pointer to exponent on stack.
   7373         INC     HL              ; address first byte of mantissa which was 
   7374                                 ; previously loaded with sign bit $00 or $80.
   7375 
   7376         EXX                     ; - - -
   7377         PUSH    DE              ; push the most significant two bytes.
   7378         EXX                     ; - - -
   7379 
   7380         POP     BC              ; pop - true mantissa is now BCDE.
   7381 
   7382 ; now pick up the sign bit.
   7383 
   7384         LD      A,B             ; first mantissa byte to A 
   7385         RLA                     ; rotate out bit 7 which is set
   7386         RL      (HL)            ; rotate sign bit on stack into carry.
   7387         RRA                     ; rotate sign bit into bit 7 of mantissa.
   7388 
   7389 ; and transfer mantissa from main registers to calculator stack.
   7390 
   7391         LD      (HL),A          ;
   7392         INC     HL              ;
   7393         LD      (HL),C          ;
   7394         INC     HL              ;
   7395         LD      (HL),D          ;
   7396         INC     HL              ;
   7397         LD      (HL),E          ;
   7398 
   7399         POP     HL              ; restore pointer to num1 now result.
   7400         POP     DE              ; restore pointer to num2 now STKEND.
   7401 
   7402         EXX                     ; - - -
   7403         POP     HL              ; restore pointer to next calculator literal.
   7404         EXX                     ; - - -
   7405 
   7406         RET                     ; return.
   7407 
   7408 ; ---
   7409 
   7410 ;; REPORT-6
   7411 L1880:  RST     08H             ; ERROR-1
   7412         DEFB    $05             ; Error Report: Arithmetic overflow.
   7413 
   7414 ; ------------------------
   7415 ; THE 'DIVISION' OPERATION
   7416 ; ------------------------
   7417 ;   "Of all the arithmetic subroutines, division is the most complicated and
   7418 ;   the least understood.  It is particularly interesting to note that the 
   7419 ;   Sinclair programmer himself has made a mistake in his programming ( or has
   7420 ;   copied over someone else's mistake!) for
   7421 ;   PRINT PEEK 6352 [ $18D0 ] ('unimproved' ROM, 6351 [ $18CF ] )
   7422 ;   should give 218 not 225."
   7423 ;   - Dr. Ian Logan, Syntax magazine Jul/Aug 1982.
   7424 ;   [  i.e. the jump should be made to div-34th ]
   7425 
   7426 ;   First check for division by zero.
   7427 
   7428 ;; division
   7429 L1882:  EX      DE,HL           ; consider the second number first. 
   7430         XOR     A               ; set the running sign flag.
   7431         CALL    L17BC           ; routine PREP-M/D
   7432         JR      C,L1880         ; back if zero to REPORT-6
   7433                                 ; 'Arithmetic overflow'
   7434 
   7435         EX      DE,HL           ; now prepare first number and check for zero.
   7436         CALL    L17BC           ; routine PREP-M/D
   7437         RET     C               ; return if zero, 0/anything is zero.
   7438 
   7439         EXX                     ; - - -
   7440         PUSH    HL              ; save pointer to the next calculator literal.
   7441         EXX                     ; - - -
   7442 
   7443         PUSH    DE              ; save pointer to divisor - will be STKEND.
   7444         PUSH    HL              ; save pointer to dividend - will be result.
   7445 
   7446         CALL    L16F7           ; routine FETCH-TWO fetches the two numbers
   7447                                 ; into the registers H'B'C'C B
   7448                                 ;                    L'D'E'D E
   7449         EXX                     ; - - -
   7450         PUSH    HL              ; save the two exponents.
   7451 
   7452         LD      H,B             ; transfer the dividend to H'L'H L
   7453         LD      L,C             ; 
   7454         EXX                     ;
   7455         LD      H,C             ;
   7456         LD      L,B             ; 
   7457 
   7458         XOR     A               ; clear carry bit and accumulator.
   7459         LD      B,$DF           ; count upwards from -33 decimal
   7460         JR      L18B2           ; forward to mid-loop entry point DIV-START
   7461 
   7462 ; ---
   7463 
   7464 ;; DIV-LOOP
   7465 L18A2:  RLA                     ; multiply partial quotient by two
   7466         RL      C               ; setting result bit from carry.
   7467         EXX                     ;
   7468         RL      C               ;
   7469         RL      B               ;
   7470         EXX                     ;
   7471 
   7472 ;; div-34th
   7473 L18AB:  ADD     HL,HL           ;
   7474         EXX                     ;
   7475         ADC     HL,HL           ;
   7476         EXX                     ;
   7477         JR      C,L18C2         ; forward to SUBN-ONLY
   7478 
   7479 ;; DIV-START
   7480 L18B2:  SBC     HL,DE           ; subtract divisor part.
   7481         EXX                     ;
   7482         SBC     HL,DE           ;
   7483         EXX                     ;
   7484         JR      NC,L18C9        ; forward if subtraction goes to NO-RSTORE
   7485 
   7486         ADD     HL,DE           ; else restore     
   7487         EXX                     ;
   7488         ADC     HL,DE           ;
   7489         EXX                     ;
   7490         AND     A               ; clear carry
   7491         JR      L18CA           ; forward to COUNT-ONE
   7492 
   7493 ; ---
   7494 
   7495 ;; SUBN-ONLY
   7496 L18C2:  AND     A               ;
   7497         SBC     HL,DE           ;
   7498         EXX                     ;
   7499         SBC     HL,DE           ;
   7500         EXX                     ;
   7501 
   7502 ;; NO-RSTORE
   7503 L18C9:  SCF                     ; set carry flag
   7504 
   7505 ;; COUNT-ONE
   7506 L18CA:  INC     B               ; increment the counter
   7507         JP      M,L18A2         ; back while still minus to DIV-LOOP
   7508 
   7509         PUSH    AF              ;
   7510         JR      Z,L18B2         ; back to DIV-START
   7511 
   7512 ; "This jump is made to the wrong place. No 34th bit will ever be obtained
   7513 ; without first shifting the dividend. Hence important results like 1/10 and
   7514 ; 1/1000 are not rounded up as they should be. Rounding up never occurs when
   7515 ; it depends on the 34th bit. The jump should be made to div-34th above."
   7516 ; - Dr. Frank O'Hara, "The Complete Spectrum ROM Disassembly", 1983,
   7517 ; published by Melbourne House.
   7518 ; (Note. on the ZX81 this would be JR Z,L18AB)
   7519 ;
   7520 ; However if you make this change, then while (1/2=.5) will now evaluate as
   7521 ; true, (.25=1/4), which did evaluate as true, no longer does.
   7522 
   7523         LD      E,A             ;
   7524         LD      D,C             ;
   7525         EXX                     ;
   7526         LD      E,C             ;
   7527         LD      D,B             ;
   7528 
   7529         POP     AF              ;
   7530         RR      B               ;
   7531         POP     AF              ;
   7532         RR      B               ;
   7533 
   7534         EXX                     ;
   7535         POP     BC              ;
   7536         POP     HL              ;
   7537         LD      A,B             ;
   7538         SUB     C               ;
   7539         JP      L1810           ; jump back to DIVN-EXPT
   7540 
   7541 ; ------------------------------------------------
   7542 ; THE 'INTEGER TRUNCATION TOWARDS ZERO' SUBROUTINE
   7543 ; ------------------------------------------------
   7544 ;
   7545 
   7546 ;; truncate
   7547 L18E4:  LD      A,(HL)          ; fetch exponent
   7548         CP      $81             ; compare to +1  
   7549         JR      NC,L18EF        ; forward, if 1 or more, to T-GR-ZERO
   7550 
   7551 ; else the number is smaller than plus or minus 1 and can be made zero.
   7552 
   7553         LD      (HL),$00        ; make exponent zero.
   7554         LD      A,$20           ; prepare to set 32 bits of mantissa to zero.
   7555         JR      L18F4           ; forward to NIL-BYTES
   7556 
   7557 ; ---
   7558 
   7559 ;; T-GR-ZERO
   7560 L18EF:  SUB     $A0             ; subtract +32 from exponent
   7561         RET     P               ; return if result is positive as all 32 bits 
   7562                                 ; of the mantissa relate to the integer part.
   7563                                 ; The floating point is somewhere to the right 
   7564                                 ; of the mantissa
   7565 
   7566         NEG                     ; else negate to form number of rightmost bits 
   7567                                 ; to be blanked.
   7568 
   7569 ; for instance, disregarding the sign bit, the number 3.5 is held as 
   7570 ; exponent $82 mantissa .11100000 00000000 00000000 00000000
   7571 ; we need to set $82 - $A0 = $E2 NEG = $1E (thirty) bits to zero to form the 
   7572 ; integer.
   7573 ; The sign of the number is never considered as the first bit of the mantissa
   7574 ; must be part of the integer.
   7575 
   7576 ;; NIL-BYTES
   7577 L18F4:  PUSH    DE              ; save pointer to STKEND
   7578         EX      DE,HL           ; HL points at STKEND
   7579         DEC     HL              ; now at last byte of mantissa.
   7580         LD      B,A             ; Transfer bit count to B register.
   7581         SRL     B               ; divide by 
   7582         SRL     B               ; eight
   7583         SRL     B               ;
   7584         JR      Z,L1905         ; forward if zero to BITS-ZERO
   7585 
   7586 ; else the original count was eight or more and whole bytes can be blanked.
   7587 
   7588 ;; BYTE-ZERO
   7589 L1900:  LD      (HL),$00        ; set eight bits to zero.
   7590         DEC     HL              ; point to more significant byte of mantissa.
   7591         DJNZ    L1900           ; loop back to BYTE-ZERO
   7592 
   7593 ; now consider any residual bits.
   7594 
   7595 ;; BITS-ZERO
   7596 L1905:  AND     $07             ; isolate the remaining bits
   7597         JR      Z,L1912         ; forward if none to IX-END
   7598 
   7599         LD      B,A             ; transfer bit count to B counter.
   7600         LD      A,$FF           ; form a mask 11111111
   7601 
   7602 ;; LESS-MASK
   7603 L190C:  SLA     A               ; 1 <- 76543210 <- o     slide mask leftwards.
   7604         DJNZ    L190C           ; loop back for bit count to LESS-MASK
   7605 
   7606         AND     (HL)            ; lose the unwanted rightmost bits
   7607         LD      (HL),A          ; and place in mantissa byte.
   7608 
   7609 ;; IX-END
   7610 L1912:  EX      DE,HL           ; restore result pointer from DE. 
   7611         POP     DE              ; restore STKEND from stack.
   7612         RET                     ; return.
   7613 
   7614 
   7615 ;********************************
   7616 ;**  FLOATING-POINT CALCULATOR **
   7617 ;********************************
   7618 
   7619 ; As a general rule the calculator avoids using the IY register.
   7620 ; Exceptions are val and str$.
   7621 ; So an assembly language programmer who has disabled interrupts to use IY
   7622 ; for other purposes can still use the calculator for mathematical
   7623 ; purposes.
   7624 
   7625 
   7626 ; ------------------------
   7627 ; THE 'TABLE OF CONSTANTS'
   7628 ; ------------------------
   7629 ; The ZX81 has only floating-point number representation.
   7630 ; Both the ZX80 and the ZX Spectrum have integer numbers in some form.
   7631 
   7632 ;; stk-zero                                                 00 00 00 00 00
   7633 L1915:  DEFB    $00             ;;Bytes: 1
   7634         DEFB    $B0             ;;Exponent $00
   7635         DEFB    $00             ;;(+00,+00,+00)
   7636 
   7637 ;; stk-one                                                  81 00 00 00 00
   7638 L1918:  DEFB    $31             ;;Exponent $81, Bytes: 1
   7639         DEFB    $00             ;;(+00,+00,+00)
   7640 
   7641 
   7642 ;; stk-half                                                 80 00 00 00 00
   7643 L191A:  DEFB    $30             ;;Exponent: $80, Bytes: 1
   7644         DEFB    $00             ;;(+00,+00,+00)
   7645 
   7646 
   7647 ;; stk-pi/2                                                 81 49 0F DA A2
   7648 L191C:  DEFB    $F1             ;;Exponent: $81, Bytes: 4
   7649         DEFB    $49,$0F,$DA,$A2 ;;
   7650 
   7651 ;; stk-ten                                                  84 20 00 00 00
   7652 L1921:  DEFB    $34             ;;Exponent: $84, Bytes: 1
   7653         DEFB    $20             ;;(+00,+00,+00)
   7654 
   7655 
   7656 ; ------------------------
   7657 ; THE 'TABLE OF ADDRESSES'
   7658 ; ------------------------
   7659 ;
   7660 ; starts with binary operations which have two operands and one result.
   7661 ; three pseudo binary operations first.
   7662 
   7663 ;; tbl-addrs
   7664 L1923:  DEFW    L1C2F           ; $00 Address: $1C2F - jump-true
   7665         DEFW    L1A72           ; $01 Address: $1A72 - exchange
   7666         DEFW    L19E3           ; $02 Address: $19E3 - delete
   7667 
   7668 ; true binary operations.
   7669 
   7670         DEFW    L174C           ; $03 Address: $174C - subtract
   7671         DEFW    L17C6           ; $04 Address: $176C - multiply
   7672         DEFW    L1882           ; $05 Address: $1882 - division
   7673         DEFW    L1DE2           ; $06 Address: $1DE2 - to-power
   7674         DEFW    L1AED           ; $07 Address: $1AED - or
   7675 
   7676         DEFW    L1AF3           ; $08 Address: $1B03 - no-&-no
   7677         DEFW    L1B03           ; $09 Address: $1B03 - no-l-eql
   7678         DEFW    L1B03           ; $0A Address: $1B03 - no-gr-eql
   7679         DEFW    L1B03           ; $0B Address: $1B03 - nos-neql
   7680         DEFW    L1B03           ; $0C Address: $1B03 - no-grtr
   7681         DEFW    L1B03           ; $0D Address: $1B03 - no-less
   7682         DEFW    L1B03           ; $0E Address: $1B03 - nos-eql
   7683         DEFW    L1755           ; $0F Address: $1755 - addition
   7684 
   7685         DEFW    L1AF8           ; $10 Address: $1AF8 - str-&-no
   7686         DEFW    L1B03           ; $11 Address: $1B03 - str-l-eql
   7687         DEFW    L1B03           ; $12 Address: $1B03 - str-gr-eql
   7688         DEFW    L1B03           ; $13 Address: $1B03 - strs-neql
   7689         DEFW    L1B03           ; $14 Address: $1B03 - str-grtr
   7690         DEFW    L1B03           ; $15 Address: $1B03 - str-less
   7691         DEFW    L1B03           ; $16 Address: $1B03 - strs-eql
   7692         DEFW    L1B62           ; $17 Address: $1B62 - strs-add
   7693 
   7694 ; unary follow
   7695 
   7696         DEFW    L1AA0           ; $18 Address: $1AA0 - neg
   7697 
   7698         DEFW    L1C06           ; $19 Address: $1C06 - code
   7699         DEFW    L1BA4           ; $1A Address: $1BA4 - val
   7700         DEFW    L1C11           ; $1B Address: $1C11 - len
   7701         DEFW    L1D49           ; $1C Address: $1D49 - sin
   7702         DEFW    L1D3E           ; $1D Address: $1D3E - cos
   7703         DEFW    L1D6E           ; $1E Address: $1D6E - tan
   7704         DEFW    L1DC4           ; $1F Address: $1DC4 - asn
   7705         DEFW    L1DD4           ; $20 Address: $1DD4 - acs
   7706         DEFW    L1D76           ; $21 Address: $1D76 - atn
   7707         DEFW    L1CA9           ; $22 Address: $1CA9 - ln
   7708         DEFW    L1C5B           ; $23 Address: $1C5B - exp
   7709         DEFW    L1C46           ; $24 Address: $1C46 - int
   7710         DEFW    L1DDB           ; $25 Address: $1DDB - sqr
   7711         DEFW    L1AAF           ; $26 Address: $1AAF - sgn
   7712         DEFW    L1AAA           ; $27 Address: $1AAA - abs
   7713         DEFW    L1ABE           ; $28 Address: $1A1B - peek
   7714         DEFW    L1AC5           ; $29 Address: $1AC5 - usr-no
   7715         DEFW    L1BD5           ; $2A Address: $1BD5 - str$
   7716         DEFW    L1B8F           ; $2B Address: $1B8F - chrs
   7717         DEFW    L1AD5           ; $2C Address: $1AD5 - not
   7718 
   7719 ; end of true unary
   7720 
   7721         DEFW    L19F6           ; $2D Address: $19F6 - duplicate
   7722         DEFW    L1C37           ; $2E Address: $1C37 - n-mod-m
   7723 
   7724         DEFW    L1C23           ; $2F Address: $1C23 - jump
   7725         DEFW    L19FC           ; $30 Address: $19FC - stk-data
   7726 
   7727         DEFW    L1C17           ; $31 Address: $1C17 - dec-jr-nz
   7728         DEFW    L1ADB           ; $32 Address: $1ADB - less-0
   7729         DEFW    L1ACE           ; $33 Address: $1ACE - greater-0
   7730         DEFW    L002B           ; $34 Address: $002B - end-calc
   7731         DEFW    L1D18           ; $35 Address: $1D18 - get-argt
   7732         DEFW    L18E4           ; $36 Address: $18E4 - truncate
   7733         DEFW    L19E4           ; $37 Address: $19E4 - fp-calc-2
   7734         DEFW    L155A           ; $38 Address: $155A - e-to-fp
   7735 
   7736 ; the following are just the next available slots for the 128 compound literals
   7737 ; which are in range $80 - $FF.
   7738 
   7739         DEFW    L1A7F           ; $39 Address: $1A7F - series-xx    $80 - $9F.
   7740         DEFW    L1A51           ; $3A Address: $1A51 - stk-const-xx $A0 - $BF.
   7741         DEFW    L1A63           ; $3B Address: $1A63 - st-mem-xx    $C0 - $DF.
   7742         DEFW    L1A45           ; $3C Address: $1A45 - get-mem-xx   $E0 - $FF.
   7743 
   7744 ; Aside: 3D - 7F are therefore unused calculator literals.
   7745 ;        39 - 7B would be available for expansion.
   7746 
   7747 ; -------------------------------
   7748 ; THE 'FLOATING POINT CALCULATOR'
   7749 ; -------------------------------
   7750 ;
   7751 ;
   7752 
   7753 ;; CALCULATE
   7754 L199D:  CALL    L1B85           ; routine STK-PNTRS is called to set up the
   7755                                 ; calculator stack pointers for a default
   7756                                 ; unary operation. HL = last value on stack.
   7757                                 ; DE = STKEND first location after stack.
   7758 
   7759 ; the calculate routine is called at this point by the series generator...
   7760 
   7761 ;; GEN-ENT-1
   7762 L19A0:  LD      A,B             ; fetch the Z80 B register to A
   7763         LD      ($401E),A       ; and store value in system variable BREG.
   7764                                 ; this will be the counter for dec-jr-nz
   7765                                 ; or if used from fp-calc2 the calculator
   7766                                 ; instruction.
   7767 
   7768 ; ... and again later at this point
   7769 
   7770 ;; GEN-ENT-2
   7771 L19A4:  EXX                     ; switch sets
   7772         EX      (SP),HL         ; and store the address of next instruction,
   7773                                 ; the return address, in H'L'.
   7774                                 ; If this is a recursive call then the H'L'
   7775                                 ; of the previous invocation goes on stack.
   7776                                 ; c.f. end-calc.
   7777         EXX                     ; switch back to main set.
   7778 
   7779 ; this is the re-entry looping point when handling a string of literals.
   7780 
   7781 ;; RE-ENTRY
   7782 L19A7:  LD      ($401C),DE      ; save end of stack in system variable STKEND
   7783         EXX                     ; switch to alt
   7784         LD      A,(HL)          ; get next literal
   7785         INC     HL              ; increase pointer'
   7786 
   7787 ; single operation jumps back to here
   7788 
   7789 ;; SCAN-ENT
   7790 L19AE:  PUSH    HL              ; save pointer on stack   *
   7791         AND     A               ; now test the literal
   7792         JP      P,L19C2         ; forward to FIRST-3D if in range $00 - $3D
   7793                                 ; anything with bit 7 set will be one of
   7794                                 ; 128 compound literals.
   7795 
   7796 ; compound literals have the following format.
   7797 ; bit 7 set indicates compound.
   7798 ; bits 6-5 the subgroup 0-3.
   7799 ; bits 4-0 the embedded parameter $00 - $1F.
   7800 ; The subgroup 0-3 needs to be manipulated to form the next available four
   7801 ; address places after the simple literals in the address table.
   7802 
   7803         LD      D,A             ; save literal in D
   7804         AND     $60             ; and with 01100000 to isolate subgroup
   7805         RRCA                    ; rotate bits
   7806         RRCA                    ; 4 places to right
   7807         RRCA                    ; not five as we need offset * 2
   7808         RRCA                    ; 00000xx0
   7809         ADD     A,$72           ; add ($39 * 2) to give correct offset.
   7810                                 ; alter above if you add more literals.
   7811         LD      L,A             ; store in L for later indexing.
   7812         LD      A,D             ; bring back compound literal
   7813         AND     $1F             ; use mask to isolate parameter bits
   7814         JR      L19D0           ; forward to ENT-TABLE
   7815 
   7816 ; ---
   7817 
   7818 ; the branch was here with simple literals.
   7819 
   7820 ;; FIRST-3D
   7821 L19C2:  CP      $18             ; compare with first unary operations.
   7822         JR      NC,L19CE        ; to DOUBLE-A with unary operations
   7823 
   7824 ; it is binary so adjust pointers.
   7825 
   7826         EXX                     ;
   7827         LD      BC,$FFFB        ; the value -5
   7828         LD      D,H             ; transfer HL, the last value, to DE.
   7829         LD      E,L             ;
   7830         ADD     HL,BC           ; subtract 5 making HL point to second
   7831                                 ; value.
   7832         EXX                     ;
   7833 
   7834 ;; DOUBLE-A
   7835 L19CE:  RLCA                    ; double the literal
   7836         LD      L,A             ; and store in L for indexing
   7837 
   7838 ;; ENT-TABLE
   7839 L19D0:  LD      DE,L1923        ; Address: tbl-addrs
   7840         LD      H,$00           ; prepare to index
   7841         ADD     HL,DE           ; add to get address of routine
   7842         LD      E,(HL)          ; low byte to E
   7843         INC     HL              ;
   7844         LD      D,(HL)          ; high byte to D
   7845 
   7846         LD      HL,L19A7        ; Address: RE-ENTRY
   7847         EX      (SP),HL         ; goes on machine stack
   7848                                 ; address of next literal goes to HL. *
   7849 
   7850 
   7851         PUSH    DE              ; now the address of routine is stacked.
   7852         EXX                     ; back to main set
   7853                                 ; avoid using IY register.
   7854         LD      BC,($401D)      ; STKEND_hi
   7855                                 ; nothing much goes to C but BREG to B
   7856                                 ; and continue into next ret instruction
   7857                                 ; which has a dual identity
   7858 
   7859 
   7860 ; -----------------------
   7861 ; THE 'DELETE' SUBROUTINE
   7862 ; -----------------------
   7863 ; offset $02: 'delete'
   7864 ; A simple return but when used as a calculator literal this
   7865 ; deletes the last value from the calculator stack.
   7866 ; On entry, as always with binary operations,
   7867 ; HL=first number, DE=second number
   7868 ; On exit, HL=result, DE=stkend.
   7869 ; So nothing to do
   7870 
   7871 ;; delete
   7872 L19E3:  RET                     ; return - indirect jump if from above.
   7873 
   7874 ; ---------------------------------
   7875 ; THE 'SINGLE OPERATION' SUBROUTINE
   7876 ; ---------------------------------
   7877 ; offset $37: 'fp-calc-2'
   7878 ; this single operation is used, in the first instance, to evaluate most
   7879 ; of the mathematical and string functions found in BASIC expressions.
   7880 
   7881 ;; fp-calc-2
   7882 L19E4:  POP     AF              ; drop return address.
   7883         LD      A,($401E)       ; load accumulator from system variable BREG
   7884                                 ; value will be literal eg. 'tan'
   7885         EXX                     ; switch to alt
   7886         JR      L19AE           ; back to SCAN-ENT
   7887                                 ; next literal will be end-calc in scanning
   7888 
   7889 ; ------------------------------
   7890 ; THE 'TEST 5 SPACES' SUBROUTINE
   7891 ; ------------------------------
   7892 ; This routine is called from MOVE-FP, STK-CONST and STK-STORE to
   7893 ; test that there is enough space between the calculator stack and the
   7894 ; machine stack for another five-byte value. It returns with BC holding
   7895 ; the value 5 ready for any subsequent LDIR.
   7896 
   7897 ;; TEST-5-SP
   7898 L19EB:  PUSH    DE              ; save
   7899         PUSH    HL              ; registers
   7900         LD      BC,$0005        ; an overhead of five bytes
   7901         CALL    L0EC5           ; routine TEST-ROOM tests free RAM raising
   7902                                 ; an error if not.
   7903         POP     HL              ; else restore
   7904         POP     DE              ; registers.
   7905         RET                     ; return with BC set at 5.
   7906 
   7907 
   7908 ; ---------------------------------------------
   7909 ; THE 'MOVE A FLOATING POINT NUMBER' SUBROUTINE
   7910 ; ---------------------------------------------
   7911 ; offset $2D: 'duplicate'
   7912 ; This simple routine is a 5-byte LDIR instruction
   7913 ; that incorporates a memory check.
   7914 ; When used as a calculator literal it duplicates the last value on the
   7915 ; calculator stack.
   7916 ; Unary so on entry HL points to last value, DE to stkend
   7917 
   7918 ;; duplicate
   7919 ;; MOVE-FP
   7920 L19F6:  CALL    L19EB           ; routine TEST-5-SP test free memory
   7921                                 ; and sets BC to 5.
   7922         LDIR                    ; copy the five bytes.
   7923         RET                     ; return with DE addressing new STKEND
   7924                                 ; and HL addressing new last value.
   7925 
   7926 ; -------------------------------
   7927 ; THE 'STACK LITERALS' SUBROUTINE
   7928 ; -------------------------------
   7929 ; offset $30: 'stk-data'
   7930 ; When a calculator subroutine needs to put a value on the calculator
   7931 ; stack that is not a regular constant this routine is called with a
   7932 ; variable number of following data bytes that convey to the routine
   7933 ; the floating point form as succinctly as is possible.
   7934 
   7935 ;; stk-data
   7936 L19FC:  LD      H,D             ; transfer STKEND
   7937         LD      L,E             ; to HL for result.
   7938 
   7939 ;; STK-CONST
   7940 L19FE:  CALL    L19EB           ; routine TEST-5-SP tests that room exists
   7941                                 ; and sets BC to $05.
   7942 
   7943         EXX                     ; switch to alternate set
   7944         PUSH    HL              ; save the pointer to next literal on stack
   7945         EXX                     ; switch back to main set
   7946 
   7947         EX      (SP),HL         ; pointer to HL, destination to stack.
   7948 
   7949         PUSH    BC              ; save BC - value 5 from test room ??.
   7950 
   7951         LD      A,(HL)          ; fetch the byte following 'stk-data'
   7952         AND     $C0             ; isolate bits 7 and 6
   7953         RLCA                    ; rotate
   7954         RLCA                    ; to bits 1 and 0  range $00 - $03.
   7955         LD      C,A             ; transfer to C
   7956         INC     C               ; and increment to give number of bytes
   7957                                 ; to read. $01 - $04
   7958         LD      A,(HL)          ; reload the first byte
   7959         AND     $3F             ; mask off to give possible exponent.
   7960         JR      NZ,L1A14        ; forward to FORM-EXP if it was possible to
   7961                                 ; include the exponent.
   7962 
   7963 ; else byte is just a byte count and exponent comes next.
   7964 
   7965         INC     HL              ; address next byte and
   7966         LD      A,(HL)          ; pick up the exponent ( - $50).
   7967 
   7968 ;; FORM-EXP
   7969 L1A14:  ADD     A,$50           ; now add $50 to form actual exponent
   7970         LD      (DE),A          ; and load into first destination byte.
   7971         LD      A,$05           ; load accumulator with $05 and
   7972         SUB     C               ; subtract C to give count of trailing
   7973                                 ; zeros plus one.
   7974         INC     HL              ; increment source
   7975         INC     DE              ; increment destination
   7976         LD      B,$00           ; prepare to copy
   7977         LDIR                    ; copy C bytes
   7978 
   7979         POP     BC              ; restore 5 counter to BC ??.
   7980 
   7981         EX      (SP),HL         ; put HL on stack as next literal pointer
   7982                                 ; and the stack value - result pointer -
   7983                                 ; to HL.
   7984 
   7985         EXX                     ; switch to alternate set.
   7986         POP     HL              ; restore next literal pointer from stack
   7987                                 ; to H'L'.
   7988         EXX                     ; switch back to main set.
   7989 
   7990         LD      B,A             ; zero count to B
   7991         XOR     A               ; clear accumulator
   7992 
   7993 ;; STK-ZEROS
   7994 L1A27:  DEC     B               ; decrement B counter
   7995         RET     Z               ; return if zero.          >>
   7996                                 ; DE points to new STKEND
   7997                                 ; HL to new number.
   7998 
   7999         LD      (DE),A          ; else load zero to destination
   8000         INC     DE              ; increase destination
   8001         JR      L1A27           ; loop back to STK-ZEROS until done.
   8002 
   8003 ; -------------------------------
   8004 ; THE 'SKIP CONSTANTS' SUBROUTINE
   8005 ; -------------------------------
   8006 ; This routine traverses variable-length entries in the table of constants,
   8007 ; stacking intermediate, unwanted constants onto a dummy calculator stack,
   8008 ; in the first five bytes of the ZX81 ROM.
   8009 
   8010 ;; SKIP-CONS
   8011 L1A2D:  AND     A               ; test if initially zero.
   8012 
   8013 ;; SKIP-NEXT
   8014 L1A2E:  RET     Z               ; return if zero.          >>
   8015 
   8016         PUSH     AF             ; save count.
   8017         PUSH    DE              ; and normal STKEND
   8018 
   8019         LD      DE,$0000        ; dummy value for STKEND at start of ROM
   8020                                 ; Note. not a fault but this has to be
   8021                                 ; moved elsewhere when running in RAM.
   8022                                 ;
   8023         CALL    L19FE           ; routine STK-CONST works through variable
   8024                                 ; length records.
   8025 
   8026         POP     DE              ; restore real STKEND
   8027         POP     AF              ; restore count
   8028         DEC     A               ; decrease
   8029         JR      L1A2E           ; loop back to SKIP-NEXT
   8030 
   8031 ; --------------------------------
   8032 ; THE 'MEMORY LOCATION' SUBROUTINE
   8033 ; --------------------------------
   8034 ; This routine, when supplied with a base address in HL and an index in A,
   8035 ; will calculate the address of the A'th entry, where each entry occupies
   8036 ; five bytes. It is used for addressing floating-point numbers in the
   8037 ; calculator's memory area.
   8038 
   8039 ;; LOC-MEM
   8040 L1A3C:  LD      C,A             ; store the original number $00-$1F.
   8041         RLCA                    ; double.
   8042         RLCA                    ; quadruple.
   8043         ADD     A,C             ; now add original value to multiply by five.
   8044 
   8045         LD      C,A             ; place the result in C.
   8046         LD      B,$00           ; set B to 0.
   8047         ADD     HL,BC           ; add to form address of start of number in HL.
   8048 
   8049         RET                     ; return.
   8050 
   8051 ; -------------------------------------
   8052 ; THE 'GET FROM MEMORY AREA' SUBROUTINE
   8053 ; -------------------------------------
   8054 ; offsets $E0 to $FF: 'get-mem-0', 'get-mem-1' etc.
   8055 ; A holds $00-$1F offset.
   8056 ; The calculator stack increases by 5 bytes.
   8057 
   8058 ;; get-mem-xx
   8059 L1A45:  PUSH    DE              ; save STKEND
   8060         LD      HL,($401F)      ; MEM is base address of the memory cells.
   8061         CALL    L1A3C           ; routine LOC-MEM so that HL = first byte
   8062         CALL    L19F6           ; routine MOVE-FP moves 5 bytes with memory
   8063                                 ; check.
   8064                                 ; DE now points to new STKEND.
   8065         POP     HL              ; the original STKEND is now RESULT pointer.
   8066         RET                     ; return.
   8067 
   8068 ; ---------------------------------
   8069 ; THE 'STACK A CONSTANT' SUBROUTINE
   8070 ; ---------------------------------
   8071 ; offset $A0: 'stk-zero'
   8072 ; offset $A1: 'stk-one'
   8073 ; offset $A2: 'stk-half'
   8074 ; offset $A3: 'stk-pi/2'
   8075 ; offset $A4: 'stk-ten'
   8076 ; This routine allows a one-byte instruction to stack up to 32 constants
   8077 ; held in short form in a table of constants. In fact only 5 constants are
   8078 ; required. On entry the A register holds the literal ANDed with $1F.
   8079 ; It isn't very efficient and it would have been better to hold the
   8080 ; numbers in full, five byte form and stack them in a similar manner
   8081 ; to that which would be used later for semi-tone table values.
   8082 
   8083 ;; stk-const-xx
   8084 L1A51:  LD      H,D             ; save STKEND - required for result
   8085         LD      L,E             ;
   8086         EXX                     ; swap
   8087         PUSH    HL              ; save pointer to next literal
   8088         LD      HL,L1915        ; Address: stk-zero - start of table of
   8089                                 ; constants
   8090         EXX                     ;
   8091         CALL    L1A2D           ; routine SKIP-CONS
   8092         CALL    L19FE           ; routine STK-CONST
   8093         EXX                     ;
   8094         POP     HL              ; restore pointer to next literal.
   8095         EXX                     ;
   8096         RET                     ; return.
   8097 
   8098 ; ---------------------------------------
   8099 ; THE 'STORE IN A MEMORY AREA' SUBROUTINE
   8100 ; ---------------------------------------
   8101 ; Offsets $C0 to $DF: 'st-mem-0', 'st-mem-1' etc.
   8102 ; Although 32 memory storage locations can be addressed, only six
   8103 ; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5)
   8104 ; required for these are allocated. ZX81 programmers who wish to
   8105 ; use the floating point routines from assembly language may wish to
   8106 ; alter the system variable MEM to point to 160 bytes of RAM to have
   8107 ; use the full range available.
   8108 ; A holds derived offset $00-$1F.
   8109 ; Unary so on entry HL points to last value, DE to STKEND.
   8110 
   8111 ;; st-mem-xx
   8112 L1A63:  PUSH    HL              ; save the result pointer.
   8113         EX      DE,HL           ; transfer to DE.
   8114         LD      HL,($401F)      ; fetch MEM the base of memory area.
   8115         CALL    L1A3C           ; routine LOC-MEM sets HL to the destination.
   8116         EX      DE,HL           ; swap - HL is start, DE is destination.
   8117         CALL    L19F6           ; routine MOVE-FP.
   8118                                 ; note. a short ld bc,5; ldir
   8119                                 ; the embedded memory check is not required
   8120                                 ; so these instructions would be faster!
   8121         EX      DE,HL           ; DE = STKEND
   8122         POP     HL              ; restore original result pointer
   8123         RET                     ; return.
   8124 
   8125 ; -------------------------
   8126 ; THE 'EXCHANGE' SUBROUTINE
   8127 ; -------------------------
   8128 ; offset $01: 'exchange'
   8129 ; This routine exchanges the last two values on the calculator stack
   8130 ; On entry, as always with binary operations,
   8131 ; HL=first number, DE=second number
   8132 ; On exit, HL=result, DE=stkend.
   8133 
   8134 ;; exchange
   8135 L1A72:  LD      B,$05           ; there are five bytes to be swapped
   8136 
   8137 ; start of loop.
   8138 
   8139 ;; SWAP-BYTE
   8140 L1A74:  LD      A,(DE)          ; each byte of second
   8141         LD      C,(HL)          ; each byte of first
   8142         EX      DE,HL           ; swap pointers
   8143         LD      (DE),A          ; store each byte of first
   8144         LD      (HL),C          ; store each byte of second
   8145         INC     HL              ; advance both
   8146         INC     DE              ; pointers.
   8147         DJNZ    L1A74           ; loop back to SWAP-BYTE until all 5 done.
   8148 
   8149         EX      DE,HL           ; even up the exchanges
   8150                                 ; so that DE addresses STKEND.
   8151         RET                     ; return.
   8152 
   8153 ; ---------------------------------
   8154 ; THE 'SERIES GENERATOR' SUBROUTINE
   8155 ; ---------------------------------
   8156 ; offset $86: 'series-06'
   8157 ; offset $88: 'series-08'
   8158 ; offset $8C: 'series-0C'
   8159 ; The ZX81 uses Chebyshev polynomials to generate approximations for
   8160 ; SIN, ATN, LN and EXP. These are named after the Russian mathematician
   8161 ; Pafnuty Chebyshev, born in 1821, who did much pioneering work on numerical
   8162 ; series. As far as calculators are concerned, Chebyshev polynomials have an
   8163 ; advantage over other series, for example the Taylor series, as they can
   8164 ; reach an approximation in just six iterations for SIN, eight for EXP and
   8165 ; twelve for LN and ATN. The mechanics of the routine are interesting but
   8166 ; for full treatment of how these are generated with demonstrations in
   8167 ; Sinclair BASIC see "The Complete Spectrum ROM Disassembly" by Dr Ian Logan
   8168 ; and Dr Frank O'Hara, published 1983 by Melbourne House.
   8169 
   8170 ;; series-xx
   8171 L1A7F:  LD      B,A             ; parameter $00 - $1F to B counter
   8172         CALL    L19A0           ; routine GEN-ENT-1 is called.
   8173                                 ; A recursive call to a special entry point
   8174                                 ; in the calculator that puts the B register
   8175                                 ; in the system variable BREG. The return
   8176                                 ; address is the next location and where
   8177                                 ; the calculator will expect its first
   8178                                 ; instruction - now pointed to by HL'.
   8179                                 ; The previous pointer to the series of
   8180                                 ; five-byte numbers goes on the machine stack.
   8181 
   8182 ; The initialization phase.
   8183 
   8184         DEFB    $2D             ;;duplicate       x,x
   8185         DEFB    $0F             ;;addition        x+x
   8186         DEFB    $C0             ;;st-mem-0        x+x
   8187         DEFB    $02             ;;delete          .
   8188         DEFB    $A0             ;;stk-zero        0
   8189         DEFB    $C2             ;;st-mem-2        0
   8190 
   8191 ; a loop is now entered to perform the algebraic calculation for each of
   8192 ; the numbers in the series
   8193 
   8194 ;; G-LOOP
   8195 L1A89:  DEFB    $2D             ;;duplicate       v,v.
   8196         DEFB    $E0             ;;get-mem-0       v,v,x+2
   8197         DEFB    $04             ;;multiply        v,v*x+2
   8198         DEFB    $E2             ;;get-mem-2       v,v*x+2,v
   8199         DEFB    $C1             ;;st-mem-1
   8200         DEFB    $03             ;;subtract
   8201         DEFB    $34             ;;end-calc
   8202 
   8203 ; the previous pointer is fetched from the machine stack to H'L' where it
   8204 ; addresses one of the numbers of the series following the series literal.
   8205 
   8206         CALL    L19FC           ; routine STK-DATA is called directly to
   8207                                 ; push a value and advance H'L'.
   8208         CALL    L19A4           ; routine GEN-ENT-2 recursively re-enters
   8209                                 ; the calculator without disturbing
   8210                                 ; system variable BREG
   8211                                 ; H'L' value goes on the machine stack and is
   8212                                 ; then loaded as usual with the next address.
   8213 
   8214         DEFB    $0F             ;;addition
   8215         DEFB    $01             ;;exchange
   8216         DEFB    $C2             ;;st-mem-2
   8217         DEFB    $02             ;;delete
   8218 
   8219         DEFB    $31             ;;dec-jr-nz
   8220         DEFB    $EE             ;;back to L1A89, G-LOOP
   8221 
   8222 ; when the counted loop is complete the final subtraction yields the result
   8223 ; for example SIN X.
   8224 
   8225         DEFB    $E1             ;;get-mem-1
   8226         DEFB    $03             ;;subtract
   8227         DEFB    $34             ;;end-calc
   8228 
   8229         RET                     ; return with H'L' pointing to location
   8230                                 ; after last number in series.
   8231 
   8232 ; -----------------------
   8233 ; Handle unary minus (18)
   8234 ; -----------------------
   8235 ; Unary so on entry HL points to last value, DE to STKEND.
   8236 
   8237 ;; NEGATE
   8238 ;; negate
   8239 L1AA0:  LD A,  (HL)             ; fetch exponent of last value on the
   8240                                 ; calculator stack.
   8241         AND     A               ; test it.
   8242         RET     Z               ; return if zero.
   8243 
   8244         INC     HL              ; address the byte with the sign bit.
   8245         LD      A,(HL)          ; fetch to accumulator.
   8246         XOR     $80             ; toggle the sign bit.
   8247         LD      (HL),A          ; put it back.
   8248         DEC     HL              ; point to last value again.
   8249         RET                     ; return.
   8250 
   8251 ; -----------------------
   8252 ; Absolute magnitude (27)
   8253 ; -----------------------
   8254 ; This calculator literal finds the absolute value of the last value,
   8255 ; floating point, on calculator stack.
   8256 
   8257 ;; abs
   8258 L1AAA:  INC     HL              ; point to byte with sign bit.
   8259         RES     7,(HL)          ; make the sign positive.
   8260         DEC     HL              ; point to last value again.
   8261         RET                     ; return.
   8262 
   8263 ; -----------
   8264 ; Signum (26)
   8265 ; -----------
   8266 ; This routine replaces the last value on the calculator stack,
   8267 ; which is in floating point form, with one if positive and with -minus one
   8268 ; if negative. If it is zero then it is left as such.
   8269 
   8270 ;; sgn
   8271 L1AAF:  INC     HL              ; point to first byte of 4-byte mantissa.
   8272         LD      A,(HL)          ; pick up the byte with the sign bit.
   8273         DEC     HL              ; point to exponent.
   8274         DEC     (HL)            ; test the exponent for
   8275         INC     (HL)            ; the value zero.
   8276 
   8277         SCF                     ; set the carry flag.
   8278         CALL    NZ,L1AE0        ; routine FP-0/1  replaces last value with one
   8279                                 ; if exponent indicates the value is non-zero.
   8280                                 ; in either case mantissa is now four zeros.
   8281 
   8282         INC HL                  ; point to first byte of 4-byte mantissa.
   8283         RLCA                    ; rotate original sign bit to carry.
   8284         RR      (HL)            ; rotate the carry into sign.
   8285         DEC HL                  ; point to last value.
   8286         RET                     ; return.
   8287 
   8288 
   8289 ; -------------------------
   8290 ; Handle PEEK function (28)
   8291 ; -------------------------
   8292 ; This function returns the contents of a memory address.
   8293 ; The entire address space can be peeked including the ROM.
   8294 
   8295 ;; peek
   8296 L1ABE:  CALL    L0EA7           ; routine FIND-INT puts address in BC.
   8297         LD      A,(BC)          ; load contents into A register.
   8298 
   8299 ;; IN-PK-STK
   8300 L1AC2:  JP      L151D           ; exit via STACK-A to put value on the
   8301                                 ; calculator stack.
   8302 
   8303 ; ---------------
   8304 ; USR number (29)
   8305 ; ---------------
   8306 ; The USR function followed by a number 0-65535 is the method by which
   8307 ; the ZX81 invokes machine code programs. This function returns the
   8308 ; contents of the BC register pair.
   8309 ; Note. that STACK-BC re-initializes the IY register to $4000 if a user-written
   8310 ; program has altered it.
   8311 
   8312 ;; usr-no
   8313 L1AC5:  CALL    L0EA7           ; routine FIND-INT to fetch the
   8314                                 ; supplied address into BC.
   8315 
   8316         LD      HL,L1520        ; address: STACK-BC is
   8317         PUSH    HL              ; pushed onto the machine stack.
   8318         PUSH    BC              ; then the address of the machine code
   8319                                 ; routine.
   8320 
   8321         RET                     ; make an indirect jump to the routine
   8322                                 ; and, hopefully, to STACK-BC also.
   8323 
   8324 
   8325 ; -----------------------
   8326 ; Greater than zero ($33)
   8327 ; -----------------------
   8328 ; Test if the last value on the calculator stack is greater than zero.
   8329 ; This routine is also called directly from the end-tests of the comparison
   8330 ; routine.
   8331 
   8332 ;; GREATER-0
   8333 ;; greater-0
   8334 L1ACE:  LD      A,(HL)          ; fetch exponent.
   8335         AND     A               ; test it for zero.
   8336         RET     Z               ; return if so.
   8337 
   8338 
   8339         LD      A,$FF           ; prepare XOR mask for sign bit
   8340         JR      L1ADC           ; forward to SIGN-TO-C
   8341                                 ; to put sign in carry
   8342                                 ; (carry will become set if sign is positive)
   8343                                 ; and then overwrite location with 1 or 0
   8344                                 ; as appropriate.
   8345 
   8346 ; ------------------------
   8347 ; Handle NOT operator ($2C)
   8348 ; ------------------------
   8349 ; This overwrites the last value with 1 if it was zero else with zero
   8350 ; if it was any other value.
   8351 ;
   8352 ; e.g. NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0.
   8353 ;
   8354 ; The subroutine is also called directly from the end-tests of the comparison
   8355 ; operator.
   8356 
   8357 ;; NOT
   8358 ;; not
   8359 L1AD5:  LD      A,(HL)          ; get exponent byte.
   8360         NEG                     ; negate - sets carry if non-zero.
   8361         CCF                     ; complement so carry set if zero, else reset.
   8362         JR      L1AE0           ; forward to FP-0/1.
   8363 
   8364 ; -------------------
   8365 ; Less than zero (32)
   8366 ; -------------------
   8367 ; Destructively test if last value on calculator stack is less than zero.
   8368 ; Bit 7 of second byte will be set if so.
   8369 
   8370 ;; less-0
   8371 L1ADB:  XOR     A               ; set xor mask to zero
   8372                                 ; (carry will become set if sign is negative).
   8373 
   8374 ; transfer sign of mantissa to Carry Flag.
   8375 
   8376 ;; SIGN-TO-C
   8377 L1ADC:  INC     HL              ; address 2nd byte.
   8378         XOR     (HL)            ; bit 7 of HL will be set if number is negative.
   8379         DEC     HL              ; address 1st byte again.
   8380         RLCA                    ; rotate bit 7 of A to carry.
   8381 
   8382 ; -----------
   8383 ; Zero or one
   8384 ; -----------
   8385 ; This routine places an integer value zero or one at the addressed location
   8386 ; of calculator stack or MEM area. The value one is written if carry is set on
   8387 ; entry else zero.
   8388 
   8389 ;; FP-0/1
   8390 L1AE0:  PUSH    HL              ; save pointer to the first byte
   8391         LD      B,$05           ; five bytes to do.
   8392 
   8393 ;; FP-loop
   8394 L1AE3:  LD      (HL),$00        ; insert a zero.
   8395         INC     HL              ;
   8396         DJNZ    L1AE3           ; repeat.
   8397 
   8398         POP     HL              ;
   8399         RET     NC              ;
   8400 
   8401         LD      (HL),$81        ; make value 1
   8402         RET                     ; return.
   8403 
   8404 
   8405 ; -----------------------
   8406 ; Handle OR operator (07)
   8407 ; -----------------------
   8408 ; The Boolean OR operator. eg. X OR Y
   8409 ; The result is zero if both values are zero else a non-zero value.
   8410 ;
   8411 ; e.g.    0 OR 0  returns 0.
   8412 ;        -3 OR 0  returns -3.
   8413 ;         0 OR -3 returns 1.
   8414 ;        -3 OR 2  returns 1.
   8415 ;
   8416 ; A binary operation.
   8417 ; On entry HL points to first operand (X) and DE to second operand (Y).
   8418 
   8419 ;; or
   8420 L1AED:  LD      A,(DE)          ; fetch exponent of second number
   8421         AND     A               ; test it.
   8422         RET     Z               ; return if zero.
   8423 
   8424         SCF                     ; set carry flag
   8425         JR      L1AE0           ; back to FP-0/1 to overwrite the first operand
   8426                                 ; with the value 1.
   8427 
   8428 
   8429 ; -----------------------------
   8430 ; Handle number AND number (08)
   8431 ; -----------------------------
   8432 ; The Boolean AND operator.
   8433 ;
   8434 ; e.g.    -3 AND 2  returns -3.
   8435 ;         -3 AND 0  returns 0.
   8436 ;          0 and -2 returns 0.
   8437 ;          0 and 0  returns 0.
   8438 ;
   8439 ; Compare with OR routine above.
   8440 
   8441 ;; no-&-no
   8442 L1AF3:  LD      A,(DE)          ; fetch exponent of second number.
   8443         AND     A               ; test it.
   8444         RET     NZ              ; return if not zero.
   8445 
   8446         JR      L1AE0           ; back to FP-0/1 to overwrite the first operand
   8447                                 ; with zero for return value.
   8448 
   8449 ; -----------------------------
   8450 ; Handle string AND number (10)
   8451 ; -----------------------------
   8452 ; e.g. "YOU WIN" AND SCORE>99 will return the string if condition is true
   8453 ; or the null string if false.
   8454 
   8455 ;; str-&-no
   8456 L1AF8:  LD      A,(DE)          ; fetch exponent of second number.
   8457         AND     A               ; test it.
   8458         RET     NZ              ; return if number was not zero - the string
   8459                                 ; is the result.
   8460 
   8461 ; if the number was zero (false) then the null string must be returned by
   8462 ; altering the length of the string on the calculator stack to zero.
   8463 
   8464         PUSH    DE              ; save pointer to the now obsolete number
   8465                                 ; (which will become the new STKEND)
   8466 
   8467         DEC     DE              ; point to the 5th byte of string descriptor.
   8468         XOR     A               ; clear the accumulator.
   8469         LD      (DE),A          ; place zero in high byte of length.
   8470         DEC     DE              ; address low byte of length.
   8471         LD      (DE),A          ; place zero there - now the null string.
   8472 
   8473         POP     DE              ; restore pointer - new STKEND.
   8474         RET                     ; return.
   8475 
   8476 ; -----------------------------------
   8477 ; Perform comparison ($09-$0E, $11-$16)
   8478 ; -----------------------------------
   8479 ; True binary operations.
   8480 ;
   8481 ; A single entry point is used to evaluate six numeric and six string
   8482 ; comparisons. On entry, the calculator literal is in the B register and
   8483 ; the two numeric values, or the two string parameters, are on the
   8484 ; calculator stack.
   8485 ; The individual bits of the literal are manipulated to group similar
   8486 ; operations although the SUB 8 instruction does nothing useful and merely
   8487 ; alters the string test bit.
   8488 ; Numbers are compared by subtracting one from the other, strings are
   8489 ; compared by comparing every character until a mismatch, or the end of one
   8490 ; or both, is reached.
   8491 ;
   8492 ; Numeric Comparisons.
   8493 ; --------------------
   8494 ; The 'x>y' example is the easiest as it employs straight-thru logic.
   8495 ; Number y is subtracted from x and the result tested for greater-0 yielding
   8496 ; a final value 1 (true) or 0 (false).
   8497 ; For 'x<y' the same logic is used but the two values are first swapped on the
   8498 ; calculator stack.
   8499 ; For 'x=y' NOT is applied to the subtraction result yielding true if the
   8500 ; difference was zero and false with anything else.
   8501 ; The first three numeric comparisons are just the opposite of the last three
   8502 ; so the same processing steps are used and then a final NOT is applied.
   8503 ;
   8504 ; literal    Test   No  sub 8       ExOrNot  1st RRCA  exch sub  ?   End-Tests
   8505 ; =========  ====   == ======== === ======== ========  ==== ===  =  === === ===
   8506 ; no-l-eql   x<=y   09 00000001 dec 00000000 00000000  ---- x-y  ?  --- >0? NOT
   8507 ; no-gr-eql  x>=y   0A 00000010 dec 00000001 10000000c swap y-x  ?  --- >0? NOT
   8508 ; nos-neql   x<>y   0B 00000011 dec 00000010 00000001  ---- x-y  ?  NOT --- NOT
   8509 ; no-grtr    x>y    0C 00000100  -  00000100 00000010  ---- x-y  ?  --- >0? ---
   8510 ; no-less    x<y    0D 00000101  -  00000101 10000010c swap y-x  ?  --- >0? ---
   8511 ; nos-eql    x=y    0E 00000110  -  00000110 00000011  ---- x-y  ?  NOT --- ---
   8512 ;
   8513 ;                                                           comp -> C/F
   8514 ;                                                           ====    ===
   8515 ; str-l-eql  x$<=y$ 11 00001001 dec 00001000 00000100  ---- x$y$ 0  !or >0? NOT
   8516 ; str-gr-eql x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0  !or >0? NOT
   8517 ; strs-neql  x$<>y$ 13 00001011 dec 00001010 00000101  ---- x$y$ 0  !or >0? NOT
   8518 ; str-grtr   x$>y$  14 00001100  -  00001100 00000110  ---- x$y$ 0  !or >0? ---
   8519 ; str-less   x$<y$  15 00001101  -  00001101 10000110c swap y$x$ 0  !or >0? ---
   8520 ; strs-eql   x$=y$  16 00001110  -  00001110 00000111  ---- x$y$ 0  !or >0? ---
   8521 ;
   8522 ; String comparisons are a little different in that the eql/neql carry flag
   8523 ; from the 2nd RRCA is, as before, fed into the first of the end tests but
   8524 ; along the way it gets modified by the comparison process. The result on the
   8525 ; stack always starts off as zero and the carry fed in determines if NOT is
   8526 ; applied to it. So the only time the greater-0 test is applied is if the
   8527 ; stack holds zero which is not very efficient as the test will always yield
   8528 ; zero. The most likely explanation is that there were once separate end tests
   8529 ; for numbers and strings.
   8530 
   8531 ;; no-l-eql,etc.
   8532 L1B03:  LD      A,B             ; transfer literal to accumulator.
   8533         SUB     $08             ; subtract eight - which is not useful.
   8534 
   8535         BIT     2,A             ; isolate '>', '<', '='.
   8536 
   8537         JR      NZ,L1B0B        ; skip to EX-OR-NOT with these.
   8538 
   8539         DEC     A               ; else make $00-$02, $08-$0A to match bits 0-2.
   8540 
   8541 ;; EX-OR-NOT
   8542 L1B0B:  RRCA                    ; the first RRCA sets carry for a swap.
   8543         JR      NC,L1B16        ; forward to NU-OR-STR with other 8 cases
   8544 
   8545 ; for the other 4 cases the two values on the calculator stack are exchanged.
   8546 
   8547         PUSH    AF              ; save A and carry.
   8548         PUSH    HL              ; save HL - pointer to first operand.
   8549                                 ; (DE points to second operand).
   8550 
   8551         CALL    L1A72           ; routine exchange swaps the two values.
   8552                                 ; (HL = second operand, DE = STKEND)
   8553 
   8554         POP     DE              ; DE = first operand
   8555         EX      DE,HL           ; as we were.
   8556         POP     AF              ; restore A and carry.
   8557 
   8558 ; Note. it would be better if the 2nd RRCA preceded the string test.
   8559 ; It would save two duplicate bytes and if we also got rid of that sub 8
   8560 ; at the beginning we wouldn't have to alter which bit we test.
   8561 
   8562 ;; NU-OR-STR
   8563 L1B16:  BIT     2,A             ; test if a string comparison.
   8564         JR      NZ,L1B21        ; forward to STRINGS if so.
   8565 
   8566 ; continue with numeric comparisons.
   8567 
   8568         RRCA                    ; 2nd RRCA causes eql/neql to set carry.
   8569         PUSH    AF              ; save A and carry
   8570 
   8571         CALL    L174C           ; routine subtract leaves result on stack.
   8572         JR      L1B54           ; forward to END-TESTS
   8573 
   8574 ; ---
   8575 
   8576 ;; STRINGS
   8577 L1B21:  RRCA                    ; 2nd RRCA causes eql/neql to set carry.
   8578         PUSH    AF              ; save A and carry.
   8579 
   8580         CALL    L13F8           ; routine STK-FETCH gets 2nd string params
   8581         PUSH    DE              ; save start2 *.
   8582         PUSH    BC              ; and the length.
   8583 
   8584         CALL    L13F8           ; routine STK-FETCH gets 1st string
   8585                                 ; parameters - start in DE, length in BC.
   8586         POP     HL              ; restore length of second to HL.
   8587 
   8588 ; A loop is now entered to compare, by subtraction, each corresponding character
   8589 ; of the strings. For each successful match, the pointers are incremented and
   8590 ; the lengths decreased and the branch taken back to here. If both string
   8591 ; remainders become null at the same time, then an exact match exists.
   8592 
   8593 ;; BYTE-COMP
   8594 L1B2C:  LD      A,H             ; test if the second string
   8595         OR      L               ; is the null string and hold flags.
   8596 
   8597         EX      (SP),HL         ; put length2 on stack, bring start2 to HL *.
   8598         LD      A,B             ; hi byte of length1 to A
   8599 
   8600         JR      NZ,L1B3D        ; forward to SEC-PLUS if second not null.
   8601 
   8602         OR      C               ; test length of first string.
   8603 
   8604 ;; SECND-LOW
   8605 L1B33:  POP     BC              ; pop the second length off stack.
   8606         JR      Z,L1B3A         ; forward to BOTH-NULL if first string is also
   8607                                 ; of zero length.
   8608 
   8609 ; the true condition - first is longer than second (SECND-LESS)
   8610 
   8611         POP     AF              ; restore carry (set if eql/neql)
   8612         CCF                     ; complement carry flag.
   8613                                 ; Note. equality becomes false.
   8614                                 ; Inequality is true. By swapping or applying
   8615                                 ; a terminal 'not', all comparisons have been
   8616                                 ; manipulated so that this is success path.
   8617         JR      L1B50           ; forward to leave via STR-TEST
   8618 
   8619 ; ---
   8620 ; the branch was here with a match
   8621 
   8622 ;; BOTH-NULL
   8623 L1B3A:  POP     AF              ; restore carry - set for eql/neql
   8624         JR      L1B50           ; forward to STR-TEST
   8625 
   8626 ; ---
   8627 ; the branch was here when 2nd string not null and low byte of first is yet
   8628 ; to be tested.
   8629 
   8630 
   8631 ;; SEC-PLUS
   8632 L1B3D:  OR      C               ; test the length of first string.
   8633         JR      Z,L1B4D         ; forward to FRST-LESS if length is zero.
   8634 
   8635 ; both strings have at least one character left.
   8636 
   8637         LD      A,(DE)          ; fetch character of first string.
   8638         SUB     (HL)            ; subtract with that of 2nd string.
   8639         JR      C,L1B4D         ; forward to FRST-LESS if carry set
   8640 
   8641         JR      NZ,L1B33        ; back to SECND-LOW and then STR-TEST
   8642                                 ; if not exact match.
   8643 
   8644         DEC     BC              ; decrease length of 1st string.
   8645         INC     DE              ; increment 1st string pointer.
   8646 
   8647         INC     HL              ; increment 2nd string pointer.
   8648         EX      (SP),HL         ; swap with length on stack
   8649         DEC     HL              ; decrement 2nd string length
   8650         JR      L1B2C           ; back to BYTE-COMP
   8651 
   8652 ; ---
   8653 ;   the false condition.
   8654 
   8655 ;; FRST-LESS
   8656 L1B4D:  POP     BC              ; discard length
   8657         POP     AF              ; pop A
   8658         AND     A               ; clear the carry for false result.
   8659 
   8660 ; ---
   8661 ;   exact match and x$>y$ rejoin here
   8662 
   8663 ;; STR-TEST
   8664 L1B50:  PUSH    AF              ; save A and carry
   8665 
   8666         RST     28H             ;; FP-CALC
   8667         DEFB    $A0             ;;stk-zero      an initial false value.
   8668         DEFB    $34             ;;end-calc
   8669 
   8670 ;   both numeric and string paths converge here.
   8671 
   8672 ;; END-TESTS
   8673 L1B54:  POP     AF              ; pop carry  - will be set if eql/neql
   8674         PUSH    AF              ; save it again.
   8675 
   8676         CALL    C,L1AD5         ; routine NOT sets true(1) if equal(0)
   8677                                 ; or, for strings, applies true result.
   8678         CALL    L1ACE           ; greater-0  ??????????
   8679 
   8680 
   8681         POP     AF              ; pop A
   8682         RRCA                    ; the third RRCA - test for '<=', '>=' or '<>'.
   8683         CALL    NC,L1AD5        ; apply a terminal NOT if so.
   8684         RET                     ; return.
   8685 
   8686 ; -------------------------
   8687 ; String concatenation ($17)
   8688 ; -------------------------
   8689 ;   This literal combines two strings into one e.g. LET A$ = B$ + C$
   8690 ;   The two parameters of the two strings to be combined are on the stack.
   8691 
   8692 ;; strs-add
   8693 L1B62:  CALL    L13F8           ; routine STK-FETCH fetches string parameters
   8694                                 ; and deletes calculator stack entry.
   8695         PUSH    DE              ; save start address.
   8696         PUSH    BC              ; and length.
   8697 
   8698         CALL    L13F8           ; routine STK-FETCH for first string
   8699         POP     HL              ; re-fetch first length
   8700         PUSH    HL              ; and save again
   8701         PUSH    DE              ; save start of second string
   8702         PUSH    BC              ; and its length.
   8703 
   8704         ADD     HL,BC           ; add the two lengths.
   8705         LD      B,H             ; transfer to BC
   8706         LD      C,L             ; and create
   8707         RST     30H             ; BC-SPACES in workspace.
   8708                                 ; DE points to start of space.
   8709 
   8710         CALL    L12C3           ; routine STK-STO-$ stores parameters
   8711                                 ; of new string updating STKEND.
   8712 
   8713         POP     BC              ; length of first
   8714         POP     HL              ; address of start
   8715         LD      A,B             ; test for
   8716         OR      C               ; zero length.
   8717         JR      Z,L1B7D         ; to OTHER-STR if null string
   8718 
   8719         LDIR                    ; copy string to workspace.
   8720 
   8721 ;; OTHER-STR
   8722 L1B7D:  POP     BC              ; now second length
   8723         POP     HL              ; and start of string
   8724         LD      A,B             ; test this one
   8725         OR      C               ; for zero length
   8726         JR      Z,L1B85         ; skip forward to STK-PNTRS if so as complete.
   8727 
   8728         LDIR                    ; else copy the bytes.
   8729                                 ; and continue into next routine which
   8730                                 ; sets the calculator stack pointers.
   8731 
   8732 ; --------------------
   8733 ; Check stack pointers
   8734 ; --------------------
   8735 ;   Register DE is set to STKEND and HL, the result pointer, is set to five
   8736 ;   locations below this.
   8737 ;   This routine is used when it is inconvenient to save these values at the
   8738 ;   time the calculator stack is manipulated due to other activity on the
   8739 ;   machine stack.
   8740 ;   This routine is also used to terminate the VAL routine for
   8741 ;   the same reason and to initialize the calculator stack at the start of
   8742 ;   the CALCULATE routine.
   8743 
   8744 ;; STK-PNTRS
   8745 L1B85:  LD      HL,($401C)      ; fetch STKEND value from system variable.
   8746         LD      DE,$FFFB        ; the value -5
   8747         PUSH    HL              ; push STKEND value.
   8748 
   8749         ADD     HL,DE           ; subtract 5 from HL.
   8750 
   8751         POP     DE              ; pop STKEND to DE.
   8752         RET                     ; return.
   8753 
   8754 ; ----------------
   8755 ; Handle CHR$ (2B)
   8756 ; ----------------
   8757 ;   This function returns a single character string that is a result of
   8758 ;   converting a number in the range 0-255 to a string e.g. CHR$ 38 = "A".
   8759 ;   Note. the ZX81 does not have an ASCII character set.
   8760 
   8761 ;; chrs
   8762 L1B8F:  CALL    L15CD           ; routine FP-TO-A puts the number in A.
   8763 
   8764         JR      C,L1BA2         ; forward to REPORT-Bd if overflow
   8765         JR      NZ,L1BA2        ; forward to REPORT-Bd if negative
   8766 
   8767         PUSH    AF              ; save the argument.
   8768 
   8769         LD      BC,$0001        ; one space required.
   8770         RST     30H             ; BC-SPACES makes DE point to start
   8771 
   8772         POP     AF              ; restore the number.
   8773 
   8774         LD      (DE),A          ; and store in workspace
   8775 
   8776         CALL    L12C3           ; routine STK-STO-$ stacks descriptor.
   8777 
   8778         EX      DE,HL           ; make HL point to result and DE to STKEND.
   8779         RET                     ; return.
   8780 
   8781 ; ---
   8782 
   8783 ;; REPORT-Bd
   8784 L1BA2:  RST     08H             ; ERROR-1
   8785         DEFB    $0A             ; Error Report: Integer out of range
   8786 
   8787 ; ----------------------------
   8788 ; Handle VAL ($1A)
   8789 ; ----------------------------
   8790 ;   VAL treats the characters in a string as a numeric expression.
   8791 ;       e.g. VAL "2.3" = 2.3, VAL "2+4" = 6, VAL ("2" + "4") = 24.
   8792 
   8793 ;; val
   8794 L1BA4:  LD      HL,($4016)      ; fetch value of system variable CH_ADD
   8795         PUSH    HL              ; and save on the machine stack.
   8796 
   8797         CALL    L13F8           ; routine STK-FETCH fetches the string operand
   8798                                 ; from calculator stack.
   8799 
   8800         PUSH    DE              ; save the address of the start of the string.
   8801         INC     BC              ; increment the length for a carriage return.
   8802 
   8803         RST     30H             ; BC-SPACES creates the space in workspace.
   8804         POP     HL              ; restore start of string to HL.
   8805         LD      ($4016),DE      ; load CH_ADD with start DE in workspace.
   8806 
   8807         PUSH    DE              ; save the start in workspace
   8808         LDIR                    ; copy string from program or variables or
   8809                                 ; workspace to the workspace area.
   8810         EX      DE,HL           ; end of string + 1 to HL
   8811         DEC     HL              ; decrement HL to point to end of new area.
   8812         LD      (HL),$76        ; insert a carriage return at end.
   8813                                 ; ZX81 has a non-ASCII character set
   8814         RES     7,(IY+$01)      ; update FLAGS  - signal checking syntax.
   8815         CALL    L0D92           ; routine CLASS-06 - SCANNING evaluates string
   8816                                 ; expression and checks for integer result.
   8817 
   8818         CALL    L0D22           ; routine CHECK-2 checks for carriage return.
   8819 
   8820 
   8821         POP     HL              ; restore start of string in workspace.
   8822 
   8823         LD      ($4016),HL      ; set CH_ADD to the start of the string again.
   8824         SET     7,(IY+$01)      ; update FLAGS  - signal running program.
   8825         CALL    L0F55           ; routine SCANNING evaluates the string
   8826                                 ; in full leaving result on calculator stack.
   8827 
   8828         POP     HL              ; restore saved character address in program.
   8829         LD      ($4016),HL      ; and reset the system variable CH_ADD.
   8830 
   8831         JR      L1B85           ; back to exit via STK-PNTRS.
   8832                                 ; resetting the calculator stack pointers
   8833                                 ; HL and DE from STKEND as it wasn't possible
   8834                                 ; to preserve them during this routine.
   8835 
   8836 ; ----------------
   8837 ; Handle STR$ (2A)
   8838 ; ----------------
   8839 ;   This function returns a string representation of a numeric argument.
   8840 ;   The method used is to trick the PRINT-FP routine into thinking it
   8841 ;   is writing to a collapsed display file when in fact it is writing to
   8842 ;   string workspace.
   8843 ;   If there is already a newline at the intended print position and the
   8844 ;   column count has not been reduced to zero then the print routine
   8845 ;   assumes that there is only 1K of RAM and the screen memory, like the rest
   8846 ;   of dynamic memory, expands as necessary using calls to the ONE-SPACE
   8847 ;   routine. The screen is character-mapped not bit-mapped.
   8848 
   8849 ;; str$
   8850 L1BD5:  LD      BC,$0001        ; create an initial byte in workspace
   8851         RST     30H             ; using BC-SPACES restart.
   8852 
   8853         LD      (HL),$76        ; place a carriage return there.
   8854 
   8855         LD      HL,($4039)      ; fetch value of S_POSN column/line
   8856         PUSH    HL              ; and preserve on stack.
   8857 
   8858         LD      L,$FF           ; make column value high to create a
   8859                                 ; contrived buffer of length 254.
   8860         LD      ($4039),HL      ; and store in system variable S_POSN.
   8861 
   8862         LD      HL,($400E)      ; fetch value of DF_CC
   8863         PUSH    HL              ; and preserve on stack also.
   8864 
   8865         LD      ($400E),DE      ; now set DF_CC which normally addresses
   8866                                 ; somewhere in the display file to the start
   8867                                 ; of workspace.
   8868         PUSH    DE              ; save the start of new string.
   8869 
   8870         CALL    L15DB           ; routine PRINT-FP.
   8871 
   8872         POP     DE              ; retrieve start of string.
   8873 
   8874         LD      HL,($400E)      ; fetch end of string from DF_CC.
   8875         AND     A               ; prepare for true subtraction.
   8876         SBC     HL,DE           ; subtract to give length.
   8877 
   8878         LD      B,H             ; and transfer to the BC
   8879         LD      C,L             ; register.
   8880 
   8881         POP     HL              ; restore original
   8882         LD      ($400E),HL      ; DF_CC value
   8883 
   8884         POP     HL              ; restore original
   8885         LD      ($4039),HL      ; S_POSN values.
   8886 
   8887         CALL    L12C3           ; routine STK-STO-$ stores the string
   8888                                 ; descriptor on the calculator stack.
   8889 
   8890         EX      DE,HL           ; HL = last value, DE = STKEND.
   8891         RET                     ; return.
   8892 
   8893 
   8894 ; -------------------
   8895 ; THE 'CODE' FUNCTION
   8896 ; -------------------
   8897 ; (offset $19: 'code')
   8898 ;   Returns the code of a character or first character of a string
   8899 ;   e.g. CODE "AARDVARK" = 38  (not 65 as the ZX81 does not have an ASCII
   8900 ;   character set).
   8901 
   8902 
   8903 ;; code
   8904 L1C06:  CALL    L13F8           ; routine STK-FETCH to fetch and delete the
   8905                                 ; string parameters.
   8906                                 ; DE points to the start, BC holds the length.
   8907         LD      A,B             ; test length
   8908         OR      C               ; of the string.
   8909         JR      Z,L1C0E         ; skip to STK-CODE with zero if the null string.
   8910 
   8911         LD      A,(DE)          ; else fetch the first character.
   8912 
   8913 ;; STK-CODE
   8914 L1C0E:  JP      L151D           ; jump back to STACK-A (with memory check)
   8915 
   8916 ; --------------------
   8917 ; THE 'LEN' SUBROUTINE
   8918 ; --------------------
   8919 ; (offset $1b: 'len')
   8920 ;   Returns the length of a string.
   8921 ;   In Sinclair BASIC strings can be more than twenty thousand characters long
   8922 ;   so a sixteen-bit register is required to store the length
   8923 
   8924 ;; len
   8925 L1C11:  CALL    L13F8           ; routine STK-FETCH to fetch and delete the
   8926                                 ; string parameters from the calculator stack.
   8927                                 ; register BC now holds the length of string.
   8928 
   8929         JP      L1520           ; jump back to STACK-BC to save result on the
   8930                                 ; calculator stack (with memory check).
   8931 
   8932 ; -------------------------------------
   8933 ; THE 'DECREASE THE COUNTER' SUBROUTINE
   8934 ; -------------------------------------
   8935 ; (offset $31: 'dec-jr-nz')
   8936 ;   The calculator has an instruction that decrements a single-byte
   8937 ;   pseudo-register and makes consequential relative jumps just like
   8938 ;   the Z80's DJNZ instruction.
   8939 
   8940 ;; dec-jr-nz
   8941 L1C17:  EXX                     ; switch in set that addresses code
   8942 
   8943         PUSH    HL              ; save pointer to offset byte
   8944         LD      HL,$401E        ; address BREG in system variables
   8945         DEC     (HL)            ; decrement it
   8946         POP     HL              ; restore pointer
   8947 
   8948         JR      NZ,L1C24        ; to JUMP-2 if not zero
   8949 
   8950         INC     HL              ; step past the jump length.
   8951         EXX                     ; switch in the main set.
   8952         RET                     ; return.
   8953 
   8954 ;   Note. as a general rule the calculator avoids using the IY register
   8955 ;   otherwise the cumbersome 4 instructions in the middle could be replaced by
   8956 ;   dec (iy+$xx) - using three instruction bytes instead of six.
   8957 
   8958 
   8959 ; ---------------------
   8960 ; THE 'JUMP' SUBROUTINE
   8961 ; ---------------------
   8962 ; (Offset $2F; 'jump')
   8963 ;   This enables the calculator to perform relative jumps just like
   8964 ;   the Z80 chip's JR instruction.
   8965 ;   This is one of the few routines to be polished for the ZX Spectrum.
   8966 ;   See, without looking at the ZX Spectrum ROM, if you can get rid of the
   8967 ;   relative jump.
   8968 
   8969 ;; jump
   8970 ;; JUMP
   8971 L1C23:  EXX                     ;switch in pointer set
   8972 
   8973 ;; JUMP-2
   8974 L1C24:  LD      E,(HL)          ; the jump byte 0-127 forward, 128-255 back.
   8975         XOR     A               ; clear accumulator.
   8976         BIT     7,E             ; test if negative jump
   8977         JR      Z,L1C2B         ; skip, if positive, to JUMP-3.
   8978 
   8979         CPL                     ; else change to $FF.
   8980 
   8981 ;; JUMP-3
   8982 L1C2B:  LD      D,A             ; transfer to high byte.
   8983         ADD     HL,DE           ; advance calculator pointer forward or back.
   8984 
   8985         EXX                     ; switch out pointer set.
   8986         RET                     ; return.
   8987 
   8988 ; -----------------------------
   8989 ; THE 'JUMP ON TRUE' SUBROUTINE
   8990 ; -----------------------------
   8991 ; (Offset $00; 'jump-true')
   8992 ;   This enables the calculator to perform conditional relative jumps
   8993 ;   dependent on whether the last test gave a true result
   8994 ;   On the ZX81, the exponent will be zero for zero or else $81 for one.
   8995 
   8996 ;; jump-true
   8997 L1C2F:  LD      A,(DE)          ; collect exponent byte
   8998 
   8999         AND     A               ; is result 0 or 1 ?
   9000         JR      NZ,L1C23        ; back to JUMP if true (1).
   9001 
   9002         EXX                     ; else switch in the pointer set.
   9003         INC     HL              ; step past the jump length.
   9004         EXX                     ; switch in the main set.
   9005         RET                     ; return.
   9006 
   9007 
   9008 ; ------------------------
   9009 ; THE 'MODULUS' SUBROUTINE
   9010 ; ------------------------
   9011 ; ( Offset $2E: 'n-mod-m' )
   9012 ; ( i1, i2 -- i3, i4 )
   9013 ;   The subroutine calculate N mod M where M is the positive integer, the
   9014 ;   'last value' on the calculator stack and N is the integer beneath.
   9015 ;   The subroutine returns the integer quotient as the last value and the
   9016 ;   remainder as the value beneath.
   9017 ;   e.g.    17 MOD 3 = 5 remainder 2
   9018 ;   It is invoked during the calculation of a random number and also by
   9019 ;   the PRINT-FP routine.
   9020 
   9021 ;; n-mod-m
   9022 L1C37:  RST     28H             ;; FP-CALC          17, 3.
   9023         DEFB    $C0             ;;st-mem-0          17, 3.
   9024         DEFB    $02             ;;delete            17.
   9025         DEFB    $2D             ;;duplicate         17, 17.
   9026         DEFB    $E0             ;;get-mem-0         17, 17, 3.
   9027         DEFB    $05             ;;division          17, 17/3.
   9028         DEFB    $24             ;;int               17, 5.
   9029         DEFB    $E0             ;;get-mem-0         17, 5, 3.
   9030         DEFB    $01             ;;exchange          17, 3, 5.
   9031         DEFB    $C0             ;;st-mem-0          17, 3, 5.
   9032         DEFB    $04             ;;multiply          17, 15.
   9033         DEFB    $03             ;;subtract          2.
   9034         DEFB    $E0             ;;get-mem-0         2, 5.
   9035         DEFB    $34             ;;end-calc          2, 5.
   9036 
   9037         RET                     ; return.
   9038 
   9039 
   9040 ; ----------------------
   9041 ; THE 'INTEGER' FUNCTION
   9042 ; ----------------------
   9043 ; (offset $24: 'int')
   9044 ;   This function returns the integer of x, which is just the same as truncate
   9045 ;   for positive numbers. The truncate literal truncates negative numbers
   9046 ;   upwards so that -3.4 gives -3 whereas the BASIC INT function has to
   9047 ;   truncate negative numbers down so that INT -3.4 is 4.
   9048 ;   It is best to work through using, say, plus or minus 3.4 as examples.
   9049 
   9050 ;; int
   9051 L1C46:  RST     28H             ;; FP-CALC              x.    (= 3.4 or -3.4).
   9052         DEFB    $2D             ;;duplicate             x, x.
   9053         DEFB    $32             ;;less-0                x, (1/0)
   9054         DEFB    $00             ;;jump-true             x, (1/0)
   9055         DEFB    $04             ;;to L1C46, X-NEG
   9056 
   9057         DEFB    $36             ;;truncate              trunc 3.4 = 3.
   9058         DEFB    $34             ;;end-calc              3.
   9059 
   9060         RET                     ; return with + int x on stack.
   9061 
   9062 
   9063 ;; X-NEG
   9064 L1C4E:  DEFB    $2D             ;;duplicate             -3.4, -3.4.
   9065         DEFB    $36             ;;truncate              -3.4, -3.
   9066         DEFB    $C0             ;;st-mem-0              -3.4, -3.
   9067         DEFB    $03             ;;subtract              -.4
   9068         DEFB    $E0             ;;get-mem-0             -.4, -3.
   9069         DEFB    $01             ;;exchange              -3, -.4.
   9070         DEFB    $2C             ;;not                   -3, (0).
   9071         DEFB    $00             ;;jump-true             -3.
   9072         DEFB    $03             ;;to L1C59, EXIT        -3.
   9073 
   9074         DEFB    $A1             ;;stk-one               -3, 1.
   9075         DEFB    $03             ;;subtract              -4.
   9076 
   9077 ;; EXIT
   9078 L1C59:  DEFB    $34             ;;end-calc              -4.
   9079 
   9080         RET                     ; return.
   9081 
   9082 
   9083 ; ----------------
   9084 ; Exponential (23)
   9085 ; ----------------
   9086 ;
   9087 ;
   9088 
   9089 ;; EXP
   9090 ;; exp
   9091 L1C5B:  RST     28H             ;; FP-CALC
   9092         DEFB    $30             ;;stk-data
   9093         DEFB    $F1             ;;Exponent: $81, Bytes: 4
   9094         DEFB    $38,$AA,$3B,$29 ;;
   9095         DEFB    $04             ;;multiply
   9096         DEFB    $2D             ;;duplicate
   9097         DEFB    $24             ;;int
   9098         DEFB    $C3             ;;st-mem-3
   9099         DEFB    $03             ;;subtract
   9100         DEFB    $2D             ;;duplicate
   9101         DEFB    $0F             ;;addition
   9102         DEFB    $A1             ;;stk-one
   9103         DEFB    $03             ;;subtract
   9104         DEFB    $88             ;;series-08
   9105         DEFB    $13             ;;Exponent: $63, Bytes: 1
   9106         DEFB    $36             ;;(+00,+00,+00)
   9107         DEFB    $58             ;;Exponent: $68, Bytes: 2
   9108         DEFB    $65,$66         ;;(+00,+00)
   9109         DEFB    $9D             ;;Exponent: $6D, Bytes: 3
   9110         DEFB    $78,$65,$40     ;;(+00)
   9111         DEFB    $A2             ;;Exponent: $72, Bytes: 3
   9112         DEFB    $60,$32,$C9     ;;(+00)
   9113         DEFB    $E7             ;;Exponent: $77, Bytes: 4
   9114         DEFB    $21,$F7,$AF,$24 ;;
   9115         DEFB    $EB             ;;Exponent: $7B, Bytes: 4
   9116         DEFB    $2F,$B0,$B0,$14 ;;
   9117         DEFB    $EE             ;;Exponent: $7E, Bytes: 4
   9118         DEFB    $7E,$BB,$94,$58 ;;
   9119         DEFB    $F1             ;;Exponent: $81, Bytes: 4
   9120         DEFB    $3A,$7E,$F8,$CF ;;
   9121         DEFB    $E3             ;;get-mem-3
   9122         DEFB    $34             ;;end-calc
   9123 
   9124         CALL    L15CD           ; routine FP-TO-A
   9125         JR      NZ,L1C9B        ; to N-NEGTV
   9126 
   9127         JR      C,L1C99         ; to REPORT-6b
   9128 
   9129         ADD     A,(HL)          ;
   9130         JR      NC,L1CA2        ; to RESULT-OK
   9131 
   9132 
   9133 ;; REPORT-6b
   9134 L1C99:  RST     08H             ; ERROR-1
   9135         DEFB    $05             ; Error Report: Number too big
   9136 
   9137 ;; N-NEGTV
   9138 L1C9B:  JR      C,L1CA4         ; to RSLT-ZERO
   9139 
   9140         SUB     (HL)            ;
   9141         JR      NC,L1CA4        ; to RSLT-ZERO
   9142 
   9143         NEG                     ; Negate
   9144 
   9145 ;; RESULT-OK
   9146 L1CA2:  LD      (HL),A          ;
   9147         RET                     ; return.
   9148 
   9149 
   9150 ;; RSLT-ZERO
   9151 L1CA4:  RST     28H             ;; FP-CALC
   9152         DEFB    $02             ;;delete
   9153         DEFB    $A0             ;;stk-zero
   9154         DEFB    $34             ;;end-calc
   9155 
   9156         RET                     ; return.
   9157 
   9158 
   9159 ; --------------------------------
   9160 ; THE 'NATURAL LOGARITHM' FUNCTION
   9161 ; --------------------------------
   9162 ; (offset $22: 'ln')
   9163 ;   Like the ZX81 itself, 'natural' logarithms came from Scotland.
   9164 ;   They were devised in 1614 by well-traveled Scotsman John Napier who noted
   9165 ;   "Nothing doth more molest and hinder calculators than the multiplications,
   9166 ;    divisions, square and cubical extractions of great numbers".
   9167 ;
   9168 ;   Napier's logarithms enabled the above operations to be accomplished by 
   9169 ;   simple addition and subtraction simplifying the navigational and 
   9170 ;   astronomical calculations which beset his age.
   9171 ;   Napier's logarithms were quickly overtaken by logarithms to the base 10
   9172 ;   devised, in conjunction with Napier, by Henry Briggs a Cambridge-educated 
   9173 ;   professor of Geometry at Oxford University. These simplified the layout
   9174 ;   of the tables enabling humans to easily scale calculations.
   9175 ;
   9176 ;   It is only recently with the introduction of pocket calculators and
   9177 ;   computers like the ZX81 that natural logarithms are once more at the fore,
   9178 ;   although some computers retain logarithms to the base ten.
   9179 ;   'Natural' logarithms are powers to the base 'e', which like 'pi' is a 
   9180 ;   naturally occurring number in branches of mathematics.
   9181 ;   Like 'pi' also, 'e' is an irrational number and starts 2.718281828...
   9182 ;
   9183 ;   The tabular use of logarithms was that to multiply two numbers one looked
   9184 ;   up their two logarithms in the tables, added them together and then looked 
   9185 ;   for the result in a table of antilogarithms to give the desired product.
   9186 ;
   9187 ;   The EXP function is the BASIC equivalent of a calculator's 'antiln' function 
   9188 ;   and by picking any two numbers, 1.72 and 6.89 say,
   9189 ;     10 PRINT EXP ( LN 1.72 + LN 6.89 ) 
   9190 ;   will give just the same result as
   9191 ;     20 PRINT 1.72 * 6.89.
   9192 ;   Division is accomplished by subtracting the two logs.
   9193 ;
   9194 ;   Napier also mentioned "square and cubicle extractions". 
   9195 ;   To raise a number to the power 3, find its 'ln', multiply by 3 and find the 
   9196 ;   'antiln'.  e.g. PRINT EXP( LN 4 * 3 )  gives 64.
   9197 ;   Similarly to find the n'th root divide the logarithm by 'n'.
   9198 ;   The ZX81 ROM used PRINT EXP ( LN 9 / 2 ) to find the square root of the 
   9199 ;   number 9. The Napieran square root function is just a special case of 
   9200 ;   the 'to_power' function. A cube root or indeed any root/power would be just
   9201 ;   as simple.
   9202 
   9203 ;   First test that the argument to LN is a positive, non-zero number.
   9204 
   9205 ;; ln
   9206 L1CA9:  RST     28H             ;; FP-CALC
   9207         DEFB    $2D             ;;duplicate
   9208         DEFB    $33             ;;greater-0
   9209         DEFB    $00             ;;jump-true
   9210         DEFB    $04             ;;to L1CB1, VALID
   9211 
   9212         DEFB    $34             ;;end-calc
   9213 
   9214 
   9215 ;; REPORT-Ab
   9216 L1CAF:  RST     08H             ; ERROR-1
   9217         DEFB    $09             ; Error Report: Invalid argument
   9218 
   9219 ;; VALID
   9220 L1CB1:  DEFB    $A0             ;;stk-zero              Note. not 
   9221         DEFB    $02             ;;delete                necessary.
   9222         DEFB    $34             ;;end-calc
   9223         LD      A,(HL)          ;
   9224 
   9225         LD      (HL),$80        ;
   9226         CALL    L151D           ; routine STACK-A
   9227 
   9228         RST     28H             ;; FP-CALC
   9229         DEFB    $30             ;;stk-data
   9230         DEFB    $38             ;;Exponent: $88, Bytes: 1
   9231         DEFB    $00             ;;(+00,+00,+00)
   9232         DEFB    $03             ;;subtract
   9233         DEFB    $01             ;;exchange
   9234         DEFB    $2D             ;;duplicate
   9235         DEFB    $30             ;;stk-data
   9236         DEFB    $F0             ;;Exponent: $80, Bytes: 4
   9237         DEFB    $4C,$CC,$CC,$CD ;;
   9238         DEFB    $03             ;;subtract
   9239         DEFB    $33             ;;greater-0
   9240         DEFB    $00             ;;jump-true
   9241         DEFB    $08             ;;to L1CD2, GRE.8
   9242 
   9243         DEFB    $01             ;;exchange
   9244         DEFB    $A1             ;;stk-one
   9245         DEFB    $03             ;;subtract
   9246         DEFB    $01             ;;exchange
   9247         DEFB    $34             ;;end-calc
   9248 
   9249         INC     (HL)            ;
   9250 
   9251         RST     28H             ;; FP-CALC
   9252 
   9253 ;; GRE.8
   9254 L1CD2:  DEFB    $01             ;;exchange
   9255         DEFB    $30             ;;stk-data
   9256         DEFB    $F0             ;;Exponent: $80, Bytes: 4
   9257         DEFB    $31,$72,$17,$F8 ;;
   9258         DEFB    $04             ;;multiply
   9259         DEFB    $01             ;;exchange
   9260         DEFB    $A2             ;;stk-half
   9261         DEFB    $03             ;;subtract
   9262         DEFB    $A2             ;;stk-half
   9263         DEFB    $03             ;;subtract
   9264         DEFB    $2D             ;;duplicate
   9265         DEFB    $30             ;;stk-data
   9266         DEFB    $32             ;;Exponent: $82, Bytes: 1
   9267         DEFB    $20             ;;(+00,+00,+00)
   9268         DEFB    $04             ;;multiply
   9269         DEFB    $A2             ;;stk-half
   9270         DEFB    $03             ;;subtract
   9271         DEFB    $8C             ;;series-0C
   9272         DEFB    $11             ;;Exponent: $61, Bytes: 1
   9273         DEFB    $AC             ;;(+00,+00,+00)
   9274         DEFB    $14             ;;Exponent: $64, Bytes: 1
   9275         DEFB    $09             ;;(+00,+00,+00)
   9276         DEFB    $56             ;;Exponent: $66, Bytes: 2
   9277         DEFB    $DA,$A5         ;;(+00,+00)
   9278         DEFB    $59             ;;Exponent: $69, Bytes: 2
   9279         DEFB    $30,$C5         ;;(+00,+00)
   9280         DEFB    $5C             ;;Exponent: $6C, Bytes: 2
   9281         DEFB    $90,$AA         ;;(+00,+00)
   9282         DEFB    $9E             ;;Exponent: $6E, Bytes: 3
   9283         DEFB    $70,$6F,$61     ;;(+00)
   9284         DEFB    $A1             ;;Exponent: $71, Bytes: 3
   9285         DEFB    $CB,$DA,$96     ;;(+00)
   9286         DEFB    $A4             ;;Exponent: $74, Bytes: 3
   9287         DEFB    $31,$9F,$B4     ;;(+00)
   9288         DEFB    $E7             ;;Exponent: $77, Bytes: 4
   9289         DEFB    $A0,$FE,$5C,$FC ;;
   9290         DEFB    $EA             ;;Exponent: $7A, Bytes: 4
   9291         DEFB    $1B,$43,$CA,$36 ;;
   9292         DEFB    $ED             ;;Exponent: $7D, Bytes: 4
   9293         DEFB    $A7,$9C,$7E,$5E ;;
   9294         DEFB    $F0             ;;Exponent: $80, Bytes: 4
   9295         DEFB    $6E,$23,$80,$93 ;;
   9296         DEFB    $04             ;;multiply
   9297         DEFB    $0F             ;;addition
   9298         DEFB    $34             ;;end-calc
   9299 
   9300         RET                     ; return.
   9301 
   9302 ; -----------------------------
   9303 ; THE 'TRIGONOMETRIC' FUNCTIONS
   9304 ; -----------------------------
   9305 ;   Trigonometry is rocket science. It is also used by carpenters and pyramid
   9306 ;   builders. 
   9307 ;   Some uses can be quite abstract but the principles can be seen in simple
   9308 ;   right-angled triangles. Triangles have some special properties -
   9309 ;
   9310 ;   1) The sum of the three angles is always PI radians (180 degrees).
   9311 ;      Very helpful if you know two angles and wish to find the third.
   9312 ;   2) In any right-angled triangle the sum of the squares of the two shorter
   9313 ;      sides is equal to the square of the longest side opposite the right-angle.
   9314 ;      Very useful if you know the length of two sides and wish to know the
   9315 ;      length of the third side.
   9316 ;   3) Functions sine, cosine and tangent enable one to calculate the length 
   9317 ;      of an unknown side when the length of one other side and an angle is 
   9318 ;      known.
   9319 ;   4) Functions arcsin, arccosine and arctan enable one to calculate an unknown
   9320 ;      angle when the length of two of the sides is known.
   9321 
   9322 ; --------------------------------
   9323 ; THE 'REDUCE ARGUMENT' SUBROUTINE
   9324 ; --------------------------------
   9325 ; (offset $35: 'get-argt')
   9326 ;
   9327 ;   This routine performs two functions on the angle, in radians, that forms
   9328 ;   the argument to the sine and cosine functions.
   9329 ;   First it ensures that the angle 'wraps round'. That if a ship turns through 
   9330 ;   an angle of, say, 3*PI radians (540 degrees) then the net effect is to turn 
   9331 ;   through an angle of PI radians (180 degrees).
   9332 ;   Secondly it converts the angle in radians to a fraction of a right angle,
   9333 ;   depending within which quadrant the angle lies, with the periodicity 
   9334 ;   resembling that of the desired sine value.
   9335 ;   The result lies in the range -1 to +1.              
   9336 ;
   9337 ;                       90 deg.
   9338 ; 
   9339 ;                       (pi/2)
   9340 ;                II       +1        I
   9341 ;                         |
   9342 ;          sin+      |\   |   /|    sin+
   9343 ;          cos-      | \  |  / |    cos+
   9344 ;          tan-      |  \ | /  |    tan+
   9345 ;                    |   \|/)  |           
   9346 ;   180 deg. (pi) 0 -|----+----|-- 0  (0)   0 degrees
   9347 ;                    |   /|\   |
   9348 ;          sin-      |  / | \  |    sin-
   9349 ;          cos-      | /  |  \ |    cos+
   9350 ;          tan+      |/   |   \|    tan-
   9351 ;                         |
   9352 ;                III      -1       IV
   9353 ;                       (3pi/2)
   9354 ;
   9355 ;                       270 deg.
   9356 
   9357 
   9358 ;; get-argt
   9359 L1D18:  RST     28H             ;; FP-CALC         X.
   9360         DEFB    $30             ;;stk-data
   9361         DEFB    $EE             ;;Exponent: $7E, 
   9362                                 ;;Bytes: 4
   9363         DEFB    $22,$F9,$83,$6E ;;                 X, 1/(2*PI)             
   9364         DEFB    $04             ;;multiply         X/(2*PI) = fraction
   9365 
   9366         DEFB    $2D             ;;duplicate             
   9367         DEFB    $A2             ;;stk-half
   9368         DEFB    $0F             ;;addition
   9369         DEFB    $24             ;;int
   9370 
   9371         DEFB    $03             ;;subtract         now range -.5 to .5
   9372 
   9373         DEFB    $2D             ;;duplicate
   9374         DEFB    $0F             ;;addition         now range -1 to 1.
   9375         DEFB    $2D             ;;duplicate
   9376         DEFB    $0F             ;;addition         now range -2 to 2.
   9377 
   9378 ;   quadrant I (0 to +1) and quadrant IV (-1 to 0) are now correct.
   9379 ;   quadrant II ranges +1 to +2.
   9380 ;   quadrant III ranges -2 to -1.
   9381 
   9382         DEFB    $2D             ;;duplicate        Y, Y.
   9383         DEFB    $27             ;;abs              Y, abs(Y).    range 1 to 2
   9384         DEFB    $A1             ;;stk-one          Y, abs(Y), 1.
   9385         DEFB    $03             ;;subtract         Y, abs(Y)-1.  range 0 to 1
   9386         DEFB    $2D             ;;duplicate        Y, Z, Z.
   9387         DEFB    $33             ;;greater-0        Y, Z, (1/0).
   9388 
   9389         DEFB    $C0             ;;st-mem-0         store as possible sign 
   9390                                 ;;                 for cosine function.
   9391 
   9392         DEFB    $00             ;;jump-true
   9393         DEFB    $04             ;;to L1D35, ZPLUS  with quadrants II and III
   9394 
   9395 ;   else the angle lies in quadrant I or IV and value Y is already correct.
   9396 
   9397         DEFB    $02             ;;delete          Y    delete test value.
   9398         DEFB    $34             ;;end-calc        Y.
   9399 
   9400         RET                     ; return.         with Q1 and Q4 >>>
   9401 
   9402 ;   The branch was here with quadrants II (0 to 1) and III (1 to 0).
   9403 ;   Y will hold -2 to -1 if this is quadrant III.
   9404 
   9405 ;; ZPLUS
   9406 L1D35:  DEFB    $A1             ;;stk-one         Y, Z, 1
   9407         DEFB    $03             ;;subtract        Y, Z-1.       Q3 = 0 to -1
   9408         DEFB    $01             ;;exchange        Z-1, Y.
   9409         DEFB    $32             ;;less-0          Z-1, (1/0).
   9410         DEFB    $00             ;;jump-true       Z-1.
   9411         DEFB    $02             ;;to L1D3C, YNEG
   9412                                 ;;if angle in quadrant III
   9413 
   9414 ;   else angle is within quadrant II (-1 to 0)
   9415 
   9416         DEFB    $18             ;;negate          range +1 to 0
   9417 
   9418 
   9419 ;; YNEG
   9420 L1D3C:  DEFB    $34             ;;end-calc        quadrants II and III correct.
   9421 
   9422         RET                     ; return.
   9423 
   9424 
   9425 ; ---------------------
   9426 ; THE 'COSINE' FUNCTION
   9427 ; ---------------------
   9428 ; (offset $1D: 'cos')
   9429 ;   Cosines are calculated as the sine of the opposite angle rectifying the 
   9430 ;   sign depending on the quadrant rules. 
   9431 ;
   9432 ;
   9433 ;             /|
   9434 ;          h /y|
   9435 ;           /  |o
   9436 ;          /x  |
   9437 ;         /----|    
   9438 ;           a
   9439 ;
   9440 ;   The cosine of angle x is the adjacent side (a) divided by the hypotenuse 1.
   9441 ;   However if we examine angle y then a/h is the sine of that angle.
   9442 ;   Since angle x plus angle y equals a right-angle, we can find angle y by 
   9443 ;   subtracting angle x from pi/2.
   9444 ;   However it's just as easy to reduce the argument first and subtract the
   9445 ;   reduced argument from the value 1 (a reduced right-angle).
   9446 ;   It's even easier to subtract 1 from the angle and rectify the sign.
   9447 ;   In fact, after reducing the argument, the absolute value of the argument
   9448 ;   is used and rectified using the test result stored in mem-0 by 'get-argt'
   9449 ;   for that purpose.
   9450 
   9451 ;; cos
   9452 L1D3E:  RST     28H             ;; FP-CALC              angle in radians.
   9453         DEFB    $35             ;;get-argt              X       reduce -1 to +1
   9454 
   9455         DEFB    $27             ;;abs                   ABS X   0 to 1
   9456         DEFB    $A1             ;;stk-one               ABS X, 1.
   9457         DEFB    $03             ;;subtract              now opposite angle 
   9458                                 ;;                      though negative sign.
   9459         DEFB    $E0             ;;get-mem-0             fetch sign indicator.
   9460         DEFB    $00             ;;jump-true
   9461         DEFB    $06             ;;fwd to L1D4B, C-ENT
   9462                                 ;;forward to common code if in QII or QIII 
   9463 
   9464 
   9465         DEFB    $18             ;;negate                else make positive.
   9466         DEFB    $2F             ;;jump
   9467         DEFB    $03             ;;fwd to L1D4B, C-ENT
   9468                                 ;;with quadrants QI and QIV 
   9469 
   9470 ; -------------------
   9471 ; THE 'SINE' FUNCTION
   9472 ; -------------------
   9473 ; (offset $1C: 'sin')
   9474 ;   This is a fundamental transcendental function from which others such as cos
   9475 ;   and tan are directly, or indirectly, derived.
   9476 ;   It uses the series generator to produce Chebyshev polynomials.
   9477 ;
   9478 ;
   9479 ;             /|
   9480 ;          1 / |
   9481 ;           /  |x
   9482 ;          /a  |
   9483 ;         /----|    
   9484 ;           y
   9485 ;
   9486 ;   The 'get-argt' function is designed to modify the angle and its sign 
   9487 ;   in line with the desired sine value and afterwards it can launch straight
   9488 ;   into common code.
   9489 
   9490 ;; sin
   9491 L1D49:  RST     28H             ;; FP-CALC      angle in radians
   9492         DEFB    $35             ;;get-argt      reduce - sign now correct.
   9493 
   9494 ;; C-ENT
   9495 L1D4B:  DEFB    $2D             ;;duplicate
   9496         DEFB    $2D             ;;duplicate
   9497         DEFB    $04             ;;multiply
   9498         DEFB    $2D             ;;duplicate
   9499         DEFB    $0F             ;;addition
   9500         DEFB    $A1             ;;stk-one
   9501         DEFB    $03             ;;subtract
   9502 
   9503         DEFB    $86             ;;series-06
   9504         DEFB    $14             ;;Exponent: $64, Bytes: 1
   9505         DEFB    $E6             ;;(+00,+00,+00)
   9506         DEFB    $5C             ;;Exponent: $6C, Bytes: 2
   9507         DEFB    $1F,$0B         ;;(+00,+00)
   9508         DEFB    $A3             ;;Exponent: $73, Bytes: 3
   9509         DEFB    $8F,$38,$EE     ;;(+00)
   9510         DEFB    $E9             ;;Exponent: $79, Bytes: 4
   9511         DEFB    $15,$63,$BB,$23 ;;
   9512         DEFB    $EE             ;;Exponent: $7E, Bytes: 4
   9513         DEFB    $92,$0D,$CD,$ED ;;
   9514         DEFB    $F1             ;;Exponent: $81, Bytes: 4
   9515         DEFB    $23,$5D,$1B,$EA ;;
   9516 
   9517         DEFB    $04             ;;multiply
   9518         DEFB    $34             ;;end-calc
   9519 
   9520         RET                     ; return.
   9521 
   9522 
   9523 ; ----------------------
   9524 ; THE 'TANGENT' FUNCTION
   9525 ; ----------------------
   9526 ; (offset $1E: 'tan')
   9527 ;
   9528 ;   Evaluates tangent x as    sin(x) / cos(x).
   9529 ;
   9530 ;
   9531 ;             /|
   9532 ;          h / |
   9533 ;           /  |o
   9534 ;          /x  |
   9535 ;         /----|    
   9536 ;           a
   9537 ;
   9538 ;   The tangent of angle x is the ratio of the length of the opposite side 
   9539 ;   divided by the length of the adjacent side. As the opposite length can 
   9540 ;   be calculates using sin(x) and the adjacent length using cos(x) then 
   9541 ;   the tangent can be defined in terms of the previous two functions.
   9542 
   9543 ;   Error 6 if the argument, in radians, is too close to one like pi/2
   9544 ;   which has an infinite tangent. e.g. PRINT TAN (PI/2)  evaluates as 1/0.
   9545 ;   Similarly PRINT TAN (3*PI/2), TAN (5*PI/2) etc.
   9546 
   9547 ;; tan
   9548 L1D6E:  RST     28H             ;; FP-CALC          x.
   9549         DEFB    $2D             ;;duplicate         x, x.
   9550         DEFB    $1C             ;;sin               x, sin x.
   9551         DEFB    $01             ;;exchange          sin x, x.
   9552         DEFB    $1D             ;;cos               sin x, cos x.
   9553         DEFB    $05             ;;division          sin x/cos x (= tan x).
   9554         DEFB    $34             ;;end-calc          tan x.
   9555 
   9556         RET                     ; return.
   9557 
   9558 ; ---------------------
   9559 ; THE 'ARCTAN' FUNCTION
   9560 ; ---------------------
   9561 ; (Offset $21: 'atn')
   9562 ;   The inverse tangent function with the result in radians.
   9563 ;   This is a fundamental transcendental function from which others such as
   9564 ;   asn and acs are directly, or indirectly, derived.
   9565 ;   It uses the series generator to produce Chebyshev polynomials.
   9566 
   9567 ;; atn
   9568 L1D76:  LD      A,(HL)          ; fetch exponent
   9569         CP      $81             ; compare to that for 'one'
   9570         JR      C,L1D89         ; forward, if less, to SMALL
   9571 
   9572         RST     28H             ;; FP-CALC      X.
   9573         DEFB    $A1             ;;stk-one
   9574         DEFB    $18             ;;negate
   9575         DEFB    $01             ;;exchange
   9576         DEFB    $05             ;;division
   9577         DEFB    $2D             ;;duplicate
   9578         DEFB    $32             ;;less-0
   9579         DEFB    $A3             ;;stk-pi/2
   9580         DEFB    $01             ;;exchange
   9581         DEFB    $00             ;;jump-true
   9582         DEFB    $06             ;;to L1D8B, CASES
   9583 
   9584         DEFB    $18             ;;negate
   9585         DEFB    $2F             ;;jump
   9586         DEFB    $03             ;;to L1D8B, CASES
   9587 
   9588 ; ---
   9589 
   9590 ;; SMALL
   9591 L1D89:  RST     28H             ;; FP-CALC
   9592         DEFB    $A0             ;;stk-zero
   9593 
   9594 ;; CASES
   9595 L1D8B:  DEFB    $01             ;;exchange
   9596         DEFB    $2D             ;;duplicate
   9597         DEFB    $2D             ;;duplicate
   9598         DEFB    $04             ;;multiply
   9599         DEFB    $2D             ;;duplicate
   9600         DEFB    $0F             ;;addition
   9601         DEFB    $A1             ;;stk-one
   9602         DEFB    $03             ;;subtract
   9603 
   9604         DEFB    $8C             ;;series-0C
   9605         DEFB    $10             ;;Exponent: $60, Bytes: 1
   9606         DEFB    $B2             ;;(+00,+00,+00)
   9607         DEFB    $13             ;;Exponent: $63, Bytes: 1
   9608         DEFB    $0E             ;;(+00,+00,+00)
   9609         DEFB    $55             ;;Exponent: $65, Bytes: 2
   9610         DEFB    $E4,$8D         ;;(+00,+00)
   9611         DEFB    $58             ;;Exponent: $68, Bytes: 2
   9612         DEFB    $39,$BC         ;;(+00,+00)
   9613         DEFB    $5B             ;;Exponent: $6B, Bytes: 2
   9614         DEFB    $98,$FD         ;;(+00,+00)
   9615         DEFB    $9E             ;;Exponent: $6E, Bytes: 3
   9616         DEFB    $00,$36,$75     ;;(+00)
   9617         DEFB    $A0             ;;Exponent: $70, Bytes: 3
   9618         DEFB    $DB,$E8,$B4     ;;(+00)
   9619         DEFB    $63             ;;Exponent: $73, Bytes: 2
   9620         DEFB    $42,$C4         ;;(+00,+00)
   9621         DEFB    $E6             ;;Exponent: $76, Bytes: 4
   9622         DEFB    $B5,$09,$36,$BE ;;
   9623         DEFB    $E9             ;;Exponent: $79, Bytes: 4
   9624         DEFB    $36,$73,$1B,$5D ;;
   9625         DEFB    $EC             ;;Exponent: $7C, Bytes: 4
   9626         DEFB    $D8,$DE,$63,$BE ;;
   9627         DEFB    $F0             ;;Exponent: $80, Bytes: 4
   9628         DEFB    $61,$A1,$B3,$0C ;;
   9629 
   9630         DEFB    $04             ;;multiply
   9631         DEFB    $0F             ;;addition
   9632         DEFB    $34             ;;end-calc
   9633 
   9634         RET                     ; return.
   9635 
   9636 
   9637 ; ---------------------
   9638 ; THE 'ARCSIN' FUNCTION
   9639 ; ---------------------
   9640 ; (Offset $1F: 'asn')
   9641 ;   The inverse sine function with result in radians.
   9642 ;   Derived from arctan function above.
   9643 ;   Error A unless the argument is between -1 and +1 inclusive.
   9644 ;   Uses an adaptation of the formula asn(x) = atn(x/sqr(1-x*x))
   9645 ;
   9646 ;
   9647 ;                 /|
   9648 ;                / |
   9649 ;              1/  |x
   9650 ;              /a  |
   9651 ;             /----|    
   9652 ;               y
   9653 ;
   9654 ;   e.g. We know the opposite side (x) and hypotenuse (1) 
   9655 ;   and we wish to find angle a in radians.
   9656 ;   We can derive length y by Pythagoras and then use ATN instead. 
   9657 ;   Since y*y + x*x = 1*1 (Pythagoras Theorem) then
   9658 ;   y=sqr(1-x*x)                         - no need to multiply 1 by itself.
   9659 ;   So, asn(a) = atn(x/y)
   9660 ;   or more fully,
   9661 ;   asn(a) = atn(x/sqr(1-x*x))
   9662 
   9663 ;   Close but no cigar.
   9664 
   9665 ;   While PRINT ATN (x/SQR (1-x*x)) gives the same results as PRINT ASN x,
   9666 ;   it leads to division by zero when x is 1 or -1.
   9667 ;   To overcome this, 1 is added to y giving half the required angle and the 
   9668 ;   result is then doubled. 
   9669 ;   That is, PRINT ATN (x/(SQR (1-x*x) +1)) *2
   9670 ;
   9671 ;
   9672 ;               . /|
   9673 ;            .  c/ |
   9674 ;         .     /1 |x
   9675 ;      . c   b /a  |
   9676 ;    ---------/----|    
   9677 ;      1      y
   9678 ;
   9679 ;   By creating an isosceles triangle with two equal sides of 1, angles c and 
   9680 ;   c are also equal. If b+c+d = 180 degrees and b+a = 180 degrees then c=a/2.
   9681 ;
   9682 ;   A value higher than 1 gives the required error as attempting to find  the
   9683 ;   square root of a negative number generates an error in Sinclair BASIC.
   9684 
   9685 ;; asn
   9686 L1DC4:  RST     28H             ;; FP-CALC      x.
   9687         DEFB    $2D             ;;duplicate     x, x.
   9688         DEFB    $2D             ;;duplicate     x, x, x.
   9689         DEFB    $04             ;;multiply      x, x*x.
   9690         DEFB    $A1             ;;stk-one       x, x*x, 1.
   9691         DEFB    $03             ;;subtract      x, x*x-1.
   9692         DEFB    $18             ;;negate        x, 1-x*x.
   9693         DEFB    $25             ;;sqr           x, sqr(1-x*x) = y.
   9694         DEFB    $A1             ;;stk-one       x, y, 1.
   9695         DEFB    $0F             ;;addition      x, y+1.
   9696         DEFB    $05             ;;division      x/y+1.
   9697         DEFB    $21             ;;atn           a/2     (half the angle)
   9698         DEFB    $2D             ;;duplicate     a/2, a/2.
   9699         DEFB    $0F             ;;addition      a.
   9700         DEFB    $34             ;;end-calc      a.
   9701 
   9702         RET                     ; return.
   9703 
   9704 
   9705 ; ------------------------
   9706 ; THE 'ARCCOS' FUNCTION
   9707 ; ------------------------
   9708 ; (Offset $20: 'acs')
   9709 ;   The inverse cosine function with the result in radians.
   9710 ;   Error A unless the argument is between -1 and +1.
   9711 ;   Result in range 0 to pi.
   9712 ;   Derived from asn above which is in turn derived from the preceding atn. It 
   9713 ;   could have been derived directly from atn using acs(x) = atn(sqr(1-x*x)/x).
   9714 ;   However, as sine and cosine are horizontal translations of each other,
   9715 ;   uses acs(x) = pi/2 - asn(x)
   9716 
   9717 ;   e.g. the arccosine of a known x value will give the required angle b in 
   9718 ;   radians.
   9719 ;   We know, from above, how to calculate the angle a using asn(x). 
   9720 ;   Since the three angles of any triangle add up to 180 degrees, or pi radians,
   9721 ;   and the largest angle in this case is a right-angle (pi/2 radians), then
   9722 ;   we can calculate angle b as pi/2 (both angles) minus asn(x) (angle a).
   9723 ; 
   9724 ;
   9725 ;            /|
   9726 ;         1 /b|
   9727 ;          /  |x
   9728 ;         /a  |
   9729 ;        /----|    
   9730 ;          y
   9731 
   9732 ;; acs
   9733 L1DD4:  RST     28H             ;; FP-CALC      x.
   9734         DEFB    $1F             ;;asn           asn(x).
   9735         DEFB    $A3             ;;stk-pi/2      asn(x), pi/2.
   9736         DEFB    $03             ;;subtract      asn(x) - pi/2.
   9737         DEFB    $18             ;;negate        pi/2 - asn(x) = acs(x).
   9738         DEFB    $34             ;;end-calc      acs(x)
   9739 
   9740         RET                     ; return.
   9741 
   9742 
   9743 ; --------------------------
   9744 ; THE 'SQUARE ROOT' FUNCTION
   9745 ; --------------------------
   9746 ; (Offset $25: 'sqr')
   9747 ;   Error A if argument is negative.
   9748 ;   This routine is remarkable for its brevity - 7 bytes.
   9749 ;   The ZX81 code was originally 9K and various techniques had to be
   9750 ;   used to shoe-horn it into an 8K Rom chip.
   9751 
   9752 
   9753 ;; sqr
   9754 L1DDB:  RST     28H             ;; FP-CALC              x.
   9755         DEFB    $2D             ;;duplicate             x, x.
   9756         DEFB    $2C             ;;not                   x, 1/0
   9757         DEFB    $00             ;;jump-true             x, (1/0).
   9758         DEFB    $1E             ;;to L1DFD, LAST        exit if argument zero
   9759                                 ;;                      with zero result.
   9760 
   9761 ;   else continue to calculate as x ** .5
   9762 
   9763         DEFB    $A2             ;;stk-half              x, .5.
   9764         DEFB    $34             ;;end-calc              x, .5.
   9765 
   9766 
   9767 ; ------------------------------
   9768 ; THE 'EXPONENTIATION' OPERATION
   9769 ; ------------------------------
   9770 ; (Offset $06: 'to-power')
   9771 ;   This raises the first number X to the power of the second number Y.
   9772 ;   As with the ZX80,
   9773 ;   0 ** 0 = 1
   9774 ;   0 ** +n = 0
   9775 ;   0 ** -n = arithmetic overflow.
   9776 
   9777 ;; to-power
   9778 L1DE2:  RST     28H             ;; FP-CALC              X,Y.
   9779         DEFB    $01             ;;exchange              Y,X.
   9780         DEFB    $2D             ;;duplicate             Y,X,X.
   9781         DEFB    $2C             ;;not                   Y,X,(1/0).
   9782         DEFB    $00             ;;jump-true
   9783         DEFB    $07             ;;forward to L1DEE, XISO if X is zero.
   9784 
   9785 ;   else X is non-zero. function 'ln' will catch a negative value of X.
   9786 
   9787         DEFB    $22             ;;ln                    Y, LN X.
   9788         DEFB    $04             ;;multiply              Y * LN X
   9789         DEFB    $34             ;;end-calc
   9790 
   9791         JP      L1C5B           ; jump back to EXP routine.  ->
   9792 
   9793 ; ---
   9794 
   9795 ;   These routines form the three simple results when the number is zero.
   9796 ;   begin by deleting the known zero to leave Y the power factor.
   9797 
   9798 ;; XISO
   9799 L1DEE:  DEFB    $02             ;;delete                Y.
   9800         DEFB    $2D             ;;duplicate             Y, Y.
   9801         DEFB    $2C             ;;not                   Y, (1/0).
   9802         DEFB    $00             ;;jump-true     
   9803         DEFB    $09             ;;forward to L1DFB, ONE if Y is zero.
   9804 
   9805 ;   the power factor is not zero. If negative then an error exists.
   9806 
   9807         DEFB    $A0             ;;stk-zero              Y, 0.
   9808         DEFB    $01             ;;exchange              0, Y.
   9809         DEFB    $33             ;;greater-0             0, (1/0).
   9810         DEFB    $00             ;;jump-true             0
   9811         DEFB    $06             ;;to L1DFD, LAST        if Y was any positive 
   9812                                 ;;                      number.
   9813 
   9814 ;   else force division by zero thereby raising an Arithmetic overflow error.
   9815 ;   There are some one and two-byte alternatives but perhaps the most formal
   9816 ;   might have been to use end-calc; rst 08; defb 05.
   9817 
   9818         DEFB    $A1             ;;stk-one               0, 1.
   9819         DEFB    $01             ;;exchange              1, 0.
   9820         DEFB    $05             ;;division              1/0    >> error 
   9821 
   9822 ; ---
   9823 
   9824 ;; ONE
   9825 L1DFB:  DEFB    $02             ;;delete                .
   9826         DEFB    $A1             ;;stk-one               1.
   9827 
   9828 ;; LAST
   9829 L1DFD:  DEFB    $34             ;;end-calc              last value 1 or 0.
   9830 
   9831         RET                     ; return.
   9832 
   9833 ; ---------------------
   9834 ; THE 'SPARE LOCATIONS'
   9835 ; ---------------------
   9836 
   9837 ;; SPARE
   9838 L1DFF:  DEFB    $FF             ; That's all folks.
   9839 
   9840 
   9841 
   9842 ; ------------------------
   9843 ; THE 'ZX81 CHARACTER SET'
   9844 ; ------------------------
   9845 
   9846 ;; char-set - begins with space character.
   9847 
   9848 ; $00 - Character: ' '          CHR$(0)
   9849 
   9850 L1E00:  DEFB    %00000000
   9851         DEFB    %00000000
   9852         DEFB    %00000000
   9853         DEFB    %00000000
   9854         DEFB    %00000000
   9855         DEFB    %00000000
   9856         DEFB    %00000000
   9857         DEFB    %00000000
   9858 
   9859 ; $01 - Character: mosaic       CHR$(1)
   9860 
   9861         DEFB    %11110000
   9862         DEFB    %11110000
   9863         DEFB    %11110000
   9864         DEFB    %11110000
   9865         DEFB    %00000000
   9866         DEFB    %00000000
   9867         DEFB    %00000000
   9868         DEFB    %00000000
   9869 
   9870 
   9871 ; $02 - Character: mosaic       CHR$(2)
   9872 
   9873         DEFB    %00001111
   9874         DEFB    %00001111
   9875         DEFB    %00001111
   9876         DEFB    %00001111
   9877         DEFB    %00000000
   9878         DEFB    %00000000
   9879         DEFB    %00000000
   9880         DEFB    %00000000
   9881 
   9882 
   9883 ; $03 - Character: mosaic       CHR$(3)
   9884 
   9885         DEFB    %11111111
   9886         DEFB    %11111111
   9887         DEFB    %11111111
   9888         DEFB    %11111111
   9889         DEFB    %00000000
   9890         DEFB    %00000000
   9891         DEFB    %00000000
   9892         DEFB    %00000000
   9893 
   9894 ; $04 - Character: mosaic       CHR$(4)
   9895 
   9896         DEFB    %00000000
   9897         DEFB    %00000000
   9898         DEFB    %00000000
   9899         DEFB    %00000000
   9900         DEFB    %11110000
   9901         DEFB    %11110000
   9902         DEFB    %11110000
   9903         DEFB    %11110000
   9904 
   9905 ; $05 - Character: mosaic       CHR$(1)
   9906 
   9907         DEFB    %11110000
   9908         DEFB    %11110000
   9909         DEFB    %11110000
   9910         DEFB    %11110000
   9911         DEFB    %11110000
   9912         DEFB    %11110000
   9913         DEFB    %11110000
   9914         DEFB    %11110000
   9915 
   9916 ; $06 - Character: mosaic       CHR$(1)
   9917 
   9918         DEFB    %00001111
   9919         DEFB    %00001111
   9920         DEFB    %00001111
   9921         DEFB    %00001111
   9922         DEFB    %11110000
   9923         DEFB    %11110000
   9924         DEFB    %11110000
   9925         DEFB    %11110000
   9926 
   9927 ; $07 - Character: mosaic       CHR$(1)
   9928 
   9929         DEFB    %11111111
   9930         DEFB    %11111111
   9931         DEFB    %11111111
   9932         DEFB    %11111111
   9933         DEFB    %11110000
   9934         DEFB    %11110000
   9935         DEFB    %11110000
   9936         DEFB    %11110000
   9937 
   9938 ; $08 - Character: mosaic       CHR$(1)
   9939 
   9940         DEFB    %10101010
   9941         DEFB    %01010101
   9942         DEFB    %10101010
   9943         DEFB    %01010101
   9944         DEFB    %10101010
   9945         DEFB    %01010101
   9946         DEFB    %10101010
   9947         DEFB    %01010101
   9948 
   9949 ; $09 - Character: mosaic       CHR$(1)
   9950 
   9951         DEFB    %00000000
   9952         DEFB    %00000000
   9953         DEFB    %00000000
   9954         DEFB    %00000000
   9955         DEFB    %10101010
   9956         DEFB    %01010101
   9957         DEFB    %10101010
   9958         DEFB    %01010101
   9959 
   9960 ; $0A - Character: mosaic       CHR$(10)
   9961 
   9962         DEFB    %10101010
   9963         DEFB    %01010101
   9964         DEFB    %10101010
   9965         DEFB    %01010101
   9966         DEFB    %00000000
   9967         DEFB    %00000000
   9968         DEFB    %00000000
   9969         DEFB    %00000000
   9970 
   9971 ; $0B - Character: '"'          CHR$(11)
   9972 
   9973         DEFB    %00000000
   9974         DEFB    %00100100
   9975         DEFB    %00100100
   9976         DEFB    %00000000
   9977         DEFB    %00000000
   9978         DEFB    %00000000
   9979         DEFB    %00000000
   9980         DEFB    %00000000
   9981 
   9982 ; $0B - Character: ukp          CHR$(12)
   9983 
   9984         DEFB    %00000000
   9985         DEFB    %00011100
   9986         DEFB    %00100010
   9987         DEFB    %01111000
   9988         DEFB    %00100000
   9989         DEFB    %00100000
   9990         DEFB    %01111110
   9991         DEFB    %00000000
   9992 
   9993 ; $0B - Character: '$'          CHR$(13)
   9994 
   9995         DEFB    %00000000
   9996         DEFB    %00001000
   9997         DEFB    %00111110
   9998         DEFB    %00101000
   9999         DEFB    %00111110
  10000         DEFB    %00001010
  10001         DEFB    %00111110
  10002         DEFB    %00001000
  10003 
  10004 ; $0B - Character: ':'          CHR$(14)
  10005 
  10006         DEFB    %00000000
  10007         DEFB    %00000000
  10008         DEFB    %00000000
  10009         DEFB    %00010000
  10010         DEFB    %00000000
  10011         DEFB    %00000000
  10012         DEFB    %00010000
  10013         DEFB    %00000000
  10014 
  10015 ; $0B - Character: '?'          CHR$(15)
  10016 
  10017         DEFB    %00000000
  10018         DEFB    %00111100
  10019         DEFB    %01000010
  10020         DEFB    %00000100
  10021         DEFB    %00001000
  10022         DEFB    %00000000
  10023         DEFB    %00001000
  10024         DEFB    %00000000
  10025 
  10026 ; $10 - Character: '('          CHR$(16)
  10027 
  10028         DEFB    %00000000
  10029         DEFB    %00000100
  10030         DEFB    %00001000
  10031         DEFB    %00001000
  10032         DEFB    %00001000
  10033         DEFB    %00001000
  10034         DEFB    %00000100
  10035         DEFB    %00000000
  10036 
  10037 ; $11 - Character: ')'          CHR$(17)
  10038 
  10039         DEFB    %00000000
  10040         DEFB    %00100000
  10041         DEFB    %00010000
  10042         DEFB    %00010000
  10043         DEFB    %00010000
  10044         DEFB    %00010000
  10045         DEFB    %00100000
  10046         DEFB    %00000000
  10047 
  10048 ; $12 - Character: '>'          CHR$(18)
  10049 
  10050         DEFB    %00000000
  10051         DEFB    %00000000
  10052         DEFB    %00010000
  10053         DEFB    %00001000
  10054         DEFB    %00000100
  10055         DEFB    %00001000
  10056         DEFB    %00010000
  10057         DEFB    %00000000
  10058 
  10059 ; $13 - Character: '<'          CHR$(19)
  10060 
  10061         DEFB    %00000000
  10062         DEFB    %00000000
  10063         DEFB    %00000100
  10064         DEFB    %00001000
  10065         DEFB    %00010000
  10066         DEFB    %00001000
  10067         DEFB    %00000100
  10068         DEFB    %00000000
  10069 
  10070 ; $14 - Character: '='          CHR$(20)
  10071 
  10072         DEFB    %00000000
  10073         DEFB    %00000000
  10074         DEFB    %00000000
  10075         DEFB    %00111110
  10076         DEFB    %00000000
  10077         DEFB    %00111110
  10078         DEFB    %00000000
  10079         DEFB    %00000000
  10080 
  10081 ; $15 - Character: '+'          CHR$(21)
  10082 
  10083         DEFB    %00000000
  10084         DEFB    %00000000
  10085         DEFB    %00001000
  10086         DEFB    %00001000
  10087         DEFB    %00111110
  10088         DEFB    %00001000
  10089         DEFB    %00001000
  10090         DEFB    %00000000
  10091 
  10092 ; $16 - Character: '-'          CHR$(22)
  10093 
  10094         DEFB    %00000000
  10095         DEFB    %00000000
  10096         DEFB    %00000000
  10097         DEFB    %00000000
  10098         DEFB    %00111110
  10099         DEFB    %00000000
  10100         DEFB    %00000000
  10101         DEFB    %00000000
  10102 
  10103 ; $17 - Character: '*'          CHR$(23)
  10104 
  10105         DEFB    %00000000
  10106         DEFB    %00000000
  10107         DEFB    %00010100
  10108         DEFB    %00001000
  10109         DEFB    %00111110
  10110         DEFB    %00001000
  10111         DEFB    %00010100
  10112         DEFB    %00000000
  10113 
  10114 ; $18 - Character: '/'          CHR$(24)
  10115 
  10116         DEFB    %00000000
  10117         DEFB    %00000000
  10118         DEFB    %00000010
  10119         DEFB    %00000100
  10120         DEFB    %00001000
  10121         DEFB    %00010000
  10122         DEFB    %00100000
  10123         DEFB    %00000000
  10124 
  10125 ; $19 - Character: ';'          CHR$(25)
  10126 
  10127         DEFB    %00000000
  10128         DEFB    %00000000
  10129         DEFB    %00010000
  10130         DEFB    %00000000
  10131         DEFB    %00000000
  10132         DEFB    %00010000
  10133         DEFB    %00010000
  10134         DEFB    %00100000
  10135 
  10136 ; $1A - Character: ','          CHR$(26)
  10137 
  10138         DEFB    %00000000
  10139         DEFB    %00000000
  10140         DEFB    %00000000
  10141         DEFB    %00000000
  10142         DEFB    %00000000
  10143         DEFB    %00001000
  10144         DEFB    %00001000
  10145         DEFB    %00010000
  10146 
  10147 ; $1B - Character: '"'          CHR$(27)
  10148 
  10149         DEFB    %00000000
  10150         DEFB    %00000000
  10151         DEFB    %00000000
  10152         DEFB    %00000000
  10153         DEFB    %00000000
  10154         DEFB    %00011000
  10155         DEFB    %00011000
  10156         DEFB    %00000000
  10157 
  10158 ; $1C - Character: '0'          CHR$(28)
  10159 
  10160         DEFB    %00000000
  10161         DEFB    %00111100
  10162         DEFB    %01000110
  10163         DEFB    %01001010
  10164         DEFB    %01010010
  10165         DEFB    %01100010
  10166         DEFB    %00111100
  10167         DEFB    %00000000
  10168 
  10169 ; $1D - Character: '1'          CHR$(29)
  10170 
  10171         DEFB    %00000000
  10172         DEFB    %00011000
  10173         DEFB    %00101000
  10174         DEFB    %00001000
  10175         DEFB    %00001000
  10176         DEFB    %00001000
  10177         DEFB    %00111110
  10178         DEFB    %00000000
  10179 
  10180 ; $1E - Character: '2'          CHR$(30)
  10181 
  10182         DEFB    %00000000
  10183         DEFB    %00111100
  10184         DEFB    %01000010
  10185         DEFB    %00000010
  10186         DEFB    %00111100
  10187         DEFB    %01000000
  10188         DEFB    %01111110
  10189         DEFB    %00000000
  10190 
  10191 ; $1F - Character: '3'          CHR$(31)
  10192 
  10193         DEFB    %00000000
  10194         DEFB    %00111100
  10195         DEFB    %01000010
  10196         DEFB    %00001100
  10197         DEFB    %00000010
  10198         DEFB    %01000010
  10199         DEFB    %00111100
  10200         DEFB    %00000000
  10201 
  10202 ; $20 - Character: '4'          CHR$(32)
  10203 
  10204         DEFB    %00000000
  10205         DEFB    %00001000
  10206         DEFB    %00011000
  10207         DEFB    %00101000
  10208         DEFB    %01001000
  10209         DEFB    %01111110
  10210         DEFB    %00001000
  10211         DEFB    %00000000
  10212 
  10213 ; $21 - Character: '5'          CHR$(33)
  10214 
  10215         DEFB    %00000000
  10216         DEFB    %01111110
  10217         DEFB    %01000000
  10218         DEFB    %01111100
  10219         DEFB    %00000010
  10220         DEFB    %01000010
  10221         DEFB    %00111100
  10222         DEFB    %00000000
  10223 
  10224 ; $22 - Character: '6'          CHR$(34)
  10225 
  10226         DEFB    %00000000
  10227         DEFB    %00111100
  10228         DEFB    %01000000
  10229         DEFB    %01111100
  10230         DEFB    %01000010
  10231         DEFB    %01000010
  10232         DEFB    %00111100
  10233         DEFB    %00000000
  10234 
  10235 ; $23 - Character: '7'          CHR$(35)
  10236 
  10237         DEFB    %00000000
  10238         DEFB    %01111110
  10239         DEFB    %00000010
  10240         DEFB    %00000100
  10241         DEFB    %00001000
  10242         DEFB    %00010000
  10243         DEFB    %00010000
  10244         DEFB    %00000000
  10245 
  10246 ; $24 - Character: '8'          CHR$(36)
  10247 
  10248         DEFB    %00000000
  10249         DEFB    %00111100
  10250         DEFB    %01000010
  10251         DEFB    %00111100
  10252         DEFB    %01000010
  10253         DEFB    %01000010
  10254         DEFB    %00111100
  10255         DEFB    %00000000
  10256 
  10257 ; $25 - Character: '9'          CHR$(37)
  10258 
  10259         DEFB    %00000000
  10260         DEFB    %00111100
  10261         DEFB    %01000010
  10262         DEFB    %01000010
  10263         DEFB    %00111110
  10264         DEFB    %00000010
  10265         DEFB    %00111100
  10266         DEFB    %00000000
  10267 
  10268 ; $26 - Character: 'A'          CHR$(38)
  10269 
  10270         DEFB    %00000000
  10271         DEFB    %00111100
  10272         DEFB    %01000010
  10273         DEFB    %01000010
  10274         DEFB    %01111110
  10275         DEFB    %01000010
  10276         DEFB    %01000010
  10277         DEFB    %00000000
  10278 
  10279 ; $27 - Character: 'B'          CHR$(39)
  10280 
  10281         DEFB    %00000000
  10282         DEFB    %01111100
  10283         DEFB    %01000010
  10284         DEFB    %01111100
  10285         DEFB    %01000010
  10286         DEFB    %01000010
  10287         DEFB    %01111100
  10288         DEFB    %00000000
  10289 
  10290 ; $28 - Character: 'C'          CHR$(40)
  10291 
  10292         DEFB    %00000000
  10293         DEFB    %00111100
  10294         DEFB    %01000010
  10295         DEFB    %01000000
  10296         DEFB    %01000000
  10297         DEFB    %01000010
  10298         DEFB    %00111100
  10299         DEFB    %00000000
  10300 
  10301 ; $29 - Character: 'D'          CHR$(41)
  10302 
  10303         DEFB    %00000000
  10304         DEFB    %01111000
  10305         DEFB    %01000100
  10306         DEFB    %01000010
  10307         DEFB    %01000010
  10308         DEFB    %01000100
  10309         DEFB    %01111000
  10310         DEFB    %00000000
  10311 
  10312 ; $2A - Character: 'E'          CHR$(42)
  10313 
  10314         DEFB    %00000000
  10315         DEFB    %01111110
  10316         DEFB    %01000000
  10317         DEFB    %01111100
  10318         DEFB    %01000000
  10319         DEFB    %01000000
  10320         DEFB    %01111110
  10321         DEFB    %00000000
  10322 
  10323 ; $2B - Character: 'F'          CHR$(43)
  10324 
  10325         DEFB    %00000000
  10326         DEFB    %01111110
  10327         DEFB    %01000000
  10328         DEFB    %01111100
  10329         DEFB    %01000000
  10330         DEFB    %01000000
  10331         DEFB    %01000000
  10332         DEFB    %00000000
  10333 
  10334 ; $2C - Character: 'G'          CHR$(44)
  10335 
  10336         DEFB    %00000000
  10337         DEFB    %00111100
  10338         DEFB    %01000010
  10339         DEFB    %01000000
  10340         DEFB    %01001110
  10341         DEFB    %01000010
  10342         DEFB    %00111100
  10343         DEFB    %00000000
  10344 
  10345 ; $2D - Character: 'H'          CHR$(45)
  10346 
  10347         DEFB    %00000000
  10348         DEFB    %01000010
  10349         DEFB    %01000010
  10350         DEFB    %01111110
  10351         DEFB    %01000010
  10352         DEFB    %01000010
  10353         DEFB    %01000010
  10354         DEFB    %00000000
  10355 
  10356 ; $2E - Character: 'I'          CHR$(46)
  10357 
  10358         DEFB    %00000000
  10359         DEFB    %00111110
  10360         DEFB    %00001000
  10361         DEFB    %00001000
  10362         DEFB    %00001000
  10363         DEFB    %00001000
  10364         DEFB    %00111110
  10365         DEFB    %00000000
  10366 
  10367 ; $2F - Character: 'J'          CHR$(47)
  10368 
  10369         DEFB    %00000000
  10370         DEFB    %00000010
  10371         DEFB    %00000010
  10372         DEFB    %00000010
  10373         DEFB    %01000010
  10374         DEFB    %01000010
  10375         DEFB    %00111100
  10376         DEFB    %00000000
  10377 
  10378 ; $30 - Character: 'K'          CHR$(48)
  10379 
  10380         DEFB    %00000000
  10381         DEFB    %01000100
  10382         DEFB    %01001000
  10383         DEFB    %01110000
  10384         DEFB    %01001000
  10385         DEFB    %01000100
  10386         DEFB    %01000010
  10387         DEFB    %00000000
  10388 
  10389 ; $31 - Character: 'L'          CHR$(49)
  10390 
  10391         DEFB    %00000000
  10392         DEFB    %01000000
  10393         DEFB    %01000000
  10394         DEFB    %01000000
  10395         DEFB    %01000000
  10396         DEFB    %01000000
  10397         DEFB    %01111110
  10398         DEFB    %00000000
  10399 
  10400 ; $32 - Character: 'M'          CHR$(50)
  10401 
  10402         DEFB    %00000000
  10403         DEFB    %01000010
  10404         DEFB    %01100110
  10405         DEFB    %01011010
  10406         DEFB    %01000010
  10407         DEFB    %01000010
  10408         DEFB    %01000010
  10409         DEFB    %00000000
  10410 
  10411 ; $33 - Character: 'N'          CHR$(51)
  10412 
  10413         DEFB    %00000000
  10414         DEFB    %01000010
  10415         DEFB    %01100010
  10416         DEFB    %01010010
  10417         DEFB    %01001010
  10418         DEFB    %01000110
  10419         DEFB    %01000010
  10420         DEFB    %00000000
  10421 
  10422 ; $34 - Character: 'O'          CHR$(52)
  10423 
  10424         DEFB    %00000000
  10425         DEFB    %00111100
  10426         DEFB    %01000010
  10427         DEFB    %01000010
  10428         DEFB    %01000010
  10429         DEFB    %01000010
  10430         DEFB    %00111100
  10431         DEFB    %00000000
  10432 
  10433 ; $35 - Character: 'P'          CHR$(53)
  10434 
  10435         DEFB    %00000000
  10436         DEFB    %01111100
  10437         DEFB    %01000010
  10438         DEFB    %01000010
  10439         DEFB    %01111100
  10440         DEFB    %01000000
  10441         DEFB    %01000000
  10442         DEFB    %00000000
  10443 
  10444 ; $36 - Character: 'Q'          CHR$(54)
  10445 
  10446         DEFB    %00000000
  10447         DEFB    %00111100
  10448         DEFB    %01000010
  10449         DEFB    %01000010
  10450         DEFB    %01010010
  10451         DEFB    %01001010
  10452         DEFB    %00111100
  10453         DEFB    %00000000
  10454 
  10455 ; $37 - Character: 'R'          CHR$(55)
  10456 
  10457         DEFB    %00000000
  10458         DEFB    %01111100
  10459         DEFB    %01000010
  10460         DEFB    %01000010
  10461         DEFB    %01111100
  10462         DEFB    %01000100
  10463         DEFB    %01000010
  10464         DEFB    %00000000
  10465 
  10466 ; $38 - Character: 'S'          CHR$(56)
  10467 
  10468         DEFB    %00000000
  10469         DEFB    %00111100
  10470         DEFB    %01000000
  10471         DEFB    %00111100
  10472         DEFB    %00000010
  10473         DEFB    %01000010
  10474         DEFB    %00111100
  10475         DEFB    %00000000
  10476 
  10477 ; $39 - Character: 'T'          CHR$(57)
  10478 
  10479         DEFB    %00000000
  10480         DEFB    %11111110
  10481         DEFB    %00010000
  10482         DEFB    %00010000
  10483         DEFB    %00010000
  10484         DEFB    %00010000
  10485         DEFB    %00010000
  10486         DEFB    %00000000
  10487 
  10488 ; $3A - Character: 'U'          CHR$(58)
  10489 
  10490         DEFB    %00000000
  10491         DEFB    %01000010
  10492         DEFB    %01000010
  10493         DEFB    %01000010
  10494         DEFB    %01000010
  10495         DEFB    %01000010
  10496         DEFB    %00111100
  10497         DEFB    %00000000
  10498 
  10499 ; $3B - Character: 'V'          CHR$(59)
  10500 
  10501         DEFB    %00000000
  10502         DEFB    %01000010
  10503         DEFB    %01000010
  10504         DEFB    %01000010
  10505         DEFB    %01000010
  10506         DEFB    %00100100
  10507         DEFB    %00011000
  10508         DEFB    %00000000
  10509 
  10510 ; $3C - Character: 'W'          CHR$(60)
  10511 
  10512         DEFB    %00000000
  10513         DEFB    %01000010
  10514         DEFB    %01000010
  10515         DEFB    %01000010
  10516         DEFB    %01000010
  10517         DEFB    %01011010
  10518         DEFB    %00100100
  10519         DEFB    %00000000
  10520 
  10521 ; $3D - Character: 'X'          CHR$(61)
  10522 
  10523         DEFB    %00000000
  10524         DEFB    %01000010
  10525         DEFB    %00100100
  10526         DEFB    %00011000
  10527         DEFB    %00011000
  10528         DEFB    %00100100
  10529         DEFB    %01000010
  10530         DEFB    %00000000
  10531 
  10532 ; $3E - Character: 'Y'          CHR$(62)
  10533 
  10534         DEFB    %00000000
  10535         DEFB    %10000010
  10536         DEFB    %01000100
  10537         DEFB    %00101000
  10538         DEFB    %00010000
  10539         DEFB    %00010000
  10540         DEFB    %00010000
  10541         DEFB    %00000000
  10542 
  10543 ; $3F - Character: 'Z'          CHR$(63)
  10544 
  10545         DEFB    %00000000
  10546         DEFB    %01111110
  10547         DEFB    %00000100
  10548         DEFB    %00001000
  10549         DEFB    %00010000
  10550         DEFB    %00100000
  10551         DEFB    %01111110
  10552         DEFB    %00000000
  10553 
  10554 .END                                ;TASM assembler instruction.
  10555 
  10556