; NASCOM ROM BASIC Ver 4.7, (C) 1978 Microsoft
; Scanned from source published in 80-BUS NEWS from Vol 2, Issue 3
; (May-June 1983) to Vol 3, Issue 3 (May-June 1984)
; Adapted for the freeware Zilog Macro Assembler 2.10 to produce
; the original ROM code (checksum A934H). PA

; MONITOR EQUATES (RESTART INSTRUCTIONS)

_ROUT   EQU     0F7H            ; ROUT - Output char in A
_BLNK   EQU     07BDFH          ; SCAL BLINK - Get input char in A
_INLN   EQU     063DFH          ; SCAL INLIN - Get input line
_MFLP   EQU     05FDFH          ; SCAL MFLP - Toggle tape drv LED
_MRET   EQU     05BDFH          ; SCAL MRET - Return to monitor
_READ   EQU     052DFH          ; SCAL READ
_RIN    EQU     062DFH          ; SCAL RIN - Scan for input char
_VRFY   EQU     056DFH          ; SCAL VERIFY
_WRIT   EQU     057DFH          ; SCAL WRITE

; GENERAL EQUATES

UARTD   EQU     01H             ; UART data port
UARTS   EQU     02H             ; UART status port
CTRLC   EQU     03H             ; Control "C"
CTRLG   EQU     07H             ; Control "G"
BKSP    EQU     08H             ; Back space
LF      EQU     0AH             ; Line feed
CS      EQU     0CH             ; Clear screen
CR      EQU     0DH             ; Carriage return
CTRLO   EQU     0FH             ; Control "O"
CTRLR   EQU     12H             ; Control "R"
CTRLS   EQU     13H             ; Control "S"
CTRLU   EQU     15H             ; Control "U"
CTRLZ   EQU     1AH             ; Control "Z"
ESC     EQU     1BH             ; Escape
TBRK    EQU     1CH             ; "T" monitor break
TBS     EQU     1DH             ; "T" monitor back space
TCS     EQU     1EH             ; "T" monitor clear screen
TCR     EQU     1FH             ; "T" monitor carriage return
DEL     EQU     7FH             ; Delete

; MONITOR LOCATIONS

MONSTT  EQU     0000H           ; Start of monitor
STMON   EQU     000DH           ; NAS-SYS initialisation
MFLP    EQU     0051H           ; Flip tape LED ("T")
MONTYP  EQU     008DH           ; Type of "T" monitor
T2DUMP  EQU     03D1H           ; "T2" Dump routine
T4WR    EQU     0400H           ; "T4" Write routine
T4READ  EQU     070CH           ; "T4" Read routine
VDU     EQU     0800H           ; NASCOM Video RAM base

; MONITOR WORK SPACE LOCATIONS

PORT0   EQU     0C00H           ; Copy of output port 0
ARG1    EQU     0C0CH           ; Argument 1
ARG2    EQU     0C0EH           ; Argument 2
TCUR    EQU     0C18H           ; "T" monitor cursor
CURSOR  EQU     0C29H           ; NAS-SYS Cursor
ARGN    EQU     0C2BH           ; Number of ARGS
TOUT    EQU     0C4AH           ; "T" Output reflection
TIN     EQU     0C4DH           ; "T" Input reflection
CIN     EQU     0C75H           ; NAS-SYS Input table
NMI     EQU     0C7EH           ; NAS-SYS NMI Jump

; BASIC WORK SPACE LOCATIONS

WRKSPC  EQU     1000H           ; BASIC Work space
USR     EQU     1003H           ; "USR (x)" jump
OUTSUB  EQU     1006H           ; "OUT p,n"
OTPORT  EQU     1007H           ; Port (p)
DIVSUP  EQU     1009H           ; Division support routine
DIV1    EQU     100AH           ; <- Values
DIV2    EQU     100EH           ; <-   to
DIV3    EQU     1012H           ; <-   be
DIV4    EQU     1015H           ; <-inserted
SEED    EQU     1017H           ; Random number seed
LSTRND  EQU     103AH           ; Last random number
INPSUB  EQU     103EH           ; #INP (x)" Routine
INPORT  EQU     103FH           ; PORT (x)
NULLS   EQU     1041H           ; Number of nulls
LWIDTH  EQU     1042H           ; Terminal width
COMMAN  EQU     1043H           ; Width for commas
NULFLG  EQU     1044H           ; Null after input byte flag
CTLOFG  EQU     1045H           ; Control "O" flag
LINESC  EQU     1046H           ; Lines counter
LINESN  EQU     1048H           ; Lines number
CHKSUM  EQU     104AH           ; Array load/save check sum
NMIFLG  EQU     104CH           ; Flag for NMI break routine
BRKFLG  EQU     104DH           ; Break flag
RINPUT  EQU     104EH           ; Input reflection
POINT   EQU     1051H           ; "POINT" reflection (unused)
PSET    EQU     1054H           ; "SET"   reflection
RESET   EQU     1057H           ; "RESET" reflection
STRSPC  EQU     105AH           ; Bottom of string space
LINEAT  EQU     105CH           ; Current line number
BASTXT  EQU     105EH           ; Pointer to start of program
BUFFER  EQU     1061H           ; Input buffer
STACK   EQU     1066H           ; Initial stack
CURPOS  EQU     10ABH           ; Character position on line
LCRFLG  EQU     10ACH           ; Locate/Create flag
TYPE    EQU     10ADH           ; Data type flag
DATFLG  EQU     10AEH           ; Literal statement flag
LSTRAM  EQU     10AFH           ; Last available RAM
TMSTPT  EQU     10B1H           ; Temporary string pointer
TMSTPL  EQU     10B3H           ; Temporary string pool
TMPSTR  EQU     10BFH           ; Temporary string
STRBOT  EQU     10C3H           ; Bottom of string space
CUROPR  EQU     10C5H           ; Current operator in EVAL
LOOPST  EQU     10C7H           ; First statement of loop
DATLIN  EQU     10C9H           ; Line of current DATA item
FORFLG  EQU     10CBH           ; "FOR" loop flag
LSTBIN  EQU     10CCH           ; Last byte entered
READFG  EQU     10CDH           ; Read/Input flag
BRKLIN  EQU     10CEH           ; Line of break
NXTOPR  EQU     10D0H           ; Next operator in EVAL
ERRLIN  EQU     10D2H           ; Line of error
CONTAD  EQU     10D4H           ; Where to CONTinue
PROGND  EQU     10D6H           ; End of program
VAREND  EQU     10D8H           ; End of variables
ARREND  EQU     10DAH           ; End of arrays
NXTDAT  EQU     10DCH           ; Next data item
FNRGNM  EQU     10DEH           ; Name of FN argument
FNARG   EQU     10E0H           ; FN argument value
FPREG   EQU     10E4H           ; Floating point register
FPEXP   EQU     FPREG+3         ; Floating point exponent
SGNRES  EQU     10E8H           ; Sign of result
PBUFF   EQU     10E9H           ; Number print buffer
MULVAL  EQU     10F6H           ; Multiplier
PROGST  EQU     10F9H           ; Start of program text area
STLOOK  EQU     115DH           ; Start of memory test

; BASIC ERROR CODE VALUES

NF      EQU     00H             ; NEXT without FOR
SN      EQU     02H             ; Syntax error
RG      EQU     04H             ; RETURN without GOSUB
OD      EQU     06H             ; Out of DATA
FC      EQU     08H             ; Function call error
OV      EQU     0AH             ; Overflow
OM      EQU     0CH             ; Out of memory
UL      EQU     0EH             ; Undefined line number
BS      EQU     10H             ; Bad subscript
DD      EQU     12H             ; Re-DIMensioned array
DZ      EQU     14H             ; Division by zero (/0)
ID      EQU     16H             ; Illegal direct
TM      EQU     18H             ; Type miss-match
OS      EQU     1AH             ; Out of string space
LS      EQU     1CH             ; String too long
ST      EQU     1EH             ; String formula too complex
CN      EQU     20H             ; Can't CONTinue
UF      EQU     22H             ; UnDEFined FN function
MO      EQU     24H             ; Missing operand

        ORG     0E000H

START:  JP      STARTB          ; Jump for restart jump
STARTB: DI                      ; No interrupts
        LD      IX,0            ; Flag cold start
        JP      CSTART          ; Jump to initialise

        DW      DEINT           ; Get integer -32768 to 32767
        DW      ABPASS          ; Return integer in AB

        JP      LDNMI1          ; << NO REFERENCE TO HERE >>

CSTART: LD      HL,WRKSPC       ; Start of workspace RAM
        LD      SP,HL           ; Set up a temporary stack
        JP      INITST          ; Go to initialise

INIT:   LD      DE,INITAB       ; Initialise workspace
        LD      B,INITBE-INITAB+3; Bytes to copy
        LD      HL,WRKSPC       ; Into workspace RAM
COPY:   LD      A,(DE)          ; Get source
        LD      (HL),A          ; To destination
        INC     HL              ; Next destination
        INC     DE              ; Next source
        DEC     B               ; Count bytes
        JP      NZ,COPY         ; More to move
        LD      SP,HL           ; Temporary stack
        CALL    CLREG           ; Clear registers and stack
        CALL    PRNTCR          ; Output CRLF
        LD      (BUFFER+72+1),A ; Mark end of buffer
        LD      (PROGST),A      ; Initialise program area
MSIZE:  LD      HL,MEMMSG       ; Point to message
        CALL    PRS             ; Output "Memory size"
        CALL    PROMPT          ; Get input with "?"
        CALL    GETCHR          ; Get next character
        OR      A               ; Set flags
        JP      NZ,TSTMEM       ; If number - Test if RAM there
        LD      HL,STLOOK       ; Point to start of RAM
MLOOP:  INC     HL              ; Next byte
        LD      A,H             ; Above address FFFF ?
        OR      L
        JP      Z,SETTOP        ; Yes - 64K RAM
        LD      A,(HL)          ; Get contents
        LD      B,A             ; Save it
        CPL                     ; Flip all bits
        LD      (HL),A          ; Put it back
        CP      (HL)            ; RAM there if same
        LD      (HL),B          ; Restore old contents
        JP      Z,MLOOP         ; If RAM - test next byte
        JP      SETTOP          ; Top of RAM found

TSTMEM: CALL    ATOH            ; Get high memory into DE
        OR      A               ; Set flags on last byte
        JP      NZ,SNERR        ; ?SN Error if bad character
        EX      DE,HL           ; Address into HL
        DEC     HL              ; Back one byte
        LD      A,11011001B     ; Test byte
        LD      B,(HL)          ; Get old contents
        LD      (HL),A          ; Load test byte
        CP      (HL)            ; RAM there if same
        LD      (HL),B          ; Restore old contents
        JP      NZ,MSIZE        ; Ask again if no RAM

SETTOP: DEC     HL              ; Back one byte
        LD      DE,STLOOK-1     ; See if enough RAM
        CALL    CPDEHL          ; Compare DE with HL
        JP      C,MSIZE         ; Ask again if not enough RAM
        NOP
        NOP
        NOP
        NOP
        NOP
        NOP
        NOP
        NOP
        NOP
        LD      DE,0-50         ; 50 Bytes string space
        LD      (LSTRAM),HL     ; Save last available RAM
        ADD     HL,DE           ; Allocate string space
        LD      (STRSPC),HL     ; Save string space
        CALL    CLRPTR          ; Clear program area
        LD      HL,(STRSPC)     ; Get end of memory
        LD      DE,0-17         ; Offset for free bytes
        ADD     HL,DE           ; Adjust HL
        LD      DE,PROGST       ; Start of program text
        LD      A,L             ; Get LSB
        SUB     E               ; Adjust it
        LD      L,A             ; Re-save
        LD      A,H             ; Get MSB
        SBC     A,D             ; Adjust it
        LD      H,A             ; Re-save
        PUSH    HL              ; Save bytes free
        LD      HL,SIGNON       ; Sign-on message
        CALL    PRS             ; Output string
        POP     HL              ; Get bytes free back
        CALL    PRNTHL          ; Output amount of free memory
        LD      HL,BFREE        ; " Bytes free" message
        CALL    PRS             ; Output string

WARMST: LD      SP,STACK        ; Temporary stack
BRKRET: CALL    CLREG           ; Clear registers and stack
        JP      PRNTOK          ; Go to get command line

BFREE:  DB      " Bytes free",CR,0,0

SIGNON: DB      "NASCOM ROM BASIC Ver 4.7   ",CR
        DB      "Copyright (C) 1978 by Microsoft",CR,0,0

MEMMSG: DB      "Memory size",0

; FUNCTION ADDRESS TABLE

FNCTAB: DW      SGN
        DW      INT
        DW      ABS
        DW      USR
        DW      FRE
        DW      INP
        DW      POS
        DW      SQR
        DW      RND
        DW      LOG
        DW      EXP
        DW      COS
        DW      SIN
        DW      TAN
        DW      ATN
        DW      PEEK
        DW      DEEK
        DW      POINT
        DW      LEN
        DW      STR
        DW      VAL
        DW      ASC
        DW      CHR
        DW      LEFT
        DW      RIGHT
        DW      MID

; RESERVED WORD LIST

WORDS:  DB      "E"+80H,"ND"
        DB      "F"+80H,"OR"
        DB      "N"+80H,"EXT"
        DB      "D"+80H,"ATA"
        DB      "I"+80H,"NPUT"
        DB      "D"+80H,"IM"
        DB      "R"+80H,"EAD"
        DB      "L"+80H,"ET"
        DB      "G"+80H,"OTO"
        DB      "R"+80H,"UN"
        DB      "I"+80H,"F"
        DB      "R"+80H,"ESTORE"
        DB      "G"+80H,"OSUB"
        DB      "R"+80H,"ETURN"
        DB      "R"+80H,"EM"
        DB      "S"+80H,"TOP"
        DB      "O"+80H,"UT"
        DB      "O"+80H,"N"
        DB      "N"+80H,"ULL"
        DB      "W"+80H,"AIT"
        DB      "D"+80H,"EF"
        DB      "P"+80H,"OKE"
        DB      "D"+80H,"OKE"
        DB      "S"+80H,"CREEN"
        DB      "L"+80H,"INES"
        DB      "C"+80H,"LS"
        DB      "W"+80H,"IDTH"
        DB      "M"+80H,"ONITOR"
        DB      "S"+80H,"ET"
        DB      "R"+80H,"ESET"
        DB      "P"+80H,"RINT"
        DB      "C"+80H,"ONT"
        DB      "L"+80H,"IST"
        DB      "C"+80H,"LEAR"
        DB      "C"+80H,"LOAD"
        DB      "C"+80H,"SAVE"
        DB      "N"+80H,"EW"
        DB      "T"+80H,"AB("
        DB      "T"+80H,"O"
        DB      "F"+80H,"N"
        DB      "S"+80H,"PC("
        DB      "T"+80H,"HEN"
        DB      "N"+80H,"OT"
        DB      "S"+80H,"TEP"

        DB      "+"+80H
        DB      "-"+80H
        DB      "*"+80H
        DB      "/"+80H
        DB      "^"+80H
        DB      "A"+80H,"ND"
        DB      "O"+80H,"R"
        DB      ">"+80H
        DB      "="+80H
        DB      "<"+80H

        DB      "S"+80H,"GN"
        DB      "I"+80H,"NT"
        DB      "A"+80H,"BS"
        DB      "U"+80H,"SR"
        DB      "F"+80H,"RE"
        DB      "I"+80H,"NP"
        DB      "P"+80H,"OS"
        DB      "S"+80H,"QR"
        DB      "R"+80H,"ND"
        DB      "L"+80H,"OG"
        DB      "E"+80H,"XP"
        DB      "C"+80H,"OS"
        DB      "S"+80H,"IN"
        DB      "T"+80H,"AN"
        DB      "A"+80H,"TN"
        DB      "P"+80H,"EEK"
        DB      "D"+80H,"EEK"
        DB      "P"+80H,"OINT"
        DB      "L"+80H,"EN"
        DB      "S"+80H,"TR$"
        DB      "V"+80H,"AL"
        DB      "A"+80H,"SC"
        DB      "C"+80H,"HR$"
        DB      "L"+80H,"EFT$"
        DB      "R"+80H,"IGHT$"
        DB      "M"+80H,"ID$"
        DB      80H             ; End of list marker

; KEYWORD ADDRESS TABLE

WORDTB: DW      PEND
        DW      FOR
        DW      NEXT
        DW      DATA
        DW      INPUT
        DW      DIM
        DW      READ
        DW      LET
        DW      GOTO
        DW      RUN
        DW      IF
        DW      RESTOR
        DW      GOSUB
        DW      RETURN
        DW      REM
        DW      STOP
        DW      POUT
        DW      ON
        DW      NULL
        DW      WAIT
        DW      DEF
        DW      POKE
        DW      DOKE
        DW      SCREEN
        DW      LINES
        DW      CLS
        DW      WIDTH
        DW      MONITR
        DW      PSET
        DW      RESET
        DW      PRINT
        DW      CONT
        DW      LIST
        DW      CLEAR
        DW      CLOAD
        DW      CSAVE
        DW      NEW

; RESERVED WORD TOKEN VALUES

ZEND    EQU     080H            ; END
ZFOR    EQU     081H            ; FOR
ZDATA   EQU     083H            ; DATA
ZGOTO   EQU     088H            ; GOTO
ZGOSUB  EQU     08CH            ; GOSUB
ZREM    EQU     08EH            ; REM
ZPRINT  EQU     09EH            ; PRINT
ZNEW    EQU     0A4H            ; NEW

ZTAB    EQU     0A5H            ; TAB
ZTO     EQU     0A6H            ; TO
ZFN     EQU     0A7H            ; FN
ZSPC    EQU     0A8H            ; SPC
ZTHEN   EQU     0A9H            ; THEN
ZNOT    EQU     0AAH            ; NOT
ZSTEP   EQU     0ABH            ; STEP

ZPLUS   EQU     0ACH            ; +
ZMINUS  EQU     0ADH            ; -
ZTIMES  EQU     0AEH            ; *
ZDIV    EQU     0AFH            ; /
ZOR     EQU     0B2H            ; OR
ZGTR    EQU     0B3H            ; >
ZEQUAL  EQU     0B4H            ; M
ZLTH    EQU     0B5H            ; <
ZSGN    EQU     0B6H            ; SGN
ZPOINT  EQU     0C7H            ; POINT
ZLEFT   EQU     0CDH            ; LEFT$

; ARITHMETIC PRECEDENCE TABLE

PRITAB: DB      79H             ; Precedence value
        DW      PADD            ; FPREG = <last> + FPREG

        DB      79H             ; Precedence value
        DW      PSUB            ; FPREG = <last> - FPREG

        DB      7CH             ; Precedence value
        DW      MULT            ; PPREG = <last> * FPREG

        DB      7CH             ; Precedence value
        DW      DIV             ; FPREG = <last> / FPREG

        DB      7FH             ; Precedence value
        DW      POWER           ; FPREG = <last> ^ FPREG

        DB      50H             ; Precedence value
        DW      PAND            ; FPREG = <last> AND FPREG

        DB      46H             ; Precedence value
        DW      POR             ; FPREG = <last> OR FPREG

; BASIC ERROR CODE LIST

ERRORS: DB      "NF"            ; NEXT without FOR
        DB      "SN"            ; Syntax error
        DB      "RG"            ; RETURN without GOSUB
        DB      "OD"            ; Out of DATA
        DB      "FC"            ; Illegal function call
        DB      "OV"            ; Overflow error
        DB      "OM"            ; Out of memory
        DB      "UL"            ; Undefined line
        DB      "BS"            ; Bad subscript
        DB      "DD"            ; Re-DIMensioned array
        DB      "/0"            ; Division by zero
        DB      "ID"            ; Illegal direct
        DB      "TM"            ; Type mis-match
        DB      "OS"            ; Out of string space
        DB      "LS"            ; String too long
        DB      "ST"            ; String formula too complex
        DB      "CN"            ; Can't CONTinue
        DB      "UF"            ; Undefined FN function
        DB      "MO"            ; Missing operand

; INITIALISATION TABLE

INITAB: JP      WARMST          ; Warm start jump
        JP      FCERR           ; "USR (X)" jump (Set to Error)

        OUT     (0),A           ; "OUT p,n" skeleton
        RET

        SUB     0               ; Division support routine
        LD      L,A
        LD      A,H
        SBC     A,0
        LD      H,A
        LD      A,B
        SBC     A,0
        LD      B,A
        LD      A,0
        RET

        DB      0,0,0                   ; Random number seed
                                        ; Table used by RND
        DB      035H,04AH,0CAH,099H     ;-2.65145E+07
        DB      039H,01CH,076H,098H     ; 1.61291E+07
        DB      022H,095H,0B3H,098H     ;-1.17691E+07
        DB      00AH,0DDH,047H,098H     ; 1.30983E+07
        DB      053H,0D1H,099H,099H     ;-2-01612E+07
        DB      00AH,01AH,09FH,098H     ;-1.04269E+07
        DB      065H,0BCH,0CDH,098H     ;-1.34831E+07
        DB      0D6H,077H,03EH,098H     ; 1.24825E+07
        DB      052H,0C7H,04FH,080H     ; Last random number

        IN      A,(0)           ; INP (x) skeleton
        RET

        DB      1               ; POS (x) number (1)
        DB      47              ; Terminal width (47)
        DB      28              ; Width for commas (3 columns)
        DB      0               ; No nulls after input bytes
        DB      0               ; Output enabled (^O off)

        DW      5               ; Initial lines counter
        DW      5               ; Initial lines number
        DW      0               ; Array load/save check sum

        DB      0               ; Break not by NMI
        DB      0               ; Break flag

        JP      TTYLIN          ; Input reflection (set to TTY)
        JP      POINTB          ; POINT reflection unused
        JP      SETB            ; SET reflection
        JP      RESETB          ; RESET reflection

        DW      STLOOK          ; Temp string space
        DW      -2              ; Current line number (cold)
        DW      PROGST+1        ; Start of program text
INITBE:                         ; END OF INITIALISATION TABLE

ERRMSG: DB      " Error",0
INMSG:  DB      " in ",0
ZERBYT  EQU     $-1             ; A zero byte
OKMSG:  DB      "Ok",CR,0,0
BRKMSG: DB      "Break",0

BAKSTK: LD      HL,4            ; Look for "FOR" block with
        ADD     HL,SP           ; same index as specified
LOKFOR: LD      A,(HL)          ; Get block ID
        INC     HL              ; Point to index address
        CP      ZFOR            ; Is it a "FOR" token
        RET     NZ              ; No - exit
        LD      C,(HL)          ; BC = Address of "FOR" index
        INC     HL
        LD      B,(HL)
        INC     HL              ; Point to sign of STEP
        PUSH    HL              ; Save pointer to sign
        LD      L,C             ; HL = address of "FOR" index
        LD      H,B
        LD      A,D             ; See if an index was specified
        OR      E               ; DE = 0 if no index specified
        EX      DE,HL           ; Specified index into HL
        JP      Z,INDFND        ; Skip if no index given
        EX      DE,HL           ; Index back into DE
        CALL    CPDEHL          ; Compare index with one given
INDFND: LD      BC,16-3         ; Offset to next block
        POP     HL              ; Restore pointer to sign
        RET     Z               ; Return if block found
        ADD     HL,BC           ; Point to next block
        JP      LOKFOR          ; Keep on looking

MOVUP:  CALL    ENFMEM          ; See if enough memory
MOVSTR: PUSH    BC              ; Save end of source
        EX      (SP),HL         ; Swap source and dest" end
        POP     BC              ; Get end of destination
MOVLP:  CALL    CPDEHL          ; See if list moved
        LD      A,(HL)          ; Get byte
        LD      (BC),A          ; Move it
        RET     Z               ; Exit if all done
        DEC     BC              ; Next byte to move to
        DEC     HL              ; Next byte to move
        JP      MOVLP           ; Loop until all bytes moved

CHKSTK: PUSH    HL              ; Save code string address
        LD      HL,(ARREND)     ; Lowest free memory
        LD      B,0             ; BC = Number of levels to test
        ADD     HL,BC           ; 2 Bytes for each level
        ADD     HL,BC
        DB      3EH             ; Skip "PUSH HL"
ENFMEM: PUSH    HL              ; Save code string address
        LD      A,LOW -48       ; 48 Bytes minimum RAM
        SUB     L
        LD      L,A
        LD      A,HIGH -48      ; 48 Bytes minimum RAM
        SBC     A,H
        JP      C,OMERR         ; Not enough - ?OM Error
        LD      H,A
        ADD     HL,SP           ; Test if stack is overflowed
        POP     HL              ; Restore code string address
        RET     C               ; Return if enough mmory
OMERR:  LD      E,OM            ; ?OM Error
        JP      ERROR

DATSNR: LD      HL,(DATLIN)     ; Get line of current DATA item
        LD      (LINEAT),HL     ; Save as current line
SNERR:  LD      E,SN            ; ?SN Error
        DB      01H             ; Skip "LD E,DZ"
DZERR:  LD      E,DZ            ; ?/0 Error
        DB      01H             ; Skip "LD E,NF"
NFERR:  LD      E,NF            ; ?NF Error
        DB      01H             ; Skip "LD E,DD"
DDERR:  LD      E,DD            ; ?DD Error
        DB      01H             ; Skip "LD E,UF"
UFERR:  LD      E,UF            ; ?UF Error
        DB      01H             ; Skip "LD E,OV
OVERR:  LD      E,OV            ; ?OV Error
        DB      01H             ; Skip "LD E,TM"
TMERR:  LD      E,TM            ; ?TM Error

ERROR:  CALL    CLREG           ; Clear registers and stack
        LD      (CTLOFG),A      ; Enable output (A is 0)
        CALL    STTLIN          ; Start new line
        LD      HL,ERRORS       ; Point to error codes
        LD      D,A             ; D = 0 (A is 0)
        LD      A,"?"
        CALL    OUTC            ; Output "?"
        ADD     HL,DE           ; Offset to correct error code
        LD      A,(HL)          ; First character
        CALL    OUTC            ; Output it
        CALL    GETCHR          ; Get next character
        CALL    OUTC            ; Output it
        LD      HL,ERRMSG       ; "Error" message
ERRIN:  CALL    PRS             ; Output message
        LD      HL,(LINEAT)     ; Get line of error
        LD      DE,-2           ; Cold start error if -2
        CALL    CPDEHL          ; See if cold start error
        JP      Z,CSTART        ; Cold start error - Restart
        LD      A,H             ; Was it a direct error?
        AND     L               ; Line = -1 if direct error
        INC     A
        CALL    NZ,LINEIN       ; No - output line of error
        DB      3EH             ; Skip "POP BC"
POPNOK: POP     BC              ; Drop address in input buffer

PRNTOK: XOR     A               ; Output "Ok" and get command
        LD      (CTLOFG),A      ; Enable output
        CALL    STTLIN          ; Start new line
        LD      HL,OKMSG        ; "Ok" message
        CALL    PRS             ; Output "Ok"
GETCMD: LD      HL,-1           ; Flag direct mode
        LD      (LINEAT),HL     ; Save as current line
        CALL    GETLIN          ; Get an input line
        JP      C,GETCMD        ; Get line again if break
        CALL    GETCHR          ; Get first character
        INC     A               ; Test if end of line
        DEC     A               ; Without affecting Carry
        JP      Z,GETCMD        ; Nothing entered - Get another
        PUSH    AF              ; Save Carry status
        CALL    ATOH            ; Get line number into DE
        PUSH    DE              ; Save line number
        CALL    CRUNCH          ; Tokenise rest of line
        LD      B,A             ; Length of tokenised line
        POP     DE              ; Restore line number
        POP     AF              ; Restore Carry
        JP      NC,EXCUTE       ; No line number - Direct mode
        PUSH    DE              ; Save line number
        PUSH    BC              ; Save length of tokenised line
        XOR     A
        LD      (LSTBIN),A      ; Clear last byte input
        CALL    GETCHR          ; Get next character
        OR      A               ; Set flags
        PUSH    AF              ; And save them
        CALL    SRCHLN          ; Search for line number in DE
        JP      C,LINFND        ; Jump if line found
        POP     AF              ; Get status
        PUSH    AF              ; And re-save
        JP      Z,ULERR         ; Nothing after number - Error
        OR      A               ; Clear Carry
LINFND: PUSH    BC              ; Save address of line in prog
        JP      NC,INEWLN       ; Line not found - Insert new
        EX      DE,HL           ; Next line address in DE
        LD      HL,(PROGND)     ; End of program
SFTPRG: LD      A,(DE)          ; Shift rest of program down
        LD      (BC),A
        INC     BC              ; Next destination
        INC     DE              ; Next source
        CALL    CPDEHL          ; All done?
        JP      NZ,SFTPRG       ; More to do
        LD      H,B             ; HL - New end of program
        LD      L,C
        LD      (PROGND),HL     ; Update end of program

INEWLN: POP     DE              ; Get address of line,
        POP     AF              ; Get status
        JP      Z,SETPTR        ; No text - Set up pointers
        LD      HL,(PROGND)     ; Get end of program
        EX      (SP),HL         ; Get length of input line
        POP     BC              ; End of program to BC
        ADD     HL,BC           ; Find new end
        PUSH    HL              ; Save new end
        CALL    MOVUP           ; Make space for line
        POP     HL              ; Restore new end
        LD      (PROGND),HL     ; Update end of program pointer
        EX      DE,HL           ; Get line to move up in HL
        LD      (HL),H          ; Save MSB
        POP     DE              ; Get new line number
        INC     HL              ; Skip pointer
        INC     HL
        LD      (HL),E          ; Save LSB of line number
        INC     HL
        LD      (HL),D          ; Save MSB of line number
        INC     HL              ; To first byte in line
        LD      DE,BUFFER       ; Copy buffer to program
MOVBUF: LD      A,(DE)          ; Get source
        LD      (HL),A          ; Save destinations
        INC     HL              ; Next source
        INC     DE              ; Next destination
        OR      A               ; Done?
        JP      NZ,MOVBUF       ; No - Repeat
SETPTR: CALL    RUNFST          ; Set line pointers
        INC     HL              ; To LSB of pointer
        EX      DE,HL           ; Address to DE
PTRLP:  LD      H,D             ; Address to HL
        LD      L,E
        LD      A,(HL)          ; Get LSB of pointer
        INC     HL              ; To MSB of pointer
        OR      (HL)            ; Compare with MSB pointer
        JP      Z,GETCMD        ; Get command line if end
        INC     HL              ; To LSB of line number
        INC     HL              ; Skip line number
        INC     HL              ; Point to first byte in line
        XOR     A               ; Looking for 00 byte
FNDEND: CP      (HL)            ; Found end of line?
        INC     HL              ; Move to next byte
        JP      NZ,FNDEND       ; No - Keep looking
        EX      DE,HL           ; Next line address to HL
        LD      (HL),E          ; Save LSB of pointer
        INC     HL
        LD      (HL),D          ; Save MSB of pointer
        JP      PTRLP           ; Do next line

SRCHLN: LD      HL,(BASTXT)     ; Start of program text
SRCHLP: LD      B,H             ; BC = Address to look at
        LD      C,L
        LD      A,(HL)          ; Get address of next line
        INC     HL
        OR      (HL)            ; End of program found?
        DEC     HL
        RET     Z               ; Yes - Line not found
        INC     HL
        INC     HL
        LD      A,(HL)          ; Get LSB of line number
        INC     HL
        LD      H,(HL)          ; Get MSB of line number
        LD      L,A
        CALL    CPDEHL          ; Compare with line in DE
        LD      H,B             ; HL = Start of this line
        LD      L,C
        LD      A,(HL)          ; Get LSB of next line address
        INC     HL
        LD      H,(HL)          ; Get MSB of next line address
        LD      L,A             ; Next line to HL
        CCF
        RET     Z               ; Lines found - Exit
        CCF
        RET     NC              ; Line not found,at line after
        JP      SRCHLP          ; Keep looking

NEW:    RET     NZ              ; Return if any more on line
CLRPTR: LD      HL,(BASTXT)     ; Point to start of program
        XOR     A               ; Set program area to empty
        LD      (HL),A          ; Save LSB = 00
        INC     HL
        LD      (HL),A          ; Save MSB = 00
        INC     HL
        LD      (PROGND),HL     ; Set program end

RUNFST: LD      HL,(BASTXT)     ; Clear all variables
        DEC     HL

INTVAR: LD      (BRKLIN),HL     ; Initialise RUN variables
        LD      HL,(LSTRAM)     ; Get end of RAM
        LD      (STRBOT),HL     ; Clear string space
        XOR     A
        CALL    RESTOR          ; Reset DATA pointers
        LD      HL,(PROGND)     ; Get end of program
        LD      (VAREND),HL     ; Clear variables
        LD      (ARREND),HL     ; Clear arrays

CLREG:  POP     BC              ; Save return address
        LD      HL,(STRSPC)     ; Get end of working RAN
        LD      SP,HL           ; Set stack
        LD      HL,TMSTPL       ; Temporary string pool
        LD      (TMSTPT),HL     ; Reset temporary string ptr
        XOR     A               ; A = 00
        LD      L,A             ; HL = 0000
        LD      H,A
        LD      (CONTAD),HL     ; No CONTinue
        LD      (FORFLG),A      ; Clear FOR flag
        LD      (FNRGNM),HL     ; Clear FN argument
        PUSH    HL              ; HL = 0000
        PUSH    BC              ; Put back return
DOAGN:  LD      HL,(BRKLIN)     ; Get address of code to RUN
        RET                     ; Return to execution driver

PROMPT: LD      A,"?"           ; "?"
        CALL    OUTC            ; Output character
        LD      A," "           ; Space
        CALL    OUTC            ; Output character
        JP      RINPUT          ; Get input line

CRUNCH: XOR     A               ; Tokenise line @ HL to BUFFER
        LD      (DATFLG),A      ; Reset literal flag
        LD      C,2+3           ; 2 byte number and 3 nulls
        LD      DE,BUFFER       ; Start of input buffer
CRNCLP: LD      A,(HL)          ; Get byte
        CP      " "             ; Is it a space?
        JP      Z,MOVDIR        ; Yes - Copy direct
        LD      B,A             ; Save character
        CP      '"'             ; Is it a quote?
        JP      Z,CPYLIT        ; Yes - Copy literal string
        OR      A               ; Is it end of buffer?
        JP      Z,ENDBUF        ; Yes - End buffer
        LD      A,(DATFLG)      ; Get data type
        OR      A               ; Literal?
        LD      A,(HL)          ; Get byte to copy
        JP      NZ,MOVDIR       ; Literal - Copy direct
        CP      "?"             ; Is it "?" short for PRINT
        LD      A,ZPRINT        ; "PRINT" token
        JP      Z,MOVDIR        ; Yes - replace it
        LD      A,(HL)          ; Get byte again
        CP      "0"             ; Is it less than "0"
        JP      C,FNDWRD        ; Yes - Look for reserved words
        CP      ";"+1           ; Is it "0123456789:;" ?
        JP      C,MOVDIR        ; Yes - copy it direct
FNDWRD: PUSH    DE              ; Look for reserved words
        LD      DE,WORDS-1      ; Point to table
        PUSH    BC              ; Save count
        LD      BC,RETNAD       ; Where to return to
        PUSH    BC              ; Save return address
        LD      B,ZEND-1        ; First token value -1
        LD      A,(HL)          ; Get byte
        CP      "a"             ; Less than "a" ?
        JP      C,SEARCH        ; Yes - search for words
        CP      "z"+1           ; Greater than "z" ?
        JP      NC,SEARCH       ; Yes - search for words
        AND     01011111B       ; Force upper case
        LD      (HL),A          ; Replace byte
SEARCH: LD      C,(HL)          ; Search for a word
        EX      DE,HL
GETNXT: INC     HL              ; Get next reserved word
        OR      (HL)            ; Start of word?
        JP      P,GETNXT        ; No - move on
        INC     B               ; Increment token value
        LD      A, (HL)         ; Get byte from table
        AND     01111111B       ; Strip bit 7
        RET     Z               ; Return if end of list
        CP      C               ; Same character as in buffer?
        JP      NZ,GETNXT       ; No - get next word
        EX      DE,HL
        PUSH    HL              ; Save start of word

NXTBYT: INC     DE              ; Look through rest of word
        LD      A,(DE)          ; Get byte from table
        OR      A               ; End of word ?
        JP      M,MATCH         ; Yes - Match found
        LD      C,A             ; Save it
        LD      A,B             ; Get token value
        CP      ZGOTO           ; Is it "GOTO" token ?
        JP      NZ,NOSPC        ; No - Don't allow spaces
        CALL    GETCHR          ; Get next character
        DEC     HL              ; Cancel increment from GETCHR
NOSPC:  INC     HL              ; Next byte
        LD      A,(HL)          ; Get byte
        CP      "a"             ; Less than "a" ?
        JP      C,NOCHNG        ; Yes - don't change
        AND     01011111B       ; Make upper case
NOCHNG: CP      C               ; Same as in buffer ?
        JP      Z,NXTBYT        ; Yes - keep testing
        POP     HL              ; Get back start of word
        JP      SEARCH          ; Look at next word

MATCH:  LD      C,B             ; Word found - Save token value
        POP     AF              ; Throw away return
        EX      DE,HL
        RET                     ; Return to "RETNAD"
RETNAD: EX      DE,HL           ; Get address in string
        LD      A,C             ; Get token value
        POP     BC              ; Restore buffer length
        POP     DE              ; Get destination address
MOVDIR: INC     HL              ; Next source in buffer
        LD      (DE),A          ; Put byte in buffer
        INC     DE              ; Move up buffer
        INC     C               ; Increment length of buffer
        SUB     ":"             ; End of statement?
        JP      Z,SETLIT        ; Jump if multi-statement line
        CP      ZDATA-3AH       ; Is it DATA statement ?
        JP      NZ,TSTREM       ; No - see if REM
SETLIT: LD      (DATFLG),A      ; Set literal flag
TSTREM: SUB     ZREM-3AH        ; Is it REM?
        JP      NZ,CRNCLP       ; No - Leave flag
        LD      B,A             ; Copy rest of buffer
NXTCHR: LD      A,(HL)          ; Get byte
        OR      A               ; End of line ?
        JP      Z,ENDBUF        ; Yes - Terminate buffer
        CP      B               ; End of statement ?
        JP      Z,MOVDIR        ; Yes - Get next one
CPYLIT: INC     HL              ; Move up source string
        LD      (DE),A          ; Save in destination
        INC     C               ; Increment length
        INC     DE              ; Move up destination
        JP      NXTCHR          ; Repeat

ENDBUF: LD      HL,BUFFER-1     ; Point to start of buffer
        LD      (DE),A          ; Mark end of buffer (A = 00)
        INC     DE
        LD      (DE),A          ; A = 00
        INC     DE
        LD      (DE),A          ; A = 00
        RET

DODEL:  LD      A,(NULFLG)      ; Get null flag status
        OR      A               ; Is it zero?
        LD      A,0             ; Zero A - Leave flags
        LD      (NULFLG),A      ; Zero null flag
        JP      NZ,ECHDEL       ; Set - Echo it
        DEC     B               ; Decrement length
        JP      Z,GETLIN        ; Get line again if empty
        CALL    OUTC            ; Output null character
        DB      3EH             ; Skip "DEC B"
ECHDEL: DEC     B               ; Count bytes in buffer
        DEC     HL              ; Back space buffer
        JP      Z,OTKLN         ; No buffer - Try again
        LD      A,(HL)          ; Get deleted byte
        CALL    OUTC            ; Echo it
        JP      MORINP          ; Get more input

DELCHR: DEC     B               ; Count bytes in buffer
        DEC     HL              ; Back space buffer
        CALL    OUTC            ; Output character in A
        JP      NZ,MORINP       ; Not end - Get more
OTKLN:  CALL    OUTC            ; Output character in A
KILIN:  CALL    PRNTCR          ; Output CRLF
        JP      TTYLIN          ; Get line again

GETLIN: CALL    MONTST          ; Is it NAS-SYS?
        JP      Z,TTYLIN        ; No - Character input
        LD      HL,(CIN)        ; Point to NAS-SYS input table
        LD      A,(HL)          ; Get input mode
        CP      74H             ; Is it "X" mode?
        JP      Z,TTYLIN        ; Yes - Teletype line input
        CALL    INLINE          ; Get a line from NAS-SYS
        JP      DONULL          ; POS(X)=0 and do nulls

TTYLIN: LD      HL,BUFFER       ; Get a line by character
        LD      B,1             ; Set buffer as empty
        XOR     A
        LD      (NULFLG),A      ; Clear null flag
MORINP: CALL    CLOTST          ; Get character and test ^O
        LD      C,A             ; Save character in C
        CP      DEL             ; Delete character?
        JP      Z,DODEL         ; Yes - Process it
        LD      A,(NULFLG)      ; Get null flag
        OR      A               ; Test null flag status
        JP      Z,PROCES        ; Reset - Process character
        LD      A,0             ; Set a null
        CALL    OUTC            ; Output null
        XOR     A               ; Clear A
        LD      (NULFLG),A      ; Reset null flag
PROCES: LD      A,C             ; Get character
        CP      CTRLG           ; Bell?
        JP      Z,PUTCTL        ; Yes - Save it
        CP      CTRLC           ; Is it control "C"?
        CALL    Z,PRNTCR        ; Yes - Output CRLF
        SCF                     ; Flag break
        RET     Z               ; Return if control "C"
        CP      CR              ; Is it enter?
        JP      Z,ENDINP        ; Yes - Terminate input
        CP      CTRLU           ; Is it control "U"?
        JP      Z,KILIN         ; Yes - Get another line
        CP      "@"             ; Is it "kill line"?
        JP      Z,OTKLN         ; Yes - Kill line
        CP      "_"             ; Is it delete?
        JP      Z,DELCHR        ; Yes - Delete character
        CP      BKSP            ; Is it backspace?
        JP      Z,DELCHR        ; Yes - Delete character
        CP      CTRLR           ; Is it control "R"?
        JP      NZ,PUTBUF       ; No - Put in buffer
        PUSH    BC              ; Save buffer length
        PUSH    DE              ; Save DE
        PUSH    HL              ; Save buffer address
        LD      (HL),0          ; Mark end of buffer
        CALL    OUTNCR          ; Output and do CRLF
        LD      HL,BUFFER       ; Point to buffer start
        CALL    PRS             ; Output buffer
        POP     HL              ; Restore buffer address
        POP     DE              ; Restore DE
        POP     BC              ; Restore buffer length
        JP      MORINP          ; Get another character

PUTBUF: CP      " "             ; Is it a control code?
        JP      C,MORINP        ; Yes - Ignore
PUTCTL: LD      A,B             ; Get number of bytes in buffer
        CP      72+1            ; Test for line overflow
        LD      A,CTRLG         ; Set a bell
        JP      NC,OUTNBS       ; Ring bell if buffer full
        LD      A,C             ; Get character
        LD      (HL),C          ; Save in buffer
        LD      (LSTBIN),A      ; Save last input byte
        INC     HL              ; Move up buffer
        INC     B               ; Increment length
OUTIT:  CALL    OUTC            ; Output the character entered
        JP      MORINP          ; Get another character

OUTNBS: CALL    OUTC            ; Output bell and back over it
        LD      A,BKSP          ; Set back space
        JP      OUTIT           ; Output it and get more

CPDEHL: LD      A,H             ; Get H
        SUB     D               ; Compare with D
        RET     NZ              ; Different - Exit
        LD      A,L             ; Get L
        SUB     E               ; Compare with E
        RET                     ; Return status

CHKSYN: LD      A,(HL)          ; Check syntax of character
        EX      (SP),HL         ; Address of test byte
        CP      (HL)            ; Same as in code string?
        INC     HL              ; Return address
        EX      (SP),HL         ; Put it back
        JP      Z,GETCHR        ; Yes - Get next character
        JP      SNERR           ; Different - ?SN Error

OUTC:   PUSH    AF              ; Save character
        LD      A,(CTLOFG)      ; Get control "O" flag
        OR      A               ; Is it set?
        JP      NZ,POPAF        ; Yes - don't output
        POP     AF              ; Restore character
        PUSH    BC              ; Save buffer length
        PUSH    AF              ; Save character
        CP      " "             ; Is it a control code?
        JP      C,DINPOS        ; Yes - Don't INC POS(X)
        LD      A,(LWIDTH)      ; Get line width
        LD      B,A             ; To B
        LD      A,(CURPOS)      ; Get cursor position
        INC     B               ; Width 255?
        JP      Z,INCLEN        ; Yes - No width limit
        DEC     B               ; Restore width
        CP      B               ; At end of line?
        CALL    Z,PRNTCR        ; Yes - output CRLF
INCLEN: INC     A               ; Move on one character
        LD      (CURPOS),A      ; Save new position
DINPOS: POP     AF              ; Restore character
        POP     BC              ; Restore buffer length
        PUSH    AF              ; << This sequence >>
        POP     AF              ; << is not needed >>
        PUSH    AF              ; Save character
        PUSH    BC              ; Save buffer length
        LD      C,A             ; Character to C
        CALL    CONMON          ; Send it
        POP     BC              ; Restore buffer length
        POP     AF              ; Restore character
        RET

CLOTST: CALL    GETINP          ; Get input character
        AND     01111111B       ; Strip bit 7
        CP      CTRLO           ; Is it control "O"?
        RET     NZ              ; No don't flip flag
        LD      A,(CTLOFG)      ; Get flag
        CPL                     ; Flip it
        LD      (CTLOFG),A      ; Put it back
        XOR     A               ; Null character
        RET

LIST:   CALL    ATOH            ; ASCII number to DE
        RET     NZ              ; Return if anything extra
        POP     BC              ; Rubbish - Not needed
        CALL    SRCHLN          ; Search for line number in DE
        PUSH    BC              ; Save address of line
        CALL    SETLIN          ; Set up lines counter
LISTLP: POP     HL              ; Restore address of line
        LD      C,(HL)          ; Get LSB of next line
        INC     HL
        LD      B,(HL)          ; Get MSB of next line
        INC     HL
        LD      A,B             ; BC = 0 (End of program)?
        OR      C
        JP      Z,PRNTOK        ; Yes - Go to command mode
        CALL    COUNT           ; Count lines
        CALL    TSTBRK          ; Test for break key
        PUSH    BC              ; Save address of next line
        CALL    PRNTCR          ; Output CRLF
        LD      E,(HL)          ; Get LSB of line number
        INC     HL
        LD      D,(HL)          ; Get MSB of line number
        INC     HL
        PUSH    HL              ; Save address of line start
        EX      DE,HL           ; Line number to HL
        CALL    PRNTHL          ; Output line number in decimal
        LD      A," "           ; Space after line number
        POP     HL              ; Restore start of line address
LSTLP2: CALL    OUTC            ; Output character in A
LSTLP3: LD      A,(HL)          ; Get next byte in line
        OR      A               ; End of line?
        INC     HL              ; To next byte in line
        JP      Z,LISTLP        ; Yes - get next line
        JP      P,LSTLP2        ; No token - output it
        SUB     ZEND-1          ; Find and output word
        LD      C,A             ; Token offset+1 to C
        LD      DE,WORDS        ; Reserved word list
FNDTOK: LD      A,(DE)          ; Get character in list
        INC     DE              ; Move on to next
        OR      A               ; Is it start of word?
        JP      P,FNDTOK        ; No - Keep looking for word
        DEC     C               ; Count words
        JP      NZ,FNDTOK       ; Not there - keep looking
OUTWRD: AND     01111111B       ; Strip bit 7
        CALL    OUTC            ; Output first character
        LD      A,(DE)          ; Get next character
        INC     DE              ; Move on to next
        OR      A               ; Is it end of word?
        JP      P,OUTWRD        ; No - output the rest
        JP      LSTLP3          ; Next byte in line

SETLIN: PUSH    HL              ; Set up LINES counter
        LD      HL,(LINESN)     ; Get LINES number
        LD      (LINESC),HL     ; Save in LINES counter
        POP     HL
        RET

LDNMI1: LD      HL,BREAK        ; Break routine
        LD      (NMI),HL        ; NMI forces break
        JP      PRNTOK          ; Go to command mode

        DB      0FEH            ; <<< NO REFERENCE TO HERE >>>

COUNT:  PUSH    HL              ; Save code string address
        PUSH    DE
        LD      HL,(LINESC)     ; Get LINES counter
        LD      DE,-1
        ADC     HL,DE           ; Decrement
        LD      (LINESC),HL     ; Put it back
        POP     DE
        POP     HL              ; Restore code string address
        RET     P               ; Return if more lines to go
        PUSH    HL              ; Save code string address
        LD      HL,(LINESN)     ; Get LINES number
        LD      (LINESC),HL     ; Reset LINES counter
        LD      A,(NMIFLG)      ; Break by NMI?
        OR      A
        JP      NZ,ARETN        ; Yes - "RETN"
        CALL    GETINP          ; Get input character
        CP      CTRLC           ; Is it control "C"?
        JP      Z,RSLNBK        ; Yes - Reset LINES an break
        POP     HL              ; Restore code string address
        JP      COUNT           ; Keep on counting

RSLNBK: LD      HL,(LINESN)     ; Get LINES number
        LD      (LINESC),HL     ; Reset LINES counter
        JP      BRKRET          ; Go and output "Break"

FOR:    LD      A,64H           ; Flag "FOR" assignment
        LD      (FORFLG),A      ; Save "FOR" flag
        CALL    LET             ; Set up initial index
        POP     BC              ; Drop RETurn address
        PUSH    HL              ; Save code string address
        CALL    DATA            ; Get next statement address
        LD      (LOOPST),HL     ; Save it for start of lo6p
        LD      HL,2            ; Offset for "FOR" block
        ADD     HL,SP           ; Point to it
FORSLP: CALL    LOKFOR          ; Look for existing "FOR" block
        POP     DE              ; Get code string address
        JP      NZ,FORFND       ; No nesting found
        ADD     HL,BC           ; Move into "FOR" block
        PUSH    DE              ; Save code string address
        DEC     HL
        LD      D,(HL)          ; Get MSB of loop statement
        DEC     HL
        LD      E,(HL)          ; Get LSB of loop statement
        INC     HL
        INC     HL
        PUSH    HL              ; Save block address
        LD      HL,(LOOPST)     ; Get address of loop statement
        CALL    CPDEHL          ; Compare the FOR loops
        POP     HL              ; Restore block address
        JP      NZ,FORSLP       ; Different FORs - Find another
        POP     DE              ; Restore code string address
        LD      SP,HL           ; Remove all nested loops

FORFND: EX      DE,HL           ; Code string address to HL
        LD      C,8
        CALL    CHKSTK          ; Check for 8 levels of stack
        PUSH    HL              ; Save code string address
        LD      HL,(LOOPST)     ; Get first statement of loop
        EX      (SP),HL         ; Save and restore code string
        PUSH    HL              ; Re-save code string address
        LD      HL,(LINEAT)     ; Get current line number
        EX      (SP),HL         ; Save and restore code string
        CALL    TSTNUM          ; Make sure it's a number
        CALL    CHKSYN          ; Make sure "TO" is next
        DB      ZTO             ; "TO" token
        CALL    GETNUM          ; Get "TO" expression value
        PUSH    HL              ; Save code string address
        CALL    BCDEFP          ; Move "TO" value to BCDE
        POP     HL              ; Restore code string address
        PUSH    BC              ; Save "TO" value in block
        PUSH    DE
        LD      BC,8100H        ; BCDE - 1 (default STEP)
        LD      D,C             ; C=0
        LD      E,D             ; D=0
        LD      A,(HL)          ; Get next byte in code string
        CP      ZSTEP           ; See if "STEP" is stated
        LD      A,1             ; Sign of step = 1
        JP      NZ,SAVSTP       ; No STEP given - Default to 1
        CALL    GETCHR          ; Jump over "STEP" token
        CALL    GETNUM          ; Get step value
        PUSH    HL              ; Save code string address
        CALL    BCDEFP          ; Move STEP to BCDE
        CALL    TSTSGN          ; Test sign of FPREG
        POP     HL              ; Restore code string address
SAVSTP: PUSH    BC              ; Save the STEP value in block
        PUSH    DE
        PUSH    AF              ; Save sign of STEP
        INC     SP              ; Don't save flags
        PUSH    HL              ; Save code string address
        LD      HL,(BRKLIN)     ; Get address of index variable
        EX      (SP),HL         ; Save and restore code string
PUTFID: LD      B,ZFOR          ; "FOR" block marker
        PUSH    BC              ; Save it
        INC     SP              ; Don't save C

RUNCNT: CALL    CHKBRK          ; Execution driver - Test break
        OR      A               ; Break key hit?
        CALL    NZ,STALL        ; Yes - Pause for a key
        LD      (BRKLIN),HL     ; Save code address for break
        LD      A,(HL)          ; Get next byte in code string
        CP      ":"             ; Multi statement line?
        JP      Z,EXCUTE        ; Yes - Execute it
        OR      A               ; End of line?
        JP      NZ,SNERR        ; No - Syntax error
        INC     HL              ; Point to address of next line
        LD      A,(HL)          ; Get LSB of line pointer
        INC     HL
        OR      (HL)            ; Is it zero (End of prog)?
        JP      Z,ENDPRG        ; Yes - Terminate execution
        INC     HL              ; Point to line number
        LD      E,(HL)          ; Get LSB of line number
        INC     HL
        LD      D,(HL)          ; Get MSB of line number
        EX      DE,HL           ; Line number to HL
        LD      (LINEAT),HL     ; Save as current line number
        EX      DE,HL           ; Line number back to DE
EXCUTE: CALL    GETCHR          ; Get key word
        LD      DE,RUNCNT       ; Where to RETurn to
        PUSH    DE              ; Save for RETurn
IFJMP:  RET     Z               ; Go to RUNCNT if end of STMT
ONJMP:  SUB     ZEND            ; Is it a token?
        JP      C,LET           ; No - try to assign it
        CP      ZNEW+1-ZEND     ; END to NEW ?
        JP      NC,SNERR        ; Not a key word - ?SN Error
        RLCA                    ; Double it
        LD      C,A             ; BC = Offset into table
        LD      B,0
        EX      DE,HL           ; Save code string address
        LD      HL,WORDTB       ; Keyword address table
        ADD     HL,BC           ; Point to routine address
        LD      C,(HL)          ; Get LSB of routine address
        INC     HL
        LD      B,(HL)          ; Get MSB of routine address
        PUSH    BC              ; Save routine address
        EX      DE,HL           ; Restore code string address

GETCHR: INC     HL              ; Point to next character
        LD      A,(HL)          ; Get next code string byte
        CP      ":"             ; Z if ":"
        RET     NC              ; NC if > "9"
        CP      " "
        JP      Z,GETCHR        ; Skip over spaces
        CP      "0"
        CCF                     ; NC if < "0"
        INC     A               ; Test for zero - Leave carry
        DEC     A               ; Z if Null
        RET

RESTOR: EX      DE,HL           ; Save code string address
        LD      HL,(BASTXT)     ; Point to start of program
        JP      Z,RESTNL        ; Just RESTORE - reset pointer
        EX      DE,HL           ; Restore code string address
        CALL    ATOH            ; Get line number to DE
        PUSH    HL              ; Save code string address
        CALL    SRCHLN          ; Search for line number in DE
        LD      H,B             ; HL = Address of line
        LD      L,C
        POP     DE              ; Restore code string address
        JP      NC,ULERR        ; ?UL Error if not found
RESTNL: DEC     HL              ; Byte before DATA statement
UPDATA: LD      (NXTDAT),HL     ; Update DATA pointer
        EX      DE,HL           ; Restore code string address
        RET

TSTBRK: CALL    CHKBRK          ; Test for interrupts
        OR      A
        RET     Z               ; Return if no key pressed
STALL:  CALL    CLOTST          ; Get input and test for ^O
        CP      CTRLS           ; Is it control "S"
        CALL    Z,CLOTST        ; Yes - Get another character
        CP      CTRLC           ; Return if not control "C"
STOP:   RET     NZ              ; Exit if anything else
        DB      0F6H            ; Flag "STOP"
PEND:   RET     NZ              ; Exit if anything else
        LD      (BRKLIN),HL     ; Save point of break
        DB      21H             ; Skip "OR 11111111B"
INPBRK: OR      11111111B       ; Flag "Break" wanted
        POP     BC              ; Return not needed and more
ENDPRG: LD      HL,(LINEAT)     ; Get current line number
        PUSH    AF              ; Save STOP / END status
        LD      A,L             ; Is it direct break?
        AND     H
        INC     A               ; Line is -1 if direct break
        JP      Z,NOLIN         ; Yes - No line number
        LD      (ERRLIN),HL     ; Save line of break
        LD      HL,(BRKLIN)     ; Get point of break
        LD      (CONTAD),HL     ; Save point to CONTinue
NOLIN:  XOR     A
        LD      (CTLOFG),A      ; Enable output
        CALL    STTLIN          ; Start a new line
        POP     AF              ; Restore STOP / END status
        LD      HL,BRKMSG       ; "Break" message
        JP      NZ,ERRIN        ; "in line" wanted?
        JP      PRNTOK          ; Go to command mode

CONT:   LD      HL,(CONTAD)     ; Get CONTinue address
        LD      A,H             ; Is it zero?
        OR      L
        LD      E,CN            ; ?CN Error
        JP      Z,ERROR         ; Yes - output "?CN Error"
        EX      DE,HL           ; Save code string address
        LD      HL,(ERRLIN)     ; Get line of last break
        LD      (LINEAT),HL     ; Set up current line number
        EX      DE,HL           ; Restore code string address
        RET                     ; CONTinue where left off

NULL:   CALL    GETINT          ; Get integer 0-255
        RET     NZ              ; Return if bad value
        LD      (NULLS),A       ; Set nulls number
        RET

ARRLD1: LD      B,-1            ; Flag array load
ARRSV1: CALL    GETCHR          ; Skip "*"
        LD      A,B             ; CLOAD* or CSAVE*
        LD      (BRKLIN),A      ; Save it
        LD      A,1             ; It's an array
        LD      (FORFLG),A      ; Flag array name
        CALL    GETVAR          ; Get address of array name
        PUSH    HL              ; Save code string address
        LD      (FORFLG),A      ; Clear flag
        LD      H,B             ; Address of array to HL
        LD      L,C
        DEC     BC              ; Back space
        DEC     BC              ;  to point
        DEC     BC              ;  to the
        DEC     BC              ; array name
        LD      A,(BRKLIN)      ; CLOAD* or CSAVE* ?
        OR      A
        PUSH    AF              ; Save CLOAD* / CSAVE* status
        EX      DE,HL           ; Array data length
        ADD     HL,DE           ; End of data
        EX      DE,HL           ; To DE
        LD      C,(HL)          ; Get dimension bytes
        LD      B,0
        ADD     HL,BC           ; 2 Bytes each dimension
        ADD     HL,BC
        INC     HL              ; Over number of dimensions
        PUSH    HL              ; Address of array data
        PUSH    DE              ; End of array data
        PUSH    BC              ; Number of dimensions
        LD      A,(BRKLIN)      ; CLOAD* or CSAVE* ?
        CP      -1
        CALL    Z,CASFF         ; CLOAD* - Cassette on
        LD      A,(BRKLIN)      ; CLOAD* or CSAVE* ?
        CP      -1
        CALL    NZ,CASFFW       ; CSAVE* - Cassette on and wait
        NOP
        NOP
        NOP
        LD      HL,0
        LD      (CHKSUM),HL     ; Zero check sum
        POP     BC              ; Number of dimensions
        POP     DE              ; End of array data
        POP     HL              ; Address of array data
        LD      B,11010010B     ; Header byte
        JP      JPLDSV          ; CSAVE-SNDHDR , CLOAD-GETHDR

SNDHDR: LD      A,B             ; Get header byte
        CALL    WUART2          ; Send 2 bytes to UART
        CALL    WUART2          ; Send 2 bytes to UART
        JP      SNDARY          ; Send array data

GETHDR: LD      C,4             ; 4 Bytes to check
HDRLP:  CALL    RUART           ; Read byte from UART
        CP      B               ; Same as header?
        JP      NZ,GETHDR       ; No - Wait for another
        DEC     C               ; Count bytes
        JP      NZ,HDRLP        ; More needed
SNDARY: CALL    TSTNUM          ; Check it's a numerical array
ARYLP:  CALL    CPDEHL          ; All array data done
        JP      Z,SUMOFF        ; Yes - Do check sum
        POP     AF              ; CLOAD* or CSAVE* ?
        PUSH    AF              ; Re-save flags
        LD      A,(HL)          ; Get byte
        CALL    P,WUART         ; CSAVE* - Write byte
        CALL    M,RUART         ; CLOAD* - Read byte
        LD      (HL),A          ; Save byte in case of CLOAD*
        CALL    ACCSUM          ; Accumulate check sum
        INC     HL              ; Next byte
        JP      ARYLP           ; Repeat

SUMOFF: CALL    DOSUM           ; Do check sum
        CALL    CASFF           ; Cassette off
        POP     AF              ; Not needed any more
        POP     HL              ; Restore code string address
        RET

ACCSUM: PUSH    HL              ; Save address in array
        LD      HL,(CHKSUM)     ; Get check sum
        LD      B,0             ; BC - Value of byte
        LD      C,A
        ADD     HL,BC           ; Add byte to check sum
        LD      (CHKSUM),HL     ; Re-save check sum
        POP     HL              ; Restore address in array
        RET

DOSUM:  LD      A,(BRKLIN)      ; CLOAD* or CSAVE* ?
        OR      A
        JP      M,CHSUMS        ; CLOAD* - Check if sums match
        LD      A,(CHKSUM)      ; Get LSB of check sum
        CALL    WUART           ; Write to UART
        LD      A,(CHKSUM+1)    ; Get MSB of check sum
        JP      WUART           ; Write to UART and return

CHSUMS: CALL    RUART           ; Read LSB of check sum
        PUSH    AF              ; Save it
        CALL    RUART           ; Read MSB of check sum
        POP     BC              ; LSB to B
        LD      E,B             ; LSB to E
        LD      D,A             ; MSB to D
        LD      HL,(CHKSUM)     ; Get accumulated check sum
        CALL    CPDEHL          ; Are they the same?
        RET     Z               ; Yes - End CLOAD*
        CALL    CASFF           ; Cassette off
        JP      OUTBAD          ; Different - Output "Bad"

CHKLTR: LD      A,(HL)          ; Get byte
        CP      "A"             ; < "A" ?
        RET     C               ; Carry set if not letter
        CP      "Z"+1           ; > "Z" ?
        CCF
        RET                     ; Carry set if not letter

FPSINT: CALL    GETCHR          ; Get next character
POSINT: CALL    GETNUM          ; Get integer 0 to 32767
DEPINT: CALL    TSTSGN          ; Test sign of FPREG
        JP      M,FCERR         ; Negative - ?FC Error
DEINT:  LD      A,(FPEXP)       ; Get integer value to DE
        CP      80H+16          ; Exponent in range (16 bits)?
        JP      C,FPINT         ; Yes - convert it
        LD      BC,9080H        ; BCDE = -32768
        LD      DE,0000
        PUSH    HL              ; Save code string address
        CALL    CMPNUM          ; Compare FPREG with BCDE
        POP     HL              ; Restore code string address
        LD      D,C             ; MSB to D
        RET     Z               ; Return if in range
FCERR:  LD      E,FC            ; ?FC Error
        JP      ERROR           ; Output error-

ATOH:   DEC     HL              ; ASCII number to DE binary
GETLN:  LD      DE,0            ; Get number to DE
GTLNLP: CALL    GETCHR          ; Get next character
        RET     NC              ; Exit if not a digit
        PUSH    HL              ; Save code string address
        PUSH    AF              ; Save digit
        LD      HL,65529/10     ; Largest number 65529
        CALL    CPDEHL          ; Number in range?
        JP      C,SNERR         ; No - ?SN Error
        LD      H,D             ; HL = Number
        LD      L,E
        ADD     HL,DE           ; Times 2
        ADD     HL,HL           ; Times 4
        ADD     HL,DE           ; Times 5
        ADD     HL,HL           ; Times 10
        POP     AF              ; Restore digit
        SUB     "0"             ; Make it 0 to 9
        LD      E,A             ; DE = Value of digit
        LD      D,0
        ADD     HL,DE           ; Add to number
        EX      DE,HL           ; Number to DE
        POP     HL              ; Restore code string address
        JP      GTLNLP          ; Go to next character

CLEAR:  JP      Z,INTVAR        ; Just "CLEAR" Keep parameters
        CALL    POSINT          ; Get integer 0 to 32767 to DE
        DEC     HL              ; Cancel increment
        CALL    GETCHR          ; Get next character
        PUSH    HL              ; Save code string address
        LD      HL,(LSTRAM)     ; Get end of RAM
        JP      Z,STORED        ; No value given - Use stored
        POP     HL              ; Restore code string address
        CALL    CHKSYN          ; Check for comma
        DB      ","
        PUSH    DE              ; Save number
        CALL    POSINT          ; Get integer 0 to 32767
        DEC     HL              ; Cancel increment
        CALL    GETCHR          ; Get next character
        JP      NZ,SNERR        ; ?SN Error if more on line
        EX      (SP),HL         ; Save code string address
        EX      DE,HL           ; Number to DE
STORED: LD      A,L             ; Get LSB of new RAM top
        SUB     E               ; Subtract LSB of string space
        LD      E,A             ; Save LSB
        LD      A,H             ; Get MSB of new RAM top
        SBC     A,D             ; Subtract MSB of string space
        LD      D,A             ; Save MSB
        JP      C,OMERR         ; ?OM Error if not enough mem
        PUSH    HL              ; Save RAM top
        LD      HL,(PROGND)     ; Get program end
        LD      BC,40           ; 40 Bytes minimum working RAM
        ADD     HL,BC           ; Get lowest address
        CALL    CPDEHL          ; Enough memory?
        JP      NC,OMERR        ; No - ?OM Error
        EX      DE,HL           ; RAM top to HL
        LD      (STRSPC),HL     ; Set new string space
        POP     HL              ; End of memory to use
        LD      (LSTRAM),HL     ; Set new top of RAM
        POP     HL              ; Restore code string address
        JP      INTVAR          ; Initialise variables

RUN:    JP      Z,RUNFST        ; RUN from start if just RUN
        CALL    INTVAR          ; Initialise variables
        LD      BC,RUNCNT       ; Execution driver loop
        JP      RUNLIN          ; RUN from line number

GOSUB:  LD      C,3             ; 3 Levels of stack needed
        CALL    CHKSTK          ; Check for 3 levels of stack
        POP     BC              ; Get return address
        PUSH    HL              ; Save code string for RETURN
        PUSH    HL              ; And for GOSUB routine
        LD      HL,(LINEAT)     ; Get current line
        EX      (SP),HL         ; Into stack - Code string out
        LD      A,ZGOSUB        ; "GOSUB" token
        PUSH    AF              ; Save token
        INC     SP              ; Don't save flags

RUNLIN: PUSH    BC              ; Save return address
GOTO:   CALL    ATOH            ; ASCII number to DE binary
        CALL    REM             ; Get end of line
        PUSH    HL              ; Save end of line
        LD      HL,(LINEAT)     ; Get current line
        CALL    CPDEHL          ; Line after current?
        POP     HL              ; Restore end of line
        INC     HL              ; Start of next line
        CALL    C,SRCHLP        ; Line is after current line
        CALL    NC,SRCHLN       ; Line is before current line
        LD      H,B             ; Set up code string address
        LD      L,C
        DEC     HL              ; Incremented after
        RET     C               ; Line found
ULERR:  LD      E,UL            ; ?UL Error
        JP      ERROR           ; Output error message

RETURN: RET     NZ              ; Return if not just RETURN
        LD      D,-1            ; Flag "GOSUB" search
        CALL    BAKSTK          ; Look "GOSUB" block
        LD      SP,HL           ; Kill all FORs in subroutine
        CP      ZGOSUB          ; Test for "GOSUB" token
        LD      E,RG            ; ?RG Error
        JP      NZ,ERROR        ; Error if no "GOSUB" found
        POP     HL              ; Get RETURN line number
        LD      (LINEAT),HL     ; Save as current
        INC     HL              ; Was it from direct statement?
        LD      A,H
        OR      L               ; Return to line
        JP      NZ,RETLIN       ; No - Return to line
        LD      A,(LSTBIN)      ; Any INPUT in subroutine?
        OR      A               ; If so buffer is corrupted
        JP      NZ,POPNOK       ; Yes - Go to command mode
RETLIN: LD      HL,RUNCNT       ; Execution driver loop
        EX      (SP),HL         ; Into stack - Code string out
        DB      3EH             ; Skip "POP HL"
NXTDTA: POP     HL              ; Restore code string address

DATA:   DB      01H,3AH         ; ":" End of statement
REM:    LD      C,0             ; 00  End of statement
        LD      B,0
NXTSTL: LD      A,C             ; Statement and byte
        LD      C,B
        LD      B,A             ; Statement end byte
NXTSTT: LD      A,(HL)          ; Get byte
        OR      A               ; End of line?
        RET     Z               ; Yes - Exit
        CP      B               ; End of statement?
        RET     Z               ; Yes - Exit
        INC     HL              ; Next byte
        CP      '"'             ; Literal string?
        JP      Z,NXTSTL        ; Yes - Look for another '"'
        JP      NXTSTT          ; Keep looking

LET:    CALL    GETVAR          ; Get variable name
        CALL    CHKSYN          ; Make sure "=" follows
        DB      ZEQUAL          ; "=" token
        PUSH    DE              ; Save address of variable
        LD      A,(TYPE)        ; Get data type
        PUSH    AF              ; Save type
        CALL    EVAL            ; Evaluate expression
        POP     AF              ; Restore type
        EX      (SP),HL         ; Save code - Get var addr
        LD      (BRKLIN),HL     ; Save address of variable
        RRA                     ; Adjust type
        CALL    CHKTYP          ; Check types are the same
        JP      Z,LETNUM        ; Numeric - Move value
LETSTR: PUSH    HL              ; Save address of string var
        LD      HL,(FPREG)      ; Pointer to string entry
        PUSH    HL              ; Save it on stack
        INC     HL              ; Skip over length
        INC     HL
        LD      E,(HL)          ; LSB of string address
        INC     HL
        LD      D,(HL)          ; MSB of string address
        LD      HL,(BASTXT)     ; Point to start of program
        CALL    CPDEHL          ; Is string before program?
        JP      NC,CRESTR       ; Yes - Create string entry
        LD      HL,(STRSPC)     ; Point to string space
        CALL    CPDEHL          ; Is string literal in program?
        POP     DE              ; Restore address of string
        JP      NC,MVSTPT       ; Yes - Set up pointer
        LD      HL,TMPSTR       ; Temporary string pool
        CALL    CPDEHL          ; Is string in temporary pool?
        JP      NC,MVSTPT       ; No - Set up pointer
        DB      3EH             ; Skip "POP DE"
CRESTR: POP     DE              ; Restore address of string
        CALL    BAKTMP          ; Back to last tmp-str entry
        EX      DE,HL           ; Address of string entry
        CALL    SAVSTR          ; Save string in string area
MVSTPT: CALL    BAKTMP          ; Back to last tmp-str entry
        POP     HL              ; Get string pointer
        CALL    DETHL4          ; Move string pointer to var
        POP     HL              ; Restore code string address
        RET

LETNUM: PUSH    HL              ; Save address of variable
        CALL    FPTHL           ; Move value to variable
        POP     DE              ; Restore address of variable
        POP     HL              ; Restore code string address
        RET

ON:     CALL    GETINT          ; Get integer 0-255
        LD      A,(HL)          ; Get "GOTO" or "GOSUB" token
        LD      B,A             ; Save in B
        CP      ZGOSUB          ; "GOSUB" token?
        JP      Z,ONGO          ; Yes - Find line number
        CALL    CHKSYN          ; Make sure it's "GOTO"
        DB      ZGOTO           ; "GOTO" token
        DEC     HL              ; Cancel increment
ONGO:   LD      C,E             ; Integer of branch value
ONGOLP: DEC     C               ; Count branches
        LD      A,B             ; Get "GOTO" or "GOSUB" token
        JP      Z,ONJMP         ; Go to that line if right one
        CALL    GETLN           ; Get line number to DE
        CP      ","             ; Another line number?
        RET     NZ              ; No - Drop through
        JP      ONGOLP          ; Yes - loop

IF:     CALL    EVAL            ; Evaluate expression
        LD      A,(HL)          ; Get token
        CP      ZGOTO           ; "GOTO" token?
        JP      Z,IFGO          ; Yes - Get line
        CALL    CHKSYN          ; Make sure it's "THEN"
        DB      ZTHEN           ; "THEN" token
        DEC     HL              ; Cancel increment
IFGO:   CALL    TSTNUM          ; Make sure it's numeric
        CALL    TSTSGN          ; Test state of expression
        JP      Z,REM           ; False - Drop through
        CALL    GETCHR          ; Get next character
        JP      C,GOTO          ; Number - GOTO that line
        JP      IFJMP           ; Otherwise do statement

MRPRNT: DEC     HL              ; DEC 'cos GETCHR INCs
        CALL    GETCHR          ; Get next character
PRINT:  JP      Z,PRNTCR        ; CRLF if just PRINT
PRNTLP: RET     Z               ; End of list - Exit
        CP      ZTAB            ; "TAB(" token?
        JP      Z,DOTAB         ; Yes - Do TAB routine
        CP      ZSPC            ; "SPC(" token?
        JP      Z,DOTAB         ; Yes - Do SPC routine
        PUSH    HL              ; Save code string address
        CP      ","             ; Comma?
        JP      Z,DOCOM         ; Yes - Move to next zone
        CP      ";"             ; Semi-colon?
        JP      Z,NEXITM        ; Do semi-colon routine
        POP     BC              ; Code string address to BC
        CALL    EVAL            ; Evaluate expression
        PUSH    HL              ; Save code string address
        LD      A,(TYPE)        ; Get variable type
        OR      A               ; Is it a string variable?
        JP      NZ,PRNTST       ; Yes - Output string contents
        CALL    NUMASC          ; Convert number to text
        CALL    CRTST           ; Create temporary string
        LD      (HL)," "        ; Followed by a space
        LD      HL,(FPREG)      ; Get length of output
        INC     (HL)            ; Plus 1 for the space
        LD      HL,(FPREG)      ; < Not needed >
        LD      A,(LWIDTH)      ; Get width of line
        LD      B,A             ; To B
        INC     B               ; Width 255 (No limit)?
        JP      Z,PRNTNB        ; Yes - Output number string
        INC     B               ; Adjust it
        LD      A,(CURPOS)      ; Get cursor position
        ADD     A,(HL)          ; Add length of string
        DEC     A               ; Adjust it
        CP      B               ; Will output fit on this line?
        CALL    NC,PRNTCR       ; No - CRLF first
PRNTNB: CALL    PRS1            ; Output string at (HL)
        XOR     A               ; Skip CALL by setting "Z" flag
PRNTST: CALL    NZ,PRS1         ; Output string at (HL)
        POP     HL              ; Restore code string address
        JP      MRPRNT          ; See if more to PRINT

STTLIN: LD      A,(CURPOS)      ; Make sure on new line
        OR      A               ; Already at start?
        RET     Z               ; Yes - Do nothing
        JP      PRNTCR          ; Start a new line

ENDINP: LD      (HL),0          ; Mark end of buffer
        LD      HL,BUFFER-1     ; Point to buffer
PRNTCR: LD      A,CR            ; Load a CR
        CALL    OUTC            ; Output character
DONULL: XOR     A               ; Set to position 0
        LD      (CURPOS),A      ; Store it
        LD      A,(NULLS)       ; Get number of nulls
NULLP:  DEC     A               ; Count them
        RET     Z               ; Return if done
        PUSH    AF              ; Save count
        XOR     A               ; Load a null
        CALL    OUTC            ; Output it
        POP     AF              ; Restore count
        JP      NULLP           ; Keep counting

DOCOM:  LD      A,(COMMAN)      ; Get comma width
        LD      B,A             ; Save in B
        LD      A,(CURPOS)      ; Get current position
        CP      B               ; Within the limit?
        CALL    NC,PRNTCR       ; No - output CRLF
        JP      NC,NEXITM       ; Get next item
ZONELP: SUB     14              ; Next zone of 14 characters
        JP      NC,ZONELP       ; Repeat if more zones
        CPL                     ; Number of spaces to output
        JP      ASPCS           ; Output them

DOTAB:  PUSH    AF              ; Save token
        CALL    FNDNUM          ; Evaluate expression
        CALL    CHKSYN          ; Make sure ")" follows
        DB      ")"
        DEC     HL              ; Back space on to ")"
        POP     AF              ; Restore token
        SUB     ZSPC            ; Was it "SPC(" ?
        PUSH    HL              ; Save code string address
        JP      Z,DOSPC         ; Yes - Do "E" spaces
        LD      A,(CURPOS)      ; Get current position
DOSPC:  CPL                     ; Number of spaces to print to
        ADD     A,E             ; Total number to print
        JP      NC,NEXITM       ; TAB < Current POS(X)
ASPCS:  INC     A               ; Output A spaces
        LD      B,A             ; Save number to print
        LD      A," "           ; Space
SPCLP:  CALL    OUTC            ; Output character in A
        DEC     B               ; Count them
        JP      NZ,SPCLP        ; Repeat if more
NEXITM: POP     HL              ; Restore code string address
        CALL    GETCHR          ; Get next character
        JP      PRNTLP          ; More to print

REDO:   DB      "?Redo from start",CR,LF,0

BADINP: LD      A,(READFG)      ; READ or INPUT?
        OR      A
        JP      NZ,DATSNR       ; READ - ?SN Error
        POP     BC              ; Throw away code string addr
        LD      HL,REDO         ; "Redo from start" message
        CALL    PRS             ; Output string
        JP      DOAGN           ; Do last INPUT again

INPUT:  CALL    IDTEST          ; Test for illegal direct
        LD      A,(HL)          ; Get character after "INPUT"
        CP      '"'             ; Is there a prompt string?
        LD      A,0             ; Clear A and leave flags
        LD      (CTLOFG),A      ; Enable output
        JP      NZ,NOPMPT       ; No prompt - get input
        CALL    QTSTR           ; Get string terminated by '"'
        CALL    CHKSYN          ; Check for ";" after prompt
        DB      ";"
        PUSH    HL              ; Save code string address
        CALL    PRS1            ; Output prompt string
        DB      3EH             ; Skip "PUSH HL"
NOPMPT: PUSH    HL              ; Save code string address
        CALL    PROMPT          ; Get input with "? " prompt
        POP     BC              ; Restore code string address
        JP      C,INPBRK        ; Break pressed - Exit
        INC     HL              ; Next byte
        LD      A,(HL)          ; Get it
        OR      A               ; End of line?
        DEC     HL              ; Back again
        PUSH    BC              ; Re-save code string address
        JP      Z,NXTDTA        ; Yes - Find next DATA stmt
        LD      (HL),","        ; Store comma as separator
        JP      NXTITM          ; Get next item

READ:   PUSH    HL              ; Save code string address
        LD      HL,(NXTDAT)     ; Next DATA statement
        DB      0F6H            ; Flag "READ"
NXTITM: XOR     A               ; Flag "INPUT"
        LD      (READFG),A      ; Save "READ"/"INPUT" flag
        EX      (SP),HL         ; Get code str' , Save pointer
        JP      GTVLUS          ; Get values

NEDMOR: CALL    CHKSYN          ; Check for comma between items
        DB      ","
GTVLUS: CALL    GETVAR          ; Get variable name
        EX      (SP),HL         ; Save code str" , Get pointer
        PUSH    DE              ; Save variable address
        LD      A,(HL)          ; Get next "INPUT"/"DATA" byte
        CP      ","             ; Comma?
        JP      Z,ANTVLU        ; Yes - Get another value
        LD      A,(READFG)      ; Is it READ?
        OR      A
        JP      NZ,FDTLP        ; Yes - Find next DATA stmt
        LD      A,"?"           ; More INPUT needed
        CALL    OUTC            ; Output character
        CALL    PROMPT          ; Get INPUT with prompt
        POP     DE              ; Variable address
        POP     BC              ; Code string address
        JP      C,INPBRK        ; Break pressed
        INC     HL              ; Point to next DATA byte
        LD      A,(HL)          ; Get byte
        OR      A               ; Is it zero (No input) ?
        DEC     HL              ; Back space INPUT pointer
        PUSH    BC              ; Save code string address
        JP      Z,NXTDTA        ; Find end of buffer
        PUSH    DE              ; Save variable address
ANTVLU: LD      A,(TYPE)        ; Check data type
        OR      A               ; Is it numeric?
        JP      Z,INPBIN        ; Yes - Convert to binary
        CALL    GETCHR          ; Get next character
        LD      D,A             ; Save input character
        LD      B,A             ; Again
        CP      '"'             ; Start of literal sting?
        JP      Z,STRENT        ; Yes - Create string entry
        LD      A,(READFG)      ; "READ" or "INPUT" ?
        OR      A
        LD      D,A             ; Save 00 if "INPUT"
        JP      Z,ITMSEP        ; "INPUT" - End with 00
        LD      D,":"           ; "DATA" - End with 00 or ":"
ITMSEP: LD      B,","           ; Item separator
        DEC     HL              ; Back space for DTSTR
STRENT: CALL    DTSTR           ; Get string terminated by D
        EX      DE,HL           ; String address to DE
        LD      HL,LTSTND       ; Where to go after LETSTR
        EX      (SP),HL         ; Save HL , get input pointer
        PUSH    DE              ; Save address of string
        JP      LETSTR          ; Assign string to variable

INPBIN: CALL    GETCHR          ; Get next character
        CALL    ASCTFP          ; Convert ASCII to FP number
        EX      (SP),HL         ; Save input ptr, Get var addr
        CALL    FPTHL           ; Move FPREG to variable
        POP     HL              ; Restore input pointer
LTSTND: DEC     HL              ; DEC 'cos GETCHR INCs
        CALL    GETCHR          ; Get next character
        JP      Z,MORDT         ; End of line - More needed?
        CP      ","             ; Another value?
        JP      NZ,BADINP       ; No - Bad input
MORDT:  EX      (SP),HL         ; Get code string address
        DEC     HL              ; DEC 'cos GETCHR INCs
        CALL    GETCHR          ; Get next character
        JP      NZ,NEDMOR       ; More needed - Get it
        POP     DE              ; Restore DATA pointer
        LD      A,(READFG)      ; "READ" or "INPUT" ?
        OR      A
        EX      DE,HL           ; DATA pointer to HL
        JP      NZ,UPDATA       ; Update DATA pointer if "READ"
        PUSH    DE              ; Save code string address
        OR      (HL)            ; More input given?
        LD      HL,EXTIG        ; "?Extra ignored" message
        CALL    NZ,PRS          ; Output string if extra given
        POP     HL              ; Restore code string address
        RET

EXTIG:  DB      "?Extra ignored",CR,LF,0

FDTLP:  CALL    DATA            ; Get next statement
        OR      A               ; End of line?
        JP      NZ,FANDT        ; No - See if DATA statement
        INC     HL
        LD      A,(HL)          ; End of program?
        INC     HL
        OR      (HL)            ; 00 00 Ends program
        LD      E,OD            ; ?OD Error
        JP      Z,ERROR         ; Yes - Out of DATA
        INC     HL
        LD      E,(HL)          ; LSB of line number
        INC     HL
        LD      D,(HL)          ; MSB of line number
        EX      DE,HL
        LD      (DATLIN),HL     ; Set line of current DATA item
        EX      DE,HL
FANDT:  CALL    GETCHR          ; Get next character
        CP      ZDATA           ; "DATA" token
        JP      NZ,FDTLP        ; No "DATA" - Keep looking
        JP      ANTVLU          ; Found - Convert input

NEXT:   LD      DE,0            ; In case no index given
NEXT1:  CALL    NZ,GETVAR       ; Get index address
        LD      (BRKLIN),HL     ; Save code string address
        CALL    BAKSTK          ; Look for "FOR" block
        JP      NZ,NFERR        ; No "FOR" - ?NF Error
        LD      SP,HL           ; Clear nested loops
        PUSH    DE              ; Save index address
        LD      A,(HL)          ; Get sign of STEP
        INC     HL
        PUSH    AF              ; Save sign of STEP
        PUSH    DE              ; Save index address
        CALL    PHLTFP          ; Move index value to FPREG
        EX      (SP),HL         ; Save address of TO value
        PUSH    HL              ; Save address of index
        CALL    ADDPHL          ; Add STEP to index value
        POP     HL              ; Restore address of index
        CALL    FPTHL           ; Move value to index variable
        POP     HL              ; Restore address of TO value
        CALL    LOADFP          ; Move TO value to BCDE
        PUSH    HL              ; Save address of line of FOR
        CALL    CMPNUM          ; Compare index with TO value
        POP     HL              ; Restore address of line num
        POP     BC              ; Address of sign of STEP
        SUB     B               ; Compare with expected sign
        CALL    LOADFP          ; BC = Loop stmt,DE = Line num
        JP      Z,KILFOR        ; Loop finished - Terminate it
        EX      DE,HL           ; Loop statement line number
        LD      (LINEAT),HL     ; Set loop line number
        LD      L,C             ; Set code string to loop
        LD      H,B
        JP      PUTFID          ; Put back "FOR" and continue

KILFOR: LD      SP,HL           ; Remove "FOR" block
        LD      HL,(BRKLIN)     ; Code string after "NEXT"
        LD      A,(HL)          ; Get next byte in code string
        CP      ","             ; More NEXTs ?
        JP      NZ,RUNCNT       ; No - Do next statement
        CALL    GETCHR          ; Position to index name
        CALL    NEXT1           ; Re-enter NEXT routine
; < will not RETurn to here , Exit to RUNCNT or Loop >

GETNUM: CALL    EVAL            ; Get a numeric expression
TSTNUM: DB      0F6H            ; Clear carry (numeric)
TSTSTR: SCF                     ; Set carry (string)
CHKTYP: LD      A,(TYPE)        ; Check types match
        ADC     A,A             ; Expected + actual
        OR      A               ; Clear carry , set parity
        RET     PE              ; Even parity - Types match
        JP      TMERR           ; Different types - Error

; <<< NO REFERENCE TO HERE >>>

        CALL    CHKSYN          ; Make sure "=" follows
        DB      ZEQUAL          ; "="
        JP      EVAL            ; Evaluate expression

OPNPAR: CALL    CHKSYN          ; Make sure "(" follows
        DB      "("
EVAL:   DEC     HL              ; Evaluate expression & save
        LD      D,0             ; Precedence value
EVAL1:  PUSH    DE              ; Save precedence
        LD      C,1
        CALL    CHKSTK          ; Check for 1 level of stack
        CALL    OPRND           ; Get next expression value
EVAL2:  LD      (NXTOPR),HL     ; Save address of next operator
EVAL3:  LD      HL,(NXTOPR)     ; Restore address of next opr
        POP     BC              ; Precedence value and operator
        LD      A,B             ; Get precedence value
        CP      78H             ; "AND" or "OR" ?
        CALL    NC,TSTNUM       ; No - Make sure it's a number
        LD      A,(HL)          ; Get next operator / function
        LD      D,0             ; Clear Last relation
RLTLP:  SUB     ZGTR            ; ">" Token
        JP      C,FOPRND        ; + - * / ^ AND OR - Test it
        CP      ZLTH+1-ZGTR     ; < = >
        JP      NC,FOPRND       ; Function - Call it
        CP      ZEQUAL-ZGTR     ; "="
        RLA                     ; <- Test for legal
        XOR     D               ; <- combinations of < = >
        CP      D               ; <- by combining last token
        LD      D,A             ; <- with current one
        JP      C,SNERR         ; Error if "<<" "==" or ">>"
        LD      (CUROPR),HL     ; Save address of current token
        CALL    GETCHR          ; Get next character
        JP      RLTLP           ; Treat the two as one

FOPRND: LD      A,D             ; < = > found ?
        OR      A
        JP      NZ,TSTRED       ; Yes - Test for reduction
        LD      A,(HL)          ; Get operator token
        LD      (CUROPR),HL     ; Save operator address
        SUB     ZPLUS           ; Operator or function?
        RET     C               ; Neither - Exit
        CP      ZOR+1-ZPLUS     ; Is it + - * / ^ AND OR ?
        RET     NC              ; No - Exit
        LD      E,A             ; Coded operator
        LD      A,(TYPE)        ; Get data type
        DEC     A               ; FF = numeric , 00 = string
        OR      E               ; Combine with coded operator
        LD      A,E             ; Get coded operator
        JP      Z,CONCAT        ; String concatenation
        RLCA                    ; Times 2
        ADD     A,E             ; Times 3
        LD      E,A             ; To DE (D is 0)
        LD      HL,PRITAB       ; Precedence table
        ADD     HL,DE           ; To the operator concerned
        LD      A,B             ; Last operator precedence
        LD      D,(HL)          ; Get evaluation precedence
        CP      D               ; Compare with eval precedence
        RET     NC              ; Exit if higher precedence
        INC     HL              ; Point to routine address
        CALL    TSTNUM          ; Make sure it's a number

STKTHS: PUSH    BC              ; Save last precedence & token
        LD      BC,EVAL3        ; Where to go on prec' break
        PUSH    BC              ; Save on stack for return
        LD      B,E             ; Save operator
        LD      C,D             ; Save precedence
        CALL    STAKFP          ; Move value to stack
        LD      E,B             ; Restore operator
        LD      D,C             ; Restore precedence
        LD      C,(HL)          ; Get LSB of routine address
        INC     HL
        LD      B,(HL)          ; Get MSB of routine address
        INC     HL
        PUSH    BC              ; Save routine address
        LD      HL,(CUROPR)     ; Address of current operator
        JP      EVAL1           ; Loop until prec' break

OPRND:  XOR     A               ; Get operand routine
        LD      (TYPE),A        ; Set numeric expected
        CALL    GETCHR          ; Get next character
        LD      E,MO            ; ?MO Error
        JP      Z,ERROR         ; No operand - Error
        JP      C,ASCTFP        ; Number - Get value
        CALL    CHKLTR          ; See if a letter
        JP      NC,CONVAR       ; Letter - Find variable
        CP      ZPLUS           ; "+" Token ?
        JP      Z,OPRND         ; Yes - Look for operand
        CP      "."             ; "." ?
        JP      Z,ASCTFP        ; Yes - Create FP number
        CP      ZMINUS          ; "-" Token ?
        JP      Z,MINUS         ; Yes - Do minus
        CP      '"'             ; Literal string ?
        JP      Z,QTSTR         ; Get string terminated by '"'
        CP      ZNOT            ; "NOT" Token ?
        JP      Z,EVNOT         ; Yes - Eval NOT expression
        CP      ZFN             ; "FN" Token ?
        JP      Z,DOFN          ; Yes - Do FN routine
        SUB     ZSGN            ; Is it a function?
        JP      NC,FNOFST       ; Yes - Evaluate function
EVLPAR: CALL    OPNPAR          ; Evaluate expression in "()"
        CALL    CHKSYN          ; Make sure ")" follows
        DB      ")"
        RET

MINUS:  LD      D,7DH           ; "-" precedence
        CALL    EVAL1           ; Evaluate until prec' break
        LD      HL,(NXTOPR)     ; Get next operator address
        PUSH    HL              ; Save next operator address
        CALL    INVSGN          ; Negate value
RETNUM: CALL    TSTNUM          ; Make sure it's a number
        POP     HL              ; Restore next operator address
        RET

CONVAR: CALL    GETVAR          ; Get variable address to DE
FRMEVL: PUSH    HL              ; Save code string address
        EX      DE,HL           ; Variable address to HL
        LD      (FPREG),HL      ; Save address of variable
        LD      A,(TYPE)        ; Get type
        OR      A               ; Numeric?
        CALL    Z,PHLTFP        ; Yes - Move contents to FPREG
        POP     HL              ; Restore code string address
        RET

FNOFST: LD      B,0             ; Get address of function
        RLCA                    ; Double function offset
        LD      C,A             ; BC = Offset in function table
        PUSH    BC              ; Save adjusted token value
        CALL    GETCHR          ; Get next character
        LD      A,C             ; Get adjusted token value
        CP      2*(ZPOINT-ZSGN) ; Adjusted "POINT" token?
        JP      Z,POINTB        ; Yes - Do "POINT" (not POINTB)
        CP      2*(ZLEFT-ZSGN)-1; Adj' LEFT$,RIGHT$ or MID$ ?
        JP      C,FNVAL         ; No - Do function
        CALL    OPNPAR          ; Evaluate expression  (X,...
        CALL    CHKSYN          ; Make sure "," follows
        DB      ","
        CALL    TSTSTR          ; Make sure it's a string
        EX      DE,HL           ; Save code string address
        LD      HL,(FPREG)      ; Get address of string
        EX      (SP),HL         ; Save address of string
        PUSH    HL              ; Save adjusted token value
        EX      DE,HL           ; Restore code string address
        CALL    GETINT          ; Get integer 0-255
        EX      DE,HL           ; Save code string address
        EX      (SP),HL         ; Save integer,HL = adj' token
        JP      GOFUNC          ; Jump to string function

FNVAL:  CALL    EVLPAR          ; Evaluate expression
        EX      (SP),HL         ; HL = Adjusted token value
        LD      DE,RETNUM       ; Return number from function
        PUSH    DE              ; Save on stack
GOFUNC: LD      BC,FNCTAB       ; Function routine addresses
        ADD     HL,BC           ; Point to right address
        LD      C,(HL)          ; Get LSB of address
        INC     HL              ;
        LD      H,(HL)          ; Get MSB of address
        LD      L,C             ; Address to HL
        JP      (HL)            ; Jump to function

SGNEXP: DEC     D               ; Dee to flag negative exponent
        CP      ZMINUS          ; "-" token ?
        RET     Z               ; Yes - Return
        CP      "-"             ; "-" ASCII ?
        RET     Z               ; Yes - Return
        INC     D               ; Inc to flag positive exponent
        CP      "+"             ; "+" ASCII ?
        RET     Z               ; Yes - Return
        CP      ZPLUS           ; "+" token ?
        RET     Z               ; Yes - Return
        DEC     HL              ; DEC 'cos GETCHR INCs
        RET                     ; Return "NZ"

POR:    DB      0F6H            ; Flag "OR"
PAND:   XOR     A               ; Flag "AND"
        PUSH    AF              ; Save "AND" / "OR" flag
        CALL    TSTNUM          ; Make sure it's a number
        CALL    DEINT           ; Get integer -32768 to 32767
        POP     AF              ; Restore "AND" / "OR" flag
        EX      DE,HL           ; <- Get last
        POP     BC              ; <-  value
        EX      (SP),HL         ; <-  from
        EX      DE,HL           ; <-  stack
        CALL    FPBCDE          ; Move last value to FPREG
        PUSH    AF              ; Save "AND" / "OR" flag
        CALL    DEINT           ; Get integer -32768 to 32767
        POP     AF              ; Restore "AND" / "OR" flag
        POP     BC              ; Get value
        LD      A,C             ; Get LSB
        LD      HL,ACPASS       ; Address of save AC as current
        JP      NZ,POR1         ; Jump if OR
        AND     E               ; "AND" LSBs
        LD      C,A             ; Save LSB
        LD      A,B             ; Get MBS
        AND     D               ; "AND" MSBs
        JP      (HL)            ; Save AC as current (ACPASS)

POR1:   OR      E               ; "OR" LSBs
        LD      C,A             ; Save LSB
        LD      A,B             ; Get MSB
        OR      D               ; "OR" MSBs
        JP      (HL)            ; Save AC as current (ACPASS)

TSTRED: LD      HL,CMPLOG       ; Logical compare routine
        LD      A,(TYPE)        ; Get data type
        RRA                     ; Carry set = string
        LD      A,D             ; Get last precedence value
        RLA                     ; Times 2 plus carry
        LD      E,A             ; To E
        LD      D,64H           ; Relational precedence
        LD      A,B             ; Get current precedence
        CP      D               ; Compare with last
        RET     NC              ; Eval if last was rel' or log'
        JP      STKTHS          ; Stack this one and get next

CMPLOG: DW      CMPLG1          ; Compare two values / strings
CMPLG1: LD      A,C             ; Get data type
        OR      A
        RRA
        POP     BC              ; Get last expression to BCDE
        POP     DE
        PUSH    AF              ; Save status
        CALL    CHKTYP          ; Check that types match
        LD      HL,CMPRES       ; Result to comparison
        PUSH    HL              ; Save for RETurn
        JP      Z,CMPNUM        ; Compare values if numeric
        XOR     A               ; Compare two strings
        LD      (TYPE),A        ; Set type to numeric
        PUSH    DE              ; Save string name
        CALL    GSTRCU          ; Get current string
        LD      A,(HL)          ; Get length of string
        INC     HL
        INC     HL
        LD      C,(HL)          ; Get LSB of address
        INC     HL
        LD      B,(HL)          ; Get MSB of address
        POP     DE              ; Restore string name
        PUSH    BC              ; Save address of string
        PUSH    AF              ; Save length of string
        CALL    GSTRDE          ; Get second string
        CALL    LOADFP          ; Get address of second string
        POP     AF              ; Restore length of string 1
        LD      D,A             ; Length to D
        POP     HL              ; Restore address of string 1
CMPSTR: LD      A,E             ; Bytes of string 2 to do
        OR      D               ; Bytes of string 1 to do
        RET     Z               ; Exit if all bytes compared
        LD      A,D             ; Get bytes of string 1 to do
        SUB     1
        RET     C               ; Exit if end of string 1
        XOR     A
        CP      E               ; Bytes of string 2 to do
        INC     A
        RET     NC              ; Exit if end of string 2
        DEC     D               ; Count bytes in string 1
        DEC     E               ; Count bytes in string 2
        LD      A,(BC)          ; Byte in string 2
        CP      (HL)            ; Compare to byte in string 1
        INC     HL              ; Move up string 1
        INC     BC              ; Move up string 2
        JP      Z,CMPSTR        ; Same - Try next bytes
        CCF                     ; Flag difference (">" or "<")
        JP      FLGDIF          ; "<" gives -1 , ">" gives +1

CMPRES: INC     A               ; Increment current value
        ADC     A,A             ; Double plus carry
        POP     BC              ; Get other value
        AND     B               ; Combine them
        ADD     A,-1            ; Carry set if different
        SBC     A,A             ; 00 - Equal , FF - Different
        JP      FLGREL          ; Set current value & continue

EVNOT:  LD      D,5AH           ; Precedence value for "NOT"
        CALL    EVAL1           ; Eval until precedence break
        CALL    TSTNUM          ; Make sure it's a number
        CALL    DEINT           ; Get integer -32768 - 32767
        LD      A,E             ; Get LSB
        CPL                     ; Invert LSB
        LD      C,A             ; Save "NOT" of LSB
        LD      A,D             ; Get MSB
        CPL                     ; Invert MSB
        CALL    ACPASS          ; Save AC as current
        POP     BC              ; Clean up stack
        JP      EVAL3           ; Continue evaluation

DIMRET: DEC     HL              ; DEC 'cos GETCHR INCs
        CALL    GETCHR          ; Get next character
        RET     Z               ; End of DIM statement
        CALL    CHKSYN          ; Make sure "," follows
        DB      ","
DIM:    LD      BC,DIMRET       ; Return to "DIMRET"
        PUSH    BC              ; Save on stack
        DB      0F6H            ; Flag "Create" variable
GETVAR: XOR     A               ; Find variable address,to DE
        LD      (LCRFLG),A      ; Set locate / create flag
        LD      B,(HL)          ; Get First byte of name
GTFNAM: CALL    CHKLTR          ; See if a letter
        JP      C,SNERR         ; ?SN Error if not a letter
        XOR     A
        LD      C,A             ; Clear second byte of name
        LD      (TYPE),A        ; Set type to numeric
        CALL    GETCHR          ; Get next character
        JP      C,SVNAM2        ; Numeric - Save in name
        CALL    CHKLTR          ; See if a letter
        JP      C,CHARTY        ; Not a letter - Check type
SVNAM2: LD      C,A             ; Save second byte of name
ENDNAM: CALL    GETCHR          ; Get next character
        JP      C,ENDNAM        ; Numeric - Get another
        CALL    CHKLTR          ; See if a letter
        JP      NC,ENDNAM       ; Letter - Get another
CHARTY: SUB     "$"             ; String variable?
        JP      NZ,NOTSTR       ; No - Numeric variable
        INC     A               ; A = 1 (string type)
        LD      (TYPE),A        ; Set type to string
        RRCA                    ; A = 80H , Flag for string
        ADD     A,C             ; 2nd byte of name has bit 7 on
        LD      C,A             ; Resave second byte on name
        CALL    GETCHR          ; Get next character
NOTSTR: LD      A,(FORFLG)      ; Array name needed ?
        DEC     A
        JP      Z,ARLDSV        ; Yes - Get array name
        JP      P,NSCFOR        ; No array with "FOR" or "FN"
        LD      A,(HL)          ; Get byte again
        SUB     "("             ; Subscripted variable?
        JP      Z,SBSCPT        ; Yes - Sort out subscript

NSCFOR: XOR     A               ; Simple variable
        LD      (FORFLG),A      ; Clear "FOR" flag
        PUSH    HL              ; Save code string address
        LD      D,B             ; DE = Variable name to find
        LD      E,C
        LD      HL,(FNRGNM)     ; FN argument name
        CALL    CPDEHL          ; Is it the FN argument?
        LD      DE,FNARG        ; Point to argument value
        JP      Z,POPHRT        ; Yes - Return FN argument value
        LD      HL,(VAREND)     ; End of variables
        EX      DE,HL           ; Address of end of search
        LD      HL,(PROGND)     ; Start of variables address
FNDVAR: CALL    CPDEHL          ; End of variable list table?
        JP      Z,CFEVAL        ; Yes - Called from EVAL?
        LD      A,C             ; Get second byte of name
        SUB     (HL)            ; Compare with name in list
        INC     HL              ; Move on to first byte
        JP      NZ,FNTHR        ; Different - Find another
        LD      A,B             ; Get first byte of name
        SUB     (HL)            ; Compare with name in list
FNTHR:  INC     HL              ; Move on to LSB of value
        JP      Z,RETADR        ; Found - Return address
        INC     HL              ; <- Skip
        INC     HL              ; <- over
        INC     HL              ; <- F.P.
        INC     HL              ; <- value
        JP      FNDVAR          ; Keep looking

CFEVAL: POP     HL              ; Restore code string address
        EX      (SP),HL         ; Get return address
        PUSH    DE              ; Save address of variable
        LD      DE,FRMEVL       ; Return address in EVAL
        CALL    CPDEHL          ; Called from EVAL ?
        POP     DE              ; Restore address of variable
        JP      Z,RETNUL        ; Yes - Return null variable
        EX      (SP),HL         ; Put back return
        PUSH    HL              ; Save code string address
        PUSH    BC              ; Save variable name
        LD      BC,6            ; 2 byte name plus 4 byte data
        LD      HL,(ARREND)     ; End of arrays
        PUSH    HL              ; Save end of arrays
        ADD     HL,BC           ; Move up 6 bytes
        POP     BC              ; Source address in BC
        PUSH    HL              ; Save new end address
        CALL    MOVUP           ; Move arrays up
        POP     HL              ; Restore new end address
        LD      (ARREND),HL     ; Set new end address
        LD      H,B             ; End of variables to HL
        LD      L,C
        LD      (VAREND),HL     ; Set new end address

ZEROLP: DEC     HL              ; Back through to zero variable
        LD      (HL),0          ; Zero byte in variable
        CALL    CPDEHL          ; Done them all?
        JP      NZ,ZEROLP       ; No - Keep on going
        POP     DE              ; Get variable name
        LD      (HL),E          ; Store second character
        INC     HL
        LD      (HL),D          ; Store first character
        INC     HL
RETADR: EX      DE,HL           ; Address of variable in DE
        POP     HL              ; Restore code string address
        RET

RETNUL: LD      (FPEXP),A       ; Set result to zero
        LD      HL,ZERBYT       ; Also set a null string
        LD      (FPREG),HL      ; Save for EVAL
        POP     HL              ; Restore code string address
        RET

SBSCPT: PUSH    HL              ; Save code string address
        LD      HL,(LCRFLG)     ; Locate/Create and Type
        EX      (SP),HL         ; Save and get code string
        LD      D,A             ; Zero number of dimensions
SCPTLP: PUSH    DE              ; Save number of dimensions
        PUSH    BC              ; Save array name
        CALL    FPSINT          ; Get subscript (0-32767)
        POP     BC              ; Restore array name
        POP     AF              ; Get number of dimensions
        EX      DE,HL
        EX      (SP),HL         ; Save subscript value
        PUSH    HL              ; Save LCRFLG and TYPE
        EX      DE,HL
        INC     A               ; Count dimensions
        LD      D,A             ; Save in D
        LD      A,(HL)          ; Get next byte in code string
        CP      ","             ; Comma (more to come)?
        JP      Z,SCPTLP        ; Yes - More subscripts
        CALL    CHKSYN          ; Make sure ")" follows
        DB      ")"
        LD      (NXTOPR),HL     ; Save code string address
        POP     HL              ; Get LCRFLG and TYPE
        LD      (LCRFLG),HL     ; Restore Locate/create & type
        LD      E,0             ; Flag not CSAVE* or CLOAD*
        PUSH    DE              ; Save number of dimensions (D)
        DB      11H             ; Skip "PUSH HL" and "PUSH AF'

ARLDSV: PUSH    HL              ; Save code string address
        PUSH    AF              ; A = 00 , Flags set = Z,N
        LD      HL,(VAREND)     ; Start of arrays
        DB      3EH             ; Skip "ADD HL,DE"
FNDARY: ADD     HL,DE           ; Move to next array start
        EX      DE,HL
        LD      HL,(ARREND)     ; End of arrays
        EX      DE,HL           ; Current array pointer
        CALL    CPDEHL          ; End of arrays found?
        JP      Z,CREARY        ; Yes - Create array
        LD      A,(HL)          ; Get second byte of name
        CP      C               ; Compare with name given
        INC     HL              ; Move on
        JP      NZ,NXTARY       ; Different - Find next array
        LD      A,(HL)          ; Get first byte of name
        CP      B               ; Compare with name given
NXTARY: INC     HL              ; Move on
        LD      E,(HL)          ; Get LSB of next array address
        INC     HL
        LD      D,(HL)          ; Get MSB of next array address
        INC     HL
        JP      NZ,FNDARY       ; Not found - Keep looking
        LD      A,(LCRFLG)      ; Found Locate or Create it?
        OR      A
        JP      NZ,DDERR        ; Create - ?DD Error
        POP     AF              ; Locate - Get number of dim'ns
        LD      B,H             ; BC Points to array dim'ns
        LD      C,L
        JP      Z,POPHRT        ; Jump if array load/save
        SUB     (HL)            ; Same number of dimensions?
        JP      Z,FINDEL        ; Yes - Find element
BSERR:  LD      E,BS            ; ?BS Error
        JP      ERROR           ; Output error

CREARY: LD      DE,4            ; 4 Bytes per entry
        POP     AF              ; Array to save or 0 dim'ns?
        JP      Z,FCERR         ; Yes - ?FC Error
        LD      (HL),C          ; Save second byte of name
        INC     HL
        LD      (HL),B          ; Save first byte of name
        INC     HL
        LD      C,A             ; Number of dimensions to C
        CALL    CHKSTK          ; Check if enough memory
        INC     HL              ; Point to number of dimensions
        INC     HL
        LD      (CUROPR),HL     ; Save address of pointer
        LD      (HL),C          ; Set number of dimensions
        INC     HL
        LD      A,(LCRFLG)      ; Locate of Create?
        RLA                     ; Carry set = Create
        LD      A,C             ; Get number of dimensions
CRARLP: LD      BC,10+1         ; Default dimension size 10
        JP      NC,DEFSIZ       ; Locate - Set default size
        POP     BC              ; Get specified dimension size
        INC     BC              ; Include zero element
DEFSIZ: LD      (HL),C          ; Save LSB of dimension size
        INC     HL
        LD      (HL),B          ; Save MSB of dimension size
        INC     HL
        PUSH    AF              ; Save num' of dim'ns an status
        PUSH    HL              ; Save address of dim'n size
        CALL    MLDEBC          ; Multiply DE by BC to find
        EX      DE,HL           ; amount of mem needed (to DE)
        POP     HL              ; Restore address of dimension
        POP     AF              ; Restore number of dimensions
        DEC     A               ; Count them
        JP      NZ,CRARLP       ; Do next dimension if more
        PUSH    AF              ; Save locate/create flag
        LD      B,D             ; MSB of memory needed
        LD      C,E             ; LSB of memory needed
        EX      DE,HL
        ADD     HL,DE           ; Add bytes to array start
        JP      C,OMERR         ; Too big - Error
        CALL    ENFMEM          ; See if enough memory
        LD      (ARREND),HL     ; Save new end of array

ZERARY: DEC     HL              ; Back through array data
        LD      (HL),0          ; Set array element to zero
        CALL    CPDEHL          ; All elements zeroed?
        JP      NZ,ZERARY       ; No - Keep on going
        INC     BC              ; Number of bytes + 1
        LD      D,A             ; A=0
        LD      HL,(CUROPR)     ; Get address of array
        LD      E,(HL)          ; Number of dimensions
        EX      DE,HL           ; To HL
        ADD     HL,HL           ; Two bytes per dimension size
        ADD     HL,BC           ; Add number of bytes
        EX      DE,HL           ; Bytes needed to DE
        DEC     HL
        DEC     HL
        LD      (HL),E          ; Save LSB of bytes needed
        INC     HL
        LD      (HL),D          ; Save MSB of bytes needed
        INC     HL
        POP     AF              ; Locate / Create?
        JP      C,ENDDIM        ; A is 0 , End if create
FINDEL: LD      B,A             ; Find array element
        LD      C,A
        LD      A,(HL)          ; Number of dimensions
        INC     HL
        DB      16H             ; Skip "POP HL"
FNDELP: POP     HL              ; Address of next dim' size
        LD      E,(HL)          ; Get LSB of dim'n size
        INC     HL
        LD      D,(HL)          ; Get MSB of dim'n size
        INC     HL
        EX      (SP),HL         ; Save address - Get index
        PUSH    AF              ; Save number of dim'ns
        CALL    CPDEHL          ; Dimension too large?
        JP      NC,BSERR        ; Yes - ?BS Error
        PUSH    HL              ; Save index
        CALL    MLDEBC          ; Multiply previous by size
        POP     DE              ; Index supplied to DE
        ADD     HL,DE           ; Add index to pointer
        POP     AF              ; Number of dimensions
        DEC     A               ; Count them
        LD      B,H             ; MSB of pointer
        LD      C,L             ; LSB of pointer
        JP      NZ,FNDELP       ; More - Keep going
        ADD     HL,HL           ; 4 Bytes per element
        ADD     HL,HL
        POP     BC              ; Start of array
        ADD     HL,BC           ; Point to element
        EX      DE,HL           ; Address of element to DE
ENDDIM: LD      HL,(NXTOPR)     ; Got code string address
        RET

FRE:    LD      HL,(ARREND)     ; Start of free memory
        EX      DE,HL           ; To DE
        LD      HL,0            ; End of free memory
        ADD     HL,SP           ; Current stack value
        LD      A,(TYPE)        ; Dummy argument type
        OR      A
        JP      Z,FRENUM        ; Numeric - Free variable space
        CALL    GSTRCU          ; Current string to pool
        CALL    GARBGE          ; Garbage collection
        LD      HL,(STRSPC)     ; Bottom of string space in use
        EX      DE,HL           ; To DE
        LD      HL,(STRBOT)     ; Bottom of string space
FRENUM: LD      A,L             ; Get LSB of end
        SUB     E               ; Subtract LSB of beginning
        LD      C,A             ; Save difference if C
        LD      A,H             ; Get MSB of end
        SBC     A,D             ; Subtract MSB of beginning
ACPASS: LD      B,C             ; Return integer AC
ABPASS: LD      D,B             ; Return integer AB
        LD      E,0
        LD      HL,TYPE         ; Point to type
        LD      (HL),E          ; Set type to numeric
        LD      B,80H+16        ; 16 bit integer
        JP      RETINT          ; Return the integr

POS:    LD      A,(CURPOS)      ; Get cursor position
PASSA:  LD      B,A             ; Put A into AB
        XOR     A               ; Zero A
        JP      ABPASS          ; Return integer AB

DEF:    CALL    CHEKFN          ; Get "FN" and name
        CALL    IDTEST          ; Test for illegal direct
        LD      BC,DATA         ; To get next statement
        PUSH    BC              ; Save address for RETurn
        PUSH    DE              ; Save address of function ptr
        CALL    CHKSYN          ; Make sure "(" follows
        DB      "("
        CALL    GETVAR          ; Get argument variable name
        PUSH    HL              ; Save code string address
        EX      DE,HL           ; Argument address to HL
        DEC     HL
        LD      D,(HL)          ; Get first byte of arg name
        DEC     HL
        LD      E,(HL)          ; Get second byte of arg name
        POP     HL              ; Restore code string address
        CALL    TSTNUM          ; Make sure numeric argument
        CALL    CHKSYN          ; Make sure ")" follows
        DB      ")"
        CALL    CHKSYN          ; Make sure "=" follows
        DB      ZEQUAL          ; "=" token
        LD      B,H             ; Code string address to BC
        LD      C,L
        EX      (SP),HL         ; Save code str , Get FN ptr
        LD      (HL),C          ; Save LSB of FN code string
        INC     HL
        LD      (HL),B          ; Save MSB of FN code string
        JP      SVSTAD          ; Save address and do function

DOFN:   CALL    CHEKFN          ; Make sure FN follows
        PUSH    DE              ; Save function pointer address
        CALL    EVLPAR          ; Evaluate expression in "()"
        CALL    TSTNUM          ; Make sure numeric result
        EX      (SP),HL         ; Save code str , Get FN ptr
        LD      E,(HL)          ; Get LSB of FN code string
        INC     HL
        LD      D,(HL)          ; Get MSB of FN code string
        INC     HL
        LD      A,D             ; And function DEFined?
        OR      E
        JP      Z,UFERR         ; No - ?UF Error
        LD      A,(HL)          ; Get LSB of argument address
        INC     HL
        LD      H,(HL)          ; Get MSB of argument address
        LD      L,A             ; HL = Arg variable address
        PUSH    HL              ; Save it
        LD      HL,(FNRGNM)     ; Get old argument name
        EX      (SP),HL ;       ; Save old , Get new
        LD      (FNRGNM),HL     ; Set new argument name
        LD      HL,(FNARG+2)    ; Get LSB,NLSB of old arg value
        PUSH    HL              ; Save it
        LD      HL,(FNARG)      ; Get MSB,EXP of old arg value
        PUSH    HL              ; Save it
        LD      HL,FNARG        ; HL = Value of argument
        PUSH    DE              ; Save FN code string address
        CALL    FPTHL           ; Move FPREG to argument
        POP     HL              ; Get FN code string address
        CALL    GETNUM          ; Get value from function
        DEC     HL              ; DEC 'cos GETCHR INCs
        CALL    GETCHR          ; Get next character
        JP      NZ,SNERR        ; Bad character in FN - Error
        POP     HL              ; Get MSB,EXP of old arg
        LD      (FNARG),HL      ; Restore it
        POP     HL              ; Get LSB,NLSB of old arg
        LD      (FNARG+2),HL    ; Restore it
        POP     HL              ; Get name of old arg
        LD      (FNRGNM),HL     ; Restore it
        POP     HL              ; Restore code string address
        RET

IDTEST: PUSH    HL              ; Save code string address
        LD      HL,(LINEAT)     ; Get current line number
        INC     HL              ; -1 means direct statement
        LD      A,H
        OR      L
        POP     HL              ; Restore code string address
        RET     NZ              ; Return if in program
        LD      E,ID            ; ?ID Error
        JP      ERROR

CHEKFN: CALL    CHKSYN          ; Make sure FN follows
        DB      ZFN             ; "FN" token
        LD      A,80H
        LD      (FORFLG),A      ; Flag FN name to find
        OR      (HL)            ; FN name has bit 7 set
        LD      B,A             ; in first byte of name
        CALL    GTFNAM          ; Get FN name
        JP      TSTNUM          ; Make sure numeric function

STR:    CALL    TSTNUM          ; Make sure it's a number
        CALL    NUMASC          ; Turn number into text
        CALL    CRTST           ; Create string entry for it
        CALL    GSTRCU          ; Current string to pool
        LD      BC,TOPOOL       ; Save in string pool
        PUSH    BC              ; Save address on stack

SAVSTR: LD      A,(HL)          ; Get string length
        INC     HL
        INC     HL
        PUSH    HL              ; Save pointer to string
        CALL    TESTR           ; See if enough string space
        POP     HL              ; Restore pointer to string
        LD      C,(HL)          ; Get LSB of address
        INC     HL
        LD      B,(HL)          ; Get MSB of address
        CALL    CRTMST          ; Create string entry
        PUSH    HL              ; Save pointer to MSB of addr
        LD      L,A             ; Length of string
        CALL    TOSTRA          ; Move to string area
        POP     DE              ; Restore pointer to MSB
        RET

MKTMST: CALL    TESTR           ; See if enough string space
CRTMST: LD      HL,TMPSTR       ; Temporary string
        PUSH    HL              ; Save it
        LD      (HL),A          ; Save length of string
        INC     HL
SVSTAD: INC     HL
        LD      (HL),E          ; Save LSB of address
        INC     HL
        LD      (HL),D          ; Save MSB of address
        POP     HL              ; Restore pointer
        RET

CRTST:  DEC     HL              ; DEC - INCed after
QTSTR:  LD      B,'"'           ; Terminating quote
        LD      D,B             ; Quote to D
DTSTR:  PUSH    HL              ; Save start
        LD      C,-1            ; Set counter to -1
QTSTLP: INC     HL              ; Move on
        LD      A,(HL)          ; Get byte
        INC     C               ; Count bytes
        OR      A               ; End of line?
        JP      Z,CRTSTE        ; Yes - Create string entry
        CP      D               ; Terminator D found?
        JP      Z,CRTSTE        ; Yes - Create string entry
        CP      B               ; Terminator B found?
        JP      NZ,QTSTLP       ; No - Keep looking
CRTSTE: CP      '"'             ; End with '"'?
        CALL    Z,GETCHR        ; Yes - Get next character
        EX      (SP),HL         ; Starting quote
        INC     HL              ; First byte of string
        EX      DE,HL           ; To DE
        LD      A,C             ; Get length
        CALL    CRTMST          ; Create string entry
TSTOPL: LD      DE,TMPSTR       ; Temporary string
        LD      HL,(TMSTPT)     ; Temporary string pool pointer
        LD      (FPREG),HL      ; Save address of string ptr
        LD      A,1
        LD      (TYPE),A        ; Set type to string
        CALL    DETHL4          ; Move string to pool
        CALL    CPDEHL          ; Out of string pool?
        LD      (TMSTPT),HL     ; Save new pointer
        POP     HL              ; Restore code string address
        LD      A,(HL)          ; Get next code byte
        RET     NZ              ; Return if pool OK
        LD      E,ST            ; ?ST Error
        JP      ERROR           ; String pool overflow

PRNUMS: INC     HL              ; Skip leading space
PRS:    CALL    CRTST           ; Create string entry for it
PRS1:   CALL    GSTRCU          ; Current string to pool
        CALL    LOADFP          ; Move string block to BCDE
        INC     E               ; Length + 1
PRSLP:  DEC     E               ; Count characters
        RET     Z               ; End of string
        LD      A,(BC)          ; Get byte to output
        CALL    OUTC            ; Output character in A
        CP      CR              ; Return?
        CALL    Z,DONULL        ; Yes - Do nulls
        INC     BC              ; Next byte in string
        JP      PRSLP           ; More characters to output

TESTR:  OR      A               ; Test if enough room
        DB      0EH             ; No garbage collection done
GRBDON: POP     AF              ; Garbage collection done
        PUSH    AF              ; Save status
        LD      HL,(STRSPC)     ; Bottom of string space in use
        EX      DE,HL           ; To DE
        LD      HL,(STRBOT)     ; Bottom of string area
        CPL                     ; Negate length (Top down)
        LD      C,A             ; -Length to BC
        LD      B,-1            ; BC = -ve length of string
        ADD     HL,BC           ; Add to bottom of space in use
        INC     HL              ; Plus one for 2's complement
        CALL    CPDEHL          ; Below string RAM area?
        JP      C,TESTOS        ; Tidy up if not done else err
        LD      (STRBOT),HL     ; Save new bottom of area
        INC     HL              ; Point to first byte of string
        EX      DE,HL           ; Address to DE
POPAF:  POP     AF              ; Throw away status push
        RET

TESTOS: POP     AF              ; Garbage collect been done?
        LD      E,OS            ; ?OS Error
        JP      Z,ERROR         ; Yes - Not enough string apace
        CP      A               ; Flag garbage collect done
        PUSH    AF              ; Save status
        LD      BC,GRBDON       ; Garbage collection done
        PUSH    BC              ; Save for RETurn
GARBGE: LD      HL,(LSTRAM)     ; Get end of RAM pointer
GARBLP: LD      (STRBOT),HL     ; Reset string pointer
        LD      HL,0
        PUSH    HL              ; Flag no string found
        LD      HL,(STRSPC)     ; Get bottom of string space
        PUSH    HL              ; Save bottom of string space
        LD      HL,TMSTPL       ; Temporary string pool
GRBLP:  EX      DE,HL
        LD      HL,(TMSTPT)     ; Temporary string pool pointer
        EX      DE,HL
        CALL    CPDEHL          ; Temporary string pool done?
        LD      BC,GRBLP        ; Loop until string pool done
        JP      NZ,STPOOL       ; No - See if in string area
        LD      HL,(PROGND)     ; Start of simple variables
SMPVAR: EX      DE,HL
        LD      HL,(VAREND)     ; End of simple variables
        EX      DE,HL
        CALL    CPDEHL          ; All simple strings done?
        JP      Z,ARRLP         ; Yes - Do string arrays
        LD      A,(HL)          ; Get type of variable
        INC     HL
        INC     HL
        OR      A               ; "S" flag set if string
        CALL    STRADD          ; See if string in string area
        JP      SMPVAR          ; Loop until simple ones done

GNXARY: POP     BC              ; Scrap address of this array
ARRLP:  EX      DE,HL
        LD      HL,(ARREND)     ; End of string arrays
        EX      DE,HL
        CALL    CPDEHL          ; All string arrays done?
        JP      Z,SCNEND        ; Yes - Move string if found
        CALL    LOADFP          ; Get array name to BCDE
        LD      A,E             ; Get type of array     
        PUSH    HL              ; Save address of num of dim'ns
        ADD     HL,BC           ; Start of next array
        OR      A               ; Test type of array
        JP      P,GNXARY        ; Numeric array - Ignore it
        LD      (CUROPR),HL     ; Save address of next array
        POP     HL              ; Get address of num of dim'ns
        LD      C,(HL)          ; BC = Number of dimensions
        LD      B,0
        ADD     HL,BC           ; Two bytes per dimension size
        ADD     HL,BC
        INC     HL              ; Plus one for number of dim'ns
GRBARY: EX      DE,HL
        LD      HL,(CUROPR)     ; Get address of next array
        EX      DE,HL
        CALL    CPDEHL          ; Is this array finished?
        JP      Z,ARRLP         ; Yes - Get next one
        LD      BC,GRBARY       ; Loop until array all done
STPOOL: PUSH    BC              ; Save return address
        OR      80H             ; Flag string type
STRADD: LD      A,(HL)          ; Get string length
        INC     HL
        INC     HL
        LD      E,(HL)          ; Get LSB of string address
        INC     HL
        LD      D,(HL)          ; Get MSB of string address
        INC     HL
        RET     P               ; Not a string - Return
        OR      A               ; Set flags on string length
        RET     Z               ; Null string - Return
        LD      B,H             ; Save variable pointer
        LD      C,L
        LD      HL,(STRBOT)     ; Bottom of new area
        CALL    CPDEHL          ; String been done?
        LD      H,B             ; Restore variable pointer
        LD      L,C
        RET     C               ; String done - Ignore
        POP     HL              ; Return address
        EX      (SP),HL         ; Lowest available string area
        CALL    CPDEHL          ; String within string area?
        EX      (SP),HL         ; Lowest available string area
        PUSH    HL              ; Re-save return address
        LD      H,B             ; Restore variable pointer
        LD      L,C
        RET     NC              ; Outside string area - Ignore
        POP     BC              ; Get return , Throw 2 away
        POP     AF              ; 
        POP     AF              ; 
        PUSH    HL              ; Save variable pointer
        PUSH    DE              ; Save address of current
        PUSH    BC              ; Put back return address
        RET                     ; Go to it

SCNEND: POP     DE              ; Addresses of strings
        POP     HL              ; 
        LD      A,L             ; HL = 0 if no more to do
        OR      H
        RET     Z               ; No more to do - Return
        DEC     HL
        LD      B,(HL)          ; MSB of address of string
        DEC     HL
        LD      C,(HL)          ; LSB of address of string
        PUSH    HL              ; Save variable address
        DEC     HL
        DEC     HL
        LD      L,(HL)          ; HL = Length of string
        LD      H,0
        ADD     HL,BC           ; Address of end of string+1
        LD      D,B             ; String address to DE
        LD      E,C
        DEC     HL              ; Last byte in string
        LD      B,H             ; Address to BC
        LD      C,L
        LD      HL,(STRBOT)     ; Current bottom of string area
        CALL    MOVSTR          ; Move string to new address
        POP     HL              ; Restore variable address
        LD      (HL),C          ; Save new LSB of address
        INC     HL
        LD      (HL),B          ; Save new MSB of address
        LD      L,C             ; Next string area+1 to HL
        LD      H,B
        DEC     HL              ; Next string area address
        JP      GARBLP          ; Look for more strings

CONCAT: PUSH    BC              ; Save prec' opr & code string
        PUSH    HL              ; 
        LD      HL,(FPREG)      ; Get first string
        EX      (SP),HL         ; Save first string
        CALL    OPRND           ; Get second string
        EX      (SP),HL         ; Restore first string
        CALL    TSTSTR          ; Make sure it's a string
        LD      A,(HL)          ; Get length of second string
        PUSH    HL              ; Save first string
        LD      HL,(FPREG)      ; Get second string
        PUSH    HL              ; Save second string
        ADD     A,(HL)          ; Add length of second string
        LD      E,LS            ; ?LS Error
        JP      C,ERROR         ; String too long - Error
        CALL    MKTMST          ; Make temporary string
        POP     DE              ; Get second string to DE
        CALL    GSTRDE          ; Move to string pool if needed
        EX      (SP),HL         ; Get first string
        CALL    GSTRHL          ; Move to string pool if needed
        PUSH    HL              ; Save first string
        LD      HL,(TMPSTR+2)   ; Temporary string address
        EX      DE,HL           ; To DE
        CALL    SSTSA           ; First string to string area
        CALL    SSTSA           ; Second string to string area
        LD      HL,EVAL2        ; Return to evaluation loop
        EX      (SP),HL         ; Save return,get code string
        PUSH    HL              ; Save code string address
        JP      TSTOPL          ; To temporary string to pool

SSTSA:  POP     HL              ; Return address
        EX      (SP),HL         ; Get string block,save return
        LD      A,(HL)          ; Get length of string
        INC     HL
        INC     HL
        LD      C,(HL)          ; Get LSB of string address
        INC     HL
        LD      B,(HL)          ; Get MSB of string address
        LD      L,A             ; Length to L
TOSTRA: INC     L               ; INC - DECed after
TSALP:  DEC     L               ; Count bytes moved
        RET     Z               ; End of string - Return
        LD      A,(BC)          ; Get source
        LD      (DE),A          ; Save destination
        INC     BC              ; Next source
        INC     DE              ; Next destination
        JP      TSALP           ; Loop until string moved

GETSTR: CALL    TSTSTR          ; Make sure it's a string
GSTRCU: LD      HL,(FPREG)      ; Get current string
GSTRHL: EX      DE,HL           ; Save DE
GSTRDE: CALL    BAKTMP          ; Was it last tmp-str?
        EX      DE,HL           ; Restore DE
        RET     NZ              ; No - Return
        PUSH    DE              ; Save string
        LD      D,B             ; String block address to DE
        LD      E,C
        DEC     DE              ; Point to length
        LD      C,(HL)          ; Get string length
        LD      HL,(STRBOT)     ; Current bottom of string area
        CALL    CPDEHL          ; Last one in string area?
        JP      NZ,POPHL        ; No - Return
        LD      B,A             ; Clear B (A=0)
        ADD     HL,BC           ; Remove string from str' area
        LD      (STRBOT),HL     ; Save new bottom of str' area
POPHL:  POP     HL              ; Restore string
        RET

BAKTMP: LD      HL,(TMSTPT)     ; Get temporary string pool top
        DEC     HL              ; Back
        LD      B,(HL)          ; Get MSB of address
        DEC     HL              ; Back
        LD      C,(HL)          ; Get LSB of address
        DEC     HL              ; Back
        DEC     HL              ; Back
        CALL    CPDEHL          ; String last in string pool?
        RET     NZ              ; Yes - Leave it
        LD      (TMSTPT),HL     ; Save new string pool top
        RET

LEN:    LD      BC,PASSA        ; To return integer A
        PUSH    BC              ; Save address
GETLEN: CALL    GETSTR          ; Get string and its length
        XOR     A
        LD      D,A             ; Clear D
        LD      (TYPE),A        ; Set type to numeric
        LD      A,(HL)          ; Get length of string
        OR      A               ; Set status flags
        RET

ASC:    LD      BC,PASSA        ; To return integer A
        PUSH    BC              ; Save address
GTFLNM: CALL    GETLEN          ; Get length of string
        JP      Z,FCERR         ; Null string - Error
        INC     HL
        INC     HL
        LD      E,(HL)          ; Get LSB of address
        INC     HL
        LD      D,(HL)          ; Get MSB of address
        LD      A,(DE)          ; Get first byte of string
        RET

CHR:    LD      A,1             ; One character string
        CALL    MKTMST          ; Make a temporary string
        CALL    MAKINT          ; Make it integer A
        LD      HL,(TMPSTR+2)   ; Get address of string
        LD      (HL),E          ; Save character
TOPOOL: POP     BC              ; Clean up stack
        JP      TSTOPL          ; Temporary string to pool

LEFT:   CALL    LFRGNM          ; Get number and ending ")"
        XOR     A               ; Start at first byte in string
RIGHT1: EX      (SP),HL         ; Save code string,Get string
        LD      C,A             ; Starting position in string
MID1:   PUSH    HL              ; Save string block address
        LD      A,(HL)          ; Get length of string
        CP      B               ; Compare with number given
        JP      C,ALLFOL        ; All following bytes required
        LD      A,B             ; Get new length
        DB      11H             ; Skip "LD C,0"
ALLFOL: LD      C,0             ; First byte of string
        PUSH    BC              ; Save position in string
        CALL    TESTR           ; See if enough string space
        POP     BC              ; Get position in string
        POP     HL              ; Restore string block address
        PUSH    HL              ; And re-save it
        INC     HL
        INC     HL
        LD      B,(HL)          ; Get LSB of address
        INC     HL
        LD      H,(HL)          ; Get MSB of address
        LD      L,B             ; HL = address of string
        LD      B,0             ; BC = starting address
        ADD     HL,BC           ; Point to that byte
        LD      B,H             ; BC = source string
        LD      C,L
        CALL    CRTMST          ; Create a string entry
        LD      L,A             ; Length of new string
        CALL    TOSTRA          ; Move string to string area
        POP     DE              ; Clear stack
        CALL    GSTRDE          ; Move to string pool if needed
        JP      TSTOPL          ; Temporary string to pool

RIGHT:  CALL    LFRGNM          ; Get number and ending ")"
        POP     DE              ; Get string length
        PUSH    DE              ; And re-save
        LD      A,(DE)          ; Get length
        SUB     B               ; Move back N bytes
        JP      RIGHT1          ; Go and get sub-string

MID:    EX      DE,HL           ; Get code string address
        LD      A,(HL)          ; Get next byte "," or ")"
        CALL    MIDNUM          ; Get number supplied
        INC     B               ; Is it character zero?
        DEC     B
        JP      Z,FCERR         ; Yes - Error
        PUSH    BC              ; Save starting position
        LD      E,255           ; All of string
        CP      ")"             ; Any length given?
        JP      Z,RSTSTR        ; No - Rest of string
        CALL    CHKSYN          ; Make sure "," follows
        DB      ","
        CALL    GETINT          ; Get integer 0-255
RSTSTR: CALL    CHKSYN          ; Make sure ")" follows
        DB      ")"
        POP     AF              ; Restore starting position
        EX      (SP),HL         ; Get string,8ave code string
        LD      BC,MID1         ; Continuation of MID$ routine
        PUSH    BC              ; Save for return
        DEC     A               ; Starting position-1
        CP      (HL)            ; Compare with length
        LD      B,0             ; Zero bytes length
        RET     NC              ; Null string if start past end
        LD      C,A             ; Save starting position-1
        LD      A,(HL)          ; Get length of string
        SUB     C               ; Subtract start
        CP      E               ; Enough string for it?
        LD      B,A             ; Save maximum length available
        RET     C               ; Truncate string if needed
        LD      B,E             ; Set specified length
        RET                     ; Go and create string

VAL:    CALL    GETLEN          ; Get length of string
        JP      Z,RESZER        ; Result zero
        LD      E,A             ; Save length
        INC     HL
        INC     HL
        LD      A,(HL)          ; Get LSB of address
        INC     HL
        LD      H,(HL)          ; Get MSB of address
        LD      L,A             ; HL = String address
        PUSH    HL              ; Save string address
        ADD     HL,DE
        LD      B,(HL)          ; Get end of string+1 byte
        LD      (HL),D          ; Zero it to terminate
        EX      (SP),HL         ; Save string end,get start
        PUSH    BC              ; Save end+1 byte
        LD      A,(HL)          ; Get starting byte
        CALL    ASCTFP          ; Convert ASCII string to FP
        POP     BC              ; Restore end+1 byte
        POP     HL              ; Restore end+1 address
        LD      (HL),B          ; Put back original byte
        RET

LFRGNM: EX      DE,HL           ; Code string address to HL
        CALL    CHKSYN          ; Make sure ")" follows
        DB      ")"
MIDNUM: POP     BC              ; Get return address
        POP     DE              ; Get number supplied
        PUSH    BC              ; Re-save return address
        LD      B,E             ; Number to B
        RET

INP:    CALL    MAKINT          ; Make it integer A
        LD      (INPORT),A      ; Set input port
        CALL    INPSUB          ; Get input from port
        JP      PASSA           ; Return integer A

POUT:   CALL    SETIO           ; Set up port number
        JP      OUTSUB          ; Output data and return

WAIT:   CALL    SETIO           ; Set up port number
        PUSH    AF              ; Save AND mask
        LD      E,0             ; Assume zero if none given
        DEC     HL              ; DEC 'cos GETCHR INCs
        CALL    GETCHR          ; Get next character
        JP      Z,NOXOR         ; No XOR byte given
        CALL    CHKSYN          ; Make sure "," follows
        DB      ","
        CALL    GETINT          ; Get integer 0-255 to XOR with
NOXOR:  POP     BC              ; Restore AND mask
WAITLP: CALL    INPSUB          ; Get input
        XOR     E               ; Flip selected bits
        AND     B               ; Result non-zero?
        JP      Z,WAITLP        ; No = keep waiting
        RET

SETIO:  CALL    GETINT          ; Get integer 0-255
        LD      (INPORT),A      ; Set input port
        LD      (OTPORT),A      ; Set output port
        CALL    CHKSYN          ; Make sure "," follows
        DB      ","
        JP      GETINT          ; Get integer 0-255 and return

FNDNUM: CALL    GETCHR          ; Get next character
GETINT: CALL    GETNUM          ; Get a number from 0 to 255
MAKINT: CALL    DEPINT          ; Make sure value 0 - 255
        LD      A,D             ; Get MSB of number
        OR      A               ; Zero?
        JP      NZ,FCERR        ; No - Error
        DEC     HL              ; DEC 'cos GETCHR INCs
        CALL    GETCHR          ; Get next character
        LD      A,E             ; Get number to A
        RET

; << NO  REFERENCE  TO  THIS  SECTION  OF  CODE >>
; << Set up another program area (can be in ROM) >>

        LD      HL,(BASTXT)     ; Get start of program text
        LD      (PROGND),HL     ; Set more variable space
        LD      HL,8000H        ; Address of new program
        LD      E,(HL)          ; Get LSB of new RAM end
        INC     HL
        LD      D,(HL)          ; Get MSB of new RAM end
        INC     HL
        INC     HL              ; Null at start of program
        LD      (BASTXT),HL     ; New program text area 8003H
        EX      DE,HL           ; New RAM end to HL
        LD      (LSTRAM),HL     ; Set new RAM end
        LD      (STRSPC),HL     ; Clear string space
        LD      BC,RUNCNT       ; Execution driver loop
        PUSH    BC              ; Save for return
        JP      RUNFST          ; Clear variables and continue

RUART:  JP      GUART           ; Get a byte from UART

WUART2: CALL    WUART           ; Send 2 Bytes to UART
WUART:  PUSH    AF              ; Save byte
        PUSH    BC              ; Save BC
        LD      C,A             ; Byte to C
        CALL    SUART           ; Send byte to UART
        POP     BC              ; Restore BC
        POP     AF              ; Restore byte
        RET

CSAVE:  LD      B,1             ; Flag "CSAVE"
        CP      ZTIMES          ; "*" token? ("CSAVE*")
        JP      Z,ARRSV1        ; Yes - Array save
        CALL    EVAL            ; Evaluate expression
        PUSH    HL              ; Save code string address
        CALL    GTFLNM          ; Get file name
        PUSH    DE              ; Save file name
        CALL    CASFFW          ; Turn on motor and wait
        POP     DE              ; Restore file name
        LD      A,11010011B     ; Header byte
        CALL    WUART           ; Send byte to UART
        CALL    WUART2          ; Send byte twice more
        LD      A,(DE)          ; Get file name
        CALL    WUART           ; Send it to UART
        NOP
        NOP
        NOP
        LD      HL,PROGND       ; Start of program information
        LD      (ARG1),HL       ; Save for monitor save routine
        LD      HL,(PROGND)     ; End of program information
        LD      (ARG2),HL       ; Save for monitor save routine
        CALL    SAVE            ; Save program to tape
        CALL    ARET            ; Not much there!
        POP     HL              ; Restore code string address
        RET

CLOAD:  LD      A,(HL)          ; Get byte after "CLOAD"
        CP      ZTIMES          ; "*" token? ("CLOAD*")
        JP      Z,ARRLD1        ; Yes - Array load
        CALL    SMOTOR          ; Start motor and get "?"
        SUB     ZPRINT          ; "?" ("PRINT" token) Verify?
        JP      Z,FLGVER        ; Yes - Flag "verify"
        XOR     A               ; Flag "load"
        DB      01H             ; Skip "CPL" and "INC HL"
FLGVER: CPL                     ; Flag "verify"
        INC     HL              ; Skip over "?"
        PUSH    AF              ; Save verify flag
        DEC     HL              ; DEC 'cos GETCHR INCs
        CALL    GETCHR          ; Get next character
        LD      A,0             ; Any file will do
        JP      Z,ANYNAM        ; No name given - Any will do
        CALL    EVAL            ; Evaluate expression
        CALL    GTFLNM          ; Get file name
        LD      A,(DE)          ; Get first byte of name
ANYNAM: LD      L,A             ; Save name to find
        POP     AF              ; Get verify flag
        PUSH    AF              ; And re-save
        OR      A               ; Verify of load?
        LD      H,A
        LD      (FPREG),HL      ; Save nam of file to find
        CALL    Z,CLRPTR        ; Load - Clear pointers
        LD      HL,(FPREG)      ; Get name of program to find
        EX      DE,HL           ; Name to DE
CLOAD1: LD      B,3             ; 3 Header bytes
CLOAD2: CALL    RUART           ; Get a byte from UART
        SUB     11010011B       ; Header byte?
        JP      NZ,CLOAD1       ; Look for header
        DEC     B               ; Count header bytes
        JP      NZ,CLOAD2       ; More to find?
        CALL    RUART           ; Get name of file
        CALL    FILFND          ; Display "file X found"
        INC     E               ; Any file name given?
        DEC     E
        JP      Z,THSFIL        ; No - This file will do
        CP      E               ; Has file been found?
        JP      NZ,CLOAD1       ; No - Look for another
THSFIL: NOP
        NOP
        NOP
        POP     AF              ; Get verify flag
        OR      A               ; Load or verify?
        JP      NZ,CLOADV       ; Verify program
        CALL    MONLD           ; Use monitor to load program
        LD      HL,(PROGND)     ; Get end of program
        CALL    ENFMEM          ; See if enough memory
        JP      CLOADE          ; "Ok" and set up pointers

CLOADV: CALL    MONVE           ; Use monitor to verify program
CLOADE: LD      HL,OKMSG        ; "Ok" message
        CALL    PRS             ; Output string
        CALL    ARET            ; Not a lot there!
        JP      SETPTR          ; Set up line pointers

OUTBAD: LD      HL,BAD          ; "Bad" message
        CALL    PRS             ; Output string
        JP      ERRIN           ; In line message

FILFND: PUSH    BC              ; <- Save
        PUSH    HL              ; <- all
        PUSH    DE              ; <- the
        PUSH    AF              ; <- registers
        LD      HL,FILE         ; "File" message
        CALL    PRS             ; Output string
        POP     AF              ; Get file name
        PUSH    AF              ; And re-save
        CALL    CONMON          ; Output file name to screen
        LD      HL,FOUND        ; "Found" message
        CALL    PRS             ; Output string
        POP     AF              ; <- Restore
        POP     DE              ; <- all
        POP     HL              ; <- the
        POP     BC              ; <- registers
        RET

FILE:   DB      "File ",0
FOUND:  DB      " Found",CR,LF,0
BAD:    DB      "Bad",0,0,0

PEEK:   CALL    DEINT           ; Get memory address
        LD      A,(DE)          ; Get byte in memory
        JP      PASSA           ; Return integer A

POKE:   CALL    GETNUM          ; Get memory address
        CALL    DEINT           ; Get integer -32768 to 3276
        PUSH    DE              ; Save memory address
        CALL    CHKSYN          ; Make sure "," follows
        DB      ","
        CALL    GETINT          ; Get integer 0-255
        POP     DE              ; Restore memory address
        LD      (DE),A          ; Load it into memory
        RET

ROUND:  LD      HL,HALF         ; Add 0.5 to FPREG
ADDPHL: CALL    LOADFP          ; Load FP at (HL) to BCDE
        JP      FPADD           ; Add BCDE to FPREG

SUBPHL: CALL    LOADFP          ; FPREG = -FPREG + number at HL
        DB      21H             ; Skip "POP BC" and "POP DE"
PSUB:   POP     BC              ; Get FP number from stack
        POP     DE
SUBCDE: CALL    INVSGN          ; Negate FPREG
FPADD:  LD      A,B             ; Get FP exponent
        OR      A               ; Is number zero?
        RET     Z               ; Yes - Nothing to add
        LD      A,(FPEXP)       ; Get FPREG exponent
        OR      A               ; Is this number zero?
        JP      Z,FPBCDE        ; Yes - Move BCDE to FPREG
        SUB     B               ; BCDE number larger?
        JP      NC,NOSWAP       ; No - Don't swap them
        CPL                     ; Two's complement
        INC     A               ;  FP exponent
        EX      DE,HL
        CALL    STAKFP          ; Put FPREG on stack
        EX      DE,HL
        CALL    FPBCDE          ; Move BCDE to FPREG
        POP     BC              ; Restore number from stack
        POP     DE
NOSWAP: CP      24+1            ; Second number insignificant?
        RET     NC              ; Yes - First number is result
        PUSH    AF              ; Save number of bits to scale
        CALL    SIGNS           ; Set MSBs & sign of result
        LD      H,A             ; Save sign of result
        POP     AF              ; Restore scaling factor
        CALL    SCALE           ; Scale BCDE to same exponent
        OR      H               ; Result to be positive?
        LD      HL,FPREG        ; Point to FPREG
        JP      P,MINCDE        ; No - Subtract FPREG from CDE
        CALL    PLUCDE          ; Add FPREG to CDE
        JP      NC,RONDUP       ; No overflow - Round it up
        INC     HL              ; Point to exponent
        INC     (HL)            ; Increment it
        JP      Z,OVERR         ; Number overflowed - Error
        LD      L,1             ; 1 bit to shift right
        CALL    SHRT1           ; Shift result right
        JP      RONDUP          ; Round it up

MINCDE: XOR     A               ; Clear A and carry
        SUB     B               ; Negate exponent
        LD      B,A             ; Re-save exponent
        LD      A,(HL)          ; Get LSB of FPREG
        SBC     A, E            ; Subtract LSB of BCDE
        LD      E,A             ; Save LSB of BCDE
        INC     HL
        LD      A,(HL)          ; Get NMSB of FPREG
        SBC     A,D             ; Subtract NMSB of BCDE
        LD      D,A             ; Save NMSB of BCDE
        INC     HL
        LD      A,(HL)          ; Get MSB of FPREG
        SBC     A,C             ; Subtract MSB of BCDE
        LD      C,A             ; Save MSB of BCDE
CONPOS: CALL    C,COMPL         ; Overflow - Make it positive

BNORM:  LD      L,B             ; L = Exponent
        LD      H,E             ; H = LSB
        XOR     A
BNRMLP: LD      B,A             ; Save bit count
        LD      A,C             ; Get MSB
        OR      A               ; Is it zero?
        JP      NZ,PNORM        ; No - Do it bit at a time
        LD      C,D             ; MSB = NMSB
        LD      D,H             ; NMSB= LSB
        LD      H,L             ; LSB = VLSB
        LD      L,A             ; VLSB= 0
        LD      A,B             ; Get exponent
        SUB     8               ; Count 8 bits
        CP      -24-8           ; Was number zero?
        JP      NZ,BNRMLP       ; No - Keep normalising
RESZER: XOR     A               ; Result is zero
SAVEXP: LD      (FPEXP),A       ; Save result as zero
        RET

NORMAL: DEC     B               ; Count bits
        ADD     HL,HL           ; Shift HL left
        LD      A,D             ; Get NMSB
        RLA                     ; Shift left with last bit
        LD      D,A             ; Save NMSB
        LD      A,C             ; Get MSB
        ADC     A,A             ; Shift left with last bit
        LD      C,A             ; Save MSB
PNORM:  JP      P,NORMAL        ; Not done - Keep going
        LD      A,B             ; Number of bits shifted
        LD      E,H             ; Save HL in EB
        LD      B,L
        OR      A               ; Any shifting done?
        JP      Z,RONDUP        ; No - Round it up
        LD      HL,FPEXP        ; Point to exponent
        ADD     A,(HL)          ; Add shifted bits
        LD      (HL),A          ; Re-save exponent
        JP      NC,RESZER       ; Underflow - Result is zero
        RET     Z               ; Result is zero
RONDUP: LD      A,B             ; Get VLSB of number
RONDB:  LD      HL,FPEXP        ; Point to exponent
        OR      A               ; Any rounding?
        CALL    M,FPROND        ; Yes - Round number up
        LD      B,(HL)          ; B = Exponent
        INC     HL
        LD      A,(HL)          ; Get sign of result
        AND     10000000B       ; Only bit 7 needed
        XOR     C               ; Set correct sign
        LD      C,A             ; Save correct sign in number
        JP      FPBCDE          ; Move BCDE to FPREG

FPROND: INC     E               ; Round LSB
        RET     NZ              ; Return if ok
        INC     D               ; Round NMSB
        RET     NZ              ; Return if ok
        INC     C               ; Round MSB
        RET     NZ              ; Return if ok
        LD      C,80H           ; Set normal value
        INC     (HL)            ; Increment exponent
        RET     NZ              ; Return if ok
        JP      OVERR           ; Overflow error

PLUCDE: LD      A,(HL)          ; Get LSB of FPREG
        ADD     A,E             ; Add LSB of BCDE
        LD      E,A             ; Save LSB of BCDE
        INC     HL
        LD      A,(HL)          ; Get NMSB of FPREG
        ADC     A,D             ; Add NMSB of BCDE
        LD      D,A             ; Save NMSB of BCDE
        INC     HL
        LD      A,(HL)          ; Get MSB of FPREG
        ADC     A,C             ; Add MSB of BCDE
        LD      C,A             ; Save MSB of BCDE
        RET

COMPL:  LD      HL,SGNRES       ; Sign of result
        LD      A,(HL)          ; Get sign of result
        CPL                     ; Negate it
        LD      (HL),A          ; Put it back
        XOR     A
        LD      L,A             ; Set L to zero
        SUB     B               ; Negate exponent,set carry
        LD      B,A             ; Re-save exponent
        LD      A,L             ; Load zero
        SBC     A,E             ; Negate LSB
        LD      E,A             ; Re-save LSB
        LD      A,L             ; Load zero
        SBC     A,D             ; Negate NMSB
        LD      D,A             ; Re-save NMSB
        LD      A,L             ; Load zero
        SBC     A,C             ; Negate MSB
        LD      C,A             ; Re-save MSB
        RET

SCALE:  LD      B,0             ; Clear underflow
SCALLP: SUB     8               ; 8 bits (a whole byte)?
        JP      C,SHRITE        ; No - Shift right A bits
        LD      B,E             ; <- Shift
        LD      E,D             ; <- right
        LD      D,C             ; <- eight
        LD      C,0             ; <- bits
        JP      SCALLP          ; More bits to shift

SHRITE: ADD     A,8+1           ; Adjust count
        LD      L,A             ; Save bits to shift
SHRLP:  XOR     A               ; Flag for all done
        DEC     L               ; All shifting done?
        RET     Z               ; Yes - Return
        LD      A,C             ; Get MSB
SHRT1:  RRA                     ; Shift it right
        LD      C,A             ; Re-save
        LD      A,D             ; Get NMSB
        RRA                     ; Shift right with last bit
        LD      D,A             ; Re-save it
        LD      A,E             ; Get LSB
        RRA                     ; Shift right with last bit
        LD      E,A             ; Re-save it
        LD      A,B             ; Get underflow
        RRA                     ; Shift right with last bit
        LD      B,A             ; Re-save underflow
        JP      SHRLP           ; More bits to do

UNITY:  DB       000H,000H,000H,081H    ; 1.00000

LOGTAB: DB      3                       ; Table used by LOG
        DB      0AAH,056H,019H,080H     ; 0.59898
        DB      0F1H,022H,076H,080H     ; 0.96147
        DB      045H,0AAH,038H,082H     ; 2.88539

LOG:    CALL    TSTSGN          ; Test sign of value
        OR      A
        JP      PE,FCERR        ; ?FC Error if <= zero
        LD      HL,FPEXP        ; Point to exponent
        LD      A,(HL)          ; Get exponent
        LD      BC,8035H        ; BCDE = SQR(1/2)
        LD      DE,04F3H
        SUB     B               ; Scale value to be < 1
        PUSH    AF              ; Save scale factor
        LD      (HL),B          ; Save new exponent
        PUSH    DE              ; Save SQR(1/2)
        PUSH    BC
        CALL    FPADD           ; Add SQR(1/2) to value
        POP     BC              ; Restore SQR(1/2)
        POP     DE
        INC     B               ; Make it SQR(2)
        CALL    DVBCDE          ; Divide by SQR(2)
        LD      HL,UNITY        ; Point to 1.
        CALL    SUBPHL          ; Subtract FPREG from 1
        LD      HL,LOGTAB       ; Coefficient table
        CALL    SUMSER          ; Evaluate sum of series
        LD      BC,8080H        ; BCDE = -0.5
        LD      DE,0000H
        CALL    FPADD           ; Subtract 0.5 from FPREG
        POP     AF              ; Restore scale factor
        CALL    RSCALE          ; Re-scale number
MULLN2: LD      BC,8031H        ; BCDE = Ln(2)
        LD      DE,7218H
        DB      21H             ; Skip "POP BC" and "POP DE"

MULT:   POP     BC              ; Get number from stack
        POP     DE
FPMULT: CALL    TSTSGN          ; Test sign of FPREG
        RET     Z               ; Return zero if zero
        LD      L,0             ; Flag add exponents
        CALL    ADDEXP          ; Add exponents
        LD      A,C             ; Get MSB of multiplier
        LD      (MULVAL),A      ; Save MSB of multiplier
        EX      DE,HL
        LD      (MULVAL+1),HL   ; Save rest of multiplier
        LD      BC,0            ; Partial product (BCDE) = zero
        LD      D,B
        LD      E,B
        LD      HL,BNORM        ; Address of normalise
        PUSH    HL              ; Save for return
        LD      HL,MULT8        ; Address of 8 bit multiply
        PUSH    HL              ; Save for NMSB,MSB
        PUSH    HL              ; 
        LD      HL,FPREG        ; Point to number
MULT8:  LD      A,(HL)          ; Get LSB of number
        INC     HL              ; Point to NMSB
        OR      A               ; Test LSB
        JP      Z,BYTSFT        ; Zero - shift to next byte
        PUSH    HL              ; Save address of number
        LD      L,8             ; 8 bits to multiply by
MUL8LP: RRA                     ; Shift LSB right
        LD      H,A             ; Save LSB
        LD      A,C             ; Get MSB
        JP      NC,NOMADD       ; Bit was zero - Don't add
        PUSH    HL              ; Save LSB and count
        LD      HL,(MULVAL+1)   ; Get LSB and NMSB
        ADD     HL,DE           ; Add NMSB and LSB
        EX      DE,HL           ; Leave sum in DE
        POP     HL              ; Restore MSB and count
        LD      A,(MULVAL)      ; Get MSB of multiplier
        ADC     A,C             ; Add MSB
NOMADD: RRA                     ; Shift MSB right
        LD      C,A             ; Re-save MSB
        LD      A,D             ; Get NMSB
        RRA                     ; Shift NMSB right
        LD      D,A             ; Re-save NMSB
        LD      A,E             ; Get LSB
        RRA                     ; Shift LSB right
        LD      E,A             ; Re-save LSB
        LD      A,B             ; Get VLSB
        RRA                     ; Shift VLSB right
        LD      B,A             ; Re-save VLSB
        DEC     L               ; Count bits multiplied
        LD      A,H             ; Get LSB of multiplier
        JP      NZ,MUL8LP       ; More - Do it
POPHRT: POP     HL              ; Restore address of number
        RET

BYTSFT: LD      B,E             ; Shift partial product left
        LD      E,D
        LD      D,C
        LD      C,A
        RET

DIV10:  CALL    STAKFP          ; Save FPREG on stack
        LD      BC,8420H        ; BCDE = 10.
        LD      DE,0000H
        CALL    FPBCDE          ; Move 10 to FPREG

DIV:    POP     BC              ; Get number from stack
        POP     DE
DVBCDE: CALL    TSTSGN          ; Test sign of FPREG
        JP      Z,DZERR         ; Error if division by zero
        LD      L,-1            ; Flag subtract exponents
        CALL    ADDEXP          ; Subtract exponents
        INC     (HL)            ; Add 2 to exponent to adjust
        INC     (HL)
        DEC     HL              ; Point to MSB
        LD      A,(HL)          ; Get MSB of dividend
        LD      (DIV3),A        ; Save for subtraction
        DEC     HL
        LD      A,(HL)          ; Get NMSB of dividend
        LD      (DIV2),A        ; Save for subtraction
        DEC     HL
        LD      A,(HL)          ; Get MSB of dividend
        LD      (DIV1),A        ; Save for subtraction
        LD      B,C             ; Get MSB
        EX      DE,HL           ; NMSB,LSB to HL
        XOR     A
        LD      C,A             ; Clear MSB of quotient
        LD      D,A             ; Clear NMSB of quotient
        LD      E,A             ; Clear LSB of quotient
        LD      (DIV4),A        ; Clear overflow count
DIVLP:  PUSH    HL              ; Save divisor
        PUSH    BC
        LD      A,L             ; Get LSB of number
        CALL    DIVSUP          ; Subt' divisor from dividend
        SBC     A,0             ; Count for overflows
        CCF
        JP      NC,RESDIV       ; Restore divisor if borrow
        LD      (DIV4),A        ; Re-save overflow count
        POP     AF              ; Scrap divisor
        POP     AF
        SCF                     ; Set carry to
        DB      0D2H            ; Skip "POP BC" and "POP HL"

RESDIV: POP     BC              ; Restore divisor
        POP     HL
        LD      A,C             ; Get MSB of quotient
        INC     A
        DEC     A
        RRA                     ; Bit 0 to bit 7
        JP      M,RONDB         ; Done - Normalise result
        RLA                     ; Restore carry
        LD      A,E             ; Get LSB of quotient
        RLA                     ; Double it
        LD      E,A             ; Put it back
        LD      A,D             ; Get NMSB of quotient
        RLA                     ; Double it
        LD      D,A             ; Put it back
        LD      A,C             ; Get MSB of quotient
        RLA                     ; Double it
        LD      C,A             ; Put it back
        ADD     HL,HL           ; Double NMSB,LSB of divisor
        LD      A,B             ; Get MSB of divisor
        RLA                     ; Double it
        LD      B,A             ; Put it back
        LD      A,(DIV4)        ; Get VLSB of quotient
        RLA                     ; Double it
        LD      (DIV4),A        ; Put it back
        LD      A,C             ; Get MSB of quotient
        OR      D               ; Merge NMSB
        OR      E               ; Merge LSB
        JP      NZ,DIVLP        ; Not done - Keep dividing
        PUSH    HL              ; Save divisor
        LD      HL,FPEXP        ; Point to exponent
        DEC     (HL)            ; Divide by 2
        POP     HL              ; Restore divisor
        JP      NZ,DIVLP        ; Ok - Keep going
        JP      OVERR           ; Overflow error

ADDEXP: LD      A,B             ; Get exponent of dividend
        OR      A               ; Test it
        JP      Z,OVTST3        ; Zero - Result zero
        LD      A,L             ; Get add/subtract flag
        LD      HL,FPEXP        ; Point to exponent
        XOR     (HL)            ; Add or subtract it
        ADD     A,B             ; Add the other exponent
        LD      B,A             ; Save new exponent
        RRA                     ; Test exponent for overflow
        XOR     B
        LD      A,B             ; Get exponent
        JP      P,OVTST2        ; Positive - Test for overflow
        ADD     A,80H           ; Add excess 128
        LD      (HL),A          ; Save new exponent
        JP      Z,POPHRT        ; Zero - Result zero
        CALL    SIGNS           ; Set MSBs and sign of result
        LD      (HL),A          ; Save new exponent
        DEC     HL              ; Point to MSB
        RET

OVTST1: CALL    TSTSGN          ; Test sign of FPREG
        CPL                     ; Invert sign
        POP     HL              ; Clean up stack
OVTST2: OR      A               ; Test if new exponent zero
OVTST3: POP     HL              ; Clear off return address
        JP      P,RESZER        ; Result zero
        JP      OVERR           ; Overflow error

MLSP10: CALL    BCDEFP          ; Move FPREG to BCDE
        LD      A,B             ; Get exponent
        OR      A               ; Is it zero?
        RET     Z               ; Yes - Result is zero
        ADD     A,2             ; Multiply by 4
        JP      C,OVERR         ; Overflow - ?OV Error
        LD      B,A             ; Re-save exponent
        CALL    FPADD           ; Add BCDE to FPREG (Times 5)
        LD      HL,FPEXP        ; Point to exponent
        INC     (HL)            ; Double number (Times 10)
        RET     NZ              ; Ok - Return
        JP      OVERR           ; Overflow error

TSTSGN: LD      A,(FPEXP)       ; Get sign of FPREG
        OR      A
        RET     Z               ; RETurn if number is zero
        LD      A,(FPREG+2)     ; Get MSB of FPREG
        DB      0FEH            ; Test sign
RETREL: CPL                     ; Invert sign
        RLA                     ; Sign bit to carry
FLGDIF: SBC     A,A             ; Carry to all bits of A
        RET     NZ              ; Return -1 if negative
        INC     A               ; Bump to +1
        RET                     ; Positive - Return +1

SGN:    CALL    TSTSGN          ; Test sign of FPREG
FLGREL: LD      B,80H+8         ; 8 bit integer in exponent
        LD      DE,0            ; Zero NMSB and LSB
RETINT: LD      HL,FPEXP        ; Point to exponent
        LD      C,A             ; CDE = MSB,NMSB and LSB
        LD      (HL),B          ; Save exponent
        LD      B,0             ; CDE = integer to normalise
        INC     HL              ; Point to sign of result
        LD      (HL),80H        ; Set sign of result
        RLA                     ; Carry = sign of integer
        JP      CONPOS          ; Set sign of result

ABS:    CALL    TSTSGN          ; Test sign of FPREG
        RET     P               ; Return if positive
INVSGN: LD      HL,FPREG+2      ; Point to MSB
        LD      A,(HL)          ; Get sign of mantissa
        XOR     80H             ; Invert sign of mantissa
        LD      (HL),A          ; Re-save sign of mantissa
        RET

STAKFP: EX      DE,HL           ; Save code string address
        LD      HL,(FPREG)      ; LSB,NLSB of FPREG
        EX      (SP),HL         ; Stack them,get return
        PUSH    HL              ; Re-save return
        LD      HL,(FPREG+2)    ; MSB and exponent of FPREG
        EX      (SP),HL         ; Stack them,get return
        PUSH    HL              ; Re-save return
        EX      DE,HL           ; Restore code string address
        RET

PHLTFP: CALL    LOADFP          ; Number at HL to BCDE
FPBCDE: EX      DE,HL           ; Save code string address
        LD      (FPREG),HL      ; Save LSB,NLSB of number
        LD      H,B             ; Exponent of number
        LD      L,C             ; MSB of number
        LD      (FPREG+2),HL    ; Save MSB and exponent
        EX      DE,HL           ; Restore code string address
        RET

BCDEFP: LD      HL,FPREG        ; Point to FPREG
LOADFP: LD      E,(HL)          ; Get LSB of number
        INC     HL
        LD      D,(HL)          ; Get NMSB of number
        INC     HL
        LD      C,(HL)          ; Get MSB of number
        INC     HL
        LD      B,(HL)          ; Get exponent of number
INCHL:  INC     HL              ; Used for conditional "INC HL"
        RET

FPTHL:  LD      DE,FPREG        ; Point to FPREG
DETHL4: LD      B,4             ; 4 bytes to move
DETHLB: LD      A,(DE)          ; Get source
        LD      (HL),A          ; Save destination
        INC     DE              ; Next source
        INC     HL              ; Next destination
        DEC     B               ; Count bytes
        JP      NZ,DETHLB       ; Loop if more
        RET

SIGNS:  LD      HL,FPREG+2      ; Point to MSB of FPREG
        LD      A,(HL)          ; Get MSB
        RLCA                    ; Old sign to carry
        SCF                     ; Set MSBit
        RRA                     ; Set MSBit of MSB
        LD      (HL),A          ; Save new MSB
        CCF                     ; Complement sign
        RRA                     ; Old sign to carry
        INC     HL
        INC     HL
        LD      (HL),A          ; Set sign of result
        LD      A,C             ; Get MSB
        RLCA                    ; Old sign to carry
        SCF                     ; Set MSBit
        RRA                     ; Set MSBit of MSB
        LD      C,A             ; Save MSB
        RRA
        XOR     (HL)            ; New sign of result
        RET

CMPNUM: LD      A,B             ; Get exponent of number
        OR      A
        JP      Z,TSTSGN        ; Zero - Test sign of FPREG
        LD      HL,RETREL       ; Return relation routine
        PUSH    HL              ; Save for return
        CALL    TSTSGN          ; Test sign of FPREG
        LD      A,C             ; Get MSB of number
        RET     Z               ; FPREG zero - Number's MSB
        LD      HL,FPREG+2      ; MSB of FPREG
        XOR     (HL)            ; Combine signs
        LD      A,C             ; Get MSB of number
        RET     M               ; Exit if signs different
        CALL    CMPFP           ; Compare FP numbers
        RRA                     ; Get carry to sign
        XOR     C               ; Combine with MSB of number
        RET

CMPFP:  INC     HL              ; Point to exponent
        LD      A,B             ; Get exponent
        CP      (HL)            ; Compare exponents
        RET     NZ              ; Different
        DEC     HL              ; Point to MBS
        LD      A,C             ; Get MSB
        CP      (HL)            ; Compare MSBs
        RET     NZ              ; Different
        DEC     HL              ; Point to NMSB
        LD      A,D             ; Get NMSB
        CP      (HL)            ; Compare NMSBs
        RET     NZ              ; Different
        DEC     HL              ; Point to LSB
        LD      A,E             ; Get LSB
        SUB     (HL)            ; Compare LSBs
        RET     NZ              ; Different
        POP     HL              ; Drop RETurn
        POP     HL              ; Drop another RETurn
        RET

FPINT:  LD      B,A             ; <- Move
        LD      C,A             ; <- exponent
        LD      D,A             ; <- to all
        LD      E,A             ; <- bits
        OR      A               ; Test exponent
        RET     Z               ; Zero - Return zero
        PUSH    HL              ; Save pointer to number
        CALL    BCDEFP          ; Move FPREG to BCDE
        CALL    SIGNS           ; Set MSBs & sign of result
        XOR     (HL)            ; Combine with sign of FPREG
        LD      H,A             ; Save combined signs
        CALL    M,DCBCDE        ; Negative - Decrement BCDE
        LD      A,80H+24        ; 24 bits
        SUB     B               ; Bits to shift
        CALL    SCALE           ; Shift BCDE
        LD      A,H             ; Get combined sign
        RLA                     ; Sign to carry
        CALL    C,FPROND        ; Negative - Round number up
        LD      B,0             ; Zero exponent
        CALL    C,COMPL         ; If negative make positive
        POP     HL              ; Restore pointer to number
        RET

DCBCDE: DEC     DE              ; Decrement BCDE
        LD      A,D             ; Test LSBs
        AND     E
        INC     A
        RET     NZ              ; Exit if LSBs not FFFF
        DEC     BC              ; Decrement MSBs
        RET

INT:    LD      HL,FPEXP        ; Point to exponent
        LD      A,(HL)          ; Get exponent
        CP      80H+24          ; Integer accuracy only?
        LD      A,(FPREG)       ; Get LSB
        RET     NC              ; Yes - Already integer
        LD      A,(HL)          ; Get exponent
        CALL    FPINT           ; F.P to integer
        LD      (HL),80H+24     ; Save 24 bit integer
        LD      A,E             ; Get LSB of number
        PUSH    AF              ; Save LSB
        LD      A,C             ; Get MSB of number
        RLA                     ; Sign to carry
        CALL    CONPOS          ; Set sign of result
        POP     AF              ; Restore LSB of number
        RET

MLDEBC: LD      HL,0            ; Clear partial product
        LD      A,B             ; Test multiplier
        OR      C
        RET     Z               ; Return zero if zero
        LD      A,16            ; 16 bits
MLDBLP: ADD     HL,HL           ; Shift P.P left
        JP      C,BSERR         ; ?BS Error if overflow
        EX      DE,HL
        ADD     HL,HL           ; Shift multiplier left
        EX      DE,HL
        JP      NC,NOMLAD       ; Bit was zero - No add
        ADD     HL,BC           ; Add multiplicand
        JP      C,BSERR         ; ?BS Error if overflow
NOMLAD: DEC     A               ; Count bits
        JP      NZ,MLDBLP       ; More
        RET

ASCTFP: CP      "-"             ; Negative?
        PUSH    AF              ; Save it and flags
        JP      Z,CNVNUM        ; Yes - Convert number
        CP      "+"             ; Positive?
        JP      Z,CNVNUM        ; Yes - Convert number
        DEC     HL              ; DEC 'cos GETCHR INCs
CNVNUM: CALL    RESZER          ; Set result to zero
        LD      B,A             ; Digits after point counter
        LD      D,A             ; Sign of exponent
        LD      E,A             ; Exponent of ten
        CPL
        LD      C,A             ; Before or after point flag
MANLP:  CALL    GETCHR          ; Get next character
        JP      C,ADDIG         ; Digit - Add to number
        CP      "."
        JP      Z,DPOINT        ; "." - Flag point
        CP      "E"
        JP      NZ,CONEXP       ; Not "E" - Scale number
        CALL    GETCHR          ; Get next character
        CALL    SGNEXP          ; Get sign of exponent
EXPLP:  CALL    GETCHR          ; Get next character
        JP      C,EDIGIT        ; Digit - Add to exponent
        INC     D               ; Is sign negative?
        JP      NZ,CONEXP       ; No - Scale number
        XOR     A
        SUB     E               ; Negate exponent
        LD      E,A             ; And re-save it
        INC     C               ; Flag end of number
DPOINT: INC     C               ; Flag point passed
        JP      Z,MANLP         ; Zero - Get another digit
CONEXP: PUSH    HL              ; Save code string address
        LD      A,E             ; Get exponent
        SUB     B               ; Subtract digits after point
SCALMI: CALL    P,SCALPL        ; Positive - Multiply number
        JP      P,ENDCON        ; Positive - All done
        PUSH    AF              ; Save number of times to /10
        CALL    DIV10           ; Divide by 10
        POP     AF              ; Restore count
        INC     A               ; Count divides

ENDCON: JP      NZ,SCALMI       ; More to do
        POP     DE              ; Restore code string address
        POP     AF              ; Restore sign of number
        CALL    Z,INVSGN        ; Negative - Negate number
        EX      DE,HL           ; Code string address to HL
        RET

SCALPL: RET     Z               ; Exit if no scaling needed
MULTEN: PUSH    AF              ; Save count
        CALL    MLSP10          ; Multiply number by 10
        POP     AF              ; Restore count
        DEC     A               ; Count multiplies
        RET

ADDIG:  PUSH    DE              ; Save sign of exponent
        LD      D,A             ; Save digit
        LD      A,B             ; Get digits after point
        ADC     A,C             ; Add one if after point
        LD      B,A             ; Re-save counter
        PUSH    BC              ; Save point flags
        PUSH    HL              ; Save code string address
        PUSH    DE              ; Save digit
        CALL    MLSP10          ; Multiply number by 10
        POP     AF              ; Restore digit
        SUB     "0"             ; Make it absolute
        CALL    RSCALE          ; Re-scale number
        POP     HL              ; Restore code string address
        POP     BC              ; Restore point flags
        POP     DE              ; Restore sign of exponent
        JP      MANLP           ; Get another digit

RSCALE: CALL    STAKFP          ; Put number on stack
        CALL    FLGREL          ; Digit to add to FPREG
PADD:   POP     BC              ; Restore number
        POP     DE
        JP      FPADD           ; Add BCDE to FPREG and return

EDIGIT: LD      A,E             ; Get digit
        RLCA                    ; Times 2
        RLCA                    ; Times 4
        ADD     A,E             ; Times 5
        RLCA                    ; Times 10
        ADD     A,(HL)          ; Add next digit
        SUB     "0"             ; Make it absolute
        LD      E,A             ; Save new digit
        JP      EXPLP           ; Look for another digit

LINEIN: PUSH    HL              ; Save code string address
        LD      HL,INMSG        ; Output " in "
        CALL    PRS             ; Output string at HL
        POP     HL              ; Restore code string address
PRNTHL: EX      DE,HL           ; Code string address to DE
        XOR     A
        LD      B,80H+24        ; 24 bits
        CALL    RETINT          ; Return the integer
        LD      HL,PRNUMS       ; Print number string
        PUSH    HL              ; Save for return
NUMASC: LD      HL,PBUFF        ; Convert number to ASCII
        PUSH    HL              ; Save for return
        CALL    TSTSGN          ; Test sign of FPREG
        LD      (HL)," "        ; Space at start
        JP      P,SPCFST        ; Positive - Space to start
        LD      (HL),"-"        ; "-" sign at start
SPCFST: INC     HL              ; First byte of number
        LD      (HL),"0"        ; "0" if zero
        JP      Z,JSTZER        ; Return "0" if zero
        PUSH    HL              ; Save buffer address
        CALL    M,INVSGN        ; Negate FPREG if negative
        XOR     A               ; Zero A
        PUSH    AF              ; Save it
        CALL    RNGTST          ; Test number is in range
SIXDIG: LD      BC,9143H        ; BCDE - 99999.9
        LD      DE,4FF8H
        CALL    CMPNUM          ; Compare numbers
        OR      A
        JP      PO,INRNG        ; > 99999.9 - Sort it out
        POP     AF              ; Restore count
        CALL    MULTEN          ; Multiply by ten
        PUSH    AF              ; Re-save count
        JP      SIXDIG          ; Test it again

GTSIXD: CALL    DIV10           ; Divide by 10
        POP     AF              ; Get count
        INC     A               ; Count divides
        PUSH    AF              ; Re-save count
        CALL    RNGTST          ; Test number is in range
INRNG:  CALL    ROUND           ; Add 0.5 to FPREG
        INC     A
        CALL    FPINT           ; F.P to integer
        CALL    FPBCDE          ; Move BCDE to FPREG
        LD      BC,0306H        ; 1E+06 to 1E-03 range
        POP     AF              ; Restore count
        ADD     A,C             ; 6 digits before point
        INC     A               ; Add one
        JP      M,MAKNUM        ; Do it in "E" form if < 1E-02
        CP      6+1+1           ; More than 999999 ?
        JP      NC,MAKNUM       ; Yes - Do it in "E" form
        INC     A               ; Adjust for exponent
        LD      B,A             ; Exponent of number
        LD      A,2             ; Make it zero after

MAKNUM: DEC     A               ; Adjust for digits to do
        DEC     A
        POP     HL              ; Restore buffer address
        PUSH    AF              ; Save count
        LD      DE,POWERS       ; Powers of ten
        DEC     B               ; Count digits before point
        JP      NZ,DIGTXT       ; Not zero - Do number
        LD      (HL),"."        ; Save point
        INC     HL              ; Move on
        LD      (HL),"0"        ; Save zero
        INC     HL              ; Move on
DIGTXT: DEC     B               ; Count digits before point
        LD      (HL),"."        ; Save point in case
        CALL    Z,INCHL         ; Last digit - move on
        PUSH    BC              ; Save digits before point
        PUSH    HL              ; Save buffer address
        PUSH    DE              ; Save powers of ten
        CALL    BCDEFP          ; Move FPREG to BCDE
        POP     HL              ; Powers of ten table
        LD      B, "0"-1        ; ASCII "0" - 1
TRYAGN: INC     B               ; Count subtractions
        LD      A,E             ; Get LSB
        SUB     (HL)            ; Subtract LSB
        LD      E,A             ; Save LSB
        INC     HL
        LD      A,D             ; Get NMSB
        SBC     A,(HL)          ; Subtract NMSB
        LD      D,A             ; Save NMSB
        INC     HL
        LD      A,C             ; Get MSB
        SBC     A,(HL)          ; Subtract MSB
        LD      C,A             ; Save MSB
        DEC     HL              ; Point back to start
        DEC     HL
        JP      NC,TRYAGN       ; No overflow - Try again
        CALL    PLUCDE          ; Restore number
        INC     HL              ; Start of next number
        CALL    FPBCDE          ; Move BCDE to FPREG
        EX      DE,HL           ; Save point in table
        POP     HL              ; Restore buffer address
        LD      (HL),B          ; Save digit in buffer
        INC     HL              ; And move on
        POP     BC              ; Restore digit count
        DEC     C               ; Count digits
        JP      NZ,DIGTXT       ; More - Do them
        DEC     B               ; Any decimal part?
        JP      Z,DOEBIT        ; No - Do "E" bit
SUPTLZ: DEC     HL              ; Move back through buffer
        LD      A,(HL)          ; Get character
        CP      "0"             ; "0" character?
        JP      Z,SUPTLZ        ; Yes - Look back for more
        CP      "."             ; A decimal point?
        CALL    NZ,INCHL        ; Move back over digit

DOEBIT: POP     AF              ; Get "E" flag
        JP      Z,NOENED        ; No "E" needed - End buffer
        LD      (HL),"E"        ; Put "E" in buffer
        INC     HL              ; And move on
        LD      (HL),"+"        ; Put '+' in buffer
        JP      P,OUTEXP        ; Positive - Output exponent
        LD      (HL),"-"        ; Put "-" in buffer
        CPL                     ; Negate exponent
        INC     A
OUTEXP: LD      B,"0"-1         ; ASCII "0" - 1
EXPTEN: INC     B               ; Count subtractions
        SUB     10              ; Tens digit
        JP      NC,EXPTEN       ; More to do
        ADD     A,"0"+10        ; Restore and make ASCII
        INC     HL              ; Move on
        LD      (HL),B          ; Save MSB of exponent
JSTZER: INC     HL              ;
        LD      (HL),A          ; Save LSB of exponent
        INC     HL
NOENED: LD      (HL),C          ; Mark end of buffer
        POP     HL              ; Restore code string address
        RET

RNGTST: LD      BC,9474H        ; BCDE = 999999.
        LD      DE,23F7H
        CALL    CMPNUM          ; Compare numbers
        OR      A
        POP     HL              ; Return address to HL
        JP      PO,GTSIXD       ; Too big - Divide by ten
        JP      (HL)            ; Otherwise return to caller

HALF:   DB      00H,00H,00H,80H ; 0.5

POWERS: DB      0A0H,086H,001H  ; 100000
        DB      010H,027H,000H  ;  10000
        DB      0E8H,003H,000H  ;   1000
        DB      064H,000H,000H  ;    100
        DB      00AH,000H,000H  ;     10
        DB      001H,000H,000H  ;      1

NEGAFT: LD  HL,INVSGN           ; Negate result
        EX      (SP),HL         ; To be done after caller
        JP      (HL)            ; Return to caller

SQR:    CALL    STAKFP          ; Put value on stack
        LD      HL,HALF         ; Set power to 1/2
        CALL    PHLTFP          ; Move 1/2 to FPREG

POWER:  POP     BC              ; Get base
        POP     DE
        CALL    TSTSGN          ; Test sign of power
        LD      A,B             ; Get exponent of base
        JP      Z,EXP           ; Make result 1 if zero
        JP      P,POWER1        ; Positive base - Ok
        OR      A               ; Zero to negative power?
        JP      Z,DZERR         ; Yes - ?/0 Error
POWER1: OR      A               ; Base zero?
        JP      Z,SAVEXP        ; Yes - Return zero
        PUSH    DE              ; Save base
        PUSH    BC
        LD      A,C             ; Get MSB of base
        OR      01111111B       ; Get sign status
        CALL    BCDEFP          ; Move power to BCDE
        JP      P,POWER2        ; Positive base - Ok
        PUSH    DE              ; Save power
        PUSH    BC
        CALL    INT             ; Get integer of power
        POP     BC              ; Restore power
        POP     DE
        PUSH    AF              ; MSB of base
        CALL    CMPNUM          ; Power an integer?
        POP     HL              ; Restore MSB of base
        LD      A,H             ; but don't affect flags
        RRA                     ; Exponent odd or even?
POWER2: POP     HL              ; Restore MSB and exponent
        LD      (FPREG+2),HL    ; Save base in FPREG
        POP     HL              ; LSBs of base
        LD      (FPREG),HL      ; Save in FPREG
        CALL    C,NEGAFT        ; Odd power - Negate result
        CALL    Z,INVSGN        ; Negative base - Negate it
        PUSH    DE              ; Save power
        PUSH    BC
        CALL    LOG             ; Get LOG of base
        POP     BC              ; Restore power
        POP     DE
        CALL    FPMULT          ; Multiply LOG by power

EXP:    CALL    STAKFP          ; Put value on stack
        LD      BC,08138H       ; BCDE = 1/Ln(2)
        LD      DE,0AA3BH
        CALL    FPMULT          ; Multiply value by 1/LN(2)
        LD      A,(FPEXP)       ; Get exponent
        CP      80H+8           ; Is it in range?
        JP      NC,OVTST1       ; No - Test for overflow
        CALL    INT             ; Get INT of FPREG
        ADD     A,80H           ; For excess 128
        ADD     A,2             ; Exponent > 126?
        JP      C,OVTST1        ; Yes - Test for overflow
        PUSH    AF              ; Save scaling factor
        LD      HL,UNITY        ; Point to 1.
        CALL    ADDPHL          ; Add 1 to FPREG
        CALL    MULLN2          ; Multiply by LN(2)
        POP     AF              ; Restore scaling factor
        POP     BC              ; Restore exponent
        POP     DE
        PUSH    AF              ; Save scaling factor
        CALL    SUBCDE          ; Subtract exponent from FPREG
        CALL    INVSGN          ; Negate result
        LD      HL,EXPTAB       ; Coefficient table
        CALL    SMSER1          ; Sum the series
        LD      DE,0            ; Zero LSBs
        POP     BC              ; Scaling factor
        LD      C,D             ; Zero MSB
        JP      FPMULT          ; Scale result to correct value

EXPTAB: DB      8                       ; Table used by EXP
        DB      040H,02EH,094H,074H     ; -1/7! (-1/5040)
        DB      070H,04FH,02EH,077H     ;  1/6! ( 1/720)
        DB      06EH,002H,088H,07AH     ; -1/5! (-1/120)
        DB      0E6H,0A0H,02AH,07CH     ;  1/4! ( 1/24)
        DB      050H,0AAH,0AAH,07EH     ; -1/3! (-1/6)
        DB      0FFH,0FFH,07FH,07FH     ;  1/2! ( 1/2)
        DB      000H,000H,080H,081H     ; -1/1! (-1/1)
        DB      000H,000H,000H,081H     ;  1/0! ( 1/1)

SUMSER: CALL    STAKFP          ; Put FPREG on stack
        LD      DE,MULT         ; Multiply by "X"
        PUSH    DE              ; To be done after
        PUSH    HL              ; Save address of table
        CALL    BCDEFP          ; Move FPREG to BCDE
        CALL    FPMULT          ; Square the value
        POP     HL              ; Restore address of table
SMSER1: CALL    STAKFP          ; Put value on stack
        LD      A,(HL)          ; Get number of coefficients
        INC     HL              ; Point to start of table
        CALL    PHLTFP          ; Move coefficient to FPREG
        DB      06H             ; Skip "POP AF"
SUMLP:  POP     AF              ; Restore count
        POP     BC              ; Restore number
        POP     DE
        DEC     A               ; Cont coefficients
        RET     Z               ; All done
        PUSH    DE              ; Save number
        PUSH    BC
        PUSH    AF              ; Save count
        PUSH    HL              ; Save address in table
        CALL    FPMULT          ; Multiply FPREG by BCDE
        POP     HL              ; Restore address in table
        CALL    LOADFP          ; Number at HL to BCDE
        PUSH    HL              ; Save address in table
        CALL    FPADD           ; Add coefficient to FPREG
        POP     HL              ; Restore address in table
        JP      SUMLP           ; More coefficients

RND:    CALL    TSTSGN          ; Test sign of FPREG
        LD      HL,SEED+2       ; Random number seed
        JP      M,RESEED        ; Negative - Re-seed
        LD      HL,LSTRND       ; Last random number
        CALL    PHLTFP          ; Move last RND to FPREG
        LD      HL,SEED+2       ; Random number seed
        RET     Z               ; Return if RND(0)
        ADD     A,(HL)          ; Add (SEED)+2)
        AND     00000111B       ; 0 to 7
        LD      B,0
        LD      (HL),A          ; Re-save seed
        INC     HL              ; Move to coefficient table
        ADD     A,A             ; 4 bytes
        ADD     A,A             ; per entry
        LD      C,A             ; BC = Offset into table
        ADD     HL,BC           ; Point to coefficient
        CALL    LOADFP          ; Coefficient to BCDE
        CALL    FPMULT  ;       ; Multiply FPREG by coefficient
        LD      A,(SEED+1)      ; Get (SEED+1)
        INC     A               ; Add 1
        AND     00000011B       ; 0 to 3
        LD      B,0
        CP      1               ; Is it zero?
        ADC     A,B             ; Yes - Make it 1
        LD      (SEED+1),A      ; Re-save seed
        LD      HL,RNDTAB-4     ; Addition table
        ADD     A,A             ; 4 bytes
        ADD     A,A             ; per entry
        LD      C,A             ; BC = Offset into table
        ADD     HL,BC           ; Point to value
        CALL    ADDPHL          ; Add value to FPREG
RND1:   CALL    BCDEFP          ; Move FPREG to BCDE
        LD      A,E             ; Get LSB
        LD      E,C             ; LSB = MSB
        XOR     01001111B       ; Fiddle around
        LD      C,A             ; New MSB
        LD      (HL),80H        ; Set exponent
        DEC     HL              ; Point to MSB
        LD      B,(HL)          ; Get MSB
        LD      (HL),80H        ; Make value -0.5
        LD      HL,SEED         ; Random number seed
        INC     (HL)            ; Count seed
        LD      A,(HL)          ; Get seed
        SUB     171             ; Do it modulo 171
        JP      NZ,RND2         ; Non-zero - Ok
        LD      (HL),A          ; Zero seed
        INC     C               ; Fillde about
        DEC     D               ; with the
        INC     E               ; number
RND2:   CALL    BNORM           ; Normalise number
        LD      HL,LSTRND       ; Save random number
        JP      FPTHL           ; Move FPREG to last and return

RESEED: LD      (HL),A          ; Re-seed random numbers
        DEC     HL
        LD      (HL),A
        DEC     HL
        LD      (HL),A
        JP      RND1            ; Return RND seed

RNDTAB: DB      068H,0B1H,046H,068H     ; Table used by RND
        DB      099H,0E9H,092H,069H
        DB      010H,0D1H,075H,068H

COS:    LD      HL,HALFPI       ; Point to PI/2
        CALL    ADDPHL          ; Add it to PPREG
SIN:    CALL    STAKFP          ; Put angle on stack
        LD      BC,8349H        ; BCDE = 2 PI
        LD      DE,0FDBH
        CALL    FPBCDE          ; Move 2 PI to FPREG
        POP     BC              ; Restore angle
        POP     DE
        CALL    DVBCDE          ; Divide angle by 2 PI
        CALL    STAKFP          ; Put it on stack
        CALL    INT             ; Get INT of result
        POP     BC              ; Restore number
        POP     DE
        CALL    SUBCDE          ; Make it 0 <= value < 1
        LD      HL,QUARTR       ; Point to 0.25
        CALL    SUBPHL          ; Subtract value from 0.25
        CALL    TSTSGN          ; Test sign of value
        SCF                     ; Flag positive
        JP      P,SIN1          ; Positive - Ok
        CALL    ROUND           ; Add 0.5 to value
        CALL    TSTSGN          ; Test sign of value
        OR      A               ; Flag negative
SIN1:   PUSH    AF              ; Save sign
        CALL    P,INVSGN        ; Negate value if positive
        LD      HL,QUARTR       ; Point to 0.25
        CALL    ADDPHL          ; Add 0.25 to value
        POP     AF              ; Restore sign
        CALL    NC,INVSGN       ; Negative - Make positive
        LD      HL,SINTAB       ; Coefficient table
        JP      SUMSER          ; Evaluate sum of series

HALFPI: DB      0DBH,00FH,049H,081H     ; 1.5708 (PI/2)

QUARTR: DB      000H,000H,000H,07FH     ; 0.25

SINTAB: DB      5                       ; Table used by SIN
        DB      0BAH,0D7H,01EH,086H     ; 39.711
        DB      064H,026H,099H,087H     ;-76.575
        DB      058H,034H,023H,087H     ; 81.602
        DB      0E0H,05DH,0A5H,086H     ;-41.342
        DB      0DAH,00FH,049H,083H     ;  6.2832

TAN:    CALL    STAKFP          ; Put angle on stack
        CALL    SIN             ; Get SIN of angle
        POP     BC              ; Restore angle
        POP     HL
        CALL    STAKFP          ; Save SIN of angle
        EX      DE,HL           ; BCDE = Angle
        CALL    FPBCDE          ; Angle to FPREG
        CALL    COS             ; Get COS of angle
        JP      DIV             ; TAN = SIN / COS

ATN:    CALL    TSTSGN          ; Test sign of value
        CALL    M,NEGAFT        ; Negate result after if -ve
        CALL    M,INVSGN        ; Negate value if -ve
        LD      A,(FPEXP)       ; Get exponent
        CP      81H             ; Number less than 1?
        JP      C,ATN1          ; Yes - Get arc tangnt
        LD      BC,8100H        ; BCDE = 1
        LD      D,C
        LD      E,C
        CALL    DVBCDE          ; Get reciprocal of number
        LD      HL,SUBPHL       ; Sub angle from PI/2
        PUSH    HL              ; Save for angle > 1
ATN1:   LD      HL,ATNTAB       ; Coefficient table
        CALL    SUMSER          ; Evaluate sum of series
        LD      HL,HALFPI       ; PI/2 - angle in case > 1
        RET                     ; Number > 1 - Sub from PI/2

ATNTAB: DB      9                       ; Table used by ATN
        DB      04AH,0D7H,03BH,078H     ; 1/17
        DB      002H,06EH,084H,07BH     ;-1/15
        DB      0FEH,0C1H,02FH,07CH     ; 1/13
        DB      074H,031H,09AH,07DH     ;-1/11
        DB      084H,03DH,05AH,07DH     ; 1/9
        DB      0C8H,07FH,091H,07EH     ;-1/7
        DB      0E4H,0BBH,04CH,07EH     ; 1/5
        DB      06CH,0AAH,0AAH,07FH     ;-1/3
        DB      000H,000H,000H,081H     ; 1/1

CASFFW: CALL    FLPLED          ; Turn on cassette
        LD      B,0             ; Set 1 second delay
DELAYB: CALL    DELAY           ; Wait a bit
        DEC     B               ; Count
        JP      NZ,DELAYB       ; More delay needed
        RET

CASFF:  JP      FLPLED          ; Flip tape LED

ARET:   RET                     ; A RETurn instruction

CONMON: PUSH    HL              ; Output character to screen
        PUSH    BC              ; 
        PUSH    DE              ; 
        PUSH    AF              ; 
        CALL    MONTST          ; See if NAS-SYS
        JP      NZ,NASOUT       ; NAS-SYS - Output ASCII
        POP     AF              ; Get character
        PUSH    AF              ; And re-save
        CP      LF              ; ASCII Line feed?
        JP      Z,IGCHR         ; Yes - Ignore it
        CP      BKSP            ; ASCII back space?
        JP      NZ,CONOT1       ; No - Test for CR
        LD      A,TBS           ; NASBUG back space
CONOT1: CP      CR              ; ASCII CR?
        JP      NZ,OUTCHR       ; No - Output character
        LD      A,TCR           ; NASBUG CR
        JP      OUTCHR          ; Output it

NASOUT: POP     AF              ; Get character
        PUSH    AF              ; And re-save
OUTCHR: CALL    MONOUT          ; Output it
IGCHR:  POP     AF              ; Restore character
        POP     DE              ;
        POP     BC              ;
        POP     HL              ;
        RET

GETINP: PUSH    HL              ; Get an input character
        PUSH    BC              ;
        PUSH    DE              ;
        CALL    MONTST          ; See if NAS-SYS
        JP      Z,GETTIN        ; "T" monitor - Get input
        DW      _BLNK
        JP      CONVIN          ; Convert to ASCII

GETTIN: CALL    TIN             ; "T" input a character
        JP      NC,GETTIN       ; No input - wait
CONVIN: CP      TBS             ; NASBUG back space?
        JP      NZ,CNVIN1       ; No - Test for break
        LD      A,BKSP          ; ASCII back space
CNVIN1: CP      TBRK            ; NASBUG break?
        JP      NZ,CNVIN2       ; No - Test for control Z
        LD      A,CTRLC         ; Control C
CNVIN2: CP      CTRLZ           ; ^Z?
        JP      NZ,CNVIN3       ; No - Test for escape
        LD      A,DEL           ; Delete
CNVIN3: CP      ESC             ; "ESC" ?
        JP      NZ,CNVIN4       ; No - Test for CR
        LD      A,CTRLC         ; Control C
CNVIN4: CP      TCR             ; NASBUG CR?
        JP      NZ,CNVIN5       ; No - Return character
        LD      A,CR            ; ASCII CR
CNVIN5: POP     DE
        POP     BC
        POP     HL
        RET

CHKBRK: XOR     A               ; Check for break
        CALL    SFTENT          ; Test for shift/enter
        JP      Z,TBRK2         ; Yes - Test for second break
        LD      A,(BRKFLG)      ; Get break flag
        OR      A               ; Break flag set?
        JP      NZ,TBRK2        ; Yes - Test for second break
        XOR     A               ; Flag no break
        RET

TBRK2:  CALL    BREAK2          ; Second break?
        LD      A,-1            ; Flag break
        RET

GUART:  IN      A,(UARTS)       ; Get UART status
        RLA                     ; Any data ready?
        JP      NC,GUART        ; No - wait until there is
        IN      A,(UARTD)       ; Get data from UART
        RET

UARTOT: OUT     (UARTD),A       ; Send data to UART
URTOLP: IN      A,(UARTS)       ; Get status
        ADD     A,A             ; Byte sent?
        RET     M               ; Yes - Return
        JP      URTOLP          ; Keep waiting

SUART:  PUSH    AF              ; Save A
        CALL    UARTOT          ; Send it to UART
        POP     AF              ; Restore A
        RET

        NOP
        NOP

SFTENT: PUSH    HL              ; Test for Shift Enter from KBD
        LD      A,00000010B     ; Reset KBD counter mask
        LD      HL,PORT0        ; Get old contents
        XOR     (HL)            ; Toggle bit
        OUT     (0),A           ; Reset KBD counter
        XOR     00000001B       ; Toggle bit
        OUT     (0),A           ; Next row
        XOR     00000010B
        OUT     (0),A           ; Clear "clear" strobe
        LD      A,(HL)          ; Get old value
        OUT     (0),A           ; Original contents
        ADD     HL,DE           ; ?? WHAT ??
        POP     HL              ; Restore HL
        IN      A,(0)           ; Read in row
        AND     00010010B       ; Mask SHIFT and ENTER
        RET

CLS:    CALL    MONTST          ; See if NAS-SYS
        JP      Z,TCLS          ; "T" CLS
        LD      A,CS            ; ASCII Clear screen
        JP      CONMON          ; Output character

TCLS:   LD      A,TCS           ; NASBUG Clear screen
        JP      CONMON          ; Output character

DELAY:  XOR     A               ; Delay routine
DELAY1: PUSH    AF              ; PUSHes and POPs delay
        POP     AF
        PUSH    AF
        POP     AF
        DEC     A               ; Count delays
        JP      NZ,DELAY1       ; More delay
        RET

WIDTH:  CALL    GETINT          ; Get integer 0-255
        LD      A,E             ; Width to A
        LD      (LWIDTH),A      ; Set width
        RET

LINES:  CALL    GETNUM          ; Get a number
        CALL    DEINT           ; Get integer -32768 to 32767
        LD      (LINESC),DE     ; Set lines counter
        LD      (LINESN),DE     ; Set lines number
        RET

DEEK:   CALL    DEINT           ; Get integer -32768 to 32767
        PUSH    DE              ; Save number
        POP     HL              ; Number to HL
        LD      B,(HL)          ; Get LSB of contents
        INC     HL
        LD      A,(HL)          ; Get MSB of contents
        JP      ABPASS          ; Return integer AB

DOKE:   CALL    GETNUM          ; Get a number
        CALL    DEINT           ; Get integer -32768 to 32767
        PUSH    DE              ; Save address
        CALL    CHKSYN          ; Make sure "," follows
        DB      ","
        CALL    GETNUM          ; Get a number
        CALL    DEINT           ; Get integer -32768 to 32767
        EX      (SP),HL         ; Save value,get address
        LD      (HL),E          ; Save LSB of value
        INC     HL
        LD      (HL),D          ; Save MSB of value
        POP     HL              ; Restore code string address
        RET

JJUMP1: DI                      ; Disable interrupts
        LD      IX,-1           ; Flag cold start
        JP      CSTART          ; Go and initialise

SCREEN: CALL    GETINT          ; Get integer 0 to 255
        PUSH    AF              ; Save column
        CALL    CHKSYN          ; Make sure "," follows
        DB      ","
        CALL    GETINT          ; Get integer 0 to 255
        POP     BC              ; Column to B
        PUSH    HL              ; Save code string address
        PUSH    BC              ; Save column
        CALL    SCRADR          ; Calculate screen address
        PUSH    HL              ; Save screen address
        CALL    MONTST          ; See if NAS-SYS
        JP      Z,TMNCUR        ; "T" monitor - "T" cursor
        POP     HL              ; Restore screen address
        LD      (CURSOR),HL     ; Set new cursor position
        POP     HL              ; Rstore code string address
        RET

TMNCUR: LD      HL,(TCUR)       ; Get address or cursor
        LD      (HL)," "        ; Remove cursor
        POP     HL              ; Get new cursor address
        LD      (TCUR),HL       ; Set new cursor
        LD      (HL),"_"        ; Put it on screen
        POP     HL              ; Restore code string address
        RET

SCRADR: LD      HL,VDU+10-65    ; SCREEN VDU address (0,0)
        LD      B,0
        LD      C,A             ; Line to BC
        OR      A               ; Test it
        JP      Z,FCERR         ; Zero - ?FC Error
        CP      16+1            ; 16 lines
        JP      P,FCERR         ; > 16 - ?FC Error
        POP     DE              ; RETurn address
        POP     AF              ; Get column
        PUSH    DE              ; Re-save RETurn
        LD      D,0
        LD      E,A             ; Column to DE
        OR      A               ; Test it
        JP      Z,FCERR         ; Zero - ?FC Error
        CP      48+1            ; 48 characters per line
        JP      P,FCERR         ; > 48 - ?FC Error
        ADD     HL,DE           ; Add column to address
        LD      D,0
        LD      E,C             ; Line to DE
        LD      B,64            ; 64 Bytes per line
ADD64X: ADD     HL,DE           ; Add line
        DJNZ    ADD64X          ; SIXTY FOUR TIMES!!!
        RET

FLPLED: CALL    MONTST          ; See if NAS-SYS
        JP      Z,TMFLP         ; "T" MFLP
        DW      _MFLP
        RET

TMFLP:  JP      MFLP            ; Flip drive LED

MONOUT: PUSH    AF              ; Save character
        CALL    MONTST          ; See if NAS-SYS
        JP      Z,TMNOUT        ; "T" output
        POP     AF              ; Restore character
        DB      _ROUT           ; Output it
        RET

TMNOUT: POP     AF              ; Restore character
        JP      TOUT            ; "T" output

BREAK2: LD      A,(BRKFLG)      ; Break flag set?
        JP      NZ,RETCTC       ; Yes - Return ^C
        CALL    MONTST          ; See if NAS-SYS
        JP      Z,TCHINP        ; Get "T" character input
        DW      _RIN            ; Scan for a character
        RET

TCHINP: JP      TIN             ; "T" input a character

RETCTC: LD      A,0             ; Clear Break flag
        LD      (BRKFLG),A
        LD      A,CTRLC         ; Return ^C
        RET

MONTST: LD      A,(MONSTT+1)    ; "T" monitor or NAS-SYS?
        CP      33H             ; 31 00 10 / 31 33 0C
        RET

SAVE:   CALL    FLPLED          ; Flip tape LED
        CALL    MONTST          ; See if NAS-SYS
        JP      Z,TSAVE         ; "T" save
        DW      _WRIT           ; Save program
        RET

TSAVE:  LD      A,(MONTYP)      ; "T2" or "T4" (FLAGS!!!)
        JP      Z,T4WR          ; T4 Write
        JP      T2DUMP          ; T2 Dump

MONLD:  CALL    FLPLED          ; Flip tape LED
        CALL    MONTST          ; See if NAS-SYS
        JP      Z,TLOAD         ; "T" load
        LD      A,"R"           ; Set READ
        LD      (ARGN),A
        DW      _READ           ; Load program
        RET

TLOAD:  LD      A,(MONTYP)      ; "T2" or "T4" (FLAGS!!!)
        JP      Z,T4READ        ; T4 Read
        JP      T2DUMP          ; T2 Dump ??????????

MONITR: CALL    MONTST          ; See if NAS-SYS
        JP      Z,MONSTT        ; Jump to zero if "T"
        DW      _MRET           ; Return to NAS-SYS

MONVE:  CALL    FLPLED          ; Flip tape LED
        CALL    MONTST          ; See if NAS-SYS
        JP      Z,FCERR         ; Verify not available on "T"
        LD      A,"V"           ; Set VERIFY
        LD      (ARGN),A
        DW      _VRFY           ; Verify tape
        RET

INITST: LD      A,0             ; Clear break flag
        LD      (BRKFLG),A
        CALL    MONTST          ; See if NAS-SYS
        JP      Z,INIT          ; "T" - No NMI vector
        LD      HL,BREAK        ; Set NMI gives break
        LD      (NMI),HL
        PUSH    IX              ; Get start up condition
        POP     AF              ; "Z" set if cold , Else clear
        OR      A               ; "Cold" or "Cool" start?
        JP      NZ,INIT         ; "Cool" don't init NAS-SYS
        LD      B,15            ; Delay for keyboard clear
        CALL    DELAYB          ; Allow time for key release
        CALL    STMON           ; Initialise NAS-SYS
        JP      INIT            ; Initialise BASIC

BREAK:  PUSH    AF              ; Save character
        LD      A,-1
        LD      (BRKFLG),A      ; Flag break
        POP     AF              ; Restore character
ARETN:  RETN                    ; Return from NMI

        NOP

INLINE: DW      _INLN           ; Get an input line
        PUSH    DE              ; Save cursor address
        PUSH    DE              ; Cursor address to HL
        POP     HL
        LD      DE,48-1         ; Length of line-1
        ADD     HL,DE           ; Point to end of line
ENDLIN: LD      A,(HL)          ; Get end of line
        CP      " "             ; Space?
        JP      NZ,LINTBF       ; No - Copy to buffer
        DEC     E               ; Back 1 character
        LD      A,0             ; Wasteful test on E
        OR      E
        JP      Z,LINTBF        ; Start of line - Copy it
        DEC     HL              ; Back 1 character
        JP      ENDLIN          ; Keep looking for end

LINTBF: PUSH    DE              ; Line length to BC
        POP     BC
        INC     BC              ; Length +1
        LD      DE,BUFFER       ; Input buffer
        POP     HL              ; Line start
        PUSH    BC              ; Save length
        LDIR                    ; Move line to buffer
        LD      A,0
        LD      (DE),A          ; Mark end of buffer with 00
        POP     BC              ; Restore buffer length
        LD      B,C             ; Length returned in B
        LD      HL,BUFFER-1     ; Point to start of buffer-1
        RET

GETXYA: CALL    CHKSYN          ; Make sure "(" follows
        DB      "("
        CALL    GETNUM          ; Get a number
        CALL    DEINT           ; Get integer -32768 to 32767
        PUSH    DE              ; Save "X"
        CALL    CHKSYN          ; Make sure "," follows
        DB      ","
        CALL    GETNUM          ; Get a number
        CALL    CHKSYN          ; Make sure ")" follows
        DB      ")"
        CALL    DEINT           ; Get integer -32768 to 32767
        PUSH    HL              ; Save code string address
        POP     IY              ; In IY
        CALL    XYPOS           ; Address and bit mask
        PUSH    AF              ; Save mask
        CALL    ADJCOL          ; Adjust column
        CALL    SCRADR          ; Get VDU address
        POP     AF              ; Restore bit mask
        LD      B,11000000B     ; Block graphics base
        OR      B               ; Set bits 7 & 6
        RET

SETB:   CALL    GETXYA          ; Get co-ords and VDU address
        PUSH    AF              ; Save bit mask
        LD      A,(HL)          ; Get character from screen
        CP      11000000B       ; Is it a block graphic?
        JP      NC,SETOR        ; Yes - OR new bit
        POP     AF              ; Restore bit mask
PUTBIT: LD      (HL),A          ; Put character on screen
RESCSA: PUSH    IY              ; Restore code string address
        POP     HL              ; From IY
        RET

SETOR:  POP     BC              ; Restore bit mask
        OR      B               ; Merge the bits
        JP      PUTBIT          ; Save on screen

RESETB: CALL    GETXYA          ; Get co-ords and VDU address
        PUSH    AF              ; Save bit mask
        LD      A,(HL)          ; Get byte from screen
        CP      11000000B       ; Is it a block graphic?
        JP      C,NORES         ; No - Leave it
        LD      B,00111111B     ; Six bits per block
        AND     B               ; Clear bits 7 & 6
        POP     BC              ; Get bit mask
        AND     B               ; Test for common bit
        JP      Z,RESCSA        ; None - Leave it
        LD      A,(HL)          ; Get byte from screen
        AND     00111111B       ; Isolate bit
        XOR     B               ; Clear that bit
        CP      11000000B       ; Is it a graphic blank?
        JP      NZ,PUTBIT       ; No - Save character
        LD      A," "           ; Put a space there
        JP      PUTBIT          ; Save the space

NORES:  POP     BC              ; Drop bit mask
        JP      RESCSA          ; Restore code string address

POINTB: CALL    GETXYA          ; Get co-ords and VDU address
        LD      B,(HL)          ; Get character from screen
        CALL    TSTBIT          ; Test if bit is set
        JP      NZ,POINT0       ; Different - Return zero
        LD      A,0
        LD      B,1             ; Integer AB = 1
POINTX: POP     HL              ; Drop return
        PUSH    IY              ; PUSH code string address
        LD      DE,RETNUM       ; To return a number
        PUSH    DE              ; Save for return
        JP      ABPASS          ; Return integer AB

POINT0: LD      B,0             ; Set zero
        JP      POINTX          ; Return value

XYPOS:  POP     BC              ; Get return address
        POP     HL              ; Get column
        PUSH    HL              ; And re-save
        PUSH    BC              ; Put back return address
        LD      A,L             ; Get column
        LD      B,00000001B     ; 2 bits per character
        AND     B               ; Odd or even bit
        PUSH    AF              ; Save it
        PUSH    DE              ; Get row
        POP     HL              ; to HL
        LD      DE,0            ; Zero line count
        LD      BC,3            ; 3 blocks per line
        INC     HL
DIV3LP: SBC     HL,BC           ; Subtract 3
        INC     DE              ; Count the subtractions
        JP      Z,DIV3EX        ; Exactly - Exit
        JP      P,DIV3LP        ; More to do

DIV3EX: ADD     HL,BC           ; Restore number
        POP     AF              ; Restore column and odd/even
        OR      A               ; Set flags (NZ or Z)
        LD      A,L             ; Get remainder from /3
        JP      Z,NOREMD        ; No remainder
        ADD     A,3             ; Adjust remainder
NOREMD: LD      B,A             ; Bit number+1 to B
        LD      A,00000001B     ; Bit to rotate
SHFTBT: RLCA                    ; Shift bit left
        DJNZ    SHFTBT          ; Count shifts
        RRA                     ; Restore correct place
        RET

ADJCOL: POP     BC              ; Restore return address
        POP     AF              ; Get bit mask
        POP     HL              ; Get column
        PUSH    AF              ; Re-save but mask
        LD      A,L             ; Get column
        RRA                     ; Divide by 2
        ADD     A,1             ; Start at column 1
        AND     00111111B       ; 0 to 63
        LD      H,A             ; Save column in H
        PUSH    HL              ; Re-save column
        PUSH    BC              ; Put back return
        LD      A,E             ; Get row
        RET

SMOTOR: CALL    CASFF           ; Flip tape drive
        LD      A,(HL)          ; Get byte
        RET

JPLDSV: LD      A,(BRKLIN)      ; CLOAD or CSAVE?
        CP      -1
        JP      NZ,SNDHDR       ; CSAVE - Send header
        JP      GETHDR          ; CLOAD - Get header

CRLIN1: CALL    PRNTCR          ; Output CRLF
        JP      GETLIN          ; Get an input line

CRLIN:  CALL    PRNTCR          ; Output CRLF
        JP      GETLIN          ; Get an input line

TSTBIT: PUSH    AF              ; Save bit mask
        AND     B               ; Get common bits
        POP     BC              ; Restore bit mask
        CP      B               ; Same bit set?
        LD      A,0             ; Return 0 in A
        RET

OUTNCR: CALL    OUTC            ; Output character in A
        JP      PRNTCR          ; Output CRLF

JJUMP:  JP      JJUMP1          ; "Cool" start

ZJUMP:  JP      BRKRET          ; Warm start
        END
