zx81-rom

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

zx81v2.asm (227795B)


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