Subversion Repositories pentevo

Rev

Rev 384 | Rev 487 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

  1.  
  2. ;www.fruitcake.plus.com
  3.  
  4. ;LAST UPDATE: 04.05.2011 savelij
  5.  
  6.                 include rst8_equ.a80
  7.  
  8. AY_PRINTER      EQU 0
  9. TAP_EMUL        EQU 1
  10. PRESS_MAGIC     EQU 1
  11.  
  12. ; **************************************
  13. ; *** SPECTRUM 128 ROM 1 DISASSEMBLY ***
  14. ; **************************************
  15.  
  16. ; The Spectrum ROMs are copyright Amstrad, who have kindly given permission
  17. ; to reverse engineer and publish ROM disassemblies.
  18.  
  19.  
  20. ; =====
  21. ; NOTES
  22. ; =====
  23.  
  24. ; ------------
  25. ; Release Date
  26. ; ------------
  27. ; 23rd May 2009
  28.  
  29.  
  30. ; =================
  31. ; ASSEMBLER DEFINES
  32. ; =================
  33.  
  34. ;TASM directives:
  35.  
  36. ;#define DB .BYTE      
  37. ;#define DEFW .WORD
  38. ;#define DEFM .TEXT
  39. ;#DEFINE DEFS .FILL
  40. ;#define END  .END
  41. ;#define EQU  .EQU
  42. ;#define ORG  .ORG
  43.  
  44. ; The Sinclair Interface1 ROM written by Dr. Ian Logan calls numerous
  45. ; routines in this ROM. Non-standard entry points have a label beginning
  46. ; with X.
  47.  
  48.         ORG     $0000
  49.  
  50. ;*****************************************
  51. ;** Part 1. RESTART ROUTINES AND TABLES **
  52. ;*****************************************
  53.  
  54. ; -----------
  55. ; THE 'START'
  56. ; -----------
  57. ; At switch on, the Z80 chip is in interrupt mode 0.
  58. ; This location can also be 'called' to reset the machine.
  59. ; Typically with PRINT USR 0.
  60.  
  61. ;; START
  62. L0000:  DI                      ; disable interrupts.
  63.         XOR     A               ; signal coming from START.
  64.         LD      DE,$FFFF        ; top of possible physical RAM.
  65.         JP      L11CB           ; jump forward to common code at START-NEW.
  66.  
  67. ; -------------------
  68. ; THE 'ERROR' RESTART
  69. ; -------------------
  70. ; The error pointer is made to point to the position of the error to enable
  71. ; the editor to show the error if it occurred during syntax checking.
  72. ; It is used at 37 places in the program.
  73. ; An instruction fetch on address $0008 may page in a peripheral ROM
  74. ; such as the Sinclair Interface 1 or Disciple Disk Interface.
  75. ; This was not however an original design concept and not all errors pass
  76. ; through here.
  77.  
  78. ;; ERROR-1
  79. L0008
  80. ;               LD HL,($5C5D)           ; fetch the character address from CH_ADD.
  81.                 JP RST8_CMP
  82.  
  83. L000B           LD ($5C5F),HL           ; copy it to the error pointer X_PTR.
  84.                 JR L0053                ; forward to continue at ERROR-2.
  85.  
  86. ; -----------------------------
  87. ; THE 'PRINT CHARACTER' RESTART
  88. ; -----------------------------
  89. ; The A register holds the code of the character that is to be sent to
  90. ; the output stream of the current channel.
  91. ; The alternate register set is used to output a character in the A register
  92. ; so there is no need to preserve any of the current registers (HL,DE,BC).
  93. ; This restart is used 21 times.
  94.  
  95. ;; PRINT-A
  96. L0010:  JP      L15F2           ; jump forward to continue at PRINT-A-2.
  97.  
  98. ; ---
  99.  
  100. L0013
  101.                 OUT (C),A
  102.                 NOP
  103.                 RET
  104.  
  105.                 DUPL 0X0018-$,0XFF
  106.  
  107. ;        DB    $FF             ; this byte is used by the SPECTRUM command in
  108.                                 ; ROM 0 to generate an error report "0 OK".
  109. ;        DB    $FF, $FF        ; four unused locations.
  110. ;        DB    $FF, $FF        ;
  111.  
  112. ; -------------------------------
  113. ; THE 'COLLECT CHARACTER' RESTART
  114. ; -------------------------------
  115. ; The contents of the location currently addressed by CH_ADD are fetched.
  116. ; A return is made if the value represents a character that has
  117. ; relevance to the BASIC parser. Otherwise CH_ADD is incremented and the
  118. ; tests repeated. CH_ADD will be addressing somewhere -
  119. ; 1) in the BASIC program area during line execution.
  120. ; 2) in workspace if evaluating, for example, a string expression.
  121. ; 3) in the edit buffer if parsing a direct command or a new BASIC line.
  122. ; 4) in workspace if accepting input but not that from INPUT LINE.
  123.  
  124. ;; GET-CHAR
  125. L0018:  LD      HL,($5C5D)      ; fetch the address from CH_ADD.
  126.         LD      A,(HL)          ; use it to pick up current character.
  127.  
  128. ;; TEST-CHAR
  129. L001C:  CALL    L007D           ; routine SKIP-OVER tests if the character
  130.         RET     NC              ; is relevant. Return if it is so.
  131.  
  132. ; ------------------------------------
  133. ; THE 'COLLECT NEXT CHARACTER' RESTART
  134. ; ------------------------------------
  135. ; As the BASIC commands and expressions are interpreted, this routine is
  136. ; called repeatedly to step along the line. It is used 83 times.
  137.  
  138. ;; NEXT-CHAR
  139. L0020:  CALL    L0074           ; routine CH-ADD+1 fetches the next immediate
  140.                                 ; character.
  141.         JR      L001C           ; jump back to TEST-CHAR until a valid
  142.                                 ; character is found.
  143.  
  144. ; ---
  145.  
  146.         DB    $FF, $FF, $FF   ; unused
  147.  
  148. ; -----------------------
  149. ; THE 'CALCULATE' RESTART
  150. ; -----------------------
  151. ; This restart enters the Spectrum's internal, floating-point,
  152. ; stack-based, FORTH-like language.
  153. ; It is further used recursively from within the calculator.
  154. ; It is used on 77 occasions.
  155.  
  156. ;; FP-CALC
  157. L0028:  JP      L335B           ; jump forward to the CALCULATE routine.
  158.  
  159. ; ---
  160.  
  161.         DB    $FF, $FF, $FF   ; spare - note that on the ZX81, space being a
  162.         DB    $FF, $FF        ; little cramped, these same locations were
  163.                                 ; used for the five-byte end-calc literal.
  164.  
  165. ; ------------------------------
  166. ; THE 'CREATE BC SPACES' RESTART
  167. ; ------------------------------
  168. ; This restart is used on only 12 occasions to create BC spaces
  169. ; between workspace and the calculator stack.
  170.  
  171. ;; BC-SPACES
  172. L0030:  PUSH    BC              ; save number of spaces.
  173.         LD      HL,($5C61)      ; fetch WORKSP.
  174.         PUSH    HL              ; save address of workspace.
  175.         JP      L169E           ; jump forward to continuation code RESERVE.
  176.  
  177. ; --------------------------------
  178. ; THE 'MASKABLE INTERRUPT' ROUTINE
  179. ; --------------------------------
  180. ; This routine increments the Spectrum's three-byte FRAMES counter
  181. ; fifty times a second (sixty times a second in the USA ).
  182. ; Both this routine and the called KEYBOARD subroutine use
  183. ; the IY register to access system variables and flags so a user-written
  184. ; program must disable interrupts to make use of the IY register.
  185.  
  186. ;; MASK-INT
  187. L0038:  PUSH    AF              ; save the registers.
  188.         PUSH    HL              ; but not IY unfortunately.
  189.         LD      HL,($5C78)      ; fetch two bytes at FRAMES1.
  190.         INC     HL              ; increment lowest two bytes of counter.
  191.         LD      ($5C78),HL      ; place back in FRAMES1.
  192.         LD      A,H             ; test if the result
  193.         OR      L               ; was zero.
  194.         JR      NZ,L0048        ; forward to KEY-INT if not.
  195.  
  196.         INC     (IY+$40)        ; otherwise increment FRAMES3 the third byte.
  197.  
  198. ; now save the rest of the main registers and read and decode the keyboard.
  199.  
  200. ;; KEY-INT
  201. L0048:  PUSH    BC              ; save the other
  202.         PUSH    DE              ; main registers.
  203.  
  204.                 IF BAS48_ONLY
  205.                 CALL L02BF
  206.                 ELSE
  207.                 CALL L386E              ; Spectrum 128 patch: read the keypad and keyboard
  208.                                         ; in the process of reading a key-press.
  209.                 ENDIF
  210.  
  211. L004D:  POP     DE              ;
  212.         POP     BC              ; restore registers.
  213.  
  214.         POP     HL              ;
  215.         POP     AF              ;
  216.         EI                      ; enable interrupts.
  217.         RET                     ; return.
  218.  
  219. ; ---------------------
  220. ; THE 'ERROR-2' ROUTINE
  221. ; ---------------------
  222. ; A continuation of the code at 0008.
  223. ; The error code is stored and after clearing down stacks,
  224. ; an indirect jump is made to MAIN-4, etc. to handle the error.
  225.  
  226. ;; ERROR-2
  227. L0053:  POP     HL              ; drop the return address - the location
  228.                                 ; after the RST 08H instruction.
  229.         LD      L,(HL)          ; fetch the error code that follows.
  230.                                 ; (nice to see this instruction used.)
  231.  
  232. ; Note. this entry point is used when out of memory at REPORT-4.
  233. ; The L register has been loaded with the report code but X-PTR is not
  234. ; updated.
  235.  
  236. ;; ERROR-3
  237. L0055:  LD      (IY+$00),L      ; store it in the system variable ERR_NR.
  238.         LD      SP,($5C3D)      ; ERR_SP points to an error handler on the
  239.                                 ; machine stack. There may be a hierarchy
  240.                                 ; of routines.
  241.                                 ; to MAIN-4 initially at base.
  242.                                 ; or REPORT-G on line entry.
  243.                                 ; or  ED-ERROR when editing.
  244.                                 ; or   ED-FULL during ed-enter.
  245.                                 ; or  IN-VAR-1 during runtime input etc.
  246.  
  247.         JP      L16C5           ; jump to SET-STK to clear the calculator
  248.                                 ; stack and reset MEM to usual place in the
  249.                                 ; systems variables area.
  250.                                 ; and then indirectly to MAIN-4, etc.
  251.  
  252. ; ---
  253.  
  254.         DB    $FF, $FF, $FF   ; unused locations
  255.         DB    $FF, $FF, $FF   ; before the fixed-position
  256.         DB    $FF             ; NMI routine.
  257.  
  258. ; ------------------------------------
  259. ; THE 'NON-MASKABLE INTERRUPT' ROUTINE
  260. ; ------------------------------------
  261. ; There is no NMI switch on the standard Spectrum.
  262. ; When activated, a location in the system variables is tested
  263. ; and if the contents are zero a jump made to that location else
  264. ; a return is made. Perhaps a disabled development feature but
  265. ; if the logic was reversed, no program would be safe from
  266. ; copy-protection and the Spectrum would have had no software base.
  267. ; The location NMIADD was later used by Interface 1 for other purposes.
  268. ; On later Spectrums, and the Brazilian Spectrum, the logic of this
  269. ; routine was reversed.
  270.  
  271. ;===============================
  272.                 IF PRESS_MAGIC
  273.                 RST 0X08
  274.                 DB EXEC_MAGIC
  275.                 RETN
  276.                 NOP
  277.                 ELSE
  278. ;; RESET
  279. L0066           PUSH AF         ; save the
  280.                 PUSH HL         ; registers.
  281.                 LD HL,($5CB0)   ; fetch the system variable NMIADD.
  282.                 ENDIF
  283. ;===============================
  284.  
  285.                 LD A,H          ; test address
  286.                 OR L            ; for zero.
  287. ;               JR NZ,L0070     ; skip to NO-RESET if NOT ZERO
  288.                 JR Z,L0070
  289.                 JP (HL)         ; jump to routine ( i.e. L0000 )
  290.  
  291. ;; NO-RESET
  292. L0070           POP HL          ; restore the
  293.                 POP AF          ; registers.
  294.                 RETN            ; return to previous interrupt state.
  295.  
  296. ; ---------------------------
  297. ; THE 'CH ADD + 1' SUBROUTINE
  298. ; ---------------------------
  299. ; This subroutine is called from RST 20, and three times from elsewhere
  300. ; to fetch the next immediate character following the current valid character
  301. ; address and update the associated system variable.
  302. ; The entry point TEMP-PTR1 is used from the SCANNING routine.
  303. ; Both TEMP-PTR1 and TEMP-PTR2 are used by the READ command routine.
  304.  
  305. ;; CH-ADD+1
  306. L0074:  LD      HL,($5C5D)      ; fetch address from CH_ADD.
  307.  
  308. ;; TEMP-PTR1
  309. L0077:  INC     HL              ; increase the character address by one.
  310.  
  311. ;; TEMP-PTR2
  312. L0078:  LD      ($5C5D),HL      ; update CH_ADD with character address.
  313.  
  314. X007B:  LD      A,(HL)          ; load character to A from HL.
  315.         RET                     ; and return.
  316.  
  317. ; --------------------------
  318. ; THE 'SKIP OVER' SUBROUTINE
  319. ; --------------------------
  320. ; This subroutine is called once from RST 18 to skip over white-space and
  321. ; other characters irrelevant to the parsing of a BASIC line etc. .
  322. ; Initially the A register holds the character to be considered
  323. ; and HL holds its address which will not be within quoted text
  324. ; when a BASIC line is parsed.
  325. ; Although the 'tab' and 'at' characters will not appear in a BASIC line,
  326. ; they could be present in a string expression, and in other situations.
  327. ; Note. although white-space is usually placed in a program to indent loops
  328. ; and make it more readable, it can also be used for the opposite effect and
  329. ; spaces may appear in variable names although the parser never sees them.
  330. ; It is this routine that helps make the variables 'Anum bEr5 3BUS' and
  331. ; 'a number 53 bus' appear the same to the parser.
  332.  
  333. ;; SKIP-OVER
  334. L007D:  CP      $21             ; test if higher than space.
  335.         RET     NC              ; return with carry clear if so.
  336.  
  337.         CP      $0D             ; carriage return ?
  338.         RET     Z               ; return also with carry clear if so.
  339.  
  340.                                 ; all other characters have no relevance
  341.                                 ; to the parser and must be returned with
  342.                                 ; carry set.
  343.  
  344.         CP      $10             ; test if 0-15d
  345.         RET     C               ; return, if so, with carry set.
  346.  
  347.         CP      $18             ; test if 24-32d
  348.         CCF                     ; complement carry flag.
  349.         RET     C               ; return with carry set if so.
  350.  
  351.                                 ; now leaves 16d-23d
  352.  
  353.         INC     HL              ; all above have at least one extra character
  354.                                 ; to be stepped over.
  355.  
  356.         CP      $16             ; controls 22d ('at') and 23d ('tab') have two.
  357.         JR      C,L0090         ; forward to SKIPS with ink, paper, flash,
  358.                                 ; bright, inverse or over controls.
  359.                                 ; Note. the high byte of tab is for RS232 only.
  360.                                 ; it has no relevance on this machine.
  361.  
  362.         INC     HL              ; step over the second character of 'at'/'tab'.
  363.  
  364. ;; SKIPS
  365. L0090:  SCF                     ; set the carry flag
  366.         LD      ($5C5D),HL      ; update the CH_ADD system variable.
  367.         RET                     ; return with carry set.
  368.  
  369.  
  370. ; ------------------
  371. ; THE 'TOKEN TABLES'
  372. ; ------------------
  373. ; The tokenized characters 134d (RND) to 255d (COPY) are expanded using
  374. ; this table. The last byte of a token is inverted to denote the end of
  375. ; the word. The first is an inverted step-over byte.
  376.  
  377. ;; TKN-TABLE
  378. L0095           DC "?"          ;DB    '?'+$80
  379.                 DC "RND"        ;DEFM    "RN"
  380.                                 ;DB    'D'+$80
  381.                 DC "INKEY$"     ;DEFM    "INKEY"
  382.                                 ;DB    '$'+$80
  383.                 DC "PI"         ;DB    'P','I'+$80
  384.                 DC "FN"         ;DB    'F','N'+$80
  385.                 DC "POINT"      ;DEFM    "POIN"
  386.                                 ;DB    'T'+$80
  387.                 DC "SCREEN$"    ;DEFM    "SCREEN"
  388.                                 ;DB    '$'+$80
  389.                 DC "ATTR"       ;DEFM    "ATT"
  390.                                 ;DB    'R'+$80
  391.                 DC "AT"         ;DB    'A','T'+$80
  392.                 DC "TAB"        ;DEFM    "TA"
  393.                                 ;DB    'B'+$80
  394.                 DC "VAL$"       ;DEFM    "VAL"
  395.                                 ;DB    '$'+$80
  396.                 DC "CODE"       ;DEFM    "COD"
  397.                                 ;DB    'E'+$80
  398.                 DC "VAL"        ;DEFM    "VA"
  399.                                 ;DB    'L'+$80
  400.                 DC "LEN"        ;DEFM    "LE"
  401.                                 ;DB    'N'+$80
  402.                 DC "SIN"        ;DEFM    "SI"
  403.                                 ;DB    'N'+$80
  404.                 DC "COS"        ;DEFM    "CO"
  405.                                 ;DB    'S'+$80
  406.                 DC "TAN"        ;DEFM    "TA"
  407.                                 ;DB    'N'+$80
  408.                 DC "ASN"        ;DEFM    "AS"
  409.                                 ;DB    'N'+$80
  410.                 DC "ACS"        ;DEFM    "AC"
  411.                                 ;DB    'S'+$80
  412.                 DC "ATN"        ;DEFM    "AT"
  413.                                 ;DB    'N'+$80
  414.                 DC "LN"         ;DB    'L','N'+$80
  415.                 DC "EXP"        ;DEFM    "EX"
  416.                                 ;DB    'P'+$80
  417.                 DC "INT"        ;DEFM    "IN"
  418.                                 ;DB    'T'+$80
  419.                 DC "SQR"        ;DEFM    "SQ"
  420.                                 ;DB    'R'+$80
  421.                 DC "SGN"        ;DEFM    "SG"
  422.                                 ;DB    'N'+$80
  423.                 DC "ABS"        ;DEFM    "AB"
  424.                                 ;DB    'S'+$80
  425.                 DC "PEEK"       ;DEFM    "PEE"
  426.                                 ;DB    'K'+$80
  427.                 DC "IN"         ;DB    'I','N'+$80
  428.                 DC "USR"        ;DEFM    "US"
  429.                                 ;DB    'R'+$80
  430.                 DC "STR$"       ;DEFM    "STR"
  431.                                 ;DB    '$'+$80
  432.                 DC "CHR$"       ;DEFM    "CHR"
  433.                                 ;DB    '$'+$80
  434.                 DC "NOT"        ;DEFM    "NO"
  435.                                 ;DB    'T'+$80
  436.                 DC "BIN"        ;DEFM    "BI"
  437.                                 ;DB    'N'+$80
  438.  
  439. ;   The previous 32 function-type words are printed without a leading space
  440. ;   The following have a leading space if they begin with a letter
  441.  
  442.                 DC "OR"         ;DB    'O','R'+$80
  443.                 DC "AND"        ;DEFM    "AN"
  444.                                 ;DB    'D'+$80
  445.                 DC "<="         ;DB    $3C,'='+$80             ; <=
  446.                 DC ">="         ;DB    $3E,'='+$80             ; >=
  447.                 DC "<>"         ;DB    $3C,$3E+$80             ; <>
  448.                 DC "LINE"       ;DEFM    "LIN"
  449.                                 ;DB    'E'+$80
  450.                 DC "THEN"       ;DEFM    "THE"
  451.                                 ;DB    'N'+$80
  452.                 DC "TO"         ;DB    'T','O'+$80
  453.                 DC "STEP"       ;DEFM    "STE"
  454.                                 ;DB    'P'+$80
  455.                 DC "DEF FN"     ;DEFM    "DEF F"
  456.                                 ;DB    'N'+$80
  457.                 DC "CAT"        ;DEFM    "CA"
  458.                                 ;DB    'T'+$80
  459.                 DC "FORMAT"     ;DEFM    "FORMA"
  460.                                 ;DB    'T'+$80
  461.                 DC "MOVE"       ;DEFM    "MOV"
  462.                                 ;DB    'E'+$80
  463.                 DC "ERASE"      ;DEFM    "ERAS"
  464.                                 ;DB    'E'+$80
  465.                 DC "OPEN #"     ;DEFM    "OPEN "
  466.                                 ;DB    '#'+$80
  467.                 DC "CLOSE #"    ;DEFM    "CLOSE "
  468.                                 ;DB    '#'+$80
  469.                 DC "MERGE"      ;DEFM    "MERG"
  470.                                 ;DB    'E'+$80
  471.                 DC "VERIFY"     ;DEFM    "VERIF"
  472.                                 ;DB    'Y'+$80
  473.                 DC "BEEP"       ;DEFM    "BEE"
  474.                                 ;DB    'P'+$80
  475.                 DC "CIRCLE"     ;DEFM    "CIRCL"
  476.                                 ;DB    'E'+$80
  477.                 DC "INK"        ;DEFM    "IN"
  478.                                 ;DB    'K'+$80
  479.                 DC "PAPER"      ;DEFM    "PAPE"
  480.                                 ;DB    'R'+$80
  481.                 DC "FLASH"      ;DEFM    "FLAS"
  482.                                 ;DB    'H'+$80
  483.                 DC "BRIGHT"     ;DEFM    "BRIGH"
  484.                                 ;DB    'T'+$80
  485.                 DC "INVERSE"    ;DEFM    "INVERS"
  486.                                 ;DB    'E'+$80
  487.                 DC "OVER"       ;DEFM    "OVE"
  488.                                 ;DB    'R'+$80
  489.                 DC "OUT"        ;DEFM    "OU"
  490.                                 ;DB    'T'+$80
  491.                 DC "LPRINT"     ;DEFM    "LPRIN"
  492.                                 ;DB    'T'+$80
  493.                 DC "LLIST"      ;DEFM    "LLIS"
  494.                                 ;DB    'T'+$80
  495.                 DC "STOP"       ;DEFM    "STO"
  496.                                 ;DB    'P'+$80
  497.                 DC "READ"       ;DEFM    "REA"
  498.                                 ;DB    'D'+$80
  499.                 DC "DATA"       ;DEFM    "DAT"
  500.                                 ;DB    'A'+$80
  501.                 DC "RESTORE"    ;DEFM    "RESTOR"
  502.                                 ;DB    'E'+$80
  503.                 DC "NEW"        ;DEFM    "NE"
  504.                                 ;DB    'W'+$80
  505.                 DC "BORDER"     ;DEFM    "BORDE"
  506.                                 ;DB    'R'+$80
  507.                 DC "CONTINUE"   ;DEFM    "CONTINU"
  508.                                 ;DB    'E'+$80
  509.                 DC "DIM"        ;DEFM    "DI"
  510.                                 ;DB    'M'+$80
  511.                 DC "REM"        ;DEFM    "RE"
  512.                                 ;DB    'M'+$80
  513.                 DC "FOR"        ;DEFM    "FO"
  514.                                 ;DB    'R'+$80
  515.                 DC "GO TO"      ;DEFM    "GO T"
  516.                                 ;DB    'O'+$80
  517.                 DC "GO SUB"     ;DEFM    "GO SU"
  518.                                 ;DB    'B'+$80
  519.                 DC "INPUT"      ;DEFM    "INPU"
  520.                                 ;DB    'T'+$80
  521.                 DC "LOAD"       ;DEFM    "LOA"
  522.                                 ;DB    'D'+$80
  523.                 DC "LIST"       ;DEFM    "LIS"
  524.                                 ;DB    'T'+$80
  525.                 DC "LET"        ;DEFM    "LE"
  526.                                 ;DB    'T'+$80
  527.                 DC "PAUSE"      ;DEFM    "PAUS"
  528.                                 ;DB    'E'+$80
  529.                 DC "NEXT"       ;DEFM    "NEX"
  530.                                 ;DB    'T'+$80
  531.                 DC "POKE"       ;DEFM    "POK"
  532.                                 ;DB    'E'+$80
  533.                 DC "PRINT"      ;DEFM    "PRIN"
  534.                                 ;DB    'T'+$80
  535.                 DC "PLOT"       ;DEFM    "PLO"
  536.                                 ;DB    'T'+$80
  537.                 DC "RUN"        ;DEFM    "RU"
  538.                                 ;DB    'N'+$80
  539.                 DC "SAVE"       ;DEFM    "SAV"
  540.                                 ;DB    'E'+$80
  541.                 DC "RANDOMIZE"  ;DEFM    "RANDOMIZ"
  542.                                 ;DB    'E'+$80
  543.                 DC "IF"         ;DB    'I','F'+$80
  544.                 DC "CLS"        ;DEFM    "CL"
  545.                                 ;DB    'S'+$80
  546.                 DC "DRAW"       ;DEFM    "DRA"
  547.                                 ;DB    'W'+$80
  548.                 DC "CLEAR"      ;DEFM    "CLEA"
  549.                                 ;DB    'R'+$80
  550.                 DC "RETURN"     ;DEFM    "RETUR"
  551.                                 ;DB    'N'+$80
  552.                 DC "COPY"       ;DEFM    "COP"
  553.                                 ;DB    'Y'+$80
  554.  
  555. ; ----------------
  556. ; THE 'KEY' TABLES
  557. ; ----------------
  558. ; These six look-up tables are used by the keyboard reading routine
  559. ; to decode the key values.
  560.  
  561. ; The first table contains the maps for the 39 keys of the standard
  562. ; 40-key Spectrum keyboard. The remaining key [SHIFT $27] is read directly.
  563. ; The keys consist of the 26 upper-case alphabetic characters, the 10 digit
  564. ; keys and the space, ENTER and symbol shift key.
  565. ; Unshifted alphabetic keys have $20 added to the value.
  566. ; The keywords for the main alphabetic keys are obtained by adding $A5 to
  567. ; the values obtained from this table.
  568.  
  569. ;; MAIN-KEYS
  570. L0205:  DB    $42             ; B
  571.         DB    $48             ; H
  572.         DB    $59             ; Y
  573.         DB    $36             ; 6
  574.         DB    $35             ; 5
  575.         DB    $54             ; T
  576.         DB    $47             ; G
  577.         DB    $56             ; V
  578.         DB    $4E             ; N
  579.         DB    $4A             ; J
  580.         DB    $55             ; U
  581.         DB    $37             ; 7
  582.         DB    $34             ; 4
  583.         DB    $52             ; R
  584.         DB    $46             ; F
  585.         DB    $43             ; C
  586.         DB    $4D             ; M
  587.         DB    $4B             ; K
  588.         DB    $49             ; I
  589.         DB    $38             ; 8
  590.         DB    $33             ; 3
  591.         DB    $45             ; E
  592.         DB    $44             ; D
  593.         DB    $58             ; X
  594.         DB    $0E             ; SYMBOL SHIFT
  595.         DB    $4C             ; L
  596.         DB    $4F             ; O
  597.         DB    $39             ; 9
  598.         DB    $32             ; 2
  599.         DB    $57             ; W
  600.         DB    $53             ; S
  601.         DB    $5A             ; Z
  602.         DB    $20             ; SPACE
  603.         DB    $0D             ; ENTER
  604.         DB    $50             ; P
  605.         DB    $30             ; 0
  606.         DB    $31             ; 1
  607.         DB    $51             ; Q
  608.         DB    $41             ; A
  609.  
  610.  
  611. ;; E-UNSHIFT
  612. ;  The 26 unshifted extended mode keys for the alphabetic characters.
  613. ;  The green keywords on the original keyboard.
  614. L022C:  DB    $E3             ; READ
  615.         DB    $C4             ; BIN
  616.         DB    $E0             ; LPRINT
  617.         DB    $E4             ; DATA
  618.         DB    $B4             ; TAN
  619.         DB    $BC             ; SGN
  620.         DB    $BD             ; ABS
  621.         DB    $BB             ; SQR
  622.         DB    $AF             ; CODE
  623.         DB    $B0             ; VAL
  624.         DB    $B1             ; LEN
  625.         DB    $C0             ; USR
  626.         DB    $A7             ; PI
  627.         DB    $A6             ; INKEY$
  628.         DB    $BE             ; PEEK
  629.         DB    $AD             ; TAB
  630.         DB    $B2             ; SIN
  631.         DB    $BA             ; INT
  632.         DB    $E5             ; RESTORE
  633.         DB    $A5             ; RND
  634.         DB    $C2             ; CHR$
  635.         DB    $E1             ; LLIST
  636.         DB    $B3             ; COS
  637.         DB    $B9             ; EXP
  638.         DB    $C1             ; STR$
  639.         DB    $B8             ; LN
  640.  
  641.  
  642. ;; EXT-SHIFT
  643. ;  The 26 shifted extended mode keys for the alphabetic characters.
  644. ;  The red keywords below keys on the original keyboard.
  645. L0246:  DB    $7E             ; ~
  646.         DB    $DC             ; BRIGHT
  647.         DB    $DA             ; PAPER
  648.         DB    $5C             ;
  649.         DB    $B7             ; ATN
  650.         DB    $7B             ; {
  651.         DB    $7D             ; }
  652.         DB    $D8             ; CIRCLE
  653.         DB    $BF             ; IN
  654.         DB    $AE             ; VAL$
  655.         DB    $AA             ; SCREEN$
  656.         DB    $AB             ; ATTR
  657.         DB    $DD             ; INVERSE
  658.         DB    $DE             ; OVER
  659.         DB    $DF             ; OUT
  660.         DB    $7F             ; (Copyright character)
  661.         DB    $B5             ; ASN
  662.         DB    $D6             ; VERIFY
  663.         DB    $7C             ; |
  664.         DB    $D5             ; MERGE
  665.         DB    $5D             ; ]
  666.         DB    $DB             ; FLASH
  667.         DB    $B6             ; ACS
  668.         DB    $D9             ; INK
  669.         DB    $5B             ; [
  670.         DB    $D7             ; BEEP
  671.  
  672.  
  673. ;; CTL-CODES
  674. ;  The ten control codes assigned to the top line of digits when the shift
  675. ;  key is pressed.
  676. L0260:  DB    $0C             ; DELETE
  677.         DB    $07             ; EDIT
  678.         DB    $06             ; CAPS LOCK
  679.         DB    $04             ; TRUE VIDEO
  680.         DB    $05             ; INVERSE VIDEO
  681.         DB    $08             ; CURSOR LEFT
  682.         DB    $0A             ; CURSOR DOWN
  683.         DB    $0B             ; CURSOR UP
  684.         DB    $09             ; CURSOR RIGHT
  685.         DB    $0F             ; GRAPHICS
  686.  
  687.  
  688. ;; SYM-CODES
  689. ;  The 26 red symbols assigned to the alphabetic characters of the keyboard.
  690. ;  The ten single-character digit symbols are converted without the aid of
  691. ;  a table using subtraction and minor manipulation.
  692. L026A:  DB    $E2             ; STOP
  693.         DB    $2A             ; *
  694.         DB    $3F             ; ?
  695.         DB    $CD             ; STEP
  696.         DB    $C8             ; >=
  697.         DB    $CC             ; TO
  698.         DB    $CB             ; THEN
  699.         DB    $5E             ; ^
  700.         DB    $AC             ; AT
  701.         DB    $2D             ; -
  702.         DB    $2B             ; +
  703.         DB    $3D             ; =
  704.         DB    $2E             ; .
  705.         DB    $2C             ; ,
  706.         DB    $3B             ; ;
  707.         DB    $22             ; "
  708.         DB    $C7             ; <=
  709.         DB    $3C             ; <
  710.         DB    $C3             ; NOT
  711.         DB    $3E             ; >
  712.         DB    $C5             ; OR
  713.         DB    $2F             ; /
  714.         DB    $C9             ; <>
  715.         DB    $60             ; pound
  716.         DB    $C6             ; AND
  717.         DB    $3A             ; :
  718.  
  719. ;; E-DIGITS
  720. ;  The ten keywords assigned to the digits in extended mode.
  721. ;  The remaining red keywords below the keys.
  722. L0284:  DB    $D0             ; FORMAT
  723.         DB    $CE             ; DEF FN
  724.         DB    $A8             ; FN
  725.         DB    $CA             ; LINE
  726.         DB    $D3             ; OPEN#
  727.         DB    $D4             ; CLOSE#
  728.         DB    $D1             ; MOVE
  729.         DB    $D2             ; ERASE
  730.         DB    $A9             ; POINT
  731.         DB    $CF             ; CAT
  732.  
  733.  
  734. ;*******************************
  735. ;** Part 2. KEYBOARD ROUTINES **
  736. ;*******************************
  737.  
  738. ; Using shift keys and a combination of modes the Spectrum 40-key keyboard
  739. ; can be mapped to 256 input characters
  740.  
  741. ; ---------------------------------------------------------------------------
  742. ;
  743. ;         0     1     2     3     4 -Bits-  4     3     2     1     0
  744. ; PORT                                                                    PORT
  745. ;
  746. ; F7FE  [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ]  |  [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 0 ]   EFFE
  747. ;  ^                                   |                                   v
  748. ; FBFE  [ Q ] [ W ] [ E ] [ R ] [ T ]  |  [ Y ] [ U ] [ I ] [ O ] [ P ]   DFFE
  749. ;  ^                                   |                                   v
  750. ; FDFE  [ A ] [ S ] [ D ] [ F ] [ G ]  |  [ H ] [ J ] [ K ] [ L ] [ ENT ] BFFE
  751. ;  ^                                   |                                   v
  752. ; FEFE  [SHI] [ Z ] [ X ] [ C ] [ V ]  |  [ B ] [ N ] [ M ] [sym] [ SPC ] 7FFE
  753. ;  ^     $27                                                 $18           v
  754. ; Start                                                                   End
  755. ;        00100111                                            00011000
  756. ;
  757. ; ---------------------------------------------------------------------------
  758. ; The above map may help in reading.
  759. ; The neat arrangement of ports means that the B register need only be
  760. ; rotated left to work up the left hand side and then down the right
  761. ; hand side of the keyboard. When the reset bit drops into the carry
  762. ; then all 8 half-rows have been read. Shift is the first key to be
  763. ; read. The lower six bits of the shifts are unambiguous.
  764.  
  765. ; -------------------------------
  766. ; THE 'KEYBOARD SCANNING' ROUTINE
  767. ; -------------------------------
  768. ; from keyboard and s-inkey$
  769. ; returns 1 or 2 keys in DE, most significant shift first if any
  770. ; key values 0-39 else 255
  771.  
  772. ;; KEY-SCAN
  773. L028E:  LD      L,$2F           ; initial key value
  774.                                 ; valid values are obtained by subtracting
  775.                                 ; eight five times.
  776.         LD      DE,$FFFF        ; a buffer to receive 2 keys.
  777.  
  778.         LD      BC,$FEFE        ; the commencing port address
  779.                                 ; B holds 11111110 initially and is also
  780.                                 ; used to count the 8 half-rows
  781. ;; KEY-LINE
  782. L0296:  IN      A,(C)           ; read the port to A - bits will be reset
  783.                                 ; if a key is pressed else set.
  784.         CPL                     ; complement - pressed key-bits are now set
  785.         AND     $1F             ; apply 00011111 mask to pick up the
  786.                                 ; relevant set bits.
  787.  
  788.         JR      Z,L02AB         ; forward to KEY-DONE if zero and therefore
  789.                                 ; no keys pressed in row at all.
  790.  
  791.         LD      H,A             ; transfer row bits to H
  792.         LD      A,L             ; load the initial key value to A
  793.  
  794. ;; KEY-3KEYS
  795. L029F:  INC     D               ; now test the key buffer
  796.         RET     NZ              ; if we have collected 2 keys already
  797.                                 ; then too many so quit.
  798.  
  799. ;; KEY-BITS
  800. L02A1:  SUB     $08             ; subtract 8 from the key value
  801.                                 ; cycling through key values (top = $27)
  802.                                 ; e.g. 2F>   27>1F>17>0F>07
  803.                                 ;      2E>   26>1E>16>0E>06
  804.         SRL     H               ; shift key bits right into carry.
  805.         JR      NC,L02A1        ; back to KEY-BITS if not pressed
  806.                                 ; but if pressed we have a value (0-39d)
  807.  
  808.         LD      D,E             ; transfer a possible previous key to D
  809.         LD      E,A             ; transfer the new key to E
  810.         JR      NZ,L029F        ; back to KEY-3KEYS if there were more
  811.                                 ; set bits - H was not yet zero.
  812.  
  813. ;; KEY-DONE
  814. L02AB:  DEC     L               ; cycles 2F>2E>2D>2C>2B>2A>29>28 for
  815.                                 ; each half-row.
  816.         RLC     B               ; form next port address e.g. FEFE > FDFE
  817.         JR      C,L0296         ; back to KEY-LINE if still more rows to do.
  818.  
  819.         LD      A,D             ; now test if D is still FF ?
  820.         INC     A               ; if it is zero we have at most 1 key
  821.                                 ; range now $01-$28  (1-40d)
  822.         RET     Z               ; return if one key or no key.
  823.  
  824.         CP      $28             ; is it capsshift (was $27) ?
  825.         RET     Z               ; return if so.
  826.  
  827.         CP      $19             ; is it symbol shift (was $18) ?
  828.         RET     Z               ; return also
  829.  
  830.         LD      A,E             ; now test E
  831.         LD      E,D             ; but first switch
  832.         LD      D,A             ; the two keys.
  833.         CP      $18             ; is it symbol shift ?
  834.         RET                     ; return (with zero set if it was).
  835.                                 ; but with symbol shift now in D
  836.  
  837. ; ------------------------------
  838. ; Scan keyboard and decode value
  839. ; ------------------------------
  840. ; from interrupt 50 times a second
  841. ;
  842.  
  843. ;; KEYBOARD
  844. L02BF:  CALL    L028E           ; routine KEY-SCAN
  845.         RET     NZ              ; return if invalid combinations
  846.  
  847. ; then decrease the counters within the two key-state maps
  848. ; as this could cause one to become free.
  849. ; if the keyboard has not been pressed during the last five interrupts
  850. ; then both sets will be free.
  851.  
  852.  
  853.         LD      HL,$5C00        ; point to KSTATE-0
  854.  
  855. ;; K-ST-LOOP
  856. L02C6:  BIT     7,(HL)          ; is it free ?  ($FF)
  857.         JR      NZ,L02D1        ; forward to K-CH-SET if so
  858.  
  859.         INC     HL              ; address 5-counter
  860.         DEC     (HL)            ; decrease counter
  861.         DEC     HL              ; step back
  862.         JR      NZ,L02D1        ; forward to K-CH-SET if not at end of count
  863.  
  864.         LD      (HL),$FF        ; else mark it free.
  865.  
  866. ;; K-CH-SET
  867. L02D1:  LD      A,L             ; store low address byte.
  868.         LD      HL,$5C04        ; point to KSTATE-4
  869.                                 ; (ld l, $04)
  870.         CP      L               ; have 2 been done ?
  871.         JR      NZ,L02C6        ; back to K-ST-LOOP to consider this 2nd set
  872.  
  873. ; now the raw key (0-38) is converted to a main key (uppercase).
  874.  
  875.         CALL    L031E           ; routine K-TEST to get main key in A
  876.         RET     NC              ; return if single shift
  877.  
  878.         LD      HL,$5C00        ; point to KSTATE-0
  879.         CP      (HL)            ; does it match ?
  880.         JR      Z,L0310         ; forward to K-REPEAT if so
  881.  
  882. ; if not consider the second key map.
  883.  
  884.         EX      DE,HL           ; save kstate-0 in de
  885.         LD      HL,$5C04        ; point to KSTATE-4
  886.         CP      (HL)            ; does it match ?
  887.         JR      Z,L0310         ; forward to K-REPEAT if so
  888.  
  889. ; having excluded a repeating key we can now consider a new key.
  890. ; the second set is always examined before the first.
  891.  
  892.         BIT     7,(HL)          ; is it free ?
  893.         JR      NZ,L02F1        ; forward to K-NEW if so.
  894.  
  895.         EX      DE,HL           ; bring back kstate-0
  896.         BIT     7,(HL)          ; is it free ?
  897.         RET     Z               ; return if not.
  898.                                 ; as we have a key but nowhere to put it yet.
  899.  
  900. ; continue or jump to here if one of the buffers was free.
  901.  
  902. ;; K-NEW
  903. L02F1:  LD      E,A             ; store key in E
  904.         LD      (HL),A          ; place in free location
  905.         INC     HL              ; advance to interrupt counter
  906.         LD      (HL),$05        ; and initialize to 5
  907.         INC     HL              ; advance to delay
  908.         LD      A,($5C09)       ; pick up system variable REPDEL
  909.         LD      (HL),A          ; and insert that for first repeat delay.
  910.         INC     HL              ; advance to last location of state map.
  911.  
  912.         LD      C,(IY+$07)      ; pick up MODE  (3 bytes)
  913.         LD      D,(IY+$01)      ; pick up FLAGS (3 bytes)
  914.         PUSH    HL              ; save state map location
  915.                                 ; Note. could now have used.
  916.                                 ; ld l,$41; ld c,(hl); ld l,$3B; ld d,(hl).
  917.                                 ; six and two threes of course.
  918.         CALL    L0333           ; routine K-DECODE
  919.         POP     HL              ; restore map pointer
  920.         LD      (HL),A          ; put decoded key in last location of map.
  921.  
  922. ;; K-END
  923. L0308:  LD      ($5C08),A       ; update LASTK system variable.
  924.         SET     5,(IY+$01)      ; update FLAGS  - signal new key.
  925.         RET                     ; done
  926.  
  927. ; ---------------------------
  928. ; THE 'REPEAT KEY' SUBROUTINE
  929. ; ---------------------------
  930. ; A possible repeat has been identified. HL addresses the raw (main) key.
  931. ; The last location holds the decoded key (from the first context).
  932.  
  933. ;; K-REPEAT
  934. L0310:  INC     HL              ; advance
  935.         LD      (HL),$05        ; maintain interrupt counter at 5
  936.         INC     HL              ; advance
  937.         DEC     (HL)            ; decrease REPDEL value.
  938.         RET     NZ              ; return if not yet zero.
  939.  
  940.         LD      A,($5C0A)       ; REPPER
  941.         LD      (HL),A          ; but for subsequent repeats REPPER will be used.
  942.         INC     HL              ; advance
  943.                                 ;
  944.         LD      A,(HL)          ; pick up the key decoded possibly in another
  945.                                 ; context.
  946.         JR      L0308           ; back to K-END
  947.  
  948. ; --------------
  949. ; Test key value
  950. ; --------------
  951. ; also called from s-inkey$
  952. ; begin by testing for a shift with no other.
  953.  
  954. ;; K-TEST
  955. L031E:  LD      B,D             ; load most significant key to B
  956.                                 ; will be $FF if not shift.
  957.         LD      D,$00           ; and reset D to index into main table
  958.         LD      A,E             ; load least significant key from E
  959.         CP      $27             ; is it higher than 39d   i.e. FF
  960.         RET     NC              ; return with just a shift (in B now)
  961.  
  962.         CP      $18             ; is it symbol shift ?
  963.         JR      NZ,L032C        ; forward to K-MAIN if not
  964.  
  965. ; but we could have just symbol shift and no other
  966.  
  967.         BIT     7,B             ; is other key $FF (ie not shift)
  968.         RET     NZ              ; return with solitary symbol shift
  969.  
  970.  
  971. ;; K-MAIN
  972. L032C:  LD      HL,L0205        ; address: MAIN-KEYS
  973.         ADD     HL,DE           ; add offset 0-38
  974.         LD      A,(HL)          ; pick up main key value
  975.         SCF                     ; set carry flag
  976.         RET                     ; return    (B has other key still)
  977.  
  978. ; -----------------
  979. ; Keyboard decoding
  980. ; -----------------
  981. ; also called from s-inkey$
  982.  
  983. ;; K-DECODE
  984. L0333:  LD      A,E             ; pick up the stored main key
  985.         CP      $3A             ; an arbitrary point between digits and letters
  986.         JR      C,L0367         ; forward to K-DIGIT with digits, space, enter.
  987.  
  988.         DEC     C               ; decrease MODE ( 0='KLC', 1='E', 2='G')
  989.  
  990.         JP      M,L034F         ; to K-KLC-LET if was zero
  991.  
  992.         JR      Z,L0341         ; to K-E-LET if was 1 for extended letters.
  993.  
  994. ; proceed with graphic codes.
  995. ; Note. should selectively drop return address if code > 'U' ($55).
  996. ; i.e. abort the KEYBOARD call.
  997. ; e.g. cp 'V'; jr c addit; pop af; ;;addit etc. (5 bytes of instruction).
  998. ; (s-inkey$ never gets into graphics mode.)
  999.  
  1000. ;; addit
  1001.         ADD     A,$4F           ; add offset to augment 'A' to graphics A say.
  1002.         RET                     ; return.
  1003.                                 ; Note. ( but [GRAPH] V gives RND, etc ).
  1004.  
  1005. ; ---
  1006.  
  1007. ; the jump was to here with extended mode with uppercase A-Z.
  1008.  
  1009. ;; K-E-LET
  1010. L0341:  LD      HL,L022C-$41    ; base address of E-UNSHIFT L022c
  1011.                                 ; ( $01EB in standard ROM )
  1012.         INC     B               ; test B is it empty i.e. not a shift
  1013.         JR      Z,L034A         ; forward to K-LOOK-UP if neither shift
  1014.  
  1015.         LD      HL,L0246-$41    ; Address: $0205 L0246-$41 EXT-SHIFT base
  1016.  
  1017. ;; K-LOOK-UP
  1018. L034A:  LD      D,$00           ; prepare to index
  1019.         ADD     HL,DE           ; add the main key value
  1020.         LD      A,(HL)          ; pick up other mode value
  1021.         RET                     ; return
  1022.  
  1023. ; ---
  1024.  
  1025. ; the jump was here with mode = 0
  1026.  
  1027. ;; K-KLC-LET
  1028. L034F:  LD      HL,L026A-$41    ; prepare base of sym-codes
  1029.         BIT     0,B             ; shift=$27 sym-shift=$18
  1030.         JR      Z,L034A         ; back to K-LOOK-UP with symbol-shift
  1031.  
  1032.         BIT     3,D             ; test FLAGS is it 'K' mode (from OUT-CURS)
  1033.         JR      Z,L0364         ; skip to K-TOKENS if so
  1034.  
  1035.         BIT     3,(IY+$30)      ; test FLAGS2 - consider CAPS LOCK ?
  1036.         RET     NZ              ; return if so with main code.
  1037.  
  1038.         INC     B               ; is shift being pressed ?
  1039.                                 ; result zero if not
  1040.         RET     NZ              ; return if shift pressed.
  1041.  
  1042.         ADD     A,$20           ; else convert the code to lower case.
  1043.         RET                     ; return.
  1044.  
  1045. ; ---
  1046.  
  1047. ; the jump was here for tokens
  1048.  
  1049. ;; K-TOKENS
  1050. L0364:  ADD     A,$A5           ; add offset to main code so that 'A'
  1051.                                 ; becomes 'NEW' etc.
  1052.         RET                     ; return
  1053.  
  1054. ; ---
  1055.  
  1056. ; the jump was here with digits, space, enter and symbol shift (< $xx)
  1057.  
  1058. ;; K-DIGIT
  1059. L0367:  CP      $30             ; is it '0' or higher ?
  1060.         RET     C               ; return with space, enter and symbol-shift
  1061.  
  1062.         DEC     C               ; test MODE (was 0='KLC', 1='E', 2='G')
  1063.         JP      M,L039D         ; jump to K-KLC-DGT if was 0.
  1064.  
  1065.         JR      NZ,L0389        ; forward to K-GRA-DGT if mode was 2.
  1066.  
  1067. ; continue with extended digits 0-9.
  1068.  
  1069.         LD      HL,L0284-$30    ; $0254 - base of E-DIGITS
  1070.         BIT     5,B             ; test - shift=$27 sym-shift=$18
  1071.         JR      Z,L034A         ; to K-LOOK-UP if sym-shift
  1072.  
  1073.         CP      $38             ; is character '8' ?
  1074.         JR      NC,L0382        ; to K-8-&-9 if greater than '7'
  1075.  
  1076.         SUB     $20             ; reduce to ink range $10-$17
  1077.         INC     B               ; shift ?
  1078.         RET     Z               ; return if not.
  1079.  
  1080.         ADD     A,$08           ; add 8 to give paper range $18 - $1F
  1081.         RET                     ; return
  1082.  
  1083. ; ---
  1084.  
  1085. ; 89
  1086.  
  1087. ;; K-8-&-9
  1088. L0382:  SUB     $36             ; reduce to 02 and 03  bright codes
  1089.         INC     B               ; test if shift pressed.
  1090.         RET     Z               ; return if not.
  1091.  
  1092.         ADD     A,$FE           ; subtract 2 setting carry
  1093.         RET                     ; to give 0 and 1    flash codes.
  1094.  
  1095. ; ---
  1096.  
  1097. ;  graphics mode with digits
  1098.  
  1099. ;; K-GRA-DGT
  1100. L0389:  LD      HL,L0260-$30    ; $0230 base address of CTL-CODES
  1101.  
  1102.         CP      $39             ; is key '9' ?
  1103.         JR      Z,L034A         ; back to K-LOOK-UP - changed to $0F, GRAPHICS.
  1104.  
  1105.         CP      $30             ; is key '0' ?
  1106.         JR      Z,L034A         ; back to K-LOOK-UP - changed to $0C, delete.
  1107.  
  1108. ; for keys '0' - '7' we assign a mosaic character depending on shift.
  1109.  
  1110.         AND     $07             ; convert character to number. 0 - 7.
  1111.         ADD     A,$80           ; add offset - they start at $80
  1112.  
  1113.         INC     B               ; destructively test for shift
  1114.         RET     Z               ; and return if not pressed.
  1115.  
  1116.         XOR     $0F             ; toggle bits becomes range $88-$8F
  1117.         RET                     ; return.
  1118.  
  1119. ; ---
  1120.  
  1121. ; now digits in 'KLC' mode
  1122.  
  1123. ;; K-KLC-DGT
  1124. L039D:  INC     B               ; return with digit codes if neither
  1125.         RET     Z               ; shift key pressed.
  1126.  
  1127.         BIT     5,B             ; test for caps shift.
  1128.  
  1129.         LD      HL,L0260-$30    ; prepare base of table CTL-CODES.
  1130.         JR      NZ,L034A        ; back to K-LOOK-UP if shift pressed.
  1131.  
  1132. ; must have been symbol shift
  1133.  
  1134.         SUB     $10             ; for ASCII most will now be correct
  1135.                                 ; on a standard typewriter.
  1136.         CP      $22             ; but '@' is not - see below.
  1137.         JR      Z,L03B2         ; forward to to K-@-CHAR if so
  1138.  
  1139.         CP      $20             ; '_' is the other one that fails
  1140.         RET     NZ              ; return if not.
  1141.  
  1142.         LD      A,$5F           ; substitute ASCII '_'
  1143.         RET                     ; return.
  1144.  
  1145. ; ---
  1146.  
  1147. ;; K-@-CHAR
  1148. L03B2:  LD      A,$40           ; substitute ASCII '@'
  1149.         RET                     ; return.
  1150.  
  1151.  
  1152. ; ------------------------------------------------------------------------
  1153. ; The Spectrum Input character keys. One or two are abbreviated.
  1154. ; From $00 Flash 0 to $FF COPY. The routine above has decoded all these.
  1155.  
  1156. ;  | 00 Fl0| 01 Fl1| 02 Br0| 03 Br1| 04 In0| 05 In1| 06 CAP| 07 EDT|
  1157. ;  | 08 LFT| 09 RIG| 0A DWN| 0B UP | 0C DEL| 0D ENT| 0E SYM| 0F GRA|
  1158. ;  | 10 Ik0| 11 Ik1| 12 Ik2| 13 Ik3| 14 Ik4| 15 Ik5| 16 Ik6| 17 Ik7|
  1159. ;  | 18 Pa0| 19 Pa1| 1A Pa2| 1B Pa3| 1C Pa4| 1D Pa5| 1E Pa6| 1F Pa7|
  1160. ;  | 20 SP | 21  ! | 22  " | 23  # | 24  $ | 25  % | 26  & | 27  ' |
  1161. ;  | 28  ( | 29  ) | 2A  * | 2B  + | 2C  , | 2D  - | 2E  . | 2F  / |
  1162. ;  | 30  0 | 31  1 | 32  2 | 33  3 | 34  4 | 35  5 | 36  6 | 37  7 |
  1163. ;  | 38  8 | 39  9 | 3A  : | 3B  ; | 3C  < | 3D  = | 3E  > | 3F  ? |
  1164. ;  | 40  @ | 41  A | 42  B | 43  C | 44  D | 45  E | 46  F | 47  G |
  1165. ;  | 48  H | 49  I | 4A  J | 4B  K | 4C  L | 4D  M | 4E  N | 4F  O |
  1166. ;  | 50  P | 51  Q | 52  R | 53  S | 54  T | 55  U | 56  V | 57  W |
  1167. ;  | 58  X | 59  Y | 5A  Z | 5B  [ | 5C  \ | 5D  ] | 5E  ^ | 5F  _ |
  1168. ;  | 60 ukp| 61  a | 62  b | 63  c | 64  d | 65  e | 66  f | 67  g |
  1169. ;  | 68  h | 69  i | 6A  j | 6B  k | 6C  l | 6D  m | 6E  n | 6F  o |
  1170. ;  | 70  p | 71  q | 72  r | 73  s | 74  t | 75  u | 76  v | 77  w |
  1171. ;  | 78  x | 79  y | 7A  z | 7B  { | 7C  | | 7D  } | 7E  ~ | 7F (c)|
  1172. ;  | 80 128| 81 129| 82 130| 83 131| 84 132| 85 133| 86 134| 87 135|
  1173. ;  | 88 136| 89 137| 8A 138| 8B 139| 8C 140| 8D 141| 8E 142| 8F 143|
  1174. ;  | 90 [A]| 91 [B]| 92 [C]| 93 [D]| 94 [E]| 95 [F]| 96 [G]| 97 [H]|
  1175. ;  | 98 [I]| 99 [J]| 9A [K]| 9B [L]| 9C [M]| 9D [N]| 9E [O]| 9F [P]|
  1176. ;  | A0 [Q]| A1 [R]| A2 [S]| A3 [T]| A4 [U]| A5 RND| A6 IK$| A7 PI |
  1177. ;  | A8 FN | A9 PNT| AA SC$| AB ATT| AC AT | AD TAB| AE VL$| AF COD|
  1178. ;  | B0 VAL| B1 LEN| B2 SIN| B3 COS| B4 TAN| B5 ASN| B6 ACS| B7 ATN|
  1179. ;  | B8 LN | B9 EXP| BA INT| BB SQR| BC SGN| BD ABS| BE PEK| BF IN |
  1180. ;  | C0 USR| C1 ST$| C2 CH$| C3 NOT| C4 BIN| C5 OR | C6 AND| C7 <= |
  1181. ;  | C8 >= | C9 <> | CA LIN| CB THN| CC TO | CD STP| CE DEF| CF CAT|
  1182. ;  | D0 FMT| D1 MOV| D2 ERS| D3 OPN| D4 CLO| D5 MRG| D6 VFY| D7 BEP|
  1183. ;  | D8 CIR| D9 INK| DA PAP| DB FLA| DC BRI| DD INV| DE OVR| DF OUT|
  1184. ;  | E0 LPR| E1 LLI| E2 STP| E3 REA| E4 DAT| E5 RES| E6 NEW| E7 BDR|
  1185. ;  | E8 CON| E9 DIM| EA REM| EB FOR| EC GTO| ED GSB| EE INP| EF LOA|
  1186. ;  | F0 LIS| F1 LET| F2 PAU| F3 NXT| F4 POK| F5 PRI| F6 PLO| F7 RUN|
  1187. ;  | F8 SAV| F9 RAN| FA IF | FB CLS| FC DRW| FD CLR| FE RET| FF CPY|
  1188.  
  1189. ; Note that for simplicity, Sinclair have located all the control codes
  1190. ; below the space character.
  1191. ; ASCII DEL, $7F, has been made a copyright symbol.
  1192. ; Also $60, '`', not used in BASIC but used in other languages, has been
  1193. ; allocated the local currency symbol for the relevant country -
  1194. ; ukp in most Spectrums.
  1195.  
  1196. ; ------------------------------------------------------------------------
  1197.  
  1198. ;**********************************
  1199. ;** Part 3. LOUDSPEAKER ROUTINES **
  1200. ;**********************************
  1201.  
  1202.  
  1203. ; Documented by Alvin Albrecht.
  1204.  
  1205.  
  1206. ; ------------------------------
  1207. ; Routine to control loudspeaker
  1208. ; ------------------------------
  1209. ; Outputs a square wave of given duration and frequency
  1210. ; to the loudspeaker.
  1211. ;   Enter with: DE = #cycles - 1
  1212. ;               HL = tone period as described next
  1213. ;
  1214. ; The tone period is measured in T states and consists of
  1215. ; three parts: a coarse part (H register), a medium part
  1216. ; (bits 7..2 of L) and a fine part (bits 1..0 of L) which
  1217. ; contribute to the waveform timing as follows:
  1218. ;
  1219. ;                          coarse    medium       fine
  1220. ; duration of low  = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3)
  1221. ; duration of hi   = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3)
  1222. ; Tp = tone period = 236 + 2048*H + 32*(L>>2) + 8*(L&0x3)
  1223. ;                  = 236 + 2048*H + 8*L = 236 + 8*HL
  1224. ;
  1225. ; As an example, to output five seconds of middle C (261.624 Hz):
  1226. ;   (a) Tone period = 1/261.624 = 3.822ms
  1227. ;   (b) Tone period in T-States = 3.822ms*fCPU = 13378
  1228. ;         where fCPU = clock frequency of the CPU = 3.5MHz
  1229. ;   (c) Find H and L for desired tone period:
  1230. ;         HL = (Tp - 236) / 8 = (13378 - 236) / 8 = 1643 = 0x066B
  1231. ;   (d) Tone duration in cycles = 5s/3.822ms = 1308 cycles
  1232. ;         DE = 1308 - 1 = 0x051B
  1233. ;
  1234. ; The resulting waveform has a duty ratio of exactly 50%.
  1235. ;
  1236. ;
  1237. ;; BEEPER
  1238. L03B5:  DI                      ; Disable Interrupts so they don't disturb timing
  1239.         LD      A,L             ;
  1240.         SRL     L               ;
  1241.         SRL     L               ; L = medium part of tone period
  1242.         CPL                     ;
  1243.         AND     $03             ; A = 3 - fine part of tone period
  1244.         LD      C,A             ;
  1245.         LD      B,$00           ;
  1246.         LD      IX,L03D1        ; Address: BE-IX+3
  1247.         ADD     IX,BC           ;   IX holds address of entry into the loop
  1248.                                 ;   the loop will contain 0-3 NOPs, implementing
  1249.                                 ;   the fine part of the tone period.
  1250.         LD      A,($5C48)       ; BORDCR
  1251.         AND     $38             ; bits 5..3 contain border colour
  1252.         RRCA                    ; border colour bits moved to 2..0
  1253.         RRCA                    ;   to match border bits on port #FE
  1254.         RRCA                    ;
  1255.         OR       $08            ; bit 3 set (tape output bit on port #FE)
  1256.                                 ;   for loud sound output
  1257. ;; BE-IX+3
  1258. L03D1:  NOP              ;(4)   ; optionally executed NOPs for small
  1259.                                 ;   adjustments to tone period
  1260. ;; BE-IX+2
  1261. L03D2:  NOP              ;(4)   ;
  1262.  
  1263. ;; BE-IX+1
  1264. L03D3:  NOP              ;(4)   ;
  1265.  
  1266. ;; BE-IX+0
  1267. L03D4:  INC     B        ;(4)   ;
  1268.         INC     C        ;(4)   ;
  1269.  
  1270. ;; BE-H&L-LP
  1271. L03D6:  DEC     C        ;(4)   ; timing loop for duration of
  1272.         JR      NZ,L03D6 ;(12/7);   high or low pulse of waveform
  1273.  
  1274.         LD      C,$3F    ;(7)   ;
  1275.         DEC     B        ;(4)   ;
  1276.         JP      NZ,L03D6 ;(10)  ; to BE-H&L-LP
  1277.  
  1278.         XOR     $10      ;(7)   ; toggle output beep bit
  1279.         OUT     ($FE),A  ;(11)  ; output pulse
  1280.         LD      B,H      ;(4)   ; B = coarse part of tone period
  1281.         LD      C,A      ;(4)   ; save port #FE output byte
  1282.         BIT     4,A      ;(8)   ; if new output bit is high, go
  1283.         JR      NZ,L03F2 ;(12/7);   to BE-AGAIN
  1284.  
  1285.         LD      A,D      ;(4)   ; one cycle of waveform has completed
  1286.         OR      E        ;(4)   ;   (low->low). if cycle countdown = 0
  1287.         JR      Z,L03F6  ;(12/7);   go to BE-END
  1288.  
  1289.         LD      A,C      ;(4)   ; restore output byte for port #FE
  1290.         LD      C,L      ;(4)   ; C = medium part of tone period
  1291.         DEC     DE       ;(6)   ; decrement cycle count
  1292.         JP      (IX)     ;(8)   ; do another cycle
  1293.  
  1294. ;; BE-AGAIN                     ; halfway through cycle
  1295. L03F2:  LD      C,L      ;(4)   ; C = medium part of tone period
  1296.         INC     C        ;(4)   ; adds 16 cycles to make duration of high = duration of low
  1297.         JP      (IX)     ;(8)   ; do high pulse of tone
  1298.  
  1299. ;; BE-END
  1300. L03F6:  EI                      ; Enable Interrupts
  1301.         RET                     ;
  1302.  
  1303.  
  1304. ; -------------------
  1305. ; Handle BEEP command
  1306. ; -------------------
  1307. ; BASIC interface to BEEPER subroutine.
  1308. ; Invoked in BASIC with:
  1309. ;   BEEP dur, pitch
  1310. ;   where dur   = duration in seconds
  1311. ;         pitch = # of semitones above/below middle C
  1312. ;
  1313. ; Enter with: pitch on top of calculator stack
  1314. ;             duration next on calculator stack
  1315. ;
  1316. ;; beep
  1317. L03F8:  RST     28H             ;; FP-CALC
  1318.         DB    $31             ;;duplicate                  ; duplicate pitch
  1319.         DB    $27             ;;int                        ; convert to integer
  1320.         DB    $C0             ;;st-mem-0                   ; store integer pitch to memory 0
  1321.         DB    $03             ;;subtract                   ; calculate fractional part of pitch = fp_pitch - int_pitch
  1322.         DB    $34             ;;stk-data                   ; push constant
  1323.         DB    $EC             ;;Exponent: $7C, Bytes: 4    ; constant = 0.05762265
  1324.         DB    $6C,$98,$1F,$F5 ;;($6C,$98,$1F,$F5)
  1325.         DB    $04             ;;multiply                   ; compute:
  1326.         DB    $A1             ;;stk-one                    ; 1 + 0.05762265 * fraction_part(pitch)
  1327.         DB    $0F             ;;addition
  1328.         DB    $38             ;;end-calc                   ; leave on calc stack
  1329.  
  1330.         LD      HL,$5C92        ; MEM-0: number stored here is in 16 bit integer format (pitch)
  1331.                                 ;   0, 0/FF (pos/neg), LSB, MSB, 0
  1332.                                 ;   LSB/MSB is stored in two's complement
  1333.                                 ; In the following, the pitch is checked if it is in the range -128<=p<=127
  1334.         LD      A,(HL)          ; First byte must be zero, otherwise
  1335.         AND     A               ;   error in integer conversion
  1336.         JR      NZ,L046C        ; to REPORT-B
  1337.  
  1338.         INC     HL              ;
  1339.         LD      C,(HL)          ; C = pos/neg flag = 0/FF
  1340.         INC     HL              ;
  1341.         LD      B,(HL)          ; B = LSB, two's complement
  1342.         LD      A,B             ;
  1343.         RLA                     ;
  1344.         SBC     A,A             ; A = 0/FF if B is pos/neg
  1345.         CP      C               ; must be the same as C if the pitch is -128<=p<=127
  1346.         JR      NZ,L046C        ; if no, error REPORT-B
  1347.  
  1348.         INC     HL              ; if -128<=p<=127, MSB will be 0/FF if B is pos/neg
  1349.         CP      (HL)            ; verify this
  1350.         JR      NZ,L046C        ; if no, error REPORT-B
  1351.                                 ; now we know -128<=p<=127
  1352.         LD      A,B             ; A = pitch + 60
  1353.         ADD     A,$3C           ; if -60<=pitch<=67,
  1354.         JP      P,L0425         ;   goto BE-i-OK
  1355.  
  1356.         JP      PO,L046C        ; if pitch <= 67 goto REPORT-B
  1357.                                 ;   lower bound of pitch set at -60
  1358.  
  1359. ;; BE-I-OK                      ; here, -60<=pitch<=127
  1360.                                 ; and A=pitch+60 -> 0<=A<=187
  1361.  
  1362. L0425:  LD      B,$FA           ; 6 octaves below middle C
  1363.  
  1364. ;; BE-OCTAVE                    ; A=# semitones above 5 octaves below middle C
  1365. L0427:  INC     B               ; increment octave
  1366.         SUB     $0C             ; 12 semitones = one octave
  1367.         JR      NC,L0427        ; to BE-OCTAVE
  1368.  
  1369.         ADD     A,$0C           ; A = # semitones above C (0-11)
  1370.         PUSH    BC              ; B = octave displacement from middle C, 2's complement: -5<=B<=10
  1371.         LD      HL,L046E        ; Address: semi-tone
  1372.         CALL    L3406           ; routine LOC-MEM
  1373.                                 ;   HL = 5*A + $046E
  1374.         CALL    L33B4           ; routine STACK-NUM
  1375.                                 ;   read FP value (freq) from semitone table (HL) and push onto calc stack
  1376.  
  1377.         RST     28H             ;; FP-CALC
  1378.         DB    $04             ;;multiply   mult freq by 1 + 0.0576 * fraction_part(pitch) stacked earlier
  1379.                                 ;;             thus taking into account fractional part of pitch.
  1380.                                 ;;           the number 0.0576*frequency is the distance in Hz to the next
  1381.                                 ;;             note (verify with the frequencies recorded in the semitone
  1382.                                 ;;             table below) so that the fraction_part of the pitch does
  1383.                                 ;;             indeed represent a fractional distance to the next note.
  1384.         DB    $38             ;;end-calc   HL points to first byte of fp num on stack = middle frequency to generate
  1385.  
  1386.         POP     AF              ; A = octave displacement from middle C, 2's complement: -5<=A<=10
  1387.         ADD     A,(HL)          ; increase exponent by A (equivalent to multiplying by 2^A)
  1388.         LD      (HL),A          ;
  1389.  
  1390.         RST     28H             ;; FP-CALC
  1391.         DB    $C0             ;;st-mem-0          ; store frequency in memory 0
  1392.         DB    $02             ;;delete            ; remove from calc stack
  1393.         DB    $31             ;;duplicate         ; duplicate duration (seconds)
  1394.         DB    $38             ;;end-calc
  1395.  
  1396.         CALL    L1E94           ; routine FIND-INT1 ; FP duration to A
  1397.         CP      $0B             ; if dur > 10 seconds,
  1398.         JR      NC,L046C        ;   goto REPORT-B
  1399.  
  1400.         ;;; The following calculation finds the tone period for HL and the cycle count
  1401.         ;;; for DE expected in the BEEPER subroutine.  From the example in the BEEPER comments,
  1402.         ;;;
  1403.         ;;; HL = ((fCPU / f) - 236) / 8 = fCPU/8/f - 236/8 = 437500/f -29.5
  1404.         ;;; DE = duration * frequency - 1
  1405.         ;;;
  1406.         ;;; Note the different constant (30.125) used in the calculation of HL
  1407.         ;;; below.  This is probably an error.
  1408.  
  1409.         RST     28H             ;; FP-CALC
  1410.         DB    $E0             ;;get-mem-0                 ; push frequency
  1411.         DB    $04             ;;multiply                  ; result1: #cycles = duration * frequency
  1412.         DB    $E0             ;;get-mem-0                 ; push frequency
  1413.         DB    $34             ;;stk-data                  ; push constant
  1414.         DB    $80             ;;Exponent $93, Bytes: 3    ; constant = 437500
  1415.         DB    $43,$55,$9F,$80 ;;($55,$9F,$80,$00)
  1416.         DB    $01             ;;exchange                  ; frequency on top
  1417.         DB    $05             ;;division                  ; 437500 / frequency
  1418.         DB    $34             ;;stk-data                  ; push constant
  1419.         DB    $35             ;;Exponent: $85, Bytes: 1   ; constant = 30.125
  1420.         DB    $71             ;;($71,$00,$00,$00)
  1421.         DB    $03             ;;subtract                  ; result2: tone_period(HL) = 437500 / freq - 30.125
  1422.         DB    $38             ;;end-calc
  1423.  
  1424.         CALL    L1E99           ; routine FIND-INT2
  1425.         PUSH    BC              ;   BC = tone_period(HL)
  1426.         CALL    L1E99           ; routine FIND-INT2, BC = #cycles to generate
  1427.         POP     HL              ; HL = tone period
  1428.         LD      D,B             ;
  1429.         LD      E,C             ; DE = #cycles
  1430.         LD      A,D             ;
  1431.         OR      E               ;
  1432.         RET     Z               ; if duration = 0, skip BEEP and avoid 65536 cycle
  1433.                                 ;   boondoggle that would occur next
  1434.         DEC     DE              ; DE = #cycles - 1
  1435.         JP      L03B5           ; to BEEPER
  1436.  
  1437. ; ---
  1438.  
  1439.  
  1440. ;; REPORT-B
  1441. L046C:  RST     08H             ; ERROR-1
  1442.         DB    $0A             ; Error Report: Integer out of range
  1443.  
  1444.  
  1445.  
  1446. ; ---------------
  1447. ; Semi-tone table
  1448. ; ---------------
  1449. ;
  1450. ; Holds frequencies corresponding to semitones in middle octave.
  1451. ; To move n octaves higher or lower, frequencies are multiplied by 2^n.
  1452.  
  1453. ;; semi-tone         five byte fp         decimal freq     note (middle)
  1454. L046E:  DB    $89, $02, $D0, $12, $86;  261.625565290         C
  1455.         DB    $89, $0A, $97, $60, $75;  277.182631135         C#
  1456.         DB    $89, $12, $D5, $17, $1F;  293.664768100         D
  1457.         DB    $89, $1B, $90, $41, $02;  311.126983881         D#
  1458.         DB    $89, $24, $D0, $53, $CA;  329.627557039         E
  1459.         DB    $89, $2E, $9D, $36, $B1;  349.228231549         F
  1460.         DB    $89, $38, $FF, $49, $3E;  369.994422674         F#
  1461.         DB    $89, $43, $FF, $6A, $73;  391.995436072         G
  1462.         DB    $89, $4F, $A7, $00, $54;  415.304697513         G#
  1463.         DB    $89, $5C, $00, $00, $00;  440.000000000         A
  1464.         DB    $89, $69, $14, $F6, $24;  466.163761616         A#
  1465.         DB    $89, $76, $F1, $10, $05;  493.883301378         B
  1466.  
  1467.  
  1468. ;****************************************
  1469. ;** Part 4. CASSETTE HANDLING ROUTINES **
  1470. ;****************************************
  1471.  
  1472. ; These routines begin with the service routines followed by a single
  1473. ; command entry point.
  1474. ; The first of these service routines is a curiosity.
  1475.  
  1476. ; -----------------------
  1477. ; THE 'ZX81 NAME' ROUTINE
  1478. ; -----------------------
  1479. ;   This routine fetches a filename in ZX81 format and is not used by the
  1480. ;   cassette handling routines in this ROM.
  1481.  
  1482. ;; zx81-name
  1483. L04AA:  CALL    L24FB           ; routine SCANNING to evaluate expression.
  1484.         LD      A,($5C3B)       ; fetch system variable FLAGS.
  1485.         ADD     A,A             ; test bit 7 - syntax, bit 6 - result type.
  1486.         JP      M,L1C8A         ; to REPORT-C if not string result
  1487.                                 ; 'Nonsense in BASIC'.
  1488.  
  1489.         POP     HL              ; drop return address.
  1490.         RET     NC              ; return early if checking syntax.
  1491.  
  1492.         PUSH    HL              ; re-save return address.
  1493.         CALL    L2BF1           ; routine STK-FETCH fetches string parameters.
  1494.         LD      H,D             ; transfer start of filename
  1495.         LD      L,E             ; to the HL register.
  1496.         DEC     C               ; adjust to point to last character and
  1497.         RET     M               ; return if the null string.
  1498.                                 ; or multiple of 256!
  1499.  
  1500.         ADD     HL,BC           ; find last character of the filename.
  1501.                                 ; and also clear carry.
  1502.         SET     7,(HL)          ; invert it.
  1503.         RET                     ; return.
  1504.  
  1505. ; =========================================
  1506. ;
  1507. ; PORT 254 ($FE)
  1508. ;
  1509. ;                      spk mic { border  }  
  1510. ;          ___ ___ ___ ___ ___ ___ ___ ___
  1511. ; PORT    |   |   |   |   |   |   |   |   |
  1512. ; 254     |   |   |   |   |   |   |   |   |
  1513. ; $FE     |___|___|___|___|___|___|___|___|
  1514. ;           7   6   5   4   3   2   1   0
  1515. ;
  1516.  
  1517. ; ----------------------------------
  1518. ; Save header and program/data bytes
  1519. ; ----------------------------------
  1520. ; This routine saves a section of data. It is called from SA-CTRL to save the
  1521. ; seventeen bytes of header data. It is also the exit route from that routine
  1522. ; when it is set up to save the actual data.
  1523. ; On entry -
  1524. ; HL points to start of data.
  1525. ; IX points to descriptor.
  1526. ; The accumulator is set to  $00 for a header, $FF for data.
  1527.  
  1528. ;; SA-BYTES
  1529. L04C2:  LD      HL,L053F        ; address: SA/LD-RET
  1530.         PUSH    HL              ; is pushed as common exit route.
  1531.                                 ; however there is only one non-terminal exit
  1532.                                 ; point.
  1533.  
  1534.         LD      HL,$1F80        ; a timing constant H=$1F, L=$80
  1535.                                 ; inner and outer loop counters
  1536.                                 ; a five second lead-in is used for a header.
  1537.  
  1538.         BIT     7,A             ; test one bit of accumulator.
  1539.                                 ; (AND A ?)
  1540.         JR      Z,L04D0         ; skip to SA-FLAG if a header is being saved.
  1541.  
  1542. ; else is data bytes and a shorter lead-in is used.
  1543.  
  1544.         LD      HL,$0C98        ; another timing value H=$0C, L=$98.
  1545.                                 ; a two second lead-in is used for the data.
  1546.  
  1547.  
  1548. ;; SA-FLAG
  1549. L04D0:  EX      AF,AF'          ; save flag
  1550.        INC     DE              ; increase length by one.
  1551.        DEC     IX              ; decrease start.
  1552.  
  1553.        DI                      ; disable interrupts
  1554.  
  1555.        LD      A,$02           ; select red for border, microphone bit on.
  1556.        LD      B,A             ; also does as an initial slight counter value.
  1557.  
  1558. ;; SA-LEADER
  1559. L04D8:  DJNZ    L04D8           ; self loop to SA-LEADER for delay.
  1560.                                ; after initial loop, count is $A4 (or $A3)
  1561.  
  1562.        OUT     ($FE),A         ; output byte $02/$0D to tape port.
  1563.  
  1564.        XOR     $0F             ; switch from RED (mic on) to CYAN (mic off).
  1565.  
  1566.        LD      B,$A4           ; hold count. also timed instruction.
  1567.  
  1568.        DEC     L               ; originally $80 or $98.
  1569.                                ; but subsequently cycles 256 times.
  1570.        JR      NZ,L04D8        ; back to SA-LEADER until L is zero.
  1571.  
  1572. ; the outer loop is counted by H
  1573.  
  1574.        DEC     B               ; decrement count
  1575.        DEC     H               ; originally  twelve or thirty-one.
  1576.        JP      P,L04D8         ; back to SA-LEADER until H becomes $FF
  1577.  
  1578. ; now send a synch pulse. At this stage mic is off and A holds value
  1579. ; for mic on.
  1580. ; A synch pulse is much shorter than the steady pulses of the lead-in.
  1581.  
  1582.        LD      B,$2F           ; another short timed delay.
  1583.  
  1584. ;; SA-SYNC-1
  1585. L04EA:  DJNZ    L04EA           ; self loop to SA-SYNC-1
  1586.  
  1587.        OUT     ($FE),A         ; switch to mic on and red.
  1588.        LD      A,$0D           ; prepare mic off - cyan
  1589.        LD      B,$37           ; another short timed delay.
  1590.  
  1591. ;; SA-SYNC-2
  1592. L04F2:  DJNZ    L04F2           ; self loop to SA-SYNC-2
  1593.  
  1594.        OUT     ($FE),A         ; output mic off, cyan border.
  1595.        LD      BC,$3B0E        ; B=$3B time(*), C=$0E, YELLOW, MIC OFF.
  1596.  
  1597. ;
  1598.  
  1599.        EX      AF,AF'          ; restore saved flag
  1600.                                 ; which is 1st byte to be saved.
  1601.  
  1602.         LD      L,A             ; and transfer to L.
  1603.                                 ; the initial parity is A, $FF or $00.
  1604.         JP      L0507           ; JUMP forward to SA-START     ->
  1605.                                 ; the mid entry point of loop.
  1606.  
  1607. ; -------------------------
  1608. ; During the save loop a parity byte is maintained in H.
  1609. ; the save loop begins by testing if reduced length is zero and if so
  1610. ; the final parity byte is saved reducing count to $FFFF.
  1611.  
  1612. ;; SA-LOOP
  1613. L04FE:  LD      A,D             ; fetch high byte
  1614.         OR      E               ; test against low byte.
  1615.         JR      Z,L050E         ; forward to SA-PARITY if zero.
  1616.  
  1617.         LD      L,(IX+$00)      ; load currently addressed byte to L.
  1618.  
  1619. ;; SA-LOOP-P
  1620. L0505:  LD      A,H             ; fetch parity byte.
  1621.         XOR     L               ; exclusive or with new byte.
  1622.  
  1623. ; -> the mid entry point of loop.
  1624.  
  1625. ;; SA-START
  1626. L0507:  LD      H,A             ; put parity byte in H.
  1627.         LD      A,$01           ; prepare blue, mic=on.
  1628.         SCF                     ; set carry flag ready to rotate in.
  1629.         JP      L0525           ; JUMP forward to SA-8-BITS            -8->
  1630.  
  1631. ; ---
  1632.  
  1633. ;; SA-PARITY
  1634. L050E:  LD      L,H             ; transfer the running parity byte to L and
  1635.         JR      L0505           ; back to SA-LOOP-P
  1636.                                 ; to output that byte before quitting normally.
  1637.  
  1638. ; ---
  1639.  
  1640. ; entry point to save yellow part of bit.
  1641. ; a bit consists of a period with mic on and blue border followed by
  1642. ; a period of mic off with yellow border.
  1643. ; Note. since the DJNZ instruction does not affect flags, the zero flag is used
  1644. ; to indicate which of the two passes is in effect and the carry maintains the
  1645. ; state of the bit to be saved.
  1646.  
  1647. ;; SA-BIT-2
  1648. L0511:  LD      A,C             ; fetch 'mic on and yellow' which is
  1649.                                 ; held permanently in C.
  1650.         BIT     7,B             ; set the zero flag. B holds $3E.
  1651.  
  1652. ; entry point to save 1 entire bit. For first bit B holds $3B(*).
  1653. ; Carry is set if saved bit is 1. zero is reset NZ on entry.
  1654.  
  1655. ;; SA-BIT-1
  1656. L0514:  DJNZ    L0514           ; self loop for delay to SA-BIT-1
  1657.  
  1658.         JR      NC,L051C        ; forward to SA-OUT if bit is 0.
  1659.  
  1660. ; but if bit is 1 then the mic state is held for longer.
  1661.  
  1662.         LD      B,$42           ; set timed delay. (66 decimal)
  1663.  
  1664. ;; SA-SET
  1665. L051A:  DJNZ    L051A           ; self loop to SA-SET
  1666.                                 ; (roughly an extra 66*13 clock cycles)
  1667.  
  1668. ;; SA-OUT
  1669. L051C:  OUT     ($FE),A         ; blue and mic on OR  yellow and mic off.
  1670.  
  1671.         LD      B,$3E           ; set up delay
  1672.         JR      NZ,L0511        ; back to SA-BIT-2 if zero reset NZ (first pass)
  1673.  
  1674. ; proceed when the blue and yellow bands have been output.
  1675.  
  1676.         DEC     B               ; change value $3E to $3D.
  1677.         XOR     A               ; clear carry flag (ready to rotate in).
  1678.         INC     A               ; reset zero flag ie. NZ.
  1679.  
  1680. ; -8->
  1681.  
  1682. ;; SA-8-BITS
  1683. L0525:  RL      L               ; rotate left through carry
  1684.                                 ; C<76543210<C  
  1685.         JP      NZ,L0514        ; JUMP back to SA-BIT-1
  1686.                                 ; until all 8 bits done.
  1687.  
  1688. ; when the initial set carry is passed out again then a byte is complete.
  1689.  
  1690.         DEC     DE              ; decrease length
  1691.         INC     IX              ; increase byte pointer
  1692.         LD      B,$31           ; set up timing.
  1693.  
  1694.         LD      A,$7F           ; test the space key and
  1695.         IN      A,($FE)         ; return to common exit (to restore border)
  1696.         RRA                     ; if a space is pressed
  1697.         RET     NC              ; return to SA/LD-RET.   - - >
  1698.  
  1699. ; now test if byte counter has reached $FFFF.
  1700.  
  1701.         LD      A,D             ; fetch high byte
  1702.         INC     A               ; increment.
  1703.         JP      NZ,L04FE        ; JUMP to SA-LOOP if more bytes.
  1704.  
  1705.         LD      B,$3B           ; a final delay.
  1706.  
  1707. ;; SA-DELAY
  1708. L053C:  DJNZ    L053C           ; self loop to SA-DELAY
  1709.  
  1710.         RET                     ; return - - >
  1711.  
  1712. ; --------------------------------------------------
  1713. ; Reset border and check BREAK key for LOAD and SAVE
  1714. ; --------------------------------------------------
  1715. ; the address of this routine is pushed on the stack prior to any load/save
  1716. ; operation and it handles normal completion with the restoration of the
  1717. ; border and also abnormal termination when the break key, or to be more
  1718. ; precise the space key is pressed during a tape operation.
  1719. ; - - >
  1720.  
  1721. ;; SA/LD-RET
  1722. L053F:  PUSH    AF              ; preserve accumulator throughout.
  1723.         LD      A,($5C48)       ; fetch border colour from BORDCR.
  1724.         AND     $38             ; mask off paper bits.
  1725.         RRCA                    ; rotate
  1726.         RRCA                    ; to the
  1727.         RRCA                    ; range 0-7.
  1728.  
  1729. ;===============================
  1730. ;               IF TAP_EMUL
  1731. ;               DB 0,0
  1732. ;               ELSE
  1733.                 OUT ($FE),A     ; change the border colour.
  1734. ;               ENDIF
  1735. ;===============================
  1736.  
  1737.         LD      A,$7F           ; read from port address $7FFE the
  1738.         IN      A,($FE)         ; row with the space key at outside.
  1739.  
  1740.         RRA                     ; test for space key pressed.
  1741.         EI                      ; enable interrupts
  1742.         JR      C,L0554         ; forward to SA/LD-END if not
  1743.  
  1744.  
  1745. ;; REPORT-Da
  1746. L0552:  RST     08H             ; ERROR-1
  1747.         DB    $0C             ; Error Report: BREAK - CONT repeats
  1748.  
  1749. ; ---
  1750.  
  1751. ;; SA/LD-END
  1752. L0554:  POP     AF              ; restore the accumulator.
  1753.         RET                     ; return.
  1754.  
  1755. ; ------------------------------------
  1756. ; Load header or block of information
  1757. ; ------------------------------------
  1758. ; This routine is used to load bytes and on entry A is set to $00 for a
  1759. ; header or to $FF for data.  IX points to the start of receiving location
  1760. ; and DE holds the length of bytes to be loaded. If, on entry the carry flag
  1761. ; is set then data is loaded, if reset then it is verified.
  1762.  
  1763. ;; LD-BYTES
  1764. L0556:  INC     D               ; reset the zero flag without disturbing carry.
  1765.         EX      AF,AF'          ; preserve entry flags.
  1766.        DEC     D               ; restore high byte of length.
  1767.  
  1768.        DI                      ; disable interrupts
  1769.  
  1770.        LD      A,$0F           ; make the border white and mic off.
  1771.  
  1772. ;===============================
  1773. ;               IF TAP_EMUL
  1774. ;               DB 0,0
  1775. ;               ELSE
  1776.                 OUT ($FE),A     ; output to port.
  1777. ;               ENDIF
  1778. ;===============================
  1779.  
  1780.        LD      HL,L053F        ; Address: SA/LD-RET
  1781.        PUSH    HL              ; is saved on stack as terminating routine.
  1782.  
  1783. ; the reading of the EAR bit (D6) will always be preceded by a test of the
  1784. ; space key (D0), so store the initial post-test state.
  1785.  
  1786.        IN      A,($FE)         ; read the ear state - bit 6.
  1787.        RRA                     ; rotate to bit 5.
  1788.        AND     $20             ; isolate this bit.
  1789.        OR      $02             ; combine with red border colour.
  1790.  
  1791. ;===============================
  1792.                 IF TAP_EMUL
  1793.                 RST 0X08
  1794.                 DB TAPE_EMUL
  1795.                 ELSE
  1796.                 LD C,A          ; and store initial state long-term in C.
  1797.                 CP A            ; set the zero flag.
  1798.                 ENDIF
  1799. ;===============================
  1800.  
  1801. ;; LD-BREAK
  1802. L056B:  RET     NZ              ; return if at any time space is pressed.
  1803.  
  1804. ;; LD-START
  1805. L056C:  CALL    L05E7           ; routine LD-EDGE-1
  1806.        JR      NC,L056B        ; back to LD-BREAK with time out and no
  1807.                                ; edge present on tape.
  1808.  
  1809. ; but continue when a transition is found on tape.
  1810.  
  1811.        LD      HL,$0415        ; set up 16-bit outer loop counter for
  1812.                                ; approx 1 second delay.
  1813.  
  1814. ;; LD-WAIT
  1815. L0574:  DJNZ    L0574           ; self loop to LD-WAIT (for 256 times)
  1816.  
  1817.        DEC     HL              ; decrease outer loop counter.
  1818.        LD      A,H             ; test for
  1819.        OR      L               ; zero.
  1820.        JR      NZ,L0574        ; back to LD-WAIT, if not zero, with zero in B.
  1821.  
  1822. ; continue after delay with H holding zero and B also.
  1823. ; sample 256 edges to check that we are in the middle of a lead-in section.
  1824.  
  1825.        CALL    L05E3           ; routine LD-EDGE-2
  1826.        JR      NC,L056B        ; back to LD-BREAK
  1827.                                ; if no edges at all.
  1828.  
  1829. ;; LD-LEADER
  1830. L0580:  LD      B,$9C           ; set timing value.
  1831.        CALL    L05E3           ; routine LD-EDGE-2
  1832.        JR      NC,L056B        ; back to LD-BREAK if time-out
  1833.  
  1834.        LD      A,$C6           ; two edges must be spaced apart.
  1835.        CP      B               ; compare
  1836.        JR      NC,L056C        ; back to LD-START if too close together for a
  1837.                                ; lead-in.
  1838.  
  1839.        INC     H               ; proceed to test 256 edged sample.
  1840.        JR      NZ,L0580        ; back to LD-LEADER while more to do.
  1841.  
  1842. ; sample indicates we are in the middle of a two or five second lead-in.
  1843. ; Now test every edge looking for the terminal synch signal.
  1844.  
  1845. ;; LD-SYNC
  1846. L058F:  LD      B,$C9           ; initial timing value in B.
  1847.        CALL    L05E7           ; routine LD-EDGE-1
  1848.        JR      NC,L056B        ; back to LD-BREAK with time-out.
  1849.  
  1850.        LD      A,B             ; fetch augmented timing value from B.
  1851.        CP      $D4             ; compare
  1852.        JR      NC,L058F        ; back to LD-SYNC if gap too big, that is,
  1853.                                ; a normal lead-in edge gap.
  1854.  
  1855. ; but a short gap will be the synch pulse.
  1856. ; in which case another edge should appear before B rises to $FF
  1857.  
  1858.        CALL    L05E7           ; routine LD-EDGE-1
  1859.        RET     NC              ; return with time-out.
  1860.  
  1861. ; proceed when the synch at the end of the lead-in is found.
  1862. ; We are about to load data so change the border colours.
  1863.  
  1864.        LD      A,C             ; fetch long-term mask from C
  1865.        XOR     $03             ; and make blue/yellow.
  1866.  
  1867.        LD      C,A             ; store the new long-term byte.
  1868.  
  1869.        LD      H,$00           ; set up parity byte as zero.
  1870.        LD      B,$B0           ; timing.
  1871.        JR      L05C8           ; forward to LD-MARKER
  1872.                                ; the loop mid entry point with the alternate
  1873.                                ; zero flag reset to indicate first byte
  1874.                                ; is discarded.
  1875.  
  1876. ; --------------
  1877. ; the loading loop loads each byte and is entered at the mid point.
  1878.  
  1879. ;; LD-LOOP
  1880. L05A9:  EX      AF,AF'          ; restore entry flags and type in A.
  1881.         JR      NZ,L05B3        ; forward to LD-FLAG if awaiting initial flag
  1882.                                 ; which is to be discarded.
  1883.  
  1884.         JR      NC,L05BD        ; forward to LD-VERIFY if not to be loaded.
  1885.  
  1886.         LD      (IX+$00),L      ; place loaded byte at memory location.
  1887.         JR      L05C2           ; forward to LD-NEXT
  1888.  
  1889. ; ---
  1890.  
  1891. ;; LD-FLAG
  1892. L05B3:  RL      C               ; preserve carry (verify) flag in long-term
  1893.                                 ; state byte. Bit 7 can be lost.
  1894.  
  1895.         XOR     L               ; compare type in A with first byte in L.
  1896.         RET     NZ              ; return if no match e.g. CODE vs DATA.
  1897.  
  1898. ; continue when data type matches.
  1899.  
  1900.         LD      A,C             ; fetch byte with stored carry
  1901.         RRA                     ; rotate it to carry flag again
  1902.         LD      C,A             ; restore long-term port state.
  1903.  
  1904.         INC     DE              ; increment length ??
  1905.         JR      L05C4           ; forward to LD-DEC.
  1906.                                 ; but why not to location after ?
  1907.  
  1908. ; ---
  1909. ; for verification the byte read from tape is compared with that in memory.
  1910.  
  1911. ;; LD-VERIFY
  1912. L05BD:  LD      A,(IX+$00)      ; fetch byte from memory.
  1913.         XOR     L               ; compare with that on tape
  1914.         RET     NZ              ; return if not zero.
  1915.  
  1916. ;; LD-NEXT
  1917. L05C2:  INC     IX              ; increment byte pointer.
  1918.  
  1919. ;; LD-DEC
  1920. L05C4:  DEC     DE              ; decrement length.
  1921.         EX      AF,AF'          ; store the flags.
  1922.        LD      B,$B2           ; timing.
  1923.  
  1924. ; when starting to read 8 bits the receiving byte is marked with bit at right.
  1925. ; when this is rotated out again then 8 bits have been read.
  1926.  
  1927. ;; LD-MARKER
  1928. L05C8:  LD      L,$01           ; initialize as %00000001
  1929.  
  1930. ;; LD-8-BITS
  1931. L05CA:  CALL    L05E3           ; routine LD-EDGE-2 increments B relative to
  1932.                                ; gap between 2 edges.
  1933.        RET     NC              ; return with time-out.
  1934.  
  1935.        LD      A,$CB           ; the comparison byte.
  1936.        CP      B               ; compare to incremented value of B.
  1937.                                ; if B is higher then bit on tape was set.
  1938.                                ; if <= then bit on tape is reset.
  1939.  
  1940.        RL      L               ; rotate the carry bit into L.
  1941.  
  1942.        LD      B,$B0           ; reset the B timer byte.
  1943.        JP      NC,L05CA        ; JUMP back to LD-8-BITS
  1944.  
  1945. ; when carry set then marker bit has been passed out and byte is complete.
  1946.  
  1947.        LD      A,H             ; fetch the running parity byte.
  1948.        XOR     L               ; include the new byte.
  1949.        LD      H,A             ; and store back in parity register.
  1950.  
  1951.        LD      A,D             ; check length of
  1952.        OR      E               ; expected bytes.
  1953.        JR      NZ,L05A9        ; back to LD-LOOP
  1954.                                ; while there are more.
  1955.  
  1956. ; when all bytes loaded then parity byte should be zero.
  1957.  
  1958.        LD      A,H             ; fetch parity byte.
  1959.        CP      $01             ; set carry if zero.
  1960.        RET                     ; return
  1961.                                ; in no carry then error as checksum disagrees.
  1962.  
  1963. ; -------------------------
  1964. ; Check signal being loaded
  1965. ; -------------------------
  1966. ; An edge is a transition from one mic state to another.
  1967. ; More specifically a change in bit 6 of value input from port $FE.
  1968. ; Graphically it is a change of border colour, say, blue to yellow.
  1969. ; The first entry point looks for two adjacent edges. The second entry point
  1970. ; is used to find a single edge.
  1971. ; The B register holds a count, up to 256, within which the edge (or edges)
  1972. ; must be found. The gap between two edges will be more for a '1' than a '0'
  1973. ; so the value of B denotes the state of the bit (two edges) read from tape.
  1974.  
  1975. ; ->
  1976.  
  1977. ;; LD-EDGE-2
  1978. L05E3:  CALL    L05E7           ; call routine LD-EDGE-1 below.
  1979.        RET     NC              ; return if space pressed or time-out.
  1980.                                ; else continue and look for another adjacent
  1981.                                ; edge which together represent a bit on the
  1982.                                ; tape.
  1983.  
  1984. ; ->
  1985. ; this entry point is used to find a single edge from above but also
  1986. ; when detecting a read-in signal on the tape.
  1987.  
  1988. ;; LD-EDGE-1
  1989. L05E7:  LD      A,$16           ; a delay value of twenty two.
  1990.  
  1991. ;; LD-DELAY
  1992. L05E9:  DEC     A               ; decrement counter
  1993.        JR      NZ,L05E9        ; loop back to LD-DELAY 22 times.
  1994.  
  1995.        AND      A              ; clear carry.
  1996.  
  1997. ;; LD-SAMPLE
  1998. L05ED:  INC     B               ; increment the time-out counter.
  1999.        RET     Z               ; return with failure when $FF passed.
  2000.  
  2001.        LD      A,$7F           ; prepare to read keyboard and EAR port
  2002.        IN      A,($FE)         ; row $7FFE. bit 6 is EAR, bit 0 is SPACE key.
  2003.        RRA                     ; test outer key the space. (bit 6 moves to 5)
  2004.        RET     NC              ; return if space pressed.  >>>
  2005.  
  2006.        XOR     C               ; compare with initial long-term state.
  2007.        AND     $20             ; isolate bit 5
  2008.        JR      Z,L05ED         ; back to LD-SAMPLE if no edge.
  2009.  
  2010. ; but an edge, a transition of the EAR bit, has been found so switch the
  2011. ; long-term comparison byte containing both border colour and EAR bit.
  2012.  
  2013.        LD      A,C             ; fetch comparison value.
  2014.        CPL                     ; switch the bits
  2015.        LD      C,A             ; and put back in C for long-term.
  2016.  
  2017.        AND     $07             ; isolate new colour bits.
  2018.        OR      $08             ; set bit 3 - MIC off.
  2019.        OUT     ($FE),A         ; send to port to effect change of colour.
  2020.  
  2021.        SCF                     ; set carry flag signaling edge found within
  2022.                                ; time allowed.
  2023.        RET                     ; return.
  2024.  
  2025. ; ---------------------------------
  2026. ; Entry point for all tape commands
  2027. ; ---------------------------------
  2028. ; This is the single entry point for the four tape commands.
  2029. ; The routine first determines in what context it has been called by examining
  2030. ; the low byte of the Syntax table entry which was stored in T_ADDR.
  2031. ; Subtracting $EO (the present arrangement) gives a value of
  2032. ; $00 - SAVE
  2033. ; $01 - LOAD
  2034. ; $02 - VERIFY
  2035. ; $03 - MERGE
  2036. ; As with all commands the address STMT-RET is on the stack.
  2037.  
  2038. ;; SAVE-ETC
  2039. L0605:  POP     AF              ; discard address STMT-RET.
  2040.        LD      A,($5C74)       ; fetch T_ADDR
  2041.  
  2042. ; Now reduce the low byte of the Syntax table entry to give command.
  2043. ; Note. For ZASM use SUB $E0 as next instruction.
  2044.  
  2045. L0609           SUB LOW (L1ADF)+1       ; subtract the known offset.
  2046.                                ; ( is SUB $E0 in standard ROM )
  2047.  
  2048.        LD      ($5C74),A       ; and put back in T_ADDR as 0,1,2, or 3
  2049.                                ; for future reference.
  2050.  
  2051.        CALL    L1C8C           ; routine EXPT-EXP checks that a string
  2052.                                ; expression follows and stacks the
  2053.                                ; parameters in run-time.
  2054.  
  2055.        CALL    L2530           ; routine SYNTAX-Z
  2056.        JR      Z,L0652         ; forward to SA-DATA if checking syntax.
  2057.  
  2058.        LD      BC,$0011        ; presume seventeen bytes for a header.
  2059.        LD      A,($5C74)       ; fetch command from T_ADDR.
  2060.        AND     A               ; test for zero - SAVE.
  2061.        JR      Z,L0621         ; forward to SA-SPACE if so.
  2062.  
  2063.        LD      C,$22           ; else double length to thirty four.
  2064.  
  2065. ;; SA-SPACE
  2066. L0621:  RST     30H             ; BC-SPACES creates 17/34 bytes in workspace.
  2067.  
  2068.        PUSH    DE              ; transfer the start of new space to
  2069.        POP     IX              ; the available index register.
  2070.  
  2071. ; ten spaces are required for the default filename but it is simpler to
  2072. ; overwrite the first file-type indicator byte as well.
  2073.  
  2074.        LD      B,$0B           ; set counter to eleven.
  2075.        LD      A,$20           ; prepare a space.
  2076.  
  2077. ;; SA-BLANK
  2078. L0629:  LD      (DE),A          ; set workspace location to space.
  2079.        INC     DE              ; next location.
  2080.        DJNZ    L0629           ; loop back to SA-BLANK till all eleven done.
  2081.  
  2082.        LD      (IX+$01),$FF    ; set first byte of ten character filename
  2083.                                ; to $FF as a default to signal null string.
  2084.  
  2085.        CALL    L2BF1           ; routine STK-FETCH fetches the filename
  2086.                                ; parameters from the calculator stack.
  2087.                                ; length of string in BC.
  2088.                                ; start of string in DE.
  2089.  
  2090.        LD      HL,$FFF6        ; prepare the value minus ten.
  2091.        DEC     BC              ; decrement length.
  2092.                                ; ten becomes nine, zero becomes $FFFF.
  2093.        ADD     HL,BC           ; trial addition.
  2094.        INC     BC              ; restore true length.
  2095.        JR      NC,L064B        ; forward to SA-NAME if length is one to ten.
  2096.  
  2097. ; the filename is more than ten characters in length or the null string.
  2098.  
  2099.        LD      A,($5C74)       ; fetch command from T_ADDR.
  2100.        AND     A               ; test for zero - SAVE.
  2101.        JR      NZ,L0644        ; forward to SA-NULL if not the SAVE command.
  2102.  
  2103. ; but no more than ten characters are allowed for SAVE.
  2104. ; The first ten characters of any other command parameter are acceptable.
  2105. ; Weird, but necessary, if saving to sectors.
  2106. ; Note. the golden rule that there are no restriction on anything is broken.
  2107.  
  2108. ;; REPORT-Fa
  2109. L0642:  RST     08H             ; ERROR-1
  2110.        DB    $0E             ; Error Report: Invalid file name
  2111.  
  2112. ; continue with LOAD, MERGE, VERIFY and also SAVE within ten character limit.
  2113.  
  2114. ;; SA-NULL
  2115. L0644:  LD      A,B             ; test length of filename
  2116.        OR      C               ; for zero.
  2117.        JR      Z,L0652         ; forward to SA-DATA if so using the 255
  2118.                                ; indicator followed by spaces.
  2119.  
  2120.        LD      BC,$000A        ; else trim length to ten.
  2121.  
  2122. ; other paths rejoin here with BC holding length in range 1 - 10.
  2123.  
  2124. ;; SA-NAME
  2125. L064B:  PUSH    IX              ; push start of file descriptor.
  2126.        POP     HL              ; and pop into HL.
  2127.  
  2128.        INC     HL              ; HL now addresses first byte of filename.
  2129.        EX      DE,HL           ; transfer destination address to DE, start
  2130.                                ; of string in command to HL.
  2131.        LDIR                    ; copy up to ten bytes
  2132.                                ; if less than ten then trailing spaces follow.
  2133.  
  2134. ; the case for the null string rejoins here.
  2135.  
  2136. ;; SA-DATA
  2137. L0652:  RST     18H             ; GET-CHAR
  2138.        CP      $E4             ; is character after filename the token 'DATA' ?
  2139.        JR      NZ,L06A0        ; forward to SA-SCR$ to consider SCREEN$ if
  2140.                                ; not.
  2141.  
  2142. ; continue to consider DATA.
  2143.  
  2144.        LD      A,($5C74)       ; fetch command from T_ADDR
  2145.        CP      $03             ; is it 'VERIFY' ?
  2146.        JP      Z,L1C8A         ; jump forward to REPORT-C if so.
  2147.                                ; 'Nonsense in BASIC'
  2148.                                ; VERIFY "d" DATA is not allowed.
  2149.  
  2150. ; continue with SAVE, LOAD, MERGE of DATA.
  2151.  
  2152.        RST     20H             ; NEXT-CHAR
  2153.        CALL    L28B2           ; routine LOOK-VARS searches variables area
  2154.                                ; returning with carry reset if found or
  2155.                                ; checking syntax.
  2156.        SET     7,C             ; this converts a simple string to a
  2157.                                ; string array. The test for an array or string
  2158.                                ; comes later.
  2159.        JR      NC,L0672        ; forward to SA-V-OLD if variable found.
  2160.  
  2161.        LD      HL,$0000        ; set destination to zero as not fixed.
  2162.        LD      A,($5C74)       ; fetch command from T_ADDR
  2163.        DEC     A               ; test for 1 - LOAD
  2164.        JR      Z,L0685         ; forward to SA-V-NEW with LOAD DATA.
  2165.                                ; to load a new array.
  2166.  
  2167. ; otherwise the variable was not found in run-time with SAVE/MERGE.
  2168.  
  2169. ;; REPORT-2a
  2170. L0670:  RST     08H             ; ERROR-1
  2171.        DB    $01             ; Error Report: Variable not found
  2172.  
  2173. ; continue with SAVE/LOAD  DATA
  2174.  
  2175. ;; SA-V-OLD
  2176. L0672:  JP      NZ,L1C8A        ; to REPORT-C if not an array variable.
  2177.                                ; or erroneously a simple string.
  2178.                                ; 'Nonsense in BASIC'
  2179.  
  2180.  
  2181.        CALL    L2530           ; routine SYNTAX-Z
  2182.        JR      Z,L0692         ; forward to SA-DATA-1 if checking syntax.
  2183.  
  2184.        INC     HL              ; step past single character variable name.
  2185.        LD      A,(HL)          ; fetch low byte of length.
  2186.        LD      (IX+$0B),A      ; place in descriptor.
  2187.        INC     HL              ; point to high byte.
  2188.        LD      A,(HL)          ; and transfer that
  2189.        LD      (IX+$0C),A      ; to descriptor.
  2190.        INC     HL              ; increase pointer within variable.
  2191.  
  2192. ;; SA-V-NEW
  2193. L0685:  LD      (IX+$0E),C      ; place character array name in  header.
  2194.        LD      A,$01           ; default to type numeric.
  2195.        BIT     6,C             ; test result from look-vars.
  2196.        JR      Z,L068F         ; forward to SA-V-TYPE if numeric.
  2197.  
  2198.        INC     A               ; set type to 2 - string array.
  2199.  
  2200. ;; SA-V-TYPE
  2201. L068F:  LD      (IX+$00),A      ; place type 0, 1 or 2 in descriptor.
  2202.  
  2203. ;; SA-DATA-1
  2204. L0692:  EX      DE,HL           ; save var pointer in DE
  2205.  
  2206.        RST     20H             ; NEXT-CHAR
  2207.        CP      $29             ; is character ')' ?
  2208.        JR      NZ,L0672        ; back if not to SA-V-OLD to report
  2209.                                ; 'Nonsense in BASIC'
  2210.  
  2211.        RST     20H             ; NEXT-CHAR advances character address.
  2212.        CALL    L1BEE           ; routine CHECK-END errors if not end of
  2213.                                ; the statement.
  2214.  
  2215.        EX      DE,HL           ; bring back variables data pointer.
  2216.        JP      L075A           ; jump forward to SA-ALL
  2217.  
  2218. ; ---
  2219. ; the branch was here to consider a 'SCREEN$', the display file.
  2220.  
  2221. ;; SA-SCR$
  2222. L06A0:  CP      $AA             ; is character the token 'SCREEN$' ?
  2223.        JR      NZ,L06C3        ; forward to SA-CODE if not.
  2224.  
  2225.        LD      A,($5C74)       ; fetch command from T_ADDR
  2226.        CP      $03             ; is it MERGE ?
  2227.        JP       Z,L1C8A        ; jump to REPORT-C if so.
  2228.                                ; 'Nonsense in BASIC'
  2229.  
  2230. ; continue with SAVE/LOAD/VERIFY SCREEN$.
  2231.  
  2232.        RST     20H             ; NEXT-CHAR
  2233.        CALL    L1BEE           ; routine CHECK-END errors if not at end of
  2234.                                ; statement.
  2235.  
  2236. ; continue in runtime.
  2237.  
  2238.        LD      (IX+$0B),$00    ; set descriptor length
  2239.        LD      (IX+$0C),$1B    ; to $1b00 to include bitmaps and attributes.
  2240.  
  2241.        LD      HL,$4000        ; set start to display file start.
  2242.        LD      (IX+$0D),L      ; place start in
  2243.        LD      (IX+$0E),H      ; the descriptor.
  2244.        JR      L0710           ; forward to SA-TYPE-3
  2245.  
  2246. ; ---
  2247. ; the branch was here to consider CODE.
  2248.  
  2249. ;; SA-CODE
  2250. L06C3:  CP      $AF             ; is character the token 'CODE' ?
  2251.        JR      NZ,L0716        ; forward if not to SA-LINE to consider an
  2252.                                ; auto-started BASIC program.
  2253.  
  2254.        LD      A,($5C74)       ; fetch command from T_ADDR
  2255.        CP      $03             ; is it MERGE ?
  2256.        JP      Z,L1C8A         ; jump forward to REPORT-C if so.
  2257.                                ; 'Nonsense in BASIC'
  2258.  
  2259.  
  2260.        RST     20H             ; NEXT-CHAR advances character address.
  2261.        CALL    L2048           ; routine PR-ST-END checks if a carriage
  2262.                                ; return or ':' follows.
  2263.        JR      NZ,L06E1        ; forward to SA-CODE-1 if there are parameters.
  2264.  
  2265.        LD      A,($5C74)       ; else fetch the command from T_ADDR.
  2266.        AND     A               ; test for zero - SAVE without a specification.
  2267.        JP      Z,L1C8A         ; jump to REPORT-C if so.
  2268.                                ; 'Nonsense in BASIC'
  2269.  
  2270. ; for LOAD/VERIFY put zero on stack to signify handle at location saved from.
  2271.  
  2272.        CALL    L1CE6           ; routine USE-ZERO
  2273.        JR      L06F0           ; forward to SA-CODE-2
  2274.  
  2275. ; ---
  2276. ; if there are more characters after CODE expect start and possibly length.
  2277.  
  2278. ;; SA-CODE-1
  2279. L06E1:  CALL    L1C82           ; routine EXPT-1NUM checks for numeric
  2280.                                ; expression and stacks it in run-time.
  2281.  
  2282.        RST     18H             ; GET-CHAR
  2283.        CP      $2C             ; does a comma follow ?
  2284.        JR      Z,L06F5         ; forward if so to SA-CODE-3
  2285.  
  2286. ; else allow saved code to be loaded to a specified address.
  2287.  
  2288.        LD      A,($5C74)       ; fetch command from T_ADDR.
  2289.        AND     A               ; is the command SAVE which requires length ?
  2290.        JP      Z,L1C8A         ; jump to REPORT-C if so.
  2291.                                ; 'Nonsense in BASIC'
  2292.  
  2293. ; the command LOAD code may rejoin here with zero stacked as start.
  2294.  
  2295. ;; SA-CODE-2
  2296. L06F0:  CALL    L1CE6           ; routine USE-ZERO stacks zero for length.
  2297.        JR      L06F9           ; forward to SA-CODE-4
  2298.  
  2299. ; ---
  2300. ; the branch was here with SAVE CODE start,
  2301.  
  2302. ;; SA-CODE-3
  2303. L06F5:  RST     20H             ; NEXT-CHAR advances character address.
  2304.        CALL    L1C82           ; routine EXPT-1NUM checks for expression
  2305.                                ; and stacks in run-time.
  2306.  
  2307. ; paths converge here and nothing must follow.
  2308.  
  2309. ;; SA-CODE-4
  2310. L06F9:  CALL    L1BEE           ; routine CHECK-END errors with extraneous
  2311.                                ; characters and quits if checking syntax.
  2312.  
  2313. ; in run-time there are two 16-bit parameters on the calculator stack.
  2314.  
  2315.        CALL    L1E99           ; routine FIND-INT2 gets length.
  2316.        LD      (IX+$0B),C      ; place length
  2317.        LD      (IX+$0C),B      ; in descriptor.
  2318.        CALL    L1E99           ; routine FIND-INT2 gets start.
  2319.        LD      (IX+$0D),C      ; place start
  2320.        LD      (IX+$0E),B      ; in descriptor.
  2321.        LD      H,B             ; transfer the
  2322.        LD      L,C             ; start to HL also.
  2323.  
  2324. ;; SA-TYPE-3
  2325. L0710:  LD      (IX+$00),$03    ; place type 3 - code in descriptor.
  2326.        JR      L075A           ; forward to SA-ALL.
  2327.  
  2328. ; ---
  2329. ; the branch was here with BASIC to consider an optional auto-start line
  2330. ; number.
  2331.  
  2332. ;; SA-LINE
  2333. L0716:  CP      $CA             ; is character the token 'LINE' ?
  2334.        JR      Z,L0723         ; forward to SA-LINE-1 if so.
  2335.  
  2336. ; else all possibilities have been considered and nothing must follow.
  2337.  
  2338.        CALL    L1BEE           ; routine CHECK-END
  2339.  
  2340. ; continue in run-time to save BASIC without auto-start.
  2341.  
  2342.        LD      (IX+$0E),$80    ; place high line number in descriptor to
  2343.                                ; disable auto-start.
  2344.        JR      L073A           ; forward to SA-TYPE-0 to save program.
  2345.  
  2346. ; ---
  2347. ; the branch was here to consider auto-start.
  2348.  
  2349. ;; SA-LINE-1
  2350. L0723:  LD      A,($5C74)       ; fetch command from T_ADDR
  2351.        AND     A               ; test for SAVE.
  2352.        JP      NZ,L1C8A        ; jump forward to REPORT-C with anything else.
  2353.                                ; 'Nonsense in BASIC'
  2354.  
  2355. ;
  2356.  
  2357.        RST     20H             ; NEXT-CHAR
  2358.        CALL    L1C82           ; routine EXPT-1NUM checks for numeric
  2359.                                ; expression and stacks in run-time.
  2360.        CALL    L1BEE           ; routine CHECK-END quits if syntax path.
  2361.        CALL    L1E99           ; routine FIND-INT2 fetches the numeric
  2362.                                ; expression.
  2363.        LD      (IX+$0D),C      ; place the auto-start
  2364.        LD      (IX+$0E),B      ; line number in the descriptor.
  2365.  
  2366. ; Note. this isn't checked, but is subsequently handled by the system.
  2367. ; If the user typed 40000 instead of 4000 then it won't auto-start
  2368. ; at line 4000, or indeed, at all.
  2369.  
  2370. ; continue to save program and any variables.
  2371.  
  2372. ;; SA-TYPE-0
  2373. L073A:  LD      (IX+$00),$00    ; place type zero - program in descriptor.
  2374.         LD      HL,($5C59)      ; fetch E_LINE to HL.
  2375.         LD      DE,($5C53)      ; fetch PROG to DE.
  2376.  
  2377. ;===============================
  2378.                 IF TAP_EMUL
  2379.                 CALL INI_TAP
  2380.                 ELSE
  2381.                
  2382.                 SCF             ; set carry flag to calculate from end of
  2383.                                 ; variables E_LINE -1.
  2384.                 SBC HL,DE       ; subtract to give total length.
  2385.                 ENDIF
  2386.  
  2387.         LD      (IX+$0B),L      ; place total length
  2388.         LD      (IX+$0C),H      ; in descriptor.
  2389.         LD      HL,($5C4B)      ; load HL from system variable VARS
  2390.         SBC     HL,DE           ; subtract to give program length.
  2391.         LD      (IX+$0F),L      ; place length of program
  2392.         LD      (IX+$10),H      ; in the descriptor.
  2393.         EX      DE,HL           ; start to HL, length to DE.
  2394.  
  2395. ;; SA-ALL
  2396. L075A:  LD      A,($5C74)       ; fetch command from T_ADDR
  2397.         AND     A               ; test for zero - SAVE.
  2398.         JP      Z,L0970         ; jump forward to SA-CONTRL with SAVE  ->
  2399.  
  2400. ; ---
  2401. ; continue with LOAD, MERGE and VERIFY.
  2402.  
  2403.         PUSH    HL              ; save start.
  2404.         LD      BC,$0011        ; prepare to add seventeen
  2405.         ADD     IX,BC           ; to point IX at second descriptor.
  2406.  
  2407. ;; LD-LOOK-H
  2408. L0767:  PUSH    IX              ; save IX
  2409.         LD      DE,$0011        ; seventeen bytes
  2410.         XOR     A               ; reset zero flag
  2411.         SCF                     ; set carry flag
  2412.         CALL    L0556           ; routine LD-BYTES loads a header from tape
  2413.                                 ; to second descriptor.
  2414.         POP     IX              ; restore IX.
  2415.         JR      NC,L0767        ; loop back to LD-LOOK-H until header found.
  2416.  
  2417.         LD      A,$FE           ; select system channel 'S'
  2418.         CALL    L1601           ; routine CHAN-OPEN opens it.
  2419.  
  2420.         LD      (IY+$52),$03    ; set SCR_CT to 3 lines.
  2421.  
  2422.         LD      C,$80           ; C has bit 7 set to indicate type mismatch as
  2423.                                 ; a default startpoint.
  2424.  
  2425.         LD      A,(IX+$00)      ; fetch loaded header type to A
  2426.         CP      (IX-$11)        ; compare with expected type.
  2427.         JR      NZ,L078A        ; forward to LD-TYPE with mis-match.
  2428.  
  2429.         LD      C,$F6           ; set C to minus ten - will count characters
  2430.                                 ; up to zero.
  2431.  
  2432. ;; LD-TYPE
  2433. L078A:  CP      $04             ; check if type in acceptable range 0 - 3.
  2434.         JR      NC,L0767        ; back to LD-LOOK-H with 4 and over.
  2435.  
  2436. ; else A indicates type 0-3.
  2437.  
  2438.         LD      DE,L09C0        ; address base of last 4 tape messages
  2439.         PUSH    BC              ; save BC
  2440.         CALL    L0C0A           ; routine PO-MSG outputs relevant message.
  2441.                                 ; Note. all messages have a leading newline.
  2442.         POP     BC              ; restore BC
  2443.  
  2444.         PUSH    IX              ; transfer IX,
  2445.         POP     DE              ; the 2nd descriptor, to DE.
  2446.         LD      HL,$FFF0        ; prepare minus seventeen.
  2447.         ADD     HL,DE           ; add to point HL to 1st descriptor.
  2448.         LD      B,$0A           ; the count will be ten characters for the
  2449.                                 ; filename.
  2450.  
  2451.         LD      A,(HL)          ; fetch first character and test for
  2452.         INC     A               ; value 255.
  2453.         JR      NZ,L07A6        ; forward to LD-NAME if not the wildcard.
  2454.  
  2455. ; but if it is the wildcard, then add ten to C which is minus ten for a type
  2456. ; match or -128 for a type mismatch. Although characters have to be counted
  2457. ; bit 7 of C will not alter from state set here.
  2458.  
  2459.         LD      A,C             ; transfer $F6 or $80 to A
  2460.         ADD     A,B             ; add $0A
  2461.         LD      C,A             ; place result, zero or -118, in C.
  2462.  
  2463. ; At this point we have either a type mismatch, a wildcard match or ten
  2464. ; characters to be counted. The characters must be shown on the screen.
  2465.  
  2466. ;; LD-NAME
  2467. L07A6:  INC     DE              ; address next input character
  2468.         LD      A,(DE)          ; fetch character
  2469.         CP      (HL)            ; compare to expected
  2470.         INC     HL              ; address next expected character
  2471.         JR      NZ,L07AD        ; forward to LD-CH-PR with mismatch
  2472.  
  2473.         INC     C               ; increment matched character count
  2474.  
  2475. ;; LD-CH-PR
  2476. L07AD:  RST     10H             ; PRINT-A prints character
  2477.         DJNZ    L07A6           ; loop back to LD-NAME for ten characters.
  2478.  
  2479. ; if ten characters matched and the types previously matched then C will
  2480. ; now hold zero.
  2481.  
  2482.         BIT     7,C             ; test if all matched
  2483.         JR      NZ,L0767        ; back to LD-LOOK-H if not
  2484.  
  2485. ; else print a terminal carriage return.
  2486.  
  2487.         LD      A,$0D           ; prepare carriage return.
  2488.         RST     10H             ; PRINT-A outputs it.
  2489.  
  2490. ; The various control routines for LOAD, VERIFY and MERGE are executed
  2491. ; during the one-second gap following the header on tape.
  2492.  
  2493.         POP     HL              ; restore xx
  2494.         LD      A,(IX+$00)      ; fetch incoming type
  2495.         CP      $03             ; compare with CODE
  2496.         JR      Z,L07CB         ; forward to VR-CONTROL if it is CODE.
  2497.  
  2498. ;  type is a program or an array.
  2499.  
  2500.         LD      A,($5C74)       ; fetch command from T_ADDR
  2501.         DEC     A               ; was it LOAD ?
  2502.         JP      Z,L0808         ; JUMP forward to LD-CONTRL if so to
  2503.                                 ; load BASIC or variables.
  2504.  
  2505.         CP      $02             ; was command MERGE ?
  2506.         JP      Z,L08B6         ; jump forward to ME-CONTRL if so.
  2507.  
  2508. ; else continue into VERIFY control routine to verify.
  2509.  
  2510. ; ---------------------
  2511. ; Handle VERIFY control
  2512. ; ---------------------
  2513. ; There are two branches to this routine.
  2514. ; 1) From above to verify a program or array
  2515. ; 2) from earlier with no carry to load or verify code.
  2516.  
  2517. ;; VR-CONTROL
  2518. L07CB:  PUSH    HL              ; save pointer to data.
  2519.         LD      L,(IX-$06)      ; fetch length of old data
  2520.         LD      H,(IX-$05)      ; to HL.
  2521.         LD      E,(IX+$0B)      ; fetch length of new data
  2522.         LD      D,(IX+$0C)      ; to DE.
  2523.         LD      A,H             ; check length of old
  2524.         OR      L               ; for zero.
  2525.         JR      Z,L07E9         ; forward to VR-CONT-1 if length unspecified
  2526.                                 ; e.g LOAD "x" CODE
  2527.  
  2528. ; as opposed to, say, LOAD 'x' CODE 32768,300.
  2529.  
  2530.         SBC     HL,DE           ; subtract the two lengths.
  2531.         JR      C,L0806         ; forward to REPORT-R if the length on tape is
  2532.                                 ; larger than that specified in command.
  2533.                                 ; 'Tape loading error'
  2534.  
  2535.         JR      Z,L07E9         ; forward to VR-CONT-1 if lengths match.
  2536.  
  2537. ; a length on tape shorter than expected is not allowed for CODE
  2538.  
  2539.         LD      A,(IX+$00)      ; else fetch type from tape.
  2540.         CP      $03             ; is it CODE ?
  2541.         JR      NZ,L0806        ; forward to REPORT-R if so
  2542.                                 ; 'Tape loading error'
  2543.  
  2544. ;; VR-CONT-1
  2545. L07E9:  POP     HL              ; pop pointer to data
  2546.         LD      A,H             ; test for zero
  2547.         OR      L               ; e.g. LOAD 'x' CODE
  2548.         JR      NZ,L07F4        ; forward to VR-CONT-2 if destination specified.
  2549.  
  2550.         LD      L,(IX+$0D)      ; else use the destination in the header
  2551.         LD      H,(IX+$0E)      ; and load code at address saved from.
  2552.  
  2553. ;; VR-CONT-2
  2554. L07F4:  PUSH    HL              ; push pointer to start of data block.
  2555.         POP     IX              ; transfer to IX.
  2556.         LD      A,($5C74)       ; fetch reduced command from T_ADDR
  2557.         CP      $02             ; is it VERIFY ?
  2558.         SCF                     ; prepare a set carry flag
  2559.         JR      NZ,L0800        ; skip to VR-CONT-3 if not
  2560.  
  2561.         AND     A               ; clear carry flag for VERIFY so that
  2562.                                 ; data is not loaded.
  2563.  
  2564. ;; VR-CONT-3
  2565. L0800:  LD      A,$FF           ; signal data block to be loaded
  2566.  
  2567. ; -----------------
  2568. ; Load a data block
  2569. ; -----------------
  2570. ; This routine is called from 3 places other than above to load a data block.
  2571. ; In all cases the accumulator is first set to $FF so the routine could be
  2572. ; called at the previous instruction.
  2573.  
  2574. ;; LD-BLOCK
  2575. L0802:  CALL    L0556           ; routine LD-BYTES
  2576.         RET     C               ; return if successful.
  2577.  
  2578.  
  2579. ;; REPORT-R
  2580. L0806:  RST     08H             ; ERROR-1
  2581.         DB    $1A             ; Error Report: Tape loading error
  2582.  
  2583. ; -------------------
  2584. ; Handle LOAD control
  2585. ; -------------------
  2586. ; This branch is taken when the command is LOAD with type 0, 1 or 2.
  2587.  
  2588. ;; LD-CONTRL
  2589. L0808:  LD      E,(IX+$0B)      ; fetch length of found data block
  2590.         LD      D,(IX+$0C)      ; from 2nd descriptor.
  2591.         PUSH    HL              ; save destination
  2592.         LD      A,H             ; test for zero
  2593.         OR      L               ;
  2594.         JR      NZ,L0819        ; forward if not to LD-CONT-1
  2595.  
  2596.         INC     DE              ; increase length
  2597.         INC     DE              ; for letter name
  2598.         INC     DE              ; and 16-bit length
  2599.         EX      DE,HL           ; length to HL,
  2600.         JR      L0825           ; forward to LD-CONT-2
  2601.  
  2602. ; ---
  2603.  
  2604. ;; LD-CONT-1
  2605. L0819:  LD      L,(IX-$06)      ; fetch length from
  2606.         LD      H,(IX-$05)      ; the first header.
  2607.         EX      DE,HL           ;
  2608.         SCF                     ; set carry flag
  2609.         SBC     HL,DE           ;
  2610.         JR      C,L082E         ; to LD-DATA
  2611.  
  2612. ;; LD-CONT-2
  2613. L0825:  LD      DE,$0005        ; allow overhead of five bytes.
  2614.         ADD     HL,DE           ; add in the difference in data lengths.
  2615.         LD      B,H             ; transfer to
  2616.         LD      C,L             ; the BC register pair
  2617.         CALL    L1F05           ; routine TEST-ROOM fails if not enough room.
  2618.  
  2619. ;; LD-DATA
  2620. L082E:  POP     HL              ; pop destination
  2621.         LD      A,(IX+$00)      ; fetch type 0, 1 or 2.
  2622.         AND     A               ; test for program and variables.
  2623.         JR      Z,L0873         ; forward if so to LD-PROG
  2624.  
  2625. ; the type is a numeric or string array.
  2626.  
  2627.         LD      A,H             ; test the destination for zero
  2628.         OR      L               ; indicating variable does not already exist.
  2629.         JR      Z,L084C         ; forward if so to LD-DATA-1
  2630.  
  2631. ; else the destination is the first dimension within the array structure
  2632.  
  2633.         DEC     HL              ; address high byte of total length
  2634.         LD      B,(HL)          ; transfer to B.
  2635.         DEC     HL              ; address low byte of total length.
  2636.         LD      C,(HL)          ; transfer to C.
  2637.         DEC     HL              ; point to letter of variable.
  2638.         INC     BC              ; adjust length to
  2639.         INC     BC              ; include these
  2640.         INC     BC              ; three bytes also.
  2641.         LD      ($5C5F),IX      ; save header pointer in X_PTR.
  2642.         CALL    L19E8           ; routine RECLAIM-2 reclaims the old variable
  2643.                                 ; sliding workspace including the two headers
  2644.                                 ; downwards.
  2645.         LD      IX,($5C5F)      ; reload IX from X_PTR which will have been
  2646.                                 ; adjusted down by POINTERS routine.
  2647.  
  2648. ;; LD-DATA-1
  2649. L084C:  LD      HL,($5C59)      ; address E_LINE
  2650.         DEC     HL              ; now point to the $80 variables end-marker.
  2651.         LD      C,(IX+$0B)      ; fetch new data length
  2652.         LD      B,(IX+$0C)      ; from 2nd header.
  2653.         PUSH    BC              ; * save it.
  2654.         INC     BC              ; adjust the
  2655.         INC     BC              ; length to include
  2656.         INC     BC              ; letter name and total length.
  2657.         LD      A,(IX-$03)      ; fetch letter name from old header.
  2658.         PUSH    AF              ; preserve accumulator though not corrupted.
  2659.  
  2660.         CALL    L1655           ; routine MAKE-ROOM creates space for variable
  2661.                                 ; sliding workspace up. IX no longer addresses
  2662.                                 ; anywhere meaningful.
  2663.         INC     HL              ; point to first new location.
  2664.  
  2665.         POP     AF              ; fetch back the letter name.
  2666.         LD      (HL),A          ; place in first new location.
  2667.         POP     DE              ; * pop the data length.
  2668.         INC     HL              ; address 2nd location
  2669.         LD      (HL),E          ; store low byte of length.
  2670.         INC     HL              ; address next.
  2671.         LD      (HL),D          ; store high byte.
  2672.         INC     HL              ; address start of data.
  2673.         PUSH    HL              ; transfer address
  2674.         POP     IX              ; to IX register pair.
  2675.         SCF                     ; set carry flag indicating load not verify.
  2676.         LD      A,$FF           ; signal data not header.
  2677.         JP      L0802           ; JUMP back to LD-BLOCK
  2678.  
  2679. ; -----------------
  2680. ; the branch is here when a program as opposed to an array is to be loaded.
  2681.  
  2682. ;; LD-PROG
  2683. L0873:  EX      DE,HL           ; transfer dest to DE.
  2684.         LD      HL,($5C59)      ; address E_LINE
  2685.         DEC     HL              ; now variables end-marker.
  2686.         LD      ($5C5F),IX      ; place the IX header pointer in X_PTR
  2687.         LD      C,(IX+$0B)      ; get new length
  2688.         LD      B,(IX+$0C)      ; from 2nd header
  2689.         PUSH    BC              ; and save it.
  2690.  
  2691.         CALL    L19E5           ; routine RECLAIM-1 reclaims program and vars.
  2692.                                 ; adjusting X-PTR.
  2693.  
  2694.         POP     BC              ; restore new length.
  2695.         PUSH    HL              ; * save start
  2696.         PUSH    BC              ; ** and length.
  2697.  
  2698.         CALL    L1655           ; routine MAKE-ROOM creates the space.
  2699.  
  2700.         LD      IX,($5C5F)      ; reload IX from adjusted X_PTR
  2701.         INC     HL              ; point to start of new area.
  2702.         LD      C,(IX+$0F)      ; fetch length of BASIC on tape
  2703.         LD      B,(IX+$10)      ; from 2nd descriptor
  2704.         ADD     HL,BC           ; add to address the start of variables.
  2705.         LD      ($5C4B),HL      ; set system variable VARS
  2706.  
  2707.         LD      H,(IX+$0E)      ; fetch high byte of autostart line number.
  2708.         LD      A,H             ; transfer to A
  2709.         AND     $C0             ; test if greater than $3F.
  2710.         JR      NZ,L08AD        ; forward to LD-PROG-1 if so with no autostart.
  2711.  
  2712.         LD      L,(IX+$0D)      ; else fetch the low byte.
  2713.         LD      ($5C42),HL      ; set sytem variable to line number NEWPPC
  2714.         LD      (IY+$0A),$00    ; set statement NSPPC to zero.
  2715.  
  2716. ;; LD-PROG-1
  2717. L08AD:  POP     DE              ; ** pop the length
  2718.         POP     IX              ; * and start.
  2719.         SCF                     ; set carry flag
  2720.         LD      A,$FF           ; signal data as opposed to a header.
  2721.         JP      L0802           ; jump back to LD-BLOCK
  2722.  
  2723. ; --------------------
  2724. ; Handle MERGE control
  2725. ; --------------------
  2726. ; the branch was here to merge a program and its variables or an array.
  2727. ;
  2728.  
  2729. ;; ME-CONTRL
  2730. L08B6:  LD      C,(IX+$0B)      ; fetch length
  2731.         LD      B,(IX+$0C)      ; of data block on tape.
  2732.         PUSH    BC              ; save it.
  2733.         INC     BC              ; one for the pot.
  2734.  
  2735.         RST     30H             ; BC-SPACES creates room in workspace.
  2736.                                 ; HL addresses last new location.
  2737.         LD      (HL),$80        ; place end-marker at end.
  2738.         EX      DE,HL           ; transfer first location to HL.
  2739.         POP     DE              ; restore length to DE.
  2740.         PUSH    HL              ; save start.
  2741.  
  2742.         PUSH    HL              ; and transfer it
  2743.         POP     IX              ; to IX register.
  2744.         SCF                     ; set carry flag to load data on tape.
  2745.         LD      A,$FF           ; signal data not a header.
  2746.         CALL    L0802           ; routine LD-BLOCK loads to workspace.
  2747.         POP     HL              ; restore first location in workspace to HL.
  2748. X08CE   LD      DE,($5C53)      ; set DE from system variable PROG.
  2749.  
  2750. ; now enter a loop to merge the data block in workspace with the program and
  2751. ; variables.
  2752.  
  2753. ;; ME-NEW-LP
  2754. L08D2:  LD      A,(HL)          ; fetch next byte from workspace.
  2755.         AND     $C0             ; compare with $3F.
  2756.         JR      NZ,L08F0        ; forward to ME-VAR-LP if a variable or
  2757.                                 ; end-marker.
  2758.  
  2759. ; continue when HL addresses a BASIC line number.
  2760.  
  2761. ;; ME-OLD-LP
  2762. L08D7:  LD      A,(DE)          ; fetch high byte from program area.
  2763.         INC     DE              ; bump prog address.
  2764.         CP      (HL)            ; compare with that in workspace.
  2765.         INC     HL              ; bump workspace address.
  2766.         JR      NZ,L08DF        ; forward to ME-OLD-L1 if high bytes don't match
  2767.  
  2768.         LD      A,(DE)          ; fetch the low byte of program line number.
  2769.         CP      (HL)            ; compare with that in workspace.
  2770.  
  2771. ;; ME-OLD-L1
  2772. L08DF:  DEC     DE              ; point to start of
  2773.         DEC     HL              ; respective lines again.
  2774.         JR      NC,L08EB        ; forward to ME-NEW-L2 if line number in
  2775.                                 ; workspace is less than or equal to current
  2776.                                 ; program line as has to be added to program.
  2777.  
  2778.         PUSH    HL              ; else save workspace pointer.
  2779.         EX      DE,HL           ; transfer prog pointer to HL
  2780.         CALL    L19B8           ; routine NEXT-ONE finds next line in DE.
  2781.         POP     HL              ; restore workspace pointer
  2782.         JR      L08D7           ; back to ME-OLD-LP until destination position
  2783.                                 ; in program area found.
  2784.  
  2785. ; ---
  2786. ; the branch was here with an insertion or replacement point.
  2787.  
  2788. ;; ME-NEW-L2
  2789. L08EB:  CALL    L092C           ; routine ME-ENTER enters the line
  2790.         JR      L08D2           ; loop back to ME-NEW-LP.
  2791.  
  2792. ; ---
  2793. ; the branch was here when the location in workspace held a variable.
  2794.  
  2795. ;; ME-VAR-LP
  2796. L08F0:  LD      A,(HL)          ; fetch first byte of workspace variable.
  2797.         LD      C,A             ; copy to C also.
  2798.         CP      $80             ; is it the end-marker ?
  2799.         RET     Z               ; return if so as complete.  >>>>>
  2800.  
  2801.         PUSH    HL              ; save workspace area pointer.
  2802.         LD      HL,($5C4B)      ; load HL with VARS - start of variables area.
  2803.  
  2804. ;; ME-OLD-VP
  2805. L08F9:  LD      A,(HL)          ; fetch first byte.
  2806.         CP      $80             ; is it the end-marker ?
  2807.         JR      Z,L0923         ; forward if so to ME-VAR-L2 to add
  2808.                                 ; variable at end of variables area.
  2809.  
  2810.         CP      C               ; compare with variable in workspace area.
  2811.         JR      Z,L0909         ; forward to ME-OLD-V2 if a match to replace.
  2812.  
  2813. ; else entire variables area has to be searched.
  2814.  
  2815. ;; ME-OLD-V1
  2816. L0901:  PUSH    BC              ; save character in C.
  2817.         CALL    L19B8           ; routine NEXT-ONE gets following variable
  2818.                                 ; address in DE.
  2819.         POP     BC              ; restore character in C
  2820.         EX      DE,HL           ; transfer next address to HL.
  2821.         JR      L08F9           ; loop back to ME-OLD-VP
  2822.  
  2823. ; ---
  2824. ; the branch was here when first characters of name matched.
  2825.  
  2826. ;; ME-OLD-V2
  2827. L0909:  AND     $E0             ; keep bits 11100000
  2828.         CP      $A0             ; compare   10100000 - a long-named variable.
  2829.  
  2830.         JR      NZ,L0921        ; forward to ME-VAR-L1 if just one-character.
  2831.  
  2832. ; but long-named variables have to be matched character by character.
  2833.  
  2834.         POP     DE              ; fetch workspace 1st character pointer
  2835.         PUSH    DE              ; and save it on the stack again.
  2836.         PUSH    HL              ; save variables area pointer on stack.
  2837.  
  2838. ;; ME-OLD-V3
  2839. L0912:  INC     HL              ; address next character in vars area.
  2840.         INC     DE              ; address next character in workspace area.
  2841.         LD      A,(DE)          ; fetch workspace character.
  2842.         CP      (HL)            ; compare to variables character.
  2843.         JR      NZ,L091E        ; forward to ME-OLD-V4 with a mismatch.
  2844.  
  2845.         RLA                     ; test if the terminal inverted character.
  2846.         JR      NC,L0912        ; loop back to ME-OLD-V3 if more to test.
  2847.  
  2848. ; otherwise the long name matches in its entirety.
  2849.  
  2850.         POP     HL              ; restore pointer to first character of variable
  2851.         JR      L0921           ; forward to ME-VAR-L1
  2852.  
  2853. ; ---
  2854. ; the branch is here when two characters don't match
  2855.  
  2856. ;; ME-OLD-V4
  2857. L091E:  POP     HL              ; restore the prog/vars pointer.
  2858.         JR      L0901           ; back to ME-OLD-V1 to resume search.
  2859.  
  2860. ; ---
  2861. ; branch here when variable is to replace an existing one
  2862.  
  2863. ;; ME-VAR-L1
  2864. L0921:  LD      A,$FF           ; indicate a replacement.
  2865.  
  2866. ; this entry point is when A holds $80 indicating a new variable.
  2867.  
  2868. ;; ME-VAR-L2
  2869. L0923:  POP     DE              ; pop workspace pointer.
  2870.         EX      DE,HL           ; now make HL workspace pointer, DE vars pointer
  2871.         INC     A               ; zero flag set if replacement.
  2872.         SCF                     ; set carry flag indicating a variable not a
  2873.                                 ; program line.
  2874.         CALL    L092C           ; routine ME-ENTER copies variable in.
  2875.         JR      L08F0           ; loop back to ME-VAR-LP
  2876.  
  2877. ; ------------------------
  2878. ; Merge a Line or Variable
  2879. ; ------------------------
  2880. ; A BASIC line or variable is inserted at the current point. If the line numbers
  2881. ; or variable names match (zero flag set) then a replacement takes place.
  2882.  
  2883. ;; ME-ENTER
  2884. L092C:  JR      NZ,L093E        ; forward to ME-ENT-1 for insertion only.
  2885.  
  2886. ; but the program line or variable matches so old one is reclaimed.
  2887.  
  2888.         EX      AF,AF'          ; save flag??
  2889.        LD      ($5C5F),HL      ; preserve workspace pointer in dynamic X_PTR
  2890.        EX      DE,HL           ; transfer program dest pointer to HL.
  2891.        CALL    L19B8           ; routine NEXT-ONE finds following location
  2892.                                ; in program or variables area.
  2893.        CALL    L19E8           ; routine RECLAIM-2 reclaims the space between.
  2894.        EX      DE,HL           ; transfer program dest pointer back to DE.
  2895.        LD      HL,($5C5F)      ; fetch adjusted workspace pointer from X_PTR
  2896.        EX      AF,AF'          ; restore flags.
  2897.  
  2898. ; now the new line or variable is entered.
  2899.  
  2900. ;; ME-ENT-1
  2901. L093E:  EX      AF,AF'          ; save or re-save flags.
  2902.        PUSH    DE              ; save dest pointer in prog/vars area.
  2903.        CALL    L19B8           ; routine NEXT-ONE finds next in workspace.
  2904.                                ; gets next in DE, difference in BC.
  2905.                                ; prev addr in HL
  2906.        LD      ($5C5F),HL      ; store pointer in X_PTR
  2907.        LD      HL,($5C53)      ; load HL from system variable PROG
  2908.        EX      (SP),HL         ; swap with prog/vars pointer on stack.
  2909.        PUSH    BC              ; ** save length of new program line/variable.
  2910.        EX      AF,AF'          ; fetch flags back.
  2911.         JR      C,L0955         ; skip to ME-ENT-2 if variable
  2912.  
  2913.         DEC     HL              ; address location before pointer
  2914.         CALL    L1655           ; routine MAKE-ROOM creates room for BASIC line
  2915.         INC     HL              ; address next.
  2916.         JR      L0958           ; forward to ME-ENT-3
  2917.  
  2918. ; ---
  2919.  
  2920. ;; ME-ENT-2
  2921. L0955:  CALL    L1655           ; routine MAKE-ROOM creates room for variable.
  2922.  
  2923. ;; ME-ENT-3
  2924. L0958:  INC     HL              ; address next?
  2925.  
  2926.         POP     BC              ; ** pop length
  2927.         POP     DE              ; * pop value for PROG which may have been
  2928.                                 ; altered by POINTERS if first line.
  2929.         LD      ($5C53),DE      ; set PROG to original value.
  2930.         LD      DE,($5C5F)      ; fetch adjusted workspace pointer from X_PTR
  2931.         PUSH    BC              ; save length
  2932.         PUSH    DE              ; and workspace pointer
  2933.         EX      DE,HL           ; make workspace pointer source, prog/vars
  2934.                                 ; pointer the destination
  2935.         LDIR                    ; copy bytes of line or variable into new area.
  2936.         POP     HL              ; restore workspace pointer.
  2937.         POP     BC              ; restore length.
  2938.         PUSH    DE              ; save new prog/vars pointer.
  2939.         CALL    L19E8           ; routine RECLAIM-2 reclaims the space used
  2940.                                 ; by the line or variable in workspace block
  2941.                                 ; as no longer required and space could be
  2942.                                 ; useful for adding more lines.
  2943.         POP     DE              ; restore the prog/vars pointer
  2944.         RET                     ; return.
  2945.  
  2946. ; -------------------
  2947. ; Handle SAVE control
  2948. ; -------------------
  2949. ; A branch from the main SAVE-ETC routine at SAVE-ALL.
  2950. ; First the header data is saved. Then after a wait of 1 second
  2951. ; the data itself is saved.
  2952. ; HL points to start of data.
  2953. ; IX points to start of descriptor.
  2954.  
  2955. ;; SA-CONTRL
  2956. L0970:  PUSH    HL              ; save start of data
  2957.  
  2958.         LD      A,$FD           ; select system channel 'S'
  2959.         CALL    L1601           ; routine CHAN-OPEN
  2960.  
  2961.         XOR     A               ; clear to address table directly
  2962.         LD      DE,L09A1        ; address: tape-msgs
  2963.         CALL    L0C0A           ; routine PO-MSG -
  2964.                                 ; 'Start tape then press any key.'
  2965.  
  2966.         SET     5,(IY+$02)      ; TV_FLAG  - Signal lower screen requires
  2967.                                 ; clearing
  2968.         CALL    L15D4           ; routine WAIT-KEY
  2969.  
  2970.         PUSH    IX              ; save pointer to descriptor.
  2971.         LD      DE,$0011        ; there are seventeen bytes.
  2972.         XOR     A               ; signal a header.
  2973.         CALL    L04C2           ; routine SA-BYTES
  2974.  
  2975.         POP     IX              ; restore descriptor pointer.
  2976.  
  2977.         LD      B,$32           ; wait for a second - 50 interrupts.
  2978.  
  2979. ;; SA-1-SEC
  2980. L0991:  HALT                    ; wait for interrupt
  2981.         DJNZ    L0991           ; back to SA-1-SEC until pause complete.
  2982.  
  2983.         LD      E,(IX+$0B)      ; fetch length of bytes from the
  2984.         LD      D,(IX+$0C)      ; descriptor.
  2985.  
  2986.         LD      A,$FF           ; signal data bytes.
  2987.  
  2988.         POP     IX              ; retrieve pointer to start
  2989.         JP      L04C2           ; jump back to SA-BYTES
  2990.  
  2991.  
  2992. ; Arrangement of two headers in workspace.
  2993. ; Originally IX addresses first location and only one header is required
  2994. ; when saving.
  2995. ;
  2996. ;   OLD     NEW         PROG   DATA  DATA  CODE
  2997. ;   HEADER  HEADER             num   chr          NOTES.
  2998. ;   ------  ------      ----   ----  ----  ----   -----------------------------
  2999. ;   IX-$11  IX+$00      0      1     2     3      Type.
  3000. ;   IX-$10  IX+$01      x      x     x     x      F  ($FF if filename is null).
  3001. ;   IX-$0F  IX+$02      x      x     x     x      i
  3002. ;   IX-$0E  IX+$03      x      x     x     x      l
  3003. ;   IX-$0D  IX+$04      x      x     x     x      e
  3004. ;   IX-$0C  IX+$05      x      x     x     x      n
  3005. ;   IX-$0B  IX+$06      x      x     x     x      a
  3006. ;   IX-$0A  IX+$07      x      x     x     x      m
  3007. ;   IX-$09  IX+$08      x      x     x     x      e
  3008. ;   IX-$08  IX+$09      x      x     x     x      .
  3009. ;   IX-$07  IX+$0A      x      x     x     x      (terminal spaces).
  3010. ;   IX-$06  IX+$0B      lo     lo    lo    lo     Total  
  3011. ;   IX-$05  IX+$0C      hi     hi    hi    hi     Length of datablock.
  3012. ;   IX-$04  IX+$0D      Auto   -     -     Start  Various
  3013. ;   IX-$03  IX+$0E      Start  a-z   a-z   addr   ($80 if no autostart).
  3014. ;   IX-$02  IX+$0F      lo     -     -     -      Length of Program
  3015. ;   IX-$01  IX+$10      hi     -     -     -      only i.e. without variables.
  3016. ;
  3017.  
  3018.  
  3019. ; ------------------------
  3020. ; Canned cassette messages
  3021. ; ------------------------
  3022. ; The last-character-inverted Cassette messages.
  3023. ; Starts with normal initial step-over byte.
  3024.  
  3025. ;; tape-msgs
  3026. L09A1           DB $80
  3027.                 DC "Start tape, then press any key."    ;DEFM    "Start tape, then press any key"
  3028. L09C0           EQU $-1                                 ;DB    '.'+$80
  3029.                 DB $0D
  3030.                 DC "Program: "                          ;DEFM    "Program:"
  3031.                                                         ;DB    ' '+$80
  3032.                 DB $0D
  3033.                 DC "Number array: "                     ;DEFM    "Number array:"
  3034.                                                         ;DB    ' '+$80
  3035.                 DB $0D
  3036.                 DC "Character array: "                  ;DEFM    "Character array:"
  3037.                                                         ;DB    ' '+$80
  3038.                 DB $0D
  3039.                 DC "Bytes: "                            ;DEFM    "Bytes:"
  3040.                                                         ;DB    ' '+$80
  3041. ;               DB    ' '+$80
  3042.  
  3043.  
  3044. ;**************************************************
  3045. ;** Part 5. SCREEN AND PRINTER HANDLING ROUTINES **
  3046. ;**************************************************
  3047.  
  3048. ; ---------------------
  3049. ; General PRINT routine
  3050. ; ---------------------
  3051. ; This is the routine most often used by the RST 10 restart although the
  3052. ; subroutine is on two occasions called directly when it is known that
  3053. ; output will definitely be to the lower screen.
  3054.  
  3055. ;; PRINT-OUT
  3056. L09F4:  CALL    L0B03           ; routine PO-FETCH fetches print position
  3057.                                 ; to HL register pair.
  3058.         CP      $20             ; is character a space or higher ?
  3059.         JP      NC,L0AD9        ; jump forward to PO-ABLE if so.
  3060.  
  3061.         CP      $06             ; is character in range 00-05 ?
  3062.         JR      C,L0A69         ; to PO-QUEST to print '?' if so.
  3063.  
  3064.         CP      $18             ; is character in range 24d - 31d ?
  3065.         JR      NC,L0A69        ; to PO-QUEST to also print '?' if so.
  3066.  
  3067.         LD      HL,L0A11 - 6    ; address 0A0B - the base address of control
  3068.                                 ; character table - where zero would be.
  3069.         LD      E,A             ; control character 06 - 23d
  3070.         LD      D,$00           ; is transferred to DE.
  3071.  
  3072.         ADD     HL,DE           ; index into table.
  3073.  
  3074.         LD      E,(HL)          ; fetch the offset to routine.
  3075.         ADD     HL,DE           ; add to make HL the address.
  3076.         PUSH    HL              ; push the address.
  3077.         JP      L0B03           ; to PO-FETCH, as the screen/printer position
  3078.                                 ; has been disturbed, and indirectly to
  3079.                                 ; routine on stack.
  3080.  
  3081. ; -----------------------
  3082. ; Control character table
  3083. ; -----------------------
  3084. ; For control characters in the range 6 - 23d the following table
  3085. ; is indexed to provide an offset to the handling routine that
  3086. ; follows the table.
  3087.  
  3088. ;; ctlchrtab
  3089. L0A11:  DB    L0A5F - $       ; 06d offset $4E to Address: PO-COMMA
  3090.         DB    L0A69 - $       ; 07d offset $57 to Address: PO-QUEST
  3091.         DB    L0A23 - $       ; 08d offset $10 to Address: PO-BACK-1
  3092.         DB    L0A3D - $       ; 09d offset $29 to Address: PO-RIGHT
  3093.         DB    L0A69 - $       ; 10d offset $54 to Address: PO-QUEST
  3094.         DB    L0A69 - $       ; 11d offset $53 to Address: PO-QUEST
  3095.         DB    L0A69 - $       ; 12d offset $52 to Address: PO-QUEST
  3096.         DB    L0A4F - $       ; 13d offset $37 to Address: PO-ENTER
  3097.         DB    L0A69 - $       ; 14d offset $50 to Address: PO-QUEST
  3098.         DB    L0A69 - $       ; 15d offset $4F to Address: PO-QUEST
  3099.         DB    L0A7A - $       ; 16d offset $5F to Address: PO-1-OPER
  3100.         DB    L0A7A - $       ; 17d offset $5E to Address: PO-1-OPER
  3101.         DB    L0A7A - $       ; 18d offset $5D to Address: PO-1-OPER
  3102.         DB    L0A7A - $       ; 19d offset $5C to Address: PO-1-OPER
  3103.         DB    L0A7A - $       ; 20d offset $5B to Address: PO-1-OPER
  3104.         DB    L0A7A - $       ; 21d offset $5A to Address: PO-1-OPER
  3105.         DB    L0A75 - $       ; 22d offset $54 to Address: PO-2-OPER
  3106.         DB    L0A75 - $       ; 23d offset $53 to Address: PO-2-OPER
  3107.  
  3108.  
  3109. ; -------------------
  3110. ; Cursor left routine
  3111. ; -------------------
  3112. ; Backspace and up a line if that action is from the left of screen.
  3113. ; For ZX printer backspace up to first column but not beyond.
  3114.  
  3115. ;; PO-BACK-1
  3116. L0A23:  INC     C               ; move left one column.
  3117.         LD      A,$22           ; value $21 is leftmost column.
  3118.         CP      C               ; have we passed ?
  3119.         JR      NZ,L0A3A        ; to PO-BACK-3 if not and store new position.
  3120.  
  3121.         BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
  3122.         JR      NZ,L0A38        ; to PO-BACK-2 if so, as we are unable to
  3123.                                 ; backspace from the leftmost position.
  3124.  
  3125.  
  3126.         INC     B               ; move up one screen line
  3127.         LD      C,$02           ; the rightmost column position.
  3128.         LD      A,$18           ; Note. This should be $19
  3129.                                 ; credit. Dr. Frank O'Hara, 1982
  3130.  
  3131.         CP      B               ; has position moved past top of screen ?
  3132.         JR      NZ,L0A3A        ; to PO-BACK-3 if not and store new position.
  3133.  
  3134.         DEC     B               ; else back to $18.
  3135.  
  3136. ;; PO-BACK-2
  3137. L0A38:  LD      C,$21           ; the leftmost column position.
  3138.  
  3139. ;; PO-BACK-3
  3140. L0A3A:  JP      L0DD9           ; to CL-SET and PO-STORE to save new
  3141.                                 ; position in system variables.
  3142.  
  3143. ; --------------------
  3144. ; Cursor right routine
  3145. ; --------------------
  3146. ; This moves the print position to the right leaving a trail in the
  3147. ; current background colour.
  3148. ; "However the programmer has failed to store the new print position
  3149. ;  so CHR$ 9 will only work if the next print position is at a newly
  3150. ;  defined place.
  3151. ;   e.g. PRINT PAPER 2; CHR$ 9; AT 4,0;
  3152. ;  does work but is not very helpful"
  3153. ; - Dr. Ian Logan, Understanding Your Spectrum, 1982.
  3154.  
  3155. ;; PO-RIGHT
  3156. L0A3D:  LD      A,($5C91)       ; fetch P_FLAG value
  3157.         PUSH    AF              ; and save it on stack.
  3158.  
  3159.         LD      (IY+$57),$01    ; temporarily set P_FLAG 'OVER 1'.
  3160.         LD      A,$20           ; prepare a space.
  3161.         CALL    L0B65           ; routine PO-CHAR to print it.
  3162.                                 ; Note. could be PO-ABLE which would update
  3163.                                 ; the column position.
  3164.  
  3165.         POP     AF              ; restore the permanent flag.
  3166.         LD      ($5C91),A       ; and restore system variable P_FLAG
  3167.  
  3168.         RET                     ; return without updating column position
  3169.  
  3170. ; -----------------------
  3171. ; Perform carriage return
  3172. ; -----------------------
  3173. ; A carriage return is 'printed' to screen or printer buffer.
  3174.  
  3175. ;; PO-ENTER
  3176. L0A4F:  BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
  3177.         JP      NZ,L0ECD        ; to COPY-BUFF if so, to flush buffer and reset
  3178.                                 ; the print position.
  3179.  
  3180.         LD      C,$21           ; the leftmost column position.
  3181.         CALL    L0C55           ; routine PO-SCR handles any scrolling required.
  3182.         DEC     B               ; to next screen line.
  3183.         JP      L0DD9           ; jump forward to CL-SET to store new position.
  3184.  
  3185. ; -----------
  3186. ; Print comma
  3187. ; -----------
  3188. ; The comma control character. The 32 column screen has two 16 character
  3189. ; tabstops.  The routine is only reached via the control character table.
  3190.  
  3191. ;; PO-COMMA
  3192. L0A5F:  CALL    L0B03           ; routine PO-FETCH - seems unnecessary.
  3193.  
  3194.         LD      A,C             ; the column position. $21-$01
  3195.         DEC     A               ; move right. $20-$00
  3196.         DEC     A               ; and again   $1F-$00 or $FF if trailing
  3197.         AND     $10             ; will be $00 or $10.
  3198.         JR      L0AC3           ; forward to PO-FILL
  3199.  
  3200. ; -------------------
  3201. ; Print question mark
  3202. ; -------------------
  3203. ; This routine prints a question mark which is commonly
  3204. ; used to print an unassigned control character in range 0-31d.
  3205. ; there are a surprising number yet to be assigned.
  3206.  
  3207. ;; PO-QUEST
  3208. L0A69:  LD      A,$3F           ; prepare the character '?'.
  3209.         JR      L0AD9           ; forward to PO-ABLE.
  3210.  
  3211. ; --------------------------------
  3212. ; Control characters with operands
  3213. ; --------------------------------
  3214. ; Certain control characters are followed by 1 or 2 operands.
  3215. ; The entry points from control character table are PO-2-OPER and PO-1-OPER.
  3216. ; The routines alter the output address of the current channel so that
  3217. ; subsequent RST $10 instructions take the appropriate action
  3218. ; before finally resetting the output address back to PRINT-OUT.
  3219.  
  3220. ;; PO-TV-2
  3221. L0A6D:  LD      DE,L0A87        ; address: PO-CONT will be next output routine
  3222.         LD      ($5C0F),A       ; store first operand in TVDATA-hi
  3223.         JR      L0A80           ; forward to PO-CHANGE >>
  3224.  
  3225. ; ---
  3226.  
  3227. ; -> This initial entry point deals with two operands - AT or TAB.
  3228.  
  3229. ;; PO-2-OPER
  3230. L0A75:  LD      DE,L0A6D        ; address: PO-TV-2 will be next output routine
  3231.         JR      L0A7D           ; forward to PO-TV-1
  3232.  
  3233. ; ---
  3234.  
  3235. ; -> This initial entry point deals with one operand INK to OVER.
  3236.  
  3237. ;; PO-1-OPER
  3238. L0A7A:  LD      DE,L0A87        ; address: PO-CONT will be next output routine
  3239.  
  3240. ;; PO-TV-1
  3241. L0A7D:  LD      ($5C0E),A       ; store control code in TVDATA-lo
  3242.  
  3243. ;; PO-CHANGE
  3244. L0A80:  LD      HL,($5C51)      ; use CURCHL to find current output channel.
  3245.         LD      (HL),E          ; make it
  3246.         INC     HL              ; the supplied
  3247.         LD      (HL),D          ; address from DE.
  3248.         RET                     ; return.
  3249.  
  3250. ; ---
  3251.  
  3252. ;; PO-CONT
  3253. L0A87:  LD      DE,L09F4        ; Address: PRINT-OUT
  3254.         CALL    L0A80           ; routine PO-CHANGE to restore normal channel.
  3255.         LD      HL,($5C0E)      ; TVDATA gives control code and possible
  3256.                                 ; subsequent character
  3257.         LD      D,A             ; save current character
  3258.         LD      A,L             ; the stored control code
  3259.         CP      $16             ; was it INK to OVER (1 operand) ?
  3260.         JP      C,L2211         ; to CO-TEMP-5
  3261.  
  3262.         JR      NZ,L0AC2        ; to PO-TAB if not 22d i.e. 23d TAB.
  3263.  
  3264.                                 ; else must have been 22d AT.
  3265.         LD      B,H             ; line to H   (0-23d)
  3266.         LD      C,D             ; column to C (0-31d)
  3267.         LD      A,$1F           ; the value 31d
  3268.         SUB     C               ; reverse the column number.
  3269.         JR      C,L0AAC         ; to PO-AT-ERR if C was greater than 31d.
  3270.  
  3271.         ADD     A,$02           ; transform to system range $02-$21
  3272.         LD      C,A             ; and place in column register.
  3273.  
  3274.         BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
  3275.         JR      NZ,L0ABF        ; to PO-AT-SET as line can be ignored.
  3276.  
  3277.         LD      A,$16           ; 22 decimal
  3278.         SUB     B               ; subtract line number to reverse
  3279.                                 ; 0 - 22 becomes 22 - 0.
  3280.  
  3281. ;; PO-AT-ERR
  3282. L0AAC:  JP      C,L1E9F         ; to REPORT-B if higher than 22 decimal
  3283.                                 ; Integer out of range.
  3284.  
  3285.         INC     A               ; adjust for system range $01-$17
  3286.         LD      B,A             ; place in line register
  3287.         INC     B               ; adjust to system range  $02-$18
  3288.         BIT     0,(IY+$02)      ; TV_FLAG  - Lower screen in use ?
  3289.         JP      NZ,L0C55        ; exit to PO-SCR to test for scrolling
  3290.  
  3291.         CP      (IY+$31)        ; Compare against DF_SZ
  3292.         JP      C,L0C86         ; to REPORT-5 if too low
  3293.                                 ; Out of screen.
  3294.  
  3295. ;; PO-AT-SET
  3296. L0ABF:  JP      L0DD9           ; print position is valid so exit via CL-SET
  3297.  
  3298. ; Continue here when dealing with TAB.
  3299. ; Note. In BASIC, TAB is followed by a 16-bit number and was initially
  3300. ; designed to work with any output device.
  3301.  
  3302. ;; PO-TAB
  3303. L0AC2:  LD      A,H             ; transfer parameter to A
  3304.                                 ; Losing current character -
  3305.                                 ; High byte of TAB parameter.
  3306.  
  3307.  
  3308. ;; PO-FILL
  3309. L0AC3:  CALL    L0B03           ; routine PO-FETCH, HL-addr, BC=line/column.
  3310.                                 ; column 1 (right), $21 (left)
  3311.         ADD     A,C             ; add operand to current column
  3312.         DEC     A               ; range 0 - 31+
  3313.         AND     $1F             ; make range 0 - 31d
  3314.         RET     Z               ; return if result zero
  3315.  
  3316.         LD      D,A             ; Counter to D
  3317.         SET     0,(IY+$01)      ; update FLAGS  - signal suppress leading space.
  3318.  
  3319. ;; PO-SPACE
  3320. L0AD0:  LD      A,$20           ; space character.
  3321.         CALL    L0C3B           ; routine PO-SAVE prints the character
  3322.                                 ; using alternate set (normal output routine)
  3323.         DEC     D               ; decrement counter.
  3324.         JR      NZ,L0AD0        ; to PO-SPACE until done
  3325.  
  3326.         RET                     ; return
  3327.  
  3328. ; ----------------------
  3329. ; Printable character(s)
  3330. ; ----------------------
  3331. ; This routine prints printable characters and continues into
  3332. ; the position store routine
  3333.  
  3334. ;; PO-ABLE
  3335. L0AD9:  CALL    L0B24           ; routine PO-ANY
  3336.                                 ; and continue into position store routine.
  3337.  
  3338. ; -------------------------------------
  3339. ; Store line, column, and pixel address
  3340. ; -------------------------------------
  3341. ; This routine updates the system variables associated with
  3342. ; The main screen, lower screen/input buffer or ZX printer.
  3343.  
  3344. ;; PO-STORE
  3345. L0ADC:  BIT     1,(IY+$01)      ; test FLAGS  - Is printer in use ?
  3346.         JR      NZ,L0AFC        ; to PO-ST-PR if so
  3347.  
  3348.         BIT     0,(IY+$02)      ; TV_FLAG  - Lower screen in use ?
  3349.         JR      NZ,L0AF0        ; to PO-ST-E if so
  3350.  
  3351.         LD      ($5C88),BC      ; S_POSN line/column upper screen
  3352.         LD      ($5C84),HL      ; DF_CC  display file address
  3353.         RET                     ;
  3354.  
  3355. ; ---
  3356.  
  3357. ;; PO-ST-E
  3358. L0AF0:  LD      ($5C8A),BC      ; SPOSNL line/column lower screen
  3359.         LD      ($5C82),BC      ; ECHO_E line/column input buffer
  3360.         LD      ($5C86),HL      ; DFCCL  lower screen memory address
  3361.         RET                     ;
  3362.  
  3363. ; ---
  3364.  
  3365. ;; PO-ST-PR
  3366. L0AFC:  LD      (IY+$45),C      ; P_POSN column position printer
  3367.         LD      ($5C80),HL      ; PR_CC  full printer buffer memory address
  3368.         RET                     ;
  3369.  
  3370. ; -------------------------
  3371. ; Fetch position parameters
  3372. ; -------------------------
  3373. ; This routine fetches the line/column and display file address
  3374. ; of the upper and lower screen or, if the printer is in use,
  3375. ; the column position and absolute memory address.
  3376. ; Note. that PR-CC-hi (23681) is used by this routine and the one above
  3377. ; and if, in accordance with the manual (that says this is unused), the
  3378. ; location has been used for other purposes, then subsequent output
  3379. ; to the printer buffer could corrupt a 256-byte section of memory.
  3380.  
  3381. ;; PO-FETCH
  3382. L0B03:  BIT     1,(IY+$01)      ; test FLAGS  - Is printer in use
  3383.         JR      NZ,L0B1D        ; to PO-F-PR if so
  3384.  
  3385.                                 ; assume upper screen
  3386.         LD      BC,($5C88)      ; S_POSN
  3387.         LD      HL,($5C84)      ; DF_CC display file address
  3388.         BIT     0,(IY+$02)      ; TV_FLAG  - Lower screen in use ?
  3389.         RET     Z               ; return if upper screen
  3390.  
  3391.                                 ; ah well, was lower screen
  3392.         LD      BC,($5C8A)      ; SPOSNL
  3393.         LD      HL,($5C86)      ; DFCCL
  3394.         RET                     ; return
  3395.  
  3396. ; ---
  3397.  
  3398. ;; PO-F-PR
  3399. L0B1D:  LD      C,(IY+$45)      ; P_POSN column only
  3400.         LD      HL,($5C80)      ; PR_CC printer buffer address
  3401.         RET                     ; return
  3402.  
  3403. ; -------------------
  3404. ; Print any character
  3405. ; -------------------
  3406. ; This routine is used to print any character in range 32d - 255d
  3407. ; It is only called from PO-ABLE which continues into PO-STORE
  3408.  
  3409. ;; PO-ANY
  3410. L0B24:  CP      $80             ; ASCII ?
  3411.         JR      C,L0B65         ; to PO-CHAR is so.
  3412.  
  3413.         CP      $90             ; test if a block graphic character.
  3414.         JR      NC,L0B52        ; to PO-T&UDG to print tokens and udg's
  3415.  
  3416. ; The 16 2*2 mosaic characters 128-143 decimal are formed from
  3417. ; bits 0-3 of the character.
  3418.  
  3419.         LD      B,A             ; save character
  3420.         CALL    L0B38           ; routine PO-GR-1 to construct top half
  3421.                                 ; then bottom half.
  3422.         CALL    L0B03           ; routine PO-FETCH fetches print position.
  3423.         LD      DE,$5C92        ; MEM-0 is location of 8 bytes of character
  3424.         JR      L0B7F           ; to PR-ALL to print to screen or printer
  3425.  
  3426. ; ---
  3427.  
  3428. ;; PO-GR-1
  3429. L0B38:  LD      HL,$5C92        ; address MEM-0 - a temporary buffer in
  3430.                                 ; systems variables which is normally used
  3431.                                 ; by the calculator.
  3432.         CALL    L0B3E           ; routine PO-GR-2 to construct top half
  3433.                                 ; and continue into routine to construct
  3434.                                 ; bottom half.
  3435.  
  3436. ;; PO-GR-2
  3437. L0B3E:  RR      B               ; rotate bit 0/2 to carry
  3438.         SBC     A,A             ; result $00 or $FF
  3439.         AND     $0F             ; mask off right hand side
  3440.         LD      C,A             ; store part in C
  3441.         RR      B               ; rotate bit 1/3 of original chr to carry
  3442.         SBC     A,A             ; result $00 or $FF
  3443.         AND     $F0             ; mask off left hand side
  3444.         OR      C               ; combine with stored pattern
  3445.         LD      C,$04           ; four bytes for top/bottom half
  3446.  
  3447. ;; PO-GR-3
  3448. L0B4C:  LD      (HL),A          ; store bit patterns in temporary buffer
  3449.         INC     HL              ; next address
  3450.         DEC     C               ; jump back to
  3451.         JR      NZ,L0B4C        ; to PO-GR-3 until byte is stored 4 times
  3452.  
  3453.         RET                     ; return
  3454.  
  3455. ; ---
  3456.  
  3457. ; Tokens and User defined graphics are now separated.
  3458.  
  3459. ;; PO-T&UDG
  3460. L0B52           IF BAS48_ONLY
  3461.                 SUB 0XA5
  3462.                 JR NC,L0B5F
  3463.                 ELSE
  3464.                 JP L3B9F                ;Spectrum 128 patch
  3465.                 NOP
  3466.                 ENDIF
  3467.  
  3468. L0B56:  ADD     A,$15           ; add 21d to restore to 0 - 20
  3469.         PUSH    BC              ; save current print position
  3470.         LD      BC,($5C7B)      ; fetch UDG to address bit patterns
  3471.         JR      L0B6A           ; to PO-CHAR-2 - common code to lay down
  3472.                                 ; a bit patterned character
  3473.  
  3474. ; ---
  3475.  
  3476. ;; PO-T
  3477. L0B5F:  CALL    L0C10           ; routine PO-TOKENS prints tokens
  3478.         JP      L0B03           ; exit via a JUMP to PO-FETCH as this routine
  3479.                                 ; must continue into PO-STORE.
  3480.                                 ; A JR instruction could be used.
  3481.  
  3482. ; This point is used to print ASCII characters  32d - 127d.
  3483.  
  3484. ;; PO-CHAR
  3485. L0B65:  PUSH    BC              ; save print position
  3486.         LD      BC,($5C36)      ; address CHARS
  3487.  
  3488. ; This common code is used to transfer the character bytes to memory.
  3489.  
  3490. ;; PO-CHAR-2
  3491. L0B6A:  EX      DE,HL           ; transfer destination address to DE
  3492.         LD      HL,$5C3B        ; point to FLAGS
  3493.         RES     0,(HL)          ; allow for leading space
  3494.         CP      $20             ; is it a space ?
  3495.         JR      NZ,L0B76        ; to PO-CHAR-3 if not
  3496.  
  3497.         SET     0,(HL)          ; signal no leading space to FLAGS
  3498.  
  3499. ;; PO-CHAR-3
  3500. L0B76:  LD      H,$00           ; set high byte to 0
  3501.         LD      L,A             ; character to A
  3502.                                 ; 0-21 UDG or 32-127 ASCII.
  3503.         ADD     HL,HL           ; multiply
  3504.         ADD     HL,HL           ; by
  3505.         ADD     HL,HL           ; eight
  3506.         ADD     HL,BC           ; HL now points to first byte of character
  3507.         POP     BC              ; the source address CHARS or UDG
  3508.         EX      DE,HL           ; character address to DE
  3509.  
  3510. ; --------------------
  3511. ; Print all characters
  3512. ; --------------------
  3513. ; This entry point entered from above to print ASCII and UDGs
  3514. ; but also from earlier to print mosaic characters.
  3515. ; HL=destination
  3516. ; DE=character source
  3517. ; BC=line/column
  3518.  
  3519. ;; PR-ALL
  3520. L0B7F:  LD      A,C             ; column to A
  3521.         DEC     A               ; move right
  3522.         LD      A,$21           ; pre-load with leftmost position
  3523.         JR      NZ,L0B93        ; but if not zero to PR-ALL-1
  3524.  
  3525.         DEC     B               ; down one line
  3526.         LD      C,A             ; load C with $21
  3527.         BIT     1,(IY+$01)      ; test FLAGS  - Is printer in use
  3528.         JR      Z,L0B93         ; to PR-ALL-1 if not
  3529.  
  3530.         PUSH    DE              ; save source address
  3531.         CALL    L0ECD           ; routine COPY-BUFF outputs line to printer
  3532.         POP     DE              ; restore character source address
  3533.         LD      A,C             ; the new column number ($21) to C
  3534.  
  3535. ;; PR-ALL-1
  3536. L0B93:  CP      C               ; this test is really for screen - new line ?
  3537.         PUSH    DE              ; save source
  3538.  
  3539.         CALL    Z,L0C55         ; routine PO-SCR considers scrolling
  3540.  
  3541.         POP     DE              ; restore source
  3542.         PUSH    BC              ; save line/column
  3543.         PUSH    HL              ; and destination
  3544.         LD      A,($5C91)       ; fetch P_FLAG to accumulator
  3545.         LD      B,$FF           ; prepare OVER mask in B.
  3546.         RRA                     ; bit 0 set if OVER 1
  3547.         JR      C,L0BA4         ; to PR-ALL-2
  3548.  
  3549.         INC     B               ; set OVER mask to 0
  3550.  
  3551. ;; PR-ALL-2
  3552. L0BA4:  RRA                     ; skip bit 1 of P_FLAG
  3553.         RRA                     ; bit 2 is INVERSE
  3554.         SBC     A,A             ; will be FF for INVERSE 1 else zero
  3555.         LD      C,A             ; transfer INVERSE mask to C
  3556.         LD      A,$08           ; prepare to count 8 bytes
  3557.         AND     A               ; clear carry to signal screen
  3558.         BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
  3559.         JR      Z,L0BB6         ; to PR-ALL-3 if screen
  3560.  
  3561.         SET     1,(IY+$30)      ; update FLAGS2  - signal printer buffer has
  3562.                                 ; been used.
  3563.         SCF                     ; set carry flag to signal printer.
  3564.  
  3565. ;; PR-ALL-3
  3566. L0BB6:  EX      DE,HL           ; now HL=source, DE=destination
  3567.  
  3568. ;; PR-ALL-4
  3569. L0BB7:  EX      AF,AF'          ; save printer/screen flag
  3570.        LD      A,(DE)          ; fetch existing destination byte
  3571.        AND     B               ; consider OVER
  3572.        XOR     (HL)            ; now XOR with source
  3573.        XOR     C               ; now with INVERSE MASK
  3574.        LD      (DE),A          ; update screen/printer
  3575.        EX      AF,AF'          ; restore flag
  3576.         JR      C,L0BD3         ; to PR-ALL-6 - printer address update
  3577.  
  3578.         INC     D               ; gives next pixel line down screen
  3579.  
  3580. ;; PR-ALL-5
  3581. L0BC1:  INC     HL              ; address next character byte
  3582.         DEC     A               ; the byte count is decremented
  3583.         JR      NZ,L0BB7        ; back to PR-ALL-4 for all 8 bytes
  3584.  
  3585.         EX      DE,HL           ; destination to HL
  3586.         DEC     H               ; bring back to last updated screen position
  3587.         BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
  3588.         CALL    Z,L0BDB         ; if not, call routine PO-ATTR to update
  3589.                                 ; corresponding colour attribute.
  3590.         POP     HL              ; restore original screen/printer position
  3591.         POP     BC              ; and line column
  3592.         DEC     C               ; move column to right
  3593.         INC     HL              ; increase screen/printer position
  3594.         RET                     ; return and continue into PO-STORE
  3595.                                 ; within PO-ABLE
  3596.  
  3597. ; ---
  3598.  
  3599. ; This branch is used to update the printer position by 32 places
  3600. ; Note. The high byte of the address D remains constant (which it should).
  3601.  
  3602. ;; PR-ALL-6
  3603. L0BD3:  EX      AF,AF'          ; save the flag
  3604.        LD      A,$20           ; load A with 32 decimal
  3605.        ADD     A,E             ; add this to E
  3606.        LD      E,A             ; and store result in E
  3607.        EX      AF,AF'          ; fetch the flag
  3608.         JR      L0BC1           ; back to PR-ALL-5
  3609.  
  3610. ; -------------
  3611. ; Set attribute
  3612. ; -------------
  3613. ; This routine is entered with the HL register holding the last screen
  3614. ; address to be updated by PRINT or PLOT.
  3615. ; The Spectrum screen arrangement leads to the L register holding
  3616. ; the correct value for the attribute file and it is only necessary
  3617. ; to manipulate H to form the correct colour attribute address.
  3618.  
  3619. ;; PO-ATTR
  3620. L0BDB:  LD       A,H            ; fetch high byte $40 - $57
  3621.         RRCA                    ; shift
  3622.         RRCA                    ; bits 3 and 4
  3623.         RRCA                    ; to right.
  3624.         AND     $03             ; range is now 0 - 2
  3625.         OR      $58             ; form correct high byte for third of screen
  3626.         LD      H,A             ; HL is now correct
  3627.         LD      DE,($5C8F)      ; make D hold ATTR_T, E hold MASK-T
  3628.         LD      A,(HL)          ; fetch existing attribute
  3629.         XOR     E               ; apply masks
  3630.         AND     D               ;
  3631.         XOR     E               ;
  3632.         BIT     6,(IY+$57)      ; test P_FLAG  - is this PAPER 9 ??
  3633.         JR      Z,L0BFA         ; skip to PO-ATTR-1 if not.
  3634.  
  3635.         AND     $C7             ; set paper
  3636.         BIT     2,A             ; to contrast with ink
  3637.         JR      NZ,L0BFA        ; skip to PO-ATTR-1
  3638.  
  3639.         XOR     $38             ;
  3640.  
  3641. ;; PO-ATTR-1
  3642. L0BFA:  BIT     4,(IY+$57)      ; test P_FLAG  - Is this INK 9 ??
  3643.         JR      Z,L0C08         ; skip to PO-ATTR-2 if not
  3644.  
  3645.         AND     $F8             ; make ink
  3646.         BIT     5,A             ; contrast with paper.
  3647.         JR      NZ,L0C08        ; to PO-ATTR-2
  3648.  
  3649.         XOR     $07             ;
  3650.  
  3651. ;; PO-ATTR-2
  3652. L0C08:  LD      (HL),A          ; save the new attribute.
  3653.         RET                     ; return.
  3654.  
  3655. ; ----------------
  3656. ; Message printing
  3657. ; ----------------
  3658. ; This entry point is used to print tape, boot-up, scroll? and error messages
  3659. ; On entry the DE register points to an initial step-over byte or
  3660. ; the inverted end-marker of the previous entry in the table.
  3661. ; A contains the message number, often zero to print first message.
  3662. ; (HL has nothing important usually P_FLAG)
  3663.  
  3664. ;; PO-MSG
  3665. L0C0A:  PUSH    HL              ; put hi-byte zero on stack to suppress
  3666.         LD      H,$00           ; trailing spaces
  3667.         EX      (SP),HL         ; ld h,0; push hl would have done ?.
  3668.         JR      L0C14           ; forward to PO-TABLE.
  3669.  
  3670. ; ---
  3671.  
  3672. ; This entry point prints the BASIC keywords, '<>' etc. from alt set
  3673.  
  3674. ;; PO-TOKENS
  3675. L0C10:  LD      DE,L0095        ; address: TKN-TABLE
  3676.         PUSH    AF              ; save the token number to control
  3677.                                 ; trailing spaces - see later *
  3678.  
  3679. ;; PO-TABLE
  3680. L0C14:  CALL    L0C41           ; routine PO-SEARCH will set carry for
  3681.                                 ; all messages and function words.
  3682. L0C17:  JR      C,L0C22         ; forward to PO-EACH if not a command,
  3683.                                 ; '<>' etc.
  3684.  
  3685.         LD      A,$20           ; prepare leading space
  3686.         BIT     0,(IY+$01)      ; test FLAGS  - leading space if not set
  3687.         CALL    Z,L0C3B         ; routine PO-SAVE to print a space
  3688.                                 ; without disturbing registers
  3689.  
  3690. ;; PO-EACH
  3691. L0C22:  LD      A,(DE)          ; fetch character
  3692.         AND     $7F             ; remove any inverted bit
  3693.         CALL    L0C3B           ; routine PO-SAVE to print using alternate
  3694.                                 ; set of registers.
  3695.         LD      A,(DE)          ; re-fetch character.
  3696.         INC     DE              ; address next
  3697.         ADD     A,A             ; was character inverted ?
  3698.                                 ; (this also doubles character)
  3699.         JR      NC,L0C22        ; back to PO-EACH if not
  3700.  
  3701.         POP     DE              ; * re-fetch trailing space flag to D (was A)
  3702.         CP      $48             ; was last character '$' ($24*2)
  3703.         JR      Z,L0C35         ; forward to PO-TR-SP to consider trailing
  3704.                                 ; space if so.
  3705.  
  3706.         CP      $82             ; was it < 'A' i.e. '#','>','=' from tokens
  3707.                                 ; or ' ','.' (from tape) or '?' from scroll
  3708.         RET     C               ; no trailing space
  3709.  
  3710. ;; PO-TR-SP
  3711. L0C35:  LD      A,D             ; the trailing space flag (zero if an error msg)
  3712.         CP      $03             ; test against RND, INKEY$ and PI
  3713.                                 ; which have no parameters and
  3714.         RET     C               ; therefore no trailing space so return.
  3715.  
  3716.         LD      A,$20           ; else continue and print a trailing space.
  3717.  
  3718. ; -------------------------
  3719. ; Handle recursive printing
  3720. ; -------------------------
  3721. ; This routine which is part of PRINT-OUT allows RST $10 to be
  3722. ; used recursively to print tokens and the spaces associated with them.
  3723.  
  3724. ;; PO-SAVE
  3725. L0C3B:  PUSH    DE              ; save DE as CALL-SUB doesn't.
  3726.         EXX                     ; switch in main set
  3727.  
  3728.         RST     10H             ; PRINT-A prints using this alternate set.
  3729.  
  3730.         EXX                     ; back to this alternate set.
  3731.         POP     DE              ; restore initial DE.
  3732.         RET                     ; return.
  3733.  
  3734. ; ------------
  3735. ; Table search
  3736. ; ------------
  3737. ; This subroutine searches a message or the token table for the
  3738. ; message number held in A. DE holds the address of the table.
  3739.  
  3740. ;; PO-SEARCH
  3741. L0C41:  PUSH    AF              ; save the message/token number
  3742.         EX      DE,HL           ; transfer DE to HL
  3743.         INC     A               ; adjust for initial step-over byte
  3744.  
  3745. ;; PO-STEP
  3746. L0C44:  BIT     7,(HL)          ; is character inverted ?
  3747.         INC     HL              ; address next
  3748.         JR      Z,L0C44         ; back to PO-STEP if not inverted.
  3749.  
  3750.         DEC     A               ; decrease counter
  3751.         JR      NZ,L0C44        ; back to PO-STEP if not zero
  3752.  
  3753.         EX      DE,HL           ; transfer address to DE
  3754.         POP     AF              ; restore message/token number
  3755.         CP      $20             ; return with carry set
  3756.         RET     C               ; for all messages and function tokens
  3757.  
  3758.         LD      A,(DE)          ; test first character of token
  3759.         SUB     $41             ; and return with carry set
  3760.         RET                     ; if it is less that 'A'
  3761.                                 ; i.e. '<>', '<=', '>='
  3762.  
  3763. ; ---------------
  3764. ; Test for scroll
  3765. ; ---------------
  3766. ; This test routine is called when printing carriage return, when considering
  3767. ; PRINT AT and from the general PRINT ALL characters routine to test if
  3768. ; scrolling is required, prompting the user if necessary.
  3769. ; This is therefore using the alternate set.
  3770. ; The B register holds the current line.
  3771.  
  3772. ;; PO-SCR
  3773. L0C55:  BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
  3774.         RET     NZ              ; return immediately if so.
  3775.  
  3776.         LD      DE,L0DD9        ; set DE to address: CL-SET
  3777.         PUSH    DE              ; and push for return address.
  3778.         LD      A,B             ; transfer the line to A.
  3779.         BIT     0,(IY+$02)      ; test TV_FLAG  - Lower screen in use ?
  3780.         JP      NZ,L0D02        ; jump forward to PO-SCR-4 if so.
  3781.  
  3782.         CP      (IY+$31)        ; greater than DF_SZ display file size ?
  3783.         JR      C,L0C86         ; forward to REPORT-5 if less.
  3784.                                 ; 'Out of screen'
  3785.  
  3786.         RET     NZ              ; return (via CL-SET) if greater
  3787.  
  3788.         BIT     4,(IY+$02)      ; test TV_FLAG  - Automatic listing ?
  3789.         JR      Z,L0C88         ; forward to PO-SCR-2 if not.
  3790.  
  3791.         LD      E,(IY+$2D)      ; fetch BREG - the count of scroll lines to E.
  3792.         DEC     E               ; decrease and jump
  3793.         JR      Z,L0CD2         ; to PO-SCR-3 if zero and scrolling required.
  3794.  
  3795.         LD      A,$00           ; explicit - select channel zero.
  3796.         CALL    L1601           ; routine CHAN-OPEN opens it.
  3797.  
  3798.         LD      SP,($5C3F)      ; set stack pointer to LIST_SP
  3799.  
  3800.         RES     4,(IY+$02)      ; reset TV_FLAG  - signal auto listing finished.
  3801.         RET                     ; return ignoring pushed value, CL-SET
  3802.                                 ; to MAIN or EDITOR without updating
  3803.                                 ; print position                         ->
  3804.  
  3805. ; ---
  3806.  
  3807.  
  3808. ;; REPORT-5
  3809. L0C86:  RST     08H             ; ERROR-1
  3810.         DB    $04             ; Error Report: Out of screen
  3811.  
  3812. ; continue here if not an automatic listing.
  3813.  
  3814. ;; PO-SCR-2
  3815. L0C88:  DEC     (IY+$52)        ; decrease SCR_CT
  3816.         JR      NZ,L0CD2        ; forward to PO-SCR-3 to scroll display if
  3817.                                 ; result not zero.
  3818.  
  3819. ; now produce prompt.
  3820.  
  3821.         LD      A,$18           ; reset
  3822.         SUB     B               ; the
  3823.         LD      ($5C8C),A       ; SCR_CT scroll count
  3824.         LD      HL,($5C8F)      ; L=ATTR_T, H=MASK_T
  3825.         PUSH    HL              ; save on stack
  3826.         LD      A,($5C91)       ; P_FLAG
  3827.         PUSH    AF              ; save on stack to prevent lower screen
  3828.                                 ; attributes (BORDCR etc.) being applied.
  3829.         LD      A,$FD           ; select system channel 'K'
  3830.         CALL    L1601           ; routine CHAN-OPEN opens it
  3831.         XOR     A               ; clear to address message directly
  3832.         LD      DE,L0CF8        ; make DE address: scrl-mssg
  3833.         CALL    L0C0A           ; routine PO-MSG prints to lower screen
  3834.         SET     5,(IY+$02)      ; set TV_FLAG  - signal lower screen requires
  3835.                                 ; clearing
  3836.         LD      HL,$5C3B        ; make HL address FLAGS
  3837.         SET     3,(HL)          ; signal 'L' mode.
  3838.         RES     5,(HL)          ; signal 'no new key'.
  3839.         EXX                     ; switch to main set.
  3840.                                 ; as calling chr input from alternative set.
  3841.         CALL    L15D4           ; routine WAIT-KEY waits for new key
  3842.                                 ; Note. this is the right routine but the
  3843.                                 ; stream in use is unsatisfactory. From the
  3844.                                 ; choices available, it is however the best.
  3845.  
  3846.         EXX                     ; switch back to alternate set.
  3847.         CP      $20             ; space is considered as BREAK
  3848.         JR      Z,L0D00         ; forward to REPORT-D if so
  3849.                                 ; 'BREAK - CONT repeats'
  3850.  
  3851.         CP      $E2             ; is character 'STOP' ?
  3852.         JR      Z,L0D00         ; forward to REPORT-D if so
  3853.  
  3854.         OR      $20             ; convert to lower-case
  3855.         CP      $6E             ; is character 'n' ?
  3856.         JR      Z,L0D00         ; forward to REPORT-D if so else scroll.
  3857.  
  3858.         LD      A,$FE           ; select system channel 'S'
  3859.         CALL    L1601           ; routine CHAN-OPEN
  3860.         POP     AF              ; restore original P_FLAG
  3861.         LD      ($5C91),A       ; and save in P_FLAG.
  3862.         POP     HL              ; restore original ATTR_T, MASK_T
  3863.         LD      ($5C8F),HL      ; and reset ATTR_T, MASK-T as 'scroll?' has
  3864.                                 ; been printed.
  3865.  
  3866. ;; PO-SCR-3
  3867. L0CD2:  CALL    L0DFE           ; routine CL-SC-ALL to scroll whole display
  3868.         LD      B,(IY+$31)      ; fetch DF_SZ to B
  3869.         INC     B               ; increase to address last line of display
  3870.         LD      C,$21           ; set C to $21 (was $21 from above routine)
  3871.         PUSH    BC              ; save the line and column in BC.
  3872.  
  3873.         CALL    L0E9B           ; routine CL-ADDR finds display address.
  3874.  
  3875.         LD      A,H             ; now find the corresponding attribute byte
  3876.         RRCA                    ; (this code sequence is used twice
  3877.         RRCA                    ; elsewhere and is a candidate for
  3878.         RRCA                    ; a subroutine.)
  3879.         AND     $03             ;
  3880.         OR      $58             ;
  3881.         LD      H,A             ;
  3882.  
  3883.         LD      DE,$5AE0        ; start of last 'line' of attribute area
  3884.         LD      A,(DE)          ; get attribute for last line
  3885.         LD      C,(HL)          ; transfer to base line of upper part
  3886.         LD      B,$20           ; there are thirty two bytes
  3887.         EX      DE,HL           ; swap the pointers.
  3888.  
  3889. ;; PO-SCR-3A
  3890. L0CF0:  LD      (DE),A          ; transfer
  3891.         LD      (HL),C          ; attributes.
  3892.         INC     DE              ; address next.
  3893.         INC     HL              ; address next.
  3894.         DJNZ    L0CF0           ; loop back to PO-SCR-3A for all adjacent
  3895.                                 ; attribute lines.
  3896.  
  3897.         POP     BC              ; restore the line/column.
  3898.         RET                     ; return via CL-SET (was pushed on stack).
  3899.  
  3900. ; ---
  3901.  
  3902. ; The message 'scroll?' appears here with last byte inverted.
  3903.  
  3904. ;; scrl-mssg
  3905. L0CF8           DB $80             ; initial step-over byte.
  3906.                 DC "scroll?"    ;DEFM    "scroll"
  3907.                                 ;DB    '?'+$80
  3908.  
  3909. ;; REPORT-D
  3910. L0D00:  RST     08H             ; ERROR-1
  3911.         DB    $0C             ; Error Report: BREAK - CONT repeats
  3912.  
  3913. ; continue here if using lower display - A holds line number.
  3914.  
  3915. ;; PO-SCR-4
  3916. L0D02:  CP      $02             ; is line number less than 2 ?
  3917.         JR      C,L0C86         ; to REPORT-5 if so
  3918.                                 ; 'Out of Screen'.
  3919.  
  3920.         ADD     A,(IY+$31)      ; add DF_SZ
  3921.         SUB     $19             ;
  3922.         RET     NC              ; return if scrolling unnecessary
  3923.  
  3924.         NEG                     ; Negate to give number of scrolls required.
  3925.         PUSH    BC              ; save line/column
  3926.         LD      B,A             ; count to B
  3927.         LD      HL,($5C8F)      ; fetch current ATTR_T, MASK_T to HL.
  3928.         PUSH    HL              ; and save
  3929.         LD      HL,($5C91)      ; fetch P_FLAG
  3930.         PUSH    HL              ; and save.
  3931.                                 ; to prevent corruption by input AT
  3932.  
  3933.         CALL    L0D4D           ; routine TEMPS sets to BORDCR etc
  3934.         LD      A,B             ; transfer scroll number to A.
  3935.  
  3936. ;; PO-SCR-4A
  3937. L0D1C:  PUSH    AF              ; save scroll number.
  3938.         LD      HL,$5C6B        ; address DF_SZ
  3939.         LD      B,(HL)          ; fetch old value
  3940.         LD      A,B             ; transfer to A
  3941.         INC     A               ; and increment
  3942.         LD      (HL),A          ; then put back.
  3943.         LD      HL,$5C89        ; address S_POSN_hi - line
  3944.         CP      (HL)            ; compare
  3945.         JR      C,L0D2D         ; forward to PO-SCR-4B if scrolling required
  3946.  
  3947.         INC     (HL)            ; else increment S_POSN_hi
  3948.         LD      B,$18           ; set count to whole display ??
  3949.                                 ; Note. should be $17 and the top line
  3950.                                 ; will be scrolled into the ROM which
  3951.                                 ; is harmless on the standard set up.
  3952.  
  3953. ;; PO-SCR-4B
  3954. L0D2D:  CALL    L0E00           ; routine CL-SCROLL scrolls B lines
  3955.         POP     AF              ; restore scroll counter.
  3956.         DEC     A               ; decrease
  3957.         JR      NZ,L0D1C        ; back to to PO-SCR-4A until done
  3958.  
  3959.         POP     HL              ; restore original P_FLAG.
  3960.         LD      (IY+$57),L      ; and overwrite system variable P_FLAG.
  3961.  
  3962.         POP     HL              ; restore original ATTR_T/MASK_T.
  3963.         LD      ($5C8F),HL      ; and update system variables.
  3964.  
  3965.         LD      BC,($5C88)      ; fetch S_POSN to BC.
  3966.         RES     0,(IY+$02)      ; signal to TV_FLAG  - main screen in use.
  3967.         CALL    L0DD9           ; call routine CL-SET for upper display.
  3968.  
  3969.         SET     0,(IY+$02)      ; signal to TV_FLAG  - lower screen in use.
  3970.         POP     BC              ; restore line/column
  3971.         RET                     ; return via CL-SET for lower display.
  3972.  
  3973. ; ----------------------
  3974. ; Temporary colour items
  3975. ; ----------------------
  3976. ; This subroutine is called 11 times to copy the permanent colour items
  3977. ; to the temporary ones.
  3978.  
  3979. ;; TEMPS
  3980. L0D4D:  XOR     A               ; clear the accumulator
  3981.         LD      HL,($5C8D)      ; fetch L=ATTR_P and H=MASK_P
  3982.         BIT     0,(IY+$02)      ; test TV_FLAG  - is lower screen in use ?
  3983.         JR      Z,L0D5B         ; skip to TEMPS-1 if not
  3984.  
  3985.         LD      H,A             ; set H, MASK P, to 00000000.
  3986.         LD      L,(IY+$0E)      ; fetch BORDCR to L which is used for lower
  3987.                                 ; screen.
  3988.  
  3989. ;; TEMPS-1
  3990. L0D5B:  LD      ($5C8F),HL      ; transfer values to ATTR_T and MASK_T
  3991.  
  3992. ; for the print flag the permanent values are odd bits, temporary even bits.
  3993.  
  3994.         LD      HL,$5C91        ; address P_FLAG.
  3995.         JR      NZ,L0D65        ; skip to TEMPS-2 if lower screen using A=0.
  3996.  
  3997.         LD      A,(HL)          ; else pick up flag bits.
  3998.         RRCA                    ; rotate permanent bits to temporary bits.
  3999.  
  4000. ;; TEMPS-2
  4001. L0D65:  XOR     (HL)            ;
  4002.         AND     $55             ; BIN 01010101
  4003.         XOR     (HL)            ; permanent now as original
  4004.         LD      (HL),A          ; apply permanent bits to temporary bits.
  4005.         RET                     ; and return.
  4006.  
  4007. ; ------------------
  4008. ; Handle CLS command
  4009. ; ------------------
  4010. ; clears the display.
  4011. ; if it's difficult to write it should be difficult to read.
  4012.  
  4013. ;; CLS
  4014. L0D6B:  CALL    L0DAF           ; routine CL-ALL  clears display and
  4015.                                 ; resets attributes to permanent.
  4016.                                 ; re-attaches it to this computer.
  4017.  
  4018. ; this routine called from INPUT, **
  4019.  
  4020. ;; CLS-LOWER
  4021. L0D6E:  LD      HL,$5C3C        ; address System Variable TV_FLAG.
  4022.         RES     5,(HL)          ; TV_FLAG - signal do not clear lower screen.
  4023.         SET     0,(HL)          ; TV_FLAG - signal lower screen in use.
  4024.         CALL    L0D4D           ; routine TEMPS picks up temporary colours.
  4025.         LD      B,(IY+$31)      ; fetch lower screen DF_SZ
  4026.         CALL    L0E44           ; routine CL-LINE clears lower part
  4027.                                 ; and sets permanent attributes.
  4028.  
  4029.         LD      HL,$5AC0        ; fetch attribute address leftmost cell,
  4030.                                 ; second line up.
  4031.         LD      A,($5C8D)       ; fetch permanent attribute from ATTR_P.
  4032.         DEC     B               ; decrement lower screen display file size
  4033.         JR      L0D8E           ; forward to CLS-3 ->
  4034.  
  4035. ; ---
  4036.  
  4037. ;; CLS-1
  4038. L0D87:  LD      C,$20           ; set counter to 32 characters per line
  4039.  
  4040. ;; CLS-2
  4041. L0D89:  DEC     HL              ; decrease attribute address.
  4042.         LD      (HL),A          ; and place attributes in next line up.
  4043.         DEC     C               ; decrease 32 counter.
  4044.         JR      NZ,L0D89        ; loop back to CLS-2 until all 32 done.
  4045.  
  4046. ;; CLS-3
  4047. L0D8E:  DJNZ    L0D87           ; decrease B counter and back to CLS-1
  4048.                                 ; if not zero.
  4049.  
  4050.         LD      (IY+$31),$02    ; set DF_SZ lower screen to 2
  4051.  
  4052. ; This entry point is called from CL-ALL below to
  4053. ; reset the system channel input and output addresses to normal.
  4054.  
  4055. ;; CL-CHAN
  4056. L0D94:  LD      A,$FD           ; select system channel 'K'
  4057.         CALL    L1601           ; routine CHAN-OPEN opens it.
  4058.         LD      HL,($5C51)      ; fetch CURCHL to HL to address current channel
  4059.         LD      DE,L09F4        ; set address to PRINT-OUT for first pass.
  4060.         AND     A               ; clear carry for first pass.
  4061.  
  4062. ;; CL-CHAN-A
  4063. L0DA0:  LD      (HL),E          ; insert output address first pass.
  4064.         INC     HL              ; or input address on second pass.
  4065.         LD      (HL),D          ;
  4066.         INC     HL              ;
  4067.         LD      DE,L10A8        ; fetch address KEY-INPUT for second pass
  4068.         CCF                     ; complement carry flag - will set on pass 1.
  4069.  
  4070.         JR      C,L0DA0         ; back to CL-CHAN-A if first pass else done.
  4071.  
  4072.         LD      BC,$1721        ; line 23 for lower screen
  4073.         JR      L0DD9           ; exit via CL-SET to set column
  4074.                                 ; for lower display
  4075.  
  4076. ; ---------------------------
  4077. ; Clearing whole display area
  4078. ; ---------------------------
  4079. ; This subroutine called from CLS, AUTO-LIST and MAIN-3
  4080. ; clears 24 lines of the display and resets the relevant system variables
  4081. ; and system channels.
  4082.  
  4083. ;; CL-ALL
  4084. L0DAF:  LD      HL,$0000        ; initialize plot coordinates.
  4085.         LD      ($5C7D),HL      ; set COORDS to 0,0.
  4086.         RES     0,(IY+$30)      ; update FLAGS2  - signal main screen is clear.
  4087.  
  4088.         CALL    L0D94           ; routine CL-CHAN makes channel 'K' 'normal'.
  4089.  
  4090.         LD      A,$FE           ; select system channel 'S'
  4091.         CALL    L1601           ; routine CHAN-OPEN opens it
  4092.         CALL    L0D4D           ; routine TEMPS picks up permanent values.
  4093.         LD      B,$18           ; There are 24 lines.
  4094.         CALL    L0E44           ; routine CL-LINE clears 24 text lines
  4095.                                 ; (and sets BC to $1821)
  4096.  
  4097.         LD      HL,($5C51)      ; fetch CURCHL make HL address current
  4098.                                 ; channel 'S'
  4099.         LD      DE,L09F4        ; address: PRINT-OUT
  4100.         LD      (HL),E          ; is made
  4101.         INC     HL              ; the normal
  4102.         LD      (HL),D          ; output address.
  4103.  
  4104.         LD      (IY+$52),$01    ; set SCR_CT - scroll count is set to default.
  4105.                                 ; Note. BC already contains $1821.
  4106.         LD      BC,$1821        ; reset column and line to 0,0
  4107.                                 ; and continue into CL-SET, below, exiting
  4108.                                 ; via PO-STORE (for upper screen).
  4109.  
  4110. ; ---------------------------
  4111. ; Set line and column numbers
  4112. ; ---------------------------
  4113. ; This important subroutine is used to calculate the character output
  4114. ; address for screens or printer based on the line/column for screens
  4115. ; or the column for printer.
  4116.  
  4117. ;; CL-SET
  4118. L0DD9:  LD      HL,$5B00        ; the base address of printer buffer
  4119.         BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
  4120.         JR      NZ,L0DF4        ; forward to CL-SET-2 if so.
  4121.  
  4122.         LD      A,B             ; transfer line to A.
  4123.         BIT     0,(IY+$02)      ; test TV_FLAG  - lower screen in use ?
  4124.         JR      Z,L0DEE         ; skip to CL-SET-1 if handling upper part
  4125.  
  4126.         ADD     A,(IY+$31)      ; add DF_SZ for lower screen
  4127.         SUB     $18             ; and adjust.
  4128.  
  4129. ;; CL-SET-1
  4130. L0DEE:  PUSH    BC              ; save the line/column.
  4131.         LD      B,A             ; transfer line to B
  4132.                                 ; (adjusted if lower screen)
  4133.  
  4134.         CALL    L0E9B           ; routine CL-ADDR calculates address at left
  4135.                                 ; of screen.
  4136.         POP     BC              ; restore the line/column.
  4137.  
  4138. ;; CL-SET-2
  4139. L0DF4:  LD      A,$21           ; the column $1-$21 is reversed
  4140.         SUB     C               ; to range $00 - $20
  4141.         LD      E,A             ; now transfer to DE
  4142.         LD      D,$00           ; prepare for addition
  4143.         ADD     HL,DE           ; and add to base address
  4144.         JP      L0ADC           ; exit via PO-STORE to update relevant
  4145.                                 ; system variables.
  4146. ; ----------------
  4147. ; Handle scrolling
  4148. ; ----------------
  4149. ; The routine CL-SC-ALL is called once from PO to scroll all the display
  4150. ; and from the routine CL-SCROLL, once, to scroll part of the display.
  4151.  
  4152. ;; CL-SC-ALL
  4153. L0DFE:  LD      B,$17           ; scroll 23 lines, after 'scroll?'.
  4154.  
  4155. ;; CL-SCROLL
  4156. L0E00:  CALL    L0E9B           ; routine CL-ADDR gets screen address in HL.
  4157.         LD      C,$08           ; there are 8 pixel lines to scroll.
  4158.  
  4159. ;; CL-SCR-1
  4160. L0E05:  PUSH    BC              ; save counters.
  4161.         PUSH    HL              ; and initial address.
  4162.         LD      A,B             ; get line count.
  4163.         AND     $07             ; will set zero if all third to be scrolled.
  4164.         LD      A,B             ; re-fetch the line count.
  4165.         JR      NZ,L0E19        ; forward to CL-SCR-3 if partial scroll.
  4166.  
  4167. ; HL points to top line of third and must be copied to bottom of previous 3rd.
  4168. ; ( so HL = $4800 or $5000 ) ( but also sometimes $4000 )
  4169.  
  4170. ;; CL-SCR-2
  4171. L0E0D:  EX      DE,HL           ; copy HL to DE.
  4172.         LD      HL,$F8E0        ; subtract $08 from H and add $E0 to L -
  4173.         ADD     HL,DE           ; to make destination bottom line of previous
  4174.                                 ; third.
  4175.         EX      DE,HL           ; restore the source and destination.
  4176.         LD      BC,$0020        ; thirty-two bytes are to be copied.
  4177.         DEC     A               ; decrement the line count.
  4178.         LDIR                    ; copy a pixel line to previous third.
  4179.  
  4180. ;; CL-SCR-3
  4181. L0E19:  EX      DE,HL           ; save source in DE.
  4182.         LD      HL,$FFE0        ; load the value -32.
  4183.         ADD     HL,DE           ; add to form destination in HL.
  4184.         EX      DE,HL           ; switch source and destination
  4185.         LD      B,A             ; save the count in B.
  4186.         AND     $07             ; mask to find count applicable to current
  4187.         RRCA                    ; third and
  4188.         RRCA                    ; multiply by
  4189.         RRCA                    ; thirty two (same as 5 RLCAs)
  4190.  
  4191.         LD      C,A             ; transfer byte count to C ($E0 at most)
  4192.         LD      A,B             ; store line count to A
  4193.         LD      B,$00           ; make B zero
  4194.         LDIR                    ; copy bytes (BC=0, H incremented, L=0)
  4195.         LD      B,$07           ; set B to 7, C is zero.
  4196.         ADD     HL,BC           ; add 7 to H to address next third.
  4197.         AND     $F8             ; has last third been done ?
  4198.         JR      NZ,L0E0D        ; back to CL-SCR-2 if not
  4199.  
  4200.         POP     HL              ; restore topmost address.
  4201.         INC     H               ; next pixel line down.
  4202.         POP     BC              ; restore counts.
  4203.         DEC     C               ; reduce pixel line count.
  4204.         JR      NZ,L0E05        ; back to CL-SCR-1 if all eight not done.
  4205.  
  4206.         CALL    L0E88           ; routine CL-ATTR gets address in attributes
  4207.                                 ; from current 'ninth line', count in BC.
  4208.         LD      HL,$FFE0        ; set HL to the 16-bit value -32.
  4209.         ADD     HL,DE           ; and add to form destination address.
  4210.         EX      DE,HL           ; swap source and destination addresses.
  4211.         LDIR                    ; copy bytes scrolling the linear attributes.
  4212.         LD      B,$01           ; continue to clear the bottom line.
  4213.  
  4214. ; ---------------------------
  4215. ; Clear text lines of display
  4216. ; ---------------------------
  4217. ; This subroutine, called from CL-ALL, CLS-LOWER and AUTO-LIST and above,
  4218. ; clears text lines at bottom of display.
  4219. ; The B register holds on entry the number of lines to be cleared 1-24.
  4220.  
  4221. ;; CL-LINE
  4222. L0E44:  PUSH    BC              ; save line count
  4223.         CALL    L0E9B           ; routine CL-ADDR gets top address
  4224.         LD      C,$08           ; there are eight screen lines to a text line.
  4225.  
  4226. ;; CL-LINE-1
  4227. L0E4A:  PUSH    BC              ; save pixel line count
  4228.         PUSH    HL              ; and save the address
  4229.         LD      A,B             ; transfer the line to A (1-24).
  4230.  
  4231. ;; CL-LINE-2
  4232. L0E4D:  AND     $07             ; mask 0-7 to consider thirds at a time
  4233.         RRCA                    ; multiply
  4234.         RRCA                    ; by 32  (same as five RLCA instructions)
  4235.         RRCA                    ; now 32 - 256(0)
  4236.         LD      C,A             ; store result in C
  4237.         LD      A,B             ; save line in A (1-24)
  4238.         LD      B,$00           ; set high byte to 0, prepare for ldir.
  4239.         DEC     C               ; decrement count 31-255.
  4240.         LD      D,H             ; copy HL
  4241.         LD      E,L             ; to DE.
  4242.         LD      (HL),$00        ; blank the first byte.
  4243.         INC     DE              ; make DE point to next byte.
  4244.         LDIR                    ; ldir will clear lines.
  4245.         LD      DE,$0701        ; now address next third adjusting
  4246.         ADD     HL,DE           ; register E to address left hand side
  4247.         DEC     A               ; decrease the line count.
  4248.         AND     $F8             ; will be 16, 8 or 0  (AND $18 will do).
  4249.         LD      B,A             ; transfer count to B.
  4250.         JR      NZ,L0E4D        ; back to CL-LINE-2 if 16 or 8 to do
  4251.                                 ; the next third.
  4252.  
  4253.         POP     HL              ; restore start address.
  4254.         INC     H               ; address next line down.
  4255.         POP     BC              ; fetch counts.
  4256.         DEC     C               ; decrement pixel line count
  4257.         JR      NZ,L0E4A        ; back to CL-LINE-1 till all done.
  4258.  
  4259.         CALL    L0E88           ; routine CL-ATTR gets attribute address
  4260.                                 ; in DE and B * 32 in BC.
  4261.         LD      H,D             ; transfer the address
  4262.         LD      L,E             ; to HL.
  4263.  
  4264.         INC     DE              ; make DE point to next location.
  4265.  
  4266.         LD      A,($5C8D)       ; fetch ATTR_P - permanent attributes
  4267.         BIT     0,(IY+$02)      ; test TV_FLAG  - lower screen in use ?
  4268.         JR      Z,L0E80         ; skip to CL-LINE-3 if not.
  4269.  
  4270.         LD      A,($5C48)       ; else lower screen uses BORDCR as attribute.
  4271.  
  4272. ;; CL-LINE-3
  4273. L0E80:  LD      (HL),A          ; put attribute in first byte.
  4274.         DEC     BC              ; decrement the counter.
  4275.         LDIR                    ; copy bytes to set all attributes.
  4276.         POP     BC              ; restore the line $01-$24.
  4277.         LD      C,$21           ; make column $21. (No use is made of this)
  4278.         RET                     ; return to the calling routine.
  4279.  
  4280. ; ------------------
  4281. ; Attribute handling
  4282. ; ------------------
  4283. ; This subroutine is called from CL-LINE or CL-SCROLL with the HL register
  4284. ; pointing to the 'ninth' line and H needs to be decremented before or after
  4285. ; the division. Had it been done first then either present code or that used
  4286. ; at the start of PO-ATTR could have been used.
  4287. ; The Spectrum screen arrangement leads to the L register holding already
  4288. ; the correct value for the attribute file and it is only necessary
  4289. ; to manipulate H to form the correct colour attribute address.
  4290.  
  4291. ;; CL-ATTR
  4292. L0E88:  LD      A,H             ; fetch H to A - $48, $50, or $58.
  4293.         RRCA                    ; divide by
  4294.         RRCA                    ; eight.
  4295.         RRCA                    ; $09, $0A or $0B.
  4296.         DEC     A               ; $08, $09 or $0A.
  4297.         OR      $50             ; $58, $59 or $5A.
  4298.         LD      H,A             ; save high byte of attributes.
  4299.  
  4300.         EX      DE,HL           ; transfer attribute address to DE
  4301.         LD      H,C             ; set H to zero - from last LDIR.
  4302.         LD      L,B             ; load L with the line from B.
  4303.         ADD     HL,HL           ; multiply
  4304.         ADD     HL,HL           ; by
  4305.         ADD     HL,HL           ; thirty two
  4306.         ADD     HL,HL           ; to give count of attribute
  4307.         ADD     HL,HL           ; cells to end of display.
  4308.  
  4309.         LD      B,H             ; transfer result
  4310.         LD      C,L             ; to register BC.
  4311.  
  4312.         RET                     ; and return.
  4313.  
  4314. ; -------------------------------
  4315. ; Handle display with line number
  4316. ; -------------------------------
  4317. ; This subroutine is called from four places to calculate the address
  4318. ; of the start of a screen character line which is supplied in B.
  4319.  
  4320. ;; CL-ADDR
  4321. L0E9B:  LD      A,$18           ; reverse the line number
  4322.         SUB     B               ; to range $00 - $17.
  4323.         LD      D,A             ; save line in D for later.
  4324.         RRCA                    ; multiply
  4325.         RRCA                    ; by
  4326.         RRCA                    ; thirty-two.
  4327.  
  4328.         AND     $E0             ; mask off low bits to make
  4329.         LD      L,A             ; L a multiple of 32.
  4330.  
  4331.         LD      A,D             ; bring back the line to A.
  4332.  
  4333.         AND     $18             ; now $00, $08 or $10.
  4334.  
  4335.         OR      $40             ; add the base address of screen.
  4336.  
  4337.         LD      H,A             ; HL now has the correct address.
  4338.         RET                     ; return.
  4339.  
  4340. ; -------------------
  4341. ; Handle COPY command
  4342. ; -------------------
  4343. ; This command copies the top 176 lines to the ZX Printer
  4344. ; It is popular to call this from machine code at point
  4345. ; L0EAF with B holding 192 (and interrupts disabled) for a full-screen
  4346. ; copy. This particularly applies to 16K Spectrums as time-critical
  4347. ; machine code routines cannot be written in the first 16K of RAM as
  4348. ; it is shared with the ULA which has precedence over the Z80 chip.
  4349.  
  4350. ;; COPY
  4351.  
  4352. L0EAC:  DI                      ; disable interrupts as this is time-critical.
  4353. ;===============================
  4354.                 IF AY_PRINTER
  4355.                 RST 0X08
  4356.                 DB AY_PRN_SCR
  4357.                 JP L0EDA
  4358.                 ELSE
  4359.                 LD B,$B0                ; top 176 lines.
  4360. L0EAF           LD HL,$4000             ; address start of the display file.
  4361.                 ENDIF
  4362. ;===============================
  4363.  
  4364. ; now enter a loop to handle each pixel line.
  4365.  
  4366. ;; COPY-1
  4367. L0EB2:  PUSH    HL              ; save the screen address.
  4368.         PUSH    BC              ; and the line counter.
  4369.  
  4370.         CALL    L0EF4           ; routine COPY-LINE outputs one line.
  4371.  
  4372.         POP     BC              ; restore the line counter.
  4373.         POP     HL              ; and display address.
  4374.         INC     H               ; next line down screen within 'thirds'.
  4375.         LD      A,H             ; high byte to A.
  4376.         AND     $07             ; result will be zero if we have left third.
  4377.         JR      NZ,L0EC9        ; forward to COPY-2 if not to continue loop.
  4378.  
  4379.         LD      A,L             ; consider low byte first.
  4380.         ADD     A,$20           ; increase by 32 - sets carry if back to zero.
  4381.         LD      L,A             ; will be next group of 8.
  4382.         CCF                     ; complement - carry set if more lines in
  4383.                                 ; the previous third.
  4384.         SBC     A,A             ; will be FF, if more, else 00.
  4385.         AND     $F8             ; will be F8 (-8) or 00.
  4386.         ADD     A,H             ; that is subtract 8, if more to do in third.
  4387.         LD      H,A             ; and reset address.
  4388.  
  4389. ;; COPY-2
  4390. L0EC9:  DJNZ    L0EB2           ; back to COPY-1 for all lines.
  4391.  
  4392.         JR      L0EDA           ; forward to COPY-END to switch off the printer
  4393.                                 ; motor and enable interrupts.
  4394.                                 ; Note. Nothing else required.
  4395.  
  4396. ; ------------------------------
  4397. ; Pass printer buffer to printer
  4398. ; ------------------------------
  4399. ; This routine is used to copy 8 text lines from the printer buffer
  4400. ; to the ZX Printer. These text lines are mapped linearly so HL does
  4401. ; not need to be adjusted at the end of each line.
  4402.  
  4403. ;; COPY-BUFF
  4404. L0ECD:  DI                      ; disable interrupts
  4405.         LD      HL,$5B00        ; the base address of the Printer Buffer.
  4406.         LD      B,$08           ; set count to 8 lines of 32 bytes.
  4407.  
  4408. ;; COPY-3
  4409. L0ED3:  PUSH    BC              ; save counter.
  4410.         CALL    L0EF4           ; routine COPY-LINE outputs 32 bytes
  4411.         POP     BC              ; restore counter.
  4412.         DJNZ    L0ED3           ; loop back to COPY-3 for all 8 lines.
  4413.                                 ; then stop motor and clear buffer.
  4414.  
  4415. ; Note. the COPY command rejoins here, essentially to execute the next
  4416. ; three instructions.
  4417.  
  4418. ;===============================
  4419. ;; COPY-END
  4420. L0EDA           IF AY_PRINTER
  4421.                 DUPL 4,0
  4422.                 ELSE
  4423.                 LD A,$04                ; output value 4 to port
  4424.                 OUT ($FB),A             ; to stop the slowed printer motor.
  4425.                 ENDIF
  4426.                 EI                      ; enable interrupts.
  4427. ;===============================
  4428.  
  4429. ; --------------------
  4430. ; Clear Printer Buffer
  4431. ; --------------------
  4432. ; This routine clears an arbitrary 256 bytes of memory.
  4433. ; Note. The routine seems designed to clear a buffer that follows the
  4434. ; system variables.
  4435. ; The routine should check a flag or HL address and simply return if COPY
  4436. ; is in use.
  4437. ; (T-ADDR-lo would work for the system but not if COPY called externally.)
  4438. ; As a consequence of this omission the buffer will needlessly
  4439. ; be cleared when COPY is used and the screen/printer position may be set to
  4440. ; the start of the buffer and the line number to 0 (B)
  4441. ; giving an 'Out of Screen' error.
  4442. ; There seems to have been an unsuccessful attempt to circumvent the use
  4443. ; of PR_CC_hi.
  4444.  
  4445. ;; CLEAR-PRB
  4446. L0EDF:  LD      HL,$5B00        ; the location of the buffer.
  4447.         LD      (IY+$46),L      ; update PR_CC_lo - set to zero - superfluous.
  4448.         XOR     A               ; clear the accumulator.
  4449.         LD      B,A             ; set count to 256 bytes.
  4450.  
  4451. ;; PRB-BYTES
  4452. L0EE7:  LD      (HL),A          ; set addressed location to zero.
  4453.         INC     HL              ; address next byte - Note. not INC L.
  4454.         DJNZ    L0EE7           ; back to PRB-BYTES. repeat for 256 bytes.
  4455.  
  4456.         RES     1,(IY+$30)      ; set FLAGS2 - signal printer buffer is clear.
  4457.         LD      C,$21           ; set the column position .
  4458.         JP      L0DD9           ; exit via CL-SET and then PO-STORE.
  4459.  
  4460. ; -----------------
  4461. ; Copy line routine
  4462. ; -----------------
  4463. ; This routine is called from COPY and COPY-BUFF to output a line of
  4464. ; 32 bytes to the ZX Printer.
  4465. ; Output to port $FB -
  4466. ; bit 7 set - activate stylus.
  4467. ; bit 7 low - deactivate stylus.
  4468. ; bit 2 set - stops printer.
  4469. ; bit 2 reset - starts printer
  4470. ; bit 1 set - slows printer.
  4471. ; bit 1 reset - normal speed.
  4472.  
  4473. ;; COPY-LINE
  4474. ;===============================
  4475. L0EF4           IF AY_PRINTER
  4476.                 LD A,(HL)
  4477.                 RST 0X08
  4478.                 DB AY_PRN_A_
  4479.                 RET
  4480.  
  4481. PRN_TOKEN       RST 0X08
  4482.                 DB AY_PRN_TOKEN
  4483.                 RET
  4484.                 NOP
  4485.                 ELSE
  4486.                 LD A,B                  ; fetch the counter 1-8 or 1-176
  4487.                 CP $03                  ; is it 01 or 02 ?.
  4488.                 SBC A,A                 ; result is $FF if so else $00.
  4489.                 AND $02                 ; result is 02 now else 00.
  4490.                                         ; bit 1 set slows the printer.
  4491.                 OUT ($FB),A             ; slow the printer for the
  4492.                                         ; last two lines.
  4493.                 ENDIF
  4494. ;===============================
  4495.         LD      D,A             ; save the mask to control the printer later.
  4496.  
  4497. ;; COPY-L-1
  4498. L0EFD:  CALL    L1F54           ; call BREAK-KEY to read keyboard immediately.
  4499.         JR      C,L0F0C         ; forward to COPY-L-2 if 'break' not pressed.
  4500.  
  4501.         LD      A,$04           ; else stop the
  4502.         OUT     ($FB),A         ; printer motor.
  4503.         EI                      ; enable interrupts.
  4504.         CALL    L0EDF           ; call routine CLEAR-PRB.
  4505.                                 ; Note. should not be cleared if COPY in use.
  4506.  
  4507. ;; REPORT-Dc
  4508. L0F0A:  RST     08H             ; ERROR-1
  4509.         DB      $0C             ; Error Report: BREAK - CONT repeats
  4510.  
  4511. ;; COPY-L-2
  4512. L0F0C:  IN      A,($FB)         ; test now to see if
  4513.         ADD     A,A             ; a printer is attached.
  4514.         RET     M               ; return if not - but continue with parent
  4515.                                 ; command.
  4516.  
  4517.         JR      NC,L0EFD        ; back to COPY-L-1 if stylus of printer not
  4518.                                 ; in position.
  4519.  
  4520.         LD      C,$20           ; set count to 32 bytes.
  4521.  
  4522. ;; COPY-L-3
  4523. L0F14:  LD      E,(HL)          ; fetch a byte from line.
  4524.         INC     HL              ; address next location. Note. not INC L.
  4525.         LD      B,$08           ; count the bits.
  4526.  
  4527. ;; COPY-L-4
  4528. L0F18:  RL      D               ; prepare mask to receive bit.
  4529.         RL      E               ; rotate leftmost print bit to carry
  4530.         RR      D               ; and back to bit 7 of D restoring bit 1
  4531.  
  4532. ;; COPY-L-5
  4533. L0F1E:  IN      A,($FB)         ; read the port.
  4534.         RRA                     ; bit 0 to carry.
  4535.         JR      NC,L0F1E        ; back to COPY-L-5 if stylus not in position.
  4536.  
  4537.         LD      A,D             ; transfer command bits to A.
  4538.         OUT     ($FB),A         ; and output to port.
  4539.         DJNZ    L0F18           ; loop back to COPY-L-4 for all 8 bits.
  4540.  
  4541.         DEC     C               ; decrease the byte count.
  4542.         JR      NZ,L0F14        ; back to COPY-L-3 until 256 bits done.
  4543.  
  4544.         RET                     ; return to calling routine COPY/COPY-BUFF.
  4545.  
  4546. ; ----------------------------------
  4547. ; Editor routine for BASIC and INPUT
  4548. ; ----------------------------------
  4549. ; The editor is called to prepare or edit a BASIC line.
  4550. ; It is also called from INPUT to input a numeric or string expression.
  4551. ; The behaviour and options are quite different in the various modes
  4552. ; and distinguished by bit 5 of FLAGX.
  4553. ;
  4554. ; This is a compact and highly versatile routine.
  4555.  
  4556. ;; EDITOR
  4557. L0F2C:  LD      HL,($5C3D)      ; fetch ERR_SP
  4558.         PUSH    HL              ; save on stack
  4559.  
  4560. ;; ED-AGAIN
  4561. L0F30:  LD      HL,L107F        ; address: ED-ERROR
  4562.         PUSH    HL              ; save address on stack and
  4563.         LD      ($5C3D),SP      ; make ERR_SP point to it.
  4564.  
  4565. ; Note. While in editing/input mode should an error occur then RST 08 will
  4566. ; update X_PTR to the location reached by CH_ADD and jump to ED-ERROR
  4567. ; where the error will be cancelled and the loop begin again from ED-AGAIN
  4568. ; above. The position of the error will be apparent when the lower screen is
  4569. ; reprinted. If no error then the re-iteration is to ED-LOOP below when
  4570. ; input is arriving from the keyboard.
  4571.  
  4572. ;; ED-LOOP
  4573. L0F38:  CALL    L15D4           ; routine WAIT-KEY gets key possibly
  4574.                                 ; changing the mode.
  4575.         PUSH    AF              ; save key.
  4576.         LD      D,$00           ; and give a short click based
  4577.         LD      E,(IY-$01)      ; on PIP value for duration.
  4578.         LD      HL,$00C8        ; and pitch.
  4579.         CALL    L03B5           ; routine BEEPER gives click - effective
  4580.                                 ; with rubber keyboard.
  4581.         POP     AF              ; get saved key value.
  4582.         LD      HL,L0F38        ; address: ED-LOOP is loaded to HL.
  4583.         PUSH    HL              ; and pushed onto stack.
  4584.  
  4585. ; At this point there is a looping return address on the stack, an error
  4586. ; handler and an input stream set up to supply characters.
  4587. ; The character that has been received can now be processed.
  4588.  
  4589.         CP      $18             ; range 24 to 255 ?
  4590.         JR      NC,L0F81        ; forward to ADD-CHAR if so.
  4591.  
  4592.         CP      $07             ; lower than 7 ?
  4593.         JR      C,L0F81         ; forward to ADD-CHAR also.
  4594.                                 ; Note. This is a 'bug' and chr$ 6, the comma
  4595.                                 ; control character, should have had an
  4596.                                 ; entry in the ED-KEYS table.
  4597.                                 ; Steven Vickers, 1984, Pitman.
  4598.  
  4599.         CP      $10             ; less than 16 ?
  4600.         JR      C,L0F92         ; forward to ED-KEYS if editing control
  4601.                                 ; range 7 to 15 dealt with by a table
  4602.  
  4603.         LD      BC,$0002        ; prepare for ink/paper etc.
  4604.         LD      D,A             ; save character in D
  4605.         CP      $16             ; is it ink/paper/bright etc. ?
  4606.         JR      C,L0F6C         ; forward to ED-CONTR if so
  4607.  
  4608.                                 ; leaves 22d AT and 23d TAB
  4609.                                 ; which can't be entered via KEY-INPUT.
  4610.                                 ; so this code is never normally executed
  4611.                                 ; when the keyboard is used for input.
  4612.  
  4613.         INC     BC              ; if it was AT/TAB - 3 locations required
  4614.         BIT     7,(IY+$37)      ; test FLAGX  - Is this INPUT LINE ?
  4615.         JP      Z,L101E         ; jump to ED-IGNORE if not, else
  4616.  
  4617.         CALL    L15D4           ; routine WAIT-KEY - input address is KEY-NEXT
  4618.                                 ; but is reset to KEY-INPUT
  4619.         LD      E,A             ; save first in E
  4620.  
  4621. ;; ED-CONTR
  4622. L0F6C:  CALL    L15D4           ; routine WAIT-KEY for control.
  4623.                                 ; input address will be key-next.
  4624.  
  4625.         PUSH    DE              ; saved code/parameters
  4626.         LD      HL,($5C5B)      ; fetch address of keyboard cursor from K_CUR
  4627.         RES     0,(IY+$07)      ; set MODE to 'L'
  4628.  
  4629.         CALL    L1655           ; routine MAKE-ROOM makes 2/3 spaces at cursor
  4630.  
  4631.         POP     BC              ; restore code/parameters
  4632.         INC     HL              ; address first location
  4633.         LD      (HL),B          ; place code (ink etc.)
  4634.         INC     HL              ; address next
  4635.         LD      (HL),C          ; place possible parameter. If only one
  4636.                                 ; then DE points to this location also.
  4637.         JR      L0F8B           ; forward to ADD-CH-1
  4638.  
  4639. ; ------------------------
  4640. ; Add code to current line
  4641. ; ------------------------
  4642. ; this is the branch used to add normal non-control characters
  4643. ; with ED-LOOP as the stacked return address.
  4644. ; it is also the OUTPUT service routine for system channel 'R'.
  4645.  
  4646. ;; ADD-CHAR
  4647. L0F81:  RES     0,(IY+$07)      ; set MODE to 'L'
  4648.  
  4649. X0F85:  LD      HL,($5C5B)      ; fetch address of keyboard cursor from K_CUR
  4650.         CALL    L1652           ; routine ONE-SPACE creates one space.
  4651.  
  4652. ; either a continuation of above or from ED-CONTR with ED-LOOP on stack.
  4653.  
  4654. ;; ADD-CH-1
  4655. L0F8B:  LD      (DE),A          ; load current character to last new location.
  4656.         INC     DE              ; address next
  4657.         LD      ($5C5B),DE      ; and update K_CUR system variable.
  4658.         RET                     ; return - either a simple return
  4659.                                 ; from ADD-CHAR or to ED-LOOP on stack.
  4660.  
  4661. ; ---
  4662.  
  4663. ; a branch of the editing loop to deal with control characters
  4664. ; using a look-up table.
  4665.  
  4666. ;; ED-KEYS
  4667. L0F92:  LD      E,A             ; character to E.
  4668.         LD      D,$00           ; prepare to add.
  4669.         LD      HL,L0FA0 - 7    ; base address of editing keys table. $0F99
  4670.         ADD     HL,DE           ; add E
  4671.         LD      E,(HL)          ; fetch offset to E
  4672.         ADD     HL,DE           ; add offset for address of handling routine.
  4673.         PUSH    HL              ; push the address on machine stack.
  4674.         LD      HL,($5C5B)      ; load address of cursor from K_CUR.
  4675.         RET                     ; an make an indirect jump forward to routine.
  4676.  
  4677. ; ------------------
  4678. ; Editing keys table
  4679. ; ------------------
  4680. ; For each code in the range $07 to $0F this table contains a
  4681. ; single offset byte to the routine that services that code.
  4682. ; Note. for what was intended there should also have been an
  4683. ; entry for chr$ 6 with offset to ed-symbol.
  4684.  
  4685. ;; ed-keys-t
  4686. L0FA0:  DB    L0FA9 - $  ; 07d offset $09 to Address: ED-EDIT
  4687.         DB    L1007 - $  ; 08d offset $66 to Address: ED-LEFT
  4688.         DB    L100C - $  ; 09d offset $6A to Address: ED-RIGHT
  4689.         DB    L0FF3 - $  ; 10d offset $50 to Address: ED-DOWN
  4690.         DB    L1059 - $  ; 11d offset $B5 to Address: ED-UP
  4691.         DB    L1015 - $  ; 12d offset $70 to Address: ED-DELETE
  4692.         DB    L1024 - $  ; 13d offset $7E to Address: ED-ENTER
  4693.         DB    L1076 - $  ; 14d offset $CF to Address: ED-SYMBOL
  4694.         DB    L107C - $  ; 15d offset $D4 to Address: ED-GRAPH
  4695.  
  4696. ; ---------------
  4697. ; Handle EDIT key
  4698. ; ---------------
  4699. ; The user has pressed SHIFT 1 to bring edit line down to bottom of screen.
  4700. ; Alternatively the user wishes to clear the input buffer and start again.
  4701. ; Alternatively ...
  4702.  
  4703. ;; ED-EDIT
  4704. L0FA9:  LD      HL,($5C49)      ; fetch E_PPC the last line number entered.
  4705.                                 ; Note. may not exist and may follow program.
  4706.         BIT     5,(IY+$37)      ; test FLAGX  - input mode ?
  4707.         JP      NZ,L1097        ; jump forward to CLEAR-SP if not in editor.
  4708.  
  4709.         CALL    L196E           ; routine LINE-ADDR to find address of line
  4710.                                 ; or following line if it doesn't exist.
  4711.         CALL    L1695           ; routine LINE-NO will get line number from
  4712.                                 ; address or previous line if at end-marker.
  4713.         LD      A,D             ; if there is no program then DE will
  4714.         OR      E               ; contain zero so test for this.
  4715.         JP      Z,L1097         ; jump to to CLEAR-SP if so.
  4716.  
  4717. ; Note. at this point we have a validated line number, not just an
  4718. ; approximation and it would be best to update E_PPC with the true
  4719. ; cursor line value which would enable the line cursor to be suppressed
  4720. ; in all situations - see shortly.
  4721.  
  4722.         PUSH    HL              ; save address of line.
  4723.         INC     HL              ; address low byte of length.
  4724.         LD      C,(HL)          ; transfer to C
  4725.         INC     HL              ; next to high byte
  4726.         LD      B,(HL)          ; transfer to B.
  4727.         LD      HL,$000A        ; an overhead of ten bytes
  4728.         ADD     HL,BC           ; is added to length.
  4729.         LD      B,H             ; transfer adjusted value
  4730.         LD      C,L             ; to BC register.
  4731.         CALL    L1F05           ; routine TEST-ROOM checks free memory.
  4732.         CALL    L1097           ; routine CLEAR-SP clears editing area.
  4733.         LD      HL,($5C51)      ; address CURCHL
  4734.         EX      (SP),HL         ; swap with line address on stack
  4735.         PUSH    HL              ; save line address underneath
  4736.  
  4737.         LD      A,$FF           ; select system channel 'R'
  4738.         CALL    L1601           ; routine CHAN-OPEN opens it
  4739.  
  4740.         POP     HL              ; drop line address
  4741.         DEC     HL              ; make it point to first byte of line num.
  4742.         DEC     (IY+$0F)        ; decrease E_PPC_lo to suppress line cursor.
  4743.                                 ; Note. ineffective when E_PPC is one
  4744.                                 ; greater than last line of program perhaps
  4745.                                 ; as a result of a delete.
  4746.                                 ; credit. Paul Harrison 1982.
  4747.  
  4748.         CALL    L1855           ; routine OUT-LINE outputs the BASIC line
  4749.                                 ; to the editing area.
  4750.         INC     (IY+$0F)        ; restore E_PPC_lo to the previous value.
  4751.         LD      HL,($5C59)      ; address E_LINE in editing area.
  4752.         INC     HL              ; advance
  4753.         INC     HL              ; past space
  4754.         INC     HL              ; and digit characters
  4755.         INC     HL              ; of line number.
  4756.  
  4757.         LD      ($5C5B),HL      ; update K_CUR to address start of BASIC.
  4758.         POP     HL              ; restore the address of CURCHL.
  4759.         CALL    L1615           ; routine CHAN-FLAG sets flags for it.
  4760.         RET                     ; RETURN to ED-LOOP.
  4761.  
  4762. ; -------------------
  4763. ; Cursor down editing
  4764. ; -------------------
  4765. ; The BASIC lines are displayed at the top of the screen and the user
  4766. ; wishes to move the cursor down one line in edit mode.
  4767. ; In input mode this key can be used as an alternative to entering STOP.
  4768.  
  4769. ;; ED-DOWN
  4770. L0FF3:  BIT     5,(IY+$37)      ; test FLAGX  - Input Mode ?
  4771.         JR      NZ,L1001        ; skip to ED-STOP if so
  4772.  
  4773.         LD      HL,$5C49        ; address E_PPC - 'current line'
  4774.         CALL    L190F           ; routine LN-FETCH fetches number of next
  4775.                                 ; line or same if at end of program.
  4776.         JR      L106E           ; forward to ED-LIST to produce an
  4777.                                 ; automatic listing.
  4778.  
  4779. ; ---
  4780.  
  4781. ;; ED-STOP
  4782. L1001:  LD      (IY+$00),$10    ; set ERR_NR to 'STOP in INPUT' code
  4783.         JR      L1024           ; forward to ED-ENTER to produce error.
  4784.  
  4785. ; -------------------
  4786. ; Cursor left editing
  4787. ; -------------------
  4788. ; This acts on the cursor in the lower section of the screen in both
  4789. ; editing and input mode.
  4790.  
  4791. ;; ED-LEFT
  4792. L1007:  CALL    L1031           ; routine ED-EDGE moves left if possible
  4793.         JR      L1011           ; forward to ED-CUR to update K-CUR
  4794.                                 ; and return to ED-LOOP.
  4795.  
  4796. ; --------------------
  4797. ; Cursor right editing
  4798. ; --------------------
  4799. ; This acts on the cursor in the lower screen in both editing and input
  4800. ; mode and moves it to the right.
  4801.  
  4802. ;; ED-RIGHT
  4803. L100C:  LD      A,(HL)          ; fetch addressed character.
  4804.         CP      $0D             ; is it carriage return ?
  4805.         RET     Z               ; return if so to ED-LOOP
  4806.  
  4807.         INC     HL              ; address next character
  4808.  
  4809. ;; ED-CUR
  4810. L1011:  LD      ($5C5B),HL      ; update K_CUR system variable
  4811.         RET                     ; return to ED-LOOP
  4812.  
  4813. ; --------------
  4814. ; DELETE editing
  4815. ; --------------
  4816. ; This acts on the lower screen and deletes the character to left of
  4817. ; cursor. If control characters are present these are deleted first
  4818. ; leaving the naked parameter (0-7) which appears as a '?' except in the
  4819. ; case of chr$ 6 which is the comma control character. It is not mandatory
  4820. ; to delete these second characters.
  4821.  
  4822. ;; ED-DELETE
  4823. L1015:  CALL    L1031           ; routine ED-EDGE moves cursor to left.
  4824.         LD      BC,$0001        ; of character to be deleted.
  4825.         JP      L19E8           ; to RECLAIM-2 reclaim the character.
  4826.  
  4827. ; ------------------------------------------
  4828. ; Ignore next 2 codes from key-input routine
  4829. ; ------------------------------------------
  4830. ; Since AT and TAB cannot be entered this point is never reached
  4831. ; from the keyboard. If inputting from a tape device or network then
  4832. ; the control and two following characters are ignored and processing
  4833. ; continues as if a carriage return had been received.
  4834. ; Here, perhaps, another Spectrum has said print #15; AT 0,0; "This is yellow"
  4835. ; and this one is interpreting input #15; a$.
  4836.  
  4837. ;; ED-IGNORE
  4838. L101E:  CALL    L15D4           ; routine WAIT-KEY to ignore keystroke.
  4839.         CALL    L15D4           ; routine WAIT-KEY to ignore next key.
  4840.  
  4841. ; -------------
  4842. ; Enter/newline
  4843. ; -------------
  4844. ; The enter key has been pressed to have BASIC line or input accepted.
  4845.  
  4846. ;; ED-ENTER
  4847. L1024:  POP     HL              ; discard address ED-LOOP
  4848.         POP     HL              ; drop address ED-ERROR
  4849.  
  4850. ;; ED-END
  4851. L1026:  POP     HL              ; the previous value of ERR_SP
  4852.         LD      ($5C3D),HL      ; is restored to ERR_SP system variable
  4853.         BIT     7,(IY+$00)      ; is ERR_NR $FF (= 'OK') ?
  4854.         RET     NZ              ; return if so
  4855.  
  4856.         LD      SP,HL           ; else put error routine on stack
  4857.         RET                     ; and make an indirect jump to it.
  4858.  
  4859. ; -----------------------------
  4860. ; Move cursor left when editing
  4861. ; -----------------------------
  4862. ; This routine moves the cursor left. The complication is that it must
  4863. ; not position the cursor between control codes and their parameters.
  4864. ; It is further complicated in that it deals with TAB and AT characters
  4865. ; which are never present from the keyboard.
  4866. ; The method is to advance from the beginning of the line each time,
  4867. ; jumping one, two, or three characters as necessary saving the original
  4868. ; position at each jump in DE. Once it arrives at the cursor then the next
  4869. ; legitimate leftmost position is in DE.
  4870.  
  4871. ;; ED-EDGE
  4872. L1031:  SCF                     ; carry flag must be set to call the nested
  4873.         CALL    L1195           ; subroutine SET-DE.
  4874.                                 ; if input   then DE=WORKSP
  4875.                                 ; if editing then DE=E_LINE
  4876.         SBC     HL,DE           ; subtract address from start of line
  4877.         ADD     HL,DE           ; and add back.
  4878.         INC     HL              ; adjust for carry.
  4879.         POP     BC              ; drop return address
  4880.         RET     C               ; return to ED-LOOP if already at left
  4881.                                 ; of line.
  4882.  
  4883.         PUSH    BC              ; resave return address - ED-LOOP.
  4884.         LD      B,H             ; transfer HL - cursor address
  4885.         LD      C,L             ; to BC register pair.
  4886.                                 ; at this point DE addresses start of line.
  4887.  
  4888. ;; ED-EDGE-1
  4889. L103E:  LD      H,D             ; transfer DE - leftmost pointer
  4890.         LD      L,E             ; to HL
  4891.         INC     HL              ; address next leftmost character to
  4892.                                 ; advance position each time.
  4893.         LD      A,(DE)          ; pick up previous in A
  4894.         AND     $F0             ; lose the low bits
  4895.         CP      $10             ; is it INK to TAB $10-$1F ?
  4896.                                 ; that is, is it followed by a parameter ?
  4897.         JR      NZ,L1051        ; to ED-EDGE-2 if not
  4898.                                 ; HL has been incremented once
  4899.  
  4900.         INC     HL              ; address next as at least one parameter.
  4901.  
  4902. ; in fact since 'tab' and 'at' cannot be entered the next section seems
  4903. ; superfluous.
  4904. ; The test will always fail and the jump to ED-EDGE-2 will be taken.
  4905.  
  4906.         LD      A,(DE)          ; reload leftmost character
  4907.         SUB     $17             ; decimal 23 ('tab')
  4908.         ADC     A,$00           ; will be 0 for 'tab' and 'at'.
  4909.         JR      NZ,L1051        ; forward to ED-EDGE-2 if not
  4910.                                 ; HL has been incremented twice
  4911.  
  4912.         INC     HL              ; increment a third time for 'at'/'tab'
  4913.  
  4914. ;; ED-EDGE-2
  4915. L1051:  AND     A               ; prepare for true subtraction
  4916.         SBC     HL,BC           ; subtract cursor address from pointer
  4917.         ADD     HL,BC           ; and add back
  4918.                                 ; Note when HL matches the cursor position BC,
  4919.                                 ; there is no carry and the previous
  4920.                                 ; position is in DE.
  4921.         EX      DE,HL           ; transfer result to DE if looping again.
  4922.                                 ; transfer DE to HL to be used as K-CUR
  4923.                                 ; if exiting loop.
  4924.         JR      C,L103E         ; back to ED-EDGE-1 if cursor not matched.
  4925.  
  4926.         RET                     ; return.
  4927.  
  4928. ; -----------------
  4929. ; Cursor up editing
  4930. ; -----------------
  4931. ; The main screen displays part of the BASIC program and the user wishes
  4932. ; to move up one line scrolling if necessary.
  4933. ; This has no alternative use in input mode.
  4934.  
  4935. ;; ED-UP
  4936. L1059:  BIT     5,(IY+$37)      ; test FLAGX  - input mode ?
  4937.         RET     NZ              ; return if not in editor - to ED-LOOP.
  4938.  
  4939.         LD      HL,($5C49)      ; get current line from E_PPC
  4940.         CALL    L196E           ; routine LINE-ADDR gets address
  4941.         EX      DE,HL           ; and previous in DE
  4942.         CALL    L1695           ; routine LINE-NO gets prev line number
  4943.         LD      HL,$5C4A        ; set HL to E_PPC_hi as next routine stores
  4944.                                 ; top first.
  4945.         CALL    L191C           ; routine LN-STORE loads DE value to HL
  4946.                                 ; high byte first - E_PPC_lo takes E
  4947.  
  4948. ; this branch is also taken from ed-down.
  4949.  
  4950. ;; ED-LIST
  4951. L106E:  CALL    L1795           ; routine AUTO-LIST lists to upper screen
  4952.                                 ; including adjusted current line.
  4953.         LD      A,$00           ; select lower screen again
  4954.         JP      L1601           ; exit via CHAN-OPEN to ED-LOOP
  4955.  
  4956. ; --------------------------------
  4957. ; Use of symbol and graphics codes
  4958. ; --------------------------------
  4959. ; These will not be encountered with the keyboard but would be handled
  4960. ; otherwise as follows.
  4961. ; As noted earlier, Vickers says there should have been an entry in
  4962. ; the KEYS table for chr$ 6 which also pointed here.
  4963. ; If, for simplicity, two Spectrums were both using #15 as a bi-directional
  4964. ; channel connected to each other:-
  4965. ; then when the other Spectrum has said PRINT #15; x, y
  4966. ; input #15; i ; j  would treat the comma control as a newline and the
  4967. ; control would skip to input j.
  4968. ; You can get round the missing chr$ 6 handler by sending multiple print
  4969. ; items separated by a newline '.
  4970.  
  4971. ; chr$14 would have the same functionality.
  4972.  
  4973. ; This is chr$ 14.
  4974. ;; ED-SYMBOL
  4975. L1076:  BIT     7,(IY+$37)      ; test FLAGX - is this INPUT LINE ?
  4976.         JR      Z,L1024         ; back to ED-ENTER if not to treat as if
  4977.                                 ; enter had been pressed.
  4978.                                 ; else continue and add code to buffer.
  4979.  
  4980. ; Next is chr$ 15
  4981. ; Note that ADD-CHAR precedes the table so we can't offset to it directly.
  4982.  
  4983. ;; ED-GRAPH
  4984. L107C:  JP      L0F81           ; jump back to ADD-CHAR
  4985.  
  4986. ; --------------------
  4987. ; Editor error routine
  4988. ; --------------------
  4989. ; If an error occurs while editing, or inputting, then ERR_SP
  4990. ; points to the stack location holding address ED_ERROR.
  4991.  
  4992. ;; ED-ERROR
  4993. L107F:  BIT     4,(IY+$30)      ; test FLAGS2  - is K channel in use ?
  4994.         JR      Z,L1026         ; back to ED-END if not.
  4995.  
  4996. ; but as long as we're editing lines or inputting from the keyboard, then
  4997. ; we've run out of memory so give a short rasp.
  4998.  
  4999.         LD      (IY+$00),$FF    ; reset ERR_NR to 'OK'.
  5000.         LD      D,$00           ; prepare for beeper.
  5001.         LD      E,(IY-$02)      ; use RASP value.
  5002.         LD      HL,$1A90        ; set a duration.
  5003.         CALL    L03B5           ; routine BEEPER emits a warning rasp.
  5004.         JP      L0F30           ; to ED-AGAIN to re-stack address of
  5005.                                 ; this routine and make ERR_SP point to it.
  5006.  
  5007. ; ---------------------
  5008. ; Clear edit/work space
  5009. ; ---------------------
  5010. ; The editing area or workspace is cleared depending on context.
  5011. ; This is called from ED-EDIT to clear workspace if edit key is
  5012. ; used during input, to clear editing area if no program exists
  5013. ; and to clear editing area prior to copying the edit line to it.
  5014. ; It is also used by the error routine to clear the respective
  5015. ; area depending on FLAGX.
  5016.  
  5017. ;; CLEAR-SP
  5018. L1097:  PUSH    HL              ; preserve HL
  5019.         CALL    L1190           ; routine SET-HL
  5020.                                 ; if in edit   HL = WORKSP-1, DE = E_LINE
  5021.                                 ; if in input  HL = STKBOT,   DE = WORKSP
  5022.         DEC     HL              ; adjust
  5023.         CALL    L19E5           ; routine RECLAIM-1 reclaims space
  5024.         LD      ($5C5B),HL      ; set K_CUR to start of empty area
  5025.         LD      (IY+$07),$00    ; set MODE to 'KLC'
  5026.         POP     HL              ; restore HL.
  5027.         RET                     ; return.
  5028.  
  5029. ; ---------------------
  5030. ; Handle keyboard input
  5031. ; ---------------------
  5032. ; This is the service routine for the input stream of the keyboard
  5033. ; channel 'K'.
  5034.  
  5035. ;; KEY-INPUT
  5036. L10A8:  BIT     3,(IY+$02)      ; test TV_FLAG  - has a key been pressed in
  5037.                                 ; editor ?
  5038.         CALL    NZ,L111D        ; routine ED-COPY if so to reprint the lower
  5039.                                 ; screen at every keystroke.
  5040.         AND     A               ; clear carry - required exit condition.
  5041.         BIT     5,(IY+$01)      ; test FLAGS  - has a new key been pressed ?
  5042.         RET     Z               ; return if not.
  5043.  
  5044.         LD      A,($5C08)       ; system variable LASTK will hold last key -
  5045.                                 ; from the interrupt routine.
  5046.         RES     5,(IY+$01)      ; update FLAGS  - reset the new key flag.
  5047.         PUSH    AF              ; save the input character.
  5048.         BIT     5,(IY+$02)      ; test TV_FLAG  - clear lower screen ?
  5049.         CALL    NZ,L0D6E        ; routine CLS-LOWER if so.
  5050.  
  5051.         POP     AF              ; restore the character code.
  5052.         CP      $20             ; if space or higher then
  5053.         JR      NC,L111B        ; forward to KEY-DONE2 and return with carry
  5054.                                 ; set to signal key-found.
  5055.  
  5056.         CP      $10             ; with 16d INK and higher skip
  5057.         JR      NC,L10FA        ; forward to KEY-CONTR.
  5058.  
  5059.         CP      $06             ; for 6 - 15d
  5060.         JR      NC,L10DB        ; skip forward to KEY-M-CL to handle Modes
  5061.                                 ; and CapsLock.
  5062.  
  5063. ; that only leaves 0-5, the flash bright inverse switches.
  5064.  
  5065.         LD      B,A             ; save character in B
  5066.         AND     $01             ; isolate the embedded parameter (0/1).
  5067.         LD      C,A             ; and store in C
  5068.         LD      A,B             ; re-fetch copy (0-5)
  5069.         RRA                     ; halve it 0, 1 or 2.
  5070.         ADD     A,$12           ; add 18d gives 'flash', 'bright'
  5071.                                 ; and 'inverse'.
  5072.         JR      L1105           ; forward to KEY-DATA with the
  5073.                                 ; parameter (0/1) in C.
  5074.  
  5075. ; ---
  5076.  
  5077. ; Now separate capslock 06 from modes 7-15.
  5078.  
  5079. ;; KEY-M-CL
  5080. L10DB:  JR      NZ,L10E6        ; forward to KEY-MODE if not 06 (capslock)
  5081.  
  5082.         LD      HL,$5C6A        ; point to FLAGS2
  5083.         LD      A,$08           ; value 00000100
  5084.         XOR     (HL)            ; toggle BIT 2 of FLAGS2 the capslock bit
  5085.         LD      (HL),A          ; and store result in FLAGS2 again.
  5086.         JR      L10F4           ; forward to KEY-FLAG to signal no-key.
  5087.  
  5088. ; ---
  5089.  
  5090. ;; KEY-MODE
  5091. L10E6:  CP      $0E             ; compare with chr 14d
  5092.         RET     C               ; return with carry set "key found" for
  5093.                                 ; codes 7 - 13d leaving 14d and 15d
  5094.                                 ; which are converted to mode codes.
  5095.  
  5096.         SUB     $0D             ; subtract 13d leaving 1 and 2
  5097.                                 ; 1 is 'E' mode, 2 is 'G' mode.
  5098.         LD      HL,$5C41        ; address the MODE system variable.
  5099.         CP      (HL)            ; compare with existing value before
  5100.         LD      (HL),A          ; inserting the new value.
  5101.         JR      NZ,L10F4        ; forward to KEY-FLAG if it has changed.
  5102.  
  5103.         LD      (HL),$00        ; else make MODE zero - KLC mode
  5104.                                 ; Note. while in Extended/Graphics mode,
  5105.                                 ; the Extended Mode/Graphics key is pressed
  5106.                                 ; again to get out.
  5107.  
  5108. ;; KEY-FLAG
  5109. L10F4:  SET     3,(IY+$02)      ; update TV_FLAG  - show key state has changed
  5110.         CP      A               ; clear carry and reset zero flags -
  5111.                                 ; no actual key returned.
  5112.         RET                     ; make the return.
  5113.  
  5114. ; ---
  5115.  
  5116. ; now deal with colour controls - 16-23 ink, 24-31 paper
  5117.  
  5118. ;; KEY-CONTR
  5119. L10FA:  LD      B,A             ; make a copy of character.
  5120.         AND     $07             ; mask to leave bits 0-7
  5121.         LD      C,A             ; and store in C.
  5122.         LD      A,$10           ; initialize to 16d - INK.
  5123.         BIT     3,B             ; was it paper ?
  5124.         JR      NZ,L1105        ; forward to KEY-DATA with INK 16d and
  5125.                                 ; colour in C.
  5126.  
  5127.         INC     A               ; else change from INK to PAPER (17d) if so.
  5128.  
  5129. ;; KEY-DATA
  5130. L1105:  LD      (IY-$2D),C      ; put the colour (0-7)/state(0/1) in KDATA
  5131.         LD      DE,L110D        ; address: KEY-NEXT will be next input stream
  5132.         JR      L1113           ; forward to KEY-CHAN to change it ...
  5133.  
  5134. ; ---
  5135.  
  5136. ; ... so that INPUT_AD directs control to here at next call to WAIT-KEY
  5137.  
  5138. ;; KEY-NEXT
  5139. L110D:  LD      A,($5C0D)       ; pick up the parameter stored in KDATA.
  5140.         LD      DE,L10A8        ; address: KEY-INPUT will be next input stream
  5141.                                 ; continue to restore default channel and
  5142.                                 ; make a return with the control code.
  5143.  
  5144. ;; KEY-CHAN
  5145. L1113:  LD      HL,($5C4F)      ; address start of CHANNELS area using CHANS
  5146.                                 ; system variable.
  5147.                                 ; Note. One might have expected CURCHL to
  5148.                                 ; have been used.
  5149.         INC     HL              ; step over the
  5150.         INC     HL              ; output address
  5151.         LD      (HL),E          ; and update the input
  5152.         INC     HL              ; routine address for
  5153.         LD      (HL),D          ; the next call to WAIT-KEY.
  5154.  
  5155. ;; KEY-DONE2
  5156. L111B:  SCF                     ; set carry flag to show a key has been found
  5157.         RET                     ; and return.
  5158.  
  5159. ; --------------------
  5160. ; Lower screen copying
  5161. ; --------------------
  5162. ; This subroutine is called whenever the line in the editing area or
  5163. ; input workspace is required to be printed to the lower screen.
  5164. ; It is by calling this routine after any change that the cursor, for
  5165. ; instance, appears to move to the left.
  5166. ; Remember the edit line will contain characters and tokens
  5167. ; e.g. "1000 LET a = 1" is 12 characters.
  5168.  
  5169. ;; ED-COPY
  5170. L111D:  CALL    L0D4D           ; routine TEMPS sets temporary attributes.
  5171.         RES     3,(IY+$02)      ; update TV_FLAG  - signal no change in mode
  5172.         RES     5,(IY+$02)      ; update TV_FLAG  - signal don't clear lower
  5173.                                 ; screen.
  5174.         LD      HL,($5C8A)      ; fetch SPOSNL
  5175.         PUSH    HL              ; and save on stack.
  5176.  
  5177.         LD      HL,($5C3D)      ; fetch ERR_SP
  5178.         PUSH    HL              ; and save also
  5179.         LD      HL,L1167        ; address: ED-FULL
  5180.         PUSH    HL              ; is pushed as the error routine
  5181.         LD      ($5C3D),SP      ; and ERR_SP made to point to it.
  5182.  
  5183.         LD      HL,($5C82)      ; fetch ECHO_E
  5184.         PUSH    HL              ; and push also
  5185.  
  5186.         SCF                     ; set carry flag to control SET-DE
  5187.         CALL    L1195           ; call routine SET-DE
  5188.                                 ; if in input DE = WORKSP
  5189.                                 ; if in edit  DE = E_LINE
  5190.         EX      DE,HL           ; start address to HL
  5191.  
  5192.         CALL    L187D           ; routine OUT-LINE2 outputs entire line up to
  5193.                                 ; carriage return including initial
  5194.                                 ; characterized line number when present.
  5195.         EX      DE,HL           ; transfer new address to DE
  5196.         CALL    L18E1           ; routine OUT-CURS considers a
  5197.                                 ; terminating cursor.
  5198.  
  5199.         LD      HL,($5C8A)      ; fetch updated SPOSNL
  5200.         EX      (SP),HL         ; exchange with ECHO_E on stack
  5201.         EX      DE,HL           ; transfer ECHO_E to DE
  5202.         CALL    L0D4D           ; routine TEMPS to re-set attributes
  5203.                                 ; if altered.
  5204.  
  5205. ; the lower screen was not cleared, at the outset, so if deleting then old
  5206. ; text from a previous print may follow this line and requires blanking.
  5207.  
  5208. ;; ED-BLANK
  5209. L1150:  LD      A,($5C8B)       ; fetch SPOSNL_hi is current line
  5210.         SUB     D               ; compare with old
  5211.         JR      C,L117C         ; forward to ED-C-DONE if no blanking
  5212.  
  5213.         JR      NZ,L115E        ; forward to ED-SPACES if line has changed
  5214.  
  5215.         LD      A,E             ; old column to A
  5216.         SUB     (IY+$50)        ; subtract new in SPOSNL_lo
  5217.         JR      NC,L117C        ; forward to ED-C-DONE if no backfilling.
  5218.  
  5219. ;; ED-SPACES
  5220. L115E:  LD      A,$20           ; prepare a space.
  5221.         PUSH    DE              ; save old line/column.
  5222.         CALL    L09F4           ; routine PRINT-OUT prints a space over
  5223.                                 ; any text from previous print.
  5224.                                 ; Note. Since the blanking only occurs when
  5225.                                 ; using $09F4 to print to the lower screen,
  5226.                                 ; there is no need to vector via a RST 10
  5227.                                 ; and we can use this alternate set.
  5228.         POP     DE              ; restore the old line column.
  5229.         JR      L1150           ; back to ED-BLANK until all old text blanked.
  5230.  
  5231. ; -------
  5232. ; ED-FULL
  5233. ; -------
  5234. ; this is the error routine addressed by ERR_SP. This is not for the out of
  5235. ; memory situation as we're just printing. The pitch and duration are exactly
  5236. ; the same as used by ED-ERROR from which this has been augmented. The
  5237. ; situation is that the lower screen is full and a rasp is given to suggest
  5238. ; that this is perhaps not the best idea you've had that day.
  5239.  
  5240. ;; ED-FULL
  5241. L1167:  LD      D,$00           ; prepare to moan.
  5242.         LD      E,(IY-$02)      ; fetch RASP value.
  5243.         LD      HL,$1A90        ; set duration.
  5244.         CALL    L03B5           ; routine BEEPER.
  5245.         LD      (IY+$00),$FF    ; clear ERR_NR.
  5246.         LD      DE,($5C8A)      ; fetch SPOSNL.
  5247.         JR      L117E           ; forward to ED-C-END
  5248.  
  5249. ; -------
  5250.  
  5251. ; the exit point from line printing continues here.
  5252.  
  5253. ;; ED-C-DONE
  5254. L117C:  POP     DE              ; fetch new line/column.
  5255.         POP     HL              ; fetch the error address.
  5256.  
  5257. ; the error path rejoins here.
  5258.  
  5259. ;; ED-C-END
  5260. L117E:  POP     HL              ; restore the old value of ERR_SP.
  5261.         LD      ($5C3D),HL      ; update the system variable ERR_SP
  5262.         POP     BC              ; old value of SPOSN_L
  5263.         PUSH    DE              ; save new value
  5264.         CALL    L0DD9           ; routine CL-SET and PO-STORE
  5265.                                 ; update ECHO_E and SPOSN_L from BC
  5266.         POP     HL              ; restore new value
  5267.         LD      ($5C82),HL      ; and update ECHO_E
  5268.         LD      (IY+$26),$00    ; make error pointer X_PTR_hi out of bounds
  5269.         RET                     ; return
  5270.  
  5271. ; -----------------------------------------------
  5272. ; Point to first and last locations of work space
  5273. ; -----------------------------------------------
  5274. ; These two nested routines ensure that the appropriate pointers are
  5275. ; selected for the editing area or workspace. The routines that call
  5276. ; these routines are designed to work on either area.
  5277.  
  5278. ; this routine is called once
  5279. ;; SET-HL
  5280. L1190:  LD      HL,($5C61)      ; fetch WORKSP to HL.
  5281.         DEC     HL              ; point to last location of editing area.
  5282.         AND     A               ; clear carry to limit exit points to first
  5283.                                 ; or last.
  5284.  
  5285. ; this routine is called with carry set and exits at a conditional return.
  5286.  
  5287. ;; SET-DE
  5288. L1195:  LD      DE,($5C59)      ; fetch E_LINE to DE
  5289.         BIT     5,(IY+$37)      ; test FLAGX  - Input Mode ?
  5290.         RET     Z               ; return now if in editing mode
  5291.  
  5292.         LD      DE,($5C61)      ; fetch WORKSP to DE
  5293.         RET     C               ; return if carry set ( entry = set-de)
  5294.  
  5295.         LD      HL,($5C63)      ; fetch STKBOT to HL as well
  5296.         RET                     ; and return  (entry = set-hl (in input))
  5297.  
  5298. ; -------------------------------
  5299. ; Remove floating point from line
  5300. ; -------------------------------
  5301. ; When a BASIC LINE or the INPUT BUFFER is parsed any numbers will have
  5302. ; an invisible chr 14d inserted after them and the 5-byte integer or
  5303. ; floating point form inserted after that. Similar invisible value holders
  5304. ; are also created after the numeric and string variables in a DEF FN list.
  5305. ; This routine removes these 'compiled' numbers from the edit line or
  5306. ; input workspace.
  5307.  
  5308. ;; REMOVE-FP
  5309. L11A7:  LD      A,(HL)          ; fetch character
  5310.         CP      $0E             ; is it the number marker ?
  5311.         LD      BC,$0006        ; prepare for six bytes
  5312.         CALL    Z,L19E8         ; routine RECLAIM-2 reclaims space if $0E
  5313.         LD      A,(HL)          ; reload next (or same) character
  5314.         INC     HL              ; and advance address
  5315.         CP      $0D             ; end of line or input buffer ?
  5316.         JR      NZ,L11A7        ; back to REMOVE-FP until entire line done.
  5317.  
  5318.         RET                     ; return
  5319.  
  5320.  
  5321. ;*********************************
  5322. ;** Part 6. EXECUTIVE ROUTINES  **
  5323. ;*********************************
  5324.  
  5325.  
  5326. ; The memory.
  5327. ;
  5328. ; +---------+-----------+------------+--------------+-------------+--
  5329. ; | BASIC   |  Display  | Attributes | ZX Printer   |    System   |
  5330. ; |  ROM    |   File    |    File    |   Buffer     |  Variables  |
  5331. ; +---------+-----------+------------+--------------+-------------+--
  5332. ; ^         ^           ^            ^              ^             ^
  5333. ; $0000   $4000       $5800        $5B00          $5C00         $5CB6 = CHANS
  5334. ;
  5335. ;
  5336. ;  --+----------+---+---------+-----------+---+------------+--+---+--
  5337. ;    | Channel  |$80|  BASIC  | Variables |$80| Edit Line  |NL|$80|
  5338. ;    |   Info   |   | Program |   Area    |   | or Command |  |   |
  5339. ;  --+----------+---+---------+-----------+---+------------+--+---+--
  5340. ;    ^              ^         ^               ^                   ^
  5341. ;  CHANS           PROG      VARS           E_LINE              WORKSP
  5342. ;
  5343. ;
  5344. ;                             ---5-->         <---2---  <--3---
  5345. ;  --+-------+--+------------+-------+-------+---------+-------+-+---+------+
  5346. ;    | INPUT |NL| Temporary  | Calc. | Spare | Machine | GOSUB |?|$3E| UDGs |
  5347. ;    | data  |  | Work Space | Stack |       |  Stack  | Stack | |   |      |
  5348. ;  --+-------+--+------------+-------+-------+---------+-------+-+---+------+
  5349. ;    ^                       ^       ^       ^                   ^   ^      ^
  5350. ;  WORKSP                  STKBOT  STKEND   sp               RAMTOP UDG  P_RAMT
  5351. ;                                                                        
  5352.  
  5353. ; -------------------
  5354. ; Handle NEW command
  5355. ; -------------------
  5356. ; The NEW command is about to set all RAM below RAMTOP to zero and
  5357. ; then re-initialize the system. All RAM above RAMTOP should, and will be,
  5358. ; preserved.
  5359. ; There is nowhere to store values in RAM or on the stack which becomes
  5360. ; inoperable. Similarly PUSH and CALL instructions cannot be used to
  5361. ; store values or section common code. The alternate register set is the only
  5362. ; place available to store 3 persistent 16-bit system variables.
  5363.  
  5364. ;; NEW
  5365. L11B7:  DI                      ; disable interrupts - machine stack will be
  5366.                                 ; cleared.
  5367.         LD      A,$FF           ; flag coming from NEW.
  5368.         LD      DE,($5CB2)      ; fetch RAMTOP as top value.
  5369.         EXX                     ; switch in alternate set.
  5370.         LD      BC,($5CB4)      ; fetch P-RAMT differs on 16K/48K machines.
  5371.         LD      DE,($5C38)      ; fetch RASP/PIP.
  5372.         LD      HL,($5C7B)      ; fetch UDG    differs on 16K/48K machines.
  5373.         EXX                     ; switch back to main set and continue into...
  5374.  
  5375. ; ---------------------------
  5376. ; Main entry (initialization)
  5377. ; ---------------------------
  5378. ; This common code tests ram and sets it to zero re-initializing
  5379. ; all the non-zero system variables and channel information.
  5380. ; The A register tells if coming from START or NEW
  5381.  
  5382. ;; START-NEW
  5383. L11CB:  LD      B,A             ; save the flag for later branching.
  5384.  
  5385.         LD      A,$07           ; select a white border
  5386.         OUT     ($FE),A         ; and set it now.
  5387.  
  5388.         LD      A,$3F           ; load accumulator with last page in ROM.
  5389.         LD      I,A             ; set the I register - this remains constant
  5390.                                 ; and can't be in range $40 - $7F as 'snow'
  5391.                                 ; appears on the screen.
  5392.         NOP                     ; these seem unnecessary.
  5393.         NOP                     ;
  5394.         NOP                     ;
  5395.         NOP                     ;
  5396.         NOP                     ;
  5397.         NOP                     ;
  5398.  
  5399. ; ------------
  5400. ; Check RAM
  5401. ; ------------
  5402. ; Typically a Spectrum will have 16K or 48K of Ram and this code will
  5403. ; test it all till it finds an unpopulated location or, less likely, a
  5404. ; faulty location. Usually it stops when it reaches the top $FFFF or
  5405. ; in the case of NEW the supplied top value. The entire screen turns
  5406. ; black with sometimes red stripes on black paper visible.
  5407.  
  5408. ;; ram-check
  5409. L11DA:  LD      H,D             ; transfer the top value to
  5410.         LD      L,E             ; the HL register pair.
  5411.  
  5412. ;; RAM-FILL
  5413. L11DC:  LD      (HL),$02        ; load with 2 - red ink on black paper
  5414.         DEC     HL              ; next lower
  5415.         CP      H               ; have we reached ROM - $3F ?
  5416.         JR      NZ,L11DC        ; back to RAM-FILL if not.
  5417.  
  5418. ;; RAM-READ
  5419. L11E2:  AND     A               ; clear carry - prepare to subtract
  5420.         SBC     HL,DE           ; subtract and add back setting
  5421.         ADD     HL,DE           ; carry when back at start.
  5422.         INC     HL              ; and increment for next iteration.
  5423.         JR      NC,L11EF        ; forward to RAM-DONE if we've got back to
  5424.                                 ; starting point with no errors.
  5425.  
  5426.         DEC     (HL)            ; decrement to 1.
  5427.         JR      Z,L11EF         ; forward to RAM-DONE if faulty.
  5428.  
  5429.         DEC     (HL)            ; decrement to zero.
  5430.         JR      Z,L11E2         ; back to RAM-READ if zero flag was set.
  5431.  
  5432. ;; RAM-DONE
  5433. L11EF:  DEC     HL              ; step back to last valid location.
  5434.         EXX                     ; regardless of state, set up possibly
  5435.                                 ; stored system variables in case from NEW.
  5436.         LD      ($5CB4),BC      ; insert P-RAMT.
  5437.         LD      ($5C38),DE      ; insert RASP/PIP.
  5438.         LD      ($5C7B),HL      ; insert UDG.
  5439.         EXX                     ; switch in main set.
  5440.         INC     B               ; now test if we arrived here from NEW.
  5441.         JR      Z,L1219         ; forward to RAM-SET if we did.
  5442.  
  5443. ; this section applies to START only.
  5444.  
  5445.         LD      ($5CB4),HL      ; set P-RAMT to the highest working RAM
  5446.                                 ; address.
  5447.         LD      DE,$3EAF        ; address of last byte of 'U' bitmap in ROM.
  5448.         LD      BC,$00A8        ; there are 21 user defined graphics.
  5449.         EX      DE,HL           ; switch pointers and make the UDGs a
  5450.         LDDR                    ; copy of the standard characters A - U.
  5451.         EX      DE,HL           ; switch the pointer to HL.
  5452.         INC     HL              ; update to start of 'A' in RAM.
  5453.         LD      ($5C7B),HL      ; make UDG system variable address the first
  5454.                                 ; bitmap.
  5455.         DEC     HL              ; point at RAMTOP again.
  5456.  
  5457.         LD      BC,$0040        ; set the values of
  5458.         LD      ($5C38),BC      ; the PIP and RASP system variables.
  5459.  
  5460. ; the NEW command path rejoins here.
  5461.  
  5462. ;; RAM-SET
  5463. L1219:  LD      ($5CB2),HL      ; set system variable RAMTOP to HL.
  5464.  
  5465.                 LD HL,CHARS-0X100       ;$3C00        ; a strange place to set the pointer to the
  5466.         LD      ($5C36),HL      ; character set, CHARS - as no printing yet.
  5467.  
  5468.         LD      HL,($5CB2)      ; fetch RAMTOP to HL again as we've lost it.
  5469.  
  5470.         LD      (HL),$3E        ; top of user ram holds GOSUB end marker
  5471.                                 ; an impossible line number - see RETURN.
  5472.                                 ; no significance in the number $3E. It has
  5473.                                 ; been traditional since the ZX80.
  5474.  
  5475.         DEC     HL              ; followed by empty byte (not important).
  5476.         LD      SP,HL           ; set up the machine stack pointer.
  5477.         DEC     HL              ;
  5478.         DEC     HL              ;
  5479.         LD      ($5C3D),HL      ; ERR_SP is where the error pointer is
  5480.                                 ; at moment empty - will take address MAIN-4
  5481.                                 ; at the call preceding that address,
  5482.                                 ; although interrupts and calls will make use
  5483.                                 ; of this location in meantime.
  5484.  
  5485.         IM      1               ; select interrupt mode 1.
  5486.         LD      IY,$5C3A        ; set IY to ERR_NR. IY can reach all standard
  5487.                                 ; system variables but shadow ROM system
  5488.                                 ; variables will be mostly out of range.
  5489.  
  5490.         EI                      ; enable interrupts now that we have a stack.
  5491.  
  5492.         LD      HL,$5CB6        ; the address of the channels - initially
  5493.                                 ; following system variables.
  5494.         LD      ($5C4F),HL      ; set the CHANS system variable.
  5495.  
  5496.         LD      DE,L15AF        ; address: init-chan in ROM.
  5497.         LD      BC,$0015        ; there are 21 bytes of initial data in ROM.
  5498.         EX      DE,HL           ; swap the pointers.
  5499.         LDIR                    ; copy the bytes to RAM.
  5500.  
  5501.         EX      DE,HL           ; swap pointers. HL points to program area.
  5502.         DEC     HL              ; decrement address.
  5503.         LD      ($5C57),HL      ; set DATADD to location before program area.
  5504.         INC     HL              ; increment again.
  5505.  
  5506.         LD      ($5C53),HL      ; set PROG the location where BASIC starts.
  5507.         LD      ($5C4B),HL      ; set VARS to same location with a
  5508.         LD      (HL),$80        ; variables end-marker.
  5509.         INC     HL              ; advance address.
  5510.         LD      ($5C59),HL      ; set E_LINE, where the edit line
  5511.                                 ; will be created.
  5512.                                 ; Note. it is not strictly necessary to
  5513.                                 ; execute the next fifteen bytes of code
  5514.                                 ; as this will be done by the call to SET-MIN.
  5515.                                 ; --
  5516.         LD      (HL),$0D        ; initially just has a carriage return
  5517.         INC     HL              ; followed by
  5518.         LD      (HL),$80        ; an end-marker.
  5519.         INC     HL              ; address the next location.
  5520.         LD      ($5C61),HL      ; set WORKSP - empty workspace.
  5521.         LD      ($5C63),HL      ; set STKBOT - bottom of the empty stack.
  5522.         LD      ($5C65),HL      ; set STKEND to the end of the empty stack.
  5523.                                 ; --
  5524.         LD      A,$38           ; the colour system is set to white paper,
  5525.                                 ; black ink, no flash or bright.
  5526.         LD      ($5C8D),A       ; set ATTR_P permanent colour attributes.
  5527.         LD      ($5C8F),A       ; set ATTR_T temporary colour attributes.
  5528.         LD      ($5C48),A       ; set BORDCR the border colour/lower screen
  5529.                                 ; attributes.
  5530.  
  5531.         LD      HL,$0523        ; The keyboard repeat and delay values
  5532.         LD      ($5C09),HL      ; are loaded to REPDEL and REPPER.
  5533.  
  5534.         DEC     (IY-$3A)        ; set KSTATE-0 to $FF.
  5535.         DEC     (IY-$36)        ; set KSTATE-4 to $FF.
  5536.                                 ; thereby marking both available.
  5537.  
  5538.         LD      HL,L15C6        ; set source to ROM Address: init-strm
  5539.         LD      DE,$5C10        ; set destination to system variable STRMS-FD
  5540.         LD      BC,$000E        ; copy the 14 bytes of initial 7 streams data
  5541.         LDIR                    ; from ROM to RAM.
  5542.  
  5543.         SET     1,(IY+$01)      ; update FLAGS  - signal printer in use.
  5544.  
  5545. ;===============================
  5546.                 IF AY_PRINTER
  5547.                 CALL PRINTER_INITER
  5548.                 ELSE
  5549.                 CALL L0EDF                      ; call routine CLEAR-PRB to initialize system
  5550.                                                 ; variables associated with printer.
  5551.                 ENDIF
  5552. ;===============================
  5553.  
  5554.         LD      (IY+$31),$02    ; set DF_SZ the lower screen display size to
  5555.                                 ; two lines
  5556.         CALL    L0D6B           ; call routine CLS to set up system
  5557.                                 ; variables associated with screen and clear
  5558.                                 ; the screen and set attributes.
  5559.         XOR     A               ; clear accumulator so that we can address
  5560.         LD      DE,L1539 - 1    ; the message table directly.
  5561.         CALL    L0C0A           ; routine PO-MSG puts
  5562.                                 ; '(c) 1982 Sinclair Research Ltd'
  5563.                                 ; at bottom of display.
  5564.         SET     5,(IY+$02)      ; update TV_FLAG  - signal lower screen will
  5565.                                 ; require clearing.
  5566.  
  5567.         JR      L12A9           ; forward to MAIN-1
  5568.  
  5569. ; -------------------
  5570. ; Main execution loop
  5571. ; -------------------
  5572. ;
  5573. ;
  5574.  
  5575. ;; MAIN-EXEC
  5576. L12A2:  LD      (IY+$31),$02    ; set DF_SZ lower screen display file
  5577.                                 ; size to 2 lines.
  5578.         CALL    L1795           ; routine AUTO-LIST
  5579.  
  5580. ;; MAIN-1
  5581. L12A9:  CALL    L16B0           ; routine SET-MIN clears work areas.
  5582.  
  5583. ;; MAIN-2
  5584. L12AC:  LD      A,$00           ; select channel 'K' the keyboard
  5585.         CALL    L1601           ; routine CHAN-OPEN opens it
  5586.         CALL    L0F2C           ; routine EDITOR is called.
  5587.                                 ; Note the above routine is where the Spectrum
  5588.                                 ; waits for user-interaction. Perhaps the
  5589.                                 ; most common input at this stage
  5590.                                 ; is LOAD "".
  5591.         CALL    L1B17           ; routine LINE-SCAN scans the input.
  5592.         BIT     7,(IY+$00)      ; test ERR_NR - will be $FF if syntax
  5593.                                 ; is correct.
  5594.         JR      NZ,L12CF        ; forward, if correct, to MAIN-3.
  5595.  
  5596. ;
  5597.  
  5598.         BIT     4,(IY+$30)      ; test FLAGS2 - K channel in use ?
  5599.         JR      Z,L1303         ; forward to MAIN-4 if not.
  5600.  
  5601. ;
  5602.  
  5603.         LD      HL,($5C59)      ; an editing error so address E_LINE.
  5604.         CALL    L11A7           ; routine REMOVE-FP removes the hidden
  5605.                                 ; floating-point forms.
  5606.         LD      (IY+$00),$FF    ; system variable ERR_NR is reset to 'OK'.
  5607.         JR      L12AC           ; back to MAIN-2 to allow user to correct.
  5608.  
  5609. ; ---
  5610.  
  5611. ; the branch was here if syntax has passed test.
  5612.  
  5613. ;; MAIN-3
  5614. L12CF:  LD      HL,($5C59)      ; fetch the edit line address from E_LINE.
  5615.         LD      ($5C5D),HL      ; system variable CH_ADD is set to first
  5616.                                 ; character of edit line.
  5617.                                 ; Note. the above two instructions are a little
  5618.                                 ; inadequate.
  5619.                                 ; They are repeated with a subtle difference
  5620.                                 ; at the start of the next subroutine and are
  5621.                                 ; therefore not required above.
  5622.  
  5623.         CALL    L19FB           ; routine E-LINE-NO will fetch any line
  5624.                                 ; number to BC if this is a program line.
  5625.  
  5626.         LD      A,B             ; test if the number of
  5627.         OR      C               ; the line is non-zero.
  5628.         JP      NZ,L155D        ; jump forward to MAIN-ADD if so to add the
  5629.                                 ; line to the BASIC program.
  5630.  
  5631. ; Has the user just pressed the ENTER key ?
  5632.  
  5633.         RST     18H             ; GET-CHAR gets character addressed by CH_ADD.
  5634.         CP      $0D             ; is it a carriage return ?
  5635.         JR      Z,L12A2         ; back to MAIN-EXEC if so for an automatic
  5636.                                 ; listing.
  5637.  
  5638. ; this must be a direct command.
  5639.  
  5640.         BIT     0,(IY+$30)      ; test FLAGS2 - clear the main screen ?
  5641.         CALL    NZ,L0DAF        ; routine CL-ALL, if so, e.g. after listing.
  5642.         CALL    L0D6E           ; routine CLS-LOWER anyway.
  5643.         LD      A,$19           ; compute scroll count to 25 minus
  5644.         SUB     (IY+$4F)        ; value of S_POSN_hi.
  5645.         LD      ($5C8C),A       ; update SCR_CT system variable.
  5646.         SET     7,(IY+$01)      ; update FLAGS - signal running program.
  5647.         LD      (IY+$00),$FF    ; set ERR_NR to 'OK'.
  5648.         LD      (IY+$0A),$01    ; set NSPPC to one for first statement.
  5649.         CALL    L1B8A           ; call routine LINE-RUN to run the line.
  5650.                                 ; sysvar ERR_SP therefore addresses MAIN-4
  5651.  
  5652. ; Examples of direct commands are RUN, CLS, LOAD "", PRINT USR 40000,
  5653. ; LPRINT "A"; etc..
  5654. ; If a user written machine-code program disables interrupts then it
  5655. ; must enable them to pass the next step. We also jumped to here if the
  5656. ; keyboard was not being used.
  5657.  
  5658. ;; MAIN-4
  5659. L1303:  HALT                    ; wait for interrupt.
  5660.  
  5661.         RES     5,(IY+$01)      ; update FLAGS - signal no new key.
  5662.         BIT     1,(IY+$30)      ; test FLAGS2 - is printer buffer clear ?
  5663.         CALL    NZ,L0ECD        ; call routine COPY-BUFF if not.
  5664.                                 ; Note. the programmer has neglected
  5665.                                 ; to set bit 1 of FLAGS first.
  5666.  
  5667.         LD      A,($5C3A)       ; fetch ERR_NR
  5668.         INC     A               ; increment to give true code.
  5669.  
  5670. ; Now deal with a runtime error as opposed to an editing error.
  5671. ; However if the error code is now zero then the OK message will be printed.
  5672.  
  5673. ;; MAIN-G
  5674. L1313:  PUSH    AF              ; save the error number.
  5675.  
  5676.         LD      HL,$0000        ; prepare to clear some system variables.
  5677.         LD      (IY+$37),H      ; clear all the bits of FLAGX.
  5678.         LD      (IY+$26),H      ; blank X_PTR_hi to suppress error marker.
  5679.         LD      ($5C0B),HL      ; blank DEFADD to signal that no defined
  5680.                                 ; function is currently being evaluated.
  5681.  
  5682.         LD      HL,$0001        ; explicit - inc hl would do.
  5683.         LD      ($5C16),HL      ; ensure STRMS-00 is keyboard.
  5684.  
  5685.         CALL    L16B0           ; routine SET-MIN clears workspace etc.
  5686.         RES     5,(IY+$37)      ; update FLAGX - signal in EDIT not INPUT mode.
  5687.                                 ; Note. all the bits were reset earlier.
  5688.  
  5689.         CALL    L0D6E           ; call routine CLS-LOWER.
  5690.         SET     5,(IY+$02)      ; update TV_FLAG - signal lower screen
  5691.                                 ; requires clearing.
  5692.  
  5693.         POP     AF              ; bring back the error number
  5694.         LD      B,A             ; and make a copy in B.
  5695.         CP      $0A             ; is it a print-ready digit ?
  5696.         JR      C,L133C         ; forward to MAIN-5 if so.
  5697.  
  5698.         ADD     A,$07           ; add ASCII offset to letters.
  5699.  
  5700. ;; MAIN-5
  5701. L133C:  CALL    L15EF           ; call routine OUT-CODE to print the code.
  5702.  
  5703.         LD      A,$20           ; followed by a space.
  5704.         RST     10H             ; PRINT-A
  5705.  
  5706.         LD      A,B             ; fetch stored report code.
  5707.         LD      DE,L1391        ; address: rpt-mesgs.
  5708.         CALL    L0C0A           ; call routine PO-MSG to print.
  5709.  
  5710. X1349
  5711.                 IF BAS48_ONLY
  5712.                 XOR A
  5713.                 LD DE,L1536
  5714.                 ELSE
  5715.                 CALL L3B3B              ; Spectrum 128 patch
  5716.                 NOP
  5717.                 ENDIF
  5718.  
  5719. L134D:  CALL    L0C0A           ; routine PO-MSG prints them although it would
  5720.                                 ; be more succinct to use RST $10.
  5721.  
  5722.         LD      BC,($5C45)      ; fetch PPC the current line number.
  5723.         CALL    L1A1B           ; routine OUT-NUM-1 will print that
  5724.         LD      A,$3A           ; then a ':'.
  5725.         RST     10H             ; PRINT-A
  5726.  
  5727.         LD      C,(IY+$0D)      ; then SUBPPC for statement
  5728.         LD      B,$00           ; limited to 127
  5729.         CALL    L1A1B           ; routine OUT-NUM-1
  5730.  
  5731.         CALL    L1097           ; routine CLEAR-SP clears editing area.
  5732.                                 ; which probably contained 'RUN'.
  5733.         LD      A,($5C3A)       ; fetch ERR_NR again
  5734.         INC     A               ; test for no error originally $FF.
  5735.         JR      Z,L1386         ; forward to MAIN-9 if no error.
  5736.  
  5737.         CP      $09             ; is code Report 9 STOP ?
  5738.         JR      Z,L1373         ; forward to MAIN-6 if so
  5739.  
  5740.         CP      $15             ; is code Report L Break ?
  5741.         JR      NZ,L1376        ; forward to MAIN-7 if not
  5742.  
  5743. ; Stop or Break was encountered so consider CONTINUE.
  5744.  
  5745. ;; MAIN-6
  5746. L1373:  INC     (IY+$0D)        ; increment SUBPPC to next statement.
  5747.  
  5748. ;; MAIN-7
  5749. L1376:  LD      BC,$0003        ; prepare to copy 3 system variables to
  5750.         LD      DE,$5C70        ; address OSPPC - statement for CONTINUE.
  5751.                                 ; also updating OLDPPC line number below.
  5752.  
  5753.         LD      HL,$5C44        ; set source top to NSPPC next statement.
  5754.         BIT     7,(HL)          ; did BREAK occur before the jump ?
  5755.                                 ; e.g. between GO TO and next statement.
  5756.         JR      Z,L1384         ; skip forward to MAIN-8, if not, as setup
  5757.                                 ; is correct.
  5758.  
  5759.         ADD     HL,BC           ; set source to SUBPPC number of current
  5760.                                 ; statement/line which will be repeated.
  5761.  
  5762. ;; MAIN-8
  5763. L1384:  LDDR                    ; copy PPC to OLDPPC and SUBPPC to OSPCC
  5764.                                 ; or NSPPC to OLDPPC and NEWPPC to OSPCC
  5765.  
  5766. ;; MAIN-9
  5767. L1386:  LD      (IY+$0A),$FF    ; update NSPPC - signal 'no jump'.
  5768.         RES     3,(IY+$01)      ; update FLAGS  - signal use 'K' mode for
  5769.                                 ; the first character in the editor and
  5770.         JP      L12AC           ; jump back to MAIN-2.
  5771.  
  5772.  
  5773. ; ----------------------
  5774. ; Canned report messages
  5775. ; ----------------------
  5776. ; The Error reports with the last byte inverted. The first entry
  5777. ; is a dummy entry. The last, which begins with $7F, the Spectrum
  5778. ; character for copyright symbol, is placed here for convenience
  5779. ; as is the preceding comma and space.
  5780. ; The report line must accommodate a 4-digit line number and a 3-digit
  5781. ; statement number which limits the length of the message text to twenty
  5782. ; characters.
  5783. ; e.g.  "B Integer out of range, 1000:127"
  5784.  
  5785. ;; rpt-mesgs
  5786. L1391           DB $80
  5787.                 DC "OK"                         ;DB    'O','K'+$80              ; 0
  5788.                 DC "NEXT without FOR"           ;DEFM    "NEXT without FO"
  5789.                                                 ;DB    'R'+$80          ; 1
  5790.                 DC "Variable not found"         ;DEFM    "Variable not foun"
  5791.                                                 ;DB    'd'+$80          ; 2
  5792.                 DC "Subscript wrong"            ;DEFM    "Subscript wron"
  5793.                                                 ;DB    'g'+$80          ; 3
  5794.                 DC "Out of memory"              ;DEFM    "Out of memor"
  5795.                                                 ;DB    'y'+$80          ; 4
  5796.                 DC "Out of screen"              ;DEFM    "Out of scree"
  5797.                                                 ;DB    'n'+$80          ; 5
  5798.                 DC "Number too big"             ;DEFM    "Number too bi"
  5799.                                                 ;DB    'g'+$80          ; 6
  5800.                 DC "RETURN without GOSUB"       ;DEFM    "RETURN without GOSU"
  5801.                                                 ;DB    'B'+$80          ; 7
  5802.                 DC "End of file"                ;DEFM    "End of fil"
  5803.                                                 ;DB    'e'+$80          ; 8
  5804.                 DC "STOP statement"             ;DEFM    "STOP statemen"
  5805.                                                 ;DB    't'+$80          ; 9
  5806.                 DC "Invalid argument"           ;DEFM    "Invalid argumen"
  5807.                                                 ;DB    't'+$80          ; A
  5808.                 DC "Integer out of range"       ;DEFM    "Integer out of rang"
  5809.                                                 ;DB    'e'+$80          ; B
  5810.                 DC "Nonsense in BASIC"          ;DEFM    "Nonsense in BASI"
  5811.                                                 ;DB    'C'+$80          ; C
  5812.                 DC "BREAK - CONT repeats"       ;DEFM    "BREAK - CONT repeat"
  5813.                                                 ;DB    's'+$80          ; D
  5814.                 DC "Out of DATA"                ;DEFM    "Out of DAT"
  5815.                                                 ;DB    'A'+$80          ; E
  5816.                 DC "Invalid file name"          ;DEFM    "Invalid file nam"
  5817.                                                 ;DB    'e'+$80          ; F
  5818.                 DC "No room for line"           ;DEFM    "No room for lin"
  5819.                                                 ;DB    'e'+$80          ; G
  5820.                 DC "STOP in INPUT"              ;DEFM    "STOP in INPU"
  5821.                                                 ;DB    'T'+$80          ; H
  5822.                 DC "FOR without NEXT"           ;DEFM    "FOR without NEX"
  5823.                                                 ;DB    'T'+$80          ; I
  5824.                 DC "Invalid I/O device"         ;DEFM    "Invalid I/O devic"
  5825.                                                 ;DB    'e'+$80          ; J
  5826.                 DC "Invalid colour"             ;DEFM    "Invalid colou"
  5827.                                                 ;DB    'r'+$80          ; K
  5828.                 DC "BREAK into program"         ;DEFM    "BREAK into progra"
  5829.                                                 ;DB    'm'+$80          ; L
  5830.                 DC "RAMTOP no good"             ;DEFM    "RAMTOP no goo"
  5831.                                                 ;DB    'd'+$80          ; M
  5832.                 DC "Statement lost"             ;DEFM    "Statement los"
  5833.                                                 ;DB    't'+$80          ; N
  5834.                 DC "Invalid stream"             ;DEFM    "Invalid strea"
  5835.                                                 ;DB    'm'+$80          ; O
  5836.                 DC "FN without DEF"             ;DEFM    "FN without DE"
  5837.                                                 ;DB    'F'+$80          ; P
  5838.                 DC "Parameter error"            ;DEFM    "Parameter erro"
  5839.                                                 ;DB    'r'+$80          ; Q
  5840.                 DC "Tape loading error"         ;DEFM    "Tape loading erro"
  5841.                                                 ;DB    'r'+$80          ; R
  5842. L1536           EQU $-1
  5843. ;; comma-sp  
  5844. L1537           DC ", "                         ;DB    ',',' '+$80              ; used in report line.
  5845. ;; copyright
  5846. L1539           DB $7F                          ; copyright
  5847.                 DC " 1982 Sinclair Research Ltd"        ;DEFM    " 1982 Sinclair Research Lt"
  5848.                                                         ;DB    'd'+$80
  5849.  
  5850.  
  5851. ; -------------
  5852. ; REPORT-G
  5853. ; -------------
  5854. ; Note ERR_SP points here during line entry which allows the
  5855. ; normal 'Out of Memory' report to be augmented to the more
  5856. ; precise 'No Room for line' report.
  5857.  
  5858. ;; REPORT-G
  5859. ; No Room for line
  5860. L1555:  LD      A,$10           ; i.e. 'G' -$30 -$07
  5861.         LD      BC,$0000        ; this seems unnecessary.
  5862.         JP      L1313           ; jump back to MAIN-G
  5863.  
  5864. ; -----------------------------
  5865. ; Handle addition of BASIC line
  5866. ; -----------------------------
  5867. ; Note this is not a subroutine but a branch of the main execution loop.
  5868. ; System variable ERR_SP still points to editing error handler.
  5869. ; A new line is added to the BASIC program at the appropriate place.
  5870. ; An existing line with same number is deleted first.
  5871. ; Entering an existing line number deletes that line.
  5872. ; Entering a non-existent line allows the subsequent line to be edited next.
  5873.  
  5874. ;; MAIN-ADD
  5875. L155D:  LD      ($5C49),BC      ; set E_PPC to extracted line number.
  5876.         LD      HL,($5C5D)      ; fetch CH_ADD - points to location after the
  5877.                                 ; initial digits (set in E_LINE_NO).
  5878.         EX      DE,HL           ; save start of BASIC in DE.
  5879.  
  5880.         LD      HL,L1555        ; Address: REPORT-G
  5881.         PUSH    HL              ; is pushed on stack and addressed by ERR_SP.
  5882.                                 ; the only error that can occur is
  5883.                                 ; 'Out of memory'.
  5884.  
  5885.         LD      HL,($5C61)      ; fetch WORKSP - end of line.
  5886.         SCF                     ; prepare for true subtraction.
  5887.         SBC     HL,DE           ; find length of BASIC and
  5888.         PUSH    HL              ; save it on stack.
  5889.         LD      H,B             ; transfer line number
  5890.         LD      L,C             ; to HL register.
  5891.         CALL    L196E           ; routine LINE-ADDR will see if
  5892.                                 ; a line with the same number exists.
  5893.         JR      NZ,L157D        ; forward if no existing line to MAIN-ADD1.
  5894.  
  5895.         CALL    L19B8           ; routine NEXT-ONE finds the existing line.
  5896.         CALL    L19E8           ; routine RECLAIM-2 reclaims it.
  5897.  
  5898. ;; MAIN-ADD1
  5899. L157D:  POP     BC              ; retrieve the length of the new line.
  5900.         LD      A,C             ; and test if carriage return only
  5901.         DEC     A               ; i.e. one byte long.
  5902.         OR      B               ; result would be zero.
  5903.         JR      Z,L15AB         ; forward to MAIN-ADD2 is so.
  5904.  
  5905.         PUSH    BC              ; save the length again.
  5906.         INC     BC              ; adjust for inclusion
  5907.         INC     BC              ; of line number (two bytes)
  5908.         INC     BC              ; and line length
  5909.         INC     BC              ; (two bytes).
  5910.         DEC     HL              ; HL points to location before the destination
  5911.  
  5912.         LD      DE,($5C53)      ; fetch the address of PROG
  5913.         PUSH    DE              ; and save it on the stack
  5914.         CALL    L1655           ; routine MAKE-ROOM creates BC spaces in
  5915.                                 ; program area and updates pointers.
  5916.         POP     HL              ; restore old program pointer.
  5917.         LD      ($5C53),HL      ; and put back in PROG as it may have been
  5918.                                 ; altered by the POINTERS routine.
  5919.  
  5920.         POP     BC              ; retrieve BASIC length
  5921.         PUSH    BC              ; and save again.
  5922.  
  5923.         INC     DE              ; points to end of new area.
  5924.         LD      HL,($5C61)      ; set HL to WORKSP - location after edit line.
  5925.         DEC     HL              ; decrement to address end marker.
  5926.         DEC     HL              ; decrement to address carriage return.
  5927.         LDDR                    ; copy the BASIC line back to initial command.
  5928.  
  5929.         LD      HL,($5C49)      ; fetch E_PPC - line number.
  5930.         EX      DE,HL           ; swap it to DE, HL points to last of
  5931.                                 ; four locations.
  5932.         POP     BC              ; retrieve length of line.
  5933.         LD      (HL),B          ; high byte last.
  5934.         DEC     HL              ;
  5935.         LD      (HL),C          ; then low byte of length.
  5936.         DEC     HL              ;
  5937.         LD      (HL),E          ; then low byte of line number.
  5938.         DEC     HL              ;
  5939.         LD      (HL),D          ; then high byte range $0 - $27 (1-9999).
  5940.  
  5941. ;; MAIN-ADD2
  5942. L15AB:  POP     AF              ; drop the address of Report G
  5943.         JP      L12A2           ; and back to MAIN-EXEC producing a listing
  5944.                                 ; and to reset ERR_SP in EDITOR.
  5945.  
  5946.  
  5947. ; ---------------------------
  5948. ; Initial channel information
  5949. ; ---------------------------
  5950. ; This initial channel information is copied from ROM to RAM,
  5951. ; during initialization. It's new location is after the system
  5952. ; variables and is addressed by the system variable CHANS
  5953. ; which means that it can slide up and down in memory.
  5954. ; The table is never searched and the last character which could be anything
  5955. ; other than a comma provides a convenient resting place for DATADD.
  5956.  
  5957. ;; init-chan
  5958. L15AF           DW L09F4                ; PRINT-OUT
  5959.                 DW L10A8                ; KEY-INPUT
  5960.                 DB "K"
  5961.                 DW L09F4                ; PRINT-OUT
  5962.                 DW L15C4                ; REPORT-J
  5963.                 DB "S"
  5964.                 DW L0F81                ; ADD-CHAR
  5965.                 DW L15C4                ; REPORT-J
  5966.                 DB "R"
  5967. ;=======================================
  5968.                 IF AY_PRINTER
  5969.                 DW PRN_TOKEN
  5970.                 ELSE
  5971.                 DW L09F4                ; PRINT-OUT
  5972.                 ENDIF
  5973. ;=======================================
  5974.                 DW L15C4                ; REPORT-J
  5975.                 DB "P"
  5976.  
  5977.         DB    $80             ; End Marker
  5978.  
  5979. ;; REPORT-J
  5980. L15C4:  RST     08H             ; ERROR-1
  5981.         DB    $12             ; Error Report: Invalid I/O device
  5982.  
  5983.  
  5984. ; -------------------
  5985. ; Initial stream data
  5986. ; -------------------
  5987. ; This is the initial stream data for the seven streams $FD - $03 that is
  5988. ; copied from ROM to the STRMS system variables area during initialization.
  5989. ; There are reserved locations there for another 12 streams.
  5990. ; Each location contains an offset to the second byte of a channel.
  5991. ; The first byte of a channel can't be used as that would result in an
  5992. ; offset of zero for some and zero is used to denote that a stream is closed.
  5993.  
  5994. ;; init-strm
  5995. L15C6:  DB    $01, $00        ; stream $FD offset to channel 'K'
  5996.         DB    $06, $00        ; stream $FE offset to channel 'S'
  5997.         DB    $0B, $00        ; stream $FF offset to channel 'R'
  5998.  
  5999.         DB    $01, $00        ; stream $00 offset to channel 'K'
  6000.         DB    $01, $00        ; stream $01 offset to channel 'K'
  6001.         DB    $06, $00        ; stream $02 offset to channel 'S'
  6002.         DB    $10, $00        ; stream $03 offset to channel 'P'
  6003.  
  6004. ; ----------------------------
  6005. ; Control for input subroutine
  6006. ; ----------------------------
  6007. ;
  6008.  
  6009. ;; WAIT-KEY
  6010. L15D4:  BIT     5,(IY+$02)      ; test TV_FLAG - clear lower screen ?
  6011.         JR      NZ,L15DE        ; forward to WAIT-KEY1 if so.
  6012.  
  6013.         SET     3,(IY+$02)      ; update TV_FLAG - signal reprint the edit
  6014.                                 ; line to the lower screen.
  6015.  
  6016. ;; WAIT-KEY1
  6017. L15DE:  CALL    L15E6           ; routine INPUT-AD is called.
  6018.         RET     C               ; return with acceptable keys.
  6019.  
  6020.         JR      Z,L15DE         ; back to WAIT-KEY1 if no key is pressed
  6021.                                 ; or it has been handled within INPUT-AD.
  6022.  
  6023. ; Note. When inputting from the keyboard all characters are returned with
  6024. ; above conditions so this path is never taken.
  6025.  
  6026. ;; REPORT-8
  6027. L15E4:  RST     08H             ; ERROR-1
  6028.         DB    $07             ; Error Report: End of file
  6029.  
  6030. ; ------------------------------
  6031. ; Make HL point to input address
  6032. ; ------------------------------
  6033. ; This routine fetches the address of the input stream from the current
  6034. ; channel area using system variable CURCHL.
  6035.  
  6036. ;; INPUT-AD
  6037. L15E6:  EXX                     ; switch in alternate set.
  6038.         PUSH    HL              ; save HL register
  6039.         LD      HL,($5C51)      ; fetch address of CURCHL - current channel.
  6040.         INC     HL              ; step over output routine
  6041.         INC     HL              ; to point to low byte of input routine.
  6042.         JR      L15F7           ; forward to CALL-SUB.
  6043.  
  6044. ; -------------------
  6045. ; Main Output Routine
  6046. ; -------------------
  6047. ; The entry point OUT-CODE is called on five occasions to print
  6048. ; the ASCII equivalent of a value 0-9.
  6049. ;
  6050. ; PRINT-A-2 is a continuation of the RST 10 to print any character.
  6051. ; Both print to the current channel and the printing of control codes
  6052. ; may alter that channel to divert subsequent RST 10 instructions
  6053. ; to temporary routines. The normal channel is $09F4.
  6054.  
  6055. ;; OUT-CODE
  6056. L15EF:  LD      E,$30           ; add 48 decimal to give ASCII
  6057.         ADD     A,E             ; character '0' to '9'.
  6058.  
  6059. ;; PRINT-A-2
  6060. L15F2:  EXX                     ; switch in alternate set
  6061.         PUSH    HL              ; save HL register
  6062.         LD      HL,($5C51)      ; fetch CURCHL the current channel.
  6063.  
  6064. ; input-ad rejoins here also.
  6065.  
  6066. ;; CALL-SUB
  6067. L15F7:  LD      E,(HL)          ; put the low byte in E.
  6068.         INC     HL              ; advance address.
  6069.         LD      D,(HL)          ; put the high byte to D.
  6070.         EX      DE,HL           ; transfer the stream to HL.
  6071.         CALL    L162C           ; use routine CALL-JUMP.
  6072.                                 ; in effect CALL (HL).
  6073.  
  6074.         POP     HL              ; restore saved HL register.
  6075.         EXX                     ; switch back to the main set and
  6076.         RET                     ; return.
  6077.  
  6078. ; ------------
  6079. ; Open channel
  6080. ; ------------
  6081. ; This subroutine is used by the ROM to open a channel 'K', 'S', 'R' or 'P'.
  6082. ; This is either for its own use or in response to a user's request, for
  6083. ; example, when '#' is encountered with output - PRINT, LIST etc.
  6084. ; or with input - INPUT, INKEY$ etc.
  6085. ; it is entered with a system stream $FD - $FF, or a user stream $00 - $0F
  6086. ; in the accumulator.
  6087.  
  6088. ;; CHAN-OPEN
  6089. L1601:  ADD     A,A             ; double the stream ($FF will become $FE etc.)
  6090.         ADD     A,$16           ; add the offset to stream 0 from $5C00
  6091.         LD      L,A             ; result to L
  6092.         LD      H,$5C           ; now form the address in STRMS area.
  6093.         LD      E,(HL)          ; fetch low byte of CHANS offset
  6094.         INC     HL              ; address next
  6095.         LD      D,(HL)          ; fetch high byte of offset
  6096.         LD      A,D             ; test that the stream is open.
  6097.         OR      E               ; zero if closed.
  6098.         JR      NZ,L1610        ; forward to CHAN-OP-1 if open.
  6099.  
  6100. ;; REPORT-Oa
  6101. L160E:  RST     08H             ; ERROR-1
  6102.         DB    $17             ; Error Report: Invalid stream
  6103.  
  6104. ; continue here if stream was open. Note that the offset is from CHANS
  6105. ; to the second byte of the channel.
  6106.  
  6107. ;; CHAN-OP-1
  6108. L1610:  DEC     DE              ; reduce offset so it points to the channel.
  6109.         LD      HL,($5C4F)      ; fetch CHANS the location of the base of
  6110.                                 ; the channel information area
  6111.         ADD     HL,DE           ; and add the offset to address the channel.
  6112.                                 ; and continue to set flags.
  6113.  
  6114. ; -----------------
  6115. ; Set channel flags
  6116. ; -----------------
  6117. ; This subroutine is used from ED-EDIT, str$ and read-in to reset the
  6118. ; current channel when it has been temporarily altered.
  6119.  
  6120. ;; CHAN-FLAG
  6121. L1615:  LD      ($5C51),HL      ; set CURCHL system variable to the
  6122.                                 ; address in HL
  6123.         RES     4,(IY+$30)      ; update FLAGS2  - signal K channel not in use.
  6124.                                 ; Note. provide a default for channel 'R'.
  6125.         INC     HL              ; advance past
  6126.         INC     HL              ; output routine.
  6127.         INC     HL              ; advance past
  6128.         INC     HL              ; input routine.
  6129.         LD      C,(HL)          ; pick up the letter.
  6130.         LD      HL,L162D        ; address: chn-cd-lu
  6131.         CALL    L16DC           ; routine INDEXER finds offset to a
  6132.                                 ; flag-setting routine.
  6133.  
  6134.         RET     NC              ; but if the letter wasn't found in the
  6135.                                 ; table just return now. - channel 'R'.
  6136.  
  6137.         LD      D,$00           ; prepare to add
  6138.         LD      E,(HL)          ; offset to E
  6139.         ADD     HL,DE           ; add offset to location of offset to form
  6140.                                 ; address of routine
  6141.  
  6142. ;; CALL-JUMP
  6143. L162C:  JP      (HL)            ; jump to the routine
  6144.  
  6145. ; Footnote. calling any location that holds JP (HL) is the equivalent to
  6146. ; a pseudo Z80 instruction CALL (HL). The ROM uses the instruction above.
  6147.  
  6148. ; --------------------------
  6149. ; Channel code look-up table
  6150. ; --------------------------
  6151. ; This table is used by the routine above to find one of the three
  6152. ; flag setting routines below it.
  6153. ; A zero end-marker is required as channel 'R' is not present.
  6154.  
  6155. ;; chn-cd-lu
  6156. L162D:  DB    'K', L1634-$-1  ; offset $06 to CHAN-K
  6157.         DB    'S', L1642-$-1  ; offset $12 to CHAN-S
  6158.         DB    'P', L164D-$-1  ; offset $1B to CHAN-P
  6159.  
  6160.         DB    $00             ; end marker.
  6161.  
  6162. ; --------------
  6163. ; Channel K flag
  6164. ; --------------
  6165. ; routine to set flags for lower screen/keyboard channel.
  6166.  
  6167. ;; CHAN-K
  6168. L1634:  SET     0,(IY+$02)      ; update TV_FLAG  - signal lower screen in use
  6169.         RES     5,(IY+$01)      ; update FLAGS    - signal no new key
  6170.         SET     4,(IY+$30)      ; update FLAGS2   - signal K channel in use
  6171.         JR      L1646           ; forward to CHAN-S-1 for indirect exit
  6172.  
  6173. ; --------------
  6174. ; Channel S flag
  6175. ; --------------
  6176. ; routine to set flags for upper screen channel.
  6177.  
  6178. ;; CHAN-S
  6179. L1642:  RES     0,(IY+$02)      ; TV_FLAG  - signal main screen in use
  6180.  
  6181. ;; CHAN-S-1
  6182. L1646:  RES     1,(IY+$01)      ; update FLAGS  - signal printer not in use
  6183.         JP      L0D4D           ; jump back to TEMPS and exit via that
  6184.                                 ; routine after setting temporary attributes.
  6185. ; --------------
  6186. ; Channel P flag
  6187. ; --------------
  6188. ; This routine sets a flag so that subsequent print related commands
  6189. ; print to printer or update the relevant system variables.
  6190. ; This status remains in force until reset by the routine above.
  6191.  
  6192. ;; CHAN-P
  6193. L164D:  SET     1,(IY+$01)      ; update FLAGS  - signal printer in use
  6194.         RET                     ; return
  6195.  
  6196. ; -----------------------
  6197. ; Just one space required
  6198. ; -----------------------
  6199. ; This routine is called once only to create a single space
  6200. ; in workspace by ADD-CHAR. It is slightly quicker than using a RST $30.
  6201. ; There are several instances in the calculator where the sequence
  6202. ; ld bc, 1; rst $30 could be replaced by a call to this routine but it
  6203. ; only gives a saving of one byte each time.
  6204.  
  6205. ;; ONE-SPACE
  6206. L1652:  LD      BC,$0001        ; create space for a single character.
  6207.  
  6208. ; ---------
  6209. ; Make Room
  6210. ; ---------
  6211. ; This entry point is used to create BC spaces in various areas such as
  6212. ; program area, variables area, workspace etc..
  6213. ; The entire free RAM is available to each BASIC statement.
  6214. ; On entry, HL addresses where the first location is to be created.
  6215. ; Afterwards, HL will point to the location before this.
  6216.  
  6217. ;; MAKE-ROOM
  6218. L1655:  PUSH    HL              ; save the address pointer.
  6219.         CALL    L1F05           ; routine TEST-ROOM checks if room
  6220.                                 ; exists and generates an error if not.
  6221.         POP     HL              ; restore the address pointer.
  6222.         CALL    L1664           ; routine POINTERS updates the
  6223.                                 ; dynamic memory location pointers.
  6224.                                 ; DE now holds the old value of STKEND.
  6225.         LD      HL,($5C65)      ; fetch new STKEND the top destination.
  6226.  
  6227.         EX      DE,HL           ; HL now addresses the top of the area to
  6228.                                 ; be moved up - old STKEND.
  6229.         LDDR                    ; the program, variables, etc are moved up.
  6230.         RET                     ; return with new area ready to be populated.
  6231.                                 ; HL points to location before new area,
  6232.                                 ; and DE to last of new locations.
  6233.  
  6234. ; -----------------------------------------------
  6235. ; Adjust pointers before making or reclaiming room
  6236. ; -----------------------------------------------
  6237. ; This routine is called by MAKE-ROOM to adjust upwards and by RECLAIM to
  6238. ; adjust downwards the pointers within dynamic memory.
  6239. ; The fourteen pointers to dynamic memory, starting with VARS and ending
  6240. ; with STKEND, are updated adding BC if they are higher than the position
  6241. ; in HL.  
  6242. ; The system variables are in no particular order except that STKEND, the first
  6243. ; free location after dynamic memory must be the last encountered.
  6244.  
  6245. ;; POINTERS
  6246. L1664:  PUSH    AF              ; preserve accumulator.
  6247.         PUSH    HL              ; put pos pointer on stack.
  6248.         LD      HL,$5C4B        ; address VARS the first of the
  6249.         LD      A,$0E           ; fourteen variables to consider.
  6250.  
  6251. ;; PTR-NEXT
  6252. L166B:  LD      E,(HL)          ; fetch the low byte of the system variable.
  6253.         INC     HL              ; advance address.
  6254.         LD      D,(HL)          ; fetch high byte of the system variable.
  6255.         EX      (SP),HL         ; swap pointer on stack with the variable
  6256.                                 ; pointer.
  6257.         AND     A               ; prepare to subtract.
  6258.         SBC     HL,DE           ; subtract variable address
  6259.         ADD     HL,DE           ; and add back
  6260.         EX      (SP),HL         ; swap pos with system variable pointer
  6261.         JR      NC,L167F        ; forward to PTR-DONE if var before pos
  6262.  
  6263.         PUSH    DE              ; save system variable address.
  6264.         EX      DE,HL           ; transfer to HL
  6265.         ADD     HL,BC           ; add the offset
  6266.         EX      DE,HL           ; back to DE
  6267.         LD      (HL),D          ; load high byte
  6268.         DEC     HL              ; move back
  6269.         LD      (HL),E          ; load low byte
  6270.         INC     HL              ; advance to high byte
  6271.         POP     DE              ; restore old system variable address.
  6272.  
  6273. ;; PTR-DONE
  6274. L167F:  INC     HL              ; address next system variable.
  6275.         DEC     A               ; decrease counter.
  6276.         JR      NZ,L166B        ; back to PTR-NEXT if more.
  6277.         EX      DE,HL           ; transfer old value of STKEND to HL.
  6278.                                 ; Note. this has always been updated.
  6279.         POP     DE              ; pop the address of the position.
  6280.  
  6281.         POP     AF              ; pop preserved accumulator.
  6282.         AND     A               ; clear carry flag preparing to subtract.
  6283.  
  6284.         SBC     HL,DE           ; subtract position from old stkend
  6285.         LD      B,H             ; to give number of data bytes
  6286.         LD      C,L             ; to be moved.
  6287.         INC     BC              ; increment as we also copy byte at old STKEND.
  6288.         ADD     HL,DE           ; recompute old stkend.
  6289.         EX      DE,HL           ; transfer to DE.
  6290.         RET                     ; return.
  6291.  
  6292.  
  6293.  
  6294. ; -------------------
  6295. ; Collect line number
  6296. ; -------------------
  6297. ; This routine extracts a line number, at an address that has previously
  6298. ; been found using LINE-ADDR, and it is entered at LINE-NO. If it encounters
  6299. ; the program 'end-marker' then the previous line is used and if that
  6300. ; should also be unacceptable then zero is used as it must be a direct
  6301. ; command. The program end-marker is the variables end-marker $80, or
  6302. ; if variables exist, then the first character of any variable name.
  6303.  
  6304. ;; LINE-ZERO
  6305. L168F:  DB    $00, $00        ; dummy line number used for direct commands
  6306.  
  6307.  
  6308. ;; LINE-NO-A
  6309. L1691:  EX      DE,HL           ; fetch the previous line to HL and set
  6310.         LD      DE,$168F        ; DE to LINE-ZERO should HL also fail.
  6311.  
  6312. ; -> The Entry Point.
  6313.  
  6314. ;; LINE-NO
  6315. L1695:  LD      A,(HL)          ; fetch the high byte - max $2F
  6316.         AND     $C0             ; mask off the invalid bits.
  6317.         JR      NZ,L1691        ; to LINE-NO-A if an end-marker.
  6318.  
  6319.         LD      D,(HL)          ; reload the high byte.
  6320.         INC     HL              ; advance address.
  6321.         LD      E,(HL)          ; pick up the low byte.
  6322.         RET                     ; return from here.
  6323.  
  6324. ; -------------------
  6325. ; Handle reserve room
  6326. ; -------------------
  6327. ; This is a continuation of the restart BC-SPACES
  6328.  
  6329. ;; RESERVE
  6330. L169E:  LD      HL,($5C63)      ; STKBOT first location of calculator stack
  6331.         DEC     HL              ; make one less than new location
  6332.         CALL    L1655           ; routine MAKE-ROOM creates the room.
  6333.         INC     HL              ; address the first new location
  6334.         INC     HL              ; advance to second
  6335.         POP     BC              ; restore old WORKSP
  6336.         LD      ($5C61),BC      ; system variable WORKSP was perhaps
  6337.                                 ; changed by POINTERS routine.
  6338.         POP     BC              ; restore count for return value.
  6339.         EX      DE,HL           ; switch. DE = location after first new space
  6340.         INC     HL              ; HL now location after new space
  6341.         RET                     ; return.
  6342.  
  6343. ; ---------------------------
  6344. ; Clear various editing areas
  6345. ; ---------------------------
  6346. ; This routine sets the editing area, workspace and calculator stack
  6347. ; to their minimum configurations as at initialization and indeed this
  6348. ; routine could have been relied on to perform that task.
  6349. ; This routine uses HL only and returns with that register holding
  6350. ; WORKSP/STKBOT/STKEND though no use is made of this. The routines also
  6351. ; reset MEM to its usual place in the systems variable area should it
  6352. ; have been relocated to a FOR-NEXT variable. The main entry point
  6353. ; SET-MIN is called at the start of the MAIN-EXEC loop and prior to
  6354. ; displaying an error.
  6355.  
  6356. ;; SET-MIN
  6357. L16B0:  LD      HL,($5C59)      ; fetch E_LINE
  6358.         LD      (HL),$0D        ; insert carriage return
  6359.         LD      ($5C5B),HL      ; make K_CUR keyboard cursor point there.
  6360.         INC     HL              ; next location
  6361.         LD      (HL),$80        ; holds end-marker $80
  6362.         INC     HL              ; next location becomes
  6363.         LD      ($5C61),HL      ; start of WORKSP
  6364.  
  6365. ; This entry point is used prior to input and prior to the execution,
  6366. ; or parsing, of each statement.
  6367.  
  6368. ;; SET-WORK
  6369. L16BF:  LD      HL,($5C61)      ; fetch WORKSP value
  6370.         LD      ($5C63),HL      ; and place in STKBOT
  6371.  
  6372. ; This entry point is used to move the stack back to its normal place
  6373. ; after temporary relocation during line entry and also from ERROR-3
  6374.  
  6375. ;; SET-STK
  6376. L16C5:  LD      HL,($5C63)      ; fetch STKBOT value
  6377.         LD      ($5C65),HL      ; and place in STKEND.
  6378.  
  6379.         PUSH    HL              ; perhaps an obsolete entry point.
  6380.         LD      HL,$5C92        ; normal location of MEM-0
  6381.         LD      ($5C68),HL      ; is restored to system variable MEM.
  6382.         POP     HL              ; saved value not required.
  6383.         RET                     ; return.
  6384.  
  6385. ; ------------------
  6386. ; Reclaim edit-line?
  6387. ; ------------------
  6388. ; This seems to be legacy code from the ZX80/ZX81 as it is
  6389. ; not used in this ROM.
  6390. ; That task, in fact, is performed here by the dual-area routine CLEAR-SP.
  6391. ; This routine is designed to deal with something that is known to be in the
  6392. ; edit buffer and not workspace.
  6393. ; On entry, HL must point to the end of the something to be deleted.
  6394.  
  6395. ;; REC-EDIT
  6396. L16D4:  LD      DE,($5C59)      ; fetch start of edit line from E_LINE.
  6397.         JP      L19E5           ; jump forward to RECLAIM-1.
  6398.  
  6399. ; --------------------------
  6400. ; The Table INDEXING routine
  6401. ; --------------------------
  6402. ; This routine is used to search two-byte hash tables for a character
  6403. ; held in C, returning the address of the following offset byte.
  6404. ; if it is known that the character is in the table e.g. for priorities,
  6405. ; then the table requires no zero end-marker. If this is not known at the
  6406. ; outset then a zero end-marker is required and carry is set to signal
  6407. ; success.
  6408.  
  6409. ;; INDEXER-1
  6410. L16DB:  INC     HL              ; address the next pair of values.
  6411.  
  6412. ; -> The Entry Point.
  6413.  
  6414. ;; INDEXER
  6415. L16DC:  LD      A,(HL)          ; fetch the first byte of pair
  6416.         AND     A               ; is it the end-marker ?
  6417.         RET     Z               ; return with carry reset if so.
  6418.  
  6419.         CP      C               ; is it the required character ?
  6420.         INC     HL              ; address next location.
  6421.         JR      NZ,L16DB        ; back to INDEXER-1 if no match.
  6422.  
  6423.         SCF                     ; else set the carry flag.
  6424.         RET                     ; return with carry set
  6425.  
  6426. ; --------------------------------
  6427. ; The Channel and Streams Routines
  6428. ; --------------------------------
  6429. ; A channel is an input/output route to a hardware device
  6430. ; and is identified to the system by a single letter e.g. 'K' for
  6431. ; the keyboard. A channel can have an input and output route
  6432. ; associated with it in which case it is bi-directional like
  6433. ; the keyboard. Others like the upper screen 'S' are output
  6434. ; only and the input routine usually points to a report message.
  6435. ; Channels 'K' and 'S' are system channels and it would be inappropriate
  6436. ; to close the associated streams so a mechanism is provided to
  6437. ; re-attach them. When the re-attachment is no longer required, then
  6438. ; closing these streams resets them as at initialization.
  6439. ; The same also would have applied to channel 'R', the RS232 channel
  6440. ; as that is used by the system. It's input stream seems to have been
  6441. ; removed and it is not available to the user. However the channel could
  6442. ; not be removed entirely as its output routine was used by the system.
  6443. ; As a result of removing this channel, channel 'P', the printer is
  6444. ; erroneously treated as a system channel.
  6445. ; Ironically the tape streamer is not accessed through streams and
  6446. ; channels.
  6447. ; Early demonstrations of the Spectrum showed a single microdrive being
  6448. ; controlled by this ROM. Adverts also said that the network and RS232
  6449. ; were in this ROM. Channels 'M' and 'N' are user channels and have been
  6450. ; removed successfully if, as seems vaguely possible, they existed.
  6451.  
  6452. ; ---------------------
  6453. ; Handle CLOSE# command
  6454. ; ---------------------
  6455. ; This command allows streams to be closed after use.
  6456. ; Any temporary memory areas used by the stream would be reclaimed and
  6457. ; finally flags set or reset if necessary.
  6458.  
  6459. ;; CLOSE
  6460. L16E5:  CALL    L171E           ; routine STR-DATA fetches parameter
  6461.                                 ; from calculator stack and gets the
  6462.                                 ; existing STRMS data pointer address in HL
  6463.                                 ; and stream offset from CHANS in BC.
  6464.  
  6465.                                 ; Note. this offset could be zero if the
  6466.                                 ; stream is already closed. A check for this
  6467.                                 ; should occur now and an error should be
  6468.                                 ; generated, for example,
  6469.                                 ; Report S 'Stream already closed'.
  6470.  
  6471.         CALL    L1701           ; routine CLOSE-2 would perform any actions
  6472.                                 ; peculiar to that stream without disturbing
  6473.                                 ; data pointer to STRMS entry in HL.
  6474.  
  6475.         LD      BC,$0000        ; the stream is to be blanked.
  6476.         LD      DE,$A3E2        ; the number of bytes from stream 4, $5C1E,
  6477.                                 ; to $10000
  6478.         EX      DE,HL           ; transfer offset to HL, STRMS data pointer
  6479.                                 ; to DE.
  6480.         ADD     HL,DE           ; add the offset to the data pointer.  
  6481.         JR      C,L16FC         ; forward to CLOSE-1 if a non-system stream.
  6482.                                 ; i.e. higher than 3.
  6483.  
  6484. ; proceed with a negative result.
  6485.  
  6486.         LD      BC,L15C6 + 14   ; prepare the address of the byte after
  6487.                                 ; the initial stream data in ROM. ($15D4)
  6488.         ADD     HL,BC           ; index into the data table with negative value.
  6489.         LD      C,(HL)          ; low byte to C
  6490.         INC     HL              ; address next.
  6491.         LD      B,(HL)          ; high byte to B.
  6492.  
  6493. ; and for streams 0 - 3 just enter the initial data back into the STRMS entry
  6494. ; streams 0 - 2 can't be closed as they are shared by the operating system.
  6495. ; -> for streams 4 - 15 then blank the entry.
  6496.  
  6497. ;; CLOSE-1
  6498. L16FC:  EX      DE,HL           ; address of stream to HL.
  6499.         LD      (HL),C          ; place zero (or low byte).
  6500.         INC     HL              ; next address.
  6501.         LD      (HL),B          ; place zero (or high byte).
  6502.         RET                     ; return.
  6503.  
  6504. ; ------------------
  6505. ; CLOSE-2 Subroutine
  6506. ; ------------------
  6507. ; There is not much point in coming here.
  6508. ; The purpose was once to find the offset to a special closing routine,
  6509. ; in this ROM and within 256 bytes of the close stream look up table that
  6510. ; would reclaim any buffers associated with a stream. At least one has been
  6511. ; removed.
  6512.  
  6513. ;; CLOSE-2
  6514. L1701:  PUSH    HL              ; * save address of stream data pointer
  6515.                                 ; in STRMS on the machine stack.
  6516.         LD      HL,($5C4F)      ; fetch CHANS address to HL
  6517.         ADD     HL,BC           ; add the offset to address the second
  6518.                                 ; byte of the output routine hopefully.
  6519.         INC     HL              ; step past
  6520.         INC     HL              ; the input routine.
  6521.         INC     HL              ; to address channel's letter
  6522.         LD      C,(HL)          ; pick it up in C.
  6523.                                 ; Note. but if stream is already closed we
  6524.                                 ; get the value $10 (the byte preceding 'K').
  6525.         EX      DE,HL           ; save the pointer to the letter in DE.
  6526.         LD      HL,L1716        ; address: cl-str-lu in ROM.
  6527.         CALL    L16DC           ; routine INDEXER uses the code to get
  6528.                                 ; the 8-bit offset from the current point to
  6529.                                 ; the address of the closing routine in ROM.
  6530.                                 ; Note. it won't find $10 there!
  6531.         LD      C,(HL)          ; transfer the offset to C.
  6532.         LD      B,$00           ; prepare to add.
  6533.         ADD     HL,BC           ; add offset to point to the address of the
  6534.                                 ; routine that closes the stream.
  6535.                                 ; (and presumably removes any buffers that
  6536.                                 ; are associated with it.)
  6537.         JP      (HL)            ; jump to that routine.
  6538.  
  6539. ; --------------------------
  6540. ; CLOSE stream look-up table
  6541. ; --------------------------
  6542. ; This table contains an entry for a letter found in the CHANS area.
  6543. ; followed by an 8-bit displacement, from that byte's address in the
  6544. ; table to the routine that performs any ancillary actions associated
  6545. ; with closing the stream of that channel.
  6546. ; The table doesn't require a zero end-marker as the letter has been
  6547. ; picked up from a channel that has an open stream.
  6548.  
  6549. ;; cl-str-lu
  6550. L1716:  DB    'K', L171C-$-1  ; offset 5 to CLOSE-STR
  6551.         DB    'S', L171C-$-1  ; offset 3 to CLOSE-STR
  6552.         DB    'P', L171C-$-1  ; offset 1 to CLOSE-STR
  6553.  
  6554.  
  6555. ; ------------------------
  6556. ; Close Stream Subroutines
  6557. ; ------------------------
  6558. ; The close stream routines in fact have no ancillary actions to perform
  6559. ; which is not surprising with regard to 'K' and 'S'.
  6560.  
  6561. ;; CLOSE-STR                    
  6562. L171C:  POP     HL              ; * now just restore the stream data pointer
  6563.         RET                     ; in STRMS and return.
  6564.  
  6565. ; -----------
  6566. ; Stream data
  6567. ; -----------
  6568. ; This routine finds the data entry in the STRMS area for the specified
  6569. ; stream which is passed on the calculator stack. It returns with HL
  6570. ; pointing to this system variable and BC holding a displacement from
  6571. ; the CHANS area to the second byte of the stream's channel. If BC holds
  6572. ; zero, then that signifies that the stream is closed.
  6573.  
  6574. ;; STR-DATA
  6575. L171E:  CALL    L1E94           ; routine FIND-INT1 fetches parameter to A
  6576.         CP      $10             ; is it less than 16d ?
  6577.         JR      C,L1727         ; skip forward to STR-DATA1 if so.
  6578.  
  6579. ;; REPORT-Ob
  6580. L1725:  RST     08H             ; ERROR-1
  6581.         DB    $17             ; Error Report: Invalid stream
  6582.  
  6583. ;; STR-DATA1
  6584. L1727:  ADD     A,$03           ; add the offset for 3 system streams.
  6585.                                 ; range 00 - 15d becomes 3 - 18d.
  6586.         RLCA                    ; double as there are two bytes per
  6587.                                 ; stream - now 06 - 36d
  6588.         LD      HL,$5C10        ; address STRMS - the start of the streams
  6589.                                 ; data area in system variables.
  6590.         LD      C,A             ; transfer the low byte to A.
  6591.         LD      B,$00           ; prepare to add offset.
  6592.         ADD     HL,BC           ; add to address the data entry in STRMS.
  6593.  
  6594. ; the data entry itself contains an offset from CHANS to the address of the
  6595. ; stream
  6596.  
  6597.         LD      C,(HL)          ; low byte of displacement to C.
  6598.         INC     HL              ; address next.
  6599.         LD      B,(HL)          ; high byte of displacement to B.
  6600.         DEC     HL              ; step back to leave HL pointing to STRMS
  6601.                                 ; data entry.
  6602.         RET                     ; return with CHANS displacement in BC
  6603.                                 ; and address of stream data entry in HL.
  6604.  
  6605. ; --------------------
  6606. ; Handle OPEN# command
  6607. ; --------------------
  6608. ; Command syntax example: OPEN #5,"s"
  6609. ; On entry the channel code entry is on the calculator stack with the next
  6610. ; value containing the stream identifier. They have to swapped.
  6611.  
  6612. ;; OPEN
  6613. L1736:  RST     28H             ;; FP-CALC    ;s,c.
  6614.         DB    $01             ;;exchange    ;c,s.
  6615.         DB    $38             ;;end-calc
  6616.  
  6617.         CALL    L171E           ; routine STR-DATA fetches the stream off
  6618.                                 ; the stack and returns with the CHANS
  6619.                                 ; displacement in BC and HL addressing
  6620.                                 ; the STRMS data entry.
  6621.         LD      A,B             ; test for zero which
  6622.         OR      C               ; indicates the stream is closed.
  6623.         JR      Z,L1756         ; skip forward to OPEN-1 if so.
  6624.  
  6625. ; if it is a system channel then it can re-attached.
  6626.  
  6627.         EX      DE,HL           ; save STRMS address in DE.
  6628.         LD      HL,($5C4F)      ; fetch CHANS.
  6629.         ADD     HL,BC           ; add the offset to address the second
  6630.                                 ; byte of the channel.
  6631.         INC     HL              ; skip over the
  6632.         INC     HL              ; input routine.
  6633.         INC     HL              ; and address the letter.
  6634.         LD      A,(HL)          ; pick up the letter.
  6635.         EX      DE,HL           ; save letter pointer and bring back
  6636.                                 ; the STRMS pointer.
  6637.  
  6638.         CP      $4B             ; is it 'K' ?
  6639.         JR      Z,L1756         ; forward to OPEN-1 if so
  6640.  
  6641.         CP      $53             ; is it 'S' ?
  6642.         JR      Z,L1756         ; forward to OPEN-1 if so
  6643.  
  6644.         CP      $50             ; is it 'P' ?
  6645.         JR      NZ,L1725        ; back to REPORT-Ob if not.
  6646.                                 ; to report 'Invalid stream'.
  6647.  
  6648. ; continue if one of the upper-case letters was found.
  6649. ; and rejoin here from above if stream was closed.
  6650.  
  6651. ;; OPEN-1
  6652. L1756:  CALL    L175D           ; routine OPEN-2 opens the stream.
  6653.  
  6654. ; it now remains to update the STRMS variable.
  6655.  
  6656.         LD      (HL),E          ; insert or overwrite the low byte.
  6657.         INC     HL              ; address high byte in STRMS.
  6658.         LD      (HL),D          ; insert or overwrite the high byte.
  6659.         RET                     ; return.
  6660.  
  6661. ; -----------------
  6662. ; OPEN-2 Subroutine
  6663. ; -----------------
  6664. ; There is some point in coming here as, as well as once creating buffers,
  6665. ; this routine also sets flags.
  6666.  
  6667. ;; OPEN-2
  6668. L175D:  PUSH    HL              ; * save the STRMS data entry pointer.
  6669.         CALL    L2BF1           ; routine STK-FETCH now fetches the
  6670.                                 ; parameters of the channel string.
  6671.                                 ; start in DE, length in BC.
  6672.  
  6673.         LD      A,B             ; test that it is not
  6674.         OR      C               ; the null string.
  6675.         JR      NZ,L1767        ; skip forward to OPEN-3 with 1 character
  6676.                                 ; or more!
  6677.  
  6678. ;; REPORT-Fb
  6679. L1765:  RST     08H             ; ERROR-1
  6680.         DB    $0E             ; Error Report: Invalid file name
  6681.  
  6682. ;; OPEN-3
  6683. L1767:  PUSH    BC              ; save the length of the string.
  6684.         LD      A,(DE)          ; pick up the first character.
  6685.                                 ; Note. if the second character is used to
  6686.                                 ; distinguish between a binary or text
  6687.                                 ; channel then it will be simply a matter
  6688.                                 ; of setting bit 7 of FLAGX.
  6689.         AND     $DF             ; make it upper-case.
  6690.         LD      C,A             ; place it in C.
  6691.         LD      HL,L177A        ; address: op-str-lu is loaded.
  6692.         CALL    L16DC           ; routine INDEXER will search for letter.
  6693.         JR      NC,L1765        ; back to REPORT-F if not found
  6694.                                 ; 'Invalid filename'
  6695.  
  6696.         LD      C,(HL)          ; fetch the displacement to opening routine.
  6697.         LD      B,$00           ; prepare to add.
  6698.         ADD     HL,BC           ; now form address of opening routine.
  6699.         POP     BC              ; restore the length of string.
  6700.         JP      (HL)            ; now jump forward to the relevant routine.
  6701.  
  6702. ; -------------------------
  6703. ; OPEN stream look-up table
  6704. ; -------------------------
  6705. ; The open stream look-up table consists of matched pairs.
  6706. ; The channel letter is followed by an 8-bit displacement to the
  6707. ; associated stream-opening routine in this ROM.
  6708. ; The table requires a zero end-marker as the letter has been
  6709. ; provided by the user and not the operating system.
  6710.  
  6711. ;; op-str-lu
  6712. L177A:  DB    'K', L1781-$-1  ; $06 offset to OPEN-K
  6713.         DB    'S', L1785-$-1  ; $08 offset to OPEN-S
  6714.         DB    'P', L1789-$-1  ; $0A offset to OPEN-P
  6715.  
  6716.         DB    $00             ; end-marker.
  6717.  
  6718. ; ----------------------------
  6719. ; The Stream Opening Routines.
  6720. ; ----------------------------
  6721. ; These routines would have opened any buffers associated with the stream
  6722. ; before jumping forward to to OPEN-END with the displacement value in E
  6723. ; and perhaps a modified value in BC. The strange pathing does seem to
  6724. ; provide for flexibility in this respect.
  6725. ;
  6726. ; There is no need to open the printer buffer as it is there already
  6727. ; even if you are still saving up for a ZX Printer or have moved onto
  6728. ; something bigger. In any case it would have to be created after
  6729. ; the system variables but apart from that it is a simple task
  6730. ; and all but one of the ROM routines can handle a buffer in that position.
  6731. ; (PR-ALL-6 would require an extra 3 bytes of code).
  6732. ; However it wouldn't be wise to have two streams attached to the ZX Printer
  6733. ; as you can now, so one assumes that if PR_CC_hi was non-zero then
  6734. ; the OPEN-P routine would have refused to attach a stream if another
  6735. ; stream was attached.
  6736.  
  6737. ; Something of significance is being passed to these ghost routines in the
  6738. ; second character. Strings 'RB', 'RT' perhaps or a drive/station number.
  6739. ; The routine would have to deal with that and exit to OPEN_END with BC
  6740. ; containing $0001 or more likely there would be an exit within the routine.
  6741. ; Anyway doesn't matter, these routines are long gone.
  6742.  
  6743. ; -----------------
  6744. ; OPEN-K Subroutine
  6745. ; -----------------
  6746. ; Open Keyboard stream.
  6747.  
  6748. ;; OPEN-K
  6749. L1781:  LD      E,$01           ; 01 is offset to second byte of channel 'K'.
  6750.         JR      L178B           ; forward to OPEN-END
  6751.  
  6752. ; -----------------
  6753. ; OPEN-S Subroutine
  6754. ; -----------------
  6755. ; Open Screen stream.
  6756.  
  6757. ;; OPEN-S
  6758. L1785:  LD      E,$06           ; 06 is offset to 2nd byte of channel 'S'
  6759.         JR      L178B           ; to OPEN-END
  6760.  
  6761. ; -----------------
  6762. ; OPEN-P Subroutine
  6763. ; -----------------
  6764. ; Open Printer stream.
  6765.  
  6766. ;; OPEN-P
  6767. L1789:  LD      E,$10           ; 16d is offset to 2nd byte of channel 'P'
  6768.  
  6769. ;; OPEN-END
  6770. L178B:  DEC     BC              ; the stored length of 'K','S','P' or
  6771.                                 ; whatever is now tested. ??
  6772.         LD      A,B             ; test now if initial or residual length
  6773.         OR      C               ; is one character.
  6774.         JR      NZ,L1765        ; to REPORT-Fb 'Invalid file name' if not.
  6775.  
  6776.         LD      D,A             ; load D with zero to form the displacement
  6777.                                 ; in the DE register.
  6778.         POP     HL              ; * restore the saved STRMS pointer.
  6779.         RET                     ; return to update STRMS entry thereby
  6780.                                 ; signaling stream is open.
  6781.  
  6782. ; ----------------------------------------
  6783. ; Handle CAT, ERASE, FORMAT, MOVE commands
  6784. ; ----------------------------------------
  6785. ; These just generate an error report as the ROM is 'incomplete'.
  6786. ;
  6787. ; Luckily this provides a mechanism for extending these in a shadow ROM
  6788. ; but without the powerful mechanisms set up in this ROM.
  6789. ; An instruction fetch on $0008 may page in a peripheral ROM,
  6790. ; e.g. the Sinclair Interface 1 ROM, to handle these commands.
  6791. ; However that wasn't the plan.
  6792. ; Development of this ROM continued for another three months until the cost
  6793. ; of replacing it and the manual became unfeasible.
  6794. ; The ultimate power of channels and streams died at birth.
  6795.  
  6796. ;; CAT-ETC
  6797. L1793:  JR      L1725           ; to REPORT-Ob
  6798.  
  6799. ; -----------------
  6800. ; Perform AUTO-LIST
  6801. ; -----------------
  6802. ; This produces an automatic listing in the upper screen.
  6803.  
  6804. ;; AUTO-LIST
  6805. L1795:  LD      ($5C3F),SP      ; save stack pointer in LIST_SP
  6806.         LD      (IY+$02),$10    ; update TV_FLAG set bit 3
  6807.         CALL    L0DAF           ; routine CL-ALL.
  6808.         SET     0,(IY+$02)      ; update TV_FLAG  - signal lower screen in use
  6809.  
  6810.         LD      B,(IY+$31)      ; fetch DF_SZ to B.
  6811.         CALL    L0E44           ; routine CL-LINE clears lower display
  6812.                                 ; preserving B.
  6813.         RES     0,(IY+$02)      ; update TV_FLAG  - signal main screen in use
  6814.         SET     0,(IY+$30)      ; update FLAGS2  - signal unnecessary to
  6815.                                 ; clear main screen.
  6816.         LD      HL,($5C49)      ; fetch E_PPC current edit line to HL.
  6817.         LD      DE,($5C6C)      ; fetch S_TOP to DE, the current top line
  6818.                                 ; (initially zero)
  6819.         AND     A               ; prepare for true subtraction.
  6820.         SBC     HL,DE           ; subtract and
  6821.         ADD     HL,DE           ; add back.
  6822.         JR      C,L17E1         ; to AUTO-L-2 if S_TOP higher than E_PPC
  6823.                                 ; to set S_TOP to E_PPC
  6824.  
  6825.         PUSH    DE              ; save the top line number.
  6826.         CALL    L196E           ; routine LINE-ADDR gets address of E_PPC.
  6827.         LD      DE,$02C0        ; prepare known number of characters in
  6828.                                 ; the default upper screen.
  6829.         EX      DE,HL           ; offset to HL, program address to DE.
  6830.         SBC     HL,DE           ; subtract high value from low to obtain
  6831.                                 ; negated result used in addition.
  6832.         EX      (SP),HL         ; swap result with top line number on stack.
  6833.         CALL    L196E           ; routine LINE-ADDR  gets address of that
  6834.                                 ; top line in HL and next line in DE.
  6835.         POP     BC              ; restore the result to balance stack.
  6836.  
  6837. ;; AUTO-L-1
  6838. L17CE:  PUSH    BC              ; save the result.
  6839.         CALL    L19B8           ; routine NEXT-ONE gets address in HL of
  6840.                                 ; line after auto-line (in DE).
  6841.         POP     BC              ; restore result.
  6842.         ADD     HL,BC           ; compute back.
  6843.         JR      C,L17E4         ; to AUTO-L-3 if line 'should' appear
  6844.  
  6845.         EX      DE,HL           ; address of next line to HL.
  6846.         LD      D,(HL)          ; get line
  6847.         INC     HL              ; number
  6848.         LD      E,(HL)          ; in DE.
  6849.         DEC     HL              ; adjust back to start.
  6850.         LD      ($5C6C),DE      ; update S_TOP.
  6851.         JR      L17CE           ; to AUTO-L-1 until estimate reached.
  6852.  
  6853. ; ---
  6854.  
  6855. ; the jump was to here if S_TOP was greater than E_PPC
  6856.  
  6857. ;; AUTO-L-2
  6858. L17E1:  LD      ($5C6C),HL      ; make S_TOP the same as E_PPC.
  6859.  
  6860. ; continue here with valid starting point from above or good estimate
  6861. ; from computation
  6862.  
  6863. ;; AUTO-L-3
  6864. L17E4:  LD      HL,($5C6C)      ; fetch S_TOP line number to HL.
  6865.         CALL    L196E           ; routine LINE-ADDR gets address in HL.
  6866.                                 ; address of next in DE.
  6867.         JR      Z,L17ED         ; to AUTO-L-4 if line exists.
  6868.  
  6869.         EX      DE,HL           ; else use address of next line.
  6870.  
  6871. ;; AUTO-L-4
  6872. L17ED:  CALL    L1833           ; routine LIST-ALL                >>>
  6873.  
  6874. ; The return will be to here if no scrolling occurred
  6875.  
  6876.         RES     4,(IY+$02)      ; update TV_FLAG  - signal no auto listing.
  6877.         RET                     ; return.
  6878.  
  6879. ; ------------
  6880. ; Handle LLIST
  6881. ; ------------
  6882. ; A short form of LIST #3. The listing goes to stream 3 - default printer.
  6883.  
  6884. ;; LLIST
  6885. L17F5:  LD      A,$03           ; the usual stream for ZX Printer
  6886.         JR      L17FB           ; forward to LIST-1
  6887.  
  6888. ; -----------
  6889. ; Handle LIST
  6890. ; -----------
  6891. ; List to any stream.
  6892. ; Note. While a starting line can be specified it is
  6893. ; not possible to specify an end line.
  6894. ; Just listing a line makes it the current edit line.
  6895.  
  6896. ;; LIST
  6897. L17F9:  LD      A,$02           ; default is stream 2 - the upper screen.
  6898.  
  6899. ;; LIST-1
  6900. L17FB:  LD      (IY+$02),$00    ; the TV_FLAG is initialized with bit 0 reset
  6901.                                 ; indicating upper screen in use.
  6902.         CALL    L2530           ; routine SYNTAX-Z - checking syntax ?
  6903.         CALL    NZ,L1601        ; routine CHAN-OPEN if in run-time.
  6904.  
  6905.         RST     18H             ; GET-CHAR
  6906.         CALL    L2070           ; routine STR-ALTER will alter if '#'.
  6907.         JR      C,L181F         ; forward to LIST-4 not a '#' .
  6908.  
  6909.  
  6910.         RST     18H             ; GET-CHAR
  6911.         CP      $3B             ; is it ';' ?
  6912.         JR      Z,L1814         ; skip to LIST-2 if so.
  6913.  
  6914.         CP      $2C             ; is it ',' ?
  6915.         JR      NZ,L181A        ; forward to LIST-3 if neither separator.
  6916.  
  6917. ; we have, say,  LIST #15, and a number must follow the separator.
  6918.  
  6919. ;; LIST-2
  6920. L1814:  RST     20H             ; NEXT-CHAR
  6921.         CALL    L1C82           ; routine EXPT-1NUM
  6922.         JR      L1822           ; forward to LIST-5
  6923.  
  6924. ; ---
  6925.  
  6926. ; the branch was here with just LIST #3 etc.
  6927.  
  6928. ;; LIST-3
  6929. L181A:  CALL    L1CE6           ; routine USE-ZERO
  6930.         JR      L1822           ; forward to LIST-5
  6931.  
  6932. ; ---
  6933.  
  6934. ; the branch was here with LIST
  6935.  
  6936. ;; LIST-4
  6937. L181F:  CALL    L1CDE           ; routine FETCH-NUM checks if a number
  6938.                                 ; follows else uses zero.
  6939.  
  6940. ;; LIST-5
  6941. L1822:  CALL    L1BEE           ; routine CHECK-END quits if syntax OK >>>
  6942.  
  6943.         CALL    L1E99           ; routine FIND-INT2 fetches the number
  6944.                                 ; from the calculator stack in run-time.
  6945.         LD      A,B             ; fetch high byte of line number and
  6946.         AND     $3F             ; make less than $40 so that NEXT-ONE
  6947.                                 ; (from LINE-ADDR) doesn't lose context.
  6948.                                 ; Note. this is not satisfactory and the typo
  6949.                                 ; LIST 20000 will list an entirely different
  6950.                                 ; section than LIST 2000. Such typos are not
  6951.                                 ; available for checking if they are direct
  6952.                                 ; commands.
  6953.  
  6954.         LD      H,A             ; transfer the modified
  6955.         LD      L,C             ; line number to HL.
  6956.         LD      ($5C49),HL      ; update E_PPC to new line number.
  6957.         CALL    L196E           ; routine LINE-ADDR gets the address of the
  6958.                                 ; line.
  6959.  
  6960. ; This routine is called from AUTO-LIST
  6961.  
  6962. ;; LIST-ALL
  6963. L1833:  LD      E,$01           ; signal current line not yet printed
  6964.  
  6965. ;; LIST-ALL-2
  6966. L1835:  CALL    L1855           ; routine OUT-LINE outputs a BASIC line
  6967.                                 ; using PRINT-OUT and makes an early return
  6968.                                 ; when no more lines to print. >>>
  6969.  
  6970.         RST     10H             ; PRINT-A prints the carriage return (in A)
  6971.  
  6972.         BIT     4,(IY+$02)      ; test TV_FLAG  - automatic listing ?
  6973.         JR      Z,L1835         ; back to LIST-ALL-2 if not
  6974.                                 ; (loop exit is via OUT-LINE)
  6975.  
  6976. ; continue here if an automatic listing required.
  6977.  
  6978.         LD      A,($5C6B)       ; fetch DF_SZ lower display file size.
  6979.         SUB     (IY+$4F)        ; subtract S_POSN_hi ithe current line number.
  6980.         JR      NZ,L1835        ; back to LIST-ALL-2 if upper screen not full.
  6981.  
  6982.         XOR     E               ; A contains zero, E contains one if the
  6983.                                 ; current edit line has not been printed
  6984.                                 ; or zero if it has (from OUT-LINE).
  6985.         RET     Z               ; return if the screen is full and the line
  6986.                                 ; has been printed.
  6987.  
  6988. ; continue with automatic listings if the screen is full and the current
  6989. ; edit line is missing. OUT-LINE will scroll automatically.
  6990.  
  6991.         PUSH    HL              ; save the pointer address.
  6992.         PUSH    DE              ; save the E flag.
  6993.         LD      HL,$5C6C        ; fetch S_TOP the rough estimate.
  6994.         CALL    L190F           ; routine LN-FETCH updates S_TOP with
  6995.                                 ; the number of the next line.
  6996.         POP     DE              ; restore the E flag.
  6997.         POP     HL              ; restore the address of the next line.
  6998.         JR      L1835           ; back to LIST-ALL-2.
  6999.  
  7000. ; ------------------------
  7001. ; Print a whole BASIC line
  7002. ; ------------------------
  7003. ; This routine prints a whole BASIC line and it is called
  7004. ; from LIST-ALL to output the line to current channel
  7005. ; and from ED-EDIT to 'sprint' the line to the edit buffer.
  7006.  
  7007. ;; OUT-LINE
  7008. L1855:  LD      BC,($5C49)      ; fetch E_PPC the current line which may be
  7009.                                 ; unchecked and not exist.
  7010.         CALL    L1980           ; routine CP-LINES finds match or line after.
  7011.         LD      D,$3E           ; prepare cursor '>' in D.
  7012.         JR      Z,L1865         ; to OUT-LINE1 if matched or line after.
  7013.  
  7014.         LD      DE,$0000        ; put zero in D, to suppress line cursor.
  7015.         RL      E               ; pick up carry in E if line before current
  7016.                                 ; leave E zero if same or after.
  7017.  
  7018. ;; OUT-LINE1
  7019. L1865:  LD      (IY+$2D),E      ; save flag in BREG which is spare.
  7020.         LD      A,(HL)          ; get high byte of line number.
  7021.         CP      $40             ; is it too high ($2F is maximum possible) ?
  7022.         POP     BC              ; drop the return address and
  7023.         RET     NC              ; make an early return if so >>>
  7024.  
  7025.         PUSH    BC              ; save return address
  7026.         CALL    L1A28           ; routine OUT-NUM-2 to print addressed number
  7027.                                 ; with leading space.
  7028.         INC     HL              ; skip low number byte.
  7029.         INC     HL              ; and the two
  7030.         INC     HL              ; length bytes.
  7031.         RES     0,(IY+$01)      ; update FLAGS - signal leading space required.
  7032.         LD      A,D             ; fetch the cursor.
  7033.         AND     A               ; test for zero.
  7034.         JR      Z,L1881         ; to OUT-LINE3 if zero.
  7035.  
  7036.  
  7037.         RST     10H             ; PRINT-A prints '>' the current line cursor.
  7038.  
  7039. ; this entry point is called from ED-COPY
  7040.  
  7041. ;; OUT-LINE2
  7042. L187D:  SET     0,(IY+$01)      ; update FLAGS - suppress leading space.
  7043.  
  7044. ;; OUT-LINE3
  7045. L1881:  PUSH    DE              ; save flag E for a return value.
  7046.         EX      DE,HL           ; save HL address in DE.
  7047.         RES     2,(IY+$30)      ; update FLAGS2 - signal NOT in QUOTES.
  7048.  
  7049.         LD      HL,$5C3B        ; point to FLAGS.
  7050.         RES     2,(HL)          ; signal 'K' mode. (starts before keyword)
  7051.         BIT     5,(IY+$37)      ; test FLAGX - input mode ?
  7052.         JR      Z,L1894         ; forward to OUT-LINE4 if not.
  7053.  
  7054.         SET     2,(HL)          ; signal 'L' mode. (used for input)
  7055.  
  7056. ;; OUT-LINE4
  7057. L1894:  LD      HL,($5C5F)      ; fetch X_PTR - possibly the error pointer
  7058.                                 ; address.
  7059.         AND     A               ; clear the carry flag.
  7060.         SBC     HL,DE           ; test if an error address has been reached.
  7061.         JR      NZ,L18A1        ; forward to OUT-LINE5 if not.
  7062.  
  7063.         LD      A,$3F           ; load A with '?' the error marker.
  7064.         CALL    L18C1           ; routine OUT-FLASH to print flashing marker.
  7065.  
  7066. ;; OUT-LINE5
  7067. L18A1:  CALL    L18E1           ; routine OUT-CURS will print the cursor if
  7068.                                 ; this is the right position.
  7069.         EX      DE,HL           ; restore address pointer to HL.
  7070.         LD      A,(HL)          ; fetch the addressed character.
  7071.         CALL    L18B6           ; routine NUMBER skips a hidden floating
  7072.                                 ; point number if present.
  7073.         INC     HL              ; now increment the pointer.
  7074.         CP      $0D             ; is character end-of-line ?
  7075.         JR      Z,L18B4         ; to OUT-LINE6, if so, as line is finished.
  7076.  
  7077.         EX      DE,HL           ; save the pointer in DE.
  7078.         CALL    L1937           ; routine OUT-CHAR to output character/token.
  7079.  
  7080.         JR      L1894           ; back to OUT-LINE4 until entire line is done.
  7081.  
  7082. ; ---
  7083.  
  7084. ;; OUT-LINE6
  7085. L18B4:  POP     DE              ; bring back the flag E, zero if current
  7086.                                 ; line printed else 1 if still to print.
  7087.         RET                     ; return with A holding $0D
  7088.  
  7089. ; -------------------------
  7090. ; Check for a number marker
  7091. ; -------------------------
  7092. ; this subroutine is called from two processes. while outputting BASIC lines
  7093. ; and while searching statements within a BASIC line.
  7094. ; during both, this routine will pass over an invisible number indicator
  7095. ; and the five bytes floating-point number that follows it.
  7096. ; Note that this causes floating point numbers to be stripped from
  7097. ; the BASIC line when it is fetched to the edit buffer by OUT_LINE.
  7098. ; the number marker also appears after the arguments of a DEF FN statement
  7099. ; and may mask old 5-byte string parameters.
  7100.  
  7101. ;; NUMBER
  7102. L18B6:  CP      $0E             ; character fourteen ?
  7103.         RET     NZ              ; return if not.
  7104.  
  7105.         INC     HL              ; skip the character
  7106.         INC     HL              ; and five bytes
  7107.         INC     HL              ; following.
  7108.         INC     HL              ;
  7109.         INC     HL              ;
  7110.         INC     HL              ;
  7111.         LD      A,(HL)          ; fetch the following character
  7112.         RET                     ; for return value.
  7113.  
  7114. ; --------------------------
  7115. ; Print a flashing character
  7116. ; --------------------------
  7117. ; This subroutine is called from OUT-LINE to print a flashing error
  7118. ; marker '?' or from the next routine to print a flashing cursor e.g. 'L'.
  7119. ; However, this only gets called from OUT-LINE when printing the edit line
  7120. ; or the input buffer to the lower screen so a direct call to $09F4 can
  7121. ; be used, even though out-line outputs to other streams.
  7122. ; In fact the alternate set is used for the whole routine.
  7123.  
  7124. ;; OUT-FLASH
  7125. L18C1:  EXX                     ; switch in alternate set
  7126.  
  7127.         LD      HL,($5C8F)      ; fetch L = ATTR_T, H = MASK-T
  7128.         PUSH    HL              ; save masks.
  7129.         RES     7,H             ; reset flash mask bit so active.
  7130.         SET     7,L             ; make attribute FLASH.
  7131.         LD      ($5C8F),HL      ; resave ATTR_T and MASK-T
  7132.  
  7133.         LD      HL,$5C91        ; address P_FLAG
  7134.         LD      D,(HL)          ; fetch to D
  7135.         PUSH    DE              ; and save.
  7136.         LD      (HL),$00        ; clear inverse, over, ink/paper 9
  7137.  
  7138.         CALL    L09F4           ; routine PRINT-OUT outputs character
  7139.                                 ; without the need to vector via RST 10.
  7140.  
  7141.         POP     HL              ; pop P_FLAG to H.
  7142.         LD      (IY+$57),H      ; and restore system variable P_FLAG.
  7143.         POP     HL              ; restore temporary masks
  7144.         LD      ($5C8F),HL      ; and restore system variables ATTR_T/MASK_T
  7145.  
  7146.         EXX                     ; switch back to main set
  7147.         RET                     ; return
  7148.  
  7149. ; ----------------
  7150. ; Print the cursor
  7151. ; ----------------
  7152. ; This routine is called before any character is output while outputting
  7153. ; a BASIC line or the input buffer. This includes listing to a printer
  7154. ; or screen, copying a BASIC line to the edit buffer and printing the
  7155. ; input buffer or edit buffer to the lower screen. It is only in the
  7156. ; latter two cases that it has any relevance and in the last case it
  7157. ; performs another very important function also.
  7158.  
  7159. ;; OUT-CURS
  7160. L18E1:  LD      HL,($5C5B)      ; fetch K_CUR the current cursor address
  7161.         AND     A               ; prepare for true subtraction.
  7162.         SBC     HL,DE           ; test against pointer address in DE and
  7163.         RET     NZ              ; return if not at exact position.
  7164.  
  7165. ; the value of MODE, maintained by KEY-INPUT, is tested and if non-zero
  7166. ; then this value 'E' or 'G' will take precedence.
  7167.  
  7168.         LD      A,($5C41)       ; fetch MODE  0='KLC', 1='E', 2='G'.
  7169.                 DB 0XCB
  7170.                 RLCA               ; double the value and set flags.
  7171.         JR      Z,L18F3         ; to OUT-C-1 if still zero ('KLC').
  7172.  
  7173.         ADD     A,$43           ; add 'C' - will become 'E' if originally 1
  7174.                                 ; or 'G' if originally 2.
  7175.         JR      L1909           ; forward to OUT-C-2 to print.
  7176.  
  7177. ; ---
  7178.  
  7179. ; If mode was zero then, while printing a BASIC line, bit 2 of flags has been
  7180. ; set if 'THEN' or ':' was encountered as a main character and reset otherwise.
  7181. ; This is now used to determine if the 'K' cursor is to be printed but this
  7182. ; transient state is also now transferred permanently to bit 3 of FLAGS
  7183. ; to let the interrupt routine know how to decode the next key.
  7184.  
  7185. ;; OUT-C-1
  7186. L18F3:  LD      HL,$5C3B        ; Address FLAGS
  7187.         RES     3,(HL)          ; signal 'K' mode initially.
  7188.         LD      A,$4B           ; prepare letter 'K'.
  7189.         BIT     2,(HL)          ; test FLAGS - was the
  7190.                                 ; previous main character ':' or 'THEN' ?
  7191.         JR      Z,L1909         ; forward to OUT-C-2 if so to print.
  7192.  
  7193.         SET     3,(HL)          ; signal 'L' mode to interrupt routine.
  7194.                                 ; Note. transient bit has been made permanent.
  7195.         INC     A               ; augment from 'K' to 'L'.
  7196.  
  7197.         BIT     3,(IY+$30)      ; test FLAGS2 - consider caps lock ?
  7198.                                 ; which is maintained by KEY-INPUT.
  7199.         JR      Z,L1909         ; forward to OUT-C-2 if not set to print.
  7200.  
  7201.         LD      A,$43           ; alter 'L' to 'C'.
  7202.  
  7203. ;; OUT-C-2
  7204. L1909:  PUSH    DE              ; save address pointer but OK as OUT-FLASH
  7205.                                 ; uses alternate set without RST 10.
  7206.  
  7207.         CALL    L18C1           ; routine OUT-FLASH to print.
  7208.  
  7209.         POP     DE              ; restore and
  7210.         RET                     ; return.
  7211.  
  7212. ; ----------------------------
  7213. ; Get line number of next line
  7214. ; ----------------------------
  7215. ; These two subroutines are called while editing.
  7216. ; This entry point is from ED-DOWN with HL addressing E_PPC
  7217. ; to fetch the next line number.
  7218. ; Also from AUTO-LIST with HL addressing S_TOP just to update S_TOP
  7219. ; with the value of the next line number. It gets fetched but is discarded.
  7220. ; These routines never get called while the editor is being used for input.
  7221.  
  7222. ;; LN-FETCH
  7223. L190F:  LD      E,(HL)          ; fetch low byte
  7224.         INC     HL              ; address next
  7225.         LD      D,(HL)          ; fetch high byte.
  7226.         PUSH    HL              ; save system variable hi pointer.
  7227.         EX      DE,HL           ; line number to HL,
  7228.         INC     HL              ; increment as a starting point.
  7229.         CALL    L196E           ; routine LINE-ADDR gets address in HL.
  7230.         CALL    L1695           ; routine LINE-NO gets line number in DE.
  7231.         POP     HL              ; restore system variable hi pointer.
  7232.  
  7233. ; This entry point is from the ED-UP with HL addressing E_PPC_hi
  7234.  
  7235. ;; LN-STORE
  7236. L191C:  BIT     5,(IY+$37)      ; test FLAGX - input mode ?
  7237.         RET     NZ              ; return if so.
  7238.                                 ; Note. above already checked by ED-UP/ED-DOWN.
  7239.  
  7240.         LD      (HL),D          ; save high byte of line number.
  7241.         DEC     HL              ; address lower
  7242.         LD      (HL),E          ; save low byte of line number.
  7243.         RET                     ; return.
  7244.  
  7245. ; -----------------------------------------
  7246. ; Outputting numbers at start of BASIC line
  7247. ; -----------------------------------------
  7248. ; This routine entered at OUT-SP-NO is used to compute then output the first
  7249. ; three digits of a 4-digit BASIC line printing a space if necessary.
  7250. ; The line number, or residual part, is held in HL and the BC register
  7251. ; holds a subtraction value -1000, -100 or -10.
  7252. ; Note. for example line number 200 -
  7253. ; space(out_char), 2(out_code), 0(out_char) final number always out-code.
  7254.  
  7255. ;; OUT-SP-2
  7256. L1925:  LD      A,E             ; will be space if OUT-CODE not yet called.
  7257.                                 ; or $FF if spaces are suppressed.
  7258.                                 ; else $30 ('0').
  7259.                                 ; (from the first instruction at OUT-CODE)
  7260.                                 ; this guy is just too clever.
  7261.         AND     A               ; test bit 7 of A.
  7262.         RET     M               ; return if $FF, as leading spaces not
  7263.                                 ; required. This is set when printing line
  7264.                                 ; number and statement in MAIN-5.
  7265.  
  7266.         JR      L1937           ; forward to exit via OUT-CHAR.
  7267.  
  7268. ; ---
  7269.  
  7270. ; -> the single entry point.
  7271.  
  7272. ;; OUT-SP-NO
  7273. L192A:  XOR     A               ; initialize digit to 0
  7274.  
  7275. ;; OUT-SP-1
  7276. L192B:  ADD     HL,BC           ; add negative number to HL.
  7277.         INC     A               ; increment digit
  7278.         JR      C,L192B         ; back to OUT-SP-1 until no carry from
  7279.                                 ; the addition.
  7280.  
  7281.         SBC     HL,BC           ; cancel the last addition
  7282.         DEC     A               ; and decrement the digit.
  7283.         JR      Z,L1925         ; back to OUT-SP-2 if it is zero.
  7284.  
  7285.         JP      L15EF           ; jump back to exit via OUT-CODE.    ->
  7286.  
  7287.  
  7288. ; -------------------------------------
  7289. ; Outputting characters in a BASIC line
  7290. ; -------------------------------------
  7291. ; This subroutine ...
  7292.  
  7293. ;; OUT-CHAR
  7294. L1937:  CALL    L2D1B           ; routine NUMERIC tests if it is a digit ?
  7295.         JR      NC,L196C        ; to OUT-CH-3 to print digit without
  7296.                                 ; changing mode. Will be 'K' mode if digits
  7297.                                 ; are at beginning of edit line.
  7298.  
  7299.         CP      $21             ; less than quote character ?
  7300.         JR      C,L196C         ; to OUT-CH-3 to output controls and space.
  7301.  
  7302.         RES     2,(IY+$01)      ; initialize FLAGS to 'K' mode and leave
  7303.                                 ; unchanged if this character would precede
  7304.                                 ; a keyword.
  7305.  
  7306.         CP      $CB             ; is character 'THEN' token ?
  7307.         JR      Z,L196C         ; to OUT-CH-3 to output if so.
  7308.  
  7309.         CP      $3A             ; is it ':' ?
  7310.         JR      NZ,L195A        ; to OUT-CH-1 if not statement separator
  7311.                                 ; to change mode back to 'L'.
  7312.  
  7313.         BIT     5,(IY+$37)      ; FLAGX  - Input Mode ??
  7314.         JR      NZ,L1968        ; to OUT-CH-2 if in input as no statements.
  7315.                                 ; Note. this check should seemingly be at
  7316.                                 ; the start. Commands seem inappropriate in
  7317.                                 ; INPUT mode and are rejected by the syntax
  7318.                                 ; checker anyway.
  7319.                                 ; unless INPUT LINE is being used.
  7320.  
  7321.         BIT     2,(IY+$30)      ; test FLAGS2 - is the ':' within quotes ?
  7322.         JR      Z,L196C         ; to OUT-CH-3 if ':' is outside quoted text.
  7323.  
  7324.         JR      L1968           ; to OUT-CH-2 as ':' is within quotes
  7325.  
  7326. ; ---
  7327.  
  7328. ;; OUT-CH-1
  7329. L195A:  CP      $22             ; is it quote character '"'  ?
  7330.         JR      NZ,L1968        ; to OUT-CH-2 with others to set 'L' mode.
  7331.  
  7332.         PUSH    AF              ; save character.
  7333.         LD      A,($5C6A)       ; fetch FLAGS2.
  7334.         XOR     $04             ; toggle the quotes flag.
  7335.         LD      ($5C6A),A       ; update FLAGS2
  7336.         POP     AF              ; and restore character.
  7337.  
  7338. ;; OUT-CH-2
  7339. L1968:  SET     2,(IY+$01)      ; update FLAGS - signal L mode if the cursor
  7340.                                 ; is next.
  7341.  
  7342. ;; OUT-CH-3
  7343. L196C:  RST     10H             ; PRINT-A vectors the character to
  7344.                                 ; channel 'S', 'K', 'R' or 'P'.
  7345.         RET                     ; return.
  7346.  
  7347. ; -------------------------------------------
  7348. ; Get starting address of line, or line after
  7349. ; -------------------------------------------
  7350. ; This routine is used often to get the address, in HL, of a BASIC line
  7351. ; number supplied in HL, or failing that the address of the following line
  7352. ; and the address of the previous line in DE.
  7353.  
  7354. ;; LINE-ADDR
  7355. L196E:  PUSH    HL              ; save line number in HL register
  7356.         LD      HL,($5C53)      ; fetch start of program from PROG
  7357.         LD      D,H             ; transfer address to
  7358.         LD      E,L             ; the DE register pair.
  7359.  
  7360. ;; LINE-AD-1
  7361. L1974:  POP     BC              ; restore the line number to BC
  7362.         CALL    L1980           ; routine CP-LINES compares with that
  7363.                                 ; addressed by HL
  7364.         RET     NC              ; return if line has been passed or matched.
  7365.                                 ; if NZ, address of previous is in DE
  7366.  
  7367.         PUSH    BC              ; save the current line number
  7368.         CALL    L19B8           ; routine NEXT-ONE finds address of next
  7369.                                 ; line number in DE, previous in HL.
  7370.         EX      DE,HL           ; switch so next in HL
  7371.         JR      L1974           ; back to LINE-AD-1 for another comparison
  7372.  
  7373. ; --------------------
  7374. ; Compare line numbers
  7375. ; --------------------
  7376. ; This routine compares a line number supplied in BC with an addressed
  7377. ; line number pointed to by HL.
  7378.  
  7379. ;; CP-LINES
  7380. L1980:  LD      A,(HL)          ; Load the high byte of line number and
  7381.         CP      B               ; compare with that of supplied line number.
  7382.         RET     NZ              ; return if yet to match (carry will be set).
  7383.  
  7384.         INC     HL              ; address low byte of
  7385.         LD      A,(HL)          ; number and pick up in A.
  7386.         DEC     HL              ; step back to first position.
  7387.         CP      C               ; now compare.
  7388.         RET                     ; zero set if exact match.
  7389.                                 ; carry set if yet to match.
  7390.                                 ; no carry indicates a match or
  7391.                                 ; next available BASIC line or
  7392.                                 ; program end marker.
  7393.  
  7394. ; -------------------
  7395. ; Find each statement
  7396. ; -------------------
  7397. ; The single entry point EACH-STMT is used to
  7398. ; 1) To find the D'th statement in a line.
  7399. ; 2) To find a token in held E.
  7400.  
  7401. ;; not-used
  7402. L1988:  INC     HL              ;
  7403.         INC     HL              ;
  7404.         INC     HL              ;
  7405.  
  7406. ; -> entry point.
  7407.  
  7408. ;; EACH-STMT
  7409. L198B:  LD      ($5C5D),HL      ; save HL in CH_ADD
  7410.         LD      C,$00           ; initialize quotes flag
  7411.  
  7412. ;; EACH-S-1
  7413. L1990:  DEC     D               ; decrease statement count
  7414.         RET     Z               ; return if zero
  7415.  
  7416.  
  7417.         RST     20H             ; NEXT-CHAR
  7418.         CP      E               ; is it the search token ?
  7419.         JR      NZ,L199A        ; forward to EACH-S-3 if not
  7420.  
  7421.         AND     A               ; clear carry
  7422.         RET                     ; return signalling success.
  7423.  
  7424. ; ---
  7425.  
  7426. ;; EACH-S-2
  7427. L1998:  INC     HL              ; next address
  7428.         LD      A,(HL)          ; next character
  7429.  
  7430. ;; EACH-S-3
  7431. L199A:  CALL    L18B6           ; routine NUMBER skips if number marker
  7432.         LD      ($5C5D),HL      ; save in CH_ADD
  7433.         CP      $22             ; is it quotes '"' ?
  7434.         JR      NZ,L19A5        ; to EACH-S-4 if not
  7435.  
  7436.         DEC     C               ; toggle bit 0 of C
  7437.  
  7438. ;; EACH-S-4
  7439. L19A5:  CP      $3A             ; is it ':'
  7440.         JR      Z,L19AD         ; to EACH-S-5
  7441.  
  7442.         CP      $CB             ; 'THEN'
  7443.         JR      NZ,L19B1        ; to EACH-S-6
  7444.  
  7445. ;; EACH-S-5
  7446. L19AD:  BIT     0,C             ; is it in quotes
  7447.         JR      Z,L1990         ; to EACH-S-1 if not
  7448.  
  7449. ;; EACH-S-6
  7450. L19B1:  CP      $0D             ; end of line ?
  7451.         JR      NZ,L1998        ; to EACH-S-2
  7452.  
  7453.         DEC     D               ; decrease the statement counter
  7454.                                 ; which should be zero else
  7455.                                 ; 'Statement Lost'.
  7456.         SCF                     ; set carry flag - not found
  7457.         RET                     ; return
  7458.  
  7459. ; -----------------------------------------------------------------------
  7460. ; Storage of variables. For full details - see chapter 24.
  7461. ; ZX Spectrum BASIC Programming by Steven Vickers 1982.
  7462. ; It is bits 7-5 of the first character of a variable that allow
  7463. ; the six types to be distinguished. Bits 4-0 are the reduced letter.
  7464. ; So any variable name is higher that $3F and can be distinguished
  7465. ; also from the variables area end-marker $80.
  7466. ;
  7467. ; 76543210 meaning                               brief outline of format.
  7468. ; -------- ------------------------              -----------------------
  7469. ; 010      string variable.                      2 byte length + contents.
  7470. ; 110      string array.                         2 byte length + contents.
  7471. ; 100      array of numbers.                     2 byte length + contents.
  7472. ; 011      simple numeric variable.              5 bytes.
  7473. ; 101      variable length named numeric.        5 bytes.
  7474. ; 111      for-next loop variable.               18 bytes.
  7475. ; 10000000 the variables area end-marker.
  7476. ;
  7477. ; Note. any of the above seven will serve as a program end-marker.
  7478. ;
  7479. ; -----------------------------------------------------------------------
  7480.  
  7481. ; ------------
  7482. ; Get next one
  7483. ; ------------
  7484. ; This versatile routine is used to find the address of the next line
  7485. ; in the program area or the next variable in the variables area.
  7486. ; The reason one routine is made to handle two apparently unrelated tasks
  7487. ; is that it can be called indiscriminately when merging a line or a
  7488. ; variable.
  7489.  
  7490. ;; NEXT-ONE
  7491. L19B8:  PUSH    HL              ; save the pointer address.
  7492.         LD      A,(HL)          ; get first byte.
  7493.         CP      $40             ; compare with upper limit for line numbers.
  7494.         JR      C,L19D5         ; forward to NEXT-O-3 if within BASIC area.
  7495.  
  7496. ; the continuation here is for the next variable unless the supplied
  7497. ; line number was erroneously over 16383. see RESTORE command.
  7498.  
  7499.         BIT     5,A             ; is it a string or an array variable ?
  7500.         JR      Z,L19D6         ; forward to NEXT-O-4 to compute length.
  7501.  
  7502.         ADD     A,A             ; test bit 6 for single-character variables.
  7503.         JP      M,L19C7         ; forward to NEXT-O-1 if so
  7504.  
  7505.         CCF                     ; clear the carry for long-named variables.
  7506.                                 ; it remains set for for-next loop variables.
  7507.  
  7508. ;; NEXT-O-1
  7509. L19C7:  LD      BC,$0005        ; set BC to 5 for floating point number
  7510.         JR      NC,L19CE        ; forward to NEXT-O-2 if not a for/next
  7511.                                 ; variable.
  7512.  
  7513.         LD      C,$12           ; set BC to eighteen locations.
  7514.                                 ; value, limit, step, line and statement.
  7515.  
  7516. ; now deal with long-named variables
  7517.  
  7518. ;; NEXT-O-2
  7519. L19CE:  RLA                     ; test if character inverted. carry will also
  7520.                                 ; be set for single character variables
  7521.         INC     HL              ; address next location.
  7522.         LD      A,(HL)          ; and load character.
  7523.         JR      NC,L19CE        ; back to NEXT-O-2 if not inverted bit.
  7524.                                 ; forward immediately with single character
  7525.                                 ; variable names.
  7526.  
  7527.         JR      L19DB           ; forward to NEXT-O-5 to add length of
  7528.                                 ; floating point number(s etc.).
  7529.  
  7530. ; ---
  7531.  
  7532. ; this branch is for line numbers.
  7533.  
  7534. ;; NEXT-O-3
  7535. L19D5:  INC     HL              ; increment pointer to low byte of line no.
  7536.  
  7537. ; strings and arrays rejoin here
  7538.  
  7539. ;; NEXT-O-4
  7540. L19D6:  INC     HL              ; increment to address the length low byte.
  7541.         LD      C,(HL)          ; transfer to C and
  7542.         INC     HL              ; point to high byte of length.
  7543.         LD      B,(HL)          ; transfer that to B
  7544.         INC     HL              ; point to start of BASIC/variable contents.
  7545.  
  7546. ; the three types of numeric variables rejoin here
  7547.  
  7548. ;; NEXT-O-5
  7549. L19DB:  ADD     HL,BC           ; add the length to give address of next
  7550.                                 ; line/variable in HL.
  7551.         POP     DE              ; restore previous address to DE.
  7552.  
  7553. ; ------------------
  7554. ; Difference routine
  7555. ; ------------------
  7556. ; This routine terminates the above routine and is also called from the
  7557. ; start of the next routine to calculate the length to reclaim.
  7558.  
  7559. ;; DIFFER
  7560. L19DD:  AND     A               ; prepare for true subtraction.
  7561.         SBC     HL,DE           ; subtract the two pointers.
  7562.         LD      B,H             ; transfer result
  7563.         LD      C,L             ; to BC register pair.
  7564.         ADD     HL,DE           ; add back
  7565.         EX      DE,HL           ; and switch pointers
  7566.         RET                     ; return values are the length of area in BC,
  7567.                                 ; low pointer (previous) in HL,
  7568.                                 ; high pointer (next) in DE.
  7569.  
  7570. ; -----------------------
  7571. ; Handle reclaiming space
  7572. ; -----------------------
  7573. ;
  7574.  
  7575. ;; RECLAIM-1
  7576. L19E5:  CALL    L19DD           ; routine DIFFER immediately above
  7577.  
  7578. ;; RECLAIM-2
  7579. L19E8:  PUSH    BC              ;
  7580.  
  7581.         LD      A,B             ;
  7582.         CPL                     ;
  7583.         LD      B,A             ;
  7584.         LD      A,C             ;
  7585.         CPL                     ;
  7586.         LD      C,A             ;
  7587.         INC     BC              ;
  7588.  
  7589.         CALL    L1664           ; routine POINTERS
  7590.         EX      DE,HL           ;
  7591.         POP     HL              ;
  7592.  
  7593.         ADD     HL,DE           ;
  7594.         PUSH    DE              ;
  7595.         LDIR                    ; copy bytes
  7596.  
  7597.         POP     HL              ;
  7598.         RET                     ;
  7599.  
  7600. ; ----------------------------------------
  7601. ; Read line number of line in editing area
  7602. ; ----------------------------------------
  7603. ; This routine reads a line number in the editing area returning the number
  7604. ; in the BC register or zero if no digits exist before commands.
  7605. ; It is called from LINE-SCAN to check the syntax of the digits.
  7606. ; It is called from MAIN-3 to extract the line number in preparation for
  7607. ; inclusion of the line in the BASIC program area.
  7608. ;
  7609. ; Interestingly the calculator stack is moved from its normal place at the
  7610. ; end of dynamic memory to an adequate area within the system variables area.
  7611. ; This ensures that in a low memory situation, that valid line numbers can
  7612. ; be extracted without raising an error and that memory can be reclaimed
  7613. ; by deleting lines. If the stack was in its normal place then a situation
  7614. ; arises whereby the Spectrum becomes locked with no means of reclaiming space.
  7615.  
  7616. ;; E-LINE-NO
  7617. L19FB:  LD      HL,($5C59)      ; load HL from system variable E_LINE.
  7618.  
  7619.         DEC     HL              ; decrease so that NEXT_CHAR can be used
  7620.                                 ; without skipping the first digit.
  7621.  
  7622.         LD      ($5C5D),HL      ; store in the system variable CH_ADD.
  7623.  
  7624.         RST     20H             ; NEXT-CHAR skips any noise and white-space
  7625.                                 ; to point exactly at the first digit.
  7626.  
  7627.         LD      HL,$5C92        ; use MEM-0 as a temporary calculator stack
  7628.                                 ; an overhead of three locations are needed.
  7629.         LD      ($5C65),HL      ; set new STKEND.
  7630.  
  7631.         CALL    L2D3B           ; routine INT-TO-FP will read digits till
  7632.                                 ; a non-digit found.
  7633.         CALL    L2DA2           ; routine FP-TO-BC will retrieve number
  7634.                                 ; from stack at membot.
  7635.         JR      C,L1A15         ; forward to E-L-1 if overflow i.e. > 65535.
  7636.                                 ; 'Nonsense in BASIC'
  7637.  
  7638.         LD      HL,$D8F0        ; load HL with value -9999
  7639.         ADD     HL,BC           ; add to line number in BC
  7640.  
  7641. ;; E-L-1
  7642. L1A15:  JP      C,L1C8A         ; to REPORT-C 'Nonsense in BASIC' if over.
  7643.                                 ; Note. As ERR_SP points to ED_ERROR
  7644.                                 ; the report is never produced although
  7645.                                 ; the RST $08 will update X_PTR leading to
  7646.                                 ; the error marker being displayed when
  7647.                                 ; the ED_LOOP is reiterated.
  7648.                                 ; in fact, since it is immediately
  7649.                                 ; cancelled, any report will do.
  7650.  
  7651. ; a line in the range 0 - 9999 has been entered.
  7652.  
  7653.         JP      L16C5           ; jump back to SET-STK to set the calculator
  7654.                                 ; stack back to its normal place and exit
  7655.                                 ; from there.
  7656.  
  7657. ; ---------------------------------
  7658. ; Report and line number outputting
  7659. ; ---------------------------------
  7660. ; Entry point OUT-NUM-1 is used by the Error Reporting code to print
  7661. ; the line number and later the statement number held in BC.
  7662. ; If the statement was part of a direct command then -2 is used as a
  7663. ; dummy line number so that zero will be printed in the report.
  7664. ; This routine is also used to print the exponent of E-format numbers.
  7665. ;
  7666. ; Entry point OUT-NUM-2 is used from OUT-LINE to output the line number
  7667. ; addressed by HL with leading spaces if necessary.
  7668.  
  7669. ;; OUT-NUM-1
  7670. L1A1B:  PUSH    DE              ; save the
  7671.         PUSH    HL              ; registers.
  7672.         XOR     A               ; set A to zero.
  7673.         BIT     7,B             ; is the line number minus two ?
  7674.         JR      NZ,L1A42        ; forward to OUT-NUM-4 if so to print zero
  7675.                                 ; for a direct command.
  7676.  
  7677.         LD      H,B             ; transfer the
  7678.         LD      L,C             ; number to HL.
  7679.         LD      E,$FF           ; signal 'no leading zeros'.
  7680.         JR      L1A30           ; forward to continue at OUT-NUM-3
  7681.  
  7682. ; ---
  7683.  
  7684. ; from OUT-LINE - HL addresses line number.
  7685.  
  7686. ;; OUT-NUM-2
  7687. L1A28:  PUSH    DE              ; save flags
  7688.         LD      D,(HL)          ; high byte to D
  7689.         INC     HL              ; address next
  7690.         LD      E,(HL)          ; low byte to E
  7691.         PUSH    HL              ; save pointer
  7692.         EX      DE,HL           ; transfer number to HL
  7693.         LD      E,$20           ; signal 'output leading spaces'
  7694.  
  7695. ;; OUT-NUM-3
  7696. L1A30:  LD      BC,$FC18        ; value -1000
  7697.         CALL    L192A           ; routine OUT-SP-NO outputs space or number
  7698.         LD      BC,$FF9C        ; value -100
  7699.         CALL    L192A           ; routine OUT-SP-NO
  7700.         LD      C,$F6           ; value -10 ( B is still $FF )
  7701.         CALL    L192A           ; routine OUT-SP-NO
  7702.         LD      A,L             ; remainder to A.
  7703.  
  7704. ;; OUT-NUM-4
  7705. L1A42:  CALL    L15EF           ; routine OUT-CODE for final digit.
  7706.                                 ; else report code zero wouldn't get
  7707.                                 ; printed.
  7708.         POP     HL              ; restore the
  7709.         POP     DE              ; registers and
  7710.         RET                     ; return.
  7711.  
  7712.  
  7713. ;***************************************************
  7714. ;** Part 7. BASIC LINE AND COMMAND INTERPRETATION **
  7715. ;***************************************************
  7716.  
  7717. ; ----------------
  7718. ; The offset table
  7719. ; ----------------
  7720. ; The BASIC interpreter has found a command code $CE - $FF
  7721. ; which is then reduced to range $00 - $31 and added to the base address
  7722. ; of this table to give the address of an offset which, when added to
  7723. ; the offset therein, gives the location in the following parameter table
  7724. ; where a list of class codes, separators and addresses relevant to the
  7725. ; command exists.
  7726.  
  7727. ;; offst-tbl
  7728. L1A48:  DB    L1AF9 - $       ; B1 offset to Address: P-DEF-FN
  7729.         DB    L1B14 - $       ; CB offset to Address: P-CAT
  7730.         DB    L1B06 - $       ; BC offset to Address: P-FORMAT
  7731.         DB    L1B0A - $       ; BF offset to Address: P-MOVE
  7732.         DB    L1B10 - $       ; C4 offset to Address: P-ERASE
  7733.         DB    L1AFC - $       ; AF offset to Address: P-OPEN
  7734.         DB    L1B02 - $       ; B4 offset to Address: P-CLOSE
  7735.         DB    L1AE2 - $       ; 93 offset to Address: P-MERGE
  7736.         DB    L1AE1 - $       ; 91 offset to Address: P-VERIFY
  7737.         DB    L1AE3 - $       ; 92 offset to Address: P-BEEP
  7738.         DB    L1AE7 - $       ; 95 offset to Address: P-CIRCLE
  7739.         DB    L1AEB - $       ; 98 offset to Address: P-INK
  7740.         DB    L1AEC - $       ; 98 offset to Address: P-PAPER
  7741.         DB    L1AED - $       ; 98 offset to Address: P-FLASH
  7742.         DB    L1AEE - $       ; 98 offset to Address: P-BRIGHT
  7743.         DB    L1AEF - $       ; 98 offset to Address: P-INVERSE
  7744.         DB    L1AF0 - $       ; 98 offset to Address: P-OVER
  7745.         DB    L1AF1 - $       ; 98 offset to Address: P-OUT
  7746.         DB    L1AD9 - $       ; 7F offset to Address: P-LPRINT
  7747.         DB    L1ADC - $       ; 81 offset to Address: P-LLIST
  7748.         DB    L1A8A - $       ; 2E offset to Address: P-STOP
  7749.         DB    L1AC9 - $       ; 6C offset to Address: P-READ
  7750.         DB    L1ACC - $       ; 6E offset to Address: P-DATA
  7751.         DB    L1ACF - $       ; 70 offset to Address: P-RESTORE
  7752.         DB    L1AA8 - $       ; 48 offset to Address: P-NEW
  7753.         DB    L1AF5 - $       ; 94 offset to Address: P-BORDER
  7754.         DB    L1AB8 - $       ; 56 offset to Address: P-CONT
  7755.         DB    L1AA2 - $       ; 3F offset to Address: P-DIM
  7756.         DB    L1AA5 - $       ; 41 offset to Address: P-REM
  7757.         DB    L1A90 - $       ; 2B offset to Address: P-FOR
  7758.         DB    L1A7D - $       ; 17 offset to Address: P-GO-TO
  7759.         DB    L1A86 - $       ; 1F offset to Address: P-GO-SUB
  7760.         DB    L1A9F - $       ; 37 offset to Address: P-INPUT
  7761.         DB    L1AE0 - $       ; 77 offset to Address: P-LOAD
  7762.         DB    L1AAE - $       ; 44 offset to Address: P-LIST
  7763.         DB    L1A7A - $       ; 0F offset to Address: P-LET
  7764.         DB    L1AC5 - $       ; 59 offset to Address: P-PAUSE
  7765.         DB    L1A98 - $       ; 2B offset to Address: P-NEXT
  7766.         DB    L1AB1 - $       ; 43 offset to Address: P-POKE
  7767.         DB    L1A9C - $       ; 2D offset to Address: P-PRINT
  7768.         DB    L1AC1 - $       ; 51 offset to Address: P-PLOT
  7769.         DB    L1AAB - $       ; 3A offset to Address: P-RUN
  7770.         DB    L1ADF - $       ; 6D offset to Address: P-SAVE
  7771.         DB    L1AB5 - $       ; 42 offset to Address: P-RANDOM
  7772.         DB    L1A81 - $       ; 0D offset to Address: P-IF
  7773.         DB    L1ABE - $       ; 49 offset to Address: P-CLS
  7774.         DB    L1AD2 - $       ; 5C offset to Address: P-DRAW
  7775.         DB    L1ABB - $       ; 44 offset to Address: P-CLEAR
  7776.         DB    L1A8D - $       ; 15 offset to Address: P-RETURN
  7777.         DB    L1AD6 - $       ; 5D offset to Address: P-COPY
  7778.  
  7779.  
  7780. ; -------------------------------
  7781. ; The parameter or "Syntax" table
  7782. ; -------------------------------
  7783. ; For each command there exists a variable list of parameters.
  7784. ; If the character is greater than a space it is a required separator.
  7785. ; If less, then it is a command class in the range 00 - 0B.
  7786. ; Note that classes 00, 03 and 05 will fetch the addresses from this table.
  7787. ; Some classes e.g. 07 and 0B have the same address in all invocations
  7788. ; and the command is re-computed from the low-byte of the parameter address.
  7789. ; Some e.g. 02 are only called once so a call to the command is made from
  7790. ; within the class routine rather than holding the address within the table.
  7791. ; Some class routines check syntax entirely and some leave this task for the
  7792. ; command itself.
  7793. ; Others for example CIRCLE (x,y,z) check the first part (x,y) using the
  7794. ; class routine and the final part (,z) within the command.
  7795. ; The last few commands appear to have been added in a rush but their syntax
  7796. ; is rather simple e.g. MOVE "M1","M2"
  7797.  
  7798. ;; P-LET
  7799. L1A7A:  DB    $01             ; Class-01 - A variable is required.
  7800.         DB    $3D             ; Separator:  '='
  7801.         DB    $02             ; Class-02 - An expression, numeric or string,
  7802.                                 ; must follow.
  7803.  
  7804. ;; P-GO-TO
  7805. L1A7D:  DB    $06             ; Class-06 - A numeric expression must follow.
  7806.         DB    $00             ; Class-00 - No further operands.
  7807.         DEFW    L1E67           ; Address: $1E67; Address: GO-TO
  7808.  
  7809. ;; P-IF
  7810. L1A81:  DB    $06             ; Class-06 - A numeric expression must follow.
  7811.         DB    $CB             ; Separator:  'THEN'
  7812.         DB    $05             ; Class-05 - Variable syntax checked
  7813.                                 ; by routine.
  7814.         DEFW    L1CF0           ; Address: $1CF0; Address: IF
  7815.  
  7816. ;; P-GO-SUB
  7817. L1A86:  DB    $06             ; Class-06 - A numeric expression must follow.
  7818.         DB    $00             ; Class-00 - No further operands.
  7819.         DEFW    L1EED           ; Address: $1EED; Address: GO-SUB
  7820.  
  7821. ;; P-STOP
  7822. L1A8A:  DB    $00             ; Class-00 - No further operands.
  7823.         DEFW    L1CEE           ; Address: $1CEE; Address: STOP
  7824.  
  7825. ;; P-RETURN
  7826. L1A8D:  DB    $00             ; Class-00 - No further operands.
  7827.         DEFW    L1F23           ; Address: $1F23; Address: RETURN
  7828.  
  7829. ;; P-FOR
  7830. L1A90:  DB    $04             ; Class-04 - A single character variable must
  7831.                                 ; follow.
  7832.         DB    $3D             ; Separator:  '='
  7833.         DB    $06             ; Class-06 - A numeric expression must follow.
  7834.         DB    $CC             ; Separator:  'TO'
  7835.         DB    $06             ; Class-06 - A numeric expression must follow.
  7836.         DB    $05             ; Class-05 - Variable syntax checked
  7837.                                 ; by routine.
  7838.         DEFW    L1D03           ; Address: $1D03; Address: FOR
  7839.  
  7840. ;; P-NEXT
  7841. L1A98:  DB    $04             ; Class-04 - A single character variable must
  7842.                                 ; follow.
  7843.         DB    $00             ; Class-00 - No further operands.
  7844.         DEFW    L1DAB           ; Address: $1DAB; Address: NEXT
  7845.  
  7846. ;; P-PRINT
  7847. L1A9C:  DB    $05             ; Class-05 - Variable syntax checked entirely
  7848.                                 ; by routine.
  7849.         DEFW    L1FCD           ; Address: $1FCD; Address: PRINT
  7850.  
  7851. ;; P-INPUT
  7852. L1A9F:  DB    $05             ; Class-05 - Variable syntax checked entirely
  7853.                                 ; by routine.
  7854.         DEFW    L2089           ; Address: $2089; Address: INPUT
  7855.  
  7856. ;; P-DIM
  7857. L1AA2:  DB    $05             ; Class-05 - Variable syntax checked entirely
  7858.                                 ; by routine.
  7859.         DEFW    L2C02           ; Address: $2C02; Address: DIM
  7860.  
  7861. ;; P-REM
  7862. L1AA5:  DB    $05             ; Class-05 - Variable syntax checked entirely
  7863.                                 ; by routine.
  7864.         DEFW    L1BB2           ; Address: $1BB2; Address: REM
  7865.  
  7866. ;; P-NEW
  7867. L1AA8:  DB    $00             ; Class-00 - No further operands.
  7868.         DEFW    L11B7           ; Address: $11B7; Address: NEW
  7869.  
  7870. ;; P-RUN
  7871. L1AAB:  DB    $03             ; Class-03 - A numeric expression may follow
  7872.                                 ; else default to zero.
  7873.         DEFW    L1EA1           ; Address: $1EA1; Address: RUN
  7874.  
  7875. ;; P-LIST
  7876. L1AAE:  DB    $05             ; Class-05 - Variable syntax checked entirely
  7877.                                 ; by routine.
  7878.         DEFW    L17F9           ; Address: $17F9; Address: LIST
  7879.  
  7880. ;; P-POKE
  7881. L1AB1:  DB    $08             ; Class-08 - Two comma-separated numeric
  7882.                                 ; expressions required.
  7883.         DB    $00             ; Class-00 - No further operands.
  7884.         DEFW    L1E80           ; Address: $1E80; Address: POKE
  7885.  
  7886. ;; P-RANDOM
  7887. L1AB5:  DB    $03             ; Class-03 - A numeric expression may follow
  7888.                                 ; else default to zero.
  7889.         DEFW    L1E4F           ; Address: $1E4F; Address: RANDOMIZE
  7890.  
  7891. ;; P-CONT
  7892. L1AB8:  DB    $00             ; Class-00 - No further operands.
  7893.         DEFW    L1E5F           ; Address: $1E5F; Address: CONTINUE
  7894.  
  7895. ;; P-CLEAR
  7896. L1ABB:  DB    $03             ; Class-03 - A numeric expression may follow
  7897.                                 ; else default to zero.
  7898.         DEFW    L1EAC           ; Address: $1EAC; Address: CLEAR
  7899.  
  7900. ;; P-CLS
  7901. L1ABE:  DB    $00             ; Class-00 - No further operands.
  7902.         DEFW    L0D6B           ; Address: $0D6B; Address: CLS
  7903.  
  7904. ;; P-PLOT
  7905. L1AC1:  DB    $09             ; Class-09 - Two comma-separated numeric
  7906.                                 ; expressions required with optional colour
  7907.                                 ; items.
  7908.         DB    $00             ; Class-00 - No further operands.
  7909.         DEFW    L22DC           ; Address: $22DC; Address: PLOT
  7910.  
  7911. ;; P-PAUSE
  7912. L1AC5:  DB    $06             ; Class-06 - A numeric expression must follow.
  7913.         DB    $00             ; Class-00 - No further operands.
  7914.         DEFW    L1F3A           ; Address: $1F3A; Address: PAUSE
  7915.  
  7916. ;; P-READ
  7917. L1AC9:  DB    $05             ; Class-05 - Variable syntax checked entirely
  7918.                                 ; by routine.
  7919.         DEFW    L1DED           ; Address: $1DED; Address: READ
  7920.  
  7921. ;; P-DATA
  7922. L1ACC:  DB    $05             ; Class-05 - Variable syntax checked entirely
  7923.                                 ; by routine.
  7924.         DEFW    L1E27           ; Address: $1E27; Address: DATA
  7925.  
  7926. ;; P-RESTORE
  7927. L1ACF:  DB    $03             ; Class-03 - A numeric expression may follow
  7928.                                 ; else default to zero.
  7929.         DEFW    L1E42           ; Address: $1E42; Address: RESTORE
  7930.  
  7931. ;; P-DRAW
  7932. L1AD2:  DB    $09             ; Class-09 - Two comma-separated numeric
  7933.                                 ; expressions required with optional colour
  7934.                                 ; items.
  7935.         DB    $05             ; Class-05 - Variable syntax checked
  7936.                                 ; by routine.
  7937.         DEFW    L2382           ; Address: $2382; Address: DRAW
  7938.  
  7939. ;; P-COPY
  7940. L1AD6:  DB    $00             ; Class-00 - No further operands.
  7941.         DEFW    L0EAC           ; Address: $0EAC; Address: COPY
  7942.  
  7943. ;; P-LPRINT
  7944. L1AD9:  DB    $05             ; Class-05 - Variable syntax checked entirely
  7945.                                 ; by routine.
  7946.         DEFW    L1FC9           ; Address: $1FC9; Address: LPRINT
  7947.  
  7948. ;; P-LLIST
  7949. L1ADC:  DB    $05             ; Class-05 - Variable syntax checked entirely
  7950.                                 ; by routine.
  7951.         DEFW    L17F5           ; Address: $17F5; Address: LLIST
  7952.  
  7953. ;; P-SAVE
  7954. L1ADF:  DB    $0B             ; Class-0B - Offset address converted to tape
  7955.                                 ; command.
  7956.  
  7957. ;; P-LOAD
  7958. L1AE0:  DB    $0B             ; Class-0B - Offset address converted to tape
  7959.                                 ; command.
  7960.  
  7961. ;; P-VERIFY
  7962. L1AE1:  DB    $0B             ; Class-0B - Offset address converted to tape
  7963.                                 ; command.
  7964.  
  7965. ;; P-MERGE
  7966. L1AE2:  DB    $0B             ; Class-0B - Offset address converted to tape
  7967.                                 ; command.
  7968.  
  7969. ;; P-BEEP
  7970. L1AE3:  DB    $08             ; Class-08 - Two comma-separated numeric
  7971.                                 ; expressions required.
  7972.         DB    $00             ; Class-00 - No further operands.
  7973.         DEFW    L03F8           ; Address: $03F8; Address: BEEP
  7974.  
  7975. ;; P-CIRCLE
  7976. L1AE7:  DB    $09             ; Class-09 - Two comma-separated numeric
  7977.                                 ; expressions required with optional colour
  7978.                                 ; items.
  7979.         DB    $05             ; Class-05 - Variable syntax checked
  7980.                                 ; by routine.
  7981.         DEFW    L2320           ; Address: $2320; Address: CIRCLE
  7982.  
  7983. ;; P-INK
  7984. L1AEB:  DB    $07             ; Class-07 - Offset address is converted to
  7985.                                 ; colour code.
  7986.  
  7987. ;; P-PAPER
  7988. L1AEC:  DB    $07             ; Class-07 - Offset address is converted to
  7989.                                 ; colour code.
  7990.  
  7991. ;; P-FLASH
  7992. L1AED:  DB    $07             ; Class-07 - Offset address is converted to
  7993.                                 ; colour code.
  7994.  
  7995. ;; P-BRIGHT
  7996. L1AEE:  DB    $07             ; Class-07 - Offset address is converted to
  7997.                                 ; colour code.
  7998.  
  7999. ;; P-INVERSE
  8000. L1AEF:  DB    $07             ; Class-07 - Offset address is converted to
  8001.                                 ; colour code.
  8002.  
  8003. ;; P-OVER
  8004. L1AF0:  DB    $07             ; Class-07 - Offset address is converted to
  8005.                                 ; colour code.
  8006.  
  8007. ;; P-OUT
  8008. L1AF1:  DB    $08             ; Class-08 - Two comma-separated numeric
  8009.                                 ; expressions required.
  8010.         DB    $00             ; Class-00 - No further operands.
  8011.         DEFW    L1E7A           ; Address: $1E7A; Address: OUT
  8012.  
  8013. ;; P-BORDER
  8014. L1AF5:  DB    $06             ; Class-06 - A numeric expression must follow.
  8015.         DB    $00             ; Class-00 - No further operands.
  8016.         DEFW    L2294           ; Address: $2294; Address: BORDER
  8017.  
  8018. ;; P-DEF-FN
  8019. L1AF9:  DB    $05             ; Class-05 - Variable syntax checked entirely
  8020.                                 ; by routine.
  8021.         DEFW    L1F60           ; Address: $1F60; Address: DEF-FN
  8022.  
  8023. ;; P-OPEN
  8024. L1AFC:  DB    $06             ; Class-06 - A numeric expression must follow.
  8025.         DB    $2C             ; Separator:  ','          see Footnote *
  8026.         DB    $0A             ; Class-0A - A string expression must follow.
  8027.         DB    $00             ; Class-00 - No further operands.
  8028.         DEFW    L1736           ; Address: $1736; Address: OPEN
  8029.  
  8030. ;; P-CLOSE
  8031. L1B02:  DB    $06             ; Class-06 - A numeric expression must follow.
  8032.         DB    $00             ; Class-00 - No further operands.
  8033.         DEFW    L16E5           ; Address: $16E5; Address: CLOSE
  8034.  
  8035. ;; P-FORMAT
  8036. L1B06:  DB    $0A             ; Class-0A - A string expression must follow.
  8037.         DB    $00             ; Class-00 - No further operands.
  8038.         DEFW    L1793           ; Address: $1793; Address: CAT-ETC
  8039.  
  8040. ;; P-MOVE
  8041. L1B0A:  DB    $0A             ; Class-0A - A string expression must follow.
  8042.         DB    $2C             ; Separator:  ','
  8043.         DB    $0A             ; Class-0A - A string expression must follow.
  8044.         DB    $00             ; Class-00 - No further operands.
  8045.         DEFW    L1793           ; Address: $1793; Address: CAT-ETC
  8046.  
  8047. ;; P-ERASE
  8048. L1B10:  DB    $0A             ; Class-0A - A string expression must follow.
  8049.         DB    $00             ; Class-00 - No further operands.
  8050.         DEFW    L1793           ; Address: $1793; Address: CAT-ETC
  8051.  
  8052. ;; P-CAT
  8053. L1B14:  DB    $00             ; Class-00 - No further operands.
  8054.         DEFW    L1793           ; Address: $1793; Address: CAT-ETC
  8055.  
  8056. ; * Note that a comma is required as a separator with the OPEN command
  8057. ; but the Interface 1 programmers relaxed this allowing ';' as an
  8058. ; alternative for their channels creating a confusing mixture of
  8059. ; allowable syntax as it is this ROM which opens or re-opens the
  8060. ; normal channels.
  8061.  
  8062. ; -------------------------------
  8063. ; Main parser (BASIC interpreter)
  8064. ; -------------------------------
  8065. ; This routine is called once from MAIN-2 when the BASIC line is to
  8066. ; be entered or re-entered into the Program area and the syntax
  8067. ; requires checking.
  8068.  
  8069. ;; LINE-SCAN
  8070. L1B17:  RES     7,(IY+$01)      ; update FLAGS - signal checking syntax
  8071.         CALL    L19FB           ; routine E-LINE-NO              >>
  8072.                                 ; fetches the line number if in range.
  8073.  
  8074.         XOR     A               ; clear the accumulator.
  8075.         LD      ($5C47),A       ; set statement number SUBPPC to zero.
  8076.         DEC     A               ; set accumulator to $FF.
  8077.         LD      ($5C3A),A       ; set ERR_NR to 'OK' - 1.
  8078.         JR      L1B29           ; forward to continue at STMT-L-1.
  8079.  
  8080. ; --------------
  8081. ; Statement loop
  8082. ; --------------
  8083. ;
  8084. ;
  8085.  
  8086. ;; STMT-LOOP
  8087. L1B28:  RST     20H             ; NEXT-CHAR
  8088.  
  8089. ; -> the entry point from above or LINE-RUN
  8090. ;; STMT-L-1
  8091. L1B29:  CALL    L16BF           ; routine SET-WORK clears workspace etc.
  8092.  
  8093.         INC     (IY+$0D)        ; increment statement number SUBPPC
  8094.         JP      M,L1C8A         ; to REPORT-C to raise
  8095.                                 ; 'Nonsense in BASIC' if over 127.
  8096.  
  8097.         RST     18H             ; GET-CHAR
  8098.  
  8099.         LD      B,$00           ; set B to zero for later indexing.
  8100.                                 ; early so any other reason ???
  8101.  
  8102.         CP      $0D             ; is character carriage return ?
  8103.                                 ; i.e. an empty statement.
  8104.         JR      Z,L1BB3         ; forward to LINE-END if so.
  8105.  
  8106.         CP      $3A             ; is it statement end marker ':' ?
  8107.                                 ; i.e. another type of empty statement.
  8108.         JR      Z,L1B28         ; back to STMT-LOOP if so.
  8109.  
  8110.         LD      HL,L1B76        ; address: STMT-RET
  8111.         PUSH    HL              ; is now pushed as a return address
  8112.         LD      C,A             ; transfer the current character to C.
  8113.  
  8114. ; advance CH_ADD to a position after command and test if it is a command.
  8115.  
  8116.         RST     20H             ; NEXT-CHAR to advance pointer
  8117.         LD      A,C             ; restore current character
  8118.         SUB     $CE             ; subtract 'DEF FN' - first command
  8119.         JP      C,L1C8A         ; jump to REPORT-C if less than a command
  8120.                                 ; raising
  8121.                                 ; 'Nonsense in BASIC'
  8122.  
  8123.         LD      C,A             ; put the valid command code back in C.
  8124.                                 ; register B is zero.
  8125.         LD      HL,L1A48        ; address: offst-tbl
  8126.         ADD     HL,BC           ; index into table with one of 50 commands.
  8127.         LD      C,(HL)          ; pick up displacement to syntax table entry.
  8128.         ADD     HL,BC           ; add to address the relevant entry.
  8129.         JR      L1B55           ; forward to continue at GET-PARAM
  8130.  
  8131. ; ----------------------
  8132. ; The main scanning loop
  8133. ; ----------------------
  8134. ; not documented properly
  8135. ;
  8136.  
  8137. ;; SCAN-LOOP
  8138. L1B52:  LD      HL,($5C74)      ; fetch temporary address from T_ADDR
  8139.                                 ; during subsequent loops.
  8140.  
  8141. ; -> the initial entry point with HL addressing start of syntax table entry.
  8142.  
  8143. ;; GET-PARAM
  8144. L1B55:  LD      A,(HL)          ; pick up the parameter.
  8145.         INC     HL              ; address next one.
  8146.         LD      ($5C74),HL      ; save pointer in system variable T_ADDR
  8147.  
  8148.         LD      BC,L1B52        ; address: SCAN-LOOP
  8149.         PUSH    BC              ; is now pushed on stack as looping address.
  8150.         LD      C,A             ; store parameter in C.
  8151.         CP      $20             ; is it greater than ' '  ?
  8152.         JR      NC,L1B6F        ; forward to SEPARATOR to check that correct
  8153.                                 ; separator appears in statement if so.
  8154.  
  8155.         LD      HL,L1C01        ; address: class-tbl.
  8156.         LD      B,$00           ; prepare to index into the class table.
  8157.         ADD     HL,BC           ; index to find displacement to routine.
  8158.         LD      C,(HL)          ; displacement to BC
  8159.         ADD     HL,BC           ; add to address the CLASS routine.
  8160.         PUSH    HL              ; push the address on the stack.
  8161.  
  8162.         RST     18H             ; GET-CHAR - HL points to place in statement.
  8163.  
  8164.         DEC     B               ; reset the zero flag - the initial state
  8165.                                 ; for all class routines.
  8166.  
  8167.         RET                     ; and make an indirect jump to routine
  8168.                                 ; and then SCAN-LOOP (also on stack).
  8169.  
  8170. ; Note. one of the class routines will eventually drop the return address
  8171. ; off the stack breaking out of the above seemingly endless loop.
  8172.  
  8173. ; ----------------
  8174. ; Verify separator
  8175. ; ----------------
  8176. ; This routine is called once to verify that the mandatory separator
  8177. ; present in the parameter table is also present in the correct
  8178. ; location following the command. For example, the 'THEN' token after
  8179. ; the 'IF' token and expression.
  8180.  
  8181. ;; SEPARATOR
  8182. L1B6F:  RST     18H             ; GET-CHAR
  8183.         CP      C               ; does it match the character in C ?
  8184.         JP      NZ,L1C8A        ; jump forward to REPORT-C if not
  8185.                                 ; 'Nonsense in BASIC'.
  8186.  
  8187.         RST     20H             ; NEXT-CHAR advance to next character
  8188.         RET                     ; return.
  8189.  
  8190. ; ------------------------------
  8191. ; Come here after interpretation
  8192. ; ------------------------------
  8193. ;
  8194. ;
  8195.  
  8196. ;; STMT-RET
  8197. L1B76:  CALL    L1F54           ; routine BREAK-KEY is tested after every
  8198.                                 ; statement.
  8199.         JR      C,L1B7D         ; step forward to STMT-R-1 if not pressed.
  8200.  
  8201. ;; REPORT-L
  8202. L1B7B:  RST     08H             ; ERROR-1
  8203.         DB    $14             ; Error Report: BREAK into program
  8204.  
  8205. ;; STMT-R-1
  8206. L1B7D           IF BAS48_ONLY
  8207.                 BIT 7,(IY+0X0A)
  8208.                 ELSE
  8209.                 CALL L3B4D              ; Spectrum 128 patch
  8210.                 NOP
  8211.                 ENDIF
  8212.  
  8213. L1B81:  JR      NZ,L1BF4        ; forward to STMT-NEXT if a program line.
  8214.  
  8215.         LD      HL,($5C42)      ; fetch line number from NEWPPC
  8216.         BIT     7,H             ; will be set if minus two - direct command(s)
  8217.         JR      Z,L1B9E         ; forward to LINE-NEW if a jump is to be
  8218.                                 ; made to a new program line/statement.
  8219.  
  8220. ; --------------------
  8221. ; Run a direct command
  8222. ; --------------------
  8223. ; A direct command is to be run or, if continuing from above,
  8224. ; the next statement of a direct command is to be considered.
  8225.  
  8226. ;; LINE-RUN
  8227. L1B8A:  LD      HL,$FFFE        ; The dummy value minus two
  8228.         LD      ($5C45),HL      ; is set/reset as line number in PPC.
  8229.         LD      HL,($5C61)      ; point to end of line + 1 - WORKSP.
  8230.         DEC     HL              ; now point to $80 end-marker.
  8231.         LD      DE,($5C59)      ; address the start of line E_LINE.
  8232.         DEC     DE              ; now location before - for GET-CHAR.
  8233.         LD      A,($5C44)       ; load statement to A from NSPPC.
  8234.         JR      L1BD1           ; forward to NEXT-LINE.
  8235.  
  8236. ; ------------------------------
  8237. ; Find start address of new line
  8238. ; ------------------------------
  8239. ; The branch was to here if a jump is to made to a new line number
  8240. ; and statement.
  8241. ; That is the previous statement was a GO TO, GO SUB, RUN, RETURN, NEXT etc..
  8242.  
  8243. ;; LINE-NEW
  8244. L1B9E:  CALL    L196E           ; routine LINE-ADDR gets address of line
  8245.                                 ; returning zero flag set if line found.
  8246.         LD      A,($5C44)       ; fetch new statement from NSPPC
  8247.         JR      Z,L1BBF         ; forward to LINE-USE if line matched.
  8248.  
  8249. ; continue as must be a direct command.
  8250.  
  8251.         AND     A               ; test statement which should be zero
  8252.         JR      NZ,L1BEC        ; forward to REPORT-N if not.
  8253.                                 ; 'Statement lost'
  8254.  
  8255. ;
  8256.  
  8257.         LD      B,A             ; save statement in B. ?
  8258.         LD      A,(HL)          ; fetch high byte of line number.
  8259.         AND     $C0             ; test if using direct command
  8260.                                 ; a program line is less than $3F
  8261.         LD      A,B             ; retrieve statement.
  8262.                                 ; (we can assume it is zero).
  8263.         JR      Z,L1BBF         ; forward to LINE-USE if was a program line
  8264.  
  8265. ; Alternatively a direct statement has finished correctly.
  8266.  
  8267. ;; REPORT-0
  8268. L1BB0:  RST     08H             ; ERROR-1
  8269.         DB    $FF             ; Error Report: OK
  8270.  
  8271. ; ------------------
  8272. ; Handle REM command
  8273. ; ------------------
  8274. ; The REM command routine.
  8275. ; The return address STMT-RET is dropped and the rest of line ignored.
  8276.  
  8277. ;; REM
  8278. L1BB2:  POP     BC              ; drop return address STMT-RET and
  8279.                                 ; continue ignoring rest of line.
  8280.  
  8281. ; ------------
  8282. ; End of line?
  8283. ; ------------
  8284. ;
  8285. ;
  8286.  
  8287. ;; LINE-END
  8288. L1BB3:  CALL    L2530           ; routine SYNTAX-Z  (UNSTACK-Z?)
  8289.         RET     Z               ; return if checking syntax.
  8290.  
  8291.         LD      HL,($5C55)      ; fetch NXTLIN to HL.
  8292.         LD      A,$C0           ; test against the
  8293.         AND     (HL)            ; system limit $3F.
  8294.         RET     NZ              ; return if more as must be
  8295.                                 ; end of program.
  8296.                                 ; (or direct command)
  8297.  
  8298.         XOR     A               ; set statement to zero.
  8299.  
  8300. ; and continue to set up the next following line and then consider this new one.
  8301.  
  8302. ; ---------------------
  8303. ; General line checking
  8304. ; ---------------------
  8305. ; The branch was here from LINE-NEW if BASIC is branching.
  8306. ; or a continuation from above if dealing with a new sequential line.
  8307. ; First make statement zero number one leaving others unaffected.
  8308.  
  8309. ;; LINE-USE
  8310. L1BBF:  CP      $01             ; will set carry if zero.
  8311.         ADC     A,$00           ; add in any carry.
  8312.  
  8313.         LD      D,(HL)          ; high byte of line number to D.
  8314.         INC     HL              ; advance pointer.
  8315.         LD      E,(HL)          ; low byte of line number to E.
  8316.         LD      ($5C45),DE      ; set system variable PPC.
  8317.  
  8318.         INC     HL              ; advance pointer.
  8319.         LD      E,(HL)          ; low byte of line length to E.
  8320.         INC     HL              ; advance pointer.
  8321.         LD      D,(HL)          ; high byte of line length to D.
  8322.  
  8323.         EX      DE,HL           ; swap pointer to DE before
  8324.         ADD     HL,DE           ; adding to address the end of line.
  8325.         INC     HL              ; advance to start of next line.
  8326.  
  8327. ; -----------------------------
  8328. ; Update NEXT LINE but consider
  8329. ; previous line or edit line.
  8330. ; -----------------------------
  8331. ; The pointer will be the next line if continuing from above or to
  8332. ; edit line end-marker ($80) if from LINE-RUN.
  8333.  
  8334. ;; NEXT-LINE
  8335. L1BD1:  LD      ($5C55),HL      ; store pointer in system variable NXTLIN
  8336.  
  8337.         EX      DE,HL           ; bring back pointer to previous or edit line
  8338.         LD      ($5C5D),HL      ; and update CH_ADD with character address.
  8339.  
  8340.         LD      D,A             ; store statement in D.
  8341.         LD      E,$00           ; set E to zero to suppress token searching
  8342.                                 ; if EACH-STMT is to be called.
  8343.         LD      (IY+$0A),$FF    ; set statement NSPPC to $FF signalling
  8344.                                 ; no jump to be made.
  8345.         DEC     D               ; decrement and test statement
  8346.         LD      (IY+$0D),D      ; set SUBPPC to decremented statement number.
  8347.         JP      Z,L1B28         ; to STMT-LOOP if result zero as statement is
  8348.                                 ; at start of line and address is known.
  8349.  
  8350.         INC     D               ; else restore statement.
  8351.         CALL    L198B           ; routine EACH-STMT finds the D'th statement
  8352.                                 ; address as E does not contain a token.
  8353.         JR      Z,L1BF4         ; forward to STMT-NEXT if address found.
  8354.  
  8355. ;; REPORT-N
  8356. L1BEC:  RST     08H             ; ERROR-1
  8357.         DB    $16             ; Error Report: Statement lost
  8358.  
  8359. ; -----------------
  8360. ; End of statement?
  8361. ; -----------------
  8362. ; This combination of routines is called from 20 places when
  8363. ; the end of a statement should have been reached and all preceding
  8364. ; syntax is in order.
  8365.  
  8366. ;; CHECK-END
  8367. L1BEE:  CALL    L2530           ; routine SYNTAX-Z
  8368.         RET     NZ              ; return immediately in runtime
  8369.  
  8370.         POP     BC              ; drop address of calling routine.
  8371.         POP     BC              ; drop address STMT-RET.
  8372.                                 ; and continue to find next statement.
  8373.  
  8374. ; --------------------
  8375. ; Go to next statement
  8376. ; --------------------
  8377. ; Acceptable characters at this point are carriage return and ':'.
  8378. ; If so go to next statement which in the first case will be on next line.
  8379.  
  8380. ;; STMT-NEXT
  8381. L1BF4           IF BAS48_ONLY
  8382.                 RST 0X18
  8383.                 CP 0X0D
  8384.                 ELSE
  8385.                 CALL L3B5D              ; Spectrum 128 patch
  8386.                 ENDIF
  8387.  
  8388. L1BF7:  JR      Z,L1BB3         ; back to LINE-END if so.
  8389.  
  8390.         CP      $3A             ; is it ':' ?
  8391.         JP      Z,L1B28         ; jump back to STMT-LOOP to consider
  8392.                                 ; further statements
  8393.  
  8394.         JP      L1C8A           ; jump to REPORT-C with any other character
  8395.                                 ; 'Nonsense in BASIC'.
  8396.  
  8397. ; Note. the two-byte sequence 'rst 08; DB $0b' could replace the above jp.
  8398.  
  8399. ; -------------------
  8400. ; Command class table
  8401. ; -------------------
  8402. ;
  8403.  
  8404. ;; class-tbl
  8405. L1C01:  DB    L1C10 - $       ; 0F offset to Address: CLASS-00
  8406.         DB    L1C1F - $       ; 1D offset to Address: CLASS-01
  8407.         DB    L1C4E - $       ; 4B offset to Address: CLASS-02
  8408.         DB    L1C0D - $       ; 09 offset to Address: CLASS-03
  8409.         DB    L1C6C - $       ; 67 offset to Address: CLASS-04
  8410.         DB    L1C11 - $       ; 0B offset to Address: CLASS-05
  8411.         DB    L1C82 - $       ; 7B offset to Address: CLASS-06
  8412.         DB    L1C96 - $       ; 8E offset to Address: CLASS-07
  8413.         DB    L1C7A - $       ; 71 offset to Address: CLASS-08
  8414.         DB    L1CBE - $       ; B4 offset to Address: CLASS-09
  8415.         DB    L1C8C - $       ; 81 offset to Address: CLASS-0A
  8416.         DB    L1CDB - $       ; CF offset to Address: CLASS-0B
  8417.  
  8418.  
  8419. ; --------------------------------
  8420. ; Command classes---00, 03, and 05
  8421. ; --------------------------------
  8422. ; class-03 e.g RUN or RUN 200   ;  optional operand
  8423. ; class-00 e.g CONTINUE         ;  no operand
  8424. ; class-05 e.g PRINT            ;  variable syntax checked by routine
  8425.  
  8426. ;; CLASS-03
  8427. L1C0D:  CALL    L1CDE           ; routine FETCH-NUM
  8428.  
  8429. ;; CLASS-00
  8430.  
  8431. L1C10:  CP      A               ; reset zero flag.
  8432.  
  8433. ; if entering here then all class routines are entered with zero reset.
  8434.  
  8435. ;; CLASS-05
  8436. L1C11:  POP     BC              ; drop address SCAN-LOOP.
  8437.         CALL    Z,L1BEE         ; if zero set then call routine CHECK-END >>>
  8438.                                 ; as should be no further characters.
  8439.  
  8440.         EX      DE,HL           ; save HL to DE.
  8441.         LD      HL,($5C74)      ; fetch T_ADDR
  8442.         LD      C,(HL)          ; fetch low byte of routine
  8443.         INC     HL              ; address next.
  8444.         LD      B,(HL)          ; fetch high byte of routine.
  8445.         EX      DE,HL           ; restore HL from DE
  8446.         PUSH    BC              ; push the address
  8447.         RET                     ; and make an indirect jump to the command.
  8448.  
  8449. ; --------------------------------
  8450. ; Command classes---01, 02, and 04
  8451. ; --------------------------------
  8452. ; class-01  e.g LET A = 2*3     ; a variable is reqd
  8453.  
  8454. ; This class routine is also called from INPUT and READ to find the
  8455. ; destination variable for an assignment.
  8456.  
  8457. ;; CLASS-01
  8458. L1C1F:  CALL    L28B2           ; routine LOOK-VARS returns carry set if not
  8459.                                 ; found in runtime.
  8460.  
  8461. ; ----------------------
  8462. ; Variable in assignment
  8463. ; ----------------------
  8464. ;
  8465. ;
  8466.  
  8467. ;; VAR-A-1
  8468. L1C22:  LD      (IY+$37),$00    ; set FLAGX to zero
  8469.         JR      NC,L1C30        ; forward to VAR-A-2 if found or checking
  8470.                                 ; syntax.
  8471.  
  8472.         SET     1,(IY+$37)      ; FLAGX  - Signal a new variable
  8473.         JR      NZ,L1C46        ; to VAR-A-3 if not assigning to an array
  8474.                                 ; e.g. LET a$(3,3) = "X"
  8475.  
  8476. ;; REPORT-2
  8477. L1C2E:  RST     08H             ; ERROR-1
  8478.         DB    $01             ; Error Report: Variable not found
  8479.  
  8480. ;; VAR-A-2
  8481. L1C30:  CALL    Z,L2996         ; routine STK-VAR considers a subscript/slice
  8482.         BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
  8483.         JR      NZ,L1C46        ; to VAR-A-3 if numeric
  8484.  
  8485.         XOR     A               ; default to array/slice - to be retained.
  8486.         CALL    L2530           ; routine SYNTAX-Z
  8487.         CALL    NZ,L2BF1        ; routine STK-FETCH is called in runtime
  8488.                                 ; may overwrite A with 1.
  8489.         LD      HL,$5C71        ; address system variable FLAGX
  8490.         OR      (HL)            ; set bit 0 if simple variable to be reclaimed
  8491.         LD      (HL),A          ; update FLAGX
  8492.         EX      DE,HL           ; start of string/subscript to DE
  8493.  
  8494. ;; VAR-A-3
  8495. L1C46:  LD      ($5C72),BC      ; update STRLEN
  8496.         LD      ($5C4D),HL      ; and DEST of assigned string.
  8497.         RET                     ; return.
  8498.  
  8499. ; -------------------------------------------------
  8500. ; class-02 e.g. LET a = 1 + 1   ; an expression must follow
  8501.  
  8502. ;; CLASS-02
  8503. L1C4E:  POP     BC              ; drop return address SCAN-LOOP
  8504.         CALL    L1C56           ; routine VAL-FET-1 is called to check
  8505.                                 ; expression and assign result in runtime
  8506.         CALL    L1BEE           ; routine CHECK-END checks nothing else
  8507.                                 ; is present in statement.
  8508.         RET                     ; Return
  8509.  
  8510. ; -------------
  8511. ; Fetch a value
  8512. ; -------------
  8513. ;
  8514. ;
  8515.  
  8516. ;; VAL-FET-1
  8517. L1C56:  LD      A,($5C3B)       ; initial FLAGS to A
  8518.  
  8519. ;; VAL-FET-2
  8520. L1C59:  PUSH    AF              ; save A briefly
  8521.         CALL    L24FB           ; routine SCANNING evaluates expression.
  8522.         POP     AF              ; restore A
  8523.         LD      D,(IY+$01)      ; post-SCANNING FLAGS to D
  8524.         XOR     D               ; xor the two sets of flags
  8525.         AND     $40             ; pick up bit 6 of xored FLAGS should be zero
  8526.         JR      NZ,L1C8A        ; forward to REPORT-C if not zero
  8527.                                 ; 'Nonsense in BASIC' - results don't agree.
  8528.  
  8529.         BIT     7,D             ; test FLAGS - is syntax being checked ?
  8530.         JP      NZ,L2AFF        ; jump forward to LET to make the assignment
  8531.                                 ; in runtime.
  8532.  
  8533.         RET                     ; but return from here if checking syntax.
  8534.  
  8535. ; ------------------
  8536. ; Command class---04
  8537. ; ------------------
  8538. ; class-04 e.g. FOR i            ; a single character variable must follow
  8539.  
  8540. ;; CLASS-04
  8541. L1C6C:  CALL    L28B2           ; routine LOOK-VARS
  8542.         PUSH    AF              ; preserve flags.
  8543.         LD      A,C             ; fetch type - should be 011xxxxx
  8544.         OR      $9F             ; combine with 10011111.
  8545.         INC     A               ; test if now $FF by incrementing.
  8546.         JR      NZ,L1C8A        ; forward to REPORT-C if result not zero.
  8547.  
  8548.         POP     AF              ; else restore flags.
  8549.         JR      L1C22           ; back to VAR-A-1
  8550.  
  8551.  
  8552. ; --------------------------------
  8553. ; Expect numeric/string expression
  8554. ; --------------------------------
  8555. ; This routine is used to get the two coordinates of STRING$, ATTR and POINT.
  8556. ; It is also called from PRINT-ITEM to get the two numeric expressions that
  8557. ; follow the AT ( in PRINT AT, INPUT AT).
  8558.  
  8559. ;; NEXT-2NUM
  8560. L1C79:  RST     20H             ; NEXT-CHAR advance past 'AT' or '('.
  8561.  
  8562. ; --------
  8563. ; class-08 e.g POKE 65535,2     ; two numeric expressions separated by comma
  8564. ;; CLASS-08
  8565. ;; EXPT-2NUM
  8566. L1C7A:  CALL    L1C82           ; routine EXPT-1NUM is called for first
  8567.                                 ; numeric expression
  8568.         CP      $2C             ; is character ',' ?
  8569.         JR      NZ,L1C8A        ; to REPORT-C if not required separator.
  8570.                                 ; 'Nonsense in BASIC'.
  8571.  
  8572.         RST     20H             ; NEXT-CHAR
  8573.  
  8574. ; ->
  8575. ;  class-06  e.g. GOTO a*1000   ; a numeric expression must follow
  8576. ;; CLASS-06
  8577. ;; EXPT-1NUM
  8578. L1C82:  CALL    L24FB           ; routine SCANNING
  8579.         BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
  8580.         RET     NZ              ; return if result is numeric.
  8581.  
  8582. ;; REPORT-C
  8583. L1C8A:  RST     08H             ; ERROR-1
  8584.         DB    $0B             ; Error Report: Nonsense in BASIC
  8585.  
  8586. ; ---------------------------------------------------------------
  8587. ; class-0A e.g. ERASE "????"    ; a string expression must follow.
  8588. ;                               ; these only occur in unimplemented commands
  8589. ;                               ; although the routine expt-exp is called
  8590. ;                               ; from SAVE-ETC
  8591.  
  8592. ;; CLASS-0A
  8593. ;; EXPT-EXP
  8594. L1C8C:  CALL    L24FB           ; routine SCANNING
  8595.         BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
  8596.         RET     Z               ; return if string result.
  8597.  
  8598.         JR      L1C8A           ; back to REPORT-C if numeric.
  8599.  
  8600. ; ---------------------
  8601. ; Set permanent colours
  8602. ; class 07
  8603. ; ---------------------
  8604. ; class-07 e.g PAPER 6          ; a single class for a collection of
  8605. ;                               ; similar commands. Clever.
  8606. ;
  8607. ; Note. these commands should ensure that current channel is 'S'
  8608.  
  8609. ;; CLASS-07
  8610. L1C96:  BIT     7,(IY+$01)      ; test FLAGS - checking syntax only ?
  8611.         RES     0,(IY+$02)      ; update TV_FLAG - signal main screen in use
  8612.         CALL    NZ,L0D4D        ; routine TEMPS is called in runtime.
  8613.         POP     AF              ; drop return address SCAN-LOOP
  8614.         LD      A,($5C74)       ; T_ADDR_lo to accumulator.
  8615.                                 ; points to '$07' entry + 1
  8616.                                 ; e.g. for INK points to $EC now
  8617.  
  8618. ; Note if you move alter the syntax table next line may have to be altered.
  8619.  
  8620. ; Note. For ZASM assembler replace following expression with SUB $13.
  8621.  
  8622. L1CA5           SUB LOW (L1AEB)-$D8     ; % 256 ; convert $EB to $D8 ('INK') etc.
  8623.                                 ; ( is SUB $13 in standard ROM )
  8624.  
  8625.         CALL    L21FC           ; routine CO-TEMP-4
  8626.         CALL    L1BEE           ; routine CHECK-END check that nothing else
  8627.                                 ; in statement.
  8628.  
  8629. ; return here in runtime.
  8630.  
  8631.         LD      HL,($5C8F)      ; pick up ATTR_T and MASK_T
  8632.         LD      ($5C8D),HL      ; and store in ATTR_P and MASK_P
  8633.         LD      HL,$5C91        ; point to P_FLAG.
  8634.         LD      A,(HL)          ; pick up in A
  8635.         RLCA                    ; rotate to left
  8636.         XOR     (HL)            ; combine with HL
  8637.         AND     $AA             ; 10101010
  8638.         XOR     (HL)            ; only permanent bits affected
  8639.         LD      (HL),A          ; reload into P_FLAG.
  8640.         RET                     ; return.
  8641.  
  8642. ; ------------------
  8643. ; Command class---09
  8644. ; ------------------
  8645. ; e.g. PLOT PAPER 0; 128,88     ; two coordinates preceded by optional
  8646. ;                               ; embedded colour items.
  8647. ;
  8648. ; Note. this command should ensure that current channel is actually 'S'.
  8649.  
  8650. ;; CLASS-09
  8651. L1CBE:  CALL    L2530           ; routine SYNTAX-Z
  8652.         JR      Z,L1CD6         ; forward to CL-09-1 if checking syntax.
  8653.  
  8654.         RES     0,(IY+$02)      ; update TV_FLAG - signal main screen in use
  8655.         CALL    L0D4D           ; routine TEMPS is called.
  8656.         LD      HL,$5C90        ; point to MASK_T
  8657.         LD      A,(HL)          ; fetch mask to accumulator.
  8658.         OR      $F8             ; or with 11111000 paper/bright/flash 8
  8659.         LD      (HL),A          ; mask back to MASK_T system variable.
  8660.         RES     6,(IY+$57)      ; reset P_FLAG  - signal NOT PAPER 9 ?
  8661.  
  8662.         RST     18H             ; GET-CHAR
  8663.  
  8664. ;; CL-09-1
  8665. L1CD6:  CALL    L21E2           ; routine CO-TEMP-2 deals with any embedded
  8666.                                 ; colour items.
  8667.         JR      L1C7A           ; exit via EXPT-2NUM to check for x,y.
  8668.  
  8669. ; Note. if either of the numeric expressions contain STR$ then the flag setting
  8670. ; above will be undone when the channel flags are reset during STR$.
  8671. ; e.g.
  8672. ; 10 BORDER 3 : PLOT VAL STR$ 128, VAL STR$ 100
  8673. ; credit John Elliott.
  8674.  
  8675. ; ------------------
  8676. ; Command class---0B
  8677. ; ------------------
  8678. ; Again a single class for four commands.
  8679. ; This command just jumps back to SAVE-ETC to handle the four tape commands.
  8680. ; The routine itself works out which command has called it by examining the
  8681. ; address in T_ADDR_lo. Note therefore that the syntax table has to be
  8682. ; located where these and other sequential command addresses are not split
  8683. ; over a page boundary.
  8684.  
  8685. ;; CLASS-0B
  8686. L1CDB:  JP      L0605           ; jump way back to SAVE-ETC
  8687.  
  8688. ; --------------
  8689. ; Fetch a number
  8690. ; --------------
  8691. ; This routine is called from CLASS-03 when a command may be followed by
  8692. ; an optional numeric expression e.g. RUN. If the end of statement has
  8693. ; been reached then zero is used as the default.
  8694. ; Also called from LIST-4.
  8695.  
  8696. ;; FETCH-NUM
  8697. L1CDE:  CP      $0D             ; is character a carriage return ?
  8698.         JR      Z,L1CE6         ; forward to USE-ZERO if so
  8699.  
  8700.         CP      $3A             ; is it ':' ?
  8701.         JR      NZ,L1C82        ; forward to EXPT-1NUM if not.
  8702.                                 ; else continue and use zero.
  8703.  
  8704. ; ----------------
  8705. ; Use zero routine
  8706. ; ----------------
  8707. ; This routine is called four times to place the value zero on the
  8708. ; calculator stack as a default value in runtime.
  8709.  
  8710. ;; USE-ZERO
  8711. L1CE6:  CALL    L2530           ; routine SYNTAX-Z  (UNSTACK-Z?)
  8712.         RET     Z               ;
  8713.  
  8714.         RST     28H             ;; FP-CALC
  8715.         DB    $A0             ;;stk-zero       ;0.
  8716.         DB    $38             ;;end-calc
  8717.  
  8718.         RET                     ; return.
  8719.  
  8720. ; -------------------
  8721. ; Handle STOP command
  8722. ; -------------------
  8723. ; Command Syntax: STOP
  8724. ; One of the shortest and least used commands. As with 'OK' not an error.
  8725.  
  8726. ;; REPORT-9
  8727. ;; STOP
  8728. L1CEE:  RST     08H             ; ERROR-1
  8729.         DB    $08             ; Error Report: STOP statement
  8730.  
  8731. ; -----------------
  8732. ; Handle IF command
  8733. ; -----------------
  8734. ; e.g. IF score>100 THEN PRINT "You Win"
  8735. ; The parser has already checked the expression the result of which is on
  8736. ; the calculator stack. The presence of the 'THEN' separator has also been
  8737. ; checked and CH-ADD points to the command after THEN.
  8738. ;
  8739.  
  8740. ;; IF
  8741. L1CF0:  POP     BC              ; drop return address - STMT-RET
  8742.         CALL    L2530           ; routine SYNTAX-Z
  8743.         JR      Z,L1D00         ; forward to IF-1 if checking syntax
  8744.                                 ; to check syntax of PRINT "You Win"
  8745.  
  8746.  
  8747.         RST     28H             ;; FP-CALC    score>100 (1=TRUE 0=FALSE)
  8748.         DB    $02             ;;delete      .
  8749.         DB    $38             ;;end-calc
  8750.  
  8751.         EX      DE,HL           ; make HL point to deleted value
  8752.         CALL    L34E9           ; routine TEST-ZERO
  8753.         JP      C,L1BB3         ; jump to LINE-END if FALSE (0)
  8754.  
  8755. ;; IF-1
  8756. L1D00:  JP      L1B29           ; to STMT-L-1, if true (1) to execute command
  8757.                                 ; after 'THEN' token.
  8758.  
  8759. ; ------------------
  8760. ; Handle FOR command
  8761. ; ------------------
  8762. ; e.g. FOR i = 0 TO 1 STEP 0.1
  8763. ; Using the syntax tables, the parser has already checked for a start and
  8764. ; limit value and also for the intervening separator.
  8765. ; the two values v,l are on the calculator stack.
  8766. ; CLASS-04 has also checked the variable and the name is in STRLEN_lo.
  8767. ; The routine begins by checking for an optional STEP.
  8768.  
  8769. ;; FOR
  8770. L1D03:  CP      $CD             ; is there a 'STEP' ?
  8771.         JR      NZ,L1D10        ; to F-USE-1 if not to use 1 as default.
  8772.  
  8773.         RST     20H             ; NEXT-CHAR
  8774.         CALL    L1C82           ; routine EXPT-1NUM
  8775.         CALL    L1BEE           ; routine CHECK-END
  8776.         JR      L1D16           ; to F-REORDER
  8777.  
  8778. ; ---
  8779.  
  8780. ;; F-USE-1
  8781. L1D10:  CALL    L1BEE           ; routine CHECK-END
  8782.  
  8783.         RST     28H             ;; FP-CALC      v,l.
  8784.         DB    $A1             ;;stk-one       v,l,1=s.
  8785.         DB    $38             ;;end-calc
  8786.  
  8787.  
  8788. ;; F-REORDER
  8789. L1D16:  RST     28H             ;; FP-CALC       v,l,s.
  8790.         DB    $C0             ;;st-mem-0       v,l,s.
  8791.         DB    $02             ;;delete         v,l.
  8792.         DB    $01             ;;exchange       l,v.
  8793.         DB    $E0             ;;get-mem-0      l,v,s.
  8794.         DB    $01             ;;exchange       l,s,v.
  8795.         DB    $38             ;;end-calc
  8796.  
  8797.         CALL    L2AFF           ; routine LET assigns the initial value v to
  8798.                                 ; the variable altering type if necessary.
  8799.         LD      ($5C68),HL      ; The system variable MEM is made to point to
  8800.                                 ; the variable instead of its normal
  8801.                                 ; location MEMBOT
  8802.         DEC     HL              ; point to single-character name
  8803.         LD      A,(HL)          ; fetch name
  8804.         SET     7,(HL)          ; set bit 7 at location
  8805.         LD      BC,$0006        ; add six to HL
  8806.         ADD     HL,BC           ; to address where limit should be.
  8807.         RLCA                    ; test bit 7 of original name.
  8808.         JR      C,L1D34         ; forward to F-L-S if already a FOR/NEXT
  8809.                                 ; variable
  8810.  
  8811.         LD      C,$0D           ; otherwise an additional 13 bytes are needed.
  8812.                                 ; 5 for each value, two for line number and
  8813.                                 ; 1 byte for looping statement.
  8814.         CALL    L1655           ; routine MAKE-ROOM creates them.
  8815.         INC     HL              ; make HL address limit.
  8816.  
  8817. ;; F-L-S
  8818. L1D34:  PUSH    HL              ; save position.
  8819.  
  8820.         RST     28H             ;; FP-CALC         l,s.
  8821.         DB    $02             ;;delete           l.
  8822.         DB    $02             ;;delete           .
  8823.         DB    $38             ;;end-calc
  8824.                                 ; DE points to STKEND, l.
  8825.  
  8826.         POP     HL              ; restore variable position
  8827.         EX      DE,HL           ; swap pointers
  8828.         LD      C,$0A           ; ten bytes to move
  8829.         LDIR                    ; Copy 'deleted' values to variable.
  8830.         LD      HL,($5C45)      ; Load with current line number from PPC
  8831.         EX      DE,HL           ; exchange pointers.
  8832.         LD      (HL),E          ; save the looping line
  8833.         INC     HL              ; in the next
  8834.         LD      (HL),D          ; two locations.
  8835.         LD      D,(IY+$0D)      ; fetch statement from SUBPPC system variable.
  8836.         INC     D               ; increment statement.
  8837.         INC     HL              ; and pointer
  8838.         LD      (HL),D          ; and store the looping statement.
  8839.                                 ;
  8840.         CALL    L1DDA           ; routine NEXT-LOOP considers an initial
  8841.         RET     NC              ; iteration. Return to STMT-RET if a loop is
  8842.                                 ; possible to execute next statement.
  8843.  
  8844. ; no loop is possible so execution continues after the matching 'NEXT'
  8845.  
  8846.         LD      B,(IY+$38)      ; get single-character name from STRLEN_lo
  8847.         LD      HL,($5C45)      ; get the current line from PPC
  8848.         LD      ($5C42),HL      ; and store it in NEWPPC
  8849.         LD      A,($5C47)       ; fetch current statement from SUBPPC
  8850.         NEG                     ; Negate as counter decrements from zero
  8851.                                 ; initially and we are in the middle of a
  8852.                                 ; line.
  8853.         LD      D,A             ; Store result in D.
  8854.         LD      HL,($5C5D)      ; get current address from CH_ADD
  8855.         LD      E,$F3           ; search will be for token 'NEXT'
  8856.  
  8857. ;; F-LOOP
  8858. L1D64:  PUSH    BC              ; save variable name.
  8859.         LD      BC,($5C55)      ; fetch NXTLIN
  8860.         CALL    L1D86           ; routine LOOK-PROG searches for 'NEXT' token.
  8861.         LD      ($5C55),BC      ; update NXTLIN
  8862.         POP     BC              ; and fetch the letter
  8863.         JR      C,L1D84         ; forward to REPORT-I if the end of program
  8864.                                 ; was reached by LOOK-PROG.
  8865.                                 ; 'FOR without NEXT'
  8866.  
  8867.         RST     20H             ; NEXT-CHAR fetches character after NEXT
  8868.         OR      $20             ; ensure it is upper-case.
  8869.         CP      B               ; compare with FOR variable name
  8870.         JR      Z,L1D7C         ; forward to F-FOUND if it matches.
  8871.  
  8872. ; but if no match i.e. nested FOR/NEXT loops then continue search.
  8873.  
  8874.         RST     20H             ; NEXT-CHAR
  8875.         JR      L1D64           ; back to F-LOOP
  8876.  
  8877. ; ---
  8878.  
  8879.  
  8880. ;; F-FOUND
  8881. L1D7C:  RST     20H             ; NEXT-CHAR
  8882.         LD      A,$01           ; subtract the negated counter from 1
  8883.         SUB     D               ; to give the statement after the NEXT
  8884.         LD      ($5C44),A       ; set system variable NSPPC
  8885.         RET                     ; return to STMT-RET to branch to new
  8886.                                 ; line and statement. ->
  8887. ; ---
  8888.  
  8889. ;; REPORT-I
  8890. L1D84:  RST     08H             ; ERROR-1
  8891.         DB    $11             ; Error Report: FOR without NEXT
  8892.  
  8893. ; ---------
  8894. ; LOOK-PROG
  8895. ; ---------
  8896. ; Find DATA, DEF FN or NEXT.
  8897. ; This routine searches the program area for one of the above three keywords.
  8898. ; On entry, HL points to start of search area.
  8899. ; The token is in E, and D holds a statement count, decremented from zero.
  8900.  
  8901. ;; LOOK-PROG
  8902. L1D86:  LD      A,(HL)          ; fetch current character
  8903.         CP      $3A             ; is it ':' a statement separator ?
  8904.         JR      Z,L1DA3         ; forward to LOOK-P-2 if so.
  8905.  
  8906. ; The starting point was PROG - 1 or the end of a line.
  8907.  
  8908. ;; LOOK-P-1
  8909. L1D8B:  INC     HL              ; increment pointer to address
  8910.         LD      A,(HL)          ; the high byte of line number
  8911.         AND     $C0             ; test for program end marker $80 or a
  8912.                                 ; variable
  8913.         SCF                     ; Set Carry Flag
  8914.         RET     NZ              ; return with carry set if at end
  8915.                                 ; of program.           ->
  8916.  
  8917.         LD      B,(HL)          ; high byte of line number to B
  8918.         INC     HL              ;
  8919.         LD      C,(HL)          ; low byte to C.
  8920.         LD      ($5C42),BC      ; set system variable NEWPPC.
  8921.         INC     HL              ;
  8922.         LD      C,(HL)          ; low byte of line length to C.
  8923.         INC     HL              ;
  8924.         LD      B,(HL)          ; high byte to B.
  8925.         PUSH    HL              ; save address
  8926.         ADD     HL,BC           ; add length to position.
  8927.         LD      B,H             ; and save result
  8928.         LD      C,L             ; in BC.
  8929.         POP     HL              ; restore address.
  8930.         LD      D,$00           ; initialize statement counter to zero.
  8931.  
  8932. ;; LOOK-P-2
  8933. L1DA3:  PUSH    BC              ; save address of next line
  8934.         CALL    L198B           ; routine EACH-STMT searches current line.
  8935.         POP     BC              ; restore address.
  8936.         RET     NC              ; return if match was found. ->
  8937.  
  8938.         JR      L1D8B           ; back to LOOK-P-1 for next line.
  8939.  
  8940. ; -------------------
  8941. ; Handle NEXT command
  8942. ; -------------------
  8943. ; e.g. NEXT i
  8944. ; The parameter tables have already evaluated the presence of a variable
  8945.  
  8946. ;; NEXT
  8947. L1DAB:  BIT     1,(IY+$37)      ; test FLAGX - handling a new variable ?
  8948.         JP      NZ,L1C2E        ; jump back to REPORT-2 if so
  8949.                                 ; 'Variable not found'
  8950.  
  8951. ; now test if found variable is a simple variable uninitialized by a FOR.
  8952.  
  8953.         LD      HL,($5C4D)      ; load address of variable from DEST
  8954.         BIT     7,(HL)          ; is it correct type ?
  8955.         JR      Z,L1DD8         ; forward to REPORT-1 if not
  8956.                                 ; 'NEXT without FOR'
  8957.  
  8958.         INC     HL              ; step past variable name
  8959.         LD      ($5C68),HL      ; and set MEM to point to three 5-byte values
  8960.                                 ; value, limit, step.
  8961.  
  8962.         RST     28H             ;; FP-CALC     add step and re-store
  8963.         DB    $E0             ;;get-mem-0    v.
  8964.         DB    $E2             ;;get-mem-2    v,s.
  8965.         DB    $0F             ;;addition     v+s.
  8966.         DB    $C0             ;;st-mem-0     v+s.
  8967.         DB    $02             ;;delete       .
  8968.         DB    $38             ;;end-calc
  8969.  
  8970.         CALL    L1DDA           ; routine NEXT-LOOP tests against limit.
  8971.         RET     C               ; return if no more iterations possible.
  8972.  
  8973.         LD      HL,($5C68)      ; find start of variable contents from MEM.
  8974.         LD      DE,$000F        ; add 3*5 to
  8975.         ADD     HL,DE           ; address the looping line number
  8976.         LD      E,(HL)          ; low byte to E
  8977.         INC     HL              ;
  8978.         LD      D,(HL)          ; high byte to D
  8979.         INC     HL              ; address looping statement
  8980.         LD      H,(HL)          ; and store in H
  8981.         EX      DE,HL           ; swap registers
  8982.         JP      L1E73           ; exit via GO-TO-2 to execute another loop.
  8983.  
  8984. ; ---
  8985.  
  8986. ;; REPORT-1
  8987. L1DD8:  RST     08H             ; ERROR-1
  8988.         DB    $00             ; Error Report: NEXT without FOR
  8989.  
  8990.  
  8991. ; -----------------
  8992. ; Perform NEXT loop
  8993. ; -----------------
  8994. ; This routine is called from the FOR command to test for an initial
  8995. ; iteration and from the NEXT command to test for all subsequent iterations.
  8996. ; the system variable MEM addresses the variable's contents which, in the
  8997. ; latter case, have had the step, possibly negative, added to the value.
  8998.  
  8999. ;; NEXT-LOOP
  9000. L1DDA:  RST     28H             ;; FP-CALC
  9001.         DB    $E1             ;;get-mem-1        l.
  9002.         DB    $E0             ;;get-mem-0        l,v.
  9003.         DB    $E2             ;;get-mem-2        l,v,s.
  9004.         DB    $36             ;;less-0           l,v,(1/0) negative step ?
  9005.         DB    $00             ;;jump-true        l,v.(1/0)
  9006.  
  9007.         DB    $02             ;;to L1DE2, NEXT-1 if step negative
  9008.  
  9009.         DB    $01             ;;exchange         v,l.
  9010.  
  9011. ;; NEXT-1
  9012. L1DE2:  DB    $03             ;;subtract         l-v OR v-l.
  9013.         DB    $37             ;;greater-0        (1/0)
  9014.         DB    $00             ;;jump-true        .
  9015.  
  9016.         DB    $04             ;;to L1DE9, NEXT-2 if no more iterations.
  9017.  
  9018.         DB    $38             ;;end-calc         .
  9019.  
  9020.         AND     A               ; clear carry flag signalling another loop.
  9021.         RET                     ; return
  9022.  
  9023. ; ---
  9024.  
  9025. ;; NEXT-2
  9026. L1DE9:  DB    $38             ;;end-calc         .
  9027.  
  9028.         SCF                     ; set carry flag signalling looping exhausted.
  9029.         RET                     ; return
  9030.  
  9031.  
  9032. ; -------------------
  9033. ; Handle READ command
  9034. ; -------------------
  9035. ; e.g. READ a, b$, c$(1000 TO 3000)
  9036. ; A list of comma-separated variables is assigned from a list of
  9037. ; comma-separated expressions.
  9038. ; As it moves along the first list, the character address CH_ADD is stored
  9039. ; in X_PTR while CH_ADD is used to read the second list.
  9040.  
  9041. ;; READ-3
  9042. L1DEC:  RST     20H             ; NEXT-CHAR
  9043.  
  9044. ; -> Entry point.
  9045. ;; READ
  9046. L1DED:  CALL    L1C1F           ; routine CLASS-01 checks variable.
  9047.         CALL    L2530           ; routine SYNTAX-Z
  9048.         JR      Z,L1E1E         ; forward to READ-2 if checking syntax
  9049.  
  9050.  
  9051.         RST     18H             ; GET-CHAR
  9052.         LD      ($5C5F),HL      ; save character position in X_PTR.
  9053.         LD      HL,($5C57)      ; load HL with Data Address DATADD, which is
  9054.                                 ; the start of the program or the address
  9055.                                 ; after the last expression that was read or
  9056.                                 ; the address of the line number of the
  9057.                                 ; last RESTORE command.
  9058.         LD      A,(HL)          ; fetch character
  9059.         CP      $2C             ; is it a comma ?
  9060.         JR      Z,L1E0A         ; forward to READ-1 if so.
  9061.  
  9062. ; else all data in this statement has been read so look for next DATA token
  9063.  
  9064.         LD      E,$E4           ; token 'DATA'
  9065.         CALL    L1D86           ; routine LOOK-PROG
  9066.         JR      NC,L1E0A        ; forward to READ-1 if DATA found
  9067.  
  9068. ; else report the error.
  9069.  
  9070. ;; REPORT-E
  9071. L1E08:  RST     08H             ; ERROR-1
  9072.         DB    $0D             ; Error Report: Out of DATA
  9073.  
  9074. ;; READ-1
  9075. L1E0A:  CALL    L0077           ; routine TEMP-PTR1 advances updating CH_ADD
  9076.                                 ; with new DATADD position.
  9077.         CALL    L1C56           ; routine VAL-FET-1 assigns value to variable
  9078.                                 ; checking type match and adjusting CH_ADD.
  9079.  
  9080.         RST     18H             ; GET-CHAR fetches adjusted character position
  9081.         LD      ($5C57),HL      ; store back in DATADD
  9082.         LD      HL,($5C5F)      ; fetch X_PTR  the original READ CH_ADD
  9083.         LD      (IY+$26),$00    ; now nullify X_PTR_hi
  9084.         CALL    L0078           ; routine TEMP-PTR2 restores READ CH_ADD
  9085.  
  9086. ;; READ-2
  9087. L1E1E:  RST     18H             ; GET-CHAR
  9088.         CP      $2C             ; is it ',' indicating more variables to read ?
  9089.         JR      Z,L1DEC         ; back to READ-3 if so
  9090.  
  9091.         CALL    L1BEE           ; routine CHECK-END
  9092.         RET                     ; return from here in runtime to STMT-RET.
  9093.  
  9094. ; -------------------
  9095. ; Handle DATA command
  9096. ; -------------------
  9097. ; In runtime this 'command' is passed by but the syntax is checked when such
  9098. ; a statement is found while parsing a line.
  9099. ; e.g. DATA 1, 2, "text", score-1, a$(location, room, object), FN r(49),
  9100. ;         wages - tax, TRUE, The meaning of life
  9101.  
  9102. ;; DATA
  9103. L1E27:  CALL    L2530           ; routine SYNTAX-Z to check status
  9104.         JR      NZ,L1E37        ; forward to DATA-2 if in runtime
  9105.  
  9106. ;; DATA-1
  9107. L1E2C:  CALL    L24FB           ; routine SCANNING to check syntax of
  9108.                                 ; expression
  9109.         CP      $2C             ; is it a comma ?
  9110.         CALL    NZ,L1BEE        ; routine CHECK-END checks that statement
  9111.                                 ; is complete. Will make an early exit if
  9112.                                 ; so. >>>
  9113.         RST     20H             ; NEXT-CHAR
  9114.         JR      L1E2C           ; back to DATA-1
  9115.  
  9116. ; ---
  9117.  
  9118. ;; DATA-2
  9119. L1E37:  LD      A,$E4           ; set token to 'DATA' and continue into
  9120.                                 ; the the PASS-BY routine.
  9121.  
  9122.  
  9123. ; ----------------------------------
  9124. ; Check statement for DATA or DEF FN
  9125. ; ----------------------------------
  9126. ; This routine is used to backtrack to a command token and then
  9127. ; forward to the next statement in runtime.
  9128.  
  9129. ;; PASS-BY
  9130. L1E39:  LD      B,A             ; Give BC enough space to find token.
  9131.         CPDR                    ; Compare decrement and repeat. (Only use).
  9132.                                 ; Work backwards till keyword is found which
  9133.                                 ; is start of statement before any quotes.
  9134.                                 ; HL points to location before keyword.
  9135.         LD      DE,$0200        ; count 1+1 statements, dummy value in E to
  9136.                                 ; inhibit searching for a token.
  9137.         JP      L198B           ; to EACH-STMT to find next statement
  9138.  
  9139. ; -----------------------------------------------------------------------
  9140. ; A General Note on Invalid Line Numbers.
  9141. ; =======================================
  9142. ; One of the revolutionary concepts of Sinclair BASIC was that it supported
  9143. ; virtual line numbers. That is the destination of a GO TO, RESTORE etc. need
  9144. ; not exist. It could be a point before or after an actual line number.
  9145. ; Zero suffices for a before but the after should logically be infinity.
  9146. ; Since the maximum actual line limit is 9999 then the system limit, 16383
  9147. ; when variables kick in, would serve fine as a virtual end point.
  9148. ; However, ironically, only the LOAD command gets it right. It will not
  9149. ; autostart a program that has been saved with a line higher than 16383.
  9150. ; All the other commands deal with the limit unsatisfactorily.
  9151. ; LIST, RUN, GO TO, GO SUB and RESTORE have problems and the latter may
  9152. ; crash the machine when supplied with an inappropriate virtual line number.
  9153. ; This is puzzling as very careful consideration must have been given to
  9154. ; this point when the new variable types were allocated their masks and also
  9155. ; when the routine NEXT-ONE was successfully re-written to reflect this.
  9156. ; An enigma.
  9157. ; -------------------------------------------------------------------------
  9158.  
  9159. ; ----------------------
  9160. ; Handle RESTORE command
  9161. ; ----------------------
  9162. ; The restore command sets the system variable for the data address to
  9163. ; point to the location before the supplied line number or first line
  9164. ; thereafter.
  9165. ; This alters the position where subsequent READ commands look for data.
  9166. ; Note. If supplied with inappropriate high numbers the system may crash
  9167. ; in the LINE-ADDR routine as it will pass the program/variables end-marker
  9168. ; and then lose control of what it is looking for - variable or line number.
  9169. ; - observation, Steven Vickers, 1984, Pitman.
  9170.  
  9171. ;; RESTORE
  9172. L1E42:  CALL    L1E99           ; routine FIND-INT2 puts integer in BC.
  9173.                                 ; Note. B should be checked against limit $3F
  9174.                                 ; and an error generated if higher.
  9175.  
  9176. ; this entry point is used from RUN command with BC holding zero
  9177.  
  9178. ;; REST-RUN
  9179. L1E45:  LD      H,B             ; transfer the line
  9180.         LD      L,C             ; number to the HL register.
  9181.         CALL    L196E           ; routine LINE-ADDR to fetch the address.
  9182.         DEC     HL              ; point to the location before the line.
  9183.         LD      ($5C57),HL      ; update system variable DATADD.
  9184.         RET                     ; return to STMT-RET (or RUN)
  9185.  
  9186. ; ------------------------
  9187. ; Handle RANDOMIZE command
  9188. ; ------------------------
  9189. ; This command sets the SEED for the RND function to a fixed value.
  9190. ; With the parameter zero, a random start point is used depending on
  9191. ; how long the computer has been switched on.
  9192.  
  9193. ;; RANDOMIZE
  9194. L1E4F:  CALL    L1E99           ; routine FIND-INT2 puts parameter in BC.
  9195.         LD      A,B             ; test this
  9196.         OR      C               ; for zero.
  9197.         JR      NZ,L1E5A        ; forward to RAND-1 if not zero.
  9198.  
  9199.         LD      BC,($5C78)      ; use the lower two bytes at FRAMES1.
  9200.  
  9201. ;; RAND-1
  9202. L1E5A:  LD      ($5C76),BC      ; place in SEED system variable.
  9203.         RET                     ; return to STMT-RET
  9204.  
  9205. ; -----------------------
  9206. ; Handle CONTINUE command
  9207. ; -----------------------
  9208. ; The CONTINUE command transfers the OLD (but incremented) values of
  9209. ; line number and statement to the equivalent "NEW VALUE" system variables
  9210. ; by using the last part of GO TO and exits indirectly to STMT-RET.
  9211.  
  9212. ;; CONTINUE
  9213. L1E5F:  LD      HL,($5C6E)      ; fetch OLDPPC line number.
  9214.         LD      D,(IY+$36)      ; fetch OSPPC statement.
  9215.         JR      L1E73           ; forward to GO-TO-2
  9216.  
  9217. ; --------------------
  9218. ; Handle GO TO command
  9219. ; --------------------
  9220. ; The GO TO command routine is also called by GO SUB and RUN routines
  9221. ; to evaluate the parameters of both commands.
  9222. ; It updates the system variables used to fetch the next line/statement.
  9223. ; It is at STMT-RET that the actual change in control takes place.
  9224. ; Unlike some BASICs the line number need not exist.
  9225. ; Note. the high byte of the line number is incorrectly compared with $F0
  9226. ; instead of $3F. This leads to commands with operands greater than 32767
  9227. ; being considered as having been run from the editing area and the
  9228. ; error report 'Statement Lost' is given instead of 'OK'.
  9229. ; - Steven Vickers, 1984.
  9230.  
  9231. ;; GO-TO
  9232. L1E67:  CALL    L1E99           ; routine FIND-INT2 puts operand in BC
  9233.         LD      H,B             ; transfer line
  9234.         LD      L,C             ; number to HL.
  9235.         LD      D,$00           ; set statement to 0 - first.
  9236.         LD      A,H             ; compare high byte only
  9237.         CP      $F0             ; to $F0 i.e. 61439 in full.
  9238.         JR      NC,L1E9F        ; forward to REPORT-B if above.
  9239.  
  9240. ; This call entry point is used to update the system variables e.g. by RETURN.
  9241.  
  9242. ;; GO-TO-2
  9243. L1E73:  LD      ($5C42),HL      ; save line number in NEWPPC
  9244.         LD      (IY+$0A),D      ; and statement in NSPPC
  9245.         RET                     ; to STMT-RET (or GO-SUB command)
  9246.  
  9247. ; ------------------
  9248. ; Handle OUT command
  9249. ; ------------------
  9250. ; Syntax has been checked and the two comma-separated values are on the
  9251. ; calculator stack.
  9252.  
  9253. ;; OUT
  9254. L1E7A:  CALL    L1E85           ; routine TWO-PARAM fetches values
  9255.                                 ; to BC and A.
  9256.         OUT     (C),A           ; perform the operation.
  9257.         RET                     ; return to STMT-RET.
  9258.  
  9259. ; -------------------
  9260. ; Handle POKE command
  9261. ; -------------------
  9262. ; This routine alters a single byte in the 64K address space.
  9263. ; Happily no check is made as to whether ROM or RAM is addressed.
  9264. ; Sinclair BASIC requires no poking of system variables.
  9265.  
  9266. ;; POKE
  9267. L1E80:  CALL    L1E85           ; routine TWO-PARAM fetches values
  9268.                                 ; to BC and A.
  9269.         LD      (BC),A          ; load memory location with A.
  9270.         RET                     ; return to STMT-RET.
  9271.  
  9272. ; ------------------------------------
  9273. ; Fetch two  parameters from calculator stack
  9274. ; ------------------------------------
  9275. ; This routine fetches a byte and word from the calculator stack
  9276. ; producing an error if either is out of range.
  9277.  
  9278. ;; TWO-PARAM
  9279. L1E85:  CALL    L2DD5           ; routine FP-TO-A
  9280.         JR      C,L1E9F         ; forward to REPORT-B if overflow occurred
  9281.  
  9282.         JR      Z,L1E8E         ; forward to TWO-P-1 if positive
  9283.  
  9284.         NEG                     ; negative numbers are made positive
  9285.  
  9286. ;; TWO-P-1
  9287. L1E8E:  PUSH    AF              ; save the value
  9288.         CALL    L1E99           ; routine FIND-INT2 gets integer to BC
  9289.         POP     AF              ; restore the value
  9290.         RET                     ; return
  9291.  
  9292. ; -------------
  9293. ; Find integers
  9294. ; -------------
  9295. ; The first of these routines fetches a 8-bit integer (range 0-255) from the
  9296. ; calculator stack to the accumulator and is used for colours, streams,
  9297. ; durations and coordinates.
  9298. ; The second routine fetches 16-bit integers to the BC register pair
  9299. ; and is used to fetch command and function arguments involving line numbers
  9300. ; or memory addresses and also array subscripts and tab arguments.
  9301. ; ->
  9302.  
  9303. ;; FIND-INT1
  9304. L1E94:  CALL    L2DD5           ; routine FP-TO-A
  9305.         JR      L1E9C           ; forward to FIND-I-1 for common exit routine.
  9306.  
  9307. ; ---
  9308.  
  9309. ; ->
  9310.  
  9311. ;; FIND-INT2
  9312. L1E99:  CALL    L2DA2           ; routine FP-TO-BC
  9313.  
  9314. ;; FIND-I-1
  9315. L1E9C:  JR      C,L1E9F         ; to REPORT-Bb with overflow.
  9316.  
  9317.         RET     Z               ; return if positive.
  9318.  
  9319.  
  9320. ;; REPORT-Bb
  9321. L1E9F:  RST     08H             ; ERROR-1
  9322.         DB    $0A             ; Error Report: Integer out of range
  9323.  
  9324. ; ------------------
  9325. ; Handle RUN command
  9326. ; ------------------
  9327. ; This command runs a program starting at an optional line.
  9328. ; It performs a 'RESTORE 0' then CLEAR
  9329.  
  9330. ;; RUN
  9331. L1EA1:  CALL    L1E67           ; routine GO-TO puts line number in
  9332.                                 ; system variables.
  9333.         LD      BC,$0000        ; prepare to set DATADD to first line.
  9334.         CALL    L1E45           ; routine REST-RUN does the 'restore'.
  9335.                                 ; Note BC still holds zero.
  9336.         JR      L1EAF           ; forward to CLEAR-RUN to clear variables
  9337.                                 ; without disturbing RAMTOP and
  9338.                                 ; exit indirectly to STMT-RET
  9339.  
  9340. ; --------------------
  9341. ; Handle CLEAR command
  9342. ; --------------------
  9343. ; This command reclaims the space used by the variables.
  9344. ; It also clears the screen and the GO SUB stack.
  9345. ; With an integer expression, it sets the uppermost memory
  9346. ; address within the BASIC system.
  9347. ; "Contrary to the manual, CLEAR doesn't execute a RESTORE" -
  9348. ; Steven Vickers, Pitman Pocket Guide to the Spectrum, 1984.
  9349.  
  9350. ;; CLEAR
  9351. L1EAC:  CALL    L1E99           ; routine FIND-INT2 fetches to BC.
  9352.  
  9353. ;; CLEAR-RUN
  9354. L1EAF:  LD      A,B             ; test for
  9355.         OR      C               ; zero.
  9356.         JR      NZ,L1EB7        ; skip to CLEAR-1 if not zero.
  9357.  
  9358.         LD      BC,($5CB2)      ; use the existing value of RAMTOP if zero.
  9359.  
  9360. ;; CLEAR-1
  9361. L1EB7:  PUSH    BC              ; save ramtop value.
  9362.  
  9363.         LD      DE,($5C4B)      ; fetch VARS
  9364.         LD      HL,($5C59)      ; fetch E_LINE
  9365.         DEC     HL              ; adjust to point at variables end-marker.
  9366.         CALL    L19E5           ; routine RECLAIM-1 reclaims the space used by
  9367.                                 ; the variables.
  9368.         CALL    L0D6B           ; routine CLS to clear screen.
  9369.         LD      HL,($5C65)      ; fetch STKEND the start of free memory.
  9370.         LD      DE,$0032        ; allow for another 50 bytes.
  9371.         ADD     HL,DE           ; add the overhead to HL.
  9372.  
  9373.         POP     DE              ; restore the ramtop value.
  9374.         SBC     HL,DE           ; if HL is greater than the value then jump
  9375.         JR      NC,L1EDA        ; forward to REPORT-M
  9376.                                 ; 'RAMTOP no good'
  9377.  
  9378.         LD      HL,($5CB4)      ; now P-RAMT ($7FFF on 16K RAM machine)
  9379.         AND     A               ; exact this time.
  9380.         SBC     HL,DE           ; new ramtop must be lower or the same.
  9381.         JR      NC,L1EDC        ; skip to CLEAR-2 if in actual RAM.
  9382.  
  9383. ;; REPORT-M
  9384. L1EDA:  RST     08H             ; ERROR-1
  9385.         DB    $15             ; Error Report: RAMTOP no good
  9386.  
  9387. ;; CLEAR-2
  9388. L1EDC:  EX      DE,HL           ; transfer ramtop value to HL.
  9389.         LD      ($5CB2),HL      ; update system variable RAMTOP.
  9390.         POP     DE              ; pop the return address STMT-RET.
  9391.         POP     BC              ; pop the Error Address.
  9392.         LD      (HL),$3E        ; now put the GO SUB end-marker at RAMTOP.
  9393.         DEC     HL              ; leave a location beneath it.
  9394.         LD      SP,HL           ; initialize the machine stack pointer.
  9395.         PUSH    BC              ; push the error address.
  9396.         LD      ($5C3D),SP      ; make ERR_SP point to location.
  9397.         EX      DE,HL           ; put STMT-RET in HL.
  9398.         JP      (HL)            ; and go there directly.
  9399.  
  9400. ; ---------------------
  9401. ; Handle GO SUB command
  9402. ; ---------------------
  9403. ; The GO SUB command diverts BASIC control to a new line number
  9404. ; in a very similar manner to GO TO but
  9405. ; the current line number and current statement + 1
  9406. ; are placed on the GO SUB stack as a RETURN point.
  9407.  
  9408. ;; GO-SUB
  9409. L1EED:  POP     DE              ; drop the address STMT-RET
  9410.         LD      H,(IY+$0D)      ; fetch statement from SUBPPC and
  9411.         INC     H               ; increment it
  9412.         EX      (SP),HL         ; swap - error address to HL,
  9413.                                 ; H (statement) at top of stack,
  9414.                                 ; L (unimportant) beneath.
  9415.         INC     SP              ; adjust to overwrite unimportant byte
  9416.         LD      BC,($5C45)      ; fetch the current line number from PPC
  9417.         PUSH    BC              ; and PUSH onto GO SUB stack.
  9418.                                 ; the empty machine-stack can be rebuilt
  9419.         PUSH    HL              ; push the error address.
  9420.         LD      ($5C3D),SP      ; make system variable ERR_SP point to it.
  9421.         PUSH    DE              ; push the address STMT-RET.
  9422.         CALL    L1E67           ; call routine GO-TO to update the system
  9423.                                 ; variables NEWPPC and NSPPC.
  9424.                                 ; then make an indirect exit to STMT-RET via
  9425.         LD      BC,$0014        ; a 20-byte overhead memory check.
  9426.  
  9427. ; ----------------------
  9428. ; Check available memory
  9429. ; ----------------------
  9430. ; This routine is used on many occasions when extending a dynamic area
  9431. ; upwards or the GO SUB stack downwards.
  9432.  
  9433. ;; TEST-ROOM
  9434. L1F05:  LD      HL,($5C65)      ; fetch STKEND
  9435.         ADD     HL,BC           ; add the supplied test value
  9436.         JR      C,L1F15         ; forward to REPORT-4 if over $FFFF
  9437.  
  9438.         EX      DE,HL           ; was less so transfer to DE
  9439.         LD      HL,$0050        ; test against another 80 bytes
  9440.         ADD     HL,DE           ; anyway
  9441.         JR      C,L1F15         ; forward to REPORT-4 if this passes $FFFF
  9442.  
  9443.         SBC     HL,SP           ; if less than the machine stack pointer
  9444.         RET     C               ; then return - OK.
  9445.  
  9446. ;; REPORT-4
  9447. L1F15:  LD      L,$03           ; prepare 'Out of Memory'
  9448.         JP      L0055           ; jump back to ERROR-3 at $0055
  9449.                                 ; Note. this error can't be trapped at $0008
  9450.  
  9451. ; ------------------------------
  9452. ; THE 'FREE MEMORY' USER ROUTINE
  9453. ; ------------------------------
  9454. ; This routine is not used by the ROM but allows users to evaluate
  9455. ; approximate free memory with PRINT 65536 - USR 7962.
  9456.  
  9457. ;; free-mem
  9458. L1F1A:  LD      BC,$0000        ; allow no overhead.
  9459.  
  9460.         CALL    L1F05           ; routine TEST-ROOM.
  9461.  
  9462.         LD      B,H             ; transfer the result
  9463.         LD      C,L             ; to the BC register.
  9464.         RET                     ; the USR function returns value of BC.
  9465.  
  9466. ; --------------------
  9467. ; THE 'RETURN' COMMAND
  9468. ; --------------------
  9469. ; As with any command, there are two values on the machine stack at the time
  9470. ; it is invoked.  The machine stack is below the GOSUB stack.  Both grow
  9471. ; downwards, the machine stack by two bytes, the GOSUB stack by 3 bytes.
  9472. ; The highest location is a statement byte followed by a two-byte line number.
  9473.  
  9474. ;; RETURN
  9475. L1F23:  POP     BC              ; drop the address STMT-RET.
  9476.         POP     HL              ; now the error address.
  9477.         POP     DE              ; now a possible BASIC return line.
  9478.         LD      A,D             ; the high byte $00 - $27 is
  9479.         CP      $3E             ; compared with the traditional end-marker $3E.
  9480.         JR      Z,L1F36         ; forward to REPORT-7 with a match.
  9481.                                 ; 'RETURN without GOSUB'
  9482.  
  9483. ; It was not the end-marker so a single statement byte remains at the base of
  9484. ; the calculator stack. It can't be popped off.
  9485.  
  9486.         DEC     SP              ; adjust stack pointer to create room for two
  9487.                                 ; bytes.
  9488.         EX      (SP),HL         ; statement to H, error address to base of
  9489.                                 ; new machine stack.
  9490.         EX      DE,HL           ; statement to D,  BASIC line number to HL.
  9491.         LD      ($5C3D),SP      ; adjust ERR_SP to point to new stack pointer
  9492.         PUSH    BC              ; now re-stack the address STMT-RET
  9493.         JP      L1E73           ; to GO-TO-2 to update statement and line
  9494.                                 ; system variables and exit indirectly to the
  9495.                                 ; address just pushed on stack.
  9496.  
  9497. ; ---
  9498.  
  9499. ;; REPORT-7
  9500. L1F36:  PUSH    DE              ; replace the end-marker.
  9501.         PUSH    HL              ; now restore the error address
  9502.                                 ; as will be required in a few clock cycles.
  9503.  
  9504.         RST     08H             ; ERROR-1
  9505.         DB    $06             ; Error Report: RETURN without GOSUB
  9506.  
  9507. ; --------------------
  9508. ; Handle PAUSE command
  9509. ; --------------------
  9510. ; The pause command takes as its parameter the number of interrupts
  9511. ; for which to wait. PAUSE 50 pauses for about a second.
  9512. ; PAUSE 0 pauses indefinitely.
  9513. ; Both forms can be finished by pressing a key.
  9514.  
  9515. ;; PAUSE
  9516. L1F3A:  CALL    L1E99           ; routine FIND-INT2 puts value in BC
  9517.  
  9518. ;; PAUSE-1
  9519. L1F3D:  HALT                    ; wait for interrupt.
  9520.         DEC     BC              ; decrease counter.
  9521.         LD      A,B             ; test if
  9522.         OR      C               ; result is zero.
  9523.         JR      Z,L1F4F         ; forward to PAUSE-END if so.
  9524.  
  9525.         LD      A,B             ; test if
  9526.         AND     C               ; now $FFFF
  9527.         INC     A               ; that is, initially zero.
  9528.         JR      NZ,L1F49        ; skip forward to PAUSE-2 if not.
  9529.  
  9530.         INC     BC              ; restore counter to zero.
  9531.  
  9532. ;; PAUSE-2
  9533. L1F49:  BIT     5,(IY+$01)      ; test FLAGS - has a new key been pressed ?
  9534.         JR      Z,L1F3D         ; back to PAUSE-1 if not.
  9535.  
  9536. ;; PAUSE-END
  9537. L1F4F:  RES     5,(IY+$01)      ; update FLAGS - signal no new key
  9538.         RET                     ; and return.
  9539.  
  9540. ; -------------------
  9541. ; Check for BREAK key
  9542. ; -------------------
  9543. ; This routine is called from COPY-LINE, when interrupts are disabled,
  9544. ; to test if BREAK (SHIFT - SPACE) is being pressed.
  9545. ; It is also called at STMT-RET after every statement.
  9546.  
  9547. ;; BREAK-KEY
  9548. L1F54:  LD      A,$7F           ; Input address: $7FFE
  9549.         IN      A,($FE)         ; read lower right keys
  9550.         RRA                     ; rotate bit 0 - SPACE
  9551.         RET     C               ; return if not reset
  9552.  
  9553.         LD      A,$FE           ; Input address: $FEFE
  9554.         IN      A,($FE)         ; read lower left keys
  9555.         RRA                     ; rotate bit 0 - SHIFT
  9556.         RET                     ; carry will be set if not pressed.
  9557.                                 ; return with no carry if both keys
  9558.                                 ; pressed.
  9559.  
  9560. ; ---------------------
  9561. ; Handle DEF FN command
  9562. ; ---------------------
  9563. ; e.g DEF FN r$(a$,a) = a$(a TO )
  9564. ; this 'command' is ignored in runtime but has its syntax checked
  9565. ; during line-entry.
  9566.  
  9567. ;; DEF-FN
  9568. L1F60:  CALL    L2530           ; routine SYNTAX-Z
  9569.         JR      Z,L1F6A         ; forward to DEF-FN-1 if parsing
  9570.  
  9571.         LD      A,$CE           ; else load A with 'DEF FN' and
  9572.         JP      L1E39           ; jump back to PASS-BY
  9573.  
  9574. ; ---
  9575.  
  9576. ; continue here if checking syntax.
  9577.  
  9578. ;; DEF-FN-1
  9579. L1F6A:  SET      6,(IY+$01)     ; set FLAGS  - Assume numeric result
  9580.         CALL    L2C8D           ; call routine ALPHA
  9581.         JR      NC,L1F89        ; if not then to DEF-FN-4 to jump to
  9582.                                 ; 'Nonsense in BASIC'
  9583.  
  9584.  
  9585.         RST     20H             ; NEXT-CHAR
  9586.         CP      $24             ; is it '$' ?
  9587.         JR      NZ,L1F7D        ; to DEF-FN-2 if not as numeric.
  9588.  
  9589.         RES     6,(IY+$01)      ; set FLAGS  - Signal string result
  9590.  
  9591.         RST     20H             ; get NEXT-CHAR
  9592.  
  9593. ;; DEF-FN-2
  9594. L1F7D:  CP      $28             ; is it '(' ?
  9595.         JR      NZ,L1FBD        ; to DEF-FN-7 'Nonsense in BASIC'
  9596.  
  9597.  
  9598.         RST     20H             ; NEXT-CHAR
  9599.         CP      $29             ; is it ')' ?
  9600.         JR      Z,L1FA6         ; to DEF-FN-6 if null argument
  9601.  
  9602. ;; DEF-FN-3
  9603. L1F86:  CALL    L2C8D           ; routine ALPHA checks that it is the expected
  9604.                                 ; alphabetic character.
  9605.  
  9606. ;; DEF-FN-4
  9607. L1F89:  JP      NC,L1C8A        ; to REPORT-C  if not
  9608.                                 ; 'Nonsense in BASIC'.
  9609.  
  9610.         EX      DE,HL           ; save pointer in DE
  9611.  
  9612.         RST     20H             ; NEXT-CHAR re-initializes HL from CH_ADD
  9613.                                 ; and advances.
  9614.         CP      $24             ; '$' ? is it a string argument.
  9615.         JR      NZ,L1F94        ; forward to DEF-FN-5 if not.
  9616.  
  9617.         EX      DE,HL           ; save pointer to '$' in DE
  9618.  
  9619.         RST     20H             ; NEXT-CHAR re-initializes HL and advances
  9620.  
  9621. ;; DEF-FN-5
  9622. L1F94:  EX      DE,HL           ; bring back pointer.
  9623.         LD      BC,$0006        ; the function requires six hidden bytes for
  9624.                                 ; each parameter passed.
  9625.                                 ; The first byte will be $0E
  9626.                                 ; then 5-byte numeric value
  9627.                                 ; or 5-byte string pointer.
  9628.  
  9629.         CALL    L1655           ; routine MAKE-ROOM creates space in program
  9630.                                 ; area.
  9631.  
  9632.         INC     HL              ; adjust HL (set by LDDR)
  9633.         INC     HL              ; to point to first location.
  9634.         LD      (HL),$0E        ; insert the 'hidden' marker.
  9635.  
  9636. ; Note. these invisible storage locations hold nothing meaningful for the
  9637. ; moment. They will be used every time the corresponding function is
  9638. ; evaluated in runtime.
  9639. ; Now consider the following character fetched earlier.
  9640.  
  9641.         CP      $2C             ; is it ',' ? (more than one parameter)
  9642.         JR      NZ,L1FA6        ; to DEF-FN-6 if not
  9643.  
  9644.  
  9645.         RST     20H             ; else NEXT-CHAR
  9646.         JR      L1F86           ; and back to DEF-FN-3
  9647.  
  9648. ; ---
  9649.  
  9650. ;; DEF-FN-6
  9651. L1FA6:  CP      $29             ; should close with a ')'
  9652.         JR      NZ,L1FBD        ; to DEF-FN-7 if not
  9653.                                 ; 'Nonsense in BASIC'
  9654.  
  9655.  
  9656.         RST     20H             ; get NEXT-CHAR
  9657.         CP      $3D             ; is it '=' ?
  9658.         JR      NZ,L1FBD        ; to DEF-FN-7 if not 'Nonsense...'
  9659.  
  9660.  
  9661.         RST     20H             ; address NEXT-CHAR
  9662.         LD      A,($5C3B)       ; get FLAGS which has been set above
  9663.         PUSH    AF              ; and preserve
  9664.  
  9665.         CALL    L24FB           ; routine SCANNING checks syntax of expression
  9666.                                 ; and also sets flags.
  9667.  
  9668.         POP     AF              ; restore previous flags
  9669.         XOR     (IY+$01)        ; xor with FLAGS - bit 6 should be same
  9670.                                 ; therefore will be reset.
  9671.         AND     $40             ; isolate bit 6.
  9672.  
  9673. ;; DEF-FN-7
  9674. L1FBD:  JP      NZ,L1C8A        ; jump back to REPORT-C if the expected result
  9675.                                 ; is not the same type.
  9676.                                 ; 'Nonsense in BASIC'
  9677.  
  9678.         CALL    L1BEE           ; routine CHECK-END will return early if
  9679.                                 ; at end of statement and move onto next
  9680.                                 ; else produce error report. >>>
  9681.  
  9682.                                 ; There will be no return to here.
  9683.  
  9684. ; -------------------------------
  9685. ; Returning early from subroutine
  9686. ; -------------------------------
  9687. ; All routines are capable of being run in two modes - syntax checking mode
  9688. ; and runtime mode.  This routine is called often to allow a routine to return
  9689. ; early if checking syntax.
  9690.  
  9691. ;; UNSTACK-Z
  9692. L1FC3:  CALL    L2530           ; routine SYNTAX-Z sets zero flag if syntax
  9693.                                 ; is being checked.
  9694.  
  9695.         POP     HL              ; drop the return address.
  9696.         RET      Z              ; return to previous call in chain if checking
  9697.                                 ; syntax.
  9698.  
  9699.         JP      (HL)            ; jump to return address as BASIC program is
  9700.                                 ; actually running.
  9701.  
  9702. ; ---------------------
  9703. ; Handle LPRINT command
  9704. ; ---------------------
  9705. ; A simple form of 'PRINT #3' although it can output to 16 streams.
  9706. ; Probably for compatibility with other BASICs particularly ZX81 BASIC.
  9707. ; An extra UDG might have been better.
  9708.  
  9709. ;; LPRINT
  9710. L1FC9:  LD      A,$03           ; the printer channel
  9711.         JR      L1FCF           ; forward to PRINT-1
  9712.  
  9713. ; ---------------------
  9714. ; Handle PRINT commands
  9715. ; ---------------------
  9716. ; The Spectrum's main stream output command.
  9717. ; The default stream is stream 2 which is normally the upper screen
  9718. ; of the computer. However the stream can be altered in range 0 - 15.
  9719.  
  9720. ;; PRINT
  9721. L1FCD:  LD      A,$02           ; the stream for the upper screen.
  9722.  
  9723. ; The LPRINT command joins here.
  9724.  
  9725. ;; PRINT-1
  9726. L1FCF:  CALL    L2530           ; routine SYNTAX-Z checks if program running
  9727.         CALL    NZ,L1601        ; routine CHAN-OPEN if so
  9728.         CALL    L0D4D           ; routine TEMPS sets temporary colours.
  9729.         CALL    L1FDF           ; routine PRINT-2 - the actual item
  9730.         CALL    L1BEE           ; routine CHECK-END gives error if not at end
  9731.                                 ; of statement
  9732.         RET                     ; and return >>>
  9733.  
  9734. ; ------------------------------------
  9735. ; this subroutine is called from above
  9736. ; and also from INPUT.
  9737.  
  9738. ;; PRINT-2
  9739. L1FDF:  RST     18H             ; GET-CHAR gets printable character
  9740.         CALL    L2045           ; routine PR-END-Z checks if more printing
  9741.         JR      Z,L1FF2         ; to PRINT-4 if not     e.g. just 'PRINT :'
  9742.  
  9743. ; This tight loop deals with combinations of positional controls and
  9744. ; print items. An early return can be made from within the loop
  9745. ; if the end of a print sequence is reached.
  9746.  
  9747. ;; PRINT-3
  9748. L1FE5:  CALL    L204E           ; routine PR-POSN-1 returns zero if more
  9749.                                 ; but returns early at this point if
  9750.                                 ; at end of statement!
  9751.                                 ;
  9752.         JR      Z,L1FE5         ; to PRINT-3 if consecutive positioners
  9753.  
  9754.         CALL    L1FFC           ; routine PR-ITEM-1 deals with strings etc.
  9755.         CALL    L204E           ; routine PR-POSN-1 for more position codes
  9756.         JR      Z,L1FE5         ; loop back to PRINT-3 if so
  9757.  
  9758. ;; PRINT-4
  9759. L1FF2:  CP      $29             ; return now if this is ')' from input-item.
  9760.                                 ; (see INPUT.)
  9761.         RET     Z               ; or continue and print carriage return in
  9762.                                 ; runtime
  9763.  
  9764. ; ---------------------
  9765. ; Print carriage return
  9766. ; ---------------------
  9767. ; This routine which continues from above prints a carriage return
  9768. ; in run-time. It is also called once from PRINT-POSN.
  9769.  
  9770. ;; PRINT-CR
  9771. L1FF5:  CALL    L1FC3           ; routine UNSTACK-Z
  9772.  
  9773.         LD      A,$0D           ; prepare a carriage return
  9774.  
  9775.         RST     10H             ; PRINT-A
  9776.         RET                     ; return
  9777.  
  9778.  
  9779. ; -----------
  9780. ; Print items
  9781. ; -----------
  9782. ; This routine deals with print items as in
  9783. ; PRINT AT 10,0;"The value of A is ";a
  9784. ; It returns once a single item has been dealt with as it is part
  9785. ; of a tight loop that considers sequences of positional and print items
  9786.  
  9787. ;; PR-ITEM-1
  9788. L1FFC:  RST     18H             ; GET-CHAR
  9789.         CP      $AC             ; is character 'AT' ?
  9790.         JR      NZ,L200E        ; forward to PR-ITEM-2 if not.
  9791.  
  9792.         CALL    L1C79           ; routine NEXT-2NUM  check for two comma
  9793.                                 ; separated numbers placing them on the
  9794.                                 ; calculator stack in runtime.
  9795.         CALL    L1FC3           ; routine UNSTACK-Z quits if checking syntax.
  9796.  
  9797.         CALL    L2307           ; routine STK-TO-BC get the numbers in B and C.
  9798.         LD      A,$16           ; prepare the 'at' control.
  9799.         JR      L201E           ; forward to PR-AT-TAB to print the sequence.
  9800.  
  9801. ; ---
  9802.  
  9803. ;; PR-ITEM-2
  9804. L200E:  CP      $AD             ; is character 'TAB' ?
  9805.         JR      NZ,L2024        ; to PR-ITEM-3 if not
  9806.  
  9807.  
  9808.         RST     20H             ; NEXT-CHAR to address next character
  9809.         CALL    L1C82           ; routine EXPT-1NUM
  9810.         CALL    L1FC3           ; routine UNSTACK-Z quits if checking syntax.
  9811.  
  9812.         CALL    L1E99           ; routine FIND-INT2 puts integer in BC.
  9813.         LD      A,$17           ; prepare the 'tab' control.
  9814.  
  9815. ;; PR-AT-TAB
  9816. L201E:  RST     10H             ; PRINT-A outputs the control
  9817.  
  9818.         LD      A,C             ; first value to A
  9819.         RST     10H             ; PRINT-A outputs it.
  9820.  
  9821.         LD      A,B             ; second value
  9822.         RST     10H             ; PRINT-A
  9823.  
  9824.         RET                     ; return - item finished >>>
  9825.  
  9826. ; ---
  9827.  
  9828. ; Now consider paper 2; #2; a$
  9829.  
  9830. ;; PR-ITEM-3
  9831. L2024:  CALL    L21F2           ; routine CO-TEMP-3 will print any colour
  9832.         RET     NC              ; items - return if success.
  9833.  
  9834.         CALL    L2070           ; routine STR-ALTER considers new stream
  9835.         RET     NC              ; return if altered.
  9836.  
  9837.         CALL    L24FB           ; routine SCANNING now to evaluate expression
  9838.         CALL    L1FC3           ; routine UNSTACK-Z if not runtime.
  9839.  
  9840.         BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
  9841.         CALL    Z,L2BF1         ; routine STK-FETCH if string.
  9842.                                 ; note no flags affected.
  9843.         JP      NZ,L2DE3        ; to PRINT-FP to print if numeric >>>
  9844.  
  9845. ; It was a string expression - start in DE, length in BC
  9846. ; Now enter a loop to print it
  9847.  
  9848. ;; PR-STRING
  9849. L203C:  LD      A,B             ; this tests if the
  9850.         OR      C               ; length is zero and sets flag accordingly.
  9851.         DEC     BC              ; this doesn't but decrements counter.
  9852.         RET     Z               ; return if zero.
  9853.  
  9854.         LD      A,(DE)          ; fetch character.
  9855.         INC     DE              ; address next location.
  9856.  
  9857.         RST     10H             ; PRINT-A.
  9858.  
  9859.         JR      L203C           ; loop back to PR-STRING.
  9860.  
  9861. ; ---------------
  9862. ; End of printing
  9863. ; ---------------
  9864. ; This subroutine returns zero if no further printing is required
  9865. ; in the current statement.
  9866. ; The first terminator is found in  escaped input items only,
  9867. ; the others in print_items.
  9868.  
  9869. ;; PR-END-Z
  9870. L2045:  CP      $29             ; is character a ')' ?
  9871.         RET     Z               ; return if so -        e.g. INPUT (p$); a$
  9872.  
  9873. ;; PR-ST-END
  9874. L2048:  CP      $0D             ; is it a carriage return ?
  9875.         RET     Z               ; return also -         e.g. PRINT a
  9876.  
  9877.         CP      $3A             ; is character a ':' ?
  9878.         RET                     ; return - zero flag will be set if so.
  9879.                                 ;                       e.g. PRINT a :
  9880.  
  9881. ; --------------
  9882. ; Print position
  9883. ; --------------
  9884. ; This routine considers a single positional character ';', ',', '''
  9885.  
  9886. ;; PR-POSN-1
  9887. L204E:  RST     18H             ; GET-CHAR
  9888.         CP      $3B             ; is it ';' ?            
  9889.                                 ; i.e. print from last position.
  9890.         JR      Z,L2067         ; forward to PR-POSN-3 if so.
  9891.                                 ; i.e. do nothing.
  9892.  
  9893.         CP      $2C             ; is it ',' ?
  9894.                                 ; i.e. print at next tabstop.
  9895.         JR      NZ,L2061        ; forward to PR-POSN-2 if anything else.
  9896.  
  9897.         CALL    L2530           ; routine SYNTAX-Z
  9898.         JR      Z,L2067         ; forward to PR-POSN-3 if checking syntax.
  9899.  
  9900.         LD      A,$06           ; prepare the 'comma' control character.
  9901.  
  9902.         RST     10H             ; PRINT-A  outputs to current channel in
  9903.                                 ; run-time.
  9904.  
  9905.         JR      L2067           ; skip to PR-POSN-3.
  9906.  
  9907. ; ---
  9908.  
  9909. ; check for newline.
  9910.  
  9911. ;; PR-POSN-2
  9912. L2061:  CP      $27             ; is character a "'" ? (newline)
  9913.         RET     NZ              ; return if no match              >>>
  9914.  
  9915.         CALL    L1FF5           ; routine PRINT-CR outputs a carriage return
  9916.                                 ; in runtime only.
  9917.  
  9918. ;; PR-POSN-3
  9919. L2067:  RST     20H             ; NEXT-CHAR to A.
  9920.         CALL    L2045           ; routine PR-END-Z checks if at end.
  9921.         JR      NZ,L206E        ; to PR-POSN-4 if not.
  9922.  
  9923.         POP     BC              ; drop return address if at end.
  9924.  
  9925. ;; PR-POSN-4
  9926. L206E:  CP      A               ; reset the zero flag.
  9927.         RET                     ; and return to loop or quit.
  9928.  
  9929. ; ------------
  9930. ; Alter stream
  9931. ; ------------
  9932. ; This routine is called from PRINT ITEMS above, and also LIST as in
  9933. ; LIST #15
  9934.  
  9935. ;; STR-ALTER
  9936. L2070:  CP      $23             ; is character '#' ?
  9937.         SCF                     ; set carry flag.
  9938.         RET     NZ              ; return if no match.
  9939.  
  9940.  
  9941.         RST      20H            ; NEXT-CHAR
  9942.         CALL    L1C82           ; routine EXPT-1NUM gets stream number
  9943.         AND     A               ; prepare to exit early with carry reset
  9944.         CALL    L1FC3           ; routine UNSTACK-Z exits early if parsing
  9945.         CALL    L1E94           ; routine FIND-INT1 gets number off stack
  9946.         CP      $10             ; must be range 0 - 15 decimal.
  9947.         JP      NC,L160E        ; jump back to REPORT-Oa if not
  9948.                                 ; 'Invalid stream'.
  9949.  
  9950.         CALL    L1601           ; routine CHAN-OPEN
  9951.         AND     A               ; clear carry - signal item dealt with.
  9952.         RET                     ; return
  9953.  
  9954. ; --------------------
  9955. ; Handle INPUT command
  9956. ; --------------------
  9957. ; This command
  9958. ;
  9959.  
  9960. ;; INPUT
  9961. L2089:  CALL    L2530           ; routine SYNTAX-Z to check if in runtime.
  9962.         JR      Z,L2096         ; forward to INPUT-1 if checking syntax.
  9963.  
  9964.         LD      A,$01           ; select channel 'K' the keyboard for input.
  9965.         CALL    L1601           ; routine CHAN-OPEN opens it.
  9966.         CALL    L0D6E           ; routine CLS-LOWER clears the lower screen
  9967.                                 ; and sets DF_SZ to two.
  9968.  
  9969. ;; INPUT-1
  9970. L2096:  LD      (IY+$02),$01    ; update TV_FLAG - signal lower screen in use
  9971.                                 ; ensuring that the correct set of system
  9972.                                 ; variables are updated and that the border
  9973.                                 ; colour is used.
  9974.  
  9975.         CALL    L20C1           ; routine IN-ITEM-1 to handle the input.
  9976.  
  9977.         CALL    L1BEE           ; routine CHECK-END will make an early exit
  9978.                                 ; if checking syntax. >>>
  9979.  
  9980. ; keyboard input has been made and it remains to adjust the upper
  9981. ; screen in case the lower two lines have been extended upwards.
  9982.  
  9983.         LD      BC,($5C88)      ; fetch S_POSN current line/column of
  9984.                                 ; the upper screen.
  9985.         LD      A,($5C6B)       ; fetch DF_SZ the display file size of
  9986.                                 ; the lower screen.
  9987.         CP      B               ; test that lower screen does not overlap
  9988.         JR      C,L20AD         ; forward to INPUT-2 if not.
  9989.  
  9990. ; the two screens overlap so adjust upper screen.
  9991.  
  9992.         LD      C,$21           ; set column of upper screen to leftmost.
  9993.         LD      B,A             ; and line to one above lower screen.
  9994.                                 ; continue forward to update upper screen
  9995.                                 ; print position.
  9996.  
  9997. ;; INPUT-2
  9998. L20AD:  LD      ($5C88),BC      ; set S_POSN update upper screen line/column.
  9999.         LD      A,$19           ; subtract from twenty five
  10000.         SUB     B               ; the new line number.
  10001.         LD      ($5C8C),A       ; and place result in SCR_CT - scroll count.
  10002.         RES     0,(IY+$02)      ; update TV_FLAG - signal main screen in use.
  10003.         CALL    L0DD9           ; routine CL-SET sets the print position
  10004.                                 ; system variables for the upper screen.
  10005.         JP      L0D6E           ; jump back to CLS-LOWER and make
  10006.                                 ; an indirect exit >>.
  10007.  
  10008. ; ---------------------
  10009. ; INPUT ITEM subroutine
  10010. ; ---------------------
  10011. ; This subroutine deals with the input items and print items.
  10012. ; from  the current input channel.
  10013. ; It is only called from the above INPUT routine but was obviously
  10014. ; once called from somewhere else in another context.
  10015.  
  10016. ;; IN-ITEM-1
  10017. L20C1:  CALL    L204E           ; routine PR-POSN-1 deals with a single
  10018.                                 ; position item at each call.
  10019.         JR      Z,L20C1         ; back to IN-ITEM-1 until no more in a
  10020.                                 ; sequence.
  10021.  
  10022.         CP      $28             ; is character '(' ?
  10023.         JR      NZ,L20D8        ; forward to IN-ITEM-2 if not.
  10024.  
  10025. ; any variables within braces will be treated as part, or all, of the prompt
  10026. ; instead of being used as destination variables.
  10027.  
  10028.         RST     20H             ; NEXT-CHAR
  10029.         CALL    L1FDF           ; routine PRINT-2 to output the dynamic
  10030.                                 ; prompt.
  10031.  
  10032.         RST     18H             ; GET-CHAR
  10033.         CP      $29             ; is character a matching ')' ?
  10034.         JP      NZ,L1C8A        ; jump back to REPORT-C if not.
  10035.                                 ; 'Nonsense in BASIC'.
  10036.  
  10037.         RST     20H             ; NEXT-CHAR
  10038.         JP      L21B2           ; forward to IN-NEXT-2
  10039.  
  10040. ; ---
  10041.  
  10042. ;; IN-ITEM-2
  10043. L20D8:  CP      $CA             ; is the character the token 'LINE' ?
  10044.         JR      NZ,L20ED        ; forward to IN-ITEM-3 if not.
  10045.  
  10046.         RST     20H             ; NEXT-CHAR - variable must come next.
  10047.         CALL    L1C1F           ; routine CLASS-01 returns destination
  10048.                                 ; address of variable to be assigned.
  10049.                                 ; or generates an error if no variable
  10050.                                 ; at this position.
  10051.  
  10052.         SET     7,(IY+$37)      ; update FLAGX  - signal handling INPUT LINE
  10053.         BIT     6,(IY+$01)      ; test FLAGS  - numeric or string result ?
  10054.         JP      NZ,L1C8A        ; jump back to REPORT-C if not string
  10055.                                 ; 'Nonsense in BASIC'.
  10056.  
  10057.         JR      L20FA           ; forward to IN-PROMPT to set up workspace.
  10058.  
  10059. ; ---
  10060.  
  10061. ; the jump was here for other variables.
  10062.  
  10063. ;; IN-ITEM-3
  10064. L20ED:  CALL     L2C8D          ; routine ALPHA checks if character is
  10065.                                 ; a suitable variable name.
  10066.         JP      NC,L21AF        ; forward to IN-NEXT-1 if not
  10067.  
  10068.         CALL    L1C1F           ; routine CLASS-01 returns destination
  10069.                                 ; address of variable to be assigned.
  10070.         RES     7,(IY+$37)      ; update FLAGX  - signal not INPUT LINE.
  10071.  
  10072. ;; IN-PROMPT
  10073. L20FA:  CALL    L2530           ; routine SYNTAX-Z
  10074.         JP      Z,L21B2         ; forward to IN-NEXT-2 if checking syntax.
  10075.  
  10076.         CALL    L16BF           ; routine SET-WORK clears workspace.
  10077.         LD      HL,$5C71        ; point to system variable FLAGX
  10078.         RES     6,(HL)          ; signal string result.
  10079.         SET     5,(HL)          ; signal in Input Mode for editor.
  10080.         LD      BC,$0001        ; initialize space required to one for
  10081.                                 ; the carriage return.
  10082.         BIT     7,(HL)          ; test FLAGX - INPUT LINE in use ?
  10083.         JR      NZ,L211C        ; forward to IN-PR-2 if so as that is
  10084.                                 ; all the space that is required.
  10085.  
  10086.         LD      A,($5C3B)       ; load accumulator from FLAGS
  10087.         AND     $40             ; mask to test BIT 6 of FLAGS and clear
  10088.                                 ; the other bits in A.
  10089.                                 ; numeric result expected ?
  10090.         JR      NZ,L211A        ; forward to IN-PR-1 if so
  10091.  
  10092.         LD      C,$03           ; increase space to three bytes for the
  10093.                                 ; pair of surrounding quotes.
  10094.  
  10095. ;; IN-PR-1
  10096. L211A:  OR      (HL)            ; if numeric result, set bit 6 of FLAGX.
  10097.         LD      (HL),A          ; and update system variable
  10098.  
  10099. ;; IN-PR-2
  10100. L211C:  RST     30H             ; BC-SPACES opens 1 or 3 bytes in workspace
  10101.         LD      (HL),$0D        ; insert carriage return at last new location.
  10102.         LD      A,C             ; fetch the length, one or three.
  10103.         RRCA                    ; lose bit 0.
  10104.         RRCA                    ; test if quotes required.
  10105.         JR      NC,L2129        ; forward to IN-PR-3 if not.
  10106.  
  10107.         LD      A,$22           ; load the '"' character
  10108.         LD      (DE),A          ; place quote in first new location at DE.
  10109.         DEC     HL              ; decrease HL - from carriage return.
  10110.         LD      (HL),A          ; and place a quote in second location.
  10111.  
  10112. ;; IN-PR-3
  10113. L2129:  LD      ($5C5B),HL      ; set keyboard cursor K_CUR to HL
  10114.         BIT     7,(IY+$37)      ; test FLAGX  - is this INPUT LINE ??
  10115.         JR      NZ,L215E        ; forward to IN-VAR-3 if so as input will
  10116.                                 ; be accepted without checking its syntax.
  10117.  
  10118.         LD      HL,($5C5D)      ; fetch CH_ADD
  10119.         PUSH    HL              ; and save on stack.
  10120.         LD      HL,($5C3D)      ; fetch ERR_SP
  10121.         PUSH    HL              ; and save on stack
  10122.  
  10123. ;; IN-VAR-1
  10124. L213A:  LD      HL,L213A        ; address: IN-VAR-1 - this address
  10125.         PUSH    HL              ; is saved on stack to handle errors.
  10126.         BIT     4,(IY+$30)      ; test FLAGS2  - is K channel in use ?
  10127.         JR      Z,L2148         ; forward to IN-VAR-2 if not using the
  10128.                                 ; keyboard for input. (??)
  10129.  
  10130.         LD      ($5C3D),SP      ; set ERR_SP to point to IN-VAR-1 on stack.
  10131.  
  10132. ;; IN-VAR-2
  10133. L2148:  LD      HL,($5C61)      ; set HL to WORKSP - start of workspace.
  10134.         CALL    L11A7           ; routine REMOVE-FP removes floating point
  10135.                                 ; forms when looping in error condition.
  10136.         LD      (IY+$00),$FF    ; set ERR_NR to 'OK' cancelling the error.
  10137.                                 ; but X_PTR causes flashing error marker
  10138.                                 ; to be displayed at each call to the editor.
  10139.         CALL    L0F2C           ; routine EDITOR allows input to be entered
  10140.                                 ; or corrected if this is second time around.
  10141.  
  10142. ; if we pass to next then there are no system errors
  10143.  
  10144.         RES     7,(IY+$01)      ; update FLAGS  - signal checking syntax
  10145.         CALL    L21B9           ; routine IN-ASSIGN checks syntax using
  10146.                                 ; the VAL-FET-2 and powerful SCANNING routines.
  10147.                                 ; any syntax error and its back to IN-VAR-1.
  10148.                                 ; but with the flashing error marker showing
  10149.                                 ; where the error is.
  10150.                                 ; Note. the syntax of string input has to be
  10151.                                 ; checked as the user may have removed the
  10152.                                 ; bounding quotes or escaped them as with
  10153.                                 ; "hat" + "stand" for example.
  10154. ; proceed if syntax passed.
  10155.  
  10156.         JR      L2161           ; jump forward to IN-VAR-4
  10157.  
  10158. ; ---
  10159.  
  10160. ; the jump was to here when using INPUT LINE.
  10161.  
  10162. ;; IN-VAR-3
  10163. L215E:  CALL    L0F2C           ; routine EDITOR is called for input
  10164.  
  10165. ; when ENTER received rejoin other route but with no syntax check.
  10166.  
  10167. ; INPUT and INPUT LINE converge here.
  10168.  
  10169. ;; IN-VAR-4
  10170. L2161:  LD      (IY+$22),$00    ; set K_CUR_hi to a low value so that the cursor
  10171.                                 ; no longer appears in the input line.
  10172.  
  10173.         CALL    L21D6           ; routine IN-CHAN-K tests if the keyboard
  10174.                                 ; is being used for input.
  10175.         JR      NZ,L2174        ; forward to IN-VAR-5 if using another input
  10176.                                 ; channel.
  10177.  
  10178. ; continue here if using the keyboard.
  10179.  
  10180.         CALL    L111D           ; routine ED-COPY overprints the edit line
  10181.                                 ; to the lower screen. The only visible
  10182.                                 ; affect is that the cursor disappears.
  10183.                                 ; if you're inputting more than one item in
  10184.                                 ; a statement then that becomes apparent.
  10185.  
  10186.         LD      BC,($5C82)      ; fetch line and column from ECHO_E
  10187.         CALL    L0DD9           ; routine CL-SET sets S-POSNL to those
  10188.                                 ; values.
  10189.  
  10190. ; if using another input channel rejoin here.
  10191.  
  10192. ;; IN-VAR-5
  10193. L2174:  LD      HL,$5C71        ; point HL to FLAGX
  10194.         RES     5,(HL)          ; signal not in input mode
  10195.         BIT     7,(HL)          ; is this INPUT LINE ?
  10196.         RES     7,(HL)          ; cancel the bit anyway.
  10197.         JR      NZ,L219B        ; forward to IN-VAR-6 if INPUT LINE.
  10198.  
  10199.         POP     HL              ; drop the looping address
  10200.         POP     HL              ; drop the the address of previous
  10201.                                 ; error handler.
  10202.         LD      ($5C3D),HL      ; set ERR_SP to point to it.
  10203.         POP     HL              ; drop original CH_ADD which points to
  10204.                                 ; INPUT command in BASIC line.
  10205.         LD      ($5C5F),HL      ; save in X_PTR while input is assigned.
  10206.         SET     7,(IY+$01)      ; update FLAGS - Signal running program
  10207.         CALL    L21B9           ; routine IN-ASSIGN is called again
  10208.                                 ; this time the variable will be assigned
  10209.                                 ; the input value without error.
  10210.                                 ; Note. the previous example now
  10211.                                 ; becomes "hatstand"
  10212.  
  10213.         LD      HL,($5C5F)      ; fetch stored CH_ADD value from X_PTR.
  10214.         LD      (IY+$26),$00    ; set X_PTR_hi so that iy is no longer relevant.
  10215.         LD      ($5C5D),HL      ; put restored value back in CH_ADD
  10216.         JR      L21B2           ; forward to IN-NEXT-2 to see if anything
  10217.                                 ; more in the INPUT list.
  10218.  
  10219. ; ---
  10220.  
  10221. ; the jump was to here with INPUT LINE only
  10222.  
  10223. ;; IN-VAR-6
  10224. L219B:  LD      HL,($5C63)      ; STKBOT points to the end of the input.
  10225.         LD      DE,($5C61)      ; WORKSP points to the beginning.
  10226.         SCF                     ; prepare for true subtraction.
  10227.         SBC     HL,DE           ; subtract to get length
  10228.         LD      B,H             ; transfer it to
  10229.         LD      C,L             ; the BC register pair.
  10230.         CALL    L2AB2           ; routine STK-STO-$ stores parameters on
  10231.                                 ; the calculator stack.
  10232.         CALL    L2AFF           ; routine LET assigns it to destination.
  10233.         JR      L21B2           ; forward to IN-NEXT-2 as print items
  10234.                                 ; not allowed with INPUT LINE.
  10235.                                 ; Note. that "hat" + "stand" will, for
  10236.                                 ; example, be unchanged as also would
  10237.                                 ; 'PRINT "Iris was here"'.
  10238.  
  10239. ; ---
  10240.  
  10241. ; the jump was to here when ALPHA found more items while looking for
  10242. ; a variable name.
  10243.  
  10244. ;; IN-NEXT-1
  10245. L21AF:  CALL    L1FFC           ; routine PR-ITEM-1 considers further items.
  10246.  
  10247. ;; IN-NEXT-2
  10248. L21B2:  CALL    L204E           ; routine PR-POSN-1 handles a position item.
  10249.         JP      Z,L20C1         ; jump back to IN-ITEM-1 if the zero flag
  10250.                                 ; indicates more items are present.
  10251.  
  10252.         RET                     ; return.
  10253.  
  10254. ; ---------------------------
  10255. ; INPUT ASSIGNMENT Subroutine
  10256. ; ---------------------------
  10257. ; This subroutine is called twice from the INPUT command when normal
  10258. ; keyboard input is assigned. On the first occasion syntax is checked
  10259. ; using SCANNING. The final call with the syntax flag reset is to make
  10260. ; the assignment.
  10261.  
  10262. ;; IN-ASSIGN
  10263. L21B9:  LD      HL,($5C61)      ; fetch WORKSP start of input
  10264.         LD      ($5C5D),HL      ; set CH_ADD to first character
  10265.  
  10266.         RST     18H             ; GET-CHAR ignoring leading white-space.
  10267.         CP      $E2             ; is it 'STOP'
  10268.         JR      Z,L21D0         ; forward to IN-STOP if so.
  10269.  
  10270.         LD      A,($5C71)       ; load accumulator from FLAGX
  10271.         CALL    L1C59           ; routine VAL-FET-2 makes assignment
  10272.                                 ; or goes through the motions if checking
  10273.                                 ; syntax. SCANNING is used.
  10274.  
  10275.         RST     18H             ; GET-CHAR
  10276.         CP      $0D             ; is it carriage return ?
  10277.         RET     Z               ; return if so
  10278.                                 ; either syntax is OK
  10279.                                 ; or assignment has been made.
  10280.  
  10281. ; if another character was found then raise an error.
  10282. ; User doesn't see report but the flashing error marker
  10283. ; appears in the lower screen.
  10284.  
  10285. ;; REPORT-Cb
  10286. L21CE:  RST     08H             ; ERROR-1
  10287.         DB    $0B             ; Error Report: Nonsense in BASIC
  10288.  
  10289. ;; IN-STOP
  10290. L21D0:  CALL    L2530           ; routine SYNTAX-Z (UNSTACK-Z?)
  10291.         RET     Z               ; return if checking syntax
  10292.                                 ; as user wouldn't see error report.
  10293.                                 ; but generate visible error report
  10294.                                 ; on second invocation.
  10295.  
  10296. ;; REPORT-H
  10297. L21D4:  RST     08H             ; ERROR-1
  10298.         DB    $10             ; Error Report: STOP in INPUT
  10299.  
  10300. ; ------------------
  10301. ; Test for channel K
  10302. ; ------------------
  10303. ; This subroutine is called once from the keyboard
  10304. ; INPUT command to check if the input routine in
  10305. ; use is the one for the keyboard.
  10306.  
  10307. ;; IN-CHAN-K
  10308. L21D6:  LD      HL,($5C51)      ; fetch address of current channel CURCHL
  10309.         INC     HL              ;
  10310.         INC     HL              ; advance past
  10311.         INC     HL              ; input and
  10312.         INC     HL              ; output streams
  10313.         LD      A,(HL)          ; fetch the channel identifier.
  10314.         CP      $4B             ; test for 'K'
  10315.         RET                     ; return with zero set if keyboard is use.
  10316.  
  10317. ; --------------------
  10318. ; Colour Item Routines
  10319. ; --------------------
  10320. ;
  10321. ; These routines have 3 entry points -
  10322. ; 1) CO-TEMP-2 to handle a series of embedded Graphic colour items.
  10323. ; 2) CO-TEMP-3 to handle a single embedded print colour item.
  10324. ; 3) CO TEMP-4 to handle a colour command such as FLASH 1
  10325. ;
  10326. ; "Due to a bug, if you bring in a peripheral channel and later use a colour
  10327. ;  statement, colour controls will be sent to it by mistake." - Steven Vickers
  10328. ;  Pitman Pocket Guide, 1984.
  10329. ;
  10330. ; To be fair, this only applies if the last channel was other than 'K', 'S'
  10331. ; or 'P', which are all that are supported by this ROM, but if that last
  10332. ; channel was a microdrive file, network channel etc. then
  10333. ; PAPER 6; CLS will not turn the screen yellow and
  10334. ; CIRCLE INK 2; 128,88,50 will not draw a red circle.
  10335. ;
  10336. ; This bug does not apply to embedded PRINT items as it is quite permissible
  10337. ; to mix stream altering commands and colour items.
  10338. ; The fix therefore would be to ensure that CLASS-07 and CLASS-09 make
  10339. ; channel 'S' the current channel when not checking syntax.
  10340. ; -----------------------------------------------------------------
  10341.  
  10342. ;; CO-TEMP-1
  10343. L21E1:  RST     20H             ; NEXT-CHAR
  10344.  
  10345. ; -> Entry point from CLASS-09. Embedded Graphic colour items.
  10346. ; e.g. PLOT INK 2; PAPER 8; 128,88
  10347. ; Loops till all colour items output, finally addressing the coordinates.
  10348.  
  10349. ;; CO-TEMP-2
  10350. L21E2:  CALL    L21F2           ; routine CO-TEMP-3 to output colour control.
  10351.         RET     C               ; return if nothing more to output. ->
  10352.  
  10353.  
  10354.         RST     18H             ; GET-CHAR
  10355.         CP      $2C             ; is it ',' separator ?
  10356.         JR      Z,L21E1         ; back if so to CO-TEMP-1
  10357.  
  10358.         CP      $3B             ; is it ';' separator ?
  10359.         JR      Z,L21E1         ; back to CO-TEMP-1 for more.
  10360.  
  10361.         JP      L1C8A           ; to REPORT-C (REPORT-Cb is within range)
  10362.                                 ; 'Nonsense in BASIC'
  10363.  
  10364. ; -------------------
  10365. ; CO-TEMP-3
  10366. ; -------------------
  10367. ; -> this routine evaluates and outputs a colour control and parameter.
  10368. ; It is called from above and also from PR-ITEM-3 to handle a single embedded
  10369. ; print item e.g. PRINT PAPER 6; "Hi". In the latter case, the looping for
  10370. ; multiple items is within the PR-ITEM routine.
  10371. ; It is quite permissible to send these to any stream.
  10372.  
  10373. ;; CO-TEMP-3
  10374. L21F2:  CP      $D9             ; is it 'INK' ?
  10375.         RET     C               ; return if less.
  10376.  
  10377.         CP      $DF             ; compare with 'OUT'
  10378.         CCF                     ; Complement Carry Flag
  10379.         RET     C               ; return if greater than 'OVER', $DE.
  10380.  
  10381.         PUSH    AF              ; save the colour token.
  10382.  
  10383.         RST     20H             ; address NEXT-CHAR
  10384.         POP     AF              ; restore token and continue.
  10385.  
  10386. ; -> this entry point used by CLASS-07. e.g. the command PAPER 6.
  10387.  
  10388. ;; CO-TEMP-4
  10389. L21FC:  SUB     $C9             ; reduce to control character $10 (INK)
  10390.                                 ; thru $15 (OVER).
  10391.         PUSH    AF              ; save control.
  10392.         CALL    L1C82           ; routine EXPT-1NUM stacks addressed
  10393.                                 ; parameter on calculator stack.
  10394.         POP     AF              ; restore control.
  10395.         AND     A               ; clear carry
  10396.  
  10397.         CALL    L1FC3           ; routine UNSTACK-Z returns if checking syntax.
  10398.  
  10399.         PUSH    AF              ; save again
  10400.         CALL    L1E94           ; routine FIND-INT1 fetches parameter to A.
  10401.         LD      D,A             ; transfer now to D
  10402.         POP     AF              ; restore control.
  10403.  
  10404.         RST     10H             ; PRINT-A outputs the control to current
  10405.                                 ; channel.
  10406.         LD      A,D             ; transfer parameter to A.
  10407.  
  10408.         RST     10H             ; PRINT-A outputs parameter.
  10409.         RET                     ; return. ->
  10410.  
  10411. ; -------------------------------------------------------------------------
  10412. ;
  10413. ;         {fl}{br}{   paper   }{  ink    }    The temporary colour attributes
  10414. ;          ___ ___ ___ ___ ___ ___ ___ ___    system variable.
  10415. ; ATTR_T  |   |   |   |   |   |   |   |   |
  10416. ;         |   |   |   |   |   |   |   |   |
  10417. ; 23695   |___|___|___|___|___|___|___|___|
  10418. ;           7   6   5   4   3   2   1   0
  10419. ;
  10420. ;
  10421. ;         {fl}{br}{   paper   }{  ink    }    The temporary mask used for
  10422. ;          ___ ___ ___ ___ ___ ___ ___ ___    transparent colours. Any bit
  10423. ; MASK_T  |   |   |   |   |   |   |   |   |   that is 1 shows that the
  10424. ;         |   |   |   |   |   |   |   |   |   corresponding attribute is
  10425. ; 23696   |___|___|___|___|___|___|___|___|   taken not from ATTR-T but from
  10426. ;           7   6   5   4   3   2   1   0     what is already on the screen.
  10427. ;
  10428. ;
  10429. ;         {paper9 }{ ink9 }{ inv1 }{ over1}   The print flags. Even bits are
  10430. ;          ___ ___ ___ ___ ___ ___ ___ ___    temporary flags. The odd bits
  10431. ; P_FLAG  |   |   |   |   |   |   |   |   |   are the permanent flags.
  10432. ;         | p | t | p | t | p | t | p | t |
  10433. ; 23697   |___|___|___|___|___|___|___|___|
  10434. ;           7   6   5   4   3   2   1   0
  10435. ;
  10436. ; -----------------------------------------------------------------------
  10437.  
  10438. ; ------------------------------------
  10439. ;  The colour system variable handler.
  10440. ; ------------------------------------
  10441. ; This is an exit branch from PO-1-OPER, PO-2-OPER
  10442. ; A holds control $10 (INK) to $15 (OVER)
  10443. ; D holds parameter 0-9 for ink/paper 0,1 or 8 for bright/flash,
  10444. ; 0 or 1 for over/inverse.
  10445.  
  10446. ;; CO-TEMP-5
  10447. L2211:  SUB     $11             ; reduce range $FF-$04
  10448.         ADC     A,$00           ; add in carry if INK
  10449.         JR      Z,L2234         ; forward to CO-TEMP-7 with INK and PAPER.
  10450.  
  10451.         SUB     $02             ; reduce range $FF-$02
  10452.         ADC     A,$00           ; add carry if FLASH
  10453.         JR      Z,L2273         ; forward to CO-TEMP-C with FLASH and BRIGHT.
  10454.  
  10455.         CP      $01             ; is it 'INVERSE' ?
  10456.         LD      A,D             ; fetch parameter for INVERSE/OVER
  10457.         LD      B,$01           ; prepare OVER mask setting bit 0.
  10458.         JR      NZ,L2228        ; forward to CO-TEMP-6 if OVER
  10459.  
  10460.         RLCA                    ; shift bit 0
  10461.         RLCA                    ; to bit 2
  10462.         LD      B,$04           ; set bit 2 of mask for inverse.
  10463.  
  10464. ;; CO-TEMP-6
  10465. L2228:  LD      C,A             ; save the A
  10466.         LD      A,D             ; re-fetch parameter
  10467.         CP      $02             ; is it less than 2
  10468.         JR      NC,L2244        ; to REPORT-K if not 0 or 1.
  10469.                                 ; 'Invalid colour'.
  10470.  
  10471.         LD      A,C             ; restore A
  10472.         LD      HL,$5C91        ; address system variable P_FLAG
  10473.         JR      L226C           ; forward to exit via routine CO-CHANGE
  10474.  
  10475. ; ---
  10476.  
  10477. ; the branch was here with INK/PAPER and carry set for INK.
  10478.  
  10479. ;; CO-TEMP-7
  10480. L2234:  LD      A,D             ; fetch parameter
  10481.         LD      B,$07           ; set ink mask 00000111
  10482.         JR      C,L223E         ; forward to CO-TEMP-8 with INK
  10483.  
  10484.         RLCA                    ; shift bits 0-2
  10485.         RLCA                    ; to
  10486.         RLCA                    ; bits 3-5
  10487.         LD      B,$38           ; set paper mask 00111000
  10488.  
  10489. ; both paper and ink rejoin here
  10490.  
  10491. ;; CO-TEMP-8
  10492. L223E:  LD      C,A             ; value to C
  10493.         LD      A,D             ; fetch parameter
  10494.         CP      $0A             ; is it less than 10d ?
  10495.         JR      C,L2246         ; forward to CO-TEMP-9 if so.
  10496.  
  10497. ; ink 10 etc. is not allowed.
  10498.  
  10499. ;; REPORT-K
  10500. L2244:  RST     08H             ; ERROR-1
  10501.         DB    $13             ; Error Report: Invalid colour
  10502.  
  10503. ;; CO-TEMP-9
  10504. L2246:  LD      HL,$5C8F        ; address system variable ATTR_T initially.
  10505.         CP      $08             ; compare with 8
  10506.         JR      C,L2258         ; forward to CO-TEMP-B with 0-7.
  10507.  
  10508.         LD      A,(HL)          ; fetch temporary attribute as no change.
  10509.         JR      Z,L2257         ; forward to CO-TEMP-A with INK/PAPER 8
  10510.  
  10511. ; it is either ink 9 or paper 9 (contrasting)
  10512.  
  10513.         OR      B               ; or with mask to make white
  10514.         CPL                     ; make black and change other to dark
  10515.         AND     $24             ; 00100100
  10516.         JR      Z,L2257         ; forward to CO-TEMP-A if black and
  10517.                                 ; originally light.
  10518.  
  10519.         LD      A,B             ; else just use the mask (white)
  10520.  
  10521. ;; CO-TEMP-A
  10522. L2257:  LD      C,A             ; save A in C
  10523.  
  10524. ;; CO-TEMP-B
  10525. L2258:  LD      A,C             ; load colour to A
  10526.         CALL    L226C           ; routine CO-CHANGE addressing ATTR-T
  10527.  
  10528.         LD      A,$07           ; put 7 in accumulator
  10529.         CP      D               ; compare with parameter
  10530.         SBC     A,A             ; $00 if 0-7, $FF if 8
  10531.         CALL    L226C           ; routine CO-CHANGE addressing MASK-T
  10532.                                 ; mask returned in A.
  10533.  
  10534. ; now consider P-FLAG.
  10535.  
  10536.         RLCA                    ; 01110000 or 00001110
  10537.         RLCA                    ; 11100000 or 00011100
  10538.         AND     $50             ; 01000000 or 00010000  (AND 01010000)
  10539.         LD      B,A             ; transfer to mask
  10540.         LD      A,$08           ; load A with 8
  10541.         CP      D               ; compare with parameter
  10542.         SBC     A,A             ; $FF if was 9,  $00 if 0-8
  10543.                                 ; continue while addressing P-FLAG
  10544.                                 ; setting bit 4 if ink 9
  10545.                                 ; setting bit 6 if paper 9
  10546.  
  10547. ; -----------------------
  10548. ; Handle change of colour
  10549. ; -----------------------
  10550. ; This routine addresses a system variable ATTR_T, MASK_T or P-FLAG in HL.
  10551. ; colour value in A, mask in B.
  10552.  
  10553. ;; CO-CHANGE
  10554. L226C:  XOR     (HL)            ; impress bits specified
  10555.         AND     B               ; by mask
  10556.         XOR     (HL)            ; on system variable.
  10557.         LD      (HL),A          ; update system variable.
  10558.         INC     HL              ; address next location.
  10559.         LD      A,B             ; put current value of mask in A
  10560.         RET                     ; return.
  10561.  
  10562. ; ---
  10563.  
  10564. ; the branch was here with flash and bright
  10565.  
  10566. ;; CO-TEMP-C
  10567. L2273:  SBC     A,A             ; set zero flag for bright.
  10568.         LD      A,D             ; fetch original parameter 0,1 or 8
  10569.         RRCA                    ; rotate bit 0 to bit 7
  10570.         LD      B,$80           ; mask for flash 10000000
  10571.         JR      NZ,L227D        ; forward to CO-TEMP-D if flash
  10572.  
  10573.         RRCA                    ; rotate bit 7 to bit 6
  10574.         LD      B,$40           ; mask for bright 01000000
  10575.  
  10576. ;; CO-TEMP-D
  10577. L227D:  LD      C,A             ; store value in C
  10578.         LD      A,D             ; fetch parameter
  10579.         CP      $08             ; compare with 8
  10580.         JR      Z,L2287         ; forward to CO-TEMP-E if 8
  10581.  
  10582.         CP      $02             ; test if 0 or 1
  10583.         JR      NC,L2244        ; back to REPORT-K if not
  10584.                                 ; 'Invalid colour'
  10585.  
  10586. ;; CO-TEMP-E
  10587. L2287:  LD      A,C             ; value to A
  10588.         LD      HL,$5C8F        ; address ATTR_T
  10589.         CALL    L226C           ; routine CO-CHANGE addressing ATTR_T
  10590.         LD      A,C             ; fetch value
  10591.         RRCA                    ; for flash8/bright8 complete
  10592.         RRCA                    ; rotations to put set bit in
  10593.         RRCA                    ; bit 7 (flash) bit 6 (bright)
  10594.         JR      L226C           ; back to CO-CHANGE addressing MASK_T
  10595.                                 ; and indirect return.
  10596.  
  10597. ; ---------------------
  10598. ; Handle BORDER command
  10599. ; ---------------------
  10600. ; Command syntax example: BORDER 7
  10601. ; This command routine sets the border to one of the eight colours.
  10602. ; The colours used for the lower screen are based on this.
  10603.  
  10604. ;; BORDER
  10605. L2294:  CALL    L1E94           ; routine FIND-INT1
  10606.         CP      $08             ; must be in range 0 (black) to 7 (white)
  10607.         JR      NC,L2244        ; back to REPORT-K if not
  10608.                                 ; 'Invalid colour'.
  10609.  
  10610.         OUT     ($FE),A         ; outputting to port effects an immediate
  10611.                                 ; change.
  10612.         RLCA                    ; shift the colour to
  10613.         RLCA                    ; the paper bits setting the
  10614.         RLCA                    ; ink colour black.
  10615.         BIT     5,A             ; is the number light coloured ?
  10616.                                 ; i.e. in the range green to white.
  10617.         JR      NZ,L22A6        ; skip to BORDER-1 if so
  10618.  
  10619.         XOR     $07             ; make the ink white.
  10620.  
  10621. ;; BORDER-1
  10622. L22A6:  LD      ($5C48),A       ; update BORDCR with new paper/ink
  10623.         RET                     ; return.
  10624.  
  10625. ; -----------------
  10626. ; Get pixel address
  10627. ; -----------------
  10628. ;
  10629. ;
  10630.  
  10631. ;; PIXEL-ADD
  10632. L22AA:  LD      A,$AF           ; load with 175 decimal.
  10633.         SUB     B               ; subtract the y value.
  10634.         JP      C,L24F9         ; jump forward to REPORT-Bc if greater.
  10635.                                 ; 'Integer out of range'
  10636.  
  10637. ; the high byte is derived from Y only.
  10638. ; the first 3 bits are always 010
  10639. ; the next 2 bits denote in which third of the screen the byte is.
  10640. ; the last 3 bits denote in which of the 8 scan lines within a third
  10641. ; the byte is located. There are 24 discrete values.
  10642.  
  10643.  
  10644.         LD      B,A             ; the line number from top of screen to B.
  10645.         AND     A               ; clear carry (already clear)
  10646.         RRA                     ;                     0xxxxxxx
  10647.         SCF                     ; set carry flag
  10648.         RRA                     ;                     10xxxxxx
  10649.         AND     A               ; clear carry flag
  10650.         RRA                     ;                     010xxxxx
  10651.  
  10652.         XOR     B               ;
  10653.         AND     $F8             ; keep the top 5 bits 11111000
  10654.         XOR     B               ;                     010xxbbb
  10655.         LD      H,A             ; transfer high byte to H.
  10656.  
  10657. ; the low byte is derived from both X and Y.
  10658.  
  10659.         LD      A,C             ; the x value 0-255.
  10660.         RLCA                    ;
  10661.         RLCA                    ;
  10662.         RLCA                    ;
  10663.         XOR     B               ; the y value
  10664.         AND     $C7             ; apply mask             11000111
  10665.         XOR     B               ; restore unmasked bits  xxyyyxxx
  10666.         RLCA                    ; rotate to              xyyyxxxx
  10667.         RLCA                    ; required position.     yyyxxxxx
  10668.         LD      L,A             ; low byte to L.
  10669.  
  10670. ; finally form the pixel position in A.
  10671.  
  10672.         LD      A,C             ; x value to A
  10673.         AND     $07             ; mod 8
  10674.         RET                     ; return
  10675.  
  10676. ; ----------------
  10677. ; Point Subroutine
  10678. ; ----------------
  10679. ; The point subroutine is called from s-point via the scanning functions
  10680. ; table.
  10681.  
  10682. ;; POINT-SUB
  10683. L22CB:  CALL    L2307           ; routine STK-TO-BC
  10684.         CALL    L22AA           ; routine PIXEL-ADD finds address of pixel.
  10685.         LD      B,A             ; pixel position to B, 0-7.
  10686.         INC     B               ; increment to give rotation count 1-8.
  10687.         LD      A,(HL)          ; fetch byte from screen.
  10688.  
  10689. ;; POINT-LP
  10690. L22D4:  RLCA                    ; rotate and loop back
  10691.         DJNZ    L22D4           ; to POINT-LP until pixel at right.
  10692.  
  10693.         AND      $01            ; test to give zero or one.
  10694.         JP      L2D28           ; jump forward to STACK-A to save result.
  10695.  
  10696. ; -------------------
  10697. ; Handle PLOT command
  10698. ; -------------------
  10699. ; Command Syntax example: PLOT 128,88
  10700. ;
  10701.  
  10702. ;; PLOT
  10703. L22DC:  CALL    L2307           ; routine STK-TO-BC
  10704.         CALL    L22E5           ; routine PLOT-SUB
  10705.         JP      L0D4D           ; to TEMPS
  10706.  
  10707. ; -------------------
  10708. ; The Plot subroutine
  10709. ; -------------------
  10710. ; A screen byte holds 8 pixels so it is necessary to rotate a mask
  10711. ; into the correct position to leave the other 7 pixels unaffected.
  10712. ; However all 64 pixels in the character cell take any embedded colour
  10713. ; items.
  10714. ; A pixel can be reset (inverse 1), toggled (over 1), or set ( with inverse
  10715. ; and over switches off). With both switches on, the byte is simply put
  10716. ; back on the screen though the colours may change.
  10717.  
  10718. ;; PLOT-SUB
  10719. L22E5:  LD      ($5C7D),BC      ; store new x/y values in COORDS
  10720.         CALL    L22AA           ; routine PIXEL-ADD gets address in HL,
  10721.                                 ; count from left 0-7 in B.
  10722.         LD      B,A             ; transfer count to B.
  10723.         INC     B               ; increase 1-8.
  10724.         LD      A,$FE           ; 11111110 in A.
  10725.  
  10726. ;; PLOT-LOOP
  10727. L22F0:  RRCA                    ; rotate mask.
  10728.         DJNZ    L22F0           ; to PLOT-LOOP until B circular rotations.
  10729.  
  10730.         LD      B,A             ; load mask to B
  10731.         LD      A,(HL)          ; fetch screen byte to A
  10732.  
  10733.         LD      C,(IY+$57)      ; P_FLAG to C
  10734.         BIT     0,C             ; is it to be OVER 1 ?
  10735.         JR      NZ,L22FD        ; forward to PL-TST-IN if so.
  10736.  
  10737. ; was over 0
  10738.  
  10739.         AND     B               ; combine with mask to blank pixel.
  10740.  
  10741. ;; PL-TST-IN
  10742. L22FD:  BIT     2,C             ; is it inverse 1 ?
  10743.         JR      NZ,L2303        ; to PLOT-END if so.
  10744.  
  10745.         XOR     B               ; switch the pixel
  10746.         CPL                     ; restore other 7 bits
  10747.  
  10748. ;; PLOT-END
  10749. L2303:  LD      (HL),A          ; load byte to the screen.
  10750.         JP      L0BDB           ; exit to PO-ATTR to set colours for cell.
  10751.  
  10752. ; ------------------------------
  10753. ; Put two numbers in BC register
  10754. ; ------------------------------
  10755. ;
  10756. ;
  10757.  
  10758. ;; STK-TO-BC
  10759. L2307:  CALL    L2314           ; routine STK-TO-A
  10760.         LD      B,A             ;
  10761.         PUSH    BC              ;
  10762.         CALL    L2314           ; routine STK-TO-A
  10763.         LD      E,C             ;
  10764.         POP     BC              ;
  10765.         LD      D,C             ;
  10766.         LD      C,A             ;
  10767.         RET                     ;
  10768.  
  10769. ; -----------------------
  10770. ; Put stack in A register
  10771. ; -----------------------
  10772. ; This routine puts the last value on the calculator stack into the accumulator
  10773. ; deleting the last value.
  10774.  
  10775. ;; STK-TO-A
  10776. L2314:  CALL    L2DD5           ; routine FP-TO-A compresses last value into
  10777.                                 ; accumulator. e.g. PI would become 3.
  10778.                                 ; zero flag set if positive.
  10779.         JP      C,L24F9         ; jump forward to REPORT-Bc if >= 255.5.
  10780.  
  10781.         LD      C,$01           ; prepare a positive sign byte.
  10782.         RET     Z               ; return if FP-TO-BC indicated positive.
  10783.  
  10784.         LD      C,$FF           ; prepare negative sign byte and
  10785.         RET                     ; return.
  10786.  
  10787.  
  10788. ; ---------------------
  10789. ; Handle CIRCLE command
  10790. ; ---------------------
  10791. ;
  10792. ; syntax has been partly checked using the class for draw command.
  10793.  
  10794. ;; CIRCLE
  10795. L2320:  RST     18H             ; GET-CHAR
  10796.         CP      $2C             ; is it required comma ?
  10797.         JP      NZ,L1C8A        ; jump to REPORT-C if not
  10798.  
  10799.  
  10800.         RST     20H             ; NEXT-CHAR
  10801.         CALL    L1C82           ; routine EXPT-1NUM fetches radius
  10802.         CALL    L1BEE           ; routine CHECK-END will return here if
  10803.                                 ; nothing follows command.
  10804.  
  10805.         RST     28H             ;; FP-CALC
  10806.         DB    $2A             ;;abs           ; make radius positive
  10807.         DB    $3D             ;;re-stack      ; in full floating point form
  10808.         DB    $38             ;;end-calc
  10809.  
  10810.         LD      A,(HL)          ; fetch first floating point byte
  10811.         CP      $81             ; compare to one
  10812.         JR      NC,L233B        ; forward to C-R-GRE-1 if circle radius
  10813.                                 ; is greater than one.
  10814.  
  10815.  
  10816.         RST     28H             ;; FP-CALC
  10817.         DB    $02             ;;delete        ; delete the radius from stack.
  10818.         DB    $38             ;;end-calc
  10819.  
  10820.         JR      L22DC           ; to PLOT to just plot x,y.
  10821.  
  10822. ; ---
  10823.  
  10824.  
  10825. ;; C-R-GRE-1
  10826. L233B:  RST     28H             ;; FP-CALC      ; x, y, r
  10827.         DB    $A3             ;;stk-pi/2      ; x, y, r, pi/2.
  10828.         DB    $38             ;;end-calc
  10829.  
  10830.         LD      (HL),$83        ;               ; x, y, r, 2*PI
  10831.  
  10832.         RST     28H             ;; FP-CALC
  10833.         DB    $C5             ;;st-mem-5      ; store 2*PI in mem-5
  10834.         DB    $02             ;;delete        ; x, y, z.
  10835.         DB    $38             ;;end-calc
  10836.  
  10837.         CALL    L247D           ; routine CD-PRMS1
  10838.         PUSH    BC              ;
  10839.  
  10840.         RST     28H             ;; FP-CALC
  10841.         DB    $31             ;;duplicate
  10842.         DB    $E1             ;;get-mem-1
  10843.         DB    $04             ;;multiply
  10844.         DB    $38             ;;end-calc
  10845.  
  10846.         LD      A,(HL)          ;
  10847.         CP      $80             ;
  10848.         JR      NC,L235A        ; to C-ARC-GE1
  10849.  
  10850.  
  10851.         RST     28H             ;; FP-CALC
  10852.         DB    $02             ;;delete
  10853.         DB    $02             ;;delete
  10854.         DB    $38             ;;end-calc
  10855.  
  10856.         POP     BC              ;
  10857.         JP      L22DC           ; JUMP to PLOT
  10858.  
  10859. ; ---
  10860.  
  10861.  
  10862. ;; C-ARC-GE1
  10863. L235A:  RST     28H             ;; FP-CALC
  10864.         DB    $C2             ;;st-mem-2
  10865.         DB    $01             ;;exchange
  10866.         DB    $C0             ;;st-mem-0
  10867.         DB    $02             ;;delete
  10868.         DB    $03             ;;subtract
  10869.         DB    $01             ;;exchange
  10870.         DB    $E0             ;;get-mem-0
  10871.         DB    $0F             ;;addition
  10872.         DB    $C0             ;;st-mem-0
  10873.         DB    $01             ;;exchange
  10874.         DB    $31             ;;duplicate
  10875.         DB    $E0             ;;get-mem-0
  10876.         DB    $01             ;;exchange
  10877.         DB    $31             ;;duplicate
  10878.         DB    $E0             ;;get-mem-0
  10879.         DB    $A0             ;;stk-zero
  10880.         DB    $C1             ;;st-mem-1
  10881.         DB    $02             ;;delete
  10882.         DB    $38             ;;end-calc
  10883.  
  10884.         INC     (IY+$62)        ; MEM-2-1st
  10885.         CALL     L1E94          ; routine FIND-INT1
  10886.         LD      L,A             ;
  10887.         PUSH    HL              ;
  10888.         CALL    L1E94           ; routine FIND-INT1
  10889.         POP     HL              ;
  10890.         LD      H,A             ;
  10891.         LD      ($5C7D),HL      ; COORDS
  10892.         POP     BC              ;
  10893.         JP      L2420           ; to DRW-STEPS
  10894.  
  10895.  
  10896. ; -------------------
  10897. ; Handle DRAW command
  10898. ; -------------------
  10899. ;
  10900. ;
  10901.  
  10902. ;; DRAW
  10903. L2382:  RST     18H             ; GET-CHAR
  10904.         CP      $2C             ;
  10905.         JR      Z,L238D         ; to DR-3-PRMS
  10906.  
  10907.         CALL    L1BEE           ; routine CHECK-END
  10908.         JP      L2477           ; to LINE-DRAW
  10909.  
  10910. ; ---
  10911.  
  10912. ;; DR-3-PRMS
  10913. L238D:  RST     20H             ; NEXT-CHAR
  10914.         CALL    L1C82           ; routine EXPT-1NUM
  10915.         CALL    L1BEE           ; routine CHECK-END
  10916.  
  10917.         RST     28H             ;; FP-CALC
  10918.         DB    $C5             ;;st-mem-5
  10919.         DB    $A2             ;;stk-half
  10920.         DB    $04             ;;multiply
  10921.         DB    $1F             ;;sin
  10922.         DB    $31             ;;duplicate
  10923.         DB    $30             ;;not
  10924.         DB    $30             ;;not
  10925.         DB    $00             ;;jump-true
  10926.  
  10927.         DB    $06             ;;to L23A3, DR-SIN-NZ
  10928.  
  10929.         DB    $02             ;;delete
  10930.         DB    $38             ;;end-calc
  10931.  
  10932.         JP      L2477           ; to LINE-DRAW
  10933.  
  10934. ; ---
  10935.  
  10936. ;; DR-SIN-NZ
  10937. L23A3:  DB    $C0             ;;st-mem-0
  10938.         DB    $02             ;;delete
  10939.         DB    $C1             ;;st-mem-1
  10940.         DB    $02             ;;delete
  10941.         DB    $31             ;;duplicate
  10942.         DB    $2A             ;;abs
  10943.         DB    $E1             ;;get-mem-1
  10944.         DB    $01             ;;exchange
  10945.         DB    $E1             ;;get-mem-1
  10946.         DB    $2A             ;;abs
  10947.         DB    $0F             ;;addition
  10948.         DB    $E0             ;;get-mem-0
  10949.         DB    $05             ;;division
  10950.         DB    $2A             ;;abs
  10951.         DB    $E0             ;;get-mem-0
  10952.         DB    $01             ;;exchange
  10953.         DB    $3D             ;;re-stack
  10954.         DB    $38             ;;end-calc
  10955.  
  10956.         LD      A,(HL)          ;
  10957.         CP      $81             ;
  10958.         JR      NC,L23C1        ; to DR-PRMS
  10959.  
  10960.  
  10961.         RST     28H             ;; FP-CALC
  10962.         DB    $02             ;;delete
  10963.         DB    $02             ;;delete
  10964.         DB    $38             ;;end-calc
  10965.  
  10966.         JP      L2477           ; to LINE-DRAW
  10967.  
  10968. ; ---
  10969.  
  10970. ;; DR-PRMS
  10971. L23C1:  CALL    L247D           ; routine CD-PRMS1
  10972.         PUSH    BC              ;
  10973.  
  10974.         RST     28H             ;; FP-CALC
  10975.         DB    $02             ;;delete
  10976.         DB    $E1             ;;get-mem-1
  10977.         DB    $01             ;;exchange
  10978.         DB    $05             ;;division
  10979.         DB    $C1             ;;st-mem-1
  10980.         DB    $02             ;;delete
  10981.         DB    $01             ;;exchange
  10982.         DB    $31             ;;duplicate
  10983.         DB    $E1             ;;get-mem-1
  10984.         DB    $04             ;;multiply
  10985.         DB    $C2             ;;st-mem-2
  10986.         DB    $02             ;;delete
  10987.         DB    $01             ;;exchange
  10988.         DB    $31             ;;duplicate
  10989.         DB    $E1             ;;get-mem-1
  10990.         DB    $04             ;;multiply
  10991.         DB    $E2             ;;get-mem-2
  10992.         DB    $E5             ;;get-mem-5
  10993.         DB    $E0             ;;get-mem-0
  10994.         DB    $03             ;;subtract
  10995.         DB    $A2             ;;stk-half
  10996.         DB    $04             ;;multiply
  10997.         DB    $31             ;;duplicate
  10998.         DB    $1F             ;;sin
  10999.         DB    $C5             ;;st-mem-5
  11000.         DB    $02             ;;delete
  11001.         DB    $20             ;;cos
  11002.         DB    $C0             ;;st-mem-0
  11003.         DB    $02             ;;delete
  11004.         DB    $C2             ;;st-mem-2
  11005.         DB    $02             ;;delete
  11006.         DB    $C1             ;;st-mem-1
  11007.         DB    $E5             ;;get-mem-5
  11008.         DB    $04             ;;multiply
  11009.         DB    $E0             ;;get-mem-0
  11010.         DB    $E2             ;;get-mem-2
  11011.         DB    $04             ;;multiply
  11012.         DB    $0F             ;;addition
  11013.         DB    $E1             ;;get-mem-1
  11014.         DB    $01             ;;exchange
  11015.         DB    $C1             ;;st-mem-1
  11016.         DB    $02             ;;delete
  11017.         DB    $E0             ;;get-mem-0
  11018.         DB    $04             ;;multiply
  11019.         DB    $E2             ;;get-mem-2
  11020.         DB    $E5             ;;get-mem-5
  11021.         DB    $04             ;;multiply
  11022.         DB    $03             ;;subtract
  11023.         DB    $C2             ;;st-mem-2
  11024.         DB    $2A             ;;abs
  11025.         DB    $E1             ;;get-mem-1
  11026.         DB    $2A             ;;abs
  11027.         DB    $0F             ;;addition
  11028.         DB    $02             ;;delete
  11029.         DB    $38             ;;end-calc
  11030.  
  11031.         LD      A,(DE)          ;
  11032.         CP       $81            ;
  11033.         POP     BC              ;
  11034.         JP      C,L2477         ; to LINE-DRAW
  11035.  
  11036.         PUSH    BC              ;
  11037.  
  11038.         RST     28H             ;; FP-CALC
  11039.         DB    $01             ;;exchange
  11040.         DB    $38             ;;end-calc
  11041.  
  11042.         LD      A,($5C7D)       ; COORDS-x
  11043.         CALL    L2D28           ; routine STACK-A
  11044.  
  11045.         RST     28H             ;; FP-CALC
  11046.         DB    $C0             ;;st-mem-0
  11047.         DB    $0F             ;;addition
  11048.         DB    $01             ;;exchange
  11049.         DB    $38             ;;end-calc
  11050.  
  11051.         LD      A,($5C7E)       ; COORDS-y
  11052.         CALL    L2D28           ; routine STACK-A
  11053.  
  11054.         RST     28H             ;; FP-CALC
  11055.         DB    $C5             ;;st-mem-5
  11056.         DB    $0F             ;;addition
  11057.         DB    $E0             ;;get-mem-0
  11058.         DB    $E5             ;;get-mem-5
  11059.         DB    $38             ;;end-calc
  11060.  
  11061.         POP     BC              ;
  11062.  
  11063. ;; DRW-STEPS
  11064. L2420:  DEC     B               ;
  11065.         JR      Z,L245F         ; to ARC-END
  11066.  
  11067.         JR      L2439           ; to ARC-START
  11068.  
  11069. ; ---
  11070.  
  11071.  
  11072. ;; ARC-LOOP
  11073. L2425:  RST     28H             ;; FP-CALC
  11074.         DB    $E1             ;;get-mem-1
  11075.         DB    $31             ;;duplicate
  11076.         DB    $E3             ;;get-mem-3
  11077.         DB    $04             ;;multiply
  11078.         DB    $E2             ;;get-mem-2
  11079.         DB    $E4             ;;get-mem-4
  11080.         DB    $04             ;;multiply
  11081.         DB    $03             ;;subtract
  11082.         DB    $C1             ;;st-mem-1
  11083.         DB    $02             ;;delete
  11084.         DB    $E4             ;;get-mem-4
  11085.         DB    $04             ;;multiply
  11086.         DB    $E2             ;;get-mem-2
  11087.         DB    $E3             ;;get-mem-3
  11088.         DB    $04             ;;multiply
  11089.         DB    $0F             ;;addition
  11090.         DB    $C2             ;;st-mem-2
  11091.         DB    $02             ;;delete
  11092.         DB    $38             ;;end-calc
  11093.  
  11094. ;; ARC-START
  11095. L2439:  PUSH    BC              ;
  11096.  
  11097.         RST     28H             ;; FP-CALC
  11098.         DB    $C0             ;;st-mem-0
  11099.         DB    $02             ;;delete
  11100.         DB    $E1             ;;get-mem-1
  11101.         DB    $0F             ;;addition
  11102.         DB    $31             ;;duplicate
  11103.         DB    $38             ;;end-calc
  11104.  
  11105.         LD      A,($5C7D)       ; COORDS-x
  11106.         CALL    L2D28           ; routine STACK-A
  11107.  
  11108.         RST     28H             ;; FP-CALC
  11109.         DB    $03             ;;subtract
  11110.         DB    $E0             ;;get-mem-0
  11111.         DB    $E2             ;;get-mem-2
  11112.         DB    $0F             ;;addition
  11113.         DB    $C0             ;;st-mem-0
  11114.         DB    $01             ;;exchange
  11115.         DB    $E0             ;;get-mem-0
  11116.         DB    $38             ;;end-calc
  11117.  
  11118.         LD      A,($5C7E)       ; COORDS-y
  11119.         CALL    L2D28           ; routine STACK-A
  11120.  
  11121.         RST     28H             ;; FP-CALC
  11122.         DB    $03             ;;subtract
  11123.         DB    $38             ;;end-calc
  11124.  
  11125.         CALL    L24B7           ; routine DRAW-LINE
  11126.         POP     BC              ;
  11127.         DJNZ    L2425           ; to ARC-LOOP
  11128.  
  11129.  
  11130. ;; ARC-END
  11131. L245F:  RST     28H             ;; FP-CALC
  11132.         DB    $02             ;;delete
  11133.         DB    $02             ;;delete
  11134.         DB    $01             ;;exchange
  11135.         DB    $38             ;;end-calc
  11136.  
  11137.         LD      A,($5C7D)       ; COORDS-x
  11138.         CALL    L2D28           ; routine STACK-A
  11139.  
  11140.         RST     28H             ;; FP-CALC
  11141.         DB    $03             ;;subtract
  11142.         DB    $01             ;;exchange
  11143.         DB    $38             ;;end-calc
  11144.  
  11145.         LD      A,($5C7E)       ; COORDS-y
  11146.         CALL    L2D28           ; routine STACK-A
  11147.  
  11148.         RST     28H             ;; FP-CALC
  11149.         DB    $03             ;;subtract
  11150.         DB    $38             ;;end-calc
  11151.  
  11152. ;; LINE-DRAW
  11153. L2477:  CALL    L24B7           ; routine DRAW-LINE
  11154.         JP      L0D4D           ; to TEMPS
  11155.  
  11156.  
  11157. ; ------------------
  11158. ; Initial parameters
  11159. ; ------------------
  11160. ;
  11161. ;
  11162.  
  11163. ;; CD-PRMS1
  11164. L247D:  RST     28H             ;; FP-CALC
  11165.         DB    $31             ;;duplicate
  11166.         DB    $28             ;;sqr
  11167.         DB    $34             ;;stk-data
  11168.         DB    $32             ;;Exponent: $82, Bytes: 1
  11169.         DB    $00             ;;(+00,+00,+00)
  11170.         DB    $01             ;;exchange
  11171.         DB    $05             ;;division
  11172.         DB    $E5             ;;get-mem-5
  11173.         DB    $01             ;;exchange
  11174.         DB    $05             ;;division
  11175.         DB    $2A             ;;abs
  11176.         DB    $38             ;;end-calc
  11177.  
  11178.         CALL    L2DD5           ; routine FP-TO-A
  11179.         JR      C,L2495         ; to USE-252
  11180.  
  11181.         AND     $FC             ;
  11182.         ADD     A,$04           ;
  11183.         JR      NC,L2497        ; to DRAW-SAVE
  11184.  
  11185. ;; USE-252
  11186. L2495:  LD      A,$FC           ;
  11187.  
  11188. ;; DRAW-SAVE
  11189. L2497:  PUSH    AF              ;
  11190.         CALL    L2D28           ; routine STACK-A
  11191.  
  11192.         RST     28H             ;; FP-CALC
  11193.         DB    $E5             ;;get-mem-5
  11194.         DB    $01             ;;exchange
  11195.         DB    $05             ;;division
  11196.         DB    $31             ;;duplicate
  11197.         DB    $1F             ;;sin
  11198.         DB    $C4             ;;st-mem-4
  11199.         DB    $02             ;;delete
  11200.         DB    $31             ;;duplicate
  11201.         DB    $A2             ;;stk-half
  11202.         DB    $04             ;;multiply
  11203.         DB    $1F             ;;sin
  11204.         DB    $C1             ;;st-mem-1
  11205.         DB    $01             ;;exchange
  11206.         DB    $C0             ;;st-mem-0
  11207.         DB    $02             ;;delete
  11208.         DB    $31             ;;duplicate
  11209.         DB    $04             ;;multiply
  11210.         DB    $31             ;;duplicate
  11211.         DB    $0F             ;;addition
  11212.         DB    $A1             ;;stk-one
  11213.         DB    $03             ;;subtract
  11214.         DB    $1B             ;;negate
  11215.         DB    $C3             ;;st-mem-3
  11216.         DB    $02             ;;delete
  11217.         DB    $38             ;;end-calc
  11218.  
  11219.         POP     BC              ;
  11220.         RET                     ;
  11221.  
  11222. ; ------------
  11223. ; Line drawing
  11224. ; ------------
  11225. ;
  11226. ;
  11227.  
  11228. ;; DRAW-LINE
  11229. L24B7:  CALL    L2307           ; routine STK-TO-BC
  11230.         LD      A,C             ;
  11231.         CP      B               ;
  11232.         JR      NC,L24C4        ; to DL-X-GE-Y
  11233.  
  11234.         LD      L,C             ;
  11235.         PUSH    DE              ;
  11236.         XOR     A               ;
  11237.         LD      E,A             ;
  11238.         JR      L24CB           ; to DL-LARGER
  11239.  
  11240. ; ---
  11241.  
  11242. ;; DL-X-GE-Y
  11243. L24C4:  OR      C               ;
  11244.         RET     Z               ;
  11245.  
  11246.         LD      L,B             ;
  11247.         LD      B,C             ;
  11248.         PUSH    DE              ;
  11249.         LD      D,$00           ;
  11250.  
  11251. ;; DL-LARGER
  11252. L24CB:  LD      H,B             ;
  11253.         LD      A,B             ;
  11254.         RRA                     ;
  11255.  
  11256. ;; D-L-LOOP
  11257. L24CE:  ADD     A,L             ;
  11258.         JR      C,L24D4         ; to D-L-DIAG
  11259.  
  11260.         CP      H               ;
  11261.         JR      C,L24DB         ; to D-L-HR-VT
  11262.  
  11263. ;; D-L-DIAG
  11264. L24D4:  SUB     H               ;
  11265.         LD      C,A             ;
  11266.         EXX                     ;
  11267.         POP     BC              ;
  11268.         PUSH    BC              ;
  11269.         JR      L24DF           ; to D-L-STEP
  11270.  
  11271. ; ---
  11272.  
  11273. ;; D-L-HR-VT
  11274. L24DB:  LD      C,A             ;
  11275.         PUSH    DE              ;
  11276.         EXX                     ;
  11277.         POP     BC              ;
  11278.  
  11279. ;; D-L-STEP
  11280. L24DF:  LD      HL,($5C7D)      ; COORDS
  11281.         LD      A,B             ;
  11282.         ADD     A,H             ;
  11283.         LD      B,A             ;
  11284.         LD      A,C             ;
  11285.         INC     A               ;
  11286.         ADD     A,L             ;
  11287.         JR      C,L24F7         ; to D-L-RANGE
  11288.  
  11289.         JR      Z,L24F9         ; to REPORT-Bc
  11290.  
  11291. ;; D-L-PLOT
  11292. L24EC:  DEC     A               ;
  11293.         LD      C,A             ;
  11294.         CALL    L22E5           ; routine PLOT-SUB
  11295.         EXX                     ;
  11296.         LD      A,C             ;
  11297.         DJNZ    L24CE           ; to D-L-LOOP
  11298.  
  11299.         POP     DE              ;
  11300.         RET                     ;
  11301.  
  11302. ; ---
  11303.  
  11304. ;; D-L-RANGE
  11305. L24F7:  JR      Z,L24EC         ; to D-L-PLOT
  11306.  
  11307.  
  11308. ;; REPORT-Bc
  11309. L24F9:  RST     08H             ; ERROR-1
  11310.         DB    $0A             ; Error Report: Integer out of range
  11311.  
  11312.  
  11313.  
  11314. ;***********************************
  11315. ;** Part 8. EXPRESSION EVALUATION **
  11316. ;***********************************
  11317. ;
  11318. ; It is a this stage of the ROM that the Spectrum ceases altogether to be
  11319. ; just a colourful novelty. One remarkable feature is that in all previous
  11320. ; commands when the Spectrum is expecting a number or a string then an
  11321. ; expression of the same type can be substituted ad infinitum.
  11322. ; This is the routine that evaluates that expression.
  11323. ; This is what causes 2 + 2 to give the answer 4.
  11324. ; That is quite easy to understand. However you don't have to make it much
  11325. ; more complex to start a remarkable juggling act.
  11326. ; e.g. PRINT 2 * (VAL "2+2" + TAN 3)
  11327. ; In fact, provided there is enough free RAM, the Spectrum can evaluate
  11328. ; an expression of unlimited complexity.
  11329. ; Apart from a couple of minor glitches, which you can now correct, the
  11330. ; system is remarkably robust.
  11331.  
  11332.  
  11333. ; ---------------------------------
  11334. ; Scan expression or sub-expression
  11335. ; ---------------------------------
  11336. ;
  11337. ;
  11338.  
  11339. ;; SCANNING
  11340. L24FB:  RST     18H             ; GET-CHAR
  11341.         LD      B,$00           ; priority marker zero is pushed on stack
  11342.                                 ; to signify end of expression when it is
  11343.                                 ; popped off again.
  11344.         PUSH    BC              ; put in on stack.
  11345.                                 ; and proceed to consider the first character
  11346.                                 ; of the expression.
  11347.  
  11348. ;; S-LOOP-1
  11349. L24FF:  LD      C,A             ; store the character while a look up is done.
  11350.         LD      HL,L2596        ; Address: scan-func
  11351.         CALL    L16DC           ; routine INDEXER is called to see if it is
  11352.                                 ; part of a limited range '+', '(', 'ATTR' etc.
  11353.  
  11354.         LD      A,C             ; fetch the character back
  11355.         JP      NC,L2684        ; jump forward to S-ALPHNUM if not in primary
  11356.                                 ; operators and functions to consider in the
  11357.                                 ; first instance a digit or a variable and
  11358.                                 ; then anything else.                >>>
  11359.  
  11360.         LD      B,$00           ; but here if it was found in table so
  11361.         LD      C,(HL)          ; fetch offset from table and make B zero.
  11362.         ADD     HL,BC           ; add the offset to position found
  11363.         JP      (HL)            ; and jump to the routine e.g. S-BIN
  11364.                                 ; making an indirect exit from there.
  11365.  
  11366. ; -------------------------------------------------------------------------
  11367. ; The four service subroutines for routines in the scannings function table
  11368. ; -------------------------------------------------------------------------
  11369.  
  11370. ; PRINT """Hooray!"" he cried."
  11371.  
  11372. ;; S-QUOTE-S
  11373. L250F:  CALL    L0074           ; routine CH-ADD+1 points to next character
  11374.                                 ; and fetches that character.
  11375.         INC     BC              ; increase length counter.
  11376.         CP      $0D             ; is it carriage return ?
  11377.                                 ; inside a quote.
  11378.         JP      Z,L1C8A         ; jump back to REPORT-C if so.
  11379.                                 ; 'Nonsense in BASIC'.
  11380.  
  11381.         CP      $22             ; is it a quote '"' ?
  11382.         JR      NZ,L250F        ; back to S-QUOTE-S if not for more.
  11383.  
  11384.         CALL    L0074           ; routine CH-ADD+1
  11385.         CP      $22             ; compare with possible adjacent quote
  11386.         RET                     ; return. with zero set if two together.
  11387.  
  11388. ; ---
  11389.  
  11390. ; This subroutine is used to get two coordinate expressions for the three
  11391. ; functions SCREEN$, ATTR and POINT that have two fixed parameters and
  11392. ; therefore require surrounding braces.
  11393.  
  11394. ;; S-2-COORD
  11395. L2522:  RST     20H             ; NEXT-CHAR
  11396.         CP      $28             ; is it the opening '(' ?
  11397.         JR      NZ,L252D        ; forward to S-RPORT-C if not
  11398.                                 ; 'Nonsense in BASIC'.
  11399.  
  11400.         CALL    L1C79           ; routine NEXT-2NUM gets two comma-separated
  11401.                                 ; numeric expressions. Note. this could cause
  11402.                                 ; many more recursive calls to SCANNING but
  11403.                                 ; the parent function will be evaluated fully
  11404.                                 ; before rejoining the main juggling act.
  11405.  
  11406.         RST     18H             ; GET-CHAR
  11407.         CP      $29             ; is it the closing ')' ?
  11408.  
  11409. ;; S-RPORT-C
  11410. L252D:  JP      NZ,L1C8A        ; jump back to REPORT-C if not.
  11411.                                 ; 'Nonsense in BASIC'.
  11412.  
  11413. ; ------------
  11414. ; Check syntax
  11415. ; ------------
  11416. ; This routine is called on a number of occasions to check if syntax is being
  11417. ; checked or if the program is being run. To test the flag inline would use
  11418. ; four bytes of code, but a call instruction only uses 3 bytes of code.
  11419.  
  11420. ;; SYNTAX-Z
  11421. L2530:  BIT     7,(IY+$01)      ; test FLAGS  - checking syntax only ?
  11422.         RET                     ; return.
  11423.  
  11424. ; ----------------
  11425. ; Scanning SCREEN$
  11426. ; ----------------
  11427. ; This function returns the code of a bit-mapped character at screen
  11428. ; position at line C, column B. It is unable to detect the mosaic characters
  11429. ; which are not bit-mapped but detects the ASCII 32 - 127 range.
  11430. ; The bit-mapped UDGs are ignored which is curious as it requires only a
  11431. ; few extra bytes of code. As usual, anything to do with CHARS is weird.
  11432. ; If no match is found a null string is returned.
  11433. ; No actual check on ranges is performed - that's up to the BASIC programmer.
  11434. ; No real harm can come from SCREEN$(255,255) although the BASIC manual
  11435. ; says that invalid values will be trapped.
  11436. ; Interestingly, in the Pitman pocket guide, 1984, Vickers says that the
  11437. ; range checking will be performed.
  11438.  
  11439. ;; S-SCRN$-S
  11440. L2535:  CALL    L2307           ; routine STK-TO-BC.
  11441.         LD      HL,($5C36)      ; fetch address of CHARS.
  11442.         LD      DE,$0100        ; fetch offset to chr$ 32
  11443.         ADD     HL,DE           ; and find start of bitmaps.
  11444.                                 ; Note. not inc h. ??
  11445.         LD      A,C             ; transfer line to A.
  11446.         RRCA                    ; multiply
  11447.         RRCA                    ; by
  11448.         RRCA                    ; thirty-two.
  11449.         AND     $E0             ; and with 11100000
  11450.         XOR     B               ; combine with column $00 - $1F
  11451.         LD      E,A             ; to give the low byte of top line
  11452.         LD      A,C             ; column to A range 00000000 to 00011111
  11453.         AND     $18             ; and with 00011000
  11454.         XOR     $40             ; xor with 01000000 (high byte screen start)
  11455.         LD      D,A             ; register DE now holds start address of cell.
  11456.         LD      B,$60           ; there are 96 characters in ASCII set.
  11457.  
  11458. ;; S-SCRN-LP
  11459. L254F:  PUSH    BC              ; save count
  11460.         PUSH    DE              ; save screen start address
  11461.         PUSH    HL              ; save bitmap start
  11462.         LD      A,(DE)          ; first byte of screen to A
  11463.         XOR     (HL)            ; xor with corresponding character byte
  11464.         JR      Z,L255A         ; forward to S-SC-MTCH if they match
  11465.                                 ; if inverse result would be $FF
  11466.                                 ; if any other then mismatch
  11467.  
  11468.         INC     A               ; set to $00 if inverse
  11469.         JR      NZ,L2573        ; forward to S-SCR-NXT if a mismatch
  11470.  
  11471.         DEC     A               ; restore $FF
  11472.  
  11473. ; a match has been found so seven more to test.
  11474.  
  11475. ;; S-SC-MTCH
  11476. L255A:  LD      C,A             ; load C with inverse mask $00 or $FF
  11477.         LD      B,$07           ; count seven more bytes
  11478.  
  11479. ;; S-SC-ROWS
  11480. L255D:  INC     D               ; increment screen address.
  11481.         INC     HL              ; increment bitmap address.
  11482.         LD      A,(DE)          ; byte to A
  11483.         XOR     (HL)            ; will give $00 or $FF (inverse)
  11484.         XOR     C               ; xor with inverse mask
  11485.         JR      NZ,L2573        ; forward to S-SCR-NXT if no match.
  11486.  
  11487.         DJNZ    L255D           ; back to S-SC-ROWS until all eight matched.
  11488.  
  11489. ; continue if a match of all eight bytes was found
  11490.  
  11491.         POP     BC              ; discard the
  11492.         POP     BC              ; saved
  11493.         POP     BC              ; pointers
  11494.         LD      A,$80           ; the endpoint of character set
  11495.         SUB     B               ; subtract the counter
  11496.                                 ; to give the code 32-127
  11497.         LD      BC,$0001        ; make one space in workspace.
  11498.  
  11499.         RST     30H             ; BC-SPACES creates the space sliding
  11500.                                 ; the calculator stack upwards.
  11501.         LD      (DE),A          ; start is addressed by DE, so insert code
  11502.         JR      L257D           ; forward to S-SCR-STO
  11503.  
  11504. ; ---
  11505.  
  11506. ; the jump was here if no match and more bitmaps to test.
  11507.  
  11508. ;; S-SCR-NXT
  11509. L2573:  POP     HL              ; restore the last bitmap start
  11510.         LD      DE,$0008        ; and prepare to add 8.
  11511.         ADD     HL,DE           ; now addresses next character bitmap.
  11512.         POP     DE              ; restore screen address
  11513.         POP     BC              ; and character counter in B
  11514.         DJNZ    L254F           ; back to S-SCRN-LP if more characters.
  11515.  
  11516.         LD      C,B             ; B is now zero, so BC now zero.
  11517.  
  11518. ;; S-SCR-STO
  11519. L257D:  JP      L2AB2           ; to STK-STO-$ to store the string in
  11520.                                 ; workspace or a string with zero length.
  11521.                                 ; (value of DE doesn't matter in last case)
  11522.  
  11523. ; Note. this exit seems correct but the general-purpose routine S-STRING
  11524. ; that calls this one will also stack any of its string results so this
  11525. ; leads to a double storing of the result in this case.
  11526. ; The instruction at L257D should just be a RET.
  11527. ; credit Stephen Kelly and others, 1982.
  11528.  
  11529. ; -------------
  11530. ; Scanning ATTR
  11531. ; -------------
  11532. ; This function subroutine returns the attributes of a screen location -
  11533. ; a numeric result.
  11534. ; Again it's up to the BASIC programmer to supply valid values of line/column.
  11535.  
  11536. ;; S-ATTR-S
  11537. L2580:  CALL    L2307           ; routine STK-TO-BC fetches line to C,
  11538.                                 ; and column to B.
  11539.         LD      A,C             ; line to A $00 - $17   (max 00010111)
  11540.         RRCA                    ; rotate
  11541.         RRCA                    ; bits
  11542.         RRCA                    ; left.
  11543.         LD      C,A             ; store in C as an intermediate value.
  11544.  
  11545.         AND     $E0             ; pick up bits 11100000 ( was 00011100 )
  11546.         XOR     B               ; combine with column $00 - $1F
  11547.         LD      L,A             ; low byte now correct.
  11548.  
  11549.         LD      A,C             ; bring back intermediate result from C
  11550.         AND     $03             ; mask to give correct third of
  11551.                                 ; screen $00 - $02
  11552.         XOR     $58             ; combine with base address.
  11553.         LD      H,A             ; high byte correct.
  11554.         LD      A,(HL)          ; pick up the colour attribute.
  11555.         JP      L2D28           ; forward to STACK-A to store result
  11556.                                 ; and make an indirect exit.
  11557.  
  11558. ; -----------------------
  11559. ; Scanning function table
  11560. ; -----------------------
  11561. ; This table is used by INDEXER routine to find the offsets to
  11562. ; four operators and eight functions. e.g. $A8 is the token 'FN'.
  11563. ; This table is used in the first instance for the first character of an
  11564. ; expression or by a recursive call to SCANNING for the first character of
  11565. ; any sub-expression. It eliminates functions that have no argument or
  11566. ; functions that can have more than one argument and therefore require
  11567. ; braces. By eliminating and dealing with these now it can later take a
  11568. ; simplistic approach to all other functions and assume that they have
  11569. ; one argument.
  11570. ; Similarly by eliminating BIN and '.' now it is later able to assume that
  11571. ; all numbers begin with a digit and that the presence of a number or
  11572. ; variable can be detected by a call to ALPHANUM.
  11573. ; By default all expressions are positive and the spurious '+' is eliminated
  11574. ; now as in print +2. This should not be confused with the operator '+'.
  11575. ; Note. this does allow a degree of nonsense to be accepted as in
  11576. ; PRINT +"3 is the greatest.".
  11577. ; An acquired programming skill is the ability to include brackets where
  11578. ; they are not necessary.
  11579. ; A bracket at the start of a sub-expression may be spurious or necessary
  11580. ; to denote that the contained expression is to be evaluated as an entity.
  11581. ; In either case this is dealt with by recursive calls to SCANNING.
  11582. ; An expression that begins with a quote requires special treatment.
  11583.  
  11584. ;; scan-func
  11585. L2596:  DB    $22, L25B3-$-1  ; $1C offset to S-QUOTE
  11586.         DB    '(', L25E8-$-1  ; $4F offset to S-BRACKET
  11587.         DB    '.', L268D-$-1  ; $F2 offset to S-DECIMAL
  11588.         DB    '+', L25AF-$-1  ; $12 offset to S-U-PLUS
  11589.  
  11590.         DB    $A8, L25F5-$-1  ; $56 offset to S-FN
  11591.         DB    $A5, L25F8-$-1  ; $57 offset to S-RND
  11592.         DB    $A7, L2627-$-1  ; $84 offset to S-PI
  11593.         DB    $A6, L2634-$-1  ; $8F offset to S-INKEY$
  11594.         DB    $C4, L268D-$-1  ; $E6 offset to S-BIN
  11595.         DB    $AA, L2668-$-1  ; $BF offset to S-SCREEN$
  11596.         DB    $AB, L2672-$-1  ; $C7 offset to S-ATTR
  11597.         DB    $A9, L267B-$-1  ; $CE offset to S-POINT
  11598.  
  11599.         DB    $00             ; zero end marker
  11600.  
  11601. ; --------------------------
  11602. ; Scanning function routines
  11603. ; --------------------------
  11604. ; These are the 11 subroutines accessed by the above table.
  11605. ; S-BIN and S-DECIMAL are the same
  11606. ; The 1-byte offset limits their location to within 255 bytes of their
  11607. ; entry in the table.
  11608.  
  11609. ; ->
  11610. ;; S-U-PLUS
  11611. L25AF:  RST     20H             ; NEXT-CHAR just ignore
  11612.         JP      L24FF           ; to S-LOOP-1
  11613.  
  11614. ; ---
  11615.  
  11616. ; ->
  11617. ;; S-QUOTE
  11618. L25B3:  RST     18H             ; GET-CHAR
  11619.         INC     HL              ; address next character (first in quotes)
  11620.         PUSH    HL              ; save start of quoted text.
  11621.         LD      BC,$0000        ; initialize length of string to zero.
  11622.         CALL    L250F           ; routine S-QUOTE-S
  11623.         JR      NZ,L25D9        ; forward to S-Q-PRMS if
  11624.  
  11625. ;; S-Q-AGAIN
  11626. L25BE:  CALL    L250F           ; routine S-QUOTE-S copies string until a
  11627.                                 ; quote is encountered
  11628.         JR      Z,L25BE         ; back to S-Q-AGAIN if two quotes WERE
  11629.                                 ; together.
  11630.  
  11631. ; but if just an isolated quote then that terminates the string.
  11632.  
  11633.         CALL    L2530           ; routine SYNTAX-Z
  11634.         JR      Z,L25D9         ; forward to S-Q-PRMS if checking syntax.
  11635.  
  11636.  
  11637.         RST     30H             ; BC-SPACES creates the space for true
  11638.                                 ; copy of string in workspace.
  11639.         POP     HL              ; re-fetch start of quoted text.
  11640.         PUSH    DE              ; save start in workspace.
  11641.  
  11642. ;; S-Q-COPY
  11643. L25CB:  LD      A,(HL)          ; fetch a character from source.
  11644.         INC     HL              ; advance source address.
  11645.         LD      (DE),A          ; place in destination.
  11646.         INC     DE              ; advance destination address.
  11647.         CP      $22             ; was it a '"' just copied ?
  11648.         JR      NZ,L25CB        ; back to S-Q-COPY to copy more if not
  11649.  
  11650.         LD      A,(HL)          ; fetch adjacent character from source.
  11651.         INC     HL              ; advance source address.
  11652.         CP      $22             ; is this '"' ? - i.e. two quotes together ?
  11653.         JR      Z,L25CB         ; to S-Q-COPY if so including just one of the
  11654.                                 ; pair of quotes.
  11655.  
  11656. ; proceed when terminating quote encountered.
  11657.  
  11658. ;; S-Q-PRMS
  11659. L25D9:  DEC     BC              ; decrease count by 1.
  11660.         POP     DE              ; restore start of string in workspace.
  11661.  
  11662. ;; S-STRING
  11663. L25DB:  LD      HL,$5C3B        ; Address FLAGS system variable.
  11664.         RES     6,(HL)          ; signal string result.
  11665.         BIT     7,(HL)          ; is syntax being checked.
  11666.         CALL    NZ,L2AB2        ; routine STK-STO-$ is called in runtime.
  11667.         JP      L2712           ; jump forward to S-CONT-2          ===>
  11668.  
  11669. ; ---
  11670.  
  11671. ; ->
  11672. ;; S-BRACKET
  11673. L25E8:  RST     20H             ; NEXT-CHAR
  11674.         CALL    L24FB           ; routine SCANNING is called recursively.
  11675.         CP      $29             ; is it the closing ')' ?
  11676.         JP      NZ,L1C8A        ; jump back to REPORT-C if not
  11677.                                 ; 'Nonsense in BASIC'
  11678.  
  11679.         RST     20H             ; NEXT-CHAR
  11680.         JP      L2712           ; jump forward to S-CONT-2          ===>
  11681.  
  11682. ; ---
  11683.  
  11684. ; ->
  11685. ;; S-FN
  11686. L25F5:  JP      L27BD           ; jump forward to S-FN-SBRN.
  11687.  
  11688. ; ---
  11689.  
  11690. ; ->
  11691. ;; S-RND
  11692. L25F8:  CALL    L2530           ; routine SYNTAX-Z
  11693.         JR      Z,L2625         ; forward to S-RND-END if checking syntax.
  11694.  
  11695.         LD      BC,($5C76)      ; fetch system variable SEED
  11696.         CALL    L2D2B           ; routine STACK-BC places on calculator stack
  11697.  
  11698.         RST     28H             ;; FP-CALC           ;s.
  11699.         DB    $A1             ;;stk-one            ;s,1.
  11700.         DB    $0F             ;;addition           ;s+1.
  11701.         DB    $34             ;;stk-data           ;
  11702.         DB    $37             ;;Exponent: $87,
  11703.                                 ;;Bytes: 1
  11704.         DB    $16             ;;(+00,+00,+00)      ;s+1,75.
  11705.         DB    $04             ;;multiply           ;(s+1)*75 = v
  11706.         DB    $34             ;;stk-data           ;v.
  11707.         DB    $80             ;;Bytes: 3
  11708.         DB    $41             ;;Exponent $91
  11709.         DB    $00,$00,$80     ;;(+00)              ;v,65537.
  11710.         DB    $32             ;;n-mod-m            ;remainder, result.
  11711.         DB    $02             ;;delete             ;remainder.
  11712.         DB    $A1             ;;stk-one            ;remainder, 1.
  11713.         DB    $03             ;;subtract           ;remainder - 1. = rnd
  11714.         DB    $31             ;;duplicate          ;rnd,rnd.
  11715.         DB    $38             ;;end-calc
  11716.  
  11717.         CALL    L2DA2           ; routine FP-TO-BC
  11718.         LD      ($5C76),BC      ; store in SEED for next starting point.
  11719.         LD      A,(HL)          ; fetch exponent
  11720.         AND     A               ; is it zero ?
  11721.         JR      Z,L2625         ; forward if so to S-RND-END
  11722.  
  11723.         SUB     $10             ; reduce exponent by 2^16
  11724.         LD      (HL),A          ; place back
  11725.  
  11726. ;; S-RND-END
  11727. L2625:  JR      L2630           ; forward to S-PI-END
  11728.  
  11729. ; ---
  11730.  
  11731. ; the number PI 3.14159...
  11732.  
  11733. ; ->
  11734. ;; S-PI
  11735. L2627:  CALL    L2530           ; routine SYNTAX-Z
  11736.         JR      Z,L2630         ; to S-PI-END if checking syntax.
  11737.  
  11738.         RST     28H             ;; FP-CALC
  11739.         DB    $A3             ;;stk-pi/2                          pi/2.
  11740.         DB    $38             ;;end-calc
  11741.  
  11742.         INC     (HL)            ; increment the exponent leaving pi
  11743.                                 ; on the calculator stack.
  11744.  
  11745. ;; S-PI-END
  11746. L2630:  RST     20H             ; NEXT-CHAR
  11747.         JP      L26C3           ; jump forward to S-NUMERIC
  11748.  
  11749. ; ---
  11750.  
  11751. ; ->
  11752. ;; S-INKEY$
  11753. L2634:  LD      BC,$105A        ; priority $10, operation code $1A ('read-in')
  11754.                                 ; +$40 for string result, numeric operand.
  11755.                                 ; set this up now in case we need to use the
  11756.                                 ; calculator.
  11757.         RST     20H             ; NEXT-CHAR
  11758.         CP      $23             ; '#' ?
  11759.         JP      Z,L270D         ; to S-PUSH-PO if so to use the calculator
  11760.                                 ; single operation
  11761.                                 ; to read from network/RS232 etc. .
  11762.  
  11763. ; else read a key from the keyboard.
  11764.  
  11765.         LD      HL,$5C3B        ; fetch FLAGS
  11766.         RES     6,(HL)          ; signal string result.
  11767.         BIT     7,(HL)          ; checking syntax ?
  11768.         JR      Z,L2665         ; forward to S-INK$-EN if so
  11769.  
  11770. ;===============================
  11771.                 IF BAS48_ONLY
  11772.                 CALL L028E
  11773.                 ELSE
  11774.                 JP L3B6C                ; Spectrum 128 patch
  11775.                 ENDIF
  11776. ;===============================
  11777.  
  11778. L2649:  LD      C,$00           ; the length of an empty string
  11779.         JR      NZ,L2660        ; to S-IK$-STK to store empty string if
  11780.                                 ; no key returned.
  11781.  
  11782.         CALL    L031E           ; routine K-TEST get main code in A
  11783.         JR      NC,L2660        ; to S-IK$-STK to stack null string if
  11784.                                 ; invalid
  11785.  
  11786.         DEC     D               ; D is expected to be FLAGS so set bit 3 $FF
  11787.                                 ; 'L' Mode so no keywords.
  11788.         LD      E,A             ; main key to A
  11789.                                 ; C is MODE 0 'KLC' from above still.
  11790.         CALL    L0333           ; routine K-DECODE
  11791. L2657:  PUSH    AF              ; save the code
  11792.         LD      BC,$0001        ; make room for one character
  11793.  
  11794.         RST     30H             ; BC-SPACES
  11795.         POP     AF              ; bring the code back
  11796.         LD      (DE),A          ; put the key in workspace
  11797.         LD      C,$01           ; set C length to one
  11798.  
  11799. ;; S-IK$-STK
  11800. L2660:  LD      B,$00           ; set high byte of length to zero
  11801.         CALL    L2AB2           ; routine STK-STO-$
  11802.  
  11803. ;; S-INK$-EN
  11804. L2665:  JP      L2712           ; to S-CONT-2            ===>
  11805.  
  11806. ; ---
  11807.  
  11808. ; ->
  11809. ;; S-SCREEN$
  11810. L2668:  CALL    L2522           ; routine S-2-COORD
  11811.         CALL    NZ,L2535        ; routine S-SCRN$-S
  11812.  
  11813.         RST     20H             ; NEXT-CHAR
  11814.         JP      L25DB           ; forward to S-STRING to stack result
  11815.  
  11816. ; ---
  11817.  
  11818. ; ->
  11819. ;; S-ATTR
  11820. L2672:  CALL    L2522           ; routine S-2-COORD
  11821.         CALL    NZ,L2580        ; routine S-ATTR-S
  11822.  
  11823.         RST     20H             ; NEXT-CHAR
  11824.         JR      L26C3           ; forward to S-NUMERIC
  11825.  
  11826. ; ---
  11827.  
  11828. ; ->
  11829. ;; S-POINT
  11830. L267B:  CALL    L2522           ; routine S-2-COORD
  11831.         CALL    NZ,L22CB        ; routine POINT-SUB
  11832.  
  11833.         RST     20H             ; NEXT-CHAR
  11834.         JR      L26C3           ; forward to S-NUMERIC
  11835.  
  11836. ; -----------------------------
  11837.  
  11838. ; ==> The branch was here if not in table.
  11839.  
  11840. ;; S-ALPHNUM
  11841. L2684:  CALL    L2C88           ; routine ALPHANUM checks if variable or
  11842.                                 ; a digit.
  11843.         JR      NC,L26DF        ; forward to S-NEGATE if not to consider
  11844.                                 ; a '-' character then functions.
  11845.  
  11846.         CP      $41             ; compare 'A'
  11847.         JR      NC,L26C9        ; forward to S-LETTER if alpha       ->
  11848.                                 ; else must have been numeric so continue
  11849.                                 ; into that routine.
  11850.  
  11851. ; This important routine is called during runtime and from LINE-SCAN
  11852. ; when a BASIC line is checked for syntax. It is this routine that
  11853. ; inserts, during syntax checking, the invisible floating point numbers
  11854. ; after the numeric expression. During runtime it just picks these
  11855. ; numbers up. It also handles BIN format numbers.
  11856.  
  11857. ; ->
  11858. ;; S-BIN
  11859. ;; S-DECIMAL
  11860. L268D:  CALL    L2530           ; routine SYNTAX-Z
  11861.         JR      NZ,L26B5        ; to S-STK-DEC in runtime
  11862.  
  11863. ; this route is taken when checking syntax.
  11864.  
  11865.         CALL    L2C9B           ; routine DEC-TO-FP to evaluate number
  11866.  
  11867.         RST     18H             ; GET-CHAR to fetch HL
  11868.         LD      BC,$0006        ; six locations required
  11869.         CALL    L1655           ; routine MAKE-ROOM
  11870.         INC     HL              ; to first new location
  11871.         LD      (HL),$0E        ; insert number marker
  11872.         INC     HL              ; address next
  11873.         EX      DE,HL           ; make DE destination.
  11874.         LD      HL,($5C65)      ; STKEND points to end of stack.
  11875.         LD      C,$05           ; result is five locations lower
  11876.         AND     A               ; prepare for true subtraction
  11877.         SBC     HL,BC           ; point to start of value.
  11878.         LD      ($5C65),HL      ; update STKEND as we are taking number.
  11879.         LDIR                    ; Copy five bytes to program location
  11880.         EX      DE,HL           ; transfer pointer to HL
  11881.         DEC     HL              ; adjust
  11882.         CALL    L0077           ; routine TEMP-PTR1 sets CH-ADD
  11883.         JR      L26C3           ; to S-NUMERIC to record nature of result
  11884.  
  11885. ; ---
  11886.  
  11887. ; branch here in runtime.
  11888.  
  11889. ;; S-STK-DEC
  11890. L26B5:  RST     18H             ; GET-CHAR positions HL at digit.
  11891.  
  11892. ;; S-SD-SKIP
  11893. L26B6:  INC     HL              ; advance pointer
  11894.         LD      A,(HL)          ; until we find
  11895.         CP      $0E             ; chr 14d - the number indicator
  11896.         JR      NZ,L26B6        ; to S-SD-SKIP until a match
  11897.                                 ; it has to be here.
  11898.  
  11899.         INC     HL              ; point to first byte of number
  11900.         CALL    L33B4           ; routine STACK-NUM stacks it
  11901.         LD      ($5C5D),HL      ; update system variable CH_ADD
  11902.  
  11903. ;; S-NUMERIC
  11904. L26C3:  SET     6,(IY+$01)      ; update FLAGS  - Signal numeric result
  11905.         JR      L26DD           ; forward to S-CONT-1               ===>
  11906.                                 ; actually S-CONT-2 is destination but why
  11907.                                 ; waste a byte on a jump when a JR will do.
  11908.                                 ; actually a JR L2712 can be used. Rats.
  11909.  
  11910. ; end of functions accessed from scanning functions table.
  11911.  
  11912. ; --------------------------
  11913. ; Scanning variable routines
  11914. ; --------------------------
  11915. ;
  11916. ;
  11917.  
  11918. ;; S-LETTER
  11919. L26C9:  CALL    L28B2           ; routine LOOK-VARS
  11920.         JP      C,L1C2E         ; jump back to REPORT-2 if not found
  11921.                                 ; 'Variable not found'
  11922.                                 ; but a variable is always 'found' if syntax
  11923.                                 ; is being checked.
  11924.  
  11925.         CALL    Z,L2996         ; routine STK-VAR considers a subscript/slice
  11926.         LD      A,($5C3B)       ; fetch FLAGS value
  11927.         CP      $C0             ; compare 11000000
  11928.         JR      C,L26DD         ; step forward to S-CONT-1 if string  ===>
  11929.  
  11930.         INC     HL              ; advance pointer
  11931.         CALL    L33B4           ; routine STACK-NUM
  11932.  
  11933. ;; S-CONT-1
  11934. L26DD:  JR      L2712           ; forward to S-CONT-2                 ===>
  11935.  
  11936. ; ----------------------------------------
  11937. ; -> the scanning branch was here if not alphanumeric.
  11938. ; All the remaining functions will be evaluated by a single call to the
  11939. ; calculator. The correct priority for the operation has to be placed in
  11940. ; the B register and the operation code, calculator literal in the C register.
  11941. ; the operation code has bit 7 set if result is numeric and bit 6 is
  11942. ; set if operand is numeric. so
  11943. ; $C0 = numeric result, numeric operand.            e.g. 'sin'
  11944. ; $80 = numeric result, string operand.             e.g. 'code'
  11945. ; $40 = string result, numeric operand.             e.g. 'str$'
  11946. ; $00 = string result, string operand.              e.g. 'val$'
  11947.  
  11948. ;; S-NEGATE
  11949. L26DF:  LD      BC,$09DB        ; prepare priority 09, operation code $C0 +
  11950.                                 ; 'negate' ($1B) - bits 6 and 7 set for numeric
  11951.                                 ; result and numeric operand.
  11952.  
  11953.         CP      $2D             ; is it '-' ?
  11954.         JR      Z,L270D         ; forward if so to S-PUSH-PO
  11955.  
  11956.         LD      BC,$1018        ; prepare priority $10, operation code 'val$' -
  11957.                                 ; bits 6 and 7 reset for string result and
  11958.                                 ; string operand.
  11959.        
  11960.         CP      $AE             ; is it 'VAL$' ?
  11961.         JR      Z,L270D         ; forward if so to S-PUSH-PO
  11962.  
  11963.         SUB     $AF             ; subtract token 'CODE' value to reduce
  11964.                                 ; functions 'CODE' to 'NOT' although the
  11965.                                 ; upper range is, as yet, unchecked.
  11966.                                 ; valid range would be $00 - $14.
  11967.  
  11968.         JP      C,L1C8A         ; jump back to REPORT-C with anything else
  11969.                                 ; 'Nonsense in BASIC'
  11970.  
  11971.         LD      BC,$04F0        ; prepare priority $04, operation $C0 +
  11972.                                 ; 'not' ($30)
  11973.  
  11974.         CP      $14             ; is it 'NOT'
  11975.         JR      Z,L270D         ; forward to S-PUSH-PO if so
  11976.  
  11977.         JP      NC,L1C8A        ; to REPORT-C if higher
  11978.                                 ; 'Nonsense in BASIC'
  11979.  
  11980.         LD      B,$10           ; priority $10 for all the rest
  11981.         ADD     A,$DC           ; make range $DC - $EF
  11982.                                 ; $C0 + 'code'($1C) thru 'chr$' ($2F)
  11983.  
  11984.         LD      C,A             ; transfer 'function' to C
  11985.         CP      $DF             ; is it 'sin' ?
  11986.         JR      NC,L2707        ; forward to S-NO-TO-$  with 'sin' through
  11987.                                 ; 'chr$' as operand is numeric.
  11988.  
  11989. ; all the rest 'cos' through 'chr$' give a numeric result except 'str$'
  11990. ; and 'chr$'.
  11991.  
  11992.         RES     6,C             ; signal string operand for 'code', 'val' and
  11993.                                 ; 'len'.
  11994.  
  11995. ;; S-NO-TO-$
  11996. L2707:  CP      $EE             ; compare 'str$'
  11997.         JR      C,L270D         ; forward to S-PUSH-PO if lower as result
  11998.                                 ; is numeric.
  11999.  
  12000.         RES     7,C             ; reset bit 7 of op code for 'str$', 'chr$'
  12001.                                 ; as result is string.
  12002.  
  12003. ; >> This is where they were all headed for.
  12004.  
  12005. ;; S-PUSH-PO
  12006. L270D:  PUSH    BC              ; push the priority and calculator operation
  12007.                                 ; code.
  12008.  
  12009.         RST     20H             ; NEXT-CHAR
  12010.         JP      L24FF           ; jump back to S-LOOP-1 to go round the loop
  12011.                                 ; again with the next character.
  12012.  
  12013. ; --------------------------------
  12014.  
  12015. ; ===>  there were many branches forward to here
  12016.  
  12017. ;; S-CONT-2
  12018. L2712:  RST     18H             ; GET-CHAR
  12019.  
  12020. ;; S-CONT-3
  12021. L2713:  CP      $28             ; is it '(' ?
  12022.         JR      NZ,L2723        ; forward to S-OPERTR if not    >
  12023.  
  12024.         BIT     6,(IY+$01)      ; test FLAGS - numeric or string result ?
  12025.         JR      NZ,L2734        ; forward to S-LOOP if numeric to evaluate  >
  12026.  
  12027. ; if a string preceded '(' then slice it.
  12028.  
  12029.         CALL    L2A52           ; routine SLICING
  12030.  
  12031.         RST     20H             ; NEXT-CHAR
  12032.         JR      L2713           ; back to S-CONT-3
  12033.  
  12034. ; ---------------------------
  12035.  
  12036. ; the branch was here when possibility of an operator '(' has been excluded.
  12037.  
  12038. ;; S-OPERTR
  12039. L2723:  LD      B,$00           ; prepare to add
  12040.         LD      C,A             ; possible operator to C
  12041.         LD      HL,L2795        ; Address: $2795 - tbl-of-ops
  12042.         CALL    L16DC           ; routine INDEXER
  12043.         JR      NC,L2734        ; forward to S-LOOP if not in table
  12044.  
  12045. ; but if found in table the priority has to be looked up.
  12046.  
  12047.         LD      C,(HL)          ; operation code to C ( B is still zero )
  12048.         LD      HL,L27B0 - $C3  ; $26ED is base of table
  12049.         ADD     HL,BC           ; index into table.
  12050.         LD      B,(HL)          ; priority to B.
  12051.  
  12052. ; ------------------
  12053. ; Scanning main loop
  12054. ; ------------------
  12055. ; the juggling act
  12056.  
  12057. ;; S-LOOP
  12058. L2734:  POP     DE              ; fetch last priority and operation
  12059.         LD      A,D             ; priority to A
  12060.         CP      B               ; compare with this one
  12061.         JR      C,L2773         ; forward to S-TIGHTER to execute the
  12062.                                 ; last operation before this one as it has
  12063.                                 ; higher priority.
  12064.  
  12065. ; the last priority was greater or equal this one.
  12066.  
  12067.         AND     A               ; if it is zero then so is this
  12068.         JP      Z,L0018         ; jump to exit via get-char pointing at
  12069.                                 ; next character.
  12070.                                 ; This may be the character after the
  12071.                                 ; expression or, if exiting a recursive call,
  12072.                                 ; the next part of the expression to be
  12073.                                 ; evaluated.
  12074.  
  12075.         PUSH    BC              ; save current priority/operation
  12076.                                 ; as it has lower precedence than the one
  12077.                                 ; now in DE.
  12078.  
  12079. ; the 'USR' function is special in that it is overloaded to give two types
  12080. ; of result.
  12081.  
  12082.         LD      HL,$5C3B        ; address FLAGS
  12083.         LD      A,E             ; new operation to A register
  12084.         CP      $ED             ; is it $C0 + 'usr-no' ($2D)  ?
  12085.         JR      NZ,L274C        ; forward to S-STK-LST if not
  12086.  
  12087.         BIT     6,(HL)          ; string result expected ?
  12088.                                 ; (from the lower priority operand we've
  12089.                                 ; just pushed on stack )
  12090.         JR      NZ,L274C        ; forward to S-STK-LST if numeric
  12091.                                 ; as operand bits match.
  12092.  
  12093.         LD      E,$99           ; reset bit 6 and substitute $19 'usr-$'
  12094.                                 ; for string operand.
  12095.  
  12096. ;; S-STK-LST
  12097. L274C:  PUSH    DE              ; now stack this priority/operation
  12098.         CALL    L2530           ; routine SYNTAX-Z
  12099.         JR      Z,L275B         ; forward to S-SYNTEST if checking syntax.
  12100.  
  12101.         LD      A,E             ; fetch the operation code
  12102.         AND     $3F             ; mask off the result/operand bits to leave
  12103.                                 ; a calculator literal.
  12104.         LD      B,A             ; transfer to B register
  12105.  
  12106. ; now use the calculator to perform the single operation - operand is on
  12107. ; the calculator stack.
  12108. ; Note. although the calculator is performing a single operation most
  12109. ; functions e.g. TAN are written using other functions and literals and
  12110. ; these in turn are written using further strings of calculator literals so
  12111. ; another level of magical recursion joins the juggling act for a while
  12112. ; as the calculator too is calling itself.
  12113.  
  12114.         RST     28H             ;; FP-CALC
  12115.         DB    $3B             ;;fp-calc-2
  12116. L2758:  DB    $38             ;;end-calc
  12117.  
  12118.         JR      L2764           ; forward to S-RUNTEST
  12119.  
  12120. ; ---
  12121.  
  12122. ; the branch was here if checking syntax only.
  12123.  
  12124. ;; S-SYNTEST
  12125. L275B:  LD      A,E             ; fetch the operation code to accumulator
  12126.         XOR     (IY+$01)        ; compare with bits of FLAGS
  12127.         AND     $40             ; bit 6 will be zero now if operand
  12128.                                 ; matched expected result.
  12129.  
  12130. ;; S-RPORT-C2
  12131. L2761:  JP      NZ,L1C8A        ; to REPORT-C if mismatch
  12132.                                 ; 'Nonsense in BASIC'
  12133.                                 ; else continue to set flags for next
  12134.  
  12135. ; the branch is to here in runtime after a successful operation.
  12136.  
  12137. ;; S-RUNTEST
  12138. L2764:  POP     DE              ; fetch the last operation from stack
  12139.         LD      HL,$5C3B        ; address FLAGS
  12140.         SET     6,(HL)          ; set default to numeric result in FLAGS
  12141.         BIT     7,E             ; test the operational result
  12142.         JR      NZ,L2770        ; forward to S-LOOPEND if numeric
  12143.  
  12144.         RES     6,(HL)          ; reset bit 6 of FLAGS to show string result.
  12145.  
  12146. ;; S-LOOPEND
  12147. L2770:  POP     BC              ; fetch the previous priority/operation
  12148.         JR      L2734           ; back to S-LOOP to perform these
  12149.  
  12150. ; ---
  12151.  
  12152. ; the branch was here when a stacked priority/operator had higher priority
  12153. ; than the current one.
  12154.  
  12155. ;; S-TIGHTER
  12156. L2773:  PUSH    DE              ; save high priority op on stack again
  12157.         LD      A,C             ; fetch lower priority operation code
  12158.         BIT     6,(IY+$01)      ; test FLAGS - Numeric or string result ?
  12159.         JR      NZ,L2790        ; forward to S-NEXT if numeric result
  12160.  
  12161. ; if this is lower priority yet has string then must be a comparison.
  12162. ; Since these can only be evaluated in context and were defaulted to
  12163. ; numeric in operator look up they must be changed to string equivalents.
  12164.  
  12165.         AND     $3F             ; mask to give true calculator literal
  12166.         ADD     A,$08           ; augment numeric literals to string
  12167.                                 ; equivalents.
  12168.                                 ; 'no-&-no'  => 'str-&-no'
  12169.                                 ; 'no-l-eql' => 'str-l-eql'
  12170.                                 ; 'no-gr-eq' => 'str-gr-eq'
  12171.                                 ; 'nos-neql' => 'strs-neql'
  12172.                                 ; 'no-grtr'  => 'str-grtr'
  12173.                                 ; 'no-less'  => 'str-less'
  12174.                                 ; 'nos-eql'  => 'strs-eql'
  12175.                                 ; 'addition' => 'strs-add'
  12176.         LD      C,A             ; put modified comparison operator back
  12177.         CP      $10             ; is it now 'str-&-no' ?
  12178.         JR      NZ,L2788        ; forward to S-NOT-AND  if not.
  12179.  
  12180.         SET     6,C             ; set numeric operand bit
  12181.         JR      L2790           ; forward to S-NEXT
  12182.  
  12183. ; ---
  12184.  
  12185. ;; S-NOT-AND
  12186. L2788:  JR      C,L2761         ; back to S-RPORT-C2 if less
  12187.                                 ; 'Nonsense in BASIC'.
  12188.                                 ; e.g. a$ * b$
  12189.  
  12190.         CP      $17             ; is it 'strs-add' ?
  12191.         JR      Z,L2790         ; forward to to S-NEXT if so
  12192.                                 ; (bit 6 and 7 are reset)
  12193.  
  12194.         SET     7,C             ; set numeric (Boolean) result for all others
  12195.  
  12196. ;; S-NEXT
  12197. L2790:  PUSH    BC              ; now save this priority/operation on stack
  12198.  
  12199.         RST     20H             ; NEXT-CHAR
  12200.         JP      L24FF           ; jump back to S-LOOP-1
  12201.  
  12202. ; ------------------
  12203. ; Table of operators
  12204. ; ------------------
  12205. ; This table is used to look up the calculator literals associated with
  12206. ; the operator character. The thirteen calculator operations $03 - $0F
  12207. ; have bits 6 and 7 set to signify a numeric result.
  12208. ; Some of these codes and bits may be altered later if the context suggests
  12209. ; a string comparison or operation.
  12210. ; that is '+', '=', '>', '<', '<=', '>=' or '<>'.
  12211.  
  12212. ;; tbl-of-ops
  12213. L2795:  DB    '+', $CF        ;        $C0 + 'addition'
  12214.         DB    '-', $C3        ;        $C0 + 'subtract'
  12215.         DB    '*', $C4        ;        $C0 + 'multiply'
  12216.         DB    '/', $C5        ;        $C0 + 'division'
  12217.         DB    '^', $C6        ;        $C0 + 'to-power'
  12218.         DB    '=', $CE        ;        $C0 + 'nos-eql'
  12219.         DB    '>', $CC        ;        $C0 + 'no-grtr'
  12220.         DB    '<', $CD        ;        $C0 + 'no-less'
  12221.  
  12222.         DB    $C7, $C9        ; '<='   $C0 + 'no-l-eql'
  12223.         DB    $C8, $CA        ; '>='   $C0 + 'no-gr-eql'
  12224.         DB    $C9, $CB        ; '<>'   $C0 + 'nos-neql'
  12225.         DB    $C5, $C7        ; 'OR'   $C0 + 'or'
  12226.         DB    $C6, $C8        ; 'AND'  $C0 + 'no-&-no'
  12227.  
  12228.         DB    $00             ; zero end-marker.
  12229.  
  12230.  
  12231. ; -------------------
  12232. ; Table of priorities
  12233. ; -------------------
  12234. ; This table is indexed with the operation code obtained from the above
  12235. ; table $C3 - $CF to obtain the priority for the respective operation.
  12236.  
  12237. ;; tbl-priors
  12238. L27B0:  DB    $06             ; '-'   opcode $C3
  12239.         DB    $08             ; '*'   opcode $C4
  12240.         DB    $08             ; '/'   opcode $C5
  12241.         DB    $0A             ; '^'   opcode $C6
  12242.         DB    $02             ; 'OR'  opcode $C7
  12243.         DB    $03             ; 'AND' opcode $C8
  12244.         DB    $05             ; '<='  opcode $C9
  12245.         DB    $05             ; '>='  opcode $CA
  12246.         DB    $05             ; '<>'  opcode $CB
  12247.         DB    $05             ; '>'   opcode $CC
  12248.         DB    $05             ; '<'   opcode $CD
  12249.         DB    $05             ; '='   opcode $CE
  12250.         DB    $06             ; '+'   opcode $CF
  12251.  
  12252. ; ----------------------
  12253. ; Scanning function (FN)
  12254. ; ----------------------
  12255. ; This routine deals with user-defined functions.
  12256. ; The definition can be anywhere in the program area but these are best
  12257. ; placed near the start of the program as we shall see.
  12258. ; The evaluation process is quite complex as the Spectrum has to parse two
  12259. ; statements at the same time. Syntax of both has been checked previously
  12260. ; and hidden locations have been created immediately after each argument
  12261. ; of the DEF FN statement. Each of the arguments of the FN function is
  12262. ; evaluated by SCANNING and placed in the hidden locations. Then the
  12263. ; expression to the right of the DEF FN '=' is evaluated by SCANNING and for
  12264. ; any variables encountered, a search is made in the DEF FN variable list
  12265. ; in the program area before searching in the normal variables area.
  12266. ;
  12267. ; Recursion is not allowed: i.e. the definition of a function should not use
  12268. ; the same function, either directly or indirectly ( through another function).
  12269. ; You'll normally get error 4, ('Out of memory'), although sometimes the sytem
  12270. ; will crash. - Vickers, Pitman 1984.
  12271. ;
  12272. ; As the definition is just an expression, there would seem to be no means
  12273. ; of breaking out of such recursion.
  12274. ; However, by the clever use of string expressions and VAL, such recursion is
  12275. ; possible.
  12276. ; e.g. DEF FN a(n) = VAL "n+FN a(n-1)+0" ((n<1) * 10 + 1 TO )
  12277. ; will evaluate the full 11-character expression for all values where n is
  12278. ; greater than zero but just the 11th character, "0", when n drops to zero
  12279. ; thereby ending the recursion producing the correct result.
  12280. ; Recursive string functions are possible using VAL$ instead of VAL and the
  12281. ; null string as the final addend.
  12282. ; - from a turn of the century newsgroup discussion initiated by Mike Wynne.
  12283.  
  12284. ;; S-FN-SBRN
  12285. L27BD:  CALL    L2530           ; routine SYNTAX-Z
  12286.         JR      NZ,L27F7        ; forward to SF-RUN in runtime
  12287.  
  12288.  
  12289.         RST     20H             ; NEXT-CHAR
  12290.         CALL    L2C8D           ; routine ALPHA check for letters A-Z a-z
  12291.         JP      NC,L1C8A        ; jump back to REPORT-C if not
  12292.                                 ; 'Nonsense in BASIC'
  12293.  
  12294.  
  12295.         RST     20H             ; NEXT-CHAR
  12296.         CP      $24             ; is it '$' ?
  12297.         PUSH    AF              ; save character and flags
  12298.         JR      NZ,L27D0        ; forward to SF-BRKT-1 with numeric function
  12299.  
  12300.  
  12301.         RST     20H             ; NEXT-CHAR
  12302.  
  12303. ;; SF-BRKT-1
  12304. L27D0:  CP      $28             ; is '(' ?
  12305.         JR      NZ,L27E6        ; forward to SF-RPRT-C if not
  12306.                                 ; 'Nonsense in BASIC'
  12307.  
  12308.  
  12309.         RST     20H             ; NEXT-CHAR
  12310.         CP      $29             ; is it ')' ?
  12311.         JR      Z,L27E9         ; forward to SF-FLAG-6 if no arguments.
  12312.  
  12313. ;; SF-ARGMTS
  12314. L27D9:  CALL    L24FB           ; routine SCANNING checks each argument
  12315.                                 ; which may be an expression.
  12316.  
  12317.         RST     18H             ; GET-CHAR
  12318.         CP      $2C             ; is it a ',' ?
  12319.         JR      NZ,L27E4        ; forward if not to SF-BRKT-2 to test bracket
  12320.  
  12321.  
  12322.         RST     20H             ; NEXT-CHAR if a comma was found
  12323.         JR      L27D9           ; back to SF-ARGMTS to parse all arguments.
  12324.  
  12325. ; ---
  12326.  
  12327. ;; SF-BRKT-2
  12328. L27E4:  CP      $29             ; is character the closing ')' ?
  12329.  
  12330. ;; SF-RPRT-C
  12331. L27E6:  JP      NZ,L1C8A        ; jump to REPORT-C
  12332.                                 ; 'Nonsense in BASIC'
  12333.  
  12334. ; at this point any optional arguments have had their syntax checked.
  12335.  
  12336. ;; SF-FLAG-6
  12337. L27E9:  RST     20H             ; NEXT-CHAR
  12338.         LD      HL,$5C3B        ; address system variable FLAGS
  12339.         RES     6,(HL)          ; signal string result
  12340.         POP     AF              ; restore test against '$'.
  12341.         JR      Z,L27F4         ; forward to SF-SYN-EN if string function.
  12342.  
  12343.         SET     6,(HL)          ; signal numeric result
  12344.  
  12345. ;; SF-SYN-EN
  12346. L27F4:  JP      L2712           ; jump back to S-CONT-2 to continue scanning.
  12347.  
  12348. ; ---
  12349.  
  12350. ; the branch was here in runtime.
  12351.  
  12352. ;; SF-RUN
  12353. L27F7:  RST     20H             ; NEXT-CHAR fetches name
  12354.         AND     $DF             ; AND 11101111 - reset bit 5 - upper-case.
  12355.         LD      B,A             ; save in B
  12356.  
  12357.         RST     20H             ; NEXT-CHAR
  12358.         SUB     $24             ; subtract '$'
  12359.         LD      C,A             ; save result in C
  12360.         JR      NZ,L2802        ; forward if not '$' to SF-ARGMT1
  12361.  
  12362.         RST     20H             ; NEXT-CHAR advances to bracket
  12363.  
  12364. ;; SF-ARGMT1
  12365. L2802:  RST     20H             ; NEXT-CHAR advances to start of argument
  12366.         PUSH    HL              ; save address
  12367.         LD      HL,($5C53)      ; fetch start of program area from PROG
  12368.         DEC     HL              ; the search starting point is the previous
  12369.                                 ; location.
  12370.  
  12371. ;; SF-FND-DF
  12372. L2808:  LD      DE,$00CE        ; search is for token 'DEF FN' in E,
  12373.                                 ; statement count in D.
  12374.         PUSH    BC              ; save C the string test, and B the letter.
  12375.         CALL    L1D86           ; routine LOOK-PROG will search for token.
  12376.         POP     BC              ; restore BC.
  12377.         JR      NC,L2814        ; forward to SF-CP-DEF if a match was found.
  12378.  
  12379.  
  12380. ;; REPORT-P
  12381. L2812:  RST     08H             ; ERROR-1
  12382.         DB    $18             ; Error Report: FN without DEF
  12383.  
  12384. ;; SF-CP-DEF
  12385. L2814:  PUSH    HL              ; save address of DEF FN
  12386.         CALL    L28AB           ; routine FN-SKPOVR skips over white-space etc.
  12387.                                 ; without disturbing CH-ADD.
  12388.         AND     $DF             ; make fetched character upper-case.
  12389.         CP      B               ; compare with FN name
  12390.         JR      NZ,L2825        ; forward to SF-NOT-FD if no match.
  12391.  
  12392. ; the letters match so test the type.
  12393.  
  12394.         CALL    L28AB           ; routine FN-SKPOVR skips white-space
  12395.         SUB     $24             ; subtract '$' from fetched character
  12396.         CP      C               ; compare with saved result of same operation
  12397.                                 ; on FN name.
  12398.         JR      Z,L2831         ; forward to SF-VALUES with a match.
  12399.  
  12400. ; the letters matched but one was string and the other numeric.
  12401.  
  12402. ;; SF-NOT-FD
  12403. L2825:  POP     HL              ; restore search point.
  12404.         DEC     HL              ; make location before
  12405.         LD      DE,$0200        ; the search is to be for the end of the
  12406.                                 ; current definition - 2 statements forward.
  12407.         PUSH    BC              ; save the letter/type
  12408.         CALL    L198B           ; routine EACH-STMT steps past rejected
  12409.                                 ; definition.
  12410.         POP     BC              ; restore letter/type
  12411.         JR      L2808           ; back to SF-FND-DF to continue search
  12412.  
  12413. ; ---
  12414.  
  12415. ; Success!
  12416. ; the branch was here with matching letter and numeric/string type.
  12417.  
  12418. ;; SF-VALUES
  12419. L2831:  AND     A               ; test A ( will be zero if string '$' - '$' )
  12420.  
  12421.         CALL    Z,L28AB         ; routine FN-SKPOVR advances HL past '$'.
  12422.  
  12423.         POP     DE              ; discard pointer to 'DEF FN'.
  12424.         POP     DE              ; restore pointer to first FN argument.
  12425.         LD      ($5C5D),DE      ; save in CH_ADD
  12426.  
  12427.         CALL    L28AB           ; routine FN-SKPOVR advances HL past '('
  12428.         PUSH    HL              ; save start address in DEF FN  ***
  12429.         CP      $29             ; is character a ')' ?
  12430.         JR      Z,L2885         ; forward to SF-R-BR-2 if no arguments.
  12431.  
  12432. ;; SF-ARG-LP
  12433. L2843:  INC     HL              ; point to next character.
  12434.         LD      A,(HL)          ; fetch it.
  12435.         CP      $0E             ; is it the number marker
  12436.         LD      D,$40           ; signal numeric in D.
  12437.         JR      Z,L2852         ; forward to SF-ARG-VL if numeric.
  12438.  
  12439.         DEC     HL              ; back to letter
  12440.         CALL    L28AB           ; routine FN-SKPOVR skips any white-space
  12441.         INC     HL              ; advance past the expected '$' to
  12442.                                 ; the 'hidden' marker.
  12443.         LD      D,$00           ; signal string.
  12444.  
  12445. ;; SF-ARG-VL
  12446. L2852:  INC     HL              ; now address first of 5-byte location.
  12447.         PUSH    HL              ; save address in DEF FN statement
  12448.         PUSH    DE              ; save D - result type
  12449.  
  12450.         CALL    L24FB           ; routine SCANNING evaluates expression in
  12451.                                 ; the FN statement setting FLAGS and leaving
  12452.                                 ; result as last value on calculator stack.
  12453.  
  12454.         POP     AF              ; restore saved result type to A
  12455.  
  12456.         XOR     (IY+$01)        ; xor with FLAGS
  12457.         AND     $40             ; and with 01000000 to test bit 6
  12458.         JR      NZ,L288B        ; forward to REPORT-Q if type mismatch.
  12459.                                 ; 'Parameter error'
  12460.  
  12461.         POP     HL              ; pop the start address in DEF FN statement
  12462.         EX      DE,HL           ; transfer to DE ?? pop straight into de ?
  12463.  
  12464.         LD      HL,($5C65)      ; set HL to STKEND location after value
  12465.         LD      BC,$0005        ; five bytes to move
  12466.         SBC     HL,BC           ; decrease HL by 5 to point to start.
  12467.         LD      ($5C65),HL      ; set STKEND 'removing' value from stack.
  12468.  
  12469.         LDIR                    ; copy value into DEF FN statement
  12470.         EX      DE,HL           ; set HL to location after value in DEF FN
  12471.         DEC     HL              ; step back one
  12472.         CALL    L28AB           ; routine FN-SKPOVR gets next valid character
  12473.         CP      $29             ; is it ')' end of arguments ?
  12474.         JR      Z,L2885         ; forward to SF-R-BR-2 if so.
  12475.  
  12476. ; a comma separator has been encountered in the DEF FN argument list.
  12477.  
  12478.         PUSH    HL              ; save position in DEF FN statement
  12479.  
  12480.         RST     18H             ; GET-CHAR from FN statement
  12481.         CP      $2C             ; is it ',' ?
  12482.         JR      NZ,L288B        ; forward to REPORT-Q if not
  12483.                                 ; 'Parameter error'
  12484.  
  12485.         RST     20H             ; NEXT-CHAR in FN statement advances to next
  12486.                                 ; argument.
  12487.  
  12488.         POP     HL              ; restore DEF FN pointer
  12489.         CALL    L28AB           ; routine FN-SKPOVR advances to corresponding
  12490.                                 ; argument.
  12491.  
  12492.         JR      L2843           ; back to SF-ARG-LP looping until all
  12493.                                 ; arguments are passed into the DEF FN
  12494.                                 ; hidden locations.
  12495.  
  12496. ; ---
  12497.  
  12498. ; the branch was here when all arguments passed.
  12499.  
  12500. ;; SF-R-BR-2
  12501. L2885:  PUSH    HL              ; save location of ')' in DEF FN
  12502.  
  12503.         RST     18H             ; GET-CHAR gets next character in FN
  12504.         CP      $29             ; is it a ')' also ?
  12505.         JR      Z,L288D         ; forward to SF-VALUE if so.
  12506.  
  12507.  
  12508. ;; REPORT-Q
  12509. L288B:  RST     08H             ; ERROR-1
  12510.         DB    $19             ; Error Report: Parameter error
  12511.  
  12512. ;; SF-VALUE
  12513. L288D:  POP     DE              ; location of ')' in DEF FN to DE.
  12514.         EX      DE,HL           ; now to HL, FN ')' pointer to DE.
  12515.         LD      ($5C5D),HL      ; initialize CH_ADD to this value.
  12516.  
  12517. ; At this point the start of the DEF FN argument list is on the machine stack.
  12518. ; We also have to consider that this defined function may form part of the
  12519. ; definition of another defined function (though not itself).
  12520. ; As this defined function may be part of a hierarchy of defined functions
  12521. ; currently being evaluated by recursive calls to SCANNING, then we have to
  12522. ; preserve the original value of DEFADD and not assume that it is zero.
  12523.  
  12524.         LD      HL,($5C0B)      ; get original DEFADD address
  12525.         EX      (SP),HL         ; swap with DEF FN address on stack ***
  12526.         LD      ($5C0B),HL      ; set DEFADD to point to this argument list
  12527.                                 ; during scanning.
  12528.  
  12529.         PUSH    DE              ; save FN ')' pointer.
  12530.  
  12531.         RST     20H             ; NEXT-CHAR advances past ')' in define
  12532.  
  12533.         RST     20H             ; NEXT-CHAR advances past '=' to expression
  12534.  
  12535.         CALL    L24FB           ; routine SCANNING evaluates but searches
  12536.                                 ; initially for variables at DEFADD
  12537.  
  12538.         POP     HL              ; pop the FN ')' pointer
  12539.         LD      ($5C5D),HL      ; set CH_ADD to this
  12540.         POP     HL              ; pop the original DEFADD value
  12541.         LD      ($5C0B),HL      ; and re-insert into DEFADD system variable.
  12542.  
  12543.         RST     20H             ; NEXT-CHAR advances to character after ')'
  12544.         JP      L2712           ; to S-CONT-2 - to continue current
  12545.                                 ; invocation of scanning
  12546.  
  12547. ; --------------------
  12548. ; Used to parse DEF FN
  12549. ; --------------------
  12550. ; e.g. DEF FN     s $ ( x )     =  b     $ (  TO  x  ) : REM exaggerated
  12551. ;
  12552. ; This routine is used 10 times to advance along a DEF FN statement
  12553. ; skipping spaces and colour control codes. It is similar to NEXT-CHAR
  12554. ; which is, at the same time, used to skip along the corresponding FN function
  12555. ; except the latter has to deal with AT and TAB characters in string
  12556. ; expressions. These cannot occur in a program area so this routine is
  12557. ; simpler as both colour controls and their parameters are less than space.
  12558.  
  12559. ;; FN-SKPOVR
  12560. L28AB:  INC     HL              ; increase pointer
  12561.         LD      A,(HL)          ; fetch addressed character
  12562.         CP      $21             ; compare with space + 1
  12563.         JR      C,L28AB         ; back to FN-SKPOVR if less
  12564.  
  12565.         RET                     ; return pointing to a valid character.
  12566.  
  12567. ; ---------
  12568. ; LOOK-VARS
  12569. ; ---------
  12570. ;
  12571. ;
  12572.  
  12573. ;; LOOK-VARS
  12574. L28B2:  SET     6,(IY+$01)      ; update FLAGS - presume numeric result
  12575.  
  12576.         RST     18H             ; GET-CHAR
  12577.         CALL    L2C8D           ; routine ALPHA tests for A-Za-z
  12578.         JP      NC,L1C8A        ; jump to REPORT-C if not.
  12579.                                 ; 'Nonsense in BASIC'
  12580.  
  12581.         PUSH    HL              ; save pointer to first letter       ^1
  12582.         AND     $1F             ; mask lower bits, 1 - 26 decimal     000xxxxx
  12583.         LD      C,A             ; store in C.
  12584.  
  12585.         RST     20H             ; NEXT-CHAR
  12586.         PUSH    HL              ; save pointer to second character   ^2
  12587.         CP      $28             ; is it '(' - an array ?
  12588.         JR      Z,L28EF         ; forward to V-RUN/SYN if so.
  12589.  
  12590.         SET     6,C             ; set 6 signaling string if solitary  010
  12591.         CP      $24             ; is character a '$' ?
  12592.         JR      Z,L28DE         ; forward to V-STR-VAR
  12593.  
  12594.         SET     5,C             ; signal numeric                       011
  12595.         CALL    L2C88           ; routine ALPHANUM sets carry if second
  12596.                                 ; character is alphanumeric.
  12597.         JR      NC,L28E3        ; forward to V-TEST-FN if just one character
  12598.  
  12599. ; it is more than one character but re-test current character so that 6 reset
  12600. ; Note. this is a rare lack of elegance. Bit 6 could be reset once before
  12601. ; entering the loop. Another puzzle is that this loop renders the similar
  12602. ; loop at V-PASS redundant.
  12603.  
  12604. ;; V-CHAR
  12605. L28D4:  CALL    L2C88           ; routine ALPHANUM
  12606.         JR      NC,L28EF        ; to V-RUN/SYN when no more
  12607.  
  12608.         RES     6,C             ; make long named type                 001
  12609.  
  12610.         RST     20H             ; NEXT-CHAR
  12611.         JR      L28D4           ; loop back to V-CHAR
  12612.  
  12613. ; ---
  12614.  
  12615.  
  12616. ;; V-STR-VAR
  12617. L28DE:  RST     20H             ; NEXT-CHAR advances past '$'
  12618.         RES     6,(IY+$01)      ; update FLAGS - signal string result.
  12619.  
  12620. ;; V-TEST-FN
  12621. L28E3:  LD      A,($5C0C)       ; load A with DEFADD_hi
  12622.         AND     A               ; and test for zero.
  12623.         JR      Z,L28EF         ; forward to V-RUN/SYN if a defined function
  12624.                                 ; is not being evaluated.
  12625.  
  12626. ; Note.
  12627.  
  12628.         CALL    L2530           ; routine SYNTAX-Z
  12629.         JP      NZ,L2951        ; JUMP to STK-F-ARG in runtime and then
  12630.                                 ; back to this point if no variable found.
  12631.  
  12632. ;; V-RUN/SYN
  12633. L28EF:  LD      B,C             ; save flags in B
  12634.         CALL    L2530           ; routine SYNTAX-Z
  12635.         JR      NZ,L28FD        ; to V-RUN to look for the variable in runtime
  12636.  
  12637. ; if checking syntax the letter is not returned
  12638.  
  12639.         LD      A,C             ; copy letter/flags to A
  12640.         AND     $E0             ; and with 11100000 to get rid of the letter
  12641.         SET     7,A             ; use spare bit to signal checking syntax.
  12642.         LD      C,A             ; and transfer to C.
  12643.         JR      L2934           ; forward to V-SYNTAX
  12644.  
  12645. ; ---
  12646.  
  12647. ; but in runtime search for the variable.
  12648.  
  12649. ;; V-RUN
  12650. L28FD:  LD      HL,($5C4B)      ; set HL to start of variables from VARS
  12651.  
  12652. ;; V-EACH
  12653. L2900:  LD      A,(HL)          ; get first character
  12654.         AND     $7F             ; and with 01111111
  12655.                                 ; ignoring bit 7 which distinguishes
  12656.                                 ; arrays or for/next variables.
  12657.  
  12658.         JR      Z,L2932         ; to V-80-BYTE if zero as must be 10000000
  12659.                                 ; the variables end-marker.
  12660.  
  12661.         CP      C               ; compare with supplied value.
  12662.         JR      NZ,L292A        ; forward to V-NEXT if no match.
  12663.  
  12664.         RLA                     ; destructively test
  12665.         ADD     A,A             ; bits 5 and 6 of A
  12666.                                 ; jumping if bit 5 reset or 6 set
  12667.  
  12668.         JP      P,L293F         ; to V-FOUND-2  strings and arrays
  12669.  
  12670.         JR      C,L293F         ; to V-FOUND-2  simple and for next
  12671.  
  12672. ; leaving long name variables.
  12673.  
  12674.         POP     DE              ; pop pointer to 2nd. char
  12675.         PUSH    DE              ; save it again
  12676.         PUSH    HL              ; save variable first character pointer
  12677.  
  12678. ;; V-MATCHES
  12679. L2912:  INC     HL              ; address next character in vars area
  12680.  
  12681. ;; V-SPACES
  12682. L2913:  LD      A,(DE)          ; pick up letter from prog area
  12683.         INC     DE              ; and advance address
  12684.         CP      $20             ; is it a space
  12685.         JR      Z,L2913         ; back to V-SPACES until non-space
  12686.  
  12687.         OR      $20             ; convert to range 1 - 26.
  12688.         CP      (HL)            ; compare with addressed variables character
  12689.         JR      Z,L2912         ; loop back to V-MATCHES if a match on an
  12690.                                 ; intermediate letter.
  12691.  
  12692.         OR      $80             ; now set bit 7 as last character of long
  12693.                                 ; names are inverted.
  12694.         CP      (HL)            ; compare again
  12695.         JR      NZ,L2929        ; forward to V-GET-PTR if no match
  12696.  
  12697. ; but if they match check that this is also last letter in prog area
  12698.  
  12699.         LD      A,(DE)          ; fetch next character
  12700.         CALL    L2C88           ; routine ALPHANUM sets carry if not alphanum
  12701.         JR      NC,L293E        ; forward to V-FOUND-1 with a full match.
  12702.  
  12703. ;; V-GET-PTR
  12704. L2929:  POP     HL              ; pop saved pointer to char 1
  12705.  
  12706. ;; V-NEXT
  12707. L292A:  PUSH    BC              ; save flags
  12708.         CALL    L19B8           ; routine NEXT-ONE gets next variable in DE
  12709.         EX      DE,HL           ; transfer to HL.
  12710.         POP     BC              ; restore the flags
  12711.         JR      L2900           ; loop back to V-EACH
  12712.                                 ; to compare each variable
  12713.  
  12714. ; ---
  12715.  
  12716. ;; V-80-BYTE
  12717. L2932:  SET     7,B             ; will signal not found
  12718.  
  12719. ; the branch was here when checking syntax
  12720.  
  12721. ;; V-SYNTAX
  12722. L2934:  POP     DE              ; discard the pointer to 2nd. character  v2
  12723.                                 ; in BASIC line/workspace.
  12724.  
  12725.         RST     18H             ; GET-CHAR gets character after variable name.
  12726.         CP      $28             ; is it '(' ?
  12727.         JR      Z,L2943         ; forward to V-PASS
  12728.                                 ; Note. could go straight to V-END ?
  12729.  
  12730.         SET     5,B             ; signal not an array
  12731.         JR      L294B           ; forward to V-END
  12732.  
  12733. ; ---------------------------
  12734.  
  12735. ; the jump was here when a long name matched and HL pointing to last character
  12736. ; in variables area.
  12737.  
  12738. ;; V-FOUND-1
  12739. L293E:  POP     DE              ; discard pointer to first var letter
  12740.  
  12741. ; the jump was here with all other matches HL points to first var char.
  12742.  
  12743. ;; V-FOUND-2
  12744. L293F:  POP     DE              ; discard pointer to 2nd prog char       v2
  12745.         POP     DE              ; drop pointer to 1st prog char          v1
  12746.         PUSH    HL              ; save pointer to last char in vars
  12747.  
  12748.         RST     18H             ; GET-CHAR
  12749.  
  12750. ;; V-PASS
  12751. L2943:  CALL    L2C88           ; routine ALPHANUM
  12752.         JR      NC,L294B        ; forward to V-END if not
  12753.  
  12754. ; but it never will be as we advanced past long-named variables earlier.
  12755.  
  12756.         RST     20H             ; NEXT-CHAR
  12757.         JR      L2943           ; back to V-PASS
  12758.  
  12759. ; ---
  12760.  
  12761. ;; V-END
  12762. L294B:  POP     HL              ; pop the pointer to first character in
  12763.                                 ; BASIC line/workspace.
  12764.         RL      B               ; rotate the B register left
  12765.                                 ; bit 7 to carry
  12766.         BIT     6,B             ; test the array indicator bit.
  12767.         RET                     ; return
  12768.  
  12769. ; -----------------------
  12770. ; Stack function argument
  12771. ; -----------------------
  12772. ; This branch is taken from LOOK-VARS when a defined function is currently
  12773. ; being evaluated.
  12774. ; Scanning is evaluating the expression after the '=' and the variable
  12775. ; found could be in the argument list to the left of the '=' or in the
  12776. ; normal place after the program. Preference will be given to the former.
  12777. ; The variable name to be matched is in C.
  12778.  
  12779. ;; STK-F-ARG
  12780. L2951:  LD      HL,($5C0B)      ; set HL to DEFADD
  12781.         LD      A,(HL)          ; load the first character
  12782.         CP      $29             ; is it ')' ?
  12783.         JP      Z,L28EF         ; JUMP back to V-RUN/SYN, if so, as there are
  12784.                                 ; no arguments.
  12785.  
  12786. ; but proceed to search argument list of defined function first if not empty.
  12787.  
  12788. ;; SFA-LOOP
  12789. L295A:  LD      A,(HL)          ; fetch character again.
  12790.         OR      $60             ; or with 01100000 presume a simple variable.
  12791.         LD      B,A             ; save result in B.
  12792.         INC     HL              ; address next location.
  12793.         LD      A,(HL)          ; pick up byte.
  12794.         CP      $0E             ; is it the number marker ?
  12795.         JR      Z,L296B         ; forward to SFA-CP-VR if so.
  12796.  
  12797. ; it was a string. White-space may be present but syntax has been checked.
  12798.  
  12799.         DEC     HL              ; point back to letter.
  12800.         CALL    L28AB           ; routine FN-SKPOVR skips to the '$'
  12801.         INC     HL              ; now address the hidden marker.
  12802.         RES     5,B             ; signal a string variable.
  12803.  
  12804. ;; SFA-CP-VR
  12805. L296B:  LD      A,B             ; transfer found variable letter to A.
  12806.         CP      C               ; compare with expected.
  12807.         JR      Z,L2981         ; forward to SFA-MATCH with a match.
  12808.  
  12809.         INC     HL              ; step
  12810.         INC     HL              ; past
  12811.         INC     HL              ; the
  12812.         INC     HL              ; five
  12813.         INC     HL              ; bytes.
  12814.  
  12815.         CALL    L28AB           ; routine FN-SKPOVR skips to next character
  12816.         CP      $29             ; is it ')' ?
  12817.         JP      Z,L28EF         ; jump back if so to V-RUN/SYN to look in
  12818.                                 ; normal variables area.
  12819.  
  12820.         CALL    L28AB           ; routine FN-SKPOVR skips past the ','
  12821.                                 ; all syntax has been checked and these
  12822.                                 ; things can be taken as read.
  12823.         JR      L295A           ; back to SFA-LOOP while there are more
  12824.                                 ; arguments.
  12825.  
  12826. ; ---
  12827.  
  12828. ;; SFA-MATCH
  12829. L2981:  BIT     5,C             ; test if numeric
  12830.         JR      NZ,L2991        ; to SFA-END if so as will be stacked
  12831.                                 ; by scanning
  12832.  
  12833.         INC     HL              ; point to start of string descriptor
  12834.         LD      DE,($5C65)      ; set DE to STKEND
  12835.         CALL    L33C0           ; routine MOVE-FP puts parameters on stack.
  12836.         EX      DE,HL           ; new free location to HL.
  12837.         LD      ($5C65),HL      ; use it to set STKEND system variable.
  12838.  
  12839. ;; SFA-END
  12840. L2991:  POP     DE              ; discard
  12841.         POP     DE              ; pointers.
  12842.         XOR     A               ; clear carry flag.
  12843.         INC     A               ; and zero flag.
  12844.         RET                     ; return.
  12845.  
  12846. ; ------------------------
  12847. ; Stack variable component
  12848. ; ------------------------
  12849. ; This is called to evaluate a complex structure that has been found, in
  12850. ; runtime, by LOOK-VARS in the variables area.
  12851. ; In this case HL points to the initial letter, bits 7-5
  12852. ; of which indicate the type of variable.
  12853. ; 010 - simple string, 110 - string array, 100 - array of numbers.
  12854. ;
  12855. ; It is called from CLASS-01 when assigning to a string or array including
  12856. ; a slice.
  12857. ; It is called from SCANNING to isolate the required part of the structure.
  12858. ;
  12859. ; An important part of the runtime process is to check that the number of
  12860. ; dimensions of the variable match the number of subscripts supplied in the
  12861. ; BASIC line.
  12862. ;
  12863. ; If checking syntax,
  12864. ; the B register, which counts dimensions is set to zero (256) to allow
  12865. ; the loop to continue till all subscripts are checked. While doing this it
  12866. ; is reading dimension sizes from some arbitrary area of memory. Although
  12867. ; these are meaningless it is of no concern as the limit is never checked by
  12868. ; int-exp during syntax checking.
  12869. ;
  12870. ; The routine is also called from the syntax path of DIM command to check the
  12871. ; syntax of both string and numeric arrays definitions except that bit 6 of C
  12872. ; is reset so both are checked as numeric arrays. This ruse avoids a terminal
  12873. ; slice being accepted as part of the DIM command.
  12874. ; All that is being checked is that there are a valid set of comma-separated
  12875. ; expressions before a terminal ')', although, as above, it will still go
  12876. ; through the motions of checking dummy dimension sizes.
  12877.  
  12878. ;; STK-VAR
  12879. L2996:  XOR     A               ; clear A
  12880.         LD      B,A             ; and B, the syntax dimension counter (256)
  12881.         BIT     7,C             ; checking syntax ?
  12882.         JR      NZ,L29E7        ; forward to SV-COUNT if so.
  12883.  
  12884. ; runtime evaluation.
  12885.  
  12886.         BIT     7,(HL)          ; will be reset if a simple string.
  12887.         JR      NZ,L29AE        ; forward to SV-ARRAYS otherwise
  12888.  
  12889.         INC     A               ; set A to 1, simple string.
  12890.  
  12891. ;; SV-SIMPLE$
  12892. L29A1:  INC     HL              ; address length low
  12893.         LD      C,(HL)          ; place in C
  12894.         INC     HL              ; address length high
  12895.         LD      B,(HL)          ; place in B
  12896.         INC     HL              ; address start of string
  12897.         EX      DE,HL           ; DE = start now.
  12898.         CALL    L2AB2           ; routine STK-STO-$ stacks string parameters
  12899.                                 ; DE start in variables area,
  12900.                                 ; BC length, A=1 simple string
  12901.  
  12902. ; the only thing now is to consider if a slice is required.
  12903.  
  12904.         RST     18H             ; GET-CHAR puts character at CH_ADD in A
  12905.         JP      L2A49           ; jump forward to SV-SLICE? to test for '('
  12906.  
  12907. ; --------------------------------------------------------
  12908.  
  12909. ; the branch was here with string and numeric arrays in runtime.
  12910.  
  12911. ;; SV-ARRAYS
  12912. L29AE:  INC     HL              ; step past
  12913.         INC     HL              ; the total length
  12914.         INC     HL              ; to address Number of dimensions.
  12915.         LD      B,(HL)          ; transfer to B overwriting zero.
  12916.         BIT     6,C             ; a numeric array ?
  12917.         JR      Z,L29C0         ; forward to SV-PTR with numeric arrays
  12918.  
  12919.         DEC     B               ; ignore the final element of a string array
  12920.                                 ; the fixed string size.
  12921.  
  12922.         JR      Z,L29A1         ; back to SV-SIMPLE$ if result is zero as has
  12923.                                 ; been created with DIM a$(10) for instance
  12924.                                 ; and can be treated as a simple string.
  12925.  
  12926. ; proceed with multi-dimensioned string arrays in runtime.
  12927.  
  12928.         EX      DE,HL           ; save pointer to dimensions in DE
  12929.  
  12930.         RST     18H             ; GET-CHAR looks at the BASIC line
  12931.         CP      $28             ; is character '(' ?
  12932.         JR      NZ,L2A20        ; to REPORT-3 if not
  12933.                                 ; 'Subscript wrong'
  12934.  
  12935.         EX      DE,HL           ; dimensions pointer to HL to synchronize
  12936.                                 ; with next instruction.
  12937.  
  12938. ; runtime numeric arrays path rejoins here.
  12939.  
  12940. ;; SV-PTR
  12941. L29C0:  EX      DE,HL           ; save dimension pointer in DE
  12942.         JR      L29E7           ; forward to SV-COUNT with true no of dims
  12943.                                 ; in B. As there is no initial comma the
  12944.                                 ; loop is entered at the midpoint.
  12945.  
  12946. ; ----------------------------------------------------------
  12947. ; the dimension counting loop which is entered at mid-point.
  12948.  
  12949. ;; SV-COMMA
  12950. L29C3:  PUSH    HL              ; save counter
  12951.  
  12952.         RST     18H             ; GET-CHAR
  12953.  
  12954.         POP     HL              ; pop counter
  12955.         CP      $2C             ; is character ',' ?
  12956.         JR      Z,L29EA         ; forward to SV-LOOP if so
  12957.  
  12958. ; in runtime the variable definition indicates a comma should appear here
  12959.  
  12960.         BIT     7,C             ; checking syntax ?
  12961.         JR      Z,L2A20         ; forward to REPORT-3 if not
  12962.                                 ; 'Subscript error'
  12963.  
  12964. ; proceed if checking syntax of an array?
  12965.  
  12966.         BIT     6,C             ; array of strings
  12967.         JR      NZ,L29D8        ; forward to SV-CLOSE if so
  12968.  
  12969. ; an array of numbers.
  12970.  
  12971.         CP      $29             ; is character ')' ?
  12972.         JR      NZ,L2A12        ; forward to SV-RPT-C if not
  12973.                                 ; 'Nonsense in BASIC'
  12974.  
  12975.         RST     20H             ; NEXT-CHAR moves CH-ADD past the statement
  12976.         RET                     ; return ->
  12977.  
  12978. ; ---
  12979.  
  12980. ; the branch was here with an array of strings.
  12981.  
  12982. ;; SV-CLOSE
  12983. L29D8:  CP      $29             ; as above ')' could follow the expression
  12984.         JR      Z,L2A48         ; forward to SV-DIM if so
  12985.  
  12986.         CP      $CC             ; is it 'TO' ?
  12987.         JR      NZ,L2A12        ; to SV-RPT-C with anything else
  12988.                                 ; 'Nonsense in BASIC'
  12989.  
  12990. ; now backtrack CH_ADD to set up for slicing routine.
  12991. ; Note. in a BASIC line we can safely backtrack to a colour parameter.
  12992.  
  12993. ;; SV-CH-ADD
  12994. L29E0:  RST     18H             ; GET-CHAR
  12995.         DEC     HL              ; backtrack HL
  12996.         LD      ($5C5D),HL      ; to set CH_ADD up for slicing routine
  12997.         JR      L2A45           ; forward to SV-SLICE and make a return
  12998.                                 ; when all slicing complete.
  12999.  
  13000. ; ----------------------------------------
  13001. ; -> the mid-point entry point of the loop
  13002.  
  13003. ;; SV-COUNT
  13004. L29E7:  LD      HL,$0000        ; initialize data pointer to zero.
  13005.  
  13006. ;; SV-LOOP
  13007. L29EA:  PUSH    HL              ; save the data pointer.
  13008.  
  13009.         RST     20H             ; NEXT-CHAR in BASIC area points to an
  13010.                                 ; expression.
  13011.  
  13012.         POP     HL              ; restore the data pointer.
  13013.         LD      A,C             ; transfer name/type to A.
  13014.         CP      $C0             ; is it 11000000 ?
  13015.                                 ; Note. the letter component is absent if
  13016.                                 ; syntax checking.
  13017.         JR      NZ,L29FB        ; forward to SV-MULT if not an array of
  13018.                                 ; strings.
  13019.  
  13020. ; proceed to check string arrays during syntax.
  13021.  
  13022.         RST     18H             ; GET-CHAR
  13023.         CP      $29             ; ')'  end of subscripts ?
  13024.         JR      Z,L2A48         ; forward to SV-DIM to consider further slice
  13025.  
  13026.         CP      $CC             ; is it 'TO' ?
  13027.         JR      Z,L29E0         ; back to SV-CH-ADD to consider a slice.
  13028.                                 ; (no need to repeat get-char at L29E0)
  13029.  
  13030. ; if neither, then an expression is required so rejoin runtime loop ??
  13031. ; registers HL and DE only point to somewhere meaningful in runtime so
  13032. ; comments apply to that situation.
  13033.  
  13034. ;; SV-MULT
  13035. L29FB:  PUSH    BC              ; save dimension number.
  13036.         PUSH    HL              ; push data pointer/rubbish.
  13037.                                 ; DE points to current dimension.
  13038.         CALL    L2AEE           ; routine DE,(DE+1) gets next dimension in DE
  13039.                                 ; and HL points to it.
  13040.         EX      (SP),HL         ; dim pointer to stack, data pointer to HL (*)
  13041.         EX      DE,HL           ; data pointer to DE, dim size to HL.
  13042.  
  13043.         CALL    L2ACC           ; routine INT-EXP1 checks integer expression
  13044.                                 ; and gets result in BC in runtime.
  13045.         JR      C,L2A20         ; to REPORT-3 if > HL
  13046.                                 ; 'Subscript out of range'
  13047.  
  13048.         DEC     BC              ; adjust returned result from 1-x to 0-x
  13049.         CALL    L2AF4           ; routine GET-HL*DE multiplies data pointer by
  13050.                                 ; dimension size.
  13051.         ADD     HL,BC           ; add the integer returned by expression.
  13052.         POP     DE              ; pop the dimension pointer.                              ***
  13053.         POP     BC              ; pop dimension counter.
  13054.         DJNZ    L29C3           ; back to SV-COMMA if more dimensions
  13055.                                 ; Note. during syntax checking, unless there
  13056.                                 ; are more than 256 subscripts, the branch
  13057.                                 ; back to SV-COMMA is always taken.
  13058.  
  13059.         BIT     7,C             ; are we checking syntax ?
  13060.                                 ; then we've got a joker here.
  13061.  
  13062. ;; SV-RPT-C
  13063. L2A12:  JR      NZ,L2A7A        ; forward to SL-RPT-C if so
  13064.                                 ; 'Nonsense in BASIC'
  13065.                                 ; more than 256 subscripts in BASIC line.
  13066.  
  13067. ; but in runtime the number of subscripts are at least the same as dims
  13068.  
  13069.         PUSH    HL              ; save data pointer.
  13070.         BIT     6,C             ; is it a string array ?
  13071.         JR      NZ,L2A2C        ; forward to SV-ELEM$ if so.
  13072.  
  13073. ; a runtime numeric array subscript.
  13074.  
  13075.         LD      B,D             ; register DE has advanced past all dimensions
  13076.         LD      C,E             ; and points to start of data in variable.
  13077.                                 ; transfer it to BC.
  13078.  
  13079.         RST     18H             ; GET-CHAR checks BASIC line
  13080.         CP      $29             ; must be a ')' ?
  13081.         JR      Z,L2A22         ; skip to SV-NUMBER if so
  13082.  
  13083. ; else more subscripts in BASIC line than the variable definition.
  13084.  
  13085. ;; REPORT-3
  13086. L2A20:  RST     08H             ; ERROR-1
  13087.         DB    $02             ; Error Report: Subscript wrong
  13088.  
  13089. ; continue if subscripts matched the numeric array.
  13090.  
  13091. ;; SV-NUMBER
  13092. L2A22:  RST     20H             ; NEXT-CHAR moves CH_ADD to next statement
  13093.                                 ; - finished parsing.
  13094.  
  13095.         POP     HL              ; pop the data pointer.
  13096.         LD      DE,$0005        ; each numeric element is 5 bytes.
  13097.         CALL    L2AF4           ; routine GET-HL*DE multiplies.
  13098.         ADD     HL,BC           ; now add to start of data in the variable.
  13099.  
  13100.         RET                     ; return with HL pointing at the numeric
  13101.                                 ; array subscript.                       ->
  13102.  
  13103. ; ---------------------------------------------------------------
  13104.  
  13105. ; the branch was here for string subscripts when the number of subscripts
  13106. ; in the BASIC line was one less than in variable definition.
  13107.  
  13108. ;; SV-ELEM$
  13109. L2A2C:  CALL    L2AEE           ; routine DE,(DE+1) gets final dimension
  13110.                                 ; the length of strings in this array.
  13111.         EX      (SP),HL         ; start pointer to stack, data pointer to HL.
  13112.         CALL    L2AF4           ; routine GET-HL*DE multiplies by element
  13113.                                 ; size.
  13114.         POP     BC              ; the start of data pointer is added
  13115.         ADD     HL,BC           ; in - now points to location before.
  13116.         INC     HL              ; point to start of required string.
  13117.         LD      B,D             ; transfer the length (final dimension size)
  13118.         LD      C,E             ; from DE to BC.
  13119.         EX      DE,HL           ; put start in DE.
  13120.         CALL    L2AB1           ; routine STK-ST-0 stores the string parameters
  13121.                                 ; with A=0 - a slice or subscript.
  13122.  
  13123. ; now check that there were no more subscripts in the BASIC line.
  13124.  
  13125.         RST     18H             ; GET-CHAR
  13126.         CP      $29             ; is it ')' ?
  13127.         JR      Z,L2A48         ; forward to SV-DIM to consider a separate
  13128.                                 ; subscript or/and a slice.
  13129.  
  13130.         CP      $2C             ; a comma is allowed if the final subscript
  13131.                                 ; is to be sliced e.g a$(2,3,4 TO 6).
  13132.         JR      NZ,L2A20        ; to REPORT-3 with anything else
  13133.                                 ; 'Subscript error'
  13134.  
  13135. ;; SV-SLICE
  13136. L2A45:  CALL    L2A52           ; routine SLICING slices the string.
  13137.  
  13138. ; but a slice of a simple string can itself be sliced.
  13139.  
  13140. ;; SV-DIM
  13141. L2A48:  RST     20H             ; NEXT-CHAR
  13142.  
  13143. ;; SV-SLICE?
  13144. L2A49:  CP      $28             ; is character '(' ?
  13145.         JR      Z,L2A45         ; loop back if so to SV-SLICE
  13146.  
  13147.         RES     6,(IY+$01)      ; update FLAGS  - Signal string result
  13148.         RET                     ; and return.
  13149.  
  13150. ; ---
  13151.  
  13152. ; The above section deals with the flexible syntax allowed.
  13153. ; DIM a$(3,3,10) can be considered as two dimensional array of ten-character
  13154. ; strings or a 3-dimensional array of characters.
  13155. ; a$(1,1) will return a 10-character string as will a$(1,1,1 TO 10)
  13156. ; a$(1,1,1) will return a single character.
  13157. ; a$(1,1) (1 TO 6) is the same as a$(1,1,1 TO 6)
  13158. ; A slice can itself be sliced ad infinitum
  13159. ; b$ () () () () () () (2 TO 10) (2 TO 9) (3) is the same as b$(5)
  13160.  
  13161.  
  13162.  
  13163. ; -------------------------
  13164. ; Handle slicing of strings
  13165. ; -------------------------
  13166. ; The syntax of string slicing is very natural and it is as well to reflect
  13167. ; on the permutations possible.
  13168. ; a$() and a$( TO ) indicate the entire string although just a$ would do
  13169. ; and would avoid coming here.
  13170. ; h$(16) indicates the single character at position 16.
  13171. ; a$( TO 32) indicates the first 32 characters.
  13172. ; a$(257 TO) indicates all except the first 256 characters.
  13173. ; a$(19000 TO 19999) indicates the thousand characters at position 19000.
  13174. ; Also a$(9 TO 5) returns a null string not an error.
  13175. ; This enables a$(2 TO) to return a null string if the passed string is
  13176. ; of length zero or 1.
  13177. ; A string expression in brackets can be sliced. e.g. (STR$ PI) (3 TO )
  13178. ; We arrived here from SCANNING with CH-ADD pointing to the initial '('
  13179. ; or from above.
  13180.  
  13181. ;; SLICING
  13182. L2A52:  CALL    L2530           ; routine SYNTAX-Z
  13183.         CALL    NZ,L2BF1        ; routine STK-FETCH fetches parameters of
  13184.                                 ; string at runtime, start in DE, length
  13185.                                 ; in BC. This could be an array subscript.
  13186.  
  13187.         RST     20H             ; NEXT-CHAR
  13188.         CP      $29             ; is it ')' ?     e.g. a$()
  13189.         JR      Z,L2AAD         ; forward to SL-STORE to store entire string.
  13190.  
  13191.         PUSH    DE              ; else save start address of string
  13192.  
  13193.         XOR     A               ; clear accumulator to use as a running flag.
  13194.         PUSH    AF              ; and save on stack before any branching.
  13195.  
  13196.         PUSH    BC              ; save length of string to be sliced.
  13197.         LD      DE,$0001        ; default the start point to position 1.
  13198.  
  13199.         RST     18H             ; GET-CHAR
  13200.  
  13201.         POP     HL              ; pop length to HL as default end point
  13202.                                 ; and limit.
  13203.  
  13204.         CP      $CC             ; is it 'TO' ?    e.g. a$( TO 10000)
  13205.         JR      Z,L2A81         ; to SL-SECOND to evaluate second parameter.
  13206.  
  13207.         POP     AF              ; pop the running flag.
  13208.  
  13209.         CALL    L2ACD           ; routine INT-EXP2 fetches first parameter.
  13210.  
  13211.         PUSH    AF              ; save flag (will be $FF if parameter>limit)
  13212.  
  13213.         LD      D,B             ; transfer the start
  13214.         LD      E,C             ; to DE overwriting 0001.
  13215.         PUSH    HL              ; save original length.
  13216.  
  13217.         RST     18H             ; GET-CHAR
  13218.         POP     HL              ; pop the limit length.
  13219.         CP      $CC             ; is it 'TO' after a start ?
  13220.         JR      Z,L2A81         ; to SL-SECOND to evaluate second parameter
  13221.  
  13222.         CP      $29             ; is it ')' ?       e.g. a$(365)
  13223.  
  13224. ;; SL-RPT-C
  13225. L2A7A:  JP      NZ,L1C8A        ; jump to REPORT-C with anything else
  13226.                                 ; 'Nonsense in BASIC'
  13227.  
  13228.         LD      H,D             ; copy start
  13229.         LD      L,E             ; to end - just a one character slice.
  13230.         JR      L2A94           ; forward to SL-DEFINE.
  13231.  
  13232. ; ---------------------
  13233.  
  13234. ;; SL-SECOND
  13235. L2A81:  PUSH    HL              ; save limit length.
  13236.  
  13237.         RST     20H             ; NEXT-CHAR
  13238.  
  13239.         POP     HL              ; pop the length.
  13240.  
  13241.         CP      $29             ; is character ')' ?        e.g a$(7 TO )
  13242.         JR      Z,L2A94         ; to SL-DEFINE using length as end point.
  13243.  
  13244.         POP     AF              ; else restore flag.
  13245.         CALL    L2ACD           ; routine INT-EXP2 gets second expression.
  13246.  
  13247.         PUSH    AF              ; save the running flag.
  13248.  
  13249.         RST     18H             ; GET-CHAR
  13250.  
  13251.         LD      H,B             ; transfer second parameter
  13252.         LD      L,C             ; to HL.              e.g. a$(42 to 99)
  13253.         CP      $29             ; is character a ')' ?
  13254.         JR      NZ,L2A7A        ; to SL-RPT-C if not
  13255.                                 ; 'Nonsense in BASIC'
  13256.  
  13257. ; we now have start in DE and an end in HL.
  13258.  
  13259. ;; SL-DEFINE
  13260. L2A94:  POP     AF              ; pop the running flag.
  13261.         EX      (SP),HL         ; put end point on stack, start address to HL
  13262.         ADD     HL,DE           ; add address of string to the start point.
  13263.         DEC     HL              ; point to first character of slice.
  13264.         EX      (SP),HL         ; start address to stack, end point to HL (*)
  13265.         AND     A               ; prepare to subtract.
  13266.         SBC     HL,DE           ; subtract start point from end point.
  13267.         LD      BC,$0000        ; default the length result to zero.
  13268.         JR      C,L2AA8         ; forward to SL-OVER if start > end.
  13269.  
  13270.         INC     HL              ; increment the length for inclusive byte.
  13271.  
  13272.         AND     A               ; now test the running flag.
  13273.         JP      M,L2A20         ; jump back to REPORT-3 if $FF.
  13274.                                 ; 'Subscript out of range'
  13275.  
  13276.         LD      B,H             ; transfer the length
  13277.         LD      C,L             ; to BC.
  13278.  
  13279. ;; SL-OVER
  13280. L2AA8:  POP     DE              ; restore start address from machine stack ***
  13281.         RES     6,(IY+$01)      ; update FLAGS - signal string result for
  13282.                                 ; syntax.
  13283.  
  13284. ;; SL-STORE
  13285. L2AAD:  CALL    L2530           ; routine SYNTAX-Z  (UNSTACK-Z?)
  13286.         RET     Z               ; return if checking syntax.
  13287.                                 ; but continue to store the string in runtime.
  13288.  
  13289. ; ------------------------------------
  13290. ; other than from above, this routine is called from STK-VAR to stack
  13291. ; a known string array element.
  13292. ; ------------------------------------
  13293.  
  13294. ;; STK-ST-0
  13295. L2AB1:  XOR     A               ; clear to signal a sliced string or element.
  13296.  
  13297. ; -------------------------
  13298. ; this routine is called from chr$, scrn$ etc. to store a simple string result.
  13299. ; --------------------------
  13300.  
  13301. ;; STK-STO-$
  13302. L2AB2:  RES     6,(IY+$01)      ; update FLAGS - signal string result.
  13303.                                 ; and continue to store parameters of string.
  13304.  
  13305. ; ---------------------------------------
  13306. ; Pass five registers to calculator stack
  13307. ; ---------------------------------------
  13308. ; This subroutine puts five registers on the calculator stack.
  13309.  
  13310. ;; STK-STORE
  13311. L2AB6:  PUSH    BC              ; save two registers
  13312.         CALL    L33A9           ; routine TEST-5-SP checks room and puts 5
  13313.                                 ; in BC.
  13314.         POP     BC              ; fetch the saved registers.
  13315.         LD      HL,($5C65)      ; make HL point to first empty location STKEND
  13316.         LD      (HL),A          ; place the 5 registers.
  13317.         INC     HL              ;
  13318.         LD      (HL),E          ;
  13319.         INC     HL              ;
  13320.         LD      (HL),D          ;
  13321.         INC     HL              ;
  13322.         LD      (HL),C          ;
  13323.         INC     HL              ;
  13324.         LD      (HL),B          ;
  13325.         INC     HL              ;
  13326.         LD      ($5C65),HL      ; update system variable STKEND.
  13327.         RET                     ; and return.
  13328.  
  13329. ; -------------------------------------------
  13330. ; Return result of evaluating next expression
  13331. ; -------------------------------------------
  13332. ; This clever routine is used to check and evaluate an integer expression
  13333. ; which is returned in BC, setting A to $FF, if greater than a limit supplied
  13334. ; in HL. It is used to check array subscripts, parameters of a string slice
  13335. ; and the arguments of the DIM command. In the latter case, the limit check
  13336. ; is not required and H is set to $FF. When checking optional string slice
  13337. ; parameters, it is entered at the second entry point so as not to disturb
  13338. ; the running flag A, which may be $00 or $FF from a previous invocation.
  13339.  
  13340. ;; INT-EXP1
  13341. L2ACC:  XOR     A               ; set result flag to zero.
  13342.  
  13343. ; -> The entry point is here if A is used as a running flag.
  13344.  
  13345. ;; INT-EXP2
  13346. L2ACD:  PUSH    DE              ; preserve DE register throughout.
  13347.         PUSH    HL              ; save the supplied limit.
  13348.         PUSH    AF              ; save the flag.
  13349.  
  13350.         CALL    L1C82           ; routine EXPT-1NUM evaluates expression
  13351.                                 ; at CH_ADD returning if numeric result,
  13352.                                 ; with value on calculator stack.
  13353.  
  13354.         POP     AF              ; pop the flag.
  13355.         CALL    L2530           ; routine SYNTAX-Z
  13356.         JR      Z,L2AEB         ; forward to I-RESTORE if checking syntax so
  13357.                                 ; avoiding a comparison with supplied limit.
  13358.  
  13359.         PUSH    AF              ; save the flag.
  13360.  
  13361.         CALL    L1E99           ; routine FIND-INT2 fetches value from
  13362.                                 ; calculator stack to BC producing an error
  13363.                                 ; if too high.
  13364.  
  13365.         POP     DE              ; pop the flag to D.
  13366.         LD      A,B             ; test value for zero and reject
  13367.         OR      C               ; as arrays and strings begin at 1.
  13368.         SCF                     ; set carry flag.
  13369.         JR      Z,L2AE8         ; forward to I-CARRY if zero.
  13370.  
  13371.         POP     HL              ; restore the limit.
  13372.         PUSH    HL              ; and save.
  13373.         AND     A               ; prepare to subtract.
  13374.         SBC     HL,BC           ; subtract value from limit.
  13375.  
  13376. ;; I-CARRY
  13377. L2AE8:  LD      A,D             ; move flag to accumulator $00 or $FF.
  13378.         SBC     A,$00           ; will set to $FF if carry set.
  13379.  
  13380. ;; I-RESTORE
  13381. L2AEB:  POP     HL              ; restore the limit.
  13382.         POP     DE              ; and DE register.
  13383.         RET                     ; return.
  13384.  
  13385.  
  13386. ; -----------------------
  13387. ; LD DE,(DE+1) Subroutine
  13388. ; -----------------------
  13389. ; This routine just loads the DE register with the contents of the two
  13390. ; locations following the location addressed by DE.
  13391. ; It is used to step along the 16-bit dimension sizes in array definitions.
  13392. ; Note. Such code is made into subroutines to make programs easier to
  13393. ; write and it would use less space to include the five instructions in-line.
  13394. ; However, there are so many exchanges going on at the places this is invoked
  13395. ; that to implement it in-line would make the code hard to follow.
  13396. ; It probably had a zippier label though as the intention is to simplify the
  13397. ; program.
  13398.  
  13399. ;; DE,(DE+1)
  13400. L2AEE:  EX      DE,HL           ;
  13401.         INC     HL              ;
  13402.         LD      E,(HL)          ;
  13403.         INC     HL              ;
  13404.         LD      D,(HL)          ;
  13405.         RET                     ;
  13406.  
  13407. ; -------------------
  13408. ; HL=HL*DE Subroutine
  13409. ; -------------------
  13410. ; This routine calls the mathematical routine to multiply HL by DE in runtime.
  13411. ; It is called from STK-VAR and from DIM. In the latter case syntax is not
  13412. ; being checked so the entry point could have been at the second CALL
  13413. ; instruction to save a few clock-cycles.
  13414.  
  13415. ;; GET-HL*DE
  13416. L2AF4:  CALL    L2530           ; routine SYNTAX-Z.
  13417.         RET     Z               ; return if checking syntax.
  13418.  
  13419.         CALL    L30A9           ; routine HL-HL*DE.
  13420.         JP      C,L1F15         ; jump back to REPORT-4 if over 65535.
  13421.  
  13422.         RET                     ; else return with 16-bit result in HL.
  13423.  
  13424. ; -----------------
  13425. ; THE 'LET' COMMAND
  13426. ; -----------------
  13427. ; Sinclair BASIC adheres to the ANSI-78 standard and a LET is required in
  13428. ; assignments e.g. LET a = 1  :   LET h$ = "hat".
  13429. ;
  13430. ; Long names may contain spaces but not colour controls (when assigned).
  13431. ; a substring can appear to the left of the equals sign.
  13432.  
  13433. ; An earlier mathematician Lewis Carroll may have been pleased that
  13434. ; 10 LET Babies cannot manage crocodiles = Babies are illogical AND
  13435. ;    Nobody is despised who can manage a crocodile AND Illogical persons
  13436. ;    are despised
  13437. ; does not give the 'Nonsense..' error if the three variables exist.
  13438. ; I digress.
  13439.  
  13440. ;; LET
  13441. L2AFF:  LD      HL,($5C4D)      ; fetch system variable DEST to HL.
  13442.         BIT     1,(IY+$37)      ; test FLAGX - handling a new variable ?
  13443.         JR      Z,L2B66         ; forward to L-EXISTS if not.
  13444.  
  13445. ; continue for a new variable. DEST points to start in BASIC line.
  13446. ; from the CLASS routines.
  13447.  
  13448.         LD      BC,$0005        ; assume numeric and assign an initial 5 bytes
  13449.  
  13450. ;; L-EACH-CH
  13451. L2B0B:  INC     BC              ; increase byte count for each relevant
  13452.                                 ; character
  13453.  
  13454. ;; L-NO-SP
  13455. L2B0C:  INC     HL              ; increase pointer.
  13456.         LD      A,(HL)          ; fetch character.
  13457.         CP      $20             ; is it a space ?
  13458.         JR      Z,L2B0C         ; back to L-NO-SP is so.
  13459.  
  13460.         JR      NC,L2B1F        ; forward to L-TEST-CH if higher.
  13461.  
  13462.         CP      $10             ; is it $00 - $0F ?
  13463.         JR      C,L2B29         ; forward to L-SPACES if so.
  13464.  
  13465.         CP      $16             ; is it $16 - $1F ?
  13466.         JR      NC,L2B29        ; forward to L-SPACES if so.
  13467.  
  13468. ; it was $10 - $15  so step over a colour code.
  13469.  
  13470.         INC     HL              ; increase pointer.
  13471.         JR      L2B0C           ; loop back to L-NO-SP.
  13472.  
  13473. ; ---
  13474.  
  13475. ; the branch was to here if higher than space.
  13476.  
  13477. ;; L-TEST-CH
  13478. L2B1F:  CALL    L2C88           ; routine ALPHANUM sets carry if alphanumeric
  13479.         JR      C,L2B0B         ; loop back to L-EACH-CH for more if so.
  13480.  
  13481.         CP      $24             ; is it '$' ?
  13482.         JP      Z,L2BC0         ; jump forward if so, to L-NEW$
  13483.                                 ; with a new string.
  13484.  
  13485. ;; L-SPACES
  13486. L2B29:  LD      A,C             ; save length lo in A.
  13487.         LD      HL,($5C59)      ; fetch E_LINE to HL.
  13488.         DEC     HL              ; point to location before, the variables
  13489.                                 ; end-marker.
  13490.         CALL    L1655           ; routine MAKE-ROOM creates BC spaces
  13491.                                 ; for name and numeric value.
  13492.         INC     HL              ; advance to first new location.
  13493.         INC     HL              ; then to second.
  13494.         EX      DE,HL           ; set DE to second location.
  13495.         PUSH    DE              ; save this pointer.
  13496.         LD      HL,($5C4D)      ; reload HL with DEST.
  13497.         DEC     DE              ; point to first.
  13498.         SUB     $06             ; subtract six from length_lo.
  13499.         LD      B,A             ; save count in B.
  13500.         JR      Z,L2B4F         ; forward to L-SINGLE if it was just
  13501.                                 ; one character.
  13502.  
  13503. ; HL points to start of variable name after 'LET' in BASIC line.
  13504.  
  13505. ;; L-CHAR
  13506. L2B3E:  INC     HL              ; increase pointer.
  13507.         LD      A,(HL)          ; pick up character.
  13508.         CP      $21             ; is it space or higher ?
  13509.         JR      C,L2B3E         ; back to L-CHAR with space and less.
  13510.  
  13511.         OR      $20             ; make variable lower-case.
  13512.         INC     DE              ; increase destination pointer.
  13513.         LD      (DE),A          ; and load to edit line.
  13514.         DJNZ    L2B3E           ; loop back to L-CHAR until B is zero.
  13515.  
  13516.         OR      $80             ; invert the last character.
  13517.         LD      (DE),A          ; and overwrite that in edit line.
  13518.  
  13519. ; now consider first character which has bit 6 set
  13520.  
  13521.         LD      A,$C0           ; set A 11000000 is xor mask for a long name.
  13522.                                 ; %101      is xor/or  result
  13523.  
  13524. ; single character numerics rejoin here with %00000000 in mask.
  13525. ;                                            %011      will be xor/or result
  13526.  
  13527. ;; L-SINGLE
  13528. L2B4F:  LD      HL,($5C4D)      ; fetch DEST - HL addresses first character.
  13529.         XOR     (HL)            ; apply variable type indicator mask (above).
  13530.         OR      $20             ; make lowercase - set bit 5.
  13531.         POP     HL              ; restore pointer to 2nd character.
  13532.         CALL    L2BEA           ; routine L-FIRST puts A in first character.
  13533.                                 ; and returns with HL holding
  13534.                                 ; new E_LINE-1  the $80 vars end-marker.
  13535.  
  13536. ;; L-NUMERIC
  13537. L2B59:  PUSH    HL              ; save the pointer.
  13538.  
  13539. ; the value of variable is deleted but remains after calculator stack.
  13540.  
  13541.         RST     28H             ;; FP-CALC
  13542.         DB    $02             ;;delete      ; delete variable value
  13543.         DB    $38             ;;end-calc
  13544.  
  13545. ; DE (STKEND) points to start of value.
  13546.  
  13547.         POP     HL              ; restore the pointer.
  13548.         LD      BC,$0005        ; start of number is five bytes before.
  13549.         AND     A               ; prepare for true subtraction.
  13550.         SBC     HL,BC           ; HL points to start of value.
  13551.         JR      L2BA6           ; forward to L-ENTER  ==>
  13552.  
  13553. ; ---
  13554.  
  13555.  
  13556. ; the jump was to here if the variable already existed.
  13557.  
  13558. ;; L-EXISTS
  13559. L2B66:  BIT     6,(IY+$01)      ; test FLAGS - numeric or string result ?
  13560.         JR      Z,L2B72         ; skip forward to L-DELETE$   -*->
  13561.                                 ; if string result.
  13562.  
  13563. ; A numeric variable could be simple or an array element.
  13564. ; They are treated the same and the old value is overwritten.
  13565.  
  13566.         LD      DE,$0006        ; six bytes forward points to loc past value.
  13567.         ADD     HL,DE           ; add to start of number.
  13568.         JR      L2B59           ; back to L-NUMERIC to overwrite value.
  13569.  
  13570. ; ---
  13571.  
  13572. ; -*-> the branch was here if a string existed.
  13573.  
  13574. ;; L-DELETE$
  13575. L2B72:  LD      HL,($5C4D)      ; fetch DEST to HL.
  13576.                                 ; (still set from first instruction)
  13577.         LD      BC,($5C72)      ; fetch STRLEN to BC.
  13578.         BIT     0,(IY+$37)      ; test FLAGX - handling a complete simple
  13579.                                 ; string ?
  13580.         JR      NZ,L2BAF        ; forward to L-ADD$ if so.
  13581.  
  13582. ; must be a string array or a slice in workspace.
  13583. ; Note. LET a$(3 TO 6) = h$   will assign "hat " if h$ = "hat"
  13584. ;                                  and    "hats" if h$ = "hatstand".
  13585. ;
  13586. ; This is known as Procrustian lengthening and shortening after a
  13587. ; character Procrustes in Greek legend who made travellers sleep in his bed,
  13588. ; cutting off their feet or stretching them so they fitted the bed perfectly.
  13589. ; The bloke was hatstand and slain by Theseus.
  13590.  
  13591.         LD      A,B             ; test if length
  13592.         OR      C               ; is zero and
  13593.         RET     Z               ; return if so.
  13594.  
  13595.         PUSH    HL              ; save pointer to start.
  13596.  
  13597.         RST     30H             ; BC-SPACES creates room.
  13598.         PUSH    DE              ; save pointer to first new location.
  13599.         PUSH    BC              ; and length            (*)
  13600.         LD      D,H             ; set DE to point to last location.
  13601.         LD      E,L             ;
  13602.         INC     HL              ; set HL to next location.
  13603.         LD      (HL),$20        ; place a space there.
  13604.         LDDR                    ; copy bytes filling with spaces.
  13605.  
  13606.         PUSH    HL              ; save pointer to start.
  13607.         CALL    L2BF1           ; routine STK-FETCH start to DE,
  13608.                                 ; length to BC.
  13609.         POP     HL              ; restore the pointer.
  13610.         EX      (SP),HL         ; (*) length to HL, pointer to stack.
  13611.         AND     A               ; prepare for true subtraction.
  13612.         SBC     HL,BC           ; subtract old length from new.
  13613.         ADD     HL,BC           ; and add back.
  13614.         JR      NC,L2B9B        ; forward if it fits to L-LENGTH.
  13615.  
  13616.         LD      B,H             ; otherwise set
  13617.         LD      C,L             ; length to old length.
  13618.                                 ; "hatstand" becomes "hats"
  13619.  
  13620. ;; L-LENGTH
  13621. L2B9B:  EX      (SP),HL         ; (*) length to stack, pointer to HL.
  13622.         EX      DE,HL           ; pointer to DE, start of string to HL.
  13623.         LD      A,B             ; is the length zero ?
  13624.         OR      C               ;
  13625.         JR      Z,L2BA3         ; forward to L-IN-W/S if so
  13626.                                 ; leaving prepared spaces.
  13627.  
  13628.         LDIR                    ; else copy bytes overwriting some spaces.
  13629.  
  13630. ;; L-IN-W/S
  13631. L2BA3:  POP     BC              ; pop the new length.  (*)
  13632.         POP     DE              ; pop pointer to new area.
  13633.         POP     HL              ; pop pointer to variable in assignment.
  13634.                                 ; and continue copying from workspace
  13635.                                 ; to variables area.
  13636.  
  13637. ; ==> branch here from  L-NUMERIC
  13638.  
  13639. ;; L-ENTER
  13640. L2BA6:  EX      DE,HL           ; exchange pointers HL=STKEND DE=end of vars.
  13641.         LD      A,B             ; test the length
  13642.         OR      C               ; and make a
  13643.         RET     Z               ; return if zero (strings only).
  13644.  
  13645.         PUSH    DE              ; save start of destination.
  13646.         LDIR                    ; copy bytes.
  13647.         POP     HL              ; address the start.
  13648.         RET                     ; and return.
  13649.  
  13650. ; ---
  13651.  
  13652. ; the branch was here from L-DELETE$ if an existing simple string.
  13653. ; register HL addresses start of string in variables area.
  13654.  
  13655. ;; L-ADD$
  13656. L2BAF:  DEC     HL              ; point to high byte of length.
  13657.         DEC     HL              ; to low byte.
  13658.         DEC     HL              ; to letter.
  13659.         LD      A,(HL)          ; fetch masked letter to A.
  13660.         PUSH    HL              ; save the pointer on stack.
  13661.         PUSH    BC              ; save new length.
  13662.         CALL    L2BC6           ; routine L-STRING adds new string at end
  13663.                                 ; of variables area.
  13664.                                 ; if no room we still have old one.
  13665.         POP     BC              ; restore length.
  13666.         POP     HL              ; restore start.
  13667.         INC     BC              ; increase
  13668.         INC     BC              ; length by three
  13669.         INC     BC              ; to include character and length bytes.
  13670.         JP      L19E8           ; jump to indirect exit via RECLAIM-2
  13671.                                 ; deleting old version and adjusting pointers.
  13672.  
  13673. ; ---
  13674.  
  13675. ; the jump was here with a new string variable.
  13676.  
  13677. ;; L-NEW$
  13678. L2BC0:  LD      A,$DF           ; indicator mask %11011111 for
  13679.                                 ;                %010xxxxx will be result
  13680.         LD      HL,($5C4D)      ; address DEST first character.
  13681.         AND     (HL)            ; combine mask with character.
  13682.  
  13683. ;; L-STRING
  13684. L2BC6:  PUSH    AF              ; save first character and mask.
  13685.         CALL    L2BF1           ; routine STK-FETCH fetches parameters of
  13686.                                 ; the string.
  13687.         EX      DE,HL           ; transfer start to HL.
  13688.         ADD     HL,BC           ; add to length.
  13689.         PUSH    BC              ; save the length.
  13690.         DEC     HL              ; point to end of string.
  13691.         LD      ($5C4D),HL      ; save pointer in DEST.
  13692.                                 ; (updated by POINTERS if in workspace)
  13693.         INC     BC              ; extra byte for letter.
  13694.         INC     BC              ; two bytes
  13695.         INC     BC              ; for the length of string.
  13696.         LD      HL,($5C59)      ; address E_LINE.
  13697.         DEC     HL              ; now end of VARS area.
  13698.         CALL    L1655           ; routine MAKE-ROOM makes room for string.
  13699.                                 ; updating pointers including DEST.
  13700.         LD      HL,($5C4D)      ; pick up pointer to end of string from DEST.
  13701.         POP     BC              ; restore length from stack.
  13702.         PUSH    BC              ; and save again on stack.
  13703.         INC     BC              ; add a byte.
  13704.         LDDR                    ; copy bytes from end to start.
  13705.         EX      DE,HL           ; HL addresses length low
  13706.         INC     HL              ; increase to address high byte
  13707.         POP     BC              ; restore length to BC
  13708.         LD      (HL),B          ; insert high byte
  13709.         DEC     HL              ; address low byte location
  13710.         LD      (HL),C          ; insert that byte
  13711.         POP     AF              ; restore character and mask
  13712.  
  13713. ;; L-FIRST
  13714. L2BEA:  DEC     HL              ; address variable name
  13715.         LD      (HL),A          ; and insert character.
  13716.         LD      HL,($5C59)      ; load HL with E_LINE.
  13717.         DEC     HL              ; now end of VARS area.
  13718.         RET                     ; return
  13719.  
  13720. ; ------------------------------------
  13721. ; Get last value from calculator stack
  13722. ; ------------------------------------
  13723. ;
  13724. ;
  13725.  
  13726. ;; STK-FETCH
  13727. L2BF1:  LD      HL,($5C65)      ; STKEND
  13728.         DEC     HL              ;
  13729.         LD      B,(HL)          ;
  13730.         DEC     HL              ;
  13731.         LD      C,(HL)          ;
  13732.         DEC     HL              ;
  13733.         LD      D,(HL)          ;
  13734.         DEC     HL              ;
  13735.         LD      E,(HL)          ;
  13736.         DEC     HL              ;
  13737.         LD      A,(HL)          ;
  13738.         LD      ($5C65),HL      ; STKEND
  13739.         RET                     ;
  13740.  
  13741. ; ------------------
  13742. ; Handle DIM command
  13743. ; ------------------
  13744. ; e.g. DIM a(2,3,4,7): DIM a$(32) : DIM b$(300,2,768) : DIM c$(20000)
  13745. ; the only limit to dimensions is memory so, for example,
  13746. ; DIM a(2,2,2,2,2,2,2,2,2,2,2,2,2) is possible and creates a multi-
  13747. ; dimensional array of zeros. String arrays are initialized to spaces.
  13748. ; It is not possible to erase an array, but it can be re-dimensioned to
  13749. ; a minimal size of 1, after use, to free up memory.
  13750.  
  13751. ;; DIM
  13752. L2C02:  CALL    L28B2           ; routine LOOK-VARS
  13753.  
  13754. ;; D-RPORT-C
  13755. L2C05:  JP      NZ,L1C8A        ; jump to REPORT-C if a long-name variable.
  13756.                                 ; DIM lottery numbers(49) doesn't work.
  13757.  
  13758.         CALL    L2530           ; routine SYNTAX-Z
  13759.         JR      NZ,L2C15        ; forward to D-RUN in runtime.
  13760.  
  13761.         RES     6,C             ; signal 'numeric' array even if string as
  13762.                                 ; this simplifies the syntax checking.
  13763.  
  13764.         CALL    L2996           ; routine STK-VAR checks syntax.
  13765.         CALL    L1BEE           ; routine CHECK-END performs early exit ->
  13766.  
  13767. ; the branch was here in runtime.
  13768.  
  13769. ;; D-RUN
  13770. L2C15:  JR      C,L2C1F         ; skip to D-LETTER if variable did not exist.
  13771.                                 ; else reclaim the old one.
  13772.  
  13773.         PUSH    BC              ; save type in C.
  13774.         CALL    L19B8           ; routine NEXT-ONE find following variable
  13775.                                 ; or position of $80 end-marker.
  13776.         CALL    L19E8           ; routine RECLAIM-2 reclaims the
  13777.                                 ; space between.
  13778.         POP     BC              ; pop the type.
  13779.  
  13780. ;; D-LETTER
  13781. L2C1F:  SET     7,C             ; signal array.
  13782.         LD      B,$00           ; initialize dimensions to zero and
  13783.         PUSH    BC              ; save with the type.
  13784.         LD      HL,$0001        ; make elements one character presuming string
  13785.         BIT     6,C             ; is it a string ?
  13786.         JR      NZ,L2C2D        ; forward to D-SIZE if so.
  13787.  
  13788.         LD      L,$05           ; make elements 5 bytes as is numeric.
  13789.  
  13790. ;; D-SIZE
  13791. L2C2D:  EX      DE,HL           ; save the element size in DE.
  13792.  
  13793. ; now enter a loop to parse each of the integers in the list.
  13794.  
  13795. ;; D-NO-LOOP
  13796. L2C2E:  RST     20H             ; NEXT-CHAR
  13797.         LD      H,$FF           ; disable limit check by setting HL high
  13798.         CALL    L2ACC           ; routine INT-EXP1
  13799.         JP      C,L2A20         ; to REPORT-3 if > 65280 and then some
  13800.                                 ; 'Subscript out of range'
  13801.  
  13802.         POP     HL              ; pop dimension counter, array type
  13803.         PUSH    BC              ; save dimension size                     ***
  13804.         INC     H               ; increment the dimension counter
  13805.         PUSH    HL              ; save the dimension counter
  13806.         LD      H,B             ; transfer size
  13807.         LD      L,C             ; to HL
  13808.         CALL    L2AF4           ; routine GET-HL*DE multiplies dimension by
  13809.                                 ; running total of size required initially
  13810.                                 ; 1 or 5.
  13811.         EX      DE,HL           ; save running total in DE
  13812.  
  13813.         RST     18H             ; GET-CHAR
  13814.         CP      $2C             ; is it ',' ?
  13815.         JR      Z,L2C2E         ; loop back to D-NO-LOOP until all dimensions
  13816.                                 ; have been considered
  13817.  
  13818. ; when loop complete continue.
  13819.  
  13820.         CP      $29             ; is it ')' ?
  13821.         JR      NZ,L2C05        ; to D-RPORT-C with anything else
  13822.                                 ; 'Nonsense in BASIC'
  13823.  
  13824.  
  13825.         RST     20H             ; NEXT-CHAR advances to next statement/CR
  13826.  
  13827.         POP     BC              ; pop dimension counter/type
  13828.         LD      A,C             ; type to A
  13829.  
  13830. ; now calculate space required for array variable
  13831.  
  13832.         LD      L,B             ; dimensions to L since these require 16 bits
  13833.                                 ; then this value will be doubled
  13834.         LD      H,$00           ; set high byte to zero
  13835.  
  13836. ; another four bytes are required for letter(1), total length(2), number of
  13837. ; dimensions(1) but since we have yet to double allow for two
  13838.  
  13839.         INC     HL              ; increment
  13840.         INC     HL              ; increment
  13841.  
  13842.         ADD     HL,HL           ; now double giving 4 + dimensions * 2
  13843.  
  13844.         ADD     HL,DE           ; add to space required for array contents
  13845.  
  13846.         JP      C,L1F15         ; to REPORT-4 if > 65535
  13847.                                 ; 'Out of memory'
  13848.  
  13849.         PUSH    DE              ; save data space
  13850.         PUSH    BC              ; save dimensions/type
  13851.         PUSH    HL              ; save total space
  13852.         LD      B,H             ; total space
  13853.         LD      C,L             ; to BC
  13854.         LD      HL,($5C59)      ; address E_LINE - first location after
  13855.                                 ; variables area
  13856.         DEC     HL              ; point to location before - the $80 end-marker
  13857.         CALL    L1655           ; routine MAKE-ROOM creates the space if
  13858.                                 ; memory is available.
  13859.  
  13860.         INC     HL              ; point to first new location and
  13861.         LD      (HL),A          ; store letter/type
  13862.  
  13863.         POP     BC              ; pop total space
  13864.         DEC     BC              ; exclude name
  13865.         DEC     BC              ; exclude the 16-bit
  13866.         DEC     BC              ; counter itself
  13867.         INC     HL              ; point to next location the 16-bit counter
  13868.         LD      (HL),C          ; insert low byte
  13869.         INC     HL              ; address next
  13870.         LD      (HL),B          ; insert high byte
  13871.  
  13872.         POP     BC              ; pop the number of dimensions.
  13873.         LD      A,B             ; dimensions to A
  13874.         INC     HL              ; address next
  13875.         LD      (HL),A          ; and insert "No. of dims"
  13876.  
  13877.         LD      H,D             ; transfer DE space + 1 from make-room
  13878.         LD      L,E             ; to HL
  13879.         DEC     DE              ; set DE to next location down.
  13880.         LD      (HL),$00        ; presume numeric and insert a zero
  13881.         BIT     6,C             ; test bit 6 of C. numeric or string ?
  13882.         JR      Z,L2C7C         ; skip to DIM-CLEAR if numeric
  13883.  
  13884.         LD      (HL),$20        ; place a space character in HL
  13885.  
  13886. ;; DIM-CLEAR
  13887. L2C7C:  POP     BC              ; pop the data length
  13888.  
  13889.         LDDR                    ; LDDR sets to zeros or spaces
  13890.  
  13891. ; The number of dimensions is still in A.
  13892. ; A loop is now entered to insert the size of each dimension that was pushed
  13893. ; during the D-NO-LOOP working downwards from position before start of data.
  13894.  
  13895. ;; DIM-SIZES
  13896. L2C7F:  POP     BC              ; pop a dimension size                    ***
  13897.         LD      (HL),B          ; insert high byte at position
  13898.         DEC     HL              ; next location down
  13899.         LD      (HL),C          ; insert low byte
  13900.         DEC     HL              ; next location down
  13901.         DEC     A               ; decrement dimension counter
  13902.         JR      NZ,L2C7F        ; back to DIM-SIZES until all done.
  13903.  
  13904.         RET                     ; return.
  13905.  
  13906. ; -----------------------------
  13907. ; Check whether digit or letter
  13908. ; -----------------------------
  13909. ; This routine checks that the character in A is alphanumeric
  13910. ; returning with carry set if so.
  13911.  
  13912. ;; ALPHANUM
  13913. L2C88:  CALL    L2D1B           ; routine NUMERIC will reset carry if so.
  13914.         CCF                     ; Complement Carry Flag
  13915.         RET     C               ; Return if numeric else continue into
  13916.                                 ; next routine.
  13917.  
  13918. ; This routine checks that the character in A is alphabetic
  13919.  
  13920. ;; ALPHA
  13921. L2C8D:  CP      $41             ; less than 'A' ?
  13922.         CCF                     ; Complement Carry Flag
  13923.         RET     NC              ; return if so
  13924.  
  13925.         CP      $5B             ; less than 'Z'+1 ?
  13926.         RET     C               ; is within first range
  13927.  
  13928.         CP      $61             ; less than 'a' ?
  13929.         CCF                     ; Complement Carry Flag
  13930.         RET     NC              ; return if so.
  13931.  
  13932.         CP      $7B             ; less than 'z'+1 ?
  13933.         RET                     ; carry set if within a-z.
  13934.  
  13935. ; -------------------------
  13936. ; Decimal to floating point
  13937. ; -------------------------
  13938. ; This routine finds the floating point number represented by an expression
  13939. ; beginning with BIN, '.' or a digit.
  13940. ; Note that BIN need not have any '0's or '1's after it.
  13941. ; BIN is really just a notational symbol and not a function.
  13942.  
  13943. ;; DEC-TO-FP
  13944. L2C9B:  CP      $C4             ; 'BIN' token ?
  13945.         JR      NZ,L2CB8        ; to NOT-BIN if not
  13946.  
  13947.         LD      DE,$0000        ; initialize 16 bit buffer register.
  13948.  
  13949. ;; BIN-DIGIT
  13950. L2CA2:  RST     20H             ; NEXT-CHAR
  13951.         SUB     $31             ; '1'
  13952.         ADC     A,$00           ; will be zero if '1' or '0'
  13953.                                 ; carry will be set if was '0'
  13954.         JR      NZ,L2CB3        ; forward to BIN-END if result not zero
  13955.  
  13956.         EX      DE,HL           ; buffer to HL
  13957.         CCF                     ; Carry now set if originally '1'
  13958.         ADC     HL,HL           ; shift the carry into HL
  13959.         JP      C,L31AD         ; to REPORT-6 if overflow - too many digits
  13960.                                 ; after first '1'. There can be an unlimited
  13961.                                 ; number of leading zeros.
  13962.                                 ; 'Number too big' - raise an error
  13963.  
  13964.         EX      DE,HL           ; save the buffer
  13965.         JR      L2CA2           ; back to BIN-DIGIT for more digits
  13966.  
  13967. ; ---
  13968.  
  13969. ;; BIN-END
  13970. L2CB3:  LD      B,D             ; transfer 16 bit buffer
  13971.         LD      C,E             ; to BC register pair.
  13972.         JP      L2D2B           ; JUMP to STACK-BC to put on calculator stack
  13973.  
  13974. ; ---
  13975.  
  13976. ; continue here with .1,  42, 3.14, 5., 2.3 E -4
  13977.  
  13978. ;; NOT-BIN
  13979. L2CB8:  CP      $2E             ; '.' - leading decimal point ?
  13980.         JR      Z,L2CCB         ; skip to DECIMAL if so.
  13981.  
  13982.         CALL    L2D3B           ; routine INT-TO-FP to evaluate all digits
  13983.                                 ; This number 'x' is placed on stack.
  13984.         CP      $2E             ; '.' - mid decimal point ?
  13985.  
  13986.         JR      NZ,L2CEB        ; to E-FORMAT if not to consider that format
  13987.  
  13988.         RST     20H             ; NEXT-CHAR
  13989.         CALL    L2D1B           ; routine NUMERIC returns carry reset if 0-9
  13990.  
  13991.         JR      C,L2CEB         ; to E-FORMAT if not a digit e.g. '1.'
  13992.  
  13993.         JR      L2CD5           ; to DEC-STO-1 to add the decimal part to 'x'
  13994.  
  13995. ; ---
  13996.  
  13997. ; a leading decimal point has been found in a number.
  13998.  
  13999. ;; DECIMAL
  14000. L2CCB:  RST     20H             ; NEXT-CHAR
  14001.         CALL    L2D1B           ; routine NUMERIC will reset carry if digit
  14002.  
  14003. ;; DEC-RPT-C
  14004. L2CCF:  JP      C,L1C8A         ; to REPORT-C if just a '.'
  14005.                                 ; raise 'Nonsense in BASIC'
  14006.  
  14007. ; since there is no leading zero put one on the calculator stack.
  14008.  
  14009.         RST     28H             ;; FP-CALC
  14010.         DB    $A0             ;;stk-zero  ; 0.
  14011.         DB    $38             ;;end-calc
  14012.  
  14013. ; If rejoining from earlier there will be a value 'x' on stack.
  14014. ; If continuing from above the value zero.
  14015. ; Now store 1 in mem-0.
  14016. ; Note. At each pass of the digit loop this will be divided by ten.
  14017.  
  14018. ;; DEC-STO-1
  14019. L2CD5:  RST     28H             ;; FP-CALC
  14020.         DB    $A1             ;;stk-one   ;x or 0,1.
  14021.         DB    $C0             ;;st-mem-0  ;x or 0,1.
  14022.         DB    $02             ;;delete    ;x or 0.
  14023.         DB    $38             ;;end-calc
  14024.  
  14025.  
  14026. ;; NXT-DGT-1
  14027. L2CDA:  RST     18H             ; GET-CHAR
  14028.         CALL    L2D22           ; routine STK-DIGIT stacks single digit 'd'
  14029.         JR      C,L2CEB         ; exit to E-FORMAT when digits exhausted  >
  14030.  
  14031.  
  14032.         RST     28H             ;; FP-CALC   ;x or 0,d.           first pass.
  14033.         DB    $E0             ;;get-mem-0  ;x or 0,d,1.
  14034.         DB    $A4             ;;stk-ten    ;x or 0,d,1,10.
  14035.         DB    $05             ;;division   ;x or 0,d,1/10.
  14036.         DB    $C0             ;;st-mem-0   ;x or 0,d,1/10.
  14037.         DB    $04             ;;multiply   ;x or 0,d/10.
  14038.         DB    $0F             ;;addition   ;x or 0 + d/10.
  14039.         DB    $38             ;;end-calc   last value.
  14040.  
  14041.         RST     20H             ; NEXT-CHAR  moves to next character
  14042.         JR      L2CDA           ; back to NXT-DGT-1
  14043.  
  14044. ; ---
  14045.  
  14046. ; although only the first pass is shown it can be seen that at each pass
  14047. ; the new less significant digit is multiplied by an increasingly smaller
  14048. ; factor (1/100, 1/1000, 1/10000 ... ) before being added to the previous
  14049. ; last value to form a new last value.
  14050.  
  14051. ; Finally see if an exponent has been input.
  14052.  
  14053. ;; E-FORMAT
  14054. L2CEB:  CP      $45             ; is character 'E' ?
  14055.         JR      Z,L2CF2         ; to SIGN-FLAG if so
  14056.  
  14057.         CP      $65             ; 'e' is acceptable as well.
  14058.         RET     NZ              ; return as no exponent.
  14059.  
  14060. ;; SIGN-FLAG
  14061. L2CF2:  LD      B,$FF           ; initialize temporary sign byte to $FF
  14062.  
  14063.         RST     20H             ; NEXT-CHAR
  14064.         CP      $2B             ; is character '+' ?
  14065.         JR      Z,L2CFE         ; to SIGN-DONE
  14066.  
  14067.         CP      $2D             ; is character '-' ?
  14068.         JR      NZ,L2CFF        ; to ST-E-PART as no sign
  14069.  
  14070.         INC     B               ; set sign to zero
  14071.  
  14072. ; now consider digits of exponent.
  14073. ; Note. incidentally this is the only occasion in Spectrum BASIC when an
  14074. ; expression may not be used when a number is expected.
  14075.  
  14076. ;; SIGN-DONE
  14077. L2CFE:  RST     20H             ; NEXT-CHAR
  14078.  
  14079. ;; ST-E-PART
  14080. L2CFF:  CALL    L2D1B           ; routine NUMERIC
  14081.         JR      C,L2CCF         ; to DEC-RPT-C if not
  14082.                                 ; raise 'Nonsense in BASIC'.
  14083.  
  14084.         PUSH    BC              ; save sign (in B)
  14085.         CALL    L2D3B           ; routine INT-TO-FP places exponent on stack
  14086.         CALL    L2DD5           ; routine FP-TO-A  transfers it to A
  14087.         POP     BC              ; restore sign
  14088.         JP      C,L31AD         ; to REPORT-6 if overflow (over 255)
  14089.                                 ; raise 'Number too big'.
  14090.  
  14091.         AND     A               ; set flags
  14092.         JP      M,L31AD         ; to REPORT-6 if over '127'.
  14093.                                 ; raise 'Number too big'.
  14094.                                 ; 127 is still way too high and it is
  14095.                                 ; impossible to enter an exponent greater
  14096.                                 ; than 39 from the keyboard. The error gets
  14097.                                 ; raised later in E-TO-FP so two different
  14098.                                 ; error messages depending how high A is.
  14099.  
  14100.         INC     B               ; $FF to $00 or $00 to $01 - expendable now.
  14101.         JR      Z,L2D18         ; forward to E-FP-JUMP if exponent positive
  14102.  
  14103.         NEG                     ; Negate the exponent.
  14104.  
  14105. ;; E-FP-JUMP
  14106. L2D18:  JP      L2D4F           ; JUMP forward to E-TO-FP to assign to
  14107.                                 ; last value x on stack x * 10 to power A
  14108.                                 ; a relative jump would have done.
  14109.  
  14110. ; ---------------------
  14111. ; Check for valid digit
  14112. ; ---------------------
  14113. ; This routine checks that the ASCII character in A is numeric
  14114. ; returning with carry reset if so.
  14115.  
  14116. ;; NUMERIC
  14117. L2D1B:  CP      $30             ; '0'
  14118.         RET     C               ; return if less than zero character.
  14119.  
  14120.         CP      $3A             ; The upper test is '9'
  14121.         CCF                     ; Complement Carry Flag
  14122.         RET                     ; Return - carry clear if character '0' - '9'
  14123.  
  14124. ; -----------
  14125. ; Stack Digit
  14126. ; -----------
  14127. ; This subroutine is called from INT-TO-FP and DEC-TO-FP to stack a digit
  14128. ; on the calculator stack.
  14129.  
  14130. ;; STK-DIGIT
  14131. L2D22:  CALL    L2D1B           ; routine NUMERIC
  14132.         RET     C               ; return if not numeric character
  14133.  
  14134.         SUB     $30             ; convert from ASCII to digit
  14135.  
  14136. ; -----------------
  14137. ; Stack accumulator
  14138. ; -----------------
  14139. ;
  14140. ;
  14141.  
  14142. ;; STACK-A
  14143. L2D28:  LD      C,A             ; transfer to C
  14144.         LD      B,$00           ; and make B zero
  14145.  
  14146. ; ----------------------
  14147. ; Stack BC register pair
  14148. ; ----------------------
  14149. ;
  14150.  
  14151. ;; STACK-BC
  14152. L2D2B:  LD      IY,$5C3A        ; re-initialize ERR_NR
  14153.  
  14154.         XOR     A               ; clear to signal small integer
  14155.         LD      E,A             ; place in E for sign
  14156.         LD      D,C             ; LSB to D
  14157.         LD      C,B             ; MSB to C
  14158.         LD      B,A             ; last byte not used
  14159.         CALL    L2AB6           ; routine STK-STORE
  14160.  
  14161.         RST     28H             ;; FP-CALC
  14162.         DB    $38             ;;end-calc  make HL = STKEND-5
  14163.  
  14164.         AND     A               ; clear carry
  14165.         RET                     ; before returning
  14166.  
  14167. ; -------------------------
  14168. ; Integer to floating point
  14169. ; -------------------------
  14170. ; This routine places one or more digits found in a BASIC line
  14171. ; on the calculator stack multiplying the previous value by ten each time
  14172. ; before adding in the new digit to form a last value on calculator stack.
  14173.  
  14174. ;; INT-TO-FP
  14175. L2D3B:  PUSH    AF              ; save first character
  14176.  
  14177.         RST     28H             ;; FP-CALC
  14178.         DB    $A0             ;;stk-zero    ; v=0. initial value
  14179.         DB    $38             ;;end-calc
  14180.  
  14181.         POP     AF              ; fetch first character back.
  14182.  
  14183. ;; NXT-DGT-2
  14184. L2D40:  CALL    L2D22           ; routine STK-DIGIT puts 0-9 on stack
  14185.         RET     C               ; will return when character is not numeric >
  14186.  
  14187.         RST     28H             ;; FP-CALC    ; v, d.
  14188.         DB    $01             ;;exchange    ; d, v.
  14189.         DB    $A4             ;;stk-ten     ; d, v, 10.
  14190.         DB    $04             ;;multiply    ; d, v*10.
  14191.         DB    $0F             ;;addition    ; d + v*10 = newvalue
  14192.         DB    $38             ;;end-calc    ; v.
  14193.  
  14194.         CALL    L0074           ; routine CH-ADD+1 get next character
  14195.         JR      L2D40           ; back to NXT-DGT-2 to process as a digit
  14196.  
  14197.  
  14198. ;*********************************
  14199. ;** Part 9. ARITHMETIC ROUTINES **
  14200. ;*********************************
  14201.  
  14202. ; --------------------------
  14203. ; E-format to floating point
  14204. ; --------------------------
  14205. ; This subroutine is used by the PRINT-FP routine and the decimal to FP
  14206. ; routines to stack a number expressed in exponent format.
  14207. ; Note. Though not used by the ROM as such, it has also been set up as
  14208. ; a unary calculator literal but this will not work as the accumulator
  14209. ; is not available from within the calculator.
  14210.  
  14211. ; on entry there is a value x on the calculator stack and an exponent of ten
  14212. ; in A.    The required value is x + 10 ^ A
  14213.  
  14214. ;; e-to-fp
  14215. ;; E-TO-FP
  14216. L2D4F:  RLCA                    ; this will set the          x.
  14217.         RRCA                    ; carry if bit 7 is set
  14218.  
  14219.         JR      NC,L2D55        ; to E-SAVE  if positive.
  14220.  
  14221.         CPL                     ; make negative positive
  14222.         INC     A               ; without altering carry.
  14223.  
  14224. ;; E-SAVE
  14225. L2D55:  PUSH    AF              ; save positive exp and sign in carry
  14226.  
  14227.         LD      HL,$5C92        ; address MEM-0
  14228.  
  14229.         CALL    L350B           ; routine FP-0/1
  14230.                                 ; places an integer zero, if no carry,
  14231.                                 ; else a one in mem-0 as a sign flag
  14232.  
  14233.         RST     28H             ;; FP-CALC
  14234.         DB    $A4             ;;stk-ten                    x, 10.
  14235.         DB    $38             ;;end-calc
  14236.  
  14237.         POP     AF              ; pop the exponent.
  14238.  
  14239. ; now enter a loop
  14240.  
  14241. ;; E-LOOP
  14242. L2D60:  SRL     A               ; 0>76543210>C
  14243.  
  14244.         JR      NC,L2D71        ; forward to E-TST-END if no bit
  14245.  
  14246.         PUSH    AF              ; save shifted exponent.
  14247.  
  14248.         RST     28H             ;; FP-CALC
  14249.         DB    $C1             ;;st-mem-1                   x, 10.
  14250.         DB    $E0             ;;get-mem-0                  x, 10, (0/1).
  14251.         DB    $00             ;;jump-true
  14252.  
  14253.         DB    $04             ;;to L2D6D, E-DIVSN
  14254.  
  14255.         DB    $04             ;;multiply                   x*10.
  14256.         DB    $33             ;;jump
  14257.  
  14258.         DB    $02             ;;to L2D6E, E-FETCH
  14259.  
  14260. ;; E-DIVSN
  14261. L2D6D:  DB    $05             ;;division                   x/10.
  14262.  
  14263. ;; E-FETCH
  14264. L2D6E:  DB    $E1             ;;get-mem-1                  x/10 or x*10, 10.
  14265.         DB    $38             ;;end-calc                   new x, 10.
  14266.  
  14267.         POP     AF              ; restore shifted exponent
  14268.  
  14269. ; the loop branched to here with no carry
  14270.  
  14271. ;; E-TST-END
  14272. L2D71:  JR      Z,L2D7B         ; forward to E-END  if A emptied of bits
  14273.  
  14274.         PUSH    AF              ; re-save shifted exponent
  14275.  
  14276.         RST     28H             ;; FP-CALC
  14277.         DB    $31             ;;duplicate                  new x, 10, 10.
  14278.         DB    $04             ;;multiply                   new x, 100.
  14279.         DB    $38             ;;end-calc
  14280.  
  14281.         POP     AF              ; restore shifted exponent
  14282.         JR      L2D60           ; back to E-LOOP  until all bits done.
  14283.  
  14284. ; ---
  14285.  
  14286. ; although only the first pass is shown it can be seen that for each set bit
  14287. ; representing a power of two, x is multiplied or divided by the
  14288. ; corresponding power of ten.
  14289.  
  14290. ;; E-END
  14291. L2D7B:  RST     28H             ;; FP-CALC                   final x, factor.
  14292.         DB    $02             ;;delete                     final x.
  14293.         DB    $38             ;;end-calc                   x.
  14294.  
  14295.         RET                     ; return
  14296.  
  14297.  
  14298.  
  14299.  
  14300. ; -------------
  14301. ; Fetch integer
  14302. ; -------------
  14303. ; This routine is called by the mathematical routines - FP-TO-BC, PRINT-FP,
  14304. ; mult, re-stack and negate to fetch an integer from address HL.
  14305. ; HL points to the stack or a location in MEM and no deletion occurs.
  14306. ; If the number is negative then a similar process to that used in INT-STORE
  14307. ; is used to restore the twos complement number to normal in DE and a sign
  14308. ; in C.
  14309.  
  14310. ;; INT-FETCH
  14311. L2D7F:  INC     HL              ; skip zero indicator.
  14312.         LD      C,(HL)          ; fetch sign to C
  14313.         INC     HL              ; address low byte
  14314.         LD      A,(HL)          ; fetch to A
  14315.         XOR     C               ; two's complement
  14316.         SUB     C               ;
  14317.         LD      E,A             ; place in E
  14318.         INC     HL              ; address high byte
  14319.         LD      A,(HL)          ; fetch to A
  14320.         ADC     A,C             ; two's complement
  14321.         XOR     C               ;
  14322.         LD      D,A             ; place in D
  14323.         RET                     ; return
  14324.  
  14325. ; ------------------------
  14326. ; Store a positive integer
  14327. ; ------------------------
  14328. ; This entry point is not used in this ROM but would
  14329. ; store any integer as positive.
  14330.  
  14331. ;; p-int-sto
  14332. L2D8C:  LD      C,$00           ; make sign byte positive and continue
  14333.  
  14334. ; -------------
  14335. ; Store integer
  14336. ; -------------
  14337. ; this routine stores an integer in DE at address HL.
  14338. ; It is called from mult, truncate, negate and sgn.
  14339. ; The sign byte $00 +ve or $FF -ve is in C.
  14340. ; If negative, the number is stored in 2's complement form so that it is
  14341. ; ready to be added.
  14342.  
  14343. ;; INT-STORE
  14344. L2D8E:  PUSH    HL              ; preserve HL
  14345.  
  14346.         LD      (HL),$00        ; first byte zero shows integer not exponent
  14347.         INC     HL              ;
  14348.         LD      (HL),C          ; then store the sign byte
  14349.         INC     HL              ;
  14350.                                 ; e.g.             +1             -1
  14351.         LD      A,E             ; fetch low byte   00000001       00000001
  14352.         XOR     C               ; xor sign         00000000   or  11111111
  14353.                                 ; gives            00000001   or  11111110
  14354.         SUB     C               ; sub sign         00000000   or  11111111
  14355.                                 ; gives            00000001>0 or  11111111>C
  14356.         LD      (HL),A          ; store 2's complement.
  14357.         INC     HL              ;
  14358.         LD      A,D             ; high byte        00000000       00000000
  14359.         ADC     A,C             ; sign             00000000<0     11111111<C
  14360.                                 ; gives            00000000   or  00000000
  14361.         XOR     C               ; xor sign         00000000       11111111
  14362.         LD      (HL),A          ; store 2's complement.
  14363.         INC     HL              ;
  14364.         LD      (HL),$00        ; last byte always zero for integers.
  14365.                                 ; is not used and need not be looked at when
  14366.                                 ; testing for zero but comes into play should
  14367.                                 ; an integer be converted to fp.
  14368.         POP     HL              ; restore HL
  14369.         RET                     ; return.
  14370.  
  14371.  
  14372. ; -----------------------------
  14373. ; Floating point to BC register
  14374. ; -----------------------------
  14375. ; This routine gets a floating point number e.g. 127.4 from the calculator
  14376. ; stack to the BC register.
  14377.  
  14378. ;; FP-TO-BC
  14379. L2DA2:  RST     28H             ;; FP-CALC            set HL to
  14380.         DB    $38             ;;end-calc            point to last value.
  14381.  
  14382.         LD      A,(HL)          ; get first of 5 bytes
  14383.         AND     A               ; and test
  14384.         JR      Z,L2DAD         ; forward to FP-DELETE if an integer
  14385.  
  14386. ; The value is first rounded up and then converted to integer.
  14387.  
  14388.         RST     28H             ;; FP-CALC           x.
  14389.         DB    $A2             ;;stk-half           x. 1/2.
  14390.         DB    $0F             ;;addition           x + 1/2.
  14391.         DB    $27             ;;int                int(x + .5)
  14392.         DB    $38             ;;end-calc
  14393.  
  14394. ; now delete but leave HL pointing at integer
  14395.  
  14396. ;; FP-DELETE
  14397. L2DAD:  RST     28H             ;; FP-CALC
  14398.         DB    $02             ;;delete
  14399.         DB    $38             ;;end-calc
  14400.  
  14401.         PUSH    HL              ; save pointer.
  14402.         PUSH    DE              ; and STKEND.
  14403.         EX      DE,HL           ; make HL point to exponent/zero indicator
  14404.         LD      B,(HL)          ; indicator to B
  14405.         CALL    L2D7F           ; routine INT-FETCH
  14406.                                 ; gets int in DE sign byte to C
  14407.                                 ; but meaningless values if a large integer
  14408.  
  14409.         XOR     A               ; clear A
  14410.         SUB     B               ; subtract indicator byte setting carry
  14411.                                 ; if not a small integer.
  14412.  
  14413.         BIT     7,C             ; test a bit of the sign byte setting zero
  14414.                                 ; if positive.
  14415.  
  14416.         LD      B,D             ; transfer int
  14417.         LD      C,E             ; to BC
  14418.         LD      A,E             ; low byte to A as a useful return value.
  14419.  
  14420.         POP     DE              ; pop STKEND
  14421.         POP     HL              ; and pointer to last value
  14422.         RET                     ; return
  14423.                                 ; if carry is set then the number was too big.
  14424.  
  14425. ; ------------
  14426. ; LOG(2^A)
  14427. ; ------------
  14428. ; This routine is used when printing floating point numbers to calculate
  14429. ; the number of digits before the decimal point.
  14430.  
  14431. ; first convert a one-byte signed integer to its five byte form.
  14432.  
  14433. ;; LOG(2^A)
  14434. L2DC1:  LD      D,A             ; store a copy of A in D.
  14435.         RLA                     ; test sign bit of A.
  14436.         SBC     A,A             ; now $FF if negative or $00
  14437.         LD      E,A             ; sign byte to E.
  14438.         LD      C,A             ; and to C
  14439.         XOR     A               ; clear A
  14440.         LD      B,A             ; and B.
  14441.         CALL    L2AB6           ; routine STK-STORE stacks number AEDCB
  14442.  
  14443. ;  so 00 00 XX 00 00 (positive) or 00 FF XX FF 00 (negative).
  14444. ;  i.e. integer indicator, sign byte, low, high, unused.
  14445.  
  14446. ; now multiply exponent by log to the base 10 of two.
  14447.  
  14448.         RST      28H            ;; FP-CALC
  14449.  
  14450.         DB    $34             ;;stk-data                      .30103 (log 2)
  14451.         DB    $EF             ;;Exponent: $7F, Bytes: 4
  14452.         DB    $1A,$20,$9A,$85 ;;
  14453.         DB    $04             ;;multiply
  14454.  
  14455.         DB    $27             ;;int
  14456.  
  14457.         DB    $38             ;;end-calc
  14458.  
  14459. ; -------------------
  14460. ; Floating point to A
  14461. ; -------------------
  14462. ; this routine collects a floating point number from the stack into the
  14463. ; accumulator returning carry set if not in range 0 - 255.
  14464. ; Not all the calling routines raise an error with overflow so no attempt
  14465. ; is made to produce an error report here.
  14466.  
  14467. ;; FP-TO-A
  14468. L2DD5:  CALL    L2DA2           ; routine FP-TO-BC returns with C in A also.
  14469.         RET     C               ; return with carry set if > 65535, overflow
  14470.  
  14471.         PUSH    AF              ; save the value and flags
  14472.         DEC     B               ; and test that
  14473.         INC     B               ; the high byte is zero.
  14474.         JR      Z,L2DE1         ; forward  FP-A-END if zero
  14475.  
  14476. ; else there has been 8-bit overflow
  14477.  
  14478.         POP     AF              ; retrieve the value
  14479.         SCF                     ; set carry flag to show overflow
  14480.         RET                     ; and return.
  14481.  
  14482. ; ---
  14483.  
  14484. ;; FP-A-END
  14485. L2DE1:  POP     AF              ; restore value and success flag and
  14486.         RET                     ; return.
  14487.  
  14488.  
  14489. ; -----------------------------
  14490. ; Print a floating point number
  14491. ; -----------------------------
  14492. ; Not a trivial task.
  14493. ; Begin by considering whether to print a leading sign for negative numbers.
  14494.  
  14495. ;; PRINT-FP
  14496. L2DE3:  RST     28H             ;; FP-CALC
  14497.         DB    $31             ;;duplicate
  14498.         DB    $36             ;;less-0
  14499.         DB    $00             ;;jump-true
  14500.  
  14501.         DB    $0B             ;;to L2DF2, PF-NEGTVE
  14502.  
  14503.         DB    $31             ;;duplicate
  14504.         DB    $37             ;;greater-0
  14505.         DB    $00             ;;jump-true
  14506.  
  14507.         DB    $0D             ;;to L2DF8, PF-POSTVE
  14508.  
  14509. ; must be zero itself
  14510.  
  14511.         DB    $02             ;;delete
  14512.         DB    $38             ;;end-calc
  14513.  
  14514.         LD      A,$30           ; prepare the character '0'
  14515.  
  14516.         RST     10H             ; PRINT-A
  14517.         RET                     ; return.                 ->
  14518. ; ---
  14519.  
  14520. ;; PF-NEGTVE
  14521. L2DF2:  DB    $2A             ;;abs
  14522.         DB    $38             ;;end-calc
  14523.  
  14524.         LD      A,$2D           ; the character '-'
  14525.  
  14526.         RST     10H             ; PRINT-A
  14527.  
  14528. ; and continue to print the now positive number.
  14529.  
  14530.         RST     28H             ;; FP-CALC
  14531.  
  14532. ;; PF-POSTVE
  14533. L2DF8:  DB    $A0             ;;stk-zero     x,0.     begin by
  14534.         DB    $C3             ;;st-mem-3     x,0.     clearing a temporary
  14535.         DB    $C4             ;;st-mem-4     x,0.     output buffer to
  14536.         DB    $C5             ;;st-mem-5     x,0.     fifteen zeros.
  14537.         DB    $02             ;;delete       x.
  14538.         DB    $38             ;;end-calc     x.
  14539.  
  14540.         EXX                     ; in case called from 'str$' then save the
  14541.         PUSH    HL              ; pointer to whatever comes after
  14542.         EXX                     ; str$ as H'L' will be used.
  14543.  
  14544. ; now enter a loop?
  14545.  
  14546. ;; PF-LOOP
  14547. L2E01:  RST     28H             ;; FP-CALC
  14548.         DB    $31             ;;duplicate    x,x.
  14549.         DB    $27             ;;int          x,int x.
  14550.         DB    $C2             ;;st-mem-2     x,int x.
  14551.         DB    $03             ;;subtract     x-int x.     fractional part.
  14552.         DB    $E2             ;;get-mem-2    x-int x, int x.
  14553.         DB    $01             ;;exchange     int x, x-int x.
  14554.         DB    $C2             ;;st-mem-2     int x, x-int x.
  14555.         DB    $02             ;;delete       int x.
  14556.         DB    $38             ;;end-calc     int x.
  14557.                                 ;
  14558.                                 ; mem-2 holds the fractional part.
  14559.  
  14560. ; HL points to last value int x
  14561.  
  14562.         LD      A,(HL)          ; fetch exponent of int x.
  14563.         AND     A               ; test
  14564.         JR      NZ,L2E56        ; forward to PF-LARGE if a large integer
  14565.                                 ; > 65535
  14566.  
  14567. ; continue with small positive integer components in range 0 - 65535
  14568. ; if original number was say .999 then this integer component is zero.
  14569.  
  14570.         CALL    L2D7F           ; routine INT-FETCH gets x in DE
  14571.                                 ; (but x is not deleted)
  14572.  
  14573.         LD      B,$10           ; set B, bit counter, to 16d
  14574.  
  14575.         LD      A,D             ; test if
  14576.         AND     A               ; high byte is zero
  14577.         JR      NZ,L2E1E        ; forward to PF-SAVE if 16-bit integer.
  14578.  
  14579. ; and continue with integer in range 0 - 255.
  14580.  
  14581.         OR      E               ; test the low byte for zero
  14582.                                 ; i.e. originally just point something or other.
  14583.         JR      Z,L2E24         ; forward if so to PF-SMALL
  14584.  
  14585. ;
  14586.  
  14587.         LD      D,E             ; transfer E to D
  14588.         LD      B,$08           ; and reduce the bit counter to 8.
  14589.  
  14590. ;; PF-SAVE
  14591. L2E1E:  PUSH    DE              ; save the part before decimal point.
  14592.         EXX                     ;
  14593.         POP     DE              ; and pop in into D'E'
  14594.         EXX                     ;
  14595.         JR      L2E7B           ; forward to PF-BITS
  14596.  
  14597. ; ---------------------
  14598.  
  14599. ; the branch was here when 'int x' was found to be zero as in say 0.5.
  14600. ; The zero has been fetched from the calculator stack but not deleted and
  14601. ; this should occur now. This omission leaves the stack unbalanced and while
  14602. ; that causes no problems with a simple PRINT statement, it will if str$ is
  14603. ; being used in an expression e.g. "2" + STR$ 0.5 gives the result "0.5"
  14604. ; instead of the expected result "20.5".
  14605. ; credit Tony Stratton, 1982.
  14606. ; A DB 02 delete is required immediately on using the calculator.
  14607.  
  14608. ;; PF-SMALL
  14609. L2E24:  RST     28H             ;; FP-CALC       int x = 0.
  14610. L2E25:  DB    $E2             ;;get-mem-2      int x = 0, x-int x.
  14611.         DB    $38             ;;end-calc
  14612.  
  14613.         LD      A,(HL)          ; fetch exponent of positive fractional number
  14614.         SUB     $7E             ; subtract
  14615.  
  14616.         CALL    L2DC1           ; routine LOG(2^A) calculates leading digits.
  14617.  
  14618.         LD      D,A             ; transfer count to D
  14619.         LD      A,($5CAC)       ; fetch total MEM-5-1
  14620.         SUB     D               ;
  14621.         LD      ($5CAC),A       ; MEM-5-1
  14622.         LD      A,D             ;
  14623.         CALL    L2D4F           ; routine E-TO-FP
  14624.  
  14625.         RST     28H             ;; FP-CALC
  14626.         DB    $31             ;;duplicate
  14627.         DB    $27             ;;int
  14628.         DB    $C1             ;;st-mem-1
  14629.         DB    $03             ;;subtract
  14630.         DB    $E1             ;;get-mem-1
  14631.         DB    $38             ;;end-calc
  14632.  
  14633.         CALL    L2DD5           ; routine FP-TO-A
  14634.  
  14635.         PUSH    HL              ; save HL
  14636.         LD      ($5CA1),A       ; MEM-3-1
  14637.         DEC     A               ;
  14638.         RLA                     ;
  14639.         SBC     A,A             ;
  14640.         INC     A               ;
  14641.  
  14642.         LD      HL,$5CAB        ; address MEM-5-1 leading digit counter
  14643.         LD      (HL),A          ; store counter
  14644.         INC     HL              ; address MEM-5-2 total digits
  14645.         ADD     A,(HL)          ; add counter to contents
  14646.         LD      (HL),A          ; and store updated value
  14647.         POP     HL              ; restore HL
  14648.  
  14649.         JP      L2ECF           ; JUMP forward to PF-FRACTN
  14650.  
  14651. ; ---
  14652.  
  14653. ; Note. while it would be pedantic to comment on every occasion a JP
  14654. ; instruction could be replaced with a JR instruction, this applies to the
  14655. ; above, which is useful if you wish to correct the unbalanced stack error
  14656. ; by inserting a 'DB 02 delete' at L2E25, and maintain main addresses.
  14657.  
  14658. ; the branch was here with a large positive integer > 65535 e.g. 123456789
  14659. ; the accumulator holds the exponent.
  14660.  
  14661. ;; PF-LARGE
  14662. L2E56:  SUB     $80             ; make exponent positive
  14663.         CP      $1C             ; compare to 28
  14664.         JR      C,L2E6F         ; to PF-MEDIUM if integer <= 2^27
  14665.  
  14666.         CALL    L2DC1           ; routine LOG(2^A)
  14667.         SUB     $07             ;
  14668.         LD      B,A             ;
  14669.         LD      HL,$5CAC        ; address MEM-5-1 the leading digits counter.
  14670.         ADD     A,(HL)          ; add A to contents
  14671.         LD      (HL),A          ; store updated value.
  14672.         LD      A,B             ;
  14673.         NEG                     ; negate
  14674.         CALL    L2D4F           ; routine E-TO-FP
  14675.         JR      L2E01           ; back to PF-LOOP
  14676.  
  14677. ; ----------------------------
  14678.  
  14679. ;; PF-MEDIUM
  14680. L2E6F:  EX      DE,HL           ;
  14681.         CALL    L2FBA           ; routine FETCH-TWO
  14682.         EXX                     ;
  14683.         SET     7,D             ;
  14684.         LD      A,L             ;
  14685.         EXX                     ;
  14686.         SUB     $80             ;
  14687.         LD      B,A             ;
  14688.  
  14689. ; the branch was here to handle bits in DE with 8 or 16 in B  if small int
  14690. ; and integer in D'E', 6 nibbles will accommodate 065535 but routine does
  14691. ; 32-bit numbers as well from above
  14692.  
  14693. ;; PF-BITS
  14694. L2E7B:  SLA     E               ;  C<xxxxxxxx<0
  14695.         RL      D               ;  C<xxxxxxxx<C
  14696.         EXX                     ;
  14697.         RL      E               ;  C<xxxxxxxx<C
  14698.         RL      D               ;  C<xxxxxxxx<C
  14699.         EXX                     ;
  14700.  
  14701.         LD      HL,$5CAA        ; set HL to mem-4-5th last byte of buffer
  14702.         LD      C,$05           ; set byte count to 5 -  10 nibbles
  14703.  
  14704. ;; PF-BYTES
  14705. L2E8A:  LD      A,(HL)          ; fetch 0 or prev value
  14706.         ADC     A,A             ; shift left add in carry    C<xxxxxxxx<C
  14707.  
  14708.         DAA                     ; Decimal Adjust Accumulator.
  14709.                                 ; if greater than 9 then the left hand
  14710.                                 ; nibble is incremented. If greater than
  14711.                                 ; 99 then adjusted and carry set.
  14712.                                 ; so if we'd built up 7 and a carry came in
  14713.                                 ;      0000 0111 < C
  14714.                                 ;      0000 1111
  14715.                                 ; daa     1 0101  which is 15 in BCD
  14716.  
  14717.         LD      (HL),A          ; put back
  14718.         DEC     HL              ; work down thru mem 4
  14719.         DEC     C               ; decrease the 5 counter.
  14720.         JR      NZ,L2E8A        ; back to PF-BYTES until the ten nibbles rolled
  14721.  
  14722.         DJNZ    L2E7B           ; back to PF-BITS until 8 or 16 (or 32) done
  14723.  
  14724. ; at most 9 digits for 32-bit number will have been loaded with digits
  14725. ; each of the 9 nibbles in mem 4 is placed into ten bytes in mem-3 and mem 4
  14726. ; unless the nibble is zero as the buffer is already zero.
  14727. ; ( or in the case of mem-5 will become zero as a result of RLD instruction )
  14728.  
  14729.         XOR     A               ; clear to accept
  14730.         LD      HL,$5CA6        ; address MEM-4-0 byte destination.
  14731.         LD      DE,$5CA1        ; address MEM-3-0 nibble source.
  14732.         LD      B,$09           ; the count is 9 (not ten) as the first
  14733.                                 ; nibble is known to be blank.
  14734.  
  14735.         RLD                     ; shift RH nibble to left in (HL)
  14736.                                 ;    A           (HL)
  14737.                                 ; 0000 0000 < 0000 3210
  14738.                                 ; 0000 0000   3210 0000
  14739.                                 ; A picks up the blank nibble
  14740.  
  14741.  
  14742.         LD      C,$FF           ; set a flag to indicate when a significant
  14743.                                 ; digit has been encountered.
  14744.  
  14745. ;; PF-DIGITS
  14746. L2EA1:  RLD                     ; pick up leftmost nibble from (HL)
  14747.                                 ;    A           (HL)
  14748.                                 ; 0000 0000 < 7654 3210
  14749.                                 ; 0000 7654   3210 0000
  14750.  
  14751.  
  14752.         JR      NZ,L2EA9        ; to PF-INSERT if non-zero value picked up.
  14753.  
  14754.         DEC     C               ; test
  14755.         INC     C               ; flag
  14756.         JR      NZ,L2EB3        ; skip forward to PF-TEST-2 if flag still $FF
  14757.                                 ; indicating this is a leading zero.
  14758.  
  14759. ; but if the zero is a significant digit e.g. 10 then include in digit totals.
  14760. ; the path for non-zero digits rejoins here.
  14761.  
  14762. ;; PF-INSERT
  14763. L2EA9:  LD      (DE),A          ; insert digit at destination
  14764.         INC     DE              ; increase the destination pointer
  14765.         INC     (IY+$71)        ; increment MEM-5-1st  digit counter
  14766.         INC     (IY+$72)        ; increment MEM-5-2nd  leading digit counter
  14767.         LD      C,$00           ; set flag to zero indicating that any
  14768.                                 ; subsequent zeros are significant and not
  14769.                                 ; leading.
  14770.  
  14771. ;; PF-TEST-2
  14772. L2EB3:  BIT     0,B             ; test if the nibble count is even
  14773.         JR      Z,L2EB8         ; skip to PF-ALL-9 if so to deal with the
  14774.                                 ; other nibble in the same byte
  14775.  
  14776.         INC     HL              ; point to next source byte if not
  14777.  
  14778. ;; PF-ALL-9
  14779. L2EB8:  DJNZ    L2EA1           ; decrement the nibble count, back to PF-DIGITS
  14780.                                 ; if all nine not done.
  14781.  
  14782. ; For 8-bit integers there will be at most 3 digits.
  14783. ; For 16-bit integers there will be at most 5 digits.
  14784. ; but for larger integers there could be nine leading digits.
  14785. ; if nine digits complete then the last one is rounded up as the number will
  14786. ; be printed using E-format notation
  14787.  
  14788.         LD      A,($5CAB)       ; fetch digit count from MEM-5-1st
  14789.         SUB     $09             ; subtract 9 - max possible
  14790.         JR      C,L2ECB         ; forward if less to PF-MORE
  14791.  
  14792.         DEC     (IY+$71)        ; decrement digit counter MEM-5-1st to 8
  14793.         LD      A,$04           ; load A with the value 4.
  14794.         CP      (IY+$6F)        ; compare with MEM-4-4th - the ninth digit
  14795.         JR      L2F0C           ; forward to PF-ROUND
  14796.                                 ; to consider rounding.
  14797.  
  14798. ; ---------------------------------------
  14799.  
  14800. ; now delete int x from calculator stack and fetch fractional part.
  14801.  
  14802. ;; PF-MORE
  14803. L2ECB:  RST     28H             ;; FP-CALC        int x.
  14804.         DB    $02             ;;delete          .
  14805.         DB    $E2             ;;get-mem-2       x - int x = f.
  14806.         DB    $38             ;;end-calca       f.
  14807.  
  14808. ;; PF-FRACTN
  14809. L2ECF:  EX      DE,HL           ;
  14810.         CALL    L2FBA           ; routine FETCH-TWO
  14811.         EXX                     ;
  14812.         LD      A,$80           ;
  14813.         SUB     L               ;
  14814.         LD      L,$00           ;
  14815.         SET     7,D             ;
  14816.         EXX                     ;
  14817.         CALL    L2FDD           ; routine SHIFT-FP
  14818.  
  14819. ;; PF-FRN-LP
  14820. L2EDF:  LD      A,(IY+$71)      ; MEM-5-1st
  14821.         CP      $08             ;
  14822.         JR      C,L2EEC         ; to PF-FR-DGT
  14823.  
  14824.         EXX                     ;
  14825.         RL      D               ;
  14826.         EXX                     ;
  14827.         JR      L2F0C           ; to PF-ROUND
  14828.  
  14829. ; ---
  14830.  
  14831. ;; PF-FR-DGT
  14832. L2EEC:  LD      BC,$0200        ;
  14833.  
  14834. ;; PF-FR-EXX
  14835. L2EEF:  LD      A,E             ;
  14836.         CALL    L2F8B           ; routine CA-10*A+C
  14837.         LD      E,A             ;
  14838.         LD      A,D             ;
  14839.         CALL    L2F8B           ; routine CA-10*A+C
  14840.         LD      D,A             ;
  14841.         PUSH    BC              ;
  14842.         EXX                     ;
  14843.         POP     BC              ;
  14844.         DJNZ    L2EEF           ; to PF-FR-EXX
  14845.  
  14846.         LD      HL,$5CA1        ; MEM-3
  14847.         LD      A,C             ;
  14848.         LD      C,(IY+$71)      ; MEM-5-1st
  14849.         ADD     HL,BC           ;
  14850.         LD      (HL),A          ;
  14851.         INC     (IY+$71)        ; MEM-5-1st
  14852.         JR      L2EDF           ; to PF-FRN-LP
  14853.  
  14854. ; ----------------
  14855.  
  14856. ; 1) with 9 digits but 8 in mem-5-1 and A holding 4, carry set if rounding up.
  14857. ; e.g.
  14858. ;      999999999 is printed as 1E+9
  14859. ;      100000001 is printed as 1E+8
  14860. ;      100000009 is printed as 1.0000001E+8
  14861.  
  14862. ;; PF-ROUND
  14863. L2F0C:  PUSH    AF              ; save A and flags
  14864.         LD      HL,$5CA1        ; address MEM-3 start of digits
  14865.         LD      C,(IY+$71)      ; MEM-5-1st No. of digits to C
  14866.         LD      B,$00           ; prepare to add
  14867.         ADD     HL,BC           ; address last digit + 1
  14868.         LD      B,C             ; No. of digits to B counter
  14869.         POP     AF              ; restore A and carry flag from comparison.
  14870.  
  14871. ;; PF-RND-LP
  14872. L2F18:  DEC     HL              ; address digit at rounding position.
  14873.         LD      A,(HL)          ; fetch it
  14874.         ADC     A,$00           ; add carry from the comparison
  14875.         LD      (HL),A          ; put back result even if $0A.
  14876.         AND     A               ; test A
  14877.         JR      Z,L2F25         ; skip to PF-R-BACK if ZERO?
  14878.  
  14879.         CP      $0A             ; compare to 'ten' - overflow
  14880.         CCF                     ; complement carry flag so that set if ten.
  14881.         JR      NC,L2F2D        ; forward to PF-COUNT with 1 - 9.
  14882.  
  14883. ;; PF-R-BACK
  14884. L2F25:  DJNZ    L2F18           ; loop back to PF-RND-LP
  14885.  
  14886. ; if B counts down to zero then we've rounded right back as in 999999995.
  14887. ; and the first 8 locations all hold $0A.
  14888.  
  14889.  
  14890.         LD      (HL),$01        ; load first location with digit 1.
  14891.         INC     B               ; make B hold 1 also.
  14892.                                 ; could save an instruction byte here.
  14893.         INC     (IY+$72)        ; make MEM-5-2nd hold 1.
  14894.                                 ; and proceed to initialize total digits to 1.
  14895.  
  14896. ;; PF-COUNT
  14897. L2F2D:  LD      (IY+$71),B      ; MEM-5-1st
  14898.  
  14899. ; now balance the calculator stack by deleting  it
  14900.  
  14901.         RST     28H             ;; FP-CALC
  14902.         DB    $02             ;;delete
  14903.         DB    $38             ;;end-calc
  14904.  
  14905. ; note if used from str$ then other values may be on the calculator stack.
  14906. ; we can also restore the next literal pointer from its position on the
  14907. ; machine stack.
  14908.  
  14909.         EXX                     ;
  14910.         POP     HL              ; restore next literal pointer.
  14911.         EXX                     ;
  14912.  
  14913.         LD      BC,($5CAB)      ; set C to MEM-5-1st digit counter.
  14914.                                 ; set B to MEM-5-2nd leading digit counter.
  14915.         LD      HL,$5CA1        ; set HL to start of digits at MEM-3-1
  14916.         LD      A,B             ;
  14917.         CP      $09             ;
  14918.         JR      C,L2F46         ; to PF-NOT-E
  14919.  
  14920.         CP      $FC             ;
  14921.         JR      C,L2F6C         ; to PF-E-FRMT
  14922.  
  14923. ;; PF-NOT-E
  14924. L2F46:  AND     A               ; test for zero leading digits as in .123
  14925.  
  14926.         CALL    Z,L15EF         ; routine OUT-CODE prints a zero e.g. 0.123
  14927.  
  14928. ;; PF-E-SBRN
  14929. L2F4A:  XOR     A               ;
  14930.         SUB     B               ;
  14931.         JP      M,L2F52         ; skip forward to PF-OUT-LP if originally +ve
  14932.  
  14933.         LD      B,A             ; else negative count now +ve
  14934.         JR      L2F5E           ; forward to PF-DC-OUT       ->
  14935.  
  14936. ; ---
  14937.  
  14938. ;; PF-OUT-LP
  14939. L2F52:  LD      A,C             ; fetch total digit count
  14940.         AND     A               ; test for zero
  14941.         JR      Z,L2F59         ; forward to PF-OUT-DT if so
  14942.  
  14943.         LD      A,(HL)          ; fetch digit
  14944.         INC     HL              ; address next digit
  14945.         DEC     C               ; decrease total digit counter
  14946.  
  14947. ;; PF-OUT-DT
  14948. L2F59:  CALL    L15EF           ; routine OUT-CODE outputs it.
  14949.         DJNZ    L2F52           ; loop back to PF-OUT-LP until B leading
  14950.                                 ; digits output.
  14951.  
  14952. ;; PF-DC-OUT
  14953. L2F5E:  LD      A,C             ; fetch total digits and
  14954.         AND     A               ; test if also zero
  14955.         RET     Z               ; return if so              -->
  14956.  
  14957. ;
  14958.  
  14959.         INC     B               ; increment B
  14960.         LD      A,$2E           ; prepare the character '.'
  14961.  
  14962. ;; PF-DEC-0$
  14963. L2F64:  RST     10H             ; PRINT-A outputs the character '.' or '0'
  14964.  
  14965.         LD      A,$30           ; prepare the character '0'
  14966.                                 ; (for cases like .000012345678)
  14967.         DJNZ    L2F64           ; loop back to PF-DEC-0$ for B times.
  14968.  
  14969.         LD      B,C             ; load B with now trailing digit counter.
  14970.         JR      L2F52           ; back to PF-OUT-LP
  14971.  
  14972. ; ---------------------------------
  14973.  
  14974. ; the branch was here for E-format printing e.g 123456789 => 1.2345679e+8
  14975.  
  14976. ;; PF-E-FRMT
  14977. L2F6C:  LD      D,B             ; counter to D
  14978.         DEC     D               ; decrement
  14979.         LD      B,$01           ; load B with 1.
  14980.  
  14981.         CALL    L2F4A           ; routine PF-E-SBRN above
  14982.  
  14983.         LD      A,$45           ; prepare character 'e'
  14984.         RST     10H             ; PRINT-A
  14985.  
  14986.         LD      C,D             ; exponent to C
  14987.         LD      A,C             ; and to A
  14988.         AND     A               ; test exponent
  14989.         JP      P,L2F83         ; to PF-E-POS if positive
  14990.  
  14991.         NEG                     ; negate
  14992.         LD      C,A             ; positive exponent to C
  14993.         LD      A,$2D           ; prepare character '-'
  14994.         JR      L2F85           ; skip to PF-E-SIGN
  14995.  
  14996. ; ---
  14997.  
  14998. ;; PF-E-POS
  14999. L2F83:  LD      A,$2B           ; prepare character '+'
  15000.  
  15001. ;; PF-E-SIGN
  15002. L2F85:  RST     10H             ; PRINT-A outputs the sign
  15003.  
  15004.         LD      B,$00           ; make the high byte zero.
  15005.         JP      L1A1B           ; exit via OUT-NUM-1 to print exponent in BC
  15006.  
  15007. ; ------------------------------
  15008. ; Handle printing floating point
  15009. ; ------------------------------
  15010. ; This subroutine is called twice from above when printing floating-point
  15011. ; numbers. It returns 10*A +C in registers C and A
  15012.  
  15013. ;; CA-10*A+C
  15014. L2F8B:  PUSH    DE              ; preserve DE.
  15015.         LD      L,A             ; transfer A to L
  15016.         LD      H,$00           ; zero high byte.
  15017.         LD      E,L             ; copy HL
  15018.         LD      D,H             ; to DE.
  15019.         ADD     HL,HL           ; double (*2)
  15020.         ADD     HL,HL           ; double (*4)
  15021.         ADD     HL,DE           ; add DE (*5)
  15022.         ADD     HL,HL           ; double (*10)
  15023.         LD      E,C             ; copy C to E    (D is 0)
  15024.         ADD     HL,DE           ; and add to give required result.
  15025.         LD      C,H             ; transfer to
  15026.         LD      A,L             ; destination registers.
  15027.         POP     DE              ; restore DE
  15028.         RET                     ; return with result.
  15029.  
  15030. ; --------------
  15031. ; Prepare to add
  15032. ; --------------
  15033. ; This routine is called twice by addition to prepare the two numbers. The
  15034. ; exponent is picked up in A and the location made zero. Then the sign bit
  15035. ; is tested before being set to the implied state. Negative numbers are twos
  15036. ; complemented.
  15037.  
  15038. ;; PREP-ADD
  15039. L2F9B:  LD      A,(HL)          ; pick up exponent
  15040.         LD      (HL),$00        ; make location zero
  15041.         AND     A               ; test if number is zero
  15042.         RET     Z               ; return if so
  15043.  
  15044.         INC     HL              ; address mantissa
  15045.         BIT     7,(HL)          ; test the sign bit
  15046.         SET     7,(HL)          ; set it to implied state
  15047.         DEC     HL              ; point to exponent
  15048.         RET     Z               ; return if positive number.
  15049.  
  15050.         PUSH    BC              ; preserve BC
  15051.         LD      BC,$0005        ; length of number
  15052.         ADD     HL,BC           ; point HL past end
  15053.         LD      B,C             ; set B to 5 counter
  15054.         LD      C,A             ; store exponent in C
  15055.         SCF                     ; set carry flag
  15056.  
  15057. ;; NEG-BYTE
  15058. L2FAF:  DEC     HL              ; work from LSB to MSB
  15059.         LD      A,(HL)          ; fetch byte
  15060.         CPL                     ; complement
  15061.         ADC     A,$00           ; add in initial carry or from prev operation
  15062.         LD      (HL),A          ; put back
  15063.         DJNZ    L2FAF           ; loop to NEG-BYTE till all 5 done
  15064.  
  15065.         LD      A,C             ; stored exponent to A
  15066.         POP     BC              ; restore original BC
  15067.         RET                     ; return
  15068.  
  15069. ; -----------------
  15070. ; Fetch two numbers
  15071. ; -----------------
  15072. ; This routine is called twice when printing floating point numbers and also
  15073. ; to fetch two numbers by the addition, multiply and division routines.
  15074. ; HL addresses the first number, DE addresses the second number.
  15075. ; For arithmetic only, A holds the sign of the result which is stored in
  15076. ; the second location.
  15077.  
  15078. ;; FETCH-TWO
  15079. L2FBA:  PUSH    HL              ; save pointer to first number, result if math.
  15080.         PUSH    AF              ; save result sign.
  15081.  
  15082.         LD      C,(HL)          ;
  15083.         INC     HL              ;
  15084.  
  15085.         LD      B,(HL)          ;
  15086.         LD      (HL),A          ; store the sign at correct location in
  15087.                                 ; destination 5 bytes for arithmetic only.
  15088.         INC     HL              ;
  15089.  
  15090.         LD      A,C             ;
  15091.         LD      C,(HL)          ;
  15092.         PUSH    BC              ;
  15093.         INC     HL              ;
  15094.         LD      C,(HL)          ;
  15095.         INC     HL              ;
  15096.         LD      B,(HL)          ;
  15097.         EX      DE,HL           ;
  15098.         LD      D,A             ;
  15099.         LD      E,(HL)          ;
  15100.         PUSH    DE              ;
  15101.         INC     HL              ;
  15102.         LD      D,(HL)          ;
  15103.         INC     HL              ;
  15104.         LD      E,(HL)          ;
  15105.         PUSH    DE              ;
  15106.         EXX                     ;
  15107.         POP     DE              ;
  15108.         POP     HL              ;
  15109.         POP     BC              ;
  15110.         EXX                     ;
  15111.         INC     HL              ;
  15112.         LD      D,(HL)          ;
  15113.         INC     HL              ;
  15114.         LD      E,(HL)          ;
  15115.  
  15116.         POP     AF              ; restore possible result sign.
  15117.         POP     HL              ; and pointer to possible result.
  15118.         RET                     ; return.
  15119.  
  15120. ; ---------------------------------
  15121. ; Shift floating point number right
  15122. ; ---------------------------------
  15123. ;
  15124. ;
  15125.  
  15126. ;; SHIFT-FP
  15127. L2FDD:  AND     A               ;
  15128.         RET     Z               ;
  15129.  
  15130.         CP      $21             ;
  15131.         JR      NC,L2FF9        ; to ADDEND-0
  15132.  
  15133.         PUSH    BC              ;
  15134.         LD      B,A             ;
  15135.  
  15136. ;; ONE-SHIFT
  15137. L2FE5:  EXX                     ;
  15138.         SRA     L               ;
  15139.         RR      D               ;
  15140.         RR      E               ;
  15141.         EXX                     ;
  15142.         RR      D               ;
  15143.         RR      E               ;
  15144.         DJNZ    L2FE5           ; to ONE-SHIFT
  15145.  
  15146.         POP     BC              ;
  15147.         RET     NC              ;
  15148.  
  15149.         CALL    L3004           ; routine ADD-BACK
  15150.         RET     NZ              ;
  15151.  
  15152. ;; ADDEND-0
  15153. L2FF9:  EXX                     ;
  15154.         XOR     A               ;
  15155.  
  15156. ;; ZEROS-4/5
  15157. L2FFB:  LD      L,$00           ;
  15158.         LD      D,A             ;
  15159.         LD      E,L             ;
  15160.         EXX                     ;
  15161.         LD      DE,$0000        ;
  15162.         RET                     ;
  15163.  
  15164. ; ------------------
  15165. ; Add back any carry
  15166. ; ------------------
  15167. ;
  15168. ;
  15169.  
  15170. ;; ADD-BACK
  15171. L3004:  INC     E               ;
  15172.         RET     NZ              ;
  15173.  
  15174.         INC      D              ;
  15175.         RET     NZ              ;
  15176.  
  15177.         EXX                     ;
  15178.         INC     E               ;
  15179.         JR      NZ,L300D        ; to ALL-ADDED
  15180.  
  15181.         INC     D               ;
  15182.  
  15183. ;; ALL-ADDED
  15184. L300D:  EXX                     ;
  15185.         RET                     ;
  15186.  
  15187. ; -----------------------
  15188. ; Handle subtraction (03)
  15189. ; -----------------------
  15190. ; Subtraction is done by switching the sign byte/bit of the second number
  15191. ; which may be integer of floating point and continuing into addition.
  15192.  
  15193. ;; subtract
  15194. L300F:  EX      DE,HL           ; address second number with HL
  15195.  
  15196.         CALL    L346E           ; routine NEGATE switches sign
  15197.  
  15198.         EX      DE,HL           ; address first number again
  15199.                                 ; and continue.
  15200.  
  15201. ; --------------------
  15202. ; Handle addition (0F)
  15203. ; --------------------
  15204. ; HL points to first number, DE to second.
  15205. ; If they are both integers, then go for the easy route.
  15206.  
  15207. ;; addition
  15208. L3014:  LD      A,(DE)          ; fetch first byte of second
  15209.         OR      (HL)            ; combine with first byte of first
  15210.         JR      NZ,L303E        ; forward to FULL-ADDN if at least one was
  15211.                                 ; in floating point form.
  15212.  
  15213. ; continue if both were small integers.
  15214.  
  15215.         PUSH    DE              ; save pointer to lowest number for result.
  15216.  
  15217.         INC     HL              ; address sign byte and
  15218.         PUSH    HL              ; push the pointer.
  15219.  
  15220.         INC     HL              ; address low byte
  15221.         LD      E,(HL)          ; to E
  15222.         INC     HL              ; address high byte
  15223.         LD      D,(HL)          ; to D
  15224.         INC     HL              ; address unused byte
  15225.  
  15226.         INC     HL              ; address known zero indicator of 1st number
  15227.         INC     HL              ; address sign byte
  15228.  
  15229.         LD      A,(HL)          ; sign to A, $00 or $FF
  15230.  
  15231.         INC     HL              ; address low byte
  15232.         LD      C,(HL)          ; to C
  15233.         INC     HL              ; address high byte
  15234.         LD      B,(HL)          ; to B
  15235.  
  15236.         POP     HL              ; pop result sign pointer
  15237.         EX      DE,HL           ; integer to HL
  15238.  
  15239.         ADD     HL,BC           ; add to the other one in BC
  15240.                                 ; setting carry if overflow.
  15241.  
  15242.         EX      DE,HL           ; save result in DE bringing back sign pointer
  15243.  
  15244.         ADC     A,(HL)          ; if pos/pos A=01 with overflow else 00
  15245.                                 ; if neg/neg A=FF with overflow else FE
  15246.                                 ; if mixture A=00 with overflow else FF
  15247.  
  15248.         RRCA                    ; bit 0 to (C)
  15249.  
  15250.         ADC     A,$00           ; both acceptable signs now zero
  15251.  
  15252.         JR      NZ,L303C        ; forward to ADDN-OFLW if not
  15253.  
  15254.         SBC     A,A             ; restore a negative result sign
  15255.  
  15256.         LD      (HL),A          ;
  15257.         INC     HL              ;
  15258.         LD      (HL),E          ;
  15259.         INC     HL              ;
  15260.         LD      (HL),D          ;
  15261.         DEC     HL              ;
  15262.         DEC     HL              ;
  15263.         DEC     HL              ;
  15264.  
  15265.         POP     DE              ; STKEND
  15266.         RET                     ;
  15267.  
  15268. ; ---
  15269.  
  15270. ;; ADDN-OFLW
  15271. L303C:  DEC     HL              ;
  15272.         POP     DE              ;
  15273.  
  15274. ;; FULL-ADDN
  15275. L303E:  CALL    L3293           ; routine RE-ST-TWO
  15276.         EXX                     ;
  15277.         PUSH    HL              ;
  15278.         EXX                     ;
  15279.         PUSH    DE              ;
  15280.         PUSH    HL              ;
  15281.         CALL    L2F9B           ; routine PREP-ADD
  15282.         LD      B,A             ;
  15283.         EX      DE,HL           ;
  15284.         CALL    L2F9B           ; routine PREP-ADD
  15285.         LD       C,A            ;
  15286.         CP      B               ;
  15287.         JR      NC,L3055        ; to SHIFT-LEN
  15288.  
  15289.         LD      A,B             ;
  15290.         LD      B,C             ;
  15291.         EX      DE,HL           ;
  15292.  
  15293. ;; SHIFT-LEN
  15294. L3055:  PUSH    AF              ;
  15295.         SUB     B               ;
  15296.         CALL    L2FBA           ; routine FETCH-TWO
  15297.         CALL    L2FDD           ; routine SHIFT-FP
  15298.         POP     AF              ;
  15299.         POP     HL              ;
  15300.         LD      (HL),A          ;
  15301.         PUSH    HL              ;
  15302.         LD      L,B             ;
  15303.         LD      H,C             ;
  15304.         ADD     HL,DE           ;
  15305.         EXX                     ;
  15306.         EX      DE,HL           ;
  15307.         ADC     HL,BC           ;
  15308.         EX      DE,HL           ;
  15309.         LD      A,H             ;
  15310.         ADC     A,L             ;
  15311.         LD      L,A             ;
  15312.         RRA                     ;
  15313.         XOR     L               ;
  15314.         EXX                     ;
  15315.         EX      DE,HL           ;
  15316.         POP     HL              ;
  15317.         RRA                     ;
  15318.         JR      NC,L307C        ; to TEST-NEG
  15319.  
  15320.         LD      A,$01           ;
  15321.         CALL    L2FDD           ; routine SHIFT-FP
  15322.         INC     (HL)            ;
  15323.         JR      Z,L309F         ; to ADD-REP-6
  15324.  
  15325. ;; TEST-NEG
  15326. L307C:  EXX                     ;
  15327.         LD      A,L             ;
  15328.         AND     $80             ;
  15329.         EXX                     ;
  15330.         INC     HL              ;
  15331.         LD      (HL),A          ;
  15332.         DEC     HL              ;
  15333.         JR      Z,L30A5         ; to GO-NC-MLT
  15334.  
  15335.         LD      A,E             ;
  15336.         NEG                     ; Negate
  15337.         CCF                     ; Complement Carry Flag
  15338.         LD      E,A             ;
  15339.         LD      A,D             ;
  15340.         CPL                     ;
  15341.         ADC     A,$00           ;
  15342.         LD      D,A             ;
  15343.         EXX                     ;
  15344.         LD      A,E             ;
  15345.         CPL                     ;
  15346.         ADC     A,$00           ;
  15347.         LD      E,A             ;
  15348.         LD      A,D             ;
  15349.         CPL                     ;
  15350.         ADC     A,$00           ;
  15351.         JR      NC,L30A3        ; to END-COMPL
  15352.  
  15353.         RRA                     ;
  15354.         EXX                     ;
  15355.         INC     (HL)            ;
  15356.  
  15357. ;; ADD-REP-6
  15358. L309F:  JP      Z,L31AD         ; to REPORT-6
  15359.  
  15360.         EXX                     ;
  15361.  
  15362. ;; END-COMPL
  15363. L30A3:  LD      D,A             ;
  15364.         EXX                     ;
  15365.  
  15366. ;; GO-NC-MLT
  15367. L30A5:  XOR     A               ;
  15368.         JP      L3155           ; to TEST-NORM
  15369.  
  15370. ; -----------------------------
  15371. ; Used in 16 bit multiplication
  15372. ; -----------------------------
  15373. ; This routine is used, in the first instance, by the multiply calculator
  15374. ; literal to perform an integer multiplication in preference to
  15375. ; 32-bit multiplication to which it will resort if this overflows.
  15376. ;
  15377. ; It is also used by STK-VAR to calculate array subscripts and by DIM to
  15378. ; calculate the space required for multi-dimensional arrays.
  15379.  
  15380. ;; HL-HL*DE
  15381. L30A9:  PUSH    BC              ; preserve BC throughout
  15382.         LD      B,$10           ; set B to 16
  15383.         LD      A,H             ; save H in A high byte
  15384.         LD      C,L             ; save L in C low byte
  15385.         LD      HL,$0000        ; initialize result to zero
  15386.  
  15387. ; now enter a loop.
  15388.  
  15389. ;; HL-LOOP
  15390. L30B1:  ADD     HL,HL           ; double result
  15391.         JR      C,L30BE         ; to HL-END if overflow
  15392.  
  15393.         RL      C               ; shift AC left into carry
  15394.         RLA                     ;
  15395.         JR      NC,L30BC        ; to HL-AGAIN to skip addition if no carry
  15396.  
  15397.         ADD     HL,DE           ; add in DE
  15398.         JR      C,L30BE         ; to HL-END if overflow
  15399.  
  15400. ;; HL-AGAIN
  15401. L30BC:  DJNZ    L30B1           ; back to HL-LOOP for all 16 bits
  15402.  
  15403. ;; HL-END
  15404. L30BE:  POP     BC              ; restore preserved BC
  15405.         RET                     ; return with carry reset if successful
  15406.                                 ; and result in HL.
  15407.  
  15408. ; -----------------------------
  15409. ; Prepare to multiply or divide
  15410. ; -----------------------------
  15411. ; This routine is called in succession from multiply and divide to prepare
  15412. ; two mantissas by setting the leftmost bit that is used for the sign.
  15413. ; On the first call A holds zero and picks up the sign bit. On the second
  15414. ; call the two bits are XORed to form the result sign - minus * minus giving
  15415. ; plus etc. If either number is zero then this is flagged.
  15416. ; HL addresses the exponent.
  15417.  
  15418. ;; PREP-M/D
  15419. L30C0:  CALL    L34E9           ; routine TEST-ZERO  preserves accumulator.
  15420.         RET     C               ; return carry set if zero
  15421.  
  15422.         INC     HL              ; address first byte of mantissa
  15423.         XOR     (HL)            ; pick up the first or xor with first.
  15424.         SET     7,(HL)          ; now set to give true 32-bit mantissa
  15425.         DEC     HL              ; point to exponent
  15426.         RET                     ; return with carry reset
  15427.  
  15428. ; --------------------------
  15429. ; Handle multiplication (04)
  15430. ; --------------------------
  15431. ;
  15432. ;
  15433.  
  15434. ;; multiply
  15435. L30CA:  LD      A,(DE)          ;
  15436.         OR      (HL)            ;
  15437.         JR      NZ,L30F0        ; to MULT-LONG
  15438.  
  15439.         PUSH    DE              ;
  15440.         PUSH    HL              ;
  15441.         PUSH    DE              ;
  15442.         CALL    L2D7F           ; routine INT-FETCH
  15443.         EX      DE,HL           ;
  15444.         EX      (SP),HL         ;
  15445.         LD      B,C             ;
  15446.         CALL    L2D7F           ; routine INT-FETCH
  15447.         LD      A,B             ;
  15448.         XOR     C               ;
  15449.         LD      C,A             ;
  15450.         POP     HL              ;
  15451.         CALL    L30A9           ; routine HL-HL*DE
  15452.         EX      DE,HL           ;
  15453.         POP     HL              ;
  15454.         JR      C,L30EF         ; to MULT-OFLW
  15455.  
  15456.         LD      A,D             ;
  15457.         OR      E               ;
  15458.         JR      NZ,L30EA        ; to MULT-RSLT
  15459.  
  15460.         LD      C,A             ;
  15461.  
  15462. ;; MULT-RSLT
  15463. L30EA:  CALL    L2D8E           ; routine INT-STORE
  15464.         POP      DE             ;
  15465.         RET                     ;
  15466.  
  15467. ; ---
  15468.  
  15469. ;; MULT-OFLW
  15470. L30EF:  POP     DE              ;
  15471.  
  15472. ;; MULT-LONG
  15473. L30F0:  CALL    L3293           ; routine RE-ST-TWO
  15474.         XOR     A               ;
  15475.         CALL    L30C0           ; routine PREP-M/D
  15476.         RET     C               ;
  15477.  
  15478.         EXX                     ;
  15479.         PUSH    HL              ;
  15480.         EXX                     ;
  15481.         PUSH    DE              ;
  15482.         EX      DE,HL           ;
  15483.         CALL    L30C0           ; routine PREP-M/D
  15484.         EX      DE,HL           ;
  15485.         JR      C,L315D         ; to ZERO-RSLT
  15486.  
  15487.         PUSH    HL              ;
  15488.         CALL    L2FBA           ; routine FETCH-TWO
  15489.         LD      A,B             ;
  15490.         AND     A               ;
  15491.         SBC     HL,HL           ;
  15492.         EXX                     ;
  15493.         PUSH    HL              ;
  15494.         SBC     HL,HL           ;
  15495.         EXX                     ;
  15496.         LD      B,$21           ;
  15497.         JR      L3125           ; to STRT-MLT
  15498.  
  15499. ; ---
  15500.  
  15501. ;; MLT-LOOP
  15502. L3114:  JR      NC,L311B        ; to NO-ADD
  15503.  
  15504.         ADD     HL,DE           ;
  15505.         EXX                     ;
  15506.         ADC     HL,DE           ;
  15507.         EXX                     ;
  15508.  
  15509. ;; NO-ADD
  15510. L311B:  EXX                     ;
  15511.         RR      H               ;
  15512.         RR      L               ;
  15513.         EXX                     ;
  15514.         RR      H               ;
  15515.         RR      L               ;
  15516.  
  15517. ;; STRT-MLT
  15518. L3125:  EXX                     ;
  15519.         RR      B               ;
  15520.         RR      C               ;
  15521.         EXX                     ;
  15522.         RR      C               ;
  15523.         RRA                     ;
  15524.         DJNZ    L3114           ; to MLT-LOOP
  15525.  
  15526.         EX      DE,HL           ;
  15527.         EXX                     ;
  15528.         EX      DE,HL           ;
  15529.         EXX                     ;
  15530.         POP     BC              ;
  15531.         POP     HL              ;
  15532.         LD      A,B             ;
  15533.         ADD     A,C             ;
  15534.         JR      NZ,L313B        ; to MAKE-EXPT
  15535.  
  15536.         AND     A               ;
  15537.  
  15538. ;; MAKE-EXPT
  15539. L313B:  DEC     A               ;
  15540.         CCF                     ; Complement Carry Flag
  15541.  
  15542. ;; DIVN-EXPT
  15543. L313D:  RLA                     ;
  15544.         CCF                     ; Complement Carry Flag
  15545.         RRA                     ;
  15546.         JP      P,L3146         ; to OFLW1-CLR
  15547.  
  15548.         JR      NC,L31AD        ; to REPORT-6
  15549.  
  15550.         AND     A               ;
  15551.  
  15552. ;; OFLW1-CLR
  15553. L3146:  INC     A               ;
  15554.         JR      NZ,L3151        ; to OFLW2-CLR
  15555.  
  15556.         JR      C,L3151         ; to OFLW2-CLR
  15557.  
  15558.         EXX                     ;
  15559.         BIT     7,D             ;
  15560.         EXX                     ;
  15561.         JR      NZ,L31AD        ; to REPORT-6
  15562.  
  15563. ;; OFLW2-CLR
  15564. L3151:  LD      (HL),A          ;
  15565.         EXX                     ;
  15566.         LD      A,B             ;
  15567.         EXX                     ;
  15568.  
  15569. ;; TEST-NORM
  15570. L3155:  JR      NC,L316C        ; to NORMALISE
  15571.  
  15572.         LD      A,(HL)          ;
  15573.         AND     A               ;
  15574.  
  15575. ;; NEAR-ZERO
  15576. L3159:  LD      A,$80           ;
  15577.         JR      Z,L315E         ; to SKIP-ZERO
  15578.  
  15579. ;; ZERO-RSLT
  15580. L315D:  XOR     A               ;
  15581.  
  15582. ;; SKIP-ZERO
  15583. L315E:  EXX                     ;
  15584.         AND     D               ;
  15585.         CALL    L2FFB           ; routine ZEROS-4/5
  15586.         RLCA                    ;
  15587.         LD      (HL),A          ;
  15588.         JR      C,L3195         ; to OFLOW-CLR
  15589.  
  15590.         INC     HL              ;
  15591.         LD      (HL),A          ;
  15592.         DEC     HL              ;
  15593.         JR      L3195           ; to OFLOW-CLR
  15594.  
  15595. ; ---
  15596.  
  15597. ;; NORMALISE
  15598. L316C:  LD      B,$20           ;
  15599.  
  15600. ;; SHIFT-ONE
  15601. L316E:  EXX                     ;
  15602.         BIT     7,D             ;
  15603.         EXX                     ;
  15604.         JR      NZ,L3186        ; to NORML-NOW
  15605.  
  15606.         RLCA                    ;
  15607.         RL      E               ;
  15608.         RL      D               ;
  15609.         EXX                     ;
  15610.         RL      E               ;
  15611.         RL      D               ;
  15612.         EXX                     ;
  15613.         DEC     (HL)            ;
  15614.         JR      Z,L3159         ; to NEAR-ZERO
  15615.  
  15616.         DJNZ    L316E           ; to SHIFT-ONE
  15617.  
  15618.         JR      L315D           ; to ZERO-RSLT
  15619.  
  15620. ; ---
  15621.  
  15622. ;; NORML-NOW
  15623. L3186:  RLA                     ;
  15624.         JR      NC,L3195        ; to OFLOW-CLR
  15625.  
  15626.         CALL    L3004           ; routine ADD-BACK
  15627.         JR      NZ,L3195        ; to OFLOW-CLR
  15628.  
  15629.         EXX                     ;
  15630.         LD       D,$80          ;
  15631.         EXX                     ;
  15632.         INC     (HL)            ;
  15633.         JR      Z,L31AD         ; to REPORT-6
  15634.  
  15635. ;; OFLOW-CLR
  15636. L3195:  PUSH    HL              ;
  15637.         INC     HL              ;
  15638.         EXX                     ;
  15639.         PUSH    DE              ;
  15640.         EXX                     ;
  15641.         POP     BC              ;
  15642.         LD      A,B             ;
  15643.         RLA                     ;
  15644.         RL      (HL)            ;
  15645.         RRA                     ;
  15646.         LD      (HL),A          ;
  15647.         INC     HL              ;
  15648.         LD      (HL),C          ;
  15649.         INC     HL              ;
  15650.         LD      (HL),D          ;
  15651.         INC     HL              ;
  15652.         LD      (HL),E          ;
  15653.         POP     HL              ;
  15654.         POP     DE              ;
  15655.         EXX                     ;
  15656.         POP     HL              ;
  15657.         EXX                     ;
  15658.         RET                     ;
  15659.  
  15660. ; ---
  15661.  
  15662. ;; REPORT-6
  15663. L31AD:  RST     08H             ; ERROR-1
  15664.         DB    $05             ; Error Report: Number too big
  15665.  
  15666. ; --------------------
  15667. ; Handle division (05)
  15668. ; --------------------
  15669. ;
  15670. ;
  15671.  
  15672. ;; division
  15673. L31AF:  CALL    L3293           ; routine RE-ST-TWO
  15674.         EX      DE,HL           ;
  15675.         XOR     A               ;
  15676.         CALL    L30C0           ; routine PREP-M/D
  15677.         JR      C,L31AD         ; to REPORT-6
  15678.  
  15679.         EX      DE,HL           ;
  15680.         CALL    L30C0           ; routine PREP-M/D
  15681.         RET     C               ;
  15682.  
  15683.         EXX                     ;
  15684.         PUSH    HL              ;
  15685.         EXX                     ;
  15686.         PUSH    DE              ;
  15687.         PUSH    HL              ;
  15688.         CALL    L2FBA           ; routine FETCH-TWO
  15689.         EXX                     ;
  15690.         PUSH    HL              ;
  15691.         LD      H,B             ;
  15692.         LD      L,C             ;
  15693.         EXX                     ;
  15694.         LD      H,C             ;
  15695.         LD      L,B             ;
  15696.         XOR     A               ;
  15697.         LD      B,$DF           ;
  15698.         JR      L31E2           ; to DIV-START
  15699.  
  15700. ; ---
  15701.  
  15702. ;; DIV-LOOP
  15703. L31D2:  RLA                     ;
  15704.         RL      C               ;
  15705.         EXX                     ;
  15706.         RL      C               ;
  15707.         RL      B               ;
  15708.         EXX                     ;
  15709.  
  15710. ;; div-34th
  15711. L31DB:  ADD     HL,HL           ;
  15712.         EXX                     ;
  15713.         ADC     HL,HL           ;
  15714.         EXX                     ;
  15715.         JR      C,L31F2         ; to SUBN-ONLY
  15716.  
  15717. ;; DIV-START
  15718. L31E2:  SBC     HL,DE           ;
  15719.         EXX                     ;
  15720.         SBC     HL,DE           ;
  15721.         EXX                     ;
  15722.         JR      NC,L31F9        ; to NO-RSTORE
  15723.  
  15724.         ADD     HL,DE           ;
  15725.         EXX                     ;
  15726.         ADC     HL,DE           ;
  15727.         EXX                     ;
  15728.         AND     A               ;
  15729.         JR      L31FA           ; to COUNT-ONE
  15730.  
  15731. ; ---
  15732.  
  15733. ;; SUBN-ONLY
  15734. L31F2:  AND     A               ;
  15735.         SBC     HL,DE           ;
  15736.         EXX                     ;
  15737.         SBC     HL,DE           ;
  15738.         EXX                     ;
  15739.  
  15740. ;; NO-RSTORE
  15741. L31F9:  SCF                     ; Set Carry Flag
  15742.  
  15743. ;; COUNT-ONE
  15744. L31FA:  INC     B               ;
  15745.         JP      M,L31D2         ; to DIV-LOOP
  15746.  
  15747.         PUSH    AF              ;
  15748.         JR      Z,L31E2         ; to DIV-START
  15749.  
  15750. ;
  15751. ;
  15752. ;
  15753. ;
  15754.  
  15755.         LD      E,A             ;
  15756.         LD      D,C             ;
  15757.         EXX                     ;
  15758.         LD      E,C             ;
  15759.         LD      D,B             ;
  15760.         POP     AF              ;
  15761.         RR      B               ;
  15762.         POP     AF              ;
  15763.         RR      B               ;
  15764.         EXX                     ;
  15765.         POP     BC              ;
  15766.         POP     HL              ;
  15767.         LD      A,B             ;
  15768.         SUB     C               ;
  15769.         JP      L313D           ; jump back to DIVN-EXPT
  15770.  
  15771. ; ------------------------------------
  15772. ; Integer truncation towards zero ($3A)
  15773. ; ------------------------------------
  15774. ;
  15775. ;
  15776.  
  15777. ;; truncate
  15778. L3214:  LD      A,(HL)          ;
  15779.         AND     A               ;
  15780.         RET     Z               ;
  15781.  
  15782.         CP      $81             ;
  15783.         JR      NC,L3221        ; to T-GR-ZERO
  15784.  
  15785.         LD      (HL),$00        ;
  15786.         LD      A,$20           ;
  15787.         JR      L3272           ; to NIL-BYTES
  15788.  
  15789. ; ---
  15790.  
  15791. ;; T-GR-ZERO
  15792. L3221:  CP      $91             ;
  15793.         JR      NZ,L323F        ; to T-SMALL
  15794.  
  15795.         INC     HL              ;
  15796.         INC     HL              ;
  15797.         INC     HL              ;
  15798.         LD      A,$80           ;
  15799.         AND     (HL)            ;
  15800.         DEC      HL             ;
  15801.         OR      (HL)            ;
  15802.         DEC     HL              ;
  15803.         JR      NZ,L3233        ; to T-FIRST
  15804.  
  15805.         LD      A,$80           ;
  15806.         XOR     (HL)            ;
  15807.  
  15808. ;; T-FIRST
  15809. L3233:  DEC     HL              ;
  15810.         JR      NZ,L326C        ; to T-EXPNENT
  15811.  
  15812.         LD      (HL),A          ;
  15813.         INC     HL              ;
  15814.         LD      (HL),$FF        ;
  15815.         DEC     HL              ;
  15816.         LD      A,$18           ;
  15817.         JR      L3272           ; to NIL-BYTES
  15818.  
  15819. ; ---
  15820.  
  15821. ;; T-SMALL
  15822. L323F:  JR      NC,L326D        ; to X-LARGE
  15823.  
  15824.         PUSH    DE              ;
  15825.         CPL                     ;
  15826.         ADD     A,$91           ;
  15827.         INC     HL              ;
  15828.         LD      D,(HL)          ;
  15829.         INC     HL              ;
  15830.         LD      E,(HL)          ;
  15831.         DEC     HL              ;
  15832.         DEC     HL              ;
  15833.         LD      C,$00           ;
  15834.         BIT     7,D             ;
  15835.         JR      Z,L3252         ; to T-NUMERIC
  15836.  
  15837.         DEC     C               ;
  15838.  
  15839. ;; T-NUMERIC
  15840. L3252:  SET     7,D             ;
  15841.         LD      B,$08           ;
  15842.         SUB     B               ;
  15843.         ADD     A,B             ;
  15844.         JR      C,L325E         ; to T-TEST
  15845.  
  15846.         LD      E,D             ;
  15847.         LD      D,$00           ;
  15848.         SUB     B               ;
  15849.  
  15850. ;; T-TEST
  15851. L325E:  JR      Z,L3267         ; to T-STORE
  15852.  
  15853.         LD      B,A             ;
  15854.  
  15855. ;; T-SHIFT
  15856. L3261:  SRL     D               ;
  15857.         RR      E               ;
  15858.         DJNZ    L3261           ; to T-SHIFT
  15859.  
  15860. ;; T-STORE
  15861. L3267:  CALL    L2D8E           ; routine INT-STORE
  15862.         POP     DE              ;
  15863.         RET                     ;
  15864.  
  15865. ; ---
  15866.  
  15867. ;; T-EXPNENT
  15868. L326C:  LD      A,(HL)          ;
  15869.  
  15870. ;; X-LARGE
  15871. L326D:  SUB     $A0             ;
  15872.         RET     P               ;
  15873.  
  15874.         NEG                     ; Negate
  15875.  
  15876. ;; NIL-BYTES
  15877. L3272:  PUSH    DE              ;
  15878.         EX      DE,HL           ;
  15879.         DEC     HL              ;
  15880.         LD      B,A             ;
  15881.         SRL     B               ;
  15882.         SRL     B               ;
  15883.         SRL     B               ;
  15884.         JR      Z,L3283         ; to BITS-ZERO
  15885.  
  15886. ;; BYTE-ZERO
  15887. L327E:  LD      (HL),$00        ;
  15888.         DEC     HL              ;
  15889.         DJNZ    L327E           ; to BYTE-ZERO
  15890.  
  15891. ;; BITS-ZERO
  15892. L3283:  AND     $07             ;
  15893.         JR      Z,L3290         ; to IX-END
  15894.  
  15895.         LD      B,A             ;
  15896.         LD      A,$FF           ;
  15897.  
  15898. ;; LESS-MASK
  15899. L328A:  SLA     A               ;
  15900.         DJNZ    L328A           ; to LESS-MASK
  15901.  
  15902.         AND     (HL)            ;
  15903.         LD      (HL),A          ;
  15904.  
  15905. ;; IX-END
  15906. L3290:  EX      DE,HL           ;
  15907.         POP     DE              ;
  15908.         RET                     ;
  15909.  
  15910. ; ----------------------------------
  15911. ; Storage of numbers in 5 byte form.
  15912. ; ==================================
  15913. ; Both integers and floating-point numbers can be stored in five bytes.
  15914. ; Zero is a special case stored as 5 zeros.
  15915. ; For integers the form is
  15916. ; Byte 1 - zero,
  15917. ; Byte 2 - sign byte, $00 +ve, $FF -ve.
  15918. ; Byte 3 - Low byte of integer.
  15919. ; Byte 4 - High byte
  15920. ; Byte 5 - unused but always zero.
  15921. ;
  15922. ; it seems unusual to store the low byte first but it is just as easy either
  15923. ; way. Statistically it just increases the chances of trailing zeros which
  15924. ; is an advantage elsewhere in saving ROM code.
  15925. ;
  15926. ;             zero     sign     low      high    unused
  15927. ; So +1 is  00000000 00000000 00000001 00000000 00000000
  15928. ;
  15929. ; and -1 is 00000000 11111111 11111111 11111111 00000000
  15930. ;
  15931. ; much of the arithmetic found in BASIC lines can be done using numbers
  15932. ; in this form using the Z80's 16 bit register operation ADD.
  15933. ; (multiplication is done by a sequence of additions).
  15934. ;
  15935. ; Storing -ve integers in two's complement form, means that they are ready for
  15936. ; addition and you might like to add the numbers above to prove that the
  15937. ; answer is zero. If, as in this case, the carry is set then that denotes that
  15938. ; the result is positive. This only applies when the signs don't match.
  15939. ; With positive numbers a carry denotes the result is out of integer range.
  15940. ; With negative numbers a carry denotes the result is within range.
  15941. ; The exception to the last rule is when the result is -65536
  15942. ;
  15943. ; Floating point form is an alternative method of storing numbers which can
  15944. ; be used for integers and larger (or fractional) numbers.
  15945. ;
  15946. ; In this form 1 is stored as
  15947. ;           10000001 00000000 00000000 00000000 00000000
  15948. ;
  15949. ; When a small integer is converted to a floating point number the last two
  15950. ; bytes are always blank so they are omitted in the following steps
  15951. ;
  15952. ; first make exponent +1 +16d  (bit 7 of the exponent is set if positive)
  15953.  
  15954. ; 10010001 00000000 00000001
  15955. ; 10010000 00000000 00000010 <-  now shift left and decrement exponent
  15956. ; ...
  15957. ; 10000010 01000000 00000000 <-  until a 1 abuts the imaginary point
  15958. ; 10000001 10000000 00000000     to the left of the mantissa.
  15959. ;
  15960. ; however since the leftmost bit of the mantissa is always set then it can
  15961. ; be used to denote the sign of the mantissa and put back when needed by the
  15962. ; PREP routines which gives
  15963. ;
  15964. ; 10000001 00000000 00000000
  15965.  
  15966. ; -----------------------------
  15967. ; Re-stack two `small' integers
  15968. ; -----------------------------
  15969. ; This routine is called to re-stack two numbers in full floating point form
  15970. ; e.g. from mult when integer multiplication has overflowed.
  15971.  
  15972. ;; RE-ST-TWO
  15973. L3293:  CALL    L3296           ; routine RESTK-SUB  below and continue
  15974.                                 ; into the routine to do the other one.
  15975.  
  15976. ;; RESTK-SUB
  15977. L3296:  EX      DE,HL           ; swap pointers
  15978.  
  15979. ; --------------------------------
  15980. ; Re-stack one number in full form
  15981. ; --------------------------------
  15982. ; This routine re-stacks an integer usually on the calculator stack
  15983. ; in full floating point form.
  15984. ; HL points to first byte.
  15985.  
  15986. ;; re-stack
  15987. L3297:  LD      A,(HL)          ; Fetch Exponent byte to A
  15988.         AND     A               ; test it
  15989.         RET     NZ              ; return if not zero as already in full
  15990.                                 ; floating-point form.
  15991.  
  15992.         PUSH    DE              ; preserve DE.
  15993.         CALL    L2D7F           ; routine INT-FETCH
  15994.                                 ; integer to DE, sign to C.
  15995.  
  15996. ; HL points to 4th byte.
  15997.  
  15998.         XOR     A               ; clear accumulator.
  15999.         INC     HL              ; point to 5th.
  16000.         LD      (HL),A          ; and blank.
  16001.         DEC     HL              ; point to 4th.
  16002.         LD      (HL),A          ; and blank.
  16003.  
  16004.         LD      B,$91           ; set exponent byte +ve $81
  16005.                                 ; and imaginary dec point 16 bits to right
  16006.                                 ; of first bit.
  16007.  
  16008. ; we could skip to normalize now but it's quicker to avoid
  16009. ; normalizing through an empty D.
  16010.  
  16011.         LD      A,D             ; fetch the high byte D
  16012.         AND     A               ; is it zero ?
  16013.         JR      NZ,L32B1        ; skip to RS-NRMLSE if not.
  16014.  
  16015.         OR      E               ; low byte E to A and test for zero
  16016.         LD      B,D             ; set B exponent to 0
  16017.         JR      Z,L32BD         ; forward to RS-STORE if value is zero.
  16018.  
  16019.         LD      D,E             ; transfer E to D
  16020.         LD      E,B             ; set E to 0
  16021.         LD      B,$89           ; reduce the initial exponent by eight.
  16022.  
  16023.  
  16024. ;; RS-NRMLSE
  16025. L32B1:  EX      DE,HL           ; integer to HL, addr of 4th byte to DE.
  16026.  
  16027. ;; RSTK-LOOP
  16028. L32B2:  DEC     B               ; decrease exponent
  16029.         ADD     HL,HL           ; shift DE left
  16030.         JR      NC,L32B2        ; loop back to RSTK-LOOP
  16031.                                 ; until a set bit pops into carry
  16032.  
  16033.         RRC     C               ; now rotate the sign byte $00 or $FF
  16034.                                 ; into carry to give a sign bit
  16035.  
  16036.         RR      H               ; rotate the sign bit to left of H
  16037.         RR      L               ; rotate any carry into L
  16038.  
  16039.         EX      DE,HL           ; address 4th byte, normalized int to DE
  16040.  
  16041. ;; RS-STORE
  16042. L32BD:  DEC     HL              ; address 3rd byte
  16043.         LD      (HL),E          ; place E
  16044.         DEC     HL              ; address 2nd byte
  16045.         LD      (HL),D          ; place D
  16046.         DEC     HL              ; address 1st byte
  16047.         LD      (HL),B          ; store the exponent
  16048.  
  16049.         POP     DE              ; restore initial DE.
  16050.         RET                     ; return.
  16051.  
  16052. ;****************************************
  16053. ;** Part 10. FLOATING-POINT CALCULATOR **
  16054. ;****************************************
  16055.  
  16056. ; As a general rule the calculator avoids using the IY register.
  16057. ; exceptions are val, val$ and str$.
  16058. ; So an assembly language programmer who has disabled interrupts to use
  16059. ; IY for other purposes can still use the calculator for mathematical
  16060. ; purposes.
  16061.  
  16062.  
  16063. ; ------------------
  16064. ; Table of constants
  16065. ; ------------------
  16066. ;
  16067. ;
  16068.  
  16069. ; used 11 times
  16070. ;; stk-zero                                                 00 00 00 00 00
  16071. L32C5:  DB    $00             ;;Bytes: 1
  16072.         DB    $B0             ;;Exponent $00
  16073.         DB    $00             ;;(+00,+00,+00)
  16074.  
  16075. ; used 19 times
  16076. ;; stk-one                                                  00 00 01 00 00
  16077. L32C8:  DB    $40             ;;Bytes: 2
  16078.         DB    $B0             ;;Exponent $00
  16079.         DB    $00,$01         ;;(+00,+00)
  16080.  
  16081. ; used 9 times
  16082. ;; stk-half                                                 80 00 00 00 00
  16083. L32CC:  DB    $30             ;;Exponent: $80, Bytes: 1
  16084.         DB    $00             ;;(+00,+00,+00)
  16085.  
  16086. ; used 4 times.
  16087. ;; stk-pi/2                                                 81 49 0F DA A2
  16088. L32CE:  DB    $F1             ;;Exponent: $81, Bytes: 4
  16089.         DB    $49,$0F,$DA,$A2 ;;
  16090.  
  16091. ; used 3 times.
  16092. ;; stk-ten                                                  00 00 0A 00 00
  16093. L32D3:  DB    $40             ;;Bytes: 2
  16094.         DB    $B0             ;;Exponent $00
  16095.         DB    $00,$0A         ;;(+00,+00)
  16096.  
  16097.  
  16098. ; ------------------
  16099. ; Table of addresses
  16100. ; ------------------
  16101. ;
  16102. ; starts with binary operations which have two operands and one result.
  16103. ; three pseudo binary operations first.
  16104.  
  16105. ;; tbl-addrs
  16106. L32D7:  DEFW    L368F           ; $00 Address: $368F - jump-true
  16107.         DEFW    L343C           ; $01 Address: $343C - exchange
  16108.         DEFW    L33A1           ; $02 Address: $33A1 - delete
  16109.  
  16110. ; true binary operations.
  16111.  
  16112.         DEFW    L300F           ; $03 Address: $300F - subtract
  16113.         DEFW    L30CA           ; $04 Address: $30CA - multiply
  16114.         DEFW    L31AF           ; $05 Address: $31AF - division
  16115.         DEFW    L3851           ; $06 Address: $3851 - to-power
  16116.         DEFW    L351B           ; $07 Address: $351B - or
  16117.  
  16118.         DEFW    L3524           ; $08 Address: $3524 - no-&-no
  16119.         DEFW    L353B           ; $09 Address: $353B - no-l-eql
  16120.         DEFW    L353B           ; $0A Address: $353B - no-gr-eql
  16121.         DEFW    L353B           ; $0B Address: $353B - nos-neql
  16122.         DEFW    L353B           ; $0C Address: $353B - no-grtr
  16123.         DEFW    L353B           ; $0D Address: $353B - no-less
  16124.         DEFW    L353B           ; $0E Address: $353B - nos-eql
  16125.         DEFW    L3014           ; $0F Address: $3014 - addition
  16126.  
  16127.         DEFW    L352D           ; $10 Address: $352D - str-&-no
  16128.         DEFW    L353B           ; $11 Address: $353B - str-l-eql
  16129.         DEFW    L353B           ; $12 Address: $353B - str-gr-eql
  16130.         DEFW    L353B           ; $13 Address: $353B - strs-neql
  16131.         DEFW    L353B           ; $14 Address: $353B - str-grtr
  16132.         DEFW    L353B           ; $15 Address: $353B - str-less
  16133.         DEFW    L353B           ; $16 Address: $353B - strs-eql
  16134.         DEFW    L359C           ; $17 Address: $359C - strs-add
  16135.  
  16136. ; unary follow
  16137.  
  16138.         DEFW    L35DE           ; $18 Address: $35DE - val$
  16139.         DEFW    L34BC           ; $19 Address: $34BC - usr-$
  16140.         DEFW    L3645           ; $1A Address: $3645 - read-in
  16141.         DEFW    L346E           ; $1B Address: $346E - negate
  16142.  
  16143.         DEFW    L3669           ; $1C Address: $3669 - code
  16144.         DEFW    L35DE           ; $1D Address: $35DE - val
  16145.         DEFW    L3674           ; $1E Address: $3674 - len
  16146.         DEFW    L37B5           ; $1F Address: $37B5 - sin
  16147.         DEFW    L37AA           ; $20 Address: $37AA - cos
  16148.         DEFW    L37DA           ; $21 Address: $37DA - tan
  16149.         DEFW    L3833           ; $22 Address: $3833 - asn
  16150.         DEFW    L3843           ; $23 Address: $3843 - acs
  16151.         DEFW    L37E2           ; $24 Address: $37E2 - atn
  16152.         DEFW    L3713           ; $25 Address: $3713 - ln
  16153.         DEFW    L36C4           ; $26 Address: $36C4 - exp
  16154.         DEFW    L36AF           ; $27 Address: $36AF - int
  16155.         DEFW    L384A           ; $28 Address: $384A - sqr
  16156.         DEFW    L3492           ; $29 Address: $3492 - sgn
  16157.         DEFW    L346A           ; $2A Address: $346A - abs
  16158.         DEFW    L34AC           ; $2B Address: $34AC - peek
  16159.         DEFW    L34A5           ; $2C Address: $34A5 - in
  16160.         DEFW    L34B3           ; $2D Address: $34B3 - usr-no
  16161.         DEFW    L361F           ; $2E Address: $361F - str$
  16162.         DEFW    L35C9           ; $2F Address: $35C9 - chrs
  16163.         DEFW    L3501           ; $30 Address: $3501 - not
  16164.  
  16165. ; end of true unary
  16166.  
  16167.         DEFW    L33C0           ; $31 Address: $33C0 - duplicate
  16168.         DEFW    L36A0           ; $32 Address: $36A0 - n-mod-m
  16169.         DEFW    L3686           ; $33 Address: $3686 - jump
  16170.         DEFW    L33C6           ; $34 Address: $33C6 - stk-data
  16171.         DEFW    L367A           ; $35 Address: $367A - dec-jr-nz
  16172.         DEFW    L3506           ; $36 Address: $3506 - less-0
  16173.         DEFW    L34F9           ; $37 Address: $34F9 - greater-0
  16174.         DEFW    L369B           ; $38 Address: $369B - end-calc
  16175.         DEFW    L3783           ; $39 Address: $3783 - get-argt
  16176.         DEFW    L3214           ; $3A Address: $3214 - truncate
  16177.         DEFW    L33A2           ; $3B Address: $33A2 - fp-calc-2
  16178.         DEFW    L2D4F           ; $3C Address: $2D4F - e-to-fp
  16179.         DEFW    L3297           ; $3D Address: $3297 - re-stack
  16180.  
  16181. ; the following are just the next available slots for the 128 compound literals
  16182. ; which are in range $80 - $FF.
  16183.  
  16184.         DEFW    L3449           ; $3E Address: $3449 - series-xx    $80 - $9F.
  16185.         DEFW    L341B           ; $3F Address: $341B - stk-const-xx $A0 - $BF.
  16186.         DEFW    L342D           ; $40 Address: $342D - st-mem-xx    $C0 - $DF.
  16187.         DEFW    L340F           ; $41 Address: $340F - get-mem-xx   $E0 - $FF.
  16188.  
  16189. ; Aside: 3E - 7F are therefore unused calculator literals.
  16190. ;        3E - 7B would be available for expansion.
  16191.  
  16192. ; --------------
  16193. ; The Calculator
  16194. ; --------------
  16195. ;
  16196. ;
  16197.  
  16198. ;; CALCULATE
  16199. L335B:  CALL    L35BF           ; routine STK-PNTRS is called to set up the
  16200.                                 ; calculator stack pointers for a default
  16201.                                 ; unary operation. HL = last value on stack.
  16202.                                 ; DE = STKEND first location after stack.
  16203.  
  16204. ; the calculate routine is called at this point by the series generator...
  16205.  
  16206. ;; GEN-ENT-1
  16207. L335E:  LD      A,B             ; fetch the Z80 B register to A
  16208.         LD      ($5C67),A       ; and store value in system variable BREG.
  16209.                                 ; this will be the counter for dec-jr-nz
  16210.                                 ; or if used from fp-calc2 the calculator
  16211.                                 ; instruction.
  16212.  
  16213. ; ... and again later at this point
  16214.  
  16215. ;; GEN-ENT-2
  16216. L3362:  EXX                     ; switch sets
  16217.         EX      (SP),HL         ; and store the address of next instruction,
  16218.                                 ; the return address, in H'L'.
  16219.                                 ; If this is a recursive call the the H'L'
  16220.                                 ; of the previous invocation goes on stack.
  16221.                                 ; c.f. end-calc.
  16222.         EXX                     ; switch back to main set
  16223.  
  16224. ; this is the re-entry looping point when handling a string of literals.
  16225.  
  16226. ;; RE-ENTRY
  16227. L3365:  LD      ($5C65),DE      ; save end of stack in system variable STKEND
  16228.         EXX                     ; switch to alt
  16229.         LD      A,(HL)          ; get next literal
  16230.         INC     HL              ; increase pointer'
  16231.  
  16232. ; single operation jumps back to here
  16233.  
  16234. ;; SCAN-ENT
  16235. L336C:  PUSH    HL              ; save pointer on stack
  16236.         AND     A               ; now test the literal
  16237.         JP      P,L3380         ; forward to FIRST-3D if in range $00 - $3D
  16238.                                 ; anything with bit 7 set will be one of
  16239.                                 ; 128 compound literals.
  16240.  
  16241. ; compound literals have the following format.
  16242. ; bit 7 set indicates compound.
  16243. ; bits 6-5 the subgroup 0-3.
  16244. ; bits 4-0 the embedded parameter $00 - $1F.
  16245. ; The subgroup 0-3 needs to be manipulated to form the next available four
  16246. ; address places after the simple literals in the address table.
  16247.  
  16248.         LD      D,A             ; save literal in D
  16249.         AND     $60             ; and with 01100000 to isolate subgroup
  16250.         RRCA                    ; rotate bits
  16251.         RRCA                    ; 4 places to right
  16252.         RRCA                    ; not five as we need offset * 2
  16253.         RRCA                    ; 00000xx0
  16254.         ADD     A,$7C           ; add ($3E * 2) to give correct offset.
  16255.                                 ; alter above if you add more literals.
  16256.         LD      L,A             ; store in L for later indexing.
  16257.         LD      A,D             ; bring back compound literal
  16258.         AND     $1F             ; use mask to isolate parameter bits
  16259.         JR      L338E           ; forward to ENT-TABLE
  16260.  
  16261. ; ---
  16262.  
  16263. ; the branch was here with simple literals.
  16264.  
  16265. ;; FIRST-3D
  16266. L3380:  CP      $18             ; compare with first unary operations.
  16267.         JR      NC,L338C        ; to DOUBLE-A with unary operations
  16268.  
  16269. ; it is binary so adjust pointers.
  16270.  
  16271.         EXX                     ;
  16272.         LD      BC,$FFFB        ; the value -5
  16273.         LD      D,H             ; transfer HL, the last value, to DE.
  16274.         LD      E,L             ;
  16275.         ADD     HL,BC           ; subtract 5 making HL point to second
  16276.                                 ; value.
  16277.         EXX                     ;
  16278.  
  16279. ;; DOUBLE-A
  16280. L338C:  RLCA                    ; double the literal
  16281.         LD      L,A             ; and store in L for indexing
  16282.  
  16283. ;; ENT-TABLE
  16284. L338E:  LD      DE,L32D7        ; Address: tbl-addrs
  16285.         LD      H,$00           ; prepare to index
  16286.         ADD     HL,DE           ; add to get address of routine
  16287.         LD      E,(HL)          ; low byte to E
  16288.         INC     HL              ;
  16289.         LD      D,(HL)          ; high byte to D
  16290.         LD      HL,L3365        ; Address: RE-ENTRY
  16291.         EX      (SP),HL         ; goes to stack
  16292.         PUSH    DE              ; now address of routine
  16293.         EXX                     ; main set
  16294.                                 ; avoid using IY register.
  16295.         LD      BC,($5C66)      ; STKEND_hi
  16296.                                 ; nothing much goes to C but BREG to B
  16297.                                 ; and continue into next ret instruction
  16298.                                 ; which has a dual identity
  16299.  
  16300.  
  16301. ; ------------------
  16302. ; Handle delete (02)
  16303. ; ------------------
  16304. ; A simple return but when used as a calculator literal this
  16305. ; deletes the last value from the calculator stack.
  16306. ; On entry, as always with binary operations,
  16307. ; HL=first number, DE=second number
  16308. ; On exit, HL=result, DE=stkend.
  16309. ; So nothing to do
  16310.  
  16311. ;; delete
  16312. L33A1:  RET                     ; return - indirect jump if from above.
  16313.  
  16314. ; ---------------------
  16315. ; Single operation (3B)
  16316. ; ---------------------
  16317. ; this single operation is used, in the first instance, to evaluate most
  16318. ; of the mathematical and string functions found in BASIC expressions.
  16319.  
  16320. ;; fp-calc-2
  16321. L33A2:  POP     AF              ; drop return address.
  16322.         LD      A,($5C67)       ; load accumulator from system variable BREG
  16323.                                 ; value will be literal eg. 'tan'
  16324.         EXX                     ; switch to alt
  16325.         JR      L336C           ; back to SCAN-ENT
  16326.                                 ; next literal will be end-calc at L2758
  16327.  
  16328. ; ----------------
  16329. ; Test five-spaces
  16330. ; ----------------
  16331. ; This routine is called from MOVE-FP, STK-CONST and STK-STORE to
  16332. ; test that there is enough space between the calculator stack and the
  16333. ; machine stack for another five-byte value. It returns with BC holding
  16334. ; the value 5 ready for any subsequent LDIR.
  16335.  
  16336. ;; TEST-5-SP
  16337. L33A9:  PUSH    DE              ; save
  16338.         PUSH    HL              ; registers
  16339.         LD      BC,$0005        ; an overhead of five bytes
  16340.         CALL    L1F05           ; routine TEST-ROOM tests free RAM raising
  16341.                                 ; an error if not.
  16342.         POP     HL              ; else restore
  16343.         POP     DE              ; registers.
  16344.         RET                     ; return with BC set at 5.
  16345.  
  16346. ; ------------
  16347. ; Stack number
  16348. ; ------------
  16349. ; This routine is called to stack a hidden floating point number found in
  16350. ; a BASIC line. It is also called to stack a numeric variable value, and
  16351. ; from BEEP, to stack an entry in the semi-tone table. It is not part of the
  16352. ; calculator suite of routines.
  16353. ; On entry HL points to the number to be stacked.
  16354.  
  16355. ;; STACK-NUM
  16356. L33B4:  LD      DE,($5C65)      ; load destination from STKEND system variable.
  16357.         CALL    L33C0           ; routine MOVE-FP puts on calculator stack
  16358.                                 ; with a memory check.
  16359.         LD      ($5C65),DE      ; set STKEND to next free location.
  16360.         RET                     ; return.
  16361.  
  16362. ; ---------------------------------
  16363. ; Move a floating point number (31)
  16364. ; ---------------------------------
  16365. ; This simple routine is a 5-byte LDIR instruction
  16366. ; that incorporates a memory check.
  16367. ; When used as a calculator literal it duplicates the last value on the
  16368. ; calculator stack.
  16369. ; Unary so on entry HL points to last value, DE to stkend
  16370.  
  16371. ;; duplicate
  16372. ;; MOVE-FP
  16373. L33C0:  CALL    L33A9           ; routine TEST-5-SP test free memory
  16374.                                 ; and sets BC to 5.
  16375.         LDIR                    ; copy the five bytes.
  16376.         RET                     ; return with DE addressing new STKEND
  16377.                                 ; and HL addressing new last value.
  16378.  
  16379. ; -------------------
  16380. ; Stack literals ($34)
  16381. ; -------------------
  16382. ; When a calculator subroutine needs to put a value on the calculator
  16383. ; stack that is not a regular constant this routine is called with a
  16384. ; variable number of following data bytes that convey to the routine
  16385. ; the integer or floating point form as succinctly as is possible.
  16386.  
  16387. ;; stk-data
  16388. L33C6:  LD      H,D             ; transfer STKEND
  16389.         LD      L,E             ; to HL for result.
  16390.  
  16391. ;; STK-CONST
  16392. L33C8:  CALL    L33A9           ; routine TEST-5-SP tests that room exists
  16393.                                 ; and sets BC to $05.
  16394.  
  16395.         EXX                     ; switch to alternate set
  16396.         PUSH    HL              ; save the pointer to next literal on stack
  16397.         EXX                     ; switch back to main set
  16398.  
  16399.         EX      (SP),HL         ; pointer to HL, destination to stack.
  16400.  
  16401.         PUSH    BC              ; save BC - value 5 from test room ??.
  16402.  
  16403.         LD      A,(HL)          ; fetch the byte following 'stk-data'
  16404.         AND     $C0             ; isolate bits 7 and 6
  16405.         RLCA                    ; rotate
  16406.         RLCA                    ; to bits 1 and 0  range $00 - $03.
  16407.         LD      C,A             ; transfer to C
  16408.         INC     C               ; and increment to give number of bytes
  16409.                                 ; to read. $01 - $04
  16410.         LD      A,(HL)          ; reload the first byte
  16411.         AND     $3F             ; mask off to give possible exponent.
  16412.         JR      NZ,L33DE        ; forward to FORM-EXP if it was possible to
  16413.                                 ; include the exponent.
  16414.  
  16415. ; else byte is just a byte count and exponent comes next.
  16416.  
  16417.         INC     HL              ; address next byte and
  16418.         LD      A,(HL)          ; pick up the exponent ( - $50).
  16419.  
  16420. ;; FORM-EXP
  16421. L33DE:  ADD     A,$50           ; now add $50 to form actual exponent
  16422.         LD      (DE),A          ; and load into first destination byte.
  16423.         LD      A,$05           ; load accumulator with $05 and
  16424.         SUB     C               ; subtract C to give count of trailing
  16425.                                 ; zeros plus one.
  16426.         INC     HL              ; increment source
  16427.         INC     DE              ; increment destination
  16428.         LD      B,$00           ; prepare to copy
  16429.         LDIR                    ; copy C bytes
  16430.  
  16431.         POP     BC              ; restore 5 counter to BC ??.
  16432.  
  16433.         EX      (SP),HL         ; put HL on stack as next literal pointer
  16434.                                 ; and the stack value - result pointer -
  16435.                                 ; to HL.
  16436.  
  16437.         EXX                     ; switch to alternate set.
  16438.         POP     HL              ; restore next literal pointer from stack
  16439.                                 ; to H'L'.
  16440.         EXX                     ; switch back to main set.
  16441.  
  16442.         LD      B,A             ; zero count to B
  16443.         XOR     A               ; clear accumulator
  16444.  
  16445. ;; STK-ZEROS
  16446. L33F1:  DEC     B               ; decrement B counter
  16447.         RET     Z               ; return if zero.          >>
  16448.                                 ; DE points to new STKEND
  16449.                                 ; HL to new number.
  16450.  
  16451.         LD      (DE),A          ; else load zero to destination
  16452.         INC     DE              ; increase destination
  16453.         JR      L33F1           ; loop back to STK-ZEROS until done.
  16454.  
  16455. ; -------------------------------
  16456. ; THE 'SKIP CONSTANTS' SUBROUTINE
  16457. ; -------------------------------
  16458. ; This routine traverses variable-length entries in the table of constants,
  16459. ; stacking intermediate, unwanted constants onto a dummy calculator stack,
  16460. ; in the first five bytes of ROM. The destination DE normally points to the
  16461. ; end of the calculator stack which might be in the normal place or in the
  16462. ; system variables area during E-LINE-NO; INT-TO-FP; stk-ten. In any case,
  16463. ; it would be simpler all round if the routine just shoved unwanted values
  16464. ; where it is going to stick the wanted value.
  16465. ; The instruction LD DE, $0000 can be removed.
  16466.  
  16467. ;; SKIP-CONS
  16468. L33F7:  AND     A               ; test if initially zero.
  16469.  
  16470. ;; SKIP-NEXT
  16471. L33F8:  RET     Z               ; return if zero.          >>
  16472.  
  16473.         PUSH    AF              ; save count.
  16474.         PUSH    DE              ; and normal STKEND
  16475.  
  16476.         LD      DE,$0000        ; dummy value for STKEND at start of ROM
  16477.                                 ; Note. not a fault but this has to be
  16478.                                 ; moved elsewhere when running in RAM.
  16479.                                 ; e.g. with Expandor Systems 'Soft ROM'.
  16480.                                 ; Better still, write to the normal place.
  16481.         CALL    L33C8           ; routine STK-CONST works through variable
  16482.                                 ; length records.
  16483.  
  16484.         POP     DE              ; restore real STKEND
  16485.         POP     AF              ; restore count
  16486.         DEC     A               ; decrease
  16487.         JR      L33F8           ; loop back to SKIP-NEXT
  16488.  
  16489. ; ---------------
  16490. ; Memory location
  16491. ; ---------------
  16492. ; This routine, when supplied with a base address in HL and an index in A
  16493. ; will calculate the address of the A'th entry, where each entry occupies
  16494. ; five bytes. It is used for reading the semi-tone table and addressing
  16495. ; floating-point numbers in the calculator's memory area.
  16496.  
  16497. ;; LOC-MEM
  16498. L3406:  LD      C,A             ; store the original number $00-$1F.
  16499.         RLCA                    ; double.
  16500.         RLCA                    ; quadruple.
  16501.         ADD     A,C             ; now add original to multiply by five.
  16502.  
  16503.         LD      C,A             ; place the result in C.
  16504.         LD      B,$00           ; set B to 0.
  16505.         ADD     HL,BC           ; add to form address of start of number in HL.
  16506.         RET                     ; return.
  16507.  
  16508. ; ------------------------------
  16509. ; Get from memory area ($E0 etc.)
  16510. ; ------------------------------
  16511. ; Literals $E0 to $FF
  16512. ; A holds $00-$1F offset.
  16513. ; The calculator stack increases by 5 bytes.
  16514.  
  16515. ;; get-mem-xx
  16516. L340F:  PUSH    DE              ; save STKEND
  16517.         LD      HL,($5C68)      ; MEM is base address of the memory cells.
  16518.         CALL    L3406           ; routine LOC-MEM so that HL = first byte
  16519.         CALL    L33C0           ; routine MOVE-FP moves 5 bytes with memory
  16520.                                 ; check.
  16521.                                 ; DE now points to new STKEND.
  16522.         POP     HL              ; original STKEND is now RESULT pointer.
  16523.         RET                     ; return.
  16524.  
  16525. ; --------------------------
  16526. ; Stack a constant (A0 etc.)
  16527. ; --------------------------
  16528. ; This routine allows a one-byte instruction to stack up to 32 constants
  16529. ; held in short form in a table of constants. In fact only 5 constants are
  16530. ; required. On entry the A register holds the literal ANDed with 1F.
  16531. ; It isn't very efficient and it would have been better to hold the
  16532. ; numbers in full, five byte form and stack them in a similar manner
  16533. ; to that used for semi-tone table values.
  16534.  
  16535. ;; stk-const-xx
  16536. L341B:  LD      H,D             ; save STKEND - required for result
  16537.         LD      L,E             ;
  16538.         EXX                     ; swap
  16539.         PUSH    HL              ; save pointer to next literal
  16540.         LD      HL,L32C5        ; Address: stk-zero - start of table of
  16541.                                 ; constants
  16542.         EXX                     ;
  16543.         CALL    L33F7           ; routine SKIP-CONS
  16544.         CALL    L33C8           ; routine STK-CONST
  16545.         EXX                     ;
  16546.         POP     HL              ; restore pointer to next literal.
  16547.         EXX                     ;
  16548.         RET                     ; return.
  16549.  
  16550. ; --------------------------------
  16551. ; Store in a memory area ($C0 etc.)
  16552. ; --------------------------------
  16553. ; Offsets $C0 to $DF
  16554. ; Although 32 memory storage locations can be addressed, only six
  16555. ; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5)
  16556. ; required for these are allocated. Spectrum programmers who wish to
  16557. ; use the floating point routines from assembly language may wish to
  16558. ; alter the system variable MEM to point to 160 bytes of RAM to have
  16559. ; use the full range available.
  16560. ; A holds the derived offset $00-$1F.
  16561. ; This is a unary operation, so on entry HL points to the last value and DE
  16562. ; points to STKEND.
  16563.  
  16564. ;; st-mem-xx
  16565. L342D:  PUSH    HL              ; save the result pointer.
  16566.         EX      DE,HL           ; transfer to DE.
  16567.         LD      HL,($5C68)      ; fetch MEM the base of memory area.
  16568.         CALL    L3406           ; routine LOC-MEM sets HL to the destination.
  16569.         EX      DE,HL           ; swap - HL is start, DE is destination.
  16570.         CALL    L33C0           ; routine MOVE-FP.
  16571.                                 ; note. a short ld bc,5; ldir
  16572.                                 ; the embedded memory check is not required
  16573.                                 ; so these instructions would be faster.
  16574.         EX      DE,HL           ; DE = STKEND
  16575.         POP     HL              ; restore original result pointer
  16576.         RET                     ; return.
  16577.  
  16578. ; ------------------------------------
  16579. ; Swap first number with second number
  16580. ; ------------------------------------
  16581. ; This routine exchanges the last two values on the calculator stack
  16582. ; On entry, as always with binary operations,
  16583. ; HL=first number, DE=second number
  16584. ; On exit, HL=result, DE=stkend.
  16585.  
  16586. ;; exchange
  16587. L343C:  LD      B,$05           ; there are five bytes to be swapped
  16588.  
  16589. ; start of loop.
  16590.  
  16591. ;; SWAP-BYTE
  16592. L343E:  LD      A,(DE)          ; each byte of second
  16593.         LD      C,(HL)          ; each byte of first
  16594.         EX      DE,HL           ; swap pointers
  16595.         LD      (DE),A          ; store each byte of first
  16596.         LD      (HL),C          ; store each byte of second
  16597.         INC     HL              ; advance both
  16598.         INC     DE              ; pointers.
  16599.         DJNZ    L343E           ; loop back to SWAP-BYTE until all 5 done.
  16600.  
  16601.         EX      DE,HL           ; even up the exchanges
  16602.                                 ; so that DE addresses STKEND.
  16603.         RET                     ; return.
  16604.  
  16605. ; --------------------------
  16606. ; Series generator (86 etc.)
  16607. ; --------------------------
  16608. ; The Spectrum uses Chebyshev polynomials to generate approximations for
  16609. ; SIN, ATN, LN and EXP. These are named after the Russian mathematician
  16610. ; Pafnuty Chebyshev, born in 1821, who did much pioneering work on numerical
  16611. ; series. As far as calculators are concerned, Chebyshev polynomials have an
  16612. ; advantage over other series, for example the Taylor series, as they can
  16613. ; reach an approximation in just six iterations for SIN, eight for EXP and
  16614. ; twelve for LN and ATN. The mechanics of the routine are interesting but
  16615. ; for full treatment of how these are generated with demonstrations in
  16616. ; Sinclair BASIC see "The Complete Spectrum ROM Disassembly" by Dr Ian Logan
  16617. ; and Dr Frank O'Hara, published 1983 by Melbourne House.
  16618.  
  16619. ;; series-xx
  16620. L3449:  LD      B,A             ; parameter $00 - $1F to B counter
  16621.         CALL    L335E           ; routine GEN-ENT-1 is called.
  16622.                                 ; A recursive call to a special entry point
  16623.                                 ; in the calculator that puts the B register
  16624.                                 ; in the system variable BREG. The return
  16625.                                 ; address is the next location and where
  16626.                                 ; the calculator will expect its first
  16627.                                 ; instruction - now pointed to by HL'.
  16628.                                 ; The previous pointer to the series of
  16629.                                 ; five-byte numbers goes on the machine stack.
  16630.  
  16631. ; The initialization phase.
  16632.  
  16633.         DB    $31             ;;duplicate       x,x
  16634.         DB    $0F             ;;addition        x+x
  16635.         DB    $C0             ;;st-mem-0        x+x
  16636.         DB    $02             ;;delete          .
  16637.         DB    $A0             ;;stk-zero        0
  16638.         DB    $C2             ;;st-mem-2        0
  16639.  
  16640. ; a loop is now entered to perform the algebraic calculation for each of
  16641. ; the numbers in the series
  16642.  
  16643. ;; G-LOOP
  16644. L3453:  DB    $31             ;;duplicate       v,v.
  16645.         DB    $E0             ;;get-mem-0       v,v,x+2
  16646.         DB    $04             ;;multiply        v,v*x+2
  16647.         DB    $E2             ;;get-mem-2       v,v*x+2,v
  16648.         DB    $C1             ;;st-mem-1
  16649.         DB    $03             ;;subtract
  16650.         DB    $38             ;;end-calc
  16651.  
  16652. ; the previous pointer is fetched from the machine stack to H'L' where it
  16653. ; addresses one of the numbers of the series following the series literal.
  16654.  
  16655.         CALL    L33C6           ; routine STK-DATA is called directly to
  16656.                                 ; push a value and advance H'L'.
  16657.         CALL    L3362           ; routine GEN-ENT-2 recursively re-enters
  16658.                                 ; the calculator without disturbing
  16659.                                 ; system variable BREG
  16660.                                 ; H'L' value goes on the machine stack and is
  16661.                                 ; then loaded as usual with the next address.
  16662.  
  16663.         DB    $0F             ;;addition
  16664.         DB    $01             ;;exchange
  16665.         DB    $C2             ;;st-mem-2
  16666.         DB    $02             ;;delete
  16667.  
  16668.         DB    $35             ;;dec-jr-nz
  16669.         DB    $EE             ;;back to L3453, G-LOOP
  16670.  
  16671. ; when the counted loop is complete the final subtraction yields the result
  16672. ; for example SIN X.
  16673.  
  16674.         DB    $E1             ;;get-mem-1
  16675.         DB    $03             ;;subtract
  16676.         DB    $38             ;;end-calc
  16677.  
  16678.         RET                     ; return with H'L' pointing to location
  16679.                                 ; after last number in series.
  16680.  
  16681. ; -----------------------
  16682. ; Absolute magnitude (2A)
  16683. ; -----------------------
  16684. ; This calculator literal finds the absolute value of the last value,
  16685. ; integer or floating point, on calculator stack.
  16686.  
  16687. ;; abs
  16688. L346A:  LD      B,$FF           ; signal abs
  16689.         JR      L3474           ; forward to NEG-TEST
  16690.  
  16691. ; -----------------------
  16692. ; Handle unary minus (1B)
  16693. ; -----------------------
  16694. ; Unary so on entry HL points to last value, DE to STKEND.
  16695.  
  16696. ;; NEGATE
  16697. ;; negate
  16698. L346E:  CALL    L34E9           ; call routine TEST-ZERO and
  16699.         RET     C               ; return if so leaving zero unchanged.
  16700.  
  16701.         LD      B,$00           ; signal negate required before joining
  16702.                                 ; common code.
  16703.  
  16704. ;; NEG-TEST
  16705. L3474:  LD      A,(HL)          ; load first byte and
  16706.         AND     A               ; test for zero
  16707.         JR      Z,L3483         ; forward to INT-CASE if a small integer
  16708.  
  16709. ; for floating point numbers a single bit denotes the sign.
  16710.  
  16711.         INC     HL              ; address the first byte of mantissa.
  16712.         LD      A,B             ; action flag $FF=abs, $00=neg.
  16713.         AND     $80             ; now         $80      $00
  16714.         OR      (HL)            ; sets bit 7 for abs
  16715.         RLA                     ; sets carry for abs and if number negative
  16716.         CCF                     ; complement carry flag
  16717.         RRA                     ; and rotate back in altering sign
  16718.         LD      (HL),A          ; put the altered adjusted number back
  16719.         DEC     HL              ; HL points to result
  16720.         RET                     ; return with DE unchanged
  16721.  
  16722. ; ---
  16723.  
  16724. ; for integer numbers an entire byte denotes the sign.
  16725.  
  16726. ;; INT-CASE
  16727. L3483:  PUSH    DE              ; save STKEND.
  16728.  
  16729.         PUSH    HL              ; save pointer to the last value/result.
  16730.  
  16731.         CALL    L2D7F           ; routine INT-FETCH puts integer in DE
  16732.                                 ; and the sign in C.
  16733.  
  16734.         POP     HL              ; restore the result pointer.
  16735.  
  16736.         LD      A,B             ; $FF=abs, $00=neg
  16737.         OR      C               ; $FF for abs, no change neg
  16738.         CPL                     ; $00 for abs, switched for neg
  16739.         LD      C,A             ; transfer result to sign byte.
  16740.  
  16741.         CALL    L2D8E           ; routine INT-STORE to re-write the integer.
  16742.  
  16743.         POP     DE              ; restore STKEND.
  16744.         RET                     ; return.
  16745.  
  16746. ; -----------
  16747. ; Signum (29)
  16748. ; -----------
  16749. ; This routine replaces the last value on the calculator stack,
  16750. ; which may be in floating point or integer form, with the integer values
  16751. ; zero if zero, with one if positive and  with -minus one if negative.
  16752.  
  16753. ;; sgn
  16754. L3492:  CALL    L34E9           ; call routine TEST-ZERO and
  16755.         RET     C               ; exit if so as no change is required.
  16756.  
  16757.         PUSH    DE              ; save pointer to STKEND.
  16758.  
  16759.         LD      DE,$0001        ; the result will be 1.
  16760.         INC     HL              ; skip over the exponent.
  16761.         RL      (HL)            ; rotate the sign bit into the carry flag.
  16762.         DEC     HL              ; step back to point to the result.
  16763.         SBC     A,A             ; byte will be $FF if negative, $00 if positive.
  16764.         LD      C,A             ; store the sign byte in the C register.
  16765.         CALL    L2D8E           ; routine INT-STORE to overwrite the last
  16766.                                 ; value with 0001 and sign.
  16767.  
  16768.         POP     DE              ; restore STKEND.
  16769.         RET                     ; return.
  16770.  
  16771. ; -----------------------
  16772. ; Handle IN function (2C)
  16773. ; -----------------------
  16774. ; This function reads a byte from an input port.
  16775.  
  16776. ;; in
  16777. L34A5:  CALL    L1E99           ; routine FIND-INT2 puts port address in BC.
  16778.                                 ; all 16 bits are put on the address line.
  16779.         IN      A,(C)           ; read the port.
  16780.  
  16781.         JR      L34B0           ; exit to STACK-A (via IN-PK-STK to save a byte
  16782.                                 ; of instruction code).
  16783.  
  16784. ; -------------------------
  16785. ; Handle PEEK function (2B)
  16786. ; -------------------------
  16787. ; This function returns the contents of a memory address.
  16788. ; The entire address space can be peeked including the ROM.
  16789.  
  16790. ;; peek
  16791. L34AC:  CALL    L1E99           ; routine FIND-INT2 puts address in BC.
  16792.         LD      A,(BC)          ; load contents into A register.
  16793.  
  16794. ;; IN-PK-STK
  16795. L34B0:  JP      L2D28           ; exit via STACK-A to put value on the
  16796.                                 ; calculator stack.
  16797.  
  16798. ; ---------------
  16799. ; USR number (2D)
  16800. ; ---------------
  16801. ; The USR function followed by a number 0-65535 is the method by which
  16802. ; the Spectrum invokes machine code programs. This function returns the
  16803. ; contents of the BC register pair.
  16804. ; Note. that STACK-BC re-initializes the IY register if a user-written
  16805. ; program has altered it.
  16806.  
  16807. ;; usr-no
  16808. L34B3:  CALL    L1E99           ; routine FIND-INT2 to fetch the
  16809.                                 ; supplied address into BC.
  16810.  
  16811.         LD      HL,L2D2B        ; address: STACK-BC is
  16812.         PUSH    HL              ; pushed onto the machine stack.
  16813.         PUSH    BC              ; then the address of the machine code
  16814.                                 ; routine.
  16815.  
  16816.         RET                     ; make an indirect jump to the routine
  16817.                                 ; and, hopefully, to STACK-BC also.
  16818.  
  16819. ; ---------------
  16820. ; USR string (19)
  16821. ; ---------------
  16822. ; The user function with a one-character string argument, calculates the
  16823. ; address of the User Defined Graphic character that is in the string.
  16824. ; As an alternative, the ASCII equivalent, upper or lower case,
  16825. ; may be supplied. This provides a user-friendly method of redefining
  16826. ; the 21 User Definable Graphics e.g.
  16827. ; POKE USR "a", BIN 10000000 will put a dot in the top left corner of the
  16828. ; character 144.
  16829. ; Note. the curious double check on the range. With 26 UDGs the first check
  16830. ; only is necessary. With anything less the second check only is required.
  16831. ; It is highly likely that the first check was written by Steven Vickers.
  16832.  
  16833. ;; usr-$
  16834. L34BC:  CALL    L2BF1           ; routine STK-FETCH fetches the string
  16835.                                 ; parameters.
  16836.         DEC     BC              ; decrease BC by
  16837.         LD      A,B             ; one to test
  16838.         OR      C               ; the length.
  16839.         JR      NZ,L34E7        ; to REPORT-A if not a single character.
  16840.  
  16841.         LD      A,(DE)          ; fetch the character
  16842.         CALL    L2C8D           ; routine ALPHA sets carry if 'A-Z' or 'a-z'.
  16843.         JR      C,L34D3         ; forward to USR-RANGE if ASCII.
  16844.  
  16845.         SUB     $90             ; make udgs range 0-20d
  16846.         JR      C,L34E7         ; to REPORT-A if too low. e.g. usr " ".
  16847.  
  16848.         CP      $15             ; Note. this test is not necessary.
  16849.         JR      NC,L34E7        ; to REPORT-A if higher than 20.
  16850.  
  16851.         INC     A               ; make range 1-21d to match LSBs of ASCII
  16852.  
  16853. ;; USR-RANGE
  16854. L34D3:  DEC     A               ; make range of bits 0-4 start at zero
  16855.         ADD     A,A             ; multiply by eight
  16856.         ADD     A,A             ; and lose any set bits
  16857.         ADD     A,A             ; range now 0 - 25*8
  16858.         CP      $A8             ; compare to 21*8
  16859.         JR      NC,L34E7        ; to REPORT-A if originally higher
  16860.                                 ; than 'U','u' or graphics U.
  16861.  
  16862.         LD      BC,($5C7B)      ; fetch the UDG system variable value.
  16863.         ADD     A,C             ; add the offset to character
  16864.         LD      C,A             ; and store back in register C.
  16865.         JR      NC,L34E4        ; forward to USR-STACK if no overflow.
  16866.  
  16867.         INC     B               ; increment high byte.
  16868.  
  16869. ;; USR-STACK
  16870. L34E4:  JP      L2D2B           ; jump back and exit via STACK-BC to store
  16871.  
  16872. ; ---
  16873.  
  16874. ;; REPORT-A
  16875. L34E7:  RST     08H             ; ERROR-1
  16876.         DB    $09             ; Error Report: Invalid argument
  16877.  
  16878. ; -------------
  16879. ; Test for zero
  16880. ; -------------
  16881. ; Test if top value on calculator stack is zero.
  16882. ; The carry flag is set if the last value is zero but no registers are altered.
  16883. ; All five bytes will be zero but first four only need be tested.
  16884. ; On entry HL points to the exponent the first byte of the value.
  16885.  
  16886. ;; TEST-ZERO
  16887. L34E9:  PUSH    HL              ; preserve HL which is used to address.
  16888.         PUSH    BC              ; preserve BC which is used as a store.
  16889.         LD      B,A             ; preserve A in B.
  16890.  
  16891.         LD      A,(HL)          ; load first byte to accumulator
  16892.         INC     HL              ; advance.
  16893.         OR      (HL)            ; OR with second byte and clear carry.
  16894.         INC     HL              ; advance.
  16895.         OR      (HL)            ; OR with third byte.
  16896.         INC     HL              ; advance.
  16897.         OR      (HL)            ; OR with fourth byte.
  16898.  
  16899.         LD      A,B             ; restore A without affecting flags.
  16900.         POP     BC              ; restore the saved
  16901.         POP     HL              ; registers.
  16902.  
  16903.         RET     NZ              ; return if not zero and with carry reset.
  16904.  
  16905.         SCF                     ; set the carry flag.
  16906.         RET                     ; return with carry set if zero.
  16907.  
  16908. ; -----------------------
  16909. ; Greater than zero ($37)
  16910. ; -----------------------
  16911. ; Test if the last value on the calculator stack is greater than zero.
  16912. ; This routine is also called directly from the end-tests of the comparison
  16913. ; routine.
  16914.  
  16915. ;; GREATER-0
  16916. ;; greater-0
  16917. L34F9:  CALL    L34E9           ; routine TEST-ZERO
  16918.         RET     C               ; return if was zero as this
  16919.                                 ; is also the Boolean 'false' value.
  16920.  
  16921.         LD      A,$FF           ; prepare XOR mask for sign bit
  16922.         JR      L3507           ; forward to SIGN-TO-C
  16923.                                 ; to put sign in carry
  16924.                                 ; (carry will become set if sign is positive)
  16925.                                 ; and then overwrite location with 1 or 0
  16926.                                 ; as appropriate.
  16927.  
  16928. ; ------------------------
  16929. ; Handle NOT operator ($30)
  16930. ; ------------------------
  16931. ; This overwrites the last value with 1 if it was zero else with zero
  16932. ; if it was any other value.
  16933. ;
  16934. ; e.g NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0.
  16935. ;
  16936. ; The subroutine is also called directly from the end-tests of the comparison
  16937. ; operator.
  16938.  
  16939. ;; NOT
  16940. ;; not
  16941. L3501:  CALL    L34E9           ; routine TEST-ZERO sets carry if zero
  16942.  
  16943.         JR      L350B           ; to FP-0/1 to overwrite operand with
  16944.                                 ; 1 if carry is set else to overwrite with zero.
  16945.  
  16946. ; -------------------
  16947. ; Less than zero (36)
  16948. ; -------------------
  16949. ; Destructively test if last value on calculator stack is less than zero.
  16950. ; Bit 7 of second byte will be set if so.
  16951.  
  16952. ;; less-0
  16953. L3506:  XOR     A               ; set xor mask to zero
  16954.                                 ; (carry will become set if sign is negative).
  16955.  
  16956. ; transfer sign of mantissa to Carry Flag.
  16957.  
  16958. ;; SIGN-TO-C
  16959. L3507:  INC     HL              ; address 2nd byte.
  16960.         XOR     (HL)            ; bit 7 of HL will be set if number is negative.
  16961.         DEC     HL              ; address 1st byte again.
  16962.         RLCA                    ; rotate bit 7 of A to carry.
  16963.  
  16964. ; -----------
  16965. ; Zero or one
  16966. ; -----------
  16967. ; This routine places an integer value of zero or one at the addressed location
  16968. ; of the calculator stack or MEM area.  The value one is written if carry is
  16969. ; set on entry else zero.
  16970.  
  16971. ;; FP-0/1
  16972. L350B:  PUSH    HL              ; save pointer to the first byte
  16973.         LD      A,$00           ; load accumulator with zero - without
  16974.                                 ; disturbing flags.
  16975.         LD      (HL),A          ; zero to first byte
  16976.         INC     HL              ; address next
  16977.         LD      (HL),A          ; zero to 2nd byte
  16978.         INC     HL              ; address low byte of integer
  16979.         RLA                     ; carry to bit 0 of A
  16980.         LD      (HL),A          ; load one or zero to low byte.
  16981.         RRA                     ; restore zero to accumulator.
  16982.         INC     HL              ; address high byte of integer.
  16983.         LD      (HL),A          ; put a zero there.
  16984.         INC     HL              ; address fifth byte.
  16985.         LD      (HL),A          ; put a zero there.
  16986.         POP     HL              ; restore pointer to the first byte.
  16987.         RET                     ; return.
  16988.  
  16989. ; -----------------------
  16990. ; Handle OR operator (07)
  16991. ; -----------------------
  16992. ; The Boolean OR operator. eg. X OR Y
  16993. ; The result is zero if both values are zero else a non-zero value.
  16994. ;
  16995. ; e.g.    0 OR 0  returns 0.
  16996. ;        -3 OR 0  returns -3.
  16997. ;         0 OR -3 returns 1.
  16998. ;        -3 OR 2  returns 1.
  16999. ;
  17000. ; A binary operation.
  17001. ; On entry HL points to first operand (X) and DE to second operand (Y).
  17002.  
  17003. ;; or
  17004. L351B:  EX      DE,HL           ; make HL point to second number
  17005.         CALL    L34E9           ; routine TEST-ZERO
  17006.         EX      DE,HL           ; restore pointers
  17007.         RET     C               ; return if result was zero - first operand,
  17008.                                 ; now the last value, is the result.
  17009.  
  17010.         SCF                     ; set carry flag
  17011.         JR      L350B           ; back to FP-0/1 to overwrite the first operand
  17012.                                 ; with the value 1.
  17013.  
  17014.  
  17015. ; -----------------------------
  17016. ; Handle number AND number (08)
  17017. ; -----------------------------
  17018. ; The Boolean AND operator.
  17019. ;
  17020. ; e.g.    -3 AND 2  returns -3.
  17021. ;         -3 AND 0  returns 0.
  17022. ;          0 and -2 returns 0.
  17023. ;          0 and 0  returns 0.
  17024. ;
  17025. ; Compare with OR routine above.
  17026.  
  17027. ;; no-&-no
  17028. L3524:  EX      DE,HL           ; make HL address second operand.
  17029.  
  17030.         CALL    L34E9           ; routine TEST-ZERO sets carry if zero.
  17031.  
  17032.         EX      DE,HL           ; restore pointers.
  17033.         RET     NC              ; return if second non-zero, first is result.
  17034.  
  17035. ;
  17036.  
  17037.         AND     A               ; else clear carry.
  17038.         JR      L350B           ; back to FP-0/1 to overwrite first operand
  17039.                                 ; with zero for return value.
  17040.  
  17041. ; -----------------------------
  17042. ; Handle string AND number (10)
  17043. ; -----------------------------
  17044. ; e.g. "You Win" AND score>99 will return the string if condition is true
  17045. ; or the null string if false.
  17046.  
  17047. ;; str-&-no
  17048. L352D:  EX      DE,HL           ; make HL point to the number.
  17049.         CALL    L34E9           ; routine TEST-ZERO.
  17050.         EX      DE,HL           ; restore pointers.
  17051.         RET     NC              ; return if number was not zero - the string
  17052.                                 ; is the result.
  17053.  
  17054. ; if the number was zero (false) then the null string must be returned by
  17055. ; altering the length of the string on the calculator stack to zero.
  17056.  
  17057.         PUSH    DE              ; save pointer to the now obsolete number
  17058.                                 ; (which will become the new STKEND)
  17059.  
  17060.         DEC     DE              ; point to the 5th byte of string descriptor.
  17061.         XOR     A               ; clear the accumulator.
  17062.         LD      (DE),A          ; place zero in high byte of length.
  17063.         DEC     DE              ; address low byte of length.
  17064.         LD      (DE),A          ; place zero there - now the null string.
  17065.  
  17066.         POP     DE              ; restore pointer - new STKEND.
  17067.         RET                     ; return.
  17068.  
  17069. ; -----------------------------------
  17070. ; Perform comparison ($09-$0E, $11-$16)
  17071. ; -----------------------------------
  17072. ; True binary operations.
  17073. ;
  17074. ; A single entry point is used to evaluate six numeric and six string
  17075. ; comparisons. On entry, the calculator literal is in the B register and
  17076. ; the two numeric values, or the two string parameters, are on the
  17077. ; calculator stack.
  17078. ; The individual bits of the literal are manipulated to group similar
  17079. ; operations although the SUB 8 instruction does nothing useful and merely
  17080. ; alters the string test bit.
  17081. ; Numbers are compared by subtracting one from the other, strings are
  17082. ; compared by comparing every character until a mismatch, or the end of one
  17083. ; or both, is reached.
  17084. ;
  17085. ; Numeric Comparisons.
  17086. ; --------------------
  17087. ; The 'x>y' example is the easiest as it employs straight-thru logic.
  17088. ; Number y is subtracted from x and the result tested for greater-0 yielding
  17089. ; a final value 1 (true) or 0 (false).
  17090. ; For 'x<y' the same logic is used but the two values are first swapped on the
  17091. ; calculator stack.
  17092. ; For 'x=y' NOT is applied to the subtraction result yielding true if the
  17093. ; difference was zero and false with anything else.
  17094. ; The first three numeric comparisons are just the opposite of the last three
  17095. ; so the same processing steps are used and then a final NOT is applied.
  17096. ;
  17097. ; literal    Test   No  sub 8       ExOrNot  1st RRCA  exch sub  ?   End-Tests
  17098. ; =========  ====   == ======== === ======== ========  ==== ===  =  === === ===
  17099. ; no-l-eql   x<=y   09 00000001 dec 00000000 00000000  ---- x-y  ?  --- >0? NOT
  17100. ; no-gr-eql  x>=y   0A 00000010 dec 00000001 10000000c swap y-x  ?  --- >0? NOT
  17101. ; nos-neql   x<>y   0B 00000011 dec 00000010 00000001  ---- x-y  ?  NOT --- NOT
  17102. ; no-grtr    x>y    0C 00000100  -  00000100 00000010  ---- x-y  ?  --- >0? ---
  17103. ; no-less    x<y    0D 00000101  -  00000101 10000010c swap y-x  ?  --- >0? ---
  17104. ; nos-eql    x=y    0E 00000110  -  00000110 00000011  ---- x-y  ?  NOT --- ---
  17105. ;
  17106. ;                                                           comp -> C/F
  17107. ;                                                           ====    ===
  17108. ; str-l-eql  x$<=y$ 11 00001001 dec 00001000 00000100  ---- x$y$ 0  !or >0? NOT
  17109. ; str-gr-eql x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0  !or >0? NOT
  17110. ; strs-neql  x$<>y$ 13 00001011 dec 00001010 00000101  ---- x$y$ 0  !or >0? NOT
  17111. ; str-grtr   x$>y$  14 00001100  -  00001100 00000110  ---- x$y$ 0  !or >0? ---
  17112. ; str-less   x$<y$  15 00001101  -  00001101 10000110c swap y$x$ 0  !or >0? ---
  17113. ; strs-eql   x$=y$  16 00001110  -  00001110 00000111  ---- x$y$ 0  !or >0? ---
  17114. ;
  17115. ; String comparisons are a little different in that the eql/neql carry flag
  17116. ; from the 2nd RRCA is, as before, fed into the first of the end tests but
  17117. ; along the way it gets modified by the comparison process. The result on the
  17118. ; stack always starts off as zero and the carry fed in determines if NOT is
  17119. ; applied to it. So the only time the greater-0 test is applied is if the
  17120. ; stack holds zero which is not very efficient as the test will always yield
  17121. ; zero. The most likely explanation is that there were once separate end tests
  17122. ; for numbers and strings.
  17123.  
  17124. ;; no-l-eql, etc.
  17125. L353B:  LD      A,B             ; transfer literal to accumulator.
  17126.         SUB     $08             ; subtract eight - which is not useful.
  17127.  
  17128.         BIT     2,A             ; isolate '>', '<', '='.
  17129.  
  17130.         JR      NZ,L3543        ; skip to EX-OR-NOT with these.
  17131.  
  17132.         DEC     A               ; else make $00-$02, $08-$0A to match bits 0-2.
  17133.  
  17134. ;; EX-OR-NOT
  17135. L3543:  RRCA                    ; the first RRCA sets carry for a swap.
  17136.         JR      NC,L354E        ; forward to NU-OR-STR with other 8 cases
  17137.  
  17138. ; for the other 4 cases the two values on the calculator stack are exchanged.
  17139.  
  17140.         PUSH    AF              ; save A and carry.
  17141.         PUSH    HL              ; save HL - pointer to first operand.
  17142.                                 ; (DE points to second operand).
  17143.  
  17144.         CALL    L343C           ; routine exchange swaps the two values.
  17145.                                 ; (HL = second operand, DE = STKEND)
  17146.  
  17147.         POP     DE              ; DE = first operand
  17148.         EX      DE,HL           ; as we were.
  17149.         POP     AF              ; restore A and carry.
  17150.  
  17151. ; Note. it would be better if the 2nd RRCA preceded the string test.
  17152. ; It would save two duplicate bytes and if we also got rid of that sub 8
  17153. ; at the beginning we wouldn't have to alter which bit we test.
  17154.  
  17155. ;; NU-OR-STR
  17156. L354E:  BIT     2,A             ; test if a string comparison.
  17157.         JR      NZ,L3559        ; forward to STRINGS if so.
  17158.  
  17159. ; continue with numeric comparisons.
  17160.  
  17161.         RRCA                    ; 2nd RRCA causes eql/neql to set carry.
  17162.         PUSH    AF              ; save A and carry
  17163.  
  17164.         CALL    L300F           ; routine subtract leaves result on stack.
  17165.         JR      L358C           ; forward to END-TESTS
  17166.  
  17167. ; ---
  17168.  
  17169. ;; STRINGS
  17170. L3559:  RRCA                    ; 2nd RRCA causes eql/neql to set carry.
  17171.         PUSH    AF              ; save A and carry.
  17172.  
  17173.         CALL    L2BF1           ; routine STK-FETCH gets 2nd string params
  17174.         PUSH    DE              ; save start2 *.
  17175.         PUSH    BC              ; and the length.
  17176.  
  17177.         CALL    L2BF1           ; routine STK-FETCH gets 1st string
  17178.                                 ; parameters - start in DE, length in BC.
  17179.         POP     HL              ; restore length of second to HL.
  17180.  
  17181. ; A loop is now entered to compare, by subtraction, each corresponding character
  17182. ; of the strings. For each successful match, the pointers are incremented and
  17183. ; the lengths decreased and the branch taken back to here. If both string
  17184. ; remainders become null at the same time, then an exact match exists.
  17185.  
  17186. ;; BYTE-COMP
  17187. L3564:  LD      A,H             ; test if the second string
  17188.         OR      L               ; is the null string and hold flags.
  17189.  
  17190.         EX      (SP),HL         ; put length2 on stack, bring start2 to HL *.
  17191.         LD      A,B             ; hi byte of length1 to A
  17192.  
  17193.         JR      NZ,L3575        ; forward to SEC-PLUS if second not null.
  17194.  
  17195.         OR      C               ; test length of first string.
  17196.  
  17197. ;; SECND-LOW
  17198. L356B:  POP     BC              ; pop the second length off stack.
  17199.         JR      Z,L3572         ; forward to BOTH-NULL if first string is also
  17200.                                 ; of zero length.
  17201.  
  17202. ; the true condition - first is longer than second (SECND-LESS)
  17203.  
  17204.         POP     AF              ; restore carry (set if eql/neql)
  17205.         CCF                     ; complement carry flag.
  17206.                                 ; Note. equality becomes false.
  17207.                                 ; Inequality is true. By swapping or applying
  17208.                                 ; a terminal 'not', all comparisons have been
  17209.                                 ; manipulated so that this is success path.
  17210.         JR      L3588           ; forward to leave via STR-TEST
  17211.  
  17212. ; ---
  17213. ; the branch was here with a match
  17214.  
  17215. ;; BOTH-NULL
  17216. L3572:  POP     AF              ; restore carry - set for eql/neql
  17217.         JR      L3588           ; forward to STR-TEST
  17218.  
  17219. ; ---  
  17220. ; the branch was here when 2nd string not null and low byte of first is yet
  17221. ; to be tested.
  17222.  
  17223.  
  17224. ;; SEC-PLUS
  17225. L3575:  OR      C               ; test the length of first string.
  17226.         JR      Z,L3585         ; forward to FRST-LESS if length is zero.
  17227.  
  17228. ; both strings have at least one character left.
  17229.  
  17230.         LD      A,(DE)          ; fetch character of first string.
  17231.         SUB     (HL)            ; subtract with that of 2nd string.
  17232.         JR      C,L3585         ; forward to FRST-LESS if carry set
  17233.  
  17234.         JR      NZ,L356B        ; back to SECND-LOW and then STR-TEST
  17235.                                 ; if not exact match.
  17236.  
  17237.         DEC     BC              ; decrease length of 1st string.
  17238.         INC     DE              ; increment 1st string pointer.
  17239.  
  17240.         INC     HL              ; increment 2nd string pointer.
  17241.         EX      (SP),HL         ; swap with length on stack
  17242.         DEC     HL              ; decrement 2nd string length
  17243.         JR      L3564           ; back to BYTE-COMP
  17244.  
  17245. ; ---
  17246. ; the false condition.
  17247.  
  17248. ;; FRST-LESS
  17249. L3585:  POP     BC              ; discard length
  17250.         POP     AF              ; pop A
  17251.         AND     A               ; clear the carry for false result.
  17252.  
  17253. ; ---
  17254. ; exact match and x$>y$ rejoin here
  17255.  
  17256. ;; STR-TEST
  17257. L3588:  PUSH    AF              ; save A and carry
  17258.  
  17259.         RST     28H             ;; FP-CALC
  17260.         DB    $A0             ;;stk-zero      an initial false value.
  17261.         DB    $38             ;;end-calc
  17262.  
  17263. ; both numeric and string paths converge here.
  17264.  
  17265. ;; END-TESTS
  17266. L358C:  POP     AF              ; pop carry  - will be set if eql/neql
  17267.         PUSH    AF              ; save it again.
  17268.  
  17269.         CALL    C,L3501         ; routine NOT sets true(1) if equal(0)
  17270.                                 ; or, for strings, applies true result.
  17271.  
  17272.         POP     AF              ; pop carry and
  17273.         PUSH    AF              ; save A
  17274.  
  17275.         CALL    NC,L34F9        ; routine GREATER-0 tests numeric subtraction
  17276.                                 ; result but also needlessly tests the string
  17277.                                 ; value for zero - it must be.
  17278.  
  17279.         POP     AF              ; pop A
  17280.         RRCA                    ; the third RRCA - test for '<=', '>=' or '<>'.
  17281.         CALL    NC,L3501        ; apply a terminal NOT if so.
  17282.         RET                     ; return.
  17283.  
  17284. ; -------------------------
  17285. ; String concatenation ($17)
  17286. ; -------------------------
  17287. ; This literal combines two strings into one e.g. LET a$ = b$ + c$
  17288. ; The two parameters of the two strings to be combined are on the stack.
  17289.  
  17290. ;; strs-add
  17291. L359C:  CALL    L2BF1           ; routine STK-FETCH fetches string parameters
  17292.                                 ; and deletes calculator stack entry.
  17293.         PUSH    DE              ; save start address.
  17294.         PUSH    BC              ; and length.
  17295.  
  17296.         CALL    L2BF1           ; routine STK-FETCH for first string
  17297.         POP     HL              ; re-fetch first length
  17298.         PUSH    HL              ; and save again
  17299.         PUSH    DE              ; save start of second string
  17300.         PUSH    BC              ; and its length.
  17301.  
  17302.         ADD     HL,BC           ; add the two lengths.
  17303.         LD      B,H             ; transfer to BC
  17304.         LD      C,L             ; and create
  17305.         RST     30H             ; BC-SPACES in workspace.
  17306.                                 ; DE points to start of space.
  17307.  
  17308.         CALL    L2AB2           ; routine STK-STO-$ stores parameters
  17309.                                 ; of new string updating STKEND.
  17310.  
  17311.         POP     BC              ; length of first
  17312.         POP     HL              ; address of start
  17313.         LD      A,B             ; test for
  17314.         OR      C               ; zero length.
  17315.         JR      Z,L35B7         ; to OTHER-STR if null string
  17316.  
  17317.         LDIR                    ; copy string to workspace.
  17318.  
  17319. ;; OTHER-STR
  17320. L35B7:  POP     BC              ; now second length
  17321.         POP     HL              ; and start of string
  17322.         LD      A,B             ; test this one
  17323.         OR      C               ; for zero length
  17324.         JR      Z,L35BF         ; skip forward to STK-PNTRS if so as complete.
  17325.  
  17326.         LDIR                    ; else copy the bytes.
  17327.                                 ; and continue into next routine which
  17328.                                 ; sets the calculator stack pointers.
  17329.  
  17330. ; --------------------
  17331. ; Check stack pointers
  17332. ; --------------------
  17333. ; Register DE is set to STKEND and HL, the result pointer, is set to five
  17334. ; locations below this.
  17335. ; This routine is used when it is inconvenient to save these values at the
  17336. ; time the calculator stack is manipulated due to other activity on the
  17337. ; machine stack.
  17338. ; This routine is also used to terminate the VAL and READ-IN  routines for
  17339. ; the same reason and to initialize the calculator stack at the start of
  17340. ; the CALCULATE routine.
  17341.  
  17342. ;; STK-PNTRS
  17343. L35BF:  LD      HL,($5C65)      ; fetch STKEND value from system variable.
  17344.         LD      DE,$FFFB        ; the value -5
  17345.         PUSH    HL              ; push STKEND value.
  17346.  
  17347.         ADD     HL,DE           ; subtract 5 from HL.
  17348.  
  17349.         POP     DE              ; pop STKEND to DE.
  17350.         RET                     ; return.
  17351.  
  17352. ; ----------------
  17353. ; Handle CHR$ (2F)
  17354. ; ----------------
  17355. ; This function returns a single character string that is a result of
  17356. ; converting a number in the range 0-255 to a string e.g. CHR$ 65 = "A".
  17357.  
  17358. ;; chrs
  17359. L35C9:  CALL    L2DD5           ; routine FP-TO-A puts the number in A.
  17360.  
  17361.         JR      C,L35DC         ; forward to REPORT-Bd if overflow
  17362.         JR      NZ,L35DC        ; forward to REPORT-Bd if negative
  17363.  
  17364.         PUSH    AF              ; save the argument.
  17365.  
  17366.         LD      BC,$0001        ; one space required.
  17367.         RST     30H             ; BC-SPACES makes DE point to start
  17368.  
  17369.         POP     AF              ; restore the number.
  17370.  
  17371.         LD      (DE),A          ; and store in workspace
  17372.  
  17373.         CALL    L2AB2           ; routine STK-STO-$ stacks descriptor.
  17374.  
  17375.         EX      DE,HL           ; make HL point to result and DE to STKEND.
  17376.         RET                     ; return.
  17377.  
  17378. ; ---
  17379.  
  17380. ;; REPORT-Bd
  17381. L35DC:  RST     08H             ; ERROR-1
  17382.         DB    $0A             ; Error Report: Integer out of range
  17383.  
  17384. ; ----------------------------
  17385. ; Handle VAL and VAL$ ($1D, $18)
  17386. ; ----------------------------
  17387. ; VAL treats the characters in a string as a numeric expression.
  17388. ;     e.g. VAL "2.3" = 2.3, VAL "2+4" = 6, VAL ("2" + "4") = 24.
  17389. ; VAL$ treats the characters in a string as a string expression.
  17390. ;     e.g. VAL$ (z$+"(2)") = a$(2) if z$ happens to be "a$".
  17391.  
  17392. ;; val
  17393. ;; val$
  17394. L35DE:  LD      HL,($5C5D)      ; fetch value of system variable CH_ADD
  17395.         PUSH    HL              ; and save on the machine stack.
  17396.         LD      A,B             ; fetch the literal (either $1D or $18).
  17397.         ADD     A,$E3           ; add $E3 to form $00 (setting carry) or $FB.
  17398.         SBC     A,A             ; now form $FF bit 6 = numeric result
  17399.                                 ; or $00 bit 6 = string result.
  17400.         PUSH    AF              ; save this mask on the stack
  17401.  
  17402.         CALL    L2BF1           ; routine STK-FETCH fetches the string operand
  17403.                                 ; from calculator stack.
  17404.  
  17405.         PUSH    DE              ; save the address of the start of the string.
  17406.         INC     BC              ; increment the length for a carriage return.
  17407.  
  17408.         RST     30H             ; BC-SPACES creates the space in workspace.
  17409.         POP     HL              ; restore start of string to HL.
  17410.         LD      ($5C5D),DE      ; load CH_ADD with start DE in workspace.
  17411.  
  17412.         PUSH    DE              ; save the start in workspace
  17413.         LDIR                    ; copy string from program or variables or
  17414.                                 ; workspace to the workspace area.
  17415.         EX      DE,HL           ; end of string + 1 to HL
  17416.         DEC     HL              ; decrement HL to point to end of new area.
  17417.         LD      (HL),$0D        ; insert a carriage return at end.
  17418.         RES     7,(IY+$01)      ; update FLAGS  - signal checking syntax.
  17419.         CALL    L24FB           ; routine SCANNING evaluates string
  17420.                                 ; expression and result.
  17421.  
  17422.         RST     18H             ; GET-CHAR fetches next character.
  17423.         CP      $0D             ; is it the expected carriage return ?
  17424.         JR      NZ,L360C        ; forward to V-RPORT-C if not
  17425.                                 ; 'Nonsense in BASIC'.
  17426.  
  17427.         POP     HL              ; restore start of string in workspace.
  17428.         POP     AF              ; restore expected result flag (bit 6).
  17429.         XOR     (IY+$01)        ; xor with FLAGS now updated by SCANNING.
  17430.         AND     $40             ; test bit 6 - should be zero if result types
  17431.                                 ; match.
  17432.  
  17433. ;; V-RPORT-C
  17434. L360C:  JP      NZ,L1C8A        ; jump back to REPORT-C with a result mismatch.
  17435.  
  17436.         LD      ($5C5D),HL      ; set CH_ADD to the start of the string again.
  17437.         SET     7,(IY+$01)      ; update FLAGS  - signal running program.
  17438.         CALL    L24FB           ; routine SCANNING evaluates the string
  17439.                                 ; in full leaving result on calculator stack.
  17440.  
  17441.         POP     HL              ; restore saved character address in program.
  17442.         LD      ($5C5D),HL      ; and reset the system variable CH_ADD.
  17443.  
  17444.         JR      L35BF           ; back to exit via STK-PNTRS.
  17445.                                 ; resetting the calculator stack pointers
  17446.                                 ; HL and DE from STKEND as it wasn't possible
  17447.                                 ; to preserve them during this routine.
  17448.  
  17449. ; ----------------
  17450. ; Handle STR$ (2E)
  17451. ; ----------------
  17452. ;
  17453. ;
  17454.  
  17455. ;; str$
  17456. L361F:  LD      BC,$0001        ; create an initial byte in workspace
  17457.         RST     30H             ; using BC-SPACES restart.
  17458.  
  17459.         LD      ($5C5B),HL      ; set system variable K_CUR to new location.
  17460.         PUSH    HL              ; and save start on machine stack also.
  17461.  
  17462.         LD      HL,($5C51)      ; fetch value of system variable CURCHL
  17463.         PUSH    HL              ; and save that too.
  17464.  
  17465.         LD      A,$FF           ; select system channel 'R'.
  17466.         CALL    L1601           ; routine CHAN-OPEN opens it.
  17467.         CALL    L2DE3           ; routine PRINT-FP outputs the number to
  17468.                                 ; workspace updating K-CUR.
  17469.  
  17470.         POP     HL              ; restore current channel.
  17471.         CALL    L1615           ; routine CHAN-FLAG resets flags.
  17472.  
  17473.         POP     DE              ; fetch saved start of string to DE.
  17474.         LD      HL,($5C5B)      ; load HL with end of string from K_CUR.
  17475.  
  17476.         AND     A               ; prepare for true subtraction.
  17477.         SBC     HL,DE           ; subtract start from end to give length.
  17478.         LD      B,H             ; transfer the length to
  17479.         LD      C,L             ; the BC register pair.
  17480.  
  17481.         CALL    L2AB2           ; routine STK-STO-$ stores string parameters
  17482.                                 ; on the calculator stack.
  17483.  
  17484.         EX      DE,HL           ; HL = last value, DE = STKEND.
  17485.         RET                     ; return.
  17486.  
  17487. ; ------------
  17488. ; Read-in (1A)
  17489. ; ------------
  17490. ; This is the calculator literal used by the INKEY$ function when a '#'
  17491. ; is encountered after the keyword.
  17492. ; INKEY$ # does not interact correctly with the keyboard, #0 or #1, and
  17493. ; its uses are for other channels.
  17494.  
  17495. ;; read-in
  17496. L3645:  CALL    L1E94           ; routine FIND-INT1 fetches stream to A
  17497.         CP      $10             ; compare with 16 decimal.
  17498.         JP      NC,L1E9F        ; jump to REPORT-Bb if not in range 0 - 15.
  17499.                                 ; 'Integer out of range'
  17500.                                 ; (REPORT-Bd is within range)
  17501.  
  17502.         LD      HL,($5C51)      ; fetch current channel CURCHL
  17503.         PUSH    HL              ; save it
  17504.         CALL    L1601           ; routine CHAN-OPEN opens channel
  17505.  
  17506.         CALL    L15E6           ; routine INPUT-AD - the channel must have an
  17507.                                 ; input stream or else error here from stream
  17508.                                 ; stub.
  17509.         LD      BC,$0000        ; initialize length of string to zero
  17510.         JR      NC,L365F        ; forward to R-I-STORE if no key detected.
  17511.  
  17512.         INC     C               ; increase length to one.
  17513.  
  17514.         RST     30H             ; BC-SPACES creates space for one character
  17515.                                 ; in workspace.
  17516.         LD      (DE),A          ; the character is inserted.
  17517.  
  17518. ;; R-I-STORE
  17519. L365F:  CALL    L2AB2           ; routine STK-STO-$ stacks the string
  17520.                                 ; parameters.
  17521.         POP     HL              ; restore current channel address
  17522.         CALL    L1615           ; routine CHAN-FLAG resets current channel
  17523.                                 ; system variable and flags.
  17524.         JP      L35BF           ; jump back to STK-PNTRS
  17525.  
  17526. ; ----------------
  17527. ; Handle CODE (1C)
  17528. ; ----------------
  17529. ; Returns the ASCII code of a character or first character of a string
  17530. ; e.g. CODE "Aardvark" = 65, CODE "" = 0.
  17531.  
  17532. ;; code
  17533. L3669:  CALL    L2BF1           ; routine STK-FETCH to fetch and delete the
  17534.                                 ; string parameters.
  17535.                                 ; DE points to the start, BC holds the length.
  17536.         LD      A,B             ; test length
  17537.         OR      C               ; of the string.
  17538.         JR      Z,L3671         ; skip to STK-CODE with zero if the null string.
  17539.  
  17540.         LD      A,(DE)          ; else fetch the first character.
  17541.  
  17542. ;; STK-CODE
  17543. L3671:  JP      L2D28           ; jump back to STACK-A (with memory check)
  17544.  
  17545. ; ---------------
  17546. ; Handle LEN (1E)
  17547. ; ---------------
  17548. ; Returns the length of a string.
  17549. ; In Sinclair BASIC strings can be more than twenty thousand characters long
  17550. ; so a sixteen-bit register is required to store the length
  17551.  
  17552. ;; len
  17553. L3674:  CALL    L2BF1           ; routine STK-FETCH to fetch and delete the
  17554.                                 ; string parameters from the calculator stack.
  17555.                                 ; register BC now holds the length of string.
  17556.  
  17557.         JP      L2D2B           ; jump back to STACK-BC to save result on the
  17558.                                 ; calculator stack (with memory check).
  17559.  
  17560. ; -------------------------
  17561. ; Decrease the counter (35)
  17562. ; -------------------------
  17563. ; The calculator has an instruction that decrements a single-byte
  17564. ; pseudo-register and makes consequential relative jumps just like
  17565. ; the Z80's DJNZ instruction.
  17566.  
  17567. ;; dec-jr-nz
  17568. L367A:  EXX                     ; switch in set that addresses code
  17569.  
  17570.         PUSH    HL              ; save pointer to offset byte
  17571.         LD      HL,$5C67        ; address BREG in system variables
  17572.         DEC     (HL)            ; decrement it
  17573.         POP     HL              ; restore pointer
  17574.  
  17575.         JR      NZ,L3687        ; to JUMP-2 if not zero
  17576.  
  17577.         INC     HL              ; step past the jump length.
  17578.         EXX                     ; switch in the main set.
  17579.         RET                     ; return.
  17580.  
  17581. ; Note. as a general rule the calculator avoids using the IY register
  17582. ; otherwise the cumbersome 4 instructions in the middle could be replaced by
  17583. ; dec (iy+$2d) - three bytes instead of six.
  17584.  
  17585.  
  17586. ; ---------
  17587. ; Jump (33)
  17588. ; ---------
  17589. ; This enables the calculator to perform relative jumps just like
  17590. ; the Z80 chip's JR instruction
  17591.  
  17592. ;; jump
  17593. ;; JUMP
  17594. L3686:  EXX                     ;switch in pointer set
  17595.  
  17596. ;; JUMP-2
  17597. L3687:  LD      E,(HL)          ; the jump byte 0-127 forward, 128-255 back.
  17598.         LD      A,E             ; transfer to accumulator.
  17599.         RLA                     ; if backward jump, carry is set.
  17600.         SBC     A,A             ; will be $FF if backward or $00 if forward.
  17601.         LD      D,A             ; transfer to high byte.
  17602.         ADD     HL,DE           ; advance calculator pointer forward or back.
  17603.         EXX                     ; switch back.
  17604.         RET                     ; return.
  17605.  
  17606. ; -----------------
  17607. ; Jump on true (00)
  17608. ; -----------------
  17609. ; This enables the calculator to perform conditional relative jumps
  17610. ; dependent on whether the last test gave a true result
  17611.  
  17612. ;; jump-true
  17613. L368F:  INC     DE              ; collect the
  17614.         INC     DE              ; third byte
  17615.         LD      A,(DE)          ; of the test
  17616.         DEC     DE              ; result and
  17617.         DEC     DE              ; backtrack.
  17618.  
  17619.         AND     A               ; is result 0 or 1 ?
  17620.         JR      NZ,L3686        ; back to JUMP if true (1).
  17621.  
  17622.         EXX                     ; else switch in the pointer set.
  17623.         INC     HL              ; step past the jump length.
  17624.         EXX                     ; switch in the main set.
  17625.         RET                     ; return.
  17626.  
  17627. ; -----------------------
  17628. ; End of calculation (38)
  17629. ; -----------------------
  17630. ; The end-calc literal terminates a mini-program written in the Spectrum's
  17631. ; internal language.
  17632.  
  17633. ;; end-calc
  17634. L369B:  POP     AF              ; drop the calculator return address RE-ENTRY
  17635.         EXX                     ; switch to the other set.
  17636.  
  17637.         EX      (SP),HL         ; transfer H'L' to machine stack for the
  17638.                                 ; return address.
  17639.                                 ; when exiting recursion then the previous
  17640.                                 ; pointer is transferred to H'L'.
  17641.  
  17642.         EXX                     ; back to main set.
  17643.         RET                     ; return.
  17644.  
  17645.  
  17646. ; ------------------------
  17647. ; THE 'MODULUS' SUBROUTINE
  17648. ; ------------------------
  17649. ; (offset: $32 'n-mod-m')
  17650. ;
  17651. ;
  17652.  
  17653. ;; n-mod-m
  17654. L36A0:  RST     28H             ;; FP-CALC          17, 3.
  17655.         DB    $C0             ;;st-mem-0          17, 3.
  17656.         DB    $02             ;;delete            17.
  17657.         DB    $31             ;;duplicate         17, 17.
  17658.         DB    $E0             ;;get-mem-0         17, 17, 3.
  17659.         DB    $05             ;;division          17, 17/3.
  17660.         DB    $27             ;;int               17, 5.
  17661.         DB    $E0             ;;get-mem-0         17, 5, 3.
  17662.         DB    $01             ;;exchange          17, 3, 5.
  17663.         DB    $C0             ;;st-mem-0          17, 3, 5.
  17664.         DB    $04             ;;multiply          17, 15.
  17665.         DB    $03             ;;subtract          2.
  17666.         DB    $E0             ;;get-mem-0         2, 5.
  17667.         DB    $38             ;;end-calc          2, 5.
  17668.  
  17669.         RET                     ; return.
  17670.  
  17671.  
  17672. ; ------------------
  17673. ; THE 'INT' FUNCTION
  17674. ; ------------------
  17675. ; (offset $27: 'int' )
  17676. ;
  17677. ; This function returns the integer of x, which is just the same as truncate
  17678. ; for positive numbers. The truncate literal truncates negative numbers
  17679. ; upwards so that -3.4 gives -3 whereas the BASIC INT function has to
  17680. ; truncate negative numbers down so that INT -3.4 is -4.
  17681. ; It is best to work through using, say, +-3.4 as examples.
  17682.  
  17683. ;; int
  17684. L36AF:  RST     28H             ;; FP-CALC              x.    (= 3.4 or -3.4).
  17685.         DB    $31             ;;duplicate             x, x.
  17686.         DB    $36             ;;less-0                x, (1/0)
  17687.         DB    $00             ;;jump-true             x, (1/0)
  17688.         DB    $04             ;;to L36B7, X-NEG
  17689.  
  17690.         DB    $3A             ;;truncate              trunc 3.4 = 3.
  17691.         DB    $38             ;;end-calc              3.
  17692.  
  17693.         RET                     ; return with + int x on stack.
  17694.  
  17695. ; ---
  17696.  
  17697.  
  17698. ;; X-NEG
  17699. L36B7:  DB    $31             ;;duplicate             -3.4, -3.4.
  17700.         DB    $3A             ;;truncate              -3.4, -3.
  17701.         DB    $C0             ;;st-mem-0              -3.4, -3.
  17702.         DB    $03             ;;subtract              -.4
  17703.         DB    $E0             ;;get-mem-0             -.4, -3.
  17704.         DB    $01             ;;exchange              -3, -.4.
  17705.         DB    $30             ;;not                   -3, (0).
  17706.         DB    $00             ;;jump-true             -3.
  17707.         DB    $03             ;;to L36C2, EXIT        -3.
  17708.  
  17709.         DB    $A1             ;;stk-one               -3, 1.
  17710.         DB    $03             ;;subtract              -4.
  17711.  
  17712. ;; EXIT
  17713. L36C2:  DB    $38             ;;end-calc              -4.
  17714.  
  17715.         RET                     ; return.
  17716.  
  17717.  
  17718. ; ----------------
  17719. ; Exponential (26)
  17720. ; ----------------
  17721. ;
  17722. ;
  17723.  
  17724. ;; EXP
  17725. ;; exp
  17726. L36C4:  RST     28H             ;; FP-CALC
  17727.         DB    $3D             ;;re-stack
  17728.         DB    $34             ;;stk-data
  17729.         DB    $F1             ;;Exponent: $81, Bytes: 4
  17730.         DB    $38,$AA,$3B,$29 ;;
  17731.         DB    $04             ;;multiply
  17732.         DB    $31             ;;duplicate
  17733.         DB    $27             ;;int
  17734.         DB    $C3             ;;st-mem-3
  17735.         DB    $03             ;;subtract
  17736.         DB    $31             ;;duplicate
  17737.         DB    $0F             ;;addition
  17738.         DB    $A1             ;;stk-one
  17739.         DB    $03             ;;subtract
  17740.         DB    $88             ;;series-08
  17741.         DB    $13             ;;Exponent: $63, Bytes: 1
  17742.         DB    $36             ;;(+00,+00,+00)
  17743.         DB    $58             ;;Exponent: $68, Bytes: 2
  17744.         DB    $65,$66         ;;(+00,+00)
  17745.         DB    $9D             ;;Exponent: $6D, Bytes: 3
  17746.         DB    $78,$65,$40     ;;(+00)
  17747.         DB    $A2             ;;Exponent: $72, Bytes: 3
  17748.         DB    $60,$32,$C9     ;;(+00)
  17749.         DB    $E7             ;;Exponent: $77, Bytes: 4
  17750.         DB    $21,$F7,$AF,$24 ;;
  17751.         DB    $EB             ;;Exponent: $7B, Bytes: 4
  17752.         DB    $2F,$B0,$B0,$14 ;;
  17753.         DB    $EE             ;;Exponent: $7E, Bytes: 4
  17754.         DB    $7E,$BB,$94,$58 ;;
  17755.         DB    $F1             ;;Exponent: $81, Bytes: 4
  17756.         DB    $3A,$7E,$F8,$CF ;;
  17757.         DB    $E3             ;;get-mem-3
  17758.         DB    $38             ;;end-calc
  17759.  
  17760.         CALL    L2DD5           ; routine FP-TO-A
  17761.         JR      NZ,L3705        ; to N-NEGTV
  17762.  
  17763.         JR      C,L3703         ; to REPORT-6b
  17764.  
  17765.         ADD     A,(HL)          ;
  17766.         JR      NC,L370C        ; to RESULT-OK
  17767.  
  17768.  
  17769. ;; REPORT-6b
  17770. L3703:  RST     08H             ; ERROR-1
  17771.         DB    $05             ; Error Report: Number too big
  17772.  
  17773. ;; N-NEGTV
  17774. L3705:  JR      C,L370E         ; to RSLT-ZERO
  17775.  
  17776.         SUB     (HL)            ;
  17777.         JR      NC,L370E        ; to RSLT-ZERO
  17778.  
  17779.         NEG                     ; Negate
  17780.  
  17781. ;; RESULT-OK
  17782. L370C:  LD      (HL),A          ;
  17783.         RET                     ; return.
  17784.  
  17785. ; ---
  17786.  
  17787.  
  17788. ;; RSLT-ZERO
  17789. L370E:  RST     28H             ;; FP-CALC
  17790.         DB    $02             ;;delete
  17791.         DB    $A0             ;;stk-zero
  17792.         DB    $38             ;;end-calc
  17793.  
  17794.         RET                     ; return.
  17795.  
  17796.  
  17797. ; ----------------------
  17798. ; Natural logarithm (25)
  17799. ; ----------------------
  17800. ;
  17801. ;
  17802.  
  17803. ;; ln
  17804. L3713:  RST     28H             ;; FP-CALC
  17805.         DB    $3D             ;;re-stack
  17806.         DB    $31             ;;duplicate
  17807.         DB    $37             ;;greater-0
  17808.         DB    $00             ;;jump-true
  17809.         DB    $04             ;;to L371C, VALID
  17810.  
  17811.         DB    $38             ;;end-calc
  17812.  
  17813.  
  17814. ;; REPORT-Ab
  17815. L371A:  RST     08H             ; ERROR-1
  17816.         DB    $09             ; Error Report: Invalid argument
  17817.  
  17818. ;; VALID
  17819. L371C:  DB    $A0             ;;stk-zero
  17820.         DB    $02             ;;delete
  17821.         DB    $38             ;;end-calc
  17822.         LD      A,(HL)          ;
  17823.  
  17824.         LD      (HL),$80        ;
  17825.         CALL    L2D28           ; routine STACK-A
  17826.  
  17827.         RST     28H             ;; FP-CALC
  17828.         DB    $34             ;;stk-data
  17829.         DB    $38             ;;Exponent: $88, Bytes: 1
  17830.         DB    $00             ;;(+00,+00,+00)
  17831.         DB    $03             ;;subtract
  17832.         DB    $01             ;;exchange
  17833.         DB    $31             ;;duplicate
  17834.         DB    $34             ;;stk-data
  17835.         DB    $F0             ;;Exponent: $80, Bytes: 4
  17836.         DB    $4C,$CC,$CC,$CD ;;
  17837.         DB    $03             ;;subtract
  17838.         DB    $37             ;;greater-0
  17839.         DB    $00             ;;jump-true
  17840.         DB    $08             ;;to L373D, GRE.8
  17841.  
  17842.         DB    $01             ;;exchange
  17843.         DB    $A1             ;;stk-one
  17844.         DB    $03             ;;subtract
  17845.         DB    $01             ;;exchange
  17846.         DB    $38             ;;end-calc
  17847.  
  17848.         INC     (HL)            ;
  17849.  
  17850.         RST     28H             ;; FP-CALC
  17851.  
  17852. ;; GRE.8
  17853. L373D:  DB    $01             ;;exchange
  17854.         DB    $34             ;;stk-data
  17855.         DB    $F0             ;;Exponent: $80, Bytes: 4
  17856.         DB    $31,$72,$17,$F8 ;;
  17857.         DB    $04             ;;multiply
  17858.         DB    $01             ;;exchange
  17859.         DB    $A2             ;;stk-half
  17860.         DB    $03             ;;subtract
  17861.         DB    $A2             ;;stk-half
  17862.         DB    $03             ;;subtract
  17863.         DB    $31             ;;duplicate
  17864.         DB    $34             ;;stk-data
  17865.         DB    $32             ;;Exponent: $82, Bytes: 1
  17866.         DB    $20             ;;(+00,+00,+00)
  17867.         DB    $04             ;;multiply
  17868.         DB    $A2             ;;stk-half
  17869.         DB    $03             ;;subtract
  17870.         DB    $8C             ;;series-0C
  17871.         DB    $11             ;;Exponent: $61, Bytes: 1
  17872.         DB    $AC             ;;(+00,+00,+00)
  17873.         DB    $14             ;;Exponent: $64, Bytes: 1
  17874.         DB    $09             ;;(+00,+00,+00)
  17875.         DB    $56             ;;Exponent: $66, Bytes: 2
  17876.         DB    $DA,$A5         ;;(+00,+00)
  17877.         DB    $59             ;;Exponent: $69, Bytes: 2
  17878.         DB    $30,$C5         ;;(+00,+00)
  17879.         DB    $5C             ;;Exponent: $6C, Bytes: 2
  17880.         DB    $90,$AA         ;;(+00,+00)
  17881.         DB    $9E             ;;Exponent: $6E, Bytes: 3
  17882.         DB    $70,$6F,$61     ;;(+00)
  17883.         DB    $A1             ;;Exponent: $71, Bytes: 3
  17884.         DB    $CB,$DA,$96     ;;(+00)
  17885.         DB    $A4             ;;Exponent: $74, Bytes: 3
  17886.         DB    $31,$9F,$B4     ;;(+00)
  17887.         DB    $E7             ;;Exponent: $77, Bytes: 4
  17888.         DB    $A0,$FE,$5C,$FC ;;
  17889.         DB    $EA             ;;Exponent: $7A, Bytes: 4
  17890.         DB    $1B,$43,$CA,$36 ;;
  17891.         DB    $ED             ;;Exponent: $7D, Bytes: 4
  17892.         DB    $A7,$9C,$7E,$5E ;;
  17893.         DB    $F0             ;;Exponent: $80, Bytes: 4
  17894.         DB    $6E,$23,$80,$93 ;;
  17895.         DB    $04             ;;multiply
  17896.         DB    $0F             ;;addition
  17897.         DB    $38             ;;end-calc
  17898.  
  17899.         RET                     ; return.
  17900.  
  17901.  
  17902. ; -----------------------------
  17903. ; THE 'TRIGONOMETRIC' FUNCTIONS
  17904. ; -----------------------------
  17905. ; Trigonometry is rocket science. It is also used by carpenters and pyramid
  17906. ; builders.
  17907. ; Some uses can be quite abstract but the principles can be seen in simple
  17908. ; right-angled triangles. Triangles have some special properties -
  17909. ;
  17910. ; 1) The sum of the three angles is always PI radians (180 degrees).
  17911. ;    Very helpful if you know two angles and wish to find the third.
  17912. ; 2) In any right-angled triangle the sum of the squares of the two shorter
  17913. ;    sides is equal to the square of the longest side opposite the right-angle.
  17914. ;    Very useful if you know the length of two sides and wish to know the
  17915. ;    length of the third side.
  17916. ; 3) Functions sine, cosine and tangent enable one to calculate the length
  17917. ;    of an unknown side when the length of one other side and an angle is
  17918. ;    known.
  17919. ; 4) Functions arcsin, arccosine and arctan enable one to calculate an unknown
  17920. ;    angle when the length of two of the sides is known.
  17921.  
  17922. ;---------------------------------
  17923. ; THE 'REDUCE ARGUMENT' SUBROUTINE
  17924. ;---------------------------------
  17925. ; (offset $39: 'get-argt')
  17926. ;
  17927. ; This routine performs two functions on the angle, in radians, that forms
  17928. ; the argument to the sine and cosine functions.
  17929. ; First it ensures that the angle 'wraps round'. That if a ship turns through
  17930. ; an angle of, say, 3*PI radians (540 degrees) then the net effect is to turn
  17931. ; through an angle of PI radians (180 degrees).
  17932. ; Secondly it converts the angle in radians to a fraction of a right angle,
  17933. ; depending within which quadrant the angle lies, with the periodicity
  17934. ; resembling that of the desired sine value.
  17935. ; The result lies in the range -1 to +1.              
  17936. ;
  17937. ;                     90 deg.
  17938. ;
  17939. ;                     (pi/2)
  17940. ;              II       +1        I
  17941. ;                       |
  17942. ;        sin+      |\   |   /|    sin+
  17943. ;        cos-      | \  |  / |    cos+
  17944. ;        tan-      |  \ | /  |    tan+
  17945. ;                  |   \|/)  |          
  17946. ; 180 deg. (pi) 0 -|----+----|-- 0  (0)   0 degrees
  17947. ;                  |   /|\   |
  17948. ;        sin-      |  / | \  |    sin-
  17949. ;        cos-      | /  |  \ |    cos+
  17950. ;        tan+      |/   |   \|    tan-
  17951. ;                       |
  17952. ;              III      -1       IV
  17953. ;                     (3pi/2)
  17954. ;
  17955. ;                     270 deg.
  17956. ;
  17957.  
  17958. ;; get-argt
  17959. L3783:  RST     28H             ;; FP-CALC      X.
  17960.         DB    $3D             ;;re-stack
  17961.         DB    $34             ;;stk-data
  17962.         DB    $EE             ;;Exponent: $7E,
  17963.                                 ;;Bytes: 4
  17964.         DB    $22,$F9,$83,$6E ;;              X, 1/(2*PI)
  17965.         DB    $04             ;;multiply      X/(2*PI) = fraction
  17966.         DB    $31             ;;duplicate
  17967.         DB    $A2             ;;stk-half
  17968.         DB    $0F             ;;addition
  17969.         DB    $27             ;;int
  17970.  
  17971.         DB    $03             ;;subtract      now range -.5 to .5
  17972.  
  17973.         DB    $31             ;;duplicate
  17974.         DB    $0F             ;;addition      now range -1 to 1.
  17975.         DB    $31             ;;duplicate
  17976.         DB    $0F             ;;addition      now range -2 to +2.
  17977.  
  17978. ; quadrant I (0 to +1) and quadrant IV (-1 to 0) are now correct.
  17979. ; quadrant II ranges +1 to +2.
  17980. ; quadrant III ranges -2 to -1.
  17981.  
  17982.         DB    $31             ;;duplicate     Y, Y.
  17983.         DB    $2A             ;;abs           Y, abs(Y).    range 1 to 2
  17984.         DB    $A1             ;;stk-one       Y, abs(Y), 1.
  17985.         DB    $03             ;;subtract      Y, abs(Y)-1.  range 0 to 1
  17986.         DB    $31             ;;duplicate     Y, Z, Z.
  17987.         DB    $37             ;;greater-0     Y, Z, (1/0).
  17988.  
  17989.         DB    $C0             ;;st-mem-0         store as possible sign
  17990.                                 ;;                 for cosine function.
  17991.  
  17992.         DB    $00             ;;jump-true
  17993.         DB    $04             ;;to L37A1, ZPLUS  with quadrants II and III.
  17994.  
  17995. ; else the angle lies in quadrant I or IV and value Y is already correct.
  17996.  
  17997.         DB    $02             ;;delete        Y.   delete the test value.
  17998.         DB    $38             ;;end-calc      Y.
  17999.  
  18000.         RET                     ; return.       with Q1 and Q4           >>>
  18001.  
  18002. ; ---
  18003.  
  18004. ; the branch was here with quadrants II (0 to 1) and III (1 to 0).
  18005. ; Y will hold -2 to -1 if this is quadrant III.
  18006.  
  18007. ;; ZPLUS
  18008. L37A1:  DB    $A1             ;;stk-one         Y, Z, 1.
  18009.         DB    $03             ;;subtract        Y, Z-1.       Q3 = 0 to -1
  18010.         DB    $01             ;;exchange        Z-1, Y.
  18011.         DB    $36             ;;less-0          Z-1, (1/0).
  18012.         DB    $00             ;;jump-true       Z-1.
  18013.         DB    $02             ;;to L37A8, YNEG
  18014.                                 ;;if angle in quadrant III
  18015.  
  18016. ; else angle is within quadrant II (-1 to 0)
  18017.  
  18018.         DB    $1B             ;;negate          range +1 to 0.
  18019.  
  18020. ;; YNEG
  18021. L37A8:  DB    $38             ;;end-calc        quadrants II and III correct.
  18022.  
  18023.         RET                     ; return.
  18024.  
  18025.  
  18026. ;----------------------
  18027. ; THE 'COSINE' FUNCTION
  18028. ;----------------------
  18029. ; (offset $20: 'cos')
  18030. ; Cosines are calculated as the sine of the opposite angle rectifying the
  18031. ; sign depending on the quadrant rules.
  18032. ;
  18033. ;
  18034. ;           /|
  18035. ;        h /y|
  18036. ;         /  |o
  18037. ;        /x  |
  18038. ;       /----|    
  18039. ;         a
  18040. ;
  18041. ; The cosine of angle x is the adjacent side (a) divided by the hypotenuse 1.
  18042. ; However if we examine angle y then a/h is the sine of that angle.
  18043. ; Since angle x plus angle y equals a right-angle, we can find angle y by
  18044. ; subtracting angle x from pi/2.
  18045. ; However it's just as easy to reduce the argument first and subtract the
  18046. ; reduced argument from the value 1 (a reduced right-angle).
  18047. ; It's even easier to subtract 1 from the angle and rectify the sign.
  18048. ; In fact, after reducing the argument, the absolute value of the argument
  18049. ; is used and rectified using the test result stored in mem-0 by 'get-argt'
  18050. ; for that purpose.
  18051. ;
  18052.  
  18053. ;; cos
  18054. L37AA:  RST     28H             ;; FP-CALC              angle in radians.
  18055.         DB    $39             ;;get-argt              X     reduce -1 to +1
  18056.  
  18057.         DB    $2A             ;;abs                   ABS X.   0 to 1
  18058.         DB    $A1             ;;stk-one               ABS X, 1.
  18059.         DB    $03             ;;subtract              now opposite angle
  18060.                                 ;;                      although sign is -ve.
  18061.  
  18062.         DB    $E0             ;;get-mem-0             fetch the sign indicator
  18063.         DB    $00             ;;jump-true
  18064.         DB    $06             ;;fwd to L37B7, C-ENT
  18065.                                 ;;forward to common code if in QII or QIII.
  18066.  
  18067.         DB    $1B             ;;negate                else make sign +ve.
  18068.         DB    $33             ;;jump
  18069.         DB    $03             ;;fwd to L37B7, C-ENT
  18070.                                 ;; with quadrants I and IV.
  18071.  
  18072. ;--------------------
  18073. ; THE 'SINE' FUNCTION
  18074. ;--------------------
  18075. ; (offset $1F: 'sin')
  18076. ; This is a fundamental transcendental function from which others such as cos
  18077. ; and tan are directly, or indirectly, derived.
  18078. ; It uses the series generator to produce Chebyshev polynomials.
  18079. ;
  18080. ;
  18081. ;           /|
  18082. ;        1 / |
  18083. ;         /  |x
  18084. ;        /a  |
  18085. ;       /----|    
  18086. ;         y
  18087. ;
  18088. ; The 'get-argt' function is designed to modify the angle and its sign
  18089. ; in line with the desired sine value and afterwards it can launch straight
  18090. ; into common code.
  18091.  
  18092. ;; sin
  18093. L37B5:  RST     28H             ;; FP-CALC      angle in radians
  18094.         DB    $39             ;;get-argt      reduce - sign now correct.
  18095.  
  18096. ;; C-ENT
  18097. L37B7:  DB    $31             ;;duplicate
  18098.         DB    $31             ;;duplicate
  18099.         DB    $04             ;;multiply
  18100.         DB    $31             ;;duplicate
  18101.         DB    $0F             ;;addition
  18102.         DB    $A1             ;;stk-one
  18103.         DB    $03             ;;subtract
  18104.  
  18105.         DB    $86             ;;series-06
  18106.         DB    $14             ;;Exponent: $64, Bytes: 1
  18107.         DB    $E6             ;;(+00,+00,+00)
  18108.         DB    $5C             ;;Exponent: $6C, Bytes: 2
  18109.         DB    $1F,$0B         ;;(+00,+00)
  18110.         DB    $A3             ;;Exponent: $73, Bytes: 3
  18111.         DB    $8F,$38,$EE     ;;(+00)
  18112.         DB    $E9             ;;Exponent: $79, Bytes: 4
  18113.         DB    $15,$63,$BB,$23 ;;
  18114.         DB    $EE             ;;Exponent: $7E, Bytes: 4
  18115.         DB    $92,$0D,$CD,$ED ;;
  18116.         DB    $F1             ;;Exponent: $81, Bytes: 4
  18117.         DB    $23,$5D,$1B,$EA ;;
  18118.         DB    $04             ;;multiply
  18119.         DB    $38             ;;end-calc
  18120.  
  18121.         RET                     ; return.
  18122.  
  18123. ;-----------------------
  18124. ; THE 'TANGENT' FUNCTION
  18125. ;-----------------------
  18126. ; (offset $21: 'tan')
  18127. ;
  18128. ; Evaluates tangent x as    sin(x) / cos(x).
  18129. ;
  18130. ;
  18131. ;           /|
  18132. ;        h / |
  18133. ;         /  |o
  18134. ;        /x  |
  18135. ;       /----|    
  18136. ;         a
  18137. ;
  18138. ; the tangent of angle x is the ratio of the length of the opposite side
  18139. ; divided by the length of the adjacent side. As the opposite length can
  18140. ; be calculates using sin(x) and the adjacent length using cos(x) then
  18141. ; the tangent can be defined in terms of the previous two functions.
  18142.  
  18143. ; Error 6 if the argument, in radians, is too close to one like pi/2
  18144. ; which has an infinite tangent. e.g. PRINT TAN (PI/2)  evaluates as 1/0.
  18145. ; Similarly PRINT TAN (3*PI/2), TAN (5*PI/2) etc.
  18146.  
  18147. ;; tan
  18148. L37DA:  RST     28H             ;; FP-CALC          x.
  18149.         DB    $31             ;;duplicate         x, x.
  18150.         DB    $1F             ;;sin               x, sin x.
  18151.         DB    $01             ;;exchange          sin x, x.
  18152.         DB    $20             ;;cos               sin x, cos x.
  18153.         DB    $05             ;;division          sin x/cos x (= tan x).
  18154.         DB    $38             ;;end-calc          tan x.
  18155.  
  18156.         RET                     ; return.
  18157.  
  18158. ;----------------------
  18159. ; THE 'ARCTAN' FUNCTION
  18160. ;----------------------
  18161. ; (Offset $24: 'atn')
  18162. ; the inverse tangent function with the result in radians.
  18163. ; This is a fundamental transcendental function from which others such as asn
  18164. ; and acs are directly, or indirectly, derived.
  18165. ; It uses the series generator to produce Chebyshev polynomials.
  18166.  
  18167. ;; atn
  18168. L37E2:  CALL    L3297           ; routine re-stack
  18169.         LD      A,(HL)          ; fetch exponent byte.
  18170.         CP      $81             ; compare to that for 'one'
  18171.         JR      C,L37F8         ; forward, if less, to SMALL
  18172.  
  18173.         RST     28H             ;; FP-CALC
  18174.         DB    $A1             ;;stk-one
  18175.         DB    $1B             ;;negate
  18176.         DB    $01             ;;exchange
  18177.         DB    $05             ;;division
  18178.         DB    $31             ;;duplicate
  18179.         DB    $36             ;;less-0
  18180.         DB    $A3             ;;stk-pi/2
  18181.         DB    $01             ;;exchange
  18182.         DB    $00             ;;jump-true
  18183.         DB    $06             ;;to L37FA, CASES
  18184.  
  18185.         DB    $1B             ;;negate
  18186.         DB    $33             ;;jump
  18187.         DB    $03             ;;to L37FA, CASES
  18188.  
  18189. ;; SMALL
  18190. L37F8:  RST     28H             ;; FP-CALC
  18191.         DB    $A0             ;;stk-zero
  18192.  
  18193. ;; CASES
  18194. L37FA:  DB    $01             ;;exchange
  18195.         DB    $31             ;;duplicate
  18196.         DB    $31             ;;duplicate
  18197.         DB    $04             ;;multiply
  18198.         DB    $31             ;;duplicate
  18199.         DB    $0F             ;;addition
  18200.         DB    $A1             ;;stk-one
  18201.         DB    $03             ;;subtract
  18202.         DB    $8C             ;;series-0C
  18203.         DB    $10             ;;Exponent: $60, Bytes: 1
  18204.         DB    $B2             ;;(+00,+00,+00)
  18205.         DB    $13             ;;Exponent: $63, Bytes: 1
  18206.         DB    $0E             ;;(+00,+00,+00)
  18207.         DB    $55             ;;Exponent: $65, Bytes: 2
  18208.         DB    $E4,$8D         ;;(+00,+00)
  18209.         DB    $58             ;;Exponent: $68, Bytes: 2
  18210.         DB    $39,$BC         ;;(+00,+00)
  18211.         DB    $5B             ;;Exponent: $6B, Bytes: 2
  18212.         DB    $98,$FD         ;;(+00,+00)
  18213.         DB    $9E             ;;Exponent: $6E, Bytes: 3
  18214.         DB    $00,$36,$75     ;;(+00)
  18215.         DB    $A0             ;;Exponent: $70, Bytes: 3
  18216.         DB    $DB,$E8,$B4     ;;(+00)
  18217.         DB    $63             ;;Exponent: $73, Bytes: 2
  18218.         DB    $42,$C4         ;;(+00,+00)
  18219.         DB    $E6             ;;Exponent: $76, Bytes: 4
  18220.         DB    $B5,$09,$36,$BE ;;
  18221.         DB    $E9             ;;Exponent: $79, Bytes: 4
  18222.         DB    $36,$73,$1B,$5D ;;
  18223.         DB    $EC             ;;Exponent: $7C, Bytes: 4
  18224.         DB    $D8,$DE,$63,$BE ;;
  18225.         DB    $F0             ;;Exponent: $80, Bytes: 4
  18226.         DB    $61,$A1,$B3,$0C ;;
  18227.         DB    $04             ;;multiply
  18228.         DB    $0F             ;;addition
  18229.         DB    $38             ;;end-calc
  18230.  
  18231.         RET                     ; return.
  18232.  
  18233.  
  18234. ;----------------------
  18235. ; THE 'ARCSIN' FUNCTION
  18236. ;----------------------
  18237. ; (Offset $22: 'asn')
  18238. ; the inverse sine function with result in radians.
  18239. ; derived from arctan function above.
  18240. ; Error A unless the argument is between -1 and +1 inclusive.
  18241. ; uses an adaptation of the formula asn(x) = atn(x/sqr(1-x*x))
  18242. ;
  18243. ;
  18244. ;           /|
  18245. ;        1 / |
  18246. ;         /  |x
  18247. ;        /a  |
  18248. ;       /----|    
  18249. ;         y
  18250. ;
  18251. ; e.g. we know the opposite side (x) and hypotenuse (1)
  18252. ; and we wish to find angle a in radians.
  18253. ; we can derive length y by Pythagorus and then use ATN instead.
  18254. ; since y*y + x*x = 1*1 (Pythagorus Theorem) then
  18255. ; y=sqr(1-x*x)                         - no need to multiply 1 by itself.
  18256. ; so, asn(a) = atn(x/y)
  18257. ; or more fully,
  18258. ; asn(a) = atn(x/sqr(1-x*x))
  18259.  
  18260. ; Close but no cigar.
  18261.  
  18262. ; While PRINT ATN (x/SQR (1-x*x)) gives the same results as PRINT ASN x,
  18263. ; it leads to division by zero when x is 1 or -1.
  18264. ; To overcome this, 1 is added to y giving half the required angle and the
  18265. ; result is then doubled.
  18266. ; That is PRINT ATN (x/(SQR (1-x*x) +1)) *2
  18267. ; A value higher than 1 gives the required error as attempting to find  the
  18268. ; square root of a negative number generates an error in Sinclair BASIC.
  18269.  
  18270. ;; asn
  18271. L3833:  RST     28H             ;; FP-CALC      x.
  18272.         DB    $31             ;;duplicate     x, x.
  18273.         DB    $31             ;;duplicate     x, x, x.
  18274.         DB    $04             ;;multiply      x, x*x.
  18275.         DB    $A1             ;;stk-one       x, x*x, 1.
  18276.         DB    $03             ;;subtract      x, x*x-1.
  18277.         DB    $1B             ;;negate        x, 1-x*x.
  18278.         DB    $28             ;;sqr           x, sqr(1-x*x) = y
  18279.         DB    $A1             ;;stk-one       x, y, 1.
  18280.         DB    $0F             ;;addition      x, y+1.
  18281.         DB    $05             ;;division      x/y+1.
  18282.         DB    $24             ;;atn           a/2       (half the angle)
  18283.         DB    $31             ;;duplicate     a/2, a/2.
  18284.         DB    $0F             ;;addition      a.
  18285.         DB    $38             ;;end-calc      a.
  18286.  
  18287.         RET                     ; return.
  18288.  
  18289.  
  18290. ;-------------------------
  18291. ; THE 'ARCCOS' FUNCTION
  18292. ;-------------------------
  18293. ; (Offset $23: 'acs')
  18294. ; the inverse cosine function with the result in radians.
  18295. ; Error A unless the argument is between -1 and +1.
  18296. ; Result in range 0 to pi.
  18297. ; Derived from asn above which is in turn derived from the preceding atn.
  18298. ; It could have been derived directly from atn using acs(x) = atn(sqr(1-x*x)/x).
  18299. ; However, as sine and cosine are horizontal translations of each other,
  18300. ; uses acs(x) = pi/2 - asn(x)
  18301.  
  18302. ; e.g. the arccosine of a known x value will give the required angle b in
  18303. ; radians.
  18304. ; We know, from above, how to calculate the angle a using asn(x).
  18305. ; Since the three angles of any triangle add up to 180 degrees, or pi radians,
  18306. ; and the largest angle in this case is a right-angle (pi/2 radians), then
  18307. ; we can calculate angle b as pi/2 (both angles) minus asn(x) (angle a).
  18308. ;
  18309. ;
  18310. ;           /|
  18311. ;        1 /b|
  18312. ;         /  |x
  18313. ;        /a  |
  18314. ;       /----|    
  18315. ;         y
  18316. ;
  18317.  
  18318. ;; acs
  18319. L3843:  RST     28H             ;; FP-CALC      x.
  18320.         DB    $22             ;;asn           asn(x).
  18321.         DB    $A3             ;;stk-pi/2      asn(x), pi/2.
  18322.         DB    $03             ;;subtract      asn(x) - pi/2.
  18323.         DB    $1B             ;;negate        pi/2 -asn(x)  =  acs(x).
  18324.         DB    $38             ;;end-calc      acs(x).
  18325.  
  18326.         RET                     ; return.
  18327.  
  18328.  
  18329. ; --------------------------
  18330. ; THE 'SQUARE ROOT' FUNCTION
  18331. ; --------------------------
  18332. ; (Offset $28: 'sqr')
  18333. ; This routine is remarkable only in its brevity - 7 bytes.
  18334. ; It wasn't written here but in the ZX81 where the programmers had to squeeze
  18335. ; a bulky operating sytem into an 8K ROM. It simply calculates
  18336. ; the square root by stacking the value .5 and continuing into the 'to-power'
  18337. ; routine. With more space available the much faster Newton-Raphson method
  18338. ; should have been used as on the Jupiter Ace.
  18339.  
  18340. ;; sqr
  18341. L384A:  RST     28H             ;; FP-CALC
  18342.         DB    $31             ;;duplicate
  18343.         DB    $30             ;;not
  18344.         DB    $00             ;;jump-true
  18345.         DB    $1E             ;;to L386C, LAST
  18346.  
  18347.         DB    $A2             ;;stk-half
  18348.         DB    $38             ;;end-calc
  18349.  
  18350.  
  18351. ; ------------------------------
  18352. ; THE 'EXPONENTIATION' OPERATION
  18353. ; ------------------------------
  18354. ; (Offset $06: 'to-power')
  18355. ; This raises the first number X to the power of the second number Y.
  18356. ; As with the ZX80,
  18357. ; 0 ^ 0 = 1.
  18358. ; 0 ^ +n = 0.
  18359. ; 0 ^ -n = arithmetic overflow.
  18360. ;
  18361.  
  18362. ;; to-power
  18363. L3851:  RST     28H             ;; FP-CALC              X, Y.
  18364.         DB    $01             ;;exchange              Y, X.
  18365.         DB    $31             ;;duplicate             Y, X, X.
  18366.         DB    $30             ;;not                   Y, X, (1/0).
  18367.         DB    $00             ;;jump-true
  18368.         DB    $07             ;;to L385D, XISO   if X is zero.
  18369.  
  18370. ; else X is non-zero. Function 'ln' will catch a negative value of X.
  18371.  
  18372.         DB    $25             ;;ln                    Y, LN X.
  18373.         DB    $04             ;;multiply              Y * LN X.
  18374.         DB    $38             ;;end-calc
  18375.  
  18376.         JP      L36C4           ; jump back to EXP routine   ->
  18377.  
  18378. ; ---
  18379.  
  18380. ; these routines form the three simple results when the number is zero.
  18381. ; begin by deleting the known zero to leave Y the power factor.
  18382.  
  18383. ;; XISO
  18384. L385D:  DB    $02             ;;delete                Y.
  18385.         DB    $31             ;;duplicate             Y, Y.
  18386.         DB    $30             ;;not                   Y, (1/0).
  18387.         DB    $00             ;;jump-true
  18388.         DB    $09             ;;to L386A, ONE         if Y is zero.
  18389.  
  18390.         DB    $A0             ;;stk-zero              Y, 0.
  18391.         DB    $01             ;;exchange              0, Y.
  18392.         DB    $37             ;;greater-0             0, (1/0).
  18393.         DB    $00             ;;jump-true             0.
  18394.         DB    $06             ;;to L386C, LAST        if Y was any positive
  18395.                                 ;;                      number.
  18396.  
  18397. ; else force division by zero thereby raising an Arithmetic overflow error.
  18398. ; There are some one and two-byte alternatives but perhaps the most formal
  18399. ; might have been to use end-calc; rst 08; DB 05.
  18400.  
  18401.         DB    $A1             ;;stk-one               0, 1.
  18402.         DB    $01             ;;exchange              1, 0.
  18403.         DB    $05             ;;division              1/0        ouch!
  18404.  
  18405. ; ---
  18406.  
  18407. ;; ONE
  18408. L386A:  DB    $02             ;;delete                .
  18409.         DB    $A1             ;;stk-one               1.
  18410.  
  18411. ;; LAST
  18412. L386C:  DB    $38             ;;end-calc              last value is 1 or 0.
  18413.  
  18414.         RET                     ; return.               Whew!
  18415.  
  18416. ;*********************************
  18417. ;** Spectrum 128 Patch Routines **
  18418. ;*********************************
  18419.  
  18420. ; The new code added to the standard 48K Spectrum ROM is mainly devoted to the scanning and decoding of the keypad.
  18421. ; These routines occupy addresses 386E through to 3B3A. Addresses 3B3B through to 3C96 contain a variety of routines for the following purposes: displaying the new tokens 'PLAY' and 'SPECTRUM',
  18422. ; dealing with the keypad when using INKEY$, handling new 128 BASIC error messages, and producing the TV tuner display. Addresses 3BE1 to 3BFE and addresses 3C97 to 3CFF are unused and all contain 00.
  18423. ; Documented by Paul Farrow.
  18424.  
  18425. ; --------------------------------
  18426. ; SCAN THE KEYPAD AND THE KEYBOARD
  18427. ; --------------------------------
  18428. ; This patch will attempt to scan the keypad if in 128K mode and will then scan the keyboard.
  18429.  
  18430. ;; KEYS
  18431. L386E:  PUSH    IX
  18432.         BIT     4,(IY+$01)      ; [FLAGS] Test if in 128K mode
  18433.         JR      Z,L3879         ; Z=in 48K mode
  18434.  
  18435.         CALL    L3A42           ; Attempt to scan the keypad
  18436.  
  18437. ;; KEYS_CONT
  18438. L3879:  CALL    L02BF           ; Scan the keyboard
  18439.         POP     IX
  18440.         RET
  18441.  
  18442. ; ----------------------------------
  18443. ; READ THE STATE OF THE OUTPUT LINES
  18444. ; ----------------------------------
  18445. ; This routine returns the state of the four output lines (bits 0-3) in the lower four bits of L. The LSB of L corresponds to the output communication line to the keypad.
  18446. ; In this way the state of the other three outputs are maintained when the state of the LSB of L is changed and sent out to register 14 of the AY-3-8912.
  18447.  
  18448. ;; READ_OUTPUTS
  18449. L387F:  LD      C,$FD           ; FFFD = Address of the
  18450.         LD      D,$FF           ; command register (register 7)
  18451.         LD      E,$BF           ; BFFD = Address of the
  18452.         LD      B,D             ; data register (register 14)
  18453.         LD      A,$07
  18454.         OUT     (C),A           ; Select command register
  18455.         IN      H,(C)           ; Read its status
  18456.         LD      A,$0E
  18457.         OUT     (C),A           ; Select data register
  18458.         IN      A,(C)           ; Read its status
  18459.         OR      $F0             ; Mask off the input lines
  18460.         LD      L,A             ; L=state of output lines at the
  18461.         RET                     ; keypad socket
  18462.  
  18463. ; --------------------------
  18464. ; SET THE OUTPUT LINE, BIT 0
  18465. ; --------------------------
  18466. ; The output line to the keypad is set via the LSB of L.
  18467.  
  18468. ;; SET_REG14
  18469. L3896:  LD      B,D
  18470.         LD      A,$0E
  18471.         OUT     (C),A           ; Select the data register
  18472.         LD      B,E
  18473.         OUT     (C),L           ; Send L out to the data register
  18474.         RET                     ; Set the output line
  18475.  
  18476. ; ----------------------------------------
  18477. ; FETCH THE STATE OF THE INPUT LINE, BIT 5
  18478. ; ----------------------------------------
  18479. ; Return the state of the input line from the keypad in bit 5 of A.
  18480.  
  18481. ;; GET_REG14
  18482. L389F:  LD      B,D
  18483.         LD      A,$0E
  18484.         OUT     (C),A           ; Select the data register
  18485.         IN      A,(C)           ; Read the input line
  18486.         RET
  18487.  
  18488. ; ------------------------------
  18489. ; SET THE OUTPUT LINE LOW, BIT 0
  18490. ; ------------------------------
  18491.  
  18492. ;; RESET_LINE
  18493. L38A7:  LD      A,L
  18494.         AND     $FE             ; Reset bit 0 of L
  18495.         LD      L,A
  18496.         JR      L3896           ; Send out L to the data register
  18497.  
  18498. ; -------------------------------
  18499. ; SET THE OUTPUT LINE HIGH, BIT 0
  18500. ; -------------------------------
  18501.  
  18502. ;; SET_LINE
  18503. L38AD:  LD      A,L
  18504.         OR      $01             ; Set bit 0 of L
  18505.         LD      L,A
  18506.         JR      L3896           ; Send out L to the data register
  18507.  
  18508. ; -------------------
  18509. ; MINOR DELAY ROUTINE
  18510. ; -------------------
  18511. ; Delay for (B*13)+5 T-States.
  18512.  
  18513. ;; DELAY
  18514. L38B3:  DJNZ    L38B3
  18515.         RET
  18516.  
  18517. ; -------------------
  18518. ; MAJOR DELAY ROUTINE
  18519. ; -------------------
  18520. ; Delay for (B*271)+5 T-states.
  18521.  
  18522. ;; DELAY2
  18523. L38B6:  PUSH    BC
  18524.         LD      B,$10
  18525.         CALL    L38B3           ; Inner delay of 135 T-States
  18526.         POP     BC
  18527.         DJNZ    L38B6
  18528.         RET
  18529.  
  18530. ; ------------------------------------
  18531. ; MONITOR FOR THE INPUT LINE TO GO LOW
  18532. ; ------------------------------------
  18533. ; Monitor the input line, bit 5, for up to (B*108)+5 T-states.
  18534.  
  18535. ;; MON_B5_LO
  18536. L38C0:  PUSH    BC
  18537.         CALL    L389F           ; Read the state of the input line
  18538.         POP     BC
  18539.         AND     $20             ; Test bit 5, the input line
  18540.         JR      Z,L38CB         ; Exit if input line found low
  18541.         DJNZ    L38C0           ; Repeat until timeout expires
  18542.  
  18543. ;; EXT_MON_LO
  18544. L38CB:  RET
  18545.  
  18546. ; -------------------------------------
  18547. ; MONITOR FOR THE INPUT LINE TO GO HIGH
  18548. ; -------------------------------------
  18549. ; Monitor the input line, bit 5, for up to (B*108)+5 T-states.
  18550.  
  18551. ;; MON_B5_HI
  18552. L38CC:  PUSH    BC
  18553.         CALL    L389F           ; Read the state of the input line
  18554.         POP     BC
  18555.         AND     $20             ; Test bit 5, the input line
  18556.         JR      NZ,L38D7        ; Exit if input line found low
  18557.         DJNZ    L38CC           ; Repeat until timeout expires
  18558.  
  18559. ;; EXT_MON_HI
  18560. L38D7:  RET
  18561.  
  18562. ; -------------------------
  18563. ; READ KEY PRESS STATUS BIT
  18564. ; -------------------------
  18565. ; This entry point is used to read in the status bit for a keypad row. If a key is being pressed in the current row then the bit read in will be a 1.
  18566.  
  18567. ;; READ_STATUS
  18568. L38D8:  CALL    L387F           ; Read the output lines
  18569.         LD      B,$01           ; Read in one bit
  18570.         JR      L38E4
  18571.  
  18572. ; ----------------
  18573. ; READ IN A NIBBLE
  18574. ; ----------------
  18575. ; This entry point is used to read in a nibble of data from the keypad. It is used for two functions. The first is to read in the poll nibble and the second is to read in a row of key press data.
  18576. ; For a nibble of key press data, a bit read in as 1 indicates that the corresponding key was pressed.
  18577.  
  18578. ;; READ_NIBBLE
  18579. L38DF:  CALL    L387F           ; Read the state of the output lines
  18580.         LD      B,$04           ; Read in four bits
  18581.  
  18582. ;; READ_BIT
  18583. L38E4:  PUSH    BC
  18584.         CALL    L389F           ; Read the input line from the keypad
  18585.         POP     BC
  18586.         AND     $20             ; This line should initially be high
  18587.         JR      Z,L392D         ; Z=read in a 0, there must be an error
  18588.  
  18589.         XOR     A               ; The bits read in will be stored in register A
  18590.  
  18591. ;; BIT_LOOP
  18592. L38EE:  PUSH    BC              ; Preserve the loop count and any bits
  18593.         PUSH    AF              ; read in so far
  18594.         CALL    L38AD           ; Set the output line high
  18595.  
  18596.         LD      B,$A3           ; Monitor for 17609 T-states for the
  18597.         CALL    L38C0           ; input line to go low
  18598.         JR      NZ,L392B        ; NZ=the line did not go low
  18599.  
  18600.         CALL    L38A7           ; Set the output line low
  18601.         JR      L3901           ; Insert a delay of 12 T-states
  18602.  
  18603. L38FF:  DB    $FF, $FF
  18604.  
  18605. ;; BL_CONTINUE
  18606. L3901:  LD      B,$2B           ; Delay for 564 T-states
  18607.         CALL    L38B3
  18608.         CALL    L389F           ; Read in the bit value
  18609.         BIT     5,A
  18610.         JR      Z,L3911         ; Z=read in a 0
  18611.  
  18612.         POP     AF              ; Retrieve read in bits
  18613.         SCF                     ; Set carry bit
  18614.         JR      L3914
  18615.  
  18616. ;; BL_READ_0
  18617. L3911:  POP     AF              ; Retrieve read in bits
  18618.         SCF
  18619.         CCF                     ; Clear carry bit
  18620.  
  18621. ;; BL_STORE
  18622. L3914:  RRA                     ; Shift the carry bit into bit 0 of A
  18623.         PUSH    AF              ; Save bits read in
  18624.         CALL    L38AD           ; Set the output line high
  18625.  
  18626.         LD      B,$26           ; Delay for 499 T-states
  18627.         CALL    L38B3
  18628.  
  18629.         CALL    L38A7           ; Set the output line low
  18630.  
  18631.         LD      B,$23           ; Delay for 460 T-states
  18632.         CALL    L38B3
  18633.  
  18634.         POP     AF              ; Retrieve read in bits
  18635.         POP     BC              ; Retrieve loop counter and repeat
  18636.         DJNZ    L38EE           ; for all bits to read in
  18637.         RET
  18638.  
  18639. ; ----------
  18640. ; LINE ERROR
  18641. ; ----------
  18642. ; The input line was found at the wrong level. The output line is now set high which will eventually cause the keypad to abandon its transmissions.
  18643. ; The upper nibble of system variable FLAGS/ROW3 will be cleared to indicate that communications to the keypad is no longer in progress.
  18644.  
  18645. ;; LINE_ERROR
  18646. L392B:  POP     AF
  18647.         POP     BC              ; Clear the stack
  18648.  
  18649. ;; LINE_ERROR2
  18650. L392D:  CALL    L38AD           ; Set the output line high
  18651.  
  18652.         XOR     A               ; Clear FLAGS nibble
  18653.         LD      ($5B88),A       ; [FLAGS/ROW3]
  18654.  
  18655.         INC     A               ; Return zero flag reset
  18656.         SCF
  18657.         CCF                     ; Return carry flag reset
  18658.         RET
  18659.  
  18660. ; ---------------
  18661. ; POLL THE KEYPAD
  18662. ; ---------------
  18663. ; The Spectrum 128 polls the keypad by changing the state of the output line and monitoring for responses from the keypad on the input line.
  18664. ; Before a poll occurs, the poll counter must be decremented until it reaches zero. This counter causes a delay of three seconds before a communications attempt to the keypad is made.
  18665. ; The routine can exit at five different places and it is the state of the A register, the zero flag and the carry flag which indicates the cause of the exit. This is summarised below:
  18666. ;
  18667. ; A Register    Zero Flag       Carry Flag    Cause
  18668. ; 0             set             set           Communications already established
  18669. ; 0             set             reset         Nibble read in OK
  18670. ; 1             reset           reset         Nibble read in with an error or i/p line initially low
  18671. ; 1             reset           set           Poll counter has not yet reached zero
  18672. ;
  18673. ; The third bit of the nibble read in must be set for the poll to be subsequently accepted.
  18674.  
  18675. ;; ATTEMPT_POLL
  18676. L3938:  CALL    L387F           ; Read the output line states
  18677.  
  18678.         LD      A,($5B88)       ; [FLAGS/ROW3] Has communications already been
  18679.         AND     $80             ; established with the keypad?
  18680.         JR      NZ,L3999        ; NZ=yes, so skip the poll
  18681.  
  18682.         CALL    L389F           ; Read the input line
  18683.         AND     $20             ; It should be high initially
  18684.         JR      Z,L392D         ; Z=error, input line found low
  18685.  
  18686.         LD      A,($5B88)       ; [FLAGS/ROW3] Test if poll counter already zero thus
  18687.         AND     A               ; indicating a previous comms error
  18688.         JR      NZ,L395A        ; NZ=ready to poll the keypad
  18689.  
  18690.         INC     A               ; Indicate comms not established
  18691.         LD      ($5B88),A       ; [FLAGS/ROW3]
  18692.         LD      A,$4C           ; Reset the poll counter
  18693.         LD      ($5B89),A       ; [ROW2/ROW1]
  18694.         JR      L399C           ; Exit the routine
  18695.  
  18696. ;;POLL_KEYPAD
  18697. L395A:  LD      A,($5B89)       ; [ROW2/ROW1] Decrement the poll counter
  18698.         DEC     A
  18699.         LD      ($5B89),A       ; [ROW2/ROW1]
  18700.         JR      NZ,L399C        ; Exit the routine if it is not yet zero
  18701.  
  18702. ; The poll counter has reached zero so a poll of the keypad can now occur.
  18703.  
  18704.         XOR     A
  18705.         LD      ($5B88),A       ; [FLAGS/ROW3] Indicate that a poll can occur
  18706.         LD      ($5B89),A       ; [ROW2/ROW1]
  18707.         LD      ($5B8A),A       ; [ROW4/ROW5] Clear all the row nibble stores
  18708.  
  18709.         CALL    L38A7           ; Set the output line low
  18710.  
  18711.         LD      B,$21           ; Wait up to 3569 T-States for the
  18712.         CALL    L38C0           ; input line to go low
  18713.         JR      NZ,L392D        ; NZ=line did not go low
  18714.  
  18715.         CALL    L38AD           ; Set the output line high
  18716.  
  18717.         LD      B,$24           ; Wait up to 3893 T-States for the
  18718.         CALL    L38CC           ; input line to go high
  18719.         JR      Z,L392D         ; NZ=line did not go high
  18720.  
  18721.         CALL    L38A7           ; Set the output line low
  18722.  
  18723.         LD      B,$0F
  18724.         CALL    L38B6           ; Delay for 4070 T-States
  18725.         CALL    L38DF           ; Read in a nibble of data
  18726.         JR      NZ,L392D        ; NZ=error occurred when reading in nibble
  18727.  
  18728.         SET     7,A             ; Set bit 7
  18729.         AND     $F0             ; Keep only the upper four bits
  18730.                                 ; (Bit 6 will be set if poll successful)
  18731.         LD      ($5B88),A       ; [FLAGS/ROW3] Store the flags nibble
  18732.         XOR     A
  18733.         SRL     A               ; Exit: Zero flag set, Carry flag reset
  18734.         RET
  18735.  
  18736. ;; AP_SKIP_POLL
  18737. L3999:  XOR     A               ; Communications already established
  18738.         SCF                     ; Exit: Zero flag set, Carry flag set
  18739.         RET
  18740.  
  18741. ;; PK_EXIT
  18742. L399C:  XOR     A               ; Poll counter not zero
  18743.         INC     A
  18744.         SCF                     ; Exit: Zero flag reset, Carry flag set
  18745.         RET
  18746.  
  18747. ; -----------------------
  18748. ; SCAN THE KEYPAD ROUTINE
  18749. ; -----------------------
  18750. ; If a successful poll of the keypad occurs then the five rows of keys are read in and a unique key code generated.
  18751.  
  18752. ;; KEYPAD_SCAN
  18753. L39A0:  CALL    L3938           ; Try to poll the keypad
  18754.  
  18755.         LD      A,($5B88)       ; [FLAGS/ROW3] Test the flags nibble
  18756.         CPL
  18757.         AND     $C0             ; Bits 6 and 7 must be set in FLAGS
  18758.         RET     NZ              ; NZ=poll was not successful
  18759.  
  18760. ; The poll was successful so now read in data for the five keypad rows.
  18761.  
  18762.         LD      IX,$5B8A        ; [ROW4/ROW5]
  18763.         LD      B,$05           ; The five rows
  18764.  
  18765. ;; KS_LOOP
  18766. L39B0:  PUSH    BC              ; Save counter
  18767.  
  18768.         CALL    L38D8           ; Read the key press status bit
  18769.         JP      NZ,L3A3A        ; NZ=error occurred
  18770.  
  18771.         BIT     7,A             ; Test the bit read in
  18772.         JR      Z,L39DC         ; Z=no key pressed in this row
  18773.  
  18774.         CALL    L38DF           ; Read in the row's nibble of data
  18775.         JR      NZ,L3A3A        ; NZ=error occurred
  18776.  
  18777.         POP     BC              ; Fetch the nibble loop counter
  18778.         PUSH    BC
  18779.         LD      C,A             ; Move the nibble read in to C
  18780.         LD      A,(IX+$00)      ; Fetch the nibble store
  18781.         BIT     0,B             ; Test if an upper or lower nibble
  18782.         JR      Z,L39D6         ; Z=upper nibble
  18783.  
  18784.         SRL     C               ; Shift the nibble to the lower position
  18785.         SRL     C
  18786.         SRL     C
  18787.         SRL     C
  18788.         AND     $F0             ; Mask off the lower nibble of the
  18789.         JR      L39D8           ; nibble store
  18790.  
  18791. ;; KS_UPPER
  18792. L39D6:  AND     $0F             ; Mask off the upper nibble of the nibble store
  18793.  
  18794. ;; KS_STORE
  18795. L39D8:  OR      C               ; Combine the existing and new
  18796.         LD      (IX+$00),A      ; nibbles and store them
  18797.  
  18798. ;; KS_NEXT
  18799. L39DC:  POP     BC              ; Retrieve the row counter
  18800.         BIT     0,B             ; Test if next nibble store is required
  18801.         JR      NZ,L39E3        ; NZ=use same nibble store
  18802.  
  18803.         DEC     IX              ; Point to the next nibble store
  18804.  
  18805. ;; KS_NEW
  18806. L39E3:  DJNZ    L39B0           ; Repeat for the next keypad row
  18807.  
  18808. ; All five rows have now been read so compose a unique code for the key pressed.
  18809.  
  18810.         LD      E,$80           ; Signal no key press found yet
  18811.         LD      IX,$5B88        ; [FLAGS/ROW3]
  18812.         LD      HL,$3A3F        ; Point to the key mask data
  18813.         LD      B,$03           ; Scan three nibbles
  18814.  
  18815. ;; GEN_LOOP
  18816. L39F0:  LD      A,(IX+$00)      ; Fetch a pair of nibbles
  18817.         AND     (HL)            ; This will mask off the FLAGS nibble and the SHIFT/0 key
  18818.  
  18819.         JR      Z,L3A17         ; Z=no key pressed in these nibbles
  18820.  
  18821.         BIT     7,E             ; Test if a key has already been found
  18822.         JR      Z,L3A3C         ; Z=multiple keys pressed
  18823.  
  18824.         PUSH    BC              ; Save the loop counter
  18825.         PUSH    AF              ; Save the byte of key bit data
  18826.         LD      A,B             ; Move loop counter to A
  18827.         JR      L3A01           ; A delay of 12 T-States
  18828.  
  18829. L39FF:  DB    $FF, $FF        ; Unused locations
  18830.  
  18831. ;; GEN_CONT
  18832. L3A01:  DEC     A               ; These lines of code generate base
  18833.         SLA     A               ; values of 7, 15 and 23 for the three
  18834.         SLA     A               ; nibble stores 5B88, 5B89 & 5B8A.
  18835.         SLA     A
  18836.         OR      $07
  18837.         LD      B,A             ; B=(loop counter-1)*8+7
  18838.         POP     AF              ; Fetch the byte of key press data
  18839.  
  18840. ;; GEN_BIT
  18841. L3A0C:  SLA     A               ; Shift until a set key bit drops into the
  18842.         JP      C,L3A13         ; carry flag
  18843.  
  18844.         DJNZ    L3A0C           ; Decrement B for each 'unsuccessful' shift of the A register
  18845.  
  18846. ;; GEN_FOUND
  18847. L3A13:  LD      E,B             ; E=a unique number for the key pressed, between 1 - 19 except 2 & 3
  18848.  
  18849.         POP     BC              ; As a result shifting the set key bit
  18850.                                 ; into the carry flag, the A register will
  18851.                                 ; hold 00 if only one key was pressed
  18852.         JR      NZ,L3A3C        ; NZ=multiple keys pressed
  18853.  
  18854. ;; GEN_NEXT
  18855. L3A17:  INC     IX              ; Point to the next nibble store
  18856.         INC     HL              ; Point to the corresponding mask data
  18857.         DJNZ    L39F0           ; Repeat for all three 'nibble' bytes
  18858.  
  18859.         BIT     7,E             ; Test if any keys were pressed
  18860.         JR      NZ,L3A27        ; NZ=no keys were pressed
  18861.  
  18862.         LD      A,E             ; Copy the key code
  18863.         AND     $FC             ; Test for the '.' key (E=1)
  18864.         JR      Z,L3A27         ; Z='.' key pressed
  18865.  
  18866.         DEC     E
  18867.         DEC     E               ; Key code in range 2 - 17
  18868.  
  18869. ; The E register now holds a unique key code value between 1 and 17.
  18870.  
  18871. ;; GEN_POINT
  18872. L3A27:  LD      A,($5B8A)       ; [ROW4/ROW5] Test if the SHIFT key was pressed
  18873.         AND     $08
  18874.         JR      Z,L3A34         ; Z=the SHIFT key was not pressed
  18875.  
  18876. ; The SHIFT key was pressed or no key was pressed.
  18877.  
  18878.         LD      A,E             ; Fetch the key code
  18879.         AND     $7F             ; Mask off 'no key pressed' bit
  18880.         ADD     A,$12           ; Add on a shift offset of 12
  18881.         LD      E,A
  18882.  
  18883. ; Add a base offset of 5A to all key codes. Note that no key press will result in a key code of DA. This is the only code with bit 7 set and so will be detected later.
  18884.  
  18885. ;; GEN_NOSHIFT
  18886. L3A34:  LD      A,E
  18887.         ADD     A,$5A           ; Add a base offset of 5A
  18888.         LD      E,A             ; Return key codes in range 5B - 7D
  18889.         XOR     A
  18890.         RET                     ; Exit: Zero flag set, key found OK
  18891.  
  18892. ; These two lines belong with the loop above to read in the five keypad rows and are jumped to when an error occurs during reading in a nibble of data.
  18893.  
  18894. ;; KS_ERROR
  18895. L3A3A:  POP     BC              ; Clear the stack and exit
  18896.         RET                     ; Exit: Zero flag reset
  18897.  
  18898. ;; GEN_INVALID
  18899. L3A3C:  XOR     A               ; Exit: Zero flag reset indicating an
  18900.         INC     A               ; invalid key press
  18901.         RET
  18902.  
  18903. ; ----------------
  18904. ; KEYPAD MASK DATA
  18905. ; ----------------
  18906.  
  18907. ;; KEY_MASKS
  18908. L3A3F:  DB    $0F, $FF, $F2   ; Key mask data
  18909.  
  18910. ; ---------------
  18911. ; READ THE KEYPAD
  18912. ; ---------------
  18913. ; This routine reads the keypad and handles key repeat and decoding. The bulk of the key repeat code is very similar to that used in the equivalent keyboard routine and works are follows.
  18914. ; A double system of KSTATE system variables (KSTATE0 - KSTATE3 and KSTATE4 - KSTATE7) is used to allow the detection of one key while in the repeat period of the previous key.
  18915. ; In this way, a 'spike' from another key will not stop the previous key from repeating. For a new key to be acknowledged, it must be held down for at least 1/5th of a second, i.e. ten calls to KEYPAD.
  18916. ; The KSTATE system variables store the following data:
  18917. ;
  18918. ;       KSTATE0/4       Un-decoded Key Value (00-27 for keyboard, 5B-7D for keypad, FF for no key)
  18919. ;       KSTATE1/5       10 Call Counter
  18920. ;       KSTATE2/6       Repeat Delay
  18921. ;       KSTATE3/7       Decoded Key Value
  18922. ;
  18923. ; The code returned is then stored in system variable LAST_K (5C08) and a new key signalled by setting bit 5 of FLAGS (5C3B).
  18924. ;
  18925. ; If the Spectrum 128 were to operate identically to the standard 48K Spectrum when in 48K mode, it would have to spend zero time in reading the keypad.
  18926. ; As this is not possible, the loading on the CPU is reduced by scanning the keypad upon every other interrupt. A '10 Call Counter' is then used to ensure that a key is held down for at least 1/5th of a second
  18927. ; before it is registered. Note that this is twice as long as for keyboard key presses and so the keypad key repeat delay is halved.
  18928. ;
  18929. ; At every other interrupt the keypad scanning routine is skipped. The net result of the routine is simply to decrement both '10 Call Counters', if appropriate. By loading the E register with 80 ensures that
  18930. ; the call to KP_TEST will reject the key code and cause a return. A test for keyboard key codes prevents the Call Counter decrements affecting a keyboard key press. It would have been more efficient to execute
  18931. ; a return upon every other call to KEYPAD and then to have used a '5 Call Counter' just as the keyboard routine does.
  18932. ;
  18933. ; A side effect of both the keyboard and keypad using the same KSTATE system variables is that if a key is held down on the keypad and then a key is held down on the keyboard, both keys will be monitored and
  18934. ; repeated alternatively, but with a reduced repeat delay. This delay is between the keypad key repeat delay and the keyboard key repeat delay. This occurs because both the keypad and keyboard routines will
  18935. ; decrement the KSTATE system variable Call Counters. The keypad routine 'knows' of the existence of keyboard key codes but the reverse is not true.
  18936.  
  18937. ;; KEYPAD
  18938. L3A42:  LD      E,$80           ; Signal no key pressed
  18939.         LD      A,($5C78)       ; [FRAMES]
  18940.         AND     $01             ; Scan the keypad every other
  18941.         JR      NZ,L3A4F        ; interrupt
  18942.  
  18943.         CALL    L39A0
  18944.         RET     NZ              ; NZ=no valid key pressed
  18945.  
  18946. ;; KP_CHECK
  18947. L3A4F:  LD HL,$5C00             ; [KSTATE0] Test the first KSTATE variable
  18948.  
  18949. ;; KP_LOOP
  18950. L3A52:  BIT     7,(HL)          ; Is the set free?
  18951.         JR      NZ,L3A62        ; NZ=yes
  18952.  
  18953.         LD      A,(HL)          ; Fetch the un-decoded key value
  18954.         CP      $5B             ; Is it a keyboard code?
  18955.         JR      C,L3A62         ; C=yes, so do not decrement counter
  18956.  
  18957.         INC     HL
  18958.         DEC     (HL)            ; Decrement the 10 Call Counter
  18959.         DEC     HL
  18960.         JR      NZ,L3A62        ; If the counter reaches zero, then
  18961.                                 ; signal the set is free
  18962.         LD      (HL),$FF
  18963.  
  18964. ;; KP_CH_SET
  18965. L3A62:  LD      A,L             ; Jump back and test the second set if
  18966.         LD      HL,$5C04        ; [KSTATE4] not yet considered
  18967.         CP      L
  18968.         JR      NZ,L3A52
  18969.  
  18970.         CALL    L3AAE           ; Test for valid key combinations and
  18971.         RET     NZ              ; return if invalid
  18972.  
  18973.         LD      A,E             ; Test if the key in the first set is being
  18974.         LD      HL,$5C00        ; [KSTATE0] repeated
  18975.         CP      (HL)
  18976.         JR      Z,L3A9E         ; Jump if being repeated
  18977.  
  18978.         EX      DE,HL           ; Save the address of KSTATE0
  18979.         LD      HL,$5C04        ; [KSTATE4] Test if the key in the second set is
  18980.         CP      (HL)            ; being repeated
  18981.         JR      Z,L3A9E         ; Jump if being repeated
  18982.  
  18983. ; A new key will not be accepted unless one of the KSTATE sets is free.
  18984.  
  18985.         BIT     7,(HL)          ; Test if the second set is free
  18986.         JR      NZ,L3A83        ; Jump if set is free
  18987.  
  18988.         EX      DE,HL
  18989.         BIT     7,(HL)          ; Test if the first set is free
  18990.         RET     Z               ; Return if no set is free
  18991.  
  18992. ;; KP_NEW
  18993. L3A83:  LD      E,A             ; Pass the key code to the E register
  18994.         LD      (HL),A          ; and to KSTATE0/4
  18995.         INC     HL
  18996.         LD      (HL),$0A        ; Set the '10 Call Counter' to 10
  18997.         INC     HL
  18998.  
  18999.         LD      A,($5C09)       ; [REPDEL] Fetch the initial repeat delay
  19000.         SRL     A               ; Divide delay by two
  19001.         LD      (HL),A          ; Store the repeat delay
  19002.         INC     HL
  19003.  
  19004.         CALL    L3AD7           ; Decode the keypad key code
  19005.         LD      (HL),E          ; and store it in KSTATE3/7
  19006.  
  19007. ; This section is common for both new keys and repeated keys.
  19008.  
  19009. ;; KP_END
  19010. L3A94:  LD      A,E
  19011.         LD      ($5C08),A       ; [LAST_K] Store the key value in LAST_K
  19012.         LD      HL,$5C3B        ; FLAGS
  19013.         SET     5,(HL)          ; Signal a new key pressed
  19014.         RET
  19015.  
  19016. ; -------------------------
  19017. ; THE KEY REPEAT SUBROUTINE
  19018. ; -------------------------
  19019.  
  19020. ;; KP_REPEAT
  19021. L3A9E:  INC     HL
  19022.         LD      (HL),$0A        ; Reset the '10 Call Counter' to 10
  19023.         INC     HL
  19024.         DEC     (HL)            ; Decrement the repeat delay
  19025.         RET     NZ              ; Return if not zero
  19026.  
  19027.         LD      A,($5C0A)       ; [REPPER] The subsequent repeat delay is
  19028.         SRL     A               ; divided by two and stored
  19029.         LD      (HL),A
  19030.         INC     HL
  19031.         LD      E,(HL)          ; The key repeating is fetched
  19032.         JR      L3A94           ; and then returned in LAST_K
  19033.  
  19034. ; ----------------------------------------
  19035. ; THE TEST FOR A VALID KEY CODE SUBROUTINE
  19036. ; ----------------------------------------
  19037. ; The zero flag is returned set if the key code is valid. No key press, SHIFT only or invalid shifted key presses return the zero flag reset.
  19038.  
  19039. ;; KP_TEST
  19040. L3AAE:  LD      A,E
  19041.         LD      HL,$5B66        ; FLAGS3 Test if in BASIC or EDIT mode
  19042.         BIT     0,(HL)
  19043.         JR      Z,L3ABC         ; Z=EDIT mode
  19044.  
  19045. ; Test key codes when in BASIC/CALCULATOR mode
  19046.  
  19047.         CP      $6D             ; Test for shifted keys
  19048.         JR      NC,L3AD4        ; and signal an error if found
  19049.  
  19050. ;; KPT_OK
  19051. L3ABA:  XOR     A               ; Signal valid key code
  19052.         RET                     ; Exit: Zero flag set
  19053.  
  19054. ; Test key codes when in EDIT/MENU mode.
  19055.  
  19056. ;; KPT_EDIT
  19057. L3ABC:  CP      $80             ; Test for no key press
  19058.         JR      NC,L3AD4        ; NC=no key press
  19059.  
  19060.         CP      $6C             ; Test for SHIFT on its own
  19061.         JR      NZ,L3ABA        ; NZ=valid key code
  19062.  
  19063. L3AC4:  DB    $00, $00, $00   ; Delay for 64 T-States
  19064.         DB    $00, $00, $00
  19065.         DB    $00, $00, $00
  19066.         DB    $00, $00, $00
  19067.         DB    $00, $00, $00
  19068.         DB    $00
  19069.  
  19070. ;; KPT_INVALID
  19071. L3AD4:  XOR     A               ; Signal invalid key code
  19072.         INC     A
  19073.         RET                     ; Exit: Zero flag reset
  19074.  
  19075. ; ---------------------------
  19076. ; THE KEY DECODING SUBROUTINE
  19077. ; ---------------------------
  19078.  
  19079. ;; KP_DECODE
  19080. L3AD7:  PUSH    HL              ; Save the KSTATE pointer
  19081.         LD      A,E
  19082.         SUB     $5B             ; Reduce the key code range to
  19083.         LD      D,$00           ; 00 - 22 and transfer to DE
  19084.         LD      E,A
  19085.  
  19086.         LD      HL,$5B66        ; FLAGS3 Test if in EDIT or BASIC mode
  19087.         BIT     0,(HL)
  19088.         JR      Z,L3AEA         ; Z=EDIT/MENU mode
  19089.  
  19090. ; Use Table 1 when in CALCULATOR/BASIC mode.
  19091.  
  19092.         LD      HL,L3B13
  19093.         JR      L3B0F           ; Look up the key value
  19094.  
  19095. ; Deal with EDIT/MENU mode.
  19096.  
  19097. ;; KPD_EDIT
  19098. L3AEA:  LD      HL,L3B25        ; Use Table 4 for unshifted key
  19099.         CP      $11             ; presses
  19100.         JR      C,L3B0F
  19101.  
  19102. ; Deal with shifted keys in EDIT/MENU mode.
  19103.  
  19104. ; Use Table 3 with SHIFT 1 (delete to beginning of line), SHIFT 2 (delete to end of line), SHIFT 3 (SHIFT TOGGLE). Note that although SHIFT TOGGLE produces a unique valid code,
  19105. ; it actually performs no function when editing a BASIC program.
  19106.  
  19107.         LD      HL,L3B21
  19108.         CP      $15             ; Test for SHIFT 1
  19109.         JR      Z,L3B0F
  19110.  
  19111.         CP      $16             ; Test for SHIFT 2
  19112.         JR      Z,L3B0F
  19113.  
  19114.         JR      L3B01           ; Delay for 12 T-States
  19115.  
  19116. L3AFE:  DB    $00, $FF, $FF   ; Unused locations
  19117.  
  19118. ;; KPD_CONT
  19119. L3B01:  CP      $17             ; Test for SHIFT 3
  19120.         JR      Z,L3B0F
  19121.  
  19122. ; Use Table 2 with SHIFT 4 (delete to beginning of word) and SHIFT 5 (delete to end of word).
  19123.  
  19124.         LD      HL,L3B18
  19125.         CP      $21             ; Test for SHIFT 4 and above
  19126.         JR      NC,L3B0F
  19127.  
  19128. ;Use Table 1 for all other shifted key presses.
  19129.  
  19130.         LD      HL,L3B13
  19131.  
  19132. ;; KPD_EXIT
  19133. L3B0F:  ADD     HL,DE           ; Look up the key value
  19134.         LD      E,(HL)
  19135.         POP     HL              ; Retrieve the KSTATE address
  19136.         RET
  19137.  
  19138. ; --------------------------------
  19139. ; THE KEYPAD DECODE LOOK-UP TABLES
  19140. ; --------------------------------
  19141.  
  19142. ;; KPD_TABLE1
  19143. L3B13:  DB    $2E, $0D, $33   ; '.', ENTER, 3
  19144.         DB    $32, $31        ; 2, 1
  19145.  
  19146. ;; KPD_TABLE2
  19147. L3B18:  DB    $29, $28, $2A   ; ), (, *
  19148.         DB    $2F, $2D, $39   ; /, - , 9
  19149.         DB    $38, $37, $2B   ; 8, 7, +
  19150.  
  19151. ;; KPD_TABLE3
  19152. L3B21:  DB    $36, $35, $34   ; 6, 5, 4
  19153.         DB    $30             ; 0
  19154.  
  19155. ;; KPD_TABLE4
  19156. L3B25:  DB    $A5, $0D, $A6   ; Bottom, ENTER, Top
  19157.         DB    $A7, $A8, $A9   ; End of line, Start of line, TOGGLE
  19158.         DB    $AA, $0B, $0C   ; DEL right, Up, DEL
  19159.         DB    $07, $09, $0A   ; CMND, Right, Down
  19160.         DB    $08, $AC, $AD   ; Left, Down ten, Up ten
  19161.         DB    $AE, $AF        ; End word, Beginning of word
  19162.         DB    $B0, $B1, $B2   ; DEL to end of line, DEL to start of line, SHIFT TOGGLE
  19163.         DB    $B3, $B4        ; DEL to end of word, DEL to beginning of word
  19164.  
  19165. ; -----------------------------
  19166. ; PRINT NEW ERROR MESSAGE PATCH
  19167. ; -----------------------------
  19168.  
  19169. L3B3B:  BIT     4,(IY+$01)      ; FLAGS 3 - In 128K mode?
  19170.         JR      NZ,L3B46        ; NZ=128K mode
  19171.  
  19172. ; In 48K mode
  19173.  
  19174.         XOR     A               ; Replicate code from standard ROM that the patch over-wrote
  19175.         LD      DE,$1536
  19176.         RET    
  19177.  
  19178. ; In 128K mode
  19179.  
  19180. L3B46:  LD      HL,$010F        ; Vector table entry in Editor ROM -> JP $03A2
  19181.  
  19182. ; Return to Editor ROM at address in HL
  19183.  
  19184. L3B49:  EX      (SP),HL         ; Change the return address
  19185.         JP      $5B00           ; Page Editor ROM and return to the address on the stack
  19186.  
  19187. ; -------------------------------------
  19188. ; STATEMENT INTERPRETATION RETURN PATCH
  19189. ; -------------------------------------
  19190.  
  19191. L3B4D:  BIT     4,(IY+$01)      ; In 128K mode?
  19192.         JR      NZ,L3B58        ; NZ=128K mode
  19193.  
  19194. ; In 48K mode
  19195.  
  19196.         BIT     7,(IY+$0A)      ; replicate code from standard ROM that the patch over-wrote
  19197.         RET    
  19198.  
  19199. ; In 128K mode
  19200.  
  19201. L3B58:  LD      HL,$0112        ; Handle in Editor ROM by jumping to Vector table entry in Editor ROM -> JP #182A
  19202.         JR      L3B49
  19203.  
  19204. ; --------------------------
  19205. ; GO TO NEXT STATEMENT PATCH
  19206. ; --------------------------
  19207.  
  19208. L3B5D:  BIT     4,(IY+$01)      ; In 128K mode?
  19209.         JR      NZ,L3B67        ; NZ=128K mode
  19210.  
  19211. ; In 48K mode
  19212.  
  19213.         RST     18H             ; replicate code from standard ROM that the patch over-wrote
  19214.         CP      $0D
  19215.         RET    
  19216.  
  19217. ; In 128K mode
  19218.  
  19219. L3B67:  LD      HL,$0115        ; Handle in Editor ROM by jumping to Vector table entry in Editor ROM -> JP #18A8
  19220.         JR      L3B49
  19221.  
  19222. ; --------------------------------------
  19223. ; INKEY$ ROUTINE TO DEAL WITH THE KEYPAD
  19224. ; --------------------------------------
  19225.  
  19226. ;; KEYSCAN2
  19227. L3B6C:  CALL    L028E           ; KEYSCAN Scan the keyboard
  19228.         LD      C,$00
  19229.         JR      NZ,L3B80        ; NZ=multiple keys
  19230.  
  19231.         CALL    L031E           ; K_TEST
  19232.         JR      NC,L3B80        ; NC=shift only or no key
  19233.  
  19234.         DEC     D
  19235.         LD      E,A
  19236.         CALL    L0333           ; K_DECODE
  19237.         JP      L2657           ; S_CONT Get string and continue scanning
  19238.  
  19239. ;; KPI_SCAN
  19240. L3B80:  BIT     4,(IY+$01)      ; 128K mode?
  19241.         JP      Z,L2660         ; S_IK$_STK Z=no, stack keyboard code
  19242.  
  19243.         DI                      ; Disable interrupts whilst scanning
  19244.         CALL    L39A0           ; the keypad
  19245.         EI
  19246.         JR      NZ,L3B9A        ; NZ=multiple keys
  19247.  
  19248.         CALL    L3AAE           ; Test the keypad
  19249.         JR      NZ,L3B9A        ; NZ=no key, shift only or invalid combination
  19250.  
  19251.         CALL    L3AD7           ; Form the key code
  19252.         LD      A,E
  19253.         JP      L2657           ; S_CONT Get string and continue scanning
  19254.  
  19255. ;; KPI_INVALID
  19256. L3B9A:  LD      C,$00           ; Signal no key, i.e. length=0
  19257.         JP      L2660           ; S_IK$_STK
  19258.  
  19259. ; ---------------------
  19260. ; PRINT TOKEN/UDG PATCH
  19261. ; ---------------------
  19262.  
  19263. L3B9F:  CP      $A3             ; SPECTRUM (T)
  19264.         JR      Z,L3BAF
  19265.  
  19266.         CP      $A4             ; PLAY (U)
  19267.         JR      Z,L3BAF
  19268.  
  19269. ; In 48K mode here
  19270.  
  19271. L3BA7:  SUB     $A5             ; Check as per original ROM
  19272.         JP      NC,$0B5F
  19273.  
  19274.         JP      $0B56           ; Rejoin original ROM routine
  19275.  
  19276. L3BAF:  BIT     4,(IY+$01)      ; FLAGS3 - Bit 4=1 if in 128K mode
  19277.         JR      Z,L3BA7         ; Rejoin code for when in 48K mode
  19278.  
  19279. ; In 128K mode here
  19280.  
  19281.         LD      DE,L3BC9
  19282.         PUSH    DE              ; Stack return address
  19283.  
  19284.         SUB     $A3             ; Check whether the SPECTRUM token
  19285.  
  19286.         LD      DE,L3BD2        ; SPECTRUM token
  19287.         JR      Z,L3BC3
  19288.  
  19289.         LD      DE,L3BDA        ; PLAY token
  19290.  
  19291. L3BC3:  LD      A,$04           ; Signal not RND, INKEY$ or PI so that a trailing space is printed
  19292.         PUSH    AF
  19293.         JP      L0C17           ; Rejoin printing routine PO-TABLE+3
  19294.  
  19295. ; Return address from above
  19296.  
  19297. L3BC9:  SCF                     ; Return as if no trailing space
  19298.  
  19299.         BIT     1,(IY+$01)      ; Test if printer is in use
  19300.         RET     NZ              ; NZ=printer in use
  19301.  
  19302.         JP      $0B03           ; PO-FETCH - Return via Position Fetch routine
  19303.  
  19304. L3BD2           DC "SPECTRUM"   ;DEFM    "SPECTRU"       ; SPECTRUM token
  19305.                                 ;DB    'M'+$80
  19306.  
  19307. L3BDA           DC "PLAY"       ;DEFM    "PLA"           ; PLAY token
  19308.                                 ;DB    'Y'+$80
  19309.  
  19310. ;; KP_SCAN2
  19311. L3BDE:  JP      L3C01           ; This is not called from either ROM. It can be used to scan the keypad.
  19312.  
  19313. ;===============================
  19314.                 IF TAP_EMUL
  19315. INI_TAP         RST 0X08
  19316.                 DB TAPE_INIT
  19317.                 SCF
  19318.                 SBC HL,DE
  19319.                 RET
  19320.                 ENDIF
  19321.  
  19322.                 IF AY_PRINTER
  19323. PRINTER_INITER  RST 0X08
  19324.                 DB AY_PRN_INIT
  19325.                 JP L0EDF
  19326.                 ENDIF
  19327.  
  19328.                 DUPL 0X3BFF-$,0
  19329.                 DW 0XFFFF
  19330. ;===============================
  19331.  
  19332. ;; KP_SCAN
  19333. L3C01:  JP      L39A0           ; This was to be called via the vector table in the EDITOR ROM but due to a programming error it never gets called.
  19334.  
  19335. ; -----------------------
  19336. ; TV TUNER VECTOR ENTRIES
  19337. ; -----------------------
  19338.  
  19339. L3C04:  JP      L3C10
  19340. L3C07:  JP      L3C10
  19341. L3C0A:  JP      L3C10
  19342. L3C0D:  JP      L3C10
  19343.  
  19344. ; ----------------
  19345. ; TV TUNER ROUTINE
  19346. ; ----------------
  19347. ; This routine generates a display showing all possible colours and emitting a continuous cycle of a 440Hz tone for 1 second followed by silence for 1 second.
  19348. ; Its purpose is to ease the tuning in of TV sets to the Spectrum 128's RF signal. The display consists of vertical stripes of width four character squares showing each of the eight colours
  19349. ; available at both their normal and bright intensities. The display begins with white on the left progressing up to black on the right. With in each colour stripe in the first eight rows is
  19350. ; shown the year '1986' in varying ink colours. This leads to a display that shows all possible ink colours on all possible paper colours.
  19351.  
  19352. ;; TV_TUNER
  19353. L3C10:  LD      A,$7F           ; Test for the BREAK key
  19354.         IN      A,($FE)
  19355.         RRA    
  19356.         RET     C               ; C=SPACE not pressed
  19357.  
  19358.         LD      A,$FE
  19359.         IN      A,($FE)
  19360.         RRA    
  19361.         RET     C               ; C=SPACE not pressed
  19362.  
  19363.         LD      A,$07
  19364.         OUT     ($FE),A         ; Set the border to white
  19365.  
  19366.         LD      A,$02           ; Open channel 2 (main screen)
  19367.         CALL    $1601
  19368.  
  19369.         XOR     A
  19370.         LD      ($5C3C),A       ; [TV_FLAG] Signal using main screen
  19371.  
  19372.         LD      A,$16           ; Print character 'AT'
  19373.         RST     10H
  19374.  
  19375.         XOR     A               ; Print character '0'
  19376.         RST     10H
  19377.  
  19378.         XOR     A               ; Print character '0'
  19379.         RST     10H
  19380.  
  19381.         LD      E,$08           ; Number of characters per colour
  19382.         LD      B,E             ; Paper counter + 1
  19383.         LD      D,B             ; Ink counter + 1
  19384.  
  19385. ;; TVT_ROW
  19386. L3C34:  LD      A,B             ; Calculate the paper colour
  19387.         DEC     A               ; Bits 3-5 of each screen attribute
  19388.                 DB 0XCB
  19389.                 RLA               ; holds the paper colour; bits 0-2
  19390.                 DB 0XCB
  19391.                 RLA               ; the ink colour
  19392.                 DB 0XCB
  19393.                 RLA
  19394.         ADD     A,D             ; Add the ink colour
  19395.         DEC     A
  19396.         LD      ($5C8F),A       ; [ATTR_T] Store as temporary attribute value
  19397.  
  19398.         LD      HL,L3C8F        ; TVT_DATA Point to the 'year' data
  19399.         LD      C,E             ; Get number of characters to print
  19400.  
  19401. ;; TVT_YEAR
  19402. L3C45:  LD      A,(HL)          ; Fetch a character from the data
  19403.         RST     10H             ; Print it
  19404.         INC     HL
  19405.         DEC     C
  19406.         JR      NZ,L3C45        ; Repeat for the 8 characters
  19407.  
  19408.         DJNZ    L3C34           ; Repeat for all colours in this row
  19409.  
  19410.         LD      B,E             ; Reset paper colour
  19411.         DEC     D               ; Next ink colour
  19412.         JR      NZ,L3C34        ; Produce next row with new ink colour
  19413.  
  19414.         LD      HL,$4800        ; Point to 2nd third of display file
  19415.         LD      D,H
  19416.         LD      E,L
  19417.         INC     DE              ; Point to the next display cell
  19418.         XOR     A
  19419.         LD      (HL),A          ; Clear first display cell
  19420.         LD      BC,$0FFF
  19421.         LDIR                    ; Clear lower 2 thirds of display file
  19422.  
  19423.         EX      DE,HL           ; HL points to start of attributes file
  19424.         LD      DE,$5900        ; Point to 2nd third of attributes file
  19425.         LD      BC,$0200
  19426.         LDIR                    ; Copy screen attributes
  19427.  
  19428. ; Now that the display has been constructed, produce a continuous cycle of a 440Hz tone for 1 second followed by a period of silence for 1 second (actually 962ms).
  19429.  
  19430.         DI                      ; Disable interrupts so that a pure tone can be generated
  19431.  
  19432. ;; TVT_TONE
  19433. L3C68:  LD      DE,$0370        ; DE=twice the tone frequency in Hz
  19434.         LD      L,$07           ; Border colour of white
  19435.  
  19436. ;; TVT_DURATION
  19437. L3C6D:  LD      BC,$0099        ; Delay for 950.4us
  19438.  
  19439. ;; TVT_PERIOD
  19440. L3C70:  DEC     BC
  19441.         LD      A,B
  19442.         OR      C
  19443.         JR      NZ,L3C70
  19444.  
  19445.         LD      A,L
  19446.         XOR     $10              ; Toggle the speaker output whilst
  19447.         LD      L,A              ; preserving the border colour
  19448.         OUT     ($FE),A
  19449.  
  19450.         DEC     DE               ; Generate the tone for 1 second
  19451.         LD      A,D
  19452.         OR      E
  19453.         JR      NZ,L3C6D
  19454.  
  19455. ; At this point the speaker is turned off, so delay for 1 second.
  19456.  
  19457.         LD      BC,$0000         ; Delay for 480.4us
  19458.  
  19459. ;; TVT_DELAY1
  19460. L3C83:  DEC     BC
  19461.         LD      A,B
  19462.         OR      C
  19463.         JR      NZ,L3C83
  19464.  
  19465. ;; TVT_DELAY2
  19466. L3C88:  DEC     BC               ; Delay for 480.4us
  19467.         LD      A,B
  19468.         OR      C
  19469.         JR      NZ,L3C88
  19470.  
  19471.         JR      L3C68            ; Repeat the tone cycle
  19472.  
  19473. ;; TVT_DATA
  19474. L3C8F:  DB    $13, $00         ; Bright, off
  19475.         DB    $31, $39         ; '1', '9'
  19476.         DB    $13, $01         ; Bright, on
  19477.         DB    $38, $36         ; '8', '6'
  19478.  
  19479.                 include new_proc.a80
  19480.  
  19481. ; ------
  19482. ; UNUSED
  19483. ; ------
  19484.  
  19485.                 DUPL 0X3D00-$,0
  19486.  
  19487. ; -------------------------------
  19488. ; THE 'ZX SPECTRUM CHARACTER SET'
  19489. ; -------------------------------
  19490.  
  19491. ;; char-set
  19492.  
  19493. ; $20 - Character: ' '          CHR$(32)
  19494.  
  19495. CHARS           binclude shr_3d00.bin
  19496.