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

Subversion Repositories a-z80

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 8 gdevic
;************************************************************************
2
;** An Assembly File Listing to generate a 16K ROM for the ZX Spectrum **
3
;************************************************************************
4
;
5 11 gdevic
; 03-13-2016:
6
; Add custom NMI handler and a function to enter game pokes after pressing the NMI button
7
;
8 8 gdevic
; 11-10-2014:
9
; This version has been updated to correctly handle the NMI jump.
10
;
11
; -------------------------
12
; Last updated: 13-DEC-2004
13
; -------------------------
14
 
15
; TASM cross-assembler directives.
16
; ( comment out, perhaps, for other assemblers - see Notes at end.)
17
 
18
#define DEFB .BYTE
19
#define DEFW .WORD
20
#define DEFM .TEXT
21
#define ORG  .ORG
22
#define EQU  .EQU
23
#define equ  .EQU
24
 
25
;   It is always a good idea to anchor, using ORGs, important sections such as
26
;   the character bitmaps so that they don't move as code is added and removed.
27
 
28
;   Generally most approaches try to maintain main entry points as they are
29
;   often used by third-party software.
30
 
31
ORG 0000
32
 
33
;*****************************************
34
;** Part 1. RESTART ROUTINES AND TABLES **
35
;*****************************************
36
 
37
; -----------
38
; THE 'START'
39
; -----------
40
;   At switch on, the Z80 chip is in Interrupt Mode 0.
41
;   The Spectrum uses Interrupt Mode 1.
42
;   This location can also be 'called' to reset the machine.
43
;   Typically with PRINT USR 0.
44
 
45
;; START
46
L0000:  DI                      ; Disable Interrupts.
47
        XOR     A               ; Signal coming from START.
48
        LD      DE,$FFFF        ; Set pointer to top of possible physical RAM.
49
        JP      L11CB           ; Jump forward to common code at START-NEW.
50
 
51
; -------------------
52
; THE 'ERROR' RESTART
53
; -------------------
54
;   The error pointer is made to point to the position of the error to enable
55
;   the editor to highlight the error position if it occurred during syntax
56
;   checking.  It is used at 37 places in the program.  An instruction fetch
57
;   on address $0008 may page in a peripheral ROM such as the Sinclair
58
;   Interface 1 or Disciple Disk Interface.  This was not an original design
59
;   concept and not all errors pass through here.
60
 
61
;; ERROR-1
62
L0008:  LD      HL,($5C5D)      ; Fetch the character address from CH_ADD.
63
        LD      ($5C5F),HL      ; Copy it to the error pointer X_PTR.
64
        JR      L0053           ; Forward to continue at ERROR-2.
65
 
66
; -----------------------------
67
; THE 'PRINT CHARACTER' RESTART
68
; -----------------------------
69
;   The A register holds the code of the character that is to be sent to
70
;   the output stream of the current channel.  The alternate register set is
71
;   used to output a character in the A register so there is no need to
72
;   preserve any of the current main registers (HL, DE, BC).
73
;   This restart is used 21 times.
74
 
75
;; PRINT-A
76
L0010:  JP      L15F2           ; Jump forward to continue at PRINT-A-2.
77
 
78
; ---
79
 
80
        DEFB    $FF, $FF, $FF   ; Five unused locations.
81
        DEFB    $FF, $FF        ;
82
 
83
; -------------------------------
84
; THE 'COLLECT CHARACTER' RESTART
85
; -------------------------------
86
;   The contents of the location currently addressed by CH_ADD are fetched.
87
;   A return is made if the value represents a character that has
88
;   relevance to the BASIC parser. Otherwise CH_ADD is incremented and the
89
;   tests repeated. CH_ADD will be addressing somewhere -
90
;   1) in the BASIC program area during line execution.
91
;   2) in workspace if evaluating, for example, a string expression.
92
;   3) in the edit buffer if parsing a direct command or a new BASIC line.
93
;   4) in workspace if accepting input but not that from INPUT LINE.
94
 
95
;; GET-CHAR
96
L0018:  LD      HL,($5C5D)      ; fetch the address from CH_ADD.
97
        LD      A,(HL)          ; use it to pick up current character.
98
 
99
;; TEST-CHAR
100
L001C:  CALL    L007D           ; routine SKIP-OVER tests if the character is
101
                                ; relevant.
102
        RET     NC              ; Return if it is significant.
103
 
104
; ------------------------------------
105
; THE 'COLLECT NEXT CHARACTER' RESTART
106
; ------------------------------------
107
;   As the BASIC commands and expressions are interpreted, this routine is
108
;   called repeatedly to step along the line.  It is used 83 times.
109
 
110
;; NEXT-CHAR
111
L0020:  CALL    L0074           ; routine CH-ADD+1 fetches the next immediate
112
                                ; character.
113
        JR      L001C           ; jump back to TEST-CHAR until a valid
114
                                ; character is found.
115
 
116
; ---
117
 
118
        DEFB    $FF, $FF, $FF   ; unused
119
 
120
; -----------------------
121
; THE 'CALCULATE' RESTART
122
; -----------------------
123
;   This restart enters the Spectrum's internal, floating-point, stack-based,
124
;   FORTH-like language.
125
;   It is further used recursively from within the calculator.
126
;   It is used on 77 occasions.
127
 
128
;; FP-CALC
129
L0028:  JP      L335B           ; jump forward to the CALCULATE routine.
130
 
131
; ---
132
 
133
        DEFB    $FF, $FF, $FF   ; spare - note that on the ZX81, space being a
134
        DEFB    $FF, $FF        ; little cramped, these same locations were
135
                                ; used for the five-byte end-calc literal.
136
 
137
; ------------------------------
138
; THE 'CREATE BC SPACES' RESTART
139
; ------------------------------
140
;   This restart is used on only 12 occasions to create BC spaces
141
;   between workspace and the calculator stack.
142
 
143
;; BC-SPACES
144
L0030:  PUSH    BC              ; Save number of spaces.
145
        LD      HL,($5C61)      ; Fetch WORKSP.
146
        PUSH    HL              ; Save address of workspace.
147
        JP      L169E           ; Jump forward to continuation code RESERVE.
148
 
149
; --------------------------------
150
; THE 'MASKABLE INTERRUPT' ROUTINE
151
; --------------------------------
152
;   This routine increments the Spectrum's three-byte FRAMES counter fifty
153
;   times a second (sixty times a second in the USA ).
154
;   Both this routine and the called KEYBOARD subroutine use the IY register
155
;   to access system variables and flags so a user-written program must
156
;   disable interrupts to make use of the IY register.
157
 
158
;; MASK-INT
159
L0038:  PUSH    AF              ; Save the registers that will be used but not
160
        PUSH    HL              ; the IY register unfortunately.
161
        LD      HL,($5C78)      ; Fetch the first two bytes at FRAMES1.
162
        INC     HL              ; Increment lowest two bytes of counter.
163
        LD      ($5C78),HL      ; Place back in FRAMES1.
164
        LD      A,H             ; Test if the result was zero.
165
        OR      L               ;
166
        JR      NZ,L0048        ; Forward, if not, to KEY-INT
167
 
168
        INC     (IY+$40)        ; otherwise increment FRAMES3 the third byte.
169
 
170
;   Now save the rest of the main registers and read and decode the keyboard.
171
 
172
;; KEY-INT
173
L0048:  PUSH    BC              ; Save the other main registers.
174
        PUSH    DE              ;
175
 
176
        CALL    L02BF           ; Routine KEYBOARD executes a stage in the
177
                                ; process of reading a key-press.
178
        POP     DE              ;
179
        POP     BC              ; Restore registers.
180
 
181
        POP     HL              ;
182
        POP     AF              ;
183
 
184
        EI                      ; Enable Interrupts.
185
        RET                     ; Return.
186
 
187
; ---------------------
188
; THE 'ERROR-2' ROUTINE
189
; ---------------------
190
;   A continuation of the code at 0008.
191
;   The error code is stored and after clearing down stacks, an indirect jump
192
;   is made to MAIN-4, etc. to handle the error.
193
 
194
;; ERROR-2
195
L0053:  POP     HL              ; drop the return address - the location
196
                                ; after the RST 08H instruction.
197
        LD      L,(HL)          ; fetch the error code that follows.
198
                                ; (nice to see this instruction used.)
199
 
200
;   Note. this entry point is used when out of memory at REPORT-4.
201
;   The L register has been loaded with the report code but X-PTR is not
202
;   updated.
203
 
204
;; ERROR-3
205
L0055:  LD      (IY+$00),L      ; Store it in the system variable ERR_NR.
206
        LD      SP,($5C3D)      ; ERR_SP points to an error handler on the
207
                                ; machine stack. There may be a hierarchy
208
                                ; of routines.
209
                                ; To MAIN-4 initially at base.
210
                                ; or REPORT-G on line entry.
211
                                ; or  ED-ERROR when editing.
212
                                ; or   ED-FULL during ed-enter.
213
                                ; or  IN-VAR-1 during runtime input etc.
214
 
215
        JP      L16C5           ; Jump to SET-STK to clear the calculator stack
216
                                ; and reset MEM to usual place in the systems
217
                                ; variables area and then indirectly to MAIN-4,
218
                                ; etc.
219
 
220
; ---
221
 
222
        DEFB    $FF, $FF, $FF   ; Unused locations
223
        DEFB    $FF, $FF, $FF   ; before the fixed-position
224
        DEFB    $FF             ; NMI routine.
225
 
226
; ------------------------------------
227
; THE 'NON-MASKABLE INTERRUPT' ROUTINE
228
; ------------------------------------
229
;
230
;   There is no NMI switch on the standard Spectrum or its peripherals.
231
;   When the NMI line is held low, then no matter what the Z80 was doing at
232
;   the time, it will now execute the code at 66 Hex.
233
;   This Interrupt Service Routine will jump to location zero if the contents
234
;   of the system variable NMIADD are zero or return if the location holds a
235
;   non-zero address.   So attaching a simple switch to the NMI as in the book
236
;   "Spectrum Hardware Manual" causes a reset.  The logic was obviously
237
;   intended to work the other way.  Sinclair Research said that, since they
238
;   had never advertised the NMI, they had no plans to fix the error "until
239
;   the opportunity arose".
240
;
241
;   Note. The location NMIADD was, in fact, later used by Sinclair Research
242
;   to enhance the text channel on the ZX Interface 1.
243
;   On later Amstrad-made Spectrums, and the Brazilian Spectrum, the logic of
244
;   this routine was indeed reversed but not as at first intended.
245
;
246
;   It can be deduced by looking elsewhere in this ROM that the NMIADD system
247
;   variable pointed to L121C and that this enabled a Warm Restart to be
248
;   performed at any time, even while playing machine code games, or while
249
;   another Spectrum has been allowed to gain control of this one.
250
;
251
;   Software houses would have been able to protect their games from attack by
252
;   placing two zeros in the NMIADD system variable.
253
 
254
;; RESET
255
L0066:  PUSH    AF              ; save the
256
        PUSH    HL              ; registers.
257 11 gdevic
;       LD      HL,($5CB0)      ; fetch the system variable NMIADD.
258
        LD      HL, nmi_handler ; Custom NMI handler
259 8 gdevic
        LD      A,H             ; test address
260
        OR      L               ; for zero.
261
 
262 11 gdevic
;       JR      NZ,L0070       ; skip to NO-RESET if NOT ZERO
263 8 gdevic
        JR      Z,L0070         ; **FIXED**
264
 
265
        JP      (HL)            ; jump to routine ( i.e. L0000 )
266
 
267
;; NO-RESET
268
L0070:  POP     HL              ; restore the
269
        POP     AF              ; registers.
270
        RETN                    ; return to previous interrupt state.
271
 
272
; ---------------------------
273
; THE 'CH ADD + 1' SUBROUTINE
274
; ---------------------------
275
;   This subroutine is called from RST 20, and three times from elsewhere
276
;   to fetch the next immediate character following the current valid character
277
;   address and update the associated system variable.
278
;   The entry point TEMP-PTR1 is used from the SCANNING routine.
279
;   Both TEMP-PTR1 and TEMP-PTR2 are used by the READ command routine.
280
 
281
;; CH-ADD+1
282
L0074:  LD      HL,($5C5D)      ; fetch address from CH_ADD.
283
 
284
;; TEMP-PTR1
285
L0077:  INC     HL              ; increase the character address by one.
286
 
287
;; TEMP-PTR2
288
L0078:  LD      ($5C5D),HL      ; update CH_ADD with character address.
289
 
290
X007B:  LD      A,(HL)          ; load character to A from HL.
291
        RET                     ; and return.
292
 
293
; --------------------------
294
; THE 'SKIP OVER' SUBROUTINE
295
; --------------------------
296
;   This subroutine is called once from RST 18 to skip over white-space and
297
;   other characters irrelevant to the parsing of a BASIC line etc. .
298
;   Initially the A register holds the character to be considered
299
;   and HL holds its address which will not be within quoted text
300
;   when a BASIC line is parsed.
301
;   Although the 'tab' and 'at' characters will not appear in a BASIC line,
302
;   they could be present in a string expression, and in other situations.
303
;   Note. although white-space is usually placed in a program to indent loops
304
;   and make it more readable, it can also be used for the opposite effect and
305
;   spaces may appear in variable names although the parser never sees them.
306
;   It is this routine that helps make the variables 'Anum bEr5 3BUS' and
307
;   'a number 53 bus' appear the same to the parser.
308
 
309
;; SKIP-OVER
310
L007D:  CP      $21             ; test if higher than space.
311
        RET     NC              ; return with carry clear if so.
312
 
313
        CP      $0D             ; carriage return ?
314
        RET     Z               ; return also with carry clear if so.
315
 
316
                                ; all other characters have no relevance
317
                                ; to the parser and must be returned with
318
                                ; carry set.
319
 
320
        CP      $10             ; test if 0-15d
321
        RET     C               ; return, if so, with carry set.
322
 
323
        CP      $18             ; test if 24-32d
324
        CCF                     ; complement carry flag.
325
        RET     C               ; return with carry set if so.
326
 
327
                                ; now leaves 16d-23d
328
 
329
        INC     HL              ; all above have at least one extra character
330
                                ; to be stepped over.
331
 
332
        CP      $16             ; controls 22d ('at') and 23d ('tab') have two.
333
        JR      C,L0090         ; forward to SKIPS with ink, paper, flash,
334
                                ; bright, inverse or over controls.
335
                                ; Note. the high byte of tab is for RS232 only.
336
                                ; it has no relevance on this machine.
337
 
338
        INC     HL              ; step over the second character of 'at'/'tab'.
339
 
340
;; SKIPS
341
L0090:  SCF                     ; set the carry flag
342
        LD      ($5C5D),HL      ; update the CH_ADD system variable.
343
        RET                     ; return with carry set.
344
 
345
 
346
; ------------------
347
; THE 'TOKEN' TABLES
348
; ------------------
349
;   The tokenized characters 134d (RND) to 255d (COPY) are expanded using
350
;   this table. The last byte of a token is inverted to denote the end of
351
;   the word. The first is an inverted step-over byte.
352
 
353
;; TKN-TABLE
354
L0095:  DEFB    '?'+$80
355
        DEFM    "RN"
356
        DEFB    'D'+$80
357
        DEFM    "INKEY"
358
        DEFB    '$'+$80
359
        DEFB    'P','I'+$80
360
        DEFB    'F','N'+$80
361
        DEFM    "POIN"
362
        DEFB    'T'+$80
363
        DEFM    "SCREEN"
364
        DEFB    '$'+$80
365
        DEFM    "ATT"
366
        DEFB    'R'+$80
367
        DEFB    'A','T'+$80
368
        DEFM    "TA"
369
        DEFB    'B'+$80
370
        DEFM    "VAL"
371
        DEFB    '$'+$80
372
        DEFM    "COD"
373
        DEFB    'E'+$80
374
        DEFM    "VA"
375
        DEFB    'L'+$80
376
        DEFM    "LE"
377
        DEFB    'N'+$80
378
        DEFM    "SI"
379
        DEFB    'N'+$80
380
        DEFM    "CO"
381
        DEFB    'S'+$80
382
        DEFM    "TA"
383
        DEFB    'N'+$80
384
        DEFM    "AS"
385
        DEFB    'N'+$80
386
        DEFM    "AC"
387
        DEFB    'S'+$80
388
        DEFM    "AT"
389
        DEFB    'N'+$80
390
        DEFB    'L','N'+$80
391
        DEFM    "EX"
392
        DEFB    'P'+$80
393
        DEFM    "IN"
394
        DEFB    'T'+$80
395
        DEFM    "SQ"
396
        DEFB    'R'+$80
397
        DEFM    "SG"
398
        DEFB    'N'+$80
399
        DEFM    "AB"
400
        DEFB    'S'+$80
401
        DEFM    "PEE"
402
        DEFB    'K'+$80
403
        DEFB    'I','N'+$80
404
        DEFM    "US"
405
        DEFB    'R'+$80
406
        DEFM    "STR"
407
        DEFB    '$'+$80
408
        DEFM    "CHR"
409
        DEFB    '$'+$80
410
        DEFM    "NO"
411
        DEFB    'T'+$80
412
        DEFM    "BI"
413
        DEFB    'N'+$80
414
 
415
;   The previous 32 function-type words are printed without a leading space
416
;   The following have a leading space if they begin with a letter
417
 
418
        DEFB    'O','R'+$80
419
        DEFM    "AN"
420
        DEFB    'D'+$80
421
        DEFB    $3C,'='+$80             ; <=
422
        DEFB    $3E,'='+$80             ; >=
423
        DEFB    $3C,$3E+$80             ; <>
424
        DEFM    "LIN"
425
        DEFB    'E'+$80
426
        DEFM    "THE"
427
        DEFB    'N'+$80
428
        DEFB    'T','O'+$80
429
        DEFM    "STE"
430
        DEFB    'P'+$80
431
        DEFM    "DEF F"
432
        DEFB    'N'+$80
433
        DEFM    "CA"
434
        DEFB    'T'+$80
435
        DEFM    "FORMA"
436
        DEFB    'T'+$80
437
        DEFM    "MOV"
438
        DEFB    'E'+$80
439
        DEFM    "ERAS"
440
        DEFB    'E'+$80
441
        DEFM    "OPEN "
442
        DEFB    '#'+$80
443
        DEFM    "CLOSE "
444
        DEFB    '#'+$80
445
        DEFM    "MERG"
446
        DEFB    'E'+$80
447
        DEFM    "VERIF"
448
        DEFB    'Y'+$80
449
        DEFM    "BEE"
450
        DEFB    'P'+$80
451
        DEFM    "CIRCL"
452
        DEFB    'E'+$80
453
        DEFM    "IN"
454
        DEFB    'K'+$80
455
        DEFM    "PAPE"
456
        DEFB    'R'+$80
457
        DEFM    "FLAS"
458
        DEFB    'H'+$80
459
        DEFM    "BRIGH"
460
        DEFB    'T'+$80
461
        DEFM    "INVERS"
462
        DEFB    'E'+$80
463
        DEFM    "OVE"
464
        DEFB    'R'+$80
465
        DEFM    "OU"
466
        DEFB    'T'+$80
467
        DEFM    "LPRIN"
468
        DEFB    'T'+$80
469
        DEFM    "LLIS"
470
        DEFB    'T'+$80
471
        DEFM    "STO"
472
        DEFB    'P'+$80
473
        DEFM    "REA"
474
        DEFB    'D'+$80
475
        DEFM    "DAT"
476
        DEFB    'A'+$80
477
        DEFM    "RESTOR"
478
        DEFB    'E'+$80
479
        DEFM    "NE"
480
        DEFB    'W'+$80
481
        DEFM    "BORDE"
482
        DEFB    'R'+$80
483
        DEFM    "CONTINU"
484
        DEFB    'E'+$80
485
        DEFM    "DI"
486
        DEFB    'M'+$80
487
        DEFM    "RE"
488
        DEFB    'M'+$80
489
        DEFM    "FO"
490
        DEFB    'R'+$80
491
        DEFM    "GO T"
492
        DEFB    'O'+$80
493
        DEFM    "GO SU"
494
        DEFB    'B'+$80
495
        DEFM    "INPU"
496
        DEFB    'T'+$80
497
        DEFM    "LOA"
498
        DEFB    'D'+$80
499
        DEFM    "LIS"
500
        DEFB    'T'+$80
501
        DEFM    "LE"
502
        DEFB    'T'+$80
503
        DEFM    "PAUS"
504
        DEFB    'E'+$80
505
        DEFM    "NEX"
506
        DEFB    'T'+$80
507
        DEFM    "POK"
508
        DEFB    'E'+$80
509
        DEFM    "PRIN"
510
        DEFB    'T'+$80
511
        DEFM    "PLO"
512
        DEFB    'T'+$80
513
        DEFM    "RU"
514
        DEFB    'N'+$80
515
        DEFM    "SAV"
516
        DEFB    'E'+$80
517
        DEFM    "RANDOMIZ"
518
        DEFB    'E'+$80
519
        DEFB    'I','F'+$80
520
        DEFM    "CL"
521
        DEFB    'S'+$80
522
        DEFM    "DRA"
523
        DEFB    'W'+$80
524
        DEFM    "CLEA"
525
        DEFB    'R'+$80
526
        DEFM    "RETUR"
527
        DEFB    'N'+$80
528
        DEFM    "COP"
529
        DEFB    'Y'+$80
530
 
531
; ----------------
532
; THE 'KEY' TABLES
533
; ----------------
534
;   These six look-up tables are used by the keyboard reading routine
535
;   to decode the key values.
536
;
537
;   The first table contains the maps for the 39 keys of the standard
538
;   40-key Spectrum keyboard. The remaining key [SHIFT $27] is read directly.
539
;   The keys consist of the 26 upper-case alphabetic characters, the 10 digit
540
;   keys and the space, ENTER and symbol shift key.
541
;   Unshifted alphabetic keys have $20 added to the value.
542
;   The keywords for the main alphabetic keys are obtained by adding $A5 to
543
;   the values obtained from this table.
544
 
545
;; MAIN-KEYS
546
L0205:  DEFB    $42             ; B
547
        DEFB    $48             ; H
548
        DEFB    $59             ; Y
549
        DEFB    $36             ; 6
550
        DEFB    $35             ; 5
551
        DEFB    $54             ; T
552
        DEFB    $47             ; G
553
        DEFB    $56             ; V
554
        DEFB    $4E             ; N
555
        DEFB    $4A             ; J
556
        DEFB    $55             ; U
557
        DEFB    $37             ; 7
558
        DEFB    $34             ; 4
559
        DEFB    $52             ; R
560
        DEFB    $46             ; F
561
        DEFB    $43             ; C
562
        DEFB    $4D             ; M
563
        DEFB    $4B             ; K
564
        DEFB    $49             ; I
565
        DEFB    $38             ; 8
566
        DEFB    $33             ; 3
567
        DEFB    $45             ; E
568
        DEFB    $44             ; D
569
        DEFB    $58             ; X
570
        DEFB    $0E             ; SYMBOL SHIFT
571
        DEFB    $4C             ; L
572
        DEFB    $4F             ; O
573
        DEFB    $39             ; 9
574
        DEFB    $32             ; 2
575
        DEFB    $57             ; W
576
        DEFB    $53             ; S
577
        DEFB    $5A             ; Z
578
        DEFB    $20             ; SPACE
579
        DEFB    $0D             ; ENTER
580
        DEFB    $50             ; P
581
        DEFB    $30             ; 0
582
        DEFB    $31             ; 1
583
        DEFB    $51             ; Q
584
        DEFB    $41             ; A
585
 
586
 
587
;; E-UNSHIFT
588
;  The 26 unshifted extended mode keys for the alphabetic characters.
589
;  The green keywords on the original keyboard.
590
L022C:  DEFB    $E3             ; READ
591
        DEFB    $C4             ; BIN
592
        DEFB    $E0             ; LPRINT
593
        DEFB    $E4             ; DATA
594
        DEFB    $B4             ; TAN
595
        DEFB    $BC             ; SGN
596
        DEFB    $BD             ; ABS
597
        DEFB    $BB             ; SQR
598
        DEFB    $AF             ; CODE
599
        DEFB    $B0             ; VAL
600
        DEFB    $B1             ; LEN
601
        DEFB    $C0             ; USR
602
        DEFB    $A7             ; PI
603
        DEFB    $A6             ; INKEY$
604
        DEFB    $BE             ; PEEK
605
        DEFB    $AD             ; TAB
606
        DEFB    $B2             ; SIN
607
        DEFB    $BA             ; INT
608
        DEFB    $E5             ; RESTORE
609
        DEFB    $A5             ; RND
610
        DEFB    $C2             ; CHR$
611
        DEFB    $E1             ; LLIST
612
        DEFB    $B3             ; COS
613
        DEFB    $B9             ; EXP
614
        DEFB    $C1             ; STR$
615
        DEFB    $B8             ; LN
616
 
617
 
618
;; EXT-SHIFT
619
;  The 26 shifted extended mode keys for the alphabetic characters.
620
;  The red keywords below keys on the original keyboard.
621
L0246:  DEFB    $7E             ; ~
622
        DEFB    $DC             ; BRIGHT
623
        DEFB    $DA             ; PAPER
624
        DEFB    $5C             ; \
625
        DEFB    $B7             ; ATN
626
        DEFB    $7B             ; {
627
        DEFB    $7D             ; }
628
        DEFB    $D8             ; CIRCLE
629
        DEFB    $BF             ; IN
630
        DEFB    $AE             ; VAL$
631
        DEFB    $AA             ; SCREEN$
632
        DEFB    $AB             ; ATTR
633
        DEFB    $DD             ; INVERSE
634
        DEFB    $DE             ; OVER
635
        DEFB    $DF             ; OUT
636
        DEFB    $7F             ; (Copyright character)
637
        DEFB    $B5             ; ASN
638
        DEFB    $D6             ; VERIFY
639
        DEFB    $7C             ; |
640
        DEFB    $D5             ; MERGE
641
        DEFB    $5D             ; ]
642
        DEFB    $DB             ; FLASH
643
        DEFB    $B6             ; ACS
644
        DEFB    $D9             ; INK
645
        DEFB    $5B             ; [
646
        DEFB    $D7             ; BEEP
647
 
648
 
649
;; CTL-CODES
650
;  The ten control codes assigned to the top line of digits when the shift
651
;  key is pressed.
652
L0260:  DEFB    $0C             ; DELETE
653
        DEFB    $07             ; EDIT
654
        DEFB    $06             ; CAPS LOCK
655
        DEFB    $04             ; TRUE VIDEO
656
        DEFB    $05             ; INVERSE VIDEO
657
        DEFB    $08             ; CURSOR LEFT
658
        DEFB    $0A             ; CURSOR DOWN
659
        DEFB    $0B             ; CURSOR UP
660
        DEFB    $09             ; CURSOR RIGHT
661
        DEFB    $0F             ; GRAPHICS
662
 
663
 
664
;; SYM-CODES
665
;  The 26 red symbols assigned to the alphabetic characters of the keyboard.
666
;  The ten single-character digit symbols are converted without the aid of
667
;  a table using subtraction and minor manipulation.
668
L026A:  DEFB    $E2             ; STOP
669
        DEFB    $2A             ; *
670
        DEFB    $3F             ; ?
671
        DEFB    $CD             ; STEP
672
        DEFB    $C8             ; >=
673
        DEFB    $CC             ; TO
674
        DEFB    $CB             ; THEN
675
        DEFB    $5E             ; ^
676
        DEFB    $AC             ; AT
677
        DEFB    $2D             ; -
678
        DEFB    $2B             ; +
679
        DEFB    $3D             ; =
680
        DEFB    $2E             ; .
681
        DEFB    $2C             ; ,
682
        DEFB    $3B             ; ;
683
        DEFB    $22             ; "
684
        DEFB    $C7             ; <=
685
        DEFB    $3C             ; <
686
        DEFB    $C3             ; NOT
687
        DEFB    $3E             ; >
688
        DEFB    $C5             ; OR
689
        DEFB    $2F             ; /
690
        DEFB    $C9             ; <>
691
        DEFB    $60             ; pound
692
        DEFB    $C6             ; AND
693
        DEFB    $3A             ; :
694
 
695
;; E-DIGITS
696
;  The ten keywords assigned to the digits in extended mode.
697
;  The remaining red keywords below the keys.
698
L0284:  DEFB    $D0             ; FORMAT
699
        DEFB    $CE             ; DEF FN
700
        DEFB    $A8             ; FN
701
        DEFB    $CA             ; LINE
702
        DEFB    $D3             ; OPEN #
703
        DEFB    $D4             ; CLOSE #
704
        DEFB    $D1             ; MOVE
705
        DEFB    $D2             ; ERASE
706
        DEFB    $A9             ; POINT
707
        DEFB    $CF             ; CAT
708
 
709
 
710
;*******************************
711
;** Part 2. KEYBOARD ROUTINES **
712
;*******************************
713
 
714
;   Using shift keys and a combination of modes the Spectrum 40-key keyboard
715
;   can be mapped to 256 input characters
716
 
717
; ---------------------------------------------------------------------------
718
;
719
;         0     1     2     3     4 -Bits-  4     3     2     1     0
720
; PORT                                                                    PORT
721
;
722
; F7FE  [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ]  |  [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 0 ]   EFFE
723
;  ^                                   |                                   v
724
; FBFE  [ Q ] [ W ] [ E ] [ R ] [ T ]  |  [ Y ] [ U ] [ I ] [ O ] [ P ]   DFFE
725
;  ^                                   |                                   v
726
; FDFE  [ A ] [ S ] [ D ] [ F ] [ G ]  |  [ H ] [ J ] [ K ] [ L ] [ ENT ] BFFE
727
;  ^                                   |                                   v
728
; FEFE  [SHI] [ Z ] [ X ] [ C ] [ V ]  |  [ B ] [ N ] [ M ] [sym] [ SPC ] 7FFE
729
;  ^     $27                                                 $18           v
730
; Start                                                                   End
731
;        00100111                                            00011000
732
;
733
; ---------------------------------------------------------------------------
734
;   The above map may help in reading.
735
;   The neat arrangement of ports means that the B register need only be
736
;   rotated left to work up the left hand side and then down the right
737
;   hand side of the keyboard. When the reset bit drops into the carry
738
;   then all 8 half-rows have been read. Shift is the first key to be
739
;   read. The lower six bits of the shifts are unambiguous.
740
 
741
; -------------------------------
742
; THE 'KEYBOARD SCANNING' ROUTINE
743
; -------------------------------
744
;   From keyboard and s-inkey$
745
;   Returns 1 or 2 keys in DE, most significant shift first if any
746
;   key values 0-39 else 255
747
 
748
;; KEY-SCAN
749
L028E:  LD      L,$2F           ; initial key value
750
                                ; valid values are obtained by subtracting
751
                                ; eight five times.
752
        LD      DE,$FFFF        ; a buffer to receive 2 keys.
753
 
754
        LD      BC,$FEFE        ; the commencing port address
755
                                ; B holds 11111110 initially and is also
756
                                ; used to count the 8 half-rows
757
;; KEY-LINE
758
L0296:  IN      A,(C)           ; read the port to A - bits will be reset
759
                                ; if a key is pressed else set.
760
        CPL                     ; complement - pressed key-bits are now set
761
        AND     $1F             ; apply 00011111 mask to pick up the
762
                                ; relevant set bits.
763
 
764
        JR      Z,L02AB         ; forward to KEY-DONE if zero and therefore
765
                                ; no keys pressed in row at all.
766
 
767
        LD      H,A             ; transfer row bits to H
768
        LD      A,L             ; load the initial key value to A
769
 
770
;; KEY-3KEYS
771
L029F:  INC     D               ; now test the key buffer
772
        RET     NZ              ; if we have collected 2 keys already
773
                                ; then too many so quit.
774
 
775
;; KEY-BITS
776
L02A1:  SUB     $08             ; subtract 8 from the key value
777
                                ; cycling through key values (top = $27)
778
                                ; e.g. 2F>   27>1F>17>0F>07
779
                                ;      2E>   26>1E>16>0E>06
780
        SRL     H               ; shift key bits right into carry.
781
        JR      NC,L02A1        ; back to KEY-BITS if not pressed
782
                                ; but if pressed we have a value (0-39d)
783
 
784
        LD      D,E             ; transfer a possible previous key to D
785
        LD      E,A             ; transfer the new key to E
786
        JR      NZ,L029F        ; back to KEY-3KEYS if there were more
787
                                ; set bits - H was not yet zero.
788
 
789
;; KEY-DONE
790
L02AB:  DEC     L               ; cycles 2F>2E>2D>2C>2B>2A>29>28 for
791
                                ; each half-row.
792
        RLC     B               ; form next port address e.g. FEFE > FDFE
793
        JR      C,L0296         ; back to KEY-LINE if still more rows to do.
794
 
795
        LD      A,D             ; now test if D is still FF ?
796
        INC     A               ; if it is zero we have at most 1 key
797
                                ; range now $01-$28  (1-40d)
798
        RET     Z               ; return if one key or no key.
799
 
800
        CP      $28             ; is it capsshift (was $27) ?
801
        RET     Z               ; return if so.
802
 
803
        CP      $19             ; is it symbol shift (was $18) ?
804
        RET     Z               ; return also
805
 
806
        LD      A,E             ; now test E
807
        LD      E,D             ; but first switch
808
        LD      D,A             ; the two keys.
809
        CP      $18             ; is it symbol shift ?
810
        RET                     ; return (with zero set if it was).
811
                                ; but with symbol shift now in D
812
 
813
; ----------------------
814
; THE 'KEYBOARD' ROUTINE
815
; ----------------------
816
;   Called from the interrupt 50 times a second.
817
;
818
 
819
;; KEYBOARD
820
L02BF:  CALL    L028E           ; routine KEY-SCAN
821
        RET     NZ              ; return if invalid combinations
822
 
823
;   then decrease the counters within the two key-state maps
824
;   as this could cause one to become free.
825
;   if the keyboard has not been pressed during the last five interrupts
826
;   then both sets will be free.
827
 
828
 
829
        LD      HL,$5C00        ; point to KSTATE-0
830
 
831
;; K-ST-LOOP
832
L02C6:  BIT     7,(HL)          ; is it free ?  (i.e. $FF)
833
        JR      NZ,L02D1        ; forward to K-CH-SET if so
834
 
835
        INC     HL              ; address the 5-counter
836
        DEC     (HL)            ; decrease the counter
837
        DEC     HL              ; step back
838
 
839
        JR      NZ,L02D1        ; forward to K-CH-SET if not at end of count
840
 
841
        LD      (HL),$FF        ; else mark this particular map free.
842
 
843
;; K-CH-SET
844
L02D1:  LD      A,L             ; make a copy of the low address byte.
845
        LD      HL,$5C04        ; point to KSTATE-4
846
                                ; (ld l,$04 would do)
847
        CP      L               ; have both sets been considered ?
848
        JR      NZ,L02C6        ; back to K-ST-LOOP to consider this 2nd set
849
 
850
;   now the raw key (0-38d) is converted to a main key (uppercase).
851
 
852
        CALL    L031E           ; routine K-TEST to get main key in A
853
 
854
        RET     NC              ; return if just a single shift
855
 
856
        LD      HL,$5C00        ; point to KSTATE-0
857
        CP      (HL)            ; does the main key code match ?
858
        JR      Z,L0310         ; forward to K-REPEAT if so
859
 
860
;   if not consider the second key map.
861
 
862
        EX      DE,HL           ; save kstate-0 in de
863
        LD      HL,$5C04        ; point to KSTATE-4
864
        CP      (HL)            ; does the main key code match ?
865
        JR      Z,L0310         ; forward to K-REPEAT if so
866
 
867
;   having excluded a repeating key we can now consider a new key.
868
;   the second set is always examined before the first.
869
 
870
        BIT     7,(HL)          ; is the key map free ?
871
        JR      NZ,L02F1        ; forward to K-NEW if so.
872
 
873
        EX      DE,HL           ; bring back KSTATE-0
874
        BIT     7,(HL)          ; is it free ?
875
        RET     Z               ; return if not.
876
                                ; as we have a key but nowhere to put it yet.
877
 
878
;   continue or jump to here if one of the buffers was free.
879
 
880
;; K-NEW
881
L02F1:  LD      E,A             ; store key in E
882
        LD      (HL),A          ; place in free location
883
        INC     HL              ; advance to the interrupt counter
884
        LD      (HL),$05        ; and initialize counter to 5
885
        INC     HL              ; advance to the delay
886
        LD      A,($5C09)       ; pick up the system variable REPDEL
887
        LD      (HL),A          ; and insert that for first repeat delay.
888
        INC     HL              ; advance to last location of state map.
889
 
890
        LD      C,(IY+$07)      ; pick up MODE  (3 bytes)
891
        LD      D,(IY+$01)      ; pick up FLAGS (3 bytes)
892
        PUSH    HL              ; save state map location
893
                                ; Note. could now have used, to avoid IY,
894
                                ; ld l,$41; ld c,(hl); ld l,$3B; ld d,(hl).
895
                                ; six and two threes of course.
896
 
897
        CALL    L0333           ; routine K-DECODE
898
 
899
        POP     HL              ; restore map pointer
900
        LD      (HL),A          ; put the decoded key in last location of map.
901
 
902
;; K-END
903
L0308:  LD      ($5C08),A       ; update LASTK system variable.
904
        SET     5,(IY+$01)      ; update FLAGS  - signal a new key.
905
        RET                     ; return to interrupt routine.
906
 
907
; -----------------------
908
; THE 'REPEAT KEY' BRANCH
909
; -----------------------
910
;   A possible repeat has been identified. HL addresses the raw key.
911
;   The last location of the key map holds the decoded key from the first
912
;   context.  This could be a keyword and, with the exception of NOT a repeat
913
;   is syntactically incorrect and not really desirable.
914
 
915
;; K-REPEAT
916
L0310:  INC     HL              ; increment the map pointer to second location.
917
        LD      (HL),$05        ; maintain interrupt counter at 5.
918
        INC     HL              ; now point to third location.
919
        DEC     (HL)            ; decrease the REPDEL value which is used to
920
                                ; time the delay of a repeat key.
921
 
922
        RET     NZ              ; return if not yet zero.
923
 
924
        LD      A,($5C0A)       ; fetch the system variable value REPPER.
925
        LD      (HL),A          ; for subsequent repeats REPPER will be used.
926
 
927
        INC     HL              ; advance
928
                                ;
929
        LD      A,(HL)          ; pick up the key decoded possibly in another
930
                                ; context.
931
                                ; Note. should compare with $A5 (RND) and make
932
                                ; a simple return if this is a keyword.
933
                                ; e.g. cp $a5; ret nc; (3 extra bytes)
934
        JR      L0308           ; back to K-END
935
 
936
; ----------------------
937
; THE 'KEY-TEST' ROUTINE
938
; ----------------------
939
;   also called from s-inkey$
940
;   begin by testing for a shift with no other.
941
 
942
;; K-TEST
943
L031E:  LD      B,D             ; load most significant key to B
944
                                ; will be $FF if not shift.
945
        LD      D,$00           ; and reset D to index into main table
946
        LD      A,E             ; load least significant key from E
947
        CP      $27             ; is it higher than 39d   i.e. FF
948
        RET     NC              ; return with just a shift (in B now)
949
 
950
        CP      $18             ; is it symbol shift ?
951
        JR      NZ,L032C        ; forward to K-MAIN if not
952
 
953
;   but we could have just symbol shift and no other
954
 
955
        BIT     7,B             ; is other key $FF (ie not shift)
956
        RET     NZ              ; return with solitary symbol shift
957
 
958
 
959
;; K-MAIN
960
L032C:  LD      HL,L0205        ; address: MAIN-KEYS
961
        ADD     HL,DE           ; add offset 0-38
962
        LD      A,(HL)          ; pick up main key value
963
        SCF                     ; set carry flag
964
        RET                     ; return    (B has other key still)
965
 
966
; ----------------------------------
967
; THE 'KEYBOARD DECODING' SUBROUTINE
968
; ----------------------------------
969
;   also called from s-inkey$
970
 
971
;; K-DECODE
972
L0333:  LD      A,E             ; pick up the stored main key
973
        CP      $3A             ; an arbitrary point between digits and letters
974
        JR      C,L0367         ; forward to K-DIGIT with digits, space, enter.
975
 
976
        DEC     C               ; decrease MODE ( 0='KLC', 1='E', 2='G')
977
 
978
        JP      M,L034F         ; to K-KLC-LET if was zero
979
 
980
        JR      Z,L0341         ; to K-E-LET if was 1 for extended letters.
981
 
982
;   proceed with graphic codes.
983
;   Note. should selectively drop return address if code > 'U' ($55).
984
;   i.e. abort the KEYBOARD call.
985
;   e.g. cp 'V'; jr c,addit; pop af ;pop af ;;addit etc. (6 extra bytes).
986
;   (s-inkey$ never gets into graphics mode.)
987
 
988
;; addit
989
        ADD     A,$4F           ; add offset to augment 'A' to graphics A say.
990
        RET                     ; return.
991
                                ; Note. ( but [GRAPH] V gives RND, etc ).
992
 
993
; ---
994
 
995
;   the jump was to here with extended mode with uppercase A-Z.
996
 
997
;; K-E-LET
998
L0341:  LD      HL,L022C-$41    ; base address of E-UNSHIFT L022c.
999
                                ; ( $01EB in standard ROM ).
1000
        INC     B               ; test B is it empty i.e. not a shift.
1001
        JR      Z,L034A         ; forward to K-LOOK-UP if neither shift.
1002
 
1003
        LD      HL,L0246-$41    ; Address: $0205 L0246-$41 EXT-SHIFT base
1004
 
1005
;; K-LOOK-UP
1006
L034A:  LD      D,$00           ; prepare to index.
1007
        ADD     HL,DE           ; add the main key value.
1008
        LD      A,(HL)          ; pick up other mode value.
1009
        RET                     ; return.
1010
 
1011
; ---
1012
 
1013
;   the jump was here with mode = 0
1014
 
1015
;; K-KLC-LET
1016
L034F:  LD      HL,L026A-$41    ; prepare base of sym-codes
1017
        BIT     0,B             ; shift=$27 sym-shift=$18
1018
        JR      Z,L034A         ; back to K-LOOK-UP with symbol-shift
1019
 
1020
        BIT     3,D             ; test FLAGS is it 'K' mode (from OUT-CURS)
1021
        JR      Z,L0364         ; skip to K-TOKENS if so
1022
 
1023
        BIT     3,(IY+$30)      ; test FLAGS2 - consider CAPS LOCK ?
1024
        RET     NZ              ; return if so with main code.
1025
 
1026
        INC     B               ; is shift being pressed ?
1027
                                ; result zero if not
1028
        RET     NZ              ; return if shift pressed.
1029
 
1030
        ADD     A,$20           ; else convert the code to lower case.
1031
        RET                     ; return.
1032
 
1033
; ---
1034
 
1035
;   the jump was here for tokens
1036
 
1037
;; K-TOKENS
1038
L0364:  ADD     A,$A5           ; add offset to main code so that 'A'
1039
                                ; becomes 'NEW' etc.
1040
 
1041
        RET                     ; return.
1042
 
1043
; ---
1044
 
1045
;   the jump was here with digits, space, enter and symbol shift (< $xx)
1046
 
1047
;; K-DIGIT
1048
L0367:  CP      $30             ; is it '0' or higher ?
1049
        RET     C               ; return with space, enter and symbol-shift
1050
 
1051
        DEC     C               ; test MODE (was 0='KLC', 1='E', 2='G')
1052
        JP      M,L039D         ; jump to K-KLC-DGT if was 0.
1053
 
1054
        JR      NZ,L0389        ; forward to K-GRA-DGT if mode was 2.
1055
 
1056
;   continue with extended digits 0-9.
1057
 
1058
        LD      HL,L0284-$30    ; $0254 - base of E-DIGITS
1059
        BIT     5,B             ; test - shift=$27 sym-shift=$18
1060
        JR      Z,L034A         ; to K-LOOK-UP if sym-shift
1061
 
1062
        CP      $38             ; is character '8' ?
1063
        JR      NC,L0382        ; to K-8-&-9 if greater than '7'
1064
 
1065
        SUB     $20             ; reduce to ink range $10-$17
1066
        INC     B               ; shift ?
1067
        RET     Z               ; return if not.
1068
 
1069
        ADD     A,$08           ; add 8 to give paper range $18 - $1F
1070
        RET                     ; return
1071
 
1072
; ---
1073
 
1074
;   89
1075
 
1076
;; K-8-&-9
1077
L0382:  SUB     $36             ; reduce to 02 and 03  bright codes
1078
        INC     B               ; test if shift pressed.
1079
        RET     Z               ; return if not.
1080
 
1081
        ADD     A,$FE           ; subtract 2 setting carry
1082
        RET                     ; to give 0 and 1    flash codes.
1083
 
1084
; ---
1085
 
1086
;   graphics mode with digits
1087
 
1088
;; K-GRA-DGT
1089
L0389:  LD      HL,L0260-$30    ; $0230 base address of CTL-CODES
1090
 
1091
        CP      $39             ; is key '9' ?
1092
        JR      Z,L034A         ; back to K-LOOK-UP - changed to $0F, GRAPHICS.
1093
 
1094
        CP      $30             ; is key '0' ?
1095
        JR      Z,L034A         ; back to K-LOOK-UP - changed to $0C, delete.
1096
 
1097
;   for keys '0' - '7' we assign a mosaic character depending on shift.
1098
 
1099
        AND     $07             ; convert character to number. 0 - 7.
1100
        ADD     A,$80           ; add offset - they start at $80
1101
 
1102
        INC     B               ; destructively test for shift
1103
        RET     Z               ; and return if not pressed.
1104
 
1105
        XOR     $0F             ; toggle bits becomes range $88-$8F
1106
        RET                     ; return.
1107
 
1108
; ---
1109
 
1110
;   now digits in 'KLC' mode
1111
 
1112
;; K-KLC-DGT
1113
L039D:  INC     B               ; return with digit codes if neither
1114
        RET     Z               ; shift key pressed.
1115
 
1116
        BIT     5,B             ; test for caps shift.
1117
 
1118
        LD      HL,L0260-$30    ; prepare base of table CTL-CODES.
1119
        JR      NZ,L034A        ; back to K-LOOK-UP if shift pressed.
1120
 
1121
;   must have been symbol shift
1122
 
1123
        SUB     $10             ; for ASCII most will now be correct
1124
                                ; on a standard typewriter.
1125
 
1126
        CP      $22             ; but '@' is not - see below.
1127
        JR      Z,L03B2         ; forward to K-@-CHAR if so
1128
 
1129
        CP      $20             ; '_' is the other one that fails
1130
        RET     NZ              ; return if not.
1131
 
1132
        LD      A,$5F           ; substitute ASCII '_'
1133
        RET                     ; return.
1134
 
1135
; ---
1136
 
1137
;; K-@-CHAR
1138
L03B2:  LD      A,$40           ; substitute ASCII '@'
1139
        RET                     ; return.
1140
 
1141
 
1142
; ------------------------------------------------------------------------
1143
;   The Spectrum Input character keys. One or two are abbreviated.
1144
;   From $00 Flash 0 to $FF COPY. The routine above has decoded all these.
1145
 
1146
;  | 00 Fl0| 01 Fl1| 02 Br0| 03 Br1| 04 In0| 05 In1| 06 CAP| 07 EDT|
1147
;  | 08 LFT| 09 RIG| 0A DWN| 0B UP | 0C DEL| 0D ENT| 0E SYM| 0F GRA|
1148
;  | 10 Ik0| 11 Ik1| 12 Ik2| 13 Ik3| 14 Ik4| 15 Ik5| 16 Ik6| 17 Ik7|
1149
;  | 18 Pa0| 19 Pa1| 1A Pa2| 1B Pa3| 1C Pa4| 1D Pa5| 1E Pa6| 1F Pa7|
1150
;  | 20 SP | 21  ! | 22  " | 23  # | 24  $ | 25  % | 26  & | 27  ' |
1151
;  | 28  ( | 29  ) | 2A  * | 2B  + | 2C  , | 2D  - | 2E  . | 2F  / |
1152
;  | 30  0 | 31  1 | 32  2 | 33  3 | 34  4 | 35  5 | 36  6 | 37  7 |
1153
;  | 38  8 | 39  9 | 3A  : | 3B  ; | 3C  < | 3D  = | 3E  > | 3F  ? |
1154
;  | 40  @ | 41  A | 42  B | 43  C | 44  D | 45  E | 46  F | 47  G |
1155
;  | 48  H | 49  I | 4A  J | 4B  K | 4C  L | 4D  M | 4E  N | 4F  O |
1156
;  | 50  P | 51  Q | 52  R | 53  S | 54  T | 55  U | 56  V | 57  W |
1157
;  | 58  X | 59  Y | 5A  Z | 5B  [ | 5C  \ | 5D  ] | 5E  ^ | 5F  _ |
1158
;  | 60  £ | 61  a | 62  b | 63  c | 64  d | 65  e | 66  f | 67  g |
1159
;  | 68  h | 69  i | 6A  j | 6B  k | 6C  l | 6D  m | 6E  n | 6F  o |
1160
;  | 70  p | 71  q | 72  r | 73  s | 74  t | 75  u | 76  v | 77  w |
1161
;  | 78  x | 79  y | 7A  z | 7B  { | 7C  | | 7D  } | 7E  ~ | 7F  © |
1162
;  | 80 128| 81 129| 82 130| 83 131| 84 132| 85 133| 86 134| 87 135|
1163
;  | 88 136| 89 137| 8A 138| 8B 139| 8C 140| 8D 141| 8E 142| 8F 143|
1164
;  | 90 [A]| 91 [B]| 92 [C]| 93 [D]| 94 [E]| 95 [F]| 96 [G]| 97 [H]|
1165
;  | 98 [I]| 99 [J]| 9A [K]| 9B [L]| 9C [M]| 9D [N]| 9E [O]| 9F [P]|
1166
;  | A0 [Q]| A1 [R]| A2 [S]| A3 [T]| A4 [U]| A5 RND| A6 IK$| A7 PI |
1167
;  | A8 FN | A9 PNT| AA SC$| AB ATT| AC AT | AD TAB| AE VL$| AF COD|
1168
;  | B0 VAL| B1 LEN| B2 SIN| B3 COS| B4 TAN| B5 ASN| B6 ACS| B7 ATN|
1169
;  | B8 LN | B9 EXP| BA INT| BB SQR| BC SGN| BD ABS| BE PEK| BF IN |
1170
;  | C0 USR| C1 ST$| C2 CH$| C3 NOT| C4 BIN| C5 OR | C6 AND| C7 <= |
1171
;  | C8 >= | C9 <> | CA LIN| CB THN| CC TO | CD STP| CE DEF| CF CAT|
1172
;  | D0 FMT| D1 MOV| D2 ERS| D3 OPN| D4 CLO| D5 MRG| D6 VFY| D7 BEP|
1173
;  | D8 CIR| D9 INK| DA PAP| DB FLA| DC BRI| DD INV| DE OVR| DF OUT|
1174
;  | E0 LPR| E1 LLI| E2 STP| E3 REA| E4 DAT| E5 RES| E6 NEW| E7 BDR|
1175
;  | E8 CON| E9 DIM| EA REM| EB FOR| EC GTO| ED GSB| EE INP| EF LOA|
1176
;  | F0 LIS| F1 LET| F2 PAU| F3 NXT| F4 POK| F5 PRI| F6 PLO| F7 RUN|
1177
;  | F8 SAV| F9 RAN| FA IF | FB CLS| FC DRW| FD CLR| FE RET| FF CPY|
1178
 
1179
;   Note that for simplicity, Sinclair have located all the control codes
1180
;   below the space character.
1181
;   ASCII DEL, $7F, has been made a copyright symbol.
1182
;   Also $60, '`', not used in BASIC but used in other languages, has been
1183
;   allocated the local currency symbol for the relevant country -
1184
;    £  in most Spectrums.
1185
 
1186
; ------------------------------------------------------------------------
1187
 
1188
 
1189
;**********************************
1190
;** Part 3. LOUDSPEAKER ROUTINES **
1191
;**********************************
1192
 
1193
; Documented by Alvin Albrecht.
1194
 
1195
; ------------------------------
1196
; Routine to control loudspeaker
1197
; ------------------------------
1198
; Outputs a square wave of given duration and frequency
1199
; to the loudspeaker.
1200
;   Enter with: DE = #cycles - 1
1201
;               HL = tone period as described next
1202
;
1203
; The tone period is measured in T states and consists of
1204
; three parts: a coarse part (H register), a medium part
1205
; (bits 7..2 of L) and a fine part (bits 1..0 of L) which
1206
; contribute to the waveform timing as follows:
1207
;
1208
;                          coarse    medium       fine
1209
; duration of low  = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3)
1210
; duration of hi   = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3)
1211
; Tp = tone period = 236 + 2048*H + 32*(L>>2) + 8*(L&0x3)
1212
;                  = 236 + 2048*H + 8*L = 236 + 8*HL
1213
;
1214
; As an example, to output five seconds of middle C (261.624 Hz):
1215
;   (a) Tone period = 1/261.624 = 3.822ms
1216
;   (b) Tone period in T-States = 3.822ms*fCPU = 13378
1217
;         where fCPU = clock frequency of the CPU = 3.5MHz
1218
;    ©  Find H and L for desired tone period:
1219
;         HL = (Tp - 236) / 8 = (13378 - 236) / 8 = 1643 = 0x066B
1220
;   (d) Tone duration in cycles = 5s/3.822ms = 1308 cycles
1221
;         DE = 1308 - 1 = 0x051B
1222
;
1223
; The resulting waveform has a duty ratio of exactly 50%.
1224
;
1225
;
1226
;; BEEPER
1227
L03B5:  DI                      ; Disable Interrupts so they don't disturb timing
1228
        LD      A,L             ;
1229
        SRL     L               ;
1230
        SRL     L               ; L = medium part of tone period
1231
        CPL                     ;
1232
        AND     $03             ; A = 3 - fine part of tone period
1233
        LD      C,A             ;
1234
        LD      B,$00           ;
1235
        LD      IX,L03D1        ; Address: BE-IX+3
1236
        ADD     IX,BC           ;   IX holds address of entry into the loop
1237
                                ;   the loop will contain 0-3 NOPs, implementing
1238
                                ;   the fine part of the tone period.
1239
        LD      A,($5C48)       ; BORDCR
1240
        AND     $38             ; bits 5..3 contain border colour
1241
        RRCA                    ; border colour bits moved to 2..0
1242
        RRCA                    ;   to match border bits on port #FE
1243
        RRCA                    ;
1244
        OR       $08            ; bit 3 set (tape output bit on port #FE)
1245
                                ;   for loud sound output
1246
;; BE-IX+3
1247
L03D1:  NOP              ;(4)   ; optionally executed NOPs for small
1248
                                ;   adjustments to tone period
1249
;; BE-IX+2
1250
L03D2:  NOP              ;(4)   ;
1251
 
1252
;; BE-IX+1
1253
L03D3:  NOP              ;(4)   ;
1254
 
1255
;; BE-IX+0
1256
L03D4:  INC     B        ;(4)   ;
1257
        INC     C        ;(4)   ;
1258
 
1259
;; BE-H&L-LP
1260
L03D6:  DEC     C        ;(4)   ; timing loop for duration of
1261
        JR      NZ,L03D6 ;(12/7);   high or low pulse of waveform
1262
 
1263
        LD      C,$3F    ;(7)   ;
1264
        DEC     B        ;(4)   ;
1265
        JP      NZ,L03D6 ;(10)  ; to BE-H&L-LP
1266
 
1267
        XOR     $10      ;(7)   ; toggle output beep bit
1268
        OUT     ($FE),A  ;(11)  ; output pulse
1269
        LD      B,H      ;(4)   ; B = coarse part of tone period
1270
        LD      C,A      ;(4)   ; save port #FE output byte
1271
        BIT     4,A      ;(8)   ; if new output bit is high, go
1272
        JR      NZ,L03F2 ;(12/7);   to BE-AGAIN
1273
 
1274
        LD      A,D      ;(4)   ; one cycle of waveform has completed
1275
        OR      E        ;(4)   ;   (low->low). if cycle countdown = 0
1276
        JR      Z,L03F6  ;(12/7);   go to BE-END
1277
 
1278
        LD      A,C      ;(4)   ; restore output byte for port #FE
1279
        LD      C,L      ;(4)   ; C = medium part of tone period
1280
        DEC     DE       ;(6)   ; decrement cycle count
1281
        JP      (IX)     ;(8)   ; do another cycle
1282
 
1283
;; BE-AGAIN                     ; halfway through cycle
1284
L03F2:  LD      C,L      ;(4)   ; C = medium part of tone period
1285
        INC     C        ;(4)   ; adds 16 cycles to make duration of high = duration of low
1286
        JP      (IX)     ;(8)   ; do high pulse of tone
1287
 
1288
;; BE-END
1289
L03F6:  EI                      ; Enable Interrupts
1290
        RET                     ;
1291
 
1292
 
1293
; ------------------
1294
; THE 'BEEP' COMMAND
1295
; ------------------
1296
; BASIC interface to BEEPER subroutine.
1297
; Invoked in BASIC with:
1298
;   BEEP dur, pitch
1299
;   where dur   = duration in seconds
1300
;         pitch = # of semitones above/below middle C
1301
;
1302
; Enter with: pitch on top of calculator stack
1303
;             duration next on calculator stack
1304
;
1305
;; beep
1306
L03F8:  RST     28H             ;; FP-CALC
1307
        DEFB    $31             ;;duplicate                  ; duplicate pitch
1308
        DEFB    $27             ;;int                        ; convert to integer
1309
        DEFB    $C0             ;;st-mem-0                   ; store integer pitch to memory 0
1310
        DEFB    $03             ;;subtract                   ; calculate fractional part of pitch = fp_pitch - int_pitch
1311
        DEFB    $34             ;;stk-data                   ; push constant
1312
        DEFB    $EC             ;;Exponent: $7C, Bytes: 4    ; constant = 0.05762265
1313
        DEFB    $6C,$98,$1F,$F5 ;;($6C,$98,$1F,$F5)
1314
        DEFB    $04             ;;multiply                   ; compute:
1315
        DEFB    $A1             ;;stk-one                    ; 1 + 0.05762265 * fraction_part(pitch)
1316
        DEFB    $0F             ;;addition
1317
        DEFB    $38             ;;end-calc                   ; leave on calc stack
1318
 
1319
        LD      HL,$5C92        ; MEM-0: number stored here is in 16 bit integer format (pitch)
1320
                                ;   0, 0/FF (pos/neg), LSB, MSB, 0
1321
                                ;   LSB/MSB is stored in two's complement
1322
                                ; In the following, the pitch is checked if it is in the range -128<=p<=127
1323
        LD      A,(HL)          ; First byte must be zero, otherwise
1324
        AND     A               ;   error in integer conversion
1325
        JR      NZ,L046C        ; to REPORT-B
1326
 
1327
        INC     HL              ;
1328
        LD      C,(HL)          ; C = pos/neg flag = 0/FF
1329
        INC     HL              ;
1330
        LD      B,(HL)          ; B = LSB, two's complement
1331
        LD      A,B             ;
1332
        RLA                     ;
1333
        SBC     A,A             ; A = 0/FF if B is pos/neg
1334
        CP      C               ; must be the same as C if the pitch is -128<=p<=127
1335
        JR      NZ,L046C        ; if no, error REPORT-B
1336
 
1337
        INC     HL              ; if -128<=p<=127, MSB will be 0/FF if B is pos/neg
1338
        CP      (HL)            ; verify this
1339
        JR      NZ,L046C        ; if no, error REPORT-B
1340
                                ; now we know -128<=p<=127
1341
        LD      A,B             ; A = pitch + 60
1342
        ADD     A,$3C           ; if -60<=pitch<=67,
1343
        JP      P,L0425         ;   goto BE-i-OK
1344
 
1345
        JP      PO,L046C        ; if pitch <= 67 goto REPORT-B
1346
                                ;   lower bound of pitch set at -60
1347
 
1348
;; BE-I-OK                      ; here, -60<=pitch<=127
1349
                                ; and A=pitch+60 -> 0<=A<=187
1350
 
1351
L0425:  LD      B,$FA           ; 6 octaves below middle C
1352
 
1353
;; BE-OCTAVE                    ; A=# semitones above 5 octaves below middle C
1354
L0427:  INC     B               ; increment octave
1355
        SUB     $0C             ; 12 semitones = one octave
1356
        JR      NC,L0427        ; to BE-OCTAVE
1357
 
1358
        ADD     A,$0C           ; A = # semitones above C (0-11)
1359
        PUSH    BC              ; B = octave displacement from middle C, 2's complement: -5<=B<=10
1360
        LD      HL,L046E        ; Address: semi-tone
1361
        CALL    L3406           ; routine LOC-MEM
1362
                                ;   HL = 5*A + $046E
1363
        CALL    L33B4           ; routine STACK-NUM
1364
                                ;   read FP value (freq) from semitone table (HL) and push onto calc stack
1365
 
1366
        RST     28H             ;; FP-CALC
1367
        DEFB    $04             ;;multiply   mult freq by 1 + 0.0576 * fraction_part(pitch) stacked earlier
1368
                                ;;             thus taking into account fractional part of pitch.
1369
                                ;;           the number 0.0576*frequency is the distance in Hz to the next
1370
                                ;;             note (verify with the frequencies recorded in the semitone
1371
                                ;;             table below) so that the fraction_part of the pitch does
1372
                                ;;             indeed represent a fractional distance to the next note.
1373
        DEFB    $38             ;;end-calc   HL points to first byte of fp num on stack = middle frequency to generate
1374
 
1375
        POP     AF              ; A = octave displacement from middle C, 2's complement: -5<=A<=10
1376
        ADD     A,(HL)          ; increase exponent by A (equivalent to multiplying by 2^A)
1377
        LD      (HL),A          ;
1378
 
1379
        RST     28H             ;; FP-CALC
1380
        DEFB    $C0             ;;st-mem-0          ; store frequency in memory 0
1381
        DEFB    $02             ;;delete            ; remove from calc stack
1382
        DEFB    $31             ;;duplicate         ; duplicate duration (seconds)
1383
        DEFB    $38             ;;end-calc
1384
 
1385
        CALL    L1E94           ; routine FIND-INT1 ; FP duration to A
1386
        CP      $0B             ; if dur > 10 seconds,
1387
        JR      NC,L046C        ;   goto REPORT-B
1388
 
1389
        ;;; The following calculation finds the tone period for HL and the cycle count
1390
        ;;; for DE expected in the BEEPER subroutine.  From the example in the BEEPER comments,
1391
        ;;;
1392
        ;;; HL = ((fCPU / f) - 236) / 8 = fCPU/8/f - 236/8 = 437500/f -29.5
1393
        ;;; DE = duration * frequency - 1
1394
        ;;;
1395
        ;;; Note the different constant (30.125) used in the calculation of HL
1396
        ;;; below.  This is probably an error.
1397
 
1398
        RST     28H             ;; FP-CALC
1399
        DEFB    $E0             ;;get-mem-0                 ; push frequency
1400
        DEFB    $04             ;;multiply                  ; result1: #cycles = duration * frequency
1401
        DEFB    $E0             ;;get-mem-0                 ; push frequency
1402
        DEFB    $34             ;;stk-data                  ; push constant
1403
        DEFB    $80             ;;Exponent $93, Bytes: 3    ; constant = 437500
1404
        DEFB    $43,$55,$9F,$80 ;;($55,$9F,$80,$00)
1405
        DEFB    $01             ;;exchange                  ; frequency on top
1406
        DEFB    $05             ;;division                  ; 437500 / frequency
1407
        DEFB    $34             ;;stk-data                  ; push constant
1408
        DEFB    $35             ;;Exponent: $85, Bytes: 1   ; constant = 30.125
1409
        DEFB    $71             ;;($71,$00,$00,$00)
1410
        DEFB    $03             ;;subtract                  ; result2: tone_period(HL) = 437500 / freq - 30.125
1411
        DEFB    $38             ;;end-calc
1412
 
1413
        CALL    L1E99           ; routine FIND-INT2
1414
        PUSH    BC              ;   BC = tone_period(HL)
1415
        CALL    L1E99           ; routine FIND-INT2, BC = #cycles to generate
1416
        POP     HL              ; HL = tone period
1417
        LD      D,B             ;
1418
        LD      E,C             ; DE = #cycles
1419
        LD      A,D             ;
1420
        OR      E               ;
1421
        RET     Z               ; if duration = 0, skip BEEP and avoid 65536 cycle
1422
                                ;   boondoggle that would occur next
1423
        DEC     DE              ; DE = #cycles - 1
1424
        JP      L03B5           ; to BEEPER
1425
 
1426
; ---
1427
 
1428
 
1429
;; REPORT-B
1430
L046C:  RST     08H             ; ERROR-1
1431
        DEFB    $0A             ; Error Report: Integer out of range
1432
 
1433
 
1434
 
1435
; ---------------------
1436
; THE 'SEMI-TONE' TABLE
1437
; ---------------------
1438
;
1439
;   Holds frequencies corresponding to semitones in middle octave.
1440
;   To move n octaves higher or lower, frequencies are multiplied by 2^n.
1441
 
1442
;; semi-tone         five byte fp         decimal freq     note (middle)
1443
L046E:  DEFB    $89, $02, $D0, $12, $86;  261.625565290         C
1444
        DEFB    $89, $0A, $97, $60, $75;  277.182631135         C#
1445
        DEFB    $89, $12, $D5, $17, $1F;  293.664768100         D
1446
        DEFB    $89, $1B, $90, $41, $02;  311.126983881         D#
1447
        DEFB    $89, $24, $D0, $53, $CA;  329.627557039         E
1448
        DEFB    $89, $2E, $9D, $36, $B1;  349.228231549         F
1449
        DEFB    $89, $38, $FF, $49, $3E;  369.994422674         F#
1450
        DEFB    $89, $43, $FF, $6A, $73;  391.995436072         G
1451
        DEFB    $89, $4F, $A7, $00, $54;  415.304697513         G#
1452
        DEFB    $89, $5C, $00, $00, $00;  440.000000000         A
1453
        DEFB    $89, $69, $14, $F6, $24;  466.163761616         A#
1454
        DEFB    $89, $76, $F1, $10, $05;  493.883301378         B
1455
 
1456
 
1457
;   "Music is the hidden mathematical endeavour of a soul unconscious it
1458
;    is calculating" - Gottfried Wilhelm Liebnitz 1646 - 1716
1459
 
1460
 
1461
;****************************************
1462
;** Part 4. CASSETTE HANDLING ROUTINES **
1463
;****************************************
1464
 
1465
;   These routines begin with the service routines followed by a single
1466
;   command entry point.
1467
;   The first of these service routines is a curiosity.
1468
 
1469
; -----------------------
1470
; THE 'ZX81 NAME' ROUTINE
1471
; -----------------------
1472
;   This routine fetches a filename in ZX81 format and is not used by the
1473
;   cassette handling routines in this ROM.
1474
 
1475
;; zx81-name
1476
L04AA:  CALL    L24FB           ; routine SCANNING to evaluate expression.
1477
        LD      A,($5C3B)       ; fetch system variable FLAGS.
1478
        ADD     A,A             ; test bit 7 - syntax, bit 6 - result type.
1479
        JP      M,L1C8A         ; to REPORT-C if not string result
1480
                                ; 'Nonsense in BASIC'.
1481
 
1482
        POP     HL              ; drop return address.
1483
        RET     NC              ; return early if checking syntax.
1484
 
1485
        PUSH    HL              ; re-save return address.
1486
        CALL    L2BF1           ; routine STK-FETCH fetches string parameters.
1487
        LD      H,D             ; transfer start of filename
1488
        LD      L,E             ; to the HL register.
1489
        DEC     C               ; adjust to point to last character and
1490
        RET     M               ; return if the null string.
1491
                                ; or multiple of 256!
1492
 
1493
        ADD     HL,BC           ; find last character of the filename.
1494
                                ; and also clear carry.
1495
        SET     7,(HL)          ; invert it.
1496
        RET                     ; return.
1497
 
1498
; =========================================
1499
;
1500
; PORT 254 ($FE)
1501
;
1502
;                      spk mic { border  }
1503
;          ___ ___ ___ ___ ___ ___ ___ ___
1504
; PORT    |   |   |   |   |   |   |   |   |
1505
; 254     |   |   |   |   |   |   |   |   |
1506
; $FE     |___|___|___|___|___|___|___|___|
1507
;           7   6   5   4   3   2   1   0
1508
;
1509
 
1510
; ----------------------------------
1511
; Save header and program/data bytes
1512
; ----------------------------------
1513
;   This routine saves a section of data. It is called from SA-CTRL to save the
1514
;   seventeen bytes of header data. It is also the exit route from that routine
1515
;   when it is set up to save the actual data.
1516
;   On entry -
1517
;   HL points to start of data.
1518
;   IX points to descriptor.
1519
;   The accumulator is set to  $00 for a header, $FF for data.
1520
 
1521
;; SA-BYTES
1522
L04C2:  LD      HL,L053F        ; address: SA/LD-RET
1523
        PUSH    HL              ; is pushed as common exit route.
1524
                                ; however there is only one non-terminal exit
1525
                                ; point.
1526
 
1527
        LD      HL,$1F80        ; a timing constant H=$1F, L=$80
1528
                                ; inner and outer loop counters
1529
                                ; a five second lead-in is used for a header.
1530
 
1531
        BIT     7,A             ; test one bit of accumulator.
1532
                                ; (AND A ?)
1533
        JR      Z,L04D0         ; skip to SA-FLAG if a header is being saved.
1534
 
1535
;   else is data bytes and a shorter lead-in is used.
1536
 
1537
        LD      HL,$0C98        ; another timing value H=$0C, L=$98.
1538
                                ; a two second lead-in is used for the data.
1539
 
1540
 
1541
;; SA-FLAG
1542
L04D0:  EX      AF,AF'          ; save flag
1543
        INC     DE              ; increase length by one.
1544
        DEC     IX              ; decrease start.
1545
 
1546
        DI                      ; disable interrupts
1547
 
1548
        LD      A,$02           ; select red for border, microphone bit on.
1549
        LD      B,A             ; also does as an initial slight counter value.
1550
 
1551
;; SA-LEADER
1552
L04D8:  DJNZ    L04D8           ; self loop to SA-LEADER for delay.
1553
                                ; after initial loop, count is $A4 (or $A3)
1554
 
1555
        OUT     ($FE),A         ; output byte $02/$0D to tape port.
1556
 
1557
        XOR     $0F             ; switch from RED (mic on) to CYAN (mic off).
1558
 
1559
        LD      B,$A4           ; hold count. also timed instruction.
1560
 
1561
        DEC     L               ; originally $80 or $98.
1562
                                ; but subsequently cycles 256 times.
1563
        JR      NZ,L04D8        ; back to SA-LEADER until L is zero.
1564
 
1565
;   the outer loop is counted by H
1566
 
1567
        DEC     B               ; decrement count
1568
        DEC     H               ; originally  twelve or thirty-one.
1569
        JP      P,L04D8         ; back to SA-LEADER until H becomes $FF
1570
 
1571
;   now send a sync pulse. At this stage mic is off and A holds value
1572
;   for mic on.
1573
;   A sync pulse is much shorter than the steady pulses of the lead-in.
1574
 
1575
        LD      B,$2F           ; another short timed delay.
1576
 
1577
;; SA-SYNC-1
1578
L04EA:  DJNZ    L04EA           ; self loop to SA-SYNC-1
1579
 
1580
        OUT     ($FE),A         ; switch to mic on and red.
1581
        LD      A,$0D           ; prepare mic off - cyan
1582
        LD      B,$37           ; another short timed delay.
1583
 
1584
;; SA-SYNC-2
1585
L04F2:  DJNZ    L04F2           ; self loop to SA-SYNC-2
1586
 
1587
        OUT     ($FE),A         ; output mic off, cyan border.
1588
        LD      BC,$3B0E        ; B=$3B time(*), C=$0E, YELLOW, MIC OFF.
1589
 
1590
;
1591
 
1592
        EX      AF,AF'          ; restore saved flag
1593
                                ; which is 1st byte to be saved.
1594
 
1595
        LD      L,A             ; and transfer to L.
1596
                                ; the initial parity is A, $FF or $00.
1597
        JP      L0507           ; JUMP forward to SA-START     ->
1598
                                ; the mid entry point of loop.
1599
 
1600
; -------------------------
1601
;   During the save loop a parity byte is maintained in H.
1602
;   the save loop begins by testing if reduced length is zero and if so
1603
;   the final parity byte is saved reducing count to $FFFF.
1604
 
1605
;; SA-LOOP
1606
L04FE:  LD      A,D             ; fetch high byte
1607
        OR      E               ; test against low byte.
1608
        JR      Z,L050E         ; forward to SA-PARITY if zero.
1609
 
1610
        LD      L,(IX+$00)      ; load currently addressed byte to L.
1611
 
1612
;; SA-LOOP-P
1613
L0505:  LD      A,H             ; fetch parity byte.
1614
        XOR     L               ; exclusive or with new byte.
1615
 
1616
; -> the mid entry point of loop.
1617
 
1618
;; SA-START
1619
L0507:  LD      H,A             ; put parity byte in H.
1620
        LD      A,$01           ; prepare blue, mic=on.
1621
        SCF                     ; set carry flag ready to rotate in.
1622
        JP      L0525           ; JUMP forward to SA-8-BITS            -8->
1623
 
1624
; ---
1625
 
1626
;; SA-PARITY
1627
L050E:  LD      L,H             ; transfer the running parity byte to L and
1628
        JR      L0505           ; back to SA-LOOP-P
1629
                                ; to output that byte before quitting normally.
1630
 
1631
; ---
1632
 
1633
;   The entry point to save yellow part of bit.
1634
;   A bit consists of a period with mic on and blue border followed by
1635
;   a period of mic off with yellow border.
1636
;   Note. since the DJNZ instruction does not affect flags, the zero flag is
1637
;   used to indicate which of the two passes is in effect and the carry
1638
;   maintains the state of the bit to be saved.
1639
 
1640
;; SA-BIT-2
1641
L0511:  LD      A,C             ; fetch 'mic on and yellow' which is
1642
                                ; held permanently in C.
1643
        BIT     7,B             ; set the zero flag. B holds $3E.
1644
 
1645
;   The entry point to save 1 entire bit. For first bit B holds $3B(*).
1646
;   Carry is set if saved bit is 1. zero is reset NZ on entry.
1647
 
1648
;; SA-BIT-1
1649
L0514:  DJNZ    L0514           ; self loop for delay to SA-BIT-1
1650
 
1651
        JR      NC,L051C        ; forward to SA-OUT if bit is 0.
1652
 
1653
;   but if bit is 1 then the mic state is held for longer.
1654
 
1655
        LD      B,$42           ; set timed delay. (66 decimal)
1656
 
1657
;; SA-SET
1658
L051A:  DJNZ    L051A           ; self loop to SA-SET
1659
                                ; (roughly an extra 66*13 clock cycles)
1660
 
1661
;; SA-OUT
1662
L051C:  OUT     ($FE),A         ; blue and mic on OR  yellow and mic off.
1663
 
1664
        LD      B,$3E           ; set up delay
1665
        JR      NZ,L0511        ; back to SA-BIT-2 if zero reset NZ (first pass)
1666
 
1667
;   proceed when the blue and yellow bands have been output.
1668
 
1669
        DEC     B               ; change value $3E to $3D.
1670
        XOR     A               ; clear carry flag (ready to rotate in).
1671
        INC     A               ; reset zero flag i.e. NZ.
1672
 
1673
; -8->
1674
 
1675
;; SA-8-BITS
1676
L0525:  RL      L               ; rotate left through carry
1677
                                ; C<76543210
1678
        JP      NZ,L0514        ; JUMP back to SA-BIT-1
1679
                                ; until all 8 bits done.
1680
 
1681
;   when the initial set carry is passed out again then a byte is complete.
1682
 
1683
        DEC     DE              ; decrease length
1684
        INC     IX              ; increase byte pointer
1685
        LD      B,$31           ; set up timing.
1686
 
1687
        LD      A,$7F           ; test the space key and
1688
        IN      A,($FE)         ; return to common exit (to restore border)
1689
        RRA                     ; if a space is pressed
1690
        RET     NC              ; return to SA/LD-RET.   - - >
1691
 
1692
;   now test if byte counter has reached $FFFF.
1693
 
1694
        LD      A,D             ; fetch high byte
1695
        INC     A               ; increment.
1696
        JP      NZ,L04FE        ; JUMP to SA-LOOP if more bytes.
1697
 
1698
        LD      B,$3B           ; a final delay.
1699
 
1700
;; SA-DELAY
1701
L053C:  DJNZ    L053C           ; self loop to SA-DELAY
1702
 
1703
        RET                     ; return - - >
1704
 
1705
; ------------------------------
1706
; THE 'SAVE/LOAD RETURN' ROUTINE
1707
; ------------------------------
1708
;   The address of this routine is pushed on the stack prior to any load/save
1709
;   operation and it handles normal completion with the restoration of the
1710
;   border and also abnormal termination when the break key, or to be more
1711
;   precise the space key is pressed during a tape operation.
1712
;
1713
; - - >
1714
 
1715
;; SA/LD-RET
1716
L053F:  PUSH    AF              ; preserve accumulator throughout.
1717
        LD      A,($5C48)       ; fetch border colour from BORDCR.
1718
        AND     $38             ; mask off paper bits.
1719
        RRCA                    ; rotate
1720
        RRCA                    ; to the
1721
        RRCA                    ; range 0-7.
1722
 
1723
        OUT     ($FE),A         ; change the border colour.
1724
 
1725
        LD      A,$7F           ; read from port address $7FFE the
1726
        IN      A,($FE)         ; row with the space key at outside.
1727
 
1728
        RRA                     ; test for space key pressed.
1729
        EI                      ; enable interrupts
1730
        JR      C,L0554         ; forward to SA/LD-END if not
1731
 
1732
 
1733
;; REPORT-Da
1734
L0552:  RST     08H             ; ERROR-1
1735
        DEFB    $0C             ; Error Report: BREAK - CONT repeats
1736
 
1737
; ---
1738
 
1739
;; SA/LD-END
1740
L0554:  POP     AF              ; restore the accumulator.
1741
        RET                     ; return.
1742
 
1743
; ------------------------------------
1744
; Load header or block of information
1745
; ------------------------------------
1746
;   This routine is used to load bytes and on entry A is set to $00 for a
1747
;   header or to $FF for data.  IX points to the start of receiving location
1748
;   and DE holds the length of bytes to be loaded. If, on entry the carry flag
1749
;   is set then data is loaded, if reset then it is verified.
1750
 
1751
;; LD-BYTES
1752
L0556:  INC     D               ; reset the zero flag without disturbing carry.
1753
        EX      AF,AF'          ; preserve entry flags.
1754
        DEC     D               ; restore high byte of length.
1755
 
1756
        DI                      ; disable interrupts
1757
 
1758
        LD      A,$0F           ; make the border white and mic off.
1759
        OUT     ($FE),A         ; output to port.
1760
 
1761
        LD      HL,L053F        ; Address: SA/LD-RET
1762
        PUSH    HL              ; is saved on stack as terminating routine.
1763
 
1764
;   the reading of the EAR bit (D6) will always be preceded by a test of the
1765
;   space key (D0), so store the initial post-test state.
1766
 
1767
        IN      A,($FE)         ; read the ear state - bit 6.
1768
        RRA                     ; rotate to bit 5.
1769
        AND     $20             ; isolate this bit.
1770
        OR      $02             ; combine with red border colour.
1771
        LD      C,A             ; and store initial state long-term in C.
1772
        CP      A               ; set the zero flag.
1773
 
1774
;
1775
 
1776
;; LD-BREAK
1777
L056B:  RET     NZ              ; return if at any time space is pressed.
1778
 
1779
;; LD-START
1780
L056C:  CALL    L05E7           ; routine LD-EDGE-1
1781
        JR      NC,L056B        ; back to LD-BREAK with time out and no
1782
                                ; edge present on tape.
1783
 
1784
;   but continue when a transition is found on tape.
1785
 
1786
        LD      HL,$0415        ; set up 16-bit outer loop counter for
1787
                                ; approx 1 second delay.
1788
 
1789
;; LD-WAIT
1790
L0574:  DJNZ    L0574           ; self loop to LD-WAIT (for 256 times)
1791
 
1792
        DEC     HL              ; decrease outer loop counter.
1793
        LD      A,H             ; test for
1794
        OR      L               ; zero.
1795
        JR      NZ,L0574        ; back to LD-WAIT, if not zero, with zero in B.
1796
 
1797
;   continue after delay with H holding zero and B also.
1798
;   sample 256 edges to check that we are in the middle of a lead-in section.
1799
 
1800
        CALL    L05E3           ; routine LD-EDGE-2
1801
        JR      NC,L056B        ; back to LD-BREAK
1802
                                ; if no edges at all.
1803
 
1804
;; LD-LEADER
1805
L0580:  LD      B,$9C           ; set timing value.
1806
        CALL    L05E3           ; routine LD-EDGE-2
1807
        JR      NC,L056B        ; back to LD-BREAK if time-out
1808
 
1809
        LD      A,$C6           ; two edges must be spaced apart.
1810
        CP      B               ; compare
1811
        JR      NC,L056C        ; back to LD-START if too close together for a
1812
                                ; lead-in.
1813
 
1814
        INC     H               ; proceed to test 256 edged sample.
1815
        JR      NZ,L0580        ; back to LD-LEADER while more to do.
1816
 
1817
;   sample indicates we are in the middle of a two or five second lead-in.
1818
;   Now test every edge looking for the terminal sync signal.
1819
 
1820
;; LD-SYNC
1821
L058F:  LD      B,$C9           ; initial timing value in B.
1822
        CALL    L05E7           ; routine LD-EDGE-1
1823
        JR      NC,L056B        ; back to LD-BREAK with time-out.
1824
 
1825
        LD      A,B             ; fetch augmented timing value from B.
1826
        CP      $D4             ; compare
1827
        JR      NC,L058F        ; back to LD-SYNC if gap too big, that is,
1828
                                ; a normal lead-in edge gap.
1829
 
1830
;   but a short gap will be the sync pulse.
1831
;   in which case another edge should appear before B rises to $FF
1832
 
1833
        CALL    L05E7           ; routine LD-EDGE-1
1834
        RET     NC              ; return with time-out.
1835
 
1836
; proceed when the sync at the end of the lead-in is found.
1837
; We are about to load data so change the border colours.
1838
 
1839
        LD      A,C             ; fetch long-term mask from C
1840
        XOR     $03             ; and make blue/yellow.
1841
 
1842
        LD      C,A             ; store the new long-term byte.
1843
 
1844
        LD      H,$00           ; set up parity byte as zero.
1845
        LD      B,$B0           ; timing.
1846
        JR      L05C8           ; forward to LD-MARKER
1847
                                ; the loop mid entry point with the alternate
1848
                                ; zero flag reset to indicate first byte
1849
                                ; is discarded.
1850
 
1851
; --------------
1852
;   the loading loop loads each byte and is entered at the mid point.
1853
 
1854
;; LD-LOOP
1855
L05A9:  EX      AF,AF'          ; restore entry flags and type in A.
1856
        JR      NZ,L05B3        ; forward to LD-FLAG if awaiting initial flag
1857
                                ; which is to be discarded.
1858
 
1859
        JR      NC,L05BD        ; forward to LD-VERIFY if not to be loaded.
1860
 
1861
        LD      (IX+$00),L      ; place loaded byte at memory location.
1862
        JR      L05C2           ; forward to LD-NEXT
1863
 
1864
; ---
1865
 
1866
;; LD-FLAG
1867
L05B3:  RL      C               ; preserve carry (verify) flag in long-term
1868
                                ; state byte. Bit 7 can be lost.
1869
 
1870
        XOR     L               ; compare type in A with first byte in L.
1871
        RET     NZ              ; return if no match e.g. CODE vs. DATA.
1872
 
1873
;   continue when data type matches.
1874
 
1875
        LD      A,C             ; fetch byte with stored carry
1876
        RRA                     ; rotate it to carry flag again
1877
        LD      C,A             ; restore long-term port state.
1878
 
1879
        INC     DE              ; increment length ??
1880
        JR      L05C4           ; forward to LD-DEC.
1881
                                ; but why not to location after ?
1882
 
1883
; ---
1884
;   for verification the byte read from tape is compared with that in memory.
1885
 
1886
;; LD-VERIFY
1887
L05BD:  LD      A,(IX+$00)      ; fetch byte from memory.
1888
        XOR     L               ; compare with that on tape
1889
        RET     NZ              ; return if not zero.
1890
 
1891
;; LD-NEXT
1892
L05C2:  INC     IX              ; increment byte pointer.
1893
 
1894
;; LD-DEC
1895
L05C4:  DEC     DE              ; decrement length.
1896
        EX      AF,AF'          ; store the flags.
1897
        LD      B,$B2           ; timing.
1898
 
1899
;   when starting to read 8 bits the receiving byte is marked with bit at right.
1900
;   when this is rotated out again then 8 bits have been read.
1901
 
1902
;; LD-MARKER
1903
L05C8:  LD      L,$01           ; initialize as %00000001
1904
 
1905
;; LD-8-BITS
1906
L05CA:  CALL    L05E3           ; routine LD-EDGE-2 increments B relative to
1907
                                ; gap between 2 edges.
1908
        RET     NC              ; return with time-out.
1909
 
1910
        LD      A,$CB           ; the comparison byte.
1911
        CP      B               ; compare to incremented value of B.
1912
                                ; if B is higher then bit on tape was set.
1913
                                ; if <= then bit on tape is reset.
1914
 
1915
        RL      L               ; rotate the carry bit into L.
1916
 
1917
        LD      B,$B0           ; reset the B timer byte.
1918
        JP      NC,L05CA        ; JUMP back to LD-8-BITS
1919
 
1920
;   when carry set then marker bit has been passed out and byte is complete.
1921
 
1922
        LD      A,H             ; fetch the running parity byte.
1923
        XOR     L               ; include the new byte.
1924
        LD      H,A             ; and store back in parity register.
1925
 
1926
        LD      A,D             ; check length of
1927
        OR      E               ; expected bytes.
1928
        JR      NZ,L05A9        ; back to LD-LOOP
1929
                                ; while there are more.
1930
 
1931
;   when all bytes loaded then parity byte should be zero.
1932
 
1933
        LD      A,H             ; fetch parity byte.
1934
        CP      $01             ; set carry if zero.
1935
        RET                     ; return
1936
                                ; in no carry then error as checksum disagrees.
1937
 
1938
; -------------------------
1939
; Check signal being loaded
1940
; -------------------------
1941
;   An edge is a transition from one mic state to another.
1942
;   More specifically a change in bit 6 of value input from port $FE.
1943
;   Graphically it is a change of border colour, say, blue to yellow.
1944
;   The first entry point looks for two adjacent edges. The second entry point
1945
;   is used to find a single edge.
1946
;   The B register holds a count, up to 256, within which the edge (or edges)
1947
;   must be found. The gap between two edges will be more for a '1' than a '0'
1948
;   so the value of B denotes the state of the bit (two edges) read from tape.
1949
 
1950
; ->
1951
 
1952
;; LD-EDGE-2
1953
L05E3:  CALL    L05E7           ; call routine LD-EDGE-1 below.
1954
        RET     NC              ; return if space pressed or time-out.
1955
                                ; else continue and look for another adjacent
1956
                                ; edge which together represent a bit on the
1957
                                ; tape.
1958
 
1959
; ->
1960
;   this entry point is used to find a single edge from above but also
1961
;   when detecting a read-in signal on the tape.
1962
 
1963
;; LD-EDGE-1
1964
L05E7:  LD      A,$16           ; a delay value of twenty two.
1965
 
1966
;; LD-DELAY
1967
L05E9:  DEC     A               ; decrement counter
1968
        JR      NZ,L05E9        ; loop back to LD-DELAY 22 times.
1969
 
1970
        AND      A              ; clear carry.
1971
 
1972
;; LD-SAMPLE
1973
L05ED:  INC     B               ; increment the time-out counter.
1974
        RET     Z               ; return with failure when $FF passed.
1975
 
1976
        LD      A,$7F           ; prepare to read keyboard and EAR port
1977
        IN      A,($FE)         ; row $7FFE. bit 6 is EAR, bit 0 is SPACE key.
1978
        RRA                     ; test outer key the space. (bit 6 moves to 5)
1979
        RET     NC              ; return if space pressed.  >>>
1980
 
1981
        XOR     C               ; compare with initial long-term state.
1982
        AND     $20             ; isolate bit 5
1983
        JR      Z,L05ED         ; back to LD-SAMPLE if no edge.
1984
 
1985
;   but an edge, a transition of the EAR bit, has been found so switch the
1986
;   long-term comparison byte containing both border colour and EAR bit.
1987
 
1988
        LD      A,C             ; fetch comparison value.
1989
        CPL                     ; switch the bits
1990
        LD      C,A             ; and put back in C for long-term.
1991
 
1992
        AND     $07             ; isolate new colour bits.
1993
        OR      $08             ; set bit 3 - MIC off.
1994
        OUT     ($FE),A         ; send to port to effect the change of colour.
1995
 
1996
        SCF                     ; set carry flag signaling edge found within
1997
                                ; time allowed.
1998
        RET                     ; return.
1999
 
2000
; ---------------------------------
2001
; Entry point for all tape commands
2002
; ---------------------------------
2003
;   This is the single entry point for the four tape commands.
2004
;   The routine first determines in what context it has been called by examining
2005
;   the low byte of the Syntax table entry which was stored in T_ADDR.
2006
;   Subtracting $EO (the present arrangement) gives a value of
2007
;   $00 - SAVE
2008
;   $01 - LOAD
2009
;   $02 - VERIFY
2010
;   $03 - MERGE
2011
;   As with all commands the address STMT-RET is on the stack.
2012
 
2013
;; SAVE-ETC
2014
L0605:  POP     AF              ; discard address STMT-RET.
2015
        LD      A,($5C74)       ; fetch T_ADDR
2016
 
2017
;   Now reduce the low byte of the Syntax table entry to give command.
2018
;   Note. For ZASM use SUB $E0 as next instruction.
2019
 
2020
L0609:  SUB     L1ADF + 1 % 256 ; subtract the known offset.
2021
                                ; ( is SUB $E0 in standard ROM )
2022
 
2023
        LD      ($5C74),A       ; and put back in T_ADDR as 0,1,2, or 3
2024
                                ; for future reference.
2025
 
2026
        CALL    L1C8C           ; routine EXPT-EXP checks that a string
2027
                                ; expression follows and stacks the
2028
                                ; parameters in run-time.
2029
 
2030
        CALL    L2530           ; routine SYNTAX-Z
2031
        JR      Z,L0652         ; forward to SA-DATA if checking syntax.
2032
 
2033
        LD      BC,$0011        ; presume seventeen bytes for a header.
2034
        LD      A,($5C74)       ; fetch command from T_ADDR.
2035
        AND     A               ; test for zero - SAVE.
2036
        JR      Z,L0621         ; forward to SA-SPACE if so.
2037
 
2038
        LD      C,$22           ; else double length to thirty four.
2039
 
2040
;; SA-SPACE
2041
L0621:  RST     30H             ; BC-SPACES creates 17/34 bytes in workspace.
2042
 
2043
        PUSH    DE              ; transfer the start of new space to
2044
        POP     IX              ; the available index register.
2045
 
2046
;   ten spaces are required for the default filename but it is simpler to
2047
;   overwrite the first file-type indicator byte as well.
2048
 
2049
        LD      B,$0B           ; set counter to eleven.
2050
        LD      A,$20           ; prepare a space.
2051
 
2052
;; SA-BLANK
2053
L0629:  LD      (DE),A          ; set workspace location to space.
2054
        INC     DE              ; next location.
2055
        DJNZ    L0629           ; loop back to SA-BLANK till all eleven done.
2056
 
2057
        LD      (IX+$01),$FF    ; set first byte of ten character filename
2058
                                ; to $FF as a default to signal null string.
2059
 
2060
        CALL    L2BF1           ; routine STK-FETCH fetches the filename
2061
                                ; parameters from the calculator stack.
2062
                                ; length of string in BC.
2063
                                ; start of string in DE.
2064
 
2065
        LD      HL,$FFF6        ; prepare the value minus ten.
2066
        DEC     BC              ; decrement length.
2067
                                ; ten becomes nine, zero becomes $FFFF.
2068
        ADD     HL,BC           ; trial addition.
2069
        INC     BC              ; restore true length.
2070
        JR      NC,L064B        ; forward to SA-NAME if length is one to ten.
2071
 
2072
;   the filename is more than ten characters in length or the null string.
2073
 
2074
        LD      A,($5C74)       ; fetch command from T_ADDR.
2075
        AND     A               ; test for zero - SAVE.
2076
        JR      NZ,L0644        ; forward to SA-NULL if not the SAVE command.
2077
 
2078
;   but no more than ten characters are allowed for SAVE.
2079
;   The first ten characters of any other command parameter are acceptable.
2080
;   Weird, but necessary, if saving to sectors.
2081
;   Note. the golden rule that there are no restriction on anything is broken.
2082
 
2083
;; REPORT-Fa
2084
L0642:  RST     08H             ; ERROR-1
2085
        DEFB    $0E             ; Error Report: Invalid file name
2086
 
2087
;   continue with LOAD, MERGE, VERIFY and also SAVE within ten character limit.
2088
 
2089
;; SA-NULL
2090
L0644:  LD      A,B             ; test length of filename
2091
        OR      C               ; for zero.
2092
        JR      Z,L0652         ; forward to SA-DATA if so using the 255
2093
                                ; indicator followed by spaces.
2094
 
2095
        LD      BC,$000A        ; else trim length to ten.
2096
 
2097
;   other paths rejoin here with BC holding length in range 1 - 10.
2098
 
2099
;; SA-NAME
2100
L064B:  PUSH    IX              ; push start of file descriptor.
2101
        POP     HL              ; and pop into HL.
2102
 
2103
        INC     HL              ; HL now addresses first byte of filename.
2104
        EX      DE,HL           ; transfer destination address to DE, start
2105
                                ; of string in command to HL.
2106
        LDIR                    ; copy up to ten bytes
2107
                                ; if less than ten then trailing spaces follow.
2108
 
2109
;   the case for the null string rejoins here.
2110
 
2111
;; SA-DATA
2112
L0652:  RST     18H             ; GET-CHAR
2113
        CP      $E4             ; is character after filename the token 'DATA' ?
2114
        JR      NZ,L06A0        ; forward to SA-SCR$ to consider SCREEN$ if
2115
                                ; not.
2116
 
2117
;   continue to consider DATA.
2118
 
2119
        LD      A,($5C74)       ; fetch command from T_ADDR
2120
        CP      $03             ; is it 'VERIFY' ?
2121
        JP      Z,L1C8A         ; jump forward to REPORT-C if so.
2122
                                ; 'Nonsense in BASIC'
2123
                                ; VERIFY "d" DATA is not allowed.
2124
 
2125
;   continue with SAVE, LOAD, MERGE of DATA.
2126
 
2127
        RST     20H             ; NEXT-CHAR
2128
        CALL    L28B2           ; routine LOOK-VARS searches variables area
2129
                                ; returning with carry reset if found or
2130
                                ; checking syntax.
2131
        SET     7,C             ; this converts a simple string to a
2132
                                ; string array. The test for an array or string
2133
                                ; comes later.
2134
        JR      NC,L0672        ; forward to SA-V-OLD if variable found.
2135
 
2136
        LD      HL,$0000        ; set destination to zero as not fixed.
2137
        LD      A,($5C74)       ; fetch command from T_ADDR
2138
        DEC     A               ; test for 1 - LOAD
2139
        JR      Z,L0685         ; forward to SA-V-NEW with LOAD DATA.
2140
                                ; to load a new array.
2141
 
2142
;   otherwise the variable was not found in run-time with SAVE/MERGE.
2143
 
2144
;; REPORT-2a
2145
L0670:  RST     08H             ; ERROR-1
2146
        DEFB    $01             ; Error Report: Variable not found
2147
 
2148
;   continue with SAVE/LOAD  DATA
2149
 
2150
;; SA-V-OLD
2151
L0672:  JP      NZ,L1C8A        ; to REPORT-C if not an array variable.
2152
                                ; or erroneously a simple string.
2153
                                ; 'Nonsense in BASIC'
2154
 
2155
 
2156
        CALL    L2530           ; routine SYNTAX-Z
2157
        JR      Z,L0692         ; forward to SA-DATA-1 if checking syntax.
2158
 
2159
        INC     HL              ; step past single character variable name.
2160
        LD      A,(HL)          ; fetch low byte of length.
2161
        LD      (IX+$0B),A      ; place in descriptor.
2162
        INC     HL              ; point to high byte.
2163
        LD      A,(HL)          ; and transfer that
2164
        LD      (IX+$0C),A      ; to descriptor.
2165
        INC     HL              ; increase pointer within variable.
2166
 
2167
;; SA-V-NEW
2168
L0685:  LD      (IX+$0E),C      ; place character array name in  header.
2169
        LD      A,$01           ; default to type numeric.
2170
        BIT     6,C             ; test result from look-vars.
2171
        JR      Z,L068F         ; forward to SA-V-TYPE if numeric.
2172
 
2173
        INC     A               ; set type to 2 - string array.
2174
 
2175
;; SA-V-TYPE
2176
L068F:  LD      (IX+$00),A      ; place type 0, 1 or 2 in descriptor.
2177
 
2178
;; SA-DATA-1
2179
L0692:  EX      DE,HL           ; save var pointer in DE
2180
 
2181
        RST     20H             ; NEXT-CHAR
2182
        CP      $29             ; is character ')' ?
2183
        JR      NZ,L0672        ; back if not to SA-V-OLD to report
2184
                                ; 'Nonsense in BASIC'
2185
 
2186
        RST     20H             ; NEXT-CHAR advances character address.
2187
        CALL    L1BEE           ; routine CHECK-END errors if not end of
2188
                                ; the statement.
2189
 
2190
        EX      DE,HL           ; bring back variables data pointer.
2191
        JP      L075A           ; jump forward to SA-ALL
2192
 
2193
; ---
2194
;   the branch was here to consider a 'SCREEN$', the display file.
2195
 
2196
;; SA-SCR$
2197
L06A0:  CP      $AA             ; is character the token 'SCREEN$' ?
2198
        JR      NZ,L06C3        ; forward to SA-CODE if not.
2199
 
2200
        LD      A,($5C74)       ; fetch command from T_ADDR
2201
        CP      $03             ; is it MERGE ?
2202
        JP       Z,L1C8A        ; jump to REPORT-C if so.
2203
                                ; 'Nonsense in BASIC'
2204
 
2205
;   continue with SAVE/LOAD/VERIFY SCREEN$.
2206
 
2207
        RST     20H             ; NEXT-CHAR
2208
        CALL    L1BEE           ; routine CHECK-END errors if not at end of
2209
                                ; statement.
2210
 
2211
;   continue in runtime.
2212
 
2213
        LD      (IX+$0B),$00    ; set descriptor length
2214
        LD      (IX+$0C),$1B    ; to $1b00 to include bitmaps and attributes.
2215
 
2216
        LD      HL,$4000        ; set start to display file start.
2217
        LD      (IX+$0D),L      ; place start in
2218
        LD      (IX+$0E),H      ; the descriptor.
2219
        JR      L0710           ; forward to SA-TYPE-3
2220
 
2221
; ---
2222
;   the branch was here to consider CODE.
2223
 
2224
;; SA-CODE
2225
L06C3:  CP      $AF             ; is character the token 'CODE' ?
2226
        JR      NZ,L0716        ; forward if not to SA-LINE to consider an
2227
                                ; auto-started BASIC program.
2228
 
2229
        LD      A,($5C74)       ; fetch command from T_ADDR
2230
        CP      $03             ; is it MERGE ?
2231
        JP      Z,L1C8A         ; jump forward to REPORT-C if so.
2232
                                ; 'Nonsense in BASIC'
2233
 
2234
 
2235
        RST     20H             ; NEXT-CHAR advances character address.
2236
        CALL    L2048           ; routine PR-ST-END checks if a carriage
2237
                                ; return or ':' follows.
2238
        JR      NZ,L06E1        ; forward to SA-CODE-1 if there are parameters.
2239
 
2240
        LD      A,($5C74)       ; else fetch the command from T_ADDR.
2241
        AND     A               ; test for zero - SAVE without a specification.
2242
        JP      Z,L1C8A         ; jump to REPORT-C if so.
2243
                                ; 'Nonsense in BASIC'
2244
 
2245
;   for LOAD/VERIFY put zero on stack to signify handle at location saved from.
2246
 
2247
        CALL    L1CE6           ; routine USE-ZERO
2248
        JR      L06F0           ; forward to SA-CODE-2
2249
 
2250
; ---
2251
 
2252
;   if there are more characters after CODE expect start and possibly length.
2253
 
2254
;; SA-CODE-1
2255
L06E1:  CALL    L1C82           ; routine EXPT-1NUM checks for numeric
2256
                                ; expression and stacks it in run-time.
2257
 
2258
        RST     18H             ; GET-CHAR
2259
        CP      $2C             ; does a comma follow ?
2260
        JR      Z,L06F5         ; forward if so to SA-CODE-3
2261
 
2262
;   else allow saved code to be loaded to a specified address.
2263
 
2264
        LD      A,($5C74)       ; fetch command from T_ADDR.
2265
        AND     A               ; is the command SAVE which requires length ?
2266
        JP      Z,L1C8A         ; jump to REPORT-C if so.
2267
                                ; 'Nonsense in BASIC'
2268
 
2269
;   the command LOAD code may rejoin here with zero stacked as start.
2270
 
2271
;; SA-CODE-2
2272
L06F0:  CALL    L1CE6           ; routine USE-ZERO stacks zero for length.
2273
        JR      L06F9           ; forward to SA-CODE-4
2274
 
2275
; ---
2276
;   the branch was here with SAVE CODE start,
2277
 
2278
;; SA-CODE-3
2279
L06F5:  RST     20H             ; NEXT-CHAR advances character address.
2280
        CALL    L1C82           ; routine EXPT-1NUM checks for expression
2281
                                ; and stacks in run-time.
2282
 
2283
;   paths converge here and nothing must follow.
2284
 
2285
;; SA-CODE-4
2286
L06F9:  CALL    L1BEE           ; routine CHECK-END errors with extraneous
2287
                                ; characters and quits if checking syntax.
2288
 
2289
;   in run-time there are two 16-bit parameters on the calculator stack.
2290
 
2291
        CALL    L1E99           ; routine FIND-INT2 gets length.
2292
        LD      (IX+$0B),C      ; place length
2293
        LD      (IX+$0C),B      ; in descriptor.
2294
        CALL    L1E99           ; routine FIND-INT2 gets start.
2295
        LD      (IX+$0D),C      ; place start
2296
        LD      (IX+$0E),B      ; in descriptor.
2297
        LD      H,B             ; transfer the
2298
        LD      L,C             ; start to HL also.
2299
 
2300
;; SA-TYPE-3
2301
L0710:  LD      (IX+$00),$03    ; place type 3 - code in descriptor.
2302
        JR      L075A           ; forward to SA-ALL.
2303
 
2304
; ---
2305
;   the branch was here with BASIC to consider an optional auto-start line
2306
;   number.
2307
 
2308
;; SA-LINE
2309
L0716:  CP      $CA             ; is character the token 'LINE' ?
2310
        JR      Z,L0723         ; forward to SA-LINE-1 if so.
2311
 
2312
;   else all possibilities have been considered and nothing must follow.
2313
 
2314
        CALL    L1BEE           ; routine CHECK-END
2315
 
2316
;   continue in run-time to save BASIC without auto-start.
2317
 
2318
        LD      (IX+$0E),$80    ; place high line number in descriptor to
2319
                                ; disable auto-start.
2320
        JR      L073A           ; forward to SA-TYPE-0 to save program.
2321
 
2322
; ---
2323
;   the branch was here to consider auto-start.
2324
 
2325
;; SA-LINE-1
2326
L0723:  LD      A,($5C74)       ; fetch command from T_ADDR
2327
        AND     A               ; test for SAVE.
2328
        JP      NZ,L1C8A        ; jump forward to REPORT-C with anything else.
2329
                                ; 'Nonsense in BASIC'
2330
 
2331
;
2332
 
2333
        RST     20H             ; NEXT-CHAR
2334
        CALL    L1C82           ; routine EXPT-1NUM checks for numeric
2335
                                ; expression and stacks in run-time.
2336
        CALL    L1BEE           ; routine CHECK-END quits if syntax path.
2337
        CALL    L1E99           ; routine FIND-INT2 fetches the numeric
2338
                                ; expression.
2339
        LD      (IX+$0D),C      ; place the auto-start
2340
        LD      (IX+$0E),B      ; line number in the descriptor.
2341
 
2342
;   Note. this isn't checked, but is subsequently handled by the system.
2343
;   If the user typed 40000 instead of 4000 then it won't auto-start
2344
;   at line 4000, or indeed, at all.
2345
 
2346
;   continue to save program and any variables.
2347
 
2348
;; SA-TYPE-0
2349
L073A:  LD      (IX+$00),$00    ; place type zero - program in descriptor.
2350
        LD      HL,($5C59)      ; fetch E_LINE to HL.
2351
        LD      DE,($5C53)      ; fetch PROG to DE.
2352
        SCF                     ; set carry flag to calculate from end of
2353
                                ; variables E_LINE -1.
2354
        SBC     HL,DE           ; subtract to give total length.
2355
 
2356
        LD      (IX+$0B),L      ; place total length
2357
        LD      (IX+$0C),H      ; in descriptor.
2358
        LD      HL,($5C4B)      ; load HL from system variable VARS
2359
        SBC     HL,DE           ; subtract to give program length.
2360
        LD      (IX+$0F),L      ; place length of program
2361
        LD      (IX+$10),H      ; in the descriptor.
2362
        EX      DE,HL           ; start to HL, length to DE.
2363
 
2364
;; SA-ALL
2365
L075A:  LD      A,($5C74)       ; fetch command from T_ADDR
2366
        AND     A               ; test for zero - SAVE.
2367
        JP      Z,L0970         ; jump forward to SA-CONTRL with SAVE  ->
2368
 
2369
; ---
2370
;   continue with LOAD, MERGE and VERIFY.
2371
 
2372
        PUSH    HL              ; save start.
2373
        LD      BC,$0011        ; prepare to add seventeen
2374
        ADD     IX,BC           ; to point IX at second descriptor.
2375
 
2376
;; LD-LOOK-H
2377
L0767:  PUSH    IX              ; save IX
2378
        LD      DE,$0011        ; seventeen bytes
2379
        XOR     A               ; reset zero flag
2380
        SCF                     ; set carry flag
2381
        CALL    L0556           ; routine LD-BYTES loads a header from tape
2382
                                ; to second descriptor.
2383
        POP     IX              ; restore IX.
2384
        JR      NC,L0767        ; loop back to LD-LOOK-H until header found.
2385
 
2386
        LD      A,$FE           ; select system channel 'S'
2387
        CALL    L1601           ; routine CHAN-OPEN opens it.
2388
 
2389
        LD      (IY+$52),$03    ; set SCR_CT to 3 lines.
2390
 
2391
        LD      C,$80           ; C has bit 7 set to indicate type mismatch as
2392
                                ; a default startpoint.
2393
 
2394
        LD      A,(IX+$00)      ; fetch loaded header type to A
2395
        CP      (IX-$11)        ; compare with expected type.
2396
        JR      NZ,L078A        ; forward to LD-TYPE with mis-match.
2397
 
2398
        LD      C,$F6           ; set C to minus ten - will count characters
2399
                                ; up to zero.
2400
 
2401
;; LD-TYPE
2402
L078A:  CP      $04             ; check if type in acceptable range 0 - 3.
2403
        JR      NC,L0767        ; back to LD-LOOK-H with 4 and over.
2404
 
2405
;   else A indicates type 0-3.
2406
 
2407
        LD      DE,L09C0        ; address base of last 4 tape messages
2408
        PUSH    BC              ; save BC
2409
        CALL    L0C0A           ; routine PO-MSG outputs relevant message.
2410
                                ; Note. all messages have a leading newline.
2411
        POP     BC              ; restore BC
2412
 
2413
        PUSH    IX              ; transfer IX,
2414
        POP     DE              ; the 2nd descriptor, to DE.
2415
        LD      HL,$FFF0        ; prepare minus seventeen.
2416
        ADD     HL,DE           ; add to point HL to 1st descriptor.
2417
        LD      B,$0A           ; the count will be ten characters for the
2418
                                ; filename.
2419
 
2420
        LD      A,(HL)          ; fetch first character and test for
2421
        INC     A               ; value 255.
2422
        JR      NZ,L07A6        ; forward to LD-NAME if not the wildcard.
2423
 
2424
;   but if it is the wildcard, then add ten to C which is minus ten for a type
2425
;   match or -128 for a type mismatch. Although characters have to be counted
2426
;   bit 7 of C will not alter from state set here.
2427
 
2428
        LD      A,C             ; transfer $F6 or $80 to A
2429
        ADD     A,B             ; add $0A
2430
        LD      C,A             ; place result, zero or -118, in C.
2431
 
2432
;   At this point we have either a type mismatch, a wildcard match or ten
2433
;   characters to be counted. The characters must be shown on the screen.
2434
 
2435
;; LD-NAME
2436
L07A6:  INC     DE              ; address next input character
2437
        LD      A,(DE)          ; fetch character
2438
        CP      (HL)            ; compare to expected
2439
        INC     HL              ; address next expected character
2440
        JR      NZ,L07AD        ; forward to LD-CH-PR with mismatch
2441
 
2442
        INC     C               ; increment matched character count
2443
 
2444
;; LD-CH-PR
2445
L07AD:  RST     10H             ; PRINT-A prints character
2446
        DJNZ    L07A6           ; loop back to LD-NAME for ten characters.
2447
 
2448
;   if ten characters matched and the types previously matched then C will
2449
;   now hold zero.
2450
 
2451
        BIT     7,C             ; test if all matched
2452
        JR      NZ,L0767        ; back to LD-LOOK-H if not
2453
 
2454
;   else print a terminal carriage return.
2455
 
2456
        LD      A,$0D           ; prepare carriage return.
2457
        RST     10H             ; PRINT-A outputs it.
2458
 
2459
;   The various control routines for LOAD, VERIFY and MERGE are executed
2460
;   during the one-second gap following the header on tape.
2461
 
2462
        POP     HL              ; restore xx
2463
        LD      A,(IX+$00)      ; fetch incoming type
2464
        CP      $03             ; compare with CODE
2465
        JR      Z,L07CB         ; forward to VR-CONTRL if it is CODE.
2466
 
2467
;  type is a program or an array.
2468
 
2469
        LD      A,($5C74)       ; fetch command from T_ADDR
2470
        DEC     A               ; was it LOAD ?
2471
        JP      Z,L0808         ; JUMP forward to LD-CONTRL if so to
2472
                                ; load BASIC or variables.
2473
 
2474
        CP      $02             ; was command MERGE ?
2475
        JP      Z,L08B6         ; jump forward to ME-CONTRL if so.
2476
 
2477
;   else continue into VERIFY control routine to verify.
2478
 
2479
; ----------------------------
2480
; THE 'VERIFY CONTROL' ROUTINE
2481
; ----------------------------
2482
;   There are two branches to this routine.
2483
;   1) From above to verify a program or array
2484
;   2) from earlier with no carry to load or verify code.
2485
 
2486
;; VR-CONTRL
2487
L07CB:  PUSH    HL              ; save pointer to data.
2488
        LD      L,(IX-$06)      ; fetch length of old data
2489
        LD      H,(IX-$05)      ; to HL.
2490
        LD      E,(IX+$0B)      ; fetch length of new data
2491
        LD      D,(IX+$0C)      ; to DE.
2492
        LD      A,H             ; check length of old
2493
        OR      L               ; for zero.
2494
        JR      Z,L07E9         ; forward to VR-CONT-1 if length unspecified
2495
                                ; e.g. LOAD "x" CODE
2496
 
2497
;   as opposed to, say, LOAD 'x' CODE 32768,300.
2498
 
2499
        SBC     HL,DE           ; subtract the two lengths.
2500
        JR      C,L0806         ; forward to REPORT-R if the length on tape is
2501
                                ; larger than that specified in command.
2502
                                ; 'Tape loading error'
2503
 
2504
        JR      Z,L07E9         ; forward to VR-CONT-1 if lengths match.
2505
 
2506
;   a length on tape shorter than expected is not allowed for CODE
2507
 
2508
        LD      A,(IX+$00)      ; else fetch type from tape.
2509
        CP      $03             ; is it CODE ?
2510
        JR      NZ,L0806        ; forward to REPORT-R if so
2511
                                ; 'Tape loading error'
2512
 
2513
;; VR-CONT-1
2514
L07E9:  POP     HL              ; pop pointer to data
2515
        LD      A,H             ; test for zero
2516
        OR      L               ; e.g. LOAD 'x' CODE
2517
        JR      NZ,L07F4        ; forward to VR-CONT-2 if destination specified.
2518
 
2519
        LD      L,(IX+$0D)      ; else use the destination in the header
2520
        LD      H,(IX+$0E)      ; and load code at address saved from.
2521
 
2522
;; VR-CONT-2
2523
L07F4:  PUSH    HL              ; push pointer to start of data block.
2524
        POP     IX              ; transfer to IX.
2525
        LD      A,($5C74)       ; fetch reduced command from T_ADDR
2526
        CP      $02             ; is it VERIFY ?
2527
        SCF                     ; prepare a set carry flag
2528
        JR      NZ,L0800        ; skip to VR-CONT-3 if not
2529
 
2530
        AND     A               ; clear carry flag for VERIFY so that
2531
                                ; data is not loaded.
2532
 
2533
;; VR-CONT-3
2534
L0800:  LD      A,$FF           ; signal data block to be loaded
2535
 
2536
; -----------------
2537
; Load a data block
2538
; -----------------
2539
;   This routine is called from 3 places other than above to load a data block.
2540
;   In all cases the accumulator is first set to $FF so the routine could be
2541
;   called at the previous instruction.
2542
 
2543
;; LD-BLOCK
2544
L0802:  CALL    L0556           ; routine LD-BYTES
2545
        RET     C               ; return if successful.
2546
 
2547
 
2548
;; REPORT-R
2549
L0806:  RST     08H             ; ERROR-1
2550
        DEFB    $1A             ; Error Report: Tape loading error
2551
 
2552
; --------------------------
2553
; THE 'LOAD CONTROL' ROUTINE
2554
; --------------------------
2555
;   This branch is taken when the command is LOAD with type 0, 1 or 2.
2556
 
2557
;; LD-CONTRL
2558
L0808:  LD      E,(IX+$0B)      ; fetch length of found data block
2559
        LD      D,(IX+$0C)      ; from 2nd descriptor.
2560
        PUSH    HL              ; save destination
2561
        LD      A,H             ; test for zero
2562
        OR      L               ;
2563
        JR      NZ,L0819        ; forward if not to LD-CONT-1
2564
 
2565
        INC     DE              ; increase length
2566
        INC     DE              ; for letter name
2567
        INC     DE              ; and 16-bit length
2568
        EX      DE,HL           ; length to HL,
2569
        JR      L0825           ; forward to LD-CONT-2
2570
 
2571
; ---
2572
 
2573
;; LD-CONT-1
2574
L0819:  LD      L,(IX-$06)      ; fetch length from
2575
        LD      H,(IX-$05)      ; the first header.
2576
        EX      DE,HL           ;
2577
        SCF                     ; set carry flag
2578
        SBC     HL,DE           ;
2579
        JR      C,L082E         ; to LD-DATA
2580
 
2581
;; LD-CONT-2
2582
L0825:  LD      DE,$0005        ; allow overhead of five bytes.
2583
        ADD     HL,DE           ; add in the difference in data lengths.
2584
        LD      B,H             ; transfer to
2585
        LD      C,L             ; the BC register pair
2586
        CALL    L1F05           ; routine TEST-ROOM fails if not enough room.
2587
 
2588
;; LD-DATA
2589
L082E:  POP     HL              ; pop destination
2590
        LD      A,(IX+$00)      ; fetch type 0, 1 or 2.
2591
        AND     A               ; test for program and variables.
2592
        JR      Z,L0873         ; forward if so to LD-PROG
2593
 
2594
;   the type is a numeric or string array.
2595
 
2596
        LD      A,H             ; test the destination for zero
2597
        OR      L               ; indicating variable does not already exist.
2598
        JR      Z,L084C         ; forward if so to LD-DATA-1
2599
 
2600
;   else the destination is the first dimension within the array structure
2601
 
2602
        DEC     HL              ; address high byte of total length
2603
        LD      B,(HL)          ; transfer to B.
2604
        DEC     HL              ; address low byte of total length.
2605
        LD      C,(HL)          ; transfer to C.
2606
        DEC     HL              ; point to letter of variable.
2607
        INC     BC              ; adjust length to
2608
        INC     BC              ; include these
2609
        INC     BC              ; three bytes also.
2610
        LD      ($5C5F),IX      ; save header pointer in X_PTR.
2611
        CALL    L19E8           ; routine RECLAIM-2 reclaims the old variable
2612
                                ; sliding workspace including the two headers
2613
                                ; downwards.
2614
        LD      IX,($5C5F)      ; reload IX from X_PTR which will have been
2615
                                ; adjusted down by POINTERS routine.
2616
 
2617
;; LD-DATA-1
2618
L084C:  LD      HL,($5C59)      ; address E_LINE
2619
        DEC     HL              ; now point to the $80 variables end-marker.
2620
        LD      C,(IX+$0B)      ; fetch new data length
2621
        LD      B,(IX+$0C)      ; from 2nd header.
2622
        PUSH    BC              ; * save it.
2623
        INC     BC              ; adjust the
2624
        INC     BC              ; length to include
2625
        INC     BC              ; letter name and total length.
2626
        LD      A,(IX-$03)      ; fetch letter name from old header.
2627
        PUSH    AF              ; preserve accumulator though not corrupted.
2628
 
2629
        CALL    L1655           ; routine MAKE-ROOM creates space for variable
2630
                                ; sliding workspace up. IX no longer addresses
2631
                                ; anywhere meaningful.
2632
        INC     HL              ; point to first new location.
2633
 
2634
        POP     AF              ; fetch back the letter name.
2635
        LD      (HL),A          ; place in first new location.
2636
        POP     DE              ; * pop the data length.
2637
        INC     HL              ; address 2nd location
2638
        LD      (HL),E          ; store low byte of length.
2639
        INC     HL              ; address next.
2640
        LD      (HL),D          ; store high byte.
2641
        INC     HL              ; address start of data.
2642
        PUSH    HL              ; transfer address
2643
        POP     IX              ; to IX register pair.
2644
        SCF                     ; set carry flag indicating load not verify.
2645
        LD      A,$FF           ; signal data not header.
2646
        JP      L0802           ; JUMP back to LD-BLOCK
2647
 
2648
; -----------------
2649
;   the branch is here when a program as opposed to an array is to be loaded.
2650
 
2651
;; LD-PROG
2652
L0873:  EX      DE,HL           ; transfer dest to DE.
2653
        LD      HL,($5C59)      ; address E_LINE
2654
        DEC     HL              ; now variables end-marker.
2655
        LD      ($5C5F),IX      ; place the IX header pointer in X_PTR
2656
        LD      C,(IX+$0B)      ; get new length
2657
        LD      B,(IX+$0C)      ; from 2nd header
2658
        PUSH    BC              ; and save it.
2659
 
2660
        CALL    L19E5           ; routine RECLAIM-1 reclaims program and vars.
2661
                                ; adjusting X-PTR.
2662
 
2663
        POP     BC              ; restore new length.
2664
        PUSH    HL              ; * save start
2665
        PUSH    BC              ; ** and length.
2666
 
2667
        CALL    L1655           ; routine MAKE-ROOM creates the space.
2668
 
2669
        LD      IX,($5C5F)      ; reload IX from adjusted X_PTR
2670
        INC     HL              ; point to start of new area.
2671
        LD      C,(IX+$0F)      ; fetch length of BASIC on tape
2672
        LD      B,(IX+$10)      ; from 2nd descriptor
2673
        ADD     HL,BC           ; add to address the start of variables.
2674
        LD      ($5C4B),HL      ; set system variable VARS
2675
 
2676
        LD      H,(IX+$0E)      ; fetch high byte of autostart line number.
2677
        LD      A,H             ; transfer to A
2678
        AND     $C0             ; test if greater than $3F.
2679
        JR      NZ,L08AD        ; forward to LD-PROG-1 if so with no autostart.
2680
 
2681
        LD      L,(IX+$0D)      ; else fetch the low byte.
2682
        LD      ($5C42),HL      ; set system variable to line number NEWPPC
2683
        LD      (IY+$0A),$00    ; set statement NSPPC to zero.
2684
 
2685
;; LD-PROG-1
2686
L08AD:  POP     DE              ; ** pop the length
2687
        POP     IX              ; * and start.
2688
        SCF                     ; set carry flag
2689
        LD      A,$FF           ; signal data as opposed to a header.
2690
        JP      L0802           ; jump back to LD-BLOCK
2691
 
2692
; ---------------------------
2693
; THE 'MERGE CONTROL' ROUTINE
2694
; ---------------------------
2695
;   the branch was here to merge a program and its variables or an array.
2696
;
2697
 
2698
;; ME-CONTRL
2699
L08B6:  LD      C,(IX+$0B)      ; fetch length
2700
        LD      B,(IX+$0C)      ; of data block on tape.
2701
        PUSH    BC              ; save it.
2702
        INC     BC              ; one for the pot.
2703
 
2704
        RST     30H             ; BC-SPACES creates room in workspace.
2705
                                ; HL addresses last new location.
2706
        LD      (HL),$80        ; place end-marker at end.
2707
        EX      DE,HL           ; transfer first location to HL.
2708
        POP     DE              ; restore length to DE.
2709
        PUSH    HL              ; save start.
2710
 
2711
        PUSH    HL              ; and transfer it
2712
        POP     IX              ; to IX register.
2713
        SCF                     ; set carry flag to load data on tape.
2714
        LD      A,$FF           ; signal data not a header.
2715
        CALL    L0802           ; routine LD-BLOCK loads to workspace.
2716
        POP     HL              ; restore first location in workspace to HL.
2717
X08CE   LD      DE,($5C53)      ; set DE from system variable PROG.
2718
 
2719
;   now enter a loop to merge the data block in workspace with the program and
2720
;   variables.
2721
 
2722
;; ME-NEW-LP
2723
L08D2:  LD      A,(HL)          ; fetch next byte from workspace.
2724
        AND     $C0             ; compare with $3F.
2725
        JR      NZ,L08F0        ; forward to ME-VAR-LP if a variable or
2726
                                ; end-marker.
2727
 
2728
;   continue when HL addresses a BASIC line number.
2729
 
2730
;; ME-OLD-LP
2731
L08D7:  LD      A,(DE)          ; fetch high byte from program area.
2732
        INC     DE              ; bump prog address.
2733
        CP      (HL)            ; compare with that in workspace.
2734
        INC     HL              ; bump workspace address.
2735
        JR      NZ,L08DF        ; forward to ME-OLD-L1 if high bytes don't match
2736
 
2737
        LD      A,(DE)          ; fetch the low byte of program line number.
2738
        CP      (HL)            ; compare with that in workspace.
2739
 
2740
;; ME-OLD-L1
2741
L08DF:  DEC     DE              ; point to start of
2742
        DEC     HL              ; respective lines again.
2743
        JR      NC,L08EB        ; forward to ME-NEW-L2 if line number in
2744
                                ; workspace is less than or equal to current
2745
                                ; program line as has to be added to program.
2746
 
2747
        PUSH    HL              ; else save workspace pointer.
2748
        EX      DE,HL           ; transfer prog pointer to HL
2749
        CALL    L19B8           ; routine NEXT-ONE finds next line in DE.
2750
        POP     HL              ; restore workspace pointer
2751
        JR      L08D7           ; back to ME-OLD-LP until destination position
2752
                                ; in program area found.
2753
 
2754
; ---
2755
;   the branch was here with an insertion or replacement point.
2756
 
2757
;; ME-NEW-L2
2758
L08EB:  CALL    L092C           ; routine ME-ENTER enters the line
2759
        JR      L08D2           ; loop back to ME-NEW-LP.
2760
 
2761
; ---
2762
;   the branch was here when the location in workspace held a variable.
2763
 
2764
;; ME-VAR-LP
2765
L08F0:  LD      A,(HL)          ; fetch first byte of workspace variable.
2766
        LD      C,A             ; copy to C also.
2767
        CP      $80             ; is it the end-marker ?
2768
        RET     Z               ; return if so as complete.  >>>>>
2769
 
2770
        PUSH    HL              ; save workspace area pointer.
2771
        LD      HL,($5C4B)      ; load HL with VARS - start of variables area.
2772
 
2773
;; ME-OLD-VP
2774
L08F9:  LD      A,(HL)          ; fetch first byte.
2775
        CP      $80             ; is it the end-marker ?
2776
        JR      Z,L0923         ; forward if so to ME-VAR-L2 to add
2777
                                ; variable at end of variables area.
2778
 
2779
        CP      C               ; compare with variable in workspace area.
2780
        JR      Z,L0909         ; forward to ME-OLD-V2 if a match to replace.
2781
 
2782
;   else entire variables area has to be searched.
2783
 
2784
;; ME-OLD-V1
2785
L0901:  PUSH    BC              ; save character in C.
2786
        CALL    L19B8           ; routine NEXT-ONE gets following variable
2787
                                ; address in DE.
2788
        POP     BC              ; restore character in C
2789
        EX      DE,HL           ; transfer next address to HL.
2790
        JR      L08F9           ; loop back to ME-OLD-VP
2791
 
2792
; ---
2793
;   the branch was here when first characters of name matched.
2794
 
2795
;; ME-OLD-V2
2796
L0909:  AND     $E0             ; keep bits 11100000
2797
        CP      $A0             ; compare   10100000 - a long-named variable.
2798
 
2799
        JR      NZ,L0921        ; forward to ME-VAR-L1 if just one-character.
2800
 
2801
;   but long-named variables have to be matched character by character.
2802
 
2803
        POP     DE              ; fetch workspace 1st character pointer
2804
        PUSH    DE              ; and save it on the stack again.
2805
        PUSH    HL              ; save variables area pointer on stack.
2806
 
2807
;; ME-OLD-V3
2808
L0912:  INC     HL              ; address next character in vars area.
2809
        INC     DE              ; address next character in workspace area.
2810
        LD      A,(DE)          ; fetch workspace character.
2811
        CP      (HL)            ; compare to variables character.
2812
        JR      NZ,L091E        ; forward to ME-OLD-V4 with a mismatch.
2813
 
2814
        RLA                     ; test if the terminal inverted character.
2815
        JR      NC,L0912        ; loop back to ME-OLD-V3 if more to test.
2816
 
2817
;   otherwise the long name matches in its entirety.
2818
 
2819
        POP     HL              ; restore pointer to first character of variable
2820
        JR      L0921           ; forward to ME-VAR-L1
2821
 
2822
; ---
2823
;   the branch is here when two characters don't match
2824
 
2825
;; ME-OLD-V4
2826
L091E:  POP     HL              ; restore the prog/vars pointer.
2827
        JR      L0901           ; back to ME-OLD-V1 to resume search.
2828
 
2829
; ---
2830
;   branch here when variable is to replace an existing one
2831
 
2832
;; ME-VAR-L1
2833
L0921:  LD      A,$FF           ; indicate a replacement.
2834
 
2835
;   this entry point is when A holds $80 indicating a new variable.
2836
 
2837
;; ME-VAR-L2
2838
L0923:  POP     DE              ; pop workspace pointer.
2839
        EX      DE,HL           ; now make HL workspace pointer, DE vars pointer
2840
        INC     A               ; zero flag set if replacement.
2841
        SCF                     ; set carry flag indicating a variable not a
2842
                                ; program line.
2843
        CALL    L092C           ; routine ME-ENTER copies variable in.
2844
        JR      L08F0           ; loop back to ME-VAR-LP
2845
 
2846
; ------------------------
2847
; Merge a Line or Variable
2848
; ------------------------
2849
;   A BASIC line or variable is inserted at the current point. If the line
2850
;   number or variable names match (zero flag set) then a replacement takes
2851
;   place.
2852
 
2853
;; ME-ENTER
2854
L092C:  JR      NZ,L093E        ; forward to ME-ENT-1 for insertion only.
2855
 
2856
;   but the program line or variable matches so old one is reclaimed.
2857
 
2858
        EX      AF,AF'          ; save flag??
2859
        LD      ($5C5F),HL      ; preserve workspace pointer in dynamic X_PTR
2860
        EX      DE,HL           ; transfer program dest pointer to HL.
2861
        CALL    L19B8           ; routine NEXT-ONE finds following location
2862
                                ; in program or variables area.
2863
        CALL    L19E8           ; routine RECLAIM-2 reclaims the space between.
2864
        EX      DE,HL           ; transfer program dest pointer back to DE.
2865
        LD      HL,($5C5F)      ; fetch adjusted workspace pointer from X_PTR
2866
        EX      AF,AF'          ; restore flags.
2867
 
2868
;   now the new line or variable is entered.
2869
 
2870
;; ME-ENT-1
2871
L093E:  EX      AF,AF'          ; save or re-save flags.
2872
        PUSH    DE              ; save dest pointer in prog/vars area.
2873
        CALL    L19B8           ; routine NEXT-ONE finds next in workspace.
2874
                                ; gets next in DE, difference in BC.
2875
                                ; prev addr in HL
2876
        LD      ($5C5F),HL      ; store pointer in X_PTR
2877
        LD      HL,($5C53)      ; load HL from system variable PROG
2878
        EX      (SP),HL         ; swap with prog/vars pointer on stack.
2879
        PUSH    BC              ; ** save length of new program line/variable.
2880
        EX      AF,AF'          ; fetch flags back.
2881
        JR      C,L0955         ; skip to ME-ENT-2 if variable
2882
 
2883
        DEC     HL              ; address location before pointer
2884
        CALL    L1655           ; routine MAKE-ROOM creates room for BASIC line
2885
        INC     HL              ; address next.
2886
        JR      L0958           ; forward to ME-ENT-3
2887
 
2888
; ---
2889
 
2890
;; ME-ENT-2
2891
L0955:  CALL    L1655           ; routine MAKE-ROOM creates room for variable.
2892
 
2893
;; ME-ENT-3
2894
L0958:  INC     HL              ; address next?
2895
 
2896
        POP     BC              ; ** pop length
2897
        POP     DE              ; * pop value for PROG which may have been
2898
                                ; altered by POINTERS if first line.
2899
        LD      ($5C53),DE      ; set PROG to original value.
2900
        LD      DE,($5C5F)      ; fetch adjusted workspace pointer from X_PTR
2901
        PUSH    BC              ; save length
2902
        PUSH    DE              ; and workspace pointer
2903
        EX      DE,HL           ; make workspace pointer source, prog/vars
2904
                                ; pointer the destination
2905
        LDIR                    ; copy bytes of line or variable into new area.
2906
        POP     HL              ; restore workspace pointer.
2907
        POP     BC              ; restore length.
2908
        PUSH    DE              ; save new prog/vars pointer.
2909
        CALL    L19E8           ; routine RECLAIM-2 reclaims the space used
2910
                                ; by the line or variable in workspace block
2911
                                ; as no longer required and space could be
2912
                                ; useful for adding more lines.
2913
        POP     DE              ; restore the prog/vars pointer
2914
        RET                     ; return.
2915
 
2916
; --------------------------
2917
; THE 'SAVE CONTROL' ROUTINE
2918
; --------------------------
2919
;   A branch from the main SAVE-ETC routine at SAVE-ALL.
2920
;   First the header data is saved. Then after a wait of 1 second
2921
;   the data itself is saved.
2922
;   HL points to start of data.
2923
;   IX points to start of descriptor.
2924
 
2925
;; SA-CONTRL
2926
L0970:  PUSH    HL              ; save start of data
2927
 
2928
        LD      A,$FD           ; select system channel 'S'
2929
        CALL    L1601           ; routine CHAN-OPEN
2930
 
2931
        XOR     A               ; clear to address table directly
2932
        LD      DE,L09A1        ; address: tape-msgs
2933
        CALL    L0C0A           ; routine PO-MSG -
2934
                                ; 'Start tape then press any key.'
2935
 
2936
        SET     5,(IY+$02)      ; TV_FLAG  - Signal lower screen requires
2937
                                ; clearing
2938
        CALL    L15D4           ; routine WAIT-KEY
2939
 
2940
        PUSH    IX              ; save pointer to descriptor.
2941
        LD      DE,$0011        ; there are seventeen bytes.
2942
        XOR     A               ; signal a header.
2943
        CALL    L04C2           ; routine SA-BYTES
2944
 
2945
        POP     IX              ; restore descriptor pointer.
2946
 
2947
        LD      B,$32           ; wait for a second - 50 interrupts.
2948
 
2949
;; SA-1-SEC
2950
L0991:  HALT                    ; wait for interrupt
2951
        DJNZ    L0991           ; back to SA-1-SEC until pause complete.
2952
 
2953
        LD      E,(IX+$0B)      ; fetch length of bytes from the
2954
        LD      D,(IX+$0C)      ; descriptor.
2955
 
2956
        LD      A,$FF           ; signal data bytes.
2957
 
2958
        POP     IX              ; retrieve pointer to start
2959
        JP      L04C2           ; jump back to SA-BYTES
2960
 
2961
 
2962
;   Arrangement of two headers in workspace.
2963
;   Originally IX addresses first location and only one header is required
2964
;   when saving.
2965
;
2966
;   OLD     NEW         PROG   DATA  DATA  CODE
2967
;   HEADER  HEADER             num   chr          NOTES.
2968
;   ------  ------      ----   ----  ----  ----   -----------------------------
2969
;   IX-$11  IX+$00      0      1     2     3      Type.
2970
;   IX-$10  IX+$01      x      x     x     x      F  ($FF if filename is null).
2971
;   IX-$0F  IX+$02      x      x     x     x      i
2972
;   IX-$0E  IX+$03      x      x     x     x      l
2973
;   IX-$0D  IX+$04      x      x     x     x      e
2974
;   IX-$0C  IX+$05      x      x     x     x      n
2975
;   IX-$0B  IX+$06      x      x     x     x      a
2976
;   IX-$0A  IX+$07      x      x     x     x      m
2977
;   IX-$09  IX+$08      x      x     x     x      e
2978
;   IX-$08  IX+$09      x      x     x     x      .
2979
;   IX-$07  IX+$0A      x      x     x     x      (terminal spaces).
2980
;   IX-$06  IX+$0B      lo     lo    lo    lo     Total
2981
;   IX-$05  IX+$0C      hi     hi    hi    hi     Length of datablock.
2982
;   IX-$04  IX+$0D      Auto   -     -     Start  Various
2983
;   IX-$03  IX+$0E      Start  a-z   a-z   addr   ($80 if no autostart).
2984
;   IX-$02  IX+$0F      lo     -     -     -      Length of Program
2985
;   IX-$01  IX+$10      hi     -     -     -      only i.e. without variables.
2986
;
2987
 
2988
 
2989
; ------------------------
2990
; Canned cassette messages
2991
; ------------------------
2992
;   The last-character-inverted Cassette messages.
2993
;   Starts with normal initial step-over byte.
2994
 
2995
;; tape-msgs
2996
L09A1:  DEFB    $80
2997
        DEFM    "Start tape, then press any key"
2998
L09C0:  DEFB    '.'+$80
2999
        DEFB    $0D
3000
        DEFM    "Program:"
3001
        DEFB    ' '+$80
3002
        DEFB    $0D
3003
        DEFM    "Number array:"
3004
        DEFB    ' '+$80
3005
        DEFB    $0D
3006
        DEFM    "Character array:"
3007
        DEFB    ' '+$80
3008
        DEFB    $0D
3009
        DEFM    "Bytes:"
3010
        DEFB    ' '+$80
3011
 
3012
 
3013
;**************************************************
3014
;** Part 5. SCREEN AND PRINTER HANDLING ROUTINES **
3015
;**************************************************
3016
 
3017
; --------------------------
3018
; THE 'PRINT OUTPUT' ROUTINE
3019
; --------------------------
3020
;   This is the routine most often used by the RST 10 restart although the
3021
;   subroutine is on two occasions called directly when it is known that
3022
;   output will definitely be to the lower screen.
3023
 
3024
;; PRINT-OUT
3025
L09F4:  CALL    L0B03           ; routine PO-FETCH fetches print position
3026
                                ; to HL register pair.
3027
        CP      $20             ; is character a space or higher ?
3028
        JP      NC,L0AD9        ; jump forward to PO-ABLE if so.
3029
 
3030
        CP      $06             ; is character in range 00-05 ?
3031
        JR      C,L0A69         ; to PO-QUEST to print '?' if so.
3032
 
3033
        CP      $18             ; is character in range 24d - 31d ?
3034
        JR      NC,L0A69        ; to PO-QUEST to also print '?' if so.
3035
 
3036
        LD      HL,L0A11 - 6    ; address 0A0B - the base address of control
3037
                                ; character table - where zero would be.
3038
        LD      E,A             ; control character 06 - 23d
3039
        LD      D,$00           ; is transferred to DE.
3040
 
3041
        ADD     HL,DE           ; index into table.
3042
 
3043
        LD      E,(HL)          ; fetch the offset to routine.
3044
        ADD     HL,DE           ; add to make HL the address.
3045
        PUSH    HL              ; push the address.
3046
 
3047
        JP      L0B03           ; Jump forward to PO-FETCH,
3048
                                ; as the screen/printer position has been
3049
                                ; disturbed, and then indirectly to the PO-STORE
3050
                                ; routine on stack.
3051
 
3052
; -----------------------------
3053
; THE 'CONTROL CHARACTER' TABLE
3054
; -----------------------------
3055
;   For control characters in the range 6 - 23d the following table
3056
;   is indexed to provide an offset to the handling routine that
3057
;   follows the table.
3058
 
3059
;; ctlchrtab
3060
L0A11:  DEFB    L0A5F - $       ; 06d offset $4E to Address: PO-COMMA
3061
        DEFB    L0A69 - $       ; 07d offset $57 to Address: PO-QUEST
3062
        DEFB    L0A23 - $       ; 08d offset $10 to Address: PO-BACK-1
3063
        DEFB    L0A3D - $       ; 09d offset $29 to Address: PO-RIGHT
3064
        DEFB    L0A69 - $       ; 10d offset $54 to Address: PO-QUEST
3065
        DEFB    L0A69 - $       ; 11d offset $53 to Address: PO-QUEST
3066
        DEFB    L0A69 - $       ; 12d offset $52 to Address: PO-QUEST
3067
        DEFB    L0A4F - $       ; 13d offset $37 to Address: PO-ENTER
3068
        DEFB    L0A69 - $       ; 14d offset $50 to Address: PO-QUEST
3069
        DEFB    L0A69 - $       ; 15d offset $4F to Address: PO-QUEST
3070
        DEFB    L0A7A - $       ; 16d offset $5F to Address: PO-1-OPER
3071
        DEFB    L0A7A - $       ; 17d offset $5E to Address: PO-1-OPER
3072
        DEFB    L0A7A - $       ; 18d offset $5D to Address: PO-1-OPER
3073
        DEFB    L0A7A - $       ; 19d offset $5C to Address: PO-1-OPER
3074
        DEFB    L0A7A - $       ; 20d offset $5B to Address: PO-1-OPER
3075
        DEFB    L0A7A - $       ; 21d offset $5A to Address: PO-1-OPER
3076
        DEFB    L0A75 - $       ; 22d offset $54 to Address: PO-2-OPER
3077
        DEFB    L0A75 - $       ; 23d offset $53 to Address: PO-2-OPER
3078
 
3079
 
3080
; -------------------------
3081
; THE 'CURSOR LEFT' ROUTINE
3082
; -------------------------
3083
;   Backspace and up a line if that action is from the left of screen.
3084
;   For ZX printer backspace up to first column but not beyond.
3085
 
3086
;; PO-BACK-1
3087
L0A23:  INC     C               ; move left one column.
3088
        LD      A,$22           ; value $21 is leftmost column.
3089
        CP      C               ; have we passed ?
3090
        JR      NZ,L0A3A        ; to PO-BACK-3 if not and store new position.
3091
 
3092
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3093
        JR      NZ,L0A38        ; to PO-BACK-2 if so, as we are unable to
3094
                                ; backspace from the leftmost position.
3095
 
3096
 
3097
        INC     B               ; move up one screen line
3098
        LD      C,$02           ; the rightmost column position.
3099
        LD      A,$18           ; Note. This should be $19
3100
                                ; credit. Dr. Frank O'Hara, 1982
3101
 
3102
        CP      B               ; has position moved past top of screen ?
3103
        JR      NZ,L0A3A        ; to PO-BACK-3 if not and store new position.
3104
 
3105
        DEC     B               ; else back to $18.
3106
 
3107
;; PO-BACK-2
3108
L0A38:  LD      C,$21           ; the leftmost column position.
3109
 
3110
;; PO-BACK-3
3111
L0A3A:  JP      L0DD9           ; to CL-SET and PO-STORE to save new
3112
                                ; position in system variables.
3113
 
3114
; --------------------------
3115
; THE 'CURSOR RIGHT' ROUTINE
3116
; --------------------------
3117
;   This moves the print position to the right leaving a trail in the
3118
;   current background colour.
3119
;   "However the programmer has failed to store the new print position
3120
;   so CHR$ 9 will only work if the next print position is at a newly
3121
;   defined place.
3122
;   e.g. PRINT PAPER 2; CHR$ 9; AT 4,0;
3123
;   does work but is not very helpful"
3124
;   - Dr. Ian Logan, Understanding Your Spectrum, 1982.
3125
 
3126
;; PO-RIGHT
3127
L0A3D:  LD      A,($5C91)       ; fetch P_FLAG value
3128
        PUSH    AF              ; and save it on stack.
3129
 
3130
        LD      (IY+$57),$01    ; temporarily set P_FLAG 'OVER 1'.
3131
        LD      A,$20           ; prepare a space.
3132
        CALL    L0B65           ; routine PO-CHAR to print it.
3133
                                ; Note. could be PO-ABLE which would update
3134
                                ; the column position.
3135
 
3136
        POP     AF              ; restore the permanent flag.
3137
        LD      ($5C91),A       ; and restore system variable P_FLAG
3138
 
3139
        RET                     ; return without updating column position
3140
 
3141
; -----------------------
3142
; Perform carriage return
3143
; -----------------------
3144
; A carriage return is 'printed' to screen or printer buffer.
3145
 
3146
;; PO-ENTER
3147
L0A4F:  BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3148
        JP      NZ,L0ECD        ; to COPY-BUFF if so, to flush buffer and reset
3149
                                ; the print position.
3150
 
3151
        LD      C,$21           ; the leftmost column position.
3152
        CALL    L0C55           ; routine PO-SCR handles any scrolling required.
3153
        DEC     B               ; to next screen line.
3154
        JP      L0DD9           ; jump forward to CL-SET to store new position.
3155
 
3156
; -----------
3157
; Print comma
3158
; -----------
3159
; The comma control character. The 32 column screen has two 16 character
3160
; tabstops.  The routine is only reached via the control character table.
3161
 
3162
;; PO-COMMA
3163
L0A5F:  CALL    L0B03           ; routine PO-FETCH - seems unnecessary.
3164
 
3165
        LD      A,C             ; the column position. $21-$01
3166
        DEC     A               ; move right. $20-$00
3167
        DEC     A               ; and again   $1F-$00 or $FF if trailing
3168
        AND     $10             ; will be $00 or $10.
3169
        JR      L0AC3           ; forward to PO-FILL
3170
 
3171
; -------------------
3172
; Print question mark
3173
; -------------------
3174
; This routine prints a question mark which is commonly
3175
; used to print an unassigned control character in range 0-31d.
3176
; there are a surprising number yet to be assigned.
3177
 
3178
;; PO-QUEST
3179
L0A69:  LD      A,$3F           ; prepare the character '?'.
3180
        JR      L0AD9           ; forward to PO-ABLE.
3181
 
3182
; --------------------------------
3183
; Control characters with operands
3184
; --------------------------------
3185
; Certain control characters are followed by 1 or 2 operands.
3186
; The entry points from control character table are PO-2-OPER and PO-1-OPER.
3187
; The routines alter the output address of the current channel so that
3188
; subsequent RST $10 instructions take the appropriate action
3189
; before finally resetting the output address back to PRINT-OUT.
3190
 
3191
;; PO-TV-2
3192
L0A6D:  LD      DE,L0A87        ; address: PO-CONT will be next output routine
3193
        LD      ($5C0F),A       ; store first operand in TVDATA-hi
3194
        JR      L0A80           ; forward to PO-CHANGE >>
3195
 
3196
; ---
3197
 
3198
; -> This initial entry point deals with two operands - AT or TAB.
3199
 
3200
;; PO-2-OPER
3201
L0A75:  LD      DE,L0A6D        ; address: PO-TV-2 will be next output routine
3202
        JR      L0A7D           ; forward to PO-TV-1
3203
 
3204
; ---
3205
 
3206
; -> This initial entry point deals with one operand INK to OVER.
3207
 
3208
;; PO-1-OPER
3209
L0A7A:  LD      DE,L0A87        ; address: PO-CONT will be next output routine
3210
 
3211
;; PO-TV-1
3212
L0A7D:  LD      ($5C0E),A       ; store control code in TVDATA-lo
3213
 
3214
;; PO-CHANGE
3215
L0A80:  LD      HL,($5C51)      ; use CURCHL to find current output channel.
3216
        LD      (HL),E          ; make it
3217
        INC     HL              ; the supplied
3218
        LD      (HL),D          ; address from DE.
3219
        RET                     ; return.
3220
 
3221
; ---
3222
 
3223
;; PO-CONT
3224
L0A87:  LD      DE,L09F4        ; Address: PRINT-OUT
3225
        CALL    L0A80           ; routine PO-CHANGE to restore normal channel.
3226
        LD      HL,($5C0E)      ; TVDATA gives control code and possible
3227
                                ; subsequent character
3228
        LD      D,A             ; save current character
3229
        LD      A,L             ; the stored control code
3230
        CP      $16             ; was it INK to OVER (1 operand) ?
3231
        JP      C,L2211         ; to CO-TEMP-5
3232
 
3233
        JR      NZ,L0AC2        ; to PO-TAB if not 22d i.e. 23d TAB.
3234
 
3235
                                ; else must have been 22d AT.
3236
        LD      B,H             ; line to H   (0-23d)
3237
        LD      C,D             ; column to C (0-31d)
3238
        LD      A,$1F           ; the value 31d
3239
        SUB     C               ; reverse the column number.
3240
        JR      C,L0AAC         ; to PO-AT-ERR if C was greater than 31d.
3241
 
3242
        ADD     A,$02           ; transform to system range $02-$21
3243
        LD      C,A             ; and place in column register.
3244
 
3245
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3246
        JR      NZ,L0ABF        ; to PO-AT-SET as line can be ignored.
3247
 
3248
        LD      A,$16           ; 22 decimal
3249
        SUB     B               ; subtract line number to reverse
3250
                                ; 0 - 22 becomes 22 - 0.
3251
 
3252
;; PO-AT-ERR
3253
L0AAC:  JP      C,L1E9F         ; to REPORT-B if higher than 22 decimal
3254
                                ; Integer out of range.
3255
 
3256
        INC     A               ; adjust for system range $01-$17
3257
        LD      B,A             ; place in line register
3258
        INC     B               ; adjust to system range  $02-$18
3259
        BIT     0,(IY+$02)      ; TV_FLAG  - Lower screen in use ?
3260
        JP      NZ,L0C55        ; exit to PO-SCR to test for scrolling
3261
 
3262
        CP      (IY+$31)        ; Compare against DF_SZ
3263
        JP      C,L0C86         ; to REPORT-5 if too low
3264
                                ; Out of screen.
3265
 
3266
;; PO-AT-SET
3267
L0ABF:  JP      L0DD9           ; print position is valid so exit via CL-SET
3268
 
3269
; ---
3270
 
3271
; Continue here when dealing with TAB.
3272
; Note. In BASIC, TAB is followed by a 16-bit number and was initially
3273
; designed to work with any output device.
3274
 
3275
;; PO-TAB
3276
L0AC2:  LD      A,H             ; transfer parameter to A
3277
                                ; Losing current character -
3278
                                ; High byte of TAB parameter.
3279
 
3280
 
3281
;; PO-FILL
3282
L0AC3:  CALL    L0B03           ; routine PO-FETCH, HL-addr, BC=line/column.
3283
                                ; column 1 (right), $21 (left)
3284
        ADD     A,C             ; add operand to current column
3285
        DEC     A               ; range 0 - 31+
3286
        AND     $1F             ; make range 0 - 31d
3287
        RET     Z               ; return if result zero
3288
 
3289
        LD      D,A             ; Counter to D
3290
        SET     0,(IY+$01)      ; update FLAGS  - signal suppress leading space.
3291
 
3292
;; PO-SPACE
3293
L0AD0:  LD      A,$20           ; space character.
3294
 
3295
        CALL    L0C3B           ; routine PO-SAVE prints the character
3296
                                ; using alternate set (normal output routine)
3297
 
3298
        DEC     D               ; decrement counter.
3299
        JR      NZ,L0AD0        ; to PO-SPACE until done
3300
 
3301
        RET                     ; return
3302
 
3303
; ----------------------
3304
; Printable character(s)
3305
; ----------------------
3306
; This routine prints printable characters and continues into
3307
; the position store routine
3308
 
3309
;; PO-ABLE
3310
L0AD9:  CALL    L0B24           ; routine PO-ANY
3311
                                ; and continue into position store routine.
3312
 
3313
; ----------------------------
3314
; THE 'POSITION STORE' ROUTINE
3315
; ----------------------------
3316
;   This routine updates the system variables associated with the main screen,
3317
;   the lower screen/input buffer or the ZX printer.
3318
 
3319
;; PO-STORE
3320
L0ADC:  BIT     1,(IY+$01)      ; Test FLAGS - is printer in use ?
3321
        JR      NZ,L0AFC        ; Forward, if so, to PO-ST-PR
3322
 
3323
        BIT     0,(IY+$02)      ; Test TV_FLAG - is lower screen in use ?
3324
        JR      NZ,L0AF0        ; Forward, if so, to PO-ST-E
3325
 
3326
;   This section deals with the upper screen.
3327
 
3328
        LD      ($5C88),BC      ; Update S_POSN - line/column upper screen
3329
        LD      ($5C84),HL      ; Update DF_CC - upper display file address
3330
 
3331
        RET                     ; Return.
3332
 
3333
; ---
3334
 
3335
;   This section deals with the lower screen.
3336
 
3337
;; PO-ST-E
3338
L0AF0:  LD      ($5C8A),BC      ; Update SPOSNL line/column lower screen
3339
        LD      ($5C82),BC      ; Update ECHO_E line/column input buffer
3340
        LD      ($5C86),HL      ; Update DFCCL  lower screen memory address
3341
        RET                     ; Return.
3342
 
3343
; ---
3344
 
3345
;   This section deals with the ZX Printer.
3346
 
3347
;; PO-ST-PR
3348
L0AFC:  LD      (IY+$45),C      ; Update P_POSN column position printer
3349
        LD      ($5C80),HL      ; Update PR_CC - full printer buffer memory
3350
                                ; address
3351
        RET                     ; Return.
3352
 
3353
;   Note. that any values stored in location 23681 will be overwritten with
3354
;   the value 91 decimal.
3355
;   Credit April 1983, Dilwyn Jones. "Delving Deeper into your ZX Spectrum".
3356
 
3357
; ----------------------------
3358
; THE 'POSITION FETCH' ROUTINE
3359
; ----------------------------
3360
;   This routine fetches the line/column and display file address of the upper
3361
;   and lower screen or, if the printer is in use, the column position and
3362
;   absolute memory address.
3363
;   Note. that PR-CC-hi (23681) is used by this routine and if, in accordance
3364
;   with the manual (that says this is unused), the location has been used for
3365
;   other purposes, then subsequent output to the printer buffer could corrupt
3366
;   a 256-byte section of memory.
3367
 
3368
;; PO-FETCH
3369
L0B03:  BIT     1,(IY+$01)      ; Test FLAGS - is printer in use ?
3370
        JR      NZ,L0B1D        ; Forward, if so, to PO-F-PR
3371
 
3372
;   assume upper screen in use and thus optimize for path that requires speed.
3373
 
3374
        LD      BC,($5C88)      ; Fetch line/column from S_POSN
3375
        LD      HL,($5C84)      ; Fetch DF_CC display file address
3376
 
3377
        BIT     0,(IY+$02)      ; Test TV_FLAG - lower screen in use ?
3378
        RET     Z               ; Return if upper screen in use.
3379
 
3380
;   Overwrite registers with values for lower screen.
3381
 
3382
        LD      BC,($5C8A)      ; Fetch line/column from SPOSNL
3383
        LD      HL,($5C86)      ; Fetch display file address from DFCCL
3384
        RET                     ; Return.
3385
 
3386
; ---
3387
 
3388
;   This section deals with the ZX Printer.
3389
 
3390
;; PO-F-PR
3391
L0B1D:  LD      C,(IY+$45)      ; Fetch column from P_POSN.
3392
        LD      HL,($5C80)      ; Fetch printer buffer address from PR_CC.
3393
        RET                     ; Return.
3394
 
3395
; ---------------------------------
3396
; THE 'PRINT ANY CHARACTER' ROUTINE
3397
; ---------------------------------
3398
;   This routine is used to print any character in range 32d - 255d
3399
;   It is only called from PO-ABLE which continues into PO-STORE
3400
 
3401
;; PO-ANY
3402
L0B24:  CP      $80             ; ASCII ?
3403
        JR      C,L0B65         ; to PO-CHAR is so.
3404
 
3405
        CP      $90             ; test if a block graphic character.
3406
        JR      NC,L0B52        ; to PO-T&UDG to print tokens and UDGs
3407
 
3408
; The 16 2*2 mosaic characters 128-143 decimal are formed from
3409
; bits 0-3 of the character.
3410
 
3411
        LD      B,A             ; save character
3412
        CALL    L0B38           ; routine PO-GR-1 to construct top half
3413
                                ; then bottom half.
3414
        CALL    L0B03           ; routine PO-FETCH fetches print position.
3415
        LD      DE,$5C92        ; MEM-0 is location of 8 bytes of character
3416
        JR      L0B7F           ; to PR-ALL to print to screen or printer
3417
 
3418
; ---
3419
 
3420
;; PO-GR-1
3421
L0B38:  LD      HL,$5C92        ; address MEM-0 - a temporary buffer in
3422
                                ; systems variables which is normally used
3423
                                ; by the calculator.
3424
        CALL    L0B3E           ; routine PO-GR-2 to construct top half
3425
                                ; and continue into routine to construct
3426
                                ; bottom half.
3427
 
3428
;; PO-GR-2
3429
L0B3E:  RR      B               ; rotate bit 0/2 to carry
3430
        SBC     A,A             ; result $00 or $FF
3431
        AND     $0F             ; mask off right hand side
3432
        LD      C,A             ; store part in C
3433
        RR      B               ; rotate bit 1/3 of original chr to carry
3434
        SBC     A,A             ; result $00 or $FF
3435
        AND     $F0             ; mask off left hand side
3436
        OR      C               ; combine with stored pattern
3437
        LD      C,$04           ; four bytes for top/bottom half
3438
 
3439
;; PO-GR-3
3440
L0B4C:  LD      (HL),A          ; store bit patterns in temporary buffer
3441
        INC     HL              ; next address
3442
        DEC     C               ; jump back to
3443
        JR      NZ,L0B4C        ; to PO-GR-3 until byte is stored 4 times
3444
 
3445
        RET                     ; return
3446
 
3447
; ---
3448
 
3449
; Tokens and User defined graphics are now separated.
3450
 
3451
;; PO-T&UDG
3452
L0B52:  SUB     $A5             ; the 'RND' character
3453
        JR      NC,L0B5F        ; to PO-T to print tokens
3454
 
3455
        ADD     A,$15           ; add 21d to restore to 0 - 20
3456
        PUSH    BC              ; save current print position
3457
        LD      BC,($5C7B)      ; fetch UDG to address bit patterns
3458
        JR      L0B6A           ; to PO-CHAR-2 - common code to lay down
3459
                                ; a bit patterned character
3460
 
3461
; ---
3462
 
3463
;; PO-T
3464
L0B5F:  CALL    L0C10           ; routine PO-TOKENS prints tokens
3465
        JP      L0B03           ; exit via a JUMP to PO-FETCH as this routine
3466
                                ; must continue into PO-STORE.
3467
                                ; A JR instruction could be used.
3468
 
3469
; This point is used to print ASCII characters  32d - 127d.
3470
 
3471
;; PO-CHAR
3472
L0B65:  PUSH    BC              ; save print position
3473
        LD      BC,($5C36)      ; address CHARS
3474
 
3475
; This common code is used to transfer the character bytes to memory.
3476
 
3477
;; PO-CHAR-2
3478
L0B6A:  EX      DE,HL           ; transfer destination address to DE
3479
        LD      HL,$5C3B        ; point to FLAGS
3480
        RES     0,(HL)          ; allow for leading space
3481
        CP      $20             ; is it a space ?
3482
        JR      NZ,L0B76        ; to PO-CHAR-3 if not
3483
 
3484
        SET     0,(HL)          ; signal no leading space to FLAGS
3485
 
3486
;; PO-CHAR-3
3487
L0B76:  LD      H,$00           ; set high byte to 0
3488
        LD      L,A             ; character to A
3489
                                ; 0-21 UDG or 32-127 ASCII.
3490
        ADD     HL,HL           ; multiply
3491
        ADD     HL,HL           ; by
3492
        ADD     HL,HL           ; eight
3493
        ADD     HL,BC           ; HL now points to first byte of character
3494
        POP     BC              ; the source address CHARS or UDG
3495
        EX      DE,HL           ; character address to DE
3496
 
3497
; ----------------------------------
3498
; THE 'PRINT ALL CHARACTERS' ROUTINE
3499
; ----------------------------------
3500
;   This entry point entered from above to print ASCII and UDGs but also from
3501
;   earlier to print mosaic characters.
3502
;   HL=destination
3503
;   DE=character source
3504
;   BC=line/column
3505
 
3506
;; PR-ALL
3507
L0B7F:  LD      A,C             ; column to A
3508
        DEC     A               ; move right
3509
        LD      A,$21           ; pre-load with leftmost position
3510
        JR      NZ,L0B93        ; but if not zero to PR-ALL-1
3511
 
3512
        DEC     B               ; down one line
3513
        LD      C,A             ; load C with $21
3514
        BIT     1,(IY+$01)      ; test FLAGS  - Is printer in use
3515
        JR      Z,L0B93         ; to PR-ALL-1 if not
3516
 
3517
        PUSH    DE              ; save source address
3518
        CALL    L0ECD           ; routine COPY-BUFF outputs line to printer
3519
        POP     DE              ; restore character source address
3520
        LD      A,C             ; the new column number ($21) to C
3521
 
3522
;; PR-ALL-1
3523
L0B93:  CP      C               ; this test is really for screen - new line ?
3524
        PUSH    DE              ; save source
3525
 
3526
        CALL    Z,L0C55         ; routine PO-SCR considers scrolling
3527
 
3528
        POP     DE              ; restore source
3529
        PUSH    BC              ; save line/column
3530
        PUSH    HL              ; and destination
3531
        LD      A,($5C91)       ; fetch P_FLAG to accumulator
3532
        LD      B,$FF           ; prepare OVER mask in B.
3533
        RRA                     ; bit 0 set if OVER 1
3534
        JR      C,L0BA4         ; to PR-ALL-2
3535
 
3536
        INC     B               ; set OVER mask to 0
3537
 
3538
;; PR-ALL-2
3539
L0BA4:  RRA                     ; skip bit 1 of P_FLAG
3540
        RRA                     ; bit 2 is INVERSE
3541
        SBC     A,A             ; will be FF for INVERSE 1 else zero
3542
        LD      C,A             ; transfer INVERSE mask to C
3543
        LD      A,$08           ; prepare to count 8 bytes
3544
        AND     A               ; clear carry to signal screen
3545
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3546
        JR      Z,L0BB6         ; to PR-ALL-3 if screen
3547
 
3548
        SET     1,(IY+$30)      ; update FLAGS2  - signal printer buffer has
3549
                                ; been used.
3550
        SCF                     ; set carry flag to signal printer.
3551
 
3552
;; PR-ALL-3
3553
L0BB6:  EX      DE,HL           ; now HL=source, DE=destination
3554
 
3555
;; PR-ALL-4
3556
L0BB7:  EX      AF,AF'          ; save printer/screen flag
3557
        LD      A,(DE)          ; fetch existing destination byte
3558
        AND     B               ; consider OVER
3559
        XOR     (HL)            ; now XOR with source
3560
        XOR     C               ; now with INVERSE MASK
3561
        LD      (DE),A          ; update screen/printer
3562
        EX      AF,AF'          ; restore flag
3563
        JR      C,L0BD3         ; to PR-ALL-6 - printer address update
3564
 
3565
        INC     D               ; gives next pixel line down screen
3566
 
3567
;; PR-ALL-5
3568
L0BC1:  INC     HL              ; address next character byte
3569
        DEC     A               ; the byte count is decremented
3570
        JR      NZ,L0BB7        ; back to PR-ALL-4 for all 8 bytes
3571
 
3572
        EX      DE,HL           ; destination to HL
3573
        DEC     H               ; bring back to last updated screen position
3574
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3575
        CALL    Z,L0BDB         ; if not, call routine PO-ATTR to update
3576
                                ; corresponding colour attribute.
3577
        POP     HL              ; restore original screen/printer position
3578
        POP     BC              ; and line column
3579
        DEC     C               ; move column to right
3580
        INC     HL              ; increase screen/printer position
3581
        RET                     ; return and continue into PO-STORE
3582
                                ; within PO-ABLE
3583
 
3584
; ---
3585
 
3586
;   This branch is used to update the printer position by 32 places
3587
;   Note. The high byte of the address D remains constant (which it should).
3588
 
3589
;; PR-ALL-6
3590
L0BD3:  EX      AF,AF'          ; save the flag
3591
        LD      A,$20           ; load A with 32 decimal
3592
        ADD     A,E             ; add this to E
3593
        LD      E,A             ; and store result in E
3594
        EX      AF,AF'          ; fetch the flag
3595
        JR      L0BC1           ; back to PR-ALL-5
3596
 
3597
; -----------------------------------
3598
; THE 'GET ATTRIBUTE ADDRESS' ROUTINE
3599
; -----------------------------------
3600
;   This routine is entered with the HL register holding the last screen
3601
;   address to be updated by PRINT or PLOT.
3602
;   The Spectrum screen arrangement leads to the L register holding the correct
3603
;   value for the attribute file and it is only necessary to manipulate H to
3604
;   form the correct colour attribute address.
3605
 
3606
;; PO-ATTR
3607
L0BDB:  LD       A,H            ; fetch high byte $40 - $57
3608
        RRCA                    ; shift
3609
        RRCA                    ; bits 3 and 4
3610
        RRCA                    ; to right.
3611
        AND     $03             ; range is now 0 - 2
3612
        OR      $58             ; form correct high byte for third of screen
3613
        LD      H,A             ; HL is now correct
3614
        LD      DE,($5C8F)      ; make D hold ATTR_T, E hold MASK-T
3615
        LD      A,(HL)          ; fetch existing attribute
3616
        XOR     E               ; apply masks
3617
        AND     D               ;
3618
        XOR     E               ;
3619
        BIT     6,(IY+$57)      ; test P_FLAG  - is this PAPER 9 ??
3620
        JR      Z,L0BFA         ; skip to PO-ATTR-1 if not.
3621
 
3622
        AND     $C7             ; set paper
3623
        BIT     2,A             ; to contrast with ink
3624
        JR      NZ,L0BFA        ; skip to PO-ATTR-1
3625
 
3626
        XOR     $38             ;
3627
 
3628
;; PO-ATTR-1
3629
L0BFA:  BIT     4,(IY+$57)      ; test P_FLAG  - Is this INK 9 ??
3630
        JR      Z,L0C08         ; skip to PO-ATTR-2 if not
3631
 
3632
        AND     $F8             ; make ink
3633
        BIT     5,A             ; contrast with paper.
3634
        JR      NZ,L0C08        ; to PO-ATTR-2
3635
 
3636
        XOR     $07             ;
3637
 
3638
;; PO-ATTR-2
3639
L0C08:  LD      (HL),A          ; save the new attribute.
3640
        RET                     ; return.
3641
 
3642
; ---------------------------------
3643
; THE 'MESSAGE PRINTING' SUBROUTINE
3644
; ---------------------------------
3645
;   This entry point is used to print tape, boot-up, scroll? and error messages.
3646
;   On entry the DE register points to an initial step-over byte or the
3647
;   inverted end-marker of the previous entry in the table.
3648
;   Register A contains the message number, often zero to print first message.
3649
;   (HL has nothing important usually P_FLAG)
3650
 
3651
;; PO-MSG
3652
L0C0A:  PUSH    HL              ; put hi-byte zero on stack to suppress
3653
        LD      H,$00           ; trailing spaces
3654
        EX      (SP),HL         ; ld h,0; push hl would have done ?.
3655
        JR      L0C14           ; forward to PO-TABLE.
3656
 
3657
; ---
3658
 
3659
;   This entry point prints the BASIC keywords, '<>' etc. from alt set
3660
 
3661
;; PO-TOKENS
3662
L0C10:  LD      DE,L0095        ; address: TKN-TABLE
3663
        PUSH    AF              ; save the token number to control
3664
                                ; trailing spaces - see later *
3665
 
3666
; ->
3667
 
3668
;; PO-TABLE
3669
L0C14:  CALL    L0C41           ; routine PO-SEARCH will set carry for
3670
                                ; all messages and function words.
3671
 
3672
        JR      C,L0C22         ; forward to PO-EACH if not a command, '<>' etc.
3673
 
3674
        LD      A,$20           ; prepare leading space
3675
        BIT     0,(IY+$01)      ; test FLAGS  - leading space if not set
3676
 
3677
        CALL    Z,L0C3B         ; routine PO-SAVE to print a space without
3678
                                ; disturbing registers.
3679
 
3680
;; PO-EACH
3681
L0C22:  LD      A,(DE)          ; Fetch character from the table.
3682
        AND     $7F             ; Cancel any inverted bit.
3683
 
3684
        CALL    L0C3B           ; Routine PO-SAVE to print using the alternate
3685
                                ; set of registers.
3686
 
3687
        LD      A,(DE)          ; Re-fetch character from table.
3688
        INC     DE              ; Address next character in the table.
3689
 
3690
        ADD     A,A             ; Was character inverted ?
3691
                                ; (this also doubles character)
3692
        JR      NC,L0C22        ; back to PO-EACH if not.
3693
 
3694
        POP     DE              ; * re-fetch trailing space byte to D
3695
 
3696
        CP      $48             ; was the last character '$' ?
3697
        JR      Z,L0C35         ; forward to PO-TR-SP to consider trailing
3698
                                ; space if so.
3699
 
3700
        CP      $82             ; was it < 'A' i.e. '#','>','=' from tokens
3701
                                ; or ' ','.' (from tape) or '?' from scroll
3702
 
3703
        RET     C               ; Return if so as no trailing space required.
3704
 
3705
;; PO-TR-SP
3706
L0C35:  LD      A,D             ; The trailing space flag (zero if an error msg)
3707
 
3708
        CP      $03             ; Test against RND, INKEY$ and PI which have no
3709
                                ; parameters and therefore no trailing space.
3710
 
3711
        RET     C               ; Return if no trailing space.
3712
 
3713
        LD      A,$20           ; Prepare the space character and continue to
3714
                                ; print and make an indirect return.
3715
 
3716
; -----------------------------------
3717
; THE 'RECURSIVE PRINTING' SUBROUTINE
3718
; -----------------------------------
3719
;   This routine which is part of PRINT-OUT allows RST $10 to be used
3720
;   recursively to print tokens and the spaces associated with them.
3721
;   It is called on three occasions when the value of DE must be preserved.
3722
 
3723
;; PO-SAVE
3724
L0C3B:  PUSH    DE              ; Save DE value.
3725
        EXX                     ; Switch in main set
3726
 
3727
        RST     10H             ; PRINT-A prints using this alternate set.
3728
 
3729
        EXX                     ; Switch back to this alternate set.
3730
        POP     DE              ; Restore the initial DE value.
3731
 
3732
        RET                     ; Return.
3733
 
3734
; ------------
3735
; Table search
3736
; ------------
3737
; This subroutine searches a message or the token table for the
3738
; message number held in A. DE holds the address of the table.
3739
 
3740
;; PO-SEARCH
3741
L0C41:  PUSH    AF              ; save the message/token number
3742
        EX      DE,HL           ; transfer DE to HL
3743
        INC     A               ; adjust for initial step-over byte
3744
 
3745
;; PO-STEP
3746
L0C44:  BIT     7,(HL)          ; is character inverted ?
3747
        INC     HL              ; address next
3748
        JR      Z,L0C44         ; back to PO-STEP if not inverted.
3749
 
3750
        DEC     A               ; decrease counter
3751
        JR      NZ,L0C44        ; back to PO-STEP if not zero
3752
 
3753
        EX      DE,HL           ; transfer address to DE
3754
        POP     AF              ; restore message/token number
3755
        CP      $20             ; return with carry set
3756
        RET     C               ; for all messages and function tokens
3757
 
3758
        LD      A,(DE)          ; test first character of token
3759
        SUB     $41             ; and return with carry set
3760
        RET                     ; if it is less that 'A'
3761
                                ; i.e. '<>', '<=', '>='
3762
 
3763
; ---------------
3764
; Test for scroll
3765
; ---------------
3766
; This test routine is called when printing carriage return, when considering
3767
; PRINT AT and from the general PRINT ALL characters routine to test if
3768
; scrolling is required, prompting the user if necessary.
3769
; This is therefore using the alternate set.
3770
; The B register holds the current line.
3771
 
3772
;; PO-SCR
3773
L0C55:  BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
3774
        RET     NZ              ; return immediately if so.
3775
 
3776
        LD      DE,L0DD9        ; set DE to address: CL-SET
3777
        PUSH    DE              ; and push for return address.
3778
 
3779
        LD      A,B             ; transfer the line to A.
3780
        BIT     0,(IY+$02)      ; test TV_FLAG - lower screen in use ?
3781
        JP      NZ,L0D02        ; jump forward to PO-SCR-4 if so.
3782
 
3783
        CP      (IY+$31)        ; greater than DF_SZ display file size ?
3784
        JR      C,L0C86         ; forward to REPORT-5 if less.
3785
                                ; 'Out of screen'
3786
 
3787
        RET     NZ              ; return (via CL-SET) if greater
3788
 
3789
        BIT     4,(IY+$02)      ; test TV_FLAG  - Automatic listing ?
3790
        JR      Z,L0C88         ; forward to PO-SCR-2 if not.
3791
 
3792
        LD      E,(IY+$2D)      ; fetch BREG - the count of scroll lines to E.
3793
        DEC     E               ; decrease and jump
3794
        JR      Z,L0CD2         ; to PO-SCR-3 if zero and scrolling required.
3795
 
3796
        LD      A,$00           ; explicit - select channel zero.
3797
        CALL    L1601           ; routine CHAN-OPEN opens it.
3798
 
3799
        LD      SP,($5C3F)      ; set stack pointer to LIST_SP
3800
 
3801
        RES     4,(IY+$02)      ; reset TV_FLAG  - signal auto listing finished.
3802
        RET                     ; return ignoring pushed value, CL-SET
3803
                                ; to MAIN or EDITOR without updating
3804
                                ; print position                         >>
3805
 
3806
; ---
3807
 
3808
 
3809
;; REPORT-5
3810
L0C86:  RST     08H             ; ERROR-1
3811
        DEFB    $04             ; Error Report: Out of screen
3812
 
3813
; continue here if not an automatic listing.
3814
 
3815
;; PO-SCR-2
3816
L0C88:  DEC     (IY+$52)        ; decrease SCR_CT
3817
        JR      NZ,L0CD2        ; forward to PO-SCR-3 to scroll display if
3818
                                ; result not zero.
3819
 
3820
; now produce prompt.
3821
 
3822
        LD      A,$18           ; reset
3823
        SUB     B               ; the
3824
        LD      ($5C8C),A       ; SCR_CT scroll count
3825
        LD      HL,($5C8F)      ; L=ATTR_T, H=MASK_T
3826
        PUSH    HL              ; save on stack
3827
        LD      A,($5C91)       ; P_FLAG
3828
        PUSH    AF              ; save on stack to prevent lower screen
3829
                                ; attributes (BORDCR etc.) being applied.
3830
        LD      A,$FD           ; select system channel 'K'
3831
        CALL    L1601           ; routine CHAN-OPEN opens it
3832
        XOR     A               ; clear to address message directly
3833
        LD      DE,L0CF8        ; make DE address: scrl-mssg
3834
        CALL    L0C0A           ; routine PO-MSG prints to lower screen
3835
        SET     5,(IY+$02)      ; set TV_FLAG  - signal lower screen requires
3836
                                ; clearing
3837
        LD      HL,$5C3B        ; make HL address FLAGS
3838
        SET     3,(HL)          ; signal 'L' mode.
3839
        RES     5,(HL)          ; signal 'no new key'.
3840
        EXX                     ; switch to main set.
3841
                                ; as calling chr input from alternative set.
3842
        CALL    L15D4           ; routine WAIT-KEY waits for new key
3843
                                ; Note. this is the right routine but the
3844
                                ; stream in use is unsatisfactory. From the
3845
                                ; choices available, it is however the best.
3846
 
3847
        EXX                     ; switch back to alternate set.
3848
        CP      $20             ; space is considered as BREAK
3849
        JR      Z,L0D00         ; forward to REPORT-D if so
3850
                                ; 'BREAK - CONT repeats'
3851
 
3852
        CP      $E2             ; is character 'STOP' ?
3853
        JR      Z,L0D00         ; forward to REPORT-D if so
3854
 
3855
        OR      $20             ; convert to lower-case
3856
        CP      $6E             ; is character 'n' ?
3857
        JR      Z,L0D00         ; forward to REPORT-D if so else scroll.
3858
 
3859
        LD      A,$FE           ; select system channel 'S'
3860
        CALL    L1601           ; routine CHAN-OPEN
3861
        POP     AF              ; restore original P_FLAG
3862
        LD      ($5C91),A       ; and save in P_FLAG.
3863
        POP     HL              ; restore original ATTR_T, MASK_T
3864
        LD      ($5C8F),HL      ; and reset ATTR_T, MASK-T as 'scroll?' has
3865
                                ; been printed.
3866
 
3867
;; PO-SCR-3
3868
L0CD2:  CALL    L0DFE           ; routine CL-SC-ALL to scroll whole display
3869
        LD      B,(IY+$31)      ; fetch DF_SZ to B
3870
        INC     B               ; increase to address last line of display
3871
        LD      C,$21           ; set C to $21 (was $21 from above routine)
3872
        PUSH    BC              ; save the line and column in BC.
3873
 
3874
        CALL    L0E9B           ; routine CL-ADDR finds display address.
3875
 
3876
        LD      A,H             ; now find the corresponding attribute byte
3877
        RRCA                    ; (this code sequence is used twice
3878
        RRCA                    ; elsewhere and is a candidate for
3879
        RRCA                    ; a subroutine.)
3880
        AND     $03             ;
3881
        OR      $58             ;
3882
        LD      H,A             ;
3883
 
3884
        LD      DE,$5AE0        ; start of last 'line' of attribute area
3885
        LD      A,(DE)          ; get attribute for last line
3886
        LD      C,(HL)          ; transfer to base line of upper part
3887
        LD      B,$20           ; there are thirty two bytes
3888
        EX      DE,HL           ; swap the pointers.
3889
 
3890
;; PO-SCR-3A
3891
L0CF0:  LD      (DE),A          ; transfer
3892
        LD      (HL),C          ; attributes.
3893
        INC     DE              ; address next.
3894
        INC     HL              ; address next.
3895
        DJNZ    L0CF0           ; loop back to PO-SCR-3A for all adjacent
3896
                                ; attribute lines.
3897
 
3898
        POP     BC              ; restore the line/column.
3899
        RET                     ; return via CL-SET (was pushed on stack).
3900
 
3901
; ---
3902
 
3903
; The message 'scroll?' appears here with last byte inverted.
3904
 
3905
;; scrl-mssg
3906
L0CF8:  DEFB    $80             ; initial step-over byte.
3907
        DEFM    "scroll"
3908
        DEFB    '?'+$80
3909
 
3910
;; REPORT-D
3911
L0D00:  RST     08H             ; ERROR-1
3912
        DEFB    $0C             ; Error Report: BREAK - CONT repeats
3913
 
3914
; continue here if using lower display - A holds line number.
3915
 
3916
;; PO-SCR-4
3917
L0D02:  CP      $02             ; is line number less than 2 ?
3918
        JR      C,L0C86         ; to REPORT-5 if so
3919
                                ; 'Out of Screen'.
3920
 
3921
        ADD     A,(IY+$31)      ; add DF_SZ
3922
        SUB     $19             ;
3923
        RET     NC              ; return if scrolling unnecessary
3924
 
3925
        NEG                     ; Negate to give number of scrolls required.
3926
        PUSH    BC              ; save line/column
3927
        LD      B,A             ; count to B
3928
        LD      HL,($5C8F)      ; fetch current ATTR_T, MASK_T to HL.
3929
        PUSH    HL              ; and save
3930
        LD      HL,($5C91)      ; fetch P_FLAG
3931
        PUSH    HL              ; and save.
3932
                                ; to prevent corruption by input AT
3933
 
3934
        CALL    L0D4D           ; routine TEMPS sets to BORDCR etc
3935
        LD      A,B             ; transfer scroll number to A.
3936
 
3937
;; PO-SCR-4A
3938
L0D1C:  PUSH    AF              ; save scroll number.
3939
        LD      HL,$5C6B        ; address DF_SZ
3940
        LD      B,(HL)          ; fetch old value
3941
        LD      A,B             ; transfer to A
3942
        INC     A               ; and increment
3943
        LD      (HL),A          ; then put back.
3944
        LD      HL,$5C89        ; address S_POSN_hi - line
3945
        CP      (HL)            ; compare
3946
        JR      C,L0D2D         ; forward to PO-SCR-4B if scrolling required
3947
 
3948
        INC     (HL)            ; else increment S_POSN_hi
3949
        LD      B,$18           ; set count to whole display ??
3950
                                ; Note. should be $17 and the top line will be
3951
                                ; scrolled into the ROM which is harmless on
3952
                                ; the standard set up.
3953
                                ; credit P.Giblin 1984.
3954
 
3955
;; PO-SCR-4B
3956
L0D2D:  CALL    L0E00           ; routine CL-SCROLL scrolls B lines
3957
        POP     AF              ; restore scroll counter.
3958
        DEC     A               ; decrease
3959
        JR      NZ,L0D1C        ; back to PO-SCR-4A until done
3960
 
3961
        POP     HL              ; restore original P_FLAG.
3962
        LD      (IY+$57),L      ; and overwrite system variable P_FLAG.
3963
 
3964
        POP     HL              ; restore original ATTR_T/MASK_T.
3965
        LD      ($5C8F),HL      ; and update system variables.
3966
 
3967
        LD      BC,($5C88)      ; fetch S_POSN to BC.
3968
        RES     0,(IY+$02)      ; signal to TV_FLAG  - main screen in use.
3969
        CALL    L0DD9           ; call routine CL-SET for upper display.
3970
 
3971
        SET     0,(IY+$02)      ; signal to TV_FLAG  - lower screen in use.
3972
        POP     BC              ; restore line/column
3973
        RET                     ; return via CL-SET for lower display.
3974
 
3975
; ----------------------
3976
; Temporary colour items
3977
; ----------------------
3978
; This subroutine is called 11 times to copy the permanent colour items
3979
; to the temporary ones.
3980
 
3981
;; TEMPS
3982
L0D4D:  XOR     A               ; clear the accumulator
3983
        LD      HL,($5C8D)      ; fetch L=ATTR_P and H=MASK_P
3984
        BIT     0,(IY+$02)      ; test TV_FLAG  - is lower screen in use ?
3985
        JR      Z,L0D5B         ; skip to TEMPS-1 if not
3986
 
3987
        LD      H,A             ; set H, MASK P, to 00000000.
3988
        LD      L,(IY+$0E)      ; fetch BORDCR to L which is used for lower
3989
                                ; screen.
3990
 
3991
;; TEMPS-1
3992
L0D5B:  LD      ($5C8F),HL      ; transfer values to ATTR_T and MASK_T
3993
 
3994
; for the print flag the permanent values are odd bits, temporary even bits.
3995
 
3996
        LD      HL,$5C91        ; address P_FLAG.
3997
        JR      NZ,L0D65        ; skip to TEMPS-2 if lower screen using A=0.
3998
 
3999
        LD      A,(HL)          ; else pick up flag bits.
4000
        RRCA                    ; rotate permanent bits to temporary bits.
4001
 
4002
;; TEMPS-2
4003
L0D65:  XOR     (HL)            ;
4004
        AND     $55             ; BIN 01010101
4005
        XOR     (HL)            ; permanent now as original
4006
        LD      (HL),A          ; apply permanent bits to temporary bits.
4007
        RET                     ; and return.
4008
 
4009
; -----------------
4010
; THE 'CLS' COMMAND
4011
; -----------------
4012
;    This command clears the display.
4013
;    The routine is also called during initialization and by the CLEAR command.
4014
;    If it's difficult to write it should be difficult to read.
4015
 
4016
;; CLS
4017
L0D6B:  CALL    L0DAF           ; Routine CL-ALL clears the entire display and
4018
                                ; sets the attributes to the permanent ones
4019
                                ; from ATTR-P.
4020
 
4021
;   Having cleared all 24 lines of the display area, continue into the
4022
;   subroutine that clears the lower display area.  Note that at the moment
4023
;   the attributes for the lower lines are the same as upper ones and have
4024
;   to be changed to match the BORDER colour.
4025
 
4026
; --------------------------
4027
; THE 'CLS-LOWER' SUBROUTINE
4028
; --------------------------
4029
;   This routine is called from INPUT, and from the MAIN execution loop.
4030
;   This is very much a housekeeping routine which clears between 2 and 23
4031
;   lines of the display, setting attributes and correcting situations where
4032
;   errors have occurred while the normal input and output routines have been
4033
;   temporarily diverted to deal with, say colour control codes.
4034
 
4035
;; CLS-LOWER
4036
L0D6E:  LD      HL,$5C3C        ; address System Variable TV_FLAG.
4037
        RES     5,(HL)          ; TV_FLAG - signal do not clear lower screen.
4038
        SET     0,(HL)          ; TV_FLAG - signal lower screen in use.
4039
 
4040
        CALL    L0D4D           ; routine TEMPS applies permanent attributes,
4041
                                ; in this case BORDCR to ATTR_T.
4042
                                ; Note. this seems unnecessary and is repeated
4043
                                ; within CL-LINE.
4044
 
4045
        LD      B,(IY+$31)      ; fetch lower screen display file size DF_SZ
4046
 
4047
        CALL    L0E44           ; routine CL-LINE clears lines to bottom of the
4048
                                ; display and sets attributes from BORDCR while
4049
                                ; preserving the B register.
4050
 
4051
        LD      HL,$5AC0        ; set initial attribute address to the leftmost
4052
                                ; cell of second line up.
4053
 
4054
        LD      A,($5C8D)       ; fetch permanent attribute from ATTR_P.
4055
 
4056
        DEC     B               ; decrement lower screen display file size.
4057
 
4058
        JR      L0D8E           ; forward to enter the backfill loop at CLS-3
4059
                                ; where B is decremented again.
4060
 
4061
; ---
4062
 
4063
;   The backfill loop is entered at midpoint and ensures, if more than 2
4064
;   lines have been cleared, that any other lines take the permanent screen
4065
;   attributes.
4066
 
4067
;; CLS-1
4068
L0D87:  LD      C,$20           ; set counter to 32 character cells per line
4069
 
4070
;; CLS-2
4071
L0D89:  DEC     HL              ; decrease attribute address.
4072
        LD      (HL),A          ; and place attributes in next line up.
4073
        DEC     C               ; decrease the 32 counter.
4074
        JR      NZ,L0D89        ; loop back to CLS-2 until all 32 cells done.
4075
 
4076
;; CLS-3
4077
L0D8E:  DJNZ    L0D87           ; decrease B counter and back to CLS-1
4078
                                ; if not zero.
4079
 
4080
        LD      (IY+$31),$02    ; now set DF_SZ lower screen to 2
4081
 
4082
; This entry point is also called from CL-ALL below to
4083
; reset the system channel input and output addresses to normal.
4084
 
4085
;; CL-CHAN
4086
L0D94:  LD      A,$FD           ; select system channel 'K'
4087
 
4088
        CALL    L1601           ; routine CHAN-OPEN opens it.
4089
 
4090
        LD      HL,($5C51)      ; fetch CURCHL to HL to address current channel
4091
        LD      DE,L09F4        ; set address to PRINT-OUT for first pass.
4092
        AND     A               ; clear carry for first pass.
4093
 
4094
;; CL-CHAN-A
4095
L0DA0:  LD      (HL),E          ; Insert the output address on the first pass
4096
        INC     HL              ; or the input address on the second pass.
4097
        LD      (HL),D          ;
4098
        INC     HL              ;
4099
 
4100
        LD      DE,L10A8        ; fetch address KEY-INPUT for second pass
4101
        CCF                     ; complement carry flag - will set on pass 1.
4102
 
4103
        JR      C,L0DA0         ; back to CL-CHAN-A if first pass else done.
4104
 
4105
        LD      BC,$1721        ; line 23 for lower screen
4106
        JR      L0DD9           ; exit via CL-SET to set column
4107
                                ; for lower display
4108
 
4109
; ---------------------------
4110
; Clearing whole display area
4111
; ---------------------------
4112
; This subroutine called from CLS, AUTO-LIST and MAIN-3
4113
; clears 24 lines of the display and resets the relevant system variables.
4114
; This routine also recovers from an error situation where, for instance, an
4115
; invalid colour or position control code has left the output routine addressing
4116
; PO-TV-2 or PO-CONT.
4117
 
4118
;; CL-ALL
4119
L0DAF:  LD      HL,$0000        ; Initialize plot coordinates.
4120
        LD      ($5C7D),HL      ; Set system variable COORDS to 0,0.
4121
 
4122
        RES     0,(IY+$30)      ; update FLAGS2  - signal main screen is clear.
4123
 
4124
        CALL    L0D94           ; routine CL-CHAN makes channel 'K' 'normal'.
4125
 
4126
        LD      A,$FE           ; select system channel 'S'
4127
        CALL    L1601           ; routine CHAN-OPEN opens it.
4128
 
4129
        CALL    L0D4D           ; routine TEMPS applies permanent attributes,
4130
                                ; in this case ATTR_P, to ATTR_T.
4131
                                ; Note. this seems unnecessary.
4132
 
4133
        LD      B,$18           ; There are 24 lines.
4134
 
4135
        CALL    L0E44           ; routine CL-LINE clears 24 text lines and sets
4136
                                ; attributes from ATTR-P.
4137
                                ; This routine preserves B and sets C to $21.
4138
 
4139
        LD      HL,($5C51)      ; fetch CURCHL make HL address output routine.
4140
 
4141
        LD      DE,L09F4        ; address: PRINT-OUT
4142
        LD      (HL),E          ; is made
4143
        INC     HL              ; the normal
4144
        LD      (HL),D          ; output address.
4145
 
4146
        LD      (IY+$52),$01    ; set SCR_CT - scroll count - to default.
4147
 
4148
;   Note. BC already contains $1821.
4149
 
4150
        LD      BC,$1821        ; reset column and line to 0,0
4151
                                ; and continue into CL-SET, below, exiting
4152
                                ; via PO-STORE (for the upper screen).
4153
 
4154
; --------------------
4155
; THE 'CL-SET' ROUTINE
4156
; --------------------
4157
; This important subroutine is used to calculate the character output
4158
; address for screens or printer based on the line/column for screens
4159
; or the column for printer.
4160
 
4161
;; CL-SET
4162
L0DD9:  LD      HL,$5B00        ; the base address of printer buffer
4163
        BIT     1,(IY+$01)      ; test FLAGS  - is printer in use ?
4164
        JR      NZ,L0DF4        ; forward to CL-SET-2 if so.
4165
 
4166
        LD      A,B             ; transfer line to A.
4167
        BIT     0,(IY+$02)      ; test TV_FLAG  - lower screen in use ?
4168
        JR      Z,L0DEE         ; skip to CL-SET-1 if handling upper part
4169
 
4170
        ADD     A,(IY+$31)      ; add DF_SZ for lower screen
4171
        SUB     $18             ; and adjust.
4172
 
4173
;; CL-SET-1
4174
L0DEE:  PUSH    BC              ; save the line/column.
4175
        LD      B,A             ; transfer line to B
4176
                                ; (adjusted if lower screen)
4177
 
4178
        CALL    L0E9B           ; routine CL-ADDR calculates address at left
4179
                                ; of screen.
4180
        POP     BC              ; restore the line/column.
4181
 
4182
;; CL-SET-2
4183
L0DF4:  LD      A,$21           ; the column $01-$21 is reversed
4184
        SUB     C               ; to range $00 - $20
4185
        LD      E,A             ; now transfer to DE
4186
        LD      D,$00           ; prepare for addition
4187
        ADD     HL,DE           ; and add to base address
4188
 
4189
        JP      L0ADC           ; exit via PO-STORE to update the relevant
4190
                                ; system variables.
4191
; ----------------
4192
; Handle scrolling
4193
; ----------------
4194
; The routine CL-SC-ALL is called once from PO to scroll all the display
4195
; and from the routine CL-SCROLL, once, to scroll part of the display.
4196
 
4197
;; CL-SC-ALL
4198
L0DFE:  LD      B,$17           ; scroll 23 lines, after 'scroll?'.
4199
 
4200
;; CL-SCROLL
4201
L0E00:  CALL    L0E9B           ; routine CL-ADDR gets screen address in HL.
4202
        LD      C,$08           ; there are 8 pixel lines to scroll.
4203
 
4204
;; CL-SCR-1
4205
L0E05:  PUSH    BC              ; save counters.
4206
        PUSH    HL              ; and initial address.
4207
        LD      A,B             ; get line count.
4208
        AND     $07             ; will set zero if all third to be scrolled.
4209
        LD      A,B             ; re-fetch the line count.
4210
        JR      NZ,L0E19        ; forward to CL-SCR-3 if partial scroll.
4211
 
4212
; HL points to top line of third and must be copied to bottom of previous 3rd.
4213
; ( so HL = $4800 or $5000 ) ( but also sometimes $4000 )
4214
 
4215
;; CL-SCR-2
4216
L0E0D:  EX      DE,HL           ; copy HL to DE.
4217
        LD      HL,$F8E0        ; subtract $08 from H and add $E0 to L -
4218
        ADD     HL,DE           ; to make destination bottom line of previous
4219
                                ; third.
4220
        EX      DE,HL           ; restore the source and destination.
4221
        LD      BC,$0020        ; thirty-two bytes are to be copied.
4222
        DEC     A               ; decrement the line count.
4223
        LDIR                    ; copy a pixel line to previous third.
4224
 
4225
;; CL-SCR-3
4226
L0E19:  EX      DE,HL           ; save source in DE.
4227
        LD      HL,$FFE0        ; load the value -32.
4228
        ADD     HL,DE           ; add to form destination in HL.
4229
        EX      DE,HL           ; switch source and destination
4230
        LD      B,A             ; save the count in B.
4231
        AND     $07             ; mask to find count applicable to current
4232
        RRCA                    ; third and
4233
        RRCA                    ; multiply by
4234
        RRCA                    ; thirty two (same as 5 RLCAs)
4235
 
4236
        LD      C,A             ; transfer byte count to C ($E0 at most)
4237
        LD      A,B             ; store line count to A
4238
        LD      B,$00           ; make B zero
4239
        LDIR                    ; copy bytes (BC=0, H incremented, L=0)
4240
        LD      B,$07           ; set B to 7, C is zero.
4241
        ADD     HL,BC           ; add 7 to H to address next third.
4242
        AND     $F8             ; has last third been done ?
4243
        JR      NZ,L0E0D        ; back to CL-SCR-2 if not.
4244
 
4245
        POP     HL              ; restore topmost address.
4246
        INC     H               ; next pixel line down.
4247
        POP     BC              ; restore counts.
4248
        DEC     C               ; reduce pixel line count.
4249
        JR      NZ,L0E05        ; back to CL-SCR-1 if all eight not done.
4250
 
4251
        CALL    L0E88           ; routine CL-ATTR gets address in attributes
4252
                                ; from current 'ninth line', count in BC.
4253
 
4254
        LD      HL,$FFE0        ; set HL to the 16-bit value -32.
4255
        ADD     HL,DE           ; and add to form destination address.
4256
        EX      DE,HL           ; swap source and destination addresses.
4257
        LDIR                    ; copy bytes scrolling the linear attributes.
4258
        LD      B,$01           ; continue to clear the bottom line.
4259
 
4260
; ------------------------------
4261
; THE 'CLEAR TEXT LINES' ROUTINE
4262
; ------------------------------
4263
; This subroutine, called from CL-ALL, CLS-LOWER and AUTO-LIST and above,
4264
; clears text lines at bottom of display.
4265
; The B register holds on entry the number of lines to be cleared 1-24.
4266
 
4267
;; CL-LINE
4268
L0E44:  PUSH    BC              ; save line count
4269
        CALL    L0E9B           ; routine CL-ADDR gets top address
4270
        LD      C,$08           ; there are eight screen lines to a text line.
4271
 
4272
;; CL-LINE-1
4273
L0E4A:  PUSH    BC              ; save pixel line count
4274
        PUSH    HL              ; and save the address
4275
        LD      A,B             ; transfer the line to A (1-24).
4276
 
4277
;; CL-LINE-2
4278
L0E4D:  AND     $07             ; mask 0-7 to consider thirds at a time
4279
        RRCA                    ; multiply
4280
        RRCA                    ; by 32  (same as five RLCA instructions)
4281
        RRCA                    ; now 32 - 256(0)
4282
        LD      C,A             ; store result in C
4283
        LD      A,B             ; save line in A (1-24)
4284
        LD      B,$00           ; set high byte to 0, prepare for ldir.
4285
        DEC     C               ; decrement count 31-255.
4286
        LD      D,H             ; copy HL
4287
        LD      E,L             ; to DE.
4288
        LD      (HL),$00        ; blank the first byte.
4289
        INC     DE              ; make DE point to next byte.
4290
        LDIR                    ; ldir will clear lines.
4291
        LD      DE,$0701        ; now address next third adjusting
4292
        ADD     HL,DE           ; register E to address left hand side
4293
        DEC     A               ; decrease the line count.
4294
        AND     $F8             ; will be 16, 8 or 0  (AND $18 will do).
4295
        LD      B,A             ; transfer count to B.
4296
        JR      NZ,L0E4D        ; back to CL-LINE-2 if 16 or 8 to do
4297
                                ; the next third.
4298
 
4299
        POP     HL              ; restore start address.
4300
        INC     H               ; address next line down.
4301
        POP     BC              ; fetch counts.
4302
        DEC     C               ; decrement pixel line count
4303
        JR      NZ,L0E4A        ; back to CL-LINE-1 till all done.
4304
 
4305
        CALL    L0E88           ; routine CL-ATTR gets attribute address
4306
                                ; in DE and B * 32 in BC.
4307
 
4308
        LD      H,D             ; transfer the address
4309
        LD      L,E             ; to HL.
4310
 
4311
        INC     DE              ; make DE point to next location.
4312
 
4313
        LD      A,($5C8D)       ; fetch ATTR_P - permanent attributes
4314
        BIT     0,(IY+$02)      ; test TV_FLAG  - lower screen in use ?
4315
        JR      Z,L0E80         ; skip to CL-LINE-3 if not.
4316
 
4317
        LD      A,($5C48)       ; else lower screen uses BORDCR as attribute.
4318
 
4319
;; CL-LINE-3
4320
L0E80:  LD      (HL),A          ; put attribute in first byte.
4321
        DEC     BC              ; decrement the counter.
4322
        LDIR                    ; copy bytes to set all attributes.
4323
        POP     BC              ; restore the line $01-$24.
4324
        LD      C,$21           ; make column $21. (No use is made of this)
4325
        RET                     ; return to the calling routine.
4326
 
4327
; ------------------
4328
; Attribute handling
4329
; ------------------
4330
; This subroutine is called from CL-LINE or CL-SCROLL with the HL register
4331
; pointing to the 'ninth' line and H needs to be decremented before or after
4332
; the division. Had it been done first then either present code or that used
4333
; at the start of PO-ATTR could have been used.
4334
; The Spectrum screen arrangement leads to the L register already holding
4335
; the correct value for the attribute file and it is only necessary
4336
; to manipulate H to form the correct colour attribute address.
4337
 
4338
;; CL-ATTR
4339
L0E88:  LD      A,H             ; fetch H to A - $48, $50, or $58.
4340
        RRCA                    ; divide by
4341
        RRCA                    ; eight.
4342
        RRCA                    ; $09, $0A or $0B.
4343
        DEC     A               ; $08, $09 or $0A.
4344
        OR      $50             ; $58, $59 or $5A.
4345
        LD      H,A             ; save high byte of attributes.
4346
 
4347
        EX      DE,HL           ; transfer attribute address to DE
4348
        LD      H,C             ; set H to zero - from last LDIR.
4349
        LD      L,B             ; load L with the line from B.
4350
        ADD     HL,HL           ; multiply
4351
        ADD     HL,HL           ; by
4352
        ADD     HL,HL           ; thirty two
4353
        ADD     HL,HL           ; to give count of attribute
4354
        ADD     HL,HL           ; cells to the end of display.
4355
 
4356
        LD      B,H             ; transfer the result
4357
        LD      C,L             ; to register BC.
4358
 
4359
        RET                     ; return.
4360
 
4361
; -------------------------------
4362
; Handle display with line number
4363
; -------------------------------
4364
; This subroutine is called from four places to calculate the address
4365
; of the start of a screen character line which is supplied in B.
4366
 
4367
;; CL-ADDR
4368
L0E9B:  LD      A,$18           ; reverse the line number
4369
        SUB     B               ; to range $00 - $17.
4370
        LD      D,A             ; save line in D for later.
4371
        RRCA                    ; multiply
4372
        RRCA                    ; by
4373
        RRCA                    ; thirty-two.
4374
 
4375
        AND     $E0             ; mask off low bits to make
4376
        LD      L,A             ; L a multiple of 32.
4377
 
4378
        LD      A,D             ; bring back the line to A.
4379
 
4380
        AND     $18             ; now $00, $08 or $10.
4381
 
4382
        OR      $40             ; add the base address of screen.
4383
 
4384
        LD      H,A             ; HL now has the correct address.
4385
        RET                     ; return.
4386
 
4387
; -------------------
4388
; Handle COPY command
4389
; -------------------
4390
; This command copies the top 176 lines to the ZX Printer
4391
; It is popular to call this from machine code at point
4392
; L0EAF with B holding 192 (and interrupts disabled) for a full-screen
4393
; copy. This particularly applies to 16K Spectrums as time-critical
4394
; machine code routines cannot be written in the first 16K of RAM as
4395
; it is shared with the ULA which has precedence over the Z80 chip.
4396
 
4397
;; COPY
4398
L0EAC:  DI                      ; disable interrupts as this is time-critical.
4399
 
4400
        LD      B,$B0           ; top 176 lines.
4401
L0EAF:  LD      HL,$4000        ; address start of the display file.
4402
 
4403
; now enter a loop to handle each pixel line.
4404
 
4405
;; COPY-1
4406
L0EB2:  PUSH    HL              ; save the screen address.
4407
        PUSH    BC              ; and the line counter.
4408
 
4409
        CALL    L0EF4           ; routine COPY-LINE outputs one line.
4410
 
4411
        POP     BC              ; restore the line counter.
4412
        POP     HL              ; and display address.
4413
        INC     H               ; next line down screen within 'thirds'.
4414
        LD      A,H             ; high byte to A.
4415
        AND     $07             ; result will be zero if we have left third.
4416
        JR      NZ,L0EC9        ; forward to COPY-2 if not to continue loop.
4417
 
4418
        LD      A,L             ; consider low byte first.
4419
        ADD     A,$20           ; increase by 32 - sets carry if back to zero.
4420
        LD      L,A             ; will be next group of 8.
4421
        CCF                     ; complement - carry set if more lines in
4422
                                ; the previous third.
4423
        SBC     A,A             ; will be FF, if more, else 00.
4424
        AND     $F8             ; will be F8 (-8) or 00.
4425
        ADD     A,H             ; that is subtract 8, if more to do in third.
4426
        LD      H,A             ; and reset address.
4427
 
4428
;; COPY-2
4429
L0EC9:  DJNZ    L0EB2           ; back to COPY-1 for all lines.
4430
 
4431
        JR      L0EDA           ; forward to COPY-END to switch off the printer
4432
                                ; motor and enable interrupts.
4433
                                ; Note. Nothing else is required.
4434
 
4435
; ------------------------------
4436
; Pass printer buffer to printer
4437
; ------------------------------
4438
; This routine is used to copy 8 text lines from the printer buffer
4439
; to the ZX Printer. These text lines are mapped linearly so HL does
4440
; not need to be adjusted at the end of each line.
4441
 
4442
;; COPY-BUFF
4443
L0ECD:  DI                      ; disable interrupts
4444
        LD      HL,$5B00        ; the base address of the Printer Buffer.
4445
        LD      B,$08           ; set count to 8 lines of 32 bytes.
4446
 
4447
;; COPY-3
4448
L0ED3:  PUSH    BC              ; save counter.
4449
 
4450
        CALL    L0EF4           ; routine COPY-LINE outputs 32 bytes
4451
 
4452
        POP     BC              ; restore counter.
4453
        DJNZ    L0ED3           ; loop back to COPY-3 for all 8 lines.
4454
                                ; then stop motor and clear buffer.
4455
 
4456
; Note. the COPY command rejoins here, essentially to execute the next
4457
; three instructions.
4458
 
4459
;; COPY-END
4460
L0EDA:  LD      A,$04           ; output value 4 to port
4461
        OUT     ($FB),A         ; to stop the slowed printer motor.
4462
        EI                      ; enable interrupts.
4463
 
4464
; --------------------
4465
; Clear Printer Buffer
4466
; --------------------
4467
; This routine clears an arbitrary 256 bytes of memory.
4468
; Note. The routine seems designed to clear a buffer that follows the
4469
; system variables.
4470
; The routine should check a flag or HL address and simply return if COPY
4471
; is in use.
4472
; As a consequence of this omission the buffer will needlessly
4473
; be cleared when COPY is used and the screen/printer position may be set to
4474
; the start of the buffer and the line number to 0 (B)
4475
; giving an 'Out of Screen' error.
4476
; There seems to have been an unsuccessful attempt to circumvent the use
4477
; of PR_CC_hi.
4478
 
4479
;; CLEAR-PRB
4480
L0EDF:  LD      HL,$5B00        ; the location of the buffer.
4481
        LD      (IY+$46),L      ; update PR_CC_lo - set to zero - superfluous.
4482
        XOR     A               ; clear the accumulator.
4483
        LD      B,A             ; set count to 256 bytes.
4484
 
4485
;; PRB-BYTES
4486
L0EE7:  LD      (HL),A          ; set addressed location to zero.
4487
        INC     HL              ; address next byte - Note. not INC L.
4488
        DJNZ    L0EE7           ; back to PRB-BYTES. repeat for 256 bytes.
4489
 
4490
        RES     1,(IY+$30)      ; set FLAGS2 - signal printer buffer is clear.
4491
        LD      C,$21           ; set the column position .
4492
        JP      L0DD9           ; exit via CL-SET and then PO-STORE.
4493
 
4494
; -----------------
4495
; Copy line routine
4496
; -----------------
4497
; This routine is called from COPY and COPY-BUFF to output a line of
4498
; 32 bytes to the ZX Printer.
4499
; Output to port $FB -
4500
; bit 7 set - activate stylus.
4501
; bit 7 low - deactivate stylus.
4502
; bit 2 set - stops printer.
4503
; bit 2 reset - starts printer
4504
; bit 1 set - slows printer.
4505
; bit 1 reset - normal speed.
4506
 
4507
;; COPY-LINE
4508
L0EF4:  LD      A,B             ; fetch the counter 1-8 or 1-176
4509
        CP      $03             ; is it 01 or 02 ?.
4510
        SBC     A,A             ; result is $FF if so else $00.
4511
        AND     $02             ; result is 02 now else 00.
4512
                                ; bit 1 set slows the printer.
4513
        OUT     ($FB),A         ; slow the printer for the
4514
                                ; last two lines.
4515
        LD      D,A             ; save the mask to control the printer later.
4516
 
4517
;; COPY-L-1
4518
L0EFD:  CALL    L1F54           ; call BREAK-KEY to read keyboard immediately.
4519
        JR      C,L0F0C         ; forward to COPY-L-2 if 'break' not pressed.
4520
 
4521
        LD      A,$04           ; else stop the
4522
        OUT     ($FB),A         ; printer motor.
4523
        EI                      ; enable interrupts.
4524
        CALL    L0EDF           ; call routine CLEAR-PRB.
4525
                                ; Note. should not be cleared if COPY in use.
4526
 
4527
;; REPORT-Dc
4528
L0F0A:  RST     08H             ; ERROR-1
4529
        DEFB    $0C             ; Error Report: BREAK - CONT repeats
4530
 
4531
;; COPY-L-2
4532
L0F0C:  IN      A,($FB)         ; test now to see if
4533
        ADD     A,A             ; a printer is attached.
4534
        RET     M               ; return if not - but continue with parent
4535
                                ; command.
4536
 
4537
        JR      NC,L0EFD        ; back to COPY-L-1 if stylus of printer not
4538
                                ; in position.
4539
 
4540
        LD      C,$20           ; set count to 32 bytes.
4541
 
4542
;; COPY-L-3
4543
L0F14:  LD      E,(HL)          ; fetch a byte from line.
4544
        INC     HL              ; address next location. Note. not INC L.
4545
        LD      B,$08           ; count the bits.
4546
 
4547
;; COPY-L-4
4548
L0F18:  RL      D               ; prepare mask to receive bit.
4549
        RL      E               ; rotate leftmost print bit to carry
4550
        RR      D               ; and back to bit 7 of D restoring bit 1
4551
 
4552
;; COPY-L-5
4553
L0F1E:  IN      A,($FB)         ; read the port.
4554
        RRA                     ; bit 0 to carry.
4555
        JR      NC,L0F1E        ; back to COPY-L-5 if stylus not in position.
4556
 
4557
        LD      A,D             ; transfer command bits to A.
4558
        OUT     ($FB),A         ; and output to port.
4559
        DJNZ    L0F18           ; loop back to COPY-L-4 for all 8 bits.
4560
 
4561
        DEC     C               ; decrease the byte count.
4562
        JR      NZ,L0F14        ; back to COPY-L-3 until 256 bits done.
4563
 
4564
        RET                     ; return to calling routine COPY/COPY-BUFF.
4565
 
4566
 
4567
; ----------------------------------
4568
; Editor routine for BASIC and INPUT
4569
; ----------------------------------
4570
; The editor is called to prepare or edit a BASIC line.
4571
; It is also called from INPUT to input a numeric or string expression.
4572
; The behaviour and options are quite different in the various modes
4573
; and distinguished by bit 5 of FLAGX.
4574
;
4575
; This is a compact and highly versatile routine.
4576
 
4577
;; EDITOR
4578
L0F2C:  LD      HL,($5C3D)      ; fetch ERR_SP
4579
        PUSH    HL              ; save on stack
4580
 
4581
;; ED-AGAIN
4582
L0F30:  LD      HL,L107F        ; address: ED-ERROR
4583
        PUSH    HL              ; save address on stack and
4584
        LD      ($5C3D),SP      ; make ERR_SP point to it.
4585
 
4586
; Note. While in editing/input mode should an error occur then RST 08 will
4587
; update X_PTR to the location reached by CH_ADD and jump to ED-ERROR
4588
; where the error will be cancelled and the loop begin again from ED-AGAIN
4589
; above. The position of the error will be apparent when the lower screen is
4590
; reprinted. If no error then the re-iteration is to ED-LOOP below when
4591
; input is arriving from the keyboard.
4592
 
4593
;; ED-LOOP
4594
L0F38:  CALL    L15D4           ; routine WAIT-KEY gets key possibly
4595
                                ; changing the mode.
4596
        PUSH    AF              ; save key.
4597
        LD      D,$00           ; and give a short click based
4598
        LD      E,(IY-$01)      ; on PIP value for duration.
4599
        LD      HL,$00C8        ; and pitch.
4600
        CALL    L03B5           ; routine BEEPER gives click - effective
4601
                                ; with rubber keyboard.
4602
        POP     AF              ; get saved key value.
4603
        LD      HL,L0F38        ; address: ED-LOOP is loaded to HL.
4604
        PUSH    HL              ; and pushed onto stack.
4605
 
4606
; At this point there is a looping return address on the stack, an error
4607
; handler and an input stream set up to supply characters.
4608
; The character that has been received can now be processed.
4609
 
4610
        CP      $18             ; range 24 to 255 ?
4611
        JR      NC,L0F81        ; forward to ADD-CHAR if so.
4612
 
4613
        CP      $07             ; lower than 7 ?
4614
        JR      C,L0F81         ; forward to ADD-CHAR also.
4615
                                ; Note. This is a 'bug' and chr$ 6, the comma
4616
                                ; control character, should have had an
4617
                                ; entry in the ED-KEYS table.
4618
                                ; Steven Vickers, 1984, Pitman.
4619
 
4620
        CP      $10             ; less than 16 ?
4621
        JR      C,L0F92         ; forward to ED-KEYS if editing control
4622
                                ; range 7 to 15 dealt with by a table
4623
 
4624
        LD      BC,$0002        ; prepare for ink/paper etc.
4625
        LD      D,A             ; save character in D
4626
        CP      $16             ; is it ink/paper/bright etc. ?
4627
        JR      C,L0F6C         ; forward to ED-CONTR if so
4628
 
4629
                                ; leaves 22d AT and 23d TAB
4630
                                ; which can't be entered via KEY-INPUT.
4631
                                ; so this code is never normally executed
4632
                                ; when the keyboard is used for input.
4633
 
4634
        INC     BC              ; if it was AT/TAB - 3 locations required
4635
        BIT     7,(IY+$37)      ; test FLAGX  - Is this INPUT LINE ?
4636
        JP      Z,L101E         ; jump to ED-IGNORE if not, else
4637
 
4638
        CALL    L15D4           ; routine WAIT-KEY - input address is KEY-NEXT
4639
                                ; but is reset to KEY-INPUT
4640
        LD      E,A             ; save first in E
4641
 
4642
;; ED-CONTR
4643
L0F6C:  CALL    L15D4           ; routine WAIT-KEY for control.
4644
                                ; input address will be key-next.
4645
 
4646
        PUSH    DE              ; saved code/parameters
4647
        LD      HL,($5C5B)      ; fetch address of keyboard cursor from K_CUR
4648
        RES     0,(IY+$07)      ; set MODE to 'L'
4649
 
4650
        CALL    L1655           ; routine MAKE-ROOM makes 2/3 spaces at cursor
4651
 
4652
        POP     BC              ; restore code/parameters
4653
        INC     HL              ; address first location
4654
        LD      (HL),B          ; place code (ink etc.)
4655
        INC     HL              ; address next
4656
        LD      (HL),C          ; place possible parameter. If only one
4657
                                ; then DE points to this location also.
4658
        JR      L0F8B           ; forward to ADD-CH-1
4659
 
4660
; ------------------------
4661
; Add code to current line
4662
; ------------------------
4663
; this is the branch used to add normal non-control characters
4664
; with ED-LOOP as the stacked return address.
4665
; it is also the OUTPUT service routine for system channel 'R'.
4666
 
4667
;; ADD-CHAR
4668
L0F81:  RES     0,(IY+$07)      ; set MODE to 'L'
4669
 
4670
X0F85:  LD      HL,($5C5B)      ; fetch address of keyboard cursor from K_CUR
4671
 
4672
        CALL    L1652           ; routine ONE-SPACE creates one space.
4673
 
4674
; either a continuation of above or from ED-CONTR with ED-LOOP on stack.
4675
 
4676
;; ADD-CH-1
4677
L0F8B:  LD      (DE),A          ; load current character to last new location.
4678
        INC     DE              ; address next
4679
        LD      ($5C5B),DE      ; and update K_CUR system variable.
4680
        RET                     ; return - either a simple return
4681
                                ; from ADD-CHAR or to ED-LOOP on stack.
4682
 
4683
; ---
4684
 
4685
; a branch of the editing loop to deal with control characters
4686
; using a look-up table.
4687
 
4688
;; ED-KEYS
4689
L0F92:  LD      E,A             ; character to E.
4690
        LD      D,$00           ; prepare to add.
4691
        LD      HL,L0FA0 - 7    ; base address of editing keys table. $0F99
4692
        ADD     HL,DE           ; add E
4693
        LD      E,(HL)          ; fetch offset to E
4694
        ADD     HL,DE           ; add offset for address of handling routine.
4695
        PUSH    HL              ; push the address on machine stack.
4696
        LD      HL,($5C5B)      ; load address of cursor from K_CUR.
4697
        RET                     ; Make an indirect jump forward to routine.
4698
 
4699
; ------------------
4700
; Editing keys table
4701
; ------------------
4702
; For each code in the range $07 to $0F this table contains a
4703
; single offset byte to the routine that services that code.
4704
; Note. for what was intended there should also have been an
4705
; entry for chr$ 6 with offset to ed-symbol.
4706
 
4707
;; ed-keys-t
4708
L0FA0:  DEFB    L0FA9 - $  ; 07d offset $09 to Address: ED-EDIT
4709
        DEFB    L1007 - $  ; 08d offset $66 to Address: ED-LEFT
4710
        DEFB    L100C - $  ; 09d offset $6A to Address: ED-RIGHT
4711
        DEFB    L0FF3 - $  ; 10d offset $50 to Address: ED-DOWN
4712
        DEFB    L1059 - $  ; 11d offset $B5 to Address: ED-UP
4713
        DEFB    L1015 - $  ; 12d offset $70 to Address: ED-DELETE
4714
        DEFB    L1024 - $  ; 13d offset $7E to Address: ED-ENTER
4715
        DEFB    L1076 - $  ; 14d offset $CF to Address: ED-SYMBOL
4716
        DEFB    L107C - $  ; 15d offset $D4 to Address: ED-GRAPH
4717
 
4718
; ---------------
4719
; Handle EDIT key
4720
; ---------------
4721
; The user has pressed SHIFT 1 to bring edit line down to bottom of screen.
4722
; Alternatively the user wishes to clear the input buffer and start again.
4723
; Alternatively ...
4724
 
4725
;; ED-EDIT
4726
L0FA9:  LD      HL,($5C49)      ; fetch E_PPC the last line number entered.
4727
                                ; Note. may not exist and may follow program.
4728
        BIT     5,(IY+$37)      ; test FLAGX  - input mode ?
4729
        JP      NZ,L1097        ; jump forward to CLEAR-SP if not in editor.
4730
 
4731
        CALL    L196E           ; routine LINE-ADDR to find address of line
4732
                                ; or following line if it doesn't exist.
4733
        CALL    L1695           ; routine LINE-NO will get line number from
4734
                                ; address or previous line if at end-marker.
4735
        LD      A,D             ; if there is no program then DE will
4736
        OR      E               ; contain zero so test for this.
4737
        JP      Z,L1097         ; jump to CLEAR-SP if so.
4738
 
4739
; Note. at this point we have a validated line number, not just an
4740
; approximation and it would be best to update E_PPC with the true
4741
; cursor line value which would enable the line cursor to be suppressed
4742
; in all situations - see shortly.
4743
 
4744
        PUSH    HL              ; save address of line.
4745
        INC     HL              ; address low byte of length.
4746
        LD      C,(HL)          ; transfer to C
4747
        INC     HL              ; next to high byte
4748
        LD      B,(HL)          ; transfer to B.
4749
        LD      HL,$000A        ; an overhead of ten bytes
4750
        ADD     HL,BC           ; is added to length.
4751
        LD      B,H             ; transfer adjusted value
4752
        LD      C,L             ; to BC register.
4753
        CALL    L1F05           ; routine TEST-ROOM checks free memory.
4754
        CALL    L1097           ; routine CLEAR-SP clears editing area.
4755
        LD      HL,($5C51)      ; address CURCHL
4756
        EX      (SP),HL         ; swap with line address on stack
4757
        PUSH    HL              ; save line address underneath
4758
 
4759
        LD      A,$FF           ; select system channel 'R'
4760
        CALL    L1601           ; routine CHAN-OPEN opens it
4761
 
4762
        POP     HL              ; drop line address
4763
        DEC     HL              ; make it point to first byte of line num.
4764
        DEC     (IY+$0F)        ; decrease E_PPC_lo to suppress line cursor.
4765
                                ; Note. ineffective when E_PPC is one
4766
                                ; greater than last line of program perhaps
4767
                                ; as a result of a delete.
4768
                                ; credit. Paul Harrison 1982.
4769
 
4770
        CALL    L1855           ; routine OUT-LINE outputs the BASIC line
4771
                                ; to the editing area.
4772
        INC     (IY+$0F)        ; restore E_PPC_lo to the previous value.
4773
        LD      HL,($5C59)      ; address E_LINE in editing area.
4774
        INC     HL              ; advance
4775
        INC     HL              ; past space
4776
        INC     HL              ; and digit characters
4777
        INC     HL              ; of line number.
4778
 
4779
        LD      ($5C5B),HL      ; update K_CUR to address start of BASIC.
4780
        POP     HL              ; restore the address of CURCHL.
4781
        CALL    L1615           ; routine CHAN-FLAG sets flags for it.
4782
 
4783
        RET                     ; RETURN to ED-LOOP.
4784
 
4785
; -------------------
4786
; Cursor down editing
4787
; -------------------
4788
;   The BASIC lines are displayed at the top of the screen and the user
4789
;   wishes to move the cursor down one line in edit mode.
4790
;   With INPUT LINE, this key must be used instead of entering STOP.
4791