OpenCores
URL https://opencores.org/ocsvn/a-z80/a-z80/trunk

Subversion Repositories a-z80

[/] [a-z80/] [trunk/] [host/] [zxspectrum_de1/] [rom/] [zxspectrum_rom.asm] - Blame information for rev 11

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 8 gdevic
;************************************************************************
2
;** An Assembly File Listing to generate a 16K ROM for the ZX Spectrum **
3
;************************************************************************
4
;
5 11 gdevic
; 03-13-2016:
6
; Add custom NMI handler and a function to enter game pokes after pressing the NMI button
7
;
8 8 gdevic
; 11-10-2014:
9
; This version has been updated to correctly handle the NMI jump.
10
;
11
; -------------------------
12
; Last updated: 13-DEC-2004
13
; -------------------------
14
 
15
; TASM cross-assembler directives.
16
; ( comment out, perhaps, for other assemblers - see Notes at end.)
17
 
18
#define DEFB .BYTE
19
#define DEFW .WORD
20
#define DEFM .TEXT
21
#define ORG  .ORG
22
#define EQU  .EQU
23
#define equ  .EQU
24
 
25
;   It is always a good idea to anchor, using ORGs, important sections such as
26
;   the character bitmaps so that they don't move as code is added and removed.
27
 
28
;   Generally most approaches try to maintain main entry points as they are
29
;   often used by third-party software.
30
 
31
ORG 0000
32
 
33
;*****************************************
34
;** Part 1. RESTART ROUTINES AND TABLES **
35
;*****************************************
36
 
37
; -----------
38
; THE 'START'
39
; -----------
40
;   At switch on, the Z80 chip is in Interrupt Mode 0.
41
;   The Spectrum uses Interrupt Mode 1.
42
;   This location can also be 'called' to reset the machine.
43
;   Typically with PRINT USR 0.
44
 
45
;; START
46
L0000:  DI                      ; Disable Interrupts.
47
        XOR     A               ; Signal coming from START.
48
        LD      DE,$FFFF        ; Set pointer to top of possible physical RAM.
49
        JP      L11CB           ; Jump forward to common code at START-NEW.
50
 
51
; -------------------
52
; THE 'ERROR' RESTART
53
; -------------------
54
;   The error pointer is made to point to the position of the error to enable
55
;   the editor to highlight the error position if it occurred during syntax
56
;   checking.  It is used at 37 places in the program.  An instruction fetch
57
;   on address $0008 may page in a peripheral ROM such as the Sinclair
58
;   Interface 1 or Disciple Disk Interface.  This was not an original design
59
;   concept and not all errors pass through here.
60
 
61
;; ERROR-1
62
L0008:  LD      HL,($5C5D)      ; Fetch the character address from CH_ADD.
63
        LD      ($5C5F),HL      ; Copy it to the error pointer X_PTR.
64
        JR      L0053           ; Forward to continue at ERROR-2.
65
 
66
; -----------------------------
67
; THE 'PRINT CHARACTER' RESTART
68
; -----------------------------
69
;   The A register holds the code of the character that is to be sent to
70
;   the output stream of the current channel.  The alternate register set is
71
;   used to output a character in the A register so there is no need to
72
;   preserve any of the current main registers (HL, DE, BC).
73
;   This restart is used 21 times.
74
 
75
;; PRINT-A
76
L0010:  JP      L15F2           ; Jump forward to continue at PRINT-A-2.
77
 
78
; ---
79
 
80
        DEFB    $FF, $FF, $FF   ; Five unused locations.
81
        DEFB    $FF, $FF        ;
82
 
83
; -------------------------------
84
; THE 'COLLECT CHARACTER' RESTART
85
; -------------------------------
86
;   The contents of the location currently addressed by CH_ADD are fetched.
87
;   A return is made if the value represents a character that has
88
;   relevance to the BASIC parser. Otherwise CH_ADD is incremented and the
89
;   tests repeated. CH_ADD will be addressing somewhere -
90
;   1) in the BASIC program area during line execution.
91
;   2) in workspace if evaluating, for example, a string expression.
92
;   3) in the edit buffer if parsing a direct command or a new BASIC line.
93
;   4) in workspace if accepting input but not that from INPUT LINE.
94
 
95
;; GET-CHAR
96
L0018:  LD      HL,($5C5D)      ; fetch the address from CH_ADD.
97
        LD      A,(HL)          ; use it to pick up current character.
98
 
99
;; TEST-CHAR
100
L001C:  CALL    L007D           ; routine SKIP-OVER tests if the character is
101
                                ; relevant.
102
        RET     NC              ; Return if it is significant.
103
 
104
; ------------------------------------
105
; THE 'COLLECT NEXT CHARACTER' RESTART
106
; ------------------------------------
107
;   As the BASIC commands and expressions are interpreted, this routine is
108
;   called repeatedly to step along the line.  It is used 83 times.
109
 
110
;; NEXT-CHAR
111
L0020:  CALL    L0074           ; routine CH-ADD+1 fetches the next immediate
112
                                ; character.
113
        JR      L001C           ; jump back to TEST-CHAR until a valid
114
                                ; character is found.
115
 
116
; ---
117
 
118
        DEFB    $FF, $FF, $FF   ; unused
119
 
120
; -----------------------
121
; THE 'CALCULATE' RESTART
122
; -----------------------
123
;   This restart enters the Spectrum's internal, floating-point, stack-based,
124
;   FORTH-like language.
125
;   It is further used recursively from within the calculator.
126
;   It is used on 77 occasions.
127
 
128
;; FP-CALC
129
L0028:  JP      L335B           ; jump forward to the CALCULATE routine.
130
 
131
; ---
132
 
133
        DEFB    $FF, $FF, $FF   ; spare - note that on the ZX81, space being a
134
        DEFB    $FF, $FF        ; little cramped, these same locations were
135
                                ; used for the five-byte end-calc literal.
136
 
137
; ------------------------------
138
; THE 'CREATE BC SPACES' RESTART
139
; ------------------------------
140
;   This restart is used on only 12 occasions to create BC spaces
141
;   between workspace and the calculator stack.
142
 
143
;; BC-SPACES
144
L0030:  PUSH    BC              ; Save number of spaces.
145
        LD      HL,($5C61)      ; Fetch WORKSP.
146
        PUSH    HL              ; Save address of workspace.
147
        JP      L169E           ; Jump forward to continuation code RESERVE.
148
 
149
; --------------------------------
150
; THE 'MASKABLE INTERRUPT' ROUTINE
151
; --------------------------------
152
;   This routine increments the Spectrum's three-byte FRAMES counter fifty
153
;   times a second (sixty times a second in the USA ).
154
;   Both this routine and the called KEYBOARD subroutine use the IY register
155
;   to access system variables and flags so a user-written program must
156
;   disable interrupts to make use of the IY register.
157
 
158
;; MASK-INT
159
L0038:  PUSH    AF              ; Save the registers that will be used but not
160
        PUSH    HL              ; the IY register unfortunately.
161
        LD      HL,($5C78)      ; Fetch the first two bytes at FRAMES1.
162
        INC     HL              ; Increment lowest two bytes of counter.
163
        LD      ($5C78),HL      ; Place back in FRAMES1.
164
        LD      A,H             ; Test if the result was zero.
165
        OR      L               ;
166
        JR      NZ,L0048        ; Forward, if not, to KEY-INT
167
 
168
        INC     (IY+$40)        ; otherwise increment FRAMES3 the third byte.
169
 
170
;   Now save the rest of the main registers and read and decode the keyboard.
171
 
172
;; KEY-INT
173
L0048:  PUSH    BC              ; Save the other main registers.
174
        PUSH    DE              ;
175
 
176
        CALL    L02BF           ; Routine KEYBOARD executes a stage in the
177
                                ; process of reading a key-press.
178
        POP     DE              ;
179
        POP     BC              ; Restore registers.
180
 
181
        POP     HL              ;
182
        POP     AF              ;
183
 
184
        EI                      ; Enable Interrupts.
185
        RET                     ; Return.
186
 
187
; ---------------------
188
; THE 'ERROR-2' ROUTINE
189
; ---------------------
190
;   A continuation of the code at 0008.
191
;   The error code is stored and after clearing down stacks, an indirect jump
192
;   is made to MAIN-4, etc. to handle the error.
193
 
194
;; ERROR-2
195
L0053:  POP     HL              ; drop the return address - the location
196
                                ; after the RST 08H instruction.
197
        LD      L,(HL)          ; fetch the error code that follows.
198
                                ; (nice to see this instruction used.)
199
 
200
;   Note. this entry point is used when out of memory at REPORT-4.
201
;   The L register has been loaded with the report code but X-PTR is not
202
;   updated.
203
 
204
;; ERROR-3
205
L0055:  LD      (IY+$00),L      ; Store it in the system variable ERR_NR.
206
        LD      SP,($5C3D)      ; ERR_SP points to an error handler on the
207
                                ; machine stack. There may be a hierarchy
208
                                ; of routines.
209
                                ; To MAIN-4 initially at base.
210
                                ; or REPORT-G on line entry.
211
                                ; or  ED-ERROR when editing.
212
                                ; or   ED-FULL during ed-enter.
213
                                ; or  IN-VAR-1 during runtime input etc.
214
 
215
        JP      L16C5           ; Jump to SET-STK to clear the calculator stack
216
                                ; and reset MEM to usual place in the systems
217
                                ; variables area and then indirectly to MAIN-4,
218
                                ; etc.
219
 
220
; ---
221
 
222
        DEFB    $FF, $FF, $FF   ; Unused locations
223
        DEFB    $FF, $FF, $FF   ; before the fixed-position
224
        DEFB    $FF             ; NMI routine.
225
 
226
; ------------------------------------
227
; THE 'NON-MASKABLE INTERRUPT' ROUTINE
228
; ------------------------------------
229
;
230
;   There is no NMI switch on the standard Spectrum or its peripherals.
231
;   When the NMI line is held low, then no matter what the Z80 was doing at
232
;   the time, it will now execute the code at 66 Hex.
233
;   This Interrupt Service Routine will jump to location zero if the contents
234
;   of the system variable NMIADD are zero or return if the location holds a
235
;   non-zero address.   So attaching a simple switch to the NMI as in the book
236
;   "Spectrum Hardware Manual" causes a reset.  The logic was obviously
237
;   intended to work the other way.  Sinclair Research said that, since they
238
;   had never advertised the NMI, they had no plans to fix the error "until
239
;   the opportunity arose".
240
;
241
;   Note. The location NMIADD was, in fact, later used by Sinclair Research
242
;   to enhance the text channel on the ZX Interface 1.
243
;   On later Amstrad-made Spectrums, and the Brazilian Spectrum, the logic of
244
;   this routine was indeed reversed but not as at first intended.
245
;
246
;   It can be deduced by looking elsewhere in this ROM that the NMIADD system
247
;   variable pointed to L121C and that this enabled a Warm Restart to be
248
;   performed at any time, even while playing machine code games, or while
249
;   another Spectrum has been allowed to gain control of this one.
250
;
251
;   Software houses would have been able to protect their games from attack by
252
;   placing two zeros in the NMIADD system variable.
253
 
254
;; RESET
255
L0066:  PUSH    AF              ; save the
256
        PUSH    HL              ; registers.
257 11 gdevic
;       LD      HL,($5CB0)      ; fetch the system variable NMIADD.
258
        LD      HL, nmi_handler ; Custom NMI handler
259 8 gdevic
        LD      A,H             ; test address
260
        OR      L               ; for zero.
261
 
262 11 gdevic
;       JR      NZ,L0070       ; skip to NO-RESET if NOT ZERO
263 8 gdevic
        JR      Z,L0070         ; **FIXED**
264
 
265
        JP      (HL)            ; jump to routine ( i.e. L0000 )
266
 
267
;; NO-RESET
268
L0070:  POP     HL              ; restore the
269
        POP     AF              ; registers.
270
        RETN                    ; return to previous interrupt state.
271
 
272
; ---------------------------
273
; THE 'CH ADD + 1' SUBROUTINE
274
; ---------------------------
275
;   This subroutine is called from RST 20, and three times from elsewhere
276
;   to fetch the next immediate character following the current valid character
277
;   address and update the associated system variable.
278
;   The entry point TEMP-PTR1 is used from the SCANNING routine.
279
;   Both TEMP-PTR1 and TEMP-PTR2 are used by the READ command routine.
280
 
281
;; CH-ADD+1
282
L0074:  LD      HL,($5C5D)      ; fetch address from CH_ADD.
283
 
284
;; TEMP-PTR1
285
L0077:  INC     HL              ; increase the character address by one.
286
 
287
;; TEMP-PTR2
288
L0078:  LD      ($5C5D),HL      ; update CH_ADD with character address.
289
 
290
X007B:  LD      A,(HL)          ; load character to A from HL.
291
        RET                     ; and return.
292
 
293
; --------------------------
294
; THE 'SKIP OVER' SUBROUTINE
295
; --------------------------
296
;   This subroutine is called once from RST 18 to skip over white-space and
297
;   other characters irrelevant to the parsing of a BASIC line etc. .
298
;   Initially the A register holds the character to be considered
299
;   and HL holds its address which will not be within quoted text
300
;   when a BASIC line is parsed.
301
;   Although the 'tab' and 'at' characters will not appear in a BASIC line,
302
;   they could be present in a string expression, and in other situations.
303
;   Note. although white-space is usually placed in a program to indent loops
304
;   and make it more readable, it can also be used for the opposite effect and
305
;   spaces may appear in variable names although the parser never sees them.
306
;   It is this routine that helps make the variables 'Anum bEr5 3BUS' and
307
;   'a number 53 bus' appear the same to the parser.
308
 
309
;; SKIP-OVER
310
L007D:  CP      $21             ; test if higher than space.
311
        RET     NC              ; return with carry clear if so.
312
 
313
        CP      $0D             ; carriage return ?
314
        RET     Z               ; return also with carry clear if so.
315
 
316
                                ; all other characters have no relevance
317
                                ; to the parser and must be returned with
318
                                ; carry set.
319
 
320
        CP      $10             ; test if 0-15d
321
        RET     C               ; return, if so, with carry set.
322
 
323
        CP      $18             ; test if 24-32d
324
        CCF                     ; complement carry flag.
325
        RET     C               ; return with carry set if so.
326
 
327
                                ; now leaves 16d-23d
328
 
329
        INC     HL              ; all above have at least one extra character
330
                                ; to be stepped over.
331
 
332
        CP      $16             ; controls 22d ('at') and 23d ('tab') have two.
333
        JR      C,L0090         ; forward to SKIPS with ink, paper, flash,
334
                                ; bright, inverse or over controls.
335
                                ; Note. the high byte of tab is for RS232 only.
336
                                ; it has no relevance on this machine.
337
 
338
        INC     HL              ; step over the second character of 'at'/'tab'.
339
 
340
;; SKIPS
341
L0090:  SCF                     ; set the carry flag
342
        LD      ($5C5D),HL      ; update the CH_ADD system variable.
343
        RET                     ; return with carry set.
344
 
345
 
346
; ------------------
347
; THE 'TOKEN' TABLES
348
; ------------------
349
;   The tokenized characters 134d (RND) to 255d (COPY) are expanded using
350
;   this table. The last byte of a token is inverted to denote the end of
351
;   the word. The first is an inverted step-over byte.
352
 
353
;; TKN-TABLE
354
L0095:  DEFB    '?'+$80
355
        DEFM    "RN"
356
        DEFB    'D'+$80
357
        DEFM    "INKEY"
358
        DEFB    '$'+$80
359
        DEFB    'P','I'+$80
360
        DEFB    'F','N'+$80
361
        DEFM    "POIN"
362
        DEFB    'T'+$80
363
        DEFM    "SCREEN"
364
        DEFB    '$'+$80
365
        DEFM    "ATT"
366
        DEFB    'R'+$80
367
        DEFB    'A','T'+$80
368
        DEFM    "TA"
369
        DEFB    'B'+$80
370
        DEFM    "VAL"
371
        DEFB    '$'+$80
372
        DEFM    "COD"
373
        DEFB    'E'+$80
374
        DEFM    "VA"
375
        DEFB    'L'+$80
376
        DEFM    "LE"
377
        DEFB    'N'+$80
378
        DEFM    "SI"
379
        DEFB    'N'+$80
380
        DEFM    "CO"
381
        DEFB    'S'+$80
382
        DEFM    "TA"
383
        DEFB    'N'+$80
384
        DEFM    "AS"
385
        DEFB    'N'+$80
386
        DEFM    "AC"
387
        DEFB    'S'+$80
388
        DEFM    "AT"
389
        DEFB    'N'+$80
390
        DEFB    'L','N'+$80
391
        DEFM    "EX"
392
        DEFB    'P'+$80
393
        DEFM    "IN"
394
        DEFB    'T'+$80
395
        DEFM    "SQ"
396
        DEFB    'R'+$80
397
        DEFM    "SG"
398
        DEFB    'N'+$80
399
        DEFM    "AB"
400
        DEFB    'S'+$80
401
        DEFM    "PEE"
402
        DEFB    'K'+$80
403
        DEFB    'I','N'+$80
404
        DEFM    "US"
405
        DEFB    'R'+$80
406
        DEFM    "STR"
407
        DEFB    '$'+$80
408
        DEFM    "CHR"
409
        DEFB    '$'+$80
410
        DEFM    "NO"
411
        DEFB    'T'+$80
412
        DEFM    "BI"
413
        DEFB    'N'+$80
414
 
415
;   The previous 32 function-type words are printed without a leading space
416
;   The following have a leading space if they begin with a letter
417
 
418
        DEFB    'O','R'+$80
419
        DEFM    "AN"
420
        DEFB    'D'+$80
421
        DEFB    $3C,'='+$80             ; <=
422
        DEFB    $3E,'='+$80             ; >=
423
        DEFB    $3C,$3E+$80             ; <>
424
        DEFM    "LIN"
425
        DEFB    'E'+$80
426
        DEFM    "THE"
427
        DEFB    'N'+$80
428
        DEFB    'T','O'+$80
429
        DEFM    "STE"
430
        DEFB    'P'+$80
431
        DEFM    "DEF F"
432
        DEFB    'N'+$80
433
        DEFM    "CA"
434
        DEFB    'T'+$80
435
        DEFM    "FORMA"
436
        DEFB    'T'+$80
437
        DEFM    "MOV"
438
        DEFB    'E'+$80
439
        DEFM    "ERAS"
440
        DEFB    'E'+$80
441
        DEFM    "OPEN "
442
        DEFB    '#'+$80
443
        DEFM    "CLOSE "
444
        DEFB    '#'+$80
445
        DEFM    "MERG"
446
        DEFB    'E'+$80
447
        DEFM    "VERIF"
448
        DEFB    'Y'+$80
449
        DEFM    "BEE"
450
        DEFB    'P'+$80
451
        DEFM    "CIRCL"
452
        DEFB    'E'+$80
453
        DEFM    "IN"
454
        DEFB    'K'+$80
455
        DEFM    "PAPE"
456
        DEFB    'R'+$80
457
        DEFM    "FLAS"
458
        DEFB    'H'+$80
459
        DEFM    "BRIGH"
460
        DEFB    'T'+$80
461
        DEFM    "INVERS"
462
        DEFB    'E'+$80
463
        DEFM    "OVE"
464
        DEFB    'R'+$80
465
        DEFM    "OU"
466
        DEFB    'T'+$80
467
        DEFM    "LPRIN"
468
        DEFB    'T'+$80
469
        DEFM    "LLIS"
470
        DEFB    'T'+$80
471
        DEFM    "STO"
472
        DEFB    'P'+$80
473
        DEFM    "REA"
474
        DEFB    'D'+$80
475
        DEFM    "DAT"
476
        DEFB    'A'+$80
477
        DEFM    "RESTOR"
478
        DEFB    'E'+$80
479
        DEFM    "NE"
480
        DEFB    'W'+$80
481
        DEFM    "BORDE"
482
        DEFB    'R'+$80
483
        DEFM    "CONTINU"
484
        DEFB    'E'+$80
485
        DEFM    "DI"
486
        DEFB    'M'+$80
487
        DEFM    "RE"
488
        DEFB    'M'+$80
489
        DEFM    "FO"
490
        DEFB    'R'+$80
491
        DEFM    "GO T"
492
        DEFB    'O'+$80
493
        DEFM    "GO SU"
494
        DEFB    'B'+$80
495
        DEFM    "INPU"
496
        DEFB    'T'+$80
497
        DEFM    "LOA"
498
        DEFB    'D'+$80
499
        DEFM    "LIS"
500
        DEFB    'T'+$80
501
        DEFM    "LE"
502
        DEFB    'T'+$80
503
        DEFM    "PAUS"
504
        DEFB    'E'+$80
505
        DEFM    "NEX"
506
        DEFB    'T'+$80
507
        DEFM    "POK"
508
        DEFB    'E'+$80
509
        DEFM    "PRIN"
510
        DEFB    'T'+$80
511
        DEFM    "PLO"
512
        DEFB    'T'+$80
513
        DEFM    "RU"
514
        DEFB    'N'+$80
515
        DEFM    "SAV"
516
        DEFB    'E'+$80
517
        DEFM    "RANDOMIZ"
518
        DEFB    'E'+$80
519
        DEFB    'I','F'+$80
520
        DEFM    "CL"
521
        DEFB    'S'+$80
522
        DEFM    "DRA"
523
        DEFB    'W'+$80
524
        DEFM    "CLEA"
525
        DEFB    'R'+$80
526
        DEFM    "RETUR"
527
        DEFB    'N'+$80
528
        DEFM    "COP"
529
        DEFB    'Y'+$80
530
 
531
; ----------------
532
; THE 'KEY' TABLES
533
; ----------------
534
;   These six look-up tables are used by the keyboard reading routine
535
;   to decode the key values.
536
;
537
;   The first table contains the maps for the 39 keys of the standard
538
;   40-key Spectrum keyboard. The remaining key [SHIFT $27] is read directly.
539
;   The keys consist of the 26 upper-case alphabetic characters, the 10 digit
540
;   keys and the space, ENTER and symbol shift key.
541
;   Unshifted alphabetic keys have $20 added to the value.
542
;   The keywords for the main alphabetic keys are obtained by adding $A5 to
543
;   the values obtained from this table.
544
 
545
;; MAIN-KEYS
546
L0205:  DEFB    $42             ; B
547
        DEFB    $48             ; H
548
        DEFB    $59             ; Y
549
        DEFB    $36             ; 6
550
        DEFB    $35             ; 5
551
        DEFB    $54             ; T
552
        DEFB    $47             ; G
553
        DEFB    $56             ; V
554
        DEFB    $4E             ; N
555
        DEFB    $4A             ; J
556
        DEFB    $55             ; U
557
        DEFB    $37             ; 7
558
        DEFB    $34             ; 4
559
        DEFB    $52             ; R
560
        DEFB    $46             ; F
561
        DEFB    $43             ; C
562
        DEFB    $4D             ; M
563
        DEFB    $4B             ; K
564
        DEFB    $49             ; I
565
        DEFB    $38             ; 8
566
        DEFB    $33             ; 3
567
        DEFB    $45             ; E
568
        DEFB    $44             ; D
569
        DEFB    $58             ; X
570
        DEFB    $0E             ; SYMBOL SHIFT
571
        DEFB    $4C             ; L
572
        DEFB    $4F             ; O
573
        DEFB    $39             ; 9
574
        DEFB    $32             ; 2
575
        DEFB    $57             ; W
576
        DEFB    $53             ; S
577
        DEFB    $5A             ; Z
578
        DEFB    $20             ; SPACE
579
        DEFB    $0D             ; ENTER
580
        DEFB    $50             ; P
581
        DEFB    $30             ; 0
582
        DEFB    $31             ; 1
583
        DEFB    $51             ; Q
584
        DEFB    $41             ; A
585
 
586
 
587
;; E-UNSHIFT
588
;  The 26 unshifted extended mode keys for the alphabetic characters.
589
;  The green keywords on the original keyboard.
590
L022C:  DEFB    $E3             ; READ
591
        DEFB    $C4             ; BIN
592
        DEFB    $E0             ; LPRINT
593
        DEFB    $E4             ; DATA
594
        DEFB    $B4             ; TAN
595
        DEFB    $BC             ; SGN
596
        DEFB    $BD             ; ABS
597
        DEFB    $BB             ; SQR
598
        DEFB    $AF             ; CODE
599
        DEFB    $B0             ; VAL
600
        DEFB    $B1             ; LEN
601
        DEFB    $C0             ; USR
602
        DEFB    $A7             ; PI
603
        DEFB    $A6             ; INKEY$
604
        DEFB    $BE             ; PEEK
605
        DEFB    $AD             ; TAB
606
        DEFB    $B2             ; SIN
607
        DEFB    $BA             ; INT
608
        DEFB    $E5             ; RESTORE
609
        DEFB    $A5             ; RND
610
        DEFB    $C2             ; CHR$
611
        DEFB    $E1             ; LLIST
612
        DEFB    $B3             ; COS
613
        DEFB    $B9             ; EXP
614
        DEFB    $C1             ; STR$
615
        DEFB    $B8             ; LN
616
 
617
 
618
;; EXT-SHIFT
619
;  The 26 shifted extended mode keys for the alphabetic characters.
620
;  The red keywords below keys on the original keyboard.
621
L0246:  DEFB    $7E             ; ~
622
        DEFB    $DC             ; BRIGHT
623
        DEFB    $DA             ; PAPER
624
        DEFB    $5C             ; \
625
        DEFB    $B7             ; ATN
626
        DEFB    $7B             ; {
627
        DEFB    $7D             ; }
628
        DEFB    $D8             ; CIRCLE
629
        DEFB    $BF             ; IN
630
        DEFB    $AE             ; VAL$
631
        DEFB    $AA             ; SCREEN$
632
        DEFB    $AB             ; ATTR
633
        DEFB    $DD             ; INVERSE
634
        DEFB    $DE             ; OVER
635
        DEFB    $DF             ; OUT
636
        DEFB    $7F             ; (Copyright character)
637
        DEFB    $B5             ; ASN
638
        DEFB    $D6             ; VERIFY
639
        DEFB    $7C             ; |
640
        DEFB    $D5             ; MERGE
641
        DEFB    $5D             ; ]
642
        DEFB    $DB             ; FLASH
643
        DEFB    $B6             ; ACS
644
        DEFB    $D9             ; INK
645
        DEFB    $5B             ; [
646
        DEFB    $D7             ; BEEP
647
 
648
 
649
;; CTL-CODES
650
;  The ten control codes assigned to the top line of digits when the shift
651
;  key is pressed.
652
L0260:  DEFB    $0C             ; DELETE
653
        DEFB    $07             ; EDIT
654
        DEFB    $06             ; CAPS LOCK
655
        DEFB    $04             ; TRUE VIDEO
656
        DEFB    $05             ; INVERSE VIDEO
657
        DEFB    $08             ; CURSOR LEFT
658
        DEFB    $0A             ; CURSOR DOWN
659
        DEFB    $0B             ; CURSOR UP
660
        DEFB    $09             ; CURSOR RIGHT
661
        DEFB    $0F             ; GRAPHICS
662
 
663
 
664
;; SYM-CODES
665
;  The 26 red symbols assigned to the alphabetic characters of the keyboard.
666
;  The ten single-character digit symbols are converted without the aid of
667
;  a table using subtraction and minor manipulation.
668
L026A:  DEFB    $E2             ; STOP
669
        DEFB    $2A             ; *
670
        DEFB    $3F             ; ?
671
        DEFB    $CD             ; STEP
672
        DEFB    $C8             ; >=
673
        DEFB    $CC             ; TO
674
        DEFB    $CB             ; THEN
675
        DEFB    $5E             ; ^
676
        DEFB    $AC             ; AT
677
        DEFB    $2D             ; -
678
        DEFB    $2B             ; +
679
        DEFB    $3D             ; =
680
        DEFB    $2E             ; .
681
        DEFB    $2C             ; ,
682
        DEFB    $3B             ; ;
683
        DEFB    $22             ; "
684
        DEFB    $C7             ; <=
685
        DEFB    $3C             ; <
686
        DEFB    $C3             ; NOT
687
        DEFB    $3E             ; >
688
        DEFB    $C5             ; OR
689
        DEFB    $2F             ; /
690
        DEFB    $C9             ; <>
691
        DEFB    $60             ; pound
692
        DEFB    $C6             ; AND
693
        DEFB    $3A             ; :
694
 
695
;; E-DIGITS
696
;  The ten keywords assigned to the digits in extended mode.
697
;  The remaining red keywords below the keys.
698
L0284:  DEFB    $D0             ; FORMAT
699
        DEFB    $CE             ; DEF FN
700
        DEFB    $A8             ; FN
701
        DEFB    $CA             ; LINE
702
        DEFB    $D3             ; OPEN #
703
        DEFB    $D4             ; CLOSE #
704
        DEFB    $D1             ; MOVE
705
        DEFB    $D2             ; ERASE
706
        DEFB    $A9             ; POINT
707
        DEFB    $CF             ; CAT
708
 
709
 
710
;*******************************
711
;** Part 2. KEYBOARD ROUTINES **
712
;*******************************
713
 
714
;   Using shift keys and a combination of modes the Spectrum 40-key keyboard
715
;   can be mapped to 256 input characters
716
 
717
; ---------------------------------------------------------------------------
718
;
719
;         0     1     2     3     4 -Bits-  4     3     2     1     0
720
; PORT                                                                    PORT
721
;
722
; F7FE  [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ]  |  [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 0 ]   EFFE
723
;  ^                                   |                                   v
724
; FBFE  [ Q ] [ W ] [ E ] [ R ] [ T ]  |  [ Y ] [ U ] [ I ] [ O ] [ P ]   DFFE
725
;  ^                                   |                                   v
726
; FDFE  [ A ] [ S ] [ D ] [ F ] [ G ]  |  [ H ] [ J ] [ K ] [ L ] [ ENT ] BFFE
727
;  ^                                   |                                   v
728
; FEFE  [SHI] [ Z ] [ X ] [ C ] [ V ]  |  [ B ] [ N ] [ M ] [sym] [ SPC ] 7FFE
729
;  ^     $27                                                 $18           v
730
; Start                                                                   End
731
;        00100111                                            00011000
732
;
733
; ---------------------------------------------------------------------------
734
;   The above map may help in reading.
735
;   The neat arrangement of ports means that the B register need only be
736
;   rotated left to work up the left hand side and then down the right
737
;   hand side of the keyboard. When the reset bit drops into the carry
738
;   then all 8 half-rows have been read. Shift is the first key to be
739
;   read. The lower six bits of the shifts are unambiguous.
740
 
741
; -------------------------------
742
; THE 'KEYBOARD SCANNING' ROUTINE
743
; -------------------------------
744
;   From keyboard and s-inkey$
745
;   Returns 1 or 2 keys in DE, most significant shift first if any
746
;   key values 0-39 else 255
747
 
748
;; KEY-SCAN
749
L028E:  LD      L,$2F           ; initial key value
750
                                ; valid values are obtained by subtracting
751
                                ; eight five times.
752
        LD      DE,$FFFF        ; a buffer to receive 2 keys.
753
 
754
        LD      BC,$FEFE        ; the commencing port address
755
                                ; B holds 11111110 initially and is also
756
                                ; used to count the 8 half-rows
757
;; KEY-LINE
758
L0296:  IN      A,(C)           ; read the port to A - bits will be reset
759
                                ; if a key is pressed else set.
760
        CPL                     ; complement - pressed key-bits are now set
761
        AND     $1F             ; apply 00011111 mask to pick up the
762
                                ; relevant set bits.
763
 
764
        JR      Z,L02AB         ; forward to KEY-DONE if zero and therefore
765
                                ; no keys pressed in row at all.
766
 
767
        LD      H,A             ; transfer row bits to H
768
        LD      A,L             ; load the initial key value to A
769
 
770
;; KEY-3KEYS
771
L029F:  INC     D               ; now test the key buffer
772
        RET     NZ              ; if we have collected 2 keys already
773
                                ; then too many so quit.
774
 
775
;; KEY-BITS
776
L02A1:  SUB     $08             ; subtract 8 from the key value
777
                                ; cycling through key values (top = $27)
778
                                ; e.g. 2F>   27>1F>17>0F>07
779
                                ;      2E>   26>1E>16>0E>06
780
        SRL     H               ; shift key bits right into carry.
781
        JR      NC,L02A1        ; back to KEY-BITS if not pressed
782
                                ; but if pressed we have a value (0-39d)
783
 
784
        LD      D,E             ; transfer a possible previous key to D
785
        LD      E,A             ; transfer the new key to E
786
        JR      NZ,L029F        ; back to KEY-3KEYS if there were more
787
                                ; set bits - H was not yet zero.
788
 
789
;; KEY-DONE
790
L02AB:  DEC     L               ; cycles 2F>2E>2D>2C>2B>2A>29>28 for
791
                                ; each half-row.
792
        RLC     B               ; form next port address e.g. FEFE > FDFE
793
        JR      C,L0296         ; back to KEY-LINE if still more rows to do.
794
 
795
        LD      A,D             ; now test if D is still FF ?
796
        INC     A               ; if it is zero we have at most 1 key
797
                                ; range now $01-$28  (1-40d)
798
        RET     Z               ; return if one key or no key.
799
 
800
        CP      $28             ; is it capsshift (was $27) ?
801
        RET     Z               ; return if so.
802
 
803
        CP      $19             ; is it symbol shift (was $18) ?
804
        RET     Z               ; return also
805
 
806
        LD      A,E             ; now test E
807
        LD      E,D             ; but first switch
808
        LD      D,A             ; the two keys.
809
        CP      $18             ; is it symbol shift ?
810
        RET                     ; return (with zero set if it was).
811
                                ; but with symbol shift now in D
812
 
813
; ----------------------
814
; THE 'KEYBOARD' ROUTINE
815
; ----------------------
816
;   Called from the interrupt 50 times a second.
817
;
818
 
819
;; KEYBOARD
820
L02BF:  CALL    L028E           ; routine KEY-SCAN
821
        RET     NZ              ; return if invalid combinations
822
 
823
;   then decrease the counters within the two key-state maps
824
;   as this could cause one to become free.
825
;   if the keyboard has not been pressed during the last five interrupts
826
;   then both sets will be free.
827
 
828
 
829
        LD      HL,$5C00        ; point to KSTATE-0
830
 
831
;; K-ST-LOOP
832
L02C6:  BIT     7,(HL)          ; is it free ?  (i.e. $FF)
833
        JR      NZ,L02D1        ; forward to K-CH-SET if so
834
 
835
        INC     HL              ; address the 5-counter
836
        DEC     (HL)            ; decrease the counter
837
        DEC     HL              ; step back
838
 
839
        JR      NZ,L02D1        ; forward to K-CH-SET if not at end of count
840
 
841
        LD      (HL),$FF        ; else mark this particular map free.
842
 
843
;; K-CH-SET
844
L02D1:  LD      A,L             ; make a copy of the low address byte.
845
        LD      HL,$5C04        ; point to KSTATE-4
846
                                ; (ld l,$04 would do)
847
        CP      L               ; have both sets been considered ?
848
        JR      NZ,L02C6        ; back to K-ST-LOOP to consider this 2nd set
849
 
850
;   now the raw key (0-38d) is converted to a main key (uppercase).
851
 
852
        CALL    L031E           ; routine K-TEST to get main key in A
853
 
854
        RET     NC              ; return if just a single shift
855
 
856
        LD      HL,$5C00        ; point to KSTATE-0
857
        CP      (HL)            ; does the main key code match ?
858
        JR      Z,L0310         ; forward to K-REPEAT if so
859
 
860
;   if not consider the second key map.
861
 
862
        EX      DE,HL           ; save kstate-0 in de
863
        LD      HL,$5C04        ; point to KSTATE-4
864
        CP      (HL)            ; does the main key code match ?
865
        JR      Z,L0310         ; forward to K-REPEAT if so
866
 
867
;   having excluded a repeating key we can now consider a new key.
868
;   the second set is always examined before the first.
869
 
870
        BIT     7,(HL)          ; is the key map free ?
871
        JR      NZ,L02F1        ; forward to K-NEW if so.
872
 
873
        EX      DE,HL           ; bring back KSTATE-0
874
        BIT     7,(HL)          ; is it free ?
875
        RET     Z               ; return if not.
876
                                ; as we have a key but nowhere to put it yet.
877
 
878
;   continue or jump to here if one of the buffers was free.
879
 
880
;; K-NEW
881
L02F1:  LD      E,A             ; store key in E
882
        LD      (HL),A          ; place in free location
883
        INC     HL              ; advance to the interrupt counter
884
        LD      (HL),$05        ; and initialize counter to 5
885
        INC     HL              ; advance to the delay
886
        LD      A,($5C09)       ; pick up the system variable REPDEL
887
        LD      (HL),A          ; and insert that for first repeat delay.
888
        INC     HL              ; advance to last location of state map.
889
 
890
        LD      C,(IY+$07)      ; pick up MODE  (3 bytes)
891
        LD      D,(IY+$01)      ; pick up FLAGS (3 bytes)
892
        PUSH    HL              ; save state map location
893
                                ; Note. could now have used, to avoid IY,
894
                                ; ld l,$41; ld c,(hl); ld l,$3B; ld d,(hl).
895
                                ; six and two threes of course.
896
 
897
        CALL    L0333           ; routine K-DECODE
898
 
899
        POP     HL              ; restore map pointer
900
        LD      (HL),A          ; put the decoded key in last location of map.
901
 
902
;; K-END
903
L0308:  LD      ($5C08),A       ; update LASTK system variable.
904
        SET     5,(IY+$01)      ; update FLAGS  - signal a new key.
905
        RET                     ; return to interrupt routine.
906
 
907
; -----------------------
908
; THE 'REPEAT KEY' BRANCH
909
; -----------------------
910
;   A possible repeat has been identified. HL addresses the raw key.
911
;   The last location of the key map holds the decoded key from the first
912
;   context.  This could be a keyword and, with the exception of NOT a repeat
913
;   is syntactically incorrect and not really desirable.
914
 
915
;; K-REPEAT
916
L0310:  INC     HL              ; increment the map pointer to second location.
917
        LD      (HL),$05        ; maintain interrupt counter at 5.
918
        INC     HL              ; now point to third location.
919
        DEC     (HL)            ; decrease the REPDEL value which is used to
920
                                ; time the delay of a repeat key.
921
 
922
        RET     NZ              ; return if not yet zero.
923
 
924
        LD      A,($5C0A)       ; fetch the system variable value REPPER.
925
        LD      (HL),A          ; for subsequent repeats REPPER will be used.
926
 
927
        INC     HL              ; advance
928
                                ;
929
        LD      A,(HL)          ; pick up the key decoded possibly in another
930
                                ; context.
931
                                ; Note. should compare with $A5 (RND) and make
932
                                ; a simple return if this is a keyword.
933
                                ; e.g. cp $a5; ret nc; (3 extra bytes)
934
        JR      L0308           ; back to K-END
935
 
936
; ----------------------
937
; THE 'KEY-TEST' ROUTINE
938
; ----------------------
939
;   also called from s-inkey$
940
;   begin by testing for a shift with no other.
941
 
942
;; K-TEST
943
L031E:  LD      B,D             ; load most significant key to B
944
                                ; will be $FF if not shift.
945
        LD      D,$00           ; and reset D to index into main table
946
        LD      A,E             ; load least significant key from E
947
        CP      $27             ; is it higher than 39d   i.e. FF
948
        RET     NC              ; return with just a shift (in B now)
949
 
950
        CP      $18             ; is it symbol shift ?
951
        JR      NZ,L032C        ; forward to K-MAIN if not
952
 
953
;   but we could have just symbol shift and no other
954
 
955
        BIT     7,B             ; is other key $FF (ie not shift)
956
        RET     NZ              ; return with solitary symbol shift
957
 
958
 
959
;; K-MAIN
960
L032C:  LD      HL,L0205        ; address: MAIN-KEYS
961
        ADD     HL,DE           ; add offset 0-38
962
        LD      A,(HL)          ; pick up main key value
963
        SCF                     ; set carry flag
964
        RET                     ; return    (B has other key still)
965
 
966
; ----------------------------------
967
; THE 'KEYBOARD DECODING' SUBROUTINE
968
; ----------------------------------
969
;   also called from s-inkey$
970
 
971
;; K-DECODE
972
L0333:  LD      A,E             ; pick up the stored main key
973
        CP      $3A             ; an arbitrary point between digits and letters
974
        JR      C,L0367         ; forward to K-DIGIT with digits, space, enter.
975
 
976
        DEC     C               ; decrease MODE ( 0='KLC', 1='E', 2='G')
977
 
978
        JP      M,L034F         ; to K-KLC-LET if was zero
979
 
980
        JR      Z,L0341         ; to K-E-LET if was 1 for extended letters.
981
 
982
;   proceed with graphic codes.
983
;   Note. should selectively drop return address if code > 'U' ($55).
984
;   i.e. abort the KEYBOARD call.
985
;   e.g. cp 'V'; jr c,addit; pop af ;pop af ;;addit etc. (6 extra bytes).
986
;   (s-inkey$ never gets into graphics mode.)
987
 
988
;; addit
989
        ADD     A,$4F           ; add offset to augment 'A' to graphics A say.
990
        RET                     ; return.
991
                                ; Note. ( but [GRAPH] V gives RND, etc ).
992
 
993
; ---
994
 
995
;   the jump was to here with extended mode with uppercase A-Z.
996
 
997
;; K-E-LET
998
L0341:  LD      HL,L022C-$41    ; base address of E-UNSHIFT L022c.
999
                                ; ( $01EB in standard ROM ).
1000
        INC     B               ; test B is it empty i.e. not a shift.
1001
        JR      Z,L034A         ; forward to K-LOOK-UP if neither shift.
1002
 
1003
        LD      HL,L0246-$41    ; Address: $0205 L0246-$41 EXT-SHIFT base
1004
 
1005
;; K-LOOK-UP
1006
L034A:  LD      D,$00           ; prepare to index.
1007
        ADD     HL,DE           ; add the main key value.
1008
        LD      A,(HL)          ; pick up other mode value.
1009
        RET                     ; return.
1010
 
1011
; ---
1012
 
1013
;   the jump was here with mode = 0
1014
 
1015
;; K-KLC-LET
1016
L034F:  LD      HL,L026A-$41    ; prepare base of sym-codes
1017
        BIT     0,B             ; shift=$27 sym-shift=$18
1018
        JR      Z,L034A         ; back to K-LOOK-UP with symbol-shift
1019
 
1020
        BIT     3,D             ; test FLAGS is it 'K' mode (from OUT-CURS)
1021
        JR      Z,L0364         ; skip to K-TOKENS if so
1022
 
1023
        BIT     3,(IY+$30)      ; test FLAGS2 - consider CAPS LOCK ?
1024
        RET     NZ              ; return if so with main code.
1025
 
1026
        INC     B               ; is shift being pressed ?
1027
                                ; result zero if not
1028
        RET     NZ              ; return if shift pressed.
1029
 
1030
        ADD     A,$20           ; else convert the code to lower case.
1031
        RET                     ; return.
1032
 
1033
; ---
1034
 
1035
;   the jump was here for tokens
1036
 
1037
;; K-TOKENS
1038
L0364:  ADD     A,$A5           ; add offset to main code so that 'A'
1039
                                ; becomes 'NEW' etc.
1040
 
1041
        RET                     ; return.
1042
 
1043
; ---
1044
 
1045
;   the jump was here with digits, space, enter and symbol shift (< $xx)
1046
 
1047
;; K-DIGIT
1048
L0367:  CP      $30             ; is it '0' or higher ?
1049
        RET     C               ; return with space, enter and symbol-shift
1050
 
1051
        DEC     C               ; test MODE (was 0='KLC', 1='E', 2='G')
1052
        JP      M,L039D         ; jump to K-KLC-DGT if was 0.
1053
 
1054
        JR      NZ,L0389        ; forward to K-GRA-DGT if mode was 2.
1055
 
1056
;   continue with extended digits 0-9.
1057
 
1058
        LD      HL,L0284-$30    ; $0254 - base of E-DIGITS
1059
        BIT     5,B             ; test - shift=$27 sym-shift=$18
1060
        JR      Z,L034A         ; to K-LOOK-UP if sym-shift
1061
 
1062
        CP      $38             ; is character '8' ?
1063
        JR      NC,L0382        ; to K-8-&-9 if greater than '7'
1064
 
1065
        SUB     $20             ; reduce to ink range $10-$17
1066
        INC     B               ; shift ?
1067
        RET     Z               ; return if not.
1068
 
1069
        ADD     A,$08           ; add 8 to give paper range $18 - $1F
1070
        RET                     ; return
1071
 
1072
; ---
1073
 
1074
;   89
1075
 
1076
;; K-8-&-9
1077
L0382:  SUB     $36             ; reduce to 02 and 03  bright codes
1078
        INC     B               ; test if shift pressed.
1079
        RET     Z               ; return if not.
1080
 
1081
        ADD     A,$FE           ; subtract 2 setting carry
1082
        RET                     ; to give 0 and 1    flash codes.
1083
 
1084
; ---
1085
 
1086
;   graphics mode with digits
1087
 
1088
;; K-GRA-DGT
1089
L0389:  LD      HL,L0260-$30    ; $0230 base address of CTL-CODES
1090
 
1091
        CP      $39             ; is key '9' ?
1092
        JR      Z,L034A         ; back to K-LOOK-UP - changed to $0F, GRAPHICS.
1093
 
1094
        CP      $30             ; is key '0' ?
1095
        JR      Z,L034A         ; back to K-LOOK-UP - changed to $0C, delete.
1096
 
1097
;   for keys '0' - '7' we assign a mosaic character depending on shift.
1098
 
1099
        AND     $07             ; convert character to number. 0 - 7.
1100
        ADD     A,$80           ; add offset - they start at $80
1101
 
1102
        INC     B               ; destructively test for shift
1103
        RET     Z               ; and return if not pressed.
1104
 
1105
        XOR     $0F             ; toggle bits becomes range $88-$8F
1106
        RET                     ; return.
1107
 
1108
; ---
1109
 
1110
;   now digits in 'KLC' mode
1111
 
1112
;; K-KLC-DGT
1113
L039D:  INC     B               ; return with digit codes if neither
1114
        RET     Z               ; shift key pressed.
1115
 
1116
        BIT     5,B             ; test for caps shift.
1117
 
1118
        LD      HL,L0260-$30    ; prepare base of table CTL-CODES.
1119
        JR      NZ,L034A        ; back to K-LOOK-UP if shift pressed.
1120
 
1121
;   must have been symbol shift
1122
 
1123
        SUB     $10             ; for ASCII most will now be correct
1124
                                ; on a standard typewriter.
1125
 
1126
        CP      $22             ; but '@' is not - see below.
1127
        JR      Z,L03B2         ; forward to K-@-CHAR if so
1128
 
1129
        CP      $20             ; '_' is the other one that fails
1130
        RET     NZ              ; return if not.
1131
 
1132
        LD      A,$5F           ; substitute ASCII '_'
1133
        RET                     ; return.
1134
 
1135
; ---
1136
 
1137
;; K-@-CHAR
1138
L03B2:  LD      A,$40           ; substitute ASCII '@'
1139
        RET                     ; return.
1140
 
1141
 
1142
; ------------------------------------------------------------------------
1143
;   The Spectrum Input character keys. One or two are abbreviated.
1144
;   From $00 Flash 0 to $FF COPY. The routine above has decoded all these.
1145
 
1146
;  | 00 Fl0| 01 Fl1| 02 Br0| 03 Br1| 04 In0| 05 In1| 06 CAP| 07 EDT|
1147
;  | 08 LFT| 09 RIG| 0A DWN| 0B UP | 0C DEL| 0D ENT| 0E SYM| 0F GRA|
1148
;  | 10 Ik0| 11 Ik1| 12 Ik2| 13 Ik3| 14 Ik4| 15 Ik5| 16 Ik6| 17 Ik7|
1149
;  | 18 Pa0| 19 Pa1| 1A Pa2| 1B Pa3| 1C Pa4| 1D Pa5| 1E Pa6| 1F Pa7|
1150
;  | 20 SP | 21  ! | 22  " | 23  # | 24  $ | 25  % | 26  & | 27  ' |
1151
;  | 28  ( | 29  ) | 2A  * | 2B  + | 2C  , | 2D  - | 2E  . | 2F  / |
1152
;  | 30  0 | 31  1 | 32  2 | 33  3 | 34  4 | 35  5 | 36  6 | 37  7 |
1153
;  | 38  8 | 39  9 | 3A  : | 3B  ; | 3C  < | 3D  = | 3E  > | 3F  ? |
1154
;  | 40  @ | 41  A | 42  B | 43  C | 44  D | 45  E | 46  F | 47  G |
1155
;  | 48  H | 49  I | 4A  J | 4B  K | 4C  L | 4D  M | 4E  N | 4F  O |
1156
;  | 50  P | 51  Q | 52  R | 53  S | 54  T | 55  U | 56  V | 57  W |
1157
;  | 58  X | 59  Y | 5A  Z | 5B  [ | 5C  \ | 5D  ] | 5E  ^ | 5F  _ |
1158
;  | 60  £ | 61  a | 62  b | 63  c | 64  d | 65  e | 66  f | 67  g |
1159
;  | 68  h | 69  i | 6A  j | 6B  k | 6C  l | 6D  m | 6E  n | 6F  o |
1160
;  | 70  p | 71  q | 72  r | 73  s | 74  t | 75  u | 76  v | 77  w |
1161
;  | 78  x | 79  y | 7A  z | 7B  { | 7C  | | 7D  } | 7E  ~ | 7F  © |
1162
;  | 80 128| 81 129| 82 130| 83 131| 84 132| 85 133| 86 134| 87 135|
1163
;  | 88 136| 89 137| 8A 138| 8B 139| 8C 140| 8D 141| 8E 142| 8F 143|
1164
;  | 90 [A]| 91 [B]| 92 [C]| 93 [D]| 94 [E]| 95 [F]| 96 [G]| 97 [H]|
1165
;  | 98 [I]| 99 [J]| 9A [K]| 9B [L]| 9C [M]| 9D [N]| 9E [O]| 9F [P]|
1166
;  | A0 [Q]| A1 [R]| A2 [S]| A3 [T]| A4 [U]| A5 RND| A6 IK$| A7 PI |
1167
;  | A8 FN | A9 PNT| AA SC$| AB ATT| AC AT | AD TAB| AE VL$| AF COD|
1168
;  | B0 VAL| B1 LEN| B2 SIN| B3 COS| B4 TAN| B5 ASN| B6 ACS| B7 ATN|
1169
;  | B8 LN | B9 EXP| BA INT| BB SQR| BC SGN| BD ABS| BE PEK| BF IN |
1170
;  | C0 USR| C1 ST$| C2 CH$| C3 NOT| C4 BIN| C5 OR | C6 AND| C7 <= |
1171
;  | C8 >= | C9 <> | CA LIN| CB THN| CC TO | CD STP| CE DEF| CF CAT|
1172
;  | D0 FMT| D1 MOV| D2 ERS| D3 OPN| D4 CLO| D5 MRG| D6 VFY| D7 BEP|
1173
;  | D8 CIR| D9 INK| DA PAP| DB FLA| DC BRI| DD INV| DE OVR| DF OUT|
1174
;  | E0 LPR| E1 LLI| E2 STP| E3 REA| E4 DAT| E5 RES| E6 NEW| E7 BDR|
1175
;  | E8 CON| E9 DIM| EA REM| EB FOR| EC GTO| ED GSB| EE INP| EF LOA|
1176
;  | F0 LIS| F1 LET| F2 PAU| F3 NXT| F4 POK| F5 PRI| F6 PLO| F7 RUN|
1177
;  | F8 SAV| F9 RAN| FA IF | FB CLS| FC DRW| FD CLR| FE RET| FF CPY|
1178
 
1179
;   Note that for simplicity, Sinclair have located all the control codes
1180
;   below the space character.
1181
;   ASCII DEL, $7F, has been made a copyright symbol.
1182
;   Also $60, '`', not used in BASIC but used in other languages, has been
1183
;   allocated the local currency symbol for the relevant country -
1184
;    £  in most Spectrums.
1185
 
1186
; ------------------------------------------------------------------------
1187
 
1188
 
1189
;**********************************
1190
;** Part 3. LOUDSPEAKER ROUTINES **
1191
;**********************************
1192
 
1193
; Documented by Alvin Albrecht.
1194
 
1195
; ------------------------------
1196
; Routine to control loudspeaker
1197
; ------------------------------
1198
; Outputs a square wave of given duration and frequency
1199
; to the loudspeaker.
1200
;   Enter with: DE = #cycles - 1
1201
;               HL = tone period as described next
1202
;
1203
; The tone period is measured in T states and consists of
1204
; three parts: a coarse part (H register), a medium part
1205
; (bits 7..2 of L) and a fine part (bits 1..0 of L) which
1206
; contribute to the waveform timing as follows:
1207
;
1208
;                          coarse    medium       fine
1209
; duration of low  = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3)
1210
; duration of hi   = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3)
1211
; Tp = tone period = 236 + 2048*H + 32*(L>>2) + 8*(L&0x3)
1212
;                  = 236 + 2048*H + 8*L = 236 + 8*HL
1213
;
1214
; As an example, to output five seconds of middle C (261.624 Hz):
1215
;   (a) Tone period = 1/261.624 = 3.822ms
1216
;   (b) Tone period in T-States = 3.822ms*fCPU = 13378
1217
;         where fCPU = clock frequency of the CPU = 3.5MHz
1218
;    ©  Find H and L for desired tone period:
1219
;         HL = (Tp - 236) / 8 = (13378 - 236) / 8 = 1643 = 0x066B
1220
;   (d) Tone duration in cycles = 5s/3.822ms = 1308 cycles
1221
;         DE = 1308 - 1 = 0x051B
1222
;
1223
; The resulting waveform has a duty ratio of exactly 50%.
1224
;
1225
;
1226
;; BEEPER
1227
L03B5:  DI                      ; Disable Interrupts so they don't disturb timing
1228
        LD      A,L             ;
1229
        SRL     L               ;
1230
        SRL     L               ; L = medium part of tone period
1231
        CPL                     ;
1232
        AND     $03             ; A = 3 - fine part of tone period
1233
        LD      C,A             ;
1234
        LD      B,$00           ;
1235
        LD      IX,L03D1        ; Address: BE-IX+3
1236
        ADD     IX,BC           ;   IX holds address of entry into the loop
1237
                                ;   the loop will contain 0-3 NOPs, implementing
1238
                                ;   the fine part of the tone period.
1239
        LD      A,($5C48)       ; BORDCR
1240
        AND     $38             ; bits 5..3 contain border colour
1241
        RRCA                    ; border colour bits moved to 2..0
1242
        RRCA                    ;   to match border bits on port #FE
1243
        RRCA                    ;
1244
        OR       $08            ; bit 3 set (tape output bit on port #FE)
1245
                                ;   for loud sound output
1246
;; BE-IX+3
1247
L03D1:  NOP              ;(4)   ; optionally executed NOPs for small
1248
                                ;   adjustments to tone period
1249
;; BE-IX+2
1250
L03D2:  NOP              ;(4)   ;
1251
 
1252
;; BE-IX+1
1253
L03D3:  NOP              ;(4)   ;
1254
 
1255
;; BE-IX+0
1256
L03D4:  INC     B        ;(4)   ;
1257
        INC     C        ;(4)   ;
1258
 
1259
;; BE-H&L-LP
1260
L03D6:  DEC     C        ;(4)   ; timing loop for duration of
1261
        JR      NZ,L03D6 ;(12/7);   high or low pulse of waveform
1262
 
1263
        LD      C,$3F    ;(7)   ;
1264
        DEC     B        ;(4)   ;
1265
        JP      NZ,L03D6 ;(10)  ; to BE-H&L-LP
1266
 
1267
        XOR     $10      ;(7)   ; toggle output beep bit
1268
        OUT     ($FE),A  ;(11)  ; output pulse
1269
        LD      B,H      ;(4)   ; B = coarse part of tone period
1270
        LD      C,A      ;(4)   ; save port #FE output byte
1271
        BIT     4,A      ;(8)   ; if new output bit is high, go
1272
        JR      NZ,L03F2 ;(12/7);   to BE-AGAIN
1273
 
1274
        LD      A,D      ;(4)   ; one cycle of waveform has completed
1275
        OR      E        ;(4)   ;   (low->low). if cycle countdown = 0
1276
        JR      Z,L03F6  ;(12/7);   go to BE-END
1277
 
1278
        LD      A,C      ;(4)   ; restore output byte for port #FE
1279
        LD      C,L      ;(4)   ; C = medium part of tone period
1280
        DEC     DE       ;(6)   ; decrement cycle count
1281
        JP      (IX)     ;(8)   ; do another cycle
1282
 
1283
;; BE-AGAIN                     ; halfway through cycle
1284
L03F2:  LD      C,L      ;(4)   ; C = medium part of tone period
1285
        INC     C        ;(4)   ; adds 16 cycles to make duration of high = duration of low
1286
        JP      (IX)     ;(8)   ; do high pulse of tone
1287
 
1288
;; BE-END
1289
L03F6:  EI                      ; Enable Interrupts
1290
        RET                     ;
1291
 
1292
 
1293
; ------------------
1294
; THE 'BEEP' COMMAND
1295
; ------------------
1296
; BASIC interface to BEEPER subroutine.
1297
; Invoked in BASIC with:
1298
;   BEEP dur, pitch
1299
;   where dur   = duration in seconds
1300
;         pitch = # of semitones above/below middle C
1301
;
1302
; Enter with: pitch on top of calculator stack
1303
;             duration next on calculator stack
1304
;
1305
;; beep
1306
L03F8:  RST     28H             ;; FP-CALC
1307
        DEFB    $31             ;;duplicate                  ; duplicate pitch
1308
        DEFB    $27             ;;int                        ; convert to integer
1309
        DEFB    $C0             ;;st-mem-0                   ; store integer pitch to memory 0
1310
        DEFB    $03             ;;subtract                   ; calculate fractional part of pitch = fp_pitch - int_pitch
1311
        DEFB    $34             ;;stk-data                   ; push constant
1312
        DEFB    $EC             ;;Exponent: $7C, Bytes: 4    ; constant = 0.05762265
1313
        DEFB    $6C,$98,$1F,$F5 ;;($6C,$98,$1F,$F5)
1314
        DEFB    $04             ;;multiply                   ; compute:
1315
        DEFB    $A1             ;;stk-one                    ; 1 + 0.05762265 * fraction_part(pitch)
1316
        DEFB    $0F             ;;addition
1317
        DEFB    $38             ;;end-calc                   ; leave on calc stack
1318
 
1319
        LD      HL,$5C92        ; MEM-0: number stored here is in 16 bit integer format (pitch)
1320
                                ;   0, 0/FF (pos/neg), LSB, MSB, 0
1321
                                ;   LSB/MSB is stored in two's complement
1322
                                ; In the following, the pitch is checked if it is in the range -128<=p<=127
1323
        LD      A,(HL)          ; First byte must be zero, otherwise
1324
        AND     A               ;   error in integer conversion
1325
        JR      NZ,L046C        ; to REPORT-B
1326
 
1327
        INC     HL              ;
1328
        LD      C,(HL)          ; C = pos/neg flag = 0/FF
1329
        INC     HL              ;
1330
        LD      B,(HL)          ; B = LSB, two's complement
1331
        LD      A,B             ;
1332
        RLA                     ;
1333
        SBC     A,A             ; A = 0/FF if B is pos/neg
1334
        CP      C               ; must be the same as C if the pitch is -128<=p<=127
1335
        JR      NZ,L046C        ; if no, error REPORT-B
1336
 
1337
        INC     HL              ; if -128<=p<=127, MSB will be 0/FF if B is pos/neg
1338
        CP      (HL)            ; verify this
1339
        JR      NZ,L046C        ; if no, error REPORT-B
1340
                                ; now we know -128<=p<=127
1341
        LD      A,B             ; A = pitch + 60
1342
        ADD     A,$3C           ; if -60<=pitch<=67,
1343
        JP      P,L0425         ;   goto BE-i-OK
1344
 
1345
        JP      PO,L046C        ; if pitch <= 67 goto REPORT-B
1346
                                ;   lower bound of pitch set at -60
1347
 
1348
;; BE-I-OK                      ; here, -60<=pitch<=127
1349
                                ; and A=pitch+60 -> 0<=A<=187
1350
 
1351
L0425:  LD      B,$FA           ; 6 octaves below middle C
1352
 
1353
;; BE-OCTAVE                    ; A=# semitones above 5 octaves below middle C
1354
L0427:  INC     B               ; increment octave
1355
        SUB     $0C             ; 12 semitones = one octave
1356
        JR      NC,L0427        ; to BE-OCTAVE
1357
 
1358
        ADD     A,$0C           ; A = # semitones above C (0-11)
1359
        PUSH    BC              ; B = octave displacement from middle C, 2's complement: -5<=B<=10
1360
        LD      HL,L046E        ; Address: semi-tone
1361
        CALL    L3406           ; routine LOC-MEM
1362
                                ;   HL = 5*A + $046E
1363
        CALL    L33B4           ; routine STACK-NUM
1364
                                ;   read FP value (freq) from semitone table (HL) and push onto calc stack
1365
 
1366
        RST     28H             ;; FP-CALC
1367
        DEFB    $04             ;;multiply   mult freq by 1 + 0.0576 * fraction_part(pitch) stacked earlier
1368
                                ;;             thus taking into account fractional part of pitch.
1369
                                ;;           the number 0.0576*frequency is the distance in Hz to the next
1370
                                ;;             note (verify with the frequencies recorded in the semitone
1371
                                ;;             table below) so that the fraction_part of the pitch does
1372
                                ;;             indeed represent a fractional distance to the next note.
1373
        DEFB    $38             ;;end-calc   HL points to first byte of fp num on stack = middle frequency to generate
1374
 
1375
        POP     AF              ; A = octave displacement from middle C, 2's complement: -5<=A<=10
1376
        ADD     A,(HL)          ; increase exponent by A (equivalent to multiplying by 2^A)
1377
        LD      (HL),A          ;
1378
 
1379
        RST     28H             ;; FP-CALC
1380
        DEFB    $C0             ;;st-mem-0          ; store frequency in memory 0
1381
        DEFB    $02             ;;delete            ; remove from calc stack
1382
        DEFB    $31             ;;duplicate         ; duplicate duration (seconds)
1383
        DEFB    $38             ;;end-calc
1384
 
1385
        CALL    L1E94           ; routine FIND-INT1 ; FP duration to A
1386
        CP      $0B             ; if dur > 10 seconds,
1387
        JR      NC,L046C        ;   goto REPORT-B
1388
 
1389
        ;;; The following calculation finds the tone period for HL and the cycle count
1390
        ;;; for DE expected in the BEEPER subroutine.  From the example in the BEEPER comments,
1391
        ;;;
1392
        ;;; HL = ((fCPU / f) - 236) / 8 = fCPU/8/f - 236/8 = 437500/f -29.5
1393
        ;;; DE = duration * frequency - 1
1394
        ;;;
1395
        ;;; Note the different constant (30.125) used in the calculation of HL
1396
        ;;; below.  This is probably an error.
1397
 
1398
        RST     28H             ;; FP-CALC
1399
        DEFB    $E0             ;;get-mem-0                 ; push frequency
1400
        DEFB    $04             ;;multiply                  ; result1: #cycles = duration * frequency
1401
        DEFB    $E0             ;;get-mem-0                 ; push frequency
1402
        DEFB    $34             ;;stk-data                  ; push constant
1403
        DEFB    $80             ;;Exponent $93, Bytes: 3    ; constant = 437500
1404
        DEFB    $43,$55,$9F,$80 ;;($55,$9F,$80,$00)
1405
        DEFB    $01             ;;exchange                  ; frequency on top
1406
        DEFB    $05             ;;division                  ; 437500 / frequency
1407
        DEFB    $34             ;;stk-data                  ; push constant
1408
        DEFB    $35             ;;Exponent: $85, Bytes: 1   ; constant = 30.125
1409
        DEFB    $71             ;;($71,$00,$00,$00)
1410
        DEFB    $03             ;;subtract                  ; result2: tone_period(HL) = 437500 / freq - 30.125
1411
        DEFB    $38             ;;end-calc
1412
 
1413
        CALL    L1E99           ; routine FIND-INT2
1414
        PUSH    BC              ;   BC = tone_period(HL)
1415
        CALL    L1E99           ; routine FIND-INT2, BC = #cycles to generate
1416
        POP     HL              ; HL = tone period
1417
        LD      D,B             ;
1418
        LD      E,C             ; DE = #cycles
1419
        LD      A,D             ;
1420
        OR      E               ;
1421
        RET     Z               ; if duration = 0, skip BEEP and avoid 65536 cycle
1422
                                ;   boondoggle that would occur next
1423
        DEC     DE              ; DE = #cycles - 1
1424
        JP      L03B5           ; to BEEPER
1425
 
1426
; ---
1427
 
1428
 
1429
;; REPORT-B
1430
L046C:  RST     08H             ; ERROR-1
1431
        DEFB    $0A             ; Error Report: Integer out of range
1432
 
1433
 
1434
 
1435
; ---------------------
1436
; THE 'SEMI-TONE' TABLE
1437
; ---------------------
1438
;
1439
;   Holds frequencies corresponding to semitones in middle octave.
1440
;   To move n octaves higher or lower, frequencies are multiplied by 2^n.
1441
 
1442
;; semi-tone         five byte fp         decimal freq     note (middle)
1443
L046E:  DEFB    $89, $02, $D0, $12, $86;  261.625565290         C
1444
        DEFB    $89, $0A, $97, $60, $75;  277.182631135         C#
1445
        DEFB    $89, $12, $D5, $17, $1F;  293.664768100         D
1446
        DEFB    $89, $1B, $90, $41, $02;  311.126983881         D#
1447
        DEFB    $89, $24, $D0, $53, $CA;  329.627557039         E
1448
        DEFB    $89, $2E, $9D, $36, $B1;  349.228231549         F
1449
        DEFB    $89, $38, $FF, $49, $3E;  369.994422674         F#
1450
        DEFB    $89, $43, $FF, $6A, $73;  391.995436072         G
1451
        DEFB    $89, $4F, $A7, $00, $54;  415.304697513         G#
1452
        DEFB    $89, $5C, $00, $00, $00;  440.000000000         A
1453
        DEFB    $89, $69, $14, $F6, $24;  466.163761616         A#
1454
        DEFB    $89, $76, $F1, $10, $05;  493.883301378         B
1455
 
1456
 
1457
;   "Music is the hidden mathematical endeavour of a soul unconscious it
1458
;    is calculating" - Gottfried Wilhelm Liebnitz 1646 - 1716
1459
 
1460
 
1461
;****************************************
1462
;** Part 4. CASSETTE HANDLING ROUTINES **
1463
;****************************************
1464
 
1465
;   These routines begin with the service routines followed by a single
1466
;   command entry point.
1467
;   The first of these service routines is a curiosity.
1468
 
1469
; -----------------------
1470
; THE 'ZX81 NAME' ROUTINE
1471
; -----------------------
1472
;   This routine fetches a filename in ZX81 format and is not used by the
1473
;   cassette handling routines in this ROM.
1474
 
1475
;; zx81-name
1476
L04AA:  CALL    L24FB           ; routine SCANNING to evaluate expression.
1477
        LD      A,($5C3B)       ; fetch system variable FLAGS.
1478
        ADD     A,A             ; test bit 7 - syntax, bit 6 - result type.
1479
        JP      M,L1C8A         ; to REPORT-C if not string result
1480
                                ; 'Nonsense in BASIC'.
1481
 
1482
        POP     HL              ; drop return address.
1483
        RET     NC              ; return early if checking syntax.
1484
 
1485
        PUSH    HL              ; re-save return address.
1486
        CALL    L2BF1           ; routine STK-FETCH fetches string parameters.
1487
        LD      H,D             ; transfer start of filename
1488
        LD      L,E             ; to the HL register.
1489
        DEC     C               ; adjust to point to last character and
1490
        RET     M               ; return if the null string.
1491
                                ; or multiple of 256!
1492
 
1493
        ADD     HL,BC           ; find last character of the filename.
1494
                                ; and also clear carry.
1495
        SET     7,(HL)          ; invert it.
1496
        RET                     ; return.
1497
 
1498
; =========================================
1499
;
1500
; PORT 254 ($FE)
1501
;
1502
;                      spk mic { border  }
1503
;          ___ ___ ___ ___ ___ ___ ___ ___
1504
; PORT    |   |   |   |   |   |   |   |   |
1505
; 254     |   |   |   |   |   |   |   |   |
1506
; $FE     |___|___|___|___|___|___|___|___|
1507
;           7   6   5   4   3   2   1   0
1508
;
1509
 
1510
; ----------------------------------
1511
; Save header and program/data bytes
1512
; ----------------------------------
1513
;   This routine saves a section of data. It is called from SA-CTRL to save the
1514
;   seventeen bytes of header data. It is also the exit route from that routine
1515
;   when it is set up to save the actual data.
1516
;   On entry -
1517
;   HL points to start of data.
1518
;   IX points to descriptor.
1519
;   The accumulator is set to  $00 for a header, $FF for data.
1520
 
1521
;; SA-BYTES
1522
L04C2:  LD      HL,L053F        ; address: SA/LD-RET
1523
        PUSH    HL              ; is pushed as common exit route.
1524
                                ; however there is only one non-terminal exit
1525
                                ; point.
1526
 
1527
        LD      HL,$1F80        ; a timing constant H=$1F, L=$80
1528
                                ; inner and outer loop counters
1529
                                ; a five second lead-in is used for a header.
1530
 
1531
        BIT     7,A             ; test one bit of accumulator.
1532
                                ; (AND A ?)
1533
        JR      Z,L04D0         ; skip to SA-FLAG if a header is being saved.
1534
 
1535
;   else is data bytes and a shorter lead-in is used.
1536
 
1537
        LD      HL,$0C98        ; another timing value H=$0C, L=$98.
1538
                                ; a two second lead-in is used for the data.
1539
 
1540
 
1541
;; SA-FLAG
1542
L04D0:  EX      AF,AF'          ; save flag
1543
        INC     DE              ; increase length by one.
1544
        DEC     IX              ; decrease start.
1545
 
1546
        DI                      ; disable interrupts
1547
 
1548
        LD      A,$02           ; select red for border, microphone bit on.
1549
        LD      B,A             ; also does as an initial slight counter value.
1550
 
1551
;; SA-LEADER
1552
L04D8:  DJNZ    L04D8           ; self loop to SA-LEADER for delay.
1553
                                ; after initial loop, count is $A4 (or $A3)
1554
 
1555
        OUT     ($FE),A         ; output byte $02/$0D to tape port.
1556
 
1557
        XOR     $0F             ; switch from RED (mic on) to CYAN (mic off).
1558
 
1559
        LD      B,$A4           ; hold count. also timed instruction.
1560
 
1561
        DEC     L               ; originally $80 or $98.
1562
                                ; but subsequently cycles 256 times.
1563
        JR      NZ,L04D8        ; back to SA-LEADER until L is zero.
1564
 
1565
;   the outer loop is counted by H
1566
 
1567
        DEC     B               ; decrement count
1568
        DEC     H               ; originally  twelve or thirty-one.
1569
        JP      P,L04D8         ; back to SA-LEADER until H becomes $FF
1570
 
1571
;   now send a sync pulse. At this stage mic is off and A holds value
1572
;   for mic on.
1573
;   A sync pulse is much shorter than the steady pulses of the lead-in.
1574
 
1575
        LD      B,$2F           ; another short timed delay.
1576
 
1577
;; SA-SYNC-1
1578
L04EA:  DJNZ    L04EA           ; self loop to SA-SYNC-1
1579
 
1580
        OUT     ($FE),A         ; switch to mic on and red.
1581
        LD      A,$0D           ; prepare mic off - cyan
1582
        LD      B,$37           ; another short timed delay.
1583
 
1584
;; SA-SYNC-2
1585
L04F2:  DJNZ    L04F2           ; self loop to SA-SYNC-2
1586
 
1587
        OUT     ($FE),A         ; output mic off, cyan border.
1588
        LD      BC,$3B0E        ; B=$3B time(*), C=$0E, YELLOW, MIC OFF.
1589
 
1590
;
1591
 
1592
        EX      AF,AF'          ; restore saved flag
1593
                                ; which is 1st byte to be saved.
1594
 
1595
        LD      L,A             ; and transfer to L.
1596
                                ; the initial parity is A, $FF or $00.
1597
        JP      L0507           ; JUMP forward to SA-START     ->
1598
                                ; the mid entry point of loop.
1599
 
1600
; -------------------------
1601
;   During the save loop a parity byte is maintained in H.
1602
;   the save loop begins by testing if reduced length is zero and if so
1603
;   the final parity byte is saved reducing count to $FFFF.
1604
 
1605
;; SA-LOOP
1606
L04FE:  LD      A,D             ; fetch high byte
1607
        OR      E               ; test against low byte.
1608
        JR      Z,L050E         ; forward to SA-PARITY if zero.
1609
 
1610
        LD      L,(IX+$00)      ; load currently addressed byte to L.
1611
 
1612
;; SA-LOOP-P
1613
L0505:  LD      A,H             ; fetch parity byte.
1614
        XOR     L               ; exclusive or with new byte.
1615
 
1616
; -> the mid entry point of loop.
1617
 
1618
;; SA-START
1619
L0507:  LD      H,A             ; put parity byte in H.
1620
        LD      A,$01           ; prepare blue, mic=on.
1621
        SCF                     ; set carry flag ready to rotate in.
1622
        JP      L0525           ; JUMP forward to SA-8-BITS            -8->
1623
 
1624
; ---
1625
 
1626
;; SA-PARITY
1627
L050E:  LD      L,H             ; transfer the running parity byte to L and
1628
        JR      L0505           ; back to SA-LOOP-P
1629
                                ; to output that byte before quitting normally.
1630
 
1631
; ---
1632
 
1633
;   The entry point to save yellow part of bit.
1634
;   A bit consists of a period with mic on and blue border followed by
1635
;   a period of mic off with yellow border.
1636
;   Note. since the DJNZ instruction does not affect flags, the zero flag is
1637
;   used to indicate which of the two passes is in effect and the carry
1638
;   maintains the state of the bit to be saved.
1639
 
1640
;; SA-BIT-2
1641
L0511:  LD      A,C             ; fetch 'mic on and yellow' which is
1642
                                ; held permanently in C.
1643
        BIT     7,B             ; set the zero flag. B holds $3E.
1644
 
1645
;   The entry point to save 1 entire bit. For first bit B holds $3B(*).
1646
;   Carry is set if saved bit is 1. zero is reset NZ on entry.
1647
 
1648
;; SA-BIT-1
1649
L0514:  DJNZ    L0514           ; self loop for delay to SA-BIT-1
1650
 
1651
        JR      NC,L051C        ; forward to SA-OUT if bit is 0.
1652
 
1653
;   but if bit is 1 then the mic state is held for longer.
1654
 
1655
        LD      B,$42           ; set timed delay. (66 decimal)
1656
 
1657
;; SA-SET
1658
L051A:  DJNZ    L051A           ; self loop to SA-SET
1659
                                ; (roughly an extra 66*13 clock cycles)
1660
 
1661
;; SA-OUT
1662
L051C:  OUT     ($FE),A         ; blue and mic on OR  yellow and mic off.
1663
 
1664
        LD      B,$3E           ; set up delay
1665
        JR      NZ,L0511        ; back to SA-BIT-2 if zero reset NZ (first pass)
1666
 
1667
;   proceed when the blue and yellow bands have been output.
1668
 
1669
        DEC     B               ; change value $3E to $3D.
1670
        XOR     A               ; clear carry flag (ready to rotate in).
1671
        INC     A               ; reset zero flag i.e. NZ.
1672
 
1673
; -8->
1674
 
1675
;; SA-8-BITS
1676
L0525:  RL      L               ; rotate left through carry
1677
                                ; C<76543210
1678
        JP      NZ,L0514        ; JUMP back to SA-BIT-1
1679
                                ; until all 8 bits done.
1680
 
1681
;   when the initial set carry is passed out again then a byte is complete.
1682
 
1683
        DEC     DE              ; decrease length
1684
        INC     IX              ; increase byte pointer
1685
        LD      B,$31           ; set up timing.
1686
 
1687
        LD      A,$7F           ; test the space key and
1688
        IN      A,($FE)         ; return to common exit (to restore border)
1689
        RRA                     ; if a space is pressed
1690
        RET     NC              ; return to SA/LD-RET.   - - >
1691
 
1692
;   now test if byte counter has reached $FFFF.
1693
 
1694
        LD      A,D             ; fetch high byte
1695
        INC     A               ; increment.
1696
        JP      NZ,L04FE        ; JUMP to SA-LOOP if more bytes.
1697
 
1698
        LD      B,$3B           ; a final delay.
1699
 
1700
;; SA-DELAY
1701
L053C:  DJNZ    L053C           ; self loop to SA-DELAY
1702
 
1703
        RET                     ; return - - >
1704
 
1705
; ------------------------------
1706
; THE 'SAVE/LOAD RETURN' ROUTINE
1707
; ------------------------------
1708
;   The address of this routine is pushed on the stack prior to any load/save
1709
;   operation and it handles normal completion with the restoration of the
1710
;   border and also abnormal termination when the break key, or to be more
1711
;   precise the space key is pressed during a tape operation.
1712
;
1713
; - - >
1714
 
1715
;; SA/LD-RET
1716
L053F:  PUSH    AF              ; preserve accumulator throughout.
1717
        LD      A,($5C48)       ; fetch border colour from BORDCR.
1718
        AND     $38             ; mask off paper bits.
1719
        RRCA                    ; rotate
1720
        RRCA                    ; to the
1721
        RRCA                    ; range 0-7.
1722
 
1723
        OUT     ($FE),A         ; change the border colour.
1724
 
1725
        LD      A,$7F           ; read from port address $7FFE the
1726
        IN      A,($FE)         ; row with the space key at outside.
1727
 
1728
        RRA                     ; test for space key pressed.
1729
        EI                      ; enable interrupts
1730
        JR      C,L0554         ; forward to SA/LD-END if not
1731
 
1732
 
1733
;; REPORT-Da
1734
L0552:  RST     08H             ; ERROR-1
1735
        DEFB    $0C             ; Error Report: BREAK - CONT repeats
1736
 
1737
; ---
1738
 
1739
;; SA/LD-END
1740
L0554:  POP     AF              ; restore the accumulator.
1741
        RET                     ; return.
1742
 
1743
; ------------------------------------
1744
; Load header or block of information
1745
; ------------------------------------
1746
;   This routine is used to load bytes and on entry A is set to $00 for a
1747
;   header or to $FF for data.  IX points to the start of receiving location
1748
;   and DE holds the length of bytes to be loaded. If, on entry the carry flag
1749
;   is set then data is loaded, if reset then it is verified.
1750
 
1751
;; LD-BYTES
1752
L0556:  INC     D               ; reset the zero flag without disturbing carry.
1753
        EX      AF,AF'          ; preserve entry flags.
1754
        DEC     D               ; restore high byte of length.
1755
 
1756
        DI                      ; disable interrupts
1757
 
1758
        LD      A,$0F           ; make the border white and mic off.
1759
        OUT     ($FE),A         ; output to port.
1760
 
1761
        LD      HL,L053F        ; Address: SA/LD-RET
1762
        PUSH    HL              ; is saved on stack as terminating routine.
1763
 
1764
;   the reading of the EAR bit (D6) will always be preceded by a test of the
1765
;   space key (D0), so store the initial post-test state.
1766
 
1767
        IN      A,($FE)         ; read the ear state - bit 6.
1768
        RRA                     ; rotate to bit 5.
1769
        AND     $20             ; isolate this bit.
1770
        OR      $02             ; combine with red border colour.
1771
        LD      C,A             ; and store initial state long-term in C.
1772
        CP      A               ; set the zero flag.
1773
 
1774
;
1775
 
1776
;; LD-BREAK
1777
L056B:  RET     NZ              ; return if at any time space is pressed.
1778
 
1779
;; LD-START
1780
L056C:  CALL    L05E7           ; routine LD-EDGE-1
1781
        JR      NC,L056B        ; back to LD-BREAK with time out and no
1782
                                ; edge present on tape.
1783
 
1784
;   but continue when a transition is found on tape.
1785
 
1786
        LD      HL,$0415        ; set up 16-bit outer loop counter for
1787
                                ; approx 1 second delay.
1788
 
1789
;; LD-WAIT
1790
L0574:  DJNZ    L0574           ; self loop to LD-WAIT (for 256 times)
1791
 
1792
        DEC     HL              ; decrease outer loop counter.
1793
        LD      A,H             ; test for
1794
        OR      L               ; zero.
1795
        JR      NZ,L0574        ; back to LD-WAIT, if not zero, with zero in B.
1796
 
1797
;   continue after delay with H holding zero and B also.
1798
;   sample 256 edges to check that we are in the middle of a lead-in section.
1799
 
1800
        CALL    L05E3           ; routine LD-EDGE-2
1801
        JR      NC,L056B        ; back to LD-BREAK
1802
                                ; if no edges at all.
1803
 
1804
;; LD-LEADER
1805
L0580:  LD      B,$9C           ; set timing value.
1806
        CALL    L05E3           ; routine LD-EDGE-2
1807
        JR      NC,L056B        ; back to LD-BREAK if time-out
1808
 
1809
        LD      A,$C6           ; two edges must be spaced apart.
1810
        CP      B               ; compare
1811
        JR      NC,L056C        ; back to LD-START if too close together for a
1812
                                ; lead-in.
1813
 
1814
        INC     H               ; proceed to test 256 edged sample.
1815
        JR      NZ,L0580        ; back to LD-LEADER while more to do.
1816
 
1817
;   sample indicates we are in the middle of a two or five second lead-in.
1818
;   Now test every edge looking for the terminal sync signal.
1819
 
1820
;; LD-SYNC
1821
L058F:  LD      B,$C9           ; initial timing value in B.
1822
        CALL    L05E7           ; routine LD-EDGE-1
1823
        JR      NC,L056B        ; back to LD-BREAK with time-out.
1824
 
1825
        LD      A,B             ; fetch augmented timing value from B.
1826
        CP      $D4             ; compare
1827
        JR      NC,L058F        ; back to LD-SYNC if gap too big, that is,
1828
                                ; a normal lead-in edge gap.
1829
 
1830
;   but a short gap will be the sync pulse.
1831
;   in which case another edge should appear before B rises to $FF
1832
 
1833
        CALL    L05E7           ; routine LD-EDGE-1
1834
        RET     NC              ; return with time-out.
1835
 
1836
; proceed when the sync at the end of the lead-in is found.
1837
; We are about to load data so change the border colours.
1838
 
1839
        LD      A,C             ; fetch long-term mask from C
1840
        XOR     $03             ; and make blue/yellow.
1841
 
1842
        LD      C,A             ; store the new long-term byte.
1843
 
1844
        LD      H,$00           ; set up parity byte as zero.
1845
        LD      B,$B0           ; timing.
1846
        JR      L05C8           ; forward to LD-MARKER
1847
                                ; the loop mid entry point with the alternate
1848
                                ; zero flag reset to indicate first byte
1849
                                ; is discarded.
1850
 
1851
; --------------
1852
;   the loading loop loads each byte and is entered at the mid point.
1853
 
1854
;; LD-LOOP
1855
L05A9:  EX      AF,AF'          ; restore entry flags and type in A.
1856
        JR      NZ,L05B3        ; forward to LD-FLAG if awaiting initial flag
1857
                                ; which is to be discarded.
1858
 
1859
        JR      NC,L05BD        ; forward to LD-VERIFY if not to be loaded.
1860
 
1861
        LD      (IX+$00),L      ; place loaded byte at memory location.
1862
        JR      L05C2           ; forward to LD-NEXT
1863
 
1864
; ---
1865
 
1866
;; LD-FLAG
1867
L05B3:  RL      C               ; preserve carry (verify) flag in long-term
1868
                                ; state byte. Bit 7 can be lost.
1869
 
1870
        XOR     L               ; compare type in A with first byte in L.
1871
        RET     NZ              ; return if no match e.g. CODE vs. DATA.
1872
 
1873
;   continue when data type matches.
1874
 
1875
        LD      A,C             ; fetch byte with stored carry
1876
        RRA                     ; rotate it to carry flag again
1877
        LD      C,A             ; restore long-term port state.
1878
 
1879
        INC     DE              ; increment length ??
1880
        JR      L05C4           ; forward to LD-DEC.
1881
                                ; but why not to location after ?
1882
 
1883
; ---
1884
;   for verification the byte read from tape is compared with that in memory.
1885
 
1886
;; LD-VERIFY
1887
L05BD:  LD      A,(IX+$00)      ; fetch byte from memory.
1888
        XOR     L               ; compare with that on tape
1889
        RET     NZ              ; return if not zero.
1890
 
1891
;; LD-NEXT
1892
L05C2:  INC     IX              ; increment byte pointer.
1893
 
1894
;; LD-DEC
1895
L05C4:  DEC     DE              ; decrement length.
1896
        EX      AF,AF'          ; store the flags.
1897
        LD      B,$B2           ; timing.
1898
 
1899
;   when starting to read 8 bits the receiving byte is marked with bit at right.
1900
;   when this is rotated out again then 8 bits have been read.
1901
 
1902
;; LD-MARKER
1903
L05C8:  LD      L,$01           ; initialize as %00000001
1904
 
1905
;; LD-8-BITS
1906
L05CA:  CALL    L05E3           ; routine LD-EDGE-2 increments B relative to
1907
                                ; gap between 2 edges.
1908
        RET     NC              ; return with time-out.
1909
 
1910
        LD      A,$CB           ; the comparison byte.
1911
        CP      B               ; compare to incremented value of B.
1912
                                ; if B is higher then bit on tape was set.
1913
                                ; if <= then bit on tape is reset.
1914
 
1915
        RL      L               ; rotate the carry bit into L.
1916
 
1917
        LD      B,$B0           ; reset the B timer byte.
1918
        JP      NC,L05CA        ; JUMP back to LD-8-BITS
1919
 
1920
;   when carry set then marker bit has been passed out and byte is complete.
1921
 
1922
        LD      A,H             ; fetch the running parity byte.
1923
        XOR     L               ; include the new byte.
1924
        LD      H,A             ; and store back in parity register.
1925
 
1926
        LD      A,D             ; check length of
1927
        OR      E               ; expected bytes.
1928
        JR      NZ,L05A9        ; back to LD-LOOP
1929
                                ; while there are more.
1930
 
1931
;   when all bytes loaded then parity byte should be zero.
1932
 
1933
        LD      A,H             ; fetch parity byte.
1934
        CP      $01             ; set carry if zero.
1935
        RET                     ; return
1936
                                ; in no carry then error as checksum disagrees.
1937
 
1938
; -------------------------
1939
; Check signal being loaded
1940
; -------------------------
1941
;   An edge is a transition from one mic state to another.
1942
;   More specifically a change in bit 6 of value input from port $FE.
1943
;   Graphically it is a change of border colour, say, blue to yellow.
1944
;   The first entry point looks for two adjacent edges. The second entry point
1945
;   is used to find a single edge.
1946
;   The B register holds a count, up to 256, within which the edge (or edges)
1947
;   must be found. The gap between two edges will be more for a '1' than a '0'
1948
;   so the value of B denotes the state of the bit (two edges) read from tape.
1949
 
1950
; ->
1951
 
1952
;; LD-EDGE-2
1953
L05E3:  CALL    L05E7           ; call routine LD-EDGE-1 below.
1954
        RET     NC              ; return if space pressed or time-out.
1955
                                ; else continue and look for another adjacent
1956
                                ; edge which together represent a bit on the
1957
                                ; tape.
1958
 
1959
; ->
1960
;   this entry point is used to find a single edge from above but also
1961
;   when detecting a read-in signal on the tape.
1962
 
1963
;; LD-EDGE-1
1964
L05E7:  LD      A,$16           ; a delay value of twenty two.
1965
 
1966
;; LD-DELAY
1967
L05E9:  DEC     A               ; decrement counter
1968
        JR      NZ,L05E9        ; loop back to LD-DELAY 22 times.
1969
 
1970
        AND      A              ; clear carry.
1971
 
1972
;; LD-SAMPLE
1973
L05ED:  INC     B               ; increment the time-out counter.
1974
        RET     Z               ; return with failure when $FF passed.
1975
 
1976
        LD      A,$7F           ; prepare to read keyboard and EAR port
1977
        IN      A,($FE)         ; row $7FFE. bit 6 is EAR, bit 0 is SPACE key.
1978
        RRA                     ; test outer key the space. (bit 6 moves to 5)
1979
        RET     NC              ; return if space pressed.  >>>
1980
 
1981
        XOR     C               ; compare with initial long-term state.
1982
        AND     $20             ; isolate bit 5
1983
        JR      Z,L05ED         ; back to LD-SAMPLE if no edge.
1984
 
1985
;   but an edge, a transition of the EAR bit, has been found so switch the
1986
;   long-term comparison byte containing both border colour and EAR bit.
1987
 
1988
        LD      A,C             ; fetch comparison value.
1989
        CPL                     ; switch the bits
1990
        LD      C,A             ; and put back in C for long-term.
1991
 
1992
        AND     $07             ; isolate new colour bits.
1993
        OR      $08             ; set bit 3 - MIC off.
1994
        OUT     ($FE),A         ; send to port to effect the change of colour.
1995
 
1996
        SCF                     ; set carry flag signaling edge found within
1997
                                ; time allowed.
1998
        RET                     ; return.
1999
 
2000
; ---------------------------------
2001
; Entry point for all tape commands
2002
; ---------------------------------
2003
;   This is the single entry point for the four tape commands.
2004
;   The routine first determines in what context it has been called by examining
2005
;   the low byte of the Syntax table entry which was stored in T_ADDR.
2006
;   Subtracting $EO (the present arrangement) gives a value of
2007
;   $00 - SAVE
2008
;   $01 - LOAD
2009
;   $02 - VERIFY
2010
;   $03 - MERGE
2011
;   As with all commands the address STMT-RET is on the stack.
2012
 
2013
;; SAVE-ETC
2014
L0605:  POP     AF              ; discard address STMT-RET.
2015
        LD      A,($5C74)       ; fetch T_ADDR
2016
 
2017
;   Now reduce the low byte of the Syntax table entry to give command.
2018
;   Note. For ZASM use SUB $E0 as next instruction.
2019
 
2020
L0609:  SUB     L1ADF + 1 % 256 ; subtract the known offset.
2021
                                ; ( is SUB $E0 in standard ROM )
2022
 
2023
        LD      ($5C74),A       ; and put back in T_ADDR as 0,1,2, or 3
2024
                                ; for future reference.
2025
 
2026
        CALL    L1C8C           ; routine EXPT-EXP checks that a string
2027
                                ; expression follows and stacks the
2028
                                ; parameters in run-time.
2029
 
2030
        CALL    L2530           ; routine SYNTAX-Z
2031
        JR      Z,L0652         ; forward to SA-DATA if checking syntax.
2032
 
2033
        LD      BC,$0011        ; presume seventeen bytes for a header.
2034
        LD      A,($5C74)       ; fetch command from T_ADDR.
2035
        AND     A               ; test for zero - SAVE.
2036
        JR      Z,L0621         ; forward to SA-SPACE if so.
2037
 
2038
        LD      C,$22           ; else double length to thirty four.
2039
 
2040
;; SA-SPACE
2041
L0621:  RST     30H             ; BC-SPACES creates 17/34 bytes in workspace.
2042
 
2043
        PUSH    DE              ; transfer the start of new space to
2044
        POP     IX              ; the available index register.
2045
 
2046
;   ten spaces are required for the default filename but it is simpler to
2047
;   overwrite the first file-type indicator byte as well.
2048
 
2049
        LD      B,$0B           ; set counter to eleven.
2050
        LD      A,$20           ; prepare a space.
2051
 
2052
;; SA-BLANK
2053
L0629:  LD      (DE),A          ; set workspace location to space.
2054
        INC     DE              ; next location.
2055
        DJNZ    L0629           ; loop back to SA-BLANK till all eleven done.
2056
 
2057
        LD      (IX+$01),$FF    ; set first byte of ten character filename
2058
                                ; to $FF as a default to signal null string.
2059
 
2060
        CALL    L2BF1           ; routine STK-FETCH fetches the filename
2061
                                ; parameters from the calculator stack.
2062
                                ; length of string in BC.
2063
                                ; start of string in DE.
2064
 
2065
        LD      HL,$FFF6        ; prepare the value minus ten.
2066
        DEC     BC              ; decrement length.
2067
                                ; ten becomes nine, zero becomes $FFFF.
2068
        ADD     HL,BC           ; trial addition.
2069
        INC     BC              ; restore true length.
2070
        JR      NC,L064B        ; forward to SA-NAME if length is one to ten.
2071
 
2072
;   the filename is more than ten characters in length or the null string.
2073
 
2074
        LD      A,($5C74)       ; fetch command from T_ADDR.
2075
        AND     A               ; test for zero - SAVE.
2076
        JR      NZ,L0644        ; forward to SA-NULL if not the SAVE command.
2077
 
2078
;   but no more than ten characters are allowed for SAVE.
2079
;   The first ten characters of any other command parameter are acceptable.
2080
;   Weird, but necessary, if saving to sectors.
2081
;   Note. the golden rule that there are no restriction on anything is broken.
2082
 
2083
;; REPORT-Fa
2084
L0642:  RST     08H             ; ERROR-1
2085
        DEFB    $0E             ; Error Report: Invalid file name
2086
 
2087
;   continue with LOAD, MERGE, VERIFY and also SAVE within ten character limit.
2088
 
2089
;; SA-NULL
2090
L0644:  LD      A,B             ; test length of filename
2091
        OR      C               ; for zero.
2092
        JR      Z,L0652         ; forward to SA-DATA if so using the 255
2093
                                ; indicator followed by spaces.
2094
 
2095
        LD      BC,$000A        ; else trim length to ten.
2096
 
2097
;   other paths rejoin here with BC holding length in range 1 - 10.
2098
 
2099
;; SA-NAME
2100
L064B:  PUSH    IX              ; push start of file descriptor.
2101
        POP     HL              ; and pop into HL.
2102
 
2103
        INC     HL              ; HL now addresses first byte of filename.
2104
        EX      DE,HL           ; transfer destination address to DE, start
2105
                                ; of string in command to HL.
2106
        LDIR                    ; copy up to ten bytes
2107
                                ; if less than ten then trailing spaces follow.
2108
 
2109
;   the case for the null string rejoins here.
2110
 
2111
;; SA-DATA
2112
L0652:  RST     18H             ; GET-CHAR
2113
        CP      $E4             ; is character after filename the token 'DATA' ?
2114
        JR      NZ,L06A0        ; forward to SA-SCR$ to consider SCREEN$ if
2115
                                ; not.
2116
 
2117
;   continue to consider DATA.
2118
 
2119
        LD      A,($5C74)       ; fetch command from T_ADDR
2120
        CP      $03             ; is it 'VERIFY' ?
2121
        JP      Z,L1C8A         ; jump forward to REPORT-C if so.
2122
                                ; 'Nonsense in BASIC'
2123
                                ; VERIFY "d" DATA is not allowed.
2124
 
2125
;   continue with SAVE, LOAD, MERGE of DATA.
2126
 
2127
        RST     20H             ; NEXT-CHAR
2128
        CALL    L28B2           ; routine LOOK-VARS searches variables area
2129
                                ; returning with carry reset if found or
2130
                                ; checking syntax.
2131
        SET     7,C             ; this converts a simple string to a
2132
                                ; string array. The test for an array or string
2133
                                ; comes later.
2134
        JR      NC,L0672        ; forward to SA-V-OLD if variable found.
2135
 
2136
        LD      HL,$0000        ; set destination to zero as not fixed.
2137
        LD      A,($5C74)       ; fetch command from T_ADDR
2138
        DEC     A               ; test for 1 - LOAD
2139
        JR      Z,L0685         ; forward to SA-V-NEW with LOAD DATA.
2140
                                ; to load a new array.
2141
 
2142
;   otherwise the variable was not found in run-time with SAVE/MERGE.
2143
 
2144
;; REPORT-2a
2145
L0670:  RST     08H             ; ERROR-1
2146
        DEFB    $01             ; Error Report: Variable not found
2147
 
2148
;   continue with SAVE/LOAD  DATA
2149
 
2150
;; SA-V-OLD
2151
L0672:  JP      NZ,L1C8A        ; to REPORT-C if not an array variable.
2152
                                ; or erroneously a simple string.
2153
                                ; 'Nonsense in BASIC'
2154
 
2155
 
2156
        CALL    L2530           ; routine SYNTAX-Z
2157
        JR      Z,L0692         ; forward to SA-DATA-1 if checking syntax.
2158
 
2159
        INC     HL              ; step past single character variable name.
2160
        LD      A,(HL)          ; fetch low byte of length.
2161
        LD      (IX+$0B),A      ; place in descriptor.
2162
        INC     HL              ; point to high byte.
2163
        LD      A,(HL)          ; and transfer that
2164
        LD      (IX+$0C),A      ; to descriptor.
2165
        INC     HL              ; increase pointer within variable.
2166
 
2167
;; SA-V-NEW
2168
L0685:  LD      (IX+$0E),C      ; place character array name in  header.
2169
        LD      A,$01           ; default to type numeric.
2170
        BIT     6,C             ; test result from look-vars.
2171
        JR      Z,L068F         ; forward to SA-V-TYPE if numeric.
2172
 
2173
        INC     A               ; set type to 2 - string array.
2174
 
2175
;; SA-V-TYPE
2176
L068F:  LD      (IX+$00),A      ; place type 0, 1 or 2 in descriptor.
2177
 
2178
;; SA-DATA-1
2179
L0692:  EX      DE,HL           ; save var pointer in DE
2180
 
2181
        RST     20H             ; NEXT-CHAR
2182
        CP      $29             ; is character ')' ?
2183
        JR      NZ,L0672        ; back if not to SA-V-OLD to report
2184
                                ; 'Nonsense in BASIC'
2185
 
2186
        RST     20H             ; NEXT-CHAR advances character address.
2187
        CALL    L1BEE           ; routine CHECK-END errors if not end of
2188
                                ; the statement.
2189
 
2190
        EX      DE,HL           ; bring back variables data pointer.
2191
        JP      L075A           ; jump forward to SA-ALL
2192
 
2193
; ---
2194
;   the branch was here to consider a 'SCREEN$', the display file.
2195
 
2196
;; SA-SCR$
2197
L06A0:  CP      $AA             ; is character the token 'SCREEN$' ?
2198
        JR      NZ,L06C3        ; forward to SA-CODE if not.
2199
 
2200
        LD      A,($5C74)       ; fetch command from T_ADDR
2201
        CP      $03             ; is it MERGE ?
2202
        JP       Z,L1C8A        ; jump to REPORT-C if so.
2203
                                ; 'Nonsense in BASIC'
2204
 
2205
;   continue with SAVE/LOAD/VERIFY SCREEN$.
2206
 
2207
        RST     20H             ; NEXT-CHAR
2208
        CALL    L1BEE           ; routine CHECK-END errors if not at end of
2209
                                ; statement.
2210
 
2211
;   continue in runtime.
2212
 
2213
        LD      (IX+$0B),$00    ; set descriptor length
2214
        LD      (IX+$0C),$1B    ; to $1b00 to include bitmaps and attributes.
2215
 
2216
        LD      HL,$4000        ; set start to display file start.
2217
        LD      (IX+$0D),L      ; place start in
2218
        LD      (IX+$0E),H      ; the descriptor.
2219
        JR      L0710           ; forward to SA-TYPE-3
2220
 
2221
; ---
2222
;   the branch was here to consider CODE.
2223
 
2224
;; SA-CODE
2225
L06C3:  CP      $AF             ; is character the token 'CODE' ?
2226
        JR      NZ,L0716        ; forward if not to SA-LINE to consider an
2227
                                ; auto-started BASIC program.
2228
 
2229
        LD      A,($5C74)       ; fetch command from T_ADDR
2230
        CP      $03             ; is it MERGE ?
2231
        JP      Z,L1C8A         ; jump forward to REPORT-C if so.
2232
                                ; 'Nonsense in BASIC'
2233
 
2234
 
2235
        RST     20H             ; NEXT-CHAR advances character address.
2236
        CALL    L2048           ; routine PR-ST-END checks if a carriage
2237
                                ; return or ':' follows.
2238
        JR      NZ,L06E1        ; forward to SA-CODE-1 if there are parameters.
2239
 
2240
        LD      A,($5C74)       ; else fetch the command from T_ADDR.
2241
        AND     A               ; test for zero - SAVE without a specification.
2242
        JP      Z,L1C8A         ; jump to REPORT-C if so.
2243
                                ; 'Nonsense in BASIC'
2244
 
2245
;   for LOAD/VERIFY put zero on stack to signify handle at location saved from.
2246
 
2247
        CALL    L1CE6           ; routine USE-ZERO
2248
        JR      L06F0           ; forward to SA-CODE-2
2249
 
2250
; ---
2251
 
2252
;   if there are more characters after CODE expect start and possibly length.
2253
 
2254
;; SA-CODE-1
2255
L06E1:  CALL    L1C82           ; routine EXPT-1NUM checks for numeric
2256
                                ; expression and stacks it in run-time.
2257
 
2258
        RST     18H             ; GET-CHAR
2259
        CP      $2C             ; does a comma follow ?
2260
        JR      Z,L06F5         ; forward if so to SA-CODE-3
2261
 
2262
;   else allow saved code to be loaded to a specified address.
2263
 
2264
        LD      A,($5C74)       ; fetch command from T_ADDR.
2265
        AND     A               ; is the command SAVE which requires length ?
2266
        JP      Z,L1C8A         ; jump to REPORT-C if so.
2267
                                ; 'Nonsense in BASIC'
2268
 
2269
;   the command LOAD code may rejoin here with zero stacked as start.
2270
 
2271
;; SA-CODE-2
2272
L06F0:  CALL    L1CE6           ; routine USE-ZERO stacks zero for length.
2273
        JR      L06F9           ; forward to SA-CODE-4
2274
 
2275
; ---
2276
;   the branch was here with SAVE CODE start,
2277
 
2278
;; SA-CODE-3
2279
L06F5:  RST     20H             ; NEXT-CHAR advances character address.
2280
        CALL    L1C82           ; routine EXPT-1NUM checks for expression
2281
                                ; and stacks in run-time.
2282
 
2283
;   paths converge here and nothing must follow.
2284
 
2285
;; SA-CODE-4
2286
L06F9:  CALL    L1BEE           ; routine CHECK-END errors with extraneous
2287
                                ; characters and quits if checking syntax.
2288
 
2289
;   in run-time there are two 16-bit parameters on the calculator stack.
2290
 
2291
        CALL    L1E99           ; routine FIND-INT2 gets length.
2292
        LD      (IX+$0B),C      ; place length
2293
        LD      (IX+$0C),B      ; in descriptor.
2294
        CALL    L1E99           ; routine FIND-INT2 gets start.
2295
        LD      (IX+$0D),C      ; place start
2296
        LD      (IX+$0E),B      ; in descriptor.
2297
        LD      H,B             ; transfer the
2298
        LD      L,C             ; start to HL also.
2299
 
2300
;; SA-TYPE-3
2301
L0710:  LD      (IX+$00),$03    ; place type 3 - code in descriptor.
2302
        JR      L075A           ; forward to SA-ALL.
2303
 
2304
; ---
2305
;   the branch was here with BASIC to consider an optional auto-start line
2306
;   number.
2307
 
2308
;; SA-LINE
2309
L0716:  CP      $CA             ; is character the token 'LINE' ?
2310
        JR      Z,L0723         ; forward to SA-LINE-1 if so.
2311
 
2312
;   else all possibilities have been considered and nothing must follow.
2313
 
2314
        CALL    L1BEE           ; routine CHECK-END
2315
 
2316
;   continue in run-time to save BASIC without auto-start.
2317
 
2318
        LD      (IX+$0E),$80    ; place high line number in descriptor to
2319
                                ; disable auto-start.
2320
        JR      L073A           ; forward to SA-TYPE-0 to save program.
2321
 
2322
; ---
2323
;   the branch was here to consider auto-start.
2324
 
2325
;; SA-LINE-1
2326
L0723:  LD      A,($5C74)       ; fetch command from T_ADDR
2327
        AND     A               ; test for SAVE.
2328
        JP      NZ,L1C8A        ; jump forward to REPORT-C with anything else.
2329
                                ; 'Nonsense in BASIC'
2330
 
2331
;
2332
 
2333
        RST     20H             ; NEXT-CHAR
2334
        CALL    L1C82           ; routine EXPT-1NUM checks for numeric
2335
                                ; expression and stacks in run-time.
2336
        CALL    L1BEE           ; routine CHECK-END quits if syntax path.
2337
        CALL    L1E99           ; routine FIND-INT2 fetches the numeric
2338
                                ; expression.
2339
        LD      (IX+$0D),C      ; place the auto-start
2340
        LD      (IX+$0E),B      ; line number in the descriptor.
2341
 
2342
;   Note. this isn't checked, but is subsequently handled by the system.
2343
;   If the user typed 40000 instead of 4000 then it won't auto-start
2344
;   at line 4000, or indeed, at all.
2345
 
2346
;   continue to save program and any variables.
2347
 
2348
;; SA-TYPE-0
2349
L073A:  LD      (IX+$00),$00    ; place type zero - program in descriptor.
2350
        LD      HL,($5C59)      ; fetch E_LINE to HL.
2351
        LD      DE,($5C53)      ; fetch PROG to DE.
2352
        SCF                     ; set carry flag to calculate from end of
2353
                                ; variables E_LINE -1.
2354
        SBC     HL,DE           ; subtract to give total length.
2355
 
2356
        LD      (IX+$0B),L      ; place total length
2357
        LD      (IX+$0C),H      ; in descriptor.
2358
        LD      HL,($5C4B)      ; load HL from system variable VARS
2359
        SBC     HL,DE           ; subtract to give program length.
2360
        LD      (IX+$0F),L      ; place length of program
2361
        LD      (IX+$10),H      ; in the descriptor.
2362
        EX      DE,HL           ; start to HL, length to DE.
2363
 
2364
;; SA-ALL
2365
L075A:  LD      A,($5C74)       ; fetch command from T_ADDR
2366
        AND     A               ; test for zero - SAVE.
2367
        JP      Z,L0970         ; jump forward to SA-CONTRL with SAVE  ->
2368
 
2369
; ---
2370
;   continue with LOAD, MERGE and VERIFY.
2371
 
2372
        PUSH    HL              ; save start.
2373
        LD      BC,$0011        ; prepare to add seventeen
2374
        ADD     IX,BC           ; to point IX at second descriptor.
2375
 
2376
;; LD-LOOK-H
2377
L0767:  PUSH    IX              ; save IX
2378
        LD      DE,$0011        ; seventeen bytes
2379
        XOR     A               ; reset zero flag
2380
        SCF                     ; set carry flag
2381
        CALL    L0556           ; routine LD-BYTES loads a header from tape
2382
                                ; to second descriptor.
2383
        POP     IX              ; restore IX.
2384
        JR      NC,L0767        ; loop back to LD-LOOK-H until header found.
2385
 
2386
        LD      A,$FE           ; select system channel 'S'
2387
        CALL    L1601           ; routine CHAN-OPEN opens it.
2388
 
2389
        LD      (IY+$52),$03    ; set SCR_CT to 3 lines.
2390
 
2391
        LD      C,$80           ; C has bit 7 set to indicate type mismatch as
2392
                                ; a default startpoint.
2393
 
2394
        LD      A,(IX+$00)      ; fetch loaded header type to A
2395
        CP      (IX-$11)        ; compare with expected type.
2396
        JR      NZ,L078A        ; forward to LD-TYPE with mis-match.
2397
 
2398
        LD      C,$F6           ; set C to minus ten - will count characters
2399
                                ; up to zero.
2400
 
2401
;; LD-TYPE
2402
L078A:  CP      $04             ; check if type in acceptable range 0 - 3.
2403
        JR      NC,L0767        ; back to LD-LOOK-H with 4 and over.
2404
 
2405
;   else A indicates type 0-3.
2406
 
2407
        LD      DE,L09C0        ; address base of last 4 tape messages
2408
        PUSH    BC              ; save BC
2409
        CALL    L0C0A           ; routine PO-MSG outputs relevant message.
2410
                                ; Note. all messages have a leading newline.
2411
        POP     BC              ; restore BC
2412
 
2413
        PUSH    IX              ; transfer IX,
2414
        POP     DE              ; the 2nd descriptor, to DE.
2415
        LD      HL,$FFF0        ; prepare minus seventeen.
2416
        ADD     HL,DE           ; add to point HL to 1st descriptor.
2417
        LD      B,$0A           ; the count will be ten characters for the
2418
                                ; filename.
2419
 
2420
        LD      A,(HL)          ; fetch first character and test for
2421
        INC     A               ; value 255.
2422
        JR      NZ,L07A6        ; forward to LD-NAME if not the wildcard.
2423
 
2424
;   but if it is the wildcard, then add ten to C which is minus ten for a type
2425
;   match or -128 for a type mismatch. Although characters have to be counted
2426
;   bit 7 of C will not alter from state set here.
2427
 
2428
        LD      A,C             ; transfer $F6 or $80 to A
2429
        ADD     A,B             ; add $0A
2430
        LD      C,A             ; place result, zero or -118, in C.
2431
 
2432
;   At this point we have either a type mismatch, a wildcard match or ten
2433
;   characters to be counted. The characters must be shown on the screen.
2434
 
2435
;; LD-NAME
2436
L07A6:  INC     DE              ; address next input character
2437
        LD      A,(DE)          ; fetch character
2438
        CP      (HL)            ; compare to expected
2439
        INC     HL              ; address next expected character
2440
        JR      NZ,L07AD        ; forward to LD-CH-PR with mismatch
2441
 
2442
        INC     C               ; increment matched character count
2443
 
2444
;; LD-CH-PR
2445
L07AD:  RST     10H             ; PRINT-A prints character
2446
        DJNZ    L07A6           ; loop back to LD-NAME for ten characters.
2447
 
2448
;   if ten characters matched and the types previously matched then C will
2449
;   now hold zero.
2450
 
2451
        BIT     7,C             ; test if all matched
2452
        JR      NZ,L0767        ; back to LD-LOOK-H if not
2453
 
2454
;   else print a terminal carriage return.
2455
 
2456
        LD      A,$0D           ; prepare carriage return.
2457
        RST     10H             ; PRINT-A outputs it.
2458
 
2459
;   The various control routines for LOAD, VERIFY and MERGE are executed
2460
;   during the one-second gap following the header on tape.
2461
 
2462
        POP     HL              ; restore xx
2463
        LD      A,(IX+$00)      ; fetch incoming type
2464
        CP      $03             ; compare with CODE
2465
        JR      Z,L07CB         ; forward to VR-CONTRL if it is CODE.
2466
 
2467
;  type is a program or an array.
2468
 
2469
        LD      A,($5C74)       ; fetch command from T_ADDR
2470
        DEC     A               ; was it LOAD ?
2471
        JP      Z,L0808         ; JUMP forward to LD-CONTRL if so to
2472
                                ; load BASIC or variables.
2473
 
2474
        CP      $02             ; was command MERGE ?
2475
        JP      Z,L08B6         ; jump forward to ME-CONTRL if so.
2476
 
2477
;   else continue into VERIFY control routine to verify.
2478
 
2479
; ----------------------------
2480
; THE 'VERIFY CONTROL' ROUTINE
2481
; ----------------------------
2482
;   There are two branches to this routine.
2483
;   1) From above to verify a program or array
2484
;   2) from earlier with no carry to load or verify code.
2485
 
2486
;; VR-CONTRL
2487
L07CB:  PUSH    HL              ; save pointer to data.
2488
        LD      L,(IX-$06)      ; fetch length of old data
2489
        LD      H,(IX-$05)      ; to HL.
2490
        LD      E,(IX+$0B)      ; fetch length of new data
2491
        LD      D,(IX+$0C)      ; to DE.
2492
        LD      A,H             ; check length of old
2493
        OR      L               ; for zero.
2494
        JR      Z,L07E9         ; forward to VR-CONT-1 if length unspecified
2495
                                ; e.g. LOAD "x" CODE
2496
 
2497
;   as opposed to, say, LOAD 'x' CODE 32768,300.
2498
 
2499
        SBC     HL,DE           ; subtract the two lengths.
2500
        JR      C,L0806         ; forward to REPORT-R if the length on tape is
2501
                                ; larger than that specified in command.
2502
                                ; 'Tape loading error'
2503
 
2504
        JR      Z,L07E9         ; forward to VR-CONT-1 if lengths match.
2505
 
2506
;   a length on tape shorter than expected is not allowed for CODE
2507
 
2508
        LD      A,(IX+$00)      ; else fetch type from tape.
2509
        CP      $03             ; is it CODE ?
2510
        JR      NZ,L0806        ; forward to REPORT-R if so
2511
                                ; 'Tape loading error'
2512
 
2513
;; VR-CONT-1
2514
L07E9:  POP     HL              ; pop pointer to data
2515
        LD      A,H             ; test for zero
2516
        OR      L               ; e.g. LOAD 'x' CODE
2517
        JR      NZ,L07F4        ; forward to VR-CONT-2 if destination specified.
2518
 
2519
        LD      L,(IX+$0D)      ; else use the destination in the header
2520
        LD      H,(IX+$0E)      ; and load code at address saved from.
2521
 
2522
;; VR-CONT-2
2523
L07F4:  PUSH    HL              ; push pointer to start of data block.
2524
        POP     IX              ; transfer to IX.
2525
        LD      A,($5C74)       ; fetch reduced command from T_ADDR
2526
        CP      $02             ; is it VERIFY ?
2527
        SCF                     ; prepare a set carry flag
2528
        JR      NZ,L0800        ; skip to VR-CONT-3 if not
2529
 
2530
        AND     A               ; clear carry flag for VERIFY so that
2531
                                ; data is not loaded.
2532
 
2533
;; VR-CONT-3
2534
L0800:  LD      A,$FF           ; signal data block to be loaded
2535
 
2536
; -----------------
2537
; Load a data block
2538
; -----------------
2539
;   This routine is called from 3 places other than above to load a data block.
2540
;   In all cases the accumulator is first set to $FF so the routine could be
2541
;   called at the previous instruction.
2542
 
2543
;; LD-BLOCK
2544
L0802:  CALL    L0556           ; routine LD-BYTES
2545
        RET     C               ; return if successful.
2546
 
2547
 
2548
;; REPORT-R
2549
L0806:  RST     08H             ; ERROR-1
2550
        DEFB    $1A             ; Error Report: Tape loading error
2551
 
2552
; --------------------------
2553
; THE 'LOAD CONTROL' ROUTINE
2554
; --------------------------
2555
;   This branch is taken when the command is LOAD with type 0, 1 or 2.
2556
 
2557
;; LD-CONTRL
2558
L0808:  LD      E,(IX+$0B)      ; fetch length of found data block
2559
        LD      D,(IX+$0C)      ; from 2nd descriptor.
2560
        PUSH    HL              ; save destination
2561
        LD      A,H             ; test for zero
2562
        OR      L               ;
2563
        JR      NZ,L0819        ; forward if not to LD-CONT-1
2564
 
2565
        INC     DE              ; increase length
2566
        INC     DE              ; for letter name
2567
        INC     DE              ; and 16-bit length
2568
        EX      DE,HL           ; length to HL,
2569
        JR      L0825           ; forward to LD-CONT-2
2570
 
2571
; ---
2572
 
2573
;; LD-CONT-1
2574
L0819:  LD      L,(IX-$06)      ; fetch length from
2575
        LD      H,(IX-$05)      ; the first header.
2576
        EX      DE,HL           ;
2577
        SCF                     ; set carry flag
2578
        SBC     HL,DE           ;
2579
        JR      C,L082E         ; to LD-DATA
2580
 
2581
;; LD-CONT-2
2582
L0825:  LD      DE,$0005        ; allow overhead of five bytes.
2583
        ADD     HL,DE           ; add in the difference in data lengths.
2584
        LD      B,H             ; transfer to
2585
        LD      C,L             ; the BC register pair
2586
        CALL    L1F05           ; routine TEST-ROOM fails if not enough room.
2587
 
2588
;; LD-DATA
2589
L082E:  POP     HL              ; pop destination
2590
        LD      A,(IX+$00)      ; fetch type 0, 1 or 2.
2591
        AND     A               ; test for program and variables.
2592
        JR      Z,L0873         ; forward if so to LD-PROG
2593
 
2594
;   the type is a numeric or string array.
2595
 
2596
        LD      A,H             ; test the destination for zero
2597
        OR      L               ; indicating variable does not already exist.
2598
        JR      Z,L084C         ; forward if so to LD-DATA-1
2599
 
2600
;   else the destination is the first dimension within the array structure
2601
 
2602
        DEC     HL              ; address high byte of total length
2603
        LD      B,(HL)          ; transfer to B.
2604
        DEC     HL              ; address low byte of total length.
2605
        LD      C,(HL)          ; transfer to C.
2606
        DEC     HL              ; point to letter of variable.
2607
        INC     BC              ; adjust length to
2608
        INC     BC              ; include these
2609
        INC     BC              ; three bytes also.
2610
        LD      ($5C5F),IX      ; save header pointer in X_PTR.
2611
        CALL    L19E8           ; routine RECLAIM-2 reclaims the old variable
2612
                                ; sliding workspace including the two headers
2613
                                ; downwards.
2614
        LD      IX,($5C5F)      ; reload IX from X_PTR which will have been
2615
                                ; adjusted down by POINTERS routine.
2616
 
2617
;; LD-DATA-1
2618
L084C:  LD      HL,($5C59)      ; address E_LINE
2619
        DEC     HL              ; now point to the $80 variables end-marker.
2620
        LD      C,(IX+$0B)      ; fetch new data length
2621
        LD      B,(IX+$0C)      ; from 2nd header.
2622
        PUSH    BC              ; * save it.
2623
        INC     BC              ; adjust the
2624
        INC     BC              ; length to include
2625
        INC     BC              ; letter name and total length.
2626
        LD      A,(IX-$03)      ; fetch letter name from old header.
2627
        PUSH    AF              ; preserve accumulator though not corrupted.
2628
 
2629
        CALL    L1655           ; routine MAKE-ROOM creates space for variable
2630
                                ; sliding workspace up. IX no longer addresses
2631
                                ; anywhere meaningful.
2632
        INC     HL              ; point to first new location.
2633
 
2634
        POP     AF              ; fetch back the letter name.
2635
        LD      (HL),A          ; place in first new location.
2636
        POP     DE              ; * pop the data length.
2637
        INC     HL              ; address 2nd location
2638
        LD      (HL),E          ; store low byte of length.
2639
        INC     HL              ; address next.
2640
        LD      (HL),D          ; store high byte.
2641
        INC     HL              ; address start of data.
2642
        PUSH    HL              ; transfer address
2643
        POP     IX              ; to IX register pair.
2644
        SCF                     ; set carry flag indicating load not verify.
2645
        LD      A,$FF           ; signal data not header.
2646
        JP      L0802           ; JUMP back to LD-BLOCK
2647
 
2648
; -----------------
2649
;   the branch is here when a program as opposed to an array is to be loaded.
2650
 
2651
;; LD-PROG
2652
L0873:  EX      DE,HL           ; transfer dest to DE.
2653
        LD      HL,($5C59)      ; address E_LINE
2654
        DEC     HL              ; now variables end-marker.
2655
        LD      ($5C5F),IX      ; place the IX header pointer in X_PTR
2656
        LD      C,(IX+$0B)      ; get new length
2657
        LD      B,(IX+$0C)      ; from 2nd header
2658
        PUSH    BC              ; and save it.
2659
 
2660
        CALL    L19E5           ; routine RECLAIM-1 reclaims program and vars.
2661
                                ; adjusting X-PTR.
2662
 
2663
        POP     BC              ; restore new length.
2664
        PUSH    HL              ; * save start
2665
        PUSH    BC              ; ** and length.
2666
 
2667
        CALL    L1655           ; routine MAKE-ROOM creates the space.
2668
 
2669
        LD      IX,($5C5F)      ; reload IX from adjusted X_PTR
2670
        INC     HL              ; point to start of new area.
2671
        LD      C,(IX+$0F)      ; fetch length of BASIC on tape
2672
        LD      B,(IX+$10)      ; from 2nd descriptor
2673
        ADD     HL,BC           ; add to address the start of variables.
2674
        LD      ($5C4B),HL      ; set system variable VARS
2675
 
2676
        LD      H,(IX+$0E)      ; fetch high byte of autostart line number.
2677
        LD      A,H             ; transfer to A
2678
        AND     $C0             ; test if greater than $3F.
2679
        JR      NZ,L08AD        ; forward to LD-PROG-1 if so with no autostart.
2680
 
2681
        LD      L,(IX+$0D)      ; else fetch the low byte.
2682
        LD      ($5C42),HL      ; set system variable to line number NEWPPC
2683
        LD      (IY+$0A),$00    ; set statement NSPPC to zero.
2684
 
2685
;; LD-PROG-1
2686
L08AD:  POP     DE              ; ** pop the length
2687
        POP     IX              ; * and start.
2688
        SCF                     ; set carry flag
2689
        LD      A,$FF           ; signal data as opposed to a header.
2690
        JP      L0802           ; jump back to LD-BLOCK
2691
 
2692
; ---------------------------
2693
; THE 'MERGE CONTROL' ROUTINE
2694
; ---------------------------
2695
;   the branch was here to merge a program and its variables or an array.
2696
;
2697
 
2698
;; ME-CONTRL
2699
L08B6:  LD      C,(IX+$0B)      ; fetch length
2700
        LD      B,(IX+$0C)      ; of data block on tape.
2701
        PUSH    BC              ; save it.
2702
        INC     BC              ; one for the pot.
2703
 
2704
        RST     30H             ; BC-SPACES creates room in workspace.
2705
                                ; HL addresses last new location.
2706
        LD      (HL),$80        ; place end-marker at end.
2707
        EX      DE,HL           ; transfer first location to HL.
2708
        POP     DE              ; restore length to DE.
2709
        PUSH    HL              ; save start.
2710
 
2711
        PUSH    HL              ; and transfer it
2712
        POP     IX              ; to IX register.
2713
        SCF                     ; set carry flag to load data on tape.
2714
        LD      A,$FF           ; signal data not a header.
2715
        CALL    L0802           ; routine LD-BLOCK loads to workspace.
2716
        POP     HL              ; restore first location in workspace to HL.
2717
X08CE   LD      DE,($5C53)      ; set DE from system variable PROG.
2718
 
2719
;   now enter a loop to merge the data block in workspace with the program and
2720
;   variables.
2721
 
2722
;; ME-NEW-LP
2723
L08D2:  LD      A,(HL)          ; fetch next byte from workspace.
2724
        AND     $C0             ; compare with $3F.
2725
        JR      NZ,L08F0        ; forward to ME-VAR-LP if a variable or
2726
                                ; end-marker.
2727
 
2728
;   continue when HL addresses a BASIC line number.
2729
 
2730
;; ME-OLD-LP
2731
L08D7:  LD      A,(DE)          ; fetch high byte from program area.
2732
        INC     DE              ; bump prog address.
2733
        CP      (HL)            ; compare with that in workspace.
2734
        INC     HL              ; bump workspace address.
2735
        JR      NZ,L08DF        ; forward to ME-OLD-L1 if high bytes don't match
2736
 
2737
        LD      A,(DE)          ; fetch the low byte of program line number.
2738
        CP      (HL)            ; compare with that in workspace.
2739
 
2740
;; ME-OLD-L1
2741
L08DF:  DEC     DE              ; point to start of
2742
        DEC     HL              ; respective lines again.
2743
        JR      NC,L08EB        ; forward to ME-NEW-L2 if line number in
2744
                                ; workspace is less than or equal to current
2745
                                ; program line as has to be added to program.
2746
 
2747
        PUSH    HL              ; else save workspace pointer.
2748
        EX      DE,HL           ; transfer prog pointer to HL
2749
        CALL    L19B8           ; routine NEXT-ONE finds next line in DE.
2750
        POP     HL              ; restore workspace pointer
2751
        JR      L08D7           ; back to ME-OLD-LP until destination position
2752
                                ; in program area found.
2753
 
2754
; ---
2755
;   the branch was here with an insertion or replacement point.
2756
 
2757
;; ME-NEW-L2
2758
L08EB:  CALL    L092C           ; routine ME-ENTER enters the line
2759
        JR      L08D2           ; loop back to ME-NEW-LP.
2760
 
2761
; ---
2762
;   the branch was here when the location in workspace held a variable.
2763
 
2764
;; ME-VAR-LP
2765
L08F0:  LD      A,(HL)          ; fetch first byte of workspace variable.
2766
        LD      C,A             ; copy to C also.
2767
        CP      $80             ; is it the end-marker ?
2768
        RET     Z               ; return if so as complete.  >>>>>
2769
 
2770
        PUSH    HL              ; save workspace area pointer.
2771
        LD      HL,($5C4B)      ; load HL with VARS - start of variables area.
2772
 
2773
;; ME-OLD-VP
2774
L08F9:  LD      A,(HL)          ; fetch first byte.
2775
        CP      $80             ; is it the end-marker ?
2776
        JR      Z,L0923         ; forward if so to ME-VAR-L2 to add
2777
                                ; variable at end of variables area.
2778
 
2779
        CP      C               ; compare with variable in workspace area.
2780
        JR      Z,L0909         ; forward to ME-OLD-V2 if a match to replace.
2781
 
2782
;   else entire variables area has to be searched.
2783
 
2784
;; ME-OLD-V1
2785
L0901:  PUSH    BC              ; save character in C.
2786
        CALL    L19B8           ; routine NEXT-ONE gets following variable
2787
                                ; address in DE.
2788
        POP     BC              ; restore character in C
2789
        EX      DE,HL           ; transfer next address to HL.
2790
        JR      L08F9           ; loop back to ME-OLD-VP
2791
 
2792
; ---
2793
;   the branch was here when first characters of name matched.
2794
 
2795
;; ME-OLD-V2
2796
L0909:  AND     $E0             ; keep bits 11100000
2797
        CP      $A0             ; compare   10100000 - a long-named variable.
2798
 
2799
        JR      NZ,L0921        ; forward to ME-VAR-L1 if just one-character.
2800
 
2801
;   but long-named variables have to be matched character by character.
2802
 
2803
        POP     DE              ; fetch workspace 1st character pointer
2804
        PUSH    DE              ; and save it on the stack again.
2805
        PUSH    HL              ; save variables area pointer on stack.
2806
 
2807
;; ME-OLD-V3
2808
L0912:  INC     HL              ; address next character in vars area.
2809
        INC     DE              ; address next character in workspace area.
2810
        LD      A,(DE)          ; fetch workspace character.
2811
        CP      (HL)            ; compare to variables character.
2812
        JR      NZ,L091E        ; forward to ME-OLD-V4 with a mismatch.
2813
 
2814
        RLA                     ; test if the terminal inverted character.
2815
        JR      NC,L0912        ; loop back to ME-OLD-V3 if more to test.
2816
 
2817
;   otherwise the long name matches in its entirety.
2818
 
2819
        POP     HL              ; restore pointer to first character of variable
2820
        JR      L0921           ; forward to ME-VAR-L1
2821
 
2822
; ---
2823
;   the branch is here when two characters don't match
2824
 
2825
;; ME-OLD-V4
2826
L091E:  POP     HL              ; restore the prog/vars pointer.
2827
        JR      L0901           ; back to ME-OLD-V1 to resume search.
2828
 
2829
; ---
2830
;   branch here when variable is to replace an existing one
2831
 
2832
;; ME-VAR-L1
2833
L0921:  LD      A,$FF           ; indicate a replacement.
2834
 
2835
;   this entry point is when A holds $80 indicating a new variable.
2836
 
2837
;; ME-VAR-L2
2838
L0923:  POP     DE              ; pop workspace pointer.
2839
        EX      DE,HL           ; now make HL workspace pointer, DE vars pointer
2840
        INC     A               ; zero flag set if replacement.
2841
        SCF                     ; set carry flag indicating a variable not a
2842
                                ; program line.
2843
        CALL    L092C           ; routine ME-ENTER copies variable in.
2844
        JR      L08F0           ; loop back to ME-VAR-LP
2845
 
2846
; ------------------------
2847
; Merge a Line or Variable
2848
; ------------------------
2849
;   A BASIC line or variable is inserted at the current point. If the line
2850
;   number or variable names match (zero flag set) then a replacement takes
2851
;   place.
2852
 
2853
;; ME-ENTER
2854
L092C:  JR      NZ,L093E        ; forward to ME-ENT-1 for insertion only.
2855
 
2856
;   but the program line or variable matches so old one is reclaimed.
2857
 
2858
        EX      AF,AF'          ; save flag??
2859
        LD      ($5C5F),HL      ; preserve workspace pointer in dynamic X_PTR
2860
        EX      DE,HL           ; transfer program dest pointer to HL.
2861
        CALL    L19B8           ; routine NEXT-ONE finds following location
2862
                                ; in program or variables area.
2863
        CALL    L19E8           ; routine RECLAIM-2 reclaims the space between.
2864
        EX      DE,HL           ; transfer program dest pointer back to DE.
2865
        LD      HL,($5C5F)      ; fetch adjusted workspace pointer from X_PTR
2866
        EX      AF,AF'          ; restore flags.
2867
 
2868
;   now the new line or variable is entered.
2869
 
2870
;; ME-ENT-1
2871
L093E:  EX      AF,AF'          ; save or re-save flags.
2872
        PUSH    DE              ; save dest pointer in prog/vars area.
2873
        CALL    L19B8           ; routine NEXT-ONE finds next in workspace.
2874
                                ; gets next in DE, difference in BC.
2875
                                ; prev addr in HL
2876
        LD      ($5C5F),HL      ; store pointer in X_PTR
2877
        LD      HL,($5C53)      ; load HL from system variable PROG
2878
        EX      (SP),HL         ; swap with prog/vars pointer on stack.
2879
        PUSH    BC              ; ** save length of new program line/variable.
2880
        EX      AF,AF'          ; fetch flags back.
2881
        JR      C,L0955         ; skip to ME-ENT-2 if variable
2882
 
2883
        DEC     HL              ; address location before pointer
2884
        CALL    L1655           ; routine MAKE-ROOM creates room for BASIC line
2885
        INC     HL              ; address next.
2886
        JR      L0958           ; forward to ME-ENT-3
2887
 
2888
; ---
2889
 
2890
;; ME-ENT-2
2891
L0955:  CALL    L1655           ; routine MAKE-ROOM creates room for variable.
2892
 
2893
;; ME-ENT-3
2894
L0958:  INC     HL              ; address next?
2895
 
2896
        POP     BC              ; ** pop length
2897
        POP     DE              ; * pop value for PROG which may have been
2898
                                ; altered by POINTERS if first line.
2899
        LD      ($5C53),DE      ; set PROG to original value.
2900
        LD      DE,($5C5F)      ; fetch adjusted workspace pointer from X_PTR
2901
        PUSH    BC              ; save length
2902
        PUSH    DE              ; and workspace pointer
2903
        EX      DE,HL           ; make workspace pointer source, prog/vars
2904
                                ; pointer the destination
2905
        LDIR                    ; copy bytes of line or variable into new area.
2906
        POP     HL              ; restore workspace pointer.
2907
        POP     BC              ; restore length.
2908
        PUSH    DE              ; save new prog/vars pointer.
2909
        CALL    L19E8           ; routine RECLAIM-2 reclaims the space used
2910
                                ; by the line or variable in workspace block
2911
                                ; as no longer required and space could be
2912
                                ; useful for adding more lines.
2913
        POP     DE              ; restore the prog/vars pointer
2914
        RET                     ; return.
2915
 
2916
; --------------------------
2917
; THE 'SAVE CONTROL' ROUTINE
2918
; --------------------------
2919
;   A branch from the main SAVE-ETC routine at SAVE-ALL.
2920
;   First the header data is saved. Then after a wait of 1 second
2921
;   the data itself is saved.
2922
;   HL points to start of data.
2923
;   IX points to start of descriptor.
2924
 
2925
;; SA-CONTRL
2926
L0970:  PUSH    HL              ; save start of data
2927
 
2928
        LD      A,$FD           ; select system channel 'S'
2929
        CALL    L1601           ; routine CHAN-OPEN
2930
 
2931
        XOR     A               ; clear to address table directly
2932
        LD      DE,L09A1        ; address: tape-msgs
2933
        CALL    L0C0A           ; routine PO-MSG -
2934
                                ; 'Start tape then press any key.'
2935
 
2936
        SET     5,(IY+$02)      ; TV_FLAG  - Signal lower screen requires
2937
                                ; clearing
2938
        CALL    L15D4           ; routine WAIT-KEY
2939
 
2940
        PUSH    IX              ; save pointer to descriptor.
2941
        LD      DE,$0011        ; there are seventeen bytes.
2942
        XOR     A               ; signal a header.
2943
        CALL    L04C2           ; routine SA-BYTES
2944
 
2945
        POP     IX              ; restore descriptor pointer.
2946
 
2947
        LD      B,$32           ; wait for a second - 50 interrupts.
2948
 
2949
;; SA-1-SEC
2950
L0991:  HALT                    ; wait for interrupt
2951
        DJNZ    L0991           ; back to SA-1-SEC until pause complete.
2952
 
2953
        LD      E,(IX+$0B)      ; fetch length of bytes from the
2954
        LD      D,(IX+$0C)      ; descriptor.
2955
 
2956
        LD      A,$FF           ; signal data bytes.
2957
 
2958
        POP     IX              ; retrieve pointer to start
2959
        JP      L04C2           ; jump back to SA-BYTES
2960
 
2961
 
2962
;   Arrangement of two headers in workspace.
2963
;   Originally IX addresses first location and only one header is required
2964
;   when saving.
2965
;
2966
;   OLD     NEW         PROG   DATA  DATA  CODE
2967
;   HEADER  HEADER             num   chr          NOTES.
2968
;   ------  ------      ----   ----  ----  ----   -----------------------------
2969
;   IX-$11  IX+$00      0      1     2     3      Type.
2970
;   IX-$10  IX+$01      x      x     x     x      F  ($FF if filename is null).
2971
;   IX-$0F  IX+$02      x      x     x     x      i
2972
;   IX-$0E  IX+$03      x      x     x     x      l
2973
;   IX-$0D  IX+$04      x      x     x     x      e
2974
;   IX-$0C  IX+$05      x      x     x     x      n
2975
;   IX-$0B  IX+$06      x      x     x     x      a
2976
;   IX-$0A  IX+$07      x      x     x     x      m
2977
;   IX-$09  IX+$08      x      x     x     x      e
2978
;   IX-$08  IX+$09      x      x     x     x      .
2979
;   IX-$07  IX+$0A      x      x     x     x      (terminal spaces).
2980
;   IX-$06  IX+$0B      lo     lo    lo    lo     Total
2981
;   IX-$05  IX+$0C      hi     hi    hi    hi     Length of datablock.
2982
;   IX-$04  IX+$0D      Auto   -     -     Start  Various
2983
;   IX-$03  IX+$0E      Start  a-z   a-z   addr   ($80 if no autostart).
2984
;   IX-$02  IX+$0F      lo     -     -     -      Length of Program
2985
;   IX-$01  IX+$10      hi     -     -     -      only i.e. without variables.
2986
;
2987
 
2988
 
2989
; ------------------------
2990
; Canned cassette messages
2991
; ------------------------
2992
;   The last-character-inverted Cassette messages.
2993
;   Starts with normal initial step-over byte.
2994
 
2995
;; tape-msgs
2996
L09A1:  DEFB    $80
2997
        DEFM    "Start tape, then press any key"
2998
L09C0:  DEFB    '.'+$80
2999
        DEFB    $0D
3000
        DEFM    "Program:"
3001
        DEFB    ' '+$80
3002
        DEFB    $0D
3003
        DEFM    "Number array:"
3004
        DEFB    ' '+$80
3005
        DEFB    $0D
3006
        DEFM    "Character array:"
3007
        DEFB    ' '+$80
3008
        DEFB    $0D
3009
        DEFM    "Bytes:"
3010
        DEFB    ' '+$80
3011
 
3012
 
3013
;**************************************************
3014
;** Part 5. SCREEN AND PRINTER HANDLING ROUTINES **
3015
;**************************************************
3016
 
3017
; --------------------------
3018
; THE 'PRINT OUTPUT' ROUTINE
3019
; --------------------------
3020
;   This is the routine most often used by the RST 10 restart although the
3021
;   subroutine is on two occasions called directly when it is known that
3022
;   output will definitely be to the lower screen.
3023
 
3024
;; PRINT-OUT
3025
L09F4:  CALL    L0B03           ; routine PO-FETCH fetches print position
3026
                                ; to HL register pair.
3027
        CP      $20             ; is character a space or higher ?
3028
        JP      NC,L0AD9        ; jump forward to PO-ABLE if so.
3029
 
3030
        CP      $06             ; is character in range 00-05 ?
3031
        JR      C,L0A69         ; to PO-QUEST to print '?' if so.
3032
 
3033
        CP      $18             ; is character in range 24d - 31d ?
3034
        JR      NC,L0A69        ; to PO-QUEST to also print '?' if so.
3035
 
3036
        LD      HL,L0A11 - 6    ; address 0A0B - the base address of control
3037
                                ; character table - where zero would be.
3038
        LD      E,A             ; control character 06 - 23d
3039
        LD      D,$00           ; is transferred to DE.
3040
 
3041
        ADD     HL,DE           ; index into table.
3042
 
3043
        LD      E,(HL)          ; fetch the offset to routine.
3044
        ADD     HL,DE           ; add to make HL the address.
3045
        PUSH    HL              ; push the address.
3046
 
3047
        JP      L0B03           ; Jump forward to PO-FETCH,
3048
                                ; as the screen/printer position has been
3049
                                ; disturbed, and then indirectly to the PO-STORE
3050
                                ; routine on stack.
3051
 
3052
; -----------------------------
3053
; THE 'CONTROL CHARACTER' TABLE
3054
; -----------------------------
3055
;   For control characters in the range 6 - 23d the following table
3056
;   is indexed to provide an offset to the handling routine that
3057
;   follows the table.
3058
 
3059
;; ctlchrtab
3060
L0A11:  DEFB    L0A5F - $       ; 06d offset $4E to Address: PO-COMMA
3061
        DEFB    L0A69 - $       ; 07d offset $57 to Address: PO-QUEST
3062
        DEFB    L0A23 - $       ; 08d offset $10 to Address: PO-BACK-1
3063
        DEFB    L0A3D - $       ; 09d offset $29 to Address: PO-RIGHT
3064
        DEFB    L0A69 - $       ; 10d offset $54 to Address: PO-QUEST
3065
        DEFB    L0A69 - $       ; 11d offset $53 to Address: PO-QUEST
3066
        DEFB    L0A69 - $       ; 12d offset $52 to Address: PO-QUEST
3067
        DEFB    L0A4F - $       ; 13d offset $37 to Address: PO-ENTER
3068
        DEFB    L0A69 - $       ; 14d offset $50 to Address: PO-QUEST
3069
        DEFB    L0A69 - $       ; 15d offset $4F to Address: PO-QUEST
3070
        DEFB    L0A7A - $       ; 16d offset $5F to Address: PO-1-OPER
3071
        DEFB    L0A7A - $       ; 17d offset $5E to Address: PO-1-OPER
3072
        DEFB    L0A7A - $       ; 18d offset $5D to Address: PO-1-OPER
3073
        DEFB    L0A7A - $       ; 19d offset $5C to Address: PO-1-OPER
3074
        DEFB    L0A7A - $       ; 20d offset $5B to Address: PO-1-OPER
3075
        DEFB    L0A7A - $       ; 21d offset $5A to Address: PO-1-OPER
3076
        DEFB    L0A75 - $       ; 22d offset $54 to Address: PO-2-OPER
3077
        DEFB    L0A75 - $       ; 23d offset $53 to Address: PO-2-OPER
3078
 
3079
 
3080
; -------------------------
3081
; THE 'CURSOR LEFT' ROUTINE
3082
; -------------------------
3083
;   Backspace and up a line if that action is from the left of screen.
3084
;   For ZX printer backspace up to first column but not beyond.
3085
 
3086
;; PO-BACK-1
3087
L0A23:  INC     C               ; move left one column.
3088
        LD      A,$22           ; value $21 is leftmost column.
3089
        CP      C               ; have we passed ?
3090
        JR      NZ,L0A3A        ; to PO-BACK-3 if not and store new position.
3091
 
3092
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3093
        JR      NZ,L0A38        ; to PO-BACK-2 if so, as we are unable to
3094
                                ; backspace from the leftmost position.
3095
 
3096
 
3097
        INC     B               ; move up one screen line
3098
        LD      C,$02           ; the rightmost column position.
3099
        LD      A,$18           ; Note. This should be $19
3100
                                ; credit. Dr. Frank O'Hara, 1982
3101
 
3102
        CP      B               ; has position moved past top of screen ?
3103
        JR      NZ,L0A3A        ; to PO-BACK-3 if not and store new position.
3104
 
3105
        DEC     B               ; else back to $18.
3106
 
3107
;; PO-BACK-2
3108
L0A38:  LD      C,$21           ; the leftmost column position.
3109
 
3110
;; PO-BACK-3
3111
L0A3A:  JP      L0DD9           ; to CL-SET and PO-STORE to save new
3112
                                ; position in system variables.
3113
 
3114
; --------------------------
3115
; THE 'CURSOR RIGHT' ROUTINE
3116
; --------------------------
3117
;   This moves the print position to the right leaving a trail in the
3118
;   current background colour.
3119
;   "However the programmer has failed to store the new print position
3120
;   so CHR$ 9 will only work if the next print position is at a newly
3121
;   defined place.
3122
;   e.g. PRINT PAPER 2; CHR$ 9; AT 4,0;
3123
;   does work but is not very helpful"
3124
;   - Dr. Ian Logan, Understanding Your Spectrum, 1982.
3125
 
3126
;; PO-RIGHT
3127
L0A3D:  LD      A,($5C91)       ; fetch P_FLAG value
3128
        PUSH    AF              ; and save it on stack.
3129
 
3130
        LD      (IY+$57),$01    ; temporarily set P_FLAG 'OVER 1'.
3131
        LD      A,$20           ; prepare a space.
3132
        CALL    L0B65           ; routine PO-CHAR to print it.
3133
                                ; Note. could be PO-ABLE which would update
3134
                                ; the column position.
3135
 
3136
        POP     AF              ; restore the permanent flag.
3137
        LD      ($5C91),A       ; and restore system variable P_FLAG
3138
 
3139
        RET                     ; return without updating column position
3140
 
3141
; -----------------------
3142
; Perform carriage return
3143
; -----------------------
3144
; A carriage return is 'printed' to screen or printer buffer.
3145
 
3146
;; PO-ENTER
3147
L0A4F:  BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3148
        JP      NZ,L0ECD        ; to COPY-BUFF if so, to flush buffer and reset
3149
                                ; the print position.
3150
 
3151
        LD      C,$21           ; the leftmost column position.
3152
        CALL    L0C55           ; routine PO-SCR handles any scrolling required.
3153
        DEC     B               ; to next screen line.
3154
        JP      L0DD9           ; jump forward to CL-SET to store new position.
3155
 
3156
; -----------
3157
; Print comma
3158
; -----------
3159
; The comma control character. The 32 column screen has two 16 character
3160
; tabstops.  The routine is only reached via the control character table.
3161
 
3162
;; PO-COMMA
3163
L0A5F:  CALL    L0B03           ; routine PO-FETCH - seems unnecessary.
3164
 
3165
        LD      A,C             ; the column position. $21-$01
3166
        DEC     A               ; move right. $20-$00
3167
        DEC     A               ; and again   $1F-$00 or $FF if trailing
3168
        AND     $10             ; will be $00 or $10.
3169
        JR      L0AC3           ; forward to PO-FILL
3170
 
3171
; -------------------
3172
; Print question mark
3173
; -------------------
3174
; This routine prints a question mark which is commonly
3175
; used to print an unassigned control character in range 0-31d.
3176
; there are a surprising number yet to be assigned.
3177
 
3178
;; PO-QUEST
3179
L0A69:  LD      A,$3F           ; prepare the character '?'.
3180
        JR      L0AD9           ; forward to PO-ABLE.
3181
 
3182
; --------------------------------
3183
; Control characters with operands
3184
; --------------------------------
3185
; Certain control characters are followed by 1 or 2 operands.
3186
; The entry points from control character table are PO-2-OPER and PO-1-OPER.
3187
; The routines alter the output address of the current channel so that
3188
; subsequent RST $10 instructions take the appropriate action
3189
; before finally resetting the output address back to PRINT-OUT.
3190
 
3191
;; PO-TV-2
3192
L0A6D:  LD      DE,L0A87        ; address: PO-CONT will be next output routine
3193
        LD      ($5C0F),A       ; store first operand in TVDATA-hi
3194
        JR      L0A80           ; forward to PO-CHANGE >>
3195
 
3196
; ---
3197
 
3198
; -> This initial entry point deals with two operands - AT or TAB.
3199
 
3200
;; PO-2-OPER
3201
L0A75:  LD      DE,L0A6D        ; address: PO-TV-2 will be next output routine
3202
        JR      L0A7D           ; forward to PO-TV-1
3203
 
3204
; ---
3205
 
3206
; -> This initial entry point deals with one operand INK to OVER.
3207
 
3208
;; PO-1-OPER
3209
L0A7A:  LD      DE,L0A87        ; address: PO-CONT will be next output routine
3210
 
3211
;; PO-TV-1
3212
L0A7D:  LD      ($5C0E),A       ; store control code in TVDATA-lo
3213
 
3214
;; PO-CHANGE
3215
L0A80:  LD      HL,($5C51)      ; use CURCHL to find current output channel.
3216
        LD      (HL),E          ; make it
3217
        INC     HL              ; the supplied
3218
        LD      (HL),D          ; address from DE.
3219
        RET                     ; return.
3220
 
3221
; ---
3222
 
3223
;; PO-CONT
3224
L0A87:  LD      DE,L09F4        ; Address: PRINT-OUT
3225
        CALL    L0A80           ; routine PO-CHANGE to restore normal channel.
3226
        LD      HL,($5C0E)      ; TVDATA gives control code and possible
3227
                                ; subsequent character
3228
        LD      D,A             ; save current character
3229
        LD      A,L             ; the stored control code
3230
        CP      $16             ; was it INK to OVER (1 operand) ?
3231
        JP      C,L2211         ; to CO-TEMP-5
3232
 
3233
        JR      NZ,L0AC2        ; to PO-TAB if not 22d i.e. 23d TAB.
3234
 
3235
                                ; else must have been 22d AT.
3236
        LD      B,H             ; line to H   (0-23d)
3237
        LD      C,D             ; column to C (0-31d)
3238
        LD      A,$1F           ; the value 31d
3239
        SUB     C               ; reverse the column number.
3240
        JR      C,L0AAC         ; to PO-AT-ERR if C was greater than 31d.
3241
 
3242
        ADD     A,$02           ; transform to system range $02-$21
3243
        LD      C,A             ; and place in column register.
3244
 
3245
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3246
        JR      NZ,L0ABF        ; to PO-AT-SET as line can be ignored.
3247
 
3248
        LD      A,$16           ; 22 decimal
3249
        SUB     B               ; subtract line number to reverse
3250
                                ; 0 - 22 becomes 22 - 0.
3251
 
3252
;; PO-AT-ERR
3253
L0AAC:  JP      C,L1E9F         ; to REPORT-B if higher than 22 decimal
3254
                                ; Integer out of range.
3255
 
3256
        INC     A               ; adjust for system range $01-$17
3257
        LD      B,A             ; place in line register
3258
        INC     B               ; adjust to system range  $02-$18
3259
        BIT     0,(IY+$02)      ; TV_FLAG  - Lower screen in use ?
3260
        JP      NZ,L0C55        ; exit to PO-SCR to test for scrolling
3261
 
3262
        CP      (IY+$31)        ; Compare against DF_SZ
3263
        JP      C,L0C86         ; to REPORT-5 if too low
3264
                                ; Out of screen.
3265
 
3266
;; PO-AT-SET
3267
L0ABF:  JP      L0DD9           ; print position is valid so exit via CL-SET
3268
 
3269
; ---
3270
 
3271
; Continue here when dealing with TAB.
3272
; Note. In BASIC, TAB is followed by a 16-bit number and was initially
3273
; designed to work with any output device.
3274
 
3275
;; PO-TAB
3276
L0AC2:  LD      A,H             ; transfer parameter to A
3277
                                ; Losing current character -
3278
                                ; High byte of TAB parameter.
3279
 
3280
 
3281
;; PO-FILL
3282
L0AC3:  CALL    L0B03           ; routine PO-FETCH, HL-addr, BC=line/column.
3283
                                ; column 1 (right), $21 (left)
3284
        ADD     A,C             ; add operand to current column
3285
        DEC     A               ; range 0 - 31+
3286
        AND     $1F             ; make range 0 - 31d
3287
        RET     Z               ; return if result zero
3288
 
3289
        LD      D,A             ; Counter to D
3290
        SET     0,(IY+$01)      ; update FLAGS  - signal suppress leading space.
3291
 
3292
;; PO-SPACE
3293
L0AD0:  LD      A,$20           ; space character.
3294
 
3295
        CALL    L0C3B           ; routine PO-SAVE prints the character
3296
                                ; using alternate set (normal output routine)
3297
 
3298
        DEC     D               ; decrement counter.
3299
        JR      NZ,L0AD0        ; to PO-SPACE until done
3300
 
3301
        RET                     ; return
3302
 
3303
; ----------------------
3304
; Printable character(s)
3305
; ----------------------
3306
; This routine prints printable characters and continues into
3307
; the position store routine
3308
 
3309
;; PO-ABLE
3310
L0AD9:  CALL    L0B24           ; routine PO-ANY
3311
                                ; and continue into position store routine.
3312
 
3313
; ----------------------------
3314
; THE 'POSITION STORE' ROUTINE
3315
; ----------------------------
3316
;   This routine updates the system variables associated with the main screen,
3317
;   the lower screen/input buffer or the ZX printer.
3318
 
3319
;; PO-STORE
3320
L0ADC:  BIT     1,(IY+$01)      ; Test FLAGS - is printer in use ?
3321
        JR      NZ,L0AFC        ; Forward, if so, to PO-ST-PR
3322
 
3323
        BIT     0,(IY+$02)      ; Test TV_FLAG - is lower screen in use ?
3324
        JR      NZ,L0AF0        ; Forward, if so, to PO-ST-E
3325
 
3326
;   This section deals with the upper screen.
3327
 
3328
        LD      ($5C88),BC      ; Update S_POSN - line/column upper screen
3329
        LD      ($5C84),HL      ; Update DF_CC - upper display file address
3330
 
3331
        RET                     ; Return.
3332
 
3333
; ---
3334
 
3335
;   This section deals with the lower screen.
3336
 
3337
;; PO-ST-E
3338
L0AF0:  LD      ($5C8A),BC      ; Update SPOSNL line/column lower screen
3339
        LD      ($5C82),BC      ; Update ECHO_E line/column input buffer
3340
        LD      ($5C86),HL      ; Update DFCCL  lower screen memory address
3341
        RET                     ; Return.
3342
 
3343
; ---
3344
 
3345
;   This section deals with the ZX Printer.
3346
 
3347
;; PO-ST-PR
3348
L0AFC:  LD      (IY+$45),C      ; Update P_POSN column position printer
3349
        LD      ($5C80),HL      ; Update PR_CC - full printer buffer memory
3350
                                ; address
3351
        RET                     ; Return.
3352
 
3353
;   Note. that any values stored in location 23681 will be overwritten with
3354
;   the value 91 decimal.
3355
;   Credit April 1983, Dilwyn Jones. "Delving Deeper into your ZX Spectrum".
3356
 
3357
; ----------------------------
3358
; THE 'POSITION FETCH' ROUTINE
3359
; ----------------------------
3360
;   This routine fetches the line/column and display file address of the upper
3361
;   and lower screen or, if the printer is in use, the column position and
3362
;   absolute memory address.
3363
;   Note. that PR-CC-hi (23681) is used by this routine and if, in accordance
3364
;   with the manual (that says this is unused), the location has been used for
3365
;   other purposes, then subsequent output to the printer buffer could corrupt
3366
;   a 256-byte section of memory.
3367
 
3368
;; PO-FETCH
3369
L0B03:  BIT     1,(IY+$01)      ; Test FLAGS - is printer in use ?
3370
        JR      NZ,L0B1D        ; Forward, if so, to PO-F-PR
3371
 
3372
;   assume upper screen in use and thus optimize for path that requires speed.
3373
 
3374
        LD      BC,($5C88)      ; Fetch line/column from S_POSN
3375
        LD      HL,($5C84)      ; Fetch DF_CC display file address
3376
 
3377
        BIT     0,(IY+$02)      ; Test TV_FLAG - lower screen in use ?
3378
        RET     Z               ; Return if upper screen in use.
3379
 
3380
;   Overwrite registers with values for lower screen.
3381
 
3382
        LD      BC,($5C8A)      ; Fetch line/column from SPOSNL
3383
        LD      HL,($5C86)      ; Fetch display file address from DFCCL
3384
        RET                     ; Return.
3385
 
3386
; ---
3387
 
3388
;   This section deals with the ZX Printer.
3389
 
3390
;; PO-F-PR
3391
L0B1D:  LD      C,(IY+$45)      ; Fetch column from P_POSN.
3392
        LD      HL,($5C80)      ; Fetch printer buffer address from PR_CC.
3393
        RET                     ; Return.
3394
 
3395
; ---------------------------------
3396
; THE 'PRINT ANY CHARACTER' ROUTINE
3397
; ---------------------------------
3398
;   This routine is used to print any character in range 32d - 255d
3399
;   It is only called from PO-ABLE which continues into PO-STORE
3400
 
3401
;; PO-ANY
3402
L0B24:  CP      $80             ; ASCII ?
3403
        JR      C,L0B65         ; to PO-CHAR is so.
3404
 
3405
        CP      $90             ; test if a block graphic character.
3406
        JR      NC,L0B52        ; to PO-T&UDG to print tokens and UDGs
3407
 
3408
; The 16 2*2 mosaic characters 128-143 decimal are formed from
3409
; bits 0-3 of the character.
3410
 
3411
        LD      B,A             ; save character
3412
        CALL    L0B38           ; routine PO-GR-1 to construct top half
3413
                                ; then bottom half.
3414
        CALL    L0B03           ; routine PO-FETCH fetches print position.
3415
        LD      DE,$5C92        ; MEM-0 is location of 8 bytes of character
3416
        JR      L0B7F           ; to PR-ALL to print to screen or printer
3417
 
3418
; ---
3419
 
3420
;; PO-GR-1
3421
L0B38:  LD      HL,$5C92        ; address MEM-0 - a temporary buffer in
3422
                                ; systems variables which is normally used
3423
                                ; by the calculator.
3424
        CALL    L0B3E           ; routine PO-GR-2 to construct top half
3425
                                ; and continue into routine to construct
3426
                                ; bottom half.
3427
 
3428
;; PO-GR-2
3429
L0B3E:  RR      B               ; rotate bit 0/2 to carry
3430
        SBC     A,A             ; result $00 or $FF
3431
        AND     $0F             ; mask off right hand side
3432
        LD      C,A             ; store part in C
3433
        RR      B               ; rotate bit 1/3 of original chr to carry
3434
        SBC     A,A             ; result $00 or $FF
3435
        AND     $F0             ; mask off left hand side
3436
        OR      C               ; combine with stored pattern
3437
        LD      C,$04           ; four bytes for top/bottom half
3438
 
3439
;; PO-GR-3
3440
L0B4C:  LD      (HL),A          ; store bit patterns in temporary buffer
3441
        INC     HL              ; next address
3442
        DEC     C               ; jump back to
3443
        JR      NZ,L0B4C        ; to PO-GR-3 until byte is stored 4 times
3444
 
3445
        RET                     ; return
3446
 
3447
; ---
3448
 
3449
; Tokens and User defined graphics are now separated.
3450
 
3451
;; PO-T&UDG
3452
L0B52:  SUB     $A5             ; the 'RND' character
3453
        JR      NC,L0B5F        ; to PO-T to print tokens
3454
 
3455
        ADD     A,$15           ; add 21d to restore to 0 - 20
3456
        PUSH    BC              ; save current print position
3457
        LD      BC,($5C7B)      ; fetch UDG to address bit patterns
3458
        JR      L0B6A           ; to PO-CHAR-2 - common code to lay down
3459
                                ; a bit patterned character
3460
 
3461
; ---
3462
 
3463
;; PO-T
3464
L0B5F:  CALL    L0C10           ; routine PO-TOKENS prints tokens
3465
        JP      L0B03           ; exit via a JUMP to PO-FETCH as this routine
3466
                                ; must continue into PO-STORE.
3467
                                ; A JR instruction could be used.
3468
 
3469
; This point is used to print ASCII characters  32d - 127d.
3470
 
3471
;; PO-CHAR
3472
L0B65:  PUSH    BC              ; save print position
3473
        LD      BC,($5C36)      ; address CHARS
3474
 
3475
; This common code is used to transfer the character bytes to memory.
3476
 
3477
;; PO-CHAR-2
3478
L0B6A:  EX      DE,HL           ; transfer destination address to DE
3479
        LD      HL,$5C3B        ; point to FLAGS
3480
        RES     0,(HL)          ; allow for leading space
3481
        CP      $20             ; is it a space ?
3482
        JR      NZ,L0B76        ; to PO-CHAR-3 if not
3483
 
3484
        SET     0,(HL)          ; signal no leading space to FLAGS
3485
 
3486
;; PO-CHAR-3
3487
L0B76:  LD      H,$00           ; set high byte to 0
3488
        LD      L,A             ; character to A
3489
                                ; 0-21 UDG or 32-127 ASCII.
3490
        ADD     HL,HL           ; multiply
3491
        ADD     HL,HL           ; by
3492
        ADD     HL,HL           ; eight
3493
        ADD     HL,BC           ; HL now points to first byte of character
3494
        POP     BC              ; the source address CHARS or UDG
3495
        EX      DE,HL           ; character address to DE
3496
 
3497
; ----------------------------------
3498
; THE 'PRINT ALL CHARACTERS' ROUTINE
3499
; ----------------------------------
3500
;   This entry point entered from above to print ASCII and UDGs but also from
3501
;   earlier to print mosaic characters.
3502
;   HL=destination
3503
;   DE=character source
3504
;   BC=line/column
3505
 
3506
;; PR-ALL
3507
L0B7F:  LD      A,C             ; column to A
3508
        DEC     A               ; move right
3509
        LD      A,$21           ; pre-load with leftmost position
3510
        JR      NZ,L0B93        ; but if not zero to PR-ALL-1
3511
 
3512
        DEC     B               ; down one line
3513
        LD      C,A             ; load C with $21
3514
        BIT     1,(IY+$01)      ; test FLAGS  - Is printer in use
3515
        JR      Z,L0B93         ; to PR-ALL-1 if not
3516
 
3517
        PUSH    DE              ; save source address
3518
        CALL    L0ECD           ; routine COPY-BUFF outputs line to printer
3519
        POP     DE              ; restore character source address
3520
        LD      A,C             ; the new column number ($21) to C
3521
 
3522
;; PR-ALL-1
3523
L0B93:  CP      C               ; this test is really for screen - new line ?
3524
        PUSH    DE              ; save source
3525
 
3526
        CALL    Z,L0C55         ; routine PO-SCR considers scrolling
3527
 
3528
        POP     DE              ; restore source
3529
        PUSH    BC              ; save line/column
3530
        PUSH    HL              ; and destination
3531
        LD      A,($5C91)       ; fetch P_FLAG to accumulator
3532
        LD      B,$FF           ; prepare OVER mask in B.
3533
        RRA                     ; bit 0 set if OVER 1
3534
        JR      C,L0BA4         ; to PR-ALL-2
3535
 
3536
        INC     B               ; set OVER mask to 0
3537
 
3538
;; PR-ALL-2
3539
L0BA4:  RRA                     ; skip bit 1 of P_FLAG
3540
        RRA                     ; bit 2 is INVERSE
3541
        SBC     A,A             ; will be FF for INVERSE 1 else zero
3542
        LD      C,A             ; transfer INVERSE mask to C
3543
        LD      A,$08           ; prepare to count 8 bytes
3544
        AND     A               ; clear carry to signal screen
3545
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3546
        JR      Z,L0BB6         ; to PR-ALL-3 if screen
3547
 
3548
        SET     1,(IY+$30)      ; update FLAGS2  - signal printer buffer has
3549
                                ; been used.
3550
        SCF                     ; set carry flag to signal printer.
3551
 
3552
;; PR-ALL-3
3553
L0BB6:  EX      DE,HL           ; now HL=source, DE=destination
3554
 
3555
;; PR-ALL-4
3556
L0BB7:  EX      AF,AF'          ; save printer/screen flag
3557
        LD      A,(DE)          ; fetch existing destination byte
3558
        AND     B               ; consider OVER
3559
        XOR     (HL)            ; now XOR with source
3560
        XOR     C               ; now with INVERSE MASK
3561
        LD      (DE),A          ; update screen/printer
3562
        EX      AF,AF'          ; restore flag
3563
        JR      C,L0BD3         ; to PR-ALL-6 - printer address update
3564
 
3565
        INC     D               ; gives next pixel line down screen
3566
 
3567
;; PR-ALL-5
3568
L0BC1:  INC     HL              ; address next character byte
3569
        DEC     A               ; the byte count is decremented
3570
        JR      NZ,L0BB7        ; back to PR-ALL-4 for all 8 bytes
3571
 
3572
        EX      DE,HL           ; destination to HL
3573
        DEC     H               ; bring back to last updated screen position
3574
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3575
        CALL    Z,L0BDB         ; if not, call routine PO-ATTR to update
3576
                                ; corresponding colour attribute.
3577
        POP     HL              ; restore original screen/printer position
3578
        POP     BC              ; and line column
3579
        DEC     C               ; move column to right
3580
        INC     HL              ; increase screen/printer position
3581
        RET                     ; return and continue into PO-STORE
3582
                                ; within PO-ABLE
3583
 
3584
; ---
3585
 
3586
;   This branch is used to update the printer position by 32 places
3587
;   Note. The high byte of the address D remains constant (which it should).
3588
 
3589
;; PR-ALL-6
3590
L0BD3:  EX      AF,AF'          ; save the flag
3591
        LD      A,$20           ; load A with 32 decimal
3592
        ADD     A,E             ; add this to E
3593
        LD      E,A             ; and store result in E
3594
        EX      AF,AF'          ; fetch the flag
3595
        JR      L0BC1           ; back to PR-ALL-5
3596
 
3597
; -----------------------------------
3598
; THE 'GET ATTRIBUTE ADDRESS' ROUTINE
3599
; -----------------------------------
3600
;   This routine is entered with the HL register holding the last screen
3601
;   address to be updated by PRINT or PLOT.
3602
;   The Spectrum screen arrangement leads to the L register holding the correct
3603
;   value for the attribute file and it is only necessary to manipulate H to
3604
;   form the correct colour attribute address.
3605
 
3606
;; PO-ATTR
3607
L0BDB:  LD       A,H            ; fetch high byte $40 - $57
3608
        RRCA                    ; shift
3609
        RRCA                    ; bits 3 and 4
3610
        RRCA                    ; to right.
3611
        AND     $03             ; range is now 0 - 2
3612
        OR      $58             ; form correct high byte for third of screen
3613
        LD      H,A             ; HL is now correct
3614
        LD      DE,($5C8F)      ; make D hold ATTR_T, E hold MASK-T
3615
        LD      A,(HL)          ; fetch existing attribute
3616
        XOR     E               ; apply masks
3617
        AND     D               ;
3618
        XOR     E               ;
3619
        BIT     6,(IY+$57)      ; test P_FLAG  - is this PAPER 9 ??
3620
        JR      Z,L0BFA         ; skip to PO-ATTR-1 if not.
3621
 
3622
        AND     $C7             ; set paper
3623
        BIT     2,A             ; to contrast with ink
3624
        JR      NZ,L0BFA        ; skip to PO-ATTR-1
3625
 
3626
        XOR     $38             ;
3627
 
3628
;; PO-ATTR-1
3629
L0BFA:  BIT     4,(IY+$57)      ; test P_FLAG  - Is this INK 9 ??
3630
        JR      Z,L0C08         ; skip to PO-ATTR-2 if not
3631
 
3632
        AND     $F8             ; make ink
3633
        BIT     5,A             ; contrast with paper.
3634
        JR      NZ,L0C08        ; to PO-ATTR-2
3635
 
3636
        XOR     $07             ;
3637
 
3638
;; PO-ATTR-2
3639
L0C08:  LD      (HL),A          ; save the new attribute.
3640
        RET                     ; return.
3641
 
3642
; ---------------------------------
3643
; THE 'MESSAGE PRINTING' SUBROUTINE
3644
; ---------------------------------
3645
;   This entry point is used to print tape, boot-up, scroll? and error messages.
3646
;   On entry the DE register points to an initial step-over byte or the
3647
;   inverted end-marker of the previous entry in the table.
3648
;   Register A contains the message number, often zero to print first message.
3649
;   (HL has nothing important usually P_FLAG)
3650
 
3651
;; PO-MSG
3652
L0C0A:  PUSH    HL              ; put hi-byte zero on stack to suppress
3653
        LD      H,$00           ; trailing spaces
3654
        EX      (SP),HL         ; ld h,0; push hl would have done ?.
3655
        JR      L0C14           ; forward to PO-TABLE.
3656
 
3657
; ---
3658
 
3659
;   This entry point prints the BASIC keywords, '<>' etc. from alt set
3660
 
3661
;; PO-TOKENS
3662
L0C10:  LD      DE,L0095        ; address: TKN-TABLE
3663
        PUSH    AF              ; save the token number to control
3664
                                ; trailing spaces - see later *
3665
 
3666
; ->
3667
 
3668
;; PO-TABLE
3669
L0C14:  CALL    L0C41           ; routine PO-SEARCH will set carry for
3670
                                ; all messages and function words.
3671
 
3672
        JR      C,L0C22         ; forward to PO-EACH if not a command, '<>' etc.
3673
 
3674
        LD      A,$20           ; prepare leading space
3675
        BIT     0,(IY+$01)      ; test FLAGS  - leading space if not set
3676
 
3677
        CALL    Z,L0C3B         ; routine PO-SAVE to print a space without
3678
                                ; disturbing registers.
3679
 
3680
;; PO-EACH
3681
L0C22:  LD      A,(DE)          ; Fetch character from the table.
3682
        AND     $7F             ; Cancel any inverted bit.
3683
 
3684
        CALL    L0C3B           ; Routine PO-SAVE to print using the alternate
3685
                                ; set of registers.
3686
 
3687
        LD      A,(DE)          ; Re-fetch character from table.
3688
        INC     DE              ; Address next character in the table.
3689
 
3690
        ADD     A,A             ; Was character inverted ?
3691
                                ; (this also doubles character)
3692
        JR      NC,L0C22        ; back to PO-EACH if not.
3693
 
3694
        POP     DE              ; * re-fetch trailing space byte to D
3695
 
3696
        CP      $48             ; was the last character '$' ?
3697
        JR      Z,L0C35         ; forward to PO-TR-SP to consider trailing
3698
                                ; space if so.
3699
 
3700
        CP      $82             ; was it < 'A' i.e. '#','>','=' from tokens
3701
                                ; or ' ','.' (from tape) or '?' from scroll
3702
 
3703
        RET     C               ; Return if so as no trailing space required.
3704
 
3705
;; PO-TR-SP
3706
L0C35:  LD      A,D             ; The trailing space flag (zero if an error msg)
3707
 
3708
        CP      $03             ; Test against RND, INKEY$ and PI which have no
3709
                                ; parameters and therefore no trailing space.
3710
 
3711
        RET     C               ; Return if no trailing space.
3712
 
3713
        LD      A,$20           ; Prepare the space character and continue to
3714
                                ; print and make an indirect return.
3715
 
3716
; -----------------------------------
3717
; THE 'RECURSIVE PRINTING' SUBROUTINE
3718
; -----------------------------------
3719
;   This routine which is part of PRINT-OUT allows RST $10 to be used
3720
;   recursively to print tokens and the spaces associated with them.
3721
;   It is called on three occasions when the value of DE must be preserved.
3722
 
3723
;; PO-SAVE
3724
L0C3B:  PUSH    DE              ; Save DE value.
3725
        EXX                     ; Switch in main set
3726
 
3727
        RST     10H             ; PRINT-A prints using this alternate set.
3728
 
3729
        EXX                     ; Switch back to this alternate set.
3730
        POP     DE              ; Restore the initial DE value.
3731
 
3732
        RET                     ; Return.
3733
 
3734
; ------------
3735
; Table search
3736
; ------------
3737
; This subroutine searches a message or the token table for the
3738
; message number held in A. DE holds the address of the table.
3739
 
3740
;; PO-SEARCH
3741
L0C41:  PUSH    AF              ; save the message/token number
3742
        EX      DE,HL           ; transfer DE to HL
3743
        INC     A               ; adjust for initial step-over byte
3744
 
3745
;; PO-STEP
3746
L0C44:  BIT     7,(HL)          ; is character inverted ?
3747
        INC     HL              ; address next
3748
        JR      Z,L0C44         ; back to PO-STEP if not inverted.
3749
 
3750
        DEC     A               ; decrease counter
3751
        JR      NZ,L0C44        ; back to PO-STEP if not zero
3752
 
3753
        EX      DE,HL           ; transfer address to DE
3754
        POP     AF              ; restore message/token number
3755
        CP      $20             ; return with carry set
3756
        RET     C               ; for all messages and function tokens
3757
 
3758
        LD      A,(DE)          ; test first character of token
3759
        SUB     $41             ; and return with carry set
3760
        RET                     ; if it is less that 'A'
3761
                                ; i.e. '<>', '<=', '>='
3762
 
3763
; ---------------
3764
; Test for scroll
3765
; ---------------
3766
; This test routine is called when printing carriage return, when considering
3767
; PRINT AT and from the general PRINT ALL characters routine to test if
3768
; scrolling is required, prompting the user if necessary.
3769
; This is therefore using the alternate set.
3770
; The B register holds the current line.
3771
 
3772
;; PO-SCR
3773
L0C55:  BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3774
        RET     NZ              ; return immediately if so.
3775
 
3776
        LD      DE,L0DD9        ; set DE to address: CL-SET
3777
        PUSH    DE              ; and push for return address.
3778
 
3779
        LD      A,B             ; transfer the line to A.
3780
        BIT     0,(IY+$02)      ; test TV_FLAG - lower screen in use ?
3781
        JP      NZ,L0D02        ; jump forward to PO-SCR-4 if so.
3782
 
3783
        CP      (IY+$31)        ; greater than DF_SZ display file size ?
3784
        JR      C,L0C86         ; forward to REPORT-5 if less.
3785
                                ; 'Out of screen'
3786
 
3787
        RET     NZ              ; return (via CL-SET) if greater
3788
 
3789
        BIT     4,(IY+$02)      ; test TV_FLAG  - Automatic listing ?
3790
        JR      Z,L0C88         ; forward to PO-SCR-2 if not.
3791
 
3792
        LD      E,(IY+$2D)      ; fetch BREG - the count of scroll lines to E.
3793
        DEC     E               ; decrease and jump
3794
        JR      Z,L0CD2         ; to PO-SCR-3 if zero and scrolling required.
3795
 
3796
        LD      A,$00           ; explicit - select channel zero.
3797
        CALL    L1601           ; routine CHAN-OPEN opens it.
3798
 
3799
        LD      SP,($5C3F)      ; set stack pointer to LIST_SP
3800
 
3801
        RES     4,(IY+$02)      ; reset TV_FLAG  - signal auto listing finished.
3802
        RET                     ; return ignoring pushed value, CL-SET
3803
                                ; to MAIN or EDITOR without updating
3804
                                ; print position                         >>
3805
 
3806
; ---
3807
 
3808
 
3809
;; REPORT-5
3810
L0C86:  RST     08H             ; ERROR-1
3811
        DEFB    $04             ; Error Report: Out of screen
3812
 
3813
; continue here if not an automatic listing.
3814
 
3815
;; PO-SCR-2
3816
L0C88:  DEC     (IY+$52)        ; decrease SCR_CT
3817
        JR      NZ,L0CD2        ; forward to PO-SCR-3 to scroll display if
3818
                                ; result not zero.
3819
 
3820
; now produce prompt.
3821
 
3822
        LD      A,$18           ; reset
3823
        SUB     B               ; the
3824
        LD      ($5C8C),A       ; SCR_CT scroll count
3825
        LD      HL,($5C8F)      ; L=ATTR_T, H=MASK_T
3826
        PUSH    HL              ; save on stack
3827
        LD      A,($5C91)       ; P_FLAG
3828
        PUSH    AF              ; save on stack to prevent lower screen
3829
                                ; attributes (BORDCR etc.) being applied.
3830
        LD      A,$FD           ; select system channel 'K'
3831
        CALL    L1601           ; routine CHAN-OPEN opens it
3832
        XOR     A               ; clear to address message directly
3833
        LD      DE,L0CF8        ; make DE address: scrl-mssg
3834
        CALL    L0C0A           ; routine PO-MSG prints to lower screen
3835
        SET     5,(IY+$02)      ; set TV_FLAG  - signal lower screen requires
3836
                                ; clearing
3837
        LD      HL,$5C3B        ; make HL address FLAGS
3838
        SET     3,(HL)          ; signal 'L' mode.
3839
        RES     5,(HL)          ; signal 'no new key'.
3840
        EXX                     ; switch to main set.
3841
                                ; as calling chr input from alternative set.
3842
        CALL    L15D4           ; routine WAIT-KEY waits for new key
3843
                                ; Note. this is the right routine but the
3844
                                ; stream in use is unsatisfactory. From the
3845
                                ; choices available, it is however the best.
3846
 
3847
        EXX                     ; switch back to alternate set.
3848
        CP      $20             ; space is considered as BREAK
3849
        JR      Z,L0D00         ; forward to REPORT-D if so
3850
                                ; 'BREAK - CONT repeats'
3851
 
3852
        CP      $E2             ; is character 'STOP' ?
3853
        JR      Z,L0D00         ; forward to REPORT-D if so
3854
 
3855
        OR      $20             ; convert to lower-case
3856
        CP      $6E             ; is character 'n' ?
3857
        JR      Z,L0D00         ; forward to REPORT-D if so else scroll.
3858
 
3859
        LD      A,$FE           ; select system channel 'S'
3860
        CALL    L1601           ; routine CHAN-OPEN
3861
        POP     AF              ; restore original P_FLAG
3862
        LD      ($5C91),A       ; and save in P_FLAG.
3863
        POP     HL              ; restore original ATTR_T, MASK_T
3864
        LD      ($5C8F),HL      ; and reset ATTR_T, MASK-T as 'scroll?' has
3865
                                ; been printed.
3866
 
3867
;; PO-SCR-3
3868
L0CD2:  CALL    L0DFE           ; routine CL-SC-ALL to scroll whole display
3869
        LD      B,(IY+$31)      ; fetch DF_SZ to B
3870
        INC     B               ; increase to address last line of display
3871
        LD      C,$21           ; set C to $21 (was $21 from above routine)
3872
        PUSH    BC              ; save the line and column in BC.
3873
 
3874
        CALL    L0E9B           ; routine CL-ADDR finds display address.
3875
 
3876
        LD      A,H             ; now find the corresponding attribute byte
3877
        RRCA                    ; (this code sequence is used twice
3878
        RRCA                    ; elsewhere and is a candidate for
3879
        RRCA                    ; a subroutine.)
3880
        AND     $03             ;
3881
        OR      $58             ;
3882
        LD      H,A             ;
3883
 
3884
        LD      DE,$5AE0        ; start of last 'line' of attribute area
3885
        LD      A,(DE)          ; get attribute for last line
3886
        LD      C,(HL)          ; transfer to base line of upper part
3887
        LD      B,$20           ; there are thirty two bytes
3888
        EX      DE,HL           ; swap the pointers.
3889
 
3890
;; PO-SCR-3A
3891
L0CF0:  LD      (DE),A          ; transfer
3892
        LD      (HL),C          ; attributes.
3893
        INC     DE              ; address next.
3894
        INC     HL              ; address next.
3895
        DJNZ    L0CF0           ; loop back to PO-SCR-3A for all adjacent
3896
                                ; attribute lines.
3897
 
3898
        POP     BC              ; restore the line/column.
3899
        RET                     ; return via CL-SET (was pushed on stack).
3900
 
3901
; ---
3902
 
3903
; The message 'scroll?' appears here with last byte inverted.
3904
 
3905
;; scrl-mssg
3906
L0CF8:  DEFB    $80             ; initial step-over byte.
3907
        DEFM    "scroll"
3908
        DEFB    '?'+$80
3909
 
3910
;; REPORT-D
3911
L0D00:  RST     08H             ; ERROR-1
3912
        DEFB    $0C             ; Error Report: BREAK - CONT repeats
3913
 
3914
; continue here if using lower display - A holds line number.
3915
 
3916
;; PO-SCR-4
3917
L0D02:  CP      $02             ; is line number less than 2 ?
3918
        JR      C,L0C86         ; to REPORT-5 if so
3919
                                ; 'Out of Screen'.
3920
 
3921
        ADD     A,(IY+$31)      ; add DF_SZ
3922
        SUB     $19             ;
3923
        RET     NC              ; return if scrolling unnecessary
3924
 
3925
        NEG                     ; Negate to give number of scrolls required.
3926
        PUSH    BC              ; save line/column
3927
        LD      B,A             ; count to B
3928
        LD      HL,($5C8F)      ; fetch current ATTR_T, MASK_T to HL.
3929
        PUSH    HL              ; and save
3930
        LD      HL,($5C91)      ; fetch P_FLAG
3931
        PUSH    HL              ; and save.
3932
                                ; to prevent corruption by input AT
3933
 
3934
        CALL    L0D4D           ; routine TEMPS sets to BORDCR etc
3935
        LD      A,B             ; transfer scroll number to A.
3936
 
3937
;; PO-SCR-4A
3938
L0D1C:  PUSH    AF              ; save scroll number.
3939
        LD      HL,$5C6B        ; address DF_SZ
3940
        LD      B,(HL)          ; fetch old value
3941
        LD      A,B             ; transfer to A
3942
        INC     A               ; and increment
3943
        LD      (HL),A          ; then put back.
3944
        LD      HL,$5C89        ; address S_POSN_hi - line
3945
        CP      (HL)            ; compare
3946
        JR      C,L0D2D         ; forward to PO-SCR-4B if scrolling required
3947
 
3948
        INC     (HL)            ; else increment S_POSN_hi
3949
        LD      B,$18           ; set count to whole display ??
3950
                                ; Note. should be $17 and the top line will be
3951
                                ; scrolled into the ROM which is harmless on
3952
                                ; the standard set up.
3953
                                ; credit P.Giblin 1984.
3954
 
3955
;; PO-SCR-4B
3956
L0D2D:  CALL    L0E00           ; routine CL-SCROLL scrolls B lines
3957
        POP     AF              ; restore scroll counter.
3958
        DEC     A               ; decrease
3959
        JR      NZ,L0D1C        ; back to PO-SCR-4A until done
3960
 
3961
        POP     HL              ; restore original P_FLAG.
3962
        LD      (IY+$57),L      ; and overwrite system variable P_FLAG.
3963
 
3964
        POP     HL              ; restore original ATTR_T/MASK_T.
3965
        LD      ($5C8F),HL      ; and update system variables.
3966
 
3967
        LD      BC,($5C88)      ; fetch S_POSN to BC.
3968
        RES     0,(IY+$02)      ; signal to TV_FLAG  - main screen in use.
3969
        CALL    L0DD9           ; call routine CL-SET for upper display.
3970
 
3971
        SET     0,(IY+$02)      ; signal to TV_FLAG  - lower screen in use.
3972
        POP     BC              ; restore line/column
3973
        RET                     ; return via CL-SET for lower display.
3974
 
3975
; ----------------------
3976
; Temporary colour items
3977
; ----------------------
3978
; This subroutine is called 11 times to copy the permanent colour items
3979
; to the temporary ones.
3980
 
3981
;; TEMPS
3982
L0D4D:  XOR     A               ; clear the accumulator
3983
        LD      HL,($5C8D)      ; fetch L=ATTR_P and H=MASK_P
3984
        BIT     0,(IY+$02)      ; test TV_FLAG  - is lower screen in use ?
3985
        JR      Z,L0D5B         ; skip to TEMPS-1 if not
3986
 
3987
        LD      H,A             ; set H, MASK P, to 00000000.
3988
        LD      L,(IY+$0E)      ; fetch BORDCR to L which is used for lower
3989
                                ; screen.
3990
 
3991
;; TEMPS-1
3992
L0D5B:  LD      ($5C8F),HL      ; transfer values to ATTR_T and MASK_T
3993
 
3994
; for the print flag the permanent values are odd bits, temporary even bits.
3995
 
3996
        LD      HL,$5C91        ; address P_FLAG.
3997
        JR      NZ,L0D65        ; skip to TEMPS-2 if lower screen using A=0.
3998
 
3999
        LD      A,(HL)          ; else pick up flag bits.
4000
        RRCA                    ; rotate permanent bits to temporary bits.
4001
 
4002
;; TEMPS-2
4003
L0D65:  XOR     (HL)            ;
4004
        AND     $55             ; BIN 01010101
4005
        XOR     (HL)            ; permanent now as original
4006
        LD      (HL),A          ; apply permanent bits to temporary bits.
4007
        RET                     ; and return.
4008
 
4009
; -----------------
4010
; THE 'CLS' COMMAND
4011
; -----------------
4012
;    This command clears the display.
4013
;    The routine is also called during initialization and by the CLEAR command.
4014
;    If it's difficult to write it should be difficult to read.
4015
 
4016
;; CLS
4017
L0D6B:  CALL    L0DAF           ; Routine CL-ALL clears the entire display and
4018
                                ; sets the attributes to the permanent ones
4019
                                ; from ATTR-P.
4020
 
4021
;   Having cleared all 24 lines of the display area, continue into the
4022
;   subroutine that clears the lower display area.  Note that at the moment
4023
;   the attributes for the lower lines are the same as upper ones and have
4024
;   to be changed to match the BORDER colour.
4025
 
4026
; --------------------------
4027
; THE 'CLS-LOWER' SUBROUTINE
4028
; --------------------------
4029
;   This routine is called from INPUT, and from the MAIN execution loop.
4030
;   This is very much a housekeeping routine which clears between 2 and 23
4031
;   lines of the display, setting attributes and correcting situations where
4032
;   errors have occurred while the normal input and output routines have been
4033
;   temporarily diverted to deal with, say colour control codes.
4034
 
4035
;; CLS-LOWER
4036
L0D6E:  LD      HL,$5C3C        ; address System Variable TV_FLAG.
4037
        RES     5,(HL)          ; TV_FLAG - signal do not clear lower screen.
4038
        SET     0,(HL)          ; TV_FLAG - signal lower screen in use.
4039
 
4040
        CALL    L0D4D           ; routine TEMPS applies permanent attributes,
4041
                                ; in this case BORDCR to ATTR_T.
4042
                                ; Note. this seems unnecessary and is repeated
4043
                                ; within CL-LINE.
4044
 
4045
        LD      B,(IY+$31)      ; fetch lower screen display file size DF_SZ
4046
 
4047
        CALL    L0E44           ; routine CL-LINE clears lines to bottom of the
4048
                                ; display and sets attributes from BORDCR while
4049
                                ; preserving the B register.
4050
 
4051
        LD      HL,$5AC0        ; set initial attribute address to the leftmost
4052
                                ; cell of second line up.
4053
 
4054
        LD      A,($5C8D)       ; fetch permanent attribute from ATTR_P.
4055
 
4056
        DEC     B               ; decrement lower screen display file size.
4057
 
4058
        JR      L0D8E           ; forward to enter the backfill loop at CLS-3
4059
                                ; where B is decremented again.
4060
 
4061
; ---
4062
 
4063
;   The backfill loop is entered at midpoint and ensures, if more than 2
4064
;   lines have been cleared, that any other lines take the permanent screen
4065
;   attributes.
4066
 
4067
;; CLS-1
4068
L0D87:  LD      C,$20           ; set counter to 32 character cells per line
4069
 
4070
;; CLS-2
4071
L0D89:  DEC     HL              ; decrease attribute address.
4072
        LD      (HL),A          ; and place attributes in next line up.
4073
        DEC     C               ; decrease the 32 counter.
4074
        JR      NZ,L0D89        ; loop back to CLS-2 until all 32 cells done.
4075
 
4076
;; CLS-3
4077
L0D8E:  DJNZ    L0D87           ; decrease B counter and back to CLS-1
4078
                                ; if not zero.
4079
 
4080
        LD      (IY+$31),$02    ; now set DF_SZ lower screen to 2
4081
 
4082
; This entry point is also called from CL-ALL below to
4083
; reset the system channel input and output addresses to normal.
4084
 
4085
;; CL-CHAN
4086
L0D94:  LD      A,$FD           ; select system channel 'K'
4087
 
4088
        CALL    L1601           ; routine CHAN-OPEN opens it.
4089
 
4090
        LD      HL,($5C51)      ; fetch CURCHL to HL to address current channel
4091
        LD      DE,L09F4        ; set address to PRINT-OUT for first pass.
4092
        AND     A               ; clear carry for first pass.
4093
 
4094
;; CL-CHAN-A
4095
L0DA0:  LD      (HL),E          ; Insert the output address on the first pass
4096
        INC     HL              ; or the input address on the second pass.
4097
        LD      (HL),D          ;
4098
        INC     HL              ;
4099
 
4100
        LD      DE,L10A8        ; fetch address KEY-INPUT for second pass
4101
        CCF                     ; complement carry flag - will set on pass 1.
4102
 
4103
        JR      C,L0DA0         ; back to CL-CHAN-A if first pass else done.
4104
 
4105
        LD      BC,$1721        ; line 23 for lower screen
4106
        JR      L0DD9           ; exit via CL-SET to set column
4107
                                ; for lower display
4108
 
4109
; ---------------------------
4110
; Clearing whole display area
4111
; ---------------------------
4112
; This subroutine called from CLS, AUTO-LIST and MAIN-3
4113
; clears 24 lines of the display and resets the relevant system variables.
4114
; This routine also recovers from an error situation where, for instance, an
4115
; invalid colour or position control code has left the output routine addressing
4116
; PO-TV-2 or PO-CONT.
4117
 
4118
;; CL-ALL
4119
L0DAF:  LD      HL,$0000        ; Initialize plot coordinates.
4120
        LD      ($5C7D),HL      ; Set system variable COORDS to 0,0.
4121
 
4122
        RES     0,(IY+$30)      ; update FLAGS2  - signal main screen is clear.
4123
 
4124
        CALL    L0D94           ; routine CL-CHAN makes channel 'K' 'normal'.
4125
 
4126
        LD      A,$FE           ; select system channel 'S'
4127
        CALL    L1601           ; routine CHAN-OPEN opens it.
4128
 
4129
        CALL    L0D4D           ; routine TEMPS applies permanent attributes,
4130
                                ; in this case ATTR_P, to ATTR_T.
4131
                                ; Note. this seems unnecessary.
4132
 
4133
        LD      B,$18           ; There are 24 lines.
4134
 
4135
        CALL    L0E44           ; routine CL-LINE clears 24 text lines and sets
4136
                                ; attributes from ATTR-P.
4137
                                ; This routine preserves B and sets C to $21.
4138
 
4139
        LD      HL,($5C51)      ; fetch CURCHL make HL address output routine.
4140
 
4141
        LD      DE,L09F4        ; address: PRINT-OUT
4142
        LD      (HL),E          ; is made
4143
        INC     HL              ; the normal
4144
        LD      (HL),D          ; output address.
4145
 
4146
        LD      (IY+$52),$01    ; set SCR_CT - scroll count - to default.
4147
 
4148
;   Note. BC already contains $1821.
4149
 
4150
        LD      BC,$1821        ; reset column and line to 0,0
4151
                                ; and continue into CL-SET, below, exiting
4152
                                ; via PO-STORE (for the upper screen).
4153
 
4154
; --------------------
4155
; THE 'CL-SET' ROUTINE
4156
; --------------------
4157
; This important subroutine is used to calculate the character output
4158
; address for screens or printer based on the line/column for screens
4159
; or the column for printer.
4160
 
4161
;; CL-SET
4162
L0DD9:  LD      HL,$5B00        ; the base address of printer buffer
4163
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
4164
        JR      NZ,L0DF4        ; forward to CL-SET-2 if so.
4165
 
4166
        LD      A,B             ; transfer line to A.
4167
        BIT     0,(IY+$02)      ; test TV_FLAG  - lower screen in use ?
4168
        JR      Z,L0DEE         ; skip to CL-SET-1 if handling upper part
4169
 
4170
        ADD     A,(IY+$31)      ; add DF_SZ for lower screen
4171
        SUB     $18             ; and adjust.
4172
 
4173
;; CL-SET-1
4174
L0DEE:  PUSH    BC              ; save the line/column.
4175
        LD      B,A             ; transfer line to B
4176
                                ; (adjusted if lower screen)
4177
 
4178
        CALL    L0E9B           ; routine CL-ADDR calculates address at left
4179
                                ; of screen.
4180
        POP     BC              ; restore the line/column.
4181
 
4182
;; CL-SET-2
4183
L0DF4:  LD      A,$21           ; the column $01-$21 is reversed
4184
        SUB     C               ; to range $00 - $20
4185
        LD      E,A             ; now transfer to DE
4186
        LD      D,$00           ; prepare for addition
4187
        ADD     HL,DE           ; and add to base address
4188
 
4189
        JP      L0ADC           ; exit via PO-STORE to update the relevant
4190
                                ; system variables.
4191
; ----------------
4192
; Handle scrolling
4193
; ----------------
4194
; The routine CL-SC-ALL is called once from PO to scroll all the display
4195
; and from the routine CL-SCROLL, once, to scroll part of the display.
4196
 
4197
;; CL-SC-ALL
4198
L0DFE:  LD      B,$17           ; scroll 23 lines, after 'scroll?'.
4199
 
4200
;; CL-SCROLL
4201
L0E00:  CALL    L0E9B           ; routine CL-ADDR gets screen address in HL.
4202
        LD      C,$08           ; there are 8 pixel lines to scroll.
4203
 
4204
;; CL-SCR-1
4205
L0E05:  PUSH    BC              ; save counters.
4206
        PUSH    HL              ; and initial address.
4207
        LD      A,B             ; get line count.
4208
        AND     $07             ; will set zero if all third to be scrolled.
4209
        LD      A,B             ; re-fetch the line count.
4210
        JR      NZ,L0E19        ; forward to CL-SCR-3 if partial scroll.
4211
 
4212
; HL points to top line of third and must be copied to bottom of previous 3rd.
4213
; ( so HL = $4800 or $5000 ) ( but also sometimes $4000 )
4214
 
4215
;; CL-SCR-2
4216
L0E0D:  EX      DE,HL           ; copy HL to DE.
4217
        LD      HL,$F8E0        ; subtract $08 from H and add $E0 to L -
4218
        ADD     HL,DE           ; to make destination bottom line of previous
4219
                                ; third.
4220
        EX      DE,HL           ; restore the source and destination.
4221
        LD      BC,$0020        ; thirty-two bytes are to be copied.
4222
        DEC     A               ; decrement the line count.
4223
        LDIR                    ; copy a pixel line to previous third.
4224
 
4225
;; CL-SCR-3
4226
L0E19:  EX      DE,HL           ; save source in DE.
4227
        LD      HL,$FFE0        ; load the value -32.
4228
        ADD     HL,DE           ; add to form destination in HL.
4229
        EX      DE,HL           ; switch source and destination
4230
        LD      B,A             ; save the count in B.
4231
        AND     $07             ; mask to find count applicable to current
4232
        RRCA                    ; third and
4233
        RRCA                    ; multiply by
4234
        RRCA                    ; thirty two (same as 5 RLCAs)
4235
 
4236
        LD      C,A             ; transfer byte count to C ($E0 at most)
4237
        LD      A,B             ; store line count to A
4238
        LD      B,$00           ; make B zero
4239
        LDIR                    ; copy bytes (BC=0, H incremented, L=0)
4240
        LD      B,$07           ; set B to 7, C is zero.
4241
        ADD     HL,BC           ; add 7 to H to address next third.
4242
        AND     $F8             ; has last third been done ?
4243
        JR      NZ,L0E0D        ; back to CL-SCR-2 if not.
4244
 
4245
        POP     HL              ; restore topmost address.
4246
        INC     H               ; next pixel line down.
4247
        POP     BC              ; restore counts.
4248
        DEC     C               ; reduce pixel line count.
4249
        JR      NZ,L0E05        ; back to CL-SCR-1 if all eight not done.
4250
 
4251
        CALL    L0E88           ; routine CL-ATTR gets address in attributes
4252
                                ; from current 'ninth line', count in BC.
4253
 
4254
        LD      HL,$FFE0        ; set HL to the 16-bit value -32.
4255
        ADD     HL,DE           ; and add to form destination address.
4256
        EX      DE,HL           ; swap source and destination addresses.
4257
        LDIR                    ; copy bytes scrolling the linear attributes.
4258
        LD      B,$01           ; continue to clear the bottom line.
4259
 
4260
; ------------------------------
4261
; THE 'CLEAR TEXT LINES' ROUTINE
4262
; ------------------------------
4263
; This subroutine, called from CL-ALL, CLS-LOWER and AUTO-LIST and above,
4264
; clears text lines at bottom of display.
4265
; The B register holds on entry the number of lines to be cleared 1-24.
4266
 
4267
;; CL-LINE
4268
L0E44:  PUSH    BC              ; save line count
4269
        CALL    L0E9B           ; routine CL-ADDR gets top address
4270
        LD      C,$08           ; there are eight screen lines to a text line.
4271
 
4272
;; CL-LINE-1
4273
L0E4A:  PUSH    BC              ; save pixel line count
4274
        PUSH    HL              ; and save the address
4275
        LD      A,B             ; transfer the line to A (1-24).
4276
 
4277
;; CL-LINE-2
4278
L0E4D:  AND     $07             ; mask 0-7 to consider thirds at a time
4279
        RRCA                    ; multiply
4280
        RRCA                    ; by 32  (same as five RLCA instructions)
4281
        RRCA                    ; now 32 - 256(0)
4282
        LD      C,A             ; store result in C
4283
        LD      A,B             ; save line in A (1-24)
4284
        LD      B,$00           ; set high byte to 0, prepare for ldir.
4285
        DEC     C               ; decrement count 31-255.
4286
        LD      D,H             ; copy HL
4287
        LD      E,L             ; to DE.
4288
        LD      (HL),$00        ; blank the first byte.
4289
        INC     DE              ; make DE point to next byte.
4290
        LDIR                    ; ldir will clear lines.
4291
        LD      DE,$0701        ; now address next third adjusting
4292
        ADD     HL,DE           ; register E to address left hand side
4293
        DEC     A               ; decrease the line count.
4294
        AND     $F8             ; will be 16, 8 or 0  (AND $18 will do).
4295
        LD      B,A             ; transfer count to B.
4296
        JR      NZ,L0E4D        ; back to CL-LINE-2 if 16 or 8 to do
4297
                                ; the next third.
4298
 
4299
        POP     HL              ; restore start address.
4300
        INC     H               ; address next line down.
4301
        POP     BC              ; fetch counts.
4302
        DEC     C               ; decrement pixel line count
4303
        JR      NZ,L0E4A        ; back to CL-LINE-1 till all done.
4304
 
4305
        CALL    L0E88           ; routine CL-ATTR gets attribute address
4306
                                ; in DE and B * 32 in BC.
4307
 
4308
        LD      H,D             ; transfer the address
4309
        LD      L,E             ; to HL.
4310
 
4311
        INC     DE              ; make DE point to next location.
4312
 
4313
        LD      A,($5C8D)       ; fetch ATTR_P - permanent attributes
4314
        BIT     0,(IY+$02)      ; test TV_FLAG  - lower screen in use ?
4315
        JR      Z,L0E80         ; skip to CL-LINE-3 if not.
4316
 
4317
        LD      A,($5C48)       ; else lower screen uses BORDCR as attribute.
4318
 
4319
;; CL-LINE-3
4320
L0E80:  LD      (HL),A          ; put attribute in first byte.
4321
        DEC     BC              ; decrement the counter.
4322
        LDIR                    ; copy bytes to set all attributes.
4323
        POP     BC              ; restore the line $01-$24.
4324
        LD      C,$21           ; make column $21. (No use is made of this)
4325
        RET                     ; return to the calling routine.
4326
 
4327
; ------------------
4328
; Attribute handling
4329
; ------------------
4330
; This subroutine is called from CL-LINE or CL-SCROLL with the HL register
4331
; pointing to the 'ninth' line and H needs to be decremented before or after
4332
; the division. Had it been done first then either present code or that used
4333
; at the start of PO-ATTR could have been used.
4334
; The Spectrum screen arrangement leads to the L register already holding
4335
; the correct value for the attribute file and it is only necessary
4336
; to manipulate H to form the correct colour attribute address.
4337
 
4338
;; CL-ATTR
4339
L0E88:  LD      A,H             ; fetch H to A - $48, $50, or $58.
4340
        RRCA                    ; divide by
4341
        RRCA                    ; eight.
4342
        RRCA                    ; $09, $0A or $0B.
4343
        DEC     A               ; $08, $09 or $0A.
4344
        OR      $50             ; $58, $59 or $5A.
4345
        LD      H,A             ; save high byte of attributes.
4346
 
4347
        EX      DE,HL           ; transfer attribute address to DE
4348
        LD      H,C             ; set H to zero - from last LDIR.
4349
        LD      L,B             ; load L with the line from B.
4350
        ADD     HL,HL           ; multiply
4351
        ADD     HL,HL           ; by
4352
        ADD     HL,HL           ; thirty two
4353
        ADD     HL,HL           ; to give count of attribute
4354
        ADD     HL,HL           ; cells to the end of display.
4355
 
4356
        LD      B,H             ; transfer the result
4357
        LD      C,L             ; to register BC.
4358
 
4359
        RET                     ; return.
4360
 
4361
; -------------------------------
4362
; Handle display with line number
4363
; -------------------------------
4364
; This subroutine is called from four places to calculate the address
4365
; of the start of a screen character line which is supplied in B.
4366
 
4367
;; CL-ADDR
4368
L0E9B:  LD      A,$18           ; reverse the line number
4369
        SUB     B               ; to range $00 - $17.
4370
        LD      D,A             ; save line in D for later.
4371
        RRCA                    ; multiply
4372
        RRCA                    ; by
4373
        RRCA                    ; thirty-two.
4374
 
4375
        AND     $E0             ; mask off low bits to make
4376
        LD      L,A             ; L a multiple of 32.
4377
 
4378
        LD      A,D             ; bring back the line to A.
4379
 
4380
        AND     $18             ; now $00, $08 or $10.
4381
 
4382
        OR      $40             ; add the base address of screen.
4383
 
4384
        LD      H,A             ; HL now has the correct address.
4385
        RET                     ; return.
4386
 
4387
; -------------------
4388
; Handle COPY command
4389
; -------------------
4390
; This command copies the top 176 lines to the ZX Printer
4391
; It is popular to call this from machine code at point
4392
; L0EAF with B holding 192 (and interrupts disabled) for a full-screen
4393
; copy. This particularly applies to 16K Spectrums as time-critical
4394
; machine code routines cannot be written in the first 16K of RAM as
4395
; it is shared with the ULA which has precedence over the Z80 chip.
4396
 
4397
;; COPY
4398
L0EAC:  DI                      ; disable interrupts as this is time-critical.
4399
 
4400
        LD      B,$B0           ; top 176 lines.
4401
L0EAF:  LD      HL,$4000        ; address start of the display file.
4402
 
4403
; now enter a loop to handle each pixel line.
4404
 
4405
;; COPY-1
4406
L0EB2:  PUSH    HL              ; save the screen address.
4407
        PUSH    BC              ; and the line counter.
4408
 
4409
        CALL    L0EF4           ; routine COPY-LINE outputs one line.
4410
 
4411
        POP     BC              ; restore the line counter.
4412
        POP     HL              ; and display address.
4413
        INC     H               ; next line down screen within 'thirds'.
4414
        LD      A,H             ; high byte to A.
4415
        AND     $07             ; result will be zero if we have left third.
4416
        JR      NZ,L0EC9        ; forward to COPY-2 if not to continue loop.
4417
 
4418
        LD      A,L             ; consider low byte first.
4419
        ADD     A,$20           ; increase by 32 - sets carry if back to zero.
4420
        LD      L,A             ; will be next group of 8.
4421
        CCF                     ; complement - carry set if more lines in
4422
                                ; the previous third.
4423
        SBC     A,A             ; will be FF, if more, else 00.
4424
        AND     $F8             ; will be F8 (-8) or 00.
4425
        ADD     A,H             ; that is subtract 8, if more to do in third.
4426
        LD      H,A             ; and reset address.
4427
 
4428
;; COPY-2
4429
L0EC9:  DJNZ    L0EB2           ; back to COPY-1 for all lines.
4430
 
4431
        JR      L0EDA           ; forward to COPY-END to switch off the printer
4432
                                ; motor and enable interrupts.
4433
                                ; Note. Nothing else is required.
4434
 
4435
; ------------------------------
4436
; Pass printer buffer to printer
4437
; ------------------------------
4438
; This routine is used to copy 8 text lines from the printer buffer
4439
; to the ZX Printer. These text lines are mapped linearly so HL does
4440
; not need to be adjusted at the end of each line.
4441
 
4442
;; COPY-BUFF
4443
L0ECD:  DI                      ; disable interrupts
4444
        LD      HL,$5B00        ; the base address of the Printer Buffer.
4445
        LD      B,$08           ; set count to 8 lines of 32 bytes.
4446
 
4447
;; COPY-3
4448
L0ED3:  PUSH    BC              ; save counter.
4449
 
4450
        CALL    L0EF4           ; routine COPY-LINE outputs 32 bytes
4451
 
4452
        POP     BC              ; restore counter.
4453
        DJNZ    L0ED3           ; loop back to COPY-3 for all 8 lines.
4454
                                ; then stop motor and clear buffer.
4455
 
4456
; Note. the COPY command rejoins here, essentially to execute the next
4457
; three instructions.
4458
 
4459
;; COPY-END
4460
L0EDA:  LD      A,$04           ; output value 4 to port
4461
        OUT     ($FB),A         ; to stop the slowed printer motor.
4462
        EI                      ; enable interrupts.
4463
 
4464
; --------------------
4465
; Clear Printer Buffer
4466
; --------------------
4467
; This routine clears an arbitrary 256 bytes of memory.
4468
; Note. The routine seems designed to clear a buffer that follows the
4469
; system variables.
4470
; The routine should check a flag or HL address and simply return if COPY
4471
; is in use.
4472
; As a consequence of this omission the buffer will needlessly
4473
; be cleared when COPY is used and the screen/printer position may be set to
4474
; the start of the buffer and the line number to 0 (B)
4475
; giving an 'Out of Screen' error.
4476
; There seems to have been an unsuccessful attempt to circumvent the use
4477
; of PR_CC_hi.
4478
 
4479
;; CLEAR-PRB
4480
L0EDF:  LD      HL,$5B00        ; the location of the buffer.
4481
        LD      (IY+$46),L      ; update PR_CC_lo - set to zero - superfluous.
4482
        XOR     A               ; clear the accumulator.
4483
        LD      B,A             ; set count to 256 bytes.
4484
 
4485
;; PRB-BYTES
4486
L0EE7:  LD      (HL),A          ; set addressed location to zero.
4487
        INC     HL              ; address next byte - Note. not INC L.
4488
        DJNZ    L0EE7           ; back to PRB-BYTES. repeat for 256 bytes.
4489
 
4490
        RES     1,(IY+$30)      ; set FLAGS2 - signal printer buffer is clear.
4491
        LD      C,$21           ; set the column position .
4492
        JP      L0DD9           ; exit via CL-SET and then PO-STORE.
4493
 
4494
; -----------------
4495
; Copy line routine
4496
; -----------------
4497
; This routine is called from COPY and COPY-BUFF to output a line of
4498
; 32 bytes to the ZX Printer.
4499
; Output to port $FB -
4500
; bit 7 set - activate stylus.
4501
; bit 7 low - deactivate stylus.
4502
; bit 2 set - stops printer.
4503
; bit 2 reset - starts printer
4504
; bit 1 set - slows printer.
4505
; bit 1 reset - normal speed.
4506
 
4507
;; COPY-LINE
4508
L0EF4:  LD      A,B             ; fetch the counter 1-8 or 1-176
4509
        CP      $03             ; is it 01 or 02 ?.
4510
        SBC     A,A             ; result is $FF if so else $00.
4511
        AND     $02             ; result is 02 now else 00.
4512
                                ; bit 1 set slows the printer.
4513
        OUT     ($FB),A         ; slow the printer for the
4514
                                ; last two lines.
4515
        LD      D,A             ; save the mask to control the printer later.
4516
 
4517
;; COPY-L-1
4518
L0EFD:  CALL    L1F54           ; call BREAK-KEY to read keyboard immediately.
4519
        JR      C,L0F0C         ; forward to COPY-L-2 if 'break' not pressed.
4520
 
4521
        LD      A,$04           ; else stop the
4522
        OUT     ($FB),A         ; printer motor.
4523
        EI                      ; enable interrupts.
4524
        CALL    L0EDF           ; call routine CLEAR-PRB.
4525
                                ; Note. should not be cleared if COPY in use.
4526
 
4527
;; REPORT-Dc
4528
L0F0A:  RST     08H             ; ERROR-1
4529
        DEFB    $0C             ; Error Report: BREAK - CONT repeats
4530
 
4531
;; COPY-L-2
4532
L0F0C:  IN      A,($FB)         ; test now to see if
4533
        ADD     A,A             ; a printer is attached.
4534
        RET     M               ; return if not - but continue with parent
4535
                                ; command.
4536
 
4537
        JR      NC,L0EFD        ; back to COPY-L-1 if stylus of printer not
4538
                                ; in position.
4539
 
4540
        LD      C,$20           ; set count to 32 bytes.
4541
 
4542
;; COPY-L-3
4543
L0F14:  LD      E,(HL)          ; fetch a byte from line.
4544
        INC     HL              ; address next location. Note. not INC L.
4545
        LD      B,$08           ; count the bits.
4546
 
4547
;; COPY-L-4
4548
L0F18:  RL      D               ; prepare mask to receive bit.
4549
        RL      E               ; rotate leftmost print bit to carry
4550
        RR      D               ; and back to bit 7 of D restoring bit 1
4551
 
4552
;; COPY-L-5
4553
L0F1E:  IN      A,($FB)         ; read the port.
4554
        RRA                     ; bit 0 to carry.
4555
        JR      NC,L0F1E        ; back to COPY-L-5 if stylus not in position.
4556
 
4557
        LD      A,D             ; transfer command bits to A.
4558
        OUT     ($FB),A         ; and output to port.
4559
        DJNZ    L0F18           ; loop back to COPY-L-4 for all 8 bits.
4560
 
4561
        DEC     C               ; decrease the byte count.
4562
        JR      NZ,L0F14        ; back to COPY-L-3 until 256 bits done.
4563
 
4564
        RET                     ; return to calling routine COPY/COPY-BUFF.
4565
 
4566
 
4567
; ----------------------------------
4568
; Editor routine for BASIC and INPUT
4569
; ----------------------------------
4570
; The editor is called to prepare or edit a BASIC line.
4571
; It is also called from INPUT to input a numeric or string expression.
4572
; The behaviour and options are quite different in the various modes
4573
; and distinguished by bit 5 of FLAGX.
4574
;
4575
; This is a compact and highly versatile routine.
4576
 
4577
;; EDITOR
4578
L0F2C:  LD      HL,($5C3D)      ; fetch ERR_SP
4579
        PUSH    HL              ; save on stack
4580
 
4581
;; ED-AGAIN
4582
L0F30:  LD      HL,L107F        ; address: ED-ERROR
4583
        PUSH    HL              ; save address on stack and
4584
        LD      ($5C3D),SP      ; make ERR_SP point to it.
4585
 
4586
; Note. While in editing/input mode should an error occur then RST 08 will
4587
; update X_PTR to the location reached by CH_ADD and jump to ED-ERROR
4588
; where the error will be cancelled and the loop begin again from ED-AGAIN
4589
; above. The position of the error will be apparent when the lower screen is
4590
; reprinted. If no error then the re-iteration is to ED-LOOP below when
4591
; input is arriving from the keyboard.
4592
 
4593
;; ED-LOOP
4594
L0F38:  CALL    L15D4           ; routine WAIT-KEY gets key possibly
4595
                                ; changing the mode.
4596
        PUSH    AF              ; save key.
4597
        LD      D,$00           ; and give a short click based
4598
        LD      E,(IY-$01)      ; on PIP value for duration.
4599
        LD      HL,$00C8        ; and pitch.
4600
        CALL    L03B5           ; routine BEEPER gives click - effective
4601
                                ; with rubber keyboard.
4602
        POP     AF              ; get saved key value.
4603
        LD      HL,L0F38        ; address: ED-LOOP is loaded to HL.
4604
        PUSH    HL              ; and pushed onto stack.
4605
 
4606
; At this point there is a looping return address on the stack, an error
4607
; handler and an input stream set up to supply characters.
4608
; The character that has been received can now be processed.
4609
 
4610
        CP      $18             ; range 24 to 255 ?
4611
        JR      NC,L0F81        ; forward to ADD-CHAR if so.
4612
 
4613
        CP      $07             ; lower than 7 ?
4614
        JR      C,L0F81         ; forward to ADD-CHAR also.
4615
                                ; Note. This is a 'bug' and chr$ 6, the comma
4616
                                ; control character, should have had an
4617
                                ; entry in the ED-KEYS table.
4618
                                ; Steven Vickers, 1984, Pitman.
4619
 
4620
        CP      $10             ; less than 16 ?
4621
        JR      C,L0F92         ; forward to ED-KEYS if editing control
4622
                                ; range 7 to 15 dealt with by a table
4623
 
4624
        LD      BC,$0002        ; prepare for ink/paper etc.
4625
        LD      D,A             ; save character in D
4626
        CP      $16             ; is it ink/paper/bright etc. ?
4627
        JR      C,L0F6C         ; forward to ED-CONTR if so
4628
 
4629
                                ; leaves 22d AT and 23d TAB
4630
                                ; which can't be entered via KEY-INPUT.
4631
                                ; so this code is never normally executed
4632
                                ; when the keyboard is used for input.
4633
 
4634
        INC     BC              ; if it was AT/TAB - 3 locations required
4635
        BIT     7,(IY+$37)      ; test FLAGX  - Is this INPUT LINE ?
4636
        JP      Z,L101E         ; jump to ED-IGNORE if not, else
4637
 
4638
        CALL    L15D4           ; routine WAIT-KEY - input address is KEY-NEXT
4639
                                ; but is reset to KEY-INPUT
4640
        LD      E,A             ; save first in E
4641
 
4642
;; ED-CONTR
4643
L0F6C:  CALL    L15D4           ; routine WAIT-KEY for control.
4644
                                ; input address will be key-next.
4645
 
4646
        PUSH    DE              ; saved code/parameters
4647
        LD      HL,($5C5B)      ; fetch address of keyboard cursor from K_CUR
4648
        RES     0,(IY+$07)      ; set MODE to 'L'
4649
 
4650
        CALL    L1655           ; routine MAKE-ROOM makes 2/3 spaces at cursor
4651
 
4652
        POP     BC              ; restore code/parameters
4653
        INC     HL              ; address first location
4654
        LD      (HL),B          ; place code (ink etc.)
4655
        INC     HL              ; address next
4656
        LD      (HL),C          ; place possible parameter. If only one
4657
                                ; then DE points to this location also.
4658
        JR      L0F8B           ; forward to ADD-CH-1
4659
 
4660
; ------------------------
4661
; Add code to current line
4662
; ------------------------
4663
; this is the branch used to add normal non-control characters
4664
; with ED-LOOP as the stacked return address.
4665
; it is also the OUTPUT service routine for system channel 'R'.
4666
 
4667
;; ADD-CHAR
4668
L0F81:  RES     0,(IY+$07)      ; set MODE to 'L'
4669
 
4670
X0F85:  LD      HL,($5C5B)      ; fetch address of keyboard cursor from K_CUR
4671
 
4672
        CALL    L1652           ; routine ONE-SPACE creates one space.
4673
 
4674
; either a continuation of above or from ED-CONTR with ED-LOOP on stack.
4675
 
4676
;; ADD-CH-1
4677
L0F8B:  LD      (DE),A          ; load current character to last new location.
4678
        INC     DE              ; address next
4679
        LD      ($5C5B),DE      ; and update K_CUR system variable.
4680
        RET                     ; return - either a simple return
4681
                                ; from ADD-CHAR or to ED-LOOP on stack.
4682
 
4683
; ---
4684
 
4685
; a branch of the editing loop to deal with control characters
4686
; using a look-up table.
4687
 
4688
;; ED-KEYS
4689
L0F92:  LD      E,A             ; character to E.
4690
        LD      D,$00           ; prepare to add.
4691
        LD      HL,L0FA0 - 7    ; base address of editing keys table. $0F99
4692
        ADD     HL,DE           ; add E
4693
        LD      E,(HL)          ; fetch offset to E
4694
        ADD     HL,DE           ; add offset for address of handling routine.
4695
        PUSH    HL              ; push the address on machine stack.
4696
        LD      HL,($5C5B)      ; load address of cursor from K_CUR.
4697
        RET                     ; Make an indirect jump forward to routine.
4698
 
4699
; ------------------
4700
; Editing keys table
4701
; ------------------
4702
; For each code in the range $07 to $0F this table contains a
4703
; single offset byte to the routine that services that code.
4704
; Note. for what was intended there should also have been an
4705
; entry for chr$ 6 with offset to ed-symbol.
4706
 
4707
;; ed-keys-t
4708
L0FA0:  DEFB    L0FA9 - $  ; 07d offset $09 to Address: ED-EDIT
4709
        DEFB    L1007 - $  ; 08d offset $66 to Address: ED-LEFT
4710
        DEFB    L100C - $  ; 09d offset $6A to Address: ED-RIGHT
4711
        DEFB    L0FF3 - $  ; 10d offset $50 to Address: ED-DOWN
4712
        DEFB    L1059 - $  ; 11d offset $B5 to Address: ED-UP
4713
        DEFB    L1015 - $  ; 12d offset $70 to Address: ED-DELETE
4714
        DEFB    L1024 - $  ; 13d offset $7E to Address: ED-ENTER
4715
        DEFB    L1076 - $  ; 14d offset $CF to Address: ED-SYMBOL
4716
        DEFB    L107C - $  ; 15d offset $D4 to Address: ED-GRAPH
4717
 
4718
; ---------------
4719
; Handle EDIT key
4720
; ---------------
4721
; The user has pressed SHIFT 1 to bring edit line down to bottom of screen.
4722
; Alternatively the user wishes to clear the input buffer and start again.
4723
; Alternatively ...
4724
 
4725
;; ED-EDIT
4726
L0FA9:  LD      HL,($5C49)      ; fetch E_PPC the last line number entered.
4727
                                ; Note. may not exist and may follow program.
4728
        BIT     5,(IY+$37)      ; test FLAGX  - input mode ?
4729
        JP      NZ,L1097        ; jump forward to CLEAR-SP if not in editor.
4730
 
4731
        CALL    L196E           ; routine LINE-ADDR to find address of line
4732
                                ; or following line if it doesn't exist.
4733
        CALL    L1695           ; routine LINE-NO will get line number from
4734
                                ; address or previous line if at end-marker.
4735
        LD      A,D             ; if there is no program then DE will
4736
        OR      E               ; contain zero so test for this.
4737
        JP      Z,L1097         ; jump to CLEAR-SP if so.
4738
 
4739
; Note. at this point we have a validated line number, not just an
4740
; approximation and it would be best to update E_PPC with the true
4741
; cursor line value which would enable the line cursor to be suppressed
4742
; in all situations - see shortly.
4743
 
4744
        PUSH    HL              ; save address of line.
4745
        INC     HL              ; address low byte of length.
4746
        LD      C,(HL)          ; transfer to C
4747
        INC     HL              ; next to high byte
4748
        LD      B,(HL)          ; transfer to B.
4749
        LD      HL,$000A        ; an overhead of ten bytes
4750
        ADD     HL,BC           ; is added to length.
4751
        LD      B,H             ; transfer adjusted value
4752
        LD      C,L             ; to BC register.
4753
        CALL    L1F05           ; routine TEST-ROOM checks free memory.
4754
        CALL    L1097           ; routine CLEAR-SP clears editing area.
4755
        LD      HL,($5C51)      ; address CURCHL
4756
        EX      (SP),HL         ; swap with line address on stack
4757
        PUSH    HL              ; save line address underneath
4758
 
4759
        LD      A,$FF           ; select system channel 'R'
4760
        CALL    L1601           ; routine CHAN-OPEN opens it
4761
 
4762
        POP     HL              ; drop line address
4763
        DEC     HL              ; make it point to first byte of line num.
4764
        DEC     (IY+$0F)        ; decrease E_PPC_lo to suppress line cursor.
4765
                                ; Note. ineffective when E_PPC is one
4766
                                ; greater than last line of program perhaps
4767
                                ; as a result of a delete.
4768
                                ; credit. Paul Harrison 1982.
4769
 
4770
        CALL    L1855           ; routine OUT-LINE outputs the BASIC line
4771
                                ; to the editing area.
4772
        INC     (IY+$0F)        ; restore E_PPC_lo to the previous value.
4773
        LD      HL,($5C59)      ; address E_LINE in editing area.
4774
        INC     HL              ; advance
4775
        INC     HL              ; past space
4776
        INC     HL              ; and digit characters
4777
        INC     HL              ; of line number.
4778
 
4779
        LD      ($5C5B),HL      ; update K_CUR to address start of BASIC.
4780
        POP     HL              ; restore the address of CURCHL.
4781
        CALL    L1615           ; routine CHAN-FLAG sets flags for it.
4782
 
4783
        RET                     ; RETURN to ED-LOOP.
4784
 
4785
; -------------------
4786
; Cursor down editing
4787
; -------------------
4788
;   The BASIC lines are displayed at the top of the screen and the user
4789
;   wishes to move the cursor down one line in edit mode.
4790
;   With INPUT LINE, this key must be used instead of entering STOP.
4791
 
4792
;; ED-DOWN
4793
L0FF3:  BIT     5,(IY+$37)      ; test FLAGX  - Input Mode ?
4794
        JR      NZ,L1001        ; skip to ED-STOP if so
4795
 
4796
        LD      HL,$5C49        ; address E_PPC - 'current line'
4797
        CALL    L190F           ; routine LN-FETCH fetches number of next
4798
                                ; line or same if at end of program.
4799
        JR      L106E           ; forward to ED-LIST to produce an
4800
                                ; automatic listing.
4801
 
4802
; ---
4803
 
4804
;; ED-STOP
4805
L1001:  LD      (IY+$00),$10    ; set ERR_NR to 'STOP in INPUT' code
4806
        JR      L1024           ; forward to ED-ENTER to produce error.
4807
 
4808
; -------------------
4809
; Cursor left editing
4810
; -------------------
4811
; This acts on the cursor in the lower section of the screen in both
4812
; editing and input mode.
4813
 
4814
;; ED-LEFT
4815
L1007:  CALL    L1031           ; routine ED-EDGE moves left if possible
4816
        JR      L1011           ; forward to ED-CUR to update K-CUR
4817
                                ; and return to ED-LOOP.
4818
 
4819
; --------------------
4820
; Cursor right editing
4821
; --------------------
4822
; This acts on the cursor in the lower screen in both editing and input
4823
; mode and moves it to the right.
4824
 
4825
;; ED-RIGHT
4826
L100C:  LD      A,(HL)          ; fetch addressed character.
4827
        CP      $0D             ; is it carriage return ?
4828
        RET     Z               ; return if so to ED-LOOP
4829
 
4830
        INC     HL              ; address next character
4831
 
4832
;; ED-CUR
4833
L1011:  LD      ($5C5B),HL      ; update K_CUR system variable
4834
        RET                     ; return to ED-LOOP
4835
 
4836
; --------------
4837
; DELETE editing
4838
; --------------
4839
; This acts on the lower screen and deletes the character to left of
4840
; cursor. If control characters are present these are deleted first
4841
; leaving the naked parameter (0-7) which appears as a '?' except in the
4842
; case of chr$ 6 which is the comma control character. It is not mandatory
4843
; to delete these second characters.
4844
 
4845
;; ED-DELETE
4846
L1015:  CALL    L1031           ; routine ED-EDGE moves cursor to left.
4847
        LD      BC,$0001        ; of character to be deleted.
4848
        JP      L19E8           ; to RECLAIM-2 reclaim the character.
4849
 
4850
; ------------------------------------------
4851
; Ignore next 2 codes from key-input routine
4852
; ------------------------------------------
4853
; Since AT and TAB cannot be entered this point is never reached
4854
; from the keyboard. If inputting from a tape device or network then
4855
; the control and two following characters are ignored and processing
4856
; continues as if a carriage return had been received.
4857
; Here, perhaps, another Spectrum has said print #15; AT 0,0; "This is yellow"
4858
; and this one is interpreting input #15; a$.
4859
 
4860
;; ED-IGNORE
4861
L101E:  CALL    L15D4           ; routine WAIT-KEY to ignore keystroke.
4862
        CALL    L15D4           ; routine WAIT-KEY to ignore next key.
4863
 
4864
; -------------
4865
; Enter/newline
4866
; -------------
4867
; The enter key has been pressed to have BASIC line or input accepted.
4868
 
4869
;; ED-ENTER
4870
L1024:  POP     HL              ; discard address ED-LOOP
4871
        POP     HL              ; drop address ED-ERROR
4872
 
4873
;; ED-END
4874
L1026:  POP     HL              ; the previous value of ERR_SP
4875
        LD      ($5C3D),HL      ; is restored to ERR_SP system variable
4876
        BIT     7,(IY+$00)      ; is ERR_NR $FF (= 'OK') ?
4877
        RET     NZ              ; return if so
4878
 
4879
        LD      SP,HL           ; else put error routine on stack
4880
        RET                     ; and make an indirect jump to it.
4881
 
4882
; -----------------------------
4883
; Move cursor left when editing
4884
; -----------------------------
4885
; This routine moves the cursor left. The complication is that it must
4886
; not position the cursor between control codes and their parameters.
4887
; It is further complicated in that it deals with TAB and AT characters
4888
; which are never present from the keyboard.
4889
; The method is to advance from the beginning of the line each time,
4890
; jumping one, two, or three characters as necessary saving the original
4891
; position at each jump in DE. Once it arrives at the cursor then the next
4892
; legitimate leftmost position is in DE.
4893
 
4894
;; ED-EDGE
4895
L1031:  SCF                     ; carry flag must be set to call the nested
4896
        CALL    L1195           ; subroutine SET-DE.
4897
                                ; if input   then DE=WORKSP
4898
                                ; if editing then DE=E_LINE
4899
        SBC     HL,DE           ; subtract address from start of line
4900
        ADD     HL,DE           ; and add back.
4901
        INC     HL              ; adjust for carry.
4902
        POP     BC              ; drop return address
4903
        RET     C               ; return to ED-LOOP if already at left
4904
                                ; of line.
4905
 
4906
        PUSH    BC              ; resave return address - ED-LOOP.
4907
        LD      B,H             ; transfer HL - cursor address
4908
        LD      C,L             ; to BC register pair.
4909
                                ; at this point DE addresses start of line.
4910
 
4911
;; ED-EDGE-1
4912
L103E:  LD      H,D             ; transfer DE - leftmost pointer
4913
        LD      L,E             ; to HL
4914
        INC     HL              ; address next leftmost character to
4915
                                ; advance position each time.
4916
        LD      A,(DE)          ; pick up previous in A
4917
        AND     $F0             ; lose the low bits
4918
        CP      $10             ; is it INK to TAB $10-$1F ?
4919
                                ; that is, is it followed by a parameter ?
4920
        JR      NZ,L1051        ; to ED-EDGE-2 if not
4921
                                ; HL has been incremented once
4922
 
4923
        INC     HL              ; address next as at least one parameter.
4924
 
4925
; in fact since 'tab' and 'at' cannot be entered the next section seems
4926
; superfluous.
4927
; The test will always fail and the jump to ED-EDGE-2 will be taken.
4928
 
4929
        LD      A,(DE)          ; reload leftmost character
4930
        SUB     $17             ; decimal 23 ('tab')
4931
        ADC     A,$00           ; will be 0 for 'tab' and 'at'.
4932
        JR      NZ,L1051        ; forward to ED-EDGE-2 if not
4933
                                ; HL has been incremented twice
4934
 
4935
        INC     HL              ; increment a third time for 'at'/'tab'
4936
 
4937
;; ED-EDGE-2
4938
L1051:  AND     A               ; prepare for true subtraction
4939
        SBC     HL,BC           ; subtract cursor address from pointer
4940
        ADD     HL,BC           ; and add back
4941
                                ; Note when HL matches the cursor position BC,
4942
                                ; there is no carry and the previous
4943
                                ; position is in DE.
4944
        EX      DE,HL           ; transfer result to DE if looping again.
4945
                                ; transfer DE to HL to be used as K-CUR
4946
                                ; if exiting loop.
4947
        JR      C,L103E         ; back to ED-EDGE-1 if cursor not matched.
4948
 
4949
        RET                     ; return.
4950
 
4951
; -----------------
4952
; Cursor up editing
4953
; -----------------
4954
; The main screen displays part of the BASIC program and the user wishes
4955
; to move up one line scrolling if necessary.
4956
; This has no alternative use in input mode.
4957
 
4958
;; ED-UP
4959
L1059:  BIT     5,(IY+$37)      ; test FLAGX  - input mode ?
4960
        RET     NZ              ; return if not in editor - to ED-LOOP.
4961
 
4962
        LD      HL,($5C49)      ; get current line from E_PPC
4963
        CALL    L196E           ; routine LINE-ADDR gets address
4964
        EX      DE,HL           ; and previous in DE
4965
        CALL    L1695           ; routine LINE-NO gets prev line number
4966
        LD      HL,$5C4A        ; set HL to E_PPC_hi as next routine stores
4967
                                ; top first.
4968
        CALL    L191C           ; routine LN-STORE loads DE value to HL
4969
                                ; high byte first - E_PPC_lo takes E
4970
 
4971
; this branch is also taken from ed-down.
4972
 
4973
;; ED-LIST
4974
L106E:  CALL    L1795           ; routine AUTO-LIST lists to upper screen
4975
                                ; including adjusted current line.
4976
        LD      A,$00           ; select lower screen again
4977
        JP      L1601           ; exit via CHAN-OPEN to ED-LOOP
4978
 
4979
; --------------------------------
4980
; Use of symbol and graphics codes
4981
; --------------------------------
4982
; These will not be encountered with the keyboard but would be handled
4983
; otherwise as follows.
4984
; As noted earlier, Vickers says there should have been an entry in
4985
; the KEYS table for chr$ 6 which also pointed here.
4986
; If, for simplicity, two Spectrums were both using #15 as a bi-directional
4987
; channel connected to each other:-
4988
; then when the other Spectrum has said PRINT #15; x, y
4989
; input #15; i ; j  would treat the comma control as a newline and the
4990
; control would skip to input j.
4991
; You can get round the missing chr$ 6 handler by sending multiple print
4992
; items separated by a newline '.
4993
 
4994
; chr$14 would have the same functionality.
4995
 
4996
; This is chr$ 14.
4997
;; ED-SYMBOL
4998
L1076:  BIT     7,(IY+$37)      ; test FLAGX - is this INPUT LINE ?
4999
        JR      Z,L1024         ; back to ED-ENTER if not to treat as if
5000
                                ; enter had been pressed.
5001
                                ; else continue and add code to buffer.
5002
 
5003
; Next is chr$ 15
5004
; Note that ADD-CHAR precedes the table so we can't offset to it directly.
5005
 
5006
;; ED-GRAPH
5007
L107C:  JP      L0F81           ; jump back to ADD-CHAR
5008
 
5009
; --------------------
5010
; Editor error routine
5011
; --------------------
5012
; If an error occurs while editing, or inputting, then ERR_SP
5013
; points to the stack location holding address ED_ERROR.
5014
 
5015
;; ED-ERROR
5016
L107F:  BIT     4,(IY+$30)      ; test FLAGS2  - is K channel in use ?
5017
        JR      Z,L1026         ; back to ED-END if not.
5018
 
5019
; but as long as we're editing lines or inputting from the keyboard, then
5020
; we've run out of memory so give a short rasp.
5021
 
5022
        LD      (IY+$00),$FF    ; reset ERR_NR to 'OK'.
5023
        LD      D,$00           ; prepare for beeper.
5024
        LD      E,(IY-$02)      ; use RASP value.
5025
        LD      HL,$1A90        ; set the pitch - or tone period.
5026
        CALL    L03B5           ; routine BEEPER emits a warning rasp.
5027
        JP      L0F30           ; to ED-AGAIN to re-stack address of
5028
                                ; this routine and make ERR_SP point to it.
5029
 
5030
; ---------------------
5031
; Clear edit/work space
5032
; ---------------------
5033
; The editing area or workspace is cleared depending on context.
5034
; This is called from ED-EDIT to clear workspace if edit key is
5035
; used during input, to clear editing area if no program exists
5036
; and to clear editing area prior to copying the edit line to it.
5037
; It is also used by the error routine to clear the respective
5038
; area depending on FLAGX.
5039
 
5040
;; CLEAR-SP
5041
L1097:  PUSH    HL              ; preserve HL
5042
        CALL    L1190           ; routine SET-HL
5043
                                ; if in edit   HL = WORKSP-1, DE = E_LINE
5044
                                ; if in input  HL = STKBOT,   DE = WORKSP
5045
        DEC     HL              ; adjust
5046
        CALL    L19E5           ; routine RECLAIM-1 reclaims space
5047
        LD      ($5C5B),HL      ; set K_CUR to start of empty area
5048
        LD      (IY+$07),$00    ; set MODE to 'KLC'
5049
        POP     HL              ; restore HL.
5050
        RET                     ; return.
5051
 
5052
; ----------------------------
5053
; THE 'KEYBOARD INPUT' ROUTINE
5054
; ----------------------------
5055
; This is the service routine for the input stream of the keyboard channel 'K'.
5056
 
5057
;; KEY-INPUT
5058
L10A8:  BIT     3,(IY+$02)      ; test TV_FLAG  - has a key been pressed in
5059
                                ; editor ?
5060
 
5061
        CALL    NZ,L111D        ; routine ED-COPY, if so, to reprint the lower
5062
                                ; screen at every keystroke/mode change.
5063
 
5064
        AND     A               ; clear carry flag - required exit condition.
5065
 
5066
        BIT     5,(IY+$01)      ; test FLAGS  - has a new key been pressed ?
5067
        RET     Z               ; return if not.                        >>
5068
 
5069
        LD      A,($5C08)       ; system variable LASTK will hold last key -
5070
                                ; from the interrupt routine.
5071
 
5072
        RES     5,(IY+$01)      ; update FLAGS  - reset the new key flag.
5073
        PUSH    AF              ; save the input character.
5074
 
5075
        BIT     5,(IY+$02)      ; test TV_FLAG  - clear lower screen ?
5076
 
5077
        CALL    NZ,L0D6E        ; routine CLS-LOWER if so.
5078
 
5079
        POP     AF              ; restore the character code.
5080
 
5081
        CP      $20             ; if space or higher then
5082
        JR      NC,L111B        ; forward to KEY-DONE2 and return with carry
5083
                                ; set to signal key-found.
5084
 
5085
        CP      $10             ; with 16d INK and higher skip
5086
        JR      NC,L10FA        ; forward to KEY-CONTR.
5087
 
5088
        CP      $06             ; for 6 - 15d
5089
        JR      NC,L10DB        ; skip forward to KEY-M-CL to handle Modes
5090
                                ; and CapsLock.
5091
 
5092
; that only leaves 0-5, the flash bright inverse switches.
5093
 
5094
        LD      B,A             ; save character in B
5095
        AND     $01             ; isolate the embedded parameter (0/1).
5096
        LD      C,A             ; and store in C
5097
        LD      A,B             ; re-fetch copy (0-5)
5098
        RRA                     ; halve it 0, 1 or 2.
5099
        ADD     A,$12           ; add 18d gives 'flash', 'bright'
5100
                                ; and 'inverse'.
5101
        JR      L1105           ; forward to KEY-DATA with the
5102
                                ; parameter (0/1) in C.
5103
 
5104
; ---
5105
 
5106
; Now separate capslock 06 from modes 7-15.
5107
 
5108
;; KEY-M-CL
5109
L10DB:  JR      NZ,L10E6        ; forward to KEY-MODE if not 06 (capslock)
5110
 
5111
        LD      HL,$5C6A        ; point to FLAGS2
5112
        LD      A,$08           ; value 00001000
5113
        XOR     (HL)            ; toggle BIT 3 of FLAGS2 the capslock bit
5114
        LD      (HL),A          ; and store result in FLAGS2 again.
5115
        JR      L10F4           ; forward to KEY-FLAG to signal no-key.
5116
 
5117
; ---
5118
 
5119
;; KEY-MODE
5120
L10E6:  CP      $0E             ; compare with chr 14d
5121
        RET     C               ; return with carry set "key found" for
5122
                                ; codes 7 - 13d leaving 14d and 15d
5123
                                ; which are converted to mode codes.
5124
 
5125
        SUB     $0D             ; subtract 13d leaving 1 and 2
5126
                                ; 1 is 'E' mode, 2 is 'G' mode.
5127
        LD      HL,$5C41        ; address the MODE system variable.
5128
        CP      (HL)            ; compare with existing value before
5129
        LD      (HL),A          ; inserting the new value.
5130
        JR      NZ,L10F4        ; forward to KEY-FLAG if it has changed.
5131
 
5132
        LD      (HL),$00        ; else make MODE zero - KLC mode
5133
                                ; Note. while in Extended/Graphics mode,
5134
                                ; the Extended Mode/Graphics key is pressed
5135
                                ; again to get out.
5136
 
5137
;; KEY-FLAG
5138
L10F4:  SET     3,(IY+$02)      ; update TV_FLAG  - show key state has changed
5139
        CP      A               ; clear carry and reset zero flags -
5140
                                ; no actual key returned.
5141
        RET                     ; make the return.
5142
 
5143
; ---
5144
 
5145
; now deal with colour controls - 16-23 ink, 24-31 paper
5146
 
5147
;; KEY-CONTR
5148
L10FA:  LD      B,A             ; make a copy of character.
5149
        AND     $07             ; mask to leave bits 0-7
5150
        LD      C,A             ; and store in C.
5151
        LD      A,$10           ; initialize to 16d - INK.
5152
        BIT     3,B             ; was it paper ?
5153
        JR      NZ,L1105        ; forward to KEY-DATA with INK 16d and
5154
                                ; colour in C.
5155
 
5156
        INC     A               ; else change from INK to PAPER (17d) if so.
5157
 
5158
;; KEY-DATA
5159
L1105:  LD      (IY-$2D),C      ; put the colour (0-7)/state(0/1) in KDATA
5160
        LD      DE,L110D        ; address: KEY-NEXT will be next input stream
5161
        JR      L1113           ; forward to KEY-CHAN to change it ...
5162
 
5163
; ---
5164
 
5165
; ... so that INPUT_AD directs control to here at next call to WAIT-KEY
5166
 
5167
;; KEY-NEXT
5168
L110D:  LD      A,($5C0D)       ; pick up the parameter stored in KDATA.
5169
        LD      DE,L10A8        ; address: KEY-INPUT will be next input stream
5170
                                ; continue to restore default channel and
5171
                                ; make a return with the control code.
5172
 
5173
;; KEY-CHAN
5174
L1113:  LD      HL,($5C4F)      ; address start of CHANNELS area using CHANS
5175
                                ; system variable.
5176
                                ; Note. One might have expected CURCHL to
5177
                                ; have been used.
5178
        INC     HL              ; step over the
5179
        INC     HL              ; output address
5180
        LD      (HL),E          ; and update the input
5181
        INC     HL              ; routine address for
5182
        LD      (HL),D          ; the next call to WAIT-KEY.
5183
 
5184
;; KEY-DONE2
5185
L111B:  SCF                     ; set carry flag to show a key has been found
5186
        RET                     ; and return.
5187
 
5188
; --------------------
5189
; Lower screen copying
5190
; --------------------
5191
; This subroutine is called whenever the line in the editing area or
5192
; input workspace is required to be printed to the lower screen.
5193
; It is by calling this routine after any change that the cursor, for
5194
; instance, appears to move to the left.
5195
; Remember the edit line will contain characters and tokens
5196
; e.g. "1000 LET a=1" is 8 characters.
5197
 
5198
;; ED-COPY
5199
L111D:  CALL    L0D4D           ; routine TEMPS sets temporary attributes.
5200
        RES     3,(IY+$02)      ; update TV_FLAG  - signal no change in mode
5201
        RES     5,(IY+$02)      ; update TV_FLAG  - signal don't clear lower
5202
                                ; screen.
5203
        LD      HL,($5C8A)      ; fetch SPOSNL
5204
        PUSH    HL              ; and save on stack.
5205
 
5206
        LD      HL,($5C3D)      ; fetch ERR_SP
5207
        PUSH    HL              ; and save also
5208
        LD      HL,L1167        ; address: ED-FULL
5209
        PUSH    HL              ; is pushed as the error routine
5210
        LD      ($5C3D),SP      ; and ERR_SP made to point to it.
5211
 
5212
        LD      HL,($5C82)      ; fetch ECHO_E
5213
        PUSH    HL              ; and push also
5214
 
5215
        SCF                     ; set carry flag to control SET-DE
5216
        CALL    L1195           ; call routine SET-DE
5217
                                ; if in input DE = WORKSP
5218
                                ; if in edit  DE = E_LINE
5219
        EX      DE,HL           ; start address to HL
5220
 
5221
        CALL    L187D           ; routine OUT-LINE2 outputs entire line up to
5222
                                ; carriage return including initial
5223
                                ; characterized line number when present.
5224
        EX      DE,HL           ; transfer new address to DE
5225
        CALL    L18E1           ; routine OUT-CURS considers a
5226
                                ; terminating cursor.
5227
 
5228
        LD      HL,($5C8A)      ; fetch updated SPOSNL
5229
        EX      (SP),HL         ; exchange with ECHO_E on stack
5230
        EX      DE,HL           ; transfer ECHO_E to DE
5231
        CALL    L0D4D           ; routine TEMPS to re-set attributes
5232
                                ; if altered.
5233
 
5234
; the lower screen was not cleared, at the outset, so if deleting then old
5235
; text from a previous print may follow this line and requires blanking.
5236
 
5237
;; ED-BLANK
5238
L1150:  LD      A,($5C8B)       ; fetch SPOSNL_hi is current line
5239
        SUB     D               ; compare with old
5240
        JR      C,L117C         ; forward to ED-C-DONE if no blanking
5241
 
5242
        JR      NZ,L115E        ; forward to ED-SPACES if line has changed
5243
 
5244
        LD      A,E             ; old column to A
5245
        SUB     (IY+$50)        ; subtract new in SPOSNL_lo
5246
        JR      NC,L117C        ; forward to ED-C-DONE if no backfilling.
5247
 
5248
;; ED-SPACES
5249
L115E:  LD      A,$20           ; prepare a space.
5250
        PUSH    DE              ; save old line/column.
5251
        CALL    L09F4           ; routine PRINT-OUT prints a space over
5252
                                ; any text from previous print.
5253
                                ; Note. Since the blanking only occurs when
5254
                                ; using $09F4 to print to the lower screen,
5255
                                ; there is no need to vector via a RST 10
5256
                                ; and we can use this alternate set.
5257
        POP     DE              ; restore the old line column.
5258
        JR      L1150           ; back to ED-BLANK until all old text blanked.
5259
 
5260
; -------------------------------
5261
; THE 'EDITOR-FULL' ERROR ROUTINE
5262
; -------------------------------
5263
;   This is the error routine addressed by ERR_SP.  This is not for the out of
5264
;   memory situation as we're just printing.  The pitch and duration are exactly
5265
;   the same as used by ED-ERROR from which this has been augmented.  The
5266
;   situation is that the lower screen is full and a rasp is given to suggest
5267
;   that this is perhaps not the best idea you've had that day.
5268
 
5269
;; ED-FULL
5270
L1167:  LD      D,$00           ; prepare to moan.
5271
        LD      E,(IY-$02)      ; fetch RASP value.
5272
        LD      HL,$1A90        ; set pitch or tone period.
5273
 
5274
        CALL    L03B5           ; routine BEEPER.
5275
 
5276
        LD      (IY+$00),$FF    ; clear ERR_NR.
5277
        LD      DE,($5C8A)      ; fetch SPOSNL.
5278
        JR      L117E           ; forward to ED-C-END
5279
 
5280
; -------
5281
 
5282
; the exit point from line printing continues here.
5283
 
5284
;; ED-C-DONE
5285
L117C:  POP     DE              ; fetch new line/column.
5286
        POP     HL              ; fetch the error address.
5287
 
5288
; the error path rejoins here.
5289
 
5290
;; ED-C-END
5291
L117E:  POP     HL              ; restore the old value of ERR_SP.
5292
        LD      ($5C3D),HL      ; update the system variable ERR_SP
5293
 
5294
        POP     BC              ; old value of SPOSN_L
5295
        PUSH    DE              ; save new value
5296
 
5297
        CALL    L0DD9           ; routine CL-SET and PO-STORE
5298
                                ; update ECHO_E and SPOSN_L from BC
5299
 
5300
        POP     HL              ; restore new value
5301
        LD      ($5C82),HL      ; and overwrite ECHO_E
5302
 
5303
        LD      (IY+$26),$00    ; make error pointer X_PTR_hi out of bounds
5304
 
5305
        RET                     ; return
5306
 
5307
; -----------------------------------------------
5308
; Point to first and last locations of work space
5309
; -----------------------------------------------
5310
;   These two nested routines ensure that the appropriate pointers are
5311
;   selected for the editing area or workspace. The routines that call
5312
;   these routines are designed to work on either area.
5313
 
5314
; this routine is called once
5315
 
5316
;; SET-HL
5317
L1190:  LD      HL,($5C61)      ; fetch WORKSP to HL.
5318
        DEC     HL              ; point to last location of editing area.
5319
        AND     A               ; clear carry to limit exit points to first
5320
                                ; or last.
5321
 
5322
; this routine is called with carry set and exits at a conditional return.
5323
 
5324
;; SET-DE
5325
L1195:  LD      DE,($5C59)      ; fetch E_LINE to DE
5326
        BIT     5,(IY+$37)      ; test FLAGX  - Input Mode ?
5327
        RET     Z               ; return now if in editing mode
5328
 
5329
        LD      DE,($5C61)      ; fetch WORKSP to DE
5330
        RET     C               ; return if carry set ( entry = set-de)
5331
 
5332
        LD      HL,($5C63)      ; fetch STKBOT to HL as well
5333
        RET                     ; and return  (entry = set-hl (in input))
5334
 
5335
; -----------------------------------
5336
; THE 'REMOVE FLOATING POINT' ROUTINE
5337
; -----------------------------------
5338
;   When a BASIC LINE or the INPUT BUFFER is parsed any numbers will have
5339
;   an invisible chr 14d inserted after them and the 5-byte integer or
5340
;   floating point form inserted after that.  Similar invisible value holders
5341
;   are also created after the numeric and string variables in a DEF FN list.
5342
;   This routine removes these 'compiled' numbers from the edit line or
5343
;   input workspace.
5344
 
5345
;; REMOVE-FP
5346
L11A7:  LD      A,(HL)          ; fetch character
5347
        CP      $0E             ; is it the CHR$ 14 number marker ?
5348
        LD      BC,$0006        ; prepare to strip six bytes
5349
 
5350
        CALL    Z,L19E8         ; routine RECLAIM-2 reclaims bytes if CHR$ 14.
5351
 
5352
        LD      A,(HL)          ; reload next (or same) character
5353
        INC     HL              ; and advance address
5354
        CP      $0D             ; end of line or input buffer ?
5355
        JR      NZ,L11A7        ; back to REMOVE-FP until entire line done.
5356
 
5357
        RET                     ; return.
5358
 
5359
 
5360
; *********************************
5361
; ** Part 6. EXECUTIVE ROUTINES  **
5362
; *********************************
5363
 
5364
 
5365
; The memory.
5366
;
5367
; +---------+-----------+------------+--------------+-------------+--
5368
; | BASIC   |  Display  | Attributes | ZX Printer   |    System   |
5369
; |  ROM    |   File    |    File    |   Buffer     |  Variables  |
5370
; +---------+-----------+------------+--------------+-------------+--
5371
; ^         ^           ^            ^              ^             ^
5372
; $0000   $4000       $5800        $5B00          $5C00         $5CB6 = CHANS
5373
;
5374
;
5375
;  --+----------+---+---------+-----------+---+------------+--+---+--
5376
;    | Channel  |$80|  BASIC  | Variables |$80| Edit Line  |NL|$80|
5377
;    |   Info   |   | Program |   Area    |   | or Command |  |   |
5378
;  --+----------+---+---------+-----------+---+------------+--+---+--
5379
;    ^              ^         ^               ^                   ^
5380
;  CHANS           PROG      VARS           E_LINE              WORKSP
5381
;
5382
;
5383
;                             ---5-->         <---2---  <--3---
5384
;  --+-------+--+------------+-------+-------+---------+-------+-+---+------+
5385
;    | INPUT |NL| Temporary  | Calc. | Spare | Machine | GOSUB |?|$3E| UDGs |
5386
;    | data  |  | Work Space | Stack |       |  Stack  | Stack | |   |      |
5387
;  --+-------+--+------------+-------+-------+---------+-------+-+---+------+
5388
;    ^                       ^       ^       ^                   ^   ^      ^
5389
;  WORKSP                  STKBOT  STKEND   sp               RAMTOP UDG  P_RAMT
5390
;
5391
 
5392
; -----------------
5393
; THE 'NEW' COMMAND
5394
; -----------------
5395
;   The NEW command is about to set all RAM below RAMTOP to zero and then
5396
;   re-initialize the system.  All RAM above RAMTOP should, and will be,
5397
;   preserved.
5398
;   There is nowhere to store values in RAM or on the stack which becomes
5399
;   inoperable. Similarly PUSH and CALL instructions cannot be used to store
5400
;   values or section common code. The alternate register set is the only place
5401
;   available to store 3 persistent 16-bit system variables.
5402
 
5403
;; NEW
5404
L11B7:  DI                      ; Disable Interrupts - machine stack will be
5405
                                ; cleared.
5406
        LD      A,$FF           ; Flag coming from NEW.
5407
        LD      DE,($5CB2)      ; Fetch RAMTOP as top value.
5408
        EXX                     ; Switch in alternate set.
5409
        LD      BC,($5CB4)      ; Fetch P-RAMT differs on 16K/48K machines.
5410
        LD      DE,($5C38)      ; Fetch RASP/PIP.
5411
        LD      HL,($5C7B)      ; Fetch UDG    differs on 16K/48K machines.
5412
        EXX                     ; Switch back to main set and continue into...
5413
 
5414
; ----------------------
5415
; THE 'START-NEW' BRANCH
5416
; ----------------------
5417
;   This branch is taken from above and from RST 00h.
5418
;   The common code tests RAM and sets it to zero re-initializing all the
5419
;   non-zero system variables and channel information.  The A register flags
5420
;   if coming from START or NEW.
5421
 
5422
;; START-NEW
5423
L11CB:  LD      B,A             ; Save the flag to control later branching.
5424
 
5425
        LD      A,$07           ; Select a white border
5426
        OUT     ($FE),A         ; and set it now by writing to a port.
5427
 
5428
        LD      A,$3F           ; Load the accumulator with last page in ROM.
5429
        LD      I,A             ; Set the I register - this remains constant
5430
                                ; and can't be in the range $40 - $7F as 'snow'
5431
                                ; appears on the screen.
5432
 
5433
        LD      HL, NMI_VECT    ; Initialize the NMI jump vector
5434
        LD      ($5CB0), HL
5435
        ;NOP                     ; These seem unnecessary.
5436
        ;NOP                     ; Note: They are a placeholder for the two
5437
        ;NOP                     ; instructions above that initialize NMI junp.
5438
        ;NOP                     ; This way the rest of the code is not moved.
5439
        ;NOP                     ;
5440
        ;NOP                     ;
5441
 
5442
; -----------------------
5443
; THE 'RAM CHECK' SECTION
5444
; -----------------------
5445
;   Typically, a Spectrum will have 16K or 48K of RAM and this code will test
5446
;   it all till it finds an unpopulated location or, less likely, a faulty
5447
;   location.  Usually it stops when it reaches the top $FFFF, or in the case
5448
;   of NEW the supplied top value.  The entire screen turns black with
5449
;   sometimes red stripes on black paper just visible.
5450
 
5451
;; ram-check
5452
L11DA:  LD      H,D             ; Transfer the top value to the HL register
5453
        LD      L,E             ; pair.
5454
 
5455
;; RAM-FILL
5456
L11DC:  LD      (HL),$02        ; Load memory with $02 - red ink on black paper.
5457
        DEC     HL              ; Decrement memory address.
5458
        CP      H               ; Have we reached ROM - $3F ?
5459
        JR      NZ,L11DC        ; Back to RAM-FILL if not.
5460
 
5461
;; RAM-READ
5462
L11E2:  AND     A               ; Clear carry - prepare to subtract.
5463
        SBC     HL,DE           ; subtract and add back setting
5464
        ADD     HL,DE           ; carry when back at start.
5465
        INC     HL              ; and increment for next iteration.
5466
        JR      NC,L11EF        ; forward to RAM-DONE if we've got back to
5467
                                ; starting point with no errors.
5468
 
5469
        DEC     (HL)            ; decrement to 1.
5470
        JR      Z,L11EF         ; forward to RAM-DONE if faulty.
5471
 
5472
        DEC     (HL)            ; decrement to zero.
5473
        JR      Z,L11E2         ; back to RAM-READ if zero flag was set.
5474
 
5475
;; RAM-DONE
5476
L11EF:  DEC     HL              ; step back to last valid location.
5477
        EXX                     ; regardless of state, set up possibly
5478
                                ; stored system variables in case from NEW.
5479
        LD      ($5CB4),BC      ; insert P-RAMT.
5480
        LD      ($5C38),DE      ; insert RASP/PIP.
5481
        LD      ($5C7B),HL      ; insert UDG.
5482
        EXX                     ; switch in main set.
5483
        INC     B               ; now test if we arrived here from NEW.
5484
        JR      Z,L1219         ; forward to RAM-SET if we did.
5485
 
5486
;   This section applies to START only.
5487
 
5488
        LD      ($5CB4),HL      ; set P-RAMT to the highest working RAM
5489
                                ; address.
5490
        LD      DE,$3EAF        ; address of last byte of 'U' bitmap in ROM.
5491
        LD      BC,$00A8        ; there are 21 user defined graphics.
5492
        EX      DE,HL           ; switch pointers and make the UDGs a
5493
        LDDR                    ; copy of the standard characters A - U.
5494
        EX      DE,HL           ; switch the pointer to HL.
5495
        INC     HL              ; update to start of 'A' in RAM.
5496
        LD      ($5C7B),HL      ; make UDG system variable address the first
5497
                                ; bitmap.
5498
        DEC     HL              ; point at RAMTOP again.
5499
 
5500
        LD      BC,$0040        ; set the values of
5501
        LD      ($5C38),BC      ; the PIP and RASP system variables.
5502
 
5503
;   The NEW command path rejoins here.
5504
 
5505
;; RAM-SET
5506
L1219:  LD      ($5CB2),HL      ; set system variable RAMTOP to HL.
5507
 
5508
;
5509
;   Note. this entry point is a disabled Warm Restart that was almost certainly
5510
;   once pointed to by the System Variable NMIADD.  It would be essential that
5511
;   any NMI Handler would perform the tasks from here to the EI instruction
5512
;   below.
5513
 
5514
NMI_VECT:
5515
L121C:
5516
        LD      HL,$3C00        ; a strange place to set the pointer to the
5517
        LD      ($5C36),HL      ; character set, CHARS - as no printing yet.
5518
 
5519
        LD      HL,($5CB2)      ; fetch RAMTOP to HL again as we've lost it.
5520
 
5521
        LD      (HL),$3E        ; top of user ram holds GOSUB end marker
5522
                                ; an impossible line number - see RETURN.
5523
                                ; no significance in the number $3E. It has
5524
                                ; been traditional since the ZX80.
5525
 
5526
        DEC     HL              ; followed by empty byte (not important).
5527
        LD      SP,HL           ; set up the machine stack pointer.
5528
        DEC     HL              ;
5529
        DEC     HL              ;
5530
        LD      ($5C3D),HL      ; ERR_SP is where the error pointer is
5531
                                ; at moment empty - will take address MAIN-4
5532
                                ; at the call preceding that address,
5533
                                ; although interrupts and calls will make use
5534
                                ; of this location in meantime.
5535
 
5536
        IM      1               ; select interrupt mode 1.
5537
 
5538
        LD      IY,$5C3A        ; set IY to ERR_NR. IY can reach all standard
5539
                                ; system variables but shadow ROM system
5540
                                ; variables will be mostly out of range.
5541
 
5542
        EI                      ; enable interrupts now that we have a stack.
5543
 
5544
;   If, as suggested above, the NMI service routine pointed to this section of
5545
;   code then a decision would have to be made at this point to jump forward,
5546
;   in a Warm Restart scenario, to produce a report code, leaving any program
5547
;   intact.
5548
 
5549
        LD      HL,$5CB6        ; The address of the channels - initially
5550
                                ; following system variables.
5551
        LD      ($5C4F),HL      ; Set the CHANS system variable.
5552
 
5553
        LD      DE,L15AF        ; Address: init-chan in ROM.
5554
        LD      BC,$0015        ; There are 21 bytes of initial data in ROM.
5555
        EX      DE,HL           ; swap the pointers.
5556
        LDIR                    ; Copy the bytes to RAM.
5557
 
5558
        EX      DE,HL           ; Swap pointers. HL points to program area.
5559
        DEC     HL              ; Decrement address.
5560
        LD      ($5C57),HL      ; Set DATADD to location before program area.
5561
        INC     HL              ; Increment again.
5562
 
5563
        LD      ($5C53),HL      ; Set PROG the location where BASIC starts.
5564
        LD      ($5C4B),HL      ; Set VARS to same location with a
5565
        LD      (HL),$80        ; variables end-marker.
5566
        INC     HL              ; Advance address.
5567
        LD      ($5C59),HL      ; Set E_LINE, where the edit line
5568
                                ; will be created.
5569
                                ; Note. it is not strictly necessary to
5570
                                ; execute the next fifteen bytes of code
5571
                                ; as this will be done by the call to SET-MIN.
5572
                                ; --
5573
        LD      (HL),$0D        ; initially just has a carriage return
5574
        INC     HL              ; followed by
5575
        LD      (HL),$80        ; an end-marker.
5576
        INC     HL              ; address the next location.
5577
        LD      ($5C61),HL      ; set WORKSP - empty workspace.
5578
        LD      ($5C63),HL      ; set STKBOT - bottom of the empty stack.
5579
        LD      ($5C65),HL      ; set STKEND to the end of the empty stack.
5580
                                ; --
5581
        LD      A,$38           ; the colour system is set to white paper,
5582
                                ; black ink, no flash or bright.
5583
        LD      ($5C8D),A       ; set ATTR_P permanent colour attributes.
5584
        LD      ($5C8F),A       ; set ATTR_T temporary colour attributes.
5585
        LD      ($5C48),A       ; set BORDCR the border colour/lower screen
5586
                                ; attributes.
5587
 
5588
        LD      HL,$0523        ; The keyboard repeat and delay values are
5589
        LD      ($5C09),HL      ; loaded to REPDEL and REPPER.
5590
 
5591
        DEC     (IY-$3A)        ; set KSTATE-0 to $FF - keyboard map available.
5592
        DEC     (IY-$36)        ; set KSTATE-4 to $FF - keyboard map available.
5593
 
5594
        LD      HL,L15C6        ; set source to ROM Address: init-strm
5595
        LD      DE,$5C10        ; set destination to system variable STRMS-FD
5596
        LD      BC,$000E        ; copy the 14 bytes of initial 7 streams data
5597
        LDIR                    ; from ROM to RAM.
5598
 
5599
        SET     1,(IY+$01)      ; update FLAGS  - signal printer in use.
5600
        CALL    L0EDF           ; call routine CLEAR-PRB to initialize system
5601
                                ; variables associated with printer.
5602
                                ; The buffer is clear.
5603
 
5604
        LD      (IY+$31),$02    ; set DF_SZ the lower screen display size to
5605
                                ; two lines
5606
        CALL    L0D6B           ; call routine CLS to set up system
5607
                                ; variables associated with screen and clear
5608
                                ; the screen and set attributes.
5609
        XOR     A               ; clear accumulator so that we can address
5610
        LD      DE,L1539 - 1    ; the message table directly.
5611
        CALL    L0C0A           ; routine PO-MSG puts
5612
                                ; ' ©  1982 Sinclair Research Ltd'
5613
                                ; at bottom of display.
5614
        SET     5,(IY+$02)      ; update TV_FLAG  - signal lower screen will
5615
                                ; require clearing.
5616
 
5617
        JR      L12A9           ; forward to MAIN-1
5618
 
5619
; -------------------------
5620
; THE 'MAIN EXECUTION LOOP'
5621
; -------------------------
5622
;
5623
;
5624
 
5625
;; MAIN-EXEC
5626
L12A2:  LD      (IY+$31),$02    ; set DF_SZ lower screen display file size to
5627
                                ; two lines.
5628
        CALL    L1795           ; routine AUTO-LIST
5629
 
5630
;; MAIN-1
5631
L12A9:  CALL    L16B0           ; routine SET-MIN clears work areas.
5632
 
5633
;; MAIN-2
5634
L12AC:  LD      A,$00           ; select channel 'K' the keyboard
5635
 
5636
        CALL    L1601           ; routine CHAN-OPEN opens it
5637
 
5638
        CALL    L0F2C           ; routine EDITOR is called.
5639
                                ; Note the above routine is where the Spectrum
5640
                                ; waits for user-interaction. Perhaps the
5641
                                ; most common input at this stage
5642
                                ; is LOAD "".
5643
 
5644
        CALL    L1B17           ; routine LINE-SCAN scans the input.
5645
 
5646
        BIT     7,(IY+$00)      ; test ERR_NR - will be $FF if syntax is OK.
5647
        JR      NZ,L12CF        ; forward, if correct, to MAIN-3.
5648
 
5649
;
5650
 
5651
        BIT     4,(IY+$30)      ; test FLAGS2 - K channel in use ?
5652
        JR      Z,L1303         ; forward to MAIN-4 if not.
5653
 
5654
;
5655
 
5656
        LD      HL,($5C59)      ; an editing error so address E_LINE.
5657
        CALL    L11A7           ; routine REMOVE-FP removes the hidden
5658
                                ; floating-point forms.
5659
        LD      (IY+$00),$FF    ; system variable ERR_NR is reset to 'OK'.
5660
        JR      L12AC           ; back to MAIN-2 to allow user to correct.
5661
 
5662
; ---
5663
 
5664
; the branch was here if syntax has passed test.
5665
 
5666
;; MAIN-3
5667
L12CF:  LD      HL,($5C59)      ; fetch the edit line address from E_LINE.
5668
 
5669
        LD      ($5C5D),HL      ; system variable CH_ADD is set to first
5670
                                ; character of edit line.
5671
                                ; Note. the above two instructions are a little
5672
                                ; inadequate.
5673
                                ; They are repeated with a subtle difference
5674
                                ; at the start of the next subroutine and are
5675
                                ; therefore not required above.
5676
 
5677
        CALL    L19FB           ; routine E-LINE-NO will fetch any line
5678
                                ; number to BC if this is a program line.
5679
 
5680
        LD      A,B             ; test if the number of
5681
        OR      C               ; the line is non-zero.
5682
        JP      NZ,L155D        ; jump forward to MAIN-ADD if so to add the
5683
                                ; line to the BASIC program.
5684
 
5685
; Has the user just pressed the ENTER key ?
5686
 
5687
        RST     18H             ; GET-CHAR gets character addressed by CH_ADD.
5688
        CP      $0D             ; is it a carriage return ?
5689
        JR      Z,L12A2         ; back to MAIN-EXEC if so for an automatic
5690
                                ; listing.
5691
 
5692
; this must be a direct command.
5693
 
5694
        BIT     0,(IY+$30)      ; test FLAGS2 - clear the main screen ?
5695
 
5696
        CALL    NZ,L0DAF        ; routine CL-ALL, if so, e.g. after listing.
5697
 
5698
        CALL    L0D6E           ; routine CLS-LOWER anyway.
5699
 
5700
        LD      A,$19           ; compute scroll count as 25 minus
5701
        SUB     (IY+$4F)        ; value of S_POSN_hi.
5702
        LD      ($5C8C),A       ; update SCR_CT system variable.
5703
        SET     7,(IY+$01)      ; update FLAGS - signal running program.
5704
        LD      (IY+$00),$FF    ; set ERR_NR to 'OK'.
5705
        LD      (IY+$0A),$01    ; set NSPPC to one for first statement.
5706
        CALL    L1B8A           ; call routine LINE-RUN to run the line.
5707
                                ; sysvar ERR_SP therefore addresses MAIN-4
5708
 
5709
; Examples of direct commands are RUN, CLS, LOAD "", PRINT USR 40000,
5710
; LPRINT "A"; etc..
5711
; If a user written machine-code program disables interrupts then it
5712
; must enable them to pass the next step. We also jumped to here if the
5713
; keyboard was not being used.
5714
 
5715
;; MAIN-4
5716
L1303:  HALT                    ; wait for interrupt the only routine that can
5717
                                ; set bit 5 of FLAGS.
5718
 
5719
        RES     5,(IY+$01)      ; update bit 5 of FLAGS - signal no new key.
5720
 
5721
        BIT     1,(IY+$30)      ; test FLAGS2 - is printer buffer clear ?
5722
        CALL    NZ,L0ECD        ; call routine COPY-BUFF if not.
5723
                                ; Note. the programmer has neglected
5724
                                ; to set bit 1 of FLAGS first.
5725
 
5726
        LD      A,($5C3A)       ; fetch ERR_NR
5727
        INC     A               ; increment to give true code.
5728
 
5729
; Now deal with a runtime error as opposed to an editing error.
5730
; However if the error code is now zero then the OK message will be printed.
5731
 
5732
;; MAIN-G
5733
L1313:  PUSH    AF              ; save the error number.
5734
 
5735
        LD      HL,$0000        ; prepare to clear some system variables.
5736
        LD      (IY+$37),H      ; clear all the bits of FLAGX.
5737
        LD      (IY+$26),H      ; blank X_PTR_hi to suppress error marker.
5738
        LD      ($5C0B),HL      ; blank DEFADD to signal that no defined
5739
                                ; function is currently being evaluated.
5740
 
5741
        LD      HL,$0001        ; explicit - inc hl would do.
5742
        LD      ($5C16),HL      ; ensure STRMS-00 is keyboard.
5743
 
5744
        CALL    L16B0           ; routine SET-MIN clears workspace etc.
5745
        RES     5,(IY+$37)      ; update FLAGX - signal in EDIT not INPUT mode.
5746
                                ; Note. all the bits were reset earlier.
5747
 
5748
        CALL    L0D6E           ; call routine CLS-LOWER.
5749
 
5750
        SET     5,(IY+$02)      ; update TV_FLAG - signal lower screen
5751
                                ; requires clearing.
5752
 
5753
        POP     AF              ; bring back the true error number
5754
        LD      B,A             ; and make a copy in B.
5755
        CP      $0A             ; is it a print-ready digit ?
5756
        JR      C,L133C         ; forward to MAIN-5 if so.
5757
 
5758
        ADD     A,$07           ; add ASCII offset to letters.
5759
 
5760
;; MAIN-5
5761
L133C:  CALL    L15EF           ; call routine OUT-CODE to print the code.
5762
 
5763
        LD      A,$20           ; followed by a space.
5764
        RST     10H             ; PRINT-A
5765
 
5766
        LD      A,B             ; fetch stored report code.
5767
        LD      DE,L1391        ; address: rpt-mesgs.
5768
 
5769
        CALL    L0C0A           ; call routine PO-MSG to print the message.
5770
 
5771
X1349:  XOR     A               ; clear accumulator to directly
5772
        LD      DE,L1537 - 1    ; address the comma and space message.
5773
 
5774
        CALL    L0C0A           ; routine PO-MSG prints ', ' although it would
5775
                                ; be more succinct to use RST $10.
5776
 
5777
        LD      BC,($5C45)      ; fetch PPC the current line number.
5778
        CALL    L1A1B           ; routine OUT-NUM-1 will print that
5779
 
5780
        LD      A,$3A           ; then a ':' character.
5781
        RST     10H             ; PRINT-A
5782
 
5783
        LD      C,(IY+$0D)      ; then SUBPPC for statement
5784
        LD      B,$00           ; limited to 127
5785
        CALL    L1A1B           ; routine OUT-NUM-1 prints BC.
5786
 
5787
        CALL    L1097           ; routine CLEAR-SP clears editing area which
5788
                                ; probably contained 'RUN'.
5789
 
5790
        LD      A,($5C3A)       ; fetch ERR_NR again
5791
        INC     A               ; test for no error originally $FF.
5792
        JR      Z,L1386         ; forward to MAIN-9 if no error.
5793
 
5794
        CP      $09             ; is code Report 9 STOP ?
5795
        JR      Z,L1373         ; forward to MAIN-6 if so
5796
 
5797
        CP      $15             ; is code Report L Break ?
5798
        JR      NZ,L1376        ; forward to MAIN-7 if not
5799
 
5800
; Stop or Break was encountered so consider CONTINUE.
5801
 
5802
;; MAIN-6
5803
L1373:  INC     (IY+$0D)        ; increment SUBPPC to next statement.
5804
 
5805
;; MAIN-7
5806
L1376:  LD      BC,$0003        ; prepare to copy 3 system variables to
5807
        LD      DE,$5C70        ; address OSPPC - statement for CONTINUE.
5808
                                ; also updating OLDPPC line number below.
5809
 
5810
        LD      HL,$5C44        ; set source top to NSPPC next statement.
5811
        BIT     7,(HL)          ; did BREAK occur before the jump ?
5812
                                ; e.g. between GO TO and next statement.
5813
        JR      Z,L1384         ; skip forward to MAIN-8, if not, as set-up
5814
                                ; is correct.
5815
 
5816
        ADD     HL,BC           ; set source to SUBPPC number of current
5817
                                ; statement/line which will be repeated.
5818
 
5819
;; MAIN-8
5820
L1384:  LDDR                    ; copy PPC to OLDPPC and SUBPPC to OSPCC
5821
                                ; or NSPPC to OLDPPC and NEWPPC to OSPCC
5822
 
5823
;; MAIN-9
5824
L1386:  LD      (IY+$0A),$FF    ; update NSPPC - signal 'no jump'.
5825
        RES     3,(IY+$01)      ; update FLAGS - signal use 'K' mode for
5826
                                ; the first character in the editor and
5827
 
5828
        JP      L12AC           ; jump back to MAIN-2.
5829
 
5830
 
5831
; ----------------------
5832
; Canned report messages
5833
; ----------------------
5834
; The Error reports with the last byte inverted. The first entry
5835
; is a dummy entry. The last, which begins with $7F, the Spectrum
5836
; character for copyright symbol, is placed here for convenience
5837
; as is the preceding comma and space.
5838
; The report line must accommodate a 4-digit line number and a 3-digit
5839
; statement number which limits the length of the message text to twenty
5840
; characters.
5841
; e.g.  "B Integer out of range, 1000:127"
5842
 
5843
;; rpt-mesgs
5844
L1391:  DEFB    $80
5845
        DEFB    'O','K'+$80                             ; 0
5846
        DEFM    "NEXT without FO"
5847
        DEFB    'R'+$80                                 ; 1
5848
        DEFM    "Variable not foun"
5849
        DEFB    'd'+$80                                 ; 2
5850
        DEFM    "Subscript wron"
5851
        DEFB    'g'+$80                                 ; 3
5852
        DEFM    "Out of memor"
5853
        DEFB    'y'+$80                                 ; 4
5854
        DEFM    "Out of scree"
5855
        DEFB    'n'+$80                                 ; 5
5856
        DEFM    "Number too bi"
5857
        DEFB    'g'+$80                                 ; 6
5858
        DEFM    "RETURN without GOSU"
5859
        DEFB    'B'+$80                                 ; 7
5860
        DEFM    "End of fil"
5861
        DEFB    'e'+$80                                 ; 8
5862
        DEFM    "STOP statemen"
5863
        DEFB    't'+$80                                 ; 9
5864
        DEFM    "Invalid argumen"
5865
        DEFB    't'+$80                                 ; A
5866
        DEFM    "Integer out of rang"
5867
        DEFB    'e'+$80                                 ; B
5868
        DEFM    "Nonsense in BASI"
5869
        DEFB    'C'+$80                                 ; C
5870
        DEFM    "BREAK - CONT repeat"
5871
        DEFB    's'+$80                                 ; D
5872
        DEFM    "Out of DAT"
5873
        DEFB    'A'+$80                                 ; E
5874
        DEFM    "Invalid file nam"
5875
        DEFB    'e'+$80                                 ; F
5876
        DEFM    "No room for lin"
5877
        DEFB    'e'+$80                                 ; G
5878
        DEFM    "STOP in INPU"
5879
        DEFB    'T'+$80                                 ; H
5880
        DEFM    "FOR without NEX"
5881
        DEFB    'T'+$80                                 ; I
5882
        DEFM    "Invalid I/O devic"
5883
        DEFB    'e'+$80                                 ; J
5884
        DEFM    "Invalid colou"
5885
        DEFB    'r'+$80                                 ; K
5886
        DEFM    "BREAK into progra"
5887
        DEFB    'm'+$80                                 ; L
5888
        DEFM    "RAMTOP no goo"
5889
        DEFB    'd'+$80                                 ; M
5890
        DEFM    "Statement los"
5891
        DEFB    't'+$80                                 ; N
5892
        DEFM    "Invalid strea"
5893
        DEFB    'm'+$80                                 ; O
5894
        DEFM    "FN without DE"
5895
        DEFB    'F'+$80                                 ; P
5896
        DEFM    "Parameter erro"
5897
        DEFB    'r'+$80                                 ; Q
5898
        DEFM    "Tape loading erro"
5899
        DEFB    'r'+$80                                 ; R
5900
;; comma-sp
5901
L1537:  DEFB    ',',' '+$80                             ; used in report line.
5902
;; copyright
5903
L1539:  DEFB    $7F                                     ; copyright
5904
        DEFM    " 1982 Sinclair Research Lt"
5905
        DEFB    'd'+$80
5906
 
5907
 
5908
; -------------
5909
; REPORT-G
5910
; -------------
5911
; Note ERR_SP points here during line entry which allows the
5912
; normal 'Out of Memory' report to be augmented to the more
5913
; precise 'No Room for line' report.
5914
 
5915
;; REPORT-G
5916
; No Room for line
5917
L1555:  LD      A,$10           ; i.e. 'G' -$30 -$07
5918
        LD      BC,$0000        ; this seems unnecessary.
5919
        JP      L1313           ; jump back to MAIN-G
5920
 
5921
; -----------------------------
5922
; Handle addition of BASIC line
5923
; -----------------------------
5924
; Note this is not a subroutine but a branch of the main execution loop.
5925
; System variable ERR_SP still points to editing error handler.
5926
; A new line is added to the BASIC program at the appropriate place.
5927
; An existing line with same number is deleted first.
5928
; Entering an existing line number deletes that line.
5929
; Entering a non-existent line allows the subsequent line to be edited next.
5930
 
5931
;; MAIN-ADD
5932
L155D:  LD      ($5C49),BC      ; set E_PPC to extracted line number.
5933
        LD      HL,($5C5D)      ; fetch CH_ADD - points to location after the
5934
                                ; initial digits (set in E_LINE_NO).
5935
        EX      DE,HL           ; save start of BASIC in DE.
5936
 
5937
        LD      HL,L1555        ; Address: REPORT-G
5938
        PUSH    HL              ; is pushed on stack and addressed by ERR_SP.
5939
                                ; the only error that can occur is
5940
                                ; 'Out of memory'.
5941
 
5942
        LD      HL,($5C61)      ; fetch WORKSP - end of line.
5943
        SCF                     ; prepare for true subtraction.
5944
        SBC     HL,DE           ; find length of BASIC and
5945
        PUSH    HL              ; save it on stack.
5946
        LD      H,B             ; transfer line number
5947
        LD      L,C             ; to HL register.
5948
        CALL    L196E           ; routine LINE-ADDR will see if
5949
                                ; a line with the same number exists.
5950
        JR      NZ,L157D        ; forward if no existing line to MAIN-ADD1.
5951
 
5952
        CALL    L19B8           ; routine NEXT-ONE finds the existing line.
5953
        CALL    L19E8           ; routine RECLAIM-2 reclaims it.
5954
 
5955
;; MAIN-ADD1
5956
L157D:  POP     BC              ; retrieve the length of the new line.
5957
        LD      A,C             ; and test if carriage return only
5958
        DEC     A               ; i.e. one byte long.
5959
        OR      B               ; result would be zero.
5960
        JR      Z,L15AB         ; forward to MAIN-ADD2 is so.
5961
 
5962
        PUSH    BC              ; save the length again.
5963
        INC     BC              ; adjust for inclusion
5964
        INC     BC              ; of line number (two bytes)
5965
        INC     BC              ; and line length
5966
        INC     BC              ; (two bytes).
5967
        DEC     HL              ; HL points to location before the destination
5968
 
5969
        LD      DE,($5C53)      ; fetch the address of PROG
5970
        PUSH    DE              ; and save it on the stack
5971
        CALL    L1655           ; routine MAKE-ROOM creates BC spaces in
5972
                                ; program area and updates pointers.
5973
        POP     HL              ; restore old program pointer.
5974
        LD      ($5C53),HL      ; and put back in PROG as it may have been
5975
                                ; altered by the POINTERS routine.
5976
 
5977
        POP     BC              ; retrieve BASIC length
5978
        PUSH    BC              ; and save again.
5979
 
5980
        INC     DE              ; points to end of new area.
5981
        LD      HL,($5C61)      ; set HL to WORKSP - location after edit line.
5982
        DEC     HL              ; decrement to address end marker.
5983
        DEC     HL              ; decrement to address carriage return.
5984
        LDDR                    ; copy the BASIC line back to initial command.
5985
 
5986
        LD      HL,($5C49)      ; fetch E_PPC - line number.
5987
        EX      DE,HL           ; swap it to DE, HL points to last of
5988
                                ; four locations.
5989
        POP     BC              ; retrieve length of line.
5990
        LD      (HL),B          ; high byte last.
5991
        DEC     HL              ;
5992
        LD      (HL),C          ; then low byte of length.
5993
        DEC     HL              ;
5994
        LD      (HL),E          ; then low byte of line number.
5995
        DEC     HL              ;
5996
        LD      (HL),D          ; then high byte range $0 - $27 (1-9999).
5997
 
5998
;; MAIN-ADD2
5999
L15AB:  POP     AF              ; drop the address of Report G
6000
        JP      L12A2           ; and back to MAIN-EXEC producing a listing
6001
                                ; and to reset ERR_SP in EDITOR.
6002
 
6003
 
6004
; ---------------------------------
6005
; THE 'INITIAL CHANNEL' INFORMATION
6006
; ---------------------------------
6007
;   This initial channel information is copied from ROM to RAM, during
6008
;   initialization.  It's new location is after the system variables and is
6009
;   addressed by the system variable CHANS which means that it can slide up and
6010
;   down in memory.  The table is never searched, by this ROM, and the last
6011
;   character, which could be anything other than a comma, provides a
6012
;   convenient resting place for DATADD.
6013
 
6014
;; init-chan
6015
L15AF:  DEFW    L09F4           ; PRINT-OUT
6016
        DEFW    L10A8           ; KEY-INPUT
6017
        DEFB    $4B             ; 'K'
6018
        DEFW    L09F4           ; PRINT-OUT
6019
        DEFW    L15C4           ; REPORT-J
6020
        DEFB    $53             ; 'S'
6021
        DEFW    L0F81           ; ADD-CHAR
6022
        DEFW    L15C4           ; REPORT-J
6023
        DEFB    $52             ; 'R'
6024
        DEFW    L09F4           ; PRINT-OUT
6025
        DEFW    L15C4           ; REPORT-J
6026
        DEFB    $50             ; 'P'
6027
 
6028
        DEFB    $80             ; End Marker
6029
 
6030
;; REPORT-J
6031
L15C4:  RST     08H             ; ERROR-1
6032
        DEFB    $12             ; Error Report: Invalid I/O device
6033
 
6034
 
6035
; -------------------------
6036
; THE 'INITIAL STREAM' DATA
6037
; -------------------------
6038
;   This is the initial stream data for the seven streams $FD - $03 that is
6039
;   copied from ROM to the STRMS system variables area during initialization.
6040
;   There are reserved locations there for another 12 streams.  Each location
6041
;   contains an offset to the second byte of a channel.  The first byte of a
6042
;   channel can't be used as that would result in an offset of zero for some
6043
;   and zero is used to denote that a stream is closed.
6044
 
6045
;; init-strm
6046
L15C6:  DEFB    $01, $00        ; stream $FD offset to channel 'K'
6047
        DEFB    $06, $00        ; stream $FE offset to channel 'S'
6048
        DEFB    $0B, $00        ; stream $FF offset to channel 'R'
6049
 
6050
        DEFB    $01, $00        ; stream $00 offset to channel 'K'
6051
        DEFB    $01, $00        ; stream $01 offset to channel 'K'
6052
        DEFB    $06, $00        ; stream $02 offset to channel 'S'
6053
        DEFB    $10, $00        ; stream $03 offset to channel 'P'
6054
 
6055
; ------------------------------
6056
; THE 'INPUT CONTROL' SUBROUTINE
6057
; ------------------------------
6058
;
6059
 
6060
;; WAIT-KEY
6061
L15D4:  BIT     5,(IY+$02)      ; test TV_FLAG - clear lower screen ?
6062
        JR      NZ,L15DE        ; forward to WAIT-KEY1 if so.
6063
 
6064
        SET     3,(IY+$02)      ; update TV_FLAG - signal reprint the edit
6065
                                ; line to the lower screen.
6066
 
6067
;; WAIT-KEY1
6068
L15DE:  CALL    L15E6           ; routine INPUT-AD is called.
6069
 
6070
        RET     C               ; return with acceptable keys.
6071
 
6072
        JR      Z,L15DE         ; back to WAIT-KEY1 if no key is pressed
6073
                                ; or it has been handled within INPUT-AD.
6074
 
6075
;   Note. When inputting from the keyboard all characters are returned with
6076
;   above conditions so this path is never taken.
6077
 
6078
;; REPORT-8
6079
L15E4:  RST     08H             ; ERROR-1
6080
        DEFB    $07             ; Error Report: End of file
6081
 
6082
; ---------------------------
6083
; THE 'INPUT ADDRESS' ROUTINE
6084
; ---------------------------
6085
;   This routine fetches the address of the input stream from the current
6086
;   channel area using the system variable CURCHL.
6087
 
6088
;; INPUT-AD
6089
L15E6:  EXX                     ; switch in alternate set.
6090
        PUSH    HL              ; save HL register
6091
        LD      HL,($5C51)      ; fetch address of CURCHL - current channel.
6092
        INC     HL              ; step over output routine
6093
        INC     HL              ; to point to low byte of input routine.
6094
        JR      L15F7           ; forward to CALL-SUB.
6095
 
6096
; -------------------------
6097
; THE 'CODE OUTPUT' ROUTINE
6098
; -------------------------
6099
;   This routine is called on five occasions to print the ASCII equivalent of
6100
;   a value 0-9.
6101
 
6102
;; OUT-CODE
6103
L15EF:  LD      E,$30           ; add 48 decimal to give the ASCII character
6104
        ADD     A,E             ; '0' to '9' and continue into the main output
6105
                                ; routine.
6106
 
6107
; -------------------------
6108
; THE 'MAIN OUTPUT' ROUTINE
6109
; -------------------------
6110
;   PRINT-A-2 is a continuation of the RST 10 restart that prints any character.
6111
;   The routine prints to the current channel and the printing of control codes
6112
;   may alter that channel to divert subsequent RST 10 instructions to temporary
6113
;   routines. The normal channel is $09F4.
6114
 
6115
;; PRINT-A-2
6116
L15F2:  EXX                     ; switch in alternate set
6117
        PUSH    HL              ; save HL register
6118
        LD      HL,($5C51)      ; fetch CURCHL the current channel.
6119
 
6120
; input-ad rejoins here also.
6121
 
6122
;; CALL-SUB
6123
L15F7:  LD      E,(HL)          ; put the low byte in E.
6124
        INC     HL              ; advance address.
6125
        LD      D,(HL)          ; put the high byte to D.
6126
        EX      DE,HL           ; transfer the stream to HL.
6127
        CALL    L162C           ; use routine CALL-JUMP.
6128
                                ; in effect CALL (HL).
6129
 
6130
        POP     HL              ; restore saved HL register.
6131
        EXX                     ; switch back to the main set and
6132
        RET                     ; return.
6133
 
6134
; --------------------------
6135
; THE 'OPEN CHANNEL' ROUTINE
6136
; --------------------------
6137
;   This subroutine is used by the ROM to open a channel 'K', 'S', 'R' or 'P'.
6138
;   This is either for its own use or in response to a user's request, for
6139
;   example, when '#' is encountered with output - PRINT, LIST etc.
6140
;   or with input - INPUT, INKEY$ etc.
6141
;   It is entered with a system stream $FD - $FF, or a user stream $00 - $0F
6142
;   in the accumulator.
6143
 
6144
;; CHAN-OPEN
6145
L1601:  ADD     A,A             ; double the stream ($FF will become $FE etc.)
6146
        ADD     A,$16           ; add the offset to stream 0 from $5C00
6147
        LD      L,A             ; result to L
6148
        LD      H,$5C           ; now form the address in STRMS area.
6149
        LD      E,(HL)          ; fetch low byte of CHANS offset
6150
        INC     HL              ; address next
6151
        LD      D,(HL)          ; fetch high byte of offset
6152
        LD      A,D             ; test that the stream is open.
6153
        OR      E               ; zero if closed.
6154
        JR      NZ,L1610        ; forward to CHAN-OP-1 if open.
6155
 
6156
;; REPORT-Oa
6157
L160E:  RST     08H             ; ERROR-1
6158
        DEFB    $17             ; Error Report: Invalid stream
6159
 
6160
; continue here if stream was open. Note that the offset is from CHANS
6161
; to the second byte of the channel.
6162
 
6163
;; CHAN-OP-1
6164
L1610:  DEC     DE              ; reduce offset so it points to the channel.
6165
        LD      HL,($5C4F)      ; fetch CHANS the location of the base of
6166
                                ; the channel information area
6167
        ADD     HL,DE           ; and add the offset to address the channel.
6168
                                ; and continue to set flags.
6169
 
6170
; -----------------
6171
; Set channel flags
6172
; -----------------
6173
; This subroutine is used from ED-EDIT, str$ and read-in to reset the
6174
; current channel when it has been temporarily altered.
6175
 
6176
;; CHAN-FLAG
6177
L1615:  LD      ($5C51),HL      ; set CURCHL system variable to the
6178
                                ; address in HL
6179
        RES     4,(IY+$30)      ; update FLAGS2  - signal K channel not in use.
6180
                                ; Note. provide a default for channel 'R'.
6181
        INC     HL              ; advance past
6182
        INC     HL              ; output routine.
6183
        INC     HL              ; advance past
6184
        INC     HL              ; input routine.
6185
        LD      C,(HL)          ; pick up the letter.
6186
        LD      HL,L162D        ; address: chn-cd-lu
6187
        CALL    L16DC           ; routine INDEXER finds offset to a
6188
                                ; flag-setting routine.
6189
 
6190
        RET     NC              ; but if the letter wasn't found in the
6191
                                ; table just return now. - channel 'R'.
6192
 
6193
        LD      D,$00           ; prepare to add
6194
        LD      E,(HL)          ; offset to E
6195
        ADD     HL,DE           ; add offset to location of offset to form
6196
                                ; address of routine
6197
 
6198
;; CALL-JUMP
6199
L162C:  JP      (HL)            ; jump to the routine
6200
 
6201
; Footnote. calling any location that holds JP (HL) is the equivalent to
6202
; a pseudo Z80 instruction CALL (HL). The ROM uses the instruction above.
6203
 
6204
; --------------------------
6205
; Channel code look-up table
6206
; --------------------------
6207
; This table is used by the routine above to find one of the three
6208
; flag setting routines below it.
6209
; A zero end-marker is required as channel 'R' is not present.
6210
 
6211
;; chn-cd-lu
6212
L162D:  DEFB    'K', L1634-$-1  ; offset $06 to CHAN-K
6213
        DEFB    'S', L1642-$-1  ; offset $12 to CHAN-S
6214
        DEFB    'P', L164D-$-1  ; offset $1B to CHAN-P
6215
 
6216
        DEFB    $00             ; end marker.
6217
 
6218
; --------------
6219
; Channel K flag
6220
; --------------
6221
; routine to set flags for lower screen/keyboard channel.
6222
 
6223
;; CHAN-K
6224
L1634:  SET     0,(IY+$02)      ; update TV_FLAG  - signal lower screen in use
6225
        RES     5,(IY+$01)      ; update FLAGS    - signal no new key
6226
        SET     4,(IY+$30)      ; update FLAGS2   - signal K channel in use
6227
        JR      L1646           ; forward to CHAN-S-1 for indirect exit
6228
 
6229
; --------------
6230
; Channel S flag
6231
; --------------
6232
; routine to set flags for upper screen channel.
6233
 
6234
;; CHAN-S
6235
L1642:  RES     0,(IY+$02)      ; TV_FLAG  - signal main screen in use
6236
 
6237
;; CHAN-S-1
6238
L1646:  RES     1,(IY+$01)      ; update FLAGS  - signal printer not in use
6239
        JP      L0D4D           ; jump back to TEMPS and exit via that
6240
                                ; routine after setting temporary attributes.
6241
; --------------
6242
; Channel P flag
6243
; --------------
6244
; This routine sets a flag so that subsequent print related commands
6245
; print to printer or update the relevant system variables.
6246
; This status remains in force until reset by the routine above.
6247
 
6248
;; CHAN-P
6249
L164D:  SET     1,(IY+$01)      ; update FLAGS  - signal printer in use
6250
        RET                     ; return
6251
 
6252
; --------------------------
6253
; THE 'ONE SPACE' SUBROUTINE
6254
; --------------------------
6255
; This routine is called once only to create a single space
6256
; in workspace by ADD-CHAR.
6257
 
6258
;; ONE-SPACE
6259
L1652:  LD      BC,$0001        ; create space for a single character.
6260
 
6261
; ---------
6262
; Make Room
6263
; ---------
6264
; This entry point is used to create BC spaces in various areas such as
6265
; program area, variables area, workspace etc..
6266
; The entire free RAM is available to each BASIC statement.
6267
; On entry, HL addresses where the first location is to be created.
6268
; Afterwards, HL will point to the location before this.
6269
 
6270
;; MAKE-ROOM
6271
L1655:  PUSH    HL              ; save the address pointer.
6272
        CALL    L1F05           ; routine TEST-ROOM checks if room
6273
                                ; exists and generates an error if not.
6274
        POP     HL              ; restore the address pointer.
6275
        CALL    L1664           ; routine POINTERS updates the
6276
                                ; dynamic memory location pointers.
6277
                                ; DE now holds the old value of STKEND.
6278
        LD      HL,($5C65)      ; fetch new STKEND the top destination.
6279
 
6280
        EX      DE,HL           ; HL now addresses the top of the area to
6281
                                ; be moved up - old STKEND.
6282
        LDDR                    ; the program, variables, etc are moved up.
6283
        RET                     ; return with new area ready to be populated.
6284
                                ; HL points to location before new area,
6285
                                ; and DE to last of new locations.
6286
 
6287
; -----------------------------------------------
6288
; Adjust pointers before making or reclaiming room
6289
; -----------------------------------------------
6290
; This routine is called by MAKE-ROOM to adjust upwards and by RECLAIM to
6291
; adjust downwards the pointers within dynamic memory.
6292
; The fourteen pointers to dynamic memory, starting with VARS and ending
6293
; with STKEND, are updated adding BC if they are higher than the position
6294
; in HL.
6295
; The system variables are in no particular order except that STKEND, the first
6296
; free location after dynamic memory must be the last encountered.
6297
 
6298
;; POINTERS
6299
L1664:  PUSH    AF              ; preserve accumulator.
6300
        PUSH    HL              ; put pos pointer on stack.
6301
        LD      HL,$5C4B        ; address VARS the first of the
6302
        LD      A,$0E           ; fourteen variables to consider.
6303
 
6304
;; PTR-NEXT
6305
L166B:  LD      E,(HL)          ; fetch the low byte of the system variable.
6306
        INC     HL              ; advance address.
6307
        LD      D,(HL)          ; fetch high byte of the system variable.
6308
        EX      (SP),HL         ; swap pointer on stack with the variable
6309
                                ; pointer.
6310
        AND     A               ; prepare to subtract.
6311
        SBC     HL,DE           ; subtract variable address
6312
        ADD     HL,DE           ; and add back
6313
        EX      (SP),HL         ; swap pos with system variable pointer
6314
        JR      NC,L167F        ; forward to PTR-DONE if var before pos
6315
 
6316
        PUSH    DE              ; save system variable address.
6317
        EX      DE,HL           ; transfer to HL
6318
        ADD     HL,BC           ; add the offset
6319
        EX      DE,HL           ; back to DE
6320
        LD      (HL),D          ; load high byte
6321
        DEC     HL              ; move back
6322
        LD      (HL),E          ; load low byte
6323
        INC     HL              ; advance to high byte
6324
        POP     DE              ; restore old system variable address.
6325
 
6326
;; PTR-DONE
6327
L167F:  INC     HL              ; address next system variable.
6328
        DEC     A               ; decrease counter.
6329
        JR      NZ,L166B        ; back to PTR-NEXT if more.
6330
        EX      DE,HL           ; transfer old value of STKEND to HL.
6331
                                ; Note. this has always been updated.
6332
        POP     DE              ; pop the address of the position.
6333
 
6334
        POP     AF              ; pop preserved accumulator.
6335
        AND     A               ; clear carry flag preparing to subtract.
6336
 
6337
        SBC     HL,DE           ; subtract position from old stkend
6338
        LD      B,H             ; to give number of data bytes
6339
        LD      C,L             ; to be moved.
6340
        INC     BC              ; increment as we also copy byte at old STKEND.
6341
        ADD     HL,DE           ; recompute old stkend.
6342
        EX      DE,HL           ; transfer to DE.
6343
        RET                     ; return.
6344
 
6345
 
6346
 
6347
; -------------------
6348
; Collect line number
6349
; -------------------
6350
; This routine extracts a line number, at an address that has previously
6351
; been found using LINE-ADDR, and it is entered at LINE-NO. If it encounters
6352
; the program 'end-marker' then the previous line is used and if that
6353
; should also be unacceptable then zero is used as it must be a direct
6354
; command. The program end-marker is the variables end-marker $80, or
6355
; if variables exist, then the first character of any variable name.
6356
 
6357
;; LINE-ZERO
6358
L168F:  DEFB    $00, $00        ; dummy line number used for direct commands
6359
 
6360
 
6361
;; LINE-NO-A
6362
L1691:  EX      DE,HL           ; fetch the previous line to HL and set
6363
        LD      DE,L168F        ; DE to LINE-ZERO should HL also fail.
6364
 
6365
; -> The Entry Point.
6366
 
6367
;; LINE-NO
6368
L1695:  LD      A,(HL)          ; fetch the high byte - max $2F
6369
        AND     $C0             ; mask off the invalid bits.
6370
        JR      NZ,L1691        ; to LINE-NO-A if an end-marker.
6371
 
6372
        LD      D,(HL)          ; reload the high byte.
6373
        INC     HL              ; advance address.
6374
        LD      E,(HL)          ; pick up the low byte.
6375
        RET                     ; return from here.
6376
 
6377
; -------------------
6378
; Handle reserve room
6379
; -------------------
6380
; This is a continuation of the restart BC-SPACES
6381
 
6382
;; RESERVE
6383
L169E:  LD      HL,($5C63)      ; STKBOT first location of calculator stack
6384
        DEC     HL              ; make one less than new location
6385
        CALL    L1655           ; routine MAKE-ROOM creates the room.
6386
        INC     HL              ; address the first new location
6387
        INC     HL              ; advance to second
6388
        POP     BC              ; restore old WORKSP
6389
        LD      ($5C61),BC      ; system variable WORKSP was perhaps
6390
                                ; changed by POINTERS routine.
6391
        POP     BC              ; restore count for return value.
6392
        EX      DE,HL           ; switch. DE = location after first new space
6393
        INC     HL              ; HL now location after new space
6394
        RET                     ; return.
6395
 
6396
; ---------------------------
6397
; Clear various editing areas
6398
; ---------------------------
6399
; This routine sets the editing area, workspace and calculator stack
6400
; to their minimum configurations as at initialization and indeed this
6401
; routine could have been relied on to perform that task.
6402
; This routine uses HL only and returns with that register holding
6403
; WORKSP/STKBOT/STKEND though no use is made of this. The routines also
6404
; reset MEM to its usual place in the systems variable area should it
6405
; have been relocated to a FOR-NEXT variable. The main entry point
6406
; SET-MIN is called at the start of the MAIN-EXEC loop and prior to
6407
; displaying an error.
6408
 
6409
;; SET-MIN
6410
L16B0:  LD      HL,($5C59)      ; fetch E_LINE
6411
        LD      (HL),$0D        ; insert carriage return
6412
        LD      ($5C5B),HL      ; make K_CUR keyboard cursor point there.
6413
        INC     HL              ; next location
6414
        LD      (HL),$80        ; holds end-marker $80
6415
        INC     HL              ; next location becomes
6416
        LD      ($5C61),HL      ; start of WORKSP
6417
 
6418
; This entry point is used prior to input and prior to the execution,
6419
; or parsing, of each statement.
6420
 
6421
;; SET-WORK
6422
L16BF:  LD      HL,($5C61)      ; fetch WORKSP value
6423
        LD      ($5C63),HL      ; and place in STKBOT
6424
 
6425
; This entry point is used to move the stack back to its normal place
6426
; after temporary relocation during line entry and also from ERROR-3
6427
 
6428
;; SET-STK
6429
L16C5:  LD      HL,($5C63)      ; fetch STKBOT value
6430
        LD      ($5C65),HL      ; and place in STKEND.
6431
 
6432
        PUSH    HL              ; perhaps an obsolete entry point.
6433
        LD      HL,$5C92        ; normal location of MEM-0
6434
        LD      ($5C68),HL      ; is restored to system variable MEM.
6435
        POP     HL              ; saved value not required.
6436
        RET                     ; return.
6437
 
6438
; ------------------
6439
; Reclaim edit-line?
6440
; ------------------
6441
; This seems to be legacy code from the ZX80/ZX81 as it is
6442
; not used in this ROM.
6443
; That task, in fact, is performed here by the dual-area routine CLEAR-SP.
6444
; This routine is designed to deal with something that is known to be in the
6445
; edit buffer and not workspace.
6446
; On entry, HL must point to the end of the something to be deleted.
6447
 
6448
;; REC-EDIT
6449
L16D4:  LD      DE,($5C59)      ; fetch start of edit line from E_LINE.
6450
        JP      L19E5           ; jump forward to RECLAIM-1.
6451
 
6452
; --------------------------
6453
; The Table INDEXING routine
6454
; --------------------------
6455
; This routine is used to search two-byte hash tables for a character
6456
; held in C, returning the address of the following offset byte.
6457
; if it is known that the character is in the table e.g. for priorities,
6458
; then the table requires no zero end-marker. If this is not known at the
6459
; outset then a zero end-marker is required and carry is set to signal
6460
; success.
6461
 
6462
;; INDEXER-1
6463
L16DB:  INC     HL              ; address the next pair of values.
6464
 
6465
; -> The Entry Point.
6466
 
6467
;; INDEXER
6468
L16DC:  LD      A,(HL)          ; fetch the first byte of pair
6469
        AND     A               ; is it the end-marker ?
6470
        RET     Z               ; return with carry reset if so.
6471
 
6472
        CP      C               ; is it the required character ?
6473
        INC     HL              ; address next location.
6474
        JR      NZ,L16DB        ; back to INDEXER-1 if no match.
6475
 
6476
        SCF                     ; else set the carry flag.
6477
        RET                     ; return with carry set
6478
 
6479
; --------------------------------
6480
; The Channel and Streams Routines
6481
; --------------------------------
6482
; A channel is an input/output route to a hardware device
6483
; and is identified to the system by a single letter e.g. 'K' for
6484
; the keyboard. A channel can have an input and output route
6485
; associated with it in which case it is bi-directional like
6486
; the keyboard. Others like the upper screen 'S' are output
6487
; only and the input routine usually points to a report message.
6488
; Channels 'K' and 'S' are system channels and it would be inappropriate
6489
; to close the associated streams so a mechanism is provided to
6490
; re-attach them. When the re-attachment is no longer required, then
6491
; closing these streams resets them as at initialization.
6492
; Early adverts said that the network and RS232 were in this ROM.
6493
; Channels 'N' and 'B' are user channels and have been removed successfully
6494
; if, as seems possible, they existed.
6495
; Ironically the tape streamer is not accessed through streams and
6496
; channels.
6497
; Early demonstrations of the Spectrum showed a single microdrive being
6498
; controlled by the main ROM.
6499
 
6500
; ---------------------
6501
; THE 'CLOSE #' COMMAND
6502
; ---------------------
6503
;   This command allows streams to be closed after use.
6504
;   Any temporary memory areas used by the stream would be reclaimed and
6505
;   finally flags set or reset if necessary.
6506
 
6507
;; CLOSE
6508
L16E5:  CALL    L171E           ; routine STR-DATA fetches parameter
6509
                                ; from calculator stack and gets the
6510
                                ; existing STRMS data pointer address in HL
6511
                                ; and stream offset from CHANS in BC.
6512
 
6513
                                ; Note. this offset could be zero if the
6514
                                ; stream is already closed. A check for this
6515
                                ; should occur now and an error should be
6516
                                ; generated, for example,
6517
                                ; Report S 'Stream status closed'.
6518
 
6519
        CALL    L1701           ; routine CLOSE-2 would perform any actions
6520
                                ; peculiar to that stream without disturbing
6521
                                ; data pointer to STRMS entry in HL.
6522
 
6523
        LD      BC,$0000        ; the stream is to be blanked.
6524
        LD      DE,$A3E2        ; the number of bytes from stream 4, $5C1E,
6525
                                ; to $10000
6526
        EX      DE,HL           ; transfer offset to HL, STRMS data pointer
6527
                                ; to DE.
6528
        ADD     HL,DE           ; add the offset to the data pointer.
6529
        JR      C,L16FC         ; forward to CLOSE-1 if a non-system stream.
6530
                                ; i.e. higher than 3.
6531
 
6532
; proceed with a negative result.
6533
 
6534
        LD      BC,L15C6 + 14   ; prepare the address of the byte after
6535
                                ; the initial stream data in ROM. ($15D4)
6536
        ADD     HL,BC           ; index into the data table with negative value.
6537
        LD      C,(HL)          ; low byte to C
6538
        INC     HL              ; address next.
6539
        LD      B,(HL)          ; high byte to B.
6540
 
6541
;   and for streams 0 - 3 just enter the initial data back into the STRMS entry
6542
;   streams 0 - 2 can't be closed as they are shared by the operating system.
6543
;   -> for streams 4 - 15 then blank the entry.
6544
 
6545
;; CLOSE-1
6546
L16FC:  EX      DE,HL           ; address of stream to HL.
6547
        LD      (HL),C          ; place zero (or low byte).
6548
        INC     HL              ; next address.
6549
        LD      (HL),B          ; place zero (or high byte).
6550
        RET                     ; return.
6551
 
6552
; ------------------------
6553
; THE 'CLOSE-2' SUBROUTINE
6554
; ------------------------
6555
;   There is not much point in coming here.
6556
;   The purpose was once to find the offset to a special closing routine,
6557
;   in this ROM and within 256 bytes of the close stream look up table that
6558
;   would reclaim any buffers associated with a stream. At least one has been
6559
;   removed.
6560
;   Any attempt to CLOSE streams $00 to $04, without first opening the stream,
6561
;   will lead to either a system restart or the production of a strange report.
6562
;   credit: Martin Wren-Hilton 1982.
6563
 
6564
;; CLOSE-2
6565
L1701:  PUSH    HL              ; * save address of stream data pointer
6566
                                ; in STRMS on the machine stack.
6567
        LD      HL,($5C4F)      ; fetch CHANS address to HL
6568
        ADD     HL,BC           ; add the offset to address the second
6569
                                ; byte of the output routine hopefully.
6570
        INC     HL              ; step past
6571
        INC     HL              ; the input routine.
6572
 
6573
;    Note. When the Sinclair Interface1 is fitted then an instruction fetch
6574
;    on the next address pages this ROM out and the shadow ROM in.
6575
 
6576
;; ROM_TRAP
6577
L1708:  INC     HL              ; to address channel's letter
6578
        LD      C,(HL)          ; pick it up in C.
6579
                                ; Note. but if stream is already closed we
6580
                                ; get the value $10 (the byte preceding 'K').
6581
 
6582
        EX      DE,HL           ; save the pointer to the letter in DE.
6583
 
6584
;   Note. The string pointer is saved but not used!!
6585
 
6586
        LD      HL,L1716        ; address: cl-str-lu in ROM.
6587
        CALL    L16DC           ; routine INDEXER uses the code to get
6588
                                ; the 8-bit offset from the current point to
6589
                                ; the address of the closing routine in ROM.
6590
                                ; Note. it won't find $10 there!
6591
 
6592
        LD      C,(HL)          ; transfer the offset to C.
6593
        LD      B,$00           ; prepare to add.
6594
        ADD     HL,BC           ; add offset to point to the address of the
6595
                                ; routine that closes the stream.
6596
                                ; (and presumably removes any buffers that
6597
                                ; are associated with it.)
6598
        JP      (HL)            ; jump to that routine.
6599
 
6600
; --------------------------------
6601
; THE 'CLOSE STREAM LOOK-UP' TABLE
6602
; --------------------------------
6603
;   This table contains an entry for a letter found in the CHANS area.
6604
;   followed by an 8-bit displacement, from that byte's address in the
6605
;   table to the routine that performs any ancillary actions associated
6606
;   with closing the stream of that channel.
6607
;   The table doesn't require a zero end-marker as the letter has been
6608
;   picked up from a channel that has an open stream.
6609
 
6610
;; cl-str-lu
6611
L1716:  DEFB    'K', L171C-$-1  ; offset 5 to CLOSE-STR
6612
        DEFB    'S', L171C-$-1  ; offset 3 to CLOSE-STR
6613
        DEFB    'P', L171C-$-1  ; offset 1 to CLOSE-STR
6614
 
6615
 
6616
; ------------------------------
6617
; THE 'CLOSE STREAM' SUBROUTINES
6618
; ------------------------------
6619
; The close stream routines in fact have no ancillary actions to perform
6620
; which is not surprising with regard to 'K' and 'S'.
6621
 
6622
;; CLOSE-STR
6623
L171C:  POP     HL              ; * now just restore the stream data pointer
6624
        RET                     ; in STRMS and return.
6625
 
6626
; -----------
6627
; Stream data
6628
; -----------
6629
; This routine finds the data entry in the STRMS area for the specified
6630
; stream which is passed on the calculator stack. It returns with HL
6631
; pointing to this system variable and BC holding a displacement from
6632
; the CHANS area to the second byte of the stream's channel. If BC holds
6633
; zero, then that signifies that the stream is closed.
6634
 
6635
;; STR-DATA
6636
L171E:  CALL    L1E94           ; routine FIND-INT1 fetches parameter to A
6637
        CP      $10             ; is it less than 16d ?
6638
        JR      C,L1727         ; skip forward to STR-DATA1 if so.
6639
 
6640
;; REPORT-Ob
6641
L1725:  RST     08H             ; ERROR-1
6642
        DEFB    $17             ; Error Report: Invalid stream
6643
 
6644
;; STR-DATA1
6645
L1727:  ADD     A,$03           ; add the offset for 3 system streams.
6646
                                ; range 00 - 15d becomes 3 - 18d.
6647
        RLCA                    ; double as there are two bytes per
6648
                                ; stream - now 06 - 36d
6649
        LD      HL,$5C10        ; address STRMS - the start of the streams
6650
                                ; data area in system variables.
6651
        LD      C,A             ; transfer the low byte to A.
6652
        LD      B,$00           ; prepare to add offset.
6653
        ADD     HL,BC           ; add to address the data entry in STRMS.
6654
 
6655
; the data entry itself contains an offset from CHANS to the address of the
6656
; stream
6657
 
6658
        LD      C,(HL)          ; low byte of displacement to C.
6659
        INC     HL              ; address next.
6660
        LD      B,(HL)          ; high byte of displacement to B.
6661
        DEC     HL              ; step back to leave HL pointing to STRMS
6662
                                ; data entry.
6663
        RET                     ; return with CHANS displacement in BC
6664
                                ; and address of stream data entry in HL.
6665
 
6666
; --------------------
6667
; Handle OPEN# command
6668
; --------------------
6669
; Command syntax example: OPEN #5,"s"
6670
; On entry the channel code entry is on the calculator stack with the next
6671
; value containing the stream identifier. They have to swapped.
6672
 
6673
;; OPEN
6674
L1736:  RST     28H             ;; FP-CALC    ;s,c.
6675
        DEFB    $01             ;;exchange    ;c,s.
6676
        DEFB    $38             ;;end-calc
6677
 
6678
        CALL    L171E           ; routine STR-DATA fetches the stream off
6679
                                ; the stack and returns with the CHANS
6680
                                ; displacement in BC and HL addressing
6681
                                ; the STRMS data entry.
6682
        LD      A,B             ; test for zero which
6683
        OR      C               ; indicates the stream is closed.
6684
        JR      Z,L1756         ; skip forward to OPEN-1 if so.
6685
 
6686
; if it is a system channel then it can re-attached.
6687
 
6688
        EX      DE,HL           ; save STRMS address in DE.
6689
        LD      HL,($5C4F)      ; fetch CHANS.
6690
        ADD     HL,BC           ; add the offset to address the second
6691
                                ; byte of the channel.
6692
        INC     HL              ; skip over the
6693
        INC     HL              ; input routine.
6694
        INC     HL              ; and address the letter.
6695
        LD      A,(HL)          ; pick up the letter.
6696
        EX      DE,HL           ; save letter pointer and bring back
6697
                                ; the STRMS pointer.
6698
 
6699
        CP      $4B             ; is it 'K' ?
6700
        JR      Z,L1756         ; forward to OPEN-1 if so
6701
 
6702
        CP      $53             ; is it 'S' ?
6703
        JR      Z,L1756         ; forward to OPEN-1 if so
6704
 
6705
        CP      $50             ; is it 'P' ?
6706
        JR      NZ,L1725        ; back to REPORT-Ob if not.
6707
                                ; to report 'Invalid stream'.
6708
 
6709
; continue if one of the upper-case letters was found.
6710
; and rejoin here from above if stream was closed.
6711
 
6712
;; OPEN-1
6713
L1756:  CALL    L175D           ; routine OPEN-2 opens the stream.
6714
 
6715
; it now remains to update the STRMS variable.
6716
 
6717
        LD      (HL),E          ; insert or overwrite the low byte.
6718
        INC     HL              ; address high byte in STRMS.
6719
        LD      (HL),D          ; insert or overwrite the high byte.
6720
        RET                     ; return.
6721
 
6722
; -----------------
6723
; OPEN-2 Subroutine
6724
; -----------------
6725
; There is some point in coming here as, as well as once creating buffers,
6726
; this routine also sets flags.
6727
 
6728
;; OPEN-2
6729
L175D:  PUSH    HL              ; * save the STRMS data entry pointer.
6730
        CALL    L2BF1           ; routine STK-FETCH now fetches the
6731
                                ; parameters of the channel string.
6732
                                ; start in DE, length in BC.
6733
 
6734
        LD      A,B             ; test that it is not
6735
        OR      C               ; the null string.
6736
        JR      NZ,L1767        ; skip forward to OPEN-3 with 1 character
6737
                                ; or more!
6738
 
6739
;; REPORT-Fb
6740
L1765:  RST     08H             ; ERROR-1
6741
        DEFB    $0E             ; Error Report: Invalid file name
6742
 
6743
;; OPEN-3
6744
L1767:  PUSH    BC              ; save the length of the string.
6745
        LD      A,(DE)          ; pick up the first character.
6746
                                ; Note. There can be more than one character.
6747
        AND     $DF             ; make it upper-case.
6748
        LD      C,A             ; place it in C.
6749
        LD      HL,L177A        ; address: op-str-lu is loaded.
6750
        CALL    L16DC           ; routine INDEXER will search for letter.
6751
        JR      NC,L1765        ; back to REPORT-F if not found
6752
                                ; 'Invalid filename'
6753
 
6754
        LD      C,(HL)          ; fetch the displacement to opening routine.
6755
        LD      B,$00           ; prepare to add.
6756
        ADD     HL,BC           ; now form address of opening routine.
6757
        POP     BC              ; restore the length of string.
6758
        JP      (HL)            ; now jump forward to the relevant routine.
6759
 
6760
; -------------------------
6761
; OPEN stream look-up table
6762
; -------------------------
6763
; The open stream look-up table consists of matched pairs.
6764
; The channel letter is followed by an 8-bit displacement to the
6765
; associated stream-opening routine in this ROM.
6766
; The table requires a zero end-marker as the letter has been
6767
; provided by the user and not the operating system.
6768
 
6769
;; op-str-lu
6770
L177A:  DEFB    'K', L1781-$-1  ; $06 offset to OPEN-K
6771
        DEFB    'S', L1785-$-1  ; $08 offset to OPEN-S
6772
        DEFB    'P', L1789-$-1  ; $0A offset to OPEN-P
6773
 
6774
        DEFB    $00             ; end-marker.
6775
 
6776
; ----------------------------
6777
; The Stream Opening Routines.
6778
; ----------------------------
6779
; These routines would have opened any buffers associated with the stream
6780
; before jumping forward to OPEN-END with the displacement value in E
6781
; and perhaps a modified value in BC. The strange pathing does seem to
6782
; provide for flexibility in this respect.
6783
;
6784
; There is no need to open the printer buffer as it is there already
6785
; even if you are still saving up for a ZX Printer or have moved onto
6786
; something bigger. In any case it would have to be created after
6787
; the system variables but apart from that it is a simple task
6788
; and all but one of the ROM routines can handle a buffer in that position.
6789
; (PR-ALL-6 would require an extra 3 bytes of code).
6790
; However it wouldn't be wise to have two streams attached to the ZX Printer
6791
; as you can now, so one assumes that if PR_CC_hi was non-zero then
6792
; the OPEN-P routine would have refused to attach a stream if another
6793
; stream was attached.
6794
 
6795
; Something of significance is being passed to these ghost routines in the
6796
; second character. Strings 'RB', 'RT' perhaps or a drive/station number.
6797
; The routine would have to deal with that and exit to OPEN_END with BC
6798
; containing $0001 or more likely there would be an exit within the routine.
6799
; Anyway doesn't matter, these routines are long gone.
6800
 
6801
; -----------------
6802
; OPEN-K Subroutine
6803
; -----------------
6804
; Open Keyboard stream.
6805
 
6806
;; OPEN-K
6807
L1781:  LD      E,$01           ; 01 is offset to second byte of channel 'K'.
6808
        JR      L178B           ; forward to OPEN-END
6809
 
6810
; -----------------
6811
; OPEN-S Subroutine
6812
; -----------------
6813
; Open Screen stream.
6814
 
6815
;; OPEN-S
6816
L1785:  LD      E,$06           ; 06 is offset to 2nd byte of channel 'S'
6817
        JR      L178B           ; to OPEN-END
6818
 
6819
; -----------------
6820
; OPEN-P Subroutine
6821
; -----------------
6822
; Open Printer stream.
6823
 
6824
;; OPEN-P
6825
L1789:  LD      E,$10           ; 16d is offset to 2nd byte of channel 'P'
6826
 
6827
;; OPEN-END
6828
L178B:  DEC     BC              ; the stored length of 'K','S','P' or
6829
                                ; whatever is now tested. ??
6830
        LD      A,B             ; test now if initial or residual length
6831
        OR      C               ; is one character.
6832
        JR      NZ,L1765        ; to REPORT-Fb 'Invalid file name' if not.
6833
 
6834
        LD      D,A             ; load D with zero to form the displacement
6835
                                ; in the DE register.
6836
        POP     HL              ; * restore the saved STRMS pointer.
6837
        RET                     ; return to update STRMS entry thereby
6838
                                ; signaling stream is open.
6839
 
6840
; ----------------------------------------
6841
; Handle CAT, ERASE, FORMAT, MOVE commands
6842
; ----------------------------------------
6843
; These just generate an error report as the ROM is 'incomplete'.
6844
;
6845
; Luckily this provides a mechanism for extending these in a shadow ROM
6846
; but without the powerful mechanisms set up in this ROM.
6847
; An instruction fetch on $0008 may page in a peripheral ROM,
6848
; e.g. the Sinclair Interface 1 ROM, to handle these commands.
6849
; However that wasn't the plan.
6850
; Development of this ROM continued for another three months until the cost
6851
; of replacing it and the manual became unfeasible.
6852
; The ultimate power of channels and streams died at birth.
6853
 
6854
;; CAT-ETC
6855
L1793:  JR      L1725           ; to REPORT-Ob
6856
 
6857
; -----------------
6858
; Perform AUTO-LIST
6859
; -----------------
6860
; This produces an automatic listing in the upper screen.
6861
 
6862
;; AUTO-LIST
6863
L1795:  LD      ($5C3F),SP      ; save stack pointer in LIST_SP
6864
        LD      (IY+$02),$10    ; update TV_FLAG set bit 3
6865
        CALL    L0DAF           ; routine CL-ALL.
6866
        SET     0,(IY+$02)      ; update TV_FLAG  - signal lower screen in use
6867
 
6868
        LD      B,(IY+$31)      ; fetch DF_SZ to B.
6869
        CALL    L0E44           ; routine CL-LINE clears lower display
6870
                                ; preserving B.
6871
        RES     0,(IY+$02)      ; update TV_FLAG  - signal main screen in use
6872
        SET     0,(IY+$30)      ; update FLAGS2 - signal will be necessary to
6873
                                ; clear main screen.
6874
        LD      HL,($5C49)      ; fetch E_PPC current edit line to HL.
6875
        LD      DE,($5C6C)      ; fetch S_TOP to DE, the current top line
6876
                                ; (initially zero)
6877
        AND     A               ; prepare for true subtraction.
6878
        SBC     HL,DE           ; subtract and
6879
        ADD     HL,DE           ; add back.
6880
        JR      C,L17E1         ; to AUTO-L-2 if S_TOP higher than E_PPC
6881
                                ; to set S_TOP to E_PPC
6882
 
6883
        PUSH    DE              ; save the top line number.
6884
        CALL    L196E           ; routine LINE-ADDR gets address of E_PPC.
6885
        LD      DE,$02C0        ; prepare known number of characters in
6886
                                ; the default upper screen.
6887
        EX      DE,HL           ; offset to HL, program address to DE.
6888
        SBC     HL,DE           ; subtract high value from low to obtain
6889
                                ; negated result used in addition.
6890
        EX      (SP),HL         ; swap result with top line number on stack.
6891
        CALL    L196E           ; routine LINE-ADDR  gets address of that
6892
                                ; top line in HL and next line in DE.
6893
        POP     BC              ; restore the result to balance stack.
6894
 
6895
;; AUTO-L-1
6896
L17CE:  PUSH    BC              ; save the result.
6897
        CALL    L19B8           ; routine NEXT-ONE gets address in HL of
6898
                                ; line after auto-line (in DE).
6899
        POP     BC              ; restore result.
6900
        ADD     HL,BC           ; compute back.
6901
        JR      C,L17E4         ; to AUTO-L-3 if line 'should' appear
6902
 
6903
        EX      DE,HL           ; address of next line to HL.
6904
        LD      D,(HL)          ; get line
6905
        INC     HL              ; number
6906
        LD      E,(HL)          ; in DE.
6907
        DEC     HL              ; adjust back to start.
6908
        LD      ($5C6C),DE      ; update S_TOP.
6909
        JR      L17CE           ; to AUTO-L-1 until estimate reached.
6910
 
6911
; ---
6912
 
6913
; the jump was to here if S_TOP was greater than E_PPC
6914
 
6915
;; AUTO-L-2
6916
L17E1:  LD      ($5C6C),HL      ; make S_TOP the same as E_PPC.
6917
 
6918
; continue here with valid starting point from above or good estimate
6919
; from computation
6920
 
6921
;; AUTO-L-3
6922
L17E4:  LD      HL,($5C6C)      ; fetch S_TOP line number to HL.
6923
        CALL    L196E           ; routine LINE-ADDR gets address in HL.
6924
                                ; address of next in DE.
6925
        JR      Z,L17ED         ; to AUTO-L-4 if line exists.
6926
 
6927
        EX      DE,HL           ; else use address of next line.
6928
 
6929
;; AUTO-L-4
6930
L17ED:  CALL    L1833           ; routine LIST-ALL                >>>
6931
 
6932
; The return will be to here if no scrolling occurred
6933
 
6934
        RES     4,(IY+$02)      ; update TV_FLAG  - signal no auto listing.
6935
        RET                     ; return.
6936
 
6937
; ------------
6938
; Handle LLIST
6939
; ------------
6940
; A short form of LIST #3. The listing goes to stream 3 - default printer.
6941
 
6942
;; LLIST
6943
L17F5:  LD      A,$03           ; the usual stream for ZX Printer
6944
        JR      L17FB           ; forward to LIST-1
6945
 
6946
; -----------
6947
; Handle LIST
6948
; -----------
6949
; List to any stream.
6950
; Note. While a starting line can be specified it is
6951
; not possible to specify an end line.
6952
; Just listing a line makes it the current edit line.
6953
 
6954
;; LIST
6955
L17F9:  LD      A,$02           ; default is stream 2 - the upper screen.
6956
 
6957
;; LIST-1
6958
L17FB:  LD      (IY+$02),$00    ; the TV_FLAG is initialized with bit 0 reset
6959
                                ; indicating upper screen in use.
6960
        CALL    L2530           ; routine SYNTAX-Z - checking syntax ?
6961
        CALL    NZ,L1601        ; routine CHAN-OPEN if in run-time.
6962
 
6963
        RST     18H             ; GET-CHAR
6964
        CALL    L2070           ; routine STR-ALTER will alter if '#'.
6965
        JR      C,L181F         ; forward to LIST-4 not a '#' .
6966
 
6967
 
6968
        RST     18H             ; GET-CHAR
6969
        CP      $3B             ; is it ';' ?
6970
        JR      Z,L1814         ; skip to LIST-2 if so.
6971
 
6972
        CP      $2C             ; is it ',' ?
6973
        JR      NZ,L181A        ; forward to LIST-3 if neither separator.
6974
 
6975
; we have, say,  LIST #15, and a number must follow the separator.
6976
 
6977
;; LIST-2
6978
L1814:  RST     20H             ; NEXT-CHAR
6979
        CALL    L1C82           ; routine EXPT-1NUM
6980
        JR      L1822           ; forward to LIST-5
6981
 
6982
; ---
6983
 
6984
; the branch was here with just LIST #3 etc.
6985
 
6986
;; LIST-3
6987
L181A:  CALL    L1CE6           ; routine USE-ZERO
6988
        JR      L1822           ; forward to LIST-5
6989
 
6990
; ---
6991
 
6992
; the branch was here with LIST
6993
 
6994
;; LIST-4
6995
L181F:  CALL    L1CDE           ; routine FETCH-NUM checks if a number
6996
                                ; follows else uses zero.
6997
 
6998
;; LIST-5
6999
L1822:  CALL    L1BEE           ; routine CHECK-END quits if syntax OK >>>
7000
 
7001
        CALL    L1E99           ; routine FIND-INT2 fetches the number
7002
                                ; from the calculator stack in run-time.
7003
        LD      A,B             ; fetch high byte of line number and
7004
        AND     $3F             ; make less than $40 so that NEXT-ONE
7005
                                ; (from LINE-ADDR) doesn't lose context.
7006
                                ; Note. this is not satisfactory and the typo
7007
                                ; LIST 20000 will list an entirely different
7008
                                ; section than LIST 2000. Such typos are not
7009
                                ; available for checking if they are direct
7010
                                ; commands.
7011
 
7012
        LD      H,A             ; transfer the modified
7013
        LD      L,C             ; line number to HL.
7014
        LD      ($5C49),HL      ; update E_PPC to new line number.
7015
        CALL    L196E           ; routine LINE-ADDR gets the address of the
7016
                                ; line.
7017
 
7018
; This routine is called from AUTO-LIST
7019
 
7020
;; LIST-ALL
7021
L1833:  LD      E,$01           ; signal current line not yet printed
7022
 
7023
;; LIST-ALL-2
7024
L1835:  CALL    L1855           ; routine OUT-LINE outputs a BASIC line
7025
                                ; using PRINT-OUT and makes an early return
7026
                                ; when no more lines to print. >>>
7027
 
7028
        RST     10H             ; PRINT-A prints the carriage return (in A)
7029
 
7030
        BIT     4,(IY+$02)      ; test TV_FLAG  - automatic listing ?
7031
        JR      Z,L1835         ; back to LIST-ALL-2 if not
7032
                                ; (loop exit is via OUT-LINE)
7033
 
7034
; continue here if an automatic listing required.
7035
 
7036
        LD      A,($5C6B)       ; fetch DF_SZ lower display file size.
7037
        SUB     (IY+$4F)        ; subtract S_POSN_hi ithe current line number.
7038
        JR      NZ,L1835        ; back to LIST-ALL-2 if upper screen not full.
7039
 
7040
        XOR     E               ; A contains zero, E contains one if the
7041
                                ; current edit line has not been printed
7042
                                ; or zero if it has (from OUT-LINE).
7043
        RET     Z               ; return if the screen is full and the line
7044
                                ; has been printed.
7045
 
7046
; continue with automatic listings if the screen is full and the current
7047
; edit line is missing. OUT-LINE will scroll automatically.
7048
 
7049
        PUSH    HL              ; save the pointer address.
7050
        PUSH    DE              ; save the E flag.
7051
        LD      HL,$5C6C        ; fetch S_TOP the rough estimate.
7052
        CALL    L190F           ; routine LN-FETCH updates S_TOP with
7053
                                ; the number of the next line.
7054
        POP     DE              ; restore the E flag.
7055
        POP     HL              ; restore the address of the next line.
7056
        JR      L1835           ; back to LIST-ALL-2.
7057
 
7058
; ------------------------
7059
; Print a whole BASIC line
7060
; ------------------------
7061
; This routine prints a whole BASIC line and it is called
7062
; from LIST-ALL to output the line to current channel
7063
; and from ED-EDIT to 'sprint' the line to the edit buffer.
7064
 
7065
;; OUT-LINE
7066
L1855:  LD      BC,($5C49)      ; fetch E_PPC the current line which may be
7067
                                ; unchecked and not exist.
7068
        CALL    L1980           ; routine CP-LINES finds match or line after.
7069
        LD      D,$3E           ; prepare cursor '>' in D.
7070
        JR      Z,L1865         ; to OUT-LINE1 if matched or line after.
7071
 
7072
        LD      DE,$0000        ; put zero in D, to suppress line cursor.
7073
        RL      E               ; pick up carry in E if line before current
7074
                                ; leave E zero if same or after.
7075
 
7076
;; OUT-LINE1
7077
L1865:  LD      (IY+$2D),E      ; save flag in BREG which is spare.
7078
        LD      A,(HL)          ; get high byte of line number.
7079
        CP      $40             ; is it too high ($2F is maximum possible) ?
7080
        POP     BC              ; drop the return address and
7081
        RET     NC              ; make an early return if so >>>
7082
 
7083
        PUSH    BC              ; save return address
7084
        CALL    L1A28           ; routine OUT-NUM-2 to print addressed number
7085
                                ; with leading space.
7086
        INC     HL              ; skip low number byte.
7087
        INC     HL              ; and the two
7088
        INC     HL              ; length bytes.
7089
        RES     0,(IY+$01)      ; update FLAGS - signal leading space required.
7090
        LD      A,D             ; fetch the cursor.
7091
        AND     A               ; test for zero.
7092
        JR      Z,L1881         ; to OUT-LINE3 if zero.
7093
 
7094
 
7095
        RST     10H             ; PRINT-A prints '>' the current line cursor.
7096
 
7097
; this entry point is called from ED-COPY
7098
 
7099
;; OUT-LINE2
7100
L187D:  SET     0,(IY+$01)      ; update FLAGS - suppress leading space.
7101
 
7102
;; OUT-LINE3
7103
L1881:  PUSH    DE              ; save flag E for a return value.
7104
        EX      DE,HL           ; save HL address in DE.
7105
        RES     2,(IY+$30)      ; update FLAGS2 - signal NOT in QUOTES.
7106
 
7107
        LD      HL,$5C3B        ; point to FLAGS.
7108
        RES     2,(HL)          ; signal 'K' mode. (starts before keyword)
7109
        BIT     5,(IY+$37)      ; test FLAGX - input mode ?
7110
        JR      Z,L1894         ; forward to OUT-LINE4 if not.
7111
 
7112
        SET     2,(HL)          ; signal 'L' mode. (used for input)
7113
 
7114
;; OUT-LINE4
7115
L1894:  LD      HL,($5C5F)      ; fetch X_PTR - possibly the error pointer
7116
                                ; address.
7117
        AND     A               ; clear the carry flag.
7118
        SBC     HL,DE           ; test if an error address has been reached.
7119
        JR      NZ,L18A1        ; forward to OUT-LINE5 if not.
7120
 
7121
        LD      A,$3F           ; load A with '?' the error marker.
7122
        CALL    L18C1           ; routine OUT-FLASH to print flashing marker.
7123
 
7124
;; OUT-LINE5
7125
L18A1:  CALL    L18E1           ; routine OUT-CURS will print the cursor if
7126
                                ; this is the right position.
7127
        EX      DE,HL           ; restore address pointer to HL.
7128
        LD      A,(HL)          ; fetch the addressed character.
7129
        CALL    L18B6           ; routine NUMBER skips a hidden floating
7130
                                ; point number if present.
7131
        INC     HL              ; now increment the pointer.
7132
        CP      $0D             ; is character end-of-line ?
7133
        JR      Z,L18B4         ; to OUT-LINE6, if so, as line is finished.
7134
 
7135
        EX      DE,HL           ; save the pointer in DE.
7136
        CALL    L1937           ; routine OUT-CHAR to output character/token.
7137
 
7138
        JR      L1894           ; back to OUT-LINE4 until entire line is done.
7139
 
7140
; ---
7141
 
7142
;; OUT-LINE6
7143
L18B4:  POP     DE              ; bring back the flag E, zero if current
7144
                                ; line printed else 1 if still to print.
7145
        RET                     ; return with A holding $0D
7146
 
7147
; -------------------------
7148
; Check for a number marker
7149
; -------------------------
7150
; this subroutine is called from two processes. while outputting BASIC lines
7151
; and while searching statements within a BASIC line.
7152
; during both, this routine will pass over an invisible number indicator
7153
; and the five bytes floating-point number that follows it.
7154
; Note that this causes floating point numbers to be stripped from
7155
; the BASIC line when it is fetched to the edit buffer by OUT_LINE.
7156
; the number marker also appears after the arguments of a DEF FN statement
7157
; and may mask old 5-byte string parameters.
7158
 
7159
;; NUMBER
7160
L18B6:  CP      $0E             ; character fourteen ?
7161
        RET     NZ              ; return if not.
7162
 
7163
        INC     HL              ; skip the character
7164
        INC     HL              ; and five bytes
7165
        INC     HL              ; following.
7166
        INC     HL              ;
7167
        INC     HL              ;
7168
        INC     HL              ;
7169
        LD      A,(HL)          ; fetch the following character
7170
        RET                     ; for return value.
7171
 
7172
; --------------------------
7173
; Print a flashing character
7174
; --------------------------
7175
; This subroutine is called from OUT-LINE to print a flashing error
7176
; marker '?' or from the next routine to print a flashing cursor e.g. 'L'.
7177
; However, this only gets called from OUT-LINE when printing the edit line
7178
; or the input buffer to the lower screen so a direct call to $09F4 can
7179
; be used, even though out-line outputs to other streams.
7180
; In fact the alternate set is used for the whole routine.
7181
 
7182
;; OUT-FLASH
7183
L18C1:  EXX                     ; switch in alternate set
7184
 
7185
        LD      HL,($5C8F)      ; fetch L = ATTR_T, H = MASK-T
7186
        PUSH    HL              ; save masks.
7187
        RES     7,H             ; reset flash mask bit so active.
7188
        SET     7,L             ; make attribute FLASH.
7189
        LD      ($5C8F),HL      ; resave ATTR_T and MASK-T
7190
 
7191
        LD      HL,$5C91        ; address P_FLAG
7192
        LD      D,(HL)          ; fetch to D
7193
        PUSH    DE              ; and save.
7194
        LD      (HL),$00        ; clear inverse, over, ink/paper 9
7195
 
7196
        CALL    L09F4           ; routine PRINT-OUT outputs character
7197
                                ; without the need to vector via RST 10.
7198
 
7199
        POP     HL              ; pop P_FLAG to H.
7200
        LD      (IY+$57),H      ; and restore system variable P_FLAG.
7201
        POP     HL              ; restore temporary masks
7202
        LD      ($5C8F),HL      ; and restore system variables ATTR_T/MASK_T
7203
 
7204
        EXX                     ; switch back to main set
7205
        RET                     ; return
7206
 
7207
; ----------------
7208
; Print the cursor
7209
; ----------------
7210
; This routine is called before any character is output while outputting
7211
; a BASIC line or the input buffer. This includes listing to a printer
7212
; or screen, copying a BASIC line to the edit buffer and printing the
7213
; input buffer or edit buffer to the lower screen. It is only in the
7214
; latter two cases that it has any relevance and in the last case it
7215
; performs another very important function also.
7216
 
7217
;; OUT-CURS
7218
L18E1:  LD      HL,($5C5B)      ; fetch K_CUR the current cursor address
7219
        AND     A               ; prepare for true subtraction.
7220
        SBC     HL,DE           ; test against pointer address in DE and
7221
        RET     NZ              ; return if not at exact position.
7222
 
7223
; the value of MODE, maintained by KEY-INPUT, is tested and if non-zero
7224
; then this value 'E' or 'G' will take precedence.
7225
 
7226
        LD      A,($5C41)       ; fetch MODE  0='KLC', 1='E', 2='G'.
7227
        RLC     A               ; double the value and set flags.
7228
        JR      Z,L18F3         ; to OUT-C-1 if still zero ('KLC').
7229
 
7230
        ADD     A,$43           ; add 'C' - will become 'E' if originally 1
7231
                                ; or 'G' if originally 2.
7232
        JR      L1909           ; forward to OUT-C-2 to print.
7233
 
7234
; ---
7235
 
7236
; If mode was zero then, while printing a BASIC line, bit 2 of flags has been
7237
; set if 'THEN' or ':' was encountered as a main character and reset otherwise.
7238
; This is now used to determine if the 'K' cursor is to be printed but this
7239
; transient state is also now transferred permanently to bit 3 of FLAGS
7240
; to let the interrupt routine know how to decode the next key.
7241
 
7242
;; OUT-C-1
7243
L18F3:  LD      HL,$5C3B        ; Address FLAGS
7244
        RES     3,(HL)          ; signal 'K' mode initially.
7245
        LD      A,$4B           ; prepare letter 'K'.
7246
        BIT     2,(HL)          ; test FLAGS - was the
7247
                                ; previous main character ':' or 'THEN' ?
7248
        JR      Z,L1909         ; forward to OUT-C-2 if so to print.
7249
 
7250
        SET     3,(HL)          ; signal 'L' mode to interrupt routine.
7251
                                ; Note. transient bit has been made permanent.
7252
        INC     A               ; augment from 'K' to 'L'.
7253
 
7254
        BIT     3,(IY+$30)      ; test FLAGS2 - consider caps lock ?
7255
                                ; which is maintained by KEY-INPUT.
7256
        JR      Z,L1909         ; forward to OUT-C-2 if not set to print.
7257
 
7258
        LD      A,$43           ; alter 'L' to 'C'.
7259
 
7260
;; OUT-C-2
7261
L1909:  PUSH    DE              ; save address pointer but OK as OUT-FLASH
7262
                                ; uses alternate set without RST 10.
7263
 
7264
        CALL    L18C1           ; routine OUT-FLASH to print.
7265
 
7266
        POP     DE              ; restore and
7267
        RET                     ; return.
7268
 
7269
; ----------------------------
7270
; Get line number of next line
7271
; ----------------------------
7272
; These two subroutines are called while editing.
7273
; This entry point is from ED-DOWN with HL addressing E_PPC
7274
; to fetch the next line number.
7275
; Also from AUTO-LIST with HL addressing S_TOP just to update S_TOP
7276
; with the value of the next line number. It gets fetched but is discarded.
7277
; These routines never get called while the editor is being used for input.
7278
 
7279
;; LN-FETCH
7280
L190F:  LD      E,(HL)          ; fetch low byte
7281
        INC     HL              ; address next
7282
        LD      D,(HL)          ; fetch high byte.
7283
        PUSH    HL              ; save system variable hi pointer.
7284
        EX      DE,HL           ; line number to HL,
7285
        INC     HL              ; increment as a starting point.
7286
        CALL    L196E           ; routine LINE-ADDR gets address in HL.
7287
        CALL    L1695           ; routine LINE-NO gets line number in DE.
7288
        POP     HL              ; restore system variable hi pointer.
7289
 
7290
; This entry point is from the ED-UP with HL addressing E_PPC_hi
7291
 
7292
;; LN-STORE
7293
L191C:  BIT     5,(IY+$37)      ; test FLAGX - input mode ?
7294
        RET     NZ              ; return if so.
7295
                                ; Note. above already checked by ED-UP/ED-DOWN.
7296
 
7297
        LD      (HL),D          ; save high byte of line number.
7298
        DEC     HL              ; address lower
7299
        LD      (HL),E          ; save low byte of line number.
7300
        RET                     ; return.
7301
 
7302
; -----------------------------------------
7303
; Outputting numbers at start of BASIC line
7304
; -----------------------------------------
7305
; This routine entered at OUT-SP-NO is used to compute then output the first
7306
; three digits of a 4-digit BASIC line printing a space if necessary.
7307
; The line number, or residual part, is held in HL and the BC register
7308
; holds a subtraction value -1000, -100 or -10.
7309
; Note. for example line number 200 -
7310
; space(out_char), 2(out_code), 0(out_char) final number always out-code.
7311
 
7312
;; OUT-SP-2
7313
L1925:  LD      A,E             ; will be space if OUT-CODE not yet called.
7314
                                ; or $FF if spaces are suppressed.
7315
                                ; else $30 ('0').
7316
                                ; (from the first instruction at OUT-CODE)
7317
                                ; this guy is just too clever.
7318
        AND     A               ; test bit 7 of A.
7319
        RET     M               ; return if $FF, as leading spaces not
7320
                                ; required. This is set when printing line
7321
                                ; number and statement in MAIN-5.
7322
 
7323
        JR      L1937           ; forward to exit via OUT-CHAR.
7324
 
7325
; ---
7326
 
7327
; -> the single entry point.
7328
 
7329
;; OUT-SP-NO
7330
L192A:  XOR     A               ; initialize digit to 0
7331
 
7332
;; OUT-SP-1
7333
L192B:  ADD     HL,BC           ; add negative number to HL.
7334
        INC     A               ; increment digit
7335
        JR      C,L192B         ; back to OUT-SP-1 until no carry from
7336
                                ; the addition.
7337
 
7338
        SBC     HL,BC           ; cancel the last addition
7339
        DEC     A               ; and decrement the digit.
7340
        JR      Z,L1925         ; back to OUT-SP-2 if it is zero.
7341
 
7342
        JP      L15EF           ; jump back to exit via OUT-CODE.    ->
7343
 
7344
 
7345
; -------------------------------------
7346
; Outputting characters in a BASIC line
7347
; -------------------------------------
7348
; This subroutine ...
7349
 
7350
;; OUT-CHAR
7351
L1937:  CALL    L2D1B           ; routine NUMERIC tests if it is a digit ?
7352
        JR      NC,L196C        ; to OUT-CH-3 to print digit without
7353
                                ; changing mode. Will be 'K' mode if digits
7354
                                ; are at beginning of edit line.
7355
 
7356
        CP      $21             ; less than quote character ?
7357
        JR      C,L196C         ; to OUT-CH-3 to output controls and space.
7358
 
7359
        RES     2,(IY+$01)      ; initialize FLAGS to 'K' mode and leave
7360
                                ; unchanged if this character would precede
7361
                                ; a keyword.
7362
 
7363
        CP      $CB             ; is character 'THEN' token ?
7364
        JR      Z,L196C         ; to OUT-CH-3 to output if so.
7365
 
7366
        CP      $3A             ; is it ':' ?
7367
        JR      NZ,L195A        ; to OUT-CH-1 if not statement separator
7368
                                ; to change mode back to 'L'.
7369
 
7370
        BIT     5,(IY+$37)      ; FLAGX  - Input Mode ??
7371
        JR      NZ,L1968        ; to OUT-CH-2 if in input as no statements.
7372
                                ; Note. this check should seemingly be at
7373
                                ; the start. Commands seem inappropriate in
7374
                                ; INPUT mode and are rejected by the syntax
7375
                                ; checker anyway.
7376
                                ; unless INPUT LINE is being used.
7377
 
7378
        BIT     2,(IY+$30)      ; test FLAGS2 - is the ':' within quotes ?
7379
        JR      Z,L196C         ; to OUT-CH-3 if ':' is outside quoted text.
7380
 
7381
        JR      L1968           ; to OUT-CH-2 as ':' is within quotes
7382
 
7383
; ---
7384
 
7385
;; OUT-CH-1
7386
L195A:  CP      $22             ; is it quote character '"'  ?
7387
        JR      NZ,L1968        ; to OUT-CH-2 with others to set 'L' mode.
7388
 
7389
        PUSH    AF              ; save character.
7390
        LD      A,($5C6A)       ; fetch FLAGS2.
7391
        XOR     $04             ; toggle the quotes flag.
7392
        LD      ($5C6A),A       ; update FLAGS2
7393
        POP     AF              ; and restore character.
7394
 
7395
;; OUT-CH-2
7396
L1968:  SET     2,(IY+$01)      ; update FLAGS - signal L mode if the cursor
7397
                                ; is next.
7398
 
7399
;; OUT-CH-3
7400
L196C:  RST     10H             ; PRINT-A vectors the character to
7401
                                ; channel 'S', 'K', 'R' or 'P'.
7402
        RET                     ; return.
7403
 
7404
; -------------------------------------------
7405
; Get starting address of line, or line after
7406
; -------------------------------------------
7407
; This routine is used often to get the address, in HL, of a BASIC line
7408
; number supplied in HL, or failing that the address of the following line
7409
; and the address of the previous line in DE.
7410
 
7411
;; LINE-ADDR
7412
L196E:  PUSH    HL              ; save line number in HL register
7413
        LD      HL,($5C53)      ; fetch start of program from PROG
7414
        LD      D,H             ; transfer address to
7415
        LD      E,L             ; the DE register pair.
7416
 
7417
;; LINE-AD-1
7418
L1974:  POP     BC              ; restore the line number to BC
7419
        CALL    L1980           ; routine CP-LINES compares with that
7420
                                ; addressed by HL
7421
        RET     NC              ; return if line has been passed or matched.
7422
                                ; if NZ, address of previous is in DE
7423
 
7424
        PUSH    BC              ; save the current line number
7425
        CALL    L19B8           ; routine NEXT-ONE finds address of next
7426
                                ; line number in DE, previous in HL.
7427
        EX      DE,HL           ; switch so next in HL
7428
        JR      L1974           ; back to LINE-AD-1 for another comparison
7429
 
7430
; --------------------
7431
; Compare line numbers
7432
; --------------------
7433
; This routine compares a line number supplied in BC with an addressed
7434
; line number pointed to by HL.
7435
 
7436
;; CP-LINES
7437
L1980:  LD      A,(HL)          ; Load the high byte of line number and
7438
        CP      B               ; compare with that of supplied line number.
7439
        RET     NZ              ; return if yet to match (carry will be set).
7440
 
7441
        INC     HL              ; address low byte of
7442
        LD      A,(HL)          ; number and pick up in A.
7443
        DEC     HL              ; step back to first position.
7444
        CP      C               ; now compare.
7445
        RET                     ; zero set if exact match.
7446
                                ; carry set if yet to match.
7447
                                ; no carry indicates a match or
7448
                                ; next available BASIC line or
7449
                                ; program end marker.
7450
 
7451
; -------------------
7452
; Find each statement
7453
; -------------------
7454
; The single entry point EACH-STMT is used to
7455
; 1) To find the D'th statement in a line.
7456
; 2) To find a token in held E.
7457
 
7458
;; not-used
7459
L1988:  INC     HL              ;
7460
        INC     HL              ;
7461
        INC     HL              ;
7462
 
7463
; -> entry point.
7464
 
7465
;; EACH-STMT
7466
L198B:  LD      ($5C5D),HL      ; save HL in CH_ADD
7467
        LD      C,$00           ; initialize quotes flag
7468
 
7469
;; EACH-S-1
7470
L1990:  DEC     D               ; decrease statement count
7471
        RET     Z               ; return if zero
7472
 
7473
 
7474
        RST     20H             ; NEXT-CHAR
7475
        CP      E               ; is it the search token ?
7476
        JR      NZ,L199A        ; forward to EACH-S-3 if not
7477
 
7478
        AND     A               ; clear carry
7479
        RET                     ; return signalling success.
7480
 
7481
; ---
7482
 
7483
;; EACH-S-2
7484
L1998:  INC     HL              ; next address
7485
        LD      A,(HL)          ; next character
7486
 
7487
;; EACH-S-3
7488
L199A:  CALL    L18B6           ; routine NUMBER skips if number marker
7489
        LD      ($5C5D),HL      ; save in CH_ADD
7490
        CP      $22             ; is it quotes '"' ?
7491
        JR      NZ,L19A5        ; to EACH-S-4 if not
7492
 
7493
        DEC     C               ; toggle bit 0 of C
7494
 
7495
;; EACH-S-4
7496
L19A5:  CP      $3A             ; is it ':'
7497
        JR      Z,L19AD         ; to EACH-S-5
7498
 
7499
        CP      $CB             ; 'THEN'
7500
        JR      NZ,L19B1        ; to EACH-S-6
7501
 
7502
;; EACH-S-5
7503
L19AD:  BIT     0,C             ; is it in quotes
7504
        JR      Z,L1990         ; to EACH-S-1 if not
7505
 
7506
;; EACH-S-6
7507
L19B1:  CP      $0D             ; end of line ?
7508
        JR      NZ,L1998        ; to EACH-S-2
7509
 
7510
        DEC     D               ; decrease the statement counter
7511
                                ; which should be zero else
7512
                                ; 'Statement Lost'.
7513
        SCF                     ; set carry flag - not found
7514
        RET                     ; return
7515
 
7516
; -----------------------------------------------------------------------
7517
; Storage of variables. For full details - see chapter 24.
7518
; ZX Spectrum BASIC Programming by Steven Vickers 1982.
7519
; It is bits 7-5 of the first character of a variable that allow
7520
; the six types to be distinguished. Bits 4-0 are the reduced letter.
7521
; So any variable name is higher that $3F and can be distinguished
7522
; also from the variables area end-marker $80.
7523
;
7524
; 76543210 meaning                               brief outline of format.
7525
; -------- ------------------------              -----------------------
7526
; 010      string variable.                      2 byte length + contents.
7527
; 110      string array.                         2 byte length + contents.
7528
; 100      array of numbers.                     2 byte length + contents.
7529
; 011      simple numeric variable.              5 bytes.
7530
; 101      variable length named numeric.        5 bytes.
7531
; 111      for-next loop variable.               18 bytes.
7532
; 10000000 the variables area end-marker.
7533
;
7534
; Note. any of the above seven will serve as a program end-marker.
7535
;
7536
; -----------------------------------------------------------------------
7537
 
7538
; ------------
7539
; Get next one
7540
; ------------
7541
; This versatile routine is used to find the address of the next line
7542
; in the program area or the next variable in the variables area.
7543
; The reason one routine is made to handle two apparently unrelated tasks
7544
; is that it can be called indiscriminately when merging a line or a
7545
; variable.
7546
 
7547
;; NEXT-ONE
7548
L19B8:  PUSH    HL              ; save the pointer address.
7549
        LD      A,(HL)          ; get first byte.
7550
        CP      $40             ; compare with upper limit for line numbers.
7551
        JR      C,L19D5         ; forward to NEXT-O-3 if within BASIC area.
7552
 
7553
; the continuation here is for the next variable unless the supplied
7554
; line number was erroneously over 16383. see RESTORE command.
7555
 
7556
        BIT     5,A             ; is it a string or an array variable ?
7557
        JR      Z,L19D6         ; forward to NEXT-O-4 to compute length.
7558
 
7559
        ADD     A,A             ; test bit 6 for single-character variables.
7560
        JP      M,L19C7         ; forward to NEXT-O-1 if so
7561
 
7562
        CCF                     ; clear the carry for long-named variables.
7563
                                ; it remains set for for-next loop variables.
7564
 
7565
;; NEXT-O-1
7566
L19C7:  LD      BC,$0005        ; set BC to 5 for floating point number
7567
        JR      NC,L19CE        ; forward to NEXT-O-2 if not a for/next
7568
                                ; variable.
7569
 
7570
        LD      C,$12           ; set BC to eighteen locations.
7571
                                ; value, limit, step, line and statement.
7572
 
7573
; now deal with long-named variables
7574
 
7575
;; NEXT-O-2
7576
L19CE:  RLA                     ; test if character inverted. carry will also
7577
                                ; be set for single character variables
7578
        INC     HL              ; address next location.
7579
        LD      A,(HL)          ; and load character.
7580
        JR      NC,L19CE        ; back to NEXT-O-2 if not inverted bit.
7581
                                ; forward immediately with single character
7582
                                ; variable names.
7583
 
7584
        JR      L19DB           ; forward to NEXT-O-5 to add length of
7585
                                ; floating point number(s etc.).
7586
 
7587
; ---
7588
 
7589
; this branch is for line numbers.
7590
 
7591
;; NEXT-O-3
7592
L19D5:  INC     HL              ; increment pointer to low byte of line no.
7593
 
7594
; strings and arrays rejoin here
7595
 
7596
;; NEXT-O-4
7597
L19D6:  INC     HL              ; increment to address the length low byte.
7598
        LD      C,(HL)          ; transfer to C and
7599
        INC     HL              ; point to high byte of length.
7600
        LD      B,(HL)          ; transfer that to B
7601
        INC     HL              ; point to start of BASIC/variable contents.
7602
 
7603
; the three types of numeric variables rejoin here
7604
 
7605
;; NEXT-O-5
7606
L19DB:  ADD     HL,BC           ; add the length to give address of next
7607
                                ; line/variable in HL.
7608
        POP     DE              ; restore previous address to DE.
7609
 
7610
; ------------------
7611
; Difference routine
7612
; ------------------
7613
; This routine terminates the above routine and is also called from the
7614
; start of the next routine to calculate the length to reclaim.
7615
 
7616
;; DIFFER
7617
L19DD:  AND     A               ; prepare for true subtraction.
7618
        SBC     HL,DE           ; subtract the two pointers.
7619
        LD      B,H             ; transfer result
7620
        LD      C,L             ; to BC register pair.
7621
        ADD     HL,DE           ; add back
7622
        EX      DE,HL           ; and switch pointers
7623
        RET                     ; return values are the length of area in BC,
7624
                                ; low pointer (previous) in HL,
7625
                                ; high pointer (next) in DE.
7626
 
7627
; -----------------------
7628
; Handle reclaiming space
7629
; -----------------------
7630
;
7631
 
7632
;; RECLAIM-1
7633
L19E5:  CALL    L19DD           ; routine DIFFER immediately above
7634
 
7635
;; RECLAIM-2
7636
L19E8:  PUSH    BC              ;
7637
 
7638
        LD      A,B             ;
7639
        CPL                     ;
7640
        LD      B,A             ;
7641
        LD      A,C             ;
7642
        CPL                     ;
7643
        LD      C,A             ;
7644
        INC     BC              ;
7645
 
7646
        CALL    L1664           ; routine POINTERS
7647
        EX      DE,HL           ;
7648
        POP     HL              ;
7649
 
7650
        ADD     HL,DE           ;
7651
        PUSH    DE              ;
7652
        LDIR                    ; copy bytes
7653
 
7654
        POP     HL              ;
7655
        RET                     ;
7656
 
7657
; ----------------------------------------
7658
; Read line number of line in editing area
7659
; ----------------------------------------
7660
; This routine reads a line number in the editing area returning the number
7661
; in the BC register or zero if no digits exist before commands.
7662
; It is called from LINE-SCAN to check the syntax of the digits.
7663
; It is called from MAIN-3 to extract the line number in preparation for
7664
; inclusion of the line in the BASIC program area.
7665
;
7666
; Interestingly the calculator stack is moved from its normal place at the
7667
; end of dynamic memory to an adequate area within the system variables area.
7668
; This ensures that in a low memory situation, that valid line numbers can
7669
; be extracted without raising an error and that memory can be reclaimed
7670
; by deleting lines. If the stack was in its normal place then a situation
7671
; arises whereby the Spectrum becomes locked with no means of reclaiming space.
7672
 
7673
;; E-LINE-NO
7674
L19FB:  LD      HL,($5C59)      ; load HL from system variable E_LINE.
7675
 
7676
        DEC     HL              ; decrease so that NEXT_CHAR can be used
7677
                                ; without skipping the first digit.
7678
 
7679
        LD      ($5C5D),HL      ; store in the system variable CH_ADD.
7680
 
7681
        RST     20H             ; NEXT-CHAR skips any noise and white-space
7682
                                ; to point exactly at the first digit.
7683
 
7684
        LD      HL,$5C92        ; use MEM-0 as a temporary calculator stack
7685
                                ; an overhead of three locations are needed.
7686
        LD      ($5C65),HL      ; set new STKEND.
7687
 
7688
        CALL    L2D3B           ; routine INT-TO-FP will read digits till
7689
                                ; a non-digit found.
7690
        CALL    L2DA2           ; routine FP-TO-BC will retrieve number
7691
                                ; from stack at membot.
7692
        JR      C,L1A15         ; forward to E-L-1 if overflow i.e. > 65535.
7693
                                ; 'Nonsense in BASIC'
7694
 
7695
        LD      HL,$D8F0        ; load HL with value -9999
7696
        ADD     HL,BC           ; add to line number in BC
7697
 
7698
;; E-L-1
7699
L1A15:  JP      C,L1C8A         ; to REPORT-C 'Nonsense in BASIC' if over.
7700
                                ; Note. As ERR_SP points to ED_ERROR
7701
                                ; the report is never produced although
7702
                                ; the RST $08 will update X_PTR leading to
7703
                                ; the error marker being displayed when
7704
                                ; the ED_LOOP is reiterated.
7705
                                ; in fact, since it is immediately
7706
                                ; cancelled, any report will do.
7707
 
7708
; a line in the range 0 - 9999 has been entered.
7709
 
7710
        JP      L16C5           ; jump back to SET-STK to set the calculator
7711
                                ; stack back to its normal place and exit
7712
                                ; from there.
7713
 
7714
; ---------------------------------
7715
; Report and line number outputting
7716
; ---------------------------------
7717
; Entry point OUT-NUM-1 is used by the Error Reporting code to print
7718
; the line number and later the statement number held in BC.
7719
; If the statement was part of a direct command then -2 is used as a
7720
; dummy line number so that zero will be printed in the report.
7721
; This routine is also used to print the exponent of E-format numbers.
7722
;
7723
; Entry point OUT-NUM-2 is used from OUT-LINE to output the line number
7724
; addressed by HL with leading spaces if necessary.
7725
 
7726
;; OUT-NUM-1
7727
L1A1B:  PUSH    DE              ; save the
7728
        PUSH    HL              ; registers.
7729
        XOR     A               ; set A to zero.
7730
        BIT     7,B             ; is the line number minus two ?
7731
        JR      NZ,L1A42        ; forward to OUT-NUM-4 if so to print zero
7732
                                ; for a direct command.
7733
 
7734
        LD      H,B             ; transfer the
7735
        LD      L,C             ; number to HL.
7736
        LD      E,$FF           ; signal 'no leading zeros'.
7737
        JR      L1A30           ; forward to continue at OUT-NUM-3
7738
 
7739
; ---
7740
 
7741
; from OUT-LINE - HL addresses line number.
7742
 
7743
;; OUT-NUM-2
7744
L1A28:  PUSH    DE              ; save flags
7745
        LD      D,(HL)          ; high byte to D
7746
        INC     HL              ; address next
7747
        LD      E,(HL)          ; low byte to E
7748
        PUSH    HL              ; save pointer
7749
        EX      DE,HL           ; transfer number to HL
7750
        LD      E,$20           ; signal 'output leading spaces'
7751
 
7752
;; OUT-NUM-3
7753
L1A30:  LD      BC,$FC18        ; value -1000
7754
        CALL    L192A           ; routine OUT-SP-NO outputs space or number
7755
        LD      BC,$FF9C        ; value -100
7756
        CALL    L192A           ; routine OUT-SP-NO
7757
        LD      C,$F6           ; value -10 ( B is still $FF )
7758
        CALL    L192A           ; routine OUT-SP-NO
7759
        LD      A,L             ; remainder to A.
7760
 
7761
;; OUT-NUM-4
7762
L1A42:  CALL    L15EF           ; routine OUT-CODE for final digit.
7763
                                ; else report code zero wouldn't get
7764
                                ; printed.
7765
        POP     HL              ; restore the
7766
        POP     DE              ; registers and
7767
        RET                     ; return.
7768
 
7769
 
7770
;***************************************************
7771
;** Part 7. BASIC LINE AND COMMAND INTERPRETATION **
7772
;***************************************************
7773
 
7774
; ----------------
7775
; The offset table
7776
; ----------------
7777
; The BASIC interpreter has found a command code $CE - $FF
7778
; which is then reduced to range $00 - $31 and added to the base address
7779
; of this table to give the address of an offset which, when added to
7780
; the offset therein, gives the location in the following parameter table
7781
; where a list of class codes, separators and addresses relevant to the
7782
; command exists.
7783
 
7784
;; offst-tbl
7785
L1A48:  DEFB    L1AF9 - $       ; B1 offset to Address: P-DEF-FN
7786
        DEFB    L1B14 - $       ; CB offset to Address: P-CAT
7787
        DEFB    L1B06 - $       ; BC offset to Address: P-FORMAT
7788
        DEFB    L1B0A - $       ; BF offset to Address: P-MOVE
7789
        DEFB    L1B10 - $       ; C4 offset to Address: P-ERASE
7790
        DEFB    L1AFC - $       ; AF offset to Address: P-OPEN
7791
        DEFB    L1B02 - $       ; B4 offset to Address: P-CLOSE
7792
        DEFB    L1AE2 - $       ; 93 offset to Address: P-MERGE
7793
        DEFB    L1AE1 - $       ; 91 offset to Address: P-VERIFY
7794
        DEFB    L1AE3 - $       ; 92 offset to Address: P-BEEP
7795
        DEFB    L1AE7 - $       ; 95 offset to Address: P-CIRCLE
7796
        DEFB    L1AEB - $       ; 98 offset to Address: P-INK
7797
        DEFB    L1AEC - $       ; 98 offset to Address: P-PAPER
7798
        DEFB    L1AED - $       ; 98 offset to Address: P-FLASH
7799
        DEFB    L1AEE - $       ; 98 offset to Address: P-BRIGHT
7800
        DEFB    L1AEF - $       ; 98 offset to Address: P-INVERSE
7801
        DEFB    L1AF0 - $       ; 98 offset to Address: P-OVER
7802
        DEFB    L1AF1 - $       ; 98 offset to Address: P-OUT
7803
        DEFB    L1AD9 - $       ; 7F offset to Address: P-LPRINT
7804
        DEFB    L1ADC - $       ; 81 offset to Address: P-LLIST
7805
        DEFB    L1A8A - $       ; 2E offset to Address: P-STOP
7806
        DEFB    L1AC9 - $       ; 6C offset to Address: P-READ
7807
        DEFB    L1ACC - $       ; 6E offset to Address: P-DATA
7808
        DEFB    L1ACF - $       ; 70 offset to Address: P-RESTORE
7809
        DEFB    L1AA8 - $       ; 48 offset to Address: P-NEW
7810
        DEFB    L1AF5 - $       ; 94 offset to Address: P-BORDER
7811
        DEFB    L1AB8 - $       ; 56 offset to Address: P-CONT
7812
        DEFB    L1AA2 - $       ; 3F offset to Address: P-DIM
7813
        DEFB    L1AA5 - $       ; 41 offset to Address: P-REM
7814
        DEFB    L1A90 - $       ; 2B offset to Address: P-FOR
7815
        DEFB    L1A7D - $       ; 17 offset to Address: P-GO-TO
7816
        DEFB    L1A86 - $       ; 1F offset to Address: P-GO-SUB
7817
        DEFB    L1A9F - $       ; 37 offset to Address: P-INPUT
7818
        DEFB    L1AE0 - $       ; 77 offset to Address: P-LOAD
7819
        DEFB    L1AAE - $       ; 44 offset to Address: P-LIST
7820
        DEFB    L1A7A - $       ; 0F offset to Address: P-LET
7821
        DEFB    L1AC5 - $       ; 59 offset to Address: P-PAUSE
7822
        DEFB    L1A98 - $       ; 2B offset to Address: P-NEXT
7823
        DEFB    L1AB1 - $       ; 43 offset to Address: P-POKE
7824
        DEFB    L1A9C - $       ; 2D offset to Address: P-PRINT
7825
        DEFB    L1AC1 - $       ; 51 offset to Address: P-PLOT
7826
        DEFB    L1AAB - $       ; 3A offset to Address: P-RUN
7827
        DEFB    L1ADF - $       ; 6D offset to Address: P-SAVE
7828
        DEFB    L1AB5 - $       ; 42 offset to Address: P-RANDOM
7829
        DEFB    L1A81 - $       ; 0D offset to Address: P-IF
7830
        DEFB    L1ABE - $       ; 49 offset to Address: P-CLS
7831
        DEFB    L1AD2 - $       ; 5C offset to Address: P-DRAW
7832
        DEFB    L1ABB - $       ; 44 offset to Address: P-CLEAR
7833
        DEFB    L1A8D - $       ; 15 offset to Address: P-RETURN
7834
        DEFB    L1AD6 - $       ; 5D offset to Address: P-COPY
7835
 
7836
 
7837
; -------------------------------
7838
; The parameter or "Syntax" table
7839
; -------------------------------
7840
; For each command there exists a variable list of parameters.
7841
; If the character is greater than a space it is a required separator.
7842
; If less, then it is a command class in the range 00 - 0B.
7843
; Note that classes 00, 03 and 05 will fetch the addresses from this table.
7844
; Some classes e.g. 07 and 0B have the same address in all invocations
7845
; and the command is re-computed from the low-byte of the parameter address.
7846
; Some e.g. 02 are only called once so a call to the command is made from
7847
; within the class routine rather than holding the address within the table.
7848
; Some class routines check syntax entirely and some leave this task for the
7849
; command itself.
7850
; Others for example CIRCLE (x,y,z) check the first part (x,y) using the
7851
; class routine and the final part (,z) within the command.
7852
; The last few commands appear to have been added in a rush but their syntax
7853
; is rather simple e.g. MOVE "M1","M2"
7854
 
7855
;; P-LET
7856
L1A7A:  DEFB    $01             ; Class-01 - A variable is required.
7857
        DEFB    $3D             ; Separator:  '='
7858
        DEFB    $02             ; Class-02 - An expression, numeric or string,
7859
                                ; must follow.
7860
 
7861
;; P-GO-TO
7862
L1A7D:  DEFB    $06             ; Class-06 - A numeric expression must follow.
7863
        DEFB    $00             ; Class-00 - No further operands.
7864
        DEFW    L1E67           ; Address: $1E67; Address: GO-TO
7865
 
7866
;; P-IF
7867
L1A81:  DEFB    $06             ; Class-06 - A numeric expression must follow.
7868
        DEFB    $CB             ; Separator:  'THEN'
7869
        DEFB    $05             ; Class-05 - Variable syntax checked
7870
                                ; by routine.
7871
        DEFW    L1CF0           ; Address: $1CF0; Address: IF
7872
 
7873
;; P-GO-SUB
7874
L1A86:  DEFB    $06             ; Class-06 - A numeric expression must follow.
7875
        DEFB    $00             ; Class-00 - No further operands.
7876
        DEFW    L1EED           ; Address: $1EED; Address: GO-SUB
7877
 
7878
;; P-STOP
7879
L1A8A:  DEFB    $00             ; Class-00 - No further operands.
7880
        DEFW    L1CEE           ; Address: $1CEE; Address: STOP
7881
 
7882
;; P-RETURN
7883
L1A8D:  DEFB    $00             ; Class-00 - No further operands.
7884
        DEFW    L1F23           ; Address: $1F23; Address: RETURN
7885
 
7886
;; P-FOR
7887
L1A90:  DEFB    $04             ; Class-04 - A single character variable must
7888
                                ; follow.
7889
        DEFB    $3D             ; Separator:  '='
7890
        DEFB    $06             ; Class-06 - A numeric expression must follow.
7891
        DEFB    $CC             ; Separator:  'TO'
7892
        DEFB    $06             ; Class-06 - A numeric expression must follow.
7893
        DEFB    $05             ; Class-05 - Variable syntax checked
7894
                                ; by routine.
7895
        DEFW    L1D03           ; Address: $1D03; Address: FOR
7896
 
7897
;; P-NEXT
7898
L1A98:  DEFB    $04             ; Class-04 - A single character variable must
7899
                                ; follow.
7900
        DEFB    $00             ; Class-00 - No further operands.
7901
        DEFW    L1DAB           ; Address: $1DAB; Address: NEXT
7902
 
7903
;; P-PRINT
7904
L1A9C:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7905
                                ; by routine.
7906
        DEFW    L1FCD           ; Address: $1FCD; Address: PRINT
7907
 
7908
;; P-INPUT
7909
L1A9F:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7910
                                ; by routine.
7911
        DEFW    L2089           ; Address: $2089; Address: INPUT
7912
 
7913
;; P-DIM
7914
L1AA2:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7915
                                ; by routine.
7916
        DEFW    L2C02           ; Address: $2C02; Address: DIM
7917
 
7918
;; P-REM
7919
L1AA5:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7920
                                ; by routine.
7921
        DEFW    L1BB2           ; Address: $1BB2; Address: REM
7922
 
7923
;; P-NEW
7924
L1AA8:  DEFB    $00             ; Class-00 - No further operands.
7925
        DEFW    L11B7           ; Address: $11B7; Address: NEW
7926
 
7927
;; P-RUN
7928
L1AAB:  DEFB    $03             ; Class-03 - A numeric expression may follow
7929
                                ; else default to zero.
7930
        DEFW    L1EA1           ; Address: $1EA1; Address: RUN
7931
 
7932
;; P-LIST
7933
L1AAE:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7934
                                ; by routine.
7935
        DEFW    L17F9           ; Address: $17F9; Address: LIST
7936
 
7937
;; P-POKE
7938
L1AB1:  DEFB    $08             ; Class-08 - Two comma-separated numeric
7939
                                ; expressions required.
7940
        DEFB    $00             ; Class-00 - No further operands.
7941
        DEFW    L1E80           ; Address: $1E80; Address: POKE
7942
 
7943
;; P-RANDOM
7944
L1AB5:  DEFB    $03             ; Class-03 - A numeric expression may follow
7945
                                ; else default to zero.
7946
        DEFW    L1E4F           ; Address: $1E4F; Address: RANDOMIZE
7947
 
7948
;; P-CONT
7949
L1AB8:  DEFB    $00             ; Class-00 - No further operands.
7950
        DEFW    L1E5F           ; Address: $1E5F; Address: CONTINUE
7951
 
7952
;; P-CLEAR
7953
L1ABB:  DEFB    $03             ; Class-03 - A numeric expression may follow
7954
                                ; else default to zero.
7955
        DEFW    L1EAC           ; Address: $1EAC; Address: CLEAR
7956
 
7957
;; P-CLS
7958
L1ABE:  DEFB    $00             ; Class-00 - No further operands.
7959
        DEFW    L0D6B           ; Address: $0D6B; Address: CLS
7960
 
7961
;; P-PLOT
7962
L1AC1:  DEFB    $09             ; Class-09 - Two comma-separated numeric
7963
                                ; expressions required with optional colour
7964
                                ; items.
7965
        DEFB    $00             ; Class-00 - No further operands.
7966
        DEFW    L22DC           ; Address: $22DC; Address: PLOT
7967
 
7968
;; P-PAUSE
7969
L1AC5:  DEFB    $06             ; Class-06 - A numeric expression must follow.
7970
        DEFB    $00             ; Class-00 - No further operands.
7971
        DEFW    L1F3A           ; Address: $1F3A; Address: PAUSE
7972
 
7973
;; P-READ
7974
L1AC9:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7975
                                ; by routine.
7976
        DEFW    L1DED           ; Address: $1DED; Address: READ
7977
 
7978
;; P-DATA
7979
L1ACC:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7980
                                ; by routine.
7981
        DEFW    L1E27           ; Address: $1E27; Address: DATA
7982
 
7983
;; P-RESTORE
7984
L1ACF:  DEFB    $03             ; Class-03 - A numeric expression may follow
7985
                                ; else default to zero.
7986
        DEFW    L1E42           ; Address: $1E42; Address: RESTORE
7987
 
7988
;; P-DRAW
7989
L1AD2:  DEFB    $09             ; Class-09 - Two comma-separated numeric
7990
                                ; expressions required with optional colour
7991
                                ; items.
7992
        DEFB    $05             ; Class-05 - Variable syntax checked
7993
                                ; by routine.
7994
        DEFW    L2382           ; Address: $2382; Address: DRAW
7995
 
7996
;; P-COPY
7997
L1AD6:  DEFB    $00             ; Class-00 - No further operands.
7998
        DEFW    L0EAC           ; Address: $0EAC; Address: COPY
7999
 
8000
;; P-LPRINT
8001
L1AD9:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
8002
                                ; by routine.
8003
        DEFW    L1FC9           ; Address: $1FC9; Address: LPRINT
8004
 
8005
;; P-LLIST
8006
L1ADC:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
8007
                                ; by routine.
8008
        DEFW    L17F5           ; Address: $17F5; Address: LLIST
8009
 
8010
;; P-SAVE
8011
L1ADF:  DEFB    $0B             ; Class-0B - Offset address converted to tape
8012
                                ; command.
8013
 
8014
;; P-LOAD
8015
L1AE0:  DEFB    $0B             ; Class-0B - Offset address converted to tape
8016
                                ; command.
8017
 
8018
;; P-VERIFY
8019
L1AE1:  DEFB    $0B             ; Class-0B - Offset address converted to tape
8020
                                ; command.
8021
 
8022
;; P-MERGE
8023
L1AE2:  DEFB    $0B             ; Class-0B - Offset address converted to tape
8024
                                ; command.
8025
 
8026
;; P-BEEP
8027
L1AE3:  DEFB    $08             ; Class-08 - Two comma-separated numeric
8028
                                ; expressions required.
8029
        DEFB    $00             ; Class-00 - No further operands.
8030
        DEFW    L03F8           ; Address: $03F8; Address: BEEP
8031
 
8032
;; P-CIRCLE
8033
L1AE7:  DEFB    $09             ; Class-09 - Two comma-separated numeric
8034
                                ; expressions required with optional colour
8035
                                ; items.
8036
        DEFB    $05             ; Class-05 - Variable syntax checked
8037
                                ; by routine.
8038
        DEFW    L2320           ; Address: $2320; Address: CIRCLE
8039
 
8040
;; P-INK
8041
L1AEB:  DEFB    $07             ; Class-07 - Offset address is converted to
8042
                                ; colour code.
8043
 
8044
;; P-PAPER
8045
L1AEC:  DEFB    $07             ; Class-07 - Offset address is converted to
8046
                                ; colour code.
8047
 
8048
;; P-FLASH
8049
L1AED:  DEFB    $07             ; Class-07 - Offset address is converted to
8050
                                ; colour code.
8051
 
8052
;; P-BRIGHT
8053
L1AEE:  DEFB    $07             ; Class-07 - Offset address is converted to
8054
                                ; colour code.
8055
 
8056
;; P-INVERSE
8057
L1AEF:  DEFB    $07             ; Class-07 - Offset address is converted to
8058
                                ; colour code.
8059
 
8060
;; P-OVER
8061
L1AF0:  DEFB    $07             ; Class-07 - Offset address is converted to
8062
                                ; colour code.
8063
 
8064
;; P-OUT
8065
L1AF1:  DEFB    $08             ; Class-08 - Two comma-separated numeric
8066
                                ; expressions required.
8067
        DEFB    $00             ; Class-00 - No further operands.
8068
        DEFW    L1E7A           ; Address: $1E7A; Address: OUT
8069
 
8070
;; P-BORDER
8071
L1AF5:  DEFB    $06             ; Class-06 - A numeric expression must follow.
8072
        DEFB    $00             ; Class-00 - No further operands.
8073
        DEFW    L2294           ; Address: $2294; Address: BORDER
8074
 
8075
;; P-DEF-FN
8076
L1AF9:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
8077
                                ; by routine.
8078
        DEFW    L1F60           ; Address: $1F60; Address: DEF-FN
8079
 
8080
;; P-OPEN
8081
L1AFC:  DEFB    $06             ; Class-06 - A numeric expression must follow.
8082
        DEFB    $2C             ; Separator:  ','          see Footnote *
8083
        DEFB    $0A             ; Class-0A - A string expression must follow.
8084
        DEFB    $00             ; Class-00 - No further operands.
8085
        DEFW    L1736           ; Address: $1736; Address: OPEN
8086
 
8087
;; P-CLOSE
8088
L1B02:  DEFB    $06             ; Class-06 - A numeric expression must follow.
8089
        DEFB    $00             ; Class-00 - No further operands.
8090
        DEFW    L16E5           ; Address: $16E5; Address: CLOSE
8091
 
8092
;; P-FORMAT
8093
L1B06:  DEFB    $0A             ; Class-0A - A string expression must follow.
8094
        DEFB    $00             ; Class-00 - No further operands.
8095
        DEFW    L1793           ; Address: $1793; Address: CAT-ETC
8096
 
8097
;; P-MOVE
8098
L1B0A:  DEFB    $0A             ; Class-0A - A string expression must follow.
8099
        DEFB    $2C             ; Separator:  ','
8100
        DEFB    $0A             ; Class-0A - A string expression must follow.
8101
        DEFB    $00             ; Class-00 - No further operands.
8102
        DEFW    L1793           ; Address: $1793; Address: CAT-ETC
8103
 
8104
;; P-ERASE
8105
L1B10:  DEFB    $0A             ; Class-0A - A string expression must follow.
8106
        DEFB    $00             ; Class-00 - No further operands.
8107
        DEFW    L1793           ; Address: $1793; Address: CAT-ETC
8108
 
8109
;; P-CAT
8110
L1B14:  DEFB    $00             ; Class-00 - No further operands.
8111
        DEFW    L1793           ; Address: $1793; Address: CAT-ETC
8112
 
8113
; * Note that a comma is required as a separator with the OPEN command
8114
; but the Interface 1 programmers relaxed this allowing ';' as an
8115
; alternative for their channels creating a confusing mixture of
8116
; allowable syntax as it is this ROM which opens or re-opens the
8117
; normal channels.
8118
 
8119
; -------------------------------
8120
; Main parser (BASIC interpreter)
8121
; -------------------------------
8122
; This routine is called once from MAIN-2 when the BASIC line is to
8123
; be entered or re-entered into the Program area and the syntax
8124
; requires checking.
8125
 
8126
;; LINE-SCAN
8127
L1B17:  RES     7,(IY+$01)      ; update FLAGS - signal checking syntax
8128
        CALL    L19FB           ; routine E-LINE-NO              >>
8129
                                ; fetches the line number if in range.
8130
 
8131
        XOR     A               ; clear the accumulator.
8132
        LD      ($5C47),A       ; set statement number SUBPPC to zero.
8133
        DEC     A               ; set accumulator to $FF.
8134
        LD      ($5C3A),A       ; set ERR_NR to 'OK' - 1.
8135
        JR      L1B29           ; forward to continue at STMT-L-1.
8136
 
8137
; --------------
8138
; Statement loop
8139
; --------------
8140
;
8141
;
8142
 
8143
;; STMT-LOOP
8144
L1B28:  RST     20H             ; NEXT-CHAR
8145
 
8146
; -> the entry point from above or LINE-RUN
8147
;; STMT-L-1
8148
L1B29:  CALL    L16BF           ; routine SET-WORK clears workspace etc.
8149
 
8150
        INC     (IY+$0D)        ; increment statement number SUBPPC
8151
        JP      M,L1C8A         ; to REPORT-C to raise
8152
                                ; 'Nonsense in BASIC' if over 127.
8153
 
8154
        RST     18H             ; GET-CHAR
8155
 
8156
        LD      B,$00           ; set B to zero for later indexing.
8157
                                ; early so any other reason ???
8158
 
8159
        CP      $0D             ; is character carriage return ?
8160
                                ; i.e. an empty statement.
8161
        JR      Z,L1BB3         ; forward to LINE-END if so.
8162
 
8163
        CP      $3A             ; is it statement end marker ':' ?
8164
                                ; i.e. another type of empty statement.
8165
        JR      Z,L1B28         ; back to STMT-LOOP if so.
8166
 
8167
        LD      HL,L1B76        ; address: STMT-RET
8168
        PUSH    HL              ; is now pushed as a return address
8169
        LD      C,A             ; transfer the current character to C.
8170
 
8171
; advance CH_ADD to a position after command and test if it is a command.
8172
 
8173
        RST     20H             ; NEXT-CHAR to advance pointer
8174
        LD      A,C             ; restore current character
8175
        SUB     $CE             ; subtract 'DEF FN' - first command
8176
        JP      C,L1C8A         ; jump to REPORT-C if less than a command
8177
                                ; raising
8178
                                ; 'Nonsense in BASIC'
8179
 
8180
        LD      C,A             ; put the valid command code back in C.
8181
                                ; register B is zero.
8182
        LD      HL,L1A48        ; address: offst-tbl
8183
        ADD     HL,BC           ; index into table with one of 50 commands.
8184
        LD      C,(HL)          ; pick up displacement to syntax table entry.
8185
        ADD     HL,BC           ; add to address the relevant entry.
8186
        JR      L1B55           ; forward to continue at GET-PARAM
8187
 
8188
; ----------------------
8189
; The main scanning loop
8190
; ----------------------
8191
; not documented properly
8192
;
8193
 
8194
;; SCAN-LOOP
8195
L1B52:  LD      HL,($5C74)      ; fetch temporary address from T_ADDR
8196
                                ; during subsequent loops.
8197
 
8198
; -> the initial entry point with HL addressing start of syntax table entry.
8199
 
8200
;; GET-PARAM
8201
L1B55:  LD      A,(HL)          ; pick up the parameter.
8202
        INC     HL              ; address next one.
8203
        LD      ($5C74),HL      ; save pointer in system variable T_ADDR
8204
 
8205
        LD      BC,L1B52        ; address: SCAN-LOOP
8206
        PUSH    BC              ; is now pushed on stack as looping address.
8207
        LD      C,A             ; store parameter in C.
8208
        CP      $20             ; is it greater than ' '  ?
8209
        JR      NC,L1B6F        ; forward to SEPARATOR to check that correct
8210
                                ; separator appears in statement if so.
8211
 
8212
        LD      HL,L1C01        ; address: class-tbl.
8213
        LD      B,$00           ; prepare to index into the class table.
8214
        ADD     HL,BC           ; index to find displacement to routine.
8215
        LD      C,(HL)          ; displacement to BC
8216
        ADD     HL,BC           ; add to address the CLASS routine.
8217
        PUSH    HL              ; push the address on the stack.
8218
 
8219
        RST     18H             ; GET-CHAR - HL points to place in statement.
8220
 
8221
        DEC     B               ; reset the zero flag - the initial state
8222
                                ; for all class routines.
8223
 
8224
        RET                     ; and make an indirect jump to routine
8225
                                ; and then SCAN-LOOP (also on stack).
8226
 
8227
; Note. one of the class routines will eventually drop the return address
8228
; off the stack breaking out of the above seemingly endless loop.
8229
 
8230
; -----------------------
8231
; THE 'SEPARATOR' ROUTINE
8232
; -----------------------
8233
;   This routine is called once to verify that the mandatory separator
8234
;   present in the parameter table is also present in the correct
8235
;   location following the command.  For example, the 'THEN' token after
8236
;   the 'IF' token and expression.
8237
 
8238
;; SEPARATOR
8239
L1B6F:  RST     18H             ; GET-CHAR
8240
        CP      C               ; does it match the character in C ?
8241
        JP      NZ,L1C8A        ; jump forward to REPORT-C if not
8242
                                ; 'Nonsense in BASIC'.
8243
 
8244
        RST     20H             ; NEXT-CHAR advance to next character
8245
        RET                     ; return.
8246
 
8247
; ------------------------------
8248
; Come here after interpretation
8249
; ------------------------------
8250
;
8251
;
8252
 
8253
;; STMT-RET
8254
L1B76:  CALL    L1F54           ; routine BREAK-KEY is tested after every
8255
                                ; statement.
8256
        JR      C,L1B7D         ; step forward to STMT-R-1 if not pressed.
8257
 
8258
;; REPORT-L
8259
L1B7B:  RST     08H             ; ERROR-1
8260
        DEFB    $14             ; Error Report: BREAK into program
8261
 
8262
;; STMT-R-1
8263
L1B7D:  BIT     7,(IY+$0A)      ; test NSPPC - will be set if $FF -
8264
                                ; no jump to be made.
8265
        JR      NZ,L1BF4        ; forward to STMT-NEXT if a program line.
8266
 
8267
        LD      HL,($5C42)      ; fetch line number from NEWPPC
8268
        BIT     7,H             ; will be set if minus two - direct command(s)
8269
        JR      Z,L1B9E         ; forward to LINE-NEW if a jump is to be
8270
                                ; made to a new program line/statement.
8271
 
8272
; --------------------
8273
; Run a direct command
8274
; --------------------
8275
; A direct command is to be run or, if continuing from above,
8276
; the next statement of a direct command is to be considered.
8277
 
8278
;; LINE-RUN
8279
L1B8A:  LD      HL,$FFFE        ; The dummy value minus two
8280
        LD      ($5C45),HL      ; is set/reset as line number in PPC.
8281
        LD      HL,($5C61)      ; point to end of line + 1 - WORKSP.
8282
        DEC     HL              ; now point to $80 end-marker.
8283
        LD      DE,($5C59)      ; address the start of line E_LINE.
8284
        DEC     DE              ; now location before - for GET-CHAR.
8285
        LD      A,($5C44)       ; load statement to A from NSPPC.
8286
        JR      L1BD1           ; forward to NEXT-LINE.
8287
 
8288
; ------------------------------
8289
; Find start address of new line
8290
; ------------------------------
8291
; The branch was to here if a jump is to made to a new line number
8292
; and statement.
8293
; That is the previous statement was a GO TO, GO SUB, RUN, RETURN, NEXT etc..
8294
 
8295
;; LINE-NEW
8296
L1B9E:  CALL    L196E           ; routine LINE-ADDR gets address of line
8297
                                ; returning zero flag set if line found.
8298
        LD      A,($5C44)       ; fetch new statement from NSPPC
8299
        JR      Z,L1BBF         ; forward to LINE-USE if line matched.
8300
 
8301
; continue as must be a direct command.
8302
 
8303
        AND     A               ; test statement which should be zero
8304
        JR      NZ,L1BEC        ; forward to REPORT-N if not.
8305
                                ; 'Statement lost'
8306
 
8307
;
8308
 
8309
        LD      B,A             ; save statement in B.??
8310
        LD      A,(HL)          ; fetch high byte of line number.
8311
        AND     $C0             ; test if using direct command
8312
                                ; a program line is less than $3F
8313
        LD      A,B             ; retrieve statement.
8314
                                ; (we can assume it is zero).
8315
        JR      Z,L1BBF         ; forward to LINE-USE if was a program line
8316
 
8317
; Alternatively a direct statement has finished correctly.
8318
 
8319
;; REPORT-0
8320
L1BB0:  RST     08H             ; ERROR-1
8321
        DEFB    $FF             ; Error Report: OK
8322
 
8323
; -----------------
8324
; THE 'REM' COMMAND
8325
; -----------------
8326
; The REM command routine.
8327
; The return address STMT-RET is dropped and the rest of line ignored.
8328
 
8329
;; REM
8330
L1BB2:  POP     BC              ; drop return address STMT-RET and
8331
                                ; continue ignoring rest of line.
8332
 
8333
; ------------
8334
; End of line?
8335
; ------------
8336
;
8337
;
8338
 
8339
;; LINE-END
8340
L1BB3:  CALL    L2530           ; routine SYNTAX-Z  (UNSTACK-Z?)
8341
        RET     Z               ; return if checking syntax.
8342
 
8343
        LD      HL,($5C55)      ; fetch NXTLIN to HL.
8344
        LD      A,$C0           ; test against the
8345
        AND     (HL)            ; system limit $3F.
8346
        RET     NZ              ; return if more as must be
8347
                                ; end of program.
8348
                                ; (or direct command)
8349
 
8350
        XOR     A               ; set statement to zero.
8351
 
8352
; and continue to set up the next following line and then consider this new one.
8353
 
8354
; ---------------------
8355
; General line checking
8356
; ---------------------
8357
; The branch was here from LINE-NEW if BASIC is branching.
8358
; or a continuation from above if dealing with a new sequential line.
8359
; First make statement zero number one leaving others unaffected.
8360
 
8361
;; LINE-USE
8362
L1BBF:  CP      $01             ; will set carry if zero.
8363
        ADC     A,$00           ; add in any carry.
8364
 
8365
        LD      D,(HL)          ; high byte of line number to D.
8366
        INC     HL              ; advance pointer.
8367
        LD      E,(HL)          ; low byte of line number to E.
8368
        LD      ($5C45),DE      ; set system variable PPC.
8369
 
8370
        INC     HL              ; advance pointer.
8371
        LD      E,(HL)          ; low byte of line length to E.
8372
        INC     HL              ; advance pointer.
8373
        LD      D,(HL)          ; high byte of line length to D.
8374
 
8375
        EX      DE,HL           ; swap pointer to DE before
8376
        ADD     HL,DE           ; adding to address the end of line.
8377
        INC     HL              ; advance to start of next line.
8378
 
8379
; -----------------------------
8380
; Update NEXT LINE but consider
8381
; previous line or edit line.
8382
; -----------------------------
8383
; The pointer will be the next line if continuing from above or to
8384
; edit line end-marker ($80) if from LINE-RUN.
8385
 
8386
;; NEXT-LINE
8387
L1BD1:  LD      ($5C55),HL      ; store pointer in system variable NXTLIN
8388
 
8389
        EX      DE,HL           ; bring back pointer to previous or edit line
8390
        LD      ($5C5D),HL      ; and update CH_ADD with character address.
8391
 
8392
        LD      D,A             ; store statement in D.
8393
        LD      E,$00           ; set E to zero to suppress token searching
8394
                                ; if EACH-STMT is to be called.
8395
        LD      (IY+$0A),$FF    ; set statement NSPPC to $FF signalling
8396
                                ; no jump to be made.
8397
        DEC     D               ; decrement and test statement
8398
        LD      (IY+$0D),D      ; set SUBPPC to decremented statement number.
8399
        JP      Z,L1B28         ; to STMT-LOOP if result zero as statement is
8400
                                ; at start of line and address is known.
8401
 
8402
        INC     D               ; else restore statement.
8403
        CALL    L198B           ; routine EACH-STMT finds the D'th statement
8404
                                ; address as E does not contain a token.
8405
        JR      Z,L1BF4         ; forward to STMT-NEXT if address found.
8406
 
8407
;; REPORT-N
8408
L1BEC:  RST     08H             ; ERROR-1
8409
        DEFB    $16             ; Error Report: Statement lost
8410
 
8411
; -----------------
8412
; End of statement?
8413
; -----------------
8414
; This combination of routines is called from 20 places when
8415
; the end of a statement should have been reached and all preceding
8416
; syntax is in order.
8417
 
8418
;; CHECK-END
8419
L1BEE:  CALL    L2530           ; routine SYNTAX-Z
8420
        RET     NZ              ; return immediately in runtime
8421
 
8422
        POP     BC              ; drop address of calling routine.
8423
        POP     BC              ; drop address STMT-RET.
8424
                                ; and continue to find next statement.
8425
 
8426
; --------------------
8427
; Go to next statement
8428
; --------------------
8429
; Acceptable characters at this point are carriage return and ':'.
8430
; If so go to next statement which in the first case will be on next line.
8431
 
8432
;; STMT-NEXT
8433
L1BF4:  RST     18H             ; GET-CHAR - ignoring white space etc.
8434
 
8435
        CP      $0D             ; is it carriage return ?
8436
        JR      Z,L1BB3         ; back to LINE-END if so.
8437
 
8438
        CP      $3A             ; is it ':' ?
8439
        JP      Z,L1B28         ; jump back to STMT-LOOP to consider
8440
                                ; further statements
8441
 
8442
        JP      L1C8A           ; jump to REPORT-C with any other character
8443
                                ; 'Nonsense in BASIC'.
8444
 
8445
; Note. the two-byte sequence 'rst 08; defb $0b' could replace the above jp.
8446
 
8447
; -------------------
8448
; Command class table
8449
; -------------------
8450
;
8451
 
8452
;; class-tbl
8453
L1C01:  DEFB    L1C10 - $       ; 0F offset to Address: CLASS-00
8454
        DEFB    L1C1F - $       ; 1D offset to Address: CLASS-01
8455
        DEFB    L1C4E - $       ; 4B offset to Address: CLASS-02
8456
        DEFB    L1C0D - $       ; 09 offset to Address: CLASS-03
8457
        DEFB    L1C6C - $       ; 67 offset to Address: CLASS-04
8458
        DEFB    L1C11 - $       ; 0B offset to Address: CLASS-05
8459
        DEFB    L1C82 - $       ; 7B offset to Address: CLASS-06
8460
        DEFB    L1C96 - $       ; 8E offset to Address: CLASS-07
8461
        DEFB    L1C7A - $       ; 71 offset to Address: CLASS-08
8462
        DEFB    L1CBE - $       ; B4 offset to Address: CLASS-09
8463
        DEFB    L1C8C - $       ; 81 offset to Address: CLASS-0A
8464
        DEFB    L1CDB - $       ; CF offset to Address: CLASS-0B
8465
 
8466
 
8467
; --------------------------------
8468
; Command classes---00, 03, and 05
8469
; --------------------------------
8470
; class-03 e.g. RUN or RUN 200   ;  optional operand
8471
; class-00 e.g. CONTINUE         ;  no operand
8472
; class-05 e.g. PRINT            ;  variable syntax checked by routine
8473
 
8474
;; CLASS-03
8475
L1C0D:  CALL    L1CDE           ; routine FETCH-NUM
8476
 
8477
;; CLASS-00
8478
 
8479
L1C10:  CP      A               ; reset zero flag.
8480
 
8481
; if entering here then all class routines are entered with zero reset.
8482
 
8483
;; CLASS-05
8484
L1C11:  POP     BC              ; drop address SCAN-LOOP.
8485
        CALL    Z,L1BEE         ; if zero set then call routine CHECK-END >>>
8486
                                ; as should be no further characters.
8487
 
8488
        EX      DE,HL           ; save HL to DE.
8489
        LD      HL,($5C74)      ; fetch T_ADDR
8490
        LD      C,(HL)          ; fetch low byte of routine
8491
        INC     HL              ; address next.
8492
        LD      B,(HL)          ; fetch high byte of routine.
8493
        EX      DE,HL           ; restore HL from DE
8494
        PUSH    BC              ; push the address
8495
        RET                     ; and make an indirect jump to the command.
8496
 
8497
; --------------------------------
8498
; Command classes---01, 02, and 04
8499
; --------------------------------
8500
; class-01  e.g. LET A = 2*3     ; a variable is reqd
8501
 
8502
; This class routine is also called from INPUT and READ to find the
8503
; destination variable for an assignment.
8504
 
8505
;; CLASS-01
8506
L1C1F:  CALL    L28B2           ; routine LOOK-VARS returns carry set if not
8507
                                ; found in runtime.
8508
 
8509
; ----------------------
8510
; Variable in assignment
8511
; ----------------------
8512
;
8513
;
8514
 
8515
;; VAR-A-1
8516
L1C22:  LD      (IY+$37),$00    ; set FLAGX to zero
8517
        JR      NC,L1C30        ; forward to VAR-A-2 if found or checking
8518
                                ; syntax.
8519
 
8520
        SET     1,(IY+$37)      ; FLAGX  - Signal a new variable
8521
        JR      NZ,L1C46        ; to VAR-A-3 if not assigning to an array
8522
                                ; e.g. LET a$(3,3) = "X"
8523
 
8524
;; REPORT-2
8525
L1C2E:  RST     08H             ; ERROR-1
8526
        DEFB    $01             ; Error Report: Variable not found
8527
 
8528
;; VAR-A-2
8529
L1C30:  CALL    Z,L2996         ; routine STK-VAR considers a subscript/slice
8530
        BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
8531
        JR      NZ,L1C46        ; to VAR-A-3 if numeric
8532
 
8533
        XOR     A               ; default to array/slice - to be retained.
8534
        CALL    L2530           ; routine SYNTAX-Z
8535
        CALL    NZ,L2BF1        ; routine STK-FETCH is called in runtime
8536
                                ; may overwrite A with 1.
8537
        LD      HL,$5C71        ; address system variable FLAGX
8538
        OR      (HL)            ; set bit 0 if simple variable to be reclaimed
8539
        LD      (HL),A          ; update FLAGX
8540
        EX      DE,HL           ; start of string/subscript to DE
8541
 
8542
;; VAR-A-3
8543
L1C46:  LD      ($5C72),BC      ; update STRLEN
8544
        LD      ($5C4D),HL      ; and DEST of assigned string.
8545
        RET                     ; return.
8546
 
8547
; -------------------------------------------------
8548
; class-02 e.g. LET a = 1 + 1   ; an expression must follow
8549
 
8550
;; CLASS-02
8551
L1C4E:  POP     BC              ; drop return address SCAN-LOOP
8552
        CALL    L1C56           ; routine VAL-FET-1 is called to check
8553
                                ; expression and assign result in runtime
8554
        CALL    L1BEE           ; routine CHECK-END checks nothing else
8555
                                ; is present in statement.
8556
        RET                     ; Return
8557
 
8558
; -------------
8559
; Fetch a value
8560
; -------------
8561
;
8562
;
8563
 
8564
;; VAL-FET-1
8565
L1C56:  LD      A,($5C3B)       ; initial FLAGS to A
8566
 
8567
;; VAL-FET-2
8568
L1C59:  PUSH    AF              ; save A briefly
8569
        CALL    L24FB           ; routine SCANNING evaluates expression.
8570
        POP     AF              ; restore A
8571
        LD      D,(IY+$01)      ; post-SCANNING FLAGS to D
8572
        XOR     D               ; xor the two sets of flags
8573
        AND     $40             ; pick up bit 6 of xored FLAGS should be zero
8574
        JR      NZ,L1C8A        ; forward to REPORT-C if not zero
8575
                                ; 'Nonsense in BASIC' - results don't agree.
8576
 
8577
        BIT     7,D             ; test FLAGS - is syntax being checked ?
8578
        JP      NZ,L2AFF        ; jump forward to LET to make the assignment
8579
                                ; in runtime.
8580
 
8581
        RET                     ; but return from here if checking syntax.
8582
 
8583
; ------------------
8584
; Command class---04
8585
; ------------------
8586
; class-04 e.g. FOR i            ; a single character variable must follow
8587
 
8588
;; CLASS-04
8589
L1C6C:  CALL    L28B2           ; routine LOOK-VARS
8590
        PUSH    AF              ; preserve flags.
8591
        LD      A,C             ; fetch type - should be 011xxxxx
8592
        OR      $9F             ; combine with 10011111.
8593
        INC     A               ; test if now $FF by incrementing.
8594
        JR      NZ,L1C8A        ; forward to REPORT-C if result not zero.
8595
 
8596
        POP     AF              ; else restore flags.
8597
        JR      L1C22           ; back to VAR-A-1
8598
 
8599
 
8600
; --------------------------------
8601
; Expect numeric/string expression
8602
; --------------------------------
8603
; This routine is used to get the two coordinates of STRING$, ATTR and POINT.
8604
; It is also called from PRINT-ITEM to get the two numeric expressions that
8605
; follow the AT ( in PRINT AT, INPUT AT).
8606
 
8607
;; NEXT-2NUM
8608
L1C79:  RST     20H             ; NEXT-CHAR advance past 'AT' or '('.
8609
 
8610
; --------
8611
; class-08 e.g. POKE 65535,2     ; two numeric expressions separated by comma
8612
;; CLASS-08
8613
;; EXPT-2NUM
8614
L1C7A:  CALL    L1C82           ; routine EXPT-1NUM is called for first
8615
                                ; numeric expression
8616
        CP      $2C             ; is character ',' ?
8617
        JR      NZ,L1C8A        ; to REPORT-C if not required separator.
8618
                                ; 'Nonsense in BASIC'.
8619
 
8620
        RST     20H             ; NEXT-CHAR
8621
 
8622
; ->
8623
;  class-06  e.g. GOTO a*1000   ; a numeric expression must follow
8624
;; CLASS-06
8625
;; EXPT-1NUM
8626
L1C82:  CALL    L24FB           ; routine SCANNING
8627
        BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
8628
        RET     NZ              ; return if result is numeric.
8629
 
8630
;; REPORT-C
8631
L1C8A:  RST     08H             ; ERROR-1
8632
        DEFB    $0B             ; Error Report: Nonsense in BASIC
8633
 
8634
; ---------------------------------------------------------------
8635
; class-0A e.g. ERASE "????"    ; a string expression must follow.
8636
;                               ; these only occur in unimplemented commands
8637
;                               ; although the routine expt-exp is called
8638
;                               ; from SAVE-ETC
8639
 
8640
;; CLASS-0A
8641
;; EXPT-EXP
8642
L1C8C:  CALL    L24FB           ; routine SCANNING
8643
        BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
8644
        RET     Z               ; return if string result.
8645
 
8646
        JR      L1C8A           ; back to REPORT-C if numeric.
8647
 
8648
; ---------------------
8649
; Set permanent colours
8650
; class 07
8651
; ---------------------
8652
; class-07 e.g. PAPER 6          ; a single class for a collection of
8653
;                               ; similar commands. Clever.
8654
;
8655
; Note. these commands should ensure that current channel is 'S'
8656
 
8657
;; CLASS-07
8658
L1C96:  BIT     7,(IY+$01)      ; test FLAGS - checking syntax only ?
8659
                                ; Note. there is a subroutine to do this.
8660
        RES     0,(IY+$02)      ; update TV_FLAG - signal main screen in use
8661
        CALL    NZ,L0D4D        ; routine TEMPS is called in runtime.
8662
        POP     AF              ; drop return address SCAN-LOOP
8663
        LD      A,($5C74)       ; T_ADDR_lo to accumulator.
8664
                                ; points to '$07' entry + 1
8665
                                ; e.g. for INK points to $EC now
8666
 
8667
; Note if you move alter the syntax table next line may have to be altered.
8668
 
8669
; Note. For ZASM assembler replace following expression with SUB $13.
8670
 
8671
L1CA5:  SUB     L1AEB-$D8 % 256 ; convert $EB to $D8 ('INK') etc.
8672
                                ; ( is SUB $13 in standard ROM )
8673
 
8674
        CALL    L21FC           ; routine CO-TEMP-4
8675
        CALL    L1BEE           ; routine CHECK-END check that nothing else
8676
                                ; in statement.
8677
 
8678
; return here in runtime.
8679
 
8680
        LD      HL,($5C8F)      ; pick up ATTR_T and MASK_T
8681
        LD      ($5C8D),HL      ; and store in ATTR_P and MASK_P
8682
        LD      HL,$5C91        ; point to P_FLAG.
8683
        LD      A,(HL)          ; pick up in A
8684
        RLCA                    ; rotate to left
8685
        XOR     (HL)            ; combine with HL
8686
        AND     $AA             ; 10101010
8687
        XOR     (HL)            ; only permanent bits affected
8688
        LD      (HL),A          ; reload into P_FLAG.
8689
        RET                     ; return.
8690
 
8691
; ------------------
8692
; Command class---09
8693
; ------------------
8694
; e.g. PLOT PAPER 0; 128,88     ; two coordinates preceded by optional
8695
;                               ; embedded colour items.
8696
;
8697
; Note. this command should ensure that current channel is actually 'S'.
8698
 
8699
;; CLASS-09
8700
L1CBE:  CALL    L2530           ; routine SYNTAX-Z
8701
        JR      Z,L1CD6         ; forward to CL-09-1 if checking syntax.
8702
 
8703
        RES     0,(IY+$02)      ; update TV_FLAG - signal main screen in use
8704
        CALL    L0D4D           ; routine TEMPS is called.
8705
        LD      HL,$5C90        ; point to MASK_T
8706
        LD      A,(HL)          ; fetch mask to accumulator.
8707
        OR      $F8             ; or with 11111000 paper/bright/flash 8
8708
        LD      (HL),A          ; mask back to MASK_T system variable.
8709
        RES     6,(IY+$57)      ; reset P_FLAG  - signal NOT PAPER 9 ?
8710
 
8711
        RST     18H             ; GET-CHAR
8712
 
8713
;; CL-09-1
8714
L1CD6:  CALL    L21E2           ; routine CO-TEMP-2 deals with any embedded
8715
                                ; colour items.
8716
        JR      L1C7A           ; exit via EXPT-2NUM to check for x,y.
8717
 
8718
; Note. if either of the numeric expressions contain STR$ then the flag setting
8719
; above will be undone when the channel flags are reset during STR$.
8720
; e.g.
8721
; 10 BORDER 3 : PLOT VAL STR$ 128, VAL STR$ 100
8722
; credit John Elliott.
8723
 
8724
; ------------------
8725
; Command class---0B
8726
; ------------------
8727
; Again a single class for four commands.
8728
; This command just jumps back to SAVE-ETC to handle the four tape commands.
8729
; The routine itself works out which command has called it by examining the
8730
; address in T_ADDR_lo. Note therefore that the syntax table has to be
8731
; located where these and other sequential command addresses are not split
8732
; over a page boundary.
8733
 
8734
;; CLASS-0B
8735
L1CDB:  JP      L0605           ; jump way back to SAVE-ETC
8736
 
8737
; --------------
8738
; Fetch a number
8739
; --------------
8740
; This routine is called from CLASS-03 when a command may be followed by
8741
; an optional numeric expression e.g. RUN. If the end of statement has
8742
; been reached then zero is used as the default.
8743
; Also called from LIST-4.
8744
 
8745
;; FETCH-NUM
8746
L1CDE:  CP      $0D             ; is character a carriage return ?
8747
        JR      Z,L1CE6         ; forward to USE-ZERO if so
8748
 
8749
        CP      $3A             ; is it ':' ?
8750
        JR      NZ,L1C82        ; forward to EXPT-1NUM if not.
8751
                                ; else continue and use zero.
8752
 
8753
; ----------------
8754
; Use zero routine
8755
; ----------------
8756
; This routine is called four times to place the value zero on the
8757
; calculator stack as a default value in runtime.
8758
 
8759
;; USE-ZERO
8760
L1CE6:  CALL    L2530           ; routine SYNTAX-Z  (UNSTACK-Z?)
8761
        RET     Z               ;
8762
 
8763
        RST     28H             ;; FP-CALC
8764
        DEFB    $A0             ;;stk-zero       ;0.
8765
        DEFB    $38             ;;end-calc
8766
 
8767
        RET                     ; return.
8768
 
8769
; -------------------
8770
; Handle STOP command
8771
; -------------------
8772
; Command Syntax: STOP
8773
; One of the shortest and least used commands. As with 'OK' not an error.
8774
 
8775
;; REPORT-9
8776
;; STOP
8777
L1CEE:  RST     08H             ; ERROR-1
8778
        DEFB    $08             ; Error Report: STOP statement
8779
 
8780
; -----------------
8781
; Handle IF command
8782
; -----------------
8783
; e.g. IF score>100 THEN PRINT "You Win"
8784
; The parser has already checked the expression the result of which is on
8785
; the calculator stack. The presence of the 'THEN' separator has also been
8786
; checked and CH-ADD points to the command after THEN.
8787
;
8788
 
8789
;; IF
8790
L1CF0:  POP     BC              ; drop return address - STMT-RET
8791
        CALL    L2530           ; routine SYNTAX-Z
8792
        JR      Z,L1D00         ; forward to IF-1 if checking syntax
8793
                                ; to check syntax of PRINT "You Win"
8794
 
8795
 
8796
        RST     28H             ;; FP-CALC    score>100 (1=TRUE 0=FALSE)
8797
        DEFB    $02             ;;delete      .
8798
        DEFB    $38             ;;end-calc
8799
 
8800
        EX      DE,HL           ; make HL point to deleted value
8801
        CALL    L34E9           ; routine TEST-ZERO
8802
        JP      C,L1BB3         ; jump to LINE-END if FALSE (0)
8803
 
8804
;; IF-1
8805
L1D00:  JP      L1B29           ; to STMT-L-1, if true (1) to execute command
8806
                                ; after 'THEN' token.
8807
 
8808
; ------------------
8809
; Handle FOR command
8810
; ------------------
8811
; e.g. FOR i = 0 TO 1 STEP 0.1
8812
; Using the syntax tables, the parser has already checked for a start and
8813
; limit value and also for the intervening separator.
8814
; the two values v,l are on the calculator stack.
8815
; CLASS-04 has also checked the variable and the name is in STRLEN_lo.
8816
; The routine begins by checking for an optional STEP.
8817
 
8818
;; FOR
8819
L1D03:  CP      $CD             ; is there a 'STEP' ?
8820
        JR      NZ,L1D10        ; to F-USE-1 if not to use 1 as default.
8821
 
8822
        RST     20H             ; NEXT-CHAR
8823
        CALL    L1C82           ; routine EXPT-1NUM
8824
        CALL    L1BEE           ; routine CHECK-END
8825
        JR      L1D16           ; to F-REORDER
8826
 
8827
; ---
8828
 
8829
;; F-USE-1
8830
L1D10:  CALL    L1BEE           ; routine CHECK-END
8831
 
8832
        RST     28H             ;; FP-CALC      v,l.
8833
        DEFB    $A1             ;;stk-one       v,l,1=s.
8834
        DEFB    $38             ;;end-calc
8835
 
8836
 
8837
;; F-REORDER
8838
L1D16:  RST     28H             ;; FP-CALC       v,l,s.
8839
        DEFB    $C0             ;;st-mem-0       v,l,s.
8840
        DEFB    $02             ;;delete         v,l.
8841
        DEFB    $01             ;;exchange       l,v.
8842
        DEFB    $E0             ;;get-mem-0      l,v,s.
8843
        DEFB    $01             ;;exchange       l,s,v.
8844
        DEFB    $38             ;;end-calc
8845
 
8846
        CALL    L2AFF           ; routine LET assigns the initial value v to
8847
                                ; the variable altering type if necessary.
8848
        LD      ($5C68),HL      ; The system variable MEM is made to point to
8849
                                ; the variable instead of its normal
8850
                                ; location MEMBOT
8851
        DEC     HL              ; point to single-character name
8852
        LD      A,(HL)          ; fetch name
8853
        SET     7,(HL)          ; set bit 7 at location
8854
        LD      BC,$0006        ; add six to HL
8855
        ADD     HL,BC           ; to address where limit should be.
8856
        RLCA                    ; test bit 7 of original name.
8857
        JR      C,L1D34         ; forward to F-L-S if already a FOR/NEXT
8858
                                ; variable
8859
 
8860
        LD      C,$0D           ; otherwise an additional 13 bytes are needed.
8861
                                ; 5 for each value, two for line number and
8862
                                ; 1 byte for looping statement.
8863
        CALL    L1655           ; routine MAKE-ROOM creates them.
8864
        INC     HL              ; make HL address limit.
8865
 
8866
;; F-L-S
8867
L1D34:  PUSH    HL              ; save position.
8868
 
8869
        RST     28H             ;; FP-CALC         l,s.
8870
        DEFB    $02             ;;delete           l.
8871
        DEFB    $02             ;;delete           .
8872
        DEFB    $38             ;;end-calc
8873
                                ; DE points to STKEND, l.
8874
 
8875
        POP     HL              ; restore variable position
8876
        EX      DE,HL           ; swap pointers
8877
        LD      C,$0A           ; ten bytes to move
8878
        LDIR                    ; Copy 'deleted' values to variable.
8879
        LD      HL,($5C45)      ; Load with current line number from PPC
8880
        EX      DE,HL           ; exchange pointers.
8881
        LD      (HL),E          ; save the looping line
8882
        INC     HL              ; in the next
8883
        LD      (HL),D          ; two locations.
8884
        LD      D,(IY+$0D)      ; fetch statement from SUBPPC system variable.
8885
        INC     D               ; increment statement.
8886
        INC     HL              ; and pointer
8887
        LD      (HL),D          ; and store the looping statement.
8888
                                ;
8889
        CALL    L1DDA           ; routine NEXT-LOOP considers an initial
8890
        RET     NC              ; iteration. Return to STMT-RET if a loop is
8891
                                ; possible to execute next statement.
8892
 
8893
; no loop is possible so execution continues after the matching 'NEXT'
8894
 
8895
        LD      B,(IY+$38)      ; get single-character name from STRLEN_lo
8896
        LD      HL,($5C45)      ; get the current line from PPC
8897
        LD      ($5C42),HL      ; and store it in NEWPPC
8898
        LD      A,($5C47)       ; fetch current statement from SUBPPC
8899
        NEG                     ; Negate as counter decrements from zero
8900
                                ; initially and we are in the middle of a
8901
                                ; line.
8902
        LD      D,A             ; Store result in D.
8903
        LD      HL,($5C5D)      ; get current address from CH_ADD
8904
        LD      E,$F3           ; search will be for token 'NEXT'
8905
 
8906
;; F-LOOP
8907
L1D64:  PUSH    BC              ; save variable name.
8908
        LD      BC,($5C55)      ; fetch NXTLIN
8909
        CALL    L1D86           ; routine LOOK-PROG searches for 'NEXT' token.
8910
        LD      ($5C55),BC      ; update NXTLIN
8911
        POP     BC              ; and fetch the letter
8912
        JR      C,L1D84         ; forward to REPORT-I if the end of program
8913
                                ; was reached by LOOK-PROG.
8914
                                ; 'FOR without NEXT'
8915
 
8916
        RST     20H             ; NEXT-CHAR fetches character after NEXT
8917
        OR      $20             ; ensure it is upper-case.
8918
        CP      B               ; compare with FOR variable name
8919
        JR      Z,L1D7C         ; forward to F-FOUND if it matches.
8920
 
8921
; but if no match i.e. nested FOR/NEXT loops then continue search.
8922
 
8923
        RST     20H             ; NEXT-CHAR
8924
        JR      L1D64           ; back to F-LOOP
8925
 
8926
; ---
8927
 
8928
 
8929
;; F-FOUND
8930
L1D7C:  RST     20H             ; NEXT-CHAR
8931
        LD      A,$01           ; subtract the negated counter from 1
8932
        SUB     D               ; to give the statement after the NEXT
8933
        LD      ($5C44),A       ; set system variable NSPPC
8934
        RET                     ; return to STMT-RET to branch to new
8935
                                ; line and statement. ->
8936
; ---
8937
 
8938
;; REPORT-I
8939
L1D84:  RST     08H             ; ERROR-1
8940
        DEFB    $11             ; Error Report: FOR without NEXT
8941
 
8942
; ---------
8943
; LOOK-PROG
8944
; ---------
8945
; Find DATA, DEF FN or NEXT.
8946
; This routine searches the program area for one of the above three keywords.
8947
; On entry, HL points to start of search area.
8948
; The token is in E, and D holds a statement count, decremented from zero.
8949
 
8950
;; LOOK-PROG
8951
L1D86:  LD      A,(HL)          ; fetch current character
8952
        CP      $3A             ; is it ':' a statement separator ?
8953
        JR      Z,L1DA3         ; forward to LOOK-P-2 if so.
8954
 
8955
; The starting point was PROG - 1 or the end of a line.
8956
 
8957
;; LOOK-P-1
8958
L1D8B:  INC     HL              ; increment pointer to address
8959
        LD      A,(HL)          ; the high byte of line number
8960
        AND     $C0             ; test for program end marker $80 or a
8961
                                ; variable
8962
        SCF                     ; Set Carry Flag
8963
        RET     NZ              ; return with carry set if at end
8964
                                ; of program.           ->
8965
 
8966
        LD      B,(HL)          ; high byte of line number to B
8967
        INC     HL              ;
8968
        LD      C,(HL)          ; low byte to C.
8969
        LD      ($5C42),BC      ; set system variable NEWPPC.
8970
        INC     HL              ;
8971
        LD      C,(HL)          ; low byte of line length to C.
8972
        INC     HL              ;
8973
        LD      B,(HL)          ; high byte to B.
8974
        PUSH    HL              ; save address
8975
        ADD     HL,BC           ; add length to position.
8976
        LD      B,H             ; and save result
8977
        LD      C,L             ; in BC.
8978
        POP     HL              ; restore address.
8979
        LD      D,$00           ; initialize statement counter to zero.
8980
 
8981
;; LOOK-P-2
8982
L1DA3:  PUSH    BC              ; save address of next line
8983
        CALL    L198B           ; routine EACH-STMT searches current line.
8984
        POP     BC              ; restore address.
8985
        RET     NC              ; return if match was found. ->
8986
 
8987
        JR      L1D8B           ; back to LOOK-P-1 for next line.
8988
 
8989
; -------------------
8990
; Handle NEXT command
8991
; -------------------
8992
; e.g. NEXT i
8993
; The parameter tables have already evaluated the presence of a variable
8994
 
8995
;; NEXT
8996
L1DAB:  BIT     1,(IY+$37)      ; test FLAGX - handling a new variable ?
8997
        JP      NZ,L1C2E        ; jump back to REPORT-2 if so
8998
                                ; 'Variable not found'
8999
 
9000
; now test if found variable is a simple variable uninitialized by a FOR.
9001
 
9002
        LD      HL,($5C4D)      ; load address of variable from DEST
9003
        BIT     7,(HL)          ; is it correct type ?
9004
        JR      Z,L1DD8         ; forward to REPORT-1 if not
9005
                                ; 'NEXT without FOR'
9006
 
9007
        INC     HL              ; step past variable name
9008
        LD      ($5C68),HL      ; and set MEM to point to three 5-byte values
9009
                                ; value, limit, step.
9010
 
9011
        RST     28H             ;; FP-CALC     add step and re-store
9012
        DEFB    $E0             ;;get-mem-0    v.
9013
        DEFB    $E2             ;;get-mem-2    v,s.
9014
        DEFB    $0F             ;;addition     v+s.
9015
        DEFB    $C0             ;;st-mem-0     v+s.
9016
        DEFB    $02             ;;delete       .
9017
        DEFB    $38             ;;end-calc
9018
 
9019
        CALL    L1DDA           ; routine NEXT-LOOP tests against limit.
9020
        RET     C               ; return if no more iterations possible.
9021
 
9022
        LD      HL,($5C68)      ; find start of variable contents from MEM.
9023
        LD      DE,$000F        ; add 3*5 to
9024
        ADD     HL,DE           ; address the looping line number
9025
        LD      E,(HL)          ; low byte to E
9026
        INC     HL              ;
9027
        LD      D,(HL)          ; high byte to D
9028
        INC     HL              ; address looping statement
9029
        LD      H,(HL)          ; and store in H
9030
        EX      DE,HL           ; swap registers
9031
        JP      L1E73           ; exit via GO-TO-2 to execute another loop.
9032
 
9033
; ---
9034
 
9035
;; REPORT-1
9036
L1DD8:  RST     08H             ; ERROR-1
9037
        DEFB    $00             ; Error Report: NEXT without FOR
9038
 
9039
 
9040
; -----------------
9041
; Perform NEXT loop
9042
; -----------------
9043
; This routine is called from the FOR command to test for an initial
9044
; iteration and from the NEXT command to test for all subsequent iterations.
9045
; the system variable MEM addresses the variable's contents which, in the
9046
; latter case, have had the step, possibly negative, added to the value.
9047
 
9048
;; NEXT-LOOP
9049
L1DDA:  RST     28H             ;; FP-CALC
9050
        DEFB    $E1             ;;get-mem-1        l.
9051
        DEFB    $E0             ;;get-mem-0        l,v.
9052
        DEFB    $E2             ;;get-mem-2        l,v,s.
9053
        DEFB    $36             ;;less-0           l,v,(1/0) negative step ?
9054
        DEFB    $00             ;;jump-true        l,v.(1/0)
9055
 
9056
        DEFB    $02             ;;to L1DE2, NEXT-1 if step negative
9057
 
9058
        DEFB    $01             ;;exchange         v,l.
9059
 
9060
;; NEXT-1
9061
L1DE2:  DEFB    $03             ;;subtract         l-v OR v-l.
9062
        DEFB    $37             ;;greater-0        (1/0)
9063
        DEFB    $00             ;;jump-true        .
9064
 
9065
        DEFB    $04             ;;to L1DE9, NEXT-2 if no more iterations.
9066
 
9067
        DEFB    $38             ;;end-calc         .
9068
 
9069
        AND     A               ; clear carry flag signalling another loop.
9070
        RET                     ; return
9071
 
9072
; ---
9073
 
9074
;; NEXT-2
9075
L1DE9:  DEFB    $38             ;;end-calc         .
9076
 
9077
        SCF                     ; set carry flag signalling looping exhausted.
9078
        RET                     ; return
9079
 
9080
 
9081
; -------------------
9082
; Handle READ command
9083
; -------------------
9084
; e.g. READ a, b$, c$(1000 TO 3000)
9085
; A list of comma-separated variables is assigned from a list of
9086
; comma-separated expressions.
9087
; As it moves along the first list, the character address CH_ADD is stored
9088
; in X_PTR while CH_ADD is used to read the second list.
9089
 
9090
;; READ-3
9091
L1DEC:  RST     20H             ; NEXT-CHAR
9092
 
9093
; -> Entry point.
9094
;; READ
9095
L1DED:  CALL    L1C1F           ; routine CLASS-01 checks variable.
9096
        CALL    L2530           ; routine SYNTAX-Z
9097
        JR      Z,L1E1E         ; forward to READ-2 if checking syntax
9098
 
9099
 
9100
        RST     18H             ; GET-CHAR
9101
        LD      ($5C5F),HL      ; save character position in X_PTR.
9102
        LD      HL,($5C57)      ; load HL with Data Address DATADD, which is
9103
                                ; the start of the program or the address
9104
                                ; after the last expression that was read or
9105
                                ; the address of the line number of the
9106
                                ; last RESTORE command.
9107
        LD      A,(HL)          ; fetch character
9108
        CP      $2C             ; is it a comma ?
9109
        JR      Z,L1E0A         ; forward to READ-1 if so.
9110
 
9111
; else all data in this statement has been read so look for next DATA token
9112
 
9113
        LD      E,$E4           ; token 'DATA'
9114
        CALL    L1D86           ; routine LOOK-PROG
9115
        JR      NC,L1E0A        ; forward to READ-1 if DATA found
9116
 
9117
; else report the error.
9118
 
9119
;; REPORT-E
9120
L1E08:  RST     08H             ; ERROR-1
9121
        DEFB    $0D             ; Error Report: Out of DATA
9122
 
9123
;; READ-1
9124
L1E0A:  CALL    L0077           ; routine TEMP-PTR1 advances updating CH_ADD
9125
                                ; with new DATADD position.
9126
        CALL    L1C56           ; routine VAL-FET-1 assigns value to variable
9127
                                ; checking type match and adjusting CH_ADD.
9128
 
9129
        RST     18H             ; GET-CHAR fetches adjusted character position
9130
        LD      ($5C57),HL      ; store back in DATADD
9131
        LD      HL,($5C5F)      ; fetch X_PTR  the original READ CH_ADD
9132
        LD      (IY+$26),$00    ; now nullify X_PTR_hi
9133
        CALL    L0078           ; routine TEMP-PTR2 restores READ CH_ADD
9134
 
9135
;; READ-2
9136
L1E1E:  RST     18H             ; GET-CHAR
9137
        CP      $2C             ; is it ',' indicating more variables to read ?
9138
        JR      Z,L1DEC         ; back to READ-3 if so
9139
 
9140
        CALL    L1BEE           ; routine CHECK-END
9141
        RET                     ; return from here in runtime to STMT-RET.
9142
 
9143
; -------------------
9144
; Handle DATA command
9145
; -------------------
9146
; In runtime this 'command' is passed by but the syntax is checked when such
9147
; a statement is found while parsing a line.
9148
; e.g. DATA 1, 2, "text", score-1, a$(location, room, object), FN r(49),
9149
;         wages - tax, TRUE, The meaning of life
9150
 
9151
;; DATA
9152
L1E27:  CALL    L2530           ; routine SYNTAX-Z to check status
9153
        JR      NZ,L1E37        ; forward to DATA-2 if in runtime
9154
 
9155
;; DATA-1
9156
L1E2C:  CALL    L24FB           ; routine SCANNING to check syntax of
9157
                                ; expression
9158
        CP      $2C             ; is it a comma ?
9159
        CALL    NZ,L1BEE        ; routine CHECK-END checks that statement
9160
                                ; is complete. Will make an early exit if
9161
                                ; so. >>>
9162
        RST     20H             ; NEXT-CHAR
9163
        JR      L1E2C           ; back to DATA-1
9164
 
9165
; ---
9166
 
9167
;; DATA-2
9168
L1E37:  LD      A,$E4           ; set token to 'DATA' and continue into
9169
                                ; the PASS-BY routine.
9170
 
9171
 
9172
; ----------------------------------
9173
; Check statement for DATA or DEF FN
9174
; ----------------------------------
9175
; This routine is used to backtrack to a command token and then
9176
; forward to the next statement in runtime.
9177
 
9178
;; PASS-BY
9179
L1E39:  LD      B,A             ; Give BC enough space to find token.
9180
        CPDR                    ; Compare decrement and repeat. (Only use).
9181
                                ; Work backwards till keyword is found which
9182
                                ; is start of statement before any quotes.
9183
                                ; HL points to location before keyword.
9184
        LD      DE,$0200        ; count 1+1 statements, dummy value in E to
9185
                                ; inhibit searching for a token.
9186
        JP      L198B           ; to EACH-STMT to find next statement
9187
 
9188
; -----------------------------------------------------------------------
9189
; A General Note on Invalid Line Numbers.
9190
; =======================================
9191
; One of the revolutionary concepts of Sinclair BASIC was that it supported
9192
; virtual line numbers. That is the destination of a GO TO, RESTORE etc. need
9193
; not exist. It could be a point before or after an actual line number.
9194
; Zero suffices for a before but the after should logically be infinity.
9195
; Since the maximum actual line limit is 9999 then the system limit, 16383
9196
; when variables kick in, would serve fine as a virtual end point.
9197
; However, ironically, only the LOAD command gets it right. It will not
9198
; autostart a program that has been saved with a line higher than 16383.
9199
; All the other commands deal with the limit unsatisfactorily.
9200
; LIST, RUN, GO TO, GO SUB and RESTORE have problems and the latter may
9201
; crash the machine when supplied with an inappropriate virtual line number.
9202
; This is puzzling as very careful consideration must have been given to
9203
; this point when the new variable types were allocated their masks and also
9204
; when the routine NEXT-ONE was successfully re-written to reflect this.
9205
; An enigma.
9206
; -------------------------------------------------------------------------
9207
 
9208
; ----------------------
9209
; Handle RESTORE command
9210
; ----------------------
9211
; The restore command sets the system variable for the data address to
9212
; point to the location before the supplied line number or first line
9213
; thereafter.
9214
; This alters the position where subsequent READ commands look for data.
9215
; Note. If supplied with inappropriate high numbers the system may crash
9216
; in the LINE-ADDR routine as it will pass the program/variables end-marker
9217
; and then lose control of what it is looking for - variable or line number.
9218
; - observation, Steven Vickers, 1984, Pitman.
9219
 
9220
;; RESTORE
9221
L1E42:  CALL    L1E99           ; routine FIND-INT2 puts integer in BC.
9222
                                ; Note. B should be checked against limit $3F
9223
                                ; and an error generated if higher.
9224
 
9225
; this entry point is used from RUN command with BC holding zero
9226
 
9227
;; REST-RUN
9228
L1E45:  LD      H,B             ; transfer the line
9229
        LD      L,C             ; number to the HL register.
9230
        CALL    L196E           ; routine LINE-ADDR to fetch the address.
9231
        DEC     HL              ; point to the location before the line.
9232
        LD      ($5C57),HL      ; update system variable DATADD.
9233
        RET                     ; return to STMT-RET (or RUN)
9234
 
9235
; ------------------------
9236
; Handle RANDOMIZE command
9237
; ------------------------
9238
; This command sets the SEED for the RND function to a fixed value.
9239
; With the parameter zero, a random start point is used depending on
9240
; how long the computer has been switched on.
9241
 
9242
;; RANDOMIZE
9243
L1E4F:  CALL    L1E99           ; routine FIND-INT2 puts parameter in BC.
9244
        LD      A,B             ; test this
9245
        OR      C               ; for zero.
9246
        JR      NZ,L1E5A        ; forward to RAND-1 if not zero.
9247
 
9248
        LD      BC,($5C78)      ; use the lower two bytes at FRAMES1.
9249
 
9250
;; RAND-1
9251
L1E5A:  LD      ($5C76),BC      ; place in SEED system variable.
9252
        RET                     ; return to STMT-RET
9253
 
9254
; -----------------------
9255
; Handle CONTINUE command
9256
; -----------------------
9257
; The CONTINUE command transfers the OLD (but incremented) values of
9258
; line number and statement to the equivalent "NEW VALUE" system variables
9259
; by using the last part of GO TO and exits indirectly to STMT-RET.
9260
 
9261
;; CONTINUE
9262
L1E5F:  LD      HL,($5C6E)      ; fetch OLDPPC line number.
9263
        LD      D,(IY+$36)      ; fetch OSPPC statement.
9264
        JR      L1E73           ; forward to GO-TO-2
9265
 
9266
; --------------------
9267
; Handle GO TO command
9268
; --------------------
9269
; The GO TO command routine is also called by GO SUB and RUN routines
9270
; to evaluate the parameters of both commands.
9271
; It updates the system variables used to fetch the next line/statement.
9272
; It is at STMT-RET that the actual change in control takes place.
9273
; Unlike some BASICs the line number need not exist.
9274
; Note. the high byte of the line number is incorrectly compared with $F0
9275
; instead of $3F. This leads to commands with operands greater than 32767
9276
; being considered as having been run from the editing area and the
9277
; error report 'Statement Lost' is given instead of 'OK'.
9278
; - Steven Vickers, 1984.
9279
 
9280
;; GO-TO
9281
L1E67:  CALL    L1E99           ; routine FIND-INT2 puts operand in BC
9282
        LD      H,B             ; transfer line
9283
        LD      L,C             ; number to HL.
9284
        LD      D,$00           ; set statement to 0 - first.
9285
        LD      A,H             ; compare high byte only
9286
        CP      $F0             ; to $F0 i.e. 61439 in full.
9287
        JR      NC,L1E9F        ; forward to REPORT-B if above.
9288
 
9289
; This call entry point is used to update the system variables e.g. by RETURN.
9290
 
9291
;; GO-TO-2
9292
L1E73:  LD      ($5C42),HL      ; save line number in NEWPPC
9293
        LD      (IY+$0A),D      ; and statement in NSPPC
9294
        RET                     ; to STMT-RET (or GO-SUB command)
9295
 
9296
; ------------------
9297
; Handle OUT command
9298
; ------------------
9299
; Syntax has been checked and the two comma-separated values are on the
9300
; calculator stack.
9301
 
9302
;; OUT
9303
L1E7A:  CALL    L1E85           ; routine TWO-PARAM fetches values
9304
                                ; to BC and A.
9305
        OUT     (C),A           ; perform the operation.
9306
        RET                     ; return to STMT-RET.
9307
 
9308
; -------------------
9309
; Handle POKE command
9310
; -------------------
9311
; This routine alters a single byte in the 64K address space.
9312
; Happily no check is made as to whether ROM or RAM is addressed.
9313
; Sinclair BASIC requires no poking of system variables.
9314
 
9315
;; POKE
9316
L1E80:  CALL    L1E85           ; routine TWO-PARAM fetches values
9317
                                ; to BC and A.
9318
        LD      (BC),A          ; load memory location with A.
9319
        RET                     ; return to STMT-RET.
9320
 
9321
; ------------------------------------
9322
; Fetch two  parameters from calculator stack
9323
; ------------------------------------
9324
; This routine fetches a byte and word from the calculator stack
9325
; producing an error if either is out of range.
9326
 
9327
;; TWO-PARAM
9328
L1E85:  CALL    L2DD5           ; routine FP-TO-A
9329
        JR      C,L1E9F         ; forward to REPORT-B if overflow occurred
9330
 
9331
        JR      Z,L1E8E         ; forward to TWO-P-1 if positive
9332
 
9333
        NEG                     ; negative numbers are made positive
9334
 
9335
;; TWO-P-1
9336
L1E8E:  PUSH    AF              ; save the value
9337
        CALL    L1E99           ; routine FIND-INT2 gets integer to BC
9338
        POP     AF              ; restore the value
9339
        RET                     ; return
9340
 
9341
; -------------
9342
; Find integers
9343
; -------------
9344
; The first of these routines fetches a 8-bit integer (range 0-255) from the
9345
; calculator stack to the accumulator and is used for colours, streams,
9346
; durations and coordinates.
9347
; The second routine fetches 16-bit integers to the BC register pair
9348
; and is used to fetch command and function arguments involving line numbers
9349
; or memory addresses and also array subscripts and tab arguments.
9350
; ->
9351
 
9352
;; FIND-INT1
9353
L1E94:  CALL    L2DD5           ; routine FP-TO-A
9354
        JR      L1E9C           ; forward to FIND-I-1 for common exit routine.
9355
 
9356
; ---
9357
 
9358
; ->
9359
 
9360
;; FIND-INT2
9361
L1E99:  CALL    L2DA2           ; routine FP-TO-BC
9362
 
9363
;; FIND-I-1
9364
L1E9C:  JR      C,L1E9F         ; to REPORT-Bb with overflow.
9365
 
9366
        RET     Z               ; return if positive.
9367
 
9368
 
9369
;; REPORT-Bb
9370
L1E9F:  RST     08H             ; ERROR-1
9371
        DEFB    $0A             ; Error Report: Integer out of range
9372
 
9373
; ------------------
9374
; Handle RUN command
9375
; ------------------
9376
; This command runs a program starting at an optional line.
9377
; It performs a 'RESTORE 0' then CLEAR
9378
 
9379
;; RUN
9380
L1EA1:  CALL    L1E67           ; routine GO-TO puts line number in
9381
                                ; system variables.
9382
        LD      BC,$0000        ; prepare to set DATADD to first line.
9383
        CALL    L1E45           ; routine REST-RUN does the 'restore'.
9384
                                ; Note BC still holds zero.
9385
        JR      L1EAF           ; forward to CLEAR-RUN to clear variables
9386
                                ; without disturbing RAMTOP and
9387
                                ; exit indirectly to STMT-RET
9388
 
9389
; --------------------
9390
; Handle CLEAR command
9391
; --------------------
9392
; This command reclaims the space used by the variables.
9393
; It also clears the screen and the GO SUB stack.
9394
; With an integer expression, it sets the uppermost memory
9395
; address within the BASIC system.
9396
; "Contrary to the manual, CLEAR doesn't execute a RESTORE" -
9397
; Steven Vickers, Pitman Pocket Guide to the Spectrum, 1984.
9398
 
9399
;; CLEAR
9400
L1EAC:  CALL    L1E99           ; routine FIND-INT2 fetches to BC.
9401
 
9402
;; CLEAR-RUN
9403
L1EAF:  LD      A,B             ; test for
9404
        OR      C               ; zero.
9405
        JR      NZ,L1EB7        ; skip to CLEAR-1 if not zero.
9406
 
9407
        LD      BC,($5CB2)      ; use the existing value of RAMTOP if zero.
9408
 
9409
;; CLEAR-1
9410
L1EB7:  PUSH    BC              ; save ramtop value.
9411
 
9412
        LD      DE,($5C4B)      ; fetch VARS
9413
        LD      HL,($5C59)      ; fetch E_LINE
9414
        DEC     HL              ; adjust to point at variables end-marker.
9415
        CALL    L19E5           ; routine RECLAIM-1 reclaims the space used by
9416
                                ; the variables.
9417
 
9418
        CALL    L0D6B           ; routine CLS to clear screen.
9419
 
9420
        LD      HL,($5C65)      ; fetch STKEND the start of free memory.
9421
        LD      DE,$0032        ; allow for another 50 bytes.
9422
        ADD     HL,DE           ; add the overhead to HL.
9423
 
9424
        POP     DE              ; restore the ramtop value.
9425
        SBC     HL,DE           ; if HL is greater than the value then jump
9426
        JR      NC,L1EDA        ; forward to REPORT-M
9427
                                ; 'RAMTOP no good'
9428
 
9429
        LD      HL,($5CB4)      ; now P-RAMT ($7FFF on 16K RAM machine)
9430
        AND     A               ; exact this time.
9431
        SBC     HL,DE           ; new ramtop must be lower or the same.
9432
        JR      NC,L1EDC        ; skip to CLEAR-2 if in actual RAM.
9433
 
9434
;; REPORT-M
9435
L1EDA:  RST     08H             ; ERROR-1
9436
        DEFB    $15             ; Error Report: RAMTOP no good
9437
 
9438
;; CLEAR-2
9439
L1EDC:  EX      DE,HL           ; transfer ramtop value to HL.
9440
        LD      ($5CB2),HL      ; update system variable RAMTOP.
9441
        POP     DE              ; pop the return address STMT-RET.
9442
        POP     BC              ; pop the Error Address.
9443
        LD      (HL),$3E        ; now put the GO SUB end-marker at RAMTOP.
9444
        DEC     HL              ; leave a location beneath it.
9445
        LD      SP,HL           ; initialize the machine stack pointer.
9446
        PUSH    BC              ; push the error address.
9447
        LD      ($5C3D),SP      ; make ERR_SP point to location.
9448
        EX      DE,HL           ; put STMT-RET in HL.
9449
        JP      (HL)            ; and go there directly.
9450
 
9451
; ---------------------
9452
; Handle GO SUB command
9453
; ---------------------
9454
; The GO SUB command diverts BASIC control to a new line number
9455
; in a very similar manner to GO TO but
9456
; the current line number and current statement + 1
9457
; are placed on the GO SUB stack as a RETURN point.
9458
 
9459
;; GO-SUB
9460
L1EED:  POP     DE              ; drop the address STMT-RET
9461
        LD      H,(IY+$0D)      ; fetch statement from SUBPPC and
9462
        INC     H               ; increment it
9463
        EX      (SP),HL         ; swap - error address to HL,
9464
                                ; H (statement) at top of stack,
9465
                                ; L (unimportant) beneath.
9466
        INC     SP              ; adjust to overwrite unimportant byte
9467
        LD      BC,($5C45)      ; fetch the current line number from PPC
9468
        PUSH    BC              ; and PUSH onto GO SUB stack.
9469
                                ; the empty machine-stack can be rebuilt
9470
        PUSH    HL              ; push the error address.
9471
        LD      ($5C3D),SP      ; make system variable ERR_SP point to it.
9472
        PUSH    DE              ; push the address STMT-RET.
9473
        CALL    L1E67           ; call routine GO-TO to update the system
9474
                                ; variables NEWPPC and NSPPC.
9475
                                ; then make an indirect exit to STMT-RET via
9476
        LD      BC,$0014        ; a 20-byte overhead memory check.
9477
 
9478
; ----------------------
9479
; Check available memory
9480
; ----------------------
9481
; This routine is used on many occasions when extending a dynamic area
9482
; upwards or the GO SUB stack downwards.
9483
 
9484
;; TEST-ROOM
9485
L1F05:  LD      HL,($5C65)      ; fetch STKEND
9486
        ADD     HL,BC           ; add the supplied test value
9487
        JR      C,L1F15         ; forward to REPORT-4 if over $FFFF
9488
 
9489
        EX      DE,HL           ; was less so transfer to DE
9490
        LD      HL,$0050        ; test against another 80 bytes
9491
        ADD     HL,DE           ; anyway
9492
        JR      C,L1F15         ; forward to REPORT-4 if this passes $FFFF
9493
 
9494
        SBC     HL,SP           ; if less than the machine stack pointer
9495
        RET     C               ; then return - OK.
9496
 
9497
;; REPORT-4
9498
L1F15:  LD      L,$03           ; prepare 'Out of Memory'
9499
        JP      L0055           ; jump back to ERROR-3 at $0055
9500
                                ; Note. this error can't be trapped at $0008
9501
 
9502
; ------------------------------
9503
; THE 'FREE MEMORY' USER ROUTINE
9504
; ------------------------------
9505
; This routine is not used by the ROM but allows users to evaluate
9506
; approximate free memory with PRINT 65536 - USR 7962.
9507
 
9508
;; free-mem
9509
L1F1A:  LD      BC,$0000        ; allow no overhead.
9510
 
9511
        CALL    L1F05           ; routine TEST-ROOM.
9512
 
9513
        LD      B,H             ; transfer the result
9514
        LD      C,L             ; to the BC register.
9515
        RET                     ; the USR function returns value of BC.
9516
 
9517
; --------------------
9518
; THE 'RETURN' COMMAND
9519
; --------------------
9520
; As with any command, there are two values on the machine stack at the time
9521
; it is invoked.  The machine stack is below the GOSUB stack.  Both grow
9522
; downwards, the machine stack by two bytes, the GOSUB stack by 3 bytes.
9523
; The highest location is a statement byte followed by a two-byte line number.
9524
 
9525
;; RETURN
9526
L1F23:  POP     BC              ; drop the address STMT-RET.
9527
        POP     HL              ; now the error address.
9528
        POP     DE              ; now a possible BASIC return line.
9529
        LD      A,D             ; the high byte $00 - $27 is
9530
        CP      $3E             ; compared with the traditional end-marker $3E.
9531
        JR      Z,L1F36         ; forward to REPORT-7 with a match.
9532
                                ; 'RETURN without GOSUB'
9533
 
9534
; It was not the end-marker so a single statement byte remains at the base of
9535
; the calculator stack. It can't be popped off.
9536
 
9537
        DEC     SP              ; adjust stack pointer to create room for two
9538
                                ; bytes.
9539
        EX      (SP),HL         ; statement to H, error address to base of
9540
                                ; new machine stack.
9541
        EX      DE,HL           ; statement to D,  BASIC line number to HL.
9542
        LD      ($5C3D),SP      ; adjust ERR_SP to point to new stack pointer
9543
        PUSH    BC              ; now re-stack the address STMT-RET
9544
        JP      L1E73           ; to GO-TO-2 to update statement and line
9545
                                ; system variables and exit indirectly to the
9546
                                ; address just pushed on stack.
9547
 
9548
; ---
9549
 
9550
;; REPORT-7
9551
L1F36:  PUSH    DE              ; replace the end-marker.
9552
        PUSH    HL              ; now restore the error address
9553
                                ; as will be required in a few clock cycles.
9554
 
9555
        RST     08H             ; ERROR-1
9556
        DEFB    $06             ; Error Report: RETURN without GOSUB
9557
 
9558
; --------------------
9559
; Handle PAUSE command
9560
; --------------------
9561
; The pause command takes as its parameter the number of interrupts
9562
; for which to wait. PAUSE 50 pauses for about a second.
9563
; PAUSE 0 pauses indefinitely.
9564
; Both forms can be finished by pressing a key.
9565
 
9566
;; PAUSE
9567
L1F3A:  CALL    L1E99           ; routine FIND-INT2 puts value in BC
9568
 
9569
;; PAUSE-1
9570
L1F3D:  HALT                    ; wait for interrupt.
9571
        DEC     BC              ; decrease counter.
9572
        LD      A,B             ; test if
9573
        OR      C               ; result is zero.
9574
        JR      Z,L1F4F         ; forward to PAUSE-END if so.
9575
 
9576
        LD      A,B             ; test if
9577
        AND     C               ; now $FFFF
9578
        INC     A               ; that is, initially zero.
9579
        JR      NZ,L1F49        ; skip forward to PAUSE-2 if not.
9580
 
9581
        INC     BC              ; restore counter to zero.
9582
 
9583
;; PAUSE-2
9584
L1F49:  BIT     5,(IY+$01)      ; test FLAGS - has a new key been pressed ?
9585
        JR      Z,L1F3D         ; back to PAUSE-1 if not.
9586
 
9587
;; PAUSE-END
9588
L1F4F:  RES     5,(IY+$01)      ; update FLAGS - signal no new key
9589
        RET                     ; and return.
9590
 
9591
; -------------------
9592
; Check for BREAK key
9593
; -------------------
9594
; This routine is called from COPY-LINE, when interrupts are disabled,
9595
; to test if BREAK (SHIFT - SPACE) is being pressed.
9596
; It is also called at STMT-RET after every statement.
9597
 
9598
;; BREAK-KEY
9599
L1F54:  LD      A,$7F           ; Input address: $7FFE
9600
        IN      A,($FE)         ; read lower right keys
9601
        RRA                     ; rotate bit 0 - SPACE
9602
        RET     C               ; return if not reset
9603
 
9604
        LD      A,$FE           ; Input address: $FEFE
9605
        IN      A,($FE)         ; read lower left keys
9606
        RRA                     ; rotate bit 0 - SHIFT
9607
        RET                     ; carry will be set if not pressed.
9608
                                ; return with no carry if both keys
9609
                                ; pressed.
9610
 
9611
; ---------------------
9612
; Handle DEF FN command
9613
; ---------------------
9614
; e.g. DEF FN r$(a$,a) = a$(a TO )
9615
; this 'command' is ignored in runtime but has its syntax checked
9616
; during line-entry.
9617
 
9618
;; DEF-FN
9619
L1F60:  CALL    L2530           ; routine SYNTAX-Z
9620
        JR      Z,L1F6A         ; forward to DEF-FN-1 if parsing
9621
 
9622
        LD      A,$CE           ; else load A with 'DEF FN' and
9623
        JP      L1E39           ; jump back to PASS-BY
9624
 
9625
; ---
9626
 
9627
; continue here if checking syntax.
9628
 
9629
;; DEF-FN-1
9630
L1F6A:  SET      6,(IY+$01)     ; set FLAGS  - Assume numeric result
9631
        CALL    L2C8D           ; call routine ALPHA
9632
        JR      NC,L1F89        ; if not then to DEF-FN-4 to jump to
9633
                                ; 'Nonsense in BASIC'
9634
 
9635
 
9636
        RST     20H             ; NEXT-CHAR
9637
        CP      $24             ; is it '$' ?
9638
        JR      NZ,L1F7D        ; to DEF-FN-2 if not as numeric.
9639
 
9640
        RES     6,(IY+$01)      ; set FLAGS  - Signal string result
9641
 
9642
        RST     20H             ; get NEXT-CHAR
9643
 
9644
;; DEF-FN-2
9645
L1F7D:  CP      $28             ; is it '(' ?
9646
        JR      NZ,L1FBD        ; to DEF-FN-7 'Nonsense in BASIC'
9647
 
9648
 
9649
        RST     20H             ; NEXT-CHAR
9650
        CP      $29             ; is it ')' ?
9651
        JR      Z,L1FA6         ; to DEF-FN-6 if null argument
9652
 
9653
;; DEF-FN-3
9654
L1F86:  CALL    L2C8D           ; routine ALPHA checks that it is the expected
9655
                                ; alphabetic character.
9656
 
9657
;; DEF-FN-4
9658
L1F89:  JP      NC,L1C8A        ; to REPORT-C  if not
9659
                                ; 'Nonsense in BASIC'.
9660
 
9661
        EX      DE,HL           ; save pointer in DE
9662
 
9663
        RST     20H             ; NEXT-CHAR re-initializes HL from CH_ADD
9664
                                ; and advances.
9665
        CP      $24             ; '$' ? is it a string argument.
9666
        JR      NZ,L1F94        ; forward to DEF-FN-5 if not.
9667
 
9668
        EX      DE,HL           ; save pointer to '$' in DE
9669
 
9670
        RST     20H             ; NEXT-CHAR re-initializes HL and advances
9671
 
9672
;; DEF-FN-5
9673
L1F94:  EX      DE,HL           ; bring back pointer.
9674
        LD      BC,$0006        ; the function requires six hidden bytes for
9675
                                ; each parameter passed.
9676
                                ; The first byte will be $0E
9677
                                ; then 5-byte numeric value
9678
                                ; or 5-byte string pointer.
9679
 
9680
        CALL    L1655           ; routine MAKE-ROOM creates space in program
9681
                                ; area.
9682
 
9683
        INC     HL              ; adjust HL (set by LDDR)
9684
        INC     HL              ; to point to first location.
9685
        LD      (HL),$0E        ; insert the 'hidden' marker.
9686
 
9687
; Note. these invisible storage locations hold nothing meaningful for the
9688
; moment. They will be used every time the corresponding function is
9689
; evaluated in runtime.
9690
; Now consider the following character fetched earlier.
9691
 
9692
        CP      $2C             ; is it ',' ? (more than one parameter)
9693
        JR      NZ,L1FA6        ; to DEF-FN-6 if not
9694
 
9695
 
9696
        RST     20H             ; else NEXT-CHAR
9697
        JR      L1F86           ; and back to DEF-FN-3
9698
 
9699
; ---
9700
 
9701
;; DEF-FN-6
9702
L1FA6:  CP      $29             ; should close with a ')'
9703
        JR      NZ,L1FBD        ; to DEF-FN-7 if not
9704
                                ; 'Nonsense in BASIC'
9705
 
9706
 
9707
        RST     20H             ; get NEXT-CHAR
9708
        CP      $3D             ; is it '=' ?
9709
        JR      NZ,L1FBD        ; to DEF-FN-7 if not 'Nonsense...'
9710
 
9711
 
9712
        RST     20H             ; address NEXT-CHAR
9713
        LD      A,($5C3B)       ; get FLAGS which has been set above
9714
        PUSH    AF              ; and preserve
9715
 
9716
        CALL    L24FB           ; routine SCANNING checks syntax of expression
9717
                                ; and also sets flags.
9718
 
9719
        POP     AF              ; restore previous flags
9720
        XOR     (IY+$01)        ; xor with FLAGS - bit 6 should be same
9721
                                ; therefore will be reset.
9722
        AND     $40             ; isolate bit 6.
9723
 
9724
;; DEF-FN-7
9725
L1FBD:  JP      NZ,L1C8A        ; jump back to REPORT-C if the expected result
9726
                                ; is not the same type.
9727
                                ; 'Nonsense in BASIC'
9728
 
9729
        CALL    L1BEE           ; routine CHECK-END will return early if
9730
                                ; at end of statement and move onto next
9731
                                ; else produce error report. >>>
9732
 
9733
                                ; There will be no return to here.
9734
 
9735
; -------------------------------
9736
; Returning early from subroutine
9737
; -------------------------------
9738
; All routines are capable of being run in two modes - syntax checking mode
9739
; and runtime mode.  This routine is called often to allow a routine to return
9740
; early if checking syntax.
9741
 
9742
;; UNSTACK-Z
9743
L1FC3:  CALL    L2530           ; routine SYNTAX-Z sets zero flag if syntax
9744
                                ; is being checked.
9745
 
9746
        POP     HL              ; drop the return address.
9747
        RET      Z              ; return to previous call in chain if checking
9748
                                ; syntax.
9749
 
9750
        JP      (HL)            ; jump to return address as BASIC program is
9751
                                ; actually running.
9752
 
9753
; ---------------------
9754
; Handle LPRINT command
9755
; ---------------------
9756
; A simple form of 'PRINT #3' although it can output to 16 streams.
9757
; Probably for compatibility with other BASICs particularly ZX81 BASIC.
9758
; An extra UDG might have been better.
9759
 
9760
;; LPRINT
9761
L1FC9:  LD      A,$03           ; the printer channel
9762
        JR      L1FCF           ; forward to PRINT-1
9763
 
9764
; ---------------------
9765
; Handle PRINT commands
9766
; ---------------------
9767
; The Spectrum's main stream output command.
9768
; The default stream is stream 2 which is normally the upper screen
9769
; of the computer. However the stream can be altered in range 0 - 15.
9770
 
9771
;; PRINT
9772
L1FCD:  LD      A,$02           ; the stream for the upper screen.
9773
 
9774
; The LPRINT command joins here.
9775
 
9776
;; PRINT-1
9777
L1FCF:  CALL    L2530           ; routine SYNTAX-Z checks if program running
9778
        CALL    NZ,L1601        ; routine CHAN-OPEN if so
9779
        CALL    L0D4D           ; routine TEMPS sets temporary colours.
9780
        CALL    L1FDF           ; routine PRINT-2 - the actual item
9781
        CALL    L1BEE           ; routine CHECK-END gives error if not at end
9782
                                ; of statement
9783
        RET                     ; and return >>>
9784
 
9785
; ------------------------------------
9786
; this subroutine is called from above
9787
; and also from INPUT.
9788
 
9789
;; PRINT-2
9790
L1FDF:  RST     18H             ; GET-CHAR gets printable character
9791
        CALL    L2045           ; routine PR-END-Z checks if more printing
9792
        JR      Z,L1FF2         ; to PRINT-4 if not     e.g. just 'PRINT :'
9793
 
9794
; This tight loop deals with combinations of positional controls and
9795
; print items. An early return can be made from within the loop
9796
; if the end of a print sequence is reached.
9797
 
9798
;; PRINT-3
9799
L1FE5:  CALL    L204E           ; routine PR-POSN-1 returns zero if more
9800
                                ; but returns early at this point if
9801
                                ; at end of statement!
9802
                                ;
9803
        JR      Z,L1FE5         ; to PRINT-3 if consecutive positioners
9804
 
9805
        CALL    L1FFC           ; routine PR-ITEM-1 deals with strings etc.
9806
        CALL    L204E           ; routine PR-POSN-1 for more position codes
9807
        JR      Z,L1FE5         ; loop back to PRINT-3 if so
9808
 
9809
;; PRINT-4
9810
L1FF2:  CP      $29             ; return now if this is ')' from input-item.
9811
                                ; (see INPUT.)
9812
        RET     Z               ; or continue and print carriage return in
9813
                                ; runtime
9814
 
9815
; ---------------------
9816
; Print carriage return
9817
; ---------------------
9818
; This routine which continues from above prints a carriage return
9819
; in run-time. It is also called once from PRINT-POSN.
9820
 
9821
;; PRINT-CR
9822
L1FF5:  CALL    L1FC3           ; routine UNSTACK-Z
9823
 
9824
        LD      A,$0D           ; prepare a carriage return
9825
 
9826
        RST     10H             ; PRINT-A
9827
        RET                     ; return
9828
 
9829
 
9830
; -----------
9831
; Print items
9832
; -----------
9833
; This routine deals with print items as in
9834
; PRINT AT 10,0;"The value of A is ";a
9835
; It returns once a single item has been dealt with as it is part
9836
; of a tight loop that considers sequences of positional and print items
9837
 
9838
;; PR-ITEM-1
9839
L1FFC:  RST     18H             ; GET-CHAR
9840
        CP      $AC             ; is character 'AT' ?
9841
        JR      NZ,L200E        ; forward to PR-ITEM-2 if not.
9842
 
9843
        CALL    L1C79           ; routine NEXT-2NUM  check for two comma
9844
                                ; separated numbers placing them on the
9845
                                ; calculator stack in runtime.
9846
        CALL    L1FC3           ; routine UNSTACK-Z quits if checking syntax.
9847
 
9848
        CALL    L2307           ; routine STK-TO-BC get the numbers in B and C.
9849
        LD      A,$16           ; prepare the 'at' control.
9850
        JR      L201E           ; forward to PR-AT-TAB to print the sequence.
9851
 
9852
; ---
9853
 
9854
;; PR-ITEM-2
9855
L200E:  CP      $AD             ; is character 'TAB' ?
9856
        JR      NZ,L2024        ; to PR-ITEM-3 if not
9857
 
9858
 
9859
        RST     20H             ; NEXT-CHAR to address next character
9860
        CALL    L1C82           ; routine EXPT-1NUM
9861
        CALL    L1FC3           ; routine UNSTACK-Z quits if checking syntax.
9862
 
9863
        CALL    L1E99           ; routine FIND-INT2 puts integer in BC.
9864
        LD      A,$17           ; prepare the 'tab' control.
9865
 
9866
;; PR-AT-TAB
9867
L201E:  RST     10H             ; PRINT-A outputs the control
9868
 
9869
        LD      A,C             ; first value to A
9870
        RST     10H             ; PRINT-A outputs it.
9871
 
9872
        LD      A,B             ; second value
9873
        RST     10H             ; PRINT-A
9874
 
9875
        RET                     ; return - item finished >>>
9876
 
9877
; ---
9878
 
9879
; Now consider paper 2; #2; a$
9880
 
9881
;; PR-ITEM-3
9882
L2024:  CALL    L21F2           ; routine CO-TEMP-3 will print any colour
9883
        RET     NC              ; items - return if success.
9884
 
9885
        CALL    L2070           ; routine STR-ALTER considers new stream
9886
        RET     NC              ; return if altered.
9887
 
9888
        CALL    L24FB           ; routine SCANNING now to evaluate expression
9889
        CALL    L1FC3           ; routine UNSTACK-Z if not runtime.
9890
 
9891
        BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
9892
        CALL    Z,L2BF1         ; routine STK-FETCH if string.
9893
                                ; note no flags affected.
9894
        JP      NZ,L2DE3        ; to PRINT-FP to print if numeric >>>
9895
 
9896
; It was a string expression - start in DE, length in BC
9897
; Now enter a loop to print it
9898
 
9899
;; PR-STRING
9900
L203C:  LD      A,B             ; this tests if the
9901
        OR      C               ; length is zero and sets flag accordingly.
9902
        DEC     BC              ; this doesn't but decrements counter.
9903
        RET     Z               ; return if zero.
9904
 
9905
        LD      A,(DE)          ; fetch character.
9906
        INC     DE              ; address next location.
9907
 
9908
        RST     10H             ; PRINT-A.
9909
 
9910
        JR      L203C           ; loop back to PR-STRING.
9911
 
9912
; ---------------
9913
; End of printing
9914
; ---------------
9915
; This subroutine returns zero if no further printing is required
9916
; in the current statement.
9917
; The first terminator is found in  escaped input items only,
9918
; the others in print_items.
9919
 
9920
;; PR-END-Z
9921
L2045:  CP      $29             ; is character a ')' ?
9922
        RET     Z               ; return if so -        e.g. INPUT (p$); a$
9923
 
9924
;; PR-ST-END
9925
L2048:  CP      $0D             ; is it a carriage return ?
9926
        RET     Z               ; return also -         e.g. PRINT a
9927
 
9928
        CP      $3A             ; is character a ':' ?
9929
        RET                     ; return - zero flag will be set if so.
9930
                                ;                       e.g. PRINT a :
9931
 
9932
; --------------
9933
; Print position
9934
; --------------
9935
; This routine considers a single positional character ';', ',', '''
9936
 
9937
;; PR-POSN-1
9938
L204E:  RST     18H             ; GET-CHAR
9939
        CP      $3B             ; is it ';' ?
9940
                                ; i.e. print from last position.
9941
        JR      Z,L2067         ; forward to PR-POSN-3 if so.
9942
                                ; i.e. do nothing.
9943
 
9944
        CP      $2C             ; is it ',' ?
9945
                                ; i.e. print at next tabstop.
9946
        JR      NZ,L2061        ; forward to PR-POSN-2 if anything else.
9947
 
9948
        CALL    L2530           ; routine SYNTAX-Z
9949
        JR      Z,L2067         ; forward to PR-POSN-3 if checking syntax.
9950
 
9951
        LD      A,$06           ; prepare the 'comma' control character.
9952
 
9953
        RST     10H             ; PRINT-A  outputs to current channel in
9954
                                ; run-time.
9955
 
9956
        JR      L2067           ; skip to PR-POSN-3.
9957
 
9958
; ---
9959
 
9960
; check for newline.
9961
 
9962
;; PR-POSN-2
9963
L2061:  CP      $27             ; is character a "'" ? (newline)
9964
        RET     NZ              ; return if no match              >>>
9965
 
9966
        CALL    L1FF5           ; routine PRINT-CR outputs a carriage return
9967
                                ; in runtime only.
9968
 
9969
;; PR-POSN-3
9970
L2067:  RST     20H             ; NEXT-CHAR to A.
9971
        CALL    L2045           ; routine PR-END-Z checks if at end.
9972
        JR      NZ,L206E        ; to PR-POSN-4 if not.
9973
 
9974
        POP     BC              ; drop return address if at end.
9975
 
9976
;; PR-POSN-4
9977
L206E:  CP      A               ; reset the zero flag.
9978
        RET                     ; and return to loop or quit.
9979
 
9980
; ------------
9981
; Alter stream
9982
; ------------
9983
; This routine is called from PRINT ITEMS above, and also LIST as in
9984
; LIST #15
9985
 
9986
;; STR-ALTER
9987
L2070:  CP      $23             ; is character '#' ?
9988
        SCF                     ; set carry flag.
9989
        RET     NZ              ; return if no match.
9990
 
9991
 
9992
        RST      20H            ; NEXT-CHAR
9993
        CALL    L1C82           ; routine EXPT-1NUM gets stream number
9994
        AND     A               ; prepare to exit early with carry reset
9995
        CALL    L1FC3           ; routine UNSTACK-Z exits early if parsing
9996
        CALL    L1E94           ; routine FIND-INT1 gets number off stack
9997
        CP      $10             ; must be range 0 - 15 decimal.
9998
        JP      NC,L160E        ; jump back to REPORT-Oa if not
9999
                                ; 'Invalid stream'.
10000
 
10001
        CALL    L1601           ; routine CHAN-OPEN
10002
        AND     A               ; clear carry - signal item dealt with.
10003
        RET                     ; return
10004
 
10005
; -------------------
10006
; THE 'INPUT' COMMAND
10007
; -------------------
10008
; This command is mysterious.
10009
;
10010
 
10011
;; INPUT
10012
L2089:  CALL    L2530           ; routine SYNTAX-Z to check if in runtime.
10013
 
10014
        JR      Z,L2096         ; forward to INPUT-1 if checking syntax.
10015
 
10016
        LD      A,$01           ; select channel 'K' the keyboard for input.
10017
        CALL    L1601           ; routine CHAN-OPEN opens the channel and sets
10018
                                ; bit 0 of TV_FLAG.
10019
 
10020
;   Note. As a consequence of clearing the lower screen channel 0 is made
10021
;   the current channel so the above two instructions are superfluous.
10022
 
10023
        CALL    L0D6E           ; routine CLS-LOWER clears the lower screen
10024
                                ; and sets DF_SZ to two and TV_FLAG to $01.
10025
 
10026
;; INPUT-1
10027
L2096:  LD      (IY+$02),$01    ; update TV_FLAG - signal lower screen in use
10028
                                ; ensuring that the correct set of system
10029
                                ; variables are updated and that the border
10030
                                ; colour is used.
10031
 
10032
;   Note. The Complete Spectrum ROM Disassembly incorrectly names DF-SZ as the
10033
;   system variable that is updated above and if, as some have done, you make
10034
;   this unnecessary alteration then there will be two blank lines between the
10035
;   lower screen and the upper screen areas which will also scroll wrongly.
10036
 
10037
        CALL    L20C1           ; routine IN-ITEM-1 to handle the input.
10038
 
10039
        CALL    L1BEE           ; routine CHECK-END will make an early exit
10040
                                ; if checking syntax. >>>
10041
 
10042
;   Keyboard input has been made and it remains to adjust the upper
10043
;   screen in case the lower two lines have been extended upwards.
10044
 
10045
        LD      BC,($5C88)      ; fetch S_POSN current line/column of
10046
                                ; the upper screen.
10047
        LD      A,($5C6B)       ; fetch DF_SZ the display file size of
10048
                                ; the lower screen.
10049
        CP      B               ; test that lower screen does not overlap
10050
        JR      C,L20AD         ; forward to INPUT-2 if not.
10051
 
10052
; the two screens overlap so adjust upper screen.
10053
 
10054
        LD      C,$21           ; set column of upper screen to leftmost.
10055
        LD      B,A             ; and line to one above lower screen.
10056
                                ; continue forward to update upper screen
10057
                                ; print position.
10058
 
10059
;; INPUT-2
10060
L20AD:  LD      ($5C88),BC      ; set S_POSN update upper screen line/column.
10061
        LD      A,$19           ; subtract from twenty five
10062
        SUB     B               ; the new line number.
10063
        LD      ($5C8C),A       ; and place result in SCR_CT - scroll count.
10064
        RES     0,(IY+$02)      ; update TV_FLAG - signal main screen in use.
10065
 
10066
        CALL    L0DD9           ; routine CL-SET sets the print position
10067
                                ; system variables for the upper screen.
10068
 
10069
        JP      L0D6E           ; jump back to CLS-LOWER and make
10070
                                ; an indirect exit >>.
10071
 
10072
; ---------------------
10073
; INPUT ITEM subroutine
10074
; ---------------------
10075
;   This subroutine deals with the input items and print items.
10076
;   from  the current input channel.
10077
;   It is only called from the above INPUT routine but was obviously
10078
;   once called from somewhere else in another context.
10079
 
10080
;; IN-ITEM-1
10081
L20C1:  CALL    L204E           ; routine PR-POSN-1 deals with a single
10082
                                ; position item at each call.
10083
        JR      Z,L20C1         ; back to IN-ITEM-1 until no more in a
10084
                                ; sequence.
10085
 
10086
        CP      $28             ; is character '(' ?
10087
        JR      NZ,L20D8        ; forward to IN-ITEM-2 if not.
10088
 
10089
;   any variables within braces will be treated as part, or all, of the prompt
10090
;   instead of being used as destination variables.
10091
 
10092
        RST     20H             ; NEXT-CHAR
10093
        CALL    L1FDF           ; routine PRINT-2 to output the dynamic
10094
                                ; prompt.
10095
 
10096
        RST     18H             ; GET-CHAR
10097
        CP      $29             ; is character a matching ')' ?
10098
        JP      NZ,L1C8A        ; jump back to REPORT-C if not.
10099
                                ; 'Nonsense in BASIC'.
10100
 
10101
        RST     20H             ; NEXT-CHAR
10102
        JP      L21B2           ; forward to IN-NEXT-2
10103
 
10104
; ---
10105
 
10106
;; IN-ITEM-2
10107
L20D8:  CP      $CA             ; is the character the token 'LINE' ?
10108
        JR      NZ,L20ED        ; forward to IN-ITEM-3 if not.
10109
 
10110
        RST     20H             ; NEXT-CHAR - variable must come next.
10111
        CALL    L1C1F           ; routine CLASS-01 returns destination
10112
                                ; address of variable to be assigned.
10113
                                ; or generates an error if no variable
10114
                                ; at this position.
10115
 
10116
        SET     7,(IY+$37)      ; update FLAGX  - signal handling INPUT LINE
10117
        BIT     6,(IY+$01)      ; test FLAGS  - numeric or string result ?
10118
        JP      NZ,L1C8A        ; jump back to REPORT-C if not string
10119
                                ; 'Nonsense in BASIC'.
10120
 
10121
        JR      L20FA           ; forward to IN-PROMPT to set up workspace.
10122
 
10123
; ---
10124
 
10125
;   the jump was here for other variables.
10126
 
10127
;; IN-ITEM-3
10128
L20ED:  CALL     L2C8D          ; routine ALPHA checks if character is
10129
                                ; a suitable variable name.
10130
        JP      NC,L21AF        ; forward to IN-NEXT-1 if not
10131
 
10132
        CALL    L1C1F           ; routine CLASS-01 returns destination
10133
                                ; address of variable to be assigned.
10134
        RES     7,(IY+$37)      ; update FLAGX  - signal not INPUT LINE.
10135
 
10136
;; IN-PROMPT
10137
L20FA:  CALL    L2530           ; routine SYNTAX-Z
10138
        JP      Z,L21B2         ; forward to IN-NEXT-2 if checking syntax.
10139
 
10140
        CALL    L16BF           ; routine SET-WORK clears workspace.
10141
        LD      HL,$5C71        ; point to system variable FLAGX
10142
        RES     6,(HL)          ; signal string result.
10143
        SET     5,(HL)          ; signal in Input Mode for editor.
10144
        LD      BC,$0001        ; initialize space required to one for
10145
                                ; the carriage return.
10146
        BIT     7,(HL)          ; test FLAGX - INPUT LINE in use ?
10147
        JR      NZ,L211C        ; forward to IN-PR-2 if so as that is
10148
                                ; all the space that is required.
10149
 
10150
        LD      A,($5C3B)       ; load accumulator from FLAGS
10151
        AND     $40             ; mask to test BIT 6 of FLAGS and clear
10152
                                ; the other bits in A.
10153
                                ; numeric result expected ?
10154
        JR      NZ,L211A        ; forward to IN-PR-1 if so
10155
 
10156
        LD      C,$03           ; increase space to three bytes for the
10157
                                ; pair of surrounding quotes.
10158
 
10159
;; IN-PR-1
10160
L211A:  OR      (HL)            ; if numeric result, set bit 6 of FLAGX.
10161
        LD      (HL),A          ; and update system variable
10162
 
10163
;; IN-PR-2
10164
L211C:  RST     30H             ; BC-SPACES opens 1 or 3 bytes in workspace
10165
        LD      (HL),$0D        ; insert carriage return at last new location.
10166
        LD      A,C             ; fetch the length, one or three.
10167
        RRCA                    ; lose bit 0.
10168
        RRCA                    ; test if quotes required.
10169
        JR      NC,L2129        ; forward to IN-PR-3 if not.
10170
 
10171
        LD      A,$22           ; load the '"' character
10172
        LD      (DE),A          ; place quote in first new location at DE.
10173
        DEC     HL              ; decrease HL - from carriage return.
10174
        LD      (HL),A          ; and place a quote in second location.
10175
 
10176
;; IN-PR-3
10177
L2129:  LD      ($5C5B),HL      ; set keyboard cursor K_CUR to HL
10178
        BIT     7,(IY+$37)      ; test FLAGX  - is this INPUT LINE ??
10179
        JR      NZ,L215E        ; forward to IN-VAR-3 if so as input will
10180
                                ; be accepted without checking its syntax.
10181
 
10182
        LD      HL,($5C5D)      ; fetch CH_ADD
10183
        PUSH    HL              ; and save on stack.
10184
        LD      HL,($5C3D)      ; fetch ERR_SP
10185
        PUSH    HL              ; and save on stack
10186
 
10187
;; IN-VAR-1
10188
L213A:  LD      HL,L213A        ; address: IN-VAR-1 - this address
10189
        PUSH    HL              ; is saved on stack to handle errors.
10190
        BIT     4,(IY+$30)      ; test FLAGS2  - is K channel in use ?
10191
        JR      Z,L2148         ; forward to IN-VAR-2 if not using the
10192
                                ; keyboard for input. (??)
10193
 
10194
        LD      ($5C3D),SP      ; set ERR_SP to point to IN-VAR-1 on stack.
10195
 
10196
;; IN-VAR-2
10197
L2148:  LD      HL,($5C61)      ; set HL to WORKSP - start of workspace.
10198
        CALL    L11A7           ; routine REMOVE-FP removes floating point
10199
                                ; forms when looping in error condition.
10200
        LD      (IY+$00),$FF    ; set ERR_NR to 'OK' cancelling the error.
10201
                                ; but X_PTR causes flashing error marker
10202
                                ; to be displayed at each call to the editor.
10203
        CALL    L0F2C           ; routine EDITOR allows input to be entered
10204
                                ; or corrected if this is second time around.
10205
 
10206
; if we pass to next then there are no system errors
10207
 
10208
        RES     7,(IY+$01)      ; update FLAGS  - signal checking syntax
10209
        CALL    L21B9           ; routine IN-ASSIGN checks syntax using
10210
                                ; the VAL-FET-2 and powerful SCANNING routines.
10211
                                ; any syntax error and its back to IN-VAR-1.
10212
                                ; but with the flashing error marker showing
10213
                                ; where the error is.
10214
                                ; Note. the syntax of string input has to be
10215
                                ; checked as the user may have removed the
10216
                                ; bounding quotes or escaped them as with
10217
                                ; "hat" + "stand" for example.
10218
; proceed if syntax passed.
10219
 
10220
        JR      L2161           ; jump forward to IN-VAR-4
10221
 
10222
; ---
10223
 
10224
; the jump was to here when using INPUT LINE.
10225
 
10226
;; IN-VAR-3
10227
L215E:  CALL    L0F2C           ; routine EDITOR is called for input
10228
 
10229
; when ENTER received rejoin other route but with no syntax check.
10230
 
10231
; INPUT and INPUT LINE converge here.
10232
 
10233
;; IN-VAR-4
10234
L2161:  LD      (IY+$22),$00    ; set K_CUR_hi to a low value so that the cursor
10235
                                ; no longer appears in the input line.
10236
 
10237
        CALL    L21D6           ; routine IN-CHAN-K tests if the keyboard
10238
                                ; is being used for input.
10239
        JR      NZ,L2174        ; forward to IN-VAR-5 if using another input
10240
                                ; channel.
10241
 
10242
; continue here if using the keyboard.
10243
 
10244
        CALL    L111D           ; routine ED-COPY overprints the edit line
10245
                                ; to the lower screen. The only visible
10246
                                ; affect is that the cursor disappears.
10247
                                ; if you're inputting more than one item in
10248
                                ; a statement then that becomes apparent.
10249
 
10250
        LD      BC,($5C82)      ; fetch line and column from ECHO_E
10251
        CALL    L0DD9           ; routine CL-SET sets S-POSNL to those
10252
                                ; values.
10253
 
10254
; if using another input channel rejoin here.
10255
 
10256
;; IN-VAR-5
10257
L2174:  LD      HL,$5C71        ; point HL to FLAGX
10258
        RES     5,(HL)          ; signal not in input mode
10259
        BIT     7,(HL)          ; is this INPUT LINE ?
10260
        RES     7,(HL)          ; cancel the bit anyway.
10261
        JR      NZ,L219B        ; forward to IN-VAR-6 if INPUT LINE.
10262
 
10263
        POP     HL              ; drop the looping address
10264
        POP     HL              ; drop the address of previous
10265
                                ; error handler.
10266
        LD      ($5C3D),HL      ; set ERR_SP to point to it.
10267
        POP     HL              ; drop original CH_ADD which points to
10268
                                ; INPUT command in BASIC line.
10269
        LD      ($5C5F),HL      ; save in X_PTR while input is assigned.
10270
        SET     7,(IY+$01)      ; update FLAGS - Signal running program
10271
        CALL    L21B9           ; routine IN-ASSIGN is called again
10272
                                ; this time the variable will be assigned
10273
                                ; the input value without error.
10274
                                ; Note. the previous example now
10275
                                ; becomes "hatstand"
10276
 
10277
        LD      HL,($5C5F)      ; fetch stored CH_ADD value from X_PTR.
10278
        LD      (IY+$26),$00    ; set X_PTR_hi so that iy is no longer relevant.
10279
        LD      ($5C5D),HL      ; put restored value back in CH_ADD
10280
        JR      L21B2           ; forward to IN-NEXT-2 to see if anything
10281
                                ; more in the INPUT list.
10282
 
10283
; ---
10284
 
10285
; the jump was to here with INPUT LINE only
10286
 
10287
;; IN-VAR-6
10288
L219B:  LD      HL,($5C63)      ; STKBOT points to the end of the input.
10289
        LD      DE,($5C61)      ; WORKSP points to the beginning.
10290
        SCF                     ; prepare for true subtraction.
10291
        SBC     HL,DE           ; subtract to get length
10292
        LD      B,H             ; transfer it to
10293
        LD      C,L             ; the BC register pair.
10294
        CALL    L2AB2           ; routine STK-STO-$ stores parameters on
10295
                                ; the calculator stack.
10296
        CALL    L2AFF           ; routine LET assigns it to destination.
10297
        JR      L21B2           ; forward to IN-NEXT-2 as print items
10298
                                ; not allowed with INPUT LINE.
10299
                                ; Note. that "hat" + "stand" will, for
10300
                                ; example, be unchanged as also would
10301
                                ; 'PRINT "Iris was here"'.
10302
 
10303
; ---
10304
 
10305
; the jump was to here when ALPHA found more items while looking for
10306
; a variable name.
10307
 
10308
;; IN-NEXT-1
10309
L21AF:  CALL    L1FFC           ; routine PR-ITEM-1 considers further items.
10310
 
10311
;; IN-NEXT-2
10312
L21B2:  CALL    L204E           ; routine PR-POSN-1 handles a position item.
10313
        JP      Z,L20C1         ; jump back to IN-ITEM-1 if the zero flag
10314
                                ; indicates more items are present.
10315
 
10316
        RET                     ; return.
10317
 
10318
; ---------------------------
10319
; INPUT ASSIGNMENT Subroutine
10320
; ---------------------------
10321
; This subroutine is called twice from the INPUT command when normal
10322
; keyboard input is assigned. On the first occasion syntax is checked
10323
; using SCANNING. The final call with the syntax flag reset is to make
10324
; the assignment.
10325
 
10326
;; IN-ASSIGN
10327
L21B9:  LD      HL,($5C61)      ; fetch WORKSP start of input
10328
        LD      ($5C5D),HL      ; set CH_ADD to first character
10329
 
10330
        RST     18H             ; GET-CHAR ignoring leading white-space.
10331
        CP      $E2             ; is it 'STOP'
10332
        JR      Z,L21D0         ; forward to IN-STOP if so.
10333
 
10334
        LD      A,($5C71)       ; load accumulator from FLAGX
10335
        CALL    L1C59           ; routine VAL-FET-2 makes assignment
10336
                                ; or goes through the motions if checking
10337
                                ; syntax. SCANNING is used.
10338
 
10339
        RST     18H             ; GET-CHAR
10340
        CP      $0D             ; is it carriage return ?
10341
        RET     Z               ; return if so
10342
                                ; either syntax is OK
10343
                                ; or assignment has been made.
10344
 
10345
; if another character was found then raise an error.
10346
; User doesn't see report but the flashing error marker
10347
; appears in the lower screen.
10348
 
10349
;; REPORT-Cb
10350
L21CE:  RST     08H             ; ERROR-1
10351
        DEFB    $0B             ; Error Report: Nonsense in BASIC
10352
 
10353
;; IN-STOP
10354
L21D0:  CALL    L2530           ; routine SYNTAX-Z (UNSTACK-Z?)
10355
        RET     Z               ; return if checking syntax
10356
                                ; as user wouldn't see error report.
10357
                                ; but generate visible error report
10358
                                ; on second invocation.
10359
 
10360
;; REPORT-H
10361
L21D4:  RST     08H             ; ERROR-1
10362
        DEFB    $10             ; Error Report: STOP in INPUT
10363
 
10364
; -----------------------------------
10365
; THE 'TEST FOR CHANNEL K' SUBROUTINE
10366
; -----------------------------------
10367
;   This subroutine is called once from the keyboard INPUT command to check if
10368
;   the input routine in use is the one for the keyboard.
10369
 
10370
;; IN-CHAN-K
10371
L21D6:  LD      HL,($5C51)      ; fetch address of current channel CURCHL
10372
        INC     HL              ;
10373
        INC     HL              ; advance past
10374
        INC     HL              ; input and
10375
        INC     HL              ; output streams
10376
        LD      A,(HL)          ; fetch the channel identifier.
10377
        CP      $4B             ; test for 'K'
10378
        RET                     ; return with zero set if keyboard is use.
10379
 
10380
; --------------------
10381
; Colour Item Routines
10382
; --------------------
10383
;
10384
; These routines have 3 entry points -
10385
; 1) CO-TEMP-2 to handle a series of embedded Graphic colour items.
10386
; 2) CO-TEMP-3 to handle a single embedded print colour item.
10387
; 3) CO TEMP-4 to handle a colour command such as FLASH 1
10388
;
10389
; "Due to a bug, if you bring in a peripheral channel and later use a colour
10390
;  statement, colour controls will be sent to it by mistake." - Steven Vickers
10391
;  Pitman Pocket Guide, 1984.
10392
;
10393
; To be fair, this only applies if the last channel was other than 'K', 'S'
10394
; or 'P', which are all that are supported by this ROM, but if that last
10395
; channel was a microdrive file, network channel etc. then
10396
; PAPER 6; CLS will not turn the screen yellow and
10397
; CIRCLE INK 2; 128,88,50 will not draw a red circle.
10398
;
10399
; This bug does not apply to embedded PRINT items as it is quite permissible
10400
; to mix stream altering commands and colour items.
10401
; The fix therefore would be to ensure that CLASS-07 and CLASS-09 make
10402
; channel 'S' the current channel when not checking syntax.
10403
; -----------------------------------------------------------------
10404
 
10405
;; CO-TEMP-1
10406
L21E1:  RST     20H             ; NEXT-CHAR
10407
 
10408
; -> Entry point from CLASS-09. Embedded Graphic colour items.
10409
; e.g. PLOT INK 2; PAPER 8; 128,88
10410
; Loops till all colour items output, finally addressing the coordinates.
10411
 
10412
;; CO-TEMP-2
10413
L21E2:  CALL    L21F2           ; routine CO-TEMP-3 to output colour control.
10414
        RET     C               ; return if nothing more to output. ->
10415
 
10416
 
10417
        RST     18H             ; GET-CHAR
10418
        CP      $2C             ; is it ',' separator ?
10419
        JR      Z,L21E1         ; back if so to CO-TEMP-1
10420
 
10421
        CP      $3B             ; is it ';' separator ?
10422
        JR      Z,L21E1         ; back to CO-TEMP-1 for more.
10423
 
10424
        JP      L1C8A           ; to REPORT-C (REPORT-Cb is within range)
10425
                                ; 'Nonsense in BASIC'
10426
 
10427
; -------------------
10428
; CO-TEMP-3
10429
; -------------------
10430
; -> this routine evaluates and outputs a colour control and parameter.
10431
; It is called from above and also from PR-ITEM-3 to handle a single embedded
10432
; print item e.g. PRINT PAPER 6; "Hi". In the latter case, the looping for
10433
; multiple items is within the PR-ITEM routine.
10434
; It is quite permissible to send these to any stream.
10435
 
10436
;; CO-TEMP-3
10437
L21F2:  CP      $D9             ; is it 'INK' ?
10438
        RET     C               ; return if less.
10439
 
10440
        CP      $DF             ; compare with 'OUT'
10441
        CCF                     ; Complement Carry Flag
10442
        RET     C               ; return if greater than 'OVER', $DE.
10443
 
10444
        PUSH    AF              ; save the colour token.
10445
 
10446
        RST     20H             ; address NEXT-CHAR
10447
        POP     AF              ; restore token and continue.
10448
 
10449
; -> this entry point used by CLASS-07. e.g. the command PAPER 6.
10450
 
10451
;; CO-TEMP-4
10452
L21FC:  SUB     $C9             ; reduce to control character $10 (INK)
10453
                                ; thru $15 (OVER).
10454
        PUSH    AF              ; save control.
10455
        CALL    L1C82           ; routine EXPT-1NUM stacks addressed
10456
                                ; parameter on calculator stack.
10457
        POP     AF              ; restore control.
10458
        AND     A               ; clear carry
10459
 
10460
        CALL    L1FC3           ; routine UNSTACK-Z returns if checking syntax.
10461
 
10462
        PUSH    AF              ; save again
10463
        CALL    L1E94           ; routine FIND-INT1 fetches parameter to A.
10464
        LD      D,A             ; transfer now to D
10465
        POP     AF              ; restore control.
10466
 
10467
        RST     10H             ; PRINT-A outputs the control to current
10468
                                ; channel.
10469
        LD      A,D             ; transfer parameter to A.
10470
 
10471
        RST     10H             ; PRINT-A outputs parameter.
10472
        RET                     ; return. ->
10473
 
10474
; -------------------------------------------------------------------------
10475
;
10476
;         {fl}{br}{   paper   }{  ink    }    The temporary colour attributes
10477
;          ___ ___ ___ ___ ___ ___ ___ ___    system variable.
10478
; ATTR_T  |   |   |   |   |   |   |   |   |
10479
;         |   |   |   |   |   |   |   |   |
10480
; 23695   |___|___|___|___|___|___|___|___|
10481
;           7   6   5   4   3   2   1   0
10482
;
10483
;
10484
;         {fl}{br}{   paper   }{  ink    }    The temporary mask used for
10485
;          ___ ___ ___ ___ ___ ___ ___ ___    transparent colours. Any bit
10486
; MASK_T  |   |   |   |   |   |   |   |   |   that is 1 shows that the
10487
;         |   |   |   |   |   |   |   |   |   corresponding attribute is
10488
; 23696   |___|___|___|___|___|___|___|___|   taken not from ATTR-T but from
10489
;           7   6   5   4   3   2   1   0     what is already on the screen.
10490
;
10491
;
10492
;         {paper9 }{ ink9 }{ inv1 }{ over1}   The print flags. Even bits are
10493
;          ___ ___ ___ ___ ___ ___ ___ ___    temporary flags. The odd bits
10494
; P_FLAG  |   |   |   |   |   |   |   |   |   are the permanent flags.
10495
;         | p | t | p | t | p | t | p | t |
10496
; 23697   |___|___|___|___|___|___|___|___|
10497
;           7   6   5   4   3   2   1   0
10498
;
10499
; -----------------------------------------------------------------------
10500
 
10501
; ------------------------------------
10502
;  The colour system variable handler.
10503
; ------------------------------------
10504
; This is an exit branch from PO-1-OPER, PO-2-OPER
10505
; A holds control $10 (INK) to $15 (OVER)
10506
; D holds parameter 0-9 for ink/paper 0,1 or 8 for bright/flash,
10507
; 0 or 1 for over/inverse.
10508
 
10509
;; CO-TEMP-5
10510
L2211:  SUB     $11             ; reduce range $FF-$04
10511
        ADC     A,$00           ; add in carry if INK
10512
        JR      Z,L2234         ; forward to CO-TEMP-7 with INK and PAPER.
10513
 
10514
        SUB     $02             ; reduce range $FF-$02
10515
        ADC     A,$00           ; add carry if FLASH
10516
        JR      Z,L2273         ; forward to CO-TEMP-C with FLASH and BRIGHT.
10517
 
10518
        CP      $01             ; is it 'INVERSE' ?
10519
        LD      A,D             ; fetch parameter for INVERSE/OVER
10520
        LD      B,$01           ; prepare OVER mask setting bit 0.
10521
        JR      NZ,L2228        ; forward to CO-TEMP-6 if OVER
10522
 
10523
        RLCA                    ; shift bit 0
10524
        RLCA                    ; to bit 2
10525
        LD      B,$04           ; set bit 2 of mask for inverse.
10526
 
10527
;; CO-TEMP-6
10528
L2228:  LD      C,A             ; save the A
10529
        LD      A,D             ; re-fetch parameter
10530
        CP      $02             ; is it less than 2
10531
        JR      NC,L2244        ; to REPORT-K if not 0 or 1.
10532
                                ; 'Invalid colour'.
10533
 
10534
        LD      A,C             ; restore A
10535
        LD      HL,$5C91        ; address system variable P_FLAG
10536
        JR      L226C           ; forward to exit via routine CO-CHANGE
10537
 
10538
; ---
10539
 
10540
; the branch was here with INK/PAPER and carry set for INK.
10541
 
10542
;; CO-TEMP-7
10543
L2234:  LD      A,D             ; fetch parameter
10544
        LD      B,$07           ; set ink mask 00000111
10545
        JR      C,L223E         ; forward to CO-TEMP-8 with INK
10546
 
10547
        RLCA                    ; shift bits 0-2
10548
        RLCA                    ; to
10549
        RLCA                    ; bits 3-5
10550
        LD      B,$38           ; set paper mask 00111000
10551
 
10552
; both paper and ink rejoin here
10553
 
10554
;; CO-TEMP-8
10555
L223E:  LD      C,A             ; value to C
10556
        LD      A,D             ; fetch parameter
10557
        CP      $0A             ; is it less than 10d ?
10558
        JR      C,L2246         ; forward to CO-TEMP-9 if so.
10559
 
10560
; ink 10 etc. is not allowed.
10561
 
10562
;; REPORT-K
10563
L2244:  RST     08H             ; ERROR-1
10564
        DEFB    $13             ; Error Report: Invalid colour
10565
 
10566
;; CO-TEMP-9
10567
L2246:  LD      HL,$5C8F        ; address system variable ATTR_T initially.
10568
        CP      $08             ; compare with 8
10569
        JR      C,L2258         ; forward to CO-TEMP-B with 0-7.
10570
 
10571
        LD      A,(HL)          ; fetch temporary attribute as no change.
10572
        JR      Z,L2257         ; forward to CO-TEMP-A with INK/PAPER 8
10573
 
10574
; it is either ink 9 or paper 9 (contrasting)
10575
 
10576
        OR      B               ; or with mask to make white
10577
        CPL                     ; make black and change other to dark
10578
        AND     $24             ; 00100100
10579
        JR      Z,L2257         ; forward to CO-TEMP-A if black and
10580
                                ; originally light.
10581
 
10582
        LD      A,B             ; else just use the mask (white)
10583
 
10584
;; CO-TEMP-A
10585
L2257:  LD      C,A             ; save A in C
10586
 
10587
;; CO-TEMP-B
10588
L2258:  LD      A,C             ; load colour to A
10589
        CALL    L226C           ; routine CO-CHANGE addressing ATTR-T
10590
 
10591
        LD      A,$07           ; put 7 in accumulator
10592
        CP      D               ; compare with parameter
10593
        SBC     A,A             ; $00 if 0-7, $FF if 8
10594
        CALL    L226C           ; routine CO-CHANGE addressing MASK-T
10595
                                ; mask returned in A.
10596
 
10597
; now consider P-FLAG.
10598
 
10599
        RLCA                    ; 01110000 or 00001110
10600
        RLCA                    ; 11100000 or 00011100
10601
        AND     $50             ; 01000000 or 00010000  (AND 01010000)
10602
        LD      B,A             ; transfer to mask
10603
        LD      A,$08           ; load A with 8
10604
        CP      D               ; compare with parameter
10605
        SBC     A,A             ; $FF if was 9,  $00 if 0-8
10606
                                ; continue while addressing P-FLAG
10607
                                ; setting bit 4 if ink 9
10608
                                ; setting bit 6 if paper 9
10609
 
10610
; -----------------------
10611
; Handle change of colour
10612
; -----------------------
10613
; This routine addresses a system variable ATTR_T, MASK_T or P-FLAG in HL.
10614
; colour value in A, mask in B.
10615
 
10616
;; CO-CHANGE
10617
L226C:  XOR     (HL)            ; impress bits specified
10618
        AND     B               ; by mask
10619
        XOR     (HL)            ; on system variable.
10620
        LD      (HL),A          ; update system variable.
10621
        INC     HL              ; address next location.
10622
        LD      A,B             ; put current value of mask in A
10623
        RET                     ; return.
10624
 
10625
; ---
10626
 
10627
; the branch was here with flash and bright
10628
 
10629
;; CO-TEMP-C
10630
L2273:  SBC     A,A             ; set zero flag for bright.
10631
        LD      A,D             ; fetch original parameter 0,1 or 8
10632
        RRCA                    ; rotate bit 0 to bit 7
10633
        LD      B,$80           ; mask for flash 10000000
10634
        JR      NZ,L227D        ; forward to CO-TEMP-D if flash
10635
 
10636
        RRCA                    ; rotate bit 7 to bit 6
10637
        LD      B,$40           ; mask for bright 01000000
10638
 
10639
;; CO-TEMP-D
10640
L227D:  LD      C,A             ; store value in C
10641
        LD      A,D             ; fetch parameter
10642
        CP      $08             ; compare with 8
10643
        JR      Z,L2287         ; forward to CO-TEMP-E if 8
10644
 
10645
        CP      $02             ; test if 0 or 1
10646
        JR      NC,L2244        ; back to REPORT-K if not
10647
                                ; 'Invalid colour'
10648
 
10649
;; CO-TEMP-E
10650
L2287:  LD      A,C             ; value to A
10651
        LD      HL,$5C8F        ; address ATTR_T
10652
        CALL    L226C           ; routine CO-CHANGE addressing ATTR_T
10653
        LD      A,C             ; fetch value
10654
        RRCA                    ; for flash8/bright8 complete
10655
        RRCA                    ; rotations to put set bit in
10656
        RRCA                    ; bit 7 (flash) bit 6 (bright)
10657
        JR      L226C           ; back to CO-CHANGE addressing MASK_T
10658
                                ; and indirect return.
10659
 
10660
; ---------------------
10661
; Handle BORDER command
10662
; ---------------------
10663
; Command syntax example: BORDER 7
10664
; This command routine sets the border to one of the eight colours.
10665
; The colours used for the lower screen are based on this.
10666
 
10667
;; BORDER
10668
L2294:  CALL    L1E94           ; routine FIND-INT1
10669
        CP      $08             ; must be in range 0 (black) to 7 (white)
10670
        JR      NC,L2244        ; back to REPORT-K if not
10671
                                ; 'Invalid colour'.
10672
 
10673
        OUT     ($FE),A         ; outputting to port effects an immediate
10674
                                ; change.
10675
        RLCA                    ; shift the colour to
10676
        RLCA                    ; the paper bits setting the
10677
        RLCA                    ; ink colour black.
10678
        BIT     5,A             ; is the number light coloured ?
10679
                                ; i.e. in the range green to white.
10680
        JR      NZ,L22A6        ; skip to BORDER-1 if so
10681
 
10682
        XOR     $07             ; make the ink white.
10683
 
10684
;; BORDER-1
10685
L22A6:  LD      ($5C48),A       ; update BORDCR with new paper/ink
10686
        RET                     ; return.
10687
 
10688
; -----------------
10689
; Get pixel address
10690
; -----------------
10691
;
10692
;
10693
 
10694
;; PIXEL-ADD
10695
L22AA:  LD      A,$AF           ; load with 175 decimal.
10696
        SUB     B               ; subtract the y value.
10697
        JP      C,L24F9         ; jump forward to REPORT-Bc if greater.
10698
                                ; 'Integer out of range'
10699
 
10700
; the high byte is derived from Y only.
10701
; the first 3 bits are always 010
10702
; the next 2 bits denote in which third of the screen the byte is.
10703
; the last 3 bits denote in which of the 8 scan lines within a third
10704
; the byte is located. There are 24 discrete values.
10705
 
10706
 
10707
        LD      B,A             ; the line number from top of screen to B.
10708
        AND     A               ; clear carry (already clear)
10709
        RRA                     ;                     0xxxxxxx
10710
        SCF                     ; set carry flag
10711
        RRA                     ;                     10xxxxxx
10712
        AND     A               ; clear carry flag
10713
        RRA                     ;                     010xxxxx
10714
 
10715
        XOR     B               ;
10716
        AND     $F8             ; keep the top 5 bits 11111000
10717
        XOR     B               ;                     010xxbbb
10718
        LD      H,A             ; transfer high byte to H.
10719
 
10720
; the low byte is derived from both X and Y.
10721
 
10722
        LD      A,C             ; the x value 0-255.
10723
        RLCA                    ;
10724
        RLCA                    ;
10725
        RLCA                    ;
10726
        XOR     B               ; the y value
10727
        AND     $C7             ; apply mask             11000111
10728
        XOR     B               ; restore unmasked bits  xxyyyxxx
10729
        RLCA                    ; rotate to              xyyyxxxx
10730
        RLCA                    ; required position.     yyyxxxxx
10731
        LD      L,A             ; low byte to L.
10732
 
10733
; finally form the pixel position in A.
10734
 
10735
        LD      A,C             ; x value to A
10736
        AND     $07             ; mod 8
10737
        RET                     ; return
10738
 
10739
; ----------------
10740
; Point Subroutine
10741
; ----------------
10742
; The point subroutine is called from s-point via the scanning functions
10743
; table.
10744
 
10745
;; POINT-SUB
10746
L22CB:  CALL    L2307           ; routine STK-TO-BC
10747
        CALL    L22AA           ; routine PIXEL-ADD finds address of pixel.
10748
        LD      B,A             ; pixel position to B, 0-7.
10749
        INC     B               ; increment to give rotation count 1-8.
10750
        LD      A,(HL)          ; fetch byte from screen.
10751
 
10752
;; POINT-LP
10753
L22D4:  RLCA                    ; rotate and loop back
10754
        DJNZ    L22D4           ; to POINT-LP until pixel at right.
10755
 
10756
        AND      $01            ; test to give zero or one.
10757
        JP      L2D28           ; jump forward to STACK-A to save result.
10758
 
10759
; -------------------
10760
; Handle PLOT command
10761
; -------------------
10762
; Command Syntax example: PLOT 128,88
10763
;
10764
 
10765
;; PLOT
10766
L22DC:  CALL    L2307           ; routine STK-TO-BC
10767
        CALL    L22E5           ; routine PLOT-SUB
10768
        JP      L0D4D           ; to TEMPS
10769
 
10770
; -------------------
10771
; The Plot subroutine
10772
; -------------------
10773
; A screen byte holds 8 pixels so it is necessary to rotate a mask
10774
; into the correct position to leave the other 7 pixels unaffected.
10775
; However all 64 pixels in the character cell take any embedded colour
10776
; items.
10777
; A pixel can be reset (inverse 1), toggled (over 1), or set ( with inverse
10778
; and over switches off). With both switches on, the byte is simply put
10779
; back on the screen though the colours may change.
10780
 
10781
;; PLOT-SUB
10782
L22E5:  LD      ($5C7D),BC      ; store new x/y values in COORDS
10783
        CALL    L22AA           ; routine PIXEL-ADD gets address in HL,
10784
                                ; count from left 0-7 in B.
10785
        LD      B,A             ; transfer count to B.
10786
        INC     B               ; increase 1-8.
10787
        LD      A,$FE           ; 11111110 in A.
10788
 
10789
;; PLOT-LOOP
10790
L22F0:  RRCA                    ; rotate mask.
10791
        DJNZ    L22F0           ; to PLOT-LOOP until B circular rotations.
10792
 
10793
        LD      B,A             ; load mask to B
10794
        LD      A,(HL)          ; fetch screen byte to A
10795
 
10796
        LD      C,(IY+$57)      ; P_FLAG to C
10797
        BIT     0,C             ; is it to be OVER 1 ?
10798
        JR      NZ,L22FD        ; forward to PL-TST-IN if so.
10799
 
10800
; was over 0
10801
 
10802
        AND     B               ; combine with mask to blank pixel.
10803
 
10804
;; PL-TST-IN
10805
L22FD:  BIT     2,C             ; is it inverse 1 ?
10806
        JR      NZ,L2303        ; to PLOT-END if so.
10807
 
10808
        XOR     B               ; switch the pixel
10809
        CPL                     ; restore other 7 bits
10810
 
10811
;; PLOT-END
10812
L2303:  LD      (HL),A          ; load byte to the screen.
10813
        JP      L0BDB           ; exit to PO-ATTR to set colours for cell.
10814
 
10815
; ------------------------------
10816
; Put two numbers in BC register
10817
; ------------------------------
10818
;
10819
;
10820
 
10821
;; STK-TO-BC
10822
L2307:  CALL    L2314           ; routine STK-TO-A
10823
        LD      B,A             ;
10824
        PUSH    BC              ;
10825
        CALL    L2314           ; routine STK-TO-A
10826
        LD      E,C             ;
10827
        POP     BC              ;
10828
        LD      D,C             ;
10829
        LD      C,A             ;
10830
        RET                     ;
10831
 
10832
; -----------------------
10833
; Put stack in A register
10834
; -----------------------
10835
; This routine puts the last value on the calculator stack into the accumulator
10836
; deleting the last value.
10837
 
10838
;; STK-TO-A
10839
L2314:  CALL    L2DD5           ; routine FP-TO-A compresses last value into
10840
                                ; accumulator. e.g. PI would become 3.
10841
                                ; zero flag set if positive.
10842
        JP      C,L24F9         ; jump forward to REPORT-Bc if >= 255.5.
10843
 
10844
        LD      C,$01           ; prepare a positive sign byte.
10845
        RET     Z               ; return if FP-TO-BC indicated positive.
10846
 
10847
        LD      C,$FF           ; prepare negative sign byte and
10848
        RET                     ; return.
10849
 
10850
 
10851
; --------------------
10852
; THE 'CIRCLE' COMMAND
10853
; --------------------
10854
;   "Goe not Thou about to Square eyther circle" -
10855
;   - John Donne, Cambridge educated theologian, 1624
10856
;
10857
;   The CIRCLE command draws a circle as a series of straight lines.
10858
;   In some ways it can be regarded as a polygon, but the first line is drawn
10859
;   as a tangent, taking the radius as its distance from the centre.
10860
;
10861
;   Both the CIRCLE algorithm and the ARC drawing algorithm make use of the
10862
;   'ROTATION FORMULA' (see later).  It is only necessary to work out where
10863
;   the first line will be drawn and how long it is and then the rotation
10864
;   formula takes over and calculates all other rotated points.
10865
;
10866
;   All Spectrum circles consist of two vertical lines at each side and two
10867
;   horizontal lines at the top and bottom. The number of lines is calculated
10868
;   from the radius of the circle and is always divisible by 4. For complete
10869
;   circles it will range from 4 for a square circle to 32 for a circle of
10870
;   radius 87. The Spectrum can attempt larger circles e.g. CIRCLE 0,14,255
10871
;   but these will error as they go off-screen after four lines are drawn.
10872
;   At the opposite end, CIRCLE 128,88,1.23 will draw a circle as a perfect 3x3
10873
;   square using 4 straight lines although very small circles are just drawn as
10874
;   a dot on the screen.
10875
;
10876
;   The first chord drawn is the vertical chord on the right of the circle.
10877
;   The starting point is at the base of this chord which is drawn upwards and
10878
;   the circle continues in an anti-clockwise direction. As noted earlier the
10879
;   x-coordinate of this point measured from the centre of the circle is the
10880
;   radius.
10881
;
10882
;   The CIRCLE command makes extensive use of the calculator and as part of
10883
;   process of drawing a large circle, free memory is checked 1315 times.
10884
;   When drawing a large arc, free memory is checked 928 times.
10885
;   A single call to 'sin' involves 63 memory checks and so values of sine
10886
;   and cosine are pre-calculated and held in the mem locations. As a
10887
;   clever trick 'cos' is derived from 'sin' using simple arithmetic operations
10888
;   instead of the more expensive 'cos' function.
10889
;
10890
;   Initially, the syntax has been partly checked using the class for the DRAW
10891
;   command which stacks the origin of the circle (X,Y).
10892
 
10893
;; CIRCLE
10894
L2320:  RST     18H             ; GET-CHAR              x, y.
10895
        CP      $2C             ; Is character the required comma ?
10896
        JP      NZ,L1C8A        ; Jump, if not, to REPORT-C
10897
                                ; 'Nonsense in basic'
10898
 
10899
        RST     20H             ; NEXT-CHAR advances the parsed character address.
10900
        CALL    L1C82           ; routine EXPT-1NUM stacks radius in runtime.
10901
        CALL    L1BEE           ; routine CHECK-END will return here in runtime
10902
                                ; if nothing follows the command.
10903
 
10904
;   Now make the radius positive and ensure that it is in floating point form
10905
;   so that the exponent byte can be accessed for quick testing.
10906
 
10907
        RST     28H             ;; FP-CALC              x, y, r.
10908
        DEFB    $2A             ;;abs                   x, y, r.
10909
        DEFB    $3D             ;;re-stack              x, y, r.
10910
        DEFB    $38             ;;end-calc              x, y, r.
10911
 
10912
        LD      A,(HL)          ; Fetch first, floating-point, exponent byte.
10913
        CP      $81             ; Compare to one.
10914
        JR      NC,L233B        ; Forward to C-R-GRE-1
10915
                                ; if circle radius is greater than one.
10916
 
10917
;    The circle is no larger than a single pixel so delete the radius from the
10918
;    calculator stack and plot a point at the centre.
10919
 
10920
        RST     28H             ;; FP-CALC              x, y, r.
10921
        DEFB    $02             ;;delete                x, y.
10922
        DEFB    $38             ;;end-calc              x, y.
10923
 
10924
        JR      L22DC           ; back to PLOT routine to just plot x,y.
10925
 
10926
; ---
10927
 
10928
;   Continue when the circle's radius measures greater than one by forming
10929
;   the angle 2 * PI radians which is 360 degrees.
10930
 
10931
;; C-R-GRE-1
10932
L233B:  RST     28H             ;; FP-CALC      x, y, r
10933
        DEFB    $A3             ;;stk-pi/2      x, y, r, pi/2.
10934
        DEFB    $38             ;;end-calc      x, y, r, pi/2.
10935
 
10936
;   Change the exponent of pi/2 from $81 to $83 giving 2*PI the central angle.
10937
;   This is quicker than multiplying by four.
10938
 
10939
        LD      (HL),$83        ;               x, y, r, 2*PI.
10940
 
10941
;   Now store this important constant in mem-5 and delete so that other
10942
;   parameters can be derived from it, by a routine shared with DRAW.
10943
 
10944
        RST     28H             ;; FP-CALC      x, y, r, 2*PI.
10945
        DEFB    $C5             ;;st-mem-5      store 2*PI in mem-5
10946
        DEFB    $02             ;;delete        x, y, r.
10947
        DEFB    $38             ;;end-calc      x, y, r.
10948
 
10949
;   The parameters derived from mem-5 (A) and from the radius are set up in
10950
;   four of the other mem locations by the CIRCLE DRAW PARAMETERS routine which
10951
;   also returns the number of straight lines in the B register.
10952
 
10953
        CALL    L247D           ; routine CD-PRMS1
10954
 
10955
                                ; mem-0 ; A/No of lines (=a)            unused
10956
                                ; mem-1 ; sin(a/2)  will be moving x    var
10957
                                ; mem-2 ; -         will be moving y    var
10958
                                ; mem-3 ; cos(a)                        const
10959
                                ; mem-4 ; sin(a)                        const
10960
                                ; mem-5 ; Angle of rotation (A) (2*PI)  const
10961
                                ; B     ; Number of straight lines.
10962
 
10963
        PUSH    BC              ; Preserve the number of lines in B.
10964
 
10965
;   Next calculate the length of half a chord by multiplying the sine of half
10966
;   the central angle by the radius of the circle.
10967
 
10968
        RST     28H             ;; FP-CALC      x, y, r.
10969
        DEFB    $31             ;;duplicate     x, y, r, r.
10970
        DEFB    $E1             ;;get-mem-1     x, y, r, r, sin(a/2).
10971
        DEFB    $04             ;;multiply      x, y, r, half-chord.
10972
        DEFB    $38             ;;end-calc      x, y, r, half-chord.
10973
 
10974
        LD      A,(HL)          ; fetch exponent  of the half arc to A.
10975
        CP      $80             ; compare to a half pixel
10976
        JR      NC,L235A        ; forward, if greater than .5, to C-ARC-GE1
10977
 
10978
;   If the first line is less than .5 then 4 'lines' would be drawn on the same
10979
;   spot so tidy the calculator stack and machine stack and plot the centre.
10980
 
10981
        RST     28H             ;; FP-CALC      x, y, r, hc.
10982
        DEFB    $02             ;;delete        x, y, r.
10983
        DEFB    $02             ;;delete        x, y.
10984
        DEFB    $38             ;;end-calc      x, y.
10985
 
10986
        POP     BC              ; Balance machine stack by taking chord-count.
10987
 
10988
        JP      L22DC           ; JUMP to PLOT
10989
 
10990
; ---
10991
 
10992
;   The arc is greater than 0.5 so the circle can be drawn.
10993
 
10994
;; C-ARC-GE1
10995
L235A:  RST     28H             ;; FP-CALC      x, y, r, hc.
10996
        DEFB    $C2             ;;st-mem-2      x, y, r, half chord to mem-2.
10997
        DEFB    $01             ;;exchange      x, y, hc, r.
10998
        DEFB    $C0             ;;st-mem-0      x, y, hc, r.
10999
        DEFB    $02             ;;delete        x, y, hc.
11000
 
11001
;   Subtract the length of the half-chord from the absolute y coordinate to
11002
;   give the starting y coordinate sy.
11003
;   Note that for a circle this is also the end coordinate.
11004
 
11005
        DEFB    $03             ;;subtract      x, y-hc.  (The start y-coord)
11006
        DEFB    $01             ;;exchange      sy, x.
11007
 
11008
;   Next simply add the radius to the x coordinate to give a fuzzy x-coordinate.
11009
;   Strictly speaking, the radius should be multiplied by cos(a/2) first but
11010
;   doing it this way makes the circle slightly larger.
11011
 
11012
        DEFB    $E0             ;;get-mem-0     sy, x, r.
11013
        DEFB    $0F             ;;addition      sy, x+r.  (The start x-coord)
11014
 
11015
;   We now want three copies of this pair of values on the calculator stack.
11016
;   The first pair remain on the stack throughout the circle routine and are
11017
;   the end points. The next pair will be the moving absolute values of x and y
11018
;   that are updated after each line is drawn. The final pair will be loaded
11019
;   into the COORDS system variable so that the first vertical line starts at
11020
;   the right place.
11021
 
11022
        DEFB    $C0             ;;st-mem-0      sy, sx.
11023
        DEFB    $01             ;;exchange      sx, sy.
11024
        DEFB    $31             ;;duplicate     sx, sy, sy.
11025
        DEFB    $E0             ;;get-mem-0     sx, sy, sy, sx.
11026
        DEFB    $01             ;;exchange      sx, sy, sx, sy.
11027
        DEFB    $31             ;;duplicate     sx, sy, sx, sy, sy.
11028
        DEFB    $E0             ;;get-mem-0     sx, sy, sx, sy, sy, sx.
11029
 
11030
;   Locations mem-1 and mem-2 are the relative x and y values which are updated
11031
;   after each line is drawn. Since we are drawing a vertical line then the rx
11032
;   value in mem-1 is zero and the ry value in mem-2 is the full chord.
11033
 
11034
        DEFB    $A0             ;;stk-zero      sx, sy, sx, sy, sy, sx, 0.
11035
        DEFB    $C1             ;;st-mem-1      sx, sy, sx, sy, sy, sx, 0.
11036
        DEFB    $02             ;;delete        sx, sy, sx, sy, sy, sx.
11037
 
11038
;   Although the three pairs of x/y values are the same for a circle, they
11039
;   will be labelled terminating, absolute and start coordinates.
11040
 
11041
        DEFB    $38             ;;end-calc      tx, ty, ax, ay, sy, sx.
11042
 
11043
;   Use the exponent manipulating trick again to double the value of mem-2.
11044
 
11045
        INC     (IY+$62)        ; Increment MEM-2-1st doubling half chord.
11046
 
11047
;   Note. this first vertical chord is drawn at the radius so circles are
11048
;   slightly displaced to the right.
11049
;   It is only necessary to place the values (sx) and (sy) in the system
11050
;   variable COORDS to ensure that drawing commences at the correct pixel.
11051
;   Note. a couple of LD (COORDS),A instructions would have been quicker, and
11052
;   simpler, than using LD (COORDS),HL.
11053
 
11054
        CALL    L1E94           ; routine FIND-INT1 fetches sx from stack to A.
11055
 
11056
        LD      L,A             ; place X value in L.
11057
        PUSH    HL              ; save the holding register.
11058
 
11059
        CALL    L1E94           ; routine FIND-INT1 fetches sy to A
11060
 
11061
        POP     HL              ; restore the holding register.
11062
        LD      H,A             ; and place y value in high byte.
11063
 
11064
        LD      ($5C7D),HL      ; Update the COORDS system variable.
11065
                                ;
11066
                                ;               tx, ty, ax, ay.
11067
 
11068
        POP     BC              ; restore the chord count
11069
                                ; values 4,8,12,16,20,24,28 or 32.
11070
 
11071
        JP      L2420           ; forward to DRW-STEPS
11072
                                ;               tx, ty, ax, ay.
11073
 
11074
;   Note. the jump to DRW-STEPS is just to decrement B and jump into the
11075
;   middle of the arc-drawing loop. The arc count which includes the first
11076
;   vertical arc draws one less than the perceived number of arcs.
11077
;   The final arc offsets are obtained by subtracting the final COORDS value
11078
;   from the initial sx and sy values which are kept at the base of the
11079
;   calculator stack throughout the arc loop.
11080
;   This ensures that the final line finishes exactly at the starting pixel
11081
;   removing the possibility of any inaccuracy.
11082
;   Since the initial sx and sy values are not required until the final arc
11083
;   is drawn, they are not shown until then.
11084
;   As the calculator stack is quite busy, only the active parts are shown in
11085
;   each section.
11086
 
11087
 
11088
; ------------------
11089
; THE 'DRAW' COMMAND
11090
; ------------------
11091
;   The Spectrum's DRAW command is overloaded and can take two parameters sets.
11092
;
11093
;   With two parameters, it simply draws an approximation to a straight line
11094
;   at offset x,y using the LINE-DRAW routine.
11095
;
11096
;   With three parameters, an arc is drawn to the point at offset x,y turning
11097
;   through an angle, in radians, supplied by the third parameter.
11098
;   The arc will consist of 4 to 252 straight lines each one of which is drawn
11099
;   by calls to the DRAW-LINE routine.
11100
 
11101
;; DRAW
11102
L2382:  RST     18H             ; GET-CHAR
11103
        CP      $2C             ; is it the comma character ?
11104
        JR      Z,L238D         ; forward, if so, to DR-3-PRMS
11105
 
11106
;   There are two parameters e.g. DRAW 255,175
11107
 
11108
        CALL    L1BEE           ; routine CHECK-END
11109
 
11110
        JP      L2477           ; jump forward to LINE-DRAW
11111
 
11112
; ---
11113
 
11114
;    There are three parameters e.g. DRAW 255, 175, .5
11115
;    The first two are relative coordinates and the third is the angle of
11116
;    rotation in radians (A).
11117
 
11118
;; DR-3-PRMS
11119
L238D:  RST     20H             ; NEXT-CHAR skips over the 'comma'.
11120
 
11121
        CALL    L1C82           ; routine EXPT-1NUM stacks the rotation angle.
11122
 
11123
        CALL    L1BEE           ; routine CHECK-END
11124
 
11125
;   Now enter the calculator and store the complete rotation angle in mem-5
11126
 
11127
        RST     28H             ;; FP-CALC      x, y, A.
11128
        DEFB    $C5             ;;st-mem-5      x, y, A.
11129
 
11130
;   Test the angle for the special case of 360 degrees.
11131
 
11132
        DEFB    $A2             ;;stk-half      x, y, A, 1/2.
11133
        DEFB    $04             ;;multiply      x, y, A/2.
11134
        DEFB    $1F             ;;sin           x, y, sin(A/2).
11135
        DEFB    $31             ;;duplicate     x, y, sin(A/2),sin(A/2)
11136
        DEFB    $30             ;;not           x, y, sin(A/2), (0/1).
11137
        DEFB    $30             ;;not           x, y, sin(A/2), (1/0).
11138
        DEFB    $00             ;;jump-true     x, y, sin(A/2).
11139
 
11140
        DEFB    $06             ;;forward to L23A3, DR-SIN-NZ
11141
                                ; if sin(r/2) is not zero.
11142
 
11143
;   The third parameter is 2*PI (or a multiple of 2*PI) so a 360 degrees turn
11144
;   would just be a straight line.  Eliminating this case here prevents
11145
;   division by zero at later stage.
11146
 
11147
        DEFB    $02             ;;delete        x, y.
11148
        DEFB    $38             ;;end-calc      x, y.
11149
 
11150
        JP      L2477           ; forward to LINE-DRAW
11151
 
11152
; ---
11153
 
11154
;   An arc can be drawn.
11155
 
11156
;; DR-SIN-NZ
11157
L23A3:  DEFB    $C0             ;;st-mem-0      x, y, sin(A/2).   store mem-0
11158
        DEFB    $02             ;;delete        x, y.
11159
 
11160
;   The next step calculates (roughly) the diameter of the circle of which the
11161
;   arc will form part.  This value does not have to be too accurate as it is
11162
;   only used to evaluate the number of straight lines and then discarded.
11163
;   After all for a circle, the radius is used. Consequently, a circle of
11164
;   radius 50 will have 24 straight lines but an arc of radius 50 will have 20
11165
;   straight lines - when drawn in any direction.
11166
;   So that simple arithmetic can be used, the length of the chord can be
11167
;   calculated as X+Y rather than by Pythagoras Theorem and the sine of the
11168
;   nearest angle within reach is used.
11169
 
11170
        DEFB    $C1             ;;st-mem-1      x, y.             store mem-1
11171
        DEFB    $02             ;;delete        x.
11172
 
11173
        DEFB    $31             ;;duplicate     x, x.
11174
        DEFB    $2A             ;;abs           x, x (+ve).
11175
        DEFB    $E1             ;;get-mem-1     x, X, y.
11176
        DEFB    $01             ;;exchange      x, y, X.
11177
        DEFB    $E1             ;;get-mem-1     x, y, X, y.
11178
        DEFB    $2A             ;;abs           x, y, X, Y (+ve).
11179
        DEFB    $0F             ;;addition      x, y, X+Y.
11180
        DEFB    $E0             ;;get-mem-0     x, y, X+Y, sin(A/2).
11181
        DEFB    $05             ;;division      x, y, X+Y/sin(A/2).
11182
        DEFB    $2A             ;;abs           x, y, X+Y/sin(A/2) = D.
11183
 
11184
;    Bring back sin(A/2) from mem-0 which will shortly get trashed.
11185
;    Then bring D to the top of the stack again.
11186
 
11187
        DEFB    $E0             ;;get-mem-0     x, y, D, sin(A/2).
11188
        DEFB    $01             ;;exchange      x, y, sin(A/2), D.
11189
 
11190
;   Note. that since the value at the top of the stack has arisen as a result
11191
;   of division then it can no longer be in integer form and the next re-stack
11192
;   is unnecessary. Only the Sinclair ZX80 had integer division.
11193
 
11194
        DEFB    $3D             ;;re-stack      (unnecessary)
11195
 
11196
        DEFB    $38             ;;end-calc      x, y, sin(A/2), D.
11197
 
11198
;   The next test avoids drawing 4 straight lines when the start and end pixels
11199
;   are adjacent (or the same) but is probably best dispensed with.
11200
 
11201
        LD      A,(HL)          ; fetch exponent byte of D.
11202
        CP      $81             ; compare to 1
11203
        JR      NC,L23C1        ; forward, if > 1,  to DR-PRMS
11204
 
11205
;   else delete the top two stack values and draw a simple straight line.
11206
 
11207
        RST     28H             ;; FP-CALC
11208
        DEFB    $02             ;;delete
11209
        DEFB    $02             ;;delete
11210
        DEFB    $38             ;;end-calc      x, y.
11211
 
11212
        JP      L2477           ; to LINE-DRAW
11213
 
11214
; ---
11215
 
11216
;   The ARC will consist of multiple straight lines so call the CIRCLE-DRAW
11217
;   PARAMETERS ROUTINE to pre-calculate sine values from the angle (in mem-5)
11218
;   and determine also the number of straight lines from that value and the
11219
;   'diameter' which is at the top of the calculator stack.
11220
 
11221
;; DR-PRMS
11222
L23C1:  CALL    L247D           ; routine CD-PRMS1
11223
 
11224
                                ; mem-0 ; (A)/No. of lines (=a) (step angle)
11225
                                ; mem-1 ; sin(a/2)
11226
                                ; mem-2 ; -
11227
                                ; mem-3 ; cos(a)                        const
11228
                                ; mem-4 ; sin(a)                        const
11229
                                ; mem-5 ; Angle of rotation (A)         in
11230
                                ; B     ; Count of straight lines - max 252.
11231
 
11232
        PUSH    BC              ; Save the line count on the machine stack.
11233
 
11234
;   Remove the now redundant diameter value D.
11235
 
11236
        RST     28H             ;; FP-CALC      x, y, sin(A/2), D.
11237
        DEFB    $02             ;;delete        x, y, sin(A/2).
11238
 
11239
;   Dividing the sine of the step angle by the sine of the total angle gives
11240
;   the length of the initial chord on a unary circle. This factor f is used
11241
;   to scale the coordinates of the first line which still points in the
11242
;   direction of the end point and may be larger.
11243
 
11244
        DEFB    $E1             ;;get-mem-1     x, y, sin(A/2), sin(a/2)
11245
        DEFB    $01             ;;exchange      x, y, sin(a/2), sin(A/2)
11246
        DEFB    $05             ;;division      x, y, sin(a/2)/sin(A/2)
11247
        DEFB    $C1             ;;st-mem-1      x, y. f.
11248
        DEFB    $02             ;;delete        x, y.
11249
 
11250
;   With the factor stored, scale the x coordinate first.
11251
 
11252
        DEFB    $01             ;;exchange      y, x.
11253
        DEFB    $31             ;;duplicate     y, x, x.
11254
        DEFB    $E1             ;;get-mem-1     y, x, x, f.
11255
        DEFB    $04             ;;multiply      y, x, x*f    (=xx)
11256
        DEFB    $C2             ;;st-mem-2      y, x, xx.
11257
        DEFB    $02             ;;delete        y. x.
11258
 
11259
;   Now scale the y coordinate.
11260
 
11261
        DEFB    $01             ;;exchange      x, y.
11262
        DEFB    $31             ;;duplicate     x, y, y.
11263
        DEFB    $E1             ;;get-mem-1     x, y, y, f
11264
        DEFB    $04             ;;multiply      x, y, y*f    (=yy)
11265
 
11266
;   Note. 'sin' and 'cos' trash locations mem-0 to mem-2 so fetch mem-2 to the
11267
;   calculator stack for safe keeping.
11268
 
11269
        DEFB    $E2             ;;get-mem-2     x, y, yy, xx.
11270
 
11271
;   Once we get the coordinates of the first straight line then the 'ROTATION
11272
;   FORMULA' used in the arc loop will take care of all other points, but we
11273
;   now use a variation of that formula to rotate the first arc through (A-a)/2
11274
;   radians.
11275
;
11276
;       xRotated = y * sin(angle) + x * cos(angle)
11277
;       yRotated = y * cos(angle) - x * sin(angle)
11278
;
11279
 
11280
        DEFB    $E5             ;;get-mem-5     x, y, yy, xx, A.
11281
        DEFB    $E0             ;;get-mem-0     x, y, yy, xx, A, a.
11282
        DEFB    $03             ;;subtract      x, y, yy, xx, A-a.
11283
        DEFB    $A2             ;;stk-half      x, y, yy, xx, A-a, 1/2.
11284
        DEFB    $04             ;;multiply      x, y, yy, xx, (A-a)/2. (=angle)
11285
        DEFB    $31             ;;duplicate     x, y, yy, xx, angle, angle.
11286
        DEFB    $1F             ;;sin           x, y, yy, xx, angle, sin(angle)
11287
        DEFB    $C5             ;;st-mem-5      x, y, yy, xx, angle, sin(angle)
11288
        DEFB    $02             ;;delete        x, y, yy, xx, angle
11289
 
11290
        DEFB    $20             ;;cos           x, y, yy, xx, cos(angle).
11291
 
11292
;   Note. mem-0, mem-1 and mem-2 can be used again now...
11293
 
11294
        DEFB    $C0             ;;st-mem-0      x, y, yy, xx, cos(angle).
11295
        DEFB    $02             ;;delete        x, y, yy, xx.
11296
 
11297
        DEFB    $C2             ;;st-mem-2      x, y, yy, xx.
11298
        DEFB    $02             ;;delete        x, y, yy.
11299
 
11300
        DEFB    $C1             ;;st-mem-1      x, y, yy.
11301
        DEFB    $E5             ;;get-mem-5     x, y, yy, sin(angle)
11302
        DEFB    $04             ;;multiply      x, y, yy*sin(angle).
11303
        DEFB    $E0             ;;get-mem-0     x, y, yy*sin(angle), cos(angle)
11304
        DEFB    $E2             ;;get-mem-2     x, y, yy*sin(angle), cos(angle), xx.
11305
        DEFB    $04             ;;multiply      x, y, yy*sin(angle), xx*cos(angle).
11306
        DEFB    $0F             ;;addition      x, y, xRotated.
11307
        DEFB    $E1             ;;get-mem-1     x, y, xRotated, yy.
11308
        DEFB    $01             ;;exchange      x, y, yy, xRotated.
11309
        DEFB    $C1             ;;st-mem-1      x, y, yy, xRotated.
11310
        DEFB    $02             ;;delete        x, y, yy.
11311
 
11312
        DEFB    $E0             ;;get-mem-0     x, y, yy, cos(angle).
11313
        DEFB    $04             ;;multiply      x, y, yy*cos(angle).
11314
        DEFB    $E2             ;;get-mem-2     x, y, yy*cos(angle), xx.
11315
        DEFB    $E5             ;;get-mem-5     x, y, yy*cos(angle), xx, sin(angle).
11316
        DEFB    $04             ;;multiply      x, y, yy*cos(angle), xx*sin(angle).
11317
        DEFB    $03             ;;subtract      x, y, yRotated.
11318
        DEFB    $C2             ;;st-mem-2      x, y, yRotated.
11319
 
11320
;   Now the initial x and y coordinates are made positive and summed to see
11321
;   if they measure up to anything significant.
11322
 
11323
        DEFB    $2A             ;;abs           x, y, yRotated'.
11324
        DEFB    $E1             ;;get-mem-1     x, y, yRotated', xRotated.
11325
        DEFB    $2A             ;;abs           x, y, yRotated', xRotated'.
11326
        DEFB    $0F             ;;addition      x, y, yRotated+xRotated.
11327
        DEFB    $02             ;;delete        x, y.
11328
 
11329
        DEFB    $38             ;;end-calc      x, y.
11330
 
11331
;   Although the test value has been deleted it is still above the calculator
11332
;   stack in memory and conveniently DE which points to the first free byte
11333
;   addresses the exponent of the test value.
11334
 
11335
        LD      A,(DE)          ; Fetch exponent of the length indicator.
11336
        CP      $81             ; Compare to that for 1
11337
 
11338
        POP     BC              ; Balance the machine stack
11339
 
11340
        JP      C,L2477         ; forward, if the coordinates of first line
11341
                                ; don't add up to more than 1, to LINE-DRAW
11342
 
11343
;   Continue when the arc will have a discernable shape.
11344
 
11345
        PUSH    BC              ; Restore line counter to the machine stack.
11346
 
11347
;   The parameters of the DRAW command were relative and they are now converted
11348
;   to absolute coordinates by adding to the coordinates of the last point
11349
;   plotted. The first two values on the stack are the terminal tx and ty
11350
;   coordinates.  The x-coordinate is converted first but first the last point
11351
;   plotted is saved as it will initialize the moving ax, value.
11352
 
11353
        RST     28H             ;; FP-CALC      x, y.
11354
        DEFB    $01             ;;exchange      y, x.
11355
        DEFB    $38             ;;end-calc      y, x.
11356
 
11357
        LD      A,($5C7D)       ; Fetch System Variable COORDS-x
11358
        CALL    L2D28           ; routine STACK-A
11359
 
11360
        RST     28H             ;; FP-CALC      y, x, last-x.
11361
 
11362
;   Store the last point plotted to initialize the moving ax value.
11363
 
11364
        DEFB    $C0             ;;st-mem-0      y, x, last-x.
11365
        DEFB    $0F             ;;addition      y, absolute x.
11366
        DEFB    $01             ;;exchange      tx, y.
11367
        DEFB    $38             ;;end-calc      tx, y.
11368
 
11369
        LD      A,($5C7E)       ; Fetch System Variable COORDS-y
11370
        CALL    L2D28           ; routine STACK-A
11371
 
11372
        RST     28H             ;; FP-CALC      tx, y, last-y.
11373
 
11374
;   Store the last point plotted to initialize the moving ay value.
11375
 
11376
        DEFB    $C5             ;;st-mem-5      tx, y, last-y.
11377
        DEFB    $0F             ;;addition      tx, ty.
11378
 
11379
;   Fetch the moving ax and ay to the calculator stack.
11380
 
11381
        DEFB    $E0             ;;get-mem-0     tx, ty, ax.
11382
        DEFB    $E5             ;;get-mem-5     tx, ty, ax, ay.
11383
        DEFB    $38             ;;end-calc      tx, ty, ax, ay.
11384
 
11385
        POP     BC              ; Restore the straight line count.
11386
 
11387
; -----------------------------------
11388
; THE 'CIRCLE/DRAW CONVERGENCE POINT'
11389
; -----------------------------------
11390
;   The CIRCLE and ARC-DRAW commands converge here.
11391
;
11392
;   Note. for both the CIRCLE and ARC commands the minimum initial line count
11393
;   is 4 (as set up by the CD_PARAMS routine) and so the zero flag will never
11394
;   be set and the loop is always entered.  The first test is superfluous and
11395
;   the jump will always be made to ARC-START.
11396
 
11397
;; DRW-STEPS
11398
L2420:  DEC     B               ; decrement the arc count (4,8,12,16...).
11399
 
11400
        JR      Z,L245F         ; forward, if zero (not possible), to ARC-END
11401
 
11402
        JR      L2439           ; forward to ARC-START
11403
 
11404
; --------------
11405
; THE 'ARC LOOP'
11406
; --------------
11407
;
11408
;   The arc drawing loop will draw up to 31 straight lines for a circle and up
11409
;   251 straight lines for an arc between two points. In both cases the final
11410
;   closing straight line is drawn at ARC_END, but it otherwise loops back to
11411
;   here to calculate the next coordinate using the ROTATION FORMULA where (a)
11412
;   is the previously calculated, constant CENTRAL ANGLE of the arcs.
11413
;
11414
;       Xrotated = x * cos(a) - y * sin(a)
11415
;       Yrotated = x * sin(a) + y * cos(a)
11416
;
11417
;   The values cos(a) and sin(a) are pre-calculated and held in mem-3 and mem-4
11418
;   for the duration of the routine.
11419
;   Memory location mem-1 holds the last relative x value (rx) and mem-2 holds
11420
;   the last relative y value (ry) used by DRAW.
11421
;
11422
;   Note. that this is a very clever twist on what is after all a very clever,
11423
;   well-used formula.  Normally the rotation formula is used with the x and y
11424
;   coordinates from the centre of the circle (or arc) and a supplied angle to
11425
;   produce two new x and y coordinates in an anticlockwise direction on the
11426
;   circumference of the circle.
11427
;   What is being used here, instead, is the relative X and Y parameters from
11428
;   the last point plotted that are required to get to the current point and
11429
;   the formula returns the next relative coordinates to use.
11430
 
11431
;; ARC-LOOP
11432
L2425:  RST     28H             ;; FP-CALC
11433
        DEFB    $E1             ;;get-mem-1     rx.
11434
        DEFB    $31             ;;duplicate     rx, rx.
11435
        DEFB    $E3             ;;get-mem-3     cos(a)
11436
        DEFB    $04             ;;multiply      rx, rx*cos(a).
11437
        DEFB    $E2             ;;get-mem-2     rx, rx*cos(a), ry.
11438
        DEFB    $E4             ;;get-mem-4     rx, rx*cos(a), ry, sin(a).
11439
        DEFB    $04             ;;multiply      rx, rx*cos(a), ry*sin(a).
11440
        DEFB    $03             ;;subtract      rx, rx*cos(a) - ry*sin(a)
11441
        DEFB    $C1             ;;st-mem-1      rx, new relative x rotated.
11442
        DEFB    $02             ;;delete        rx.
11443
 
11444
        DEFB    $E4             ;;get-mem-4     rx, sin(a).
11445
        DEFB    $04             ;;multiply      rx*sin(a)
11446
        DEFB    $E2             ;;get-mem-2     rx*sin(a), ry.
11447
        DEFB    $E3             ;;get-mem-3     rx*sin(a), ry, cos(a).
11448
        DEFB    $04             ;;multiply      rx*sin(a), ry*cos(a).
11449
        DEFB    $0F             ;;addition      rx*sin(a) + ry*cos(a).
11450
        DEFB    $C2             ;;st-mem-2      new relative y rotated.
11451
        DEFB    $02             ;;delete        .
11452
        DEFB    $38             ;;end-calc      .
11453
 
11454
;   Note. the calculator stack actually holds   tx, ty, ax, ay
11455
;   and the last absolute values of x and y
11456
;   are now brought into play.
11457
;
11458
;   Magically, the two new rotated coordinates rx and ry are all that we would
11459
;   require to draw a circle or arc - on paper!
11460
;   The Spectrum DRAW routine draws to the rounded x and y coordinate and so
11461
;   repetitions of values like 3.49 would mean that the fractional parts
11462
;   would be lost until eventually the draw coordinates might differ from the
11463
;   floating point values used above by several pixels.
11464
;   For this reason the accurate offsets calculated above are added to the
11465
;   accurate, absolute coordinates maintained in ax and ay and these new
11466
;   coordinates have the integer coordinates of the last plot position
11467
;   ( from System Variable COORDS ) subtracted from them to give the relative
11468
;   coordinates required by the DRAW routine.
11469
 
11470
;   The mid entry point.
11471
 
11472
;; ARC-START
11473
L2439:  PUSH    BC              ; Preserve the arc counter on the machine stack.
11474
 
11475
;   Store the absolute ay in temporary variable mem-0 for the moment.
11476
 
11477
        RST     28H             ;; FP-CALC      ax, ay.
11478
        DEFB    $C0             ;;st-mem-0      ax, ay.
11479
        DEFB    $02             ;;delete        ax.
11480
 
11481
;   Now add the fractional relative x coordinate to the fractional absolute
11482
;   x coordinate to obtain a new fractional x-coordinate.
11483
 
11484
        DEFB    $E1             ;;get-mem-1     ax, xr.
11485
        DEFB    $0F             ;;addition      ax+xr (= new ax).
11486
        DEFB    $31             ;;duplicate     ax, ax.
11487
        DEFB    $38             ;;end-calc      ax, ax.
11488
 
11489
        LD      A,($5C7D)       ; COORDS-x      last x    (integer ix 0-255)
11490
        CALL    L2D28           ; routine STACK-A
11491
 
11492
        RST     28H             ;; FP-CALC      ax, ax, ix.
11493
        DEFB    $03             ;;subtract      ax, ax-ix  = relative DRAW Dx.
11494
 
11495
;   Having calculated the x value for DRAW do the same for the y value.
11496
 
11497
        DEFB    $E0             ;;get-mem-0     ax, Dx, ay.
11498
        DEFB    $E2             ;;get-mem-2     ax, Dx, ay, ry.
11499
        DEFB    $0F             ;;addition      ax, Dx, ay+ry (= new ay).
11500
        DEFB    $C0             ;;st-mem-0      ax, Dx, ay.
11501
        DEFB    $01             ;;exchange      ax, ay, Dx,
11502
        DEFB    $E0             ;;get-mem-0     ax, ay, Dx, ay.
11503
        DEFB    $38             ;;end-calc      ax, ay, Dx, ay.
11504
 
11505
        LD      A,($5C7E)       ; COORDS-y      last y (integer iy 0-175)
11506
        CALL    L2D28           ; routine STACK-A
11507
 
11508
        RST     28H             ;; FP-CALC      ax, ay, Dx, ay, iy.
11509
        DEFB    $03             ;;subtract      ax, ay, Dx, ay-iy ( = Dy).
11510
        DEFB    $38             ;;end-calc      ax, ay, Dx, Dy.
11511
 
11512
        CALL    L24B7           ; Routine DRAW-LINE draws (Dx,Dy) relative to
11513
                                ; the last pixel plotted leaving absolute x
11514
                                ; and y on the calculator stack.
11515
                                ;               ax, ay.
11516
 
11517
        POP     BC              ; Restore the arc counter from the machine stack.
11518
 
11519
        DJNZ    L2425           ; Decrement and loop while > 0 to ARC-LOOP
11520
 
11521
; -------------
11522
; THE 'ARC END'
11523
; -------------
11524
 
11525
;   To recap the full calculator stack is       tx, ty, ax, ay.
11526
 
11527
;   Just as one would do if drawing the curve on paper, the final line would
11528
;   be drawn by joining the last point plotted to the initial start point
11529
;   in the case of a CIRCLE or to the calculated end point in the case of
11530
;   an ARC.
11531
;   The moving absolute values of x and y are no longer required and they
11532
;   can be deleted to expose the closing coordinates.
11533
 
11534
;; ARC-END
11535
L245F:  RST     28H             ;; FP-CALC      tx, ty, ax, ay.
11536
        DEFB    $02             ;;delete        tx, ty, ax.
11537
        DEFB    $02             ;;delete        tx, ty.
11538
        DEFB    $01             ;;exchange      ty, tx.
11539
        DEFB    $38             ;;end-calc      ty, tx.
11540
 
11541
;   First calculate the relative x coordinate to the end-point.
11542
 
11543
        LD      A,($5C7D)       ; COORDS-x
11544
        CALL    L2D28           ; routine STACK-A
11545
 
11546
        RST     28H             ;; FP-CALC      ty, tx, coords_x.
11547
        DEFB    $03             ;;subtract      ty, rx.
11548
 
11549
;   Next calculate the relative y coordinate to the end-point.
11550
 
11551
        DEFB    $01             ;;exchange      rx, ty.
11552
        DEFB    $38             ;;end-calc      rx, ty.
11553
 
11554
        LD      A,($5C7E)       ; COORDS-y
11555
        CALL    L2D28           ; routine STACK-A
11556
 
11557
        RST     28H             ;; FP-CALC      rx, ty, coords_y
11558
        DEFB    $03             ;;subtract      rx, ry.
11559
        DEFB    $38             ;;end-calc      rx, ry.
11560
 
11561
;   Finally draw the last straight line.
11562
 
11563
;; LINE-DRAW
11564
L2477:  CALL    L24B7           ; routine DRAW-LINE draws to the relative
11565
                                ; coordinates (rx, ry).
11566
 
11567
        JP      L0D4D           ; jump back and exit via TEMPS          >>>
11568
 
11569
 
11570
; --------------------------------------------
11571
; THE 'INITIAL CIRCLE/DRAW PARAMETERS' ROUTINE
11572
; --------------------------------------------
11573
;   Begin by calculating the number of chords which will be returned in B.
11574
;   A rule of thumb is employed that uses a value z which for a circle is the
11575
;   radius and for an arc is the diameter with, as it happens, a pinch more if
11576
;   the arc is on a slope.
11577
;
11578
;   NUMBER OF STRAIGHT LINES = ANGLE OF ROTATION * SQUARE ROOT ( Z ) / 2
11579
 
11580
;; CD-PRMS1
11581
L247D:  RST     28H             ;; FP-CALC      z.
11582
        DEFB    $31             ;;duplicate     z, z.
11583
        DEFB    $28             ;;sqr           z, sqr(z).
11584
        DEFB    $34             ;;stk-data      z, sqr(z), 2.
11585
        DEFB    $32             ;;Exponent: $82, Bytes: 1
11586
        DEFB    $00             ;;(+00,+00,+00)
11587
        DEFB    $01             ;;exchange      z, 2, sqr(z).
11588
        DEFB    $05             ;;division      z, 2/sqr(z).
11589
        DEFB    $E5             ;;get-mem-5     z, 2/sqr(z), ANGLE.
11590
        DEFB    $01             ;;exchange      z, ANGLE, 2/sqr (z)
11591
        DEFB    $05             ;;division      z, ANGLE*sqr(z)/2 (= No. of lines)
11592
        DEFB    $2A             ;;abs           (for arc only)
11593
        DEFB    $38             ;;end-calc      z, number of lines.
11594
 
11595
;    As an example for a circle of radius 87 the number of lines will be 29.
11596
 
11597
        CALL    L2DD5           ; routine FP-TO-A
11598
 
11599
;    The value is compressed into A register, no carry with valid circle.
11600
 
11601
        JR      C,L2495         ; forward, if over 256, to USE-252
11602
 
11603
;    now make a multiple of 4 e.g. 29 becomes 28
11604
 
11605
        AND     $FC             ; AND 252
11606
 
11607
;    Adding 4 could set carry for arc, for the circle example, 28 becomes 32.
11608
 
11609
        ADD     A,$04           ; adding 4 could set carry if result is 256.
11610
 
11611
        JR      NC,L2497        ; forward if less than 256 to DRAW-SAVE
11612
 
11613
;    For an arc, a limit of 252 is imposed.
11614
 
11615
;; USE-252
11616
L2495:  LD      A,$FC           ; Use a value of 252 (for arc).
11617
 
11618
 
11619
;   For both arcs and circles, constants derived from the central angle are
11620
;   stored in the 'mem' locations.  Some are not relevant for the circle.
11621
 
11622
;; DRAW-SAVE
11623
L2497:  PUSH    AF              ; Save the line count (A) on the machine stack.
11624
 
11625
        CALL    L2D28           ; Routine STACK-A stacks the modified count(A).
11626
 
11627
        RST     28H             ;; FP-CALC      z, A.
11628
        DEFB    $E5             ;;get-mem-5     z, A, ANGLE.
11629
        DEFB    $01             ;;exchange      z, ANGLE, A.
11630
        DEFB    $05             ;;division      z, ANGLE/A. (Angle/count = a)
11631
        DEFB    $31             ;;duplicate     z, a, a.
11632
 
11633
;  Note. that cos (a) could be formed here directly using 'cos' and stored in
11634
;  mem-3 but that would spoil a good story and be slightly slower, as also
11635
;  would using square roots to form cos (a) from sin (a).
11636
 
11637
        DEFB    $1F             ;;sin           z, a, sin(a)
11638
        DEFB    $C4             ;;st-mem-4      z, a, sin(a)
11639
        DEFB    $02             ;;delete        z, a.
11640
        DEFB    $31             ;;duplicate     z, a, a.
11641
        DEFB    $A2             ;;stk-half      z, a, a, 1/2.
11642
        DEFB    $04             ;;multiply      z, a, a/2.
11643
        DEFB    $1F             ;;sin           z, a, sin(a/2).
11644
 
11645
;   Note. after second sin, mem-0 and mem-1 become free.
11646
 
11647
        DEFB    $C1             ;;st-mem-1      z, a, sin(a/2).
11648
        DEFB    $01             ;;exchange      z, sin(a/2), a.
11649
        DEFB    $C0             ;;st-mem-0      z, sin(a/2), a.  (for arc only)
11650
 
11651
;   Now form cos(a) from sin(a/2) using the 'DOUBLE ANGLE FORMULA'.
11652
 
11653
        DEFB    $02             ;;delete        z, sin(a/2).
11654
        DEFB    $31             ;;duplicate     z, sin(a/2), sin(a/2).
11655
        DEFB    $04             ;;multiply      z, sin(a/2)*sin(a/2).
11656
        DEFB    $31             ;;duplicate     z, sin(a/2)*sin(a/2),
11657
                                ;;                           sin(a/2)*sin(a/2).
11658
        DEFB    $0F             ;;addition      z, 2*sin(a/2)*sin(a/2).
11659
        DEFB    $A1             ;;stk-one       z, 2*sin(a/2)*sin(a/2), 1.
11660
        DEFB    $03             ;;subtract      z, 2*sin(a/2)*sin(a/2)-1.
11661
 
11662
        DEFB    $1B             ;;negate        z, 1-2*sin(a/2)*sin(a/2).
11663
 
11664
        DEFB    $C3             ;;st-mem-3      z, cos(a).
11665
        DEFB    $02             ;;delete        z.
11666
        DEFB    $38             ;;end-calc      z.
11667
 
11668
;   The radius/diameter is left on the calculator stack.
11669
 
11670
        POP     BC              ; Restore the line count to the B register.
11671
 
11672
        RET                     ; Return.
11673
 
11674
; --------------------------
11675
; THE 'DOUBLE ANGLE FORMULA'
11676
; --------------------------
11677
;   This formula forms cos(a) from sin(a/2) using simple arithmetic.
11678
;
11679
;   THE GEOMETRIC PROOF OF FORMULA   cos (a) = 1 - 2 * sin(a/2) * sin(a/2)
11680
;
11681
;
11682
;                                            A
11683
;
11684
;                                         . /|\
11685
;                                     .    / | \
11686
;                                  .      /  |  \
11687
;                               .        /   |a/2\
11688
;                            .          /    |    \
11689
;                         .          1 /     |     \
11690
;                      .              /      |      \
11691
;                   .                /       |       \
11692
;                .                  /        |        \
11693
;             .  a/2             D / a      E|-+       \
11694
;          B ---------------------/----------+-+--------\ C
11695
;            <-         1       -><-       1           ->
11696
;
11697
;   cos a = 1 - 2 * sin(a/2) * sin(a/2)
11698
;
11699
;   The figure shows a right triangle that inscribes a circle of radius 1 with
11700
;   centre, or origin, D.  Line BC is the diameter of length 2 and A is a point
11701
;   on the circle. The periphery angle BAC is therefore a right angle by the
11702
;   Rule of Thales.
11703
;   Line AC is a chord touching two points on the circle and the angle at the
11704
;   centre is (a).
11705
;   Since the vertex of the largest triangle B touches the circle, the
11706
;   inscribed angle (a/2) is half the central angle (a).
11707
;   The cosine of (a) is the length DE as the hypotenuse is of length 1.
11708
;   This can also be expressed as 1-length CE.  Examining the triangle at the
11709
;   right, the top angle is also (a/2) as angle BAE and EBA add to give a right
11710
;   angle as do BAE and EAC.
11711
;   So cos (a) = 1 - AC * sin(a/2)
11712
;   Looking at the largest triangle, side AC can be expressed as
11713
;   AC = 2 * sin(a/2)   and so combining these we get
11714
;   cos (a) = 1 - 2 * sin(a/2) * sin(a/2).
11715
;
11716
;   "I will be sufficiently rewarded if when telling it to others, you will
11717
;    not claim the discovery as your own, but will say it is mine."
11718
;   - Thales, 640 - 546 B.C.
11719
;
11720
; --------------------------
11721
; THE 'LINE DRAWING' ROUTINE
11722
; --------------------------
11723
;
11724
;
11725
 
11726
;; DRAW-LINE
11727
L24B7:  CALL    L2307           ; routine STK-TO-BC
11728
        LD      A,C             ;
11729
        CP      B               ;
11730
        JR      NC,L24C4        ; to DL-X-GE-Y
11731
 
11732
        LD      L,C             ;
11733
        PUSH    DE              ;
11734
        XOR     A               ;
11735
        LD      E,A             ;
11736
        JR      L24CB           ; to DL-LARGER
11737
 
11738
; ---
11739
 
11740
;; DL-X-GE-Y
11741
L24C4:  OR      C               ;
11742
        RET     Z               ;
11743
 
11744
        LD      L,B             ;
11745
        LD      B,C             ;
11746
        PUSH    DE              ;
11747
        LD      D,$00           ;
11748
 
11749
;; DL-LARGER
11750
L24CB:  LD      H,B             ;
11751
        LD      A,B             ;
11752
        RRA                     ;
11753
 
11754
;; D-L-LOOP
11755
L24CE:  ADD     A,L             ;
11756
        JR      C,L24D4         ; to D-L-DIAG
11757
 
11758
        CP      H               ;
11759
        JR      C,L24DB         ; to D-L-HR-VT
11760
 
11761
;; D-L-DIAG
11762
L24D4:  SUB     H               ;
11763
        LD      C,A             ;
11764
        EXX                     ;
11765
        POP     BC              ;
11766
        PUSH    BC              ;
11767
        JR      L24DF           ; to D-L-STEP
11768
 
11769
; ---
11770
 
11771
;; D-L-HR-VT
11772
L24DB:  LD      C,A             ;
11773
        PUSH    DE              ;
11774
        EXX                     ;
11775
        POP     BC              ;
11776
 
11777
;; D-L-STEP
11778
L24DF:  LD      HL,($5C7D)      ; COORDS
11779
        LD      A,B             ;
11780
        ADD     A,H             ;
11781
        LD      B,A             ;
11782
        LD      A,C             ;
11783
        INC     A               ;
11784
        ADD     A,L             ;
11785
        JR      C,L24F7         ; to D-L-RANGE
11786
 
11787
        JR      Z,L24F9         ; to REPORT-Bc
11788
 
11789
;; D-L-PLOT
11790
L24EC:  DEC     A               ;
11791
        LD      C,A             ;
11792
        CALL    L22E5           ; routine PLOT-SUB
11793
        EXX                     ;
11794
        LD      A,C             ;
11795
        DJNZ    L24CE           ; to D-L-LOOP
11796
 
11797
        POP     DE              ;
11798
        RET                     ;
11799
 
11800
; ---
11801
 
11802
;; D-L-RANGE
11803
L24F7:  JR      Z,L24EC         ; to D-L-PLOT
11804
 
11805
 
11806
;; REPORT-Bc
11807
L24F9:  RST     08H             ; ERROR-1
11808
        DEFB    $0A             ; Error Report: Integer out of range
11809
 
11810
 
11811
 
11812
;***********************************
11813
;** Part 8. EXPRESSION EVALUATION **
11814
;***********************************
11815
;
11816
; It is a this stage of the ROM that the Spectrum ceases altogether to be
11817
; just a colourful novelty. One remarkable feature is that in all previous
11818
; commands when the Spectrum is expecting a number or a string then an
11819
; expression of the same type can be substituted ad infinitum.
11820
; This is the routine that evaluates that expression.
11821
; This is what causes 2 + 2 to give the answer 4.
11822
; That is quite easy to understand. However you don't have to make it much
11823
; more complex to start a remarkable juggling act.
11824
; e.g. PRINT 2 * (VAL "2+2" + TAN 3)
11825
; In fact, provided there is enough free RAM, the Spectrum can evaluate
11826
; an expression of unlimited complexity.
11827
; Apart from a couple of minor glitches, which you can now correct, the
11828
; system is remarkably robust.
11829
 
11830
 
11831
; ---------------------------------
11832
; Scan expression or sub-expression
11833
; ---------------------------------
11834
;
11835
;
11836
 
11837
;; SCANNING
11838
L24FB:  RST     18H             ; GET-CHAR
11839
        LD      B,$00           ; priority marker zero is pushed on stack
11840
                                ; to signify end of expression when it is
11841
                                ; popped off again.
11842
        PUSH    BC              ; put in on stack.
11843
                                ; and proceed to consider the first character
11844
                                ; of the expression.
11845
 
11846
;; S-LOOP-1
11847
L24FF:  LD      C,A             ; store the character while a look up is done.
11848
        LD      HL,L2596        ; Address: scan-func
11849
        CALL    L16DC           ; routine INDEXER is called to see if it is
11850
                                ; part of a limited range '+', '(', 'ATTR' etc.
11851
 
11852
        LD      A,C             ; fetch the character back
11853
        JP      NC,L2684        ; jump forward to S-ALPHNUM if not in primary
11854
                                ; operators and functions to consider in the
11855
                                ; first instance a digit or a variable and
11856
                                ; then anything else.                >>>
11857
 
11858
        LD      B,$00           ; but here if it was found in table so
11859
        LD      C,(HL)          ; fetch offset from table and make B zero.
11860
        ADD     HL,BC           ; add the offset to position found
11861
        JP      (HL)            ; and jump to the routine e.g. S-BIN
11862
                                ; making an indirect exit from there.
11863
 
11864
; -------------------------------------------------------------------------
11865
; The four service subroutines for routines in the scanning function table
11866
; -------------------------------------------------------------------------
11867
 
11868
; PRINT """Hooray!"" he cried."
11869
 
11870
;; S-QUOTE-S
11871
L250F:  CALL    L0074           ; routine CH-ADD+1 points to next character
11872
                                ; and fetches that character.
11873
        INC     BC              ; increase length counter.
11874
        CP      $0D             ; is it carriage return ?
11875
                                ; inside a quote.
11876
        JP      Z,L1C8A         ; jump back to REPORT-C if so.
11877
                                ; 'Nonsense in BASIC'.
11878
 
11879
        CP      $22             ; is it a quote '"' ?
11880
        JR      NZ,L250F        ; back to S-QUOTE-S if not for more.
11881
 
11882
        CALL    L0074           ; routine CH-ADD+1
11883
        CP      $22             ; compare with possible adjacent quote
11884
        RET                     ; return. with zero set if two together.
11885
 
11886
; ---
11887
 
11888
; This subroutine is used to get two coordinate expressions for the three
11889
; functions SCREEN$, ATTR and POINT that have two fixed parameters and
11890
; therefore require surrounding braces.
11891
 
11892
;; S-2-COORD
11893
L2522:  RST     20H             ; NEXT-CHAR
11894
        CP      $28             ; is it the opening '(' ?
11895
        JR      NZ,L252D        ; forward to S-RPORT-C if not
11896
                                ; 'Nonsense in BASIC'.
11897
 
11898
        CALL    L1C79           ; routine NEXT-2NUM gets two comma-separated
11899
                                ; numeric expressions. Note. this could cause
11900
                                ; many more recursive calls to SCANNING but
11901
                                ; the parent function will be evaluated fully
11902
                                ; before rejoining the main juggling act.
11903
 
11904
        RST     18H             ; GET-CHAR
11905
        CP      $29             ; is it the closing ')' ?
11906
 
11907
;; S-RPORT-C
11908
L252D:  JP      NZ,L1C8A        ; jump back to REPORT-C if not.
11909
                                ; 'Nonsense in BASIC'.
11910
 
11911
; ------------
11912
; Check syntax
11913
; ------------
11914
; This routine is called on a number of occasions to check if syntax is being
11915
; checked or if the program is being run. To test the flag inline would use
11916
; four bytes of code, but a call instruction only uses 3 bytes of code.
11917
 
11918
;; SYNTAX-Z
11919
L2530:  BIT     7,(IY+$01)      ; test FLAGS  - checking syntax only ?
11920
        RET                     ; return.
11921
 
11922
; ----------------
11923
; Scanning SCREEN$
11924
; ----------------
11925
; This function returns the code of a bit-mapped character at screen
11926
; position at line C, column B. It is unable to detect the mosaic characters
11927
; which are not bit-mapped but detects the ASCII 32 - 127 range.
11928
; The bit-mapped UDGs are ignored which is curious as it requires only a
11929
; few extra bytes of code. As usual, anything to do with CHARS is weird.
11930
; If no match is found a null string is returned.
11931
; No actual check on ranges is performed - that's up to the BASIC programmer.
11932
; No real harm can come from SCREEN$(255,255) although the BASIC manual
11933
; says that invalid values will be trapped.
11934
; Interestingly, in the Pitman pocket guide, 1984, Vickers says that the
11935
; range checking will be performed.
11936
 
11937
;; S-SCRN$-S
11938
L2535:  CALL    L2307           ; routine STK-TO-BC.
11939
        LD      HL,($5C36)      ; fetch address of CHARS.
11940
        LD      DE,$0100        ; fetch offset to chr$ 32
11941
        ADD     HL,DE           ; and find start of bitmaps.
11942
                                ; Note. not inc h. ??
11943
        LD      A,C             ; transfer line to A.
11944
        RRCA                    ; multiply
11945
        RRCA                    ; by
11946
        RRCA                    ; thirty-two.
11947
        AND     $E0             ; and with 11100000
11948
        XOR     B               ; combine with column $00 - $1F
11949
        LD      E,A             ; to give the low byte of top line
11950
        LD      A,C             ; column to A range 00000000 to 00011111
11951
        AND     $18             ; and with 00011000
11952
        XOR     $40             ; xor with 01000000 (high byte screen start)
11953
        LD      D,A             ; register DE now holds start address of cell.
11954
        LD      B,$60           ; there are 96 characters in ASCII set.
11955
 
11956
;; S-SCRN-LP
11957
L254F:  PUSH    BC              ; save count
11958
        PUSH    DE              ; save screen start address
11959
        PUSH    HL              ; save bitmap start
11960
        LD      A,(DE)          ; first byte of screen to A
11961
        XOR     (HL)            ; xor with corresponding character byte
11962
        JR      Z,L255A         ; forward to S-SC-MTCH if they match
11963
                                ; if inverse result would be $FF
11964
                                ; if any other then mismatch
11965
 
11966
        INC     A               ; set to $00 if inverse
11967
        JR      NZ,L2573        ; forward to S-SCR-NXT if a mismatch
11968
 
11969
        DEC     A               ; restore $FF
11970
 
11971
; a match has been found so seven more to test.
11972
 
11973
;; S-SC-MTCH
11974
L255A:  LD      C,A             ; load C with inverse mask $00 or $FF
11975
        LD      B,$07           ; count seven more bytes
11976
 
11977
;; S-SC-ROWS
11978
L255D:  INC     D               ; increment screen address.
11979
        INC     HL              ; increment bitmap address.
11980
        LD      A,(DE)          ; byte to A
11981
        XOR     (HL)            ; will give $00 or $FF (inverse)
11982
        XOR     C               ; xor with inverse mask
11983
        JR      NZ,L2573        ; forward to S-SCR-NXT if no match.
11984
 
11985
        DJNZ    L255D           ; back to S-SC-ROWS until all eight matched.
11986
 
11987
; continue if a match of all eight bytes was found
11988
 
11989
        POP     BC              ; discard the
11990
        POP     BC              ; saved
11991
        POP     BC              ; pointers
11992
        LD      A,$80           ; the endpoint of character set
11993
        SUB     B               ; subtract the counter
11994
                                ; to give the code 32-127
11995
        LD      BC,$0001        ; make one space in workspace.
11996
 
11997
        RST     30H             ; BC-SPACES creates the space sliding
11998
                                ; the calculator stack upwards.
11999
        LD      (DE),A          ; start is addressed by DE, so insert code
12000
        JR      L257D           ; forward to S-SCR-STO
12001
 
12002
; ---
12003
 
12004
; the jump was here if no match and more bitmaps to test.
12005
 
12006
;; S-SCR-NXT
12007
L2573:  POP     HL              ; restore the last bitmap start
12008
        LD      DE,$0008        ; and prepare to add 8.
12009
        ADD     HL,DE           ; now addresses next character bitmap.
12010
        POP     DE              ; restore screen address
12011
        POP     BC              ; and character counter in B
12012
        DJNZ    L254F           ; back to S-SCRN-LP if more characters.
12013
 
12014
        LD      C,B             ; B is now zero, so BC now zero.
12015
 
12016
;; S-SCR-STO
12017
L257D:  JP      L2AB2           ; to STK-STO-$ to store the string in
12018
                                ; workspace or a string with zero length.
12019
                                ; (value of DE doesn't matter in last case)
12020
 
12021
; Note. this exit seems correct but the general-purpose routine S-STRING
12022
; that calls this one will also stack any of its string results so this
12023
; leads to a double storing of the result in this case.
12024
; The instruction at L257D should just be a RET.
12025
; credit Stephen Kelly and others, 1982.
12026
 
12027
; -------------
12028
; Scanning ATTR
12029
; -------------
12030
; This function subroutine returns the attributes of a screen location -
12031
; a numeric result.
12032
; Again it's up to the BASIC programmer to supply valid values of line/column.
12033
 
12034
;; S-ATTR-S
12035
L2580:  CALL    L2307           ; routine STK-TO-BC fetches line to C,
12036
                                ; and column to B.
12037
        LD      A,C             ; line to A $00 - $17   (max 00010111)
12038
        RRCA                    ; rotate
12039
        RRCA                    ; bits
12040
        RRCA                    ; left.
12041
        LD      C,A             ; store in C as an intermediate value.
12042
 
12043
        AND     $E0             ; pick up bits 11100000 ( was 00011100 )
12044
        XOR     B               ; combine with column $00 - $1F
12045
        LD      L,A             ; low byte now correct.
12046
 
12047
        LD      A,C             ; bring back intermediate result from C
12048
        AND     $03             ; mask to give correct third of
12049
                                ; screen $00 - $02
12050
        XOR     $58             ; combine with base address.
12051
        LD      H,A             ; high byte correct.
12052
        LD      A,(HL)          ; pick up the colour attribute.
12053
        JP      L2D28           ; forward to STACK-A to store result
12054
                                ; and make an indirect exit.
12055
 
12056
; -----------------------
12057
; Scanning function table
12058
; -----------------------
12059
; This table is used by INDEXER routine to find the offsets to
12060
; four operators and eight functions. e.g. $A8 is the token 'FN'.
12061
; This table is used in the first instance for the first character of an
12062
; expression or by a recursive call to SCANNING for the first character of
12063
; any sub-expression. It eliminates functions that have no argument or
12064
; functions that can have more than one argument and therefore require
12065
; braces. By eliminating and dealing with these now it can later take a
12066
; simplistic approach to all other functions and assume that they have
12067
; one argument.
12068
; Similarly by eliminating BIN and '.' now it is later able to assume that
12069
; all numbers begin with a digit and that the presence of a number or
12070
; variable can be detected by a call to ALPHANUM.
12071
; By default all expressions are positive and the spurious '+' is eliminated
12072
; now as in print +2. This should not be confused with the operator '+'.
12073
; Note. this does allow a degree of nonsense to be accepted as in
12074
; PRINT +"3 is the greatest.".
12075
; An acquired programming skill is the ability to include brackets where
12076
; they are not necessary.
12077
; A bracket at the start of a sub-expression may be spurious or necessary
12078
; to denote that the contained expression is to be evaluated as an entity.
12079
; In either case this is dealt with by recursive calls to SCANNING.
12080
; An expression that begins with a quote requires special treatment.
12081
 
12082
;; scan-func
12083
L2596:  DEFB    $22, L25B3-$-1  ; $1C offset to S-QUOTE
12084
        DEFB    '(', L25E8-$-1  ; $4F offset to S-BRACKET
12085
        DEFB    '.', L268D-$-1  ; $F2 offset to S-DECIMAL
12086
        DEFB    '+', L25AF-$-1  ; $12 offset to S-U-PLUS
12087
 
12088
        DEFB    $A8, L25F5-$-1  ; $56 offset to S-FN
12089
        DEFB    $A5, L25F8-$-1  ; $57 offset to S-RND
12090
        DEFB    $A7, L2627-$-1  ; $84 offset to S-PI
12091
        DEFB    $A6, L2634-$-1  ; $8F offset to S-INKEY$
12092
        DEFB    $C4, L268D-$-1  ; $E6 offset to S-BIN
12093
        DEFB    $AA, L2668-$-1  ; $BF offset to S-SCREEN$
12094
        DEFB    $AB, L2672-$-1  ; $C7 offset to S-ATTR
12095
        DEFB    $A9, L267B-$-1  ; $CE offset to S-POINT
12096
 
12097
        DEFB    $00             ; zero end marker
12098
 
12099
; --------------------------
12100
; Scanning function routines
12101
; --------------------------
12102
; These are the 11 subroutines accessed by the above table.
12103
; S-BIN and S-DECIMAL are the same
12104
; The 1-byte offset limits their location to within 255 bytes of their
12105
; entry in the table.
12106
 
12107
; ->
12108
;; S-U-PLUS
12109
L25AF:  RST     20H             ; NEXT-CHAR just ignore
12110
        JP      L24FF           ; to S-LOOP-1
12111
 
12112
; ---
12113
 
12114
; ->
12115
;; S-QUOTE
12116
L25B3:  RST     18H             ; GET-CHAR
12117
        INC     HL              ; address next character (first in quotes)
12118
        PUSH    HL              ; save start of quoted text.
12119
        LD      BC,$0000        ; initialize length of string to zero.
12120
        CALL    L250F           ; routine S-QUOTE-S
12121
        JR      NZ,L25D9        ; forward to S-Q-PRMS if
12122
 
12123
;; S-Q-AGAIN
12124
L25BE:  CALL    L250F           ; routine S-QUOTE-S copies string until a
12125
                                ; quote is encountered
12126
        JR      Z,L25BE         ; back to S-Q-AGAIN if two quotes WERE
12127
                                ; together.
12128
 
12129
; but if just an isolated quote then that terminates the string.
12130
 
12131
        CALL    L2530           ; routine SYNTAX-Z
12132
        JR      Z,L25D9         ; forward to S-Q-PRMS if checking syntax.
12133
 
12134
 
12135
        RST     30H             ; BC-SPACES creates the space for true
12136
                                ; copy of string in workspace.
12137
        POP     HL              ; re-fetch start of quoted text.
12138
        PUSH    DE              ; save start in workspace.
12139
 
12140
;; S-Q-COPY
12141
L25CB:  LD      A,(HL)          ; fetch a character from source.
12142
        INC     HL              ; advance source address.
12143
        LD      (DE),A          ; place in destination.
12144
        INC     DE              ; advance destination address.
12145
        CP      $22             ; was it a '"' just copied ?
12146
        JR      NZ,L25CB        ; back to S-Q-COPY to copy more if not
12147
 
12148
        LD      A,(HL)          ; fetch adjacent character from source.
12149
        INC     HL              ; advance source address.
12150
        CP      $22             ; is this '"' ? - i.e. two quotes together ?
12151
        JR      Z,L25CB         ; to S-Q-COPY if so including just one of the
12152
                                ; pair of quotes.
12153
 
12154
; proceed when terminating quote encountered.
12155
 
12156
;; S-Q-PRMS
12157
L25D9:  DEC     BC              ; decrease count by 1.
12158
        POP     DE              ; restore start of string in workspace.
12159
 
12160
;; S-STRING
12161
L25DB:  LD      HL,$5C3B        ; Address FLAGS system variable.
12162
        RES     6,(HL)          ; signal string result.
12163
        BIT     7,(HL)          ; is syntax being checked.
12164
        CALL    NZ,L2AB2        ; routine STK-STO-$ is called in runtime.
12165
        JP      L2712           ; jump forward to S-CONT-2          ===>
12166
 
12167
; ---
12168
 
12169
; ->
12170
;; S-BRACKET
12171
L25E8:  RST     20H             ; NEXT-CHAR
12172
        CALL    L24FB           ; routine SCANNING is called recursively.
12173
        CP      $29             ; is it the closing ')' ?
12174
        JP      NZ,L1C8A        ; jump back to REPORT-C if not
12175
                                ; 'Nonsense in BASIC'
12176
 
12177
        RST     20H             ; NEXT-CHAR
12178
        JP      L2712           ; jump forward to S-CONT-2          ===>
12179
 
12180
; ---
12181
 
12182
; ->
12183
;; S-FN
12184
L25F5:  JP      L27BD           ; jump forward to S-FN-SBRN.
12185
 
12186
; --------------------------------------------------------------------
12187
;
12188
;   RANDOM THEORY from the ZX81 manual by Steven Vickers
12189
;
12190
;   (same algorithm as the ZX Spectrum).
12191
;
12192
;   Chapter 5. Exercise 6. (For mathematicians only.)
12193
;
12194
;   Let p be a [large] prime, & let a be a primitive root modulo p.
12195
;   Then if b_i is the residue of a^i modulo p (1<=b_i
12196
;   sequence
12197
;
12198
;                           (b_i-1)/(p-1)
12199
;
12200
;   is a cyclical sequence of p-1 distinct numbers in the range 0 to 1
12201
;   (excluding 1). By choosing a suitably, these can be made to look
12202
;   fairly random.
12203
;
12204
;     65537 is a Mersenne prime 2^16-1. Note.
12205
;
12206
;   Use this, & Gauss' law of quadratic reciprocity, to show that 75
12207
;   is a primitive root modulo 65537.
12208
;
12209
;     The ZX81 uses p=65537 & a=75, & stores some b_i-1 in memory.
12210
;   The function RND involves replacing b_i-1 in memory by b_(i+1)-1,
12211
;   & yielding the result (b_(i+1)-1)/(p-1). RAND n (with 1<=n<=65535)
12212
;   makes b_i equal to n+1.
12213
;
12214
; --------------------------------------------------------------------
12215
;
12216
; Steven Vickers writing in comp.sys.sinclair on 20-DEC-1993
12217
;
12218
;   Note. (Of course, 65537 is 2^16 + 1, not -1.)
12219
;
12220
;   Consider arithmetic modulo a prime p. There are p residue classes, and the
12221
;   non-zero ones are all invertible. Hence under multiplication they form a
12222
;   group (Fp*, say) of order p-1; moreover (and not so obvious) Fp* is cyclic.
12223
;   Its generators are the "primitive roots". The "quadratic residues modulo p"
12224
;   are the squares in Fp*, and the "Legendre symbol" (d/p) is defined (when p
12225
;   does not divide d) as +1 or -1, according as d is or is not a quadratic
12226
;   residue mod p.
12227
;
12228
;   In the case when p = 65537, we can show that d is a primitive root if and
12229
;   only if it's not a quadratic residue. For let w be a primitive root, d
12230
;   congruent to w^r (mod p). If d is not primitive, then its order is a proper
12231
;   factor of 65536: hence w^{32768*r} = 1 (mod p), so 65536 divides 32768*r,
12232
;   and hence r is even and d is a square (mod p). Conversely, the squares in
12233
;   Fp* form a subgroup of (Fp*)^2 of index 2, and so cannot be generators.
12234
;
12235
;   Hence to check whether 75 is primitive mod 65537, we want to calculate that
12236
;   (75/65537) = -1. There is a multiplicative formula (ab/p) = (a/p)(b/p) (mod
12237
;   p), so (75/65537) = (5/65537)^2 * (3/65537) = (3/65537). Now the law of
12238
;   quadratic reciprocity says that if p and q are distinct odd primes, then
12239
;
12240
;    (p/q)(q/p) = (-1)^{(p-1)(q-1)/4}
12241
;
12242
;   Hence (3/65537) = (65537/3) * (-1)^{65536*2/4} = (65537/3)
12243
;            = (2/3)  (because 65537 = 2 mod 3)
12244
;            = -1
12245
;
12246
;   (I referred to Pierre Samuel's "Algebraic Theory of Numbers".)
12247
;
12248
; ->
12249
 
12250
;; S-RND
12251
L25F8:  CALL    L2530           ; routine SYNTAX-Z
12252
        JR      Z,L2625         ; forward to S-RND-END if checking syntax.
12253
 
12254
        LD      BC,($5C76)      ; fetch system variable SEED
12255
        CALL    L2D2B           ; routine STACK-BC places on calculator stack
12256
 
12257
        RST     28H             ;; FP-CALC           ;s.
12258
        DEFB    $A1             ;;stk-one            ;s,1.
12259
        DEFB    $0F             ;;addition           ;s+1.
12260
        DEFB    $34             ;;stk-data           ;
12261
        DEFB    $37             ;;Exponent: $87,
12262
                                ;;Bytes: 1
12263
        DEFB    $16             ;;(+00,+00,+00)      ;s+1,75.
12264
        DEFB    $04             ;;multiply           ;(s+1)*75 = v
12265
        DEFB    $34             ;;stk-data           ;v.
12266
        DEFB    $80             ;;Bytes: 3
12267
        DEFB    $41             ;;Exponent $91
12268
        DEFB    $00,$00,$80     ;;(+00)              ;v,65537.
12269
        DEFB    $32             ;;n-mod-m            ;remainder, result.
12270
        DEFB    $02             ;;delete             ;remainder.
12271
        DEFB    $A1             ;;stk-one            ;remainder, 1.
12272
        DEFB    $03             ;;subtract           ;remainder - 1. = rnd
12273
        DEFB    $31             ;;duplicate          ;rnd,rnd.
12274
        DEFB    $38             ;;end-calc
12275
 
12276
        CALL    L2DA2           ; routine FP-TO-BC
12277
        LD      ($5C76),BC      ; store in SEED for next starting point.
12278
        LD      A,(HL)          ; fetch exponent
12279
        AND     A               ; is it zero ?
12280
        JR      Z,L2625         ; forward if so to S-RND-END
12281
 
12282
        SUB     $10             ; reduce exponent by 2^16
12283
        LD      (HL),A          ; place back
12284
 
12285
;; S-RND-END
12286
L2625:  JR      L2630           ; forward to S-PI-END
12287
 
12288
; ---
12289
 
12290
; the number PI 3.14159...
12291
 
12292
; ->
12293
;; S-PI
12294
L2627:  CALL    L2530           ; routine SYNTAX-Z
12295
        JR      Z,L2630         ; to S-PI-END if checking syntax.
12296
 
12297
        RST     28H             ;; FP-CALC
12298
        DEFB    $A3             ;;stk-pi/2                          pi/2.
12299
        DEFB    $38             ;;end-calc
12300
 
12301
        INC     (HL)            ; increment the exponent leaving pi
12302
                                ; on the calculator stack.
12303
 
12304
;; S-PI-END
12305
L2630:  RST     20H             ; NEXT-CHAR
12306
        JP      L26C3           ; jump forward to S-NUMERIC
12307
 
12308
; ---
12309
 
12310
; ->
12311
;; S-INKEY$
12312
L2634:  LD      BC,$105A        ; priority $10, operation code $1A ('read-in')
12313
                                ; +$40 for string result, numeric operand.
12314
                                ; set this up now in case we need to use the
12315
                                ; calculator.
12316
        RST     20H             ; NEXT-CHAR
12317
        CP      $23             ; '#' ?
12318
        JP      Z,L270D         ; to S-PUSH-PO if so to use the calculator
12319
                                ; single operation
12320
                                ; to read from network/RS232 etc. .
12321
 
12322
; else read a key from the keyboard.
12323
 
12324
        LD      HL,$5C3B        ; fetch FLAGS
12325
        RES     6,(HL)          ; signal string result.
12326
        BIT     7,(HL)          ; checking syntax ?
12327
        JR      Z,L2665         ; forward to S-INK$-EN if so
12328
 
12329
        CALL    L028E           ; routine KEY-SCAN key in E, shift in D.
12330
        LD      C,$00           ; the length of an empty string
12331
        JR      NZ,L2660        ; to S-IK$-STK to store empty string if
12332
                                ; no key returned.
12333
 
12334
        CALL    L031E           ; routine K-TEST get main code in A
12335
        JR      NC,L2660        ; to S-IK$-STK to stack null string if
12336
                                ; invalid
12337
 
12338
        DEC     D               ; D is expected to be FLAGS so set bit 3 $FF
12339
                                ; 'L' Mode so no keywords.
12340
        LD      E,A             ; main key to A
12341
                                ; C is MODE 0 'KLC' from above still.
12342
        CALL    L0333           ; routine K-DECODE
12343
        PUSH    AF              ; save the code
12344
        LD      BC,$0001        ; make room for one character
12345
 
12346
        RST     30H             ; BC-SPACES
12347
        POP     AF              ; bring the code back
12348
        LD      (DE),A          ; put the key in workspace
12349
        LD      C,$01           ; set C length to one
12350
 
12351
;; S-IK$-STK
12352
L2660:  LD      B,$00           ; set high byte of length to zero
12353
        CALL    L2AB2           ; routine STK-STO-$
12354
 
12355
;; S-INK$-EN
12356
L2665:  JP      L2712           ; to S-CONT-2            ===>
12357
 
12358
; ---
12359
 
12360
; ->
12361
;; S-SCREEN$
12362
L2668:  CALL    L2522           ; routine S-2-COORD
12363
        CALL    NZ,L2535        ; routine S-SCRN$-S
12364
 
12365
        RST     20H             ; NEXT-CHAR
12366
        JP      L25DB           ; forward to S-STRING to stack result
12367
 
12368
; ---
12369
 
12370
; ->
12371
;; S-ATTR
12372
L2672:  CALL    L2522           ; routine S-2-COORD
12373
        CALL    NZ,L2580        ; routine S-ATTR-S
12374
 
12375
        RST     20H             ; NEXT-CHAR
12376
        JR      L26C3           ; forward to S-NUMERIC
12377
 
12378
; ---
12379
 
12380
; ->
12381
;; S-POINT
12382
L267B:  CALL    L2522           ; routine S-2-COORD
12383
        CALL    NZ,L22CB        ; routine POINT-SUB
12384
 
12385
        RST     20H             ; NEXT-CHAR
12386
        JR      L26C3           ; forward to S-NUMERIC
12387
 
12388
; -----------------------------
12389
 
12390
; ==> The branch was here if not in table.
12391
 
12392
;; S-ALPHNUM
12393
L2684:  CALL    L2C88           ; routine ALPHANUM checks if variable or
12394
                                ; a digit.
12395
        JR      NC,L26DF        ; forward to S-NEGATE if not to consider
12396
                                ; a '-' character then functions.
12397
 
12398
        CP      $41             ; compare 'A'
12399
        JR      NC,L26C9        ; forward to S-LETTER if alpha       ->
12400
                                ; else must have been numeric so continue
12401
                                ; into that routine.
12402
 
12403
; This important routine is called during runtime and from LINE-SCAN
12404
; when a BASIC line is checked for syntax. It is this routine that
12405
; inserts, during syntax checking, the invisible floating point numbers
12406
; after the numeric expression. During runtime it just picks these
12407
; numbers up. It also handles BIN format numbers.
12408
 
12409
; ->
12410
;; S-BIN
12411
;; S-DECIMAL
12412
L268D:  CALL    L2530           ; routine SYNTAX-Z
12413
        JR      NZ,L26B5        ; to S-STK-DEC in runtime
12414
 
12415
; this route is taken when checking syntax.
12416
 
12417
        CALL    L2C9B           ; routine DEC-TO-FP to evaluate number
12418
 
12419
        RST     18H             ; GET-CHAR to fetch HL
12420
        LD      BC,$0006        ; six locations required
12421
        CALL    L1655           ; routine MAKE-ROOM
12422
        INC     HL              ; to first new location
12423
        LD      (HL),$0E        ; insert number marker
12424
        INC     HL              ; address next
12425
        EX      DE,HL           ; make DE destination.
12426
        LD      HL,($5C65)      ; STKEND points to end of stack.
12427
        LD      C,$05           ; result is five locations lower
12428
        AND     A               ; prepare for true subtraction
12429
        SBC     HL,BC           ; point to start of value.
12430
        LD      ($5C65),HL      ; update STKEND as we are taking number.
12431
        LDIR                    ; Copy five bytes to program location
12432
        EX      DE,HL           ; transfer pointer to HL
12433
        DEC     HL              ; adjust
12434
        CALL    L0077           ; routine TEMP-PTR1 sets CH-ADD
12435
        JR      L26C3           ; to S-NUMERIC to record nature of result
12436
 
12437
; ---
12438
 
12439
; branch here in runtime.
12440
 
12441
;; S-STK-DEC
12442
L26B5:  RST     18H             ; GET-CHAR positions HL at digit.
12443
 
12444
;; S-SD-SKIP
12445
L26B6:  INC     HL              ; advance pointer
12446
        LD      A,(HL)          ; until we find
12447
        CP      $0E             ; chr 14d - the number indicator
12448
        JR      NZ,L26B6        ; to S-SD-SKIP until a match
12449
                                ; it has to be here.
12450
 
12451
        INC     HL              ; point to first byte of number
12452
        CALL    L33B4           ; routine STACK-NUM stacks it
12453
        LD      ($5C5D),HL      ; update system variable CH_ADD
12454
 
12455
;; S-NUMERIC
12456
L26C3:  SET     6,(IY+$01)      ; update FLAGS  - Signal numeric result
12457
        JR      L26DD           ; forward to S-CONT-1               ===>
12458
                                ; actually S-CONT-2 is destination but why
12459
                                ; waste a byte on a jump when a JR will do.
12460
                                ; Actually a JR L2712 can be used. Rats.
12461
 
12462
; end of functions accessed from scanning functions table.
12463
 
12464
; --------------------------
12465
; Scanning variable routines
12466
; --------------------------
12467
;
12468
;
12469
 
12470
;; S-LETTER
12471
L26C9:  CALL    L28B2           ; routine LOOK-VARS
12472
 
12473
        JP      C,L1C2E         ; jump back to REPORT-2 if variable not found
12474
                                ; 'Variable not found'
12475
                                ; but a variable is always 'found' if syntax
12476
                                ; is being checked.
12477
 
12478
        CALL    Z,L2996         ; routine STK-VAR considers a subscript/slice
12479
        LD      A,($5C3B)       ; fetch FLAGS value
12480
        CP      $C0             ; compare 11000000
12481
        JR      C,L26DD         ; step forward to S-CONT-1 if string  ===>
12482
 
12483
        INC     HL              ; advance pointer
12484
        CALL    L33B4           ; routine STACK-NUM
12485
 
12486
;; S-CONT-1
12487
L26DD:  JR      L2712           ; forward to S-CONT-2                 ===>
12488
 
12489
; ----------------------------------------
12490
; -> the scanning branch was here if not alphanumeric.
12491
; All the remaining functions will be evaluated by a single call to the
12492
; calculator. The correct priority for the operation has to be placed in
12493
; the B register and the operation code, calculator literal in the C register.
12494
; the operation code has bit 7 set if result is numeric and bit 6 is
12495
; set if operand is numeric. so
12496
; $C0 = numeric result, numeric operand.            e.g. 'sin'
12497
; $80 = numeric result, string operand.             e.g. 'code'
12498
; $40 = string result, numeric operand.             e.g. 'str$'
12499
; $00 = string result, string operand.              e.g. 'val$'
12500
 
12501
;; S-NEGATE
12502
L26DF:  LD      BC,$09DB        ; prepare priority 09, operation code $C0 +
12503
                                ; 'negate' ($1B) - bits 6 and 7 set for numeric
12504
                                ; result and numeric operand.
12505
 
12506
        CP      $2D             ; is it '-' ?
12507
        JR      Z,L270D         ; forward if so to S-PUSH-PO
12508
 
12509
        LD      BC,$1018        ; prepare priority $10, operation code 'val$' -
12510
                                ; bits 6 and 7 reset for string result and
12511
                                ; string operand.
12512
 
12513
        CP      $AE             ; is it 'VAL$' ?
12514
        JR      Z,L270D         ; forward if so to S-PUSH-PO
12515
 
12516
        SUB     $AF             ; subtract token 'CODE' value to reduce
12517
                                ; functions 'CODE' to 'NOT' although the
12518
                                ; upper range is, as yet, unchecked.
12519
                                ; valid range would be $00 - $14.
12520
 
12521
        JP      C,L1C8A         ; jump back to REPORT-C with anything else
12522
                                ; 'Nonsense in BASIC'
12523
 
12524
        LD      BC,$04F0        ; prepare priority $04, operation $C0 +
12525
                                ; 'not' ($30)
12526
 
12527
        CP      $14             ; is it 'NOT'
12528
        JR      Z,L270D         ; forward to S-PUSH-PO if so
12529
 
12530
        JP      NC,L1C8A        ; to REPORT-C if higher
12531
                                ; 'Nonsense in BASIC'
12532
 
12533
        LD      B,$10           ; priority $10 for all the rest
12534
        ADD     A,$DC           ; make range $DC - $EF
12535
                                ; $C0 + 'code'($1C) thru 'chr$' ($2F)
12536
 
12537
        LD      C,A             ; transfer 'function' to C
12538
        CP      $DF             ; is it 'sin' ?
12539
        JR      NC,L2707        ; forward to S-NO-TO-$  with 'sin' through
12540
                                ; 'chr$' as operand is numeric.
12541
 
12542
; all the rest 'cos' through 'chr$' give a numeric result except 'str$'
12543
; and 'chr$'.
12544
 
12545
        RES     6,C             ; signal string operand for 'code', 'val' and
12546
                                ; 'len'.
12547
 
12548
;; S-NO-TO-$
12549
L2707:  CP      $EE             ; compare 'str$'
12550
        JR      C,L270D         ; forward to S-PUSH-PO if lower as result
12551
                                ; is numeric.
12552
 
12553
        RES     7,C             ; reset bit 7 of op code for 'str$', 'chr$'
12554
                                ; as result is string.
12555
 
12556
; >> This is where they were all headed for.
12557
 
12558
;; S-PUSH-PO
12559
L270D:  PUSH    BC              ; push the priority and calculator operation
12560
                                ; code.
12561
 
12562
        RST     20H             ; NEXT-CHAR
12563
        JP      L24FF           ; jump back to S-LOOP-1 to go round the loop
12564
                                ; again with the next character.
12565
 
12566
; --------------------------------
12567
 
12568
; ===>  there were many branches forward to here
12569
 
12570
;   An important step after the evaluation of an expression is to test for
12571
;   a string expression and allow it to be sliced.  If a numeric expression is
12572
;   followed by a '(' then the numeric expression is complete.
12573
;   Since a string slice can itself be sliced then loop repeatedly
12574
;   e.g. (STR$ PI) (3 TO) (TO 2)    or "nonsense" (4 TO )
12575
 
12576
;; S-CONT-2
12577
L2712:  RST     18H             ; GET-CHAR
12578
 
12579
;; S-CONT-3
12580
L2713:  CP      $28             ; is it '(' ?
12581
        JR      NZ,L2723        ; forward, if not, to S-OPERTR
12582
 
12583
        BIT     6,(IY+$01)      ; test FLAGS - numeric or string result ?
12584
        JR      NZ,L2734        ; forward, if numeric, to S-LOOP
12585
 
12586
;   if a string expression preceded the '(' then slice it.
12587
 
12588
        CALL    L2A52           ; routine SLICING
12589
 
12590
        RST     20H             ; NEXT-CHAR
12591
        JR      L2713           ; loop back to S-CONT-3
12592
 
12593
; ---------------------------
12594
 
12595
;   the branch was here when possibility of a '(' has been excluded.
12596
 
12597
;; S-OPERTR
12598
L2723:  LD      B,$00           ; prepare to add
12599
        LD      C,A             ; possible operator to C
12600
        LD      HL,L2795        ; Address: $2795 - tbl-of-ops
12601
        CALL    L16DC           ; routine INDEXER
12602
        JR      NC,L2734        ; forward to S-LOOP if not in table
12603
 
12604
;   but if found in table the priority has to be looked up.
12605
 
12606
        LD      C,(HL)          ; operation code to C ( B is still zero )
12607
        LD      HL,L27B0 - $C3  ; $26ED is base of table
12608
        ADD     HL,BC           ; index into table.
12609
        LD      B,(HL)          ; priority to B.
12610
 
12611
; ------------------
12612
; Scanning main loop
12613
; ------------------
12614
; the juggling act
12615
 
12616
;; S-LOOP
12617
L2734:  POP     DE              ; fetch last priority and operation
12618
        LD      A,D             ; priority to A
12619
        CP      B               ; compare with this one
12620
        JR      C,L2773         ; forward to S-TIGHTER to execute the
12621
                                ; last operation before this one as it has
12622
                                ; higher priority.
12623
 
12624
; the last priority was greater or equal this one.
12625
 
12626
        AND     A               ; if it is zero then so is this
12627
        JP      Z,L0018         ; jump to exit via get-char pointing at
12628
                                ; next character.
12629
                                ; This may be the character after the
12630
                                ; expression or, if exiting a recursive call,
12631
                                ; the next part of the expression to be
12632
                                ; evaluated.
12633
 
12634
        PUSH    BC              ; save current priority/operation
12635
                                ; as it has lower precedence than the one
12636
                                ; now in DE.
12637
 
12638
; the 'USR' function is special in that it is overloaded to give two types
12639
; of result.
12640
 
12641
        LD      HL,$5C3B        ; address FLAGS
12642
        LD      A,E             ; new operation to A register
12643
        CP      $ED             ; is it $C0 + 'usr-no' ($2D)  ?
12644
        JR      NZ,L274C        ; forward to S-STK-LST if not
12645
 
12646
        BIT     6,(HL)          ; string result expected ?
12647
                                ; (from the lower priority operand we've
12648
                                ; just pushed on stack )
12649
        JR      NZ,L274C        ; forward to S-STK-LST if numeric
12650
                                ; as operand bits match.
12651
 
12652
        LD      E,$99           ; reset bit 6 and substitute $19 'usr-$'
12653
                                ; for string operand.
12654
 
12655
;; S-STK-LST
12656
L274C:  PUSH    DE              ; now stack this priority/operation
12657
        CALL    L2530           ; routine SYNTAX-Z
12658
        JR      Z,L275B         ; forward to S-SYNTEST if checking syntax.
12659
 
12660
        LD      A,E             ; fetch the operation code
12661
        AND     $3F             ; mask off the result/operand bits to leave
12662
                                ; a calculator literal.
12663
        LD      B,A             ; transfer to B register
12664
 
12665
; now use the calculator to perform the single operation - operand is on
12666
; the calculator stack.
12667
; Note. although the calculator is performing a single operation most
12668
; functions e.g. TAN are written using other functions and literals and
12669
; these in turn are written using further strings of calculator literals so
12670
; another level of magical recursion joins the juggling act for a while
12671
; as the calculator too is calling itself.
12672
 
12673
        RST     28H             ;; FP-CALC
12674
        DEFB    $3B             ;;fp-calc-2
12675
L2758:  DEFB    $38             ;;end-calc
12676
 
12677
        JR      L2764           ; forward to S-RUNTEST
12678
 
12679
; ---
12680
 
12681
; the branch was here if checking syntax only.
12682
 
12683
;; S-SYNTEST
12684
L275B:  LD      A,E             ; fetch the operation code to accumulator
12685
        XOR     (IY+$01)        ; compare with bits of FLAGS
12686
        AND     $40             ; bit 6 will be zero now if operand
12687
                                ; matched expected result.
12688
 
12689
;; S-RPORT-C2
12690
L2761:  JP      NZ,L1C8A        ; to REPORT-C if mismatch
12691
                                ; 'Nonsense in BASIC'
12692
                                ; else continue to set flags for next
12693
 
12694
; the branch is to here in runtime after a successful operation.
12695
 
12696
;; S-RUNTEST
12697
L2764:  POP     DE              ; fetch the last operation from stack
12698
        LD      HL,$5C3B        ; address FLAGS
12699
        SET     6,(HL)          ; set default to numeric result in FLAGS
12700
        BIT     7,E             ; test the operational result
12701
        JR      NZ,L2770        ; forward to S-LOOPEND if numeric
12702
 
12703
        RES     6,(HL)          ; reset bit 6 of FLAGS to show string result.
12704
 
12705
;; S-LOOPEND
12706
L2770:  POP     BC              ; fetch the previous priority/operation
12707
        JR      L2734           ; back to S-LOOP to perform these
12708
 
12709
; ---
12710
 
12711
; the branch was here when a stacked priority/operator had higher priority
12712
; than the current one.
12713
 
12714
;; S-TIGHTER
12715
L2773:  PUSH    DE              ; save high priority op on stack again
12716
        LD      A,C             ; fetch lower priority operation code
12717
        BIT     6,(IY+$01)      ; test FLAGS - Numeric or string result ?
12718
        JR      NZ,L2790        ; forward to S-NEXT if numeric result
12719
 
12720
; if this is lower priority yet has string then must be a comparison.
12721
; Since these can only be evaluated in context and were defaulted to
12722
; numeric in operator look up they must be changed to string equivalents.
12723
 
12724
        AND     $3F             ; mask to give true calculator literal
12725
        ADD     A,$08           ; augment numeric literals to string
12726
                                ; equivalents.
12727
                                ; 'no-&-no'  => 'str-&-no'
12728
                                ; 'no-l-eql' => 'str-l-eql'
12729
                                ; 'no-gr-eq' => 'str-gr-eq'
12730
                                ; 'nos-neql' => 'strs-neql'
12731
                                ; 'no-grtr'  => 'str-grtr'
12732
                                ; 'no-less'  => 'str-less'
12733
                                ; 'nos-eql'  => 'strs-eql'
12734
                                ; 'addition' => 'strs-add'
12735
        LD      C,A             ; put modified comparison operator back
12736
        CP      $10             ; is it now 'str-&-no' ?
12737
        JR      NZ,L2788        ; forward to S-NOT-AND  if not.
12738
 
12739
        SET     6,C             ; set numeric operand bit
12740
        JR      L2790           ; forward to S-NEXT
12741
 
12742
; ---
12743
 
12744
;; S-NOT-AND
12745
L2788:  JR      C,L2761         ; back to S-RPORT-C2 if less
12746
                                ; 'Nonsense in BASIC'.
12747
                                ; e.g. a$ * b$
12748
 
12749
        CP      $17             ; is it 'strs-add' ?
12750
        JR      Z,L2790         ; forward to S-NEXT if so
12751
                                ; (bit 6 and 7 are reset)
12752
 
12753
        SET     7,C             ; set numeric (Boolean) result for all others
12754
 
12755
;; S-NEXT
12756
L2790:  PUSH    BC              ; now save this priority/operation on stack
12757
 
12758
        RST     20H             ; NEXT-CHAR
12759
        JP      L24FF           ; jump back to S-LOOP-1
12760
 
12761
; ------------------
12762
; Table of operators
12763
; ------------------
12764
; This table is used to look up the calculator literals associated with
12765
; the operator character. The thirteen calculator operations $03 - $0F
12766
; have bits 6 and 7 set to signify a numeric result.
12767
; Some of these codes and bits may be altered later if the context suggests
12768
; a string comparison or operation.
12769
; that is '+', '=', '>', '<', '<=', '>=' or '<>'.
12770
 
12771
;; tbl-of-ops
12772
L2795:  DEFB    '+', $CF        ;        $C0 + 'addition'
12773
        DEFB    '-', $C3        ;        $C0 + 'subtract'
12774
        DEFB    '*', $C4        ;        $C0 + 'multiply'
12775
        DEFB    '/', $C5        ;        $C0 + 'division'
12776
        DEFB    '^', $C6        ;        $C0 + 'to-power'
12777
        DEFB    '=', $CE        ;        $C0 + 'nos-eql'
12778
        DEFB    '>', $CC        ;        $C0 + 'no-grtr'
12779
        DEFB    '<', $CD        ;        $C0 + 'no-less'
12780
 
12781
        DEFB    $C7, $C9        ; '<='   $C0 + 'no-l-eql'
12782
        DEFB    $C8, $CA        ; '>='   $C0 + 'no-gr-eql'
12783
        DEFB    $C9, $CB        ; '<>'   $C0 + 'nos-neql'
12784
        DEFB    $C5, $C7        ; 'OR'   $C0 + 'or'
12785
        DEFB    $C6, $C8        ; 'AND'  $C0 + 'no-&-no'
12786
 
12787
        DEFB    $00             ; zero end-marker.
12788
 
12789
 
12790
; -------------------
12791
; Table of priorities
12792
; -------------------
12793
; This table is indexed with the operation code obtained from the above
12794
; table $C3 - $CF to obtain the priority for the respective operation.
12795
 
12796
;; tbl-priors
12797
L27B0:  DEFB    $06             ; '-'   opcode $C3
12798
        DEFB    $08             ; '*'   opcode $C4
12799
        DEFB    $08             ; '/'   opcode $C5
12800
        DEFB    $0A             ; '^'   opcode $C6
12801
        DEFB    $02             ; 'OR'  opcode $C7
12802
        DEFB    $03             ; 'AND' opcode $C8
12803
        DEFB    $05             ; '<='  opcode $C9
12804
        DEFB    $05             ; '>='  opcode $CA
12805
        DEFB    $05             ; '<>'  opcode $CB
12806
        DEFB    $05             ; '>'   opcode $CC
12807
        DEFB    $05             ; '<'   opcode $CD
12808
        DEFB    $05             ; '='   opcode $CE
12809
        DEFB    $06             ; '+'   opcode $CF
12810
 
12811
; ----------------------
12812
; Scanning function (FN)
12813
; ----------------------
12814
; This routine deals with user-defined functions.
12815
; The definition can be anywhere in the program area but these are best
12816
; placed near the start of the program as we shall see.
12817
; The evaluation process is quite complex as the Spectrum has to parse two
12818
; statements at the same time. Syntax of both has been checked previously
12819
; and hidden locations have been created immediately after each argument
12820
; of the DEF FN statement. Each of the arguments of the FN function is
12821
; evaluated by SCANNING and placed in the hidden locations. Then the
12822
; expression to the right of the DEF FN '=' is evaluated by SCANNING and for
12823
; any variables encountered, a search is made in the DEF FN variable list
12824
; in the program area before searching in the normal variables area.
12825
;
12826
; Recursion is not allowed: i.e. the definition of a function should not use
12827
; the same function, either directly or indirectly ( through another function).
12828
; You'll normally get error 4, ('Out of memory'), although sometimes the system
12829
; will crash. - Vickers, Pitman 1984.
12830
;
12831
; As the definition is just an expression, there would seem to be no means
12832
; of breaking out of such recursion.
12833
; However, by the clever use of string expressions and VAL, such recursion is
12834
; possible.
12835
; e.g. DEF FN a(n) = VAL "n+FN a(n-1)+0" ((n<1) * 10 + 1 TO )
12836
; will evaluate the full 11-character expression for all values where n is
12837
; greater than zero but just the 11th character, "0", when n drops to zero
12838
; thereby ending the recursion producing the correct result.
12839
; Recursive string functions are possible using VAL$ instead of VAL and the
12840
; null string as the final addend.
12841
; - from a turn of the century newsgroup discussion initiated by Mike Wynne.
12842
 
12843
;; S-FN-SBRN
12844
L27BD:  CALL    L2530           ; routine SYNTAX-Z
12845
        JR      NZ,L27F7        ; forward to SF-RUN in runtime
12846
 
12847
 
12848
        RST     20H             ; NEXT-CHAR
12849
        CALL    L2C8D           ; routine ALPHA check for letters A-Z a-z
12850
        JP      NC,L1C8A        ; jump back to REPORT-C if not
12851
                                ; 'Nonsense in BASIC'
12852
 
12853
 
12854
        RST     20H             ; NEXT-CHAR
12855
        CP      $24             ; is it '$' ?
12856
        PUSH    AF              ; save character and flags
12857
        JR      NZ,L27D0        ; forward to SF-BRKT-1 with numeric function
12858
 
12859
 
12860
        RST     20H             ; NEXT-CHAR
12861
 
12862
;; SF-BRKT-1
12863
L27D0:  CP      $28             ; is '(' ?
12864
        JR      NZ,L27E6        ; forward to SF-RPRT-C if not
12865
                                ; 'Nonsense in BASIC'
12866
 
12867
 
12868
        RST     20H             ; NEXT-CHAR
12869
        CP      $29             ; is it ')' ?
12870
        JR      Z,L27E9         ; forward to SF-FLAG-6 if no arguments.
12871
 
12872
;; SF-ARGMTS
12873
L27D9:  CALL    L24FB           ; routine SCANNING checks each argument
12874
                                ; which may be an expression.
12875
 
12876
        RST     18H             ; GET-CHAR
12877
        CP      $2C             ; is it a ',' ?
12878
        JR      NZ,L27E4        ; forward if not to SF-BRKT-2 to test bracket
12879
 
12880
 
12881
        RST     20H             ; NEXT-CHAR if a comma was found
12882
        JR      L27D9           ; back to SF-ARGMTS to parse all arguments.
12883
 
12884
; ---
12885
 
12886
;; SF-BRKT-2
12887
L27E4:  CP      $29             ; is character the closing ')' ?
12888
 
12889
;; SF-RPRT-C
12890
L27E6:  JP      NZ,L1C8A        ; jump to REPORT-C
12891
                                ; 'Nonsense in BASIC'
12892
 
12893
; at this point any optional arguments have had their syntax checked.
12894
 
12895
;; SF-FLAG-6
12896
L27E9:  RST     20H             ; NEXT-CHAR
12897
        LD      HL,$5C3B        ; address system variable FLAGS
12898
        RES     6,(HL)          ; signal string result
12899
        POP     AF              ; restore test against '$'.
12900
        JR      Z,L27F4         ; forward to SF-SYN-EN if string function.
12901
 
12902
        SET     6,(HL)          ; signal numeric result
12903
 
12904
;; SF-SYN-EN
12905
L27F4:  JP      L2712           ; jump back to S-CONT-2 to continue scanning.
12906
 
12907
; ---
12908
 
12909
; the branch was here in runtime.
12910
 
12911
;; SF-RUN
12912
L27F7:  RST     20H             ; NEXT-CHAR fetches name
12913
        AND     $DF             ; AND 11101111 - reset bit 5 - upper-case.
12914
        LD      B,A             ; save in B
12915
 
12916
        RST     20H             ; NEXT-CHAR
12917
        SUB     $24             ; subtract '$'
12918
        LD      C,A             ; save result in C
12919
        JR      NZ,L2802        ; forward if not '$' to SF-ARGMT1
12920
 
12921
        RST     20H             ; NEXT-CHAR advances to bracket
12922
 
12923
;; SF-ARGMT1
12924
L2802:  RST     20H             ; NEXT-CHAR advances to start of argument
12925
        PUSH    HL              ; save address
12926
        LD      HL,($5C53)      ; fetch start of program area from PROG
12927
        DEC     HL              ; the search starting point is the previous
12928
                                ; location.
12929
 
12930
;; SF-FND-DF
12931
L2808:  LD      DE,$00CE        ; search is for token 'DEF FN' in E,
12932
                                ; statement count in D.
12933
        PUSH    BC              ; save C the string test, and B the letter.
12934
        CALL    L1D86           ; routine LOOK-PROG will search for token.
12935
        POP     BC              ; restore BC.
12936
        JR      NC,L2814        ; forward to SF-CP-DEF if a match was found.
12937
 
12938
 
12939
;; REPORT-P
12940
L2812:  RST     08H             ; ERROR-1
12941
        DEFB    $18             ; Error Report: FN without DEF
12942
 
12943
;; SF-CP-DEF
12944
L2814:  PUSH    HL              ; save address of DEF FN
12945
        CALL    L28AB           ; routine FN-SKPOVR skips over white-space etc.
12946
                                ; without disturbing CH-ADD.
12947
        AND     $DF             ; make fetched character upper-case.
12948
        CP      B               ; compare with FN name
12949
        JR      NZ,L2825        ; forward to SF-NOT-FD if no match.
12950
 
12951
; the letters match so test the type.
12952
 
12953
        CALL    L28AB           ; routine FN-SKPOVR skips white-space
12954
        SUB     $24             ; subtract '$' from fetched character
12955
        CP      C               ; compare with saved result of same operation
12956
                                ; on FN name.
12957
        JR      Z,L2831         ; forward to SF-VALUES with a match.
12958
 
12959
; the letters matched but one was string and the other numeric.
12960
 
12961
;; SF-NOT-FD
12962
L2825:  POP     HL              ; restore search point.
12963
        DEC     HL              ; make location before
12964
        LD      DE,$0200        ; the search is to be for the end of the
12965
                                ; current definition - 2 statements forward.
12966
        PUSH    BC              ; save the letter/type
12967
        CALL    L198B           ; routine EACH-STMT steps past rejected
12968
                                ; definition.
12969
        POP     BC              ; restore letter/type
12970
        JR      L2808           ; back to SF-FND-DF to continue search
12971
 
12972
; ---
12973
 
12974
; Success!
12975
; the branch was here with matching letter and numeric/string type.
12976
 
12977
;; SF-VALUES
12978
L2831:  AND     A               ; test A ( will be zero if string '$' - '$' )
12979
 
12980
        CALL    Z,L28AB         ; routine FN-SKPOVR advances HL past '$'.
12981
 
12982
        POP     DE              ; discard pointer to 'DEF FN'.
12983
        POP     DE              ; restore pointer to first FN argument.
12984
        LD      ($5C5D),DE      ; save in CH_ADD
12985
 
12986
        CALL    L28AB           ; routine FN-SKPOVR advances HL past '('
12987
        PUSH    HL              ; save start address in DEF FN  ***
12988
        CP      $29             ; is character a ')' ?
12989
        JR      Z,L2885         ; forward to SF-R-BR-2 if no arguments.
12990
 
12991
;; SF-ARG-LP
12992
L2843:  INC     HL              ; point to next character.
12993
        LD      A,(HL)          ; fetch it.
12994
        CP      $0E             ; is it the number marker
12995
        LD      D,$40           ; signal numeric in D.
12996
        JR      Z,L2852         ; forward to SF-ARG-VL if numeric.
12997
 
12998
        DEC     HL              ; back to letter
12999
        CALL    L28AB           ; routine FN-SKPOVR skips any white-space
13000
        INC     HL              ; advance past the expected '$' to
13001
                                ; the 'hidden' marker.
13002
        LD      D,$00           ; signal string.
13003
 
13004
;; SF-ARG-VL
13005
L2852:  INC     HL              ; now address first of 5-byte location.
13006
        PUSH    HL              ; save address in DEF FN statement
13007
        PUSH    DE              ; save D - result type
13008
 
13009
        CALL    L24FB           ; routine SCANNING evaluates expression in
13010
                                ; the FN statement setting FLAGS and leaving
13011
                                ; result as last value on calculator stack.
13012
 
13013
        POP     AF              ; restore saved result type to A
13014
 
13015
        XOR     (IY+$01)        ; xor with FLAGS
13016
        AND     $40             ; and with 01000000 to test bit 6
13017
        JR      NZ,L288B        ; forward to REPORT-Q if type mismatch.
13018
                                ; 'Parameter error'
13019
 
13020
        POP     HL              ; pop the start address in DEF FN statement
13021
        EX      DE,HL           ; transfer to DE ?? pop straight into de ?
13022
 
13023
        LD      HL,($5C65)      ; set HL to STKEND location after value
13024
        LD      BC,$0005        ; five bytes to move
13025
        SBC     HL,BC           ; decrease HL by 5 to point to start.
13026
        LD      ($5C65),HL      ; set STKEND 'removing' value from stack.
13027
 
13028
        LDIR                    ; copy value into DEF FN statement
13029
        EX      DE,HL           ; set HL to location after value in DEF FN
13030
        DEC     HL              ; step back one
13031
        CALL    L28AB           ; routine FN-SKPOVR gets next valid character
13032
        CP      $29             ; is it ')' end of arguments ?
13033
        JR      Z,L2885         ; forward to SF-R-BR-2 if so.
13034
 
13035
; a comma separator has been encountered in the DEF FN argument list.
13036
 
13037
        PUSH    HL              ; save position in DEF FN statement
13038
 
13039
        RST     18H             ; GET-CHAR from FN statement
13040
        CP      $2C             ; is it ',' ?
13041
        JR      NZ,L288B        ; forward to REPORT-Q if not
13042
                                ; 'Parameter error'
13043
 
13044
        RST     20H             ; NEXT-CHAR in FN statement advances to next
13045
                                ; argument.
13046
 
13047
        POP     HL              ; restore DEF FN pointer
13048
        CALL    L28AB           ; routine FN-SKPOVR advances to corresponding
13049
                                ; argument.
13050
 
13051
        JR      L2843           ; back to SF-ARG-LP looping until all
13052
                                ; arguments are passed into the DEF FN
13053
                                ; hidden locations.
13054
 
13055
; ---
13056
 
13057
; the branch was here when all arguments passed.
13058
 
13059
;; SF-R-BR-2
13060
L2885:  PUSH    HL              ; save location of ')' in DEF FN
13061
 
13062
        RST     18H             ; GET-CHAR gets next character in FN
13063
        CP      $29             ; is it a ')' also ?
13064
        JR      Z,L288D         ; forward to SF-VALUE if so.
13065
 
13066
 
13067
;; REPORT-Q
13068
L288B:  RST     08H             ; ERROR-1
13069
        DEFB    $19             ; Error Report: Parameter error
13070
 
13071
;; SF-VALUE
13072
L288D:  POP     DE              ; location of ')' in DEF FN to DE.
13073
        EX      DE,HL           ; now to HL, FN ')' pointer to DE.
13074
        LD      ($5C5D),HL      ; initialize CH_ADD to this value.
13075
 
13076
; At this point the start of the DEF FN argument list is on the machine stack.
13077
; We also have to consider that this defined function may form part of the
13078
; definition of another defined function (though not itself).
13079
; As this defined function may be part of a hierarchy of defined functions
13080
; currently being evaluated by recursive calls to SCANNING, then we have to
13081
; preserve the original value of DEFADD and not assume that it is zero.
13082
 
13083
        LD      HL,($5C0B)      ; get original DEFADD address
13084
        EX      (SP),HL         ; swap with DEF FN address on stack ***
13085
        LD      ($5C0B),HL      ; set DEFADD to point to this argument list
13086
                                ; during scanning.
13087
 
13088
        PUSH    DE              ; save FN ')' pointer.
13089
 
13090
        RST     20H             ; NEXT-CHAR advances past ')' in define
13091
 
13092
        RST     20H             ; NEXT-CHAR advances past '=' to expression
13093
 
13094
        CALL    L24FB           ; routine SCANNING evaluates but searches
13095
                                ; initially for variables at DEFADD
13096
 
13097
        POP     HL              ; pop the FN ')' pointer
13098
        LD      ($5C5D),HL      ; set CH_ADD to this
13099
        POP     HL              ; pop the original DEFADD value
13100
        LD      ($5C0B),HL      ; and re-insert into DEFADD system variable.
13101
 
13102
        RST     20H             ; NEXT-CHAR advances to character after ')'
13103
        JP      L2712           ; to S-CONT-2 - to continue current
13104
                                ; invocation of scanning
13105
 
13106
; --------------------
13107
; Used to parse DEF FN
13108
; --------------------
13109
; e.g. DEF FN     s $ ( x )     =  b     $ (  TO  x  ) : REM exaggerated
13110
;
13111
; This routine is used 10 times to advance along a DEF FN statement
13112
; skipping spaces and colour control codes. It is similar to NEXT-CHAR
13113
; which is, at the same time, used to skip along the corresponding FN function
13114
; except the latter has to deal with AT and TAB characters in string
13115
; expressions. These cannot occur in a program area so this routine is
13116
; simpler as both colour controls and their parameters are less than space.
13117
 
13118
;; FN-SKPOVR
13119
L28AB:  INC     HL              ; increase pointer
13120
        LD      A,(HL)          ; fetch addressed character
13121
        CP      $21             ; compare with space + 1
13122
        JR      C,L28AB         ; back to FN-SKPOVR if less
13123
 
13124
        RET                     ; return pointing to a valid character.
13125
 
13126
; ---------
13127
; LOOK-VARS
13128
; ---------
13129
;
13130
;
13131
 
13132
;; LOOK-VARS
13133
L28B2:  SET     6,(IY+$01)      ; update FLAGS - presume numeric result
13134
 
13135
        RST     18H             ; GET-CHAR
13136
        CALL    L2C8D           ; routine ALPHA tests for A-Za-z
13137
        JP      NC,L1C8A        ; jump to REPORT-C if not.
13138
                                ; 'Nonsense in BASIC'
13139
 
13140
        PUSH    HL              ; save pointer to first letter       ^1
13141
        AND     $1F             ; mask lower bits, 1 - 26 decimal     000xxxxx
13142
        LD      C,A             ; store in C.
13143
 
13144
        RST     20H             ; NEXT-CHAR
13145
        PUSH    HL              ; save pointer to second character   ^2
13146
        CP      $28             ; is it '(' - an array ?
13147
        JR      Z,L28EF         ; forward to V-RUN/SYN if so.
13148
 
13149
        SET     6,C             ; set 6 signaling string if solitary  010
13150
        CP      $24             ; is character a '$' ?
13151
        JR      Z,L28DE         ; forward to V-STR-VAR
13152
 
13153
        SET     5,C             ; signal numeric                       011
13154
        CALL    L2C88           ; routine ALPHANUM sets carry if second
13155
                                ; character is alphanumeric.
13156
        JR      NC,L28E3        ; forward to V-TEST-FN if just one character
13157
 
13158
; It is more than one character but re-test current character so that 6 reset
13159
; This loop renders the similar loop at V-PASS redundant.
13160
 
13161
;; V-CHAR
13162
L28D4:  CALL    L2C88           ; routine ALPHANUM
13163
        JR      NC,L28EF        ; to V-RUN/SYN when no more
13164
 
13165
        RES     6,C             ; make long named type                 001
13166
 
13167
        RST     20H             ; NEXT-CHAR
13168
        JR      L28D4           ; loop back to V-CHAR
13169
 
13170
; ---
13171
 
13172
 
13173
;; V-STR-VAR
13174
L28DE:  RST     20H             ; NEXT-CHAR advances past '$'
13175
        RES     6,(IY+$01)      ; update FLAGS - signal string result.
13176
 
13177
;; V-TEST-FN
13178
L28E3:  LD      A,($5C0C)       ; load A with DEFADD_hi
13179
        AND     A               ; and test for zero.
13180
        JR      Z,L28EF         ; forward to V-RUN/SYN if a defined function
13181
                                ; is not being evaluated.
13182
 
13183
; Note.
13184
 
13185
        CALL    L2530           ; routine SYNTAX-Z
13186
        JP      NZ,L2951        ; JUMP to STK-F-ARG in runtime and then
13187
                                ; back to this point if no variable found.
13188
 
13189
;; V-RUN/SYN
13190
L28EF:  LD      B,C             ; save flags in B
13191
        CALL    L2530           ; routine SYNTAX-Z
13192
        JR      NZ,L28FD        ; to V-RUN to look for the variable in runtime
13193
 
13194
; if checking syntax the letter is not returned
13195
 
13196
        LD      A,C             ; copy letter/flags to A
13197
        AND     $E0             ; and with 11100000 to get rid of the letter
13198
        SET     7,A             ; use spare bit to signal checking syntax.
13199
        LD      C,A             ; and transfer to C.
13200
        JR      L2934           ; forward to V-SYNTAX
13201
 
13202
; ---
13203
 
13204
; but in runtime search for the variable.
13205
 
13206
;; V-RUN
13207
L28FD:  LD      HL,($5C4B)      ; set HL to start of variables from VARS
13208
 
13209
;; V-EACH
13210
L2900:  LD      A,(HL)          ; get first character
13211
        AND     $7F             ; and with 01111111
13212
                                ; ignoring bit 7 which distinguishes
13213
                                ; arrays or for/next variables.
13214
 
13215
        JR      Z,L2932         ; to V-80-BYTE if zero as must be 10000000
13216
                                ; the variables end-marker.
13217
 
13218
        CP      C               ; compare with supplied value.
13219
        JR      NZ,L292A        ; forward to V-NEXT if no match.
13220
 
13221
        RLA                     ; destructively test
13222
        ADD     A,A             ; bits 5 and 6 of A
13223
                                ; jumping if bit 5 reset or 6 set
13224
 
13225
        JP      P,L293F         ; to V-FOUND-2  strings and arrays
13226
 
13227
        JR      C,L293F         ; to V-FOUND-2  simple and for next
13228
 
13229
; leaving long name variables.
13230
 
13231
        POP     DE              ; pop pointer to 2nd. char
13232
        PUSH    DE              ; save it again
13233
        PUSH    HL              ; save variable first character pointer
13234
 
13235
;; V-MATCHES
13236
L2912:  INC     HL              ; address next character in vars area
13237
 
13238
;; V-SPACES
13239
L2913:  LD      A,(DE)          ; pick up letter from prog area
13240
        INC     DE              ; and advance address
13241
        CP      $20             ; is it a space
13242
        JR      Z,L2913         ; back to V-SPACES until non-space
13243
 
13244
        OR      $20             ; convert to range 1 - 26.
13245
        CP      (HL)            ; compare with addressed variables character
13246
        JR      Z,L2912         ; loop back to V-MATCHES if a match on an
13247
                                ; intermediate letter.
13248
 
13249
        OR      $80             ; now set bit 7 as last character of long
13250
                                ; names are inverted.
13251
        CP      (HL)            ; compare again
13252
        JR      NZ,L2929        ; forward to V-GET-PTR if no match
13253
 
13254
; but if they match check that this is also last letter in prog area
13255
 
13256
        LD      A,(DE)          ; fetch next character
13257
        CALL    L2C88           ; routine ALPHANUM sets carry if not alphanum
13258
        JR      NC,L293E        ; forward to V-FOUND-1 with a full match.
13259
 
13260
;; V-GET-PTR
13261
L2929:  POP     HL              ; pop saved pointer to char 1
13262
 
13263
;; V-NEXT
13264
L292A:  PUSH    BC              ; save flags
13265
        CALL    L19B8           ; routine NEXT-ONE gets next variable in DE
13266
        EX      DE,HL           ; transfer to HL.
13267
        POP     BC              ; restore the flags
13268
        JR      L2900           ; loop back to V-EACH
13269
                                ; to compare each variable
13270
 
13271
; ---
13272
 
13273
;; V-80-BYTE
13274
L2932:  SET     7,B             ; will signal not found
13275
 
13276
; the branch was here when checking syntax
13277
 
13278
;; V-SYNTAX
13279
L2934:  POP     DE              ; discard the pointer to 2nd. character  v2
13280
                                ; in BASIC line/workspace.
13281
 
13282
        RST     18H             ; GET-CHAR gets character after variable name.
13283
        CP      $28             ; is it '(' ?
13284
        JR      Z,L2943         ; forward to V-PASS
13285
                                ; Note. could go straight to V-END ?
13286
 
13287
        SET     5,B             ; signal not an array
13288
        JR      L294B           ; forward to V-END
13289
 
13290
; ---------------------------
13291
 
13292
; the jump was here when a long name matched and HL pointing to last character
13293
; in variables area.
13294
 
13295
;; V-FOUND-1
13296
L293E:  POP     DE              ; discard pointer to first var letter
13297
 
13298
; the jump was here with all other matches HL points to first var char.
13299
 
13300
;; V-FOUND-2
13301
L293F:  POP     DE              ; discard pointer to 2nd prog char       v2
13302
        POP     DE              ; drop pointer to 1st prog char          v1
13303
        PUSH    HL              ; save pointer to last char in vars
13304
 
13305
        RST     18H             ; GET-CHAR
13306
 
13307
;; V-PASS
13308
L2943:  CALL    L2C88           ; routine ALPHANUM
13309
        JR      NC,L294B        ; forward to V-END if not
13310
 
13311
; but it never will be as we advanced past long-named variables earlier.
13312
 
13313
        RST     20H             ; NEXT-CHAR
13314
        JR      L2943           ; back to V-PASS
13315
 
13316
; ---
13317
 
13318
;; V-END
13319
L294B:  POP     HL              ; pop the pointer to first character in
13320
                                ; BASIC line/workspace.
13321
        RL      B               ; rotate the B register left
13322
                                ; bit 7 to carry
13323
        BIT     6,B             ; test the array indicator bit.
13324
        RET                     ; return
13325
 
13326
; -----------------------
13327
; Stack function argument
13328
; -----------------------
13329
; This branch is taken from LOOK-VARS when a defined function is currently
13330
; being evaluated.
13331
; Scanning is evaluating the expression after the '=' and the variable
13332
; found could be in the argument list to the left of the '=' or in the
13333
; normal place after the program. Preference will be given to the former.
13334
; The variable name to be matched is in C.
13335
 
13336
;; STK-F-ARG
13337
L2951:  LD      HL,($5C0B)      ; set HL to DEFADD
13338
        LD      A,(HL)          ; load the first character
13339
        CP      $29             ; is it ')' ?
13340
        JP      Z,L28EF         ; JUMP back to V-RUN/SYN, if so, as there are
13341
                                ; no arguments.
13342
 
13343
; but proceed to search argument list of defined function first if not empty.
13344
 
13345
;; SFA-LOOP
13346
L295A:  LD      A,(HL)          ; fetch character again.
13347
        OR      $60             ; or with 01100000 presume a simple variable.
13348
        LD      B,A             ; save result in B.
13349
        INC     HL              ; address next location.
13350
        LD      A,(HL)          ; pick up byte.
13351
        CP      $0E             ; is it the number marker ?
13352
        JR      Z,L296B         ; forward to SFA-CP-VR if so.
13353
 
13354
; it was a string. White-space may be present but syntax has been checked.
13355
 
13356
        DEC     HL              ; point back to letter.
13357
        CALL    L28AB           ; routine FN-SKPOVR skips to the '$'
13358
        INC     HL              ; now address the hidden marker.
13359
        RES     5,B             ; signal a string variable.
13360
 
13361
;; SFA-CP-VR
13362
L296B:  LD      A,B             ; transfer found variable letter to A.
13363
        CP      C               ; compare with expected.
13364
        JR      Z,L2981         ; forward to SFA-MATCH with a match.
13365
 
13366
        INC     HL              ; step
13367
        INC     HL              ; past
13368
        INC     HL              ; the
13369
        INC     HL              ; five
13370
        INC     HL              ; bytes.
13371
 
13372
        CALL    L28AB           ; routine FN-SKPOVR skips to next character
13373
        CP      $29             ; is it ')' ?
13374
        JP      Z,L28EF         ; jump back if so to V-RUN/SYN to look in
13375
                                ; normal variables area.
13376
 
13377
        CALL    L28AB           ; routine FN-SKPOVR skips past the ','
13378
                                ; all syntax has been checked and these
13379
                                ; things can be taken as read.
13380
        JR      L295A           ; back to SFA-LOOP while there are more
13381
                                ; arguments.
13382
 
13383
; ---
13384
 
13385
;; SFA-MATCH
13386
L2981:  BIT     5,C             ; test if numeric
13387
        JR      NZ,L2991        ; to SFA-END if so as will be stacked
13388
                                ; by scanning
13389
 
13390
        INC     HL              ; point to start of string descriptor
13391
        LD      DE,($5C65)      ; set DE to STKEND
13392
        CALL    L33C0           ; routine MOVE-FP puts parameters on stack.
13393
        EX      DE,HL           ; new free location to HL.
13394
        LD      ($5C65),HL      ; use it to set STKEND system variable.
13395
 
13396
;; SFA-END
13397
L2991:  POP     DE              ; discard
13398
        POP     DE              ; pointers.
13399
        XOR     A               ; clear carry flag.
13400
        INC     A               ; and zero flag.
13401
        RET                     ; return.
13402
 
13403
; ------------------------
13404
; Stack variable component
13405
; ------------------------
13406
; This is called to evaluate a complex structure that has been found, in
13407
; runtime, by LOOK-VARS in the variables area.
13408
; In this case HL points to the initial letter, bits 7-5
13409
; of which indicate the type of variable.
13410
; 010 - simple string, 110 - string array, 100 - array of numbers.
13411
;
13412
; It is called from CLASS-01 when assigning to a string or array including
13413
; a slice.
13414
; It is called from SCANNING to isolate the required part of the structure.
13415
;
13416
; An important part of the runtime process is to check that the number of
13417
; dimensions of the variable match the number of subscripts supplied in the
13418
; BASIC line.
13419
;
13420
; If checking syntax,
13421
; the B register, which counts dimensions is set to zero (256) to allow
13422
; the loop to continue till all subscripts are checked. While doing this it
13423
; is reading dimension sizes from some arbitrary area of memory. Although
13424
; these are meaningless it is of no concern as the limit is never checked by
13425
; int-exp during syntax checking.
13426
;
13427
; The routine is also called from the syntax path of DIM command to check the
13428
; syntax of both string and numeric arrays definitions except that bit 6 of C
13429
; is reset so both are checked as numeric arrays. This ruse avoids a terminal
13430
; slice being accepted as part of the DIM command.
13431
; All that is being checked is that there are a valid set of comma-separated
13432
; expressions before a terminal ')', although, as above, it will still go
13433
; through the motions of checking dummy dimension sizes.
13434
 
13435
;; STK-VAR
13436
L2996:  XOR     A               ; clear A
13437
        LD      B,A             ; and B, the syntax dimension counter (256)
13438
        BIT     7,C             ; checking syntax ?
13439
        JR      NZ,L29E7        ; forward to SV-COUNT if so.
13440
 
13441
; runtime evaluation.
13442
 
13443
        BIT     7,(HL)          ; will be reset if a simple string.
13444
        JR      NZ,L29AE        ; forward to SV-ARRAYS otherwise
13445
 
13446
        INC     A               ; set A to 1, simple string.
13447
 
13448
;; SV-SIMPLE$
13449
L29A1:  INC     HL              ; address length low
13450
        LD      C,(HL)          ; place in C
13451
        INC     HL              ; address length high
13452
        LD      B,(HL)          ; place in B
13453
        INC     HL              ; address start of string
13454
        EX      DE,HL           ; DE = start now.
13455
        CALL    L2AB2           ; routine STK-STO-$ stacks string parameters
13456
                                ; DE start in variables area,
13457
                                ; BC length, A=1 simple string
13458
 
13459
; the only thing now is to consider if a slice is required.
13460
 
13461
        RST     18H             ; GET-CHAR puts character at CH_ADD in A
13462
        JP      L2A49           ; jump forward to SV-SLICE? to test for '('
13463
 
13464
; --------------------------------------------------------
13465
 
13466
; the branch was here with string and numeric arrays in runtime.
13467
 
13468
;; SV-ARRAYS
13469
L29AE:  INC     HL              ; step past
13470
        INC     HL              ; the total length
13471
        INC     HL              ; to address Number of dimensions.
13472
        LD      B,(HL)          ; transfer to B overwriting zero.
13473
        BIT     6,C             ; a numeric array ?
13474
        JR      Z,L29C0         ; forward to SV-PTR with numeric arrays
13475
 
13476
        DEC     B               ; ignore the final element of a string array
13477
                                ; the fixed string size.
13478
 
13479
        JR      Z,L29A1         ; back to SV-SIMPLE$ if result is zero as has
13480
                                ; been created with DIM a$(10) for instance
13481
                                ; and can be treated as a simple string.
13482
 
13483
; proceed with multi-dimensioned string arrays in runtime.
13484
 
13485
        EX      DE,HL           ; save pointer to dimensions in DE
13486
 
13487
        RST     18H             ; GET-CHAR looks at the BASIC line
13488
        CP      $28             ; is character '(' ?
13489
        JR      NZ,L2A20        ; to REPORT-3 if not
13490
                                ; 'Subscript wrong'
13491
 
13492
        EX      DE,HL           ; dimensions pointer to HL to synchronize
13493
                                ; with next instruction.
13494
 
13495
; runtime numeric arrays path rejoins here.
13496
 
13497
;; SV-PTR
13498
L29C0:  EX      DE,HL           ; save dimension pointer in DE
13499
        JR      L29E7           ; forward to SV-COUNT with true no of dims
13500
                                ; in B. As there is no initial comma the
13501
                                ; loop is entered at the midpoint.
13502
 
13503
; ----------------------------------------------------------
13504
; the dimension counting loop which is entered at mid-point.
13505
 
13506
;; SV-COMMA
13507
L29C3:  PUSH    HL              ; save counter
13508
 
13509
        RST     18H             ; GET-CHAR
13510
 
13511
        POP     HL              ; pop counter
13512
        CP      $2C             ; is character ',' ?
13513
        JR      Z,L29EA         ; forward to SV-LOOP if so
13514
 
13515
; in runtime the variable definition indicates a comma should appear here
13516
 
13517
        BIT     7,C             ; checking syntax ?
13518
        JR      Z,L2A20         ; forward to REPORT-3 if not
13519
                                ; 'Subscript error'
13520
 
13521
; proceed if checking syntax of an array?
13522
 
13523
        BIT     6,C             ; array of strings
13524
        JR      NZ,L29D8        ; forward to SV-CLOSE if so
13525
 
13526
; an array of numbers.
13527
 
13528
        CP      $29             ; is character ')' ?
13529
        JR      NZ,L2A12        ; forward to SV-RPT-C if not
13530
                                ; 'Nonsense in BASIC'
13531
 
13532
        RST     20H             ; NEXT-CHAR moves CH-ADD past the statement
13533
        RET                     ; return ->
13534
 
13535
; ---
13536
 
13537
; the branch was here with an array of strings.
13538
 
13539
;; SV-CLOSE
13540
L29D8:  CP      $29             ; as above ')' could follow the expression
13541
        JR      Z,L2A48         ; forward to SV-DIM if so
13542
 
13543
        CP      $CC             ; is it 'TO' ?
13544
        JR      NZ,L2A12        ; to SV-RPT-C with anything else
13545
                                ; 'Nonsense in BASIC'
13546
 
13547
; now backtrack CH_ADD to set up for slicing routine.
13548
; Note. in a BASIC line we can safely backtrack to a colour parameter.
13549
 
13550
;; SV-CH-ADD
13551
L29E0:  RST     18H             ; GET-CHAR
13552
        DEC     HL              ; backtrack HL
13553
        LD      ($5C5D),HL      ; to set CH_ADD up for slicing routine
13554
        JR      L2A45           ; forward to SV-SLICE and make a return
13555
                                ; when all slicing complete.
13556
 
13557
; ----------------------------------------
13558
; -> the mid-point entry point of the loop
13559
 
13560
;; SV-COUNT
13561
L29E7:  LD      HL,$0000        ; initialize data pointer to zero.
13562
 
13563
;; SV-LOOP
13564
L29EA:  PUSH    HL              ; save the data pointer.
13565
 
13566
        RST     20H             ; NEXT-CHAR in BASIC area points to an
13567
                                ; expression.
13568
 
13569
        POP     HL              ; restore the data pointer.
13570
        LD      A,C             ; transfer name/type to A.
13571
        CP      $C0             ; is it 11000000 ?
13572
                                ; Note. the letter component is absent if
13573
                                ; syntax checking.
13574
        JR      NZ,L29FB        ; forward to SV-MULT if not an array of
13575
                                ; strings.
13576
 
13577
; proceed to check string arrays during syntax.
13578
 
13579
        RST     18H             ; GET-CHAR
13580
        CP      $29             ; ')'  end of subscripts ?
13581
        JR      Z,L2A48         ; forward to SV-DIM to consider further slice
13582
 
13583
        CP      $CC             ; is it 'TO' ?
13584
        JR      Z,L29E0         ; back to SV-CH-ADD to consider a slice.
13585
                                ; (no need to repeat get-char at L29E0)
13586
 
13587
; if neither, then an expression is required so rejoin runtime loop ??
13588
; registers HL and DE only point to somewhere meaningful in runtime so
13589
; comments apply to that situation.
13590
 
13591
;; SV-MULT
13592
L29FB:  PUSH    BC              ; save dimension number.
13593
        PUSH    HL              ; push data pointer/rubbish.
13594
                                ; DE points to current dimension.
13595
        CALL    L2AEE           ; routine DE,(DE+1) gets next dimension in DE
13596
                                ; and HL points to it.
13597
        EX      (SP),HL         ; dim pointer to stack, data pointer to HL (*)
13598
        EX      DE,HL           ; data pointer to DE, dim size to HL.
13599
 
13600
        CALL    L2ACC           ; routine INT-EXP1 checks integer expression
13601
                                ; and gets result in BC in runtime.
13602
        JR      C,L2A20         ; to REPORT-3 if > HL
13603
                                ; 'Subscript out of range'
13604
 
13605
        DEC     BC              ; adjust returned result from 1-x to 0-x
13606
        CALL    L2AF4           ; routine GET-HL*DE multiplies data pointer by
13607
                                ; dimension size.
13608
        ADD     HL,BC           ; add the integer returned by expression.
13609
        POP     DE              ; pop the dimension pointer.                              ***
13610
        POP     BC              ; pop dimension counter.
13611
        DJNZ    L29C3           ; back to SV-COMMA if more dimensions
13612
                                ; Note. during syntax checking, unless there
13613
                                ; are more than 256 subscripts, the branch
13614
                                ; back to SV-COMMA is always taken.
13615
 
13616
        BIT     7,C             ; are we checking syntax ?
13617
                                ; then we've got a joker here.
13618
 
13619
;; SV-RPT-C
13620
L2A12:  JR      NZ,L2A7A        ; forward to SL-RPT-C if so
13621
                                ; 'Nonsense in BASIC'
13622
                                ; more than 256 subscripts in BASIC line.
13623
 
13624
; but in runtime the number of subscripts are at least the same as dims
13625
 
13626
        PUSH    HL              ; save data pointer.
13627
        BIT     6,C             ; is it a string array ?
13628
        JR      NZ,L2A2C        ; forward to SV-ELEM$ if so.
13629
 
13630
; a runtime numeric array subscript.
13631
 
13632
        LD      B,D             ; register DE has advanced past all dimensions
13633
        LD      C,E             ; and points to start of data in variable.
13634
                                ; transfer it to BC.
13635
 
13636
        RST     18H             ; GET-CHAR checks BASIC line
13637
        CP      $29             ; must be a ')' ?
13638
        JR      Z,L2A22         ; skip to SV-NUMBER if so
13639
 
13640
; else more subscripts in BASIC line than the variable definition.
13641
 
13642
;; REPORT-3
13643
L2A20:  RST     08H             ; ERROR-1
13644
        DEFB    $02             ; Error Report: Subscript wrong
13645
 
13646
; continue if subscripts matched the numeric array.
13647
 
13648
;; SV-NUMBER
13649
L2A22:  RST     20H             ; NEXT-CHAR moves CH_ADD to next statement
13650
                                ; - finished parsing.
13651
 
13652
        POP     HL              ; pop the data pointer.
13653
        LD      DE,$0005        ; each numeric element is 5 bytes.
13654
        CALL    L2AF4           ; routine GET-HL*DE multiplies.
13655
        ADD     HL,BC           ; now add to start of data in the variable.
13656
 
13657
        RET                     ; return with HL pointing at the numeric
13658
                                ; array subscript.                       ->
13659
 
13660
; ---------------------------------------------------------------
13661
 
13662
; the branch was here for string subscripts when the number of subscripts
13663
; in the BASIC line was one less than in variable definition.
13664
 
13665
;; SV-ELEM$
13666
L2A2C:  CALL    L2AEE           ; routine DE,(DE+1) gets final dimension
13667
                                ; the length of strings in this array.
13668
        EX      (SP),HL         ; start pointer to stack, data pointer to HL.
13669
        CALL    L2AF4           ; routine GET-HL*DE multiplies by element
13670
                                ; size.
13671
        POP     BC              ; the start of data pointer is added
13672
        ADD     HL,BC           ; in - now points to location before.
13673
        INC     HL              ; point to start of required string.
13674
        LD      B,D             ; transfer the length (final dimension size)
13675
        LD      C,E             ; from DE to BC.
13676
        EX      DE,HL           ; put start in DE.
13677
        CALL    L2AB1           ; routine STK-ST-0 stores the string parameters
13678
                                ; with A=0 - a slice or subscript.
13679
 
13680
; now check that there were no more subscripts in the BASIC line.
13681
 
13682
        RST     18H             ; GET-CHAR
13683
        CP      $29             ; is it ')' ?
13684
        JR      Z,L2A48         ; forward to SV-DIM to consider a separate
13685
                                ; subscript or/and a slice.
13686
 
13687
        CP      $2C             ; a comma is allowed if the final subscript
13688
                                ; is to be sliced e.g. a$(2,3,4 TO 6).
13689
        JR      NZ,L2A20        ; to REPORT-3 with anything else
13690
                                ; 'Subscript error'
13691
 
13692
;; SV-SLICE
13693
L2A45:  CALL    L2A52           ; routine SLICING slices the string.
13694
 
13695
; but a slice of a simple string can itself be sliced.
13696
 
13697
;; SV-DIM
13698
L2A48:  RST     20H             ; NEXT-CHAR
13699
 
13700
;; SV-SLICE?
13701
L2A49:  CP      $28             ; is character '(' ?
13702
        JR      Z,L2A45         ; loop back if so to SV-SLICE
13703
 
13704
        RES     6,(IY+$01)      ; update FLAGS  - Signal string result
13705
        RET                     ; and return.
13706
 
13707
; ---
13708
 
13709
; The above section deals with the flexible syntax allowed.
13710
; DIM a$(3,3,10) can be considered as two dimensional array of ten-character
13711
; strings or a 3-dimensional array of characters.
13712
; a$(1,1) will return a 10-character string as will a$(1,1,1 TO 10)
13713
; a$(1,1,1) will return a single character.
13714
; a$(1,1) (1 TO 6) is the same as a$(1,1,1 TO 6)
13715
; A slice can itself be sliced ad infinitum
13716
; b$ () () () () () () (2 TO 10) (2 TO 9) (3) is the same as b$(5)
13717
 
13718
 
13719
 
13720
; -------------------------
13721
; Handle slicing of strings
13722
; -------------------------
13723
; The syntax of string slicing is very natural and it is as well to reflect
13724
; on the permutations possible.
13725
; a$() and a$( TO ) indicate the entire string although just a$ would do
13726
; and would avoid coming here.
13727
; h$(16) indicates the single character at position 16.
13728
; a$( TO 32) indicates the first 32 characters.
13729
; a$(257 TO) indicates all except the first 256 characters.
13730
; a$(19000 TO 19999) indicates the thousand characters at position 19000.
13731
; Also a$(9 TO 5) returns a null string not an error.
13732
; This enables a$(2 TO) to return a null string if the passed string is
13733
; of length zero or 1.
13734
; A string expression in brackets can be sliced. e.g. (STR$ PI) (3 TO )
13735
; We arrived here from SCANNING with CH-ADD pointing to the initial '('
13736
; or from above.
13737
 
13738
;; SLICING
13739
L2A52:  CALL    L2530           ; routine SYNTAX-Z
13740
        CALL    NZ,L2BF1        ; routine STK-FETCH fetches parameters of
13741
                                ; string at runtime, start in DE, length
13742
                                ; in BC. This could be an array subscript.
13743
 
13744
        RST     20H             ; NEXT-CHAR
13745
        CP      $29             ; is it ')' ?     e.g. a$()
13746
        JR      Z,L2AAD         ; forward to SL-STORE to store entire string.
13747
 
13748
        PUSH    DE              ; else save start address of string
13749
 
13750
        XOR     A               ; clear accumulator to use as a running flag.
13751
        PUSH    AF              ; and save on stack before any branching.
13752
 
13753
        PUSH    BC              ; save length of string to be sliced.
13754
        LD      DE,$0001        ; default the start point to position 1.
13755
 
13756
        RST     18H             ; GET-CHAR
13757
 
13758
        POP     HL              ; pop length to HL as default end point
13759
                                ; and limit.
13760
 
13761
        CP      $CC             ; is it 'TO' ?    e.g. a$( TO 10000)
13762
        JR      Z,L2A81         ; to SL-SECOND to evaluate second parameter.
13763
 
13764
        POP     AF              ; pop the running flag.
13765
 
13766
        CALL    L2ACD           ; routine INT-EXP2 fetches first parameter.
13767
 
13768
        PUSH    AF              ; save flag (will be $FF if parameter>limit)
13769
 
13770
        LD      D,B             ; transfer the start
13771
        LD      E,C             ; to DE overwriting 0001.
13772
        PUSH    HL              ; save original length.
13773
 
13774
        RST     18H             ; GET-CHAR
13775
        POP     HL              ; pop the limit length.
13776
        CP      $CC             ; is it 'TO' after a start ?
13777
        JR      Z,L2A81         ; to SL-SECOND to evaluate second parameter
13778
 
13779
        CP      $29             ; is it ')' ?       e.g. a$(365)
13780
 
13781
;; SL-RPT-C
13782
L2A7A:  JP      NZ,L1C8A        ; jump to REPORT-C with anything else
13783
                                ; 'Nonsense in BASIC'
13784
 
13785
        LD      H,D             ; copy start
13786
        LD      L,E             ; to end - just a one character slice.
13787
        JR      L2A94           ; forward to SL-DEFINE.
13788
 
13789
; ---------------------
13790
 
13791
;; SL-SECOND
13792
L2A81:  PUSH    HL              ; save limit length.
13793
 
13794
        RST     20H             ; NEXT-CHAR
13795
 
13796
        POP     HL              ; pop the length.
13797
 
13798
        CP      $29             ; is character ')' ?        e.g. a$(7 TO )
13799
        JR      Z,L2A94         ; to SL-DEFINE using length as end point.
13800
 
13801
        POP     AF              ; else restore flag.
13802
        CALL    L2ACD           ; routine INT-EXP2 gets second expression.
13803
 
13804
        PUSH    AF              ; save the running flag.
13805
 
13806
        RST     18H             ; GET-CHAR
13807
 
13808
        LD      H,B             ; transfer second parameter
13809
        LD      L,C             ; to HL.              e.g. a$(42 to 99)
13810
        CP      $29             ; is character a ')' ?
13811
        JR      NZ,L2A7A        ; to SL-RPT-C if not
13812
                                ; 'Nonsense in BASIC'
13813
 
13814
; we now have start in DE and an end in HL.
13815
 
13816
;; SL-DEFINE
13817
L2A94:  POP     AF              ; pop the running flag.
13818
        EX      (SP),HL         ; put end point on stack, start address to HL
13819
        ADD     HL,DE           ; add address of string to the start point.
13820
        DEC     HL              ; point to first character of slice.
13821
        EX      (SP),HL         ; start address to stack, end point to HL (*)
13822
        AND     A               ; prepare to subtract.
13823
        SBC     HL,DE           ; subtract start point from end point.
13824
        LD      BC,$0000        ; default the length result to zero.
13825
        JR      C,L2AA8         ; forward to SL-OVER if start > end.
13826
 
13827
        INC     HL              ; increment the length for inclusive byte.
13828
 
13829
        AND     A               ; now test the running flag.
13830
        JP      M,L2A20         ; jump back to REPORT-3 if $FF.
13831
                                ; 'Subscript out of range'
13832
 
13833
        LD      B,H             ; transfer the length
13834
        LD      C,L             ; to BC.
13835
 
13836
;; SL-OVER
13837
L2AA8:  POP     DE              ; restore start address from machine stack ***
13838
        RES     6,(IY+$01)      ; update FLAGS - signal string result for
13839
                                ; syntax.
13840
 
13841
;; SL-STORE
13842
L2AAD:  CALL    L2530           ; routine SYNTAX-Z  (UNSTACK-Z?)
13843
        RET     Z               ; return if checking syntax.
13844
                                ; but continue to store the string in runtime.
13845
 
13846
; ------------------------------------
13847
; other than from above, this routine is called from STK-VAR to stack
13848
; a known string array element.
13849
; ------------------------------------
13850
 
13851
;; STK-ST-0
13852
L2AB1:  XOR     A               ; clear to signal a sliced string or element.
13853
 
13854
; -------------------------
13855
; this routine is called from chr$, scrn$ etc. to store a simple string result.
13856
; --------------------------
13857
 
13858
;; STK-STO-$
13859
L2AB2:  RES     6,(IY+$01)      ; update FLAGS - signal string result.
13860
                                ; and continue to store parameters of string.
13861
 
13862
; ---------------------------------------
13863
; Pass five registers to calculator stack
13864
; ---------------------------------------
13865
; This subroutine puts five registers on the calculator stack.
13866
 
13867
;; STK-STORE
13868
L2AB6:  PUSH    BC              ; save two registers
13869
        CALL    L33A9           ; routine TEST-5-SP checks room and puts 5
13870
                                ; in BC.
13871
        POP     BC              ; fetch the saved registers.
13872
        LD      HL,($5C65)      ; make HL point to first empty location STKEND
13873
        LD      (HL),A          ; place the 5 registers.
13874
        INC     HL              ;
13875
        LD      (HL),E          ;
13876
        INC     HL              ;
13877
        LD      (HL),D          ;
13878
        INC     HL              ;
13879
        LD      (HL),C          ;
13880
        INC     HL              ;
13881
        LD      (HL),B          ;
13882
        INC     HL              ;
13883
        LD      ($5C65),HL      ; update system variable STKEND.
13884
        RET                     ; and return.
13885
 
13886
; -------------------------------------------
13887
; Return result of evaluating next expression
13888
; -------------------------------------------
13889
; This clever routine is used to check and evaluate an integer expression
13890
; which is returned in BC, setting A to $FF, if greater than a limit supplied
13891
; in HL. It is used to check array subscripts, parameters of a string slice
13892
; and the arguments of the DIM command. In the latter case, the limit check
13893
; is not required and H is set to $FF. When checking optional string slice
13894
; parameters, it is entered at the second entry point so as not to disturb
13895
; the running flag A, which may be $00 or $FF from a previous invocation.
13896
 
13897
;; INT-EXP1
13898
L2ACC:  XOR     A               ; set result flag to zero.
13899
 
13900
; -> The entry point is here if A is used as a running flag.
13901
 
13902
;; INT-EXP2
13903
L2ACD:  PUSH    DE              ; preserve DE register throughout.
13904
        PUSH    HL              ; save the supplied limit.
13905
        PUSH    AF              ; save the flag.
13906
 
13907
        CALL    L1C82           ; routine EXPT-1NUM evaluates expression
13908
                                ; at CH_ADD returning if numeric result,
13909
                                ; with value on calculator stack.
13910
 
13911
        POP     AF              ; pop the flag.
13912
        CALL    L2530           ; routine SYNTAX-Z
13913
        JR      Z,L2AEB         ; forward to I-RESTORE if checking syntax so
13914
                                ; avoiding a comparison with supplied limit.
13915
 
13916
        PUSH    AF              ; save the flag.
13917
 
13918
        CALL    L1E99           ; routine FIND-INT2 fetches value from
13919
                                ; calculator stack to BC producing an error
13920
                                ; if too high.
13921
 
13922
        POP     DE              ; pop the flag to D.
13923
        LD      A,B             ; test value for zero and reject
13924
        OR      C               ; as arrays and strings begin at 1.
13925
        SCF                     ; set carry flag.
13926
        JR      Z,L2AE8         ; forward to I-CARRY if zero.
13927
 
13928
        POP     HL              ; restore the limit.
13929
        PUSH    HL              ; and save.
13930
        AND     A               ; prepare to subtract.
13931
        SBC     HL,BC           ; subtract value from limit.
13932
 
13933
;; I-CARRY
13934
L2AE8:  LD      A,D             ; move flag to accumulator $00 or $FF.
13935
        SBC     A,$00           ; will set to $FF if carry set.
13936
 
13937
;; I-RESTORE
13938
L2AEB:  POP     HL              ; restore the limit.
13939
        POP     DE              ; and DE register.
13940
        RET                     ; return.
13941
 
13942
 
13943
; -----------------------
13944
; LD DE,(DE+1) Subroutine
13945
; -----------------------
13946
; This routine just loads the DE register with the contents of the two
13947
; locations following the location addressed by DE.
13948
; It is used to step along the 16-bit dimension sizes in array definitions.
13949
; Note. Such code is made into subroutines to make programs easier to
13950
; write and it would use less space to include the five instructions in-line.
13951
; However, there are so many exchanges going on at the places this is invoked
13952
; that to implement it in-line would make the code hard to follow.
13953
; It probably had a zippier label though as the intention is to simplify the
13954
; program.
13955
 
13956
;; DE,(DE+1)
13957
L2AEE:  EX      DE,HL           ;
13958
        INC     HL              ;
13959
        LD      E,(HL)          ;
13960
        INC     HL              ;
13961
        LD      D,(HL)          ;
13962
        RET                     ;
13963
 
13964
; -------------------
13965
; HL=HL*DE Subroutine
13966
; -------------------
13967
; This routine calls the mathematical routine to multiply HL by DE in runtime.
13968
; It is called from STK-VAR and from DIM. In the latter case syntax is not
13969
; being checked so the entry point could have been at the second CALL
13970
; instruction to save a few clock-cycles.
13971
 
13972
;; GET-HL*DE
13973
L2AF4:  CALL    L2530           ; routine SYNTAX-Z.
13974
        RET     Z               ; return if checking syntax.
13975
 
13976
        CALL    L30A9           ; routine HL-HL*DE.
13977
        JP      C,L1F15         ; jump back to REPORT-4 if over 65535.
13978
 
13979
        RET                     ; else return with 16-bit result in HL.
13980
 
13981
; -----------------
13982
; THE 'LET' COMMAND
13983
; -----------------
13984
; Sinclair BASIC adheres to the ANSI-78 standard and a LET is required in
13985
; assignments e.g. LET a = 1  :   LET h$ = "hat".
13986
;
13987
; Long names may contain spaces but not colour controls (when assigned).
13988
; a substring can appear to the left of the equals sign.
13989
 
13990
; An earlier mathematician Lewis Carroll may have been pleased that
13991
; 10 LET Babies cannot manage crocodiles = Babies are illogical AND
13992
;    Nobody is despised who can manage a crocodile AND Illogical persons
13993
;    are despised
13994
; does not give the 'Nonsense..' error if the three variables exist.
13995
; I digress.
13996
 
13997
;; LET
13998
L2AFF:  LD      HL,($5C4D)      ; fetch system variable DEST to HL.
13999
        BIT     1,(IY+$37)      ; test FLAGX - handling a new variable ?
14000
        JR      Z,L2B66         ; forward to L-EXISTS if not.
14001
 
14002
; continue for a new variable. DEST points to start in BASIC line.
14003
; from the CLASS routines.
14004
 
14005
        LD      BC,$0005        ; assume numeric and assign an initial 5 bytes
14006
 
14007
;; L-EACH-CH
14008
L2B0B:  INC     BC              ; increase byte count for each relevant
14009
                                ; character
14010
 
14011
;; L-NO-SP
14012
L2B0C:  INC     HL              ; increase pointer.
14013
        LD      A,(HL)          ; fetch character.
14014
        CP      $20             ; is it a space ?
14015
        JR      Z,L2B0C         ; back to L-NO-SP is so.
14016
 
14017
        JR      NC,L2B1F        ; forward to L-TEST-CH if higher.
14018
 
14019
        CP      $10             ; is it $00 - $0F ?
14020
        JR      C,L2B29         ; forward to L-SPACES if so.
14021
 
14022
        CP      $16             ; is it $16 - $1F ?
14023
        JR      NC,L2B29        ; forward to L-SPACES if so.
14024
 
14025
; it was $10 - $15  so step over a colour code.
14026
 
14027
        INC     HL              ; increase pointer.
14028
        JR      L2B0C           ; loop back to L-NO-SP.
14029
 
14030
; ---
14031
 
14032
; the branch was to here if higher than space.
14033
 
14034
;; L-TEST-CH
14035
L2B1F:  CALL    L2C88           ; routine ALPHANUM sets carry if alphanumeric
14036
        JR      C,L2B0B         ; loop back to L-EACH-CH for more if so.
14037
 
14038
        CP      $24             ; is it '$' ?
14039
        JP      Z,L2BC0         ; jump forward if so, to L-NEW$
14040
                                ; with a new string.
14041
 
14042
;; L-SPACES
14043
L2B29:  LD      A,C             ; save length lo in A.
14044
        LD      HL,($5C59)      ; fetch E_LINE to HL.
14045
        DEC     HL              ; point to location before, the variables
14046
                                ; end-marker.
14047
        CALL    L1655           ; routine MAKE-ROOM creates BC spaces
14048
                                ; for name and numeric value.
14049
        INC     HL              ; advance to first new location.
14050
        INC     HL              ; then to second.
14051
        EX      DE,HL           ; set DE to second location.
14052
        PUSH    DE              ; save this pointer.
14053
        LD      HL,($5C4D)      ; reload HL with DEST.
14054
        DEC     DE              ; point to first.
14055
        SUB     $06             ; subtract six from length_lo.
14056
        LD      B,A             ; save count in B.
14057
        JR      Z,L2B4F         ; forward to L-SINGLE if it was just
14058
                                ; one character.
14059
 
14060
; HL points to start of variable name after 'LET' in BASIC line.
14061
 
14062
;; L-CHAR
14063
L2B3E:  INC     HL              ; increase pointer.
14064
        LD      A,(HL)          ; pick up character.
14065
        CP      $21             ; is it space or higher ?
14066
        JR      C,L2B3E         ; back to L-CHAR with space and less.
14067
 
14068
        OR      $20             ; make variable lower-case.
14069
        INC     DE              ; increase destination pointer.
14070
        LD      (DE),A          ; and load to edit line.
14071
        DJNZ    L2B3E           ; loop back to L-CHAR until B is zero.
14072
 
14073
        OR      $80             ; invert the last character.
14074
        LD      (DE),A          ; and overwrite that in edit line.
14075
 
14076
; now consider first character which has bit 6 set
14077
 
14078
        LD      A,$C0           ; set A 11000000 is xor mask for a long name.
14079
                                ; %101      is xor/or  result
14080
 
14081
; single character numerics rejoin here with %00000000 in mask.
14082
;                                            %011      will be xor/or result
14083
 
14084
;; L-SINGLE
14085
L2B4F:  LD      HL,($5C4D)      ; fetch DEST - HL addresses first character.
14086
        XOR     (HL)            ; apply variable type indicator mask (above).
14087
        OR      $20             ; make lowercase - set bit 5.
14088
        POP     HL              ; restore pointer to 2nd character.
14089
        CALL    L2BEA           ; routine L-FIRST puts A in first character.
14090
                                ; and returns with HL holding
14091
                                ; new E_LINE-1  the $80 vars end-marker.
14092
 
14093
;; L-NUMERIC
14094
L2B59:  PUSH    HL              ; save the pointer.
14095
 
14096
; the value of variable is deleted but remains after calculator stack.
14097
 
14098
        RST     28H             ;; FP-CALC
14099
        DEFB    $02             ;;delete      ; delete variable value
14100
        DEFB    $38             ;;end-calc
14101
 
14102
; DE (STKEND) points to start of value.
14103
 
14104
        POP     HL              ; restore the pointer.
14105
        LD      BC,$0005        ; start of number is five bytes before.
14106
        AND     A               ; prepare for true subtraction.
14107
        SBC     HL,BC           ; HL points to start of value.
14108
        JR      L2BA6           ; forward to L-ENTER  ==>
14109
 
14110
; ---
14111
 
14112
 
14113
; the jump was to here if the variable already existed.
14114
 
14115
;; L-EXISTS
14116
L2B66:  BIT     6,(IY+$01)      ; test FLAGS - numeric or string result ?
14117
        JR      Z,L2B72         ; skip forward to L-DELETE$   -*->
14118
                                ; if string result.
14119
 
14120
; A numeric variable could be simple or an array element.
14121
; They are treated the same and the old value is overwritten.
14122
 
14123
        LD      DE,$0006        ; six bytes forward points to loc past value.
14124
        ADD     HL,DE           ; add to start of number.
14125
        JR      L2B59           ; back to L-NUMERIC to overwrite value.
14126
 
14127
; ---
14128
 
14129
; -*-> the branch was here if a string existed.
14130
 
14131
;; L-DELETE$
14132
L2B72:  LD      HL,($5C4D)      ; fetch DEST to HL.
14133
                                ; (still set from first instruction)
14134
        LD      BC,($5C72)      ; fetch STRLEN to BC.
14135
        BIT     0,(IY+$37)      ; test FLAGX - handling a complete simple
14136
                                ; string ?
14137
        JR      NZ,L2BAF        ; forward to L-ADD$ if so.
14138
 
14139
; must be a string array or a slice in workspace.
14140
; Note. LET a$(3 TO 6) = h$   will assign "hat " if h$ = "hat"
14141
;                                  and    "hats" if h$ = "hatstand".
14142
;
14143
; This is known as Procrustean lengthening and shortening after a
14144
; character Procrustes in Greek legend who made travellers sleep in his bed,
14145
; cutting off their feet or stretching them so they fitted the bed perfectly.
14146
; The bloke was hatstand and slain by Theseus.
14147
 
14148
        LD      A,B             ; test if length
14149
        OR      C               ; is zero and
14150
        RET     Z               ; return if so.
14151
 
14152
        PUSH    HL              ; save pointer to start.
14153
 
14154
        RST     30H             ; BC-SPACES creates room.
14155
        PUSH    DE              ; save pointer to first new location.
14156
        PUSH    BC              ; and length            (*)
14157
        LD      D,H             ; set DE to point to last location.
14158
        LD      E,L             ;
14159
        INC     HL              ; set HL to next location.
14160
        LD      (HL),$20        ; place a space there.
14161
        LDDR                    ; copy bytes filling with spaces.
14162
 
14163
        PUSH    HL              ; save pointer to start.
14164
        CALL    L2BF1           ; routine STK-FETCH start to DE,
14165
                                ; length to BC.
14166
        POP     HL              ; restore the pointer.
14167
        EX      (SP),HL         ; (*) length to HL, pointer to stack.
14168
        AND     A               ; prepare for true subtraction.
14169
        SBC     HL,BC           ; subtract old length from new.
14170
        ADD     HL,BC           ; and add back.
14171
        JR      NC,L2B9B        ; forward if it fits to L-LENGTH.
14172
 
14173
        LD      B,H             ; otherwise set
14174
        LD      C,L             ; length to old length.
14175
                                ; "hatstand" becomes "hats"
14176
 
14177
;; L-LENGTH
14178
L2B9B:  EX      (SP),HL         ; (*) length to stack, pointer to HL.
14179
        EX      DE,HL           ; pointer to DE, start of string to HL.
14180
        LD      A,B             ; is the length zero ?
14181
        OR      C               ;
14182
        JR      Z,L2BA3         ; forward to L-IN-W/S if so
14183
                                ; leaving prepared spaces.
14184
 
14185
        LDIR                    ; else copy bytes overwriting some spaces.
14186
 
14187
;; L-IN-W/S
14188
L2BA3:  POP     BC              ; pop the new length.  (*)
14189
        POP     DE              ; pop pointer to new area.
14190
        POP     HL              ; pop pointer to variable in assignment.
14191
                                ; and continue copying from workspace
14192
                                ; to variables area.
14193
 
14194
; ==> branch here from  L-NUMERIC
14195
 
14196
;; L-ENTER
14197
L2BA6:  EX      DE,HL           ; exchange pointers HL=STKEND DE=end of vars.
14198
        LD      A,B             ; test the length
14199
        OR      C               ; and make a
14200
        RET     Z               ; return if zero (strings only).
14201
 
14202
        PUSH    DE              ; save start of destination.
14203
        LDIR                    ; copy bytes.
14204
        POP     HL              ; address the start.
14205
        RET                     ; and return.
14206
 
14207
; ---
14208
 
14209
; the branch was here from L-DELETE$ if an existing simple string.
14210
; register HL addresses start of string in variables area.
14211
 
14212
;; L-ADD$
14213
L2BAF:  DEC     HL              ; point to high byte of length.
14214
        DEC     HL              ; to low byte.
14215
        DEC     HL              ; to letter.
14216
        LD      A,(HL)          ; fetch masked letter to A.
14217
        PUSH    HL              ; save the pointer on stack.
14218
        PUSH    BC              ; save new length.
14219
        CALL    L2BC6           ; routine L-STRING adds new string at end
14220
                                ; of variables area.
14221
                                ; if no room we still have old one.
14222
        POP     BC              ; restore length.
14223
        POP     HL              ; restore start.
14224
        INC     BC              ; increase
14225
        INC     BC              ; length by three
14226
        INC     BC              ; to include character and length bytes.
14227
        JP      L19E8           ; jump to indirect exit via RECLAIM-2
14228
                                ; deleting old version and adjusting pointers.
14229
 
14230
; ---
14231
 
14232
; the jump was here with a new string variable.
14233
 
14234
;; L-NEW$
14235
L2BC0:  LD      A,$DF           ; indicator mask %11011111 for
14236
                                ;                %010xxxxx will be result
14237
        LD      HL,($5C4D)      ; address DEST first character.
14238
        AND     (HL)            ; combine mask with character.
14239
 
14240
;; L-STRING
14241
L2BC6:  PUSH    AF              ; save first character and mask.
14242
        CALL    L2BF1           ; routine STK-FETCH fetches parameters of
14243
                                ; the string.
14244
        EX      DE,HL           ; transfer start to HL.
14245
        ADD     HL,BC           ; add to length.
14246
        PUSH    BC              ; save the length.
14247
        DEC     HL              ; point to end of string.
14248
        LD      ($5C4D),HL      ; save pointer in DEST.
14249
                                ; (updated by POINTERS if in workspace)
14250
        INC     BC              ; extra byte for letter.
14251
        INC     BC              ; two bytes
14252
        INC     BC              ; for the length of string.
14253
        LD      HL,($5C59)      ; address E_LINE.
14254
        DEC     HL              ; now end of VARS area.
14255
        CALL    L1655           ; routine MAKE-ROOM makes room for string.
14256
                                ; updating pointers including DEST.
14257
        LD      HL,($5C4D)      ; pick up pointer to end of string from DEST.
14258
        POP     BC              ; restore length from stack.
14259
        PUSH    BC              ; and save again on stack.
14260
        INC     BC              ; add a byte.
14261
        LDDR                    ; copy bytes from end to start.
14262
        EX      DE,HL           ; HL addresses length low
14263
        INC     HL              ; increase to address high byte
14264
        POP     BC              ; restore length to BC
14265
        LD      (HL),B          ; insert high byte
14266
        DEC     HL              ; address low byte location
14267
        LD      (HL),C          ; insert that byte
14268
        POP     AF              ; restore character and mask
14269
 
14270
;; L-FIRST
14271
L2BEA:  DEC     HL              ; address variable name
14272
        LD      (HL),A          ; and insert character.
14273
        LD      HL,($5C59)      ; load HL with E_LINE.
14274
        DEC     HL              ; now end of VARS area.
14275
        RET                     ; return
14276
 
14277
; ------------------------------------
14278
; Get last value from calculator stack
14279
; ------------------------------------
14280
;
14281
;
14282
 
14283
;; STK-FETCH
14284
L2BF1:  LD      HL,($5C65)      ; STKEND
14285
        DEC     HL              ;
14286
        LD      B,(HL)          ;
14287
        DEC     HL              ;
14288
        LD      C,(HL)          ;
14289
        DEC     HL              ;
14290
        LD      D,(HL)          ;
14291
        DEC     HL              ;
14292
        LD      E,(HL)          ;
14293
        DEC     HL              ;
14294
        LD      A,(HL)          ;
14295
        LD      ($5C65),HL      ; STKEND
14296
        RET                     ;
14297
 
14298
; ------------------
14299
; Handle DIM command
14300
; ------------------
14301
; e.g. DIM a(2,3,4,7): DIM a$(32) : DIM b$(20,2,768) : DIM c$(20000)
14302
; the only limit to dimensions is memory so, for example,
14303
; DIM a(2,2,2,2,2,2,2,2,2,2,2,2,2) is possible and creates a multi-
14304
; dimensional array of zeros. String arrays are initialized to spaces.
14305
; It is not possible to erase an array, but it can be re-dimensioned to
14306
; a minimal size of 1, after use, to free up memory.
14307
 
14308
;; DIM
14309
L2C02:  CALL    L28B2           ; routine LOOK-VARS
14310
 
14311
;; D-RPORT-C
14312
L2C05:  JP      NZ,L1C8A        ; jump to REPORT-C if a long-name variable.
14313
                                ; DIM lottery numbers(49) doesn't work.
14314
 
14315
        CALL    L2530           ; routine SYNTAX-Z
14316
        JR      NZ,L2C15        ; forward to D-RUN in runtime.
14317
 
14318
        RES     6,C             ; signal 'numeric' array even if string as
14319
                                ; this simplifies the syntax checking.
14320
 
14321
        CALL    L2996           ; routine STK-VAR checks syntax.
14322
        CALL    L1BEE           ; routine CHECK-END performs early exit ->
14323
 
14324
; the branch was here in runtime.
14325
 
14326
;; D-RUN
14327
L2C15:  JR      C,L2C1F         ; skip to D-LETTER if variable did not exist.
14328
                                ; else reclaim the old one.
14329
 
14330
        PUSH    BC              ; save type in C.
14331
        CALL    L19B8           ; routine NEXT-ONE find following variable
14332
                                ; or position of $80 end-marker.
14333
        CALL    L19E8           ; routine RECLAIM-2 reclaims the
14334
                                ; space between.
14335
        POP     BC              ; pop the type.
14336
 
14337
;; D-LETTER
14338
L2C1F:  SET     7,C             ; signal array.
14339
        LD      B,$00           ; initialize dimensions to zero and
14340
        PUSH    BC              ; save with the type.
14341
        LD      HL,$0001        ; make elements one character presuming string
14342
        BIT     6,C             ; is it a string ?
14343
        JR      NZ,L2C2D        ; forward to D-SIZE if so.
14344
 
14345
        LD      L,$05           ; make elements 5 bytes as is numeric.
14346
 
14347
;; D-SIZE
14348
L2C2D:  EX      DE,HL           ; save the element size in DE.
14349
 
14350
; now enter a loop to parse each of the integers in the list.
14351
 
14352
;; D-NO-LOOP
14353
L2C2E:  RST     20H             ; NEXT-CHAR
14354
        LD      H,$FF           ; disable limit check by setting HL high
14355
        CALL    L2ACC           ; routine INT-EXP1
14356
        JP      C,L2A20         ; to REPORT-3 if > 65280 and then some
14357
                                ; 'Subscript out of range'
14358
 
14359
        POP     HL              ; pop dimension counter, array type
14360
        PUSH    BC              ; save dimension size                     ***
14361
        INC     H               ; increment the dimension counter
14362
        PUSH    HL              ; save the dimension counter
14363
        LD      H,B             ; transfer size
14364
        LD      L,C             ; to HL
14365
        CALL    L2AF4           ; routine GET-HL*DE multiplies dimension by
14366
                                ; running total of size required initially
14367
                                ; 1 or 5.
14368
        EX      DE,HL           ; save running total in DE
14369
 
14370
        RST     18H             ; GET-CHAR
14371
        CP      $2C             ; is it ',' ?
14372
        JR      Z,L2C2E         ; loop back to D-NO-LOOP until all dimensions
14373
                                ; have been considered
14374
 
14375
; when loop complete continue.
14376
 
14377
        CP      $29             ; is it ')' ?
14378
        JR      NZ,L2C05        ; to D-RPORT-C with anything else
14379
                                ; 'Nonsense in BASIC'
14380
 
14381
 
14382
        RST     20H             ; NEXT-CHAR advances to next statement/CR
14383
 
14384
        POP     BC              ; pop dimension counter/type
14385
        LD      A,C             ; type to A
14386
 
14387
; now calculate space required for array variable
14388
 
14389
        LD      L,B             ; dimensions to L since these require 16 bits
14390
                                ; then this value will be doubled
14391
        LD      H,$00           ; set high byte to zero
14392
 
14393
; another four bytes are required for letter(1), total length(2), number of
14394
; dimensions(1) but since we have yet to double allow for two
14395
 
14396
        INC     HL              ; increment
14397
        INC     HL              ; increment
14398
 
14399
        ADD     HL,HL           ; now double giving 4 + dimensions * 2
14400
 
14401
        ADD     HL,DE           ; add to space required for array contents
14402
 
14403
        JP      C,L1F15         ; to REPORT-4 if > 65535
14404
                                ; 'Out of memory'
14405
 
14406
        PUSH    DE              ; save data space
14407
        PUSH    BC              ; save dimensions/type
14408
        PUSH    HL              ; save total space
14409
        LD      B,H             ; total space
14410
        LD      C,L             ; to BC
14411
        LD      HL,($5C59)      ; address E_LINE - first location after
14412
                                ; variables area
14413
        DEC     HL              ; point to location before - the $80 end-marker
14414
        CALL    L1655           ; routine MAKE-ROOM creates the space if
14415
                                ; memory is available.
14416
 
14417
        INC     HL              ; point to first new location and
14418
        LD      (HL),A          ; store letter/type
14419
 
14420
        POP     BC              ; pop total space
14421
        DEC     BC              ; exclude name
14422
        DEC     BC              ; exclude the 16-bit
14423
        DEC     BC              ; counter itself
14424
        INC     HL              ; point to next location the 16-bit counter
14425
        LD      (HL),C          ; insert low byte
14426
        INC     HL              ; address next
14427
        LD      (HL),B          ; insert high byte
14428
 
14429
        POP     BC              ; pop the number of dimensions.
14430
        LD      A,B             ; dimensions to A
14431
        INC     HL              ; address next
14432
        LD      (HL),A          ; and insert "No. of dims"
14433
 
14434
        LD      H,D             ; transfer DE space + 1 from make-room
14435
        LD      L,E             ; to HL
14436
        DEC     DE              ; set DE to next location down.
14437
        LD      (HL),$00        ; presume numeric and insert a zero
14438
        BIT     6,C             ; test bit 6 of C. numeric or string ?
14439
        JR      Z,L2C7C         ; skip to DIM-CLEAR if numeric
14440
 
14441
        LD      (HL),$20        ; place a space character in HL
14442
 
14443
;; DIM-CLEAR
14444
L2C7C:  POP     BC              ; pop the data length
14445
 
14446
        LDDR                    ; LDDR sets to zeros or spaces
14447
 
14448
; The number of dimensions is still in A.
14449
; A loop is now entered to insert the size of each dimension that was pushed
14450
; during the D-NO-LOOP working downwards from position before start of data.
14451
 
14452
;; DIM-SIZES
14453
L2C7F:  POP     BC              ; pop a dimension size                    ***
14454
        LD      (HL),B          ; insert high byte at position
14455
        DEC     HL              ; next location down
14456
        LD      (HL),C          ; insert low byte
14457
        DEC     HL              ; next location down
14458
        DEC     A               ; decrement dimension counter
14459
        JR      NZ,L2C7F        ; back to DIM-SIZES until all done.
14460
 
14461
        RET                     ; return.
14462
 
14463
; -----------------------------
14464
; Check whether digit or letter
14465
; -----------------------------
14466
; This routine checks that the character in A is alphanumeric
14467
; returning with carry set if so.
14468
 
14469
;; ALPHANUM
14470
L2C88:  CALL    L2D1B           ; routine NUMERIC will reset carry if so.
14471
        CCF                     ; Complement Carry Flag
14472
        RET     C               ; Return if numeric else continue into
14473
                                ; next routine.
14474
 
14475
; This routine checks that the character in A is alphabetic
14476
 
14477
;; ALPHA
14478
L2C8D:  CP      $41             ; less than 'A' ?
14479
        CCF                     ; Complement Carry Flag
14480
        RET     NC              ; return if so
14481
 
14482
        CP      $5B             ; less than 'Z'+1 ?
14483
        RET     C               ; is within first range
14484
 
14485
        CP      $61             ; less than 'a' ?
14486
        CCF                     ; Complement Carry Flag
14487
        RET     NC              ; return if so.
14488
 
14489
        CP      $7B             ; less than 'z'+1 ?
14490
        RET                     ; carry set if within a-z.
14491
 
14492
; -------------------------
14493
; Decimal to floating point
14494
; -------------------------
14495
; This routine finds the floating point number represented by an expression
14496
; beginning with BIN, '.' or a digit.
14497
; Note that BIN need not have any '0's or '1's after it.
14498
; BIN is really just a notational symbol and not a function.
14499
 
14500
;; DEC-TO-FP
14501
L2C9B:  CP      $C4             ; 'BIN' token ?
14502
        JR      NZ,L2CB8        ; to NOT-BIN if not
14503
 
14504
        LD      DE,$0000        ; initialize 16 bit buffer register.
14505
 
14506
;; BIN-DIGIT
14507
L2CA2:  RST     20H             ; NEXT-CHAR
14508
        SUB     $31             ; '1'
14509
        ADC     A,$00           ; will be zero if '1' or '0'
14510
                                ; carry will be set if was '0'
14511
        JR      NZ,L2CB3        ; forward to BIN-END if result not zero
14512
 
14513
        EX      DE,HL           ; buffer to HL
14514
        CCF                     ; Carry now set if originally '1'
14515
        ADC     HL,HL           ; shift the carry into HL
14516
        JP      C,L31AD         ; to REPORT-6 if overflow - too many digits
14517
                                ; after first '1'. There can be an unlimited
14518
                                ; number of leading zeros.
14519
                                ; 'Number too big' - raise an error
14520
 
14521
        EX      DE,HL           ; save the buffer
14522
        JR      L2CA2           ; back to BIN-DIGIT for more digits
14523
 
14524
; ---
14525
 
14526
;; BIN-END
14527
L2CB3:  LD      B,D             ; transfer 16 bit buffer
14528
        LD      C,E             ; to BC register pair.
14529
        JP      L2D2B           ; JUMP to STACK-BC to put on calculator stack
14530
 
14531
; ---
14532
 
14533
; continue here with .1,  42, 3.14, 5., 2.3 E -4
14534
 
14535
;; NOT-BIN
14536
L2CB8:  CP      $2E             ; '.' - leading decimal point ?
14537
        JR      Z,L2CCB         ; skip to DECIMAL if so.
14538
 
14539
        CALL    L2D3B           ; routine INT-TO-FP to evaluate all digits
14540
                                ; This number 'x' is placed on stack.
14541
        CP      $2E             ; '.' - mid decimal point ?
14542
 
14543
        JR      NZ,L2CEB        ; to E-FORMAT if not to consider that format
14544
 
14545
        RST     20H             ; NEXT-CHAR
14546
        CALL    L2D1B           ; routine NUMERIC returns carry reset if 0-9
14547
 
14548
        JR      C,L2CEB         ; to E-FORMAT if not a digit e.g. '1.'
14549
 
14550
        JR      L2CD5           ; to DEC-STO-1 to add the decimal part to 'x'
14551
 
14552
; ---
14553
 
14554
; a leading decimal point has been found in a number.
14555
 
14556
;; DECIMAL
14557
L2CCB:  RST     20H             ; NEXT-CHAR
14558
        CALL    L2D1B           ; routine NUMERIC will reset carry if digit
14559
 
14560
;; DEC-RPT-C
14561
L2CCF:  JP      C,L1C8A         ; to REPORT-C if just a '.'
14562
                                ; raise 'Nonsense in BASIC'
14563
 
14564
; since there is no leading zero put one on the calculator stack.
14565
 
14566
        RST     28H             ;; FP-CALC
14567
        DEFB    $A0             ;;stk-zero  ; 0.
14568
        DEFB    $38             ;;end-calc
14569
 
14570
; If rejoining from earlier there will be a value 'x' on stack.
14571
; If continuing from above the value zero.
14572
; Now store 1 in mem-0.
14573
; Note. At each pass of the digit loop this will be divided by ten.
14574
 
14575
;; DEC-STO-1
14576
L2CD5:  RST     28H             ;; FP-CALC
14577
        DEFB    $A1             ;;stk-one   ;x or 0,1.
14578
        DEFB    $C0             ;;st-mem-0  ;x or 0,1.
14579
        DEFB    $02             ;;delete    ;x or 0.
14580
        DEFB    $38             ;;end-calc
14581
 
14582
 
14583
;; NXT-DGT-1
14584
L2CDA:  RST     18H             ; GET-CHAR
14585
        CALL    L2D22           ; routine STK-DIGIT stacks single digit 'd'
14586
        JR      C,L2CEB         ; exit to E-FORMAT when digits exhausted  >
14587
 
14588
 
14589
        RST     28H             ;; FP-CALC   ;x or 0,d.           first pass.
14590
        DEFB    $E0             ;;get-mem-0  ;x or 0,d,1.
14591
        DEFB    $A4             ;;stk-ten    ;x or 0,d,1,10.
14592
        DEFB    $05             ;;division   ;x or 0,d,1/10.
14593
        DEFB    $C0             ;;st-mem-0   ;x or 0,d,1/10.
14594
        DEFB    $04             ;;multiply   ;x or 0,d/10.
14595
        DEFB    $0F             ;;addition   ;x or 0 + d/10.
14596
        DEFB    $38             ;;end-calc   last value.
14597
 
14598
        RST     20H             ; NEXT-CHAR  moves to next character
14599
        JR      L2CDA           ; back to NXT-DGT-1
14600
 
14601
; ---
14602
 
14603
; although only the first pass is shown it can be seen that at each pass
14604
; the new less significant digit is multiplied by an increasingly smaller
14605
; factor (1/100, 1/1000, 1/10000 ... ) before being added to the previous
14606
; last value to form a new last value.
14607
 
14608
; Finally see if an exponent has been input.
14609
 
14610
;; E-FORMAT
14611
L2CEB:  CP      $45             ; is character 'E' ?
14612
        JR      Z,L2CF2         ; to SIGN-FLAG if so
14613
 
14614
        CP      $65             ; 'e' is acceptable as well.
14615
        RET     NZ              ; return as no exponent.
14616
 
14617
;; SIGN-FLAG
14618
L2CF2:  LD      B,$FF           ; initialize temporary sign byte to $FF
14619
 
14620
        RST     20H             ; NEXT-CHAR
14621
        CP      $2B             ; is character '+' ?
14622
        JR      Z,L2CFE         ; to SIGN-DONE
14623
 
14624
        CP      $2D             ; is character '-' ?
14625
        JR      NZ,L2CFF        ; to ST-E-PART as no sign
14626
 
14627
        INC     B               ; set sign to zero
14628
 
14629
; now consider digits of exponent.
14630
; Note. incidentally this is the only occasion in Spectrum BASIC when an
14631
; expression may not be used when a number is expected.
14632
 
14633
;; SIGN-DONE
14634
L2CFE:  RST     20H             ; NEXT-CHAR
14635
 
14636
;; ST-E-PART
14637
L2CFF:  CALL    L2D1B           ; routine NUMERIC
14638
        JR      C,L2CCF         ; to DEC-RPT-C if not
14639
                                ; raise 'Nonsense in BASIC'.
14640
 
14641
        PUSH    BC              ; save sign (in B)
14642
        CALL    L2D3B           ; routine INT-TO-FP places exponent on stack
14643
        CALL    L2DD5           ; routine FP-TO-A  transfers it to A
14644
        POP     BC              ; restore sign
14645
        JP      C,L31AD         ; to REPORT-6 if overflow (over 255)
14646
                                ; raise 'Number too big'.
14647
 
14648
        AND     A               ; set flags
14649
        JP      M,L31AD         ; to REPORT-6 if over '127'.
14650
                                ; raise 'Number too big'.
14651
                                ; 127 is still way too high and it is
14652
                                ; impossible to enter an exponent greater
14653
                                ; than 39 from the keyboard. The error gets
14654
                                ; raised later in E-TO-FP so two different
14655
                                ; error messages depending how high A is.
14656
 
14657
        INC     B               ; $FF to $00 or $00 to $01 - expendable now.
14658
        JR      Z,L2D18         ; forward to E-FP-JUMP if exponent positive
14659
 
14660
        NEG                     ; Negate the exponent.
14661
 
14662
;; E-FP-JUMP
14663
L2D18:  JP      L2D4F           ; JUMP forward to E-TO-FP to assign to
14664
                                ; last value x on stack x * 10 to power A
14665
                                ; a relative jump would have done.
14666
 
14667
; ---------------------
14668
; Check for valid digit
14669
; ---------------------
14670
; This routine checks that the ASCII character in A is numeric
14671
; returning with carry reset if so.
14672
 
14673
;; NUMERIC
14674
L2D1B:  CP      $30             ; '0'
14675
        RET     C               ; return if less than zero character.
14676
 
14677
        CP      $3A             ; The upper test is '9'
14678
        CCF                     ; Complement Carry Flag
14679
        RET                     ; Return - carry clear if character '0' - '9'
14680
 
14681
; -----------
14682
; Stack Digit
14683
; -----------
14684
; This subroutine is called from INT-TO-FP and DEC-TO-FP to stack a digit
14685
; on the calculator stack.
14686
 
14687
;; STK-DIGIT
14688
L2D22:  CALL    L2D1B           ; routine NUMERIC
14689
        RET     C               ; return if not numeric character
14690
 
14691
        SUB     $30             ; convert from ASCII to digit
14692
 
14693
; -----------------
14694
; Stack accumulator
14695
; -----------------
14696
;
14697
;
14698
 
14699
;; STACK-A
14700
L2D28:  LD      C,A             ; transfer to C
14701
        LD      B,$00           ; and make B zero
14702
 
14703
; ----------------------
14704
; Stack BC register pair
14705
; ----------------------
14706
;
14707
 
14708
;; STACK-BC
14709
L2D2B:  LD      IY,$5C3A        ; re-initialize ERR_NR
14710
 
14711
        XOR     A               ; clear to signal small integer
14712
        LD      E,A             ; place in E for sign
14713
        LD      D,C             ; LSB to D
14714
        LD      C,B             ; MSB to C
14715
        LD      B,A             ; last byte not used
14716
        CALL    L2AB6           ; routine STK-STORE
14717
 
14718
        RST     28H             ;; FP-CALC
14719
        DEFB    $38             ;;end-calc  make HL = STKEND-5
14720
 
14721
        AND     A               ; clear carry
14722
        RET                     ; before returning
14723
 
14724
; -------------------------
14725
; Integer to floating point
14726
; -------------------------
14727
; This routine places one or more digits found in a BASIC line
14728
; on the calculator stack multiplying the previous value by ten each time
14729
; before adding in the new digit to form a last value on calculator stack.
14730
 
14731
;; INT-TO-FP
14732
L2D3B:  PUSH    AF              ; save first character
14733
 
14734
        RST     28H             ;; FP-CALC
14735
        DEFB    $A0             ;;stk-zero    ; v=0. initial value
14736
        DEFB    $38             ;;end-calc
14737
 
14738
        POP     AF              ; fetch first character back.
14739
 
14740
;; NXT-DGT-2
14741
L2D40:  CALL    L2D22           ; routine STK-DIGIT puts 0-9 on stack
14742
        RET     C               ; will return when character is not numeric >
14743
 
14744
        RST     28H             ;; FP-CALC    ; v, d.
14745
        DEFB    $01             ;;exchange    ; d, v.
14746
        DEFB    $A4             ;;stk-ten     ; d, v, 10.
14747
        DEFB    $04             ;;multiply    ; d, v*10.
14748
        DEFB    $0F             ;;addition    ; d + v*10 = newvalue
14749
        DEFB    $38             ;;end-calc    ; v.
14750
 
14751
        CALL    L0074           ; routine CH-ADD+1 get next character
14752
        JR      L2D40           ; back to NXT-DGT-2 to process as a digit
14753
 
14754
 
14755
;*********************************
14756
;** Part 9. ARITHMETIC ROUTINES **
14757
;*********************************
14758
 
14759
; --------------------------
14760
; E-format to floating point
14761
; --------------------------
14762
; This subroutine is used by the PRINT-FP routine and the decimal to FP
14763
; routines to stack a number expressed in exponent format.
14764
; Note. Though not used by the ROM as such, it has also been set up as
14765
; a unary calculator literal but this will not work as the accumulator
14766
; is not available from within the calculator.
14767
 
14768
; on entry there is a value x on the calculator stack and an exponent of ten
14769
; in A.    The required value is x + 10 ^ A
14770
 
14771
;; e-to-fp
14772
;; E-TO-FP
14773
L2D4F:  RLCA                    ; this will set the          x.
14774
        RRCA                    ; carry if bit 7 is set
14775
 
14776
        JR      NC,L2D55        ; to E-SAVE  if positive.
14777
 
14778
        CPL                     ; make negative positive
14779
        INC     A               ; without altering carry.
14780
 
14781
;; E-SAVE
14782
L2D55:  PUSH    AF              ; save positive exp and sign in carry
14783
 
14784
        LD      HL,$5C92        ; address MEM-0
14785
 
14786
        CALL    L350B           ; routine FP-0/1
14787
                                ; places an integer zero, if no carry,
14788
                                ; else a one in mem-0 as a sign flag
14789
 
14790
        RST     28H             ;; FP-CALC
14791
        DEFB    $A4             ;;stk-ten                    x, 10.
14792
        DEFB    $38             ;;end-calc
14793
 
14794
        POP     AF              ; pop the exponent.
14795
 
14796
; now enter a loop
14797
 
14798
;; E-LOOP
14799
L2D60:  SRL     A               ; 0>76543210>C
14800
 
14801
        JR      NC,L2D71        ; forward to E-TST-END if no bit
14802
 
14803
        PUSH    AF              ; save shifted exponent.
14804
 
14805
        RST     28H             ;; FP-CALC
14806
        DEFB    $C1             ;;st-mem-1                   x, 10.
14807
        DEFB    $E0             ;;get-mem-0                  x, 10, (0/1).
14808
        DEFB    $00             ;;jump-true
14809
 
14810
        DEFB    $04             ;;to L2D6D, E-DIVSN
14811
 
14812
        DEFB    $04             ;;multiply                   x*10.
14813
        DEFB    $33             ;;jump
14814
 
14815
        DEFB    $02             ;;to L2D6E, E-FETCH
14816
 
14817
;; E-DIVSN
14818
L2D6D:  DEFB    $05             ;;division                   x/10.
14819
 
14820
;; E-FETCH
14821
L2D6E:  DEFB    $E1             ;;get-mem-1                  x/10 or x*10, 10.
14822
        DEFB    $38             ;;end-calc                   new x, 10.
14823
 
14824
        POP     AF              ; restore shifted exponent
14825
 
14826
; the loop branched to here with no carry
14827
 
14828
;; E-TST-END
14829
L2D71:  JR      Z,L2D7B         ; forward to E-END  if A emptied of bits
14830
 
14831
        PUSH    AF              ; re-save shifted exponent
14832
 
14833
        RST     28H             ;; FP-CALC
14834
        DEFB    $31             ;;duplicate                  new x, 10, 10.
14835
        DEFB    $04             ;;multiply                   new x, 100.
14836
        DEFB    $38             ;;end-calc
14837
 
14838
        POP     AF              ; restore shifted exponent
14839
        JR      L2D60           ; back to E-LOOP  until all bits done.
14840
 
14841
; ---
14842
 
14843
; although only the first pass is shown it can be seen that for each set bit
14844
; representing a power of two, x is multiplied or divided by the
14845
; corresponding power of ten.
14846
 
14847
;; E-END
14848
L2D7B:  RST     28H             ;; FP-CALC                   final x, factor.
14849
        DEFB    $02             ;;delete                     final x.
14850
        DEFB    $38             ;;end-calc                   x.
14851
 
14852
        RET                     ; return
14853
 
14854
 
14855
 
14856
 
14857
; -------------
14858
; Fetch integer
14859
; -------------
14860
; This routine is called by the mathematical routines - FP-TO-BC, PRINT-FP,
14861
; mult, re-stack and negate to fetch an integer from address HL.
14862
; HL points to the stack or a location in MEM and no deletion occurs.
14863
; If the number is negative then a similar process to that used in INT-STORE
14864
; is used to restore the twos complement number to normal in DE and a sign
14865
; in C.
14866
 
14867
;; INT-FETCH
14868
L2D7F:  INC     HL              ; skip zero indicator.
14869
        LD      C,(HL)          ; fetch sign to C
14870
        INC     HL              ; address low byte
14871
        LD      A,(HL)          ; fetch to A
14872
        XOR     C               ; two's complement
14873
        SUB     C               ;
14874
        LD      E,A             ; place in E
14875
        INC     HL              ; address high byte
14876
        LD      A,(HL)          ; fetch to A
14877
        ADC     A,C             ; two's complement
14878
        XOR     C               ;
14879
        LD      D,A             ; place in D
14880
        RET                     ; return
14881
 
14882
; ------------------------
14883
; Store a positive integer
14884
; ------------------------
14885
; This entry point is not used in this ROM but would
14886
; store any integer as positive.
14887
 
14888
;; p-int-sto
14889
L2D8C:  LD      C,$00           ; make sign byte positive and continue
14890
 
14891
; -------------
14892
; Store integer
14893
; -------------
14894
; this routine stores an integer in DE at address HL.
14895
; It is called from mult, truncate, negate and sgn.
14896
; The sign byte $00 +ve or $FF -ve is in C.
14897
; If negative, the number is stored in 2's complement form so that it is
14898
; ready to be added.
14899
 
14900
;; INT-STORE
14901
L2D8E:  PUSH    HL              ; preserve HL
14902
 
14903
        LD      (HL),$00        ; first byte zero shows integer not exponent
14904
        INC     HL              ;
14905
        LD      (HL),C          ; then store the sign byte
14906
        INC     HL              ;
14907
                                ; e.g.             +1             -1
14908
        LD      A,E             ; fetch low byte   00000001       00000001
14909
        XOR     C               ; xor sign         00000000   or  11111111
14910
                                ; gives            00000001   or  11111110
14911
        SUB     C               ; sub sign         00000000   or  11111111
14912
                                ; gives            00000001>0 or  11111111>C
14913
        LD      (HL),A          ; store 2's complement.
14914
        INC     HL              ;
14915
        LD      A,D             ; high byte        00000000       00000000
14916
        ADC     A,C             ; sign             00000000<0     11111111
14917
                                ; gives            00000000   or  00000000
14918
        XOR     C               ; xor sign         00000000       11111111
14919
        LD      (HL),A          ; store 2's complement.
14920
        INC     HL              ;
14921
        LD      (HL),$00        ; last byte always zero for integers.
14922
                                ; is not used and need not be looked at when
14923
                                ; testing for zero but comes into play should
14924
                                ; an integer be converted to fp.
14925
        POP     HL              ; restore HL
14926
        RET                     ; return.
14927
 
14928
 
14929
; -----------------------------
14930
; Floating point to BC register
14931
; -----------------------------
14932
; This routine gets a floating point number e.g. 127.4 from the calculator
14933
; stack to the BC register.
14934
 
14935
;; FP-TO-BC
14936
L2DA2:  RST     28H             ;; FP-CALC            set HL to
14937
        DEFB    $38             ;;end-calc            point to last value.
14938
 
14939
        LD      A,(HL)          ; get first of 5 bytes
14940
        AND     A               ; and test
14941
        JR      Z,L2DAD         ; forward to FP-DELETE if an integer
14942
 
14943
; The value is first rounded up and then converted to integer.
14944
 
14945
        RST     28H             ;; FP-CALC           x.
14946
        DEFB    $A2             ;;stk-half           x. 1/2.
14947
        DEFB    $0F             ;;addition           x + 1/2.
14948
        DEFB    $27             ;;int                int(x + .5)
14949
        DEFB    $38             ;;end-calc
14950
 
14951
; now delete but leave HL pointing at integer
14952
 
14953
;; FP-DELETE
14954
L2DAD:  RST     28H             ;; FP-CALC
14955
        DEFB    $02             ;;delete
14956
        DEFB    $38             ;;end-calc
14957
 
14958
        PUSH    HL              ; save pointer.
14959
        PUSH    DE              ; and STKEND.
14960
        EX      DE,HL           ; make HL point to exponent/zero indicator
14961
        LD      B,(HL)          ; indicator to B
14962
        CALL    L2D7F           ; routine INT-FETCH
14963
                                ; gets int in DE sign byte to C
14964
                                ; but meaningless values if a large integer
14965
 
14966
        XOR     A               ; clear A
14967
        SUB     B               ; subtract indicator byte setting carry
14968
                                ; if not a small integer.
14969
 
14970
        BIT     7,C             ; test a bit of the sign byte setting zero
14971
                                ; if positive.
14972
 
14973
        LD      B,D             ; transfer int
14974
        LD      C,E             ; to BC
14975
        LD      A,E             ; low byte to A as a useful return value.
14976
 
14977
        POP     DE              ; pop STKEND
14978
        POP     HL              ; and pointer to last value
14979
        RET                     ; return
14980
                                ; if carry is set then the number was too big.
14981
 
14982
; ------------
14983
; LOG(2^A)
14984
; ------------
14985
; This routine is used when printing floating point numbers to calculate
14986
; the number of digits before the decimal point.
14987
 
14988
; first convert a one-byte signed integer to its five byte form.
14989
 
14990
;; LOG(2^A)
14991
L2DC1:  LD      D,A             ; store a copy of A in D.
14992
        RLA                     ; test sign bit of A.
14993
        SBC     A,A             ; now $FF if negative or $00
14994
        LD      E,A             ; sign byte to E.
14995
        LD      C,A             ; and to C
14996
        XOR     A               ; clear A
14997
        LD      B,A             ; and B.
14998
        CALL    L2AB6           ; routine STK-STORE stacks number AEDCB
14999
 
15000
;  so 00 00 XX 00 00 (positive) or 00 FF XX FF 00 (negative).
15001
;  i.e. integer indicator, sign byte, low, high, unused.
15002
 
15003
; now multiply exponent by log to the base 10 of two.
15004
 
15005
        RST      28H            ;; FP-CALC
15006
 
15007
        DEFB    $34             ;;stk-data                      .30103 (log 2)
15008
        DEFB    $EF             ;;Exponent: $7F, Bytes: 4
15009
        DEFB    $1A,$20,$9A,$85 ;;
15010
        DEFB    $04             ;;multiply
15011
 
15012
        DEFB    $27             ;;int
15013
 
15014
        DEFB    $38             ;;end-calc
15015
 
15016
; -------------------
15017
; Floating point to A
15018
; -------------------
15019
; this routine collects a floating point number from the stack into the
15020
; accumulator returning carry set if not in range 0 - 255.
15021
; Not all the calling routines raise an error with overflow so no attempt
15022
; is made to produce an error report here.
15023
 
15024
;; FP-TO-A
15025
L2DD5:  CALL    L2DA2           ; routine FP-TO-BC returns with C in A also.
15026
        RET     C               ; return with carry set if > 65535, overflow
15027
 
15028
        PUSH    AF              ; save the value and flags
15029
        DEC     B               ; and test that
15030
        INC     B               ; the high byte is zero.
15031
        JR      Z,L2DE1         ; forward  FP-A-END if zero
15032
 
15033
; else there has been 8-bit overflow
15034
 
15035
        POP     AF              ; retrieve the value
15036
        SCF                     ; set carry flag to show overflow
15037
        RET                     ; and return.
15038
 
15039
; ---
15040
 
15041
;; FP-A-END
15042
L2DE1:  POP     AF              ; restore value and success flag and
15043
        RET                     ; return.
15044
 
15045
 
15046
; -----------------------------
15047
; Print a floating point number
15048
; -----------------------------
15049
; Not a trivial task.
15050
; Begin by considering whether to print a leading sign for negative numbers.
15051
 
15052
;; PRINT-FP
15053
L2DE3:  RST     28H             ;; FP-CALC
15054
        DEFB    $31             ;;duplicate
15055
        DEFB    $36             ;;less-0
15056
        DEFB    $00             ;;jump-true
15057
 
15058
        DEFB    $0B             ;;to L2DF2, PF-NEGTVE
15059
 
15060
        DEFB    $31             ;;duplicate
15061
        DEFB    $37             ;;greater-0
15062
        DEFB    $00             ;;jump-true
15063
 
15064
        DEFB    $0D             ;;to L2DF8, PF-POSTVE
15065
 
15066
; must be zero itself
15067
 
15068
        DEFB    $02             ;;delete
15069
        DEFB    $38             ;;end-calc
15070
 
15071
        LD      A,$30           ; prepare the character '0'
15072
 
15073
        RST     10H             ; PRINT-A
15074
        RET                     ; return.                 ->
15075
; ---
15076
 
15077
;; PF-NEGTVE
15078
L2DF2:  DEFB    $2A             ;;abs
15079
        DEFB    $38             ;;end-calc
15080
 
15081
        LD      A,$2D           ; the character '-'
15082
 
15083
        RST     10H             ; PRINT-A
15084
 
15085
; and continue to print the now positive number.
15086
 
15087
        RST     28H             ;; FP-CALC
15088
 
15089
;; PF-POSTVE
15090
L2DF8:  DEFB    $A0             ;;stk-zero     x,0.     begin by
15091
        DEFB    $C3             ;;st-mem-3     x,0.     clearing a temporary
15092
        DEFB    $C4             ;;st-mem-4     x,0.     output buffer to
15093
        DEFB    $C5             ;;st-mem-5     x,0.     fifteen zeros.
15094
        DEFB    $02             ;;delete       x.
15095
        DEFB    $38             ;;end-calc     x.
15096
 
15097
        EXX                     ; in case called from 'str$' then save the
15098
        PUSH    HL              ; pointer to whatever comes after
15099
        EXX                     ; str$ as H'L' will be used.
15100
 
15101
; now enter a loop?
15102
 
15103
;; PF-LOOP
15104
L2E01:  RST     28H             ;; FP-CALC
15105
        DEFB    $31             ;;duplicate    x,x.
15106
        DEFB    $27             ;;int          x,int x.
15107
        DEFB    $C2             ;;st-mem-2     x,int x.
15108
        DEFB    $03             ;;subtract     x-int x.     fractional part.
15109
        DEFB    $E2             ;;get-mem-2    x-int x, int x.
15110
        DEFB    $01             ;;exchange     int x, x-int x.
15111
        DEFB    $C2             ;;st-mem-2     int x, x-int x.
15112
        DEFB    $02             ;;delete       int x.
15113
        DEFB    $38             ;;end-calc     int x.
15114
                                ;
15115
                                ; mem-2 holds the fractional part.
15116
 
15117
; HL points to last value int x
15118
 
15119
        LD      A,(HL)          ; fetch exponent of int x.
15120
        AND     A               ; test
15121
        JR      NZ,L2E56        ; forward to PF-LARGE if a large integer
15122
                                ; > 65535
15123
 
15124
; continue with small positive integer components in range 0 - 65535
15125
; if original number was say .999 then this integer component is zero.
15126
 
15127
        CALL    L2D7F           ; routine INT-FETCH gets x in DE
15128
                                ; (but x is not deleted)
15129
 
15130
        LD      B,$10           ; set B, bit counter, to 16d
15131
 
15132
        LD      A,D             ; test if
15133
        AND     A               ; high byte is zero
15134
        JR      NZ,L2E1E        ; forward to PF-SAVE if 16-bit integer.
15135
 
15136
; and continue with integer in range 0 - 255.
15137
 
15138
        OR      E               ; test the low byte for zero
15139
                                ; i.e. originally just point something or other.
15140
        JR      Z,L2E24         ; forward if so to PF-SMALL
15141
 
15142
;
15143
 
15144
        LD      D,E             ; transfer E to D
15145
        LD      B,$08           ; and reduce the bit counter to 8.
15146
 
15147
;; PF-SAVE
15148
L2E1E:  PUSH    DE              ; save the part before decimal point.
15149
        EXX                     ;
15150
        POP     DE              ; and pop in into D'E'
15151
        EXX                     ;
15152
        JR      L2E7B           ; forward to PF-BITS
15153
 
15154
; ---------------------
15155
 
15156
; the branch was here when 'int x' was found to be zero as in say 0.5.
15157
; The zero has been fetched from the calculator stack but not deleted and
15158
; this should occur now. This omission leaves the stack unbalanced and while
15159
; that causes no problems with a simple PRINT statement, it will if str$ is
15160
; being used in an expression e.g. "2" + STR$ 0.5 gives the result "0.5"
15161
; instead of the expected result "20.5".
15162
; credit Tony Stratton, 1982.
15163
; A DEFB 02 delete is required immediately on using the calculator.
15164
 
15165
;; PF-SMALL
15166
L2E24:  RST     28H             ;; FP-CALC       int x = 0.
15167
L2E25:  DEFB    $E2             ;;get-mem-2      int x = 0, x-int x.
15168
        DEFB    $38             ;;end-calc
15169
 
15170
        LD      A,(HL)          ; fetch exponent of positive fractional number
15171
        SUB     $7E             ; subtract
15172
 
15173
        CALL    L2DC1           ; routine LOG(2^A) calculates leading digits.
15174
 
15175
        LD      D,A             ; transfer count to D
15176
        LD      A,($5CAC)       ; fetch total MEM-5-1
15177
        SUB     D               ;
15178
        LD      ($5CAC),A       ; MEM-5-1
15179
        LD      A,D             ;
15180
        CALL    L2D4F           ; routine E-TO-FP
15181
 
15182
        RST     28H             ;; FP-CALC
15183
        DEFB    $31             ;;duplicate
15184
        DEFB    $27             ;;int
15185
        DEFB    $C1             ;;st-mem-1
15186
        DEFB    $03             ;;subtract
15187
        DEFB    $E1             ;;get-mem-1
15188
        DEFB    $38             ;;end-calc
15189
 
15190
        CALL    L2DD5           ; routine FP-TO-A
15191
 
15192
        PUSH    HL              ; save HL
15193
        LD      ($5CA1),A       ; MEM-3-1
15194
        DEC     A               ;
15195
        RLA                     ;
15196
        SBC     A,A             ;
15197
        INC     A               ;
15198
 
15199
        LD      HL,$5CAB        ; address MEM-5-1 leading digit counter
15200
        LD      (HL),A          ; store counter
15201
        INC     HL              ; address MEM-5-2 total digits
15202
        ADD     A,(HL)          ; add counter to contents
15203
        LD      (HL),A          ; and store updated value
15204
        POP     HL              ; restore HL
15205
 
15206
        JP      L2ECF           ; JUMP forward to PF-FRACTN
15207
 
15208
; ---
15209
 
15210
; Note. while it would be pedantic to comment on every occasion a JP
15211
; instruction could be replaced with a JR instruction, this applies to the
15212
; above, which is useful if you wish to correct the unbalanced stack error
15213
; by inserting a 'DEFB 02 delete' at L2E25, and maintain main addresses.
15214
 
15215
; the branch was here with a large positive integer > 65535 e.g. 123456789
15216
; the accumulator holds the exponent.
15217
 
15218
;; PF-LARGE
15219
L2E56:  SUB     $80             ; make exponent positive
15220
        CP      $1C             ; compare to 28
15221
        JR      C,L2E6F         ; to PF-MEDIUM if integer <= 2^27
15222
 
15223
        CALL    L2DC1           ; routine LOG(2^A)
15224
        SUB     $07             ;
15225
        LD      B,A             ;
15226
        LD      HL,$5CAC        ; address MEM-5-1 the leading digits counter.
15227
        ADD     A,(HL)          ; add A to contents
15228
        LD      (HL),A          ; store updated value.
15229
        LD      A,B             ;
15230
        NEG                     ; negate
15231
        CALL    L2D4F           ; routine E-TO-FP
15232
        JR      L2E01           ; back to PF-LOOP
15233
 
15234
; ----------------------------
15235
 
15236
;; PF-MEDIUM
15237
L2E6F:  EX      DE,HL           ;
15238
        CALL    L2FBA           ; routine FETCH-TWO
15239
        EXX                     ;
15240
        SET     7,D             ;
15241
        LD      A,L             ;
15242
        EXX                     ;
15243
        SUB     $80             ;
15244
        LD      B,A             ;
15245
 
15246
; the branch was here to handle bits in DE with 8 or 16 in B  if small int
15247
; and integer in D'E', 6 nibbles will accommodate 065535 but routine does
15248
; 32-bit numbers as well from above
15249
 
15250
;; PF-BITS
15251
L2E7B:  SLA     E               ;  C
15252
        RL      D               ;  C
15253
        EXX                     ;
15254
        RL      E               ;  C
15255
        RL      D               ;  C
15256
        EXX                     ;
15257
 
15258
        LD      HL,$5CAA        ; set HL to mem-4-5th last byte of buffer
15259
        LD      C,$05           ; set byte count to 5 -  10 nibbles
15260
 
15261
;; PF-BYTES
15262
L2E8A:  LD      A,(HL)          ; fetch 0 or prev value
15263
        ADC     A,A             ; shift left add in carry    C
15264
 
15265
        DAA                     ; Decimal Adjust Accumulator.
15266
                                ; if greater than 9 then the left hand
15267
                                ; nibble is incremented. If greater than
15268
                                ; 99 then adjusted and carry set.
15269
                                ; so if we'd built up 7 and a carry came in
15270
                                ;      0000 0111 < C
15271
                                ;      0000 1111
15272
                                ; daa     1 0101  which is 15 in BCD
15273
 
15274
        LD      (HL),A          ; put back
15275
        DEC     HL              ; work down thru mem 4
15276
        DEC     C               ; decrease the 5 counter.
15277
        JR      NZ,L2E8A        ; back to PF-BYTES until the ten nibbles rolled
15278
 
15279
        DJNZ    L2E7B           ; back to PF-BITS until 8 or 16 (or 32) done
15280
 
15281
; at most 9 digits for 32-bit number will have been loaded with digits
15282
; each of the 9 nibbles in mem 4 is placed into ten bytes in mem-3 and mem 4
15283
; unless the nibble is zero as the buffer is already zero.
15284
; ( or in the case of mem-5 will become zero as a result of RLD instruction )
15285
 
15286
        XOR     A               ; clear to accept
15287
        LD      HL,$5CA6        ; address MEM-4-0 byte destination.
15288
        LD      DE,$5CA1        ; address MEM-3-0 nibble source.
15289
        LD      B,$09           ; the count is 9 (not ten) as the first
15290
                                ; nibble is known to be blank.
15291
 
15292
        RLD                     ; shift RH nibble to left in (HL)
15293
                                ;    A           (HL)
15294
                                ; 0000 0000 < 0000 3210
15295
                                ; 0000 0000   3210 0000
15296
                                ; A picks up the blank nibble
15297
 
15298
 
15299
        LD      C,$FF           ; set a flag to indicate when a significant
15300
                                ; digit has been encountered.
15301
 
15302
;; PF-DIGITS
15303
L2EA1:  RLD                     ; pick up leftmost nibble from (HL)
15304
                                ;    A           (HL)
15305
                                ; 0000 0000 < 7654 3210
15306
                                ; 0000 7654   3210 0000
15307
 
15308
 
15309
        JR      NZ,L2EA9        ; to PF-INSERT if non-zero value picked up.
15310
 
15311
        DEC     C               ; test
15312
        INC     C               ; flag
15313
        JR      NZ,L2EB3        ; skip forward to PF-TEST-2 if flag still $FF
15314
                                ; indicating this is a leading zero.
15315
 
15316
; but if the zero is a significant digit e.g. 10 then include in digit totals.
15317
; the path for non-zero digits rejoins here.
15318
 
15319
;; PF-INSERT
15320
L2EA9:  LD      (DE),A          ; insert digit at destination
15321
        INC     DE              ; increase the destination pointer
15322
        INC     (IY+$71)        ; increment MEM-5-1st  digit counter
15323
        INC     (IY+$72)        ; increment MEM-5-2nd  leading digit counter
15324
        LD      C,$00           ; set flag to zero indicating that any
15325
                                ; subsequent zeros are significant and not
15326
                                ; leading.
15327
 
15328
;; PF-TEST-2
15329
L2EB3:  BIT     0,B             ; test if the nibble count is even
15330
        JR      Z,L2EB8         ; skip to PF-ALL-9 if so to deal with the
15331
                                ; other nibble in the same byte
15332
 
15333
        INC     HL              ; point to next source byte if not
15334
 
15335
;; PF-ALL-9
15336
L2EB8:  DJNZ    L2EA1           ; decrement the nibble count, back to PF-DIGITS
15337
                                ; if all nine not done.
15338
 
15339
; For 8-bit integers there will be at most 3 digits.
15340
; For 16-bit integers there will be at most 5 digits.
15341
; but for larger integers there could be nine leading digits.
15342
; if nine digits complete then the last one is rounded up as the number will
15343
; be printed using E-format notation
15344
 
15345
        LD      A,($5CAB)       ; fetch digit count from MEM-5-1st
15346
        SUB     $09             ; subtract 9 - max possible
15347
        JR      C,L2ECB         ; forward if less to PF-MORE
15348
 
15349
        DEC     (IY+$71)        ; decrement digit counter MEM-5-1st to 8
15350
        LD      A,$04           ; load A with the value 4.
15351
        CP      (IY+$6F)        ; compare with MEM-4-4th - the ninth digit
15352
        JR      L2F0C           ; forward to PF-ROUND
15353
                                ; to consider rounding.
15354
 
15355
; ---------------------------------------
15356
 
15357
; now delete int x from calculator stack and fetch fractional part.
15358
 
15359
;; PF-MORE
15360
L2ECB:  RST     28H             ;; FP-CALC        int x.
15361
        DEFB    $02             ;;delete          .
15362
        DEFB    $E2             ;;get-mem-2       x - int x = f.
15363
        DEFB    $38             ;;end-calc        f.
15364
 
15365
;; PF-FRACTN
15366
L2ECF:  EX      DE,HL           ;
15367
        CALL    L2FBA           ; routine FETCH-TWO
15368
        EXX                     ;
15369
        LD      A,$80           ;
15370
        SUB     L               ;
15371
        LD      L,$00           ;
15372
        SET     7,D             ;
15373
        EXX                     ;
15374
        CALL    L2FDD           ; routine SHIFT-FP
15375
 
15376
;; PF-FRN-LP
15377
L2EDF:  LD      A,(IY+$71)      ; MEM-5-1st
15378
        CP      $08             ;
15379
        JR      C,L2EEC         ; to PF-FR-DGT
15380
 
15381
        EXX                     ;
15382
        RL      D               ;
15383
        EXX                     ;
15384
        JR      L2F0C           ; to PF-ROUND
15385
 
15386
; ---
15387
 
15388
;; PF-FR-DGT
15389
L2EEC:  LD      BC,$0200        ;
15390
 
15391
;; PF-FR-EXX
15392
L2EEF:  LD      A,E             ;
15393
        CALL    L2F8B           ; routine CA-10*A+C
15394
        LD      E,A             ;
15395
        LD      A,D             ;
15396
        CALL    L2F8B           ; routine CA-10*A+C
15397
        LD      D,A             ;
15398
        PUSH    BC              ;
15399
        EXX                     ;
15400
        POP     BC              ;
15401
        DJNZ    L2EEF           ; to PF-FR-EXX
15402
 
15403
        LD      HL,$5CA1        ; MEM-3
15404
        LD      A,C             ;
15405
        LD      C,(IY+$71)      ; MEM-5-1st
15406
        ADD     HL,BC           ;
15407
        LD      (HL),A          ;
15408
        INC     (IY+$71)        ; MEM-5-1st
15409
        JR      L2EDF           ; to PF-FRN-LP
15410
 
15411
; ----------------
15412
 
15413
; 1) with 9 digits but 8 in mem-5-1 and A holding 4, carry set if rounding up.
15414
; e.g.
15415
;      999999999 is printed as 1E+9
15416
;      100000001 is printed as 1E+8
15417
;      100000009 is printed as 1.0000001E+8
15418
 
15419
;; PF-ROUND
15420
L2F0C:  PUSH    AF              ; save A and flags
15421
        LD      HL,$5CA1        ; address MEM-3 start of digits
15422
        LD      C,(IY+$71)      ; MEM-5-1st No. of digits to C
15423
        LD      B,$00           ; prepare to add
15424
        ADD     HL,BC           ; address last digit + 1
15425
        LD      B,C             ; No. of digits to B counter
15426
        POP     AF              ; restore A and carry flag from comparison.
15427
 
15428
;; PF-RND-LP
15429
L2F18:  DEC     HL              ; address digit at rounding position.
15430
        LD      A,(HL)          ; fetch it
15431
        ADC     A,$00           ; add carry from the comparison
15432
        LD      (HL),A          ; put back result even if $0A.
15433
        AND     A               ; test A
15434
        JR      Z,L2F25         ; skip to PF-R-BACK if ZERO?
15435
 
15436
        CP      $0A             ; compare to 'ten' - overflow
15437
        CCF                     ; complement carry flag so that set if ten.
15438
        JR      NC,L2F2D        ; forward to PF-COUNT with 1 - 9.
15439
 
15440
;; PF-R-BACK
15441
L2F25:  DJNZ    L2F18           ; loop back to PF-RND-LP
15442
 
15443
; if B counts down to zero then we've rounded right back as in 999999995.
15444
; and the first 8 locations all hold $0A.
15445
 
15446
 
15447
        LD      (HL),$01        ; load first location with digit 1.
15448
        INC     B               ; make B hold 1 also.
15449
                                ; could save an instruction byte here.
15450
        INC     (IY+$72)        ; make MEM-5-2nd hold 1.
15451
                                ; and proceed to initialize total digits to 1.
15452
 
15453
;; PF-COUNT
15454
L2F2D:  LD      (IY+$71),B      ; MEM-5-1st
15455
 
15456
; now balance the calculator stack by deleting  it
15457
 
15458
        RST     28H             ;; FP-CALC
15459
        DEFB    $02             ;;delete
15460
        DEFB    $38             ;;end-calc
15461
 
15462
; note if used from str$ then other values may be on the calculator stack.
15463
; we can also restore the next literal pointer from its position on the
15464
; machine stack.
15465
 
15466
        EXX                     ;
15467
        POP     HL              ; restore next literal pointer.
15468
        EXX                     ;
15469
 
15470
        LD      BC,($5CAB)      ; set C to MEM-5-1st digit counter.
15471
                                ; set B to MEM-5-2nd leading digit counter.
15472
        LD      HL,$5CA1        ; set HL to start of digits at MEM-3-1
15473
        LD      A,B             ;
15474
        CP      $09             ;
15475
        JR      C,L2F46         ; to PF-NOT-E
15476
 
15477
        CP      $FC             ;
15478
        JR      C,L2F6C         ; to PF-E-FRMT
15479
 
15480
;; PF-NOT-E
15481
L2F46:  AND     A               ; test for zero leading digits as in .123
15482
 
15483
        CALL    Z,L15EF         ; routine OUT-CODE prints a zero e.g. 0.123
15484
 
15485
;; PF-E-SBRN
15486
L2F4A:  XOR     A               ;
15487
        SUB     B               ;
15488
        JP      M,L2F52         ; skip forward to PF-OUT-LP if originally +ve
15489
 
15490
        LD      B,A             ; else negative count now +ve
15491
        JR      L2F5E           ; forward to PF-DC-OUT       ->
15492
 
15493
; ---
15494
 
15495
;; PF-OUT-LP
15496
L2F52:  LD      A,C             ; fetch total digit count
15497
        AND     A               ; test for zero
15498
        JR      Z,L2F59         ; forward to PF-OUT-DT if so
15499
 
15500
        LD      A,(HL)          ; fetch digit
15501
        INC     HL              ; address next digit
15502
        DEC     C               ; decrease total digit counter
15503
 
15504
;; PF-OUT-DT
15505
L2F59:  CALL    L15EF           ; routine OUT-CODE outputs it.
15506
        DJNZ    L2F52           ; loop back to PF-OUT-LP until B leading
15507
                                ; digits output.
15508
 
15509
;; PF-DC-OUT
15510
L2F5E:  LD      A,C             ; fetch total digits and
15511
        AND     A               ; test if also zero
15512
        RET     Z               ; return if so              -->
15513
 
15514
;
15515
 
15516
        INC     B               ; increment B
15517
        LD      A,$2E           ; prepare the character '.'
15518
 
15519
;; PF-DEC-0S
15520
L2F64:  RST     10H             ; PRINT-A outputs the character '.' or '0'
15521
 
15522
        LD      A,$30           ; prepare the character '0'
15523
                                ; (for cases like .000012345678)
15524
        DJNZ    L2F64           ; loop back to PF-DEC-0S for B times.
15525
 
15526
        LD      B,C             ; load B with now trailing digit counter.
15527
        JR      L2F52           ; back to PF-OUT-LP
15528
 
15529
; ---------------------------------
15530
 
15531
; the branch was here for E-format printing e.g. 123456789 => 1.2345679e+8
15532
 
15533
;; PF-E-FRMT
15534
L2F6C:  LD      D,B             ; counter to D
15535
        DEC     D               ; decrement
15536
        LD      B,$01           ; load B with 1.
15537
 
15538
        CALL    L2F4A           ; routine PF-E-SBRN above
15539
 
15540
        LD      A,$45           ; prepare character 'e'
15541
        RST     10H             ; PRINT-A
15542
 
15543
        LD      C,D             ; exponent to C
15544
        LD      A,C             ; and to A
15545
        AND     A               ; test exponent
15546
        JP      P,L2F83         ; to PF-E-POS if positive
15547
 
15548
        NEG                     ; negate
15549
        LD      C,A             ; positive exponent to C
15550
        LD      A,$2D           ; prepare character '-'
15551
        JR      L2F85           ; skip to PF-E-SIGN
15552
 
15553
; ---
15554
 
15555
;; PF-E-POS
15556
L2F83:  LD      A,$2B           ; prepare character '+'
15557
 
15558
;; PF-E-SIGN
15559
L2F85:  RST     10H             ; PRINT-A outputs the sign
15560
 
15561
        LD      B,$00           ; make the high byte zero.
15562
        JP      L1A1B           ; exit via OUT-NUM-1 to print exponent in BC
15563
 
15564
; ------------------------------
15565
; Handle printing floating point
15566
; ------------------------------
15567
; This subroutine is called twice from above when printing floating-point
15568
; numbers. It returns 10*A +C in registers C and A
15569
 
15570
;; CA-10*A+C
15571
L2F8B:  PUSH    DE              ; preserve DE.
15572
        LD      L,A             ; transfer A to L
15573
        LD      H,$00           ; zero high byte.
15574
        LD      E,L             ; copy HL
15575
        LD      D,H             ; to DE.
15576
        ADD     HL,HL           ; double (*2)
15577
        ADD     HL,HL           ; double (*4)
15578
        ADD     HL,DE           ; add DE (*5)
15579
        ADD     HL,HL           ; double (*10)
15580
        LD      E,C             ; copy C to E    (D is 0)
15581
        ADD     HL,DE           ; and add to give required result.
15582
        LD      C,H             ; transfer to
15583
        LD      A,L             ; destination registers.
15584
        POP     DE              ; restore DE
15585
        RET                     ; return with result.
15586
 
15587
; --------------
15588
; Prepare to add
15589
; --------------
15590
; This routine is called twice by addition to prepare the two numbers. The
15591
; exponent is picked up in A and the location made zero. Then the sign bit
15592
; is tested before being set to the implied state. Negative numbers are twos
15593
; complemented.
15594
 
15595
;; PREP-ADD
15596
L2F9B:  LD      A,(HL)          ; pick up exponent
15597
        LD      (HL),$00        ; make location zero
15598
        AND     A               ; test if number is zero
15599
        RET     Z               ; return if so
15600
 
15601
        INC     HL              ; address mantissa
15602
        BIT     7,(HL)          ; test the sign bit
15603
        SET     7,(HL)          ; set it to implied state
15604
        DEC     HL              ; point to exponent
15605
        RET     Z               ; return if positive number.
15606
 
15607
        PUSH    BC              ; preserve BC
15608
        LD      BC,$0005        ; length of number
15609
        ADD     HL,BC           ; point HL past end
15610
        LD      B,C             ; set B to 5 counter
15611
        LD      C,A             ; store exponent in C
15612
        SCF                     ; set carry flag
15613
 
15614
;; NEG-BYTE
15615
L2FAF:  DEC     HL              ; work from LSB to MSB
15616
        LD      A,(HL)          ; fetch byte
15617
        CPL                     ; complement
15618
        ADC     A,$00           ; add in initial carry or from prev operation
15619
        LD      (HL),A          ; put back
15620
        DJNZ    L2FAF           ; loop to NEG-BYTE till all 5 done
15621
 
15622
        LD      A,C             ; stored exponent to A
15623
        POP     BC              ; restore original BC
15624
        RET                     ; return
15625
 
15626
; -----------------
15627
; Fetch two numbers
15628
; -----------------
15629
; This routine is called twice when printing floating point numbers and also
15630
; to fetch two numbers by the addition, multiply and division routines.
15631
; HL addresses the first number, DE addresses the second number.
15632
; For arithmetic only, A holds the sign of the result which is stored in
15633
; the second location.
15634
 
15635
;; FETCH-TWO
15636
L2FBA:  PUSH    HL              ; save pointer to first number, result if math.
15637
        PUSH    AF              ; save result sign.
15638
 
15639
        LD      C,(HL)          ;
15640
        INC     HL              ;
15641
 
15642
        LD      B,(HL)          ;
15643
        LD      (HL),A          ; store the sign at correct location in
15644
                                ; destination 5 bytes for arithmetic only.
15645
        INC     HL              ;
15646
 
15647
        LD      A,C             ;
15648
        LD      C,(HL)          ;
15649
        PUSH    BC              ;
15650
        INC     HL              ;
15651
        LD      C,(HL)          ;
15652
        INC     HL              ;
15653
        LD      B,(HL)          ;
15654
        EX      DE,HL           ;
15655
        LD      D,A             ;
15656
        LD      E,(HL)          ;
15657
        PUSH    DE              ;
15658
        INC     HL              ;
15659
        LD      D,(HL)          ;
15660
        INC     HL              ;
15661
        LD      E,(HL)          ;
15662
        PUSH    DE              ;
15663
        EXX                     ;
15664
        POP     DE              ;
15665
        POP     HL              ;
15666
        POP     BC              ;
15667
        EXX                     ;
15668
        INC     HL              ;
15669
        LD      D,(HL)          ;
15670
        INC     HL              ;
15671
        LD      E,(HL)          ;
15672
 
15673
        POP     AF              ; restore possible result sign.
15674
        POP     HL              ; and pointer to possible result.
15675
        RET                     ; return.
15676
 
15677
; ---------------------------------
15678
; Shift floating point number right
15679
; ---------------------------------
15680
;
15681
;
15682
 
15683
;; SHIFT-FP
15684
L2FDD:  AND     A               ;
15685
        RET     Z               ;
15686
 
15687
        CP      $21             ;
15688
        JR      NC,L2FF9        ; to ADDEND-0
15689
 
15690
        PUSH    BC              ;
15691
        LD      B,A             ;
15692
 
15693
;; ONE-SHIFT
15694
L2FE5:  EXX                     ;
15695
        SRA     L               ;
15696
        RR      D               ;
15697
        RR      E               ;
15698
        EXX                     ;
15699
        RR      D               ;
15700
        RR      E               ;
15701
        DJNZ    L2FE5           ; to ONE-SHIFT
15702
 
15703
        POP     BC              ;
15704
        RET     NC              ;
15705
 
15706
        CALL    L3004           ; routine ADD-BACK
15707
        RET     NZ              ;
15708
 
15709
;; ADDEND-0
15710
L2FF9:  EXX                     ;
15711
        XOR     A               ;
15712
 
15713
;; ZEROS-4/5
15714
L2FFB:  LD      L,$00           ;
15715
        LD      D,A             ;
15716
        LD      E,L             ;
15717
        EXX                     ;
15718
        LD      DE,$0000        ;
15719
        RET                     ;
15720
 
15721
; ------------------
15722
; Add back any carry
15723
; ------------------
15724
;
15725
;
15726
 
15727
;; ADD-BACK
15728
L3004:  INC     E               ;
15729
        RET     NZ              ;
15730
 
15731
        INC      D              ;
15732
        RET     NZ              ;
15733
 
15734
        EXX                     ;
15735
        INC     E               ;
15736
        JR      NZ,L300D        ; to ALL-ADDED
15737
 
15738
        INC     D               ;
15739
 
15740
;; ALL-ADDED
15741
L300D:  EXX                     ;
15742
        RET                     ;
15743
 
15744
; -----------------------
15745
; Handle subtraction (03)
15746
; -----------------------
15747
; Subtraction is done by switching the sign byte/bit of the second number
15748
; which may be integer of floating point and continuing into addition.
15749
 
15750
;; subtract
15751
L300F:  EX      DE,HL           ; address second number with HL
15752
 
15753
        CALL    L346E           ; routine NEGATE switches sign
15754
 
15755
        EX      DE,HL           ; address first number again
15756
                                ; and continue.
15757
 
15758
; --------------------
15759
; Handle addition (0F)
15760
; --------------------
15761
; HL points to first number, DE to second.
15762
; If they are both integers, then go for the easy route.
15763
 
15764
;; addition
15765
L3014:  LD      A,(DE)          ; fetch first byte of second
15766
        OR      (HL)            ; combine with first byte of first
15767
        JR      NZ,L303E        ; forward to FULL-ADDN if at least one was
15768
                                ; in floating point form.
15769
 
15770
; continue if both were small integers.
15771
 
15772
        PUSH    DE              ; save pointer to lowest number for result.
15773
 
15774
        INC     HL              ; address sign byte and
15775
        PUSH    HL              ; push the pointer.
15776
 
15777
        INC     HL              ; address low byte
15778
        LD      E,(HL)          ; to E
15779
        INC     HL              ; address high byte
15780
        LD      D,(HL)          ; to D
15781
        INC     HL              ; address unused byte
15782
 
15783
        INC     HL              ; address known zero indicator of 1st number
15784
        INC     HL              ; address sign byte
15785
 
15786
        LD      A,(HL)          ; sign to A, $00 or $FF
15787
 
15788
        INC     HL              ; address low byte
15789
        LD      C,(HL)          ; to C
15790
        INC     HL              ; address high byte
15791
        LD      B,(HL)          ; to B
15792
 
15793
        POP     HL              ; pop result sign pointer
15794
        EX      DE,HL           ; integer to HL
15795
 
15796
        ADD     HL,BC           ; add to the other one in BC
15797
                                ; setting carry if overflow.
15798
 
15799
        EX      DE,HL           ; save result in DE bringing back sign pointer
15800
 
15801
        ADC     A,(HL)          ; if pos/pos A=01 with overflow else 00
15802
                                ; if neg/neg A=FF with overflow else FE
15803
                                ; if mixture A=00 with overflow else FF
15804
 
15805
        RRCA                    ; bit 0 to (C)
15806
 
15807
        ADC     A,$00           ; both acceptable signs now zero
15808
 
15809
        JR      NZ,L303C        ; forward to ADDN-OFLW if not
15810
 
15811
        SBC     A,A             ; restore a negative result sign
15812
 
15813
        LD      (HL),A          ;
15814
        INC     HL              ;
15815
        LD      (HL),E          ;
15816
        INC     HL              ;
15817
        LD      (HL),D          ;
15818
        DEC     HL              ;
15819
        DEC     HL              ;
15820
        DEC     HL              ;
15821
 
15822
        POP     DE              ; STKEND
15823
        RET                     ;
15824
 
15825
; ---
15826
 
15827
;; ADDN-OFLW
15828
L303C:  DEC     HL              ;
15829
        POP     DE              ;
15830
 
15831
;; FULL-ADDN
15832
L303E:  CALL    L3293           ; routine RE-ST-TWO
15833
        EXX                     ;
15834
        PUSH    HL              ;
15835
        EXX                     ;
15836
        PUSH    DE              ;
15837
        PUSH    HL              ;
15838
        CALL    L2F9B           ; routine PREP-ADD
15839
        LD      B,A             ;
15840
        EX      DE,HL           ;
15841
        CALL    L2F9B           ; routine PREP-ADD
15842
        LD       C,A            ;
15843
        CP      B               ;
15844
        JR      NC,L3055        ; to SHIFT-LEN
15845
 
15846
        LD      A,B             ;
15847
        LD      B,C             ;
15848
        EX      DE,HL           ;
15849
 
15850
;; SHIFT-LEN
15851
L3055:  PUSH    AF              ;
15852
        SUB     B               ;
15853
        CALL    L2FBA           ; routine FETCH-TWO
15854
        CALL    L2FDD           ; routine SHIFT-FP
15855
        POP     AF              ;
15856
        POP     HL              ;
15857
        LD      (HL),A          ;
15858
        PUSH    HL              ;
15859
        LD      L,B             ;
15860
        LD      H,C             ;
15861
        ADD     HL,DE           ;
15862
        EXX                     ;
15863
        EX      DE,HL           ;
15864
        ADC     HL,BC           ;
15865
        EX      DE,HL           ;
15866
        LD      A,H             ;
15867
        ADC     A,L             ;
15868
        LD      L,A             ;
15869
        RRA                     ;
15870
        XOR     L               ;
15871
        EXX                     ;
15872
        EX      DE,HL           ;
15873
        POP     HL              ;
15874
        RRA                     ;
15875
        JR      NC,L307C        ; to TEST-NEG
15876
 
15877
        LD      A,$01           ;
15878
        CALL    L2FDD           ; routine SHIFT-FP
15879
        INC     (HL)            ;
15880
        JR      Z,L309F         ; to ADD-REP-6
15881
 
15882
;; TEST-NEG
15883
L307C:  EXX                     ;
15884
        LD      A,L             ;
15885
        AND     $80             ;
15886
        EXX                     ;
15887
        INC     HL              ;
15888
        LD      (HL),A          ;
15889
        DEC     HL              ;
15890
        JR      Z,L30A5         ; to GO-NC-MLT
15891
 
15892
        LD      A,E             ;
15893
        NEG                     ; Negate
15894
        CCF                     ; Complement Carry Flag
15895
        LD      E,A             ;
15896
        LD      A,D             ;
15897
        CPL                     ;
15898
        ADC     A,$00           ;
15899
        LD      D,A             ;
15900
        EXX                     ;
15901
        LD      A,E             ;
15902
        CPL                     ;
15903
        ADC     A,$00           ;
15904
        LD      E,A             ;
15905
        LD      A,D             ;
15906
        CPL                     ;
15907
        ADC     A,$00           ;
15908
        JR      NC,L30A3        ; to END-COMPL
15909
 
15910
        RRA                     ;
15911
        EXX                     ;
15912
        INC     (HL)            ;
15913
 
15914
;; ADD-REP-6
15915
L309F:  JP      Z,L31AD         ; to REPORT-6
15916
 
15917
        EXX                     ;
15918
 
15919
;; END-COMPL
15920
L30A3:  LD      D,A             ;
15921
        EXX                     ;
15922
 
15923
;; GO-NC-MLT
15924
L30A5:  XOR     A               ;
15925
        JP      L3155           ; to TEST-NORM
15926
 
15927
; -----------------------------
15928
; Used in 16 bit multiplication
15929
; -----------------------------
15930
; This routine is used, in the first instance, by the multiply calculator
15931
; literal to perform an integer multiplication in preference to
15932
; 32-bit multiplication to which it will resort if this overflows.
15933
;
15934
; It is also used by STK-VAR to calculate array subscripts and by DIM to
15935
; calculate the space required for multi-dimensional arrays.
15936
 
15937
;; HL-HL*DE
15938
L30A9:  PUSH    BC              ; preserve BC throughout
15939
        LD      B,$10           ; set B to 16
15940
        LD      A,H             ; save H in A high byte
15941
        LD      C,L             ; save L in C low byte
15942
        LD      HL,$0000        ; initialize result to zero
15943
 
15944
; now enter a loop.
15945
 
15946
;; HL-LOOP
15947
L30B1:  ADD     HL,HL           ; double result
15948
        JR      C,L30BE         ; to HL-END if overflow
15949
 
15950
        RL      C               ; shift AC left into carry
15951
        RLA                     ;
15952
        JR      NC,L30BC        ; to HL-AGAIN to skip addition if no carry
15953
 
15954
        ADD     HL,DE           ; add in DE
15955
        JR      C,L30BE         ; to HL-END if overflow
15956
 
15957
;; HL-AGAIN
15958
L30BC:  DJNZ    L30B1           ; back to HL-LOOP for all 16 bits
15959
 
15960
;; HL-END
15961
L30BE:  POP     BC              ; restore preserved BC
15962
        RET                     ; return with carry reset if successful
15963
                                ; and result in HL.
15964
 
15965
; ----------------------------------------------
15966
; THE 'PREPARE TO MULTIPLY OR DIVIDE' SUBROUTINE
15967
; ----------------------------------------------
15968
;   This routine is called in succession from multiply and divide to prepare
15969
;   two mantissas by setting the leftmost bit that is used for the sign.
15970
;   On the first call A holds zero and picks up the sign bit. On the second
15971
;   call the two bits are XORed to form the result sign - minus * minus giving
15972
;   plus etc. If either number is zero then this is flagged.
15973
;   HL addresses the exponent.
15974
 
15975
;; PREP-M/D
15976
L30C0:  CALL    L34E9           ; routine TEST-ZERO  preserves accumulator.
15977
        RET     C               ; return carry set if zero
15978
 
15979
        INC     HL              ; address first byte of mantissa
15980
        XOR     (HL)            ; pick up the first or xor with first.
15981
        SET     7,(HL)          ; now set to give true 32-bit mantissa
15982
        DEC     HL              ; point to exponent
15983
        RET                     ; return with carry reset
15984
 
15985
; ----------------------
15986
; THE 'MULTIPLY' ROUTINE
15987
; ----------------------
15988
; (offset: $04 'multiply')
15989
;
15990
;
15991
;   "He said go forth and something about mathematics, I wasn't really
15992
;    listening" - overheard conversation between two unicorns.
15993
;    [ The Odd Streak ].
15994
 
15995
;; multiply
15996
L30CA:  LD      A,(DE)          ;
15997
        OR      (HL)            ;
15998
        JR      NZ,L30F0        ; to MULT-LONG
15999
 
16000
        PUSH    DE              ;
16001
        PUSH    HL              ;
16002
        PUSH    DE              ;
16003
        CALL    L2D7F           ; routine INT-FETCH
16004
        EX      DE,HL           ;
16005
        EX      (SP),HL         ;
16006
        LD      B,C             ;
16007
        CALL    L2D7F           ; routine INT-FETCH
16008
        LD      A,B             ;
16009
        XOR     C               ;
16010
        LD      C,A             ;
16011
        POP     HL              ;
16012
        CALL    L30A9           ; routine HL-HL*DE
16013
        EX      DE,HL           ;
16014
        POP     HL              ;
16015
        JR      C,L30EF         ; to MULT-OFLW
16016
 
16017
        LD      A,D             ;
16018
        OR      E               ;
16019
        JR      NZ,L30EA        ; to MULT-RSLT
16020
 
16021
        LD      C,A             ;
16022
 
16023
;; MULT-RSLT
16024
L30EA:  CALL    L2D8E           ; routine INT-STORE
16025
        POP      DE             ;
16026
        RET                     ;
16027
 
16028
; ---
16029
 
16030
;; MULT-OFLW
16031
L30EF:  POP     DE              ;
16032
 
16033
;; MULT-LONG
16034
L30F0:  CALL    L3293           ; routine RE-ST-TWO
16035
        XOR     A               ;
16036
        CALL    L30C0           ; routine PREP-M/D
16037
        RET     C               ;
16038
 
16039
        EXX                     ;
16040
        PUSH    HL              ;
16041
        EXX                     ;
16042
        PUSH    DE              ;
16043
        EX      DE,HL           ;
16044
        CALL    L30C0           ; routine PREP-M/D
16045
        EX      DE,HL           ;
16046
        JR      C,L315D         ; to ZERO-RSLT
16047
 
16048
        PUSH    HL              ;
16049
        CALL    L2FBA           ; routine FETCH-TWO
16050
        LD      A,B             ;
16051
        AND     A               ;
16052
        SBC     HL,HL           ;
16053
        EXX                     ;
16054
        PUSH    HL              ;
16055
        SBC     HL,HL           ;
16056
        EXX                     ;
16057
        LD      B,$21           ;
16058
        JR      L3125           ; to STRT-MLT
16059
 
16060
; ---
16061
 
16062
;; MLT-LOOP
16063
L3114:  JR      NC,L311B        ; to NO-ADD
16064
 
16065
        ADD     HL,DE           ;
16066
        EXX                     ;
16067
        ADC     HL,DE           ;
16068
        EXX                     ;
16069
 
16070
;; NO-ADD
16071
L311B:  EXX                     ;
16072
        RR      H               ;
16073
        RR      L               ;
16074
        EXX                     ;
16075
        RR      H               ;
16076
        RR      L               ;
16077
 
16078
;; STRT-MLT
16079
L3125:  EXX                     ;
16080
        RR      B               ;
16081
        RR      C               ;
16082
        EXX                     ;
16083
        RR      C               ;
16084
        RRA                     ;
16085
        DJNZ    L3114           ; to MLT-LOOP
16086
 
16087
        EX      DE,HL           ;
16088
        EXX                     ;
16089
        EX      DE,HL           ;
16090
        EXX                     ;
16091
        POP     BC              ;
16092
        POP     HL              ;
16093
        LD      A,B             ;
16094
        ADD     A,C             ;
16095
        JR      NZ,L313B        ; to MAKE-EXPT
16096
 
16097
        AND     A               ;
16098
 
16099
;; MAKE-EXPT
16100
L313B:  DEC     A               ;
16101
        CCF                     ; Complement Carry Flag
16102
 
16103
;; DIVN-EXPT
16104
L313D:  RLA                     ;
16105
        CCF                     ; Complement Carry Flag
16106
        RRA                     ;
16107
        JP      P,L3146         ; to OFLW1-CLR
16108
 
16109
        JR      NC,L31AD        ; to REPORT-6
16110
 
16111
        AND     A               ;
16112
 
16113
;; OFLW1-CLR
16114
L3146:  INC     A               ;
16115
        JR      NZ,L3151        ; to OFLW2-CLR
16116
 
16117
        JR      C,L3151         ; to OFLW2-CLR
16118
 
16119
        EXX                     ;
16120
        BIT     7,D             ;
16121
        EXX                     ;
16122
        JR      NZ,L31AD        ; to REPORT-6
16123
 
16124
;; OFLW2-CLR
16125
L3151:  LD      (HL),A          ;
16126
        EXX                     ;
16127
        LD      A,B             ;
16128
        EXX                     ;
16129
 
16130
;; TEST-NORM
16131
L3155:  JR      NC,L316C        ; to NORMALISE
16132
 
16133
        LD      A,(HL)          ;
16134
        AND     A               ;
16135
 
16136
;; NEAR-ZERO
16137
L3159:  LD      A,$80           ;
16138
        JR      Z,L315E         ; to SKIP-ZERO
16139
 
16140
;; ZERO-RSLT
16141
L315D:  XOR     A               ;
16142
 
16143
;; SKIP-ZERO
16144
L315E:  EXX                     ;
16145
        AND     D               ;
16146
        CALL    L2FFB           ; routine ZEROS-4/5
16147
        RLCA                    ;
16148
        LD      (HL),A          ;
16149
        JR      C,L3195         ; to OFLOW-CLR
16150
 
16151
        INC     HL              ;
16152
        LD      (HL),A          ;
16153
        DEC     HL              ;
16154
        JR      L3195           ; to OFLOW-CLR
16155
 
16156
; ---
16157
 
16158
;; NORMALISE
16159
L316C:  LD      B,$20           ;
16160
 
16161
;; SHIFT-ONE
16162
L316E:  EXX                     ;
16163
        BIT     7,D             ;
16164
        EXX                     ;
16165
        JR      NZ,L3186        ; to NORML-NOW
16166
 
16167
        RLCA                    ;
16168
        RL      E               ;
16169
        RL      D               ;
16170
        EXX                     ;
16171
        RL      E               ;
16172
        RL      D               ;
16173
        EXX                     ;
16174
        DEC     (HL)            ;
16175
        JR      Z,L3159         ; to NEAR-ZERO
16176
 
16177
        DJNZ    L316E           ; to SHIFT-ONE
16178
 
16179
        JR      L315D           ; to ZERO-RSLT
16180
 
16181
; ---
16182
 
16183
;; NORML-NOW
16184
L3186:  RLA                     ;
16185
        JR      NC,L3195        ; to OFLOW-CLR
16186
 
16187
        CALL    L3004           ; routine ADD-BACK
16188
        JR      NZ,L3195        ; to OFLOW-CLR
16189
 
16190
        EXX                     ;
16191
        LD       D,$80          ;
16192
        EXX                     ;
16193
        INC     (HL)            ;
16194
        JR      Z,L31AD         ; to REPORT-6
16195
 
16196
;; OFLOW-CLR
16197
L3195:  PUSH    HL              ;
16198
        INC     HL              ;
16199
        EXX                     ;
16200
        PUSH    DE              ;
16201
        EXX                     ;
16202
        POP     BC              ;
16203
        LD      A,B             ;
16204
        RLA                     ;
16205
        RL      (HL)            ;
16206
        RRA                     ;
16207
        LD      (HL),A          ;
16208
        INC     HL              ;
16209
        LD      (HL),C          ;
16210
        INC     HL              ;
16211
        LD      (HL),D          ;
16212
        INC     HL              ;
16213
        LD      (HL),E          ;
16214
        POP     HL              ;
16215
        POP     DE              ;
16216
        EXX                     ;
16217
        POP     HL              ;
16218
        EXX                     ;
16219
        RET                     ;
16220
 
16221
; ---
16222
 
16223
;; REPORT-6
16224
L31AD:  RST     08H             ; ERROR-1
16225
        DEFB    $05             ; Error Report: Number too big
16226
 
16227
; ----------------------
16228
; THE 'DIVISION' ROUTINE
16229
; ----------------------
16230
; (offset: $05 'division')
16231
;
16232
;   "He who can properly define and divide is to be considered a god"
16233
;   - Plato,  429 - 347 B.C.
16234
 
16235
;; division
16236
L31AF:  CALL    L3293           ; routine RE-ST-TWO
16237
        EX      DE,HL           ;
16238
        XOR     A               ;
16239
        CALL    L30C0           ; routine PREP-M/D
16240
        JR      C,L31AD         ; to REPORT-6
16241
 
16242
        EX      DE,HL           ;
16243
        CALL    L30C0           ; routine PREP-M/D
16244
        RET     C               ;
16245
 
16246
        EXX                     ;
16247
        PUSH    HL              ;
16248
        EXX                     ;
16249
        PUSH    DE              ;
16250
        PUSH    HL              ;
16251
        CALL    L2FBA           ; routine FETCH-TWO
16252
        EXX                     ;
16253
        PUSH    HL              ;
16254
        LD      H,B             ;
16255
        LD      L,C             ;
16256
        EXX                     ;
16257
        LD      H,C             ;
16258
        LD      L,B             ;
16259
        XOR     A               ;
16260
        LD      B,$DF           ;
16261
        JR      L31E2           ; to DIV-START
16262
 
16263
; ---
16264
 
16265
;; DIV-LOOP
16266
L31D2:  RLA                     ;
16267
        RL      C               ;
16268
        EXX                     ;
16269
        RL      C               ;
16270
        RL      B               ;
16271
        EXX                     ;
16272
 
16273
;; div-34th
16274
L31DB:  ADD     HL,HL           ;
16275
        EXX                     ;
16276
        ADC     HL,HL           ;
16277
        EXX                     ;
16278
        JR      C,L31F2         ; to SUBN-ONLY
16279
 
16280
;; DIV-START
16281
L31E2:  SBC     HL,DE           ;
16282
        EXX                     ;
16283
        SBC     HL,DE           ;
16284
        EXX                     ;
16285
        JR      NC,L31F9        ; to NO-RSTORE
16286
 
16287
        ADD     HL,DE           ;
16288
        EXX                     ;
16289
        ADC     HL,DE           ;
16290
        EXX                     ;
16291
        AND     A               ;
16292
        JR      L31FA           ; to COUNT-ONE
16293
 
16294
; ---
16295
 
16296
;; SUBN-ONLY
16297
L31F2:  AND     A               ;
16298
        SBC     HL,DE           ;
16299
        EXX                     ;
16300
        SBC     HL,DE           ;
16301
        EXX                     ;
16302
 
16303
;; NO-RSTORE
16304
L31F9:  SCF                     ; Set Carry Flag
16305
 
16306
;; COUNT-ONE
16307
L31FA:  INC     B               ;
16308
        JP      M,L31D2         ; to DIV-LOOP
16309
 
16310
        PUSH    AF              ;
16311
        JR      Z,L31E2         ; to DIV-START
16312
 
16313
;
16314
;
16315
;
16316
;
16317
 
16318
        LD      E,A             ;
16319
        LD      D,C             ;
16320
        EXX                     ;
16321
        LD      E,C             ;
16322
        LD      D,B             ;
16323
        POP     AF              ;
16324
        RR      B               ;
16325
        POP     AF              ;
16326
        RR      B               ;
16327
        EXX                     ;
16328
        POP     BC              ;
16329
        POP     HL              ;
16330
        LD      A,B             ;
16331
        SUB     C               ;
16332
        JP      L313D           ; jump back to DIVN-EXPT
16333
 
16334
; ------------------------------------
16335
; Integer truncation towards zero ($3A)
16336
; ------------------------------------
16337
;
16338
;
16339
 
16340
;; truncate
16341
L3214:  LD      A,(HL)          ;
16342
        AND     A               ;
16343
        RET     Z               ;
16344
 
16345
        CP      $81             ;
16346
        JR      NC,L3221        ; to T-GR-ZERO
16347
 
16348
        LD      (HL),$00        ;
16349
        LD      A,$20           ;
16350
        JR      L3272           ; to NIL-BYTES
16351
 
16352
; ---
16353
 
16354
;; T-GR-ZERO
16355
L3221:  CP      $91             ;
16356
        JR      NZ,L323F        ; to T-SMALL
16357
 
16358
        INC     HL              ;
16359
        INC     HL              ;
16360
        INC     HL              ;
16361
        LD      A,$80           ;
16362
        AND     (HL)            ;
16363
        DEC     HL              ;
16364
        OR      (HL)            ;
16365
        DEC     HL              ;
16366
        JR      NZ,L3233        ; to T-FIRST
16367
 
16368
        LD      A,$80           ;
16369
        XOR     (HL)            ;
16370
 
16371
;; T-FIRST
16372
L3233:  DEC     HL              ;
16373
        JR      NZ,L326C        ; to T-EXPNENT
16374
 
16375
        LD      (HL),A          ;
16376
        INC     HL              ;
16377
        LD      (HL),$FF        ;
16378
        DEC     HL              ;
16379
        LD      A,$18           ;
16380
        JR      L3272           ; to NIL-BYTES
16381
 
16382
; ---
16383
 
16384
;; T-SMALL
16385
L323F:  JR      NC,L326D        ; to X-LARGE
16386
 
16387
        PUSH    DE              ;
16388
        CPL                     ;
16389
        ADD     A,$91           ;
16390
        INC     HL              ;
16391
        LD      D,(HL)          ;
16392
        INC     HL              ;
16393
        LD      E,(HL)          ;
16394
        DEC     HL              ;
16395
        DEC     HL              ;
16396
        LD      C,$00           ;
16397
        BIT     7,D             ;
16398
        JR      Z,L3252         ; to T-NUMERIC
16399
 
16400
        DEC     C               ;
16401
 
16402
;; T-NUMERIC
16403
L3252:  SET     7,D             ;
16404
        LD      B,$08           ;
16405
        SUB     B               ;
16406
        ADD     A,B             ;
16407
        JR      C,L325E         ; to T-TEST
16408
 
16409
        LD      E,D             ;
16410
        LD      D,$00           ;
16411
        SUB     B               ;
16412
 
16413
;; T-TEST
16414
L325E:  JR      Z,L3267         ; to T-STORE
16415
 
16416
        LD      B,A             ;
16417
 
16418
;; T-SHIFT
16419
L3261:  SRL     D               ;
16420
        RR      E               ;
16421
        DJNZ    L3261           ; to T-SHIFT
16422
 
16423
;; T-STORE
16424
L3267:  CALL    L2D8E           ; routine INT-STORE
16425
        POP     DE              ;
16426
        RET                     ;
16427
 
16428
; ---
16429
 
16430
;; T-EXPNENT
16431
L326C:  LD      A,(HL)          ;
16432
 
16433
;; X-LARGE
16434
L326D:  SUB     $A0             ;
16435
        RET     P               ;
16436
 
16437
        NEG                     ; Negate
16438
 
16439
;; NIL-BYTES
16440
L3272:  PUSH    DE              ;
16441
        EX      DE,HL           ;
16442
        DEC     HL              ;
16443
        LD      B,A             ;
16444
        SRL     B               ;
16445
        SRL     B               ;
16446
        SRL     B               ;
16447
        JR      Z,L3283         ; to BITS-ZERO
16448
 
16449
;; BYTE-ZERO
16450
L327E:  LD      (HL),$00        ;
16451
        DEC     HL              ;
16452
        DJNZ    L327E           ; to BYTE-ZERO
16453
 
16454
;; BITS-ZERO
16455
L3283:  AND     $07             ;
16456
        JR      Z,L3290         ; to IX-END
16457
 
16458
        LD      B,A             ;
16459
        LD      A,$FF           ;
16460
 
16461
;; LESS-MASK
16462
L328A:  SLA     A               ;
16463
        DJNZ    L328A           ; to LESS-MASK
16464
 
16465
        AND     (HL)            ;
16466
        LD      (HL),A          ;
16467
 
16468
;; IX-END
16469
L3290:  EX      DE,HL           ;
16470
        POP     DE              ;
16471
        RET                     ;
16472
 
16473
; ----------------------------------
16474
; Storage of numbers in 5 byte form.
16475
; ==================================
16476
; Both integers and floating-point numbers can be stored in five bytes.
16477
; Zero is a special case stored as 5 zeros.
16478
; For integers the form is
16479
; Byte 1 - zero,
16480
; Byte 2 - sign byte, $00 +ve, $FF -ve.
16481
; Byte 3 - Low byte of integer.
16482
; Byte 4 - High byte
16483
; Byte 5 - unused but always zero.
16484
;
16485
; it seems unusual to store the low byte first but it is just as easy either
16486
; way. Statistically it just increases the chances of trailing zeros which
16487
; is an advantage elsewhere in saving ROM code.
16488
;
16489
;             zero     sign     low      high    unused
16490
; So +1 is  00000000 00000000 00000001 00000000 00000000
16491
;
16492
; and -1 is 00000000 11111111 11111111 11111111 00000000
16493
;
16494
; much of the arithmetic found in BASIC lines can be done using numbers
16495
; in this form using the Z80's 16 bit register operation ADD.
16496
; (multiplication is done by a sequence of additions).
16497
;
16498
; Storing -ve integers in two's complement form, means that they are ready for
16499
; addition and you might like to add the numbers above to prove that the
16500
; answer is zero. If, as in this case, the carry is set then that denotes that
16501
; the result is positive. This only applies when the signs don't match.
16502
; With positive numbers a carry denotes the result is out of integer range.
16503
; With negative numbers a carry denotes the result is within range.
16504
; The exception to the last rule is when the result is -65536
16505
;
16506
; Floating point form is an alternative method of storing numbers which can
16507
; be used for integers and larger (or fractional) numbers.
16508
;
16509
; In this form 1 is stored as
16510
;           10000001 00000000 00000000 00000000 00000000
16511
;
16512
; When a small integer is converted to a floating point number the last two
16513
; bytes are always blank so they are omitted in the following steps
16514
;
16515
; first make exponent +1 +16d  (bit 7 of the exponent is set if positive)
16516
 
16517
; 10010001 00000000 00000001
16518
; 10010000 00000000 00000010 <-  now shift left and decrement exponent
16519
; ...
16520
; 10000010 01000000 00000000 <-  until a 1 abuts the imaginary point
16521
; 10000001 10000000 00000000     to the left of the mantissa.
16522
;
16523
; however since the leftmost bit of the mantissa is always set then it can
16524
; be used to denote the sign of the mantissa and put back when needed by the
16525
; PREP routines which gives
16526
;
16527
; 10000001 00000000 00000000
16528
 
16529
; ----------------------------------------------
16530
; THE 'RE-STACK TWO "SMALL" INTEGERS' SUBROUTINE
16531
; ----------------------------------------------
16532
;   This routine is called to re-stack two numbers in full floating point form
16533
;   e.g. from mult when integer multiplication has overflowed.
16534
 
16535
;; RE-ST-TWO
16536
L3293:  CALL    L3296           ; routine RESTK-SUB  below and continue
16537
                                ; into the routine to do the other one.
16538
 
16539
;; RESTK-SUB
16540
L3296:  EX      DE,HL           ; swap pointers
16541
 
16542
; ---------------------------------------------
16543
; THE 'RE-STACK ONE "SMALL" INTEGER' SUBROUTINE
16544
; ---------------------------------------------
16545
; (offset: $3D 're-stack')
16546
;   This routine re-stacks an integer, usually on the calculator stack, in full
16547
;   floating point form.  HL points to first byte.
16548
 
16549
;; re-stack
16550
L3297:  LD      A,(HL)          ; Fetch Exponent byte to A
16551
        AND     A               ; test it
16552
        RET     NZ              ; return if not zero as already in full
16553
                                ; floating-point form.
16554
 
16555
        PUSH    DE              ; preserve DE.
16556
        CALL    L2D7F           ; routine INT-FETCH
16557
                                ; integer to DE, sign to C.
16558
 
16559
; HL points to 4th byte.
16560
 
16561
        XOR     A               ; clear accumulator.
16562
        INC     HL              ; point to 5th.
16563
        LD      (HL),A          ; and blank.
16564
        DEC     HL              ; point to 4th.
16565
        LD      (HL),A          ; and blank.
16566
 
16567
        LD      B,$91           ; set exponent byte +ve $81
16568
                                ; and imaginary dec point 16 bits to right
16569
                                ; of first bit.
16570
 
16571
;   we could skip to normalize now but it's quicker to avoid normalizing
16572
;   through an empty D.
16573
 
16574
        LD      A,D             ; fetch the high byte D
16575
        AND     A               ; is it zero ?
16576
        JR      NZ,L32B1        ; skip to RS-NRMLSE if not.
16577
 
16578
        OR      E               ; low byte E to A and test for zero
16579
        LD      B,D             ; set B exponent to 0
16580
        JR      Z,L32BD         ; forward to RS-STORE if value is zero.
16581
 
16582
        LD      D,E             ; transfer E to D
16583
        LD      E,B             ; set E to 0
16584
        LD      B,$89           ; reduce the initial exponent by eight.
16585
 
16586
 
16587
;; RS-NRMLSE
16588
L32B1:  EX      DE,HL           ; integer to HL, addr of 4th byte to DE.
16589
 
16590
;; RSTK-LOOP
16591
L32B2:  DEC     B               ; decrease exponent
16592
        ADD     HL,HL           ; shift DE left
16593
        JR      NC,L32B2        ; loop back to RSTK-LOOP
16594
                                ; until a set bit pops into carry
16595
 
16596
        RRC     C               ; now rotate the sign byte $00 or $FF
16597
                                ; into carry to give a sign bit
16598
 
16599
        RR      H               ; rotate the sign bit to left of H
16600
        RR      L               ; rotate any carry into L
16601
 
16602
        EX      DE,HL           ; address 4th byte, normalized int to DE
16603
 
16604
;; RS-STORE
16605
L32BD:  DEC     HL              ; address 3rd byte
16606
        LD      (HL),E          ; place E
16607
        DEC     HL              ; address 2nd byte
16608
        LD      (HL),D          ; place D
16609
        DEC     HL              ; address 1st byte
16610
        LD      (HL),B          ; store the exponent
16611
 
16612
        POP     DE              ; restore initial DE.
16613
        RET                     ; return.
16614
 
16615
;****************************************
16616
;** Part 10. FLOATING-POINT CALCULATOR **
16617
;****************************************
16618
 
16619
; As a general rule the calculator avoids using the IY register.
16620
; exceptions are val, val$ and str$.
16621
; So an assembly language programmer who has disabled interrupts to use
16622
; IY for other purposes can still use the calculator for mathematical
16623
; purposes.
16624
 
16625
 
16626
; ------------------------
16627
; THE 'TABLE OF CONSTANTS'
16628
; ------------------------
16629
;
16630
;
16631
 
16632
; used 11 times
16633
;; stk-zero                                                 00 00 00 00 00
16634
L32C5:  DEFB    $00             ;;Bytes: 1
16635
        DEFB    $B0             ;;Exponent $00
16636
        DEFB    $00             ;;(+00,+00,+00)
16637
 
16638
; used 19 times
16639
;; stk-one                                                  00 00 01 00 00
16640
L32C8:  DEFB    $40             ;;Bytes: 2
16641
        DEFB    $B0             ;;Exponent $00
16642
        DEFB    $00,$01         ;;(+00,+00)
16643
 
16644
; used 9 times
16645
;; stk-half                                                 80 00 00 00 00
16646
L32CC:  DEFB    $30             ;;Exponent: $80, Bytes: 1
16647
        DEFB    $00             ;;(+00,+00,+00)
16648
 
16649
; used 4 times.
16650
;; stk-pi/2                                                 81 49 0F DA A2
16651
L32CE:  DEFB    $F1             ;;Exponent: $81, Bytes: 4
16652
        DEFB    $49,$0F,$DA,$A2 ;;
16653
 
16654
; used 3 times.
16655
;; stk-ten                                                  00 00 0A 00 00
16656
L32D3:  DEFB    $40             ;;Bytes: 2
16657
        DEFB    $B0             ;;Exponent $00
16658
        DEFB    $00,$0A         ;;(+00,+00)
16659
 
16660
 
16661
; ------------------------
16662
; THE 'TABLE OF ADDRESSES'
16663
; ------------------------
16664
;  "Each problem that I solved became a rule which served afterwards to solve
16665
;   other problems" - Rene Descartes 1596 - 1650.
16666
;
16667
;   Starts with binary operations which have two operands and one result.
16668
;   Three pseudo binary operations first.
16669
 
16670
;; tbl-addrs
16671
L32D7:  DEFW    L368F           ; $00 Address: $368F - jump-true
16672
        DEFW    L343C           ; $01 Address: $343C - exchange
16673
        DEFW    L33A1           ; $02 Address: $33A1 - delete
16674
 
16675
;   True binary operations.
16676
 
16677
        DEFW    L300F           ; $03 Address: $300F - subtract
16678
        DEFW    L30CA           ; $04 Address: $30CA - multiply
16679
        DEFW    L31AF           ; $05 Address: $31AF - division
16680
        DEFW    L3851           ; $06 Address: $3851 - to-power
16681
        DEFW    L351B           ; $07 Address: $351B - or
16682
 
16683
        DEFW    L3524           ; $08 Address: $3524 - no-&-no
16684
        DEFW    L353B           ; $09 Address: $353B - no-l-eql
16685
        DEFW    L353B           ; $0A Address: $353B - no-gr-eql
16686
        DEFW    L353B           ; $0B Address: $353B - nos-neql
16687
        DEFW    L353B           ; $0C Address: $353B - no-grtr
16688
        DEFW    L353B           ; $0D Address: $353B - no-less
16689
        DEFW    L353B           ; $0E Address: $353B - nos-eql
16690
        DEFW    L3014           ; $0F Address: $3014 - addition
16691
 
16692
        DEFW    L352D           ; $10 Address: $352D - str-&-no
16693
        DEFW    L353B           ; $11 Address: $353B - str-l-eql
16694
        DEFW    L353B           ; $12 Address: $353B - str-gr-eql
16695
        DEFW    L353B           ; $13 Address: $353B - strs-neql
16696
        DEFW    L353B           ; $14 Address: $353B - str-grtr
16697
        DEFW    L353B           ; $15 Address: $353B - str-less
16698
        DEFW    L353B           ; $16 Address: $353B - strs-eql
16699
        DEFW    L359C           ; $17 Address: $359C - strs-add
16700
 
16701
;   Unary follow.
16702
 
16703
        DEFW    L35DE           ; $18 Address: $35DE - val$
16704
        DEFW    L34BC           ; $19 Address: $34BC - usr-$
16705
        DEFW    L3645           ; $1A Address: $3645 - read-in
16706
        DEFW    L346E           ; $1B Address: $346E - negate
16707
 
16708
        DEFW    L3669           ; $1C Address: $3669 - code
16709
        DEFW    L35DE           ; $1D Address: $35DE - val
16710
        DEFW    L3674           ; $1E Address: $3674 - len
16711
        DEFW    L37B5           ; $1F Address: $37B5 - sin
16712
        DEFW    L37AA           ; $20 Address: $37AA - cos
16713
        DEFW    L37DA           ; $21 Address: $37DA - tan
16714
        DEFW    L3833           ; $22 Address: $3833 - asn
16715
        DEFW    L3843           ; $23 Address: $3843 - acs
16716
        DEFW    L37E2           ; $24 Address: $37E2 - atn
16717
        DEFW    L3713           ; $25 Address: $3713 - ln
16718
        DEFW    L36C4           ; $26 Address: $36C4 - exp
16719
        DEFW    L36AF           ; $27 Address: $36AF - int
16720
        DEFW    L384A           ; $28 Address: $384A - sqr
16721
        DEFW    L3492           ; $29 Address: $3492 - sgn
16722
        DEFW    L346A           ; $2A Address: $346A - abs
16723
        DEFW    L34AC           ; $2B Address: $34AC - peek
16724
        DEFW    L34A5           ; $2C Address: $34A5 - in
16725
        DEFW    L34B3           ; $2D Address: $34B3 - usr-no
16726
        DEFW    L361F           ; $2E Address: $361F - str$
16727
        DEFW    L35C9           ; $2F Address: $35C9 - chrs
16728
        DEFW    L3501           ; $30 Address: $3501 - not
16729
 
16730
;   End of true unary.
16731
 
16732
        DEFW    L33C0           ; $31 Address: $33C0 - duplicate
16733
        DEFW    L36A0           ; $32 Address: $36A0 - n-mod-m
16734
        DEFW    L3686           ; $33 Address: $3686 - jump
16735
        DEFW    L33C6           ; $34 Address: $33C6 - stk-data
16736
        DEFW    L367A           ; $35 Address: $367A - dec-jr-nz
16737
        DEFW    L3506           ; $36 Address: $3506 - less-0
16738
        DEFW    L34F9           ; $37 Address: $34F9 - greater-0
16739
        DEFW    L369B           ; $38 Address: $369B - end-calc
16740
        DEFW    L3783           ; $39 Address: $3783 - get-argt
16741
        DEFW    L3214           ; $3A Address: $3214 - truncate
16742
        DEFW    L33A2           ; $3B Address: $33A2 - fp-calc-2
16743
        DEFW    L2D4F           ; $3C Address: $2D4F - e-to-fp
16744
        DEFW    L3297           ; $3D Address: $3297 - re-stack
16745
 
16746
;   The following are just the next available slots for the 128 compound
16747
;   literals which are in range $80 - $FF.
16748
 
16749
        DEFW    L3449           ;     Address: $3449 - series-xx    $80 - $9F.
16750
        DEFW    L341B           ;     Address: $341B - stk-const-xx $A0 - $BF.
16751
        DEFW    L342D           ;     Address: $342D - st-mem-xx    $C0 - $DF.
16752
        DEFW    L340F           ;     Address: $340F - get-mem-xx   $E0 - $FF.
16753
 
16754
;   Aside: 3E - 3F are therefore unused calculator literals.
16755
;   If the literal has to be also usable as a function then bits 6 and 7 are
16756
;   used to show type of arguments and result.
16757
 
16758
; --------------
16759
; The Calculator
16760
; --------------
16761
;  "A good calculator does not need artificial aids"
16762
;  Lao Tze 604 - 531 B.C.
16763
 
16764
;; CALCULATE
16765
L335B:  CALL    L35BF           ; routine STK-PNTRS is called to set up the
16766
                                ; calculator stack pointers for a default
16767
                                ; unary operation. HL = last value on stack.
16768
                                ; DE = STKEND first location after stack.
16769
 
16770
; the calculate routine is called at this point by the series generator...
16771
 
16772
;; GEN-ENT-1
16773
L335E:  LD      A,B             ; fetch the Z80 B register to A
16774
        LD      ($5C67),A       ; and store value in system variable BREG.
16775
                                ; this will be the counter for dec-jr-nz
16776
                                ; or if used from fp-calc2 the calculator
16777
                                ; instruction.
16778
 
16779
; ... and again later at this point
16780
 
16781
;; GEN-ENT-2
16782
L3362:  EXX                     ; switch sets
16783
        EX      (SP),HL         ; and store the address of next instruction,
16784
                                ; the return address, in H'L'.
16785
                                ; If this is a recursive call the H'L'
16786
                                ; of the previous invocation goes on stack.
16787
                                ; c.f. end-calc.
16788
        EXX                     ; switch back to main set
16789
 
16790
; this is the re-entry looping point when handling a string of literals.
16791
 
16792
;; RE-ENTRY
16793
L3365:  LD      ($5C65),DE      ; save end of stack in system variable STKEND
16794
        EXX                     ; switch to alt
16795
        LD      A,(HL)          ; get next literal
16796
        INC     HL              ; increase pointer'
16797
 
16798
; single operation jumps back to here
16799
 
16800
;; SCAN-ENT
16801
L336C:  PUSH    HL              ; save pointer on stack
16802
        AND     A               ; now test the literal
16803
        JP      P,L3380         ; forward to FIRST-3D if in range $00 - $3D
16804
                                ; anything with bit 7 set will be one of
16805
                                ; 128 compound literals.
16806
 
16807
; compound literals have the following format.
16808
; bit 7 set indicates compound.
16809
; bits 6-5 the subgroup 0-3.
16810
; bits 4-0 the embedded parameter $00 - $1F.
16811
; The subgroup 0-3 needs to be manipulated to form the next available four
16812
; address places after the simple literals in the address table.
16813
 
16814
        LD      D,A             ; save literal in D
16815
        AND     $60             ; and with 01100000 to isolate subgroup
16816
        RRCA                    ; rotate bits
16817
        RRCA                    ; 4 places to right
16818
        RRCA                    ; not five as we need offset * 2
16819
        RRCA                    ; 00000xx0
16820
        ADD     A,$7C           ; add ($3E * 2) to give correct offset.
16821
                                ; alter above if you add more literals.
16822
        LD      L,A             ; store in L for later indexing.
16823
        LD      A,D             ; bring back compound literal
16824
        AND     $1F             ; use mask to isolate parameter bits
16825
        JR      L338E           ; forward to ENT-TABLE
16826
 
16827
; ---
16828
 
16829
; the branch was here with simple literals.
16830
 
16831
;; FIRST-3D
16832
L3380:  CP      $18             ; compare with first unary operations.
16833
        JR      NC,L338C        ; to DOUBLE-A with unary operations
16834
 
16835
; it is binary so adjust pointers.
16836
 
16837
        EXX                     ;
16838
        LD      BC,$FFFB        ; the value -5
16839
        LD      D,H             ; transfer HL, the last value, to DE.
16840
        LD      E,L             ;
16841
        ADD     HL,BC           ; subtract 5 making HL point to second
16842
                                ; value.
16843
        EXX                     ;
16844
 
16845
;; DOUBLE-A
16846
L338C:  RLCA                    ; double the literal
16847
        LD      L,A             ; and store in L for indexing
16848
 
16849
;; ENT-TABLE
16850
L338E:  LD      DE,L32D7        ; Address: tbl-addrs
16851
        LD      H,$00           ; prepare to index
16852
        ADD     HL,DE           ; add to get address of routine
16853
        LD      E,(HL)          ; low byte to E
16854
        INC     HL              ;
16855
        LD      D,(HL)          ; high byte to D
16856
        LD      HL,L3365        ; Address: RE-ENTRY
16857
        EX      (SP),HL         ; goes to stack
16858
        PUSH    DE              ; now address of routine
16859
        EXX                     ; main set
16860
                                ; avoid using IY register.
16861
        LD      BC,($5C66)      ; STKEND_hi
16862
                                ; nothing much goes to C but BREG to B
16863
                                ; and continue into next ret instruction
16864
                                ; which has a dual identity
16865
 
16866
 
16867
; ------------------
16868
; Handle delete (02)
16869
; ------------------
16870
; A simple return but when used as a calculator literal this
16871
; deletes the last value from the calculator stack.
16872
; On entry, as always with binary operations,
16873
; HL=first number, DE=second number
16874
; On exit, HL=result, DE=stkend.
16875
; So nothing to do
16876
 
16877
;; delete
16878
L33A1:  RET                     ; return - indirect jump if from above.
16879
 
16880
; ---------------------
16881
; Single operation (3B)
16882
; ---------------------
16883
;   This single operation is used, in the first instance, to evaluate most
16884
;   of the mathematical and string functions found in BASIC expressions.
16885
 
16886
;; fp-calc-2
16887
L33A2:  POP     AF              ; drop return address.
16888
        LD      A,($5C67)       ; load accumulator from system variable BREG
16889
                                ; value will be literal e.g. 'tan'
16890
        EXX                     ; switch to alt
16891
        JR      L336C           ; back to SCAN-ENT
16892
                                ; next literal will be end-calc at L2758
16893
 
16894
; ---------------------------------
16895
; THE 'TEST FIVE SPACES' SUBROUTINE
16896
; ---------------------------------
16897
;   This routine is called from MOVE-FP, STK-CONST and STK-STORE to test that
16898
;   there is enough space between the calculator stack and the machine stack
16899
;   for another five-byte value.  It returns with BC holding the value 5 ready
16900
;   for any subsequent LDIR.
16901
 
16902
;; TEST-5-SP
16903
L33A9:  PUSH    DE              ; save
16904
        PUSH    HL              ; registers
16905
        LD      BC,$0005        ; an overhead of five bytes
16906
        CALL    L1F05           ; routine TEST-ROOM tests free RAM raising
16907
                                ; an error if not.
16908
        POP     HL              ; else restore
16909
        POP     DE              ; registers.
16910
        RET                     ; return with BC set at 5.
16911
 
16912
; -----------------------------
16913
; THE 'STACK NUMBER' SUBROUTINE
16914
; -----------------------------
16915
;   This routine is called to stack a hidden floating point number found in
16916
;   a BASIC line.  It is also called to stack a numeric variable value, and
16917
;   from BEEP, to stack an entry in the semi-tone table.  It is not part of the
16918
;   calculator suite of routines.  On entry, HL points to the number to be
16919
;   stacked.
16920
 
16921
;; STACK-NUM
16922
L33B4:  LD      DE,($5C65)      ; Load destination from STKEND system variable.
16923
 
16924
        CALL    L33C0           ; Routine MOVE-FP puts on calculator stack
16925
                                ; with a memory check.
16926
        LD      ($5C65),DE      ; Set STKEND to next free location.
16927
 
16928
        RET                     ; Return.
16929
 
16930
; ---------------------------------
16931
; Move a floating point number (31)
16932
; ---------------------------------
16933
 
16934
; This simple routine is a 5-byte LDIR instruction
16935
; that incorporates a memory check.
16936
; When used as a calculator literal it duplicates the last value on the
16937
; calculator stack.
16938
; Unary so on entry HL points to last value, DE to stkend
16939
 
16940
;; duplicate
16941
;; MOVE-FP
16942
L33C0:  CALL    L33A9           ; routine TEST-5-SP test free memory
16943
                                ; and sets BC to 5.
16944
        LDIR                    ; copy the five bytes.
16945
        RET                     ; return with DE addressing new STKEND
16946
                                ; and HL addressing new last value.
16947
 
16948
; -------------------
16949
; Stack literals ($34)
16950
; -------------------
16951
; When a calculator subroutine needs to put a value on the calculator
16952
; stack that is not a regular constant this routine is called with a
16953
; variable number of following data bytes that convey to the routine
16954
; the integer or floating point form as succinctly as is possible.
16955
 
16956
;; stk-data
16957
L33C6:  LD      H,D             ; transfer STKEND
16958
        LD      L,E             ; to HL for result.
16959
 
16960
;; STK-CONST
16961
L33C8:  CALL    L33A9           ; routine TEST-5-SP tests that room exists
16962
                                ; and sets BC to $05.
16963
 
16964
        EXX                     ; switch to alternate set
16965
        PUSH    HL              ; save the pointer to next literal on stack
16966
        EXX                     ; switch back to main set
16967
 
16968
        EX      (SP),HL         ; pointer to HL, destination to stack.
16969
 
16970
        PUSH    BC              ; save BC - value 5 from test room ??.
16971
 
16972
        LD      A,(HL)          ; fetch the byte following 'stk-data'
16973
        AND     $C0             ; isolate bits 7 and 6
16974
        RLCA                    ; rotate
16975
        RLCA                    ; to bits 1 and 0  range $00 - $03.
16976
        LD      C,A             ; transfer to C
16977
        INC     C               ; and increment to give number of bytes
16978
                                ; to read. $01 - $04
16979
        LD      A,(HL)          ; reload the first byte
16980
        AND     $3F             ; mask off to give possible exponent.
16981
        JR      NZ,L33DE        ; forward to FORM-EXP if it was possible to
16982
                                ; include the exponent.
16983
 
16984
; else byte is just a byte count and exponent comes next.
16985
 
16986
        INC     HL              ; address next byte and
16987
        LD      A,(HL)          ; pick up the exponent ( - $50).
16988
 
16989
;; FORM-EXP
16990
L33DE:  ADD     A,$50           ; now add $50 to form actual exponent
16991
        LD      (DE),A          ; and load into first destination byte.
16992
        LD      A,$05           ; load accumulator with $05 and
16993
        SUB     C               ; subtract C to give count of trailing
16994
                                ; zeros plus one.
16995
        INC     HL              ; increment source
16996
        INC     DE              ; increment destination
16997
        LD      B,$00           ; prepare to copy
16998
        LDIR                    ; copy C bytes
16999
 
17000
        POP     BC              ; restore 5 counter to BC ??.
17001
 
17002
        EX      (SP),HL         ; put HL on stack as next literal pointer
17003
                                ; and the stack value - result pointer -
17004
                                ; to HL.
17005
 
17006
        EXX                     ; switch to alternate set.
17007
        POP     HL              ; restore next literal pointer from stack
17008
                                ; to H'L'.
17009
        EXX                     ; switch back to main set.
17010
 
17011
        LD      B,A             ; zero count to B
17012
        XOR     A               ; clear accumulator
17013
 
17014
;; STK-ZEROS
17015
L33F1:  DEC     B               ; decrement B counter
17016
        RET     Z               ; return if zero.          >>
17017
                                ; DE points to new STKEND
17018
                                ; HL to new number.
17019
 
17020
        LD      (DE),A          ; else load zero to destination
17021
        INC     DE              ; increase destination
17022
        JR      L33F1           ; loop back to STK-ZEROS until done.
17023
 
17024
; -------------------------------
17025
; THE 'SKIP CONSTANTS' SUBROUTINE
17026
; -------------------------------
17027
;   This routine traverses variable-length entries in the table of constants,
17028
;   stacking intermediate, unwanted constants onto a dummy calculator stack,
17029
;   in the first five bytes of ROM.  The destination DE normally points to the
17030
;   end of the calculator stack which might be in the normal place or in the
17031
;   system variables area during E-LINE-NO; INT-TO-FP; stk-ten.  In any case,
17032
;   it would be simpler all round if the routine just shoved unwanted values
17033
;   where it is going to stick the wanted value.  The instruction LD DE, $0000
17034
;   can be removed.
17035
 
17036
;; SKIP-CONS
17037
L33F7:  AND     A               ; test if initially zero.
17038
 
17039
;; SKIP-NEXT
17040
L33F8:  RET     Z               ; return if zero.          >>
17041
 
17042
        PUSH    AF              ; save count.
17043
        PUSH    DE              ; and normal STKEND
17044
 
17045
        LD      DE,$0000        ; dummy value for STKEND at start of ROM
17046
                                ; Note. not a fault but this has to be
17047
                                ; moved elsewhere when running in RAM.
17048
                                ; e.g. with Expandor Systems 'Soft ROM'.
17049
                                ; Better still, write to the normal place.
17050
        CALL    L33C8           ; routine STK-CONST works through variable
17051
                                ; length records.
17052
 
17053
        POP     DE              ; restore real STKEND
17054
        POP     AF              ; restore count
17055
        DEC     A               ; decrease
17056
        JR      L33F8           ; loop back to SKIP-NEXT
17057
 
17058
; ------------------------------
17059
; THE 'LOCATE MEMORY' SUBROUTINE
17060
; ------------------------------
17061
;   This routine, when supplied with a base address in HL and an index in A,
17062
;   will calculate the address of the A'th entry, where each entry occupies
17063
;   five bytes.  It is used for reading the semi-tone table and addressing
17064
;   floating-point numbers in the calculator's memory area.
17065
;   It is not possible to use this routine for the table of constants as these
17066
;   six values are held in compressed format.
17067
 
17068
;; LOC-MEM
17069
L3406:  LD      C,A             ; store the original number $00-$1F.
17070
        RLCA                    ; X2 - double.
17071
        RLCA                    ; X4 - quadruple.
17072
        ADD     A,C             ; X5 - now add original to multiply by five.
17073
 
17074
        LD      C,A             ; place the result in the low byte.
17075
        LD      B,$00           ; set high byte to zero.
17076
        ADD     HL,BC           ; add to form address of start of number in HL.
17077
 
17078
        RET                     ; return.
17079
 
17080
; ------------------------------
17081
; Get from memory area ($E0 etc.)
17082
; ------------------------------
17083
; Literals $E0 to $FF
17084
; A holds $00-$1F offset.
17085
; The calculator stack increases by 5 bytes.
17086
 
17087
;; get-mem-xx
17088
L340F:  PUSH    DE              ; save STKEND
17089
        LD      HL,($5C68)      ; MEM is base address of the memory cells.
17090
        CALL    L3406           ; routine LOC-MEM so that HL = first byte
17091
        CALL    L33C0           ; routine MOVE-FP moves 5 bytes with memory
17092
                                ; check.
17093
                                ; DE now points to new STKEND.
17094
        POP     HL              ; original STKEND is now RESULT pointer.
17095
        RET                     ; return.
17096
 
17097
; --------------------------
17098
; Stack a constant (A0 etc.)
17099
; --------------------------
17100
; This routine allows a one-byte instruction to stack up to 32 constants
17101
; held in short form in a table of constants. In fact only 5 constants are
17102
; required. On entry the A register holds the literal ANDed with 1F.
17103
; It isn't very efficient and it would have been better to hold the
17104
; numbers in full, five byte form and stack them in a similar manner
17105
; to that used for semi-tone table values.
17106
 
17107
;; stk-const-xx
17108
L341B:  LD      H,D             ; save STKEND - required for result
17109
        LD      L,E             ;
17110
        EXX                     ; swap
17111
        PUSH    HL              ; save pointer to next literal
17112
        LD      HL,L32C5        ; Address: stk-zero - start of table of
17113
                                ; constants
17114
        EXX                     ;
17115
        CALL    L33F7           ; routine SKIP-CONS
17116
        CALL    L33C8           ; routine STK-CONST
17117
        EXX                     ;
17118
        POP     HL              ; restore pointer to next literal.
17119
        EXX                     ;
17120
        RET                     ; return.
17121
 
17122
; --------------------------------
17123
; Store in a memory area ($C0 etc.)
17124
; --------------------------------
17125
; Offsets $C0 to $DF
17126
; Although 32 memory storage locations can be addressed, only six
17127
; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5)
17128
; required for these are allocated. Spectrum programmers who wish to
17129
; use the floating point routines from assembly language may wish to
17130
; alter the system variable MEM to point to 160 bytes of RAM to have
17131
; use the full range available.
17132
; A holds the derived offset $00-$1F.
17133
; This is a unary operation, so on entry HL points to the last value and DE
17134
; points to STKEND.
17135
 
17136
;; st-mem-xx
17137
L342D:  PUSH    HL              ; save the result pointer.
17138
        EX      DE,HL           ; transfer to DE.
17139
        LD      HL,($5C68)      ; fetch MEM the base of memory area.
17140
        CALL    L3406           ; routine LOC-MEM sets HL to the destination.
17141
        EX      DE,HL           ; swap - HL is start, DE is destination.
17142
        CALL    L33C0           ; routine MOVE-FP.
17143
                                ; note. a short ld bc,5; ldir
17144
                                ; the embedded memory check is not required
17145
                                ; so these instructions would be faster.
17146
        EX      DE,HL           ; DE = STKEND
17147
        POP     HL              ; restore original result pointer
17148
        RET                     ; return.
17149
 
17150
; -------------------------
17151
; THE 'EXCHANGE' SUBROUTINE
17152
; -------------------------
17153
; (offset: $01 'exchange')
17154
;   This routine swaps the last two values on the calculator stack.
17155
;   On entry, as always with binary operations,
17156
;   HL=first number, DE=second number
17157
;   On exit, HL=result, DE=stkend.
17158
 
17159
;; exchange
17160
L343C:  LD      B,$05           ; there are five bytes to be swapped
17161
 
17162
; start of loop.
17163
 
17164
;; SWAP-BYTE
17165
L343E:  LD      A,(DE)          ; each byte of second
17166
        LD      C,(HL)          ; each byte of first
17167
        EX      DE,HL           ; swap pointers
17168
        LD      (DE),A          ; store each byte of first
17169
        LD      (HL),C          ; store each byte of second
17170
        INC     HL              ; advance both
17171
        INC     DE              ; pointers.
17172
        DJNZ    L343E           ; loop back to SWAP-BYTE until all 5 done.
17173
 
17174
        EX      DE,HL           ; even up the exchanges so that DE addresses
17175
                                ; STKEND.
17176
 
17177
        RET                     ; return.
17178
 
17179
; ------------------------------
17180
; THE 'SERIES GENERATOR' ROUTINE
17181
; ------------------------------
17182
; (offset: $86 'series-06')
17183
; (offset: $88 'series-08')
17184
; (offset: $8C 'series-0C')
17185
;   The Spectrum uses Chebyshev polynomials to generate approximations for
17186
;   SIN, ATN, LN and EXP.  These are named after the Russian mathematician
17187
;   Pafnuty Chebyshev, born in 1821, who did much pioneering work on numerical
17188
;   series.  As far as calculators are concerned, Chebyshev polynomials have an
17189
;   advantage over other series, for example the Taylor series, as they can
17190
;   reach an approximation in just six iterations for SIN, eight for EXP and
17191
;   twelve for LN and ATN.  The mechanics of the routine are interesting but
17192
;   for full treatment of how these are generated with demonstrations in
17193
;   Sinclair BASIC see "The Complete Spectrum ROM Disassembly" by Dr Ian Logan
17194
;   and Dr Frank O'Hara, published 1983 by Melbourne House.
17195
 
17196
;; series-xx
17197
L3449:  LD      B,A             ; parameter $00 - $1F to B counter
17198
        CALL    L335E           ; routine GEN-ENT-1 is called.
17199
                                ; A recursive call to a special entry point
17200
                                ; in the calculator that puts the B register
17201
                                ; in the system variable BREG. The return
17202
                                ; address is the next location and where
17203
                                ; the calculator will expect its first
17204
                                ; instruction - now pointed to by HL'.
17205
                                ; The previous pointer to the series of
17206
                                ; five-byte numbers goes on the machine stack.
17207
 
17208
; The initialization phase.
17209
 
17210
        DEFB    $31             ;;duplicate       x,x
17211
        DEFB    $0F             ;;addition        x+x
17212
        DEFB    $C0             ;;st-mem-0        x+x
17213
        DEFB    $02             ;;delete          .
17214
        DEFB    $A0             ;;stk-zero        0
17215
        DEFB    $C2             ;;st-mem-2        0
17216
 
17217
; a loop is now entered to perform the algebraic calculation for each of
17218
; the numbers in the series
17219
 
17220
;; G-LOOP
17221
L3453:  DEFB    $31             ;;duplicate       v,v.
17222
        DEFB    $E0             ;;get-mem-0       v,v,x+2
17223
        DEFB    $04             ;;multiply        v,v*x+2
17224
        DEFB    $E2             ;;get-mem-2       v,v*x+2,v
17225
        DEFB    $C1             ;;st-mem-1
17226
        DEFB    $03             ;;subtract
17227
        DEFB    $38             ;;end-calc
17228
 
17229
; the previous pointer is fetched from the machine stack to H'L' where it
17230
; addresses one of the numbers of the series following the series literal.
17231
 
17232
        CALL    L33C6           ; routine STK-DATA is called directly to
17233
                                ; push a value and advance H'L'.
17234
        CALL    L3362           ; routine GEN-ENT-2 recursively re-enters
17235
                                ; the calculator without disturbing
17236
                                ; system variable BREG
17237
                                ; H'L' value goes on the machine stack and is
17238
                                ; then loaded as usual with the next address.
17239
 
17240
        DEFB    $0F             ;;addition
17241
        DEFB    $01             ;;exchange
17242
        DEFB    $C2             ;;st-mem-2
17243
        DEFB    $02             ;;delete
17244
 
17245
        DEFB    $35             ;;dec-jr-nz
17246
        DEFB    $EE             ;;back to L3453, G-LOOP
17247
 
17248
; when the counted loop is complete the final subtraction yields the result
17249
; for example SIN X.
17250
 
17251
        DEFB    $E1             ;;get-mem-1
17252
        DEFB    $03             ;;subtract
17253
        DEFB    $38             ;;end-calc
17254
 
17255
        RET                     ; return with H'L' pointing to location
17256
                                ; after last number in series.
17257
 
17258
; ---------------------------------
17259
; THE 'ABSOLUTE MAGNITUDE' FUNCTION
17260
; ---------------------------------
17261
; (offset: $2A 'abs')
17262
;   This calculator literal finds the absolute value of the last value,
17263
;   integer or floating point, on calculator stack.
17264
 
17265
;; abs
17266
L346A:  LD      B,$FF           ; signal abs
17267
        JR      L3474           ; forward to NEG-TEST
17268
 
17269
; ---------------------------
17270
; THE 'UNARY MINUS' OPERATION
17271
; ---------------------------
17272
; (offset: $1B 'negate')
17273
;   Unary so on entry HL points to last value, DE to STKEND.
17274
 
17275
;; NEGATE
17276
;; negate
17277
L346E:  CALL    L34E9           ; call routine TEST-ZERO and
17278
        RET     C               ; return if so leaving zero unchanged.
17279
 
17280
        LD      B,$00           ; signal negate required before joining
17281
                                ; common code.
17282
 
17283
;; NEG-TEST
17284
L3474:  LD      A,(HL)          ; load first byte and
17285
        AND     A               ; test for zero
17286
        JR      Z,L3483         ; forward to INT-CASE if a small integer
17287
 
17288
; for floating point numbers a single bit denotes the sign.
17289
 
17290
        INC     HL              ; address the first byte of mantissa.
17291
        LD      A,B             ; action flag $FF=abs, $00=neg.
17292
        AND     $80             ; now         $80      $00
17293
        OR      (HL)            ; sets bit 7 for abs
17294
        RLA                     ; sets carry for abs and if number negative
17295
        CCF                     ; complement carry flag
17296
        RRA                     ; and rotate back in altering sign
17297
        LD      (HL),A          ; put the altered adjusted number back
17298
        DEC     HL              ; HL points to result
17299
        RET                     ; return with DE unchanged
17300
 
17301
; ---
17302
 
17303
; for integer numbers an entire byte denotes the sign.
17304
 
17305
;; INT-CASE
17306
L3483:  PUSH    DE              ; save STKEND.
17307
 
17308
        PUSH    HL              ; save pointer to the last value/result.
17309
 
17310
        CALL    L2D7F           ; routine INT-FETCH puts integer in DE
17311
                                ; and the sign in C.
17312
 
17313
        POP     HL              ; restore the result pointer.
17314
 
17315
        LD      A,B             ; $FF=abs, $00=neg
17316
        OR      C               ; $FF for abs, no change neg
17317
        CPL                     ; $00 for abs, switched for neg
17318
        LD      C,A             ; transfer result to sign byte.
17319
 
17320
        CALL    L2D8E           ; routine INT-STORE to re-write the integer.
17321
 
17322
        POP     DE              ; restore STKEND.
17323
        RET                     ; return.
17324
 
17325
; ---------------------
17326
; THE 'SIGNUM' FUNCTION
17327
; ---------------------
17328
; (offset: $29 'sgn')
17329
;   This routine replaces the last value on the calculator stack,
17330
;   which may be in floating point or integer form, with the integer values
17331
;   zero if zero, with one if positive and  with -minus one if negative.
17332
 
17333
;; sgn
17334
L3492:  CALL    L34E9           ; call routine TEST-ZERO and
17335
        RET     C               ; exit if so as no change is required.
17336
 
17337
        PUSH    DE              ; save pointer to STKEND.
17338
 
17339
        LD      DE,$0001        ; the result will be 1.
17340
        INC     HL              ; skip over the exponent.
17341
        RL      (HL)            ; rotate the sign bit into the carry flag.
17342
        DEC     HL              ; step back to point to the result.
17343
        SBC     A,A             ; byte will be $FF if negative, $00 if positive.
17344
        LD      C,A             ; store the sign byte in the C register.
17345
        CALL    L2D8E           ; routine INT-STORE to overwrite the last
17346
                                ; value with 0001 and sign.
17347
 
17348
        POP     DE              ; restore STKEND.
17349
        RET                     ; return.
17350
 
17351
; -----------------
17352
; THE 'IN' FUNCTION
17353
; -----------------
17354
; (offset: $2C 'in')
17355
;   This function reads a byte from an input port.
17356
 
17357
;; in
17358
L34A5:  CALL    L1E99           ; Routine FIND-INT2 puts port address in BC.
17359
                                ; All 16 bits are put on the address line.
17360
 
17361
        IN      A,(C)           ; Read the port.
17362
 
17363
        JR      L34B0           ; exit to STACK-A (via IN-PK-STK to save a byte
17364
                                ; of instruction code).
17365
 
17366
; -------------------
17367
; THE 'PEEK' FUNCTION
17368
; -------------------
17369
; (offset: $2B 'peek')
17370
;   This function returns the contents of a memory address.
17371
;   The entire address space can be peeked including the ROM.
17372
 
17373
;; peek
17374
L34AC:  CALL    L1E99           ; routine FIND-INT2 puts address in BC.
17375
        LD      A,(BC)          ; load contents into A register.
17376
 
17377
;; IN-PK-STK
17378
L34B0:  JP      L2D28           ; exit via STACK-A to put the value on the
17379
                                ; calculator stack.
17380
 
17381
; ------------------
17382
; THE 'USR' FUNCTION
17383
; ------------------
17384
; (offset: $2d 'usr-no')
17385
;   The USR function followed by a number 0-65535 is the method by which
17386
;   the Spectrum invokes machine code programs. This function returns the
17387
;   contents of the BC register pair.
17388
;   Note. that STACK-BC re-initializes the IY register if a user-written
17389
;   program has altered it.
17390
 
17391
;; usr-no
17392
L34B3:  CALL    L1E99           ; routine FIND-INT2 to fetch the
17393
                                ; supplied address into BC.
17394
 
17395
        LD      HL,L2D2B        ; address: STACK-BC is
17396
        PUSH    HL              ; pushed onto the machine stack.
17397
        PUSH    BC              ; then the address of the machine code
17398
                                ; routine.
17399
 
17400
        RET                     ; make an indirect jump to the routine
17401
                                ; and, hopefully, to STACK-BC also.
17402
 
17403
; -------------------------
17404
; THE 'USR STRING' FUNCTION
17405
; -------------------------
17406
; (offset: $19 'usr-$')
17407
;   The user function with a one-character string argument, calculates the
17408
;   address of the User Defined Graphic character that is in the string.
17409
;   As an alternative, the ASCII equivalent, upper or lower case,
17410
;   may be supplied. This provides a user-friendly method of redefining
17411
;   the 21 User Definable Graphics e.g.
17412
;   POKE USR "a", BIN 10000000 will put a dot in the top left corner of the
17413
;   character 144.
17414
;   Note. the curious double check on the range. With 26 UDGs the first check
17415
;   only is necessary. With anything less the second check only is required.
17416
;   It is highly likely that the first check was written by Steven Vickers.
17417
 
17418
;; usr-$
17419
L34BC:  CALL    L2BF1           ; routine STK-FETCH fetches the string
17420
                                ; parameters.
17421
        DEC     BC              ; decrease BC by
17422
        LD      A,B             ; one to test
17423
        OR      C               ; the length.
17424
        JR      NZ,L34E7        ; to REPORT-A if not a single character.
17425
 
17426
        LD      A,(DE)          ; fetch the character
17427
        CALL    L2C8D           ; routine ALPHA sets carry if 'A-Z' or 'a-z'.
17428
        JR      C,L34D3         ; forward to USR-RANGE if ASCII.
17429
 
17430
        SUB     $90             ; make UDGs range 0-20d
17431
        JR      C,L34E7         ; to REPORT-A if too low. e.g. usr " ".
17432
 
17433
        CP      $15             ; Note. this test is not necessary.
17434
        JR      NC,L34E7        ; to REPORT-A if higher than 20.
17435
 
17436
        INC     A               ; make range 1-21d to match LSBs of ASCII
17437
 
17438
;; USR-RANGE
17439
L34D3:  DEC     A               ; make range of bits 0-4 start at zero
17440
        ADD     A,A             ; multiply by eight
17441
        ADD     A,A             ; and lose any set bits
17442
        ADD     A,A             ; range now 0 - 25*8
17443
        CP      $A8             ; compare to 21*8
17444
        JR      NC,L34E7        ; to REPORT-A if originally higher
17445
                                ; than 'U','u' or graphics U.
17446
 
17447
        LD      BC,($5C7B)      ; fetch the UDG system variable value.
17448
        ADD     A,C             ; add the offset to character
17449
        LD      C,A             ; and store back in register C.
17450
        JR      NC,L34E4        ; forward to USR-STACK if no overflow.
17451
 
17452
        INC     B               ; increment high byte.
17453
 
17454
;; USR-STACK
17455
L34E4:  JP      L2D2B           ; jump back and exit via STACK-BC to store
17456
 
17457
; ---
17458
 
17459
;; REPORT-A
17460
L34E7:  RST     08H             ; ERROR-1
17461
        DEFB    $09             ; Error Report: Invalid argument
17462
 
17463
; ------------------------------
17464
; THE 'TEST FOR ZERO' SUBROUTINE
17465
; ------------------------------
17466
;   Test if top value on calculator stack is zero.  The carry flag is set if
17467
;   the last value is zero but no registers are altered.
17468
;   All five bytes will be zero but first four only need be tested.
17469
;   On entry, HL points to the exponent the first byte of the value.
17470
 
17471
;; TEST-ZERO
17472
L34E9:  PUSH    HL              ; preserve HL which is used to address.
17473
        PUSH    BC              ; preserve BC which is used as a store.
17474
        LD      B,A             ; preserve A in B.
17475
 
17476
        LD      A,(HL)          ; load first byte to accumulator
17477
        INC     HL              ; advance.
17478
        OR      (HL)            ; OR with second byte and clear carry.
17479
        INC     HL              ; advance.
17480
        OR      (HL)            ; OR with third byte.
17481
        INC     HL              ; advance.
17482
        OR      (HL)            ; OR with fourth byte.
17483
 
17484
        LD      A,B             ; restore A without affecting flags.
17485
        POP     BC              ; restore the saved
17486
        POP     HL              ; registers.
17487
 
17488
        RET     NZ              ; return if not zero and with carry reset.
17489
 
17490
        SCF                     ; set the carry flag.
17491
        RET                     ; return with carry set if zero.
17492
 
17493
; --------------------------------
17494
; THE 'GREATER THAN ZERO' OPERATOR
17495
; --------------------------------
17496
; (offset: $37 'greater-0' )
17497
;   Test if the last value on the calculator stack is greater than zero.
17498
;   This routine is also called directly from the end-tests of the comparison
17499
;   routine.
17500
 
17501
;; GREATER-0
17502
;; greater-0
17503
L34F9:  CALL    L34E9           ; routine TEST-ZERO
17504
        RET     C               ; return if was zero as this
17505
                                ; is also the Boolean 'false' value.
17506
 
17507
        LD      A,$FF           ; prepare XOR mask for sign bit
17508
        JR      L3507           ; forward to SIGN-TO-C
17509
                                ; to put sign in carry
17510
                                ; (carry will become set if sign is positive)
17511
                                ; and then overwrite location with 1 or 0
17512
                                ; as appropriate.
17513
 
17514
; ------------------
17515
; THE 'NOT' FUNCTION
17516
; ------------------
17517
; (offset: $30 'not')
17518
;   This overwrites the last value with 1 if it was zero else with zero
17519
;   if it was any other value.
17520
;
17521
;   e.g. NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0.
17522
;
17523
;   The subroutine is also called directly from the end-tests of the comparison
17524
;   operator.
17525
 
17526
;; NOT
17527
;; not
17528
L3501:  CALL    L34E9           ; routine TEST-ZERO sets carry if zero
17529
 
17530
        JR      L350B           ; to FP-0/1 to overwrite operand with
17531
                                ; 1 if carry is set else to overwrite with zero.
17532
 
17533
; ------------------------------
17534
; THE 'LESS THAN ZERO' OPERATION
17535
; ------------------------------
17536
; (offset: $36 'less-0' )
17537
;   Destructively test if last value on calculator stack is less than zero.
17538
;   Bit 7 of second byte will be set if so.
17539
 
17540
;; less-0
17541
L3506:  XOR     A               ; set XOR mask to zero
17542
                                ; (carry will become set if sign is negative).
17543
 
17544
;   transfer sign of mantissa to Carry Flag.
17545
 
17546
;; SIGN-TO-C
17547
L3507:  INC     HL              ; address 2nd byte.
17548
        XOR     (HL)            ; bit 7 of HL will be set if number is negative.
17549
        DEC     HL              ; address 1st byte again.
17550
        RLCA                    ; rotate bit 7 of A to carry.
17551
 
17552
; ----------------------------
17553
; THE 'ZERO OR ONE' SUBROUTINE
17554
; ----------------------------
17555
;   This routine places an integer value of zero or one at the addressed
17556
;   location of the calculator stack or MEM area.  The value one is written if
17557
;   carry is set on entry else zero.
17558
 
17559
;; FP-0/1
17560
L350B:  PUSH    HL              ; save pointer to the first byte
17561
        LD      A,$00           ; load accumulator with zero - without
17562
                                ; disturbing flags.
17563
        LD      (HL),A          ; zero to first byte
17564
        INC     HL              ; address next
17565
        LD      (HL),A          ; zero to 2nd byte
17566
        INC     HL              ; address low byte of integer
17567
        RLA                     ; carry to bit 0 of A
17568
        LD      (HL),A          ; load one or zero to low byte.
17569
        RRA                     ; restore zero to accumulator.
17570
        INC     HL              ; address high byte of integer.
17571
        LD      (HL),A          ; put a zero there.
17572
        INC     HL              ; address fifth byte.
17573
        LD      (HL),A          ; put a zero there.
17574
        POP     HL              ; restore pointer to the first byte.
17575
        RET                     ; return.
17576
 
17577
; -----------------
17578
; THE 'OR' OPERATOR
17579
; -----------------
17580
; (offset: $07 'or' )
17581
; The Boolean OR operator. e.g. X OR Y
17582
; The result is zero if both values are zero else a non-zero value.
17583
;
17584
; e.g.    0 OR 0  returns 0.
17585
;        -3 OR 0  returns -3.
17586
;         0 OR -3 returns 1.
17587
;        -3 OR 2  returns 1.
17588
;
17589
; A binary operation.
17590
; On entry HL points to first operand (X) and DE to second operand (Y).
17591
 
17592
;; or
17593
L351B:  EX      DE,HL           ; make HL point to second number
17594
        CALL    L34E9           ; routine TEST-ZERO
17595
        EX      DE,HL           ; restore pointers
17596
        RET     C               ; return if result was zero - first operand,
17597
                                ; now the last value, is the result.
17598
 
17599
        SCF                     ; set carry flag
17600
        JR      L350B           ; back to FP-0/1 to overwrite the first operand
17601
                                ; with the value 1.
17602
 
17603
 
17604
; ---------------------------------
17605
; THE 'NUMBER AND NUMBER' OPERATION
17606
; ---------------------------------
17607
; (offset: $08 'no-&-no')
17608
;   The Boolean AND operator.
17609
;
17610
;   e.g.    -3 AND 2  returns -3.
17611
;           -3 AND 0  returns 0.
17612
;            0 and -2 returns 0.
17613
;            0 and 0  returns 0.
17614
;
17615
;   Compare with OR routine above.
17616
 
17617
;; no-&-no
17618
L3524:  EX      DE,HL           ; make HL address second operand.
17619
 
17620
        CALL    L34E9           ; routine TEST-ZERO sets carry if zero.
17621
 
17622
        EX      DE,HL           ; restore pointers.
17623
        RET     NC              ; return if second non-zero, first is result.
17624
 
17625
;
17626
 
17627
        AND     A               ; else clear carry.
17628
        JR      L350B           ; back to FP-0/1 to overwrite first operand
17629
                                ; with zero for return value.
17630
 
17631
; ---------------------------------
17632
; THE 'STRING AND NUMBER' OPERATION
17633
; ---------------------------------
17634
; (offset: $10 'str-&-no')
17635
;   e.g. "You Win" AND score>99 will return the string if condition is true
17636
;   or the null string if false.
17637
 
17638
;; str-&-no
17639
L352D:  EX      DE,HL           ; make HL point to the number.
17640
        CALL    L34E9           ; routine TEST-ZERO.
17641
        EX      DE,HL           ; restore pointers.
17642
        RET     NC              ; return if number was not zero - the string
17643
                                ; is the result.
17644
 
17645
;   if the number was zero (false) then the null string must be returned by
17646
;   altering the length of the string on the calculator stack to zero.
17647
 
17648
        PUSH    DE              ; save pointer to the now obsolete number
17649
                                ; (which will become the new STKEND)
17650
 
17651
        DEC     DE              ; point to the 5th byte of string descriptor.
17652
        XOR     A               ; clear the accumulator.
17653
        LD      (DE),A          ; place zero in high byte of length.
17654
        DEC     DE              ; address low byte of length.
17655
        LD      (DE),A          ; place zero there - now the null string.
17656
 
17657
        POP     DE              ; restore pointer - new STKEND.
17658
        RET                     ; return.
17659
 
17660
; ---------------------------
17661
; THE 'COMPARISON' OPERATIONS
17662
; ---------------------------
17663
; (offset: $0A 'no-gr-eql')
17664
; (offset: $0B 'nos-neql')
17665
; (offset: $0C 'no-grtr')
17666
; (offset: $0D 'no-less')
17667
; (offset: $0E 'nos-eql')
17668
; (offset: $11 'str-l-eql')
17669
; (offset: $12 'str-gr-eql')
17670
; (offset: $13 'strs-neql')
17671
; (offset: $14 'str-grtr')
17672
; (offset: $15 'str-less')
17673
; (offset: $16 'strs-eql')
17674
 
17675
;   True binary operations.
17676
;   A single entry point is used to evaluate six numeric and six string
17677
;   comparisons. On entry, the calculator literal is in the B register and
17678
;   the two numeric values, or the two string parameters, are on the
17679
;   calculator stack.
17680
;   The individual bits of the literal are manipulated to group similar
17681
;   operations although the SUB 8 instruction does nothing useful and merely
17682
;   alters the string test bit.
17683
;   Numbers are compared by subtracting one from the other, strings are
17684
;   compared by comparing every character until a mismatch, or the end of one
17685
;   or both, is reached.
17686
;
17687
;   Numeric Comparisons.
17688
;   --------------------
17689
;   The 'x>y' example is the easiest as it employs straight-thru logic.
17690
;   Number y is subtracted from x and the result tested for greater-0 yielding
17691
;   a final value 1 (true) or 0 (false).
17692
;   For 'x
17693
;   calculator stack.
17694
;   For 'x=y' NOT is applied to the subtraction result yielding true if the
17695
;   difference was zero and false with anything else.
17696
;   The first three numeric comparisons are just the opposite of the last three
17697
;   so the same processing steps are used and then a final NOT is applied.
17698
;
17699
; literal    Test   No  sub 8       ExOrNot  1st RRCA  exch sub  ?   End-Tests
17700
; =========  ====   == ======== === ======== ========  ==== ===  =  === === ===
17701
; no-l-eql   x<=y   09 00000001 dec 00000000 00000000  ---- x-y  ?  --- >0? NOT
17702
; no-gr-eql  x>=y   0A 00000010 dec 00000001 10000000c swap y-x  ?  --- >0? NOT
17703
; nos-neql   x<>y   0B 00000011 dec 00000010 00000001  ---- x-y  ?  NOT --- NOT
17704
; no-grtr    x>y    0C 00000100  -  00000100 00000010  ---- x-y  ?  --- >0? ---
17705
; no-less    x0? ---
17706
; nos-eql    x=y    0E 00000110  -  00000110 00000011  ---- x-y  ?  NOT --- ---
17707
;
17708
;                                                           comp -> C/F
17709
;                                                           ====    ===
17710
; str-l-eql  x$<=y$ 11 00001001 dec 00001000 00000100  ---- x$y$ 0  !or >0? NOT
17711
; str-gr-eql x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0  !or >0? NOT
17712
; strs-neql  x$<>y$ 13 00001011 dec 00001010 00000101  ---- x$y$ 0  !or >0? NOT
17713
; str-grtr   x$>y$  14 00001100  -  00001100 00000110  ---- x$y$ 0  !or >0? ---
17714
; str-less   x$0? ---
17715
; strs-eql   x$=y$  16 00001110  -  00001110 00000111  ---- x$y$ 0  !or >0? ---
17716
;
17717
;   String comparisons are a little different in that the eql/neql carry flag
17718
;   from the 2nd RRCA is, as before, fed into the first of the end tests but
17719
;   along the way it gets modified by the comparison process. The result on the
17720
;   stack always starts off as zero and the carry fed in determines if NOT is
17721
;   applied to it. So the only time the greater-0 test is applied is if the
17722
;   stack holds zero which is not very efficient as the test will always yield
17723
;   zero. The most likely explanation is that there were once separate end tests
17724
;   for numbers and strings.
17725
 
17726
;; no-l-eql,etc.
17727
L353B:  LD      A,B             ; transfer literal to accumulator.
17728
        SUB     $08             ; subtract eight - which is not useful.
17729
 
17730
        BIT     2,A             ; isolate '>', '<', '='.
17731
 
17732
        JR      NZ,L3543        ; skip to EX-OR-NOT with these.
17733
 
17734
        DEC     A               ; else make $00-$02, $08-$0A to match bits 0-2.
17735
 
17736
;; EX-OR-NOT
17737
L3543:  RRCA                    ; the first RRCA sets carry for a swap.
17738
        JR      NC,L354E        ; forward to NU-OR-STR with other 8 cases
17739
 
17740
; for the other 4 cases the two values on the calculator stack are exchanged.
17741
 
17742
        PUSH    AF              ; save A and carry.
17743
        PUSH    HL              ; save HL - pointer to first operand.
17744
                                ; (DE points to second operand).
17745
 
17746
        CALL    L343C           ; routine exchange swaps the two values.
17747
                                ; (HL = second operand, DE = STKEND)
17748
 
17749
        POP     DE              ; DE = first operand
17750
        EX      DE,HL           ; as we were.
17751
        POP     AF              ; restore A and carry.
17752
 
17753
; Note. it would be better if the 2nd RRCA preceded the string test.
17754
; It would save two duplicate bytes and if we also got rid of that sub 8
17755
; at the beginning we wouldn't have to alter which bit we test.
17756
 
17757
;; NU-OR-STR
17758
L354E:  BIT     2,A             ; test if a string comparison.
17759
        JR      NZ,L3559        ; forward to STRINGS if so.
17760
 
17761
; continue with numeric comparisons.
17762
 
17763
        RRCA                    ; 2nd RRCA causes eql/neql to set carry.
17764
        PUSH    AF              ; save A and carry
17765
 
17766
        CALL    L300F           ; routine subtract leaves result on stack.
17767
        JR      L358C           ; forward to END-TESTS
17768
 
17769
; ---
17770
 
17771
;; STRINGS
17772
L3559:  RRCA                    ; 2nd RRCA causes eql/neql to set carry.
17773
        PUSH    AF              ; save A and carry.
17774
 
17775
        CALL    L2BF1           ; routine STK-FETCH gets 2nd string params
17776
        PUSH    DE              ; save start2 *.
17777
        PUSH    BC              ; and the length.
17778
 
17779
        CALL    L2BF1           ; routine STK-FETCH gets 1st string
17780
                                ; parameters - start in DE, length in BC.
17781
        POP     HL              ; restore length of second to HL.
17782
 
17783
; A loop is now entered to compare, by subtraction, each corresponding character
17784
; of the strings. For each successful match, the pointers are incremented and
17785
; the lengths decreased and the branch taken back to here. If both string
17786
; remainders become null at the same time, then an exact match exists.
17787
 
17788
;; BYTE-COMP
17789
L3564:  LD      A,H             ; test if the second string
17790
        OR      L               ; is the null string and hold flags.
17791
 
17792
        EX      (SP),HL         ; put length2 on stack, bring start2 to HL *.
17793
        LD      A,B             ; hi byte of length1 to A
17794
 
17795
        JR      NZ,L3575        ; forward to SEC-PLUS if second not null.
17796
 
17797
        OR      C               ; test length of first string.
17798
 
17799
;; SECND-LOW
17800
L356B:  POP     BC              ; pop the second length off stack.
17801
        JR      Z,L3572         ; forward to BOTH-NULL if first string is also
17802
                                ; of zero length.
17803
 
17804
; the true condition - first is longer than second (SECND-LESS)
17805
 
17806
        POP     AF              ; restore carry (set if eql/neql)
17807
        CCF                     ; complement carry flag.
17808
                                ; Note. equality becomes false.
17809
                                ; Inequality is true. By swapping or applying
17810
                                ; a terminal 'not', all comparisons have been
17811
                                ; manipulated so that this is success path.
17812
        JR      L3588           ; forward to leave via STR-TEST
17813
 
17814
; ---
17815
; the branch was here with a match
17816
 
17817
;; BOTH-NULL
17818
L3572:  POP     AF              ; restore carry - set for eql/neql
17819
        JR      L3588           ; forward to STR-TEST
17820
 
17821
; ---
17822
; the branch was here when 2nd string not null and low byte of first is yet
17823
; to be tested.
17824
 
17825
 
17826
;; SEC-PLUS
17827
L3575:  OR      C               ; test the length of first string.
17828
        JR      Z,L3585         ; forward to FRST-LESS if length is zero.
17829
 
17830
; both strings have at least one character left.
17831
 
17832
        LD      A,(DE)          ; fetch character of first string.
17833
        SUB     (HL)            ; subtract with that of 2nd string.
17834
        JR      C,L3585         ; forward to FRST-LESS if carry set
17835
 
17836
        JR      NZ,L356B        ; back to SECND-LOW and then STR-TEST
17837
                                ; if not exact match.
17838
 
17839
        DEC     BC              ; decrease length of 1st string.
17840
        INC     DE              ; increment 1st string pointer.
17841
 
17842
        INC     HL              ; increment 2nd string pointer.
17843
        EX      (SP),HL         ; swap with length on stack
17844
        DEC     HL              ; decrement 2nd string length
17845
        JR      L3564           ; back to BYTE-COMP
17846
 
17847
; ---
17848
; the false condition.
17849
 
17850
;; FRST-LESS
17851
L3585:  POP     BC              ; discard length
17852
        POP     AF              ; pop A
17853
        AND     A               ; clear the carry for false result.
17854
 
17855
; ---
17856
; exact match and x$>y$ rejoin here
17857
 
17858
;; STR-TEST
17859
L3588:  PUSH    AF              ; save A and carry
17860
 
17861
        RST     28H             ;; FP-CALC
17862
        DEFB    $A0             ;;stk-zero      an initial false value.
17863
        DEFB    $38             ;;end-calc
17864
 
17865
; both numeric and string paths converge here.
17866
 
17867
;; END-TESTS
17868
L358C:  POP     AF              ; pop carry  - will be set if eql/neql
17869
        PUSH    AF              ; save it again.
17870
 
17871
        CALL    C,L3501         ; routine NOT sets true(1) if equal(0)
17872
                                ; or, for strings, applies true result.
17873
 
17874
        POP     AF              ; pop carry and
17875
        PUSH    AF              ; save A
17876
 
17877
        CALL    NC,L34F9        ; routine GREATER-0 tests numeric subtraction
17878
                                ; result but also needlessly tests the string
17879
                                ; value for zero - it must be.
17880
 
17881
        POP     AF              ; pop A
17882
        RRCA                    ; the third RRCA - test for '<=', '>=' or '<>'.
17883
        CALL    NC,L3501        ; apply a terminal NOT if so.
17884
        RET                     ; return.
17885
 
17886
; ------------------------------------
17887
; THE 'STRING CONCATENATION' OPERATION
17888
; ------------------------------------
17889
; (offset: $17 'strs-add')
17890
;   This literal combines two strings into one e.g. LET a$ = b$ + c$
17891
;   The two parameters of the two strings to be combined are on the stack.
17892
 
17893
;; strs-add
17894
L359C:  CALL    L2BF1           ; routine STK-FETCH fetches string parameters
17895
                                ; and deletes calculator stack entry.
17896
        PUSH    DE              ; save start address.
17897
        PUSH    BC              ; and length.
17898
 
17899
        CALL    L2BF1           ; routine STK-FETCH for first string
17900
        POP     HL              ; re-fetch first length
17901
        PUSH    HL              ; and save again
17902
        PUSH    DE              ; save start of second string
17903
        PUSH    BC              ; and its length.
17904
 
17905
        ADD     HL,BC           ; add the two lengths.
17906
        LD      B,H             ; transfer to BC
17907
        LD      C,L             ; and create
17908
        RST     30H             ; BC-SPACES in workspace.
17909
                                ; DE points to start of space.
17910
 
17911
        CALL    L2AB2           ; routine STK-STO-$ stores parameters
17912
                                ; of new string updating STKEND.
17913
 
17914
        POP     BC              ; length of first
17915
        POP     HL              ; address of start
17916
        LD      A,B             ; test for
17917
        OR      C               ; zero length.
17918
        JR      Z,L35B7         ; to OTHER-STR if null string
17919
 
17920
        LDIR                    ; copy string to workspace.
17921
 
17922
;; OTHER-STR
17923
L35B7:  POP     BC              ; now second length
17924
        POP     HL              ; and start of string
17925
        LD      A,B             ; test this one
17926
        OR      C               ; for zero length
17927
        JR      Z,L35BF         ; skip forward to STK-PNTRS if so as complete.
17928
 
17929
        LDIR                    ; else copy the bytes.
17930
                                ; and continue into next routine which
17931
                                ; sets the calculator stack pointers.
17932
 
17933
; -----------------------------------
17934
; THE 'SET STACK POINTERS' SUBROUTINE
17935
; -----------------------------------
17936
;   Register DE is set to STKEND and HL, the result pointer, is set to five
17937
;   locations below this.
17938
;   This routine is used when it is inconvenient to save these values at the
17939
;   time the calculator stack is manipulated due to other activity on the
17940
;   machine stack.
17941
;   This routine is also used to terminate the VAL and READ-IN  routines for
17942
;   the same reason and to initialize the calculator stack at the start of
17943
;   the CALCULATE routine.
17944
 
17945
;; STK-PNTRS
17946
L35BF:  LD      HL,($5C65)      ; fetch STKEND value from system variable.
17947
        LD      DE,$FFFB        ; the value -5
17948
        PUSH    HL              ; push STKEND value.
17949
 
17950
        ADD     HL,DE           ; subtract 5 from HL.
17951
 
17952
        POP     DE              ; pop STKEND to DE.
17953
        RET                     ; return.
17954
 
17955
; -------------------
17956
; THE 'CHR$' FUNCTION
17957
; -------------------
17958
; (offset: $2f 'chr$')
17959
;   This function returns a single character string that is a result of
17960
;   converting a number in the range 0-255 to a string e.g. CHR$ 65 = "A".
17961
 
17962
;; chrs
17963
L35C9:  CALL    L2DD5           ; routine FP-TO-A puts the number in A.
17964
 
17965
        JR      C,L35DC         ; forward to REPORT-Bd if overflow
17966
        JR      NZ,L35DC        ; forward to REPORT-Bd if negative
17967
 
17968
        PUSH    AF              ; save the argument.
17969
 
17970
        LD      BC,$0001        ; one space required.
17971
        RST     30H             ; BC-SPACES makes DE point to start
17972
 
17973
        POP     AF              ; restore the number.
17974
 
17975
        LD      (DE),A          ; and store in workspace
17976
 
17977
        CALL    L2AB2           ; routine STK-STO-$ stacks descriptor.
17978
 
17979
        EX      DE,HL           ; make HL point to result and DE to STKEND.
17980
        RET                     ; return.
17981
 
17982
; ---
17983
 
17984
;; REPORT-Bd
17985
L35DC:  RST     08H             ; ERROR-1
17986
        DEFB    $0A             ; Error Report: Integer out of range
17987
 
17988
; ----------------------------
17989
; THE 'VAL and VAL$' FUNCTIONS
17990
; ----------------------------
17991
; (offset: $1d 'val')
17992
; (offset: $18 'val$')
17993
;   VAL treats the characters in a string as a numeric expression.
17994
;   e.g. VAL "2.3" = 2.3, VAL "2+4" = 6, VAL ("2" + "4") = 24.
17995
;   VAL$ treats the characters in a string as a string expression.
17996
;   e.g. VAL$ (z$+"(2)") = a$(2) if z$ happens to be "a$".
17997
 
17998
;; val
17999
;; val$
18000
L35DE:  LD      HL,($5C5D)      ; fetch value of system variable CH_ADD
18001
        PUSH    HL              ; and save on the machine stack.
18002
        LD      A,B             ; fetch the literal (either $1D or $18).
18003
        ADD     A,$E3           ; add $E3 to form $00 (setting carry) or $FB.
18004
        SBC     A,A             ; now form $FF bit 6 = numeric result
18005
                                ; or $00 bit 6 = string result.
18006
        PUSH    AF              ; save this mask on the stack
18007
 
18008
        CALL    L2BF1           ; routine STK-FETCH fetches the string operand
18009
                                ; from calculator stack.
18010
 
18011
        PUSH    DE              ; save the address of the start of the string.
18012
        INC     BC              ; increment the length for a carriage return.
18013
 
18014
        RST     30H             ; BC-SPACES creates the space in workspace.
18015
        POP     HL              ; restore start of string to HL.
18016
        LD      ($5C5D),DE      ; load CH_ADD with start DE in workspace.
18017
 
18018
        PUSH    DE              ; save the start in workspace
18019
        LDIR                    ; copy string from program or variables or
18020
                                ; workspace to the workspace area.
18021
        EX      DE,HL           ; end of string + 1 to HL
18022
        DEC     HL              ; decrement HL to point to end of new area.
18023
        LD      (HL),$0D        ; insert a carriage return at end.
18024
        RES     7,(IY+$01)      ; update FLAGS  - signal checking syntax.
18025
        CALL    L24FB           ; routine SCANNING evaluates string
18026
                                ; expression and result.
18027
 
18028
        RST     18H             ; GET-CHAR fetches next character.
18029
        CP      $0D             ; is it the expected carriage return ?
18030
        JR      NZ,L360C        ; forward to V-RPORT-C if not
18031
                                ; 'Nonsense in BASIC'.
18032
 
18033
        POP     HL              ; restore start of string in workspace.
18034
        POP     AF              ; restore expected result flag (bit 6).
18035
        XOR     (IY+$01)        ; xor with FLAGS now updated by SCANNING.
18036
        AND     $40             ; test bit 6 - should be zero if result types
18037
                                ; match.
18038
 
18039
;; V-RPORT-C
18040
L360C:  JP      NZ,L1C8A        ; jump back to REPORT-C with a result mismatch.
18041
 
18042
        LD      ($5C5D),HL      ; set CH_ADD to the start of the string again.
18043
        SET     7,(IY+$01)      ; update FLAGS  - signal running program.
18044
        CALL    L24FB           ; routine SCANNING evaluates the string
18045
                                ; in full leaving result on calculator stack.
18046
 
18047
        POP     HL              ; restore saved character address in program.
18048
        LD      ($5C5D),HL      ; and reset the system variable CH_ADD.
18049
 
18050
        JR      L35BF           ; back to exit via STK-PNTRS.
18051
                                ; resetting the calculator stack pointers
18052
                                ; HL and DE from STKEND as it wasn't possible
18053
                                ; to preserve them during this routine.
18054
 
18055
; -------------------
18056
; THE 'STR$' FUNCTION
18057
; -------------------
18058
; (offset: $2e 'str$')
18059
;   This function produces a string comprising the characters that would appear
18060
;   if the numeric argument were printed.
18061
;   e.g. STR$ (1/10) produces "0.1".
18062
 
18063
;; str$
18064
L361F:  LD      BC,$0001        ; create an initial byte in workspace
18065
        RST     30H             ; using BC-SPACES restart.
18066
 
18067
        LD      ($5C5B),HL      ; set system variable K_CUR to new location.
18068
        PUSH    HL              ; and save start on machine stack also.
18069
 
18070
        LD      HL,($5C51)      ; fetch value of system variable CURCHL
18071
        PUSH    HL              ; and save that too.
18072
 
18073
        LD      A,$FF           ; select system channel 'R'.
18074
        CALL    L1601           ; routine CHAN-OPEN opens it.
18075
        CALL    L2DE3           ; routine PRINT-FP outputs the number to
18076
                                ; workspace updating K-CUR.
18077
 
18078
        POP     HL              ; restore current channel.
18079
        CALL    L1615           ; routine CHAN-FLAG resets flags.
18080
 
18081
        POP     DE              ; fetch saved start of string to DE.
18082
        LD      HL,($5C5B)      ; load HL with end of string from K_CUR.
18083
 
18084
        AND     A               ; prepare for true subtraction.
18085
        SBC     HL,DE           ; subtract start from end to give length.
18086
        LD      B,H             ; transfer the length to
18087
        LD      C,L             ; the BC register pair.
18088
 
18089
        CALL    L2AB2           ; routine STK-STO-$ stores string parameters
18090
                                ; on the calculator stack.
18091
 
18092
        EX      DE,HL           ; HL = last value, DE = STKEND.
18093
        RET                     ; return.
18094
 
18095
; ------------------------
18096
; THE 'READ-IN' SUBROUTINE
18097
; ------------------------
18098
; (offset: $1a 'read-in')
18099
;   This is the calculator literal used by the INKEY$ function when a '#'
18100
;   is encountered after the keyword.
18101
;   INKEY$ # does not interact correctly with the keyboard, #0 or #1, and
18102
;   its uses are for other channels.
18103
 
18104
;; read-in
18105
L3645:  CALL    L1E94           ; routine FIND-INT1 fetches stream to A
18106
        CP      $10             ; compare with 16 decimal.
18107
        JP      NC,L1E9F        ; JUMP to REPORT-Bb if not in range 0 - 15.
18108
                                ; 'Integer out of range'
18109
                                ; (REPORT-Bd is within range)
18110
 
18111
        LD      HL,($5C51)      ; fetch current channel CURCHL
18112
        PUSH    HL              ; save it
18113
 
18114
        CALL    L1601           ; routine CHAN-OPEN opens channel
18115
 
18116
        CALL    L15E6           ; routine INPUT-AD - the channel must have an
18117
                                ; input stream or else error here from stream
18118
                                ; stub.
18119
        LD      BC,$0000        ; initialize length of string to zero
18120
        JR      NC,L365F        ; forward to R-I-STORE if no key detected.
18121
 
18122
        INC     C               ; increase length to one.
18123
 
18124
        RST     30H             ; BC-SPACES creates space for one character
18125
                                ; in workspace.
18126
        LD      (DE),A          ; the character is inserted.
18127
 
18128
;; R-I-STORE
18129
L365F:  CALL    L2AB2           ; routine STK-STO-$ stacks the string
18130
                                ; parameters.
18131
        POP     HL              ; restore current channel address
18132
 
18133
        CALL    L1615           ; routine CHAN-FLAG resets current channel
18134
                                ; system variable and flags.
18135
 
18136
        JP      L35BF           ; jump back to STK-PNTRS
18137
 
18138
; -------------------
18139
; THE 'CODE' FUNCTION
18140
; -------------------
18141
; (offset: $1c 'code')
18142
;   Returns the ASCII code of a character or first character of a string
18143
;   e.g. CODE "Aardvark" = 65, CODE "" = 0.
18144
 
18145
;; code
18146
L3669:  CALL    L2BF1           ; routine STK-FETCH to fetch and delete the
18147
                                ; string parameters.
18148
                                ; DE points to the start, BC holds the length.
18149
 
18150
        LD      A,B             ; test length
18151
        OR      C               ; of the string.
18152
        JR      Z,L3671         ; skip to STK-CODE with zero if the null string.
18153
 
18154
        LD      A,(DE)          ; else fetch the first character.
18155
 
18156
;; STK-CODE
18157
L3671:  JP      L2D28           ; jump back to STACK-A (with memory check)
18158
 
18159
; ------------------
18160
; THE 'LEN' FUNCTION
18161
; ------------------
18162
; (offset: $1e 'len')
18163
;   Returns the length of a string.
18164
;   In Sinclair BASIC strings can be more than twenty thousand characters long
18165
;   so a sixteen-bit register is required to store the length
18166
 
18167
;; len
18168
L3674:  CALL    L2BF1           ; Routine STK-FETCH to fetch and delete the
18169
                                ; string parameters from the calculator stack.
18170
                                ; Register BC now holds the length of string.
18171
 
18172
        JP      L2D2B           ; Jump back to STACK-BC to save result on the
18173
                                ; calculator stack (with memory check).
18174
 
18175
; -------------------------------------
18176
; THE 'DECREASE THE COUNTER' SUBROUTINE
18177
; -------------------------------------
18178
; (offset: $35 'dec-jr-nz')
18179
;   The calculator has an instruction that decrements a single-byte
18180
;   pseudo-register and makes consequential relative jumps just like
18181
;   the Z80's DJNZ instruction.
18182
 
18183
;; dec-jr-nz
18184
L367A:  EXX                     ; switch in set that addresses code
18185
 
18186
        PUSH    HL              ; save pointer to offset byte
18187
        LD      HL,$5C67        ; address BREG in system variables
18188
        DEC     (HL)            ; decrement it
18189
        POP     HL              ; restore pointer
18190
 
18191
        JR      NZ,L3687        ; to JUMP-2 if not zero
18192
 
18193
        INC     HL              ; step past the jump length.
18194
        EXX                     ; switch in the main set.
18195
        RET                     ; return.
18196
 
18197
; Note. as a general rule the calculator avoids using the IY register
18198
; otherwise the cumbersome 4 instructions in the middle could be replaced by
18199
; dec (iy+$2d) - three bytes instead of six.
18200
 
18201
 
18202
; ---------------------
18203
; THE 'JUMP' SUBROUTINE
18204
; ---------------------
18205
; (offset: $33 'jump')
18206
;   This enables the calculator to perform relative jumps just like the Z80
18207
;   chip's JR instruction.
18208
 
18209
;; jump
18210
;; JUMP
18211
L3686:  EXX                     ; switch in pointer set
18212
 
18213
;; JUMP-2
18214
L3687:  LD      E,(HL)          ; the jump byte 0-127 forward, 128-255 back.
18215
        LD      A,E             ; transfer to accumulator.
18216
        RLA                     ; if backward jump, carry is set.
18217
        SBC     A,A             ; will be $FF if backward or $00 if forward.
18218
        LD      D,A             ; transfer to high byte.
18219
        ADD     HL,DE           ; advance calculator pointer forward or back.
18220
 
18221
        EXX                     ; switch back.
18222
        RET                     ; return.
18223
 
18224
; --------------------------
18225
; THE 'JUMP-TRUE' SUBROUTINE
18226
; --------------------------
18227
; (offset: $00 'jump-true')
18228
;   This enables the calculator to perform conditional relative jumps dependent
18229
;   on whether the last test gave a true result.
18230
 
18231
;; jump-true
18232
L368F:  INC     DE              ; Collect the
18233
        INC     DE              ; third byte
18234
        LD      A,(DE)          ; of the test
18235
        DEC     DE              ; result and
18236
        DEC     DE              ; backtrack.
18237
 
18238
        AND     A               ; Is result 0 or 1 ?
18239
        JR      NZ,L3686        ; Back to JUMP if true (1).
18240
 
18241
        EXX                     ; Else switch in the pointer set.
18242
        INC     HL              ; Step past the jump length.
18243
        EXX                     ; Switch in the main set.
18244
        RET                     ; Return.
18245
 
18246
; -------------------------
18247
; THE 'END-CALC' SUBROUTINE
18248
; -------------------------
18249
; (offset: $38 'end-calc')
18250
;   The end-calc literal terminates a mini-program written in the Spectrum's
18251
;   internal language.
18252
 
18253
;; end-calc
18254
L369B:  POP     AF              ; Drop the calculator return address RE-ENTRY
18255
        EXX                     ; Switch to the other set.
18256
 
18257
        EX      (SP),HL         ; Transfer H'L' to machine stack for the
18258
                                ; return address.
18259
                                ; When exiting recursion, then the previous
18260
                                ; pointer is transferred to H'L'.
18261
 
18262
        EXX                     ; Switch back to main set.
18263
        RET                     ; Return.
18264
 
18265
 
18266
; ------------------------
18267
; THE 'MODULUS' SUBROUTINE
18268
; ------------------------
18269
; (offset: $32 'n-mod-m')
18270
; (n1,n2 -- r,q)
18271
;   Similar to FORTH's 'divide mod' /MOD
18272
;   On the Spectrum, this is only used internally by the RND function and could
18273
;   have been implemented inline.  On the ZX81, this calculator routine was also
18274
;   used by PRINT-FP.
18275
 
18276
;; n-mod-m
18277
L36A0:  RST     28H             ;; FP-CALC          17, 3.
18278
        DEFB    $C0             ;;st-mem-0          17, 3.
18279
        DEFB    $02             ;;delete            17.
18280
        DEFB    $31             ;;duplicate         17, 17.
18281
        DEFB    $E0             ;;get-mem-0         17, 17, 3.
18282
        DEFB    $05             ;;division          17, 17/3.
18283
        DEFB    $27             ;;int               17, 5.
18284
        DEFB    $E0             ;;get-mem-0         17, 5, 3.
18285
        DEFB    $01             ;;exchange          17, 3, 5.
18286
        DEFB    $C0             ;;st-mem-0          17, 3, 5.
18287
        DEFB    $04             ;;multiply          17, 15.
18288
        DEFB    $03             ;;subtract          2.
18289
        DEFB    $E0             ;;get-mem-0         2, 5.
18290
        DEFB    $38             ;;end-calc          2, 5.
18291
 
18292
        RET                     ; return.
18293
 
18294
 
18295
; ------------------
18296
; THE 'INT' FUNCTION
18297
; ------------------
18298
; (offset $27: 'int' )
18299
; This function returns the integer of x, which is just the same as truncate
18300
; for positive numbers. The truncate literal truncates negative numbers
18301
; upwards so that -3.4 gives -3 whereas the BASIC INT function has to
18302
; truncate negative numbers down so that INT -3.4 is -4.
18303
; It is best to work through using, say, +-3.4 as examples.
18304
 
18305
;; int
18306
L36AF:  RST     28H             ;; FP-CALC              x.    (= 3.4 or -3.4).
18307
        DEFB    $31             ;;duplicate             x, x.
18308
        DEFB    $36             ;;less-0                x, (1/0)
18309
        DEFB    $00             ;;jump-true             x, (1/0)
18310
        DEFB    $04             ;;to L36B7, X-NEG
18311
 
18312
        DEFB    $3A             ;;truncate              trunc 3.4 = 3.
18313
        DEFB    $38             ;;end-calc              3.
18314
 
18315
        RET                     ; return with + int x on stack.
18316
 
18317
; ---
18318
 
18319
 
18320
;; X-NEG
18321
L36B7:  DEFB    $31             ;;duplicate             -3.4, -3.4.
18322
        DEFB    $3A             ;;truncate              -3.4, -3.
18323
        DEFB    $C0             ;;st-mem-0              -3.4, -3.
18324
        DEFB    $03             ;;subtract              -.4
18325
        DEFB    $E0             ;;get-mem-0             -.4, -3.
18326
        DEFB    $01             ;;exchange              -3, -.4.
18327
        DEFB    $30             ;;not                   -3, (0).
18328
        DEFB    $00             ;;jump-true             -3.
18329
        DEFB    $03             ;;to L36C2, EXIT        -3.
18330
 
18331
        DEFB    $A1             ;;stk-one               -3, 1.
18332
        DEFB    $03             ;;subtract              -4.
18333
 
18334
;; EXIT
18335
L36C2:  DEFB    $38             ;;end-calc              -4.
18336
 
18337
        RET                     ; return.
18338
 
18339
 
18340
; ------------------
18341
; THE 'EXP' FUNCTION
18342
; ------------------
18343
; (offset $26: 'exp')
18344
;   The exponential function EXP x is equal to e^x, where e is the mathematical
18345
;   name for a number approximated to 2.718281828.
18346
;   ERROR 6 if argument is more than about 88.
18347
 
18348
;; EXP
18349
;; exp
18350
L36C4:  RST     28H             ;; FP-CALC
18351
        DEFB    $3D             ;;re-stack      (not required - mult will do)
18352
        DEFB    $34             ;;stk-data
18353
        DEFB    $F1             ;;Exponent: $81, Bytes: 4
18354
        DEFB    $38,$AA,$3B,$29 ;;
18355
        DEFB    $04             ;;multiply
18356
        DEFB    $31             ;;duplicate
18357
        DEFB    $27             ;;int
18358
        DEFB    $C3             ;;st-mem-3
18359
        DEFB    $03             ;;subtract
18360
        DEFB    $31             ;;duplicate
18361
        DEFB    $0F             ;;addition
18362
        DEFB    $A1             ;;stk-one
18363
        DEFB    $03             ;;subtract
18364
        DEFB    $88             ;;series-08
18365
        DEFB    $13             ;;Exponent: $63, Bytes: 1
18366
        DEFB    $36             ;;(+00,+00,+00)
18367
        DEFB    $58             ;;Exponent: $68, Bytes: 2
18368
        DEFB    $65,$66         ;;(+00,+00)
18369
        DEFB    $9D             ;;Exponent: $6D, Bytes: 3
18370
        DEFB    $78,$65,$40     ;;(+00)
18371
        DEFB    $A2             ;;Exponent: $72, Bytes: 3
18372
        DEFB    $60,$32,$C9     ;;(+00)
18373
        DEFB    $E7             ;;Exponent: $77, Bytes: 4
18374
        DEFB    $21,$F7,$AF,$24 ;;
18375
        DEFB    $EB             ;;Exponent: $7B, Bytes: 4
18376
        DEFB    $2F,$B0,$B0,$14 ;;
18377
        DEFB    $EE             ;;Exponent: $7E, Bytes: 4
18378
        DEFB    $7E,$BB,$94,$58 ;;
18379
        DEFB    $F1             ;;Exponent: $81, Bytes: 4
18380
        DEFB    $3A,$7E,$F8,$CF ;;
18381
        DEFB    $E3             ;;get-mem-3
18382
        DEFB    $38             ;;end-calc
18383
 
18384
        CALL    L2DD5           ; routine FP-TO-A
18385
        JR      NZ,L3705        ; to N-NEGTV
18386
 
18387
        JR      C,L3703         ; to REPORT-6b
18388
                                ; 'Number too big'
18389
 
18390
        ADD     A,(HL)          ;
18391
        JR      NC,L370C        ; to RESULT-OK
18392
 
18393
 
18394
;; REPORT-6b
18395
L3703:  RST     08H             ; ERROR-1
18396
        DEFB    $05             ; Error Report: Number too big
18397
 
18398
; ---
18399
 
18400
;; N-NEGTV
18401
L3705:  JR      C,L370E         ; to RSLT-ZERO
18402
 
18403
        SUB     (HL)            ;
18404
        JR      NC,L370E        ; to RSLT-ZERO
18405
 
18406
        NEG                     ; Negate
18407
 
18408
;; RESULT-OK
18409
L370C:  LD      (HL),A          ;
18410
        RET                     ; return.
18411
 
18412
; ---
18413
 
18414
 
18415
;; RSLT-ZERO
18416
L370E:  RST     28H             ;; FP-CALC
18417
        DEFB    $02             ;;delete
18418
        DEFB    $A0             ;;stk-zero
18419
        DEFB    $38             ;;end-calc
18420
 
18421
        RET                     ; return.
18422
 
18423
 
18424
; --------------------------------
18425
; THE 'NATURAL LOGARITHM' FUNCTION
18426
; --------------------------------
18427
; (offset $25: 'ln')
18428
;   Function to calculate the natural logarithm (to the base e ).
18429
;   Natural logarithms were devised in 1614 by well-traveled Scotsman John
18430
;   Napier who noted
18431
;   "Nothing doth more molest and hinder calculators than the multiplications,
18432
;    divisions, square and cubical extractions of great numbers".
18433
;
18434
;   Napier's logarithms enabled the above operations to be accomplished by
18435
;   simple addition and subtraction simplifying the navigational and
18436
;   astronomical calculations which beset his age.
18437
;   Napier's logarithms were quickly overtaken by logarithms to the base 10
18438
;   devised, in conjunction with Napier, by Henry Briggs a Cambridge-educated
18439
;   professor of Geometry at Oxford University. These simplified the layout
18440
;   of the tables enabling humans to easily scale calculations.
18441
;
18442
;   It is only recently with the introduction of pocket calculators and machines
18443
;   like the ZX Spectrum that natural logarithms are once more at the fore,
18444
;   although some computers retain logarithms to the base ten.
18445
;
18446
;   'Natural' logarithms are powers to the base 'e', which like 'pi' is a
18447
;   naturally occurring number in branches of mathematics.
18448
;   Like 'pi' also, 'e' is an irrational number and starts 2.718281828...
18449
;
18450
;   The tabular use of logarithms was that to multiply two numbers one looked
18451
;   up their two logarithms in the tables, added them together and then looked
18452
;   for the result in a table of antilogarithms to give the desired product.
18453
;
18454
;   The EXP function is the BASIC equivalent of a calculator's 'antiln' function
18455
;   and by picking any two numbers, 1.72 and 6.89 say,
18456
;     10 PRINT EXP ( LN 1.72 + LN 6.89 )
18457
;   will give just the same result as
18458
;     20 PRINT 1.72 * 6.89.
18459
;   Division is accomplished by subtracting the two logs.
18460
;
18461
;   Napier also mentioned "square and cubicle extractions".
18462
;   To raise a number to the power 3, find its 'ln', multiply by 3 and find the
18463
;   'antiln'.  e.g. PRINT EXP( LN 4 * 3 )  gives 64.
18464
;   Similarly to find the n'th root divide the logarithm by 'n'.
18465
;   The ZX81 ROM used PRINT EXP ( LN 9 / 2 ) to find the square root of the
18466
;   number 9. The Napieran square root function is just a special case of
18467
;   the 'to_power' function. A cube root or indeed any root/power would be just
18468
;   as simple.
18469
 
18470
;   First test that the argument to LN is a positive, non-zero number.
18471
;   Error A if the argument is 0 or negative.
18472
 
18473
;; ln
18474
L3713:  RST     28H             ;; FP-CALC
18475
        DEFB    $3D             ;;re-stack
18476
        DEFB    $31             ;;duplicate
18477
        DEFB    $37             ;;greater-0
18478
        DEFB    $00             ;;jump-true
18479
        DEFB    $04             ;;to L371C, VALID
18480
 
18481
        DEFB    $38             ;;end-calc
18482
 
18483
 
18484
;; REPORT-Ab
18485
L371A:  RST     08H             ; ERROR-1
18486
        DEFB    $09             ; Error Report: Invalid argument
18487
 
18488
;; VALID
18489
L371C:  DEFB    $A0             ;;stk-zero              Note. not
18490
        DEFB    $02             ;;delete                necessary.
18491
        DEFB    $38             ;;end-calc
18492
        LD      A,(HL)          ;
18493
 
18494
        LD      (HL),$80        ;
18495
        CALL    L2D28           ; routine STACK-A
18496
 
18497
        RST     28H             ;; FP-CALC
18498
        DEFB    $34             ;;stk-data
18499
        DEFB    $38             ;;Exponent: $88, Bytes: 1
18500
        DEFB    $00             ;;(+00,+00,+00)
18501
        DEFB    $03             ;;subtract
18502
        DEFB    $01             ;;exchange
18503
        DEFB    $31             ;;duplicate
18504
        DEFB    $34             ;;stk-data
18505
        DEFB    $F0             ;;Exponent: $80, Bytes: 4
18506
        DEFB    $4C,$CC,$CC,$CD ;;
18507
        DEFB    $03             ;;subtract
18508
        DEFB    $37             ;;greater-0
18509
        DEFB    $00             ;;jump-true
18510
        DEFB    $08             ;;to L373D, GRE.8
18511
 
18512
        DEFB    $01             ;;exchange
18513
        DEFB    $A1             ;;stk-one
18514
        DEFB    $03             ;;subtract
18515
        DEFB    $01             ;;exchange
18516
        DEFB    $38             ;;end-calc
18517
 
18518
        INC     (HL)            ;
18519
 
18520
        RST     28H             ;; FP-CALC
18521
 
18522
;; GRE.8
18523
L373D:  DEFB    $01             ;;exchange
18524
        DEFB    $34             ;;stk-data
18525
        DEFB    $F0             ;;Exponent: $80, Bytes: 4
18526
        DEFB    $31,$72,$17,$F8 ;;
18527
        DEFB    $04             ;;multiply
18528
        DEFB    $01             ;;exchange
18529
        DEFB    $A2             ;;stk-half
18530
        DEFB    $03             ;;subtract
18531
        DEFB    $A2             ;;stk-half
18532
        DEFB    $03             ;;subtract
18533
        DEFB    $31             ;;duplicate
18534
        DEFB    $34             ;;stk-data
18535
        DEFB    $32             ;;Exponent: $82, Bytes: 1
18536
        DEFB    $20             ;;(+00,+00,+00)
18537
        DEFB    $04             ;;multiply
18538
        DEFB    $A2             ;;stk-half
18539
        DEFB    $03             ;;subtract
18540
        DEFB    $8C             ;;series-0C
18541
        DEFB    $11             ;;Exponent: $61, Bytes: 1
18542
        DEFB    $AC             ;;(+00,+00,+00)
18543
        DEFB    $14             ;;Exponent: $64, Bytes: 1
18544
        DEFB    $09             ;;(+00,+00,+00)
18545
        DEFB    $56             ;;Exponent: $66, Bytes: 2
18546
        DEFB    $DA,$A5         ;;(+00,+00)
18547
        DEFB    $59             ;;Exponent: $69, Bytes: 2
18548
        DEFB    $30,$C5         ;;(+00,+00)
18549
        DEFB    $5C             ;;Exponent: $6C, Bytes: 2
18550
        DEFB    $90,$AA         ;;(+00,+00)
18551
        DEFB    $9E             ;;Exponent: $6E, Bytes: 3
18552
        DEFB    $70,$6F,$61     ;;(+00)
18553
        DEFB    $A1             ;;Exponent: $71, Bytes: 3
18554
        DEFB    $CB,$DA,$96     ;;(+00)
18555
        DEFB    $A4             ;;Exponent: $74, Bytes: 3
18556
        DEFB    $31,$9F,$B4     ;;(+00)
18557
        DEFB    $E7             ;;Exponent: $77, Bytes: 4
18558
        DEFB    $A0,$FE,$5C,$FC ;;
18559
        DEFB    $EA             ;;Exponent: $7A, Bytes: 4
18560
        DEFB    $1B,$43,$CA,$36 ;;
18561
        DEFB    $ED             ;;Exponent: $7D, Bytes: 4
18562
        DEFB    $A7,$9C,$7E,$5E ;;
18563
        DEFB    $F0             ;;Exponent: $80, Bytes: 4
18564
        DEFB    $6E,$23,$80,$93 ;;
18565
        DEFB    $04             ;;multiply
18566
        DEFB    $0F             ;;addition
18567
        DEFB    $38             ;;end-calc
18568
 
18569
        RET                     ; return.
18570
 
18571
 
18572
; -----------------------------
18573
; THE 'TRIGONOMETRIC' FUNCTIONS
18574
; -----------------------------
18575
; Trigonometry is rocket science. It is also used by carpenters and pyramid
18576
; builders.
18577
; Some uses can be quite abstract but the principles can be seen in simple
18578
; right-angled triangles. Triangles have some special properties -
18579
;
18580
; 1) The sum of the three angles is always PI radians (180 degrees).
18581
;    Very helpful if you know two angles and wish to find the third.
18582
; 2) In any right-angled triangle the sum of the squares of the two shorter
18583
;    sides is equal to the square of the longest side opposite the right-angle.
18584
;    Very useful if you know the length of two sides and wish to know the
18585
;    length of the third side.
18586
; 3) Functions sine, cosine and tangent enable one to calculate the length
18587
;    of an unknown side when the length of one other side and an angle is
18588
;    known.
18589
; 4) Functions arcsin, arccosine and arctan enable one to calculate an unknown
18590
;    angle when the length of two of the sides is known.
18591
 
18592
; --------------------------------
18593
; THE 'REDUCE ARGUMENT' SUBROUTINE
18594
; --------------------------------
18595
; (offset $39: 'get-argt')
18596
;
18597
; This routine performs two functions on the angle, in radians, that forms
18598
; the argument to the sine and cosine functions.
18599
; First it ensures that the angle 'wraps round'. That if a ship turns through
18600
; an angle of, say, 3*PI radians (540 degrees) then the net effect is to turn
18601
; through an angle of PI radians (180 degrees).
18602
; Secondly it converts the angle in radians to a fraction of a right angle,
18603
; depending within which quadrant the angle lies, with the periodicity
18604
; resembling that of the desired sine value.
18605
; The result lies in the range -1 to +1.
18606
;
18607
;                     90 deg.
18608
;
18609
;                     (pi/2)
18610
;              II       +1        I
18611
;                       |
18612
;        sin+      |\   |   /|    sin+
18613
;        cos-      | \  |  / |    cos+
18614
;        tan-      |  \ | /  |    tan+
18615
;                  |   \|/)  |
18616
; 180 deg. (pi) 0 -|----+----|-- 0  (0)   0 degrees
18617
;                  |   /|\   |
18618
;        sin-      |  / | \  |    sin-
18619
;        cos-      | /  |  \ |    cos+
18620
;        tan+      |/   |   \|    tan-
18621
;                       |
18622
;              III      -1       IV
18623
;                     (3pi/2)
18624
;
18625
;                     270 deg.
18626
;
18627
 
18628
;; get-argt
18629
L3783:  RST     28H             ;; FP-CALC      X.
18630
        DEFB    $3D             ;;re-stack      (not rquired done by mult)
18631
        DEFB    $34             ;;stk-data
18632
        DEFB    $EE             ;;Exponent: $7E,
18633
                                ;;Bytes: 4
18634
        DEFB    $22,$F9,$83,$6E ;;              X, 1/(2*PI)
18635
        DEFB    $04             ;;multiply      X/(2*PI) = fraction
18636
        DEFB    $31             ;;duplicate
18637
        DEFB    $A2             ;;stk-half
18638
        DEFB    $0F             ;;addition
18639
        DEFB    $27             ;;int
18640
 
18641
        DEFB    $03             ;;subtract      now range -.5 to .5
18642
 
18643
        DEFB    $31             ;;duplicate
18644
        DEFB    $0F             ;;addition      now range -1 to 1.
18645
        DEFB    $31             ;;duplicate
18646
        DEFB    $0F             ;;addition      now range -2 to +2.
18647
 
18648
; quadrant I (0 to +1) and quadrant IV (-1 to 0) are now correct.
18649
; quadrant II ranges +1 to +2.
18650
; quadrant III ranges -2 to -1.
18651
 
18652
        DEFB    $31             ;;duplicate     Y, Y.
18653
        DEFB    $2A             ;;abs           Y, abs(Y).    range 1 to 2
18654
        DEFB    $A1             ;;stk-one       Y, abs(Y), 1.
18655
        DEFB    $03             ;;subtract      Y, abs(Y)-1.  range 0 to 1
18656
        DEFB    $31             ;;duplicate     Y, Z, Z.
18657
        DEFB    $37             ;;greater-0     Y, Z, (1/0).
18658
 
18659
        DEFB    $C0             ;;st-mem-0         store as possible sign
18660
                                ;;                 for cosine function.
18661
 
18662
        DEFB    $00             ;;jump-true
18663
        DEFB    $04             ;;to L37A1, ZPLUS  with quadrants II and III.
18664
 
18665
; else the angle lies in quadrant I or IV and value Y is already correct.
18666
 
18667
        DEFB    $02             ;;delete        Y.   delete the test value.
18668
        DEFB    $38             ;;end-calc      Y.
18669
 
18670
        RET                     ; return.       with Q1 and Q4           >>>
18671
 
18672
; ---
18673
 
18674
; the branch was here with quadrants II (0 to 1) and III (1 to 0).
18675
; Y will hold -2 to -1 if this is quadrant III.
18676
 
18677
;; ZPLUS
18678
L37A1:  DEFB    $A1             ;;stk-one         Y, Z, 1.
18679
        DEFB    $03             ;;subtract        Y, Z-1.       Q3 = 0 to -1
18680
        DEFB    $01             ;;exchange        Z-1, Y.
18681
        DEFB    $36             ;;less-0          Z-1, (1/0).
18682
        DEFB    $00             ;;jump-true       Z-1.
18683
        DEFB    $02             ;;to L37A8, YNEG
18684
                                ;;if angle in quadrant III
18685
 
18686
; else angle is within quadrant II (-1 to 0)
18687
 
18688
        DEFB    $1B             ;;negate          range +1 to 0.
18689
 
18690
;; YNEG
18691
L37A8:  DEFB    $38             ;;end-calc        quadrants II and III correct.
18692
 
18693
        RET                     ; return.
18694
 
18695
 
18696
; ---------------------
18697
; THE 'COSINE' FUNCTION
18698
; ---------------------
18699
; (offset $20: 'cos')
18700
; Cosines are calculated as the sine of the opposite angle rectifying the
18701
; sign depending on the quadrant rules.
18702
;
18703
;
18704
;           /|
18705
;        h /y|
18706
;         /  |o
18707
;        /x  |
18708
;       /----|
18709
;         a
18710
;
18711
; The cosine of angle x is the adjacent side (a) divided by the hypotenuse 1.
18712
; However if we examine angle y then a/h is the sine of that angle.
18713
; Since angle x plus angle y equals a right-angle, we can find angle y by
18714
; subtracting angle x from pi/2.
18715
; However it's just as easy to reduce the argument first and subtract the
18716
; reduced argument from the value 1 (a reduced right-angle).
18717
; It's even easier to subtract 1 from the angle and rectify the sign.
18718
; In fact, after reducing the argument, the absolute value of the argument
18719
; is used and rectified using the test result stored in mem-0 by 'get-argt'
18720
; for that purpose.
18721
;
18722
 
18723
;; cos
18724
L37AA:  RST     28H             ;; FP-CALC              angle in radians.
18725
        DEFB    $39             ;;get-argt              X     reduce -1 to +1
18726
 
18727
        DEFB    $2A             ;;abs                   ABS X.   0 to 1
18728
        DEFB    $A1             ;;stk-one               ABS X, 1.
18729
        DEFB    $03             ;;subtract              now opposite angle
18730
                                ;;                      although sign is -ve.
18731
 
18732
        DEFB    $E0             ;;get-mem-0             fetch the sign indicator
18733
        DEFB    $00             ;;jump-true
18734
        DEFB    $06             ;;fwd to L37B7, C-ENT
18735
                                ;;forward to common code if in QII or QIII.
18736
 
18737
        DEFB    $1B             ;;negate                else make sign +ve.
18738
        DEFB    $33             ;;jump
18739
        DEFB    $03             ;;fwd to L37B7, C-ENT
18740
                                ;; with quadrants I and IV.
18741
 
18742
; -------------------
18743
; THE 'SINE' FUNCTION
18744
; -------------------
18745
; (offset $1F: 'sin')
18746
; This is a fundamental transcendental function from which others such as cos
18747
; and tan are directly, or indirectly, derived.
18748
; It uses the series generator to produce Chebyshev polynomials.
18749
;
18750
;
18751
;           /|
18752
;        1 / |
18753
;         /  |x
18754
;        /a  |
18755
;       /----|
18756
;         y
18757
;
18758
; The 'get-argt' function is designed to modify the angle and its sign
18759
; in line with the desired sine value and afterwards it can launch straight
18760
; into common code.
18761
 
18762
;; sin
18763
L37B5:  RST     28H             ;; FP-CALC      angle in radians
18764
        DEFB    $39             ;;get-argt      reduce - sign now correct.
18765
 
18766
;; C-ENT
18767
L37B7:  DEFB    $31             ;;duplicate
18768
        DEFB    $31             ;;duplicate
18769
        DEFB    $04             ;;multiply
18770
        DEFB    $31             ;;duplicate
18771
        DEFB    $0F             ;;addition
18772
        DEFB    $A1             ;;stk-one
18773
        DEFB    $03             ;;subtract
18774
 
18775
        DEFB    $86             ;;series-06
18776
        DEFB    $14             ;;Exponent: $64, Bytes: 1
18777
        DEFB    $E6             ;;(+00,+00,+00)
18778
        DEFB    $5C             ;;Exponent: $6C, Bytes: 2
18779
        DEFB    $1F,$0B         ;;(+00,+00)
18780
        DEFB    $A3             ;;Exponent: $73, Bytes: 3
18781
        DEFB    $8F,$38,$EE     ;;(+00)
18782
        DEFB    $E9             ;;Exponent: $79, Bytes: 4
18783
        DEFB    $15,$63,$BB,$23 ;;
18784
        DEFB    $EE             ;;Exponent: $7E, Bytes: 4
18785
        DEFB    $92,$0D,$CD,$ED ;;
18786
        DEFB    $F1             ;;Exponent: $81, Bytes: 4
18787
        DEFB    $23,$5D,$1B,$EA ;;
18788
        DEFB    $04             ;;multiply
18789
        DEFB    $38             ;;end-calc
18790
 
18791
        RET                     ; return.
18792
 
18793
; ----------------------
18794
; THE 'TANGENT' FUNCTION
18795
; ----------------------
18796
; (offset $21: 'tan')
18797
;
18798
; Evaluates tangent x as    sin(x) / cos(x).
18799
;
18800
;
18801
;           /|
18802
;        h / |
18803
;         /  |o
18804
;        /x  |
18805
;       /----|
18806
;         a
18807
;
18808
; the tangent of angle x is the ratio of the length of the opposite side
18809
; divided by the length of the adjacent side. As the opposite length can
18810
; be calculates using sin(x) and the adjacent length using cos(x) then
18811
; the tangent can be defined in terms of the previous two functions.
18812
 
18813
; Error 6 if the argument, in radians, is too close to one like pi/2
18814
; which has an infinite tangent. e.g. PRINT TAN (PI/2)  evaluates as 1/0.
18815
; Similarly PRINT TAN (3*PI/2), TAN (5*PI/2) etc.
18816
 
18817
;; tan
18818
L37DA:  RST     28H             ;; FP-CALC          x.
18819
        DEFB    $31             ;;duplicate         x, x.
18820
        DEFB    $1F             ;;sin               x, sin x.
18821
        DEFB    $01             ;;exchange          sin x, x.
18822
        DEFB    $20             ;;cos               sin x, cos x.
18823
        DEFB    $05             ;;division          sin x/cos x (= tan x).
18824
        DEFB    $38             ;;end-calc          tan x.
18825
 
18826
        RET                     ; return.
18827
 
18828
; ---------------------
18829
; THE 'ARCTAN' FUNCTION
18830
; ---------------------
18831
; (Offset $24: 'atn')
18832
; the inverse tangent function with the result in radians.
18833
; This is a fundamental transcendental function from which others such as asn
18834
; and acs are directly, or indirectly, derived.
18835
; It uses the series generator to produce Chebyshev polynomials.
18836
 
18837
;; atn
18838
L37E2:  CALL    L3297           ; routine re-stack
18839
        LD      A,(HL)          ; fetch exponent byte.
18840
        CP      $81             ; compare to that for 'one'
18841
        JR      C,L37F8         ; forward, if less, to SMALL
18842
 
18843
        RST     28H             ;; FP-CALC
18844
        DEFB    $A1             ;;stk-one
18845
        DEFB    $1B             ;;negate
18846
        DEFB    $01             ;;exchange
18847
        DEFB    $05             ;;division
18848
        DEFB    $31             ;;duplicate
18849
        DEFB    $36             ;;less-0
18850
        DEFB    $A3             ;;stk-pi/2
18851
        DEFB    $01             ;;exchange
18852
        DEFB    $00             ;;jump-true
18853
        DEFB    $06             ;;to L37FA, CASES
18854
 
18855
        DEFB    $1B             ;;negate
18856
        DEFB    $33             ;;jump
18857
        DEFB    $03             ;;to L37FA, CASES
18858
 
18859
;; SMALL
18860
L37F8:  RST     28H             ;; FP-CALC
18861
        DEFB    $A0             ;;stk-zero
18862
 
18863
;; CASES
18864
L37FA:  DEFB    $01             ;;exchange
18865
        DEFB    $31             ;;duplicate
18866
        DEFB    $31             ;;duplicate
18867
        DEFB    $04             ;;multiply
18868
        DEFB    $31             ;;duplicate
18869
        DEFB    $0F             ;;addition
18870
        DEFB    $A1             ;;stk-one
18871
        DEFB    $03             ;;subtract
18872
        DEFB    $8C             ;;series-0C
18873
        DEFB    $10             ;;Exponent: $60, Bytes: 1
18874
        DEFB    $B2             ;;(+00,+00,+00)
18875
        DEFB    $13             ;;Exponent: $63, Bytes: 1
18876
        DEFB    $0E             ;;(+00,+00,+00)
18877
        DEFB    $55             ;;Exponent: $65, Bytes: 2
18878
        DEFB    $E4,$8D         ;;(+00,+00)
18879
        DEFB    $58             ;;Exponent: $68, Bytes: 2
18880
        DEFB    $39,$BC         ;;(+00,+00)
18881
        DEFB    $5B             ;;Exponent: $6B, Bytes: 2
18882
        DEFB    $98,$FD         ;;(+00,+00)
18883
        DEFB    $9E             ;;Exponent: $6E, Bytes: 3
18884
        DEFB    $00,$36,$75     ;;(+00)
18885
        DEFB    $A0             ;;Exponent: $70, Bytes: 3
18886
        DEFB    $DB,$E8,$B4     ;;(+00)
18887
        DEFB    $63             ;;Exponent: $73, Bytes: 2
18888
        DEFB    $42,$C4         ;;(+00,+00)
18889
        DEFB    $E6             ;;Exponent: $76, Bytes: 4
18890
        DEFB    $B5,$09,$36,$BE ;;
18891
        DEFB    $E9             ;;Exponent: $79, Bytes: 4
18892
        DEFB    $36,$73,$1B,$5D ;;
18893
        DEFB    $EC             ;;Exponent: $7C, Bytes: 4
18894
        DEFB    $D8,$DE,$63,$BE ;;
18895
        DEFB    $F0             ;;Exponent: $80, Bytes: 4
18896
        DEFB    $61,$A1,$B3,$0C ;;
18897
        DEFB    $04             ;;multiply
18898
        DEFB    $0F             ;;addition
18899
        DEFB    $38             ;;end-calc
18900
 
18901
        RET                     ; return.
18902
 
18903
 
18904
; ---------------------
18905
; THE 'ARCSIN' FUNCTION
18906
; ---------------------
18907
; (Offset $22: 'asn')
18908
;   The inverse sine function with result in radians.
18909
;   Derived from arctan function above.
18910
;   Error A unless the argument is between -1 and +1 inclusive.
18911
;   Uses an adaptation of the formula asn(x) = atn(x/sqr(1-x*x))
18912
;
18913
;
18914
;                 /|
18915
;                / |
18916
;              1/  |x
18917
;              /a  |
18918
;             /----|
18919
;               y
18920
;
18921
;   e.g. We know the opposite side (x) and hypotenuse (1)
18922
;   and we wish to find angle a in radians.
18923
;   We can derive length y by Pythagoras and then use ATN instead.
18924
;   Since y*y + x*x = 1*1 (Pythagoras Theorem) then
18925
;   y=sqr(1-x*x)                         - no need to multiply 1 by itself.
18926
;   So, asn(a) = atn(x/y)
18927
;   or more fully,
18928
;   asn(a) = atn(x/sqr(1-x*x))
18929
 
18930
;   Close but no cigar.
18931
 
18932
;   While PRINT ATN (x/SQR (1-x*x)) gives the same results as PRINT ASN x,
18933
;   it leads to division by zero when x is 1 or -1.
18934
;   To overcome this, 1 is added to y giving half the required angle and the
18935
;   result is then doubled.
18936
;   That is, PRINT ATN (x/(SQR (1-x*x) +1)) *2
18937
;
18938
;   GEOMETRIC PROOF.
18939
;
18940
;
18941
;               . /|
18942
;            .  c/ |
18943
;         .     /1 |x
18944
;      . c   b /a  |
18945
;    ---------/----|
18946
;      1      y
18947
;
18948
;   By creating an isosceles triangle with two equal sides of 1, angles c and
18949
;   c are also equal. If b+c+c = 180 degrees and b+a = 180 degrees then c=a/2.
18950
;
18951
;   A value higher than 1 gives the required error as attempting to find  the
18952
;   square root of a negative number generates an error in Sinclair BASIC.
18953
 
18954
;; asn
18955
L3833:  RST     28H             ;; FP-CALC      x.
18956
        DEFB    $31             ;;duplicate     x, x.
18957
        DEFB    $31             ;;duplicate     x, x, x.
18958
        DEFB    $04             ;;multiply      x, x*x.
18959
        DEFB    $A1             ;;stk-one       x, x*x, 1.
18960
        DEFB    $03             ;;subtract      x, x*x-1.
18961
        DEFB    $1B             ;;negate        x, 1-x*x.
18962
        DEFB    $28             ;;sqr           x, sqr(1-x*x) = y
18963
        DEFB    $A1             ;;stk-one       x, y, 1.
18964
        DEFB    $0F             ;;addition      x, y+1.
18965
        DEFB    $05             ;;division      x/y+1.
18966
        DEFB    $24             ;;atn           a/2       (half the angle)
18967
        DEFB    $31             ;;duplicate     a/2, a/2.
18968
        DEFB    $0F             ;;addition      a.
18969
        DEFB    $38             ;;end-calc      a.
18970
 
18971
        RET                     ; return.
18972
 
18973
 
18974
; ---------------------
18975
; THE 'ARCCOS' FUNCTION
18976
; ---------------------
18977
; (Offset $23: 'acs')
18978
; the inverse cosine function with the result in radians.
18979
; Error A unless the argument is between -1 and +1.
18980
; Result in range 0 to pi.
18981
; Derived from asn above which is in turn derived from the preceding atn.
18982
; It could have been derived directly from atn using acs(x) = atn(sqr(1-x*x)/x).
18983
; However, as sine and cosine are horizontal translations of each other,
18984
; uses acs(x) = pi/2 - asn(x)
18985
 
18986
; e.g. the arccosine of a known x value will give the required angle b in
18987
; radians.
18988
; We know, from above, how to calculate the angle a using asn(x).
18989
; Since the three angles of any triangle add up to 180 degrees, or pi radians,
18990
; and the largest angle in this case is a right-angle (pi/2 radians), then
18991
; we can calculate angle b as pi/2 (both angles) minus asn(x) (angle a).
18992
;
18993
;
18994
;           /|
18995
;        1 /b|
18996
;         /  |x
18997
;        /a  |
18998
;       /----|
18999
;         y
19000
;
19001
 
19002
;; acs
19003
L3843:  RST     28H             ;; FP-CALC      x.
19004
        DEFB    $22             ;;asn           asn(x).
19005
        DEFB    $A3             ;;stk-pi/2      asn(x), pi/2.
19006
        DEFB    $03             ;;subtract      asn(x) - pi/2.
19007
        DEFB    $1B             ;;negate        pi/2 -asn(x)  =  acs(x).
19008
        DEFB    $38             ;;end-calc      acs(x).
19009
 
19010
        RET                     ; return.
19011
 
19012
 
19013
; --------------------------
19014
; THE 'SQUARE ROOT' FUNCTION
19015
; --------------------------
19016
; (Offset $28: 'sqr')
19017
; This routine is remarkable for its brevity - 7 bytes.
19018
; It wasn't written here but in the ZX81 where the programmers had to squeeze
19019
; a bulky operating system into an 8K ROM. It simply calculates
19020
; the square root by stacking the value .5 and continuing into the 'to-power'
19021
; routine. With more space available the much faster Newton-Raphson method
19022
; could have been used as on the Jupiter Ace.
19023
 
19024
;; sqr
19025
L384A:  RST     28H             ;; FP-CALC
19026
        DEFB    $31             ;;duplicate
19027
        DEFB    $30             ;;not
19028
        DEFB    $00             ;;jump-true
19029
        DEFB    $1E             ;;to L386C, LAST
19030
 
19031
        DEFB    $A2             ;;stk-half
19032
        DEFB    $38             ;;end-calc
19033
 
19034
 
19035
; ------------------------------
19036
; THE 'EXPONENTIATION' OPERATION
19037
; ------------------------------
19038
; (Offset $06: 'to-power')
19039
; This raises the first number X to the power of the second number Y.
19040
; As with the ZX80,
19041
; 0 ^ 0 = 1.
19042
; 0 ^ +n = 0.
19043
; 0 ^ -n = arithmetic overflow.
19044
;
19045
 
19046
;; to-power
19047
L3851:  RST     28H             ;; FP-CALC              X, Y.
19048
        DEFB    $01             ;;exchange              Y, X.
19049
        DEFB    $31             ;;duplicate             Y, X, X.
19050
        DEFB    $30             ;;not                   Y, X, (1/0).
19051
        DEFB    $00             ;;jump-true
19052
        DEFB    $07             ;;to L385D, XIS0   if X is zero.
19053
 
19054
;   else X is non-zero. Function 'ln' will catch a negative value of X.
19055
 
19056
        DEFB    $25             ;;ln                    Y, LN X.
19057
        DEFB    $04             ;;multiply              Y * LN X.
19058
        DEFB    $38             ;;end-calc
19059
 
19060
        JP      L36C4           ; jump back to EXP routine   ->
19061
 
19062
; ---
19063
 
19064
;   these routines form the three simple results when the number is zero.
19065
;   begin by deleting the known zero to leave Y the power factor.
19066
 
19067
;; XIS0
19068
L385D:  DEFB    $02             ;;delete                Y.
19069
        DEFB    $31             ;;duplicate             Y, Y.
19070
        DEFB    $30             ;;not                   Y, (1/0).
19071
        DEFB    $00             ;;jump-true
19072
        DEFB    $09             ;;to L386A, ONE         if Y is zero.
19073
 
19074
        DEFB    $A0             ;;stk-zero              Y, 0.
19075
        DEFB    $01             ;;exchange              0, Y.
19076
        DEFB    $37             ;;greater-0             0, (1/0).
19077
        DEFB    $00             ;;jump-true             0.
19078
        DEFB    $06             ;;to L386C, LAST        if Y was any positive
19079
                                ;;                      number.
19080
 
19081
;   else force division by zero thereby raising an Arithmetic overflow error.
19082
;   There are some one and two-byte alternatives but perhaps the most formal
19083
;   might have been to use end-calc; rst 08; defb 05.
19084
 
19085
        DEFB    $A1             ;;stk-one               0, 1.
19086
        DEFB    $01             ;;exchange              1, 0.
19087
        DEFB    $05             ;;division              1/0        ouch!
19088
 
19089
; ---
19090
 
19091
;; ONE
19092
L386A:  DEFB    $02             ;;delete                .
19093
        DEFB    $A1             ;;stk-one               1.
19094
 
19095
;; LAST
19096
L386C:  DEFB    $38             ;;end-calc              last value is 1 or 0.
19097
 
19098
        RET                     ; return.
19099
 
19100
;   "Everything should be made as simple as possible, but not simpler"
19101
;   - Albert Einstein, 1879-1955.
19102
 
19103
; ---------------------
19104
; THE 'SPARE' LOCATIONS
19105
; ---------------------
19106
 
19107
;; spare
19108
L386E:  DEFB    $FF, $FF        ;
19109
 
19110 11 gdevic
; ----------------------------------------------------------------------------
19111
; This custom NMI handler provides a way to enter a POKE for a game by typing in
19112
; the address (5 decimal digits) followed by the value (3 decimal digits)
19113
; after which the value will be stored to the selected location.
19114
; ----------------------------------------------------------------------------
19115
nmi_handler:                    ; NMI handler
19116
        push    bc
19117
        push    de
19118
        push    ix
19119
        ld      hl,$04000       ; Use the screen memory as a temp storage
19120
        ld      e,$08           ; Will load 8 characters (numbers)
19121
next_key:
19122
        ld      bc,$f7fe        ; Number row 1..5
19123
        in      a,(c)
19124
        ld      c,a
19125
        ld      a,$01           ; Preload "1"
19126
        bit     0,c             ; If the key has been pressed
19127
        jr      z,accept_key    ; Accept it
19128
        inc     a               ; Preload "2"
19129
        bit     1,c             ; and continue for every key up to "5"
19130
        jr      z,accept_key
19131
        inc     a
19132
        bit     2,c
19133
        jr      z,accept_key
19134
        inc     a
19135
        bit     3,c
19136
        jr      z,accept_key
19137
        inc     a
19138
        bit     4,c
19139
        jr      z,accept_key
19140
        ld      bc,$effe        ; Number row 6...0
19141
        in      a,(c)
19142
        ld      c,a
19143
        ld      a,$06
19144
        bit     4,c
19145
        jr      z,accept_key
19146
        inc     a
19147
        bit     3,c
19148
        jr      z,accept_key
19149
        inc     a
19150
        bit     2,c
19151
        jr      z,accept_key
19152
        inc     a
19153
        bit     1,c
19154
        jr      z,accept_key
19155
        xor     a
19156
        bit     0,c
19157
        jr      z,accept_key
19158
        jp      next_key
19159
accept_key:
19160
        ld      (hl),a          ; Store current key value into the buffer
19161
        inc     hl
19162
poll_key_release:               ; Poll for any pressed key to be released
19163
        ld      bc,$f7fe
19164
        in      a,(c)
19165
        cpl
19166
        and     $1f
19167
        jr      nz,poll_key_release
19168
        ld      bc,$effe
19169
        in      a,(c)
19170
        cpl
19171
        and     $1f
19172
        jr      nz,poll_key_release
19173
        dec     e               ; Decrement the number of keys expected
19174
        jr      nz,next_key     ; Jump back to accept next key if not yet done
19175
        ld      ix,$4000
19176
        ld      b,$05           ; First 5 numbers represent the address to POKE to
19177
        call    decimal_to_hl
19178
        push    hl              ; Address is in HL, store it
19179
        ld      b,$03           ; Next 3 numbers represent the value to POKE
19180
        call    decimal_to_hl
19181
        ld      a,l             ; Value is in L
19182
        pop     hl              ; Get the address
19183
        ld      (hl),a          ; POKE a value
19184
        pop     ix
19185
        pop     de
19186
        pop     bc
19187
        pop     hl
19188
        pop     af
19189
        retn
19190
; Read a decimal value pointed to by IX register
19191
; The number of digits is given in B register
19192
; Return the value in HL register
19193
decimal_to_hl:
19194
        ld      hl,$0000        ; Start with value of 0
19195
lp2:
19196
        push    bc
19197
        ld      b,$09           ; Multiply the current value by 10
19198
        push    hl
19199
        pop     de
19200
lp1:
19201
        add     hl,de
19202
        djnz    lp1
19203
        pop     bc
19204
        ld      e,(ix+0)        ; Read in the next digit
19205
        ld      d,$00
19206
        add     hl,de           ; Add in the new value
19207
        inc     ix
19208
        djnz    lp2             ; Loop for the requested number of digits
19209
        ret
19210 8 gdevic
 
19211
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19212
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19213
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19214
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19215
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19216
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19217
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19218
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19219
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19220
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19221
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19222
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19223
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19224
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19225
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19226
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19227
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19228
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19229
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19230
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19231
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19232
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19233
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19234
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19235
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19236
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19237
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19238
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19239
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19240
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19241
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19242
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19243
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19244
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19245
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19246
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19247
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19248
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19249
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19250
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19251
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19252
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19253
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19254
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19255
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19256
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19257
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19258
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19259
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19260
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19261
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19262
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19263
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19264
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19265
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19266
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19267
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19268
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19269
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19270
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19271
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19272
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19273
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19274
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19275
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19276
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19277
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19278
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19279
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19280
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19281
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19282
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19283
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19284
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19285
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19286
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19287
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19288
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19289
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19290
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19291
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19292
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19293
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19294
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19295
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19296
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19297
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19298
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19299
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19300
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19301
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19302
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19303
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19304
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19305
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19306
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19307
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19308
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19309
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19310
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19311
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19312
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19313
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19314
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19315
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19316
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19317
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19318
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19319
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19320
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19321
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19322
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19323
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19324
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19325
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19326
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19327
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19328
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19329
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19330
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19331
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19332
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19333
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19334
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19335
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19336
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19337
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19338
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19339
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19340
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19341
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19342
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19343
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19344
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19345
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19346
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19347
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19348
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19349
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19350
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19351
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19352
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19353
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19354
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19355
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19356
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19357
 
19358
ORG $3D00
19359
 
19360
; -------------------------------
19361
; THE 'ZX SPECTRUM CHARACTER SET'
19362
; -------------------------------
19363
 
19364
;; char-set
19365
 
19366
; $20 - Character: ' '          CHR$(32)
19367
 
19368
L3D00:  DEFB    %00000000
19369
        DEFB    %00000000
19370
        DEFB    %00000000
19371
        DEFB    %00000000
19372
        DEFB    %00000000
19373
        DEFB    %00000000
19374
        DEFB    %00000000
19375
        DEFB    %00000000
19376
 
19377
; $21 - Character: '!'          CHR$(33)
19378
 
19379
        DEFB    %00000000
19380
        DEFB    %00010000
19381
        DEFB    %00010000
19382
        DEFB    %00010000
19383
        DEFB    %00010000
19384
        DEFB    %00000000
19385
        DEFB    %00010000
19386
        DEFB    %00000000
19387
 
19388
; $22 - Character: '"'          CHR$(34)
19389
 
19390
        DEFB    %00000000
19391
        DEFB    %00100100
19392
        DEFB    %00100100
19393
        DEFB    %00000000
19394
        DEFB    %00000000
19395
        DEFB    %00000000
19396
        DEFB    %00000000
19397
        DEFB    %00000000
19398
 
19399
; $23 - Character: '#'          CHR$(35)
19400
 
19401
        DEFB    %00000000
19402
        DEFB    %00100100
19403
        DEFB    %01111110
19404
        DEFB    %00100100
19405
        DEFB    %00100100
19406
        DEFB    %01111110
19407
        DEFB    %00100100
19408
        DEFB    %00000000
19409
 
19410
; $24 - Character: '$'          CHR$(36)
19411
 
19412
        DEFB    %00000000
19413
        DEFB    %00001000
19414
        DEFB    %00111110
19415
        DEFB    %00101000
19416
        DEFB    %00111110
19417
        DEFB    %00001010
19418
        DEFB    %00111110
19419
        DEFB    %00001000
19420
 
19421
; $25 - Character: '%'          CHR$(37)
19422
 
19423
        DEFB    %00000000
19424
        DEFB    %01100010
19425
        DEFB    %01100100
19426
        DEFB    %00001000
19427
        DEFB    %00010000
19428
        DEFB    %00100110
19429
        DEFB    %01000110
19430
        DEFB    %00000000
19431
 
19432
; $26 - Character: '&'          CHR$(38)
19433
 
19434
        DEFB    %00000000
19435
        DEFB    %00010000
19436
        DEFB    %00101000
19437
        DEFB    %00010000
19438
        DEFB    %00101010
19439
        DEFB    %01000100
19440
        DEFB    %00111010
19441
        DEFB    %00000000
19442
 
19443
; $27 - Character: '''          CHR$(39)
19444
 
19445
        DEFB    %00000000
19446
        DEFB    %00001000
19447
        DEFB    %00010000
19448
        DEFB    %00000000
19449
        DEFB    %00000000
19450
        DEFB    %00000000
19451
        DEFB    %00000000
19452
        DEFB    %00000000
19453
 
19454
; $28 - Character: '('          CHR$(40)
19455
 
19456
        DEFB    %00000000
19457
        DEFB    %00000100
19458
        DEFB    %00001000
19459
        DEFB    %00001000
19460
        DEFB    %00001000
19461
        DEFB    %00001000
19462
        DEFB    %00000100
19463
        DEFB    %00000000
19464
 
19465
; $29 - Character: ')'          CHR$(41)
19466
 
19467
        DEFB    %00000000
19468
        DEFB    %00100000
19469
        DEFB    %00010000
19470
        DEFB    %00010000
19471
        DEFB    %00010000
19472
        DEFB    %00010000
19473
        DEFB    %00100000
19474
        DEFB    %00000000
19475
 
19476
; $2A - Character: '*'          CHR$(42)
19477
 
19478
        DEFB    %00000000
19479
        DEFB    %00000000
19480
        DEFB    %00010100
19481
        DEFB    %00001000
19482
        DEFB    %00111110
19483
        DEFB    %00001000
19484
        DEFB    %00010100
19485
        DEFB    %00000000
19486
 
19487
; $2B - Character: '+'          CHR$(43)
19488
 
19489
        DEFB    %00000000
19490
        DEFB    %00000000
19491
        DEFB    %00001000
19492
        DEFB    %00001000
19493
        DEFB    %00111110
19494
        DEFB    %00001000
19495
        DEFB    %00001000
19496
        DEFB    %00000000
19497
 
19498
; $2C - Character: ','          CHR$(44)
19499
 
19500
        DEFB    %00000000
19501
        DEFB    %00000000
19502
        DEFB    %00000000
19503
        DEFB    %00000000
19504
        DEFB    %00000000
19505
        DEFB    %00001000
19506
        DEFB    %00001000
19507
        DEFB    %00010000
19508
 
19509
; $2D - Character: '-'          CHR$(45)
19510
 
19511
        DEFB    %00000000
19512
        DEFB    %00000000
19513
        DEFB    %00000000
19514
        DEFB    %00000000
19515
        DEFB    %00111110
19516
        DEFB    %00000000
19517
        DEFB    %00000000
19518
        DEFB    %00000000
19519
 
19520
; $2E - Character: '.'          CHR$(46)
19521
 
19522
        DEFB    %00000000
19523
        DEFB    %00000000
19524
        DEFB    %00000000
19525
        DEFB    %00000000
19526
        DEFB    %00000000
19527
        DEFB    %00011000
19528
        DEFB    %00011000
19529
        DEFB    %00000000
19530
 
19531
; $2F - Character: '/'          CHR$(47)
19532
 
19533
        DEFB    %00000000
19534
        DEFB    %00000000
19535
        DEFB    %00000010
19536
        DEFB    %00000100
19537
        DEFB    %00001000
19538
        DEFB    %00010000
19539
        DEFB    %00100000
19540
        DEFB    %00000000
19541
 
19542
; $30 - Character: '0'          CHR$(48)
19543
 
19544
        DEFB    %00000000
19545
        DEFB    %00111100
19546
        DEFB    %01000110
19547
        DEFB    %01001010
19548
        DEFB    %01010010
19549
        DEFB    %01100010
19550
        DEFB    %00111100
19551
        DEFB    %00000000
19552
 
19553
; $31 - Character: '1'          CHR$(49)
19554
 
19555
        DEFB    %00000000
19556
        DEFB    %00011000
19557
        DEFB    %00101000
19558
        DEFB    %00001000
19559
        DEFB    %00001000
19560
        DEFB    %00001000
19561
        DEFB    %00111110
19562
        DEFB    %00000000
19563
 
19564
; $32 - Character: '2'          CHR$(50)
19565
 
19566
        DEFB    %00000000
19567
        DEFB    %00111100
19568
        DEFB    %01000010
19569
        DEFB    %00000010
19570
        DEFB    %00111100
19571
        DEFB    %01000000
19572
        DEFB    %01111110
19573
        DEFB    %00000000
19574
 
19575
; $33 - Character: '3'          CHR$(51)
19576
 
19577
        DEFB    %00000000
19578
        DEFB    %00111100
19579
        DEFB    %01000010
19580
        DEFB    %00001100
19581
        DEFB    %00000010
19582
        DEFB    %01000010
19583
        DEFB    %00111100
19584
        DEFB    %00000000
19585
 
19586
; $34 - Character: '4'          CHR$(52)
19587
 
19588
        DEFB    %00000000
19589
        DEFB    %00001000
19590
        DEFB    %00011000
19591
        DEFB    %00101000
19592
        DEFB    %01001000
19593
        DEFB    %01111110
19594
        DEFB    %00001000
19595
        DEFB    %00000000
19596
 
19597
; $35 - Character: '5'          CHR$(53)
19598
 
19599
        DEFB    %00000000
19600
        DEFB    %01111110
19601
        DEFB    %01000000
19602
        DEFB    %01111100
19603
        DEFB    %00000010
19604
        DEFB    %01000010
19605
        DEFB    %00111100
19606
        DEFB    %00000000
19607
 
19608
; $36 - Character: '6'          CHR$(54)
19609
 
19610
        DEFB    %00000000
19611
        DEFB    %00111100
19612
        DEFB    %01000000
19613
        DEFB    %01111100
19614
        DEFB    %01000010
19615
        DEFB    %01000010
19616
        DEFB    %00111100
19617
        DEFB    %00000000
19618
 
19619
; $37 - Character: '7'          CHR$(55)
19620
 
19621
        DEFB    %00000000
19622
        DEFB    %01111110
19623
        DEFB    %00000010
19624
        DEFB    %00000100
19625
        DEFB    %00001000
19626
        DEFB    %00010000
19627
        DEFB    %00010000
19628
        DEFB    %00000000
19629
 
19630
; $38 - Character: '8'          CHR$(56)
19631
 
19632
        DEFB    %00000000
19633
        DEFB    %00111100
19634
        DEFB    %01000010
19635
        DEFB    %00111100
19636
        DEFB    %01000010
19637
        DEFB    %01000010
19638
        DEFB    %00111100
19639
        DEFB    %00000000
19640
 
19641
; $39 - Character: '9'          CHR$(57)
19642
 
19643
        DEFB    %00000000
19644
        DEFB    %00111100
19645
        DEFB    %01000010
19646
        DEFB    %01000010
19647
        DEFB    %00111110
19648
        DEFB    %00000010
19649
        DEFB    %00111100
19650
        DEFB    %00000000
19651
 
19652
; $3A - Character: ':'          CHR$(58)
19653
 
19654
        DEFB    %00000000
19655
        DEFB    %00000000
19656
        DEFB    %00000000
19657
        DEFB    %00010000
19658
        DEFB    %00000000
19659
        DEFB    %00000000
19660
        DEFB    %00010000
19661
        DEFB    %00000000
19662
 
19663
; $3B - Character: ';'          CHR$(59)
19664
 
19665
        DEFB    %00000000
19666
        DEFB    %00000000
19667
        DEFB    %00010000
19668
        DEFB    %00000000
19669
        DEFB    %00000000
19670
        DEFB    %00010000
19671
        DEFB    %00010000
19672
        DEFB    %00100000
19673
 
19674
; $3C - Character: '<'          CHR$(60)
19675
 
19676
        DEFB    %00000000
19677
        DEFB    %00000000
19678
        DEFB    %00000100
19679
        DEFB    %00001000
19680
        DEFB    %00010000
19681
        DEFB    %00001000
19682
        DEFB    %00000100
19683
        DEFB    %00000000
19684
 
19685
; $3D - Character: '='          CHR$(61)
19686
 
19687
        DEFB    %00000000
19688
        DEFB    %00000000
19689
        DEFB    %00000000
19690
        DEFB    %00111110
19691
        DEFB    %00000000
19692
        DEFB    %00111110
19693
        DEFB    %00000000
19694
        DEFB    %00000000
19695
 
19696
; $3E - Character: '>'          CHR$(62)
19697
 
19698
        DEFB    %00000000
19699
        DEFB    %00000000
19700
        DEFB    %00010000
19701
        DEFB    %00001000
19702
        DEFB    %00000100
19703
        DEFB    %00001000
19704
        DEFB    %00010000
19705
        DEFB    %00000000
19706
 
19707
; $3F - Character: '?'          CHR$(63)
19708
 
19709
        DEFB    %00000000
19710
        DEFB    %00111100
19711
        DEFB    %01000010
19712
        DEFB    %00000100
19713
        DEFB    %00001000
19714
        DEFB    %00000000
19715
        DEFB    %00001000
19716
        DEFB    %00000000
19717
 
19718
; $40 - Character: '@'          CHR$(64)
19719
 
19720
        DEFB    %00000000
19721
        DEFB    %00111100
19722
        DEFB    %01001010
19723
        DEFB    %01010110
19724
        DEFB    %01011110
19725
        DEFB    %01000000
19726
        DEFB    %00111100
19727
        DEFB    %00000000
19728
 
19729
; $41 - Character: 'A'          CHR$(65)
19730
 
19731
        DEFB    %00000000
19732
        DEFB    %00111100
19733
        DEFB    %01000010
19734
        DEFB    %01000010
19735
        DEFB    %01111110
19736
        DEFB    %01000010
19737
        DEFB    %01000010
19738
        DEFB    %00000000
19739
 
19740
; $42 - Character: 'B'          CHR$(66)
19741
 
19742
        DEFB    %00000000
19743
        DEFB    %01111100
19744
        DEFB    %01000010
19745
        DEFB    %01111100
19746
        DEFB    %01000010
19747
        DEFB    %01000010
19748
        DEFB    %01111100
19749
        DEFB    %00000000
19750
 
19751
; $43 - Character: 'C'          CHR$(67)
19752
 
19753
        DEFB    %00000000
19754
        DEFB    %00111100
19755
        DEFB    %01000010
19756
        DEFB    %01000000
19757
        DEFB    %01000000
19758
        DEFB    %01000010
19759
        DEFB    %00111100
19760
        DEFB    %00000000
19761
 
19762
; $44 - Character: 'D'          CHR$(68)
19763
 
19764
        DEFB    %00000000
19765
        DEFB    %01111000
19766
        DEFB    %01000100
19767
        DEFB    %01000010
19768
        DEFB    %01000010
19769
        DEFB    %01000100
19770
        DEFB    %01111000
19771
        DEFB    %00000000
19772
 
19773
; $45 - Character: 'E'          CHR$(69)
19774
 
19775
        DEFB    %00000000
19776
        DEFB    %01111110
19777
        DEFB    %01000000
19778
        DEFB    %01111100
19779
        DEFB    %01000000
19780
        DEFB    %01000000
19781
        DEFB    %01111110
19782
        DEFB    %00000000
19783
 
19784
; $46 - Character: 'F'          CHR$(70)
19785
 
19786
        DEFB    %00000000
19787
        DEFB    %01111110
19788
        DEFB    %01000000
19789
        DEFB    %01111100
19790
        DEFB    %01000000
19791
        DEFB    %01000000
19792
        DEFB    %01000000
19793
        DEFB    %00000000
19794
 
19795
; $47 - Character: 'G'          CHR$(71)
19796
 
19797
        DEFB    %00000000
19798
        DEFB    %00111100
19799
        DEFB    %01000010
19800
        DEFB    %01000000
19801
        DEFB    %01001110
19802
        DEFB    %01000010
19803
        DEFB    %00111100
19804
        DEFB    %00000000
19805
 
19806
; $48 - Character: 'H'          CHR$(72)
19807
 
19808
        DEFB    %00000000
19809
        DEFB    %01000010
19810
        DEFB    %01000010
19811
        DEFB    %01111110
19812
        DEFB    %01000010
19813
        DEFB    %01000010
19814
        DEFB    %01000010
19815
        DEFB    %00000000
19816
 
19817
; $49 - Character: 'I'          CHR$(73)
19818
 
19819
        DEFB    %00000000
19820
        DEFB    %00111110
19821
        DEFB    %00001000
19822
        DEFB    %00001000
19823
        DEFB    %00001000
19824
        DEFB    %00001000
19825
        DEFB    %00111110
19826
        DEFB    %00000000
19827
 
19828
; $4A - Character: 'J'          CHR$(74)
19829
 
19830
        DEFB    %00000000
19831
        DEFB    %00000010
19832
        DEFB    %00000010
19833
        DEFB    %00000010
19834
        DEFB    %01000010
19835
        DEFB    %01000010
19836
        DEFB    %00111100
19837
        DEFB    %00000000
19838
 
19839
; $4B - Character: 'K'          CHR$(75)
19840
 
19841
        DEFB    %00000000
19842
        DEFB    %01000100
19843
        DEFB    %01001000
19844
        DEFB    %01110000
19845
        DEFB    %01001000
19846
        DEFB    %01000100
19847
        DEFB    %01000010
19848
        DEFB    %00000000
19849
 
19850
; $4C - Character: 'L'          CHR$(76)
19851
 
19852
        DEFB    %00000000
19853
        DEFB    %01000000
19854
        DEFB    %01000000
19855
        DEFB    %01000000
19856
        DEFB    %01000000
19857
        DEFB    %01000000
19858
        DEFB    %01111110
19859
        DEFB    %00000000
19860
 
19861
; $4D - Character: 'M'          CHR$(77)
19862
 
19863
        DEFB    %00000000
19864
        DEFB    %01000010
19865
        DEFB    %01100110
19866
        DEFB    %01011010
19867
        DEFB    %01000010
19868
        DEFB    %01000010
19869
        DEFB    %01000010
19870
        DEFB    %00000000
19871
 
19872
; $4E - Character: 'N'          CHR$(78)
19873
 
19874
        DEFB    %00000000
19875
        DEFB    %01000010
19876
        DEFB    %01100010
19877
        DEFB    %01010010
19878
        DEFB    %01001010
19879
        DEFB    %01000110
19880
        DEFB    %01000010
19881
        DEFB    %00000000
19882
 
19883
; $4F - Character: 'O'          CHR$(79)
19884
 
19885
        DEFB    %00000000
19886
        DEFB    %00111100
19887
        DEFB    %01000010
19888
        DEFB    %01000010
19889
        DEFB    %01000010
19890
        DEFB    %01000010
19891
        DEFB    %00111100
19892
        DEFB    %00000000
19893
 
19894
; $50 - Character: 'P'          CHR$(80)
19895
 
19896
        DEFB    %00000000
19897
        DEFB    %01111100
19898
        DEFB    %01000010
19899
        DEFB    %01000010
19900
        DEFB    %01111100
19901
        DEFB    %01000000
19902
        DEFB    %01000000
19903
        DEFB    %00000000
19904
 
19905
; $51 - Character: 'Q'          CHR$(81)
19906
 
19907
        DEFB    %00000000
19908
        DEFB    %00111100
19909
        DEFB    %01000010
19910
        DEFB    %01000010
19911
        DEFB    %01010010
19912
        DEFB    %01001010
19913
        DEFB    %00111100
19914
        DEFB    %00000000
19915
 
19916
; $52 - Character: 'R'          CHR$(82)
19917
 
19918
        DEFB    %00000000
19919
        DEFB    %01111100
19920
        DEFB    %01000010
19921
        DEFB    %01000010
19922
        DEFB    %01111100
19923
        DEFB    %01000100
19924
        DEFB    %01000010
19925
        DEFB    %00000000
19926
 
19927
; $53 - Character: 'S'          CHR$(83)
19928
 
19929
        DEFB    %00000000
19930
        DEFB    %00111100
19931
        DEFB    %01000000
19932
        DEFB    %00111100
19933
        DEFB    %00000010
19934
        DEFB    %01000010
19935
        DEFB    %00111100
19936
        DEFB    %00000000
19937
 
19938
; $54 - Character: 'T'          CHR$(84)
19939
 
19940
        DEFB    %00000000
19941
        DEFB    %11111110
19942
        DEFB    %00010000
19943
        DEFB    %00010000
19944
        DEFB    %00010000
19945
        DEFB    %00010000
19946
        DEFB    %00010000
19947
        DEFB    %00000000
19948
 
19949
; $55 - Character: 'U'          CHR$(85)
19950
 
19951
        DEFB    %00000000
19952
        DEFB    %01000010
19953
        DEFB    %01000010
19954
        DEFB    %01000010
19955
        DEFB    %01000010
19956
        DEFB    %01000010
19957
        DEFB    %00111100
19958
        DEFB    %00000000
19959
 
19960
; $56 - Character: 'V'          CHR$(86)
19961
 
19962
        DEFB    %00000000
19963
        DEFB    %01000010
19964
        DEFB    %01000010
19965
        DEFB    %01000010
19966
        DEFB    %01000010
19967
        DEFB    %00100100
19968
        DEFB    %00011000
19969
        DEFB    %00000000
19970
 
19971
; $57 - Character: 'W'          CHR$(87)
19972
 
19973
        DEFB    %00000000
19974
        DEFB    %01000010
19975
        DEFB    %01000010
19976
        DEFB    %01000010
19977
        DEFB    %01000010
19978
        DEFB    %01011010
19979
        DEFB    %00100100
19980
        DEFB    %00000000
19981
 
19982
; $58 - Character: 'X'          CHR$(88)
19983
 
19984
        DEFB    %00000000
19985
        DEFB    %01000010
19986
        DEFB    %00100100
19987
        DEFB    %00011000
19988
        DEFB    %00011000
19989
        DEFB    %00100100
19990
        DEFB    %01000010
19991
        DEFB    %00000000
19992
 
19993
; $59 - Character: 'Y'          CHR$(89)
19994
 
19995
        DEFB    %00000000
19996
        DEFB    %10000010
19997
        DEFB    %01000100
19998
        DEFB    %00101000
19999
        DEFB    %00010000
20000
        DEFB    %00010000
20001
        DEFB    %00010000
20002
        DEFB    %00000000
20003
 
20004
; $5A - Character: 'Z'          CHR$(90)
20005
 
20006
        DEFB    %00000000
20007
        DEFB    %01111110
20008
        DEFB    %00000100
20009
        DEFB    %00001000
20010
        DEFB    %00010000
20011
        DEFB    %00100000
20012
        DEFB    %01111110
20013
        DEFB    %00000000
20014
 
20015
; $5B - Character: '['          CHR$(91)
20016
 
20017
        DEFB    %00000000
20018
        DEFB    %00001110
20019
        DEFB    %00001000
20020
        DEFB    %00001000
20021
        DEFB    %00001000
20022
        DEFB    %00001000
20023
        DEFB    %00001110
20024
        DEFB    %00000000
20025
 
20026
; $5C - Character: '\'          CHR$(92)
20027
 
20028
        DEFB    %00000000
20029
        DEFB    %00000000
20030
        DEFB    %01000000
20031
        DEFB    %00100000
20032
        DEFB    %00010000
20033
        DEFB    %00001000
20034
        DEFB    %00000100
20035
        DEFB    %00000000
20036
 
20037
; $5D - Character: ']'          CHR$(93)
20038
 
20039
        DEFB    %00000000
20040
        DEFB    %01110000
20041
        DEFB    %00010000
20042
        DEFB    %00010000
20043
        DEFB    %00010000
20044
        DEFB    %00010000
20045
        DEFB    %01110000
20046
        DEFB    %00000000
20047
 
20048
; $5E - Character: '^'          CHR$(94)
20049
 
20050
        DEFB    %00000000
20051
        DEFB    %00010000
20052
        DEFB    %00111000
20053
        DEFB    %01010100
20054
        DEFB    %00010000
20055
        DEFB    %00010000
20056
        DEFB    %00010000
20057
        DEFB    %00000000
20058
 
20059
; $5F - Character: '_'          CHR$(95)
20060
 
20061
        DEFB    %00000000
20062
        DEFB    %00000000
20063
        DEFB    %00000000
20064
        DEFB    %00000000
20065
        DEFB    %00000000
20066
        DEFB    %00000000
20067
        DEFB    %00000000
20068
        DEFB    %11111111
20069
 
20070
; $60 - Character: ' £ '        CHR$(96)
20071
 
20072
        DEFB    %00000000
20073
        DEFB    %00011100
20074
        DEFB    %00100010
20075
        DEFB    %01111000
20076
        DEFB    %00100000
20077
        DEFB    %00100000
20078
        DEFB    %01111110
20079
        DEFB    %00000000
20080
 
20081
; $61 - Character: 'a'          CHR$(97)
20082
 
20083
        DEFB    %00000000
20084
        DEFB    %00000000
20085
        DEFB    %00111000
20086
        DEFB    %00000100
20087
        DEFB    %00111100
20088
        DEFB    %01000100
20089
        DEFB    %00111100
20090
        DEFB    %00000000
20091
 
20092
; $62 - Character: 'b'          CHR$(98)
20093
 
20094
        DEFB    %00000000
20095
        DEFB    %00100000
20096
        DEFB    %00100000
20097
        DEFB    %00111100
20098
        DEFB    %00100010
20099
        DEFB    %00100010
20100
        DEFB    %00111100
20101
        DEFB    %00000000
20102
 
20103
; $63 - Character: 'c'          CHR$(99)
20104
 
20105
        DEFB    %00000000
20106
        DEFB    %00000000
20107
        DEFB    %00011100
20108
        DEFB    %00100000
20109
        DEFB    %00100000
20110
        DEFB    %00100000
20111
        DEFB    %00011100
20112
        DEFB    %00000000
20113
 
20114
; $64 - Character: 'd'          CHR$(100)
20115
 
20116
        DEFB    %00000000
20117
        DEFB    %00000100
20118
        DEFB    %00000100
20119
        DEFB    %00111100
20120
        DEFB    %01000100
20121
        DEFB    %01000100
20122
        DEFB    %00111100
20123
        DEFB    %00000000
20124
 
20125
; $65 - Character: 'e'          CHR$(101)
20126
 
20127
        DEFB    %00000000
20128
        DEFB    %00000000
20129
        DEFB    %00111000
20130
        DEFB    %01000100
20131
        DEFB    %01111000
20132
        DEFB    %01000000
20133
        DEFB    %00111100
20134
        DEFB    %00000000
20135
 
20136
; $66 - Character: 'f'          CHR$(102)
20137
 
20138
        DEFB    %00000000
20139
        DEFB    %00001100
20140
        DEFB    %00010000
20141
        DEFB    %00011000
20142
        DEFB    %00010000
20143
        DEFB    %00010000
20144
        DEFB    %00010000
20145
        DEFB    %00000000
20146
 
20147
; $67 - Character: 'g'          CHR$(103)
20148
 
20149
        DEFB    %00000000
20150
        DEFB    %00000000
20151
        DEFB    %00111100
20152
        DEFB    %01000100
20153
        DEFB    %01000100
20154
        DEFB    %00111100
20155
        DEFB    %00000100
20156
        DEFB    %00111000
20157
 
20158
; $68 - Character: 'h'          CHR$(104)
20159
 
20160
        DEFB    %00000000
20161
        DEFB    %01000000
20162
        DEFB    %01000000
20163
        DEFB    %01111000
20164
        DEFB    %01000100
20165
        DEFB    %01000100
20166
        DEFB    %01000100
20167
        DEFB    %00000000
20168
 
20169
; $69 - Character: 'i'          CHR$(105)
20170
 
20171
        DEFB    %00000000
20172
        DEFB    %00010000
20173
        DEFB    %00000000
20174
        DEFB    %00110000
20175
        DEFB    %00010000
20176
        DEFB    %00010000
20177
        DEFB    %00111000
20178
        DEFB    %00000000
20179
 
20180
; $6A - Character: 'j'          CHR$(106)
20181
 
20182
        DEFB    %00000000
20183
        DEFB    %00000100
20184
        DEFB    %00000000
20185
        DEFB    %00000100
20186
        DEFB    %00000100
20187
        DEFB    %00000100
20188
        DEFB    %00100100
20189
        DEFB    %00011000
20190
 
20191
; $6B - Character: 'k'          CHR$(107)
20192
 
20193
        DEFB    %00000000
20194
        DEFB    %00100000
20195
        DEFB    %00101000
20196
        DEFB    %00110000
20197
        DEFB    %00110000
20198
        DEFB    %00101000
20199
        DEFB    %00100100
20200
        DEFB    %00000000
20201
 
20202
; $6C - Character: 'l'          CHR$(108)
20203
 
20204
        DEFB    %00000000
20205
        DEFB    %00010000
20206
        DEFB    %00010000
20207
        DEFB    %00010000
20208
        DEFB    %00010000
20209
        DEFB    %00010000
20210
        DEFB    %00001100
20211
        DEFB    %00000000
20212
 
20213
; $6D - Character: 'm'          CHR$(109)
20214
 
20215
        DEFB    %00000000
20216
        DEFB    %00000000
20217
        DEFB    %01101000
20218
        DEFB    %01010100
20219
        DEFB    %01010100
20220
        DEFB    %01010100
20221
        DEFB    %01010100
20222
        DEFB    %00000000
20223
 
20224
; $6E - Character: 'n'          CHR$(110)
20225
 
20226
        DEFB    %00000000
20227
        DEFB    %00000000
20228
        DEFB    %01111000
20229
        DEFB    %01000100
20230
        DEFB    %01000100
20231
        DEFB    %01000100
20232
        DEFB    %01000100
20233
        DEFB    %00000000
20234
 
20235
; $6F - Character: 'o'          CHR$(111)
20236
 
20237
        DEFB    %00000000
20238
        DEFB    %00000000
20239
        DEFB    %00111000
20240
        DEFB    %01000100
20241
        DEFB    %01000100
20242
        DEFB    %01000100
20243
        DEFB    %00111000
20244
        DEFB    %00000000
20245
 
20246
; $70 - Character: 'p'          CHR$(112)
20247
 
20248
        DEFB    %00000000
20249
        DEFB    %00000000
20250
        DEFB    %01111000
20251
        DEFB    %01000100
20252
        DEFB    %01000100
20253
        DEFB    %01111000
20254
        DEFB    %01000000
20255
        DEFB    %01000000
20256
 
20257
; $71 - Character: 'q'          CHR$(113)
20258
 
20259
        DEFB    %00000000
20260
        DEFB    %00000000
20261
        DEFB    %00111100
20262
        DEFB    %01000100
20263
        DEFB    %01000100
20264
        DEFB    %00111100
20265
        DEFB    %00000100
20266
        DEFB    %00000110
20267
 
20268
; $72 - Character: 'r'          CHR$(114)
20269
 
20270
        DEFB    %00000000
20271
        DEFB    %00000000
20272
        DEFB    %00011100
20273
        DEFB    %00100000
20274
        DEFB    %00100000
20275
        DEFB    %00100000
20276
        DEFB    %00100000
20277
        DEFB    %00000000
20278
 
20279
; $73 - Character: 's'          CHR$(115)
20280
 
20281
        DEFB    %00000000
20282
        DEFB    %00000000
20283
        DEFB    %00111000
20284
        DEFB    %01000000
20285
        DEFB    %00111000
20286
        DEFB    %00000100
20287
        DEFB    %01111000
20288
        DEFB    %00000000
20289
 
20290
; $74 - Character: 't'          CHR$(116)
20291
 
20292
        DEFB    %00000000
20293
        DEFB    %00010000
20294
        DEFB    %00111000
20295
        DEFB    %00010000
20296
        DEFB    %00010000
20297
        DEFB    %00010000
20298
        DEFB    %00001100
20299
        DEFB    %00000000
20300
 
20301
; $75 - Character: 'u'          CHR$(117)
20302
 
20303
        DEFB    %00000000
20304
        DEFB    %00000000
20305
        DEFB    %01000100
20306
        DEFB    %01000100
20307
        DEFB    %01000100
20308
        DEFB    %01000100
20309
        DEFB    %00111000
20310
        DEFB    %00000000
20311
 
20312
; $76 - Character: 'v'          CHR$(118)
20313
 
20314
        DEFB    %00000000
20315
        DEFB    %00000000
20316
        DEFB    %01000100
20317
        DEFB    %01000100
20318
        DEFB    %00101000
20319
        DEFB    %00101000
20320
        DEFB    %00010000
20321
        DEFB    %00000000
20322
 
20323
; $77 - Character: 'w'          CHR$(119)
20324
 
20325
        DEFB    %00000000
20326
        DEFB    %00000000
20327
        DEFB    %01000100
20328
        DEFB    %01010100
20329
        DEFB    %01010100
20330
        DEFB    %01010100
20331
        DEFB    %00101000
20332
        DEFB    %00000000
20333
 
20334
; $78 - Character: 'x'          CHR$(120)
20335
 
20336
        DEFB    %00000000
20337
        DEFB    %00000000
20338
        DEFB    %01000100
20339
        DEFB    %00101000
20340
        DEFB    %00010000
20341
        DEFB    %00101000
20342
        DEFB    %01000100
20343
        DEFB    %00000000
20344
 
20345
; $79 - Character: 'y'          CHR$(121)
20346
 
20347
        DEFB    %00000000
20348
        DEFB    %00000000
20349
        DEFB    %01000100
20350
        DEFB    %01000100
20351
        DEFB    %01000100
20352
        DEFB    %00111100
20353
        DEFB    %00000100
20354
        DEFB    %00111000
20355
 
20356
; $7A - Character: 'z'          CHR$(122)
20357
 
20358
        DEFB    %00000000
20359
        DEFB    %00000000
20360
        DEFB    %01111100
20361
        DEFB    %00001000
20362
        DEFB    %00010000
20363
        DEFB    %00100000
20364
        DEFB    %01111100
20365
        DEFB    %00000000
20366
 
20367
; $7B - Character: '{'          CHR$(123)
20368
 
20369
        DEFB    %00000000
20370
        DEFB    %00001110
20371
        DEFB    %00001000
20372
        DEFB    %00110000
20373
        DEFB    %00001000
20374
        DEFB    %00001000
20375
        DEFB    %00001110
20376
        DEFB    %00000000
20377
 
20378
; $7C - Character: '|'          CHR$(124)
20379
 
20380
        DEFB    %00000000
20381
        DEFB    %00001000
20382
        DEFB    %00001000
20383
        DEFB    %00001000
20384
        DEFB    %00001000
20385
        DEFB    %00001000
20386
        DEFB    %00001000
20387
        DEFB    %00000000
20388
 
20389
; $7D - Character: '}'          CHR$(125)
20390
 
20391
        DEFB    %00000000
20392
        DEFB    %01110000
20393
        DEFB    %00010000
20394
        DEFB    %00001100
20395
        DEFB    %00010000
20396
        DEFB    %00010000
20397
        DEFB    %01110000
20398
        DEFB    %00000000
20399
 
20400
; $7E - Character: '~'          CHR$(126)
20401
 
20402
        DEFB    %00000000
20403
        DEFB    %00010100
20404
        DEFB    %00101000
20405
        DEFB    %00000000
20406
        DEFB    %00000000
20407
        DEFB    %00000000
20408
        DEFB    %00000000
20409
        DEFB    %00000000
20410
 
20411
; $7F - Character: ' © '        CHR$(127)
20412
 
20413
        DEFB    %00111100
20414
        DEFB    %01000010
20415
        DEFB    %10011001
20416
        DEFB    %10100001
20417
        DEFB    %10100001
20418
        DEFB    %10011001
20419
        DEFB    %01000010
20420
        DEFB    %00111100
20421
 
20422
 
20423
#end                            ; generic cross-assembler directive
20424
 
20425
; Acknowledgements
20426
; -----------------
20427
; Sean Irvine               for default list of section headings
20428
; Dr. Ian Logan             for labels and functional disassembly.
20429
; Dr. Frank O'Hara          for labels and functional disassembly.
20430
;
20431
; Credits
20432
; -------
20433
; Alex Pallero Gonzales     for corrections.
20434
; Mike Dailly               for comments.
20435
; Alvin Albrecht            for comments.
20436
; Andy Styles               for full relocatability implementation and testing.                    testing.
20437
; Andrew Owen               for ZASM compatibility and format improvements.
20438
 
20439
;   For other assemblers you may have to add directives like these near the
20440
;   beginning - see accompanying documentation.
20441
;   ZASM (MacOs) cross-assembler directives. (uncomment by removing ';' )
20442
;   #target rom           ; declare target file format as binary.
20443
;   #code   0,$4000       ; declare code segment.
20444
;   Also see notes at Address Labels 0609 and 1CA5 if your assembler has
20445
;   trouble with expressions.
20446
;
20447
;   Note. The Sinclair Interface 1 ROM written by Dr. Ian Logan and Martin
20448
;   Brennan calls numerous routines in this ROM.
20449
;   Non-standard entry points have a label beginning with X.

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.