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 8

Go to most recent revision | 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-10-2014:
6
; This version has been updated to correctly handle the NMI jump.
7
;
8
; -------------------------
9
; Last updated: 13-DEC-2004
10
; -------------------------
11
 
12
; TASM cross-assembler directives.
13
; ( comment out, perhaps, for other assemblers - see Notes at end.)
14
 
15
#define DEFB .BYTE
16
#define DEFW .WORD
17
#define DEFM .TEXT
18
#define ORG  .ORG
19
#define EQU  .EQU
20
#define equ  .EQU
21
 
22
;   It is always a good idea to anchor, using ORGs, important sections such as
23
;   the character bitmaps so that they don't move as code is added and removed.
24
 
25
;   Generally most approaches try to maintain main entry points as they are
26
;   often used by third-party software.
27
 
28
ORG 0000
29
 
30
;*****************************************
31
;** Part 1. RESTART ROUTINES AND TABLES **
32
;*****************************************
33
 
34
; -----------
35
; THE 'START'
36
; -----------
37
;   At switch on, the Z80 chip is in Interrupt Mode 0.
38
;   The Spectrum uses Interrupt Mode 1.
39
;   This location can also be 'called' to reset the machine.
40
;   Typically with PRINT USR 0.
41
 
42
;; START
43
L0000:  DI                      ; Disable Interrupts.
44
        XOR     A               ; Signal coming from START.
45
        LD      DE,$FFFF        ; Set pointer to top of possible physical RAM.
46
        JP      L11CB           ; Jump forward to common code at START-NEW.
47
 
48
; -------------------
49
; THE 'ERROR' RESTART
50
; -------------------
51
;   The error pointer is made to point to the position of the error to enable
52
;   the editor to highlight the error position if it occurred during syntax
53
;   checking.  It is used at 37 places in the program.  An instruction fetch
54
;   on address $0008 may page in a peripheral ROM such as the Sinclair
55
;   Interface 1 or Disciple Disk Interface.  This was not an original design
56
;   concept and not all errors pass through here.
57
 
58
;; ERROR-1
59
L0008:  LD      HL,($5C5D)      ; Fetch the character address from CH_ADD.
60
        LD      ($5C5F),HL      ; Copy it to the error pointer X_PTR.
61
        JR      L0053           ; Forward to continue at ERROR-2.
62
 
63
; -----------------------------
64
; THE 'PRINT CHARACTER' RESTART
65
; -----------------------------
66
;   The A register holds the code of the character that is to be sent to
67
;   the output stream of the current channel.  The alternate register set is
68
;   used to output a character in the A register so there is no need to
69
;   preserve any of the current main registers (HL, DE, BC).
70
;   This restart is used 21 times.
71
 
72
;; PRINT-A
73
L0010:  JP      L15F2           ; Jump forward to continue at PRINT-A-2.
74
 
75
; ---
76
 
77
        DEFB    $FF, $FF, $FF   ; Five unused locations.
78
        DEFB    $FF, $FF        ;
79
 
80
; -------------------------------
81
; THE 'COLLECT CHARACTER' RESTART
82
; -------------------------------
83
;   The contents of the location currently addressed by CH_ADD are fetched.
84
;   A return is made if the value represents a character that has
85
;   relevance to the BASIC parser. Otherwise CH_ADD is incremented and the
86
;   tests repeated. CH_ADD will be addressing somewhere -
87
;   1) in the BASIC program area during line execution.
88
;   2) in workspace if evaluating, for example, a string expression.
89
;   3) in the edit buffer if parsing a direct command or a new BASIC line.
90
;   4) in workspace if accepting input but not that from INPUT LINE.
91
 
92
;; GET-CHAR
93
L0018:  LD      HL,($5C5D)      ; fetch the address from CH_ADD.
94
        LD      A,(HL)          ; use it to pick up current character.
95
 
96
;; TEST-CHAR
97
L001C:  CALL    L007D           ; routine SKIP-OVER tests if the character is
98
                                ; relevant.
99
        RET     NC              ; Return if it is significant.
100
 
101
; ------------------------------------
102
; THE 'COLLECT NEXT CHARACTER' RESTART
103
; ------------------------------------
104
;   As the BASIC commands and expressions are interpreted, this routine is
105
;   called repeatedly to step along the line.  It is used 83 times.
106
 
107
;; NEXT-CHAR
108
L0020:  CALL    L0074           ; routine CH-ADD+1 fetches the next immediate
109
                                ; character.
110
        JR      L001C           ; jump back to TEST-CHAR until a valid
111
                                ; character is found.
112
 
113
; ---
114
 
115
        DEFB    $FF, $FF, $FF   ; unused
116
 
117
; -----------------------
118
; THE 'CALCULATE' RESTART
119
; -----------------------
120
;   This restart enters the Spectrum's internal, floating-point, stack-based,
121
;   FORTH-like language.
122
;   It is further used recursively from within the calculator.
123
;   It is used on 77 occasions.
124
 
125
;; FP-CALC
126
L0028:  JP      L335B           ; jump forward to the CALCULATE routine.
127
 
128
; ---
129
 
130
        DEFB    $FF, $FF, $FF   ; spare - note that on the ZX81, space being a
131
        DEFB    $FF, $FF        ; little cramped, these same locations were
132
                                ; used for the five-byte end-calc literal.
133
 
134
; ------------------------------
135
; THE 'CREATE BC SPACES' RESTART
136
; ------------------------------
137
;   This restart is used on only 12 occasions to create BC spaces
138
;   between workspace and the calculator stack.
139
 
140
;; BC-SPACES
141
L0030:  PUSH    BC              ; Save number of spaces.
142
        LD      HL,($5C61)      ; Fetch WORKSP.
143
        PUSH    HL              ; Save address of workspace.
144
        JP      L169E           ; Jump forward to continuation code RESERVE.
145
 
146
; --------------------------------
147
; THE 'MASKABLE INTERRUPT' ROUTINE
148
; --------------------------------
149
;   This routine increments the Spectrum's three-byte FRAMES counter fifty
150
;   times a second (sixty times a second in the USA ).
151
;   Both this routine and the called KEYBOARD subroutine use the IY register
152
;   to access system variables and flags so a user-written program must
153
;   disable interrupts to make use of the IY register.
154
 
155
;; MASK-INT
156
L0038:  PUSH    AF              ; Save the registers that will be used but not
157
        PUSH    HL              ; the IY register unfortunately.
158
        LD      HL,($5C78)      ; Fetch the first two bytes at FRAMES1.
159
        INC     HL              ; Increment lowest two bytes of counter.
160
        LD      ($5C78),HL      ; Place back in FRAMES1.
161
        LD      A,H             ; Test if the result was zero.
162
        OR      L               ;
163
        JR      NZ,L0048        ; Forward, if not, to KEY-INT
164
 
165
        INC     (IY+$40)        ; otherwise increment FRAMES3 the third byte.
166
 
167
;   Now save the rest of the main registers and read and decode the keyboard.
168
 
169
;; KEY-INT
170
L0048:  PUSH    BC              ; Save the other main registers.
171
        PUSH    DE              ;
172
 
173
        CALL    L02BF           ; Routine KEYBOARD executes a stage in the
174
                                ; process of reading a key-press.
175
        POP     DE              ;
176
        POP     BC              ; Restore registers.
177
 
178
        POP     HL              ;
179
        POP     AF              ;
180
 
181
        EI                      ; Enable Interrupts.
182
        RET                     ; Return.
183
 
184
; ---------------------
185
; THE 'ERROR-2' ROUTINE
186
; ---------------------
187
;   A continuation of the code at 0008.
188
;   The error code is stored and after clearing down stacks, an indirect jump
189
;   is made to MAIN-4, etc. to handle the error.
190
 
191
;; ERROR-2
192
L0053:  POP     HL              ; drop the return address - the location
193
                                ; after the RST 08H instruction.
194
        LD      L,(HL)          ; fetch the error code that follows.
195
                                ; (nice to see this instruction used.)
196
 
197
;   Note. this entry point is used when out of memory at REPORT-4.
198
;   The L register has been loaded with the report code but X-PTR is not
199
;   updated.
200
 
201
;; ERROR-3
202
L0055:  LD      (IY+$00),L      ; Store it in the system variable ERR_NR.
203
        LD      SP,($5C3D)      ; ERR_SP points to an error handler on the
204
                                ; machine stack. There may be a hierarchy
205
                                ; of routines.
206
                                ; To MAIN-4 initially at base.
207
                                ; or REPORT-G on line entry.
208
                                ; or  ED-ERROR when editing.
209
                                ; or   ED-FULL during ed-enter.
210
                                ; or  IN-VAR-1 during runtime input etc.
211
 
212
        JP      L16C5           ; Jump to SET-STK to clear the calculator stack
213
                                ; and reset MEM to usual place in the systems
214
                                ; variables area and then indirectly to MAIN-4,
215
                                ; etc.
216
 
217
; ---
218
 
219
        DEFB    $FF, $FF, $FF   ; Unused locations
220
        DEFB    $FF, $FF, $FF   ; before the fixed-position
221
        DEFB    $FF             ; NMI routine.
222
 
223
; ------------------------------------
224
; THE 'NON-MASKABLE INTERRUPT' ROUTINE
225
; ------------------------------------
226
;
227
;   There is no NMI switch on the standard Spectrum or its peripherals.
228
;   When the NMI line is held low, then no matter what the Z80 was doing at
229
;   the time, it will now execute the code at 66 Hex.
230
;   This Interrupt Service Routine will jump to location zero if the contents
231
;   of the system variable NMIADD are zero or return if the location holds a
232
;   non-zero address.   So attaching a simple switch to the NMI as in the book
233
;   "Spectrum Hardware Manual" causes a reset.  The logic was obviously
234
;   intended to work the other way.  Sinclair Research said that, since they
235
;   had never advertised the NMI, they had no plans to fix the error "until
236
;   the opportunity arose".
237
;
238
;   Note. The location NMIADD was, in fact, later used by Sinclair Research
239
;   to enhance the text channel on the ZX Interface 1.
240
;   On later Amstrad-made Spectrums, and the Brazilian Spectrum, the logic of
241
;   this routine was indeed reversed but not as at first intended.
242
;
243
;   It can be deduced by looking elsewhere in this ROM that the NMIADD system
244
;   variable pointed to L121C and that this enabled a Warm Restart to be
245
;   performed at any time, even while playing machine code games, or while
246
;   another Spectrum has been allowed to gain control of this one.
247
;
248
;   Software houses would have been able to protect their games from attack by
249
;   placing two zeros in the NMIADD system variable.
250
 
251
;; RESET
252
L0066:  PUSH    AF              ; save the
253
        PUSH    HL              ; registers.
254
        LD      HL,($5CB0)      ; fetch the system variable NMIADD.
255
        LD      A,H             ; test address
256
        OR      L               ; for zero.
257
 
258
;        JR      NZ,L0070       ; skip to NO-RESET if NOT ZERO
259
        JR      Z,L0070         ; **FIXED**
260
 
261
        JP      (HL)            ; jump to routine ( i.e. L0000 )
262
 
263
;; NO-RESET
264
L0070:  POP     HL              ; restore the
265
        POP     AF              ; registers.
266
        RETN                    ; return to previous interrupt state.
267
 
268
; ---------------------------
269
; THE 'CH ADD + 1' SUBROUTINE
270
; ---------------------------
271
;   This subroutine is called from RST 20, and three times from elsewhere
272
;   to fetch the next immediate character following the current valid character
273
;   address and update the associated system variable.
274
;   The entry point TEMP-PTR1 is used from the SCANNING routine.
275
;   Both TEMP-PTR1 and TEMP-PTR2 are used by the READ command routine.
276
 
277
;; CH-ADD+1
278
L0074:  LD      HL,($5C5D)      ; fetch address from CH_ADD.
279
 
280
;; TEMP-PTR1
281
L0077:  INC     HL              ; increase the character address by one.
282
 
283
;; TEMP-PTR2
284
L0078:  LD      ($5C5D),HL      ; update CH_ADD with character address.
285
 
286
X007B:  LD      A,(HL)          ; load character to A from HL.
287
        RET                     ; and return.
288
 
289
; --------------------------
290
; THE 'SKIP OVER' SUBROUTINE
291
; --------------------------
292
;   This subroutine is called once from RST 18 to skip over white-space and
293
;   other characters irrelevant to the parsing of a BASIC line etc. .
294
;   Initially the A register holds the character to be considered
295
;   and HL holds its address which will not be within quoted text
296
;   when a BASIC line is parsed.
297
;   Although the 'tab' and 'at' characters will not appear in a BASIC line,
298
;   they could be present in a string expression, and in other situations.
299
;   Note. although white-space is usually placed in a program to indent loops
300
;   and make it more readable, it can also be used for the opposite effect and
301
;   spaces may appear in variable names although the parser never sees them.
302
;   It is this routine that helps make the variables 'Anum bEr5 3BUS' and
303
;   'a number 53 bus' appear the same to the parser.
304
 
305
;; SKIP-OVER
306
L007D:  CP      $21             ; test if higher than space.
307
        RET     NC              ; return with carry clear if so.
308
 
309
        CP      $0D             ; carriage return ?
310
        RET     Z               ; return also with carry clear if so.
311
 
312
                                ; all other characters have no relevance
313
                                ; to the parser and must be returned with
314
                                ; carry set.
315
 
316
        CP      $10             ; test if 0-15d
317
        RET     C               ; return, if so, with carry set.
318
 
319
        CP      $18             ; test if 24-32d
320
        CCF                     ; complement carry flag.
321
        RET     C               ; return with carry set if so.
322
 
323
                                ; now leaves 16d-23d
324
 
325
        INC     HL              ; all above have at least one extra character
326
                                ; to be stepped over.
327
 
328
        CP      $16             ; controls 22d ('at') and 23d ('tab') have two.
329
        JR      C,L0090         ; forward to SKIPS with ink, paper, flash,
330
                                ; bright, inverse or over controls.
331
                                ; Note. the high byte of tab is for RS232 only.
332
                                ; it has no relevance on this machine.
333
 
334
        INC     HL              ; step over the second character of 'at'/'tab'.
335
 
336
;; SKIPS
337
L0090:  SCF                     ; set the carry flag
338
        LD      ($5C5D),HL      ; update the CH_ADD system variable.
339
        RET                     ; return with carry set.
340
 
341
 
342
; ------------------
343
; THE 'TOKEN' TABLES
344
; ------------------
345
;   The tokenized characters 134d (RND) to 255d (COPY) are expanded using
346
;   this table. The last byte of a token is inverted to denote the end of
347
;   the word. The first is an inverted step-over byte.
348
 
349
;; TKN-TABLE
350
L0095:  DEFB    '?'+$80
351
        DEFM    "RN"
352
        DEFB    'D'+$80
353
        DEFM    "INKEY"
354
        DEFB    '$'+$80
355
        DEFB    'P','I'+$80
356
        DEFB    'F','N'+$80
357
        DEFM    "POIN"
358
        DEFB    'T'+$80
359
        DEFM    "SCREEN"
360
        DEFB    '$'+$80
361
        DEFM    "ATT"
362
        DEFB    'R'+$80
363
        DEFB    'A','T'+$80
364
        DEFM    "TA"
365
        DEFB    'B'+$80
366
        DEFM    "VAL"
367
        DEFB    '$'+$80
368
        DEFM    "COD"
369
        DEFB    'E'+$80
370
        DEFM    "VA"
371
        DEFB    'L'+$80
372
        DEFM    "LE"
373
        DEFB    'N'+$80
374
        DEFM    "SI"
375
        DEFB    'N'+$80
376
        DEFM    "CO"
377
        DEFB    'S'+$80
378
        DEFM    "TA"
379
        DEFB    'N'+$80
380
        DEFM    "AS"
381
        DEFB    'N'+$80
382
        DEFM    "AC"
383
        DEFB    'S'+$80
384
        DEFM    "AT"
385
        DEFB    'N'+$80
386
        DEFB    'L','N'+$80
387
        DEFM    "EX"
388
        DEFB    'P'+$80
389
        DEFM    "IN"
390
        DEFB    'T'+$80
391
        DEFM    "SQ"
392
        DEFB    'R'+$80
393
        DEFM    "SG"
394
        DEFB    'N'+$80
395
        DEFM    "AB"
396
        DEFB    'S'+$80
397
        DEFM    "PEE"
398
        DEFB    'K'+$80
399
        DEFB    'I','N'+$80
400
        DEFM    "US"
401
        DEFB    'R'+$80
402
        DEFM    "STR"
403
        DEFB    '$'+$80
404
        DEFM    "CHR"
405
        DEFB    '$'+$80
406
        DEFM    "NO"
407
        DEFB    'T'+$80
408
        DEFM    "BI"
409
        DEFB    'N'+$80
410
 
411
;   The previous 32 function-type words are printed without a leading space
412
;   The following have a leading space if they begin with a letter
413
 
414
        DEFB    'O','R'+$80
415
        DEFM    "AN"
416
        DEFB    'D'+$80
417
        DEFB    $3C,'='+$80             ; <=
418
        DEFB    $3E,'='+$80             ; >=
419
        DEFB    $3C,$3E+$80             ; <>
420
        DEFM    "LIN"
421
        DEFB    'E'+$80
422
        DEFM    "THE"
423
        DEFB    'N'+$80
424
        DEFB    'T','O'+$80
425
        DEFM    "STE"
426
        DEFB    'P'+$80
427
        DEFM    "DEF F"
428
        DEFB    'N'+$80
429
        DEFM    "CA"
430
        DEFB    'T'+$80
431
        DEFM    "FORMA"
432
        DEFB    'T'+$80
433
        DEFM    "MOV"
434
        DEFB    'E'+$80
435
        DEFM    "ERAS"
436
        DEFB    'E'+$80
437
        DEFM    "OPEN "
438
        DEFB    '#'+$80
439
        DEFM    "CLOSE "
440
        DEFB    '#'+$80
441
        DEFM    "MERG"
442
        DEFB    'E'+$80
443
        DEFM    "VERIF"
444
        DEFB    'Y'+$80
445
        DEFM    "BEE"
446
        DEFB    'P'+$80
447
        DEFM    "CIRCL"
448
        DEFB    'E'+$80
449
        DEFM    "IN"
450
        DEFB    'K'+$80
451
        DEFM    "PAPE"
452
        DEFB    'R'+$80
453
        DEFM    "FLAS"
454
        DEFB    'H'+$80
455
        DEFM    "BRIGH"
456
        DEFB    'T'+$80
457
        DEFM    "INVERS"
458
        DEFB    'E'+$80
459
        DEFM    "OVE"
460
        DEFB    'R'+$80
461
        DEFM    "OU"
462
        DEFB    'T'+$80
463
        DEFM    "LPRIN"
464
        DEFB    'T'+$80
465
        DEFM    "LLIS"
466
        DEFB    'T'+$80
467
        DEFM    "STO"
468
        DEFB    'P'+$80
469
        DEFM    "REA"
470
        DEFB    'D'+$80
471
        DEFM    "DAT"
472
        DEFB    'A'+$80
473
        DEFM    "RESTOR"
474
        DEFB    'E'+$80
475
        DEFM    "NE"
476
        DEFB    'W'+$80
477
        DEFM    "BORDE"
478
        DEFB    'R'+$80
479
        DEFM    "CONTINU"
480
        DEFB    'E'+$80
481
        DEFM    "DI"
482
        DEFB    'M'+$80
483
        DEFM    "RE"
484
        DEFB    'M'+$80
485
        DEFM    "FO"
486
        DEFB    'R'+$80
487
        DEFM    "GO T"
488
        DEFB    'O'+$80
489
        DEFM    "GO SU"
490
        DEFB    'B'+$80
491
        DEFM    "INPU"
492
        DEFB    'T'+$80
493
        DEFM    "LOA"
494
        DEFB    'D'+$80
495
        DEFM    "LIS"
496
        DEFB    'T'+$80
497
        DEFM    "LE"
498
        DEFB    'T'+$80
499
        DEFM    "PAUS"
500
        DEFB    'E'+$80
501
        DEFM    "NEX"
502
        DEFB    'T'+$80
503
        DEFM    "POK"
504
        DEFB    'E'+$80
505
        DEFM    "PRIN"
506
        DEFB    'T'+$80
507
        DEFM    "PLO"
508
        DEFB    'T'+$80
509
        DEFM    "RU"
510
        DEFB    'N'+$80
511
        DEFM    "SAV"
512
        DEFB    'E'+$80
513
        DEFM    "RANDOMIZ"
514
        DEFB    'E'+$80
515
        DEFB    'I','F'+$80
516
        DEFM    "CL"
517
        DEFB    'S'+$80
518
        DEFM    "DRA"
519
        DEFB    'W'+$80
520
        DEFM    "CLEA"
521
        DEFB    'R'+$80
522
        DEFM    "RETUR"
523
        DEFB    'N'+$80
524
        DEFM    "COP"
525
        DEFB    'Y'+$80
526
 
527
; ----------------
528
; THE 'KEY' TABLES
529
; ----------------
530
;   These six look-up tables are used by the keyboard reading routine
531
;   to decode the key values.
532
;
533
;   The first table contains the maps for the 39 keys of the standard
534
;   40-key Spectrum keyboard. The remaining key [SHIFT $27] is read directly.
535
;   The keys consist of the 26 upper-case alphabetic characters, the 10 digit
536
;   keys and the space, ENTER and symbol shift key.
537
;   Unshifted alphabetic keys have $20 added to the value.
538
;   The keywords for the main alphabetic keys are obtained by adding $A5 to
539
;   the values obtained from this table.
540
 
541
;; MAIN-KEYS
542
L0205:  DEFB    $42             ; B
543
        DEFB    $48             ; H
544
        DEFB    $59             ; Y
545
        DEFB    $36             ; 6
546
        DEFB    $35             ; 5
547
        DEFB    $54             ; T
548
        DEFB    $47             ; G
549
        DEFB    $56             ; V
550
        DEFB    $4E             ; N
551
        DEFB    $4A             ; J
552
        DEFB    $55             ; U
553
        DEFB    $37             ; 7
554
        DEFB    $34             ; 4
555
        DEFB    $52             ; R
556
        DEFB    $46             ; F
557
        DEFB    $43             ; C
558
        DEFB    $4D             ; M
559
        DEFB    $4B             ; K
560
        DEFB    $49             ; I
561
        DEFB    $38             ; 8
562
        DEFB    $33             ; 3
563
        DEFB    $45             ; E
564
        DEFB    $44             ; D
565
        DEFB    $58             ; X
566
        DEFB    $0E             ; SYMBOL SHIFT
567
        DEFB    $4C             ; L
568
        DEFB    $4F             ; O
569
        DEFB    $39             ; 9
570
        DEFB    $32             ; 2
571
        DEFB    $57             ; W
572
        DEFB    $53             ; S
573
        DEFB    $5A             ; Z
574
        DEFB    $20             ; SPACE
575
        DEFB    $0D             ; ENTER
576
        DEFB    $50             ; P
577
        DEFB    $30             ; 0
578
        DEFB    $31             ; 1
579
        DEFB    $51             ; Q
580
        DEFB    $41             ; A
581
 
582
 
583
;; E-UNSHIFT
584
;  The 26 unshifted extended mode keys for the alphabetic characters.
585
;  The green keywords on the original keyboard.
586
L022C:  DEFB    $E3             ; READ
587
        DEFB    $C4             ; BIN
588
        DEFB    $E0             ; LPRINT
589
        DEFB    $E4             ; DATA
590
        DEFB    $B4             ; TAN
591
        DEFB    $BC             ; SGN
592
        DEFB    $BD             ; ABS
593
        DEFB    $BB             ; SQR
594
        DEFB    $AF             ; CODE
595
        DEFB    $B0             ; VAL
596
        DEFB    $B1             ; LEN
597
        DEFB    $C0             ; USR
598
        DEFB    $A7             ; PI
599
        DEFB    $A6             ; INKEY$
600
        DEFB    $BE             ; PEEK
601
        DEFB    $AD             ; TAB
602
        DEFB    $B2             ; SIN
603
        DEFB    $BA             ; INT
604
        DEFB    $E5             ; RESTORE
605
        DEFB    $A5             ; RND
606
        DEFB    $C2             ; CHR$
607
        DEFB    $E1             ; LLIST
608
        DEFB    $B3             ; COS
609
        DEFB    $B9             ; EXP
610
        DEFB    $C1             ; STR$
611
        DEFB    $B8             ; LN
612
 
613
 
614
;; EXT-SHIFT
615
;  The 26 shifted extended mode keys for the alphabetic characters.
616
;  The red keywords below keys on the original keyboard.
617
L0246:  DEFB    $7E             ; ~
618
        DEFB    $DC             ; BRIGHT
619
        DEFB    $DA             ; PAPER
620
        DEFB    $5C             ; \
621
        DEFB    $B7             ; ATN
622
        DEFB    $7B             ; {
623
        DEFB    $7D             ; }
624
        DEFB    $D8             ; CIRCLE
625
        DEFB    $BF             ; IN
626
        DEFB    $AE             ; VAL$
627
        DEFB    $AA             ; SCREEN$
628
        DEFB    $AB             ; ATTR
629
        DEFB    $DD             ; INVERSE
630
        DEFB    $DE             ; OVER
631
        DEFB    $DF             ; OUT
632
        DEFB    $7F             ; (Copyright character)
633
        DEFB    $B5             ; ASN
634
        DEFB    $D6             ; VERIFY
635
        DEFB    $7C             ; |
636
        DEFB    $D5             ; MERGE
637
        DEFB    $5D             ; ]
638
        DEFB    $DB             ; FLASH
639
        DEFB    $B6             ; ACS
640
        DEFB    $D9             ; INK
641
        DEFB    $5B             ; [
642
        DEFB    $D7             ; BEEP
643
 
644
 
645
;; CTL-CODES
646
;  The ten control codes assigned to the top line of digits when the shift
647
;  key is pressed.
648
L0260:  DEFB    $0C             ; DELETE
649
        DEFB    $07             ; EDIT
650
        DEFB    $06             ; CAPS LOCK
651
        DEFB    $04             ; TRUE VIDEO
652
        DEFB    $05             ; INVERSE VIDEO
653
        DEFB    $08             ; CURSOR LEFT
654
        DEFB    $0A             ; CURSOR DOWN
655
        DEFB    $0B             ; CURSOR UP
656
        DEFB    $09             ; CURSOR RIGHT
657
        DEFB    $0F             ; GRAPHICS
658
 
659
 
660
;; SYM-CODES
661
;  The 26 red symbols assigned to the alphabetic characters of the keyboard.
662
;  The ten single-character digit symbols are converted without the aid of
663
;  a table using subtraction and minor manipulation.
664
L026A:  DEFB    $E2             ; STOP
665
        DEFB    $2A             ; *
666
        DEFB    $3F             ; ?
667
        DEFB    $CD             ; STEP
668
        DEFB    $C8             ; >=
669
        DEFB    $CC             ; TO
670
        DEFB    $CB             ; THEN
671
        DEFB    $5E             ; ^
672
        DEFB    $AC             ; AT
673
        DEFB    $2D             ; -
674
        DEFB    $2B             ; +
675
        DEFB    $3D             ; =
676
        DEFB    $2E             ; .
677
        DEFB    $2C             ; ,
678
        DEFB    $3B             ; ;
679
        DEFB    $22             ; "
680
        DEFB    $C7             ; <=
681
        DEFB    $3C             ; <
682
        DEFB    $C3             ; NOT
683
        DEFB    $3E             ; >
684
        DEFB    $C5             ; OR
685
        DEFB    $2F             ; /
686
        DEFB    $C9             ; <>
687
        DEFB    $60             ; pound
688
        DEFB    $C6             ; AND
689
        DEFB    $3A             ; :
690
 
691
;; E-DIGITS
692
;  The ten keywords assigned to the digits in extended mode.
693
;  The remaining red keywords below the keys.
694
L0284:  DEFB    $D0             ; FORMAT
695
        DEFB    $CE             ; DEF FN
696
        DEFB    $A8             ; FN
697
        DEFB    $CA             ; LINE
698
        DEFB    $D3             ; OPEN #
699
        DEFB    $D4             ; CLOSE #
700
        DEFB    $D1             ; MOVE
701
        DEFB    $D2             ; ERASE
702
        DEFB    $A9             ; POINT
703
        DEFB    $CF             ; CAT
704
 
705
 
706
;*******************************
707
;** Part 2. KEYBOARD ROUTINES **
708
;*******************************
709
 
710
;   Using shift keys and a combination of modes the Spectrum 40-key keyboard
711
;   can be mapped to 256 input characters
712
 
713
; ---------------------------------------------------------------------------
714
;
715
;         0     1     2     3     4 -Bits-  4     3     2     1     0
716
; PORT                                                                    PORT
717
;
718
; F7FE  [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ]  |  [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 0 ]   EFFE
719
;  ^                                   |                                   v
720
; FBFE  [ Q ] [ W ] [ E ] [ R ] [ T ]  |  [ Y ] [ U ] [ I ] [ O ] [ P ]   DFFE
721
;  ^                                   |                                   v
722
; FDFE  [ A ] [ S ] [ D ] [ F ] [ G ]  |  [ H ] [ J ] [ K ] [ L ] [ ENT ] BFFE
723
;  ^                                   |                                   v
724
; FEFE  [SHI] [ Z ] [ X ] [ C ] [ V ]  |  [ B ] [ N ] [ M ] [sym] [ SPC ] 7FFE
725
;  ^     $27                                                 $18           v
726
; Start                                                                   End
727
;        00100111                                            00011000
728
;
729
; ---------------------------------------------------------------------------
730
;   The above map may help in reading.
731
;   The neat arrangement of ports means that the B register need only be
732
;   rotated left to work up the left hand side and then down the right
733
;   hand side of the keyboard. When the reset bit drops into the carry
734
;   then all 8 half-rows have been read. Shift is the first key to be
735
;   read. The lower six bits of the shifts are unambiguous.
736
 
737
; -------------------------------
738
; THE 'KEYBOARD SCANNING' ROUTINE
739
; -------------------------------
740
;   From keyboard and s-inkey$
741
;   Returns 1 or 2 keys in DE, most significant shift first if any
742
;   key values 0-39 else 255
743
 
744
;; KEY-SCAN
745
L028E:  LD      L,$2F           ; initial key value
746
                                ; valid values are obtained by subtracting
747
                                ; eight five times.
748
        LD      DE,$FFFF        ; a buffer to receive 2 keys.
749
 
750
        LD      BC,$FEFE        ; the commencing port address
751
                                ; B holds 11111110 initially and is also
752
                                ; used to count the 8 half-rows
753
;; KEY-LINE
754
L0296:  IN      A,(C)           ; read the port to A - bits will be reset
755
                                ; if a key is pressed else set.
756
        CPL                     ; complement - pressed key-bits are now set
757
        AND     $1F             ; apply 00011111 mask to pick up the
758
                                ; relevant set bits.
759
 
760
        JR      Z,L02AB         ; forward to KEY-DONE if zero and therefore
761
                                ; no keys pressed in row at all.
762
 
763
        LD      H,A             ; transfer row bits to H
764
        LD      A,L             ; load the initial key value to A
765
 
766
;; KEY-3KEYS
767
L029F:  INC     D               ; now test the key buffer
768
        RET     NZ              ; if we have collected 2 keys already
769
                                ; then too many so quit.
770
 
771
;; KEY-BITS
772
L02A1:  SUB     $08             ; subtract 8 from the key value
773
                                ; cycling through key values (top = $27)
774
                                ; e.g. 2F>   27>1F>17>0F>07
775
                                ;      2E>   26>1E>16>0E>06
776
        SRL     H               ; shift key bits right into carry.
777
        JR      NC,L02A1        ; back to KEY-BITS if not pressed
778
                                ; but if pressed we have a value (0-39d)
779
 
780
        LD      D,E             ; transfer a possible previous key to D
781
        LD      E,A             ; transfer the new key to E
782
        JR      NZ,L029F        ; back to KEY-3KEYS if there were more
783
                                ; set bits - H was not yet zero.
784
 
785
;; KEY-DONE
786
L02AB:  DEC     L               ; cycles 2F>2E>2D>2C>2B>2A>29>28 for
787
                                ; each half-row.
788
        RLC     B               ; form next port address e.g. FEFE > FDFE
789
        JR      C,L0296         ; back to KEY-LINE if still more rows to do.
790
 
791
        LD      A,D             ; now test if D is still FF ?
792
        INC     A               ; if it is zero we have at most 1 key
793
                                ; range now $01-$28  (1-40d)
794
        RET     Z               ; return if one key or no key.
795
 
796
        CP      $28             ; is it capsshift (was $27) ?
797
        RET     Z               ; return if so.
798
 
799
        CP      $19             ; is it symbol shift (was $18) ?
800
        RET     Z               ; return also
801
 
802
        LD      A,E             ; now test E
803
        LD      E,D             ; but first switch
804
        LD      D,A             ; the two keys.
805
        CP      $18             ; is it symbol shift ?
806
        RET                     ; return (with zero set if it was).
807
                                ; but with symbol shift now in D
808
 
809
; ----------------------
810
; THE 'KEYBOARD' ROUTINE
811
; ----------------------
812
;   Called from the interrupt 50 times a second.
813
;
814
 
815
;; KEYBOARD
816
L02BF:  CALL    L028E           ; routine KEY-SCAN
817
        RET     NZ              ; return if invalid combinations
818
 
819
;   then decrease the counters within the two key-state maps
820
;   as this could cause one to become free.
821
;   if the keyboard has not been pressed during the last five interrupts
822
;   then both sets will be free.
823
 
824
 
825
        LD      HL,$5C00        ; point to KSTATE-0
826
 
827
;; K-ST-LOOP
828
L02C6:  BIT     7,(HL)          ; is it free ?  (i.e. $FF)
829
        JR      NZ,L02D1        ; forward to K-CH-SET if so
830
 
831
        INC     HL              ; address the 5-counter
832
        DEC     (HL)            ; decrease the counter
833
        DEC     HL              ; step back
834
 
835
        JR      NZ,L02D1        ; forward to K-CH-SET if not at end of count
836
 
837
        LD      (HL),$FF        ; else mark this particular map free.
838
 
839
;; K-CH-SET
840
L02D1:  LD      A,L             ; make a copy of the low address byte.
841
        LD      HL,$5C04        ; point to KSTATE-4
842
                                ; (ld l,$04 would do)
843
        CP      L               ; have both sets been considered ?
844
        JR      NZ,L02C6        ; back to K-ST-LOOP to consider this 2nd set
845
 
846
;   now the raw key (0-38d) is converted to a main key (uppercase).
847
 
848
        CALL    L031E           ; routine K-TEST to get main key in A
849
 
850
        RET     NC              ; return if just a single shift
851
 
852
        LD      HL,$5C00        ; point to KSTATE-0
853
        CP      (HL)            ; does the main key code match ?
854
        JR      Z,L0310         ; forward to K-REPEAT if so
855
 
856
;   if not consider the second key map.
857
 
858
        EX      DE,HL           ; save kstate-0 in de
859
        LD      HL,$5C04        ; point to KSTATE-4
860
        CP      (HL)            ; does the main key code match ?
861
        JR      Z,L0310         ; forward to K-REPEAT if so
862
 
863
;   having excluded a repeating key we can now consider a new key.
864
;   the second set is always examined before the first.
865
 
866
        BIT     7,(HL)          ; is the key map free ?
867
        JR      NZ,L02F1        ; forward to K-NEW if so.
868
 
869
        EX      DE,HL           ; bring back KSTATE-0
870
        BIT     7,(HL)          ; is it free ?
871
        RET     Z               ; return if not.
872
                                ; as we have a key but nowhere to put it yet.
873
 
874
;   continue or jump to here if one of the buffers was free.
875
 
876
;; K-NEW
877
L02F1:  LD      E,A             ; store key in E
878
        LD      (HL),A          ; place in free location
879
        INC     HL              ; advance to the interrupt counter
880
        LD      (HL),$05        ; and initialize counter to 5
881
        INC     HL              ; advance to the delay
882
        LD      A,($5C09)       ; pick up the system variable REPDEL
883
        LD      (HL),A          ; and insert that for first repeat delay.
884
        INC     HL              ; advance to last location of state map.
885
 
886
        LD      C,(IY+$07)      ; pick up MODE  (3 bytes)
887
        LD      D,(IY+$01)      ; pick up FLAGS (3 bytes)
888
        PUSH    HL              ; save state map location
889
                                ; Note. could now have used, to avoid IY,
890
                                ; ld l,$41; ld c,(hl); ld l,$3B; ld d,(hl).
891
                                ; six and two threes of course.
892
 
893
        CALL    L0333           ; routine K-DECODE
894
 
895
        POP     HL              ; restore map pointer
896
        LD      (HL),A          ; put the decoded key in last location of map.
897
 
898
;; K-END
899
L0308:  LD      ($5C08),A       ; update LASTK system variable.
900
        SET     5,(IY+$01)      ; update FLAGS  - signal a new key.
901
        RET                     ; return to interrupt routine.
902
 
903
; -----------------------
904
; THE 'REPEAT KEY' BRANCH
905
; -----------------------
906
;   A possible repeat has been identified. HL addresses the raw key.
907
;   The last location of the key map holds the decoded key from the first
908
;   context.  This could be a keyword and, with the exception of NOT a repeat
909
;   is syntactically incorrect and not really desirable.
910
 
911
;; K-REPEAT
912
L0310:  INC     HL              ; increment the map pointer to second location.
913
        LD      (HL),$05        ; maintain interrupt counter at 5.
914
        INC     HL              ; now point to third location.
915
        DEC     (HL)            ; decrease the REPDEL value which is used to
916
                                ; time the delay of a repeat key.
917
 
918
        RET     NZ              ; return if not yet zero.
919
 
920
        LD      A,($5C0A)       ; fetch the system variable value REPPER.
921
        LD      (HL),A          ; for subsequent repeats REPPER will be used.
922
 
923
        INC     HL              ; advance
924
                                ;
925
        LD      A,(HL)          ; pick up the key decoded possibly in another
926
                                ; context.
927
                                ; Note. should compare with $A5 (RND) and make
928
                                ; a simple return if this is a keyword.
929
                                ; e.g. cp $a5; ret nc; (3 extra bytes)
930
        JR      L0308           ; back to K-END
931
 
932
; ----------------------
933
; THE 'KEY-TEST' ROUTINE
934
; ----------------------
935
;   also called from s-inkey$
936
;   begin by testing for a shift with no other.
937
 
938
;; K-TEST
939
L031E:  LD      B,D             ; load most significant key to B
940
                                ; will be $FF if not shift.
941
        LD      D,$00           ; and reset D to index into main table
942
        LD      A,E             ; load least significant key from E
943
        CP      $27             ; is it higher than 39d   i.e. FF
944
        RET     NC              ; return with just a shift (in B now)
945
 
946
        CP      $18             ; is it symbol shift ?
947
        JR      NZ,L032C        ; forward to K-MAIN if not
948
 
949
;   but we could have just symbol shift and no other
950
 
951
        BIT     7,B             ; is other key $FF (ie not shift)
952
        RET     NZ              ; return with solitary symbol shift
953
 
954
 
955
;; K-MAIN
956
L032C:  LD      HL,L0205        ; address: MAIN-KEYS
957
        ADD     HL,DE           ; add offset 0-38
958
        LD      A,(HL)          ; pick up main key value
959
        SCF                     ; set carry flag
960
        RET                     ; return    (B has other key still)
961
 
962
; ----------------------------------
963
; THE 'KEYBOARD DECODING' SUBROUTINE
964
; ----------------------------------
965
;   also called from s-inkey$
966
 
967
;; K-DECODE
968
L0333:  LD      A,E             ; pick up the stored main key
969
        CP      $3A             ; an arbitrary point between digits and letters
970
        JR      C,L0367         ; forward to K-DIGIT with digits, space, enter.
971
 
972
        DEC     C               ; decrease MODE ( 0='KLC', 1='E', 2='G')
973
 
974
        JP      M,L034F         ; to K-KLC-LET if was zero
975
 
976
        JR      Z,L0341         ; to K-E-LET if was 1 for extended letters.
977
 
978
;   proceed with graphic codes.
979
;   Note. should selectively drop return address if code > 'U' ($55).
980
;   i.e. abort the KEYBOARD call.
981
;   e.g. cp 'V'; jr c,addit; pop af ;pop af ;;addit etc. (6 extra bytes).
982
;   (s-inkey$ never gets into graphics mode.)
983
 
984
;; addit
985
        ADD     A,$4F           ; add offset to augment 'A' to graphics A say.
986
        RET                     ; return.
987
                                ; Note. ( but [GRAPH] V gives RND, etc ).
988
 
989
; ---
990
 
991
;   the jump was to here with extended mode with uppercase A-Z.
992
 
993
;; K-E-LET
994
L0341:  LD      HL,L022C-$41    ; base address of E-UNSHIFT L022c.
995
                                ; ( $01EB in standard ROM ).
996
        INC     B               ; test B is it empty i.e. not a shift.
997
        JR      Z,L034A         ; forward to K-LOOK-UP if neither shift.
998
 
999
        LD      HL,L0246-$41    ; Address: $0205 L0246-$41 EXT-SHIFT base
1000
 
1001
;; K-LOOK-UP
1002
L034A:  LD      D,$00           ; prepare to index.
1003
        ADD     HL,DE           ; add the main key value.
1004
        LD      A,(HL)          ; pick up other mode value.
1005
        RET                     ; return.
1006
 
1007
; ---
1008
 
1009
;   the jump was here with mode = 0
1010
 
1011
;; K-KLC-LET
1012
L034F:  LD      HL,L026A-$41    ; prepare base of sym-codes
1013
        BIT     0,B             ; shift=$27 sym-shift=$18
1014
        JR      Z,L034A         ; back to K-LOOK-UP with symbol-shift
1015
 
1016
        BIT     3,D             ; test FLAGS is it 'K' mode (from OUT-CURS)
1017
        JR      Z,L0364         ; skip to K-TOKENS if so
1018
 
1019
        BIT     3,(IY+$30)      ; test FLAGS2 - consider CAPS LOCK ?
1020
        RET     NZ              ; return if so with main code.
1021
 
1022
        INC     B               ; is shift being pressed ?
1023
                                ; result zero if not
1024
        RET     NZ              ; return if shift pressed.
1025
 
1026
        ADD     A,$20           ; else convert the code to lower case.
1027
        RET                     ; return.
1028
 
1029
; ---
1030
 
1031
;   the jump was here for tokens
1032
 
1033
;; K-TOKENS
1034
L0364:  ADD     A,$A5           ; add offset to main code so that 'A'
1035
                                ; becomes 'NEW' etc.
1036
 
1037
        RET                     ; return.
1038
 
1039
; ---
1040
 
1041
;   the jump was here with digits, space, enter and symbol shift (< $xx)
1042
 
1043
;; K-DIGIT
1044
L0367:  CP      $30             ; is it '0' or higher ?
1045
        RET     C               ; return with space, enter and symbol-shift
1046
 
1047
        DEC     C               ; test MODE (was 0='KLC', 1='E', 2='G')
1048
        JP      M,L039D         ; jump to K-KLC-DGT if was 0.
1049
 
1050
        JR      NZ,L0389        ; forward to K-GRA-DGT if mode was 2.
1051
 
1052
;   continue with extended digits 0-9.
1053
 
1054
        LD      HL,L0284-$30    ; $0254 - base of E-DIGITS
1055
        BIT     5,B             ; test - shift=$27 sym-shift=$18
1056
        JR      Z,L034A         ; to K-LOOK-UP if sym-shift
1057
 
1058
        CP      $38             ; is character '8' ?
1059
        JR      NC,L0382        ; to K-8-&-9 if greater than '7'
1060
 
1061
        SUB     $20             ; reduce to ink range $10-$17
1062
        INC     B               ; shift ?
1063
        RET     Z               ; return if not.
1064
 
1065
        ADD     A,$08           ; add 8 to give paper range $18 - $1F
1066
        RET                     ; return
1067
 
1068
; ---
1069
 
1070
;   89
1071
 
1072
;; K-8-&-9
1073
L0382:  SUB     $36             ; reduce to 02 and 03  bright codes
1074
        INC     B               ; test if shift pressed.
1075
        RET     Z               ; return if not.
1076
 
1077
        ADD     A,$FE           ; subtract 2 setting carry
1078
        RET                     ; to give 0 and 1    flash codes.
1079
 
1080
; ---
1081
 
1082
;   graphics mode with digits
1083
 
1084
;; K-GRA-DGT
1085
L0389:  LD      HL,L0260-$30    ; $0230 base address of CTL-CODES
1086
 
1087
        CP      $39             ; is key '9' ?
1088
        JR      Z,L034A         ; back to K-LOOK-UP - changed to $0F, GRAPHICS.
1089
 
1090
        CP      $30             ; is key '0' ?
1091
        JR      Z,L034A         ; back to K-LOOK-UP - changed to $0C, delete.
1092
 
1093
;   for keys '0' - '7' we assign a mosaic character depending on shift.
1094
 
1095
        AND     $07             ; convert character to number. 0 - 7.
1096
        ADD     A,$80           ; add offset - they start at $80
1097
 
1098
        INC     B               ; destructively test for shift
1099
        RET     Z               ; and return if not pressed.
1100
 
1101
        XOR     $0F             ; toggle bits becomes range $88-$8F
1102
        RET                     ; return.
1103
 
1104
; ---
1105
 
1106
;   now digits in 'KLC' mode
1107
 
1108
;; K-KLC-DGT
1109
L039D:  INC     B               ; return with digit codes if neither
1110
        RET     Z               ; shift key pressed.
1111
 
1112
        BIT     5,B             ; test for caps shift.
1113
 
1114
        LD      HL,L0260-$30    ; prepare base of table CTL-CODES.
1115
        JR      NZ,L034A        ; back to K-LOOK-UP if shift pressed.
1116
 
1117
;   must have been symbol shift
1118
 
1119
        SUB     $10             ; for ASCII most will now be correct
1120
                                ; on a standard typewriter.
1121
 
1122
        CP      $22             ; but '@' is not - see below.
1123
        JR      Z,L03B2         ; forward to K-@-CHAR if so
1124
 
1125
        CP      $20             ; '_' is the other one that fails
1126
        RET     NZ              ; return if not.
1127
 
1128
        LD      A,$5F           ; substitute ASCII '_'
1129
        RET                     ; return.
1130
 
1131
; ---
1132
 
1133
;; K-@-CHAR
1134
L03B2:  LD      A,$40           ; substitute ASCII '@'
1135
        RET                     ; return.
1136
 
1137
 
1138
; ------------------------------------------------------------------------
1139
;   The Spectrum Input character keys. One or two are abbreviated.
1140
;   From $00 Flash 0 to $FF COPY. The routine above has decoded all these.
1141
 
1142
;  | 00 Fl0| 01 Fl1| 02 Br0| 03 Br1| 04 In0| 05 In1| 06 CAP| 07 EDT|
1143
;  | 08 LFT| 09 RIG| 0A DWN| 0B UP | 0C DEL| 0D ENT| 0E SYM| 0F GRA|
1144
;  | 10 Ik0| 11 Ik1| 12 Ik2| 13 Ik3| 14 Ik4| 15 Ik5| 16 Ik6| 17 Ik7|
1145
;  | 18 Pa0| 19 Pa1| 1A Pa2| 1B Pa3| 1C Pa4| 1D Pa5| 1E Pa6| 1F Pa7|
1146
;  | 20 SP | 21  ! | 22  " | 23  # | 24  $ | 25  % | 26  & | 27  ' |
1147
;  | 28  ( | 29  ) | 2A  * | 2B  + | 2C  , | 2D  - | 2E  . | 2F  / |
1148
;  | 30  0 | 31  1 | 32  2 | 33  3 | 34  4 | 35  5 | 36  6 | 37  7 |
1149
;  | 38  8 | 39  9 | 3A  : | 3B  ; | 3C  < | 3D  = | 3E  > | 3F  ? |
1150
;  | 40  @ | 41  A | 42  B | 43  C | 44  D | 45  E | 46  F | 47  G |
1151
;  | 48  H | 49  I | 4A  J | 4B  K | 4C  L | 4D  M | 4E  N | 4F  O |
1152
;  | 50  P | 51  Q | 52  R | 53  S | 54  T | 55  U | 56  V | 57  W |
1153
;  | 58  X | 59  Y | 5A  Z | 5B  [ | 5C  \ | 5D  ] | 5E  ^ | 5F  _ |
1154
;  | 60  £ | 61  a | 62  b | 63  c | 64  d | 65  e | 66  f | 67  g |
1155
;  | 68  h | 69  i | 6A  j | 6B  k | 6C  l | 6D  m | 6E  n | 6F  o |
1156
;  | 70  p | 71  q | 72  r | 73  s | 74  t | 75  u | 76  v | 77  w |
1157
;  | 78  x | 79  y | 7A  z | 7B  { | 7C  | | 7D  } | 7E  ~ | 7F  © |
1158
;  | 80 128| 81 129| 82 130| 83 131| 84 132| 85 133| 86 134| 87 135|
1159
;  | 88 136| 89 137| 8A 138| 8B 139| 8C 140| 8D 141| 8E 142| 8F 143|
1160
;  | 90 [A]| 91 [B]| 92 [C]| 93 [D]| 94 [E]| 95 [F]| 96 [G]| 97 [H]|
1161
;  | 98 [I]| 99 [J]| 9A [K]| 9B [L]| 9C [M]| 9D [N]| 9E [O]| 9F [P]|
1162
;  | A0 [Q]| A1 [R]| A2 [S]| A3 [T]| A4 [U]| A5 RND| A6 IK$| A7 PI |
1163
;  | A8 FN | A9 PNT| AA SC$| AB ATT| AC AT | AD TAB| AE VL$| AF COD|
1164
;  | B0 VAL| B1 LEN| B2 SIN| B3 COS| B4 TAN| B5 ASN| B6 ACS| B7 ATN|
1165
;  | B8 LN | B9 EXP| BA INT| BB SQR| BC SGN| BD ABS| BE PEK| BF IN |
1166
;  | C0 USR| C1 ST$| C2 CH$| C3 NOT| C4 BIN| C5 OR | C6 AND| C7 <= |
1167
;  | C8 >= | C9 <> | CA LIN| CB THN| CC TO | CD STP| CE DEF| CF CAT|
1168
;  | D0 FMT| D1 MOV| D2 ERS| D3 OPN| D4 CLO| D5 MRG| D6 VFY| D7 BEP|
1169
;  | D8 CIR| D9 INK| DA PAP| DB FLA| DC BRI| DD INV| DE OVR| DF OUT|
1170
;  | E0 LPR| E1 LLI| E2 STP| E3 REA| E4 DAT| E5 RES| E6 NEW| E7 BDR|
1171
;  | E8 CON| E9 DIM| EA REM| EB FOR| EC GTO| ED GSB| EE INP| EF LOA|
1172
;  | F0 LIS| F1 LET| F2 PAU| F3 NXT| F4 POK| F5 PRI| F6 PLO| F7 RUN|
1173
;  | F8 SAV| F9 RAN| FA IF | FB CLS| FC DRW| FD CLR| FE RET| FF CPY|
1174
 
1175
;   Note that for simplicity, Sinclair have located all the control codes
1176
;   below the space character.
1177
;   ASCII DEL, $7F, has been made a copyright symbol.
1178
;   Also $60, '`', not used in BASIC but used in other languages, has been
1179
;   allocated the local currency symbol for the relevant country -
1180
;    £  in most Spectrums.
1181
 
1182
; ------------------------------------------------------------------------
1183
 
1184
 
1185
;**********************************
1186
;** Part 3. LOUDSPEAKER ROUTINES **
1187
;**********************************
1188
 
1189
; Documented by Alvin Albrecht.
1190
 
1191
; ------------------------------
1192
; Routine to control loudspeaker
1193
; ------------------------------
1194
; Outputs a square wave of given duration and frequency
1195
; to the loudspeaker.
1196
;   Enter with: DE = #cycles - 1
1197
;               HL = tone period as described next
1198
;
1199
; The tone period is measured in T states and consists of
1200
; three parts: a coarse part (H register), a medium part
1201
; (bits 7..2 of L) and a fine part (bits 1..0 of L) which
1202
; contribute to the waveform timing as follows:
1203
;
1204
;                          coarse    medium       fine
1205
; duration of low  = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3)
1206
; duration of hi   = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3)
1207
; Tp = tone period = 236 + 2048*H + 32*(L>>2) + 8*(L&0x3)
1208
;                  = 236 + 2048*H + 8*L = 236 + 8*HL
1209
;
1210
; As an example, to output five seconds of middle C (261.624 Hz):
1211
;   (a) Tone period = 1/261.624 = 3.822ms
1212
;   (b) Tone period in T-States = 3.822ms*fCPU = 13378
1213
;         where fCPU = clock frequency of the CPU = 3.5MHz
1214
;    ©  Find H and L for desired tone period:
1215
;         HL = (Tp - 236) / 8 = (13378 - 236) / 8 = 1643 = 0x066B
1216
;   (d) Tone duration in cycles = 5s/3.822ms = 1308 cycles
1217
;         DE = 1308 - 1 = 0x051B
1218
;
1219
; The resulting waveform has a duty ratio of exactly 50%.
1220
;
1221
;
1222
;; BEEPER
1223
L03B5:  DI                      ; Disable Interrupts so they don't disturb timing
1224
        LD      A,L             ;
1225
        SRL     L               ;
1226
        SRL     L               ; L = medium part of tone period
1227
        CPL                     ;
1228
        AND     $03             ; A = 3 - fine part of tone period
1229
        LD      C,A             ;
1230
        LD      B,$00           ;
1231
        LD      IX,L03D1        ; Address: BE-IX+3
1232
        ADD     IX,BC           ;   IX holds address of entry into the loop
1233
                                ;   the loop will contain 0-3 NOPs, implementing
1234
                                ;   the fine part of the tone period.
1235
        LD      A,($5C48)       ; BORDCR
1236
        AND     $38             ; bits 5..3 contain border colour
1237
        RRCA                    ; border colour bits moved to 2..0
1238
        RRCA                    ;   to match border bits on port #FE
1239
        RRCA                    ;
1240
        OR       $08            ; bit 3 set (tape output bit on port #FE)
1241
                                ;   for loud sound output
1242
;; BE-IX+3
1243
L03D1:  NOP              ;(4)   ; optionally executed NOPs for small
1244
                                ;   adjustments to tone period
1245
;; BE-IX+2
1246
L03D2:  NOP              ;(4)   ;
1247
 
1248
;; BE-IX+1
1249
L03D3:  NOP              ;(4)   ;
1250
 
1251
;; BE-IX+0
1252
L03D4:  INC     B        ;(4)   ;
1253
        INC     C        ;(4)   ;
1254
 
1255
;; BE-H&L-LP
1256
L03D6:  DEC     C        ;(4)   ; timing loop for duration of
1257
        JR      NZ,L03D6 ;(12/7);   high or low pulse of waveform
1258
 
1259
        LD      C,$3F    ;(7)   ;
1260
        DEC     B        ;(4)   ;
1261
        JP      NZ,L03D6 ;(10)  ; to BE-H&L-LP
1262
 
1263
        XOR     $10      ;(7)   ; toggle output beep bit
1264
        OUT     ($FE),A  ;(11)  ; output pulse
1265
        LD      B,H      ;(4)   ; B = coarse part of tone period
1266
        LD      C,A      ;(4)   ; save port #FE output byte
1267
        BIT     4,A      ;(8)   ; if new output bit is high, go
1268
        JR      NZ,L03F2 ;(12/7);   to BE-AGAIN
1269
 
1270
        LD      A,D      ;(4)   ; one cycle of waveform has completed
1271
        OR      E        ;(4)   ;   (low->low). if cycle countdown = 0
1272
        JR      Z,L03F6  ;(12/7);   go to BE-END
1273
 
1274
        LD      A,C      ;(4)   ; restore output byte for port #FE
1275
        LD      C,L      ;(4)   ; C = medium part of tone period
1276
        DEC     DE       ;(6)   ; decrement cycle count
1277
        JP      (IX)     ;(8)   ; do another cycle
1278
 
1279
;; BE-AGAIN                     ; halfway through cycle
1280
L03F2:  LD      C,L      ;(4)   ; C = medium part of tone period
1281
        INC     C        ;(4)   ; adds 16 cycles to make duration of high = duration of low
1282
        JP      (IX)     ;(8)   ; do high pulse of tone
1283
 
1284
;; BE-END
1285
L03F6:  EI                      ; Enable Interrupts
1286
        RET                     ;
1287
 
1288
 
1289
; ------------------
1290
; THE 'BEEP' COMMAND
1291
; ------------------
1292
; BASIC interface to BEEPER subroutine.
1293
; Invoked in BASIC with:
1294
;   BEEP dur, pitch
1295
;   where dur   = duration in seconds
1296
;         pitch = # of semitones above/below middle C
1297
;
1298
; Enter with: pitch on top of calculator stack
1299
;             duration next on calculator stack
1300
;
1301
;; beep
1302
L03F8:  RST     28H             ;; FP-CALC
1303
        DEFB    $31             ;;duplicate                  ; duplicate pitch
1304
        DEFB    $27             ;;int                        ; convert to integer
1305
        DEFB    $C0             ;;st-mem-0                   ; store integer pitch to memory 0
1306
        DEFB    $03             ;;subtract                   ; calculate fractional part of pitch = fp_pitch - int_pitch
1307
        DEFB    $34             ;;stk-data                   ; push constant
1308
        DEFB    $EC             ;;Exponent: $7C, Bytes: 4    ; constant = 0.05762265
1309
        DEFB    $6C,$98,$1F,$F5 ;;($6C,$98,$1F,$F5)
1310
        DEFB    $04             ;;multiply                   ; compute:
1311
        DEFB    $A1             ;;stk-one                    ; 1 + 0.05762265 * fraction_part(pitch)
1312
        DEFB    $0F             ;;addition
1313
        DEFB    $38             ;;end-calc                   ; leave on calc stack
1314
 
1315
        LD      HL,$5C92        ; MEM-0: number stored here is in 16 bit integer format (pitch)
1316
                                ;   0, 0/FF (pos/neg), LSB, MSB, 0
1317
                                ;   LSB/MSB is stored in two's complement
1318
                                ; In the following, the pitch is checked if it is in the range -128<=p<=127
1319
        LD      A,(HL)          ; First byte must be zero, otherwise
1320
        AND     A               ;   error in integer conversion
1321
        JR      NZ,L046C        ; to REPORT-B
1322
 
1323
        INC     HL              ;
1324
        LD      C,(HL)          ; C = pos/neg flag = 0/FF
1325
        INC     HL              ;
1326
        LD      B,(HL)          ; B = LSB, two's complement
1327
        LD      A,B             ;
1328
        RLA                     ;
1329
        SBC     A,A             ; A = 0/FF if B is pos/neg
1330
        CP      C               ; must be the same as C if the pitch is -128<=p<=127
1331
        JR      NZ,L046C        ; if no, error REPORT-B
1332
 
1333
        INC     HL              ; if -128<=p<=127, MSB will be 0/FF if B is pos/neg
1334
        CP      (HL)            ; verify this
1335
        JR      NZ,L046C        ; if no, error REPORT-B
1336
                                ; now we know -128<=p<=127
1337
        LD      A,B             ; A = pitch + 60
1338
        ADD     A,$3C           ; if -60<=pitch<=67,
1339
        JP      P,L0425         ;   goto BE-i-OK
1340
 
1341
        JP      PO,L046C        ; if pitch <= 67 goto REPORT-B
1342
                                ;   lower bound of pitch set at -60
1343
 
1344
;; BE-I-OK                      ; here, -60<=pitch<=127
1345
                                ; and A=pitch+60 -> 0<=A<=187
1346
 
1347
L0425:  LD      B,$FA           ; 6 octaves below middle C
1348
 
1349
;; BE-OCTAVE                    ; A=# semitones above 5 octaves below middle C
1350
L0427:  INC     B               ; increment octave
1351
        SUB     $0C             ; 12 semitones = one octave
1352
        JR      NC,L0427        ; to BE-OCTAVE
1353
 
1354
        ADD     A,$0C           ; A = # semitones above C (0-11)
1355
        PUSH    BC              ; B = octave displacement from middle C, 2's complement: -5<=B<=10
1356
        LD      HL,L046E        ; Address: semi-tone
1357
        CALL    L3406           ; routine LOC-MEM
1358
                                ;   HL = 5*A + $046E
1359
        CALL    L33B4           ; routine STACK-NUM
1360
                                ;   read FP value (freq) from semitone table (HL) and push onto calc stack
1361
 
1362
        RST     28H             ;; FP-CALC
1363
        DEFB    $04             ;;multiply   mult freq by 1 + 0.0576 * fraction_part(pitch) stacked earlier
1364
                                ;;             thus taking into account fractional part of pitch.
1365
                                ;;           the number 0.0576*frequency is the distance in Hz to the next
1366
                                ;;             note (verify with the frequencies recorded in the semitone
1367
                                ;;             table below) so that the fraction_part of the pitch does
1368
                                ;;             indeed represent a fractional distance to the next note.
1369
        DEFB    $38             ;;end-calc   HL points to first byte of fp num on stack = middle frequency to generate
1370
 
1371
        POP     AF              ; A = octave displacement from middle C, 2's complement: -5<=A<=10
1372
        ADD     A,(HL)          ; increase exponent by A (equivalent to multiplying by 2^A)
1373
        LD      (HL),A          ;
1374
 
1375
        RST     28H             ;; FP-CALC
1376
        DEFB    $C0             ;;st-mem-0          ; store frequency in memory 0
1377
        DEFB    $02             ;;delete            ; remove from calc stack
1378
        DEFB    $31             ;;duplicate         ; duplicate duration (seconds)
1379
        DEFB    $38             ;;end-calc
1380
 
1381
        CALL    L1E94           ; routine FIND-INT1 ; FP duration to A
1382
        CP      $0B             ; if dur > 10 seconds,
1383
        JR      NC,L046C        ;   goto REPORT-B
1384
 
1385
        ;;; The following calculation finds the tone period for HL and the cycle count
1386
        ;;; for DE expected in the BEEPER subroutine.  From the example in the BEEPER comments,
1387
        ;;;
1388
        ;;; HL = ((fCPU / f) - 236) / 8 = fCPU/8/f - 236/8 = 437500/f -29.5
1389
        ;;; DE = duration * frequency - 1
1390
        ;;;
1391
        ;;; Note the different constant (30.125) used in the calculation of HL
1392
        ;;; below.  This is probably an error.
1393
 
1394
        RST     28H             ;; FP-CALC
1395
        DEFB    $E0             ;;get-mem-0                 ; push frequency
1396
        DEFB    $04             ;;multiply                  ; result1: #cycles = duration * frequency
1397
        DEFB    $E0             ;;get-mem-0                 ; push frequency
1398
        DEFB    $34             ;;stk-data                  ; push constant
1399
        DEFB    $80             ;;Exponent $93, Bytes: 3    ; constant = 437500
1400
        DEFB    $43,$55,$9F,$80 ;;($55,$9F,$80,$00)
1401
        DEFB    $01             ;;exchange                  ; frequency on top
1402
        DEFB    $05             ;;division                  ; 437500 / frequency
1403
        DEFB    $34             ;;stk-data                  ; push constant
1404
        DEFB    $35             ;;Exponent: $85, Bytes: 1   ; constant = 30.125
1405
        DEFB    $71             ;;($71,$00,$00,$00)
1406
        DEFB    $03             ;;subtract                  ; result2: tone_period(HL) = 437500 / freq - 30.125
1407
        DEFB    $38             ;;end-calc
1408
 
1409
        CALL    L1E99           ; routine FIND-INT2
1410
        PUSH    BC              ;   BC = tone_period(HL)
1411
        CALL    L1E99           ; routine FIND-INT2, BC = #cycles to generate
1412
        POP     HL              ; HL = tone period
1413
        LD      D,B             ;
1414
        LD      E,C             ; DE = #cycles
1415
        LD      A,D             ;
1416
        OR      E               ;
1417
        RET     Z               ; if duration = 0, skip BEEP and avoid 65536 cycle
1418
                                ;   boondoggle that would occur next
1419
        DEC     DE              ; DE = #cycles - 1
1420
        JP      L03B5           ; to BEEPER
1421
 
1422
; ---
1423
 
1424
 
1425
;; REPORT-B
1426
L046C:  RST     08H             ; ERROR-1
1427
        DEFB    $0A             ; Error Report: Integer out of range
1428
 
1429
 
1430
 
1431
; ---------------------
1432
; THE 'SEMI-TONE' TABLE
1433
; ---------------------
1434
;
1435
;   Holds frequencies corresponding to semitones in middle octave.
1436
;   To move n octaves higher or lower, frequencies are multiplied by 2^n.
1437
 
1438
;; semi-tone         five byte fp         decimal freq     note (middle)
1439
L046E:  DEFB    $89, $02, $D0, $12, $86;  261.625565290         C
1440
        DEFB    $89, $0A, $97, $60, $75;  277.182631135         C#
1441
        DEFB    $89, $12, $D5, $17, $1F;  293.664768100         D
1442
        DEFB    $89, $1B, $90, $41, $02;  311.126983881         D#
1443
        DEFB    $89, $24, $D0, $53, $CA;  329.627557039         E
1444
        DEFB    $89, $2E, $9D, $36, $B1;  349.228231549         F
1445
        DEFB    $89, $38, $FF, $49, $3E;  369.994422674         F#
1446
        DEFB    $89, $43, $FF, $6A, $73;  391.995436072         G
1447
        DEFB    $89, $4F, $A7, $00, $54;  415.304697513         G#
1448
        DEFB    $89, $5C, $00, $00, $00;  440.000000000         A
1449
        DEFB    $89, $69, $14, $F6, $24;  466.163761616         A#
1450
        DEFB    $89, $76, $F1, $10, $05;  493.883301378         B
1451
 
1452
 
1453
;   "Music is the hidden mathematical endeavour of a soul unconscious it
1454
;    is calculating" - Gottfried Wilhelm Liebnitz 1646 - 1716
1455
 
1456
 
1457
;****************************************
1458
;** Part 4. CASSETTE HANDLING ROUTINES **
1459
;****************************************
1460
 
1461
;   These routines begin with the service routines followed by a single
1462
;   command entry point.
1463
;   The first of these service routines is a curiosity.
1464
 
1465
; -----------------------
1466
; THE 'ZX81 NAME' ROUTINE
1467
; -----------------------
1468
;   This routine fetches a filename in ZX81 format and is not used by the
1469
;   cassette handling routines in this ROM.
1470
 
1471
;; zx81-name
1472
L04AA:  CALL    L24FB           ; routine SCANNING to evaluate expression.
1473
        LD      A,($5C3B)       ; fetch system variable FLAGS.
1474
        ADD     A,A             ; test bit 7 - syntax, bit 6 - result type.
1475
        JP      M,L1C8A         ; to REPORT-C if not string result
1476
                                ; 'Nonsense in BASIC'.
1477
 
1478
        POP     HL              ; drop return address.
1479
        RET     NC              ; return early if checking syntax.
1480
 
1481
        PUSH    HL              ; re-save return address.
1482
        CALL    L2BF1           ; routine STK-FETCH fetches string parameters.
1483
        LD      H,D             ; transfer start of filename
1484
        LD      L,E             ; to the HL register.
1485
        DEC     C               ; adjust to point to last character and
1486
        RET     M               ; return if the null string.
1487
                                ; or multiple of 256!
1488
 
1489
        ADD     HL,BC           ; find last character of the filename.
1490
                                ; and also clear carry.
1491
        SET     7,(HL)          ; invert it.
1492
        RET                     ; return.
1493
 
1494
; =========================================
1495
;
1496
; PORT 254 ($FE)
1497
;
1498
;                      spk mic { border  }
1499
;          ___ ___ ___ ___ ___ ___ ___ ___
1500
; PORT    |   |   |   |   |   |   |   |   |
1501
; 254     |   |   |   |   |   |   |   |   |
1502
; $FE     |___|___|___|___|___|___|___|___|
1503
;           7   6   5   4   3   2   1   0
1504
;
1505
 
1506
; ----------------------------------
1507
; Save header and program/data bytes
1508
; ----------------------------------
1509
;   This routine saves a section of data. It is called from SA-CTRL to save the
1510
;   seventeen bytes of header data. It is also the exit route from that routine
1511
;   when it is set up to save the actual data.
1512
;   On entry -
1513
;   HL points to start of data.
1514
;   IX points to descriptor.
1515
;   The accumulator is set to  $00 for a header, $FF for data.
1516
 
1517
;; SA-BYTES
1518
L04C2:  LD      HL,L053F        ; address: SA/LD-RET
1519
        PUSH    HL              ; is pushed as common exit route.
1520
                                ; however there is only one non-terminal exit
1521
                                ; point.
1522
 
1523
        LD      HL,$1F80        ; a timing constant H=$1F, L=$80
1524
                                ; inner and outer loop counters
1525
                                ; a five second lead-in is used for a header.
1526
 
1527
        BIT     7,A             ; test one bit of accumulator.
1528
                                ; (AND A ?)
1529
        JR      Z,L04D0         ; skip to SA-FLAG if a header is being saved.
1530
 
1531
;   else is data bytes and a shorter lead-in is used.
1532
 
1533
        LD      HL,$0C98        ; another timing value H=$0C, L=$98.
1534
                                ; a two second lead-in is used for the data.
1535
 
1536
 
1537
;; SA-FLAG
1538
L04D0:  EX      AF,AF'          ; save flag
1539
        INC     DE              ; increase length by one.
1540
        DEC     IX              ; decrease start.
1541
 
1542
        DI                      ; disable interrupts
1543
 
1544
        LD      A,$02           ; select red for border, microphone bit on.
1545
        LD      B,A             ; also does as an initial slight counter value.
1546
 
1547
;; SA-LEADER
1548
L04D8:  DJNZ    L04D8           ; self loop to SA-LEADER for delay.
1549
                                ; after initial loop, count is $A4 (or $A3)
1550
 
1551
        OUT     ($FE),A         ; output byte $02/$0D to tape port.
1552
 
1553
        XOR     $0F             ; switch from RED (mic on) to CYAN (mic off).
1554
 
1555
        LD      B,$A4           ; hold count. also timed instruction.
1556
 
1557
        DEC     L               ; originally $80 or $98.
1558
                                ; but subsequently cycles 256 times.
1559
        JR      NZ,L04D8        ; back to SA-LEADER until L is zero.
1560
 
1561
;   the outer loop is counted by H
1562
 
1563
        DEC     B               ; decrement count
1564
        DEC     H               ; originally  twelve or thirty-one.
1565
        JP      P,L04D8         ; back to SA-LEADER until H becomes $FF
1566
 
1567
;   now send a sync pulse. At this stage mic is off and A holds value
1568
;   for mic on.
1569
;   A sync pulse is much shorter than the steady pulses of the lead-in.
1570
 
1571
        LD      B,$2F           ; another short timed delay.
1572
 
1573
;; SA-SYNC-1
1574
L04EA:  DJNZ    L04EA           ; self loop to SA-SYNC-1
1575
 
1576
        OUT     ($FE),A         ; switch to mic on and red.
1577
        LD      A,$0D           ; prepare mic off - cyan
1578
        LD      B,$37           ; another short timed delay.
1579
 
1580
;; SA-SYNC-2
1581
L04F2:  DJNZ    L04F2           ; self loop to SA-SYNC-2
1582
 
1583
        OUT     ($FE),A         ; output mic off, cyan border.
1584
        LD      BC,$3B0E        ; B=$3B time(*), C=$0E, YELLOW, MIC OFF.
1585
 
1586
;
1587
 
1588
        EX      AF,AF'          ; restore saved flag
1589
                                ; which is 1st byte to be saved.
1590
 
1591
        LD      L,A             ; and transfer to L.
1592
                                ; the initial parity is A, $FF or $00.
1593
        JP      L0507           ; JUMP forward to SA-START     ->
1594
                                ; the mid entry point of loop.
1595
 
1596
; -------------------------
1597
;   During the save loop a parity byte is maintained in H.
1598
;   the save loop begins by testing if reduced length is zero and if so
1599
;   the final parity byte is saved reducing count to $FFFF.
1600
 
1601
;; SA-LOOP
1602
L04FE:  LD      A,D             ; fetch high byte
1603
        OR      E               ; test against low byte.
1604
        JR      Z,L050E         ; forward to SA-PARITY if zero.
1605
 
1606
        LD      L,(IX+$00)      ; load currently addressed byte to L.
1607
 
1608
;; SA-LOOP-P
1609
L0505:  LD      A,H             ; fetch parity byte.
1610
        XOR     L               ; exclusive or with new byte.
1611
 
1612
; -> the mid entry point of loop.
1613
 
1614
;; SA-START
1615
L0507:  LD      H,A             ; put parity byte in H.
1616
        LD      A,$01           ; prepare blue, mic=on.
1617
        SCF                     ; set carry flag ready to rotate in.
1618
        JP      L0525           ; JUMP forward to SA-8-BITS            -8->
1619
 
1620
; ---
1621
 
1622
;; SA-PARITY
1623
L050E:  LD      L,H             ; transfer the running parity byte to L and
1624
        JR      L0505           ; back to SA-LOOP-P
1625
                                ; to output that byte before quitting normally.
1626
 
1627
; ---
1628
 
1629
;   The entry point to save yellow part of bit.
1630
;   A bit consists of a period with mic on and blue border followed by
1631
;   a period of mic off with yellow border.
1632
;   Note. since the DJNZ instruction does not affect flags, the zero flag is
1633
;   used to indicate which of the two passes is in effect and the carry
1634
;   maintains the state of the bit to be saved.
1635
 
1636
;; SA-BIT-2
1637
L0511:  LD      A,C             ; fetch 'mic on and yellow' which is
1638
                                ; held permanently in C.
1639
        BIT     7,B             ; set the zero flag. B holds $3E.
1640
 
1641
;   The entry point to save 1 entire bit. For first bit B holds $3B(*).
1642
;   Carry is set if saved bit is 1. zero is reset NZ on entry.
1643
 
1644
;; SA-BIT-1
1645
L0514:  DJNZ    L0514           ; self loop for delay to SA-BIT-1
1646
 
1647
        JR      NC,L051C        ; forward to SA-OUT if bit is 0.
1648
 
1649
;   but if bit is 1 then the mic state is held for longer.
1650
 
1651
        LD      B,$42           ; set timed delay. (66 decimal)
1652
 
1653
;; SA-SET
1654
L051A:  DJNZ    L051A           ; self loop to SA-SET
1655
                                ; (roughly an extra 66*13 clock cycles)
1656
 
1657
;; SA-OUT
1658
L051C:  OUT     ($FE),A         ; blue and mic on OR  yellow and mic off.
1659
 
1660
        LD      B,$3E           ; set up delay
1661
        JR      NZ,L0511        ; back to SA-BIT-2 if zero reset NZ (first pass)
1662
 
1663
;   proceed when the blue and yellow bands have been output.
1664
 
1665
        DEC     B               ; change value $3E to $3D.
1666
        XOR     A               ; clear carry flag (ready to rotate in).
1667
        INC     A               ; reset zero flag i.e. NZ.
1668
 
1669
; -8->
1670
 
1671
;; SA-8-BITS
1672
L0525:  RL      L               ; rotate left through carry
1673
                                ; C<76543210
1674
        JP      NZ,L0514        ; JUMP back to SA-BIT-1
1675
                                ; until all 8 bits done.
1676
 
1677
;   when the initial set carry is passed out again then a byte is complete.
1678
 
1679
        DEC     DE              ; decrease length
1680
        INC     IX              ; increase byte pointer
1681
        LD      B,$31           ; set up timing.
1682
 
1683
        LD      A,$7F           ; test the space key and
1684
        IN      A,($FE)         ; return to common exit (to restore border)
1685
        RRA                     ; if a space is pressed
1686
        RET     NC              ; return to SA/LD-RET.   - - >
1687
 
1688
;   now test if byte counter has reached $FFFF.
1689
 
1690
        LD      A,D             ; fetch high byte
1691
        INC     A               ; increment.
1692
        JP      NZ,L04FE        ; JUMP to SA-LOOP if more bytes.
1693
 
1694
        LD      B,$3B           ; a final delay.
1695
 
1696
;; SA-DELAY
1697
L053C:  DJNZ    L053C           ; self loop to SA-DELAY
1698
 
1699
        RET                     ; return - - >
1700
 
1701
; ------------------------------
1702
; THE 'SAVE/LOAD RETURN' ROUTINE
1703
; ------------------------------
1704
;   The address of this routine is pushed on the stack prior to any load/save
1705
;   operation and it handles normal completion with the restoration of the
1706
;   border and also abnormal termination when the break key, or to be more
1707
;   precise the space key is pressed during a tape operation.
1708
;
1709
; - - >
1710
 
1711
;; SA/LD-RET
1712
L053F:  PUSH    AF              ; preserve accumulator throughout.
1713
        LD      A,($5C48)       ; fetch border colour from BORDCR.
1714
        AND     $38             ; mask off paper bits.
1715
        RRCA                    ; rotate
1716
        RRCA                    ; to the
1717
        RRCA                    ; range 0-7.
1718
 
1719
        OUT     ($FE),A         ; change the border colour.
1720
 
1721
        LD      A,$7F           ; read from port address $7FFE the
1722
        IN      A,($FE)         ; row with the space key at outside.
1723
 
1724
        RRA                     ; test for space key pressed.
1725
        EI                      ; enable interrupts
1726
        JR      C,L0554         ; forward to SA/LD-END if not
1727
 
1728
 
1729
;; REPORT-Da
1730
L0552:  RST     08H             ; ERROR-1
1731
        DEFB    $0C             ; Error Report: BREAK - CONT repeats
1732
 
1733
; ---
1734
 
1735
;; SA/LD-END
1736
L0554:  POP     AF              ; restore the accumulator.
1737
        RET                     ; return.
1738
 
1739
; ------------------------------------
1740
; Load header or block of information
1741
; ------------------------------------
1742
;   This routine is used to load bytes and on entry A is set to $00 for a
1743
;   header or to $FF for data.  IX points to the start of receiving location
1744
;   and DE holds the length of bytes to be loaded. If, on entry the carry flag
1745
;   is set then data is loaded, if reset then it is verified.
1746
 
1747
;; LD-BYTES
1748
L0556:  INC     D               ; reset the zero flag without disturbing carry.
1749
        EX      AF,AF'          ; preserve entry flags.
1750
        DEC     D               ; restore high byte of length.
1751
 
1752
        DI                      ; disable interrupts
1753
 
1754
        LD      A,$0F           ; make the border white and mic off.
1755
        OUT     ($FE),A         ; output to port.
1756
 
1757
        LD      HL,L053F        ; Address: SA/LD-RET
1758
        PUSH    HL              ; is saved on stack as terminating routine.
1759
 
1760
;   the reading of the EAR bit (D6) will always be preceded by a test of the
1761
;   space key (D0), so store the initial post-test state.
1762
 
1763
        IN      A,($FE)         ; read the ear state - bit 6.
1764
        RRA                     ; rotate to bit 5.
1765
        AND     $20             ; isolate this bit.
1766
        OR      $02             ; combine with red border colour.
1767
        LD      C,A             ; and store initial state long-term in C.
1768
        CP      A               ; set the zero flag.
1769
 
1770
;
1771
 
1772
;; LD-BREAK
1773
L056B:  RET     NZ              ; return if at any time space is pressed.
1774
 
1775
;; LD-START
1776
L056C:  CALL    L05E7           ; routine LD-EDGE-1
1777
        JR      NC,L056B        ; back to LD-BREAK with time out and no
1778
                                ; edge present on tape.
1779
 
1780
;   but continue when a transition is found on tape.
1781
 
1782
        LD      HL,$0415        ; set up 16-bit outer loop counter for
1783
                                ; approx 1 second delay.
1784
 
1785
;; LD-WAIT
1786
L0574:  DJNZ    L0574           ; self loop to LD-WAIT (for 256 times)
1787
 
1788
        DEC     HL              ; decrease outer loop counter.
1789
        LD      A,H             ; test for
1790
        OR      L               ; zero.
1791
        JR      NZ,L0574        ; back to LD-WAIT, if not zero, with zero in B.
1792
 
1793
;   continue after delay with H holding zero and B also.
1794
;   sample 256 edges to check that we are in the middle of a lead-in section.
1795
 
1796
        CALL    L05E3           ; routine LD-EDGE-2
1797
        JR      NC,L056B        ; back to LD-BREAK
1798
                                ; if no edges at all.
1799
 
1800
;; LD-LEADER
1801
L0580:  LD      B,$9C           ; set timing value.
1802
        CALL    L05E3           ; routine LD-EDGE-2
1803
        JR      NC,L056B        ; back to LD-BREAK if time-out
1804
 
1805
        LD      A,$C6           ; two edges must be spaced apart.
1806
        CP      B               ; compare
1807
        JR      NC,L056C        ; back to LD-START if too close together for a
1808
                                ; lead-in.
1809
 
1810
        INC     H               ; proceed to test 256 edged sample.
1811
        JR      NZ,L0580        ; back to LD-LEADER while more to do.
1812
 
1813
;   sample indicates we are in the middle of a two or five second lead-in.
1814
;   Now test every edge looking for the terminal sync signal.
1815
 
1816
;; LD-SYNC
1817
L058F:  LD      B,$C9           ; initial timing value in B.
1818
        CALL    L05E7           ; routine LD-EDGE-1
1819
        JR      NC,L056B        ; back to LD-BREAK with time-out.
1820
 
1821
        LD      A,B             ; fetch augmented timing value from B.
1822
        CP      $D4             ; compare
1823
        JR      NC,L058F        ; back to LD-SYNC if gap too big, that is,
1824
                                ; a normal lead-in edge gap.
1825
 
1826
;   but a short gap will be the sync pulse.
1827
;   in which case another edge should appear before B rises to $FF
1828
 
1829
        CALL    L05E7           ; routine LD-EDGE-1
1830
        RET     NC              ; return with time-out.
1831
 
1832
; proceed when the sync at the end of the lead-in is found.
1833
; We are about to load data so change the border colours.
1834
 
1835
        LD      A,C             ; fetch long-term mask from C
1836
        XOR     $03             ; and make blue/yellow.
1837
 
1838
        LD      C,A             ; store the new long-term byte.
1839
 
1840
        LD      H,$00           ; set up parity byte as zero.
1841
        LD      B,$B0           ; timing.
1842
        JR      L05C8           ; forward to LD-MARKER
1843
                                ; the loop mid entry point with the alternate
1844
                                ; zero flag reset to indicate first byte
1845
                                ; is discarded.
1846
 
1847
; --------------
1848
;   the loading loop loads each byte and is entered at the mid point.
1849
 
1850
;; LD-LOOP
1851
L05A9:  EX      AF,AF'          ; restore entry flags and type in A.
1852
        JR      NZ,L05B3        ; forward to LD-FLAG if awaiting initial flag
1853
                                ; which is to be discarded.
1854
 
1855
        JR      NC,L05BD        ; forward to LD-VERIFY if not to be loaded.
1856
 
1857
        LD      (IX+$00),L      ; place loaded byte at memory location.
1858
        JR      L05C2           ; forward to LD-NEXT
1859
 
1860
; ---
1861
 
1862
;; LD-FLAG
1863
L05B3:  RL      C               ; preserve carry (verify) flag in long-term
1864
                                ; state byte. Bit 7 can be lost.
1865
 
1866
        XOR     L               ; compare type in A with first byte in L.
1867
        RET     NZ              ; return if no match e.g. CODE vs. DATA.
1868
 
1869
;   continue when data type matches.
1870
 
1871
        LD      A,C             ; fetch byte with stored carry
1872
        RRA                     ; rotate it to carry flag again
1873
        LD      C,A             ; restore long-term port state.
1874
 
1875
        INC     DE              ; increment length ??
1876
        JR      L05C4           ; forward to LD-DEC.
1877
                                ; but why not to location after ?
1878
 
1879
; ---
1880
;   for verification the byte read from tape is compared with that in memory.
1881
 
1882
;; LD-VERIFY
1883
L05BD:  LD      A,(IX+$00)      ; fetch byte from memory.
1884
        XOR     L               ; compare with that on tape
1885
        RET     NZ              ; return if not zero.
1886
 
1887
;; LD-NEXT
1888
L05C2:  INC     IX              ; increment byte pointer.
1889
 
1890
;; LD-DEC
1891
L05C4:  DEC     DE              ; decrement length.
1892
        EX      AF,AF'          ; store the flags.
1893
        LD      B,$B2           ; timing.
1894
 
1895
;   when starting to read 8 bits the receiving byte is marked with bit at right.
1896
;   when this is rotated out again then 8 bits have been read.
1897
 
1898
;; LD-MARKER
1899
L05C8:  LD      L,$01           ; initialize as %00000001
1900
 
1901
;; LD-8-BITS
1902
L05CA:  CALL    L05E3           ; routine LD-EDGE-2 increments B relative to
1903
                                ; gap between 2 edges.
1904
        RET     NC              ; return with time-out.
1905
 
1906
        LD      A,$CB           ; the comparison byte.
1907
        CP      B               ; compare to incremented value of B.
1908
                                ; if B is higher then bit on tape was set.
1909
                                ; if <= then bit on tape is reset.
1910
 
1911
        RL      L               ; rotate the carry bit into L.
1912
 
1913
        LD      B,$B0           ; reset the B timer byte.
1914
        JP      NC,L05CA        ; JUMP back to LD-8-BITS
1915
 
1916
;   when carry set then marker bit has been passed out and byte is complete.
1917
 
1918
        LD      A,H             ; fetch the running parity byte.
1919
        XOR     L               ; include the new byte.
1920
        LD      H,A             ; and store back in parity register.
1921
 
1922
        LD      A,D             ; check length of
1923
        OR      E               ; expected bytes.
1924
        JR      NZ,L05A9        ; back to LD-LOOP
1925
                                ; while there are more.
1926
 
1927
;   when all bytes loaded then parity byte should be zero.
1928
 
1929
        LD      A,H             ; fetch parity byte.
1930
        CP      $01             ; set carry if zero.
1931
        RET                     ; return
1932
                                ; in no carry then error as checksum disagrees.
1933
 
1934
; -------------------------
1935
; Check signal being loaded
1936
; -------------------------
1937
;   An edge is a transition from one mic state to another.
1938
;   More specifically a change in bit 6 of value input from port $FE.
1939
;   Graphically it is a change of border colour, say, blue to yellow.
1940
;   The first entry point looks for two adjacent edges. The second entry point
1941
;   is used to find a single edge.
1942
;   The B register holds a count, up to 256, within which the edge (or edges)
1943
;   must be found. The gap between two edges will be more for a '1' than a '0'
1944
;   so the value of B denotes the state of the bit (two edges) read from tape.
1945
 
1946
; ->
1947
 
1948
;; LD-EDGE-2
1949
L05E3:  CALL    L05E7           ; call routine LD-EDGE-1 below.
1950
        RET     NC              ; return if space pressed or time-out.
1951
                                ; else continue and look for another adjacent
1952
                                ; edge which together represent a bit on the
1953
                                ; tape.
1954
 
1955
; ->
1956
;   this entry point is used to find a single edge from above but also
1957
;   when detecting a read-in signal on the tape.
1958
 
1959
;; LD-EDGE-1
1960
L05E7:  LD      A,$16           ; a delay value of twenty two.
1961
 
1962
;; LD-DELAY
1963
L05E9:  DEC     A               ; decrement counter
1964
        JR      NZ,L05E9        ; loop back to LD-DELAY 22 times.
1965
 
1966
        AND      A              ; clear carry.
1967
 
1968
;; LD-SAMPLE
1969
L05ED:  INC     B               ; increment the time-out counter.
1970
        RET     Z               ; return with failure when $FF passed.
1971
 
1972
        LD      A,$7F           ; prepare to read keyboard and EAR port
1973
        IN      A,($FE)         ; row $7FFE. bit 6 is EAR, bit 0 is SPACE key.
1974
        RRA                     ; test outer key the space. (bit 6 moves to 5)
1975
        RET     NC              ; return if space pressed.  >>>
1976
 
1977
        XOR     C               ; compare with initial long-term state.
1978
        AND     $20             ; isolate bit 5
1979
        JR      Z,L05ED         ; back to LD-SAMPLE if no edge.
1980
 
1981
;   but an edge, a transition of the EAR bit, has been found so switch the
1982
;   long-term comparison byte containing both border colour and EAR bit.
1983
 
1984
        LD      A,C             ; fetch comparison value.
1985
        CPL                     ; switch the bits
1986
        LD      C,A             ; and put back in C for long-term.
1987
 
1988
        AND     $07             ; isolate new colour bits.
1989
        OR      $08             ; set bit 3 - MIC off.
1990
        OUT     ($FE),A         ; send to port to effect the change of colour.
1991
 
1992
        SCF                     ; set carry flag signaling edge found within
1993
                                ; time allowed.
1994
        RET                     ; return.
1995
 
1996
; ---------------------------------
1997
; Entry point for all tape commands
1998
; ---------------------------------
1999
;   This is the single entry point for the four tape commands.
2000
;   The routine first determines in what context it has been called by examining
2001
;   the low byte of the Syntax table entry which was stored in T_ADDR.
2002
;   Subtracting $EO (the present arrangement) gives a value of
2003
;   $00 - SAVE
2004
;   $01 - LOAD
2005
;   $02 - VERIFY
2006
;   $03 - MERGE
2007
;   As with all commands the address STMT-RET is on the stack.
2008
 
2009
;; SAVE-ETC
2010
L0605:  POP     AF              ; discard address STMT-RET.
2011
        LD      A,($5C74)       ; fetch T_ADDR
2012
 
2013
;   Now reduce the low byte of the Syntax table entry to give command.
2014
;   Note. For ZASM use SUB $E0 as next instruction.
2015
 
2016
L0609:  SUB     L1ADF + 1 % 256 ; subtract the known offset.
2017
                                ; ( is SUB $E0 in standard ROM )
2018
 
2019
        LD      ($5C74),A       ; and put back in T_ADDR as 0,1,2, or 3
2020
                                ; for future reference.
2021
 
2022
        CALL    L1C8C           ; routine EXPT-EXP checks that a string
2023
                                ; expression follows and stacks the
2024
                                ; parameters in run-time.
2025
 
2026
        CALL    L2530           ; routine SYNTAX-Z
2027
        JR      Z,L0652         ; forward to SA-DATA if checking syntax.
2028
 
2029
        LD      BC,$0011        ; presume seventeen bytes for a header.
2030
        LD      A,($5C74)       ; fetch command from T_ADDR.
2031
        AND     A               ; test for zero - SAVE.
2032
        JR      Z,L0621         ; forward to SA-SPACE if so.
2033
 
2034
        LD      C,$22           ; else double length to thirty four.
2035
 
2036
;; SA-SPACE
2037
L0621:  RST     30H             ; BC-SPACES creates 17/34 bytes in workspace.
2038
 
2039
        PUSH    DE              ; transfer the start of new space to
2040
        POP     IX              ; the available index register.
2041
 
2042
;   ten spaces are required for the default filename but it is simpler to
2043
;   overwrite the first file-type indicator byte as well.
2044
 
2045
        LD      B,$0B           ; set counter to eleven.
2046
        LD      A,$20           ; prepare a space.
2047
 
2048
;; SA-BLANK
2049
L0629:  LD      (DE),A          ; set workspace location to space.
2050
        INC     DE              ; next location.
2051
        DJNZ    L0629           ; loop back to SA-BLANK till all eleven done.
2052
 
2053
        LD      (IX+$01),$FF    ; set first byte of ten character filename
2054
                                ; to $FF as a default to signal null string.
2055
 
2056
        CALL    L2BF1           ; routine STK-FETCH fetches the filename
2057
                                ; parameters from the calculator stack.
2058
                                ; length of string in BC.
2059
                                ; start of string in DE.
2060
 
2061
        LD      HL,$FFF6        ; prepare the value minus ten.
2062
        DEC     BC              ; decrement length.
2063
                                ; ten becomes nine, zero becomes $FFFF.
2064
        ADD     HL,BC           ; trial addition.
2065
        INC     BC              ; restore true length.
2066
        JR      NC,L064B        ; forward to SA-NAME if length is one to ten.
2067
 
2068
;   the filename is more than ten characters in length or the null string.
2069
 
2070
        LD      A,($5C74)       ; fetch command from T_ADDR.
2071
        AND     A               ; test for zero - SAVE.
2072
        JR      NZ,L0644        ; forward to SA-NULL if not the SAVE command.
2073
 
2074
;   but no more than ten characters are allowed for SAVE.
2075
;   The first ten characters of any other command parameter are acceptable.
2076
;   Weird, but necessary, if saving to sectors.
2077
;   Note. the golden rule that there are no restriction on anything is broken.
2078
 
2079
;; REPORT-Fa
2080
L0642:  RST     08H             ; ERROR-1
2081
        DEFB    $0E             ; Error Report: Invalid file name
2082
 
2083
;   continue with LOAD, MERGE, VERIFY and also SAVE within ten character limit.
2084
 
2085
;; SA-NULL
2086
L0644:  LD      A,B             ; test length of filename
2087
        OR      C               ; for zero.
2088
        JR      Z,L0652         ; forward to SA-DATA if so using the 255
2089
                                ; indicator followed by spaces.
2090
 
2091
        LD      BC,$000A        ; else trim length to ten.
2092
 
2093
;   other paths rejoin here with BC holding length in range 1 - 10.
2094
 
2095
;; SA-NAME
2096
L064B:  PUSH    IX              ; push start of file descriptor.
2097
        POP     HL              ; and pop into HL.
2098
 
2099
        INC     HL              ; HL now addresses first byte of filename.
2100
        EX      DE,HL           ; transfer destination address to DE, start
2101
                                ; of string in command to HL.
2102
        LDIR                    ; copy up to ten bytes
2103
                                ; if less than ten then trailing spaces follow.
2104
 
2105
;   the case for the null string rejoins here.
2106
 
2107
;; SA-DATA
2108
L0652:  RST     18H             ; GET-CHAR
2109
        CP      $E4             ; is character after filename the token 'DATA' ?
2110
        JR      NZ,L06A0        ; forward to SA-SCR$ to consider SCREEN$ if
2111
                                ; not.
2112
 
2113
;   continue to consider DATA.
2114
 
2115
        LD      A,($5C74)       ; fetch command from T_ADDR
2116
        CP      $03             ; is it 'VERIFY' ?
2117
        JP      Z,L1C8A         ; jump forward to REPORT-C if so.
2118
                                ; 'Nonsense in BASIC'
2119
                                ; VERIFY "d" DATA is not allowed.
2120
 
2121
;   continue with SAVE, LOAD, MERGE of DATA.
2122
 
2123
        RST     20H             ; NEXT-CHAR
2124
        CALL    L28B2           ; routine LOOK-VARS searches variables area
2125
                                ; returning with carry reset if found or
2126
                                ; checking syntax.
2127
        SET     7,C             ; this converts a simple string to a
2128
                                ; string array. The test for an array or string
2129
                                ; comes later.
2130
        JR      NC,L0672        ; forward to SA-V-OLD if variable found.
2131
 
2132
        LD      HL,$0000        ; set destination to zero as not fixed.
2133
        LD      A,($5C74)       ; fetch command from T_ADDR
2134
        DEC     A               ; test for 1 - LOAD
2135
        JR      Z,L0685         ; forward to SA-V-NEW with LOAD DATA.
2136
                                ; to load a new array.
2137
 
2138
;   otherwise the variable was not found in run-time with SAVE/MERGE.
2139
 
2140
;; REPORT-2a
2141
L0670:  RST     08H             ; ERROR-1
2142
        DEFB    $01             ; Error Report: Variable not found
2143
 
2144
;   continue with SAVE/LOAD  DATA
2145
 
2146
;; SA-V-OLD
2147
L0672:  JP      NZ,L1C8A        ; to REPORT-C if not an array variable.
2148
                                ; or erroneously a simple string.
2149
                                ; 'Nonsense in BASIC'
2150
 
2151
 
2152
        CALL    L2530           ; routine SYNTAX-Z
2153
        JR      Z,L0692         ; forward to SA-DATA-1 if checking syntax.
2154
 
2155
        INC     HL              ; step past single character variable name.
2156
        LD      A,(HL)          ; fetch low byte of length.
2157
        LD      (IX+$0B),A      ; place in descriptor.
2158
        INC     HL              ; point to high byte.
2159
        LD      A,(HL)          ; and transfer that
2160
        LD      (IX+$0C),A      ; to descriptor.
2161
        INC     HL              ; increase pointer within variable.
2162
 
2163
;; SA-V-NEW
2164
L0685:  LD      (IX+$0E),C      ; place character array name in  header.
2165
        LD      A,$01           ; default to type numeric.
2166
        BIT     6,C             ; test result from look-vars.
2167
        JR      Z,L068F         ; forward to SA-V-TYPE if numeric.
2168
 
2169
        INC     A               ; set type to 2 - string array.
2170
 
2171
;; SA-V-TYPE
2172
L068F:  LD      (IX+$00),A      ; place type 0, 1 or 2 in descriptor.
2173
 
2174
;; SA-DATA-1
2175
L0692:  EX      DE,HL           ; save var pointer in DE
2176
 
2177
        RST     20H             ; NEXT-CHAR
2178
        CP      $29             ; is character ')' ?
2179
        JR      NZ,L0672        ; back if not to SA-V-OLD to report
2180
                                ; 'Nonsense in BASIC'
2181
 
2182
        RST     20H             ; NEXT-CHAR advances character address.
2183
        CALL    L1BEE           ; routine CHECK-END errors if not end of
2184
                                ; the statement.
2185
 
2186
        EX      DE,HL           ; bring back variables data pointer.
2187
        JP      L075A           ; jump forward to SA-ALL
2188
 
2189
; ---
2190
;   the branch was here to consider a 'SCREEN$', the display file.
2191
 
2192
;; SA-SCR$
2193
L06A0:  CP      $AA             ; is character the token 'SCREEN$' ?
2194
        JR      NZ,L06C3        ; forward to SA-CODE if not.
2195
 
2196
        LD      A,($5C74)       ; fetch command from T_ADDR
2197
        CP      $03             ; is it MERGE ?
2198
        JP       Z,L1C8A        ; jump to REPORT-C if so.
2199
                                ; 'Nonsense in BASIC'
2200
 
2201
;   continue with SAVE/LOAD/VERIFY SCREEN$.
2202
 
2203
        RST     20H             ; NEXT-CHAR
2204
        CALL    L1BEE           ; routine CHECK-END errors if not at end of
2205
                                ; statement.
2206
 
2207
;   continue in runtime.
2208
 
2209
        LD      (IX+$0B),$00    ; set descriptor length
2210
        LD      (IX+$0C),$1B    ; to $1b00 to include bitmaps and attributes.
2211
 
2212
        LD      HL,$4000        ; set start to display file start.
2213
        LD      (IX+$0D),L      ; place start in
2214
        LD      (IX+$0E),H      ; the descriptor.
2215
        JR      L0710           ; forward to SA-TYPE-3
2216
 
2217
; ---
2218
;   the branch was here to consider CODE.
2219
 
2220
;; SA-CODE
2221
L06C3:  CP      $AF             ; is character the token 'CODE' ?
2222
        JR      NZ,L0716        ; forward if not to SA-LINE to consider an
2223
                                ; auto-started BASIC program.
2224
 
2225
        LD      A,($5C74)       ; fetch command from T_ADDR
2226
        CP      $03             ; is it MERGE ?
2227
        JP      Z,L1C8A         ; jump forward to REPORT-C if so.
2228
                                ; 'Nonsense in BASIC'
2229
 
2230
 
2231
        RST     20H             ; NEXT-CHAR advances character address.
2232
        CALL    L2048           ; routine PR-ST-END checks if a carriage
2233
                                ; return or ':' follows.
2234
        JR      NZ,L06E1        ; forward to SA-CODE-1 if there are parameters.
2235
 
2236
        LD      A,($5C74)       ; else fetch the command from T_ADDR.
2237
        AND     A               ; test for zero - SAVE without a specification.
2238
        JP      Z,L1C8A         ; jump to REPORT-C if so.
2239
                                ; 'Nonsense in BASIC'
2240
 
2241
;   for LOAD/VERIFY put zero on stack to signify handle at location saved from.
2242
 
2243
        CALL    L1CE6           ; routine USE-ZERO
2244
        JR      L06F0           ; forward to SA-CODE-2
2245
 
2246
; ---
2247
 
2248
;   if there are more characters after CODE expect start and possibly length.
2249
 
2250
;; SA-CODE-1
2251
L06E1:  CALL    L1C82           ; routine EXPT-1NUM checks for numeric
2252
                                ; expression and stacks it in run-time.
2253
 
2254
        RST     18H             ; GET-CHAR
2255
        CP      $2C             ; does a comma follow ?
2256
        JR      Z,L06F5         ; forward if so to SA-CODE-3
2257
 
2258
;   else allow saved code to be loaded to a specified address.
2259
 
2260
        LD      A,($5C74)       ; fetch command from T_ADDR.
2261
        AND     A               ; is the command SAVE which requires length ?
2262
        JP      Z,L1C8A         ; jump to REPORT-C if so.
2263
                                ; 'Nonsense in BASIC'
2264
 
2265
;   the command LOAD code may rejoin here with zero stacked as start.
2266
 
2267
;; SA-CODE-2
2268
L06F0:  CALL    L1CE6           ; routine USE-ZERO stacks zero for length.
2269
        JR      L06F9           ; forward to SA-CODE-4
2270
 
2271
; ---
2272
;   the branch was here with SAVE CODE start,
2273
 
2274
;; SA-CODE-3
2275
L06F5:  RST     20H             ; NEXT-CHAR advances character address.
2276
        CALL    L1C82           ; routine EXPT-1NUM checks for expression
2277
                                ; and stacks in run-time.
2278
 
2279
;   paths converge here and nothing must follow.
2280
 
2281
;; SA-CODE-4
2282
L06F9:  CALL    L1BEE           ; routine CHECK-END errors with extraneous
2283
                                ; characters and quits if checking syntax.
2284
 
2285
;   in run-time there are two 16-bit parameters on the calculator stack.
2286
 
2287
        CALL    L1E99           ; routine FIND-INT2 gets length.
2288
        LD      (IX+$0B),C      ; place length
2289
        LD      (IX+$0C),B      ; in descriptor.
2290
        CALL    L1E99           ; routine FIND-INT2 gets start.
2291
        LD      (IX+$0D),C      ; place start
2292
        LD      (IX+$0E),B      ; in descriptor.
2293
        LD      H,B             ; transfer the
2294
        LD      L,C             ; start to HL also.
2295
 
2296
;; SA-TYPE-3
2297
L0710:  LD      (IX+$00),$03    ; place type 3 - code in descriptor.
2298
        JR      L075A           ; forward to SA-ALL.
2299
 
2300
; ---
2301
;   the branch was here with BASIC to consider an optional auto-start line
2302
;   number.
2303
 
2304
;; SA-LINE
2305
L0716:  CP      $CA             ; is character the token 'LINE' ?
2306
        JR      Z,L0723         ; forward to SA-LINE-1 if so.
2307
 
2308
;   else all possibilities have been considered and nothing must follow.
2309
 
2310
        CALL    L1BEE           ; routine CHECK-END
2311
 
2312
;   continue in run-time to save BASIC without auto-start.
2313
 
2314
        LD      (IX+$0E),$80    ; place high line number in descriptor to
2315
                                ; disable auto-start.
2316
        JR      L073A           ; forward to SA-TYPE-0 to save program.
2317
 
2318
; ---
2319
;   the branch was here to consider auto-start.
2320
 
2321
;; SA-LINE-1
2322
L0723:  LD      A,($5C74)       ; fetch command from T_ADDR
2323
        AND     A               ; test for SAVE.
2324
        JP      NZ,L1C8A        ; jump forward to REPORT-C with anything else.
2325
                                ; 'Nonsense in BASIC'
2326
 
2327
;
2328
 
2329
        RST     20H             ; NEXT-CHAR
2330
        CALL    L1C82           ; routine EXPT-1NUM checks for numeric
2331
                                ; expression and stacks in run-time.
2332
        CALL    L1BEE           ; routine CHECK-END quits if syntax path.
2333
        CALL    L1E99           ; routine FIND-INT2 fetches the numeric
2334
                                ; expression.
2335
        LD      (IX+$0D),C      ; place the auto-start
2336
        LD      (IX+$0E),B      ; line number in the descriptor.
2337
 
2338
;   Note. this isn't checked, but is subsequently handled by the system.
2339
;   If the user typed 40000 instead of 4000 then it won't auto-start
2340
;   at line 4000, or indeed, at all.
2341
 
2342
;   continue to save program and any variables.
2343
 
2344
;; SA-TYPE-0
2345
L073A:  LD      (IX+$00),$00    ; place type zero - program in descriptor.
2346
        LD      HL,($5C59)      ; fetch E_LINE to HL.
2347
        LD      DE,($5C53)      ; fetch PROG to DE.
2348
        SCF                     ; set carry flag to calculate from end of
2349
                                ; variables E_LINE -1.
2350
        SBC     HL,DE           ; subtract to give total length.
2351
 
2352
        LD      (IX+$0B),L      ; place total length
2353
        LD      (IX+$0C),H      ; in descriptor.
2354
        LD      HL,($5C4B)      ; load HL from system variable VARS
2355
        SBC     HL,DE           ; subtract to give program length.
2356
        LD      (IX+$0F),L      ; place length of program
2357
        LD      (IX+$10),H      ; in the descriptor.
2358
        EX      DE,HL           ; start to HL, length to DE.
2359
 
2360
;; SA-ALL
2361
L075A:  LD      A,($5C74)       ; fetch command from T_ADDR
2362
        AND     A               ; test for zero - SAVE.
2363
        JP      Z,L0970         ; jump forward to SA-CONTRL with SAVE  ->
2364
 
2365
; ---
2366
;   continue with LOAD, MERGE and VERIFY.
2367
 
2368
        PUSH    HL              ; save start.
2369
        LD      BC,$0011        ; prepare to add seventeen
2370
        ADD     IX,BC           ; to point IX at second descriptor.
2371
 
2372
;; LD-LOOK-H
2373
L0767:  PUSH    IX              ; save IX
2374
        LD      DE,$0011        ; seventeen bytes
2375
        XOR     A               ; reset zero flag
2376
        SCF                     ; set carry flag
2377
        CALL    L0556           ; routine LD-BYTES loads a header from tape
2378
                                ; to second descriptor.
2379
        POP     IX              ; restore IX.
2380
        JR      NC,L0767        ; loop back to LD-LOOK-H until header found.
2381
 
2382
        LD      A,$FE           ; select system channel 'S'
2383
        CALL    L1601           ; routine CHAN-OPEN opens it.
2384
 
2385
        LD      (IY+$52),$03    ; set SCR_CT to 3 lines.
2386
 
2387
        LD      C,$80           ; C has bit 7 set to indicate type mismatch as
2388
                                ; a default startpoint.
2389
 
2390
        LD      A,(IX+$00)      ; fetch loaded header type to A
2391
        CP      (IX-$11)        ; compare with expected type.
2392
        JR      NZ,L078A        ; forward to LD-TYPE with mis-match.
2393
 
2394
        LD      C,$F6           ; set C to minus ten - will count characters
2395
                                ; up to zero.
2396
 
2397
;; LD-TYPE
2398
L078A:  CP      $04             ; check if type in acceptable range 0 - 3.
2399
        JR      NC,L0767        ; back to LD-LOOK-H with 4 and over.
2400
 
2401
;   else A indicates type 0-3.
2402
 
2403
        LD      DE,L09C0        ; address base of last 4 tape messages
2404
        PUSH    BC              ; save BC
2405
        CALL    L0C0A           ; routine PO-MSG outputs relevant message.
2406
                                ; Note. all messages have a leading newline.
2407
        POP     BC              ; restore BC
2408
 
2409
        PUSH    IX              ; transfer IX,
2410
        POP     DE              ; the 2nd descriptor, to DE.
2411
        LD      HL,$FFF0        ; prepare minus seventeen.
2412
        ADD     HL,DE           ; add to point HL to 1st descriptor.
2413
        LD      B,$0A           ; the count will be ten characters for the
2414
                                ; filename.
2415
 
2416
        LD      A,(HL)          ; fetch first character and test for
2417
        INC     A               ; value 255.
2418
        JR      NZ,L07A6        ; forward to LD-NAME if not the wildcard.
2419
 
2420
;   but if it is the wildcard, then add ten to C which is minus ten for a type
2421
;   match or -128 for a type mismatch. Although characters have to be counted
2422
;   bit 7 of C will not alter from state set here.
2423
 
2424
        LD      A,C             ; transfer $F6 or $80 to A
2425
        ADD     A,B             ; add $0A
2426
        LD      C,A             ; place result, zero or -118, in C.
2427
 
2428
;   At this point we have either a type mismatch, a wildcard match or ten
2429
;   characters to be counted. The characters must be shown on the screen.
2430
 
2431
;; LD-NAME
2432
L07A6:  INC     DE              ; address next input character
2433
        LD      A,(DE)          ; fetch character
2434
        CP      (HL)            ; compare to expected
2435
        INC     HL              ; address next expected character
2436
        JR      NZ,L07AD        ; forward to LD-CH-PR with mismatch
2437
 
2438
        INC     C               ; increment matched character count
2439
 
2440
;; LD-CH-PR
2441
L07AD:  RST     10H             ; PRINT-A prints character
2442
        DJNZ    L07A6           ; loop back to LD-NAME for ten characters.
2443
 
2444
;   if ten characters matched and the types previously matched then C will
2445
;   now hold zero.
2446
 
2447
        BIT     7,C             ; test if all matched
2448
        JR      NZ,L0767        ; back to LD-LOOK-H if not
2449
 
2450
;   else print a terminal carriage return.
2451
 
2452
        LD      A,$0D           ; prepare carriage return.
2453
        RST     10H             ; PRINT-A outputs it.
2454
 
2455
;   The various control routines for LOAD, VERIFY and MERGE are executed
2456
;   during the one-second gap following the header on tape.
2457
 
2458
        POP     HL              ; restore xx
2459
        LD      A,(IX+$00)      ; fetch incoming type
2460
        CP      $03             ; compare with CODE
2461
        JR      Z,L07CB         ; forward to VR-CONTRL if it is CODE.
2462
 
2463
;  type is a program or an array.
2464
 
2465
        LD      A,($5C74)       ; fetch command from T_ADDR
2466
        DEC     A               ; was it LOAD ?
2467
        JP      Z,L0808         ; JUMP forward to LD-CONTRL if so to
2468
                                ; load BASIC or variables.
2469
 
2470
        CP      $02             ; was command MERGE ?
2471
        JP      Z,L08B6         ; jump forward to ME-CONTRL if so.
2472
 
2473
;   else continue into VERIFY control routine to verify.
2474
 
2475
; ----------------------------
2476
; THE 'VERIFY CONTROL' ROUTINE
2477
; ----------------------------
2478
;   There are two branches to this routine.
2479
;   1) From above to verify a program or array
2480
;   2) from earlier with no carry to load or verify code.
2481
 
2482
;; VR-CONTRL
2483
L07CB:  PUSH    HL              ; save pointer to data.
2484
        LD      L,(IX-$06)      ; fetch length of old data
2485
        LD      H,(IX-$05)      ; to HL.
2486
        LD      E,(IX+$0B)      ; fetch length of new data
2487
        LD      D,(IX+$0C)      ; to DE.
2488
        LD      A,H             ; check length of old
2489
        OR      L               ; for zero.
2490
        JR      Z,L07E9         ; forward to VR-CONT-1 if length unspecified
2491
                                ; e.g. LOAD "x" CODE
2492
 
2493
;   as opposed to, say, LOAD 'x' CODE 32768,300.
2494
 
2495
        SBC     HL,DE           ; subtract the two lengths.
2496
        JR      C,L0806         ; forward to REPORT-R if the length on tape is
2497
                                ; larger than that specified in command.
2498
                                ; 'Tape loading error'
2499
 
2500
        JR      Z,L07E9         ; forward to VR-CONT-1 if lengths match.
2501
 
2502
;   a length on tape shorter than expected is not allowed for CODE
2503
 
2504
        LD      A,(IX+$00)      ; else fetch type from tape.
2505
        CP      $03             ; is it CODE ?
2506
        JR      NZ,L0806        ; forward to REPORT-R if so
2507
                                ; 'Tape loading error'
2508
 
2509
;; VR-CONT-1
2510
L07E9:  POP     HL              ; pop pointer to data
2511
        LD      A,H             ; test for zero
2512
        OR      L               ; e.g. LOAD 'x' CODE
2513
        JR      NZ,L07F4        ; forward to VR-CONT-2 if destination specified.
2514
 
2515
        LD      L,(IX+$0D)      ; else use the destination in the header
2516
        LD      H,(IX+$0E)      ; and load code at address saved from.
2517
 
2518
;; VR-CONT-2
2519
L07F4:  PUSH    HL              ; push pointer to start of data block.
2520
        POP     IX              ; transfer to IX.
2521
        LD      A,($5C74)       ; fetch reduced command from T_ADDR
2522
        CP      $02             ; is it VERIFY ?
2523
        SCF                     ; prepare a set carry flag
2524
        JR      NZ,L0800        ; skip to VR-CONT-3 if not
2525
 
2526
        AND     A               ; clear carry flag for VERIFY so that
2527
                                ; data is not loaded.
2528
 
2529
;; VR-CONT-3
2530
L0800:  LD      A,$FF           ; signal data block to be loaded
2531
 
2532
; -----------------
2533
; Load a data block
2534
; -----------------
2535
;   This routine is called from 3 places other than above to load a data block.
2536
;   In all cases the accumulator is first set to $FF so the routine could be
2537
;   called at the previous instruction.
2538
 
2539
;; LD-BLOCK
2540
L0802:  CALL    L0556           ; routine LD-BYTES
2541
        RET     C               ; return if successful.
2542
 
2543
 
2544
;; REPORT-R
2545
L0806:  RST     08H             ; ERROR-1
2546
        DEFB    $1A             ; Error Report: Tape loading error
2547
 
2548
; --------------------------
2549
; THE 'LOAD CONTROL' ROUTINE
2550
; --------------------------
2551
;   This branch is taken when the command is LOAD with type 0, 1 or 2.
2552
 
2553
;; LD-CONTRL
2554
L0808:  LD      E,(IX+$0B)      ; fetch length of found data block
2555
        LD      D,(IX+$0C)      ; from 2nd descriptor.
2556
        PUSH    HL              ; save destination
2557
        LD      A,H             ; test for zero
2558
        OR      L               ;
2559
        JR      NZ,L0819        ; forward if not to LD-CONT-1
2560
 
2561
        INC     DE              ; increase length
2562
        INC     DE              ; for letter name
2563
        INC     DE              ; and 16-bit length
2564
        EX      DE,HL           ; length to HL,
2565
        JR      L0825           ; forward to LD-CONT-2
2566
 
2567
; ---
2568
 
2569
;; LD-CONT-1
2570
L0819:  LD      L,(IX-$06)      ; fetch length from
2571
        LD      H,(IX-$05)      ; the first header.
2572
        EX      DE,HL           ;
2573
        SCF                     ; set carry flag
2574
        SBC     HL,DE           ;
2575
        JR      C,L082E         ; to LD-DATA
2576
 
2577
;; LD-CONT-2
2578
L0825:  LD      DE,$0005        ; allow overhead of five bytes.
2579
        ADD     HL,DE           ; add in the difference in data lengths.
2580
        LD      B,H             ; transfer to
2581
        LD      C,L             ; the BC register pair
2582
        CALL    L1F05           ; routine TEST-ROOM fails if not enough room.
2583
 
2584
;; LD-DATA
2585
L082E:  POP     HL              ; pop destination
2586
        LD      A,(IX+$00)      ; fetch type 0, 1 or 2.
2587
        AND     A               ; test for program and variables.
2588
        JR      Z,L0873         ; forward if so to LD-PROG
2589
 
2590
;   the type is a numeric or string array.
2591
 
2592
        LD      A,H             ; test the destination for zero
2593
        OR      L               ; indicating variable does not already exist.
2594
        JR      Z,L084C         ; forward if so to LD-DATA-1
2595
 
2596
;   else the destination is the first dimension within the array structure
2597
 
2598
        DEC     HL              ; address high byte of total length
2599
        LD      B,(HL)          ; transfer to B.
2600
        DEC     HL              ; address low byte of total length.
2601
        LD      C,(HL)          ; transfer to C.
2602
        DEC     HL              ; point to letter of variable.
2603
        INC     BC              ; adjust length to
2604
        INC     BC              ; include these
2605
        INC     BC              ; three bytes also.
2606
        LD      ($5C5F),IX      ; save header pointer in X_PTR.
2607
        CALL    L19E8           ; routine RECLAIM-2 reclaims the old variable
2608
                                ; sliding workspace including the two headers
2609
                                ; downwards.
2610
        LD      IX,($5C5F)      ; reload IX from X_PTR which will have been
2611
                                ; adjusted down by POINTERS routine.
2612
 
2613
;; LD-DATA-1
2614
L084C:  LD      HL,($5C59)      ; address E_LINE
2615
        DEC     HL              ; now point to the $80 variables end-marker.
2616
        LD      C,(IX+$0B)      ; fetch new data length
2617
        LD      B,(IX+$0C)      ; from 2nd header.
2618
        PUSH    BC              ; * save it.
2619
        INC     BC              ; adjust the
2620
        INC     BC              ; length to include
2621
        INC     BC              ; letter name and total length.
2622
        LD      A,(IX-$03)      ; fetch letter name from old header.
2623
        PUSH    AF              ; preserve accumulator though not corrupted.
2624
 
2625
        CALL    L1655           ; routine MAKE-ROOM creates space for variable
2626
                                ; sliding workspace up. IX no longer addresses
2627
                                ; anywhere meaningful.
2628
        INC     HL              ; point to first new location.
2629
 
2630
        POP     AF              ; fetch back the letter name.
2631
        LD      (HL),A          ; place in first new location.
2632
        POP     DE              ; * pop the data length.
2633
        INC     HL              ; address 2nd location
2634
        LD      (HL),E          ; store low byte of length.
2635
        INC     HL              ; address next.
2636
        LD      (HL),D          ; store high byte.
2637
        INC     HL              ; address start of data.
2638
        PUSH    HL              ; transfer address
2639
        POP     IX              ; to IX register pair.
2640
        SCF                     ; set carry flag indicating load not verify.
2641
        LD      A,$FF           ; signal data not header.
2642
        JP      L0802           ; JUMP back to LD-BLOCK
2643
 
2644
; -----------------
2645
;   the branch is here when a program as opposed to an array is to be loaded.
2646
 
2647
;; LD-PROG
2648
L0873:  EX      DE,HL           ; transfer dest to DE.
2649
        LD      HL,($5C59)      ; address E_LINE
2650
        DEC     HL              ; now variables end-marker.
2651
        LD      ($5C5F),IX      ; place the IX header pointer in X_PTR
2652
        LD      C,(IX+$0B)      ; get new length
2653
        LD      B,(IX+$0C)      ; from 2nd header
2654
        PUSH    BC              ; and save it.
2655
 
2656
        CALL    L19E5           ; routine RECLAIM-1 reclaims program and vars.
2657
                                ; adjusting X-PTR.
2658
 
2659
        POP     BC              ; restore new length.
2660
        PUSH    HL              ; * save start
2661
        PUSH    BC              ; ** and length.
2662
 
2663
        CALL    L1655           ; routine MAKE-ROOM creates the space.
2664
 
2665
        LD      IX,($5C5F)      ; reload IX from adjusted X_PTR
2666
        INC     HL              ; point to start of new area.
2667
        LD      C,(IX+$0F)      ; fetch length of BASIC on tape
2668
        LD      B,(IX+$10)      ; from 2nd descriptor
2669
        ADD     HL,BC           ; add to address the start of variables.
2670
        LD      ($5C4B),HL      ; set system variable VARS
2671
 
2672
        LD      H,(IX+$0E)      ; fetch high byte of autostart line number.
2673
        LD      A,H             ; transfer to A
2674
        AND     $C0             ; test if greater than $3F.
2675
        JR      NZ,L08AD        ; forward to LD-PROG-1 if so with no autostart.
2676
 
2677
        LD      L,(IX+$0D)      ; else fetch the low byte.
2678
        LD      ($5C42),HL      ; set system variable to line number NEWPPC
2679
        LD      (IY+$0A),$00    ; set statement NSPPC to zero.
2680
 
2681
;; LD-PROG-1
2682
L08AD:  POP     DE              ; ** pop the length
2683
        POP     IX              ; * and start.
2684
        SCF                     ; set carry flag
2685
        LD      A,$FF           ; signal data as opposed to a header.
2686
        JP      L0802           ; jump back to LD-BLOCK
2687
 
2688
; ---------------------------
2689
; THE 'MERGE CONTROL' ROUTINE
2690
; ---------------------------
2691
;   the branch was here to merge a program and its variables or an array.
2692
;
2693
 
2694
;; ME-CONTRL
2695
L08B6:  LD      C,(IX+$0B)      ; fetch length
2696
        LD      B,(IX+$0C)      ; of data block on tape.
2697
        PUSH    BC              ; save it.
2698
        INC     BC              ; one for the pot.
2699
 
2700
        RST     30H             ; BC-SPACES creates room in workspace.
2701
                                ; HL addresses last new location.
2702
        LD      (HL),$80        ; place end-marker at end.
2703
        EX      DE,HL           ; transfer first location to HL.
2704
        POP     DE              ; restore length to DE.
2705
        PUSH    HL              ; save start.
2706
 
2707
        PUSH    HL              ; and transfer it
2708
        POP     IX              ; to IX register.
2709
        SCF                     ; set carry flag to load data on tape.
2710
        LD      A,$FF           ; signal data not a header.
2711
        CALL    L0802           ; routine LD-BLOCK loads to workspace.
2712
        POP     HL              ; restore first location in workspace to HL.
2713
X08CE   LD      DE,($5C53)      ; set DE from system variable PROG.
2714
 
2715
;   now enter a loop to merge the data block in workspace with the program and
2716
;   variables.
2717
 
2718
;; ME-NEW-LP
2719
L08D2:  LD      A,(HL)          ; fetch next byte from workspace.
2720
        AND     $C0             ; compare with $3F.
2721
        JR      NZ,L08F0        ; forward to ME-VAR-LP if a variable or
2722
                                ; end-marker.
2723
 
2724
;   continue when HL addresses a BASIC line number.
2725
 
2726
;; ME-OLD-LP
2727
L08D7:  LD      A,(DE)          ; fetch high byte from program area.
2728
        INC     DE              ; bump prog address.
2729
        CP      (HL)            ; compare with that in workspace.
2730
        INC     HL              ; bump workspace address.
2731
        JR      NZ,L08DF        ; forward to ME-OLD-L1 if high bytes don't match
2732
 
2733
        LD      A,(DE)          ; fetch the low byte of program line number.
2734
        CP      (HL)            ; compare with that in workspace.
2735
 
2736
;; ME-OLD-L1
2737
L08DF:  DEC     DE              ; point to start of
2738
        DEC     HL              ; respective lines again.
2739
        JR      NC,L08EB        ; forward to ME-NEW-L2 if line number in
2740
                                ; workspace is less than or equal to current
2741
                                ; program line as has to be added to program.
2742
 
2743
        PUSH    HL              ; else save workspace pointer.
2744
        EX      DE,HL           ; transfer prog pointer to HL
2745
        CALL    L19B8           ; routine NEXT-ONE finds next line in DE.
2746
        POP     HL              ; restore workspace pointer
2747
        JR      L08D7           ; back to ME-OLD-LP until destination position
2748
                                ; in program area found.
2749
 
2750
; ---
2751
;   the branch was here with an insertion or replacement point.
2752
 
2753
;; ME-NEW-L2
2754
L08EB:  CALL    L092C           ; routine ME-ENTER enters the line
2755
        JR      L08D2           ; loop back to ME-NEW-LP.
2756
 
2757
; ---
2758
;   the branch was here when the location in workspace held a variable.
2759
 
2760
;; ME-VAR-LP
2761
L08F0:  LD      A,(HL)          ; fetch first byte of workspace variable.
2762
        LD      C,A             ; copy to C also.
2763
        CP      $80             ; is it the end-marker ?
2764
        RET     Z               ; return if so as complete.  >>>>>
2765
 
2766
        PUSH    HL              ; save workspace area pointer.
2767
        LD      HL,($5C4B)      ; load HL with VARS - start of variables area.
2768
 
2769
;; ME-OLD-VP
2770
L08F9:  LD      A,(HL)          ; fetch first byte.
2771
        CP      $80             ; is it the end-marker ?
2772
        JR      Z,L0923         ; forward if so to ME-VAR-L2 to add
2773
                                ; variable at end of variables area.
2774
 
2775
        CP      C               ; compare with variable in workspace area.
2776
        JR      Z,L0909         ; forward to ME-OLD-V2 if a match to replace.
2777
 
2778
;   else entire variables area has to be searched.
2779
 
2780
;; ME-OLD-V1
2781
L0901:  PUSH    BC              ; save character in C.
2782
        CALL    L19B8           ; routine NEXT-ONE gets following variable
2783
                                ; address in DE.
2784
        POP     BC              ; restore character in C
2785
        EX      DE,HL           ; transfer next address to HL.
2786
        JR      L08F9           ; loop back to ME-OLD-VP
2787
 
2788
; ---
2789
;   the branch was here when first characters of name matched.
2790
 
2791
;; ME-OLD-V2
2792
L0909:  AND     $E0             ; keep bits 11100000
2793
        CP      $A0             ; compare   10100000 - a long-named variable.
2794
 
2795
        JR      NZ,L0921        ; forward to ME-VAR-L1 if just one-character.
2796
 
2797
;   but long-named variables have to be matched character by character.
2798
 
2799
        POP     DE              ; fetch workspace 1st character pointer
2800
        PUSH    DE              ; and save it on the stack again.
2801
        PUSH    HL              ; save variables area pointer on stack.
2802
 
2803
;; ME-OLD-V3
2804
L0912:  INC     HL              ; address next character in vars area.
2805
        INC     DE              ; address next character in workspace area.
2806
        LD      A,(DE)          ; fetch workspace character.
2807
        CP      (HL)            ; compare to variables character.
2808
        JR      NZ,L091E        ; forward to ME-OLD-V4 with a mismatch.
2809
 
2810
        RLA                     ; test if the terminal inverted character.
2811
        JR      NC,L0912        ; loop back to ME-OLD-V3 if more to test.
2812
 
2813
;   otherwise the long name matches in its entirety.
2814
 
2815
        POP     HL              ; restore pointer to first character of variable
2816
        JR      L0921           ; forward to ME-VAR-L1
2817
 
2818
; ---
2819
;   the branch is here when two characters don't match
2820
 
2821
;; ME-OLD-V4
2822
L091E:  POP     HL              ; restore the prog/vars pointer.
2823
        JR      L0901           ; back to ME-OLD-V1 to resume search.
2824
 
2825
; ---
2826
;   branch here when variable is to replace an existing one
2827
 
2828
;; ME-VAR-L1
2829
L0921:  LD      A,$FF           ; indicate a replacement.
2830
 
2831
;   this entry point is when A holds $80 indicating a new variable.
2832
 
2833
;; ME-VAR-L2
2834
L0923:  POP     DE              ; pop workspace pointer.
2835
        EX      DE,HL           ; now make HL workspace pointer, DE vars pointer
2836
        INC     A               ; zero flag set if replacement.
2837
        SCF                     ; set carry flag indicating a variable not a
2838
                                ; program line.
2839
        CALL    L092C           ; routine ME-ENTER copies variable in.
2840
        JR      L08F0           ; loop back to ME-VAR-LP
2841
 
2842
; ------------------------
2843
; Merge a Line or Variable
2844
; ------------------------
2845
;   A BASIC line or variable is inserted at the current point. If the line
2846
;   number or variable names match (zero flag set) then a replacement takes
2847
;   place.
2848
 
2849
;; ME-ENTER
2850
L092C:  JR      NZ,L093E        ; forward to ME-ENT-1 for insertion only.
2851
 
2852
;   but the program line or variable matches so old one is reclaimed.
2853
 
2854
        EX      AF,AF'          ; save flag??
2855
        LD      ($5C5F),HL      ; preserve workspace pointer in dynamic X_PTR
2856
        EX      DE,HL           ; transfer program dest pointer to HL.
2857
        CALL    L19B8           ; routine NEXT-ONE finds following location
2858
                                ; in program or variables area.
2859
        CALL    L19E8           ; routine RECLAIM-2 reclaims the space between.
2860
        EX      DE,HL           ; transfer program dest pointer back to DE.
2861
        LD      HL,($5C5F)      ; fetch adjusted workspace pointer from X_PTR
2862
        EX      AF,AF'          ; restore flags.
2863
 
2864
;   now the new line or variable is entered.
2865
 
2866
;; ME-ENT-1
2867
L093E:  EX      AF,AF'          ; save or re-save flags.
2868
        PUSH    DE              ; save dest pointer in prog/vars area.
2869
        CALL    L19B8           ; routine NEXT-ONE finds next in workspace.
2870
                                ; gets next in DE, difference in BC.
2871
                                ; prev addr in HL
2872
        LD      ($5C5F),HL      ; store pointer in X_PTR
2873
        LD      HL,($5C53)      ; load HL from system variable PROG
2874
        EX      (SP),HL         ; swap with prog/vars pointer on stack.
2875
        PUSH    BC              ; ** save length of new program line/variable.
2876
        EX      AF,AF'          ; fetch flags back.
2877
        JR      C,L0955         ; skip to ME-ENT-2 if variable
2878
 
2879
        DEC     HL              ; address location before pointer
2880
        CALL    L1655           ; routine MAKE-ROOM creates room for BASIC line
2881
        INC     HL              ; address next.
2882
        JR      L0958           ; forward to ME-ENT-3
2883
 
2884
; ---
2885
 
2886
;; ME-ENT-2
2887
L0955:  CALL    L1655           ; routine MAKE-ROOM creates room for variable.
2888
 
2889
;; ME-ENT-3
2890
L0958:  INC     HL              ; address next?
2891
 
2892
        POP     BC              ; ** pop length
2893
        POP     DE              ; * pop value for PROG which may have been
2894
                                ; altered by POINTERS if first line.
2895
        LD      ($5C53),DE      ; set PROG to original value.
2896
        LD      DE,($5C5F)      ; fetch adjusted workspace pointer from X_PTR
2897
        PUSH    BC              ; save length
2898
        PUSH    DE              ; and workspace pointer
2899
        EX      DE,HL           ; make workspace pointer source, prog/vars
2900
                                ; pointer the destination
2901
        LDIR                    ; copy bytes of line or variable into new area.
2902
        POP     HL              ; restore workspace pointer.
2903
        POP     BC              ; restore length.
2904
        PUSH    DE              ; save new prog/vars pointer.
2905
        CALL    L19E8           ; routine RECLAIM-2 reclaims the space used
2906
                                ; by the line or variable in workspace block
2907
                                ; as no longer required and space could be
2908
                                ; useful for adding more lines.
2909
        POP     DE              ; restore the prog/vars pointer
2910
        RET                     ; return.
2911
 
2912
; --------------------------
2913
; THE 'SAVE CONTROL' ROUTINE
2914
; --------------------------
2915
;   A branch from the main SAVE-ETC routine at SAVE-ALL.
2916
;   First the header data is saved. Then after a wait of 1 second
2917
;   the data itself is saved.
2918
;   HL points to start of data.
2919
;   IX points to start of descriptor.
2920
 
2921
;; SA-CONTRL
2922
L0970:  PUSH    HL              ; save start of data
2923
 
2924
        LD      A,$FD           ; select system channel 'S'
2925
        CALL    L1601           ; routine CHAN-OPEN
2926
 
2927
        XOR     A               ; clear to address table directly
2928
        LD      DE,L09A1        ; address: tape-msgs
2929
        CALL    L0C0A           ; routine PO-MSG -
2930
                                ; 'Start tape then press any key.'
2931
 
2932
        SET     5,(IY+$02)      ; TV_FLAG  - Signal lower screen requires
2933
                                ; clearing
2934
        CALL    L15D4           ; routine WAIT-KEY
2935
 
2936
        PUSH    IX              ; save pointer to descriptor.
2937
        LD      DE,$0011        ; there are seventeen bytes.
2938
        XOR     A               ; signal a header.
2939
        CALL    L04C2           ; routine SA-BYTES
2940
 
2941
        POP     IX              ; restore descriptor pointer.
2942
 
2943
        LD      B,$32           ; wait for a second - 50 interrupts.
2944
 
2945
;; SA-1-SEC
2946
L0991:  HALT                    ; wait for interrupt
2947
        DJNZ    L0991           ; back to SA-1-SEC until pause complete.
2948
 
2949
        LD      E,(IX+$0B)      ; fetch length of bytes from the
2950
        LD      D,(IX+$0C)      ; descriptor.
2951
 
2952
        LD      A,$FF           ; signal data bytes.
2953
 
2954
        POP     IX              ; retrieve pointer to start
2955
        JP      L04C2           ; jump back to SA-BYTES
2956
 
2957
 
2958
;   Arrangement of two headers in workspace.
2959
;   Originally IX addresses first location and only one header is required
2960
;   when saving.
2961
;
2962
;   OLD     NEW         PROG   DATA  DATA  CODE
2963
;   HEADER  HEADER             num   chr          NOTES.
2964
;   ------  ------      ----   ----  ----  ----   -----------------------------
2965
;   IX-$11  IX+$00      0      1     2     3      Type.
2966
;   IX-$10  IX+$01      x      x     x     x      F  ($FF if filename is null).
2967
;   IX-$0F  IX+$02      x      x     x     x      i
2968
;   IX-$0E  IX+$03      x      x     x     x      l
2969
;   IX-$0D  IX+$04      x      x     x     x      e
2970
;   IX-$0C  IX+$05      x      x     x     x      n
2971
;   IX-$0B  IX+$06      x      x     x     x      a
2972
;   IX-$0A  IX+$07      x      x     x     x      m
2973
;   IX-$09  IX+$08      x      x     x     x      e
2974
;   IX-$08  IX+$09      x      x     x     x      .
2975
;   IX-$07  IX+$0A      x      x     x     x      (terminal spaces).
2976
;   IX-$06  IX+$0B      lo     lo    lo    lo     Total
2977
;   IX-$05  IX+$0C      hi     hi    hi    hi     Length of datablock.
2978
;   IX-$04  IX+$0D      Auto   -     -     Start  Various
2979
;   IX-$03  IX+$0E      Start  a-z   a-z   addr   ($80 if no autostart).
2980
;   IX-$02  IX+$0F      lo     -     -     -      Length of Program
2981
;   IX-$01  IX+$10      hi     -     -     -      only i.e. without variables.
2982
;
2983
 
2984
 
2985
; ------------------------
2986
; Canned cassette messages
2987
; ------------------------
2988
;   The last-character-inverted Cassette messages.
2989
;   Starts with normal initial step-over byte.
2990
 
2991
;; tape-msgs
2992
L09A1:  DEFB    $80
2993
        DEFM    "Start tape, then press any key"
2994
L09C0:  DEFB    '.'+$80
2995
        DEFB    $0D
2996
        DEFM    "Program:"
2997
        DEFB    ' '+$80
2998
        DEFB    $0D
2999
        DEFM    "Number array:"
3000
        DEFB    ' '+$80
3001
        DEFB    $0D
3002
        DEFM    "Character array:"
3003
        DEFB    ' '+$80
3004
        DEFB    $0D
3005
        DEFM    "Bytes:"
3006
        DEFB    ' '+$80
3007
 
3008
 
3009
;**************************************************
3010
;** Part 5. SCREEN AND PRINTER HANDLING ROUTINES **
3011
;**************************************************
3012
 
3013
; --------------------------
3014
; THE 'PRINT OUTPUT' ROUTINE
3015
; --------------------------
3016
;   This is the routine most often used by the RST 10 restart although the
3017
;   subroutine is on two occasions called directly when it is known that
3018
;   output will definitely be to the lower screen.
3019
 
3020
;; PRINT-OUT
3021
L09F4:  CALL    L0B03           ; routine PO-FETCH fetches print position
3022
                                ; to HL register pair.
3023
        CP      $20             ; is character a space or higher ?
3024
        JP      NC,L0AD9        ; jump forward to PO-ABLE if so.
3025
 
3026
        CP      $06             ; is character in range 00-05 ?
3027
        JR      C,L0A69         ; to PO-QUEST to print '?' if so.
3028
 
3029
        CP      $18             ; is character in range 24d - 31d ?
3030
        JR      NC,L0A69        ; to PO-QUEST to also print '?' if so.
3031
 
3032
        LD      HL,L0A11 - 6    ; address 0A0B - the base address of control
3033
                                ; character table - where zero would be.
3034
        LD      E,A             ; control character 06 - 23d
3035
        LD      D,$00           ; is transferred to DE.
3036
 
3037
        ADD     HL,DE           ; index into table.
3038
 
3039
        LD      E,(HL)          ; fetch the offset to routine.
3040
        ADD     HL,DE           ; add to make HL the address.
3041
        PUSH    HL              ; push the address.
3042
 
3043
        JP      L0B03           ; Jump forward to PO-FETCH,
3044
                                ; as the screen/printer position has been
3045
                                ; disturbed, and then indirectly to the PO-STORE
3046
                                ; routine on stack.
3047
 
3048
; -----------------------------
3049
; THE 'CONTROL CHARACTER' TABLE
3050
; -----------------------------
3051
;   For control characters in the range 6 - 23d the following table
3052
;   is indexed to provide an offset to the handling routine that
3053
;   follows the table.
3054
 
3055
;; ctlchrtab
3056
L0A11:  DEFB    L0A5F - $       ; 06d offset $4E to Address: PO-COMMA
3057
        DEFB    L0A69 - $       ; 07d offset $57 to Address: PO-QUEST
3058
        DEFB    L0A23 - $       ; 08d offset $10 to Address: PO-BACK-1
3059
        DEFB    L0A3D - $       ; 09d offset $29 to Address: PO-RIGHT
3060
        DEFB    L0A69 - $       ; 10d offset $54 to Address: PO-QUEST
3061
        DEFB    L0A69 - $       ; 11d offset $53 to Address: PO-QUEST
3062
        DEFB    L0A69 - $       ; 12d offset $52 to Address: PO-QUEST
3063
        DEFB    L0A4F - $       ; 13d offset $37 to Address: PO-ENTER
3064
        DEFB    L0A69 - $       ; 14d offset $50 to Address: PO-QUEST
3065
        DEFB    L0A69 - $       ; 15d offset $4F to Address: PO-QUEST
3066
        DEFB    L0A7A - $       ; 16d offset $5F to Address: PO-1-OPER
3067
        DEFB    L0A7A - $       ; 17d offset $5E to Address: PO-1-OPER
3068
        DEFB    L0A7A - $       ; 18d offset $5D to Address: PO-1-OPER
3069
        DEFB    L0A7A - $       ; 19d offset $5C to Address: PO-1-OPER
3070
        DEFB    L0A7A - $       ; 20d offset $5B to Address: PO-1-OPER
3071
        DEFB    L0A7A - $       ; 21d offset $5A to Address: PO-1-OPER
3072
        DEFB    L0A75 - $       ; 22d offset $54 to Address: PO-2-OPER
3073
        DEFB    L0A75 - $       ; 23d offset $53 to Address: PO-2-OPER
3074
 
3075
 
3076
; -------------------------
3077
; THE 'CURSOR LEFT' ROUTINE
3078
; -------------------------
3079
;   Backspace and up a line if that action is from the left of screen.
3080
;   For ZX printer backspace up to first column but not beyond.
3081
 
3082
;; PO-BACK-1
3083
L0A23:  INC     C               ; move left one column.
3084
        LD      A,$22           ; value $21 is leftmost column.
3085
        CP      C               ; have we passed ?
3086
        JR      NZ,L0A3A        ; to PO-BACK-3 if not and store new position.
3087
 
3088
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3089
        JR      NZ,L0A38        ; to PO-BACK-2 if so, as we are unable to
3090
                                ; backspace from the leftmost position.
3091
 
3092
 
3093
        INC     B               ; move up one screen line
3094
        LD      C,$02           ; the rightmost column position.
3095
        LD      A,$18           ; Note. This should be $19
3096
                                ; credit. Dr. Frank O'Hara, 1982
3097
 
3098
        CP      B               ; has position moved past top of screen ?
3099
        JR      NZ,L0A3A        ; to PO-BACK-3 if not and store new position.
3100
 
3101
        DEC     B               ; else back to $18.
3102
 
3103
;; PO-BACK-2
3104
L0A38:  LD      C,$21           ; the leftmost column position.
3105
 
3106
;; PO-BACK-3
3107
L0A3A:  JP      L0DD9           ; to CL-SET and PO-STORE to save new
3108
                                ; position in system variables.
3109
 
3110
; --------------------------
3111
; THE 'CURSOR RIGHT' ROUTINE
3112
; --------------------------
3113
;   This moves the print position to the right leaving a trail in the
3114
;   current background colour.
3115
;   "However the programmer has failed to store the new print position
3116
;   so CHR$ 9 will only work if the next print position is at a newly
3117
;   defined place.
3118
;   e.g. PRINT PAPER 2; CHR$ 9; AT 4,0;
3119
;   does work but is not very helpful"
3120
;   - Dr. Ian Logan, Understanding Your Spectrum, 1982.
3121
 
3122
;; PO-RIGHT
3123
L0A3D:  LD      A,($5C91)       ; fetch P_FLAG value
3124
        PUSH    AF              ; and save it on stack.
3125
 
3126
        LD      (IY+$57),$01    ; temporarily set P_FLAG 'OVER 1'.
3127
        LD      A,$20           ; prepare a space.
3128
        CALL    L0B65           ; routine PO-CHAR to print it.
3129
                                ; Note. could be PO-ABLE which would update
3130
                                ; the column position.
3131
 
3132
        POP     AF              ; restore the permanent flag.
3133
        LD      ($5C91),A       ; and restore system variable P_FLAG
3134
 
3135
        RET                     ; return without updating column position
3136
 
3137
; -----------------------
3138
; Perform carriage return
3139
; -----------------------
3140
; A carriage return is 'printed' to screen or printer buffer.
3141
 
3142
;; PO-ENTER
3143
L0A4F:  BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3144
        JP      NZ,L0ECD        ; to COPY-BUFF if so, to flush buffer and reset
3145
                                ; the print position.
3146
 
3147
        LD      C,$21           ; the leftmost column position.
3148
        CALL    L0C55           ; routine PO-SCR handles any scrolling required.
3149
        DEC     B               ; to next screen line.
3150
        JP      L0DD9           ; jump forward to CL-SET to store new position.
3151
 
3152
; -----------
3153
; Print comma
3154
; -----------
3155
; The comma control character. The 32 column screen has two 16 character
3156
; tabstops.  The routine is only reached via the control character table.
3157
 
3158
;; PO-COMMA
3159
L0A5F:  CALL    L0B03           ; routine PO-FETCH - seems unnecessary.
3160
 
3161
        LD      A,C             ; the column position. $21-$01
3162
        DEC     A               ; move right. $20-$00
3163
        DEC     A               ; and again   $1F-$00 or $FF if trailing
3164
        AND     $10             ; will be $00 or $10.
3165
        JR      L0AC3           ; forward to PO-FILL
3166
 
3167
; -------------------
3168
; Print question mark
3169
; -------------------
3170
; This routine prints a question mark which is commonly
3171
; used to print an unassigned control character in range 0-31d.
3172
; there are a surprising number yet to be assigned.
3173
 
3174
;; PO-QUEST
3175
L0A69:  LD      A,$3F           ; prepare the character '?'.
3176
        JR      L0AD9           ; forward to PO-ABLE.
3177
 
3178
; --------------------------------
3179
; Control characters with operands
3180
; --------------------------------
3181
; Certain control characters are followed by 1 or 2 operands.
3182
; The entry points from control character table are PO-2-OPER and PO-1-OPER.
3183
; The routines alter the output address of the current channel so that
3184
; subsequent RST $10 instructions take the appropriate action
3185
; before finally resetting the output address back to PRINT-OUT.
3186
 
3187
;; PO-TV-2
3188
L0A6D:  LD      DE,L0A87        ; address: PO-CONT will be next output routine
3189
        LD      ($5C0F),A       ; store first operand in TVDATA-hi
3190
        JR      L0A80           ; forward to PO-CHANGE >>
3191
 
3192
; ---
3193
 
3194
; -> This initial entry point deals with two operands - AT or TAB.
3195
 
3196
;; PO-2-OPER
3197
L0A75:  LD      DE,L0A6D        ; address: PO-TV-2 will be next output routine
3198
        JR      L0A7D           ; forward to PO-TV-1
3199
 
3200
; ---
3201
 
3202
; -> This initial entry point deals with one operand INK to OVER.
3203
 
3204
;; PO-1-OPER
3205
L0A7A:  LD      DE,L0A87        ; address: PO-CONT will be next output routine
3206
 
3207
;; PO-TV-1
3208
L0A7D:  LD      ($5C0E),A       ; store control code in TVDATA-lo
3209
 
3210
;; PO-CHANGE
3211
L0A80:  LD      HL,($5C51)      ; use CURCHL to find current output channel.
3212
        LD      (HL),E          ; make it
3213
        INC     HL              ; the supplied
3214
        LD      (HL),D          ; address from DE.
3215
        RET                     ; return.
3216
 
3217
; ---
3218
 
3219
;; PO-CONT
3220
L0A87:  LD      DE,L09F4        ; Address: PRINT-OUT
3221
        CALL    L0A80           ; routine PO-CHANGE to restore normal channel.
3222
        LD      HL,($5C0E)      ; TVDATA gives control code and possible
3223
                                ; subsequent character
3224
        LD      D,A             ; save current character
3225
        LD      A,L             ; the stored control code
3226
        CP      $16             ; was it INK to OVER (1 operand) ?
3227
        JP      C,L2211         ; to CO-TEMP-5
3228
 
3229
        JR      NZ,L0AC2        ; to PO-TAB if not 22d i.e. 23d TAB.
3230
 
3231
                                ; else must have been 22d AT.
3232
        LD      B,H             ; line to H   (0-23d)
3233
        LD      C,D             ; column to C (0-31d)
3234
        LD      A,$1F           ; the value 31d
3235
        SUB     C               ; reverse the column number.
3236
        JR      C,L0AAC         ; to PO-AT-ERR if C was greater than 31d.
3237
 
3238
        ADD     A,$02           ; transform to system range $02-$21
3239
        LD      C,A             ; and place in column register.
3240
 
3241
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3242
        JR      NZ,L0ABF        ; to PO-AT-SET as line can be ignored.
3243
 
3244
        LD      A,$16           ; 22 decimal
3245
        SUB     B               ; subtract line number to reverse
3246
                                ; 0 - 22 becomes 22 - 0.
3247
 
3248
;; PO-AT-ERR
3249
L0AAC:  JP      C,L1E9F         ; to REPORT-B if higher than 22 decimal
3250
                                ; Integer out of range.
3251
 
3252
        INC     A               ; adjust for system range $01-$17
3253
        LD      B,A             ; place in line register
3254
        INC     B               ; adjust to system range  $02-$18
3255
        BIT     0,(IY+$02)      ; TV_FLAG  - Lower screen in use ?
3256
        JP      NZ,L0C55        ; exit to PO-SCR to test for scrolling
3257
 
3258
        CP      (IY+$31)        ; Compare against DF_SZ
3259
        JP      C,L0C86         ; to REPORT-5 if too low
3260
                                ; Out of screen.
3261
 
3262
;; PO-AT-SET
3263
L0ABF:  JP      L0DD9           ; print position is valid so exit via CL-SET
3264
 
3265
; ---
3266
 
3267
; Continue here when dealing with TAB.
3268
; Note. In BASIC, TAB is followed by a 16-bit number and was initially
3269
; designed to work with any output device.
3270
 
3271
;; PO-TAB
3272
L0AC2:  LD      A,H             ; transfer parameter to A
3273
                                ; Losing current character -
3274
                                ; High byte of TAB parameter.
3275
 
3276
 
3277
;; PO-FILL
3278
L0AC3:  CALL    L0B03           ; routine PO-FETCH, HL-addr, BC=line/column.
3279
                                ; column 1 (right), $21 (left)
3280
        ADD     A,C             ; add operand to current column
3281
        DEC     A               ; range 0 - 31+
3282
        AND     $1F             ; make range 0 - 31d
3283
        RET     Z               ; return if result zero
3284
 
3285
        LD      D,A             ; Counter to D
3286
        SET     0,(IY+$01)      ; update FLAGS  - signal suppress leading space.
3287
 
3288
;; PO-SPACE
3289
L0AD0:  LD      A,$20           ; space character.
3290
 
3291
        CALL    L0C3B           ; routine PO-SAVE prints the character
3292
                                ; using alternate set (normal output routine)
3293
 
3294
        DEC     D               ; decrement counter.
3295
        JR      NZ,L0AD0        ; to PO-SPACE until done
3296
 
3297
        RET                     ; return
3298
 
3299
; ----------------------
3300
; Printable character(s)
3301
; ----------------------
3302
; This routine prints printable characters and continues into
3303
; the position store routine
3304
 
3305
;; PO-ABLE
3306
L0AD9:  CALL    L0B24           ; routine PO-ANY
3307
                                ; and continue into position store routine.
3308
 
3309
; ----------------------------
3310
; THE 'POSITION STORE' ROUTINE
3311
; ----------------------------
3312
;   This routine updates the system variables associated with the main screen,
3313
;   the lower screen/input buffer or the ZX printer.
3314
 
3315
;; PO-STORE
3316
L0ADC:  BIT     1,(IY+$01)      ; Test FLAGS - is printer in use ?
3317
        JR      NZ,L0AFC        ; Forward, if so, to PO-ST-PR
3318
 
3319
        BIT     0,(IY+$02)      ; Test TV_FLAG - is lower screen in use ?
3320
        JR      NZ,L0AF0        ; Forward, if so, to PO-ST-E
3321
 
3322
;   This section deals with the upper screen.
3323
 
3324
        LD      ($5C88),BC      ; Update S_POSN - line/column upper screen
3325
        LD      ($5C84),HL      ; Update DF_CC - upper display file address
3326
 
3327
        RET                     ; Return.
3328
 
3329
; ---
3330
 
3331
;   This section deals with the lower screen.
3332
 
3333
;; PO-ST-E
3334
L0AF0:  LD      ($5C8A),BC      ; Update SPOSNL line/column lower screen
3335
        LD      ($5C82),BC      ; Update ECHO_E line/column input buffer
3336
        LD      ($5C86),HL      ; Update DFCCL  lower screen memory address
3337
        RET                     ; Return.
3338
 
3339
; ---
3340
 
3341
;   This section deals with the ZX Printer.
3342
 
3343
;; PO-ST-PR
3344
L0AFC:  LD      (IY+$45),C      ; Update P_POSN column position printer
3345
        LD      ($5C80),HL      ; Update PR_CC - full printer buffer memory
3346
                                ; address
3347
        RET                     ; Return.
3348
 
3349
;   Note. that any values stored in location 23681 will be overwritten with
3350
;   the value 91 decimal.
3351
;   Credit April 1983, Dilwyn Jones. "Delving Deeper into your ZX Spectrum".
3352
 
3353
; ----------------------------
3354
; THE 'POSITION FETCH' ROUTINE
3355
; ----------------------------
3356
;   This routine fetches the line/column and display file address of the upper
3357
;   and lower screen or, if the printer is in use, the column position and
3358
;   absolute memory address.
3359
;   Note. that PR-CC-hi (23681) is used by this routine and if, in accordance
3360
;   with the manual (that says this is unused), the location has been used for
3361
;   other purposes, then subsequent output to the printer buffer could corrupt
3362
;   a 256-byte section of memory.
3363
 
3364
;; PO-FETCH
3365
L0B03:  BIT     1,(IY+$01)      ; Test FLAGS - is printer in use ?
3366
        JR      NZ,L0B1D        ; Forward, if so, to PO-F-PR
3367
 
3368
;   assume upper screen in use and thus optimize for path that requires speed.
3369
 
3370
        LD      BC,($5C88)      ; Fetch line/column from S_POSN
3371
        LD      HL,($5C84)      ; Fetch DF_CC display file address
3372
 
3373
        BIT     0,(IY+$02)      ; Test TV_FLAG - lower screen in use ?
3374
        RET     Z               ; Return if upper screen in use.
3375
 
3376
;   Overwrite registers with values for lower screen.
3377
 
3378
        LD      BC,($5C8A)      ; Fetch line/column from SPOSNL
3379
        LD      HL,($5C86)      ; Fetch display file address from DFCCL
3380
        RET                     ; Return.
3381
 
3382
; ---
3383
 
3384
;   This section deals with the ZX Printer.
3385
 
3386
;; PO-F-PR
3387
L0B1D:  LD      C,(IY+$45)      ; Fetch column from P_POSN.
3388
        LD      HL,($5C80)      ; Fetch printer buffer address from PR_CC.
3389
        RET                     ; Return.
3390
 
3391
; ---------------------------------
3392
; THE 'PRINT ANY CHARACTER' ROUTINE
3393
; ---------------------------------
3394
;   This routine is used to print any character in range 32d - 255d
3395
;   It is only called from PO-ABLE which continues into PO-STORE
3396
 
3397
;; PO-ANY
3398
L0B24:  CP      $80             ; ASCII ?
3399
        JR      C,L0B65         ; to PO-CHAR is so.
3400
 
3401
        CP      $90             ; test if a block graphic character.
3402
        JR      NC,L0B52        ; to PO-T&UDG to print tokens and UDGs
3403
 
3404
; The 16 2*2 mosaic characters 128-143 decimal are formed from
3405
; bits 0-3 of the character.
3406
 
3407
        LD      B,A             ; save character
3408
        CALL    L0B38           ; routine PO-GR-1 to construct top half
3409
                                ; then bottom half.
3410
        CALL    L0B03           ; routine PO-FETCH fetches print position.
3411
        LD      DE,$5C92        ; MEM-0 is location of 8 bytes of character
3412
        JR      L0B7F           ; to PR-ALL to print to screen or printer
3413
 
3414
; ---
3415
 
3416
;; PO-GR-1
3417
L0B38:  LD      HL,$5C92        ; address MEM-0 - a temporary buffer in
3418
                                ; systems variables which is normally used
3419
                                ; by the calculator.
3420
        CALL    L0B3E           ; routine PO-GR-2 to construct top half
3421
                                ; and continue into routine to construct
3422
                                ; bottom half.
3423
 
3424
;; PO-GR-2
3425
L0B3E:  RR      B               ; rotate bit 0/2 to carry
3426
        SBC     A,A             ; result $00 or $FF
3427
        AND     $0F             ; mask off right hand side
3428
        LD      C,A             ; store part in C
3429
        RR      B               ; rotate bit 1/3 of original chr to carry
3430
        SBC     A,A             ; result $00 or $FF
3431
        AND     $F0             ; mask off left hand side
3432
        OR      C               ; combine with stored pattern
3433
        LD      C,$04           ; four bytes for top/bottom half
3434
 
3435
;; PO-GR-3
3436
L0B4C:  LD      (HL),A          ; store bit patterns in temporary buffer
3437
        INC     HL              ; next address
3438
        DEC     C               ; jump back to
3439
        JR      NZ,L0B4C        ; to PO-GR-3 until byte is stored 4 times
3440
 
3441
        RET                     ; return
3442
 
3443
; ---
3444
 
3445
; Tokens and User defined graphics are now separated.
3446
 
3447
;; PO-T&UDG
3448
L0B52:  SUB     $A5             ; the 'RND' character
3449
        JR      NC,L0B5F        ; to PO-T to print tokens
3450
 
3451
        ADD     A,$15           ; add 21d to restore to 0 - 20
3452
        PUSH    BC              ; save current print position
3453
        LD      BC,($5C7B)      ; fetch UDG to address bit patterns
3454
        JR      L0B6A           ; to PO-CHAR-2 - common code to lay down
3455
                                ; a bit patterned character
3456
 
3457
; ---
3458
 
3459
;; PO-T
3460
L0B5F:  CALL    L0C10           ; routine PO-TOKENS prints tokens
3461
        JP      L0B03           ; exit via a JUMP to PO-FETCH as this routine
3462
                                ; must continue into PO-STORE.
3463
                                ; A JR instruction could be used.
3464
 
3465
; This point is used to print ASCII characters  32d - 127d.
3466
 
3467
;; PO-CHAR
3468
L0B65:  PUSH    BC              ; save print position
3469
        LD      BC,($5C36)      ; address CHARS
3470
 
3471
; This common code is used to transfer the character bytes to memory.
3472
 
3473
;; PO-CHAR-2
3474
L0B6A:  EX      DE,HL           ; transfer destination address to DE
3475
        LD      HL,$5C3B        ; point to FLAGS
3476
        RES     0,(HL)          ; allow for leading space
3477
        CP      $20             ; is it a space ?
3478
        JR      NZ,L0B76        ; to PO-CHAR-3 if not
3479
 
3480
        SET     0,(HL)          ; signal no leading space to FLAGS
3481
 
3482
;; PO-CHAR-3
3483
L0B76:  LD      H,$00           ; set high byte to 0
3484
        LD      L,A             ; character to A
3485
                                ; 0-21 UDG or 32-127 ASCII.
3486
        ADD     HL,HL           ; multiply
3487
        ADD     HL,HL           ; by
3488
        ADD     HL,HL           ; eight
3489
        ADD     HL,BC           ; HL now points to first byte of character
3490
        POP     BC              ; the source address CHARS or UDG
3491
        EX      DE,HL           ; character address to DE
3492
 
3493
; ----------------------------------
3494
; THE 'PRINT ALL CHARACTERS' ROUTINE
3495
; ----------------------------------
3496
;   This entry point entered from above to print ASCII and UDGs but also from
3497
;   earlier to print mosaic characters.
3498
;   HL=destination
3499
;   DE=character source
3500
;   BC=line/column
3501
 
3502
;; PR-ALL
3503
L0B7F:  LD      A,C             ; column to A
3504
        DEC     A               ; move right
3505
        LD      A,$21           ; pre-load with leftmost position
3506
        JR      NZ,L0B93        ; but if not zero to PR-ALL-1
3507
 
3508
        DEC     B               ; down one line
3509
        LD      C,A             ; load C with $21
3510
        BIT     1,(IY+$01)      ; test FLAGS  - Is printer in use
3511
        JR      Z,L0B93         ; to PR-ALL-1 if not
3512
 
3513
        PUSH    DE              ; save source address
3514
        CALL    L0ECD           ; routine COPY-BUFF outputs line to printer
3515
        POP     DE              ; restore character source address
3516
        LD      A,C             ; the new column number ($21) to C
3517
 
3518
;; PR-ALL-1
3519
L0B93:  CP      C               ; this test is really for screen - new line ?
3520
        PUSH    DE              ; save source
3521
 
3522
        CALL    Z,L0C55         ; routine PO-SCR considers scrolling
3523
 
3524
        POP     DE              ; restore source
3525
        PUSH    BC              ; save line/column
3526
        PUSH    HL              ; and destination
3527
        LD      A,($5C91)       ; fetch P_FLAG to accumulator
3528
        LD      B,$FF           ; prepare OVER mask in B.
3529
        RRA                     ; bit 0 set if OVER 1
3530
        JR      C,L0BA4         ; to PR-ALL-2
3531
 
3532
        INC     B               ; set OVER mask to 0
3533
 
3534
;; PR-ALL-2
3535
L0BA4:  RRA                     ; skip bit 1 of P_FLAG
3536
        RRA                     ; bit 2 is INVERSE
3537
        SBC     A,A             ; will be FF for INVERSE 1 else zero
3538
        LD      C,A             ; transfer INVERSE mask to C
3539
        LD      A,$08           ; prepare to count 8 bytes
3540
        AND     A               ; clear carry to signal screen
3541
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3542
        JR      Z,L0BB6         ; to PR-ALL-3 if screen
3543
 
3544
        SET     1,(IY+$30)      ; update FLAGS2  - signal printer buffer has
3545
                                ; been used.
3546
        SCF                     ; set carry flag to signal printer.
3547
 
3548
;; PR-ALL-3
3549
L0BB6:  EX      DE,HL           ; now HL=source, DE=destination
3550
 
3551
;; PR-ALL-4
3552
L0BB7:  EX      AF,AF'          ; save printer/screen flag
3553
        LD      A,(DE)          ; fetch existing destination byte
3554
        AND     B               ; consider OVER
3555
        XOR     (HL)            ; now XOR with source
3556
        XOR     C               ; now with INVERSE MASK
3557
        LD      (DE),A          ; update screen/printer
3558
        EX      AF,AF'          ; restore flag
3559
        JR      C,L0BD3         ; to PR-ALL-6 - printer address update
3560
 
3561
        INC     D               ; gives next pixel line down screen
3562
 
3563
;; PR-ALL-5
3564
L0BC1:  INC     HL              ; address next character byte
3565
        DEC     A               ; the byte count is decremented
3566
        JR      NZ,L0BB7        ; back to PR-ALL-4 for all 8 bytes
3567
 
3568
        EX      DE,HL           ; destination to HL
3569
        DEC     H               ; bring back to last updated screen position
3570
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3571
        CALL    Z,L0BDB         ; if not, call routine PO-ATTR to update
3572
                                ; corresponding colour attribute.
3573
        POP     HL              ; restore original screen/printer position
3574
        POP     BC              ; and line column
3575
        DEC     C               ; move column to right
3576
        INC     HL              ; increase screen/printer position
3577
        RET                     ; return and continue into PO-STORE
3578
                                ; within PO-ABLE
3579
 
3580
; ---
3581
 
3582
;   This branch is used to update the printer position by 32 places
3583
;   Note. The high byte of the address D remains constant (which it should).
3584
 
3585
;; PR-ALL-6
3586
L0BD3:  EX      AF,AF'          ; save the flag
3587
        LD      A,$20           ; load A with 32 decimal
3588
        ADD     A,E             ; add this to E
3589
        LD      E,A             ; and store result in E
3590
        EX      AF,AF'          ; fetch the flag
3591
        JR      L0BC1           ; back to PR-ALL-5
3592
 
3593
; -----------------------------------
3594
; THE 'GET ATTRIBUTE ADDRESS' ROUTINE
3595
; -----------------------------------
3596
;   This routine is entered with the HL register holding the last screen
3597
;   address to be updated by PRINT or PLOT.
3598
;   The Spectrum screen arrangement leads to the L register holding the correct
3599
;   value for the attribute file and it is only necessary to manipulate H to
3600
;   form the correct colour attribute address.
3601
 
3602
;; PO-ATTR
3603
L0BDB:  LD       A,H            ; fetch high byte $40 - $57
3604
        RRCA                    ; shift
3605
        RRCA                    ; bits 3 and 4
3606
        RRCA                    ; to right.
3607
        AND     $03             ; range is now 0 - 2
3608
        OR      $58             ; form correct high byte for third of screen
3609
        LD      H,A             ; HL is now correct
3610
        LD      DE,($5C8F)      ; make D hold ATTR_T, E hold MASK-T
3611
        LD      A,(HL)          ; fetch existing attribute
3612
        XOR     E               ; apply masks
3613
        AND     D               ;
3614
        XOR     E               ;
3615
        BIT     6,(IY+$57)      ; test P_FLAG  - is this PAPER 9 ??
3616
        JR      Z,L0BFA         ; skip to PO-ATTR-1 if not.
3617
 
3618
        AND     $C7             ; set paper
3619
        BIT     2,A             ; to contrast with ink
3620
        JR      NZ,L0BFA        ; skip to PO-ATTR-1
3621
 
3622
        XOR     $38             ;
3623
 
3624
;; PO-ATTR-1
3625
L0BFA:  BIT     4,(IY+$57)      ; test P_FLAG  - Is this INK 9 ??
3626
        JR      Z,L0C08         ; skip to PO-ATTR-2 if not
3627
 
3628
        AND     $F8             ; make ink
3629
        BIT     5,A             ; contrast with paper.
3630
        JR      NZ,L0C08        ; to PO-ATTR-2
3631
 
3632
        XOR     $07             ;
3633
 
3634
;; PO-ATTR-2
3635
L0C08:  LD      (HL),A          ; save the new attribute.
3636
        RET                     ; return.
3637
 
3638
; ---------------------------------
3639
; THE 'MESSAGE PRINTING' SUBROUTINE
3640
; ---------------------------------
3641
;   This entry point is used to print tape, boot-up, scroll? and error messages.
3642
;   On entry the DE register points to an initial step-over byte or the
3643
;   inverted end-marker of the previous entry in the table.
3644
;   Register A contains the message number, often zero to print first message.
3645
;   (HL has nothing important usually P_FLAG)
3646
 
3647
;; PO-MSG
3648
L0C0A:  PUSH    HL              ; put hi-byte zero on stack to suppress
3649
        LD      H,$00           ; trailing spaces
3650
        EX      (SP),HL         ; ld h,0; push hl would have done ?.
3651
        JR      L0C14           ; forward to PO-TABLE.
3652
 
3653
; ---
3654
 
3655
;   This entry point prints the BASIC keywords, '<>' etc. from alt set
3656
 
3657
;; PO-TOKENS
3658
L0C10:  LD      DE,L0095        ; address: TKN-TABLE
3659
        PUSH    AF              ; save the token number to control
3660
                                ; trailing spaces - see later *
3661
 
3662
; ->
3663
 
3664
;; PO-TABLE
3665
L0C14:  CALL    L0C41           ; routine PO-SEARCH will set carry for
3666
                                ; all messages and function words.
3667
 
3668
        JR      C,L0C22         ; forward to PO-EACH if not a command, '<>' etc.
3669
 
3670
        LD      A,$20           ; prepare leading space
3671
        BIT     0,(IY+$01)      ; test FLAGS  - leading space if not set
3672
 
3673
        CALL    Z,L0C3B         ; routine PO-SAVE to print a space without
3674
                                ; disturbing registers.
3675
 
3676
;; PO-EACH
3677
L0C22:  LD      A,(DE)          ; Fetch character from the table.
3678
        AND     $7F             ; Cancel any inverted bit.
3679
 
3680
        CALL    L0C3B           ; Routine PO-SAVE to print using the alternate
3681
                                ; set of registers.
3682
 
3683
        LD      A,(DE)          ; Re-fetch character from table.
3684
        INC     DE              ; Address next character in the table.
3685
 
3686
        ADD     A,A             ; Was character inverted ?
3687
                                ; (this also doubles character)
3688
        JR      NC,L0C22        ; back to PO-EACH if not.
3689
 
3690
        POP     DE              ; * re-fetch trailing space byte to D
3691
 
3692
        CP      $48             ; was the last character '$' ?
3693
        JR      Z,L0C35         ; forward to PO-TR-SP to consider trailing
3694
                                ; space if so.
3695
 
3696
        CP      $82             ; was it < 'A' i.e. '#','>','=' from tokens
3697
                                ; or ' ','.' (from tape) or '?' from scroll
3698
 
3699
        RET     C               ; Return if so as no trailing space required.
3700
 
3701
;; PO-TR-SP
3702
L0C35:  LD      A,D             ; The trailing space flag (zero if an error msg)
3703
 
3704
        CP      $03             ; Test against RND, INKEY$ and PI which have no
3705
                                ; parameters and therefore no trailing space.
3706
 
3707
        RET     C               ; Return if no trailing space.
3708
 
3709
        LD      A,$20           ; Prepare the space character and continue to
3710
                                ; print and make an indirect return.
3711
 
3712
; -----------------------------------
3713
; THE 'RECURSIVE PRINTING' SUBROUTINE
3714
; -----------------------------------
3715
;   This routine which is part of PRINT-OUT allows RST $10 to be used
3716
;   recursively to print tokens and the spaces associated with them.
3717
;   It is called on three occasions when the value of DE must be preserved.
3718
 
3719
;; PO-SAVE
3720
L0C3B:  PUSH    DE              ; Save DE value.
3721
        EXX                     ; Switch in main set
3722
 
3723
        RST     10H             ; PRINT-A prints using this alternate set.
3724
 
3725
        EXX                     ; Switch back to this alternate set.
3726
        POP     DE              ; Restore the initial DE value.
3727
 
3728
        RET                     ; Return.
3729
 
3730
; ------------
3731
; Table search
3732
; ------------
3733
; This subroutine searches a message or the token table for the
3734
; message number held in A. DE holds the address of the table.
3735
 
3736
;; PO-SEARCH
3737
L0C41:  PUSH    AF              ; save the message/token number
3738
        EX      DE,HL           ; transfer DE to HL
3739
        INC     A               ; adjust for initial step-over byte
3740
 
3741
;; PO-STEP
3742
L0C44:  BIT     7,(HL)          ; is character inverted ?
3743
        INC     HL              ; address next
3744
        JR      Z,L0C44         ; back to PO-STEP if not inverted.
3745
 
3746
        DEC     A               ; decrease counter
3747
        JR      NZ,L0C44        ; back to PO-STEP if not zero
3748
 
3749
        EX      DE,HL           ; transfer address to DE
3750
        POP     AF              ; restore message/token number
3751
        CP      $20             ; return with carry set
3752
        RET     C               ; for all messages and function tokens
3753
 
3754
        LD      A,(DE)          ; test first character of token
3755
        SUB     $41             ; and return with carry set
3756
        RET                     ; if it is less that 'A'
3757
                                ; i.e. '<>', '<=', '>='
3758
 
3759
; ---------------
3760
; Test for scroll
3761
; ---------------
3762
; This test routine is called when printing carriage return, when considering
3763
; PRINT AT and from the general PRINT ALL characters routine to test if
3764
; scrolling is required, prompting the user if necessary.
3765
; This is therefore using the alternate set.
3766
; The B register holds the current line.
3767
 
3768
;; PO-SCR
3769
L0C55:  BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3770
        RET     NZ              ; return immediately if so.
3771
 
3772
        LD      DE,L0DD9        ; set DE to address: CL-SET
3773
        PUSH    DE              ; and push for return address.
3774
 
3775
        LD      A,B             ; transfer the line to A.
3776
        BIT     0,(IY+$02)      ; test TV_FLAG - lower screen in use ?
3777
        JP      NZ,L0D02        ; jump forward to PO-SCR-4 if so.
3778
 
3779
        CP      (IY+$31)        ; greater than DF_SZ display file size ?
3780
        JR      C,L0C86         ; forward to REPORT-5 if less.
3781
                                ; 'Out of screen'
3782
 
3783
        RET     NZ              ; return (via CL-SET) if greater
3784
 
3785
        BIT     4,(IY+$02)      ; test TV_FLAG  - Automatic listing ?
3786
        JR      Z,L0C88         ; forward to PO-SCR-2 if not.
3787
 
3788
        LD      E,(IY+$2D)      ; fetch BREG - the count of scroll lines to E.
3789
        DEC     E               ; decrease and jump
3790
        JR      Z,L0CD2         ; to PO-SCR-3 if zero and scrolling required.
3791
 
3792
        LD      A,$00           ; explicit - select channel zero.
3793
        CALL    L1601           ; routine CHAN-OPEN opens it.
3794
 
3795
        LD      SP,($5C3F)      ; set stack pointer to LIST_SP
3796
 
3797
        RES     4,(IY+$02)      ; reset TV_FLAG  - signal auto listing finished.
3798
        RET                     ; return ignoring pushed value, CL-SET
3799
                                ; to MAIN or EDITOR without updating
3800
                                ; print position                         >>
3801
 
3802
; ---
3803
 
3804
 
3805
;; REPORT-5
3806
L0C86:  RST     08H             ; ERROR-1
3807
        DEFB    $04             ; Error Report: Out of screen
3808
 
3809
; continue here if not an automatic listing.
3810
 
3811
;; PO-SCR-2
3812
L0C88:  DEC     (IY+$52)        ; decrease SCR_CT
3813
        JR      NZ,L0CD2        ; forward to PO-SCR-3 to scroll display if
3814
                                ; result not zero.
3815
 
3816
; now produce prompt.
3817
 
3818
        LD      A,$18           ; reset
3819
        SUB     B               ; the
3820
        LD      ($5C8C),A       ; SCR_CT scroll count
3821
        LD      HL,($5C8F)      ; L=ATTR_T, H=MASK_T
3822
        PUSH    HL              ; save on stack
3823
        LD      A,($5C91)       ; P_FLAG
3824
        PUSH    AF              ; save on stack to prevent lower screen
3825
                                ; attributes (BORDCR etc.) being applied.
3826
        LD      A,$FD           ; select system channel 'K'
3827
        CALL    L1601           ; routine CHAN-OPEN opens it
3828
        XOR     A               ; clear to address message directly
3829
        LD      DE,L0CF8        ; make DE address: scrl-mssg
3830
        CALL    L0C0A           ; routine PO-MSG prints to lower screen
3831
        SET     5,(IY+$02)      ; set TV_FLAG  - signal lower screen requires
3832
                                ; clearing
3833
        LD      HL,$5C3B        ; make HL address FLAGS
3834
        SET     3,(HL)          ; signal 'L' mode.
3835
        RES     5,(HL)          ; signal 'no new key'.
3836
        EXX                     ; switch to main set.
3837
                                ; as calling chr input from alternative set.
3838
        CALL    L15D4           ; routine WAIT-KEY waits for new key
3839
                                ; Note. this is the right routine but the
3840
                                ; stream in use is unsatisfactory. From the
3841
                                ; choices available, it is however the best.
3842
 
3843
        EXX                     ; switch back to alternate set.
3844
        CP      $20             ; space is considered as BREAK
3845
        JR      Z,L0D00         ; forward to REPORT-D if so
3846
                                ; 'BREAK - CONT repeats'
3847
 
3848
        CP      $E2             ; is character 'STOP' ?
3849
        JR      Z,L0D00         ; forward to REPORT-D if so
3850
 
3851
        OR      $20             ; convert to lower-case
3852
        CP      $6E             ; is character 'n' ?
3853
        JR      Z,L0D00         ; forward to REPORT-D if so else scroll.
3854
 
3855
        LD      A,$FE           ; select system channel 'S'
3856
        CALL    L1601           ; routine CHAN-OPEN
3857
        POP     AF              ; restore original P_FLAG
3858
        LD      ($5C91),A       ; and save in P_FLAG.
3859
        POP     HL              ; restore original ATTR_T, MASK_T
3860
        LD      ($5C8F),HL      ; and reset ATTR_T, MASK-T as 'scroll?' has
3861
                                ; been printed.
3862
 
3863
;; PO-SCR-3
3864
L0CD2:  CALL    L0DFE           ; routine CL-SC-ALL to scroll whole display
3865
        LD      B,(IY+$31)      ; fetch DF_SZ to B
3866
        INC     B               ; increase to address last line of display
3867
        LD      C,$21           ; set C to $21 (was $21 from above routine)
3868
        PUSH    BC              ; save the line and column in BC.
3869
 
3870
        CALL    L0E9B           ; routine CL-ADDR finds display address.
3871
 
3872
        LD      A,H             ; now find the corresponding attribute byte
3873
        RRCA                    ; (this code sequence is used twice
3874
        RRCA                    ; elsewhere and is a candidate for
3875
        RRCA                    ; a subroutine.)
3876
        AND     $03             ;
3877
        OR      $58             ;
3878
        LD      H,A             ;
3879
 
3880
        LD      DE,$5AE0        ; start of last 'line' of attribute area
3881
        LD      A,(DE)          ; get attribute for last line
3882
        LD      C,(HL)          ; transfer to base line of upper part
3883
        LD      B,$20           ; there are thirty two bytes
3884
        EX      DE,HL           ; swap the pointers.
3885
 
3886
;; PO-SCR-3A
3887
L0CF0:  LD      (DE),A          ; transfer
3888
        LD      (HL),C          ; attributes.
3889
        INC     DE              ; address next.
3890
        INC     HL              ; address next.
3891
        DJNZ    L0CF0           ; loop back to PO-SCR-3A for all adjacent
3892
                                ; attribute lines.
3893
 
3894
        POP     BC              ; restore the line/column.
3895
        RET                     ; return via CL-SET (was pushed on stack).
3896
 
3897
; ---
3898
 
3899
; The message 'scroll?' appears here with last byte inverted.
3900
 
3901
;; scrl-mssg
3902
L0CF8:  DEFB    $80             ; initial step-over byte.
3903
        DEFM    "scroll"
3904
        DEFB    '?'+$80
3905
 
3906
;; REPORT-D
3907
L0D00:  RST     08H             ; ERROR-1
3908
        DEFB    $0C             ; Error Report: BREAK - CONT repeats
3909
 
3910
; continue here if using lower display - A holds line number.
3911
 
3912
;; PO-SCR-4
3913
L0D02:  CP      $02             ; is line number less than 2 ?
3914
        JR      C,L0C86         ; to REPORT-5 if so
3915
                                ; 'Out of Screen'.
3916
 
3917
        ADD     A,(IY+$31)      ; add DF_SZ
3918
        SUB     $19             ;
3919
        RET     NC              ; return if scrolling unnecessary
3920
 
3921
        NEG                     ; Negate to give number of scrolls required.
3922
        PUSH    BC              ; save line/column
3923
        LD      B,A             ; count to B
3924
        LD      HL,($5C8F)      ; fetch current ATTR_T, MASK_T to HL.
3925
        PUSH    HL              ; and save
3926
        LD      HL,($5C91)      ; fetch P_FLAG
3927
        PUSH    HL              ; and save.
3928
                                ; to prevent corruption by input AT
3929
 
3930
        CALL    L0D4D           ; routine TEMPS sets to BORDCR etc
3931
        LD      A,B             ; transfer scroll number to A.
3932
 
3933
;; PO-SCR-4A
3934
L0D1C:  PUSH    AF              ; save scroll number.
3935
        LD      HL,$5C6B        ; address DF_SZ
3936
        LD      B,(HL)          ; fetch old value
3937
        LD      A,B             ; transfer to A
3938
        INC     A               ; and increment
3939
        LD      (HL),A          ; then put back.
3940
        LD      HL,$5C89        ; address S_POSN_hi - line
3941
        CP      (HL)            ; compare
3942
        JR      C,L0D2D         ; forward to PO-SCR-4B if scrolling required
3943
 
3944
        INC     (HL)            ; else increment S_POSN_hi
3945
        LD      B,$18           ; set count to whole display ??
3946
                                ; Note. should be $17 and the top line will be
3947
                                ; scrolled into the ROM which is harmless on
3948
                                ; the standard set up.
3949
                                ; credit P.Giblin 1984.
3950
 
3951
;; PO-SCR-4B
3952
L0D2D:  CALL    L0E00           ; routine CL-SCROLL scrolls B lines
3953
        POP     AF              ; restore scroll counter.
3954
        DEC     A               ; decrease
3955
        JR      NZ,L0D1C        ; back to PO-SCR-4A until done
3956
 
3957
        POP     HL              ; restore original P_FLAG.
3958
        LD      (IY+$57),L      ; and overwrite system variable P_FLAG.
3959
 
3960
        POP     HL              ; restore original ATTR_T/MASK_T.
3961
        LD      ($5C8F),HL      ; and update system variables.
3962
 
3963
        LD      BC,($5C88)      ; fetch S_POSN to BC.
3964
        RES     0,(IY+$02)      ; signal to TV_FLAG  - main screen in use.
3965
        CALL    L0DD9           ; call routine CL-SET for upper display.
3966
 
3967
        SET     0,(IY+$02)      ; signal to TV_FLAG  - lower screen in use.
3968
        POP     BC              ; restore line/column
3969
        RET                     ; return via CL-SET for lower display.
3970
 
3971
; ----------------------
3972
; Temporary colour items
3973
; ----------------------
3974
; This subroutine is called 11 times to copy the permanent colour items
3975
; to the temporary ones.
3976
 
3977
;; TEMPS
3978
L0D4D:  XOR     A               ; clear the accumulator
3979
        LD      HL,($5C8D)      ; fetch L=ATTR_P and H=MASK_P
3980
        BIT     0,(IY+$02)      ; test TV_FLAG  - is lower screen in use ?
3981
        JR      Z,L0D5B         ; skip to TEMPS-1 if not
3982
 
3983
        LD      H,A             ; set H, MASK P, to 00000000.
3984
        LD      L,(IY+$0E)      ; fetch BORDCR to L which is used for lower
3985
                                ; screen.
3986
 
3987
;; TEMPS-1
3988
L0D5B:  LD      ($5C8F),HL      ; transfer values to ATTR_T and MASK_T
3989
 
3990
; for the print flag the permanent values are odd bits, temporary even bits.
3991
 
3992
        LD      HL,$5C91        ; address P_FLAG.
3993
        JR      NZ,L0D65        ; skip to TEMPS-2 if lower screen using A=0.
3994
 
3995
        LD      A,(HL)          ; else pick up flag bits.
3996
        RRCA                    ; rotate permanent bits to temporary bits.
3997
 
3998
;; TEMPS-2
3999
L0D65:  XOR     (HL)            ;
4000
        AND     $55             ; BIN 01010101
4001
        XOR     (HL)            ; permanent now as original
4002
        LD      (HL),A          ; apply permanent bits to temporary bits.
4003
        RET                     ; and return.
4004
 
4005
; -----------------
4006
; THE 'CLS' COMMAND
4007
; -----------------
4008
;    This command clears the display.
4009
;    The routine is also called during initialization and by the CLEAR command.
4010
;    If it's difficult to write it should be difficult to read.
4011
 
4012
;; CLS
4013
L0D6B:  CALL    L0DAF           ; Routine CL-ALL clears the entire display and
4014
                                ; sets the attributes to the permanent ones
4015
                                ; from ATTR-P.
4016
 
4017
;   Having cleared all 24 lines of the display area, continue into the
4018
;   subroutine that clears the lower display area.  Note that at the moment
4019
;   the attributes for the lower lines are the same as upper ones and have
4020
;   to be changed to match the BORDER colour.
4021
 
4022
; --------------------------
4023
; THE 'CLS-LOWER' SUBROUTINE
4024
; --------------------------
4025
;   This routine is called from INPUT, and from the MAIN execution loop.
4026
;   This is very much a housekeeping routine which clears between 2 and 23
4027
;   lines of the display, setting attributes and correcting situations where
4028
;   errors have occurred while the normal input and output routines have been
4029
;   temporarily diverted to deal with, say colour control codes.
4030
 
4031
;; CLS-LOWER
4032
L0D6E:  LD      HL,$5C3C        ; address System Variable TV_FLAG.
4033
        RES     5,(HL)          ; TV_FLAG - signal do not clear lower screen.
4034
        SET     0,(HL)          ; TV_FLAG - signal lower screen in use.
4035
 
4036
        CALL    L0D4D           ; routine TEMPS applies permanent attributes,
4037
                                ; in this case BORDCR to ATTR_T.
4038
                                ; Note. this seems unnecessary and is repeated
4039
                                ; within CL-LINE.
4040
 
4041
        LD      B,(IY+$31)      ; fetch lower screen display file size DF_SZ
4042
 
4043
        CALL    L0E44           ; routine CL-LINE clears lines to bottom of the
4044
                                ; display and sets attributes from BORDCR while
4045
                                ; preserving the B register.
4046
 
4047
        LD      HL,$5AC0        ; set initial attribute address to the leftmost
4048
                                ; cell of second line up.
4049
 
4050
        LD      A,($5C8D)       ; fetch permanent attribute from ATTR_P.
4051
 
4052
        DEC     B               ; decrement lower screen display file size.
4053
 
4054
        JR      L0D8E           ; forward to enter the backfill loop at CLS-3
4055
                                ; where B is decremented again.
4056
 
4057
; ---
4058
 
4059
;   The backfill loop is entered at midpoint and ensures, if more than 2
4060
;   lines have been cleared, that any other lines take the permanent screen
4061
;   attributes.
4062
 
4063
;; CLS-1
4064
L0D87:  LD      C,$20           ; set counter to 32 character cells per line
4065
 
4066
;; CLS-2
4067
L0D89:  DEC     HL              ; decrease attribute address.
4068
        LD      (HL),A          ; and place attributes in next line up.
4069
        DEC     C               ; decrease the 32 counter.
4070
        JR      NZ,L0D89        ; loop back to CLS-2 until all 32 cells done.
4071
 
4072
;; CLS-3
4073
L0D8E:  DJNZ    L0D87           ; decrease B counter and back to CLS-1
4074
                                ; if not zero.
4075
 
4076
        LD      (IY+$31),$02    ; now set DF_SZ lower screen to 2
4077
 
4078
; This entry point is also called from CL-ALL below to
4079
; reset the system channel input and output addresses to normal.
4080
 
4081
;; CL-CHAN
4082
L0D94:  LD      A,$FD           ; select system channel 'K'
4083
 
4084
        CALL    L1601           ; routine CHAN-OPEN opens it.
4085
 
4086
        LD      HL,($5C51)      ; fetch CURCHL to HL to address current channel
4087
        LD      DE,L09F4        ; set address to PRINT-OUT for first pass.
4088
        AND     A               ; clear carry for first pass.
4089
 
4090
;; CL-CHAN-A
4091
L0DA0:  LD      (HL),E          ; Insert the output address on the first pass
4092
        INC     HL              ; or the input address on the second pass.
4093
        LD      (HL),D          ;
4094
        INC     HL              ;
4095
 
4096
        LD      DE,L10A8        ; fetch address KEY-INPUT for second pass
4097
        CCF                     ; complement carry flag - will set on pass 1.
4098
 
4099
        JR      C,L0DA0         ; back to CL-CHAN-A if first pass else done.
4100
 
4101
        LD      BC,$1721        ; line 23 for lower screen
4102
        JR      L0DD9           ; exit via CL-SET to set column
4103
                                ; for lower display
4104
 
4105
; ---------------------------
4106
; Clearing whole display area
4107
; ---------------------------
4108
; This subroutine called from CLS, AUTO-LIST and MAIN-3
4109
; clears 24 lines of the display and resets the relevant system variables.
4110
; This routine also recovers from an error situation where, for instance, an
4111
; invalid colour or position control code has left the output routine addressing
4112
; PO-TV-2 or PO-CONT.
4113
 
4114
;; CL-ALL
4115
L0DAF:  LD      HL,$0000        ; Initialize plot coordinates.
4116
        LD      ($5C7D),HL      ; Set system variable COORDS to 0,0.
4117
 
4118
        RES     0,(IY+$30)      ; update FLAGS2  - signal main screen is clear.
4119
 
4120
        CALL    L0D94           ; routine CL-CHAN makes channel 'K' 'normal'.
4121
 
4122
        LD      A,$FE           ; select system channel 'S'
4123
        CALL    L1601           ; routine CHAN-OPEN opens it.
4124
 
4125
        CALL    L0D4D           ; routine TEMPS applies permanent attributes,
4126
                                ; in this case ATTR_P, to ATTR_T.
4127
                                ; Note. this seems unnecessary.
4128
 
4129
        LD      B,$18           ; There are 24 lines.
4130
 
4131
        CALL    L0E44           ; routine CL-LINE clears 24 text lines and sets
4132
                                ; attributes from ATTR-P.
4133
                                ; This routine preserves B and sets C to $21.
4134
 
4135
        LD      HL,($5C51)      ; fetch CURCHL make HL address output routine.
4136
 
4137
        LD      DE,L09F4        ; address: PRINT-OUT
4138
        LD      (HL),E          ; is made
4139
        INC     HL              ; the normal
4140
        LD      (HL),D          ; output address.
4141
 
4142
        LD      (IY+$52),$01    ; set SCR_CT - scroll count - to default.
4143
 
4144
;   Note. BC already contains $1821.
4145
 
4146
        LD      BC,$1821        ; reset column and line to 0,0
4147
                                ; and continue into CL-SET, below, exiting
4148
                                ; via PO-STORE (for the upper screen).
4149
 
4150
; --------------------
4151
; THE 'CL-SET' ROUTINE
4152
; --------------------
4153
; This important subroutine is used to calculate the character output
4154
; address for screens or printer based on the line/column for screens
4155
; or the column for printer.
4156
 
4157
;; CL-SET
4158
L0DD9:  LD      HL,$5B00        ; the base address of printer buffer
4159
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
4160
        JR      NZ,L0DF4        ; forward to CL-SET-2 if so.
4161
 
4162
        LD      A,B             ; transfer line to A.
4163
        BIT     0,(IY+$02)      ; test TV_FLAG  - lower screen in use ?
4164
        JR      Z,L0DEE         ; skip to CL-SET-1 if handling upper part
4165
 
4166
        ADD     A,(IY+$31)      ; add DF_SZ for lower screen
4167
        SUB     $18             ; and adjust.
4168
 
4169
;; CL-SET-1
4170
L0DEE:  PUSH    BC              ; save the line/column.
4171
        LD      B,A             ; transfer line to B
4172
                                ; (adjusted if lower screen)
4173
 
4174
        CALL    L0E9B           ; routine CL-ADDR calculates address at left
4175
                                ; of screen.
4176
        POP     BC              ; restore the line/column.
4177
 
4178
;; CL-SET-2
4179
L0DF4:  LD      A,$21           ; the column $01-$21 is reversed
4180
        SUB     C               ; to range $00 - $20
4181
        LD      E,A             ; now transfer to DE
4182
        LD      D,$00           ; prepare for addition
4183
        ADD     HL,DE           ; and add to base address
4184
 
4185
        JP      L0ADC           ; exit via PO-STORE to update the relevant
4186
                                ; system variables.
4187
; ----------------
4188
; Handle scrolling
4189
; ----------------
4190
; The routine CL-SC-ALL is called once from PO to scroll all the display
4191
; and from the routine CL-SCROLL, once, to scroll part of the display.
4192
 
4193
;; CL-SC-ALL
4194
L0DFE:  LD      B,$17           ; scroll 23 lines, after 'scroll?'.
4195
 
4196
;; CL-SCROLL
4197
L0E00:  CALL    L0E9B           ; routine CL-ADDR gets screen address in HL.
4198
        LD      C,$08           ; there are 8 pixel lines to scroll.
4199
 
4200
;; CL-SCR-1
4201
L0E05:  PUSH    BC              ; save counters.
4202
        PUSH    HL              ; and initial address.
4203
        LD      A,B             ; get line count.
4204
        AND     $07             ; will set zero if all third to be scrolled.
4205
        LD      A,B             ; re-fetch the line count.
4206
        JR      NZ,L0E19        ; forward to CL-SCR-3 if partial scroll.
4207
 
4208
; HL points to top line of third and must be copied to bottom of previous 3rd.
4209
; ( so HL = $4800 or $5000 ) ( but also sometimes $4000 )
4210
 
4211
;; CL-SCR-2
4212
L0E0D:  EX      DE,HL           ; copy HL to DE.
4213
        LD      HL,$F8E0        ; subtract $08 from H and add $E0 to L -
4214
        ADD     HL,DE           ; to make destination bottom line of previous
4215
                                ; third.
4216
        EX      DE,HL           ; restore the source and destination.
4217
        LD      BC,$0020        ; thirty-two bytes are to be copied.
4218
        DEC     A               ; decrement the line count.
4219
        LDIR                    ; copy a pixel line to previous third.
4220
 
4221
;; CL-SCR-3
4222
L0E19:  EX      DE,HL           ; save source in DE.
4223
        LD      HL,$FFE0        ; load the value -32.
4224
        ADD     HL,DE           ; add to form destination in HL.
4225
        EX      DE,HL           ; switch source and destination
4226
        LD      B,A             ; save the count in B.
4227
        AND     $07             ; mask to find count applicable to current
4228
        RRCA                    ; third and
4229
        RRCA                    ; multiply by
4230
        RRCA                    ; thirty two (same as 5 RLCAs)
4231
 
4232
        LD      C,A             ; transfer byte count to C ($E0 at most)
4233
        LD      A,B             ; store line count to A
4234
        LD      B,$00           ; make B zero
4235
        LDIR                    ; copy bytes (BC=0, H incremented, L=0)
4236
        LD      B,$07           ; set B to 7, C is zero.
4237
        ADD     HL,BC           ; add 7 to H to address next third.
4238
        AND     $F8             ; has last third been done ?
4239
        JR      NZ,L0E0D        ; back to CL-SCR-2 if not.
4240
 
4241
        POP     HL              ; restore topmost address.
4242
        INC     H               ; next pixel line down.
4243
        POP     BC              ; restore counts.
4244
        DEC     C               ; reduce pixel line count.
4245
        JR      NZ,L0E05        ; back to CL-SCR-1 if all eight not done.
4246
 
4247
        CALL    L0E88           ; routine CL-ATTR gets address in attributes
4248
                                ; from current 'ninth line', count in BC.
4249
 
4250
        LD      HL,$FFE0        ; set HL to the 16-bit value -32.
4251
        ADD     HL,DE           ; and add to form destination address.
4252
        EX      DE,HL           ; swap source and destination addresses.
4253
        LDIR                    ; copy bytes scrolling the linear attributes.
4254
        LD      B,$01           ; continue to clear the bottom line.
4255
 
4256
; ------------------------------
4257
; THE 'CLEAR TEXT LINES' ROUTINE
4258
; ------------------------------
4259
; This subroutine, called from CL-ALL, CLS-LOWER and AUTO-LIST and above,
4260
; clears text lines at bottom of display.
4261
; The B register holds on entry the number of lines to be cleared 1-24.
4262
 
4263
;; CL-LINE
4264
L0E44:  PUSH    BC              ; save line count
4265
        CALL    L0E9B           ; routine CL-ADDR gets top address
4266
        LD      C,$08           ; there are eight screen lines to a text line.
4267
 
4268
;; CL-LINE-1
4269
L0E4A:  PUSH    BC              ; save pixel line count
4270
        PUSH    HL              ; and save the address
4271
        LD      A,B             ; transfer the line to A (1-24).
4272
 
4273
;; CL-LINE-2
4274
L0E4D:  AND     $07             ; mask 0-7 to consider thirds at a time
4275
        RRCA                    ; multiply
4276
        RRCA                    ; by 32  (same as five RLCA instructions)
4277
        RRCA                    ; now 32 - 256(0)
4278
        LD      C,A             ; store result in C
4279
        LD      A,B             ; save line in A (1-24)
4280
        LD      B,$00           ; set high byte to 0, prepare for ldir.
4281
        DEC     C               ; decrement count 31-255.
4282
        LD      D,H             ; copy HL
4283
        LD      E,L             ; to DE.
4284
        LD      (HL),$00        ; blank the first byte.
4285
        INC     DE              ; make DE point to next byte.
4286
        LDIR                    ; ldir will clear lines.
4287
        LD      DE,$0701        ; now address next third adjusting
4288
        ADD     HL,DE           ; register E to address left hand side
4289
        DEC     A               ; decrease the line count.
4290
        AND     $F8             ; will be 16, 8 or 0  (AND $18 will do).
4291
        LD      B,A             ; transfer count to B.
4292
        JR      NZ,L0E4D        ; back to CL-LINE-2 if 16 or 8 to do
4293
                                ; the next third.
4294
 
4295
        POP     HL              ; restore start address.
4296
        INC     H               ; address next line down.
4297
        POP     BC              ; fetch counts.
4298
        DEC     C               ; decrement pixel line count
4299
        JR      NZ,L0E4A        ; back to CL-LINE-1 till all done.
4300
 
4301
        CALL    L0E88           ; routine CL-ATTR gets attribute address
4302
                                ; in DE and B * 32 in BC.
4303
 
4304
        LD      H,D             ; transfer the address
4305
        LD      L,E             ; to HL.
4306
 
4307
        INC     DE              ; make DE point to next location.
4308
 
4309
        LD      A,($5C8D)       ; fetch ATTR_P - permanent attributes
4310
        BIT     0,(IY+$02)      ; test TV_FLAG  - lower screen in use ?
4311
        JR      Z,L0E80         ; skip to CL-LINE-3 if not.
4312
 
4313
        LD      A,($5C48)       ; else lower screen uses BORDCR as attribute.
4314
 
4315
;; CL-LINE-3
4316
L0E80:  LD      (HL),A          ; put attribute in first byte.
4317
        DEC     BC              ; decrement the counter.
4318
        LDIR                    ; copy bytes to set all attributes.
4319
        POP     BC              ; restore the line $01-$24.
4320
        LD      C,$21           ; make column $21. (No use is made of this)
4321
        RET                     ; return to the calling routine.
4322
 
4323
; ------------------
4324
; Attribute handling
4325
; ------------------
4326
; This subroutine is called from CL-LINE or CL-SCROLL with the HL register
4327
; pointing to the 'ninth' line and H needs to be decremented before or after
4328
; the division. Had it been done first then either present code or that used
4329
; at the start of PO-ATTR could have been used.
4330
; The Spectrum screen arrangement leads to the L register already holding
4331
; the correct value for the attribute file and it is only necessary
4332
; to manipulate H to form the correct colour attribute address.
4333
 
4334
;; CL-ATTR
4335
L0E88:  LD      A,H             ; fetch H to A - $48, $50, or $58.
4336
        RRCA                    ; divide by
4337
        RRCA                    ; eight.
4338
        RRCA                    ; $09, $0A or $0B.
4339
        DEC     A               ; $08, $09 or $0A.
4340
        OR      $50             ; $58, $59 or $5A.
4341
        LD      H,A             ; save high byte of attributes.
4342
 
4343
        EX      DE,HL           ; transfer attribute address to DE
4344
        LD      H,C             ; set H to zero - from last LDIR.
4345
        LD      L,B             ; load L with the line from B.
4346
        ADD     HL,HL           ; multiply
4347
        ADD     HL,HL           ; by
4348
        ADD     HL,HL           ; thirty two
4349
        ADD     HL,HL           ; to give count of attribute
4350
        ADD     HL,HL           ; cells to the end of display.
4351
 
4352
        LD      B,H             ; transfer the result
4353
        LD      C,L             ; to register BC.
4354
 
4355
        RET                     ; return.
4356
 
4357
; -------------------------------
4358
; Handle display with line number
4359
; -------------------------------
4360
; This subroutine is called from four places to calculate the address
4361
; of the start of a screen character line which is supplied in B.
4362
 
4363
;; CL-ADDR
4364
L0E9B:  LD      A,$18           ; reverse the line number
4365
        SUB     B               ; to range $00 - $17.
4366
        LD      D,A             ; save line in D for later.
4367
        RRCA                    ; multiply
4368
        RRCA                    ; by
4369
        RRCA                    ; thirty-two.
4370
 
4371
        AND     $E0             ; mask off low bits to make
4372
        LD      L,A             ; L a multiple of 32.
4373
 
4374
        LD      A,D             ; bring back the line to A.
4375
 
4376
        AND     $18             ; now $00, $08 or $10.
4377
 
4378
        OR      $40             ; add the base address of screen.
4379
 
4380
        LD      H,A             ; HL now has the correct address.
4381
        RET                     ; return.
4382
 
4383
; -------------------
4384
; Handle COPY command
4385
; -------------------
4386
; This command copies the top 176 lines to the ZX Printer
4387
; It is popular to call this from machine code at point
4388
; L0EAF with B holding 192 (and interrupts disabled) for a full-screen
4389
; copy. This particularly applies to 16K Spectrums as time-critical
4390
; machine code routines cannot be written in the first 16K of RAM as
4391
; it is shared with the ULA which has precedence over the Z80 chip.
4392
 
4393
;; COPY
4394
L0EAC:  DI                      ; disable interrupts as this is time-critical.
4395
 
4396
        LD      B,$B0           ; top 176 lines.
4397
L0EAF:  LD      HL,$4000        ; address start of the display file.
4398
 
4399
; now enter a loop to handle each pixel line.
4400
 
4401
;; COPY-1
4402
L0EB2:  PUSH    HL              ; save the screen address.
4403
        PUSH    BC              ; and the line counter.
4404
 
4405
        CALL    L0EF4           ; routine COPY-LINE outputs one line.
4406
 
4407
        POP     BC              ; restore the line counter.
4408
        POP     HL              ; and display address.
4409
        INC     H               ; next line down screen within 'thirds'.
4410
        LD      A,H             ; high byte to A.
4411
        AND     $07             ; result will be zero if we have left third.
4412
        JR      NZ,L0EC9        ; forward to COPY-2 if not to continue loop.
4413
 
4414
        LD      A,L             ; consider low byte first.
4415
        ADD     A,$20           ; increase by 32 - sets carry if back to zero.
4416
        LD      L,A             ; will be next group of 8.
4417
        CCF                     ; complement - carry set if more lines in
4418
                                ; the previous third.
4419
        SBC     A,A             ; will be FF, if more, else 00.
4420
        AND     $F8             ; will be F8 (-8) or 00.
4421
        ADD     A,H             ; that is subtract 8, if more to do in third.
4422
        LD      H,A             ; and reset address.
4423
 
4424
;; COPY-2
4425
L0EC9:  DJNZ    L0EB2           ; back to COPY-1 for all lines.
4426
 
4427
        JR      L0EDA           ; forward to COPY-END to switch off the printer
4428
                                ; motor and enable interrupts.
4429
                                ; Note. Nothing else is required.
4430
 
4431
; ------------------------------
4432
; Pass printer buffer to printer
4433
; ------------------------------
4434
; This routine is used to copy 8 text lines from the printer buffer
4435
; to the ZX Printer. These text lines are mapped linearly so HL does
4436
; not need to be adjusted at the end of each line.
4437
 
4438
;; COPY-BUFF
4439
L0ECD:  DI                      ; disable interrupts
4440
        LD      HL,$5B00        ; the base address of the Printer Buffer.
4441
        LD      B,$08           ; set count to 8 lines of 32 bytes.
4442
 
4443
;; COPY-3
4444
L0ED3:  PUSH    BC              ; save counter.
4445
 
4446
        CALL    L0EF4           ; routine COPY-LINE outputs 32 bytes
4447
 
4448
        POP     BC              ; restore counter.
4449
        DJNZ    L0ED3           ; loop back to COPY-3 for all 8 lines.
4450
                                ; then stop motor and clear buffer.
4451
 
4452
; Note. the COPY command rejoins here, essentially to execute the next
4453
; three instructions.
4454
 
4455
;; COPY-END
4456
L0EDA:  LD      A,$04           ; output value 4 to port
4457
        OUT     ($FB),A         ; to stop the slowed printer motor.
4458
        EI                      ; enable interrupts.
4459
 
4460
; --------------------
4461
; Clear Printer Buffer
4462
; --------------------
4463
; This routine clears an arbitrary 256 bytes of memory.
4464
; Note. The routine seems designed to clear a buffer that follows the
4465
; system variables.
4466
; The routine should check a flag or HL address and simply return if COPY
4467
; is in use.
4468
; As a consequence of this omission the buffer will needlessly
4469
; be cleared when COPY is used and the screen/printer position may be set to
4470
; the start of the buffer and the line number to 0 (B)
4471
; giving an 'Out of Screen' error.
4472
; There seems to have been an unsuccessful attempt to circumvent the use
4473
; of PR_CC_hi.
4474
 
4475
;; CLEAR-PRB
4476
L0EDF:  LD      HL,$5B00        ; the location of the buffer.
4477
        LD      (IY+$46),L      ; update PR_CC_lo - set to zero - superfluous.
4478
        XOR     A               ; clear the accumulator.
4479
        LD      B,A             ; set count to 256 bytes.
4480
 
4481
;; PRB-BYTES
4482
L0EE7:  LD      (HL),A          ; set addressed location to zero.
4483
        INC     HL              ; address next byte - Note. not INC L.
4484
        DJNZ    L0EE7           ; back to PRB-BYTES. repeat for 256 bytes.
4485
 
4486
        RES     1,(IY+$30)      ; set FLAGS2 - signal printer buffer is clear.
4487
        LD      C,$21           ; set the column position .
4488
        JP      L0DD9           ; exit via CL-SET and then PO-STORE.
4489
 
4490
; -----------------
4491
; Copy line routine
4492
; -----------------
4493
; This routine is called from COPY and COPY-BUFF to output a line of
4494
; 32 bytes to the ZX Printer.
4495
; Output to port $FB -
4496
; bit 7 set - activate stylus.
4497
; bit 7 low - deactivate stylus.
4498
; bit 2 set - stops printer.
4499
; bit 2 reset - starts printer
4500
; bit 1 set - slows printer.
4501
; bit 1 reset - normal speed.
4502
 
4503
;; COPY-LINE
4504
L0EF4:  LD      A,B             ; fetch the counter 1-8 or 1-176
4505
        CP      $03             ; is it 01 or 02 ?.
4506
        SBC     A,A             ; result is $FF if so else $00.
4507
        AND     $02             ; result is 02 now else 00.
4508
                                ; bit 1 set slows the printer.
4509
        OUT     ($FB),A         ; slow the printer for the
4510
                                ; last two lines.
4511
        LD      D,A             ; save the mask to control the printer later.
4512
 
4513
;; COPY-L-1
4514
L0EFD:  CALL    L1F54           ; call BREAK-KEY to read keyboard immediately.
4515
        JR      C,L0F0C         ; forward to COPY-L-2 if 'break' not pressed.
4516
 
4517
        LD      A,$04           ; else stop the
4518
        OUT     ($FB),A         ; printer motor.
4519
        EI                      ; enable interrupts.
4520
        CALL    L0EDF           ; call routine CLEAR-PRB.
4521
                                ; Note. should not be cleared if COPY in use.
4522
 
4523
;; REPORT-Dc
4524
L0F0A:  RST     08H             ; ERROR-1
4525
        DEFB    $0C             ; Error Report: BREAK - CONT repeats
4526
 
4527
;; COPY-L-2
4528
L0F0C:  IN      A,($FB)         ; test now to see if
4529
        ADD     A,A             ; a printer is attached.
4530
        RET     M               ; return if not - but continue with parent
4531
                                ; command.
4532
 
4533
        JR      NC,L0EFD        ; back to COPY-L-1 if stylus of printer not
4534
                                ; in position.
4535
 
4536
        LD      C,$20           ; set count to 32 bytes.
4537
 
4538
;; COPY-L-3
4539
L0F14:  LD      E,(HL)          ; fetch a byte from line.
4540
        INC     HL              ; address next location. Note. not INC L.
4541
        LD      B,$08           ; count the bits.
4542
 
4543
;; COPY-L-4
4544
L0F18:  RL      D               ; prepare mask to receive bit.
4545
        RL      E               ; rotate leftmost print bit to carry
4546
        RR      D               ; and back to bit 7 of D restoring bit 1
4547
 
4548
;; COPY-L-5
4549
L0F1E:  IN      A,($FB)         ; read the port.
4550
        RRA                     ; bit 0 to carry.
4551
        JR      NC,L0F1E        ; back to COPY-L-5 if stylus not in position.
4552
 
4553
        LD      A,D             ; transfer command bits to A.
4554
        OUT     ($FB),A         ; and output to port.
4555
        DJNZ    L0F18           ; loop back to COPY-L-4 for all 8 bits.
4556
 
4557
        DEC     C               ; decrease the byte count.
4558
        JR      NZ,L0F14        ; back to COPY-L-3 until 256 bits done.
4559
 
4560
        RET                     ; return to calling routine COPY/COPY-BUFF.
4561
 
4562
 
4563
; ----------------------------------
4564
; Editor routine for BASIC and INPUT
4565
; ----------------------------------
4566
; The editor is called to prepare or edit a BASIC line.
4567
; It is also called from INPUT to input a numeric or string expression.
4568
; The behaviour and options are quite different in the various modes
4569
; and distinguished by bit 5 of FLAGX.
4570
;
4571
; This is a compact and highly versatile routine.
4572
 
4573
;; EDITOR
4574
L0F2C:  LD      HL,($5C3D)      ; fetch ERR_SP
4575
        PUSH    HL              ; save on stack
4576
 
4577
;; ED-AGAIN
4578
L0F30:  LD      HL,L107F        ; address: ED-ERROR
4579
        PUSH    HL              ; save address on stack and
4580
        LD      ($5C3D),SP      ; make ERR_SP point to it.
4581
 
4582
; Note. While in editing/input mode should an error occur then RST 08 will
4583
; update X_PTR to the location reached by CH_ADD and jump to ED-ERROR
4584
; where the error will be cancelled and the loop begin again from ED-AGAIN
4585
; above. The position of the error will be apparent when the lower screen is
4586
; reprinted. If no error then the re-iteration is to ED-LOOP below when
4587
; input is arriving from the keyboard.
4588
 
4589
;; ED-LOOP
4590
L0F38:  CALL    L15D4           ; routine WAIT-KEY gets key possibly
4591
                                ; changing the mode.
4592
        PUSH    AF              ; save key.
4593
        LD      D,$00           ; and give a short click based
4594
        LD      E,(IY-$01)      ; on PIP value for duration.
4595
        LD      HL,$00C8        ; and pitch.
4596
        CALL    L03B5           ; routine BEEPER gives click - effective
4597
                                ; with rubber keyboard.
4598
        POP     AF              ; get saved key value.
4599
        LD      HL,L0F38        ; address: ED-LOOP is loaded to HL.
4600
        PUSH    HL              ; and pushed onto stack.
4601
 
4602
; At this point there is a looping return address on the stack, an error
4603
; handler and an input stream set up to supply characters.
4604
; The character that has been received can now be processed.
4605
 
4606
        CP      $18             ; range 24 to 255 ?
4607
        JR      NC,L0F81        ; forward to ADD-CHAR if so.
4608
 
4609
        CP      $07             ; lower than 7 ?
4610
        JR      C,L0F81         ; forward to ADD-CHAR also.
4611
                                ; Note. This is a 'bug' and chr$ 6, the comma
4612
                                ; control character, should have had an
4613
                                ; entry in the ED-KEYS table.
4614
                                ; Steven Vickers, 1984, Pitman.
4615
 
4616
        CP      $10             ; less than 16 ?
4617
        JR      C,L0F92         ; forward to ED-KEYS if editing control
4618
                                ; range 7 to 15 dealt with by a table
4619
 
4620
        LD      BC,$0002        ; prepare for ink/paper etc.
4621
        LD      D,A             ; save character in D
4622
        CP      $16             ; is it ink/paper/bright etc. ?
4623
        JR      C,L0F6C         ; forward to ED-CONTR if so
4624
 
4625
                                ; leaves 22d AT and 23d TAB
4626
                                ; which can't be entered via KEY-INPUT.
4627
                                ; so this code is never normally executed
4628
                                ; when the keyboard is used for input.
4629
 
4630
        INC     BC              ; if it was AT/TAB - 3 locations required
4631
        BIT     7,(IY+$37)      ; test FLAGX  - Is this INPUT LINE ?
4632
        JP      Z,L101E         ; jump to ED-IGNORE if not, else
4633
 
4634
        CALL    L15D4           ; routine WAIT-KEY - input address is KEY-NEXT
4635
                                ; but is reset to KEY-INPUT
4636
        LD      E,A             ; save first in E
4637
 
4638
;; ED-CONTR
4639
L0F6C:  CALL    L15D4           ; routine WAIT-KEY for control.
4640
                                ; input address will be key-next.
4641
 
4642
        PUSH    DE              ; saved code/parameters
4643
        LD      HL,($5C5B)      ; fetch address of keyboard cursor from K_CUR
4644
        RES     0,(IY+$07)      ; set MODE to 'L'
4645
 
4646
        CALL    L1655           ; routine MAKE-ROOM makes 2/3 spaces at cursor
4647
 
4648
        POP     BC              ; restore code/parameters
4649
        INC     HL              ; address first location
4650
        LD      (HL),B          ; place code (ink etc.)
4651
        INC     HL              ; address next
4652
        LD      (HL),C          ; place possible parameter. If only one
4653
                                ; then DE points to this location also.
4654
        JR      L0F8B           ; forward to ADD-CH-1
4655
 
4656
; ------------------------
4657
; Add code to current line
4658
; ------------------------
4659
; this is the branch used to add normal non-control characters
4660
; with ED-LOOP as the stacked return address.
4661
; it is also the OUTPUT service routine for system channel 'R'.
4662
 
4663
;; ADD-CHAR
4664
L0F81:  RES     0,(IY+$07)      ; set MODE to 'L'
4665
 
4666
X0F85:  LD      HL,($5C5B)      ; fetch address of keyboard cursor from K_CUR
4667
 
4668
        CALL    L1652           ; routine ONE-SPACE creates one space.
4669
 
4670
; either a continuation of above or from ED-CONTR with ED-LOOP on stack.
4671
 
4672
;; ADD-CH-1
4673
L0F8B:  LD      (DE),A          ; load current character to last new location.
4674
        INC     DE              ; address next
4675
        LD      ($5C5B),DE      ; and update K_CUR system variable.
4676
        RET                     ; return - either a simple return
4677
                                ; from ADD-CHAR or to ED-LOOP on stack.
4678
 
4679
; ---
4680
 
4681
; a branch of the editing loop to deal with control characters
4682
; using a look-up table.
4683
 
4684
;; ED-KEYS
4685
L0F92:  LD      E,A             ; character to E.
4686
        LD      D,$00           ; prepare to add.
4687
        LD      HL,L0FA0 - 7    ; base address of editing keys table. $0F99
4688
        ADD     HL,DE           ; add E
4689
        LD      E,(HL)          ; fetch offset to E
4690
        ADD     HL,DE           ; add offset for address of handling routine.
4691
        PUSH    HL              ; push the address on machine stack.
4692
        LD      HL,($5C5B)      ; load address of cursor from K_CUR.
4693
        RET                     ; Make an indirect jump forward to routine.
4694
 
4695
; ------------------
4696
; Editing keys table
4697
; ------------------
4698
; For each code in the range $07 to $0F this table contains a
4699
; single offset byte to the routine that services that code.
4700
; Note. for what was intended there should also have been an
4701
; entry for chr$ 6 with offset to ed-symbol.
4702
 
4703
;; ed-keys-t
4704
L0FA0:  DEFB    L0FA9 - $  ; 07d offset $09 to Address: ED-EDIT
4705
        DEFB    L1007 - $  ; 08d offset $66 to Address: ED-LEFT
4706
        DEFB    L100C - $  ; 09d offset $6A to Address: ED-RIGHT
4707
        DEFB    L0FF3 - $  ; 10d offset $50 to Address: ED-DOWN
4708
        DEFB    L1059 - $  ; 11d offset $B5 to Address: ED-UP
4709
        DEFB    L1015 - $  ; 12d offset $70 to Address: ED-DELETE
4710
        DEFB    L1024 - $  ; 13d offset $7E to Address: ED-ENTER
4711
        DEFB    L1076 - $  ; 14d offset $CF to Address: ED-SYMBOL
4712
        DEFB    L107C - $  ; 15d offset $D4 to Address: ED-GRAPH
4713
 
4714
; ---------------
4715
; Handle EDIT key
4716
; ---------------
4717
; The user has pressed SHIFT 1 to bring edit line down to bottom of screen.
4718
; Alternatively the user wishes to clear the input buffer and start again.
4719
; Alternatively ...
4720
 
4721
;; ED-EDIT
4722
L0FA9:  LD      HL,($5C49)      ; fetch E_PPC the last line number entered.
4723
                                ; Note. may not exist and may follow program.
4724
        BIT     5,(IY+$37)      ; test FLAGX  - input mode ?
4725
        JP      NZ,L1097        ; jump forward to CLEAR-SP if not in editor.
4726
 
4727
        CALL    L196E           ; routine LINE-ADDR to find address of line
4728
                                ; or following line if it doesn't exist.
4729
        CALL    L1695           ; routine LINE-NO will get line number from
4730
                                ; address or previous line if at end-marker.
4731
        LD      A,D             ; if there is no program then DE will
4732
        OR      E               ; contain zero so test for this.
4733
        JP      Z,L1097         ; jump to CLEAR-SP if so.
4734
 
4735
; Note. at this point we have a validated line number, not just an
4736
; approximation and it would be best to update E_PPC with the true
4737
; cursor line value which would enable the line cursor to be suppressed
4738
; in all situations - see shortly.
4739
 
4740
        PUSH    HL              ; save address of line.
4741
        INC     HL              ; address low byte of length.
4742
        LD      C,(HL)          ; transfer to C
4743
        INC     HL              ; next to high byte
4744
        LD      B,(HL)          ; transfer to B.
4745
        LD      HL,$000A        ; an overhead of ten bytes
4746
        ADD     HL,BC           ; is added to length.
4747
        LD      B,H             ; transfer adjusted value
4748
        LD      C,L             ; to BC register.
4749
        CALL    L1F05           ; routine TEST-ROOM checks free memory.
4750
        CALL    L1097           ; routine CLEAR-SP clears editing area.
4751
        LD      HL,($5C51)      ; address CURCHL
4752
        EX      (SP),HL         ; swap with line address on stack
4753
        PUSH    HL              ; save line address underneath
4754
 
4755
        LD      A,$FF           ; select system channel 'R'
4756
        CALL    L1601           ; routine CHAN-OPEN opens it
4757
 
4758
        POP     HL              ; drop line address
4759
        DEC     HL              ; make it point to first byte of line num.
4760
        DEC     (IY+$0F)        ; decrease E_PPC_lo to suppress line cursor.
4761
                                ; Note. ineffective when E_PPC is one
4762
                                ; greater than last line of program perhaps
4763
                                ; as a result of a delete.
4764
                                ; credit. Paul Harrison 1982.
4765
 
4766
        CALL    L1855           ; routine OUT-LINE outputs the BASIC line
4767
                                ; to the editing area.
4768
        INC     (IY+$0F)        ; restore E_PPC_lo to the previous value.
4769
        LD      HL,($5C59)      ; address E_LINE in editing area.
4770
        INC     HL              ; advance
4771
        INC     HL              ; past space
4772
        INC     HL              ; and digit characters
4773
        INC     HL              ; of line number.
4774
 
4775
        LD      ($5C5B),HL      ; update K_CUR to address start of BASIC.
4776
        POP     HL              ; restore the address of CURCHL.
4777
        CALL    L1615           ; routine CHAN-FLAG sets flags for it.
4778
 
4779
        RET                     ; RETURN to ED-LOOP.
4780
 
4781
; -------------------
4782
; Cursor down editing
4783
; -------------------
4784
;   The BASIC lines are displayed at the top of the screen and the user
4785
;   wishes to move the cursor down one line in edit mode.
4786
;   With INPUT LINE, this key must be used instead of entering STOP.
4787
 
4788
;; ED-DOWN
4789
L0FF3:  BIT     5,(IY+$37)      ; test FLAGX  - Input Mode ?
4790
        JR      NZ,L1001        ; skip to ED-STOP if so
4791
 
4792
        LD      HL,$5C49        ; address E_PPC - 'current line'
4793
        CALL    L190F           ; routine LN-FETCH fetches number of next
4794
                                ; line or same if at end of program.
4795
        JR      L106E           ; forward to ED-LIST to produce an
4796
                                ; automatic listing.
4797
 
4798
; ---
4799
 
4800
;; ED-STOP
4801
L1001:  LD      (IY+$00),$10    ; set ERR_NR to 'STOP in INPUT' code
4802
        JR      L1024           ; forward to ED-ENTER to produce error.
4803
 
4804
; -------------------
4805
; Cursor left editing
4806
; -------------------
4807
; This acts on the cursor in the lower section of the screen in both
4808
; editing and input mode.
4809
 
4810
;; ED-LEFT
4811
L1007:  CALL    L1031           ; routine ED-EDGE moves left if possible
4812
        JR      L1011           ; forward to ED-CUR to update K-CUR
4813
                                ; and return to ED-LOOP.
4814
 
4815
; --------------------
4816
; Cursor right editing
4817
; --------------------
4818
; This acts on the cursor in the lower screen in both editing and input
4819
; mode and moves it to the right.
4820
 
4821
;; ED-RIGHT
4822
L100C:  LD      A,(HL)          ; fetch addressed character.
4823
        CP      $0D             ; is it carriage return ?
4824
        RET     Z               ; return if so to ED-LOOP
4825
 
4826
        INC     HL              ; address next character
4827
 
4828
;; ED-CUR
4829
L1011:  LD      ($5C5B),HL      ; update K_CUR system variable
4830
        RET                     ; return to ED-LOOP
4831
 
4832
; --------------
4833
; DELETE editing
4834
; --------------
4835
; This acts on the lower screen and deletes the character to left of
4836
; cursor. If control characters are present these are deleted first
4837
; leaving the naked parameter (0-7) which appears as a '?' except in the
4838
; case of chr$ 6 which is the comma control character. It is not mandatory
4839
; to delete these second characters.
4840
 
4841
;; ED-DELETE
4842
L1015:  CALL    L1031           ; routine ED-EDGE moves cursor to left.
4843
        LD      BC,$0001        ; of character to be deleted.
4844
        JP      L19E8           ; to RECLAIM-2 reclaim the character.
4845
 
4846
; ------------------------------------------
4847
; Ignore next 2 codes from key-input routine
4848
; ------------------------------------------
4849
; Since AT and TAB cannot be entered this point is never reached
4850
; from the keyboard. If inputting from a tape device or network then
4851
; the control and two following characters are ignored and processing
4852
; continues as if a carriage return had been received.
4853
; Here, perhaps, another Spectrum has said print #15; AT 0,0; "This is yellow"
4854
; and this one is interpreting input #15; a$.
4855
 
4856
;; ED-IGNORE
4857
L101E:  CALL    L15D4           ; routine WAIT-KEY to ignore keystroke.
4858
        CALL    L15D4           ; routine WAIT-KEY to ignore next key.
4859
 
4860
; -------------
4861
; Enter/newline
4862
; -------------
4863
; The enter key has been pressed to have BASIC line or input accepted.
4864
 
4865
;; ED-ENTER
4866
L1024:  POP     HL              ; discard address ED-LOOP
4867
        POP     HL              ; drop address ED-ERROR
4868
 
4869
;; ED-END
4870
L1026:  POP     HL              ; the previous value of ERR_SP
4871
        LD      ($5C3D),HL      ; is restored to ERR_SP system variable
4872
        BIT     7,(IY+$00)      ; is ERR_NR $FF (= 'OK') ?
4873
        RET     NZ              ; return if so
4874
 
4875
        LD      SP,HL           ; else put error routine on stack
4876
        RET                     ; and make an indirect jump to it.
4877
 
4878
; -----------------------------
4879
; Move cursor left when editing
4880
; -----------------------------
4881
; This routine moves the cursor left. The complication is that it must
4882
; not position the cursor between control codes and their parameters.
4883
; It is further complicated in that it deals with TAB and AT characters
4884
; which are never present from the keyboard.
4885
; The method is to advance from the beginning of the line each time,
4886
; jumping one, two, or three characters as necessary saving the original
4887
; position at each jump in DE. Once it arrives at the cursor then the next
4888
; legitimate leftmost position is in DE.
4889
 
4890
;; ED-EDGE
4891
L1031:  SCF                     ; carry flag must be set to call the nested
4892
        CALL    L1195           ; subroutine SET-DE.
4893
                                ; if input   then DE=WORKSP
4894
                                ; if editing then DE=E_LINE
4895
        SBC     HL,DE           ; subtract address from start of line
4896
        ADD     HL,DE           ; and add back.
4897
        INC     HL              ; adjust for carry.
4898
        POP     BC              ; drop return address
4899
        RET     C               ; return to ED-LOOP if already at left
4900
                                ; of line.
4901
 
4902
        PUSH    BC              ; resave return address - ED-LOOP.
4903
        LD      B,H             ; transfer HL - cursor address
4904
        LD      C,L             ; to BC register pair.
4905
                                ; at this point DE addresses start of line.
4906
 
4907
;; ED-EDGE-1
4908
L103E:  LD      H,D             ; transfer DE - leftmost pointer
4909
        LD      L,E             ; to HL
4910
        INC     HL              ; address next leftmost character to
4911
                                ; advance position each time.
4912
        LD      A,(DE)          ; pick up previous in A
4913
        AND     $F0             ; lose the low bits
4914
        CP      $10             ; is it INK to TAB $10-$1F ?
4915
                                ; that is, is it followed by a parameter ?
4916
        JR      NZ,L1051        ; to ED-EDGE-2 if not
4917
                                ; HL has been incremented once
4918
 
4919
        INC     HL              ; address next as at least one parameter.
4920
 
4921
; in fact since 'tab' and 'at' cannot be entered the next section seems
4922
; superfluous.
4923
; The test will always fail and the jump to ED-EDGE-2 will be taken.
4924
 
4925
        LD      A,(DE)          ; reload leftmost character
4926
        SUB     $17             ; decimal 23 ('tab')
4927
        ADC     A,$00           ; will be 0 for 'tab' and 'at'.
4928
        JR      NZ,L1051        ; forward to ED-EDGE-2 if not
4929
                                ; HL has been incremented twice
4930
 
4931
        INC     HL              ; increment a third time for 'at'/'tab'
4932
 
4933
;; ED-EDGE-2
4934
L1051:  AND     A               ; prepare for true subtraction
4935
        SBC     HL,BC           ; subtract cursor address from pointer
4936
        ADD     HL,BC           ; and add back
4937
                                ; Note when HL matches the cursor position BC,
4938
                                ; there is no carry and the previous
4939
                                ; position is in DE.
4940
        EX      DE,HL           ; transfer result to DE if looping again.
4941
                                ; transfer DE to HL to be used as K-CUR
4942
                                ; if exiting loop.
4943
        JR      C,L103E         ; back to ED-EDGE-1 if cursor not matched.
4944
 
4945
        RET                     ; return.
4946
 
4947
; -----------------
4948
; Cursor up editing
4949
; -----------------
4950
; The main screen displays part of the BASIC program and the user wishes
4951
; to move up one line scrolling if necessary.
4952
; This has no alternative use in input mode.
4953
 
4954
;; ED-UP
4955
L1059:  BIT     5,(IY+$37)      ; test FLAGX  - input mode ?
4956
        RET     NZ              ; return if not in editor - to ED-LOOP.
4957
 
4958
        LD      HL,($5C49)      ; get current line from E_PPC
4959
        CALL    L196E           ; routine LINE-ADDR gets address
4960
        EX      DE,HL           ; and previous in DE
4961
        CALL    L1695           ; routine LINE-NO gets prev line number
4962
        LD      HL,$5C4A        ; set HL to E_PPC_hi as next routine stores
4963
                                ; top first.
4964
        CALL    L191C           ; routine LN-STORE loads DE value to HL
4965
                                ; high byte first - E_PPC_lo takes E
4966
 
4967
; this branch is also taken from ed-down.
4968
 
4969
;; ED-LIST
4970
L106E:  CALL    L1795           ; routine AUTO-LIST lists to upper screen
4971
                                ; including adjusted current line.
4972
        LD      A,$00           ; select lower screen again
4973
        JP      L1601           ; exit via CHAN-OPEN to ED-LOOP
4974
 
4975
; --------------------------------
4976
; Use of symbol and graphics codes
4977
; --------------------------------
4978
; These will not be encountered with the keyboard but would be handled
4979
; otherwise as follows.
4980
; As noted earlier, Vickers says there should have been an entry in
4981
; the KEYS table for chr$ 6 which also pointed here.
4982
; If, for simplicity, two Spectrums were both using #15 as a bi-directional
4983
; channel connected to each other:-
4984
; then when the other Spectrum has said PRINT #15; x, y
4985
; input #15; i ; j  would treat the comma control as a newline and the
4986
; control would skip to input j.
4987
; You can get round the missing chr$ 6 handler by sending multiple print
4988
; items separated by a newline '.
4989
 
4990
; chr$14 would have the same functionality.
4991
 
4992
; This is chr$ 14.
4993
;; ED-SYMBOL
4994
L1076:  BIT     7,(IY+$37)      ; test FLAGX - is this INPUT LINE ?
4995
        JR      Z,L1024         ; back to ED-ENTER if not to treat as if
4996
                                ; enter had been pressed.
4997
                                ; else continue and add code to buffer.
4998
 
4999
; Next is chr$ 15
5000
; Note that ADD-CHAR precedes the table so we can't offset to it directly.
5001
 
5002
;; ED-GRAPH
5003
L107C:  JP      L0F81           ; jump back to ADD-CHAR
5004
 
5005
; --------------------
5006
; Editor error routine
5007
; --------------------
5008
; If an error occurs while editing, or inputting, then ERR_SP
5009
; points to the stack location holding address ED_ERROR.
5010
 
5011
;; ED-ERROR
5012
L107F:  BIT     4,(IY+$30)      ; test FLAGS2  - is K channel in use ?
5013
        JR      Z,L1026         ; back to ED-END if not.
5014
 
5015
; but as long as we're editing lines or inputting from the keyboard, then
5016
; we've run out of memory so give a short rasp.
5017
 
5018
        LD      (IY+$00),$FF    ; reset ERR_NR to 'OK'.
5019
        LD      D,$00           ; prepare for beeper.
5020
        LD      E,(IY-$02)      ; use RASP value.
5021
        LD      HL,$1A90        ; set the pitch - or tone period.
5022
        CALL    L03B5           ; routine BEEPER emits a warning rasp.
5023
        JP      L0F30           ; to ED-AGAIN to re-stack address of
5024
                                ; this routine and make ERR_SP point to it.
5025
 
5026
; ---------------------
5027
; Clear edit/work space
5028
; ---------------------
5029
; The editing area or workspace is cleared depending on context.
5030
; This is called from ED-EDIT to clear workspace if edit key is
5031
; used during input, to clear editing area if no program exists
5032
; and to clear editing area prior to copying the edit line to it.
5033
; It is also used by the error routine to clear the respective
5034
; area depending on FLAGX.
5035
 
5036
;; CLEAR-SP
5037
L1097:  PUSH    HL              ; preserve HL
5038
        CALL    L1190           ; routine SET-HL
5039
                                ; if in edit   HL = WORKSP-1, DE = E_LINE
5040
                                ; if in input  HL = STKBOT,   DE = WORKSP
5041
        DEC     HL              ; adjust
5042
        CALL    L19E5           ; routine RECLAIM-1 reclaims space
5043
        LD      ($5C5B),HL      ; set K_CUR to start of empty area
5044
        LD      (IY+$07),$00    ; set MODE to 'KLC'
5045
        POP     HL              ; restore HL.
5046
        RET                     ; return.
5047
 
5048
; ----------------------------
5049
; THE 'KEYBOARD INPUT' ROUTINE
5050
; ----------------------------
5051
; This is the service routine for the input stream of the keyboard channel 'K'.
5052
 
5053
;; KEY-INPUT
5054
L10A8:  BIT     3,(IY+$02)      ; test TV_FLAG  - has a key been pressed in
5055
                                ; editor ?
5056
 
5057
        CALL    NZ,L111D        ; routine ED-COPY, if so, to reprint the lower
5058
                                ; screen at every keystroke/mode change.
5059
 
5060
        AND     A               ; clear carry flag - required exit condition.
5061
 
5062
        BIT     5,(IY+$01)      ; test FLAGS  - has a new key been pressed ?
5063
        RET     Z               ; return if not.                        >>
5064
 
5065
        LD      A,($5C08)       ; system variable LASTK will hold last key -
5066
                                ; from the interrupt routine.
5067
 
5068
        RES     5,(IY+$01)      ; update FLAGS  - reset the new key flag.
5069
        PUSH    AF              ; save the input character.
5070
 
5071
        BIT     5,(IY+$02)      ; test TV_FLAG  - clear lower screen ?
5072
 
5073
        CALL    NZ,L0D6E        ; routine CLS-LOWER if so.
5074
 
5075
        POP     AF              ; restore the character code.
5076
 
5077
        CP      $20             ; if space or higher then
5078
        JR      NC,L111B        ; forward to KEY-DONE2 and return with carry
5079
                                ; set to signal key-found.
5080
 
5081
        CP      $10             ; with 16d INK and higher skip
5082
        JR      NC,L10FA        ; forward to KEY-CONTR.
5083
 
5084
        CP      $06             ; for 6 - 15d
5085
        JR      NC,L10DB        ; skip forward to KEY-M-CL to handle Modes
5086
                                ; and CapsLock.
5087
 
5088
; that only leaves 0-5, the flash bright inverse switches.
5089
 
5090
        LD      B,A             ; save character in B
5091
        AND     $01             ; isolate the embedded parameter (0/1).
5092
        LD      C,A             ; and store in C
5093
        LD      A,B             ; re-fetch copy (0-5)
5094
        RRA                     ; halve it 0, 1 or 2.
5095
        ADD     A,$12           ; add 18d gives 'flash', 'bright'
5096
                                ; and 'inverse'.
5097
        JR      L1105           ; forward to KEY-DATA with the
5098
                                ; parameter (0/1) in C.
5099
 
5100
; ---
5101
 
5102
; Now separate capslock 06 from modes 7-15.
5103
 
5104
;; KEY-M-CL
5105
L10DB:  JR      NZ,L10E6        ; forward to KEY-MODE if not 06 (capslock)
5106
 
5107
        LD      HL,$5C6A        ; point to FLAGS2
5108
        LD      A,$08           ; value 00001000
5109
        XOR     (HL)            ; toggle BIT 3 of FLAGS2 the capslock bit
5110
        LD      (HL),A          ; and store result in FLAGS2 again.
5111
        JR      L10F4           ; forward to KEY-FLAG to signal no-key.
5112
 
5113
; ---
5114
 
5115
;; KEY-MODE
5116
L10E6:  CP      $0E             ; compare with chr 14d
5117
        RET     C               ; return with carry set "key found" for
5118
                                ; codes 7 - 13d leaving 14d and 15d
5119
                                ; which are converted to mode codes.
5120
 
5121
        SUB     $0D             ; subtract 13d leaving 1 and 2
5122
                                ; 1 is 'E' mode, 2 is 'G' mode.
5123
        LD      HL,$5C41        ; address the MODE system variable.
5124
        CP      (HL)            ; compare with existing value before
5125
        LD      (HL),A          ; inserting the new value.
5126
        JR      NZ,L10F4        ; forward to KEY-FLAG if it has changed.
5127
 
5128
        LD      (HL),$00        ; else make MODE zero - KLC mode
5129
                                ; Note. while in Extended/Graphics mode,
5130
                                ; the Extended Mode/Graphics key is pressed
5131
                                ; again to get out.
5132
 
5133
;; KEY-FLAG
5134
L10F4:  SET     3,(IY+$02)      ; update TV_FLAG  - show key state has changed
5135
        CP      A               ; clear carry and reset zero flags -
5136
                                ; no actual key returned.
5137
        RET                     ; make the return.
5138
 
5139
; ---
5140
 
5141
; now deal with colour controls - 16-23 ink, 24-31 paper
5142
 
5143
;; KEY-CONTR
5144
L10FA:  LD      B,A             ; make a copy of character.
5145
        AND     $07             ; mask to leave bits 0-7
5146
        LD      C,A             ; and store in C.
5147
        LD      A,$10           ; initialize to 16d - INK.
5148
        BIT     3,B             ; was it paper ?
5149
        JR      NZ,L1105        ; forward to KEY-DATA with INK 16d and
5150
                                ; colour in C.
5151
 
5152
        INC     A               ; else change from INK to PAPER (17d) if so.
5153
 
5154
;; KEY-DATA
5155
L1105:  LD      (IY-$2D),C      ; put the colour (0-7)/state(0/1) in KDATA
5156
        LD      DE,L110D        ; address: KEY-NEXT will be next input stream
5157
        JR      L1113           ; forward to KEY-CHAN to change it ...
5158
 
5159
; ---
5160
 
5161
; ... so that INPUT_AD directs control to here at next call to WAIT-KEY
5162
 
5163
;; KEY-NEXT
5164
L110D:  LD      A,($5C0D)       ; pick up the parameter stored in KDATA.
5165
        LD      DE,L10A8        ; address: KEY-INPUT will be next input stream
5166
                                ; continue to restore default channel and
5167
                                ; make a return with the control code.
5168
 
5169
;; KEY-CHAN
5170
L1113:  LD      HL,($5C4F)      ; address start of CHANNELS area using CHANS
5171
                                ; system variable.
5172
                                ; Note. One might have expected CURCHL to
5173
                                ; have been used.
5174
        INC     HL              ; step over the
5175
        INC     HL              ; output address
5176
        LD      (HL),E          ; and update the input
5177
        INC     HL              ; routine address for
5178
        LD      (HL),D          ; the next call to WAIT-KEY.
5179
 
5180
;; KEY-DONE2
5181
L111B:  SCF                     ; set carry flag to show a key has been found
5182
        RET                     ; and return.
5183
 
5184
; --------------------
5185
; Lower screen copying
5186
; --------------------
5187
; This subroutine is called whenever the line in the editing area or
5188
; input workspace is required to be printed to the lower screen.
5189
; It is by calling this routine after any change that the cursor, for
5190
; instance, appears to move to the left.
5191
; Remember the edit line will contain characters and tokens
5192
; e.g. "1000 LET a=1" is 8 characters.
5193
 
5194
;; ED-COPY
5195
L111D:  CALL    L0D4D           ; routine TEMPS sets temporary attributes.
5196
        RES     3,(IY+$02)      ; update TV_FLAG  - signal no change in mode
5197
        RES     5,(IY+$02)      ; update TV_FLAG  - signal don't clear lower
5198
                                ; screen.
5199
        LD      HL,($5C8A)      ; fetch SPOSNL
5200
        PUSH    HL              ; and save on stack.
5201
 
5202
        LD      HL,($5C3D)      ; fetch ERR_SP
5203
        PUSH    HL              ; and save also
5204
        LD      HL,L1167        ; address: ED-FULL
5205
        PUSH    HL              ; is pushed as the error routine
5206
        LD      ($5C3D),SP      ; and ERR_SP made to point to it.
5207
 
5208
        LD      HL,($5C82)      ; fetch ECHO_E
5209
        PUSH    HL              ; and push also
5210
 
5211
        SCF                     ; set carry flag to control SET-DE
5212
        CALL    L1195           ; call routine SET-DE
5213
                                ; if in input DE = WORKSP
5214
                                ; if in edit  DE = E_LINE
5215
        EX      DE,HL           ; start address to HL
5216
 
5217
        CALL    L187D           ; routine OUT-LINE2 outputs entire line up to
5218
                                ; carriage return including initial
5219
                                ; characterized line number when present.
5220
        EX      DE,HL           ; transfer new address to DE
5221
        CALL    L18E1           ; routine OUT-CURS considers a
5222
                                ; terminating cursor.
5223
 
5224
        LD      HL,($5C8A)      ; fetch updated SPOSNL
5225
        EX      (SP),HL         ; exchange with ECHO_E on stack
5226
        EX      DE,HL           ; transfer ECHO_E to DE
5227
        CALL    L0D4D           ; routine TEMPS to re-set attributes
5228
                                ; if altered.
5229
 
5230
; the lower screen was not cleared, at the outset, so if deleting then old
5231
; text from a previous print may follow this line and requires blanking.
5232
 
5233
;; ED-BLANK
5234
L1150:  LD      A,($5C8B)       ; fetch SPOSNL_hi is current line
5235
        SUB     D               ; compare with old
5236
        JR      C,L117C         ; forward to ED-C-DONE if no blanking
5237
 
5238
        JR      NZ,L115E        ; forward to ED-SPACES if line has changed
5239
 
5240
        LD      A,E             ; old column to A
5241
        SUB     (IY+$50)        ; subtract new in SPOSNL_lo
5242
        JR      NC,L117C        ; forward to ED-C-DONE if no backfilling.
5243
 
5244
;; ED-SPACES
5245
L115E:  LD      A,$20           ; prepare a space.
5246
        PUSH    DE              ; save old line/column.
5247
        CALL    L09F4           ; routine PRINT-OUT prints a space over
5248
                                ; any text from previous print.
5249
                                ; Note. Since the blanking only occurs when
5250
                                ; using $09F4 to print to the lower screen,
5251
                                ; there is no need to vector via a RST 10
5252
                                ; and we can use this alternate set.
5253
        POP     DE              ; restore the old line column.
5254
        JR      L1150           ; back to ED-BLANK until all old text blanked.
5255
 
5256
; -------------------------------
5257
; THE 'EDITOR-FULL' ERROR ROUTINE
5258
; -------------------------------
5259
;   This is the error routine addressed by ERR_SP.  This is not for the out of
5260
;   memory situation as we're just printing.  The pitch and duration are exactly
5261
;   the same as used by ED-ERROR from which this has been augmented.  The
5262
;   situation is that the lower screen is full and a rasp is given to suggest
5263
;   that this is perhaps not the best idea you've had that day.
5264
 
5265
;; ED-FULL
5266
L1167:  LD      D,$00           ; prepare to moan.
5267
        LD      E,(IY-$02)      ; fetch RASP value.
5268
        LD      HL,$1A90        ; set pitch or tone period.
5269
 
5270
        CALL    L03B5           ; routine BEEPER.
5271
 
5272
        LD      (IY+$00),$FF    ; clear ERR_NR.
5273
        LD      DE,($5C8A)      ; fetch SPOSNL.
5274
        JR      L117E           ; forward to ED-C-END
5275
 
5276
; -------
5277
 
5278
; the exit point from line printing continues here.
5279
 
5280
;; ED-C-DONE
5281
L117C:  POP     DE              ; fetch new line/column.
5282
        POP     HL              ; fetch the error address.
5283
 
5284
; the error path rejoins here.
5285
 
5286
;; ED-C-END
5287
L117E:  POP     HL              ; restore the old value of ERR_SP.
5288
        LD      ($5C3D),HL      ; update the system variable ERR_SP
5289
 
5290
        POP     BC              ; old value of SPOSN_L
5291
        PUSH    DE              ; save new value
5292
 
5293
        CALL    L0DD9           ; routine CL-SET and PO-STORE
5294
                                ; update ECHO_E and SPOSN_L from BC
5295
 
5296
        POP     HL              ; restore new value
5297
        LD      ($5C82),HL      ; and overwrite ECHO_E
5298
 
5299
        LD      (IY+$26),$00    ; make error pointer X_PTR_hi out of bounds
5300
 
5301
        RET                     ; return
5302
 
5303
; -----------------------------------------------
5304
; Point to first and last locations of work space
5305
; -----------------------------------------------
5306
;   These two nested routines ensure that the appropriate pointers are
5307
;   selected for the editing area or workspace. The routines that call
5308
;   these routines are designed to work on either area.
5309
 
5310
; this routine is called once
5311
 
5312
;; SET-HL
5313
L1190:  LD      HL,($5C61)      ; fetch WORKSP to HL.
5314
        DEC     HL              ; point to last location of editing area.
5315
        AND     A               ; clear carry to limit exit points to first
5316
                                ; or last.
5317
 
5318
; this routine is called with carry set and exits at a conditional return.
5319
 
5320
;; SET-DE
5321
L1195:  LD      DE,($5C59)      ; fetch E_LINE to DE
5322
        BIT     5,(IY+$37)      ; test FLAGX  - Input Mode ?
5323
        RET     Z               ; return now if in editing mode
5324
 
5325
        LD      DE,($5C61)      ; fetch WORKSP to DE
5326
        RET     C               ; return if carry set ( entry = set-de)
5327
 
5328
        LD      HL,($5C63)      ; fetch STKBOT to HL as well
5329
        RET                     ; and return  (entry = set-hl (in input))
5330
 
5331
; -----------------------------------
5332
; THE 'REMOVE FLOATING POINT' ROUTINE
5333
; -----------------------------------
5334
;   When a BASIC LINE or the INPUT BUFFER is parsed any numbers will have
5335
;   an invisible chr 14d inserted after them and the 5-byte integer or
5336
;   floating point form inserted after that.  Similar invisible value holders
5337
;   are also created after the numeric and string variables in a DEF FN list.
5338
;   This routine removes these 'compiled' numbers from the edit line or
5339
;   input workspace.
5340
 
5341
;; REMOVE-FP
5342
L11A7:  LD      A,(HL)          ; fetch character
5343
        CP      $0E             ; is it the CHR$ 14 number marker ?
5344
        LD      BC,$0006        ; prepare to strip six bytes
5345
 
5346
        CALL    Z,L19E8         ; routine RECLAIM-2 reclaims bytes if CHR$ 14.
5347
 
5348
        LD      A,(HL)          ; reload next (or same) character
5349
        INC     HL              ; and advance address
5350
        CP      $0D             ; end of line or input buffer ?
5351
        JR      NZ,L11A7        ; back to REMOVE-FP until entire line done.
5352
 
5353
        RET                     ; return.
5354
 
5355
 
5356
; *********************************
5357
; ** Part 6. EXECUTIVE ROUTINES  **
5358
; *********************************
5359
 
5360
 
5361
; The memory.
5362
;
5363
; +---------+-----------+------------+--------------+-------------+--
5364
; | BASIC   |  Display  | Attributes | ZX Printer   |    System   |
5365
; |  ROM    |   File    |    File    |   Buffer     |  Variables  |
5366
; +---------+-----------+------------+--------------+-------------+--
5367
; ^         ^           ^            ^              ^             ^
5368
; $0000   $4000       $5800        $5B00          $5C00         $5CB6 = CHANS
5369
;
5370
;
5371
;  --+----------+---+---------+-----------+---+------------+--+---+--
5372
;    | Channel  |$80|  BASIC  | Variables |$80| Edit Line  |NL|$80|
5373
;    |   Info   |   | Program |   Area    |   | or Command |  |   |
5374
;  --+----------+---+---------+-----------+---+------------+--+---+--
5375
;    ^              ^         ^               ^                   ^
5376
;  CHANS           PROG      VARS           E_LINE              WORKSP
5377
;
5378
;
5379
;                             ---5-->         <---2---  <--3---
5380
;  --+-------+--+------------+-------+-------+---------+-------+-+---+------+
5381
;    | INPUT |NL| Temporary  | Calc. | Spare | Machine | GOSUB |?|$3E| UDGs |
5382
;    | data  |  | Work Space | Stack |       |  Stack  | Stack | |   |      |
5383
;  --+-------+--+------------+-------+-------+---------+-------+-+---+------+
5384
;    ^                       ^       ^       ^                   ^   ^      ^
5385
;  WORKSP                  STKBOT  STKEND   sp               RAMTOP UDG  P_RAMT
5386
;
5387
 
5388
; -----------------
5389
; THE 'NEW' COMMAND
5390
; -----------------
5391
;   The NEW command is about to set all RAM below RAMTOP to zero and then
5392
;   re-initialize the system.  All RAM above RAMTOP should, and will be,
5393
;   preserved.
5394
;   There is nowhere to store values in RAM or on the stack which becomes
5395
;   inoperable. Similarly PUSH and CALL instructions cannot be used to store
5396
;   values or section common code. The alternate register set is the only place
5397
;   available to store 3 persistent 16-bit system variables.
5398
 
5399
;; NEW
5400
L11B7:  DI                      ; Disable Interrupts - machine stack will be
5401
                                ; cleared.
5402
        LD      A,$FF           ; Flag coming from NEW.
5403
        LD      DE,($5CB2)      ; Fetch RAMTOP as top value.
5404
        EXX                     ; Switch in alternate set.
5405
        LD      BC,($5CB4)      ; Fetch P-RAMT differs on 16K/48K machines.
5406
        LD      DE,($5C38)      ; Fetch RASP/PIP.
5407
        LD      HL,($5C7B)      ; Fetch UDG    differs on 16K/48K machines.
5408
        EXX                     ; Switch back to main set and continue into...
5409
 
5410
; ----------------------
5411
; THE 'START-NEW' BRANCH
5412
; ----------------------
5413
;   This branch is taken from above and from RST 00h.
5414
;   The common code tests RAM and sets it to zero re-initializing all the
5415
;   non-zero system variables and channel information.  The A register flags
5416
;   if coming from START or NEW.
5417
 
5418
;; START-NEW
5419
L11CB:  LD      B,A             ; Save the flag to control later branching.
5420
 
5421
        LD      A,$07           ; Select a white border
5422
        OUT     ($FE),A         ; and set it now by writing to a port.
5423
 
5424
        LD      A,$3F           ; Load the accumulator with last page in ROM.
5425
        LD      I,A             ; Set the I register - this remains constant
5426
                                ; and can't be in the range $40 - $7F as 'snow'
5427
                                ; appears on the screen.
5428
 
5429
        LD      HL, NMI_VECT    ; Initialize the NMI jump vector
5430
        LD      ($5CB0), HL
5431
        ;NOP                     ; These seem unnecessary.
5432
        ;NOP                     ; Note: They are a placeholder for the two
5433
        ;NOP                     ; instructions above that initialize NMI junp.
5434
        ;NOP                     ; This way the rest of the code is not moved.
5435
        ;NOP                     ;
5436
        ;NOP                     ;
5437
 
5438
; -----------------------
5439
; THE 'RAM CHECK' SECTION
5440
; -----------------------
5441
;   Typically, a Spectrum will have 16K or 48K of RAM and this code will test
5442
;   it all till it finds an unpopulated location or, less likely, a faulty
5443
;   location.  Usually it stops when it reaches the top $FFFF, or in the case
5444
;   of NEW the supplied top value.  The entire screen turns black with
5445
;   sometimes red stripes on black paper just visible.
5446
 
5447
;; ram-check
5448
L11DA:  LD      H,D             ; Transfer the top value to the HL register
5449
        LD      L,E             ; pair.
5450
 
5451
;; RAM-FILL
5452
L11DC:  LD      (HL),$02        ; Load memory with $02 - red ink on black paper.
5453
        DEC     HL              ; Decrement memory address.
5454
        CP      H               ; Have we reached ROM - $3F ?
5455
        JR      NZ,L11DC        ; Back to RAM-FILL if not.
5456
 
5457
;; RAM-READ
5458
L11E2:  AND     A               ; Clear carry - prepare to subtract.
5459
        SBC     HL,DE           ; subtract and add back setting
5460
        ADD     HL,DE           ; carry when back at start.
5461
        INC     HL              ; and increment for next iteration.
5462
        JR      NC,L11EF        ; forward to RAM-DONE if we've got back to
5463
                                ; starting point with no errors.
5464
 
5465
        DEC     (HL)            ; decrement to 1.
5466
        JR      Z,L11EF         ; forward to RAM-DONE if faulty.
5467
 
5468
        DEC     (HL)            ; decrement to zero.
5469
        JR      Z,L11E2         ; back to RAM-READ if zero flag was set.
5470
 
5471
;; RAM-DONE
5472
L11EF:  DEC     HL              ; step back to last valid location.
5473
        EXX                     ; regardless of state, set up possibly
5474
                                ; stored system variables in case from NEW.
5475
        LD      ($5CB4),BC      ; insert P-RAMT.
5476
        LD      ($5C38),DE      ; insert RASP/PIP.
5477
        LD      ($5C7B),HL      ; insert UDG.
5478
        EXX                     ; switch in main set.
5479
        INC     B               ; now test if we arrived here from NEW.
5480
        JR      Z,L1219         ; forward to RAM-SET if we did.
5481
 
5482
;   This section applies to START only.
5483
 
5484
        LD      ($5CB4),HL      ; set P-RAMT to the highest working RAM
5485
                                ; address.
5486
        LD      DE,$3EAF        ; address of last byte of 'U' bitmap in ROM.
5487
        LD      BC,$00A8        ; there are 21 user defined graphics.
5488
        EX      DE,HL           ; switch pointers and make the UDGs a
5489
        LDDR                    ; copy of the standard characters A - U.
5490
        EX      DE,HL           ; switch the pointer to HL.
5491
        INC     HL              ; update to start of 'A' in RAM.
5492
        LD      ($5C7B),HL      ; make UDG system variable address the first
5493
                                ; bitmap.
5494
        DEC     HL              ; point at RAMTOP again.
5495
 
5496
        LD      BC,$0040        ; set the values of
5497
        LD      ($5C38),BC      ; the PIP and RASP system variables.
5498
 
5499
;   The NEW command path rejoins here.
5500
 
5501
;; RAM-SET
5502
L1219:  LD      ($5CB2),HL      ; set system variable RAMTOP to HL.
5503
 
5504
;
5505
;   Note. this entry point is a disabled Warm Restart that was almost certainly
5506
;   once pointed to by the System Variable NMIADD.  It would be essential that
5507
;   any NMI Handler would perform the tasks from here to the EI instruction
5508
;   below.
5509
 
5510
NMI_VECT:
5511
L121C:
5512
        LD      HL,$3C00        ; a strange place to set the pointer to the
5513
        LD      ($5C36),HL      ; character set, CHARS - as no printing yet.
5514
 
5515
        LD      HL,($5CB2)      ; fetch RAMTOP to HL again as we've lost it.
5516
 
5517
        LD      (HL),$3E        ; top of user ram holds GOSUB end marker
5518
                                ; an impossible line number - see RETURN.
5519
                                ; no significance in the number $3E. It has
5520
                                ; been traditional since the ZX80.
5521
 
5522
        DEC     HL              ; followed by empty byte (not important).
5523
        LD      SP,HL           ; set up the machine stack pointer.
5524
        DEC     HL              ;
5525
        DEC     HL              ;
5526
        LD      ($5C3D),HL      ; ERR_SP is where the error pointer is
5527
                                ; at moment empty - will take address MAIN-4
5528
                                ; at the call preceding that address,
5529
                                ; although interrupts and calls will make use
5530
                                ; of this location in meantime.
5531
 
5532
        IM      1               ; select interrupt mode 1.
5533
 
5534
        LD      IY,$5C3A        ; set IY to ERR_NR. IY can reach all standard
5535
                                ; system variables but shadow ROM system
5536
                                ; variables will be mostly out of range.
5537
 
5538
        EI                      ; enable interrupts now that we have a stack.
5539
 
5540
;   If, as suggested above, the NMI service routine pointed to this section of
5541
;   code then a decision would have to be made at this point to jump forward,
5542
;   in a Warm Restart scenario, to produce a report code, leaving any program
5543
;   intact.
5544
 
5545
        LD      HL,$5CB6        ; The address of the channels - initially
5546
                                ; following system variables.
5547
        LD      ($5C4F),HL      ; Set the CHANS system variable.
5548
 
5549
        LD      DE,L15AF        ; Address: init-chan in ROM.
5550
        LD      BC,$0015        ; There are 21 bytes of initial data in ROM.
5551
        EX      DE,HL           ; swap the pointers.
5552
        LDIR                    ; Copy the bytes to RAM.
5553
 
5554
        EX      DE,HL           ; Swap pointers. HL points to program area.
5555
        DEC     HL              ; Decrement address.
5556
        LD      ($5C57),HL      ; Set DATADD to location before program area.
5557
        INC     HL              ; Increment again.
5558
 
5559
        LD      ($5C53),HL      ; Set PROG the location where BASIC starts.
5560
        LD      ($5C4B),HL      ; Set VARS to same location with a
5561
        LD      (HL),$80        ; variables end-marker.
5562
        INC     HL              ; Advance address.
5563
        LD      ($5C59),HL      ; Set E_LINE, where the edit line
5564
                                ; will be created.
5565
                                ; Note. it is not strictly necessary to
5566
                                ; execute the next fifteen bytes of code
5567
                                ; as this will be done by the call to SET-MIN.
5568
                                ; --
5569
        LD      (HL),$0D        ; initially just has a carriage return
5570
        INC     HL              ; followed by
5571
        LD      (HL),$80        ; an end-marker.
5572
        INC     HL              ; address the next location.
5573
        LD      ($5C61),HL      ; set WORKSP - empty workspace.
5574
        LD      ($5C63),HL      ; set STKBOT - bottom of the empty stack.
5575
        LD      ($5C65),HL      ; set STKEND to the end of the empty stack.
5576
                                ; --
5577
        LD      A,$38           ; the colour system is set to white paper,
5578
                                ; black ink, no flash or bright.
5579
        LD      ($5C8D),A       ; set ATTR_P permanent colour attributes.
5580
        LD      ($5C8F),A       ; set ATTR_T temporary colour attributes.
5581
        LD      ($5C48),A       ; set BORDCR the border colour/lower screen
5582
                                ; attributes.
5583
 
5584
        LD      HL,$0523        ; The keyboard repeat and delay values are
5585
        LD      ($5C09),HL      ; loaded to REPDEL and REPPER.
5586
 
5587
        DEC     (IY-$3A)        ; set KSTATE-0 to $FF - keyboard map available.
5588
        DEC     (IY-$36)        ; set KSTATE-4 to $FF - keyboard map available.
5589
 
5590
        LD      HL,L15C6        ; set source to ROM Address: init-strm
5591
        LD      DE,$5C10        ; set destination to system variable STRMS-FD
5592
        LD      BC,$000E        ; copy the 14 bytes of initial 7 streams data
5593
        LDIR                    ; from ROM to RAM.
5594
 
5595
        SET     1,(IY+$01)      ; update FLAGS  - signal printer in use.
5596
        CALL    L0EDF           ; call routine CLEAR-PRB to initialize system
5597
                                ; variables associated with printer.
5598
                                ; The buffer is clear.
5599
 
5600
        LD      (IY+$31),$02    ; set DF_SZ the lower screen display size to
5601
                                ; two lines
5602
        CALL    L0D6B           ; call routine CLS to set up system
5603
                                ; variables associated with screen and clear
5604
                                ; the screen and set attributes.
5605
        XOR     A               ; clear accumulator so that we can address
5606
        LD      DE,L1539 - 1    ; the message table directly.
5607
        CALL    L0C0A           ; routine PO-MSG puts
5608
                                ; ' ©  1982 Sinclair Research Ltd'
5609
                                ; at bottom of display.
5610
        SET     5,(IY+$02)      ; update TV_FLAG  - signal lower screen will
5611
                                ; require clearing.
5612
 
5613
        JR      L12A9           ; forward to MAIN-1
5614
 
5615
; -------------------------
5616
; THE 'MAIN EXECUTION LOOP'
5617
; -------------------------
5618
;
5619
;
5620
 
5621
;; MAIN-EXEC
5622
L12A2:  LD      (IY+$31),$02    ; set DF_SZ lower screen display file size to
5623
                                ; two lines.
5624
        CALL    L1795           ; routine AUTO-LIST
5625
 
5626
;; MAIN-1
5627
L12A9:  CALL    L16B0           ; routine SET-MIN clears work areas.
5628
 
5629
;; MAIN-2
5630
L12AC:  LD      A,$00           ; select channel 'K' the keyboard
5631
 
5632
        CALL    L1601           ; routine CHAN-OPEN opens it
5633
 
5634
        CALL    L0F2C           ; routine EDITOR is called.
5635
                                ; Note the above routine is where the Spectrum
5636
                                ; waits for user-interaction. Perhaps the
5637
                                ; most common input at this stage
5638
                                ; is LOAD "".
5639
 
5640
        CALL    L1B17           ; routine LINE-SCAN scans the input.
5641
 
5642
        BIT     7,(IY+$00)      ; test ERR_NR - will be $FF if syntax is OK.
5643
        JR      NZ,L12CF        ; forward, if correct, to MAIN-3.
5644
 
5645
;
5646
 
5647
        BIT     4,(IY+$30)      ; test FLAGS2 - K channel in use ?
5648
        JR      Z,L1303         ; forward to MAIN-4 if not.
5649
 
5650
;
5651
 
5652
        LD      HL,($5C59)      ; an editing error so address E_LINE.
5653
        CALL    L11A7           ; routine REMOVE-FP removes the hidden
5654
                                ; floating-point forms.
5655
        LD      (IY+$00),$FF    ; system variable ERR_NR is reset to 'OK'.
5656
        JR      L12AC           ; back to MAIN-2 to allow user to correct.
5657
 
5658
; ---
5659
 
5660
; the branch was here if syntax has passed test.
5661
 
5662
;; MAIN-3
5663
L12CF:  LD      HL,($5C59)      ; fetch the edit line address from E_LINE.
5664
 
5665
        LD      ($5C5D),HL      ; system variable CH_ADD is set to first
5666
                                ; character of edit line.
5667
                                ; Note. the above two instructions are a little
5668
                                ; inadequate.
5669
                                ; They are repeated with a subtle difference
5670
                                ; at the start of the next subroutine and are
5671
                                ; therefore not required above.
5672
 
5673
        CALL    L19FB           ; routine E-LINE-NO will fetch any line
5674
                                ; number to BC if this is a program line.
5675
 
5676
        LD      A,B             ; test if the number of
5677
        OR      C               ; the line is non-zero.
5678
        JP      NZ,L155D        ; jump forward to MAIN-ADD if so to add the
5679
                                ; line to the BASIC program.
5680
 
5681
; Has the user just pressed the ENTER key ?
5682
 
5683
        RST     18H             ; GET-CHAR gets character addressed by CH_ADD.
5684
        CP      $0D             ; is it a carriage return ?
5685
        JR      Z,L12A2         ; back to MAIN-EXEC if so for an automatic
5686
                                ; listing.
5687
 
5688
; this must be a direct command.
5689
 
5690
        BIT     0,(IY+$30)      ; test FLAGS2 - clear the main screen ?
5691
 
5692
        CALL    NZ,L0DAF        ; routine CL-ALL, if so, e.g. after listing.
5693
 
5694
        CALL    L0D6E           ; routine CLS-LOWER anyway.
5695
 
5696
        LD      A,$19           ; compute scroll count as 25 minus
5697
        SUB     (IY+$4F)        ; value of S_POSN_hi.
5698
        LD      ($5C8C),A       ; update SCR_CT system variable.
5699
        SET     7,(IY+$01)      ; update FLAGS - signal running program.
5700
        LD      (IY+$00),$FF    ; set ERR_NR to 'OK'.
5701
        LD      (IY+$0A),$01    ; set NSPPC to one for first statement.
5702
        CALL    L1B8A           ; call routine LINE-RUN to run the line.
5703
                                ; sysvar ERR_SP therefore addresses MAIN-4
5704
 
5705
; Examples of direct commands are RUN, CLS, LOAD "", PRINT USR 40000,
5706
; LPRINT "A"; etc..
5707
; If a user written machine-code program disables interrupts then it
5708
; must enable them to pass the next step. We also jumped to here if the
5709
; keyboard was not being used.
5710
 
5711
;; MAIN-4
5712
L1303:  HALT                    ; wait for interrupt the only routine that can
5713
                                ; set bit 5 of FLAGS.
5714
 
5715
        RES     5,(IY+$01)      ; update bit 5 of FLAGS - signal no new key.
5716
 
5717
        BIT     1,(IY+$30)      ; test FLAGS2 - is printer buffer clear ?
5718
        CALL    NZ,L0ECD        ; call routine COPY-BUFF if not.
5719
                                ; Note. the programmer has neglected
5720
                                ; to set bit 1 of FLAGS first.
5721
 
5722
        LD      A,($5C3A)       ; fetch ERR_NR
5723
        INC     A               ; increment to give true code.
5724
 
5725
; Now deal with a runtime error as opposed to an editing error.
5726
; However if the error code is now zero then the OK message will be printed.
5727
 
5728
;; MAIN-G
5729
L1313:  PUSH    AF              ; save the error number.
5730
 
5731
        LD      HL,$0000        ; prepare to clear some system variables.
5732
        LD      (IY+$37),H      ; clear all the bits of FLAGX.
5733
        LD      (IY+$26),H      ; blank X_PTR_hi to suppress error marker.
5734
        LD      ($5C0B),HL      ; blank DEFADD to signal that no defined
5735
                                ; function is currently being evaluated.
5736
 
5737
        LD      HL,$0001        ; explicit - inc hl would do.
5738
        LD      ($5C16),HL      ; ensure STRMS-00 is keyboard.
5739
 
5740
        CALL    L16B0           ; routine SET-MIN clears workspace etc.
5741
        RES     5,(IY+$37)      ; update FLAGX - signal in EDIT not INPUT mode.
5742
                                ; Note. all the bits were reset earlier.
5743
 
5744
        CALL    L0D6E           ; call routine CLS-LOWER.
5745
 
5746
        SET     5,(IY+$02)      ; update TV_FLAG - signal lower screen
5747
                                ; requires clearing.
5748
 
5749
        POP     AF              ; bring back the true error number
5750
        LD      B,A             ; and make a copy in B.
5751
        CP      $0A             ; is it a print-ready digit ?
5752
        JR      C,L133C         ; forward to MAIN-5 if so.
5753
 
5754
        ADD     A,$07           ; add ASCII offset to letters.
5755
 
5756
;; MAIN-5
5757
L133C:  CALL    L15EF           ; call routine OUT-CODE to print the code.
5758
 
5759
        LD      A,$20           ; followed by a space.
5760
        RST     10H             ; PRINT-A
5761
 
5762
        LD      A,B             ; fetch stored report code.
5763
        LD      DE,L1391        ; address: rpt-mesgs.
5764
 
5765
        CALL    L0C0A           ; call routine PO-MSG to print the message.
5766
 
5767
X1349:  XOR     A               ; clear accumulator to directly
5768
        LD      DE,L1537 - 1    ; address the comma and space message.
5769
 
5770
        CALL    L0C0A           ; routine PO-MSG prints ', ' although it would
5771
                                ; be more succinct to use RST $10.
5772
 
5773
        LD      BC,($5C45)      ; fetch PPC the current line number.
5774
        CALL    L1A1B           ; routine OUT-NUM-1 will print that
5775
 
5776
        LD      A,$3A           ; then a ':' character.
5777
        RST     10H             ; PRINT-A
5778
 
5779
        LD      C,(IY+$0D)      ; then SUBPPC for statement
5780
        LD      B,$00           ; limited to 127
5781
        CALL    L1A1B           ; routine OUT-NUM-1 prints BC.
5782
 
5783
        CALL    L1097           ; routine CLEAR-SP clears editing area which
5784
                                ; probably contained 'RUN'.
5785
 
5786
        LD      A,($5C3A)       ; fetch ERR_NR again
5787
        INC     A               ; test for no error originally $FF.
5788
        JR      Z,L1386         ; forward to MAIN-9 if no error.
5789
 
5790
        CP      $09             ; is code Report 9 STOP ?
5791
        JR      Z,L1373         ; forward to MAIN-6 if so
5792
 
5793
        CP      $15             ; is code Report L Break ?
5794
        JR      NZ,L1376        ; forward to MAIN-7 if not
5795
 
5796
; Stop or Break was encountered so consider CONTINUE.
5797
 
5798
;; MAIN-6
5799
L1373:  INC     (IY+$0D)        ; increment SUBPPC to next statement.
5800
 
5801
;; MAIN-7
5802
L1376:  LD      BC,$0003        ; prepare to copy 3 system variables to
5803
        LD      DE,$5C70        ; address OSPPC - statement for CONTINUE.
5804
                                ; also updating OLDPPC line number below.
5805
 
5806
        LD      HL,$5C44        ; set source top to NSPPC next statement.
5807
        BIT     7,(HL)          ; did BREAK occur before the jump ?
5808
                                ; e.g. between GO TO and next statement.
5809
        JR      Z,L1384         ; skip forward to MAIN-8, if not, as set-up
5810
                                ; is correct.
5811
 
5812
        ADD     HL,BC           ; set source to SUBPPC number of current
5813
                                ; statement/line which will be repeated.
5814
 
5815
;; MAIN-8
5816
L1384:  LDDR                    ; copy PPC to OLDPPC and SUBPPC to OSPCC
5817
                                ; or NSPPC to OLDPPC and NEWPPC to OSPCC
5818
 
5819
;; MAIN-9
5820
L1386:  LD      (IY+$0A),$FF    ; update NSPPC - signal 'no jump'.
5821
        RES     3,(IY+$01)      ; update FLAGS - signal use 'K' mode for
5822
                                ; the first character in the editor and
5823
 
5824
        JP      L12AC           ; jump back to MAIN-2.
5825
 
5826
 
5827
; ----------------------
5828
; Canned report messages
5829
; ----------------------
5830
; The Error reports with the last byte inverted. The first entry
5831
; is a dummy entry. The last, which begins with $7F, the Spectrum
5832
; character for copyright symbol, is placed here for convenience
5833
; as is the preceding comma and space.
5834
; The report line must accommodate a 4-digit line number and a 3-digit
5835
; statement number which limits the length of the message text to twenty
5836
; characters.
5837
; e.g.  "B Integer out of range, 1000:127"
5838
 
5839
;; rpt-mesgs
5840
L1391:  DEFB    $80
5841
        DEFB    'O','K'+$80                             ; 0
5842
        DEFM    "NEXT without FO"
5843
        DEFB    'R'+$80                                 ; 1
5844
        DEFM    "Variable not foun"
5845
        DEFB    'd'+$80                                 ; 2
5846
        DEFM    "Subscript wron"
5847
        DEFB    'g'+$80                                 ; 3
5848
        DEFM    "Out of memor"
5849
        DEFB    'y'+$80                                 ; 4
5850
        DEFM    "Out of scree"
5851
        DEFB    'n'+$80                                 ; 5
5852
        DEFM    "Number too bi"
5853
        DEFB    'g'+$80                                 ; 6
5854
        DEFM    "RETURN without GOSU"
5855
        DEFB    'B'+$80                                 ; 7
5856
        DEFM    "End of fil"
5857
        DEFB    'e'+$80                                 ; 8
5858
        DEFM    "STOP statemen"
5859
        DEFB    't'+$80                                 ; 9
5860
        DEFM    "Invalid argumen"
5861
        DEFB    't'+$80                                 ; A
5862
        DEFM    "Integer out of rang"
5863
        DEFB    'e'+$80                                 ; B
5864
        DEFM    "Nonsense in BASI"
5865
        DEFB    'C'+$80                                 ; C
5866
        DEFM    "BREAK - CONT repeat"
5867
        DEFB    's'+$80                                 ; D
5868
        DEFM    "Out of DAT"
5869
        DEFB    'A'+$80                                 ; E
5870
        DEFM    "Invalid file nam"
5871
        DEFB    'e'+$80                                 ; F
5872
        DEFM    "No room for lin"
5873
        DEFB    'e'+$80                                 ; G
5874
        DEFM    "STOP in INPU"
5875
        DEFB    'T'+$80                                 ; H
5876
        DEFM    "FOR without NEX"
5877
        DEFB    'T'+$80                                 ; I
5878
        DEFM    "Invalid I/O devic"
5879
        DEFB    'e'+$80                                 ; J
5880
        DEFM    "Invalid colou"
5881
        DEFB    'r'+$80                                 ; K
5882
        DEFM    "BREAK into progra"
5883
        DEFB    'm'+$80                                 ; L
5884
        DEFM    "RAMTOP no goo"
5885
        DEFB    'd'+$80                                 ; M
5886
        DEFM    "Statement los"
5887
        DEFB    't'+$80                                 ; N
5888
        DEFM    "Invalid strea"
5889
        DEFB    'm'+$80                                 ; O
5890
        DEFM    "FN without DE"
5891
        DEFB    'F'+$80                                 ; P
5892
        DEFM    "Parameter erro"
5893
        DEFB    'r'+$80                                 ; Q
5894
        DEFM    "Tape loading erro"
5895
        DEFB    'r'+$80                                 ; R
5896
;; comma-sp
5897
L1537:  DEFB    ',',' '+$80                             ; used in report line.
5898
;; copyright
5899
L1539:  DEFB    $7F                                     ; copyright
5900
        DEFM    " 1982 Sinclair Research Lt"
5901
        DEFB    'd'+$80
5902
 
5903
 
5904
; -------------
5905
; REPORT-G
5906
; -------------
5907
; Note ERR_SP points here during line entry which allows the
5908
; normal 'Out of Memory' report to be augmented to the more
5909
; precise 'No Room for line' report.
5910
 
5911
;; REPORT-G
5912
; No Room for line
5913
L1555:  LD      A,$10           ; i.e. 'G' -$30 -$07
5914
        LD      BC,$0000        ; this seems unnecessary.
5915
        JP      L1313           ; jump back to MAIN-G
5916
 
5917
; -----------------------------
5918
; Handle addition of BASIC line
5919
; -----------------------------
5920
; Note this is not a subroutine but a branch of the main execution loop.
5921
; System variable ERR_SP still points to editing error handler.
5922
; A new line is added to the BASIC program at the appropriate place.
5923
; An existing line with same number is deleted first.
5924
; Entering an existing line number deletes that line.
5925
; Entering a non-existent line allows the subsequent line to be edited next.
5926
 
5927
;; MAIN-ADD
5928
L155D:  LD      ($5C49),BC      ; set E_PPC to extracted line number.
5929
        LD      HL,($5C5D)      ; fetch CH_ADD - points to location after the
5930
                                ; initial digits (set in E_LINE_NO).
5931
        EX      DE,HL           ; save start of BASIC in DE.
5932
 
5933
        LD      HL,L1555        ; Address: REPORT-G
5934
        PUSH    HL              ; is pushed on stack and addressed by ERR_SP.
5935
                                ; the only error that can occur is
5936
                                ; 'Out of memory'.
5937
 
5938
        LD      HL,($5C61)      ; fetch WORKSP - end of line.
5939
        SCF                     ; prepare for true subtraction.
5940
        SBC     HL,DE           ; find length of BASIC and
5941
        PUSH    HL              ; save it on stack.
5942
        LD      H,B             ; transfer line number
5943
        LD      L,C             ; to HL register.
5944
        CALL    L196E           ; routine LINE-ADDR will see if
5945
                                ; a line with the same number exists.
5946
        JR      NZ,L157D        ; forward if no existing line to MAIN-ADD1.
5947
 
5948
        CALL    L19B8           ; routine NEXT-ONE finds the existing line.
5949
        CALL    L19E8           ; routine RECLAIM-2 reclaims it.
5950
 
5951
;; MAIN-ADD1
5952
L157D:  POP     BC              ; retrieve the length of the new line.
5953
        LD      A,C             ; and test if carriage return only
5954
        DEC     A               ; i.e. one byte long.
5955
        OR      B               ; result would be zero.
5956
        JR      Z,L15AB         ; forward to MAIN-ADD2 is so.
5957
 
5958
        PUSH    BC              ; save the length again.
5959
        INC     BC              ; adjust for inclusion
5960
        INC     BC              ; of line number (two bytes)
5961
        INC     BC              ; and line length
5962
        INC     BC              ; (two bytes).
5963
        DEC     HL              ; HL points to location before the destination
5964
 
5965
        LD      DE,($5C53)      ; fetch the address of PROG
5966
        PUSH    DE              ; and save it on the stack
5967
        CALL    L1655           ; routine MAKE-ROOM creates BC spaces in
5968
                                ; program area and updates pointers.
5969
        POP     HL              ; restore old program pointer.
5970
        LD      ($5C53),HL      ; and put back in PROG as it may have been
5971
                                ; altered by the POINTERS routine.
5972
 
5973
        POP     BC              ; retrieve BASIC length
5974
        PUSH    BC              ; and save again.
5975
 
5976
        INC     DE              ; points to end of new area.
5977
        LD      HL,($5C61)      ; set HL to WORKSP - location after edit line.
5978
        DEC     HL              ; decrement to address end marker.
5979
        DEC     HL              ; decrement to address carriage return.
5980
        LDDR                    ; copy the BASIC line back to initial command.
5981
 
5982
        LD      HL,($5C49)      ; fetch E_PPC - line number.
5983
        EX      DE,HL           ; swap it to DE, HL points to last of
5984
                                ; four locations.
5985
        POP     BC              ; retrieve length of line.
5986
        LD      (HL),B          ; high byte last.
5987
        DEC     HL              ;
5988
        LD      (HL),C          ; then low byte of length.
5989
        DEC     HL              ;
5990
        LD      (HL),E          ; then low byte of line number.
5991
        DEC     HL              ;
5992
        LD      (HL),D          ; then high byte range $0 - $27 (1-9999).
5993
 
5994
;; MAIN-ADD2
5995
L15AB:  POP     AF              ; drop the address of Report G
5996
        JP      L12A2           ; and back to MAIN-EXEC producing a listing
5997
                                ; and to reset ERR_SP in EDITOR.
5998
 
5999
 
6000
; ---------------------------------
6001
; THE 'INITIAL CHANNEL' INFORMATION
6002
; ---------------------------------
6003
;   This initial channel information is copied from ROM to RAM, during
6004
;   initialization.  It's new location is after the system variables and is
6005
;   addressed by the system variable CHANS which means that it can slide up and
6006
;   down in memory.  The table is never searched, by this ROM, and the last
6007
;   character, which could be anything other than a comma, provides a
6008
;   convenient resting place for DATADD.
6009
 
6010
;; init-chan
6011
L15AF:  DEFW    L09F4           ; PRINT-OUT
6012
        DEFW    L10A8           ; KEY-INPUT
6013
        DEFB    $4B             ; 'K'
6014
        DEFW    L09F4           ; PRINT-OUT
6015
        DEFW    L15C4           ; REPORT-J
6016
        DEFB    $53             ; 'S'
6017
        DEFW    L0F81           ; ADD-CHAR
6018
        DEFW    L15C4           ; REPORT-J
6019
        DEFB    $52             ; 'R'
6020
        DEFW    L09F4           ; PRINT-OUT
6021
        DEFW    L15C4           ; REPORT-J
6022
        DEFB    $50             ; 'P'
6023
 
6024
        DEFB    $80             ; End Marker
6025
 
6026
;; REPORT-J
6027
L15C4:  RST     08H             ; ERROR-1
6028
        DEFB    $12             ; Error Report: Invalid I/O device
6029
 
6030
 
6031
; -------------------------
6032
; THE 'INITIAL STREAM' DATA
6033
; -------------------------
6034
;   This is the initial stream data for the seven streams $FD - $03 that is
6035
;   copied from ROM to the STRMS system variables area during initialization.
6036
;   There are reserved locations there for another 12 streams.  Each location
6037
;   contains an offset to the second byte of a channel.  The first byte of a
6038
;   channel can't be used as that would result in an offset of zero for some
6039
;   and zero is used to denote that a stream is closed.
6040
 
6041
;; init-strm
6042
L15C6:  DEFB    $01, $00        ; stream $FD offset to channel 'K'
6043
        DEFB    $06, $00        ; stream $FE offset to channel 'S'
6044
        DEFB    $0B, $00        ; stream $FF offset to channel 'R'
6045
 
6046
        DEFB    $01, $00        ; stream $00 offset to channel 'K'
6047
        DEFB    $01, $00        ; stream $01 offset to channel 'K'
6048
        DEFB    $06, $00        ; stream $02 offset to channel 'S'
6049
        DEFB    $10, $00        ; stream $03 offset to channel 'P'
6050
 
6051
; ------------------------------
6052
; THE 'INPUT CONTROL' SUBROUTINE
6053
; ------------------------------
6054
;
6055
 
6056
;; WAIT-KEY
6057
L15D4:  BIT     5,(IY+$02)      ; test TV_FLAG - clear lower screen ?
6058
        JR      NZ,L15DE        ; forward to WAIT-KEY1 if so.
6059
 
6060
        SET     3,(IY+$02)      ; update TV_FLAG - signal reprint the edit
6061
                                ; line to the lower screen.
6062
 
6063
;; WAIT-KEY1
6064
L15DE:  CALL    L15E6           ; routine INPUT-AD is called.
6065
 
6066
        RET     C               ; return with acceptable keys.
6067
 
6068
        JR      Z,L15DE         ; back to WAIT-KEY1 if no key is pressed
6069
                                ; or it has been handled within INPUT-AD.
6070
 
6071
;   Note. When inputting from the keyboard all characters are returned with
6072
;   above conditions so this path is never taken.
6073
 
6074
;; REPORT-8
6075
L15E4:  RST     08H             ; ERROR-1
6076
        DEFB    $07             ; Error Report: End of file
6077
 
6078
; ---------------------------
6079
; THE 'INPUT ADDRESS' ROUTINE
6080
; ---------------------------
6081
;   This routine fetches the address of the input stream from the current
6082
;   channel area using the system variable CURCHL.
6083
 
6084
;; INPUT-AD
6085
L15E6:  EXX                     ; switch in alternate set.
6086
        PUSH    HL              ; save HL register
6087
        LD      HL,($5C51)      ; fetch address of CURCHL - current channel.
6088
        INC     HL              ; step over output routine
6089
        INC     HL              ; to point to low byte of input routine.
6090
        JR      L15F7           ; forward to CALL-SUB.
6091
 
6092
; -------------------------
6093
; THE 'CODE OUTPUT' ROUTINE
6094
; -------------------------
6095
;   This routine is called on five occasions to print the ASCII equivalent of
6096
;   a value 0-9.
6097
 
6098
;; OUT-CODE
6099
L15EF:  LD      E,$30           ; add 48 decimal to give the ASCII character
6100
        ADD     A,E             ; '0' to '9' and continue into the main output
6101
                                ; routine.
6102
 
6103
; -------------------------
6104
; THE 'MAIN OUTPUT' ROUTINE
6105
; -------------------------
6106
;   PRINT-A-2 is a continuation of the RST 10 restart that prints any character.
6107
;   The routine prints to the current channel and the printing of control codes
6108
;   may alter that channel to divert subsequent RST 10 instructions to temporary
6109
;   routines. The normal channel is $09F4.
6110
 
6111
;; PRINT-A-2
6112
L15F2:  EXX                     ; switch in alternate set
6113
        PUSH    HL              ; save HL register
6114
        LD      HL,($5C51)      ; fetch CURCHL the current channel.
6115
 
6116
; input-ad rejoins here also.
6117
 
6118
;; CALL-SUB
6119
L15F7:  LD      E,(HL)          ; put the low byte in E.
6120
        INC     HL              ; advance address.
6121
        LD      D,(HL)          ; put the high byte to D.
6122
        EX      DE,HL           ; transfer the stream to HL.
6123
        CALL    L162C           ; use routine CALL-JUMP.
6124
                                ; in effect CALL (HL).
6125
 
6126
        POP     HL              ; restore saved HL register.
6127
        EXX                     ; switch back to the main set and
6128
        RET                     ; return.
6129
 
6130
; --------------------------
6131
; THE 'OPEN CHANNEL' ROUTINE
6132
; --------------------------
6133
;   This subroutine is used by the ROM to open a channel 'K', 'S', 'R' or 'P'.
6134
;   This is either for its own use or in response to a user's request, for
6135
;   example, when '#' is encountered with output - PRINT, LIST etc.
6136
;   or with input - INPUT, INKEY$ etc.
6137
;   It is entered with a system stream $FD - $FF, or a user stream $00 - $0F
6138
;   in the accumulator.
6139
 
6140
;; CHAN-OPEN
6141
L1601:  ADD     A,A             ; double the stream ($FF will become $FE etc.)
6142
        ADD     A,$16           ; add the offset to stream 0 from $5C00
6143
        LD      L,A             ; result to L
6144
        LD      H,$5C           ; now form the address in STRMS area.
6145
        LD      E,(HL)          ; fetch low byte of CHANS offset
6146
        INC     HL              ; address next
6147
        LD      D,(HL)          ; fetch high byte of offset
6148
        LD      A,D             ; test that the stream is open.
6149
        OR      E               ; zero if closed.
6150
        JR      NZ,L1610        ; forward to CHAN-OP-1 if open.
6151
 
6152
;; REPORT-Oa
6153
L160E:  RST     08H             ; ERROR-1
6154
        DEFB    $17             ; Error Report: Invalid stream
6155
 
6156
; continue here if stream was open. Note that the offset is from CHANS
6157
; to the second byte of the channel.
6158
 
6159
;; CHAN-OP-1
6160
L1610:  DEC     DE              ; reduce offset so it points to the channel.
6161
        LD      HL,($5C4F)      ; fetch CHANS the location of the base of
6162
                                ; the channel information area
6163
        ADD     HL,DE           ; and add the offset to address the channel.
6164
                                ; and continue to set flags.
6165
 
6166
; -----------------
6167
; Set channel flags
6168
; -----------------
6169
; This subroutine is used from ED-EDIT, str$ and read-in to reset the
6170
; current channel when it has been temporarily altered.
6171
 
6172
;; CHAN-FLAG
6173
L1615:  LD      ($5C51),HL      ; set CURCHL system variable to the
6174
                                ; address in HL
6175
        RES     4,(IY+$30)      ; update FLAGS2  - signal K channel not in use.
6176
                                ; Note. provide a default for channel 'R'.
6177
        INC     HL              ; advance past
6178
        INC     HL              ; output routine.
6179
        INC     HL              ; advance past
6180
        INC     HL              ; input routine.
6181
        LD      C,(HL)          ; pick up the letter.
6182
        LD      HL,L162D        ; address: chn-cd-lu
6183
        CALL    L16DC           ; routine INDEXER finds offset to a
6184
                                ; flag-setting routine.
6185
 
6186
        RET     NC              ; but if the letter wasn't found in the
6187
                                ; table just return now. - channel 'R'.
6188
 
6189
        LD      D,$00           ; prepare to add
6190
        LD      E,(HL)          ; offset to E
6191
        ADD     HL,DE           ; add offset to location of offset to form
6192
                                ; address of routine
6193
 
6194
;; CALL-JUMP
6195
L162C:  JP      (HL)            ; jump to the routine
6196
 
6197
; Footnote. calling any location that holds JP (HL) is the equivalent to
6198
; a pseudo Z80 instruction CALL (HL). The ROM uses the instruction above.
6199
 
6200
; --------------------------
6201
; Channel code look-up table
6202
; --------------------------
6203
; This table is used by the routine above to find one of the three
6204
; flag setting routines below it.
6205
; A zero end-marker is required as channel 'R' is not present.
6206
 
6207
;; chn-cd-lu
6208
L162D:  DEFB    'K', L1634-$-1  ; offset $06 to CHAN-K
6209
        DEFB    'S', L1642-$-1  ; offset $12 to CHAN-S
6210
        DEFB    'P', L164D-$-1  ; offset $1B to CHAN-P
6211
 
6212
        DEFB    $00             ; end marker.
6213
 
6214
; --------------
6215
; Channel K flag
6216
; --------------
6217
; routine to set flags for lower screen/keyboard channel.
6218
 
6219
;; CHAN-K
6220
L1634:  SET     0,(IY+$02)      ; update TV_FLAG  - signal lower screen in use
6221
        RES     5,(IY+$01)      ; update FLAGS    - signal no new key
6222
        SET     4,(IY+$30)      ; update FLAGS2   - signal K channel in use
6223
        JR      L1646           ; forward to CHAN-S-1 for indirect exit
6224
 
6225
; --------------
6226
; Channel S flag
6227
; --------------
6228
; routine to set flags for upper screen channel.
6229
 
6230
;; CHAN-S
6231
L1642:  RES     0,(IY+$02)      ; TV_FLAG  - signal main screen in use
6232
 
6233
;; CHAN-S-1
6234
L1646:  RES     1,(IY+$01)      ; update FLAGS  - signal printer not in use
6235
        JP      L0D4D           ; jump back to TEMPS and exit via that
6236
                                ; routine after setting temporary attributes.
6237
; --------------
6238
; Channel P flag
6239
; --------------
6240
; This routine sets a flag so that subsequent print related commands
6241
; print to printer or update the relevant system variables.
6242
; This status remains in force until reset by the routine above.
6243
 
6244
;; CHAN-P
6245
L164D:  SET     1,(IY+$01)      ; update FLAGS  - signal printer in use
6246
        RET                     ; return
6247
 
6248
; --------------------------
6249
; THE 'ONE SPACE' SUBROUTINE
6250
; --------------------------
6251
; This routine is called once only to create a single space
6252
; in workspace by ADD-CHAR.
6253
 
6254
;; ONE-SPACE
6255
L1652:  LD      BC,$0001        ; create space for a single character.
6256
 
6257
; ---------
6258
; Make Room
6259
; ---------
6260
; This entry point is used to create BC spaces in various areas such as
6261
; program area, variables area, workspace etc..
6262
; The entire free RAM is available to each BASIC statement.
6263
; On entry, HL addresses where the first location is to be created.
6264
; Afterwards, HL will point to the location before this.
6265
 
6266
;; MAKE-ROOM
6267
L1655:  PUSH    HL              ; save the address pointer.
6268
        CALL    L1F05           ; routine TEST-ROOM checks if room
6269
                                ; exists and generates an error if not.
6270
        POP     HL              ; restore the address pointer.
6271
        CALL    L1664           ; routine POINTERS updates the
6272
                                ; dynamic memory location pointers.
6273
                                ; DE now holds the old value of STKEND.
6274
        LD      HL,($5C65)      ; fetch new STKEND the top destination.
6275
 
6276
        EX      DE,HL           ; HL now addresses the top of the area to
6277
                                ; be moved up - old STKEND.
6278
        LDDR                    ; the program, variables, etc are moved up.
6279
        RET                     ; return with new area ready to be populated.
6280
                                ; HL points to location before new area,
6281
                                ; and DE to last of new locations.
6282
 
6283
; -----------------------------------------------
6284
; Adjust pointers before making or reclaiming room
6285
; -----------------------------------------------
6286
; This routine is called by MAKE-ROOM to adjust upwards and by RECLAIM to
6287
; adjust downwards the pointers within dynamic memory.
6288
; The fourteen pointers to dynamic memory, starting with VARS and ending
6289
; with STKEND, are updated adding BC if they are higher than the position
6290
; in HL.
6291
; The system variables are in no particular order except that STKEND, the first
6292
; free location after dynamic memory must be the last encountered.
6293
 
6294
;; POINTERS
6295
L1664:  PUSH    AF              ; preserve accumulator.
6296
        PUSH    HL              ; put pos pointer on stack.
6297
        LD      HL,$5C4B        ; address VARS the first of the
6298
        LD      A,$0E           ; fourteen variables to consider.
6299
 
6300
;; PTR-NEXT
6301
L166B:  LD      E,(HL)          ; fetch the low byte of the system variable.
6302
        INC     HL              ; advance address.
6303
        LD      D,(HL)          ; fetch high byte of the system variable.
6304
        EX      (SP),HL         ; swap pointer on stack with the variable
6305
                                ; pointer.
6306
        AND     A               ; prepare to subtract.
6307
        SBC     HL,DE           ; subtract variable address
6308
        ADD     HL,DE           ; and add back
6309
        EX      (SP),HL         ; swap pos with system variable pointer
6310
        JR      NC,L167F        ; forward to PTR-DONE if var before pos
6311
 
6312
        PUSH    DE              ; save system variable address.
6313
        EX      DE,HL           ; transfer to HL
6314
        ADD     HL,BC           ; add the offset
6315
        EX      DE,HL           ; back to DE
6316
        LD      (HL),D          ; load high byte
6317
        DEC     HL              ; move back
6318
        LD      (HL),E          ; load low byte
6319
        INC     HL              ; advance to high byte
6320
        POP     DE              ; restore old system variable address.
6321
 
6322
;; PTR-DONE
6323
L167F:  INC     HL              ; address next system variable.
6324
        DEC     A               ; decrease counter.
6325
        JR      NZ,L166B        ; back to PTR-NEXT if more.
6326
        EX      DE,HL           ; transfer old value of STKEND to HL.
6327
                                ; Note. this has always been updated.
6328
        POP     DE              ; pop the address of the position.
6329
 
6330
        POP     AF              ; pop preserved accumulator.
6331
        AND     A               ; clear carry flag preparing to subtract.
6332
 
6333
        SBC     HL,DE           ; subtract position from old stkend
6334
        LD      B,H             ; to give number of data bytes
6335
        LD      C,L             ; to be moved.
6336
        INC     BC              ; increment as we also copy byte at old STKEND.
6337
        ADD     HL,DE           ; recompute old stkend.
6338
        EX      DE,HL           ; transfer to DE.
6339
        RET                     ; return.
6340
 
6341
 
6342
 
6343
; -------------------
6344
; Collect line number
6345
; -------------------
6346
; This routine extracts a line number, at an address that has previously
6347
; been found using LINE-ADDR, and it is entered at LINE-NO. If it encounters
6348
; the program 'end-marker' then the previous line is used and if that
6349
; should also be unacceptable then zero is used as it must be a direct
6350
; command. The program end-marker is the variables end-marker $80, or
6351
; if variables exist, then the first character of any variable name.
6352
 
6353
;; LINE-ZERO
6354
L168F:  DEFB    $00, $00        ; dummy line number used for direct commands
6355
 
6356
 
6357
;; LINE-NO-A
6358
L1691:  EX      DE,HL           ; fetch the previous line to HL and set
6359
        LD      DE,L168F        ; DE to LINE-ZERO should HL also fail.
6360
 
6361
; -> The Entry Point.
6362
 
6363
;; LINE-NO
6364
L1695:  LD      A,(HL)          ; fetch the high byte - max $2F
6365
        AND     $C0             ; mask off the invalid bits.
6366
        JR      NZ,L1691        ; to LINE-NO-A if an end-marker.
6367
 
6368
        LD      D,(HL)          ; reload the high byte.
6369
        INC     HL              ; advance address.
6370
        LD      E,(HL)          ; pick up the low byte.
6371
        RET                     ; return from here.
6372
 
6373
; -------------------
6374
; Handle reserve room
6375
; -------------------
6376
; This is a continuation of the restart BC-SPACES
6377
 
6378
;; RESERVE
6379
L169E:  LD      HL,($5C63)      ; STKBOT first location of calculator stack
6380
        DEC     HL              ; make one less than new location
6381
        CALL    L1655           ; routine MAKE-ROOM creates the room.
6382
        INC     HL              ; address the first new location
6383
        INC     HL              ; advance to second
6384
        POP     BC              ; restore old WORKSP
6385
        LD      ($5C61),BC      ; system variable WORKSP was perhaps
6386
                                ; changed by POINTERS routine.
6387
        POP     BC              ; restore count for return value.
6388
        EX      DE,HL           ; switch. DE = location after first new space
6389
        INC     HL              ; HL now location after new space
6390
        RET                     ; return.
6391
 
6392
; ---------------------------
6393
; Clear various editing areas
6394
; ---------------------------
6395
; This routine sets the editing area, workspace and calculator stack
6396
; to their minimum configurations as at initialization and indeed this
6397
; routine could have been relied on to perform that task.
6398
; This routine uses HL only and returns with that register holding
6399
; WORKSP/STKBOT/STKEND though no use is made of this. The routines also
6400
; reset MEM to its usual place in the systems variable area should it
6401
; have been relocated to a FOR-NEXT variable. The main entry point
6402
; SET-MIN is called at the start of the MAIN-EXEC loop and prior to
6403
; displaying an error.
6404
 
6405
;; SET-MIN
6406
L16B0:  LD      HL,($5C59)      ; fetch E_LINE
6407
        LD      (HL),$0D        ; insert carriage return
6408
        LD      ($5C5B),HL      ; make K_CUR keyboard cursor point there.
6409
        INC     HL              ; next location
6410
        LD      (HL),$80        ; holds end-marker $80
6411
        INC     HL              ; next location becomes
6412
        LD      ($5C61),HL      ; start of WORKSP
6413
 
6414
; This entry point is used prior to input and prior to the execution,
6415
; or parsing, of each statement.
6416
 
6417
;; SET-WORK
6418
L16BF:  LD      HL,($5C61)      ; fetch WORKSP value
6419
        LD      ($5C63),HL      ; and place in STKBOT
6420
 
6421
; This entry point is used to move the stack back to its normal place
6422
; after temporary relocation during line entry and also from ERROR-3
6423
 
6424
;; SET-STK
6425
L16C5:  LD      HL,($5C63)      ; fetch STKBOT value
6426
        LD      ($5C65),HL      ; and place in STKEND.
6427
 
6428
        PUSH    HL              ; perhaps an obsolete entry point.
6429
        LD      HL,$5C92        ; normal location of MEM-0
6430
        LD      ($5C68),HL      ; is restored to system variable MEM.
6431
        POP     HL              ; saved value not required.
6432
        RET                     ; return.
6433
 
6434
; ------------------
6435
; Reclaim edit-line?
6436
; ------------------
6437
; This seems to be legacy code from the ZX80/ZX81 as it is
6438
; not used in this ROM.
6439
; That task, in fact, is performed here by the dual-area routine CLEAR-SP.
6440
; This routine is designed to deal with something that is known to be in the
6441
; edit buffer and not workspace.
6442
; On entry, HL must point to the end of the something to be deleted.
6443
 
6444
;; REC-EDIT
6445
L16D4:  LD      DE,($5C59)      ; fetch start of edit line from E_LINE.
6446
        JP      L19E5           ; jump forward to RECLAIM-1.
6447
 
6448
; --------------------------
6449
; The Table INDEXING routine
6450
; --------------------------
6451
; This routine is used to search two-byte hash tables for a character
6452
; held in C, returning the address of the following offset byte.
6453
; if it is known that the character is in the table e.g. for priorities,
6454
; then the table requires no zero end-marker. If this is not known at the
6455
; outset then a zero end-marker is required and carry is set to signal
6456
; success.
6457
 
6458
;; INDEXER-1
6459
L16DB:  INC     HL              ; address the next pair of values.
6460
 
6461
; -> The Entry Point.
6462
 
6463
;; INDEXER
6464
L16DC:  LD      A,(HL)          ; fetch the first byte of pair
6465
        AND     A               ; is it the end-marker ?
6466
        RET     Z               ; return with carry reset if so.
6467
 
6468
        CP      C               ; is it the required character ?
6469
        INC     HL              ; address next location.
6470
        JR      NZ,L16DB        ; back to INDEXER-1 if no match.
6471
 
6472
        SCF                     ; else set the carry flag.
6473
        RET                     ; return with carry set
6474
 
6475
; --------------------------------
6476
; The Channel and Streams Routines
6477
; --------------------------------
6478
; A channel is an input/output route to a hardware device
6479
; and is identified to the system by a single letter e.g. 'K' for
6480
; the keyboard. A channel can have an input and output route
6481
; associated with it in which case it is bi-directional like
6482
; the keyboard. Others like the upper screen 'S' are output
6483
; only and the input routine usually points to a report message.
6484
; Channels 'K' and 'S' are system channels and it would be inappropriate
6485
; to close the associated streams so a mechanism is provided to
6486
; re-attach them. When the re-attachment is no longer required, then
6487
; closing these streams resets them as at initialization.
6488
; Early adverts said that the network and RS232 were in this ROM.
6489
; Channels 'N' and 'B' are user channels and have been removed successfully
6490
; if, as seems possible, they existed.
6491
; Ironically the tape streamer is not accessed through streams and
6492
; channels.
6493
; Early demonstrations of the Spectrum showed a single microdrive being
6494
; controlled by the main ROM.
6495
 
6496
; ---------------------
6497
; THE 'CLOSE #' COMMAND
6498
; ---------------------
6499
;   This command allows streams to be closed after use.
6500
;   Any temporary memory areas used by the stream would be reclaimed and
6501
;   finally flags set or reset if necessary.
6502
 
6503
;; CLOSE
6504
L16E5:  CALL    L171E           ; routine STR-DATA fetches parameter
6505
                                ; from calculator stack and gets the
6506
                                ; existing STRMS data pointer address in HL
6507
                                ; and stream offset from CHANS in BC.
6508
 
6509
                                ; Note. this offset could be zero if the
6510
                                ; stream is already closed. A check for this
6511
                                ; should occur now and an error should be
6512
                                ; generated, for example,
6513
                                ; Report S 'Stream status closed'.
6514
 
6515
        CALL    L1701           ; routine CLOSE-2 would perform any actions
6516
                                ; peculiar to that stream without disturbing
6517
                                ; data pointer to STRMS entry in HL.
6518
 
6519
        LD      BC,$0000        ; the stream is to be blanked.
6520
        LD      DE,$A3E2        ; the number of bytes from stream 4, $5C1E,
6521
                                ; to $10000
6522
        EX      DE,HL           ; transfer offset to HL, STRMS data pointer
6523
                                ; to DE.
6524
        ADD     HL,DE           ; add the offset to the data pointer.
6525
        JR      C,L16FC         ; forward to CLOSE-1 if a non-system stream.
6526
                                ; i.e. higher than 3.
6527
 
6528
; proceed with a negative result.
6529
 
6530
        LD      BC,L15C6 + 14   ; prepare the address of the byte after
6531
                                ; the initial stream data in ROM. ($15D4)
6532
        ADD     HL,BC           ; index into the data table with negative value.
6533
        LD      C,(HL)          ; low byte to C
6534
        INC     HL              ; address next.
6535
        LD      B,(HL)          ; high byte to B.
6536
 
6537
;   and for streams 0 - 3 just enter the initial data back into the STRMS entry
6538
;   streams 0 - 2 can't be closed as they are shared by the operating system.
6539
;   -> for streams 4 - 15 then blank the entry.
6540
 
6541
;; CLOSE-1
6542
L16FC:  EX      DE,HL           ; address of stream to HL.
6543
        LD      (HL),C          ; place zero (or low byte).
6544
        INC     HL              ; next address.
6545
        LD      (HL),B          ; place zero (or high byte).
6546
        RET                     ; return.
6547
 
6548
; ------------------------
6549
; THE 'CLOSE-2' SUBROUTINE
6550
; ------------------------
6551
;   There is not much point in coming here.
6552
;   The purpose was once to find the offset to a special closing routine,
6553
;   in this ROM and within 256 bytes of the close stream look up table that
6554
;   would reclaim any buffers associated with a stream. At least one has been
6555
;   removed.
6556
;   Any attempt to CLOSE streams $00 to $04, without first opening the stream,
6557
;   will lead to either a system restart or the production of a strange report.
6558
;   credit: Martin Wren-Hilton 1982.
6559
 
6560
;; CLOSE-2
6561
L1701:  PUSH    HL              ; * save address of stream data pointer
6562
                                ; in STRMS on the machine stack.
6563
        LD      HL,($5C4F)      ; fetch CHANS address to HL
6564
        ADD     HL,BC           ; add the offset to address the second
6565
                                ; byte of the output routine hopefully.
6566
        INC     HL              ; step past
6567
        INC     HL              ; the input routine.
6568
 
6569
;    Note. When the Sinclair Interface1 is fitted then an instruction fetch
6570
;    on the next address pages this ROM out and the shadow ROM in.
6571
 
6572
;; ROM_TRAP
6573
L1708:  INC     HL              ; to address channel's letter
6574
        LD      C,(HL)          ; pick it up in C.
6575
                                ; Note. but if stream is already closed we
6576
                                ; get the value $10 (the byte preceding 'K').
6577
 
6578
        EX      DE,HL           ; save the pointer to the letter in DE.
6579
 
6580
;   Note. The string pointer is saved but not used!!
6581
 
6582
        LD      HL,L1716        ; address: cl-str-lu in ROM.
6583
        CALL    L16DC           ; routine INDEXER uses the code to get
6584
                                ; the 8-bit offset from the current point to
6585
                                ; the address of the closing routine in ROM.
6586
                                ; Note. it won't find $10 there!
6587
 
6588
        LD      C,(HL)          ; transfer the offset to C.
6589
        LD      B,$00           ; prepare to add.
6590
        ADD     HL,BC           ; add offset to point to the address of the
6591
                                ; routine that closes the stream.
6592
                                ; (and presumably removes any buffers that
6593
                                ; are associated with it.)
6594
        JP      (HL)            ; jump to that routine.
6595
 
6596
; --------------------------------
6597
; THE 'CLOSE STREAM LOOK-UP' TABLE
6598
; --------------------------------
6599
;   This table contains an entry for a letter found in the CHANS area.
6600
;   followed by an 8-bit displacement, from that byte's address in the
6601
;   table to the routine that performs any ancillary actions associated
6602
;   with closing the stream of that channel.
6603
;   The table doesn't require a zero end-marker as the letter has been
6604
;   picked up from a channel that has an open stream.
6605
 
6606
;; cl-str-lu
6607
L1716:  DEFB    'K', L171C-$-1  ; offset 5 to CLOSE-STR
6608
        DEFB    'S', L171C-$-1  ; offset 3 to CLOSE-STR
6609
        DEFB    'P', L171C-$-1  ; offset 1 to CLOSE-STR
6610
 
6611
 
6612
; ------------------------------
6613
; THE 'CLOSE STREAM' SUBROUTINES
6614
; ------------------------------
6615
; The close stream routines in fact have no ancillary actions to perform
6616
; which is not surprising with regard to 'K' and 'S'.
6617
 
6618
;; CLOSE-STR
6619
L171C:  POP     HL              ; * now just restore the stream data pointer
6620
        RET                     ; in STRMS and return.
6621
 
6622
; -----------
6623
; Stream data
6624
; -----------
6625
; This routine finds the data entry in the STRMS area for the specified
6626
; stream which is passed on the calculator stack. It returns with HL
6627
; pointing to this system variable and BC holding a displacement from
6628
; the CHANS area to the second byte of the stream's channel. If BC holds
6629
; zero, then that signifies that the stream is closed.
6630
 
6631
;; STR-DATA
6632
L171E:  CALL    L1E94           ; routine FIND-INT1 fetches parameter to A
6633
        CP      $10             ; is it less than 16d ?
6634
        JR      C,L1727         ; skip forward to STR-DATA1 if so.
6635
 
6636
;; REPORT-Ob
6637
L1725:  RST     08H             ; ERROR-1
6638
        DEFB    $17             ; Error Report: Invalid stream
6639
 
6640
;; STR-DATA1
6641
L1727:  ADD     A,$03           ; add the offset for 3 system streams.
6642
                                ; range 00 - 15d becomes 3 - 18d.
6643
        RLCA                    ; double as there are two bytes per
6644
                                ; stream - now 06 - 36d
6645
        LD      HL,$5C10        ; address STRMS - the start of the streams
6646
                                ; data area in system variables.
6647
        LD      C,A             ; transfer the low byte to A.
6648
        LD      B,$00           ; prepare to add offset.
6649
        ADD     HL,BC           ; add to address the data entry in STRMS.
6650
 
6651
; the data entry itself contains an offset from CHANS to the address of the
6652
; stream
6653
 
6654
        LD      C,(HL)          ; low byte of displacement to C.
6655
        INC     HL              ; address next.
6656
        LD      B,(HL)          ; high byte of displacement to B.
6657
        DEC     HL              ; step back to leave HL pointing to STRMS
6658
                                ; data entry.
6659
        RET                     ; return with CHANS displacement in BC
6660
                                ; and address of stream data entry in HL.
6661
 
6662
; --------------------
6663
; Handle OPEN# command
6664
; --------------------
6665
; Command syntax example: OPEN #5,"s"
6666
; On entry the channel code entry is on the calculator stack with the next
6667
; value containing the stream identifier. They have to swapped.
6668
 
6669
;; OPEN
6670
L1736:  RST     28H             ;; FP-CALC    ;s,c.
6671
        DEFB    $01             ;;exchange    ;c,s.
6672
        DEFB    $38             ;;end-calc
6673
 
6674
        CALL    L171E           ; routine STR-DATA fetches the stream off
6675
                                ; the stack and returns with the CHANS
6676
                                ; displacement in BC and HL addressing
6677
                                ; the STRMS data entry.
6678
        LD      A,B             ; test for zero which
6679
        OR      C               ; indicates the stream is closed.
6680
        JR      Z,L1756         ; skip forward to OPEN-1 if so.
6681
 
6682
; if it is a system channel then it can re-attached.
6683
 
6684
        EX      DE,HL           ; save STRMS address in DE.
6685
        LD      HL,($5C4F)      ; fetch CHANS.
6686
        ADD     HL,BC           ; add the offset to address the second
6687
                                ; byte of the channel.
6688
        INC     HL              ; skip over the
6689
        INC     HL              ; input routine.
6690
        INC     HL              ; and address the letter.
6691
        LD      A,(HL)          ; pick up the letter.
6692
        EX      DE,HL           ; save letter pointer and bring back
6693
                                ; the STRMS pointer.
6694
 
6695
        CP      $4B             ; is it 'K' ?
6696
        JR      Z,L1756         ; forward to OPEN-1 if so
6697
 
6698
        CP      $53             ; is it 'S' ?
6699
        JR      Z,L1756         ; forward to OPEN-1 if so
6700
 
6701
        CP      $50             ; is it 'P' ?
6702
        JR      NZ,L1725        ; back to REPORT-Ob if not.
6703
                                ; to report 'Invalid stream'.
6704
 
6705
; continue if one of the upper-case letters was found.
6706
; and rejoin here from above if stream was closed.
6707
 
6708
;; OPEN-1
6709
L1756:  CALL    L175D           ; routine OPEN-2 opens the stream.
6710
 
6711
; it now remains to update the STRMS variable.
6712
 
6713
        LD      (HL),E          ; insert or overwrite the low byte.
6714
        INC     HL              ; address high byte in STRMS.
6715
        LD      (HL),D          ; insert or overwrite the high byte.
6716
        RET                     ; return.
6717
 
6718
; -----------------
6719
; OPEN-2 Subroutine
6720
; -----------------
6721
; There is some point in coming here as, as well as once creating buffers,
6722
; this routine also sets flags.
6723
 
6724
;; OPEN-2
6725
L175D:  PUSH    HL              ; * save the STRMS data entry pointer.
6726
        CALL    L2BF1           ; routine STK-FETCH now fetches the
6727
                                ; parameters of the channel string.
6728
                                ; start in DE, length in BC.
6729
 
6730
        LD      A,B             ; test that it is not
6731
        OR      C               ; the null string.
6732
        JR      NZ,L1767        ; skip forward to OPEN-3 with 1 character
6733
                                ; or more!
6734
 
6735
;; REPORT-Fb
6736
L1765:  RST     08H             ; ERROR-1
6737
        DEFB    $0E             ; Error Report: Invalid file name
6738
 
6739
;; OPEN-3
6740
L1767:  PUSH    BC              ; save the length of the string.
6741
        LD      A,(DE)          ; pick up the first character.
6742
                                ; Note. There can be more than one character.
6743
        AND     $DF             ; make it upper-case.
6744
        LD      C,A             ; place it in C.
6745
        LD      HL,L177A        ; address: op-str-lu is loaded.
6746
        CALL    L16DC           ; routine INDEXER will search for letter.
6747
        JR      NC,L1765        ; back to REPORT-F if not found
6748
                                ; 'Invalid filename'
6749
 
6750
        LD      C,(HL)          ; fetch the displacement to opening routine.
6751
        LD      B,$00           ; prepare to add.
6752
        ADD     HL,BC           ; now form address of opening routine.
6753
        POP     BC              ; restore the length of string.
6754
        JP      (HL)            ; now jump forward to the relevant routine.
6755
 
6756
; -------------------------
6757
; OPEN stream look-up table
6758
; -------------------------
6759
; The open stream look-up table consists of matched pairs.
6760
; The channel letter is followed by an 8-bit displacement to the
6761
; associated stream-opening routine in this ROM.
6762
; The table requires a zero end-marker as the letter has been
6763
; provided by the user and not the operating system.
6764
 
6765
;; op-str-lu
6766
L177A:  DEFB    'K', L1781-$-1  ; $06 offset to OPEN-K
6767
        DEFB    'S', L1785-$-1  ; $08 offset to OPEN-S
6768
        DEFB    'P', L1789-$-1  ; $0A offset to OPEN-P
6769
 
6770
        DEFB    $00             ; end-marker.
6771
 
6772
; ----------------------------
6773
; The Stream Opening Routines.
6774
; ----------------------------
6775
; These routines would have opened any buffers associated with the stream
6776
; before jumping forward to OPEN-END with the displacement value in E
6777
; and perhaps a modified value in BC. The strange pathing does seem to
6778
; provide for flexibility in this respect.
6779
;
6780
; There is no need to open the printer buffer as it is there already
6781
; even if you are still saving up for a ZX Printer or have moved onto
6782
; something bigger. In any case it would have to be created after
6783
; the system variables but apart from that it is a simple task
6784
; and all but one of the ROM routines can handle a buffer in that position.
6785
; (PR-ALL-6 would require an extra 3 bytes of code).
6786
; However it wouldn't be wise to have two streams attached to the ZX Printer
6787
; as you can now, so one assumes that if PR_CC_hi was non-zero then
6788
; the OPEN-P routine would have refused to attach a stream if another
6789
; stream was attached.
6790
 
6791
; Something of significance is being passed to these ghost routines in the
6792
; second character. Strings 'RB', 'RT' perhaps or a drive/station number.
6793
; The routine would have to deal with that and exit to OPEN_END with BC
6794
; containing $0001 or more likely there would be an exit within the routine.
6795
; Anyway doesn't matter, these routines are long gone.
6796
 
6797
; -----------------
6798
; OPEN-K Subroutine
6799
; -----------------
6800
; Open Keyboard stream.
6801
 
6802
;; OPEN-K
6803
L1781:  LD      E,$01           ; 01 is offset to second byte of channel 'K'.
6804
        JR      L178B           ; forward to OPEN-END
6805
 
6806
; -----------------
6807
; OPEN-S Subroutine
6808
; -----------------
6809
; Open Screen stream.
6810
 
6811
;; OPEN-S
6812
L1785:  LD      E,$06           ; 06 is offset to 2nd byte of channel 'S'
6813
        JR      L178B           ; to OPEN-END
6814
 
6815
; -----------------
6816
; OPEN-P Subroutine
6817
; -----------------
6818
; Open Printer stream.
6819
 
6820
;; OPEN-P
6821
L1789:  LD      E,$10           ; 16d is offset to 2nd byte of channel 'P'
6822
 
6823
;; OPEN-END
6824
L178B:  DEC     BC              ; the stored length of 'K','S','P' or
6825
                                ; whatever is now tested. ??
6826
        LD      A,B             ; test now if initial or residual length
6827
        OR      C               ; is one character.
6828
        JR      NZ,L1765        ; to REPORT-Fb 'Invalid file name' if not.
6829
 
6830
        LD      D,A             ; load D with zero to form the displacement
6831
                                ; in the DE register.
6832
        POP     HL              ; * restore the saved STRMS pointer.
6833
        RET                     ; return to update STRMS entry thereby
6834
                                ; signaling stream is open.
6835
 
6836
; ----------------------------------------
6837
; Handle CAT, ERASE, FORMAT, MOVE commands
6838
; ----------------------------------------
6839
; These just generate an error report as the ROM is 'incomplete'.
6840
;
6841
; Luckily this provides a mechanism for extending these in a shadow ROM
6842
; but without the powerful mechanisms set up in this ROM.
6843
; An instruction fetch on $0008 may page in a peripheral ROM,
6844
; e.g. the Sinclair Interface 1 ROM, to handle these commands.
6845
; However that wasn't the plan.
6846
; Development of this ROM continued for another three months until the cost
6847
; of replacing it and the manual became unfeasible.
6848
; The ultimate power of channels and streams died at birth.
6849
 
6850
;; CAT-ETC
6851
L1793:  JR      L1725           ; to REPORT-Ob
6852
 
6853
; -----------------
6854
; Perform AUTO-LIST
6855
; -----------------
6856
; This produces an automatic listing in the upper screen.
6857
 
6858
;; AUTO-LIST
6859
L1795:  LD      ($5C3F),SP      ; save stack pointer in LIST_SP
6860
        LD      (IY+$02),$10    ; update TV_FLAG set bit 3
6861
        CALL    L0DAF           ; routine CL-ALL.
6862
        SET     0,(IY+$02)      ; update TV_FLAG  - signal lower screen in use
6863
 
6864
        LD      B,(IY+$31)      ; fetch DF_SZ to B.
6865
        CALL    L0E44           ; routine CL-LINE clears lower display
6866
                                ; preserving B.
6867
        RES     0,(IY+$02)      ; update TV_FLAG  - signal main screen in use
6868
        SET     0,(IY+$30)      ; update FLAGS2 - signal will be necessary to
6869
                                ; clear main screen.
6870
        LD      HL,($5C49)      ; fetch E_PPC current edit line to HL.
6871
        LD      DE,($5C6C)      ; fetch S_TOP to DE, the current top line
6872
                                ; (initially zero)
6873
        AND     A               ; prepare for true subtraction.
6874
        SBC     HL,DE           ; subtract and
6875
        ADD     HL,DE           ; add back.
6876
        JR      C,L17E1         ; to AUTO-L-2 if S_TOP higher than E_PPC
6877
                                ; to set S_TOP to E_PPC
6878
 
6879
        PUSH    DE              ; save the top line number.
6880
        CALL    L196E           ; routine LINE-ADDR gets address of E_PPC.
6881
        LD      DE,$02C0        ; prepare known number of characters in
6882
                                ; the default upper screen.
6883
        EX      DE,HL           ; offset to HL, program address to DE.
6884
        SBC     HL,DE           ; subtract high value from low to obtain
6885
                                ; negated result used in addition.
6886
        EX      (SP),HL         ; swap result with top line number on stack.
6887
        CALL    L196E           ; routine LINE-ADDR  gets address of that
6888
                                ; top line in HL and next line in DE.
6889
        POP     BC              ; restore the result to balance stack.
6890
 
6891
;; AUTO-L-1
6892
L17CE:  PUSH    BC              ; save the result.
6893
        CALL    L19B8           ; routine NEXT-ONE gets address in HL of
6894
                                ; line after auto-line (in DE).
6895
        POP     BC              ; restore result.
6896
        ADD     HL,BC           ; compute back.
6897
        JR      C,L17E4         ; to AUTO-L-3 if line 'should' appear
6898
 
6899
        EX      DE,HL           ; address of next line to HL.
6900
        LD      D,(HL)          ; get line
6901
        INC     HL              ; number
6902
        LD      E,(HL)          ; in DE.
6903
        DEC     HL              ; adjust back to start.
6904
        LD      ($5C6C),DE      ; update S_TOP.
6905
        JR      L17CE           ; to AUTO-L-1 until estimate reached.
6906
 
6907
; ---
6908
 
6909
; the jump was to here if S_TOP was greater than E_PPC
6910
 
6911
;; AUTO-L-2
6912
L17E1:  LD      ($5C6C),HL      ; make S_TOP the same as E_PPC.
6913
 
6914
; continue here with valid starting point from above or good estimate
6915
; from computation
6916
 
6917
;; AUTO-L-3
6918
L17E4:  LD      HL,($5C6C)      ; fetch S_TOP line number to HL.
6919
        CALL    L196E           ; routine LINE-ADDR gets address in HL.
6920
                                ; address of next in DE.
6921
        JR      Z,L17ED         ; to AUTO-L-4 if line exists.
6922
 
6923
        EX      DE,HL           ; else use address of next line.
6924
 
6925
;; AUTO-L-4
6926
L17ED:  CALL    L1833           ; routine LIST-ALL                >>>
6927
 
6928
; The return will be to here if no scrolling occurred
6929
 
6930
        RES     4,(IY+$02)      ; update TV_FLAG  - signal no auto listing.
6931
        RET                     ; return.
6932
 
6933
; ------------
6934
; Handle LLIST
6935
; ------------
6936
; A short form of LIST #3. The listing goes to stream 3 - default printer.
6937
 
6938
;; LLIST
6939
L17F5:  LD      A,$03           ; the usual stream for ZX Printer
6940
        JR      L17FB           ; forward to LIST-1
6941
 
6942
; -----------
6943
; Handle LIST
6944
; -----------
6945
; List to any stream.
6946
; Note. While a starting line can be specified it is
6947
; not possible to specify an end line.
6948
; Just listing a line makes it the current edit line.
6949
 
6950
;; LIST
6951
L17F9:  LD      A,$02           ; default is stream 2 - the upper screen.
6952
 
6953
;; LIST-1
6954
L17FB:  LD      (IY+$02),$00    ; the TV_FLAG is initialized with bit 0 reset
6955
                                ; indicating upper screen in use.
6956
        CALL    L2530           ; routine SYNTAX-Z - checking syntax ?
6957
        CALL    NZ,L1601        ; routine CHAN-OPEN if in run-time.
6958
 
6959
        RST     18H             ; GET-CHAR
6960
        CALL    L2070           ; routine STR-ALTER will alter if '#'.
6961
        JR      C,L181F         ; forward to LIST-4 not a '#' .
6962
 
6963
 
6964
        RST     18H             ; GET-CHAR
6965
        CP      $3B             ; is it ';' ?
6966
        JR      Z,L1814         ; skip to LIST-2 if so.
6967
 
6968
        CP      $2C             ; is it ',' ?
6969
        JR      NZ,L181A        ; forward to LIST-3 if neither separator.
6970
 
6971
; we have, say,  LIST #15, and a number must follow the separator.
6972
 
6973
;; LIST-2
6974
L1814:  RST     20H             ; NEXT-CHAR
6975
        CALL    L1C82           ; routine EXPT-1NUM
6976
        JR      L1822           ; forward to LIST-5
6977
 
6978
; ---
6979
 
6980
; the branch was here with just LIST #3 etc.
6981
 
6982
;; LIST-3
6983
L181A:  CALL    L1CE6           ; routine USE-ZERO
6984
        JR      L1822           ; forward to LIST-5
6985
 
6986
; ---
6987
 
6988
; the branch was here with LIST
6989
 
6990
;; LIST-4
6991
L181F:  CALL    L1CDE           ; routine FETCH-NUM checks if a number
6992
                                ; follows else uses zero.
6993
 
6994
;; LIST-5
6995
L1822:  CALL    L1BEE           ; routine CHECK-END quits if syntax OK >>>
6996
 
6997
        CALL    L1E99           ; routine FIND-INT2 fetches the number
6998
                                ; from the calculator stack in run-time.
6999
        LD      A,B             ; fetch high byte of line number and
7000
        AND     $3F             ; make less than $40 so that NEXT-ONE
7001
                                ; (from LINE-ADDR) doesn't lose context.
7002
                                ; Note. this is not satisfactory and the typo
7003
                                ; LIST 20000 will list an entirely different
7004
                                ; section than LIST 2000. Such typos are not
7005
                                ; available for checking if they are direct
7006
                                ; commands.
7007
 
7008
        LD      H,A             ; transfer the modified
7009
        LD      L,C             ; line number to HL.
7010
        LD      ($5C49),HL      ; update E_PPC to new line number.
7011
        CALL    L196E           ; routine LINE-ADDR gets the address of the
7012
                                ; line.
7013
 
7014
; This routine is called from AUTO-LIST
7015
 
7016
;; LIST-ALL
7017
L1833:  LD      E,$01           ; signal current line not yet printed
7018
 
7019
;; LIST-ALL-2
7020
L1835:  CALL    L1855           ; routine OUT-LINE outputs a BASIC line
7021
                                ; using PRINT-OUT and makes an early return
7022
                                ; when no more lines to print. >>>
7023
 
7024
        RST     10H             ; PRINT-A prints the carriage return (in A)
7025
 
7026
        BIT     4,(IY+$02)      ; test TV_FLAG  - automatic listing ?
7027
        JR      Z,L1835         ; back to LIST-ALL-2 if not
7028
                                ; (loop exit is via OUT-LINE)
7029
 
7030
; continue here if an automatic listing required.
7031
 
7032
        LD      A,($5C6B)       ; fetch DF_SZ lower display file size.
7033
        SUB     (IY+$4F)        ; subtract S_POSN_hi ithe current line number.
7034
        JR      NZ,L1835        ; back to LIST-ALL-2 if upper screen not full.
7035
 
7036
        XOR     E               ; A contains zero, E contains one if the
7037
                                ; current edit line has not been printed
7038
                                ; or zero if it has (from OUT-LINE).
7039
        RET     Z               ; return if the screen is full and the line
7040
                                ; has been printed.
7041
 
7042
; continue with automatic listings if the screen is full and the current
7043
; edit line is missing. OUT-LINE will scroll automatically.
7044
 
7045
        PUSH    HL              ; save the pointer address.
7046
        PUSH    DE              ; save the E flag.
7047
        LD      HL,$5C6C        ; fetch S_TOP the rough estimate.
7048
        CALL    L190F           ; routine LN-FETCH updates S_TOP with
7049
                                ; the number of the next line.
7050
        POP     DE              ; restore the E flag.
7051
        POP     HL              ; restore the address of the next line.
7052
        JR      L1835           ; back to LIST-ALL-2.
7053
 
7054
; ------------------------
7055
; Print a whole BASIC line
7056
; ------------------------
7057
; This routine prints a whole BASIC line and it is called
7058
; from LIST-ALL to output the line to current channel
7059
; and from ED-EDIT to 'sprint' the line to the edit buffer.
7060
 
7061
;; OUT-LINE
7062
L1855:  LD      BC,($5C49)      ; fetch E_PPC the current line which may be
7063
                                ; unchecked and not exist.
7064
        CALL    L1980           ; routine CP-LINES finds match or line after.
7065
        LD      D,$3E           ; prepare cursor '>' in D.
7066
        JR      Z,L1865         ; to OUT-LINE1 if matched or line after.
7067
 
7068
        LD      DE,$0000        ; put zero in D, to suppress line cursor.
7069
        RL      E               ; pick up carry in E if line before current
7070
                                ; leave E zero if same or after.
7071
 
7072
;; OUT-LINE1
7073
L1865:  LD      (IY+$2D),E      ; save flag in BREG which is spare.
7074
        LD      A,(HL)          ; get high byte of line number.
7075
        CP      $40             ; is it too high ($2F is maximum possible) ?
7076
        POP     BC              ; drop the return address and
7077
        RET     NC              ; make an early return if so >>>
7078
 
7079
        PUSH    BC              ; save return address
7080
        CALL    L1A28           ; routine OUT-NUM-2 to print addressed number
7081
                                ; with leading space.
7082
        INC     HL              ; skip low number byte.
7083
        INC     HL              ; and the two
7084
        INC     HL              ; length bytes.
7085
        RES     0,(IY+$01)      ; update FLAGS - signal leading space required.
7086
        LD      A,D             ; fetch the cursor.
7087
        AND     A               ; test for zero.
7088
        JR      Z,L1881         ; to OUT-LINE3 if zero.
7089
 
7090
 
7091
        RST     10H             ; PRINT-A prints '>' the current line cursor.
7092
 
7093
; this entry point is called from ED-COPY
7094
 
7095
;; OUT-LINE2
7096
L187D:  SET     0,(IY+$01)      ; update FLAGS - suppress leading space.
7097
 
7098
;; OUT-LINE3
7099
L1881:  PUSH    DE              ; save flag E for a return value.
7100
        EX      DE,HL           ; save HL address in DE.
7101
        RES     2,(IY+$30)      ; update FLAGS2 - signal NOT in QUOTES.
7102
 
7103
        LD      HL,$5C3B        ; point to FLAGS.
7104
        RES     2,(HL)          ; signal 'K' mode. (starts before keyword)
7105
        BIT     5,(IY+$37)      ; test FLAGX - input mode ?
7106
        JR      Z,L1894         ; forward to OUT-LINE4 if not.
7107
 
7108
        SET     2,(HL)          ; signal 'L' mode. (used for input)
7109
 
7110
;; OUT-LINE4
7111
L1894:  LD      HL,($5C5F)      ; fetch X_PTR - possibly the error pointer
7112
                                ; address.
7113
        AND     A               ; clear the carry flag.
7114
        SBC     HL,DE           ; test if an error address has been reached.
7115
        JR      NZ,L18A1        ; forward to OUT-LINE5 if not.
7116
 
7117
        LD      A,$3F           ; load A with '?' the error marker.
7118
        CALL    L18C1           ; routine OUT-FLASH to print flashing marker.
7119
 
7120
;; OUT-LINE5
7121
L18A1:  CALL    L18E1           ; routine OUT-CURS will print the cursor if
7122
                                ; this is the right position.
7123
        EX      DE,HL           ; restore address pointer to HL.
7124
        LD      A,(HL)          ; fetch the addressed character.
7125
        CALL    L18B6           ; routine NUMBER skips a hidden floating
7126
                                ; point number if present.
7127
        INC     HL              ; now increment the pointer.
7128
        CP      $0D             ; is character end-of-line ?
7129
        JR      Z,L18B4         ; to OUT-LINE6, if so, as line is finished.
7130
 
7131
        EX      DE,HL           ; save the pointer in DE.
7132
        CALL    L1937           ; routine OUT-CHAR to output character/token.
7133
 
7134
        JR      L1894           ; back to OUT-LINE4 until entire line is done.
7135
 
7136
; ---
7137
 
7138
;; OUT-LINE6
7139
L18B4:  POP     DE              ; bring back the flag E, zero if current
7140
                                ; line printed else 1 if still to print.
7141
        RET                     ; return with A holding $0D
7142
 
7143
; -------------------------
7144
; Check for a number marker
7145
; -------------------------
7146
; this subroutine is called from two processes. while outputting BASIC lines
7147
; and while searching statements within a BASIC line.
7148
; during both, this routine will pass over an invisible number indicator
7149
; and the five bytes floating-point number that follows it.
7150
; Note that this causes floating point numbers to be stripped from
7151
; the BASIC line when it is fetched to the edit buffer by OUT_LINE.
7152
; the number marker also appears after the arguments of a DEF FN statement
7153
; and may mask old 5-byte string parameters.
7154
 
7155
;; NUMBER
7156
L18B6:  CP      $0E             ; character fourteen ?
7157
        RET     NZ              ; return if not.
7158
 
7159
        INC     HL              ; skip the character
7160
        INC     HL              ; and five bytes
7161
        INC     HL              ; following.
7162
        INC     HL              ;
7163
        INC     HL              ;
7164
        INC     HL              ;
7165
        LD      A,(HL)          ; fetch the following character
7166
        RET                     ; for return value.
7167
 
7168
; --------------------------
7169
; Print a flashing character
7170
; --------------------------
7171
; This subroutine is called from OUT-LINE to print a flashing error
7172
; marker '?' or from the next routine to print a flashing cursor e.g. 'L'.
7173
; However, this only gets called from OUT-LINE when printing the edit line
7174
; or the input buffer to the lower screen so a direct call to $09F4 can
7175
; be used, even though out-line outputs to other streams.
7176
; In fact the alternate set is used for the whole routine.
7177
 
7178
;; OUT-FLASH
7179
L18C1:  EXX                     ; switch in alternate set
7180
 
7181
        LD      HL,($5C8F)      ; fetch L = ATTR_T, H = MASK-T
7182
        PUSH    HL              ; save masks.
7183
        RES     7,H             ; reset flash mask bit so active.
7184
        SET     7,L             ; make attribute FLASH.
7185
        LD      ($5C8F),HL      ; resave ATTR_T and MASK-T
7186
 
7187
        LD      HL,$5C91        ; address P_FLAG
7188
        LD      D,(HL)          ; fetch to D
7189
        PUSH    DE              ; and save.
7190
        LD      (HL),$00        ; clear inverse, over, ink/paper 9
7191
 
7192
        CALL    L09F4           ; routine PRINT-OUT outputs character
7193
                                ; without the need to vector via RST 10.
7194
 
7195
        POP     HL              ; pop P_FLAG to H.
7196
        LD      (IY+$57),H      ; and restore system variable P_FLAG.
7197
        POP     HL              ; restore temporary masks
7198
        LD      ($5C8F),HL      ; and restore system variables ATTR_T/MASK_T
7199
 
7200
        EXX                     ; switch back to main set
7201
        RET                     ; return
7202
 
7203
; ----------------
7204
; Print the cursor
7205
; ----------------
7206
; This routine is called before any character is output while outputting
7207
; a BASIC line or the input buffer. This includes listing to a printer
7208
; or screen, copying a BASIC line to the edit buffer and printing the
7209
; input buffer or edit buffer to the lower screen. It is only in the
7210
; latter two cases that it has any relevance and in the last case it
7211
; performs another very important function also.
7212
 
7213
;; OUT-CURS
7214
L18E1:  LD      HL,($5C5B)      ; fetch K_CUR the current cursor address
7215
        AND     A               ; prepare for true subtraction.
7216
        SBC     HL,DE           ; test against pointer address in DE and
7217
        RET     NZ              ; return if not at exact position.
7218
 
7219
; the value of MODE, maintained by KEY-INPUT, is tested and if non-zero
7220
; then this value 'E' or 'G' will take precedence.
7221
 
7222
        LD      A,($5C41)       ; fetch MODE  0='KLC', 1='E', 2='G'.
7223
        RLC     A               ; double the value and set flags.
7224
        JR      Z,L18F3         ; to OUT-C-1 if still zero ('KLC').
7225
 
7226
        ADD     A,$43           ; add 'C' - will become 'E' if originally 1
7227
                                ; or 'G' if originally 2.
7228
        JR      L1909           ; forward to OUT-C-2 to print.
7229
 
7230
; ---
7231
 
7232
; If mode was zero then, while printing a BASIC line, bit 2 of flags has been
7233
; set if 'THEN' or ':' was encountered as a main character and reset otherwise.
7234
; This is now used to determine if the 'K' cursor is to be printed but this
7235
; transient state is also now transferred permanently to bit 3 of FLAGS
7236
; to let the interrupt routine know how to decode the next key.
7237
 
7238
;; OUT-C-1
7239
L18F3:  LD      HL,$5C3B        ; Address FLAGS
7240
        RES     3,(HL)          ; signal 'K' mode initially.
7241
        LD      A,$4B           ; prepare letter 'K'.
7242
        BIT     2,(HL)          ; test FLAGS - was the
7243
                                ; previous main character ':' or 'THEN' ?
7244
        JR      Z,L1909         ; forward to OUT-C-2 if so to print.
7245
 
7246
        SET     3,(HL)          ; signal 'L' mode to interrupt routine.
7247
                                ; Note. transient bit has been made permanent.
7248
        INC     A               ; augment from 'K' to 'L'.
7249
 
7250
        BIT     3,(IY+$30)      ; test FLAGS2 - consider caps lock ?
7251
                                ; which is maintained by KEY-INPUT.
7252
        JR      Z,L1909         ; forward to OUT-C-2 if not set to print.
7253
 
7254
        LD      A,$43           ; alter 'L' to 'C'.
7255
 
7256
;; OUT-C-2
7257
L1909:  PUSH    DE              ; save address pointer but OK as OUT-FLASH
7258
                                ; uses alternate set without RST 10.
7259
 
7260
        CALL    L18C1           ; routine OUT-FLASH to print.
7261
 
7262
        POP     DE              ; restore and
7263
        RET                     ; return.
7264
 
7265
; ----------------------------
7266
; Get line number of next line
7267
; ----------------------------
7268
; These two subroutines are called while editing.
7269
; This entry point is from ED-DOWN with HL addressing E_PPC
7270
; to fetch the next line number.
7271
; Also from AUTO-LIST with HL addressing S_TOP just to update S_TOP
7272
; with the value of the next line number. It gets fetched but is discarded.
7273
; These routines never get called while the editor is being used for input.
7274
 
7275
;; LN-FETCH
7276
L190F:  LD      E,(HL)          ; fetch low byte
7277
        INC     HL              ; address next
7278
        LD      D,(HL)          ; fetch high byte.
7279
        PUSH    HL              ; save system variable hi pointer.
7280
        EX      DE,HL           ; line number to HL,
7281
        INC     HL              ; increment as a starting point.
7282
        CALL    L196E           ; routine LINE-ADDR gets address in HL.
7283
        CALL    L1695           ; routine LINE-NO gets line number in DE.
7284
        POP     HL              ; restore system variable hi pointer.
7285
 
7286
; This entry point is from the ED-UP with HL addressing E_PPC_hi
7287
 
7288
;; LN-STORE
7289
L191C:  BIT     5,(IY+$37)      ; test FLAGX - input mode ?
7290
        RET     NZ              ; return if so.
7291
                                ; Note. above already checked by ED-UP/ED-DOWN.
7292
 
7293
        LD      (HL),D          ; save high byte of line number.
7294
        DEC     HL              ; address lower
7295
        LD      (HL),E          ; save low byte of line number.
7296
        RET                     ; return.
7297
 
7298
; -----------------------------------------
7299
; Outputting numbers at start of BASIC line
7300
; -----------------------------------------
7301
; This routine entered at OUT-SP-NO is used to compute then output the first
7302
; three digits of a 4-digit BASIC line printing a space if necessary.
7303
; The line number, or residual part, is held in HL and the BC register
7304
; holds a subtraction value -1000, -100 or -10.
7305
; Note. for example line number 200 -
7306
; space(out_char), 2(out_code), 0(out_char) final number always out-code.
7307
 
7308
;; OUT-SP-2
7309
L1925:  LD      A,E             ; will be space if OUT-CODE not yet called.
7310
                                ; or $FF if spaces are suppressed.
7311
                                ; else $30 ('0').
7312
                                ; (from the first instruction at OUT-CODE)
7313
                                ; this guy is just too clever.
7314
        AND     A               ; test bit 7 of A.
7315
        RET     M               ; return if $FF, as leading spaces not
7316
                                ; required. This is set when printing line
7317
                                ; number and statement in MAIN-5.
7318
 
7319
        JR      L1937           ; forward to exit via OUT-CHAR.
7320
 
7321
; ---
7322
 
7323
; -> the single entry point.
7324
 
7325
;; OUT-SP-NO
7326
L192A:  XOR     A               ; initialize digit to 0
7327
 
7328
;; OUT-SP-1
7329
L192B:  ADD     HL,BC           ; add negative number to HL.
7330
        INC     A               ; increment digit
7331
        JR      C,L192B         ; back to OUT-SP-1 until no carry from
7332
                                ; the addition.
7333
 
7334
        SBC     HL,BC           ; cancel the last addition
7335
        DEC     A               ; and decrement the digit.
7336
        JR      Z,L1925         ; back to OUT-SP-2 if it is zero.
7337
 
7338
        JP      L15EF           ; jump back to exit via OUT-CODE.    ->
7339
 
7340
 
7341
; -------------------------------------
7342
; Outputting characters in a BASIC line
7343
; -------------------------------------
7344
; This subroutine ...
7345
 
7346
;; OUT-CHAR
7347
L1937:  CALL    L2D1B           ; routine NUMERIC tests if it is a digit ?
7348
        JR      NC,L196C        ; to OUT-CH-3 to print digit without
7349
                                ; changing mode. Will be 'K' mode if digits
7350
                                ; are at beginning of edit line.
7351
 
7352
        CP      $21             ; less than quote character ?
7353
        JR      C,L196C         ; to OUT-CH-3 to output controls and space.
7354
 
7355
        RES     2,(IY+$01)      ; initialize FLAGS to 'K' mode and leave
7356
                                ; unchanged if this character would precede
7357
                                ; a keyword.
7358
 
7359
        CP      $CB             ; is character 'THEN' token ?
7360
        JR      Z,L196C         ; to OUT-CH-3 to output if so.
7361
 
7362
        CP      $3A             ; is it ':' ?
7363
        JR      NZ,L195A        ; to OUT-CH-1 if not statement separator
7364
                                ; to change mode back to 'L'.
7365
 
7366
        BIT     5,(IY+$37)      ; FLAGX  - Input Mode ??
7367
        JR      NZ,L1968        ; to OUT-CH-2 if in input as no statements.
7368
                                ; Note. this check should seemingly be at
7369
                                ; the start. Commands seem inappropriate in
7370
                                ; INPUT mode and are rejected by the syntax
7371
                                ; checker anyway.
7372
                                ; unless INPUT LINE is being used.
7373
 
7374
        BIT     2,(IY+$30)      ; test FLAGS2 - is the ':' within quotes ?
7375
        JR      Z,L196C         ; to OUT-CH-3 if ':' is outside quoted text.
7376
 
7377
        JR      L1968           ; to OUT-CH-2 as ':' is within quotes
7378
 
7379
; ---
7380
 
7381
;; OUT-CH-1
7382
L195A:  CP      $22             ; is it quote character '"'  ?
7383
        JR      NZ,L1968        ; to OUT-CH-2 with others to set 'L' mode.
7384
 
7385
        PUSH    AF              ; save character.
7386
        LD      A,($5C6A)       ; fetch FLAGS2.
7387
        XOR     $04             ; toggle the quotes flag.
7388
        LD      ($5C6A),A       ; update FLAGS2
7389
        POP     AF              ; and restore character.
7390
 
7391
;; OUT-CH-2
7392
L1968:  SET     2,(IY+$01)      ; update FLAGS - signal L mode if the cursor
7393
                                ; is next.
7394
 
7395
;; OUT-CH-3
7396
L196C:  RST     10H             ; PRINT-A vectors the character to
7397
                                ; channel 'S', 'K', 'R' or 'P'.
7398
        RET                     ; return.
7399
 
7400
; -------------------------------------------
7401
; Get starting address of line, or line after
7402
; -------------------------------------------
7403
; This routine is used often to get the address, in HL, of a BASIC line
7404
; number supplied in HL, or failing that the address of the following line
7405
; and the address of the previous line in DE.
7406
 
7407
;; LINE-ADDR
7408
L196E:  PUSH    HL              ; save line number in HL register
7409
        LD      HL,($5C53)      ; fetch start of program from PROG
7410
        LD      D,H             ; transfer address to
7411
        LD      E,L             ; the DE register pair.
7412
 
7413
;; LINE-AD-1
7414
L1974:  POP     BC              ; restore the line number to BC
7415
        CALL    L1980           ; routine CP-LINES compares with that
7416
                                ; addressed by HL
7417
        RET     NC              ; return if line has been passed or matched.
7418
                                ; if NZ, address of previous is in DE
7419
 
7420
        PUSH    BC              ; save the current line number
7421
        CALL    L19B8           ; routine NEXT-ONE finds address of next
7422
                                ; line number in DE, previous in HL.
7423
        EX      DE,HL           ; switch so next in HL
7424
        JR      L1974           ; back to LINE-AD-1 for another comparison
7425
 
7426
; --------------------
7427
; Compare line numbers
7428
; --------------------
7429
; This routine compares a line number supplied in BC with an addressed
7430
; line number pointed to by HL.
7431
 
7432
;; CP-LINES
7433
L1980:  LD      A,(HL)          ; Load the high byte of line number and
7434
        CP      B               ; compare with that of supplied line number.
7435
        RET     NZ              ; return if yet to match (carry will be set).
7436
 
7437
        INC     HL              ; address low byte of
7438
        LD      A,(HL)          ; number and pick up in A.
7439
        DEC     HL              ; step back to first position.
7440
        CP      C               ; now compare.
7441
        RET                     ; zero set if exact match.
7442
                                ; carry set if yet to match.
7443
                                ; no carry indicates a match or
7444
                                ; next available BASIC line or
7445
                                ; program end marker.
7446
 
7447
; -------------------
7448
; Find each statement
7449
; -------------------
7450
; The single entry point EACH-STMT is used to
7451
; 1) To find the D'th statement in a line.
7452
; 2) To find a token in held E.
7453
 
7454
;; not-used
7455
L1988:  INC     HL              ;
7456
        INC     HL              ;
7457
        INC     HL              ;
7458
 
7459
; -> entry point.
7460
 
7461
;; EACH-STMT
7462
L198B:  LD      ($5C5D),HL      ; save HL in CH_ADD
7463
        LD      C,$00           ; initialize quotes flag
7464
 
7465
;; EACH-S-1
7466
L1990:  DEC     D               ; decrease statement count
7467
        RET     Z               ; return if zero
7468
 
7469
 
7470
        RST     20H             ; NEXT-CHAR
7471
        CP      E               ; is it the search token ?
7472
        JR      NZ,L199A        ; forward to EACH-S-3 if not
7473
 
7474
        AND     A               ; clear carry
7475
        RET                     ; return signalling success.
7476
 
7477
; ---
7478
 
7479
;; EACH-S-2
7480
L1998:  INC     HL              ; next address
7481
        LD      A,(HL)          ; next character
7482
 
7483
;; EACH-S-3
7484
L199A:  CALL    L18B6           ; routine NUMBER skips if number marker
7485
        LD      ($5C5D),HL      ; save in CH_ADD
7486
        CP      $22             ; is it quotes '"' ?
7487
        JR      NZ,L19A5        ; to EACH-S-4 if not
7488
 
7489
        DEC     C               ; toggle bit 0 of C
7490
 
7491
;; EACH-S-4
7492
L19A5:  CP      $3A             ; is it ':'
7493
        JR      Z,L19AD         ; to EACH-S-5
7494
 
7495
        CP      $CB             ; 'THEN'
7496
        JR      NZ,L19B1        ; to EACH-S-6
7497
 
7498
;; EACH-S-5
7499
L19AD:  BIT     0,C             ; is it in quotes
7500
        JR      Z,L1990         ; to EACH-S-1 if not
7501
 
7502
;; EACH-S-6
7503
L19B1:  CP      $0D             ; end of line ?
7504
        JR      NZ,L1998        ; to EACH-S-2
7505
 
7506
        DEC     D               ; decrease the statement counter
7507
                                ; which should be zero else
7508
                                ; 'Statement Lost'.
7509
        SCF                     ; set carry flag - not found
7510
        RET                     ; return
7511
 
7512
; -----------------------------------------------------------------------
7513
; Storage of variables. For full details - see chapter 24.
7514
; ZX Spectrum BASIC Programming by Steven Vickers 1982.
7515
; It is bits 7-5 of the first character of a variable that allow
7516
; the six types to be distinguished. Bits 4-0 are the reduced letter.
7517
; So any variable name is higher that $3F and can be distinguished
7518
; also from the variables area end-marker $80.
7519
;
7520
; 76543210 meaning                               brief outline of format.
7521
; -------- ------------------------              -----------------------
7522
; 010      string variable.                      2 byte length + contents.
7523
; 110      string array.                         2 byte length + contents.
7524
; 100      array of numbers.                     2 byte length + contents.
7525
; 011      simple numeric variable.              5 bytes.
7526
; 101      variable length named numeric.        5 bytes.
7527
; 111      for-next loop variable.               18 bytes.
7528
; 10000000 the variables area end-marker.
7529
;
7530
; Note. any of the above seven will serve as a program end-marker.
7531
;
7532
; -----------------------------------------------------------------------
7533
 
7534
; ------------
7535
; Get next one
7536
; ------------
7537
; This versatile routine is used to find the address of the next line
7538
; in the program area or the next variable in the variables area.
7539
; The reason one routine is made to handle two apparently unrelated tasks
7540
; is that it can be called indiscriminately when merging a line or a
7541
; variable.
7542
 
7543
;; NEXT-ONE
7544
L19B8:  PUSH    HL              ; save the pointer address.
7545
        LD      A,(HL)          ; get first byte.
7546
        CP      $40             ; compare with upper limit for line numbers.
7547
        JR      C,L19D5         ; forward to NEXT-O-3 if within BASIC area.
7548
 
7549
; the continuation here is for the next variable unless the supplied
7550
; line number was erroneously over 16383. see RESTORE command.
7551
 
7552
        BIT     5,A             ; is it a string or an array variable ?
7553
        JR      Z,L19D6         ; forward to NEXT-O-4 to compute length.
7554
 
7555
        ADD     A,A             ; test bit 6 for single-character variables.
7556
        JP      M,L19C7         ; forward to NEXT-O-1 if so
7557
 
7558
        CCF                     ; clear the carry for long-named variables.
7559
                                ; it remains set for for-next loop variables.
7560
 
7561
;; NEXT-O-1
7562
L19C7:  LD      BC,$0005        ; set BC to 5 for floating point number
7563
        JR      NC,L19CE        ; forward to NEXT-O-2 if not a for/next
7564
                                ; variable.
7565
 
7566
        LD      C,$12           ; set BC to eighteen locations.
7567
                                ; value, limit, step, line and statement.
7568
 
7569
; now deal with long-named variables
7570
 
7571
;; NEXT-O-2
7572
L19CE:  RLA                     ; test if character inverted. carry will also
7573
                                ; be set for single character variables
7574
        INC     HL              ; address next location.
7575
        LD      A,(HL)          ; and load character.
7576
        JR      NC,L19CE        ; back to NEXT-O-2 if not inverted bit.
7577
                                ; forward immediately with single character
7578
                                ; variable names.
7579
 
7580
        JR      L19DB           ; forward to NEXT-O-5 to add length of
7581
                                ; floating point number(s etc.).
7582
 
7583
; ---
7584
 
7585
; this branch is for line numbers.
7586
 
7587
;; NEXT-O-3
7588
L19D5:  INC     HL              ; increment pointer to low byte of line no.
7589
 
7590
; strings and arrays rejoin here
7591
 
7592
;; NEXT-O-4
7593
L19D6:  INC     HL              ; increment to address the length low byte.
7594
        LD      C,(HL)          ; transfer to C and
7595
        INC     HL              ; point to high byte of length.
7596
        LD      B,(HL)          ; transfer that to B
7597
        INC     HL              ; point to start of BASIC/variable contents.
7598
 
7599
; the three types of numeric variables rejoin here
7600
 
7601
;; NEXT-O-5
7602
L19DB:  ADD     HL,BC           ; add the length to give address of next
7603
                                ; line/variable in HL.
7604
        POP     DE              ; restore previous address to DE.
7605
 
7606
; ------------------
7607
; Difference routine
7608
; ------------------
7609
; This routine terminates the above routine and is also called from the
7610
; start of the next routine to calculate the length to reclaim.
7611
 
7612
;; DIFFER
7613
L19DD:  AND     A               ; prepare for true subtraction.
7614
        SBC     HL,DE           ; subtract the two pointers.
7615
        LD      B,H             ; transfer result
7616
        LD      C,L             ; to BC register pair.
7617
        ADD     HL,DE           ; add back
7618
        EX      DE,HL           ; and switch pointers
7619
        RET                     ; return values are the length of area in BC,
7620
                                ; low pointer (previous) in HL,
7621
                                ; high pointer (next) in DE.
7622
 
7623
; -----------------------
7624
; Handle reclaiming space
7625
; -----------------------
7626
;
7627
 
7628
;; RECLAIM-1
7629
L19E5:  CALL    L19DD           ; routine DIFFER immediately above
7630
 
7631
;; RECLAIM-2
7632
L19E8:  PUSH    BC              ;
7633
 
7634
        LD      A,B             ;
7635
        CPL                     ;
7636
        LD      B,A             ;
7637
        LD      A,C             ;
7638
        CPL                     ;
7639
        LD      C,A             ;
7640
        INC     BC              ;
7641
 
7642
        CALL    L1664           ; routine POINTERS
7643
        EX      DE,HL           ;
7644
        POP     HL              ;
7645
 
7646
        ADD     HL,DE           ;
7647
        PUSH    DE              ;
7648
        LDIR                    ; copy bytes
7649
 
7650
        POP     HL              ;
7651
        RET                     ;
7652
 
7653
; ----------------------------------------
7654
; Read line number of line in editing area
7655
; ----------------------------------------
7656
; This routine reads a line number in the editing area returning the number
7657
; in the BC register or zero if no digits exist before commands.
7658
; It is called from LINE-SCAN to check the syntax of the digits.
7659
; It is called from MAIN-3 to extract the line number in preparation for
7660
; inclusion of the line in the BASIC program area.
7661
;
7662
; Interestingly the calculator stack is moved from its normal place at the
7663
; end of dynamic memory to an adequate area within the system variables area.
7664
; This ensures that in a low memory situation, that valid line numbers can
7665
; be extracted without raising an error and that memory can be reclaimed
7666
; by deleting lines. If the stack was in its normal place then a situation
7667
; arises whereby the Spectrum becomes locked with no means of reclaiming space.
7668
 
7669
;; E-LINE-NO
7670
L19FB:  LD      HL,($5C59)      ; load HL from system variable E_LINE.
7671
 
7672
        DEC     HL              ; decrease so that NEXT_CHAR can be used
7673
                                ; without skipping the first digit.
7674
 
7675
        LD      ($5C5D),HL      ; store in the system variable CH_ADD.
7676
 
7677
        RST     20H             ; NEXT-CHAR skips any noise and white-space
7678
                                ; to point exactly at the first digit.
7679
 
7680
        LD      HL,$5C92        ; use MEM-0 as a temporary calculator stack
7681
                                ; an overhead of three locations are needed.
7682
        LD      ($5C65),HL      ; set new STKEND.
7683
 
7684
        CALL    L2D3B           ; routine INT-TO-FP will read digits till
7685
                                ; a non-digit found.
7686
        CALL    L2DA2           ; routine FP-TO-BC will retrieve number
7687
                                ; from stack at membot.
7688
        JR      C,L1A15         ; forward to E-L-1 if overflow i.e. > 65535.
7689
                                ; 'Nonsense in BASIC'
7690
 
7691
        LD      HL,$D8F0        ; load HL with value -9999
7692
        ADD     HL,BC           ; add to line number in BC
7693
 
7694
;; E-L-1
7695
L1A15:  JP      C,L1C8A         ; to REPORT-C 'Nonsense in BASIC' if over.
7696
                                ; Note. As ERR_SP points to ED_ERROR
7697
                                ; the report is never produced although
7698
                                ; the RST $08 will update X_PTR leading to
7699
                                ; the error marker being displayed when
7700
                                ; the ED_LOOP is reiterated.
7701
                                ; in fact, since it is immediately
7702
                                ; cancelled, any report will do.
7703
 
7704
; a line in the range 0 - 9999 has been entered.
7705
 
7706
        JP      L16C5           ; jump back to SET-STK to set the calculator
7707
                                ; stack back to its normal place and exit
7708
                                ; from there.
7709
 
7710
; ---------------------------------
7711
; Report and line number outputting
7712
; ---------------------------------
7713
; Entry point OUT-NUM-1 is used by the Error Reporting code to print
7714
; the line number and later the statement number held in BC.
7715
; If the statement was part of a direct command then -2 is used as a
7716
; dummy line number so that zero will be printed in the report.
7717
; This routine is also used to print the exponent of E-format numbers.
7718
;
7719
; Entry point OUT-NUM-2 is used from OUT-LINE to output the line number
7720
; addressed by HL with leading spaces if necessary.
7721
 
7722
;; OUT-NUM-1
7723
L1A1B:  PUSH    DE              ; save the
7724
        PUSH    HL              ; registers.
7725
        XOR     A               ; set A to zero.
7726
        BIT     7,B             ; is the line number minus two ?
7727
        JR      NZ,L1A42        ; forward to OUT-NUM-4 if so to print zero
7728
                                ; for a direct command.
7729
 
7730
        LD      H,B             ; transfer the
7731
        LD      L,C             ; number to HL.
7732
        LD      E,$FF           ; signal 'no leading zeros'.
7733
        JR      L1A30           ; forward to continue at OUT-NUM-3
7734
 
7735
; ---
7736
 
7737
; from OUT-LINE - HL addresses line number.
7738
 
7739
;; OUT-NUM-2
7740
L1A28:  PUSH    DE              ; save flags
7741
        LD      D,(HL)          ; high byte to D
7742
        INC     HL              ; address next
7743
        LD      E,(HL)          ; low byte to E
7744
        PUSH    HL              ; save pointer
7745
        EX      DE,HL           ; transfer number to HL
7746
        LD      E,$20           ; signal 'output leading spaces'
7747
 
7748
;; OUT-NUM-3
7749
L1A30:  LD      BC,$FC18        ; value -1000
7750
        CALL    L192A           ; routine OUT-SP-NO outputs space or number
7751
        LD      BC,$FF9C        ; value -100
7752
        CALL    L192A           ; routine OUT-SP-NO
7753
        LD      C,$F6           ; value -10 ( B is still $FF )
7754
        CALL    L192A           ; routine OUT-SP-NO
7755
        LD      A,L             ; remainder to A.
7756
 
7757
;; OUT-NUM-4
7758
L1A42:  CALL    L15EF           ; routine OUT-CODE for final digit.
7759
                                ; else report code zero wouldn't get
7760
                                ; printed.
7761
        POP     HL              ; restore the
7762
        POP     DE              ; registers and
7763
        RET                     ; return.
7764
 
7765
 
7766
;***************************************************
7767
;** Part 7. BASIC LINE AND COMMAND INTERPRETATION **
7768
;***************************************************
7769
 
7770
; ----------------
7771
; The offset table
7772
; ----------------
7773
; The BASIC interpreter has found a command code $CE - $FF
7774
; which is then reduced to range $00 - $31 and added to the base address
7775
; of this table to give the address of an offset which, when added to
7776
; the offset therein, gives the location in the following parameter table
7777
; where a list of class codes, separators and addresses relevant to the
7778
; command exists.
7779
 
7780
;; offst-tbl
7781
L1A48:  DEFB    L1AF9 - $       ; B1 offset to Address: P-DEF-FN
7782
        DEFB    L1B14 - $       ; CB offset to Address: P-CAT
7783
        DEFB    L1B06 - $       ; BC offset to Address: P-FORMAT
7784
        DEFB    L1B0A - $       ; BF offset to Address: P-MOVE
7785
        DEFB    L1B10 - $       ; C4 offset to Address: P-ERASE
7786
        DEFB    L1AFC - $       ; AF offset to Address: P-OPEN
7787
        DEFB    L1B02 - $       ; B4 offset to Address: P-CLOSE
7788
        DEFB    L1AE2 - $       ; 93 offset to Address: P-MERGE
7789
        DEFB    L1AE1 - $       ; 91 offset to Address: P-VERIFY
7790
        DEFB    L1AE3 - $       ; 92 offset to Address: P-BEEP
7791
        DEFB    L1AE7 - $       ; 95 offset to Address: P-CIRCLE
7792
        DEFB    L1AEB - $       ; 98 offset to Address: P-INK
7793
        DEFB    L1AEC - $       ; 98 offset to Address: P-PAPER
7794
        DEFB    L1AED - $       ; 98 offset to Address: P-FLASH
7795
        DEFB    L1AEE - $       ; 98 offset to Address: P-BRIGHT
7796
        DEFB    L1AEF - $       ; 98 offset to Address: P-INVERSE
7797
        DEFB    L1AF0 - $       ; 98 offset to Address: P-OVER
7798
        DEFB    L1AF1 - $       ; 98 offset to Address: P-OUT
7799
        DEFB    L1AD9 - $       ; 7F offset to Address: P-LPRINT
7800
        DEFB    L1ADC - $       ; 81 offset to Address: P-LLIST
7801
        DEFB    L1A8A - $       ; 2E offset to Address: P-STOP
7802
        DEFB    L1AC9 - $       ; 6C offset to Address: P-READ
7803
        DEFB    L1ACC - $       ; 6E offset to Address: P-DATA
7804
        DEFB    L1ACF - $       ; 70 offset to Address: P-RESTORE
7805
        DEFB    L1AA8 - $       ; 48 offset to Address: P-NEW
7806
        DEFB    L1AF5 - $       ; 94 offset to Address: P-BORDER
7807
        DEFB    L1AB8 - $       ; 56 offset to Address: P-CONT
7808
        DEFB    L1AA2 - $       ; 3F offset to Address: P-DIM
7809
        DEFB    L1AA5 - $       ; 41 offset to Address: P-REM
7810
        DEFB    L1A90 - $       ; 2B offset to Address: P-FOR
7811
        DEFB    L1A7D - $       ; 17 offset to Address: P-GO-TO
7812
        DEFB    L1A86 - $       ; 1F offset to Address: P-GO-SUB
7813
        DEFB    L1A9F - $       ; 37 offset to Address: P-INPUT
7814
        DEFB    L1AE0 - $       ; 77 offset to Address: P-LOAD
7815
        DEFB    L1AAE - $       ; 44 offset to Address: P-LIST
7816
        DEFB    L1A7A - $       ; 0F offset to Address: P-LET
7817
        DEFB    L1AC5 - $       ; 59 offset to Address: P-PAUSE
7818
        DEFB    L1A98 - $       ; 2B offset to Address: P-NEXT
7819
        DEFB    L1AB1 - $       ; 43 offset to Address: P-POKE
7820
        DEFB    L1A9C - $       ; 2D offset to Address: P-PRINT
7821
        DEFB    L1AC1 - $       ; 51 offset to Address: P-PLOT
7822
        DEFB    L1AAB - $       ; 3A offset to Address: P-RUN
7823
        DEFB    L1ADF - $       ; 6D offset to Address: P-SAVE
7824
        DEFB    L1AB5 - $       ; 42 offset to Address: P-RANDOM
7825
        DEFB    L1A81 - $       ; 0D offset to Address: P-IF
7826
        DEFB    L1ABE - $       ; 49 offset to Address: P-CLS
7827
        DEFB    L1AD2 - $       ; 5C offset to Address: P-DRAW
7828
        DEFB    L1ABB - $       ; 44 offset to Address: P-CLEAR
7829
        DEFB    L1A8D - $       ; 15 offset to Address: P-RETURN
7830
        DEFB    L1AD6 - $       ; 5D offset to Address: P-COPY
7831
 
7832
 
7833
; -------------------------------
7834
; The parameter or "Syntax" table
7835
; -------------------------------
7836
; For each command there exists a variable list of parameters.
7837
; If the character is greater than a space it is a required separator.
7838
; If less, then it is a command class in the range 00 - 0B.
7839
; Note that classes 00, 03 and 05 will fetch the addresses from this table.
7840
; Some classes e.g. 07 and 0B have the same address in all invocations
7841
; and the command is re-computed from the low-byte of the parameter address.
7842
; Some e.g. 02 are only called once so a call to the command is made from
7843
; within the class routine rather than holding the address within the table.
7844
; Some class routines check syntax entirely and some leave this task for the
7845
; command itself.
7846
; Others for example CIRCLE (x,y,z) check the first part (x,y) using the
7847
; class routine and the final part (,z) within the command.
7848
; The last few commands appear to have been added in a rush but their syntax
7849
; is rather simple e.g. MOVE "M1","M2"
7850
 
7851
;; P-LET
7852
L1A7A:  DEFB    $01             ; Class-01 - A variable is required.
7853
        DEFB    $3D             ; Separator:  '='
7854
        DEFB    $02             ; Class-02 - An expression, numeric or string,
7855
                                ; must follow.
7856
 
7857
;; P-GO-TO
7858
L1A7D:  DEFB    $06             ; Class-06 - A numeric expression must follow.
7859
        DEFB    $00             ; Class-00 - No further operands.
7860
        DEFW    L1E67           ; Address: $1E67; Address: GO-TO
7861
 
7862
;; P-IF
7863
L1A81:  DEFB    $06             ; Class-06 - A numeric expression must follow.
7864
        DEFB    $CB             ; Separator:  'THEN'
7865
        DEFB    $05             ; Class-05 - Variable syntax checked
7866
                                ; by routine.
7867
        DEFW    L1CF0           ; Address: $1CF0; Address: IF
7868
 
7869
;; P-GO-SUB
7870
L1A86:  DEFB    $06             ; Class-06 - A numeric expression must follow.
7871
        DEFB    $00             ; Class-00 - No further operands.
7872
        DEFW    L1EED           ; Address: $1EED; Address: GO-SUB
7873
 
7874
;; P-STOP
7875
L1A8A:  DEFB    $00             ; Class-00 - No further operands.
7876
        DEFW    L1CEE           ; Address: $1CEE; Address: STOP
7877
 
7878
;; P-RETURN
7879
L1A8D:  DEFB    $00             ; Class-00 - No further operands.
7880
        DEFW    L1F23           ; Address: $1F23; Address: RETURN
7881
 
7882
;; P-FOR
7883
L1A90:  DEFB    $04             ; Class-04 - A single character variable must
7884
                                ; follow.
7885
        DEFB    $3D             ; Separator:  '='
7886
        DEFB    $06             ; Class-06 - A numeric expression must follow.
7887
        DEFB    $CC             ; Separator:  'TO'
7888
        DEFB    $06             ; Class-06 - A numeric expression must follow.
7889
        DEFB    $05             ; Class-05 - Variable syntax checked
7890
                                ; by routine.
7891
        DEFW    L1D03           ; Address: $1D03; Address: FOR
7892
 
7893
;; P-NEXT
7894
L1A98:  DEFB    $04             ; Class-04 - A single character variable must
7895
                                ; follow.
7896
        DEFB    $00             ; Class-00 - No further operands.
7897
        DEFW    L1DAB           ; Address: $1DAB; Address: NEXT
7898
 
7899
;; P-PRINT
7900
L1A9C:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7901
                                ; by routine.
7902
        DEFW    L1FCD           ; Address: $1FCD; Address: PRINT
7903
 
7904
;; P-INPUT
7905
L1A9F:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7906
                                ; by routine.
7907
        DEFW    L2089           ; Address: $2089; Address: INPUT
7908
 
7909
;; P-DIM
7910
L1AA2:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7911
                                ; by routine.
7912
        DEFW    L2C02           ; Address: $2C02; Address: DIM
7913
 
7914
;; P-REM
7915
L1AA5:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7916
                                ; by routine.
7917
        DEFW    L1BB2           ; Address: $1BB2; Address: REM
7918
 
7919
;; P-NEW
7920
L1AA8:  DEFB    $00             ; Class-00 - No further operands.
7921
        DEFW    L11B7           ; Address: $11B7; Address: NEW
7922
 
7923
;; P-RUN
7924
L1AAB:  DEFB    $03             ; Class-03 - A numeric expression may follow
7925
                                ; else default to zero.
7926
        DEFW    L1EA1           ; Address: $1EA1; Address: RUN
7927
 
7928
;; P-LIST
7929
L1AAE:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7930
                                ; by routine.
7931
        DEFW    L17F9           ; Address: $17F9; Address: LIST
7932
 
7933
;; P-POKE
7934
L1AB1:  DEFB    $08             ; Class-08 - Two comma-separated numeric
7935
                                ; expressions required.
7936
        DEFB    $00             ; Class-00 - No further operands.
7937
        DEFW    L1E80           ; Address: $1E80; Address: POKE
7938
 
7939
;; P-RANDOM
7940
L1AB5:  DEFB    $03             ; Class-03 - A numeric expression may follow
7941
                                ; else default to zero.
7942
        DEFW    L1E4F           ; Address: $1E4F; Address: RANDOMIZE
7943
 
7944
;; P-CONT
7945
L1AB8:  DEFB    $00             ; Class-00 - No further operands.
7946
        DEFW    L1E5F           ; Address: $1E5F; Address: CONTINUE
7947
 
7948
;; P-CLEAR
7949
L1ABB:  DEFB    $03             ; Class-03 - A numeric expression may follow
7950
                                ; else default to zero.
7951
        DEFW    L1EAC           ; Address: $1EAC; Address: CLEAR
7952
 
7953
;; P-CLS
7954
L1ABE:  DEFB    $00             ; Class-00 - No further operands.
7955
        DEFW    L0D6B           ; Address: $0D6B; Address: CLS
7956
 
7957
;; P-PLOT
7958
L1AC1:  DEFB    $09             ; Class-09 - Two comma-separated numeric
7959
                                ; expressions required with optional colour
7960
                                ; items.
7961
        DEFB    $00             ; Class-00 - No further operands.
7962
        DEFW    L22DC           ; Address: $22DC; Address: PLOT
7963
 
7964
;; P-PAUSE
7965
L1AC5:  DEFB    $06             ; Class-06 - A numeric expression must follow.
7966
        DEFB    $00             ; Class-00 - No further operands.
7967
        DEFW    L1F3A           ; Address: $1F3A; Address: PAUSE
7968
 
7969
;; P-READ
7970
L1AC9:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7971
                                ; by routine.
7972
        DEFW    L1DED           ; Address: $1DED; Address: READ
7973
 
7974
;; P-DATA
7975
L1ACC:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7976
                                ; by routine.
7977
        DEFW    L1E27           ; Address: $1E27; Address: DATA
7978
 
7979
;; P-RESTORE
7980
L1ACF:  DEFB    $03             ; Class-03 - A numeric expression may follow
7981
                                ; else default to zero.
7982
        DEFW    L1E42           ; Address: $1E42; Address: RESTORE
7983
 
7984
;; P-DRAW
7985
L1AD2:  DEFB    $09             ; Class-09 - Two comma-separated numeric
7986
                                ; expressions required with optional colour
7987
                                ; items.
7988
        DEFB    $05             ; Class-05 - Variable syntax checked
7989
                                ; by routine.
7990
        DEFW    L2382           ; Address: $2382; Address: DRAW
7991
 
7992
;; P-COPY
7993
L1AD6:  DEFB    $00             ; Class-00 - No further operands.
7994
        DEFW    L0EAC           ; Address: $0EAC; Address: COPY
7995
 
7996
;; P-LPRINT
7997
L1AD9:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
7998
                                ; by routine.
7999
        DEFW    L1FC9           ; Address: $1FC9; Address: LPRINT
8000
 
8001
;; P-LLIST
8002
L1ADC:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
8003
                                ; by routine.
8004
        DEFW    L17F5           ; Address: $17F5; Address: LLIST
8005
 
8006
;; P-SAVE
8007
L1ADF:  DEFB    $0B             ; Class-0B - Offset address converted to tape
8008
                                ; command.
8009
 
8010
;; P-LOAD
8011
L1AE0:  DEFB    $0B             ; Class-0B - Offset address converted to tape
8012
                                ; command.
8013
 
8014
;; P-VERIFY
8015
L1AE1:  DEFB    $0B             ; Class-0B - Offset address converted to tape
8016
                                ; command.
8017
 
8018
;; P-MERGE
8019
L1AE2:  DEFB    $0B             ; Class-0B - Offset address converted to tape
8020
                                ; command.
8021
 
8022
;; P-BEEP
8023
L1AE3:  DEFB    $08             ; Class-08 - Two comma-separated numeric
8024
                                ; expressions required.
8025
        DEFB    $00             ; Class-00 - No further operands.
8026
        DEFW    L03F8           ; Address: $03F8; Address: BEEP
8027
 
8028
;; P-CIRCLE
8029
L1AE7:  DEFB    $09             ; Class-09 - Two comma-separated numeric
8030
                                ; expressions required with optional colour
8031
                                ; items.
8032
        DEFB    $05             ; Class-05 - Variable syntax checked
8033
                                ; by routine.
8034
        DEFW    L2320           ; Address: $2320; Address: CIRCLE
8035
 
8036
;; P-INK
8037
L1AEB:  DEFB    $07             ; Class-07 - Offset address is converted to
8038
                                ; colour code.
8039
 
8040
;; P-PAPER
8041
L1AEC:  DEFB    $07             ; Class-07 - Offset address is converted to
8042
                                ; colour code.
8043
 
8044
;; P-FLASH
8045
L1AED:  DEFB    $07             ; Class-07 - Offset address is converted to
8046
                                ; colour code.
8047
 
8048
;; P-BRIGHT
8049
L1AEE:  DEFB    $07             ; Class-07 - Offset address is converted to
8050
                                ; colour code.
8051
 
8052
;; P-INVERSE
8053
L1AEF:  DEFB    $07             ; Class-07 - Offset address is converted to
8054
                                ; colour code.
8055
 
8056
;; P-OVER
8057
L1AF0:  DEFB    $07             ; Class-07 - Offset address is converted to
8058
                                ; colour code.
8059
 
8060
;; P-OUT
8061
L1AF1:  DEFB    $08             ; Class-08 - Two comma-separated numeric
8062
                                ; expressions required.
8063
        DEFB    $00             ; Class-00 - No further operands.
8064
        DEFW    L1E7A           ; Address: $1E7A; Address: OUT
8065
 
8066
;; P-BORDER
8067
L1AF5:  DEFB    $06             ; Class-06 - A numeric expression must follow.
8068
        DEFB    $00             ; Class-00 - No further operands.
8069
        DEFW    L2294           ; Address: $2294; Address: BORDER
8070
 
8071
;; P-DEF-FN
8072
L1AF9:  DEFB    $05             ; Class-05 - Variable syntax checked entirely
8073
                                ; by routine.
8074
        DEFW    L1F60           ; Address: $1F60; Address: DEF-FN
8075
 
8076
;; P-OPEN
8077
L1AFC:  DEFB    $06             ; Class-06 - A numeric expression must follow.
8078
        DEFB    $2C             ; Separator:  ','          see Footnote *
8079
        DEFB    $0A             ; Class-0A - A string expression must follow.
8080
        DEFB    $00             ; Class-00 - No further operands.
8081
        DEFW    L1736           ; Address: $1736; Address: OPEN
8082
 
8083
;; P-CLOSE
8084
L1B02:  DEFB    $06             ; Class-06 - A numeric expression must follow.
8085
        DEFB    $00             ; Class-00 - No further operands.
8086
        DEFW    L16E5           ; Address: $16E5; Address: CLOSE
8087
 
8088
;; P-FORMAT
8089
L1B06:  DEFB    $0A             ; Class-0A - A string expression must follow.
8090
        DEFB    $00             ; Class-00 - No further operands.
8091
        DEFW    L1793           ; Address: $1793; Address: CAT-ETC
8092
 
8093
;; P-MOVE
8094
L1B0A:  DEFB    $0A             ; Class-0A - A string expression must follow.
8095
        DEFB    $2C             ; Separator:  ','
8096
        DEFB    $0A             ; Class-0A - A string expression must follow.
8097
        DEFB    $00             ; Class-00 - No further operands.
8098
        DEFW    L1793           ; Address: $1793; Address: CAT-ETC
8099
 
8100
;; P-ERASE
8101
L1B10:  DEFB    $0A             ; Class-0A - A string expression must follow.
8102
        DEFB    $00             ; Class-00 - No further operands.
8103
        DEFW    L1793           ; Address: $1793; Address: CAT-ETC
8104
 
8105
;; P-CAT
8106
L1B14:  DEFB    $00             ; Class-00 - No further operands.
8107
        DEFW    L1793           ; Address: $1793; Address: CAT-ETC
8108
 
8109
; * Note that a comma is required as a separator with the OPEN command
8110
; but the Interface 1 programmers relaxed this allowing ';' as an
8111
; alternative for their channels creating a confusing mixture of
8112
; allowable syntax as it is this ROM which opens or re-opens the
8113
; normal channels.
8114
 
8115
; -------------------------------
8116
; Main parser (BASIC interpreter)
8117
; -------------------------------
8118
; This routine is called once from MAIN-2 when the BASIC line is to
8119
; be entered or re-entered into the Program area and the syntax
8120
; requires checking.
8121
 
8122
;; LINE-SCAN
8123
L1B17:  RES     7,(IY+$01)      ; update FLAGS - signal checking syntax
8124
        CALL    L19FB           ; routine E-LINE-NO              >>
8125
                                ; fetches the line number if in range.
8126
 
8127
        XOR     A               ; clear the accumulator.
8128
        LD      ($5C47),A       ; set statement number SUBPPC to zero.
8129
        DEC     A               ; set accumulator to $FF.
8130
        LD      ($5C3A),A       ; set ERR_NR to 'OK' - 1.
8131
        JR      L1B29           ; forward to continue at STMT-L-1.
8132
 
8133
; --------------
8134
; Statement loop
8135
; --------------
8136
;
8137
;
8138
 
8139
;; STMT-LOOP
8140
L1B28:  RST     20H             ; NEXT-CHAR
8141
 
8142
; -> the entry point from above or LINE-RUN
8143
;; STMT-L-1
8144
L1B29:  CALL    L16BF           ; routine SET-WORK clears workspace etc.
8145
 
8146
        INC     (IY+$0D)        ; increment statement number SUBPPC
8147
        JP      M,L1C8A         ; to REPORT-C to raise
8148
                                ; 'Nonsense in BASIC' if over 127.
8149
 
8150
        RST     18H             ; GET-CHAR
8151
 
8152
        LD      B,$00           ; set B to zero for later indexing.
8153
                                ; early so any other reason ???
8154
 
8155
        CP      $0D             ; is character carriage return ?
8156
                                ; i.e. an empty statement.
8157
        JR      Z,L1BB3         ; forward to LINE-END if so.
8158
 
8159
        CP      $3A             ; is it statement end marker ':' ?
8160
                                ; i.e. another type of empty statement.
8161
        JR      Z,L1B28         ; back to STMT-LOOP if so.
8162
 
8163
        LD      HL,L1B76        ; address: STMT-RET
8164
        PUSH    HL              ; is now pushed as a return address
8165
        LD      C,A             ; transfer the current character to C.
8166
 
8167
; advance CH_ADD to a position after command and test if it is a command.
8168
 
8169
        RST     20H             ; NEXT-CHAR to advance pointer
8170
        LD      A,C             ; restore current character
8171
        SUB     $CE             ; subtract 'DEF FN' - first command
8172
        JP      C,L1C8A         ; jump to REPORT-C if less than a command
8173
                                ; raising
8174
                                ; 'Nonsense in BASIC'
8175
 
8176
        LD      C,A             ; put the valid command code back in C.
8177
                                ; register B is zero.
8178
        LD      HL,L1A48        ; address: offst-tbl
8179
        ADD     HL,BC           ; index into table with one of 50 commands.
8180
        LD      C,(HL)          ; pick up displacement to syntax table entry.
8181
        ADD     HL,BC           ; add to address the relevant entry.
8182
        JR      L1B55           ; forward to continue at GET-PARAM
8183
 
8184
; ----------------------
8185
; The main scanning loop
8186
; ----------------------
8187
; not documented properly
8188
;
8189
 
8190
;; SCAN-LOOP
8191
L1B52:  LD      HL,($5C74)      ; fetch temporary address from T_ADDR
8192
                                ; during subsequent loops.
8193
 
8194
; -> the initial entry point with HL addressing start of syntax table entry.
8195
 
8196
;; GET-PARAM
8197
L1B55:  LD      A,(HL)          ; pick up the parameter.
8198
        INC     HL              ; address next one.
8199
        LD      ($5C74),HL      ; save pointer in system variable T_ADDR
8200
 
8201
        LD      BC,L1B52        ; address: SCAN-LOOP
8202
        PUSH    BC              ; is now pushed on stack as looping address.
8203
        LD      C,A             ; store parameter in C.
8204
        CP      $20             ; is it greater than ' '  ?
8205
        JR      NC,L1B6F        ; forward to SEPARATOR to check that correct
8206
                                ; separator appears in statement if so.
8207
 
8208
        LD      HL,L1C01        ; address: class-tbl.
8209
        LD      B,$00           ; prepare to index into the class table.
8210
        ADD     HL,BC           ; index to find displacement to routine.
8211
        LD      C,(HL)          ; displacement to BC
8212
        ADD     HL,BC           ; add to address the CLASS routine.
8213
        PUSH    HL              ; push the address on the stack.
8214
 
8215
        RST     18H             ; GET-CHAR - HL points to place in statement.
8216
 
8217
        DEC     B               ; reset the zero flag - the initial state
8218
                                ; for all class routines.
8219
 
8220
        RET                     ; and make an indirect jump to routine
8221
                                ; and then SCAN-LOOP (also on stack).
8222
 
8223
; Note. one of the class routines will eventually drop the return address
8224
; off the stack breaking out of the above seemingly endless loop.
8225
 
8226
; -----------------------
8227
; THE 'SEPARATOR' ROUTINE
8228
; -----------------------
8229
;   This routine is called once to verify that the mandatory separator
8230
;   present in the parameter table is also present in the correct
8231
;   location following the command.  For example, the 'THEN' token after
8232
;   the 'IF' token and expression.
8233
 
8234
;; SEPARATOR
8235
L1B6F:  RST     18H             ; GET-CHAR
8236
        CP      C               ; does it match the character in C ?
8237
        JP      NZ,L1C8A        ; jump forward to REPORT-C if not
8238
                                ; 'Nonsense in BASIC'.
8239
 
8240
        RST     20H             ; NEXT-CHAR advance to next character
8241
        RET                     ; return.
8242
 
8243
; ------------------------------
8244
; Come here after interpretation
8245
; ------------------------------
8246
;
8247
;
8248
 
8249
;; STMT-RET
8250
L1B76:  CALL    L1F54           ; routine BREAK-KEY is tested after every
8251
                                ; statement.
8252
        JR      C,L1B7D         ; step forward to STMT-R-1 if not pressed.
8253
 
8254
;; REPORT-L
8255
L1B7B:  RST     08H             ; ERROR-1
8256
        DEFB    $14             ; Error Report: BREAK into program
8257
 
8258
;; STMT-R-1
8259
L1B7D:  BIT     7,(IY+$0A)      ; test NSPPC - will be set if $FF -
8260
                                ; no jump to be made.
8261
        JR      NZ,L1BF4        ; forward to STMT-NEXT if a program line.
8262
 
8263
        LD      HL,($5C42)      ; fetch line number from NEWPPC
8264
        BIT     7,H             ; will be set if minus two - direct command(s)
8265
        JR      Z,L1B9E         ; forward to LINE-NEW if a jump is to be
8266
                                ; made to a new program line/statement.
8267
 
8268
; --------------------
8269
; Run a direct command
8270
; --------------------
8271
; A direct command is to be run or, if continuing from above,
8272
; the next statement of a direct command is to be considered.
8273
 
8274
;; LINE-RUN
8275
L1B8A:  LD      HL,$FFFE        ; The dummy value minus two
8276
        LD      ($5C45),HL      ; is set/reset as line number in PPC.
8277
        LD      HL,($5C61)      ; point to end of line + 1 - WORKSP.
8278
        DEC     HL              ; now point to $80 end-marker.
8279
        LD      DE,($5C59)      ; address the start of line E_LINE.
8280
        DEC     DE              ; now location before - for GET-CHAR.
8281
        LD      A,($5C44)       ; load statement to A from NSPPC.
8282
        JR      L1BD1           ; forward to NEXT-LINE.
8283
 
8284
; ------------------------------
8285
; Find start address of new line
8286
; ------------------------------
8287
; The branch was to here if a jump is to made to a new line number
8288
; and statement.
8289
; That is the previous statement was a GO TO, GO SUB, RUN, RETURN, NEXT etc..
8290
 
8291
;; LINE-NEW
8292
L1B9E:  CALL    L196E           ; routine LINE-ADDR gets address of line
8293
                                ; returning zero flag set if line found.
8294
        LD      A,($5C44)       ; fetch new statement from NSPPC
8295
        JR      Z,L1BBF         ; forward to LINE-USE if line matched.
8296
 
8297
; continue as must be a direct command.
8298
 
8299
        AND     A               ; test statement which should be zero
8300
        JR      NZ,L1BEC        ; forward to REPORT-N if not.
8301
                                ; 'Statement lost'
8302
 
8303
;
8304
 
8305
        LD      B,A             ; save statement in B.??
8306
        LD      A,(HL)          ; fetch high byte of line number.
8307
        AND     $C0             ; test if using direct command
8308
                                ; a program line is less than $3F
8309
        LD      A,B             ; retrieve statement.
8310
                                ; (we can assume it is zero).
8311
        JR      Z,L1BBF         ; forward to LINE-USE if was a program line
8312
 
8313
; Alternatively a direct statement has finished correctly.
8314
 
8315
;; REPORT-0
8316
L1BB0:  RST     08H             ; ERROR-1
8317
        DEFB    $FF             ; Error Report: OK
8318
 
8319
; -----------------
8320
; THE 'REM' COMMAND
8321
; -----------------
8322
; The REM command routine.
8323
; The return address STMT-RET is dropped and the rest of line ignored.
8324
 
8325
;; REM
8326
L1BB2:  POP     BC              ; drop return address STMT-RET and
8327
                                ; continue ignoring rest of line.
8328
 
8329
; ------------
8330
; End of line?
8331
; ------------
8332
;
8333
;
8334
 
8335
;; LINE-END
8336
L1BB3:  CALL    L2530           ; routine SYNTAX-Z  (UNSTACK-Z?)
8337
        RET     Z               ; return if checking syntax.
8338
 
8339
        LD      HL,($5C55)      ; fetch NXTLIN to HL.
8340
        LD      A,$C0           ; test against the
8341
        AND     (HL)            ; system limit $3F.
8342
        RET     NZ              ; return if more as must be
8343
                                ; end of program.
8344
                                ; (or direct command)
8345
 
8346
        XOR     A               ; set statement to zero.
8347
 
8348
; and continue to set up the next following line and then consider this new one.
8349
 
8350
; ---------------------
8351
; General line checking
8352
; ---------------------
8353
; The branch was here from LINE-NEW if BASIC is branching.
8354
; or a continuation from above if dealing with a new sequential line.
8355
; First make statement zero number one leaving others unaffected.
8356
 
8357
;; LINE-USE
8358
L1BBF:  CP      $01             ; will set carry if zero.
8359
        ADC     A,$00           ; add in any carry.
8360
 
8361
        LD      D,(HL)          ; high byte of line number to D.
8362
        INC     HL              ; advance pointer.
8363
        LD      E,(HL)          ; low byte of line number to E.
8364
        LD      ($5C45),DE      ; set system variable PPC.
8365
 
8366
        INC     HL              ; advance pointer.
8367
        LD      E,(HL)          ; low byte of line length to E.
8368
        INC     HL              ; advance pointer.
8369
        LD      D,(HL)          ; high byte of line length to D.
8370
 
8371
        EX      DE,HL           ; swap pointer to DE before
8372
        ADD     HL,DE           ; adding to address the end of line.
8373
        INC     HL              ; advance to start of next line.
8374
 
8375
; -----------------------------
8376
; Update NEXT LINE but consider
8377
; previous line or edit line.
8378
; -----------------------------
8379
; The pointer will be the next line if continuing from above or to
8380
; edit line end-marker ($80) if from LINE-RUN.
8381
 
8382
;; NEXT-LINE
8383
L1BD1:  LD      ($5C55),HL      ; store pointer in system variable NXTLIN
8384
 
8385
        EX      DE,HL           ; bring back pointer to previous or edit line
8386
        LD      ($5C5D),HL      ; and update CH_ADD with character address.
8387
 
8388
        LD      D,A             ; store statement in D.
8389
        LD      E,$00           ; set E to zero to suppress token searching
8390
                                ; if EACH-STMT is to be called.
8391
        LD      (IY+$0A),$FF    ; set statement NSPPC to $FF signalling
8392
                                ; no jump to be made.
8393
        DEC     D               ; decrement and test statement
8394
        LD      (IY+$0D),D      ; set SUBPPC to decremented statement number.
8395
        JP      Z,L1B28         ; to STMT-LOOP if result zero as statement is
8396
                                ; at start of line and address is known.
8397
 
8398
        INC     D               ; else restore statement.
8399
        CALL    L198B           ; routine EACH-STMT finds the D'th statement
8400
                                ; address as E does not contain a token.
8401
        JR      Z,L1BF4         ; forward to STMT-NEXT if address found.
8402
 
8403
;; REPORT-N
8404
L1BEC:  RST     08H             ; ERROR-1
8405
        DEFB    $16             ; Error Report: Statement lost
8406
 
8407
; -----------------
8408
; End of statement?
8409
; -----------------
8410
; This combination of routines is called from 20 places when
8411
; the end of a statement should have been reached and all preceding
8412
; syntax is in order.
8413
 
8414
;; CHECK-END
8415
L1BEE:  CALL    L2530           ; routine SYNTAX-Z
8416
        RET     NZ              ; return immediately in runtime
8417
 
8418
        POP     BC              ; drop address of calling routine.
8419
        POP     BC              ; drop address STMT-RET.
8420
                                ; and continue to find next statement.
8421
 
8422
; --------------------
8423
; Go to next statement
8424
; --------------------
8425
; Acceptable characters at this point are carriage return and ':'.
8426
; If so go to next statement which in the first case will be on next line.
8427
 
8428
;; STMT-NEXT
8429
L1BF4:  RST     18H             ; GET-CHAR - ignoring white space etc.
8430
 
8431
        CP      $0D             ; is it carriage return ?
8432
        JR      Z,L1BB3         ; back to LINE-END if so.
8433
 
8434
        CP      $3A             ; is it ':' ?
8435
        JP      Z,L1B28         ; jump back to STMT-LOOP to consider
8436
                                ; further statements
8437
 
8438
        JP      L1C8A           ; jump to REPORT-C with any other character
8439
                                ; 'Nonsense in BASIC'.
8440
 
8441
; Note. the two-byte sequence 'rst 08; defb $0b' could replace the above jp.
8442
 
8443
; -------------------
8444
; Command class table
8445
; -------------------
8446
;
8447
 
8448
;; class-tbl
8449
L1C01:  DEFB    L1C10 - $       ; 0F offset to Address: CLASS-00
8450
        DEFB    L1C1F - $       ; 1D offset to Address: CLASS-01
8451
        DEFB    L1C4E - $       ; 4B offset to Address: CLASS-02
8452
        DEFB    L1C0D - $       ; 09 offset to Address: CLASS-03
8453
        DEFB    L1C6C - $       ; 67 offset to Address: CLASS-04
8454
        DEFB    L1C11 - $       ; 0B offset to Address: CLASS-05
8455
        DEFB    L1C82 - $       ; 7B offset to Address: CLASS-06
8456
        DEFB    L1C96 - $       ; 8E offset to Address: CLASS-07
8457
        DEFB    L1C7A - $       ; 71 offset to Address: CLASS-08
8458
        DEFB    L1CBE - $       ; B4 offset to Address: CLASS-09
8459
        DEFB    L1C8C - $       ; 81 offset to Address: CLASS-0A
8460
        DEFB    L1CDB - $       ; CF offset to Address: CLASS-0B
8461
 
8462
 
8463
; --------------------------------
8464
; Command classes---00, 03, and 05
8465
; --------------------------------
8466
; class-03 e.g. RUN or RUN 200   ;  optional operand
8467
; class-00 e.g. CONTINUE         ;  no operand
8468
; class-05 e.g. PRINT            ;  variable syntax checked by routine
8469
 
8470
;; CLASS-03
8471
L1C0D:  CALL    L1CDE           ; routine FETCH-NUM
8472
 
8473
;; CLASS-00
8474
 
8475
L1C10:  CP      A               ; reset zero flag.
8476
 
8477
; if entering here then all class routines are entered with zero reset.
8478
 
8479
;; CLASS-05
8480
L1C11:  POP     BC              ; drop address SCAN-LOOP.
8481
        CALL    Z,L1BEE         ; if zero set then call routine CHECK-END >>>
8482
                                ; as should be no further characters.
8483
 
8484
        EX      DE,HL           ; save HL to DE.
8485
        LD      HL,($5C74)      ; fetch T_ADDR
8486
        LD      C,(HL)          ; fetch low byte of routine
8487
        INC     HL              ; address next.
8488
        LD      B,(HL)          ; fetch high byte of routine.
8489
        EX      DE,HL           ; restore HL from DE
8490
        PUSH    BC              ; push the address
8491
        RET                     ; and make an indirect jump to the command.
8492
 
8493
; --------------------------------
8494
; Command classes---01, 02, and 04
8495
; --------------------------------
8496
; class-01  e.g. LET A = 2*3     ; a variable is reqd
8497
 
8498
; This class routine is also called from INPUT and READ to find the
8499
; destination variable for an assignment.
8500
 
8501
;; CLASS-01
8502
L1C1F:  CALL    L28B2           ; routine LOOK-VARS returns carry set if not
8503
                                ; found in runtime.
8504
 
8505
; ----------------------
8506
; Variable in assignment
8507
; ----------------------
8508
;
8509
;
8510
 
8511
;; VAR-A-1
8512
L1C22:  LD      (IY+$37),$00    ; set FLAGX to zero
8513
        JR      NC,L1C30        ; forward to VAR-A-2 if found or checking
8514
                                ; syntax.
8515
 
8516
        SET     1,(IY+$37)      ; FLAGX  - Signal a new variable
8517
        JR      NZ,L1C46        ; to VAR-A-3 if not assigning to an array
8518
                                ; e.g. LET a$(3,3) = "X"
8519
 
8520
;; REPORT-2
8521
L1C2E:  RST     08H             ; ERROR-1
8522
        DEFB    $01             ; Error Report: Variable not found
8523
 
8524
;; VAR-A-2
8525
L1C30:  CALL    Z,L2996         ; routine STK-VAR considers a subscript/slice
8526
        BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
8527
        JR      NZ,L1C46        ; to VAR-A-3 if numeric
8528
 
8529
        XOR     A               ; default to array/slice - to be retained.
8530
        CALL    L2530           ; routine SYNTAX-Z
8531
        CALL    NZ,L2BF1        ; routine STK-FETCH is called in runtime
8532
                                ; may overwrite A with 1.
8533
        LD      HL,$5C71        ; address system variable FLAGX
8534
        OR      (HL)            ; set bit 0 if simple variable to be reclaimed
8535
        LD      (HL),A          ; update FLAGX
8536
        EX      DE,HL           ; start of string/subscript to DE
8537
 
8538
;; VAR-A-3
8539
L1C46:  LD      ($5C72),BC      ; update STRLEN
8540
        LD      ($5C4D),HL      ; and DEST of assigned string.
8541
        RET                     ; return.
8542
 
8543
; -------------------------------------------------
8544
; class-02 e.g. LET a = 1 + 1   ; an expression must follow
8545
 
8546
;; CLASS-02
8547
L1C4E:  POP     BC              ; drop return address SCAN-LOOP
8548
        CALL    L1C56           ; routine VAL-FET-1 is called to check
8549
                                ; expression and assign result in runtime
8550
        CALL    L1BEE           ; routine CHECK-END checks nothing else
8551
                                ; is present in statement.
8552
        RET                     ; Return
8553
 
8554
; -------------
8555
; Fetch a value
8556
; -------------
8557
;
8558
;
8559
 
8560
;; VAL-FET-1
8561
L1C56:  LD      A,($5C3B)       ; initial FLAGS to A
8562
 
8563
;; VAL-FET-2
8564
L1C59:  PUSH    AF              ; save A briefly
8565
        CALL    L24FB           ; routine SCANNING evaluates expression.
8566
        POP     AF              ; restore A
8567
        LD      D,(IY+$01)      ; post-SCANNING FLAGS to D
8568
        XOR     D               ; xor the two sets of flags
8569
        AND     $40             ; pick up bit 6 of xored FLAGS should be zero
8570
        JR      NZ,L1C8A        ; forward to REPORT-C if not zero
8571
                                ; 'Nonsense in BASIC' - results don't agree.
8572
 
8573
        BIT     7,D             ; test FLAGS - is syntax being checked ?
8574
        JP      NZ,L2AFF        ; jump forward to LET to make the assignment
8575
                                ; in runtime.
8576
 
8577
        RET                     ; but return from here if checking syntax.
8578
 
8579
; ------------------
8580
; Command class---04
8581
; ------------------
8582
; class-04 e.g. FOR i            ; a single character variable must follow
8583
 
8584
;; CLASS-04
8585
L1C6C:  CALL    L28B2           ; routine LOOK-VARS
8586
        PUSH    AF              ; preserve flags.
8587
        LD      A,C             ; fetch type - should be 011xxxxx
8588
        OR      $9F             ; combine with 10011111.
8589
        INC     A               ; test if now $FF by incrementing.
8590
        JR      NZ,L1C8A        ; forward to REPORT-C if result not zero.
8591
 
8592
        POP     AF              ; else restore flags.
8593
        JR      L1C22           ; back to VAR-A-1
8594
 
8595
 
8596
; --------------------------------
8597
; Expect numeric/string expression
8598
; --------------------------------
8599
; This routine is used to get the two coordinates of STRING$, ATTR and POINT.
8600
; It is also called from PRINT-ITEM to get the two numeric expressions that
8601
; follow the AT ( in PRINT AT, INPUT AT).
8602
 
8603
;; NEXT-2NUM
8604
L1C79:  RST     20H             ; NEXT-CHAR advance past 'AT' or '('.
8605
 
8606
; --------
8607
; class-08 e.g. POKE 65535,2     ; two numeric expressions separated by comma
8608
;; CLASS-08
8609
;; EXPT-2NUM
8610
L1C7A:  CALL    L1C82           ; routine EXPT-1NUM is called for first
8611
                                ; numeric expression
8612
        CP      $2C             ; is character ',' ?
8613
        JR      NZ,L1C8A        ; to REPORT-C if not required separator.
8614
                                ; 'Nonsense in BASIC'.
8615
 
8616
        RST     20H             ; NEXT-CHAR
8617
 
8618
; ->
8619
;  class-06  e.g. GOTO a*1000   ; a numeric expression must follow
8620
;; CLASS-06
8621
;; EXPT-1NUM
8622
L1C82:  CALL    L24FB           ; routine SCANNING
8623
        BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
8624
        RET     NZ              ; return if result is numeric.
8625
 
8626
;; REPORT-C
8627
L1C8A:  RST     08H             ; ERROR-1
8628
        DEFB    $0B             ; Error Report: Nonsense in BASIC
8629
 
8630
; ---------------------------------------------------------------
8631
; class-0A e.g. ERASE "????"    ; a string expression must follow.
8632
;                               ; these only occur in unimplemented commands
8633
;                               ; although the routine expt-exp is called
8634
;                               ; from SAVE-ETC
8635
 
8636
;; CLASS-0A
8637
;; EXPT-EXP
8638
L1C8C:  CALL    L24FB           ; routine SCANNING
8639
        BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
8640
        RET     Z               ; return if string result.
8641
 
8642
        JR      L1C8A           ; back to REPORT-C if numeric.
8643
 
8644
; ---------------------
8645
; Set permanent colours
8646
; class 07
8647
; ---------------------
8648
; class-07 e.g. PAPER 6          ; a single class for a collection of
8649
;                               ; similar commands. Clever.
8650
;
8651
; Note. these commands should ensure that current channel is 'S'
8652
 
8653
;; CLASS-07
8654
L1C96:  BIT     7,(IY+$01)      ; test FLAGS - checking syntax only ?
8655
                                ; Note. there is a subroutine to do this.
8656
        RES     0,(IY+$02)      ; update TV_FLAG - signal main screen in use
8657
        CALL    NZ,L0D4D        ; routine TEMPS is called in runtime.
8658
        POP     AF              ; drop return address SCAN-LOOP
8659
        LD      A,($5C74)       ; T_ADDR_lo to accumulator.
8660
                                ; points to '$07' entry + 1
8661
                                ; e.g. for INK points to $EC now
8662
 
8663
; Note if you move alter the syntax table next line may have to be altered.
8664
 
8665
; Note. For ZASM assembler replace following expression with SUB $13.
8666
 
8667
L1CA5:  SUB     L1AEB-$D8 % 256 ; convert $EB to $D8 ('INK') etc.
8668
                                ; ( is SUB $13 in standard ROM )
8669
 
8670
        CALL    L21FC           ; routine CO-TEMP-4
8671
        CALL    L1BEE           ; routine CHECK-END check that nothing else
8672
                                ; in statement.
8673
 
8674
; return here in runtime.
8675
 
8676
        LD      HL,($5C8F)      ; pick up ATTR_T and MASK_T
8677
        LD      ($5C8D),HL      ; and store in ATTR_P and MASK_P
8678
        LD      HL,$5C91        ; point to P_FLAG.
8679
        LD      A,(HL)          ; pick up in A
8680
        RLCA                    ; rotate to left
8681
        XOR     (HL)            ; combine with HL
8682
        AND     $AA             ; 10101010
8683
        XOR     (HL)            ; only permanent bits affected
8684
        LD      (HL),A          ; reload into P_FLAG.
8685
        RET                     ; return.
8686
 
8687
; ------------------
8688
; Command class---09
8689
; ------------------
8690
; e.g. PLOT PAPER 0; 128,88     ; two coordinates preceded by optional
8691
;                               ; embedded colour items.
8692
;
8693
; Note. this command should ensure that current channel is actually 'S'.
8694
 
8695
;; CLASS-09
8696
L1CBE:  CALL    L2530           ; routine SYNTAX-Z
8697
        JR      Z,L1CD6         ; forward to CL-09-1 if checking syntax.
8698
 
8699
        RES     0,(IY+$02)      ; update TV_FLAG - signal main screen in use
8700
        CALL    L0D4D           ; routine TEMPS is called.
8701
        LD      HL,$5C90        ; point to MASK_T
8702
        LD      A,(HL)          ; fetch mask to accumulator.
8703
        OR      $F8             ; or with 11111000 paper/bright/flash 8
8704
        LD      (HL),A          ; mask back to MASK_T system variable.
8705
        RES     6,(IY+$57)      ; reset P_FLAG  - signal NOT PAPER 9 ?
8706
 
8707
        RST     18H             ; GET-CHAR
8708
 
8709
;; CL-09-1
8710
L1CD6:  CALL    L21E2           ; routine CO-TEMP-2 deals with any embedded
8711
                                ; colour items.
8712
        JR      L1C7A           ; exit via EXPT-2NUM to check for x,y.
8713
 
8714
; Note. if either of the numeric expressions contain STR$ then the flag setting
8715
; above will be undone when the channel flags are reset during STR$.
8716
; e.g.
8717
; 10 BORDER 3 : PLOT VAL STR$ 128, VAL STR$ 100
8718
; credit John Elliott.
8719
 
8720
; ------------------
8721
; Command class---0B
8722
; ------------------
8723
; Again a single class for four commands.
8724
; This command just jumps back to SAVE-ETC to handle the four tape commands.
8725
; The routine itself works out which command has called it by examining the
8726
; address in T_ADDR_lo. Note therefore that the syntax table has to be
8727
; located where these and other sequential command addresses are not split
8728
; over a page boundary.
8729
 
8730
;; CLASS-0B
8731
L1CDB:  JP      L0605           ; jump way back to SAVE-ETC
8732
 
8733
; --------------
8734
; Fetch a number
8735
; --------------
8736
; This routine is called from CLASS-03 when a command may be followed by
8737
; an optional numeric expression e.g. RUN. If the end of statement has
8738
; been reached then zero is used as the default.
8739
; Also called from LIST-4.
8740
 
8741
;; FETCH-NUM
8742
L1CDE:  CP      $0D             ; is character a carriage return ?
8743
        JR      Z,L1CE6         ; forward to USE-ZERO if so
8744
 
8745
        CP      $3A             ; is it ':' ?
8746
        JR      NZ,L1C82        ; forward to EXPT-1NUM if not.
8747
                                ; else continue and use zero.
8748
 
8749
; ----------------
8750
; Use zero routine
8751
; ----------------
8752
; This routine is called four times to place the value zero on the
8753
; calculator stack as a default value in runtime.
8754
 
8755
;; USE-ZERO
8756
L1CE6:  CALL    L2530           ; routine SYNTAX-Z  (UNSTACK-Z?)
8757
        RET     Z               ;
8758
 
8759
        RST     28H             ;; FP-CALC
8760
        DEFB    $A0             ;;stk-zero       ;0.
8761
        DEFB    $38             ;;end-calc
8762
 
8763
        RET                     ; return.
8764
 
8765
; -------------------
8766
; Handle STOP command
8767
; -------------------
8768
; Command Syntax: STOP
8769
; One of the shortest and least used commands. As with 'OK' not an error.
8770
 
8771
;; REPORT-9
8772
;; STOP
8773
L1CEE:  RST     08H             ; ERROR-1
8774
        DEFB    $08             ; Error Report: STOP statement
8775
 
8776
; -----------------
8777
; Handle IF command
8778
; -----------------
8779
; e.g. IF score>100 THEN PRINT "You Win"
8780
; The parser has already checked the expression the result of which is on
8781
; the calculator stack. The presence of the 'THEN' separator has also been
8782
; checked and CH-ADD points to the command after THEN.
8783
;
8784
 
8785
;; IF
8786
L1CF0:  POP     BC              ; drop return address - STMT-RET
8787
        CALL    L2530           ; routine SYNTAX-Z
8788
        JR      Z,L1D00         ; forward to IF-1 if checking syntax
8789
                                ; to check syntax of PRINT "You Win"
8790
 
8791
 
8792
        RST     28H             ;; FP-CALC    score>100 (1=TRUE 0=FALSE)
8793
        DEFB    $02             ;;delete      .
8794
        DEFB    $38             ;;end-calc
8795
 
8796
        EX      DE,HL           ; make HL point to deleted value
8797
        CALL    L34E9           ; routine TEST-ZERO
8798
        JP      C,L1BB3         ; jump to LINE-END if FALSE (0)
8799
 
8800
;; IF-1
8801
L1D00:  JP      L1B29           ; to STMT-L-1, if true (1) to execute command
8802
                                ; after 'THEN' token.
8803
 
8804
; ------------------
8805
; Handle FOR command
8806
; ------------------
8807
; e.g. FOR i = 0 TO 1 STEP 0.1
8808
; Using the syntax tables, the parser has already checked for a start and
8809
; limit value and also for the intervening separator.
8810
; the two values v,l are on the calculator stack.
8811
; CLASS-04 has also checked the variable and the name is in STRLEN_lo.
8812
; The routine begins by checking for an optional STEP.
8813
 
8814
;; FOR
8815
L1D03:  CP      $CD             ; is there a 'STEP' ?
8816
        JR      NZ,L1D10        ; to F-USE-1 if not to use 1 as default.
8817
 
8818
        RST     20H             ; NEXT-CHAR
8819
        CALL    L1C82           ; routine EXPT-1NUM
8820
        CALL    L1BEE           ; routine CHECK-END
8821
        JR      L1D16           ; to F-REORDER
8822
 
8823
; ---
8824
 
8825
;; F-USE-1
8826
L1D10:  CALL    L1BEE           ; routine CHECK-END
8827
 
8828
        RST     28H             ;; FP-CALC      v,l.
8829
        DEFB    $A1             ;;stk-one       v,l,1=s.
8830
        DEFB    $38             ;;end-calc
8831
 
8832
 
8833
;; F-REORDER
8834
L1D16:  RST     28H             ;; FP-CALC       v,l,s.
8835
        DEFB    $C0             ;;st-mem-0       v,l,s.
8836
        DEFB    $02             ;;delete         v,l.
8837
        DEFB    $01             ;;exchange       l,v.
8838
        DEFB    $E0             ;;get-mem-0      l,v,s.
8839
        DEFB    $01             ;;exchange       l,s,v.
8840
        DEFB    $38             ;;end-calc
8841
 
8842
        CALL    L2AFF           ; routine LET assigns the initial value v to
8843
                                ; the variable altering type if necessary.
8844
        LD      ($5C68),HL      ; The system variable MEM is made to point to
8845
                                ; the variable instead of its normal
8846
                                ; location MEMBOT
8847
        DEC     HL              ; point to single-character name
8848
        LD      A,(HL)          ; fetch name
8849
        SET     7,(HL)          ; set bit 7 at location
8850
        LD      BC,$0006        ; add six to HL
8851
        ADD     HL,BC           ; to address where limit should be.
8852
        RLCA                    ; test bit 7 of original name.
8853
        JR      C,L1D34         ; forward to F-L-S if already a FOR/NEXT
8854
                                ; variable
8855
 
8856
        LD      C,$0D           ; otherwise an additional 13 bytes are needed.
8857
                                ; 5 for each value, two for line number and
8858
                                ; 1 byte for looping statement.
8859
        CALL    L1655           ; routine MAKE-ROOM creates them.
8860
        INC     HL              ; make HL address limit.
8861
 
8862
;; F-L-S
8863
L1D34:  PUSH    HL              ; save position.
8864
 
8865
        RST     28H             ;; FP-CALC         l,s.
8866
        DEFB    $02             ;;delete           l.
8867
        DEFB    $02             ;;delete           .
8868
        DEFB    $38             ;;end-calc
8869
                                ; DE points to STKEND, l.
8870
 
8871
        POP     HL              ; restore variable position
8872
        EX      DE,HL           ; swap pointers
8873
        LD      C,$0A           ; ten bytes to move
8874
        LDIR                    ; Copy 'deleted' values to variable.
8875
        LD      HL,($5C45)      ; Load with current line number from PPC
8876
        EX      DE,HL           ; exchange pointers.
8877
        LD      (HL),E          ; save the looping line
8878
        INC     HL              ; in the next
8879
        LD      (HL),D          ; two locations.
8880
        LD      D,(IY+$0D)      ; fetch statement from SUBPPC system variable.
8881
        INC     D               ; increment statement.
8882
        INC     HL              ; and pointer
8883
        LD      (HL),D          ; and store the looping statement.
8884
                                ;
8885
        CALL    L1DDA           ; routine NEXT-LOOP considers an initial
8886
        RET     NC              ; iteration. Return to STMT-RET if a loop is
8887
                                ; possible to execute next statement.
8888
 
8889
; no loop is possible so execution continues after the matching 'NEXT'
8890
 
8891
        LD      B,(IY+$38)      ; get single-character name from STRLEN_lo
8892
        LD      HL,($5C45)      ; get the current line from PPC
8893
        LD      ($5C42),HL      ; and store it in NEWPPC
8894
        LD      A,($5C47)       ; fetch current statement from SUBPPC
8895
        NEG                     ; Negate as counter decrements from zero
8896
                                ; initially and we are in the middle of a
8897
                                ; line.
8898
        LD      D,A             ; Store result in D.
8899
        LD      HL,($5C5D)      ; get current address from CH_ADD
8900
        LD      E,$F3           ; search will be for token 'NEXT'
8901
 
8902
;; F-LOOP
8903
L1D64:  PUSH    BC              ; save variable name.
8904
        LD      BC,($5C55)      ; fetch NXTLIN
8905
        CALL    L1D86           ; routine LOOK-PROG searches for 'NEXT' token.
8906
        LD      ($5C55),BC      ; update NXTLIN
8907
        POP     BC              ; and fetch the letter
8908
        JR      C,L1D84         ; forward to REPORT-I if the end of program
8909
                                ; was reached by LOOK-PROG.
8910
                                ; 'FOR without NEXT'
8911
 
8912
        RST     20H             ; NEXT-CHAR fetches character after NEXT
8913
        OR      $20             ; ensure it is upper-case.
8914
        CP      B               ; compare with FOR variable name
8915
        JR      Z,L1D7C         ; forward to F-FOUND if it matches.
8916
 
8917
; but if no match i.e. nested FOR/NEXT loops then continue search.
8918
 
8919
        RST     20H             ; NEXT-CHAR
8920
        JR      L1D64           ; back to F-LOOP
8921
 
8922
; ---
8923
 
8924
 
8925
;; F-FOUND
8926
L1D7C:  RST     20H             ; NEXT-CHAR
8927
        LD      A,$01           ; subtract the negated counter from 1
8928
        SUB     D               ; to give the statement after the NEXT
8929
        LD      ($5C44),A       ; set system variable NSPPC
8930
        RET                     ; return to STMT-RET to branch to new
8931
                                ; line and statement. ->
8932
; ---
8933
 
8934
;; REPORT-I
8935
L1D84:  RST     08H             ; ERROR-1
8936
        DEFB    $11             ; Error Report: FOR without NEXT
8937
 
8938
; ---------
8939
; LOOK-PROG
8940
; ---------
8941
; Find DATA, DEF FN or NEXT.
8942
; This routine searches the program area for one of the above three keywords.
8943
; On entry, HL points to start of search area.
8944
; The token is in E, and D holds a statement count, decremented from zero.
8945
 
8946
;; LOOK-PROG
8947
L1D86:  LD      A,(HL)          ; fetch current character
8948
        CP      $3A             ; is it ':' a statement separator ?
8949
        JR      Z,L1DA3         ; forward to LOOK-P-2 if so.
8950
 
8951
; The starting point was PROG - 1 or the end of a line.
8952
 
8953
;; LOOK-P-1
8954
L1D8B:  INC     HL              ; increment pointer to address
8955
        LD      A,(HL)          ; the high byte of line number
8956
        AND     $C0             ; test for program end marker $80 or a
8957
                                ; variable
8958
        SCF                     ; Set Carry Flag
8959
        RET     NZ              ; return with carry set if at end
8960
                                ; of program.           ->
8961
 
8962
        LD      B,(HL)          ; high byte of line number to B
8963
        INC     HL              ;
8964
        LD      C,(HL)          ; low byte to C.
8965
        LD      ($5C42),BC      ; set system variable NEWPPC.
8966
        INC     HL              ;
8967
        LD      C,(HL)          ; low byte of line length to C.
8968
        INC     HL              ;
8969
        LD      B,(HL)          ; high byte to B.
8970
        PUSH    HL              ; save address
8971
        ADD     HL,BC           ; add length to position.
8972
        LD      B,H             ; and save result
8973
        LD      C,L             ; in BC.
8974
        POP     HL              ; restore address.
8975
        LD      D,$00           ; initialize statement counter to zero.
8976
 
8977
;; LOOK-P-2
8978
L1DA3:  PUSH    BC              ; save address of next line
8979
        CALL    L198B           ; routine EACH-STMT searches current line.
8980
        POP     BC              ; restore address.
8981
        RET     NC              ; return if match was found. ->
8982
 
8983
        JR      L1D8B           ; back to LOOK-P-1 for next line.
8984
 
8985
; -------------------
8986
; Handle NEXT command
8987
; -------------------
8988
; e.g. NEXT i
8989
; The parameter tables have already evaluated the presence of a variable
8990
 
8991
;; NEXT
8992
L1DAB:  BIT     1,(IY+$37)      ; test FLAGX - handling a new variable ?
8993
        JP      NZ,L1C2E        ; jump back to REPORT-2 if so
8994
                                ; 'Variable not found'
8995
 
8996
; now test if found variable is a simple variable uninitialized by a FOR.
8997
 
8998
        LD      HL,($5C4D)      ; load address of variable from DEST
8999
        BIT     7,(HL)          ; is it correct type ?
9000
        JR      Z,L1DD8         ; forward to REPORT-1 if not
9001
                                ; 'NEXT without FOR'
9002
 
9003
        INC     HL              ; step past variable name
9004
        LD      ($5C68),HL      ; and set MEM to point to three 5-byte values
9005
                                ; value, limit, step.
9006
 
9007
        RST     28H             ;; FP-CALC     add step and re-store
9008
        DEFB    $E0             ;;get-mem-0    v.
9009
        DEFB    $E2             ;;get-mem-2    v,s.
9010
        DEFB    $0F             ;;addition     v+s.
9011
        DEFB    $C0             ;;st-mem-0     v+s.
9012
        DEFB    $02             ;;delete       .
9013
        DEFB    $38             ;;end-calc
9014
 
9015
        CALL    L1DDA           ; routine NEXT-LOOP tests against limit.
9016
        RET     C               ; return if no more iterations possible.
9017
 
9018
        LD      HL,($5C68)      ; find start of variable contents from MEM.
9019
        LD      DE,$000F        ; add 3*5 to
9020
        ADD     HL,DE           ; address the looping line number
9021
        LD      E,(HL)          ; low byte to E
9022
        INC     HL              ;
9023
        LD      D,(HL)          ; high byte to D
9024
        INC     HL              ; address looping statement
9025
        LD      H,(HL)          ; and store in H
9026
        EX      DE,HL           ; swap registers
9027
        JP      L1E73           ; exit via GO-TO-2 to execute another loop.
9028
 
9029
; ---
9030
 
9031
;; REPORT-1
9032
L1DD8:  RST     08H             ; ERROR-1
9033
        DEFB    $00             ; Error Report: NEXT without FOR
9034
 
9035
 
9036
; -----------------
9037
; Perform NEXT loop
9038
; -----------------
9039
; This routine is called from the FOR command to test for an initial
9040
; iteration and from the NEXT command to test for all subsequent iterations.
9041
; the system variable MEM addresses the variable's contents which, in the
9042
; latter case, have had the step, possibly negative, added to the value.
9043
 
9044
;; NEXT-LOOP
9045
L1DDA:  RST     28H             ;; FP-CALC
9046
        DEFB    $E1             ;;get-mem-1        l.
9047
        DEFB    $E0             ;;get-mem-0        l,v.
9048
        DEFB    $E2             ;;get-mem-2        l,v,s.
9049
        DEFB    $36             ;;less-0           l,v,(1/0) negative step ?
9050
        DEFB    $00             ;;jump-true        l,v.(1/0)
9051
 
9052
        DEFB    $02             ;;to L1DE2, NEXT-1 if step negative
9053
 
9054
        DEFB    $01             ;;exchange         v,l.
9055
 
9056
;; NEXT-1
9057
L1DE2:  DEFB    $03             ;;subtract         l-v OR v-l.
9058
        DEFB    $37             ;;greater-0        (1/0)
9059
        DEFB    $00             ;;jump-true        .
9060
 
9061
        DEFB    $04             ;;to L1DE9, NEXT-2 if no more iterations.
9062
 
9063
        DEFB    $38             ;;end-calc         .
9064
 
9065
        AND     A               ; clear carry flag signalling another loop.
9066
        RET                     ; return
9067
 
9068
; ---
9069
 
9070
;; NEXT-2
9071
L1DE9:  DEFB    $38             ;;end-calc         .
9072
 
9073
        SCF                     ; set carry flag signalling looping exhausted.
9074
        RET                     ; return
9075
 
9076
 
9077
; -------------------
9078
; Handle READ command
9079
; -------------------
9080
; e.g. READ a, b$, c$(1000 TO 3000)
9081
; A list of comma-separated variables is assigned from a list of
9082
; comma-separated expressions.
9083
; As it moves along the first list, the character address CH_ADD is stored
9084
; in X_PTR while CH_ADD is used to read the second list.
9085
 
9086
;; READ-3
9087
L1DEC:  RST     20H             ; NEXT-CHAR
9088
 
9089
; -> Entry point.
9090
;; READ
9091
L1DED:  CALL    L1C1F           ; routine CLASS-01 checks variable.
9092
        CALL    L2530           ; routine SYNTAX-Z
9093
        JR      Z,L1E1E         ; forward to READ-2 if checking syntax
9094
 
9095
 
9096
        RST     18H             ; GET-CHAR
9097
        LD      ($5C5F),HL      ; save character position in X_PTR.
9098
        LD      HL,($5C57)      ; load HL with Data Address DATADD, which is
9099
                                ; the start of the program or the address
9100
                                ; after the last expression that was read or
9101
                                ; the address of the line number of the
9102
                                ; last RESTORE command.
9103
        LD      A,(HL)          ; fetch character
9104
        CP      $2C             ; is it a comma ?
9105
        JR      Z,L1E0A         ; forward to READ-1 if so.
9106
 
9107
; else all data in this statement has been read so look for next DATA token
9108
 
9109
        LD      E,$E4           ; token 'DATA'
9110
        CALL    L1D86           ; routine LOOK-PROG
9111
        JR      NC,L1E0A        ; forward to READ-1 if DATA found
9112
 
9113
; else report the error.
9114
 
9115
;; REPORT-E
9116
L1E08:  RST     08H             ; ERROR-1
9117
        DEFB    $0D             ; Error Report: Out of DATA
9118
 
9119
;; READ-1
9120
L1E0A:  CALL    L0077           ; routine TEMP-PTR1 advances updating CH_ADD
9121
                                ; with new DATADD position.
9122
        CALL    L1C56           ; routine VAL-FET-1 assigns value to variable
9123
                                ; checking type match and adjusting CH_ADD.
9124
 
9125
        RST     18H             ; GET-CHAR fetches adjusted character position
9126
        LD      ($5C57),HL      ; store back in DATADD
9127
        LD      HL,($5C5F)      ; fetch X_PTR  the original READ CH_ADD
9128
        LD      (IY+$26),$00    ; now nullify X_PTR_hi
9129
        CALL    L0078           ; routine TEMP-PTR2 restores READ CH_ADD
9130
 
9131
;; READ-2
9132
L1E1E:  RST     18H             ; GET-CHAR
9133
        CP      $2C             ; is it ',' indicating more variables to read ?
9134
        JR      Z,L1DEC         ; back to READ-3 if so
9135
 
9136
        CALL    L1BEE           ; routine CHECK-END
9137
        RET                     ; return from here in runtime to STMT-RET.
9138
 
9139
; -------------------
9140
; Handle DATA command
9141
; -------------------
9142
; In runtime this 'command' is passed by but the syntax is checked when such
9143
; a statement is found while parsing a line.
9144
; e.g. DATA 1, 2, "text", score-1, a$(location, room, object), FN r(49),
9145
;         wages - tax, TRUE, The meaning of life
9146
 
9147
;; DATA
9148
L1E27:  CALL    L2530           ; routine SYNTAX-Z to check status
9149
        JR      NZ,L1E37        ; forward to DATA-2 if in runtime
9150
 
9151
;; DATA-1
9152
L1E2C:  CALL    L24FB           ; routine SCANNING to check syntax of
9153
                                ; expression
9154
        CP      $2C             ; is it a comma ?
9155
        CALL    NZ,L1BEE        ; routine CHECK-END checks that statement
9156
                                ; is complete. Will make an early exit if
9157
                                ; so. >>>
9158
        RST     20H             ; NEXT-CHAR
9159
        JR      L1E2C           ; back to DATA-1
9160
 
9161
; ---
9162
 
9163
;; DATA-2
9164
L1E37:  LD      A,$E4           ; set token to 'DATA' and continue into
9165
                                ; the PASS-BY routine.
9166
 
9167
 
9168
; ----------------------------------
9169
; Check statement for DATA or DEF FN
9170
; ----------------------------------
9171
; This routine is used to backtrack to a command token and then
9172
; forward to the next statement in runtime.
9173
 
9174
;; PASS-BY
9175
L1E39:  LD      B,A             ; Give BC enough space to find token.
9176
        CPDR                    ; Compare decrement and repeat. (Only use).
9177
                                ; Work backwards till keyword is found which
9178
                                ; is start of statement before any quotes.
9179
                                ; HL points to location before keyword.
9180
        LD      DE,$0200        ; count 1+1 statements, dummy value in E to
9181
                                ; inhibit searching for a token.
9182
        JP      L198B           ; to EACH-STMT to find next statement
9183
 
9184
; -----------------------------------------------------------------------
9185
; A General Note on Invalid Line Numbers.
9186
; =======================================
9187
; One of the revolutionary concepts of Sinclair BASIC was that it supported
9188
; virtual line numbers. That is the destination of a GO TO, RESTORE etc. need
9189
; not exist. It could be a point before or after an actual line number.
9190
; Zero suffices for a before but the after should logically be infinity.
9191
; Since the maximum actual line limit is 9999 then the system limit, 16383
9192
; when variables kick in, would serve fine as a virtual end point.
9193
; However, ironically, only the LOAD command gets it right. It will not
9194
; autostart a program that has been saved with a line higher than 16383.
9195
; All the other commands deal with the limit unsatisfactorily.
9196
; LIST, RUN, GO TO, GO SUB and RESTORE have problems and the latter may
9197
; crash the machine when supplied with an inappropriate virtual line number.
9198
; This is puzzling as very careful consideration must have been given to
9199
; this point when the new variable types were allocated their masks and also
9200
; when the routine NEXT-ONE was successfully re-written to reflect this.
9201
; An enigma.
9202
; -------------------------------------------------------------------------
9203
 
9204
; ----------------------
9205
; Handle RESTORE command
9206
; ----------------------
9207
; The restore command sets the system variable for the data address to
9208
; point to the location before the supplied line number or first line
9209
; thereafter.
9210
; This alters the position where subsequent READ commands look for data.
9211
; Note. If supplied with inappropriate high numbers the system may crash
9212
; in the LINE-ADDR routine as it will pass the program/variables end-marker
9213
; and then lose control of what it is looking for - variable or line number.
9214
; - observation, Steven Vickers, 1984, Pitman.
9215
 
9216
;; RESTORE
9217
L1E42:  CALL    L1E99           ; routine FIND-INT2 puts integer in BC.
9218
                                ; Note. B should be checked against limit $3F
9219
                                ; and an error generated if higher.
9220
 
9221
; this entry point is used from RUN command with BC holding zero
9222
 
9223
;; REST-RUN
9224
L1E45:  LD      H,B             ; transfer the line
9225
        LD      L,C             ; number to the HL register.
9226
        CALL    L196E           ; routine LINE-ADDR to fetch the address.
9227
        DEC     HL              ; point to the location before the line.
9228
        LD      ($5C57),HL      ; update system variable DATADD.
9229
        RET                     ; return to STMT-RET (or RUN)
9230
 
9231
; ------------------------
9232
; Handle RANDOMIZE command
9233
; ------------------------
9234
; This command sets the SEED for the RND function to a fixed value.
9235
; With the parameter zero, a random start point is used depending on
9236
; how long the computer has been switched on.
9237
 
9238
;; RANDOMIZE
9239
L1E4F:  CALL    L1E99           ; routine FIND-INT2 puts parameter in BC.
9240
        LD      A,B             ; test this
9241
        OR      C               ; for zero.
9242
        JR      NZ,L1E5A        ; forward to RAND-1 if not zero.
9243
 
9244
        LD      BC,($5C78)      ; use the lower two bytes at FRAMES1.
9245
 
9246
;; RAND-1
9247
L1E5A:  LD      ($5C76),BC      ; place in SEED system variable.
9248
        RET                     ; return to STMT-RET
9249
 
9250
; -----------------------
9251
; Handle CONTINUE command
9252
; -----------------------
9253
; The CONTINUE command transfers the OLD (but incremented) values of
9254
; line number and statement to the equivalent "NEW VALUE" system variables
9255
; by using the last part of GO TO and exits indirectly to STMT-RET.
9256
 
9257
;; CONTINUE
9258
L1E5F:  LD      HL,($5C6E)      ; fetch OLDPPC line number.
9259
        LD      D,(IY+$36)      ; fetch OSPPC statement.
9260
        JR      L1E73           ; forward to GO-TO-2
9261
 
9262
; --------------------
9263
; Handle GO TO command
9264
; --------------------
9265
; The GO TO command routine is also called by GO SUB and RUN routines
9266
; to evaluate the parameters of both commands.
9267
; It updates the system variables used to fetch the next line/statement.
9268
; It is at STMT-RET that the actual change in control takes place.
9269
; Unlike some BASICs the line number need not exist.
9270
; Note. the high byte of the line number is incorrectly compared with $F0
9271
; instead of $3F. This leads to commands with operands greater than 32767
9272
; being considered as having been run from the editing area and the
9273
; error report 'Statement Lost' is given instead of 'OK'.
9274
; - Steven Vickers, 1984.
9275
 
9276
;; GO-TO
9277
L1E67:  CALL    L1E99           ; routine FIND-INT2 puts operand in BC
9278
        LD      H,B             ; transfer line
9279
        LD      L,C             ; number to HL.
9280
        LD      D,$00           ; set statement to 0 - first.
9281
        LD      A,H             ; compare high byte only
9282
        CP      $F0             ; to $F0 i.e. 61439 in full.
9283
        JR      NC,L1E9F        ; forward to REPORT-B if above.
9284
 
9285
; This call entry point is used to update the system variables e.g. by RETURN.
9286
 
9287
;; GO-TO-2
9288
L1E73:  LD      ($5C42),HL      ; save line number in NEWPPC
9289
        LD      (IY+$0A),D      ; and statement in NSPPC
9290
        RET                     ; to STMT-RET (or GO-SUB command)
9291
 
9292
; ------------------
9293
; Handle OUT command
9294
; ------------------
9295
; Syntax has been checked and the two comma-separated values are on the
9296
; calculator stack.
9297
 
9298
;; OUT
9299
L1E7A:  CALL    L1E85           ; routine TWO-PARAM fetches values
9300
                                ; to BC and A.
9301
        OUT     (C),A           ; perform the operation.
9302
        RET                     ; return to STMT-RET.
9303
 
9304
; -------------------
9305
; Handle POKE command
9306
; -------------------
9307
; This routine alters a single byte in the 64K address space.
9308
; Happily no check is made as to whether ROM or RAM is addressed.
9309
; Sinclair BASIC requires no poking of system variables.
9310
 
9311
;; POKE
9312
L1E80:  CALL    L1E85           ; routine TWO-PARAM fetches values
9313
                                ; to BC and A.
9314
        LD      (BC),A          ; load memory location with A.
9315
        RET                     ; return to STMT-RET.
9316
 
9317
; ------------------------------------
9318
; Fetch two  parameters from calculator stack
9319
; ------------------------------------
9320
; This routine fetches a byte and word from the calculator stack
9321
; producing an error if either is out of range.
9322
 
9323
;; TWO-PARAM
9324
L1E85:  CALL    L2DD5           ; routine FP-TO-A
9325
        JR      C,L1E9F         ; forward to REPORT-B if overflow occurred
9326
 
9327
        JR      Z,L1E8E         ; forward to TWO-P-1 if positive
9328
 
9329
        NEG                     ; negative numbers are made positive
9330
 
9331
;; TWO-P-1
9332
L1E8E:  PUSH    AF              ; save the value
9333
        CALL    L1E99           ; routine FIND-INT2 gets integer to BC
9334
        POP     AF              ; restore the value
9335
        RET                     ; return
9336
 
9337
; -------------
9338
; Find integers
9339
; -------------
9340
; The first of these routines fetches a 8-bit integer (range 0-255) from the
9341
; calculator stack to the accumulator and is used for colours, streams,
9342
; durations and coordinates.
9343
; The second routine fetches 16-bit integers to the BC register pair
9344
; and is used to fetch command and function arguments involving line numbers
9345
; or memory addresses and also array subscripts and tab arguments.
9346
; ->
9347
 
9348
;; FIND-INT1
9349
L1E94:  CALL    L2DD5           ; routine FP-TO-A
9350
        JR      L1E9C           ; forward to FIND-I-1 for common exit routine.
9351
 
9352
; ---
9353
 
9354
; ->
9355
 
9356
;; FIND-INT2
9357
L1E99:  CALL    L2DA2           ; routine FP-TO-BC
9358
 
9359
;; FIND-I-1
9360
L1E9C:  JR      C,L1E9F         ; to REPORT-Bb with overflow.
9361
 
9362
        RET     Z               ; return if positive.
9363
 
9364
 
9365
;; REPORT-Bb
9366
L1E9F:  RST     08H             ; ERROR-1
9367
        DEFB    $0A             ; Error Report: Integer out of range
9368
 
9369
; ------------------
9370
; Handle RUN command
9371
; ------------------
9372
; This command runs a program starting at an optional line.
9373
; It performs a 'RESTORE 0' then CLEAR
9374
 
9375
;; RUN
9376
L1EA1:  CALL    L1E67           ; routine GO-TO puts line number in
9377
                                ; system variables.
9378
        LD      BC,$0000        ; prepare to set DATADD to first line.
9379
        CALL    L1E45           ; routine REST-RUN does the 'restore'.
9380
                                ; Note BC still holds zero.
9381
        JR      L1EAF           ; forward to CLEAR-RUN to clear variables
9382
                                ; without disturbing RAMTOP and
9383
                                ; exit indirectly to STMT-RET
9384
 
9385
; --------------------
9386
; Handle CLEAR command
9387
; --------------------
9388
; This command reclaims the space used by the variables.
9389
; It also clears the screen and the GO SUB stack.
9390
; With an integer expression, it sets the uppermost memory
9391
; address within the BASIC system.
9392
; "Contrary to the manual, CLEAR doesn't execute a RESTORE" -
9393
; Steven Vickers, Pitman Pocket Guide to the Spectrum, 1984.
9394
 
9395
;; CLEAR
9396
L1EAC:  CALL    L1E99           ; routine FIND-INT2 fetches to BC.
9397
 
9398
;; CLEAR-RUN
9399
L1EAF:  LD      A,B             ; test for
9400
        OR      C               ; zero.
9401
        JR      NZ,L1EB7        ; skip to CLEAR-1 if not zero.
9402
 
9403
        LD      BC,($5CB2)      ; use the existing value of RAMTOP if zero.
9404
 
9405
;; CLEAR-1
9406
L1EB7:  PUSH    BC              ; save ramtop value.
9407
 
9408
        LD      DE,($5C4B)      ; fetch VARS
9409
        LD      HL,($5C59)      ; fetch E_LINE
9410
        DEC     HL              ; adjust to point at variables end-marker.
9411
        CALL    L19E5           ; routine RECLAIM-1 reclaims the space used by
9412
                                ; the variables.
9413
 
9414
        CALL    L0D6B           ; routine CLS to clear screen.
9415
 
9416
        LD      HL,($5C65)      ; fetch STKEND the start of free memory.
9417
        LD      DE,$0032        ; allow for another 50 bytes.
9418
        ADD     HL,DE           ; add the overhead to HL.
9419
 
9420
        POP     DE              ; restore the ramtop value.
9421
        SBC     HL,DE           ; if HL is greater than the value then jump
9422
        JR      NC,L1EDA        ; forward to REPORT-M
9423
                                ; 'RAMTOP no good'
9424
 
9425
        LD      HL,($5CB4)      ; now P-RAMT ($7FFF on 16K RAM machine)
9426
        AND     A               ; exact this time.
9427
        SBC     HL,DE           ; new ramtop must be lower or the same.
9428
        JR      NC,L1EDC        ; skip to CLEAR-2 if in actual RAM.
9429
 
9430
;; REPORT-M
9431
L1EDA:  RST     08H             ; ERROR-1
9432
        DEFB    $15             ; Error Report: RAMTOP no good
9433
 
9434
;; CLEAR-2
9435
L1EDC:  EX      DE,HL           ; transfer ramtop value to HL.
9436
        LD      ($5CB2),HL      ; update system variable RAMTOP.
9437
        POP     DE              ; pop the return address STMT-RET.
9438
        POP     BC              ; pop the Error Address.
9439
        LD      (HL),$3E        ; now put the GO SUB end-marker at RAMTOP.
9440
        DEC     HL              ; leave a location beneath it.
9441
        LD      SP,HL           ; initialize the machine stack pointer.
9442
        PUSH    BC              ; push the error address.
9443
        LD      ($5C3D),SP      ; make ERR_SP point to location.
9444
        EX      DE,HL           ; put STMT-RET in HL.
9445
        JP      (HL)            ; and go there directly.
9446
 
9447
; ---------------------
9448
; Handle GO SUB command
9449
; ---------------------
9450
; The GO SUB command diverts BASIC control to a new line number
9451
; in a very similar manner to GO TO but
9452
; the current line number and current statement + 1
9453
; are placed on the GO SUB stack as a RETURN point.
9454
 
9455
;; GO-SUB
9456
L1EED:  POP     DE              ; drop the address STMT-RET
9457
        LD      H,(IY+$0D)      ; fetch statement from SUBPPC and
9458
        INC     H               ; increment it
9459
        EX      (SP),HL         ; swap - error address to HL,
9460
                                ; H (statement) at top of stack,
9461
                                ; L (unimportant) beneath.
9462
        INC     SP              ; adjust to overwrite unimportant byte
9463
        LD      BC,($5C45)      ; fetch the current line number from PPC
9464
        PUSH    BC              ; and PUSH onto GO SUB stack.
9465
                                ; the empty machine-stack can be rebuilt
9466
        PUSH    HL              ; push the error address.
9467
        LD      ($5C3D),SP      ; make system variable ERR_SP point to it.
9468
        PUSH    DE              ; push the address STMT-RET.
9469
        CALL    L1E67           ; call routine GO-TO to update the system
9470
                                ; variables NEWPPC and NSPPC.
9471
                                ; then make an indirect exit to STMT-RET via
9472
        LD      BC,$0014        ; a 20-byte overhead memory check.
9473
 
9474
; ----------------------
9475
; Check available memory
9476
; ----------------------
9477
; This routine is used on many occasions when extending a dynamic area
9478
; upwards or the GO SUB stack downwards.
9479
 
9480
;; TEST-ROOM
9481
L1F05:  LD      HL,($5C65)      ; fetch STKEND
9482
        ADD     HL,BC           ; add the supplied test value
9483
        JR      C,L1F15         ; forward to REPORT-4 if over $FFFF
9484
 
9485
        EX      DE,HL           ; was less so transfer to DE
9486
        LD      HL,$0050        ; test against another 80 bytes
9487
        ADD     HL,DE           ; anyway
9488
        JR      C,L1F15         ; forward to REPORT-4 if this passes $FFFF
9489
 
9490
        SBC     HL,SP           ; if less than the machine stack pointer
9491
        RET     C               ; then return - OK.
9492
 
9493
;; REPORT-4
9494
L1F15:  LD      L,$03           ; prepare 'Out of Memory'
9495
        JP      L0055           ; jump back to ERROR-3 at $0055
9496
                                ; Note. this error can't be trapped at $0008
9497
 
9498
; ------------------------------
9499
; THE 'FREE MEMORY' USER ROUTINE
9500
; ------------------------------
9501
; This routine is not used by the ROM but allows users to evaluate
9502
; approximate free memory with PRINT 65536 - USR 7962.
9503
 
9504
;; free-mem
9505
L1F1A:  LD      BC,$0000        ; allow no overhead.
9506
 
9507
        CALL    L1F05           ; routine TEST-ROOM.
9508
 
9509
        LD      B,H             ; transfer the result
9510
        LD      C,L             ; to the BC register.
9511
        RET                     ; the USR function returns value of BC.
9512
 
9513
; --------------------
9514
; THE 'RETURN' COMMAND
9515
; --------------------
9516
; As with any command, there are two values on the machine stack at the time
9517
; it is invoked.  The machine stack is below the GOSUB stack.  Both grow
9518
; downwards, the machine stack by two bytes, the GOSUB stack by 3 bytes.
9519
; The highest location is a statement byte followed by a two-byte line number.
9520
 
9521
;; RETURN
9522
L1F23:  POP     BC              ; drop the address STMT-RET.
9523
        POP     HL              ; now the error address.
9524
        POP     DE              ; now a possible BASIC return line.
9525
        LD      A,D             ; the high byte $00 - $27 is
9526
        CP      $3E             ; compared with the traditional end-marker $3E.
9527
        JR      Z,L1F36         ; forward to REPORT-7 with a match.
9528
                                ; 'RETURN without GOSUB'
9529
 
9530
; It was not the end-marker so a single statement byte remains at the base of
9531
; the calculator stack. It can't be popped off.
9532
 
9533
        DEC     SP              ; adjust stack pointer to create room for two
9534
                                ; bytes.
9535
        EX      (SP),HL         ; statement to H, error address to base of
9536
                                ; new machine stack.
9537
        EX      DE,HL           ; statement to D,  BASIC line number to HL.
9538
        LD      ($5C3D),SP      ; adjust ERR_SP to point to new stack pointer
9539
        PUSH    BC              ; now re-stack the address STMT-RET
9540
        JP      L1E73           ; to GO-TO-2 to update statement and line
9541
                                ; system variables and exit indirectly to the
9542
                                ; address just pushed on stack.
9543
 
9544
; ---
9545
 
9546
;; REPORT-7
9547
L1F36:  PUSH    DE              ; replace the end-marker.
9548
        PUSH    HL              ; now restore the error address
9549
                                ; as will be required in a few clock cycles.
9550
 
9551
        RST     08H             ; ERROR-1
9552
        DEFB    $06             ; Error Report: RETURN without GOSUB
9553
 
9554
; --------------------
9555
; Handle PAUSE command
9556
; --------------------
9557
; The pause command takes as its parameter the number of interrupts
9558
; for which to wait. PAUSE 50 pauses for about a second.
9559
; PAUSE 0 pauses indefinitely.
9560
; Both forms can be finished by pressing a key.
9561
 
9562
;; PAUSE
9563
L1F3A:  CALL    L1E99           ; routine FIND-INT2 puts value in BC
9564
 
9565
;; PAUSE-1
9566
L1F3D:  HALT                    ; wait for interrupt.
9567
        DEC     BC              ; decrease counter.
9568
        LD      A,B             ; test if
9569
        OR      C               ; result is zero.
9570
        JR      Z,L1F4F         ; forward to PAUSE-END if so.
9571
 
9572
        LD      A,B             ; test if
9573
        AND     C               ; now $FFFF
9574
        INC     A               ; that is, initially zero.
9575
        JR      NZ,L1F49        ; skip forward to PAUSE-2 if not.
9576
 
9577
        INC     BC              ; restore counter to zero.
9578
 
9579
;; PAUSE-2
9580
L1F49:  BIT     5,(IY+$01)      ; test FLAGS - has a new key been pressed ?
9581
        JR      Z,L1F3D         ; back to PAUSE-1 if not.
9582
 
9583
;; PAUSE-END
9584
L1F4F:  RES     5,(IY+$01)      ; update FLAGS - signal no new key
9585
        RET                     ; and return.
9586
 
9587
; -------------------
9588
; Check for BREAK key
9589
; -------------------
9590
; This routine is called from COPY-LINE, when interrupts are disabled,
9591
; to test if BREAK (SHIFT - SPACE) is being pressed.
9592
; It is also called at STMT-RET after every statement.
9593
 
9594
;; BREAK-KEY
9595
L1F54:  LD      A,$7F           ; Input address: $7FFE
9596
        IN      A,($FE)         ; read lower right keys
9597
        RRA                     ; rotate bit 0 - SPACE
9598
        RET     C               ; return if not reset
9599
 
9600
        LD      A,$FE           ; Input address: $FEFE
9601
        IN      A,($FE)         ; read lower left keys
9602
        RRA                     ; rotate bit 0 - SHIFT
9603
        RET                     ; carry will be set if not pressed.
9604
                                ; return with no carry if both keys
9605
                                ; pressed.
9606
 
9607
; ---------------------
9608
; Handle DEF FN command
9609
; ---------------------
9610
; e.g. DEF FN r$(a$,a) = a$(a TO )
9611
; this 'command' is ignored in runtime but has its syntax checked
9612
; during line-entry.
9613
 
9614
;; DEF-FN
9615
L1F60:  CALL    L2530           ; routine SYNTAX-Z
9616
        JR      Z,L1F6A         ; forward to DEF-FN-1 if parsing
9617
 
9618
        LD      A,$CE           ; else load A with 'DEF FN' and
9619
        JP      L1E39           ; jump back to PASS-BY
9620
 
9621
; ---
9622
 
9623
; continue here if checking syntax.
9624
 
9625
;; DEF-FN-1
9626
L1F6A:  SET      6,(IY+$01)     ; set FLAGS  - Assume numeric result
9627
        CALL    L2C8D           ; call routine ALPHA
9628
        JR      NC,L1F89        ; if not then to DEF-FN-4 to jump to
9629
                                ; 'Nonsense in BASIC'
9630
 
9631
 
9632
        RST     20H             ; NEXT-CHAR
9633
        CP      $24             ; is it '$' ?
9634
        JR      NZ,L1F7D        ; to DEF-FN-2 if not as numeric.
9635
 
9636
        RES     6,(IY+$01)      ; set FLAGS  - Signal string result
9637
 
9638
        RST     20H             ; get NEXT-CHAR
9639
 
9640
;; DEF-FN-2
9641
L1F7D:  CP      $28             ; is it '(' ?
9642
        JR      NZ,L1FBD        ; to DEF-FN-7 'Nonsense in BASIC'
9643
 
9644
 
9645
        RST     20H             ; NEXT-CHAR
9646
        CP      $29             ; is it ')' ?
9647
        JR      Z,L1FA6         ; to DEF-FN-6 if null argument
9648
 
9649
;; DEF-FN-3
9650
L1F86:  CALL    L2C8D           ; routine ALPHA checks that it is the expected
9651
                                ; alphabetic character.
9652
 
9653
;; DEF-FN-4
9654
L1F89:  JP      NC,L1C8A        ; to REPORT-C  if not
9655
                                ; 'Nonsense in BASIC'.
9656
 
9657
        EX      DE,HL           ; save pointer in DE
9658
 
9659
        RST     20H             ; NEXT-CHAR re-initializes HL from CH_ADD
9660
                                ; and advances.
9661
        CP      $24             ; '$' ? is it a string argument.
9662
        JR      NZ,L1F94        ; forward to DEF-FN-5 if not.
9663
 
9664
        EX      DE,HL           ; save pointer to '$' in DE
9665
 
9666
        RST     20H             ; NEXT-CHAR re-initializes HL and advances
9667
 
9668
;; DEF-FN-5
9669
L1F94:  EX      DE,HL           ; bring back pointer.
9670
        LD      BC,$0006        ; the function requires six hidden bytes for
9671
                                ; each parameter passed.
9672
                                ; The first byte will be $0E
9673
                                ; then 5-byte numeric value
9674
                                ; or 5-byte string pointer.
9675
 
9676
        CALL    L1655           ; routine MAKE-ROOM creates space in program
9677
                                ; area.
9678
 
9679
        INC     HL              ; adjust HL (set by LDDR)
9680
        INC     HL              ; to point to first location.
9681
        LD      (HL),$0E        ; insert the 'hidden' marker.
9682
 
9683
; Note. these invisible storage locations hold nothing meaningful for the
9684
; moment. They will be used every time the corresponding function is
9685
; evaluated in runtime.
9686
; Now consider the following character fetched earlier.
9687
 
9688
        CP      $2C             ; is it ',' ? (more than one parameter)
9689
        JR      NZ,L1FA6        ; to DEF-FN-6 if not
9690
 
9691
 
9692
        RST     20H             ; else NEXT-CHAR
9693
        JR      L1F86           ; and back to DEF-FN-3
9694
 
9695
; ---
9696
 
9697
;; DEF-FN-6
9698
L1FA6:  CP      $29             ; should close with a ')'
9699
        JR      NZ,L1FBD        ; to DEF-FN-7 if not
9700
                                ; 'Nonsense in BASIC'
9701
 
9702
 
9703
        RST     20H             ; get NEXT-CHAR
9704
        CP      $3D             ; is it '=' ?
9705
        JR      NZ,L1FBD        ; to DEF-FN-7 if not 'Nonsense...'
9706
 
9707
 
9708
        RST     20H             ; address NEXT-CHAR
9709
        LD      A,($5C3B)       ; get FLAGS which has been set above
9710
        PUSH    AF              ; and preserve
9711
 
9712
        CALL    L24FB           ; routine SCANNING checks syntax of expression
9713
                                ; and also sets flags.
9714
 
9715
        POP     AF              ; restore previous flags
9716
        XOR     (IY+$01)        ; xor with FLAGS - bit 6 should be same
9717
                                ; therefore will be reset.
9718
        AND     $40             ; isolate bit 6.
9719
 
9720
;; DEF-FN-7
9721
L1FBD:  JP      NZ,L1C8A        ; jump back to REPORT-C if the expected result
9722
                                ; is not the same type.
9723
                                ; 'Nonsense in BASIC'
9724
 
9725
        CALL    L1BEE           ; routine CHECK-END will return early if
9726
                                ; at end of statement and move onto next
9727
                                ; else produce error report. >>>
9728
 
9729
                                ; There will be no return to here.
9730
 
9731
; -------------------------------
9732
; Returning early from subroutine
9733
; -------------------------------
9734
; All routines are capable of being run in two modes - syntax checking mode
9735
; and runtime mode.  This routine is called often to allow a routine to return
9736
; early if checking syntax.
9737
 
9738
;; UNSTACK-Z
9739
L1FC3:  CALL    L2530           ; routine SYNTAX-Z sets zero flag if syntax
9740
                                ; is being checked.
9741
 
9742
        POP     HL              ; drop the return address.
9743
        RET      Z              ; return to previous call in chain if checking
9744
                                ; syntax.
9745
 
9746
        JP      (HL)            ; jump to return address as BASIC program is
9747
                                ; actually running.
9748
 
9749
; ---------------------
9750
; Handle LPRINT command
9751
; ---------------------
9752
; A simple form of 'PRINT #3' although it can output to 16 streams.
9753
; Probably for compatibility with other BASICs particularly ZX81 BASIC.
9754
; An extra UDG might have been better.
9755
 
9756
;; LPRINT
9757
L1FC9:  LD      A,$03           ; the printer channel
9758
        JR      L1FCF           ; forward to PRINT-1
9759
 
9760
; ---------------------
9761
; Handle PRINT commands
9762
; ---------------------
9763
; The Spectrum's main stream output command.
9764
; The default stream is stream 2 which is normally the upper screen
9765
; of the computer. However the stream can be altered in range 0 - 15.
9766
 
9767
;; PRINT
9768
L1FCD:  LD      A,$02           ; the stream for the upper screen.
9769
 
9770
; The LPRINT command joins here.
9771
 
9772
;; PRINT-1
9773
L1FCF:  CALL    L2530           ; routine SYNTAX-Z checks if program running
9774
        CALL    NZ,L1601        ; routine CHAN-OPEN if so
9775
        CALL    L0D4D           ; routine TEMPS sets temporary colours.
9776
        CALL    L1FDF           ; routine PRINT-2 - the actual item
9777
        CALL    L1BEE           ; routine CHECK-END gives error if not at end
9778
                                ; of statement
9779
        RET                     ; and return >>>
9780
 
9781
; ------------------------------------
9782
; this subroutine is called from above
9783
; and also from INPUT.
9784
 
9785
;; PRINT-2
9786
L1FDF:  RST     18H             ; GET-CHAR gets printable character
9787
        CALL    L2045           ; routine PR-END-Z checks if more printing
9788
        JR      Z,L1FF2         ; to PRINT-4 if not     e.g. just 'PRINT :'
9789
 
9790
; This tight loop deals with combinations of positional controls and
9791
; print items. An early return can be made from within the loop
9792
; if the end of a print sequence is reached.
9793
 
9794
;; PRINT-3
9795
L1FE5:  CALL    L204E           ; routine PR-POSN-1 returns zero if more
9796
                                ; but returns early at this point if
9797
                                ; at end of statement!
9798
                                ;
9799
        JR      Z,L1FE5         ; to PRINT-3 if consecutive positioners
9800
 
9801
        CALL    L1FFC           ; routine PR-ITEM-1 deals with strings etc.
9802
        CALL    L204E           ; routine PR-POSN-1 for more position codes
9803
        JR      Z,L1FE5         ; loop back to PRINT-3 if so
9804
 
9805
;; PRINT-4
9806
L1FF2:  CP      $29             ; return now if this is ')' from input-item.
9807
                                ; (see INPUT.)
9808
        RET     Z               ; or continue and print carriage return in
9809
                                ; runtime
9810
 
9811
; ---------------------
9812
; Print carriage return
9813
; ---------------------
9814
; This routine which continues from above prints a carriage return
9815
; in run-time. It is also called once from PRINT-POSN.
9816
 
9817
;; PRINT-CR
9818
L1FF5:  CALL    L1FC3           ; routine UNSTACK-Z
9819
 
9820
        LD      A,$0D           ; prepare a carriage return
9821
 
9822
        RST     10H             ; PRINT-A
9823
        RET                     ; return
9824
 
9825
 
9826
; -----------
9827
; Print items
9828
; -----------
9829
; This routine deals with print items as in
9830
; PRINT AT 10,0;"The value of A is ";a
9831
; It returns once a single item has been dealt with as it is part
9832
; of a tight loop that considers sequences of positional and print items
9833
 
9834
;; PR-ITEM-1
9835
L1FFC:  RST     18H             ; GET-CHAR
9836
        CP      $AC             ; is character 'AT' ?
9837
        JR      NZ,L200E        ; forward to PR-ITEM-2 if not.
9838
 
9839
        CALL    L1C79           ; routine NEXT-2NUM  check for two comma
9840
                                ; separated numbers placing them on the
9841
                                ; calculator stack in runtime.
9842
        CALL    L1FC3           ; routine UNSTACK-Z quits if checking syntax.
9843
 
9844
        CALL    L2307           ; routine STK-TO-BC get the numbers in B and C.
9845
        LD      A,$16           ; prepare the 'at' control.
9846
        JR      L201E           ; forward to PR-AT-TAB to print the sequence.
9847
 
9848
; ---
9849
 
9850
;; PR-ITEM-2
9851
L200E:  CP      $AD             ; is character 'TAB' ?
9852
        JR      NZ,L2024        ; to PR-ITEM-3 if not
9853
 
9854
 
9855
        RST     20H             ; NEXT-CHAR to address next character
9856
        CALL    L1C82           ; routine EXPT-1NUM
9857
        CALL    L1FC3           ; routine UNSTACK-Z quits if checking syntax.
9858
 
9859
        CALL    L1E99           ; routine FIND-INT2 puts integer in BC.
9860
        LD      A,$17           ; prepare the 'tab' control.
9861
 
9862
;; PR-AT-TAB
9863
L201E:  RST     10H             ; PRINT-A outputs the control
9864
 
9865
        LD      A,C             ; first value to A
9866
        RST     10H             ; PRINT-A outputs it.
9867
 
9868
        LD      A,B             ; second value
9869
        RST     10H             ; PRINT-A
9870
 
9871
        RET                     ; return - item finished >>>
9872
 
9873
; ---
9874
 
9875
; Now consider paper 2; #2; a$
9876
 
9877
;; PR-ITEM-3
9878
L2024:  CALL    L21F2           ; routine CO-TEMP-3 will print any colour
9879
        RET     NC              ; items - return if success.
9880
 
9881
        CALL    L2070           ; routine STR-ALTER considers new stream
9882
        RET     NC              ; return if altered.
9883
 
9884
        CALL    L24FB           ; routine SCANNING now to evaluate expression
9885
        CALL    L1FC3           ; routine UNSTACK-Z if not runtime.
9886
 
9887
        BIT     6,(IY+$01)      ; test FLAGS  - Numeric or string result ?
9888
        CALL    Z,L2BF1         ; routine STK-FETCH if string.
9889
                                ; note no flags affected.
9890
        JP      NZ,L2DE3        ; to PRINT-FP to print if numeric >>>
9891
 
9892
; It was a string expression - start in DE, length in BC
9893
; Now enter a loop to print it
9894
 
9895
;; PR-STRING
9896
L203C:  LD      A,B             ; this tests if the
9897
        OR      C               ; length is zero and sets flag accordingly.
9898
        DEC     BC              ; this doesn't but decrements counter.
9899
        RET     Z               ; return if zero.
9900
 
9901
        LD      A,(DE)          ; fetch character.
9902
        INC     DE              ; address next location.
9903
 
9904
        RST     10H             ; PRINT-A.
9905
 
9906
        JR      L203C           ; loop back to PR-STRING.
9907
 
9908
; ---------------
9909
; End of printing
9910
; ---------------
9911
; This subroutine returns zero if no further printing is required
9912
; in the current statement.
9913
; The first terminator is found in  escaped input items only,
9914
; the others in print_items.
9915
 
9916
;; PR-END-Z
9917
L2045:  CP      $29             ; is character a ')' ?
9918
        RET     Z               ; return if so -        e.g. INPUT (p$); a$
9919
 
9920
;; PR-ST-END
9921
L2048:  CP      $0D             ; is it a carriage return ?
9922
        RET     Z               ; return also -         e.g. PRINT a
9923
 
9924
        CP      $3A             ; is character a ':' ?
9925
        RET                     ; return - zero flag will be set if so.
9926
                                ;                       e.g. PRINT a :
9927
 
9928
; --------------
9929
; Print position
9930
; --------------
9931
; This routine considers a single positional character ';', ',', '''
9932
 
9933
;; PR-POSN-1
9934
L204E:  RST     18H             ; GET-CHAR
9935
        CP      $3B             ; is it ';' ?
9936
                                ; i.e. print from last position.
9937
        JR      Z,L2067         ; forward to PR-POSN-3 if so.
9938
                                ; i.e. do nothing.
9939
 
9940
        CP      $2C             ; is it ',' ?
9941
                                ; i.e. print at next tabstop.
9942
        JR      NZ,L2061        ; forward to PR-POSN-2 if anything else.
9943
 
9944
        CALL    L2530           ; routine SYNTAX-Z
9945
        JR      Z,L2067         ; forward to PR-POSN-3 if checking syntax.
9946
 
9947
        LD      A,$06           ; prepare the 'comma' control character.
9948
 
9949
        RST     10H             ; PRINT-A  outputs to current channel in
9950
                                ; run-time.
9951
 
9952
        JR      L2067           ; skip to PR-POSN-3.
9953
 
9954
; ---
9955
 
9956
; check for newline.
9957
 
9958
;; PR-POSN-2
9959
L2061:  CP      $27             ; is character a "'" ? (newline)
9960
        RET     NZ              ; return if no match              >>>
9961
 
9962
        CALL    L1FF5           ; routine PRINT-CR outputs a carriage return
9963
                                ; in runtime only.
9964
 
9965
;; PR-POSN-3
9966
L2067:  RST     20H             ; NEXT-CHAR to A.
9967
        CALL    L2045           ; routine PR-END-Z checks if at end.
9968
        JR      NZ,L206E        ; to PR-POSN-4 if not.
9969
 
9970
        POP     BC              ; drop return address if at end.
9971
 
9972
;; PR-POSN-4
9973
L206E:  CP      A               ; reset the zero flag.
9974
        RET                     ; and return to loop or quit.
9975
 
9976
; ------------
9977
; Alter stream
9978
; ------------
9979
; This routine is called from PRINT ITEMS above, and also LIST as in
9980
; LIST #15
9981
 
9982
;; STR-ALTER
9983
L2070:  CP      $23             ; is character '#' ?
9984
        SCF                     ; set carry flag.
9985
        RET     NZ              ; return if no match.
9986
 
9987
 
9988
        RST      20H            ; NEXT-CHAR
9989
        CALL    L1C82           ; routine EXPT-1NUM gets stream number
9990
        AND     A               ; prepare to exit early with carry reset
9991
        CALL    L1FC3           ; routine UNSTACK-Z exits early if parsing
9992
        CALL    L1E94           ; routine FIND-INT1 gets number off stack
9993
        CP      $10             ; must be range 0 - 15 decimal.
9994
        JP      NC,L160E        ; jump back to REPORT-Oa if not
9995
                                ; 'Invalid stream'.
9996
 
9997
        CALL    L1601           ; routine CHAN-OPEN
9998
        AND     A               ; clear carry - signal item dealt with.
9999
        RET                     ; return
10000
 
10001
; -------------------
10002
; THE 'INPUT' COMMAND
10003
; -------------------
10004
; This command is mysterious.
10005
;
10006
 
10007
;; INPUT
10008
L2089:  CALL    L2530           ; routine SYNTAX-Z to check if in runtime.
10009
 
10010
        JR      Z,L2096         ; forward to INPUT-1 if checking syntax.
10011
 
10012
        LD      A,$01           ; select channel 'K' the keyboard for input.
10013
        CALL    L1601           ; routine CHAN-OPEN opens the channel and sets
10014
                                ; bit 0 of TV_FLAG.
10015
 
10016
;   Note. As a consequence of clearing the lower screen channel 0 is made
10017
;   the current channel so the above two instructions are superfluous.
10018
 
10019
        CALL    L0D6E           ; routine CLS-LOWER clears the lower screen
10020
                                ; and sets DF_SZ to two and TV_FLAG to $01.
10021
 
10022
;; INPUT-1
10023
L2096:  LD      (IY+$02),$01    ; update TV_FLAG - signal lower screen in use
10024
                                ; ensuring that the correct set of system
10025
                                ; variables are updated and that the border
10026
                                ; colour is used.
10027
 
10028
;   Note. The Complete Spectrum ROM Disassembly incorrectly names DF-SZ as the
10029
;   system variable that is updated above and if, as some have done, you make
10030
;   this unnecessary alteration then there will be two blank lines between the
10031
;   lower screen and the upper screen areas which will also scroll wrongly.
10032
 
10033
        CALL    L20C1           ; routine IN-ITEM-1 to handle the input.
10034
 
10035
        CALL    L1BEE           ; routine CHECK-END will make an early exit
10036
                                ; if checking syntax. >>>
10037
 
10038
;   Keyboard input has been made and it remains to adjust the upper
10039
;   screen in case the lower two lines have been extended upwards.
10040
 
10041
        LD      BC,($5C88)      ; fetch S_POSN current line/column of
10042
                                ; the upper screen.
10043
        LD      A,($5C6B)       ; fetch DF_SZ the display file size of
10044
                                ; the lower screen.
10045
        CP      B               ; test that lower screen does not overlap
10046
        JR      C,L20AD         ; forward to INPUT-2 if not.
10047
 
10048
; the two screens overlap so adjust upper screen.
10049
 
10050
        LD      C,$21           ; set column of upper screen to leftmost.
10051
        LD      B,A             ; and line to one above lower screen.
10052
                                ; continue forward to update upper screen
10053
                                ; print position.
10054
 
10055
;; INPUT-2
10056
L20AD:  LD      ($5C88),BC      ; set S_POSN update upper screen line/column.
10057
        LD      A,$19           ; subtract from twenty five
10058
        SUB     B               ; the new line number.
10059
        LD      ($5C8C),A       ; and place result in SCR_CT - scroll count.
10060
        RES     0,(IY+$02)      ; update TV_FLAG - signal main screen in use.
10061
 
10062
        CALL    L0DD9           ; routine CL-SET sets the print position
10063
                                ; system variables for the upper screen.
10064
 
10065
        JP      L0D6E           ; jump back to CLS-LOWER and make
10066
                                ; an indirect exit >>.
10067
 
10068
; ---------------------
10069
; INPUT ITEM subroutine
10070
; ---------------------
10071
;   This subroutine deals with the input items and print items.
10072
;   from  the current input channel.
10073
;   It is only called from the above INPUT routine but was obviously
10074
;   once called from somewhere else in another context.
10075
 
10076
;; IN-ITEM-1
10077
L20C1:  CALL    L204E           ; routine PR-POSN-1 deals with a single
10078
                                ; position item at each call.
10079
        JR      Z,L20C1         ; back to IN-ITEM-1 until no more in a
10080
                                ; sequence.
10081
 
10082
        CP      $28             ; is character '(' ?
10083
        JR      NZ,L20D8        ; forward to IN-ITEM-2 if not.
10084
 
10085
;   any variables within braces will be treated as part, or all, of the prompt
10086
;   instead of being used as destination variables.
10087
 
10088
        RST     20H             ; NEXT-CHAR
10089
        CALL    L1FDF           ; routine PRINT-2 to output the dynamic
10090
                                ; prompt.
10091
 
10092
        RST     18H             ; GET-CHAR
10093
        CP      $29             ; is character a matching ')' ?
10094
        JP      NZ,L1C8A        ; jump back to REPORT-C if not.
10095
                                ; 'Nonsense in BASIC'.
10096
 
10097
        RST     20H             ; NEXT-CHAR
10098
        JP      L21B2           ; forward to IN-NEXT-2
10099
 
10100
; ---
10101
 
10102
;; IN-ITEM-2
10103
L20D8:  CP      $CA             ; is the character the token 'LINE' ?
10104
        JR      NZ,L20ED        ; forward to IN-ITEM-3 if not.
10105
 
10106
        RST     20H             ; NEXT-CHAR - variable must come next.
10107
        CALL    L1C1F           ; routine CLASS-01 returns destination
10108
                                ; address of variable to be assigned.
10109
                                ; or generates an error if no variable
10110
                                ; at this position.
10111
 
10112
        SET     7,(IY+$37)      ; update FLAGX  - signal handling INPUT LINE
10113
        BIT     6,(IY+$01)      ; test FLAGS  - numeric or string result ?
10114
        JP      NZ,L1C8A        ; jump back to REPORT-C if not string
10115
                                ; 'Nonsense in BASIC'.
10116
 
10117
        JR      L20FA           ; forward to IN-PROMPT to set up workspace.
10118
 
10119
; ---
10120
 
10121
;   the jump was here for other variables.
10122
 
10123
;; IN-ITEM-3
10124
L20ED:  CALL     L2C8D          ; routine ALPHA checks if character is
10125
                                ; a suitable variable name.
10126
        JP      NC,L21AF        ; forward to IN-NEXT-1 if not
10127
 
10128
        CALL    L1C1F           ; routine CLASS-01 returns destination
10129
                                ; address of variable to be assigned.
10130
        RES     7,(IY+$37)      ; update FLAGX  - signal not INPUT LINE.
10131
 
10132
;; IN-PROMPT
10133
L20FA:  CALL    L2530           ; routine SYNTAX-Z
10134
        JP      Z,L21B2         ; forward to IN-NEXT-2 if checking syntax.
10135
 
10136
        CALL    L16BF           ; routine SET-WORK clears workspace.
10137
        LD      HL,$5C71        ; point to system variable FLAGX
10138
        RES     6,(HL)          ; signal string result.
10139
        SET     5,(HL)          ; signal in Input Mode for editor.
10140
        LD      BC,$0001        ; initialize space required to one for
10141
                                ; the carriage return.
10142
        BIT     7,(HL)          ; test FLAGX - INPUT LINE in use ?
10143
        JR      NZ,L211C        ; forward to IN-PR-2 if so as that is
10144
                                ; all the space that is required.
10145
 
10146
        LD      A,($5C3B)       ; load accumulator from FLAGS
10147
        AND     $40             ; mask to test BIT 6 of FLAGS and clear
10148
                                ; the other bits in A.
10149
                                ; numeric result expected ?
10150
        JR      NZ,L211A        ; forward to IN-PR-1 if so
10151
 
10152
        LD      C,$03           ; increase space to three bytes for the
10153
                                ; pair of surrounding quotes.
10154
 
10155
;; IN-PR-1
10156
L211A:  OR      (HL)            ; if numeric result, set bit 6 of FLAGX.
10157
        LD      (HL),A          ; and update system variable
10158
 
10159
;; IN-PR-2
10160
L211C:  RST     30H             ; BC-SPACES opens 1 or 3 bytes in workspace
10161
        LD      (HL),$0D        ; insert carriage return at last new location.
10162
        LD      A,C             ; fetch the length, one or three.
10163
        RRCA                    ; lose bit 0.
10164
        RRCA                    ; test if quotes required.
10165
        JR      NC,L2129        ; forward to IN-PR-3 if not.
10166
 
10167
        LD      A,$22           ; load the '"' character
10168
        LD      (DE),A          ; place quote in first new location at DE.
10169
        DEC     HL              ; decrease HL - from carriage return.
10170
        LD      (HL),A          ; and place a quote in second location.
10171
 
10172
;; IN-PR-3
10173
L2129:  LD      ($5C5B),HL      ; set keyboard cursor K_CUR to HL
10174
        BIT     7,(IY+$37)      ; test FLAGX  - is this INPUT LINE ??
10175
        JR      NZ,L215E        ; forward to IN-VAR-3 if so as input will
10176
                                ; be accepted without checking its syntax.
10177
 
10178
        LD      HL,($5C5D)      ; fetch CH_ADD
10179
        PUSH    HL              ; and save on stack.
10180
        LD      HL,($5C3D)      ; fetch ERR_SP
10181
        PUSH    HL              ; and save on stack
10182
 
10183
;; IN-VAR-1
10184
L213A:  LD      HL,L213A        ; address: IN-VAR-1 - this address
10185
        PUSH    HL              ; is saved on stack to handle errors.
10186
        BIT     4,(IY+$30)      ; test FLAGS2  - is K channel in use ?
10187
        JR      Z,L2148         ; forward to IN-VAR-2 if not using the
10188
                                ; keyboard for input. (??)
10189
 
10190
        LD      ($5C3D),SP      ; set ERR_SP to point to IN-VAR-1 on stack.
10191
 
10192
;; IN-VAR-2
10193
L2148:  LD      HL,($5C61)      ; set HL to WORKSP - start of workspace.
10194
        CALL    L11A7           ; routine REMOVE-FP removes floating point
10195
                                ; forms when looping in error condition.
10196
        LD      (IY+$00),$FF    ; set ERR_NR to 'OK' cancelling the error.
10197
                                ; but X_PTR causes flashing error marker
10198
                                ; to be displayed at each call to the editor.
10199
        CALL    L0F2C           ; routine EDITOR allows input to be entered
10200
                                ; or corrected if this is second time around.
10201
 
10202
; if we pass to next then there are no system errors
10203
 
10204
        RES     7,(IY+$01)      ; update FLAGS  - signal checking syntax
10205
        CALL    L21B9           ; routine IN-ASSIGN checks syntax using
10206
                                ; the VAL-FET-2 and powerful SCANNING routines.
10207
                                ; any syntax error and its back to IN-VAR-1.
10208
                                ; but with the flashing error marker showing
10209
                                ; where the error is.
10210
                                ; Note. the syntax of string input has to be
10211
                                ; checked as the user may have removed the
10212
                                ; bounding quotes or escaped them as with
10213
                                ; "hat" + "stand" for example.
10214
; proceed if syntax passed.
10215
 
10216
        JR      L2161           ; jump forward to IN-VAR-4
10217
 
10218
; ---
10219
 
10220
; the jump was to here when using INPUT LINE.
10221
 
10222
;; IN-VAR-3
10223
L215E:  CALL    L0F2C           ; routine EDITOR is called for input
10224
 
10225
; when ENTER received rejoin other route but with no syntax check.
10226
 
10227
; INPUT and INPUT LINE converge here.
10228
 
10229
;; IN-VAR-4
10230
L2161:  LD      (IY+$22),$00    ; set K_CUR_hi to a low value so that the cursor
10231
                                ; no longer appears in the input line.
10232
 
10233
        CALL    L21D6           ; routine IN-CHAN-K tests if the keyboard
10234
                                ; is being used for input.
10235
        JR      NZ,L2174        ; forward to IN-VAR-5 if using another input
10236
                                ; channel.
10237
 
10238
; continue here if using the keyboard.
10239
 
10240
        CALL    L111D           ; routine ED-COPY overprints the edit line
10241
                                ; to the lower screen. The only visible
10242
                                ; affect is that the cursor disappears.
10243
                                ; if you're inputting more than one item in
10244
                                ; a statement then that becomes apparent.
10245
 
10246
        LD      BC,($5C82)      ; fetch line and column from ECHO_E
10247
        CALL    L0DD9           ; routine CL-SET sets S-POSNL to those
10248
                                ; values.
10249
 
10250
; if using another input channel rejoin here.
10251
 
10252
;; IN-VAR-5
10253
L2174:  LD      HL,$5C71        ; point HL to FLAGX
10254
        RES     5,(HL)          ; signal not in input mode
10255
        BIT     7,(HL)          ; is this INPUT LINE ?
10256
        RES     7,(HL)          ; cancel the bit anyway.
10257
        JR      NZ,L219B        ; forward to IN-VAR-6 if INPUT LINE.
10258
 
10259
        POP     HL              ; drop the looping address
10260
        POP     HL              ; drop the address of previous
10261
                                ; error handler.
10262
        LD      ($5C3D),HL      ; set ERR_SP to point to it.
10263
        POP     HL              ; drop original CH_ADD which points to
10264
                                ; INPUT command in BASIC line.
10265
        LD      ($5C5F),HL      ; save in X_PTR while input is assigned.
10266
        SET     7,(IY+$01)      ; update FLAGS - Signal running program
10267
        CALL    L21B9           ; routine IN-ASSIGN is called again
10268
                                ; this time the variable will be assigned
10269
                                ; the input value without error.
10270
                                ; Note. the previous example now
10271
                                ; becomes "hatstand"
10272
 
10273
        LD      HL,($5C5F)      ; fetch stored CH_ADD value from X_PTR.
10274
        LD      (IY+$26),$00    ; set X_PTR_hi so that iy is no longer relevant.
10275
        LD      ($5C5D),HL      ; put restored value back in CH_ADD
10276
        JR      L21B2           ; forward to IN-NEXT-2 to see if anything
10277
                                ; more in the INPUT list.
10278
 
10279
; ---
10280
 
10281
; the jump was to here with INPUT LINE only
10282
 
10283
;; IN-VAR-6
10284
L219B:  LD      HL,($5C63)      ; STKBOT points to the end of the input.
10285
        LD      DE,($5C61)      ; WORKSP points to the beginning.
10286
        SCF                     ; prepare for true subtraction.
10287
        SBC     HL,DE           ; subtract to get length
10288
        LD      B,H             ; transfer it to
10289
        LD      C,L             ; the BC register pair.
10290
        CALL    L2AB2           ; routine STK-STO-$ stores parameters on
10291
                                ; the calculator stack.
10292
        CALL    L2AFF           ; routine LET assigns it to destination.
10293
        JR      L21B2           ; forward to IN-NEXT-2 as print items
10294
                                ; not allowed with INPUT LINE.
10295
                                ; Note. that "hat" + "stand" will, for
10296
                                ; example, be unchanged as also would
10297
                                ; 'PRINT "Iris was here"'.
10298
 
10299
; ---
10300
 
10301
; the jump was to here when ALPHA found more items while looking for
10302
; a variable name.
10303
 
10304
;; IN-NEXT-1
10305
L21AF:  CALL    L1FFC           ; routine PR-ITEM-1 considers further items.
10306
 
10307
;; IN-NEXT-2
10308
L21B2:  CALL    L204E           ; routine PR-POSN-1 handles a position item.
10309
        JP      Z,L20C1         ; jump back to IN-ITEM-1 if the zero flag
10310
                                ; indicates more items are present.
10311
 
10312
        RET                     ; return.
10313
 
10314
; ---------------------------
10315
; INPUT ASSIGNMENT Subroutine
10316
; ---------------------------
10317
; This subroutine is called twice from the INPUT command when normal
10318
; keyboard input is assigned. On the first occasion syntax is checked
10319
; using SCANNING. The final call with the syntax flag reset is to make
10320
; the assignment.
10321
 
10322
;; IN-ASSIGN
10323
L21B9:  LD      HL,($5C61)      ; fetch WORKSP start of input
10324
        LD      ($5C5D),HL      ; set CH_ADD to first character
10325
 
10326
        RST     18H             ; GET-CHAR ignoring leading white-space.
10327
        CP      $E2             ; is it 'STOP'
10328
        JR      Z,L21D0         ; forward to IN-STOP if so.
10329
 
10330
        LD      A,($5C71)       ; load accumulator from FLAGX
10331
        CALL    L1C59           ; routine VAL-FET-2 makes assignment
10332
                                ; or goes through the motions if checking
10333
                                ; syntax. SCANNING is used.
10334
 
10335
        RST     18H             ; GET-CHAR
10336
        CP      $0D             ; is it carriage return ?
10337
        RET     Z               ; return if so
10338
                                ; either syntax is OK
10339
                                ; or assignment has been made.
10340
 
10341
; if another character was found then raise an error.
10342
; User doesn't see report but the flashing error marker
10343
; appears in the lower screen.
10344
 
10345
;; REPORT-Cb
10346
L21CE:  RST     08H             ; ERROR-1
10347
        DEFB    $0B             ; Error Report: Nonsense in BASIC
10348
 
10349
;; IN-STOP
10350
L21D0:  CALL    L2530           ; routine SYNTAX-Z (UNSTACK-Z?)
10351
        RET     Z               ; return if checking syntax
10352
                                ; as user wouldn't see error report.
10353
                                ; but generate visible error report
10354
                                ; on second invocation.
10355
 
10356
;; REPORT-H
10357
L21D4:  RST     08H             ; ERROR-1
10358
        DEFB    $10             ; Error Report: STOP in INPUT
10359
 
10360
; -----------------------------------
10361
; THE 'TEST FOR CHANNEL K' SUBROUTINE
10362
; -----------------------------------
10363
;   This subroutine is called once from the keyboard INPUT command to check if
10364
;   the input routine in use is the one for the keyboard.
10365
 
10366
;; IN-CHAN-K
10367
L21D6:  LD      HL,($5C51)      ; fetch address of current channel CURCHL
10368
        INC     HL              ;
10369
        INC     HL              ; advance past
10370
        INC     HL              ; input and
10371
        INC     HL              ; output streams
10372
        LD      A,(HL)          ; fetch the channel identifier.
10373
        CP      $4B             ; test for 'K'
10374
        RET                     ; return with zero set if keyboard is use.
10375
 
10376
; --------------------
10377
; Colour Item Routines
10378
; --------------------
10379
;
10380
; These routines have 3 entry points -
10381
; 1) CO-TEMP-2 to handle a series of embedded Graphic colour items.
10382
; 2) CO-TEMP-3 to handle a single embedded print colour item.
10383
; 3) CO TEMP-4 to handle a colour command such as FLASH 1
10384
;
10385
; "Due to a bug, if you bring in a peripheral channel and later use a colour
10386
;  statement, colour controls will be sent to it by mistake." - Steven Vickers
10387
;  Pitman Pocket Guide, 1984.
10388
;
10389
; To be fair, this only applies if the last channel was other than 'K', 'S'
10390
; or 'P', which are all that are supported by this ROM, but if that last
10391
; channel was a microdrive file, network channel etc. then
10392
; PAPER 6; CLS will not turn the screen yellow and
10393
; CIRCLE INK 2; 128,88,50 will not draw a red circle.
10394
;
10395
; This bug does not apply to embedded PRINT items as it is quite permissible
10396
; to mix stream altering commands and colour items.
10397
; The fix therefore would be to ensure that CLASS-07 and CLASS-09 make
10398
; channel 'S' the current channel when not checking syntax.
10399
; -----------------------------------------------------------------
10400
 
10401
;; CO-TEMP-1
10402
L21E1:  RST     20H             ; NEXT-CHAR
10403
 
10404
; -> Entry point from CLASS-09. Embedded Graphic colour items.
10405
; e.g. PLOT INK 2; PAPER 8; 128,88
10406
; Loops till all colour items output, finally addressing the coordinates.
10407
 
10408
;; CO-TEMP-2
10409
L21E2:  CALL    L21F2           ; routine CO-TEMP-3 to output colour control.
10410
        RET     C               ; return if nothing more to output. ->
10411
 
10412
 
10413
        RST     18H             ; GET-CHAR
10414
        CP      $2C             ; is it ',' separator ?
10415
        JR      Z,L21E1         ; back if so to CO-TEMP-1
10416
 
10417
        CP      $3B             ; is it ';' separator ?
10418
        JR      Z,L21E1         ; back to CO-TEMP-1 for more.
10419
 
10420
        JP      L1C8A           ; to REPORT-C (REPORT-Cb is within range)
10421
                                ; 'Nonsense in BASIC'
10422
 
10423
; -------------------
10424
; CO-TEMP-3
10425
; -------------------
10426
; -> this routine evaluates and outputs a colour control and parameter.
10427
; It is called from above and also from PR-ITEM-3 to handle a single embedded
10428
; print item e.g. PRINT PAPER 6; "Hi". In the latter case, the looping for
10429
; multiple items is within the PR-ITEM routine.
10430
; It is quite permissible to send these to any stream.
10431
 
10432
;; CO-TEMP-3
10433
L21F2:  CP      $D9             ; is it 'INK' ?
10434
        RET     C               ; return if less.
10435
 
10436
        CP      $DF             ; compare with 'OUT'
10437
        CCF                     ; Complement Carry Flag
10438
        RET     C               ; return if greater than 'OVER', $DE.
10439
 
10440
        PUSH    AF              ; save the colour token.
10441
 
10442
        RST     20H             ; address NEXT-CHAR
10443
        POP     AF              ; restore token and continue.
10444
 
10445
; -> this entry point used by CLASS-07. e.g. the command PAPER 6.
10446
 
10447
;; CO-TEMP-4
10448
L21FC:  SUB     $C9             ; reduce to control character $10 (INK)
10449
                                ; thru $15 (OVER).
10450
        PUSH    AF              ; save control.
10451
        CALL    L1C82           ; routine EXPT-1NUM stacks addressed
10452
                                ; parameter on calculator stack.
10453
        POP     AF              ; restore control.
10454
        AND     A               ; clear carry
10455
 
10456
        CALL    L1FC3           ; routine UNSTACK-Z returns if checking syntax.
10457
 
10458
        PUSH    AF              ; save again
10459
        CALL    L1E94           ; routine FIND-INT1 fetches parameter to A.
10460
        LD      D,A             ; transfer now to D
10461
        POP     AF              ; restore control.
10462
 
10463
        RST     10H             ; PRINT-A outputs the control to current
10464
                                ; channel.
10465
        LD      A,D             ; transfer parameter to A.
10466
 
10467
        RST     10H             ; PRINT-A outputs parameter.
10468
        RET                     ; return. ->
10469
 
10470
; -------------------------------------------------------------------------
10471
;
10472
;         {fl}{br}{   paper   }{  ink    }    The temporary colour attributes
10473
;          ___ ___ ___ ___ ___ ___ ___ ___    system variable.
10474
; ATTR_T  |   |   |   |   |   |   |   |   |
10475
;         |   |   |   |   |   |   |   |   |
10476
; 23695   |___|___|___|___|___|___|___|___|
10477
;           7   6   5   4   3   2   1   0
10478
;
10479
;
10480
;         {fl}{br}{   paper   }{  ink    }    The temporary mask used for
10481
;          ___ ___ ___ ___ ___ ___ ___ ___    transparent colours. Any bit
10482
; MASK_T  |   |   |   |   |   |   |   |   |   that is 1 shows that the
10483
;         |   |   |   |   |   |   |   |   |   corresponding attribute is
10484
; 23696   |___|___|___|___|___|___|___|___|   taken not from ATTR-T but from
10485
;           7   6   5   4   3   2   1   0     what is already on the screen.
10486
;
10487
;
10488
;         {paper9 }{ ink9 }{ inv1 }{ over1}   The print flags. Even bits are
10489
;          ___ ___ ___ ___ ___ ___ ___ ___    temporary flags. The odd bits
10490
; P_FLAG  |   |   |   |   |   |   |   |   |   are the permanent flags.
10491
;         | p | t | p | t | p | t | p | t |
10492
; 23697   |___|___|___|___|___|___|___|___|
10493
;           7   6   5   4   3   2   1   0
10494
;
10495
; -----------------------------------------------------------------------
10496
 
10497
; ------------------------------------
10498
;  The colour system variable handler.
10499
; ------------------------------------
10500
; This is an exit branch from PO-1-OPER, PO-2-OPER
10501
; A holds control $10 (INK) to $15 (OVER)
10502
; D holds parameter 0-9 for ink/paper 0,1 or 8 for bright/flash,
10503
; 0 or 1 for over/inverse.
10504
 
10505
;; CO-TEMP-5
10506
L2211:  SUB     $11             ; reduce range $FF-$04
10507
        ADC     A,$00           ; add in carry if INK
10508
        JR      Z,L2234         ; forward to CO-TEMP-7 with INK and PAPER.
10509
 
10510
        SUB     $02             ; reduce range $FF-$02
10511
        ADC     A,$00           ; add carry if FLASH
10512
        JR      Z,L2273         ; forward to CO-TEMP-C with FLASH and BRIGHT.
10513
 
10514
        CP      $01             ; is it 'INVERSE' ?
10515
        LD      A,D             ; fetch parameter for INVERSE/OVER
10516
        LD      B,$01           ; prepare OVER mask setting bit 0.
10517
        JR      NZ,L2228        ; forward to CO-TEMP-6 if OVER
10518
 
10519
        RLCA                    ; shift bit 0
10520
        RLCA                    ; to bit 2
10521
        LD      B,$04           ; set bit 2 of mask for inverse.
10522
 
10523
;; CO-TEMP-6
10524
L2228:  LD      C,A             ; save the A
10525
        LD      A,D             ; re-fetch parameter
10526
        CP      $02             ; is it less than 2
10527
        JR      NC,L2244        ; to REPORT-K if not 0 or 1.
10528
                                ; 'Invalid colour'.
10529
 
10530
        LD      A,C             ; restore A
10531
        LD      HL,$5C91        ; address system variable P_FLAG
10532
        JR      L226C           ; forward to exit via routine CO-CHANGE
10533
 
10534
; ---
10535
 
10536
; the branch was here with INK/PAPER and carry set for INK.
10537
 
10538
;; CO-TEMP-7
10539
L2234:  LD      A,D             ; fetch parameter
10540
        LD      B,$07           ; set ink mask 00000111
10541
        JR      C,L223E         ; forward to CO-TEMP-8 with INK
10542
 
10543
        RLCA                    ; shift bits 0-2
10544
        RLCA                    ; to
10545
        RLCA                    ; bits 3-5
10546
        LD      B,$38           ; set paper mask 00111000
10547
 
10548
; both paper and ink rejoin here
10549
 
10550
;; CO-TEMP-8
10551
L223E:  LD      C,A             ; value to C
10552
        LD      A,D             ; fetch parameter
10553
        CP      $0A             ; is it less than 10d ?
10554
        JR      C,L2246         ; forward to CO-TEMP-9 if so.
10555
 
10556
; ink 10 etc. is not allowed.
10557
 
10558
;; REPORT-K
10559
L2244:  RST     08H             ; ERROR-1
10560
        DEFB    $13             ; Error Report: Invalid colour
10561
 
10562
;; CO-TEMP-9
10563
L2246:  LD      HL,$5C8F        ; address system variable ATTR_T initially.
10564
        CP      $08             ; compare with 8
10565
        JR      C,L2258         ; forward to CO-TEMP-B with 0-7.
10566
 
10567
        LD      A,(HL)          ; fetch temporary attribute as no change.
10568
        JR      Z,L2257         ; forward to CO-TEMP-A with INK/PAPER 8
10569
 
10570
; it is either ink 9 or paper 9 (contrasting)
10571
 
10572
        OR      B               ; or with mask to make white
10573
        CPL                     ; make black and change other to dark
10574
        AND     $24             ; 00100100
10575
        JR      Z,L2257         ; forward to CO-TEMP-A if black and
10576
                                ; originally light.
10577
 
10578
        LD      A,B             ; else just use the mask (white)
10579
 
10580
;; CO-TEMP-A
10581
L2257:  LD      C,A             ; save A in C
10582
 
10583
;; CO-TEMP-B
10584
L2258:  LD      A,C             ; load colour to A
10585
        CALL    L226C           ; routine CO-CHANGE addressing ATTR-T
10586
 
10587
        LD      A,$07           ; put 7 in accumulator
10588
        CP      D               ; compare with parameter
10589
        SBC     A,A             ; $00 if 0-7, $FF if 8
10590
        CALL    L226C           ; routine CO-CHANGE addressing MASK-T
10591
                                ; mask returned in A.
10592
 
10593
; now consider P-FLAG.
10594
 
10595
        RLCA                    ; 01110000 or 00001110
10596
        RLCA                    ; 11100000 or 00011100
10597
        AND     $50             ; 01000000 or 00010000  (AND 01010000)
10598
        LD      B,A             ; transfer to mask
10599
        LD      A,$08           ; load A with 8
10600
        CP      D               ; compare with parameter
10601
        SBC     A,A             ; $FF if was 9,  $00 if 0-8
10602
                                ; continue while addressing P-FLAG
10603
                                ; setting bit 4 if ink 9
10604
                                ; setting bit 6 if paper 9
10605
 
10606
; -----------------------
10607
; Handle change of colour
10608
; -----------------------
10609
; This routine addresses a system variable ATTR_T, MASK_T or P-FLAG in HL.
10610
; colour value in A, mask in B.
10611
 
10612
;; CO-CHANGE
10613
L226C:  XOR     (HL)            ; impress bits specified
10614
        AND     B               ; by mask
10615
        XOR     (HL)            ; on system variable.
10616
        LD      (HL),A          ; update system variable.
10617
        INC     HL              ; address next location.
10618
        LD      A,B             ; put current value of mask in A
10619
        RET                     ; return.
10620
 
10621
; ---
10622
 
10623
; the branch was here with flash and bright
10624
 
10625
;; CO-TEMP-C
10626
L2273:  SBC     A,A             ; set zero flag for bright.
10627
        LD      A,D             ; fetch original parameter 0,1 or 8
10628
        RRCA                    ; rotate bit 0 to bit 7
10629
        LD      B,$80           ; mask for flash 10000000
10630
        JR      NZ,L227D        ; forward to CO-TEMP-D if flash
10631
 
10632
        RRCA                    ; rotate bit 7 to bit 6
10633
        LD      B,$40           ; mask for bright 01000000
10634
 
10635
;; CO-TEMP-D
10636
L227D:  LD      C,A             ; store value in C
10637
        LD      A,D             ; fetch parameter
10638
        CP      $08             ; compare with 8
10639
        JR      Z,L2287         ; forward to CO-TEMP-E if 8
10640
 
10641
        CP      $02             ; test if 0 or 1
10642
        JR      NC,L2244        ; back to REPORT-K if not
10643
                                ; 'Invalid colour'
10644
 
10645
;; CO-TEMP-E
10646
L2287:  LD      A,C             ; value to A
10647
        LD      HL,$5C8F        ; address ATTR_T
10648
        CALL    L226C           ; routine CO-CHANGE addressing ATTR_T
10649
        LD      A,C             ; fetch value
10650
        RRCA                    ; for flash8/bright8 complete
10651
        RRCA                    ; rotations to put set bit in
10652
        RRCA                    ; bit 7 (flash) bit 6 (bright)
10653
        JR      L226C           ; back to CO-CHANGE addressing MASK_T
10654
                                ; and indirect return.
10655
 
10656
; ---------------------
10657
; Handle BORDER command
10658
; ---------------------
10659
; Command syntax example: BORDER 7
10660
; This command routine sets the border to one of the eight colours.
10661
; The colours used for the lower screen are based on this.
10662
 
10663
;; BORDER
10664
L2294:  CALL    L1E94           ; routine FIND-INT1
10665
        CP      $08             ; must be in range 0 (black) to 7 (white)
10666
        JR      NC,L2244        ; back to REPORT-K if not
10667
                                ; 'Invalid colour'.
10668
 
10669
        OUT     ($FE),A         ; outputting to port effects an immediate
10670
                                ; change.
10671
        RLCA                    ; shift the colour to
10672
        RLCA                    ; the paper bits setting the
10673
        RLCA                    ; ink colour black.
10674
        BIT     5,A             ; is the number light coloured ?
10675
                                ; i.e. in the range green to white.
10676
        JR      NZ,L22A6        ; skip to BORDER-1 if so
10677
 
10678
        XOR     $07             ; make the ink white.
10679
 
10680
;; BORDER-1
10681
L22A6:  LD      ($5C48),A       ; update BORDCR with new paper/ink
10682
        RET                     ; return.
10683
 
10684
; -----------------
10685
; Get pixel address
10686
; -----------------
10687
;
10688
;
10689
 
10690
;; PIXEL-ADD
10691
L22AA:  LD      A,$AF           ; load with 175 decimal.
10692
        SUB     B               ; subtract the y value.
10693
        JP      C,L24F9         ; jump forward to REPORT-Bc if greater.
10694
                                ; 'Integer out of range'
10695
 
10696
; the high byte is derived from Y only.
10697
; the first 3 bits are always 010
10698
; the next 2 bits denote in which third of the screen the byte is.
10699
; the last 3 bits denote in which of the 8 scan lines within a third
10700
; the byte is located. There are 24 discrete values.
10701
 
10702
 
10703
        LD      B,A             ; the line number from top of screen to B.
10704
        AND     A               ; clear carry (already clear)
10705
        RRA                     ;                     0xxxxxxx
10706
        SCF                     ; set carry flag
10707
        RRA                     ;                     10xxxxxx
10708
        AND     A               ; clear carry flag
10709
        RRA                     ;                     010xxxxx
10710
 
10711
        XOR     B               ;
10712
        AND     $F8             ; keep the top 5 bits 11111000
10713
        XOR     B               ;                     010xxbbb
10714
        LD      H,A             ; transfer high byte to H.
10715
 
10716
; the low byte is derived from both X and Y.
10717
 
10718
        LD      A,C             ; the x value 0-255.
10719
        RLCA                    ;
10720
        RLCA                    ;
10721
        RLCA                    ;
10722
        XOR     B               ; the y value
10723
        AND     $C7             ; apply mask             11000111
10724
        XOR     B               ; restore unmasked bits  xxyyyxxx
10725
        RLCA                    ; rotate to              xyyyxxxx
10726
        RLCA                    ; required position.     yyyxxxxx
10727
        LD      L,A             ; low byte to L.
10728
 
10729
; finally form the pixel position in A.
10730
 
10731
        LD      A,C             ; x value to A
10732
        AND     $07             ; mod 8
10733
        RET                     ; return
10734
 
10735
; ----------------
10736
; Point Subroutine
10737
; ----------------
10738
; The point subroutine is called from s-point via the scanning functions
10739
; table.
10740
 
10741
;; POINT-SUB
10742
L22CB:  CALL    L2307           ; routine STK-TO-BC
10743
        CALL    L22AA           ; routine PIXEL-ADD finds address of pixel.
10744
        LD      B,A             ; pixel position to B, 0-7.
10745
        INC     B               ; increment to give rotation count 1-8.
10746
        LD      A,(HL)          ; fetch byte from screen.
10747
 
10748
;; POINT-LP
10749
L22D4:  RLCA                    ; rotate and loop back
10750
        DJNZ    L22D4           ; to POINT-LP until pixel at right.
10751
 
10752
        AND      $01            ; test to give zero or one.
10753
        JP      L2D28           ; jump forward to STACK-A to save result.
10754
 
10755
; -------------------
10756
; Handle PLOT command
10757
; -------------------
10758
; Command Syntax example: PLOT 128,88
10759
;
10760
 
10761
;; PLOT
10762
L22DC:  CALL    L2307           ; routine STK-TO-BC
10763
        CALL    L22E5           ; routine PLOT-SUB
10764
        JP      L0D4D           ; to TEMPS
10765
 
10766
; -------------------
10767
; The Plot subroutine
10768
; -------------------
10769
; A screen byte holds 8 pixels so it is necessary to rotate a mask
10770
; into the correct position to leave the other 7 pixels unaffected.
10771
; However all 64 pixels in the character cell take any embedded colour
10772
; items.
10773
; A pixel can be reset (inverse 1), toggled (over 1), or set ( with inverse
10774
; and over switches off). With both switches on, the byte is simply put
10775
; back on the screen though the colours may change.
10776
 
10777
;; PLOT-SUB
10778
L22E5:  LD      ($5C7D),BC      ; store new x/y values in COORDS
10779
        CALL    L22AA           ; routine PIXEL-ADD gets address in HL,
10780
                                ; count from left 0-7 in B.
10781
        LD      B,A             ; transfer count to B.
10782
        INC     B               ; increase 1-8.
10783
        LD      A,$FE           ; 11111110 in A.
10784
 
10785
;; PLOT-LOOP
10786
L22F0:  RRCA                    ; rotate mask.
10787
        DJNZ    L22F0           ; to PLOT-LOOP until B circular rotations.
10788
 
10789
        LD      B,A             ; load mask to B
10790
        LD      A,(HL)          ; fetch screen byte to A
10791
 
10792
        LD      C,(IY+$57)      ; P_FLAG to C
10793
        BIT     0,C             ; is it to be OVER 1 ?
10794
        JR      NZ,L22FD        ; forward to PL-TST-IN if so.
10795
 
10796
; was over 0
10797
 
10798
        AND     B               ; combine with mask to blank pixel.
10799
 
10800
;; PL-TST-IN
10801
L22FD:  BIT     2,C             ; is it inverse 1 ?
10802
        JR      NZ,L2303        ; to PLOT-END if so.
10803
 
10804
        XOR     B               ; switch the pixel
10805
        CPL                     ; restore other 7 bits
10806
 
10807
;; PLOT-END
10808
L2303:  LD      (HL),A          ; load byte to the screen.
10809
        JP      L0BDB           ; exit to PO-ATTR to set colours for cell.
10810
 
10811
; ------------------------------
10812
; Put two numbers in BC register
10813
; ------------------------------
10814
;
10815
;
10816
 
10817
;; STK-TO-BC
10818
L2307:  CALL    L2314           ; routine STK-TO-A
10819
        LD      B,A             ;
10820
        PUSH    BC              ;
10821
        CALL    L2314           ; routine STK-TO-A
10822
        LD      E,C             ;
10823
        POP     BC              ;
10824
        LD      D,C             ;
10825
        LD      C,A             ;
10826
        RET                     ;
10827
 
10828
; -----------------------
10829
; Put stack in A register
10830
; -----------------------
10831
; This routine puts the last value on the calculator stack into the accumulator
10832
; deleting the last value.
10833
 
10834
;; STK-TO-A
10835
L2314:  CALL    L2DD5           ; routine FP-TO-A compresses last value into
10836
                                ; accumulator. e.g. PI would become 3.
10837
                                ; zero flag set if positive.
10838
        JP      C,L24F9         ; jump forward to REPORT-Bc if >= 255.5.
10839
 
10840
        LD      C,$01           ; prepare a positive sign byte.
10841
        RET     Z               ; return if FP-TO-BC indicated positive.
10842
 
10843
        LD      C,$FF           ; prepare negative sign byte and
10844
        RET                     ; return.
10845
 
10846
 
10847
; --------------------
10848
; THE 'CIRCLE' COMMAND
10849
; --------------------
10850
;   "Goe not Thou about to Square eyther circle" -
10851
;   - John Donne, Cambridge educated theologian, 1624
10852
;
10853
;   The CIRCLE command draws a circle as a series of straight lines.
10854
;   In some ways it can be regarded as a polygon, but the first line is drawn
10855
;   as a tangent, taking the radius as its distance from the centre.
10856
;
10857
;   Both the CIRCLE algorithm and the ARC drawing algorithm make use of the
10858
;   'ROTATION FORMULA' (see later).  It is only necessary to work out where
10859
;   the first line will be drawn and how long it is and then the rotation
10860
;   formula takes over and calculates all other rotated points.
10861
;
10862
;   All Spectrum circles consist of two vertical lines at each side and two
10863
;   horizontal lines at the top and bottom. The number of lines is calculated
10864
;   from the radius of the circle and is always divisible by 4. For complete
10865
;   circles it will range from 4 for a square circle to 32 for a circle of
10866
;   radius 87. The Spectrum can attempt larger circles e.g. CIRCLE 0,14,255
10867
;   but these will error as they go off-screen after four lines are drawn.
10868
;   At the opposite end, CIRCLE 128,88,1.23 will draw a circle as a perfect 3x3
10869
;   square using 4 straight lines although very small circles are just drawn as
10870
;   a dot on the screen.
10871
;
10872
;   The first chord drawn is the vertical chord on the right of the circle.
10873
;   The starting point is at the base of this chord which is drawn upwards and
10874
;   the circle continues in an anti-clockwise direction. As noted earlier the
10875
;   x-coordinate of this point measured from the centre of the circle is the
10876
;   radius.
10877
;
10878
;   The CIRCLE command makes extensive use of the calculator and as part of
10879
;   process of drawing a large circle, free memory is checked 1315 times.
10880
;   When drawing a large arc, free memory is checked 928 times.
10881
;   A single call to 'sin' involves 63 memory checks and so values of sine
10882
;   and cosine are pre-calculated and held in the mem locations. As a
10883
;   clever trick 'cos' is derived from 'sin' using simple arithmetic operations
10884
;   instead of the more expensive 'cos' function.
10885
;
10886
;   Initially, the syntax has been partly checked using the class for the DRAW
10887
;   command which stacks the origin of the circle (X,Y).
10888
 
10889
;; CIRCLE
10890
L2320:  RST     18H             ; GET-CHAR              x, y.
10891
        CP      $2C             ; Is character the required comma ?
10892
        JP      NZ,L1C8A        ; Jump, if not, to REPORT-C
10893
                                ; 'Nonsense in basic'
10894
 
10895
        RST     20H             ; NEXT-CHAR advances the parsed character address.
10896
        CALL    L1C82           ; routine EXPT-1NUM stacks radius in runtime.
10897
        CALL    L1BEE           ; routine CHECK-END will return here in runtime
10898
                                ; if nothing follows the command.
10899
 
10900
;   Now make the radius positive and ensure that it is in floating point form
10901
;   so that the exponent byte can be accessed for quick testing.
10902
 
10903
        RST     28H             ;; FP-CALC              x, y, r.
10904
        DEFB    $2A             ;;abs                   x, y, r.
10905
        DEFB    $3D             ;;re-stack              x, y, r.
10906
        DEFB    $38             ;;end-calc              x, y, r.
10907
 
10908
        LD      A,(HL)          ; Fetch first, floating-point, exponent byte.
10909
        CP      $81             ; Compare to one.
10910
        JR      NC,L233B        ; Forward to C-R-GRE-1
10911
                                ; if circle radius is greater than one.
10912
 
10913
;    The circle is no larger than a single pixel so delete the radius from the
10914
;    calculator stack and plot a point at the centre.
10915
 
10916
        RST     28H             ;; FP-CALC              x, y, r.
10917
        DEFB    $02             ;;delete                x, y.
10918
        DEFB    $38             ;;end-calc              x, y.
10919
 
10920
        JR      L22DC           ; back to PLOT routine to just plot x,y.
10921
 
10922
; ---
10923
 
10924
;   Continue when the circle's radius measures greater than one by forming
10925
;   the angle 2 * PI radians which is 360 degrees.
10926
 
10927
;; C-R-GRE-1
10928
L233B:  RST     28H             ;; FP-CALC      x, y, r
10929
        DEFB    $A3             ;;stk-pi/2      x, y, r, pi/2.
10930
        DEFB    $38             ;;end-calc      x, y, r, pi/2.
10931
 
10932
;   Change the exponent of pi/2 from $81 to $83 giving 2*PI the central angle.
10933
;   This is quicker than multiplying by four.
10934
 
10935
        LD      (HL),$83        ;               x, y, r, 2*PI.
10936
 
10937
;   Now store this important constant in mem-5 and delete so that other
10938
;   parameters can be derived from it, by a routine shared with DRAW.
10939
 
10940
        RST     28H             ;; FP-CALC      x, y, r, 2*PI.
10941
        DEFB    $C5             ;;st-mem-5      store 2*PI in mem-5
10942
        DEFB    $02             ;;delete        x, y, r.
10943
        DEFB    $38             ;;end-calc      x, y, r.
10944
 
10945
;   The parameters derived from mem-5 (A) and from the radius are set up in
10946
;   four of the other mem locations by the CIRCLE DRAW PARAMETERS routine which
10947
;   also returns the number of straight lines in the B register.
10948
 
10949
        CALL    L247D           ; routine CD-PRMS1
10950
 
10951
                                ; mem-0 ; A/No of lines (=a)            unused
10952
                                ; mem-1 ; sin(a/2)  will be moving x    var
10953
                                ; mem-2 ; -         will be moving y    var
10954
                                ; mem-3 ; cos(a)                        const
10955
                                ; mem-4 ; sin(a)                        const
10956
                                ; mem-5 ; Angle of rotation (A) (2*PI)  const
10957
                                ; B     ; Number of straight lines.
10958
 
10959
        PUSH    BC              ; Preserve the number of lines in B.
10960
 
10961
;   Next calculate the length of half a chord by multiplying the sine of half
10962
;   the central angle by the radius of the circle.
10963
 
10964
        RST     28H             ;; FP-CALC      x, y, r.
10965
        DEFB    $31             ;;duplicate     x, y, r, r.
10966
        DEFB    $E1             ;;get-mem-1     x, y, r, r, sin(a/2).
10967
        DEFB    $04             ;;multiply      x, y, r, half-chord.
10968
        DEFB    $38             ;;end-calc      x, y, r, half-chord.
10969
 
10970
        LD      A,(HL)          ; fetch exponent  of the half arc to A.
10971
        CP      $80             ; compare to a half pixel
10972
        JR      NC,L235A        ; forward, if greater than .5, to C-ARC-GE1
10973
 
10974
;   If the first line is less than .5 then 4 'lines' would be drawn on the same
10975
;   spot so tidy the calculator stack and machine stack and plot the centre.
10976
 
10977
        RST     28H             ;; FP-CALC      x, y, r, hc.
10978
        DEFB    $02             ;;delete        x, y, r.
10979
        DEFB    $02             ;;delete        x, y.
10980
        DEFB    $38             ;;end-calc      x, y.
10981
 
10982
        POP     BC              ; Balance machine stack by taking chord-count.
10983
 
10984
        JP      L22DC           ; JUMP to PLOT
10985
 
10986
; ---
10987
 
10988
;   The arc is greater than 0.5 so the circle can be drawn.
10989
 
10990
;; C-ARC-GE1
10991
L235A:  RST     28H             ;; FP-CALC      x, y, r, hc.
10992
        DEFB    $C2             ;;st-mem-2      x, y, r, half chord to mem-2.
10993
        DEFB    $01             ;;exchange      x, y, hc, r.
10994
        DEFB    $C0             ;;st-mem-0      x, y, hc, r.
10995
        DEFB    $02             ;;delete        x, y, hc.
10996
 
10997
;   Subtract the length of the half-chord from the absolute y coordinate to
10998
;   give the starting y coordinate sy.
10999
;   Note that for a circle this is also the end coordinate.
11000
 
11001
        DEFB    $03             ;;subtract      x, y-hc.  (The start y-coord)
11002
        DEFB    $01             ;;exchange      sy, x.
11003
 
11004
;   Next simply add the radius to the x coordinate to give a fuzzy x-coordinate.
11005
;   Strictly speaking, the radius should be multiplied by cos(a/2) first but
11006
;   doing it this way makes the circle slightly larger.
11007
 
11008
        DEFB    $E0             ;;get-mem-0     sy, x, r.
11009
        DEFB    $0F             ;;addition      sy, x+r.  (The start x-coord)
11010
 
11011
;   We now want three copies of this pair of values on the calculator stack.
11012
;   The first pair remain on the stack throughout the circle routine and are
11013
;   the end points. The next pair will be the moving absolute values of x and y
11014
;   that are updated after each line is drawn. The final pair will be loaded
11015
;   into the COORDS system variable so that the first vertical line starts at
11016
;   the right place.
11017
 
11018
        DEFB    $C0             ;;st-mem-0      sy, sx.
11019
        DEFB    $01             ;;exchange      sx, sy.
11020
        DEFB    $31             ;;duplicate     sx, sy, sy.
11021
        DEFB    $E0             ;;get-mem-0     sx, sy, sy, sx.
11022
        DEFB    $01             ;;exchange      sx, sy, sx, sy.
11023
        DEFB    $31             ;;duplicate     sx, sy, sx, sy, sy.
11024
        DEFB    $E0             ;;get-mem-0     sx, sy, sx, sy, sy, sx.
11025
 
11026
;   Locations mem-1 and mem-2 are the relative x and y values which are updated
11027
;   after each line is drawn. Since we are drawing a vertical line then the rx
11028
;   value in mem-1 is zero and the ry value in mem-2 is the full chord.
11029
 
11030
        DEFB    $A0             ;;stk-zero      sx, sy, sx, sy, sy, sx, 0.
11031
        DEFB    $C1             ;;st-mem-1      sx, sy, sx, sy, sy, sx, 0.
11032
        DEFB    $02             ;;delete        sx, sy, sx, sy, sy, sx.
11033
 
11034
;   Although the three pairs of x/y values are the same for a circle, they
11035
;   will be labelled terminating, absolute and start coordinates.
11036
 
11037
        DEFB    $38             ;;end-calc      tx, ty, ax, ay, sy, sx.
11038
 
11039
;   Use the exponent manipulating trick again to double the value of mem-2.
11040
 
11041
        INC     (IY+$62)        ; Increment MEM-2-1st doubling half chord.
11042
 
11043
;   Note. this first vertical chord is drawn at the radius so circles are
11044
;   slightly displaced to the right.
11045
;   It is only necessary to place the values (sx) and (sy) in the system
11046
;   variable COORDS to ensure that drawing commences at the correct pixel.
11047
;   Note. a couple of LD (COORDS),A instructions would have been quicker, and
11048
;   simpler, than using LD (COORDS),HL.
11049
 
11050
        CALL    L1E94           ; routine FIND-INT1 fetches sx from stack to A.
11051
 
11052
        LD      L,A             ; place X value in L.
11053
        PUSH    HL              ; save the holding register.
11054
 
11055
        CALL    L1E94           ; routine FIND-INT1 fetches sy to A
11056
 
11057
        POP     HL              ; restore the holding register.
11058
        LD      H,A             ; and place y value in high byte.
11059
 
11060
        LD      ($5C7D),HL      ; Update the COORDS system variable.
11061
                                ;
11062
                                ;               tx, ty, ax, ay.
11063
 
11064
        POP     BC              ; restore the chord count
11065
                                ; values 4,8,12,16,20,24,28 or 32.
11066
 
11067
        JP      L2420           ; forward to DRW-STEPS
11068
                                ;               tx, ty, ax, ay.
11069
 
11070
;   Note. the jump to DRW-STEPS is just to decrement B and jump into the
11071
;   middle of the arc-drawing loop. The arc count which includes the first
11072
;   vertical arc draws one less than the perceived number of arcs.
11073
;   The final arc offsets are obtained by subtracting the final COORDS value
11074
;   from the initial sx and sy values which are kept at the base of the
11075
;   calculator stack throughout the arc loop.
11076
;   This ensures that the final line finishes exactly at the starting pixel
11077
;   removing the possibility of any inaccuracy.
11078
;   Since the initial sx and sy values are not required until the final arc
11079
;   is drawn, they are not shown until then.
11080
;   As the calculator stack is quite busy, only the active parts are shown in
11081
;   each section.
11082
 
11083
 
11084
; ------------------
11085
; THE 'DRAW' COMMAND
11086
; ------------------
11087
;   The Spectrum's DRAW command is overloaded and can take two parameters sets.
11088
;
11089
;   With two parameters, it simply draws an approximation to a straight line
11090
;   at offset x,y using the LINE-DRAW routine.
11091
;
11092
;   With three parameters, an arc is drawn to the point at offset x,y turning
11093
;   through an angle, in radians, supplied by the third parameter.
11094
;   The arc will consist of 4 to 252 straight lines each one of which is drawn
11095
;   by calls to the DRAW-LINE routine.
11096
 
11097
;; DRAW
11098
L2382:  RST     18H             ; GET-CHAR
11099
        CP      $2C             ; is it the comma character ?
11100
        JR      Z,L238D         ; forward, if so, to DR-3-PRMS
11101
 
11102
;   There are two parameters e.g. DRAW 255,175
11103
 
11104
        CALL    L1BEE           ; routine CHECK-END
11105
 
11106
        JP      L2477           ; jump forward to LINE-DRAW
11107
 
11108
; ---
11109
 
11110
;    There are three parameters e.g. DRAW 255, 175, .5
11111
;    The first two are relative coordinates and the third is the angle of
11112
;    rotation in radians (A).
11113
 
11114
;; DR-3-PRMS
11115
L238D:  RST     20H             ; NEXT-CHAR skips over the 'comma'.
11116
 
11117
        CALL    L1C82           ; routine EXPT-1NUM stacks the rotation angle.
11118
 
11119
        CALL    L1BEE           ; routine CHECK-END
11120
 
11121
;   Now enter the calculator and store the complete rotation angle in mem-5
11122
 
11123
        RST     28H             ;; FP-CALC      x, y, A.
11124
        DEFB    $C5             ;;st-mem-5      x, y, A.
11125
 
11126
;   Test the angle for the special case of 360 degrees.
11127
 
11128
        DEFB    $A2             ;;stk-half      x, y, A, 1/2.
11129
        DEFB    $04             ;;multiply      x, y, A/2.
11130
        DEFB    $1F             ;;sin           x, y, sin(A/2).
11131
        DEFB    $31             ;;duplicate     x, y, sin(A/2),sin(A/2)
11132
        DEFB    $30             ;;not           x, y, sin(A/2), (0/1).
11133
        DEFB    $30             ;;not           x, y, sin(A/2), (1/0).
11134
        DEFB    $00             ;;jump-true     x, y, sin(A/2).
11135
 
11136
        DEFB    $06             ;;forward to L23A3, DR-SIN-NZ
11137
                                ; if sin(r/2) is not zero.
11138
 
11139
;   The third parameter is 2*PI (or a multiple of 2*PI) so a 360 degrees turn
11140
;   would just be a straight line.  Eliminating this case here prevents
11141
;   division by zero at later stage.
11142
 
11143
        DEFB    $02             ;;delete        x, y.
11144
        DEFB    $38             ;;end-calc      x, y.
11145
 
11146
        JP      L2477           ; forward to LINE-DRAW
11147
 
11148
; ---
11149
 
11150
;   An arc can be drawn.
11151
 
11152
;; DR-SIN-NZ
11153
L23A3:  DEFB    $C0             ;;st-mem-0      x, y, sin(A/2).   store mem-0
11154
        DEFB    $02             ;;delete        x, y.
11155
 
11156
;   The next step calculates (roughly) the diameter of the circle of which the
11157
;   arc will form part.  This value does not have to be too accurate as it is
11158
;   only used to evaluate the number of straight lines and then discarded.
11159
;   After all for a circle, the radius is used. Consequently, a circle of
11160
;   radius 50 will have 24 straight lines but an arc of radius 50 will have 20
11161
;   straight lines - when drawn in any direction.
11162
;   So that simple arithmetic can be used, the length of the chord can be
11163
;   calculated as X+Y rather than by Pythagoras Theorem and the sine of the
11164
;   nearest angle within reach is used.
11165
 
11166
        DEFB    $C1             ;;st-mem-1      x, y.             store mem-1
11167
        DEFB    $02             ;;delete        x.
11168
 
11169
        DEFB    $31             ;;duplicate     x, x.
11170
        DEFB    $2A             ;;abs           x, x (+ve).
11171
        DEFB    $E1             ;;get-mem-1     x, X, y.
11172
        DEFB    $01             ;;exchange      x, y, X.
11173
        DEFB    $E1             ;;get-mem-1     x, y, X, y.
11174
        DEFB    $2A             ;;abs           x, y, X, Y (+ve).
11175
        DEFB    $0F             ;;addition      x, y, X+Y.
11176
        DEFB    $E0             ;;get-mem-0     x, y, X+Y, sin(A/2).
11177
        DEFB    $05             ;;division      x, y, X+Y/sin(A/2).
11178
        DEFB    $2A             ;;abs           x, y, X+Y/sin(A/2) = D.
11179
 
11180
;    Bring back sin(A/2) from mem-0 which will shortly get trashed.
11181
;    Then bring D to the top of the stack again.
11182
 
11183
        DEFB    $E0             ;;get-mem-0     x, y, D, sin(A/2).
11184
        DEFB    $01             ;;exchange      x, y, sin(A/2), D.
11185
 
11186
;   Note. that since the value at the top of the stack has arisen as a result
11187
;   of division then it can no longer be in integer form and the next re-stack
11188
;   is unnecessary. Only the Sinclair ZX80 had integer division.
11189
 
11190
        DEFB    $3D             ;;re-stack      (unnecessary)
11191
 
11192
        DEFB    $38             ;;end-calc      x, y, sin(A/2), D.
11193
 
11194
;   The next test avoids drawing 4 straight lines when the start and end pixels
11195
;   are adjacent (or the same) but is probably best dispensed with.
11196
 
11197
        LD      A,(HL)          ; fetch exponent byte of D.
11198
        CP      $81             ; compare to 1
11199
        JR      NC,L23C1        ; forward, if > 1,  to DR-PRMS
11200
 
11201
;   else delete the top two stack values and draw a simple straight line.
11202
 
11203
        RST     28H             ;; FP-CALC
11204
        DEFB    $02             ;;delete
11205
        DEFB    $02             ;;delete
11206
        DEFB    $38             ;;end-calc      x, y.
11207
 
11208
        JP      L2477           ; to LINE-DRAW
11209
 
11210
; ---
11211
 
11212
;   The ARC will consist of multiple straight lines so call the CIRCLE-DRAW
11213
;   PARAMETERS ROUTINE to pre-calculate sine values from the angle (in mem-5)
11214
;   and determine also the number of straight lines from that value and the
11215
;   'diameter' which is at the top of the calculator stack.
11216
 
11217
;; DR-PRMS
11218
L23C1:  CALL    L247D           ; routine CD-PRMS1
11219
 
11220
                                ; mem-0 ; (A)/No. of lines (=a) (step angle)
11221
                                ; mem-1 ; sin(a/2)
11222
                                ; mem-2 ; -
11223
                                ; mem-3 ; cos(a)                        const
11224
                                ; mem-4 ; sin(a)                        const
11225
                                ; mem-5 ; Angle of rotation (A)         in
11226
                                ; B     ; Count of straight lines - max 252.
11227
 
11228
        PUSH    BC              ; Save the line count on the machine stack.
11229
 
11230
;   Remove the now redundant diameter value D.
11231
 
11232
        RST     28H             ;; FP-CALC      x, y, sin(A/2), D.
11233
        DEFB    $02             ;;delete        x, y, sin(A/2).
11234
 
11235
;   Dividing the sine of the step angle by the sine of the total angle gives
11236
;   the length of the initial chord on a unary circle. This factor f is used
11237
;   to scale the coordinates of the first line which still points in the
11238
;   direction of the end point and may be larger.
11239
 
11240
        DEFB    $E1             ;;get-mem-1     x, y, sin(A/2), sin(a/2)
11241
        DEFB    $01             ;;exchange      x, y, sin(a/2), sin(A/2)
11242
        DEFB    $05             ;;division      x, y, sin(a/2)/sin(A/2)
11243
        DEFB    $C1             ;;st-mem-1      x, y. f.
11244
        DEFB    $02             ;;delete        x, y.
11245
 
11246
;   With the factor stored, scale the x coordinate first.
11247
 
11248
        DEFB    $01             ;;exchange      y, x.
11249
        DEFB    $31             ;;duplicate     y, x, x.
11250
        DEFB    $E1             ;;get-mem-1     y, x, x, f.
11251
        DEFB    $04             ;;multiply      y, x, x*f    (=xx)
11252
        DEFB    $C2             ;;st-mem-2      y, x, xx.
11253
        DEFB    $02             ;;delete        y. x.
11254
 
11255
;   Now scale the y coordinate.
11256
 
11257
        DEFB    $01             ;;exchange      x, y.
11258
        DEFB    $31             ;;duplicate     x, y, y.
11259
        DEFB    $E1             ;;get-mem-1     x, y, y, f
11260
        DEFB    $04             ;;multiply      x, y, y*f    (=yy)
11261
 
11262
;   Note. 'sin' and 'cos' trash locations mem-0 to mem-2 so fetch mem-2 to the
11263
;   calculator stack for safe keeping.
11264
 
11265
        DEFB    $E2             ;;get-mem-2     x, y, yy, xx.
11266
 
11267
;   Once we get the coordinates of the first straight line then the 'ROTATION
11268
;   FORMULA' used in the arc loop will take care of all other points, but we
11269
;   now use a variation of that formula to rotate the first arc through (A-a)/2
11270
;   radians.
11271
;
11272
;       xRotated = y * sin(angle) + x * cos(angle)
11273
;       yRotated = y * cos(angle) - x * sin(angle)
11274
;
11275
 
11276
        DEFB    $E5             ;;get-mem-5     x, y, yy, xx, A.
11277
        DEFB    $E0             ;;get-mem-0     x, y, yy, xx, A, a.
11278
        DEFB    $03             ;;subtract      x, y, yy, xx, A-a.
11279
        DEFB    $A2             ;;stk-half      x, y, yy, xx, A-a, 1/2.
11280
        DEFB    $04             ;;multiply      x, y, yy, xx, (A-a)/2. (=angle)
11281
        DEFB    $31             ;;duplicate     x, y, yy, xx, angle, angle.
11282
        DEFB    $1F             ;;sin           x, y, yy, xx, angle, sin(angle)
11283
        DEFB    $C5             ;;st-mem-5      x, y, yy, xx, angle, sin(angle)
11284
        DEFB    $02             ;;delete        x, y, yy, xx, angle
11285
 
11286
        DEFB    $20             ;;cos           x, y, yy, xx, cos(angle).
11287
 
11288
;   Note. mem-0, mem-1 and mem-2 can be used again now...
11289
 
11290
        DEFB    $C0             ;;st-mem-0      x, y, yy, xx, cos(angle).
11291
        DEFB    $02             ;;delete        x, y, yy, xx.
11292
 
11293
        DEFB    $C2             ;;st-mem-2      x, y, yy, xx.
11294
        DEFB    $02             ;;delete        x, y, yy.
11295
 
11296
        DEFB    $C1             ;;st-mem-1      x, y, yy.
11297
        DEFB    $E5             ;;get-mem-5     x, y, yy, sin(angle)
11298
        DEFB    $04             ;;multiply      x, y, yy*sin(angle).
11299
        DEFB    $E0             ;;get-mem-0     x, y, yy*sin(angle), cos(angle)
11300
        DEFB    $E2             ;;get-mem-2     x, y, yy*sin(angle), cos(angle), xx.
11301
        DEFB    $04             ;;multiply      x, y, yy*sin(angle), xx*cos(angle).
11302
        DEFB    $0F             ;;addition      x, y, xRotated.
11303
        DEFB    $E1             ;;get-mem-1     x, y, xRotated, yy.
11304
        DEFB    $01             ;;exchange      x, y, yy, xRotated.
11305
        DEFB    $C1             ;;st-mem-1      x, y, yy, xRotated.
11306
        DEFB    $02             ;;delete        x, y, yy.
11307
 
11308
        DEFB    $E0             ;;get-mem-0     x, y, yy, cos(angle).
11309
        DEFB    $04             ;;multiply      x, y, yy*cos(angle).
11310
        DEFB    $E2             ;;get-mem-2     x, y, yy*cos(angle), xx.
11311
        DEFB    $E5             ;;get-mem-5     x, y, yy*cos(angle), xx, sin(angle).
11312
        DEFB    $04             ;;multiply      x, y, yy*cos(angle), xx*sin(angle).
11313
        DEFB    $03             ;;subtract      x, y, yRotated.
11314
        DEFB    $C2             ;;st-mem-2      x, y, yRotated.
11315
 
11316
;   Now the initial x and y coordinates are made positive and summed to see
11317
;   if they measure up to anything significant.
11318
 
11319
        DEFB    $2A             ;;abs           x, y, yRotated'.
11320
        DEFB    $E1             ;;get-mem-1     x, y, yRotated', xRotated.
11321
        DEFB    $2A             ;;abs           x, y, yRotated', xRotated'.
11322
        DEFB    $0F             ;;addition      x, y, yRotated+xRotated.
11323
        DEFB    $02             ;;delete        x, y.
11324
 
11325
        DEFB    $38             ;;end-calc      x, y.
11326
 
11327
;   Although the test value has been deleted it is still above the calculator
11328
;   stack in memory and conveniently DE which points to the first free byte
11329
;   addresses the exponent of the test value.
11330
 
11331
        LD      A,(DE)          ; Fetch exponent of the length indicator.
11332
        CP      $81             ; Compare to that for 1
11333
 
11334
        POP     BC              ; Balance the machine stack
11335
 
11336
        JP      C,L2477         ; forward, if the coordinates of first line
11337
                                ; don't add up to more than 1, to LINE-DRAW
11338
 
11339
;   Continue when the arc will have a discernable shape.
11340
 
11341
        PUSH    BC              ; Restore line counter to the machine stack.
11342
 
11343
;   The parameters of the DRAW command were relative and they are now converted
11344
;   to absolute coordinates by adding to the coordinates of the last point
11345
;   plotted. The first two values on the stack are the terminal tx and ty
11346
;   coordinates.  The x-coordinate is converted first but first the last point
11347
;   plotted is saved as it will initialize the moving ax, value.
11348
 
11349
        RST     28H             ;; FP-CALC      x, y.
11350
        DEFB    $01             ;;exchange      y, x.
11351
        DEFB    $38             ;;end-calc      y, x.
11352
 
11353
        LD      A,($5C7D)       ; Fetch System Variable COORDS-x
11354
        CALL    L2D28           ; routine STACK-A
11355
 
11356
        RST     28H             ;; FP-CALC      y, x, last-x.
11357
 
11358
;   Store the last point plotted to initialize the moving ax value.
11359
 
11360
        DEFB    $C0             ;;st-mem-0      y, x, last-x.
11361
        DEFB    $0F             ;;addition      y, absolute x.
11362
        DEFB    $01             ;;exchange      tx, y.
11363
        DEFB    $38             ;;end-calc      tx, y.
11364
 
11365
        LD      A,($5C7E)       ; Fetch System Variable COORDS-y
11366
        CALL    L2D28           ; routine STACK-A
11367
 
11368
        RST     28H             ;; FP-CALC      tx, y, last-y.
11369
 
11370
;   Store the last point plotted to initialize the moving ay value.
11371
 
11372
        DEFB    $C5             ;;st-mem-5      tx, y, last-y.
11373
        DEFB    $0F             ;;addition      tx, ty.
11374
 
11375
;   Fetch the moving ax and ay to the calculator stack.
11376
 
11377
        DEFB    $E0             ;;get-mem-0     tx, ty, ax.
11378
        DEFB    $E5             ;;get-mem-5     tx, ty, ax, ay.
11379
        DEFB    $38             ;;end-calc      tx, ty, ax, ay.
11380
 
11381
        POP     BC              ; Restore the straight line count.
11382
 
11383
; -----------------------------------
11384
; THE 'CIRCLE/DRAW CONVERGENCE POINT'
11385
; -----------------------------------
11386
;   The CIRCLE and ARC-DRAW commands converge here.
11387
;
11388
;   Note. for both the CIRCLE and ARC commands the minimum initial line count
11389
;   is 4 (as set up by the CD_PARAMS routine) and so the zero flag will never
11390
;   be set and the loop is always entered.  The first test is superfluous and
11391
;   the jump will always be made to ARC-START.
11392
 
11393
;; DRW-STEPS
11394
L2420:  DEC     B               ; decrement the arc count (4,8,12,16...).
11395
 
11396
        JR      Z,L245F         ; forward, if zero (not possible), to ARC-END
11397
 
11398
        JR      L2439           ; forward to ARC-START
11399
 
11400
; --------------
11401
; THE 'ARC LOOP'
11402
; --------------
11403
;
11404
;   The arc drawing loop will draw up to 31 straight lines for a circle and up
11405
;   251 straight lines for an arc between two points. In both cases the final
11406
;   closing straight line is drawn at ARC_END, but it otherwise loops back to
11407
;   here to calculate the next coordinate using the ROTATION FORMULA where (a)
11408
;   is the previously calculated, constant CENTRAL ANGLE of the arcs.
11409
;
11410
;       Xrotated = x * cos(a) - y * sin(a)
11411
;       Yrotated = x * sin(a) + y * cos(a)
11412
;
11413
;   The values cos(a) and sin(a) are pre-calculated and held in mem-3 and mem-4
11414
;   for the duration of the routine.
11415
;   Memory location mem-1 holds the last relative x value (rx) and mem-2 holds
11416
;   the last relative y value (ry) used by DRAW.
11417
;
11418
;   Note. that this is a very clever twist on what is after all a very clever,
11419
;   well-used formula.  Normally the rotation formula is used with the x and y
11420
;   coordinates from the centre of the circle (or arc) and a supplied angle to
11421
;   produce two new x and y coordinates in an anticlockwise direction on the
11422
;   circumference of the circle.
11423
;   What is being used here, instead, is the relative X and Y parameters from
11424
;   the last point plotted that are required to get to the current point and
11425
;   the formula returns the next relative coordinates to use.
11426
 
11427
;; ARC-LOOP
11428
L2425:  RST     28H             ;; FP-CALC
11429
        DEFB    $E1             ;;get-mem-1     rx.
11430
        DEFB    $31             ;;duplicate     rx, rx.
11431
        DEFB    $E3             ;;get-mem-3     cos(a)
11432
        DEFB    $04             ;;multiply      rx, rx*cos(a).
11433
        DEFB    $E2             ;;get-mem-2     rx, rx*cos(a), ry.
11434
        DEFB    $E4             ;;get-mem-4     rx, rx*cos(a), ry, sin(a).
11435
        DEFB    $04             ;;multiply      rx, rx*cos(a), ry*sin(a).
11436
        DEFB    $03             ;;subtract      rx, rx*cos(a) - ry*sin(a)
11437
        DEFB    $C1             ;;st-mem-1      rx, new relative x rotated.
11438
        DEFB    $02             ;;delete        rx.
11439
 
11440
        DEFB    $E4             ;;get-mem-4     rx, sin(a).
11441
        DEFB    $04             ;;multiply      rx*sin(a)
11442
        DEFB    $E2             ;;get-mem-2     rx*sin(a), ry.
11443
        DEFB    $E3             ;;get-mem-3     rx*sin(a), ry, cos(a).
11444
        DEFB    $04             ;;multiply      rx*sin(a), ry*cos(a).
11445
        DEFB    $0F             ;;addition      rx*sin(a) + ry*cos(a).
11446
        DEFB    $C2             ;;st-mem-2      new relative y rotated.
11447
        DEFB    $02             ;;delete        .
11448
        DEFB    $38             ;;end-calc      .
11449
 
11450
;   Note. the calculator stack actually holds   tx, ty, ax, ay
11451
;   and the last absolute values of x and y
11452
;   are now brought into play.
11453
;
11454
;   Magically, the two new rotated coordinates rx and ry are all that we would
11455
;   require to draw a circle or arc - on paper!
11456
;   The Spectrum DRAW routine draws to the rounded x and y coordinate and so
11457
;   repetitions of values like 3.49 would mean that the fractional parts
11458
;   would be lost until eventually the draw coordinates might differ from the
11459
;   floating point values used above by several pixels.
11460
;   For this reason the accurate offsets calculated above are added to the
11461
;   accurate, absolute coordinates maintained in ax and ay and these new
11462
;   coordinates have the integer coordinates of the last plot position
11463
;   ( from System Variable COORDS ) subtracted from them to give the relative
11464
;   coordinates required by the DRAW routine.
11465
 
11466
;   The mid entry point.
11467
 
11468
;; ARC-START
11469
L2439:  PUSH    BC              ; Preserve the arc counter on the machine stack.
11470
 
11471
;   Store the absolute ay in temporary variable mem-0 for the moment.
11472
 
11473
        RST     28H             ;; FP-CALC      ax, ay.
11474
        DEFB    $C0             ;;st-mem-0      ax, ay.
11475
        DEFB    $02             ;;delete        ax.
11476
 
11477
;   Now add the fractional relative x coordinate to the fractional absolute
11478
;   x coordinate to obtain a new fractional x-coordinate.
11479
 
11480
        DEFB    $E1             ;;get-mem-1     ax, xr.
11481
        DEFB    $0F             ;;addition      ax+xr (= new ax).
11482
        DEFB    $31             ;;duplicate     ax, ax.
11483
        DEFB    $38             ;;end-calc      ax, ax.
11484
 
11485
        LD      A,($5C7D)       ; COORDS-x      last x    (integer ix 0-255)
11486
        CALL    L2D28           ; routine STACK-A
11487
 
11488
        RST     28H             ;; FP-CALC      ax, ax, ix.
11489
        DEFB    $03             ;;subtract      ax, ax-ix  = relative DRAW Dx.
11490
 
11491
;   Having calculated the x value for DRAW do the same for the y value.
11492
 
11493
        DEFB    $E0             ;;get-mem-0     ax, Dx, ay.
11494
        DEFB    $E2             ;;get-mem-2     ax, Dx, ay, ry.
11495
        DEFB    $0F             ;;addition      ax, Dx, ay+ry (= new ay).
11496
        DEFB    $C0             ;;st-mem-0      ax, Dx, ay.
11497
        DEFB    $01             ;;exchange      ax, ay, Dx,
11498
        DEFB    $E0             ;;get-mem-0     ax, ay, Dx, ay.
11499
        DEFB    $38             ;;end-calc      ax, ay, Dx, ay.
11500
 
11501
        LD      A,($5C7E)       ; COORDS-y      last y (integer iy 0-175)
11502
        CALL    L2D28           ; routine STACK-A
11503
 
11504
        RST     28H             ;; FP-CALC      ax, ay, Dx, ay, iy.
11505
        DEFB    $03             ;;subtract      ax, ay, Dx, ay-iy ( = Dy).
11506
        DEFB    $38             ;;end-calc      ax, ay, Dx, Dy.
11507
 
11508
        CALL    L24B7           ; Routine DRAW-LINE draws (Dx,Dy) relative to
11509
                                ; the last pixel plotted leaving absolute x
11510
                                ; and y on the calculator stack.
11511
                                ;               ax, ay.
11512
 
11513
        POP     BC              ; Restore the arc counter from the machine stack.
11514
 
11515
        DJNZ    L2425           ; Decrement and loop while > 0 to ARC-LOOP
11516
 
11517
; -------------
11518
; THE 'ARC END'
11519
; -------------
11520
 
11521
;   To recap the full calculator stack is       tx, ty, ax, ay.
11522
 
11523
;   Just as one would do if drawing the curve on paper, the final line would
11524
;   be drawn by joining the last point plotted to the initial start point
11525
;   in the case of a CIRCLE or to the calculated end point in the case of
11526
;   an ARC.
11527
;   The moving absolute values of x and y are no longer required and they
11528
;   can be deleted to expose the closing coordinates.
11529
 
11530
;; ARC-END
11531
L245F:  RST     28H             ;; FP-CALC      tx, ty, ax, ay.
11532
        DEFB    $02             ;;delete        tx, ty, ax.
11533
        DEFB    $02             ;;delete        tx, ty.
11534
        DEFB    $01             ;;exchange      ty, tx.
11535
        DEFB    $38             ;;end-calc      ty, tx.
11536
 
11537
;   First calculate the relative x coordinate to the end-point.
11538
 
11539
        LD      A,($5C7D)       ; COORDS-x
11540
        CALL    L2D28           ; routine STACK-A
11541
 
11542
        RST     28H             ;; FP-CALC      ty, tx, coords_x.
11543
        DEFB    $03             ;;subtract      ty, rx.
11544
 
11545
;   Next calculate the relative y coordinate to the end-point.
11546
 
11547
        DEFB    $01             ;;exchange      rx, ty.
11548
        DEFB    $38             ;;end-calc      rx, ty.
11549
 
11550
        LD      A,($5C7E)       ; COORDS-y
11551
        CALL    L2D28           ; routine STACK-A
11552
 
11553
        RST     28H             ;; FP-CALC      rx, ty, coords_y
11554
        DEFB    $03             ;;subtract      rx, ry.
11555
        DEFB    $38             ;;end-calc      rx, ry.
11556
 
11557
;   Finally draw the last straight line.
11558
 
11559
;; LINE-DRAW
11560
L2477:  CALL    L24B7           ; routine DRAW-LINE draws to the relative
11561
                                ; coordinates (rx, ry).
11562
 
11563
        JP      L0D4D           ; jump back and exit via TEMPS          >>>
11564
 
11565
 
11566
; --------------------------------------------
11567
; THE 'INITIAL CIRCLE/DRAW PARAMETERS' ROUTINE
11568
; --------------------------------------------
11569
;   Begin by calculating the number of chords which will be returned in B.
11570
;   A rule of thumb is employed that uses a value z which for a circle is the
11571
;   radius and for an arc is the diameter with, as it happens, a pinch more if
11572
;   the arc is on a slope.
11573
;
11574
;   NUMBER OF STRAIGHT LINES = ANGLE OF ROTATION * SQUARE ROOT ( Z ) / 2
11575
 
11576
;; CD-PRMS1
11577
L247D:  RST     28H             ;; FP-CALC      z.
11578
        DEFB    $31             ;;duplicate     z, z.
11579
        DEFB    $28             ;;sqr           z, sqr(z).
11580
        DEFB    $34             ;;stk-data      z, sqr(z), 2.
11581
        DEFB    $32             ;;Exponent: $82, Bytes: 1
11582
        DEFB    $00             ;;(+00,+00,+00)
11583
        DEFB    $01             ;;exchange      z, 2, sqr(z).
11584
        DEFB    $05             ;;division      z, 2/sqr(z).
11585
        DEFB    $E5             ;;get-mem-5     z, 2/sqr(z), ANGLE.
11586
        DEFB    $01             ;;exchange      z, ANGLE, 2/sqr (z)
11587
        DEFB    $05             ;;division      z, ANGLE*sqr(z)/2 (= No. of lines)
11588
        DEFB    $2A             ;;abs           (for arc only)
11589
        DEFB    $38             ;;end-calc      z, number of lines.
11590
 
11591
;    As an example for a circle of radius 87 the number of lines will be 29.
11592
 
11593
        CALL    L2DD5           ; routine FP-TO-A
11594
 
11595
;    The value is compressed into A register, no carry with valid circle.
11596
 
11597
        JR      C,L2495         ; forward, if over 256, to USE-252
11598
 
11599
;    now make a multiple of 4 e.g. 29 becomes 28
11600
 
11601
        AND     $FC             ; AND 252
11602
 
11603
;    Adding 4 could set carry for arc, for the circle example, 28 becomes 32.
11604
 
11605
        ADD     A,$04           ; adding 4 could set carry if result is 256.
11606
 
11607
        JR      NC,L2497        ; forward if less than 256 to DRAW-SAVE
11608
 
11609
;    For an arc, a limit of 252 is imposed.
11610
 
11611
;; USE-252
11612
L2495:  LD      A,$FC           ; Use a value of 252 (for arc).
11613
 
11614
 
11615
;   For both arcs and circles, constants derived from the central angle are
11616
;   stored in the 'mem' locations.  Some are not relevant for the circle.
11617
 
11618
;; DRAW-SAVE
11619
L2497:  PUSH    AF              ; Save the line count (A) on the machine stack.
11620
 
11621
        CALL    L2D28           ; Routine STACK-A stacks the modified count(A).
11622
 
11623
        RST     28H             ;; FP-CALC      z, A.
11624
        DEFB    $E5             ;;get-mem-5     z, A, ANGLE.
11625
        DEFB    $01             ;;exchange      z, ANGLE, A.
11626
        DEFB    $05             ;;division      z, ANGLE/A. (Angle/count = a)
11627
        DEFB    $31             ;;duplicate     z, a, a.
11628
 
11629
;  Note. that cos (a) could be formed here directly using 'cos' and stored in
11630
;  mem-3 but that would spoil a good story and be slightly slower, as also
11631
;  would using square roots to form cos (a) from sin (a).
11632
 
11633
        DEFB    $1F             ;;sin           z, a, sin(a)
11634
        DEFB    $C4             ;;st-mem-4      z, a, sin(a)
11635
        DEFB    $02             ;;delete        z, a.
11636
        DEFB    $31             ;;duplicate     z, a, a.
11637
        DEFB    $A2             ;;stk-half      z, a, a, 1/2.
11638
        DEFB    $04             ;;multiply      z, a, a/2.
11639
        DEFB    $1F             ;;sin           z, a, sin(a/2).
11640
 
11641
;   Note. after second sin, mem-0 and mem-1 become free.
11642
 
11643
        DEFB    $C1             ;;st-mem-1      z, a, sin(a/2).
11644
        DEFB    $01             ;;exchange      z, sin(a/2), a.
11645
        DEFB    $C0             ;;st-mem-0      z, sin(a/2), a.  (for arc only)
11646
 
11647
;   Now form cos(a) from sin(a/2) using the 'DOUBLE ANGLE FORMULA'.
11648
 
11649
        DEFB    $02             ;;delete        z, sin(a/2).
11650
        DEFB    $31             ;;duplicate     z, sin(a/2), sin(a/2).
11651
        DEFB    $04             ;;multiply      z, sin(a/2)*sin(a/2).
11652
        DEFB    $31             ;;duplicate     z, sin(a/2)*sin(a/2),
11653
                                ;;                           sin(a/2)*sin(a/2).
11654
        DEFB    $0F             ;;addition      z, 2*sin(a/2)*sin(a/2).
11655
        DEFB    $A1             ;;stk-one       z, 2*sin(a/2)*sin(a/2), 1.
11656
        DEFB    $03             ;;subtract      z, 2*sin(a/2)*sin(a/2)-1.
11657
 
11658
        DEFB    $1B             ;;negate        z, 1-2*sin(a/2)*sin(a/2).
11659
 
11660
        DEFB    $C3             ;;st-mem-3      z, cos(a).
11661
        DEFB    $02             ;;delete        z.
11662
        DEFB    $38             ;;end-calc      z.
11663
 
11664
;   The radius/diameter is left on the calculator stack.
11665
 
11666
        POP     BC              ; Restore the line count to the B register.
11667
 
11668
        RET                     ; Return.
11669
 
11670
; --------------------------
11671
; THE 'DOUBLE ANGLE FORMULA'
11672
; --------------------------
11673
;   This formula forms cos(a) from sin(a/2) using simple arithmetic.
11674
;
11675
;   THE GEOMETRIC PROOF OF FORMULA   cos (a) = 1 - 2 * sin(a/2) * sin(a/2)
11676
;
11677
;
11678
;                                            A
11679
;
11680
;                                         . /|\
11681
;                                     .    / | \
11682
;                                  .      /  |  \
11683
;                               .        /   |a/2\
11684
;                            .          /    |    \
11685
;                         .          1 /     |     \
11686
;                      .              /      |      \
11687
;                   .                /       |       \
11688
;                .                  /        |        \
11689
;             .  a/2             D / a      E|-+       \
11690
;          B ---------------------/----------+-+--------\ C
11691
;            <-         1       -><-       1           ->
11692
;
11693
;   cos a = 1 - 2 * sin(a/2) * sin(a/2)
11694
;
11695
;   The figure shows a right triangle that inscribes a circle of radius 1 with
11696
;   centre, or origin, D.  Line BC is the diameter of length 2 and A is a point
11697
;   on the circle. The periphery angle BAC is therefore a right angle by the
11698
;   Rule of Thales.
11699
;   Line AC is a chord touching two points on the circle and the angle at the
11700
;   centre is (a).
11701
;   Since the vertex of the largest triangle B touches the circle, the
11702
;   inscribed angle (a/2) is half the central angle (a).
11703
;   The cosine of (a) is the length DE as the hypotenuse is of length 1.
11704
;   This can also be expressed as 1-length CE.  Examining the triangle at the
11705
;   right, the top angle is also (a/2) as angle BAE and EBA add to give a right
11706
;   angle as do BAE and EAC.
11707
;   So cos (a) = 1 - AC * sin(a/2)
11708
;   Looking at the largest triangle, side AC can be expressed as
11709
;   AC = 2 * sin(a/2)   and so combining these we get
11710
;   cos (a) = 1 - 2 * sin(a/2) * sin(a/2).
11711
;
11712
;   "I will be sufficiently rewarded if when telling it to others, you will
11713
;    not claim the discovery as your own, but will say it is mine."
11714
;   - Thales, 640 - 546 B.C.
11715
;
11716
; --------------------------
11717
; THE 'LINE DRAWING' ROUTINE
11718
; --------------------------
11719
;
11720
;
11721
 
11722
;; DRAW-LINE
11723
L24B7:  CALL    L2307           ; routine STK-TO-BC
11724
        LD      A,C             ;
11725
        CP      B               ;
11726
        JR      NC,L24C4        ; to DL-X-GE-Y
11727
 
11728
        LD      L,C             ;
11729
        PUSH    DE              ;
11730
        XOR     A               ;
11731
        LD      E,A             ;
11732
        JR      L24CB           ; to DL-LARGER
11733
 
11734
; ---
11735
 
11736
;; DL-X-GE-Y
11737
L24C4:  OR      C               ;
11738
        RET     Z               ;
11739
 
11740
        LD      L,B             ;
11741
        LD      B,C             ;
11742
        PUSH    DE              ;
11743
        LD      D,$00           ;
11744
 
11745
;; DL-LARGER
11746
L24CB:  LD      H,B             ;
11747
        LD      A,B             ;
11748
        RRA                     ;
11749
 
11750
;; D-L-LOOP
11751
L24CE:  ADD     A,L             ;
11752
        JR      C,L24D4         ; to D-L-DIAG
11753
 
11754
        CP      H               ;
11755
        JR      C,L24DB         ; to D-L-HR-VT
11756
 
11757
;; D-L-DIAG
11758
L24D4:  SUB     H               ;
11759
        LD      C,A             ;
11760
        EXX                     ;
11761
        POP     BC              ;
11762
        PUSH    BC              ;
11763
        JR      L24DF           ; to D-L-STEP
11764
 
11765
; ---
11766
 
11767
;; D-L-HR-VT
11768
L24DB:  LD      C,A             ;
11769
        PUSH    DE              ;
11770
        EXX                     ;
11771
        POP     BC              ;
11772
 
11773
;; D-L-STEP
11774
L24DF:  LD      HL,($5C7D)      ; COORDS
11775
        LD      A,B             ;
11776
        ADD     A,H             ;
11777
        LD      B,A             ;
11778
        LD      A,C             ;
11779
        INC     A               ;
11780
        ADD     A,L             ;
11781
        JR      C,L24F7         ; to D-L-RANGE
11782
 
11783
        JR      Z,L24F9         ; to REPORT-Bc
11784
 
11785
;; D-L-PLOT
11786
L24EC:  DEC     A               ;
11787
        LD      C,A             ;
11788
        CALL    L22E5           ; routine PLOT-SUB
11789
        EXX                     ;
11790
        LD      A,C             ;
11791
        DJNZ    L24CE           ; to D-L-LOOP
11792
 
11793
        POP     DE              ;
11794
        RET                     ;
11795
 
11796
; ---
11797
 
11798
;; D-L-RANGE
11799
L24F7:  JR      Z,L24EC         ; to D-L-PLOT
11800
 
11801
 
11802
;; REPORT-Bc
11803
L24F9:  RST     08H             ; ERROR-1
11804
        DEFB    $0A             ; Error Report: Integer out of range
11805
 
11806
 
11807
 
11808
;***********************************
11809
;** Part 8. EXPRESSION EVALUATION **
11810
;***********************************
11811
;
11812
; It is a this stage of the ROM that the Spectrum ceases altogether to be
11813
; just a colourful novelty. One remarkable feature is that in all previous
11814
; commands when the Spectrum is expecting a number or a string then an
11815
; expression of the same type can be substituted ad infinitum.
11816
; This is the routine that evaluates that expression.
11817
; This is what causes 2 + 2 to give the answer 4.
11818
; That is quite easy to understand. However you don't have to make it much
11819
; more complex to start a remarkable juggling act.
11820
; e.g. PRINT 2 * (VAL "2+2" + TAN 3)
11821
; In fact, provided there is enough free RAM, the Spectrum can evaluate
11822
; an expression of unlimited complexity.
11823
; Apart from a couple of minor glitches, which you can now correct, the
11824
; system is remarkably robust.
11825
 
11826
 
11827
; ---------------------------------
11828
; Scan expression or sub-expression
11829
; ---------------------------------
11830
;
11831
;
11832
 
11833
;; SCANNING
11834
L24FB:  RST     18H             ; GET-CHAR
11835
        LD      B,$00           ; priority marker zero is pushed on stack
11836
                                ; to signify end of expression when it is
11837
                                ; popped off again.
11838
        PUSH    BC              ; put in on stack.
11839
                                ; and proceed to consider the first character
11840
                                ; of the expression.
11841
 
11842
;; S-LOOP-1
11843
L24FF:  LD      C,A             ; store the character while a look up is done.
11844
        LD      HL,L2596        ; Address: scan-func
11845
        CALL    L16DC           ; routine INDEXER is called to see if it is
11846
                                ; part of a limited range '+', '(', 'ATTR' etc.
11847
 
11848
        LD      A,C             ; fetch the character back
11849
        JP      NC,L2684        ; jump forward to S-ALPHNUM if not in primary
11850
                                ; operators and functions to consider in the
11851
                                ; first instance a digit or a variable and
11852
                                ; then anything else.                >>>
11853
 
11854
        LD      B,$00           ; but here if it was found in table so
11855
        LD      C,(HL)          ; fetch offset from table and make B zero.
11856
        ADD     HL,BC           ; add the offset to position found
11857
        JP      (HL)            ; and jump to the routine e.g. S-BIN
11858
                                ; making an indirect exit from there.
11859
 
11860
; -------------------------------------------------------------------------
11861
; The four service subroutines for routines in the scanning function table
11862
; -------------------------------------------------------------------------
11863
 
11864
; PRINT """Hooray!"" he cried."
11865
 
11866
;; S-QUOTE-S
11867
L250F:  CALL    L0074           ; routine CH-ADD+1 points to next character
11868
                                ; and fetches that character.
11869
        INC     BC              ; increase length counter.
11870
        CP      $0D             ; is it carriage return ?
11871
                                ; inside a quote.
11872
        JP      Z,L1C8A         ; jump back to REPORT-C if so.
11873
                                ; 'Nonsense in BASIC'.
11874
 
11875
        CP      $22             ; is it a quote '"' ?
11876
        JR      NZ,L250F        ; back to S-QUOTE-S if not for more.
11877
 
11878
        CALL    L0074           ; routine CH-ADD+1
11879
        CP      $22             ; compare with possible adjacent quote
11880
        RET                     ; return. with zero set if two together.
11881
 
11882
; ---
11883
 
11884
; This subroutine is used to get two coordinate expressions for the three
11885
; functions SCREEN$, ATTR and POINT that have two fixed parameters and
11886
; therefore require surrounding braces.
11887
 
11888
;; S-2-COORD
11889
L2522:  RST     20H             ; NEXT-CHAR
11890
        CP      $28             ; is it the opening '(' ?
11891
        JR      NZ,L252D        ; forward to S-RPORT-C if not
11892
                                ; 'Nonsense in BASIC'.
11893
 
11894
        CALL    L1C79           ; routine NEXT-2NUM gets two comma-separated
11895
                                ; numeric expressions. Note. this could cause
11896
                                ; many more recursive calls to SCANNING but
11897
                                ; the parent function will be evaluated fully
11898
                                ; before rejoining the main juggling act.
11899
 
11900
        RST     18H             ; GET-CHAR
11901
        CP      $29             ; is it the closing ')' ?
11902
 
11903
;; S-RPORT-C
11904
L252D:  JP      NZ,L1C8A        ; jump back to REPORT-C if not.
11905
                                ; 'Nonsense in BASIC'.
11906
 
11907
; ------------
11908
; Check syntax
11909
; ------------
11910
; This routine is called on a number of occasions to check if syntax is being
11911
; checked or if the program is being run. To test the flag inline would use
11912
; four bytes of code, but a call instruction only uses 3 bytes of code.
11913
 
11914
;; SYNTAX-Z
11915
L2530:  BIT     7,(IY+$01)      ; test FLAGS  - checking syntax only ?
11916
        RET                     ; return.
11917
 
11918
; ----------------
11919
; Scanning SCREEN$
11920
; ----------------
11921
; This function returns the code of a bit-mapped character at screen
11922
; position at line C, column B. It is unable to detect the mosaic characters
11923
; which are not bit-mapped but detects the ASCII 32 - 127 range.
11924
; The bit-mapped UDGs are ignored which is curious as it requires only a
11925
; few extra bytes of code. As usual, anything to do with CHARS is weird.
11926
; If no match is found a null string is returned.
11927
; No actual check on ranges is performed - that's up to the BASIC programmer.
11928
; No real harm can come from SCREEN$(255,255) although the BASIC manual
11929
; says that invalid values will be trapped.
11930
; Interestingly, in the Pitman pocket guide, 1984, Vickers says that the
11931
; range checking will be performed.
11932
 
11933
;; S-SCRN$-S
11934
L2535:  CALL    L2307           ; routine STK-TO-BC.
11935
        LD      HL,($5C36)      ; fetch address of CHARS.
11936
        LD      DE,$0100        ; fetch offset to chr$ 32
11937
        ADD     HL,DE           ; and find start of bitmaps.
11938
                                ; Note. not inc h. ??
11939
        LD      A,C             ; transfer line to A.
11940
        RRCA                    ; multiply
11941
        RRCA                    ; by
11942
        RRCA                    ; thirty-two.
11943
        AND     $E0             ; and with 11100000
11944
        XOR     B               ; combine with column $00 - $1F
11945
        LD      E,A             ; to give the low byte of top line
11946
        LD      A,C             ; column to A range 00000000 to 00011111
11947
        AND     $18             ; and with 00011000
11948
        XOR     $40             ; xor with 01000000 (high byte screen start)
11949
        LD      D,A             ; register DE now holds start address of cell.
11950
        LD      B,$60           ; there are 96 characters in ASCII set.
11951
 
11952
;; S-SCRN-LP
11953
L254F:  PUSH    BC              ; save count
11954
        PUSH    DE              ; save screen start address
11955
        PUSH    HL              ; save bitmap start
11956
        LD      A,(DE)          ; first byte of screen to A
11957
        XOR     (HL)            ; xor with corresponding character byte
11958
        JR      Z,L255A         ; forward to S-SC-MTCH if they match
11959
                                ; if inverse result would be $FF
11960
                                ; if any other then mismatch
11961
 
11962
        INC     A               ; set to $00 if inverse
11963
        JR      NZ,L2573        ; forward to S-SCR-NXT if a mismatch
11964
 
11965
        DEC     A               ; restore $FF
11966
 
11967
; a match has been found so seven more to test.
11968
 
11969
;; S-SC-MTCH
11970
L255A:  LD      C,A             ; load C with inverse mask $00 or $FF
11971
        LD      B,$07           ; count seven more bytes
11972
 
11973
;; S-SC-ROWS
11974
L255D:  INC     D               ; increment screen address.
11975
        INC     HL              ; increment bitmap address.
11976
        LD      A,(DE)          ; byte to A
11977
        XOR     (HL)            ; will give $00 or $FF (inverse)
11978
        XOR     C               ; xor with inverse mask
11979
        JR      NZ,L2573        ; forward to S-SCR-NXT if no match.
11980
 
11981
        DJNZ    L255D           ; back to S-SC-ROWS until all eight matched.
11982
 
11983
; continue if a match of all eight bytes was found
11984
 
11985
        POP     BC              ; discard the
11986
        POP     BC              ; saved
11987
        POP     BC              ; pointers
11988
        LD      A,$80           ; the endpoint of character set
11989
        SUB     B               ; subtract the counter
11990
                                ; to give the code 32-127
11991
        LD      BC,$0001        ; make one space in workspace.
11992
 
11993
        RST     30H             ; BC-SPACES creates the space sliding
11994
                                ; the calculator stack upwards.
11995
        LD      (DE),A          ; start is addressed by DE, so insert code
11996
        JR      L257D           ; forward to S-SCR-STO
11997
 
11998
; ---
11999
 
12000
; the jump was here if no match and more bitmaps to test.
12001
 
12002
;; S-SCR-NXT
12003
L2573:  POP     HL              ; restore the last bitmap start
12004
        LD      DE,$0008        ; and prepare to add 8.
12005
        ADD     HL,DE           ; now addresses next character bitmap.
12006
        POP     DE              ; restore screen address
12007
        POP     BC              ; and character counter in B
12008
        DJNZ    L254F           ; back to S-SCRN-LP if more characters.
12009
 
12010
        LD      C,B             ; B is now zero, so BC now zero.
12011
 
12012
;; S-SCR-STO
12013
L257D:  JP      L2AB2           ; to STK-STO-$ to store the string in
12014
                                ; workspace or a string with zero length.
12015
                                ; (value of DE doesn't matter in last case)
12016
 
12017
; Note. this exit seems correct but the general-purpose routine S-STRING
12018
; that calls this one will also stack any of its string results so this
12019
; leads to a double storing of the result in this case.
12020
; The instruction at L257D should just be a RET.
12021
; credit Stephen Kelly and others, 1982.
12022
 
12023
; -------------
12024
; Scanning ATTR
12025
; -------------
12026
; This function subroutine returns the attributes of a screen location -
12027
; a numeric result.
12028
; Again it's up to the BASIC programmer to supply valid values of line/column.
12029
 
12030
;; S-ATTR-S
12031
L2580:  CALL    L2307           ; routine STK-TO-BC fetches line to C,
12032
                                ; and column to B.
12033
        LD      A,C             ; line to A $00 - $17   (max 00010111)
12034
        RRCA                    ; rotate
12035
        RRCA                    ; bits
12036
        RRCA                    ; left.
12037
        LD      C,A             ; store in C as an intermediate value.
12038
 
12039
        AND     $E0             ; pick up bits 11100000 ( was 00011100 )
12040
        XOR     B               ; combine with column $00 - $1F
12041
        LD      L,A             ; low byte now correct.
12042
 
12043
        LD      A,C             ; bring back intermediate result from C
12044
        AND     $03             ; mask to give correct third of
12045
                                ; screen $00 - $02
12046
        XOR     $58             ; combine with base address.
12047
        LD      H,A             ; high byte correct.
12048
        LD      A,(HL)          ; pick up the colour attribute.
12049
        JP      L2D28           ; forward to STACK-A to store result
12050
                                ; and make an indirect exit.
12051
 
12052
; -----------------------
12053
; Scanning function table
12054
; -----------------------
12055
; This table is used by INDEXER routine to find the offsets to
12056
; four operators and eight functions. e.g. $A8 is the token 'FN'.
12057
; This table is used in the first instance for the first character of an
12058
; expression or by a recursive call to SCANNING for the first character of
12059
; any sub-expression. It eliminates functions that have no argument or
12060
; functions that can have more than one argument and therefore require
12061
; braces. By eliminating and dealing with these now it can later take a
12062
; simplistic approach to all other functions and assume that they have
12063
; one argument.
12064
; Similarly by eliminating BIN and '.' now it is later able to assume that
12065
; all numbers begin with a digit and that the presence of a number or
12066
; variable can be detected by a call to ALPHANUM.
12067
; By default all expressions are positive and the spurious '+' is eliminated
12068
; now as in print +2. This should not be confused with the operator '+'.
12069
; Note. this does allow a degree of nonsense to be accepted as in
12070
; PRINT +"3 is the greatest.".
12071
; An acquired programming skill is the ability to include brackets where
12072
; they are not necessary.
12073
; A bracket at the start of a sub-expression may be spurious or necessary
12074
; to denote that the contained expression is to be evaluated as an entity.
12075
; In either case this is dealt with by recursive calls to SCANNING.
12076
; An expression that begins with a quote requires special treatment.
12077
 
12078
;; scan-func
12079
L2596:  DEFB    $22, L25B3-$-1  ; $1C offset to S-QUOTE
12080
        DEFB    '(', L25E8-$-1  ; $4F offset to S-BRACKET
12081
        DEFB    '.', L268D-$-1  ; $F2 offset to S-DECIMAL
12082
        DEFB    '+', L25AF-$-1  ; $12 offset to S-U-PLUS
12083
 
12084
        DEFB    $A8, L25F5-$-1  ; $56 offset to S-FN
12085
        DEFB    $A5, L25F8-$-1  ; $57 offset to S-RND
12086
        DEFB    $A7, L2627-$-1  ; $84 offset to S-PI
12087
        DEFB    $A6, L2634-$-1  ; $8F offset to S-INKEY$
12088
        DEFB    $C4, L268D-$-1  ; $E6 offset to S-BIN
12089
        DEFB    $AA, L2668-$-1  ; $BF offset to S-SCREEN$
12090
        DEFB    $AB, L2672-$-1  ; $C7 offset to S-ATTR
12091
        DEFB    $A9, L267B-$-1  ; $CE offset to S-POINT
12092
 
12093
        DEFB    $00             ; zero end marker
12094
 
12095
; --------------------------
12096
; Scanning function routines
12097
; --------------------------
12098
; These are the 11 subroutines accessed by the above table.
12099
; S-BIN and S-DECIMAL are the same
12100
; The 1-byte offset limits their location to within 255 bytes of their
12101
; entry in the table.
12102
 
12103
; ->
12104
;; S-U-PLUS
12105
L25AF:  RST     20H             ; NEXT-CHAR just ignore
12106
        JP      L24FF           ; to S-LOOP-1
12107
 
12108
; ---
12109
 
12110
; ->
12111
;; S-QUOTE
12112
L25B3:  RST     18H             ; GET-CHAR
12113
        INC     HL              ; address next character (first in quotes)
12114
        PUSH    HL              ; save start of quoted text.
12115
        LD      BC,$0000        ; initialize length of string to zero.
12116
        CALL    L250F           ; routine S-QUOTE-S
12117
        JR      NZ,L25D9        ; forward to S-Q-PRMS if
12118
 
12119
;; S-Q-AGAIN
12120
L25BE:  CALL    L250F           ; routine S-QUOTE-S copies string until a
12121
                                ; quote is encountered
12122
        JR      Z,L25BE         ; back to S-Q-AGAIN if two quotes WERE
12123
                                ; together.
12124
 
12125
; but if just an isolated quote then that terminates the string.
12126
 
12127
        CALL    L2530           ; routine SYNTAX-Z
12128
        JR      Z,L25D9         ; forward to S-Q-PRMS if checking syntax.
12129
 
12130
 
12131
        RST     30H             ; BC-SPACES creates the space for true
12132
                                ; copy of string in workspace.
12133
        POP     HL              ; re-fetch start of quoted text.
12134
        PUSH    DE              ; save start in workspace.
12135
 
12136
;; S-Q-COPY
12137
L25CB:  LD      A,(HL)          ; fetch a character from source.
12138
        INC     HL              ; advance source address.
12139
        LD      (DE),A          ; place in destination.
12140
        INC     DE              ; advance destination address.
12141
        CP      $22             ; was it a '"' just copied ?
12142
        JR      NZ,L25CB        ; back to S-Q-COPY to copy more if not
12143
 
12144
        LD      A,(HL)          ; fetch adjacent character from source.
12145
        INC     HL              ; advance source address.
12146
        CP      $22             ; is this '"' ? - i.e. two quotes together ?
12147
        JR      Z,L25CB         ; to S-Q-COPY if so including just one of the
12148
                                ; pair of quotes.
12149
 
12150
; proceed when terminating quote encountered.
12151
 
12152
;; S-Q-PRMS
12153
L25D9:  DEC     BC              ; decrease count by 1.
12154
        POP     DE              ; restore start of string in workspace.
12155
 
12156
;; S-STRING
12157
L25DB:  LD      HL,$5C3B        ; Address FLAGS system variable.
12158
        RES     6,(HL)          ; signal string result.
12159
        BIT     7,(HL)          ; is syntax being checked.
12160
        CALL    NZ,L2AB2        ; routine STK-STO-$ is called in runtime.
12161
        JP      L2712           ; jump forward to S-CONT-2          ===>
12162
 
12163
; ---
12164
 
12165
; ->
12166
;; S-BRACKET
12167
L25E8:  RST     20H             ; NEXT-CHAR
12168
        CALL    L24FB           ; routine SCANNING is called recursively.
12169
        CP      $29             ; is it the closing ')' ?
12170
        JP      NZ,L1C8A        ; jump back to REPORT-C if not
12171
                                ; 'Nonsense in BASIC'
12172
 
12173
        RST     20H             ; NEXT-CHAR
12174
        JP      L2712           ; jump forward to S-CONT-2          ===>
12175
 
12176
; ---
12177
 
12178
; ->
12179
;; S-FN
12180
L25F5:  JP      L27BD           ; jump forward to S-FN-SBRN.
12181
 
12182
; --------------------------------------------------------------------
12183
;
12184
;   RANDOM THEORY from the ZX81 manual by Steven Vickers
12185
;
12186
;   (same algorithm as the ZX Spectrum).
12187
;
12188
;   Chapter 5. Exercise 6. (For mathematicians only.)
12189
;
12190
;   Let p be a [large] prime, & let a be a primitive root modulo p.
12191
;   Then if b_i is the residue of a^i modulo p (1<=b_i
12192
;   sequence
12193
;
12194
;                           (b_i-1)/(p-1)
12195
;
12196
;   is a cyclical sequence of p-1 distinct numbers in the range 0 to 1
12197
;   (excluding 1). By choosing a suitably, these can be made to look
12198
;   fairly random.
12199
;
12200
;     65537 is a Mersenne prime 2^16-1. Note.
12201
;
12202
;   Use this, & Gauss' law of quadratic reciprocity, to show that 75
12203
;   is a primitive root modulo 65537.
12204
;
12205
;     The ZX81 uses p=65537 & a=75, & stores some b_i-1 in memory.
12206
;   The function RND involves replacing b_i-1 in memory by b_(i+1)-1,
12207
;   & yielding the result (b_(i+1)-1)/(p-1). RAND n (with 1<=n<=65535)
12208
;   makes b_i equal to n+1.
12209
;
12210
; --------------------------------------------------------------------
12211
;
12212
; Steven Vickers writing in comp.sys.sinclair on 20-DEC-1993
12213
;
12214
;   Note. (Of course, 65537 is 2^16 + 1, not -1.)
12215
;
12216
;   Consider arithmetic modulo a prime p. There are p residue classes, and the
12217
;   non-zero ones are all invertible. Hence under multiplication they form a
12218
;   group (Fp*, say) of order p-1; moreover (and not so obvious) Fp* is cyclic.
12219
;   Its generators are the "primitive roots". The "quadratic residues modulo p"
12220
;   are the squares in Fp*, and the "Legendre symbol" (d/p) is defined (when p
12221
;   does not divide d) as +1 or -1, according as d is or is not a quadratic
12222
;   residue mod p.
12223
;
12224
;   In the case when p = 65537, we can show that d is a primitive root if and
12225
;   only if it's not a quadratic residue. For let w be a primitive root, d
12226
;   congruent to w^r (mod p). If d is not primitive, then its order is a proper
12227
;   factor of 65536: hence w^{32768*r} = 1 (mod p), so 65536 divides 32768*r,
12228
;   and hence r is even and d is a square (mod p). Conversely, the squares in
12229
;   Fp* form a subgroup of (Fp*)^2 of index 2, and so cannot be generators.
12230
;
12231
;   Hence to check whether 75 is primitive mod 65537, we want to calculate that
12232
;   (75/65537) = -1. There is a multiplicative formula (ab/p) = (a/p)(b/p) (mod
12233
;   p), so (75/65537) = (5/65537)^2 * (3/65537) = (3/65537). Now the law of
12234
;   quadratic reciprocity says that if p and q are distinct odd primes, then
12235
;
12236
;    (p/q)(q/p) = (-1)^{(p-1)(q-1)/4}
12237
;
12238
;   Hence (3/65537) = (65537/3) * (-1)^{65536*2/4} = (65537/3)
12239
;            = (2/3)  (because 65537 = 2 mod 3)
12240
;            = -1
12241
;
12242
;   (I referred to Pierre Samuel's "Algebraic Theory of Numbers".)
12243
;
12244
; ->
12245
 
12246
;; S-RND
12247
L25F8:  CALL    L2530           ; routine SYNTAX-Z
12248
        JR      Z,L2625         ; forward to S-RND-END if checking syntax.
12249
 
12250
        LD      BC,($5C76)      ; fetch system variable SEED
12251
        CALL    L2D2B           ; routine STACK-BC places on calculator stack
12252
 
12253
        RST     28H             ;; FP-CALC           ;s.
12254
        DEFB    $A1             ;;stk-one            ;s,1.
12255
        DEFB    $0F             ;;addition           ;s+1.
12256
        DEFB    $34             ;;stk-data           ;
12257
        DEFB    $37             ;;Exponent: $87,
12258
                                ;;Bytes: 1
12259
        DEFB    $16             ;;(+00,+00,+00)      ;s+1,75.
12260
        DEFB    $04             ;;multiply           ;(s+1)*75 = v
12261
        DEFB    $34             ;;stk-data           ;v.
12262
        DEFB    $80             ;;Bytes: 3
12263
        DEFB    $41             ;;Exponent $91
12264
        DEFB    $00,$00,$80     ;;(+00)              ;v,65537.
12265
        DEFB    $32             ;;n-mod-m            ;remainder, result.
12266
        DEFB    $02             ;;delete             ;remainder.
12267
        DEFB    $A1             ;;stk-one            ;remainder, 1.
12268
        DEFB    $03             ;;subtract           ;remainder - 1. = rnd
12269
        DEFB    $31             ;;duplicate          ;rnd,rnd.
12270
        DEFB    $38             ;;end-calc
12271
 
12272
        CALL    L2DA2           ; routine FP-TO-BC
12273
        LD      ($5C76),BC      ; store in SEED for next starting point.
12274
        LD      A,(HL)          ; fetch exponent
12275
        AND     A               ; is it zero ?
12276
        JR      Z,L2625         ; forward if so to S-RND-END
12277
 
12278
        SUB     $10             ; reduce exponent by 2^16
12279
        LD      (HL),A          ; place back
12280
 
12281
;; S-RND-END
12282
L2625:  JR      L2630           ; forward to S-PI-END
12283
 
12284
; ---
12285
 
12286
; the number PI 3.14159...
12287
 
12288
; ->
12289
;; S-PI
12290
L2627:  CALL    L2530           ; routine SYNTAX-Z
12291
        JR      Z,L2630         ; to S-PI-END if checking syntax.
12292
 
12293
        RST     28H             ;; FP-CALC
12294
        DEFB    $A3             ;;stk-pi/2                          pi/2.
12295
        DEFB    $38             ;;end-calc
12296
 
12297
        INC     (HL)            ; increment the exponent leaving pi
12298
                                ; on the calculator stack.
12299
 
12300
;; S-PI-END
12301
L2630:  RST     20H             ; NEXT-CHAR
12302
        JP      L26C3           ; jump forward to S-NUMERIC
12303
 
12304
; ---
12305
 
12306
; ->
12307
;; S-INKEY$
12308
L2634:  LD      BC,$105A        ; priority $10, operation code $1A ('read-in')
12309
                                ; +$40 for string result, numeric operand.
12310
                                ; set this up now in case we need to use the
12311
                                ; calculator.
12312
        RST     20H             ; NEXT-CHAR
12313
        CP      $23             ; '#' ?
12314
        JP      Z,L270D         ; to S-PUSH-PO if so to use the calculator
12315
                                ; single operation
12316
                                ; to read from network/RS232 etc. .
12317
 
12318
; else read a key from the keyboard.
12319
 
12320
        LD      HL,$5C3B        ; fetch FLAGS
12321
        RES     6,(HL)          ; signal string result.
12322
        BIT     7,(HL)          ; checking syntax ?
12323
        JR      Z,L2665         ; forward to S-INK$-EN if so
12324
 
12325
        CALL    L028E           ; routine KEY-SCAN key in E, shift in D.
12326
        LD      C,$00           ; the length of an empty string
12327
        JR      NZ,L2660        ; to S-IK$-STK to store empty string if
12328
                                ; no key returned.
12329
 
12330
        CALL    L031E           ; routine K-TEST get main code in A
12331
        JR      NC,L2660        ; to S-IK$-STK to stack null string if
12332
                                ; invalid
12333
 
12334
        DEC     D               ; D is expected to be FLAGS so set bit 3 $FF
12335
                                ; 'L' Mode so no keywords.
12336
        LD      E,A             ; main key to A
12337
                                ; C is MODE 0 'KLC' from above still.
12338
        CALL    L0333           ; routine K-DECODE
12339
        PUSH    AF              ; save the code
12340
        LD      BC,$0001        ; make room for one character
12341
 
12342
        RST     30H             ; BC-SPACES
12343
        POP     AF              ; bring the code back
12344
        LD      (DE),A          ; put the key in workspace
12345
        LD      C,$01           ; set C length to one
12346
 
12347
;; S-IK$-STK
12348
L2660:  LD      B,$00           ; set high byte of length to zero
12349
        CALL    L2AB2           ; routine STK-STO-$
12350
 
12351
;; S-INK$-EN
12352
L2665:  JP      L2712           ; to S-CONT-2            ===>
12353
 
12354
; ---
12355
 
12356
; ->
12357
;; S-SCREEN$
12358
L2668:  CALL    L2522           ; routine S-2-COORD
12359
        CALL    NZ,L2535        ; routine S-SCRN$-S
12360
 
12361
        RST     20H             ; NEXT-CHAR
12362
        JP      L25DB           ; forward to S-STRING to stack result
12363
 
12364
; ---
12365
 
12366
; ->
12367
;; S-ATTR
12368
L2672:  CALL    L2522           ; routine S-2-COORD
12369
        CALL    NZ,L2580        ; routine S-ATTR-S
12370
 
12371
        RST     20H             ; NEXT-CHAR
12372
        JR      L26C3           ; forward to S-NUMERIC
12373
 
12374
; ---
12375
 
12376
; ->
12377
;; S-POINT
12378
L267B:  CALL    L2522           ; routine S-2-COORD
12379
        CALL    NZ,L22CB        ; routine POINT-SUB
12380
 
12381
        RST     20H             ; NEXT-CHAR
12382
        JR      L26C3           ; forward to S-NUMERIC
12383
 
12384
; -----------------------------
12385
 
12386
; ==> The branch was here if not in table.
12387
 
12388
;; S-ALPHNUM
12389
L2684:  CALL    L2C88           ; routine ALPHANUM checks if variable or
12390
                                ; a digit.
12391
        JR      NC,L26DF        ; forward to S-NEGATE if not to consider
12392
                                ; a '-' character then functions.
12393
 
12394
        CP      $41             ; compare 'A'
12395
        JR      NC,L26C9        ; forward to S-LETTER if alpha       ->
12396
                                ; else must have been numeric so continue
12397
                                ; into that routine.
12398
 
12399
; This important routine is called during runtime and from LINE-SCAN
12400
; when a BASIC line is checked for syntax. It is this routine that
12401
; inserts, during syntax checking, the invisible floating point numbers
12402
; after the numeric expression. During runtime it just picks these
12403
; numbers up. It also handles BIN format numbers.
12404
 
12405
; ->
12406
;; S-BIN
12407
;; S-DECIMAL
12408
L268D:  CALL    L2530           ; routine SYNTAX-Z
12409
        JR      NZ,L26B5        ; to S-STK-DEC in runtime
12410
 
12411
; this route is taken when checking syntax.
12412
 
12413
        CALL    L2C9B           ; routine DEC-TO-FP to evaluate number
12414
 
12415
        RST     18H             ; GET-CHAR to fetch HL
12416
        LD      BC,$0006        ; six locations required
12417
        CALL    L1655           ; routine MAKE-ROOM
12418
        INC     HL              ; to first new location
12419
        LD      (HL),$0E        ; insert number marker
12420
        INC     HL              ; address next
12421
        EX      DE,HL           ; make DE destination.
12422
        LD      HL,($5C65)      ; STKEND points to end of stack.
12423
        LD      C,$05           ; result is five locations lower
12424
        AND     A               ; prepare for true subtraction
12425
        SBC     HL,BC           ; point to start of value.
12426
        LD      ($5C65),HL      ; update STKEND as we are taking number.
12427
        LDIR                    ; Copy five bytes to program location
12428
        EX      DE,HL           ; transfer pointer to HL
12429
        DEC     HL              ; adjust
12430
        CALL    L0077           ; routine TEMP-PTR1 sets CH-ADD
12431
        JR      L26C3           ; to S-NUMERIC to record nature of result
12432
 
12433
; ---
12434
 
12435
; branch here in runtime.
12436
 
12437
;; S-STK-DEC
12438
L26B5:  RST     18H             ; GET-CHAR positions HL at digit.
12439
 
12440
;; S-SD-SKIP
12441
L26B6:  INC     HL              ; advance pointer
12442
        LD      A,(HL)          ; until we find
12443
        CP      $0E             ; chr 14d - the number indicator
12444
        JR      NZ,L26B6        ; to S-SD-SKIP until a match
12445
                                ; it has to be here.
12446
 
12447
        INC     HL              ; point to first byte of number
12448
        CALL    L33B4           ; routine STACK-NUM stacks it
12449
        LD      ($5C5D),HL      ; update system variable CH_ADD
12450
 
12451
;; S-NUMERIC
12452
L26C3:  SET     6,(IY+$01)      ; update FLAGS  - Signal numeric result
12453
        JR      L26DD           ; forward to S-CONT-1               ===>
12454
                                ; actually S-CONT-2 is destination but why
12455
                                ; waste a byte on a jump when a JR will do.
12456
                                ; Actually a JR L2712 can be used. Rats.
12457
 
12458
; end of functions accessed from scanning functions table.
12459
 
12460
; --------------------------
12461
; Scanning variable routines
12462
; --------------------------
12463
;
12464
;
12465
 
12466
;; S-LETTER
12467
L26C9:  CALL    L28B2           ; routine LOOK-VARS
12468
 
12469
        JP      C,L1C2E         ; jump back to REPORT-2 if variable not found
12470
                                ; 'Variable not found'
12471
                                ; but a variable is always 'found' if syntax
12472
                                ; is being checked.
12473
 
12474
        CALL    Z,L2996         ; routine STK-VAR considers a subscript/slice
12475
        LD      A,($5C3B)       ; fetch FLAGS value
12476
        CP      $C0             ; compare 11000000
12477
        JR      C,L26DD         ; step forward to S-CONT-1 if string  ===>
12478
 
12479
        INC     HL              ; advance pointer
12480
        CALL    L33B4           ; routine STACK-NUM
12481
 
12482
;; S-CONT-1
12483
L26DD:  JR      L2712           ; forward to S-CONT-2                 ===>
12484
 
12485
; ----------------------------------------
12486
; -> the scanning branch was here if not alphanumeric.
12487
; All the remaining functions will be evaluated by a single call to the
12488
; calculator. The correct priority for the operation has to be placed in
12489
; the B register and the operation code, calculator literal in the C register.
12490
; the operation code has bit 7 set if result is numeric and bit 6 is
12491
; set if operand is numeric. so
12492
; $C0 = numeric result, numeric operand.            e.g. 'sin'
12493
; $80 = numeric result, string operand.             e.g. 'code'
12494
; $40 = string result, numeric operand.             e.g. 'str$'
12495
; $00 = string result, string operand.              e.g. 'val$'
12496
 
12497
;; S-NEGATE
12498
L26DF:  LD      BC,$09DB        ; prepare priority 09, operation code $C0 +
12499
                                ; 'negate' ($1B) - bits 6 and 7 set for numeric
12500
                                ; result and numeric operand.
12501
 
12502
        CP      $2D             ; is it '-' ?
12503
        JR      Z,L270D         ; forward if so to S-PUSH-PO
12504
 
12505
        LD      BC,$1018        ; prepare priority $10, operation code 'val$' -
12506
                                ; bits 6 and 7 reset for string result and
12507
                                ; string operand.
12508
 
12509
        CP      $AE             ; is it 'VAL$' ?
12510
        JR      Z,L270D         ; forward if so to S-PUSH-PO
12511
 
12512
        SUB     $AF             ; subtract token 'CODE' value to reduce
12513
                                ; functions 'CODE' to 'NOT' although the
12514
                                ; upper range is, as yet, unchecked.
12515
                                ; valid range would be $00 - $14.
12516
 
12517
        JP      C,L1C8A         ; jump back to REPORT-C with anything else
12518
                                ; 'Nonsense in BASIC'
12519
 
12520
        LD      BC,$04F0        ; prepare priority $04, operation $C0 +
12521
                                ; 'not' ($30)
12522
 
12523
        CP      $14             ; is it 'NOT'
12524
        JR      Z,L270D         ; forward to S-PUSH-PO if so
12525
 
12526
        JP      NC,L1C8A        ; to REPORT-C if higher
12527
                                ; 'Nonsense in BASIC'
12528
 
12529
        LD      B,$10           ; priority $10 for all the rest
12530
        ADD     A,$DC           ; make range $DC - $EF
12531
                                ; $C0 + 'code'($1C) thru 'chr$' ($2F)
12532
 
12533
        LD      C,A             ; transfer 'function' to C
12534
        CP      $DF             ; is it 'sin' ?
12535
        JR      NC,L2707        ; forward to S-NO-TO-$  with 'sin' through
12536
                                ; 'chr$' as operand is numeric.
12537
 
12538
; all the rest 'cos' through 'chr$' give a numeric result except 'str$'
12539
; and 'chr$'.
12540
 
12541
        RES     6,C             ; signal string operand for 'code', 'val' and
12542
                                ; 'len'.
12543
 
12544
;; S-NO-TO-$
12545
L2707:  CP      $EE             ; compare 'str$'
12546
        JR      C,L270D         ; forward to S-PUSH-PO if lower as result
12547
                                ; is numeric.
12548
 
12549
        RES     7,C             ; reset bit 7 of op code for 'str$', 'chr$'
12550
                                ; as result is string.
12551
 
12552
; >> This is where they were all headed for.
12553
 
12554
;; S-PUSH-PO
12555
L270D:  PUSH    BC              ; push the priority and calculator operation
12556
                                ; code.
12557
 
12558
        RST     20H             ; NEXT-CHAR
12559
        JP      L24FF           ; jump back to S-LOOP-1 to go round the loop
12560
                                ; again with the next character.
12561
 
12562
; --------------------------------
12563
 
12564
; ===>  there were many branches forward to here
12565
 
12566
;   An important step after the evaluation of an expression is to test for
12567
;   a string expression and allow it to be sliced.  If a numeric expression is
12568
;   followed by a '(' then the numeric expression is complete.
12569
;   Since a string slice can itself be sliced then loop repeatedly
12570
;   e.g. (STR$ PI) (3 TO) (TO 2)    or "nonsense" (4 TO )
12571
 
12572
;; S-CONT-2
12573
L2712:  RST     18H             ; GET-CHAR
12574
 
12575
;; S-CONT-3
12576
L2713:  CP      $28             ; is it '(' ?
12577
        JR      NZ,L2723        ; forward, if not, to S-OPERTR
12578
 
12579
        BIT     6,(IY+$01)      ; test FLAGS - numeric or string result ?
12580
        JR      NZ,L2734        ; forward, if numeric, to S-LOOP
12581
 
12582
;   if a string expression preceded the '(' then slice it.
12583
 
12584
        CALL    L2A52           ; routine SLICING
12585
 
12586
        RST     20H             ; NEXT-CHAR
12587
        JR      L2713           ; loop back to S-CONT-3
12588
 
12589
; ---------------------------
12590
 
12591
;   the branch was here when possibility of a '(' has been excluded.
12592
 
12593
;; S-OPERTR
12594
L2723:  LD      B,$00           ; prepare to add
12595
        LD      C,A             ; possible operator to C
12596
        LD      HL,L2795        ; Address: $2795 - tbl-of-ops
12597
        CALL    L16DC           ; routine INDEXER
12598
        JR      NC,L2734        ; forward to S-LOOP if not in table
12599
 
12600
;   but if found in table the priority has to be looked up.
12601
 
12602
        LD      C,(HL)          ; operation code to C ( B is still zero )
12603
        LD      HL,L27B0 - $C3  ; $26ED is base of table
12604
        ADD     HL,BC           ; index into table.
12605
        LD      B,(HL)          ; priority to B.
12606
 
12607
; ------------------
12608
; Scanning main loop
12609
; ------------------
12610
; the juggling act
12611
 
12612
;; S-LOOP
12613
L2734:  POP     DE              ; fetch last priority and operation
12614
        LD      A,D             ; priority to A
12615
        CP      B               ; compare with this one
12616
        JR      C,L2773         ; forward to S-TIGHTER to execute the
12617
                                ; last operation before this one as it has
12618
                                ; higher priority.
12619
 
12620
; the last priority was greater or equal this one.
12621
 
12622
        AND     A               ; if it is zero then so is this
12623
        JP      Z,L0018         ; jump to exit via get-char pointing at
12624
                                ; next character.
12625
                                ; This may be the character after the
12626
                                ; expression or, if exiting a recursive call,
12627
                                ; the next part of the expression to be
12628
                                ; evaluated.
12629
 
12630
        PUSH    BC              ; save current priority/operation
12631
                                ; as it has lower precedence than the one
12632
                                ; now in DE.
12633
 
12634
; the 'USR' function is special in that it is overloaded to give two types
12635
; of result.
12636
 
12637
        LD      HL,$5C3B        ; address FLAGS
12638
        LD      A,E             ; new operation to A register
12639
        CP      $ED             ; is it $C0 + 'usr-no' ($2D)  ?
12640
        JR      NZ,L274C        ; forward to S-STK-LST if not
12641
 
12642
        BIT     6,(HL)          ; string result expected ?
12643
                                ; (from the lower priority operand we've
12644
                                ; just pushed on stack )
12645
        JR      NZ,L274C        ; forward to S-STK-LST if numeric
12646
                                ; as operand bits match.
12647
 
12648
        LD      E,$99           ; reset bit 6 and substitute $19 'usr-$'
12649
                                ; for string operand.
12650
 
12651
;; S-STK-LST
12652
L274C:  PUSH    DE              ; now stack this priority/operation
12653
        CALL    L2530           ; routine SYNTAX-Z
12654
        JR      Z,L275B         ; forward to S-SYNTEST if checking syntax.
12655
 
12656
        LD      A,E             ; fetch the operation code
12657
        AND     $3F             ; mask off the result/operand bits to leave
12658
                                ; a calculator literal.
12659
        LD      B,A             ; transfer to B register
12660
 
12661
; now use the calculator to perform the single operation - operand is on
12662
; the calculator stack.
12663
; Note. although the calculator is performing a single operation most
12664
; functions e.g. TAN are written using other functions and literals and
12665
; these in turn are written using further strings of calculator literals so
12666
; another level of magical recursion joins the juggling act for a while
12667
; as the calculator too is calling itself.
12668
 
12669
        RST     28H             ;; FP-CALC
12670
        DEFB    $3B             ;;fp-calc-2
12671
L2758:  DEFB    $38             ;;end-calc
12672
 
12673
        JR      L2764           ; forward to S-RUNTEST
12674
 
12675
; ---
12676
 
12677
; the branch was here if checking syntax only.
12678
 
12679
;; S-SYNTEST
12680
L275B:  LD      A,E             ; fetch the operation code to accumulator
12681
        XOR     (IY+$01)        ; compare with bits of FLAGS
12682
        AND     $40             ; bit 6 will be zero now if operand
12683
                                ; matched expected result.
12684
 
12685
;; S-RPORT-C2
12686
L2761:  JP      NZ,L1C8A        ; to REPORT-C if mismatch
12687
                                ; 'Nonsense in BASIC'
12688
                                ; else continue to set flags for next
12689
 
12690
; the branch is to here in runtime after a successful operation.
12691
 
12692
;; S-RUNTEST
12693
L2764:  POP     DE              ; fetch the last operation from stack
12694
        LD      HL,$5C3B        ; address FLAGS
12695
        SET     6,(HL)          ; set default to numeric result in FLAGS
12696
        BIT     7,E             ; test the operational result
12697
        JR      NZ,L2770        ; forward to S-LOOPEND if numeric
12698
 
12699
        RES     6,(HL)          ; reset bit 6 of FLAGS to show string result.
12700
 
12701
;; S-LOOPEND
12702
L2770:  POP     BC              ; fetch the previous priority/operation
12703
        JR      L2734           ; back to S-LOOP to perform these
12704
 
12705
; ---
12706
 
12707
; the branch was here when a stacked priority/operator had higher priority
12708
; than the current one.
12709
 
12710
;; S-TIGHTER
12711
L2773:  PUSH    DE              ; save high priority op on stack again
12712
        LD      A,C             ; fetch lower priority operation code
12713
        BIT     6,(IY+$01)      ; test FLAGS - Numeric or string result ?
12714
        JR      NZ,L2790        ; forward to S-NEXT if numeric result
12715
 
12716
; if this is lower priority yet has string then must be a comparison.
12717
; Since these can only be evaluated in context and were defaulted to
12718
; numeric in operator look up they must be changed to string equivalents.
12719
 
12720
        AND     $3F             ; mask to give true calculator literal
12721
        ADD     A,$08           ; augment numeric literals to string
12722
                                ; equivalents.
12723
                                ; 'no-&-no'  => 'str-&-no'
12724
                                ; 'no-l-eql' => 'str-l-eql'
12725
                                ; 'no-gr-eq' => 'str-gr-eq'
12726
                                ; 'nos-neql' => 'strs-neql'
12727
                                ; 'no-grtr'  => 'str-grtr'
12728
                                ; 'no-less'  => 'str-less'
12729
                                ; 'nos-eql'  => 'strs-eql'
12730
                                ; 'addition' => 'strs-add'
12731
        LD      C,A             ; put modified comparison operator back
12732
        CP      $10             ; is it now 'str-&-no' ?
12733
        JR      NZ,L2788        ; forward to S-NOT-AND  if not.
12734
 
12735
        SET     6,C             ; set numeric operand bit
12736
        JR      L2790           ; forward to S-NEXT
12737
 
12738
; ---
12739
 
12740
;; S-NOT-AND
12741
L2788:  JR      C,L2761         ; back to S-RPORT-C2 if less
12742
                                ; 'Nonsense in BASIC'.
12743
                                ; e.g. a$ * b$
12744
 
12745
        CP      $17             ; is it 'strs-add' ?
12746
        JR      Z,L2790         ; forward to S-NEXT if so
12747
                                ; (bit 6 and 7 are reset)
12748
 
12749
        SET     7,C             ; set numeric (Boolean) result for all others
12750
 
12751
;; S-NEXT
12752
L2790:  PUSH    BC              ; now save this priority/operation on stack
12753
 
12754
        RST     20H             ; NEXT-CHAR
12755
        JP      L24FF           ; jump back to S-LOOP-1
12756
 
12757
; ------------------
12758
; Table of operators
12759
; ------------------
12760
; This table is used to look up the calculator literals associated with
12761
; the operator character. The thirteen calculator operations $03 - $0F
12762
; have bits 6 and 7 set to signify a numeric result.
12763
; Some of these codes and bits may be altered later if the context suggests
12764
; a string comparison or operation.
12765
; that is '+', '=', '>', '<', '<=', '>=' or '<>'.
12766
 
12767
;; tbl-of-ops
12768
L2795:  DEFB    '+', $CF        ;        $C0 + 'addition'
12769
        DEFB    '-', $C3        ;        $C0 + 'subtract'
12770
        DEFB    '*', $C4        ;        $C0 + 'multiply'
12771
        DEFB    '/', $C5        ;        $C0 + 'division'
12772
        DEFB    '^', $C6        ;        $C0 + 'to-power'
12773
        DEFB    '=', $CE        ;        $C0 + 'nos-eql'
12774
        DEFB    '>', $CC        ;        $C0 + 'no-grtr'
12775
        DEFB    '<', $CD        ;        $C0 + 'no-less'
12776
 
12777
        DEFB    $C7, $C9        ; '<='   $C0 + 'no-l-eql'
12778
        DEFB    $C8, $CA        ; '>='   $C0 + 'no-gr-eql'
12779
        DEFB    $C9, $CB        ; '<>'   $C0 + 'nos-neql'
12780
        DEFB    $C5, $C7        ; 'OR'   $C0 + 'or'
12781
        DEFB    $C6, $C8        ; 'AND'  $C0 + 'no-&-no'
12782
 
12783
        DEFB    $00             ; zero end-marker.
12784
 
12785
 
12786
; -------------------
12787
; Table of priorities
12788
; -------------------
12789
; This table is indexed with the operation code obtained from the above
12790
; table $C3 - $CF to obtain the priority for the respective operation.
12791
 
12792
;; tbl-priors
12793
L27B0:  DEFB    $06             ; '-'   opcode $C3
12794
        DEFB    $08             ; '*'   opcode $C4
12795
        DEFB    $08             ; '/'   opcode $C5
12796
        DEFB    $0A             ; '^'   opcode $C6
12797
        DEFB    $02             ; 'OR'  opcode $C7
12798
        DEFB    $03             ; 'AND' opcode $C8
12799
        DEFB    $05             ; '<='  opcode $C9
12800
        DEFB    $05             ; '>='  opcode $CA
12801
        DEFB    $05             ; '<>'  opcode $CB
12802
        DEFB    $05             ; '>'   opcode $CC
12803
        DEFB    $05             ; '<'   opcode $CD
12804
        DEFB    $05             ; '='   opcode $CE
12805
        DEFB    $06             ; '+'   opcode $CF
12806
 
12807
; ----------------------
12808
; Scanning function (FN)
12809
; ----------------------
12810
; This routine deals with user-defined functions.
12811
; The definition can be anywhere in the program area but these are best
12812
; placed near the start of the program as we shall see.
12813
; The evaluation process is quite complex as the Spectrum has to parse two
12814
; statements at the same time. Syntax of both has been checked previously
12815
; and hidden locations have been created immediately after each argument
12816
; of the DEF FN statement. Each of the arguments of the FN function is
12817
; evaluated by SCANNING and placed in the hidden locations. Then the
12818
; expression to the right of the DEF FN '=' is evaluated by SCANNING and for
12819
; any variables encountered, a search is made in the DEF FN variable list
12820
; in the program area before searching in the normal variables area.
12821
;
12822
; Recursion is not allowed: i.e. the definition of a function should not use
12823
; the same function, either directly or indirectly ( through another function).
12824
; You'll normally get error 4, ('Out of memory'), although sometimes the system
12825
; will crash. - Vickers, Pitman 1984.
12826
;
12827
; As the definition is just an expression, there would seem to be no means
12828
; of breaking out of such recursion.
12829
; However, by the clever use of string expressions and VAL, such recursion is
12830
; possible.
12831
; e.g. DEF FN a(n) = VAL "n+FN a(n-1)+0" ((n<1) * 10 + 1 TO )
12832
; will evaluate the full 11-character expression for all values where n is
12833
; greater than zero but just the 11th character, "0", when n drops to zero
12834
; thereby ending the recursion producing the correct result.
12835
; Recursive string functions are possible using VAL$ instead of VAL and the
12836
; null string as the final addend.
12837
; - from a turn of the century newsgroup discussion initiated by Mike Wynne.
12838
 
12839
;; S-FN-SBRN
12840
L27BD:  CALL    L2530           ; routine SYNTAX-Z
12841
        JR      NZ,L27F7        ; forward to SF-RUN in runtime
12842
 
12843
 
12844
        RST     20H             ; NEXT-CHAR
12845
        CALL    L2C8D           ; routine ALPHA check for letters A-Z a-z
12846
        JP      NC,L1C8A        ; jump back to REPORT-C if not
12847
                                ; 'Nonsense in BASIC'
12848
 
12849
 
12850
        RST     20H             ; NEXT-CHAR
12851
        CP      $24             ; is it '$' ?
12852
        PUSH    AF              ; save character and flags
12853
        JR      NZ,L27D0        ; forward to SF-BRKT-1 with numeric function
12854
 
12855
 
12856
        RST     20H             ; NEXT-CHAR
12857
 
12858
;; SF-BRKT-1
12859
L27D0:  CP      $28             ; is '(' ?
12860
        JR      NZ,L27E6        ; forward to SF-RPRT-C if not
12861
                                ; 'Nonsense in BASIC'
12862
 
12863
 
12864
        RST     20H             ; NEXT-CHAR
12865
        CP      $29             ; is it ')' ?
12866
        JR      Z,L27E9         ; forward to SF-FLAG-6 if no arguments.
12867
 
12868
;; SF-ARGMTS
12869
L27D9:  CALL    L24FB           ; routine SCANNING checks each argument
12870
                                ; which may be an expression.
12871
 
12872
        RST     18H             ; GET-CHAR
12873
        CP      $2C             ; is it a ',' ?
12874
        JR      NZ,L27E4        ; forward if not to SF-BRKT-2 to test bracket
12875
 
12876
 
12877
        RST     20H             ; NEXT-CHAR if a comma was found
12878
        JR      L27D9           ; back to SF-ARGMTS to parse all arguments.
12879
 
12880
; ---
12881
 
12882
;; SF-BRKT-2
12883
L27E4:  CP      $29             ; is character the closing ')' ?
12884
 
12885
;; SF-RPRT-C
12886
L27E6:  JP      NZ,L1C8A        ; jump to REPORT-C
12887
                                ; 'Nonsense in BASIC'
12888
 
12889
; at this point any optional arguments have had their syntax checked.
12890
 
12891
;; SF-FLAG-6
12892
L27E9:  RST     20H             ; NEXT-CHAR
12893
        LD      HL,$5C3B        ; address system variable FLAGS
12894
        RES     6,(HL)          ; signal string result
12895
        POP     AF              ; restore test against '$'.
12896
        JR      Z,L27F4         ; forward to SF-SYN-EN if string function.
12897
 
12898
        SET     6,(HL)          ; signal numeric result
12899
 
12900
;; SF-SYN-EN
12901
L27F4:  JP      L2712           ; jump back to S-CONT-2 to continue scanning.
12902
 
12903
; ---
12904
 
12905
; the branch was here in runtime.
12906
 
12907
;; SF-RUN
12908
L27F7:  RST     20H             ; NEXT-CHAR fetches name
12909
        AND     $DF             ; AND 11101111 - reset bit 5 - upper-case.
12910
        LD      B,A             ; save in B
12911
 
12912
        RST     20H             ; NEXT-CHAR
12913
        SUB     $24             ; subtract '$'
12914
        LD      C,A             ; save result in C
12915
        JR      NZ,L2802        ; forward if not '$' to SF-ARGMT1
12916
 
12917
        RST     20H             ; NEXT-CHAR advances to bracket
12918
 
12919
;; SF-ARGMT1
12920
L2802:  RST     20H             ; NEXT-CHAR advances to start of argument
12921
        PUSH    HL              ; save address
12922
        LD      HL,($5C53)      ; fetch start of program area from PROG
12923
        DEC     HL              ; the search starting point is the previous
12924
                                ; location.
12925
 
12926
;; SF-FND-DF
12927
L2808:  LD      DE,$00CE        ; search is for token 'DEF FN' in E,
12928
                                ; statement count in D.
12929
        PUSH    BC              ; save C the string test, and B the letter.
12930
        CALL    L1D86           ; routine LOOK-PROG will search for token.
12931
        POP     BC              ; restore BC.
12932
        JR      NC,L2814        ; forward to SF-CP-DEF if a match was found.
12933
 
12934
 
12935
;; REPORT-P
12936
L2812:  RST     08H             ; ERROR-1
12937
        DEFB    $18             ; Error Report: FN without DEF
12938
 
12939
;; SF-CP-DEF
12940
L2814:  PUSH    HL              ; save address of DEF FN
12941
        CALL    L28AB           ; routine FN-SKPOVR skips over white-space etc.
12942
                                ; without disturbing CH-ADD.
12943
        AND     $DF             ; make fetched character upper-case.
12944
        CP      B               ; compare with FN name
12945
        JR      NZ,L2825        ; forward to SF-NOT-FD if no match.
12946
 
12947
; the letters match so test the type.
12948
 
12949
        CALL    L28AB           ; routine FN-SKPOVR skips white-space
12950
        SUB     $24             ; subtract '$' from fetched character
12951
        CP      C               ; compare with saved result of same operation
12952
                                ; on FN name.
12953
        JR      Z,L2831         ; forward to SF-VALUES with a match.
12954
 
12955
; the letters matched but one was string and the other numeric.
12956
 
12957
;; SF-NOT-FD
12958
L2825:  POP     HL              ; restore search point.
12959
        DEC     HL              ; make location before
12960
        LD      DE,$0200        ; the search is to be for the end of the
12961
                                ; current definition - 2 statements forward.
12962
        PUSH    BC              ; save the letter/type
12963
        CALL    L198B           ; routine EACH-STMT steps past rejected
12964
                                ; definition.
12965
        POP     BC              ; restore letter/type
12966
        JR      L2808           ; back to SF-FND-DF to continue search
12967
 
12968
; ---
12969
 
12970
; Success!
12971
; the branch was here with matching letter and numeric/string type.
12972
 
12973
;; SF-VALUES
12974
L2831:  AND     A               ; test A ( will be zero if string '$' - '$' )
12975
 
12976
        CALL    Z,L28AB         ; routine FN-SKPOVR advances HL past '$'.
12977
 
12978
        POP     DE              ; discard pointer to 'DEF FN'.
12979
        POP     DE              ; restore pointer to first FN argument.
12980
        LD      ($5C5D),DE      ; save in CH_ADD
12981
 
12982
        CALL    L28AB           ; routine FN-SKPOVR advances HL past '('
12983
        PUSH    HL              ; save start address in DEF FN  ***
12984
        CP      $29             ; is character a ')' ?
12985
        JR      Z,L2885         ; forward to SF-R-BR-2 if no arguments.
12986
 
12987
;; SF-ARG-LP
12988
L2843:  INC     HL              ; point to next character.
12989
        LD      A,(HL)          ; fetch it.
12990
        CP      $0E             ; is it the number marker
12991
        LD      D,$40           ; signal numeric in D.
12992
        JR      Z,L2852         ; forward to SF-ARG-VL if numeric.
12993
 
12994
        DEC     HL              ; back to letter
12995
        CALL    L28AB           ; routine FN-SKPOVR skips any white-space
12996
        INC     HL              ; advance past the expected '$' to
12997
                                ; the 'hidden' marker.
12998
        LD      D,$00           ; signal string.
12999
 
13000
;; SF-ARG-VL
13001
L2852:  INC     HL              ; now address first of 5-byte location.
13002
        PUSH    HL              ; save address in DEF FN statement
13003
        PUSH    DE              ; save D - result type
13004
 
13005
        CALL    L24FB           ; routine SCANNING evaluates expression in
13006
                                ; the FN statement setting FLAGS and leaving
13007
                                ; result as last value on calculator stack.
13008
 
13009
        POP     AF              ; restore saved result type to A
13010
 
13011
        XOR     (IY+$01)        ; xor with FLAGS
13012
        AND     $40             ; and with 01000000 to test bit 6
13013
        JR      NZ,L288B        ; forward to REPORT-Q if type mismatch.
13014
                                ; 'Parameter error'
13015
 
13016
        POP     HL              ; pop the start address in DEF FN statement
13017
        EX      DE,HL           ; transfer to DE ?? pop straight into de ?
13018
 
13019
        LD      HL,($5C65)      ; set HL to STKEND location after value
13020
        LD      BC,$0005        ; five bytes to move
13021
        SBC     HL,BC           ; decrease HL by 5 to point to start.
13022
        LD      ($5C65),HL      ; set STKEND 'removing' value from stack.
13023
 
13024
        LDIR                    ; copy value into DEF FN statement
13025
        EX      DE,HL           ; set HL to location after value in DEF FN
13026
        DEC     HL              ; step back one
13027
        CALL    L28AB           ; routine FN-SKPOVR gets next valid character
13028
        CP      $29             ; is it ')' end of arguments ?
13029
        JR      Z,L2885         ; forward to SF-R-BR-2 if so.
13030
 
13031
; a comma separator has been encountered in the DEF FN argument list.
13032
 
13033
        PUSH    HL              ; save position in DEF FN statement
13034
 
13035
        RST     18H             ; GET-CHAR from FN statement
13036
        CP      $2C             ; is it ',' ?
13037
        JR      NZ,L288B        ; forward to REPORT-Q if not
13038
                                ; 'Parameter error'
13039
 
13040
        RST     20H             ; NEXT-CHAR in FN statement advances to next
13041
                                ; argument.
13042
 
13043
        POP     HL              ; restore DEF FN pointer
13044
        CALL    L28AB           ; routine FN-SKPOVR advances to corresponding
13045
                                ; argument.
13046
 
13047
        JR      L2843           ; back to SF-ARG-LP looping until all
13048
                                ; arguments are passed into the DEF FN
13049
                                ; hidden locations.
13050
 
13051
; ---
13052
 
13053
; the branch was here when all arguments passed.
13054
 
13055
;; SF-R-BR-2
13056
L2885:  PUSH    HL              ; save location of ')' in DEF FN
13057
 
13058
        RST     18H             ; GET-CHAR gets next character in FN
13059
        CP      $29             ; is it a ')' also ?
13060
        JR      Z,L288D         ; forward to SF-VALUE if so.
13061
 
13062
 
13063
;; REPORT-Q
13064
L288B:  RST     08H             ; ERROR-1
13065
        DEFB    $19             ; Error Report: Parameter error
13066
 
13067
;; SF-VALUE
13068
L288D:  POP     DE              ; location of ')' in DEF FN to DE.
13069
        EX      DE,HL           ; now to HL, FN ')' pointer to DE.
13070
        LD      ($5C5D),HL      ; initialize CH_ADD to this value.
13071
 
13072
; At this point the start of the DEF FN argument list is on the machine stack.
13073
; We also have to consider that this defined function may form part of the
13074
; definition of another defined function (though not itself).
13075
; As this defined function may be part of a hierarchy of defined functions
13076
; currently being evaluated by recursive calls to SCANNING, then we have to
13077
; preserve the original value of DEFADD and not assume that it is zero.
13078
 
13079
        LD      HL,($5C0B)      ; get original DEFADD address
13080
        EX      (SP),HL         ; swap with DEF FN address on stack ***
13081
        LD      ($5C0B),HL      ; set DEFADD to point to this argument list
13082
                                ; during scanning.
13083
 
13084
        PUSH    DE              ; save FN ')' pointer.
13085
 
13086
        RST     20H             ; NEXT-CHAR advances past ')' in define
13087
 
13088
        RST     20H             ; NEXT-CHAR advances past '=' to expression
13089
 
13090
        CALL    L24FB           ; routine SCANNING evaluates but searches
13091
                                ; initially for variables at DEFADD
13092
 
13093
        POP     HL              ; pop the FN ')' pointer
13094
        LD      ($5C5D),HL      ; set CH_ADD to this
13095
        POP     HL              ; pop the original DEFADD value
13096
        LD      ($5C0B),HL      ; and re-insert into DEFADD system variable.
13097
 
13098
        RST     20H             ; NEXT-CHAR advances to character after ')'
13099
        JP      L2712           ; to S-CONT-2 - to continue current
13100
                                ; invocation of scanning
13101
 
13102
; --------------------
13103
; Used to parse DEF FN
13104
; --------------------
13105
; e.g. DEF FN     s $ ( x )     =  b     $ (  TO  x  ) : REM exaggerated
13106
;
13107
; This routine is used 10 times to advance along a DEF FN statement
13108
; skipping spaces and colour control codes. It is similar to NEXT-CHAR
13109
; which is, at the same time, used to skip along the corresponding FN function
13110
; except the latter has to deal with AT and TAB characters in string
13111
; expressions. These cannot occur in a program area so this routine is
13112
; simpler as both colour controls and their parameters are less than space.
13113
 
13114
;; FN-SKPOVR
13115
L28AB:  INC     HL              ; increase pointer
13116
        LD      A,(HL)          ; fetch addressed character
13117
        CP      $21             ; compare with space + 1
13118
        JR      C,L28AB         ; back to FN-SKPOVR if less
13119
 
13120
        RET                     ; return pointing to a valid character.
13121
 
13122
; ---------
13123
; LOOK-VARS
13124
; ---------
13125
;
13126
;
13127
 
13128
;; LOOK-VARS
13129
L28B2:  SET     6,(IY+$01)      ; update FLAGS - presume numeric result
13130
 
13131
        RST     18H             ; GET-CHAR
13132
        CALL    L2C8D           ; routine ALPHA tests for A-Za-z
13133
        JP      NC,L1C8A        ; jump to REPORT-C if not.
13134
                                ; 'Nonsense in BASIC'
13135
 
13136
        PUSH    HL              ; save pointer to first letter       ^1
13137
        AND     $1F             ; mask lower bits, 1 - 26 decimal     000xxxxx
13138
        LD      C,A             ; store in C.
13139
 
13140
        RST     20H             ; NEXT-CHAR
13141
        PUSH    HL              ; save pointer to second character   ^2
13142
        CP      $28             ; is it '(' - an array ?
13143
        JR      Z,L28EF         ; forward to V-RUN/SYN if so.
13144
 
13145
        SET     6,C             ; set 6 signaling string if solitary  010
13146
        CP      $24             ; is character a '$' ?
13147
        JR      Z,L28DE         ; forward to V-STR-VAR
13148
 
13149
        SET     5,C             ; signal numeric                       011
13150
        CALL    L2C88           ; routine ALPHANUM sets carry if second
13151
                                ; character is alphanumeric.
13152
        JR      NC,L28E3        ; forward to V-TEST-FN if just one character
13153
 
13154
; It is more than one character but re-test current character so that 6 reset
13155
; This loop renders the similar loop at V-PASS redundant.
13156
 
13157
;; V-CHAR
13158
L28D4:  CALL    L2C88           ; routine ALPHANUM
13159
        JR      NC,L28EF        ; to V-RUN/SYN when no more
13160
 
13161
        RES     6,C             ; make long named type                 001
13162
 
13163
        RST     20H             ; NEXT-CHAR
13164
        JR      L28D4           ; loop back to V-CHAR
13165
 
13166
; ---
13167
 
13168
 
13169
;; V-STR-VAR
13170
L28DE:  RST     20H             ; NEXT-CHAR advances past '$'
13171
        RES     6,(IY+$01)      ; update FLAGS - signal string result.
13172
 
13173
;; V-TEST-FN
13174
L28E3:  LD      A,($5C0C)       ; load A with DEFADD_hi
13175
        AND     A               ; and test for zero.
13176
        JR      Z,L28EF         ; forward to V-RUN/SYN if a defined function
13177
                                ; is not being evaluated.
13178
 
13179
; Note.
13180
 
13181
        CALL    L2530           ; routine SYNTAX-Z
13182
        JP      NZ,L2951        ; JUMP to STK-F-ARG in runtime and then
13183
                                ; back to this point if no variable found.
13184
 
13185
;; V-RUN/SYN
13186
L28EF:  LD      B,C             ; save flags in B
13187
        CALL    L2530           ; routine SYNTAX-Z
13188
        JR      NZ,L28FD        ; to V-RUN to look for the variable in runtime
13189
 
13190
; if checking syntax the letter is not returned
13191
 
13192
        LD      A,C             ; copy letter/flags to A
13193
        AND     $E0             ; and with 11100000 to get rid of the letter
13194
        SET     7,A             ; use spare bit to signal checking syntax.
13195
        LD      C,A             ; and transfer to C.
13196
        JR      L2934           ; forward to V-SYNTAX
13197
 
13198
; ---
13199
 
13200
; but in runtime search for the variable.
13201
 
13202
;; V-RUN
13203
L28FD:  LD      HL,($5C4B)      ; set HL to start of variables from VARS
13204
 
13205
;; V-EACH
13206
L2900:  LD      A,(HL)          ; get first character
13207
        AND     $7F             ; and with 01111111
13208
                                ; ignoring bit 7 which distinguishes
13209
                                ; arrays or for/next variables.
13210
 
13211
        JR      Z,L2932         ; to V-80-BYTE if zero as must be 10000000
13212
                                ; the variables end-marker.
13213
 
13214
        CP      C               ; compare with supplied value.
13215
        JR      NZ,L292A        ; forward to V-NEXT if no match.
13216
 
13217
        RLA                     ; destructively test
13218
        ADD     A,A             ; bits 5 and 6 of A
13219
                                ; jumping if bit 5 reset or 6 set
13220
 
13221
        JP      P,L293F         ; to V-FOUND-2  strings and arrays
13222
 
13223
        JR      C,L293F         ; to V-FOUND-2  simple and for next
13224
 
13225
; leaving long name variables.
13226
 
13227
        POP     DE              ; pop pointer to 2nd. char
13228
        PUSH    DE              ; save it again
13229
        PUSH    HL              ; save variable first character pointer
13230
 
13231
;; V-MATCHES
13232
L2912:  INC     HL              ; address next character in vars area
13233
 
13234
;; V-SPACES
13235
L2913:  LD      A,(DE)          ; pick up letter from prog area
13236
        INC     DE              ; and advance address
13237
        CP      $20             ; is it a space
13238
        JR      Z,L2913         ; back to V-SPACES until non-space
13239
 
13240
        OR      $20             ; convert to range 1 - 26.
13241
        CP      (HL)            ; compare with addressed variables character
13242
        JR      Z,L2912         ; loop back to V-MATCHES if a match on an
13243
                                ; intermediate letter.
13244
 
13245
        OR      $80             ; now set bit 7 as last character of long
13246
                                ; names are inverted.
13247
        CP      (HL)            ; compare again
13248
        JR      NZ,L2929        ; forward to V-GET-PTR if no match
13249
 
13250
; but if they match check that this is also last letter in prog area
13251
 
13252
        LD      A,(DE)          ; fetch next character
13253
        CALL    L2C88           ; routine ALPHANUM sets carry if not alphanum
13254
        JR      NC,L293E        ; forward to V-FOUND-1 with a full match.
13255
 
13256
;; V-GET-PTR
13257
L2929:  POP     HL              ; pop saved pointer to char 1
13258
 
13259
;; V-NEXT
13260
L292A:  PUSH    BC              ; save flags
13261
        CALL    L19B8           ; routine NEXT-ONE gets next variable in DE
13262
        EX      DE,HL           ; transfer to HL.
13263
        POP     BC              ; restore the flags
13264
        JR      L2900           ; loop back to V-EACH
13265
                                ; to compare each variable
13266
 
13267
; ---
13268
 
13269
;; V-80-BYTE
13270
L2932:  SET     7,B             ; will signal not found
13271
 
13272
; the branch was here when checking syntax
13273
 
13274
;; V-SYNTAX
13275
L2934:  POP     DE              ; discard the pointer to 2nd. character  v2
13276
                                ; in BASIC line/workspace.
13277
 
13278
        RST     18H             ; GET-CHAR gets character after variable name.
13279
        CP      $28             ; is it '(' ?
13280
        JR      Z,L2943         ; forward to V-PASS
13281
                                ; Note. could go straight to V-END ?
13282
 
13283
        SET     5,B             ; signal not an array
13284
        JR      L294B           ; forward to V-END
13285
 
13286
; ---------------------------
13287
 
13288
; the jump was here when a long name matched and HL pointing to last character
13289
; in variables area.
13290
 
13291
;; V-FOUND-1
13292
L293E:  POP     DE              ; discard pointer to first var letter
13293
 
13294
; the jump was here with all other matches HL points to first var char.
13295
 
13296
;; V-FOUND-2
13297
L293F:  POP     DE              ; discard pointer to 2nd prog char       v2
13298
        POP     DE              ; drop pointer to 1st prog char          v1
13299
        PUSH    HL              ; save pointer to last char in vars
13300
 
13301
        RST     18H             ; GET-CHAR
13302
 
13303
;; V-PASS
13304
L2943:  CALL    L2C88           ; routine ALPHANUM
13305
        JR      NC,L294B        ; forward to V-END if not
13306
 
13307
; but it never will be as we advanced past long-named variables earlier.
13308
 
13309
        RST     20H             ; NEXT-CHAR
13310
        JR      L2943           ; back to V-PASS
13311
 
13312
; ---
13313
 
13314
;; V-END
13315
L294B:  POP     HL              ; pop the pointer to first character in
13316
                                ; BASIC line/workspace.
13317
        RL      B               ; rotate the B register left
13318
                                ; bit 7 to carry
13319
        BIT     6,B             ; test the array indicator bit.
13320
        RET                     ; return
13321
 
13322
; -----------------------
13323
; Stack function argument
13324
; -----------------------
13325
; This branch is taken from LOOK-VARS when a defined function is currently
13326
; being evaluated.
13327
; Scanning is evaluating the expression after the '=' and the variable
13328
; found could be in the argument list to the left of the '=' or in the
13329
; normal place after the program. Preference will be given to the former.
13330
; The variable name to be matched is in C.
13331
 
13332
;; STK-F-ARG
13333
L2951:  LD      HL,($5C0B)      ; set HL to DEFADD
13334
        LD      A,(HL)          ; load the first character
13335
        CP      $29             ; is it ')' ?
13336
        JP      Z,L28EF         ; JUMP back to V-RUN/SYN, if so, as there are
13337
                                ; no arguments.
13338
 
13339
; but proceed to search argument list of defined function first if not empty.
13340
 
13341
;; SFA-LOOP
13342
L295A:  LD      A,(HL)          ; fetch character again.
13343
        OR      $60             ; or with 01100000 presume a simple variable.
13344
        LD      B,A             ; save result in B.
13345
        INC     HL              ; address next location.
13346
        LD      A,(HL)          ; pick up byte.
13347
        CP      $0E             ; is it the number marker ?
13348
        JR      Z,L296B         ; forward to SFA-CP-VR if so.
13349
 
13350
; it was a string. White-space may be present but syntax has been checked.
13351
 
13352
        DEC     HL              ; point back to letter.
13353
        CALL    L28AB           ; routine FN-SKPOVR skips to the '$'
13354
        INC     HL              ; now address the hidden marker.
13355
        RES     5,B             ; signal a string variable.
13356
 
13357
;; SFA-CP-VR
13358
L296B:  LD      A,B             ; transfer found variable letter to A.
13359
        CP      C               ; compare with expected.
13360
        JR      Z,L2981         ; forward to SFA-MATCH with a match.
13361
 
13362
        INC     HL              ; step
13363
        INC     HL              ; past
13364
        INC     HL              ; the
13365
        INC     HL              ; five
13366
        INC     HL              ; bytes.
13367
 
13368
        CALL    L28AB           ; routine FN-SKPOVR skips to next character
13369
        CP      $29             ; is it ')' ?
13370
        JP      Z,L28EF         ; jump back if so to V-RUN/SYN to look in
13371
                                ; normal variables area.
13372
 
13373
        CALL    L28AB           ; routine FN-SKPOVR skips past the ','
13374
                                ; all syntax has been checked and these
13375
                                ; things can be taken as read.
13376
        JR      L295A           ; back to SFA-LOOP while there are more
13377
                                ; arguments.
13378
 
13379
; ---
13380
 
13381
;; SFA-MATCH
13382
L2981:  BIT     5,C             ; test if numeric
13383
        JR      NZ,L2991        ; to SFA-END if so as will be stacked
13384
                                ; by scanning
13385
 
13386
        INC     HL              ; point to start of string descriptor
13387
        LD      DE,($5C65)      ; set DE to STKEND
13388
        CALL    L33C0           ; routine MOVE-FP puts parameters on stack.
13389
        EX      DE,HL           ; new free location to HL.
13390
        LD      ($5C65),HL      ; use it to set STKEND system variable.
13391
 
13392
;; SFA-END
13393
L2991:  POP     DE              ; discard
13394
        POP     DE              ; pointers.
13395
        XOR     A               ; clear carry flag.
13396
        INC     A               ; and zero flag.
13397
        RET                     ; return.
13398
 
13399
; ------------------------
13400
; Stack variable component
13401
; ------------------------
13402
; This is called to evaluate a complex structure that has been found, in
13403
; runtime, by LOOK-VARS in the variables area.
13404
; In this case HL points to the initial letter, bits 7-5
13405
; of which indicate the type of variable.
13406
; 010 - simple string, 110 - string array, 100 - array of numbers.
13407
;
13408
; It is called from CLASS-01 when assigning to a string or array including
13409
; a slice.
13410
; It is called from SCANNING to isolate the required part of the structure.
13411
;
13412
; An important part of the runtime process is to check that the number of
13413
; dimensions of the variable match the number of subscripts supplied in the
13414
; BASIC line.
13415
;
13416
; If checking syntax,
13417
; the B register, which counts dimensions is set to zero (256) to allow
13418
; the loop to continue till all subscripts are checked. While doing this it
13419
; is reading dimension sizes from some arbitrary area of memory. Although
13420
; these are meaningless it is of no concern as the limit is never checked by
13421
; int-exp during syntax checking.
13422
;
13423
; The routine is also called from the syntax path of DIM command to check the
13424
; syntax of both string and numeric arrays definitions except that bit 6 of C
13425
; is reset so both are checked as numeric arrays. This ruse avoids a terminal
13426
; slice being accepted as part of the DIM command.
13427
; All that is being checked is that there are a valid set of comma-separated
13428
; expressions before a terminal ')', although, as above, it will still go
13429
; through the motions of checking dummy dimension sizes.
13430
 
13431
;; STK-VAR
13432
L2996:  XOR     A               ; clear A
13433
        LD      B,A             ; and B, the syntax dimension counter (256)
13434
        BIT     7,C             ; checking syntax ?
13435
        JR      NZ,L29E7        ; forward to SV-COUNT if so.
13436
 
13437
; runtime evaluation.
13438
 
13439
        BIT     7,(HL)          ; will be reset if a simple string.
13440
        JR      NZ,L29AE        ; forward to SV-ARRAYS otherwise
13441
 
13442
        INC     A               ; set A to 1, simple string.
13443
 
13444
;; SV-SIMPLE$
13445
L29A1:  INC     HL              ; address length low
13446
        LD      C,(HL)          ; place in C
13447
        INC     HL              ; address length high
13448
        LD      B,(HL)          ; place in B
13449
        INC     HL              ; address start of string
13450
        EX      DE,HL           ; DE = start now.
13451
        CALL    L2AB2           ; routine STK-STO-$ stacks string parameters
13452
                                ; DE start in variables area,
13453
                                ; BC length, A=1 simple string
13454
 
13455
; the only thing now is to consider if a slice is required.
13456
 
13457
        RST     18H             ; GET-CHAR puts character at CH_ADD in A
13458
        JP      L2A49           ; jump forward to SV-SLICE? to test for '('
13459
 
13460
; --------------------------------------------------------
13461
 
13462
; the branch was here with string and numeric arrays in runtime.
13463
 
13464
;; SV-ARRAYS
13465
L29AE:  INC     HL              ; step past
13466
        INC     HL              ; the total length
13467
        INC     HL              ; to address Number of dimensions.
13468
        LD      B,(HL)          ; transfer to B overwriting zero.
13469
        BIT     6,C             ; a numeric array ?
13470
        JR      Z,L29C0         ; forward to SV-PTR with numeric arrays
13471
 
13472
        DEC     B               ; ignore the final element of a string array
13473
                                ; the fixed string size.
13474
 
13475
        JR      Z,L29A1         ; back to SV-SIMPLE$ if result is zero as has
13476
                                ; been created with DIM a$(10) for instance
13477
                                ; and can be treated as a simple string.
13478
 
13479
; proceed with multi-dimensioned string arrays in runtime.
13480
 
13481
        EX      DE,HL           ; save pointer to dimensions in DE
13482
 
13483
        RST     18H             ; GET-CHAR looks at the BASIC line
13484
        CP      $28             ; is character '(' ?
13485
        JR      NZ,L2A20        ; to REPORT-3 if not
13486
                                ; 'Subscript wrong'
13487
 
13488
        EX      DE,HL           ; dimensions pointer to HL to synchronize
13489
                                ; with next instruction.
13490
 
13491
; runtime numeric arrays path rejoins here.
13492
 
13493
;; SV-PTR
13494
L29C0:  EX      DE,HL           ; save dimension pointer in DE
13495
        JR      L29E7           ; forward to SV-COUNT with true no of dims
13496
                                ; in B. As there is no initial comma the
13497
                                ; loop is entered at the midpoint.
13498
 
13499
; ----------------------------------------------------------
13500
; the dimension counting loop which is entered at mid-point.
13501
 
13502
;; SV-COMMA
13503
L29C3:  PUSH    HL              ; save counter
13504
 
13505
        RST     18H             ; GET-CHAR
13506
 
13507
        POP     HL              ; pop counter
13508
        CP      $2C             ; is character ',' ?
13509
        JR      Z,L29EA         ; forward to SV-LOOP if so
13510
 
13511
; in runtime the variable definition indicates a comma should appear here
13512
 
13513
        BIT     7,C             ; checking syntax ?
13514
        JR      Z,L2A20         ; forward to REPORT-3 if not
13515
                                ; 'Subscript error'
13516
 
13517
; proceed if checking syntax of an array?
13518
 
13519
        BIT     6,C             ; array of strings
13520
        JR      NZ,L29D8        ; forward to SV-CLOSE if so
13521
 
13522
; an array of numbers.
13523
 
13524
        CP      $29             ; is character ')' ?
13525
        JR      NZ,L2A12        ; forward to SV-RPT-C if not
13526
                                ; 'Nonsense in BASIC'
13527
 
13528
        RST     20H             ; NEXT-CHAR moves CH-ADD past the statement
13529
        RET                     ; return ->
13530
 
13531
; ---
13532
 
13533
; the branch was here with an array of strings.
13534
 
13535
;; SV-CLOSE
13536
L29D8:  CP      $29             ; as above ')' could follow the expression
13537
        JR      Z,L2A48         ; forward to SV-DIM if so
13538
 
13539
        CP      $CC             ; is it 'TO' ?
13540
        JR      NZ,L2A12        ; to SV-RPT-C with anything else
13541
                                ; 'Nonsense in BASIC'
13542
 
13543
; now backtrack CH_ADD to set up for slicing routine.
13544
; Note. in a BASIC line we can safely backtrack to a colour parameter.
13545
 
13546
;; SV-CH-ADD
13547
L29E0:  RST     18H             ; GET-CHAR
13548
        DEC     HL              ; backtrack HL
13549
        LD      ($5C5D),HL      ; to set CH_ADD up for slicing routine
13550
        JR      L2A45           ; forward to SV-SLICE and make a return
13551
                                ; when all slicing complete.
13552
 
13553
; ----------------------------------------
13554
; -> the mid-point entry point of the loop
13555
 
13556
;; SV-COUNT
13557
L29E7:  LD      HL,$0000        ; initialize data pointer to zero.
13558
 
13559
;; SV-LOOP
13560
L29EA:  PUSH    HL              ; save the data pointer.
13561
 
13562
        RST     20H             ; NEXT-CHAR in BASIC area points to an
13563
                                ; expression.
13564
 
13565
        POP     HL              ; restore the data pointer.
13566
        LD      A,C             ; transfer name/type to A.
13567
        CP      $C0             ; is it 11000000 ?
13568
                                ; Note. the letter component is absent if
13569
                                ; syntax checking.
13570
        JR      NZ,L29FB        ; forward to SV-MULT if not an array of
13571
                                ; strings.
13572
 
13573
; proceed to check string arrays during syntax.
13574
 
13575
        RST     18H             ; GET-CHAR
13576
        CP      $29             ; ')'  end of subscripts ?
13577
        JR      Z,L2A48         ; forward to SV-DIM to consider further slice
13578
 
13579
        CP      $CC             ; is it 'TO' ?
13580
        JR      Z,L29E0         ; back to SV-CH-ADD to consider a slice.
13581
                                ; (no need to repeat get-char at L29E0)
13582
 
13583
; if neither, then an expression is required so rejoin runtime loop ??
13584
; registers HL and DE only point to somewhere meaningful in runtime so
13585
; comments apply to that situation.
13586
 
13587
;; SV-MULT
13588
L29FB:  PUSH    BC              ; save dimension number.
13589
        PUSH    HL              ; push data pointer/rubbish.
13590
                                ; DE points to current dimension.
13591
        CALL    L2AEE           ; routine DE,(DE+1) gets next dimension in DE
13592
                                ; and HL points to it.
13593
        EX      (SP),HL         ; dim pointer to stack, data pointer to HL (*)
13594
        EX      DE,HL           ; data pointer to DE, dim size to HL.
13595
 
13596
        CALL    L2ACC           ; routine INT-EXP1 checks integer expression
13597
                                ; and gets result in BC in runtime.
13598
        JR      C,L2A20         ; to REPORT-3 if > HL
13599
                                ; 'Subscript out of range'
13600
 
13601
        DEC     BC              ; adjust returned result from 1-x to 0-x
13602
        CALL    L2AF4           ; routine GET-HL*DE multiplies data pointer by
13603
                                ; dimension size.
13604
        ADD     HL,BC           ; add the integer returned by expression.
13605
        POP     DE              ; pop the dimension pointer.                              ***
13606
        POP     BC              ; pop dimension counter.
13607
        DJNZ    L29C3           ; back to SV-COMMA if more dimensions
13608
                                ; Note. during syntax checking, unless there
13609
                                ; are more than 256 subscripts, the branch
13610
                                ; back to SV-COMMA is always taken.
13611
 
13612
        BIT     7,C             ; are we checking syntax ?
13613
                                ; then we've got a joker here.
13614
 
13615
;; SV-RPT-C
13616
L2A12:  JR      NZ,L2A7A        ; forward to SL-RPT-C if so
13617
                                ; 'Nonsense in BASIC'
13618
                                ; more than 256 subscripts in BASIC line.
13619
 
13620
; but in runtime the number of subscripts are at least the same as dims
13621
 
13622
        PUSH    HL              ; save data pointer.
13623
        BIT     6,C             ; is it a string array ?
13624
        JR      NZ,L2A2C        ; forward to SV-ELEM$ if so.
13625
 
13626
; a runtime numeric array subscript.
13627
 
13628
        LD      B,D             ; register DE has advanced past all dimensions
13629
        LD      C,E             ; and points to start of data in variable.
13630
                                ; transfer it to BC.
13631
 
13632
        RST     18H             ; GET-CHAR checks BASIC line
13633
        CP      $29             ; must be a ')' ?
13634
        JR      Z,L2A22         ; skip to SV-NUMBER if so
13635
 
13636
; else more subscripts in BASIC line than the variable definition.
13637
 
13638
;; REPORT-3
13639
L2A20:  RST     08H             ; ERROR-1
13640
        DEFB    $02             ; Error Report: Subscript wrong
13641
 
13642
; continue if subscripts matched the numeric array.
13643
 
13644
;; SV-NUMBER
13645
L2A22:  RST     20H             ; NEXT-CHAR moves CH_ADD to next statement
13646
                                ; - finished parsing.
13647
 
13648
        POP     HL              ; pop the data pointer.
13649
        LD      DE,$0005        ; each numeric element is 5 bytes.
13650
        CALL    L2AF4           ; routine GET-HL*DE multiplies.
13651
        ADD     HL,BC           ; now add to start of data in the variable.
13652
 
13653
        RET                     ; return with HL pointing at the numeric
13654
                                ; array subscript.                       ->
13655
 
13656
; ---------------------------------------------------------------
13657
 
13658
; the branch was here for string subscripts when the number of subscripts
13659
; in the BASIC line was one less than in variable definition.
13660
 
13661
;; SV-ELEM$
13662
L2A2C:  CALL    L2AEE           ; routine DE,(DE+1) gets final dimension
13663
                                ; the length of strings in this array.
13664
        EX      (SP),HL         ; start pointer to stack, data pointer to HL.
13665
        CALL    L2AF4           ; routine GET-HL*DE multiplies by element
13666
                                ; size.
13667
        POP     BC              ; the start of data pointer is added
13668
        ADD     HL,BC           ; in - now points to location before.
13669
        INC     HL              ; point to start of required string.
13670
        LD      B,D             ; transfer the length (final dimension size)
13671
        LD      C,E             ; from DE to BC.
13672
        EX      DE,HL           ; put start in DE.
13673
        CALL    L2AB1           ; routine STK-ST-0 stores the string parameters
13674
                                ; with A=0 - a slice or subscript.
13675
 
13676
; now check that there were no more subscripts in the BASIC line.
13677
 
13678
        RST     18H             ; GET-CHAR
13679
        CP      $29             ; is it ')' ?
13680
        JR      Z,L2A48         ; forward to SV-DIM to consider a separate
13681
                                ; subscript or/and a slice.
13682
 
13683
        CP      $2C             ; a comma is allowed if the final subscript
13684
                                ; is to be sliced e.g. a$(2,3,4 TO 6).
13685
        JR      NZ,L2A20        ; to REPORT-3 with anything else
13686
                                ; 'Subscript error'
13687
 
13688
;; SV-SLICE
13689
L2A45:  CALL    L2A52           ; routine SLICING slices the string.
13690
 
13691
; but a slice of a simple string can itself be sliced.
13692
 
13693
;; SV-DIM
13694
L2A48:  RST     20H             ; NEXT-CHAR
13695
 
13696
;; SV-SLICE?
13697
L2A49:  CP      $28             ; is character '(' ?
13698
        JR      Z,L2A45         ; loop back if so to SV-SLICE
13699
 
13700
        RES     6,(IY+$01)      ; update FLAGS  - Signal string result
13701
        RET                     ; and return.
13702
 
13703
; ---
13704
 
13705
; The above section deals with the flexible syntax allowed.
13706
; DIM a$(3,3,10) can be considered as two dimensional array of ten-character
13707
; strings or a 3-dimensional array of characters.
13708
; a$(1,1) will return a 10-character string as will a$(1,1,1 TO 10)
13709
; a$(1,1,1) will return a single character.
13710
; a$(1,1) (1 TO 6) is the same as a$(1,1,1 TO 6)
13711
; A slice can itself be sliced ad infinitum
13712
; b$ () () () () () () (2 TO 10) (2 TO 9) (3) is the same as b$(5)
13713
 
13714
 
13715
 
13716
; -------------------------
13717
; Handle slicing of strings
13718
; -------------------------
13719
; The syntax of string slicing is very natural and it is as well to reflect
13720
; on the permutations possible.
13721
; a$() and a$( TO ) indicate the entire string although just a$ would do
13722
; and would avoid coming here.
13723
; h$(16) indicates the single character at position 16.
13724
; a$( TO 32) indicates the first 32 characters.
13725
; a$(257 TO) indicates all except the first 256 characters.
13726
; a$(19000 TO 19999) indicates the thousand characters at position 19000.
13727
; Also a$(9 TO 5) returns a null string not an error.
13728
; This enables a$(2 TO) to return a null string if the passed string is
13729
; of length zero or 1.
13730
; A string expression in brackets can be sliced. e.g. (STR$ PI) (3 TO )
13731
; We arrived here from SCANNING with CH-ADD pointing to the initial '('
13732
; or from above.
13733
 
13734
;; SLICING
13735
L2A52:  CALL    L2530           ; routine SYNTAX-Z
13736
        CALL    NZ,L2BF1        ; routine STK-FETCH fetches parameters of
13737
                                ; string at runtime, start in DE, length
13738
                                ; in BC. This could be an array subscript.
13739
 
13740
        RST     20H             ; NEXT-CHAR
13741
        CP      $29             ; is it ')' ?     e.g. a$()
13742
        JR      Z,L2AAD         ; forward to SL-STORE to store entire string.
13743
 
13744
        PUSH    DE              ; else save start address of string
13745
 
13746
        XOR     A               ; clear accumulator to use as a running flag.
13747
        PUSH    AF              ; and save on stack before any branching.
13748
 
13749
        PUSH    BC              ; save length of string to be sliced.
13750
        LD      DE,$0001        ; default the start point to position 1.
13751
 
13752
        RST     18H             ; GET-CHAR
13753
 
13754
        POP     HL              ; pop length to HL as default end point
13755
                                ; and limit.
13756
 
13757
        CP      $CC             ; is it 'TO' ?    e.g. a$( TO 10000)
13758
        JR      Z,L2A81         ; to SL-SECOND to evaluate second parameter.
13759
 
13760
        POP     AF              ; pop the running flag.
13761
 
13762
        CALL    L2ACD           ; routine INT-EXP2 fetches first parameter.
13763
 
13764
        PUSH    AF              ; save flag (will be $FF if parameter>limit)
13765
 
13766
        LD      D,B             ; transfer the start
13767
        LD      E,C             ; to DE overwriting 0001.
13768
        PUSH    HL              ; save original length.
13769
 
13770
        RST     18H             ; GET-CHAR
13771
        POP     HL              ; pop the limit length.
13772
        CP      $CC             ; is it 'TO' after a start ?
13773
        JR      Z,L2A81         ; to SL-SECOND to evaluate second parameter
13774
 
13775
        CP      $29             ; is it ')' ?       e.g. a$(365)
13776
 
13777
;; SL-RPT-C
13778
L2A7A:  JP      NZ,L1C8A        ; jump to REPORT-C with anything else
13779
                                ; 'Nonsense in BASIC'
13780
 
13781
        LD      H,D             ; copy start
13782
        LD      L,E             ; to end - just a one character slice.
13783
        JR      L2A94           ; forward to SL-DEFINE.
13784
 
13785
; ---------------------
13786
 
13787
;; SL-SECOND
13788
L2A81:  PUSH    HL              ; save limit length.
13789
 
13790
        RST     20H             ; NEXT-CHAR
13791
 
13792
        POP     HL              ; pop the length.
13793
 
13794
        CP      $29             ; is character ')' ?        e.g. a$(7 TO )
13795
        JR      Z,L2A94         ; to SL-DEFINE using length as end point.
13796
 
13797
        POP     AF              ; else restore flag.
13798
        CALL    L2ACD           ; routine INT-EXP2 gets second expression.
13799
 
13800
        PUSH    AF              ; save the running flag.
13801
 
13802
        RST     18H             ; GET-CHAR
13803
 
13804
        LD      H,B             ; transfer second parameter
13805
        LD      L,C             ; to HL.              e.g. a$(42 to 99)
13806
        CP      $29             ; is character a ')' ?
13807
        JR      NZ,L2A7A        ; to SL-RPT-C if not
13808
                                ; 'Nonsense in BASIC'
13809
 
13810
; we now have start in DE and an end in HL.
13811
 
13812
;; SL-DEFINE
13813
L2A94:  POP     AF              ; pop the running flag.
13814
        EX      (SP),HL         ; put end point on stack, start address to HL
13815
        ADD     HL,DE           ; add address of string to the start point.
13816
        DEC     HL              ; point to first character of slice.
13817
        EX      (SP),HL         ; start address to stack, end point to HL (*)
13818
        AND     A               ; prepare to subtract.
13819
        SBC     HL,DE           ; subtract start point from end point.
13820
        LD      BC,$0000        ; default the length result to zero.
13821
        JR      C,L2AA8         ; forward to SL-OVER if start > end.
13822
 
13823
        INC     HL              ; increment the length for inclusive byte.
13824
 
13825
        AND     A               ; now test the running flag.
13826
        JP      M,L2A20         ; jump back to REPORT-3 if $FF.
13827
                                ; 'Subscript out of range'
13828
 
13829
        LD      B,H             ; transfer the length
13830
        LD      C,L             ; to BC.
13831
 
13832
;; SL-OVER
13833
L2AA8:  POP     DE              ; restore start address from machine stack ***
13834
        RES     6,(IY+$01)      ; update FLAGS - signal string result for
13835
                                ; syntax.
13836
 
13837
;; SL-STORE
13838
L2AAD:  CALL    L2530           ; routine SYNTAX-Z  (UNSTACK-Z?)
13839
        RET     Z               ; return if checking syntax.
13840
                                ; but continue to store the string in runtime.
13841
 
13842
; ------------------------------------
13843
; other than from above, this routine is called from STK-VAR to stack
13844
; a known string array element.
13845
; ------------------------------------
13846
 
13847
;; STK-ST-0
13848
L2AB1:  XOR     A               ; clear to signal a sliced string or element.
13849
 
13850
; -------------------------
13851
; this routine is called from chr$, scrn$ etc. to store a simple string result.
13852
; --------------------------
13853
 
13854
;; STK-STO-$
13855
L2AB2:  RES     6,(IY+$01)      ; update FLAGS - signal string result.
13856
                                ; and continue to store parameters of string.
13857
 
13858
; ---------------------------------------
13859
; Pass five registers to calculator stack
13860
; ---------------------------------------
13861
; This subroutine puts five registers on the calculator stack.
13862
 
13863
;; STK-STORE
13864
L2AB6:  PUSH    BC              ; save two registers
13865
        CALL    L33A9           ; routine TEST-5-SP checks room and puts 5
13866
                                ; in BC.
13867
        POP     BC              ; fetch the saved registers.
13868
        LD      HL,($5C65)      ; make HL point to first empty location STKEND
13869
        LD      (HL),A          ; place the 5 registers.
13870
        INC     HL              ;
13871
        LD      (HL),E          ;
13872
        INC     HL              ;
13873
        LD      (HL),D          ;
13874
        INC     HL              ;
13875
        LD      (HL),C          ;
13876
        INC     HL              ;
13877
        LD      (HL),B          ;
13878
        INC     HL              ;
13879
        LD      ($5C65),HL      ; update system variable STKEND.
13880
        RET                     ; and return.
13881
 
13882
; -------------------------------------------
13883
; Return result of evaluating next expression
13884
; -------------------------------------------
13885
; This clever routine is used to check and evaluate an integer expression
13886
; which is returned in BC, setting A to $FF, if greater than a limit supplied
13887
; in HL. It is used to check array subscripts, parameters of a string slice
13888
; and the arguments of the DIM command. In the latter case, the limit check
13889
; is not required and H is set to $FF. When checking optional string slice
13890
; parameters, it is entered at the second entry point so as not to disturb
13891
; the running flag A, which may be $00 or $FF from a previous invocation.
13892
 
13893
;; INT-EXP1
13894
L2ACC:  XOR     A               ; set result flag to zero.
13895
 
13896
; -> The entry point is here if A is used as a running flag.
13897
 
13898
;; INT-EXP2
13899
L2ACD:  PUSH    DE              ; preserve DE register throughout.
13900
        PUSH    HL              ; save the supplied limit.
13901
        PUSH    AF              ; save the flag.
13902
 
13903
        CALL    L1C82           ; routine EXPT-1NUM evaluates expression
13904
                                ; at CH_ADD returning if numeric result,
13905
                                ; with value on calculator stack.
13906
 
13907
        POP     AF              ; pop the flag.
13908
        CALL    L2530           ; routine SYNTAX-Z
13909
        JR      Z,L2AEB         ; forward to I-RESTORE if checking syntax so
13910
                                ; avoiding a comparison with supplied limit.
13911
 
13912
        PUSH    AF              ; save the flag.
13913
 
13914
        CALL    L1E99           ; routine FIND-INT2 fetches value from
13915
                                ; calculator stack to BC producing an error
13916
                                ; if too high.
13917
 
13918
        POP     DE              ; pop the flag to D.
13919
        LD      A,B             ; test value for zero and reject
13920
        OR      C               ; as arrays and strings begin at 1.
13921
        SCF                     ; set carry flag.
13922
        JR      Z,L2AE8         ; forward to I-CARRY if zero.
13923
 
13924
        POP     HL              ; restore the limit.
13925
        PUSH    HL              ; and save.
13926
        AND     A               ; prepare to subtract.
13927
        SBC     HL,BC           ; subtract value from limit.
13928
 
13929
;; I-CARRY
13930
L2AE8:  LD      A,D             ; move flag to accumulator $00 or $FF.
13931
        SBC     A,$00           ; will set to $FF if carry set.
13932
 
13933
;; I-RESTORE
13934
L2AEB:  POP     HL              ; restore the limit.
13935
        POP     DE              ; and DE register.
13936
        RET                     ; return.
13937
 
13938
 
13939
; -----------------------
13940
; LD DE,(DE+1) Subroutine
13941
; -----------------------
13942
; This routine just loads the DE register with the contents of the two
13943
; locations following the location addressed by DE.
13944
; It is used to step along the 16-bit dimension sizes in array definitions.
13945
; Note. Such code is made into subroutines to make programs easier to
13946
; write and it would use less space to include the five instructions in-line.
13947
; However, there are so many exchanges going on at the places this is invoked
13948
; that to implement it in-line would make the code hard to follow.
13949
; It probably had a zippier label though as the intention is to simplify the
13950
; program.
13951
 
13952
;; DE,(DE+1)
13953
L2AEE:  EX      DE,HL           ;
13954
        INC     HL              ;
13955
        LD      E,(HL)          ;
13956
        INC     HL              ;
13957
        LD      D,(HL)          ;
13958
        RET                     ;
13959
 
13960
; -------------------
13961
; HL=HL*DE Subroutine
13962
; -------------------
13963
; This routine calls the mathematical routine to multiply HL by DE in runtime.
13964
; It is called from STK-VAR and from DIM. In the latter case syntax is not
13965
; being checked so the entry point could have been at the second CALL
13966
; instruction to save a few clock-cycles.
13967
 
13968
;; GET-HL*DE
13969
L2AF4:  CALL    L2530           ; routine SYNTAX-Z.
13970
        RET     Z               ; return if checking syntax.
13971
 
13972
        CALL    L30A9           ; routine HL-HL*DE.
13973
        JP      C,L1F15         ; jump back to REPORT-4 if over 65535.
13974
 
13975
        RET                     ; else return with 16-bit result in HL.
13976
 
13977
; -----------------
13978
; THE 'LET' COMMAND
13979
; -----------------
13980
; Sinclair BASIC adheres to the ANSI-78 standard and a LET is required in
13981
; assignments e.g. LET a = 1  :   LET h$ = "hat".
13982
;
13983
; Long names may contain spaces but not colour controls (when assigned).
13984
; a substring can appear to the left of the equals sign.
13985
 
13986
; An earlier mathematician Lewis Carroll may have been pleased that
13987
; 10 LET Babies cannot manage crocodiles = Babies are illogical AND
13988
;    Nobody is despised who can manage a crocodile AND Illogical persons
13989
;    are despised
13990
; does not give the 'Nonsense..' error if the three variables exist.
13991
; I digress.
13992
 
13993
;; LET
13994
L2AFF:  LD      HL,($5C4D)      ; fetch system variable DEST to HL.
13995
        BIT     1,(IY+$37)      ; test FLAGX - handling a new variable ?
13996
        JR      Z,L2B66         ; forward to L-EXISTS if not.
13997
 
13998
; continue for a new variable. DEST points to start in BASIC line.
13999
; from the CLASS routines.
14000
 
14001
        LD      BC,$0005        ; assume numeric and assign an initial 5 bytes
14002
 
14003
;; L-EACH-CH
14004
L2B0B:  INC     BC              ; increase byte count for each relevant
14005
                                ; character
14006
 
14007
;; L-NO-SP
14008
L2B0C:  INC     HL              ; increase pointer.
14009
        LD      A,(HL)          ; fetch character.
14010
        CP      $20             ; is it a space ?
14011
        JR      Z,L2B0C         ; back to L-NO-SP is so.
14012
 
14013
        JR      NC,L2B1F        ; forward to L-TEST-CH if higher.
14014
 
14015
        CP      $10             ; is it $00 - $0F ?
14016
        JR      C,L2B29         ; forward to L-SPACES if so.
14017
 
14018
        CP      $16             ; is it $16 - $1F ?
14019
        JR      NC,L2B29        ; forward to L-SPACES if so.
14020
 
14021
; it was $10 - $15  so step over a colour code.
14022
 
14023
        INC     HL              ; increase pointer.
14024
        JR      L2B0C           ; loop back to L-NO-SP.
14025
 
14026
; ---
14027
 
14028
; the branch was to here if higher than space.
14029
 
14030
;; L-TEST-CH
14031
L2B1F:  CALL    L2C88           ; routine ALPHANUM sets carry if alphanumeric
14032
        JR      C,L2B0B         ; loop back to L-EACH-CH for more if so.
14033
 
14034
        CP      $24             ; is it '$' ?
14035
        JP      Z,L2BC0         ; jump forward if so, to L-NEW$
14036
                                ; with a new string.
14037
 
14038
;; L-SPACES
14039
L2B29:  LD      A,C             ; save length lo in A.
14040
        LD      HL,($5C59)      ; fetch E_LINE to HL.
14041
        DEC     HL              ; point to location before, the variables
14042
                                ; end-marker.
14043
        CALL    L1655           ; routine MAKE-ROOM creates BC spaces
14044
                                ; for name and numeric value.
14045
        INC     HL              ; advance to first new location.
14046
        INC     HL              ; then to second.
14047
        EX      DE,HL           ; set DE to second location.
14048
        PUSH    DE              ; save this pointer.
14049
        LD      HL,($5C4D)      ; reload HL with DEST.
14050
        DEC     DE              ; point to first.
14051
        SUB     $06             ; subtract six from length_lo.
14052
        LD      B,A             ; save count in B.
14053
        JR      Z,L2B4F         ; forward to L-SINGLE if it was just
14054
                                ; one character.
14055
 
14056
; HL points to start of variable name after 'LET' in BASIC line.
14057
 
14058
;; L-CHAR
14059
L2B3E:  INC     HL              ; increase pointer.
14060
        LD      A,(HL)          ; pick up character.
14061
        CP      $21             ; is it space or higher ?
14062
        JR      C,L2B3E         ; back to L-CHAR with space and less.
14063
 
14064
        OR      $20             ; make variable lower-case.
14065
        INC     DE              ; increase destination pointer.
14066
        LD      (DE),A          ; and load to edit line.
14067
        DJNZ    L2B3E           ; loop back to L-CHAR until B is zero.
14068
 
14069
        OR      $80             ; invert the last character.
14070
        LD      (DE),A          ; and overwrite that in edit line.
14071
 
14072
; now consider first character which has bit 6 set
14073
 
14074
        LD      A,$C0           ; set A 11000000 is xor mask for a long name.
14075
                                ; %101      is xor/or  result
14076
 
14077
; single character numerics rejoin here with %00000000 in mask.
14078
;                                            %011      will be xor/or result
14079
 
14080
;; L-SINGLE
14081
L2B4F:  LD      HL,($5C4D)      ; fetch DEST - HL addresses first character.
14082
        XOR     (HL)            ; apply variable type indicator mask (above).
14083
        OR      $20             ; make lowercase - set bit 5.
14084
        POP     HL              ; restore pointer to 2nd character.
14085
        CALL    L2BEA           ; routine L-FIRST puts A in first character.
14086
                                ; and returns with HL holding
14087
                                ; new E_LINE-1  the $80 vars end-marker.
14088
 
14089
;; L-NUMERIC
14090
L2B59:  PUSH    HL              ; save the pointer.
14091
 
14092
; the value of variable is deleted but remains after calculator stack.
14093
 
14094
        RST     28H             ;; FP-CALC
14095
        DEFB    $02             ;;delete      ; delete variable value
14096
        DEFB    $38             ;;end-calc
14097
 
14098
; DE (STKEND) points to start of value.
14099
 
14100
        POP     HL              ; restore the pointer.
14101
        LD      BC,$0005        ; start of number is five bytes before.
14102
        AND     A               ; prepare for true subtraction.
14103
        SBC     HL,BC           ; HL points to start of value.
14104
        JR      L2BA6           ; forward to L-ENTER  ==>
14105
 
14106
; ---
14107
 
14108
 
14109
; the jump was to here if the variable already existed.
14110
 
14111
;; L-EXISTS
14112
L2B66:  BIT     6,(IY+$01)      ; test FLAGS - numeric or string result ?
14113
        JR      Z,L2B72         ; skip forward to L-DELETE$   -*->
14114
                                ; if string result.
14115
 
14116
; A numeric variable could be simple or an array element.
14117
; They are treated the same and the old value is overwritten.
14118
 
14119
        LD      DE,$0006        ; six bytes forward points to loc past value.
14120
        ADD     HL,DE           ; add to start of number.
14121
        JR      L2B59           ; back to L-NUMERIC to overwrite value.
14122
 
14123
; ---
14124
 
14125
; -*-> the branch was here if a string existed.
14126
 
14127
;; L-DELETE$
14128
L2B72:  LD      HL,($5C4D)      ; fetch DEST to HL.
14129
                                ; (still set from first instruction)
14130
        LD      BC,($5C72)      ; fetch STRLEN to BC.
14131
        BIT     0,(IY+$37)      ; test FLAGX - handling a complete simple
14132
                                ; string ?
14133
        JR      NZ,L2BAF        ; forward to L-ADD$ if so.
14134
 
14135
; must be a string array or a slice in workspace.
14136
; Note. LET a$(3 TO 6) = h$   will assign "hat " if h$ = "hat"
14137
;                                  and    "hats" if h$ = "hatstand".
14138
;
14139
; This is known as Procrustean lengthening and shortening after a
14140
; character Procrustes in Greek legend who made travellers sleep in his bed,
14141
; cutting off their feet or stretching them so they fitted the bed perfectly.
14142
; The bloke was hatstand and slain by Theseus.
14143
 
14144
        LD      A,B             ; test if length
14145
        OR      C               ; is zero and
14146
        RET     Z               ; return if so.
14147
 
14148
        PUSH    HL              ; save pointer to start.
14149
 
14150
        RST     30H             ; BC-SPACES creates room.
14151
        PUSH    DE              ; save pointer to first new location.
14152
        PUSH    BC              ; and length            (*)
14153
        LD      D,H             ; set DE to point to last location.
14154
        LD      E,L             ;
14155
        INC     HL              ; set HL to next location.
14156
        LD      (HL),$20        ; place a space there.
14157
        LDDR                    ; copy bytes filling with spaces.
14158
 
14159
        PUSH    HL              ; save pointer to start.
14160
        CALL    L2BF1           ; routine STK-FETCH start to DE,
14161
                                ; length to BC.
14162
        POP     HL              ; restore the pointer.
14163
        EX      (SP),HL         ; (*) length to HL, pointer to stack.
14164
        AND     A               ; prepare for true subtraction.
14165
        SBC     HL,BC           ; subtract old length from new.
14166
        ADD     HL,BC           ; and add back.
14167
        JR      NC,L2B9B        ; forward if it fits to L-LENGTH.
14168
 
14169
        LD      B,H             ; otherwise set
14170
        LD      C,L             ; length to old length.
14171
                                ; "hatstand" becomes "hats"
14172
 
14173
;; L-LENGTH
14174
L2B9B:  EX      (SP),HL         ; (*) length to stack, pointer to HL.
14175
        EX      DE,HL           ; pointer to DE, start of string to HL.
14176
        LD      A,B             ; is the length zero ?
14177
        OR      C               ;
14178
        JR      Z,L2BA3         ; forward to L-IN-W/S if so
14179
                                ; leaving prepared spaces.
14180
 
14181
        LDIR                    ; else copy bytes overwriting some spaces.
14182
 
14183
;; L-IN-W/S
14184
L2BA3:  POP     BC              ; pop the new length.  (*)
14185
        POP     DE              ; pop pointer to new area.
14186
        POP     HL              ; pop pointer to variable in assignment.
14187
                                ; and continue copying from workspace
14188
                                ; to variables area.
14189
 
14190
; ==> branch here from  L-NUMERIC
14191
 
14192
;; L-ENTER
14193
L2BA6:  EX      DE,HL           ; exchange pointers HL=STKEND DE=end of vars.
14194
        LD      A,B             ; test the length
14195
        OR      C               ; and make a
14196
        RET     Z               ; return if zero (strings only).
14197
 
14198
        PUSH    DE              ; save start of destination.
14199
        LDIR                    ; copy bytes.
14200
        POP     HL              ; address the start.
14201
        RET                     ; and return.
14202
 
14203
; ---
14204
 
14205
; the branch was here from L-DELETE$ if an existing simple string.
14206
; register HL addresses start of string in variables area.
14207
 
14208
;; L-ADD$
14209
L2BAF:  DEC     HL              ; point to high byte of length.
14210
        DEC     HL              ; to low byte.
14211
        DEC     HL              ; to letter.
14212
        LD      A,(HL)          ; fetch masked letter to A.
14213
        PUSH    HL              ; save the pointer on stack.
14214
        PUSH    BC              ; save new length.
14215
        CALL    L2BC6           ; routine L-STRING adds new string at end
14216
                                ; of variables area.
14217
                                ; if no room we still have old one.
14218
        POP     BC              ; restore length.
14219
        POP     HL              ; restore start.
14220
        INC     BC              ; increase
14221
        INC     BC              ; length by three
14222
        INC     BC              ; to include character and length bytes.
14223
        JP      L19E8           ; jump to indirect exit via RECLAIM-2
14224
                                ; deleting old version and adjusting pointers.
14225
 
14226
; ---
14227
 
14228
; the jump was here with a new string variable.
14229
 
14230
;; L-NEW$
14231
L2BC0:  LD      A,$DF           ; indicator mask %11011111 for
14232
                                ;                %010xxxxx will be result
14233
        LD      HL,($5C4D)      ; address DEST first character.
14234
        AND     (HL)            ; combine mask with character.
14235
 
14236
;; L-STRING
14237
L2BC6:  PUSH    AF              ; save first character and mask.
14238
        CALL    L2BF1           ; routine STK-FETCH fetches parameters of
14239
                                ; the string.
14240
        EX      DE,HL           ; transfer start to HL.
14241
        ADD     HL,BC           ; add to length.
14242
        PUSH    BC              ; save the length.
14243
        DEC     HL              ; point to end of string.
14244
        LD      ($5C4D),HL      ; save pointer in DEST.
14245
                                ; (updated by POINTERS if in workspace)
14246
        INC     BC              ; extra byte for letter.
14247
        INC     BC              ; two bytes
14248
        INC     BC              ; for the length of string.
14249
        LD      HL,($5C59)      ; address E_LINE.
14250
        DEC     HL              ; now end of VARS area.
14251
        CALL    L1655           ; routine MAKE-ROOM makes room for string.
14252
                                ; updating pointers including DEST.
14253
        LD      HL,($5C4D)      ; pick up pointer to end of string from DEST.
14254
        POP     BC              ; restore length from stack.
14255
        PUSH    BC              ; and save again on stack.
14256
        INC     BC              ; add a byte.
14257
        LDDR                    ; copy bytes from end to start.
14258
        EX      DE,HL           ; HL addresses length low
14259
        INC     HL              ; increase to address high byte
14260
        POP     BC              ; restore length to BC
14261
        LD      (HL),B          ; insert high byte
14262
        DEC     HL              ; address low byte location
14263
        LD      (HL),C          ; insert that byte
14264
        POP     AF              ; restore character and mask
14265
 
14266
;; L-FIRST
14267
L2BEA:  DEC     HL              ; address variable name
14268
        LD      (HL),A          ; and insert character.
14269
        LD      HL,($5C59)      ; load HL with E_LINE.
14270
        DEC     HL              ; now end of VARS area.
14271
        RET                     ; return
14272
 
14273
; ------------------------------------
14274
; Get last value from calculator stack
14275
; ------------------------------------
14276
;
14277
;
14278
 
14279
;; STK-FETCH
14280
L2BF1:  LD      HL,($5C65)      ; STKEND
14281
        DEC     HL              ;
14282
        LD      B,(HL)          ;
14283
        DEC     HL              ;
14284
        LD      C,(HL)          ;
14285
        DEC     HL              ;
14286
        LD      D,(HL)          ;
14287
        DEC     HL              ;
14288
        LD      E,(HL)          ;
14289
        DEC     HL              ;
14290
        LD      A,(HL)          ;
14291
        LD      ($5C65),HL      ; STKEND
14292
        RET                     ;
14293
 
14294
; ------------------
14295
; Handle DIM command
14296
; ------------------
14297
; e.g. DIM a(2,3,4,7): DIM a$(32) : DIM b$(20,2,768) : DIM c$(20000)
14298
; the only limit to dimensions is memory so, for example,
14299
; DIM a(2,2,2,2,2,2,2,2,2,2,2,2,2) is possible and creates a multi-
14300
; dimensional array of zeros. String arrays are initialized to spaces.
14301
; It is not possible to erase an array, but it can be re-dimensioned to
14302
; a minimal size of 1, after use, to free up memory.
14303
 
14304
;; DIM
14305
L2C02:  CALL    L28B2           ; routine LOOK-VARS
14306
 
14307
;; D-RPORT-C
14308
L2C05:  JP      NZ,L1C8A        ; jump to REPORT-C if a long-name variable.
14309
                                ; DIM lottery numbers(49) doesn't work.
14310
 
14311
        CALL    L2530           ; routine SYNTAX-Z
14312
        JR      NZ,L2C15        ; forward to D-RUN in runtime.
14313
 
14314
        RES     6,C             ; signal 'numeric' array even if string as
14315
                                ; this simplifies the syntax checking.
14316
 
14317
        CALL    L2996           ; routine STK-VAR checks syntax.
14318
        CALL    L1BEE           ; routine CHECK-END performs early exit ->
14319
 
14320
; the branch was here in runtime.
14321
 
14322
;; D-RUN
14323
L2C15:  JR      C,L2C1F         ; skip to D-LETTER if variable did not exist.
14324
                                ; else reclaim the old one.
14325
 
14326
        PUSH    BC              ; save type in C.
14327
        CALL    L19B8           ; routine NEXT-ONE find following variable
14328
                                ; or position of $80 end-marker.
14329
        CALL    L19E8           ; routine RECLAIM-2 reclaims the
14330
                                ; space between.
14331
        POP     BC              ; pop the type.
14332
 
14333
;; D-LETTER
14334
L2C1F:  SET     7,C             ; signal array.
14335
        LD      B,$00           ; initialize dimensions to zero and
14336
        PUSH    BC              ; save with the type.
14337
        LD      HL,$0001        ; make elements one character presuming string
14338
        BIT     6,C             ; is it a string ?
14339
        JR      NZ,L2C2D        ; forward to D-SIZE if so.
14340
 
14341
        LD      L,$05           ; make elements 5 bytes as is numeric.
14342
 
14343
;; D-SIZE
14344
L2C2D:  EX      DE,HL           ; save the element size in DE.
14345
 
14346
; now enter a loop to parse each of the integers in the list.
14347
 
14348
;; D-NO-LOOP
14349
L2C2E:  RST     20H             ; NEXT-CHAR
14350
        LD      H,$FF           ; disable limit check by setting HL high
14351
        CALL    L2ACC           ; routine INT-EXP1
14352
        JP      C,L2A20         ; to REPORT-3 if > 65280 and then some
14353
                                ; 'Subscript out of range'
14354
 
14355
        POP     HL              ; pop dimension counter, array type
14356
        PUSH    BC              ; save dimension size                     ***
14357
        INC     H               ; increment the dimension counter
14358
        PUSH    HL              ; save the dimension counter
14359
        LD      H,B             ; transfer size
14360
        LD      L,C             ; to HL
14361
        CALL    L2AF4           ; routine GET-HL*DE multiplies dimension by
14362
                                ; running total of size required initially
14363
                                ; 1 or 5.
14364
        EX      DE,HL           ; save running total in DE
14365
 
14366
        RST     18H             ; GET-CHAR
14367
        CP      $2C             ; is it ',' ?
14368
        JR      Z,L2C2E         ; loop back to D-NO-LOOP until all dimensions
14369
                                ; have been considered
14370
 
14371
; when loop complete continue.
14372
 
14373
        CP      $29             ; is it ')' ?
14374
        JR      NZ,L2C05        ; to D-RPORT-C with anything else
14375
                                ; 'Nonsense in BASIC'
14376
 
14377
 
14378
        RST     20H             ; NEXT-CHAR advances to next statement/CR
14379
 
14380
        POP     BC              ; pop dimension counter/type
14381
        LD      A,C             ; type to A
14382
 
14383
; now calculate space required for array variable
14384
 
14385
        LD      L,B             ; dimensions to L since these require 16 bits
14386
                                ; then this value will be doubled
14387
        LD      H,$00           ; set high byte to zero
14388
 
14389
; another four bytes are required for letter(1), total length(2), number of
14390
; dimensions(1) but since we have yet to double allow for two
14391
 
14392
        INC     HL              ; increment
14393
        INC     HL              ; increment
14394
 
14395
        ADD     HL,HL           ; now double giving 4 + dimensions * 2
14396
 
14397
        ADD     HL,DE           ; add to space required for array contents
14398
 
14399
        JP      C,L1F15         ; to REPORT-4 if > 65535
14400
                                ; 'Out of memory'
14401
 
14402
        PUSH    DE              ; save data space
14403
        PUSH    BC              ; save dimensions/type
14404
        PUSH    HL              ; save total space
14405
        LD      B,H             ; total space
14406
        LD      C,L             ; to BC
14407
        LD      HL,($5C59)      ; address E_LINE - first location after
14408
                                ; variables area
14409
        DEC     HL              ; point to location before - the $80 end-marker
14410
        CALL    L1655           ; routine MAKE-ROOM creates the space if
14411
                                ; memory is available.
14412
 
14413
        INC     HL              ; point to first new location and
14414
        LD      (HL),A          ; store letter/type
14415
 
14416
        POP     BC              ; pop total space
14417
        DEC     BC              ; exclude name
14418
        DEC     BC              ; exclude the 16-bit
14419
        DEC     BC              ; counter itself
14420
        INC     HL              ; point to next location the 16-bit counter
14421
        LD      (HL),C          ; insert low byte
14422
        INC     HL              ; address next
14423
        LD      (HL),B          ; insert high byte
14424
 
14425
        POP     BC              ; pop the number of dimensions.
14426
        LD      A,B             ; dimensions to A
14427
        INC     HL              ; address next
14428
        LD      (HL),A          ; and insert "No. of dims"
14429
 
14430
        LD      H,D             ; transfer DE space + 1 from make-room
14431
        LD      L,E             ; to HL
14432
        DEC     DE              ; set DE to next location down.
14433
        LD      (HL),$00        ; presume numeric and insert a zero
14434
        BIT     6,C             ; test bit 6 of C. numeric or string ?
14435
        JR      Z,L2C7C         ; skip to DIM-CLEAR if numeric
14436
 
14437
        LD      (HL),$20        ; place a space character in HL
14438
 
14439
;; DIM-CLEAR
14440
L2C7C:  POP     BC              ; pop the data length
14441
 
14442
        LDDR                    ; LDDR sets to zeros or spaces
14443
 
14444
; The number of dimensions is still in A.
14445
; A loop is now entered to insert the size of each dimension that was pushed
14446
; during the D-NO-LOOP working downwards from position before start of data.
14447
 
14448
;; DIM-SIZES
14449
L2C7F:  POP     BC              ; pop a dimension size                    ***
14450
        LD      (HL),B          ; insert high byte at position
14451
        DEC     HL              ; next location down
14452
        LD      (HL),C          ; insert low byte
14453
        DEC     HL              ; next location down
14454
        DEC     A               ; decrement dimension counter
14455
        JR      NZ,L2C7F        ; back to DIM-SIZES until all done.
14456
 
14457
        RET                     ; return.
14458
 
14459
; -----------------------------
14460
; Check whether digit or letter
14461
; -----------------------------
14462
; This routine checks that the character in A is alphanumeric
14463
; returning with carry set if so.
14464
 
14465
;; ALPHANUM
14466
L2C88:  CALL    L2D1B           ; routine NUMERIC will reset carry if so.
14467
        CCF                     ; Complement Carry Flag
14468
        RET     C               ; Return if numeric else continue into
14469
                                ; next routine.
14470
 
14471
; This routine checks that the character in A is alphabetic
14472
 
14473
;; ALPHA
14474
L2C8D:  CP      $41             ; less than 'A' ?
14475
        CCF                     ; Complement Carry Flag
14476
        RET     NC              ; return if so
14477
 
14478
        CP      $5B             ; less than 'Z'+1 ?
14479
        RET     C               ; is within first range
14480
 
14481
        CP      $61             ; less than 'a' ?
14482
        CCF                     ; Complement Carry Flag
14483
        RET     NC              ; return if so.
14484
 
14485
        CP      $7B             ; less than 'z'+1 ?
14486
        RET                     ; carry set if within a-z.
14487
 
14488
; -------------------------
14489
; Decimal to floating point
14490
; -------------------------
14491
; This routine finds the floating point number represented by an expression
14492
; beginning with BIN, '.' or a digit.
14493
; Note that BIN need not have any '0's or '1's after it.
14494
; BIN is really just a notational symbol and not a function.
14495
 
14496
;; DEC-TO-FP
14497
L2C9B:  CP      $C4             ; 'BIN' token ?
14498
        JR      NZ,L2CB8        ; to NOT-BIN if not
14499
 
14500
        LD      DE,$0000        ; initialize 16 bit buffer register.
14501
 
14502
;; BIN-DIGIT
14503
L2CA2:  RST     20H             ; NEXT-CHAR
14504
        SUB     $31             ; '1'
14505
        ADC     A,$00           ; will be zero if '1' or '0'
14506
                                ; carry will be set if was '0'
14507
        JR      NZ,L2CB3        ; forward to BIN-END if result not zero
14508
 
14509
        EX      DE,HL           ; buffer to HL
14510
        CCF                     ; Carry now set if originally '1'
14511
        ADC     HL,HL           ; shift the carry into HL
14512
        JP      C,L31AD         ; to REPORT-6 if overflow - too many digits
14513
                                ; after first '1'. There can be an unlimited
14514
                                ; number of leading zeros.
14515
                                ; 'Number too big' - raise an error
14516
 
14517
        EX      DE,HL           ; save the buffer
14518
        JR      L2CA2           ; back to BIN-DIGIT for more digits
14519
 
14520
; ---
14521
 
14522
;; BIN-END
14523
L2CB3:  LD      B,D             ; transfer 16 bit buffer
14524
        LD      C,E             ; to BC register pair.
14525
        JP      L2D2B           ; JUMP to STACK-BC to put on calculator stack
14526
 
14527
; ---
14528
 
14529
; continue here with .1,  42, 3.14, 5., 2.3 E -4
14530
 
14531
;; NOT-BIN
14532
L2CB8:  CP      $2E             ; '.' - leading decimal point ?
14533
        JR      Z,L2CCB         ; skip to DECIMAL if so.
14534
 
14535
        CALL    L2D3B           ; routine INT-TO-FP to evaluate all digits
14536
                                ; This number 'x' is placed on stack.
14537
        CP      $2E             ; '.' - mid decimal point ?
14538
 
14539
        JR      NZ,L2CEB        ; to E-FORMAT if not to consider that format
14540
 
14541
        RST     20H             ; NEXT-CHAR
14542
        CALL    L2D1B           ; routine NUMERIC returns carry reset if 0-9
14543
 
14544
        JR      C,L2CEB         ; to E-FORMAT if not a digit e.g. '1.'
14545
 
14546
        JR      L2CD5           ; to DEC-STO-1 to add the decimal part to 'x'
14547
 
14548
; ---
14549
 
14550
; a leading decimal point has been found in a number.
14551
 
14552
;; DECIMAL
14553
L2CCB:  RST     20H             ; NEXT-CHAR
14554
        CALL    L2D1B           ; routine NUMERIC will reset carry if digit
14555
 
14556
;; DEC-RPT-C
14557
L2CCF:  JP      C,L1C8A         ; to REPORT-C if just a '.'
14558
                                ; raise 'Nonsense in BASIC'
14559
 
14560
; since there is no leading zero put one on the calculator stack.
14561
 
14562
        RST     28H             ;; FP-CALC
14563
        DEFB    $A0             ;;stk-zero  ; 0.
14564
        DEFB    $38             ;;end-calc
14565
 
14566
; If rejoining from earlier there will be a value 'x' on stack.
14567
; If continuing from above the value zero.
14568
; Now store 1 in mem-0.
14569
; Note. At each pass of the digit loop this will be divided by ten.
14570
 
14571
;; DEC-STO-1
14572
L2CD5:  RST     28H             ;; FP-CALC
14573
        DEFB    $A1             ;;stk-one   ;x or 0,1.
14574
        DEFB    $C0             ;;st-mem-0  ;x or 0,1.
14575
        DEFB    $02             ;;delete    ;x or 0.
14576
        DEFB    $38             ;;end-calc
14577
 
14578
 
14579
;; NXT-DGT-1
14580
L2CDA:  RST     18H             ; GET-CHAR
14581
        CALL    L2D22           ; routine STK-DIGIT stacks single digit 'd'
14582
        JR      C,L2CEB         ; exit to E-FORMAT when digits exhausted  >
14583
 
14584
 
14585
        RST     28H             ;; FP-CALC   ;x or 0,d.           first pass.
14586
        DEFB    $E0             ;;get-mem-0  ;x or 0,d,1.
14587
        DEFB    $A4             ;;stk-ten    ;x or 0,d,1,10.
14588
        DEFB    $05             ;;division   ;x or 0,d,1/10.
14589
        DEFB    $C0             ;;st-mem-0   ;x or 0,d,1/10.
14590
        DEFB    $04             ;;multiply   ;x or 0,d/10.
14591
        DEFB    $0F             ;;addition   ;x or 0 + d/10.
14592
        DEFB    $38             ;;end-calc   last value.
14593
 
14594
        RST     20H             ; NEXT-CHAR  moves to next character
14595
        JR      L2CDA           ; back to NXT-DGT-1
14596
 
14597
; ---
14598
 
14599
; although only the first pass is shown it can be seen that at each pass
14600
; the new less significant digit is multiplied by an increasingly smaller
14601
; factor (1/100, 1/1000, 1/10000 ... ) before being added to the previous
14602
; last value to form a new last value.
14603
 
14604
; Finally see if an exponent has been input.
14605
 
14606
;; E-FORMAT
14607
L2CEB:  CP      $45             ; is character 'E' ?
14608
        JR      Z,L2CF2         ; to SIGN-FLAG if so
14609
 
14610
        CP      $65             ; 'e' is acceptable as well.
14611
        RET     NZ              ; return as no exponent.
14612
 
14613
;; SIGN-FLAG
14614
L2CF2:  LD      B,$FF           ; initialize temporary sign byte to $FF
14615
 
14616
        RST     20H             ; NEXT-CHAR
14617
        CP      $2B             ; is character '+' ?
14618
        JR      Z,L2CFE         ; to SIGN-DONE
14619
 
14620
        CP      $2D             ; is character '-' ?
14621
        JR      NZ,L2CFF        ; to ST-E-PART as no sign
14622
 
14623
        INC     B               ; set sign to zero
14624
 
14625
; now consider digits of exponent.
14626
; Note. incidentally this is the only occasion in Spectrum BASIC when an
14627
; expression may not be used when a number is expected.
14628
 
14629
;; SIGN-DONE
14630
L2CFE:  RST     20H             ; NEXT-CHAR
14631
 
14632
;; ST-E-PART
14633
L2CFF:  CALL    L2D1B           ; routine NUMERIC
14634
        JR      C,L2CCF         ; to DEC-RPT-C if not
14635
                                ; raise 'Nonsense in BASIC'.
14636
 
14637
        PUSH    BC              ; save sign (in B)
14638
        CALL    L2D3B           ; routine INT-TO-FP places exponent on stack
14639
        CALL    L2DD5           ; routine FP-TO-A  transfers it to A
14640
        POP     BC              ; restore sign
14641
        JP      C,L31AD         ; to REPORT-6 if overflow (over 255)
14642
                                ; raise 'Number too big'.
14643
 
14644
        AND     A               ; set flags
14645
        JP      M,L31AD         ; to REPORT-6 if over '127'.
14646
                                ; raise 'Number too big'.
14647
                                ; 127 is still way too high and it is
14648
                                ; impossible to enter an exponent greater
14649
                                ; than 39 from the keyboard. The error gets
14650
                                ; raised later in E-TO-FP so two different
14651
                                ; error messages depending how high A is.
14652
 
14653
        INC     B               ; $FF to $00 or $00 to $01 - expendable now.
14654
        JR      Z,L2D18         ; forward to E-FP-JUMP if exponent positive
14655
 
14656
        NEG                     ; Negate the exponent.
14657
 
14658
;; E-FP-JUMP
14659
L2D18:  JP      L2D4F           ; JUMP forward to E-TO-FP to assign to
14660
                                ; last value x on stack x * 10 to power A
14661
                                ; a relative jump would have done.
14662
 
14663
; ---------------------
14664
; Check for valid digit
14665
; ---------------------
14666
; This routine checks that the ASCII character in A is numeric
14667
; returning with carry reset if so.
14668
 
14669
;; NUMERIC
14670
L2D1B:  CP      $30             ; '0'
14671
        RET     C               ; return if less than zero character.
14672
 
14673
        CP      $3A             ; The upper test is '9'
14674
        CCF                     ; Complement Carry Flag
14675
        RET                     ; Return - carry clear if character '0' - '9'
14676
 
14677
; -----------
14678
; Stack Digit
14679
; -----------
14680
; This subroutine is called from INT-TO-FP and DEC-TO-FP to stack a digit
14681
; on the calculator stack.
14682
 
14683
;; STK-DIGIT
14684
L2D22:  CALL    L2D1B           ; routine NUMERIC
14685
        RET     C               ; return if not numeric character
14686
 
14687
        SUB     $30             ; convert from ASCII to digit
14688
 
14689
; -----------------
14690
; Stack accumulator
14691
; -----------------
14692
;
14693
;
14694
 
14695
;; STACK-A
14696
L2D28:  LD      C,A             ; transfer to C
14697
        LD      B,$00           ; and make B zero
14698
 
14699
; ----------------------
14700
; Stack BC register pair
14701
; ----------------------
14702
;
14703
 
14704
;; STACK-BC
14705
L2D2B:  LD      IY,$5C3A        ; re-initialize ERR_NR
14706
 
14707
        XOR     A               ; clear to signal small integer
14708
        LD      E,A             ; place in E for sign
14709
        LD      D,C             ; LSB to D
14710
        LD      C,B             ; MSB to C
14711
        LD      B,A             ; last byte not used
14712
        CALL    L2AB6           ; routine STK-STORE
14713
 
14714
        RST     28H             ;; FP-CALC
14715
        DEFB    $38             ;;end-calc  make HL = STKEND-5
14716
 
14717
        AND     A               ; clear carry
14718
        RET                     ; before returning
14719
 
14720
; -------------------------
14721
; Integer to floating point
14722
; -------------------------
14723
; This routine places one or more digits found in a BASIC line
14724
; on the calculator stack multiplying the previous value by ten each time
14725
; before adding in the new digit to form a last value on calculator stack.
14726
 
14727
;; INT-TO-FP
14728
L2D3B:  PUSH    AF              ; save first character
14729
 
14730
        RST     28H             ;; FP-CALC
14731
        DEFB    $A0             ;;stk-zero    ; v=0. initial value
14732
        DEFB    $38             ;;end-calc
14733
 
14734
        POP     AF              ; fetch first character back.
14735
 
14736
;; NXT-DGT-2
14737
L2D40:  CALL    L2D22           ; routine STK-DIGIT puts 0-9 on stack
14738
        RET     C               ; will return when character is not numeric >
14739
 
14740
        RST     28H             ;; FP-CALC    ; v, d.
14741
        DEFB    $01             ;;exchange    ; d, v.
14742
        DEFB    $A4             ;;stk-ten     ; d, v, 10.
14743
        DEFB    $04             ;;multiply    ; d, v*10.
14744
        DEFB    $0F             ;;addition    ; d + v*10 = newvalue
14745
        DEFB    $38             ;;end-calc    ; v.
14746
 
14747
        CALL    L0074           ; routine CH-ADD+1 get next character
14748
        JR      L2D40           ; back to NXT-DGT-2 to process as a digit
14749
 
14750
 
14751
;*********************************
14752
;** Part 9. ARITHMETIC ROUTINES **
14753
;*********************************
14754
 
14755
; --------------------------
14756
; E-format to floating point
14757
; --------------------------
14758
; This subroutine is used by the PRINT-FP routine and the decimal to FP
14759
; routines to stack a number expressed in exponent format.
14760
; Note. Though not used by the ROM as such, it has also been set up as
14761
; a unary calculator literal but this will not work as the accumulator
14762
; is not available from within the calculator.
14763
 
14764
; on entry there is a value x on the calculator stack and an exponent of ten
14765
; in A.    The required value is x + 10 ^ A
14766
 
14767
;; e-to-fp
14768
;; E-TO-FP
14769
L2D4F:  RLCA                    ; this will set the          x.
14770
        RRCA                    ; carry if bit 7 is set
14771
 
14772
        JR      NC,L2D55        ; to E-SAVE  if positive.
14773
 
14774
        CPL                     ; make negative positive
14775
        INC     A               ; without altering carry.
14776
 
14777
;; E-SAVE
14778
L2D55:  PUSH    AF              ; save positive exp and sign in carry
14779
 
14780
        LD      HL,$5C92        ; address MEM-0
14781
 
14782
        CALL    L350B           ; routine FP-0/1
14783
                                ; places an integer zero, if no carry,
14784
                                ; else a one in mem-0 as a sign flag
14785
 
14786
        RST     28H             ;; FP-CALC
14787
        DEFB    $A4             ;;stk-ten                    x, 10.
14788
        DEFB    $38             ;;end-calc
14789
 
14790
        POP     AF              ; pop the exponent.
14791
 
14792
; now enter a loop
14793
 
14794
;; E-LOOP
14795
L2D60:  SRL     A               ; 0>76543210>C
14796
 
14797
        JR      NC,L2D71        ; forward to E-TST-END if no bit
14798
 
14799
        PUSH    AF              ; save shifted exponent.
14800
 
14801
        RST     28H             ;; FP-CALC
14802
        DEFB    $C1             ;;st-mem-1                   x, 10.
14803
        DEFB    $E0             ;;get-mem-0                  x, 10, (0/1).
14804
        DEFB    $00             ;;jump-true
14805
 
14806
        DEFB    $04             ;;to L2D6D, E-DIVSN
14807
 
14808
        DEFB    $04             ;;multiply                   x*10.
14809
        DEFB    $33             ;;jump
14810
 
14811
        DEFB    $02             ;;to L2D6E, E-FETCH
14812
 
14813
;; E-DIVSN
14814
L2D6D:  DEFB    $05             ;;division                   x/10.
14815
 
14816
;; E-FETCH
14817
L2D6E:  DEFB    $E1             ;;get-mem-1                  x/10 or x*10, 10.
14818
        DEFB    $38             ;;end-calc                   new x, 10.
14819
 
14820
        POP     AF              ; restore shifted exponent
14821
 
14822
; the loop branched to here with no carry
14823
 
14824
;; E-TST-END
14825
L2D71:  JR      Z,L2D7B         ; forward to E-END  if A emptied of bits
14826
 
14827
        PUSH    AF              ; re-save shifted exponent
14828
 
14829
        RST     28H             ;; FP-CALC
14830
        DEFB    $31             ;;duplicate                  new x, 10, 10.
14831
        DEFB    $04             ;;multiply                   new x, 100.
14832
        DEFB    $38             ;;end-calc
14833
 
14834
        POP     AF              ; restore shifted exponent
14835
        JR      L2D60           ; back to E-LOOP  until all bits done.
14836
 
14837
; ---
14838
 
14839
; although only the first pass is shown it can be seen that for each set bit
14840
; representing a power of two, x is multiplied or divided by the
14841
; corresponding power of ten.
14842
 
14843
;; E-END
14844
L2D7B:  RST     28H             ;; FP-CALC                   final x, factor.
14845
        DEFB    $02             ;;delete                     final x.
14846
        DEFB    $38             ;;end-calc                   x.
14847
 
14848
        RET                     ; return
14849
 
14850
 
14851
 
14852
 
14853
; -------------
14854
; Fetch integer
14855
; -------------
14856
; This routine is called by the mathematical routines - FP-TO-BC, PRINT-FP,
14857
; mult, re-stack and negate to fetch an integer from address HL.
14858
; HL points to the stack or a location in MEM and no deletion occurs.
14859
; If the number is negative then a similar process to that used in INT-STORE
14860
; is used to restore the twos complement number to normal in DE and a sign
14861
; in C.
14862
 
14863
;; INT-FETCH
14864
L2D7F:  INC     HL              ; skip zero indicator.
14865
        LD      C,(HL)          ; fetch sign to C
14866
        INC     HL              ; address low byte
14867
        LD      A,(HL)          ; fetch to A
14868
        XOR     C               ; two's complement
14869
        SUB     C               ;
14870
        LD      E,A             ; place in E
14871
        INC     HL              ; address high byte
14872
        LD      A,(HL)          ; fetch to A
14873
        ADC     A,C             ; two's complement
14874
        XOR     C               ;
14875
        LD      D,A             ; place in D
14876
        RET                     ; return
14877
 
14878
; ------------------------
14879
; Store a positive integer
14880
; ------------------------
14881
; This entry point is not used in this ROM but would
14882
; store any integer as positive.
14883
 
14884
;; p-int-sto
14885
L2D8C:  LD      C,$00           ; make sign byte positive and continue
14886
 
14887
; -------------
14888
; Store integer
14889
; -------------
14890
; this routine stores an integer in DE at address HL.
14891
; It is called from mult, truncate, negate and sgn.
14892
; The sign byte $00 +ve or $FF -ve is in C.
14893
; If negative, the number is stored in 2's complement form so that it is
14894
; ready to be added.
14895
 
14896
;; INT-STORE
14897
L2D8E:  PUSH    HL              ; preserve HL
14898
 
14899
        LD      (HL),$00        ; first byte zero shows integer not exponent
14900
        INC     HL              ;
14901
        LD      (HL),C          ; then store the sign byte
14902
        INC     HL              ;
14903
                                ; e.g.             +1             -1
14904
        LD      A,E             ; fetch low byte   00000001       00000001
14905
        XOR     C               ; xor sign         00000000   or  11111111
14906
                                ; gives            00000001   or  11111110
14907
        SUB     C               ; sub sign         00000000   or  11111111
14908
                                ; gives            00000001>0 or  11111111>C
14909
        LD      (HL),A          ; store 2's complement.
14910
        INC     HL              ;
14911
        LD      A,D             ; high byte        00000000       00000000
14912
        ADC     A,C             ; sign             00000000<0     11111111
14913
                                ; gives            00000000   or  00000000
14914
        XOR     C               ; xor sign         00000000       11111111
14915
        LD      (HL),A          ; store 2's complement.
14916
        INC     HL              ;
14917
        LD      (HL),$00        ; last byte always zero for integers.
14918
                                ; is not used and need not be looked at when
14919
                                ; testing for zero but comes into play should
14920
                                ; an integer be converted to fp.
14921
        POP     HL              ; restore HL
14922
        RET                     ; return.
14923
 
14924
 
14925
; -----------------------------
14926
; Floating point to BC register
14927
; -----------------------------
14928
; This routine gets a floating point number e.g. 127.4 from the calculator
14929
; stack to the BC register.
14930
 
14931
;; FP-TO-BC
14932
L2DA2:  RST     28H             ;; FP-CALC            set HL to
14933
        DEFB    $38             ;;end-calc            point to last value.
14934
 
14935
        LD      A,(HL)          ; get first of 5 bytes
14936
        AND     A               ; and test
14937
        JR      Z,L2DAD         ; forward to FP-DELETE if an integer
14938
 
14939
; The value is first rounded up and then converted to integer.
14940
 
14941
        RST     28H             ;; FP-CALC           x.
14942
        DEFB    $A2             ;;stk-half           x. 1/2.
14943
        DEFB    $0F             ;;addition           x + 1/2.
14944
        DEFB    $27             ;;int                int(x + .5)
14945
        DEFB    $38             ;;end-calc
14946
 
14947
; now delete but leave HL pointing at integer
14948
 
14949
;; FP-DELETE
14950
L2DAD:  RST     28H             ;; FP-CALC
14951
        DEFB    $02             ;;delete
14952
        DEFB    $38             ;;end-calc
14953
 
14954
        PUSH    HL              ; save pointer.
14955
        PUSH    DE              ; and STKEND.
14956
        EX      DE,HL           ; make HL point to exponent/zero indicator
14957
        LD      B,(HL)          ; indicator to B
14958
        CALL    L2D7F           ; routine INT-FETCH
14959
                                ; gets int in DE sign byte to C
14960
                                ; but meaningless values if a large integer
14961
 
14962
        XOR     A               ; clear A
14963
        SUB     B               ; subtract indicator byte setting carry
14964
                                ; if not a small integer.
14965
 
14966
        BIT     7,C             ; test a bit of the sign byte setting zero
14967
                                ; if positive.
14968
 
14969
        LD      B,D             ; transfer int
14970
        LD      C,E             ; to BC
14971
        LD      A,E             ; low byte to A as a useful return value.
14972
 
14973
        POP     DE              ; pop STKEND
14974
        POP     HL              ; and pointer to last value
14975
        RET                     ; return
14976
                                ; if carry is set then the number was too big.
14977
 
14978
; ------------
14979
; LOG(2^A)
14980
; ------------
14981
; This routine is used when printing floating point numbers to calculate
14982
; the number of digits before the decimal point.
14983
 
14984
; first convert a one-byte signed integer to its five byte form.
14985
 
14986
;; LOG(2^A)
14987
L2DC1:  LD      D,A             ; store a copy of A in D.
14988
        RLA                     ; test sign bit of A.
14989
        SBC     A,A             ; now $FF if negative or $00
14990
        LD      E,A             ; sign byte to E.
14991
        LD      C,A             ; and to C
14992
        XOR     A               ; clear A
14993
        LD      B,A             ; and B.
14994
        CALL    L2AB6           ; routine STK-STORE stacks number AEDCB
14995
 
14996
;  so 00 00 XX 00 00 (positive) or 00 FF XX FF 00 (negative).
14997
;  i.e. integer indicator, sign byte, low, high, unused.
14998
 
14999
; now multiply exponent by log to the base 10 of two.
15000
 
15001
        RST      28H            ;; FP-CALC
15002
 
15003
        DEFB    $34             ;;stk-data                      .30103 (log 2)
15004
        DEFB    $EF             ;;Exponent: $7F, Bytes: 4
15005
        DEFB    $1A,$20,$9A,$85 ;;
15006
        DEFB    $04             ;;multiply
15007
 
15008
        DEFB    $27             ;;int
15009
 
15010
        DEFB    $38             ;;end-calc
15011
 
15012
; -------------------
15013
; Floating point to A
15014
; -------------------
15015
; this routine collects a floating point number from the stack into the
15016
; accumulator returning carry set if not in range 0 - 255.
15017
; Not all the calling routines raise an error with overflow so no attempt
15018
; is made to produce an error report here.
15019
 
15020
;; FP-TO-A
15021
L2DD5:  CALL    L2DA2           ; routine FP-TO-BC returns with C in A also.
15022
        RET     C               ; return with carry set if > 65535, overflow
15023
 
15024
        PUSH    AF              ; save the value and flags
15025
        DEC     B               ; and test that
15026
        INC     B               ; the high byte is zero.
15027
        JR      Z,L2DE1         ; forward  FP-A-END if zero
15028
 
15029
; else there has been 8-bit overflow
15030
 
15031
        POP     AF              ; retrieve the value
15032
        SCF                     ; set carry flag to show overflow
15033
        RET                     ; and return.
15034
 
15035
; ---
15036
 
15037
;; FP-A-END
15038
L2DE1:  POP     AF              ; restore value and success flag and
15039
        RET                     ; return.
15040
 
15041
 
15042
; -----------------------------
15043
; Print a floating point number
15044
; -----------------------------
15045
; Not a trivial task.
15046
; Begin by considering whether to print a leading sign for negative numbers.
15047
 
15048
;; PRINT-FP
15049
L2DE3:  RST     28H             ;; FP-CALC
15050
        DEFB    $31             ;;duplicate
15051
        DEFB    $36             ;;less-0
15052
        DEFB    $00             ;;jump-true
15053
 
15054
        DEFB    $0B             ;;to L2DF2, PF-NEGTVE
15055
 
15056
        DEFB    $31             ;;duplicate
15057
        DEFB    $37             ;;greater-0
15058
        DEFB    $00             ;;jump-true
15059
 
15060
        DEFB    $0D             ;;to L2DF8, PF-POSTVE
15061
 
15062
; must be zero itself
15063
 
15064
        DEFB    $02             ;;delete
15065
        DEFB    $38             ;;end-calc
15066
 
15067
        LD      A,$30           ; prepare the character '0'
15068
 
15069
        RST     10H             ; PRINT-A
15070
        RET                     ; return.                 ->
15071
; ---
15072
 
15073
;; PF-NEGTVE
15074
L2DF2:  DEFB    $2A             ;;abs
15075
        DEFB    $38             ;;end-calc
15076
 
15077
        LD      A,$2D           ; the character '-'
15078
 
15079
        RST     10H             ; PRINT-A
15080
 
15081
; and continue to print the now positive number.
15082
 
15083
        RST     28H             ;; FP-CALC
15084
 
15085
;; PF-POSTVE
15086
L2DF8:  DEFB    $A0             ;;stk-zero     x,0.     begin by
15087
        DEFB    $C3             ;;st-mem-3     x,0.     clearing a temporary
15088
        DEFB    $C4             ;;st-mem-4     x,0.     output buffer to
15089
        DEFB    $C5             ;;st-mem-5     x,0.     fifteen zeros.
15090
        DEFB    $02             ;;delete       x.
15091
        DEFB    $38             ;;end-calc     x.
15092
 
15093
        EXX                     ; in case called from 'str$' then save the
15094
        PUSH    HL              ; pointer to whatever comes after
15095
        EXX                     ; str$ as H'L' will be used.
15096
 
15097
; now enter a loop?
15098
 
15099
;; PF-LOOP
15100
L2E01:  RST     28H             ;; FP-CALC
15101
        DEFB    $31             ;;duplicate    x,x.
15102
        DEFB    $27             ;;int          x,int x.
15103
        DEFB    $C2             ;;st-mem-2     x,int x.
15104
        DEFB    $03             ;;subtract     x-int x.     fractional part.
15105
        DEFB    $E2             ;;get-mem-2    x-int x, int x.
15106
        DEFB    $01             ;;exchange     int x, x-int x.
15107
        DEFB    $C2             ;;st-mem-2     int x, x-int x.
15108
        DEFB    $02             ;;delete       int x.
15109
        DEFB    $38             ;;end-calc     int x.
15110
                                ;
15111
                                ; mem-2 holds the fractional part.
15112
 
15113
; HL points to last value int x
15114
 
15115
        LD      A,(HL)          ; fetch exponent of int x.
15116
        AND     A               ; test
15117
        JR      NZ,L2E56        ; forward to PF-LARGE if a large integer
15118
                                ; > 65535
15119
 
15120
; continue with small positive integer components in range 0 - 65535
15121
; if original number was say .999 then this integer component is zero.
15122
 
15123
        CALL    L2D7F           ; routine INT-FETCH gets x in DE
15124
                                ; (but x is not deleted)
15125
 
15126
        LD      B,$10           ; set B, bit counter, to 16d
15127
 
15128
        LD      A,D             ; test if
15129
        AND     A               ; high byte is zero
15130
        JR      NZ,L2E1E        ; forward to PF-SAVE if 16-bit integer.
15131
 
15132
; and continue with integer in range 0 - 255.
15133
 
15134
        OR      E               ; test the low byte for zero
15135
                                ; i.e. originally just point something or other.
15136
        JR      Z,L2E24         ; forward if so to PF-SMALL
15137
 
15138
;
15139
 
15140
        LD      D,E             ; transfer E to D
15141
        LD      B,$08           ; and reduce the bit counter to 8.
15142
 
15143
;; PF-SAVE
15144
L2E1E:  PUSH    DE              ; save the part before decimal point.
15145
        EXX                     ;
15146
        POP     DE              ; and pop in into D'E'
15147
        EXX                     ;
15148
        JR      L2E7B           ; forward to PF-BITS
15149
 
15150
; ---------------------
15151
 
15152
; the branch was here when 'int x' was found to be zero as in say 0.5.
15153
; The zero has been fetched from the calculator stack but not deleted and
15154
; this should occur now. This omission leaves the stack unbalanced and while
15155
; that causes no problems with a simple PRINT statement, it will if str$ is
15156
; being used in an expression e.g. "2" + STR$ 0.5 gives the result "0.5"
15157
; instead of the expected result "20.5".
15158
; credit Tony Stratton, 1982.
15159
; A DEFB 02 delete is required immediately on using the calculator.
15160
 
15161
;; PF-SMALL
15162
L2E24:  RST     28H             ;; FP-CALC       int x = 0.
15163
L2E25:  DEFB    $E2             ;;get-mem-2      int x = 0, x-int x.
15164
        DEFB    $38             ;;end-calc
15165
 
15166
        LD      A,(HL)          ; fetch exponent of positive fractional number
15167
        SUB     $7E             ; subtract
15168
 
15169
        CALL    L2DC1           ; routine LOG(2^A) calculates leading digits.
15170
 
15171
        LD      D,A             ; transfer count to D
15172
        LD      A,($5CAC)       ; fetch total MEM-5-1
15173
        SUB     D               ;
15174
        LD      ($5CAC),A       ; MEM-5-1
15175
        LD      A,D             ;
15176
        CALL    L2D4F           ; routine E-TO-FP
15177
 
15178
        RST     28H             ;; FP-CALC
15179
        DEFB    $31             ;;duplicate
15180
        DEFB    $27             ;;int
15181
        DEFB    $C1             ;;st-mem-1
15182
        DEFB    $03             ;;subtract
15183
        DEFB    $E1             ;;get-mem-1
15184
        DEFB    $38             ;;end-calc
15185
 
15186
        CALL    L2DD5           ; routine FP-TO-A
15187
 
15188
        PUSH    HL              ; save HL
15189
        LD      ($5CA1),A       ; MEM-3-1
15190
        DEC     A               ;
15191
        RLA                     ;
15192
        SBC     A,A             ;
15193
        INC     A               ;
15194
 
15195
        LD      HL,$5CAB        ; address MEM-5-1 leading digit counter
15196
        LD      (HL),A          ; store counter
15197
        INC     HL              ; address MEM-5-2 total digits
15198
        ADD     A,(HL)          ; add counter to contents
15199
        LD      (HL),A          ; and store updated value
15200
        POP     HL              ; restore HL
15201
 
15202
        JP      L2ECF           ; JUMP forward to PF-FRACTN
15203
 
15204
; ---
15205
 
15206
; Note. while it would be pedantic to comment on every occasion a JP
15207
; instruction could be replaced with a JR instruction, this applies to the
15208
; above, which is useful if you wish to correct the unbalanced stack error
15209
; by inserting a 'DEFB 02 delete' at L2E25, and maintain main addresses.
15210
 
15211
; the branch was here with a large positive integer > 65535 e.g. 123456789
15212
; the accumulator holds the exponent.
15213
 
15214
;; PF-LARGE
15215
L2E56:  SUB     $80             ; make exponent positive
15216
        CP      $1C             ; compare to 28
15217
        JR      C,L2E6F         ; to PF-MEDIUM if integer <= 2^27
15218
 
15219
        CALL    L2DC1           ; routine LOG(2^A)
15220
        SUB     $07             ;
15221
        LD      B,A             ;
15222
        LD      HL,$5CAC        ; address MEM-5-1 the leading digits counter.
15223
        ADD     A,(HL)          ; add A to contents
15224
        LD      (HL),A          ; store updated value.
15225
        LD      A,B             ;
15226
        NEG                     ; negate
15227
        CALL    L2D4F           ; routine E-TO-FP
15228
        JR      L2E01           ; back to PF-LOOP
15229
 
15230
; ----------------------------
15231
 
15232
;; PF-MEDIUM
15233
L2E6F:  EX      DE,HL           ;
15234
        CALL    L2FBA           ; routine FETCH-TWO
15235
        EXX                     ;
15236
        SET     7,D             ;
15237
        LD      A,L             ;
15238
        EXX                     ;
15239
        SUB     $80             ;
15240
        LD      B,A             ;
15241
 
15242
; the branch was here to handle bits in DE with 8 or 16 in B  if small int
15243
; and integer in D'E', 6 nibbles will accommodate 065535 but routine does
15244
; 32-bit numbers as well from above
15245
 
15246
;; PF-BITS
15247
L2E7B:  SLA     E               ;  C
15248
        RL      D               ;  C
15249
        EXX                     ;
15250
        RL      E               ;  C
15251
        RL      D               ;  C
15252
        EXX                     ;
15253
 
15254
        LD      HL,$5CAA        ; set HL to mem-4-5th last byte of buffer
15255
        LD      C,$05           ; set byte count to 5 -  10 nibbles
15256
 
15257
;; PF-BYTES
15258
L2E8A:  LD      A,(HL)          ; fetch 0 or prev value
15259
        ADC     A,A             ; shift left add in carry    C
15260
 
15261
        DAA                     ; Decimal Adjust Accumulator.
15262
                                ; if greater than 9 then the left hand
15263
                                ; nibble is incremented. If greater than
15264
                                ; 99 then adjusted and carry set.
15265
                                ; so if we'd built up 7 and a carry came in
15266
                                ;      0000 0111 < C
15267
                                ;      0000 1111
15268
                                ; daa     1 0101  which is 15 in BCD
15269
 
15270
        LD      (HL),A          ; put back
15271
        DEC     HL              ; work down thru mem 4
15272
        DEC     C               ; decrease the 5 counter.
15273
        JR      NZ,L2E8A        ; back to PF-BYTES until the ten nibbles rolled
15274
 
15275
        DJNZ    L2E7B           ; back to PF-BITS until 8 or 16 (or 32) done
15276
 
15277
; at most 9 digits for 32-bit number will have been loaded with digits
15278
; each of the 9 nibbles in mem 4 is placed into ten bytes in mem-3 and mem 4
15279
; unless the nibble is zero as the buffer is already zero.
15280
; ( or in the case of mem-5 will become zero as a result of RLD instruction )
15281
 
15282
        XOR     A               ; clear to accept
15283
        LD      HL,$5CA6        ; address MEM-4-0 byte destination.
15284
        LD      DE,$5CA1        ; address MEM-3-0 nibble source.
15285
        LD      B,$09           ; the count is 9 (not ten) as the first
15286
                                ; nibble is known to be blank.
15287
 
15288
        RLD                     ; shift RH nibble to left in (HL)
15289
                                ;    A           (HL)
15290
                                ; 0000 0000 < 0000 3210
15291
                                ; 0000 0000   3210 0000
15292
                                ; A picks up the blank nibble
15293
 
15294
 
15295
        LD      C,$FF           ; set a flag to indicate when a significant
15296
                                ; digit has been encountered.
15297
 
15298
;; PF-DIGITS
15299
L2EA1:  RLD                     ; pick up leftmost nibble from (HL)
15300
                                ;    A           (HL)
15301
                                ; 0000 0000 < 7654 3210
15302
                                ; 0000 7654   3210 0000
15303
 
15304
 
15305
        JR      NZ,L2EA9        ; to PF-INSERT if non-zero value picked up.
15306
 
15307
        DEC     C               ; test
15308
        INC     C               ; flag
15309
        JR      NZ,L2EB3        ; skip forward to PF-TEST-2 if flag still $FF
15310
                                ; indicating this is a leading zero.
15311
 
15312
; but if the zero is a significant digit e.g. 10 then include in digit totals.
15313
; the path for non-zero digits rejoins here.
15314
 
15315
;; PF-INSERT
15316
L2EA9:  LD      (DE),A          ; insert digit at destination
15317
        INC     DE              ; increase the destination pointer
15318
        INC     (IY+$71)        ; increment MEM-5-1st  digit counter
15319
        INC     (IY+$72)        ; increment MEM-5-2nd  leading digit counter
15320
        LD      C,$00           ; set flag to zero indicating that any
15321
                                ; subsequent zeros are significant and not
15322
                                ; leading.
15323
 
15324
;; PF-TEST-2
15325
L2EB3:  BIT     0,B             ; test if the nibble count is even
15326
        JR      Z,L2EB8         ; skip to PF-ALL-9 if so to deal with the
15327
                                ; other nibble in the same byte
15328
 
15329
        INC     HL              ; point to next source byte if not
15330
 
15331
;; PF-ALL-9
15332
L2EB8:  DJNZ    L2EA1           ; decrement the nibble count, back to PF-DIGITS
15333
                                ; if all nine not done.
15334
 
15335
; For 8-bit integers there will be at most 3 digits.
15336
; For 16-bit integers there will be at most 5 digits.
15337
; but for larger integers there could be nine leading digits.
15338
; if nine digits complete then the last one is rounded up as the number will
15339
; be printed using E-format notation
15340
 
15341
        LD      A,($5CAB)       ; fetch digit count from MEM-5-1st
15342
        SUB     $09             ; subtract 9 - max possible
15343
        JR      C,L2ECB         ; forward if less to PF-MORE
15344
 
15345
        DEC     (IY+$71)        ; decrement digit counter MEM-5-1st to 8
15346
        LD      A,$04           ; load A with the value 4.
15347
        CP      (IY+$6F)        ; compare with MEM-4-4th - the ninth digit
15348
        JR      L2F0C           ; forward to PF-ROUND
15349
                                ; to consider rounding.
15350
 
15351
; ---------------------------------------
15352
 
15353
; now delete int x from calculator stack and fetch fractional part.
15354
 
15355
;; PF-MORE
15356
L2ECB:  RST     28H             ;; FP-CALC        int x.
15357
        DEFB    $02             ;;delete          .
15358
        DEFB    $E2             ;;get-mem-2       x - int x = f.
15359
        DEFB    $38             ;;end-calc        f.
15360
 
15361
;; PF-FRACTN
15362
L2ECF:  EX      DE,HL           ;
15363
        CALL    L2FBA           ; routine FETCH-TWO
15364
        EXX                     ;
15365
        LD      A,$80           ;
15366
        SUB     L               ;
15367
        LD      L,$00           ;
15368
        SET     7,D             ;
15369
        EXX                     ;
15370
        CALL    L2FDD           ; routine SHIFT-FP
15371
 
15372
;; PF-FRN-LP
15373
L2EDF:  LD      A,(IY+$71)      ; MEM-5-1st
15374
        CP      $08             ;
15375
        JR      C,L2EEC         ; to PF-FR-DGT
15376
 
15377
        EXX                     ;
15378
        RL      D               ;
15379
        EXX                     ;
15380
        JR      L2F0C           ; to PF-ROUND
15381
 
15382
; ---
15383
 
15384
;; PF-FR-DGT
15385
L2EEC:  LD      BC,$0200        ;
15386
 
15387
;; PF-FR-EXX
15388
L2EEF:  LD      A,E             ;
15389
        CALL    L2F8B           ; routine CA-10*A+C
15390
        LD      E,A             ;
15391
        LD      A,D             ;
15392
        CALL    L2F8B           ; routine CA-10*A+C
15393
        LD      D,A             ;
15394
        PUSH    BC              ;
15395
        EXX                     ;
15396
        POP     BC              ;
15397
        DJNZ    L2EEF           ; to PF-FR-EXX
15398
 
15399
        LD      HL,$5CA1        ; MEM-3
15400
        LD      A,C             ;
15401
        LD      C,(IY+$71)      ; MEM-5-1st
15402
        ADD     HL,BC           ;
15403
        LD      (HL),A          ;
15404
        INC     (IY+$71)        ; MEM-5-1st
15405
        JR      L2EDF           ; to PF-FRN-LP
15406
 
15407
; ----------------
15408
 
15409
; 1) with 9 digits but 8 in mem-5-1 and A holding 4, carry set if rounding up.
15410
; e.g.
15411
;      999999999 is printed as 1E+9
15412
;      100000001 is printed as 1E+8
15413
;      100000009 is printed as 1.0000001E+8
15414
 
15415
;; PF-ROUND
15416
L2F0C:  PUSH    AF              ; save A and flags
15417
        LD      HL,$5CA1        ; address MEM-3 start of digits
15418
        LD      C,(IY+$71)      ; MEM-5-1st No. of digits to C
15419
        LD      B,$00           ; prepare to add
15420
        ADD     HL,BC           ; address last digit + 1
15421
        LD      B,C             ; No. of digits to B counter
15422
        POP     AF              ; restore A and carry flag from comparison.
15423
 
15424
;; PF-RND-LP
15425
L2F18:  DEC     HL              ; address digit at rounding position.
15426
        LD      A,(HL)          ; fetch it
15427
        ADC     A,$00           ; add carry from the comparison
15428
        LD      (HL),A          ; put back result even if $0A.
15429
        AND     A               ; test A
15430
        JR      Z,L2F25         ; skip to PF-R-BACK if ZERO?
15431
 
15432
        CP      $0A             ; compare to 'ten' - overflow
15433
        CCF                     ; complement carry flag so that set if ten.
15434
        JR      NC,L2F2D        ; forward to PF-COUNT with 1 - 9.
15435
 
15436
;; PF-R-BACK
15437
L2F25:  DJNZ    L2F18           ; loop back to PF-RND-LP
15438
 
15439
; if B counts down to zero then we've rounded right back as in 999999995.
15440
; and the first 8 locations all hold $0A.
15441
 
15442
 
15443
        LD      (HL),$01        ; load first location with digit 1.
15444
        INC     B               ; make B hold 1 also.
15445
                                ; could save an instruction byte here.
15446
        INC     (IY+$72)        ; make MEM-5-2nd hold 1.
15447
                                ; and proceed to initialize total digits to 1.
15448
 
15449
;; PF-COUNT
15450
L2F2D:  LD      (IY+$71),B      ; MEM-5-1st
15451
 
15452
; now balance the calculator stack by deleting  it
15453
 
15454
        RST     28H             ;; FP-CALC
15455
        DEFB    $02             ;;delete
15456
        DEFB    $38             ;;end-calc
15457
 
15458
; note if used from str$ then other values may be on the calculator stack.
15459
; we can also restore the next literal pointer from its position on the
15460
; machine stack.
15461
 
15462
        EXX                     ;
15463
        POP     HL              ; restore next literal pointer.
15464
        EXX                     ;
15465
 
15466
        LD      BC,($5CAB)      ; set C to MEM-5-1st digit counter.
15467
                                ; set B to MEM-5-2nd leading digit counter.
15468
        LD      HL,$5CA1        ; set HL to start of digits at MEM-3-1
15469
        LD      A,B             ;
15470
        CP      $09             ;
15471
        JR      C,L2F46         ; to PF-NOT-E
15472
 
15473
        CP      $FC             ;
15474
        JR      C,L2F6C         ; to PF-E-FRMT
15475
 
15476
;; PF-NOT-E
15477
L2F46:  AND     A               ; test for zero leading digits as in .123
15478
 
15479
        CALL    Z,L15EF         ; routine OUT-CODE prints a zero e.g. 0.123
15480
 
15481
;; PF-E-SBRN
15482
L2F4A:  XOR     A               ;
15483
        SUB     B               ;
15484
        JP      M,L2F52         ; skip forward to PF-OUT-LP if originally +ve
15485
 
15486
        LD      B,A             ; else negative count now +ve
15487
        JR      L2F5E           ; forward to PF-DC-OUT       ->
15488
 
15489
; ---
15490
 
15491
;; PF-OUT-LP
15492
L2F52:  LD      A,C             ; fetch total digit count
15493
        AND     A               ; test for zero
15494
        JR      Z,L2F59         ; forward to PF-OUT-DT if so
15495
 
15496
        LD      A,(HL)          ; fetch digit
15497
        INC     HL              ; address next digit
15498
        DEC     C               ; decrease total digit counter
15499
 
15500
;; PF-OUT-DT
15501
L2F59:  CALL    L15EF           ; routine OUT-CODE outputs it.
15502
        DJNZ    L2F52           ; loop back to PF-OUT-LP until B leading
15503
                                ; digits output.
15504
 
15505
;; PF-DC-OUT
15506
L2F5E:  LD      A,C             ; fetch total digits and
15507
        AND     A               ; test if also zero
15508
        RET     Z               ; return if so              -->
15509
 
15510
;
15511
 
15512
        INC     B               ; increment B
15513
        LD      A,$2E           ; prepare the character '.'
15514
 
15515
;; PF-DEC-0S
15516
L2F64:  RST     10H             ; PRINT-A outputs the character '.' or '0'
15517
 
15518
        LD      A,$30           ; prepare the character '0'
15519
                                ; (for cases like .000012345678)
15520
        DJNZ    L2F64           ; loop back to PF-DEC-0S for B times.
15521
 
15522
        LD      B,C             ; load B with now trailing digit counter.
15523
        JR      L2F52           ; back to PF-OUT-LP
15524
 
15525
; ---------------------------------
15526
 
15527
; the branch was here for E-format printing e.g. 123456789 => 1.2345679e+8
15528
 
15529
;; PF-E-FRMT
15530
L2F6C:  LD      D,B             ; counter to D
15531
        DEC     D               ; decrement
15532
        LD      B,$01           ; load B with 1.
15533
 
15534
        CALL    L2F4A           ; routine PF-E-SBRN above
15535
 
15536
        LD      A,$45           ; prepare character 'e'
15537
        RST     10H             ; PRINT-A
15538
 
15539
        LD      C,D             ; exponent to C
15540
        LD      A,C             ; and to A
15541
        AND     A               ; test exponent
15542
        JP      P,L2F83         ; to PF-E-POS if positive
15543
 
15544
        NEG                     ; negate
15545
        LD      C,A             ; positive exponent to C
15546
        LD      A,$2D           ; prepare character '-'
15547
        JR      L2F85           ; skip to PF-E-SIGN
15548
 
15549
; ---
15550
 
15551
;; PF-E-POS
15552
L2F83:  LD      A,$2B           ; prepare character '+'
15553
 
15554
;; PF-E-SIGN
15555
L2F85:  RST     10H             ; PRINT-A outputs the sign
15556
 
15557
        LD      B,$00           ; make the high byte zero.
15558
        JP      L1A1B           ; exit via OUT-NUM-1 to print exponent in BC
15559
 
15560
; ------------------------------
15561
; Handle printing floating point
15562
; ------------------------------
15563
; This subroutine is called twice from above when printing floating-point
15564
; numbers. It returns 10*A +C in registers C and A
15565
 
15566
;; CA-10*A+C
15567
L2F8B:  PUSH    DE              ; preserve DE.
15568
        LD      L,A             ; transfer A to L
15569
        LD      H,$00           ; zero high byte.
15570
        LD      E,L             ; copy HL
15571
        LD      D,H             ; to DE.
15572
        ADD     HL,HL           ; double (*2)
15573
        ADD     HL,HL           ; double (*4)
15574
        ADD     HL,DE           ; add DE (*5)
15575
        ADD     HL,HL           ; double (*10)
15576
        LD      E,C             ; copy C to E    (D is 0)
15577
        ADD     HL,DE           ; and add to give required result.
15578
        LD      C,H             ; transfer to
15579
        LD      A,L             ; destination registers.
15580
        POP     DE              ; restore DE
15581
        RET                     ; return with result.
15582
 
15583
; --------------
15584
; Prepare to add
15585
; --------------
15586
; This routine is called twice by addition to prepare the two numbers. The
15587
; exponent is picked up in A and the location made zero. Then the sign bit
15588
; is tested before being set to the implied state. Negative numbers are twos
15589
; complemented.
15590
 
15591
;; PREP-ADD
15592
L2F9B:  LD      A,(HL)          ; pick up exponent
15593
        LD      (HL),$00        ; make location zero
15594
        AND     A               ; test if number is zero
15595
        RET     Z               ; return if so
15596
 
15597
        INC     HL              ; address mantissa
15598
        BIT     7,(HL)          ; test the sign bit
15599
        SET     7,(HL)          ; set it to implied state
15600
        DEC     HL              ; point to exponent
15601
        RET     Z               ; return if positive number.
15602
 
15603
        PUSH    BC              ; preserve BC
15604
        LD      BC,$0005        ; length of number
15605
        ADD     HL,BC           ; point HL past end
15606
        LD      B,C             ; set B to 5 counter
15607
        LD      C,A             ; store exponent in C
15608
        SCF                     ; set carry flag
15609
 
15610
;; NEG-BYTE
15611
L2FAF:  DEC     HL              ; work from LSB to MSB
15612
        LD      A,(HL)          ; fetch byte
15613
        CPL                     ; complement
15614
        ADC     A,$00           ; add in initial carry or from prev operation
15615
        LD      (HL),A          ; put back
15616
        DJNZ    L2FAF           ; loop to NEG-BYTE till all 5 done
15617
 
15618
        LD      A,C             ; stored exponent to A
15619
        POP     BC              ; restore original BC
15620
        RET                     ; return
15621
 
15622
; -----------------
15623
; Fetch two numbers
15624
; -----------------
15625
; This routine is called twice when printing floating point numbers and also
15626
; to fetch two numbers by the addition, multiply and division routines.
15627
; HL addresses the first number, DE addresses the second number.
15628
; For arithmetic only, A holds the sign of the result which is stored in
15629
; the second location.
15630
 
15631
;; FETCH-TWO
15632
L2FBA:  PUSH    HL              ; save pointer to first number, result if math.
15633
        PUSH    AF              ; save result sign.
15634
 
15635
        LD      C,(HL)          ;
15636
        INC     HL              ;
15637
 
15638
        LD      B,(HL)          ;
15639
        LD      (HL),A          ; store the sign at correct location in
15640
                                ; destination 5 bytes for arithmetic only.
15641
        INC     HL              ;
15642
 
15643
        LD      A,C             ;
15644
        LD      C,(HL)          ;
15645
        PUSH    BC              ;
15646
        INC     HL              ;
15647
        LD      C,(HL)          ;
15648
        INC     HL              ;
15649
        LD      B,(HL)          ;
15650
        EX      DE,HL           ;
15651
        LD      D,A             ;
15652
        LD      E,(HL)          ;
15653
        PUSH    DE              ;
15654
        INC     HL              ;
15655
        LD      D,(HL)          ;
15656
        INC     HL              ;
15657
        LD      E,(HL)          ;
15658
        PUSH    DE              ;
15659
        EXX                     ;
15660
        POP     DE              ;
15661
        POP     HL              ;
15662
        POP     BC              ;
15663
        EXX                     ;
15664
        INC     HL              ;
15665
        LD      D,(HL)          ;
15666
        INC     HL              ;
15667
        LD      E,(HL)          ;
15668
 
15669
        POP     AF              ; restore possible result sign.
15670
        POP     HL              ; and pointer to possible result.
15671
        RET                     ; return.
15672
 
15673
; ---------------------------------
15674
; Shift floating point number right
15675
; ---------------------------------
15676
;
15677
;
15678
 
15679
;; SHIFT-FP
15680
L2FDD:  AND     A               ;
15681
        RET     Z               ;
15682
 
15683
        CP      $21             ;
15684
        JR      NC,L2FF9        ; to ADDEND-0
15685
 
15686
        PUSH    BC              ;
15687
        LD      B,A             ;
15688
 
15689
;; ONE-SHIFT
15690
L2FE5:  EXX                     ;
15691
        SRA     L               ;
15692
        RR      D               ;
15693
        RR      E               ;
15694
        EXX                     ;
15695
        RR      D               ;
15696
        RR      E               ;
15697
        DJNZ    L2FE5           ; to ONE-SHIFT
15698
 
15699
        POP     BC              ;
15700
        RET     NC              ;
15701
 
15702
        CALL    L3004           ; routine ADD-BACK
15703
        RET     NZ              ;
15704
 
15705
;; ADDEND-0
15706
L2FF9:  EXX                     ;
15707
        XOR     A               ;
15708
 
15709
;; ZEROS-4/5
15710
L2FFB:  LD      L,$00           ;
15711
        LD      D,A             ;
15712
        LD      E,L             ;
15713
        EXX                     ;
15714
        LD      DE,$0000        ;
15715
        RET                     ;
15716
 
15717
; ------------------
15718
; Add back any carry
15719
; ------------------
15720
;
15721
;
15722
 
15723
;; ADD-BACK
15724
L3004:  INC     E               ;
15725
        RET     NZ              ;
15726
 
15727
        INC      D              ;
15728
        RET     NZ              ;
15729
 
15730
        EXX                     ;
15731
        INC     E               ;
15732
        JR      NZ,L300D        ; to ALL-ADDED
15733
 
15734
        INC     D               ;
15735
 
15736
;; ALL-ADDED
15737
L300D:  EXX                     ;
15738
        RET                     ;
15739
 
15740
; -----------------------
15741
; Handle subtraction (03)
15742
; -----------------------
15743
; Subtraction is done by switching the sign byte/bit of the second number
15744
; which may be integer of floating point and continuing into addition.
15745
 
15746
;; subtract
15747
L300F:  EX      DE,HL           ; address second number with HL
15748
 
15749
        CALL    L346E           ; routine NEGATE switches sign
15750
 
15751
        EX      DE,HL           ; address first number again
15752
                                ; and continue.
15753
 
15754
; --------------------
15755
; Handle addition (0F)
15756
; --------------------
15757
; HL points to first number, DE to second.
15758
; If they are both integers, then go for the easy route.
15759
 
15760
;; addition
15761
L3014:  LD      A,(DE)          ; fetch first byte of second
15762
        OR      (HL)            ; combine with first byte of first
15763
        JR      NZ,L303E        ; forward to FULL-ADDN if at least one was
15764
                                ; in floating point form.
15765
 
15766
; continue if both were small integers.
15767
 
15768
        PUSH    DE              ; save pointer to lowest number for result.
15769
 
15770
        INC     HL              ; address sign byte and
15771
        PUSH    HL              ; push the pointer.
15772
 
15773
        INC     HL              ; address low byte
15774
        LD      E,(HL)          ; to E
15775
        INC     HL              ; address high byte
15776
        LD      D,(HL)          ; to D
15777
        INC     HL              ; address unused byte
15778
 
15779
        INC     HL              ; address known zero indicator of 1st number
15780
        INC     HL              ; address sign byte
15781
 
15782
        LD      A,(HL)          ; sign to A, $00 or $FF
15783
 
15784
        INC     HL              ; address low byte
15785
        LD      C,(HL)          ; to C
15786
        INC     HL              ; address high byte
15787
        LD      B,(HL)          ; to B
15788
 
15789
        POP     HL              ; pop result sign pointer
15790
        EX      DE,HL           ; integer to HL
15791
 
15792
        ADD     HL,BC           ; add to the other one in BC
15793
                                ; setting carry if overflow.
15794
 
15795
        EX      DE,HL           ; save result in DE bringing back sign pointer
15796
 
15797
        ADC     A,(HL)          ; if pos/pos A=01 with overflow else 00
15798
                                ; if neg/neg A=FF with overflow else FE
15799
                                ; if mixture A=00 with overflow else FF
15800
 
15801
        RRCA                    ; bit 0 to (C)
15802
 
15803
        ADC     A,$00           ; both acceptable signs now zero
15804
 
15805
        JR      NZ,L303C        ; forward to ADDN-OFLW if not
15806
 
15807
        SBC     A,A             ; restore a negative result sign
15808
 
15809
        LD      (HL),A          ;
15810
        INC     HL              ;
15811
        LD      (HL),E          ;
15812
        INC     HL              ;
15813
        LD      (HL),D          ;
15814
        DEC     HL              ;
15815
        DEC     HL              ;
15816
        DEC     HL              ;
15817
 
15818
        POP     DE              ; STKEND
15819
        RET                     ;
15820
 
15821
; ---
15822
 
15823
;; ADDN-OFLW
15824
L303C:  DEC     HL              ;
15825
        POP     DE              ;
15826
 
15827
;; FULL-ADDN
15828
L303E:  CALL    L3293           ; routine RE-ST-TWO
15829
        EXX                     ;
15830
        PUSH    HL              ;
15831
        EXX                     ;
15832
        PUSH    DE              ;
15833
        PUSH    HL              ;
15834
        CALL    L2F9B           ; routine PREP-ADD
15835
        LD      B,A             ;
15836
        EX      DE,HL           ;
15837
        CALL    L2F9B           ; routine PREP-ADD
15838
        LD       C,A            ;
15839
        CP      B               ;
15840
        JR      NC,L3055        ; to SHIFT-LEN
15841
 
15842
        LD      A,B             ;
15843
        LD      B,C             ;
15844
        EX      DE,HL           ;
15845
 
15846
;; SHIFT-LEN
15847
L3055:  PUSH    AF              ;
15848
        SUB     B               ;
15849
        CALL    L2FBA           ; routine FETCH-TWO
15850
        CALL    L2FDD           ; routine SHIFT-FP
15851
        POP     AF              ;
15852
        POP     HL              ;
15853
        LD      (HL),A          ;
15854
        PUSH    HL              ;
15855
        LD      L,B             ;
15856
        LD      H,C             ;
15857
        ADD     HL,DE           ;
15858
        EXX                     ;
15859
        EX      DE,HL           ;
15860
        ADC     HL,BC           ;
15861
        EX      DE,HL           ;
15862
        LD      A,H             ;
15863
        ADC     A,L             ;
15864
        LD      L,A             ;
15865
        RRA                     ;
15866
        XOR     L               ;
15867
        EXX                     ;
15868
        EX      DE,HL           ;
15869
        POP     HL              ;
15870
        RRA                     ;
15871
        JR      NC,L307C        ; to TEST-NEG
15872
 
15873
        LD      A,$01           ;
15874
        CALL    L2FDD           ; routine SHIFT-FP
15875
        INC     (HL)            ;
15876
        JR      Z,L309F         ; to ADD-REP-6
15877
 
15878
;; TEST-NEG
15879
L307C:  EXX                     ;
15880
        LD      A,L             ;
15881
        AND     $80             ;
15882
        EXX                     ;
15883
        INC     HL              ;
15884
        LD      (HL),A          ;
15885
        DEC     HL              ;
15886
        JR      Z,L30A5         ; to GO-NC-MLT
15887
 
15888
        LD      A,E             ;
15889
        NEG                     ; Negate
15890
        CCF                     ; Complement Carry Flag
15891
        LD      E,A             ;
15892
        LD      A,D             ;
15893
        CPL                     ;
15894
        ADC     A,$00           ;
15895
        LD      D,A             ;
15896
        EXX                     ;
15897
        LD      A,E             ;
15898
        CPL                     ;
15899
        ADC     A,$00           ;
15900
        LD      E,A             ;
15901
        LD      A,D             ;
15902
        CPL                     ;
15903
        ADC     A,$00           ;
15904
        JR      NC,L30A3        ; to END-COMPL
15905
 
15906
        RRA                     ;
15907
        EXX                     ;
15908
        INC     (HL)            ;
15909
 
15910
;; ADD-REP-6
15911
L309F:  JP      Z,L31AD         ; to REPORT-6
15912
 
15913
        EXX                     ;
15914
 
15915
;; END-COMPL
15916
L30A3:  LD      D,A             ;
15917
        EXX                     ;
15918
 
15919
;; GO-NC-MLT
15920
L30A5:  XOR     A               ;
15921
        JP      L3155           ; to TEST-NORM
15922
 
15923
; -----------------------------
15924
; Used in 16 bit multiplication
15925
; -----------------------------
15926
; This routine is used, in the first instance, by the multiply calculator
15927
; literal to perform an integer multiplication in preference to
15928
; 32-bit multiplication to which it will resort if this overflows.
15929
;
15930
; It is also used by STK-VAR to calculate array subscripts and by DIM to
15931
; calculate the space required for multi-dimensional arrays.
15932
 
15933
;; HL-HL*DE
15934
L30A9:  PUSH    BC              ; preserve BC throughout
15935
        LD      B,$10           ; set B to 16
15936
        LD      A,H             ; save H in A high byte
15937
        LD      C,L             ; save L in C low byte
15938
        LD      HL,$0000        ; initialize result to zero
15939
 
15940
; now enter a loop.
15941
 
15942
;; HL-LOOP
15943
L30B1:  ADD     HL,HL           ; double result
15944
        JR      C,L30BE         ; to HL-END if overflow
15945
 
15946
        RL      C               ; shift AC left into carry
15947
        RLA                     ;
15948
        JR      NC,L30BC        ; to HL-AGAIN to skip addition if no carry
15949
 
15950
        ADD     HL,DE           ; add in DE
15951
        JR      C,L30BE         ; to HL-END if overflow
15952
 
15953
;; HL-AGAIN
15954
L30BC:  DJNZ    L30B1           ; back to HL-LOOP for all 16 bits
15955
 
15956
;; HL-END
15957
L30BE:  POP     BC              ; restore preserved BC
15958
        RET                     ; return with carry reset if successful
15959
                                ; and result in HL.
15960
 
15961
; ----------------------------------------------
15962
; THE 'PREPARE TO MULTIPLY OR DIVIDE' SUBROUTINE
15963
; ----------------------------------------------
15964
;   This routine is called in succession from multiply and divide to prepare
15965
;   two mantissas by setting the leftmost bit that is used for the sign.
15966
;   On the first call A holds zero and picks up the sign bit. On the second
15967
;   call the two bits are XORed to form the result sign - minus * minus giving
15968
;   plus etc. If either number is zero then this is flagged.
15969
;   HL addresses the exponent.
15970
 
15971
;; PREP-M/D
15972
L30C0:  CALL    L34E9           ; routine TEST-ZERO  preserves accumulator.
15973
        RET     C               ; return carry set if zero
15974
 
15975
        INC     HL              ; address first byte of mantissa
15976
        XOR     (HL)            ; pick up the first or xor with first.
15977
        SET     7,(HL)          ; now set to give true 32-bit mantissa
15978
        DEC     HL              ; point to exponent
15979
        RET                     ; return with carry reset
15980
 
15981
; ----------------------
15982
; THE 'MULTIPLY' ROUTINE
15983
; ----------------------
15984
; (offset: $04 'multiply')
15985
;
15986
;
15987
;   "He said go forth and something about mathematics, I wasn't really
15988
;    listening" - overheard conversation between two unicorns.
15989
;    [ The Odd Streak ].
15990
 
15991
;; multiply
15992
L30CA:  LD      A,(DE)          ;
15993
        OR      (HL)            ;
15994
        JR      NZ,L30F0        ; to MULT-LONG
15995
 
15996
        PUSH    DE              ;
15997
        PUSH    HL              ;
15998
        PUSH    DE              ;
15999
        CALL    L2D7F           ; routine INT-FETCH
16000
        EX      DE,HL           ;
16001
        EX      (SP),HL         ;
16002
        LD      B,C             ;
16003
        CALL    L2D7F           ; routine INT-FETCH
16004
        LD      A,B             ;
16005
        XOR     C               ;
16006
        LD      C,A             ;
16007
        POP     HL              ;
16008
        CALL    L30A9           ; routine HL-HL*DE
16009
        EX      DE,HL           ;
16010
        POP     HL              ;
16011
        JR      C,L30EF         ; to MULT-OFLW
16012
 
16013
        LD      A,D             ;
16014
        OR      E               ;
16015
        JR      NZ,L30EA        ; to MULT-RSLT
16016
 
16017
        LD      C,A             ;
16018
 
16019
;; MULT-RSLT
16020
L30EA:  CALL    L2D8E           ; routine INT-STORE
16021
        POP      DE             ;
16022
        RET                     ;
16023
 
16024
; ---
16025
 
16026
;; MULT-OFLW
16027
L30EF:  POP     DE              ;
16028
 
16029
;; MULT-LONG
16030
L30F0:  CALL    L3293           ; routine RE-ST-TWO
16031
        XOR     A               ;
16032
        CALL    L30C0           ; routine PREP-M/D
16033
        RET     C               ;
16034
 
16035
        EXX                     ;
16036
        PUSH    HL              ;
16037
        EXX                     ;
16038
        PUSH    DE              ;
16039
        EX      DE,HL           ;
16040
        CALL    L30C0           ; routine PREP-M/D
16041
        EX      DE,HL           ;
16042
        JR      C,L315D         ; to ZERO-RSLT
16043
 
16044
        PUSH    HL              ;
16045
        CALL    L2FBA           ; routine FETCH-TWO
16046
        LD      A,B             ;
16047
        AND     A               ;
16048
        SBC     HL,HL           ;
16049
        EXX                     ;
16050
        PUSH    HL              ;
16051
        SBC     HL,HL           ;
16052
        EXX                     ;
16053
        LD      B,$21           ;
16054
        JR      L3125           ; to STRT-MLT
16055
 
16056
; ---
16057
 
16058
;; MLT-LOOP
16059
L3114:  JR      NC,L311B        ; to NO-ADD
16060
 
16061
        ADD     HL,DE           ;
16062
        EXX                     ;
16063
        ADC     HL,DE           ;
16064
        EXX                     ;
16065
 
16066
;; NO-ADD
16067
L311B:  EXX                     ;
16068
        RR      H               ;
16069
        RR      L               ;
16070
        EXX                     ;
16071
        RR      H               ;
16072
        RR      L               ;
16073
 
16074
;; STRT-MLT
16075
L3125:  EXX                     ;
16076
        RR      B               ;
16077
        RR      C               ;
16078
        EXX                     ;
16079
        RR      C               ;
16080
        RRA                     ;
16081
        DJNZ    L3114           ; to MLT-LOOP
16082
 
16083
        EX      DE,HL           ;
16084
        EXX                     ;
16085
        EX      DE,HL           ;
16086
        EXX                     ;
16087
        POP     BC              ;
16088
        POP     HL              ;
16089
        LD      A,B             ;
16090
        ADD     A,C             ;
16091
        JR      NZ,L313B        ; to MAKE-EXPT
16092
 
16093
        AND     A               ;
16094
 
16095
;; MAKE-EXPT
16096
L313B:  DEC     A               ;
16097
        CCF                     ; Complement Carry Flag
16098
 
16099
;; DIVN-EXPT
16100
L313D:  RLA                     ;
16101
        CCF                     ; Complement Carry Flag
16102
        RRA                     ;
16103
        JP      P,L3146         ; to OFLW1-CLR
16104
 
16105
        JR      NC,L31AD        ; to REPORT-6
16106
 
16107
        AND     A               ;
16108
 
16109
;; OFLW1-CLR
16110
L3146:  INC     A               ;
16111
        JR      NZ,L3151        ; to OFLW2-CLR
16112
 
16113
        JR      C,L3151         ; to OFLW2-CLR
16114
 
16115
        EXX                     ;
16116
        BIT     7,D             ;
16117
        EXX                     ;
16118
        JR      NZ,L31AD        ; to REPORT-6
16119
 
16120
;; OFLW2-CLR
16121
L3151:  LD      (HL),A          ;
16122
        EXX                     ;
16123
        LD      A,B             ;
16124
        EXX                     ;
16125
 
16126
;; TEST-NORM
16127
L3155:  JR      NC,L316C        ; to NORMALISE
16128
 
16129
        LD      A,(HL)          ;
16130
        AND     A               ;
16131
 
16132
;; NEAR-ZERO
16133
L3159:  LD      A,$80           ;
16134
        JR      Z,L315E         ; to SKIP-ZERO
16135
 
16136
;; ZERO-RSLT
16137
L315D:  XOR     A               ;
16138
 
16139
;; SKIP-ZERO
16140
L315E:  EXX                     ;
16141
        AND     D               ;
16142
        CALL    L2FFB           ; routine ZEROS-4/5
16143
        RLCA                    ;
16144
        LD      (HL),A          ;
16145
        JR      C,L3195         ; to OFLOW-CLR
16146
 
16147
        INC     HL              ;
16148
        LD      (HL),A          ;
16149
        DEC     HL              ;
16150
        JR      L3195           ; to OFLOW-CLR
16151
 
16152
; ---
16153
 
16154
;; NORMALISE
16155
L316C:  LD      B,$20           ;
16156
 
16157
;; SHIFT-ONE
16158
L316E:  EXX                     ;
16159
        BIT     7,D             ;
16160
        EXX                     ;
16161
        JR      NZ,L3186        ; to NORML-NOW
16162
 
16163
        RLCA                    ;
16164
        RL      E               ;
16165
        RL      D               ;
16166
        EXX                     ;
16167
        RL      E               ;
16168
        RL      D               ;
16169
        EXX                     ;
16170
        DEC     (HL)            ;
16171
        JR      Z,L3159         ; to NEAR-ZERO
16172
 
16173
        DJNZ    L316E           ; to SHIFT-ONE
16174
 
16175
        JR      L315D           ; to ZERO-RSLT
16176
 
16177
; ---
16178
 
16179
;; NORML-NOW
16180
L3186:  RLA                     ;
16181
        JR      NC,L3195        ; to OFLOW-CLR
16182
 
16183
        CALL    L3004           ; routine ADD-BACK
16184
        JR      NZ,L3195        ; to OFLOW-CLR
16185
 
16186
        EXX                     ;
16187
        LD       D,$80          ;
16188
        EXX                     ;
16189
        INC     (HL)            ;
16190
        JR      Z,L31AD         ; to REPORT-6
16191
 
16192
;; OFLOW-CLR
16193
L3195:  PUSH    HL              ;
16194
        INC     HL              ;
16195
        EXX                     ;
16196
        PUSH    DE              ;
16197
        EXX                     ;
16198
        POP     BC              ;
16199
        LD      A,B             ;
16200
        RLA                     ;
16201
        RL      (HL)            ;
16202
        RRA                     ;
16203
        LD      (HL),A          ;
16204
        INC     HL              ;
16205
        LD      (HL),C          ;
16206
        INC     HL              ;
16207
        LD      (HL),D          ;
16208
        INC     HL              ;
16209
        LD      (HL),E          ;
16210
        POP     HL              ;
16211
        POP     DE              ;
16212
        EXX                     ;
16213
        POP     HL              ;
16214
        EXX                     ;
16215
        RET                     ;
16216
 
16217
; ---
16218
 
16219
;; REPORT-6
16220
L31AD:  RST     08H             ; ERROR-1
16221
        DEFB    $05             ; Error Report: Number too big
16222
 
16223
; ----------------------
16224
; THE 'DIVISION' ROUTINE
16225
; ----------------------
16226
; (offset: $05 'division')
16227
;
16228
;   "He who can properly define and divide is to be considered a god"
16229
;   - Plato,  429 - 347 B.C.
16230
 
16231
;; division
16232
L31AF:  CALL    L3293           ; routine RE-ST-TWO
16233
        EX      DE,HL           ;
16234
        XOR     A               ;
16235
        CALL    L30C0           ; routine PREP-M/D
16236
        JR      C,L31AD         ; to REPORT-6
16237
 
16238
        EX      DE,HL           ;
16239
        CALL    L30C0           ; routine PREP-M/D
16240
        RET     C               ;
16241
 
16242
        EXX                     ;
16243
        PUSH    HL              ;
16244
        EXX                     ;
16245
        PUSH    DE              ;
16246
        PUSH    HL              ;
16247
        CALL    L2FBA           ; routine FETCH-TWO
16248
        EXX                     ;
16249
        PUSH    HL              ;
16250
        LD      H,B             ;
16251
        LD      L,C             ;
16252
        EXX                     ;
16253
        LD      H,C             ;
16254
        LD      L,B             ;
16255
        XOR     A               ;
16256
        LD      B,$DF           ;
16257
        JR      L31E2           ; to DIV-START
16258
 
16259
; ---
16260
 
16261
;; DIV-LOOP
16262
L31D2:  RLA                     ;
16263
        RL      C               ;
16264
        EXX                     ;
16265
        RL      C               ;
16266
        RL      B               ;
16267
        EXX                     ;
16268
 
16269
;; div-34th
16270
L31DB:  ADD     HL,HL           ;
16271
        EXX                     ;
16272
        ADC     HL,HL           ;
16273
        EXX                     ;
16274
        JR      C,L31F2         ; to SUBN-ONLY
16275
 
16276
;; DIV-START
16277
L31E2:  SBC     HL,DE           ;
16278
        EXX                     ;
16279
        SBC     HL,DE           ;
16280
        EXX                     ;
16281
        JR      NC,L31F9        ; to NO-RSTORE
16282
 
16283
        ADD     HL,DE           ;
16284
        EXX                     ;
16285
        ADC     HL,DE           ;
16286
        EXX                     ;
16287
        AND     A               ;
16288
        JR      L31FA           ; to COUNT-ONE
16289
 
16290
; ---
16291
 
16292
;; SUBN-ONLY
16293
L31F2:  AND     A               ;
16294
        SBC     HL,DE           ;
16295
        EXX                     ;
16296
        SBC     HL,DE           ;
16297
        EXX                     ;
16298
 
16299
;; NO-RSTORE
16300
L31F9:  SCF                     ; Set Carry Flag
16301
 
16302
;; COUNT-ONE
16303
L31FA:  INC     B               ;
16304
        JP      M,L31D2         ; to DIV-LOOP
16305
 
16306
        PUSH    AF              ;
16307
        JR      Z,L31E2         ; to DIV-START
16308
 
16309
;
16310
;
16311
;
16312
;
16313
 
16314
        LD      E,A             ;
16315
        LD      D,C             ;
16316
        EXX                     ;
16317
        LD      E,C             ;
16318
        LD      D,B             ;
16319
        POP     AF              ;
16320
        RR      B               ;
16321
        POP     AF              ;
16322
        RR      B               ;
16323
        EXX                     ;
16324
        POP     BC              ;
16325
        POP     HL              ;
16326
        LD      A,B             ;
16327
        SUB     C               ;
16328
        JP      L313D           ; jump back to DIVN-EXPT
16329
 
16330
; ------------------------------------
16331
; Integer truncation towards zero ($3A)
16332
; ------------------------------------
16333
;
16334
;
16335
 
16336
;; truncate
16337
L3214:  LD      A,(HL)          ;
16338
        AND     A               ;
16339
        RET     Z               ;
16340
 
16341
        CP      $81             ;
16342
        JR      NC,L3221        ; to T-GR-ZERO
16343
 
16344
        LD      (HL),$00        ;
16345
        LD      A,$20           ;
16346
        JR      L3272           ; to NIL-BYTES
16347
 
16348
; ---
16349
 
16350
;; T-GR-ZERO
16351
L3221:  CP      $91             ;
16352
        JR      NZ,L323F        ; to T-SMALL
16353
 
16354
        INC     HL              ;
16355
        INC     HL              ;
16356
        INC     HL              ;
16357
        LD      A,$80           ;
16358
        AND     (HL)            ;
16359
        DEC     HL              ;
16360
        OR      (HL)            ;
16361
        DEC     HL              ;
16362
        JR      NZ,L3233        ; to T-FIRST
16363
 
16364
        LD      A,$80           ;
16365
        XOR     (HL)            ;
16366
 
16367
;; T-FIRST
16368
L3233:  DEC     HL              ;
16369
        JR      NZ,L326C        ; to T-EXPNENT
16370
 
16371
        LD      (HL),A          ;
16372
        INC     HL              ;
16373
        LD      (HL),$FF        ;
16374
        DEC     HL              ;
16375
        LD      A,$18           ;
16376
        JR      L3272           ; to NIL-BYTES
16377
 
16378
; ---
16379
 
16380
;; T-SMALL
16381
L323F:  JR      NC,L326D        ; to X-LARGE
16382
 
16383
        PUSH    DE              ;
16384
        CPL                     ;
16385
        ADD     A,$91           ;
16386
        INC     HL              ;
16387
        LD      D,(HL)          ;
16388
        INC     HL              ;
16389
        LD      E,(HL)          ;
16390
        DEC     HL              ;
16391
        DEC     HL              ;
16392
        LD      C,$00           ;
16393
        BIT     7,D             ;
16394
        JR      Z,L3252         ; to T-NUMERIC
16395
 
16396
        DEC     C               ;
16397
 
16398
;; T-NUMERIC
16399
L3252:  SET     7,D             ;
16400
        LD      B,$08           ;
16401
        SUB     B               ;
16402
        ADD     A,B             ;
16403
        JR      C,L325E         ; to T-TEST
16404
 
16405
        LD      E,D             ;
16406
        LD      D,$00           ;
16407
        SUB     B               ;
16408
 
16409
;; T-TEST
16410
L325E:  JR      Z,L3267         ; to T-STORE
16411
 
16412
        LD      B,A             ;
16413
 
16414
;; T-SHIFT
16415
L3261:  SRL     D               ;
16416
        RR      E               ;
16417
        DJNZ    L3261           ; to T-SHIFT
16418
 
16419
;; T-STORE
16420
L3267:  CALL    L2D8E           ; routine INT-STORE
16421
        POP     DE              ;
16422
        RET                     ;
16423
 
16424
; ---
16425
 
16426
;; T-EXPNENT
16427
L326C:  LD      A,(HL)          ;
16428
 
16429
;; X-LARGE
16430
L326D:  SUB     $A0             ;
16431
        RET     P               ;
16432
 
16433
        NEG                     ; Negate
16434
 
16435
;; NIL-BYTES
16436
L3272:  PUSH    DE              ;
16437
        EX      DE,HL           ;
16438
        DEC     HL              ;
16439
        LD      B,A             ;
16440
        SRL     B               ;
16441
        SRL     B               ;
16442
        SRL     B               ;
16443
        JR      Z,L3283         ; to BITS-ZERO
16444
 
16445
;; BYTE-ZERO
16446
L327E:  LD      (HL),$00        ;
16447
        DEC     HL              ;
16448
        DJNZ    L327E           ; to BYTE-ZERO
16449
 
16450
;; BITS-ZERO
16451
L3283:  AND     $07             ;
16452
        JR      Z,L3290         ; to IX-END
16453
 
16454
        LD      B,A             ;
16455
        LD      A,$FF           ;
16456
 
16457
;; LESS-MASK
16458
L328A:  SLA     A               ;
16459
        DJNZ    L328A           ; to LESS-MASK
16460
 
16461
        AND     (HL)            ;
16462
        LD      (HL),A          ;
16463
 
16464
;; IX-END
16465
L3290:  EX      DE,HL           ;
16466
        POP     DE              ;
16467
        RET                     ;
16468
 
16469
; ----------------------------------
16470
; Storage of numbers in 5 byte form.
16471
; ==================================
16472
; Both integers and floating-point numbers can be stored in five bytes.
16473
; Zero is a special case stored as 5 zeros.
16474
; For integers the form is
16475
; Byte 1 - zero,
16476
; Byte 2 - sign byte, $00 +ve, $FF -ve.
16477
; Byte 3 - Low byte of integer.
16478
; Byte 4 - High byte
16479
; Byte 5 - unused but always zero.
16480
;
16481
; it seems unusual to store the low byte first but it is just as easy either
16482
; way. Statistically it just increases the chances of trailing zeros which
16483
; is an advantage elsewhere in saving ROM code.
16484
;
16485
;             zero     sign     low      high    unused
16486
; So +1 is  00000000 00000000 00000001 00000000 00000000
16487
;
16488
; and -1 is 00000000 11111111 11111111 11111111 00000000
16489
;
16490
; much of the arithmetic found in BASIC lines can be done using numbers
16491
; in this form using the Z80's 16 bit register operation ADD.
16492
; (multiplication is done by a sequence of additions).
16493
;
16494
; Storing -ve integers in two's complement form, means that they are ready for
16495
; addition and you might like to add the numbers above to prove that the
16496
; answer is zero. If, as in this case, the carry is set then that denotes that
16497
; the result is positive. This only applies when the signs don't match.
16498
; With positive numbers a carry denotes the result is out of integer range.
16499
; With negative numbers a carry denotes the result is within range.
16500
; The exception to the last rule is when the result is -65536
16501
;
16502
; Floating point form is an alternative method of storing numbers which can
16503
; be used for integers and larger (or fractional) numbers.
16504
;
16505
; In this form 1 is stored as
16506
;           10000001 00000000 00000000 00000000 00000000
16507
;
16508
; When a small integer is converted to a floating point number the last two
16509
; bytes are always blank so they are omitted in the following steps
16510
;
16511
; first make exponent +1 +16d  (bit 7 of the exponent is set if positive)
16512
 
16513
; 10010001 00000000 00000001
16514
; 10010000 00000000 00000010 <-  now shift left and decrement exponent
16515
; ...
16516
; 10000010 01000000 00000000 <-  until a 1 abuts the imaginary point
16517
; 10000001 10000000 00000000     to the left of the mantissa.
16518
;
16519
; however since the leftmost bit of the mantissa is always set then it can
16520
; be used to denote the sign of the mantissa and put back when needed by the
16521
; PREP routines which gives
16522
;
16523
; 10000001 00000000 00000000
16524
 
16525
; ----------------------------------------------
16526
; THE 'RE-STACK TWO "SMALL" INTEGERS' SUBROUTINE
16527
; ----------------------------------------------
16528
;   This routine is called to re-stack two numbers in full floating point form
16529
;   e.g. from mult when integer multiplication has overflowed.
16530
 
16531
;; RE-ST-TWO
16532
L3293:  CALL    L3296           ; routine RESTK-SUB  below and continue
16533
                                ; into the routine to do the other one.
16534
 
16535
;; RESTK-SUB
16536
L3296:  EX      DE,HL           ; swap pointers
16537
 
16538
; ---------------------------------------------
16539
; THE 'RE-STACK ONE "SMALL" INTEGER' SUBROUTINE
16540
; ---------------------------------------------
16541
; (offset: $3D 're-stack')
16542
;   This routine re-stacks an integer, usually on the calculator stack, in full
16543
;   floating point form.  HL points to first byte.
16544
 
16545
;; re-stack
16546
L3297:  LD      A,(HL)          ; Fetch Exponent byte to A
16547
        AND     A               ; test it
16548
        RET     NZ              ; return if not zero as already in full
16549
                                ; floating-point form.
16550
 
16551
        PUSH    DE              ; preserve DE.
16552
        CALL    L2D7F           ; routine INT-FETCH
16553
                                ; integer to DE, sign to C.
16554
 
16555
; HL points to 4th byte.
16556
 
16557
        XOR     A               ; clear accumulator.
16558
        INC     HL              ; point to 5th.
16559
        LD      (HL),A          ; and blank.
16560
        DEC     HL              ; point to 4th.
16561
        LD      (HL),A          ; and blank.
16562
 
16563
        LD      B,$91           ; set exponent byte +ve $81
16564
                                ; and imaginary dec point 16 bits to right
16565
                                ; of first bit.
16566
 
16567
;   we could skip to normalize now but it's quicker to avoid normalizing
16568
;   through an empty D.
16569
 
16570
        LD      A,D             ; fetch the high byte D
16571
        AND     A               ; is it zero ?
16572
        JR      NZ,L32B1        ; skip to RS-NRMLSE if not.
16573
 
16574
        OR      E               ; low byte E to A and test for zero
16575
        LD      B,D             ; set B exponent to 0
16576
        JR      Z,L32BD         ; forward to RS-STORE if value is zero.
16577
 
16578
        LD      D,E             ; transfer E to D
16579
        LD      E,B             ; set E to 0
16580
        LD      B,$89           ; reduce the initial exponent by eight.
16581
 
16582
 
16583
;; RS-NRMLSE
16584
L32B1:  EX      DE,HL           ; integer to HL, addr of 4th byte to DE.
16585
 
16586
;; RSTK-LOOP
16587
L32B2:  DEC     B               ; decrease exponent
16588
        ADD     HL,HL           ; shift DE left
16589
        JR      NC,L32B2        ; loop back to RSTK-LOOP
16590
                                ; until a set bit pops into carry
16591
 
16592
        RRC     C               ; now rotate the sign byte $00 or $FF
16593
                                ; into carry to give a sign bit
16594
 
16595
        RR      H               ; rotate the sign bit to left of H
16596
        RR      L               ; rotate any carry into L
16597
 
16598
        EX      DE,HL           ; address 4th byte, normalized int to DE
16599
 
16600
;; RS-STORE
16601
L32BD:  DEC     HL              ; address 3rd byte
16602
        LD      (HL),E          ; place E
16603
        DEC     HL              ; address 2nd byte
16604
        LD      (HL),D          ; place D
16605
        DEC     HL              ; address 1st byte
16606
        LD      (HL),B          ; store the exponent
16607
 
16608
        POP     DE              ; restore initial DE.
16609
        RET                     ; return.
16610
 
16611
;****************************************
16612
;** Part 10. FLOATING-POINT CALCULATOR **
16613
;****************************************
16614
 
16615
; As a general rule the calculator avoids using the IY register.
16616
; exceptions are val, val$ and str$.
16617
; So an assembly language programmer who has disabled interrupts to use
16618
; IY for other purposes can still use the calculator for mathematical
16619
; purposes.
16620
 
16621
 
16622
; ------------------------
16623
; THE 'TABLE OF CONSTANTS'
16624
; ------------------------
16625
;
16626
;
16627
 
16628
; used 11 times
16629
;; stk-zero                                                 00 00 00 00 00
16630
L32C5:  DEFB    $00             ;;Bytes: 1
16631
        DEFB    $B0             ;;Exponent $00
16632
        DEFB    $00             ;;(+00,+00,+00)
16633
 
16634
; used 19 times
16635
;; stk-one                                                  00 00 01 00 00
16636
L32C8:  DEFB    $40             ;;Bytes: 2
16637
        DEFB    $B0             ;;Exponent $00
16638
        DEFB    $00,$01         ;;(+00,+00)
16639
 
16640
; used 9 times
16641
;; stk-half                                                 80 00 00 00 00
16642
L32CC:  DEFB    $30             ;;Exponent: $80, Bytes: 1
16643
        DEFB    $00             ;;(+00,+00,+00)
16644
 
16645
; used 4 times.
16646
;; stk-pi/2                                                 81 49 0F DA A2
16647
L32CE:  DEFB    $F1             ;;Exponent: $81, Bytes: 4
16648
        DEFB    $49,$0F,$DA,$A2 ;;
16649
 
16650
; used 3 times.
16651
;; stk-ten                                                  00 00 0A 00 00
16652
L32D3:  DEFB    $40             ;;Bytes: 2
16653
        DEFB    $B0             ;;Exponent $00
16654
        DEFB    $00,$0A         ;;(+00,+00)
16655
 
16656
 
16657
; ------------------------
16658
; THE 'TABLE OF ADDRESSES'
16659
; ------------------------
16660
;  "Each problem that I solved became a rule which served afterwards to solve
16661
;   other problems" - Rene Descartes 1596 - 1650.
16662
;
16663
;   Starts with binary operations which have two operands and one result.
16664
;   Three pseudo binary operations first.
16665
 
16666
;; tbl-addrs
16667
L32D7:  DEFW    L368F           ; $00 Address: $368F - jump-true
16668
        DEFW    L343C           ; $01 Address: $343C - exchange
16669
        DEFW    L33A1           ; $02 Address: $33A1 - delete
16670
 
16671
;   True binary operations.
16672
 
16673
        DEFW    L300F           ; $03 Address: $300F - subtract
16674
        DEFW    L30CA           ; $04 Address: $30CA - multiply
16675
        DEFW    L31AF           ; $05 Address: $31AF - division
16676
        DEFW    L3851           ; $06 Address: $3851 - to-power
16677
        DEFW    L351B           ; $07 Address: $351B - or
16678
 
16679
        DEFW    L3524           ; $08 Address: $3524 - no-&-no
16680
        DEFW    L353B           ; $09 Address: $353B - no-l-eql
16681
        DEFW    L353B           ; $0A Address: $353B - no-gr-eql
16682
        DEFW    L353B           ; $0B Address: $353B - nos-neql
16683
        DEFW    L353B           ; $0C Address: $353B - no-grtr
16684
        DEFW    L353B           ; $0D Address: $353B - no-less
16685
        DEFW    L353B           ; $0E Address: $353B - nos-eql
16686
        DEFW    L3014           ; $0F Address: $3014 - addition
16687
 
16688
        DEFW    L352D           ; $10 Address: $352D - str-&-no
16689
        DEFW    L353B           ; $11 Address: $353B - str-l-eql
16690
        DEFW    L353B           ; $12 Address: $353B - str-gr-eql
16691
        DEFW    L353B           ; $13 Address: $353B - strs-neql
16692
        DEFW    L353B           ; $14 Address: $353B - str-grtr
16693
        DEFW    L353B           ; $15 Address: $353B - str-less
16694
        DEFW    L353B           ; $16 Address: $353B - strs-eql
16695
        DEFW    L359C           ; $17 Address: $359C - strs-add
16696
 
16697
;   Unary follow.
16698
 
16699
        DEFW    L35DE           ; $18 Address: $35DE - val$
16700
        DEFW    L34BC           ; $19 Address: $34BC - usr-$
16701
        DEFW    L3645           ; $1A Address: $3645 - read-in
16702
        DEFW    L346E           ; $1B Address: $346E - negate
16703
 
16704
        DEFW    L3669           ; $1C Address: $3669 - code
16705
        DEFW    L35DE           ; $1D Address: $35DE - val
16706
        DEFW    L3674           ; $1E Address: $3674 - len
16707
        DEFW    L37B5           ; $1F Address: $37B5 - sin
16708
        DEFW    L37AA           ; $20 Address: $37AA - cos
16709
        DEFW    L37DA           ; $21 Address: $37DA - tan
16710
        DEFW    L3833           ; $22 Address: $3833 - asn
16711
        DEFW    L3843           ; $23 Address: $3843 - acs
16712
        DEFW    L37E2           ; $24 Address: $37E2 - atn
16713
        DEFW    L3713           ; $25 Address: $3713 - ln
16714
        DEFW    L36C4           ; $26 Address: $36C4 - exp
16715
        DEFW    L36AF           ; $27 Address: $36AF - int
16716
        DEFW    L384A           ; $28 Address: $384A - sqr
16717
        DEFW    L3492           ; $29 Address: $3492 - sgn
16718
        DEFW    L346A           ; $2A Address: $346A - abs
16719
        DEFW    L34AC           ; $2B Address: $34AC - peek
16720
        DEFW    L34A5           ; $2C Address: $34A5 - in
16721
        DEFW    L34B3           ; $2D Address: $34B3 - usr-no
16722
        DEFW    L361F           ; $2E Address: $361F - str$
16723
        DEFW    L35C9           ; $2F Address: $35C9 - chrs
16724
        DEFW    L3501           ; $30 Address: $3501 - not
16725
 
16726
;   End of true unary.
16727
 
16728
        DEFW    L33C0           ; $31 Address: $33C0 - duplicate
16729
        DEFW    L36A0           ; $32 Address: $36A0 - n-mod-m
16730
        DEFW    L3686           ; $33 Address: $3686 - jump
16731
        DEFW    L33C6           ; $34 Address: $33C6 - stk-data
16732
        DEFW    L367A           ; $35 Address: $367A - dec-jr-nz
16733
        DEFW    L3506           ; $36 Address: $3506 - less-0
16734
        DEFW    L34F9           ; $37 Address: $34F9 - greater-0
16735
        DEFW    L369B           ; $38 Address: $369B - end-calc
16736
        DEFW    L3783           ; $39 Address: $3783 - get-argt
16737
        DEFW    L3214           ; $3A Address: $3214 - truncate
16738
        DEFW    L33A2           ; $3B Address: $33A2 - fp-calc-2
16739
        DEFW    L2D4F           ; $3C Address: $2D4F - e-to-fp
16740
        DEFW    L3297           ; $3D Address: $3297 - re-stack
16741
 
16742
;   The following are just the next available slots for the 128 compound
16743
;   literals which are in range $80 - $FF.
16744
 
16745
        DEFW    L3449           ;     Address: $3449 - series-xx    $80 - $9F.
16746
        DEFW    L341B           ;     Address: $341B - stk-const-xx $A0 - $BF.
16747
        DEFW    L342D           ;     Address: $342D - st-mem-xx    $C0 - $DF.
16748
        DEFW    L340F           ;     Address: $340F - get-mem-xx   $E0 - $FF.
16749
 
16750
;   Aside: 3E - 3F are therefore unused calculator literals.
16751
;   If the literal has to be also usable as a function then bits 6 and 7 are
16752
;   used to show type of arguments and result.
16753
 
16754
; --------------
16755
; The Calculator
16756
; --------------
16757
;  "A good calculator does not need artificial aids"
16758
;  Lao Tze 604 - 531 B.C.
16759
 
16760
;; CALCULATE
16761
L335B:  CALL    L35BF           ; routine STK-PNTRS is called to set up the
16762
                                ; calculator stack pointers for a default
16763
                                ; unary operation. HL = last value on stack.
16764
                                ; DE = STKEND first location after stack.
16765
 
16766
; the calculate routine is called at this point by the series generator...
16767
 
16768
;; GEN-ENT-1
16769
L335E:  LD      A,B             ; fetch the Z80 B register to A
16770
        LD      ($5C67),A       ; and store value in system variable BREG.
16771
                                ; this will be the counter for dec-jr-nz
16772
                                ; or if used from fp-calc2 the calculator
16773
                                ; instruction.
16774
 
16775
; ... and again later at this point
16776
 
16777
;; GEN-ENT-2
16778
L3362:  EXX                     ; switch sets
16779
        EX      (SP),HL         ; and store the address of next instruction,
16780
                                ; the return address, in H'L'.
16781
                                ; If this is a recursive call the H'L'
16782
                                ; of the previous invocation goes on stack.
16783
                                ; c.f. end-calc.
16784
        EXX                     ; switch back to main set
16785
 
16786
; this is the re-entry looping point when handling a string of literals.
16787
 
16788
;; RE-ENTRY
16789
L3365:  LD      ($5C65),DE      ; save end of stack in system variable STKEND
16790
        EXX                     ; switch to alt
16791
        LD      A,(HL)          ; get next literal
16792
        INC     HL              ; increase pointer'
16793
 
16794
; single operation jumps back to here
16795
 
16796
;; SCAN-ENT
16797
L336C:  PUSH    HL              ; save pointer on stack
16798
        AND     A               ; now test the literal
16799
        JP      P,L3380         ; forward to FIRST-3D if in range $00 - $3D
16800
                                ; anything with bit 7 set will be one of
16801
                                ; 128 compound literals.
16802
 
16803
; compound literals have the following format.
16804
; bit 7 set indicates compound.
16805
; bits 6-5 the subgroup 0-3.
16806
; bits 4-0 the embedded parameter $00 - $1F.
16807
; The subgroup 0-3 needs to be manipulated to form the next available four
16808
; address places after the simple literals in the address table.
16809
 
16810
        LD      D,A             ; save literal in D
16811
        AND     $60             ; and with 01100000 to isolate subgroup
16812
        RRCA                    ; rotate bits
16813
        RRCA                    ; 4 places to right
16814
        RRCA                    ; not five as we need offset * 2
16815
        RRCA                    ; 00000xx0
16816
        ADD     A,$7C           ; add ($3E * 2) to give correct offset.
16817
                                ; alter above if you add more literals.
16818
        LD      L,A             ; store in L for later indexing.
16819
        LD      A,D             ; bring back compound literal
16820
        AND     $1F             ; use mask to isolate parameter bits
16821
        JR      L338E           ; forward to ENT-TABLE
16822
 
16823
; ---
16824
 
16825
; the branch was here with simple literals.
16826
 
16827
;; FIRST-3D
16828
L3380:  CP      $18             ; compare with first unary operations.
16829
        JR      NC,L338C        ; to DOUBLE-A with unary operations
16830
 
16831
; it is binary so adjust pointers.
16832
 
16833
        EXX                     ;
16834
        LD      BC,$FFFB        ; the value -5
16835
        LD      D,H             ; transfer HL, the last value, to DE.
16836
        LD      E,L             ;
16837
        ADD     HL,BC           ; subtract 5 making HL point to second
16838
                                ; value.
16839
        EXX                     ;
16840
 
16841
;; DOUBLE-A
16842
L338C:  RLCA                    ; double the literal
16843
        LD      L,A             ; and store in L for indexing
16844
 
16845
;; ENT-TABLE
16846
L338E:  LD      DE,L32D7        ; Address: tbl-addrs
16847
        LD      H,$00           ; prepare to index
16848
        ADD     HL,DE           ; add to get address of routine
16849
        LD      E,(HL)          ; low byte to E
16850
        INC     HL              ;
16851
        LD      D,(HL)          ; high byte to D
16852
        LD      HL,L3365        ; Address: RE-ENTRY
16853
        EX      (SP),HL         ; goes to stack
16854
        PUSH    DE              ; now address of routine
16855
        EXX                     ; main set
16856
                                ; avoid using IY register.
16857
        LD      BC,($5C66)      ; STKEND_hi
16858
                                ; nothing much goes to C but BREG to B
16859
                                ; and continue into next ret instruction
16860
                                ; which has a dual identity
16861
 
16862
 
16863
; ------------------
16864
; Handle delete (02)
16865
; ------------------
16866
; A simple return but when used as a calculator literal this
16867
; deletes the last value from the calculator stack.
16868
; On entry, as always with binary operations,
16869
; HL=first number, DE=second number
16870
; On exit, HL=result, DE=stkend.
16871
; So nothing to do
16872
 
16873
;; delete
16874
L33A1:  RET                     ; return - indirect jump if from above.
16875
 
16876
; ---------------------
16877
; Single operation (3B)
16878
; ---------------------
16879
;   This single operation is used, in the first instance, to evaluate most
16880
;   of the mathematical and string functions found in BASIC expressions.
16881
 
16882
;; fp-calc-2
16883
L33A2:  POP     AF              ; drop return address.
16884
        LD      A,($5C67)       ; load accumulator from system variable BREG
16885
                                ; value will be literal e.g. 'tan'
16886
        EXX                     ; switch to alt
16887
        JR      L336C           ; back to SCAN-ENT
16888
                                ; next literal will be end-calc at L2758
16889
 
16890
; ---------------------------------
16891
; THE 'TEST FIVE SPACES' SUBROUTINE
16892
; ---------------------------------
16893
;   This routine is called from MOVE-FP, STK-CONST and STK-STORE to test that
16894
;   there is enough space between the calculator stack and the machine stack
16895
;   for another five-byte value.  It returns with BC holding the value 5 ready
16896
;   for any subsequent LDIR.
16897
 
16898
;; TEST-5-SP
16899
L33A9:  PUSH    DE              ; save
16900
        PUSH    HL              ; registers
16901
        LD      BC,$0005        ; an overhead of five bytes
16902
        CALL    L1F05           ; routine TEST-ROOM tests free RAM raising
16903
                                ; an error if not.
16904
        POP     HL              ; else restore
16905
        POP     DE              ; registers.
16906
        RET                     ; return with BC set at 5.
16907
 
16908
; -----------------------------
16909
; THE 'STACK NUMBER' SUBROUTINE
16910
; -----------------------------
16911
;   This routine is called to stack a hidden floating point number found in
16912
;   a BASIC line.  It is also called to stack a numeric variable value, and
16913
;   from BEEP, to stack an entry in the semi-tone table.  It is not part of the
16914
;   calculator suite of routines.  On entry, HL points to the number to be
16915
;   stacked.
16916
 
16917
;; STACK-NUM
16918
L33B4:  LD      DE,($5C65)      ; Load destination from STKEND system variable.
16919
 
16920
        CALL    L33C0           ; Routine MOVE-FP puts on calculator stack
16921
                                ; with a memory check.
16922
        LD      ($5C65),DE      ; Set STKEND to next free location.
16923
 
16924
        RET                     ; Return.
16925
 
16926
; ---------------------------------
16927
; Move a floating point number (31)
16928
; ---------------------------------
16929
 
16930
; This simple routine is a 5-byte LDIR instruction
16931
; that incorporates a memory check.
16932
; When used as a calculator literal it duplicates the last value on the
16933
; calculator stack.
16934
; Unary so on entry HL points to last value, DE to stkend
16935
 
16936
;; duplicate
16937
;; MOVE-FP
16938
L33C0:  CALL    L33A9           ; routine TEST-5-SP test free memory
16939
                                ; and sets BC to 5.
16940
        LDIR                    ; copy the five bytes.
16941
        RET                     ; return with DE addressing new STKEND
16942
                                ; and HL addressing new last value.
16943
 
16944
; -------------------
16945
; Stack literals ($34)
16946
; -------------------
16947
; When a calculator subroutine needs to put a value on the calculator
16948
; stack that is not a regular constant this routine is called with a
16949
; variable number of following data bytes that convey to the routine
16950
; the integer or floating point form as succinctly as is possible.
16951
 
16952
;; stk-data
16953
L33C6:  LD      H,D             ; transfer STKEND
16954
        LD      L,E             ; to HL for result.
16955
 
16956
;; STK-CONST
16957
L33C8:  CALL    L33A9           ; routine TEST-5-SP tests that room exists
16958
                                ; and sets BC to $05.
16959
 
16960
        EXX                     ; switch to alternate set
16961
        PUSH    HL              ; save the pointer to next literal on stack
16962
        EXX                     ; switch back to main set
16963
 
16964
        EX      (SP),HL         ; pointer to HL, destination to stack.
16965
 
16966
        PUSH    BC              ; save BC - value 5 from test room ??.
16967
 
16968
        LD      A,(HL)          ; fetch the byte following 'stk-data'
16969
        AND     $C0             ; isolate bits 7 and 6
16970
        RLCA                    ; rotate
16971
        RLCA                    ; to bits 1 and 0  range $00 - $03.
16972
        LD      C,A             ; transfer to C
16973
        INC     C               ; and increment to give number of bytes
16974
                                ; to read. $01 - $04
16975
        LD      A,(HL)          ; reload the first byte
16976
        AND     $3F             ; mask off to give possible exponent.
16977
        JR      NZ,L33DE        ; forward to FORM-EXP if it was possible to
16978
                                ; include the exponent.
16979
 
16980
; else byte is just a byte count and exponent comes next.
16981
 
16982
        INC     HL              ; address next byte and
16983
        LD      A,(HL)          ; pick up the exponent ( - $50).
16984
 
16985
;; FORM-EXP
16986
L33DE:  ADD     A,$50           ; now add $50 to form actual exponent
16987
        LD      (DE),A          ; and load into first destination byte.
16988
        LD      A,$05           ; load accumulator with $05 and
16989
        SUB     C               ; subtract C to give count of trailing
16990
                                ; zeros plus one.
16991
        INC     HL              ; increment source
16992
        INC     DE              ; increment destination
16993
        LD      B,$00           ; prepare to copy
16994
        LDIR                    ; copy C bytes
16995
 
16996
        POP     BC              ; restore 5 counter to BC ??.
16997
 
16998
        EX      (SP),HL         ; put HL on stack as next literal pointer
16999
                                ; and the stack value - result pointer -
17000
                                ; to HL.
17001
 
17002
        EXX                     ; switch to alternate set.
17003
        POP     HL              ; restore next literal pointer from stack
17004
                                ; to H'L'.
17005
        EXX                     ; switch back to main set.
17006
 
17007
        LD      B,A             ; zero count to B
17008
        XOR     A               ; clear accumulator
17009
 
17010
;; STK-ZEROS
17011
L33F1:  DEC     B               ; decrement B counter
17012
        RET     Z               ; return if zero.          >>
17013
                                ; DE points to new STKEND
17014
                                ; HL to new number.
17015
 
17016
        LD      (DE),A          ; else load zero to destination
17017
        INC     DE              ; increase destination
17018
        JR      L33F1           ; loop back to STK-ZEROS until done.
17019
 
17020
; -------------------------------
17021
; THE 'SKIP CONSTANTS' SUBROUTINE
17022
; -------------------------------
17023
;   This routine traverses variable-length entries in the table of constants,
17024
;   stacking intermediate, unwanted constants onto a dummy calculator stack,
17025
;   in the first five bytes of ROM.  The destination DE normally points to the
17026
;   end of the calculator stack which might be in the normal place or in the
17027
;   system variables area during E-LINE-NO; INT-TO-FP; stk-ten.  In any case,
17028
;   it would be simpler all round if the routine just shoved unwanted values
17029
;   where it is going to stick the wanted value.  The instruction LD DE, $0000
17030
;   can be removed.
17031
 
17032
;; SKIP-CONS
17033
L33F7:  AND     A               ; test if initially zero.
17034
 
17035
;; SKIP-NEXT
17036
L33F8:  RET     Z               ; return if zero.          >>
17037
 
17038
        PUSH    AF              ; save count.
17039
        PUSH    DE              ; and normal STKEND
17040
 
17041
        LD      DE,$0000        ; dummy value for STKEND at start of ROM
17042
                                ; Note. not a fault but this has to be
17043
                                ; moved elsewhere when running in RAM.
17044
                                ; e.g. with Expandor Systems 'Soft ROM'.
17045
                                ; Better still, write to the normal place.
17046
        CALL    L33C8           ; routine STK-CONST works through variable
17047
                                ; length records.
17048
 
17049
        POP     DE              ; restore real STKEND
17050
        POP     AF              ; restore count
17051
        DEC     A               ; decrease
17052
        JR      L33F8           ; loop back to SKIP-NEXT
17053
 
17054
; ------------------------------
17055
; THE 'LOCATE MEMORY' SUBROUTINE
17056
; ------------------------------
17057
;   This routine, when supplied with a base address in HL and an index in A,
17058
;   will calculate the address of the A'th entry, where each entry occupies
17059
;   five bytes.  It is used for reading the semi-tone table and addressing
17060
;   floating-point numbers in the calculator's memory area.
17061
;   It is not possible to use this routine for the table of constants as these
17062
;   six values are held in compressed format.
17063
 
17064
;; LOC-MEM
17065
L3406:  LD      C,A             ; store the original number $00-$1F.
17066
        RLCA                    ; X2 - double.
17067
        RLCA                    ; X4 - quadruple.
17068
        ADD     A,C             ; X5 - now add original to multiply by five.
17069
 
17070
        LD      C,A             ; place the result in the low byte.
17071
        LD      B,$00           ; set high byte to zero.
17072
        ADD     HL,BC           ; add to form address of start of number in HL.
17073
 
17074
        RET                     ; return.
17075
 
17076
; ------------------------------
17077
; Get from memory area ($E0 etc.)
17078
; ------------------------------
17079
; Literals $E0 to $FF
17080
; A holds $00-$1F offset.
17081
; The calculator stack increases by 5 bytes.
17082
 
17083
;; get-mem-xx
17084
L340F:  PUSH    DE              ; save STKEND
17085
        LD      HL,($5C68)      ; MEM is base address of the memory cells.
17086
        CALL    L3406           ; routine LOC-MEM so that HL = first byte
17087
        CALL    L33C0           ; routine MOVE-FP moves 5 bytes with memory
17088
                                ; check.
17089
                                ; DE now points to new STKEND.
17090
        POP     HL              ; original STKEND is now RESULT pointer.
17091
        RET                     ; return.
17092
 
17093
; --------------------------
17094
; Stack a constant (A0 etc.)
17095
; --------------------------
17096
; This routine allows a one-byte instruction to stack up to 32 constants
17097
; held in short form in a table of constants. In fact only 5 constants are
17098
; required. On entry the A register holds the literal ANDed with 1F.
17099
; It isn't very efficient and it would have been better to hold the
17100
; numbers in full, five byte form and stack them in a similar manner
17101
; to that used for semi-tone table values.
17102
 
17103
;; stk-const-xx
17104
L341B:  LD      H,D             ; save STKEND - required for result
17105
        LD      L,E             ;
17106
        EXX                     ; swap
17107
        PUSH    HL              ; save pointer to next literal
17108
        LD      HL,L32C5        ; Address: stk-zero - start of table of
17109
                                ; constants
17110
        EXX                     ;
17111
        CALL    L33F7           ; routine SKIP-CONS
17112
        CALL    L33C8           ; routine STK-CONST
17113
        EXX                     ;
17114
        POP     HL              ; restore pointer to next literal.
17115
        EXX                     ;
17116
        RET                     ; return.
17117
 
17118
; --------------------------------
17119
; Store in a memory area ($C0 etc.)
17120
; --------------------------------
17121
; Offsets $C0 to $DF
17122
; Although 32 memory storage locations can be addressed, only six
17123
; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5)
17124
; required for these are allocated. Spectrum programmers who wish to
17125
; use the floating point routines from assembly language may wish to
17126
; alter the system variable MEM to point to 160 bytes of RAM to have
17127
; use the full range available.
17128
; A holds the derived offset $00-$1F.
17129
; This is a unary operation, so on entry HL points to the last value and DE
17130
; points to STKEND.
17131
 
17132
;; st-mem-xx
17133
L342D:  PUSH    HL              ; save the result pointer.
17134
        EX      DE,HL           ; transfer to DE.
17135
        LD      HL,($5C68)      ; fetch MEM the base of memory area.
17136
        CALL    L3406           ; routine LOC-MEM sets HL to the destination.
17137
        EX      DE,HL           ; swap - HL is start, DE is destination.
17138
        CALL    L33C0           ; routine MOVE-FP.
17139
                                ; note. a short ld bc,5; ldir
17140
                                ; the embedded memory check is not required
17141
                                ; so these instructions would be faster.
17142
        EX      DE,HL           ; DE = STKEND
17143
        POP     HL              ; restore original result pointer
17144
        RET                     ; return.
17145
 
17146
; -------------------------
17147
; THE 'EXCHANGE' SUBROUTINE
17148
; -------------------------
17149
; (offset: $01 'exchange')
17150
;   This routine swaps the last two values on the calculator stack.
17151
;   On entry, as always with binary operations,
17152
;   HL=first number, DE=second number
17153
;   On exit, HL=result, DE=stkend.
17154
 
17155
;; exchange
17156
L343C:  LD      B,$05           ; there are five bytes to be swapped
17157
 
17158
; start of loop.
17159
 
17160
;; SWAP-BYTE
17161
L343E:  LD      A,(DE)          ; each byte of second
17162
        LD      C,(HL)          ; each byte of first
17163
        EX      DE,HL           ; swap pointers
17164
        LD      (DE),A          ; store each byte of first
17165
        LD      (HL),C          ; store each byte of second
17166
        INC     HL              ; advance both
17167
        INC     DE              ; pointers.
17168
        DJNZ    L343E           ; loop back to SWAP-BYTE until all 5 done.
17169
 
17170
        EX      DE,HL           ; even up the exchanges so that DE addresses
17171
                                ; STKEND.
17172
 
17173
        RET                     ; return.
17174
 
17175
; ------------------------------
17176
; THE 'SERIES GENERATOR' ROUTINE
17177
; ------------------------------
17178
; (offset: $86 'series-06')
17179
; (offset: $88 'series-08')
17180
; (offset: $8C 'series-0C')
17181
;   The Spectrum uses Chebyshev polynomials to generate approximations for
17182
;   SIN, ATN, LN and EXP.  These are named after the Russian mathematician
17183
;   Pafnuty Chebyshev, born in 1821, who did much pioneering work on numerical
17184
;   series.  As far as calculators are concerned, Chebyshev polynomials have an
17185
;   advantage over other series, for example the Taylor series, as they can
17186
;   reach an approximation in just six iterations for SIN, eight for EXP and
17187
;   twelve for LN and ATN.  The mechanics of the routine are interesting but
17188
;   for full treatment of how these are generated with demonstrations in
17189
;   Sinclair BASIC see "The Complete Spectrum ROM Disassembly" by Dr Ian Logan
17190
;   and Dr Frank O'Hara, published 1983 by Melbourne House.
17191
 
17192
;; series-xx
17193
L3449:  LD      B,A             ; parameter $00 - $1F to B counter
17194
        CALL    L335E           ; routine GEN-ENT-1 is called.
17195
                                ; A recursive call to a special entry point
17196
                                ; in the calculator that puts the B register
17197
                                ; in the system variable BREG. The return
17198
                                ; address is the next location and where
17199
                                ; the calculator will expect its first
17200
                                ; instruction - now pointed to by HL'.
17201
                                ; The previous pointer to the series of
17202
                                ; five-byte numbers goes on the machine stack.
17203
 
17204
; The initialization phase.
17205
 
17206
        DEFB    $31             ;;duplicate       x,x
17207
        DEFB    $0F             ;;addition        x+x
17208
        DEFB    $C0             ;;st-mem-0        x+x
17209
        DEFB    $02             ;;delete          .
17210
        DEFB    $A0             ;;stk-zero        0
17211
        DEFB    $C2             ;;st-mem-2        0
17212
 
17213
; a loop is now entered to perform the algebraic calculation for each of
17214
; the numbers in the series
17215
 
17216
;; G-LOOP
17217
L3453:  DEFB    $31             ;;duplicate       v,v.
17218
        DEFB    $E0             ;;get-mem-0       v,v,x+2
17219
        DEFB    $04             ;;multiply        v,v*x+2
17220
        DEFB    $E2             ;;get-mem-2       v,v*x+2,v
17221
        DEFB    $C1             ;;st-mem-1
17222
        DEFB    $03             ;;subtract
17223
        DEFB    $38             ;;end-calc
17224
 
17225
; the previous pointer is fetched from the machine stack to H'L' where it
17226
; addresses one of the numbers of the series following the series literal.
17227
 
17228
        CALL    L33C6           ; routine STK-DATA is called directly to
17229
                                ; push a value and advance H'L'.
17230
        CALL    L3362           ; routine GEN-ENT-2 recursively re-enters
17231
                                ; the calculator without disturbing
17232
                                ; system variable BREG
17233
                                ; H'L' value goes on the machine stack and is
17234
                                ; then loaded as usual with the next address.
17235
 
17236
        DEFB    $0F             ;;addition
17237
        DEFB    $01             ;;exchange
17238
        DEFB    $C2             ;;st-mem-2
17239
        DEFB    $02             ;;delete
17240
 
17241
        DEFB    $35             ;;dec-jr-nz
17242
        DEFB    $EE             ;;back to L3453, G-LOOP
17243
 
17244
; when the counted loop is complete the final subtraction yields the result
17245
; for example SIN X.
17246
 
17247
        DEFB    $E1             ;;get-mem-1
17248
        DEFB    $03             ;;subtract
17249
        DEFB    $38             ;;end-calc
17250
 
17251
        RET                     ; return with H'L' pointing to location
17252
                                ; after last number in series.
17253
 
17254
; ---------------------------------
17255
; THE 'ABSOLUTE MAGNITUDE' FUNCTION
17256
; ---------------------------------
17257
; (offset: $2A 'abs')
17258
;   This calculator literal finds the absolute value of the last value,
17259
;   integer or floating point, on calculator stack.
17260
 
17261
;; abs
17262
L346A:  LD      B,$FF           ; signal abs
17263
        JR      L3474           ; forward to NEG-TEST
17264
 
17265
; ---------------------------
17266
; THE 'UNARY MINUS' OPERATION
17267
; ---------------------------
17268
; (offset: $1B 'negate')
17269
;   Unary so on entry HL points to last value, DE to STKEND.
17270
 
17271
;; NEGATE
17272
;; negate
17273
L346E:  CALL    L34E9           ; call routine TEST-ZERO and
17274
        RET     C               ; return if so leaving zero unchanged.
17275
 
17276
        LD      B,$00           ; signal negate required before joining
17277
                                ; common code.
17278
 
17279
;; NEG-TEST
17280
L3474:  LD      A,(HL)          ; load first byte and
17281
        AND     A               ; test for zero
17282
        JR      Z,L3483         ; forward to INT-CASE if a small integer
17283
 
17284
; for floating point numbers a single bit denotes the sign.
17285
 
17286
        INC     HL              ; address the first byte of mantissa.
17287
        LD      A,B             ; action flag $FF=abs, $00=neg.
17288
        AND     $80             ; now         $80      $00
17289
        OR      (HL)            ; sets bit 7 for abs
17290
        RLA                     ; sets carry for abs and if number negative
17291
        CCF                     ; complement carry flag
17292
        RRA                     ; and rotate back in altering sign
17293
        LD      (HL),A          ; put the altered adjusted number back
17294
        DEC     HL              ; HL points to result
17295
        RET                     ; return with DE unchanged
17296
 
17297
; ---
17298
 
17299
; for integer numbers an entire byte denotes the sign.
17300
 
17301
;; INT-CASE
17302
L3483:  PUSH    DE              ; save STKEND.
17303
 
17304
        PUSH    HL              ; save pointer to the last value/result.
17305
 
17306
        CALL    L2D7F           ; routine INT-FETCH puts integer in DE
17307
                                ; and the sign in C.
17308
 
17309
        POP     HL              ; restore the result pointer.
17310
 
17311
        LD      A,B             ; $FF=abs, $00=neg
17312
        OR      C               ; $FF for abs, no change neg
17313
        CPL                     ; $00 for abs, switched for neg
17314
        LD      C,A             ; transfer result to sign byte.
17315
 
17316
        CALL    L2D8E           ; routine INT-STORE to re-write the integer.
17317
 
17318
        POP     DE              ; restore STKEND.
17319
        RET                     ; return.
17320
 
17321
; ---------------------
17322
; THE 'SIGNUM' FUNCTION
17323
; ---------------------
17324
; (offset: $29 'sgn')
17325
;   This routine replaces the last value on the calculator stack,
17326
;   which may be in floating point or integer form, with the integer values
17327
;   zero if zero, with one if positive and  with -minus one if negative.
17328
 
17329
;; sgn
17330
L3492:  CALL    L34E9           ; call routine TEST-ZERO and
17331
        RET     C               ; exit if so as no change is required.
17332
 
17333
        PUSH    DE              ; save pointer to STKEND.
17334
 
17335
        LD      DE,$0001        ; the result will be 1.
17336
        INC     HL              ; skip over the exponent.
17337
        RL      (HL)            ; rotate the sign bit into the carry flag.
17338
        DEC     HL              ; step back to point to the result.
17339
        SBC     A,A             ; byte will be $FF if negative, $00 if positive.
17340
        LD      C,A             ; store the sign byte in the C register.
17341
        CALL    L2D8E           ; routine INT-STORE to overwrite the last
17342
                                ; value with 0001 and sign.
17343
 
17344
        POP     DE              ; restore STKEND.
17345
        RET                     ; return.
17346
 
17347
; -----------------
17348
; THE 'IN' FUNCTION
17349
; -----------------
17350
; (offset: $2C 'in')
17351
;   This function reads a byte from an input port.
17352
 
17353
;; in
17354
L34A5:  CALL    L1E99           ; Routine FIND-INT2 puts port address in BC.
17355
                                ; All 16 bits are put on the address line.
17356
 
17357
        IN      A,(C)           ; Read the port.
17358
 
17359
        JR      L34B0           ; exit to STACK-A (via IN-PK-STK to save a byte
17360
                                ; of instruction code).
17361
 
17362
; -------------------
17363
; THE 'PEEK' FUNCTION
17364
; -------------------
17365
; (offset: $2B 'peek')
17366
;   This function returns the contents of a memory address.
17367
;   The entire address space can be peeked including the ROM.
17368
 
17369
;; peek
17370
L34AC:  CALL    L1E99           ; routine FIND-INT2 puts address in BC.
17371
        LD      A,(BC)          ; load contents into A register.
17372
 
17373
;; IN-PK-STK
17374
L34B0:  JP      L2D28           ; exit via STACK-A to put the value on the
17375
                                ; calculator stack.
17376
 
17377
; ------------------
17378
; THE 'USR' FUNCTION
17379
; ------------------
17380
; (offset: $2d 'usr-no')
17381
;   The USR function followed by a number 0-65535 is the method by which
17382
;   the Spectrum invokes machine code programs. This function returns the
17383
;   contents of the BC register pair.
17384
;   Note. that STACK-BC re-initializes the IY register if a user-written
17385
;   program has altered it.
17386
 
17387
;; usr-no
17388
L34B3:  CALL    L1E99           ; routine FIND-INT2 to fetch the
17389
                                ; supplied address into BC.
17390
 
17391
        LD      HL,L2D2B        ; address: STACK-BC is
17392
        PUSH    HL              ; pushed onto the machine stack.
17393
        PUSH    BC              ; then the address of the machine code
17394
                                ; routine.
17395
 
17396
        RET                     ; make an indirect jump to the routine
17397
                                ; and, hopefully, to STACK-BC also.
17398
 
17399
; -------------------------
17400
; THE 'USR STRING' FUNCTION
17401
; -------------------------
17402
; (offset: $19 'usr-$')
17403
;   The user function with a one-character string argument, calculates the
17404
;   address of the User Defined Graphic character that is in the string.
17405
;   As an alternative, the ASCII equivalent, upper or lower case,
17406
;   may be supplied. This provides a user-friendly method of redefining
17407
;   the 21 User Definable Graphics e.g.
17408
;   POKE USR "a", BIN 10000000 will put a dot in the top left corner of the
17409
;   character 144.
17410
;   Note. the curious double check on the range. With 26 UDGs the first check
17411
;   only is necessary. With anything less the second check only is required.
17412
;   It is highly likely that the first check was written by Steven Vickers.
17413
 
17414
;; usr-$
17415
L34BC:  CALL    L2BF1           ; routine STK-FETCH fetches the string
17416
                                ; parameters.
17417
        DEC     BC              ; decrease BC by
17418
        LD      A,B             ; one to test
17419
        OR      C               ; the length.
17420
        JR      NZ,L34E7        ; to REPORT-A if not a single character.
17421
 
17422
        LD      A,(DE)          ; fetch the character
17423
        CALL    L2C8D           ; routine ALPHA sets carry if 'A-Z' or 'a-z'.
17424
        JR      C,L34D3         ; forward to USR-RANGE if ASCII.
17425
 
17426
        SUB     $90             ; make UDGs range 0-20d
17427
        JR      C,L34E7         ; to REPORT-A if too low. e.g. usr " ".
17428
 
17429
        CP      $15             ; Note. this test is not necessary.
17430
        JR      NC,L34E7        ; to REPORT-A if higher than 20.
17431
 
17432
        INC     A               ; make range 1-21d to match LSBs of ASCII
17433
 
17434
;; USR-RANGE
17435
L34D3:  DEC     A               ; make range of bits 0-4 start at zero
17436
        ADD     A,A             ; multiply by eight
17437
        ADD     A,A             ; and lose any set bits
17438
        ADD     A,A             ; range now 0 - 25*8
17439
        CP      $A8             ; compare to 21*8
17440
        JR      NC,L34E7        ; to REPORT-A if originally higher
17441
                                ; than 'U','u' or graphics U.
17442
 
17443
        LD      BC,($5C7B)      ; fetch the UDG system variable value.
17444
        ADD     A,C             ; add the offset to character
17445
        LD      C,A             ; and store back in register C.
17446
        JR      NC,L34E4        ; forward to USR-STACK if no overflow.
17447
 
17448
        INC     B               ; increment high byte.
17449
 
17450
;; USR-STACK
17451
L34E4:  JP      L2D2B           ; jump back and exit via STACK-BC to store
17452
 
17453
; ---
17454
 
17455
;; REPORT-A
17456
L34E7:  RST     08H             ; ERROR-1
17457
        DEFB    $09             ; Error Report: Invalid argument
17458
 
17459
; ------------------------------
17460
; THE 'TEST FOR ZERO' SUBROUTINE
17461
; ------------------------------
17462
;   Test if top value on calculator stack is zero.  The carry flag is set if
17463
;   the last value is zero but no registers are altered.
17464
;   All five bytes will be zero but first four only need be tested.
17465
;   On entry, HL points to the exponent the first byte of the value.
17466
 
17467
;; TEST-ZERO
17468
L34E9:  PUSH    HL              ; preserve HL which is used to address.
17469
        PUSH    BC              ; preserve BC which is used as a store.
17470
        LD      B,A             ; preserve A in B.
17471
 
17472
        LD      A,(HL)          ; load first byte to accumulator
17473
        INC     HL              ; advance.
17474
        OR      (HL)            ; OR with second byte and clear carry.
17475
        INC     HL              ; advance.
17476
        OR      (HL)            ; OR with third byte.
17477
        INC     HL              ; advance.
17478
        OR      (HL)            ; OR with fourth byte.
17479
 
17480
        LD      A,B             ; restore A without affecting flags.
17481
        POP     BC              ; restore the saved
17482
        POP     HL              ; registers.
17483
 
17484
        RET     NZ              ; return if not zero and with carry reset.
17485
 
17486
        SCF                     ; set the carry flag.
17487
        RET                     ; return with carry set if zero.
17488
 
17489
; --------------------------------
17490
; THE 'GREATER THAN ZERO' OPERATOR
17491
; --------------------------------
17492
; (offset: $37 'greater-0' )
17493
;   Test if the last value on the calculator stack is greater than zero.
17494
;   This routine is also called directly from the end-tests of the comparison
17495
;   routine.
17496
 
17497
;; GREATER-0
17498
;; greater-0
17499
L34F9:  CALL    L34E9           ; routine TEST-ZERO
17500
        RET     C               ; return if was zero as this
17501
                                ; is also the Boolean 'false' value.
17502
 
17503
        LD      A,$FF           ; prepare XOR mask for sign bit
17504
        JR      L3507           ; forward to SIGN-TO-C
17505
                                ; to put sign in carry
17506
                                ; (carry will become set if sign is positive)
17507
                                ; and then overwrite location with 1 or 0
17508
                                ; as appropriate.
17509
 
17510
; ------------------
17511
; THE 'NOT' FUNCTION
17512
; ------------------
17513
; (offset: $30 'not')
17514
;   This overwrites the last value with 1 if it was zero else with zero
17515
;   if it was any other value.
17516
;
17517
;   e.g. NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0.
17518
;
17519
;   The subroutine is also called directly from the end-tests of the comparison
17520
;   operator.
17521
 
17522
;; NOT
17523
;; not
17524
L3501:  CALL    L34E9           ; routine TEST-ZERO sets carry if zero
17525
 
17526
        JR      L350B           ; to FP-0/1 to overwrite operand with
17527
                                ; 1 if carry is set else to overwrite with zero.
17528
 
17529
; ------------------------------
17530
; THE 'LESS THAN ZERO' OPERATION
17531
; ------------------------------
17532
; (offset: $36 'less-0' )
17533
;   Destructively test if last value on calculator stack is less than zero.
17534
;   Bit 7 of second byte will be set if so.
17535
 
17536
;; less-0
17537
L3506:  XOR     A               ; set XOR mask to zero
17538
                                ; (carry will become set if sign is negative).
17539
 
17540
;   transfer sign of mantissa to Carry Flag.
17541
 
17542
;; SIGN-TO-C
17543
L3507:  INC     HL              ; address 2nd byte.
17544
        XOR     (HL)            ; bit 7 of HL will be set if number is negative.
17545
        DEC     HL              ; address 1st byte again.
17546
        RLCA                    ; rotate bit 7 of A to carry.
17547
 
17548
; ----------------------------
17549
; THE 'ZERO OR ONE' SUBROUTINE
17550
; ----------------------------
17551
;   This routine places an integer value of zero or one at the addressed
17552
;   location of the calculator stack or MEM area.  The value one is written if
17553
;   carry is set on entry else zero.
17554
 
17555
;; FP-0/1
17556
L350B:  PUSH    HL              ; save pointer to the first byte
17557
        LD      A,$00           ; load accumulator with zero - without
17558
                                ; disturbing flags.
17559
        LD      (HL),A          ; zero to first byte
17560
        INC     HL              ; address next
17561
        LD      (HL),A          ; zero to 2nd byte
17562
        INC     HL              ; address low byte of integer
17563
        RLA                     ; carry to bit 0 of A
17564
        LD      (HL),A          ; load one or zero to low byte.
17565
        RRA                     ; restore zero to accumulator.
17566
        INC     HL              ; address high byte of integer.
17567
        LD      (HL),A          ; put a zero there.
17568
        INC     HL              ; address fifth byte.
17569
        LD      (HL),A          ; put a zero there.
17570
        POP     HL              ; restore pointer to the first byte.
17571
        RET                     ; return.
17572
 
17573
; -----------------
17574
; THE 'OR' OPERATOR
17575
; -----------------
17576
; (offset: $07 'or' )
17577
; The Boolean OR operator. e.g. X OR Y
17578
; The result is zero if both values are zero else a non-zero value.
17579
;
17580
; e.g.    0 OR 0  returns 0.
17581
;        -3 OR 0  returns -3.
17582
;         0 OR -3 returns 1.
17583
;        -3 OR 2  returns 1.
17584
;
17585
; A binary operation.
17586
; On entry HL points to first operand (X) and DE to second operand (Y).
17587
 
17588
;; or
17589
L351B:  EX      DE,HL           ; make HL point to second number
17590
        CALL    L34E9           ; routine TEST-ZERO
17591
        EX      DE,HL           ; restore pointers
17592
        RET     C               ; return if result was zero - first operand,
17593
                                ; now the last value, is the result.
17594
 
17595
        SCF                     ; set carry flag
17596
        JR      L350B           ; back to FP-0/1 to overwrite the first operand
17597
                                ; with the value 1.
17598
 
17599
 
17600
; ---------------------------------
17601
; THE 'NUMBER AND NUMBER' OPERATION
17602
; ---------------------------------
17603
; (offset: $08 'no-&-no')
17604
;   The Boolean AND operator.
17605
;
17606
;   e.g.    -3 AND 2  returns -3.
17607
;           -3 AND 0  returns 0.
17608
;            0 and -2 returns 0.
17609
;            0 and 0  returns 0.
17610
;
17611
;   Compare with OR routine above.
17612
 
17613
;; no-&-no
17614
L3524:  EX      DE,HL           ; make HL address second operand.
17615
 
17616
        CALL    L34E9           ; routine TEST-ZERO sets carry if zero.
17617
 
17618
        EX      DE,HL           ; restore pointers.
17619
        RET     NC              ; return if second non-zero, first is result.
17620
 
17621
;
17622
 
17623
        AND     A               ; else clear carry.
17624
        JR      L350B           ; back to FP-0/1 to overwrite first operand
17625
                                ; with zero for return value.
17626
 
17627
; ---------------------------------
17628
; THE 'STRING AND NUMBER' OPERATION
17629
; ---------------------------------
17630
; (offset: $10 'str-&-no')
17631
;   e.g. "You Win" AND score>99 will return the string if condition is true
17632
;   or the null string if false.
17633
 
17634
;; str-&-no
17635
L352D:  EX      DE,HL           ; make HL point to the number.
17636
        CALL    L34E9           ; routine TEST-ZERO.
17637
        EX      DE,HL           ; restore pointers.
17638
        RET     NC              ; return if number was not zero - the string
17639
                                ; is the result.
17640
 
17641
;   if the number was zero (false) then the null string must be returned by
17642
;   altering the length of the string on the calculator stack to zero.
17643
 
17644
        PUSH    DE              ; save pointer to the now obsolete number
17645
                                ; (which will become the new STKEND)
17646
 
17647
        DEC     DE              ; point to the 5th byte of string descriptor.
17648
        XOR     A               ; clear the accumulator.
17649
        LD      (DE),A          ; place zero in high byte of length.
17650
        DEC     DE              ; address low byte of length.
17651
        LD      (DE),A          ; place zero there - now the null string.
17652
 
17653
        POP     DE              ; restore pointer - new STKEND.
17654
        RET                     ; return.
17655
 
17656
; ---------------------------
17657
; THE 'COMPARISON' OPERATIONS
17658
; ---------------------------
17659
; (offset: $0A 'no-gr-eql')
17660
; (offset: $0B 'nos-neql')
17661
; (offset: $0C 'no-grtr')
17662
; (offset: $0D 'no-less')
17663
; (offset: $0E 'nos-eql')
17664
; (offset: $11 'str-l-eql')
17665
; (offset: $12 'str-gr-eql')
17666
; (offset: $13 'strs-neql')
17667
; (offset: $14 'str-grtr')
17668
; (offset: $15 'str-less')
17669
; (offset: $16 'strs-eql')
17670
 
17671
;   True binary operations.
17672
;   A single entry point is used to evaluate six numeric and six string
17673
;   comparisons. On entry, the calculator literal is in the B register and
17674
;   the two numeric values, or the two string parameters, are on the
17675
;   calculator stack.
17676
;   The individual bits of the literal are manipulated to group similar
17677
;   operations although the SUB 8 instruction does nothing useful and merely
17678
;   alters the string test bit.
17679
;   Numbers are compared by subtracting one from the other, strings are
17680
;   compared by comparing every character until a mismatch, or the end of one
17681
;   or both, is reached.
17682
;
17683
;   Numeric Comparisons.
17684
;   --------------------
17685
;   The 'x>y' example is the easiest as it employs straight-thru logic.
17686
;   Number y is subtracted from x and the result tested for greater-0 yielding
17687
;   a final value 1 (true) or 0 (false).
17688
;   For 'x
17689
;   calculator stack.
17690
;   For 'x=y' NOT is applied to the subtraction result yielding true if the
17691
;   difference was zero and false with anything else.
17692
;   The first three numeric comparisons are just the opposite of the last three
17693
;   so the same processing steps are used and then a final NOT is applied.
17694
;
17695
; literal    Test   No  sub 8       ExOrNot  1st RRCA  exch sub  ?   End-Tests
17696
; =========  ====   == ======== === ======== ========  ==== ===  =  === === ===
17697
; no-l-eql   x<=y   09 00000001 dec 00000000 00000000  ---- x-y  ?  --- >0? NOT
17698
; no-gr-eql  x>=y   0A 00000010 dec 00000001 10000000c swap y-x  ?  --- >0? NOT
17699
; nos-neql   x<>y   0B 00000011 dec 00000010 00000001  ---- x-y  ?  NOT --- NOT
17700
; no-grtr    x>y    0C 00000100  -  00000100 00000010  ---- x-y  ?  --- >0? ---
17701
; no-less    x0? ---
17702
; nos-eql    x=y    0E 00000110  -  00000110 00000011  ---- x-y  ?  NOT --- ---
17703
;
17704
;                                                           comp -> C/F
17705
;                                                           ====    ===
17706
; str-l-eql  x$<=y$ 11 00001001 dec 00001000 00000100  ---- x$y$ 0  !or >0? NOT
17707
; str-gr-eql x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0  !or >0? NOT
17708
; strs-neql  x$<>y$ 13 00001011 dec 00001010 00000101  ---- x$y$ 0  !or >0? NOT
17709
; str-grtr   x$>y$  14 00001100  -  00001100 00000110  ---- x$y$ 0  !or >0? ---
17710
; str-less   x$0? ---
17711
; strs-eql   x$=y$  16 00001110  -  00001110 00000111  ---- x$y$ 0  !or >0? ---
17712
;
17713
;   String comparisons are a little different in that the eql/neql carry flag
17714
;   from the 2nd RRCA is, as before, fed into the first of the end tests but
17715
;   along the way it gets modified by the comparison process. The result on the
17716
;   stack always starts off as zero and the carry fed in determines if NOT is
17717
;   applied to it. So the only time the greater-0 test is applied is if the
17718
;   stack holds zero which is not very efficient as the test will always yield
17719
;   zero. The most likely explanation is that there were once separate end tests
17720
;   for numbers and strings.
17721
 
17722
;; no-l-eql,etc.
17723
L353B:  LD      A,B             ; transfer literal to accumulator.
17724
        SUB     $08             ; subtract eight - which is not useful.
17725
 
17726
        BIT     2,A             ; isolate '>', '<', '='.
17727
 
17728
        JR      NZ,L3543        ; skip to EX-OR-NOT with these.
17729
 
17730
        DEC     A               ; else make $00-$02, $08-$0A to match bits 0-2.
17731
 
17732
;; EX-OR-NOT
17733
L3543:  RRCA                    ; the first RRCA sets carry for a swap.
17734
        JR      NC,L354E        ; forward to NU-OR-STR with other 8 cases
17735
 
17736
; for the other 4 cases the two values on the calculator stack are exchanged.
17737
 
17738
        PUSH    AF              ; save A and carry.
17739
        PUSH    HL              ; save HL - pointer to first operand.
17740
                                ; (DE points to second operand).
17741
 
17742
        CALL    L343C           ; routine exchange swaps the two values.
17743
                                ; (HL = second operand, DE = STKEND)
17744
 
17745
        POP     DE              ; DE = first operand
17746
        EX      DE,HL           ; as we were.
17747
        POP     AF              ; restore A and carry.
17748
 
17749
; Note. it would be better if the 2nd RRCA preceded the string test.
17750
; It would save two duplicate bytes and if we also got rid of that sub 8
17751
; at the beginning we wouldn't have to alter which bit we test.
17752
 
17753
;; NU-OR-STR
17754
L354E:  BIT     2,A             ; test if a string comparison.
17755
        JR      NZ,L3559        ; forward to STRINGS if so.
17756
 
17757
; continue with numeric comparisons.
17758
 
17759
        RRCA                    ; 2nd RRCA causes eql/neql to set carry.
17760
        PUSH    AF              ; save A and carry
17761
 
17762
        CALL    L300F           ; routine subtract leaves result on stack.
17763
        JR      L358C           ; forward to END-TESTS
17764
 
17765
; ---
17766
 
17767
;; STRINGS
17768
L3559:  RRCA                    ; 2nd RRCA causes eql/neql to set carry.
17769
        PUSH    AF              ; save A and carry.
17770
 
17771
        CALL    L2BF1           ; routine STK-FETCH gets 2nd string params
17772
        PUSH    DE              ; save start2 *.
17773
        PUSH    BC              ; and the length.
17774
 
17775
        CALL    L2BF1           ; routine STK-FETCH gets 1st string
17776
                                ; parameters - start in DE, length in BC.
17777
        POP     HL              ; restore length of second to HL.
17778
 
17779
; A loop is now entered to compare, by subtraction, each corresponding character
17780
; of the strings. For each successful match, the pointers are incremented and
17781
; the lengths decreased and the branch taken back to here. If both string
17782
; remainders become null at the same time, then an exact match exists.
17783
 
17784
;; BYTE-COMP
17785
L3564:  LD      A,H             ; test if the second string
17786
        OR      L               ; is the null string and hold flags.
17787
 
17788
        EX      (SP),HL         ; put length2 on stack, bring start2 to HL *.
17789
        LD      A,B             ; hi byte of length1 to A
17790
 
17791
        JR      NZ,L3575        ; forward to SEC-PLUS if second not null.
17792
 
17793
        OR      C               ; test length of first string.
17794
 
17795
;; SECND-LOW
17796
L356B:  POP     BC              ; pop the second length off stack.
17797
        JR      Z,L3572         ; forward to BOTH-NULL if first string is also
17798
                                ; of zero length.
17799
 
17800
; the true condition - first is longer than second (SECND-LESS)
17801
 
17802
        POP     AF              ; restore carry (set if eql/neql)
17803
        CCF                     ; complement carry flag.
17804
                                ; Note. equality becomes false.
17805
                                ; Inequality is true. By swapping or applying
17806
                                ; a terminal 'not', all comparisons have been
17807
                                ; manipulated so that this is success path.
17808
        JR      L3588           ; forward to leave via STR-TEST
17809
 
17810
; ---
17811
; the branch was here with a match
17812
 
17813
;; BOTH-NULL
17814
L3572:  POP     AF              ; restore carry - set for eql/neql
17815
        JR      L3588           ; forward to STR-TEST
17816
 
17817
; ---
17818
; the branch was here when 2nd string not null and low byte of first is yet
17819
; to be tested.
17820
 
17821
 
17822
;; SEC-PLUS
17823
L3575:  OR      C               ; test the length of first string.
17824
        JR      Z,L3585         ; forward to FRST-LESS if length is zero.
17825
 
17826
; both strings have at least one character left.
17827
 
17828
        LD      A,(DE)          ; fetch character of first string.
17829
        SUB     (HL)            ; subtract with that of 2nd string.
17830
        JR      C,L3585         ; forward to FRST-LESS if carry set
17831
 
17832
        JR      NZ,L356B        ; back to SECND-LOW and then STR-TEST
17833
                                ; if not exact match.
17834
 
17835
        DEC     BC              ; decrease length of 1st string.
17836
        INC     DE              ; increment 1st string pointer.
17837
 
17838
        INC     HL              ; increment 2nd string pointer.
17839
        EX      (SP),HL         ; swap with length on stack
17840
        DEC     HL              ; decrement 2nd string length
17841
        JR      L3564           ; back to BYTE-COMP
17842
 
17843
; ---
17844
; the false condition.
17845
 
17846
;; FRST-LESS
17847
L3585:  POP     BC              ; discard length
17848
        POP     AF              ; pop A
17849
        AND     A               ; clear the carry for false result.
17850
 
17851
; ---
17852
; exact match and x$>y$ rejoin here
17853
 
17854
;; STR-TEST
17855
L3588:  PUSH    AF              ; save A and carry
17856
 
17857
        RST     28H             ;; FP-CALC
17858
        DEFB    $A0             ;;stk-zero      an initial false value.
17859
        DEFB    $38             ;;end-calc
17860
 
17861
; both numeric and string paths converge here.
17862
 
17863
;; END-TESTS
17864
L358C:  POP     AF              ; pop carry  - will be set if eql/neql
17865
        PUSH    AF              ; save it again.
17866
 
17867
        CALL    C,L3501         ; routine NOT sets true(1) if equal(0)
17868
                                ; or, for strings, applies true result.
17869
 
17870
        POP     AF              ; pop carry and
17871
        PUSH    AF              ; save A
17872
 
17873
        CALL    NC,L34F9        ; routine GREATER-0 tests numeric subtraction
17874
                                ; result but also needlessly tests the string
17875
                                ; value for zero - it must be.
17876
 
17877
        POP     AF              ; pop A
17878
        RRCA                    ; the third RRCA - test for '<=', '>=' or '<>'.
17879
        CALL    NC,L3501        ; apply a terminal NOT if so.
17880
        RET                     ; return.
17881
 
17882
; ------------------------------------
17883
; THE 'STRING CONCATENATION' OPERATION
17884
; ------------------------------------
17885
; (offset: $17 'strs-add')
17886
;   This literal combines two strings into one e.g. LET a$ = b$ + c$
17887
;   The two parameters of the two strings to be combined are on the stack.
17888
 
17889
;; strs-add
17890
L359C:  CALL    L2BF1           ; routine STK-FETCH fetches string parameters
17891
                                ; and deletes calculator stack entry.
17892
        PUSH    DE              ; save start address.
17893
        PUSH    BC              ; and length.
17894
 
17895
        CALL    L2BF1           ; routine STK-FETCH for first string
17896
        POP     HL              ; re-fetch first length
17897
        PUSH    HL              ; and save again
17898
        PUSH    DE              ; save start of second string
17899
        PUSH    BC              ; and its length.
17900
 
17901
        ADD     HL,BC           ; add the two lengths.
17902
        LD      B,H             ; transfer to BC
17903
        LD      C,L             ; and create
17904
        RST     30H             ; BC-SPACES in workspace.
17905
                                ; DE points to start of space.
17906
 
17907
        CALL    L2AB2           ; routine STK-STO-$ stores parameters
17908
                                ; of new string updating STKEND.
17909
 
17910
        POP     BC              ; length of first
17911
        POP     HL              ; address of start
17912
        LD      A,B             ; test for
17913
        OR      C               ; zero length.
17914
        JR      Z,L35B7         ; to OTHER-STR if null string
17915
 
17916
        LDIR                    ; copy string to workspace.
17917
 
17918
;; OTHER-STR
17919
L35B7:  POP     BC              ; now second length
17920
        POP     HL              ; and start of string
17921
        LD      A,B             ; test this one
17922
        OR      C               ; for zero length
17923
        JR      Z,L35BF         ; skip forward to STK-PNTRS if so as complete.
17924
 
17925
        LDIR                    ; else copy the bytes.
17926
                                ; and continue into next routine which
17927
                                ; sets the calculator stack pointers.
17928
 
17929
; -----------------------------------
17930
; THE 'SET STACK POINTERS' SUBROUTINE
17931
; -----------------------------------
17932
;   Register DE is set to STKEND and HL, the result pointer, is set to five
17933
;   locations below this.
17934
;   This routine is used when it is inconvenient to save these values at the
17935
;   time the calculator stack is manipulated due to other activity on the
17936
;   machine stack.
17937
;   This routine is also used to terminate the VAL and READ-IN  routines for
17938
;   the same reason and to initialize the calculator stack at the start of
17939
;   the CALCULATE routine.
17940
 
17941
;; STK-PNTRS
17942
L35BF:  LD      HL,($5C65)      ; fetch STKEND value from system variable.
17943
        LD      DE,$FFFB        ; the value -5
17944
        PUSH    HL              ; push STKEND value.
17945
 
17946
        ADD     HL,DE           ; subtract 5 from HL.
17947
 
17948
        POP     DE              ; pop STKEND to DE.
17949
        RET                     ; return.
17950
 
17951
; -------------------
17952
; THE 'CHR$' FUNCTION
17953
; -------------------
17954
; (offset: $2f 'chr$')
17955
;   This function returns a single character string that is a result of
17956
;   converting a number in the range 0-255 to a string e.g. CHR$ 65 = "A".
17957
 
17958
;; chrs
17959
L35C9:  CALL    L2DD5           ; routine FP-TO-A puts the number in A.
17960
 
17961
        JR      C,L35DC         ; forward to REPORT-Bd if overflow
17962
        JR      NZ,L35DC        ; forward to REPORT-Bd if negative
17963
 
17964
        PUSH    AF              ; save the argument.
17965
 
17966
        LD      BC,$0001        ; one space required.
17967
        RST     30H             ; BC-SPACES makes DE point to start
17968
 
17969
        POP     AF              ; restore the number.
17970
 
17971
        LD      (DE),A          ; and store in workspace
17972
 
17973
        CALL    L2AB2           ; routine STK-STO-$ stacks descriptor.
17974
 
17975
        EX      DE,HL           ; make HL point to result and DE to STKEND.
17976
        RET                     ; return.
17977
 
17978
; ---
17979
 
17980
;; REPORT-Bd
17981
L35DC:  RST     08H             ; ERROR-1
17982
        DEFB    $0A             ; Error Report: Integer out of range
17983
 
17984
; ----------------------------
17985
; THE 'VAL and VAL$' FUNCTIONS
17986
; ----------------------------
17987
; (offset: $1d 'val')
17988
; (offset: $18 'val$')
17989
;   VAL treats the characters in a string as a numeric expression.
17990
;   e.g. VAL "2.3" = 2.3, VAL "2+4" = 6, VAL ("2" + "4") = 24.
17991
;   VAL$ treats the characters in a string as a string expression.
17992
;   e.g. VAL$ (z$+"(2)") = a$(2) if z$ happens to be "a$".
17993
 
17994
;; val
17995
;; val$
17996
L35DE:  LD      HL,($5C5D)      ; fetch value of system variable CH_ADD
17997
        PUSH    HL              ; and save on the machine stack.
17998
        LD      A,B             ; fetch the literal (either $1D or $18).
17999
        ADD     A,$E3           ; add $E3 to form $00 (setting carry) or $FB.
18000
        SBC     A,A             ; now form $FF bit 6 = numeric result
18001
                                ; or $00 bit 6 = string result.
18002
        PUSH    AF              ; save this mask on the stack
18003
 
18004
        CALL    L2BF1           ; routine STK-FETCH fetches the string operand
18005
                                ; from calculator stack.
18006
 
18007
        PUSH    DE              ; save the address of the start of the string.
18008
        INC     BC              ; increment the length for a carriage return.
18009
 
18010
        RST     30H             ; BC-SPACES creates the space in workspace.
18011
        POP     HL              ; restore start of string to HL.
18012
        LD      ($5C5D),DE      ; load CH_ADD with start DE in workspace.
18013
 
18014
        PUSH    DE              ; save the start in workspace
18015
        LDIR                    ; copy string from program or variables or
18016
                                ; workspace to the workspace area.
18017
        EX      DE,HL           ; end of string + 1 to HL
18018
        DEC     HL              ; decrement HL to point to end of new area.
18019
        LD      (HL),$0D        ; insert a carriage return at end.
18020
        RES     7,(IY+$01)      ; update FLAGS  - signal checking syntax.
18021
        CALL    L24FB           ; routine SCANNING evaluates string
18022
                                ; expression and result.
18023
 
18024
        RST     18H             ; GET-CHAR fetches next character.
18025
        CP      $0D             ; is it the expected carriage return ?
18026
        JR      NZ,L360C        ; forward to V-RPORT-C if not
18027
                                ; 'Nonsense in BASIC'.
18028
 
18029
        POP     HL              ; restore start of string in workspace.
18030
        POP     AF              ; restore expected result flag (bit 6).
18031
        XOR     (IY+$01)        ; xor with FLAGS now updated by SCANNING.
18032
        AND     $40             ; test bit 6 - should be zero if result types
18033
                                ; match.
18034
 
18035
;; V-RPORT-C
18036
L360C:  JP      NZ,L1C8A        ; jump back to REPORT-C with a result mismatch.
18037
 
18038
        LD      ($5C5D),HL      ; set CH_ADD to the start of the string again.
18039
        SET     7,(IY+$01)      ; update FLAGS  - signal running program.
18040
        CALL    L24FB           ; routine SCANNING evaluates the string
18041
                                ; in full leaving result on calculator stack.
18042
 
18043
        POP     HL              ; restore saved character address in program.
18044
        LD      ($5C5D),HL      ; and reset the system variable CH_ADD.
18045
 
18046
        JR      L35BF           ; back to exit via STK-PNTRS.
18047
                                ; resetting the calculator stack pointers
18048
                                ; HL and DE from STKEND as it wasn't possible
18049
                                ; to preserve them during this routine.
18050
 
18051
; -------------------
18052
; THE 'STR$' FUNCTION
18053
; -------------------
18054
; (offset: $2e 'str$')
18055
;   This function produces a string comprising the characters that would appear
18056
;   if the numeric argument were printed.
18057
;   e.g. STR$ (1/10) produces "0.1".
18058
 
18059
;; str$
18060
L361F:  LD      BC,$0001        ; create an initial byte in workspace
18061
        RST     30H             ; using BC-SPACES restart.
18062
 
18063
        LD      ($5C5B),HL      ; set system variable K_CUR to new location.
18064
        PUSH    HL              ; and save start on machine stack also.
18065
 
18066
        LD      HL,($5C51)      ; fetch value of system variable CURCHL
18067
        PUSH    HL              ; and save that too.
18068
 
18069
        LD      A,$FF           ; select system channel 'R'.
18070
        CALL    L1601           ; routine CHAN-OPEN opens it.
18071
        CALL    L2DE3           ; routine PRINT-FP outputs the number to
18072
                                ; workspace updating K-CUR.
18073
 
18074
        POP     HL              ; restore current channel.
18075
        CALL    L1615           ; routine CHAN-FLAG resets flags.
18076
 
18077
        POP     DE              ; fetch saved start of string to DE.
18078
        LD      HL,($5C5B)      ; load HL with end of string from K_CUR.
18079
 
18080
        AND     A               ; prepare for true subtraction.
18081
        SBC     HL,DE           ; subtract start from end to give length.
18082
        LD      B,H             ; transfer the length to
18083
        LD      C,L             ; the BC register pair.
18084
 
18085
        CALL    L2AB2           ; routine STK-STO-$ stores string parameters
18086
                                ; on the calculator stack.
18087
 
18088
        EX      DE,HL           ; HL = last value, DE = STKEND.
18089
        RET                     ; return.
18090
 
18091
; ------------------------
18092
; THE 'READ-IN' SUBROUTINE
18093
; ------------------------
18094
; (offset: $1a 'read-in')
18095
;   This is the calculator literal used by the INKEY$ function when a '#'
18096
;   is encountered after the keyword.
18097
;   INKEY$ # does not interact correctly with the keyboard, #0 or #1, and
18098
;   its uses are for other channels.
18099
 
18100
;; read-in
18101
L3645:  CALL    L1E94           ; routine FIND-INT1 fetches stream to A
18102
        CP      $10             ; compare with 16 decimal.
18103
        JP      NC,L1E9F        ; JUMP to REPORT-Bb if not in range 0 - 15.
18104
                                ; 'Integer out of range'
18105
                                ; (REPORT-Bd is within range)
18106
 
18107
        LD      HL,($5C51)      ; fetch current channel CURCHL
18108
        PUSH    HL              ; save it
18109
 
18110
        CALL    L1601           ; routine CHAN-OPEN opens channel
18111
 
18112
        CALL    L15E6           ; routine INPUT-AD - the channel must have an
18113
                                ; input stream or else error here from stream
18114
                                ; stub.
18115
        LD      BC,$0000        ; initialize length of string to zero
18116
        JR      NC,L365F        ; forward to R-I-STORE if no key detected.
18117
 
18118
        INC     C               ; increase length to one.
18119
 
18120
        RST     30H             ; BC-SPACES creates space for one character
18121
                                ; in workspace.
18122
        LD      (DE),A          ; the character is inserted.
18123
 
18124
;; R-I-STORE
18125
L365F:  CALL    L2AB2           ; routine STK-STO-$ stacks the string
18126
                                ; parameters.
18127
        POP     HL              ; restore current channel address
18128
 
18129
        CALL    L1615           ; routine CHAN-FLAG resets current channel
18130
                                ; system variable and flags.
18131
 
18132
        JP      L35BF           ; jump back to STK-PNTRS
18133
 
18134
; -------------------
18135
; THE 'CODE' FUNCTION
18136
; -------------------
18137
; (offset: $1c 'code')
18138
;   Returns the ASCII code of a character or first character of a string
18139
;   e.g. CODE "Aardvark" = 65, CODE "" = 0.
18140
 
18141
;; code
18142
L3669:  CALL    L2BF1           ; routine STK-FETCH to fetch and delete the
18143
                                ; string parameters.
18144
                                ; DE points to the start, BC holds the length.
18145
 
18146
        LD      A,B             ; test length
18147
        OR      C               ; of the string.
18148
        JR      Z,L3671         ; skip to STK-CODE with zero if the null string.
18149
 
18150
        LD      A,(DE)          ; else fetch the first character.
18151
 
18152
;; STK-CODE
18153
L3671:  JP      L2D28           ; jump back to STACK-A (with memory check)
18154
 
18155
; ------------------
18156
; THE 'LEN' FUNCTION
18157
; ------------------
18158
; (offset: $1e 'len')
18159
;   Returns the length of a string.
18160
;   In Sinclair BASIC strings can be more than twenty thousand characters long
18161
;   so a sixteen-bit register is required to store the length
18162
 
18163
;; len
18164
L3674:  CALL    L2BF1           ; Routine STK-FETCH to fetch and delete the
18165
                                ; string parameters from the calculator stack.
18166
                                ; Register BC now holds the length of string.
18167
 
18168
        JP      L2D2B           ; Jump back to STACK-BC to save result on the
18169
                                ; calculator stack (with memory check).
18170
 
18171
; -------------------------------------
18172
; THE 'DECREASE THE COUNTER' SUBROUTINE
18173
; -------------------------------------
18174
; (offset: $35 'dec-jr-nz')
18175
;   The calculator has an instruction that decrements a single-byte
18176
;   pseudo-register and makes consequential relative jumps just like
18177
;   the Z80's DJNZ instruction.
18178
 
18179
;; dec-jr-nz
18180
L367A:  EXX                     ; switch in set that addresses code
18181
 
18182
        PUSH    HL              ; save pointer to offset byte
18183
        LD      HL,$5C67        ; address BREG in system variables
18184
        DEC     (HL)            ; decrement it
18185
        POP     HL              ; restore pointer
18186
 
18187
        JR      NZ,L3687        ; to JUMP-2 if not zero
18188
 
18189
        INC     HL              ; step past the jump length.
18190
        EXX                     ; switch in the main set.
18191
        RET                     ; return.
18192
 
18193
; Note. as a general rule the calculator avoids using the IY register
18194
; otherwise the cumbersome 4 instructions in the middle could be replaced by
18195
; dec (iy+$2d) - three bytes instead of six.
18196
 
18197
 
18198
; ---------------------
18199
; THE 'JUMP' SUBROUTINE
18200
; ---------------------
18201
; (offset: $33 'jump')
18202
;   This enables the calculator to perform relative jumps just like the Z80
18203
;   chip's JR instruction.
18204
 
18205
;; jump
18206
;; JUMP
18207
L3686:  EXX                     ; switch in pointer set
18208
 
18209
;; JUMP-2
18210
L3687:  LD      E,(HL)          ; the jump byte 0-127 forward, 128-255 back.
18211
        LD      A,E             ; transfer to accumulator.
18212
        RLA                     ; if backward jump, carry is set.
18213
        SBC     A,A             ; will be $FF if backward or $00 if forward.
18214
        LD      D,A             ; transfer to high byte.
18215
        ADD     HL,DE           ; advance calculator pointer forward or back.
18216
 
18217
        EXX                     ; switch back.
18218
        RET                     ; return.
18219
 
18220
; --------------------------
18221
; THE 'JUMP-TRUE' SUBROUTINE
18222
; --------------------------
18223
; (offset: $00 'jump-true')
18224
;   This enables the calculator to perform conditional relative jumps dependent
18225
;   on whether the last test gave a true result.
18226
 
18227
;; jump-true
18228
L368F:  INC     DE              ; Collect the
18229
        INC     DE              ; third byte
18230
        LD      A,(DE)          ; of the test
18231
        DEC     DE              ; result and
18232
        DEC     DE              ; backtrack.
18233
 
18234
        AND     A               ; Is result 0 or 1 ?
18235
        JR      NZ,L3686        ; Back to JUMP if true (1).
18236
 
18237
        EXX                     ; Else switch in the pointer set.
18238
        INC     HL              ; Step past the jump length.
18239
        EXX                     ; Switch in the main set.
18240
        RET                     ; Return.
18241
 
18242
; -------------------------
18243
; THE 'END-CALC' SUBROUTINE
18244
; -------------------------
18245
; (offset: $38 'end-calc')
18246
;   The end-calc literal terminates a mini-program written in the Spectrum's
18247
;   internal language.
18248
 
18249
;; end-calc
18250
L369B:  POP     AF              ; Drop the calculator return address RE-ENTRY
18251
        EXX                     ; Switch to the other set.
18252
 
18253
        EX      (SP),HL         ; Transfer H'L' to machine stack for the
18254
                                ; return address.
18255
                                ; When exiting recursion, then the previous
18256
                                ; pointer is transferred to H'L'.
18257
 
18258
        EXX                     ; Switch back to main set.
18259
        RET                     ; Return.
18260
 
18261
 
18262
; ------------------------
18263
; THE 'MODULUS' SUBROUTINE
18264
; ------------------------
18265
; (offset: $32 'n-mod-m')
18266
; (n1,n2 -- r,q)
18267
;   Similar to FORTH's 'divide mod' /MOD
18268
;   On the Spectrum, this is only used internally by the RND function and could
18269
;   have been implemented inline.  On the ZX81, this calculator routine was also
18270
;   used by PRINT-FP.
18271
 
18272
;; n-mod-m
18273
L36A0:  RST     28H             ;; FP-CALC          17, 3.
18274
        DEFB    $C0             ;;st-mem-0          17, 3.
18275
        DEFB    $02             ;;delete            17.
18276
        DEFB    $31             ;;duplicate         17, 17.
18277
        DEFB    $E0             ;;get-mem-0         17, 17, 3.
18278
        DEFB    $05             ;;division          17, 17/3.
18279
        DEFB    $27             ;;int               17, 5.
18280
        DEFB    $E0             ;;get-mem-0         17, 5, 3.
18281
        DEFB    $01             ;;exchange          17, 3, 5.
18282
        DEFB    $C0             ;;st-mem-0          17, 3, 5.
18283
        DEFB    $04             ;;multiply          17, 15.
18284
        DEFB    $03             ;;subtract          2.
18285
        DEFB    $E0             ;;get-mem-0         2, 5.
18286
        DEFB    $38             ;;end-calc          2, 5.
18287
 
18288
        RET                     ; return.
18289
 
18290
 
18291
; ------------------
18292
; THE 'INT' FUNCTION
18293
; ------------------
18294
; (offset $27: 'int' )
18295
; This function returns the integer of x, which is just the same as truncate
18296
; for positive numbers. The truncate literal truncates negative numbers
18297
; upwards so that -3.4 gives -3 whereas the BASIC INT function has to
18298
; truncate negative numbers down so that INT -3.4 is -4.
18299
; It is best to work through using, say, +-3.4 as examples.
18300
 
18301
;; int
18302
L36AF:  RST     28H             ;; FP-CALC              x.    (= 3.4 or -3.4).
18303
        DEFB    $31             ;;duplicate             x, x.
18304
        DEFB    $36             ;;less-0                x, (1/0)
18305
        DEFB    $00             ;;jump-true             x, (1/0)
18306
        DEFB    $04             ;;to L36B7, X-NEG
18307
 
18308
        DEFB    $3A             ;;truncate              trunc 3.4 = 3.
18309
        DEFB    $38             ;;end-calc              3.
18310
 
18311
        RET                     ; return with + int x on stack.
18312
 
18313
; ---
18314
 
18315
 
18316
;; X-NEG
18317
L36B7:  DEFB    $31             ;;duplicate             -3.4, -3.4.
18318
        DEFB    $3A             ;;truncate              -3.4, -3.
18319
        DEFB    $C0             ;;st-mem-0              -3.4, -3.
18320
        DEFB    $03             ;;subtract              -.4
18321
        DEFB    $E0             ;;get-mem-0             -.4, -3.
18322
        DEFB    $01             ;;exchange              -3, -.4.
18323
        DEFB    $30             ;;not                   -3, (0).
18324
        DEFB    $00             ;;jump-true             -3.
18325
        DEFB    $03             ;;to L36C2, EXIT        -3.
18326
 
18327
        DEFB    $A1             ;;stk-one               -3, 1.
18328
        DEFB    $03             ;;subtract              -4.
18329
 
18330
;; EXIT
18331
L36C2:  DEFB    $38             ;;end-calc              -4.
18332
 
18333
        RET                     ; return.
18334
 
18335
 
18336
; ------------------
18337
; THE 'EXP' FUNCTION
18338
; ------------------
18339
; (offset $26: 'exp')
18340
;   The exponential function EXP x is equal to e^x, where e is the mathematical
18341
;   name for a number approximated to 2.718281828.
18342
;   ERROR 6 if argument is more than about 88.
18343
 
18344
;; EXP
18345
;; exp
18346
L36C4:  RST     28H             ;; FP-CALC
18347
        DEFB    $3D             ;;re-stack      (not required - mult will do)
18348
        DEFB    $34             ;;stk-data
18349
        DEFB    $F1             ;;Exponent: $81, Bytes: 4
18350
        DEFB    $38,$AA,$3B,$29 ;;
18351
        DEFB    $04             ;;multiply
18352
        DEFB    $31             ;;duplicate
18353
        DEFB    $27             ;;int
18354
        DEFB    $C3             ;;st-mem-3
18355
        DEFB    $03             ;;subtract
18356
        DEFB    $31             ;;duplicate
18357
        DEFB    $0F             ;;addition
18358
        DEFB    $A1             ;;stk-one
18359
        DEFB    $03             ;;subtract
18360
        DEFB    $88             ;;series-08
18361
        DEFB    $13             ;;Exponent: $63, Bytes: 1
18362
        DEFB    $36             ;;(+00,+00,+00)
18363
        DEFB    $58             ;;Exponent: $68, Bytes: 2
18364
        DEFB    $65,$66         ;;(+00,+00)
18365
        DEFB    $9D             ;;Exponent: $6D, Bytes: 3
18366
        DEFB    $78,$65,$40     ;;(+00)
18367
        DEFB    $A2             ;;Exponent: $72, Bytes: 3
18368
        DEFB    $60,$32,$C9     ;;(+00)
18369
        DEFB    $E7             ;;Exponent: $77, Bytes: 4
18370
        DEFB    $21,$F7,$AF,$24 ;;
18371
        DEFB    $EB             ;;Exponent: $7B, Bytes: 4
18372
        DEFB    $2F,$B0,$B0,$14 ;;
18373
        DEFB    $EE             ;;Exponent: $7E, Bytes: 4
18374
        DEFB    $7E,$BB,$94,$58 ;;
18375
        DEFB    $F1             ;;Exponent: $81, Bytes: 4
18376
        DEFB    $3A,$7E,$F8,$CF ;;
18377
        DEFB    $E3             ;;get-mem-3
18378
        DEFB    $38             ;;end-calc
18379
 
18380
        CALL    L2DD5           ; routine FP-TO-A
18381
        JR      NZ,L3705        ; to N-NEGTV
18382
 
18383
        JR      C,L3703         ; to REPORT-6b
18384
                                ; 'Number too big'
18385
 
18386
        ADD     A,(HL)          ;
18387
        JR      NC,L370C        ; to RESULT-OK
18388
 
18389
 
18390
;; REPORT-6b
18391
L3703:  RST     08H             ; ERROR-1
18392
        DEFB    $05             ; Error Report: Number too big
18393
 
18394
; ---
18395
 
18396
;; N-NEGTV
18397
L3705:  JR      C,L370E         ; to RSLT-ZERO
18398
 
18399
        SUB     (HL)            ;
18400
        JR      NC,L370E        ; to RSLT-ZERO
18401
 
18402
        NEG                     ; Negate
18403
 
18404
;; RESULT-OK
18405
L370C:  LD      (HL),A          ;
18406
        RET                     ; return.
18407
 
18408
; ---
18409
 
18410
 
18411
;; RSLT-ZERO
18412
L370E:  RST     28H             ;; FP-CALC
18413
        DEFB    $02             ;;delete
18414
        DEFB    $A0             ;;stk-zero
18415
        DEFB    $38             ;;end-calc
18416
 
18417
        RET                     ; return.
18418
 
18419
 
18420
; --------------------------------
18421
; THE 'NATURAL LOGARITHM' FUNCTION
18422
; --------------------------------
18423
; (offset $25: 'ln')
18424
;   Function to calculate the natural logarithm (to the base e ).
18425
;   Natural logarithms were devised in 1614 by well-traveled Scotsman John
18426
;   Napier who noted
18427
;   "Nothing doth more molest and hinder calculators than the multiplications,
18428
;    divisions, square and cubical extractions of great numbers".
18429
;
18430
;   Napier's logarithms enabled the above operations to be accomplished by
18431
;   simple addition and subtraction simplifying the navigational and
18432
;   astronomical calculations which beset his age.
18433
;   Napier's logarithms were quickly overtaken by logarithms to the base 10
18434
;   devised, in conjunction with Napier, by Henry Briggs a Cambridge-educated
18435
;   professor of Geometry at Oxford University. These simplified the layout
18436
;   of the tables enabling humans to easily scale calculations.
18437
;
18438
;   It is only recently with the introduction of pocket calculators and machines
18439
;   like the ZX Spectrum that natural logarithms are once more at the fore,
18440
;   although some computers retain logarithms to the base ten.
18441
;
18442
;   'Natural' logarithms are powers to the base 'e', which like 'pi' is a
18443
;   naturally occurring number in branches of mathematics.
18444
;   Like 'pi' also, 'e' is an irrational number and starts 2.718281828...
18445
;
18446
;   The tabular use of logarithms was that to multiply two numbers one looked
18447
;   up their two logarithms in the tables, added them together and then looked
18448
;   for the result in a table of antilogarithms to give the desired product.
18449
;
18450
;   The EXP function is the BASIC equivalent of a calculator's 'antiln' function
18451
;   and by picking any two numbers, 1.72 and 6.89 say,
18452
;     10 PRINT EXP ( LN 1.72 + LN 6.89 )
18453
;   will give just the same result as
18454
;     20 PRINT 1.72 * 6.89.
18455
;   Division is accomplished by subtracting the two logs.
18456
;
18457
;   Napier also mentioned "square and cubicle extractions".
18458
;   To raise a number to the power 3, find its 'ln', multiply by 3 and find the
18459
;   'antiln'.  e.g. PRINT EXP( LN 4 * 3 )  gives 64.
18460
;   Similarly to find the n'th root divide the logarithm by 'n'.
18461
;   The ZX81 ROM used PRINT EXP ( LN 9 / 2 ) to find the square root of the
18462
;   number 9. The Napieran square root function is just a special case of
18463
;   the 'to_power' function. A cube root or indeed any root/power would be just
18464
;   as simple.
18465
 
18466
;   First test that the argument to LN is a positive, non-zero number.
18467
;   Error A if the argument is 0 or negative.
18468
 
18469
;; ln
18470
L3713:  RST     28H             ;; FP-CALC
18471
        DEFB    $3D             ;;re-stack
18472
        DEFB    $31             ;;duplicate
18473
        DEFB    $37             ;;greater-0
18474
        DEFB    $00             ;;jump-true
18475
        DEFB    $04             ;;to L371C, VALID
18476
 
18477
        DEFB    $38             ;;end-calc
18478
 
18479
 
18480
;; REPORT-Ab
18481
L371A:  RST     08H             ; ERROR-1
18482
        DEFB    $09             ; Error Report: Invalid argument
18483
 
18484
;; VALID
18485
L371C:  DEFB    $A0             ;;stk-zero              Note. not
18486
        DEFB    $02             ;;delete                necessary.
18487
        DEFB    $38             ;;end-calc
18488
        LD      A,(HL)          ;
18489
 
18490
        LD      (HL),$80        ;
18491
        CALL    L2D28           ; routine STACK-A
18492
 
18493
        RST     28H             ;; FP-CALC
18494
        DEFB    $34             ;;stk-data
18495
        DEFB    $38             ;;Exponent: $88, Bytes: 1
18496
        DEFB    $00             ;;(+00,+00,+00)
18497
        DEFB    $03             ;;subtract
18498
        DEFB    $01             ;;exchange
18499
        DEFB    $31             ;;duplicate
18500
        DEFB    $34             ;;stk-data
18501
        DEFB    $F0             ;;Exponent: $80, Bytes: 4
18502
        DEFB    $4C,$CC,$CC,$CD ;;
18503
        DEFB    $03             ;;subtract
18504
        DEFB    $37             ;;greater-0
18505
        DEFB    $00             ;;jump-true
18506
        DEFB    $08             ;;to L373D, GRE.8
18507
 
18508
        DEFB    $01             ;;exchange
18509
        DEFB    $A1             ;;stk-one
18510
        DEFB    $03             ;;subtract
18511
        DEFB    $01             ;;exchange
18512
        DEFB    $38             ;;end-calc
18513
 
18514
        INC     (HL)            ;
18515
 
18516
        RST     28H             ;; FP-CALC
18517
 
18518
;; GRE.8
18519
L373D:  DEFB    $01             ;;exchange
18520
        DEFB    $34             ;;stk-data
18521
        DEFB    $F0             ;;Exponent: $80, Bytes: 4
18522
        DEFB    $31,$72,$17,$F8 ;;
18523
        DEFB    $04             ;;multiply
18524
        DEFB    $01             ;;exchange
18525
        DEFB    $A2             ;;stk-half
18526
        DEFB    $03             ;;subtract
18527
        DEFB    $A2             ;;stk-half
18528
        DEFB    $03             ;;subtract
18529
        DEFB    $31             ;;duplicate
18530
        DEFB    $34             ;;stk-data
18531
        DEFB    $32             ;;Exponent: $82, Bytes: 1
18532
        DEFB    $20             ;;(+00,+00,+00)
18533
        DEFB    $04             ;;multiply
18534
        DEFB    $A2             ;;stk-half
18535
        DEFB    $03             ;;subtract
18536
        DEFB    $8C             ;;series-0C
18537
        DEFB    $11             ;;Exponent: $61, Bytes: 1
18538
        DEFB    $AC             ;;(+00,+00,+00)
18539
        DEFB    $14             ;;Exponent: $64, Bytes: 1
18540
        DEFB    $09             ;;(+00,+00,+00)
18541
        DEFB    $56             ;;Exponent: $66, Bytes: 2
18542
        DEFB    $DA,$A5         ;;(+00,+00)
18543
        DEFB    $59             ;;Exponent: $69, Bytes: 2
18544
        DEFB    $30,$C5         ;;(+00,+00)
18545
        DEFB    $5C             ;;Exponent: $6C, Bytes: 2
18546
        DEFB    $90,$AA         ;;(+00,+00)
18547
        DEFB    $9E             ;;Exponent: $6E, Bytes: 3
18548
        DEFB    $70,$6F,$61     ;;(+00)
18549
        DEFB    $A1             ;;Exponent: $71, Bytes: 3
18550
        DEFB    $CB,$DA,$96     ;;(+00)
18551
        DEFB    $A4             ;;Exponent: $74, Bytes: 3
18552
        DEFB    $31,$9F,$B4     ;;(+00)
18553
        DEFB    $E7             ;;Exponent: $77, Bytes: 4
18554
        DEFB    $A0,$FE,$5C,$FC ;;
18555
        DEFB    $EA             ;;Exponent: $7A, Bytes: 4
18556
        DEFB    $1B,$43,$CA,$36 ;;
18557
        DEFB    $ED             ;;Exponent: $7D, Bytes: 4
18558
        DEFB    $A7,$9C,$7E,$5E ;;
18559
        DEFB    $F0             ;;Exponent: $80, Bytes: 4
18560
        DEFB    $6E,$23,$80,$93 ;;
18561
        DEFB    $04             ;;multiply
18562
        DEFB    $0F             ;;addition
18563
        DEFB    $38             ;;end-calc
18564
 
18565
        RET                     ; return.
18566
 
18567
 
18568
; -----------------------------
18569
; THE 'TRIGONOMETRIC' FUNCTIONS
18570
; -----------------------------
18571
; Trigonometry is rocket science. It is also used by carpenters and pyramid
18572
; builders.
18573
; Some uses can be quite abstract but the principles can be seen in simple
18574
; right-angled triangles. Triangles have some special properties -
18575
;
18576
; 1) The sum of the three angles is always PI radians (180 degrees).
18577
;    Very helpful if you know two angles and wish to find the third.
18578
; 2) In any right-angled triangle the sum of the squares of the two shorter
18579
;    sides is equal to the square of the longest side opposite the right-angle.
18580
;    Very useful if you know the length of two sides and wish to know the
18581
;    length of the third side.
18582
; 3) Functions sine, cosine and tangent enable one to calculate the length
18583
;    of an unknown side when the length of one other side and an angle is
18584
;    known.
18585
; 4) Functions arcsin, arccosine and arctan enable one to calculate an unknown
18586
;    angle when the length of two of the sides is known.
18587
 
18588
; --------------------------------
18589
; THE 'REDUCE ARGUMENT' SUBROUTINE
18590
; --------------------------------
18591
; (offset $39: 'get-argt')
18592
;
18593
; This routine performs two functions on the angle, in radians, that forms
18594
; the argument to the sine and cosine functions.
18595
; First it ensures that the angle 'wraps round'. That if a ship turns through
18596
; an angle of, say, 3*PI radians (540 degrees) then the net effect is to turn
18597
; through an angle of PI radians (180 degrees).
18598
; Secondly it converts the angle in radians to a fraction of a right angle,
18599
; depending within which quadrant the angle lies, with the periodicity
18600
; resembling that of the desired sine value.
18601
; The result lies in the range -1 to +1.
18602
;
18603
;                     90 deg.
18604
;
18605
;                     (pi/2)
18606
;              II       +1        I
18607
;                       |
18608
;        sin+      |\   |   /|    sin+
18609
;        cos-      | \  |  / |    cos+
18610
;        tan-      |  \ | /  |    tan+
18611
;                  |   \|/)  |
18612
; 180 deg. (pi) 0 -|----+----|-- 0  (0)   0 degrees
18613
;                  |   /|\   |
18614
;        sin-      |  / | \  |    sin-
18615
;        cos-      | /  |  \ |    cos+
18616
;        tan+      |/   |   \|    tan-
18617
;                       |
18618
;              III      -1       IV
18619
;                     (3pi/2)
18620
;
18621
;                     270 deg.
18622
;
18623
 
18624
;; get-argt
18625
L3783:  RST     28H             ;; FP-CALC      X.
18626
        DEFB    $3D             ;;re-stack      (not rquired done by mult)
18627
        DEFB    $34             ;;stk-data
18628
        DEFB    $EE             ;;Exponent: $7E,
18629
                                ;;Bytes: 4
18630
        DEFB    $22,$F9,$83,$6E ;;              X, 1/(2*PI)
18631
        DEFB    $04             ;;multiply      X/(2*PI) = fraction
18632
        DEFB    $31             ;;duplicate
18633
        DEFB    $A2             ;;stk-half
18634
        DEFB    $0F             ;;addition
18635
        DEFB    $27             ;;int
18636
 
18637
        DEFB    $03             ;;subtract      now range -.5 to .5
18638
 
18639
        DEFB    $31             ;;duplicate
18640
        DEFB    $0F             ;;addition      now range -1 to 1.
18641
        DEFB    $31             ;;duplicate
18642
        DEFB    $0F             ;;addition      now range -2 to +2.
18643
 
18644
; quadrant I (0 to +1) and quadrant IV (-1 to 0) are now correct.
18645
; quadrant II ranges +1 to +2.
18646
; quadrant III ranges -2 to -1.
18647
 
18648
        DEFB    $31             ;;duplicate     Y, Y.
18649
        DEFB    $2A             ;;abs           Y, abs(Y).    range 1 to 2
18650
        DEFB    $A1             ;;stk-one       Y, abs(Y), 1.
18651
        DEFB    $03             ;;subtract      Y, abs(Y)-1.  range 0 to 1
18652
        DEFB    $31             ;;duplicate     Y, Z, Z.
18653
        DEFB    $37             ;;greater-0     Y, Z, (1/0).
18654
 
18655
        DEFB    $C0             ;;st-mem-0         store as possible sign
18656
                                ;;                 for cosine function.
18657
 
18658
        DEFB    $00             ;;jump-true
18659
        DEFB    $04             ;;to L37A1, ZPLUS  with quadrants II and III.
18660
 
18661
; else the angle lies in quadrant I or IV and value Y is already correct.
18662
 
18663
        DEFB    $02             ;;delete        Y.   delete the test value.
18664
        DEFB    $38             ;;end-calc      Y.
18665
 
18666
        RET                     ; return.       with Q1 and Q4           >>>
18667
 
18668
; ---
18669
 
18670
; the branch was here with quadrants II (0 to 1) and III (1 to 0).
18671
; Y will hold -2 to -1 if this is quadrant III.
18672
 
18673
;; ZPLUS
18674
L37A1:  DEFB    $A1             ;;stk-one         Y, Z, 1.
18675
        DEFB    $03             ;;subtract        Y, Z-1.       Q3 = 0 to -1
18676
        DEFB    $01             ;;exchange        Z-1, Y.
18677
        DEFB    $36             ;;less-0          Z-1, (1/0).
18678
        DEFB    $00             ;;jump-true       Z-1.
18679
        DEFB    $02             ;;to L37A8, YNEG
18680
                                ;;if angle in quadrant III
18681
 
18682
; else angle is within quadrant II (-1 to 0)
18683
 
18684
        DEFB    $1B             ;;negate          range +1 to 0.
18685
 
18686
;; YNEG
18687
L37A8:  DEFB    $38             ;;end-calc        quadrants II and III correct.
18688
 
18689
        RET                     ; return.
18690
 
18691
 
18692
; ---------------------
18693
; THE 'COSINE' FUNCTION
18694
; ---------------------
18695
; (offset $20: 'cos')
18696
; Cosines are calculated as the sine of the opposite angle rectifying the
18697
; sign depending on the quadrant rules.
18698
;
18699
;
18700
;           /|
18701
;        h /y|
18702
;         /  |o
18703
;        /x  |
18704
;       /----|
18705
;         a
18706
;
18707
; The cosine of angle x is the adjacent side (a) divided by the hypotenuse 1.
18708
; However if we examine angle y then a/h is the sine of that angle.
18709
; Since angle x plus angle y equals a right-angle, we can find angle y by
18710
; subtracting angle x from pi/2.
18711
; However it's just as easy to reduce the argument first and subtract the
18712
; reduced argument from the value 1 (a reduced right-angle).
18713
; It's even easier to subtract 1 from the angle and rectify the sign.
18714
; In fact, after reducing the argument, the absolute value of the argument
18715
; is used and rectified using the test result stored in mem-0 by 'get-argt'
18716
; for that purpose.
18717
;
18718
 
18719
;; cos
18720
L37AA:  RST     28H             ;; FP-CALC              angle in radians.
18721
        DEFB    $39             ;;get-argt              X     reduce -1 to +1
18722
 
18723
        DEFB    $2A             ;;abs                   ABS X.   0 to 1
18724
        DEFB    $A1             ;;stk-one               ABS X, 1.
18725
        DEFB    $03             ;;subtract              now opposite angle
18726
                                ;;                      although sign is -ve.
18727
 
18728
        DEFB    $E0             ;;get-mem-0             fetch the sign indicator
18729
        DEFB    $00             ;;jump-true
18730
        DEFB    $06             ;;fwd to L37B7, C-ENT
18731
                                ;;forward to common code if in QII or QIII.
18732
 
18733
        DEFB    $1B             ;;negate                else make sign +ve.
18734
        DEFB    $33             ;;jump
18735
        DEFB    $03             ;;fwd to L37B7, C-ENT
18736
                                ;; with quadrants I and IV.
18737
 
18738
; -------------------
18739
; THE 'SINE' FUNCTION
18740
; -------------------
18741
; (offset $1F: 'sin')
18742
; This is a fundamental transcendental function from which others such as cos
18743
; and tan are directly, or indirectly, derived.
18744
; It uses the series generator to produce Chebyshev polynomials.
18745
;
18746
;
18747
;           /|
18748
;        1 / |
18749
;         /  |x
18750
;        /a  |
18751
;       /----|
18752
;         y
18753
;
18754
; The 'get-argt' function is designed to modify the angle and its sign
18755
; in line with the desired sine value and afterwards it can launch straight
18756
; into common code.
18757
 
18758
;; sin
18759
L37B5:  RST     28H             ;; FP-CALC      angle in radians
18760
        DEFB    $39             ;;get-argt      reduce - sign now correct.
18761
 
18762
;; C-ENT
18763
L37B7:  DEFB    $31             ;;duplicate
18764
        DEFB    $31             ;;duplicate
18765
        DEFB    $04             ;;multiply
18766
        DEFB    $31             ;;duplicate
18767
        DEFB    $0F             ;;addition
18768
        DEFB    $A1             ;;stk-one
18769
        DEFB    $03             ;;subtract
18770
 
18771
        DEFB    $86             ;;series-06
18772
        DEFB    $14             ;;Exponent: $64, Bytes: 1
18773
        DEFB    $E6             ;;(+00,+00,+00)
18774
        DEFB    $5C             ;;Exponent: $6C, Bytes: 2
18775
        DEFB    $1F,$0B         ;;(+00,+00)
18776
        DEFB    $A3             ;;Exponent: $73, Bytes: 3
18777
        DEFB    $8F,$38,$EE     ;;(+00)
18778
        DEFB    $E9             ;;Exponent: $79, Bytes: 4
18779
        DEFB    $15,$63,$BB,$23 ;;
18780
        DEFB    $EE             ;;Exponent: $7E, Bytes: 4
18781
        DEFB    $92,$0D,$CD,$ED ;;
18782
        DEFB    $F1             ;;Exponent: $81, Bytes: 4
18783
        DEFB    $23,$5D,$1B,$EA ;;
18784
        DEFB    $04             ;;multiply
18785
        DEFB    $38             ;;end-calc
18786
 
18787
        RET                     ; return.
18788
 
18789
; ----------------------
18790
; THE 'TANGENT' FUNCTION
18791
; ----------------------
18792
; (offset $21: 'tan')
18793
;
18794
; Evaluates tangent x as    sin(x) / cos(x).
18795
;
18796
;
18797
;           /|
18798
;        h / |
18799
;         /  |o
18800
;        /x  |
18801
;       /----|
18802
;         a
18803
;
18804
; the tangent of angle x is the ratio of the length of the opposite side
18805
; divided by the length of the adjacent side. As the opposite length can
18806
; be calculates using sin(x) and the adjacent length using cos(x) then
18807
; the tangent can be defined in terms of the previous two functions.
18808
 
18809
; Error 6 if the argument, in radians, is too close to one like pi/2
18810
; which has an infinite tangent. e.g. PRINT TAN (PI/2)  evaluates as 1/0.
18811
; Similarly PRINT TAN (3*PI/2), TAN (5*PI/2) etc.
18812
 
18813
;; tan
18814
L37DA:  RST     28H             ;; FP-CALC          x.
18815
        DEFB    $31             ;;duplicate         x, x.
18816
        DEFB    $1F             ;;sin               x, sin x.
18817
        DEFB    $01             ;;exchange          sin x, x.
18818
        DEFB    $20             ;;cos               sin x, cos x.
18819
        DEFB    $05             ;;division          sin x/cos x (= tan x).
18820
        DEFB    $38             ;;end-calc          tan x.
18821
 
18822
        RET                     ; return.
18823
 
18824
; ---------------------
18825
; THE 'ARCTAN' FUNCTION
18826
; ---------------------
18827
; (Offset $24: 'atn')
18828
; the inverse tangent function with the result in radians.
18829
; This is a fundamental transcendental function from which others such as asn
18830
; and acs are directly, or indirectly, derived.
18831
; It uses the series generator to produce Chebyshev polynomials.
18832
 
18833
;; atn
18834
L37E2:  CALL    L3297           ; routine re-stack
18835
        LD      A,(HL)          ; fetch exponent byte.
18836
        CP      $81             ; compare to that for 'one'
18837
        JR      C,L37F8         ; forward, if less, to SMALL
18838
 
18839
        RST     28H             ;; FP-CALC
18840
        DEFB    $A1             ;;stk-one
18841
        DEFB    $1B             ;;negate
18842
        DEFB    $01             ;;exchange
18843
        DEFB    $05             ;;division
18844
        DEFB    $31             ;;duplicate
18845
        DEFB    $36             ;;less-0
18846
        DEFB    $A3             ;;stk-pi/2
18847
        DEFB    $01             ;;exchange
18848
        DEFB    $00             ;;jump-true
18849
        DEFB    $06             ;;to L37FA, CASES
18850
 
18851
        DEFB    $1B             ;;negate
18852
        DEFB    $33             ;;jump
18853
        DEFB    $03             ;;to L37FA, CASES
18854
 
18855
;; SMALL
18856
L37F8:  RST     28H             ;; FP-CALC
18857
        DEFB    $A0             ;;stk-zero
18858
 
18859
;; CASES
18860
L37FA:  DEFB    $01             ;;exchange
18861
        DEFB    $31             ;;duplicate
18862
        DEFB    $31             ;;duplicate
18863
        DEFB    $04             ;;multiply
18864
        DEFB    $31             ;;duplicate
18865
        DEFB    $0F             ;;addition
18866
        DEFB    $A1             ;;stk-one
18867
        DEFB    $03             ;;subtract
18868
        DEFB    $8C             ;;series-0C
18869
        DEFB    $10             ;;Exponent: $60, Bytes: 1
18870
        DEFB    $B2             ;;(+00,+00,+00)
18871
        DEFB    $13             ;;Exponent: $63, Bytes: 1
18872
        DEFB    $0E             ;;(+00,+00,+00)
18873
        DEFB    $55             ;;Exponent: $65, Bytes: 2
18874
        DEFB    $E4,$8D         ;;(+00,+00)
18875
        DEFB    $58             ;;Exponent: $68, Bytes: 2
18876
        DEFB    $39,$BC         ;;(+00,+00)
18877
        DEFB    $5B             ;;Exponent: $6B, Bytes: 2
18878
        DEFB    $98,$FD         ;;(+00,+00)
18879
        DEFB    $9E             ;;Exponent: $6E, Bytes: 3
18880
        DEFB    $00,$36,$75     ;;(+00)
18881
        DEFB    $A0             ;;Exponent: $70, Bytes: 3
18882
        DEFB    $DB,$E8,$B4     ;;(+00)
18883
        DEFB    $63             ;;Exponent: $73, Bytes: 2
18884
        DEFB    $42,$C4         ;;(+00,+00)
18885
        DEFB    $E6             ;;Exponent: $76, Bytes: 4
18886
        DEFB    $B5,$09,$36,$BE ;;
18887
        DEFB    $E9             ;;Exponent: $79, Bytes: 4
18888
        DEFB    $36,$73,$1B,$5D ;;
18889
        DEFB    $EC             ;;Exponent: $7C, Bytes: 4
18890
        DEFB    $D8,$DE,$63,$BE ;;
18891
        DEFB    $F0             ;;Exponent: $80, Bytes: 4
18892
        DEFB    $61,$A1,$B3,$0C ;;
18893
        DEFB    $04             ;;multiply
18894
        DEFB    $0F             ;;addition
18895
        DEFB    $38             ;;end-calc
18896
 
18897
        RET                     ; return.
18898
 
18899
 
18900
; ---------------------
18901
; THE 'ARCSIN' FUNCTION
18902
; ---------------------
18903
; (Offset $22: 'asn')
18904
;   The inverse sine function with result in radians.
18905
;   Derived from arctan function above.
18906
;   Error A unless the argument is between -1 and +1 inclusive.
18907
;   Uses an adaptation of the formula asn(x) = atn(x/sqr(1-x*x))
18908
;
18909
;
18910
;                 /|
18911
;                / |
18912
;              1/  |x
18913
;              /a  |
18914
;             /----|
18915
;               y
18916
;
18917
;   e.g. We know the opposite side (x) and hypotenuse (1)
18918
;   and we wish to find angle a in radians.
18919
;   We can derive length y by Pythagoras and then use ATN instead.
18920
;   Since y*y + x*x = 1*1 (Pythagoras Theorem) then
18921
;   y=sqr(1-x*x)                         - no need to multiply 1 by itself.
18922
;   So, asn(a) = atn(x/y)
18923
;   or more fully,
18924
;   asn(a) = atn(x/sqr(1-x*x))
18925
 
18926
;   Close but no cigar.
18927
 
18928
;   While PRINT ATN (x/SQR (1-x*x)) gives the same results as PRINT ASN x,
18929
;   it leads to division by zero when x is 1 or -1.
18930
;   To overcome this, 1 is added to y giving half the required angle and the
18931
;   result is then doubled.
18932
;   That is, PRINT ATN (x/(SQR (1-x*x) +1)) *2
18933
;
18934
;   GEOMETRIC PROOF.
18935
;
18936
;
18937
;               . /|
18938
;            .  c/ |
18939
;         .     /1 |x
18940
;      . c   b /a  |
18941
;    ---------/----|
18942
;      1      y
18943
;
18944
;   By creating an isosceles triangle with two equal sides of 1, angles c and
18945
;   c are also equal. If b+c+c = 180 degrees and b+a = 180 degrees then c=a/2.
18946
;
18947
;   A value higher than 1 gives the required error as attempting to find  the
18948
;   square root of a negative number generates an error in Sinclair BASIC.
18949
 
18950
;; asn
18951
L3833:  RST     28H             ;; FP-CALC      x.
18952
        DEFB    $31             ;;duplicate     x, x.
18953
        DEFB    $31             ;;duplicate     x, x, x.
18954
        DEFB    $04             ;;multiply      x, x*x.
18955
        DEFB    $A1             ;;stk-one       x, x*x, 1.
18956
        DEFB    $03             ;;subtract      x, x*x-1.
18957
        DEFB    $1B             ;;negate        x, 1-x*x.
18958
        DEFB    $28             ;;sqr           x, sqr(1-x*x) = y
18959
        DEFB    $A1             ;;stk-one       x, y, 1.
18960
        DEFB    $0F             ;;addition      x, y+1.
18961
        DEFB    $05             ;;division      x/y+1.
18962
        DEFB    $24             ;;atn           a/2       (half the angle)
18963
        DEFB    $31             ;;duplicate     a/2, a/2.
18964
        DEFB    $0F             ;;addition      a.
18965
        DEFB    $38             ;;end-calc      a.
18966
 
18967
        RET                     ; return.
18968
 
18969
 
18970
; ---------------------
18971
; THE 'ARCCOS' FUNCTION
18972
; ---------------------
18973
; (Offset $23: 'acs')
18974
; the inverse cosine function with the result in radians.
18975
; Error A unless the argument is between -1 and +1.
18976
; Result in range 0 to pi.
18977
; Derived from asn above which is in turn derived from the preceding atn.
18978
; It could have been derived directly from atn using acs(x) = atn(sqr(1-x*x)/x).
18979
; However, as sine and cosine are horizontal translations of each other,
18980
; uses acs(x) = pi/2 - asn(x)
18981
 
18982
; e.g. the arccosine of a known x value will give the required angle b in
18983
; radians.
18984
; We know, from above, how to calculate the angle a using asn(x).
18985
; Since the three angles of any triangle add up to 180 degrees, or pi radians,
18986
; and the largest angle in this case is a right-angle (pi/2 radians), then
18987
; we can calculate angle b as pi/2 (both angles) minus asn(x) (angle a).
18988
;
18989
;
18990
;           /|
18991
;        1 /b|
18992
;         /  |x
18993
;        /a  |
18994
;       /----|
18995
;         y
18996
;
18997
 
18998
;; acs
18999
L3843:  RST     28H             ;; FP-CALC      x.
19000
        DEFB    $22             ;;asn           asn(x).
19001
        DEFB    $A3             ;;stk-pi/2      asn(x), pi/2.
19002
        DEFB    $03             ;;subtract      asn(x) - pi/2.
19003
        DEFB    $1B             ;;negate        pi/2 -asn(x)  =  acs(x).
19004
        DEFB    $38             ;;end-calc      acs(x).
19005
 
19006
        RET                     ; return.
19007
 
19008
 
19009
; --------------------------
19010
; THE 'SQUARE ROOT' FUNCTION
19011
; --------------------------
19012
; (Offset $28: 'sqr')
19013
; This routine is remarkable for its brevity - 7 bytes.
19014
; It wasn't written here but in the ZX81 where the programmers had to squeeze
19015
; a bulky operating system into an 8K ROM. It simply calculates
19016
; the square root by stacking the value .5 and continuing into the 'to-power'
19017
; routine. With more space available the much faster Newton-Raphson method
19018
; could have been used as on the Jupiter Ace.
19019
 
19020
;; sqr
19021
L384A:  RST     28H             ;; FP-CALC
19022
        DEFB    $31             ;;duplicate
19023
        DEFB    $30             ;;not
19024
        DEFB    $00             ;;jump-true
19025
        DEFB    $1E             ;;to L386C, LAST
19026
 
19027
        DEFB    $A2             ;;stk-half
19028
        DEFB    $38             ;;end-calc
19029
 
19030
 
19031
; ------------------------------
19032
; THE 'EXPONENTIATION' OPERATION
19033
; ------------------------------
19034
; (Offset $06: 'to-power')
19035
; This raises the first number X to the power of the second number Y.
19036
; As with the ZX80,
19037
; 0 ^ 0 = 1.
19038
; 0 ^ +n = 0.
19039
; 0 ^ -n = arithmetic overflow.
19040
;
19041
 
19042
;; to-power
19043
L3851:  RST     28H             ;; FP-CALC              X, Y.
19044
        DEFB    $01             ;;exchange              Y, X.
19045
        DEFB    $31             ;;duplicate             Y, X, X.
19046
        DEFB    $30             ;;not                   Y, X, (1/0).
19047
        DEFB    $00             ;;jump-true
19048
        DEFB    $07             ;;to L385D, XIS0   if X is zero.
19049
 
19050
;   else X is non-zero. Function 'ln' will catch a negative value of X.
19051
 
19052
        DEFB    $25             ;;ln                    Y, LN X.
19053
        DEFB    $04             ;;multiply              Y * LN X.
19054
        DEFB    $38             ;;end-calc
19055
 
19056
        JP      L36C4           ; jump back to EXP routine   ->
19057
 
19058
; ---
19059
 
19060
;   these routines form the three simple results when the number is zero.
19061
;   begin by deleting the known zero to leave Y the power factor.
19062
 
19063
;; XIS0
19064
L385D:  DEFB    $02             ;;delete                Y.
19065
        DEFB    $31             ;;duplicate             Y, Y.
19066
        DEFB    $30             ;;not                   Y, (1/0).
19067
        DEFB    $00             ;;jump-true
19068
        DEFB    $09             ;;to L386A, ONE         if Y is zero.
19069
 
19070
        DEFB    $A0             ;;stk-zero              Y, 0.
19071
        DEFB    $01             ;;exchange              0, Y.
19072
        DEFB    $37             ;;greater-0             0, (1/0).
19073
        DEFB    $00             ;;jump-true             0.
19074
        DEFB    $06             ;;to L386C, LAST        if Y was any positive
19075
                                ;;                      number.
19076
 
19077
;   else force division by zero thereby raising an Arithmetic overflow error.
19078
;   There are some one and two-byte alternatives but perhaps the most formal
19079
;   might have been to use end-calc; rst 08; defb 05.
19080
 
19081
        DEFB    $A1             ;;stk-one               0, 1.
19082
        DEFB    $01             ;;exchange              1, 0.
19083
        DEFB    $05             ;;division              1/0        ouch!
19084
 
19085
; ---
19086
 
19087
;; ONE
19088
L386A:  DEFB    $02             ;;delete                .
19089
        DEFB    $A1             ;;stk-one               1.
19090
 
19091
;; LAST
19092
L386C:  DEFB    $38             ;;end-calc              last value is 1 or 0.
19093
 
19094
        RET                     ; return.
19095
 
19096
;   "Everything should be made as simple as possible, but not simpler"
19097
;   - Albert Einstein, 1879-1955.
19098
 
19099
; ---------------------
19100
; THE 'SPARE' LOCATIONS
19101
; ---------------------
19102
 
19103
;; spare
19104
L386E:  DEFB    $FF, $FF        ;
19105
 
19106
 
19107
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19108
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19109
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19110
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19111
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19112
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19113
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19114
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19115
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19116
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19117
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19118
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19119
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19120
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19121
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19122
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19123
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19124
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19125
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19126
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19127
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19128
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19129
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19130
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19131
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19132
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19133
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19134
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19135
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19136
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19137
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19138
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19139
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19140
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19141
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19142
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19143
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19144
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19145
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19146
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19147
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19148
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19149
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19150
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19151
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19152
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19153
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19154
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19155
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19156
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19157
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19158
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19159
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19160
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19161
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19162
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19163
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19164
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19165
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19166
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19167
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19168
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19169
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19170
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19171
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19172
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19173
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19174
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19175
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19176
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19177
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19178
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19179
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19180
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19181
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19182
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19183
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19184
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19185
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19186
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19187
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19188
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19189
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19190
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19191
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19192
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19193
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19194
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19195
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19196
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19197
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19198
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19199
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19200
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19201
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19202
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19203
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19204
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19205
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19206
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19207
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19208
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19209
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
19210
        DEFB    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
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
 
19254
ORG $3D00
19255
 
19256
; -------------------------------
19257
; THE 'ZX SPECTRUM CHARACTER SET'
19258
; -------------------------------
19259
 
19260
;; char-set
19261
 
19262
; $20 - Character: ' '          CHR$(32)
19263
 
19264
L3D00:  DEFB    %00000000
19265
        DEFB    %00000000
19266
        DEFB    %00000000
19267
        DEFB    %00000000
19268
        DEFB    %00000000
19269
        DEFB    %00000000
19270
        DEFB    %00000000
19271
        DEFB    %00000000
19272
 
19273
; $21 - Character: '!'          CHR$(33)
19274
 
19275
        DEFB    %00000000
19276
        DEFB    %00010000
19277
        DEFB    %00010000
19278
        DEFB    %00010000
19279
        DEFB    %00010000
19280
        DEFB    %00000000
19281
        DEFB    %00010000
19282
        DEFB    %00000000
19283
 
19284
; $22 - Character: '"'          CHR$(34)
19285
 
19286
        DEFB    %00000000
19287
        DEFB    %00100100
19288
        DEFB    %00100100
19289
        DEFB    %00000000
19290
        DEFB    %00000000
19291
        DEFB    %00000000
19292
        DEFB    %00000000
19293
        DEFB    %00000000
19294
 
19295
; $23 - Character: '#'          CHR$(35)
19296
 
19297
        DEFB    %00000000
19298
        DEFB    %00100100
19299
        DEFB    %01111110
19300
        DEFB    %00100100
19301
        DEFB    %00100100
19302
        DEFB    %01111110
19303
        DEFB    %00100100
19304
        DEFB    %00000000
19305
 
19306
; $24 - Character: '$'          CHR$(36)
19307
 
19308
        DEFB    %00000000
19309
        DEFB    %00001000
19310
        DEFB    %00111110
19311
        DEFB    %00101000
19312
        DEFB    %00111110
19313
        DEFB    %00001010
19314
        DEFB    %00111110
19315
        DEFB    %00001000
19316
 
19317
; $25 - Character: '%'          CHR$(37)
19318
 
19319
        DEFB    %00000000
19320
        DEFB    %01100010
19321
        DEFB    %01100100
19322
        DEFB    %00001000
19323
        DEFB    %00010000
19324
        DEFB    %00100110
19325
        DEFB    %01000110
19326
        DEFB    %00000000
19327
 
19328
; $26 - Character: '&'          CHR$(38)
19329
 
19330
        DEFB    %00000000
19331
        DEFB    %00010000
19332
        DEFB    %00101000
19333
        DEFB    %00010000
19334
        DEFB    %00101010
19335
        DEFB    %01000100
19336
        DEFB    %00111010
19337
        DEFB    %00000000
19338
 
19339
; $27 - Character: '''          CHR$(39)
19340
 
19341
        DEFB    %00000000
19342
        DEFB    %00001000
19343
        DEFB    %00010000
19344
        DEFB    %00000000
19345
        DEFB    %00000000
19346
        DEFB    %00000000
19347
        DEFB    %00000000
19348
        DEFB    %00000000
19349
 
19350
; $28 - Character: '('          CHR$(40)
19351
 
19352
        DEFB    %00000000
19353
        DEFB    %00000100
19354
        DEFB    %00001000
19355
        DEFB    %00001000
19356
        DEFB    %00001000
19357
        DEFB    %00001000
19358
        DEFB    %00000100
19359
        DEFB    %00000000
19360
 
19361
; $29 - Character: ')'          CHR$(41)
19362
 
19363
        DEFB    %00000000
19364
        DEFB    %00100000
19365
        DEFB    %00010000
19366
        DEFB    %00010000
19367
        DEFB    %00010000
19368
        DEFB    %00010000
19369
        DEFB    %00100000
19370
        DEFB    %00000000
19371
 
19372
; $2A - Character: '*'          CHR$(42)
19373
 
19374
        DEFB    %00000000
19375
        DEFB    %00000000
19376
        DEFB    %00010100
19377
        DEFB    %00001000
19378
        DEFB    %00111110
19379
        DEFB    %00001000
19380
        DEFB    %00010100
19381
        DEFB    %00000000
19382
 
19383
; $2B - Character: '+'          CHR$(43)
19384
 
19385
        DEFB    %00000000
19386
        DEFB    %00000000
19387
        DEFB    %00001000
19388
        DEFB    %00001000
19389
        DEFB    %00111110
19390
        DEFB    %00001000
19391
        DEFB    %00001000
19392
        DEFB    %00000000
19393
 
19394
; $2C - Character: ','          CHR$(44)
19395
 
19396
        DEFB    %00000000
19397
        DEFB    %00000000
19398
        DEFB    %00000000
19399
        DEFB    %00000000
19400
        DEFB    %00000000
19401
        DEFB    %00001000
19402
        DEFB    %00001000
19403
        DEFB    %00010000
19404
 
19405
; $2D - Character: '-'          CHR$(45)
19406
 
19407
        DEFB    %00000000
19408
        DEFB    %00000000
19409
        DEFB    %00000000
19410
        DEFB    %00000000
19411
        DEFB    %00111110
19412
        DEFB    %00000000
19413
        DEFB    %00000000
19414
        DEFB    %00000000
19415
 
19416
; $2E - Character: '.'          CHR$(46)
19417
 
19418
        DEFB    %00000000
19419
        DEFB    %00000000
19420
        DEFB    %00000000
19421
        DEFB    %00000000
19422
        DEFB    %00000000
19423
        DEFB    %00011000
19424
        DEFB    %00011000
19425
        DEFB    %00000000
19426
 
19427
; $2F - Character: '/'          CHR$(47)
19428
 
19429
        DEFB    %00000000
19430
        DEFB    %00000000
19431
        DEFB    %00000010
19432
        DEFB    %00000100
19433
        DEFB    %00001000
19434
        DEFB    %00010000
19435
        DEFB    %00100000
19436
        DEFB    %00000000
19437
 
19438
; $30 - Character: '0'          CHR$(48)
19439
 
19440
        DEFB    %00000000
19441
        DEFB    %00111100
19442
        DEFB    %01000110
19443
        DEFB    %01001010
19444
        DEFB    %01010010
19445
        DEFB    %01100010
19446
        DEFB    %00111100
19447
        DEFB    %00000000
19448
 
19449
; $31 - Character: '1'          CHR$(49)
19450
 
19451
        DEFB    %00000000
19452
        DEFB    %00011000
19453
        DEFB    %00101000
19454
        DEFB    %00001000
19455
        DEFB    %00001000
19456
        DEFB    %00001000
19457
        DEFB    %00111110
19458
        DEFB    %00000000
19459
 
19460
; $32 - Character: '2'          CHR$(50)
19461
 
19462
        DEFB    %00000000
19463
        DEFB    %00111100
19464
        DEFB    %01000010
19465
        DEFB    %00000010
19466
        DEFB    %00111100
19467
        DEFB    %01000000
19468
        DEFB    %01111110
19469
        DEFB    %00000000
19470
 
19471
; $33 - Character: '3'          CHR$(51)
19472
 
19473
        DEFB    %00000000
19474
        DEFB    %00111100
19475
        DEFB    %01000010
19476
        DEFB    %00001100
19477
        DEFB    %00000010
19478
        DEFB    %01000010
19479
        DEFB    %00111100
19480
        DEFB    %00000000
19481
 
19482
; $34 - Character: '4'          CHR$(52)
19483
 
19484
        DEFB    %00000000
19485
        DEFB    %00001000
19486
        DEFB    %00011000
19487
        DEFB    %00101000
19488
        DEFB    %01001000
19489
        DEFB    %01111110
19490
        DEFB    %00001000
19491
        DEFB    %00000000
19492
 
19493
; $35 - Character: '5'          CHR$(53)
19494
 
19495
        DEFB    %00000000
19496
        DEFB    %01111110
19497
        DEFB    %01000000
19498
        DEFB    %01111100
19499
        DEFB    %00000010
19500
        DEFB    %01000010
19501
        DEFB    %00111100
19502
        DEFB    %00000000
19503
 
19504
; $36 - Character: '6'          CHR$(54)
19505
 
19506
        DEFB    %00000000
19507
        DEFB    %00111100
19508
        DEFB    %01000000
19509
        DEFB    %01111100
19510
        DEFB    %01000010
19511
        DEFB    %01000010
19512
        DEFB    %00111100
19513
        DEFB    %00000000
19514
 
19515
; $37 - Character: '7'          CHR$(55)
19516
 
19517
        DEFB    %00000000
19518
        DEFB    %01111110
19519
        DEFB    %00000010
19520
        DEFB    %00000100
19521
        DEFB    %00001000
19522
        DEFB    %00010000
19523
        DEFB    %00010000
19524
        DEFB    %00000000
19525
 
19526
; $38 - Character: '8'          CHR$(56)
19527
 
19528
        DEFB    %00000000
19529
        DEFB    %00111100
19530
        DEFB    %01000010
19531
        DEFB    %00111100
19532
        DEFB    %01000010
19533
        DEFB    %01000010
19534
        DEFB    %00111100
19535
        DEFB    %00000000
19536
 
19537
; $39 - Character: '9'          CHR$(57)
19538
 
19539
        DEFB    %00000000
19540
        DEFB    %00111100
19541
        DEFB    %01000010
19542
        DEFB    %01000010
19543
        DEFB    %00111110
19544
        DEFB    %00000010
19545
        DEFB    %00111100
19546
        DEFB    %00000000
19547
 
19548
; $3A - Character: ':'          CHR$(58)
19549
 
19550
        DEFB    %00000000
19551
        DEFB    %00000000
19552
        DEFB    %00000000
19553
        DEFB    %00010000
19554
        DEFB    %00000000
19555
        DEFB    %00000000
19556
        DEFB    %00010000
19557
        DEFB    %00000000
19558
 
19559
; $3B - Character: ';'          CHR$(59)
19560
 
19561
        DEFB    %00000000
19562
        DEFB    %00000000
19563
        DEFB    %00010000
19564
        DEFB    %00000000
19565
        DEFB    %00000000
19566
        DEFB    %00010000
19567
        DEFB    %00010000
19568
        DEFB    %00100000
19569
 
19570
; $3C - Character: '<'          CHR$(60)
19571
 
19572
        DEFB    %00000000
19573
        DEFB    %00000000
19574
        DEFB    %00000100
19575
        DEFB    %00001000
19576
        DEFB    %00010000
19577
        DEFB    %00001000
19578
        DEFB    %00000100
19579
        DEFB    %00000000
19580
 
19581
; $3D - Character: '='          CHR$(61)
19582
 
19583
        DEFB    %00000000
19584
        DEFB    %00000000
19585
        DEFB    %00000000
19586
        DEFB    %00111110
19587
        DEFB    %00000000
19588
        DEFB    %00111110
19589
        DEFB    %00000000
19590
        DEFB    %00000000
19591
 
19592
; $3E - Character: '>'          CHR$(62)
19593
 
19594
        DEFB    %00000000
19595
        DEFB    %00000000
19596
        DEFB    %00010000
19597
        DEFB    %00001000
19598
        DEFB    %00000100
19599
        DEFB    %00001000
19600
        DEFB    %00010000
19601
        DEFB    %00000000
19602
 
19603
; $3F - Character: '?'          CHR$(63)
19604
 
19605
        DEFB    %00000000
19606
        DEFB    %00111100
19607
        DEFB    %01000010
19608
        DEFB    %00000100
19609
        DEFB    %00001000
19610
        DEFB    %00000000
19611
        DEFB    %00001000
19612
        DEFB    %00000000
19613
 
19614
; $40 - Character: '@'          CHR$(64)
19615
 
19616
        DEFB    %00000000
19617
        DEFB    %00111100
19618
        DEFB    %01001010
19619
        DEFB    %01010110
19620
        DEFB    %01011110
19621
        DEFB    %01000000
19622
        DEFB    %00111100
19623
        DEFB    %00000000
19624
 
19625
; $41 - Character: 'A'          CHR$(65)
19626
 
19627
        DEFB    %00000000
19628
        DEFB    %00111100
19629
        DEFB    %01000010
19630
        DEFB    %01000010
19631
        DEFB    %01111110
19632
        DEFB    %01000010
19633
        DEFB    %01000010
19634
        DEFB    %00000000
19635
 
19636
; $42 - Character: 'B'          CHR$(66)
19637
 
19638
        DEFB    %00000000
19639
        DEFB    %01111100
19640
        DEFB    %01000010
19641
        DEFB    %01111100
19642
        DEFB    %01000010
19643
        DEFB    %01000010
19644
        DEFB    %01111100
19645
        DEFB    %00000000
19646
 
19647
; $43 - Character: 'C'          CHR$(67)
19648
 
19649
        DEFB    %00000000
19650
        DEFB    %00111100
19651
        DEFB    %01000010
19652
        DEFB    %01000000
19653
        DEFB    %01000000
19654
        DEFB    %01000010
19655
        DEFB    %00111100
19656
        DEFB    %00000000
19657
 
19658
; $44 - Character: 'D'          CHR$(68)
19659
 
19660
        DEFB    %00000000
19661
        DEFB    %01111000
19662
        DEFB    %01000100
19663
        DEFB    %01000010
19664
        DEFB    %01000010
19665
        DEFB    %01000100
19666
        DEFB    %01111000
19667
        DEFB    %00000000
19668
 
19669
; $45 - Character: 'E'          CHR$(69)
19670
 
19671
        DEFB    %00000000
19672
        DEFB    %01111110
19673
        DEFB    %01000000
19674
        DEFB    %01111100
19675
        DEFB    %01000000
19676
        DEFB    %01000000
19677
        DEFB    %01111110
19678
        DEFB    %00000000
19679
 
19680
; $46 - Character: 'F'          CHR$(70)
19681
 
19682
        DEFB    %00000000
19683
        DEFB    %01111110
19684
        DEFB    %01000000
19685
        DEFB    %01111100
19686
        DEFB    %01000000
19687
        DEFB    %01000000
19688
        DEFB    %01000000
19689
        DEFB    %00000000
19690
 
19691
; $47 - Character: 'G'          CHR$(71)
19692
 
19693
        DEFB    %00000000
19694
        DEFB    %00111100
19695
        DEFB    %01000010
19696
        DEFB    %01000000
19697
        DEFB    %01001110
19698
        DEFB    %01000010
19699
        DEFB    %00111100
19700
        DEFB    %00000000
19701
 
19702
; $48 - Character: 'H'          CHR$(72)
19703
 
19704
        DEFB    %00000000
19705
        DEFB    %01000010
19706
        DEFB    %01000010
19707
        DEFB    %01111110
19708
        DEFB    %01000010
19709
        DEFB    %01000010
19710
        DEFB    %01000010
19711
        DEFB    %00000000
19712
 
19713
; $49 - Character: 'I'          CHR$(73)
19714
 
19715
        DEFB    %00000000
19716
        DEFB    %00111110
19717
        DEFB    %00001000
19718
        DEFB    %00001000
19719
        DEFB    %00001000
19720
        DEFB    %00001000
19721
        DEFB    %00111110
19722
        DEFB    %00000000
19723
 
19724
; $4A - Character: 'J'          CHR$(74)
19725
 
19726
        DEFB    %00000000
19727
        DEFB    %00000010
19728
        DEFB    %00000010
19729
        DEFB    %00000010
19730
        DEFB    %01000010
19731
        DEFB    %01000010
19732
        DEFB    %00111100
19733
        DEFB    %00000000
19734
 
19735
; $4B - Character: 'K'          CHR$(75)
19736
 
19737
        DEFB    %00000000
19738
        DEFB    %01000100
19739
        DEFB    %01001000
19740
        DEFB    %01110000
19741
        DEFB    %01001000
19742
        DEFB    %01000100
19743
        DEFB    %01000010
19744
        DEFB    %00000000
19745
 
19746
; $4C - Character: 'L'          CHR$(76)
19747
 
19748
        DEFB    %00000000
19749
        DEFB    %01000000
19750
        DEFB    %01000000
19751
        DEFB    %01000000
19752
        DEFB    %01000000
19753
        DEFB    %01000000
19754
        DEFB    %01111110
19755
        DEFB    %00000000
19756
 
19757
; $4D - Character: 'M'          CHR$(77)
19758
 
19759
        DEFB    %00000000
19760
        DEFB    %01000010
19761
        DEFB    %01100110
19762
        DEFB    %01011010
19763
        DEFB    %01000010
19764
        DEFB    %01000010
19765
        DEFB    %01000010
19766
        DEFB    %00000000
19767
 
19768
; $4E - Character: 'N'          CHR$(78)
19769
 
19770
        DEFB    %00000000
19771
        DEFB    %01000010
19772
        DEFB    %01100010
19773
        DEFB    %01010010
19774
        DEFB    %01001010
19775
        DEFB    %01000110
19776
        DEFB    %01000010
19777
        DEFB    %00000000
19778
 
19779
; $4F - Character: 'O'          CHR$(79)
19780
 
19781
        DEFB    %00000000
19782
        DEFB    %00111100
19783
        DEFB    %01000010
19784
        DEFB    %01000010
19785
        DEFB    %01000010
19786
        DEFB    %01000010
19787
        DEFB    %00111100
19788
        DEFB    %00000000
19789
 
19790
; $50 - Character: 'P'          CHR$(80)
19791
 
19792
        DEFB    %00000000
19793
        DEFB    %01111100
19794
        DEFB    %01000010
19795
        DEFB    %01000010
19796
        DEFB    %01111100
19797
        DEFB    %01000000
19798
        DEFB    %01000000
19799
        DEFB    %00000000
19800
 
19801
; $51 - Character: 'Q'          CHR$(81)
19802
 
19803
        DEFB    %00000000
19804
        DEFB    %00111100
19805
        DEFB    %01000010
19806
        DEFB    %01000010
19807
        DEFB    %01010010
19808
        DEFB    %01001010
19809
        DEFB    %00111100
19810
        DEFB    %00000000
19811
 
19812
; $52 - Character: 'R'          CHR$(82)
19813
 
19814
        DEFB    %00000000
19815
        DEFB    %01111100
19816
        DEFB    %01000010
19817
        DEFB    %01000010
19818
        DEFB    %01111100
19819
        DEFB    %01000100
19820
        DEFB    %01000010
19821
        DEFB    %00000000
19822
 
19823
; $53 - Character: 'S'          CHR$(83)
19824
 
19825
        DEFB    %00000000
19826
        DEFB    %00111100
19827
        DEFB    %01000000
19828
        DEFB    %00111100
19829
        DEFB    %00000010
19830
        DEFB    %01000010
19831
        DEFB    %00111100
19832
        DEFB    %00000000
19833
 
19834
; $54 - Character: 'T'          CHR$(84)
19835
 
19836
        DEFB    %00000000
19837
        DEFB    %11111110
19838
        DEFB    %00010000
19839
        DEFB    %00010000
19840
        DEFB    %00010000
19841
        DEFB    %00010000
19842
        DEFB    %00010000
19843
        DEFB    %00000000
19844
 
19845
; $55 - Character: 'U'          CHR$(85)
19846
 
19847
        DEFB    %00000000
19848
        DEFB    %01000010
19849
        DEFB    %01000010
19850
        DEFB    %01000010
19851
        DEFB    %01000010
19852
        DEFB    %01000010
19853
        DEFB    %00111100
19854
        DEFB    %00000000
19855
 
19856
; $56 - Character: 'V'          CHR$(86)
19857
 
19858
        DEFB    %00000000
19859
        DEFB    %01000010
19860
        DEFB    %01000010
19861
        DEFB    %01000010
19862
        DEFB    %01000010
19863
        DEFB    %00100100
19864
        DEFB    %00011000
19865
        DEFB    %00000000
19866
 
19867
; $57 - Character: 'W'          CHR$(87)
19868
 
19869
        DEFB    %00000000
19870
        DEFB    %01000010
19871
        DEFB    %01000010
19872
        DEFB    %01000010
19873
        DEFB    %01000010
19874
        DEFB    %01011010
19875
        DEFB    %00100100
19876
        DEFB    %00000000
19877
 
19878
; $58 - Character: 'X'          CHR$(88)
19879
 
19880
        DEFB    %00000000
19881
        DEFB    %01000010
19882
        DEFB    %00100100
19883
        DEFB    %00011000
19884
        DEFB    %00011000
19885
        DEFB    %00100100
19886
        DEFB    %01000010
19887
        DEFB    %00000000
19888
 
19889
; $59 - Character: 'Y'          CHR$(89)
19890
 
19891
        DEFB    %00000000
19892
        DEFB    %10000010
19893
        DEFB    %01000100
19894
        DEFB    %00101000
19895
        DEFB    %00010000
19896
        DEFB    %00010000
19897
        DEFB    %00010000
19898
        DEFB    %00000000
19899
 
19900
; $5A - Character: 'Z'          CHR$(90)
19901
 
19902
        DEFB    %00000000
19903
        DEFB    %01111110
19904
        DEFB    %00000100
19905
        DEFB    %00001000
19906
        DEFB    %00010000
19907
        DEFB    %00100000
19908
        DEFB    %01111110
19909
        DEFB    %00000000
19910
 
19911
; $5B - Character: '['          CHR$(91)
19912
 
19913
        DEFB    %00000000
19914
        DEFB    %00001110
19915
        DEFB    %00001000
19916
        DEFB    %00001000
19917
        DEFB    %00001000
19918
        DEFB    %00001000
19919
        DEFB    %00001110
19920
        DEFB    %00000000
19921
 
19922
; $5C - Character: '\'          CHR$(92)
19923
 
19924
        DEFB    %00000000
19925
        DEFB    %00000000
19926
        DEFB    %01000000
19927
        DEFB    %00100000
19928
        DEFB    %00010000
19929
        DEFB    %00001000
19930
        DEFB    %00000100
19931
        DEFB    %00000000
19932
 
19933
; $5D - Character: ']'          CHR$(93)
19934
 
19935
        DEFB    %00000000
19936
        DEFB    %01110000
19937
        DEFB    %00010000
19938
        DEFB    %00010000
19939
        DEFB    %00010000
19940
        DEFB    %00010000
19941
        DEFB    %01110000
19942
        DEFB    %00000000
19943
 
19944
; $5E - Character: '^'          CHR$(94)
19945
 
19946
        DEFB    %00000000
19947
        DEFB    %00010000
19948
        DEFB    %00111000
19949
        DEFB    %01010100
19950
        DEFB    %00010000
19951
        DEFB    %00010000
19952
        DEFB    %00010000
19953
        DEFB    %00000000
19954
 
19955
; $5F - Character: '_'          CHR$(95)
19956
 
19957
        DEFB    %00000000
19958
        DEFB    %00000000
19959
        DEFB    %00000000
19960
        DEFB    %00000000
19961
        DEFB    %00000000
19962
        DEFB    %00000000
19963
        DEFB    %00000000
19964
        DEFB    %11111111
19965
 
19966
; $60 - Character: ' £ '        CHR$(96)
19967
 
19968
        DEFB    %00000000
19969
        DEFB    %00011100
19970
        DEFB    %00100010
19971
        DEFB    %01111000
19972
        DEFB    %00100000
19973
        DEFB    %00100000
19974
        DEFB    %01111110
19975
        DEFB    %00000000
19976
 
19977
; $61 - Character: 'a'          CHR$(97)
19978
 
19979
        DEFB    %00000000
19980
        DEFB    %00000000
19981
        DEFB    %00111000
19982
        DEFB    %00000100
19983
        DEFB    %00111100
19984
        DEFB    %01000100
19985
        DEFB    %00111100
19986
        DEFB    %00000000
19987
 
19988
; $62 - Character: 'b'          CHR$(98)
19989
 
19990
        DEFB    %00000000
19991
        DEFB    %00100000
19992
        DEFB    %00100000
19993
        DEFB    %00111100
19994
        DEFB    %00100010
19995
        DEFB    %00100010
19996
        DEFB    %00111100
19997
        DEFB    %00000000
19998
 
19999
; $63 - Character: 'c'          CHR$(99)
20000
 
20001
        DEFB    %00000000
20002
        DEFB    %00000000
20003
        DEFB    %00011100
20004
        DEFB    %00100000
20005
        DEFB    %00100000
20006
        DEFB    %00100000
20007
        DEFB    %00011100
20008
        DEFB    %00000000
20009
 
20010
; $64 - Character: 'd'          CHR$(100)
20011
 
20012
        DEFB    %00000000
20013
        DEFB    %00000100
20014
        DEFB    %00000100
20015
        DEFB    %00111100
20016
        DEFB    %01000100
20017
        DEFB    %01000100
20018
        DEFB    %00111100
20019
        DEFB    %00000000
20020
 
20021
; $65 - Character: 'e'          CHR$(101)
20022
 
20023
        DEFB    %00000000
20024
        DEFB    %00000000
20025
        DEFB    %00111000
20026
        DEFB    %01000100
20027
        DEFB    %01111000
20028
        DEFB    %01000000
20029
        DEFB    %00111100
20030
        DEFB    %00000000
20031
 
20032
; $66 - Character: 'f'          CHR$(102)
20033
 
20034
        DEFB    %00000000
20035
        DEFB    %00001100
20036
        DEFB    %00010000
20037
        DEFB    %00011000
20038
        DEFB    %00010000
20039
        DEFB    %00010000
20040
        DEFB    %00010000
20041
        DEFB    %00000000
20042
 
20043
; $67 - Character: 'g'          CHR$(103)
20044
 
20045
        DEFB    %00000000
20046
        DEFB    %00000000
20047
        DEFB    %00111100
20048
        DEFB    %01000100
20049
        DEFB    %01000100
20050
        DEFB    %00111100
20051
        DEFB    %00000100
20052
        DEFB    %00111000
20053
 
20054
; $68 - Character: 'h'          CHR$(104)
20055
 
20056
        DEFB    %00000000
20057
        DEFB    %01000000
20058
        DEFB    %01000000
20059
        DEFB    %01111000
20060
        DEFB    %01000100
20061
        DEFB    %01000100
20062
        DEFB    %01000100
20063
        DEFB    %00000000
20064
 
20065
; $69 - Character: 'i'          CHR$(105)
20066
 
20067
        DEFB    %00000000
20068
        DEFB    %00010000
20069
        DEFB    %00000000
20070
        DEFB    %00110000
20071
        DEFB    %00010000
20072
        DEFB    %00010000
20073
        DEFB    %00111000
20074
        DEFB    %00000000
20075
 
20076
; $6A - Character: 'j'          CHR$(106)
20077
 
20078
        DEFB    %00000000
20079
        DEFB    %00000100
20080
        DEFB    %00000000
20081
        DEFB    %00000100
20082
        DEFB    %00000100
20083
        DEFB    %00000100
20084
        DEFB    %00100100
20085
        DEFB    %00011000
20086
 
20087
; $6B - Character: 'k'          CHR$(107)
20088
 
20089
        DEFB    %00000000
20090
        DEFB    %00100000
20091
        DEFB    %00101000
20092
        DEFB    %00110000
20093
        DEFB    %00110000
20094
        DEFB    %00101000
20095
        DEFB    %00100100
20096
        DEFB    %00000000
20097
 
20098
; $6C - Character: 'l'          CHR$(108)
20099
 
20100
        DEFB    %00000000
20101
        DEFB    %00010000
20102
        DEFB    %00010000
20103
        DEFB    %00010000
20104
        DEFB    %00010000
20105
        DEFB    %00010000
20106
        DEFB    %00001100
20107
        DEFB    %00000000
20108
 
20109
; $6D - Character: 'm'          CHR$(109)
20110
 
20111
        DEFB    %00000000
20112
        DEFB    %00000000
20113
        DEFB    %01101000
20114
        DEFB    %01010100
20115
        DEFB    %01010100
20116
        DEFB    %01010100
20117
        DEFB    %01010100
20118
        DEFB    %00000000
20119
 
20120
; $6E - Character: 'n'          CHR$(110)
20121
 
20122
        DEFB    %00000000
20123
        DEFB    %00000000
20124
        DEFB    %01111000
20125
        DEFB    %01000100
20126
        DEFB    %01000100
20127
        DEFB    %01000100
20128
        DEFB    %01000100
20129
        DEFB    %00000000
20130
 
20131
; $6F - Character: 'o'          CHR$(111)
20132
 
20133
        DEFB    %00000000
20134
        DEFB    %00000000
20135
        DEFB    %00111000
20136
        DEFB    %01000100
20137
        DEFB    %01000100
20138
        DEFB    %01000100
20139
        DEFB    %00111000
20140
        DEFB    %00000000
20141
 
20142
; $70 - Character: 'p'          CHR$(112)
20143
 
20144
        DEFB    %00000000
20145
        DEFB    %00000000
20146
        DEFB    %01111000
20147
        DEFB    %01000100
20148
        DEFB    %01000100
20149
        DEFB    %01111000
20150
        DEFB    %01000000
20151
        DEFB    %01000000
20152
 
20153
; $71 - Character: 'q'          CHR$(113)
20154
 
20155
        DEFB    %00000000
20156
        DEFB    %00000000
20157
        DEFB    %00111100
20158
        DEFB    %01000100
20159
        DEFB    %01000100
20160
        DEFB    %00111100
20161
        DEFB    %00000100
20162
        DEFB    %00000110
20163
 
20164
; $72 - Character: 'r'          CHR$(114)
20165
 
20166
        DEFB    %00000000
20167
        DEFB    %00000000
20168
        DEFB    %00011100
20169
        DEFB    %00100000
20170
        DEFB    %00100000
20171
        DEFB    %00100000
20172
        DEFB    %00100000
20173
        DEFB    %00000000
20174
 
20175
; $73 - Character: 's'          CHR$(115)
20176
 
20177
        DEFB    %00000000
20178
        DEFB    %00000000
20179
        DEFB    %00111000
20180
        DEFB    %01000000
20181
        DEFB    %00111000
20182
        DEFB    %00000100
20183
        DEFB    %01111000
20184
        DEFB    %00000000
20185
 
20186
; $74 - Character: 't'          CHR$(116)
20187
 
20188
        DEFB    %00000000
20189
        DEFB    %00010000
20190
        DEFB    %00111000
20191
        DEFB    %00010000
20192
        DEFB    %00010000
20193
        DEFB    %00010000
20194
        DEFB    %00001100
20195
        DEFB    %00000000
20196
 
20197
; $75 - Character: 'u'          CHR$(117)
20198
 
20199
        DEFB    %00000000
20200
        DEFB    %00000000
20201
        DEFB    %01000100
20202
        DEFB    %01000100
20203
        DEFB    %01000100
20204
        DEFB    %01000100
20205
        DEFB    %00111000
20206
        DEFB    %00000000
20207
 
20208
; $76 - Character: 'v'          CHR$(118)
20209
 
20210
        DEFB    %00000000
20211
        DEFB    %00000000
20212
        DEFB    %01000100
20213
        DEFB    %01000100
20214
        DEFB    %00101000
20215
        DEFB    %00101000
20216
        DEFB    %00010000
20217
        DEFB    %00000000
20218
 
20219
; $77 - Character: 'w'          CHR$(119)
20220
 
20221
        DEFB    %00000000
20222
        DEFB    %00000000
20223
        DEFB    %01000100
20224
        DEFB    %01010100
20225
        DEFB    %01010100
20226
        DEFB    %01010100
20227
        DEFB    %00101000
20228
        DEFB    %00000000
20229
 
20230
; $78 - Character: 'x'          CHR$(120)
20231
 
20232
        DEFB    %00000000
20233
        DEFB    %00000000
20234
        DEFB    %01000100
20235
        DEFB    %00101000
20236
        DEFB    %00010000
20237
        DEFB    %00101000
20238
        DEFB    %01000100
20239
        DEFB    %00000000
20240
 
20241
; $79 - Character: 'y'          CHR$(121)
20242
 
20243
        DEFB    %00000000
20244
        DEFB    %00000000
20245
        DEFB    %01000100
20246
        DEFB    %01000100
20247
        DEFB    %01000100
20248
        DEFB    %00111100
20249
        DEFB    %00000100
20250
        DEFB    %00111000
20251
 
20252
; $7A - Character: 'z'          CHR$(122)
20253
 
20254
        DEFB    %00000000
20255
        DEFB    %00000000
20256
        DEFB    %01111100
20257
        DEFB    %00001000
20258
        DEFB    %00010000
20259
        DEFB    %00100000
20260
        DEFB    %01111100
20261
        DEFB    %00000000
20262
 
20263
; $7B - Character: '{'          CHR$(123)
20264
 
20265
        DEFB    %00000000
20266
        DEFB    %00001110
20267
        DEFB    %00001000
20268
        DEFB    %00110000
20269
        DEFB    %00001000
20270
        DEFB    %00001000
20271
        DEFB    %00001110
20272
        DEFB    %00000000
20273
 
20274
; $7C - Character: '|'          CHR$(124)
20275
 
20276
        DEFB    %00000000
20277
        DEFB    %00001000
20278
        DEFB    %00001000
20279
        DEFB    %00001000
20280
        DEFB    %00001000
20281
        DEFB    %00001000
20282
        DEFB    %00001000
20283
        DEFB    %00000000
20284
 
20285
; $7D - Character: '}'          CHR$(125)
20286
 
20287
        DEFB    %00000000
20288
        DEFB    %01110000
20289
        DEFB    %00010000
20290
        DEFB    %00001100
20291
        DEFB    %00010000
20292
        DEFB    %00010000
20293
        DEFB    %01110000
20294
        DEFB    %00000000
20295
 
20296
; $7E - Character: '~'          CHR$(126)
20297
 
20298
        DEFB    %00000000
20299
        DEFB    %00010100
20300
        DEFB    %00101000
20301
        DEFB    %00000000
20302
        DEFB    %00000000
20303
        DEFB    %00000000
20304
        DEFB    %00000000
20305
        DEFB    %00000000
20306
 
20307
; $7F - Character: ' © '        CHR$(127)
20308
 
20309
        DEFB    %00111100
20310
        DEFB    %01000010
20311
        DEFB    %10011001
20312
        DEFB    %10100001
20313
        DEFB    %10100001
20314
        DEFB    %10011001
20315
        DEFB    %01000010
20316
        DEFB    %00111100
20317
 
20318
 
20319
#end                            ; generic cross-assembler directive
20320
 
20321
; Acknowledgements
20322
; -----------------
20323
; Sean Irvine               for default list of section headings
20324
; Dr. Ian Logan             for labels and functional disassembly.
20325
; Dr. Frank O'Hara          for labels and functional disassembly.
20326
;
20327
; Credits
20328
; -------
20329
; Alex Pallero Gonzales     for corrections.
20330
; Mike Dailly               for comments.
20331
; Alvin Albrecht            for comments.
20332
; Andy Styles               for full relocatability implementation and testing.                    testing.
20333
; Andrew Owen               for ZASM compatibility and format improvements.
20334
 
20335
;   For other assemblers you may have to add directives like these near the
20336
;   beginning - see accompanying documentation.
20337
;   ZASM (MacOs) cross-assembler directives. (uncomment by removing ';' )
20338
;   #target rom           ; declare target file format as binary.
20339
;   #code   0,$4000       ; declare code segment.
20340
;   Also see notes at Address Labels 0609 and 1CA5 if your assembler has
20341
;   trouble with expressions.
20342
;
20343
;   Note. The Sinclair Interface 1 ROM written by Dr. Ian Logan and Martin
20344
;   Brennan calls numerous routines in this ROM.
20345
;   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.