1 |
8 |
gdevic |
;************************************************************************
|
2 |
|
|
;** An Assembly File Listing to generate a 16K ROM for the ZX Spectrum **
|
3 |
|
|
;************************************************************************
|
4 |
|
|
;
|
5 |
|
|
; 11-10-2014:
|
6 |
|
|
; This version has been updated to correctly handle the NMI jump.
|
7 |
|
|
;
|
8 |
|
|
; -------------------------
|
9 |
|
|
; Last updated: 13-DEC-2004
|
10 |
|
|
; -------------------------
|
11 |
|
|
|
12 |
|
|
; TASM cross-assembler directives.
|
13 |
|
|
; ( comment out, perhaps, for other assemblers - see Notes at end.)
|
14 |
|
|
|
15 |
|
|
#define DEFB .BYTE
|
16 |
|
|
#define DEFW .WORD
|
17 |
|
|
#define DEFM .TEXT
|
18 |
|
|
#define ORG .ORG
|
19 |
|
|
#define EQU .EQU
|
20 |
|
|
#define equ .EQU
|
21 |
|
|
|
22 |
|
|
; It is always a good idea to anchor, using ORGs, important sections such as
|
23 |
|
|
; the character bitmaps so that they don't move as code is added and removed.
|
24 |
|
|
|
25 |
|
|
; Generally most approaches try to maintain main entry points as they are
|
26 |
|
|
; often used by third-party software.
|
27 |
|
|
|
28 |
|
|
ORG 0000
|
29 |
|
|
|
30 |
|
|
;*****************************************
|
31 |
|
|
;** Part 1. RESTART ROUTINES AND TABLES **
|
32 |
|
|
;*****************************************
|
33 |
|
|
|
34 |
|
|
; -----------
|
35 |
|
|
; THE 'START'
|
36 |
|
|
; -----------
|
37 |
|
|
; At switch on, the Z80 chip is in Interrupt Mode 0.
|
38 |
|
|
; The Spectrum uses Interrupt Mode 1.
|
39 |
|
|
; This location can also be 'called' to reset the machine.
|
40 |
|
|
; Typically with PRINT USR 0.
|
41 |
|
|
|
42 |
|
|
;; START
|
43 |
|
|
L0000: DI ; Disable Interrupts.
|
44 |
|
|
XOR A ; Signal coming from START.
|
45 |
|
|
LD DE,$FFFF ; Set pointer to top of possible physical RAM.
|
46 |
|
|
JP L11CB ; Jump forward to common code at START-NEW.
|
47 |
|
|
|
48 |
|
|
; -------------------
|
49 |
|
|
; THE 'ERROR' RESTART
|
50 |
|
|
; -------------------
|
51 |
|
|
; The error pointer is made to point to the position of the error to enable
|
52 |
|
|
; the editor to highlight the error position if it occurred during syntax
|
53 |
|
|
; checking. It is used at 37 places in the program. An instruction fetch
|
54 |
|
|
; on address $0008 may page in a peripheral ROM such as the Sinclair
|
55 |
|
|
; Interface 1 or Disciple Disk Interface. This was not an original design
|
56 |
|
|
; concept and not all errors pass through here.
|
57 |
|
|
|
58 |
|
|
;; ERROR-1
|
59 |
|
|
L0008: LD HL,($5C5D) ; Fetch the character address from CH_ADD.
|
60 |
|
|
LD ($5C5F),HL ; Copy it to the error pointer X_PTR.
|
61 |
|
|
JR L0053 ; Forward to continue at ERROR-2.
|
62 |
|
|
|
63 |
|
|
; -----------------------------
|
64 |
|
|
; THE 'PRINT CHARACTER' RESTART
|
65 |
|
|
; -----------------------------
|
66 |
|
|
; The A register holds the code of the character that is to be sent to
|
67 |
|
|
; the output stream of the current channel. The alternate register set is
|
68 |
|
|
; used to output a character in the A register so there is no need to
|
69 |
|
|
; preserve any of the current main registers (HL, DE, BC).
|
70 |
|
|
; This restart is used 21 times.
|
71 |
|
|
|
72 |
|
|
;; PRINT-A
|
73 |
|
|
L0010: JP L15F2 ; Jump forward to continue at PRINT-A-2.
|
74 |
|
|
|
75 |
|
|
; ---
|
76 |
|
|
|
77 |
|
|
DEFB $FF, $FF, $FF ; Five unused locations.
|
78 |
|
|
DEFB $FF, $FF ;
|
79 |
|
|
|
80 |
|
|
; -------------------------------
|
81 |
|
|
; THE 'COLLECT CHARACTER' RESTART
|
82 |
|
|
; -------------------------------
|
83 |
|
|
; The contents of the location currently addressed by CH_ADD are fetched.
|
84 |
|
|
; A return is made if the value represents a character that has
|
85 |
|
|
; relevance to the BASIC parser. Otherwise CH_ADD is incremented and the
|
86 |
|
|
; tests repeated. CH_ADD will be addressing somewhere -
|
87 |
|
|
; 1) in the BASIC program area during line execution.
|
88 |
|
|
; 2) in workspace if evaluating, for example, a string expression.
|
89 |
|
|
; 3) in the edit buffer if parsing a direct command or a new BASIC line.
|
90 |
|
|
; 4) in workspace if accepting input but not that from INPUT LINE.
|
91 |
|
|
|
92 |
|
|
;; GET-CHAR
|
93 |
|
|
L0018: LD HL,($5C5D) ; fetch the address from CH_ADD.
|
94 |
|
|
LD A,(HL) ; use it to pick up current character.
|
95 |
|
|
|
96 |
|
|
;; TEST-CHAR
|
97 |
|
|
L001C: CALL L007D ; routine SKIP-OVER tests if the character is
|
98 |
|
|
; relevant.
|
99 |
|
|
RET NC ; Return if it is significant.
|
100 |
|
|
|
101 |
|
|
; ------------------------------------
|
102 |
|
|
; THE 'COLLECT NEXT CHARACTER' RESTART
|
103 |
|
|
; ------------------------------------
|
104 |
|
|
; As the BASIC commands and expressions are interpreted, this routine is
|
105 |
|
|
; called repeatedly to step along the line. It is used 83 times.
|
106 |
|
|
|
107 |
|
|
;; NEXT-CHAR
|
108 |
|
|
L0020: CALL L0074 ; routine CH-ADD+1 fetches the next immediate
|
109 |
|
|
; character.
|
110 |
|
|
JR L001C ; jump back to TEST-CHAR until a valid
|
111 |
|
|
; character is found.
|
112 |
|
|
|
113 |
|
|
; ---
|
114 |
|
|
|
115 |
|
|
DEFB $FF, $FF, $FF ; unused
|
116 |
|
|
|
117 |
|
|
; -----------------------
|
118 |
|
|
; THE 'CALCULATE' RESTART
|
119 |
|
|
; -----------------------
|
120 |
|
|
; This restart enters the Spectrum's internal, floating-point, stack-based,
|
121 |
|
|
; FORTH-like language.
|
122 |
|
|
; It is further used recursively from within the calculator.
|
123 |
|
|
; It is used on 77 occasions.
|
124 |
|
|
|
125 |
|
|
;; FP-CALC
|
126 |
|
|
L0028: JP L335B ; jump forward to the CALCULATE routine.
|
127 |
|
|
|
128 |
|
|
; ---
|
129 |
|
|
|
130 |
|
|
DEFB $FF, $FF, $FF ; spare - note that on the ZX81, space being a
|
131 |
|
|
DEFB $FF, $FF ; little cramped, these same locations were
|
132 |
|
|
; used for the five-byte end-calc literal.
|
133 |
|
|
|
134 |
|
|
; ------------------------------
|
135 |
|
|
; THE 'CREATE BC SPACES' RESTART
|
136 |
|
|
; ------------------------------
|
137 |
|
|
; This restart is used on only 12 occasions to create BC spaces
|
138 |
|
|
; between workspace and the calculator stack.
|
139 |
|
|
|
140 |
|
|
;; BC-SPACES
|
141 |
|
|
L0030: PUSH BC ; Save number of spaces.
|
142 |
|
|
LD HL,($5C61) ; Fetch WORKSP.
|
143 |
|
|
PUSH HL ; Save address of workspace.
|
144 |
|
|
JP L169E ; Jump forward to continuation code RESERVE.
|
145 |
|
|
|
146 |
|
|
; --------------------------------
|
147 |
|
|
; THE 'MASKABLE INTERRUPT' ROUTINE
|
148 |
|
|
; --------------------------------
|
149 |
|
|
; This routine increments the Spectrum's three-byte FRAMES counter fifty
|
150 |
|
|
; times a second (sixty times a second in the USA ).
|
151 |
|
|
; Both this routine and the called KEYBOARD subroutine use the IY register
|
152 |
|
|
; to access system variables and flags so a user-written program must
|
153 |
|
|
; disable interrupts to make use of the IY register.
|
154 |
|
|
|
155 |
|
|
;; MASK-INT
|
156 |
|
|
L0038: PUSH AF ; Save the registers that will be used but not
|
157 |
|
|
PUSH HL ; the IY register unfortunately.
|
158 |
|
|
LD HL,($5C78) ; Fetch the first two bytes at FRAMES1.
|
159 |
|
|
INC HL ; Increment lowest two bytes of counter.
|
160 |
|
|
LD ($5C78),HL ; Place back in FRAMES1.
|
161 |
|
|
LD A,H ; Test if the result was zero.
|
162 |
|
|
OR L ;
|
163 |
|
|
JR NZ,L0048 ; Forward, if not, to KEY-INT
|
164 |
|
|
|
165 |
|
|
INC (IY+$40) ; otherwise increment FRAMES3 the third byte.
|
166 |
|
|
|
167 |
|
|
; Now save the rest of the main registers and read and decode the keyboard.
|
168 |
|
|
|
169 |
|
|
;; KEY-INT
|
170 |
|
|
L0048: PUSH BC ; Save the other main registers.
|
171 |
|
|
PUSH DE ;
|
172 |
|
|
|
173 |
|
|
CALL L02BF ; Routine KEYBOARD executes a stage in the
|
174 |
|
|
; process of reading a key-press.
|
175 |
|
|
POP DE ;
|
176 |
|
|
POP BC ; Restore registers.
|
177 |
|
|
|
178 |
|
|
POP HL ;
|
179 |
|
|
POP AF ;
|
180 |
|
|
|
181 |
|
|
EI ; Enable Interrupts.
|
182 |
|
|
RET ; Return.
|
183 |
|
|
|
184 |
|
|
; ---------------------
|
185 |
|
|
; THE 'ERROR-2' ROUTINE
|
186 |
|
|
; ---------------------
|
187 |
|
|
; A continuation of the code at 0008.
|
188 |
|
|
; The error code is stored and after clearing down stacks, an indirect jump
|
189 |
|
|
; is made to MAIN-4, etc. to handle the error.
|
190 |
|
|
|
191 |
|
|
;; ERROR-2
|
192 |
|
|
L0053: POP HL ; drop the return address - the location
|
193 |
|
|
; after the RST 08H instruction.
|
194 |
|
|
LD L,(HL) ; fetch the error code that follows.
|
195 |
|
|
; (nice to see this instruction used.)
|
196 |
|
|
|
197 |
|
|
; Note. this entry point is used when out of memory at REPORT-4.
|
198 |
|
|
; The L register has been loaded with the report code but X-PTR is not
|
199 |
|
|
; updated.
|
200 |
|
|
|
201 |
|
|
;; ERROR-3
|
202 |
|
|
L0055: LD (IY+$00),L ; Store it in the system variable ERR_NR.
|
203 |
|
|
LD SP,($5C3D) ; ERR_SP points to an error handler on the
|
204 |
|
|
; machine stack. There may be a hierarchy
|
205 |
|
|
; of routines.
|
206 |
|
|
; To MAIN-4 initially at base.
|
207 |
|
|
; or REPORT-G on line entry.
|
208 |
|
|
; or ED-ERROR when editing.
|
209 |
|
|
; or ED-FULL during ed-enter.
|
210 |
|
|
; or IN-VAR-1 during runtime input etc.
|
211 |
|
|
|
212 |
|
|
JP L16C5 ; Jump to SET-STK to clear the calculator stack
|
213 |
|
|
; and reset MEM to usual place in the systems
|
214 |
|
|
; variables area and then indirectly to MAIN-4,
|
215 |
|
|
; etc.
|
216 |
|
|
|
217 |
|
|
; ---
|
218 |
|
|
|
219 |
|
|
DEFB $FF, $FF, $FF ; Unused locations
|
220 |
|
|
DEFB $FF, $FF, $FF ; before the fixed-position
|
221 |
|
|
DEFB $FF ; NMI routine.
|
222 |
|
|
|
223 |
|
|
; ------------------------------------
|
224 |
|
|
; THE 'NON-MASKABLE INTERRUPT' ROUTINE
|
225 |
|
|
; ------------------------------------
|
226 |
|
|
;
|
227 |
|
|
; There is no NMI switch on the standard Spectrum or its peripherals.
|
228 |
|
|
; When the NMI line is held low, then no matter what the Z80 was doing at
|
229 |
|
|
; the time, it will now execute the code at 66 Hex.
|
230 |
|
|
; This Interrupt Service Routine will jump to location zero if the contents
|
231 |
|
|
; of the system variable NMIADD are zero or return if the location holds a
|
232 |
|
|
; non-zero address. So attaching a simple switch to the NMI as in the book
|
233 |
|
|
; "Spectrum Hardware Manual" causes a reset. The logic was obviously
|
234 |
|
|
; intended to work the other way. Sinclair Research said that, since they
|
235 |
|
|
; had never advertised the NMI, they had no plans to fix the error "until
|
236 |
|
|
; the opportunity arose".
|
237 |
|
|
;
|
238 |
|
|
; Note. The location NMIADD was, in fact, later used by Sinclair Research
|
239 |
|
|
; to enhance the text channel on the ZX Interface 1.
|
240 |
|
|
; On later Amstrad-made Spectrums, and the Brazilian Spectrum, the logic of
|
241 |
|
|
; this routine was indeed reversed but not as at first intended.
|
242 |
|
|
;
|
243 |
|
|
; It can be deduced by looking elsewhere in this ROM that the NMIADD system
|
244 |
|
|
; variable pointed to L121C and that this enabled a Warm Restart to be
|
245 |
|
|
; performed at any time, even while playing machine code games, or while
|
246 |
|
|
; another Spectrum has been allowed to gain control of this one.
|
247 |
|
|
;
|
248 |
|
|
; Software houses would have been able to protect their games from attack by
|
249 |
|
|
; placing two zeros in the NMIADD system variable.
|
250 |
|
|
|
251 |
|
|
;; RESET
|
252 |
|
|
L0066: PUSH AF ; save the
|
253 |
|
|
PUSH HL ; registers.
|
254 |
|
|
LD HL,($5CB0) ; fetch the system variable NMIADD.
|
255 |
|
|
LD A,H ; test address
|
256 |
|
|
OR L ; for zero.
|
257 |
|
|
|
258 |
|
|
; JR NZ,L0070 ; skip to NO-RESET if NOT ZERO
|
259 |
|
|
JR Z,L0070 ; **FIXED**
|
260 |
|
|
|
261 |
|
|
JP (HL) ; jump to routine ( i.e. L0000 )
|
262 |
|
|
|
263 |
|
|
;; NO-RESET
|
264 |
|
|
L0070: POP HL ; restore the
|
265 |
|
|
POP AF ; registers.
|
266 |
|
|
RETN ; return to previous interrupt state.
|
267 |
|
|
|
268 |
|
|
; ---------------------------
|
269 |
|
|
; THE 'CH ADD + 1' SUBROUTINE
|
270 |
|
|
; ---------------------------
|
271 |
|
|
; This subroutine is called from RST 20, and three times from elsewhere
|
272 |
|
|
; to fetch the next immediate character following the current valid character
|
273 |
|
|
; address and update the associated system variable.
|
274 |
|
|
; The entry point TEMP-PTR1 is used from the SCANNING routine.
|
275 |
|
|
; Both TEMP-PTR1 and TEMP-PTR2 are used by the READ command routine.
|
276 |
|
|
|
277 |
|
|
;; CH-ADD+1
|
278 |
|
|
L0074: LD HL,($5C5D) ; fetch address from CH_ADD.
|
279 |
|
|
|
280 |
|
|
;; TEMP-PTR1
|
281 |
|
|
L0077: INC HL ; increase the character address by one.
|
282 |
|
|
|
283 |
|
|
;; TEMP-PTR2
|
284 |
|
|
L0078: LD ($5C5D),HL ; update CH_ADD with character address.
|
285 |
|
|
|
286 |
|
|
X007B: LD A,(HL) ; load character to A from HL.
|
287 |
|
|
RET ; and return.
|
288 |
|
|
|
289 |
|
|
; --------------------------
|
290 |
|
|
; THE 'SKIP OVER' SUBROUTINE
|
291 |
|
|
; --------------------------
|
292 |
|
|
; This subroutine is called once from RST 18 to skip over white-space and
|
293 |
|
|
; other characters irrelevant to the parsing of a BASIC line etc. .
|
294 |
|
|
; Initially the A register holds the character to be considered
|
295 |
|
|
; and HL holds its address which will not be within quoted text
|
296 |
|
|
; when a BASIC line is parsed.
|
297 |
|
|
; Although the 'tab' and 'at' characters will not appear in a BASIC line,
|
298 |
|
|
; they could be present in a string expression, and in other situations.
|
299 |
|
|
; Note. although white-space is usually placed in a program to indent loops
|
300 |
|
|
; and make it more readable, it can also be used for the opposite effect and
|
301 |
|
|
; spaces may appear in variable names although the parser never sees them.
|
302 |
|
|
; It is this routine that helps make the variables 'Anum bEr5 3BUS' and
|
303 |
|
|
; 'a number 53 bus' appear the same to the parser.
|
304 |
|
|
|
305 |
|
|
;; SKIP-OVER
|
306 |
|
|
L007D: CP $21 ; test if higher than space.
|
307 |
|
|
RET NC ; return with carry clear if so.
|
308 |
|
|
|
309 |
|
|
CP $0D ; carriage return ?
|
310 |
|
|
RET Z ; return also with carry clear if so.
|
311 |
|
|
|
312 |
|
|
; all other characters have no relevance
|
313 |
|
|
; to the parser and must be returned with
|
314 |
|
|
; carry set.
|
315 |
|
|
|
316 |
|
|
CP $10 ; test if 0-15d
|
317 |
|
|
RET C ; return, if so, with carry set.
|
318 |
|
|
|
319 |
|
|
CP $18 ; test if 24-32d
|
320 |
|
|
CCF ; complement carry flag.
|
321 |
|
|
RET C ; return with carry set if so.
|
322 |
|
|
|
323 |
|
|
; now leaves 16d-23d
|
324 |
|
|
|
325 |
|
|
INC HL ; all above have at least one extra character
|
326 |
|
|
; to be stepped over.
|
327 |
|
|
|
328 |
|
|
CP $16 ; controls 22d ('at') and 23d ('tab') have two.
|
329 |
|
|
JR C,L0090 ; forward to SKIPS with ink, paper, flash,
|
330 |
|
|
; bright, inverse or over controls.
|
331 |
|
|
; Note. the high byte of tab is for RS232 only.
|
332 |
|
|
; it has no relevance on this machine.
|
333 |
|
|
|
334 |
|
|
INC HL ; step over the second character of 'at'/'tab'.
|
335 |
|
|
|
336 |
|
|
;; SKIPS
|
337 |
|
|
L0090: SCF ; set the carry flag
|
338 |
|
|
LD ($5C5D),HL ; update the CH_ADD system variable.
|
339 |
|
|
RET ; return with carry set.
|
340 |
|
|
|
341 |
|
|
|
342 |
|
|
; ------------------
|
343 |
|
|
; THE 'TOKEN' TABLES
|
344 |
|
|
; ------------------
|
345 |
|
|
; The tokenized characters 134d (RND) to 255d (COPY) are expanded using
|
346 |
|
|
; this table. The last byte of a token is inverted to denote the end of
|
347 |
|
|
; the word. The first is an inverted step-over byte.
|
348 |
|
|
|
349 |
|
|
;; TKN-TABLE
|
350 |
|
|
L0095: DEFB '?'+$80
|
351 |
|
|
DEFM "RN"
|
352 |
|
|
DEFB 'D'+$80
|
353 |
|
|
DEFM "INKEY"
|
354 |
|
|
DEFB '$'+$80
|
355 |
|
|
DEFB 'P','I'+$80
|
356 |
|
|
DEFB 'F','N'+$80
|
357 |
|
|
DEFM "POIN"
|
358 |
|
|
DEFB 'T'+$80
|
359 |
|
|
DEFM "SCREEN"
|
360 |
|
|
DEFB '$'+$80
|
361 |
|
|
DEFM "ATT"
|
362 |
|
|
DEFB 'R'+$80
|
363 |
|
|
DEFB 'A','T'+$80
|
364 |
|
|
DEFM "TA"
|
365 |
|
|
DEFB 'B'+$80
|
366 |
|
|
DEFM "VAL"
|
367 |
|
|
DEFB '$'+$80
|
368 |
|
|
DEFM "COD"
|
369 |
|
|
DEFB 'E'+$80
|
370 |
|
|
DEFM "VA"
|
371 |
|
|
DEFB 'L'+$80
|
372 |
|
|
DEFM "LE"
|
373 |
|
|
DEFB 'N'+$80
|
374 |
|
|
DEFM "SI"
|
375 |
|
|
DEFB 'N'+$80
|
376 |
|
|
DEFM "CO"
|
377 |
|
|
DEFB 'S'+$80
|
378 |
|
|
DEFM "TA"
|
379 |
|
|
DEFB 'N'+$80
|
380 |
|
|
DEFM "AS"
|
381 |
|
|
DEFB 'N'+$80
|
382 |
|
|
DEFM "AC"
|
383 |
|
|
DEFB 'S'+$80
|
384 |
|
|
DEFM "AT"
|
385 |
|
|
DEFB 'N'+$80
|
386 |
|
|
DEFB 'L','N'+$80
|
387 |
|
|
DEFM "EX"
|
388 |
|
|
DEFB 'P'+$80
|
389 |
|
|
DEFM "IN"
|
390 |
|
|
DEFB 'T'+$80
|
391 |
|
|
DEFM "SQ"
|
392 |
|
|
DEFB 'R'+$80
|
393 |
|
|
DEFM "SG"
|
394 |
|
|
DEFB 'N'+$80
|
395 |
|
|
DEFM "AB"
|
396 |
|
|
DEFB 'S'+$80
|
397 |
|
|
DEFM "PEE"
|
398 |
|
|
DEFB 'K'+$80
|
399 |
|
|
DEFB 'I','N'+$80
|
400 |
|
|
DEFM "US"
|
401 |
|
|
DEFB 'R'+$80
|
402 |
|
|
DEFM "STR"
|
403 |
|
|
DEFB '$'+$80
|
404 |
|
|
DEFM "CHR"
|
405 |
|
|
DEFB '$'+$80
|
406 |
|
|
DEFM "NO"
|
407 |
|
|
DEFB 'T'+$80
|
408 |
|
|
DEFM "BI"
|
409 |
|
|
DEFB 'N'+$80
|
410 |
|
|
|
411 |
|
|
; The previous 32 function-type words are printed without a leading space
|
412 |
|
|
; The following have a leading space if they begin with a letter
|
413 |
|
|
|
414 |
|
|
DEFB 'O','R'+$80
|
415 |
|
|
DEFM "AN"
|
416 |
|
|
DEFB 'D'+$80
|
417 |
|
|
DEFB $3C,'='+$80 ; <=
|
418 |
|
|
DEFB $3E,'='+$80 ; >=
|
419 |
|
|
DEFB $3C,$3E+$80 ; <>
|
420 |
|
|
DEFM "LIN"
|
421 |
|
|
DEFB 'E'+$80
|
422 |
|
|
DEFM "THE"
|
423 |
|
|
DEFB 'N'+$80
|
424 |
|
|
DEFB 'T','O'+$80
|
425 |
|
|
DEFM "STE"
|
426 |
|
|
DEFB 'P'+$80
|
427 |
|
|
DEFM "DEF F"
|
428 |
|
|
DEFB 'N'+$80
|
429 |
|
|
DEFM "CA"
|
430 |
|
|
DEFB 'T'+$80
|
431 |
|
|
DEFM "FORMA"
|
432 |
|
|
DEFB 'T'+$80
|
433 |
|
|
DEFM "MOV"
|
434 |
|
|
DEFB 'E'+$80
|
435 |
|
|
DEFM "ERAS"
|
436 |
|
|
DEFB 'E'+$80
|
437 |
|
|
DEFM "OPEN "
|
438 |
|
|
DEFB '#'+$80
|
439 |
|
|
DEFM "CLOSE "
|
440 |
|
|
DEFB '#'+$80
|
441 |
|
|
DEFM "MERG"
|
442 |
|
|
DEFB 'E'+$80
|
443 |
|
|
DEFM "VERIF"
|
444 |
|
|
DEFB 'Y'+$80
|
445 |
|
|
DEFM "BEE"
|
446 |
|
|
DEFB 'P'+$80
|
447 |
|
|
DEFM "CIRCL"
|
448 |
|
|
DEFB 'E'+$80
|
449 |
|
|
DEFM "IN"
|
450 |
|
|
DEFB 'K'+$80
|
451 |
|
|
DEFM "PAPE"
|
452 |
|
|
DEFB 'R'+$80
|
453 |
|
|
DEFM "FLAS"
|
454 |
|
|
DEFB 'H'+$80
|
455 |
|
|
DEFM "BRIGH"
|
456 |
|
|
DEFB 'T'+$80
|
457 |
|
|
DEFM "INVERS"
|
458 |
|
|
DEFB 'E'+$80
|
459 |
|
|
DEFM "OVE"
|
460 |
|
|
DEFB 'R'+$80
|
461 |
|
|
DEFM "OU"
|
462 |
|
|
DEFB 'T'+$80
|
463 |
|
|
DEFM "LPRIN"
|
464 |
|
|
DEFB 'T'+$80
|
465 |
|
|
DEFM "LLIS"
|
466 |
|
|
DEFB 'T'+$80
|
467 |
|
|
DEFM "STO"
|
468 |
|
|
DEFB 'P'+$80
|
469 |
|
|
DEFM "REA"
|
470 |
|
|
DEFB 'D'+$80
|
471 |
|
|
DEFM "DAT"
|
472 |
|
|
DEFB 'A'+$80
|
473 |
|
|
DEFM "RESTOR"
|
474 |
|
|
DEFB 'E'+$80
|
475 |
|
|
DEFM "NE"
|
476 |
|
|
DEFB 'W'+$80
|
477 |
|
|
DEFM "BORDE"
|
478 |
|
|
DEFB 'R'+$80
|
479 |
|
|
DEFM "CONTINU"
|
480 |
|
|
DEFB 'E'+$80
|
481 |
|
|
DEFM "DI"
|
482 |
|
|
DEFB 'M'+$80
|
483 |
|
|
DEFM "RE"
|
484 |
|
|
DEFB 'M'+$80
|
485 |
|
|
DEFM "FO"
|
486 |
|
|
DEFB 'R'+$80
|
487 |
|
|
DEFM "GO T"
|
488 |
|
|
DEFB 'O'+$80
|
489 |
|
|
DEFM "GO SU"
|
490 |
|
|
DEFB 'B'+$80
|
491 |
|
|
DEFM "INPU"
|
492 |
|
|
DEFB 'T'+$80
|
493 |
|
|
DEFM "LOA"
|
494 |
|
|
DEFB 'D'+$80
|
495 |
|
|
DEFM "LIS"
|
496 |
|
|
DEFB 'T'+$80
|
497 |
|
|
DEFM "LE"
|
498 |
|
|
DEFB 'T'+$80
|
499 |
|
|
DEFM "PAUS"
|
500 |
|
|
DEFB 'E'+$80
|
501 |
|
|
DEFM "NEX"
|
502 |
|
|
DEFB 'T'+$80
|
503 |
|
|
DEFM "POK"
|
504 |
|
|
DEFB 'E'+$80
|
505 |
|
|
DEFM "PRIN"
|
506 |
|
|
DEFB 'T'+$80
|
507 |
|
|
DEFM "PLO"
|
508 |
|
|
DEFB 'T'+$80
|
509 |
|
|
DEFM "RU"
|
510 |
|
|
DEFB 'N'+$80
|
511 |
|
|
DEFM "SAV"
|
512 |
|
|
DEFB 'E'+$80
|
513 |
|
|
DEFM "RANDOMIZ"
|
514 |
|
|
DEFB 'E'+$80
|
515 |
|
|
DEFB 'I','F'+$80
|
516 |
|
|
DEFM "CL"
|
517 |
|
|
DEFB 'S'+$80
|
518 |
|
|
DEFM "DRA"
|
519 |
|
|
DEFB 'W'+$80
|
520 |
|
|
DEFM "CLEA"
|
521 |
|
|
DEFB 'R'+$80
|
522 |
|
|
DEFM "RETUR"
|
523 |
|
|
DEFB 'N'+$80
|
524 |
|
|
DEFM "COP"
|
525 |
|
|
DEFB 'Y'+$80
|
526 |
|
|
|
527 |
|
|
; ----------------
|
528 |
|
|
; THE 'KEY' TABLES
|
529 |
|
|
; ----------------
|
530 |
|
|
; These six look-up tables are used by the keyboard reading routine
|
531 |
|
|
; to decode the key values.
|
532 |
|
|
;
|
533 |
|
|
; The first table contains the maps for the 39 keys of the standard
|
534 |
|
|
; 40-key Spectrum keyboard. The remaining key [SHIFT $27] is read directly.
|
535 |
|
|
; The keys consist of the 26 upper-case alphabetic characters, the 10 digit
|
536 |
|
|
; keys and the space, ENTER and symbol shift key.
|
537 |
|
|
; Unshifted alphabetic keys have $20 added to the value.
|
538 |
|
|
; The keywords for the main alphabetic keys are obtained by adding $A5 to
|
539 |
|
|
; the values obtained from this table.
|
540 |
|
|
|
541 |
|
|
;; MAIN-KEYS
|
542 |
|
|
L0205: DEFB $42 ; B
|
543 |
|
|
DEFB $48 ; H
|
544 |
|
|
DEFB $59 ; Y
|
545 |
|
|
DEFB $36 ; 6
|
546 |
|
|
DEFB $35 ; 5
|
547 |
|
|
DEFB $54 ; T
|
548 |
|
|
DEFB $47 ; G
|
549 |
|
|
DEFB $56 ; V
|
550 |
|
|
DEFB $4E ; N
|
551 |
|
|
DEFB $4A ; J
|
552 |
|
|
DEFB $55 ; U
|
553 |
|
|
DEFB $37 ; 7
|
554 |
|
|
DEFB $34 ; 4
|
555 |
|
|
DEFB $52 ; R
|
556 |
|
|
DEFB $46 ; F
|
557 |
|
|
DEFB $43 ; C
|
558 |
|
|
DEFB $4D ; M
|
559 |
|
|
DEFB $4B ; K
|
560 |
|
|
DEFB $49 ; I
|
561 |
|
|
DEFB $38 ; 8
|
562 |
|
|
DEFB $33 ; 3
|
563 |
|
|
DEFB $45 ; E
|
564 |
|
|
DEFB $44 ; D
|
565 |
|
|
DEFB $58 ; X
|
566 |
|
|
DEFB $0E ; SYMBOL SHIFT
|
567 |
|
|
DEFB $4C ; L
|
568 |
|
|
DEFB $4F ; O
|
569 |
|
|
DEFB $39 ; 9
|
570 |
|
|
DEFB $32 ; 2
|
571 |
|
|
DEFB $57 ; W
|
572 |
|
|
DEFB $53 ; S
|
573 |
|
|
DEFB $5A ; Z
|
574 |
|
|
DEFB $20 ; SPACE
|
575 |
|
|
DEFB $0D ; ENTER
|
576 |
|
|
DEFB $50 ; P
|
577 |
|
|
DEFB $30 ; 0
|
578 |
|
|
DEFB $31 ; 1
|
579 |
|
|
DEFB $51 ; Q
|
580 |
|
|
DEFB $41 ; A
|
581 |
|
|
|
582 |
|
|
|
583 |
|
|
;; E-UNSHIFT
|
584 |
|
|
; The 26 unshifted extended mode keys for the alphabetic characters.
|
585 |
|
|
; The green keywords on the original keyboard.
|
586 |
|
|
L022C: DEFB $E3 ; READ
|
587 |
|
|
DEFB $C4 ; BIN
|
588 |
|
|
DEFB $E0 ; LPRINT
|
589 |
|
|
DEFB $E4 ; DATA
|
590 |
|
|
DEFB $B4 ; TAN
|
591 |
|
|
DEFB $BC ; SGN
|
592 |
|
|
DEFB $BD ; ABS
|
593 |
|
|
DEFB $BB ; SQR
|
594 |
|
|
DEFB $AF ; CODE
|
595 |
|
|
DEFB $B0 ; VAL
|
596 |
|
|
DEFB $B1 ; LEN
|
597 |
|
|
DEFB $C0 ; USR
|
598 |
|
|
DEFB $A7 ; PI
|
599 |
|
|
DEFB $A6 ; INKEY$
|
600 |
|
|
DEFB $BE ; PEEK
|
601 |
|
|
DEFB $AD ; TAB
|
602 |
|
|
DEFB $B2 ; SIN
|
603 |
|
|
DEFB $BA ; INT
|
604 |
|
|
DEFB $E5 ; RESTORE
|
605 |
|
|
DEFB $A5 ; RND
|
606 |
|
|
DEFB $C2 ; CHR$
|
607 |
|
|
DEFB $E1 ; LLIST
|
608 |
|
|
DEFB $B3 ; COS
|
609 |
|
|
DEFB $B9 ; EXP
|
610 |
|
|
DEFB $C1 ; STR$
|
611 |
|
|
DEFB $B8 ; LN
|
612 |
|
|
|
613 |
|
|
|
614 |
|
|
;; EXT-SHIFT
|
615 |
|
|
; The 26 shifted extended mode keys for the alphabetic characters.
|
616 |
|
|
; The red keywords below keys on the original keyboard.
|
617 |
|
|
L0246: DEFB $7E ; ~
|
618 |
|
|
DEFB $DC ; BRIGHT
|
619 |
|
|
DEFB $DA ; PAPER
|
620 |
|
|
DEFB $5C ; \
|
621 |
|
|
DEFB $B7 ; ATN
|
622 |
|
|
DEFB $7B ; {
|
623 |
|
|
DEFB $7D ; }
|
624 |
|
|
DEFB $D8 ; CIRCLE
|
625 |
|
|
DEFB $BF ; IN
|
626 |
|
|
DEFB $AE ; VAL$
|
627 |
|
|
DEFB $AA ; SCREEN$
|
628 |
|
|
DEFB $AB ; ATTR
|
629 |
|
|
DEFB $DD ; INVERSE
|
630 |
|
|
DEFB $DE ; OVER
|
631 |
|
|
DEFB $DF ; OUT
|
632 |
|
|
DEFB $7F ; (Copyright character)
|
633 |
|
|
DEFB $B5 ; ASN
|
634 |
|
|
DEFB $D6 ; VERIFY
|
635 |
|
|
DEFB $7C ; |
|
636 |
|
|
DEFB $D5 ; MERGE
|
637 |
|
|
DEFB $5D ; ]
|
638 |
|
|
DEFB $DB ; FLASH
|
639 |
|
|
DEFB $B6 ; ACS
|
640 |
|
|
DEFB $D9 ; INK
|
641 |
|
|
DEFB $5B ; [
|
642 |
|
|
DEFB $D7 ; BEEP
|
643 |
|
|
|
644 |
|
|
|
645 |
|
|
;; CTL-CODES
|
646 |
|
|
; The ten control codes assigned to the top line of digits when the shift
|
647 |
|
|
; key is pressed.
|
648 |
|
|
L0260: DEFB $0C ; DELETE
|
649 |
|
|
DEFB $07 ; EDIT
|
650 |
|
|
DEFB $06 ; CAPS LOCK
|
651 |
|
|
DEFB $04 ; TRUE VIDEO
|
652 |
|
|
DEFB $05 ; INVERSE VIDEO
|
653 |
|
|
DEFB $08 ; CURSOR LEFT
|
654 |
|
|
DEFB $0A ; CURSOR DOWN
|
655 |
|
|
DEFB $0B ; CURSOR UP
|
656 |
|
|
DEFB $09 ; CURSOR RIGHT
|
657 |
|
|
DEFB $0F ; GRAPHICS
|
658 |
|
|
|
659 |
|
|
|
660 |
|
|
;; SYM-CODES
|
661 |
|
|
; The 26 red symbols assigned to the alphabetic characters of the keyboard.
|
662 |
|
|
; The ten single-character digit symbols are converted without the aid of
|
663 |
|
|
; a table using subtraction and minor manipulation.
|
664 |
|
|
L026A: DEFB $E2 ; STOP
|
665 |
|
|
DEFB $2A ; *
|
666 |
|
|
DEFB $3F ; ?
|
667 |
|
|
DEFB $CD ; STEP
|
668 |
|
|
DEFB $C8 ; >=
|
669 |
|
|
DEFB $CC ; TO
|
670 |
|
|
DEFB $CB ; THEN
|
671 |
|
|
DEFB $5E ; ^
|
672 |
|
|
DEFB $AC ; AT
|
673 |
|
|
DEFB $2D ; -
|
674 |
|
|
DEFB $2B ; +
|
675 |
|
|
DEFB $3D ; =
|
676 |
|
|
DEFB $2E ; .
|
677 |
|
|
DEFB $2C ; ,
|
678 |
|
|
DEFB $3B ; ;
|
679 |
|
|
DEFB $22 ; "
|
680 |
|
|
DEFB $C7 ; <=
|
681 |
|
|
DEFB $3C ; <
|
682 |
|
|
DEFB $C3 ; NOT
|
683 |
|
|
DEFB $3E ; >
|
684 |
|
|
DEFB $C5 ; OR
|
685 |
|
|
DEFB $2F ; /
|
686 |
|
|
DEFB $C9 ; <>
|
687 |
|
|
DEFB $60 ; pound
|
688 |
|
|
DEFB $C6 ; AND
|
689 |
|
|
DEFB $3A ; :
|
690 |
|
|
|
691 |
|
|
;; E-DIGITS
|
692 |
|
|
; The ten keywords assigned to the digits in extended mode.
|
693 |
|
|
; The remaining red keywords below the keys.
|
694 |
|
|
L0284: DEFB $D0 ; FORMAT
|
695 |
|
|
DEFB $CE ; DEF FN
|
696 |
|
|
DEFB $A8 ; FN
|
697 |
|
|
DEFB $CA ; LINE
|
698 |
|
|
DEFB $D3 ; OPEN #
|
699 |
|
|
DEFB $D4 ; CLOSE #
|
700 |
|
|
DEFB $D1 ; MOVE
|
701 |
|
|
DEFB $D2 ; ERASE
|
702 |
|
|
DEFB $A9 ; POINT
|
703 |
|
|
DEFB $CF ; CAT
|
704 |
|
|
|
705 |
|
|
|
706 |
|
|
;*******************************
|
707 |
|
|
;** Part 2. KEYBOARD ROUTINES **
|
708 |
|
|
;*******************************
|
709 |
|
|
|
710 |
|
|
; Using shift keys and a combination of modes the Spectrum 40-key keyboard
|
711 |
|
|
; can be mapped to 256 input characters
|
712 |
|
|
|
713 |
|
|
; ---------------------------------------------------------------------------
|
714 |
|
|
;
|
715 |
|
|
; 0 1 2 3 4 -Bits- 4 3 2 1 0
|
716 |
|
|
; PORT PORT
|
717 |
|
|
;
|
718 |
|
|
; F7FE [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ] | [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 0 ] EFFE
|
719 |
|
|
; ^ | v
|
720 |
|
|
; FBFE [ Q ] [ W ] [ E ] [ R ] [ T ] | [ Y ] [ U ] [ I ] [ O ] [ P ] DFFE
|
721 |
|
|
; ^ | v
|
722 |
|
|
; FDFE [ A ] [ S ] [ D ] [ F ] [ G ] | [ H ] [ J ] [ K ] [ L ] [ ENT ] BFFE
|
723 |
|
|
; ^ | v
|
724 |
|
|
; FEFE [SHI] [ Z ] [ X ] [ C ] [ V ] | [ B ] [ N ] [ M ] [sym] [ SPC ] 7FFE
|
725 |
|
|
; ^ $27 $18 v
|
726 |
|
|
; Start End
|
727 |
|
|
; 00100111 00011000
|
728 |
|
|
;
|
729 |
|
|
; ---------------------------------------------------------------------------
|
730 |
|
|
; The above map may help in reading.
|
731 |
|
|
; The neat arrangement of ports means that the B register need only be
|
732 |
|
|
; rotated left to work up the left hand side and then down the right
|
733 |
|
|
; hand side of the keyboard. When the reset bit drops into the carry
|
734 |
|
|
; then all 8 half-rows have been read. Shift is the first key to be
|
735 |
|
|
; read. The lower six bits of the shifts are unambiguous.
|
736 |
|
|
|
737 |
|
|
; -------------------------------
|
738 |
|
|
; THE 'KEYBOARD SCANNING' ROUTINE
|
739 |
|
|
; -------------------------------
|
740 |
|
|
; From keyboard and s-inkey$
|
741 |
|
|
; Returns 1 or 2 keys in DE, most significant shift first if any
|
742 |
|
|
; key values 0-39 else 255
|
743 |
|
|
|
744 |
|
|
;; KEY-SCAN
|
745 |
|
|
L028E: LD L,$2F ; initial key value
|
746 |
|
|
; valid values are obtained by subtracting
|
747 |
|
|
; eight five times.
|
748 |
|
|
LD DE,$FFFF ; a buffer to receive 2 keys.
|
749 |
|
|
|
750 |
|
|
LD BC,$FEFE ; the commencing port address
|
751 |
|
|
; B holds 11111110 initially and is also
|
752 |
|
|
; used to count the 8 half-rows
|
753 |
|
|
;; KEY-LINE
|
754 |
|
|
L0296: IN A,(C) ; read the port to A - bits will be reset
|
755 |
|
|
; if a key is pressed else set.
|
756 |
|
|
CPL ; complement - pressed key-bits are now set
|
757 |
|
|
AND $1F ; apply 00011111 mask to pick up the
|
758 |
|
|
; relevant set bits.
|
759 |
|
|
|
760 |
|
|
JR Z,L02AB ; forward to KEY-DONE if zero and therefore
|
761 |
|
|
; no keys pressed in row at all.
|
762 |
|
|
|
763 |
|
|
LD H,A ; transfer row bits to H
|
764 |
|
|
LD A,L ; load the initial key value to A
|
765 |
|
|
|
766 |
|
|
;; KEY-3KEYS
|
767 |
|
|
L029F: INC D ; now test the key buffer
|
768 |
|
|
RET NZ ; if we have collected 2 keys already
|
769 |
|
|
; then too many so quit.
|
770 |
|
|
|
771 |
|
|
;; KEY-BITS
|
772 |
|
|
L02A1: SUB $08 ; subtract 8 from the key value
|
773 |
|
|
; cycling through key values (top = $27)
|
774 |
|
|
; e.g. 2F> 27>1F>17>0F>07
|
775 |
|
|
; 2E> 26>1E>16>0E>06
|
776 |
|
|
SRL H ; shift key bits right into carry.
|
777 |
|
|
JR NC,L02A1 ; back to KEY-BITS if not pressed
|
778 |
|
|
; but if pressed we have a value (0-39d)
|
779 |
|
|
|
780 |
|
|
LD D,E ; transfer a possible previous key to D
|
781 |
|
|
LD E,A ; transfer the new key to E
|
782 |
|
|
JR NZ,L029F ; back to KEY-3KEYS if there were more
|
783 |
|
|
; set bits - H was not yet zero.
|
784 |
|
|
|
785 |
|
|
;; KEY-DONE
|
786 |
|
|
L02AB: DEC L ; cycles 2F>2E>2D>2C>2B>2A>29>28 for
|
787 |
|
|
; each half-row.
|
788 |
|
|
RLC B ; form next port address e.g. FEFE > FDFE
|
789 |
|
|
JR C,L0296 ; back to KEY-LINE if still more rows to do.
|
790 |
|
|
|
791 |
|
|
LD A,D ; now test if D is still FF ?
|
792 |
|
|
INC A ; if it is zero we have at most 1 key
|
793 |
|
|
; range now $01-$28 (1-40d)
|
794 |
|
|
RET Z ; return if one key or no key.
|
795 |
|
|
|
796 |
|
|
CP $28 ; is it capsshift (was $27) ?
|
797 |
|
|
RET Z ; return if so.
|
798 |
|
|
|
799 |
|
|
CP $19 ; is it symbol shift (was $18) ?
|
800 |
|
|
RET Z ; return also
|
801 |
|
|
|
802 |
|
|
LD A,E ; now test E
|
803 |
|
|
LD E,D ; but first switch
|
804 |
|
|
LD D,A ; the two keys.
|
805 |
|
|
CP $18 ; is it symbol shift ?
|
806 |
|
|
RET ; return (with zero set if it was).
|
807 |
|
|
; but with symbol shift now in D
|
808 |
|
|
|
809 |
|
|
; ----------------------
|
810 |
|
|
; THE 'KEYBOARD' ROUTINE
|
811 |
|
|
; ----------------------
|
812 |
|
|
; Called from the interrupt 50 times a second.
|
813 |
|
|
;
|
814 |
|
|
|
815 |
|
|
;; KEYBOARD
|
816 |
|
|
L02BF: CALL L028E ; routine KEY-SCAN
|
817 |
|
|
RET NZ ; return if invalid combinations
|
818 |
|
|
|
819 |
|
|
; then decrease the counters within the two key-state maps
|
820 |
|
|
; as this could cause one to become free.
|
821 |
|
|
; if the keyboard has not been pressed during the last five interrupts
|
822 |
|
|
; then both sets will be free.
|
823 |
|
|
|
824 |
|
|
|
825 |
|
|
LD HL,$5C00 ; point to KSTATE-0
|
826 |
|
|
|
827 |
|
|
;; K-ST-LOOP
|
828 |
|
|
L02C6: BIT 7,(HL) ; is it free ? (i.e. $FF)
|
829 |
|
|
JR NZ,L02D1 ; forward to K-CH-SET if so
|
830 |
|
|
|
831 |
|
|
INC HL ; address the 5-counter
|
832 |
|
|
DEC (HL) ; decrease the counter
|
833 |
|
|
DEC HL ; step back
|
834 |
|
|
|
835 |
|
|
JR NZ,L02D1 ; forward to K-CH-SET if not at end of count
|
836 |
|
|
|
837 |
|
|
LD (HL),$FF ; else mark this particular map free.
|
838 |
|
|
|
839 |
|
|
;; K-CH-SET
|
840 |
|
|
L02D1: LD A,L ; make a copy of the low address byte.
|
841 |
|
|
LD HL,$5C04 ; point to KSTATE-4
|
842 |
|
|
; (ld l,$04 would do)
|
843 |
|
|
CP L ; have both sets been considered ?
|
844 |
|
|
JR NZ,L02C6 ; back to K-ST-LOOP to consider this 2nd set
|
845 |
|
|
|
846 |
|
|
; now the raw key (0-38d) is converted to a main key (uppercase).
|
847 |
|
|
|
848 |
|
|
CALL L031E ; routine K-TEST to get main key in A
|
849 |
|
|
|
850 |
|
|
RET NC ; return if just a single shift
|
851 |
|
|
|
852 |
|
|
LD HL,$5C00 ; point to KSTATE-0
|
853 |
|
|
CP (HL) ; does the main key code match ?
|
854 |
|
|
JR Z,L0310 ; forward to K-REPEAT if so
|
855 |
|
|
|
856 |
|
|
; if not consider the second key map.
|
857 |
|
|
|
858 |
|
|
EX DE,HL ; save kstate-0 in de
|
859 |
|
|
LD HL,$5C04 ; point to KSTATE-4
|
860 |
|
|
CP (HL) ; does the main key code match ?
|
861 |
|
|
JR Z,L0310 ; forward to K-REPEAT if so
|
862 |
|
|
|
863 |
|
|
; having excluded a repeating key we can now consider a new key.
|
864 |
|
|
; the second set is always examined before the first.
|
865 |
|
|
|
866 |
|
|
BIT 7,(HL) ; is the key map free ?
|
867 |
|
|
JR NZ,L02F1 ; forward to K-NEW if so.
|
868 |
|
|
|
869 |
|
|
EX DE,HL ; bring back KSTATE-0
|
870 |
|
|
BIT 7,(HL) ; is it free ?
|
871 |
|
|
RET Z ; return if not.
|
872 |
|
|
; as we have a key but nowhere to put it yet.
|
873 |
|
|
|
874 |
|
|
; continue or jump to here if one of the buffers was free.
|
875 |
|
|
|
876 |
|
|
;; K-NEW
|
877 |
|
|
L02F1: LD E,A ; store key in E
|
878 |
|
|
LD (HL),A ; place in free location
|
879 |
|
|
INC HL ; advance to the interrupt counter
|
880 |
|
|
LD (HL),$05 ; and initialize counter to 5
|
881 |
|
|
INC HL ; advance to the delay
|
882 |
|
|
LD A,($5C09) ; pick up the system variable REPDEL
|
883 |
|
|
LD (HL),A ; and insert that for first repeat delay.
|
884 |
|
|
INC HL ; advance to last location of state map.
|
885 |
|
|
|
886 |
|
|
LD C,(IY+$07) ; pick up MODE (3 bytes)
|
887 |
|
|
LD D,(IY+$01) ; pick up FLAGS (3 bytes)
|
888 |
|
|
PUSH HL ; save state map location
|
889 |
|
|
; Note. could now have used, to avoid IY,
|
890 |
|
|
; ld l,$41; ld c,(hl); ld l,$3B; ld d,(hl).
|
891 |
|
|
; six and two threes of course.
|
892 |
|
|
|
893 |
|
|
CALL L0333 ; routine K-DECODE
|
894 |
|
|
|
895 |
|
|
POP HL ; restore map pointer
|
896 |
|
|
LD (HL),A ; put the decoded key in last location of map.
|
897 |
|
|
|
898 |
|
|
;; K-END
|
899 |
|
|
L0308: LD ($5C08),A ; update LASTK system variable.
|
900 |
|
|
SET 5,(IY+$01) ; update FLAGS - signal a new key.
|
901 |
|
|
RET ; return to interrupt routine.
|
902 |
|
|
|
903 |
|
|
; -----------------------
|
904 |
|
|
; THE 'REPEAT KEY' BRANCH
|
905 |
|
|
; -----------------------
|
906 |
|
|
; A possible repeat has been identified. HL addresses the raw key.
|
907 |
|
|
; The last location of the key map holds the decoded key from the first
|
908 |
|
|
; context. This could be a keyword and, with the exception of NOT a repeat
|
909 |
|
|
; is syntactically incorrect and not really desirable.
|
910 |
|
|
|
911 |
|
|
;; K-REPEAT
|
912 |
|
|
L0310: INC HL ; increment the map pointer to second location.
|
913 |
|
|
LD (HL),$05 ; maintain interrupt counter at 5.
|
914 |
|
|
INC HL ; now point to third location.
|
915 |
|
|
DEC (HL) ; decrease the REPDEL value which is used to
|
916 |
|
|
; time the delay of a repeat key.
|
917 |
|
|
|
918 |
|
|
RET NZ ; return if not yet zero.
|
919 |
|
|
|
920 |
|
|
LD A,($5C0A) ; fetch the system variable value REPPER.
|
921 |
|
|
LD (HL),A ; for subsequent repeats REPPER will be used.
|
922 |
|
|
|
923 |
|
|
INC HL ; advance
|
924 |
|
|
;
|
925 |
|
|
LD A,(HL) ; pick up the key decoded possibly in another
|
926 |
|
|
; context.
|
927 |
|
|
; Note. should compare with $A5 (RND) and make
|
928 |
|
|
; a simple return if this is a keyword.
|
929 |
|
|
; e.g. cp $a5; ret nc; (3 extra bytes)
|
930 |
|
|
JR L0308 ; back to K-END
|
931 |
|
|
|
932 |
|
|
; ----------------------
|
933 |
|
|
; THE 'KEY-TEST' ROUTINE
|
934 |
|
|
; ----------------------
|
935 |
|
|
; also called from s-inkey$
|
936 |
|
|
; begin by testing for a shift with no other.
|
937 |
|
|
|
938 |
|
|
;; K-TEST
|
939 |
|
|
L031E: LD B,D ; load most significant key to B
|
940 |
|
|
; will be $FF if not shift.
|
941 |
|
|
LD D,$00 ; and reset D to index into main table
|
942 |
|
|
LD A,E ; load least significant key from E
|
943 |
|
|
CP $27 ; is it higher than 39d i.e. FF
|
944 |
|
|
RET NC ; return with just a shift (in B now)
|
945 |
|
|
|
946 |
|
|
CP $18 ; is it symbol shift ?
|
947 |
|
|
JR NZ,L032C ; forward to K-MAIN if not
|
948 |
|
|
|
949 |
|
|
; but we could have just symbol shift and no other
|
950 |
|
|
|
951 |
|
|
BIT 7,B ; is other key $FF (ie not shift)
|
952 |
|
|
RET NZ ; return with solitary symbol shift
|
953 |
|
|
|
954 |
|
|
|
955 |
|
|
;; K-MAIN
|
956 |
|
|
L032C: LD HL,L0205 ; address: MAIN-KEYS
|
957 |
|
|
ADD HL,DE ; add offset 0-38
|
958 |
|
|
LD A,(HL) ; pick up main key value
|
959 |
|
|
SCF ; set carry flag
|
960 |
|
|
RET ; return (B has other key still)
|
961 |
|
|
|
962 |
|
|
; ----------------------------------
|
963 |
|
|
; THE 'KEYBOARD DECODING' SUBROUTINE
|
964 |
|
|
; ----------------------------------
|
965 |
|
|
; also called from s-inkey$
|
966 |
|
|
|
967 |
|
|
;; K-DECODE
|
968 |
|
|
L0333: LD A,E ; pick up the stored main key
|
969 |
|
|
CP $3A ; an arbitrary point between digits and letters
|
970 |
|
|
JR C,L0367 ; forward to K-DIGIT with digits, space, enter.
|
971 |
|
|
|
972 |
|
|
DEC C ; decrease MODE ( 0='KLC', 1='E', 2='G')
|
973 |
|
|
|
974 |
|
|
JP M,L034F ; to K-KLC-LET if was zero
|
975 |
|
|
|
976 |
|
|
JR Z,L0341 ; to K-E-LET if was 1 for extended letters.
|
977 |
|
|
|
978 |
|
|
; proceed with graphic codes.
|
979 |
|
|
; Note. should selectively drop return address if code > 'U' ($55).
|
980 |
|
|
; i.e. abort the KEYBOARD call.
|
981 |
|
|
; e.g. cp 'V'; jr c,addit; pop af ;pop af ;;addit etc. (6 extra bytes).
|
982 |
|
|
; (s-inkey$ never gets into graphics mode.)
|
983 |
|
|
|
984 |
|
|
;; addit
|
985 |
|
|
ADD A,$4F ; add offset to augment 'A' to graphics A say.
|
986 |
|
|
RET ; return.
|
987 |
|
|
; Note. ( but [GRAPH] V gives RND, etc ).
|
988 |
|
|
|
989 |
|
|
; ---
|
990 |
|
|
|
991 |
|
|
; the jump was to here with extended mode with uppercase A-Z.
|
992 |
|
|
|
993 |
|
|
;; K-E-LET
|
994 |
|
|
L0341: LD HL,L022C-$41 ; base address of E-UNSHIFT L022c.
|
995 |
|
|
; ( $01EB in standard ROM ).
|
996 |
|
|
INC B ; test B is it empty i.e. not a shift.
|
997 |
|
|
JR Z,L034A ; forward to K-LOOK-UP if neither shift.
|
998 |
|
|
|
999 |
|
|
LD HL,L0246-$41 ; Address: $0205 L0246-$41 EXT-SHIFT base
|
1000 |
|
|
|
1001 |
|
|
;; K-LOOK-UP
|
1002 |
|
|
L034A: LD D,$00 ; prepare to index.
|
1003 |
|
|
ADD HL,DE ; add the main key value.
|
1004 |
|
|
LD A,(HL) ; pick up other mode value.
|
1005 |
|
|
RET ; return.
|
1006 |
|
|
|
1007 |
|
|
; ---
|
1008 |
|
|
|
1009 |
|
|
; the jump was here with mode = 0
|
1010 |
|
|
|
1011 |
|
|
;; K-KLC-LET
|
1012 |
|
|
L034F: LD HL,L026A-$41 ; prepare base of sym-codes
|
1013 |
|
|
BIT 0,B ; shift=$27 sym-shift=$18
|
1014 |
|
|
JR Z,L034A ; back to K-LOOK-UP with symbol-shift
|
1015 |
|
|
|
1016 |
|
|
BIT 3,D ; test FLAGS is it 'K' mode (from OUT-CURS)
|
1017 |
|
|
JR Z,L0364 ; skip to K-TOKENS if so
|
1018 |
|
|
|
1019 |
|
|
BIT 3,(IY+$30) ; test FLAGS2 - consider CAPS LOCK ?
|
1020 |
|
|
RET NZ ; return if so with main code.
|
1021 |
|
|
|
1022 |
|
|
INC B ; is shift being pressed ?
|
1023 |
|
|
; result zero if not
|
1024 |
|
|
RET NZ ; return if shift pressed.
|
1025 |
|
|
|
1026 |
|
|
ADD A,$20 ; else convert the code to lower case.
|
1027 |
|
|
RET ; return.
|
1028 |
|
|
|
1029 |
|
|
; ---
|
1030 |
|
|
|
1031 |
|
|
; the jump was here for tokens
|
1032 |
|
|
|
1033 |
|
|
;; K-TOKENS
|
1034 |
|
|
L0364: ADD A,$A5 ; add offset to main code so that 'A'
|
1035 |
|
|
; becomes 'NEW' etc.
|
1036 |
|
|
|
1037 |
|
|
RET ; return.
|
1038 |
|
|
|
1039 |
|
|
; ---
|
1040 |
|
|
|
1041 |
|
|
; the jump was here with digits, space, enter and symbol shift (< $xx)
|
1042 |
|
|
|
1043 |
|
|
;; K-DIGIT
|
1044 |
|
|
L0367: CP $30 ; is it '0' or higher ?
|
1045 |
|
|
RET C ; return with space, enter and symbol-shift
|
1046 |
|
|
|
1047 |
|
|
DEC C ; test MODE (was 0='KLC', 1='E', 2='G')
|
1048 |
|
|
JP M,L039D ; jump to K-KLC-DGT if was 0.
|
1049 |
|
|
|
1050 |
|
|
JR NZ,L0389 ; forward to K-GRA-DGT if mode was 2.
|
1051 |
|
|
|
1052 |
|
|
; continue with extended digits 0-9.
|
1053 |
|
|
|
1054 |
|
|
LD HL,L0284-$30 ; $0254 - base of E-DIGITS
|
1055 |
|
|
BIT 5,B ; test - shift=$27 sym-shift=$18
|
1056 |
|
|
JR Z,L034A ; to K-LOOK-UP if sym-shift
|
1057 |
|
|
|
1058 |
|
|
CP $38 ; is character '8' ?
|
1059 |
|
|
JR NC,L0382 ; to K-8-&-9 if greater than '7'
|
1060 |
|
|
|
1061 |
|
|
SUB $20 ; reduce to ink range $10-$17
|
1062 |
|
|
INC B ; shift ?
|
1063 |
|
|
RET Z ; return if not.
|
1064 |
|
|
|
1065 |
|
|
ADD A,$08 ; add 8 to give paper range $18 - $1F
|
1066 |
|
|
RET ; return
|
1067 |
|
|
|
1068 |
|
|
; ---
|
1069 |
|
|
|
1070 |
|
|
; 89
|
1071 |
|
|
|
1072 |
|
|
;; K-8-&-9
|
1073 |
|
|
L0382: SUB $36 ; reduce to 02 and 03 bright codes
|
1074 |
|
|
INC B ; test if shift pressed.
|
1075 |
|
|
RET Z ; return if not.
|
1076 |
|
|
|
1077 |
|
|
ADD A,$FE ; subtract 2 setting carry
|
1078 |
|
|
RET ; to give 0 and 1 flash codes.
|
1079 |
|
|
|
1080 |
|
|
; ---
|
1081 |
|
|
|
1082 |
|
|
; graphics mode with digits
|
1083 |
|
|
|
1084 |
|
|
;; K-GRA-DGT
|
1085 |
|
|
L0389: LD HL,L0260-$30 ; $0230 base address of CTL-CODES
|
1086 |
|
|
|
1087 |
|
|
CP $39 ; is key '9' ?
|
1088 |
|
|
JR Z,L034A ; back to K-LOOK-UP - changed to $0F, GRAPHICS.
|
1089 |
|
|
|
1090 |
|
|
CP $30 ; is key '0' ?
|
1091 |
|
|
JR Z,L034A ; back to K-LOOK-UP - changed to $0C, delete.
|
1092 |
|
|
|
1093 |
|
|
; for keys '0' - '7' we assign a mosaic character depending on shift.
|
1094 |
|
|
|
1095 |
|
|
AND $07 ; convert character to number. 0 - 7.
|
1096 |
|
|
ADD A,$80 ; add offset - they start at $80
|
1097 |
|
|
|
1098 |
|
|
INC B ; destructively test for shift
|
1099 |
|
|
RET Z ; and return if not pressed.
|
1100 |
|
|
|
1101 |
|
|
XOR $0F ; toggle bits becomes range $88-$8F
|
1102 |
|
|
RET ; return.
|
1103 |
|
|
|
1104 |
|
|
; ---
|
1105 |
|
|
|
1106 |
|
|
; now digits in 'KLC' mode
|
1107 |
|
|
|
1108 |
|
|
;; K-KLC-DGT
|
1109 |
|
|
L039D: INC B ; return with digit codes if neither
|
1110 |
|
|
RET Z ; shift key pressed.
|
1111 |
|
|
|
1112 |
|
|
BIT 5,B ; test for caps shift.
|
1113 |
|
|
|
1114 |
|
|
LD HL,L0260-$30 ; prepare base of table CTL-CODES.
|
1115 |
|
|
JR NZ,L034A ; back to K-LOOK-UP if shift pressed.
|
1116 |
|
|
|
1117 |
|
|
; must have been symbol shift
|
1118 |
|
|
|
1119 |
|
|
SUB $10 ; for ASCII most will now be correct
|
1120 |
|
|
; on a standard typewriter.
|
1121 |
|
|
|
1122 |
|
|
CP $22 ; but '@' is not - see below.
|
1123 |
|
|
JR Z,L03B2 ; forward to K-@-CHAR if so
|
1124 |
|
|
|
1125 |
|
|
CP $20 ; '_' is the other one that fails
|
1126 |
|
|
RET NZ ; return if not.
|
1127 |
|
|
|
1128 |
|
|
LD A,$5F ; substitute ASCII '_'
|
1129 |
|
|
RET ; return.
|
1130 |
|
|
|
1131 |
|
|
; ---
|
1132 |
|
|
|
1133 |
|
|
;; K-@-CHAR
|
1134 |
|
|
L03B2: LD A,$40 ; substitute ASCII '@'
|
1135 |
|
|
RET ; return.
|
1136 |
|
|
|
1137 |
|
|
|
1138 |
|
|
; ------------------------------------------------------------------------
|
1139 |
|
|
; The Spectrum Input character keys. One or two are abbreviated.
|
1140 |
|
|
; From $00 Flash 0 to $FF COPY. The routine above has decoded all these.
|
1141 |
|
|
|
1142 |
|
|
; | 00 Fl0| 01 Fl1| 02 Br0| 03 Br1| 04 In0| 05 In1| 06 CAP| 07 EDT|
|
1143 |
|
|
; | 08 LFT| 09 RIG| 0A DWN| 0B UP | 0C DEL| 0D ENT| 0E SYM| 0F GRA|
|
1144 |
|
|
; | 10 Ik0| 11 Ik1| 12 Ik2| 13 Ik3| 14 Ik4| 15 Ik5| 16 Ik6| 17 Ik7|
|
1145 |
|
|
; | 18 Pa0| 19 Pa1| 1A Pa2| 1B Pa3| 1C Pa4| 1D Pa5| 1E Pa6| 1F Pa7|
|
1146 |
|
|
; | 20 SP | 21 ! | 22 " | 23 # | 24 $ | 25 % | 26 & | 27 ' |
|
1147 |
|
|
; | 28 ( | 29 ) | 2A * | 2B + | 2C , | 2D - | 2E . | 2F / |
|
1148 |
|
|
; | 30 0 | 31 1 | 32 2 | 33 3 | 34 4 | 35 5 | 36 6 | 37 7 |
|
1149 |
|
|
; | 38 8 | 39 9 | 3A : | 3B ; | 3C < | 3D = | 3E > | 3F ? |
|
1150 |
|
|
; | 40 @ | 41 A | 42 B | 43 C | 44 D | 45 E | 46 F | 47 G |
|
1151 |
|
|
; | 48 H | 49 I | 4A J | 4B K | 4C L | 4D M | 4E N | 4F O |
|
1152 |
|
|
; | 50 P | 51 Q | 52 R | 53 S | 54 T | 55 U | 56 V | 57 W |
|
1153 |
|
|
; | 58 X | 59 Y | 5A Z | 5B [ | 5C \ | 5D ] | 5E ^ | 5F _ |
|
1154 |
|
|
; | 60 £ | 61 a | 62 b | 63 c | 64 d | 65 e | 66 f | 67 g |
|
1155 |
|
|
; | 68 h | 69 i | 6A j | 6B k | 6C l | 6D m | 6E n | 6F o |
|
1156 |
|
|
; | 70 p | 71 q | 72 r | 73 s | 74 t | 75 u | 76 v | 77 w |
|
1157 |
|
|
; | 78 x | 79 y | 7A z | 7B { | 7C | | 7D } | 7E ~ | 7F © |
|
1158 |
|
|
; | 80 128| 81 129| 82 130| 83 131| 84 132| 85 133| 86 134| 87 135|
|
1159 |
|
|
; | 88 136| 89 137| 8A 138| 8B 139| 8C 140| 8D 141| 8E 142| 8F 143|
|
1160 |
|
|
; | 90 [A]| 91 [B]| 92 [C]| 93 [D]| 94 [E]| 95 [F]| 96 [G]| 97 [H]|
|
1161 |
|
|
; | 98 [I]| 99 [J]| 9A [K]| 9B [L]| 9C [M]| 9D [N]| 9E [O]| 9F [P]|
|
1162 |
|
|
; | A0 [Q]| A1 [R]| A2 [S]| A3 [T]| A4 [U]| A5 RND| A6 IK$| A7 PI |
|
1163 |
|
|
; | A8 FN | A9 PNT| AA SC$| AB ATT| AC AT | AD TAB| AE VL$| AF COD|
|
1164 |
|
|
; | B0 VAL| B1 LEN| B2 SIN| B3 COS| B4 TAN| B5 ASN| B6 ACS| B7 ATN|
|
1165 |
|
|
; | B8 LN | B9 EXP| BA INT| BB SQR| BC SGN| BD ABS| BE PEK| BF IN |
|
1166 |
|
|
; | C0 USR| C1 ST$| C2 CH$| C3 NOT| C4 BIN| C5 OR | C6 AND| C7 <= |
|
1167 |
|
|
; | C8 >= | C9 <> | CA LIN| CB THN| CC TO | CD STP| CE DEF| CF CAT|
|
1168 |
|
|
; | D0 FMT| D1 MOV| D2 ERS| D3 OPN| D4 CLO| D5 MRG| D6 VFY| D7 BEP|
|
1169 |
|
|
; | D8 CIR| D9 INK| DA PAP| DB FLA| DC BRI| DD INV| DE OVR| DF OUT|
|
1170 |
|
|
; | E0 LPR| E1 LLI| E2 STP| E3 REA| E4 DAT| E5 RES| E6 NEW| E7 BDR|
|
1171 |
|
|
; | E8 CON| E9 DIM| EA REM| EB FOR| EC GTO| ED GSB| EE INP| EF LOA|
|
1172 |
|
|
; | F0 LIS| F1 LET| F2 PAU| F3 NXT| F4 POK| F5 PRI| F6 PLO| F7 RUN|
|
1173 |
|
|
; | F8 SAV| F9 RAN| FA IF | FB CLS| FC DRW| FD CLR| FE RET| FF CPY|
|
1174 |
|
|
|
1175 |
|
|
; Note that for simplicity, Sinclair have located all the control codes
|
1176 |
|
|
; below the space character.
|
1177 |
|
|
; ASCII DEL, $7F, has been made a copyright symbol.
|
1178 |
|
|
; Also $60, '`', not used in BASIC but used in other languages, has been
|
1179 |
|
|
; allocated the local currency symbol for the relevant country -
|
1180 |
|
|
; £ in most Spectrums.
|
1181 |
|
|
|
1182 |
|
|
; ------------------------------------------------------------------------
|
1183 |
|
|
|
1184 |
|
|
|
1185 |
|
|
;**********************************
|
1186 |
|
|
;** Part 3. LOUDSPEAKER ROUTINES **
|
1187 |
|
|
;**********************************
|
1188 |
|
|
|
1189 |
|
|
; Documented by Alvin Albrecht.
|
1190 |
|
|
|
1191 |
|
|
; ------------------------------
|
1192 |
|
|
; Routine to control loudspeaker
|
1193 |
|
|
; ------------------------------
|
1194 |
|
|
; Outputs a square wave of given duration and frequency
|
1195 |
|
|
; to the loudspeaker.
|
1196 |
|
|
; Enter with: DE = #cycles - 1
|
1197 |
|
|
; HL = tone period as described next
|
1198 |
|
|
;
|
1199 |
|
|
; The tone period is measured in T states and consists of
|
1200 |
|
|
; three parts: a coarse part (H register), a medium part
|
1201 |
|
|
; (bits 7..2 of L) and a fine part (bits 1..0 of L) which
|
1202 |
|
|
; contribute to the waveform timing as follows:
|
1203 |
|
|
;
|
1204 |
|
|
; coarse medium fine
|
1205 |
|
|
; duration of low = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3)
|
1206 |
|
|
; duration of hi = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3)
|
1207 |
|
|
; Tp = tone period = 236 + 2048*H + 32*(L>>2) + 8*(L&0x3)
|
1208 |
|
|
; = 236 + 2048*H + 8*L = 236 + 8*HL
|
1209 |
|
|
;
|
1210 |
|
|
; As an example, to output five seconds of middle C (261.624 Hz):
|
1211 |
|
|
; (a) Tone period = 1/261.624 = 3.822ms
|
1212 |
|
|
; (b) Tone period in T-States = 3.822ms*fCPU = 13378
|
1213 |
|
|
; where fCPU = clock frequency of the CPU = 3.5MHz
|
1214 |
|
|
; © Find H and L for desired tone period:
|
1215 |
|
|
; HL = (Tp - 236) / 8 = (13378 - 236) / 8 = 1643 = 0x066B
|
1216 |
|
|
; (d) Tone duration in cycles = 5s/3.822ms = 1308 cycles
|
1217 |
|
|
; DE = 1308 - 1 = 0x051B
|
1218 |
|
|
;
|
1219 |
|
|
; The resulting waveform has a duty ratio of exactly 50%.
|
1220 |
|
|
;
|
1221 |
|
|
;
|
1222 |
|
|
;; BEEPER
|
1223 |
|
|
L03B5: DI ; Disable Interrupts so they don't disturb timing
|
1224 |
|
|
LD A,L ;
|
1225 |
|
|
SRL L ;
|
1226 |
|
|
SRL L ; L = medium part of tone period
|
1227 |
|
|
CPL ;
|
1228 |
|
|
AND $03 ; A = 3 - fine part of tone period
|
1229 |
|
|
LD C,A ;
|
1230 |
|
|
LD B,$00 ;
|
1231 |
|
|
LD IX,L03D1 ; Address: BE-IX+3
|
1232 |
|
|
ADD IX,BC ; IX holds address of entry into the loop
|
1233 |
|
|
; the loop will contain 0-3 NOPs, implementing
|
1234 |
|
|
; the fine part of the tone period.
|
1235 |
|
|
LD A,($5C48) ; BORDCR
|
1236 |
|
|
AND $38 ; bits 5..3 contain border colour
|
1237 |
|
|
RRCA ; border colour bits moved to 2..0
|
1238 |
|
|
RRCA ; to match border bits on port #FE
|
1239 |
|
|
RRCA ;
|
1240 |
|
|
OR $08 ; bit 3 set (tape output bit on port #FE)
|
1241 |
|
|
; for loud sound output
|
1242 |
|
|
;; BE-IX+3
|
1243 |
|
|
L03D1: NOP ;(4) ; optionally executed NOPs for small
|
1244 |
|
|
; adjustments to tone period
|
1245 |
|
|
;; BE-IX+2
|
1246 |
|
|
L03D2: NOP ;(4) ;
|
1247 |
|
|
|
1248 |
|
|
;; BE-IX+1
|
1249 |
|
|
L03D3: NOP ;(4) ;
|
1250 |
|
|
|
1251 |
|
|
;; BE-IX+0
|
1252 |
|
|
L03D4: INC B ;(4) ;
|
1253 |
|
|
INC C ;(4) ;
|
1254 |
|
|
|
1255 |
|
|
;; BE-H&L-LP
|
1256 |
|
|
L03D6: DEC C ;(4) ; timing loop for duration of
|
1257 |
|
|
JR NZ,L03D6 ;(12/7); high or low pulse of waveform
|
1258 |
|
|
|
1259 |
|
|
LD C,$3F ;(7) ;
|
1260 |
|
|
DEC B ;(4) ;
|
1261 |
|
|
JP NZ,L03D6 ;(10) ; to BE-H&L-LP
|
1262 |
|
|
|
1263 |
|
|
XOR $10 ;(7) ; toggle output beep bit
|
1264 |
|
|
OUT ($FE),A ;(11) ; output pulse
|
1265 |
|
|
LD B,H ;(4) ; B = coarse part of tone period
|
1266 |
|
|
LD C,A ;(4) ; save port #FE output byte
|
1267 |
|
|
BIT 4,A ;(8) ; if new output bit is high, go
|
1268 |
|
|
JR NZ,L03F2 ;(12/7); to BE-AGAIN
|
1269 |
|
|
|
1270 |
|
|
LD A,D ;(4) ; one cycle of waveform has completed
|
1271 |
|
|
OR E ;(4) ; (low->low). if cycle countdown = 0
|
1272 |
|
|
JR Z,L03F6 ;(12/7); go to BE-END
|
1273 |
|
|
|
1274 |
|
|
LD A,C ;(4) ; restore output byte for port #FE
|
1275 |
|
|
LD C,L ;(4) ; C = medium part of tone period
|
1276 |
|
|
DEC DE ;(6) ; decrement cycle count
|
1277 |
|
|
JP (IX) ;(8) ; do another cycle
|
1278 |
|
|
|
1279 |
|
|
;; BE-AGAIN ; halfway through cycle
|
1280 |
|
|
L03F2: LD C,L ;(4) ; C = medium part of tone period
|
1281 |
|
|
INC C ;(4) ; adds 16 cycles to make duration of high = duration of low
|
1282 |
|
|
JP (IX) ;(8) ; do high pulse of tone
|
1283 |
|
|
|
1284 |
|
|
;; BE-END
|
1285 |
|
|
L03F6: EI ; Enable Interrupts
|
1286 |
|
|
RET ;
|
1287 |
|
|
|
1288 |
|
|
|
1289 |
|
|
; ------------------
|
1290 |
|
|
; THE 'BEEP' COMMAND
|
1291 |
|
|
; ------------------
|
1292 |
|
|
; BASIC interface to BEEPER subroutine.
|
1293 |
|
|
; Invoked in BASIC with:
|
1294 |
|
|
; BEEP dur, pitch
|
1295 |
|
|
; where dur = duration in seconds
|
1296 |
|
|
; pitch = # of semitones above/below middle C
|
1297 |
|
|
;
|
1298 |
|
|
; Enter with: pitch on top of calculator stack
|
1299 |
|
|
; duration next on calculator stack
|
1300 |
|
|
;
|
1301 |
|
|
;; beep
|
1302 |
|
|
L03F8: RST 28H ;; FP-CALC
|
1303 |
|
|
DEFB $31 ;;duplicate ; duplicate pitch
|
1304 |
|
|
DEFB $27 ;;int ; convert to integer
|
1305 |
|
|
DEFB $C0 ;;st-mem-0 ; store integer pitch to memory 0
|
1306 |
|
|
DEFB $03 ;;subtract ; calculate fractional part of pitch = fp_pitch - int_pitch
|
1307 |
|
|
DEFB $34 ;;stk-data ; push constant
|
1308 |
|
|
DEFB $EC ;;Exponent: $7C, Bytes: 4 ; constant = 0.05762265
|
1309 |
|
|
DEFB $6C,$98,$1F,$F5 ;;($6C,$98,$1F,$F5)
|
1310 |
|
|
DEFB $04 ;;multiply ; compute:
|
1311 |
|
|
DEFB $A1 ;;stk-one ; 1 + 0.05762265 * fraction_part(pitch)
|
1312 |
|
|
DEFB $0F ;;addition
|
1313 |
|
|
DEFB $38 ;;end-calc ; leave on calc stack
|
1314 |
|
|
|
1315 |
|
|
LD HL,$5C92 ; MEM-0: number stored here is in 16 bit integer format (pitch)
|
1316 |
|
|
; 0, 0/FF (pos/neg), LSB, MSB, 0
|
1317 |
|
|
; LSB/MSB is stored in two's complement
|
1318 |
|
|
; In the following, the pitch is checked if it is in the range -128<=p<=127
|
1319 |
|
|
LD A,(HL) ; First byte must be zero, otherwise
|
1320 |
|
|
AND A ; error in integer conversion
|
1321 |
|
|
JR NZ,L046C ; to REPORT-B
|
1322 |
|
|
|
1323 |
|
|
INC HL ;
|
1324 |
|
|
LD C,(HL) ; C = pos/neg flag = 0/FF
|
1325 |
|
|
INC HL ;
|
1326 |
|
|
LD B,(HL) ; B = LSB, two's complement
|
1327 |
|
|
LD A,B ;
|
1328 |
|
|
RLA ;
|
1329 |
|
|
SBC A,A ; A = 0/FF if B is pos/neg
|
1330 |
|
|
CP C ; must be the same as C if the pitch is -128<=p<=127
|
1331 |
|
|
JR NZ,L046C ; if no, error REPORT-B
|
1332 |
|
|
|
1333 |
|
|
INC HL ; if -128<=p<=127, MSB will be 0/FF if B is pos/neg
|
1334 |
|
|
CP (HL) ; verify this
|
1335 |
|
|
JR NZ,L046C ; if no, error REPORT-B
|
1336 |
|
|
; now we know -128<=p<=127
|
1337 |
|
|
LD A,B ; A = pitch + 60
|
1338 |
|
|
ADD A,$3C ; if -60<=pitch<=67,
|
1339 |
|
|
JP P,L0425 ; goto BE-i-OK
|
1340 |
|
|
|
1341 |
|
|
JP PO,L046C ; if pitch <= 67 goto REPORT-B
|
1342 |
|
|
; lower bound of pitch set at -60
|
1343 |
|
|
|
1344 |
|
|
;; BE-I-OK ; here, -60<=pitch<=127
|
1345 |
|
|
; and A=pitch+60 -> 0<=A<=187
|
1346 |
|
|
|
1347 |
|
|
L0425: LD B,$FA ; 6 octaves below middle C
|
1348 |
|
|
|
1349 |
|
|
;; BE-OCTAVE ; A=# semitones above 5 octaves below middle C
|
1350 |
|
|
L0427: INC B ; increment octave
|
1351 |
|
|
SUB $0C ; 12 semitones = one octave
|
1352 |
|
|
JR NC,L0427 ; to BE-OCTAVE
|
1353 |
|
|
|
1354 |
|
|
ADD A,$0C ; A = # semitones above C (0-11)
|
1355 |
|
|
PUSH BC ; B = octave displacement from middle C, 2's complement: -5<=B<=10
|
1356 |
|
|
LD HL,L046E ; Address: semi-tone
|
1357 |
|
|
CALL L3406 ; routine LOC-MEM
|
1358 |
|
|
; HL = 5*A + $046E
|
1359 |
|
|
CALL L33B4 ; routine STACK-NUM
|
1360 |
|
|
; read FP value (freq) from semitone table (HL) and push onto calc stack
|
1361 |
|
|
|
1362 |
|
|
RST 28H ;; FP-CALC
|
1363 |
|
|
DEFB $04 ;;multiply mult freq by 1 + 0.0576 * fraction_part(pitch) stacked earlier
|
1364 |
|
|
;; thus taking into account fractional part of pitch.
|
1365 |
|
|
;; the number 0.0576*frequency is the distance in Hz to the next
|
1366 |
|
|
;; note (verify with the frequencies recorded in the semitone
|
1367 |
|
|
;; table below) so that the fraction_part of the pitch does
|
1368 |
|
|
;; indeed represent a fractional distance to the next note.
|
1369 |
|
|
DEFB $38 ;;end-calc HL points to first byte of fp num on stack = middle frequency to generate
|
1370 |
|
|
|
1371 |
|
|
POP AF ; A = octave displacement from middle C, 2's complement: -5<=A<=10
|
1372 |
|
|
ADD A,(HL) ; increase exponent by A (equivalent to multiplying by 2^A)
|
1373 |
|
|
LD (HL),A ;
|
1374 |
|
|
|
1375 |
|
|
RST 28H ;; FP-CALC
|
1376 |
|
|
DEFB $C0 ;;st-mem-0 ; store frequency in memory 0
|
1377 |
|
|
DEFB $02 ;;delete ; remove from calc stack
|
1378 |
|
|
DEFB $31 ;;duplicate ; duplicate duration (seconds)
|
1379 |
|
|
DEFB $38 ;;end-calc
|
1380 |
|
|
|
1381 |
|
|
CALL L1E94 ; routine FIND-INT1 ; FP duration to A
|
1382 |
|
|
CP $0B ; if dur > 10 seconds,
|
1383 |
|
|
JR NC,L046C ; goto REPORT-B
|
1384 |
|
|
|
1385 |
|
|
;;; The following calculation finds the tone period for HL and the cycle count
|
1386 |
|
|
;;; for DE expected in the BEEPER subroutine. From the example in the BEEPER comments,
|
1387 |
|
|
;;;
|
1388 |
|
|
;;; HL = ((fCPU / f) - 236) / 8 = fCPU/8/f - 236/8 = 437500/f -29.5
|
1389 |
|
|
;;; DE = duration * frequency - 1
|
1390 |
|
|
;;;
|
1391 |
|
|
;;; Note the different constant (30.125) used in the calculation of HL
|
1392 |
|
|
;;; below. This is probably an error.
|
1393 |
|
|
|
1394 |
|
|
RST 28H ;; FP-CALC
|
1395 |
|
|
DEFB $E0 ;;get-mem-0 ; push frequency
|
1396 |
|
|
DEFB $04 ;;multiply ; result1: #cycles = duration * frequency
|
1397 |
|
|
DEFB $E0 ;;get-mem-0 ; push frequency
|
1398 |
|
|
DEFB $34 ;;stk-data ; push constant
|
1399 |
|
|
DEFB $80 ;;Exponent $93, Bytes: 3 ; constant = 437500
|
1400 |
|
|
DEFB $43,$55,$9F,$80 ;;($55,$9F,$80,$00)
|
1401 |
|
|
DEFB $01 ;;exchange ; frequency on top
|
1402 |
|
|
DEFB $05 ;;division ; 437500 / frequency
|
1403 |
|
|
DEFB $34 ;;stk-data ; push constant
|
1404 |
|
|
DEFB $35 ;;Exponent: $85, Bytes: 1 ; constant = 30.125
|
1405 |
|
|
DEFB $71 ;;($71,$00,$00,$00)
|
1406 |
|
|
DEFB $03 ;;subtract ; result2: tone_period(HL) = 437500 / freq - 30.125
|
1407 |
|
|
DEFB $38 ;;end-calc
|
1408 |
|
|
|
1409 |
|
|
CALL L1E99 ; routine FIND-INT2
|
1410 |
|
|
PUSH BC ; BC = tone_period(HL)
|
1411 |
|
|
CALL L1E99 ; routine FIND-INT2, BC = #cycles to generate
|
1412 |
|
|
POP HL ; HL = tone period
|
1413 |
|
|
LD D,B ;
|
1414 |
|
|
LD E,C ; DE = #cycles
|
1415 |
|
|
LD A,D ;
|
1416 |
|
|
OR E ;
|
1417 |
|
|
RET Z ; if duration = 0, skip BEEP and avoid 65536 cycle
|
1418 |
|
|
; boondoggle that would occur next
|
1419 |
|
|
DEC DE ; DE = #cycles - 1
|
1420 |
|
|
JP L03B5 ; to BEEPER
|
1421 |
|
|
|
1422 |
|
|
; ---
|
1423 |
|
|
|
1424 |
|
|
|
1425 |
|
|
;; REPORT-B
|
1426 |
|
|
L046C: RST 08H ; ERROR-1
|
1427 |
|
|
DEFB $0A ; Error Report: Integer out of range
|
1428 |
|
|
|
1429 |
|
|
|
1430 |
|
|
|
1431 |
|
|
; ---------------------
|
1432 |
|
|
; THE 'SEMI-TONE' TABLE
|
1433 |
|
|
; ---------------------
|
1434 |
|
|
;
|
1435 |
|
|
; Holds frequencies corresponding to semitones in middle octave.
|
1436 |
|
|
; To move n octaves higher or lower, frequencies are multiplied by 2^n.
|
1437 |
|
|
|
1438 |
|
|
;; semi-tone five byte fp decimal freq note (middle)
|
1439 |
|
|
L046E: DEFB $89, $02, $D0, $12, $86; 261.625565290 C
|
1440 |
|
|
DEFB $89, $0A, $97, $60, $75; 277.182631135 C#
|
1441 |
|
|
DEFB $89, $12, $D5, $17, $1F; 293.664768100 D
|
1442 |
|
|
DEFB $89, $1B, $90, $41, $02; 311.126983881 D#
|
1443 |
|
|
DEFB $89, $24, $D0, $53, $CA; 329.627557039 E
|
1444 |
|
|
DEFB $89, $2E, $9D, $36, $B1; 349.228231549 F
|
1445 |
|
|
DEFB $89, $38, $FF, $49, $3E; 369.994422674 F#
|
1446 |
|
|
DEFB $89, $43, $FF, $6A, $73; 391.995436072 G
|
1447 |
|
|
DEFB $89, $4F, $A7, $00, $54; 415.304697513 G#
|
1448 |
|
|
DEFB $89, $5C, $00, $00, $00; 440.000000000 A
|
1449 |
|
|
DEFB $89, $69, $14, $F6, $24; 466.163761616 A#
|
1450 |
|
|
DEFB $89, $76, $F1, $10, $05; 493.883301378 B
|
1451 |
|
|
|
1452 |
|
|
|
1453 |
|
|
; "Music is the hidden mathematical endeavour of a soul unconscious it
|
1454 |
|
|
; is calculating" - Gottfried Wilhelm Liebnitz 1646 - 1716
|
1455 |
|
|
|
1456 |
|
|
|
1457 |
|
|
;****************************************
|
1458 |
|
|
;** Part 4. CASSETTE HANDLING ROUTINES **
|
1459 |
|
|
;****************************************
|
1460 |
|
|
|
1461 |
|
|
; These routines begin with the service routines followed by a single
|
1462 |
|
|
; command entry point.
|
1463 |
|
|
; The first of these service routines is a curiosity.
|
1464 |
|
|
|
1465 |
|
|
; -----------------------
|
1466 |
|
|
; THE 'ZX81 NAME' ROUTINE
|
1467 |
|
|
; -----------------------
|
1468 |
|
|
; This routine fetches a filename in ZX81 format and is not used by the
|
1469 |
|
|
; cassette handling routines in this ROM.
|
1470 |
|
|
|
1471 |
|
|
;; zx81-name
|
1472 |
|
|
L04AA: CALL L24FB ; routine SCANNING to evaluate expression.
|
1473 |
|
|
LD A,($5C3B) ; fetch system variable FLAGS.
|
1474 |
|
|
ADD A,A ; test bit 7 - syntax, bit 6 - result type.
|
1475 |
|
|
JP M,L1C8A ; to REPORT-C if not string result
|
1476 |
|
|
; 'Nonsense in BASIC'.
|
1477 |
|
|
|
1478 |
|
|
POP HL ; drop return address.
|
1479 |
|
|
RET NC ; return early if checking syntax.
|
1480 |
|
|
|
1481 |
|
|
PUSH HL ; re-save return address.
|
1482 |
|
|
CALL L2BF1 ; routine STK-FETCH fetches string parameters.
|
1483 |
|
|
LD H,D ; transfer start of filename
|
1484 |
|
|
LD L,E ; to the HL register.
|
1485 |
|
|
DEC C ; adjust to point to last character and
|
1486 |
|
|
RET M ; return if the null string.
|
1487 |
|
|
; or multiple of 256!
|
1488 |
|
|
|
1489 |
|
|
ADD HL,BC ; find last character of the filename.
|
1490 |
|
|
; and also clear carry.
|
1491 |
|
|
SET 7,(HL) ; invert it.
|
1492 |
|
|
RET ; return.
|
1493 |
|
|
|
1494 |
|
|
; =========================================
|
1495 |
|
|
;
|
1496 |
|
|
; PORT 254 ($FE)
|
1497 |
|
|
;
|
1498 |
|
|
; spk mic { border }
|
1499 |
|
|
; ___ ___ ___ ___ ___ ___ ___ ___
|
1500 |
|
|
; PORT | | | | | | | | |
|
1501 |
|
|
; 254 | | | | | | | | |
|
1502 |
|
|
; $FE |___|___|___|___|___|___|___|___|
|
1503 |
|
|
; 7 6 5 4 3 2 1 0
|
1504 |
|
|
;
|
1505 |
|
|
|
1506 |
|
|
; ----------------------------------
|
1507 |
|
|
; Save header and program/data bytes
|
1508 |
|
|
; ----------------------------------
|
1509 |
|
|
; This routine saves a section of data. It is called from SA-CTRL to save the
|
1510 |
|
|
; seventeen bytes of header data. It is also the exit route from that routine
|
1511 |
|
|
; when it is set up to save the actual data.
|
1512 |
|
|
; On entry -
|
1513 |
|
|
; HL points to start of data.
|
1514 |
|
|
; IX points to descriptor.
|
1515 |
|
|
; The accumulator is set to $00 for a header, $FF for data.
|
1516 |
|
|
|
1517 |
|
|
;; SA-BYTES
|
1518 |
|
|
L04C2: LD HL,L053F ; address: SA/LD-RET
|
1519 |
|
|
PUSH HL ; is pushed as common exit route.
|
1520 |
|
|
; however there is only one non-terminal exit
|
1521 |
|
|
; point.
|
1522 |
|
|
|
1523 |
|
|
LD HL,$1F80 ; a timing constant H=$1F, L=$80
|
1524 |
|
|
; inner and outer loop counters
|
1525 |
|
|
; a five second lead-in is used for a header.
|
1526 |
|
|
|
1527 |
|
|
BIT 7,A ; test one bit of accumulator.
|
1528 |
|
|
; (AND A ?)
|
1529 |
|
|
JR Z,L04D0 ; skip to SA-FLAG if a header is being saved.
|
1530 |
|
|
|
1531 |
|
|
; else is data bytes and a shorter lead-in is used.
|
1532 |
|
|
|
1533 |
|
|
LD HL,$0C98 ; another timing value H=$0C, L=$98.
|
1534 |
|
|
; a two second lead-in is used for the data.
|
1535 |
|
|
|
1536 |
|
|
|
1537 |
|
|
;; SA-FLAG
|
1538 |
|
|
L04D0: EX AF,AF' ; save flag
|
1539 |
|
|
INC DE ; increase length by one.
|
1540 |
|
|
DEC IX ; decrease start.
|
1541 |
|
|
|
1542 |
|
|
DI ; disable interrupts
|
1543 |
|
|
|
1544 |
|
|
LD A,$02 ; select red for border, microphone bit on.
|
1545 |
|
|
LD B,A ; also does as an initial slight counter value.
|
1546 |
|
|
|
1547 |
|
|
;; SA-LEADER
|
1548 |
|
|
L04D8: DJNZ L04D8 ; self loop to SA-LEADER for delay.
|
1549 |
|
|
; after initial loop, count is $A4 (or $A3)
|
1550 |
|
|
|
1551 |
|
|
OUT ($FE),A ; output byte $02/$0D to tape port.
|
1552 |
|
|
|
1553 |
|
|
XOR $0F ; switch from RED (mic on) to CYAN (mic off).
|
1554 |
|
|
|
1555 |
|
|
LD B,$A4 ; hold count. also timed instruction.
|
1556 |
|
|
|
1557 |
|
|
DEC L ; originally $80 or $98.
|
1558 |
|
|
; but subsequently cycles 256 times.
|
1559 |
|
|
JR NZ,L04D8 ; back to SA-LEADER until L is zero.
|
1560 |
|
|
|
1561 |
|
|
; the outer loop is counted by H
|
1562 |
|
|
|
1563 |
|
|
DEC B ; decrement count
|
1564 |
|
|
DEC H ; originally twelve or thirty-one.
|
1565 |
|
|
JP P,L04D8 ; back to SA-LEADER until H becomes $FF
|
1566 |
|
|
|
1567 |
|
|
; now send a sync pulse. At this stage mic is off and A holds value
|
1568 |
|
|
; for mic on.
|
1569 |
|
|
; A sync pulse is much shorter than the steady pulses of the lead-in.
|
1570 |
|
|
|
1571 |
|
|
LD B,$2F ; another short timed delay.
|
1572 |
|
|
|
1573 |
|
|
;; SA-SYNC-1
|
1574 |
|
|
L04EA: DJNZ L04EA ; self loop to SA-SYNC-1
|
1575 |
|
|
|
1576 |
|
|
OUT ($FE),A ; switch to mic on and red.
|
1577 |
|
|
LD A,$0D ; prepare mic off - cyan
|
1578 |
|
|
LD B,$37 ; another short timed delay.
|
1579 |
|
|
|
1580 |
|
|
;; SA-SYNC-2
|
1581 |
|
|
L04F2: DJNZ L04F2 ; self loop to SA-SYNC-2
|
1582 |
|
|
|
1583 |
|
|
OUT ($FE),A ; output mic off, cyan border.
|
1584 |
|
|
LD BC,$3B0E ; B=$3B time(*), C=$0E, YELLOW, MIC OFF.
|
1585 |
|
|
|
1586 |
|
|
;
|
1587 |
|
|
|
1588 |
|
|
EX AF,AF' ; restore saved flag
|
1589 |
|
|
; which is 1st byte to be saved.
|
1590 |
|
|
|
1591 |
|
|
LD L,A ; and transfer to L.
|
1592 |
|
|
; the initial parity is A, $FF or $00.
|
1593 |
|
|
JP L0507 ; JUMP forward to SA-START ->
|
1594 |
|
|
; the mid entry point of loop.
|
1595 |
|
|
|
1596 |
|
|
; -------------------------
|
1597 |
|
|
; During the save loop a parity byte is maintained in H.
|
1598 |
|
|
; the save loop begins by testing if reduced length is zero and if so
|
1599 |
|
|
; the final parity byte is saved reducing count to $FFFF.
|
1600 |
|
|
|
1601 |
|
|
;; SA-LOOP
|
1602 |
|
|
L04FE: LD A,D ; fetch high byte
|
1603 |
|
|
OR E ; test against low byte.
|
1604 |
|
|
JR Z,L050E ; forward to SA-PARITY if zero.
|
1605 |
|
|
|
1606 |
|
|
LD L,(IX+$00) ; load currently addressed byte to L.
|
1607 |
|
|
|
1608 |
|
|
;; SA-LOOP-P
|
1609 |
|
|
L0505: LD A,H ; fetch parity byte.
|
1610 |
|
|
XOR L ; exclusive or with new byte.
|
1611 |
|
|
|
1612 |
|
|
; -> the mid entry point of loop.
|
1613 |
|
|
|
1614 |
|
|
;; SA-START
|
1615 |
|
|
L0507: LD H,A ; put parity byte in H.
|
1616 |
|
|
LD A,$01 ; prepare blue, mic=on.
|
1617 |
|
|
SCF ; set carry flag ready to rotate in.
|
1618 |
|
|
JP L0525 ; JUMP forward to SA-8-BITS -8->
|
1619 |
|
|
|
1620 |
|
|
; ---
|
1621 |
|
|
|
1622 |
|
|
;; SA-PARITY
|
1623 |
|
|
L050E: LD L,H ; transfer the running parity byte to L and
|
1624 |
|
|
JR L0505 ; back to SA-LOOP-P
|
1625 |
|
|
; to output that byte before quitting normally.
|
1626 |
|
|
|
1627 |
|
|
; ---
|
1628 |
|
|
|
1629 |
|
|
; The entry point to save yellow part of bit.
|
1630 |
|
|
; A bit consists of a period with mic on and blue border followed by
|
1631 |
|
|
; a period of mic off with yellow border.
|
1632 |
|
|
; Note. since the DJNZ instruction does not affect flags, the zero flag is
|
1633 |
|
|
; used to indicate which of the two passes is in effect and the carry
|
1634 |
|
|
; maintains the state of the bit to be saved.
|
1635 |
|
|
|
1636 |
|
|
;; SA-BIT-2
|
1637 |
|
|
L0511: LD A,C ; fetch 'mic on and yellow' which is
|
1638 |
|
|
; held permanently in C.
|
1639 |
|
|
BIT 7,B ; set the zero flag. B holds $3E.
|
1640 |
|
|
|
1641 |
|
|
; The entry point to save 1 entire bit. For first bit B holds $3B(*).
|
1642 |
|
|
; Carry is set if saved bit is 1. zero is reset NZ on entry.
|
1643 |
|
|
|
1644 |
|
|
;; SA-BIT-1
|
1645 |
|
|
L0514: DJNZ L0514 ; self loop for delay to SA-BIT-1
|
1646 |
|
|
|
1647 |
|
|
JR NC,L051C ; forward to SA-OUT if bit is 0.
|
1648 |
|
|
|
1649 |
|
|
; but if bit is 1 then the mic state is held for longer.
|
1650 |
|
|
|
1651 |
|
|
LD B,$42 ; set timed delay. (66 decimal)
|
1652 |
|
|
|
1653 |
|
|
;; SA-SET
|
1654 |
|
|
L051A: DJNZ L051A ; self loop to SA-SET
|
1655 |
|
|
; (roughly an extra 66*13 clock cycles)
|
1656 |
|
|
|
1657 |
|
|
;; SA-OUT
|
1658 |
|
|
L051C: OUT ($FE),A ; blue and mic on OR yellow and mic off.
|
1659 |
|
|
|
1660 |
|
|
LD B,$3E ; set up delay
|
1661 |
|
|
JR NZ,L0511 ; back to SA-BIT-2 if zero reset NZ (first pass)
|
1662 |
|
|
|
1663 |
|
|
; proceed when the blue and yellow bands have been output.
|
1664 |
|
|
|
1665 |
|
|
DEC B ; change value $3E to $3D.
|
1666 |
|
|
XOR A ; clear carry flag (ready to rotate in).
|
1667 |
|
|
INC A ; reset zero flag i.e. NZ.
|
1668 |
|
|
|
1669 |
|
|
; -8->
|
1670 |
|
|
|
1671 |
|
|
;; SA-8-BITS
|
1672 |
|
|
L0525: RL L ; rotate left through carry
|
1673 |
|
|
; C<76543210
|
1674 |
|
|
JP NZ,L0514 ; JUMP back to SA-BIT-1
|
1675 |
|
|
; until all 8 bits done.
|
1676 |
|
|
|
1677 |
|
|
; when the initial set carry is passed out again then a byte is complete.
|
1678 |
|
|
|
1679 |
|
|
DEC DE ; decrease length
|
1680 |
|
|
INC IX ; increase byte pointer
|
1681 |
|
|
LD B,$31 ; set up timing.
|
1682 |
|
|
|
1683 |
|
|
LD A,$7F ; test the space key and
|
1684 |
|
|
IN A,($FE) ; return to common exit (to restore border)
|
1685 |
|
|
RRA ; if a space is pressed
|
1686 |
|
|
RET NC ; return to SA/LD-RET. - - >
|
1687 |
|
|
|
1688 |
|
|
; now test if byte counter has reached $FFFF.
|
1689 |
|
|
|
1690 |
|
|
LD A,D ; fetch high byte
|
1691 |
|
|
INC A ; increment.
|
1692 |
|
|
JP NZ,L04FE ; JUMP to SA-LOOP if more bytes.
|
1693 |
|
|
|
1694 |
|
|
LD B,$3B ; a final delay.
|
1695 |
|
|
|
1696 |
|
|
;; SA-DELAY
|
1697 |
|
|
L053C: DJNZ L053C ; self loop to SA-DELAY
|
1698 |
|
|
|
1699 |
|
|
RET ; return - - >
|
1700 |
|
|
|
1701 |
|
|
; ------------------------------
|
1702 |
|
|
; THE 'SAVE/LOAD RETURN' ROUTINE
|
1703 |
|
|
; ------------------------------
|
1704 |
|
|
; The address of this routine is pushed on the stack prior to any load/save
|
1705 |
|
|
; operation and it handles normal completion with the restoration of the
|
1706 |
|
|
; border and also abnormal termination when the break key, or to be more
|
1707 |
|
|
; precise the space key is pressed during a tape operation.
|
1708 |
|
|
;
|
1709 |
|
|
; - - >
|
1710 |
|
|
|
1711 |
|
|
;; SA/LD-RET
|
1712 |
|
|
L053F: PUSH AF ; preserve accumulator throughout.
|
1713 |
|
|
LD A,($5C48) ; fetch border colour from BORDCR.
|
1714 |
|
|
AND $38 ; mask off paper bits.
|
1715 |
|
|
RRCA ; rotate
|
1716 |
|
|
RRCA ; to the
|
1717 |
|
|
RRCA ; range 0-7.
|
1718 |
|
|
|
1719 |
|
|
OUT ($FE),A ; change the border colour.
|
1720 |
|
|
|
1721 |
|
|
LD A,$7F ; read from port address $7FFE the
|
1722 |
|
|
IN A,($FE) ; row with the space key at outside.
|
1723 |
|
|
|
1724 |
|
|
RRA ; test for space key pressed.
|
1725 |
|
|
EI ; enable interrupts
|
1726 |
|
|
JR C,L0554 ; forward to SA/LD-END if not
|
1727 |
|
|
|
1728 |
|
|
|
1729 |
|
|
;; REPORT-Da
|
1730 |
|
|
L0552: RST 08H ; ERROR-1
|
1731 |
|
|
DEFB $0C ; Error Report: BREAK - CONT repeats
|
1732 |
|
|
|
1733 |
|
|
; ---
|
1734 |
|
|
|
1735 |
|
|
;; SA/LD-END
|
1736 |
|
|
L0554: POP AF ; restore the accumulator.
|
1737 |
|
|
RET ; return.
|
1738 |
|
|
|
1739 |
|
|
; ------------------------------------
|
1740 |
|
|
; Load header or block of information
|
1741 |
|
|
; ------------------------------------
|
1742 |
|
|
; This routine is used to load bytes and on entry A is set to $00 for a
|
1743 |
|
|
; header or to $FF for data. IX points to the start of receiving location
|
1744 |
|
|
; and DE holds the length of bytes to be loaded. If, on entry the carry flag
|
1745 |
|
|
; is set then data is loaded, if reset then it is verified.
|
1746 |
|
|
|
1747 |
|
|
;; LD-BYTES
|
1748 |
|
|
L0556: INC D ; reset the zero flag without disturbing carry.
|
1749 |
|
|
EX AF,AF' ; preserve entry flags.
|
1750 |
|
|
DEC D ; restore high byte of length.
|
1751 |
|
|
|
1752 |
|
|
DI ; disable interrupts
|
1753 |
|
|
|
1754 |
|
|
LD A,$0F ; make the border white and mic off.
|
1755 |
|
|
OUT ($FE),A ; output to port.
|
1756 |
|
|
|
1757 |
|
|
LD HL,L053F ; Address: SA/LD-RET
|
1758 |
|
|
PUSH HL ; is saved on stack as terminating routine.
|
1759 |
|
|
|
1760 |
|
|
; the reading of the EAR bit (D6) will always be preceded by a test of the
|
1761 |
|
|
; space key (D0), so store the initial post-test state.
|
1762 |
|
|
|
1763 |
|
|
IN A,($FE) ; read the ear state - bit 6.
|
1764 |
|
|
RRA ; rotate to bit 5.
|
1765 |
|
|
AND $20 ; isolate this bit.
|
1766 |
|
|
OR $02 ; combine with red border colour.
|
1767 |
|
|
LD C,A ; and store initial state long-term in C.
|
1768 |
|
|
CP A ; set the zero flag.
|
1769 |
|
|
|
1770 |
|
|
;
|
1771 |
|
|
|
1772 |
|
|
;; LD-BREAK
|
1773 |
|
|
L056B: RET NZ ; return if at any time space is pressed.
|
1774 |
|
|
|
1775 |
|
|
;; LD-START
|
1776 |
|
|
L056C: CALL L05E7 ; routine LD-EDGE-1
|
1777 |
|
|
JR NC,L056B ; back to LD-BREAK with time out and no
|
1778 |
|
|
; edge present on tape.
|
1779 |
|
|
|
1780 |
|
|
; but continue when a transition is found on tape.
|
1781 |
|
|
|
1782 |
|
|
LD HL,$0415 ; set up 16-bit outer loop counter for
|
1783 |
|
|
; approx 1 second delay.
|
1784 |
|
|
|
1785 |
|
|
;; LD-WAIT
|
1786 |
|
|
L0574: DJNZ L0574 ; self loop to LD-WAIT (for 256 times)
|
1787 |
|
|
|
1788 |
|
|
DEC HL ; decrease outer loop counter.
|
1789 |
|
|
LD A,H ; test for
|
1790 |
|
|
OR L ; zero.
|
1791 |
|
|
JR NZ,L0574 ; back to LD-WAIT, if not zero, with zero in B.
|
1792 |
|
|
|
1793 |
|
|
; continue after delay with H holding zero and B also.
|
1794 |
|
|
; sample 256 edges to check that we are in the middle of a lead-in section.
|
1795 |
|
|
|
1796 |
|
|
CALL L05E3 ; routine LD-EDGE-2
|
1797 |
|
|
JR NC,L056B ; back to LD-BREAK
|
1798 |
|
|
; if no edges at all.
|
1799 |
|
|
|
1800 |
|
|
;; LD-LEADER
|
1801 |
|
|
L0580: LD B,$9C ; set timing value.
|
1802 |
|
|
CALL L05E3 ; routine LD-EDGE-2
|
1803 |
|
|
JR NC,L056B ; back to LD-BREAK if time-out
|
1804 |
|
|
|
1805 |
|
|
LD A,$C6 ; two edges must be spaced apart.
|
1806 |
|
|
CP B ; compare
|
1807 |
|
|
JR NC,L056C ; back to LD-START if too close together for a
|
1808 |
|
|
; lead-in.
|
1809 |
|
|
|
1810 |
|
|
INC H ; proceed to test 256 edged sample.
|
1811 |
|
|
JR NZ,L0580 ; back to LD-LEADER while more to do.
|
1812 |
|
|
|
1813 |
|
|
; sample indicates we are in the middle of a two or five second lead-in.
|
1814 |
|
|
; Now test every edge looking for the terminal sync signal.
|
1815 |
|
|
|
1816 |
|
|
;; LD-SYNC
|
1817 |
|
|
L058F: LD B,$C9 ; initial timing value in B.
|
1818 |
|
|
CALL L05E7 ; routine LD-EDGE-1
|
1819 |
|
|
JR NC,L056B ; back to LD-BREAK with time-out.
|
1820 |
|
|
|
1821 |
|
|
LD A,B ; fetch augmented timing value from B.
|
1822 |
|
|
CP $D4 ; compare
|
1823 |
|
|
JR NC,L058F ; back to LD-SYNC if gap too big, that is,
|
1824 |
|
|
; a normal lead-in edge gap.
|
1825 |
|
|
|
1826 |
|
|
; but a short gap will be the sync pulse.
|
1827 |
|
|
; in which case another edge should appear before B rises to $FF
|
1828 |
|
|
|
1829 |
|
|
CALL L05E7 ; routine LD-EDGE-1
|
1830 |
|
|
RET NC ; return with time-out.
|
1831 |
|
|
|
1832 |
|
|
; proceed when the sync at the end of the lead-in is found.
|
1833 |
|
|
; We are about to load data so change the border colours.
|
1834 |
|
|
|
1835 |
|
|
LD A,C ; fetch long-term mask from C
|
1836 |
|
|
XOR $03 ; and make blue/yellow.
|
1837 |
|
|
|
1838 |
|
|
LD C,A ; store the new long-term byte.
|
1839 |
|
|
|
1840 |
|
|
LD H,$00 ; set up parity byte as zero.
|
1841 |
|
|
LD B,$B0 ; timing.
|
1842 |
|
|
JR L05C8 ; forward to LD-MARKER
|
1843 |
|
|
; the loop mid entry point with the alternate
|
1844 |
|
|
; zero flag reset to indicate first byte
|
1845 |
|
|
; is discarded.
|
1846 |
|
|
|
1847 |
|
|
; --------------
|
1848 |
|
|
; the loading loop loads each byte and is entered at the mid point.
|
1849 |
|
|
|
1850 |
|
|
;; LD-LOOP
|
1851 |
|
|
L05A9: EX AF,AF' ; restore entry flags and type in A.
|
1852 |
|
|
JR NZ,L05B3 ; forward to LD-FLAG if awaiting initial flag
|
1853 |
|
|
; which is to be discarded.
|
1854 |
|
|
|
1855 |
|
|
JR NC,L05BD ; forward to LD-VERIFY if not to be loaded.
|
1856 |
|
|
|
1857 |
|
|
LD (IX+$00),L ; place loaded byte at memory location.
|
1858 |
|
|
JR L05C2 ; forward to LD-NEXT
|
1859 |
|
|
|
1860 |
|
|
; ---
|
1861 |
|
|
|
1862 |
|
|
;; LD-FLAG
|
1863 |
|
|
L05B3: RL C ; preserve carry (verify) flag in long-term
|
1864 |
|
|
; state byte. Bit 7 can be lost.
|
1865 |
|
|
|
1866 |
|
|
XOR L ; compare type in A with first byte in L.
|
1867 |
|
|
RET NZ ; return if no match e.g. CODE vs. DATA.
|
1868 |
|
|
|
1869 |
|
|
; continue when data type matches.
|
1870 |
|
|
|
1871 |
|
|
LD A,C ; fetch byte with stored carry
|
1872 |
|
|
RRA ; rotate it to carry flag again
|
1873 |
|
|
LD C,A ; restore long-term port state.
|
1874 |
|
|
|
1875 |
|
|
INC DE ; increment length ??
|
1876 |
|
|
JR L05C4 ; forward to LD-DEC.
|
1877 |
|
|
; but why not to location after ?
|
1878 |
|
|
|
1879 |
|
|
; ---
|
1880 |
|
|
; for verification the byte read from tape is compared with that in memory.
|
1881 |
|
|
|
1882 |
|
|
;; LD-VERIFY
|
1883 |
|
|
L05BD: LD A,(IX+$00) ; fetch byte from memory.
|
1884 |
|
|
XOR L ; compare with that on tape
|
1885 |
|
|
RET NZ ; return if not zero.
|
1886 |
|
|
|
1887 |
|
|
;; LD-NEXT
|
1888 |
|
|
L05C2: INC IX ; increment byte pointer.
|
1889 |
|
|
|
1890 |
|
|
;; LD-DEC
|
1891 |
|
|
L05C4: DEC DE ; decrement length.
|
1892 |
|
|
EX AF,AF' ; store the flags.
|
1893 |
|
|
LD B,$B2 ; timing.
|
1894 |
|
|
|
1895 |
|
|
; when starting to read 8 bits the receiving byte is marked with bit at right.
|
1896 |
|
|
; when this is rotated out again then 8 bits have been read.
|
1897 |
|
|
|
1898 |
|
|
;; LD-MARKER
|
1899 |
|
|
L05C8: LD L,$01 ; initialize as %00000001
|
1900 |
|
|
|
1901 |
|
|
;; LD-8-BITS
|
1902 |
|
|
L05CA: CALL L05E3 ; routine LD-EDGE-2 increments B relative to
|
1903 |
|
|
; gap between 2 edges.
|
1904 |
|
|
RET NC ; return with time-out.
|
1905 |
|
|
|
1906 |
|
|
LD A,$CB ; the comparison byte.
|
1907 |
|
|
CP B ; compare to incremented value of B.
|
1908 |
|
|
; if B is higher then bit on tape was set.
|
1909 |
|
|
; if <= then bit on tape is reset.
|
1910 |
|
|
|
1911 |
|
|
RL L ; rotate the carry bit into L.
|
1912 |
|
|
|
1913 |
|
|
LD B,$B0 ; reset the B timer byte.
|
1914 |
|
|
JP NC,L05CA ; JUMP back to LD-8-BITS
|
1915 |
|
|
|
1916 |
|
|
; when carry set then marker bit has been passed out and byte is complete.
|
1917 |
|
|
|
1918 |
|
|
LD A,H ; fetch the running parity byte.
|
1919 |
|
|
XOR L ; include the new byte.
|
1920 |
|
|
LD H,A ; and store back in parity register.
|
1921 |
|
|
|
1922 |
|
|
LD A,D ; check length of
|
1923 |
|
|
OR E ; expected bytes.
|
1924 |
|
|
JR NZ,L05A9 ; back to LD-LOOP
|
1925 |
|
|
; while there are more.
|
1926 |
|
|
|
1927 |
|
|
; when all bytes loaded then parity byte should be zero.
|
1928 |
|
|
|
1929 |
|
|
LD A,H ; fetch parity byte.
|
1930 |
|
|
CP $01 ; set carry if zero.
|
1931 |
|
|
RET ; return
|
1932 |
|
|
; in no carry then error as checksum disagrees.
|
1933 |
|
|
|
1934 |
|
|
; -------------------------
|
1935 |
|
|
; Check signal being loaded
|
1936 |
|
|
; -------------------------
|
1937 |
|
|
; An edge is a transition from one mic state to another.
|
1938 |
|
|
; More specifically a change in bit 6 of value input from port $FE.
|
1939 |
|
|
; Graphically it is a change of border colour, say, blue to yellow.
|
1940 |
|
|
; The first entry point looks for two adjacent edges. The second entry point
|
1941 |
|
|
; is used to find a single edge.
|
1942 |
|
|
; The B register holds a count, up to 256, within which the edge (or edges)
|
1943 |
|
|
; must be found. The gap between two edges will be more for a '1' than a '0'
|
1944 |
|
|
; so the value of B denotes the state of the bit (two edges) read from tape.
|
1945 |
|
|
|
1946 |
|
|
; ->
|
1947 |
|
|
|
1948 |
|
|
;; LD-EDGE-2
|
1949 |
|
|
L05E3: CALL L05E7 ; call routine LD-EDGE-1 below.
|
1950 |
|
|
RET NC ; return if space pressed or time-out.
|
1951 |
|
|
; else continue and look for another adjacent
|
1952 |
|
|
; edge which together represent a bit on the
|
1953 |
|
|
; tape.
|
1954 |
|
|
|
1955 |
|
|
; ->
|
1956 |
|
|
; this entry point is used to find a single edge from above but also
|
1957 |
|
|
; when detecting a read-in signal on the tape.
|
1958 |
|
|
|
1959 |
|
|
;; LD-EDGE-1
|
1960 |
|
|
L05E7: LD A,$16 ; a delay value of twenty two.
|
1961 |
|
|
|
1962 |
|
|
;; LD-DELAY
|
1963 |
|
|
L05E9: DEC A ; decrement counter
|
1964 |
|
|
JR NZ,L05E9 ; loop back to LD-DELAY 22 times.
|
1965 |
|
|
|
1966 |
|
|
AND A ; clear carry.
|
1967 |
|
|
|
1968 |
|
|
;; LD-SAMPLE
|
1969 |
|
|
L05ED: INC B ; increment the time-out counter.
|
1970 |
|
|
RET Z ; return with failure when $FF passed.
|
1971 |
|
|
|
1972 |
|
|
LD A,$7F ; prepare to read keyboard and EAR port
|
1973 |
|
|
IN A,($FE) ; row $7FFE. bit 6 is EAR, bit 0 is SPACE key.
|
1974 |
|
|
RRA ; test outer key the space. (bit 6 moves to 5)
|
1975 |
|
|
RET NC ; return if space pressed. >>>
|
1976 |
|
|
|
1977 |
|
|
XOR C ; compare with initial long-term state.
|
1978 |
|
|
AND $20 ; isolate bit 5
|
1979 |
|
|
JR Z,L05ED ; back to LD-SAMPLE if no edge.
|
1980 |
|
|
|
1981 |
|
|
; but an edge, a transition of the EAR bit, has been found so switch the
|
1982 |
|
|
; long-term comparison byte containing both border colour and EAR bit.
|
1983 |
|
|
|
1984 |
|
|
LD A,C ; fetch comparison value.
|
1985 |
|
|
CPL ; switch the bits
|
1986 |
|
|
LD C,A ; and put back in C for long-term.
|
1987 |
|
|
|
1988 |
|
|
AND $07 ; isolate new colour bits.
|
1989 |
|
|
OR $08 ; set bit 3 - MIC off.
|
1990 |
|
|
OUT ($FE),A ; send to port to effect the change of colour.
|
1991 |
|
|
|
1992 |
|
|
SCF ; set carry flag signaling edge found within
|
1993 |
|
|
; time allowed.
|
1994 |
|
|
RET ; return.
|
1995 |
|
|
|
1996 |
|
|
; ---------------------------------
|
1997 |
|
|
; Entry point for all tape commands
|
1998 |
|
|
; ---------------------------------
|
1999 |
|
|
; This is the single entry point for the four tape commands.
|
2000 |
|
|
; The routine first determines in what context it has been called by examining
|
2001 |
|
|
; the low byte of the Syntax table entry which was stored in T_ADDR.
|
2002 |
|
|
; Subtracting $EO (the present arrangement) gives a value of
|
2003 |
|
|
; $00 - SAVE
|
2004 |
|
|
; $01 - LOAD
|
2005 |
|
|
; $02 - VERIFY
|
2006 |
|
|
; $03 - MERGE
|
2007 |
|
|
; As with all commands the address STMT-RET is on the stack.
|
2008 |
|
|
|
2009 |
|
|
;; SAVE-ETC
|
2010 |
|
|
L0605: POP AF ; discard address STMT-RET.
|
2011 |
|
|
LD A,($5C74) ; fetch T_ADDR
|
2012 |
|
|
|
2013 |
|
|
; Now reduce the low byte of the Syntax table entry to give command.
|
2014 |
|
|
; Note. For ZASM use SUB $E0 as next instruction.
|
2015 |
|
|
|
2016 |
|
|
L0609: SUB L1ADF + 1 % 256 ; subtract the known offset.
|
2017 |
|
|
; ( is SUB $E0 in standard ROM )
|
2018 |
|
|
|
2019 |
|
|
LD ($5C74),A ; and put back in T_ADDR as 0,1,2, or 3
|
2020 |
|
|
; for future reference.
|
2021 |
|
|
|
2022 |
|
|
CALL L1C8C ; routine EXPT-EXP checks that a string
|
2023 |
|
|
; expression follows and stacks the
|
2024 |
|
|
; parameters in run-time.
|
2025 |
|
|
|
2026 |
|
|
CALL L2530 ; routine SYNTAX-Z
|
2027 |
|
|
JR Z,L0652 ; forward to SA-DATA if checking syntax.
|
2028 |
|
|
|
2029 |
|
|
LD BC,$0011 ; presume seventeen bytes for a header.
|
2030 |
|
|
LD A,($5C74) ; fetch command from T_ADDR.
|
2031 |
|
|
AND A ; test for zero - SAVE.
|
2032 |
|
|
JR Z,L0621 ; forward to SA-SPACE if so.
|
2033 |
|
|
|
2034 |
|
|
LD C,$22 ; else double length to thirty four.
|
2035 |
|
|
|
2036 |
|
|
;; SA-SPACE
|
2037 |
|
|
L0621: RST 30H ; BC-SPACES creates 17/34 bytes in workspace.
|
2038 |
|
|
|
2039 |
|
|
PUSH DE ; transfer the start of new space to
|
2040 |
|
|
POP IX ; the available index register.
|
2041 |
|
|
|
2042 |
|
|
; ten spaces are required for the default filename but it is simpler to
|
2043 |
|
|
; overwrite the first file-type indicator byte as well.
|
2044 |
|
|
|
2045 |
|
|
LD B,$0B ; set counter to eleven.
|
2046 |
|
|
LD A,$20 ; prepare a space.
|
2047 |
|
|
|
2048 |
|
|
;; SA-BLANK
|
2049 |
|
|
L0629: LD (DE),A ; set workspace location to space.
|
2050 |
|
|
INC DE ; next location.
|
2051 |
|
|
DJNZ L0629 ; loop back to SA-BLANK till all eleven done.
|
2052 |
|
|
|
2053 |
|
|
LD (IX+$01),$FF ; set first byte of ten character filename
|
2054 |
|
|
; to $FF as a default to signal null string.
|
2055 |
|
|
|
2056 |
|
|
CALL L2BF1 ; routine STK-FETCH fetches the filename
|
2057 |
|
|
; parameters from the calculator stack.
|
2058 |
|
|
; length of string in BC.
|
2059 |
|
|
; start of string in DE.
|
2060 |
|
|
|
2061 |
|
|
LD HL,$FFF6 ; prepare the value minus ten.
|
2062 |
|
|
DEC BC ; decrement length.
|
2063 |
|
|
; ten becomes nine, zero becomes $FFFF.
|
2064 |
|
|
ADD HL,BC ; trial addition.
|
2065 |
|
|
INC BC ; restore true length.
|
2066 |
|
|
JR NC,L064B ; forward to SA-NAME if length is one to ten.
|
2067 |
|
|
|
2068 |
|
|
; the filename is more than ten characters in length or the null string.
|
2069 |
|
|
|
2070 |
|
|
LD A,($5C74) ; fetch command from T_ADDR.
|
2071 |
|
|
AND A ; test for zero - SAVE.
|
2072 |
|
|
JR NZ,L0644 ; forward to SA-NULL if not the SAVE command.
|
2073 |
|
|
|
2074 |
|
|
; but no more than ten characters are allowed for SAVE.
|
2075 |
|
|
; The first ten characters of any other command parameter are acceptable.
|
2076 |
|
|
; Weird, but necessary, if saving to sectors.
|
2077 |
|
|
; Note. the golden rule that there are no restriction on anything is broken.
|
2078 |
|
|
|
2079 |
|
|
;; REPORT-Fa
|
2080 |
|
|
L0642: RST 08H ; ERROR-1
|
2081 |
|
|
DEFB $0E ; Error Report: Invalid file name
|
2082 |
|
|
|
2083 |
|
|
; continue with LOAD, MERGE, VERIFY and also SAVE within ten character limit.
|
2084 |
|
|
|
2085 |
|
|
;; SA-NULL
|
2086 |
|
|
L0644: LD A,B ; test length of filename
|
2087 |
|
|
OR C ; for zero.
|
2088 |
|
|
JR Z,L0652 ; forward to SA-DATA if so using the 255
|
2089 |
|
|
; indicator followed by spaces.
|
2090 |
|
|
|
2091 |
|
|
LD BC,$000A ; else trim length to ten.
|
2092 |
|
|
|
2093 |
|
|
; other paths rejoin here with BC holding length in range 1 - 10.
|
2094 |
|
|
|
2095 |
|
|
;; SA-NAME
|
2096 |
|
|
L064B: PUSH IX ; push start of file descriptor.
|
2097 |
|
|
POP HL ; and pop into HL.
|
2098 |
|
|
|
2099 |
|
|
INC HL ; HL now addresses first byte of filename.
|
2100 |
|
|
EX DE,HL ; transfer destination address to DE, start
|
2101 |
|
|
; of string in command to HL.
|
2102 |
|
|
LDIR ; copy up to ten bytes
|
2103 |
|
|
; if less than ten then trailing spaces follow.
|
2104 |
|
|
|
2105 |
|
|
; the case for the null string rejoins here.
|
2106 |
|
|
|
2107 |
|
|
;; SA-DATA
|
2108 |
|
|
L0652: RST 18H ; GET-CHAR
|
2109 |
|
|
CP $E4 ; is character after filename the token 'DATA' ?
|
2110 |
|
|
JR NZ,L06A0 ; forward to SA-SCR$ to consider SCREEN$ if
|
2111 |
|
|
; not.
|
2112 |
|
|
|
2113 |
|
|
; continue to consider DATA.
|
2114 |
|
|
|
2115 |
|
|
LD A,($5C74) ; fetch command from T_ADDR
|
2116 |
|
|
CP $03 ; is it 'VERIFY' ?
|
2117 |
|
|
JP Z,L1C8A ; jump forward to REPORT-C if so.
|
2118 |
|
|
; 'Nonsense in BASIC'
|
2119 |
|
|
; VERIFY "d" DATA is not allowed.
|
2120 |
|
|
|
2121 |
|
|
; continue with SAVE, LOAD, MERGE of DATA.
|
2122 |
|
|
|
2123 |
|
|
RST 20H ; NEXT-CHAR
|
2124 |
|
|
CALL L28B2 ; routine LOOK-VARS searches variables area
|
2125 |
|
|
; returning with carry reset if found or
|
2126 |
|
|
; checking syntax.
|
2127 |
|
|
SET 7,C ; this converts a simple string to a
|
2128 |
|
|
; string array. The test for an array or string
|
2129 |
|
|
; comes later.
|
2130 |
|
|
JR NC,L0672 ; forward to SA-V-OLD if variable found.
|
2131 |
|
|
|
2132 |
|
|
LD HL,$0000 ; set destination to zero as not fixed.
|
2133 |
|
|
LD A,($5C74) ; fetch command from T_ADDR
|
2134 |
|
|
DEC A ; test for 1 - LOAD
|
2135 |
|
|
JR Z,L0685 ; forward to SA-V-NEW with LOAD DATA.
|
2136 |
|
|
; to load a new array.
|
2137 |
|
|
|
2138 |
|
|
; otherwise the variable was not found in run-time with SAVE/MERGE.
|
2139 |
|
|
|
2140 |
|
|
;; REPORT-2a
|
2141 |
|
|
L0670: RST 08H ; ERROR-1
|
2142 |
|
|
DEFB $01 ; Error Report: Variable not found
|
2143 |
|
|
|
2144 |
|
|
; continue with SAVE/LOAD DATA
|
2145 |
|
|
|
2146 |
|
|
;; SA-V-OLD
|
2147 |
|
|
L0672: JP NZ,L1C8A ; to REPORT-C if not an array variable.
|
2148 |
|
|
; or erroneously a simple string.
|
2149 |
|
|
; 'Nonsense in BASIC'
|
2150 |
|
|
|
2151 |
|
|
|
2152 |
|
|
CALL L2530 ; routine SYNTAX-Z
|
2153 |
|
|
JR Z,L0692 ; forward to SA-DATA-1 if checking syntax.
|
2154 |
|
|
|
2155 |
|
|
INC HL ; step past single character variable name.
|
2156 |
|
|
LD A,(HL) ; fetch low byte of length.
|
2157 |
|
|
LD (IX+$0B),A ; place in descriptor.
|
2158 |
|
|
INC HL ; point to high byte.
|
2159 |
|
|
LD A,(HL) ; and transfer that
|
2160 |
|
|
LD (IX+$0C),A ; to descriptor.
|
2161 |
|
|
INC HL ; increase pointer within variable.
|
2162 |
|
|
|
2163 |
|
|
;; SA-V-NEW
|
2164 |
|
|
L0685: LD (IX+$0E),C ; place character array name in header.
|
2165 |
|
|
LD A,$01 ; default to type numeric.
|
2166 |
|
|
BIT 6,C ; test result from look-vars.
|
2167 |
|
|
JR Z,L068F ; forward to SA-V-TYPE if numeric.
|
2168 |
|
|
|
2169 |
|
|
INC A ; set type to 2 - string array.
|
2170 |
|
|
|
2171 |
|
|
;; SA-V-TYPE
|
2172 |
|
|
L068F: LD (IX+$00),A ; place type 0, 1 or 2 in descriptor.
|
2173 |
|
|
|
2174 |
|
|
;; SA-DATA-1
|
2175 |
|
|
L0692: EX DE,HL ; save var pointer in DE
|
2176 |
|
|
|
2177 |
|
|
RST 20H ; NEXT-CHAR
|
2178 |
|
|
CP $29 ; is character ')' ?
|
2179 |
|
|
JR NZ,L0672 ; back if not to SA-V-OLD to report
|
2180 |
|
|
; 'Nonsense in BASIC'
|
2181 |
|
|
|
2182 |
|
|
RST 20H ; NEXT-CHAR advances character address.
|
2183 |
|
|
CALL L1BEE ; routine CHECK-END errors if not end of
|
2184 |
|
|
; the statement.
|
2185 |
|
|
|
2186 |
|
|
EX DE,HL ; bring back variables data pointer.
|
2187 |
|
|
JP L075A ; jump forward to SA-ALL
|
2188 |
|
|
|
2189 |
|
|
; ---
|
2190 |
|
|
; the branch was here to consider a 'SCREEN$', the display file.
|
2191 |
|
|
|
2192 |
|
|
;; SA-SCR$
|
2193 |
|
|
L06A0: CP $AA ; is character the token 'SCREEN$' ?
|
2194 |
|
|
JR NZ,L06C3 ; forward to SA-CODE if not.
|
2195 |
|
|
|
2196 |
|
|
LD A,($5C74) ; fetch command from T_ADDR
|
2197 |
|
|
CP $03 ; is it MERGE ?
|
2198 |
|
|
JP Z,L1C8A ; jump to REPORT-C if so.
|
2199 |
|
|
; 'Nonsense in BASIC'
|
2200 |
|
|
|
2201 |
|
|
; continue with SAVE/LOAD/VERIFY SCREEN$.
|
2202 |
|
|
|
2203 |
|
|
RST 20H ; NEXT-CHAR
|
2204 |
|
|
CALL L1BEE ; routine CHECK-END errors if not at end of
|
2205 |
|
|
; statement.
|
2206 |
|
|
|
2207 |
|
|
; continue in runtime.
|
2208 |
|
|
|
2209 |
|
|
LD (IX+$0B),$00 ; set descriptor length
|
2210 |
|
|
LD (IX+$0C),$1B ; to $1b00 to include bitmaps and attributes.
|
2211 |
|
|
|
2212 |
|
|
LD HL,$4000 ; set start to display file start.
|
2213 |
|
|
LD (IX+$0D),L ; place start in
|
2214 |
|
|
LD (IX+$0E),H ; the descriptor.
|
2215 |
|
|
JR L0710 ; forward to SA-TYPE-3
|
2216 |
|
|
|
2217 |
|
|
; ---
|
2218 |
|
|
; the branch was here to consider CODE.
|
2219 |
|
|
|
2220 |
|
|
;; SA-CODE
|
2221 |
|
|
L06C3: CP $AF ; is character the token 'CODE' ?
|
2222 |
|
|
JR NZ,L0716 ; forward if not to SA-LINE to consider an
|
2223 |
|
|
; auto-started BASIC program.
|
2224 |
|
|
|
2225 |
|
|
LD A,($5C74) ; fetch command from T_ADDR
|
2226 |
|
|
CP $03 ; is it MERGE ?
|
2227 |
|
|
JP Z,L1C8A ; jump forward to REPORT-C if so.
|
2228 |
|
|
; 'Nonsense in BASIC'
|
2229 |
|
|
|
2230 |
|
|
|
2231 |
|
|
RST 20H ; NEXT-CHAR advances character address.
|
2232 |
|
|
CALL L2048 ; routine PR-ST-END checks if a carriage
|
2233 |
|
|
; return or ':' follows.
|
2234 |
|
|
JR NZ,L06E1 ; forward to SA-CODE-1 if there are parameters.
|
2235 |
|
|
|
2236 |
|
|
LD A,($5C74) ; else fetch the command from T_ADDR.
|
2237 |
|
|
AND A ; test for zero - SAVE without a specification.
|
2238 |
|
|
JP Z,L1C8A ; jump to REPORT-C if so.
|
2239 |
|
|
; 'Nonsense in BASIC'
|
2240 |
|
|
|
2241 |
|
|
; for LOAD/VERIFY put zero on stack to signify handle at location saved from.
|
2242 |
|
|
|
2243 |
|
|
CALL L1CE6 ; routine USE-ZERO
|
2244 |
|
|
JR L06F0 ; forward to SA-CODE-2
|
2245 |
|
|
|
2246 |
|
|
; ---
|
2247 |
|
|
|
2248 |
|
|
; if there are more characters after CODE expect start and possibly length.
|
2249 |
|
|
|
2250 |
|
|
;; SA-CODE-1
|
2251 |
|
|
L06E1: CALL L1C82 ; routine EXPT-1NUM checks for numeric
|
2252 |
|
|
; expression and stacks it in run-time.
|
2253 |
|
|
|
2254 |
|
|
RST 18H ; GET-CHAR
|
2255 |
|
|
CP $2C ; does a comma follow ?
|
2256 |
|
|
JR Z,L06F5 ; forward if so to SA-CODE-3
|
2257 |
|
|
|
2258 |
|
|
; else allow saved code to be loaded to a specified address.
|
2259 |
|
|
|
2260 |
|
|
LD A,($5C74) ; fetch command from T_ADDR.
|
2261 |
|
|
AND A ; is the command SAVE which requires length ?
|
2262 |
|
|
JP Z,L1C8A ; jump to REPORT-C if so.
|
2263 |
|
|
; 'Nonsense in BASIC'
|
2264 |
|
|
|
2265 |
|
|
; the command LOAD code may rejoin here with zero stacked as start.
|
2266 |
|
|
|
2267 |
|
|
;; SA-CODE-2
|
2268 |
|
|
L06F0: CALL L1CE6 ; routine USE-ZERO stacks zero for length.
|
2269 |
|
|
JR L06F9 ; forward to SA-CODE-4
|
2270 |
|
|
|
2271 |
|
|
; ---
|
2272 |
|
|
; the branch was here with SAVE CODE start,
|
2273 |
|
|
|
2274 |
|
|
;; SA-CODE-3
|
2275 |
|
|
L06F5: RST 20H ; NEXT-CHAR advances character address.
|
2276 |
|
|
CALL L1C82 ; routine EXPT-1NUM checks for expression
|
2277 |
|
|
; and stacks in run-time.
|
2278 |
|
|
|
2279 |
|
|
; paths converge here and nothing must follow.
|
2280 |
|
|
|
2281 |
|
|
;; SA-CODE-4
|
2282 |
|
|
L06F9: CALL L1BEE ; routine CHECK-END errors with extraneous
|
2283 |
|
|
; characters and quits if checking syntax.
|
2284 |
|
|
|
2285 |
|
|
; in run-time there are two 16-bit parameters on the calculator stack.
|
2286 |
|
|
|
2287 |
|
|
CALL L1E99 ; routine FIND-INT2 gets length.
|
2288 |
|
|
LD (IX+$0B),C ; place length
|
2289 |
|
|
LD (IX+$0C),B ; in descriptor.
|
2290 |
|
|
CALL L1E99 ; routine FIND-INT2 gets start.
|
2291 |
|
|
LD (IX+$0D),C ; place start
|
2292 |
|
|
LD (IX+$0E),B ; in descriptor.
|
2293 |
|
|
LD H,B ; transfer the
|
2294 |
|
|
LD L,C ; start to HL also.
|
2295 |
|
|
|
2296 |
|
|
;; SA-TYPE-3
|
2297 |
|
|
L0710: LD (IX+$00),$03 ; place type 3 - code in descriptor.
|
2298 |
|
|
JR L075A ; forward to SA-ALL.
|
2299 |
|
|
|
2300 |
|
|
; ---
|
2301 |
|
|
; the branch was here with BASIC to consider an optional auto-start line
|
2302 |
|
|
; number.
|
2303 |
|
|
|
2304 |
|
|
;; SA-LINE
|
2305 |
|
|
L0716: CP $CA ; is character the token 'LINE' ?
|
2306 |
|
|
JR Z,L0723 ; forward to SA-LINE-1 if so.
|
2307 |
|
|
|
2308 |
|
|
; else all possibilities have been considered and nothing must follow.
|
2309 |
|
|
|
2310 |
|
|
CALL L1BEE ; routine CHECK-END
|
2311 |
|
|
|
2312 |
|
|
; continue in run-time to save BASIC without auto-start.
|
2313 |
|
|
|
2314 |
|
|
LD (IX+$0E),$80 ; place high line number in descriptor to
|
2315 |
|
|
; disable auto-start.
|
2316 |
|
|
JR L073A ; forward to SA-TYPE-0 to save program.
|
2317 |
|
|
|
2318 |
|
|
; ---
|
2319 |
|
|
; the branch was here to consider auto-start.
|
2320 |
|
|
|
2321 |
|
|
;; SA-LINE-1
|
2322 |
|
|
L0723: LD A,($5C74) ; fetch command from T_ADDR
|
2323 |
|
|
AND A ; test for SAVE.
|
2324 |
|
|
JP NZ,L1C8A ; jump forward to REPORT-C with anything else.
|
2325 |
|
|
; 'Nonsense in BASIC'
|
2326 |
|
|
|
2327 |
|
|
;
|
2328 |
|
|
|
2329 |
|
|
RST 20H ; NEXT-CHAR
|
2330 |
|
|
CALL L1C82 ; routine EXPT-1NUM checks for numeric
|
2331 |
|
|
; expression and stacks in run-time.
|
2332 |
|
|
CALL L1BEE ; routine CHECK-END quits if syntax path.
|
2333 |
|
|
CALL L1E99 ; routine FIND-INT2 fetches the numeric
|
2334 |
|
|
; expression.
|
2335 |
|
|
LD (IX+$0D),C ; place the auto-start
|
2336 |
|
|
LD (IX+$0E),B ; line number in the descriptor.
|
2337 |
|
|
|
2338 |
|
|
; Note. this isn't checked, but is subsequently handled by the system.
|
2339 |
|
|
; If the user typed 40000 instead of 4000 then it won't auto-start
|
2340 |
|
|
; at line 4000, or indeed, at all.
|
2341 |
|
|
|
2342 |
|
|
; continue to save program and any variables.
|
2343 |
|
|
|
2344 |
|
|
;; SA-TYPE-0
|
2345 |
|
|
L073A: LD (IX+$00),$00 ; place type zero - program in descriptor.
|
2346 |
|
|
LD HL,($5C59) ; fetch E_LINE to HL.
|
2347 |
|
|
LD DE,($5C53) ; fetch PROG to DE.
|
2348 |
|
|
SCF ; set carry flag to calculate from end of
|
2349 |
|
|
; variables E_LINE -1.
|
2350 |
|
|
SBC HL,DE ; subtract to give total length.
|
2351 |
|
|
|
2352 |
|
|
LD (IX+$0B),L ; place total length
|
2353 |
|
|
LD (IX+$0C),H ; in descriptor.
|
2354 |
|
|
LD HL,($5C4B) ; load HL from system variable VARS
|
2355 |
|
|
SBC HL,DE ; subtract to give program length.
|
2356 |
|
|
LD (IX+$0F),L ; place length of program
|
2357 |
|
|
LD (IX+$10),H ; in the descriptor.
|
2358 |
|
|
EX DE,HL ; start to HL, length to DE.
|
2359 |
|
|
|
2360 |
|
|
;; SA-ALL
|
2361 |
|
|
L075A: LD A,($5C74) ; fetch command from T_ADDR
|
2362 |
|
|
AND A ; test for zero - SAVE.
|
2363 |
|
|
JP Z,L0970 ; jump forward to SA-CONTRL with SAVE ->
|
2364 |
|
|
|
2365 |
|
|
; ---
|
2366 |
|
|
; continue with LOAD, MERGE and VERIFY.
|
2367 |
|
|
|
2368 |
|
|
PUSH HL ; save start.
|
2369 |
|
|
LD BC,$0011 ; prepare to add seventeen
|
2370 |
|
|
ADD IX,BC ; to point IX at second descriptor.
|
2371 |
|
|
|
2372 |
|
|
;; LD-LOOK-H
|
2373 |
|
|
L0767: PUSH IX ; save IX
|
2374 |
|
|
LD DE,$0011 ; seventeen bytes
|
2375 |
|
|
XOR A ; reset zero flag
|
2376 |
|
|
SCF ; set carry flag
|
2377 |
|
|
CALL L0556 ; routine LD-BYTES loads a header from tape
|
2378 |
|
|
; to second descriptor.
|
2379 |
|
|
POP IX ; restore IX.
|
2380 |
|
|
JR NC,L0767 ; loop back to LD-LOOK-H until header found.
|
2381 |
|
|
|
2382 |
|
|
LD A,$FE ; select system channel 'S'
|
2383 |
|
|
CALL L1601 ; routine CHAN-OPEN opens it.
|
2384 |
|
|
|
2385 |
|
|
LD (IY+$52),$03 ; set SCR_CT to 3 lines.
|
2386 |
|
|
|
2387 |
|
|
LD C,$80 ; C has bit 7 set to indicate type mismatch as
|
2388 |
|
|
; a default startpoint.
|
2389 |
|
|
|
2390 |
|
|
LD A,(IX+$00) ; fetch loaded header type to A
|
2391 |
|
|
CP (IX-$11) ; compare with expected type.
|
2392 |
|
|
JR NZ,L078A ; forward to LD-TYPE with mis-match.
|
2393 |
|
|
|
2394 |
|
|
LD C,$F6 ; set C to minus ten - will count characters
|
2395 |
|
|
; up to zero.
|
2396 |
|
|
|
2397 |
|
|
;; LD-TYPE
|
2398 |
|
|
L078A: CP $04 ; check if type in acceptable range 0 - 3.
|
2399 |
|
|
JR NC,L0767 ; back to LD-LOOK-H with 4 and over.
|
2400 |
|
|
|
2401 |
|
|
; else A indicates type 0-3.
|
2402 |
|
|
|
2403 |
|
|
LD DE,L09C0 ; address base of last 4 tape messages
|
2404 |
|
|
PUSH BC ; save BC
|
2405 |
|
|
CALL L0C0A ; routine PO-MSG outputs relevant message.
|
2406 |
|
|
; Note. all messages have a leading newline.
|
2407 |
|
|
POP BC ; restore BC
|
2408 |
|
|
|
2409 |
|
|
PUSH IX ; transfer IX,
|
2410 |
|
|
POP DE ; the 2nd descriptor, to DE.
|
2411 |
|
|
LD HL,$FFF0 ; prepare minus seventeen.
|
2412 |
|
|
ADD HL,DE ; add to point HL to 1st descriptor.
|
2413 |
|
|
LD B,$0A ; the count will be ten characters for the
|
2414 |
|
|
; filename.
|
2415 |
|
|
|
2416 |
|
|
LD A,(HL) ; fetch first character and test for
|
2417 |
|
|
INC A ; value 255.
|
2418 |
|
|
JR NZ,L07A6 ; forward to LD-NAME if not the wildcard.
|
2419 |
|
|
|
2420 |
|
|
; but if it is the wildcard, then add ten to C which is minus ten for a type
|
2421 |
|
|
; match or -128 for a type mismatch. Although characters have to be counted
|
2422 |
|
|
; bit 7 of C will not alter from state set here.
|
2423 |
|
|
|
2424 |
|
|
LD A,C ; transfer $F6 or $80 to A
|
2425 |
|
|
ADD A,B ; add $0A
|
2426 |
|
|
LD C,A ; place result, zero or -118, in C.
|
2427 |
|
|
|
2428 |
|
|
; At this point we have either a type mismatch, a wildcard match or ten
|
2429 |
|
|
; characters to be counted. The characters must be shown on the screen.
|
2430 |
|
|
|
2431 |
|
|
;; LD-NAME
|
2432 |
|
|
L07A6: INC DE ; address next input character
|
2433 |
|
|
LD A,(DE) ; fetch character
|
2434 |
|
|
CP (HL) ; compare to expected
|
2435 |
|
|
INC HL ; address next expected character
|
2436 |
|
|
JR NZ,L07AD ; forward to LD-CH-PR with mismatch
|
2437 |
|
|
|
2438 |
|
|
INC C ; increment matched character count
|
2439 |
|
|
|
2440 |
|
|
;; LD-CH-PR
|
2441 |
|
|
L07AD: RST 10H ; PRINT-A prints character
|
2442 |
|
|
DJNZ L07A6 ; loop back to LD-NAME for ten characters.
|
2443 |
|
|
|
2444 |
|
|
; if ten characters matched and the types previously matched then C will
|
2445 |
|
|
; now hold zero.
|
2446 |
|
|
|
2447 |
|
|
BIT 7,C ; test if all matched
|
2448 |
|
|
JR NZ,L0767 ; back to LD-LOOK-H if not
|
2449 |
|
|
|
2450 |
|
|
; else print a terminal carriage return.
|
2451 |
|
|
|
2452 |
|
|
LD A,$0D ; prepare carriage return.
|
2453 |
|
|
RST 10H ; PRINT-A outputs it.
|
2454 |
|
|
|
2455 |
|
|
; The various control routines for LOAD, VERIFY and MERGE are executed
|
2456 |
|
|
; during the one-second gap following the header on tape.
|
2457 |
|
|
|
2458 |
|
|
POP HL ; restore xx
|
2459 |
|
|
LD A,(IX+$00) ; fetch incoming type
|
2460 |
|
|
CP $03 ; compare with CODE
|
2461 |
|
|
JR Z,L07CB ; forward to VR-CONTRL if it is CODE.
|
2462 |
|
|
|
2463 |
|
|
; type is a program or an array.
|
2464 |
|
|
|
2465 |
|
|
LD A,($5C74) ; fetch command from T_ADDR
|
2466 |
|
|
DEC A ; was it LOAD ?
|
2467 |
|
|
JP Z,L0808 ; JUMP forward to LD-CONTRL if so to
|
2468 |
|
|
; load BASIC or variables.
|
2469 |
|
|
|
2470 |
|
|
CP $02 ; was command MERGE ?
|
2471 |
|
|
JP Z,L08B6 ; jump forward to ME-CONTRL if so.
|
2472 |
|
|
|
2473 |
|
|
; else continue into VERIFY control routine to verify.
|
2474 |
|
|
|
2475 |
|
|
; ----------------------------
|
2476 |
|
|
; THE 'VERIFY CONTROL' ROUTINE
|
2477 |
|
|
; ----------------------------
|
2478 |
|
|
; There are two branches to this routine.
|
2479 |
|
|
; 1) From above to verify a program or array
|
2480 |
|
|
; 2) from earlier with no carry to load or verify code.
|
2481 |
|
|
|
2482 |
|
|
;; VR-CONTRL
|
2483 |
|
|
L07CB: PUSH HL ; save pointer to data.
|
2484 |
|
|
LD L,(IX-$06) ; fetch length of old data
|
2485 |
|
|
LD H,(IX-$05) ; to HL.
|
2486 |
|
|
LD E,(IX+$0B) ; fetch length of new data
|
2487 |
|
|
LD D,(IX+$0C) ; to DE.
|
2488 |
|
|
LD A,H ; check length of old
|
2489 |
|
|
OR L ; for zero.
|
2490 |
|
|
JR Z,L07E9 ; forward to VR-CONT-1 if length unspecified
|
2491 |
|
|
; e.g. LOAD "x" CODE
|
2492 |
|
|
|
2493 |
|
|
; as opposed to, say, LOAD 'x' CODE 32768,300.
|
2494 |
|
|
|
2495 |
|
|
SBC HL,DE ; subtract the two lengths.
|
2496 |
|
|
JR C,L0806 ; forward to REPORT-R if the length on tape is
|
2497 |
|
|
; larger than that specified in command.
|
2498 |
|
|
; 'Tape loading error'
|
2499 |
|
|
|
2500 |
|
|
JR Z,L07E9 ; forward to VR-CONT-1 if lengths match.
|
2501 |
|
|
|
2502 |
|
|
; a length on tape shorter than expected is not allowed for CODE
|
2503 |
|
|
|
2504 |
|
|
LD A,(IX+$00) ; else fetch type from tape.
|
2505 |
|
|
CP $03 ; is it CODE ?
|
2506 |
|
|
JR NZ,L0806 ; forward to REPORT-R if so
|
2507 |
|
|
; 'Tape loading error'
|
2508 |
|
|
|
2509 |
|
|
;; VR-CONT-1
|
2510 |
|
|
L07E9: POP HL ; pop pointer to data
|
2511 |
|
|
LD A,H ; test for zero
|
2512 |
|
|
OR L ; e.g. LOAD 'x' CODE
|
2513 |
|
|
JR NZ,L07F4 ; forward to VR-CONT-2 if destination specified.
|
2514 |
|
|
|
2515 |
|
|
LD L,(IX+$0D) ; else use the destination in the header
|
2516 |
|
|
LD H,(IX+$0E) ; and load code at address saved from.
|
2517 |
|
|
|
2518 |
|
|
;; VR-CONT-2
|
2519 |
|
|
L07F4: PUSH HL ; push pointer to start of data block.
|
2520 |
|
|
POP IX ; transfer to IX.
|
2521 |
|
|
LD A,($5C74) ; fetch reduced command from T_ADDR
|
2522 |
|
|
CP $02 ; is it VERIFY ?
|
2523 |
|
|
SCF ; prepare a set carry flag
|
2524 |
|
|
JR NZ,L0800 ; skip to VR-CONT-3 if not
|
2525 |
|
|
|
2526 |
|
|
AND A ; clear carry flag for VERIFY so that
|
2527 |
|
|
; data is not loaded.
|
2528 |
|
|
|
2529 |
|
|
;; VR-CONT-3
|
2530 |
|
|
L0800: LD A,$FF ; signal data block to be loaded
|
2531 |
|
|
|
2532 |
|
|
; -----------------
|
2533 |
|
|
; Load a data block
|
2534 |
|
|
; -----------------
|
2535 |
|
|
; This routine is called from 3 places other than above to load a data block.
|
2536 |
|
|
; In all cases the accumulator is first set to $FF so the routine could be
|
2537 |
|
|
; called at the previous instruction.
|
2538 |
|
|
|
2539 |
|
|
;; LD-BLOCK
|
2540 |
|
|
L0802: CALL L0556 ; routine LD-BYTES
|
2541 |
|
|
RET C ; return if successful.
|
2542 |
|
|
|
2543 |
|
|
|
2544 |
|
|
;; REPORT-R
|
2545 |
|
|
L0806: RST 08H ; ERROR-1
|
2546 |
|
|
DEFB $1A ; Error Report: Tape loading error
|
2547 |
|
|
|
2548 |
|
|
; --------------------------
|
2549 |
|
|
; THE 'LOAD CONTROL' ROUTINE
|
2550 |
|
|
; --------------------------
|
2551 |
|
|
; This branch is taken when the command is LOAD with type 0, 1 or 2.
|
2552 |
|
|
|
2553 |
|
|
;; LD-CONTRL
|
2554 |
|
|
L0808: LD E,(IX+$0B) ; fetch length of found data block
|
2555 |
|
|
LD D,(IX+$0C) ; from 2nd descriptor.
|
2556 |
|
|
PUSH HL ; save destination
|
2557 |
|
|
LD A,H ; test for zero
|
2558 |
|
|
OR L ;
|
2559 |
|
|
JR NZ,L0819 ; forward if not to LD-CONT-1
|
2560 |
|
|
|
2561 |
|
|
INC DE ; increase length
|
2562 |
|
|
INC DE ; for letter name
|
2563 |
|
|
INC DE ; and 16-bit length
|
2564 |
|
|
EX DE,HL ; length to HL,
|
2565 |
|
|
JR L0825 ; forward to LD-CONT-2
|
2566 |
|
|
|
2567 |
|
|
; ---
|
2568 |
|
|
|
2569 |
|
|
;; LD-CONT-1
|
2570 |
|
|
L0819: LD L,(IX-$06) ; fetch length from
|
2571 |
|
|
LD H,(IX-$05) ; the first header.
|
2572 |
|
|
EX DE,HL ;
|
2573 |
|
|
SCF ; set carry flag
|
2574 |
|
|
SBC HL,DE ;
|
2575 |
|
|
JR C,L082E ; to LD-DATA
|
2576 |
|
|
|
2577 |
|
|
;; LD-CONT-2
|
2578 |
|
|
L0825: LD DE,$0005 ; allow overhead of five bytes.
|
2579 |
|
|
ADD HL,DE ; add in the difference in data lengths.
|
2580 |
|
|
LD B,H ; transfer to
|
2581 |
|
|
LD C,L ; the BC register pair
|
2582 |
|
|
CALL L1F05 ; routine TEST-ROOM fails if not enough room.
|
2583 |
|
|
|
2584 |
|
|
;; LD-DATA
|
2585 |
|
|
L082E: POP HL ; pop destination
|
2586 |
|
|
LD A,(IX+$00) ; fetch type 0, 1 or 2.
|
2587 |
|
|
AND A ; test for program and variables.
|
2588 |
|
|
JR Z,L0873 ; forward if so to LD-PROG
|
2589 |
|
|
|
2590 |
|
|
; the type is a numeric or string array.
|
2591 |
|
|
|
2592 |
|
|
LD A,H ; test the destination for zero
|
2593 |
|
|
OR L ; indicating variable does not already exist.
|
2594 |
|
|
JR Z,L084C ; forward if so to LD-DATA-1
|
2595 |
|
|
|
2596 |
|
|
; else the destination is the first dimension within the array structure
|
2597 |
|
|
|
2598 |
|
|
DEC HL ; address high byte of total length
|
2599 |
|
|
LD B,(HL) ; transfer to B.
|
2600 |
|
|
DEC HL ; address low byte of total length.
|
2601 |
|
|
LD C,(HL) ; transfer to C.
|
2602 |
|
|
DEC HL ; point to letter of variable.
|
2603 |
|
|
INC BC ; adjust length to
|
2604 |
|
|
INC BC ; include these
|
2605 |
|
|
INC BC ; three bytes also.
|
2606 |
|
|
LD ($5C5F),IX ; save header pointer in X_PTR.
|
2607 |
|
|
CALL L19E8 ; routine RECLAIM-2 reclaims the old variable
|
2608 |
|
|
; sliding workspace including the two headers
|
2609 |
|
|
; downwards.
|
2610 |
|
|
LD IX,($5C5F) ; reload IX from X_PTR which will have been
|
2611 |
|
|
; adjusted down by POINTERS routine.
|
2612 |
|
|
|
2613 |
|
|
;; LD-DATA-1
|
2614 |
|
|
L084C: LD HL,($5C59) ; address E_LINE
|
2615 |
|
|
DEC HL ; now point to the $80 variables end-marker.
|
2616 |
|
|
LD C,(IX+$0B) ; fetch new data length
|
2617 |
|
|
LD B,(IX+$0C) ; from 2nd header.
|
2618 |
|
|
PUSH BC ; * save it.
|
2619 |
|
|
INC BC ; adjust the
|
2620 |
|
|
INC BC ; length to include
|
2621 |
|
|
INC BC ; letter name and total length.
|
2622 |
|
|
LD A,(IX-$03) ; fetch letter name from old header.
|
2623 |
|
|
PUSH AF ; preserve accumulator though not corrupted.
|
2624 |
|
|
|
2625 |
|
|
CALL L1655 ; routine MAKE-ROOM creates space for variable
|
2626 |
|
|
; sliding workspace up. IX no longer addresses
|
2627 |
|
|
; anywhere meaningful.
|
2628 |
|
|
INC HL ; point to first new location.
|
2629 |
|
|
|
2630 |
|
|
POP AF ; fetch back the letter name.
|
2631 |
|
|
LD (HL),A ; place in first new location.
|
2632 |
|
|
POP DE ; * pop the data length.
|
2633 |
|
|
INC HL ; address 2nd location
|
2634 |
|
|
LD (HL),E ; store low byte of length.
|
2635 |
|
|
INC HL ; address next.
|
2636 |
|
|
LD (HL),D ; store high byte.
|
2637 |
|
|
INC HL ; address start of data.
|
2638 |
|
|
PUSH HL ; transfer address
|
2639 |
|
|
POP IX ; to IX register pair.
|
2640 |
|
|
SCF ; set carry flag indicating load not verify.
|
2641 |
|
|
LD A,$FF ; signal data not header.
|
2642 |
|
|
JP L0802 ; JUMP back to LD-BLOCK
|
2643 |
|
|
|
2644 |
|
|
; -----------------
|
2645 |
|
|
; the branch is here when a program as opposed to an array is to be loaded.
|
2646 |
|
|
|
2647 |
|
|
;; LD-PROG
|
2648 |
|
|
L0873: EX DE,HL ; transfer dest to DE.
|
2649 |
|
|
LD HL,($5C59) ; address E_LINE
|
2650 |
|
|
DEC HL ; now variables end-marker.
|
2651 |
|
|
LD ($5C5F),IX ; place the IX header pointer in X_PTR
|
2652 |
|
|
LD C,(IX+$0B) ; get new length
|
2653 |
|
|
LD B,(IX+$0C) ; from 2nd header
|
2654 |
|
|
PUSH BC ; and save it.
|
2655 |
|
|
|
2656 |
|
|
CALL L19E5 ; routine RECLAIM-1 reclaims program and vars.
|
2657 |
|
|
; adjusting X-PTR.
|
2658 |
|
|
|
2659 |
|
|
POP BC ; restore new length.
|
2660 |
|
|
PUSH HL ; * save start
|
2661 |
|
|
PUSH BC ; ** and length.
|
2662 |
|
|
|
2663 |
|
|
CALL L1655 ; routine MAKE-ROOM creates the space.
|
2664 |
|
|
|
2665 |
|
|
LD IX,($5C5F) ; reload IX from adjusted X_PTR
|
2666 |
|
|
INC HL ; point to start of new area.
|
2667 |
|
|
LD C,(IX+$0F) ; fetch length of BASIC on tape
|
2668 |
|
|
LD B,(IX+$10) ; from 2nd descriptor
|
2669 |
|
|
ADD HL,BC ; add to address the start of variables.
|
2670 |
|
|
LD ($5C4B),HL ; set system variable VARS
|
2671 |
|
|
|
2672 |
|
|
LD H,(IX+$0E) ; fetch high byte of autostart line number.
|
2673 |
|
|
LD A,H ; transfer to A
|
2674 |
|
|
AND $C0 ; test if greater than $3F.
|
2675 |
|
|
JR NZ,L08AD ; forward to LD-PROG-1 if so with no autostart.
|
2676 |
|
|
|
2677 |
|
|
LD L,(IX+$0D) ; else fetch the low byte.
|
2678 |
|
|
LD ($5C42),HL ; set system variable to line number NEWPPC
|
2679 |
|
|
LD (IY+$0A),$00 ; set statement NSPPC to zero.
|
2680 |
|
|
|
2681 |
|
|
;; LD-PROG-1
|
2682 |
|
|
L08AD: POP DE ; ** pop the length
|
2683 |
|
|
POP IX ; * and start.
|
2684 |
|
|
SCF ; set carry flag
|
2685 |
|
|
LD A,$FF ; signal data as opposed to a header.
|
2686 |
|
|
JP L0802 ; jump back to LD-BLOCK
|
2687 |
|
|
|
2688 |
|
|
; ---------------------------
|
2689 |
|
|
; THE 'MERGE CONTROL' ROUTINE
|
2690 |
|
|
; ---------------------------
|
2691 |
|
|
; the branch was here to merge a program and its variables or an array.
|
2692 |
|
|
;
|
2693 |
|
|
|
2694 |
|
|
;; ME-CONTRL
|
2695 |
|
|
L08B6: LD C,(IX+$0B) ; fetch length
|
2696 |
|
|
LD B,(IX+$0C) ; of data block on tape.
|
2697 |
|
|
PUSH BC ; save it.
|
2698 |
|
|
INC BC ; one for the pot.
|
2699 |
|
|
|
2700 |
|
|
RST 30H ; BC-SPACES creates room in workspace.
|
2701 |
|
|
; HL addresses last new location.
|
2702 |
|
|
LD (HL),$80 ; place end-marker at end.
|
2703 |
|
|
EX DE,HL ; transfer first location to HL.
|
2704 |
|
|
POP DE ; restore length to DE.
|
2705 |
|
|
PUSH HL ; save start.
|
2706 |
|
|
|
2707 |
|
|
PUSH HL ; and transfer it
|
2708 |
|
|
POP IX ; to IX register.
|
2709 |
|
|
SCF ; set carry flag to load data on tape.
|
2710 |
|
|
LD A,$FF ; signal data not a header.
|
2711 |
|
|
CALL L0802 ; routine LD-BLOCK loads to workspace.
|
2712 |
|
|
POP HL ; restore first location in workspace to HL.
|
2713 |
|
|
X08CE LD DE,($5C53) ; set DE from system variable PROG.
|
2714 |
|
|
|
2715 |
|
|
; now enter a loop to merge the data block in workspace with the program and
|
2716 |
|
|
; variables.
|
2717 |
|
|
|
2718 |
|
|
;; ME-NEW-LP
|
2719 |
|
|
L08D2: LD A,(HL) ; fetch next byte from workspace.
|
2720 |
|
|
AND $C0 ; compare with $3F.
|
2721 |
|
|
JR NZ,L08F0 ; forward to ME-VAR-LP if a variable or
|
2722 |
|
|
; end-marker.
|
2723 |
|
|
|
2724 |
|
|
; continue when HL addresses a BASIC line number.
|
2725 |
|
|
|
2726 |
|
|
;; ME-OLD-LP
|
2727 |
|
|
L08D7: LD A,(DE) ; fetch high byte from program area.
|
2728 |
|
|
INC DE ; bump prog address.
|
2729 |
|
|
CP (HL) ; compare with that in workspace.
|
2730 |
|
|
INC HL ; bump workspace address.
|
2731 |
|
|
JR NZ,L08DF ; forward to ME-OLD-L1 if high bytes don't match
|
2732 |
|
|
|
2733 |
|
|
LD A,(DE) ; fetch the low byte of program line number.
|
2734 |
|
|
CP (HL) ; compare with that in workspace.
|
2735 |
|
|
|
2736 |
|
|
;; ME-OLD-L1
|
2737 |
|
|
L08DF: DEC DE ; point to start of
|
2738 |
|
|
DEC HL ; respective lines again.
|
2739 |
|
|
JR NC,L08EB ; forward to ME-NEW-L2 if line number in
|
2740 |
|
|
; workspace is less than or equal to current
|
2741 |
|
|
; program line as has to be added to program.
|
2742 |
|
|
|
2743 |
|
|
PUSH HL ; else save workspace pointer.
|
2744 |
|
|
EX DE,HL ; transfer prog pointer to HL
|
2745 |
|
|
CALL L19B8 ; routine NEXT-ONE finds next line in DE.
|
2746 |
|
|
POP HL ; restore workspace pointer
|
2747 |
|
|
JR L08D7 ; back to ME-OLD-LP until destination position
|
2748 |
|
|
; in program area found.
|
2749 |
|
|
|
2750 |
|
|
; ---
|
2751 |
|
|
; the branch was here with an insertion or replacement point.
|
2752 |
|
|
|
2753 |
|
|
;; ME-NEW-L2
|
2754 |
|
|
L08EB: CALL L092C ; routine ME-ENTER enters the line
|
2755 |
|
|
JR L08D2 ; loop back to ME-NEW-LP.
|
2756 |
|
|
|
2757 |
|
|
; ---
|
2758 |
|
|
; the branch was here when the location in workspace held a variable.
|
2759 |
|
|
|
2760 |
|
|
;; ME-VAR-LP
|
2761 |
|
|
L08F0: LD A,(HL) ; fetch first byte of workspace variable.
|
2762 |
|
|
LD C,A ; copy to C also.
|
2763 |
|
|
CP $80 ; is it the end-marker ?
|
2764 |
|
|
RET Z ; return if so as complete. >>>>>
|
2765 |
|
|
|
2766 |
|
|
PUSH HL ; save workspace area pointer.
|
2767 |
|
|
LD HL,($5C4B) ; load HL with VARS - start of variables area.
|
2768 |
|
|
|
2769 |
|
|
;; ME-OLD-VP
|
2770 |
|
|
L08F9: LD A,(HL) ; fetch first byte.
|
2771 |
|
|
CP $80 ; is it the end-marker ?
|
2772 |
|
|
JR Z,L0923 ; forward if so to ME-VAR-L2 to add
|
2773 |
|
|
; variable at end of variables area.
|
2774 |
|
|
|
2775 |
|
|
CP C ; compare with variable in workspace area.
|
2776 |
|
|
JR Z,L0909 ; forward to ME-OLD-V2 if a match to replace.
|
2777 |
|
|
|
2778 |
|
|
; else entire variables area has to be searched.
|
2779 |
|
|
|
2780 |
|
|
;; ME-OLD-V1
|
2781 |
|
|
L0901: PUSH BC ; save character in C.
|
2782 |
|
|
CALL L19B8 ; routine NEXT-ONE gets following variable
|
2783 |
|
|
; address in DE.
|
2784 |
|
|
POP BC ; restore character in C
|
2785 |
|
|
EX DE,HL ; transfer next address to HL.
|
2786 |
|
|
JR L08F9 ; loop back to ME-OLD-VP
|
2787 |
|
|
|
2788 |
|
|
; ---
|
2789 |
|
|
; the branch was here when first characters of name matched.
|
2790 |
|
|
|
2791 |
|
|
;; ME-OLD-V2
|
2792 |
|
|
L0909: AND $E0 ; keep bits 11100000
|
2793 |
|
|
CP $A0 ; compare 10100000 - a long-named variable.
|
2794 |
|
|
|
2795 |
|
|
JR NZ,L0921 ; forward to ME-VAR-L1 if just one-character.
|
2796 |
|
|
|
2797 |
|
|
; but long-named variables have to be matched character by character.
|
2798 |
|
|
|
2799 |
|
|
POP DE ; fetch workspace 1st character pointer
|
2800 |
|
|
PUSH DE ; and save it on the stack again.
|
2801 |
|
|
PUSH HL ; save variables area pointer on stack.
|
2802 |
|
|
|
2803 |
|
|
;; ME-OLD-V3
|
2804 |
|
|
L0912: INC HL ; address next character in vars area.
|
2805 |
|
|
INC DE ; address next character in workspace area.
|
2806 |
|
|
LD A,(DE) ; fetch workspace character.
|
2807 |
|
|
CP (HL) ; compare to variables character.
|
2808 |
|
|
JR NZ,L091E ; forward to ME-OLD-V4 with a mismatch.
|
2809 |
|
|
|
2810 |
|
|
RLA ; test if the terminal inverted character.
|
2811 |
|
|
JR NC,L0912 ; loop back to ME-OLD-V3 if more to test.
|
2812 |
|
|
|
2813 |
|
|
; otherwise the long name matches in its entirety.
|
2814 |
|
|
|
2815 |
|
|
POP HL ; restore pointer to first character of variable
|
2816 |
|
|
JR L0921 ; forward to ME-VAR-L1
|
2817 |
|
|
|
2818 |
|
|
; ---
|
2819 |
|
|
; the branch is here when two characters don't match
|
2820 |
|
|
|
2821 |
|
|
;; ME-OLD-V4
|
2822 |
|
|
L091E: POP HL ; restore the prog/vars pointer.
|
2823 |
|
|
JR L0901 ; back to ME-OLD-V1 to resume search.
|
2824 |
|
|
|
2825 |
|
|
; ---
|
2826 |
|
|
; branch here when variable is to replace an existing one
|
2827 |
|
|
|
2828 |
|
|
;; ME-VAR-L1
|
2829 |
|
|
L0921: LD A,$FF ; indicate a replacement.
|
2830 |
|
|
|
2831 |
|
|
; this entry point is when A holds $80 indicating a new variable.
|
2832 |
|
|
|
2833 |
|
|
;; ME-VAR-L2
|
2834 |
|
|
L0923: POP DE ; pop workspace pointer.
|
2835 |
|
|
EX DE,HL ; now make HL workspace pointer, DE vars pointer
|
2836 |
|
|
INC A ; zero flag set if replacement.
|
2837 |
|
|
SCF ; set carry flag indicating a variable not a
|
2838 |
|
|
; program line.
|
2839 |
|
|
CALL L092C ; routine ME-ENTER copies variable in.
|
2840 |
|
|
JR L08F0 ; loop back to ME-VAR-LP
|
2841 |
|
|
|
2842 |
|
|
; ------------------------
|
2843 |
|
|
; Merge a Line or Variable
|
2844 |
|
|
; ------------------------
|
2845 |
|
|
; A BASIC line or variable is inserted at the current point. If the line
|
2846 |
|
|
; number or variable names match (zero flag set) then a replacement takes
|
2847 |
|
|
; place.
|
2848 |
|
|
|
2849 |
|
|
;; ME-ENTER
|
2850 |
|
|
L092C: JR NZ,L093E ; forward to ME-ENT-1 for insertion only.
|
2851 |
|
|
|
2852 |
|
|
; but the program line or variable matches so old one is reclaimed.
|
2853 |
|
|
|
2854 |
|
|
EX AF,AF' ; save flag??
|
2855 |
|
|
LD ($5C5F),HL ; preserve workspace pointer in dynamic X_PTR
|
2856 |
|
|
EX DE,HL ; transfer program dest pointer to HL.
|
2857 |
|
|
CALL L19B8 ; routine NEXT-ONE finds following location
|
2858 |
|
|
; in program or variables area.
|
2859 |
|
|
CALL L19E8 ; routine RECLAIM-2 reclaims the space between.
|
2860 |
|
|
EX DE,HL ; transfer program dest pointer back to DE.
|
2861 |
|
|
LD HL,($5C5F) ; fetch adjusted workspace pointer from X_PTR
|
2862 |
|
|
EX AF,AF' ; restore flags.
|
2863 |
|
|
|
2864 |
|
|
; now the new line or variable is entered.
|
2865 |
|
|
|
2866 |
|
|
;; ME-ENT-1
|
2867 |
|
|
L093E: EX AF,AF' ; save or re-save flags.
|
2868 |
|
|
PUSH DE ; save dest pointer in prog/vars area.
|
2869 |
|
|
CALL L19B8 ; routine NEXT-ONE finds next in workspace.
|
2870 |
|
|
; gets next in DE, difference in BC.
|
2871 |
|
|
; prev addr in HL
|
2872 |
|
|
LD ($5C5F),HL ; store pointer in X_PTR
|
2873 |
|
|
LD HL,($5C53) ; load HL from system variable PROG
|
2874 |
|
|
EX (SP),HL ; swap with prog/vars pointer on stack.
|
2875 |
|
|
PUSH BC ; ** save length of new program line/variable.
|
2876 |
|
|
EX AF,AF' ; fetch flags back.
|
2877 |
|
|
JR C,L0955 ; skip to ME-ENT-2 if variable
|
2878 |
|
|
|
2879 |
|
|
DEC HL ; address location before pointer
|
2880 |
|
|
CALL L1655 ; routine MAKE-ROOM creates room for BASIC line
|
2881 |
|
|
INC HL ; address next.
|
2882 |
|
|
JR L0958 ; forward to ME-ENT-3
|
2883 |
|
|
|
2884 |
|
|
; ---
|
2885 |
|
|
|
2886 |
|
|
;; ME-ENT-2
|
2887 |
|
|
L0955: CALL L1655 ; routine MAKE-ROOM creates room for variable.
|
2888 |
|
|
|
2889 |
|
|
;; ME-ENT-3
|
2890 |
|
|
L0958: INC HL ; address next?
|
2891 |
|
|
|
2892 |
|
|
POP BC ; ** pop length
|
2893 |
|
|
POP DE ; * pop value for PROG which may have been
|
2894 |
|
|
; altered by POINTERS if first line.
|
2895 |
|
|
LD ($5C53),DE ; set PROG to original value.
|
2896 |
|
|
LD DE,($5C5F) ; fetch adjusted workspace pointer from X_PTR
|
2897 |
|
|
PUSH BC ; save length
|
2898 |
|
|
PUSH DE ; and workspace pointer
|
2899 |
|
|
EX DE,HL ; make workspace pointer source, prog/vars
|
2900 |
|
|
; pointer the destination
|
2901 |
|
|
LDIR ; copy bytes of line or variable into new area.
|
2902 |
|
|
POP HL ; restore workspace pointer.
|
2903 |
|
|
POP BC ; restore length.
|
2904 |
|
|
PUSH DE ; save new prog/vars pointer.
|
2905 |
|
|
CALL L19E8 ; routine RECLAIM-2 reclaims the space used
|
2906 |
|
|
; by the line or variable in workspace block
|
2907 |
|
|
; as no longer required and space could be
|
2908 |
|
|
; useful for adding more lines.
|
2909 |
|
|
POP DE ; restore the prog/vars pointer
|
2910 |
|
|
RET ; return.
|
2911 |
|
|
|
2912 |
|
|
; --------------------------
|
2913 |
|
|
; THE 'SAVE CONTROL' ROUTINE
|
2914 |
|
|
; --------------------------
|
2915 |
|
|
; A branch from the main SAVE-ETC routine at SAVE-ALL.
|
2916 |
|
|
; First the header data is saved. Then after a wait of 1 second
|
2917 |
|
|
; the data itself is saved.
|
2918 |
|
|
; HL points to start of data.
|
2919 |
|
|
; IX points to start of descriptor.
|
2920 |
|
|
|
2921 |
|
|
;; SA-CONTRL
|
2922 |
|
|
L0970: PUSH HL ; save start of data
|
2923 |
|
|
|
2924 |
|
|
LD A,$FD ; select system channel 'S'
|
2925 |
|
|
CALL L1601 ; routine CHAN-OPEN
|
2926 |
|
|
|
2927 |
|
|
XOR A ; clear to address table directly
|
2928 |
|
|
LD DE,L09A1 ; address: tape-msgs
|
2929 |
|
|
CALL L0C0A ; routine PO-MSG -
|
2930 |
|
|
; 'Start tape then press any key.'
|
2931 |
|
|
|
2932 |
|
|
SET 5,(IY+$02) ; TV_FLAG - Signal lower screen requires
|
2933 |
|
|
; clearing
|
2934 |
|
|
CALL L15D4 ; routine WAIT-KEY
|
2935 |
|
|
|
2936 |
|
|
PUSH IX ; save pointer to descriptor.
|
2937 |
|
|
LD DE,$0011 ; there are seventeen bytes.
|
2938 |
|
|
XOR A ; signal a header.
|
2939 |
|
|
CALL L04C2 ; routine SA-BYTES
|
2940 |
|
|
|
2941 |
|
|
POP IX ; restore descriptor pointer.
|
2942 |
|
|
|
2943 |
|
|
LD B,$32 ; wait for a second - 50 interrupts.
|
2944 |
|
|
|
2945 |
|
|
;; SA-1-SEC
|
2946 |
|
|
L0991: HALT ; wait for interrupt
|
2947 |
|
|
DJNZ L0991 ; back to SA-1-SEC until pause complete.
|
2948 |
|
|
|
2949 |
|
|
LD E,(IX+$0B) ; fetch length of bytes from the
|
2950 |
|
|
LD D,(IX+$0C) ; descriptor.
|
2951 |
|
|
|
2952 |
|
|
LD A,$FF ; signal data bytes.
|
2953 |
|
|
|
2954 |
|
|
POP IX ; retrieve pointer to start
|
2955 |
|
|
JP L04C2 ; jump back to SA-BYTES
|
2956 |
|
|
|
2957 |
|
|
|
2958 |
|
|
; Arrangement of two headers in workspace.
|
2959 |
|
|
; Originally IX addresses first location and only one header is required
|
2960 |
|
|
; when saving.
|
2961 |
|
|
;
|
2962 |
|
|
; OLD NEW PROG DATA DATA CODE
|
2963 |
|
|
; HEADER HEADER num chr NOTES.
|
2964 |
|
|
; ------ ------ ---- ---- ---- ---- -----------------------------
|
2965 |
|
|
; IX-$11 IX+$00 0 1 2 3 Type.
|
2966 |
|
|
; IX-$10 IX+$01 x x x x F ($FF if filename is null).
|
2967 |
|
|
; IX-$0F IX+$02 x x x x i
|
2968 |
|
|
; IX-$0E IX+$03 x x x x l
|
2969 |
|
|
; IX-$0D IX+$04 x x x x e
|
2970 |
|
|
; IX-$0C IX+$05 x x x x n
|
2971 |
|
|
; IX-$0B IX+$06 x x x x a
|
2972 |
|
|
; IX-$0A IX+$07 x x x x m
|
2973 |
|
|
; IX-$09 IX+$08 x x x x e
|
2974 |
|
|
; IX-$08 IX+$09 x x x x .
|
2975 |
|
|
; IX-$07 IX+$0A x x x x (terminal spaces).
|
2976 |
|
|
; IX-$06 IX+$0B lo lo lo lo Total
|
2977 |
|
|
; IX-$05 IX+$0C hi hi hi hi Length of datablock.
|
2978 |
|
|
; IX-$04 IX+$0D Auto - - Start Various
|
2979 |
|
|
; IX-$03 IX+$0E Start a-z a-z addr ($80 if no autostart).
|
2980 |
|
|
; IX-$02 IX+$0F lo - - - Length of Program
|
2981 |
|
|
; IX-$01 IX+$10 hi - - - only i.e. without variables.
|
2982 |
|
|
;
|
2983 |
|
|
|
2984 |
|
|
|
2985 |
|
|
; ------------------------
|
2986 |
|
|
; Canned cassette messages
|
2987 |
|
|
; ------------------------
|
2988 |
|
|
; The last-character-inverted Cassette messages.
|
2989 |
|
|
; Starts with normal initial step-over byte.
|
2990 |
|
|
|
2991 |
|
|
;; tape-msgs
|
2992 |
|
|
L09A1: DEFB $80
|
2993 |
|
|
DEFM "Start tape, then press any key"
|
2994 |
|
|
L09C0: DEFB '.'+$80
|
2995 |
|
|
DEFB $0D
|
2996 |
|
|
DEFM "Program:"
|
2997 |
|
|
DEFB ' '+$80
|
2998 |
|
|
DEFB $0D
|
2999 |
|
|
DEFM "Number array:"
|
3000 |
|
|
DEFB ' '+$80
|
3001 |
|
|
DEFB $0D
|
3002 |
|
|
DEFM "Character array:"
|
3003 |
|
|
DEFB ' '+$80
|
3004 |
|
|
DEFB $0D
|
3005 |
|
|
DEFM "Bytes:"
|
3006 |
|
|
DEFB ' '+$80
|
3007 |
|
|
|
3008 |
|
|
|
3009 |
|
|
;**************************************************
|
3010 |
|
|
;** Part 5. SCREEN AND PRINTER HANDLING ROUTINES **
|
3011 |
|
|
;**************************************************
|
3012 |
|
|
|
3013 |
|
|
; --------------------------
|
3014 |
|
|
; THE 'PRINT OUTPUT' ROUTINE
|
3015 |
|
|
; --------------------------
|
3016 |
|
|
; This is the routine most often used by the RST 10 restart although the
|
3017 |
|
|
; subroutine is on two occasions called directly when it is known that
|
3018 |
|
|
; output will definitely be to the lower screen.
|
3019 |
|
|
|
3020 |
|
|
;; PRINT-OUT
|
3021 |
|
|
L09F4: CALL L0B03 ; routine PO-FETCH fetches print position
|
3022 |
|
|
; to HL register pair.
|
3023 |
|
|
CP $20 ; is character a space or higher ?
|
3024 |
|
|
JP NC,L0AD9 ; jump forward to PO-ABLE if so.
|
3025 |
|
|
|
3026 |
|
|
CP $06 ; is character in range 00-05 ?
|
3027 |
|
|
JR C,L0A69 ; to PO-QUEST to print '?' if so.
|
3028 |
|
|
|
3029 |
|
|
CP $18 ; is character in range 24d - 31d ?
|
3030 |
|
|
JR NC,L0A69 ; to PO-QUEST to also print '?' if so.
|
3031 |
|
|
|
3032 |
|
|
LD HL,L0A11 - 6 ; address 0A0B - the base address of control
|
3033 |
|
|
; character table - where zero would be.
|
3034 |
|
|
LD E,A ; control character 06 - 23d
|
3035 |
|
|
LD D,$00 ; is transferred to DE.
|
3036 |
|
|
|
3037 |
|
|
ADD HL,DE ; index into table.
|
3038 |
|
|
|
3039 |
|
|
LD E,(HL) ; fetch the offset to routine.
|
3040 |
|
|
ADD HL,DE ; add to make HL the address.
|
3041 |
|
|
PUSH HL ; push the address.
|
3042 |
|
|
|
3043 |
|
|
JP L0B03 ; Jump forward to PO-FETCH,
|
3044 |
|
|
; as the screen/printer position has been
|
3045 |
|
|
; disturbed, and then indirectly to the PO-STORE
|
3046 |
|
|
; routine on stack.
|
3047 |
|
|
|
3048 |
|
|
; -----------------------------
|
3049 |
|
|
; THE 'CONTROL CHARACTER' TABLE
|
3050 |
|
|
; -----------------------------
|
3051 |
|
|
; For control characters in the range 6 - 23d the following table
|
3052 |
|
|
; is indexed to provide an offset to the handling routine that
|
3053 |
|
|
; follows the table.
|
3054 |
|
|
|
3055 |
|
|
;; ctlchrtab
|
3056 |
|
|
L0A11: DEFB L0A5F - $ ; 06d offset $4E to Address: PO-COMMA
|
3057 |
|
|
DEFB L0A69 - $ ; 07d offset $57 to Address: PO-QUEST
|
3058 |
|
|
DEFB L0A23 - $ ; 08d offset $10 to Address: PO-BACK-1
|
3059 |
|
|
DEFB L0A3D - $ ; 09d offset $29 to Address: PO-RIGHT
|
3060 |
|
|
DEFB L0A69 - $ ; 10d offset $54 to Address: PO-QUEST
|
3061 |
|
|
DEFB L0A69 - $ ; 11d offset $53 to Address: PO-QUEST
|
3062 |
|
|
DEFB L0A69 - $ ; 12d offset $52 to Address: PO-QUEST
|
3063 |
|
|
DEFB L0A4F - $ ; 13d offset $37 to Address: PO-ENTER
|
3064 |
|
|
DEFB L0A69 - $ ; 14d offset $50 to Address: PO-QUEST
|
3065 |
|
|
DEFB L0A69 - $ ; 15d offset $4F to Address: PO-QUEST
|
3066 |
|
|
DEFB L0A7A - $ ; 16d offset $5F to Address: PO-1-OPER
|
3067 |
|
|
DEFB L0A7A - $ ; 17d offset $5E to Address: PO-1-OPER
|
3068 |
|
|
DEFB L0A7A - $ ; 18d offset $5D to Address: PO-1-OPER
|
3069 |
|
|
DEFB L0A7A - $ ; 19d offset $5C to Address: PO-1-OPER
|
3070 |
|
|
DEFB L0A7A - $ ; 20d offset $5B to Address: PO-1-OPER
|
3071 |
|
|
DEFB L0A7A - $ ; 21d offset $5A to Address: PO-1-OPER
|
3072 |
|
|
DEFB L0A75 - $ ; 22d offset $54 to Address: PO-2-OPER
|
3073 |
|
|
DEFB L0A75 - $ ; 23d offset $53 to Address: PO-2-OPER
|
3074 |
|
|
|
3075 |
|
|
|
3076 |
|
|
; -------------------------
|
3077 |
|
|
; THE 'CURSOR LEFT' ROUTINE
|
3078 |
|
|
; -------------------------
|
3079 |
|
|
; Backspace and up a line if that action is from the left of screen.
|
3080 |
|
|
; For ZX printer backspace up to first column but not beyond.
|
3081 |
|
|
|
3082 |
|
|
;; PO-BACK-1
|
3083 |
|
|
L0A23: INC C ; move left one column.
|
3084 |
|
|
LD A,$22 ; value $21 is leftmost column.
|
3085 |
|
|
CP C ; have we passed ?
|
3086 |
|
|
JR NZ,L0A3A ; to PO-BACK-3 if not and store new position.
|
3087 |
|
|
|
3088 |
|
|
BIT 1,(IY+$01) ; test FLAGS - is printer in use ?
|
3089 |
|
|
JR NZ,L0A38 ; to PO-BACK-2 if so, as we are unable to
|
3090 |
|
|
; backspace from the leftmost position.
|
3091 |
|
|
|
3092 |
|
|
|
3093 |
|
|
INC B ; move up one screen line
|
3094 |
|
|
LD C,$02 ; the rightmost column position.
|
3095 |
|
|
LD A,$18 ; Note. This should be $19
|
3096 |
|
|
; credit. Dr. Frank O'Hara, 1982
|
3097 |
|
|
|
3098 |
|
|
CP B ; has position moved past top of screen ?
|
3099 |
|
|
JR NZ,L0A3A ; to PO-BACK-3 if not and store new position.
|
3100 |
|
|
|
3101 |
|
|
DEC B ; else back to $18.
|
3102 |
|
|
|
3103 |
|
|
;; PO-BACK-2
|
3104 |
|
|
L0A38: LD C,$21 ; the leftmost column position.
|
3105 |
|
|
|
3106 |
|
|
;; PO-BACK-3
|
3107 |
|
|
L0A3A: JP L0DD9 ; to CL-SET and PO-STORE to save new
|
3108 |
|
|
; position in system variables.
|
3109 |
|
|
|
3110 |
|
|
; --------------------------
|
3111 |
|
|
; THE 'CURSOR RIGHT' ROUTINE
|
3112 |
|
|
; --------------------------
|
3113 |
|
|
; This moves the print position to the right leaving a trail in the
|
3114 |
|
|
; current background colour.
|
3115 |
|
|
; "However the programmer has failed to store the new print position
|
3116 |
|
|
; so CHR$ 9 will only work if the next print position is at a newly
|
3117 |
|
|
; defined place.
|
3118 |
|
|
; e.g. PRINT PAPER 2; CHR$ 9; AT 4,0;
|
3119 |
|
|
; does work but is not very helpful"
|
3120 |
|
|
; - Dr. Ian Logan, Understanding Your Spectrum, 1982.
|
3121 |
|
|
|
3122 |
|
|
;; PO-RIGHT
|
3123 |
|
|
L0A3D: LD A,($5C91) ; fetch P_FLAG value
|
3124 |
|
|
PUSH AF ; and save it on stack.
|
3125 |
|
|
|
3126 |
|
|
LD (IY+$57),$01 ; temporarily set P_FLAG 'OVER 1'.
|
3127 |
|
|
LD A,$20 ; prepare a space.
|
3128 |
|
|
CALL L0B65 ; routine PO-CHAR to print it.
|
3129 |
|
|
; Note. could be PO-ABLE which would update
|
3130 |
|
|
; the column position.
|
3131 |
|
|
|
3132 |
|
|
POP AF ; restore the permanent flag.
|
3133 |
|
|
LD ($5C91),A ; and restore system variable P_FLAG
|
3134 |
|
|
|
3135 |
|
|
RET ; return without updating column position
|
3136 |
|
|
|
3137 |
|
|
; -----------------------
|
3138 |
|
|
; Perform carriage return
|
3139 |
|
|
; -----------------------
|
3140 |
|
|
; A carriage return is 'printed' to screen or printer buffer.
|
3141 |
|
|
|
3142 |
|
|
;; PO-ENTER
|
3143 |
|
|
L0A4F: BIT 1,(IY+$01) ; test FLAGS - is printer in use ?
|
3144 |
|
|
JP NZ,L0ECD ; to COPY-BUFF if so, to flush buffer and reset
|
3145 |
|
|
; the print position.
|
3146 |
|
|
|
3147 |
|
|
LD C,$21 ; the leftmost column position.
|
3148 |
|
|
CALL L0C55 ; routine PO-SCR handles any scrolling required.
|
3149 |
|
|
DEC B ; to next screen line.
|
3150 |
|
|
JP L0DD9 ; jump forward to CL-SET to store new position.
|
3151 |
|
|
|
3152 |
|
|
; -----------
|
3153 |
|
|
; Print comma
|
3154 |
|
|
; -----------
|
3155 |
|
|
; The comma control character. The 32 column screen has two 16 character
|
3156 |
|
|
; tabstops. The routine is only reached via the control character table.
|
3157 |
|
|
|
3158 |
|
|
;; PO-COMMA
|
3159 |
|
|
L0A5F: CALL L0B03 ; routine PO-FETCH - seems unnecessary.
|
3160 |
|
|
|
3161 |
|
|
LD A,C ; the column position. $21-$01
|
3162 |
|
|
DEC A ; move right. $20-$00
|
3163 |
|
|
DEC A ; and again $1F-$00 or $FF if trailing
|
3164 |
|
|
AND $10 ; will be $00 or $10.
|
3165 |
|
|
JR L0AC3 ; forward to PO-FILL
|
3166 |
|
|
|
3167 |
|
|
; -------------------
|
3168 |
|
|
; Print question mark
|
3169 |
|
|
; -------------------
|
3170 |
|
|
; This routine prints a question mark which is commonly
|
3171 |
|
|
; used to print an unassigned control character in range 0-31d.
|
3172 |
|
|
; there are a surprising number yet to be assigned.
|
3173 |
|
|
|
3174 |
|
|
;; PO-QUEST
|
3175 |
|
|
L0A69: LD A,$3F ; prepare the character '?'.
|
3176 |
|
|
JR L0AD9 ; forward to PO-ABLE.
|
3177 |
|
|
|
3178 |
|
|
; --------------------------------
|
3179 |
|
|
; Control characters with operands
|
3180 |
|
|
; --------------------------------
|
3181 |
|
|
; Certain control characters are followed by 1 or 2 operands.
|
3182 |
|
|
; The entry points from control character table are PO-2-OPER and PO-1-OPER.
|
3183 |
|
|
; The routines alter the output address of the current channel so that
|
3184 |
|
|
; subsequent RST $10 instructions take the appropriate action
|
3185 |
|
|
; before finally resetting the output address back to PRINT-OUT.
|
3186 |
|
|
|
3187 |
|
|
;; PO-TV-2
|
3188 |
|
|
L0A6D: LD DE,L0A87 ; address: PO-CONT will be next output routine
|
3189 |
|
|
LD ($5C0F),A ; store first operand in TVDATA-hi
|
3190 |
|
|
JR L0A80 ; forward to PO-CHANGE >>
|
3191 |
|
|
|
3192 |
|
|
; ---
|
3193 |
|
|
|
3194 |
|
|
; -> This initial entry point deals with two operands - AT or TAB.
|
3195 |
|
|
|
3196 |
|
|
;; PO-2-OPER
|
3197 |
|
|
L0A75: LD DE,L0A6D ; address: PO-TV-2 will be next output routine
|
3198 |
|
|
JR L0A7D ; forward to PO-TV-1
|
3199 |
|
|
|
3200 |
|
|
; ---
|
3201 |
|
|
|
3202 |
|
|
; -> This initial entry point deals with one operand INK to OVER.
|
3203 |
|
|
|
3204 |
|
|
;; PO-1-OPER
|
3205 |
|
|
L0A7A: LD DE,L0A87 ; address: PO-CONT will be next output routine
|
3206 |
|
|
|
3207 |
|
|
;; PO-TV-1
|
3208 |
|
|
L0A7D: LD ($5C0E),A ; store control code in TVDATA-lo
|
3209 |
|
|
|
3210 |
|
|
;; PO-CHANGE
|
3211 |
|
|
L0A80: LD HL,($5C51) ; use CURCHL to find current output channel.
|
3212 |
|
|
LD (HL),E ; make it
|
3213 |
|
|
INC HL ; the supplied
|
3214 |
|
|
LD (HL),D ; address from DE.
|
3215 |
|
|
RET ; return.
|
3216 |
|
|
|
3217 |
|
|
; ---
|
3218 |
|
|
|
3219 |
|
|
;; PO-CONT
|
3220 |
|
|
L0A87: LD DE,L09F4 ; Address: PRINT-OUT
|
3221 |
|
|
CALL L0A80 ; routine PO-CHANGE to restore normal channel.
|
3222 |
|
|
LD HL,($5C0E) ; TVDATA gives control code and possible
|
3223 |
|
|
; subsequent character
|
3224 |
|
|
LD D,A ; save current character
|
3225 |
|
|
LD A,L ; the stored control code
|
3226 |
|
|
CP $16 ; was it INK to OVER (1 operand) ?
|
3227 |
|
|
JP C,L2211 ; to CO-TEMP-5
|
3228 |
|
|
|
3229 |
|
|
JR NZ,L0AC2 ; to PO-TAB if not 22d i.e. 23d TAB.
|
3230 |
|
|
|
3231 |
|
|
; else must have been 22d AT.
|
3232 |
|
|
LD B,H ; line to H (0-23d)
|
3233 |
|
|
LD C,D ; column to C (0-31d)
|
3234 |
|
|
LD A,$1F ; the value 31d
|
3235 |
|
|
SUB C ; reverse the column number.
|
3236 |
|
|
JR C,L0AAC ; to PO-AT-ERR if C was greater than 31d.
|
3237 |
|
|
|
3238 |
|
|
ADD A,$02 ; transform to system range $02-$21
|
3239 |
|
|
LD C,A ; and place in column register.
|
3240 |
|
|
|
3241 |
|
|
BIT 1,(IY+$01) ; test FLAGS - is printer in use ?
|
3242 |
|
|
JR NZ,L0ABF ; to PO-AT-SET as line can be ignored.
|
3243 |
|
|
|
3244 |
|
|
LD A,$16 ; 22 decimal
|
3245 |
|
|
SUB B ; subtract line number to reverse
|
3246 |
|
|
; 0 - 22 becomes 22 - 0.
|
3247 |
|
|
|
3248 |
|
|
;; PO-AT-ERR
|
3249 |
|
|
L0AAC: JP C,L1E9F ; to REPORT-B if higher than 22 decimal
|
3250 |
|
|
; Integer out of range.
|
3251 |
|
|
|
3252 |
|
|
INC A ; adjust for system range $01-$17
|
3253 |
|
|
LD B,A ; place in line register
|
3254 |
|
|
INC B ; adjust to system range $02-$18
|
3255 |
|
|
BIT 0,(IY+$02) ; TV_FLAG - Lower screen in use ?
|
3256 |
|
|
JP NZ,L0C55 ; exit to PO-SCR to test for scrolling
|
3257 |
|
|
|
3258 |
|
|
CP (IY+$31) ; Compare against DF_SZ
|
3259 |
|
|
JP C,L0C86 ; to REPORT-5 if too low
|
3260 |
|
|
; Out of screen.
|
3261 |
|
|
|
3262 |
|
|
;; PO-AT-SET
|
3263 |
|
|
L0ABF: JP L0DD9 ; print position is valid so exit via CL-SET
|
3264 |
|
|
|
3265 |
|
|
; ---
|
3266 |
|
|
|
3267 |
|
|
; Continue here when dealing with TAB.
|
3268 |
|
|
; Note. In BASIC, TAB is followed by a 16-bit number and was initially
|
3269 |
|
|
; designed to work with any output device.
|
3270 |
|
|
|
3271 |
|
|
;; PO-TAB
|
3272 |
|
|
L0AC2: LD A,H ; transfer parameter to A
|
3273 |
|
|
; Losing current character -
|
3274 |
|
|
; High byte of TAB parameter.
|
3275 |
|
|
|
3276 |
|
|
|
3277 |
|
|
;; PO-FILL
|
3278 |
|
|
L0AC3: CALL L0B03 ; routine PO-FETCH, HL-addr, BC=line/column.
|
3279 |
|
|
; column 1 (right), $21 (left)
|
3280 |
|
|
ADD A,C ; add operand to current column
|
3281 |
|
|
DEC A ; range 0 - 31+
|
3282 |
|
|
AND $1F ; make range 0 - 31d
|
3283 |
|
|
RET Z ; return if result zero
|
3284 |
|
|
|
3285 |
|
|
LD D,A ; Counter to D
|
3286 |
|
|
SET 0,(IY+$01) ; update FLAGS - signal suppress leading space.
|
3287 |
|
|
|
3288 |
|
|
;; PO-SPACE
|
3289 |
|
|
L0AD0: LD A,$20 ; space character.
|
3290 |
|
|
|
3291 |
|
|
CALL L0C3B ; routine PO-SAVE prints the character
|
3292 |
|
|
; using alternate set (normal output routine)
|
3293 |
|
|
|
3294 |
|
|
DEC D ; decrement counter.
|
3295 |
|
|
JR NZ,L0AD0 ; to PO-SPACE until done
|
3296 |
|
|
|
3297 |
|
|
RET ; return
|
3298 |
|
|
|
3299 |
|
|
; ----------------------
|
3300 |
|
|
; Printable character(s)
|
3301 |
|
|
; ----------------------
|
3302 |
|
|
; This routine prints printable characters and continues into
|
3303 |
|
|
; the position store routine
|
3304 |
|
|
|
3305 |
|
|
;; PO-ABLE
|
3306 |
|
|
L0AD9: CALL L0B24 ; routine PO-ANY
|
3307 |
|
|
; and continue into position store routine.
|
3308 |
|
|
|
3309 |
|
|
; ----------------------------
|
3310 |
|
|
; THE 'POSITION STORE' ROUTINE
|
3311 |
|
|
; ----------------------------
|
3312 |
|
|
; This routine updates the system variables associated with the main screen,
|
3313 |
|
|
; the lower screen/input buffer or the ZX printer.
|
3314 |
|
|
|
3315 |
|
|
;; PO-STORE
|
3316 |
|
|
L0ADC: BIT 1,(IY+$01) ; Test FLAGS - is printer in use ?
|
3317 |
|
|
JR NZ,L0AFC ; Forward, if so, to PO-ST-PR
|
3318 |
|
|
|
3319 |
|
|
BIT 0,(IY+$02) ; Test TV_FLAG - is lower screen in use ?
|
3320 |
|
|
JR NZ,L0AF0 ; Forward, if so, to PO-ST-E
|
3321 |
|
|
|
3322 |
|
|
; This section deals with the upper screen.
|
3323 |
|
|
|
3324 |
|
|
LD ($5C88),BC ; Update S_POSN - line/column upper screen
|
3325 |
|
|
LD ($5C84),HL ; Update DF_CC - upper display file address
|
3326 |
|
|
|
3327 |
|
|
RET ; Return.
|
3328 |
|
|
|
3329 |
|
|
; ---
|
3330 |
|
|
|
3331 |
|
|
; This section deals with the lower screen.
|
3332 |
|
|
|
3333 |
|
|
;; PO-ST-E
|
3334 |
|
|
L0AF0: LD ($5C8A),BC ; Update SPOSNL line/column lower screen
|
3335 |
|
|
LD ($5C82),BC ; Update ECHO_E line/column input buffer
|
3336 |
|
|
LD ($5C86),HL ; Update DFCCL lower screen memory address
|
3337 |
|
|
RET ; Return.
|
3338 |
|
|
|
3339 |
|
|
; ---
|
3340 |
|
|
|
3341 |
|
|
; This section deals with the ZX Printer.
|
3342 |
|
|
|
3343 |
|
|
;; PO-ST-PR
|
3344 |
|
|
L0AFC: LD (IY+$45),C ; Update P_POSN column position printer
|
3345 |
|
|
LD ($5C80),HL ; Update PR_CC - full printer buffer memory
|
3346 |
|
|
; address
|
3347 |
|
|
RET ; Return.
|
3348 |
|
|
|
3349 |
|
|
; Note. that any values stored in location 23681 will be overwritten with
|
3350 |
|
|
; the value 91 decimal.
|
3351 |
|
|
; Credit April 1983, Dilwyn Jones. "Delving Deeper into your ZX Spectrum".
|
3352 |
|
|
|
3353 |
|
|
; ----------------------------
|
3354 |
|
|
; THE 'POSITION FETCH' ROUTINE
|
3355 |
|
|
; ----------------------------
|
3356 |
|
|
; This routine fetches the line/column and display file address of the upper
|
3357 |
|
|
; and lower screen or, if the printer is in use, the column position and
|
3358 |
|
|
; absolute memory address.
|
3359 |
|
|
; Note. that PR-CC-hi (23681) is used by this routine and if, in accordance
|
3360 |
|
|
; with the manual (that says this is unused), the location has been used for
|
3361 |
|
|
; other purposes, then subsequent output to the printer buffer could corrupt
|
3362 |
|
|
; a 256-byte section of memory.
|
3363 |
|
|
|
3364 |
|
|
;; PO-FETCH
|
3365 |
|
|
L0B03: BIT 1,(IY+$01) ; Test FLAGS - is printer in use ?
|
3366 |
|
|
JR NZ,L0B1D ; Forward, if so, to PO-F-PR
|
3367 |
|
|
|
3368 |
|
|
; assume upper screen in use and thus optimize for path that requires speed.
|
3369 |
|
|
|
3370 |
|
|
LD BC,($5C88) ; Fetch line/column from S_POSN
|
3371 |
|
|
LD HL,($5C84) ; Fetch DF_CC display file address
|
3372 |
|
|
|
3373 |
|
|
BIT 0,(IY+$02) ; Test TV_FLAG - lower screen in use ?
|
3374 |
|
|
RET Z ; Return if upper screen in use.
|
3375 |
|
|
|
3376 |
|
|
; Overwrite registers with values for lower screen.
|
3377 |
|
|
|
3378 |
|
|
LD BC,($5C8A) ; Fetch line/column from SPOSNL
|
3379 |
|
|
LD HL,($5C86) ; Fetch display file address from DFCCL
|
3380 |
|
|
RET ; Return.
|
3381 |
|
|
|
3382 |
|
|
; ---
|
3383 |
|
|
|
3384 |
|
|
; This section deals with the ZX Printer.
|
3385 |
|
|
|
3386 |
|
|
;; PO-F-PR
|
3387 |
|
|
L0B1D: LD C,(IY+$45) ; Fetch column from P_POSN.
|
3388 |
|
|
LD HL,($5C80) ; Fetch printer buffer address from PR_CC.
|
3389 |
|
|
RET ; Return.
|
3390 |
|
|
|
3391 |
|
|
; ---------------------------------
|
3392 |
|
|
; THE 'PRINT ANY CHARACTER' ROUTINE
|
3393 |
|
|
; ---------------------------------
|
3394 |
|
|
; This routine is used to print any character in range 32d - 255d
|
3395 |
|
|
; It is only called from PO-ABLE which continues into PO-STORE
|
3396 |
|
|
|
3397 |
|
|
;; PO-ANY
|
3398 |
|
|
L0B24: CP $80 ; ASCII ?
|
3399 |
|
|
JR C,L0B65 ; to PO-CHAR is so.
|
3400 |
|
|
|
3401 |
|
|
CP $90 ; test if a block graphic character.
|
3402 |
|
|
JR NC,L0B52 ; to PO-T&UDG to print tokens and UDGs
|
3403 |
|
|
|
3404 |
|
|
; The 16 2*2 mosaic characters 128-143 decimal are formed from
|
3405 |
|
|
; bits 0-3 of the character.
|
3406 |
|
|
|
3407 |
|
|
LD B,A ; save character
|
3408 |
|
|
CALL L0B38 ; routine PO-GR-1 to construct top half
|
3409 |
|
|
; then bottom half.
|
3410 |
|
|
CALL L0B03 ; routine PO-FETCH fetches print position.
|
3411 |
|
|
LD DE,$5C92 ; MEM-0 is location of 8 bytes of character
|
3412 |
|
|
JR L0B7F ; to PR-ALL to print to screen or printer
|
3413 |
|
|
|
3414 |
|
|
; ---
|
3415 |
|
|
|
3416 |
|
|
;; PO-GR-1
|
3417 |
|
|
L0B38: LD HL,$5C92 ; address MEM-0 - a temporary buffer in
|
3418 |
|
|
; systems variables which is normally used
|
3419 |
|
|
; by the calculator.
|
3420 |
|
|
CALL L0B3E ; routine PO-GR-2 to construct top half
|
3421 |
|
|
; and continue into routine to construct
|
3422 |
|
|
; bottom half.
|
3423 |
|
|
|
3424 |
|
|
;; PO-GR-2
|
3425 |
|
|
L0B3E: RR B ; rotate bit 0/2 to carry
|
3426 |
|
|
SBC A,A ; result $00 or $FF
|
3427 |
|
|
AND $0F ; mask off right hand side
|
3428 |
|
|
LD C,A ; store part in C
|
3429 |
|
|
RR B ; rotate bit 1/3 of original chr to carry
|
3430 |
|
|
SBC A,A ; result $00 or $FF
|
3431 |
|
|
AND $F0 ; mask off left hand side
|
3432 |
|
|
OR C ; combine with stored pattern
|
3433 |
|
|
LD C,$04 ; four bytes for top/bottom half
|
3434 |
|
|
|
3435 |
|
|
;; PO-GR-3
|
3436 |
|
|
L0B4C: LD (HL),A ; store bit patterns in temporary buffer
|
3437 |
|
|
INC HL ; next address
|
3438 |
|
|
DEC C ; jump back to
|
3439 |
|
|
JR NZ,L0B4C ; to PO-GR-3 until byte is stored 4 times
|
3440 |
|
|
|
3441 |
|
|
RET ; return
|
3442 |
|
|
|
3443 |
|
|
; ---
|
3444 |
|
|
|
3445 |
|
|
; Tokens and User defined graphics are now separated.
|
3446 |
|
|
|
3447 |
|
|
;; PO-T&UDG
|
3448 |
|
|
L0B52: SUB $A5 ; the 'RND' character
|
3449 |
|
|
JR NC,L0B5F ; to PO-T to print tokens
|
3450 |
|
|
|
3451 |
|
|
ADD A,$15 ; add 21d to restore to 0 - 20
|
3452 |
|
|
PUSH BC ; save current print position
|
3453 |
|
|
LD BC,($5C7B) ; fetch UDG to address bit patterns
|
3454 |
|
|
JR L0B6A ; to PO-CHAR-2 - common code to lay down
|
3455 |
|
|
; a bit patterned character
|
3456 |
|
|
|
3457 |
|
|
; ---
|
3458 |
|
|
|
3459 |
|
|
;; PO-T
|
3460 |
|
|
L0B5F: CALL L0C10 ; routine PO-TOKENS prints tokens
|
3461 |
|
|
JP L0B03 ; exit via a JUMP to PO-FETCH as this routine
|
3462 |
|
|
; must continue into PO-STORE.
|
3463 |
|
|
; A JR instruction could be used.
|
3464 |
|
|
|
3465 |
|
|
; This point is used to print ASCII characters 32d - 127d.
|
3466 |
|
|
|
3467 |
|
|
;; PO-CHAR
|
3468 |
|
|
L0B65: PUSH BC ; save print position
|
3469 |
|
|
LD BC,($5C36) ; address CHARS
|
3470 |
|
|
|
3471 |
|
|
; This common code is used to transfer the character bytes to memory.
|
3472 |
|
|
|
3473 |
|
|
;; PO-CHAR-2
|
3474 |
|
|
L0B6A: EX DE,HL ; transfer destination address to DE
|
3475 |
|
|
LD HL,$5C3B ; point to FLAGS
|
3476 |
|
|
RES 0,(HL) ; allow for leading space
|
3477 |
|
|
CP $20 ; is it a space ?
|
3478 |
|
|
JR NZ,L0B76 ; to PO-CHAR-3 if not
|
3479 |
|
|
|
3480 |
|
|
SET 0,(HL) ; signal no leading space to FLAGS
|
3481 |
|
|
|
3482 |
|
|
;; PO-CHAR-3
|
3483 |
|
|
L0B76: LD H,$00 ; set high byte to 0
|
3484 |
|
|
LD L,A ; character to A
|
3485 |
|
|
; 0-21 UDG or 32-127 ASCII.
|
3486 |
|
|
ADD HL,HL ; multiply
|
3487 |
|
|
ADD HL,HL ; by
|
3488 |
|
|
ADD HL,HL ; eight
|
3489 |
|
|
ADD HL,BC ; HL now points to first byte of character
|
3490 |
|
|
POP BC ; the source address CHARS or UDG
|
3491 |
|
|
EX DE,HL ; character address to DE
|
3492 |
|
|
|
3493 |
|
|
; ----------------------------------
|
3494 |
|
|
; THE 'PRINT ALL CHARACTERS' ROUTINE
|
3495 |
|
|
; ----------------------------------
|
3496 |
|
|
; This entry point entered from above to print ASCII and UDGs but also from
|
3497 |
|
|
; earlier to print mosaic characters.
|
3498 |
|
|
; HL=destination
|
3499 |
|
|
; DE=character source
|
3500 |
|
|
; BC=line/column
|
3501 |
|
|
|
3502 |
|
|
;; PR-ALL
|
3503 |
|
|
L0B7F: LD A,C ; column to A
|
3504 |
|
|
DEC A ; move right
|
3505 |
|
|
LD A,$21 ; pre-load with leftmost position
|
3506 |
|
|
JR NZ,L0B93 ; but if not zero to PR-ALL-1
|
3507 |
|
|
|
3508 |
|
|
DEC B ; down one line
|
3509 |
|
|
LD C,A ; load C with $21
|
3510 |
|
|
BIT 1,(IY+$01) ; test FLAGS - Is printer in use
|
3511 |
|
|
JR Z,L0B93 ; to PR-ALL-1 if not
|
3512 |
|
|
|
3513 |
|
|
PUSH DE ; save source address
|
3514 |
|
|
CALL L0ECD ; routine COPY-BUFF outputs line to printer
|
3515 |
|
|
POP DE ; restore character source address
|
3516 |
|
|
LD A,C ; the new column number ($21) to C
|
3517 |
|
|
|
3518 |
|
|
;; PR-ALL-1
|
3519 |
|
|
L0B93: CP C ; this test is really for screen - new line ?
|
3520 |
|
|
PUSH DE ; save source
|
3521 |
|
|
|
3522 |
|
|
CALL Z,L0C55 ; routine PO-SCR considers scrolling
|
3523 |
|
|
|
3524 |
|
|
POP DE ; restore source
|
3525 |
|
|
PUSH BC ; save line/column
|
3526 |
|
|
PUSH HL ; and destination
|
3527 |
|
|
LD A,($5C91) ; fetch P_FLAG to accumulator
|
3528 |
|
|
LD B,$FF ; prepare OVER mask in B.
|
3529 |
|
|
RRA ; bit 0 set if OVER 1
|
3530 |
|
|
JR C,L0BA4 ; to PR-ALL-2
|
3531 |
|
|
|
3532 |
|
|
INC B ; set OVER mask to 0
|
3533 |
|
|
|
3534 |
|
|
;; PR-ALL-2
|
3535 |
|
|
L0BA4: RRA ; skip bit 1 of P_FLAG
|
3536 |
|
|
RRA ; bit 2 is INVERSE
|
3537 |
|
|
SBC A,A ; will be FF for INVERSE 1 else zero
|
3538 |
|
|
LD C,A ; transfer INVERSE mask to C
|
3539 |
|
|
LD A,$08 ; prepare to count 8 bytes
|
3540 |
|
|
AND A ; clear carry to signal screen
|
3541 |
|
|
BIT 1,(IY+$01) ; test FLAGS - is printer in use ?
|
3542 |
|
|
JR Z,L0BB6 ; to PR-ALL-3 if screen
|
3543 |
|
|
|
3544 |
|
|
SET 1,(IY+$30) ; update FLAGS2 - signal printer buffer has
|
3545 |
|
|
; been used.
|
3546 |
|
|
SCF ; set carry flag to signal printer.
|
3547 |
|
|
|
3548 |
|
|
;; PR-ALL-3
|
3549 |
|
|
L0BB6: EX DE,HL ; now HL=source, DE=destination
|
3550 |
|
|
|
3551 |
|
|
;; PR-ALL-4
|
3552 |
|
|
L0BB7: EX AF,AF' ; save printer/screen flag
|
3553 |
|
|
LD A,(DE) ; fetch existing destination byte
|
3554 |
|
|
AND B ; consider OVER
|
3555 |
|
|
XOR (HL) ; now XOR with source
|
3556 |
|
|
XOR C ; now with INVERSE MASK
|
3557 |
|
|
LD (DE),A ; update screen/printer
|
3558 |
|
|
EX AF,AF' ; restore flag
|
3559 |
|
|
JR C,L0BD3 ; to PR-ALL-6 - printer address update
|
3560 |
|
|
|
3561 |
|
|
INC D ; gives next pixel line down screen
|
3562 |
|
|
|
3563 |
|
|
;; PR-ALL-5
|
3564 |
|
|
L0BC1: INC HL ; address next character byte
|
3565 |
|
|
DEC A ; the byte count is decremented
|
3566 |
|
|
JR NZ,L0BB7 ; back to PR-ALL-4 for all 8 bytes
|
3567 |
|
|
|
3568 |
|
|
EX DE,HL ; destination to HL
|
3569 |
|
|
DEC H ; bring back to last updated screen position
|
3570 |
|
|
BIT 1,(IY+$01) ; test FLAGS - is printer in use ?
|
3571 |
|
|
CALL Z,L0BDB ; if not, call routine PO-ATTR to update
|
3572 |
|
|
; corresponding colour attribute.
|
3573 |
|
|
POP HL ; restore original screen/printer position
|
3574 |
|
|
POP BC ; and line column
|
3575 |
|
|
DEC C ; move column to right
|
3576 |
|
|
INC HL ; increase screen/printer position
|
3577 |
|
|
RET ; return and continue into PO-STORE
|
3578 |
|
|
; within PO-ABLE
|
3579 |
|
|
|
3580 |
|
|
; ---
|
3581 |
|
|
|
3582 |
|
|
; This branch is used to update the printer position by 32 places
|
3583 |
|
|
; Note. The high byte of the address D remains constant (which it should).
|
3584 |
|
|
|
3585 |
|
|
;; PR-ALL-6
|
3586 |
|
|
L0BD3: EX AF,AF' ; save the flag
|
3587 |
|
|
LD A,$20 ; load A with 32 decimal
|
3588 |
|
|
ADD A,E ; add this to E
|
3589 |
|
|
LD E,A ; and store result in E
|
3590 |
|
|
EX AF,AF' ; fetch the flag
|
3591 |
|
|
JR L0BC1 ; back to PR-ALL-5
|
3592 |
|
|
|
3593 |
|
|
; -----------------------------------
|
3594 |
|
|
; THE 'GET ATTRIBUTE ADDRESS' ROUTINE
|
3595 |
|
|
; -----------------------------------
|
3596 |
|
|
; This routine is entered with the HL register holding the last screen
|
3597 |
|
|
; address to be updated by PRINT or PLOT.
|
3598 |
|
|
; The Spectrum screen arrangement leads to the L register holding the correct
|
3599 |
|
|
; value for the attribute file and it is only necessary to manipulate H to
|
3600 |
|
|
; form the correct colour attribute address.
|
3601 |
|
|
|
3602 |
|
|
;; PO-ATTR
|
3603 |
|
|
L0BDB: LD A,H ; fetch high byte $40 - $57
|
3604 |
|
|
RRCA ; shift
|
3605 |
|
|
RRCA ; bits 3 and 4
|
3606 |
|
|
RRCA ; to right.
|
3607 |
|
|
AND $03 ; range is now 0 - 2
|
3608 |
|
|
OR $58 ; form correct high byte for third of screen
|
3609 |
|
|
LD H,A ; HL is now correct
|
3610 |
|
|
LD DE,($5C8F) ; make D hold ATTR_T, E hold MASK-T
|
3611 |
|
|
LD A,(HL) ; fetch existing attribute
|
3612 |
|
|
XOR E ; apply masks
|
3613 |
|
|
AND D ;
|
3614 |
|
|
XOR E ;
|
3615 |
|
|
BIT 6,(IY+$57) ; test P_FLAG - is this PAPER 9 ??
|
3616 |
|
|
JR Z,L0BFA ; skip to PO-ATTR-1 if not.
|
3617 |
|
|
|
3618 |
|
|
AND $C7 ; set paper
|
3619 |
|
|
BIT 2,A ; to contrast with ink
|
3620 |
|
|
JR NZ,L0BFA ; skip to PO-ATTR-1
|
3621 |
|
|
|
3622 |
|
|
XOR $38 ;
|
3623 |
|
|
|
3624 |
|
|
;; PO-ATTR-1
|
3625 |
|
|
L0BFA: BIT 4,(IY+$57) ; test P_FLAG - Is this INK 9 ??
|
3626 |
|
|
JR Z,L0C08 ; skip to PO-ATTR-2 if not
|
3627 |
|
|
|
3628 |
|
|
AND $F8 ; make ink
|
3629 |
|
|
BIT 5,A ; contrast with paper.
|
3630 |
|
|
JR NZ,L0C08 ; to PO-ATTR-2
|
3631 |
|
|
|
3632 |
|
|
XOR $07 ;
|
3633 |
|
|
|
3634 |
|
|
;; PO-ATTR-2
|
3635 |
|
|
L0C08: LD (HL),A ; save the new attribute.
|
3636 |
|
|
RET ; return.
|
3637 |
|
|
|
3638 |
|
|
; ---------------------------------
|
3639 |
|
|
; THE 'MESSAGE PRINTING' SUBROUTINE
|
3640 |
|
|
; ---------------------------------
|
3641 |
|
|
; This entry point is used to print tape, boot-up, scroll? and error messages.
|
3642 |
|
|
; On entry the DE register points to an initial step-over byte or the
|
3643 |
|
|
; inverted end-marker of the previous entry in the table.
|
3644 |
|
|
; Register A contains the message number, often zero to print first message.
|
3645 |
|
|
; (HL has nothing important usually P_FLAG)
|
3646 |
|
|
|
3647 |
|
|
;; PO-MSG
|
3648 |
|
|
L0C0A: PUSH HL ; put hi-byte zero on stack to suppress
|
3649 |
|
|
LD H,$00 ; trailing spaces
|
3650 |
|
|
EX (SP),HL ; ld h,0; push hl would have done ?.
|
3651 |
|
|
JR L0C14 ; forward to PO-TABLE.
|
3652 |
|
|
|
3653 |
|
|
; ---
|
3654 |
|
|
|
3655 |
|
|
; This entry point prints the BASIC keywords, '<>' etc. from alt set
|
3656 |
|
|
|
3657 |
|
|
;; PO-TOKENS
|
3658 |
|
|
L0C10: LD DE,L0095 ; address: TKN-TABLE
|
3659 |
|
|
PUSH AF ; save the token number to control
|
3660 |
|
|
; trailing spaces - see later *
|
3661 |
|
|
|
3662 |
|
|
; ->
|
3663 |
|
|
|
3664 |
|
|
;; PO-TABLE
|
3665 |
|
|
L0C14: CALL L0C41 ; routine PO-SEARCH will set carry for
|
3666 |
|
|
; all messages and function words.
|
3667 |
|
|
|
3668 |
|
|
JR C,L0C22 ; forward to PO-EACH if not a command, '<>' etc.
|
3669 |
|
|
|
3670 |
|
|
LD A,$20 ; prepare leading space
|
3671 |
|
|
BIT 0,(IY+$01) ; test FLAGS - leading space if not set
|
3672 |
|
|
|
3673 |
|
|
CALL Z,L0C3B ; routine PO-SAVE to print a space without
|
3674 |
|
|
; disturbing registers.
|
3675 |
|
|
|
3676 |
|
|
;; PO-EACH
|
3677 |
|
|
L0C22: LD A,(DE) ; Fetch character from the table.
|
3678 |
|
|
AND $7F ; Cancel any inverted bit.
|
3679 |
|
|
|
3680 |
|
|
CALL L0C3B ; Routine PO-SAVE to print using the alternate
|
3681 |
|
|
; set of registers.
|
3682 |
|
|
|
3683 |
|
|
LD A,(DE) ; Re-fetch character from table.
|
3684 |
|
|
INC DE ; Address next character in the table.
|
3685 |
|
|
|
3686 |
|
|
ADD A,A ; Was character inverted ?
|
3687 |
|
|
; (this also doubles character)
|
3688 |
|
|
JR NC,L0C22 ; back to PO-EACH if not.
|
3689 |
|
|
|
3690 |
|
|
POP DE ; * re-fetch trailing space byte to D
|
3691 |
|
|
|
3692 |
|
|
CP $48 ; was the last character '$' ?
|
3693 |
|
|
JR Z,L0C35 ; forward to PO-TR-SP to consider trailing
|
3694 |
|
|
; space if so.
|
3695 |
|
|
|
3696 |
|
|
CP $82 ; was it < 'A' i.e. '#','>','=' from tokens
|
3697 |
|
|
; or ' ','.' (from tape) or '?' from scroll
|
3698 |
|
|
|
3699 |
|
|
RET C ; Return if so as no trailing space required.
|
3700 |
|
|
|
3701 |
|
|
;; PO-TR-SP
|
3702 |
|
|
L0C35: LD A,D ; The trailing space flag (zero if an error msg)
|
3703 |
|
|
|
3704 |
|
|
CP $03 ; Test against RND, INKEY$ and PI which have no
|
3705 |
|
|
; parameters and therefore no trailing space.
|
3706 |
|
|
|
3707 |
|
|
RET C ; Return if no trailing space.
|
3708 |
|
|
|
3709 |
|
|
LD A,$20 ; Prepare the space character and continue to
|
3710 |
|
|
; print and make an indirect return.
|
3711 |
|
|
|
3712 |
|
|
; -----------------------------------
|
3713 |
|
|
; THE 'RECURSIVE PRINTING' SUBROUTINE
|
3714 |
|
|
; -----------------------------------
|
3715 |
|
|
; This routine which is part of PRINT-OUT allows RST $10 to be used
|
3716 |
|
|
; recursively to print tokens and the spaces associated with them.
|
3717 |
|
|
; It is called on three occasions when the value of DE must be preserved.
|
3718 |
|
|
|
3719 |
|
|
;; PO-SAVE
|
3720 |
|
|
L0C3B: PUSH DE ; Save DE value.
|
3721 |
|
|
EXX ; Switch in main set
|
3722 |
|
|
|
3723 |
|
|
RST 10H ; PRINT-A prints using this alternate set.
|
3724 |
|
|
|
3725 |
|
|
EXX ; Switch back to this alternate set.
|
3726 |
|
|
POP DE ; Restore the initial DE value.
|
3727 |
|
|
|
3728 |
|
|
RET ; Return.
|
3729 |
|
|
|
3730 |
|
|
; ------------
|
3731 |
|
|
; Table search
|
3732 |
|
|
; ------------
|
3733 |
|
|
; This subroutine searches a message or the token table for the
|
3734 |
|
|
; message number held in A. DE holds the address of the table.
|
3735 |
|
|
|
3736 |
|
|
;; PO-SEARCH
|
3737 |
|
|
L0C41: PUSH AF ; save the message/token number
|
3738 |
|
|
EX DE,HL ; transfer DE to HL
|
3739 |
|
|
INC A ; adjust for initial step-over byte
|
3740 |
|
|
|
3741 |
|
|
;; PO-STEP
|
3742 |
|
|
L0C44: BIT 7,(HL) ; is character inverted ?
|
3743 |
|
|
INC HL ; address next
|
3744 |
|
|
JR Z,L0C44 ; back to PO-STEP if not inverted.
|
3745 |
|
|
|
3746 |
|
|
DEC A ; decrease counter
|
3747 |
|
|
JR NZ,L0C44 ; back to PO-STEP if not zero
|
3748 |
|
|
|
3749 |
|
|
EX DE,HL ; transfer address to DE
|
3750 |
|
|
POP AF ; restore message/token number
|
3751 |
|
|
CP $20 ; return with carry set
|
3752 |
|
|
RET C ; for all messages and function tokens
|
3753 |
|
|
|
3754 |
|
|
LD A,(DE) ; test first character of token
|
3755 |
|
|
SUB $41 ; and return with carry set
|
3756 |
|
|
RET ; if it is less that 'A'
|
3757 |
|
|
; i.e. '<>', '<=', '>='
|
3758 |
|
|
|
3759 |
|
|
; ---------------
|
3760 |
|
|
; Test for scroll
|
3761 |
|
|
; ---------------
|
3762 |
|
|
; This test routine is called when printing carriage return, when considering
|
3763 |
|
|
; PRINT AT and from the general PRINT ALL characters routine to test if
|
3764 |
|
|
; scrolling is required, prompting the user if necessary.
|
3765 |
|
|
; This is therefore using the alternate set.
|
3766 |
|
|
; The B register holds the current line.
|
3767 |
|
|
|
3768 |
|
|
;; PO-SCR
|
3769 |
|
|
L0C55: BIT 1,(IY+$01) ; test FLAGS - is printer in use ?
|
3770 |
|
|
RET NZ ; return immediately if so.
|
3771 |
|
|
|
3772 |
|
|
LD DE,L0DD9 ; set DE to address: CL-SET
|
3773 |
|
|
PUSH DE ; and push for return address.
|
3774 |
|
|
|
3775 |
|
|
LD A,B ; transfer the line to A.
|
3776 |
|
|
BIT 0,(IY+$02) ; test TV_FLAG - lower screen in use ?
|
3777 |
|
|
JP NZ,L0D02 ; jump forward to PO-SCR-4 if so.
|
3778 |
|
|
|
3779 |
|
|
CP (IY+$31) ; greater than DF_SZ display file size ?
|
3780 |
|
|
JR C,L0C86 ; forward to REPORT-5 if less.
|
3781 |
|
|
; 'Out of screen'
|
3782 |
|
|
|
3783 |
|
|
RET NZ ; return (via CL-SET) if greater
|
3784 |
|
|
|
3785 |
|
|
BIT 4,(IY+$02) ; test TV_FLAG - Automatic listing ?
|
3786 |
|
|
JR Z,L0C88 ; forward to PO-SCR-2 if not.
|
3787 |
|
|
|
3788 |
|
|
LD E,(IY+$2D) ; fetch BREG - the count of scroll lines to E.
|
3789 |
|
|
DEC E ; decrease and jump
|
3790 |
|
|
JR Z,L0CD2 ; to PO-SCR-3 if zero and scrolling required.
|
3791 |
|
|
|
3792 |
|
|
LD A,$00 ; explicit - select channel zero.
|
3793 |
|
|
CALL L1601 ; routine CHAN-OPEN opens it.
|
3794 |
|
|
|
3795 |
|
|
LD SP,($5C3F) ; set stack pointer to LIST_SP
|
3796 |
|
|
|
3797 |
|
|
RES 4,(IY+$02) ; reset TV_FLAG - signal auto listing finished.
|
3798 |
|
|
RET ; return ignoring pushed value, CL-SET
|
3799 |
|
|
; to MAIN or EDITOR without updating
|
3800 |
|
|
; print position >>
|
3801 |
|
|
|
3802 |
|
|
; ---
|
3803 |
|
|
|
3804 |
|
|
|
3805 |
|
|
;; REPORT-5
|
3806 |
|
|
L0C86: RST 08H ; ERROR-1
|
3807 |
|
|
DEFB $04 ; Error Report: Out of screen
|
3808 |
|
|
|
3809 |
|
|
; continue here if not an automatic listing.
|
3810 |
|
|
|
3811 |
|
|
;; PO-SCR-2
|
3812 |
|
|
L0C88: DEC (IY+$52) ; decrease SCR_CT
|
3813 |
|
|
JR NZ,L0CD2 ; forward to PO-SCR-3 to scroll display if
|
3814 |
|
|
; result not zero.
|
3815 |
|
|
|
3816 |
|
|
; now produce prompt.
|
3817 |
|
|
|
3818 |
|
|
LD A,$18 ; reset
|
3819 |
|
|
SUB B ; the
|
3820 |
|
|
LD ($5C8C),A ; SCR_CT scroll count
|
3821 |
|
|
LD HL,($5C8F) ; L=ATTR_T, H=MASK_T
|
3822 |
|
|
PUSH HL ; save on stack
|
3823 |
|
|
LD A,($5C91) ; P_FLAG
|
3824 |
|
|
PUSH AF ; save on stack to prevent lower screen
|
3825 |
|
|
; attributes (BORDCR etc.) being applied.
|
3826 |
|
|
LD A,$FD ; select system channel 'K'
|
3827 |
|
|
CALL L1601 ; routine CHAN-OPEN opens it
|
3828 |
|
|
XOR A ; clear to address message directly
|
3829 |
|
|
LD DE,L0CF8 ; make DE address: scrl-mssg
|
3830 |
|
|
CALL L0C0A ; routine PO-MSG prints to lower screen
|
3831 |
|
|
SET 5,(IY+$02) ; set TV_FLAG - signal lower screen requires
|
3832 |
|
|
; clearing
|
3833 |
|
|
LD HL,$5C3B ; make HL address FLAGS
|
3834 |
|
|
SET 3,(HL) ; signal 'L' mode.
|
3835 |
|
|
RES 5,(HL) ; signal 'no new key'.
|
3836 |
|
|
EXX ; switch to main set.
|
3837 |
|
|
; as calling chr input from alternative set.
|
3838 |
|
|
CALL L15D4 ; routine WAIT-KEY waits for new key
|
3839 |
|
|
; Note. this is the right routine but the
|
3840 |
|
|
; stream in use is unsatisfactory. From the
|
3841 |
|
|
; choices available, it is however the best.
|
3842 |
|
|
|
3843 |
|
|
EXX ; switch back to alternate set.
|
3844 |
|
|
CP $20 ; space is considered as BREAK
|
3845 |
|
|
JR Z,L0D00 ; forward to REPORT-D if so
|
3846 |
|
|
; 'BREAK - CONT repeats'
|
3847 |
|
|
|
3848 |
|
|
CP $E2 ; is character 'STOP' ?
|
3849 |
|
|
JR Z,L0D00 ; forward to REPORT-D if so
|
3850 |
|
|
|
3851 |
|
|
OR $20 ; convert to lower-case
|
3852 |
|
|
CP $6E ; is character 'n' ?
|
3853 |
|
|
JR Z,L0D00 ; forward to REPORT-D if so else scroll.
|
3854 |
|
|
|
3855 |
|
|
LD A,$FE ; select system channel 'S'
|
3856 |
|
|
CALL L1601 ; routine CHAN-OPEN
|
3857 |
|
|
POP AF ; restore original P_FLAG
|
3858 |
|
|
LD ($5C91),A ; and save in P_FLAG.
|
3859 |
|
|
POP HL ; restore original ATTR_T, MASK_T
|
3860 |
|
|
LD ($5C8F),HL ; and reset ATTR_T, MASK-T as 'scroll?' has
|
3861 |
|
|
; been printed.
|
3862 |
|
|
|
3863 |
|
|
;; PO-SCR-3
|
3864 |
|
|
L0CD2: CALL L0DFE ; routine CL-SC-ALL to scroll whole display
|
3865 |
|
|
LD B,(IY+$31) ; fetch DF_SZ to B
|
3866 |
|
|
INC B ; increase to address last line of display
|
3867 |
|
|
LD C,$21 ; set C to $21 (was $21 from above routine)
|
3868 |
|
|
PUSH BC ; save the line and column in BC.
|
3869 |
|
|
|
3870 |
|
|
CALL L0E9B ; routine CL-ADDR finds display address.
|
3871 |
|
|
|
3872 |
|
|
LD A,H ; now find the corresponding attribute byte
|
3873 |
|
|
RRCA ; (this code sequence is used twice
|
3874 |
|
|
RRCA ; elsewhere and is a candidate for
|
3875 |
|
|
RRCA ; a subroutine.)
|
3876 |
|
|
AND $03 ;
|
3877 |
|
|
OR $58 ;
|
3878 |
|
|
LD H,A ;
|
3879 |
|
|
|
3880 |
|
|
LD DE,$5AE0 ; start of last 'line' of attribute area
|
3881 |
|
|
LD A,(DE) ; get attribute for last line
|
3882 |
|
|
LD C,(HL) ; transfer to base line of upper part
|
3883 |
|
|
LD B,$20 ; there are thirty two bytes
|
3884 |
|
|
EX DE,HL ; swap the pointers.
|
3885 |
|
|
|
3886 |
|
|
;; PO-SCR-3A
|
3887 |
|
|
L0CF0: LD (DE),A ; transfer
|
3888 |
|
|
LD (HL),C ; attributes.
|
3889 |
|
|
INC DE ; address next.
|
3890 |
|
|
INC HL ; address next.
|
3891 |
|
|
DJNZ L0CF0 ; loop back to PO-SCR-3A for all adjacent
|
3892 |
|
|
; attribute lines.
|
3893 |
|
|
|
3894 |
|
|
POP BC ; restore the line/column.
|
3895 |
|
|
RET ; return via CL-SET (was pushed on stack).
|
3896 |
|
|
|
3897 |
|
|
; ---
|
3898 |
|
|
|
3899 |
|
|
; The message 'scroll?' appears here with last byte inverted.
|
3900 |
|
|
|
3901 |
|
|
;; scrl-mssg
|
3902 |
|
|
L0CF8: DEFB $80 ; initial step-over byte.
|
3903 |
|
|
DEFM "scroll"
|
3904 |
|
|
DEFB '?'+$80
|
3905 |
|
|
|
3906 |
|
|
;; REPORT-D
|
3907 |
|
|
L0D00: RST 08H ; ERROR-1
|
3908 |
|
|
DEFB $0C ; Error Report: BREAK - CONT repeats
|
3909 |
|
|
|
3910 |
|
|
; continue here if using lower display - A holds line number.
|
3911 |
|
|
|
3912 |
|
|
;; PO-SCR-4
|
3913 |
|
|
L0D02: CP $02 ; is line number less than 2 ?
|
3914 |
|
|
JR C,L0C86 ; to REPORT-5 if so
|
3915 |
|
|
; 'Out of Screen'.
|
3916 |
|
|
|
3917 |
|
|
ADD A,(IY+$31) ; add DF_SZ
|
3918 |
|
|
SUB $19 ;
|
3919 |
|
|
RET NC ; return if scrolling unnecessary
|
3920 |
|
|
|
3921 |
|
|
NEG ; Negate to give number of scrolls required.
|
3922 |
|
|
PUSH BC ; save line/column
|
3923 |
|
|
LD B,A ; count to B
|
3924 |
|
|
LD HL,($5C8F) ; fetch current ATTR_T, MASK_T to HL.
|
3925 |
|
|
PUSH HL ; and save
|
3926 |
|
|
LD HL,($5C91) ; fetch P_FLAG
|
3927 |
|
|
PUSH HL ; and save.
|
3928 |
|
|
; to prevent corruption by input AT
|
3929 |
|
|
|
3930 |
|
|
CALL L0D4D ; routine TEMPS sets to BORDCR etc
|
3931 |
|
|
LD A,B ; transfer scroll number to A.
|
3932 |
|
|
|
3933 |
|
|
;; PO-SCR-4A
|
3934 |
|
|
L0D1C: PUSH AF ; save scroll number.
|
3935 |
|
|
LD HL,$5C6B ; address DF_SZ
|
3936 |
|
|
LD B,(HL) ; fetch old value
|
3937 |
|
|
LD A,B ; transfer to A
|
3938 |
|
|
INC A ; and increment
|
3939 |
|
|
LD (HL),A ; then put back.
|
3940 |
|
|
LD HL,$5C89 ; address S_POSN_hi - line
|
3941 |
|
|
CP (HL) ; compare
|
3942 |
|
|
JR C,L0D2D ; forward to PO-SCR-4B if scrolling required
|
3943 |
|
|
|
3944 |
|
|
INC (HL) ; else increment S_POSN_hi
|
3945 |
|
|
LD B,$18 ; set count to whole display ??
|
3946 |
|
|
; Note. should be $17 and the top line will be
|
3947 |
|
|
; scrolled into the ROM which is harmless on
|
3948 |
|
|
; the standard set up.
|
3949 |
|
|
; credit P.Giblin 1984.
|
3950 |
|
|
|
3951 |
|
|
;; PO-SCR-4B
|
3952 |
|
|
L0D2D: CALL L0E00 ; routine CL-SCROLL scrolls B lines
|
3953 |
|
|
POP AF ; restore scroll counter.
|
3954 |
|
|
DEC A ; decrease
|
3955 |
|
|
JR NZ,L0D1C ; back to PO-SCR-4A until done
|
3956 |
|
|
|
3957 |
|
|
POP HL ; restore original P_FLAG.
|
3958 |
|
|
LD (IY+$57),L ; and overwrite system variable P_FLAG.
|
3959 |
|
|
|
3960 |
|
|
POP HL ; restore original ATTR_T/MASK_T.
|
3961 |
|
|
LD ($5C8F),HL ; and update system variables.
|
3962 |
|
|
|
3963 |
|
|
LD BC,($5C88) ; fetch S_POSN to BC.
|
3964 |
|
|
RES 0,(IY+$02) ; signal to TV_FLAG - main screen in use.
|
3965 |
|
|
CALL L0DD9 ; call routine CL-SET for upper display.
|
3966 |
|
|
|
3967 |
|
|
SET 0,(IY+$02) ; signal to TV_FLAG - lower screen in use.
|
3968 |
|
|
POP BC ; restore line/column
|
3969 |
|
|
RET ; return via CL-SET for lower display.
|
3970 |
|
|
|
3971 |
|
|
; ----------------------
|
3972 |
|
|
; Temporary colour items
|
3973 |
|
|
; ----------------------
|
3974 |
|
|
; This subroutine is called 11 times to copy the permanent colour items
|
3975 |
|
|
; to the temporary ones.
|
3976 |
|
|
|
3977 |
|
|
;; TEMPS
|
3978 |
|
|
L0D4D: XOR A ; clear the accumulator
|
3979 |
|
|
LD HL,($5C8D) ; fetch L=ATTR_P and H=MASK_P
|
3980 |
|
|
BIT 0,(IY+$02) ; test TV_FLAG - is lower screen in use ?
|
3981 |
|
|
JR Z,L0D5B ; skip to TEMPS-1 if not
|
3982 |
|
|
|
3983 |
|
|
LD H,A ; set H, MASK P, to 00000000.
|
3984 |
|
|
LD L,(IY+$0E) ; fetch BORDCR to L which is used for lower
|
3985 |
|
|
; screen.
|
3986 |
|
|
|
3987 |
|
|
;; TEMPS-1
|
3988 |
|
|
L0D5B: LD ($5C8F),HL ; transfer values to ATTR_T and MASK_T
|
3989 |
|
|
|
3990 |
|
|
; for the print flag the permanent values are odd bits, temporary even bits.
|
3991 |
|
|
|
3992 |
|
|
LD HL,$5C91 ; address P_FLAG.
|
3993 |
|
|
JR NZ,L0D65 ; skip to TEMPS-2 if lower screen using A=0.
|
3994 |
|
|
|
3995 |
|
|
LD A,(HL) ; else pick up flag bits.
|
3996 |
|
|
RRCA ; rotate permanent bits to temporary bits.
|
3997 |
|
|
|
3998 |
|
|
;; TEMPS-2
|
3999 |
|
|
L0D65: XOR (HL) ;
|
4000 |
|
|
AND $55 ; BIN 01010101
|
4001 |
|
|
XOR (HL) ; permanent now as original
|
4002 |
|
|
LD (HL),A ; apply permanent bits to temporary bits.
|
4003 |
|
|
RET ; and return.
|
4004 |
|
|
|
4005 |
|
|
; -----------------
|
4006 |
|
|
; THE 'CLS' COMMAND
|
4007 |
|
|
; -----------------
|
4008 |
|
|
; This command clears the display.
|
4009 |
|
|
; The routine is also called during initialization and by the CLEAR command.
|
4010 |
|
|
; If it's difficult to write it should be difficult to read.
|
4011 |
|
|
|
4012 |
|
|
;; CLS
|
4013 |
|
|
L0D6B: CALL L0DAF ; Routine CL-ALL clears the entire display and
|
4014 |
|
|
; sets the attributes to the permanent ones
|
4015 |
|
|
; from ATTR-P.
|
4016 |
|
|
|
4017 |
|
|
; Having cleared all 24 lines of the display area, continue into the
|
4018 |
|
|
; subroutine that clears the lower display area. Note that at the moment
|
4019 |
|
|
; the attributes for the lower lines are the same as upper ones and have
|
4020 |
|
|
; to be changed to match the BORDER colour.
|
4021 |
|
|
|
4022 |
|
|
; --------------------------
|
4023 |
|
|
; THE 'CLS-LOWER' SUBROUTINE
|
4024 |
|
|
; --------------------------
|
4025 |
|
|
; This routine is called from INPUT, and from the MAIN execution loop.
|
4026 |
|
|
; This is very much a housekeeping routine which clears between 2 and 23
|
4027 |
|
|
; lines of the display, setting attributes and correcting situations where
|
4028 |
|
|
; errors have occurred while the normal input and output routines have been
|
4029 |
|
|
; temporarily diverted to deal with, say colour control codes.
|
4030 |
|
|
|
4031 |
|
|
;; CLS-LOWER
|
4032 |
|
|
L0D6E: LD HL,$5C3C ; address System Variable TV_FLAG.
|
4033 |
|
|
RES 5,(HL) ; TV_FLAG - signal do not clear lower screen.
|
4034 |
|
|
SET 0,(HL) ; TV_FLAG - signal lower screen in use.
|
4035 |
|
|
|
4036 |
|
|
CALL L0D4D ; routine TEMPS applies permanent attributes,
|
4037 |
|
|
; in this case BORDCR to ATTR_T.
|
4038 |
|
|
; Note. this seems unnecessary and is repeated
|
4039 |
|
|
; within CL-LINE.
|
4040 |
|
|
|
4041 |
|
|
LD B,(IY+$31) ; fetch lower screen display file size DF_SZ
|
4042 |
|
|
|
4043 |
|
|
CALL L0E44 ; routine CL-LINE clears lines to bottom of the
|
4044 |
|
|
; display and sets attributes from BORDCR while
|
4045 |
|
|
; preserving the B register.
|
4046 |
|
|
|
4047 |
|
|
LD HL,$5AC0 ; set initial attribute address to the leftmost
|
4048 |
|
|
; cell of second line up.
|
4049 |
|
|
|
4050 |
|
|
LD A,($5C8D) ; fetch permanent attribute from ATTR_P.
|
4051 |
|
|
|
4052 |
|
|
DEC B ; decrement lower screen display file size.
|
4053 |
|
|
|
4054 |
|
|
JR L0D8E ; forward to enter the backfill loop at CLS-3
|
4055 |
|
|
; where B is decremented again.
|
4056 |
|
|
|
4057 |
|
|
; ---
|
4058 |
|
|
|
4059 |
|
|
; The backfill loop is entered at midpoint and ensures, if more than 2
|
4060 |
|
|
; lines have been cleared, that any other lines take the permanent screen
|
4061 |
|
|
; attributes.
|
4062 |
|
|
|
4063 |
|
|
;; CLS-1
|
4064 |
|
|
L0D87: LD C,$20 ; set counter to 32 character cells per line
|
4065 |
|
|
|
4066 |
|
|
;; CLS-2
|
4067 |
|
|
L0D89: DEC HL ; decrease attribute address.
|
4068 |
|
|
LD (HL),A ; and place attributes in next line up.
|
4069 |
|
|
DEC C ; decrease the 32 counter.
|
4070 |
|
|
JR NZ,L0D89 ; loop back to CLS-2 until all 32 cells done.
|
4071 |
|
|
|
4072 |
|
|
;; CLS-3
|
4073 |
|
|
L0D8E: DJNZ L0D87 ; decrease B counter and back to CLS-1
|
4074 |
|
|
; if not zero.
|
4075 |
|
|
|
4076 |
|
|
LD (IY+$31),$02 ; now set DF_SZ lower screen to 2
|
4077 |
|
|
|
4078 |
|
|
; This entry point is also called from CL-ALL below to
|
4079 |
|
|
; reset the system channel input and output addresses to normal.
|
4080 |
|
|
|
4081 |
|
|
;; CL-CHAN
|
4082 |
|
|
L0D94: LD A,$FD ; select system channel 'K'
|
4083 |
|
|
|
4084 |
|
|
CALL L1601 ; routine CHAN-OPEN opens it.
|
4085 |
|
|
|
4086 |
|
|
LD HL,($5C51) ; fetch CURCHL to HL to address current channel
|
4087 |
|
|
LD DE,L09F4 ; set address to PRINT-OUT for first pass.
|
4088 |
|
|
AND A ; clear carry for first pass.
|
4089 |
|
|
|
4090 |
|
|
;; CL-CHAN-A
|
4091 |
|
|
L0DA0: LD (HL),E ; Insert the output address on the first pass
|
4092 |
|
|
INC HL ; or the input address on the second pass.
|
4093 |
|
|
LD (HL),D ;
|
4094 |
|
|
INC HL ;
|
4095 |
|
|
|
4096 |
|
|
LD DE,L10A8 ; fetch address KEY-INPUT for second pass
|
4097 |
|
|
CCF ; complement carry flag - will set on pass 1.
|
4098 |
|
|
|
4099 |
|
|
JR C,L0DA0 ; back to CL-CHAN-A if first pass else done.
|
4100 |
|
|
|
4101 |
|
|
LD BC,$1721 ; line 23 for lower screen
|
4102 |
|
|
JR L0DD9 ; exit via CL-SET to set column
|
4103 |
|
|
; for lower display
|
4104 |
|
|
|
4105 |
|
|
; ---------------------------
|
4106 |
|
|
; Clearing whole display area
|
4107 |
|
|
; ---------------------------
|
4108 |
|
|
; This subroutine called from CLS, AUTO-LIST and MAIN-3
|
4109 |
|
|
; clears 24 lines of the display and resets the relevant system variables.
|
4110 |
|
|
; This routine also recovers from an error situation where, for instance, an
|
4111 |
|
|
; invalid colour or position control code has left the output routine addressing
|
4112 |
|
|
; PO-TV-2 or PO-CONT.
|
4113 |
|
|
|
4114 |
|
|
;; CL-ALL
|
4115 |
|
|
L0DAF: LD HL,$0000 ; Initialize plot coordinates.
|
4116 |
|
|
LD ($5C7D),HL ; Set system variable COORDS to 0,0.
|
4117 |
|
|
|
4118 |
|
|
RES 0,(IY+$30) ; update FLAGS2 - signal main screen is clear.
|
4119 |
|
|
|
4120 |
|
|
CALL L0D94 ; routine CL-CHAN makes channel 'K' 'normal'.
|
4121 |
|
|
|
4122 |
|
|
LD A,$FE ; select system channel 'S'
|
4123 |
|
|
CALL L1601 ; routine CHAN-OPEN opens it.
|
4124 |
|
|
|
4125 |
|
|
CALL L0D4D ; routine TEMPS applies permanent attributes,
|
4126 |
|
|
; in this case ATTR_P, to ATTR_T.
|
4127 |
|
|
; Note. this seems unnecessary.
|
4128 |
|
|
|
4129 |
|
|
LD B,$18 ; There are 24 lines.
|
4130 |
|
|
|
4131 |
|
|
CALL L0E44 ; routine CL-LINE clears 24 text lines and sets
|
4132 |
|
|
; attributes from ATTR-P.
|
4133 |
|
|
; This routine preserves B and sets C to $21.
|
4134 |
|
|
|
4135 |
|
|
LD HL,($5C51) ; fetch CURCHL make HL address output routine.
|
4136 |
|
|
|
4137 |
|
|
LD DE,L09F4 ; address: PRINT-OUT
|
4138 |
|
|
LD (HL),E ; is made
|
4139 |
|
|
INC HL ; the normal
|
4140 |
|
|
LD (HL),D ; output address.
|
4141 |
|
|
|
4142 |
|
|
LD (IY+$52),$01 ; set SCR_CT - scroll count - to default.
|
4143 |
|
|
|
4144 |
|
|
; Note. BC already contains $1821.
|
4145 |
|
|
|
4146 |
|
|
LD BC,$1821 ; reset column and line to 0,0
|
4147 |
|
|
; and continue into CL-SET, below, exiting
|
4148 |
|
|
; via PO-STORE (for the upper screen).
|
4149 |
|
|
|
4150 |
|
|
; --------------------
|
4151 |
|
|
; THE 'CL-SET' ROUTINE
|
4152 |
|
|
; --------------------
|
4153 |
|
|
; This important subroutine is used to calculate the character output
|
4154 |
|
|
; address for screens or printer based on the line/column for screens
|
4155 |
|
|
; or the column for printer.
|
4156 |
|
|
|
4157 |
|
|
;; CL-SET
|
4158 |
|
|
L0DD9: LD HL,$5B00 ; the base address of printer buffer
|
4159 |
|
|
BIT 1,(IY+$01) ; test FLAGS - is printer in use ?
|
4160 |
|
|
JR NZ,L0DF4 ; forward to CL-SET-2 if so.
|
4161 |
|
|
|
4162 |
|
|
LD A,B ; transfer line to A.
|
4163 |
|
|
BIT 0,(IY+$02) ; test TV_FLAG - lower screen in use ?
|
4164 |
|
|
JR Z,L0DEE ; skip to CL-SET-1 if handling upper part
|
4165 |
|
|
|
4166 |
|
|
ADD A,(IY+$31) ; add DF_SZ for lower screen
|
4167 |
|
|
SUB $18 ; and adjust.
|
4168 |
|
|
|
4169 |
|
|
;; CL-SET-1
|
4170 |
|
|
L0DEE: PUSH BC ; save the line/column.
|
4171 |
|
|
LD B,A ; transfer line to B
|
4172 |
|
|
; (adjusted if lower screen)
|
4173 |
|
|
|
4174 |
|
|
CALL L0E9B ; routine CL-ADDR calculates address at left
|
4175 |
|
|
; of screen.
|
4176 |
|
|
POP BC ; restore the line/column.
|
4177 |
|
|
|
4178 |
|
|
;; CL-SET-2
|
4179 |
|
|
L0DF4: LD A,$21 ; the column $01-$21 is reversed
|
4180 |
|
|
SUB C ; to range $00 - $20
|
4181 |
|
|
LD E,A ; now transfer to DE
|
4182 |
|
|
LD D,$00 ; prepare for addition
|
4183 |
|
|
ADD HL,DE ; and add to base address
|
4184 |
|
|
|
4185 |
|
|
JP L0ADC ; exit via PO-STORE to update the relevant
|
4186 |
|
|
; system variables.
|
4187 |
|
|
; ----------------
|
4188 |
|
|
; Handle scrolling
|
4189 |
|
|
; ----------------
|
4190 |
|
|
; The routine CL-SC-ALL is called once from PO to scroll all the display
|
4191 |
|
|
; and from the routine CL-SCROLL, once, to scroll part of the display.
|
4192 |
|
|
|
4193 |
|
|
;; CL-SC-ALL
|
4194 |
|
|
L0DFE: LD B,$17 ; scroll 23 lines, after 'scroll?'.
|
4195 |
|
|
|
4196 |
|
|
;; CL-SCROLL
|
4197 |
|
|
L0E00: CALL L0E9B ; routine CL-ADDR gets screen address in HL.
|
4198 |
|
|
LD C,$08 ; there are 8 pixel lines to scroll.
|
4199 |
|
|
|
4200 |
|
|
;; CL-SCR-1
|
4201 |
|
|
L0E05: PUSH BC ; save counters.
|
4202 |
|
|
PUSH HL ; and initial address.
|
4203 |
|
|
LD A,B ; get line count.
|
4204 |
|
|
AND $07 ; will set zero if all third to be scrolled.
|
4205 |
|
|
LD A,B ; re-fetch the line count.
|
4206 |
|
|
JR NZ,L0E19 ; forward to CL-SCR-3 if partial scroll.
|
4207 |
|
|
|
4208 |
|
|
; HL points to top line of third and must be copied to bottom of previous 3rd.
|
4209 |
|
|
; ( so HL = $4800 or $5000 ) ( but also sometimes $4000 )
|
4210 |
|
|
|
4211 |
|
|
;; CL-SCR-2
|
4212 |
|
|
L0E0D: EX DE,HL ; copy HL to DE.
|
4213 |
|
|
LD HL,$F8E0 ; subtract $08 from H and add $E0 to L -
|
4214 |
|
|
ADD HL,DE ; to make destination bottom line of previous
|
4215 |
|
|
; third.
|
4216 |
|
|
EX DE,HL ; restore the source and destination.
|
4217 |
|
|
LD BC,$0020 ; thirty-two bytes are to be copied.
|
4218 |
|
|
DEC A ; decrement the line count.
|
4219 |
|
|
LDIR ; copy a pixel line to previous third.
|
4220 |
|
|
|
4221 |
|
|
;; CL-SCR-3
|
4222 |
|
|
L0E19: EX DE,HL ; save source in DE.
|
4223 |
|
|
LD HL,$FFE0 ; load the value -32.
|
4224 |
|
|
ADD HL,DE ; add to form destination in HL.
|
4225 |
|
|
EX DE,HL ; switch source and destination
|
4226 |
|
|
LD B,A ; save the count in B.
|
4227 |
|
|
AND $07 ; mask to find count applicable to current
|
4228 |
|
|
RRCA ; third and
|
4229 |
|
|
RRCA ; multiply by
|
4230 |
|
|
RRCA ; thirty two (same as 5 RLCAs)
|
4231 |
|
|
|
4232 |
|
|
LD C,A ; transfer byte count to C ($E0 at most)
|
4233 |
|
|
LD A,B ; store line count to A
|
4234 |
|
|
LD B,$00 ; make B zero
|
4235 |
|
|
LDIR ; copy bytes (BC=0, H incremented, L=0)
|
4236 |
|
|
LD B,$07 ; set B to 7, C is zero.
|
4237 |
|
|
ADD HL,BC ; add 7 to H to address next third.
|
4238 |
|
|
AND $F8 ; has last third been done ?
|
4239 |
|
|
JR NZ,L0E0D ; back to CL-SCR-2 if not.
|
4240 |
|
|
|
4241 |
|
|
POP HL ; restore topmost address.
|
4242 |
|
|
INC H ; next pixel line down.
|
4243 |
|
|
POP BC ; restore counts.
|
4244 |
|
|
DEC C ; reduce pixel line count.
|
4245 |
|
|
JR NZ,L0E05 ; back to CL-SCR-1 if all eight not done.
|
4246 |
|
|
|
4247 |
|
|
CALL L0E88 ; routine CL-ATTR gets address in attributes
|
4248 |
|
|
; from current 'ninth line', count in BC.
|
4249 |
|
|
|
4250 |
|
|
LD HL,$FFE0 ; set HL to the 16-bit value -32.
|
4251 |
|
|
ADD HL,DE ; and add to form destination address.
|
4252 |
|
|
EX DE,HL ; swap source and destination addresses.
|
4253 |
|
|
LDIR ; copy bytes scrolling the linear attributes.
|
4254 |
|
|
LD B,$01 ; continue to clear the bottom line.
|
4255 |
|
|
|
4256 |
|
|
; ------------------------------
|
4257 |
|
|
; THE 'CLEAR TEXT LINES' ROUTINE
|
4258 |
|
|
; ------------------------------
|
4259 |
|
|
; This subroutine, called from CL-ALL, CLS-LOWER and AUTO-LIST and above,
|
4260 |
|
|
; clears text lines at bottom of display.
|
4261 |
|
|
; The B register holds on entry the number of lines to be cleared 1-24.
|
4262 |
|
|
|
4263 |
|
|
;; CL-LINE
|
4264 |
|
|
L0E44: PUSH BC ; save line count
|
4265 |
|
|
CALL L0E9B ; routine CL-ADDR gets top address
|
4266 |
|
|
LD C,$08 ; there are eight screen lines to a text line.
|
4267 |
|
|
|
4268 |
|
|
;; CL-LINE-1
|
4269 |
|
|
L0E4A: PUSH BC ; save pixel line count
|
4270 |
|
|
PUSH HL ; and save the address
|
4271 |
|
|
LD A,B ; transfer the line to A (1-24).
|
4272 |
|
|
|
4273 |
|
|
;; CL-LINE-2
|
4274 |
|
|
L0E4D: AND $07 ; mask 0-7 to consider thirds at a time
|
4275 |
|
|
RRCA ; multiply
|
4276 |
|
|
RRCA ; by 32 (same as five RLCA instructions)
|
4277 |
|
|
RRCA ; now 32 - 256(0)
|
4278 |
|
|
LD C,A ; store result in C
|
4279 |
|
|
LD A,B ; save line in A (1-24)
|
4280 |
|
|
LD B,$00 ; set high byte to 0, prepare for ldir.
|
4281 |
|
|
DEC C ; decrement count 31-255.
|
4282 |
|
|
LD D,H ; copy HL
|
4283 |
|
|
LD E,L ; to DE.
|
4284 |
|
|
LD (HL),$00 ; blank the first byte.
|
4285 |
|
|
INC DE ; make DE point to next byte.
|
4286 |
|
|
LDIR ; ldir will clear lines.
|
4287 |
|
|
LD DE,$0701 ; now address next third adjusting
|
4288 |
|
|
ADD HL,DE ; register E to address left hand side
|
4289 |
|
|
DEC A ; decrease the line count.
|
4290 |
|
|
AND $F8 ; will be 16, 8 or 0 (AND $18 will do).
|
4291 |
|
|
LD B,A ; transfer count to B.
|
4292 |
|
|
JR NZ,L0E4D ; back to CL-LINE-2 if 16 or 8 to do
|
4293 |
|
|
; the next third.
|
4294 |
|
|
|
4295 |
|
|
POP HL ; restore start address.
|
4296 |
|
|
INC H ; address next line down.
|
4297 |
|
|
POP BC ; fetch counts.
|
4298 |
|
|
DEC C ; decrement pixel line count
|
4299 |
|
|
JR NZ,L0E4A ; back to CL-LINE-1 till all done.
|
4300 |
|
|
|
4301 |
|
|
CALL L0E88 ; routine CL-ATTR gets attribute address
|
4302 |
|
|
; in DE and B * 32 in BC.
|
4303 |
|
|
|
4304 |
|
|
LD H,D ; transfer the address
|
4305 |
|
|
LD L,E ; to HL.
|
4306 |
|
|
|
4307 |
|
|
INC DE ; make DE point to next location.
|
4308 |
|
|
|
4309 |
|
|
LD A,($5C8D) ; fetch ATTR_P - permanent attributes
|
4310 |
|
|
BIT 0,(IY+$02) ; test TV_FLAG - lower screen in use ?
|
4311 |
|
|
JR Z,L0E80 ; skip to CL-LINE-3 if not.
|
4312 |
|
|
|
4313 |
|
|
LD A,($5C48) ; else lower screen uses BORDCR as attribute.
|
4314 |
|
|
|
4315 |
|
|
;; CL-LINE-3
|
4316 |
|
|
L0E80: LD (HL),A ; put attribute in first byte.
|
4317 |
|
|
DEC BC ; decrement the counter.
|
4318 |
|
|
LDIR ; copy bytes to set all attributes.
|
4319 |
|
|
POP BC ; restore the line $01-$24.
|
4320 |
|
|
LD C,$21 ; make column $21. (No use is made of this)
|
4321 |
|
|
RET ; return to the calling routine.
|
4322 |
|
|
|
4323 |
|
|
; ------------------
|
4324 |
|
|
; Attribute handling
|
4325 |
|
|
; ------------------
|
4326 |
|
|
; This subroutine is called from CL-LINE or CL-SCROLL with the HL register
|
4327 |
|
|
; pointing to the 'ninth' line and H needs to be decremented before or after
|
4328 |
|
|
; the division. Had it been done first then either present code or that used
|
4329 |
|
|
; at the start of PO-ATTR could have been used.
|
4330 |
|
|
; The Spectrum screen arrangement leads to the L register already holding
|
4331 |
|
|
; the correct value for the attribute file and it is only necessary
|
4332 |
|
|
; to manipulate H to form the correct colour attribute address.
|
4333 |
|
|
|
4334 |
|
|
;; CL-ATTR
|
4335 |
|
|
L0E88: LD A,H ; fetch H to A - $48, $50, or $58.
|
4336 |
|
|
RRCA ; divide by
|
4337 |
|
|
RRCA ; eight.
|
4338 |
|
|
RRCA ; $09, $0A or $0B.
|
4339 |
|
|
DEC A ; $08, $09 or $0A.
|
4340 |
|
|
OR $50 ; $58, $59 or $5A.
|
4341 |
|
|
LD H,A ; save high byte of attributes.
|
4342 |
|
|
|
4343 |
|
|
EX DE,HL ; transfer attribute address to DE
|
4344 |
|
|
LD H,C ; set H to zero - from last LDIR.
|
4345 |
|
|
LD L,B ; load L with the line from B.
|
4346 |
|
|
ADD HL,HL ; multiply
|
4347 |
|
|
ADD HL,HL ; by
|
4348 |
|
|
ADD HL,HL ; thirty two
|
4349 |
|
|
ADD HL,HL ; to give count of attribute
|
4350 |
|
|
ADD HL,HL ; cells to the end of display.
|
4351 |
|
|
|
4352 |
|
|
LD B,H ; transfer the result
|
4353 |
|
|
LD C,L ; to register BC.
|
4354 |
|
|
|
4355 |
|
|
RET ; return.
|
4356 |
|
|
|
4357 |
|
|
; -------------------------------
|
4358 |
|
|
; Handle display with line number
|
4359 |
|
|
; -------------------------------
|
4360 |
|
|
; This subroutine is called from four places to calculate the address
|
4361 |
|
|
; of the start of a screen character line which is supplied in B.
|
4362 |
|
|
|
4363 |
|
|
;; CL-ADDR
|
4364 |
|
|
L0E9B: LD A,$18 ; reverse the line number
|
4365 |
|
|
SUB B ; to range $00 - $17.
|
4366 |
|
|
LD D,A ; save line in D for later.
|
4367 |
|
|
RRCA ; multiply
|
4368 |
|
|
RRCA ; by
|
4369 |
|
|
RRCA ; thirty-two.
|
4370 |
|
|
|
4371 |
|
|
AND $E0 ; mask off low bits to make
|
4372 |
|
|
LD L,A ; L a multiple of 32.
|
4373 |
|
|
|
4374 |
|
|
LD A,D ; bring back the line to A.
|
4375 |
|
|
|
4376 |
|
|
AND $18 ; now $00, $08 or $10.
|
4377 |
|
|
|
4378 |
|
|
OR $40 ; add the base address of screen.
|
4379 |
|
|
|
4380 |
|
|
LD H,A ; HL now has the correct address.
|
4381 |
|
|
RET ; return.
|
4382 |
|
|
|
4383 |
|
|
; -------------------
|
4384 |
|
|
; Handle COPY command
|
4385 |
|
|
; -------------------
|
4386 |
|
|
; This command copies the top 176 lines to the ZX Printer
|
4387 |
|
|
; It is popular to call this from machine code at point
|
4388 |
|
|
; L0EAF with B holding 192 (and interrupts disabled) for a full-screen
|
4389 |
|
|
; copy. This particularly applies to 16K Spectrums as time-critical
|
4390 |
|
|
; machine code routines cannot be written in the first 16K of RAM as
|
4391 |
|
|
; it is shared with the ULA which has precedence over the Z80 chip.
|
4392 |
|
|
|
4393 |
|
|
;; COPY
|
4394 |
|
|
L0EAC: DI ; disable interrupts as this is time-critical.
|
4395 |
|
|
|
4396 |
|
|
LD B,$B0 ; top 176 lines.
|
4397 |
|
|
L0EAF: LD HL,$4000 ; address start of the display file.
|
4398 |
|
|
|
4399 |
|
|
; now enter a loop to handle each pixel line.
|
4400 |
|
|
|
4401 |
|
|
;; COPY-1
|
4402 |
|
|
L0EB2: PUSH HL ; save the screen address.
|
4403 |
|
|
PUSH BC ; and the line counter.
|
4404 |
|
|
|
4405 |
|
|
CALL L0EF4 ; routine COPY-LINE outputs one line.
|
4406 |
|
|
|
4407 |
|
|
POP BC ; restore the line counter.
|
4408 |
|
|
POP HL ; and display address.
|
4409 |
|
|
INC H ; next line down screen within 'thirds'.
|
4410 |
|
|
LD A,H ; high byte to A.
|
4411 |
|
|
AND $07 ; result will be zero if we have left third.
|
4412 |
|
|
JR NZ,L0EC9 ; forward to COPY-2 if not to continue loop.
|
4413 |
|
|
|
4414 |
|
|
LD A,L ; consider low byte first.
|
4415 |
|
|
ADD A,$20 ; increase by 32 - sets carry if back to zero.
|
4416 |
|
|
LD L,A ; will be next group of 8.
|
4417 |
|
|
CCF ; complement - carry set if more lines in
|
4418 |
|
|
; the previous third.
|
4419 |
|
|
SBC A,A ; will be FF, if more, else 00.
|
4420 |
|
|
AND $F8 ; will be F8 (-8) or 00.
|
4421 |
|
|
ADD A,H ; that is subtract 8, if more to do in third.
|
4422 |
|
|
LD H,A ; and reset address.
|
4423 |
|
|
|
4424 |
|
|
;; COPY-2
|
4425 |
|
|
L0EC9: DJNZ L0EB2 ; back to COPY-1 for all lines.
|
4426 |
|
|
|
4427 |
|
|
JR L0EDA ; forward to COPY-END to switch off the printer
|
4428 |
|
|
; motor and enable interrupts.
|
4429 |
|
|
; Note. Nothing else is required.
|
4430 |
|
|
|
4431 |
|
|
; ------------------------------
|
4432 |
|
|
; Pass printer buffer to printer
|
4433 |
|
|
; ------------------------------
|
4434 |
|
|
; This routine is used to copy 8 text lines from the printer buffer
|
4435 |
|
|
; to the ZX Printer. These text lines are mapped linearly so HL does
|
4436 |
|
|
; not need to be adjusted at the end of each line.
|
4437 |
|
|
|
4438 |
|
|
;; COPY-BUFF
|
4439 |
|
|
L0ECD: DI ; disable interrupts
|
4440 |
|
|
LD HL,$5B00 ; the base address of the Printer Buffer.
|
4441 |
|
|
LD B,$08 ; set count to 8 lines of 32 bytes.
|
4442 |
|
|
|
4443 |
|
|
;; COPY-3
|
4444 |
|
|
L0ED3: PUSH BC ; save counter.
|
4445 |
|
|
|
4446 |
|
|
CALL L0EF4 ; routine COPY-LINE outputs 32 bytes
|
4447 |
|
|
|
4448 |
|
|
POP BC ; restore counter.
|
4449 |
|
|
DJNZ L0ED3 ; loop back to COPY-3 for all 8 lines.
|
4450 |
|
|
; then stop motor and clear buffer.
|
4451 |
|
|
|
4452 |
|
|
; Note. the COPY command rejoins here, essentially to execute the next
|
4453 |
|
|
; three instructions.
|
4454 |
|
|
|
4455 |
|
|
;; COPY-END
|
4456 |
|
|
L0EDA: LD A,$04 ; output value 4 to port
|
4457 |
|
|
OUT ($FB),A ; to stop the slowed printer motor.
|
4458 |
|
|
EI ; enable interrupts.
|
4459 |
|
|
|
4460 |
|
|
; --------------------
|
4461 |
|
|
; Clear Printer Buffer
|
4462 |
|
|
; --------------------
|
4463 |
|
|
; This routine clears an arbitrary 256 bytes of memory.
|
4464 |
|
|
; Note. The routine seems designed to clear a buffer that follows the
|
4465 |
|
|
; system variables.
|
4466 |
|
|
; The routine should check a flag or HL address and simply return if COPY
|
4467 |
|
|
; is in use.
|
4468 |
|
|
; As a consequence of this omission the buffer will needlessly
|
4469 |
|
|
; be cleared when COPY is used and the screen/printer position may be set to
|
4470 |
|
|
; the start of the buffer and the line number to 0 (B)
|
4471 |
|
|
; giving an 'Out of Screen' error.
|
4472 |
|
|
; There seems to have been an unsuccessful attempt to circumvent the use
|
4473 |
|
|
; of PR_CC_hi.
|
4474 |
|
|
|
4475 |
|
|
;; CLEAR-PRB
|
4476 |
|
|
L0EDF: LD HL,$5B00 ; the location of the buffer.
|
4477 |
|
|
LD (IY+$46),L ; update PR_CC_lo - set to zero - superfluous.
|
4478 |
|
|
XOR A ; clear the accumulator.
|
4479 |
|
|
LD B,A ; set count to 256 bytes.
|
4480 |
|
|
|
4481 |
|
|
;; PRB-BYTES
|
4482 |
|
|
L0EE7: LD (HL),A ; set addressed location to zero.
|
4483 |
|
|
INC HL ; address next byte - Note. not INC L.
|
4484 |
|
|
DJNZ L0EE7 ; back to PRB-BYTES. repeat for 256 bytes.
|
4485 |
|
|
|
4486 |
|
|
RES 1,(IY+$30) ; set FLAGS2 - signal printer buffer is clear.
|
4487 |
|
|
LD C,$21 ; set the column position .
|
4488 |
|
|
JP L0DD9 ; exit via CL-SET and then PO-STORE.
|
4489 |
|
|
|
4490 |
|
|
; -----------------
|
4491 |
|
|
; Copy line routine
|
4492 |
|
|
; -----------------
|
4493 |
|
|
; This routine is called from COPY and COPY-BUFF to output a line of
|
4494 |
|
|
; 32 bytes to the ZX Printer.
|
4495 |
|
|
; Output to port $FB -
|
4496 |
|
|
; bit 7 set - activate stylus.
|
4497 |
|
|
; bit 7 low - deactivate stylus.
|
4498 |
|
|
; bit 2 set - stops printer.
|
4499 |
|
|
; bit 2 reset - starts printer
|
4500 |
|
|
; bit 1 set - slows printer.
|
4501 |
|
|
; bit 1 reset - normal speed.
|
4502 |
|
|
|
4503 |
|
|
;; COPY-LINE
|
4504 |
|
|
L0EF4: LD A,B ; fetch the counter 1-8 or 1-176
|
4505 |
|
|
CP $03 ; is it 01 or 02 ?.
|
4506 |
|
|
SBC A,A ; result is $FF if so else $00.
|
4507 |
|
|
AND $02 ; result is 02 now else 00.
|
4508 |
|
|
; bit 1 set slows the printer.
|
4509 |
|
|
OUT ($FB),A ; slow the printer for the
|
4510 |
|
|
; last two lines.
|
4511 |
|
|
LD D,A ; save the mask to control the printer later.
|
4512 |
|
|
|
4513 |
|
|
;; COPY-L-1
|
4514 |
|
|
L0EFD: CALL L1F54 ; call BREAK-KEY to read keyboard immediately.
|
4515 |
|
|
JR C,L0F0C ; forward to COPY-L-2 if 'break' not pressed.
|
4516 |
|
|
|
4517 |
|
|
LD A,$04 ; else stop the
|
4518 |
|
|
OUT ($FB),A ; printer motor.
|
4519 |
|
|
EI ; enable interrupts.
|
4520 |
|
|
CALL L0EDF ; call routine CLEAR-PRB.
|
4521 |
|
|
; Note. should not be cleared if COPY in use.
|
4522 |
|
|
|
4523 |
|
|
;; REPORT-Dc
|
4524 |
|
|
L0F0A: RST 08H ; ERROR-1
|
4525 |
|
|
DEFB $0C ; Error Report: BREAK - CONT repeats
|
4526 |
|
|
|
4527 |
|
|
;; COPY-L-2
|
4528 |
|
|
L0F0C: IN A,($FB) ; test now to see if
|
4529 |
|
|
ADD A,A ; a printer is attached.
|
4530 |
|
|
RET M ; return if not - but continue with parent
|
4531 |
|
|
; command.
|
4532 |
|
|
|
4533 |
|
|
JR NC,L0EFD ; back to COPY-L-1 if stylus of printer not
|
4534 |
|
|
; in position.
|
4535 |
|
|
|
4536 |
|
|
LD C,$20 ; set count to 32 bytes.
|
4537 |
|
|
|
4538 |
|
|
;; COPY-L-3
|
4539 |
|
|
L0F14: LD E,(HL) ; fetch a byte from line.
|
4540 |
|
|
INC HL ; address next location. Note. not INC L.
|
4541 |
|
|
LD B,$08 ; count the bits.
|
4542 |
|
|
|
4543 |
|
|
;; COPY-L-4
|
4544 |
|
|
L0F18: RL D ; prepare mask to receive bit.
|
4545 |
|
|
RL E ; rotate leftmost print bit to carry
|
4546 |
|
|
RR D ; and back to bit 7 of D restoring bit 1
|
4547 |
|
|
|
4548 |
|
|
;; COPY-L-5
|
4549 |
|
|
L0F1E: IN A,($FB) ; read the port.
|
4550 |
|
|
RRA ; bit 0 to carry.
|
4551 |
|
|
JR NC,L0F1E ; back to COPY-L-5 if stylus not in position.
|
4552 |
|
|
|
4553 |
|
|
LD A,D ; transfer command bits to A.
|
4554 |
|
|
OUT ($FB),A ; and output to port.
|
4555 |
|
|
DJNZ L0F18 ; loop back to COPY-L-4 for all 8 bits.
|
4556 |
|
|
|
4557 |
|
|
DEC C ; decrease the byte count.
|
4558 |
|
|
JR NZ,L0F14 ; back to COPY-L-3 until 256 bits done.
|
4559 |
|
|
|
4560 |
|
|
RET ; return to calling routine COPY/COPY-BUFF.
|
4561 |
|
|
|
4562 |
|
|
|
4563 |
|
|
; ----------------------------------
|
4564 |
|
|
; Editor routine for BASIC and INPUT
|
4565 |
|
|
; ----------------------------------
|
4566 |
|
|
; The editor is called to prepare or edit a BASIC line.
|
4567 |
|
|
; It is also called from INPUT to input a numeric or string expression.
|
4568 |
|
|
; The behaviour and options are quite different in the various modes
|
4569 |
|
|
; and distinguished by bit 5 of FLAGX.
|
4570 |
|
|
;
|
4571 |
|
|
; This is a compact and highly versatile routine.
|
4572 |
|
|
|
4573 |
|
|
;; EDITOR
|
4574 |
|
|
L0F2C: LD HL,($5C3D) ; fetch ERR_SP
|
4575 |
|
|
PUSH HL ; save on stack
|
4576 |
|
|
|
4577 |
|
|
;; ED-AGAIN
|
4578 |
|
|
L0F30: LD HL,L107F ; address: ED-ERROR
|
4579 |
|
|
PUSH HL ; save address on stack and
|
4580 |
|
|
LD ($5C3D),SP ; make ERR_SP point to it.
|
4581 |
|
|
|
4582 |
|
|
; Note. While in editing/input mode should an error occur then RST 08 will
|
4583 |
|
|
; update X_PTR to the location reached by CH_ADD and jump to ED-ERROR
|
4584 |
|
|
; where the error will be cancelled and the loop begin again from ED-AGAIN
|
4585 |
|
|
; above. The position of the error will be apparent when the lower screen is
|
4586 |
|
|
; reprinted. If no error then the re-iteration is to ED-LOOP below when
|
4587 |
|
|
; input is arriving from the keyboard.
|
4588 |
|
|
|
4589 |
|
|
;; ED-LOOP
|
4590 |
|
|
L0F38: CALL L15D4 ; routine WAIT-KEY gets key possibly
|
4591 |
|
|
; changing the mode.
|
4592 |
|
|
PUSH AF ; save key.
|
4593 |
|
|
LD D,$00 ; and give a short click based
|
4594 |
|
|
LD E,(IY-$01) ; on PIP value for duration.
|
4595 |
|
|
LD HL,$00C8 ; and pitch.
|
4596 |
|
|
CALL L03B5 ; routine BEEPER gives click - effective
|
4597 |
|
|
; with rubber keyboard.
|
4598 |
|
|
POP AF ; get saved key value.
|
4599 |
|
|
LD HL,L0F38 ; address: ED-LOOP is loaded to HL.
|
4600 |
|
|
PUSH HL ; and pushed onto stack.
|
4601 |
|
|
|
4602 |
|
|
; At this point there is a looping return address on the stack, an error
|
4603 |
|
|
; handler and an input stream set up to supply characters.
|
4604 |
|
|
; The character that has been received can now be processed.
|
4605 |
|
|
|
4606 |
|
|
CP $18 ; range 24 to 255 ?
|
4607 |
|
|
JR NC,L0F81 ; forward to ADD-CHAR if so.
|
4608 |
|
|
|
4609 |
|
|
CP $07 ; lower than 7 ?
|
4610 |
|
|
JR C,L0F81 ; forward to ADD-CHAR also.
|
4611 |
|
|
; Note. This is a 'bug' and chr$ 6, the comma
|
4612 |
|
|
; control character, should have had an
|
4613 |
|
|
; entry in the ED-KEYS table.
|
4614 |
|
|
; Steven Vickers, 1984, Pitman.
|
4615 |
|
|
|
4616 |
|
|
CP $10 ; less than 16 ?
|
4617 |
|
|
JR C,L0F92 ; forward to ED-KEYS if editing control
|
4618 |
|
|
; range 7 to 15 dealt with by a table
|
4619 |
|
|
|
4620 |
|
|
LD BC,$0002 ; prepare for ink/paper etc.
|
4621 |
|
|
LD D,A ; save character in D
|
4622 |
|
|
CP $16 ; is it ink/paper/bright etc. ?
|
4623 |
|
|
JR C,L0F6C ; forward to ED-CONTR if so
|
4624 |
|
|
|
4625 |
|
|
; leaves 22d AT and 23d TAB
|
4626 |
|
|
; which can't be entered via KEY-INPUT.
|
4627 |
|
|
; so this code is never normally executed
|
4628 |
|
|
; when the keyboard is used for input.
|
4629 |
|
|
|
4630 |
|
|
INC BC ; if it was AT/TAB - 3 locations required
|
4631 |
|
|
BIT 7,(IY+$37) ; test FLAGX - Is this INPUT LINE ?
|
4632 |
|
|
JP Z,L101E ; jump to ED-IGNORE if not, else
|
4633 |
|
|
|
4634 |
|
|
CALL L15D4 ; routine WAIT-KEY - input address is KEY-NEXT
|
4635 |
|
|
; but is reset to KEY-INPUT
|
4636 |
|
|
LD E,A ; save first in E
|
4637 |
|
|
|
4638 |
|
|
;; ED-CONTR
|
4639 |
|
|
L0F6C: CALL L15D4 ; routine WAIT-KEY for control.
|
4640 |
|
|
; input address will be key-next.
|
4641 |
|
|
|
4642 |
|
|
PUSH DE ; saved code/parameters
|
4643 |
|
|
LD HL,($5C5B) ; fetch address of keyboard cursor from K_CUR
|
4644 |
|
|
RES 0,(IY+$07) ; set MODE to 'L'
|
4645 |
|
|
|
4646 |
|
|
CALL L1655 ; routine MAKE-ROOM makes 2/3 spaces at cursor
|
4647 |
|
|
|
4648 |
|
|
POP BC ; restore code/parameters
|
4649 |
|
|
INC HL ; address first location
|
4650 |
|
|
LD (HL),B ; place code (ink etc.)
|
4651 |
|
|
INC HL ; address next
|
4652 |
|
|
LD (HL),C ; place possible parameter. If only one
|
4653 |
|
|
; then DE points to this location also.
|
4654 |
|
|
JR L0F8B ; forward to ADD-CH-1
|
4655 |
|
|
|
4656 |
|
|
; ------------------------
|
4657 |
|
|
; Add code to current line
|
4658 |
|
|
; ------------------------
|
4659 |
|
|
; this is the branch used to add normal non-control characters
|
4660 |
|
|
; with ED-LOOP as the stacked return address.
|
4661 |
|
|
; it is also the OUTPUT service routine for system channel 'R'.
|
4662 |
|
|
|
4663 |
|
|
;; ADD-CHAR
|
4664 |
|
|
L0F81: RES 0,(IY+$07) ; set MODE to 'L'
|
4665 |
|
|
|
4666 |
|
|
X0F85: LD HL,($5C5B) ; fetch address of keyboard cursor from K_CUR
|
4667 |
|
|
|
4668 |
|
|
CALL L1652 ; routine ONE-SPACE creates one space.
|
4669 |
|
|
|
4670 |
|
|
; either a continuation of above or from ED-CONTR with ED-LOOP on stack.
|
4671 |
|
|
|
4672 |
|
|
;; ADD-CH-1
|
4673 |
|
|
L0F8B: LD (DE),A ; load current character to last new location.
|
4674 |
|
|
INC DE ; address next
|
4675 |
|
|
LD ($5C5B),DE ; and update K_CUR system variable.
|
4676 |
|
|
RET ; return - either a simple return
|
4677 |
|
|
; from ADD-CHAR or to ED-LOOP on stack.
|
4678 |
|
|
|
4679 |
|
|
; ---
|
4680 |
|
|
|
4681 |
|
|
; a branch of the editing loop to deal with control characters
|
4682 |
|
|
; using a look-up table.
|
4683 |
|
|
|
4684 |
|
|
;; ED-KEYS
|
4685 |
|
|
L0F92: LD E,A ; character to E.
|
4686 |
|
|
LD D,$00 ; prepare to add.
|
4687 |
|
|
LD HL,L0FA0 - 7 ; base address of editing keys table. $0F99
|
4688 |
|
|
ADD HL,DE ; add E
|
4689 |
|
|
LD E,(HL) ; fetch offset to E
|
4690 |
|
|
ADD HL,DE ; add offset for address of handling routine.
|
4691 |
|
|
PUSH HL ; push the address on machine stack.
|
4692 |
|
|
LD HL,($5C5B) ; load address of cursor from K_CUR.
|
4693 |
|
|
RET ; Make an indirect jump forward to routine.
|
4694 |
|
|
|
4695 |
|
|
; ------------------
|
4696 |
|
|
; Editing keys table
|
4697 |
|
|
; ------------------
|
4698 |
|
|
; For each code in the range $07 to $0F this table contains a
|
4699 |
|
|
; single offset byte to the routine that services that code.
|
4700 |
|
|
; Note. for what was intended there should also have been an
|
4701 |
|
|
; entry for chr$ 6 with offset to ed-symbol.
|
4702 |
|
|
|
4703 |
|
|
;; ed-keys-t
|
4704 |
|
|
L0FA0: DEFB L0FA9 - $ ; 07d offset $09 to Address: ED-EDIT
|
4705 |
|
|
DEFB L1007 - $ ; 08d offset $66 to Address: ED-LEFT
|
4706 |
|
|
DEFB L100C - $ ; 09d offset $6A to Address: ED-RIGHT
|
4707 |
|
|
DEFB L0FF3 - $ ; 10d offset $50 to Address: ED-DOWN
|
4708 |
|
|
DEFB L1059 - $ ; 11d offset $B5 to Address: ED-UP
|
4709 |
|
|
DEFB L1015 - $ ; 12d offset $70 to Address: ED-DELETE
|
4710 |
|
|
DEFB L1024 - $ ; 13d offset $7E to Address: ED-ENTER
|
4711 |
|
|
DEFB L1076 - $ ; 14d offset $CF to Address: ED-SYMBOL
|
4712 |
|
|
DEFB L107C - $ ; 15d offset $D4 to Address: ED-GRAPH
|
4713 |
|
|
|
4714 |
|
|
; ---------------
|
4715 |
|
|
; Handle EDIT key
|
4716 |
|
|
; ---------------
|
4717 |
|
|
; The user has pressed SHIFT 1 to bring edit line down to bottom of screen.
|
4718 |
|
|
; Alternatively the user wishes to clear the input buffer and start again.
|
4719 |
|
|
; Alternatively ...
|
4720 |
|
|
|
4721 |
|
|
;; ED-EDIT
|
4722 |
|
|
L0FA9: LD HL,($5C49) ; fetch E_PPC the last line number entered.
|
4723 |
|
|
; Note. may not exist and may follow program.
|
4724 |
|
|
BIT 5,(IY+$37) ; test FLAGX - input mode ?
|
4725 |
|
|
JP NZ,L1097 ; jump forward to CLEAR-SP if not in editor.
|
4726 |
|
|
|
4727 |
|
|
CALL L196E ; routine LINE-ADDR to find address of line
|
4728 |
|
|
; or following line if it doesn't exist.
|
4729 |
|
|
CALL L1695 ; routine LINE-NO will get line number from
|
4730 |
|
|
; address or previous line if at end-marker.
|
4731 |
|
|
LD A,D ; if there is no program then DE will
|
4732 |
|
|
OR E ; contain zero so test for this.
|
4733 |
|
|
JP Z,L1097 ; jump to CLEAR-SP if so.
|
4734 |
|
|
|
4735 |
|
|
; Note. at this point we have a validated line number, not just an
|
4736 |
|
|
; approximation and it would be best to update E_PPC with the true
|
4737 |
|
|
; cursor line value which would enable the line cursor to be suppressed
|
4738 |
|
|
; in all situations - see shortly.
|
4739 |
|
|
|
4740 |
|
|
PUSH HL ; save address of line.
|
4741 |
|
|
INC HL ; address low byte of length.
|
4742 |
|
|
LD C,(HL) ; transfer to C
|
4743 |
|
|
INC HL ; next to high byte
|
4744 |
|
|
LD B,(HL) ; transfer to B.
|
4745 |
|
|
LD HL,$000A ; an overhead of ten bytes
|
4746 |
|
|
ADD HL,BC ; is added to length.
|
4747 |
|
|
LD B,H ; transfer adjusted value
|
4748 |
|
|
LD C,L ; to BC register.
|
4749 |
|
|
CALL L1F05 ; routine TEST-ROOM checks free memory.
|
4750 |
|
|
CALL L1097 ; routine CLEAR-SP clears editing area.
|
4751 |
|
|
LD HL,($5C51) ; address CURCHL
|
4752 |
|
|
EX (SP),HL ; swap with line address on stack
|
4753 |
|
|
PUSH HL ; save line address underneath
|
4754 |
|
|
|
4755 |
|
|
LD A,$FF ; select system channel 'R'
|
4756 |
|
|
CALL L1601 ; routine CHAN-OPEN opens it
|
4757 |
|
|
|
4758 |
|
|
POP HL ; drop line address
|
4759 |
|
|
DEC HL ; make it point to first byte of line num.
|
4760 |
|
|
DEC (IY+$0F) ; decrease E_PPC_lo to suppress line cursor.
|
4761 |
|
|
; Note. ineffective when E_PPC is one
|
4762 |
|
|
; greater than last line of program perhaps
|
4763 |
|
|
; as a result of a delete.
|
4764 |
|
|
; credit. Paul Harrison 1982.
|
4765 |
|
|
|
4766 |
|
|
CALL L1855 ; routine OUT-LINE outputs the BASIC line
|
4767 |
|
|
; to the editing area.
|
4768 |
|
|
INC (IY+$0F) ; restore E_PPC_lo to the previous value.
|
4769 |
|
|
LD HL,($5C59) ; address E_LINE in editing area.
|
4770 |
|
|
INC HL ; advance
|
4771 |
|
|
INC HL ; past space
|
4772 |
|
|
INC HL ; and digit characters
|
4773 |
|
|
INC HL ; of line number.
|
4774 |
|
|
|
4775 |
|
|
LD ($5C5B),HL ; update K_CUR to address start of BASIC.
|
4776 |
|
|
POP HL ; restore the address of CURCHL.
|
4777 |
|
|
CALL L1615 ; routine CHAN-FLAG sets flags for it.
|
4778 |
|
|
|
4779 |
|
|
RET ; RETURN to ED-LOOP.
|
4780 |
|
|
|
4781 |
|
|
; -------------------
|
4782 |
|
|
; Cursor down editing
|
4783 |
|
|
; -------------------
|
4784 |
|
|
; The BASIC lines are displayed at the top of the screen and the user
|
4785 |
|
|
; wishes to move the cursor down one line in edit mode.
|
4786 |
|
|
; With INPUT LINE, this key must be used instead of entering STOP.
|
4787 |
|
|
|
4788 |
|
|
;; ED-DOWN
|
4789 |
|
|
L0FF3: BIT 5,(IY+$37) ; test FLAGX - Input Mode ?
|
4790 |
|
|
JR NZ,L1001 ; skip to ED-STOP if so
|
4791 |
|
|
|
4792 |
|
|
LD HL,$5C49 ; address E_PPC - 'current line'
|
4793 |
|
|
CALL L190F ; routine LN-FETCH fetches number of next
|
4794 |
|
|
; line or same if at end of program.
|
4795 |
|
|
JR L106E ; forward to ED-LIST to produce an
|
4796 |
|
|
; automatic listing.
|
4797 |
|
|
|
4798 |
|
|
; ---
|
4799 |
|
|
|
4800 |
|
|
;; ED-STOP
|
4801 |
|
|
L1001: LD (IY+$00),$10 ; set ERR_NR to 'STOP in INPUT' code
|
4802 |
|
|
JR L1024 ; forward to ED-ENTER to produce error.
|
4803 |
|
|
|
4804 |
|
|
; -------------------
|
4805 |
|
|
; Cursor left editing
|
4806 |
|
|
; -------------------
|
4807 |
|
|
; This acts on the cursor in the lower section of the screen in both
|
4808 |
|
|
; editing and input mode.
|
4809 |
|
|
|
4810 |
|
|
;; ED-LEFT
|
4811 |
|
|
L1007: CALL L1031 ; routine ED-EDGE moves left if possible
|
4812 |
|
|
JR L1011 ; forward to ED-CUR to update K-CUR
|
4813 |
|
|
; and return to ED-LOOP.
|
4814 |
|
|
|
4815 |
|
|
; --------------------
|
4816 |
|
|
; Cursor right editing
|
4817 |
|
|
; --------------------
|
4818 |
|
|
; This acts on the cursor in the lower screen in both editing and input
|
4819 |
|
|
; mode and moves it to the right.
|
4820 |
|
|
|
4821 |
|
|
;; ED-RIGHT
|
4822 |
|
|
L100C: LD A,(HL) ; fetch addressed character.
|
4823 |
|
|
CP $0D ; is it carriage return ?
|
4824 |
|
|
RET Z ; return if so to ED-LOOP
|
4825 |
|
|
|
4826 |
|
|
INC HL ; address next character
|
4827 |
|
|
|
4828 |
|
|
;; ED-CUR
|
4829 |
|
|
L1011: LD ($5C5B),HL ; update K_CUR system variable
|
4830 |
|
|
RET ; return to ED-LOOP
|
4831 |
|
|
|
4832 |
|
|
; --------------
|
4833 |
|
|
; DELETE editing
|
4834 |
|
|
; --------------
|
4835 |
|
|
; This acts on the lower screen and deletes the character to left of
|
4836 |
|
|
; cursor. If control characters are present these are deleted first
|
4837 |
|
|
; leaving the naked parameter (0-7) which appears as a '?' except in the
|
4838 |
|
|
; case of chr$ 6 which is the comma control character. It is not mandatory
|
4839 |
|
|
; to delete these second characters.
|
4840 |
|
|
|
4841 |
|
|
;; ED-DELETE
|
4842 |
|
|
L1015: CALL L1031 ; routine ED-EDGE moves cursor to left.
|
4843 |
|
|
LD BC,$0001 ; of character to be deleted.
|
4844 |
|
|
JP L19E8 ; to RECLAIM-2 reclaim the character.
|
4845 |
|
|
|
4846 |
|
|
; ------------------------------------------
|
4847 |
|
|
; Ignore next 2 codes from key-input routine
|
4848 |
|
|
; ------------------------------------------
|
4849 |
|
|
; Since AT and TAB cannot be entered this point is never reached
|
4850 |
|
|
; from the keyboard. If inputting from a tape device or network then
|
4851 |
|
|
; the control and two following characters are ignored and processing
|
4852 |
|
|
; continues as if a carriage return had been received.
|
4853 |
|
|
; Here, perhaps, another Spectrum has said print #15; AT 0,0; "This is yellow"
|
4854 |
|
|
; and this one is interpreting input #15; a$.
|
4855 |
|
|
|
4856 |
|
|
;; ED-IGNORE
|
4857 |
|
|
L101E: CALL L15D4 ; routine WAIT-KEY to ignore keystroke.
|
4858 |
|
|
CALL L15D4 ; routine WAIT-KEY to ignore next key.
|
4859 |
|
|
|
4860 |
|
|
; -------------
|
4861 |
|
|
; Enter/newline
|
4862 |
|
|
; -------------
|
4863 |
|
|
; The enter key has been pressed to have BASIC line or input accepted.
|
4864 |
|
|
|
4865 |
|
|
;; ED-ENTER
|
4866 |
|
|
L1024: POP HL ; discard address ED-LOOP
|
4867 |
|
|
POP HL ; drop address ED-ERROR
|
4868 |
|
|
|
4869 |
|
|
;; ED-END
|
4870 |
|
|
L1026: POP HL ; the previous value of ERR_SP
|
4871 |
|
|
LD ($5C3D),HL ; is restored to ERR_SP system variable
|
4872 |
|
|
BIT 7,(IY+$00) ; is ERR_NR $FF (= 'OK') ?
|
4873 |
|
|
RET NZ ; return if so
|
4874 |
|
|
|
4875 |
|
|
LD SP,HL ; else put error routine on stack
|
4876 |
|
|
RET ; and make an indirect jump to it.
|
4877 |
|
|
|
4878 |
|
|
; -----------------------------
|
4879 |
|
|
; Move cursor left when editing
|
4880 |
|
|
; -----------------------------
|
4881 |
|
|
; This routine moves the cursor left. The complication is that it must
|
4882 |
|
|
; not position the cursor between control codes and their parameters.
|
4883 |
|
|
; It is further complicated in that it deals with TAB and AT characters
|
4884 |
|
|
; which are never present from the keyboard.
|
4885 |
|
|
; The method is to advance from the beginning of the line each time,
|
4886 |
|
|
; jumping one, two, or three characters as necessary saving the original
|
4887 |
|
|
; position at each jump in DE. Once it arrives at the cursor then the next
|
4888 |
|
|
; legitimate leftmost position is in DE.
|
4889 |
|
|
|
4890 |
|
|
;; ED-EDGE
|
4891 |
|
|
L1031: SCF ; carry flag must be set to call the nested
|
4892 |
|
|
CALL L1195 ; subroutine SET-DE.
|
4893 |
|
|
; if input then DE=WORKSP
|
4894 |
|
|
; if editing then DE=E_LINE
|
4895 |
|
|
SBC HL,DE ; subtract address from start of line
|
4896 |
|
|
ADD HL,DE ; and add back.
|
4897 |
|
|
INC HL ; adjust for carry.
|
4898 |
|
|
POP BC ; drop return address
|
4899 |
|
|
RET C ; return to ED-LOOP if already at left
|
4900 |
|
|
; of line.
|
4901 |
|
|
|
4902 |
|
|
PUSH BC ; resave return address - ED-LOOP.
|
4903 |
|
|
LD B,H ; transfer HL - cursor address
|
4904 |
|
|
LD C,L ; to BC register pair.
|
4905 |
|
|
; at this point DE addresses start of line.
|
4906 |
|
|
|
4907 |
|
|
;; ED-EDGE-1
|
4908 |
|
|
L103E: LD H,D ; transfer DE - leftmost pointer
|
4909 |
|
|
LD L,E ; to HL
|
4910 |
|
|
INC HL ; address next leftmost character to
|
4911 |
|
|
; advance position each time.
|
4912 |
|
|
LD A,(DE) ; pick up previous in A
|
4913 |
|
|
AND $F0 ; lose the low bits
|
4914 |
|
|
CP $10 ; is it INK to TAB $10-$1F ?
|
4915 |
|
|
; that is, is it followed by a parameter ?
|
4916 |
|
|
JR NZ,L1051 ; to ED-EDGE-2 if not
|
4917 |
|
|
; HL has been incremented once
|
4918 |
|
|
|
4919 |
|
|
INC HL ; address next as at least one parameter.
|
4920 |
|
|
|
4921 |
|
|
; in fact since 'tab' and 'at' cannot be entered the next section seems
|
4922 |
|
|
; superfluous.
|
4923 |
|
|
; The test will always fail and the jump to ED-EDGE-2 will be taken.
|
4924 |
|
|
|
4925 |
|
|
LD A,(DE) ; reload leftmost character
|
4926 |
|
|
SUB $17 ; decimal 23 ('tab')
|
4927 |
|
|
ADC A,$00 ; will be 0 for 'tab' and 'at'.
|
4928 |
|
|
JR NZ,L1051 ; forward to ED-EDGE-2 if not
|
4929 |
|
|
; HL has been incremented twice
|
4930 |
|
|
|
4931 |
|
|
INC HL ; increment a third time for 'at'/'tab'
|
4932 |
|
|
|
4933 |
|
|
;; ED-EDGE-2
|
4934 |
|
|
L1051: AND A ; prepare for true subtraction
|
4935 |
|
|
SBC HL,BC ; subtract cursor address from pointer
|
4936 |
|
|
ADD HL,BC ; and add back
|
4937 |
|
|
; Note when HL matches the cursor position BC,
|
4938 |
|
|
; there is no carry and the previous
|
4939 |
|
|
; position is in DE.
|
4940 |
|
|
EX DE,HL ; transfer result to DE if looping again.
|
4941 |
|
|
; transfer DE to HL to be used as K-CUR
|
4942 |
|
|
; if exiting loop.
|
4943 |
|
|
JR C,L103E ; back to ED-EDGE-1 if cursor not matched.
|
4944 |
|
|
|
4945 |
|
|
RET ; return.
|
4946 |
|
|
|
4947 |
|
|
; -----------------
|
4948 |
|
|
; Cursor up editing
|
4949 |
|
|
; -----------------
|
4950 |
|
|
; The main screen displays part of the BASIC program and the user wishes
|
4951 |
|
|
; to move up one line scrolling if necessary.
|
4952 |
|
|
; This has no alternative use in input mode.
|
4953 |
|
|
|
4954 |
|
|
;; ED-UP
|
4955 |
|
|
L1059: BIT 5,(IY+$37) ; test FLAGX - input mode ?
|
4956 |
|
|
RET NZ ; return if not in editor - to ED-LOOP.
|
4957 |
|
|
|
4958 |
|
|
LD HL,($5C49) ; get current line from E_PPC
|
4959 |
|
|
CALL L196E ; routine LINE-ADDR gets address
|
4960 |
|
|
EX DE,HL ; and previous in DE
|
4961 |
|
|
CALL L1695 ; routine LINE-NO gets prev line number
|
4962 |
|
|
LD HL,$5C4A ; set HL to E_PPC_hi as next routine stores
|
4963 |
|
|
; top first.
|
4964 |
|
|
CALL L191C ; routine LN-STORE loads DE value to HL
|
4965 |
|
|
; high byte first - E_PPC_lo takes E
|
4966 |
|
|
|
4967 |
|
|
; this branch is also taken from ed-down.
|
4968 |
|
|
|
4969 |
|
|
;; ED-LIST
|
4970 |
|
|
L106E: CALL L1795 ; routine AUTO-LIST lists to upper screen
|
4971 |
|
|
; including adjusted current line.
|
4972 |
|
|
LD A,$00 ; select lower screen again
|
4973 |
|
|
JP L1601 ; exit via CHAN-OPEN to ED-LOOP
|
4974 |
|
|
|
4975 |
|
|
; --------------------------------
|
4976 |
|
|
; Use of symbol and graphics codes
|
4977 |
|
|
; --------------------------------
|
4978 |
|
|
; These will not be encountered with the keyboard but would be handled
|
4979 |
|
|
; otherwise as follows.
|
4980 |
|
|
; As noted earlier, Vickers says there should have been an entry in
|
4981 |
|
|
; the KEYS table for chr$ 6 which also pointed here.
|
4982 |
|
|
; If, for simplicity, two Spectrums were both using #15 as a bi-directional
|
4983 |
|
|
; channel connected to each other:-
|
4984 |
|
|
; then when the other Spectrum has said PRINT #15; x, y
|
4985 |
|
|
; input #15; i ; j would treat the comma control as a newline and the
|
4986 |
|
|
; control would skip to input j.
|
4987 |
|
|
; You can get round the missing chr$ 6 handler by sending multiple print
|
4988 |
|
|
; items separated by a newline '.
|
4989 |
|
|
|
4990 |
|
|
; chr$14 would have the same functionality.
|
4991 |
|
|
|
4992 |
|
|
; This is chr$ 14.
|
4993 |
|
|
;; ED-SYMBOL
|
4994 |
|
|
L1076: BIT 7,(IY+$37) ; test FLAGX - is this INPUT LINE ?
|
4995 |
|
|
JR Z,L1024 ; back to ED-ENTER if not to treat as if
|
4996 |
|
|
; enter had been pressed.
|
4997 |
|
|
; else continue and add code to buffer.
|
4998 |
|
|
|
4999 |
|
|
; Next is chr$ 15
|
5000 |
|
|
; Note that ADD-CHAR precedes the table so we can't offset to it directly.
|
5001 |
|
|
|
5002 |
|
|
;; ED-GRAPH
|
5003 |
|
|
L107C: JP L0F81 ; jump back to ADD-CHAR
|
5004 |
|
|
|
5005 |
|
|
; --------------------
|
5006 |
|
|
; Editor error routine
|
5007 |
|
|
; --------------------
|
5008 |
|
|
; If an error occurs while editing, or inputting, then ERR_SP
|
5009 |
|
|
; points to the stack location holding address ED_ERROR.
|
5010 |
|
|
|
5011 |
|
|
;; ED-ERROR
|
5012 |
|
|
L107F: BIT 4,(IY+$30) ; test FLAGS2 - is K channel in use ?
|
5013 |
|
|
JR Z,L1026 ; back to ED-END if not.
|
5014 |
|
|
|
5015 |
|
|
; but as long as we're editing lines or inputting from the keyboard, then
|
5016 |
|
|
; we've run out of memory so give a short rasp.
|
5017 |
|
|
|
5018 |
|
|
LD (IY+$00),$FF ; reset ERR_NR to 'OK'.
|
5019 |
|
|
LD D,$00 ; prepare for beeper.
|
5020 |
|
|
LD E,(IY-$02) ; use RASP value.
|
5021 |
|
|
LD HL,$1A90 ; set the pitch - or tone period.
|
5022 |
|
|
CALL L03B5 ; routine BEEPER emits a warning rasp.
|
5023 |
|
|
JP L0F30 ; to ED-AGAIN to re-stack address of
|
5024 |
|
|
; this routine and make ERR_SP point to it.
|
5025 |
|
|
|
5026 |
|
|
; ---------------------
|
5027 |
|
|
; Clear edit/work space
|
5028 |
|
|
; ---------------------
|
5029 |
|
|
; The editing area or workspace is cleared depending on context.
|
5030 |
|
|
; This is called from ED-EDIT to clear workspace if edit key is
|
5031 |
|
|
; used during input, to clear editing area if no program exists
|
5032 |
|
|
; and to clear editing area prior to copying the edit line to it.
|
5033 |
|
|
; It is also used by the error routine to clear the respective
|
5034 |
|
|
; area depending on FLAGX.
|
5035 |
|
|
|
5036 |
|
|
;; CLEAR-SP
|
5037 |
|
|
L1097: PUSH HL ; preserve HL
|
5038 |
|
|
CALL L1190 ; routine SET-HL
|
5039 |
|
|
; if in edit HL = WORKSP-1, DE = E_LINE
|
5040 |
|
|
; if in input HL = STKBOT, DE = WORKSP
|
5041 |
|
|
DEC HL ; adjust
|
5042 |
|
|
CALL L19E5 ; routine RECLAIM-1 reclaims space
|
5043 |
|
|
LD ($5C5B),HL ; set K_CUR to start of empty area
|
5044 |
|
|
LD (IY+$07),$00 ; set MODE to 'KLC'
|
5045 |
|
|
POP HL ; restore HL.
|
5046 |
|
|
RET ; return.
|
5047 |
|
|
|
5048 |
|
|
; ----------------------------
|
5049 |
|
|
; THE 'KEYBOARD INPUT' ROUTINE
|
5050 |
|
|
; ----------------------------
|
5051 |
|
|
; This is the service routine for the input stream of the keyboard channel 'K'.
|
5052 |
|
|
|
5053 |
|
|
;; KEY-INPUT
|
5054 |
|
|
L10A8: BIT 3,(IY+$02) ; test TV_FLAG - has a key been pressed in
|
5055 |
|
|
; editor ?
|
5056 |
|
|
|
5057 |
|
|
CALL NZ,L111D ; routine ED-COPY, if so, to reprint the lower
|
5058 |
|
|
; screen at every keystroke/mode change.
|
5059 |
|
|
|
5060 |
|
|
AND A ; clear carry flag - required exit condition.
|
5061 |
|
|
|
5062 |
|
|
BIT 5,(IY+$01) ; test FLAGS - has a new key been pressed ?
|
5063 |
|
|
RET Z ; return if not. >>
|
5064 |
|
|
|
5065 |
|
|
LD A,($5C08) ; system variable LASTK will hold last key -
|
5066 |
|
|
; from the interrupt routine.
|
5067 |
|
|
|
5068 |
|
|
RES 5,(IY+$01) ; update FLAGS - reset the new key flag.
|
5069 |
|
|
PUSH AF ; save the input character.
|
5070 |
|
|
|
5071 |
|
|
BIT 5,(IY+$02) ; test TV_FLAG - clear lower screen ?
|
5072 |
|
|
|
5073 |
|
|
CALL NZ,L0D6E ; routine CLS-LOWER if so.
|
5074 |
|
|
|
5075 |
|
|
POP AF ; restore the character code.
|
5076 |
|
|
|
5077 |
|
|
CP $20 ; if space or higher then
|
5078 |
|
|
JR NC,L111B ; forward to KEY-DONE2 and return with carry
|
5079 |
|
|
; set to signal key-found.
|
5080 |
|
|
|
5081 |
|
|
CP $10 ; with 16d INK and higher skip
|
5082 |
|
|
JR NC,L10FA ; forward to KEY-CONTR.
|
5083 |
|
|
|
5084 |
|
|
CP $06 ; for 6 - 15d
|
5085 |
|
|
JR NC,L10DB ; skip forward to KEY-M-CL to handle Modes
|
5086 |
|
|
; and CapsLock.
|
5087 |
|
|
|
5088 |
|
|
; that only leaves 0-5, the flash bright inverse switches.
|
5089 |
|
|
|
5090 |
|
|
LD B,A ; save character in B
|
5091 |
|
|
AND $01 ; isolate the embedded parameter (0/1).
|
5092 |
|
|
LD C,A ; and store in C
|
5093 |
|
|
LD A,B ; re-fetch copy (0-5)
|
5094 |
|
|
RRA ; halve it 0, 1 or 2.
|
5095 |
|
|
ADD A,$12 ; add 18d gives 'flash', 'bright'
|
5096 |
|
|
; and 'inverse'.
|
5097 |
|
|
JR L1105 ; forward to KEY-DATA with the
|
5098 |
|
|
; parameter (0/1) in C.
|
5099 |
|
|
|
5100 |
|
|
; ---
|
5101 |
|
|
|
5102 |
|
|
; Now separate capslock 06 from modes 7-15.
|
5103 |
|
|
|
5104 |
|
|
;; KEY-M-CL
|
5105 |
|
|
L10DB: JR NZ,L10E6 ; forward to KEY-MODE if not 06 (capslock)
|
5106 |
|
|
|
5107 |
|
|
LD HL,$5C6A ; point to FLAGS2
|
5108 |
|
|
LD A,$08 ; value 00001000
|
5109 |
|
|
XOR (HL) ; toggle BIT 3 of FLAGS2 the capslock bit
|
5110 |
|
|
LD (HL),A ; and store result in FLAGS2 again.
|
5111 |
|
|
JR L10F4 ; forward to KEY-FLAG to signal no-key.
|
5112 |
|
|
|
5113 |
|
|
; ---
|
5114 |
|
|
|
5115 |
|
|
;; KEY-MODE
|
5116 |
|
|
L10E6: CP $0E ; compare with chr 14d
|
5117 |
|
|
RET C ; return with carry set "key found" for
|
5118 |
|
|
; codes 7 - 13d leaving 14d and 15d
|
5119 |
|
|
; which are converted to mode codes.
|
5120 |
|
|
|
5121 |
|
|
SUB $0D ; subtract 13d leaving 1 and 2
|
5122 |
|
|
; 1 is 'E' mode, 2 is 'G' mode.
|
5123 |
|
|
LD HL,$5C41 ; address the MODE system variable.
|
5124 |
|
|
CP (HL) ; compare with existing value before
|
5125 |
|
|
LD (HL),A ; inserting the new value.
|
5126 |
|
|
JR NZ,L10F4 ; forward to KEY-FLAG if it has changed.
|
5127 |
|
|
|
5128 |
|
|
LD (HL),$00 ; else make MODE zero - KLC mode
|
5129 |
|
|
; Note. while in Extended/Graphics mode,
|
5130 |
|
|
; the Extended Mode/Graphics key is pressed
|
5131 |
|
|
; again to get out.
|
5132 |
|
|
|
5133 |
|
|
;; KEY-FLAG
|
5134 |
|
|
L10F4: SET 3,(IY+$02) ; update TV_FLAG - show key state has changed
|
5135 |
|
|
CP A ; clear carry and reset zero flags -
|
5136 |
|
|
; no actual key returned.
|
5137 |
|
|
RET ; make the return.
|
5138 |
|
|
|
5139 |
|
|
; ---
|
5140 |
|
|
|
5141 |
|
|
; now deal with colour controls - 16-23 ink, 24-31 paper
|
5142 |
|
|
|
5143 |
|
|
;; KEY-CONTR
|
5144 |
|
|
L10FA: LD B,A ; make a copy of character.
|
5145 |
|
|
AND $07 ; mask to leave bits 0-7
|
5146 |
|
|
LD C,A ; and store in C.
|
5147 |
|
|
LD A,$10 ; initialize to 16d - INK.
|
5148 |
|
|
BIT 3,B ; was it paper ?
|
5149 |
|
|
JR NZ,L1105 ; forward to KEY-DATA with INK 16d and
|
5150 |
|
|
; colour in C.
|
5151 |
|
|
|
5152 |
|
|
INC A ; else change from INK to PAPER (17d) if so.
|
5153 |
|
|
|
5154 |
|
|
;; KEY-DATA
|
5155 |
|
|
L1105: LD (IY-$2D),C ; put the colour (0-7)/state(0/1) in KDATA
|
5156 |
|
|
LD DE,L110D ; address: KEY-NEXT will be next input stream
|
5157 |
|
|
JR L1113 ; forward to KEY-CHAN to change it ...
|
5158 |
|
|
|
5159 |
|
|
; ---
|
5160 |
|
|
|
5161 |
|
|
; ... so that INPUT_AD directs control to here at next call to WAIT-KEY
|
5162 |
|
|
|
5163 |
|
|
;; KEY-NEXT
|
5164 |
|
|
L110D: LD A,($5C0D) ; pick up the parameter stored in KDATA.
|
5165 |
|
|
LD DE,L10A8 ; address: KEY-INPUT will be next input stream
|
5166 |
|
|
; continue to restore default channel and
|
5167 |
|
|
; make a return with the control code.
|
5168 |
|
|
|
5169 |
|
|
;; KEY-CHAN
|
5170 |
|
|
L1113: LD HL,($5C4F) ; address start of CHANNELS area using CHANS
|
5171 |
|
|
; system variable.
|
5172 |
|
|
; Note. One might have expected CURCHL to
|
5173 |
|
|
; have been used.
|
5174 |
|
|
INC HL ; step over the
|
5175 |
|
|
INC HL ; output address
|
5176 |
|
|
LD (HL),E ; and update the input
|
5177 |
|
|
INC HL ; routine address for
|
5178 |
|
|
LD (HL),D ; the next call to WAIT-KEY.
|
5179 |
|
|
|
5180 |
|
|
;; KEY-DONE2
|
5181 |
|
|
L111B: SCF ; set carry flag to show a key has been found
|
5182 |
|
|
RET ; and return.
|
5183 |
|
|
|
5184 |
|
|
; --------------------
|
5185 |
|
|
; Lower screen copying
|
5186 |
|
|
; --------------------
|
5187 |
|
|
; This subroutine is called whenever the line in the editing area or
|
5188 |
|
|
; input workspace is required to be printed to the lower screen.
|
5189 |
|
|
; It is by calling this routine after any change that the cursor, for
|
5190 |
|
|
; instance, appears to move to the left.
|
5191 |
|
|
; Remember the edit line will contain characters and tokens
|
5192 |
|
|
; e.g. "1000 LET a=1" is 8 characters.
|
5193 |
|
|
|
5194 |
|
|
;; ED-COPY
|
5195 |
|
|
L111D: CALL L0D4D ; routine TEMPS sets temporary attributes.
|
5196 |
|
|
RES 3,(IY+$02) ; update TV_FLAG - signal no change in mode
|
5197 |
|
|
RES 5,(IY+$02) ; update TV_FLAG - signal don't clear lower
|
5198 |
|
|
; screen.
|
5199 |
|
|
LD HL,($5C8A) ; fetch SPOSNL
|
5200 |
|
|
PUSH HL ; and save on stack.
|
5201 |
|
|
|
5202 |
|
|
LD HL,($5C3D) ; fetch ERR_SP
|
5203 |
|
|
PUSH HL ; and save also
|
5204 |
|
|
LD HL,L1167 ; address: ED-FULL
|
5205 |
|
|
PUSH HL ; is pushed as the error routine
|
5206 |
|
|
LD ($5C3D),SP ; and ERR_SP made to point to it.
|
5207 |
|
|
|
5208 |
|
|
LD HL,($5C82) ; fetch ECHO_E
|
5209 |
|
|
PUSH HL ; and push also
|
5210 |
|
|
|
5211 |
|
|
SCF ; set carry flag to control SET-DE
|
5212 |
|
|
CALL L1195 ; call routine SET-DE
|
5213 |
|
|
; if in input DE = WORKSP
|
5214 |
|
|
; if in edit DE = E_LINE
|
5215 |
|
|
EX DE,HL ; start address to HL
|
5216 |
|
|
|
5217 |
|
|
CALL L187D ; routine OUT-LINE2 outputs entire line up to
|
5218 |
|
|
; carriage return including initial
|
5219 |
|
|
; characterized line number when present.
|
5220 |
|
|
EX DE,HL ; transfer new address to DE
|
5221 |
|
|
CALL L18E1 ; routine OUT-CURS considers a
|
5222 |
|
|
; terminating cursor.
|
5223 |
|
|
|
5224 |
|
|
LD HL,($5C8A) ; fetch updated SPOSNL
|
5225 |
|
|
EX (SP),HL ; exchange with ECHO_E on stack
|
5226 |
|
|
EX DE,HL ; transfer ECHO_E to DE
|
5227 |
|
|
CALL L0D4D ; routine TEMPS to re-set attributes
|
5228 |
|
|
; if altered.
|
5229 |
|
|
|
5230 |
|
|
; the lower screen was not cleared, at the outset, so if deleting then old
|
5231 |
|
|
; text from a previous print may follow this line and requires blanking.
|
5232 |
|
|
|
5233 |
|
|
;; ED-BLANK
|
5234 |
|
|
L1150: LD A,($5C8B) ; fetch SPOSNL_hi is current line
|
5235 |
|
|
SUB D ; compare with old
|
5236 |
|
|
JR C,L117C ; forward to ED-C-DONE if no blanking
|
5237 |
|
|
|
5238 |
|
|
JR NZ,L115E ; forward to ED-SPACES if line has changed
|
5239 |
|
|
|
5240 |
|
|
LD A,E ; old column to A
|
5241 |
|
|
SUB (IY+$50) ; subtract new in SPOSNL_lo
|
5242 |
|
|
JR NC,L117C ; forward to ED-C-DONE if no backfilling.
|
5243 |
|
|
|
5244 |
|
|
;; ED-SPACES
|
5245 |
|
|
L115E: LD A,$20 ; prepare a space.
|
5246 |
|
|
PUSH DE ; save old line/column.
|
5247 |
|
|
CALL L09F4 ; routine PRINT-OUT prints a space over
|
5248 |
|
|
; any text from previous print.
|
5249 |
|
|
; Note. Since the blanking only occurs when
|
5250 |
|
|
; using $09F4 to print to the lower screen,
|
5251 |
|
|
; there is no need to vector via a RST 10
|
5252 |
|
|
; and we can use this alternate set.
|
5253 |
|
|
POP DE ; restore the old line column.
|
5254 |
|
|
JR L1150 ; back to ED-BLANK until all old text blanked.
|
5255 |
|
|
|
5256 |
|
|
; -------------------------------
|
5257 |
|
|
; THE 'EDITOR-FULL' ERROR ROUTINE
|
5258 |
|
|
; -------------------------------
|
5259 |
|
|
; This is the error routine addressed by ERR_SP. This is not for the out of
|
5260 |
|
|
; memory situation as we're just printing. The pitch and duration are exactly
|
5261 |
|
|
; the same as used by ED-ERROR from which this has been augmented. The
|
5262 |
|
|
; situation is that the lower screen is full and a rasp is given to suggest
|
5263 |
|
|
; that this is perhaps not the best idea you've had that day.
|
5264 |
|
|
|
5265 |
|
|
;; ED-FULL
|
5266 |
|
|
L1167: LD D,$00 ; prepare to moan.
|
5267 |
|
|
LD E,(IY-$02) ; fetch RASP value.
|
5268 |
|
|
LD HL,$1A90 ; set pitch or tone period.
|
5269 |
|
|
|
5270 |
|
|
CALL L03B5 ; routine BEEPER.
|
5271 |
|
|
|
5272 |
|
|
LD (IY+$00),$FF ; clear ERR_NR.
|
5273 |
|
|
LD DE,($5C8A) ; fetch SPOSNL.
|
5274 |
|
|
JR L117E ; forward to ED-C-END
|
5275 |
|
|
|
5276 |
|
|
; -------
|
5277 |
|
|
|
5278 |
|
|
; the exit point from line printing continues here.
|
5279 |
|
|
|
5280 |
|
|
;; ED-C-DONE
|
5281 |
|
|
L117C: POP DE ; fetch new line/column.
|
5282 |
|
|
POP HL ; fetch the error address.
|
5283 |
|
|
|
5284 |
|
|
; the error path rejoins here.
|
5285 |
|
|
|
5286 |
|
|
;; ED-C-END
|
5287 |
|
|
L117E: POP HL ; restore the old value of ERR_SP.
|
5288 |
|
|
LD ($5C3D),HL ; update the system variable ERR_SP
|
5289 |
|
|
|
5290 |
|
|
POP BC ; old value of SPOSN_L
|
5291 |
|
|
PUSH DE ; save new value
|
5292 |
|
|
|
5293 |
|
|
CALL L0DD9 ; routine CL-SET and PO-STORE
|
5294 |
|
|
; update ECHO_E and SPOSN_L from BC
|
5295 |
|
|
|
5296 |
|
|
POP HL ; restore new value
|
5297 |
|
|
LD ($5C82),HL ; and overwrite ECHO_E
|
5298 |
|
|
|
5299 |
|
|
LD (IY+$26),$00 ; make error pointer X_PTR_hi out of bounds
|
5300 |
|
|
|
5301 |
|
|
RET ; return
|
5302 |
|
|
|
5303 |
|
|
; -----------------------------------------------
|
5304 |
|
|
; Point to first and last locations of work space
|
5305 |
|
|
; -----------------------------------------------
|
5306 |
|
|
; These two nested routines ensure that the appropriate pointers are
|
5307 |
|
|
; selected for the editing area or workspace. The routines that call
|
5308 |
|
|
; these routines are designed to work on either area.
|
5309 |
|
|
|
5310 |
|
|
; this routine is called once
|
5311 |
|
|
|
5312 |
|
|
;; SET-HL
|
5313 |
|
|
L1190: LD HL,($5C61) ; fetch WORKSP to HL.
|
5314 |
|
|
DEC HL ; point to last location of editing area.
|
5315 |
|
|
AND A ; clear carry to limit exit points to first
|
5316 |
|
|
; or last.
|
5317 |
|
|
|
5318 |
|
|
; this routine is called with carry set and exits at a conditional return.
|
5319 |
|
|
|
5320 |
|
|
;; SET-DE
|
5321 |
|
|
L1195: LD DE,($5C59) ; fetch E_LINE to DE
|
5322 |
|
|
BIT 5,(IY+$37) ; test FLAGX - Input Mode ?
|
5323 |
|
|
RET Z ; return now if in editing mode
|
5324 |
|
|
|
5325 |
|
|
LD DE,($5C61) ; fetch WORKSP to DE
|
5326 |
|
|
RET C ; return if carry set ( entry = set-de)
|
5327 |
|
|
|
5328 |
|
|
LD HL,($5C63) ; fetch STKBOT to HL as well
|
5329 |
|
|
RET ; and return (entry = set-hl (in input))
|
5330 |
|
|
|
5331 |
|
|
; -----------------------------------
|
5332 |
|
|
; THE 'REMOVE FLOATING POINT' ROUTINE
|
5333 |
|
|
; -----------------------------------
|
5334 |
|
|
; When a BASIC LINE or the INPUT BUFFER is parsed any numbers will have
|
5335 |
|
|
; an invisible chr 14d inserted after them and the 5-byte integer or
|
5336 |
|
|
; floating point form inserted after that. Similar invisible value holders
|
5337 |
|
|
; are also created after the numeric and string variables in a DEF FN list.
|
5338 |
|
|
; This routine removes these 'compiled' numbers from the edit line or
|
5339 |
|
|
; input workspace.
|
5340 |
|
|
|
5341 |
|
|
;; REMOVE-FP
|
5342 |
|
|
L11A7: LD A,(HL) ; fetch character
|
5343 |
|
|
CP $0E ; is it the CHR$ 14 number marker ?
|
5344 |
|
|
LD BC,$0006 ; prepare to strip six bytes
|
5345 |
|
|
|
5346 |
|
|
CALL Z,L19E8 ; routine RECLAIM-2 reclaims bytes if CHR$ 14.
|
5347 |
|
|
|
5348 |
|
|
LD A,(HL) ; reload next (or same) character
|
5349 |
|
|
INC HL ; and advance address
|
5350 |
|
|
CP $0D ; end of line or input buffer ?
|
5351 |
|
|
JR NZ,L11A7 ; back to REMOVE-FP until entire line done.
|
5352 |
|
|
|
5353 |
|
|
RET ; return.
|
5354 |
|
|
|
5355 |
|
|
|
5356 |
|
|
; *********************************
|
5357 |
|
|
; ** Part 6. EXECUTIVE ROUTINES **
|
5358 |
|
|
; *********************************
|
5359 |
|
|
|
5360 |
|
|
|
5361 |
|
|
; The memory.
|
5362 |
|
|
;
|
5363 |
|
|
; +---------+-----------+------------+--------------+-------------+--
|
5364 |
|
|
; | BASIC | Display | Attributes | ZX Printer | System |
|
5365 |
|
|
; | ROM | File | File | Buffer | Variables |
|
5366 |
|
|
; +---------+-----------+------------+--------------+-------------+--
|
5367 |
|
|
; ^ ^ ^ ^ ^ ^
|
5368 |
|
|
; $0000 $4000 $5800 $5B00 $5C00 $5CB6 = CHANS
|
5369 |
|
|
;
|
5370 |
|
|
;
|
5371 |
|
|
; --+----------+---+---------+-----------+---+------------+--+---+--
|
5372 |
|
|
; | Channel |$80| BASIC | Variables |$80| Edit Line |NL|$80|
|
5373 |
|
|
; | Info | | Program | Area | | or Command | | |
|
5374 |
|
|
; --+----------+---+---------+-----------+---+------------+--+---+--
|
5375 |
|
|
; ^ ^ ^ ^ ^
|
5376 |
|
|
; CHANS PROG VARS E_LINE WORKSP
|
5377 |
|
|
;
|
5378 |
|
|
;
|
5379 |
|
|
; ---5--> <---2--- <--3---
|
5380 |
|
|
; --+-------+--+------------+-------+-------+---------+-------+-+---+------+
|
5381 |
|
|
; | INPUT |NL| Temporary | Calc. | Spare | Machine | GOSUB |?|$3E| UDGs |
|
5382 |
|
|
; | data | | Work Space | Stack | | Stack | Stack | | | |
|
5383 |
|
|
; --+-------+--+------------+-------+-------+---------+-------+-+---+------+
|
5384 |
|
|
; ^ ^ ^ ^ ^ ^ ^
|
5385 |
|
|
; WORKSP STKBOT STKEND sp RAMTOP UDG P_RAMT
|
5386 |
|
|
;
|
5387 |
|
|
|
5388 |
|
|
; -----------------
|
5389 |
|
|
; THE 'NEW' COMMAND
|
5390 |
|
|
; -----------------
|
5391 |
|
|
; The NEW command is about to set all RAM below RAMTOP to zero and then
|
5392 |
|
|
; re-initialize the system. All RAM above RAMTOP should, and will be,
|
5393 |
|
|
; preserved.
|
5394 |
|
|
; There is nowhere to store values in RAM or on the stack which becomes
|
5395 |
|
|
; inoperable. Similarly PUSH and CALL instructions cannot be used to store
|
5396 |
|
|
; values or section common code. The alternate register set is the only place
|
5397 |
|
|
; available to store 3 persistent 16-bit system variables.
|
5398 |
|
|
|
5399 |
|
|
;; NEW
|
5400 |
|
|
L11B7: DI ; Disable Interrupts - machine stack will be
|
5401 |
|
|
; cleared.
|
5402 |
|
|
LD A,$FF ; Flag coming from NEW.
|
5403 |
|
|
LD DE,($5CB2) ; Fetch RAMTOP as top value.
|
5404 |
|
|
EXX ; Switch in alternate set.
|
5405 |
|
|
LD BC,($5CB4) ; Fetch P-RAMT differs on 16K/48K machines.
|
5406 |
|
|
LD DE,($5C38) ; Fetch RASP/PIP.
|
5407 |
|
|
LD HL,($5C7B) ; Fetch UDG differs on 16K/48K machines.
|
5408 |
|
|
EXX ; Switch back to main set and continue into...
|
5409 |
|
|
|
5410 |
|
|
; ----------------------
|
5411 |
|
|
; THE 'START-NEW' BRANCH
|
5412 |
|
|
; ----------------------
|
5413 |
|
|
; This branch is taken from above and from RST 00h.
|
5414 |
|
|
; The common code tests RAM and sets it to zero re-initializing all the
|
5415 |
|
|
; non-zero system variables and channel information. The A register flags
|
5416 |
|
|
; if coming from START or NEW.
|
5417 |
|
|
|
5418 |
|
|
;; START-NEW
|
5419 |
|
|
L11CB: LD B,A ; Save the flag to control later branching.
|
5420 |
|
|
|
5421 |
|
|
LD A,$07 ; Select a white border
|
5422 |
|
|
OUT ($FE),A ; and set it now by writing to a port.
|
5423 |
|
|
|
5424 |
|
|
LD A,$3F ; Load the accumulator with last page in ROM.
|
5425 |
|
|
LD I,A ; Set the I register - this remains constant
|
5426 |
|
|
; and can't be in the range $40 - $7F as 'snow'
|
5427 |
|
|
; appears on the screen.
|
5428 |
|
|
|
5429 |
|
|
LD HL, NMI_VECT ; Initialize the NMI jump vector
|
5430 |
|
|
LD ($5CB0), HL
|
5431 |
|
|
;NOP ; These seem unnecessary.
|
5432 |
|
|
;NOP ; Note: They are a placeholder for the two
|
5433 |
|
|
;NOP ; instructions above that initialize NMI junp.
|
5434 |
|
|
;NOP ; This way the rest of the code is not moved.
|
5435 |
|
|
;NOP ;
|
5436 |
|
|
;NOP ;
|
5437 |
|
|
|
5438 |
|
|
; -----------------------
|
5439 |
|
|
; THE 'RAM CHECK' SECTION
|
5440 |
|
|
; -----------------------
|
5441 |
|
|
; Typically, a Spectrum will have 16K or 48K of RAM and this code will test
|
5442 |
|
|
; it all till it finds an unpopulated location or, less likely, a faulty
|
5443 |
|
|
; location. Usually it stops when it reaches the top $FFFF, or in the case
|
5444 |
|
|
; of NEW the supplied top value. The entire screen turns black with
|
5445 |
|
|
; sometimes red stripes on black paper just visible.
|
5446 |
|
|
|
5447 |
|
|
;; ram-check
|
5448 |
|
|
L11DA: LD H,D ; Transfer the top value to the HL register
|
5449 |
|
|
LD L,E ; pair.
|
5450 |
|
|
|
5451 |
|
|
;; RAM-FILL
|
5452 |
|
|
L11DC: LD (HL),$02 ; Load memory with $02 - red ink on black paper.
|
5453 |
|
|
DEC HL ; Decrement memory address.
|
5454 |
|
|
CP H ; Have we reached ROM - $3F ?
|
5455 |
|
|
JR NZ,L11DC ; Back to RAM-FILL if not.
|
5456 |
|
|
|
5457 |
|
|
;; RAM-READ
|
5458 |
|
|
L11E2: AND A ; Clear carry - prepare to subtract.
|
5459 |
|
|
SBC HL,DE ; subtract and add back setting
|
5460 |
|
|
ADD HL,DE ; carry when back at start.
|
5461 |
|
|
INC HL ; and increment for next iteration.
|
5462 |
|
|
JR NC,L11EF ; forward to RAM-DONE if we've got back to
|
5463 |
|
|
; starting point with no errors.
|
5464 |
|
|
|
5465 |
|
|
DEC (HL) ; decrement to 1.
|
5466 |
|
|
JR Z,L11EF ; forward to RAM-DONE if faulty.
|
5467 |
|
|
|
5468 |
|
|
DEC (HL) ; decrement to zero.
|
5469 |
|
|
JR Z,L11E2 ; back to RAM-READ if zero flag was set.
|
5470 |
|
|
|
5471 |
|
|
;; RAM-DONE
|
5472 |
|
|
L11EF: DEC HL ; step back to last valid location.
|
5473 |
|
|
EXX ; regardless of state, set up possibly
|
5474 |
|
|
; stored system variables in case from NEW.
|
5475 |
|
|
LD ($5CB4),BC ; insert P-RAMT.
|
5476 |
|
|
LD ($5C38),DE ; insert RASP/PIP.
|
5477 |
|
|
LD ($5C7B),HL ; insert UDG.
|
5478 |
|
|
EXX ; switch in main set.
|
5479 |
|
|
INC B ; now test if we arrived here from NEW.
|
5480 |
|
|
JR Z,L1219 ; forward to RAM-SET if we did.
|
5481 |
|
|
|
5482 |
|
|
; This section applies to START only.
|
5483 |
|
|
|
5484 |
|
|
LD ($5CB4),HL ; set P-RAMT to the highest working RAM
|
5485 |
|
|
; address.
|
5486 |
|
|
LD DE,$3EAF ; address of last byte of 'U' bitmap in ROM.
|
5487 |
|
|
LD BC,$00A8 ; there are 21 user defined graphics.
|
5488 |
|
|
EX DE,HL ; switch pointers and make the UDGs a
|
5489 |
|
|
LDDR ; copy of the standard characters A - U.
|
5490 |
|
|
EX DE,HL ; switch the pointer to HL.
|
5491 |
|
|
INC HL ; update to start of 'A' in RAM.
|
5492 |
|
|
LD ($5C7B),HL ; make UDG system variable address the first
|
5493 |
|
|
; bitmap.
|
5494 |
|
|
DEC HL ; point at RAMTOP again.
|
5495 |
|
|
|
5496 |
|
|
LD BC,$0040 ; set the values of
|
5497 |
|
|
LD ($5C38),BC ; the PIP and RASP system variables.
|
5498 |
|
|
|
5499 |
|
|
; The NEW command path rejoins here.
|
5500 |
|
|
|
5501 |
|
|
;; RAM-SET
|
5502 |
|
|
L1219: LD ($5CB2),HL ; set system variable RAMTOP to HL.
|
5503 |
|
|
|
5504 |
|
|
;
|
5505 |
|
|
; Note. this entry point is a disabled Warm Restart that was almost certainly
|
5506 |
|
|
; once pointed to by the System Variable NMIADD. It would be essential that
|
5507 |
|
|
; any NMI Handler would perform the tasks from here to the EI instruction
|
5508 |
|
|
; below.
|
5509 |
|
|
|
5510 |
|
|
NMI_VECT:
|
5511 |
|
|
L121C:
|
5512 |
|
|
LD HL,$3C00 ; a strange place to set the pointer to the
|
5513 |
|
|
LD ($5C36),HL ; character set, CHARS - as no printing yet.
|
5514 |
|
|
|
5515 |
|
|
LD HL,($5CB2) ; fetch RAMTOP to HL again as we've lost it.
|
5516 |
|
|
|
5517 |
|
|
LD (HL),$3E ; top of user ram holds GOSUB end marker
|
5518 |
|
|
; an impossible line number - see RETURN.
|
5519 |
|
|
; no significance in the number $3E. It has
|
5520 |
|
|
; been traditional since the ZX80.
|
5521 |
|
|
|
5522 |
|
|
DEC HL ; followed by empty byte (not important).
|
5523 |
|
|
LD SP,HL ; set up the machine stack pointer.
|
5524 |
|
|
DEC HL ;
|
5525 |
|
|
DEC HL ;
|
5526 |
|
|
LD ($5C3D),HL ; ERR_SP is where the error pointer is
|
5527 |
|
|
; at moment empty - will take address MAIN-4
|
5528 |
|
|
; at the call preceding that address,
|
5529 |
|
|
; although interrupts and calls will make use
|
5530 |
|
|
; of this location in meantime.
|
5531 |
|
|
|
5532 |
|
|
IM 1 ; select interrupt mode 1.
|
5533 |
|
|
|
5534 |
|
|
LD IY,$5C3A ; set IY to ERR_NR. IY can reach all standard
|
5535 |
|
|
; system variables but shadow ROM system
|
5536 |
|
|
; variables will be mostly out of range.
|
5537 |
|
|
|
5538 |
|
|
EI ; enable interrupts now that we have a stack.
|
5539 |
|
|
|
5540 |
|
|
; If, as suggested above, the NMI service routine pointed to this section of
|
5541 |
|
|
; code then a decision would have to be made at this point to jump forward,
|
5542 |
|
|
; in a Warm Restart scenario, to produce a report code, leaving any program
|
5543 |
|
|
; intact.
|
5544 |
|
|
|
5545 |
|
|
LD HL,$5CB6 ; The address of the channels - initially
|
5546 |
|
|
; following system variables.
|
5547 |
|
|
LD ($5C4F),HL ; Set the CHANS system variable.
|
5548 |
|
|
|
5549 |
|
|
LD DE,L15AF ; Address: init-chan in ROM.
|
5550 |
|
|
LD BC,$0015 ; There are 21 bytes of initial data in ROM.
|
5551 |
|
|
EX DE,HL ; swap the pointers.
|
5552 |
|
|
LDIR ; Copy the bytes to RAM.
|
5553 |
|
|
|
5554 |
|
|
EX DE,HL ; Swap pointers. HL points to program area.
|
5555 |
|
|
DEC HL ; Decrement address.
|
5556 |
|
|
LD ($5C57),HL ; Set DATADD to location before program area.
|
5557 |
|
|
INC HL ; Increment again.
|
5558 |
|
|
|
5559 |
|
|
LD ($5C53),HL ; Set PROG the location where BASIC starts.
|
5560 |
|
|
LD ($5C4B),HL ; Set VARS to same location with a
|
5561 |
|
|
LD (HL),$80 ; variables end-marker.
|
5562 |
|
|
INC HL ; Advance address.
|
5563 |
|
|
LD ($5C59),HL ; Set E_LINE, where the edit line
|
5564 |
|
|
; will be created.
|
5565 |
|
|
; Note. it is not strictly necessary to
|
5566 |
|
|
; execute the next fifteen bytes of code
|
5567 |
|
|
; as this will be done by the call to SET-MIN.
|
5568 |
|
|
; --
|
5569 |
|
|
LD (HL),$0D ; initially just has a carriage return
|
5570 |
|
|
INC HL ; followed by
|
5571 |
|
|
LD (HL),$80 ; an end-marker.
|
5572 |
|
|
INC HL ; address the next location.
|
5573 |
|
|
LD ($5C61),HL ; set WORKSP - empty workspace.
|
5574 |
|
|
LD ($5C63),HL ; set STKBOT - bottom of the empty stack.
|
5575 |
|
|
LD ($5C65),HL ; set STKEND to the end of the empty stack.
|
5576 |
|
|
; --
|
5577 |
|
|
LD A,$38 ; the colour system is set to white paper,
|
5578 |
|
|
; black ink, no flash or bright.
|
5579 |
|
|
LD ($5C8D),A ; set ATTR_P permanent colour attributes.
|
5580 |
|
|
LD ($5C8F),A ; set ATTR_T temporary colour attributes.
|
5581 |
|
|
LD ($5C48),A ; set BORDCR the border colour/lower screen
|
5582 |
|
|
; attributes.
|
5583 |
|
|
|
5584 |
|
|
LD HL,$0523 ; The keyboard repeat and delay values are
|
5585 |
|
|
LD ($5C09),HL ; loaded to REPDEL and REPPER.
|
5586 |
|
|
|
5587 |
|
|
DEC (IY-$3A) ; set KSTATE-0 to $FF - keyboard map available.
|
5588 |
|
|
DEC (IY-$36) ; set KSTATE-4 to $FF - keyboard map available.
|
5589 |
|
|
|
5590 |
|
|
LD HL,L15C6 ; set source to ROM Address: init-strm
|
5591 |
|
|
LD DE,$5C10 ; set destination to system variable STRMS-FD
|
5592 |
|
|
LD BC,$000E ; copy the 14 bytes of initial 7 streams data
|
5593 |
|
|
LDIR ; from ROM to RAM.
|
5594 |
|
|
|
5595 |
|
|
SET 1,(IY+$01) ; update FLAGS - signal printer in use.
|
5596 |
|
|
CALL L0EDF ; call routine CLEAR-PRB to initialize system
|
5597 |
|
|
; variables associated with printer.
|
5598 |
|
|
; The buffer is clear.
|
5599 |
|
|
|
5600 |
|
|
LD (IY+$31),$02 ; set DF_SZ the lower screen display size to
|
5601 |
|
|
; two lines
|
5602 |
|
|
CALL L0D6B ; call routine CLS to set up system
|
5603 |
|
|
; variables associated with screen and clear
|
5604 |
|
|
; the screen and set attributes.
|
5605 |
|
|
XOR A ; clear accumulator so that we can address
|
5606 |
|
|
LD DE,L1539 - 1 ; the message table directly.
|
5607 |
|
|
CALL L0C0A ; routine PO-MSG puts
|
5608 |
|
|
; ' © 1982 Sinclair Research Ltd'
|
5609 |
|
|
; at bottom of display.
|
5610 |
|
|
SET 5,(IY+$02) ; update TV_FLAG - signal lower screen will
|
5611 |
|
|
; require clearing.
|
5612 |
|
|
|
5613 |
|
|
JR L12A9 ; forward to MAIN-1
|
5614 |
|
|
|
5615 |
|
|
; -------------------------
|
5616 |
|
|
; THE 'MAIN EXECUTION LOOP'
|
5617 |
|
|
; -------------------------
|
5618 |
|
|
;
|
5619 |
|
|
;
|
5620 |
|
|
|
5621 |
|
|
;; MAIN-EXEC
|
5622 |
|
|
L12A2: LD (IY+$31),$02 ; set DF_SZ lower screen display file size to
|
5623 |
|
|
; two lines.
|
5624 |
|
|
CALL L1795 ; routine AUTO-LIST
|
5625 |
|
|
|
5626 |
|
|
;; MAIN-1
|
5627 |
|
|
L12A9: CALL L16B0 ; routine SET-MIN clears work areas.
|
5628 |
|
|
|
5629 |
|
|
;; MAIN-2
|
5630 |
|
|
L12AC: LD A,$00 ; select channel 'K' the keyboard
|
5631 |
|
|
|
5632 |
|
|
CALL L1601 ; routine CHAN-OPEN opens it
|
5633 |
|
|
|
5634 |
|
|
CALL L0F2C ; routine EDITOR is called.
|
5635 |
|
|
; Note the above routine is where the Spectrum
|
5636 |
|
|
; waits for user-interaction. Perhaps the
|
5637 |
|
|
; most common input at this stage
|
5638 |
|
|
; is LOAD "".
|
5639 |
|
|
|
5640 |
|
|
CALL L1B17 ; routine LINE-SCAN scans the input.
|
5641 |
|
|
|
5642 |
|
|
BIT 7,(IY+$00) ; test ERR_NR - will be $FF if syntax is OK.
|
5643 |
|
|
JR NZ,L12CF ; forward, if correct, to MAIN-3.
|
5644 |
|
|
|
5645 |
|
|
;
|
5646 |
|
|
|
5647 |
|
|
BIT 4,(IY+$30) ; test FLAGS2 - K channel in use ?
|
5648 |
|
|
JR Z,L1303 ; forward to MAIN-4 if not.
|
5649 |
|
|
|
5650 |
|
|
;
|
5651 |
|
|
|
5652 |
|
|
LD HL,($5C59) ; an editing error so address E_LINE.
|
5653 |
|
|
CALL L11A7 ; routine REMOVE-FP removes the hidden
|
5654 |
|
|
; floating-point forms.
|
5655 |
|
|
LD (IY+$00),$FF ; system variable ERR_NR is reset to 'OK'.
|
5656 |
|
|
JR L12AC ; back to MAIN-2 to allow user to correct.
|
5657 |
|
|
|
5658 |
|
|
; ---
|
5659 |
|
|
|
5660 |
|
|
; the branch was here if syntax has passed test.
|
5661 |
|
|
|
5662 |
|
|
;; MAIN-3
|
5663 |
|
|
L12CF: LD HL,($5C59) ; fetch the edit line address from E_LINE.
|
5664 |
|
|
|
5665 |
|
|
LD ($5C5D),HL ; system variable CH_ADD is set to first
|
5666 |
|
|
; character of edit line.
|
5667 |
|
|
; Note. the above two instructions are a little
|
5668 |
|
|
; inadequate.
|
5669 |
|
|
; They are repeated with a subtle difference
|
5670 |
|
|
; at the start of the next subroutine and are
|
5671 |
|
|
; therefore not required above.
|
5672 |
|
|
|
5673 |
|
|
CALL L19FB ; routine E-LINE-NO will fetch any line
|
5674 |
|
|
; number to BC if this is a program line.
|
5675 |
|
|
|
5676 |
|
|
LD A,B ; test if the number of
|
5677 |
|
|
OR C ; the line is non-zero.
|
5678 |
|
|
JP NZ,L155D ; jump forward to MAIN-ADD if so to add the
|
5679 |
|
|
; line to the BASIC program.
|
5680 |
|
|
|
5681 |
|
|
; Has the user just pressed the ENTER key ?
|
5682 |
|
|
|
5683 |
|
|
RST 18H ; GET-CHAR gets character addressed by CH_ADD.
|
5684 |
|
|
CP $0D ; is it a carriage return ?
|
5685 |
|
|
JR Z,L12A2 ; back to MAIN-EXEC if so for an automatic
|
5686 |
|
|
; listing.
|
5687 |
|
|
|
5688 |
|
|
; this must be a direct command.
|
5689 |
|
|
|
5690 |
|
|
BIT 0,(IY+$30) ; test FLAGS2 - clear the main screen ?
|
5691 |
|
|
|
5692 |
|
|
CALL NZ,L0DAF ; routine CL-ALL, if so, e.g. after listing.
|
5693 |
|
|
|
5694 |
|
|
CALL L0D6E ; routine CLS-LOWER anyway.
|
5695 |
|
|
|
5696 |
|
|
LD A,$19 ; compute scroll count as 25 minus
|
5697 |
|
|
SUB (IY+$4F) ; value of S_POSN_hi.
|
5698 |
|
|
LD ($5C8C),A ; update SCR_CT system variable.
|
5699 |
|
|
SET 7,(IY+$01) ; update FLAGS - signal running program.
|
5700 |
|
|
LD (IY+$00),$FF ; set ERR_NR to 'OK'.
|
5701 |
|
|
LD (IY+$0A),$01 ; set NSPPC to one for first statement.
|
5702 |
|
|
CALL L1B8A ; call routine LINE-RUN to run the line.
|
5703 |
|
|
; sysvar ERR_SP therefore addresses MAIN-4
|
5704 |
|
|
|
5705 |
|
|
; Examples of direct commands are RUN, CLS, LOAD "", PRINT USR 40000,
|
5706 |
|
|
; LPRINT "A"; etc..
|
5707 |
|
|
; If a user written machine-code program disables interrupts then it
|
5708 |
|
|
; must enable them to pass the next step. We also jumped to here if the
|
5709 |
|
|
; keyboard was not being used.
|
5710 |
|
|
|
5711 |
|
|
;; MAIN-4
|
5712 |
|
|
L1303: HALT ; wait for interrupt the only routine that can
|
5713 |
|
|
; set bit 5 of FLAGS.
|
5714 |
|
|
|
5715 |
|
|
RES 5,(IY+$01) ; update bit 5 of FLAGS - signal no new key.
|
5716 |
|
|
|
5717 |
|
|
BIT 1,(IY+$30) ; test FLAGS2 - is printer buffer clear ?
|
5718 |
|
|
CALL NZ,L0ECD ; call routine COPY-BUFF if not.
|
5719 |
|
|
; Note. the programmer has neglected
|
5720 |
|
|
; to set bit 1 of FLAGS first.
|
5721 |
|
|
|
5722 |
|
|
LD A,($5C3A) ; fetch ERR_NR
|
5723 |
|
|
INC A ; increment to give true code.
|
5724 |
|
|
|
5725 |
|
|
; Now deal with a runtime error as opposed to an editing error.
|
5726 |
|
|
; However if the error code is now zero then the OK message will be printed.
|
5727 |
|
|
|
5728 |
|
|
;; MAIN-G
|
5729 |
|
|
L1313: PUSH AF ; save the error number.
|
5730 |
|
|
|
5731 |
|
|
LD HL,$0000 ; prepare to clear some system variables.
|
5732 |
|
|
LD (IY+$37),H ; clear all the bits of FLAGX.
|
5733 |
|
|
LD (IY+$26),H ; blank X_PTR_hi to suppress error marker.
|
5734 |
|
|
LD ($5C0B),HL ; blank DEFADD to signal that no defined
|
5735 |
|
|
; function is currently being evaluated.
|
5736 |
|
|
|
5737 |
|
|
LD HL,$0001 ; explicit - inc hl would do.
|
5738 |
|
|
LD ($5C16),HL ; ensure STRMS-00 is keyboard.
|
5739 |
|
|
|
5740 |
|
|
CALL L16B0 ; routine SET-MIN clears workspace etc.
|
5741 |
|
|
RES 5,(IY+$37) ; update FLAGX - signal in EDIT not INPUT mode.
|
5742 |
|
|
; Note. all the bits were reset earlier.
|
5743 |
|
|
|
5744 |
|
|
CALL L0D6E ; call routine CLS-LOWER.
|
5745 |
|
|
|
5746 |
|
|
SET 5,(IY+$02) ; update TV_FLAG - signal lower screen
|
5747 |
|
|
; requires clearing.
|
5748 |
|
|
|
5749 |
|
|
POP AF ; bring back the true error number
|
5750 |
|
|
LD B,A ; and make a copy in B.
|
5751 |
|
|
CP $0A ; is it a print-ready digit ?
|
5752 |
|
|
JR C,L133C ; forward to MAIN-5 if so.
|
5753 |
|
|
|
5754 |
|
|
ADD A,$07 ; add ASCII offset to letters.
|
5755 |
|
|
|
5756 |
|
|
;; MAIN-5
|
5757 |
|
|
L133C: CALL L15EF ; call routine OUT-CODE to print the code.
|
5758 |
|
|
|
5759 |
|
|
LD A,$20 ; followed by a space.
|
5760 |
|
|
RST 10H ; PRINT-A
|
5761 |
|
|
|
5762 |
|
|
LD A,B ; fetch stored report code.
|
5763 |
|
|
LD DE,L1391 ; address: rpt-mesgs.
|
5764 |
|
|
|
5765 |
|
|
CALL L0C0A ; call routine PO-MSG to print the message.
|
5766 |
|
|
|
5767 |
|
|
X1349: XOR A ; clear accumulator to directly
|
5768 |
|
|
LD DE,L1537 - 1 ; address the comma and space message.
|
5769 |
|
|
|
5770 |
|
|
CALL L0C0A ; routine PO-MSG prints ', ' although it would
|
5771 |
|
|
; be more succinct to use RST $10.
|
5772 |
|
|
|
5773 |
|
|
LD BC,($5C45) ; fetch PPC the current line number.
|
5774 |
|
|
CALL L1A1B ; routine OUT-NUM-1 will print that
|
5775 |
|
|
|
5776 |
|
|
LD A,$3A ; then a ':' character.
|
5777 |
|
|
RST 10H ; PRINT-A
|
5778 |
|
|
|
5779 |
|
|
LD C,(IY+$0D) ; then SUBPPC for statement
|
5780 |
|
|
LD B,$00 ; limited to 127
|
5781 |
|
|
CALL L1A1B ; routine OUT-NUM-1 prints BC.
|
5782 |
|
|
|
5783 |
|
|
CALL L1097 ; routine CLEAR-SP clears editing area which
|
5784 |
|
|
; probably contained 'RUN'.
|
5785 |
|
|
|
5786 |
|
|
LD A,($5C3A) ; fetch ERR_NR again
|
5787 |
|
|
INC A ; test for no error originally $FF.
|
5788 |
|
|
JR Z,L1386 ; forward to MAIN-9 if no error.
|
5789 |
|
|
|
5790 |
|
|
CP $09 ; is code Report 9 STOP ?
|
5791 |
|
|
JR Z,L1373 ; forward to MAIN-6 if so
|
5792 |
|
|
|
5793 |
|
|
CP $15 ; is code Report L Break ?
|
5794 |
|
|
JR NZ,L1376 ; forward to MAIN-7 if not
|
5795 |
|
|
|
5796 |
|
|
; Stop or Break was encountered so consider CONTINUE.
|
5797 |
|
|
|
5798 |
|
|
;; MAIN-6
|
5799 |
|
|
L1373: INC (IY+$0D) ; increment SUBPPC to next statement.
|
5800 |
|
|
|
5801 |
|
|
;; MAIN-7
|
5802 |
|
|
L1376: LD BC,$0003 ; prepare to copy 3 system variables to
|
5803 |
|
|
LD DE,$5C70 ; address OSPPC - statement for CONTINUE.
|
5804 |
|
|
; also updating OLDPPC line number below.
|
5805 |
|
|
|
5806 |
|
|
LD HL,$5C44 ; set source top to NSPPC next statement.
|
5807 |
|
|
BIT 7,(HL) ; did BREAK occur before the jump ?
|
5808 |
|
|
; e.g. between GO TO and next statement.
|
5809 |
|
|
JR Z,L1384 ; skip forward to MAIN-8, if not, as set-up
|
5810 |
|
|
; is correct.
|
5811 |
|
|
|
5812 |
|
|
ADD HL,BC ; set source to SUBPPC number of current
|
5813 |
|
|
; statement/line which will be repeated.
|
5814 |
|
|
|
5815 |
|
|
;; MAIN-8
|
5816 |
|
|
L1384: LDDR ; copy PPC to OLDPPC and SUBPPC to OSPCC
|
5817 |
|
|
; or NSPPC to OLDPPC and NEWPPC to OSPCC
|
5818 |
|
|
|
5819 |
|
|
;; MAIN-9
|
5820 |
|
|
L1386: LD (IY+$0A),$FF ; update NSPPC - signal 'no jump'.
|
5821 |
|
|
RES 3,(IY+$01) ; update FLAGS - signal use 'K' mode for
|
5822 |
|
|
; the first character in the editor and
|
5823 |
|
|
|
5824 |
|
|
JP L12AC ; jump back to MAIN-2.
|
5825 |
|
|
|
5826 |
|
|
|
5827 |
|
|
; ----------------------
|
5828 |
|
|
; Canned report messages
|
5829 |
|
|
; ----------------------
|
5830 |
|
|
; The Error reports with the last byte inverted. The first entry
|
5831 |
|
|
; is a dummy entry. The last, which begins with $7F, the Spectrum
|
5832 |
|
|
; character for copyright symbol, is placed here for convenience
|
5833 |
|
|
; as is the preceding comma and space.
|
5834 |
|
|
; The report line must accommodate a 4-digit line number and a 3-digit
|
5835 |
|
|
; statement number which limits the length of the message text to twenty
|
5836 |
|
|
; characters.
|
5837 |
|
|
; e.g. "B Integer out of range, 1000:127"
|
5838 |
|
|
|
5839 |
|
|
;; rpt-mesgs
|
5840 |
|
|
L1391: DEFB $80
|
5841 |
|
|
DEFB 'O','K'+$80 ; 0
|
5842 |
|
|
DEFM "NEXT without FO"
|
5843 |
|
|
DEFB 'R'+$80 ; 1
|
5844 |
|
|
DEFM "Variable not foun"
|
5845 |
|
|
DEFB 'd'+$80 ; 2
|
5846 |
|
|
DEFM "Subscript wron"
|
5847 |
|
|
DEFB 'g'+$80 ; 3
|
5848 |
|
|
DEFM "Out of memor"
|
5849 |
|
|
DEFB 'y'+$80 ; 4
|
5850 |
|
|
DEFM "Out of scree"
|
5851 |
|
|
DEFB 'n'+$80 ; 5
|
5852 |
|
|
DEFM "Number too bi"
|
5853 |
|
|
DEFB 'g'+$80 ; 6
|
5854 |
|
|
DEFM "RETURN without GOSU"
|
5855 |
|
|
DEFB 'B'+$80 ; 7
|
5856 |
|
|
DEFM "End of fil"
|
5857 |
|
|
DEFB 'e'+$80 ; 8
|
5858 |
|
|
DEFM "STOP statemen"
|
5859 |
|
|
DEFB 't'+$80 ; 9
|
5860 |
|
|
DEFM "Invalid argumen"
|
5861 |
|
|
DEFB 't'+$80 ; A
|
5862 |
|
|
DEFM "Integer out of rang"
|
5863 |
|
|
DEFB 'e'+$80 ; B
|
5864 |
|
|
DEFM "Nonsense in BASI"
|
5865 |
|
|
DEFB 'C'+$80 ; C
|
5866 |
|
|
DEFM "BREAK - CONT repeat"
|
5867 |
|
|
DEFB 's'+$80 ; D
|
5868 |
|
|
DEFM "Out of DAT"
|
5869 |
|
|
DEFB 'A'+$80 ; E
|
5870 |
|
|
DEFM "Invalid file nam"
|
5871 |
|
|
DEFB 'e'+$80 ; F
|
5872 |
|
|
DEFM "No room for lin"
|
5873 |
|
|
DEFB 'e'+$80 ; G
|
5874 |
|
|
DEFM "STOP in INPU"
|
5875 |
|
|
DEFB 'T'+$80 ; H
|
5876 |
|
|
DEFM "FOR without NEX"
|
5877 |
|
|
DEFB 'T'+$80 ; I
|
5878 |
|
|
DEFM "Invalid I/O devic"
|
5879 |
|
|
DEFB 'e'+$80 ; J
|
5880 |
|
|
DEFM "Invalid colou"
|
5881 |
|
|
DEFB 'r'+$80 ; K
|
5882 |
|
|
DEFM "BREAK into progra"
|
5883 |
|
|
DEFB 'm'+$80 ; L
|
5884 |
|
|
DEFM "RAMTOP no goo"
|
5885 |
|
|
DEFB 'd'+$80 ; M
|
5886 |
|
|
DEFM "Statement los"
|
5887 |
|
|
DEFB 't'+$80 ; N
|
5888 |
|
|
DEFM "Invalid strea"
|
5889 |
|
|
DEFB 'm'+$80 ; O
|
5890 |
|
|
DEFM "FN without DE"
|
5891 |
|
|
DEFB 'F'+$80 ; P
|
5892 |
|
|
DEFM "Parameter erro"
|
5893 |
|
|
DEFB 'r'+$80 ; Q
|
5894 |
|
|
DEFM "Tape loading erro"
|
5895 |
|
|
DEFB 'r'+$80 ; R
|
5896 |
|
|
;; comma-sp
|
5897 |
|
|
L1537: DEFB ',',' '+$80 ; used in report line.
|
5898 |
|
|
;; copyright
|
5899 |
|
|
L1539: DEFB $7F ; copyright
|
5900 |
|
|
DEFM " 1982 Sinclair Research Lt"
|
5901 |
|
|
DEFB 'd'+$80
|
5902 |
|
|
|
5903 |
|
|
|
5904 |
|
|
; -------------
|
5905 |
|
|
; REPORT-G
|
5906 |
|
|
; -------------
|
5907 |
|
|
; Note ERR_SP points here during line entry which allows the
|
5908 |
|
|
; normal 'Out of Memory' report to be augmented to the more
|
5909 |
|
|
; precise 'No Room for line' report.
|
5910 |
|
|
|
5911 |
|
|
;; REPORT-G
|
5912 |
|
|
; No Room for line
|
5913 |
|
|
L1555: LD A,$10 ; i.e. 'G' -$30 -$07
|
5914 |
|
|
LD BC,$0000 ; this seems unnecessary.
|
5915 |
|
|
JP L1313 ; jump back to MAIN-G
|
5916 |
|
|
|
5917 |
|
|
; -----------------------------
|
5918 |
|
|
; Handle addition of BASIC line
|
5919 |
|
|
; -----------------------------
|
5920 |
|
|
; Note this is not a subroutine but a branch of the main execution loop.
|
5921 |
|
|
; System variable ERR_SP still points to editing error handler.
|
5922 |
|
|
; A new line is added to the BASIC program at the appropriate place.
|
5923 |
|
|
; An existing line with same number is deleted first.
|
5924 |
|
|
; Entering an existing line number deletes that line.
|
5925 |
|
|
; Entering a non-existent line allows the subsequent line to be edited next.
|
5926 |
|
|
|
5927 |
|
|
;; MAIN-ADD
|
5928 |
|
|
L155D: LD ($5C49),BC ; set E_PPC to extracted line number.
|
5929 |
|
|
LD HL,($5C5D) ; fetch CH_ADD - points to location after the
|
5930 |
|
|
; initial digits (set in E_LINE_NO).
|
5931 |
|
|
EX DE,HL ; save start of BASIC in DE.
|
5932 |
|
|
|
5933 |
|
|
LD HL,L1555 ; Address: REPORT-G
|
5934 |
|
|
PUSH HL ; is pushed on stack and addressed by ERR_SP.
|
5935 |
|
|
; the only error that can occur is
|
5936 |
|
|
; 'Out of memory'.
|
5937 |
|
|
|
5938 |
|
|
LD HL,($5C61) ; fetch WORKSP - end of line.
|
5939 |
|
|
SCF ; prepare for true subtraction.
|
5940 |
|
|
SBC HL,DE ; find length of BASIC and
|
5941 |
|
|
PUSH HL ; save it on stack.
|
5942 |
|
|
LD H,B ; transfer line number
|
5943 |
|
|
LD L,C ; to HL register.
|
5944 |
|
|
CALL L196E ; routine LINE-ADDR will see if
|
5945 |
|
|
; a line with the same number exists.
|
5946 |
|
|
JR NZ,L157D ; forward if no existing line to MAIN-ADD1.
|
5947 |
|
|
|
5948 |
|
|
CALL L19B8 ; routine NEXT-ONE finds the existing line.
|
5949 |
|
|
CALL L19E8 ; routine RECLAIM-2 reclaims it.
|
5950 |
|
|
|
5951 |
|
|
;; MAIN-ADD1
|
5952 |
|
|
L157D: POP BC ; retrieve the length of the new line.
|
5953 |
|
|
LD A,C ; and test if carriage return only
|
5954 |
|
|
DEC A ; i.e. one byte long.
|
5955 |
|
|
OR B ; result would be zero.
|
5956 |
|
|
JR Z,L15AB ; forward to MAIN-ADD2 is so.
|
5957 |
|
|
|
5958 |
|
|
PUSH BC ; save the length again.
|
5959 |
|
|
INC BC ; adjust for inclusion
|
5960 |
|
|
INC BC ; of line number (two bytes)
|
5961 |
|
|
INC BC ; and line length
|
5962 |
|
|
INC BC ; (two bytes).
|
5963 |
|
|
DEC HL ; HL points to location before the destination
|
5964 |
|
|
|
5965 |
|
|
LD DE,($5C53) ; fetch the address of PROG
|
5966 |
|
|
PUSH DE ; and save it on the stack
|
5967 |
|
|
CALL L1655 ; routine MAKE-ROOM creates BC spaces in
|
5968 |
|
|
; program area and updates pointers.
|
5969 |
|
|
POP HL ; restore old program pointer.
|
5970 |
|
|
LD ($5C53),HL ; and put back in PROG as it may have been
|
5971 |
|
|
; altered by the POINTERS routine.
|
5972 |
|
|
|
5973 |
|
|
POP BC ; retrieve BASIC length
|
5974 |
|
|
PUSH BC ; and save again.
|
5975 |
|
|
|
5976 |
|
|
INC DE ; points to end of new area.
|
5977 |
|
|
LD HL,($5C61) ; set HL to WORKSP - location after edit line.
|
5978 |
|
|
DEC HL ; decrement to address end marker.
|
5979 |
|
|
DEC HL ; decrement to address carriage return.
|
5980 |
|
|
LDDR ; copy the BASIC line back to initial command.
|
5981 |
|
|
|
5982 |
|
|
LD HL,($5C49) ; fetch E_PPC - line number.
|
5983 |
|
|
EX DE,HL ; swap it to DE, HL points to last of
|
5984 |
|
|
; four locations.
|
5985 |
|
|
POP BC ; retrieve length of line.
|
5986 |
|
|
LD (HL),B ; high byte last.
|
5987 |
|
|
DEC HL ;
|
5988 |
|
|
LD (HL),C ; then low byte of length.
|
5989 |
|
|
DEC HL ;
|
5990 |
|
|
LD (HL),E ; then low byte of line number.
|
5991 |
|
|
DEC HL ;
|
5992 |
|
|
LD (HL),D ; then high byte range $0 - $27 (1-9999).
|
5993 |
|
|
|
5994 |
|
|
;; MAIN-ADD2
|
5995 |
|
|
L15AB: POP AF ; drop the address of Report G
|
5996 |
|
|
JP L12A2 ; and back to MAIN-EXEC producing a listing
|
5997 |
|
|
; and to reset ERR_SP in EDITOR.
|
5998 |
|
|
|
5999 |
|
|
|
6000 |
|
|
; ---------------------------------
|
6001 |
|
|
; THE 'INITIAL CHANNEL' INFORMATION
|
6002 |
|
|
; ---------------------------------
|
6003 |
|
|
; This initial channel information is copied from ROM to RAM, during
|
6004 |
|
|
; initialization. It's new location is after the system variables and is
|
6005 |
|
|
; addressed by the system variable CHANS which means that it can slide up and
|
6006 |
|
|
; down in memory. The table is never searched, by this ROM, and the last
|
6007 |
|
|
; character, which could be anything other than a comma, provides a
|
6008 |
|
|
; convenient resting place for DATADD.
|
6009 |
|
|
|
6010 |
|
|
;; init-chan
|
6011 |
|
|
L15AF: DEFW L09F4 ; PRINT-OUT
|
6012 |
|
|
DEFW L10A8 ; KEY-INPUT
|
6013 |
|
|
DEFB $4B ; 'K'
|
6014 |
|
|
DEFW L09F4 ; PRINT-OUT
|
6015 |
|
|
DEFW L15C4 ; REPORT-J
|
6016 |
|
|
DEFB $53 ; 'S'
|
6017 |
|
|
DEFW L0F81 ; ADD-CHAR
|
6018 |
|
|
DEFW L15C4 ; REPORT-J
|
6019 |
|
|
DEFB $52 ; 'R'
|
6020 |
|
|
DEFW L09F4 ; PRINT-OUT
|
6021 |
|
|
DEFW L15C4 ; REPORT-J
|
6022 |
|
|
DEFB $50 ; 'P'
|
6023 |
|
|
|
6024 |
|
|
DEFB $80 ; End Marker
|
6025 |
|
|
|
6026 |
|
|
;; REPORT-J
|
6027 |
|
|
L15C4: RST 08H ; ERROR-1
|
6028 |
|
|
DEFB $12 ; Error Report: Invalid I/O device
|
6029 |
|
|
|
6030 |
|
|
|
6031 |
|
|
; -------------------------
|
6032 |
|
|
; THE 'INITIAL STREAM' DATA
|
6033 |
|
|
; -------------------------
|
6034 |
|
|
; This is the initial stream data for the seven streams $FD - $03 that is
|
6035 |
|
|
; copied from ROM to the STRMS system variables area during initialization.
|
6036 |
|
|
; There are reserved locations there for another 12 streams. Each location
|
6037 |
|
|
; contains an offset to the second byte of a channel. The first byte of a
|
6038 |
|
|
; channel can't be used as that would result in an offset of zero for some
|
6039 |
|
|
; and zero is used to denote that a stream is closed.
|
6040 |
|
|
|
6041 |
|
|
;; init-strm
|
6042 |
|
|
L15C6: DEFB $01, $00 ; stream $FD offset to channel 'K'
|
6043 |
|
|
DEFB $06, $00 ; stream $FE offset to channel 'S'
|
6044 |
|
|
DEFB $0B, $00 ; stream $FF offset to channel 'R'
|
6045 |
|
|
|
6046 |
|
|
DEFB $01, $00 ; stream $00 offset to channel 'K'
|
6047 |
|
|
DEFB $01, $00 ; stream $01 offset to channel 'K'
|
6048 |
|
|
DEFB $06, $00 ; stream $02 offset to channel 'S'
|
6049 |
|
|
DEFB $10, $00 ; stream $03 offset to channel 'P'
|
6050 |
|
|
|
6051 |
|
|
; ------------------------------
|
6052 |
|
|
; THE 'INPUT CONTROL' SUBROUTINE
|
6053 |
|
|
; ------------------------------
|
6054 |
|
|
;
|
6055 |
|
|
|
6056 |
|
|
;; WAIT-KEY
|
6057 |
|
|
L15D4: BIT 5,(IY+$02) ; test TV_FLAG - clear lower screen ?
|
6058 |
|
|
JR NZ,L15DE ; forward to WAIT-KEY1 if so.
|
6059 |
|
|
|
6060 |
|
|
SET 3,(IY+$02) ; update TV_FLAG - signal reprint the edit
|
6061 |
|
|
; line to the lower screen.
|
6062 |
|
|
|
6063 |
|
|
;; WAIT-KEY1
|
6064 |
|
|
L15DE: CALL L15E6 ; routine INPUT-AD is called.
|
6065 |
|
|
|
6066 |
|
|
RET C ; return with acceptable keys.
|
6067 |
|
|
|
6068 |
|
|
JR Z,L15DE ; back to WAIT-KEY1 if no key is pressed
|
6069 |
|
|
; or it has been handled within INPUT-AD.
|
6070 |
|
|
|
6071 |
|
|
; Note. When inputting from the keyboard all characters are returned with
|
6072 |
|
|
; above conditions so this path is never taken.
|
6073 |
|
|
|
6074 |
|
|
;; REPORT-8
|
6075 |
|
|
L15E4: RST 08H ; ERROR-1
|
6076 |
|
|
DEFB $07 ; Error Report: End of file
|
6077 |
|
|
|
6078 |
|
|
; ---------------------------
|
6079 |
|
|
; THE 'INPUT ADDRESS' ROUTINE
|
6080 |
|
|
; ---------------------------
|
6081 |
|
|
; This routine fetches the address of the input stream from the current
|
6082 |
|
|
; channel area using the system variable CURCHL.
|
6083 |
|
|
|
6084 |
|
|
;; INPUT-AD
|
6085 |
|
|
L15E6: EXX ; switch in alternate set.
|
6086 |
|
|
PUSH HL ; save HL register
|
6087 |
|
|
LD HL,($5C51) ; fetch address of CURCHL - current channel.
|
6088 |
|
|
INC HL ; step over output routine
|
6089 |
|
|
INC HL ; to point to low byte of input routine.
|
6090 |
|
|
JR L15F7 ; forward to CALL-SUB.
|
6091 |
|
|
|
6092 |
|
|
; -------------------------
|
6093 |
|
|
; THE 'CODE OUTPUT' ROUTINE
|
6094 |
|
|
; -------------------------
|
6095 |
|
|
; This routine is called on five occasions to print the ASCII equivalent of
|
6096 |
|
|
; a value 0-9.
|
6097 |
|
|
|
6098 |
|
|
;; OUT-CODE
|
6099 |
|
|
L15EF: LD E,$30 ; add 48 decimal to give the ASCII character
|
6100 |
|
|
ADD A,E ; '0' to '9' and continue into the main output
|
6101 |
|
|
; routine.
|
6102 |
|
|
|
6103 |
|
|
; -------------------------
|
6104 |
|
|
; THE 'MAIN OUTPUT' ROUTINE
|
6105 |
|
|
; -------------------------
|
6106 |
|
|
; PRINT-A-2 is a continuation of the RST 10 restart that prints any character.
|
6107 |
|
|
; The routine prints to the current channel and the printing of control codes
|
6108 |
|
|
; may alter that channel to divert subsequent RST 10 instructions to temporary
|
6109 |
|
|
; routines. The normal channel is $09F4.
|
6110 |
|
|
|
6111 |
|
|
;; PRINT-A-2
|
6112 |
|
|
L15F2: EXX ; switch in alternate set
|
6113 |
|
|
PUSH HL ; save HL register
|
6114 |
|
|
LD HL,($5C51) ; fetch CURCHL the current channel.
|
6115 |
|
|
|
6116 |
|
|
; input-ad rejoins here also.
|
6117 |
|
|
|
6118 |
|
|
;; CALL-SUB
|
6119 |
|
|
L15F7: LD E,(HL) ; put the low byte in E.
|
6120 |
|
|
INC HL ; advance address.
|
6121 |
|
|
LD D,(HL) ; put the high byte to D.
|
6122 |
|
|
EX DE,HL ; transfer the stream to HL.
|
6123 |
|
|
CALL L162C ; use routine CALL-JUMP.
|
6124 |
|
|
; in effect CALL (HL).
|
6125 |
|
|
|
6126 |
|
|
POP HL ; restore saved HL register.
|
6127 |
|
|
EXX ; switch back to the main set and
|
6128 |
|
|
RET ; return.
|
6129 |
|
|
|
6130 |
|
|
; --------------------------
|
6131 |
|
|
; THE 'OPEN CHANNEL' ROUTINE
|
6132 |
|
|
; --------------------------
|
6133 |
|
|
; This subroutine is used by the ROM to open a channel 'K', 'S', 'R' or 'P'.
|
6134 |
|
|
; This is either for its own use or in response to a user's request, for
|
6135 |
|
|
; example, when '#' is encountered with output - PRINT, LIST etc.
|
6136 |
|
|
; or with input - INPUT, INKEY$ etc.
|
6137 |
|
|
; It is entered with a system stream $FD - $FF, or a user stream $00 - $0F
|
6138 |
|
|
; in the accumulator.
|
6139 |
|
|
|
6140 |
|
|
;; CHAN-OPEN
|
6141 |
|
|
L1601: ADD A,A ; double the stream ($FF will become $FE etc.)
|
6142 |
|
|
ADD A,$16 ; add the offset to stream 0 from $5C00
|
6143 |
|
|
LD L,A ; result to L
|
6144 |
|
|
LD H,$5C ; now form the address in STRMS area.
|
6145 |
|
|
LD E,(HL) ; fetch low byte of CHANS offset
|
6146 |
|
|
INC HL ; address next
|
6147 |
|
|
LD D,(HL) ; fetch high byte of offset
|
6148 |
|
|
LD A,D ; test that the stream is open.
|
6149 |
|
|
OR E ; zero if closed.
|
6150 |
|
|
JR NZ,L1610 ; forward to CHAN-OP-1 if open.
|
6151 |
|
|
|
6152 |
|
|
;; REPORT-Oa
|
6153 |
|
|
L160E: RST 08H ; ERROR-1
|
6154 |
|
|
DEFB $17 ; Error Report: Invalid stream
|
6155 |
|
|
|
6156 |
|
|
; continue here if stream was open. Note that the offset is from CHANS
|
6157 |
|
|
; to the second byte of the channel.
|
6158 |
|
|
|
6159 |
|
|
;; CHAN-OP-1
|
6160 |
|
|
L1610: DEC DE ; reduce offset so it points to the channel.
|
6161 |
|
|
LD HL,($5C4F) ; fetch CHANS the location of the base of
|
6162 |
|
|
; the channel information area
|
6163 |
|
|
ADD HL,DE ; and add the offset to address the channel.
|
6164 |
|
|
; and continue to set flags.
|
6165 |
|
|
|
6166 |
|
|
; -----------------
|
6167 |
|
|
; Set channel flags
|
6168 |
|
|
; -----------------
|
6169 |
|
|
; This subroutine is used from ED-EDIT, str$ and read-in to reset the
|
6170 |
|
|
; current channel when it has been temporarily altered.
|
6171 |
|
|
|
6172 |
|
|
;; CHAN-FLAG
|
6173 |
|
|
L1615: LD ($5C51),HL ; set CURCHL system variable to the
|
6174 |
|
|
; address in HL
|
6175 |
|
|
RES 4,(IY+$30) ; update FLAGS2 - signal K channel not in use.
|
6176 |
|
|
; Note. provide a default for channel 'R'.
|
6177 |
|
|
INC HL ; advance past
|
6178 |
|
|
INC HL ; output routine.
|
6179 |
|
|
INC HL ; advance past
|
6180 |
|
|
INC HL ; input routine.
|
6181 |
|
|
LD C,(HL) ; pick up the letter.
|
6182 |
|
|
LD HL,L162D ; address: chn-cd-lu
|
6183 |
|
|
CALL L16DC ; routine INDEXER finds offset to a
|
6184 |
|
|
; flag-setting routine.
|
6185 |
|
|
|
6186 |
|
|
RET NC ; but if the letter wasn't found in the
|
6187 |
|
|
; table just return now. - channel 'R'.
|
6188 |
|
|
|
6189 |
|
|
LD D,$00 ; prepare to add
|
6190 |
|
|
LD E,(HL) ; offset to E
|
6191 |
|
|
ADD HL,DE ; add offset to location of offset to form
|
6192 |
|
|
; address of routine
|
6193 |
|
|
|
6194 |
|
|
;; CALL-JUMP
|
6195 |
|
|
L162C: JP (HL) ; jump to the routine
|
6196 |
|
|
|
6197 |
|
|
; Footnote. calling any location that holds JP (HL) is the equivalent to
|
6198 |
|
|
; a pseudo Z80 instruction CALL (HL). The ROM uses the instruction above.
|
6199 |
|
|
|
6200 |
|
|
; --------------------------
|
6201 |
|
|
; Channel code look-up table
|
6202 |
|
|
; --------------------------
|
6203 |
|
|
; This table is used by the routine above to find one of the three
|
6204 |
|
|
; flag setting routines below it.
|
6205 |
|
|
; A zero end-marker is required as channel 'R' is not present.
|
6206 |
|
|
|
6207 |
|
|
;; chn-cd-lu
|
6208 |
|
|
L162D: DEFB 'K', L1634-$-1 ; offset $06 to CHAN-K
|
6209 |
|
|
DEFB 'S', L1642-$-1 ; offset $12 to CHAN-S
|
6210 |
|
|
DEFB 'P', L164D-$-1 ; offset $1B to CHAN-P
|
6211 |
|
|
|
6212 |
|
|
DEFB $00 ; end marker.
|
6213 |
|
|
|
6214 |
|
|
; --------------
|
6215 |
|
|
; Channel K flag
|
6216 |
|
|
; --------------
|
6217 |
|
|
; routine to set flags for lower screen/keyboard channel.
|
6218 |
|
|
|
6219 |
|
|
;; CHAN-K
|
6220 |
|
|
L1634: SET 0,(IY+$02) ; update TV_FLAG - signal lower screen in use
|
6221 |
|
|
RES 5,(IY+$01) ; update FLAGS - signal no new key
|
6222 |
|
|
SET 4,(IY+$30) ; update FLAGS2 - signal K channel in use
|
6223 |
|
|
JR L1646 ; forward to CHAN-S-1 for indirect exit
|
6224 |
|
|
|
6225 |
|
|
; --------------
|
6226 |
|
|
; Channel S flag
|
6227 |
|
|
; --------------
|
6228 |
|
|
; routine to set flags for upper screen channel.
|
6229 |
|
|
|
6230 |
|
|
;; CHAN-S
|
6231 |
|
|
L1642: RES 0,(IY+$02) ; TV_FLAG - signal main screen in use
|
6232 |
|
|
|
6233 |
|
|
;; CHAN-S-1
|
6234 |
|
|
L1646: RES 1,(IY+$01) ; update FLAGS - signal printer not in use
|
6235 |
|
|
JP L0D4D ; jump back to TEMPS and exit via that
|
6236 |
|
|
; routine after setting temporary attributes.
|
6237 |
|
|
; --------------
|
6238 |
|
|
; Channel P flag
|
6239 |
|
|
; --------------
|
6240 |
|
|
; This routine sets a flag so that subsequent print related commands
|
6241 |
|
|
; print to printer or update the relevant system variables.
|
6242 |
|
|
; This status remains in force until reset by the routine above.
|
6243 |
|
|
|
6244 |
|
|
;; CHAN-P
|
6245 |
|
|
L164D: SET 1,(IY+$01) ; update FLAGS - signal printer in use
|
6246 |
|
|
RET ; return
|
6247 |
|
|
|
6248 |
|
|
; --------------------------
|
6249 |
|
|
; THE 'ONE SPACE' SUBROUTINE
|
6250 |
|
|
; --------------------------
|
6251 |
|
|
; This routine is called once only to create a single space
|
6252 |
|
|
; in workspace by ADD-CHAR.
|
6253 |
|
|
|
6254 |
|
|
;; ONE-SPACE
|
6255 |
|
|
L1652: LD BC,$0001 ; create space for a single character.
|
6256 |
|
|
|
6257 |
|
|
; ---------
|
6258 |
|
|
; Make Room
|
6259 |
|
|
; ---------
|
6260 |
|
|
; This entry point is used to create BC spaces in various areas such as
|
6261 |
|
|
; program area, variables area, workspace etc..
|
6262 |
|
|
; The entire free RAM is available to each BASIC statement.
|
6263 |
|
|
; On entry, HL addresses where the first location is to be created.
|
6264 |
|
|
; Afterwards, HL will point to the location before this.
|
6265 |
|
|
|
6266 |
|
|
;; MAKE-ROOM
|
6267 |
|
|
L1655: PUSH HL ; save the address pointer.
|
6268 |
|
|
CALL L1F05 ; routine TEST-ROOM checks if room
|
6269 |
|
|
; exists and generates an error if not.
|
6270 |
|
|
POP HL ; restore the address pointer.
|
6271 |
|
|
CALL L1664 ; routine POINTERS updates the
|
6272 |
|
|
; dynamic memory location pointers.
|
6273 |
|
|
; DE now holds the old value of STKEND.
|
6274 |
|
|
LD HL,($5C65) ; fetch new STKEND the top destination.
|
6275 |
|
|
|
6276 |
|
|
EX DE,HL ; HL now addresses the top of the area to
|
6277 |
|
|
; be moved up - old STKEND.
|
6278 |
|
|
LDDR ; the program, variables, etc are moved up.
|
6279 |
|
|
RET ; return with new area ready to be populated.
|
6280 |
|
|
; HL points to location before new area,
|
6281 |
|
|
; and DE to last of new locations.
|
6282 |
|
|
|
6283 |
|
|
; -----------------------------------------------
|
6284 |
|
|
; Adjust pointers before making or reclaiming room
|
6285 |
|
|
; -----------------------------------------------
|
6286 |
|
|
; This routine is called by MAKE-ROOM to adjust upwards and by RECLAIM to
|
6287 |
|
|
; adjust downwards the pointers within dynamic memory.
|
6288 |
|
|
; The fourteen pointers to dynamic memory, starting with VARS and ending
|
6289 |
|
|
; with STKEND, are updated adding BC if they are higher than the position
|
6290 |
|
|
; in HL.
|
6291 |
|
|
; The system variables are in no particular order except that STKEND, the first
|
6292 |
|
|
; free location after dynamic memory must be the last encountered.
|
6293 |
|
|
|
6294 |
|
|
;; POINTERS
|
6295 |
|
|
L1664: PUSH AF ; preserve accumulator.
|
6296 |
|
|
PUSH HL ; put pos pointer on stack.
|
6297 |
|
|
LD HL,$5C4B ; address VARS the first of the
|
6298 |
|
|
LD A,$0E ; fourteen variables to consider.
|
6299 |
|
|
|
6300 |
|
|
;; PTR-NEXT
|
6301 |
|
|
L166B: LD E,(HL) ; fetch the low byte of the system variable.
|
6302 |
|
|
INC HL ; advance address.
|
6303 |
|
|
LD D,(HL) ; fetch high byte of the system variable.
|
6304 |
|
|
EX (SP),HL ; swap pointer on stack with the variable
|
6305 |
|
|
; pointer.
|
6306 |
|
|
AND A ; prepare to subtract.
|
6307 |
|
|
SBC HL,DE ; subtract variable address
|
6308 |
|
|
ADD HL,DE ; and add back
|
6309 |
|
|
EX (SP),HL ; swap pos with system variable pointer
|
6310 |
|
|
JR NC,L167F ; forward to PTR-DONE if var before pos
|
6311 |
|
|
|
6312 |
|
|
PUSH DE ; save system variable address.
|
6313 |
|
|
EX DE,HL ; transfer to HL
|
6314 |
|
|
ADD HL,BC ; add the offset
|
6315 |
|
|
EX DE,HL ; back to DE
|
6316 |
|
|
LD (HL),D ; load high byte
|
6317 |
|
|
DEC HL ; move back
|
6318 |
|
|
LD (HL),E ; load low byte
|
6319 |
|
|
INC HL ; advance to high byte
|
6320 |
|
|
POP DE ; restore old system variable address.
|
6321 |
|
|
|
6322 |
|
|
;; PTR-DONE
|
6323 |
|
|
L167F: INC HL ; address next system variable.
|
6324 |
|
|
DEC A ; decrease counter.
|
6325 |
|
|
JR NZ,L166B ; back to PTR-NEXT if more.
|
6326 |
|
|
EX DE,HL ; transfer old value of STKEND to HL.
|
6327 |
|
|
; Note. this has always been updated.
|
6328 |
|
|
POP DE ; pop the address of the position.
|
6329 |
|
|
|
6330 |
|
|
POP AF ; pop preserved accumulator.
|
6331 |
|
|
AND A ; clear carry flag preparing to subtract.
|
6332 |
|
|
|
6333 |
|
|
SBC HL,DE ; subtract position from old stkend
|
6334 |
|
|
LD B,H ; to give number of data bytes
|
6335 |
|
|
LD C,L ; to be moved.
|
6336 |
|
|
INC BC ; increment as we also copy byte at old STKEND.
|
6337 |
|
|
ADD HL,DE ; recompute old stkend.
|
6338 |
|
|
EX DE,HL ; transfer to DE.
|
6339 |
|
|
RET ; return.
|
6340 |
|
|
|
6341 |
|
|
|
6342 |
|
|
|
6343 |
|
|
; -------------------
|
6344 |
|
|
; Collect line number
|
6345 |
|
|
; -------------------
|
6346 |
|
|
; This routine extracts a line number, at an address that has previously
|
6347 |
|
|
; been found using LINE-ADDR, and it is entered at LINE-NO. If it encounters
|
6348 |
|
|
; the program 'end-marker' then the previous line is used and if that
|
6349 |
|
|
; should also be unacceptable then zero is used as it must be a direct
|
6350 |
|
|
; command. The program end-marker is the variables end-marker $80, or
|
6351 |
|
|
; if variables exist, then the first character of any variable name.
|
6352 |
|
|
|
6353 |
|
|
;; LINE-ZERO
|
6354 |
|
|
L168F: DEFB $00, $00 ; dummy line number used for direct commands
|
6355 |
|
|
|
6356 |
|
|
|
6357 |
|
|
;; LINE-NO-A
|
6358 |
|
|
L1691: EX DE,HL ; fetch the previous line to HL and set
|
6359 |
|
|
LD DE,L168F ; DE to LINE-ZERO should HL also fail.
|
6360 |
|
|
|
6361 |
|
|
; -> The Entry Point.
|
6362 |
|
|
|
6363 |
|
|
;; LINE-NO
|
6364 |
|
|
L1695: LD A,(HL) ; fetch the high byte - max $2F
|
6365 |
|
|
AND $C0 ; mask off the invalid bits.
|
6366 |
|
|
JR NZ,L1691 ; to LINE-NO-A if an end-marker.
|
6367 |
|
|
|
6368 |
|
|
LD D,(HL) ; reload the high byte.
|
6369 |
|
|
INC HL ; advance address.
|
6370 |
|
|
LD E,(HL) ; pick up the low byte.
|
6371 |
|
|
RET ; return from here.
|
6372 |
|
|
|
6373 |
|
|
; -------------------
|
6374 |
|
|
; Handle reserve room
|
6375 |
|
|
; -------------------
|
6376 |
|
|
; This is a continuation of the restart BC-SPACES
|
6377 |
|
|
|
6378 |
|
|
;; RESERVE
|
6379 |
|
|
L169E: LD HL,($5C63) ; STKBOT first location of calculator stack
|
6380 |
|
|
DEC HL ; make one less than new location
|
6381 |
|
|
CALL L1655 ; routine MAKE-ROOM creates the room.
|
6382 |
|
|
INC HL ; address the first new location
|
6383 |
|
|
INC HL ; advance to second
|
6384 |
|
|
POP BC ; restore old WORKSP
|
6385 |
|
|
LD ($5C61),BC ; system variable WORKSP was perhaps
|
6386 |
|
|
; changed by POINTERS routine.
|
6387 |
|
|
POP BC ; restore count for return value.
|
6388 |
|
|
EX DE,HL ; switch. DE = location after first new space
|
6389 |
|
|
INC HL ; HL now location after new space
|
6390 |
|
|
RET ; return.
|
6391 |
|
|
|
6392 |
|
|
; ---------------------------
|
6393 |
|
|
; Clear various editing areas
|
6394 |
|
|
; ---------------------------
|
6395 |
|
|
; This routine sets the editing area, workspace and calculator stack
|
6396 |
|
|
; to their minimum configurations as at initialization and indeed this
|
6397 |
|
|
; routine could have been relied on to perform that task.
|
6398 |
|
|
; This routine uses HL only and returns with that register holding
|
6399 |
|
|
; WORKSP/STKBOT/STKEND though no use is made of this. The routines also
|
6400 |
|
|
; reset MEM to its usual place in the systems variable area should it
|
6401 |
|
|
; have been relocated to a FOR-NEXT variable. The main entry point
|
6402 |
|
|
; SET-MIN is called at the start of the MAIN-EXEC loop and prior to
|
6403 |
|
|
; displaying an error.
|
6404 |
|
|
|
6405 |
|
|
;; SET-MIN
|
6406 |
|
|
L16B0: LD HL,($5C59) ; fetch E_LINE
|
6407 |
|
|
LD (HL),$0D ; insert carriage return
|
6408 |
|
|
LD ($5C5B),HL ; make K_CUR keyboard cursor point there.
|
6409 |
|
|
INC HL ; next location
|
6410 |
|
|
LD (HL),$80 ; holds end-marker $80
|
6411 |
|
|
INC HL ; next location becomes
|
6412 |
|
|
LD ($5C61),HL ; start of WORKSP
|
6413 |
|
|
|
6414 |
|
|
; This entry point is used prior to input and prior to the execution,
|
6415 |
|
|
; or parsing, of each statement.
|
6416 |
|
|
|
6417 |
|
|
;; SET-WORK
|
6418 |
|
|
L16BF: LD HL,($5C61) ; fetch WORKSP value
|
6419 |
|
|
LD ($5C63),HL ; and place in STKBOT
|
6420 |
|
|
|
6421 |
|
|
; This entry point is used to move the stack back to its normal place
|
6422 |
|
|
; after temporary relocation during line entry and also from ERROR-3
|
6423 |
|
|
|
6424 |
|
|
;; SET-STK
|
6425 |
|
|
L16C5: LD HL,($5C63) ; fetch STKBOT value
|
6426 |
|
|
LD ($5C65),HL ; and place in STKEND.
|
6427 |
|
|
|
6428 |
|
|
PUSH HL ; perhaps an obsolete entry point.
|
6429 |
|
|
LD HL,$5C92 ; normal location of MEM-0
|
6430 |
|
|
LD ($5C68),HL ; is restored to system variable MEM.
|
6431 |
|
|
POP HL ; saved value not required.
|
6432 |
|
|
RET ; return.
|
6433 |
|
|
|
6434 |
|
|
; ------------------
|
6435 |
|
|
; Reclaim edit-line?
|
6436 |
|
|
; ------------------
|
6437 |
|
|
; This seems to be legacy code from the ZX80/ZX81 as it is
|
6438 |
|
|
; not used in this ROM.
|
6439 |
|
|
; That task, in fact, is performed here by the dual-area routine CLEAR-SP.
|
6440 |
|
|
; This routine is designed to deal with something that is known to be in the
|
6441 |
|
|
; edit buffer and not workspace.
|
6442 |
|
|
; On entry, HL must point to the end of the something to be deleted.
|
6443 |
|
|
|
6444 |
|
|
;; REC-EDIT
|
6445 |
|
|
L16D4: LD DE,($5C59) ; fetch start of edit line from E_LINE.
|
6446 |
|
|
JP L19E5 ; jump forward to RECLAIM-1.
|
6447 |
|
|
|
6448 |
|
|
; --------------------------
|
6449 |
|
|
; The Table INDEXING routine
|
6450 |
|
|
; --------------------------
|
6451 |
|
|
; This routine is used to search two-byte hash tables for a character
|
6452 |
|
|
; held in C, returning the address of the following offset byte.
|
6453 |
|
|
; if it is known that the character is in the table e.g. for priorities,
|
6454 |
|
|
; then the table requires no zero end-marker. If this is not known at the
|
6455 |
|
|
; outset then a zero end-marker is required and carry is set to signal
|
6456 |
|
|
; success.
|
6457 |
|
|
|
6458 |
|
|
;; INDEXER-1
|
6459 |
|
|
L16DB: INC HL ; address the next pair of values.
|
6460 |
|
|
|
6461 |
|
|
; -> The Entry Point.
|
6462 |
|
|
|
6463 |
|
|
;; INDEXER
|
6464 |
|
|
L16DC: LD A,(HL) ; fetch the first byte of pair
|
6465 |
|
|
AND A ; is it the end-marker ?
|
6466 |
|
|
RET Z ; return with carry reset if so.
|
6467 |
|
|
|
6468 |
|
|
CP C ; is it the required character ?
|
6469 |
|
|
INC HL ; address next location.
|
6470 |
|
|
JR NZ,L16DB ; back to INDEXER-1 if no match.
|
6471 |
|
|
|
6472 |
|
|
SCF ; else set the carry flag.
|
6473 |
|
|
RET ; return with carry set
|
6474 |
|
|
|
6475 |
|
|
; --------------------------------
|
6476 |
|
|
; The Channel and Streams Routines
|
6477 |
|
|
; --------------------------------
|
6478 |
|
|
; A channel is an input/output route to a hardware device
|
6479 |
|
|
; and is identified to the system by a single letter e.g. 'K' for
|
6480 |
|
|
; the keyboard. A channel can have an input and output route
|
6481 |
|
|
; associated with it in which case it is bi-directional like
|
6482 |
|
|
; the keyboard. Others like the upper screen 'S' are output
|
6483 |
|
|
; only and the input routine usually points to a report message.
|
6484 |
|
|
; Channels 'K' and 'S' are system channels and it would be inappropriate
|
6485 |
|
|
; to close the associated streams so a mechanism is provided to
|
6486 |
|
|
; re-attach them. When the re-attachment is no longer required, then
|
6487 |
|
|
; closing these streams resets them as at initialization.
|
6488 |
|
|
; Early adverts said that the network and RS232 were in this ROM.
|
6489 |
|
|
; Channels 'N' and 'B' are user channels and have been removed successfully
|
6490 |
|
|
; if, as seems possible, they existed.
|
6491 |
|
|
; Ironically the tape streamer is not accessed through streams and
|
6492 |
|
|
; channels.
|
6493 |
|
|
; Early demonstrations of the Spectrum showed a single microdrive being
|
6494 |
|
|
; controlled by the main ROM.
|
6495 |
|
|
|
6496 |
|
|
; ---------------------
|
6497 |
|
|
; THE 'CLOSE #' COMMAND
|
6498 |
|
|
; ---------------------
|
6499 |
|
|
; This command allows streams to be closed after use.
|
6500 |
|
|
; Any temporary memory areas used by the stream would be reclaimed and
|
6501 |
|
|
; finally flags set or reset if necessary.
|
6502 |
|
|
|
6503 |
|
|
;; CLOSE
|
6504 |
|
|
L16E5: CALL L171E ; routine STR-DATA fetches parameter
|
6505 |
|
|
; from calculator stack and gets the
|
6506 |
|
|
; existing STRMS data pointer address in HL
|
6507 |
|
|
; and stream offset from CHANS in BC.
|
6508 |
|
|
|
6509 |
|
|
; Note. this offset could be zero if the
|
6510 |
|
|
; stream is already closed. A check for this
|
6511 |
|
|
; should occur now and an error should be
|
6512 |
|
|
; generated, for example,
|
6513 |
|
|
; Report S 'Stream status closed'.
|
6514 |
|
|
|
6515 |
|
|
CALL L1701 ; routine CLOSE-2 would perform any actions
|
6516 |
|
|
; peculiar to that stream without disturbing
|
6517 |
|
|
; data pointer to STRMS entry in HL.
|
6518 |
|
|
|
6519 |
|
|
LD BC,$0000 ; the stream is to be blanked.
|
6520 |
|
|
LD DE,$A3E2 ; the number of bytes from stream 4, $5C1E,
|
6521 |
|
|
; to $10000
|
6522 |
|
|
EX DE,HL ; transfer offset to HL, STRMS data pointer
|
6523 |
|
|
; to DE.
|
6524 |
|
|
ADD HL,DE ; add the offset to the data pointer.
|
6525 |
|
|
JR C,L16FC ; forward to CLOSE-1 if a non-system stream.
|
6526 |
|
|
; i.e. higher than 3.
|
6527 |
|
|
|
6528 |
|
|
; proceed with a negative result.
|
6529 |
|
|
|
6530 |
|
|
LD BC,L15C6 + 14 ; prepare the address of the byte after
|
6531 |
|
|
; the initial stream data in ROM. ($15D4)
|
6532 |
|
|
ADD HL,BC ; index into the data table with negative value.
|
6533 |
|
|
LD C,(HL) ; low byte to C
|
6534 |
|
|
INC HL ; address next.
|
6535 |
|
|
LD B,(HL) ; high byte to B.
|
6536 |
|
|
|
6537 |
|
|
; and for streams 0 - 3 just enter the initial data back into the STRMS entry
|
6538 |
|
|
; streams 0 - 2 can't be closed as they are shared by the operating system.
|
6539 |
|
|
; -> for streams 4 - 15 then blank the entry.
|
6540 |
|
|
|
6541 |
|
|
;; CLOSE-1
|
6542 |
|
|
L16FC: EX DE,HL ; address of stream to HL.
|
6543 |
|
|
LD (HL),C ; place zero (or low byte).
|
6544 |
|
|
INC HL ; next address.
|
6545 |
|
|
LD (HL),B ; place zero (or high byte).
|
6546 |
|
|
RET ; return.
|
6547 |
|
|
|
6548 |
|
|
; ------------------------
|
6549 |
|
|
; THE 'CLOSE-2' SUBROUTINE
|
6550 |
|
|
; ------------------------
|
6551 |
|
|
; There is not much point in coming here.
|
6552 |
|
|
; The purpose was once to find the offset to a special closing routine,
|
6553 |
|
|
; in this ROM and within 256 bytes of the close stream look up table that
|
6554 |
|
|
; would reclaim any buffers associated with a stream. At least one has been
|
6555 |
|
|
; removed.
|
6556 |
|
|
; Any attempt to CLOSE streams $00 to $04, without first opening the stream,
|
6557 |
|
|
; will lead to either a system restart or the production of a strange report.
|
6558 |
|
|
; credit: Martin Wren-Hilton 1982.
|
6559 |
|
|
|
6560 |
|
|
;; CLOSE-2
|
6561 |
|
|
L1701: PUSH HL ; * save address of stream data pointer
|
6562 |
|
|
; in STRMS on the machine stack.
|
6563 |
|
|
LD HL,($5C4F) ; fetch CHANS address to HL
|
6564 |
|
|
ADD HL,BC ; add the offset to address the second
|
6565 |
|
|
; byte of the output routine hopefully.
|
6566 |
|
|
INC HL ; step past
|
6567 |
|
|
INC HL ; the input routine.
|
6568 |
|
|
|
6569 |
|
|
; Note. When the Sinclair Interface1 is fitted then an instruction fetch
|
6570 |
|
|
; on the next address pages this ROM out and the shadow ROM in.
|
6571 |
|
|
|
6572 |
|
|
;; ROM_TRAP
|
6573 |
|
|
L1708: INC HL ; to address channel's letter
|
6574 |
|
|
LD C,(HL) ; pick it up in C.
|
6575 |
|
|
; Note. but if stream is already closed we
|
6576 |
|
|
; get the value $10 (the byte preceding 'K').
|
6577 |
|
|
|
6578 |
|
|
EX DE,HL ; save the pointer to the letter in DE.
|
6579 |
|
|
|
6580 |
|
|
; Note. The string pointer is saved but not used!!
|
6581 |
|
|
|
6582 |
|
|
LD HL,L1716 ; address: cl-str-lu in ROM.
|
6583 |
|
|
CALL L16DC ; routine INDEXER uses the code to get
|
6584 |
|
|
; the 8-bit offset from the current point to
|
6585 |
|
|
; the address of the closing routine in ROM.
|
6586 |
|
|
; Note. it won't find $10 there!
|
6587 |
|
|
|
6588 |
|
|
LD C,(HL) ; transfer the offset to C.
|
6589 |
|
|
LD B,$00 ; prepare to add.
|
6590 |
|
|
ADD HL,BC ; add offset to point to the address of the
|
6591 |
|
|
; routine that closes the stream.
|
6592 |
|
|
; (and presumably removes any buffers that
|
6593 |
|
|
; are associated with it.)
|
6594 |
|
|
JP (HL) ; jump to that routine.
|
6595 |
|
|
|
6596 |
|
|
; --------------------------------
|
6597 |
|
|
; THE 'CLOSE STREAM LOOK-UP' TABLE
|
6598 |
|
|
; --------------------------------
|
6599 |
|
|
; This table contains an entry for a letter found in the CHANS area.
|
6600 |
|
|
; followed by an 8-bit displacement, from that byte's address in the
|
6601 |
|
|
; table to the routine that performs any ancillary actions associated
|
6602 |
|
|
; with closing the stream of that channel.
|
6603 |
|
|
; The table doesn't require a zero end-marker as the letter has been
|
6604 |
|
|
; picked up from a channel that has an open stream.
|
6605 |
|
|
|
6606 |
|
|
;; cl-str-lu
|
6607 |
|
|
L1716: DEFB 'K', L171C-$-1 ; offset 5 to CLOSE-STR
|
6608 |
|
|
DEFB 'S', L171C-$-1 ; offset 3 to CLOSE-STR
|
6609 |
|
|
DEFB 'P', L171C-$-1 ; offset 1 to CLOSE-STR
|
6610 |
|
|
|
6611 |
|
|
|
6612 |
|
|
; ------------------------------
|
6613 |
|
|
; THE 'CLOSE STREAM' SUBROUTINES
|
6614 |
|
|
; ------------------------------
|
6615 |
|
|
; The close stream routines in fact have no ancillary actions to perform
|
6616 |
|
|
; which is not surprising with regard to 'K' and 'S'.
|
6617 |
|
|
|
6618 |
|
|
;; CLOSE-STR
|
6619 |
|
|
L171C: POP HL ; * now just restore the stream data pointer
|
6620 |
|
|
RET ; in STRMS and return.
|
6621 |
|
|
|
6622 |
|
|
; -----------
|
6623 |
|
|
; Stream data
|
6624 |
|
|
; -----------
|
6625 |
|
|
; This routine finds the data entry in the STRMS area for the specified
|
6626 |
|
|
; stream which is passed on the calculator stack. It returns with HL
|
6627 |
|
|
; pointing to this system variable and BC holding a displacement from
|
6628 |
|
|
; the CHANS area to the second byte of the stream's channel. If BC holds
|
6629 |
|
|
; zero, then that signifies that the stream is closed.
|
6630 |
|
|
|
6631 |
|
|
;; STR-DATA
|
6632 |
|
|
L171E: CALL L1E94 ; routine FIND-INT1 fetches parameter to A
|
6633 |
|
|
CP $10 ; is it less than 16d ?
|
6634 |
|
|
JR C,L1727 ; skip forward to STR-DATA1 if so.
|
6635 |
|
|
|
6636 |
|
|
;; REPORT-Ob
|
6637 |
|
|
L1725: RST 08H ; ERROR-1
|
6638 |
|
|
DEFB $17 ; Error Report: Invalid stream
|
6639 |
|
|
|
6640 |
|
|
;; STR-DATA1
|
6641 |
|
|
L1727: ADD A,$03 ; add the offset for 3 system streams.
|
6642 |
|
|
; range 00 - 15d becomes 3 - 18d.
|
6643 |
|
|
RLCA ; double as there are two bytes per
|
6644 |
|
|
; stream - now 06 - 36d
|
6645 |
|
|
LD HL,$5C10 ; address STRMS - the start of the streams
|
6646 |
|
|
; data area in system variables.
|
6647 |
|
|
LD C,A ; transfer the low byte to A.
|
6648 |
|
|
LD B,$00 ; prepare to add offset.
|
6649 |
|
|
ADD HL,BC ; add to address the data entry in STRMS.
|
6650 |
|
|
|
6651 |
|
|
; the data entry itself contains an offset from CHANS to the address of the
|
6652 |
|
|
; stream
|
6653 |
|
|
|
6654 |
|
|
LD C,(HL) ; low byte of displacement to C.
|
6655 |
|
|
INC HL ; address next.
|
6656 |
|
|
LD B,(HL) ; high byte of displacement to B.
|
6657 |
|
|
DEC HL ; step back to leave HL pointing to STRMS
|
6658 |
|
|
; data entry.
|
6659 |
|
|
RET ; return with CHANS displacement in BC
|
6660 |
|
|
; and address of stream data entry in HL.
|
6661 |
|
|
|
6662 |
|
|
; --------------------
|
6663 |
|
|
; Handle OPEN# command
|
6664 |
|
|
; --------------------
|
6665 |
|
|
; Command syntax example: OPEN #5,"s"
|
6666 |
|
|
; On entry the channel code entry is on the calculator stack with the next
|
6667 |
|
|
; value containing the stream identifier. They have to swapped.
|
6668 |
|
|
|
6669 |
|
|
;; OPEN
|
6670 |
|
|
L1736: RST 28H ;; FP-CALC ;s,c.
|
6671 |
|
|
DEFB $01 ;;exchange ;c,s.
|
6672 |
|
|
DEFB $38 ;;end-calc
|
6673 |
|
|
|
6674 |
|
|
CALL L171E ; routine STR-DATA fetches the stream off
|
6675 |
|
|
; the stack and returns with the CHANS
|
6676 |
|
|
; displacement in BC and HL addressing
|
6677 |
|
|
; the STRMS data entry.
|
6678 |
|
|
LD A,B ; test for zero which
|
6679 |
|
|
OR C ; indicates the stream is closed.
|
6680 |
|
|
JR Z,L1756 ; skip forward to OPEN-1 if so.
|
6681 |
|
|
|
6682 |
|
|
; if it is a system channel then it can re-attached.
|
6683 |
|
|
|
6684 |
|
|
EX DE,HL ; save STRMS address in DE.
|
6685 |
|
|
LD HL,($5C4F) ; fetch CHANS.
|
6686 |
|
|
ADD HL,BC ; add the offset to address the second
|
6687 |
|
|
; byte of the channel.
|
6688 |
|
|
INC HL ; skip over the
|
6689 |
|
|
INC HL ; input routine.
|
6690 |
|
|
INC HL ; and address the letter.
|
6691 |
|
|
LD A,(HL) ; pick up the letter.
|
6692 |
|
|
EX DE,HL ; save letter pointer and bring back
|
6693 |
|
|
; the STRMS pointer.
|
6694 |
|
|
|
6695 |
|
|
CP $4B ; is it 'K' ?
|
6696 |
|
|
JR Z,L1756 ; forward to OPEN-1 if so
|
6697 |
|
|
|
6698 |
|
|
CP $53 ; is it 'S' ?
|
6699 |
|
|
JR Z,L1756 ; forward to OPEN-1 if so
|
6700 |
|
|
|
6701 |
|
|
CP $50 ; is it 'P' ?
|
6702 |
|
|
JR NZ,L1725 ; back to REPORT-Ob if not.
|
6703 |
|
|
; to report 'Invalid stream'.
|
6704 |
|
|
|
6705 |
|
|
; continue if one of the upper-case letters was found.
|
6706 |
|
|
; and rejoin here from above if stream was closed.
|
6707 |
|
|
|
6708 |
|
|
;; OPEN-1
|
6709 |
|
|
L1756: CALL L175D ; routine OPEN-2 opens the stream.
|
6710 |
|
|
|
6711 |
|
|
; it now remains to update the STRMS variable.
|
6712 |
|
|
|
6713 |
|
|
LD (HL),E ; insert or overwrite the low byte.
|
6714 |
|
|
INC HL ; address high byte in STRMS.
|
6715 |
|
|
LD (HL),D ; insert or overwrite the high byte.
|
6716 |
|
|
RET ; return.
|
6717 |
|
|
|
6718 |
|
|
; -----------------
|
6719 |
|
|
; OPEN-2 Subroutine
|
6720 |
|
|
; -----------------
|
6721 |
|
|
; There is some point in coming here as, as well as once creating buffers,
|
6722 |
|
|
; this routine also sets flags.
|
6723 |
|
|
|
6724 |
|
|
;; OPEN-2
|
6725 |
|
|
L175D: PUSH HL ; * save the STRMS data entry pointer.
|
6726 |
|
|
CALL L2BF1 ; routine STK-FETCH now fetches the
|
6727 |
|
|
; parameters of the channel string.
|
6728 |
|
|
; start in DE, length in BC.
|
6729 |
|
|
|
6730 |
|
|
LD A,B ; test that it is not
|
6731 |
|
|
OR C ; the null string.
|
6732 |
|
|
JR NZ,L1767 ; skip forward to OPEN-3 with 1 character
|
6733 |
|
|
; or more!
|
6734 |
|
|
|
6735 |
|
|
;; REPORT-Fb
|
6736 |
|
|
L1765: RST 08H ; ERROR-1
|
6737 |
|
|
DEFB $0E ; Error Report: Invalid file name
|
6738 |
|
|
|
6739 |
|
|
;; OPEN-3
|
6740 |
|
|
L1767: PUSH BC ; save the length of the string.
|
6741 |
|
|
LD A,(DE) ; pick up the first character.
|
6742 |
|
|
; Note. There can be more than one character.
|
6743 |
|
|
AND $DF ; make it upper-case.
|
6744 |
|
|
LD C,A ; place it in C.
|
6745 |
|
|
LD HL,L177A ; address: op-str-lu is loaded.
|
6746 |
|
|
CALL L16DC ; routine INDEXER will search for letter.
|
6747 |
|
|
JR NC,L1765 ; back to REPORT-F if not found
|
6748 |
|
|
; 'Invalid filename'
|
6749 |
|
|
|
6750 |
|
|
LD C,(HL) ; fetch the displacement to opening routine.
|
6751 |
|
|
LD B,$00 ; prepare to add.
|
6752 |
|
|
ADD HL,BC ; now form address of opening routine.
|
6753 |
|
|
POP BC ; restore the length of string.
|
6754 |
|
|
JP (HL) ; now jump forward to the relevant routine.
|
6755 |
|
|
|
6756 |
|
|
; -------------------------
|
6757 |
|
|
; OPEN stream look-up table
|
6758 |
|
|
; -------------------------
|
6759 |
|
|
; The open stream look-up table consists of matched pairs.
|
6760 |
|
|
; The channel letter is followed by an 8-bit displacement to the
|
6761 |
|
|
; associated stream-opening routine in this ROM.
|
6762 |
|
|
; The table requires a zero end-marker as the letter has been
|
6763 |
|
|
; provided by the user and not the operating system.
|
6764 |
|
|
|
6765 |
|
|
;; op-str-lu
|
6766 |
|
|
L177A: DEFB 'K', L1781-$-1 ; $06 offset to OPEN-K
|
6767 |
|
|
DEFB 'S', L1785-$-1 ; $08 offset to OPEN-S
|
6768 |
|
|
DEFB 'P', L1789-$-1 ; $0A offset to OPEN-P
|
6769 |
|
|
|
6770 |
|
|
DEFB $00 ; end-marker.
|
6771 |
|
|
|
6772 |
|
|
; ----------------------------
|
6773 |
|
|
; The Stream Opening Routines.
|
6774 |
|
|
; ----------------------------
|
6775 |
|
|
; These routines would have opened any buffers associated with the stream
|
6776 |
|
|
; before jumping forward to OPEN-END with the displacement value in E
|
6777 |
|
|
; and perhaps a modified value in BC. The strange pathing does seem to
|
6778 |
|
|
; provide for flexibility in this respect.
|
6779 |
|
|
;
|
6780 |
|
|
; There is no need to open the printer buffer as it is there already
|
6781 |
|
|
; even if you are still saving up for a ZX Printer or have moved onto
|
6782 |
|
|
; something bigger. In any case it would have to be created after
|
6783 |
|
|
; the system variables but apart from that it is a simple task
|
6784 |
|
|
; and all but one of the ROM routines can handle a buffer in that position.
|
6785 |
|
|
; (PR-ALL-6 would require an extra 3 bytes of code).
|
6786 |
|
|
; However it wouldn't be wise to have two streams attached to the ZX Printer
|
6787 |
|
|
; as you can now, so one assumes that if PR_CC_hi was non-zero then
|
6788 |
|
|
; the OPEN-P routine would have refused to attach a stream if another
|
6789 |
|
|
; stream was attached.
|
6790 |
|
|
|
6791 |
|
|
; Something of significance is being passed to these ghost routines in the
|
6792 |
|
|
; second character. Strings 'RB', 'RT' perhaps or a drive/station number.
|
6793 |
|
|
; The routine would have to deal with that and exit to OPEN_END with BC
|
6794 |
|
|
; containing $0001 or more likely there would be an exit within the routine.
|
6795 |
|
|
; Anyway doesn't matter, these routines are long gone.
|
6796 |
|
|
|
6797 |
|
|
; -----------------
|
6798 |
|
|
; OPEN-K Subroutine
|
6799 |
|
|
; -----------------
|
6800 |
|
|
; Open Keyboard stream.
|
6801 |
|
|
|
6802 |
|
|
;; OPEN-K
|
6803 |
|
|
L1781: LD E,$01 ; 01 is offset to second byte of channel 'K'.
|
6804 |
|
|
JR L178B ; forward to OPEN-END
|
6805 |
|
|
|
6806 |
|
|
; -----------------
|
6807 |
|
|
; OPEN-S Subroutine
|
6808 |
|
|
; -----------------
|
6809 |
|
|
; Open Screen stream.
|
6810 |
|
|
|
6811 |
|
|
;; OPEN-S
|
6812 |
|
|
L1785: LD E,$06 ; 06 is offset to 2nd byte of channel 'S'
|
6813 |
|
|
JR L178B ; to OPEN-END
|
6814 |
|
|
|
6815 |
|
|
; -----------------
|
6816 |
|
|
; OPEN-P Subroutine
|
6817 |
|
|
; -----------------
|
6818 |
|
|
; Open Printer stream.
|
6819 |
|
|
|
6820 |
|
|
;; OPEN-P
|
6821 |
|
|
L1789: LD E,$10 ; 16d is offset to 2nd byte of channel 'P'
|
6822 |
|
|
|
6823 |
|
|
;; OPEN-END
|
6824 |
|
|
L178B: DEC BC ; the stored length of 'K','S','P' or
|
6825 |
|
|
; whatever is now tested. ??
|
6826 |
|
|
LD A,B ; test now if initial or residual length
|
6827 |
|
|
OR C ; is one character.
|
6828 |
|
|
JR NZ,L1765 ; to REPORT-Fb 'Invalid file name' if not.
|
6829 |
|
|
|
6830 |
|
|
LD D,A ; load D with zero to form the displacement
|
6831 |
|
|
; in the DE register.
|
6832 |
|
|
POP HL ; * restore the saved STRMS pointer.
|
6833 |
|
|
RET ; return to update STRMS entry thereby
|
6834 |
|
|
; signaling stream is open.
|
6835 |
|
|
|
6836 |
|
|
; ----------------------------------------
|
6837 |
|
|
; Handle CAT, ERASE, FORMAT, MOVE commands
|
6838 |
|
|
; ----------------------------------------
|
6839 |
|
|
; These just generate an error report as the ROM is 'incomplete'.
|
6840 |
|
|
;
|
6841 |
|
|
; Luckily this provides a mechanism for extending these in a shadow ROM
|
6842 |
|
|
; but without the powerful mechanisms set up in this ROM.
|
6843 |
|
|
; An instruction fetch on $0008 may page in a peripheral ROM,
|
6844 |
|
|
; e.g. the Sinclair Interface 1 ROM, to handle these commands.
|
6845 |
|
|
; However that wasn't the plan.
|
6846 |
|
|
; Development of this ROM continued for another three months until the cost
|
6847 |
|
|
; of replacing it and the manual became unfeasible.
|
6848 |
|
|
; The ultimate power of channels and streams died at birth.
|
6849 |
|
|
|
6850 |
|
|
;; CAT-ETC
|
6851 |
|
|
L1793: JR L1725 ; to REPORT-Ob
|
6852 |
|
|
|
6853 |
|
|
; -----------------
|
6854 |
|
|
; Perform AUTO-LIST
|
6855 |
|
|
; -----------------
|
6856 |
|
|
; This produces an automatic listing in the upper screen.
|
6857 |
|
|
|
6858 |
|
|
;; AUTO-LIST
|
6859 |
|
|
L1795: LD ($5C3F),SP ; save stack pointer in LIST_SP
|
6860 |
|
|
LD (IY+$02),$10 ; update TV_FLAG set bit 3
|
6861 |
|
|
CALL L0DAF ; routine CL-ALL.
|
6862 |
|
|
SET 0,(IY+$02) ; update TV_FLAG - signal lower screen in use
|
6863 |
|
|
|
6864 |
|
|
LD B,(IY+$31) ; fetch DF_SZ to B.
|
6865 |
|
|
CALL L0E44 ; routine CL-LINE clears lower display
|
6866 |
|
|
; preserving B.
|
6867 |
|
|
RES 0,(IY+$02) ; update TV_FLAG - signal main screen in use
|
6868 |
|
|
SET 0,(IY+$30) ; update FLAGS2 - signal will be necessary to
|
6869 |
|
|
; clear main screen.
|
6870 |
|
|
LD HL,($5C49) ; fetch E_PPC current edit line to HL.
|
6871 |
|
|
LD DE,($5C6C) ; fetch S_TOP to DE, the current top line
|
6872 |
|
|
; (initially zero)
|
6873 |
|
|
AND A ; prepare for true subtraction.
|
6874 |
|
|
SBC HL,DE ; subtract and
|
6875 |
|
|
ADD HL,DE ; add back.
|
6876 |
|
|
JR C,L17E1 ; to AUTO-L-2 if S_TOP higher than E_PPC
|
6877 |
|
|
; to set S_TOP to E_PPC
|
6878 |
|
|
|
6879 |
|
|
PUSH DE ; save the top line number.
|
6880 |
|
|
CALL L196E ; routine LINE-ADDR gets address of E_PPC.
|
6881 |
|
|
LD DE,$02C0 ; prepare known number of characters in
|
6882 |
|
|
; the default upper screen.
|
6883 |
|
|
EX DE,HL ; offset to HL, program address to DE.
|
6884 |
|
|
SBC HL,DE ; subtract high value from low to obtain
|
6885 |
|
|
; negated result used in addition.
|
6886 |
|
|
EX (SP),HL ; swap result with top line number on stack.
|
6887 |
|
|
CALL L196E ; routine LINE-ADDR gets address of that
|
6888 |
|
|
; top line in HL and next line in DE.
|
6889 |
|
|
POP BC ; restore the result to balance stack.
|
6890 |
|
|
|
6891 |
|
|
;; AUTO-L-1
|
6892 |
|
|
L17CE: PUSH BC ; save the result.
|
6893 |
|
|
CALL L19B8 ; routine NEXT-ONE gets address in HL of
|
6894 |
|
|
; line after auto-line (in DE).
|
6895 |
|
|
POP BC ; restore result.
|
6896 |
|
|
ADD HL,BC ; compute back.
|
6897 |
|
|
JR C,L17E4 ; to AUTO-L-3 if line 'should' appear
|
6898 |
|
|
|
6899 |
|
|
EX DE,HL ; address of next line to HL.
|
6900 |
|
|
LD D,(HL) ; get line
|
6901 |
|
|
INC HL ; number
|
6902 |
|
|
LD E,(HL) ; in DE.
|
6903 |
|
|
DEC HL ; adjust back to start.
|
6904 |
|
|
LD ($5C6C),DE ; update S_TOP.
|
6905 |
|
|
JR L17CE ; to AUTO-L-1 until estimate reached.
|
6906 |
|
|
|
6907 |
|
|
; ---
|
6908 |
|
|
|
6909 |
|
|
; the jump was to here if S_TOP was greater than E_PPC
|
6910 |
|
|
|
6911 |
|
|
;; AUTO-L-2
|
6912 |
|
|
L17E1: LD ($5C6C),HL ; make S_TOP the same as E_PPC.
|
6913 |
|
|
|
6914 |
|
|
; continue here with valid starting point from above or good estimate
|
6915 |
|
|
; from computation
|
6916 |
|
|
|
6917 |
|
|
;; AUTO-L-3
|
6918 |
|
|
L17E4: LD HL,($5C6C) ; fetch S_TOP line number to HL.
|
6919 |
|
|
CALL L196E ; routine LINE-ADDR gets address in HL.
|
6920 |
|
|
; address of next in DE.
|
6921 |
|
|
JR Z,L17ED ; to AUTO-L-4 if line exists.
|
6922 |
|
|
|
6923 |
|
|
EX DE,HL ; else use address of next line.
|
6924 |
|
|
|
6925 |
|
|
;; AUTO-L-4
|
6926 |
|
|
L17ED: CALL L1833 ; routine LIST-ALL >>>
|
6927 |
|
|
|
6928 |
|
|
; The return will be to here if no scrolling occurred
|
6929 |
|
|
|
6930 |
|
|
RES 4,(IY+$02) ; update TV_FLAG - signal no auto listing.
|
6931 |
|
|
RET ; return.
|
6932 |
|
|
|
6933 |
|
|
; ------------
|
6934 |
|
|
; Handle LLIST
|
6935 |
|
|
; ------------
|
6936 |
|
|
; A short form of LIST #3. The listing goes to stream 3 - default printer.
|
6937 |
|
|
|
6938 |
|
|
;; LLIST
|
6939 |
|
|
L17F5: LD A,$03 ; the usual stream for ZX Printer
|
6940 |
|
|
JR L17FB ; forward to LIST-1
|
6941 |
|
|
|
6942 |
|
|
; -----------
|
6943 |
|
|
; Handle LIST
|
6944 |
|
|
; -----------
|
6945 |
|
|
; List to any stream.
|
6946 |
|
|
; Note. While a starting line can be specified it is
|
6947 |
|
|
; not possible to specify an end line.
|
6948 |
|
|
; Just listing a line makes it the current edit line.
|
6949 |
|
|
|
6950 |
|
|
;; LIST
|
6951 |
|
|
L17F9: LD A,$02 ; default is stream 2 - the upper screen.
|
6952 |
|
|
|
6953 |
|
|
;; LIST-1
|
6954 |
|
|
L17FB: LD (IY+$02),$00 ; the TV_FLAG is initialized with bit 0 reset
|
6955 |
|
|
; indicating upper screen in use.
|
6956 |
|
|
CALL L2530 ; routine SYNTAX-Z - checking syntax ?
|
6957 |
|
|
CALL NZ,L1601 ; routine CHAN-OPEN if in run-time.
|
6958 |
|
|
|
6959 |
|
|
RST 18H ; GET-CHAR
|
6960 |
|
|
CALL L2070 ; routine STR-ALTER will alter if '#'.
|
6961 |
|
|
JR C,L181F ; forward to LIST-4 not a '#' .
|
6962 |
|
|
|
6963 |
|
|
|
6964 |
|
|
RST 18H ; GET-CHAR
|
6965 |
|
|
CP $3B ; is it ';' ?
|
6966 |
|
|
JR Z,L1814 ; skip to LIST-2 if so.
|
6967 |
|
|
|
6968 |
|
|
CP $2C ; is it ',' ?
|
6969 |
|
|
JR NZ,L181A ; forward to LIST-3 if neither separator.
|
6970 |
|
|
|
6971 |
|
|
; we have, say, LIST #15, and a number must follow the separator.
|
6972 |
|
|
|
6973 |
|
|
;; LIST-2
|
6974 |
|
|
L1814: RST 20H ; NEXT-CHAR
|
6975 |
|
|
CALL L1C82 ; routine EXPT-1NUM
|
6976 |
|
|
JR L1822 ; forward to LIST-5
|
6977 |
|
|
|
6978 |
|
|
; ---
|
6979 |
|
|
|
6980 |
|
|
; the branch was here with just LIST #3 etc.
|
6981 |
|
|
|
6982 |
|
|
;; LIST-3
|
6983 |
|
|
L181A: CALL L1CE6 ; routine USE-ZERO
|
6984 |
|
|
JR L1822 ; forward to LIST-5
|
6985 |
|
|
|
6986 |
|
|
; ---
|
6987 |
|
|
|
6988 |
|
|
; the branch was here with LIST
|
6989 |
|
|
|
6990 |
|
|
;; LIST-4
|
6991 |
|
|
L181F: CALL L1CDE ; routine FETCH-NUM checks if a number
|
6992 |
|
|
; follows else uses zero.
|
6993 |
|
|
|
6994 |
|
|
;; LIST-5
|
6995 |
|
|
L1822: CALL L1BEE ; routine CHECK-END quits if syntax OK >>>
|
6996 |
|
|
|
6997 |
|
|
CALL L1E99 ; routine FIND-INT2 fetches the number
|
6998 |
|
|
; from the calculator stack in run-time.
|
6999 |
|
|
LD A,B ; fetch high byte of line number and
|
7000 |
|
|
AND $3F ; make less than $40 so that NEXT-ONE
|
7001 |
|
|
; (from LINE-ADDR) doesn't lose context.
|
7002 |
|
|
; Note. this is not satisfactory and the typo
|
7003 |
|
|
; LIST 20000 will list an entirely different
|
7004 |
|
|
; section than LIST 2000. Such typos are not
|
7005 |
|
|
; available for checking if they are direct
|
7006 |
|
|
; commands.
|
7007 |
|
|
|
7008 |
|
|
LD H,A ; transfer the modified
|
7009 |
|
|
LD L,C ; line number to HL.
|
7010 |
|
|
LD ($5C49),HL ; update E_PPC to new line number.
|
7011 |
|
|
CALL L196E ; routine LINE-ADDR gets the address of the
|
7012 |
|
|
; line.
|
7013 |
|
|
|
7014 |
|
|
; This routine is called from AUTO-LIST
|
7015 |
|
|
|
7016 |
|
|
;; LIST-ALL
|
7017 |
|
|
L1833: LD E,$01 ; signal current line not yet printed
|
7018 |
|
|
|
7019 |
|
|
;; LIST-ALL-2
|
7020 |
|
|
L1835: CALL L1855 ; routine OUT-LINE outputs a BASIC line
|
7021 |
|
|
; using PRINT-OUT and makes an early return
|
7022 |
|
|
; when no more lines to print. >>>
|
7023 |
|
|
|
7024 |
|
|
RST 10H ; PRINT-A prints the carriage return (in A)
|
7025 |
|
|
|
7026 |
|
|
BIT 4,(IY+$02) ; test TV_FLAG - automatic listing ?
|
7027 |
|
|
JR Z,L1835 ; back to LIST-ALL-2 if not
|
7028 |
|
|
; (loop exit is via OUT-LINE)
|
7029 |
|
|
|
7030 |
|
|
; continue here if an automatic listing required.
|
7031 |
|
|
|
7032 |
|
|
LD A,($5C6B) ; fetch DF_SZ lower display file size.
|
7033 |
|
|
SUB (IY+$4F) ; subtract S_POSN_hi ithe current line number.
|
7034 |
|
|
JR NZ,L1835 ; back to LIST-ALL-2 if upper screen not full.
|
7035 |
|
|
|
7036 |
|
|
XOR E ; A contains zero, E contains one if the
|
7037 |
|
|
; current edit line has not been printed
|
7038 |
|
|
; or zero if it has (from OUT-LINE).
|
7039 |
|
|
RET Z ; return if the screen is full and the line
|
7040 |
|
|
; has been printed.
|
7041 |
|
|
|
7042 |
|
|
; continue with automatic listings if the screen is full and the current
|
7043 |
|
|
; edit line is missing. OUT-LINE will scroll automatically.
|
7044 |
|
|
|
7045 |
|
|
PUSH HL ; save the pointer address.
|
7046 |
|
|
PUSH DE ; save the E flag.
|
7047 |
|
|
LD HL,$5C6C ; fetch S_TOP the rough estimate.
|
7048 |
|
|
CALL L190F ; routine LN-FETCH updates S_TOP with
|
7049 |
|
|
; the number of the next line.
|
7050 |
|
|
POP DE ; restore the E flag.
|
7051 |
|
|
POP HL ; restore the address of the next line.
|
7052 |
|
|
JR L1835 ; back to LIST-ALL-2.
|
7053 |
|
|
|
7054 |
|
|
; ------------------------
|
7055 |
|
|
; Print a whole BASIC line
|
7056 |
|
|
; ------------------------
|
7057 |
|
|
; This routine prints a whole BASIC line and it is called
|
7058 |
|
|
; from LIST-ALL to output the line to current channel
|
7059 |
|
|
; and from ED-EDIT to 'sprint' the line to the edit buffer.
|
7060 |
|
|
|
7061 |
|
|
;; OUT-LINE
|
7062 |
|
|
L1855: LD BC,($5C49) ; fetch E_PPC the current line which may be
|
7063 |
|
|
; unchecked and not exist.
|
7064 |
|
|
CALL L1980 ; routine CP-LINES finds match or line after.
|
7065 |
|
|
LD D,$3E ; prepare cursor '>' in D.
|
7066 |
|
|
JR Z,L1865 ; to OUT-LINE1 if matched or line after.
|
7067 |
|
|
|
7068 |
|
|
LD DE,$0000 ; put zero in D, to suppress line cursor.
|
7069 |
|
|
RL E ; pick up carry in E if line before current
|
7070 |
|
|
; leave E zero if same or after.
|
7071 |
|
|
|
7072 |
|
|
;; OUT-LINE1
|
7073 |
|
|
L1865: LD (IY+$2D),E ; save flag in BREG which is spare.
|
7074 |
|
|
LD A,(HL) ; get high byte of line number.
|
7075 |
|
|
CP $40 ; is it too high ($2F is maximum possible) ?
|
7076 |
|
|
POP BC ; drop the return address and
|
7077 |
|
|
RET NC ; make an early return if so >>>
|
7078 |
|
|
|
7079 |
|
|
PUSH BC ; save return address
|
7080 |
|
|
CALL L1A28 ; routine OUT-NUM-2 to print addressed number
|
7081 |
|
|
; with leading space.
|
7082 |
|
|
INC HL ; skip low number byte.
|
7083 |
|
|
INC HL ; and the two
|
7084 |
|
|
INC HL ; length bytes.
|
7085 |
|
|
RES 0,(IY+$01) ; update FLAGS - signal leading space required.
|
7086 |
|
|
LD A,D ; fetch the cursor.
|
7087 |
|
|
AND A ; test for zero.
|
7088 |
|
|
JR Z,L1881 ; to OUT-LINE3 if zero.
|
7089 |
|
|
|
7090 |
|
|
|
7091 |
|
|
RST 10H ; PRINT-A prints '>' the current line cursor.
|
7092 |
|
|
|
7093 |
|
|
; this entry point is called from ED-COPY
|
7094 |
|
|
|
7095 |
|
|
;; OUT-LINE2
|
7096 |
|
|
L187D: SET 0,(IY+$01) ; update FLAGS - suppress leading space.
|
7097 |
|
|
|
7098 |
|
|
;; OUT-LINE3
|
7099 |
|
|
L1881: PUSH DE ; save flag E for a return value.
|
7100 |
|
|
EX DE,HL ; save HL address in DE.
|
7101 |
|
|
RES 2,(IY+$30) ; update FLAGS2 - signal NOT in QUOTES.
|
7102 |
|
|
|
7103 |
|
|
LD HL,$5C3B ; point to FLAGS.
|
7104 |
|
|
RES 2,(HL) ; signal 'K' mode. (starts before keyword)
|
7105 |
|
|
BIT 5,(IY+$37) ; test FLAGX - input mode ?
|
7106 |
|
|
JR Z,L1894 ; forward to OUT-LINE4 if not.
|
7107 |
|
|
|
7108 |
|
|
SET 2,(HL) ; signal 'L' mode. (used for input)
|
7109 |
|
|
|
7110 |
|
|
;; OUT-LINE4
|
7111 |
|
|
L1894: LD HL,($5C5F) ; fetch X_PTR - possibly the error pointer
|
7112 |
|
|
; address.
|
7113 |
|
|
AND A ; clear the carry flag.
|
7114 |
|
|
SBC HL,DE ; test if an error address has been reached.
|
7115 |
|
|
JR NZ,L18A1 ; forward to OUT-LINE5 if not.
|
7116 |
|
|
|
7117 |
|
|
LD A,$3F ; load A with '?' the error marker.
|
7118 |
|
|
CALL L18C1 ; routine OUT-FLASH to print flashing marker.
|
7119 |
|
|
|
7120 |
|
|
;; OUT-LINE5
|
7121 |
|
|
L18A1: CALL L18E1 ; routine OUT-CURS will print the cursor if
|
7122 |
|
|
; this is the right position.
|
7123 |
|
|
EX DE,HL ; restore address pointer to HL.
|
7124 |
|
|
LD A,(HL) ; fetch the addressed character.
|
7125 |
|
|
CALL L18B6 ; routine NUMBER skips a hidden floating
|
7126 |
|
|
; point number if present.
|
7127 |
|
|
INC HL ; now increment the pointer.
|
7128 |
|
|
CP $0D ; is character end-of-line ?
|
7129 |
|
|
JR Z,L18B4 ; to OUT-LINE6, if so, as line is finished.
|
7130 |
|
|
|
7131 |
|
|
EX DE,HL ; save the pointer in DE.
|
7132 |
|
|
CALL L1937 ; routine OUT-CHAR to output character/token.
|
7133 |
|
|
|
7134 |
|
|
JR L1894 ; back to OUT-LINE4 until entire line is done.
|
7135 |
|
|
|
7136 |
|
|
; ---
|
7137 |
|
|
|
7138 |
|
|
;; OUT-LINE6
|
7139 |
|
|
L18B4: POP DE ; bring back the flag E, zero if current
|
7140 |
|
|
; line printed else 1 if still to print.
|
7141 |
|
|
RET ; return with A holding $0D
|
7142 |
|
|
|
7143 |
|
|
; -------------------------
|
7144 |
|
|
; Check for a number marker
|
7145 |
|
|
; -------------------------
|
7146 |
|
|
; this subroutine is called from two processes. while outputting BASIC lines
|
7147 |
|
|
; and while searching statements within a BASIC line.
|
7148 |
|
|
; during both, this routine will pass over an invisible number indicator
|
7149 |
|
|
; and the five bytes floating-point number that follows it.
|
7150 |
|
|
; Note that this causes floating point numbers to be stripped from
|
7151 |
|
|
; the BASIC line when it is fetched to the edit buffer by OUT_LINE.
|
7152 |
|
|
; the number marker also appears after the arguments of a DEF FN statement
|
7153 |
|
|
; and may mask old 5-byte string parameters.
|
7154 |
|
|
|
7155 |
|
|
;; NUMBER
|
7156 |
|
|
L18B6: CP $0E ; character fourteen ?
|
7157 |
|
|
RET NZ ; return if not.
|
7158 |
|
|
|
7159 |
|
|
INC HL ; skip the character
|
7160 |
|
|
INC HL ; and five bytes
|
7161 |
|
|
INC HL ; following.
|
7162 |
|
|
INC HL ;
|
7163 |
|
|
INC HL ;
|
7164 |
|
|
INC HL ;
|
7165 |
|
|
LD A,(HL) ; fetch the following character
|
7166 |
|
|
RET ; for return value.
|
7167 |
|
|
|
7168 |
|
|
; --------------------------
|
7169 |
|
|
; Print a flashing character
|
7170 |
|
|
; --------------------------
|
7171 |
|
|
; This subroutine is called from OUT-LINE to print a flashing error
|
7172 |
|
|
; marker '?' or from the next routine to print a flashing cursor e.g. 'L'.
|
7173 |
|
|
; However, this only gets called from OUT-LINE when printing the edit line
|
7174 |
|
|
; or the input buffer to the lower screen so a direct call to $09F4 can
|
7175 |
|
|
; be used, even though out-line outputs to other streams.
|
7176 |
|
|
; In fact the alternate set is used for the whole routine.
|
7177 |
|
|
|
7178 |
|
|
;; OUT-FLASH
|
7179 |
|
|
L18C1: EXX ; switch in alternate set
|
7180 |
|
|
|
7181 |
|
|
LD HL,($5C8F) ; fetch L = ATTR_T, H = MASK-T
|
7182 |
|
|
PUSH HL ; save masks.
|
7183 |
|
|
RES 7,H ; reset flash mask bit so active.
|
7184 |
|
|
SET 7,L ; make attribute FLASH.
|
7185 |
|
|
LD ($5C8F),HL ; resave ATTR_T and MASK-T
|
7186 |
|
|
|
7187 |
|
|
LD HL,$5C91 ; address P_FLAG
|
7188 |
|
|
LD D,(HL) ; fetch to D
|
7189 |
|
|
PUSH DE ; and save.
|
7190 |
|
|
LD (HL),$00 ; clear inverse, over, ink/paper 9
|
7191 |
|
|
|
7192 |
|
|
CALL L09F4 ; routine PRINT-OUT outputs character
|
7193 |
|
|
; without the need to vector via RST 10.
|
7194 |
|
|
|
7195 |
|
|
POP HL ; pop P_FLAG to H.
|
7196 |
|
|
LD (IY+$57),H ; and restore system variable P_FLAG.
|
7197 |
|
|
POP HL ; restore temporary masks
|
7198 |
|
|
LD ($5C8F),HL ; and restore system variables ATTR_T/MASK_T
|
7199 |
|
|
|
7200 |
|
|
EXX ; switch back to main set
|
7201 |
|
|
RET ; return
|
7202 |
|
|
|
7203 |
|
|
; ----------------
|
7204 |
|
|
; Print the cursor
|
7205 |
|
|
; ----------------
|
7206 |
|
|
; This routine is called before any character is output while outputting
|
7207 |
|
|
; a BASIC line or the input buffer. This includes listing to a printer
|
7208 |
|
|
; or screen, copying a BASIC line to the edit buffer and printing the
|
7209 |
|
|
; input buffer or edit buffer to the lower screen. It is only in the
|
7210 |
|
|
; latter two cases that it has any relevance and in the last case it
|
7211 |
|
|
; performs another very important function also.
|
7212 |
|
|
|
7213 |
|
|
;; OUT-CURS
|
7214 |
|
|
L18E1: LD HL,($5C5B) ; fetch K_CUR the current cursor address
|
7215 |
|
|
AND A ; prepare for true subtraction.
|
7216 |
|
|
SBC HL,DE ; test against pointer address in DE and
|
7217 |
|
|
RET NZ ; return if not at exact position.
|
7218 |
|
|
|
7219 |
|
|
; the value of MODE, maintained by KEY-INPUT, is tested and if non-zero
|
7220 |
|
|
; then this value 'E' or 'G' will take precedence.
|
7221 |
|
|
|
7222 |
|
|
LD A,($5C41) ; fetch MODE 0='KLC', 1='E', 2='G'.
|
7223 |
|
|
RLC A ; double the value and set flags.
|
7224 |
|
|
JR Z,L18F3 ; to OUT-C-1 if still zero ('KLC').
|
7225 |
|
|
|
7226 |
|
|
ADD A,$43 ; add 'C' - will become 'E' if originally 1
|
7227 |
|
|
; or 'G' if originally 2.
|
7228 |
|
|
JR L1909 ; forward to OUT-C-2 to print.
|
7229 |
|
|
|
7230 |
|
|
; ---
|
7231 |
|
|
|
7232 |
|
|
; If mode was zero then, while printing a BASIC line, bit 2 of flags has been
|
7233 |
|
|
; set if 'THEN' or ':' was encountered as a main character and reset otherwise.
|
7234 |
|
|
; This is now used to determine if the 'K' cursor is to be printed but this
|
7235 |
|
|
; transient state is also now transferred permanently to bit 3 of FLAGS
|
7236 |
|
|
; to let the interrupt routine know how to decode the next key.
|
7237 |
|
|
|
7238 |
|
|
;; OUT-C-1
|
7239 |
|
|
L18F3: LD HL,$5C3B ; Address FLAGS
|
7240 |
|
|
RES 3,(HL) ; signal 'K' mode initially.
|
7241 |
|
|
LD A,$4B ; prepare letter 'K'.
|
7242 |
|
|
BIT 2,(HL) ; test FLAGS - was the
|
7243 |
|
|
; previous main character ':' or 'THEN' ?
|
7244 |
|
|
JR Z,L1909 ; forward to OUT-C-2 if so to print.
|
7245 |
|
|
|
7246 |
|
|
SET 3,(HL) ; signal 'L' mode to interrupt routine.
|
7247 |
|
|
; Note. transient bit has been made permanent.
|
7248 |
|
|
INC A ; augment from 'K' to 'L'.
|
7249 |
|
|
|
7250 |
|
|
BIT 3,(IY+$30) ; test FLAGS2 - consider caps lock ?
|
7251 |
|
|
; which is maintained by KEY-INPUT.
|
7252 |
|
|
JR Z,L1909 ; forward to OUT-C-2 if not set to print.
|
7253 |
|
|
|
7254 |
|
|
LD A,$43 ; alter 'L' to 'C'.
|
7255 |
|
|
|
7256 |
|
|
;; OUT-C-2
|
7257 |
|
|
L1909: PUSH DE ; save address pointer but OK as OUT-FLASH
|
7258 |
|
|
; uses alternate set without RST 10.
|
7259 |
|
|
|
7260 |
|
|
CALL L18C1 ; routine OUT-FLASH to print.
|
7261 |
|
|
|
7262 |
|
|
POP DE ; restore and
|
7263 |
|
|
RET ; return.
|
7264 |
|
|
|
7265 |
|
|
; ----------------------------
|
7266 |
|
|
; Get line number of next line
|
7267 |
|
|
; ----------------------------
|
7268 |
|
|
; These two subroutines are called while editing.
|
7269 |
|
|
; This entry point is from ED-DOWN with HL addressing E_PPC
|
7270 |
|
|
; to fetch the next line number.
|
7271 |
|
|
; Also from AUTO-LIST with HL addressing S_TOP just to update S_TOP
|
7272 |
|
|
; with the value of the next line number. It gets fetched but is discarded.
|
7273 |
|
|
; These routines never get called while the editor is being used for input.
|
7274 |
|
|
|
7275 |
|
|
;; LN-FETCH
|
7276 |
|
|
L190F: LD E,(HL) ; fetch low byte
|
7277 |
|
|
INC HL ; address next
|
7278 |
|
|
LD D,(HL) ; fetch high byte.
|
7279 |
|
|
PUSH HL ; save system variable hi pointer.
|
7280 |
|
|
EX DE,HL ; line number to HL,
|
7281 |
|
|
INC HL ; increment as a starting point.
|
7282 |
|
|
CALL L196E ; routine LINE-ADDR gets address in HL.
|
7283 |
|
|
CALL L1695 ; routine LINE-NO gets line number in DE.
|
7284 |
|
|
POP HL ; restore system variable hi pointer.
|
7285 |
|
|
|
7286 |
|
|
; This entry point is from the ED-UP with HL addressing E_PPC_hi
|
7287 |
|
|
|
7288 |
|
|
;; LN-STORE
|
7289 |
|
|
L191C: BIT 5,(IY+$37) ; test FLAGX - input mode ?
|
7290 |
|
|
RET NZ ; return if so.
|
7291 |
|
|
; Note. above already checked by ED-UP/ED-DOWN.
|
7292 |
|
|
|
7293 |
|
|
LD (HL),D ; save high byte of line number.
|
7294 |
|
|
DEC HL ; address lower
|
7295 |
|
|
LD (HL),E ; save low byte of line number.
|
7296 |
|
|
RET ; return.
|
7297 |
|
|
|
7298 |
|
|
; -----------------------------------------
|
7299 |
|
|
; Outputting numbers at start of BASIC line
|
7300 |
|
|
; -----------------------------------------
|
7301 |
|
|
; This routine entered at OUT-SP-NO is used to compute then output the first
|
7302 |
|
|
; three digits of a 4-digit BASIC line printing a space if necessary.
|
7303 |
|
|
; The line number, or residual part, is held in HL and the BC register
|
7304 |
|
|
; holds a subtraction value -1000, -100 or -10.
|
7305 |
|
|
; Note. for example line number 200 -
|
7306 |
|
|
; space(out_char), 2(out_code), 0(out_char) final number always out-code.
|
7307 |
|
|
|
7308 |
|
|
;; OUT-SP-2
|
7309 |
|
|
L1925: LD A,E ; will be space if OUT-CODE not yet called.
|
7310 |
|
|
; or $FF if spaces are suppressed.
|
7311 |
|
|
; else $30 ('0').
|
7312 |
|
|
; (from the first instruction at OUT-CODE)
|
7313 |
|
|
; this guy is just too clever.
|
7314 |
|
|
AND A ; test bit 7 of A.
|
7315 |
|
|
RET M ; return if $FF, as leading spaces not
|
7316 |
|
|
; required. This is set when printing line
|
7317 |
|
|
; number and statement in MAIN-5.
|
7318 |
|
|
|
7319 |
|
|
JR L1937 ; forward to exit via OUT-CHAR.
|
7320 |
|
|
|
7321 |
|
|
; ---
|
7322 |
|
|
|
7323 |
|
|
; -> the single entry point.
|
7324 |
|
|
|
7325 |
|
|
;; OUT-SP-NO
|
7326 |
|
|
L192A: XOR A ; initialize digit to 0
|
7327 |
|
|
|
7328 |
|
|
;; OUT-SP-1
|
7329 |
|
|
L192B: ADD HL,BC ; add negative number to HL.
|
7330 |
|
|
INC A ; increment digit
|
7331 |
|
|
JR C,L192B ; back to OUT-SP-1 until no carry from
|
7332 |
|
|
; the addition.
|
7333 |
|
|
|
7334 |
|
|
SBC HL,BC ; cancel the last addition
|
7335 |
|
|
DEC A ; and decrement the digit.
|
7336 |
|
|
JR Z,L1925 ; back to OUT-SP-2 if it is zero.
|
7337 |
|
|
|
7338 |
|
|
JP L15EF ; jump back to exit via OUT-CODE. ->
|
7339 |
|
|
|
7340 |
|
|
|
7341 |
|
|
; -------------------------------------
|
7342 |
|
|
; Outputting characters in a BASIC line
|
7343 |
|
|
; -------------------------------------
|
7344 |
|
|
; This subroutine ...
|
7345 |
|
|
|
7346 |
|
|
;; OUT-CHAR
|
7347 |
|
|
L1937: CALL L2D1B ; routine NUMERIC tests if it is a digit ?
|
7348 |
|
|
JR NC,L196C ; to OUT-CH-3 to print digit without
|
7349 |
|
|
; changing mode. Will be 'K' mode if digits
|
7350 |
|
|
; are at beginning of edit line.
|
7351 |
|
|
|
7352 |
|
|
CP $21 ; less than quote character ?
|
7353 |
|
|
JR C,L196C ; to OUT-CH-3 to output controls and space.
|
7354 |
|
|
|
7355 |
|
|
RES 2,(IY+$01) ; initialize FLAGS to 'K' mode and leave
|
7356 |
|
|
; unchanged if this character would precede
|
7357 |
|
|
; a keyword.
|
7358 |
|
|
|
7359 |
|
|
CP $CB ; is character 'THEN' token ?
|
7360 |
|
|
JR Z,L196C ; to OUT-CH-3 to output if so.
|
7361 |
|
|
|
7362 |
|
|
CP $3A ; is it ':' ?
|
7363 |
|
|
JR NZ,L195A ; to OUT-CH-1 if not statement separator
|
7364 |
|
|
; to change mode back to 'L'.
|
7365 |
|
|
|
7366 |
|
|
BIT 5,(IY+$37) ; FLAGX - Input Mode ??
|
7367 |
|
|
JR NZ,L1968 ; to OUT-CH-2 if in input as no statements.
|
7368 |
|
|
; Note. this check should seemingly be at
|
7369 |
|
|
; the start. Commands seem inappropriate in
|
7370 |
|
|
; INPUT mode and are rejected by the syntax
|
7371 |
|
|
; checker anyway.
|
7372 |
|
|
; unless INPUT LINE is being used.
|
7373 |
|
|
|
7374 |
|
|
BIT 2,(IY+$30) ; test FLAGS2 - is the ':' within quotes ?
|
7375 |
|
|
JR Z,L196C ; to OUT-CH-3 if ':' is outside quoted text.
|
7376 |
|
|
|
7377 |
|
|
JR L1968 ; to OUT-CH-2 as ':' is within quotes
|
7378 |
|
|
|
7379 |
|
|
; ---
|
7380 |
|
|
|
7381 |
|
|
;; OUT-CH-1
|
7382 |
|
|
L195A: CP $22 ; is it quote character '"' ?
|
7383 |
|
|
JR NZ,L1968 ; to OUT-CH-2 with others to set 'L' mode.
|
7384 |
|
|
|
7385 |
|
|
PUSH AF ; save character.
|
7386 |
|
|
LD A,($5C6A) ; fetch FLAGS2.
|
7387 |
|
|
XOR $04 ; toggle the quotes flag.
|
7388 |
|
|
LD ($5C6A),A ; update FLAGS2
|
7389 |
|
|
POP AF ; and restore character.
|
7390 |
|
|
|
7391 |
|
|
;; OUT-CH-2
|
7392 |
|
|
L1968: SET 2,(IY+$01) ; update FLAGS - signal L mode if the cursor
|
7393 |
|
|
; is next.
|
7394 |
|
|
|
7395 |
|
|
;; OUT-CH-3
|
7396 |
|
|
L196C: RST 10H ; PRINT-A vectors the character to
|
7397 |
|
|
; channel 'S', 'K', 'R' or 'P'.
|
7398 |
|
|
RET ; return.
|
7399 |
|
|
|
7400 |
|
|
; -------------------------------------------
|
7401 |
|
|
; Get starting address of line, or line after
|
7402 |
|
|
; -------------------------------------------
|
7403 |
|
|
; This routine is used often to get the address, in HL, of a BASIC line
|
7404 |
|
|
; number supplied in HL, or failing that the address of the following line
|
7405 |
|
|
; and the address of the previous line in DE.
|
7406 |
|
|
|
7407 |
|
|
;; LINE-ADDR
|
7408 |
|
|
L196E: PUSH HL ; save line number in HL register
|
7409 |
|
|
LD HL,($5C53) ; fetch start of program from PROG
|
7410 |
|
|
LD D,H ; transfer address to
|
7411 |
|
|
LD E,L ; the DE register pair.
|
7412 |
|
|
|
7413 |
|
|
;; LINE-AD-1
|
7414 |
|
|
L1974: POP BC ; restore the line number to BC
|
7415 |
|
|
CALL L1980 ; routine CP-LINES compares with that
|
7416 |
|
|
; addressed by HL
|
7417 |
|
|
RET NC ; return if line has been passed or matched.
|
7418 |
|
|
; if NZ, address of previous is in DE
|
7419 |
|
|
|
7420 |
|
|
PUSH BC ; save the current line number
|
7421 |
|
|
CALL L19B8 ; routine NEXT-ONE finds address of next
|
7422 |
|
|
; line number in DE, previous in HL.
|
7423 |
|
|
EX DE,HL ; switch so next in HL
|
7424 |
|
|
JR L1974 ; back to LINE-AD-1 for another comparison
|
7425 |
|
|
|
7426 |
|
|
; --------------------
|
7427 |
|
|
; Compare line numbers
|
7428 |
|
|
; --------------------
|
7429 |
|
|
; This routine compares a line number supplied in BC with an addressed
|
7430 |
|
|
; line number pointed to by HL.
|
7431 |
|
|
|
7432 |
|
|
;; CP-LINES
|
7433 |
|
|
L1980: LD A,(HL) ; Load the high byte of line number and
|
7434 |
|
|
CP B ; compare with that of supplied line number.
|
7435 |
|
|
RET NZ ; return if yet to match (carry will be set).
|
7436 |
|
|
|
7437 |
|
|
INC HL ; address low byte of
|
7438 |
|
|
LD A,(HL) ; number and pick up in A.
|
7439 |
|
|
DEC HL ; step back to first position.
|
7440 |
|
|
CP C ; now compare.
|
7441 |
|
|
RET ; zero set if exact match.
|
7442 |
|
|
; carry set if yet to match.
|
7443 |
|
|
; no carry indicates a match or
|
7444 |
|
|
; next available BASIC line or
|
7445 |
|
|
; program end marker.
|
7446 |
|
|
|
7447 |
|
|
; -------------------
|
7448 |
|
|
; Find each statement
|
7449 |
|
|
; -------------------
|
7450 |
|
|
; The single entry point EACH-STMT is used to
|
7451 |
|
|
; 1) To find the D'th statement in a line.
|
7452 |
|
|
; 2) To find a token in held E.
|
7453 |
|
|
|
7454 |
|
|
;; not-used
|
7455 |
|
|
L1988: INC HL ;
|
7456 |
|
|
INC HL ;
|
7457 |
|
|
INC HL ;
|
7458 |
|
|
|
7459 |
|
|
; -> entry point.
|
7460 |
|
|
|
7461 |
|
|
;; EACH-STMT
|
7462 |
|
|
L198B: LD ($5C5D),HL ; save HL in CH_ADD
|
7463 |
|
|
LD C,$00 ; initialize quotes flag
|
7464 |
|
|
|
7465 |
|
|
;; EACH-S-1
|
7466 |
|
|
L1990: DEC D ; decrease statement count
|
7467 |
|
|
RET Z ; return if zero
|
7468 |
|
|
|
7469 |
|
|
|
7470 |
|
|
RST 20H ; NEXT-CHAR
|
7471 |
|
|
CP E ; is it the search token ?
|
7472 |
|
|
JR NZ,L199A ; forward to EACH-S-3 if not
|
7473 |
|
|
|
7474 |
|
|
AND A ; clear carry
|
7475 |
|
|
RET ; return signalling success.
|
7476 |
|
|
|
7477 |
|
|
; ---
|
7478 |
|
|
|
7479 |
|
|
;; EACH-S-2
|
7480 |
|
|
L1998: INC HL ; next address
|
7481 |
|
|
LD A,(HL) ; next character
|
7482 |
|
|
|
7483 |
|
|
;; EACH-S-3
|
7484 |
|
|
L199A: CALL L18B6 ; routine NUMBER skips if number marker
|
7485 |
|
|
LD ($5C5D),HL ; save in CH_ADD
|
7486 |
|
|
CP $22 ; is it quotes '"' ?
|
7487 |
|
|
JR NZ,L19A5 ; to EACH-S-4 if not
|
7488 |
|
|
|
7489 |
|
|
DEC C ; toggle bit 0 of C
|
7490 |
|
|
|
7491 |
|
|
;; EACH-S-4
|
7492 |
|
|
L19A5: CP $3A ; is it ':'
|
7493 |
|
|
JR Z,L19AD ; to EACH-S-5
|
7494 |
|
|
|
7495 |
|
|
CP $CB ; 'THEN'
|
7496 |
|
|
JR NZ,L19B1 ; to EACH-S-6
|
7497 |
|
|
|
7498 |
|
|
;; EACH-S-5
|
7499 |
|
|
L19AD: BIT 0,C ; is it in quotes
|
7500 |
|
|
JR Z,L1990 ; to EACH-S-1 if not
|
7501 |
|
|
|
7502 |
|
|
;; EACH-S-6
|
7503 |
|
|
L19B1: CP $0D ; end of line ?
|
7504 |
|
|
JR NZ,L1998 ; to EACH-S-2
|
7505 |
|
|
|
7506 |
|
|
DEC D ; decrease the statement counter
|
7507 |
|
|
; which should be zero else
|
7508 |
|
|
; 'Statement Lost'.
|
7509 |
|
|
SCF ; set carry flag - not found
|
7510 |
|
|
RET ; return
|
7511 |
|
|
|
7512 |
|
|
; -----------------------------------------------------------------------
|
7513 |
|
|
; Storage of variables. For full details - see chapter 24.
|
7514 |
|
|
; ZX Spectrum BASIC Programming by Steven Vickers 1982.
|
7515 |
|
|
; It is bits 7-5 of the first character of a variable that allow
|
7516 |
|
|
; the six types to be distinguished. Bits 4-0 are the reduced letter.
|
7517 |
|
|
; So any variable name is higher that $3F and can be distinguished
|
7518 |
|
|
; also from the variables area end-marker $80.
|
7519 |
|
|
;
|
7520 |
|
|
; 76543210 meaning brief outline of format.
|
7521 |
|
|
; -------- ------------------------ -----------------------
|
7522 |
|
|
; 010 string variable. 2 byte length + contents.
|
7523 |
|
|
; 110 string array. 2 byte length + contents.
|
7524 |
|
|
; 100 array of numbers. 2 byte length + contents.
|
7525 |
|
|
; 011 simple numeric variable. 5 bytes.
|
7526 |
|
|
; 101 variable length named numeric. 5 bytes.
|
7527 |
|
|
; 111 for-next loop variable. 18 bytes.
|
7528 |
|
|
; 10000000 the variables area end-marker.
|
7529 |
|
|
;
|
7530 |
|
|
; Note. any of the above seven will serve as a program end-marker.
|
7531 |
|
|
;
|
7532 |
|
|
; -----------------------------------------------------------------------
|
7533 |
|
|
|
7534 |
|
|
; ------------
|
7535 |
|
|
; Get next one
|
7536 |
|
|
; ------------
|
7537 |
|
|
; This versatile routine is used to find the address of the next line
|
7538 |
|
|
; in the program area or the next variable in the variables area.
|
7539 |
|
|
; The reason one routine is made to handle two apparently unrelated tasks
|
7540 |
|
|
; is that it can be called indiscriminately when merging a line or a
|
7541 |
|
|
; variable.
|
7542 |
|
|
|
7543 |
|
|
;; NEXT-ONE
|
7544 |
|
|
L19B8: PUSH HL ; save the pointer address.
|
7545 |
|
|
LD A,(HL) ; get first byte.
|
7546 |
|
|
CP $40 ; compare with upper limit for line numbers.
|
7547 |
|
|
JR C,L19D5 ; forward to NEXT-O-3 if within BASIC area.
|
7548 |
|
|
|
7549 |
|
|
; the continuation here is for the next variable unless the supplied
|
7550 |
|
|
; line number was erroneously over 16383. see RESTORE command.
|
7551 |
|
|
|
7552 |
|
|
BIT 5,A ; is it a string or an array variable ?
|
7553 |
|
|
JR Z,L19D6 ; forward to NEXT-O-4 to compute length.
|
7554 |
|
|
|
7555 |
|
|
ADD A,A ; test bit 6 for single-character variables.
|
7556 |
|
|
JP M,L19C7 ; forward to NEXT-O-1 if so
|
7557 |
|
|
|
7558 |
|
|
CCF ; clear the carry for long-named variables.
|
7559 |
|
|
; it remains set for for-next loop variables.
|
7560 |
|
|
|
7561 |
|
|
;; NEXT-O-1
|
7562 |
|
|
L19C7: LD BC,$0005 ; set BC to 5 for floating point number
|
7563 |
|
|
JR NC,L19CE ; forward to NEXT-O-2 if not a for/next
|
7564 |
|
|
; variable.
|
7565 |
|
|
|
7566 |
|
|
LD C,$12 ; set BC to eighteen locations.
|
7567 |
|
|
; value, limit, step, line and statement.
|
7568 |
|
|
|
7569 |
|
|
; now deal with long-named variables
|
7570 |
|
|
|
7571 |
|
|
;; NEXT-O-2
|
7572 |
|
|
L19CE: RLA ; test if character inverted. carry will also
|
7573 |
|
|
; be set for single character variables
|
7574 |
|
|
INC HL ; address next location.
|
7575 |
|
|
LD A,(HL) ; and load character.
|
7576 |
|
|
JR NC,L19CE ; back to NEXT-O-2 if not inverted bit.
|
7577 |
|
|
; forward immediately with single character
|
7578 |
|
|
; variable names.
|
7579 |
|
|
|
7580 |
|
|
JR L19DB ; forward to NEXT-O-5 to add length of
|
7581 |
|
|
; floating point number(s etc.).
|
7582 |
|
|
|
7583 |
|
|
; ---
|
7584 |
|
|
|
7585 |
|
|
; this branch is for line numbers.
|
7586 |
|
|
|
7587 |
|
|
;; NEXT-O-3
|
7588 |
|
|
L19D5: INC HL ; increment pointer to low byte of line no.
|
7589 |
|
|
|
7590 |
|
|
; strings and arrays rejoin here
|
7591 |
|
|
|
7592 |
|
|
;; NEXT-O-4
|
7593 |
|
|
L19D6: INC HL ; increment to address the length low byte.
|
7594 |
|
|
LD C,(HL) ; transfer to C and
|
7595 |
|
|
INC HL ; point to high byte of length.
|
7596 |
|
|
LD B,(HL) ; transfer that to B
|
7597 |
|
|
INC HL ; point to start of BASIC/variable contents.
|
7598 |
|
|
|
7599 |
|
|
; the three types of numeric variables rejoin here
|
7600 |
|
|
|
7601 |
|
|
;; NEXT-O-5
|
7602 |
|
|
L19DB: ADD HL,BC ; add the length to give address of next
|
7603 |
|
|
; line/variable in HL.
|
7604 |
|
|
POP DE ; restore previous address to DE.
|
7605 |
|
|
|
7606 |
|
|
; ------------------
|
7607 |
|
|
; Difference routine
|
7608 |
|
|
; ------------------
|
7609 |
|
|
; This routine terminates the above routine and is also called from the
|
7610 |
|
|
; start of the next routine to calculate the length to reclaim.
|
7611 |
|
|
|
7612 |
|
|
;; DIFFER
|
7613 |
|
|
L19DD: AND A ; prepare for true subtraction.
|
7614 |
|
|
SBC HL,DE ; subtract the two pointers.
|
7615 |
|
|
LD B,H ; transfer result
|
7616 |
|
|
LD C,L ; to BC register pair.
|
7617 |
|
|
ADD HL,DE ; add back
|
7618 |
|
|
EX DE,HL ; and switch pointers
|
7619 |
|
|
RET ; return values are the length of area in BC,
|
7620 |
|
|
; low pointer (previous) in HL,
|
7621 |
|
|
; high pointer (next) in DE.
|
7622 |
|
|
|
7623 |
|
|
; -----------------------
|
7624 |
|
|
; Handle reclaiming space
|
7625 |
|
|
; -----------------------
|
7626 |
|
|
;
|
7627 |
|
|
|
7628 |
|
|
;; RECLAIM-1
|
7629 |
|
|
L19E5: CALL L19DD ; routine DIFFER immediately above
|
7630 |
|
|
|
7631 |
|
|
;; RECLAIM-2
|
7632 |
|
|
L19E8: PUSH BC ;
|
7633 |
|
|
|
7634 |
|
|
LD A,B ;
|
7635 |
|
|
CPL ;
|
7636 |
|
|
LD B,A ;
|
7637 |
|
|
LD A,C ;
|
7638 |
|
|
CPL ;
|
7639 |
|
|
LD C,A ;
|
7640 |
|
|
INC BC ;
|
7641 |
|
|
|
7642 |
|
|
CALL L1664 ; routine POINTERS
|
7643 |
|
|
EX DE,HL ;
|
7644 |
|
|
POP HL ;
|
7645 |
|
|
|
7646 |
|
|
ADD HL,DE ;
|
7647 |
|
|
PUSH DE ;
|
7648 |
|
|
LDIR ; copy bytes
|
7649 |
|
|
|
7650 |
|
|
POP HL ;
|
7651 |
|
|
RET ;
|
7652 |
|
|
|
7653 |
|
|
; ----------------------------------------
|
7654 |
|
|
; Read line number of line in editing area
|
7655 |
|
|
; ----------------------------------------
|
7656 |
|
|
; This routine reads a line number in the editing area returning the number
|
7657 |
|
|
; in the BC register or zero if no digits exist before commands.
|
7658 |
|
|
; It is called from LINE-SCAN to check the syntax of the digits.
|
7659 |
|
|
; It is called from MAIN-3 to extract the line number in preparation for
|
7660 |
|
|
; inclusion of the line in the BASIC program area.
|
7661 |
|
|
;
|
7662 |
|
|
; Interestingly the calculator stack is moved from its normal place at the
|
7663 |
|
|
; end of dynamic memory to an adequate area within the system variables area.
|
7664 |
|
|
; This ensures that in a low memory situation, that valid line numbers can
|
7665 |
|
|
; be extracted without raising an error and that memory can be reclaimed
|
7666 |
|
|
; by deleting lines. If the stack was in its normal place then a situation
|
7667 |
|
|
; arises whereby the Spectrum becomes locked with no means of reclaiming space.
|
7668 |
|
|
|
7669 |
|
|
;; E-LINE-NO
|
7670 |
|
|
L19FB: LD HL,($5C59) ; load HL from system variable E_LINE.
|
7671 |
|
|
|
7672 |
|
|
DEC HL ; decrease so that NEXT_CHAR can be used
|
7673 |
|
|
; without skipping the first digit.
|
7674 |
|
|
|
7675 |
|
|
LD ($5C5D),HL ; store in the system variable CH_ADD.
|
7676 |
|
|
|
7677 |
|
|
RST 20H ; NEXT-CHAR skips any noise and white-space
|
7678 |
|
|
; to point exactly at the first digit.
|
7679 |
|
|
|
7680 |
|
|
LD HL,$5C92 ; use MEM-0 as a temporary calculator stack
|
7681 |
|
|
; an overhead of three locations are needed.
|
7682 |
|
|
LD ($5C65),HL ; set new STKEND.
|
7683 |
|
|
|
7684 |
|
|
CALL L2D3B ; routine INT-TO-FP will read digits till
|
7685 |
|
|
; a non-digit found.
|
7686 |
|
|
CALL L2DA2 ; routine FP-TO-BC will retrieve number
|
7687 |
|
|
; from stack at membot.
|
7688 |
|
|
JR C,L1A15 ; forward to E-L-1 if overflow i.e. > 65535.
|
7689 |
|
|
; 'Nonsense in BASIC'
|
7690 |
|
|
|
7691 |
|
|
LD HL,$D8F0 ; load HL with value -9999
|
7692 |
|
|
ADD HL,BC ; add to line number in BC
|
7693 |
|
|
|
7694 |
|
|
;; E-L-1
|
7695 |
|
|
L1A15: JP C,L1C8A ; to REPORT-C 'Nonsense in BASIC' if over.
|
7696 |
|
|
; Note. As ERR_SP points to ED_ERROR
|
7697 |
|
|
; the report is never produced although
|
7698 |
|
|
; the RST $08 will update X_PTR leading to
|
7699 |
|
|
; the error marker being displayed when
|
7700 |
|
|
; the ED_LOOP is reiterated.
|
7701 |
|
|
; in fact, since it is immediately
|
7702 |
|
|
; cancelled, any report will do.
|
7703 |
|
|
|
7704 |
|
|
; a line in the range 0 - 9999 has been entered.
|
7705 |
|
|
|
7706 |
|
|
JP L16C5 ; jump back to SET-STK to set the calculator
|
7707 |
|
|
; stack back to its normal place and exit
|
7708 |
|
|
; from there.
|
7709 |
|
|
|
7710 |
|
|
; ---------------------------------
|
7711 |
|
|
; Report and line number outputting
|
7712 |
|
|
; ---------------------------------
|
7713 |
|
|
; Entry point OUT-NUM-1 is used by the Error Reporting code to print
|
7714 |
|
|
; the line number and later the statement number held in BC.
|
7715 |
|
|
; If the statement was part of a direct command then -2 is used as a
|
7716 |
|
|
; dummy line number so that zero will be printed in the report.
|
7717 |
|
|
; This routine is also used to print the exponent of E-format numbers.
|
7718 |
|
|
;
|
7719 |
|
|
; Entry point OUT-NUM-2 is used from OUT-LINE to output the line number
|
7720 |
|
|
; addressed by HL with leading spaces if necessary.
|
7721 |
|
|
|
7722 |
|
|
;; OUT-NUM-1
|
7723 |
|
|
L1A1B: PUSH DE ; save the
|
7724 |
|
|
PUSH HL ; registers.
|
7725 |
|
|
XOR A ; set A to zero.
|
7726 |
|
|
BIT 7,B ; is the line number minus two ?
|
7727 |
|
|
JR NZ,L1A42 ; forward to OUT-NUM-4 if so to print zero
|
7728 |
|
|
; for a direct command.
|
7729 |
|
|
|
7730 |
|
|
LD H,B ; transfer the
|
7731 |
|
|
LD L,C ; number to HL.
|
7732 |
|
|
LD E,$FF ; signal 'no leading zeros'.
|
7733 |
|
|
JR L1A30 ; forward to continue at OUT-NUM-3
|
7734 |
|
|
|
7735 |
|
|
; ---
|
7736 |
|
|
|
7737 |
|
|
; from OUT-LINE - HL addresses line number.
|
7738 |
|
|
|
7739 |
|
|
;; OUT-NUM-2
|
7740 |
|
|
L1A28: PUSH DE ; save flags
|
7741 |
|
|
LD D,(HL) ; high byte to D
|
7742 |
|
|
INC HL ; address next
|
7743 |
|
|
LD E,(HL) ; low byte to E
|
7744 |
|
|
PUSH HL ; save pointer
|
7745 |
|
|
EX DE,HL ; transfer number to HL
|
7746 |
|
|
LD E,$20 ; signal 'output leading spaces'
|
7747 |
|
|
|
7748 |
|
|
;; OUT-NUM-3
|
7749 |
|
|
L1A30: LD BC,$FC18 ; value -1000
|
7750 |
|
|
CALL L192A ; routine OUT-SP-NO outputs space or number
|
7751 |
|
|
LD BC,$FF9C ; value -100
|
7752 |
|
|
CALL L192A ; routine OUT-SP-NO
|
7753 |
|
|
LD C,$F6 ; value -10 ( B is still $FF )
|
7754 |
|
|
CALL L192A ; routine OUT-SP-NO
|
7755 |
|
|
LD A,L ; remainder to A.
|
7756 |
|
|
|
7757 |
|
|
;; OUT-NUM-4
|
7758 |
|
|
L1A42: CALL L15EF ; routine OUT-CODE for final digit.
|
7759 |
|
|
; else report code zero wouldn't get
|
7760 |
|
|
; printed.
|
7761 |
|
|
POP HL ; restore the
|
7762 |
|
|
POP DE ; registers and
|
7763 |
|
|
RET ; return.
|
7764 |
|
|
|
7765 |
|
|
|
7766 |
|
|
;***************************************************
|
7767 |
|
|
;** Part 7. BASIC LINE AND COMMAND INTERPRETATION **
|
7768 |
|
|
;***************************************************
|
7769 |
|
|
|
7770 |
|
|
; ----------------
|
7771 |
|
|
; The offset table
|
7772 |
|
|
; ----------------
|
7773 |
|
|
; The BASIC interpreter has found a command code $CE - $FF
|
7774 |
|
|
; which is then reduced to range $00 - $31 and added to the base address
|
7775 |
|
|
; of this table to give the address of an offset which, when added to
|
7776 |
|
|
; the offset therein, gives the location in the following parameter table
|
7777 |
|
|
; where a list of class codes, separators and addresses relevant to the
|
7778 |
|
|
; command exists.
|
7779 |
|
|
|
7780 |
|
|
;; offst-tbl
|
7781 |
|
|
L1A48: DEFB L1AF9 - $ ; B1 offset to Address: P-DEF-FN
|
7782 |
|
|
DEFB L1B14 - $ ; CB offset to Address: P-CAT
|
7783 |
|
|
DEFB L1B06 - $ ; BC offset to Address: P-FORMAT
|
7784 |
|
|
DEFB L1B0A - $ ; BF offset to Address: P-MOVE
|
7785 |
|
|
DEFB L1B10 - $ ; C4 offset to Address: P-ERASE
|
7786 |
|
|
DEFB L1AFC - $ ; AF offset to Address: P-OPEN
|
7787 |
|
|
DEFB L1B02 - $ ; B4 offset to Address: P-CLOSE
|
7788 |
|
|
DEFB L1AE2 - $ ; 93 offset to Address: P-MERGE
|
7789 |
|
|
DEFB L1AE1 - $ ; 91 offset to Address: P-VERIFY
|
7790 |
|
|
DEFB L1AE3 - $ ; 92 offset to Address: P-BEEP
|
7791 |
|
|
DEFB L1AE7 - $ ; 95 offset to Address: P-CIRCLE
|
7792 |
|
|
DEFB L1AEB - $ ; 98 offset to Address: P-INK
|
7793 |
|
|
DEFB L1AEC - $ ; 98 offset to Address: P-PAPER
|
7794 |
|
|
DEFB L1AED - $ ; 98 offset to Address: P-FLASH
|
7795 |
|
|
DEFB L1AEE - $ ; 98 offset to Address: P-BRIGHT
|
7796 |
|
|
DEFB L1AEF - $ ; 98 offset to Address: P-INVERSE
|
7797 |
|
|
DEFB L1AF0 - $ ; 98 offset to Address: P-OVER
|
7798 |
|
|
DEFB L1AF1 - $ ; 98 offset to Address: P-OUT
|
7799 |
|
|
DEFB L1AD9 - $ ; 7F offset to Address: P-LPRINT
|
7800 |
|
|
DEFB L1ADC - $ ; 81 offset to Address: P-LLIST
|
7801 |
|
|
DEFB L1A8A - $ ; 2E offset to Address: P-STOP
|
7802 |
|
|
DEFB L1AC9 - $ ; 6C offset to Address: P-READ
|
7803 |
|
|
DEFB L1ACC - $ ; 6E offset to Address: P-DATA
|
7804 |
|
|
DEFB L1ACF - $ ; 70 offset to Address: P-RESTORE
|
7805 |
|
|
DEFB L1AA8 - $ ; 48 offset to Address: P-NEW
|
7806 |
|
|
DEFB L1AF5 - $ ; 94 offset to Address: P-BORDER
|
7807 |
|
|
DEFB L1AB8 - $ ; 56 offset to Address: P-CONT
|
7808 |
|
|
DEFB L1AA2 - $ ; 3F offset to Address: P-DIM
|
7809 |
|
|
DEFB L1AA5 - $ ; 41 offset to Address: P-REM
|
7810 |
|
|
DEFB L1A90 - $ ; 2B offset to Address: P-FOR
|
7811 |
|
|
DEFB L1A7D - $ ; 17 offset to Address: P-GO-TO
|
7812 |
|
|
DEFB L1A86 - $ ; 1F offset to Address: P-GO-SUB
|
7813 |
|
|
DEFB L1A9F - $ ; 37 offset to Address: P-INPUT
|
7814 |
|
|
DEFB L1AE0 - $ ; 77 offset to Address: P-LOAD
|
7815 |
|
|
DEFB L1AAE - $ ; 44 offset to Address: P-LIST
|
7816 |
|
|
DEFB L1A7A - $ ; 0F offset to Address: P-LET
|
7817 |
|
|
DEFB L1AC5 - $ ; 59 offset to Address: P-PAUSE
|
7818 |
|
|
DEFB L1A98 - $ ; 2B offset to Address: P-NEXT
|
7819 |
|
|
DEFB L1AB1 - $ ; 43 offset to Address: P-POKE
|
7820 |
|
|
DEFB L1A9C - $ ; 2D offset to Address: P-PRINT
|
7821 |
|
|
DEFB L1AC1 - $ ; 51 offset to Address: P-PLOT
|
7822 |
|
|
DEFB L1AAB - $ ; 3A offset to Address: P-RUN
|
7823 |
|
|
DEFB L1ADF - $ ; 6D offset to Address: P-SAVE
|
7824 |
|
|
DEFB L1AB5 - $ ; 42 offset to Address: P-RANDOM
|
7825 |
|
|
DEFB L1A81 - $ ; 0D offset to Address: P-IF
|
7826 |
|
|
DEFB L1ABE - $ ; 49 offset to Address: P-CLS
|
7827 |
|
|
DEFB L1AD2 - $ ; 5C offset to Address: P-DRAW
|
7828 |
|
|
DEFB L1ABB - $ ; 44 offset to Address: P-CLEAR
|
7829 |
|
|
DEFB L1A8D - $ ; 15 offset to Address: P-RETURN
|
7830 |
|
|
DEFB L1AD6 - $ ; 5D offset to Address: P-COPY
|
7831 |
|
|
|
7832 |
|
|
|
7833 |
|
|
; -------------------------------
|
7834 |
|
|
; The parameter or "Syntax" table
|
7835 |
|
|
; -------------------------------
|
7836 |
|
|
; For each command there exists a variable list of parameters.
|
7837 |
|
|
; If the character is greater than a space it is a required separator.
|
7838 |
|
|
; If less, then it is a command class in the range 00 - 0B.
|
7839 |
|
|
; Note that classes 00, 03 and 05 will fetch the addresses from this table.
|
7840 |
|
|
; Some classes e.g. 07 and 0B have the same address in all invocations
|
7841 |
|
|
; and the command is re-computed from the low-byte of the parameter address.
|
7842 |
|
|
; Some e.g. 02 are only called once so a call to the command is made from
|
7843 |
|
|
; within the class routine rather than holding the address within the table.
|
7844 |
|
|
; Some class routines check syntax entirely and some leave this task for the
|
7845 |
|
|
; command itself.
|
7846 |
|
|
; Others for example CIRCLE (x,y,z) check the first part (x,y) using the
|
7847 |
|
|
; class routine and the final part (,z) within the command.
|
7848 |
|
|
; The last few commands appear to have been added in a rush but their syntax
|
7849 |
|
|
; is rather simple e.g. MOVE "M1","M2"
|
7850 |
|
|
|
7851 |
|
|
;; P-LET
|
7852 |
|
|
L1A7A: DEFB $01 ; Class-01 - A variable is required.
|
7853 |
|
|
DEFB $3D ; Separator: '='
|
7854 |
|
|
DEFB $02 ; Class-02 - An expression, numeric or string,
|
7855 |
|
|
; must follow.
|
7856 |
|
|
|
7857 |
|
|
;; P-GO-TO
|
7858 |
|
|
L1A7D: DEFB $06 ; Class-06 - A numeric expression must follow.
|
7859 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
7860 |
|
|
DEFW L1E67 ; Address: $1E67; Address: GO-TO
|
7861 |
|
|
|
7862 |
|
|
;; P-IF
|
7863 |
|
|
L1A81: DEFB $06 ; Class-06 - A numeric expression must follow.
|
7864 |
|
|
DEFB $CB ; Separator: 'THEN'
|
7865 |
|
|
DEFB $05 ; Class-05 - Variable syntax checked
|
7866 |
|
|
; by routine.
|
7867 |
|
|
DEFW L1CF0 ; Address: $1CF0; Address: IF
|
7868 |
|
|
|
7869 |
|
|
;; P-GO-SUB
|
7870 |
|
|
L1A86: DEFB $06 ; Class-06 - A numeric expression must follow.
|
7871 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
7872 |
|
|
DEFW L1EED ; Address: $1EED; Address: GO-SUB
|
7873 |
|
|
|
7874 |
|
|
;; P-STOP
|
7875 |
|
|
L1A8A: DEFB $00 ; Class-00 - No further operands.
|
7876 |
|
|
DEFW L1CEE ; Address: $1CEE; Address: STOP
|
7877 |
|
|
|
7878 |
|
|
;; P-RETURN
|
7879 |
|
|
L1A8D: DEFB $00 ; Class-00 - No further operands.
|
7880 |
|
|
DEFW L1F23 ; Address: $1F23; Address: RETURN
|
7881 |
|
|
|
7882 |
|
|
;; P-FOR
|
7883 |
|
|
L1A90: DEFB $04 ; Class-04 - A single character variable must
|
7884 |
|
|
; follow.
|
7885 |
|
|
DEFB $3D ; Separator: '='
|
7886 |
|
|
DEFB $06 ; Class-06 - A numeric expression must follow.
|
7887 |
|
|
DEFB $CC ; Separator: 'TO'
|
7888 |
|
|
DEFB $06 ; Class-06 - A numeric expression must follow.
|
7889 |
|
|
DEFB $05 ; Class-05 - Variable syntax checked
|
7890 |
|
|
; by routine.
|
7891 |
|
|
DEFW L1D03 ; Address: $1D03; Address: FOR
|
7892 |
|
|
|
7893 |
|
|
;; P-NEXT
|
7894 |
|
|
L1A98: DEFB $04 ; Class-04 - A single character variable must
|
7895 |
|
|
; follow.
|
7896 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
7897 |
|
|
DEFW L1DAB ; Address: $1DAB; Address: NEXT
|
7898 |
|
|
|
7899 |
|
|
;; P-PRINT
|
7900 |
|
|
L1A9C: DEFB $05 ; Class-05 - Variable syntax checked entirely
|
7901 |
|
|
; by routine.
|
7902 |
|
|
DEFW L1FCD ; Address: $1FCD; Address: PRINT
|
7903 |
|
|
|
7904 |
|
|
;; P-INPUT
|
7905 |
|
|
L1A9F: DEFB $05 ; Class-05 - Variable syntax checked entirely
|
7906 |
|
|
; by routine.
|
7907 |
|
|
DEFW L2089 ; Address: $2089; Address: INPUT
|
7908 |
|
|
|
7909 |
|
|
;; P-DIM
|
7910 |
|
|
L1AA2: DEFB $05 ; Class-05 - Variable syntax checked entirely
|
7911 |
|
|
; by routine.
|
7912 |
|
|
DEFW L2C02 ; Address: $2C02; Address: DIM
|
7913 |
|
|
|
7914 |
|
|
;; P-REM
|
7915 |
|
|
L1AA5: DEFB $05 ; Class-05 - Variable syntax checked entirely
|
7916 |
|
|
; by routine.
|
7917 |
|
|
DEFW L1BB2 ; Address: $1BB2; Address: REM
|
7918 |
|
|
|
7919 |
|
|
;; P-NEW
|
7920 |
|
|
L1AA8: DEFB $00 ; Class-00 - No further operands.
|
7921 |
|
|
DEFW L11B7 ; Address: $11B7; Address: NEW
|
7922 |
|
|
|
7923 |
|
|
;; P-RUN
|
7924 |
|
|
L1AAB: DEFB $03 ; Class-03 - A numeric expression may follow
|
7925 |
|
|
; else default to zero.
|
7926 |
|
|
DEFW L1EA1 ; Address: $1EA1; Address: RUN
|
7927 |
|
|
|
7928 |
|
|
;; P-LIST
|
7929 |
|
|
L1AAE: DEFB $05 ; Class-05 - Variable syntax checked entirely
|
7930 |
|
|
; by routine.
|
7931 |
|
|
DEFW L17F9 ; Address: $17F9; Address: LIST
|
7932 |
|
|
|
7933 |
|
|
;; P-POKE
|
7934 |
|
|
L1AB1: DEFB $08 ; Class-08 - Two comma-separated numeric
|
7935 |
|
|
; expressions required.
|
7936 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
7937 |
|
|
DEFW L1E80 ; Address: $1E80; Address: POKE
|
7938 |
|
|
|
7939 |
|
|
;; P-RANDOM
|
7940 |
|
|
L1AB5: DEFB $03 ; Class-03 - A numeric expression may follow
|
7941 |
|
|
; else default to zero.
|
7942 |
|
|
DEFW L1E4F ; Address: $1E4F; Address: RANDOMIZE
|
7943 |
|
|
|
7944 |
|
|
;; P-CONT
|
7945 |
|
|
L1AB8: DEFB $00 ; Class-00 - No further operands.
|
7946 |
|
|
DEFW L1E5F ; Address: $1E5F; Address: CONTINUE
|
7947 |
|
|
|
7948 |
|
|
;; P-CLEAR
|
7949 |
|
|
L1ABB: DEFB $03 ; Class-03 - A numeric expression may follow
|
7950 |
|
|
; else default to zero.
|
7951 |
|
|
DEFW L1EAC ; Address: $1EAC; Address: CLEAR
|
7952 |
|
|
|
7953 |
|
|
;; P-CLS
|
7954 |
|
|
L1ABE: DEFB $00 ; Class-00 - No further operands.
|
7955 |
|
|
DEFW L0D6B ; Address: $0D6B; Address: CLS
|
7956 |
|
|
|
7957 |
|
|
;; P-PLOT
|
7958 |
|
|
L1AC1: DEFB $09 ; Class-09 - Two comma-separated numeric
|
7959 |
|
|
; expressions required with optional colour
|
7960 |
|
|
; items.
|
7961 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
7962 |
|
|
DEFW L22DC ; Address: $22DC; Address: PLOT
|
7963 |
|
|
|
7964 |
|
|
;; P-PAUSE
|
7965 |
|
|
L1AC5: DEFB $06 ; Class-06 - A numeric expression must follow.
|
7966 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
7967 |
|
|
DEFW L1F3A ; Address: $1F3A; Address: PAUSE
|
7968 |
|
|
|
7969 |
|
|
;; P-READ
|
7970 |
|
|
L1AC9: DEFB $05 ; Class-05 - Variable syntax checked entirely
|
7971 |
|
|
; by routine.
|
7972 |
|
|
DEFW L1DED ; Address: $1DED; Address: READ
|
7973 |
|
|
|
7974 |
|
|
;; P-DATA
|
7975 |
|
|
L1ACC: DEFB $05 ; Class-05 - Variable syntax checked entirely
|
7976 |
|
|
; by routine.
|
7977 |
|
|
DEFW L1E27 ; Address: $1E27; Address: DATA
|
7978 |
|
|
|
7979 |
|
|
;; P-RESTORE
|
7980 |
|
|
L1ACF: DEFB $03 ; Class-03 - A numeric expression may follow
|
7981 |
|
|
; else default to zero.
|
7982 |
|
|
DEFW L1E42 ; Address: $1E42; Address: RESTORE
|
7983 |
|
|
|
7984 |
|
|
;; P-DRAW
|
7985 |
|
|
L1AD2: DEFB $09 ; Class-09 - Two comma-separated numeric
|
7986 |
|
|
; expressions required with optional colour
|
7987 |
|
|
; items.
|
7988 |
|
|
DEFB $05 ; Class-05 - Variable syntax checked
|
7989 |
|
|
; by routine.
|
7990 |
|
|
DEFW L2382 ; Address: $2382; Address: DRAW
|
7991 |
|
|
|
7992 |
|
|
;; P-COPY
|
7993 |
|
|
L1AD6: DEFB $00 ; Class-00 - No further operands.
|
7994 |
|
|
DEFW L0EAC ; Address: $0EAC; Address: COPY
|
7995 |
|
|
|
7996 |
|
|
;; P-LPRINT
|
7997 |
|
|
L1AD9: DEFB $05 ; Class-05 - Variable syntax checked entirely
|
7998 |
|
|
; by routine.
|
7999 |
|
|
DEFW L1FC9 ; Address: $1FC9; Address: LPRINT
|
8000 |
|
|
|
8001 |
|
|
;; P-LLIST
|
8002 |
|
|
L1ADC: DEFB $05 ; Class-05 - Variable syntax checked entirely
|
8003 |
|
|
; by routine.
|
8004 |
|
|
DEFW L17F5 ; Address: $17F5; Address: LLIST
|
8005 |
|
|
|
8006 |
|
|
;; P-SAVE
|
8007 |
|
|
L1ADF: DEFB $0B ; Class-0B - Offset address converted to tape
|
8008 |
|
|
; command.
|
8009 |
|
|
|
8010 |
|
|
;; P-LOAD
|
8011 |
|
|
L1AE0: DEFB $0B ; Class-0B - Offset address converted to tape
|
8012 |
|
|
; command.
|
8013 |
|
|
|
8014 |
|
|
;; P-VERIFY
|
8015 |
|
|
L1AE1: DEFB $0B ; Class-0B - Offset address converted to tape
|
8016 |
|
|
; command.
|
8017 |
|
|
|
8018 |
|
|
;; P-MERGE
|
8019 |
|
|
L1AE2: DEFB $0B ; Class-0B - Offset address converted to tape
|
8020 |
|
|
; command.
|
8021 |
|
|
|
8022 |
|
|
;; P-BEEP
|
8023 |
|
|
L1AE3: DEFB $08 ; Class-08 - Two comma-separated numeric
|
8024 |
|
|
; expressions required.
|
8025 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
8026 |
|
|
DEFW L03F8 ; Address: $03F8; Address: BEEP
|
8027 |
|
|
|
8028 |
|
|
;; P-CIRCLE
|
8029 |
|
|
L1AE7: DEFB $09 ; Class-09 - Two comma-separated numeric
|
8030 |
|
|
; expressions required with optional colour
|
8031 |
|
|
; items.
|
8032 |
|
|
DEFB $05 ; Class-05 - Variable syntax checked
|
8033 |
|
|
; by routine.
|
8034 |
|
|
DEFW L2320 ; Address: $2320; Address: CIRCLE
|
8035 |
|
|
|
8036 |
|
|
;; P-INK
|
8037 |
|
|
L1AEB: DEFB $07 ; Class-07 - Offset address is converted to
|
8038 |
|
|
; colour code.
|
8039 |
|
|
|
8040 |
|
|
;; P-PAPER
|
8041 |
|
|
L1AEC: DEFB $07 ; Class-07 - Offset address is converted to
|
8042 |
|
|
; colour code.
|
8043 |
|
|
|
8044 |
|
|
;; P-FLASH
|
8045 |
|
|
L1AED: DEFB $07 ; Class-07 - Offset address is converted to
|
8046 |
|
|
; colour code.
|
8047 |
|
|
|
8048 |
|
|
;; P-BRIGHT
|
8049 |
|
|
L1AEE: DEFB $07 ; Class-07 - Offset address is converted to
|
8050 |
|
|
; colour code.
|
8051 |
|
|
|
8052 |
|
|
;; P-INVERSE
|
8053 |
|
|
L1AEF: DEFB $07 ; Class-07 - Offset address is converted to
|
8054 |
|
|
; colour code.
|
8055 |
|
|
|
8056 |
|
|
;; P-OVER
|
8057 |
|
|
L1AF0: DEFB $07 ; Class-07 - Offset address is converted to
|
8058 |
|
|
; colour code.
|
8059 |
|
|
|
8060 |
|
|
;; P-OUT
|
8061 |
|
|
L1AF1: DEFB $08 ; Class-08 - Two comma-separated numeric
|
8062 |
|
|
; expressions required.
|
8063 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
8064 |
|
|
DEFW L1E7A ; Address: $1E7A; Address: OUT
|
8065 |
|
|
|
8066 |
|
|
;; P-BORDER
|
8067 |
|
|
L1AF5: DEFB $06 ; Class-06 - A numeric expression must follow.
|
8068 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
8069 |
|
|
DEFW L2294 ; Address: $2294; Address: BORDER
|
8070 |
|
|
|
8071 |
|
|
;; P-DEF-FN
|
8072 |
|
|
L1AF9: DEFB $05 ; Class-05 - Variable syntax checked entirely
|
8073 |
|
|
; by routine.
|
8074 |
|
|
DEFW L1F60 ; Address: $1F60; Address: DEF-FN
|
8075 |
|
|
|
8076 |
|
|
;; P-OPEN
|
8077 |
|
|
L1AFC: DEFB $06 ; Class-06 - A numeric expression must follow.
|
8078 |
|
|
DEFB $2C ; Separator: ',' see Footnote *
|
8079 |
|
|
DEFB $0A ; Class-0A - A string expression must follow.
|
8080 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
8081 |
|
|
DEFW L1736 ; Address: $1736; Address: OPEN
|
8082 |
|
|
|
8083 |
|
|
;; P-CLOSE
|
8084 |
|
|
L1B02: DEFB $06 ; Class-06 - A numeric expression must follow.
|
8085 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
8086 |
|
|
DEFW L16E5 ; Address: $16E5; Address: CLOSE
|
8087 |
|
|
|
8088 |
|
|
;; P-FORMAT
|
8089 |
|
|
L1B06: DEFB $0A ; Class-0A - A string expression must follow.
|
8090 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
8091 |
|
|
DEFW L1793 ; Address: $1793; Address: CAT-ETC
|
8092 |
|
|
|
8093 |
|
|
;; P-MOVE
|
8094 |
|
|
L1B0A: DEFB $0A ; Class-0A - A string expression must follow.
|
8095 |
|
|
DEFB $2C ; Separator: ','
|
8096 |
|
|
DEFB $0A ; Class-0A - A string expression must follow.
|
8097 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
8098 |
|
|
DEFW L1793 ; Address: $1793; Address: CAT-ETC
|
8099 |
|
|
|
8100 |
|
|
;; P-ERASE
|
8101 |
|
|
L1B10: DEFB $0A ; Class-0A - A string expression must follow.
|
8102 |
|
|
DEFB $00 ; Class-00 - No further operands.
|
8103 |
|
|
DEFW L1793 ; Address: $1793; Address: CAT-ETC
|
8104 |
|
|
|
8105 |
|
|
;; P-CAT
|
8106 |
|
|
L1B14: DEFB $00 ; Class-00 - No further operands.
|
8107 |
|
|
DEFW L1793 ; Address: $1793; Address: CAT-ETC
|
8108 |
|
|
|
8109 |
|
|
; * Note that a comma is required as a separator with the OPEN command
|
8110 |
|
|
; but the Interface 1 programmers relaxed this allowing ';' as an
|
8111 |
|
|
; alternative for their channels creating a confusing mixture of
|
8112 |
|
|
; allowable syntax as it is this ROM which opens or re-opens the
|
8113 |
|
|
; normal channels.
|
8114 |
|
|
|
8115 |
|
|
; -------------------------------
|
8116 |
|
|
; Main parser (BASIC interpreter)
|
8117 |
|
|
; -------------------------------
|
8118 |
|
|
; This routine is called once from MAIN-2 when the BASIC line is to
|
8119 |
|
|
; be entered or re-entered into the Program area and the syntax
|
8120 |
|
|
; requires checking.
|
8121 |
|
|
|
8122 |
|
|
;; LINE-SCAN
|
8123 |
|
|
L1B17: RES 7,(IY+$01) ; update FLAGS - signal checking syntax
|
8124 |
|
|
CALL L19FB ; routine E-LINE-NO >>
|
8125 |
|
|
; fetches the line number if in range.
|
8126 |
|
|
|
8127 |
|
|
XOR A ; clear the accumulator.
|
8128 |
|
|
LD ($5C47),A ; set statement number SUBPPC to zero.
|
8129 |
|
|
DEC A ; set accumulator to $FF.
|
8130 |
|
|
LD ($5C3A),A ; set ERR_NR to 'OK' - 1.
|
8131 |
|
|
JR L1B29 ; forward to continue at STMT-L-1.
|
8132 |
|
|
|
8133 |
|
|
; --------------
|
8134 |
|
|
; Statement loop
|
8135 |
|
|
; --------------
|
8136 |
|
|
;
|
8137 |
|
|
;
|
8138 |
|
|
|
8139 |
|
|
;; STMT-LOOP
|
8140 |
|
|
L1B28: RST 20H ; NEXT-CHAR
|
8141 |
|
|
|
8142 |
|
|
; -> the entry point from above or LINE-RUN
|
8143 |
|
|
;; STMT-L-1
|
8144 |
|
|
L1B29: CALL L16BF ; routine SET-WORK clears workspace etc.
|
8145 |
|
|
|
8146 |
|
|
INC (IY+$0D) ; increment statement number SUBPPC
|
8147 |
|
|
JP M,L1C8A ; to REPORT-C to raise
|
8148 |
|
|
; 'Nonsense in BASIC' if over 127.
|
8149 |
|
|
|
8150 |
|
|
RST 18H ; GET-CHAR
|
8151 |
|
|
|
8152 |
|
|
LD B,$00 ; set B to zero for later indexing.
|
8153 |
|
|
; early so any other reason ???
|
8154 |
|
|
|
8155 |
|
|
CP $0D ; is character carriage return ?
|
8156 |
|
|
; i.e. an empty statement.
|
8157 |
|
|
JR Z,L1BB3 ; forward to LINE-END if so.
|
8158 |
|
|
|
8159 |
|
|
CP $3A ; is it statement end marker ':' ?
|
8160 |
|
|
; i.e. another type of empty statement.
|
8161 |
|
|
JR Z,L1B28 ; back to STMT-LOOP if so.
|
8162 |
|
|
|
8163 |
|
|
LD HL,L1B76 ; address: STMT-RET
|
8164 |
|
|
PUSH HL ; is now pushed as a return address
|
8165 |
|
|
LD C,A ; transfer the current character to C.
|
8166 |
|
|
|
8167 |
|
|
; advance CH_ADD to a position after command and test if it is a command.
|
8168 |
|
|
|
8169 |
|
|
RST 20H ; NEXT-CHAR to advance pointer
|
8170 |
|
|
LD A,C ; restore current character
|
8171 |
|
|
SUB $CE ; subtract 'DEF FN' - first command
|
8172 |
|
|
JP C,L1C8A ; jump to REPORT-C if less than a command
|
8173 |
|
|
; raising
|
8174 |
|
|
; 'Nonsense in BASIC'
|
8175 |
|
|
|
8176 |
|
|
LD C,A ; put the valid command code back in C.
|
8177 |
|
|
; register B is zero.
|
8178 |
|
|
LD HL,L1A48 ; address: offst-tbl
|
8179 |
|
|
ADD HL,BC ; index into table with one of 50 commands.
|
8180 |
|
|
LD C,(HL) ; pick up displacement to syntax table entry.
|
8181 |
|
|
ADD HL,BC ; add to address the relevant entry.
|
8182 |
|
|
JR L1B55 ; forward to continue at GET-PARAM
|
8183 |
|
|
|
8184 |
|
|
; ----------------------
|
8185 |
|
|
; The main scanning loop
|
8186 |
|
|
; ----------------------
|
8187 |
|
|
; not documented properly
|
8188 |
|
|
;
|
8189 |
|
|
|
8190 |
|
|
;; SCAN-LOOP
|
8191 |
|
|
L1B52: LD HL,($5C74) ; fetch temporary address from T_ADDR
|
8192 |
|
|
; during subsequent loops.
|
8193 |
|
|
|
8194 |
|
|
; -> the initial entry point with HL addressing start of syntax table entry.
|
8195 |
|
|
|
8196 |
|
|
;; GET-PARAM
|
8197 |
|
|
L1B55: LD A,(HL) ; pick up the parameter.
|
8198 |
|
|
INC HL ; address next one.
|
8199 |
|
|
LD ($5C74),HL ; save pointer in system variable T_ADDR
|
8200 |
|
|
|
8201 |
|
|
LD BC,L1B52 ; address: SCAN-LOOP
|
8202 |
|
|
PUSH BC ; is now pushed on stack as looping address.
|
8203 |
|
|
LD C,A ; store parameter in C.
|
8204 |
|
|
CP $20 ; is it greater than ' ' ?
|
8205 |
|
|
JR NC,L1B6F ; forward to SEPARATOR to check that correct
|
8206 |
|
|
; separator appears in statement if so.
|
8207 |
|
|
|
8208 |
|
|
LD HL,L1C01 ; address: class-tbl.
|
8209 |
|
|
LD B,$00 ; prepare to index into the class table.
|
8210 |
|
|
ADD HL,BC ; index to find displacement to routine.
|
8211 |
|
|
LD C,(HL) ; displacement to BC
|
8212 |
|
|
ADD HL,BC ; add to address the CLASS routine.
|
8213 |
|
|
PUSH HL ; push the address on the stack.
|
8214 |
|
|
|
8215 |
|
|
RST 18H ; GET-CHAR - HL points to place in statement.
|
8216 |
|
|
|
8217 |
|
|
DEC B ; reset the zero flag - the initial state
|
8218 |
|
|
; for all class routines.
|
8219 |
|
|
|
8220 |
|
|
RET ; and make an indirect jump to routine
|
8221 |
|
|
; and then SCAN-LOOP (also on stack).
|
8222 |
|
|
|
8223 |
|
|
; Note. one of the class routines will eventually drop the return address
|
8224 |
|
|
; off the stack breaking out of the above seemingly endless loop.
|
8225 |
|
|
|
8226 |
|
|
; -----------------------
|
8227 |
|
|
; THE 'SEPARATOR' ROUTINE
|
8228 |
|
|
; -----------------------
|
8229 |
|
|
; This routine is called once to verify that the mandatory separator
|
8230 |
|
|
; present in the parameter table is also present in the correct
|
8231 |
|
|
; location following the command. For example, the 'THEN' token after
|
8232 |
|
|
; the 'IF' token and expression.
|
8233 |
|
|
|
8234 |
|
|
;; SEPARATOR
|
8235 |
|
|
L1B6F: RST 18H ; GET-CHAR
|
8236 |
|
|
CP C ; does it match the character in C ?
|
8237 |
|
|
JP NZ,L1C8A ; jump forward to REPORT-C if not
|
8238 |
|
|
; 'Nonsense in BASIC'.
|
8239 |
|
|
|
8240 |
|
|
RST 20H ; NEXT-CHAR advance to next character
|
8241 |
|
|
RET ; return.
|
8242 |
|
|
|
8243 |
|
|
; ------------------------------
|
8244 |
|
|
; Come here after interpretation
|
8245 |
|
|
; ------------------------------
|
8246 |
|
|
;
|
8247 |
|
|
;
|
8248 |
|
|
|
8249 |
|
|
;; STMT-RET
|
8250 |
|
|
L1B76: CALL L1F54 ; routine BREAK-KEY is tested after every
|
8251 |
|
|
; statement.
|
8252 |
|
|
JR C,L1B7D ; step forward to STMT-R-1 if not pressed.
|
8253 |
|
|
|
8254 |
|
|
;; REPORT-L
|
8255 |
|
|
L1B7B: RST 08H ; ERROR-1
|
8256 |
|
|
DEFB $14 ; Error Report: BREAK into program
|
8257 |
|
|
|
8258 |
|
|
;; STMT-R-1
|
8259 |
|
|
L1B7D: BIT 7,(IY+$0A) ; test NSPPC - will be set if $FF -
|
8260 |
|
|
; no jump to be made.
|
8261 |
|
|
JR NZ,L1BF4 ; forward to STMT-NEXT if a program line.
|
8262 |
|
|
|
8263 |
|
|
LD HL,($5C42) ; fetch line number from NEWPPC
|
8264 |
|
|
BIT 7,H ; will be set if minus two - direct command(s)
|
8265 |
|
|
JR Z,L1B9E ; forward to LINE-NEW if a jump is to be
|
8266 |
|
|
; made to a new program line/statement.
|
8267 |
|
|
|
8268 |
|
|
; --------------------
|
8269 |
|
|
; Run a direct command
|
8270 |
|
|
; --------------------
|
8271 |
|
|
; A direct command is to be run or, if continuing from above,
|
8272 |
|
|
; the next statement of a direct command is to be considered.
|
8273 |
|
|
|
8274 |
|
|
;; LINE-RUN
|
8275 |
|
|
L1B8A: LD HL,$FFFE ; The dummy value minus two
|
8276 |
|
|
LD ($5C45),HL ; is set/reset as line number in PPC.
|
8277 |
|
|
LD HL,($5C61) ; point to end of line + 1 - WORKSP.
|
8278 |
|
|
DEC HL ; now point to $80 end-marker.
|
8279 |
|
|
LD DE,($5C59) ; address the start of line E_LINE.
|
8280 |
|
|
DEC DE ; now location before - for GET-CHAR.
|
8281 |
|
|
LD A,($5C44) ; load statement to A from NSPPC.
|
8282 |
|
|
JR L1BD1 ; forward to NEXT-LINE.
|
8283 |
|
|
|
8284 |
|
|
; ------------------------------
|
8285 |
|
|
; Find start address of new line
|
8286 |
|
|
; ------------------------------
|
8287 |
|
|
; The branch was to here if a jump is to made to a new line number
|
8288 |
|
|
; and statement.
|
8289 |
|
|
; That is the previous statement was a GO TO, GO SUB, RUN, RETURN, NEXT etc..
|
8290 |
|
|
|
8291 |
|
|
;; LINE-NEW
|
8292 |
|
|
L1B9E: CALL L196E ; routine LINE-ADDR gets address of line
|
8293 |
|
|
; returning zero flag set if line found.
|
8294 |
|
|
LD A,($5C44) ; fetch new statement from NSPPC
|
8295 |
|
|
JR Z,L1BBF ; forward to LINE-USE if line matched.
|
8296 |
|
|
|
8297 |
|
|
; continue as must be a direct command.
|
8298 |
|
|
|
8299 |
|
|
AND A ; test statement which should be zero
|
8300 |
|
|
JR NZ,L1BEC ; forward to REPORT-N if not.
|
8301 |
|
|
; 'Statement lost'
|
8302 |
|
|
|
8303 |
|
|
;
|
8304 |
|
|
|
8305 |
|
|
LD B,A ; save statement in B.??
|
8306 |
|
|
LD A,(HL) ; fetch high byte of line number.
|
8307 |
|
|
AND $C0 ; test if using direct command
|
8308 |
|
|
; a program line is less than $3F
|
8309 |
|
|
LD A,B ; retrieve statement.
|
8310 |
|
|
; (we can assume it is zero).
|
8311 |
|
|
JR Z,L1BBF ; forward to LINE-USE if was a program line
|
8312 |
|
|
|
8313 |
|
|
; Alternatively a direct statement has finished correctly.
|
8314 |
|
|
|
8315 |
|
|
;; REPORT-0
|
8316 |
|
|
L1BB0: RST 08H ; ERROR-1
|
8317 |
|
|
DEFB $FF ; Error Report: OK
|
8318 |
|
|
|
8319 |
|
|
; -----------------
|
8320 |
|
|
; THE 'REM' COMMAND
|
8321 |
|
|
; -----------------
|
8322 |
|
|
; The REM command routine.
|
8323 |
|
|
; The return address STMT-RET is dropped and the rest of line ignored.
|
8324 |
|
|
|
8325 |
|
|
;; REM
|
8326 |
|
|
L1BB2: POP BC ; drop return address STMT-RET and
|
8327 |
|
|
; continue ignoring rest of line.
|
8328 |
|
|
|
8329 |
|
|
; ------------
|
8330 |
|
|
; End of line?
|
8331 |
|
|
; ------------
|
8332 |
|
|
;
|
8333 |
|
|
;
|
8334 |
|
|
|
8335 |
|
|
;; LINE-END
|
8336 |
|
|
L1BB3: CALL L2530 ; routine SYNTAX-Z (UNSTACK-Z?)
|
8337 |
|
|
RET Z ; return if checking syntax.
|
8338 |
|
|
|
8339 |
|
|
LD HL,($5C55) ; fetch NXTLIN to HL.
|
8340 |
|
|
LD A,$C0 ; test against the
|
8341 |
|
|
AND (HL) ; system limit $3F.
|
8342 |
|
|
RET NZ ; return if more as must be
|
8343 |
|
|
; end of program.
|
8344 |
|
|
; (or direct command)
|
8345 |
|
|
|
8346 |
|
|
XOR A ; set statement to zero.
|
8347 |
|
|
|
8348 |
|
|
; and continue to set up the next following line and then consider this new one.
|
8349 |
|
|
|
8350 |
|
|
; ---------------------
|
8351 |
|
|
; General line checking
|
8352 |
|
|
; ---------------------
|
8353 |
|
|
; The branch was here from LINE-NEW if BASIC is branching.
|
8354 |
|
|
; or a continuation from above if dealing with a new sequential line.
|
8355 |
|
|
; First make statement zero number one leaving others unaffected.
|
8356 |
|
|
|
8357 |
|
|
;; LINE-USE
|
8358 |
|
|
L1BBF: CP $01 ; will set carry if zero.
|
8359 |
|
|
ADC A,$00 ; add in any carry.
|
8360 |
|
|
|
8361 |
|
|
LD D,(HL) ; high byte of line number to D.
|
8362 |
|
|
INC HL ; advance pointer.
|
8363 |
|
|
LD E,(HL) ; low byte of line number to E.
|
8364 |
|
|
LD ($5C45),DE ; set system variable PPC.
|
8365 |
|
|
|
8366 |
|
|
INC HL ; advance pointer.
|
8367 |
|
|
LD E,(HL) ; low byte of line length to E.
|
8368 |
|
|
INC HL ; advance pointer.
|
8369 |
|
|
LD D,(HL) ; high byte of line length to D.
|
8370 |
|
|
|
8371 |
|
|
EX DE,HL ; swap pointer to DE before
|
8372 |
|
|
ADD HL,DE ; adding to address the end of line.
|
8373 |
|
|
INC HL ; advance to start of next line.
|
8374 |
|
|
|
8375 |
|
|
; -----------------------------
|
8376 |
|
|
; Update NEXT LINE but consider
|
8377 |
|
|
; previous line or edit line.
|
8378 |
|
|
; -----------------------------
|
8379 |
|
|
; The pointer will be the next line if continuing from above or to
|
8380 |
|
|
; edit line end-marker ($80) if from LINE-RUN.
|
8381 |
|
|
|
8382 |
|
|
;; NEXT-LINE
|
8383 |
|
|
L1BD1: LD ($5C55),HL ; store pointer in system variable NXTLIN
|
8384 |
|
|
|
8385 |
|
|
EX DE,HL ; bring back pointer to previous or edit line
|
8386 |
|
|
LD ($5C5D),HL ; and update CH_ADD with character address.
|
8387 |
|
|
|
8388 |
|
|
LD D,A ; store statement in D.
|
8389 |
|
|
LD E,$00 ; set E to zero to suppress token searching
|
8390 |
|
|
; if EACH-STMT is to be called.
|
8391 |
|
|
LD (IY+$0A),$FF ; set statement NSPPC to $FF signalling
|
8392 |
|
|
; no jump to be made.
|
8393 |
|
|
DEC D ; decrement and test statement
|
8394 |
|
|
LD (IY+$0D),D ; set SUBPPC to decremented statement number.
|
8395 |
|
|
JP Z,L1B28 ; to STMT-LOOP if result zero as statement is
|
8396 |
|
|
; at start of line and address is known.
|
8397 |
|
|
|
8398 |
|
|
INC D ; else restore statement.
|
8399 |
|
|
CALL L198B ; routine EACH-STMT finds the D'th statement
|
8400 |
|
|
; address as E does not contain a token.
|
8401 |
|
|
JR Z,L1BF4 ; forward to STMT-NEXT if address found.
|
8402 |
|
|
|
8403 |
|
|
;; REPORT-N
|
8404 |
|
|
L1BEC: RST 08H ; ERROR-1
|
8405 |
|
|
DEFB $16 ; Error Report: Statement lost
|
8406 |
|
|
|
8407 |
|
|
; -----------------
|
8408 |
|
|
; End of statement?
|
8409 |
|
|
; -----------------
|
8410 |
|
|
; This combination of routines is called from 20 places when
|
8411 |
|
|
; the end of a statement should have been reached and all preceding
|
8412 |
|
|
; syntax is in order.
|
8413 |
|
|
|
8414 |
|
|
;; CHECK-END
|
8415 |
|
|
L1BEE: CALL L2530 ; routine SYNTAX-Z
|
8416 |
|
|
RET NZ ; return immediately in runtime
|
8417 |
|
|
|
8418 |
|
|
POP BC ; drop address of calling routine.
|
8419 |
|
|
POP BC ; drop address STMT-RET.
|
8420 |
|
|
; and continue to find next statement.
|
8421 |
|
|
|
8422 |
|
|
; --------------------
|
8423 |
|
|
; Go to next statement
|
8424 |
|
|
; --------------------
|
8425 |
|
|
; Acceptable characters at this point are carriage return and ':'.
|
8426 |
|
|
; If so go to next statement which in the first case will be on next line.
|
8427 |
|
|
|
8428 |
|
|
;; STMT-NEXT
|
8429 |
|
|
L1BF4: RST 18H ; GET-CHAR - ignoring white space etc.
|
8430 |
|
|
|
8431 |
|
|
CP $0D ; is it carriage return ?
|
8432 |
|
|
JR Z,L1BB3 ; back to LINE-END if so.
|
8433 |
|
|
|
8434 |
|
|
CP $3A ; is it ':' ?
|
8435 |
|
|
JP Z,L1B28 ; jump back to STMT-LOOP to consider
|
8436 |
|
|
; further statements
|
8437 |
|
|
|
8438 |
|
|
JP L1C8A ; jump to REPORT-C with any other character
|
8439 |
|
|
; 'Nonsense in BASIC'.
|
8440 |
|
|
|
8441 |
|
|
; Note. the two-byte sequence 'rst 08; defb $0b' could replace the above jp.
|
8442 |
|
|
|
8443 |
|
|
; -------------------
|
8444 |
|
|
; Command class table
|
8445 |
|
|
; -------------------
|
8446 |
|
|
;
|
8447 |
|
|
|
8448 |
|
|
;; class-tbl
|
8449 |
|
|
L1C01: DEFB L1C10 - $ ; 0F offset to Address: CLASS-00
|
8450 |
|
|
DEFB L1C1F - $ ; 1D offset to Address: CLASS-01
|
8451 |
|
|
DEFB L1C4E - $ ; 4B offset to Address: CLASS-02
|
8452 |
|
|
DEFB L1C0D - $ ; 09 offset to Address: CLASS-03
|
8453 |
|
|
DEFB L1C6C - $ ; 67 offset to Address: CLASS-04
|
8454 |
|
|
DEFB L1C11 - $ ; 0B offset to Address: CLASS-05
|
8455 |
|
|
DEFB L1C82 - $ ; 7B offset to Address: CLASS-06
|
8456 |
|
|
DEFB L1C96 - $ ; 8E offset to Address: CLASS-07
|
8457 |
|
|
DEFB L1C7A - $ ; 71 offset to Address: CLASS-08
|
8458 |
|
|
DEFB L1CBE - $ ; B4 offset to Address: CLASS-09
|
8459 |
|
|
DEFB L1C8C - $ ; 81 offset to Address: CLASS-0A
|
8460 |
|
|
DEFB L1CDB - $ ; CF offset to Address: CLASS-0B
|
8461 |
|
|
|
8462 |
|
|
|
8463 |
|
|
; --------------------------------
|
8464 |
|
|
; Command classes---00, 03, and 05
|
8465 |
|
|
; --------------------------------
|
8466 |
|
|
; class-03 e.g. RUN or RUN 200 ; optional operand
|
8467 |
|
|
; class-00 e.g. CONTINUE ; no operand
|
8468 |
|
|
; class-05 e.g. PRINT ; variable syntax checked by routine
|
8469 |
|
|
|
8470 |
|
|
;; CLASS-03
|
8471 |
|
|
L1C0D: CALL L1CDE ; routine FETCH-NUM
|
8472 |
|
|
|
8473 |
|
|
;; CLASS-00
|
8474 |
|
|
|
8475 |
|
|
L1C10: CP A ; reset zero flag.
|
8476 |
|
|
|
8477 |
|
|
; if entering here then all class routines are entered with zero reset.
|
8478 |
|
|
|
8479 |
|
|
;; CLASS-05
|
8480 |
|
|
L1C11: POP BC ; drop address SCAN-LOOP.
|
8481 |
|
|
CALL Z,L1BEE ; if zero set then call routine CHECK-END >>>
|
8482 |
|
|
; as should be no further characters.
|
8483 |
|
|
|
8484 |
|
|
EX DE,HL ; save HL to DE.
|
8485 |
|
|
LD HL,($5C74) ; fetch T_ADDR
|
8486 |
|
|
LD C,(HL) ; fetch low byte of routine
|
8487 |
|
|
INC HL ; address next.
|
8488 |
|
|
LD B,(HL) ; fetch high byte of routine.
|
8489 |
|
|
EX DE,HL ; restore HL from DE
|
8490 |
|
|
PUSH BC ; push the address
|
8491 |
|
|
RET ; and make an indirect jump to the command.
|
8492 |
|
|
|
8493 |
|
|
; --------------------------------
|
8494 |
|
|
; Command classes---01, 02, and 04
|
8495 |
|
|
; --------------------------------
|
8496 |
|
|
; class-01 e.g. LET A = 2*3 ; a variable is reqd
|
8497 |
|
|
|
8498 |
|
|
; This class routine is also called from INPUT and READ to find the
|
8499 |
|
|
; destination variable for an assignment.
|
8500 |
|
|
|
8501 |
|
|
;; CLASS-01
|
8502 |
|
|
L1C1F: CALL L28B2 ; routine LOOK-VARS returns carry set if not
|
8503 |
|
|
; found in runtime.
|
8504 |
|
|
|
8505 |
|
|
; ----------------------
|
8506 |
|
|
; Variable in assignment
|
8507 |
|
|
; ----------------------
|
8508 |
|
|
;
|
8509 |
|
|
;
|
8510 |
|
|
|
8511 |
|
|
;; VAR-A-1
|
8512 |
|
|
L1C22: LD (IY+$37),$00 ; set FLAGX to zero
|
8513 |
|
|
JR NC,L1C30 ; forward to VAR-A-2 if found or checking
|
8514 |
|
|
; syntax.
|
8515 |
|
|
|
8516 |
|
|
SET 1,(IY+$37) ; FLAGX - Signal a new variable
|
8517 |
|
|
JR NZ,L1C46 ; to VAR-A-3 if not assigning to an array
|
8518 |
|
|
; e.g. LET a$(3,3) = "X"
|
8519 |
|
|
|
8520 |
|
|
;; REPORT-2
|
8521 |
|
|
L1C2E: RST 08H ; ERROR-1
|
8522 |
|
|
DEFB $01 ; Error Report: Variable not found
|
8523 |
|
|
|
8524 |
|
|
;; VAR-A-2
|
8525 |
|
|
L1C30: CALL Z,L2996 ; routine STK-VAR considers a subscript/slice
|
8526 |
|
|
BIT 6,(IY+$01) ; test FLAGS - Numeric or string result ?
|
8527 |
|
|
JR NZ,L1C46 ; to VAR-A-3 if numeric
|
8528 |
|
|
|
8529 |
|
|
XOR A ; default to array/slice - to be retained.
|
8530 |
|
|
CALL L2530 ; routine SYNTAX-Z
|
8531 |
|
|
CALL NZ,L2BF1 ; routine STK-FETCH is called in runtime
|
8532 |
|
|
; may overwrite A with 1.
|
8533 |
|
|
LD HL,$5C71 ; address system variable FLAGX
|
8534 |
|
|
OR (HL) ; set bit 0 if simple variable to be reclaimed
|
8535 |
|
|
LD (HL),A ; update FLAGX
|
8536 |
|
|
EX DE,HL ; start of string/subscript to DE
|
8537 |
|
|
|
8538 |
|
|
;; VAR-A-3
|
8539 |
|
|
L1C46: LD ($5C72),BC ; update STRLEN
|
8540 |
|
|
LD ($5C4D),HL ; and DEST of assigned string.
|
8541 |
|
|
RET ; return.
|
8542 |
|
|
|
8543 |
|
|
; -------------------------------------------------
|
8544 |
|
|
; class-02 e.g. LET a = 1 + 1 ; an expression must follow
|
8545 |
|
|
|
8546 |
|
|
;; CLASS-02
|
8547 |
|
|
L1C4E: POP BC ; drop return address SCAN-LOOP
|
8548 |
|
|
CALL L1C56 ; routine VAL-FET-1 is called to check
|
8549 |
|
|
; expression and assign result in runtime
|
8550 |
|
|
CALL L1BEE ; routine CHECK-END checks nothing else
|
8551 |
|
|
; is present in statement.
|
8552 |
|
|
RET ; Return
|
8553 |
|
|
|
8554 |
|
|
; -------------
|
8555 |
|
|
; Fetch a value
|
8556 |
|
|
; -------------
|
8557 |
|
|
;
|
8558 |
|
|
;
|
8559 |
|
|
|
8560 |
|
|
;; VAL-FET-1
|
8561 |
|
|
L1C56: LD A,($5C3B) ; initial FLAGS to A
|
8562 |
|
|
|
8563 |
|
|
;; VAL-FET-2
|
8564 |
|
|
L1C59: PUSH AF ; save A briefly
|
8565 |
|
|
CALL L24FB ; routine SCANNING evaluates expression.
|
8566 |
|
|
POP AF ; restore A
|
8567 |
|
|
LD D,(IY+$01) ; post-SCANNING FLAGS to D
|
8568 |
|
|
XOR D ; xor the two sets of flags
|
8569 |
|
|
AND $40 ; pick up bit 6 of xored FLAGS should be zero
|
8570 |
|
|
JR NZ,L1C8A ; forward to REPORT-C if not zero
|
8571 |
|
|
; 'Nonsense in BASIC' - results don't agree.
|
8572 |
|
|
|
8573 |
|
|
BIT 7,D ; test FLAGS - is syntax being checked ?
|
8574 |
|
|
JP NZ,L2AFF ; jump forward to LET to make the assignment
|
8575 |
|
|
; in runtime.
|
8576 |
|
|
|
8577 |
|
|
RET ; but return from here if checking syntax.
|
8578 |
|
|
|
8579 |
|
|
; ------------------
|
8580 |
|
|
; Command class---04
|
8581 |
|
|
; ------------------
|
8582 |
|
|
; class-04 e.g. FOR i ; a single character variable must follow
|
8583 |
|
|
|
8584 |
|
|
;; CLASS-04
|
8585 |
|
|
L1C6C: CALL L28B2 ; routine LOOK-VARS
|
8586 |
|
|
PUSH AF ; preserve flags.
|
8587 |
|
|
LD A,C ; fetch type - should be 011xxxxx
|
8588 |
|
|
OR $9F ; combine with 10011111.
|
8589 |
|
|
INC A ; test if now $FF by incrementing.
|
8590 |
|
|
JR NZ,L1C8A ; forward to REPORT-C if result not zero.
|
8591 |
|
|
|
8592 |
|
|
POP AF ; else restore flags.
|
8593 |
|
|
JR L1C22 ; back to VAR-A-1
|
8594 |
|
|
|
8595 |
|
|
|
8596 |
|
|
; --------------------------------
|
8597 |
|
|
; Expect numeric/string expression
|
8598 |
|
|
; --------------------------------
|
8599 |
|
|
; This routine is used to get the two coordinates of STRING$, ATTR and POINT.
|
8600 |
|
|
; It is also called from PRINT-ITEM to get the two numeric expressions that
|
8601 |
|
|
; follow the AT ( in PRINT AT, INPUT AT).
|
8602 |
|
|
|
8603 |
|
|
;; NEXT-2NUM
|
8604 |
|
|
L1C79: RST 20H ; NEXT-CHAR advance past 'AT' or '('.
|
8605 |
|
|
|
8606 |
|
|
; --------
|
8607 |
|
|
; class-08 e.g. POKE 65535,2 ; two numeric expressions separated by comma
|
8608 |
|
|
;; CLASS-08
|
8609 |
|
|
;; EXPT-2NUM
|
8610 |
|
|
L1C7A: CALL L1C82 ; routine EXPT-1NUM is called for first
|
8611 |
|
|
; numeric expression
|
8612 |
|
|
CP $2C ; is character ',' ?
|
8613 |
|
|
JR NZ,L1C8A ; to REPORT-C if not required separator.
|
8614 |
|
|
; 'Nonsense in BASIC'.
|
8615 |
|
|
|
8616 |
|
|
RST 20H ; NEXT-CHAR
|
8617 |
|
|
|
8618 |
|
|
; ->
|
8619 |
|
|
; class-06 e.g. GOTO a*1000 ; a numeric expression must follow
|
8620 |
|
|
;; CLASS-06
|
8621 |
|
|
;; EXPT-1NUM
|
8622 |
|
|
L1C82: CALL L24FB ; routine SCANNING
|
8623 |
|
|
BIT 6,(IY+$01) ; test FLAGS - Numeric or string result ?
|
8624 |
|
|
RET NZ ; return if result is numeric.
|
8625 |
|
|
|
8626 |
|
|
;; REPORT-C
|
8627 |
|
|
L1C8A: RST 08H ; ERROR-1
|
8628 |
|
|
DEFB $0B ; Error Report: Nonsense in BASIC
|
8629 |
|
|
|
8630 |
|
|
; ---------------------------------------------------------------
|
8631 |
|
|
; class-0A e.g. ERASE "????" ; a string expression must follow.
|
8632 |
|
|
; ; these only occur in unimplemented commands
|
8633 |
|
|
; ; although the routine expt-exp is called
|
8634 |
|
|
; ; from SAVE-ETC
|
8635 |
|
|
|
8636 |
|
|
;; CLASS-0A
|
8637 |
|
|
;; EXPT-EXP
|
8638 |
|
|
L1C8C: CALL L24FB ; routine SCANNING
|
8639 |
|
|
BIT 6,(IY+$01) ; test FLAGS - Numeric or string result ?
|
8640 |
|
|
RET Z ; return if string result.
|
8641 |
|
|
|
8642 |
|
|
JR L1C8A ; back to REPORT-C if numeric.
|
8643 |
|
|
|
8644 |
|
|
; ---------------------
|
8645 |
|
|
; Set permanent colours
|
8646 |
|
|
; class 07
|
8647 |
|
|
; ---------------------
|
8648 |
|
|
; class-07 e.g. PAPER 6 ; a single class for a collection of
|
8649 |
|
|
; ; similar commands. Clever.
|
8650 |
|
|
;
|
8651 |
|
|
; Note. these commands should ensure that current channel is 'S'
|
8652 |
|
|
|
8653 |
|
|
;; CLASS-07
|
8654 |
|
|
L1C96: BIT 7,(IY+$01) ; test FLAGS - checking syntax only ?
|
8655 |
|
|
; Note. there is a subroutine to do this.
|
8656 |
|
|
RES 0,(IY+$02) ; update TV_FLAG - signal main screen in use
|
8657 |
|
|
CALL NZ,L0D4D ; routine TEMPS is called in runtime.
|
8658 |
|
|
POP AF ; drop return address SCAN-LOOP
|
8659 |
|
|
LD A,($5C74) ; T_ADDR_lo to accumulator.
|
8660 |
|
|
; points to '$07' entry + 1
|
8661 |
|
|
; e.g. for INK points to $EC now
|
8662 |
|
|
|
8663 |
|
|
; Note if you move alter the syntax table next line may have to be altered.
|
8664 |
|
|
|
8665 |
|
|
; Note. For ZASM assembler replace following expression with SUB $13.
|
8666 |
|
|
|
8667 |
|
|
L1CA5: SUB L1AEB-$D8 % 256 ; convert $EB to $D8 ('INK') etc.
|
8668 |
|
|
; ( is SUB $13 in standard ROM )
|
8669 |
|
|
|
8670 |
|
|
CALL L21FC ; routine CO-TEMP-4
|
8671 |
|
|
CALL L1BEE ; routine CHECK-END check that nothing else
|
8672 |
|
|
; in statement.
|
8673 |
|
|
|
8674 |
|
|
; return here in runtime.
|
8675 |
|
|
|
8676 |
|
|
LD HL,($5C8F) ; pick up ATTR_T and MASK_T
|
8677 |
|
|
LD ($5C8D),HL ; and store in ATTR_P and MASK_P
|
8678 |
|
|
LD HL,$5C91 ; point to P_FLAG.
|
8679 |
|
|
LD A,(HL) ; pick up in A
|
8680 |
|
|
RLCA ; rotate to left
|
8681 |
|
|
XOR (HL) ; combine with HL
|
8682 |
|
|
AND $AA ; 10101010
|
8683 |
|
|
XOR (HL) ; only permanent bits affected
|
8684 |
|
|
LD (HL),A ; reload into P_FLAG.
|
8685 |
|
|
RET ; return.
|
8686 |
|
|
|
8687 |
|
|
; ------------------
|
8688 |
|
|
; Command class---09
|
8689 |
|
|
; ------------------
|
8690 |
|
|
; e.g. PLOT PAPER 0; 128,88 ; two coordinates preceded by optional
|
8691 |
|
|
; ; embedded colour items.
|
8692 |
|
|
;
|
8693 |
|
|
; Note. this command should ensure that current channel is actually 'S'.
|
8694 |
|
|
|
8695 |
|
|
;; CLASS-09
|
8696 |
|
|
L1CBE: CALL L2530 ; routine SYNTAX-Z
|
8697 |
|
|
JR Z,L1CD6 ; forward to CL-09-1 if checking syntax.
|
8698 |
|
|
|
8699 |
|
|
RES 0,(IY+$02) ; update TV_FLAG - signal main screen in use
|
8700 |
|
|
CALL L0D4D ; routine TEMPS is called.
|
8701 |
|
|
LD HL,$5C90 ; point to MASK_T
|
8702 |
|
|
LD A,(HL) ; fetch mask to accumulator.
|
8703 |
|
|
OR $F8 ; or with 11111000 paper/bright/flash 8
|
8704 |
|
|
LD (HL),A ; mask back to MASK_T system variable.
|
8705 |
|
|
RES 6,(IY+$57) ; reset P_FLAG - signal NOT PAPER 9 ?
|
8706 |
|
|
|
8707 |
|
|
RST 18H ; GET-CHAR
|
8708 |
|
|
|
8709 |
|
|
;; CL-09-1
|
8710 |
|
|
L1CD6: CALL L21E2 ; routine CO-TEMP-2 deals with any embedded
|
8711 |
|
|
; colour items.
|
8712 |
|
|
JR L1C7A ; exit via EXPT-2NUM to check for x,y.
|
8713 |
|
|
|
8714 |
|
|
; Note. if either of the numeric expressions contain STR$ then the flag setting
|
8715 |
|
|
; above will be undone when the channel flags are reset during STR$.
|
8716 |
|
|
; e.g.
|
8717 |
|
|
; 10 BORDER 3 : PLOT VAL STR$ 128, VAL STR$ 100
|
8718 |
|
|
; credit John Elliott.
|
8719 |
|
|
|
8720 |
|
|
; ------------------
|
8721 |
|
|
; Command class---0B
|
8722 |
|
|
; ------------------
|
8723 |
|
|
; Again a single class for four commands.
|
8724 |
|
|
; This command just jumps back to SAVE-ETC to handle the four tape commands.
|
8725 |
|
|
; The routine itself works out which command has called it by examining the
|
8726 |
|
|
; address in T_ADDR_lo. Note therefore that the syntax table has to be
|
8727 |
|
|
; located where these and other sequential command addresses are not split
|
8728 |
|
|
; over a page boundary.
|
8729 |
|
|
|
8730 |
|
|
;; CLASS-0B
|
8731 |
|
|
L1CDB: JP L0605 ; jump way back to SAVE-ETC
|
8732 |
|
|
|
8733 |
|
|
; --------------
|
8734 |
|
|
; Fetch a number
|
8735 |
|
|
; --------------
|
8736 |
|
|
; This routine is called from CLASS-03 when a command may be followed by
|
8737 |
|
|
; an optional numeric expression e.g. RUN. If the end of statement has
|
8738 |
|
|
; been reached then zero is used as the default.
|
8739 |
|
|
; Also called from LIST-4.
|
8740 |
|
|
|
8741 |
|
|
;; FETCH-NUM
|
8742 |
|
|
L1CDE: CP $0D ; is character a carriage return ?
|
8743 |
|
|
JR Z,L1CE6 ; forward to USE-ZERO if so
|
8744 |
|
|
|
8745 |
|
|
CP $3A ; is it ':' ?
|
8746 |
|
|
JR NZ,L1C82 ; forward to EXPT-1NUM if not.
|
8747 |
|
|
; else continue and use zero.
|
8748 |
|
|
|
8749 |
|
|
; ----------------
|
8750 |
|
|
; Use zero routine
|
8751 |
|
|
; ----------------
|
8752 |
|
|
; This routine is called four times to place the value zero on the
|
8753 |
|
|
; calculator stack as a default value in runtime.
|
8754 |
|
|
|
8755 |
|
|
;; USE-ZERO
|
8756 |
|
|
L1CE6: CALL L2530 ; routine SYNTAX-Z (UNSTACK-Z?)
|
8757 |
|
|
RET Z ;
|
8758 |
|
|
|
8759 |
|
|
RST 28H ;; FP-CALC
|
8760 |
|
|
DEFB $A0 ;;stk-zero ;0.
|
8761 |
|
|
DEFB $38 ;;end-calc
|
8762 |
|
|
|
8763 |
|
|
RET ; return.
|
8764 |
|
|
|
8765 |
|
|
; -------------------
|
8766 |
|
|
; Handle STOP command
|
8767 |
|
|
; -------------------
|
8768 |
|
|
; Command Syntax: STOP
|
8769 |
|
|
; One of the shortest and least used commands. As with 'OK' not an error.
|
8770 |
|
|
|
8771 |
|
|
;; REPORT-9
|
8772 |
|
|
;; STOP
|
8773 |
|
|
L1CEE: RST 08H ; ERROR-1
|
8774 |
|
|
DEFB $08 ; Error Report: STOP statement
|
8775 |
|
|
|
8776 |
|
|
; -----------------
|
8777 |
|
|
; Handle IF command
|
8778 |
|
|
; -----------------
|
8779 |
|
|
; e.g. IF score>100 THEN PRINT "You Win"
|
8780 |
|
|
; The parser has already checked the expression the result of which is on
|
8781 |
|
|
; the calculator stack. The presence of the 'THEN' separator has also been
|
8782 |
|
|
; checked and CH-ADD points to the command after THEN.
|
8783 |
|
|
;
|
8784 |
|
|
|
8785 |
|
|
;; IF
|
8786 |
|
|
L1CF0: POP BC ; drop return address - STMT-RET
|
8787 |
|
|
CALL L2530 ; routine SYNTAX-Z
|
8788 |
|
|
JR Z,L1D00 ; forward to IF-1 if checking syntax
|
8789 |
|
|
; to check syntax of PRINT "You Win"
|
8790 |
|
|
|
8791 |
|
|
|
8792 |
|
|
RST 28H ;; FP-CALC score>100 (1=TRUE 0=FALSE)
|
8793 |
|
|
DEFB $02 ;;delete .
|
8794 |
|
|
DEFB $38 ;;end-calc
|
8795 |
|
|
|
8796 |
|
|
EX DE,HL ; make HL point to deleted value
|
8797 |
|
|
CALL L34E9 ; routine TEST-ZERO
|
8798 |
|
|
JP C,L1BB3 ; jump to LINE-END if FALSE (0)
|
8799 |
|
|
|
8800 |
|
|
;; IF-1
|
8801 |
|
|
L1D00: JP L1B29 ; to STMT-L-1, if true (1) to execute command
|
8802 |
|
|
; after 'THEN' token.
|
8803 |
|
|
|
8804 |
|
|
; ------------------
|
8805 |
|
|
; Handle FOR command
|
8806 |
|
|
; ------------------
|
8807 |
|
|
; e.g. FOR i = 0 TO 1 STEP 0.1
|
8808 |
|
|
; Using the syntax tables, the parser has already checked for a start and
|
8809 |
|
|
; limit value and also for the intervening separator.
|
8810 |
|
|
; the two values v,l are on the calculator stack.
|
8811 |
|
|
; CLASS-04 has also checked the variable and the name is in STRLEN_lo.
|
8812 |
|
|
; The routine begins by checking for an optional STEP.
|
8813 |
|
|
|
8814 |
|
|
;; FOR
|
8815 |
|
|
L1D03: CP $CD ; is there a 'STEP' ?
|
8816 |
|
|
JR NZ,L1D10 ; to F-USE-1 if not to use 1 as default.
|
8817 |
|
|
|
8818 |
|
|
RST 20H ; NEXT-CHAR
|
8819 |
|
|
CALL L1C82 ; routine EXPT-1NUM
|
8820 |
|
|
CALL L1BEE ; routine CHECK-END
|
8821 |
|
|
JR L1D16 ; to F-REORDER
|
8822 |
|
|
|
8823 |
|
|
; ---
|
8824 |
|
|
|
8825 |
|
|
;; F-USE-1
|
8826 |
|
|
L1D10: CALL L1BEE ; routine CHECK-END
|
8827 |
|
|
|
8828 |
|
|
RST 28H ;; FP-CALC v,l.
|
8829 |
|
|
DEFB $A1 ;;stk-one v,l,1=s.
|
8830 |
|
|
DEFB $38 ;;end-calc
|
8831 |
|
|
|
8832 |
|
|
|
8833 |
|
|
;; F-REORDER
|
8834 |
|
|
L1D16: RST 28H ;; FP-CALC v,l,s.
|
8835 |
|
|
DEFB $C0 ;;st-mem-0 v,l,s.
|
8836 |
|
|
DEFB $02 ;;delete v,l.
|
8837 |
|
|
DEFB $01 ;;exchange l,v.
|
8838 |
|
|
DEFB $E0 ;;get-mem-0 l,v,s.
|
8839 |
|
|
DEFB $01 ;;exchange l,s,v.
|
8840 |
|
|
DEFB $38 ;;end-calc
|
8841 |
|
|
|
8842 |
|
|
CALL L2AFF ; routine LET assigns the initial value v to
|
8843 |
|
|
; the variable altering type if necessary.
|
8844 |
|
|
LD ($5C68),HL ; The system variable MEM is made to point to
|
8845 |
|
|
; the variable instead of its normal
|
8846 |
|
|
; location MEMBOT
|
8847 |
|
|
DEC HL ; point to single-character name
|
8848 |
|
|
LD A,(HL) ; fetch name
|
8849 |
|
|
SET 7,(HL) ; set bit 7 at location
|
8850 |
|
|
LD BC,$0006 ; add six to HL
|
8851 |
|
|
ADD HL,BC ; to address where limit should be.
|
8852 |
|
|
RLCA ; test bit 7 of original name.
|
8853 |
|
|
JR C,L1D34 ; forward to F-L-S if already a FOR/NEXT
|
8854 |
|
|
; variable
|
8855 |
|
|
|
8856 |
|
|
LD C,$0D ; otherwise an additional 13 bytes are needed.
|
8857 |
|
|
; 5 for each value, two for line number and
|
8858 |
|
|
; 1 byte for looping statement.
|
8859 |
|
|
CALL L1655 ; routine MAKE-ROOM creates them.
|
8860 |
|
|
INC HL ; make HL address limit.
|
8861 |
|
|
|
8862 |
|
|
;; F-L-S
|
8863 |
|
|
L1D34: PUSH HL ; save position.
|
8864 |
|
|
|
8865 |
|
|
RST 28H ;; FP-CALC l,s.
|
8866 |
|
|
DEFB $02 ;;delete l.
|
8867 |
|
|
DEFB $02 ;;delete .
|
8868 |
|
|
DEFB $38 ;;end-calc
|
8869 |
|
|
; DE points to STKEND, l.
|
8870 |
|
|
|
8871 |
|
|
POP HL ; restore variable position
|
8872 |
|
|
EX DE,HL ; swap pointers
|
8873 |
|
|
LD C,$0A ; ten bytes to move
|
8874 |
|
|
LDIR ; Copy 'deleted' values to variable.
|
8875 |
|
|
LD HL,($5C45) ; Load with current line number from PPC
|
8876 |
|
|
EX DE,HL ; exchange pointers.
|
8877 |
|
|
LD (HL),E ; save the looping line
|
8878 |
|
|
INC HL ; in the next
|
8879 |
|
|
LD (HL),D ; two locations.
|
8880 |
|
|
LD D,(IY+$0D) ; fetch statement from SUBPPC system variable.
|
8881 |
|
|
INC D ; increment statement.
|
8882 |
|
|
INC HL ; and pointer
|
8883 |
|
|
LD (HL),D ; and store the looping statement.
|
8884 |
|
|
;
|
8885 |
|
|
CALL L1DDA ; routine NEXT-LOOP considers an initial
|
8886 |
|
|
RET NC ; iteration. Return to STMT-RET if a loop is
|
8887 |
|
|
; possible to execute next statement.
|
8888 |
|
|
|
8889 |
|
|
; no loop is possible so execution continues after the matching 'NEXT'
|
8890 |
|
|
|
8891 |
|
|
LD B,(IY+$38) ; get single-character name from STRLEN_lo
|
8892 |
|
|
LD HL,($5C45) ; get the current line from PPC
|
8893 |
|
|
LD ($5C42),HL ; and store it in NEWPPC
|
8894 |
|
|
LD A,($5C47) ; fetch current statement from SUBPPC
|
8895 |
|
|
NEG ; Negate as counter decrements from zero
|
8896 |
|
|
; initially and we are in the middle of a
|
8897 |
|
|
; line.
|
8898 |
|
|
LD D,A ; Store result in D.
|
8899 |
|
|
LD HL,($5C5D) ; get current address from CH_ADD
|
8900 |
|
|
LD E,$F3 ; search will be for token 'NEXT'
|
8901 |
|
|
|
8902 |
|
|
;; F-LOOP
|
8903 |
|
|
L1D64: PUSH BC ; save variable name.
|
8904 |
|
|
LD BC,($5C55) ; fetch NXTLIN
|
8905 |
|
|
CALL L1D86 ; routine LOOK-PROG searches for 'NEXT' token.
|
8906 |
|
|
LD ($5C55),BC ; update NXTLIN
|
8907 |
|
|
POP BC ; and fetch the letter
|
8908 |
|
|
JR C,L1D84 ; forward to REPORT-I if the end of program
|
8909 |
|
|
; was reached by LOOK-PROG.
|
8910 |
|
|
; 'FOR without NEXT'
|
8911 |
|
|
|
8912 |
|
|
RST 20H ; NEXT-CHAR fetches character after NEXT
|
8913 |
|
|
OR $20 ; ensure it is upper-case.
|
8914 |
|
|
CP B ; compare with FOR variable name
|
8915 |
|
|
JR Z,L1D7C ; forward to F-FOUND if it matches.
|
8916 |
|
|
|
8917 |
|
|
; but if no match i.e. nested FOR/NEXT loops then continue search.
|
8918 |
|
|
|
8919 |
|
|
RST 20H ; NEXT-CHAR
|
8920 |
|
|
JR L1D64 ; back to F-LOOP
|
8921 |
|
|
|
8922 |
|
|
; ---
|
8923 |
|
|
|
8924 |
|
|
|
8925 |
|
|
;; F-FOUND
|
8926 |
|
|
L1D7C: RST 20H ; NEXT-CHAR
|
8927 |
|
|
LD A,$01 ; subtract the negated counter from 1
|
8928 |
|
|
SUB D ; to give the statement after the NEXT
|
8929 |
|
|
LD ($5C44),A ; set system variable NSPPC
|
8930 |
|
|
RET ; return to STMT-RET to branch to new
|
8931 |
|
|
; line and statement. ->
|
8932 |
|
|
; ---
|
8933 |
|
|
|
8934 |
|
|
;; REPORT-I
|
8935 |
|
|
L1D84: RST 08H ; ERROR-1
|
8936 |
|
|
DEFB $11 ; Error Report: FOR without NEXT
|
8937 |
|
|
|
8938 |
|
|
; ---------
|
8939 |
|
|
; LOOK-PROG
|
8940 |
|
|
; ---------
|
8941 |
|
|
; Find DATA, DEF FN or NEXT.
|
8942 |
|
|
; This routine searches the program area for one of the above three keywords.
|
8943 |
|
|
; On entry, HL points to start of search area.
|
8944 |
|
|
; The token is in E, and D holds a statement count, decremented from zero.
|
8945 |
|
|
|
8946 |
|
|
;; LOOK-PROG
|
8947 |
|
|
L1D86: LD A,(HL) ; fetch current character
|
8948 |
|
|
CP $3A ; is it ':' a statement separator ?
|
8949 |
|
|
JR Z,L1DA3 ; forward to LOOK-P-2 if so.
|
8950 |
|
|
|
8951 |
|
|
; The starting point was PROG - 1 or the end of a line.
|
8952 |
|
|
|
8953 |
|
|
;; LOOK-P-1
|
8954 |
|
|
L1D8B: INC HL ; increment pointer to address
|
8955 |
|
|
LD A,(HL) ; the high byte of line number
|
8956 |
|
|
AND $C0 ; test for program end marker $80 or a
|
8957 |
|
|
; variable
|
8958 |
|
|
SCF ; Set Carry Flag
|
8959 |
|
|
RET NZ ; return with carry set if at end
|
8960 |
|
|
; of program. ->
|
8961 |
|
|
|
8962 |
|
|
LD B,(HL) ; high byte of line number to B
|
8963 |
|
|
INC HL ;
|
8964 |
|
|
LD C,(HL) ; low byte to C.
|
8965 |
|
|
LD ($5C42),BC ; set system variable NEWPPC.
|
8966 |
|
|
INC HL ;
|
8967 |
|
|
LD C,(HL) ; low byte of line length to C.
|
8968 |
|
|
INC HL ;
|
8969 |
|
|
LD B,(HL) ; high byte to B.
|
8970 |
|
|
PUSH HL ; save address
|
8971 |
|
|
ADD HL,BC ; add length to position.
|
8972 |
|
|
LD B,H ; and save result
|
8973 |
|
|
LD C,L ; in BC.
|
8974 |
|
|
POP HL ; restore address.
|
8975 |
|
|
LD D,$00 ; initialize statement counter to zero.
|
8976 |
|
|
|
8977 |
|
|
;; LOOK-P-2
|
8978 |
|
|
L1DA3: PUSH BC ; save address of next line
|
8979 |
|
|
CALL L198B ; routine EACH-STMT searches current line.
|
8980 |
|
|
POP BC ; restore address.
|
8981 |
|
|
RET NC ; return if match was found. ->
|
8982 |
|
|
|
8983 |
|
|
JR L1D8B ; back to LOOK-P-1 for next line.
|
8984 |
|
|
|
8985 |
|
|
; -------------------
|
8986 |
|
|
; Handle NEXT command
|
8987 |
|
|
; -------------------
|
8988 |
|
|
; e.g. NEXT i
|
8989 |
|
|
; The parameter tables have already evaluated the presence of a variable
|
8990 |
|
|
|
8991 |
|
|
;; NEXT
|
8992 |
|
|
L1DAB: BIT 1,(IY+$37) ; test FLAGX - handling a new variable ?
|
8993 |
|
|
JP NZ,L1C2E ; jump back to REPORT-2 if so
|
8994 |
|
|
; 'Variable not found'
|
8995 |
|
|
|
8996 |
|
|
; now test if found variable is a simple variable uninitialized by a FOR.
|
8997 |
|
|
|
8998 |
|
|
LD HL,($5C4D) ; load address of variable from DEST
|
8999 |
|
|
BIT 7,(HL) ; is it correct type ?
|
9000 |
|
|
JR Z,L1DD8 ; forward to REPORT-1 if not
|
9001 |
|
|
; 'NEXT without FOR'
|
9002 |
|
|
|
9003 |
|
|
INC HL ; step past variable name
|
9004 |
|
|
LD ($5C68),HL ; and set MEM to point to three 5-byte values
|
9005 |
|
|
; value, limit, step.
|
9006 |
|
|
|
9007 |
|
|
RST 28H ;; FP-CALC add step and re-store
|
9008 |
|
|
DEFB $E0 ;;get-mem-0 v.
|
9009 |
|
|
DEFB $E2 ;;get-mem-2 v,s.
|
9010 |
|
|
DEFB $0F ;;addition v+s.
|
9011 |
|
|
DEFB $C0 ;;st-mem-0 v+s.
|
9012 |
|
|
DEFB $02 ;;delete .
|
9013 |
|
|
DEFB $38 ;;end-calc
|
9014 |
|
|
|
9015 |
|
|
CALL L1DDA ; routine NEXT-LOOP tests against limit.
|
9016 |
|
|
RET C ; return if no more iterations possible.
|
9017 |
|
|
|
9018 |
|
|
LD HL,($5C68) ; find start of variable contents from MEM.
|
9019 |
|
|
LD DE,$000F ; add 3*5 to
|
9020 |
|
|
ADD HL,DE ; address the looping line number
|
9021 |
|
|
LD E,(HL) ; low byte to E
|
9022 |
|
|
INC HL ;
|
9023 |
|
|
LD D,(HL) ; high byte to D
|
9024 |
|
|
INC HL ; address looping statement
|
9025 |
|
|
LD H,(HL) ; and store in H
|
9026 |
|
|
EX DE,HL ; swap registers
|
9027 |
|
|
JP L1E73 ; exit via GO-TO-2 to execute another loop.
|
9028 |
|
|
|
9029 |
|
|
; ---
|
9030 |
|
|
|
9031 |
|
|
;; REPORT-1
|
9032 |
|
|
L1DD8: RST 08H ; ERROR-1
|
9033 |
|
|
DEFB $00 ; Error Report: NEXT without FOR
|
9034 |
|
|
|
9035 |
|
|
|
9036 |
|
|
; -----------------
|
9037 |
|
|
; Perform NEXT loop
|
9038 |
|
|
; -----------------
|
9039 |
|
|
; This routine is called from the FOR command to test for an initial
|
9040 |
|
|
; iteration and from the NEXT command to test for all subsequent iterations.
|
9041 |
|
|
; the system variable MEM addresses the variable's contents which, in the
|
9042 |
|
|
; latter case, have had the step, possibly negative, added to the value.
|
9043 |
|
|
|
9044 |
|
|
;; NEXT-LOOP
|
9045 |
|
|
L1DDA: RST 28H ;; FP-CALC
|
9046 |
|
|
DEFB $E1 ;;get-mem-1 l.
|
9047 |
|
|
DEFB $E0 ;;get-mem-0 l,v.
|
9048 |
|
|
DEFB $E2 ;;get-mem-2 l,v,s.
|
9049 |
|
|
DEFB $36 ;;less-0 l,v,(1/0) negative step ?
|
9050 |
|
|
DEFB $00 ;;jump-true l,v.(1/0)
|
9051 |
|
|
|
9052 |
|
|
DEFB $02 ;;to L1DE2, NEXT-1 if step negative
|
9053 |
|
|
|
9054 |
|
|
DEFB $01 ;;exchange v,l.
|
9055 |
|
|
|
9056 |
|
|
;; NEXT-1
|
9057 |
|
|
L1DE2: DEFB $03 ;;subtract l-v OR v-l.
|
9058 |
|
|
DEFB $37 ;;greater-0 (1/0)
|
9059 |
|
|
DEFB $00 ;;jump-true .
|
9060 |
|
|
|
9061 |
|
|
DEFB $04 ;;to L1DE9, NEXT-2 if no more iterations.
|
9062 |
|
|
|
9063 |
|
|
DEFB $38 ;;end-calc .
|
9064 |
|
|
|
9065 |
|
|
AND A ; clear carry flag signalling another loop.
|
9066 |
|
|
RET ; return
|
9067 |
|
|
|
9068 |
|
|
; ---
|
9069 |
|
|
|
9070 |
|
|
;; NEXT-2
|
9071 |
|
|
L1DE9: DEFB $38 ;;end-calc .
|
9072 |
|
|
|
9073 |
|
|
SCF ; set carry flag signalling looping exhausted.
|
9074 |
|
|
RET ; return
|
9075 |
|
|
|
9076 |
|
|
|
9077 |
|
|
; -------------------
|
9078 |
|
|
; Handle READ command
|
9079 |
|
|
; -------------------
|
9080 |
|
|
; e.g. READ a, b$, c$(1000 TO 3000)
|
9081 |
|
|
; A list of comma-separated variables is assigned from a list of
|
9082 |
|
|
; comma-separated expressions.
|
9083 |
|
|
; As it moves along the first list, the character address CH_ADD is stored
|
9084 |
|
|
; in X_PTR while CH_ADD is used to read the second list.
|
9085 |
|
|
|
9086 |
|
|
;; READ-3
|
9087 |
|
|
L1DEC: RST 20H ; NEXT-CHAR
|
9088 |
|
|
|
9089 |
|
|
; -> Entry point.
|
9090 |
|
|
;; READ
|
9091 |
|
|
L1DED: CALL L1C1F ; routine CLASS-01 checks variable.
|
9092 |
|
|
CALL L2530 ; routine SYNTAX-Z
|
9093 |
|
|
JR Z,L1E1E ; forward to READ-2 if checking syntax
|
9094 |
|
|
|
9095 |
|
|
|
9096 |
|
|
RST 18H ; GET-CHAR
|
9097 |
|
|
LD ($5C5F),HL ; save character position in X_PTR.
|
9098 |
|
|
LD HL,($5C57) ; load HL with Data Address DATADD, which is
|
9099 |
|
|
; the start of the program or the address
|
9100 |
|
|
; after the last expression that was read or
|
9101 |
|
|
; the address of the line number of the
|
9102 |
|
|
; last RESTORE command.
|
9103 |
|
|
LD A,(HL) ; fetch character
|
9104 |
|
|
CP $2C ; is it a comma ?
|
9105 |
|
|
JR Z,L1E0A ; forward to READ-1 if so.
|
9106 |
|
|
|
9107 |
|
|
; else all data in this statement has been read so look for next DATA token
|
9108 |
|
|
|
9109 |
|
|
LD E,$E4 ; token 'DATA'
|
9110 |
|
|
CALL L1D86 ; routine LOOK-PROG
|
9111 |
|
|
JR NC,L1E0A ; forward to READ-1 if DATA found
|
9112 |
|
|
|
9113 |
|
|
; else report the error.
|
9114 |
|
|
|
9115 |
|
|
;; REPORT-E
|
9116 |
|
|
L1E08: RST 08H ; ERROR-1
|
9117 |
|
|
DEFB $0D ; Error Report: Out of DATA
|
9118 |
|
|
|
9119 |
|
|
;; READ-1
|
9120 |
|
|
L1E0A: CALL L0077 ; routine TEMP-PTR1 advances updating CH_ADD
|
9121 |
|
|
; with new DATADD position.
|
9122 |
|
|
CALL L1C56 ; routine VAL-FET-1 assigns value to variable
|
9123 |
|
|
; checking type match and adjusting CH_ADD.
|
9124 |
|
|
|
9125 |
|
|
RST 18H ; GET-CHAR fetches adjusted character position
|
9126 |
|
|
LD ($5C57),HL ; store back in DATADD
|
9127 |
|
|
LD HL,($5C5F) ; fetch X_PTR the original READ CH_ADD
|
9128 |
|
|
LD (IY+$26),$00 ; now nullify X_PTR_hi
|
9129 |
|
|
CALL L0078 ; routine TEMP-PTR2 restores READ CH_ADD
|
9130 |
|
|
|
9131 |
|
|
;; READ-2
|
9132 |
|
|
L1E1E: RST 18H ; GET-CHAR
|
9133 |
|
|
CP $2C ; is it ',' indicating more variables to read ?
|
9134 |
|
|
JR Z,L1DEC ; back to READ-3 if so
|
9135 |
|
|
|
9136 |
|
|
CALL L1BEE ; routine CHECK-END
|
9137 |
|
|
RET ; return from here in runtime to STMT-RET.
|
9138 |
|
|
|
9139 |
|
|
; -------------------
|
9140 |
|
|
; Handle DATA command
|
9141 |
|
|
; -------------------
|
9142 |
|
|
; In runtime this 'command' is passed by but the syntax is checked when such
|
9143 |
|
|
; a statement is found while parsing a line.
|
9144 |
|
|
; e.g. DATA 1, 2, "text", score-1, a$(location, room, object), FN r(49),
|
9145 |
|
|
; wages - tax, TRUE, The meaning of life
|
9146 |
|
|
|
9147 |
|
|
;; DATA
|
9148 |
|
|
L1E27: CALL L2530 ; routine SYNTAX-Z to check status
|
9149 |
|
|
JR NZ,L1E37 ; forward to DATA-2 if in runtime
|
9150 |
|
|
|
9151 |
|
|
;; DATA-1
|
9152 |
|
|
L1E2C: CALL L24FB ; routine SCANNING to check syntax of
|
9153 |
|
|
; expression
|
9154 |
|
|
CP $2C ; is it a comma ?
|
9155 |
|
|
CALL NZ,L1BEE ; routine CHECK-END checks that statement
|
9156 |
|
|
; is complete. Will make an early exit if
|
9157 |
|
|
; so. >>>
|
9158 |
|
|
RST 20H ; NEXT-CHAR
|
9159 |
|
|
JR L1E2C ; back to DATA-1
|
9160 |
|
|
|
9161 |
|
|
; ---
|
9162 |
|
|
|
9163 |
|
|
;; DATA-2
|
9164 |
|
|
L1E37: LD A,$E4 ; set token to 'DATA' and continue into
|
9165 |
|
|
; the PASS-BY routine.
|
9166 |
|
|
|
9167 |
|
|
|
9168 |
|
|
; ----------------------------------
|
9169 |
|
|
; Check statement for DATA or DEF FN
|
9170 |
|
|
; ----------------------------------
|
9171 |
|
|
; This routine is used to backtrack to a command token and then
|
9172 |
|
|
; forward to the next statement in runtime.
|
9173 |
|
|
|
9174 |
|
|
;; PASS-BY
|
9175 |
|
|
L1E39: LD B,A ; Give BC enough space to find token.
|
9176 |
|
|
CPDR ; Compare decrement and repeat. (Only use).
|
9177 |
|
|
; Work backwards till keyword is found which
|
9178 |
|
|
; is start of statement before any quotes.
|
9179 |
|
|
; HL points to location before keyword.
|
9180 |
|
|
LD DE,$0200 ; count 1+1 statements, dummy value in E to
|
9181 |
|
|
; inhibit searching for a token.
|
9182 |
|
|
JP L198B ; to EACH-STMT to find next statement
|
9183 |
|
|
|
9184 |
|
|
; -----------------------------------------------------------------------
|
9185 |
|
|
; A General Note on Invalid Line Numbers.
|
9186 |
|
|
; =======================================
|
9187 |
|
|
; One of the revolutionary concepts of Sinclair BASIC was that it supported
|
9188 |
|
|
; virtual line numbers. That is the destination of a GO TO, RESTORE etc. need
|
9189 |
|
|
; not exist. It could be a point before or after an actual line number.
|
9190 |
|
|
; Zero suffices for a before but the after should logically be infinity.
|
9191 |
|
|
; Since the maximum actual line limit is 9999 then the system limit, 16383
|
9192 |
|
|
; when variables kick in, would serve fine as a virtual end point.
|
9193 |
|
|
; However, ironically, only the LOAD command gets it right. It will not
|
9194 |
|
|
; autostart a program that has been saved with a line higher than 16383.
|
9195 |
|
|
; All the other commands deal with the limit unsatisfactorily.
|
9196 |
|
|
; LIST, RUN, GO TO, GO SUB and RESTORE have problems and the latter may
|
9197 |
|
|
; crash the machine when supplied with an inappropriate virtual line number.
|
9198 |
|
|
; This is puzzling as very careful consideration must have been given to
|
9199 |
|
|
; this point when the new variable types were allocated their masks and also
|
9200 |
|
|
; when the routine NEXT-ONE was successfully re-written to reflect this.
|
9201 |
|
|
; An enigma.
|
9202 |
|
|
; -------------------------------------------------------------------------
|
9203 |
|
|
|
9204 |
|
|
; ----------------------
|
9205 |
|
|
; Handle RESTORE command
|
9206 |
|
|
; ----------------------
|
9207 |
|
|
; The restore command sets the system variable for the data address to
|
9208 |
|
|
; point to the location before the supplied line number or first line
|
9209 |
|
|
; thereafter.
|
9210 |
|
|
; This alters the position where subsequent READ commands look for data.
|
9211 |
|
|
; Note. If supplied with inappropriate high numbers the system may crash
|
9212 |
|
|
; in the LINE-ADDR routine as it will pass the program/variables end-marker
|
9213 |
|
|
; and then lose control of what it is looking for - variable or line number.
|
9214 |
|
|
; - observation, Steven Vickers, 1984, Pitman.
|
9215 |
|
|
|
9216 |
|
|
;; RESTORE
|
9217 |
|
|
L1E42: CALL L1E99 ; routine FIND-INT2 puts integer in BC.
|
9218 |
|
|
; Note. B should be checked against limit $3F
|
9219 |
|
|
; and an error generated if higher.
|
9220 |
|
|
|
9221 |
|
|
; this entry point is used from RUN command with BC holding zero
|
9222 |
|
|
|
9223 |
|
|
;; REST-RUN
|
9224 |
|
|
L1E45: LD H,B ; transfer the line
|
9225 |
|
|
LD L,C ; number to the HL register.
|
9226 |
|
|
CALL L196E ; routine LINE-ADDR to fetch the address.
|
9227 |
|
|
DEC HL ; point to the location before the line.
|
9228 |
|
|
LD ($5C57),HL ; update system variable DATADD.
|
9229 |
|
|
RET ; return to STMT-RET (or RUN)
|
9230 |
|
|
|
9231 |
|
|
; ------------------------
|
9232 |
|
|
; Handle RANDOMIZE command
|
9233 |
|
|
; ------------------------
|
9234 |
|
|
; This command sets the SEED for the RND function to a fixed value.
|
9235 |
|
|
; With the parameter zero, a random start point is used depending on
|
9236 |
|
|
; how long the computer has been switched on.
|
9237 |
|
|
|
9238 |
|
|
;; RANDOMIZE
|
9239 |
|
|
L1E4F: CALL L1E99 ; routine FIND-INT2 puts parameter in BC.
|
9240 |
|
|
LD A,B ; test this
|
9241 |
|
|
OR C ; for zero.
|
9242 |
|
|
JR NZ,L1E5A ; forward to RAND-1 if not zero.
|
9243 |
|
|
|
9244 |
|
|
LD BC,($5C78) ; use the lower two bytes at FRAMES1.
|
9245 |
|
|
|
9246 |
|
|
;; RAND-1
|
9247 |
|
|
L1E5A: LD ($5C76),BC ; place in SEED system variable.
|
9248 |
|
|
RET ; return to STMT-RET
|
9249 |
|
|
|
9250 |
|
|
; -----------------------
|
9251 |
|
|
; Handle CONTINUE command
|
9252 |
|
|
; -----------------------
|
9253 |
|
|
; The CONTINUE command transfers the OLD (but incremented) values of
|
9254 |
|
|
; line number and statement to the equivalent "NEW VALUE" system variables
|
9255 |
|
|
; by using the last part of GO TO and exits indirectly to STMT-RET.
|
9256 |
|
|
|
9257 |
|
|
;; CONTINUE
|
9258 |
|
|
L1E5F: LD HL,($5C6E) ; fetch OLDPPC line number.
|
9259 |
|
|
LD D,(IY+$36) ; fetch OSPPC statement.
|
9260 |
|
|
JR L1E73 ; forward to GO-TO-2
|
9261 |
|
|
|
9262 |
|
|
; --------------------
|
9263 |
|
|
; Handle GO TO command
|
9264 |
|
|
; --------------------
|
9265 |
|
|
; The GO TO command routine is also called by GO SUB and RUN routines
|
9266 |
|
|
; to evaluate the parameters of both commands.
|
9267 |
|
|
; It updates the system variables used to fetch the next line/statement.
|
9268 |
|
|
; It is at STMT-RET that the actual change in control takes place.
|
9269 |
|
|
; Unlike some BASICs the line number need not exist.
|
9270 |
|
|
; Note. the high byte of the line number is incorrectly compared with $F0
|
9271 |
|
|
; instead of $3F. This leads to commands with operands greater than 32767
|
9272 |
|
|
; being considered as having been run from the editing area and the
|
9273 |
|
|
; error report 'Statement Lost' is given instead of 'OK'.
|
9274 |
|
|
; - Steven Vickers, 1984.
|
9275 |
|
|
|
9276 |
|
|
;; GO-TO
|
9277 |
|
|
L1E67: CALL L1E99 ; routine FIND-INT2 puts operand in BC
|
9278 |
|
|
LD H,B ; transfer line
|
9279 |
|
|
LD L,C ; number to HL.
|
9280 |
|
|
LD D,$00 ; set statement to 0 - first.
|
9281 |
|
|
LD A,H ; compare high byte only
|
9282 |
|
|
CP $F0 ; to $F0 i.e. 61439 in full.
|
9283 |
|
|
JR NC,L1E9F ; forward to REPORT-B if above.
|
9284 |
|
|
|
9285 |
|
|
; This call entry point is used to update the system variables e.g. by RETURN.
|
9286 |
|
|
|
9287 |
|
|
;; GO-TO-2
|
9288 |
|
|
L1E73: LD ($5C42),HL ; save line number in NEWPPC
|
9289 |
|
|
LD (IY+$0A),D ; and statement in NSPPC
|
9290 |
|
|
RET ; to STMT-RET (or GO-SUB command)
|
9291 |
|
|
|
9292 |
|
|
; ------------------
|
9293 |
|
|
; Handle OUT command
|
9294 |
|
|
; ------------------
|
9295 |
|
|
; Syntax has been checked and the two comma-separated values are on the
|
9296 |
|
|
; calculator stack.
|
9297 |
|
|
|
9298 |
|
|
;; OUT
|
9299 |
|
|
L1E7A: CALL L1E85 ; routine TWO-PARAM fetches values
|
9300 |
|
|
; to BC and A.
|
9301 |
|
|
OUT (C),A ; perform the operation.
|
9302 |
|
|
RET ; return to STMT-RET.
|
9303 |
|
|
|
9304 |
|
|
; -------------------
|
9305 |
|
|
; Handle POKE command
|
9306 |
|
|
; -------------------
|
9307 |
|
|
; This routine alters a single byte in the 64K address space.
|
9308 |
|
|
; Happily no check is made as to whether ROM or RAM is addressed.
|
9309 |
|
|
; Sinclair BASIC requires no poking of system variables.
|
9310 |
|
|
|
9311 |
|
|
;; POKE
|
9312 |
|
|
L1E80: CALL L1E85 ; routine TWO-PARAM fetches values
|
9313 |
|
|
; to BC and A.
|
9314 |
|
|
LD (BC),A ; load memory location with A.
|
9315 |
|
|
RET ; return to STMT-RET.
|
9316 |
|
|
|
9317 |
|
|
; ------------------------------------
|
9318 |
|
|
; Fetch two parameters from calculator stack
|
9319 |
|
|
; ------------------------------------
|
9320 |
|
|
; This routine fetches a byte and word from the calculator stack
|
9321 |
|
|
; producing an error if either is out of range.
|
9322 |
|
|
|
9323 |
|
|
;; TWO-PARAM
|
9324 |
|
|
L1E85: CALL L2DD5 ; routine FP-TO-A
|
9325 |
|
|
JR C,L1E9F ; forward to REPORT-B if overflow occurred
|
9326 |
|
|
|
9327 |
|
|
JR Z,L1E8E ; forward to TWO-P-1 if positive
|
9328 |
|
|
|
9329 |
|
|
NEG ; negative numbers are made positive
|
9330 |
|
|
|
9331 |
|
|
;; TWO-P-1
|
9332 |
|
|
L1E8E: PUSH AF ; save the value
|
9333 |
|
|
CALL L1E99 ; routine FIND-INT2 gets integer to BC
|
9334 |
|
|
POP AF ; restore the value
|
9335 |
|
|
RET ; return
|
9336 |
|
|
|
9337 |
|
|
; -------------
|
9338 |
|
|
; Find integers
|
9339 |
|
|
; -------------
|
9340 |
|
|
; The first of these routines fetches a 8-bit integer (range 0-255) from the
|
9341 |
|
|
; calculator stack to the accumulator and is used for colours, streams,
|
9342 |
|
|
; durations and coordinates.
|
9343 |
|
|
; The second routine fetches 16-bit integers to the BC register pair
|
9344 |
|
|
; and is used to fetch command and function arguments involving line numbers
|
9345 |
|
|
; or memory addresses and also array subscripts and tab arguments.
|
9346 |
|
|
; ->
|
9347 |
|
|
|
9348 |
|
|
;; FIND-INT1
|
9349 |
|
|
L1E94: CALL L2DD5 ; routine FP-TO-A
|
9350 |
|
|
JR L1E9C ; forward to FIND-I-1 for common exit routine.
|
9351 |
|
|
|
9352 |
|
|
; ---
|
9353 |
|
|
|
9354 |
|
|
; ->
|
9355 |
|
|
|
9356 |
|
|
;; FIND-INT2
|
9357 |
|
|
L1E99: CALL L2DA2 ; routine FP-TO-BC
|
9358 |
|
|
|
9359 |
|
|
;; FIND-I-1
|
9360 |
|
|
L1E9C: JR C,L1E9F ; to REPORT-Bb with overflow.
|
9361 |
|
|
|
9362 |
|
|
RET Z ; return if positive.
|
9363 |
|
|
|
9364 |
|
|
|
9365 |
|
|
;; REPORT-Bb
|
9366 |
|
|
L1E9F: RST 08H ; ERROR-1
|
9367 |
|
|
DEFB $0A ; Error Report: Integer out of range
|
9368 |
|
|
|
9369 |
|
|
; ------------------
|
9370 |
|
|
; Handle RUN command
|
9371 |
|
|
; ------------------
|
9372 |
|
|
; This command runs a program starting at an optional line.
|
9373 |
|
|
; It performs a 'RESTORE 0' then CLEAR
|
9374 |
|
|
|
9375 |
|
|
;; RUN
|
9376 |
|
|
L1EA1: CALL L1E67 ; routine GO-TO puts line number in
|
9377 |
|
|
; system variables.
|
9378 |
|
|
LD BC,$0000 ; prepare to set DATADD to first line.
|
9379 |
|
|
CALL L1E45 ; routine REST-RUN does the 'restore'.
|
9380 |
|
|
; Note BC still holds zero.
|
9381 |
|
|
JR L1EAF ; forward to CLEAR-RUN to clear variables
|
9382 |
|
|
; without disturbing RAMTOP and
|
9383 |
|
|
; exit indirectly to STMT-RET
|
9384 |
|
|
|
9385 |
|
|
; --------------------
|
9386 |
|
|
; Handle CLEAR command
|
9387 |
|
|
; --------------------
|
9388 |
|
|
; This command reclaims the space used by the variables.
|
9389 |
|
|
; It also clears the screen and the GO SUB stack.
|
9390 |
|
|
; With an integer expression, it sets the uppermost memory
|
9391 |
|
|
; address within the BASIC system.
|
9392 |
|
|
; "Contrary to the manual, CLEAR doesn't execute a RESTORE" -
|
9393 |
|
|
; Steven Vickers, Pitman Pocket Guide to the Spectrum, 1984.
|
9394 |
|
|
|
9395 |
|
|
;; CLEAR
|
9396 |
|
|
L1EAC: CALL L1E99 ; routine FIND-INT2 fetches to BC.
|
9397 |
|
|
|
9398 |
|
|
;; CLEAR-RUN
|
9399 |
|
|
L1EAF: LD A,B ; test for
|
9400 |
|
|
OR C ; zero.
|
9401 |
|
|
JR NZ,L1EB7 ; skip to CLEAR-1 if not zero.
|
9402 |
|
|
|
9403 |
|
|
LD BC,($5CB2) ; use the existing value of RAMTOP if zero.
|
9404 |
|
|
|
9405 |
|
|
;; CLEAR-1
|
9406 |
|
|
L1EB7: PUSH BC ; save ramtop value.
|
9407 |
|
|
|
9408 |
|
|
LD DE,($5C4B) ; fetch VARS
|
9409 |
|
|
LD HL,($5C59) ; fetch E_LINE
|
9410 |
|
|
DEC HL ; adjust to point at variables end-marker.
|
9411 |
|
|
CALL L19E5 ; routine RECLAIM-1 reclaims the space used by
|
9412 |
|
|
; the variables.
|
9413 |
|
|
|
9414 |
|
|
CALL L0D6B ; routine CLS to clear screen.
|
9415 |
|
|
|
9416 |
|
|
LD HL,($5C65) ; fetch STKEND the start of free memory.
|
9417 |
|
|
LD DE,$0032 ; allow for another 50 bytes.
|
9418 |
|
|
ADD HL,DE ; add the overhead to HL.
|
9419 |
|
|
|
9420 |
|
|
POP DE ; restore the ramtop value.
|
9421 |
|
|
SBC HL,DE ; if HL is greater than the value then jump
|
9422 |
|
|
JR NC,L1EDA ; forward to REPORT-M
|
9423 |
|
|
; 'RAMTOP no good'
|
9424 |
|
|
|
9425 |
|
|
LD HL,($5CB4) ; now P-RAMT ($7FFF on 16K RAM machine)
|
9426 |
|
|
AND A ; exact this time.
|
9427 |
|
|
SBC HL,DE ; new ramtop must be lower or the same.
|
9428 |
|
|
JR NC,L1EDC ; skip to CLEAR-2 if in actual RAM.
|
9429 |
|
|
|
9430 |
|
|
;; REPORT-M
|
9431 |
|
|
L1EDA: RST 08H ; ERROR-1
|
9432 |
|
|
DEFB $15 ; Error Report: RAMTOP no good
|
9433 |
|
|
|
9434 |
|
|
;; CLEAR-2
|
9435 |
|
|
L1EDC: EX DE,HL ; transfer ramtop value to HL.
|
9436 |
|
|
LD ($5CB2),HL ; update system variable RAMTOP.
|
9437 |
|
|
POP DE ; pop the return address STMT-RET.
|
9438 |
|
|
POP BC ; pop the Error Address.
|
9439 |
|
|
LD (HL),$3E ; now put the GO SUB end-marker at RAMTOP.
|
9440 |
|
|
DEC HL ; leave a location beneath it.
|
9441 |
|
|
LD SP,HL ; initialize the machine stack pointer.
|
9442 |
|
|
PUSH BC ; push the error address.
|
9443 |
|
|
LD ($5C3D),SP ; make ERR_SP point to location.
|
9444 |
|
|
EX DE,HL ; put STMT-RET in HL.
|
9445 |
|
|
JP (HL) ; and go there directly.
|
9446 |
|
|
|
9447 |
|
|
; ---------------------
|
9448 |
|
|
; Handle GO SUB command
|
9449 |
|
|
; ---------------------
|
9450 |
|
|
; The GO SUB command diverts BASIC control to a new line number
|
9451 |
|
|
; in a very similar manner to GO TO but
|
9452 |
|
|
; the current line number and current statement + 1
|
9453 |
|
|
; are placed on the GO SUB stack as a RETURN point.
|
9454 |
|
|
|
9455 |
|
|
;; GO-SUB
|
9456 |
|
|
L1EED: POP DE ; drop the address STMT-RET
|
9457 |
|
|
LD H,(IY+$0D) ; fetch statement from SUBPPC and
|
9458 |
|
|
INC H ; increment it
|
9459 |
|
|
EX (SP),HL ; swap - error address to HL,
|
9460 |
|
|
; H (statement) at top of stack,
|
9461 |
|
|
; L (unimportant) beneath.
|
9462 |
|
|
INC SP ; adjust to overwrite unimportant byte
|
9463 |
|
|
LD BC,($5C45) ; fetch the current line number from PPC
|
9464 |
|
|
PUSH BC ; and PUSH onto GO SUB stack.
|
9465 |
|
|
; the empty machine-stack can be rebuilt
|
9466 |
|
|
PUSH HL ; push the error address.
|
9467 |
|
|
LD ($5C3D),SP ; make system variable ERR_SP point to it.
|
9468 |
|
|
PUSH DE ; push the address STMT-RET.
|
9469 |
|
|
CALL L1E67 ; call routine GO-TO to update the system
|
9470 |
|
|
; variables NEWPPC and NSPPC.
|
9471 |
|
|
; then make an indirect exit to STMT-RET via
|
9472 |
|
|
LD BC,$0014 ; a 20-byte overhead memory check.
|
9473 |
|
|
|
9474 |
|
|
; ----------------------
|
9475 |
|
|
; Check available memory
|
9476 |
|
|
; ----------------------
|
9477 |
|
|
; This routine is used on many occasions when extending a dynamic area
|
9478 |
|
|
; upwards or the GO SUB stack downwards.
|
9479 |
|
|
|
9480 |
|
|
;; TEST-ROOM
|
9481 |
|
|
L1F05: LD HL,($5C65) ; fetch STKEND
|
9482 |
|
|
ADD HL,BC ; add the supplied test value
|
9483 |
|
|
JR C,L1F15 ; forward to REPORT-4 if over $FFFF
|
9484 |
|
|
|
9485 |
|
|
EX DE,HL ; was less so transfer to DE
|
9486 |
|
|
LD HL,$0050 ; test against another 80 bytes
|
9487 |
|
|
ADD HL,DE ; anyway
|
9488 |
|
|
JR C,L1F15 ; forward to REPORT-4 if this passes $FFFF
|
9489 |
|
|
|
9490 |
|
|
SBC HL,SP ; if less than the machine stack pointer
|
9491 |
|
|
RET C ; then return - OK.
|
9492 |
|
|
|
9493 |
|
|
;; REPORT-4
|
9494 |
|
|
L1F15: LD L,$03 ; prepare 'Out of Memory'
|
9495 |
|
|
JP L0055 ; jump back to ERROR-3 at $0055
|
9496 |
|
|
; Note. this error can't be trapped at $0008
|
9497 |
|
|
|
9498 |
|
|
; ------------------------------
|
9499 |
|
|
; THE 'FREE MEMORY' USER ROUTINE
|
9500 |
|
|
; ------------------------------
|
9501 |
|
|
; This routine is not used by the ROM but allows users to evaluate
|
9502 |
|
|
; approximate free memory with PRINT 65536 - USR 7962.
|
9503 |
|
|
|
9504 |
|
|
;; free-mem
|
9505 |
|
|
L1F1A: LD BC,$0000 ; allow no overhead.
|
9506 |
|
|
|
9507 |
|
|
CALL L1F05 ; routine TEST-ROOM.
|
9508 |
|
|
|
9509 |
|
|
LD B,H ; transfer the result
|
9510 |
|
|
LD C,L ; to the BC register.
|
9511 |
|
|
RET ; the USR function returns value of BC.
|
9512 |
|
|
|
9513 |
|
|
; --------------------
|
9514 |
|
|
; THE 'RETURN' COMMAND
|
9515 |
|
|
; --------------------
|
9516 |
|
|
; As with any command, there are two values on the machine stack at the time
|
9517 |
|
|
; it is invoked. The machine stack is below the GOSUB stack. Both grow
|
9518 |
|
|
; downwards, the machine stack by two bytes, the GOSUB stack by 3 bytes.
|
9519 |
|
|
; The highest location is a statement byte followed by a two-byte line number.
|
9520 |
|
|
|
9521 |
|
|
;; RETURN
|
9522 |
|
|
L1F23: POP BC ; drop the address STMT-RET.
|
9523 |
|
|
POP HL ; now the error address.
|
9524 |
|
|
POP DE ; now a possible BASIC return line.
|
9525 |
|
|
LD A,D ; the high byte $00 - $27 is
|
9526 |
|
|
CP $3E ; compared with the traditional end-marker $3E.
|
9527 |
|
|
JR Z,L1F36 ; forward to REPORT-7 with a match.
|
9528 |
|
|
; 'RETURN without GOSUB'
|
9529 |
|
|
|
9530 |
|
|
; It was not the end-marker so a single statement byte remains at the base of
|
9531 |
|
|
; the calculator stack. It can't be popped off.
|
9532 |
|
|
|
9533 |
|
|
DEC SP ; adjust stack pointer to create room for two
|
9534 |
|
|
; bytes.
|
9535 |
|
|
EX (SP),HL ; statement to H, error address to base of
|
9536 |
|
|
; new machine stack.
|
9537 |
|
|
EX DE,HL ; statement to D, BASIC line number to HL.
|
9538 |
|
|
LD ($5C3D),SP ; adjust ERR_SP to point to new stack pointer
|
9539 |
|
|
PUSH BC ; now re-stack the address STMT-RET
|
9540 |
|
|
JP L1E73 ; to GO-TO-2 to update statement and line
|
9541 |
|
|
; system variables and exit indirectly to the
|
9542 |
|
|
; address just pushed on stack.
|
9543 |
|
|
|
9544 |
|
|
; ---
|
9545 |
|
|
|
9546 |
|
|
;; REPORT-7
|
9547 |
|
|
L1F36: PUSH DE ; replace the end-marker.
|
9548 |
|
|
PUSH HL ; now restore the error address
|
9549 |
|
|
; as will be required in a few clock cycles.
|
9550 |
|
|
|
9551 |
|
|
RST 08H ; ERROR-1
|
9552 |
|
|
DEFB $06 ; Error Report: RETURN without GOSUB
|
9553 |
|
|
|
9554 |
|
|
; --------------------
|
9555 |
|
|
; Handle PAUSE command
|
9556 |
|
|
; --------------------
|
9557 |
|
|
; The pause command takes as its parameter the number of interrupts
|
9558 |
|
|
; for which to wait. PAUSE 50 pauses for about a second.
|
9559 |
|
|
; PAUSE 0 pauses indefinitely.
|
9560 |
|
|
; Both forms can be finished by pressing a key.
|
9561 |
|
|
|
9562 |
|
|
;; PAUSE
|
9563 |
|
|
L1F3A: CALL L1E99 ; routine FIND-INT2 puts value in BC
|
9564 |
|
|
|
9565 |
|
|
;; PAUSE-1
|
9566 |
|
|
L1F3D: HALT ; wait for interrupt.
|
9567 |
|
|
DEC BC ; decrease counter.
|
9568 |
|
|
LD A,B ; test if
|
9569 |
|
|
OR C ; result is zero.
|
9570 |
|
|
JR Z,L1F4F ; forward to PAUSE-END if so.
|
9571 |
|
|
|
9572 |
|
|
LD A,B ; test if
|
9573 |
|
|
AND C ; now $FFFF
|
9574 |
|
|
INC A ; that is, initially zero.
|
9575 |
|
|
JR NZ,L1F49 ; skip forward to PAUSE-2 if not.
|
9576 |
|
|
|
9577 |
|
|
INC BC ; restore counter to zero.
|
9578 |
|
|
|
9579 |
|
|
;; PAUSE-2
|
9580 |
|
|
L1F49: BIT 5,(IY+$01) ; test FLAGS - has a new key been pressed ?
|
9581 |
|
|
JR Z,L1F3D ; back to PAUSE-1 if not.
|
9582 |
|
|
|
9583 |
|
|
;; PAUSE-END
|
9584 |
|
|
L1F4F: RES 5,(IY+$01) ; update FLAGS - signal no new key
|
9585 |
|
|
RET ; and return.
|
9586 |
|
|
|
9587 |
|
|
; -------------------
|
9588 |
|
|
; Check for BREAK key
|
9589 |
|
|
; -------------------
|
9590 |
|
|
; This routine is called from COPY-LINE, when interrupts are disabled,
|
9591 |
|
|
; to test if BREAK (SHIFT - SPACE) is being pressed.
|
9592 |
|
|
; It is also called at STMT-RET after every statement.
|
9593 |
|
|
|
9594 |
|
|
;; BREAK-KEY
|
9595 |
|
|
L1F54: LD A,$7F ; Input address: $7FFE
|
9596 |
|
|
IN A,($FE) ; read lower right keys
|
9597 |
|
|
RRA ; rotate bit 0 - SPACE
|
9598 |
|
|
RET C ; return if not reset
|
9599 |
|
|
|
9600 |
|
|
LD A,$FE ; Input address: $FEFE
|
9601 |
|
|
IN A,($FE) ; read lower left keys
|
9602 |
|
|
RRA ; rotate bit 0 - SHIFT
|
9603 |
|
|
RET ; carry will be set if not pressed.
|
9604 |
|
|
; return with no carry if both keys
|
9605 |
|
|
; pressed.
|
9606 |
|
|
|
9607 |
|
|
; ---------------------
|
9608 |
|
|
; Handle DEF FN command
|
9609 |
|
|
; ---------------------
|
9610 |
|
|
; e.g. DEF FN r$(a$,a) = a$(a TO )
|
9611 |
|
|
; this 'command' is ignored in runtime but has its syntax checked
|
9612 |
|
|
; during line-entry.
|
9613 |
|
|
|
9614 |
|
|
;; DEF-FN
|
9615 |
|
|
L1F60: CALL L2530 ; routine SYNTAX-Z
|
9616 |
|
|
JR Z,L1F6A ; forward to DEF-FN-1 if parsing
|
9617 |
|
|
|
9618 |
|
|
LD A,$CE ; else load A with 'DEF FN' and
|
9619 |
|
|
JP L1E39 ; jump back to PASS-BY
|
9620 |
|
|
|
9621 |
|
|
; ---
|
9622 |
|
|
|
9623 |
|
|
; continue here if checking syntax.
|
9624 |
|
|
|
9625 |
|
|
;; DEF-FN-1
|
9626 |
|
|
L1F6A: SET 6,(IY+$01) ; set FLAGS - Assume numeric result
|
9627 |
|
|
CALL L2C8D ; call routine ALPHA
|
9628 |
|
|
JR NC,L1F89 ; if not then to DEF-FN-4 to jump to
|
9629 |
|
|
; 'Nonsense in BASIC'
|
9630 |
|
|
|
9631 |
|
|
|
9632 |
|
|
RST 20H ; NEXT-CHAR
|
9633 |
|
|
CP $24 ; is it '$' ?
|
9634 |
|
|
JR NZ,L1F7D ; to DEF-FN-2 if not as numeric.
|
9635 |
|
|
|
9636 |
|
|
RES 6,(IY+$01) ; set FLAGS - Signal string result
|
9637 |
|
|
|
9638 |
|
|
RST 20H ; get NEXT-CHAR
|
9639 |
|
|
|
9640 |
|
|
;; DEF-FN-2
|
9641 |
|
|
L1F7D: CP $28 ; is it '(' ?
|
9642 |
|
|
JR NZ,L1FBD ; to DEF-FN-7 'Nonsense in BASIC'
|
9643 |
|
|
|
9644 |
|
|
|
9645 |
|
|
RST 20H ; NEXT-CHAR
|
9646 |
|
|
CP $29 ; is it ')' ?
|
9647 |
|
|
JR Z,L1FA6 ; to DEF-FN-6 if null argument
|
9648 |
|
|
|
9649 |
|
|
;; DEF-FN-3
|
9650 |
|
|
L1F86: CALL L2C8D ; routine ALPHA checks that it is the expected
|
9651 |
|
|
; alphabetic character.
|
9652 |
|
|
|
9653 |
|
|
;; DEF-FN-4
|
9654 |
|
|
L1F89: JP NC,L1C8A ; to REPORT-C if not
|
9655 |
|
|
; 'Nonsense in BASIC'.
|
9656 |
|
|
|
9657 |
|
|
EX DE,HL ; save pointer in DE
|
9658 |
|
|
|
9659 |
|
|
RST 20H ; NEXT-CHAR re-initializes HL from CH_ADD
|
9660 |
|
|
; and advances.
|
9661 |
|
|
CP $24 ; '$' ? is it a string argument.
|
9662 |
|
|
JR NZ,L1F94 ; forward to DEF-FN-5 if not.
|
9663 |
|
|
|
9664 |
|
|
EX DE,HL ; save pointer to '$' in DE
|
9665 |
|
|
|
9666 |
|
|
RST 20H ; NEXT-CHAR re-initializes HL and advances
|
9667 |
|
|
|
9668 |
|
|
;; DEF-FN-5
|
9669 |
|
|
L1F94: EX DE,HL ; bring back pointer.
|
9670 |
|
|
LD BC,$0006 ; the function requires six hidden bytes for
|
9671 |
|
|
; each parameter passed.
|
9672 |
|
|
; The first byte will be $0E
|
9673 |
|
|
; then 5-byte numeric value
|
9674 |
|
|
; or 5-byte string pointer.
|
9675 |
|
|
|
9676 |
|
|
CALL L1655 ; routine MAKE-ROOM creates space in program
|
9677 |
|
|
; area.
|
9678 |
|
|
|
9679 |
|
|
INC HL ; adjust HL (set by LDDR)
|
9680 |
|
|
INC HL ; to point to first location.
|
9681 |
|
|
LD (HL),$0E ; insert the 'hidden' marker.
|
9682 |
|
|
|
9683 |
|
|
; Note. these invisible storage locations hold nothing meaningful for the
|
9684 |
|
|
; moment. They will be used every time the corresponding function is
|
9685 |
|
|
; evaluated in runtime.
|
9686 |
|
|
; Now consider the following character fetched earlier.
|
9687 |
|
|
|
9688 |
|
|
CP $2C ; is it ',' ? (more than one parameter)
|
9689 |
|
|
JR NZ,L1FA6 ; to DEF-FN-6 if not
|
9690 |
|
|
|
9691 |
|
|
|
9692 |
|
|
RST 20H ; else NEXT-CHAR
|
9693 |
|
|
JR L1F86 ; and back to DEF-FN-3
|
9694 |
|
|
|
9695 |
|
|
; ---
|
9696 |
|
|
|
9697 |
|
|
;; DEF-FN-6
|
9698 |
|
|
L1FA6: CP $29 ; should close with a ')'
|
9699 |
|
|
JR NZ,L1FBD ; to DEF-FN-7 if not
|
9700 |
|
|
; 'Nonsense in BASIC'
|
9701 |
|
|
|
9702 |
|
|
|
9703 |
|
|
RST 20H ; get NEXT-CHAR
|
9704 |
|
|
CP $3D ; is it '=' ?
|
9705 |
|
|
JR NZ,L1FBD ; to DEF-FN-7 if not 'Nonsense...'
|
9706 |
|
|
|
9707 |
|
|
|
9708 |
|
|
RST 20H ; address NEXT-CHAR
|
9709 |
|
|
LD A,($5C3B) ; get FLAGS which has been set above
|
9710 |
|
|
PUSH AF ; and preserve
|
9711 |
|
|
|
9712 |
|
|
CALL L24FB ; routine SCANNING checks syntax of expression
|
9713 |
|
|
; and also sets flags.
|
9714 |
|
|
|
9715 |
|
|
POP AF ; restore previous flags
|
9716 |
|
|
XOR (IY+$01) ; xor with FLAGS - bit 6 should be same
|
9717 |
|
|
; therefore will be reset.
|
9718 |
|
|
AND $40 ; isolate bit 6.
|
9719 |
|
|
|
9720 |
|
|
;; DEF-FN-7
|
9721 |
|
|
L1FBD: JP NZ,L1C8A ; jump back to REPORT-C if the expected result
|
9722 |
|
|
; is not the same type.
|
9723 |
|
|
; 'Nonsense in BASIC'
|
9724 |
|
|
|
9725 |
|
|
CALL L1BEE ; routine CHECK-END will return early if
|
9726 |
|
|
; at end of statement and move onto next
|
9727 |
|
|
; else produce error report. >>>
|
9728 |
|
|
|
9729 |
|
|
; There will be no return to here.
|
9730 |
|
|
|
9731 |
|
|
; -------------------------------
|
9732 |
|
|
; Returning early from subroutine
|
9733 |
|
|
; -------------------------------
|
9734 |
|
|
; All routines are capable of being run in two modes - syntax checking mode
|
9735 |
|
|
; and runtime mode. This routine is called often to allow a routine to return
|
9736 |
|
|
; early if checking syntax.
|
9737 |
|
|
|
9738 |
|
|
;; UNSTACK-Z
|
9739 |
|
|
L1FC3: CALL L2530 ; routine SYNTAX-Z sets zero flag if syntax
|
9740 |
|
|
; is being checked.
|
9741 |
|
|
|
9742 |
|
|
POP HL ; drop the return address.
|
9743 |
|
|
RET Z ; return to previous call in chain if checking
|
9744 |
|
|
; syntax.
|
9745 |
|
|
|
9746 |
|
|
JP (HL) ; jump to return address as BASIC program is
|
9747 |
|
|
; actually running.
|
9748 |
|
|
|
9749 |
|
|
; ---------------------
|
9750 |
|
|
; Handle LPRINT command
|
9751 |
|
|
; ---------------------
|
9752 |
|
|
; A simple form of 'PRINT #3' although it can output to 16 streams.
|
9753 |
|
|
; Probably for compatibility with other BASICs particularly ZX81 BASIC.
|
9754 |
|
|
; An extra UDG might have been better.
|
9755 |
|
|
|
9756 |
|
|
;; LPRINT
|
9757 |
|
|
L1FC9: LD A,$03 ; the printer channel
|
9758 |
|
|
JR L1FCF ; forward to PRINT-1
|
9759 |
|
|
|
9760 |
|
|
; ---------------------
|
9761 |
|
|
; Handle PRINT commands
|
9762 |
|
|
; ---------------------
|
9763 |
|
|
; The Spectrum's main stream output command.
|
9764 |
|
|
; The default stream is stream 2 which is normally the upper screen
|
9765 |
|
|
; of the computer. However the stream can be altered in range 0 - 15.
|
9766 |
|
|
|
9767 |
|
|
;; PRINT
|
9768 |
|
|
L1FCD: LD A,$02 ; the stream for the upper screen.
|
9769 |
|
|
|
9770 |
|
|
; The LPRINT command joins here.
|
9771 |
|
|
|
9772 |
|
|
;; PRINT-1
|
9773 |
|
|
L1FCF: CALL L2530 ; routine SYNTAX-Z checks if program running
|
9774 |
|
|
CALL NZ,L1601 ; routine CHAN-OPEN if so
|
9775 |
|
|
CALL L0D4D ; routine TEMPS sets temporary colours.
|
9776 |
|
|
CALL L1FDF ; routine PRINT-2 - the actual item
|
9777 |
|
|
CALL L1BEE ; routine CHECK-END gives error if not at end
|
9778 |
|
|
; of statement
|
9779 |
|
|
RET ; and return >>>
|
9780 |
|
|
|
9781 |
|
|
; ------------------------------------
|
9782 |
|
|
; this subroutine is called from above
|
9783 |
|
|
; and also from INPUT.
|
9784 |
|
|
|
9785 |
|
|
;; PRINT-2
|
9786 |
|
|
L1FDF: RST 18H ; GET-CHAR gets printable character
|
9787 |
|
|
CALL L2045 ; routine PR-END-Z checks if more printing
|
9788 |
|
|
JR Z,L1FF2 ; to PRINT-4 if not e.g. just 'PRINT :'
|
9789 |
|
|
|
9790 |
|
|
; This tight loop deals with combinations of positional controls and
|
9791 |
|
|
; print items. An early return can be made from within the loop
|
9792 |
|
|
; if the end of a print sequence is reached.
|
9793 |
|
|
|
9794 |
|
|
;; PRINT-3
|
9795 |
|
|
L1FE5: CALL L204E ; routine PR-POSN-1 returns zero if more
|
9796 |
|
|
; but returns early at this point if
|
9797 |
|
|
; at end of statement!
|
9798 |
|
|
;
|
9799 |
|
|
JR Z,L1FE5 ; to PRINT-3 if consecutive positioners
|
9800 |
|
|
|
9801 |
|
|
CALL L1FFC ; routine PR-ITEM-1 deals with strings etc.
|
9802 |
|
|
CALL L204E ; routine PR-POSN-1 for more position codes
|
9803 |
|
|
JR Z,L1FE5 ; loop back to PRINT-3 if so
|
9804 |
|
|
|
9805 |
|
|
;; PRINT-4
|
9806 |
|
|
L1FF2: CP $29 ; return now if this is ')' from input-item.
|
9807 |
|
|
; (see INPUT.)
|
9808 |
|
|
RET Z ; or continue and print carriage return in
|
9809 |
|
|
; runtime
|
9810 |
|
|
|
9811 |
|
|
; ---------------------
|
9812 |
|
|
; Print carriage return
|
9813 |
|
|
; ---------------------
|
9814 |
|
|
; This routine which continues from above prints a carriage return
|
9815 |
|
|
; in run-time. It is also called once from PRINT-POSN.
|
9816 |
|
|
|
9817 |
|
|
;; PRINT-CR
|
9818 |
|
|
L1FF5: CALL L1FC3 ; routine UNSTACK-Z
|
9819 |
|
|
|
9820 |
|
|
LD A,$0D ; prepare a carriage return
|
9821 |
|
|
|
9822 |
|
|
RST 10H ; PRINT-A
|
9823 |
|
|
RET ; return
|
9824 |
|
|
|
9825 |
|
|
|
9826 |
|
|
; -----------
|
9827 |
|
|
; Print items
|
9828 |
|
|
; -----------
|
9829 |
|
|
; This routine deals with print items as in
|
9830 |
|
|
; PRINT AT 10,0;"The value of A is ";a
|
9831 |
|
|
; It returns once a single item has been dealt with as it is part
|
9832 |
|
|
; of a tight loop that considers sequences of positional and print items
|
9833 |
|
|
|
9834 |
|
|
;; PR-ITEM-1
|
9835 |
|
|
L1FFC: RST 18H ; GET-CHAR
|
9836 |
|
|
CP $AC ; is character 'AT' ?
|
9837 |
|
|
JR NZ,L200E ; forward to PR-ITEM-2 if not.
|
9838 |
|
|
|
9839 |
|
|
CALL L1C79 ; routine NEXT-2NUM check for two comma
|
9840 |
|
|
; separated numbers placing them on the
|
9841 |
|
|
; calculator stack in runtime.
|
9842 |
|
|
CALL L1FC3 ; routine UNSTACK-Z quits if checking syntax.
|
9843 |
|
|
|
9844 |
|
|
CALL L2307 ; routine STK-TO-BC get the numbers in B and C.
|
9845 |
|
|
LD A,$16 ; prepare the 'at' control.
|
9846 |
|
|
JR L201E ; forward to PR-AT-TAB to print the sequence.
|
9847 |
|
|
|
9848 |
|
|
; ---
|
9849 |
|
|
|
9850 |
|
|
;; PR-ITEM-2
|
9851 |
|
|
L200E: CP $AD ; is character 'TAB' ?
|
9852 |
|
|
JR NZ,L2024 ; to PR-ITEM-3 if not
|
9853 |
|
|
|
9854 |
|
|
|
9855 |
|
|
RST 20H ; NEXT-CHAR to address next character
|
9856 |
|
|
CALL L1C82 ; routine EXPT-1NUM
|
9857 |
|
|
CALL L1FC3 ; routine UNSTACK-Z quits if checking syntax.
|
9858 |
|
|
|
9859 |
|
|
CALL L1E99 ; routine FIND-INT2 puts integer in BC.
|
9860 |
|
|
LD A,$17 ; prepare the 'tab' control.
|
9861 |
|
|
|
9862 |
|
|
;; PR-AT-TAB
|
9863 |
|
|
L201E: RST 10H ; PRINT-A outputs the control
|
9864 |
|
|
|
9865 |
|
|
LD A,C ; first value to A
|
9866 |
|
|
RST 10H ; PRINT-A outputs it.
|
9867 |
|
|
|
9868 |
|
|
LD A,B ; second value
|
9869 |
|
|
RST 10H ; PRINT-A
|
9870 |
|
|
|
9871 |
|
|
RET ; return - item finished >>>
|
9872 |
|
|
|
9873 |
|
|
; ---
|
9874 |
|
|
|
9875 |
|
|
; Now consider paper 2; #2; a$
|
9876 |
|
|
|
9877 |
|
|
;; PR-ITEM-3
|
9878 |
|
|
L2024: CALL L21F2 ; routine CO-TEMP-3 will print any colour
|
9879 |
|
|
RET NC ; items - return if success.
|
9880 |
|
|
|
9881 |
|
|
CALL L2070 ; routine STR-ALTER considers new stream
|
9882 |
|
|
RET NC ; return if altered.
|
9883 |
|
|
|
9884 |
|
|
CALL L24FB ; routine SCANNING now to evaluate expression
|
9885 |
|
|
CALL L1FC3 ; routine UNSTACK-Z if not runtime.
|
9886 |
|
|
|
9887 |
|
|
BIT 6,(IY+$01) ; test FLAGS - Numeric or string result ?
|
9888 |
|
|
CALL Z,L2BF1 ; routine STK-FETCH if string.
|
9889 |
|
|
; note no flags affected.
|
9890 |
|
|
JP NZ,L2DE3 ; to PRINT-FP to print if numeric >>>
|
9891 |
|
|
|
9892 |
|
|
; It was a string expression - start in DE, length in BC
|
9893 |
|
|
; Now enter a loop to print it
|
9894 |
|
|
|
9895 |
|
|
;; PR-STRING
|
9896 |
|
|
L203C: LD A,B ; this tests if the
|
9897 |
|
|
OR C ; length is zero and sets flag accordingly.
|
9898 |
|
|
DEC BC ; this doesn't but decrements counter.
|
9899 |
|
|
RET Z ; return if zero.
|
9900 |
|
|
|
9901 |
|
|
LD A,(DE) ; fetch character.
|
9902 |
|
|
INC DE ; address next location.
|
9903 |
|
|
|
9904 |
|
|
RST 10H ; PRINT-A.
|
9905 |
|
|
|
9906 |
|
|
JR L203C ; loop back to PR-STRING.
|
9907 |
|
|
|
9908 |
|
|
; ---------------
|
9909 |
|
|
; End of printing
|
9910 |
|
|
; ---------------
|
9911 |
|
|
; This subroutine returns zero if no further printing is required
|
9912 |
|
|
; in the current statement.
|
9913 |
|
|
; The first terminator is found in escaped input items only,
|
9914 |
|
|
; the others in print_items.
|
9915 |
|
|
|
9916 |
|
|
;; PR-END-Z
|
9917 |
|
|
L2045: CP $29 ; is character a ')' ?
|
9918 |
|
|
RET Z ; return if so - e.g. INPUT (p$); a$
|
9919 |
|
|
|
9920 |
|
|
;; PR-ST-END
|
9921 |
|
|
L2048: CP $0D ; is it a carriage return ?
|
9922 |
|
|
RET Z ; return also - e.g. PRINT a
|
9923 |
|
|
|
9924 |
|
|
CP $3A ; is character a ':' ?
|
9925 |
|
|
RET ; return - zero flag will be set if so.
|
9926 |
|
|
; e.g. PRINT a :
|
9927 |
|
|
|
9928 |
|
|
; --------------
|
9929 |
|
|
; Print position
|
9930 |
|
|
; --------------
|
9931 |
|
|
; This routine considers a single positional character ';', ',', '''
|
9932 |
|
|
|
9933 |
|
|
;; PR-POSN-1
|
9934 |
|
|
L204E: RST 18H ; GET-CHAR
|
9935 |
|
|
CP $3B ; is it ';' ?
|
9936 |
|
|
; i.e. print from last position.
|
9937 |
|
|
JR Z,L2067 ; forward to PR-POSN-3 if so.
|
9938 |
|
|
; i.e. do nothing.
|
9939 |
|
|
|
9940 |
|
|
CP $2C ; is it ',' ?
|
9941 |
|
|
; i.e. print at next tabstop.
|
9942 |
|
|
JR NZ,L2061 ; forward to PR-POSN-2 if anything else.
|
9943 |
|
|
|
9944 |
|
|
CALL L2530 ; routine SYNTAX-Z
|
9945 |
|
|
JR Z,L2067 ; forward to PR-POSN-3 if checking syntax.
|
9946 |
|
|
|
9947 |
|
|
LD A,$06 ; prepare the 'comma' control character.
|
9948 |
|
|
|
9949 |
|
|
RST 10H ; PRINT-A outputs to current channel in
|
9950 |
|
|
; run-time.
|
9951 |
|
|
|
9952 |
|
|
JR L2067 ; skip to PR-POSN-3.
|
9953 |
|
|
|
9954 |
|
|
; ---
|
9955 |
|
|
|
9956 |
|
|
; check for newline.
|
9957 |
|
|
|
9958 |
|
|
;; PR-POSN-2
|
9959 |
|
|
L2061: CP $27 ; is character a "'" ? (newline)
|
9960 |
|
|
RET NZ ; return if no match >>>
|
9961 |
|
|
|
9962 |
|
|
CALL L1FF5 ; routine PRINT-CR outputs a carriage return
|
9963 |
|
|
; in runtime only.
|
9964 |
|
|
|
9965 |
|
|
;; PR-POSN-3
|
9966 |
|
|
L2067: RST 20H ; NEXT-CHAR to A.
|
9967 |
|
|
CALL L2045 ; routine PR-END-Z checks if at end.
|
9968 |
|
|
JR NZ,L206E ; to PR-POSN-4 if not.
|
9969 |
|
|
|
9970 |
|
|
POP BC ; drop return address if at end.
|
9971 |
|
|
|
9972 |
|
|
;; PR-POSN-4
|
9973 |
|
|
L206E: CP A ; reset the zero flag.
|
9974 |
|
|
RET ; and return to loop or quit.
|
9975 |
|
|
|
9976 |
|
|
; ------------
|
9977 |
|
|
; Alter stream
|
9978 |
|
|
; ------------
|
9979 |
|
|
; This routine is called from PRINT ITEMS above, and also LIST as in
|
9980 |
|
|
; LIST #15
|
9981 |
|
|
|
9982 |
|
|
;; STR-ALTER
|
9983 |
|
|
L2070: CP $23 ; is character '#' ?
|
9984 |
|
|
SCF ; set carry flag.
|
9985 |
|
|
RET NZ ; return if no match.
|
9986 |
|
|
|
9987 |
|
|
|
9988 |
|
|
RST 20H ; NEXT-CHAR
|
9989 |
|
|
CALL L1C82 ; routine EXPT-1NUM gets stream number
|
9990 |
|
|
AND A ; prepare to exit early with carry reset
|
9991 |
|
|
CALL L1FC3 ; routine UNSTACK-Z exits early if parsing
|
9992 |
|
|
CALL L1E94 ; routine FIND-INT1 gets number off stack
|
9993 |
|
|
CP $10 ; must be range 0 - 15 decimal.
|
9994 |
|
|
JP NC,L160E ; jump back to REPORT-Oa if not
|
9995 |
|
|
; 'Invalid stream'.
|
9996 |
|
|
|
9997 |
|
|
CALL L1601 ; routine CHAN-OPEN
|
9998 |
|
|
AND A ; clear carry - signal item dealt with.
|
9999 |
|
|
RET ; return
|
10000 |
|
|
|
10001 |
|
|
; -------------------
|
10002 |
|
|
; THE 'INPUT' COMMAND
|
10003 |
|
|
; -------------------
|
10004 |
|
|
; This command is mysterious.
|
10005 |
|
|
;
|
10006 |
|
|
|
10007 |
|
|
;; INPUT
|
10008 |
|
|
L2089: CALL L2530 ; routine SYNTAX-Z to check if in runtime.
|
10009 |
|
|
|
10010 |
|
|
JR Z,L2096 ; forward to INPUT-1 if checking syntax.
|
10011 |
|
|
|
10012 |
|
|
LD A,$01 ; select channel 'K' the keyboard for input.
|
10013 |
|
|
CALL L1601 ; routine CHAN-OPEN opens the channel and sets
|
10014 |
|
|
; bit 0 of TV_FLAG.
|
10015 |
|
|
|
10016 |
|
|
; Note. As a consequence of clearing the lower screen channel 0 is made
|
10017 |
|
|
; the current channel so the above two instructions are superfluous.
|
10018 |
|
|
|
10019 |
|
|
CALL L0D6E ; routine CLS-LOWER clears the lower screen
|
10020 |
|
|
; and sets DF_SZ to two and TV_FLAG to $01.
|
10021 |
|
|
|
10022 |
|
|
;; INPUT-1
|
10023 |
|
|
L2096: LD (IY+$02),$01 ; update TV_FLAG - signal lower screen in use
|
10024 |
|
|
; ensuring that the correct set of system
|
10025 |
|
|
; variables are updated and that the border
|
10026 |
|
|
; colour is used.
|
10027 |
|
|
|
10028 |
|
|
; Note. The Complete Spectrum ROM Disassembly incorrectly names DF-SZ as the
|
10029 |
|
|
; system variable that is updated above and if, as some have done, you make
|
10030 |
|
|
; this unnecessary alteration then there will be two blank lines between the
|
10031 |
|
|
; lower screen and the upper screen areas which will also scroll wrongly.
|
10032 |
|
|
|
10033 |
|
|
CALL L20C1 ; routine IN-ITEM-1 to handle the input.
|
10034 |
|
|
|
10035 |
|
|
CALL L1BEE ; routine CHECK-END will make an early exit
|
10036 |
|
|
; if checking syntax. >>>
|
10037 |
|
|
|
10038 |
|
|
; Keyboard input has been made and it remains to adjust the upper
|
10039 |
|
|
; screen in case the lower two lines have been extended upwards.
|
10040 |
|
|
|
10041 |
|
|
LD BC,($5C88) ; fetch S_POSN current line/column of
|
10042 |
|
|
; the upper screen.
|
10043 |
|
|
LD A,($5C6B) ; fetch DF_SZ the display file size of
|
10044 |
|
|
; the lower screen.
|
10045 |
|
|
CP B ; test that lower screen does not overlap
|
10046 |
|
|
JR C,L20AD ; forward to INPUT-2 if not.
|
10047 |
|
|
|
10048 |
|
|
; the two screens overlap so adjust upper screen.
|
10049 |
|
|
|
10050 |
|
|
LD C,$21 ; set column of upper screen to leftmost.
|
10051 |
|
|
LD B,A ; and line to one above lower screen.
|
10052 |
|
|
; continue forward to update upper screen
|
10053 |
|
|
; print position.
|
10054 |
|
|
|
10055 |
|
|
;; INPUT-2
|
10056 |
|
|
L20AD: LD ($5C88),BC ; set S_POSN update upper screen line/column.
|
10057 |
|
|
LD A,$19 ; subtract from twenty five
|
10058 |
|
|
SUB B ; the new line number.
|
10059 |
|
|
LD ($5C8C),A ; and place result in SCR_CT - scroll count.
|
10060 |
|
|
RES 0,(IY+$02) ; update TV_FLAG - signal main screen in use.
|
10061 |
|
|
|
10062 |
|
|
CALL L0DD9 ; routine CL-SET sets the print position
|
10063 |
|
|
; system variables for the upper screen.
|
10064 |
|
|
|
10065 |
|
|
JP L0D6E ; jump back to CLS-LOWER and make
|
10066 |
|
|
; an indirect exit >>.
|
10067 |
|
|
|
10068 |
|
|
; ---------------------
|
10069 |
|
|
; INPUT ITEM subroutine
|
10070 |
|
|
; ---------------------
|
10071 |
|
|
; This subroutine deals with the input items and print items.
|
10072 |
|
|
; from the current input channel.
|
10073 |
|
|
; It is only called from the above INPUT routine but was obviously
|
10074 |
|
|
; once called from somewhere else in another context.
|
10075 |
|
|
|
10076 |
|
|
;; IN-ITEM-1
|
10077 |
|
|
L20C1: CALL L204E ; routine PR-POSN-1 deals with a single
|
10078 |
|
|
; position item at each call.
|
10079 |
|
|
JR Z,L20C1 ; back to IN-ITEM-1 until no more in a
|
10080 |
|
|
; sequence.
|
10081 |
|
|
|
10082 |
|
|
CP $28 ; is character '(' ?
|
10083 |
|
|
JR NZ,L20D8 ; forward to IN-ITEM-2 if not.
|
10084 |
|
|
|
10085 |
|
|
; any variables within braces will be treated as part, or all, of the prompt
|
10086 |
|
|
; instead of being used as destination variables.
|
10087 |
|
|
|
10088 |
|
|
RST 20H ; NEXT-CHAR
|
10089 |
|
|
CALL L1FDF ; routine PRINT-2 to output the dynamic
|
10090 |
|
|
; prompt.
|
10091 |
|
|
|
10092 |
|
|
RST 18H ; GET-CHAR
|
10093 |
|
|
CP $29 ; is character a matching ')' ?
|
10094 |
|
|
JP NZ,L1C8A ; jump back to REPORT-C if not.
|
10095 |
|
|
; 'Nonsense in BASIC'.
|
10096 |
|
|
|
10097 |
|
|
RST 20H ; NEXT-CHAR
|
10098 |
|
|
JP L21B2 ; forward to IN-NEXT-2
|
10099 |
|
|
|
10100 |
|
|
; ---
|
10101 |
|
|
|
10102 |
|
|
;; IN-ITEM-2
|
10103 |
|
|
L20D8: CP $CA ; is the character the token 'LINE' ?
|
10104 |
|
|
JR NZ,L20ED ; forward to IN-ITEM-3 if not.
|
10105 |
|
|
|
10106 |
|
|
RST 20H ; NEXT-CHAR - variable must come next.
|
10107 |
|
|
CALL L1C1F ; routine CLASS-01 returns destination
|
10108 |
|
|
; address of variable to be assigned.
|
10109 |
|
|
; or generates an error if no variable
|
10110 |
|
|
; at this position.
|
10111 |
|
|
|
10112 |
|
|
SET 7,(IY+$37) ; update FLAGX - signal handling INPUT LINE
|
10113 |
|
|
BIT 6,(IY+$01) ; test FLAGS - numeric or string result ?
|
10114 |
|
|
JP NZ,L1C8A ; jump back to REPORT-C if not string
|
10115 |
|
|
; 'Nonsense in BASIC'.
|
10116 |
|
|
|
10117 |
|
|
JR L20FA ; forward to IN-PROMPT to set up workspace.
|
10118 |
|
|
|
10119 |
|
|
; ---
|
10120 |
|
|
|
10121 |
|
|
; the jump was here for other variables.
|
10122 |
|
|
|
10123 |
|
|
;; IN-ITEM-3
|
10124 |
|
|
L20ED: CALL L2C8D ; routine ALPHA checks if character is
|
10125 |
|
|
; a suitable variable name.
|
10126 |
|
|
JP NC,L21AF ; forward to IN-NEXT-1 if not
|
10127 |
|
|
|
10128 |
|
|
CALL L1C1F ; routine CLASS-01 returns destination
|
10129 |
|
|
; address of variable to be assigned.
|
10130 |
|
|
RES 7,(IY+$37) ; update FLAGX - signal not INPUT LINE.
|
10131 |
|
|
|
10132 |
|
|
;; IN-PROMPT
|
10133 |
|
|
L20FA: CALL L2530 ; routine SYNTAX-Z
|
10134 |
|
|
JP Z,L21B2 ; forward to IN-NEXT-2 if checking syntax.
|
10135 |
|
|
|
10136 |
|
|
CALL L16BF ; routine SET-WORK clears workspace.
|
10137 |
|
|
LD HL,$5C71 ; point to system variable FLAGX
|
10138 |
|
|
RES 6,(HL) ; signal string result.
|
10139 |
|
|
SET 5,(HL) ; signal in Input Mode for editor.
|
10140 |
|
|
LD BC,$0001 ; initialize space required to one for
|
10141 |
|
|
; the carriage return.
|
10142 |
|
|
BIT 7,(HL) ; test FLAGX - INPUT LINE in use ?
|
10143 |
|
|
JR NZ,L211C ; forward to IN-PR-2 if so as that is
|
10144 |
|
|
; all the space that is required.
|
10145 |
|
|
|
10146 |
|
|
LD A,($5C3B) ; load accumulator from FLAGS
|
10147 |
|
|
AND $40 ; mask to test BIT 6 of FLAGS and clear
|
10148 |
|
|
; the other bits in A.
|
10149 |
|
|
; numeric result expected ?
|
10150 |
|
|
JR NZ,L211A ; forward to IN-PR-1 if so
|
10151 |
|
|
|
10152 |
|
|
LD C,$03 ; increase space to three bytes for the
|
10153 |
|
|
; pair of surrounding quotes.
|
10154 |
|
|
|
10155 |
|
|
;; IN-PR-1
|
10156 |
|
|
L211A: OR (HL) ; if numeric result, set bit 6 of FLAGX.
|
10157 |
|
|
LD (HL),A ; and update system variable
|
10158 |
|
|
|
10159 |
|
|
;; IN-PR-2
|
10160 |
|
|
L211C: RST 30H ; BC-SPACES opens 1 or 3 bytes in workspace
|
10161 |
|
|
LD (HL),$0D ; insert carriage return at last new location.
|
10162 |
|
|
LD A,C ; fetch the length, one or three.
|
10163 |
|
|
RRCA ; lose bit 0.
|
10164 |
|
|
RRCA ; test if quotes required.
|
10165 |
|
|
JR NC,L2129 ; forward to IN-PR-3 if not.
|
10166 |
|
|
|
10167 |
|
|
LD A,$22 ; load the '"' character
|
10168 |
|
|
LD (DE),A ; place quote in first new location at DE.
|
10169 |
|
|
DEC HL ; decrease HL - from carriage return.
|
10170 |
|
|
LD (HL),A ; and place a quote in second location.
|
10171 |
|
|
|
10172 |
|
|
;; IN-PR-3
|
10173 |
|
|
L2129: LD ($5C5B),HL ; set keyboard cursor K_CUR to HL
|
10174 |
|
|
BIT 7,(IY+$37) ; test FLAGX - is this INPUT LINE ??
|
10175 |
|
|
JR NZ,L215E ; forward to IN-VAR-3 if so as input will
|
10176 |
|
|
; be accepted without checking its syntax.
|
10177 |
|
|
|
10178 |
|
|
LD HL,($5C5D) ; fetch CH_ADD
|
10179 |
|
|
PUSH HL ; and save on stack.
|
10180 |
|
|
LD HL,($5C3D) ; fetch ERR_SP
|
10181 |
|
|
PUSH HL ; and save on stack
|
10182 |
|
|
|
10183 |
|
|
;; IN-VAR-1
|
10184 |
|
|
L213A: LD HL,L213A ; address: IN-VAR-1 - this address
|
10185 |
|
|
PUSH HL ; is saved on stack to handle errors.
|
10186 |
|
|
BIT 4,(IY+$30) ; test FLAGS2 - is K channel in use ?
|
10187 |
|
|
JR Z,L2148 ; forward to IN-VAR-2 if not using the
|
10188 |
|
|
; keyboard for input. (??)
|
10189 |
|
|
|
10190 |
|
|
LD ($5C3D),SP ; set ERR_SP to point to IN-VAR-1 on stack.
|
10191 |
|
|
|
10192 |
|
|
;; IN-VAR-2
|
10193 |
|
|
L2148: LD HL,($5C61) ; set HL to WORKSP - start of workspace.
|
10194 |
|
|
CALL L11A7 ; routine REMOVE-FP removes floating point
|
10195 |
|
|
; forms when looping in error condition.
|
10196 |
|
|
LD (IY+$00),$FF ; set ERR_NR to 'OK' cancelling the error.
|
10197 |
|
|
; but X_PTR causes flashing error marker
|
10198 |
|
|
; to be displayed at each call to the editor.
|
10199 |
|
|
CALL L0F2C ; routine EDITOR allows input to be entered
|
10200 |
|
|
; or corrected if this is second time around.
|
10201 |
|
|
|
10202 |
|
|
; if we pass to next then there are no system errors
|
10203 |
|
|
|
10204 |
|
|
RES 7,(IY+$01) ; update FLAGS - signal checking syntax
|
10205 |
|
|
CALL L21B9 ; routine IN-ASSIGN checks syntax using
|
10206 |
|
|
; the VAL-FET-2 and powerful SCANNING routines.
|
10207 |
|
|
; any syntax error and its back to IN-VAR-1.
|
10208 |
|
|
; but with the flashing error marker showing
|
10209 |
|
|
; where the error is.
|
10210 |
|
|
; Note. the syntax of string input has to be
|
10211 |
|
|
; checked as the user may have removed the
|
10212 |
|
|
; bounding quotes or escaped them as with
|
10213 |
|
|
; "hat" + "stand" for example.
|
10214 |
|
|
; proceed if syntax passed.
|
10215 |
|
|
|
10216 |
|
|
JR L2161 ; jump forward to IN-VAR-4
|
10217 |
|
|
|
10218 |
|
|
; ---
|
10219 |
|
|
|
10220 |
|
|
; the jump was to here when using INPUT LINE.
|
10221 |
|
|
|
10222 |
|
|
;; IN-VAR-3
|
10223 |
|
|
L215E: CALL L0F2C ; routine EDITOR is called for input
|
10224 |
|
|
|
10225 |
|
|
; when ENTER received rejoin other route but with no syntax check.
|
10226 |
|
|
|
10227 |
|
|
; INPUT and INPUT LINE converge here.
|
10228 |
|
|
|
10229 |
|
|
;; IN-VAR-4
|
10230 |
|
|
L2161: LD (IY+$22),$00 ; set K_CUR_hi to a low value so that the cursor
|
10231 |
|
|
; no longer appears in the input line.
|
10232 |
|
|
|
10233 |
|
|
CALL L21D6 ; routine IN-CHAN-K tests if the keyboard
|
10234 |
|
|
; is being used for input.
|
10235 |
|
|
JR NZ,L2174 ; forward to IN-VAR-5 if using another input
|
10236 |
|
|
; channel.
|
10237 |
|
|
|
10238 |
|
|
; continue here if using the keyboard.
|
10239 |
|
|
|
10240 |
|
|
CALL L111D ; routine ED-COPY overprints the edit line
|
10241 |
|
|
; to the lower screen. The only visible
|
10242 |
|
|
; affect is that the cursor disappears.
|
10243 |
|
|
; if you're inputting more than one item in
|
10244 |
|
|
; a statement then that becomes apparent.
|
10245 |
|
|
|
10246 |
|
|
LD BC,($5C82) ; fetch line and column from ECHO_E
|
10247 |
|
|
CALL L0DD9 ; routine CL-SET sets S-POSNL to those
|
10248 |
|
|
; values.
|
10249 |
|
|
|
10250 |
|
|
; if using another input channel rejoin here.
|
10251 |
|
|
|
10252 |
|
|
;; IN-VAR-5
|
10253 |
|
|
L2174: LD HL,$5C71 ; point HL to FLAGX
|
10254 |
|
|
RES 5,(HL) ; signal not in input mode
|
10255 |
|
|
BIT 7,(HL) ; is this INPUT LINE ?
|
10256 |
|
|
RES 7,(HL) ; cancel the bit anyway.
|
10257 |
|
|
JR NZ,L219B ; forward to IN-VAR-6 if INPUT LINE.
|
10258 |
|
|
|
10259 |
|
|
POP HL ; drop the looping address
|
10260 |
|
|
POP HL ; drop the address of previous
|
10261 |
|
|
; error handler.
|
10262 |
|
|
LD ($5C3D),HL ; set ERR_SP to point to it.
|
10263 |
|
|
POP HL ; drop original CH_ADD which points to
|
10264 |
|
|
; INPUT command in BASIC line.
|
10265 |
|
|
LD ($5C5F),HL ; save in X_PTR while input is assigned.
|
10266 |
|
|
SET 7,(IY+$01) ; update FLAGS - Signal running program
|
10267 |
|
|
CALL L21B9 ; routine IN-ASSIGN is called again
|
10268 |
|
|
; this time the variable will be assigned
|
10269 |
|
|
; the input value without error.
|
10270 |
|
|
; Note. the previous example now
|
10271 |
|
|
; becomes "hatstand"
|
10272 |
|
|
|
10273 |
|
|
LD HL,($5C5F) ; fetch stored CH_ADD value from X_PTR.
|
10274 |
|
|
LD (IY+$26),$00 ; set X_PTR_hi so that iy is no longer relevant.
|
10275 |
|
|
LD ($5C5D),HL ; put restored value back in CH_ADD
|
10276 |
|
|
JR L21B2 ; forward to IN-NEXT-2 to see if anything
|
10277 |
|
|
; more in the INPUT list.
|
10278 |
|
|
|
10279 |
|
|
; ---
|
10280 |
|
|
|
10281 |
|
|
; the jump was to here with INPUT LINE only
|
10282 |
|
|
|
10283 |
|
|
;; IN-VAR-6
|
10284 |
|
|
L219B: LD HL,($5C63) ; STKBOT points to the end of the input.
|
10285 |
|
|
LD DE,($5C61) ; WORKSP points to the beginning.
|
10286 |
|
|
SCF ; prepare for true subtraction.
|
10287 |
|
|
SBC HL,DE ; subtract to get length
|
10288 |
|
|
LD B,H ; transfer it to
|
10289 |
|
|
LD C,L ; the BC register pair.
|
10290 |
|
|
CALL L2AB2 ; routine STK-STO-$ stores parameters on
|
10291 |
|
|
; the calculator stack.
|
10292 |
|
|
CALL L2AFF ; routine LET assigns it to destination.
|
10293 |
|
|
JR L21B2 ; forward to IN-NEXT-2 as print items
|
10294 |
|
|
; not allowed with INPUT LINE.
|
10295 |
|
|
; Note. that "hat" + "stand" will, for
|
10296 |
|
|
; example, be unchanged as also would
|
10297 |
|
|
; 'PRINT "Iris was here"'.
|
10298 |
|
|
|
10299 |
|
|
; ---
|
10300 |
|
|
|
10301 |
|
|
; the jump was to here when ALPHA found more items while looking for
|
10302 |
|
|
; a variable name.
|
10303 |
|
|
|
10304 |
|
|
;; IN-NEXT-1
|
10305 |
|
|
L21AF: CALL L1FFC ; routine PR-ITEM-1 considers further items.
|
10306 |
|
|
|
10307 |
|
|
;; IN-NEXT-2
|
10308 |
|
|
L21B2: CALL L204E ; routine PR-POSN-1 handles a position item.
|
10309 |
|
|
JP Z,L20C1 ; jump back to IN-ITEM-1 if the zero flag
|
10310 |
|
|
; indicates more items are present.
|
10311 |
|
|
|
10312 |
|
|
RET ; return.
|
10313 |
|
|
|
10314 |
|
|
; ---------------------------
|
10315 |
|
|
; INPUT ASSIGNMENT Subroutine
|
10316 |
|
|
; ---------------------------
|
10317 |
|
|
; This subroutine is called twice from the INPUT command when normal
|
10318 |
|
|
; keyboard input is assigned. On the first occasion syntax is checked
|
10319 |
|
|
; using SCANNING. The final call with the syntax flag reset is to make
|
10320 |
|
|
; the assignment.
|
10321 |
|
|
|
10322 |
|
|
;; IN-ASSIGN
|
10323 |
|
|
L21B9: LD HL,($5C61) ; fetch WORKSP start of input
|
10324 |
|
|
LD ($5C5D),HL ; set CH_ADD to first character
|
10325 |
|
|
|
10326 |
|
|
RST 18H ; GET-CHAR ignoring leading white-space.
|
10327 |
|
|
CP $E2 ; is it 'STOP'
|
10328 |
|
|
JR Z,L21D0 ; forward to IN-STOP if so.
|
10329 |
|
|
|
10330 |
|
|
LD A,($5C71) ; load accumulator from FLAGX
|
10331 |
|
|
CALL L1C59 ; routine VAL-FET-2 makes assignment
|
10332 |
|
|
; or goes through the motions if checking
|
10333 |
|
|
; syntax. SCANNING is used.
|
10334 |
|
|
|
10335 |
|
|
RST 18H ; GET-CHAR
|
10336 |
|
|
CP $0D ; is it carriage return ?
|
10337 |
|
|
RET Z ; return if so
|
10338 |
|
|
; either syntax is OK
|
10339 |
|
|
; or assignment has been made.
|
10340 |
|
|
|
10341 |
|
|
; if another character was found then raise an error.
|
10342 |
|
|
; User doesn't see report but the flashing error marker
|
10343 |
|
|
; appears in the lower screen.
|
10344 |
|
|
|
10345 |
|
|
;; REPORT-Cb
|
10346 |
|
|
L21CE: RST 08H ; ERROR-1
|
10347 |
|
|
DEFB $0B ; Error Report: Nonsense in BASIC
|
10348 |
|
|
|
10349 |
|
|
;; IN-STOP
|
10350 |
|
|
L21D0: CALL L2530 ; routine SYNTAX-Z (UNSTACK-Z?)
|
10351 |
|
|
RET Z ; return if checking syntax
|
10352 |
|
|
; as user wouldn't see error report.
|
10353 |
|
|
; but generate visible error report
|
10354 |
|
|
; on second invocation.
|
10355 |
|
|
|
10356 |
|
|
;; REPORT-H
|
10357 |
|
|
L21D4: RST 08H ; ERROR-1
|
10358 |
|
|
DEFB $10 ; Error Report: STOP in INPUT
|
10359 |
|
|
|
10360 |
|
|
; -----------------------------------
|
10361 |
|
|
; THE 'TEST FOR CHANNEL K' SUBROUTINE
|
10362 |
|
|
; -----------------------------------
|
10363 |
|
|
; This subroutine is called once from the keyboard INPUT command to check if
|
10364 |
|
|
; the input routine in use is the one for the keyboard.
|
10365 |
|
|
|
10366 |
|
|
;; IN-CHAN-K
|
10367 |
|
|
L21D6: LD HL,($5C51) ; fetch address of current channel CURCHL
|
10368 |
|
|
INC HL ;
|
10369 |
|
|
INC HL ; advance past
|
10370 |
|
|
INC HL ; input and
|
10371 |
|
|
INC HL ; output streams
|
10372 |
|
|
LD A,(HL) ; fetch the channel identifier.
|
10373 |
|
|
CP $4B ; test for 'K'
|
10374 |
|
|
RET ; return with zero set if keyboard is use.
|
10375 |
|
|
|
10376 |
|
|
; --------------------
|
10377 |
|
|
; Colour Item Routines
|
10378 |
|
|
; --------------------
|
10379 |
|
|
;
|
10380 |
|
|
; These routines have 3 entry points -
|
10381 |
|
|
; 1) CO-TEMP-2 to handle a series of embedded Graphic colour items.
|
10382 |
|
|
; 2) CO-TEMP-3 to handle a single embedded print colour item.
|
10383 |
|
|
; 3) CO TEMP-4 to handle a colour command such as FLASH 1
|
10384 |
|
|
;
|
10385 |
|
|
; "Due to a bug, if you bring in a peripheral channel and later use a colour
|
10386 |
|
|
; statement, colour controls will be sent to it by mistake." - Steven Vickers
|
10387 |
|
|
; Pitman Pocket Guide, 1984.
|
10388 |
|
|
;
|
10389 |
|
|
; To be fair, this only applies if the last channel was other than 'K', 'S'
|
10390 |
|
|
; or 'P', which are all that are supported by this ROM, but if that last
|
10391 |
|
|
; channel was a microdrive file, network channel etc. then
|
10392 |
|
|
; PAPER 6; CLS will not turn the screen yellow and
|
10393 |
|
|
; CIRCLE INK 2; 128,88,50 will not draw a red circle.
|
10394 |
|
|
;
|
10395 |
|
|
; This bug does not apply to embedded PRINT items as it is quite permissible
|
10396 |
|
|
; to mix stream altering commands and colour items.
|
10397 |
|
|
; The fix therefore would be to ensure that CLASS-07 and CLASS-09 make
|
10398 |
|
|
; channel 'S' the current channel when not checking syntax.
|
10399 |
|
|
; -----------------------------------------------------------------
|
10400 |
|
|
|
10401 |
|
|
;; CO-TEMP-1
|
10402 |
|
|
L21E1: RST 20H ; NEXT-CHAR
|
10403 |
|
|
|
10404 |
|
|
; -> Entry point from CLASS-09. Embedded Graphic colour items.
|
10405 |
|
|
; e.g. PLOT INK 2; PAPER 8; 128,88
|
10406 |
|
|
; Loops till all colour items output, finally addressing the coordinates.
|
10407 |
|
|
|
10408 |
|
|
;; CO-TEMP-2
|
10409 |
|
|
L21E2: CALL L21F2 ; routine CO-TEMP-3 to output colour control.
|
10410 |
|
|
RET C ; return if nothing more to output. ->
|
10411 |
|
|
|
10412 |
|
|
|
10413 |
|
|
RST 18H ; GET-CHAR
|
10414 |
|
|
CP $2C ; is it ',' separator ?
|
10415 |
|
|
JR Z,L21E1 ; back if so to CO-TEMP-1
|
10416 |
|
|
|
10417 |
|
|
CP $3B ; is it ';' separator ?
|
10418 |
|
|
JR Z,L21E1 ; back to CO-TEMP-1 for more.
|
10419 |
|
|
|
10420 |
|
|
JP L1C8A ; to REPORT-C (REPORT-Cb is within range)
|
10421 |
|
|
; 'Nonsense in BASIC'
|
10422 |
|
|
|
10423 |
|
|
; -------------------
|
10424 |
|
|
; CO-TEMP-3
|
10425 |
|
|
; -------------------
|
10426 |
|
|
; -> this routine evaluates and outputs a colour control and parameter.
|
10427 |
|
|
; It is called from above and also from PR-ITEM-3 to handle a single embedded
|
10428 |
|
|
; print item e.g. PRINT PAPER 6; "Hi". In the latter case, the looping for
|
10429 |
|
|
; multiple items is within the PR-ITEM routine.
|
10430 |
|
|
; It is quite permissible to send these to any stream.
|
10431 |
|
|
|
10432 |
|
|
;; CO-TEMP-3
|
10433 |
|
|
L21F2: CP $D9 ; is it 'INK' ?
|
10434 |
|
|
RET C ; return if less.
|
10435 |
|
|
|
10436 |
|
|
CP $DF ; compare with 'OUT'
|
10437 |
|
|
CCF ; Complement Carry Flag
|
10438 |
|
|
RET C ; return if greater than 'OVER', $DE.
|
10439 |
|
|
|
10440 |
|
|
PUSH AF ; save the colour token.
|
10441 |
|
|
|
10442 |
|
|
RST 20H ; address NEXT-CHAR
|
10443 |
|
|
POP AF ; restore token and continue.
|
10444 |
|
|
|
10445 |
|
|
; -> this entry point used by CLASS-07. e.g. the command PAPER 6.
|
10446 |
|
|
|
10447 |
|
|
;; CO-TEMP-4
|
10448 |
|
|
L21FC: SUB $C9 ; reduce to control character $10 (INK)
|
10449 |
|
|
; thru $15 (OVER).
|
10450 |
|
|
PUSH AF ; save control.
|
10451 |
|
|
CALL L1C82 ; routine EXPT-1NUM stacks addressed
|
10452 |
|
|
; parameter on calculator stack.
|
10453 |
|
|
POP AF ; restore control.
|
10454 |
|
|
AND A ; clear carry
|
10455 |
|
|
|
10456 |
|
|
CALL L1FC3 ; routine UNSTACK-Z returns if checking syntax.
|
10457 |
|
|
|
10458 |
|
|
PUSH AF ; save again
|
10459 |
|
|
CALL L1E94 ; routine FIND-INT1 fetches parameter to A.
|
10460 |
|
|
LD D,A ; transfer now to D
|
10461 |
|
|
POP AF ; restore control.
|
10462 |
|
|
|
10463 |
|
|
RST 10H ; PRINT-A outputs the control to current
|
10464 |
|
|
; channel.
|
10465 |
|
|
LD A,D ; transfer parameter to A.
|
10466 |
|
|
|
10467 |
|
|
RST 10H ; PRINT-A outputs parameter.
|
10468 |
|
|
RET ; return. ->
|
10469 |
|
|
|
10470 |
|
|
; -------------------------------------------------------------------------
|
10471 |
|
|
;
|
10472 |
|
|
; {fl}{br}{ paper }{ ink } The temporary colour attributes
|
10473 |
|
|
; ___ ___ ___ ___ ___ ___ ___ ___ system variable.
|
10474 |
|
|
; ATTR_T | | | | | | | | |
|
10475 |
|
|
; | | | | | | | | |
|
10476 |
|
|
; 23695 |___|___|___|___|___|___|___|___|
|
10477 |
|
|
; 7 6 5 4 3 2 1 0
|
10478 |
|
|
;
|
10479 |
|
|
;
|
10480 |
|
|
; {fl}{br}{ paper }{ ink } The temporary mask used for
|
10481 |
|
|
; ___ ___ ___ ___ ___ ___ ___ ___ transparent colours. Any bit
|
10482 |
|
|
; MASK_T | | | | | | | | | that is 1 shows that the
|
10483 |
|
|
; | | | | | | | | | corresponding attribute is
|
10484 |
|
|
; 23696 |___|___|___|___|___|___|___|___| taken not from ATTR-T but from
|
10485 |
|
|
; 7 6 5 4 3 2 1 0 what is already on the screen.
|
10486 |
|
|
;
|
10487 |
|
|
;
|
10488 |
|
|
; {paper9 }{ ink9 }{ inv1 }{ over1} The print flags. Even bits are
|
10489 |
|
|
; ___ ___ ___ ___ ___ ___ ___ ___ temporary flags. The odd bits
|
10490 |
|
|
; P_FLAG | | | | | | | | | are the permanent flags.
|
10491 |
|
|
; | p | t | p | t | p | t | p | t |
|
10492 |
|
|
; 23697 |___|___|___|___|___|___|___|___|
|
10493 |
|
|
; 7 6 5 4 3 2 1 0
|
10494 |
|
|
;
|
10495 |
|
|
; -----------------------------------------------------------------------
|
10496 |
|
|
|
10497 |
|
|
; ------------------------------------
|
10498 |
|
|
; The colour system variable handler.
|
10499 |
|
|
; ------------------------------------
|
10500 |
|
|
; This is an exit branch from PO-1-OPER, PO-2-OPER
|
10501 |
|
|
; A holds control $10 (INK) to $15 (OVER)
|
10502 |
|
|
; D holds parameter 0-9 for ink/paper 0,1 or 8 for bright/flash,
|
10503 |
|
|
; 0 or 1 for over/inverse.
|
10504 |
|
|
|
10505 |
|
|
;; CO-TEMP-5
|
10506 |
|
|
L2211: SUB $11 ; reduce range $FF-$04
|
10507 |
|
|
ADC A,$00 ; add in carry if INK
|
10508 |
|
|
JR Z,L2234 ; forward to CO-TEMP-7 with INK and PAPER.
|
10509 |
|
|
|
10510 |
|
|
SUB $02 ; reduce range $FF-$02
|
10511 |
|
|
ADC A,$00 ; add carry if FLASH
|
10512 |
|
|
JR Z,L2273 ; forward to CO-TEMP-C with FLASH and BRIGHT.
|
10513 |
|
|
|
10514 |
|
|
CP $01 ; is it 'INVERSE' ?
|
10515 |
|
|
LD A,D ; fetch parameter for INVERSE/OVER
|
10516 |
|
|
LD B,$01 ; prepare OVER mask setting bit 0.
|
10517 |
|
|
JR NZ,L2228 ; forward to CO-TEMP-6 if OVER
|
10518 |
|
|
|
10519 |
|
|
RLCA ; shift bit 0
|
10520 |
|
|
RLCA ; to bit 2
|
10521 |
|
|
LD B,$04 ; set bit 2 of mask for inverse.
|
10522 |
|
|
|
10523 |
|
|
;; CO-TEMP-6
|
10524 |
|
|
L2228: LD C,A ; save the A
|
10525 |
|
|
LD A,D ; re-fetch parameter
|
10526 |
|
|
CP $02 ; is it less than 2
|
10527 |
|
|
JR NC,L2244 ; to REPORT-K if not 0 or 1.
|
10528 |
|
|
; 'Invalid colour'.
|
10529 |
|
|
|
10530 |
|
|
LD A,C ; restore A
|
10531 |
|
|
LD HL,$5C91 ; address system variable P_FLAG
|
10532 |
|
|
JR L226C ; forward to exit via routine CO-CHANGE
|
10533 |
|
|
|
10534 |
|
|
; ---
|
10535 |
|
|
|
10536 |
|
|
; the branch was here with INK/PAPER and carry set for INK.
|
10537 |
|
|
|
10538 |
|
|
;; CO-TEMP-7
|
10539 |
|
|
L2234: LD A,D ; fetch parameter
|
10540 |
|
|
LD B,$07 ; set ink mask 00000111
|
10541 |
|
|
JR C,L223E ; forward to CO-TEMP-8 with INK
|
10542 |
|
|
|
10543 |
|
|
RLCA ; shift bits 0-2
|
10544 |
|
|
RLCA ; to
|
10545 |
|
|
RLCA ; bits 3-5
|
10546 |
|
|
LD B,$38 ; set paper mask 00111000
|
10547 |
|
|
|
10548 |
|
|
; both paper and ink rejoin here
|
10549 |
|
|
|
10550 |
|
|
;; CO-TEMP-8
|
10551 |
|
|
L223E: LD C,A ; value to C
|
10552 |
|
|
LD A,D ; fetch parameter
|
10553 |
|
|
CP $0A ; is it less than 10d ?
|
10554 |
|
|
JR C,L2246 ; forward to CO-TEMP-9 if so.
|
10555 |
|
|
|
10556 |
|
|
; ink 10 etc. is not allowed.
|
10557 |
|
|
|
10558 |
|
|
;; REPORT-K
|
10559 |
|
|
L2244: RST 08H ; ERROR-1
|
10560 |
|
|
DEFB $13 ; Error Report: Invalid colour
|
10561 |
|
|
|
10562 |
|
|
;; CO-TEMP-9
|
10563 |
|
|
L2246: LD HL,$5C8F ; address system variable ATTR_T initially.
|
10564 |
|
|
CP $08 ; compare with 8
|
10565 |
|
|
JR C,L2258 ; forward to CO-TEMP-B with 0-7.
|
10566 |
|
|
|
10567 |
|
|
LD A,(HL) ; fetch temporary attribute as no change.
|
10568 |
|
|
JR Z,L2257 ; forward to CO-TEMP-A with INK/PAPER 8
|
10569 |
|
|
|
10570 |
|
|
; it is either ink 9 or paper 9 (contrasting)
|
10571 |
|
|
|
10572 |
|
|
OR B ; or with mask to make white
|
10573 |
|
|
CPL ; make black and change other to dark
|
10574 |
|
|
AND $24 ; 00100100
|
10575 |
|
|
JR Z,L2257 ; forward to CO-TEMP-A if black and
|
10576 |
|
|
; originally light.
|
10577 |
|
|
|
10578 |
|
|
LD A,B ; else just use the mask (white)
|
10579 |
|
|
|
10580 |
|
|
;; CO-TEMP-A
|
10581 |
|
|
L2257: LD C,A ; save A in C
|
10582 |
|
|
|
10583 |
|
|
;; CO-TEMP-B
|
10584 |
|
|
L2258: LD A,C ; load colour to A
|
10585 |
|
|
CALL L226C ; routine CO-CHANGE addressing ATTR-T
|
10586 |
|
|
|
10587 |
|
|
LD A,$07 ; put 7 in accumulator
|
10588 |
|
|
CP D ; compare with parameter
|
10589 |
|
|
SBC A,A ; $00 if 0-7, $FF if 8
|
10590 |
|
|
CALL L226C ; routine CO-CHANGE addressing MASK-T
|
10591 |
|
|
; mask returned in A.
|
10592 |
|
|
|
10593 |
|
|
; now consider P-FLAG.
|
10594 |
|
|
|
10595 |
|
|
RLCA ; 01110000 or 00001110
|
10596 |
|
|
RLCA ; 11100000 or 00011100
|
10597 |
|
|
AND $50 ; 01000000 or 00010000 (AND 01010000)
|
10598 |
|
|
LD B,A ; transfer to mask
|
10599 |
|
|
LD A,$08 ; load A with 8
|
10600 |
|
|
CP D ; compare with parameter
|
10601 |
|
|
SBC A,A ; $FF if was 9, $00 if 0-8
|
10602 |
|
|
; continue while addressing P-FLAG
|
10603 |
|
|
; setting bit 4 if ink 9
|
10604 |
|
|
; setting bit 6 if paper 9
|
10605 |
|
|
|
10606 |
|
|
; -----------------------
|
10607 |
|
|
; Handle change of colour
|
10608 |
|
|
; -----------------------
|
10609 |
|
|
; This routine addresses a system variable ATTR_T, MASK_T or P-FLAG in HL.
|
10610 |
|
|
; colour value in A, mask in B.
|
10611 |
|
|
|
10612 |
|
|
;; CO-CHANGE
|
10613 |
|
|
L226C: XOR (HL) ; impress bits specified
|
10614 |
|
|
AND B ; by mask
|
10615 |
|
|
XOR (HL) ; on system variable.
|
10616 |
|
|
LD (HL),A ; update system variable.
|
10617 |
|
|
INC HL ; address next location.
|
10618 |
|
|
LD A,B ; put current value of mask in A
|
10619 |
|
|
RET ; return.
|
10620 |
|
|
|
10621 |
|
|
; ---
|
10622 |
|
|
|
10623 |
|
|
; the branch was here with flash and bright
|
10624 |
|
|
|
10625 |
|
|
;; CO-TEMP-C
|
10626 |
|
|
L2273: SBC A,A ; set zero flag for bright.
|
10627 |
|
|
LD A,D ; fetch original parameter 0,1 or 8
|
10628 |
|
|
RRCA ; rotate bit 0 to bit 7
|
10629 |
|
|
LD B,$80 ; mask for flash 10000000
|
10630 |
|
|
JR NZ,L227D ; forward to CO-TEMP-D if flash
|
10631 |
|
|
|
10632 |
|
|
RRCA ; rotate bit 7 to bit 6
|
10633 |
|
|
LD B,$40 ; mask for bright 01000000
|
10634 |
|
|
|
10635 |
|
|
;; CO-TEMP-D
|
10636 |
|
|
L227D: LD C,A ; store value in C
|
10637 |
|
|
LD A,D ; fetch parameter
|
10638 |
|
|
CP $08 ; compare with 8
|
10639 |
|
|
JR Z,L2287 ; forward to CO-TEMP-E if 8
|
10640 |
|
|
|
10641 |
|
|
CP $02 ; test if 0 or 1
|
10642 |
|
|
JR NC,L2244 ; back to REPORT-K if not
|
10643 |
|
|
; 'Invalid colour'
|
10644 |
|
|
|
10645 |
|
|
;; CO-TEMP-E
|
10646 |
|
|
L2287: LD A,C ; value to A
|
10647 |
|
|
LD HL,$5C8F ; address ATTR_T
|
10648 |
|
|
CALL L226C ; routine CO-CHANGE addressing ATTR_T
|
10649 |
|
|
LD A,C ; fetch value
|
10650 |
|
|
RRCA ; for flash8/bright8 complete
|
10651 |
|
|
RRCA ; rotations to put set bit in
|
10652 |
|
|
RRCA ; bit 7 (flash) bit 6 (bright)
|
10653 |
|
|
JR L226C ; back to CO-CHANGE addressing MASK_T
|
10654 |
|
|
; and indirect return.
|
10655 |
|
|
|
10656 |
|
|
; ---------------------
|
10657 |
|
|
; Handle BORDER command
|
10658 |
|
|
; ---------------------
|
10659 |
|
|
; Command syntax example: BORDER 7
|
10660 |
|
|
; This command routine sets the border to one of the eight colours.
|
10661 |
|
|
; The colours used for the lower screen are based on this.
|
10662 |
|
|
|
10663 |
|
|
;; BORDER
|
10664 |
|
|
L2294: CALL L1E94 ; routine FIND-INT1
|
10665 |
|
|
CP $08 ; must be in range 0 (black) to 7 (white)
|
10666 |
|
|
JR NC,L2244 ; back to REPORT-K if not
|
10667 |
|
|
; 'Invalid colour'.
|
10668 |
|
|
|
10669 |
|
|
OUT ($FE),A ; outputting to port effects an immediate
|
10670 |
|
|
; change.
|
10671 |
|
|
RLCA ; shift the colour to
|
10672 |
|
|
RLCA ; the paper bits setting the
|
10673 |
|
|
RLCA ; ink colour black.
|
10674 |
|
|
BIT 5,A ; is the number light coloured ?
|
10675 |
|
|
; i.e. in the range green to white.
|
10676 |
|
|
JR NZ,L22A6 ; skip to BORDER-1 if so
|
10677 |
|
|
|
10678 |
|
|
XOR $07 ; make the ink white.
|
10679 |
|
|
|
10680 |
|
|
;; BORDER-1
|
10681 |
|
|
L22A6: LD ($5C48),A ; update BORDCR with new paper/ink
|
10682 |
|
|
RET ; return.
|
10683 |
|
|
|
10684 |
|
|
; -----------------
|
10685 |
|
|
; Get pixel address
|
10686 |
|
|
; -----------------
|
10687 |
|
|
;
|
10688 |
|
|
;
|
10689 |
|
|
|
10690 |
|
|
;; PIXEL-ADD
|
10691 |
|
|
L22AA: LD A,$AF ; load with 175 decimal.
|
10692 |
|
|
SUB B ; subtract the y value.
|
10693 |
|
|
JP C,L24F9 ; jump forward to REPORT-Bc if greater.
|
10694 |
|
|
; 'Integer out of range'
|
10695 |
|
|
|
10696 |
|
|
; the high byte is derived from Y only.
|
10697 |
|
|
; the first 3 bits are always 010
|
10698 |
|
|
; the next 2 bits denote in which third of the screen the byte is.
|
10699 |
|
|
; the last 3 bits denote in which of the 8 scan lines within a third
|
10700 |
|
|
; the byte is located. There are 24 discrete values.
|
10701 |
|
|
|
10702 |
|
|
|
10703 |
|
|
LD B,A ; the line number from top of screen to B.
|
10704 |
|
|
AND A ; clear carry (already clear)
|
10705 |
|
|
RRA ; 0xxxxxxx
|
10706 |
|
|
SCF ; set carry flag
|
10707 |
|
|
RRA ; 10xxxxxx
|
10708 |
|
|
AND A ; clear carry flag
|
10709 |
|
|
RRA ; 010xxxxx
|
10710 |
|
|
|
10711 |
|
|
XOR B ;
|
10712 |
|
|
AND $F8 ; keep the top 5 bits 11111000
|
10713 |
|
|
XOR B ; 010xxbbb
|
10714 |
|
|
LD H,A ; transfer high byte to H.
|
10715 |
|
|
|
10716 |
|
|
; the low byte is derived from both X and Y.
|
10717 |
|
|
|
10718 |
|
|
LD A,C ; the x value 0-255.
|
10719 |
|
|
RLCA ;
|
10720 |
|
|
RLCA ;
|
10721 |
|
|
RLCA ;
|
10722 |
|
|
XOR B ; the y value
|
10723 |
|
|
AND $C7 ; apply mask 11000111
|
10724 |
|
|
XOR B ; restore unmasked bits xxyyyxxx
|
10725 |
|
|
RLCA ; rotate to xyyyxxxx
|
10726 |
|
|
RLCA ; required position. yyyxxxxx
|
10727 |
|
|
LD L,A ; low byte to L.
|
10728 |
|
|
|
10729 |
|
|
; finally form the pixel position in A.
|
10730 |
|
|
|
10731 |
|
|
LD A,C ; x value to A
|
10732 |
|
|
AND $07 ; mod 8
|
10733 |
|
|
RET ; return
|
10734 |
|
|
|
10735 |
|
|
; ----------------
|
10736 |
|
|
; Point Subroutine
|
10737 |
|
|
; ----------------
|
10738 |
|
|
; The point subroutine is called from s-point via the scanning functions
|
10739 |
|
|
; table.
|
10740 |
|
|
|
10741 |
|
|
;; POINT-SUB
|
10742 |
|
|
L22CB: CALL L2307 ; routine STK-TO-BC
|
10743 |
|
|
CALL L22AA ; routine PIXEL-ADD finds address of pixel.
|
10744 |
|
|
LD B,A ; pixel position to B, 0-7.
|
10745 |
|
|
INC B ; increment to give rotation count 1-8.
|
10746 |
|
|
LD A,(HL) ; fetch byte from screen.
|
10747 |
|
|
|
10748 |
|
|
;; POINT-LP
|
10749 |
|
|
L22D4: RLCA ; rotate and loop back
|
10750 |
|
|
DJNZ L22D4 ; to POINT-LP until pixel at right.
|
10751 |
|
|
|
10752 |
|
|
AND $01 ; test to give zero or one.
|
10753 |
|
|
JP L2D28 ; jump forward to STACK-A to save result.
|
10754 |
|
|
|
10755 |
|
|
; -------------------
|
10756 |
|
|
; Handle PLOT command
|
10757 |
|
|
; -------------------
|
10758 |
|
|
; Command Syntax example: PLOT 128,88
|
10759 |
|
|
;
|
10760 |
|
|
|
10761 |
|
|
;; PLOT
|
10762 |
|
|
L22DC: CALL L2307 ; routine STK-TO-BC
|
10763 |
|
|
CALL L22E5 ; routine PLOT-SUB
|
10764 |
|
|
JP L0D4D ; to TEMPS
|
10765 |
|
|
|
10766 |
|
|
; -------------------
|
10767 |
|
|
; The Plot subroutine
|
10768 |
|
|
; -------------------
|
10769 |
|
|
; A screen byte holds 8 pixels so it is necessary to rotate a mask
|
10770 |
|
|
; into the correct position to leave the other 7 pixels unaffected.
|
10771 |
|
|
; However all 64 pixels in the character cell take any embedded colour
|
10772 |
|
|
; items.
|
10773 |
|
|
; A pixel can be reset (inverse 1), toggled (over 1), or set ( with inverse
|
10774 |
|
|
; and over switches off). With both switches on, the byte is simply put
|
10775 |
|
|
; back on the screen though the colours may change.
|
10776 |
|
|
|
10777 |
|
|
;; PLOT-SUB
|
10778 |
|
|
L22E5: LD ($5C7D),BC ; store new x/y values in COORDS
|
10779 |
|
|
CALL L22AA ; routine PIXEL-ADD gets address in HL,
|
10780 |
|
|
; count from left 0-7 in B.
|
10781 |
|
|
LD B,A ; transfer count to B.
|
10782 |
|
|
INC B ; increase 1-8.
|
10783 |
|
|
LD A,$FE ; 11111110 in A.
|
10784 |
|
|
|
10785 |
|
|
;; PLOT-LOOP
|
10786 |
|
|
L22F0: RRCA ; rotate mask.
|
10787 |
|
|
DJNZ L22F0 ; to PLOT-LOOP until B circular rotations.
|
10788 |
|
|
|
10789 |
|
|
LD B,A ; load mask to B
|
10790 |
|
|
LD A,(HL) ; fetch screen byte to A
|
10791 |
|
|
|
10792 |
|
|
LD C,(IY+$57) ; P_FLAG to C
|
10793 |
|
|
BIT 0,C ; is it to be OVER 1 ?
|
10794 |
|
|
JR NZ,L22FD ; forward to PL-TST-IN if so.
|
10795 |
|
|
|
10796 |
|
|
; was over 0
|
10797 |
|
|
|
10798 |
|
|
AND B ; combine with mask to blank pixel.
|
10799 |
|
|
|
10800 |
|
|
;; PL-TST-IN
|
10801 |
|
|
L22FD: BIT 2,C ; is it inverse 1 ?
|
10802 |
|
|
JR NZ,L2303 ; to PLOT-END if so.
|
10803 |
|
|
|
10804 |
|
|
XOR B ; switch the pixel
|
10805 |
|
|
CPL ; restore other 7 bits
|
10806 |
|
|
|
10807 |
|
|
;; PLOT-END
|
10808 |
|
|
L2303: LD (HL),A ; load byte to the screen.
|
10809 |
|
|
JP L0BDB ; exit to PO-ATTR to set colours for cell.
|
10810 |
|
|
|
10811 |
|
|
; ------------------------------
|
10812 |
|
|
; Put two numbers in BC register
|
10813 |
|
|
; ------------------------------
|
10814 |
|
|
;
|
10815 |
|
|
;
|
10816 |
|
|
|
10817 |
|
|
;; STK-TO-BC
|
10818 |
|
|
L2307: CALL L2314 ; routine STK-TO-A
|
10819 |
|
|
LD B,A ;
|
10820 |
|
|
PUSH BC ;
|
10821 |
|
|
CALL L2314 ; routine STK-TO-A
|
10822 |
|
|
LD E,C ;
|
10823 |
|
|
POP BC ;
|
10824 |
|
|
LD D,C ;
|
10825 |
|
|
LD C,A ;
|
10826 |
|
|
RET ;
|
10827 |
|
|
|
10828 |
|
|
; -----------------------
|
10829 |
|
|
; Put stack in A register
|
10830 |
|
|
; -----------------------
|
10831 |
|
|
; This routine puts the last value on the calculator stack into the accumulator
|
10832 |
|
|
; deleting the last value.
|
10833 |
|
|
|
10834 |
|
|
;; STK-TO-A
|
10835 |
|
|
L2314: CALL L2DD5 ; routine FP-TO-A compresses last value into
|
10836 |
|
|
; accumulator. e.g. PI would become 3.
|
10837 |
|
|
; zero flag set if positive.
|
10838 |
|
|
JP C,L24F9 ; jump forward to REPORT-Bc if >= 255.5.
|
10839 |
|
|
|
10840 |
|
|
LD C,$01 ; prepare a positive sign byte.
|
10841 |
|
|
RET Z ; return if FP-TO-BC indicated positive.
|
10842 |
|
|
|
10843 |
|
|
LD C,$FF ; prepare negative sign byte and
|
10844 |
|
|
RET ; return.
|
10845 |
|
|
|
10846 |
|
|
|
10847 |
|
|
; --------------------
|
10848 |
|
|
; THE 'CIRCLE' COMMAND
|
10849 |
|
|
; --------------------
|
10850 |
|
|
; "Goe not Thou about to Square eyther circle" -
|
10851 |
|
|
; - John Donne, Cambridge educated theologian, 1624
|
10852 |
|
|
;
|
10853 |
|
|
; The CIRCLE command draws a circle as a series of straight lines.
|
10854 |
|
|
; In some ways it can be regarded as a polygon, but the first line is drawn
|
10855 |
|
|
; as a tangent, taking the radius as its distance from the centre.
|
10856 |
|
|
;
|
10857 |
|
|
; Both the CIRCLE algorithm and the ARC drawing algorithm make use of the
|
10858 |
|
|
; 'ROTATION FORMULA' (see later). It is only necessary to work out where
|
10859 |
|
|
; the first line will be drawn and how long it is and then the rotation
|
10860 |
|
|
; formula takes over and calculates all other rotated points.
|
10861 |
|
|
;
|
10862 |
|
|
; All Spectrum circles consist of two vertical lines at each side and two
|
10863 |
|
|
; horizontal lines at the top and bottom. The number of lines is calculated
|
10864 |
|
|
; from the radius of the circle and is always divisible by 4. For complete
|
10865 |
|
|
; circles it will range from 4 for a square circle to 32 for a circle of
|
10866 |
|
|
; radius 87. The Spectrum can attempt larger circles e.g. CIRCLE 0,14,255
|
10867 |
|
|
; but these will error as they go off-screen after four lines are drawn.
|
10868 |
|
|
; At the opposite end, CIRCLE 128,88,1.23 will draw a circle as a perfect 3x3
|
10869 |
|
|
; square using 4 straight lines although very small circles are just drawn as
|
10870 |
|
|
; a dot on the screen.
|
10871 |
|
|
;
|
10872 |
|
|
; The first chord drawn is the vertical chord on the right of the circle.
|
10873 |
|
|
; The starting point is at the base of this chord which is drawn upwards and
|
10874 |
|
|
; the circle continues in an anti-clockwise direction. As noted earlier the
|
10875 |
|
|
; x-coordinate of this point measured from the centre of the circle is the
|
10876 |
|
|
; radius.
|
10877 |
|
|
;
|
10878 |
|
|
; The CIRCLE command makes extensive use of the calculator and as part of
|
10879 |
|
|
; process of drawing a large circle, free memory is checked 1315 times.
|
10880 |
|
|
; When drawing a large arc, free memory is checked 928 times.
|
10881 |
|
|
; A single call to 'sin' involves 63 memory checks and so values of sine
|
10882 |
|
|
; and cosine are pre-calculated and held in the mem locations. As a
|
10883 |
|
|
; clever trick 'cos' is derived from 'sin' using simple arithmetic operations
|
10884 |
|
|
; instead of the more expensive 'cos' function.
|
10885 |
|
|
;
|
10886 |
|
|
; Initially, the syntax has been partly checked using the class for the DRAW
|
10887 |
|
|
; command which stacks the origin of the circle (X,Y).
|
10888 |
|
|
|
10889 |
|
|
;; CIRCLE
|
10890 |
|
|
L2320: RST 18H ; GET-CHAR x, y.
|
10891 |
|
|
CP $2C ; Is character the required comma ?
|
10892 |
|
|
JP NZ,L1C8A ; Jump, if not, to REPORT-C
|
10893 |
|
|
; 'Nonsense in basic'
|
10894 |
|
|
|
10895 |
|
|
RST 20H ; NEXT-CHAR advances the parsed character address.
|
10896 |
|
|
CALL L1C82 ; routine EXPT-1NUM stacks radius in runtime.
|
10897 |
|
|
CALL L1BEE ; routine CHECK-END will return here in runtime
|
10898 |
|
|
; if nothing follows the command.
|
10899 |
|
|
|
10900 |
|
|
; Now make the radius positive and ensure that it is in floating point form
|
10901 |
|
|
; so that the exponent byte can be accessed for quick testing.
|
10902 |
|
|
|
10903 |
|
|
RST 28H ;; FP-CALC x, y, r.
|
10904 |
|
|
DEFB $2A ;;abs x, y, r.
|
10905 |
|
|
DEFB $3D ;;re-stack x, y, r.
|
10906 |
|
|
DEFB $38 ;;end-calc x, y, r.
|
10907 |
|
|
|
10908 |
|
|
LD A,(HL) ; Fetch first, floating-point, exponent byte.
|
10909 |
|
|
CP $81 ; Compare to one.
|
10910 |
|
|
JR NC,L233B ; Forward to C-R-GRE-1
|
10911 |
|
|
; if circle radius is greater than one.
|
10912 |
|
|
|
10913 |
|
|
; The circle is no larger than a single pixel so delete the radius from the
|
10914 |
|
|
; calculator stack and plot a point at the centre.
|
10915 |
|
|
|
10916 |
|
|
RST 28H ;; FP-CALC x, y, r.
|
10917 |
|
|
DEFB $02 ;;delete x, y.
|
10918 |
|
|
DEFB $38 ;;end-calc x, y.
|
10919 |
|
|
|
10920 |
|
|
JR L22DC ; back to PLOT routine to just plot x,y.
|
10921 |
|
|
|
10922 |
|
|
; ---
|
10923 |
|
|
|
10924 |
|
|
; Continue when the circle's radius measures greater than one by forming
|
10925 |
|
|
; the angle 2 * PI radians which is 360 degrees.
|
10926 |
|
|
|
10927 |
|
|
;; C-R-GRE-1
|
10928 |
|
|
L233B: RST 28H ;; FP-CALC x, y, r
|
10929 |
|
|
DEFB $A3 ;;stk-pi/2 x, y, r, pi/2.
|
10930 |
|
|
DEFB $38 ;;end-calc x, y, r, pi/2.
|
10931 |
|
|
|
10932 |
|
|
; Change the exponent of pi/2 from $81 to $83 giving 2*PI the central angle.
|
10933 |
|
|
; This is quicker than multiplying by four.
|
10934 |
|
|
|
10935 |
|
|
LD (HL),$83 ; x, y, r, 2*PI.
|
10936 |
|
|
|
10937 |
|
|
; Now store this important constant in mem-5 and delete so that other
|
10938 |
|
|
; parameters can be derived from it, by a routine shared with DRAW.
|
10939 |
|
|
|
10940 |
|
|
RST 28H ;; FP-CALC x, y, r, 2*PI.
|
10941 |
|
|
DEFB $C5 ;;st-mem-5 store 2*PI in mem-5
|
10942 |
|
|
DEFB $02 ;;delete x, y, r.
|
10943 |
|
|
DEFB $38 ;;end-calc x, y, r.
|
10944 |
|
|
|
10945 |
|
|
; The parameters derived from mem-5 (A) and from the radius are set up in
|
10946 |
|
|
; four of the other mem locations by the CIRCLE DRAW PARAMETERS routine which
|
10947 |
|
|
; also returns the number of straight lines in the B register.
|
10948 |
|
|
|
10949 |
|
|
CALL L247D ; routine CD-PRMS1
|
10950 |
|
|
|
10951 |
|
|
; mem-0 ; A/No of lines (=a) unused
|
10952 |
|
|
; mem-1 ; sin(a/2) will be moving x var
|
10953 |
|
|
; mem-2 ; - will be moving y var
|
10954 |
|
|
; mem-3 ; cos(a) const
|
10955 |
|
|
; mem-4 ; sin(a) const
|
10956 |
|
|
; mem-5 ; Angle of rotation (A) (2*PI) const
|
10957 |
|
|
; B ; Number of straight lines.
|
10958 |
|
|
|
10959 |
|
|
PUSH BC ; Preserve the number of lines in B.
|
10960 |
|
|
|
10961 |
|
|
; Next calculate the length of half a chord by multiplying the sine of half
|
10962 |
|
|
; the central angle by the radius of the circle.
|
10963 |
|
|
|
10964 |
|
|
RST 28H ;; FP-CALC x, y, r.
|
10965 |
|
|
DEFB $31 ;;duplicate x, y, r, r.
|
10966 |
|
|
DEFB $E1 ;;get-mem-1 x, y, r, r, sin(a/2).
|
10967 |
|
|
DEFB $04 ;;multiply x, y, r, half-chord.
|
10968 |
|
|
DEFB $38 ;;end-calc x, y, r, half-chord.
|
10969 |
|
|
|
10970 |
|
|
LD A,(HL) ; fetch exponent of the half arc to A.
|
10971 |
|
|
CP $80 ; compare to a half pixel
|
10972 |
|
|
JR NC,L235A ; forward, if greater than .5, to C-ARC-GE1
|
10973 |
|
|
|
10974 |
|
|
; If the first line is less than .5 then 4 'lines' would be drawn on the same
|
10975 |
|
|
; spot so tidy the calculator stack and machine stack and plot the centre.
|
10976 |
|
|
|
10977 |
|
|
RST 28H ;; FP-CALC x, y, r, hc.
|
10978 |
|
|
DEFB $02 ;;delete x, y, r.
|
10979 |
|
|
DEFB $02 ;;delete x, y.
|
10980 |
|
|
DEFB $38 ;;end-calc x, y.
|
10981 |
|
|
|
10982 |
|
|
POP BC ; Balance machine stack by taking chord-count.
|
10983 |
|
|
|
10984 |
|
|
JP L22DC ; JUMP to PLOT
|
10985 |
|
|
|
10986 |
|
|
; ---
|
10987 |
|
|
|
10988 |
|
|
; The arc is greater than 0.5 so the circle can be drawn.
|
10989 |
|
|
|
10990 |
|
|
;; C-ARC-GE1
|
10991 |
|
|
L235A: RST 28H ;; FP-CALC x, y, r, hc.
|
10992 |
|
|
DEFB $C2 ;;st-mem-2 x, y, r, half chord to mem-2.
|
10993 |
|
|
DEFB $01 ;;exchange x, y, hc, r.
|
10994 |
|
|
DEFB $C0 ;;st-mem-0 x, y, hc, r.
|
10995 |
|
|
DEFB $02 ;;delete x, y, hc.
|
10996 |
|
|
|
10997 |
|
|
; Subtract the length of the half-chord from the absolute y coordinate to
|
10998 |
|
|
; give the starting y coordinate sy.
|
10999 |
|
|
; Note that for a circle this is also the end coordinate.
|
11000 |
|
|
|
11001 |
|
|
DEFB $03 ;;subtract x, y-hc. (The start y-coord)
|
11002 |
|
|
DEFB $01 ;;exchange sy, x.
|
11003 |
|
|
|
11004 |
|
|
; Next simply add the radius to the x coordinate to give a fuzzy x-coordinate.
|
11005 |
|
|
; Strictly speaking, the radius should be multiplied by cos(a/2) first but
|
11006 |
|
|
; doing it this way makes the circle slightly larger.
|
11007 |
|
|
|
11008 |
|
|
DEFB $E0 ;;get-mem-0 sy, x, r.
|
11009 |
|
|
DEFB $0F ;;addition sy, x+r. (The start x-coord)
|
11010 |
|
|
|
11011 |
|
|
; We now want three copies of this pair of values on the calculator stack.
|
11012 |
|
|
; The first pair remain on the stack throughout the circle routine and are
|
11013 |
|
|
; the end points. The next pair will be the moving absolute values of x and y
|
11014 |
|
|
; that are updated after each line is drawn. The final pair will be loaded
|
11015 |
|
|
; into the COORDS system variable so that the first vertical line starts at
|
11016 |
|
|
; the right place.
|
11017 |
|
|
|
11018 |
|
|
DEFB $C0 ;;st-mem-0 sy, sx.
|
11019 |
|
|
DEFB $01 ;;exchange sx, sy.
|
11020 |
|
|
DEFB $31 ;;duplicate sx, sy, sy.
|
11021 |
|
|
DEFB $E0 ;;get-mem-0 sx, sy, sy, sx.
|
11022 |
|
|
DEFB $01 ;;exchange sx, sy, sx, sy.
|
11023 |
|
|
DEFB $31 ;;duplicate sx, sy, sx, sy, sy.
|
11024 |
|
|
DEFB $E0 ;;get-mem-0 sx, sy, sx, sy, sy, sx.
|
11025 |
|
|
|
11026 |
|
|
; Locations mem-1 and mem-2 are the relative x and y values which are updated
|
11027 |
|
|
; after each line is drawn. Since we are drawing a vertical line then the rx
|
11028 |
|
|
; value in mem-1 is zero and the ry value in mem-2 is the full chord.
|
11029 |
|
|
|
11030 |
|
|
DEFB $A0 ;;stk-zero sx, sy, sx, sy, sy, sx, 0.
|
11031 |
|
|
DEFB $C1 ;;st-mem-1 sx, sy, sx, sy, sy, sx, 0.
|
11032 |
|
|
DEFB $02 ;;delete sx, sy, sx, sy, sy, sx.
|
11033 |
|
|
|
11034 |
|
|
; Although the three pairs of x/y values are the same for a circle, they
|
11035 |
|
|
; will be labelled terminating, absolute and start coordinates.
|
11036 |
|
|
|
11037 |
|
|
DEFB $38 ;;end-calc tx, ty, ax, ay, sy, sx.
|
11038 |
|
|
|
11039 |
|
|
; Use the exponent manipulating trick again to double the value of mem-2.
|
11040 |
|
|
|
11041 |
|
|
INC (IY+$62) ; Increment MEM-2-1st doubling half chord.
|
11042 |
|
|
|
11043 |
|
|
; Note. this first vertical chord is drawn at the radius so circles are
|
11044 |
|
|
; slightly displaced to the right.
|
11045 |
|
|
; It is only necessary to place the values (sx) and (sy) in the system
|
11046 |
|
|
; variable COORDS to ensure that drawing commences at the correct pixel.
|
11047 |
|
|
; Note. a couple of LD (COORDS),A instructions would have been quicker, and
|
11048 |
|
|
; simpler, than using LD (COORDS),HL.
|
11049 |
|
|
|
11050 |
|
|
CALL L1E94 ; routine FIND-INT1 fetches sx from stack to A.
|
11051 |
|
|
|
11052 |
|
|
LD L,A ; place X value in L.
|
11053 |
|
|
PUSH HL ; save the holding register.
|
11054 |
|
|
|
11055 |
|
|
CALL L1E94 ; routine FIND-INT1 fetches sy to A
|
11056 |
|
|
|
11057 |
|
|
POP HL ; restore the holding register.
|
11058 |
|
|
LD H,A ; and place y value in high byte.
|
11059 |
|
|
|
11060 |
|
|
LD ($5C7D),HL ; Update the COORDS system variable.
|
11061 |
|
|
;
|
11062 |
|
|
; tx, ty, ax, ay.
|
11063 |
|
|
|
11064 |
|
|
POP BC ; restore the chord count
|
11065 |
|
|
; values 4,8,12,16,20,24,28 or 32.
|
11066 |
|
|
|
11067 |
|
|
JP L2420 ; forward to DRW-STEPS
|
11068 |
|
|
; tx, ty, ax, ay.
|
11069 |
|
|
|
11070 |
|
|
; Note. the jump to DRW-STEPS is just to decrement B and jump into the
|
11071 |
|
|
; middle of the arc-drawing loop. The arc count which includes the first
|
11072 |
|
|
; vertical arc draws one less than the perceived number of arcs.
|
11073 |
|
|
; The final arc offsets are obtained by subtracting the final COORDS value
|
11074 |
|
|
; from the initial sx and sy values which are kept at the base of the
|
11075 |
|
|
; calculator stack throughout the arc loop.
|
11076 |
|
|
; This ensures that the final line finishes exactly at the starting pixel
|
11077 |
|
|
; removing the possibility of any inaccuracy.
|
11078 |
|
|
; Since the initial sx and sy values are not required until the final arc
|
11079 |
|
|
; is drawn, they are not shown until then.
|
11080 |
|
|
; As the calculator stack is quite busy, only the active parts are shown in
|
11081 |
|
|
; each section.
|
11082 |
|
|
|
11083 |
|
|
|
11084 |
|
|
; ------------------
|
11085 |
|
|
; THE 'DRAW' COMMAND
|
11086 |
|
|
; ------------------
|
11087 |
|
|
; The Spectrum's DRAW command is overloaded and can take two parameters sets.
|
11088 |
|
|
;
|
11089 |
|
|
; With two parameters, it simply draws an approximation to a straight line
|
11090 |
|
|
; at offset x,y using the LINE-DRAW routine.
|
11091 |
|
|
;
|
11092 |
|
|
; With three parameters, an arc is drawn to the point at offset x,y turning
|
11093 |
|
|
; through an angle, in radians, supplied by the third parameter.
|
11094 |
|
|
; The arc will consist of 4 to 252 straight lines each one of which is drawn
|
11095 |
|
|
; by calls to the DRAW-LINE routine.
|
11096 |
|
|
|
11097 |
|
|
;; DRAW
|
11098 |
|
|
L2382: RST 18H ; GET-CHAR
|
11099 |
|
|
CP $2C ; is it the comma character ?
|
11100 |
|
|
JR Z,L238D ; forward, if so, to DR-3-PRMS
|
11101 |
|
|
|
11102 |
|
|
; There are two parameters e.g. DRAW 255,175
|
11103 |
|
|
|
11104 |
|
|
CALL L1BEE ; routine CHECK-END
|
11105 |
|
|
|
11106 |
|
|
JP L2477 ; jump forward to LINE-DRAW
|
11107 |
|
|
|
11108 |
|
|
; ---
|
11109 |
|
|
|
11110 |
|
|
; There are three parameters e.g. DRAW 255, 175, .5
|
11111 |
|
|
; The first two are relative coordinates and the third is the angle of
|
11112 |
|
|
; rotation in radians (A).
|
11113 |
|
|
|
11114 |
|
|
;; DR-3-PRMS
|
11115 |
|
|
L238D: RST 20H ; NEXT-CHAR skips over the 'comma'.
|
11116 |
|
|
|
11117 |
|
|
CALL L1C82 ; routine EXPT-1NUM stacks the rotation angle.
|
11118 |
|
|
|
11119 |
|
|
CALL L1BEE ; routine CHECK-END
|
11120 |
|
|
|
11121 |
|
|
; Now enter the calculator and store the complete rotation angle in mem-5
|
11122 |
|
|
|
11123 |
|
|
RST 28H ;; FP-CALC x, y, A.
|
11124 |
|
|
DEFB $C5 ;;st-mem-5 x, y, A.
|
11125 |
|
|
|
11126 |
|
|
; Test the angle for the special case of 360 degrees.
|
11127 |
|
|
|
11128 |
|
|
DEFB $A2 ;;stk-half x, y, A, 1/2.
|
11129 |
|
|
DEFB $04 ;;multiply x, y, A/2.
|
11130 |
|
|
DEFB $1F ;;sin x, y, sin(A/2).
|
11131 |
|
|
DEFB $31 ;;duplicate x, y, sin(A/2),sin(A/2)
|
11132 |
|
|
DEFB $30 ;;not x, y, sin(A/2), (0/1).
|
11133 |
|
|
DEFB $30 ;;not x, y, sin(A/2), (1/0).
|
11134 |
|
|
DEFB $00 ;;jump-true x, y, sin(A/2).
|
11135 |
|
|
|
11136 |
|
|
DEFB $06 ;;forward to L23A3, DR-SIN-NZ
|
11137 |
|
|
; if sin(r/2) is not zero.
|
11138 |
|
|
|
11139 |
|
|
; The third parameter is 2*PI (or a multiple of 2*PI) so a 360 degrees turn
|
11140 |
|
|
; would just be a straight line. Eliminating this case here prevents
|
11141 |
|
|
; division by zero at later stage.
|
11142 |
|
|
|
11143 |
|
|
DEFB $02 ;;delete x, y.
|
11144 |
|
|
DEFB $38 ;;end-calc x, y.
|
11145 |
|
|
|
11146 |
|
|
JP L2477 ; forward to LINE-DRAW
|
11147 |
|
|
|
11148 |
|
|
; ---
|
11149 |
|
|
|
11150 |
|
|
; An arc can be drawn.
|
11151 |
|
|
|
11152 |
|
|
;; DR-SIN-NZ
|
11153 |
|
|
L23A3: DEFB $C0 ;;st-mem-0 x, y, sin(A/2). store mem-0
|
11154 |
|
|
DEFB $02 ;;delete x, y.
|
11155 |
|
|
|
11156 |
|
|
; The next step calculates (roughly) the diameter of the circle of which the
|
11157 |
|
|
; arc will form part. This value does not have to be too accurate as it is
|
11158 |
|
|
; only used to evaluate the number of straight lines and then discarded.
|
11159 |
|
|
; After all for a circle, the radius is used. Consequently, a circle of
|
11160 |
|
|
; radius 50 will have 24 straight lines but an arc of radius 50 will have 20
|
11161 |
|
|
; straight lines - when drawn in any direction.
|
11162 |
|
|
; So that simple arithmetic can be used, the length of the chord can be
|
11163 |
|
|
; calculated as X+Y rather than by Pythagoras Theorem and the sine of the
|
11164 |
|
|
; nearest angle within reach is used.
|
11165 |
|
|
|
11166 |
|
|
DEFB $C1 ;;st-mem-1 x, y. store mem-1
|
11167 |
|
|
DEFB $02 ;;delete x.
|
11168 |
|
|
|
11169 |
|
|
DEFB $31 ;;duplicate x, x.
|
11170 |
|
|
DEFB $2A ;;abs x, x (+ve).
|
11171 |
|
|
DEFB $E1 ;;get-mem-1 x, X, y.
|
11172 |
|
|
DEFB $01 ;;exchange x, y, X.
|
11173 |
|
|
DEFB $E1 ;;get-mem-1 x, y, X, y.
|
11174 |
|
|
DEFB $2A ;;abs x, y, X, Y (+ve).
|
11175 |
|
|
DEFB $0F ;;addition x, y, X+Y.
|
11176 |
|
|
DEFB $E0 ;;get-mem-0 x, y, X+Y, sin(A/2).
|
11177 |
|
|
DEFB $05 ;;division x, y, X+Y/sin(A/2).
|
11178 |
|
|
DEFB $2A ;;abs x, y, X+Y/sin(A/2) = D.
|
11179 |
|
|
|
11180 |
|
|
; Bring back sin(A/2) from mem-0 which will shortly get trashed.
|
11181 |
|
|
; Then bring D to the top of the stack again.
|
11182 |
|
|
|
11183 |
|
|
DEFB $E0 ;;get-mem-0 x, y, D, sin(A/2).
|
11184 |
|
|
DEFB $01 ;;exchange x, y, sin(A/2), D.
|
11185 |
|
|
|
11186 |
|
|
; Note. that since the value at the top of the stack has arisen as a result
|
11187 |
|
|
; of division then it can no longer be in integer form and the next re-stack
|
11188 |
|
|
; is unnecessary. Only the Sinclair ZX80 had integer division.
|
11189 |
|
|
|
11190 |
|
|
DEFB $3D ;;re-stack (unnecessary)
|
11191 |
|
|
|
11192 |
|
|
DEFB $38 ;;end-calc x, y, sin(A/2), D.
|
11193 |
|
|
|
11194 |
|
|
; The next test avoids drawing 4 straight lines when the start and end pixels
|
11195 |
|
|
; are adjacent (or the same) but is probably best dispensed with.
|
11196 |
|
|
|
11197 |
|
|
LD A,(HL) ; fetch exponent byte of D.
|
11198 |
|
|
CP $81 ; compare to 1
|
11199 |
|
|
JR NC,L23C1 ; forward, if > 1, to DR-PRMS
|
11200 |
|
|
|
11201 |
|
|
; else delete the top two stack values and draw a simple straight line.
|
11202 |
|
|
|
11203 |
|
|
RST 28H ;; FP-CALC
|
11204 |
|
|
DEFB $02 ;;delete
|
11205 |
|
|
DEFB $02 ;;delete
|
11206 |
|
|
DEFB $38 ;;end-calc x, y.
|
11207 |
|
|
|
11208 |
|
|
JP L2477 ; to LINE-DRAW
|
11209 |
|
|
|
11210 |
|
|
; ---
|
11211 |
|
|
|
11212 |
|
|
; The ARC will consist of multiple straight lines so call the CIRCLE-DRAW
|
11213 |
|
|
; PARAMETERS ROUTINE to pre-calculate sine values from the angle (in mem-5)
|
11214 |
|
|
; and determine also the number of straight lines from that value and the
|
11215 |
|
|
; 'diameter' which is at the top of the calculator stack.
|
11216 |
|
|
|
11217 |
|
|
;; DR-PRMS
|
11218 |
|
|
L23C1: CALL L247D ; routine CD-PRMS1
|
11219 |
|
|
|
11220 |
|
|
; mem-0 ; (A)/No. of lines (=a) (step angle)
|
11221 |
|
|
; mem-1 ; sin(a/2)
|
11222 |
|
|
; mem-2 ; -
|
11223 |
|
|
; mem-3 ; cos(a) const
|
11224 |
|
|
; mem-4 ; sin(a) const
|
11225 |
|
|
; mem-5 ; Angle of rotation (A) in
|
11226 |
|
|
; B ; Count of straight lines - max 252.
|
11227 |
|
|
|
11228 |
|
|
PUSH BC ; Save the line count on the machine stack.
|
11229 |
|
|
|
11230 |
|
|
; Remove the now redundant diameter value D.
|
11231 |
|
|
|
11232 |
|
|
RST 28H ;; FP-CALC x, y, sin(A/2), D.
|
11233 |
|
|
DEFB $02 ;;delete x, y, sin(A/2).
|
11234 |
|
|
|
11235 |
|
|
; Dividing the sine of the step angle by the sine of the total angle gives
|
11236 |
|
|
; the length of the initial chord on a unary circle. This factor f is used
|
11237 |
|
|
; to scale the coordinates of the first line which still points in the
|
11238 |
|
|
; direction of the end point and may be larger.
|
11239 |
|
|
|
11240 |
|
|
DEFB $E1 ;;get-mem-1 x, y, sin(A/2), sin(a/2)
|
11241 |
|
|
DEFB $01 ;;exchange x, y, sin(a/2), sin(A/2)
|
11242 |
|
|
DEFB $05 ;;division x, y, sin(a/2)/sin(A/2)
|
11243 |
|
|
DEFB $C1 ;;st-mem-1 x, y. f.
|
11244 |
|
|
DEFB $02 ;;delete x, y.
|
11245 |
|
|
|
11246 |
|
|
; With the factor stored, scale the x coordinate first.
|
11247 |
|
|
|
11248 |
|
|
DEFB $01 ;;exchange y, x.
|
11249 |
|
|
DEFB $31 ;;duplicate y, x, x.
|
11250 |
|
|
DEFB $E1 ;;get-mem-1 y, x, x, f.
|
11251 |
|
|
DEFB $04 ;;multiply y, x, x*f (=xx)
|
11252 |
|
|
DEFB $C2 ;;st-mem-2 y, x, xx.
|
11253 |
|
|
DEFB $02 ;;delete y. x.
|
11254 |
|
|
|
11255 |
|
|
; Now scale the y coordinate.
|
11256 |
|
|
|
11257 |
|
|
DEFB $01 ;;exchange x, y.
|
11258 |
|
|
DEFB $31 ;;duplicate x, y, y.
|
11259 |
|
|
DEFB $E1 ;;get-mem-1 x, y, y, f
|
11260 |
|
|
DEFB $04 ;;multiply x, y, y*f (=yy)
|
11261 |
|
|
|
11262 |
|
|
; Note. 'sin' and 'cos' trash locations mem-0 to mem-2 so fetch mem-2 to the
|
11263 |
|
|
; calculator stack for safe keeping.
|
11264 |
|
|
|
11265 |
|
|
DEFB $E2 ;;get-mem-2 x, y, yy, xx.
|
11266 |
|
|
|
11267 |
|
|
; Once we get the coordinates of the first straight line then the 'ROTATION
|
11268 |
|
|
; FORMULA' used in the arc loop will take care of all other points, but we
|
11269 |
|
|
; now use a variation of that formula to rotate the first arc through (A-a)/2
|
11270 |
|
|
; radians.
|
11271 |
|
|
;
|
11272 |
|
|
; xRotated = y * sin(angle) + x * cos(angle)
|
11273 |
|
|
; yRotated = y * cos(angle) - x * sin(angle)
|
11274 |
|
|
;
|
11275 |
|
|
|
11276 |
|
|
DEFB $E5 ;;get-mem-5 x, y, yy, xx, A.
|
11277 |
|
|
DEFB $E0 ;;get-mem-0 x, y, yy, xx, A, a.
|
11278 |
|
|
DEFB $03 ;;subtract x, y, yy, xx, A-a.
|
11279 |
|
|
DEFB $A2 ;;stk-half x, y, yy, xx, A-a, 1/2.
|
11280 |
|
|
DEFB $04 ;;multiply x, y, yy, xx, (A-a)/2. (=angle)
|
11281 |
|
|
DEFB $31 ;;duplicate x, y, yy, xx, angle, angle.
|
11282 |
|
|
DEFB $1F ;;sin x, y, yy, xx, angle, sin(angle)
|
11283 |
|
|
DEFB $C5 ;;st-mem-5 x, y, yy, xx, angle, sin(angle)
|
11284 |
|
|
DEFB $02 ;;delete x, y, yy, xx, angle
|
11285 |
|
|
|
11286 |
|
|
DEFB $20 ;;cos x, y, yy, xx, cos(angle).
|
11287 |
|
|
|
11288 |
|
|
; Note. mem-0, mem-1 and mem-2 can be used again now...
|
11289 |
|
|
|
11290 |
|
|
DEFB $C0 ;;st-mem-0 x, y, yy, xx, cos(angle).
|
11291 |
|
|
DEFB $02 ;;delete x, y, yy, xx.
|
11292 |
|
|
|
11293 |
|
|
DEFB $C2 ;;st-mem-2 x, y, yy, xx.
|
11294 |
|
|
DEFB $02 ;;delete x, y, yy.
|
11295 |
|
|
|
11296 |
|
|
DEFB $C1 ;;st-mem-1 x, y, yy.
|
11297 |
|
|
DEFB $E5 ;;get-mem-5 x, y, yy, sin(angle)
|
11298 |
|
|
DEFB $04 ;;multiply x, y, yy*sin(angle).
|
11299 |
|
|
DEFB $E0 ;;get-mem-0 x, y, yy*sin(angle), cos(angle)
|
11300 |
|
|
DEFB $E2 ;;get-mem-2 x, y, yy*sin(angle), cos(angle), xx.
|
11301 |
|
|
DEFB $04 ;;multiply x, y, yy*sin(angle), xx*cos(angle).
|
11302 |
|
|
DEFB $0F ;;addition x, y, xRotated.
|
11303 |
|
|
DEFB $E1 ;;get-mem-1 x, y, xRotated, yy.
|
11304 |
|
|
DEFB $01 ;;exchange x, y, yy, xRotated.
|
11305 |
|
|
DEFB $C1 ;;st-mem-1 x, y, yy, xRotated.
|
11306 |
|
|
DEFB $02 ;;delete x, y, yy.
|
11307 |
|
|
|
11308 |
|
|
DEFB $E0 ;;get-mem-0 x, y, yy, cos(angle).
|
11309 |
|
|
DEFB $04 ;;multiply x, y, yy*cos(angle).
|
11310 |
|
|
DEFB $E2 ;;get-mem-2 x, y, yy*cos(angle), xx.
|
11311 |
|
|
DEFB $E5 ;;get-mem-5 x, y, yy*cos(angle), xx, sin(angle).
|
11312 |
|
|
DEFB $04 ;;multiply x, y, yy*cos(angle), xx*sin(angle).
|
11313 |
|
|
DEFB $03 ;;subtract x, y, yRotated.
|
11314 |
|
|
DEFB $C2 ;;st-mem-2 x, y, yRotated.
|
11315 |
|
|
|
11316 |
|
|
; Now the initial x and y coordinates are made positive and summed to see
|
11317 |
|
|
; if they measure up to anything significant.
|
11318 |
|
|
|
11319 |
|
|
DEFB $2A ;;abs x, y, yRotated'.
|
11320 |
|
|
DEFB $E1 ;;get-mem-1 x, y, yRotated', xRotated.
|
11321 |
|
|
DEFB $2A ;;abs x, y, yRotated', xRotated'.
|
11322 |
|
|
DEFB $0F ;;addition x, y, yRotated+xRotated.
|
11323 |
|
|
DEFB $02 ;;delete x, y.
|
11324 |
|
|
|
11325 |
|
|
DEFB $38 ;;end-calc x, y.
|
11326 |
|
|
|
11327 |
|
|
; Although the test value has been deleted it is still above the calculator
|
11328 |
|
|
; stack in memory and conveniently DE which points to the first free byte
|
11329 |
|
|
; addresses the exponent of the test value.
|
11330 |
|
|
|
11331 |
|
|
LD A,(DE) ; Fetch exponent of the length indicator.
|
11332 |
|
|
CP $81 ; Compare to that for 1
|
11333 |
|
|
|
11334 |
|
|
POP BC ; Balance the machine stack
|
11335 |
|
|
|
11336 |
|
|
JP C,L2477 ; forward, if the coordinates of first line
|
11337 |
|
|
; don't add up to more than 1, to LINE-DRAW
|
11338 |
|
|
|
11339 |
|
|
; Continue when the arc will have a discernable shape.
|
11340 |
|
|
|
11341 |
|
|
PUSH BC ; Restore line counter to the machine stack.
|
11342 |
|
|
|
11343 |
|
|
; The parameters of the DRAW command were relative and they are now converted
|
11344 |
|
|
; to absolute coordinates by adding to the coordinates of the last point
|
11345 |
|
|
; plotted. The first two values on the stack are the terminal tx and ty
|
11346 |
|
|
; coordinates. The x-coordinate is converted first but first the last point
|
11347 |
|
|
; plotted is saved as it will initialize the moving ax, value.
|
11348 |
|
|
|
11349 |
|
|
RST 28H ;; FP-CALC x, y.
|
11350 |
|
|
DEFB $01 ;;exchange y, x.
|
11351 |
|
|
DEFB $38 ;;end-calc y, x.
|
11352 |
|
|
|
11353 |
|
|
LD A,($5C7D) ; Fetch System Variable COORDS-x
|
11354 |
|
|
CALL L2D28 ; routine STACK-A
|
11355 |
|
|
|
11356 |
|
|
RST 28H ;; FP-CALC y, x, last-x.
|
11357 |
|
|
|
11358 |
|
|
; Store the last point plotted to initialize the moving ax value.
|
11359 |
|
|
|
11360 |
|
|
DEFB $C0 ;;st-mem-0 y, x, last-x.
|
11361 |
|
|
DEFB $0F ;;addition y, absolute x.
|
11362 |
|
|
DEFB $01 ;;exchange tx, y.
|
11363 |
|
|
DEFB $38 ;;end-calc tx, y.
|
11364 |
|
|
|
11365 |
|
|
LD A,($5C7E) ; Fetch System Variable COORDS-y
|
11366 |
|
|
CALL L2D28 ; routine STACK-A
|
11367 |
|
|
|
11368 |
|
|
RST 28H ;; FP-CALC tx, y, last-y.
|
11369 |
|
|
|
11370 |
|
|
; Store the last point plotted to initialize the moving ay value.
|
11371 |
|
|
|
11372 |
|
|
DEFB $C5 ;;st-mem-5 tx, y, last-y.
|
11373 |
|
|
DEFB $0F ;;addition tx, ty.
|
11374 |
|
|
|
11375 |
|
|
; Fetch the moving ax and ay to the calculator stack.
|
11376 |
|
|
|
11377 |
|
|
DEFB $E0 ;;get-mem-0 tx, ty, ax.
|
11378 |
|
|
DEFB $E5 ;;get-mem-5 tx, ty, ax, ay.
|
11379 |
|
|
DEFB $38 ;;end-calc tx, ty, ax, ay.
|
11380 |
|
|
|
11381 |
|
|
POP BC ; Restore the straight line count.
|
11382 |
|
|
|
11383 |
|
|
; -----------------------------------
|
11384 |
|
|
; THE 'CIRCLE/DRAW CONVERGENCE POINT'
|
11385 |
|
|
; -----------------------------------
|
11386 |
|
|
; The CIRCLE and ARC-DRAW commands converge here.
|
11387 |
|
|
;
|
11388 |
|
|
; Note. for both the CIRCLE and ARC commands the minimum initial line count
|
11389 |
|
|
; is 4 (as set up by the CD_PARAMS routine) and so the zero flag will never
|
11390 |
|
|
; be set and the loop is always entered. The first test is superfluous and
|
11391 |
|
|
; the jump will always be made to ARC-START.
|
11392 |
|
|
|
11393 |
|
|
;; DRW-STEPS
|
11394 |
|
|
L2420: DEC B ; decrement the arc count (4,8,12,16...).
|
11395 |
|
|
|
11396 |
|
|
JR Z,L245F ; forward, if zero (not possible), to ARC-END
|
11397 |
|
|
|
11398 |
|
|
JR L2439 ; forward to ARC-START
|
11399 |
|
|
|
11400 |
|
|
; --------------
|
11401 |
|
|
; THE 'ARC LOOP'
|
11402 |
|
|
; --------------
|
11403 |
|
|
;
|
11404 |
|
|
; The arc drawing loop will draw up to 31 straight lines for a circle and up
|
11405 |
|
|
; 251 straight lines for an arc between two points. In both cases the final
|
11406 |
|
|
; closing straight line is drawn at ARC_END, but it otherwise loops back to
|
11407 |
|
|
; here to calculate the next coordinate using the ROTATION FORMULA where (a)
|
11408 |
|
|
; is the previously calculated, constant CENTRAL ANGLE of the arcs.
|
11409 |
|
|
;
|
11410 |
|
|
; Xrotated = x * cos(a) - y * sin(a)
|
11411 |
|
|
; Yrotated = x * sin(a) + y * cos(a)
|
11412 |
|
|
;
|
11413 |
|
|
; The values cos(a) and sin(a) are pre-calculated and held in mem-3 and mem-4
|
11414 |
|
|
; for the duration of the routine.
|
11415 |
|
|
; Memory location mem-1 holds the last relative x value (rx) and mem-2 holds
|
11416 |
|
|
; the last relative y value (ry) used by DRAW.
|
11417 |
|
|
;
|
11418 |
|
|
; Note. that this is a very clever twist on what is after all a very clever,
|
11419 |
|
|
; well-used formula. Normally the rotation formula is used with the x and y
|
11420 |
|
|
; coordinates from the centre of the circle (or arc) and a supplied angle to
|
11421 |
|
|
; produce two new x and y coordinates in an anticlockwise direction on the
|
11422 |
|
|
; circumference of the circle.
|
11423 |
|
|
; What is being used here, instead, is the relative X and Y parameters from
|
11424 |
|
|
; the last point plotted that are required to get to the current point and
|
11425 |
|
|
; the formula returns the next relative coordinates to use.
|
11426 |
|
|
|
11427 |
|
|
;; ARC-LOOP
|
11428 |
|
|
L2425: RST 28H ;; FP-CALC
|
11429 |
|
|
DEFB $E1 ;;get-mem-1 rx.
|
11430 |
|
|
DEFB $31 ;;duplicate rx, rx.
|
11431 |
|
|
DEFB $E3 ;;get-mem-3 cos(a)
|
11432 |
|
|
DEFB $04 ;;multiply rx, rx*cos(a).
|
11433 |
|
|
DEFB $E2 ;;get-mem-2 rx, rx*cos(a), ry.
|
11434 |
|
|
DEFB $E4 ;;get-mem-4 rx, rx*cos(a), ry, sin(a).
|
11435 |
|
|
DEFB $04 ;;multiply rx, rx*cos(a), ry*sin(a).
|
11436 |
|
|
DEFB $03 ;;subtract rx, rx*cos(a) - ry*sin(a)
|
11437 |
|
|
DEFB $C1 ;;st-mem-1 rx, new relative x rotated.
|
11438 |
|
|
DEFB $02 ;;delete rx.
|
11439 |
|
|
|
11440 |
|
|
DEFB $E4 ;;get-mem-4 rx, sin(a).
|
11441 |
|
|
DEFB $04 ;;multiply rx*sin(a)
|
11442 |
|
|
DEFB $E2 ;;get-mem-2 rx*sin(a), ry.
|
11443 |
|
|
DEFB $E3 ;;get-mem-3 rx*sin(a), ry, cos(a).
|
11444 |
|
|
DEFB $04 ;;multiply rx*sin(a), ry*cos(a).
|
11445 |
|
|
DEFB $0F ;;addition rx*sin(a) + ry*cos(a).
|
11446 |
|
|
DEFB $C2 ;;st-mem-2 new relative y rotated.
|
11447 |
|
|
DEFB $02 ;;delete .
|
11448 |
|
|
DEFB $38 ;;end-calc .
|
11449 |
|
|
|
11450 |
|
|
; Note. the calculator stack actually holds tx, ty, ax, ay
|
11451 |
|
|
; and the last absolute values of x and y
|
11452 |
|
|
; are now brought into play.
|
11453 |
|
|
;
|
11454 |
|
|
; Magically, the two new rotated coordinates rx and ry are all that we would
|
11455 |
|
|
; require to draw a circle or arc - on paper!
|
11456 |
|
|
; The Spectrum DRAW routine draws to the rounded x and y coordinate and so
|
11457 |
|
|
; repetitions of values like 3.49 would mean that the fractional parts
|
11458 |
|
|
; would be lost until eventually the draw coordinates might differ from the
|
11459 |
|
|
; floating point values used above by several pixels.
|
11460 |
|
|
; For this reason the accurate offsets calculated above are added to the
|
11461 |
|
|
; accurate, absolute coordinates maintained in ax and ay and these new
|
11462 |
|
|
; coordinates have the integer coordinates of the last plot position
|
11463 |
|
|
; ( from System Variable COORDS ) subtracted from them to give the relative
|
11464 |
|
|
; coordinates required by the DRAW routine.
|
11465 |
|
|
|
11466 |
|
|
; The mid entry point.
|
11467 |
|
|
|
11468 |
|
|
;; ARC-START
|
11469 |
|
|
L2439: PUSH BC ; Preserve the arc counter on the machine stack.
|
11470 |
|
|
|
11471 |
|
|
; Store the absolute ay in temporary variable mem-0 for the moment.
|
11472 |
|
|
|
11473 |
|
|
RST 28H ;; FP-CALC ax, ay.
|
11474 |
|
|
DEFB $C0 ;;st-mem-0 ax, ay.
|
11475 |
|
|
DEFB $02 ;;delete ax.
|
11476 |
|
|
|
11477 |
|
|
; Now add the fractional relative x coordinate to the fractional absolute
|
11478 |
|
|
; x coordinate to obtain a new fractional x-coordinate.
|
11479 |
|
|
|
11480 |
|
|
DEFB $E1 ;;get-mem-1 ax, xr.
|
11481 |
|
|
DEFB $0F ;;addition ax+xr (= new ax).
|
11482 |
|
|
DEFB $31 ;;duplicate ax, ax.
|
11483 |
|
|
DEFB $38 ;;end-calc ax, ax.
|
11484 |
|
|
|
11485 |
|
|
LD A,($5C7D) ; COORDS-x last x (integer ix 0-255)
|
11486 |
|
|
CALL L2D28 ; routine STACK-A
|
11487 |
|
|
|
11488 |
|
|
RST 28H ;; FP-CALC ax, ax, ix.
|
11489 |
|
|
DEFB $03 ;;subtract ax, ax-ix = relative DRAW Dx.
|
11490 |
|
|
|
11491 |
|
|
; Having calculated the x value for DRAW do the same for the y value.
|
11492 |
|
|
|
11493 |
|
|
DEFB $E0 ;;get-mem-0 ax, Dx, ay.
|
11494 |
|
|
DEFB $E2 ;;get-mem-2 ax, Dx, ay, ry.
|
11495 |
|
|
DEFB $0F ;;addition ax, Dx, ay+ry (= new ay).
|
11496 |
|
|
DEFB $C0 ;;st-mem-0 ax, Dx, ay.
|
11497 |
|
|
DEFB $01 ;;exchange ax, ay, Dx,
|
11498 |
|
|
DEFB $E0 ;;get-mem-0 ax, ay, Dx, ay.
|
11499 |
|
|
DEFB $38 ;;end-calc ax, ay, Dx, ay.
|
11500 |
|
|
|
11501 |
|
|
LD A,($5C7E) ; COORDS-y last y (integer iy 0-175)
|
11502 |
|
|
CALL L2D28 ; routine STACK-A
|
11503 |
|
|
|
11504 |
|
|
RST 28H ;; FP-CALC ax, ay, Dx, ay, iy.
|
11505 |
|
|
DEFB $03 ;;subtract ax, ay, Dx, ay-iy ( = Dy).
|
11506 |
|
|
DEFB $38 ;;end-calc ax, ay, Dx, Dy.
|
11507 |
|
|
|
11508 |
|
|
CALL L24B7 ; Routine DRAW-LINE draws (Dx,Dy) relative to
|
11509 |
|
|
; the last pixel plotted leaving absolute x
|
11510 |
|
|
; and y on the calculator stack.
|
11511 |
|
|
; ax, ay.
|
11512 |
|
|
|
11513 |
|
|
POP BC ; Restore the arc counter from the machine stack.
|
11514 |
|
|
|
11515 |
|
|
DJNZ L2425 ; Decrement and loop while > 0 to ARC-LOOP
|
11516 |
|
|
|
11517 |
|
|
; -------------
|
11518 |
|
|
; THE 'ARC END'
|
11519 |
|
|
; -------------
|
11520 |
|
|
|
11521 |
|
|
; To recap the full calculator stack is tx, ty, ax, ay.
|
11522 |
|
|
|
11523 |
|
|
; Just as one would do if drawing the curve on paper, the final line would
|
11524 |
|
|
; be drawn by joining the last point plotted to the initial start point
|
11525 |
|
|
; in the case of a CIRCLE or to the calculated end point in the case of
|
11526 |
|
|
; an ARC.
|
11527 |
|
|
; The moving absolute values of x and y are no longer required and they
|
11528 |
|
|
; can be deleted to expose the closing coordinates.
|
11529 |
|
|
|
11530 |
|
|
;; ARC-END
|
11531 |
|
|
L245F: RST 28H ;; FP-CALC tx, ty, ax, ay.
|
11532 |
|
|
DEFB $02 ;;delete tx, ty, ax.
|
11533 |
|
|
DEFB $02 ;;delete tx, ty.
|
11534 |
|
|
DEFB $01 ;;exchange ty, tx.
|
11535 |
|
|
DEFB $38 ;;end-calc ty, tx.
|
11536 |
|
|
|
11537 |
|
|
; First calculate the relative x coordinate to the end-point.
|
11538 |
|
|
|
11539 |
|
|
LD A,($5C7D) ; COORDS-x
|
11540 |
|
|
CALL L2D28 ; routine STACK-A
|
11541 |
|
|
|
11542 |
|
|
RST 28H ;; FP-CALC ty, tx, coords_x.
|
11543 |
|
|
DEFB $03 ;;subtract ty, rx.
|
11544 |
|
|
|
11545 |
|
|
; Next calculate the relative y coordinate to the end-point.
|
11546 |
|
|
|
11547 |
|
|
DEFB $01 ;;exchange rx, ty.
|
11548 |
|
|
DEFB $38 ;;end-calc rx, ty.
|
11549 |
|
|
|
11550 |
|
|
LD A,($5C7E) ; COORDS-y
|
11551 |
|
|
CALL L2D28 ; routine STACK-A
|
11552 |
|
|
|
11553 |
|
|
RST 28H ;; FP-CALC rx, ty, coords_y
|
11554 |
|
|
DEFB $03 ;;subtract rx, ry.
|
11555 |
|
|
DEFB $38 ;;end-calc rx, ry.
|
11556 |
|
|
|
11557 |
|
|
; Finally draw the last straight line.
|
11558 |
|
|
|
11559 |
|
|
;; LINE-DRAW
|
11560 |
|
|
L2477: CALL L24B7 ; routine DRAW-LINE draws to the relative
|
11561 |
|
|
; coordinates (rx, ry).
|
11562 |
|
|
|
11563 |
|
|
JP L0D4D ; jump back and exit via TEMPS >>>
|
11564 |
|
|
|
11565 |
|
|
|
11566 |
|
|
; --------------------------------------------
|
11567 |
|
|
; THE 'INITIAL CIRCLE/DRAW PARAMETERS' ROUTINE
|
11568 |
|
|
; --------------------------------------------
|
11569 |
|
|
; Begin by calculating the number of chords which will be returned in B.
|
11570 |
|
|
; A rule of thumb is employed that uses a value z which for a circle is the
|
11571 |
|
|
; radius and for an arc is the diameter with, as it happens, a pinch more if
|
11572 |
|
|
; the arc is on a slope.
|
11573 |
|
|
;
|
11574 |
|
|
; NUMBER OF STRAIGHT LINES = ANGLE OF ROTATION * SQUARE ROOT ( Z ) / 2
|
11575 |
|
|
|
11576 |
|
|
;; CD-PRMS1
|
11577 |
|
|
L247D: RST 28H ;; FP-CALC z.
|
11578 |
|
|
DEFB $31 ;;duplicate z, z.
|
11579 |
|
|
DEFB $28 ;;sqr z, sqr(z).
|
11580 |
|
|
DEFB $34 ;;stk-data z, sqr(z), 2.
|
11581 |
|
|
DEFB $32 ;;Exponent: $82, Bytes: 1
|
11582 |
|
|
DEFB $00 ;;(+00,+00,+00)
|
11583 |
|
|
DEFB $01 ;;exchange z, 2, sqr(z).
|
11584 |
|
|
DEFB $05 ;;division z, 2/sqr(z).
|
11585 |
|
|
DEFB $E5 ;;get-mem-5 z, 2/sqr(z), ANGLE.
|
11586 |
|
|
DEFB $01 ;;exchange z, ANGLE, 2/sqr (z)
|
11587 |
|
|
DEFB $05 ;;division z, ANGLE*sqr(z)/2 (= No. of lines)
|
11588 |
|
|
DEFB $2A ;;abs (for arc only)
|
11589 |
|
|
DEFB $38 ;;end-calc z, number of lines.
|
11590 |
|
|
|
11591 |
|
|
; As an example for a circle of radius 87 the number of lines will be 29.
|
11592 |
|
|
|
11593 |
|
|
CALL L2DD5 ; routine FP-TO-A
|
11594 |
|
|
|
11595 |
|
|
; The value is compressed into A register, no carry with valid circle.
|
11596 |
|
|
|
11597 |
|
|
JR C,L2495 ; forward, if over 256, to USE-252
|
11598 |
|
|
|
11599 |
|
|
; now make a multiple of 4 e.g. 29 becomes 28
|
11600 |
|
|
|
11601 |
|
|
AND $FC ; AND 252
|
11602 |
|
|
|
11603 |
|
|
; Adding 4 could set carry for arc, for the circle example, 28 becomes 32.
|
11604 |
|
|
|
11605 |
|
|
ADD A,$04 ; adding 4 could set carry if result is 256.
|
11606 |
|
|
|
11607 |
|
|
JR NC,L2497 ; forward if less than 256 to DRAW-SAVE
|
11608 |
|
|
|
11609 |
|
|
; For an arc, a limit of 252 is imposed.
|
11610 |
|
|
|
11611 |
|
|
;; USE-252
|
11612 |
|
|
L2495: LD A,$FC ; Use a value of 252 (for arc).
|
11613 |
|
|
|
11614 |
|
|
|
11615 |
|
|
; For both arcs and circles, constants derived from the central angle are
|
11616 |
|
|
; stored in the 'mem' locations. Some are not relevant for the circle.
|
11617 |
|
|
|
11618 |
|
|
;; DRAW-SAVE
|
11619 |
|
|
L2497: PUSH AF ; Save the line count (A) on the machine stack.
|
11620 |
|
|
|
11621 |
|
|
CALL L2D28 ; Routine STACK-A stacks the modified count(A).
|
11622 |
|
|
|
11623 |
|
|
RST 28H ;; FP-CALC z, A.
|
11624 |
|
|
DEFB $E5 ;;get-mem-5 z, A, ANGLE.
|
11625 |
|
|
DEFB $01 ;;exchange z, ANGLE, A.
|
11626 |
|
|
DEFB $05 ;;division z, ANGLE/A. (Angle/count = a)
|
11627 |
|
|
DEFB $31 ;;duplicate z, a, a.
|
11628 |
|
|
|
11629 |
|
|
; Note. that cos (a) could be formed here directly using 'cos' and stored in
|
11630 |
|
|
; mem-3 but that would spoil a good story and be slightly slower, as also
|
11631 |
|
|
; would using square roots to form cos (a) from sin (a).
|
11632 |
|
|
|
11633 |
|
|
DEFB $1F ;;sin z, a, sin(a)
|
11634 |
|
|
DEFB $C4 ;;st-mem-4 z, a, sin(a)
|
11635 |
|
|
DEFB $02 ;;delete z, a.
|
11636 |
|
|
DEFB $31 ;;duplicate z, a, a.
|
11637 |
|
|
DEFB $A2 ;;stk-half z, a, a, 1/2.
|
11638 |
|
|
DEFB $04 ;;multiply z, a, a/2.
|
11639 |
|
|
DEFB $1F ;;sin z, a, sin(a/2).
|
11640 |
|
|
|
11641 |
|
|
; Note. after second sin, mem-0 and mem-1 become free.
|
11642 |
|
|
|
11643 |
|
|
DEFB $C1 ;;st-mem-1 z, a, sin(a/2).
|
11644 |
|
|
DEFB $01 ;;exchange z, sin(a/2), a.
|
11645 |
|
|
DEFB $C0 ;;st-mem-0 z, sin(a/2), a. (for arc only)
|
11646 |
|
|
|
11647 |
|
|
; Now form cos(a) from sin(a/2) using the 'DOUBLE ANGLE FORMULA'.
|
11648 |
|
|
|
11649 |
|
|
DEFB $02 ;;delete z, sin(a/2).
|
11650 |
|
|
DEFB $31 ;;duplicate z, sin(a/2), sin(a/2).
|
11651 |
|
|
DEFB $04 ;;multiply z, sin(a/2)*sin(a/2).
|
11652 |
|
|
DEFB $31 ;;duplicate z, sin(a/2)*sin(a/2),
|
11653 |
|
|
;; sin(a/2)*sin(a/2).
|
11654 |
|
|
DEFB $0F ;;addition z, 2*sin(a/2)*sin(a/2).
|
11655 |
|
|
DEFB $A1 ;;stk-one z, 2*sin(a/2)*sin(a/2), 1.
|
11656 |
|
|
DEFB $03 ;;subtract z, 2*sin(a/2)*sin(a/2)-1.
|
11657 |
|
|
|
11658 |
|
|
DEFB $1B ;;negate z, 1-2*sin(a/2)*sin(a/2).
|
11659 |
|
|
|
11660 |
|
|
DEFB $C3 ;;st-mem-3 z, cos(a).
|
11661 |
|
|
DEFB $02 ;;delete z.
|
11662 |
|
|
DEFB $38 ;;end-calc z.
|
11663 |
|
|
|
11664 |
|
|
; The radius/diameter is left on the calculator stack.
|
11665 |
|
|
|
11666 |
|
|
POP BC ; Restore the line count to the B register.
|
11667 |
|
|
|
11668 |
|
|
RET ; Return.
|
11669 |
|
|
|
11670 |
|
|
; --------------------------
|
11671 |
|
|
; THE 'DOUBLE ANGLE FORMULA'
|
11672 |
|
|
; --------------------------
|
11673 |
|
|
; This formula forms cos(a) from sin(a/2) using simple arithmetic.
|
11674 |
|
|
;
|
11675 |
|
|
; THE GEOMETRIC PROOF OF FORMULA cos (a) = 1 - 2 * sin(a/2) * sin(a/2)
|
11676 |
|
|
;
|
11677 |
|
|
;
|
11678 |
|
|
; A
|
11679 |
|
|
;
|
11680 |
|
|
; . /|\
|
11681 |
|
|
; . / | \
|
11682 |
|
|
; . / | \
|
11683 |
|
|
; . / |a/2\
|
11684 |
|
|
; . / | \
|
11685 |
|
|
; . 1 / | \
|
11686 |
|
|
; . / | \
|
11687 |
|
|
; . / | \
|
11688 |
|
|
; . / | \
|
11689 |
|
|
; . a/2 D / a E|-+ \
|
11690 |
|
|
; B ---------------------/----------+-+--------\ C
|
11691 |
|
|
; <- 1 -><- 1 ->
|
11692 |
|
|
;
|
11693 |
|
|
; cos a = 1 - 2 * sin(a/2) * sin(a/2)
|
11694 |
|
|
;
|
11695 |
|
|
; The figure shows a right triangle that inscribes a circle of radius 1 with
|
11696 |
|
|
; centre, or origin, D. Line BC is the diameter of length 2 and A is a point
|
11697 |
|
|
; on the circle. The periphery angle BAC is therefore a right angle by the
|
11698 |
|
|
; Rule of Thales.
|
11699 |
|
|
; Line AC is a chord touching two points on the circle and the angle at the
|
11700 |
|
|
; centre is (a).
|
11701 |
|
|
; Since the vertex of the largest triangle B touches the circle, the
|
11702 |
|
|
; inscribed angle (a/2) is half the central angle (a).
|
11703 |
|
|
; The cosine of (a) is the length DE as the hypotenuse is of length 1.
|
11704 |
|
|
; This can also be expressed as 1-length CE. Examining the triangle at the
|
11705 |
|
|
; right, the top angle is also (a/2) as angle BAE and EBA add to give a right
|
11706 |
|
|
; angle as do BAE and EAC.
|
11707 |
|
|
; So cos (a) = 1 - AC * sin(a/2)
|
11708 |
|
|
; Looking at the largest triangle, side AC can be expressed as
|
11709 |
|
|
; AC = 2 * sin(a/2) and so combining these we get
|
11710 |
|
|
; cos (a) = 1 - 2 * sin(a/2) * sin(a/2).
|
11711 |
|
|
;
|
11712 |
|
|
; "I will be sufficiently rewarded if when telling it to others, you will
|
11713 |
|
|
; not claim the discovery as your own, but will say it is mine."
|
11714 |
|
|
; - Thales, 640 - 546 B.C.
|
11715 |
|
|
;
|
11716 |
|
|
; --------------------------
|
11717 |
|
|
; THE 'LINE DRAWING' ROUTINE
|
11718 |
|
|
; --------------------------
|
11719 |
|
|
;
|
11720 |
|
|
;
|
11721 |
|
|
|
11722 |
|
|
;; DRAW-LINE
|
11723 |
|
|
L24B7: CALL L2307 ; routine STK-TO-BC
|
11724 |
|
|
LD A,C ;
|
11725 |
|
|
CP B ;
|
11726 |
|
|
JR NC,L24C4 ; to DL-X-GE-Y
|
11727 |
|
|
|
11728 |
|
|
LD L,C ;
|
11729 |
|
|
PUSH DE ;
|
11730 |
|
|
XOR A ;
|
11731 |
|
|
LD E,A ;
|
11732 |
|
|
JR L24CB ; to DL-LARGER
|
11733 |
|
|
|
11734 |
|
|
; ---
|
11735 |
|
|
|
11736 |
|
|
;; DL-X-GE-Y
|
11737 |
|
|
L24C4: OR C ;
|
11738 |
|
|
RET Z ;
|
11739 |
|
|
|
11740 |
|
|
LD L,B ;
|
11741 |
|
|
LD B,C ;
|
11742 |
|
|
PUSH DE ;
|
11743 |
|
|
LD D,$00 ;
|
11744 |
|
|
|
11745 |
|
|
;; DL-LARGER
|
11746 |
|
|
L24CB: LD H,B ;
|
11747 |
|
|
LD A,B ;
|
11748 |
|
|
RRA ;
|
11749 |
|
|
|
11750 |
|
|
;; D-L-LOOP
|
11751 |
|
|
L24CE: ADD A,L ;
|
11752 |
|
|
JR C,L24D4 ; to D-L-DIAG
|
11753 |
|
|
|
11754 |
|
|
CP H ;
|
11755 |
|
|
JR C,L24DB ; to D-L-HR-VT
|
11756 |
|
|
|
11757 |
|
|
;; D-L-DIAG
|
11758 |
|
|
L24D4: SUB H ;
|
11759 |
|
|
LD C,A ;
|
11760 |
|
|
EXX ;
|
11761 |
|
|
POP BC ;
|
11762 |
|
|
PUSH BC ;
|
11763 |
|
|
JR L24DF ; to D-L-STEP
|
11764 |
|
|
|
11765 |
|
|
; ---
|
11766 |
|
|
|
11767 |
|
|
;; D-L-HR-VT
|
11768 |
|
|
L24DB: LD C,A ;
|
11769 |
|
|
PUSH DE ;
|
11770 |
|
|
EXX ;
|
11771 |
|
|
POP BC ;
|
11772 |
|
|
|
11773 |
|
|
;; D-L-STEP
|
11774 |
|
|
L24DF: LD HL,($5C7D) ; COORDS
|
11775 |
|
|
LD A,B ;
|
11776 |
|
|
ADD A,H ;
|
11777 |
|
|
LD B,A ;
|
11778 |
|
|
LD A,C ;
|
11779 |
|
|
INC A ;
|
11780 |
|
|
ADD A,L ;
|
11781 |
|
|
JR C,L24F7 ; to D-L-RANGE
|
11782 |
|
|
|
11783 |
|
|
JR Z,L24F9 ; to REPORT-Bc
|
11784 |
|
|
|
11785 |
|
|
;; D-L-PLOT
|
11786 |
|
|
L24EC: DEC A ;
|
11787 |
|
|
LD C,A ;
|
11788 |
|
|
CALL L22E5 ; routine PLOT-SUB
|
11789 |
|
|
EXX ;
|
11790 |
|
|
LD A,C ;
|
11791 |
|
|
DJNZ L24CE ; to D-L-LOOP
|
11792 |
|
|
|
11793 |
|
|
POP DE ;
|
11794 |
|
|
RET ;
|
11795 |
|
|
|
11796 |
|
|
; ---
|
11797 |
|
|
|
11798 |
|
|
;; D-L-RANGE
|
11799 |
|
|
L24F7: JR Z,L24EC ; to D-L-PLOT
|
11800 |
|
|
|
11801 |
|
|
|
11802 |
|
|
;; REPORT-Bc
|
11803 |
|
|
L24F9: RST 08H ; ERROR-1
|
11804 |
|
|
DEFB $0A ; Error Report: Integer out of range
|
11805 |
|
|
|
11806 |
|
|
|
11807 |
|
|
|
11808 |
|
|
;***********************************
|
11809 |
|
|
;** Part 8. EXPRESSION EVALUATION **
|
11810 |
|
|
;***********************************
|
11811 |
|
|
;
|
11812 |
|
|
; It is a this stage of the ROM that the Spectrum ceases altogether to be
|
11813 |
|
|
; just a colourful novelty. One remarkable feature is that in all previous
|
11814 |
|
|
; commands when the Spectrum is expecting a number or a string then an
|
11815 |
|
|
; expression of the same type can be substituted ad infinitum.
|
11816 |
|
|
; This is the routine that evaluates that expression.
|
11817 |
|
|
; This is what causes 2 + 2 to give the answer 4.
|
11818 |
|
|
; That is quite easy to understand. However you don't have to make it much
|
11819 |
|
|
; more complex to start a remarkable juggling act.
|
11820 |
|
|
; e.g. PRINT 2 * (VAL "2+2" + TAN 3)
|
11821 |
|
|
; In fact, provided there is enough free RAM, the Spectrum can evaluate
|
11822 |
|
|
; an expression of unlimited complexity.
|
11823 |
|
|
; Apart from a couple of minor glitches, which you can now correct, the
|
11824 |
|
|
; system is remarkably robust.
|
11825 |
|
|
|
11826 |
|
|
|
11827 |
|
|
; ---------------------------------
|
11828 |
|
|
; Scan expression or sub-expression
|
11829 |
|
|
; ---------------------------------
|
11830 |
|
|
;
|
11831 |
|
|
;
|
11832 |
|
|
|
11833 |
|
|
;; SCANNING
|
11834 |
|
|
L24FB: RST 18H ; GET-CHAR
|
11835 |
|
|
LD B,$00 ; priority marker zero is pushed on stack
|
11836 |
|
|
; to signify end of expression when it is
|
11837 |
|
|
; popped off again.
|
11838 |
|
|
PUSH BC ; put in on stack.
|
11839 |
|
|
; and proceed to consider the first character
|
11840 |
|
|
; of the expression.
|
11841 |
|
|
|
11842 |
|
|
;; S-LOOP-1
|
11843 |
|
|
L24FF: LD C,A ; store the character while a look up is done.
|
11844 |
|
|
LD HL,L2596 ; Address: scan-func
|
11845 |
|
|
CALL L16DC ; routine INDEXER is called to see if it is
|
11846 |
|
|
; part of a limited range '+', '(', 'ATTR' etc.
|
11847 |
|
|
|
11848 |
|
|
LD A,C ; fetch the character back
|
11849 |
|
|
JP NC,L2684 ; jump forward to S-ALPHNUM if not in primary
|
11850 |
|
|
; operators and functions to consider in the
|
11851 |
|
|
; first instance a digit or a variable and
|
11852 |
|
|
; then anything else. >>>
|
11853 |
|
|
|
11854 |
|
|
LD B,$00 ; but here if it was found in table so
|
11855 |
|
|
LD C,(HL) ; fetch offset from table and make B zero.
|
11856 |
|
|
ADD HL,BC ; add the offset to position found
|
11857 |
|
|
JP (HL) ; and jump to the routine e.g. S-BIN
|
11858 |
|
|
; making an indirect exit from there.
|
11859 |
|
|
|
11860 |
|
|
; -------------------------------------------------------------------------
|
11861 |
|
|
; The four service subroutines for routines in the scanning function table
|
11862 |
|
|
; -------------------------------------------------------------------------
|
11863 |
|
|
|
11864 |
|
|
; PRINT """Hooray!"" he cried."
|
11865 |
|
|
|
11866 |
|
|
;; S-QUOTE-S
|
11867 |
|
|
L250F: CALL L0074 ; routine CH-ADD+1 points to next character
|
11868 |
|
|
; and fetches that character.
|
11869 |
|
|
INC BC ; increase length counter.
|
11870 |
|
|
CP $0D ; is it carriage return ?
|
11871 |
|
|
; inside a quote.
|
11872 |
|
|
JP Z,L1C8A ; jump back to REPORT-C if so.
|
11873 |
|
|
; 'Nonsense in BASIC'.
|
11874 |
|
|
|
11875 |
|
|
CP $22 ; is it a quote '"' ?
|
11876 |
|
|
JR NZ,L250F ; back to S-QUOTE-S if not for more.
|
11877 |
|
|
|
11878 |
|
|
CALL L0074 ; routine CH-ADD+1
|
11879 |
|
|
CP $22 ; compare with possible adjacent quote
|
11880 |
|
|
RET ; return. with zero set if two together.
|
11881 |
|
|
|
11882 |
|
|
; ---
|
11883 |
|
|
|
11884 |
|
|
; This subroutine is used to get two coordinate expressions for the three
|
11885 |
|
|
; functions SCREEN$, ATTR and POINT that have two fixed parameters and
|
11886 |
|
|
; therefore require surrounding braces.
|
11887 |
|
|
|
11888 |
|
|
;; S-2-COORD
|
11889 |
|
|
L2522: RST 20H ; NEXT-CHAR
|
11890 |
|
|
CP $28 ; is it the opening '(' ?
|
11891 |
|
|
JR NZ,L252D ; forward to S-RPORT-C if not
|
11892 |
|
|
; 'Nonsense in BASIC'.
|
11893 |
|
|
|
11894 |
|
|
CALL L1C79 ; routine NEXT-2NUM gets two comma-separated
|
11895 |
|
|
; numeric expressions. Note. this could cause
|
11896 |
|
|
; many more recursive calls to SCANNING but
|
11897 |
|
|
; the parent function will be evaluated fully
|
11898 |
|
|
; before rejoining the main juggling act.
|
11899 |
|
|
|
11900 |
|
|
RST 18H ; GET-CHAR
|
11901 |
|
|
CP $29 ; is it the closing ')' ?
|
11902 |
|
|
|
11903 |
|
|
;; S-RPORT-C
|
11904 |
|
|
L252D: JP NZ,L1C8A ; jump back to REPORT-C if not.
|
11905 |
|
|
; 'Nonsense in BASIC'.
|
11906 |
|
|
|
11907 |
|
|
; ------------
|
11908 |
|
|
; Check syntax
|
11909 |
|
|
; ------------
|
11910 |
|
|
; This routine is called on a number of occasions to check if syntax is being
|
11911 |
|
|
; checked or if the program is being run. To test the flag inline would use
|
11912 |
|
|
; four bytes of code, but a call instruction only uses 3 bytes of code.
|
11913 |
|
|
|
11914 |
|
|
;; SYNTAX-Z
|
11915 |
|
|
L2530: BIT 7,(IY+$01) ; test FLAGS - checking syntax only ?
|
11916 |
|
|
RET ; return.
|
11917 |
|
|
|
11918 |
|
|
; ----------------
|
11919 |
|
|
; Scanning SCREEN$
|
11920 |
|
|
; ----------------
|
11921 |
|
|
; This function returns the code of a bit-mapped character at screen
|
11922 |
|
|
; position at line C, column B. It is unable to detect the mosaic characters
|
11923 |
|
|
; which are not bit-mapped but detects the ASCII 32 - 127 range.
|
11924 |
|
|
; The bit-mapped UDGs are ignored which is curious as it requires only a
|
11925 |
|
|
; few extra bytes of code. As usual, anything to do with CHARS is weird.
|
11926 |
|
|
; If no match is found a null string is returned.
|
11927 |
|
|
; No actual check on ranges is performed - that's up to the BASIC programmer.
|
11928 |
|
|
; No real harm can come from SCREEN$(255,255) although the BASIC manual
|
11929 |
|
|
; says that invalid values will be trapped.
|
11930 |
|
|
; Interestingly, in the Pitman pocket guide, 1984, Vickers says that the
|
11931 |
|
|
; range checking will be performed.
|
11932 |
|
|
|
11933 |
|
|
;; S-SCRN$-S
|
11934 |
|
|
L2535: CALL L2307 ; routine STK-TO-BC.
|
11935 |
|
|
LD HL,($5C36) ; fetch address of CHARS.
|
11936 |
|
|
LD DE,$0100 ; fetch offset to chr$ 32
|
11937 |
|
|
ADD HL,DE ; and find start of bitmaps.
|
11938 |
|
|
; Note. not inc h. ??
|
11939 |
|
|
LD A,C ; transfer line to A.
|
11940 |
|
|
RRCA ; multiply
|
11941 |
|
|
RRCA ; by
|
11942 |
|
|
RRCA ; thirty-two.
|
11943 |
|
|
AND $E0 ; and with 11100000
|
11944 |
|
|
XOR B ; combine with column $00 - $1F
|
11945 |
|
|
LD E,A ; to give the low byte of top line
|
11946 |
|
|
LD A,C ; column to A range 00000000 to 00011111
|
11947 |
|
|
AND $18 ; and with 00011000
|
11948 |
|
|
XOR $40 ; xor with 01000000 (high byte screen start)
|
11949 |
|
|
LD D,A ; register DE now holds start address of cell.
|
11950 |
|
|
LD B,$60 ; there are 96 characters in ASCII set.
|
11951 |
|
|
|
11952 |
|
|
;; S-SCRN-LP
|
11953 |
|
|
L254F: PUSH BC ; save count
|
11954 |
|
|
PUSH DE ; save screen start address
|
11955 |
|
|
PUSH HL ; save bitmap start
|
11956 |
|
|
LD A,(DE) ; first byte of screen to A
|
11957 |
|
|
XOR (HL) ; xor with corresponding character byte
|
11958 |
|
|
JR Z,L255A ; forward to S-SC-MTCH if they match
|
11959 |
|
|
; if inverse result would be $FF
|
11960 |
|
|
; if any other then mismatch
|
11961 |
|
|
|
11962 |
|
|
INC A ; set to $00 if inverse
|
11963 |
|
|
JR NZ,L2573 ; forward to S-SCR-NXT if a mismatch
|
11964 |
|
|
|
11965 |
|
|
DEC A ; restore $FF
|
11966 |
|
|
|
11967 |
|
|
; a match has been found so seven more to test.
|
11968 |
|
|
|
11969 |
|
|
;; S-SC-MTCH
|
11970 |
|
|
L255A: LD C,A ; load C with inverse mask $00 or $FF
|
11971 |
|
|
LD B,$07 ; count seven more bytes
|
11972 |
|
|
|
11973 |
|
|
;; S-SC-ROWS
|
11974 |
|
|
L255D: INC D ; increment screen address.
|
11975 |
|
|
INC HL ; increment bitmap address.
|
11976 |
|
|
LD A,(DE) ; byte to A
|
11977 |
|
|
XOR (HL) ; will give $00 or $FF (inverse)
|
11978 |
|
|
XOR C ; xor with inverse mask
|
11979 |
|
|
JR NZ,L2573 ; forward to S-SCR-NXT if no match.
|
11980 |
|
|
|
11981 |
|
|
DJNZ L255D ; back to S-SC-ROWS until all eight matched.
|
11982 |
|
|
|
11983 |
|
|
; continue if a match of all eight bytes was found
|
11984 |
|
|
|
11985 |
|
|
POP BC ; discard the
|
11986 |
|
|
POP BC ; saved
|
11987 |
|
|
POP BC ; pointers
|
11988 |
|
|
LD A,$80 ; the endpoint of character set
|
11989 |
|
|
SUB B ; subtract the counter
|
11990 |
|
|
; to give the code 32-127
|
11991 |
|
|
LD BC,$0001 ; make one space in workspace.
|
11992 |
|
|
|
11993 |
|
|
RST 30H ; BC-SPACES creates the space sliding
|
11994 |
|
|
; the calculator stack upwards.
|
11995 |
|
|
LD (DE),A ; start is addressed by DE, so insert code
|
11996 |
|
|
JR L257D ; forward to S-SCR-STO
|
11997 |
|
|
|
11998 |
|
|
; ---
|
11999 |
|
|
|
12000 |
|
|
; the jump was here if no match and more bitmaps to test.
|
12001 |
|
|
|
12002 |
|
|
;; S-SCR-NXT
|
12003 |
|
|
L2573: POP HL ; restore the last bitmap start
|
12004 |
|
|
LD DE,$0008 ; and prepare to add 8.
|
12005 |
|
|
ADD HL,DE ; now addresses next character bitmap.
|
12006 |
|
|
POP DE ; restore screen address
|
12007 |
|
|
POP BC ; and character counter in B
|
12008 |
|
|
DJNZ L254F ; back to S-SCRN-LP if more characters.
|
12009 |
|
|
|
12010 |
|
|
LD C,B ; B is now zero, so BC now zero.
|
12011 |
|
|
|
12012 |
|
|
;; S-SCR-STO
|
12013 |
|
|
L257D: JP L2AB2 ; to STK-STO-$ to store the string in
|
12014 |
|
|
; workspace or a string with zero length.
|
12015 |
|
|
; (value of DE doesn't matter in last case)
|
12016 |
|
|
|
12017 |
|
|
; Note. this exit seems correct but the general-purpose routine S-STRING
|
12018 |
|
|
; that calls this one will also stack any of its string results so this
|
12019 |
|
|
; leads to a double storing of the result in this case.
|
12020 |
|
|
; The instruction at L257D should just be a RET.
|
12021 |
|
|
; credit Stephen Kelly and others, 1982.
|
12022 |
|
|
|
12023 |
|
|
; -------------
|
12024 |
|
|
; Scanning ATTR
|
12025 |
|
|
; -------------
|
12026 |
|
|
; This function subroutine returns the attributes of a screen location -
|
12027 |
|
|
; a numeric result.
|
12028 |
|
|
; Again it's up to the BASIC programmer to supply valid values of line/column.
|
12029 |
|
|
|
12030 |
|
|
;; S-ATTR-S
|
12031 |
|
|
L2580: CALL L2307 ; routine STK-TO-BC fetches line to C,
|
12032 |
|
|
; and column to B.
|
12033 |
|
|
LD A,C ; line to A $00 - $17 (max 00010111)
|
12034 |
|
|
RRCA ; rotate
|
12035 |
|
|
RRCA ; bits
|
12036 |
|
|
RRCA ; left.
|
12037 |
|
|
LD C,A ; store in C as an intermediate value.
|
12038 |
|
|
|
12039 |
|
|
AND $E0 ; pick up bits 11100000 ( was 00011100 )
|
12040 |
|
|
XOR B ; combine with column $00 - $1F
|
12041 |
|
|
LD L,A ; low byte now correct.
|
12042 |
|
|
|
12043 |
|
|
LD A,C ; bring back intermediate result from C
|
12044 |
|
|
AND $03 ; mask to give correct third of
|
12045 |
|
|
; screen $00 - $02
|
12046 |
|
|
XOR $58 ; combine with base address.
|
12047 |
|
|
LD H,A ; high byte correct.
|
12048 |
|
|
LD A,(HL) ; pick up the colour attribute.
|
12049 |
|
|
JP L2D28 ; forward to STACK-A to store result
|
12050 |
|
|
; and make an indirect exit.
|
12051 |
|
|
|
12052 |
|
|
; -----------------------
|
12053 |
|
|
; Scanning function table
|
12054 |
|
|
; -----------------------
|
12055 |
|
|
; This table is used by INDEXER routine to find the offsets to
|
12056 |
|
|
; four operators and eight functions. e.g. $A8 is the token 'FN'.
|
12057 |
|
|
; This table is used in the first instance for the first character of an
|
12058 |
|
|
; expression or by a recursive call to SCANNING for the first character of
|
12059 |
|
|
; any sub-expression. It eliminates functions that have no argument or
|
12060 |
|
|
; functions that can have more than one argument and therefore require
|
12061 |
|
|
; braces. By eliminating and dealing with these now it can later take a
|
12062 |
|
|
; simplistic approach to all other functions and assume that they have
|
12063 |
|
|
; one argument.
|
12064 |
|
|
; Similarly by eliminating BIN and '.' now it is later able to assume that
|
12065 |
|
|
; all numbers begin with a digit and that the presence of a number or
|
12066 |
|
|
; variable can be detected by a call to ALPHANUM.
|
12067 |
|
|
; By default all expressions are positive and the spurious '+' is eliminated
|
12068 |
|
|
; now as in print +2. This should not be confused with the operator '+'.
|
12069 |
|
|
; Note. this does allow a degree of nonsense to be accepted as in
|
12070 |
|
|
; PRINT +"3 is the greatest.".
|
12071 |
|
|
; An acquired programming skill is the ability to include brackets where
|
12072 |
|
|
; they are not necessary.
|
12073 |
|
|
; A bracket at the start of a sub-expression may be spurious or necessary
|
12074 |
|
|
; to denote that the contained expression is to be evaluated as an entity.
|
12075 |
|
|
; In either case this is dealt with by recursive calls to SCANNING.
|
12076 |
|
|
; An expression that begins with a quote requires special treatment.
|
12077 |
|
|
|
12078 |
|
|
;; scan-func
|
12079 |
|
|
L2596: DEFB $22, L25B3-$-1 ; $1C offset to S-QUOTE
|
12080 |
|
|
DEFB '(', L25E8-$-1 ; $4F offset to S-BRACKET
|
12081 |
|
|
DEFB '.', L268D-$-1 ; $F2 offset to S-DECIMAL
|
12082 |
|
|
DEFB '+', L25AF-$-1 ; $12 offset to S-U-PLUS
|
12083 |
|
|
|
12084 |
|
|
DEFB $A8, L25F5-$-1 ; $56 offset to S-FN
|
12085 |
|
|
DEFB $A5, L25F8-$-1 ; $57 offset to S-RND
|
12086 |
|
|
DEFB $A7, L2627-$-1 ; $84 offset to S-PI
|
12087 |
|
|
DEFB $A6, L2634-$-1 ; $8F offset to S-INKEY$
|
12088 |
|
|
DEFB $C4, L268D-$-1 ; $E6 offset to S-BIN
|
12089 |
|
|
DEFB $AA, L2668-$-1 ; $BF offset to S-SCREEN$
|
12090 |
|
|
DEFB $AB, L2672-$-1 ; $C7 offset to S-ATTR
|
12091 |
|
|
DEFB $A9, L267B-$-1 ; $CE offset to S-POINT
|
12092 |
|
|
|
12093 |
|
|
DEFB $00 ; zero end marker
|
12094 |
|
|
|
12095 |
|
|
; --------------------------
|
12096 |
|
|
; Scanning function routines
|
12097 |
|
|
; --------------------------
|
12098 |
|
|
; These are the 11 subroutines accessed by the above table.
|
12099 |
|
|
; S-BIN and S-DECIMAL are the same
|
12100 |
|
|
; The 1-byte offset limits their location to within 255 bytes of their
|
12101 |
|
|
; entry in the table.
|
12102 |
|
|
|
12103 |
|
|
; ->
|
12104 |
|
|
;; S-U-PLUS
|
12105 |
|
|
L25AF: RST 20H ; NEXT-CHAR just ignore
|
12106 |
|
|
JP L24FF ; to S-LOOP-1
|
12107 |
|
|
|
12108 |
|
|
; ---
|
12109 |
|
|
|
12110 |
|
|
; ->
|
12111 |
|
|
;; S-QUOTE
|
12112 |
|
|
L25B3: RST 18H ; GET-CHAR
|
12113 |
|
|
INC HL ; address next character (first in quotes)
|
12114 |
|
|
PUSH HL ; save start of quoted text.
|
12115 |
|
|
LD BC,$0000 ; initialize length of string to zero.
|
12116 |
|
|
CALL L250F ; routine S-QUOTE-S
|
12117 |
|
|
JR NZ,L25D9 ; forward to S-Q-PRMS if
|
12118 |
|
|
|
12119 |
|
|
;; S-Q-AGAIN
|
12120 |
|
|
L25BE: CALL L250F ; routine S-QUOTE-S copies string until a
|
12121 |
|
|
; quote is encountered
|
12122 |
|
|
JR Z,L25BE ; back to S-Q-AGAIN if two quotes WERE
|
12123 |
|
|
; together.
|
12124 |
|
|
|
12125 |
|
|
; but if just an isolated quote then that terminates the string.
|
12126 |
|
|
|
12127 |
|
|
CALL L2530 ; routine SYNTAX-Z
|
12128 |
|
|
JR Z,L25D9 ; forward to S-Q-PRMS if checking syntax.
|
12129 |
|
|
|
12130 |
|
|
|
12131 |
|
|
RST 30H ; BC-SPACES creates the space for true
|
12132 |
|
|
; copy of string in workspace.
|
12133 |
|
|
POP HL ; re-fetch start of quoted text.
|
12134 |
|
|
PUSH DE ; save start in workspace.
|
12135 |
|
|
|
12136 |
|
|
;; S-Q-COPY
|
12137 |
|
|
L25CB: LD A,(HL) ; fetch a character from source.
|
12138 |
|
|
INC HL ; advance source address.
|
12139 |
|
|
LD (DE),A ; place in destination.
|
12140 |
|
|
INC DE ; advance destination address.
|
12141 |
|
|
CP $22 ; was it a '"' just copied ?
|
12142 |
|
|
JR NZ,L25CB ; back to S-Q-COPY to copy more if not
|
12143 |
|
|
|
12144 |
|
|
LD A,(HL) ; fetch adjacent character from source.
|
12145 |
|
|
INC HL ; advance source address.
|
12146 |
|
|
CP $22 ; is this '"' ? - i.e. two quotes together ?
|
12147 |
|
|
JR Z,L25CB ; to S-Q-COPY if so including just one of the
|
12148 |
|
|
; pair of quotes.
|
12149 |
|
|
|
12150 |
|
|
; proceed when terminating quote encountered.
|
12151 |
|
|
|
12152 |
|
|
;; S-Q-PRMS
|
12153 |
|
|
L25D9: DEC BC ; decrease count by 1.
|
12154 |
|
|
POP DE ; restore start of string in workspace.
|
12155 |
|
|
|
12156 |
|
|
;; S-STRING
|
12157 |
|
|
L25DB: LD HL,$5C3B ; Address FLAGS system variable.
|
12158 |
|
|
RES 6,(HL) ; signal string result.
|
12159 |
|
|
BIT 7,(HL) ; is syntax being checked.
|
12160 |
|
|
CALL NZ,L2AB2 ; routine STK-STO-$ is called in runtime.
|
12161 |
|
|
JP L2712 ; jump forward to S-CONT-2 ===>
|
12162 |
|
|
|
12163 |
|
|
; ---
|
12164 |
|
|
|
12165 |
|
|
; ->
|
12166 |
|
|
;; S-BRACKET
|
12167 |
|
|
L25E8: RST 20H ; NEXT-CHAR
|
12168 |
|
|
CALL L24FB ; routine SCANNING is called recursively.
|
12169 |
|
|
CP $29 ; is it the closing ')' ?
|
12170 |
|
|
JP NZ,L1C8A ; jump back to REPORT-C if not
|
12171 |
|
|
; 'Nonsense in BASIC'
|
12172 |
|
|
|
12173 |
|
|
RST 20H ; NEXT-CHAR
|
12174 |
|
|
JP L2712 ; jump forward to S-CONT-2 ===>
|
12175 |
|
|
|
12176 |
|
|
; ---
|
12177 |
|
|
|
12178 |
|
|
; ->
|
12179 |
|
|
;; S-FN
|
12180 |
|
|
L25F5: JP L27BD ; jump forward to S-FN-SBRN.
|
12181 |
|
|
|
12182 |
|
|
; --------------------------------------------------------------------
|
12183 |
|
|
;
|
12184 |
|
|
; RANDOM THEORY from the ZX81 manual by Steven Vickers
|
12185 |
|
|
;
|
12186 |
|
|
; (same algorithm as the ZX Spectrum).
|
12187 |
|
|
;
|
12188 |
|
|
; Chapter 5. Exercise 6. (For mathematicians only.)
|
12189 |
|
|
;
|
12190 |
|
|
; Let p be a [large] prime, & let a be a primitive root modulo p.
|
12191 |
|
|
; Then if b_i is the residue of a^i modulo p (1<=b_i
|
12192 |
|
|
; sequence
|
12193 |
|
|
;
|
12194 |
|
|
; (b_i-1)/(p-1)
|
12195 |
|
|
;
|
12196 |
|
|
; is a cyclical sequence of p-1 distinct numbers in the range 0 to 1
|
12197 |
|
|
; (excluding 1). By choosing a suitably, these can be made to look
|
12198 |
|
|
; fairly random.
|
12199 |
|
|
;
|
12200 |
|
|
; 65537 is a Mersenne prime 2^16-1. Note.
|
12201 |
|
|
;
|
12202 |
|
|
; Use this, & Gauss' law of quadratic reciprocity, to show that 75
|
12203 |
|
|
; is a primitive root modulo 65537.
|
12204 |
|
|
;
|
12205 |
|
|
; The ZX81 uses p=65537 & a=75, & stores some b_i-1 in memory.
|
12206 |
|
|
; The function RND involves replacing b_i-1 in memory by b_(i+1)-1,
|
12207 |
|
|
; & yielding the result (b_(i+1)-1)/(p-1). RAND n (with 1<=n<=65535)
|
12208 |
|
|
; makes b_i equal to n+1.
|
12209 |
|
|
;
|
12210 |
|
|
; --------------------------------------------------------------------
|
12211 |
|
|
;
|
12212 |
|
|
; Steven Vickers writing in comp.sys.sinclair on 20-DEC-1993
|
12213 |
|
|
;
|
12214 |
|
|
; Note. (Of course, 65537 is 2^16 + 1, not -1.)
|
12215 |
|
|
;
|
12216 |
|
|
; Consider arithmetic modulo a prime p. There are p residue classes, and the
|
12217 |
|
|
; non-zero ones are all invertible. Hence under multiplication they form a
|
12218 |
|
|
; group (Fp*, say) of order p-1; moreover (and not so obvious) Fp* is cyclic.
|
12219 |
|
|
; Its generators are the "primitive roots". The "quadratic residues modulo p"
|
12220 |
|
|
; are the squares in Fp*, and the "Legendre symbol" (d/p) is defined (when p
|
12221 |
|
|
; does not divide d) as +1 or -1, according as d is or is not a quadratic
|
12222 |
|
|
; residue mod p.
|
12223 |
|
|
;
|
12224 |
|
|
; In the case when p = 65537, we can show that d is a primitive root if and
|
12225 |
|
|
; only if it's not a quadratic residue. For let w be a primitive root, d
|
12226 |
|
|
; congruent to w^r (mod p). If d is not primitive, then its order is a proper
|
12227 |
|
|
; factor of 65536: hence w^{32768*r} = 1 (mod p), so 65536 divides 32768*r,
|
12228 |
|
|
; and hence r is even and d is a square (mod p). Conversely, the squares in
|
12229 |
|
|
; Fp* form a subgroup of (Fp*)^2 of index 2, and so cannot be generators.
|
12230 |
|
|
;
|
12231 |
|
|
; Hence to check whether 75 is primitive mod 65537, we want to calculate that
|
12232 |
|
|
; (75/65537) = -1. There is a multiplicative formula (ab/p) = (a/p)(b/p) (mod
|
12233 |
|
|
; p), so (75/65537) = (5/65537)^2 * (3/65537) = (3/65537). Now the law of
|
12234 |
|
|
; quadratic reciprocity says that if p and q are distinct odd primes, then
|
12235 |
|
|
;
|
12236 |
|
|
; (p/q)(q/p) = (-1)^{(p-1)(q-1)/4}
|
12237 |
|
|
;
|
12238 |
|
|
; Hence (3/65537) = (65537/3) * (-1)^{65536*2/4} = (65537/3)
|
12239 |
|
|
; = (2/3) (because 65537 = 2 mod 3)
|
12240 |
|
|
; = -1
|
12241 |
|
|
;
|
12242 |
|
|
; (I referred to Pierre Samuel's "Algebraic Theory of Numbers".)
|
12243 |
|
|
;
|
12244 |
|
|
; ->
|
12245 |
|
|
|
12246 |
|
|
;; S-RND
|
12247 |
|
|
L25F8: CALL L2530 ; routine SYNTAX-Z
|
12248 |
|
|
JR Z,L2625 ; forward to S-RND-END if checking syntax.
|
12249 |
|
|
|
12250 |
|
|
LD BC,($5C76) ; fetch system variable SEED
|
12251 |
|
|
CALL L2D2B ; routine STACK-BC places on calculator stack
|
12252 |
|
|
|
12253 |
|
|
RST 28H ;; FP-CALC ;s.
|
12254 |
|
|
DEFB $A1 ;;stk-one ;s,1.
|
12255 |
|
|
DEFB $0F ;;addition ;s+1.
|
12256 |
|
|
DEFB $34 ;;stk-data ;
|
12257 |
|
|
DEFB $37 ;;Exponent: $87,
|
12258 |
|
|
;;Bytes: 1
|
12259 |
|
|
DEFB $16 ;;(+00,+00,+00) ;s+1,75.
|
12260 |
|
|
DEFB $04 ;;multiply ;(s+1)*75 = v
|
12261 |
|
|
DEFB $34 ;;stk-data ;v.
|
12262 |
|
|
DEFB $80 ;;Bytes: 3
|
12263 |
|
|
DEFB $41 ;;Exponent $91
|
12264 |
|
|
DEFB $00,$00,$80 ;;(+00) ;v,65537.
|
12265 |
|
|
DEFB $32 ;;n-mod-m ;remainder, result.
|
12266 |
|
|
DEFB $02 ;;delete ;remainder.
|
12267 |
|
|
DEFB $A1 ;;stk-one ;remainder, 1.
|
12268 |
|
|
DEFB $03 ;;subtract ;remainder - 1. = rnd
|
12269 |
|
|
DEFB $31 ;;duplicate ;rnd,rnd.
|
12270 |
|
|
DEFB $38 ;;end-calc
|
12271 |
|
|
|
12272 |
|
|
CALL L2DA2 ; routine FP-TO-BC
|
12273 |
|
|
LD ($5C76),BC ; store in SEED for next starting point.
|
12274 |
|
|
LD A,(HL) ; fetch exponent
|
12275 |
|
|
AND A ; is it zero ?
|
12276 |
|
|
JR Z,L2625 ; forward if so to S-RND-END
|
12277 |
|
|
|
12278 |
|
|
SUB $10 ; reduce exponent by 2^16
|
12279 |
|
|
LD (HL),A ; place back
|
12280 |
|
|
|
12281 |
|
|
;; S-RND-END
|
12282 |
|
|
L2625: JR L2630 ; forward to S-PI-END
|
12283 |
|
|
|
12284 |
|
|
; ---
|
12285 |
|
|
|
12286 |
|
|
; the number PI 3.14159...
|
12287 |
|
|
|
12288 |
|
|
; ->
|
12289 |
|
|
;; S-PI
|
12290 |
|
|
L2627: CALL L2530 ; routine SYNTAX-Z
|
12291 |
|
|
JR Z,L2630 ; to S-PI-END if checking syntax.
|
12292 |
|
|
|
12293 |
|
|
RST 28H ;; FP-CALC
|
12294 |
|
|
DEFB $A3 ;;stk-pi/2 pi/2.
|
12295 |
|
|
DEFB $38 ;;end-calc
|
12296 |
|
|
|
12297 |
|
|
INC (HL) ; increment the exponent leaving pi
|
12298 |
|
|
; on the calculator stack.
|
12299 |
|
|
|
12300 |
|
|
;; S-PI-END
|
12301 |
|
|
L2630: RST 20H ; NEXT-CHAR
|
12302 |
|
|
JP L26C3 ; jump forward to S-NUMERIC
|
12303 |
|
|
|
12304 |
|
|
; ---
|
12305 |
|
|
|
12306 |
|
|
; ->
|
12307 |
|
|
;; S-INKEY$
|
12308 |
|
|
L2634: LD BC,$105A ; priority $10, operation code $1A ('read-in')
|
12309 |
|
|
; +$40 for string result, numeric operand.
|
12310 |
|
|
; set this up now in case we need to use the
|
12311 |
|
|
; calculator.
|
12312 |
|
|
RST 20H ; NEXT-CHAR
|
12313 |
|
|
CP $23 ; '#' ?
|
12314 |
|
|
JP Z,L270D ; to S-PUSH-PO if so to use the calculator
|
12315 |
|
|
; single operation
|
12316 |
|
|
; to read from network/RS232 etc. .
|
12317 |
|
|
|
12318 |
|
|
; else read a key from the keyboard.
|
12319 |
|
|
|
12320 |
|
|
LD HL,$5C3B ; fetch FLAGS
|
12321 |
|
|
RES 6,(HL) ; signal string result.
|
12322 |
|
|
BIT 7,(HL) ; checking syntax ?
|
12323 |
|
|
JR Z,L2665 ; forward to S-INK$-EN if so
|
12324 |
|
|
|
12325 |
|
|
CALL L028E ; routine KEY-SCAN key in E, shift in D.
|
12326 |
|
|
LD C,$00 ; the length of an empty string
|
12327 |
|
|
JR NZ,L2660 ; to S-IK$-STK to store empty string if
|
12328 |
|
|
; no key returned.
|
12329 |
|
|
|
12330 |
|
|
CALL L031E ; routine K-TEST get main code in A
|
12331 |
|
|
JR NC,L2660 ; to S-IK$-STK to stack null string if
|
12332 |
|
|
; invalid
|
12333 |
|
|
|
12334 |
|
|
DEC D ; D is expected to be FLAGS so set bit 3 $FF
|
12335 |
|
|
; 'L' Mode so no keywords.
|
12336 |
|
|
LD E,A ; main key to A
|
12337 |
|
|
; C is MODE 0 'KLC' from above still.
|
12338 |
|
|
CALL L0333 ; routine K-DECODE
|
12339 |
|
|
PUSH AF ; save the code
|
12340 |
|
|
LD BC,$0001 ; make room for one character
|
12341 |
|
|
|
12342 |
|
|
RST 30H ; BC-SPACES
|
12343 |
|
|
POP AF ; bring the code back
|
12344 |
|
|
LD (DE),A ; put the key in workspace
|
12345 |
|
|
LD C,$01 ; set C length to one
|
12346 |
|
|
|
12347 |
|
|
;; S-IK$-STK
|
12348 |
|
|
L2660: LD B,$00 ; set high byte of length to zero
|
12349 |
|
|
CALL L2AB2 ; routine STK-STO-$
|
12350 |
|
|
|
12351 |
|
|
;; S-INK$-EN
|
12352 |
|
|
L2665: JP L2712 ; to S-CONT-2 ===>
|
12353 |
|
|
|
12354 |
|
|
; ---
|
12355 |
|
|
|
12356 |
|
|
; ->
|
12357 |
|
|
;; S-SCREEN$
|
12358 |
|
|
L2668: CALL L2522 ; routine S-2-COORD
|
12359 |
|
|
CALL NZ,L2535 ; routine S-SCRN$-S
|
12360 |
|
|
|
12361 |
|
|
RST 20H ; NEXT-CHAR
|
12362 |
|
|
JP L25DB ; forward to S-STRING to stack result
|
12363 |
|
|
|
12364 |
|
|
; ---
|
12365 |
|
|
|
12366 |
|
|
; ->
|
12367 |
|
|
;; S-ATTR
|
12368 |
|
|
L2672: CALL L2522 ; routine S-2-COORD
|
12369 |
|
|
CALL NZ,L2580 ; routine S-ATTR-S
|
12370 |
|
|
|
12371 |
|
|
RST 20H ; NEXT-CHAR
|
12372 |
|
|
JR L26C3 ; forward to S-NUMERIC
|
12373 |
|
|
|
12374 |
|
|
; ---
|
12375 |
|
|
|
12376 |
|
|
; ->
|
12377 |
|
|
;; S-POINT
|
12378 |
|
|
L267B: CALL L2522 ; routine S-2-COORD
|
12379 |
|
|
CALL NZ,L22CB ; routine POINT-SUB
|
12380 |
|
|
|
12381 |
|
|
RST 20H ; NEXT-CHAR
|
12382 |
|
|
JR L26C3 ; forward to S-NUMERIC
|
12383 |
|
|
|
12384 |
|
|
; -----------------------------
|
12385 |
|
|
|
12386 |
|
|
; ==> The branch was here if not in table.
|
12387 |
|
|
|
12388 |
|
|
;; S-ALPHNUM
|
12389 |
|
|
L2684: CALL L2C88 ; routine ALPHANUM checks if variable or
|
12390 |
|
|
; a digit.
|
12391 |
|
|
JR NC,L26DF ; forward to S-NEGATE if not to consider
|
12392 |
|
|
; a '-' character then functions.
|
12393 |
|
|
|
12394 |
|
|
CP $41 ; compare 'A'
|
12395 |
|
|
JR NC,L26C9 ; forward to S-LETTER if alpha ->
|
12396 |
|
|
; else must have been numeric so continue
|
12397 |
|
|
; into that routine.
|
12398 |
|
|
|
12399 |
|
|
; This important routine is called during runtime and from LINE-SCAN
|
12400 |
|
|
; when a BASIC line is checked for syntax. It is this routine that
|
12401 |
|
|
; inserts, during syntax checking, the invisible floating point numbers
|
12402 |
|
|
; after the numeric expression. During runtime it just picks these
|
12403 |
|
|
; numbers up. It also handles BIN format numbers.
|
12404 |
|
|
|
12405 |
|
|
; ->
|
12406 |
|
|
;; S-BIN
|
12407 |
|
|
;; S-DECIMAL
|
12408 |
|
|
L268D: CALL L2530 ; routine SYNTAX-Z
|
12409 |
|
|
JR NZ,L26B5 ; to S-STK-DEC in runtime
|
12410 |
|
|
|
12411 |
|
|
; this route is taken when checking syntax.
|
12412 |
|
|
|
12413 |
|
|
CALL L2C9B ; routine DEC-TO-FP to evaluate number
|
12414 |
|
|
|
12415 |
|
|
RST 18H ; GET-CHAR to fetch HL
|
12416 |
|
|
LD BC,$0006 ; six locations required
|
12417 |
|
|
CALL L1655 ; routine MAKE-ROOM
|
12418 |
|
|
INC HL ; to first new location
|
12419 |
|
|
LD (HL),$0E ; insert number marker
|
12420 |
|
|
INC HL ; address next
|
12421 |
|
|
EX DE,HL ; make DE destination.
|
12422 |
|
|
LD HL,($5C65) ; STKEND points to end of stack.
|
12423 |
|
|
LD C,$05 ; result is five locations lower
|
12424 |
|
|
AND A ; prepare for true subtraction
|
12425 |
|
|
SBC HL,BC ; point to start of value.
|
12426 |
|
|
LD ($5C65),HL ; update STKEND as we are taking number.
|
12427 |
|
|
LDIR ; Copy five bytes to program location
|
12428 |
|
|
EX DE,HL ; transfer pointer to HL
|
12429 |
|
|
DEC HL ; adjust
|
12430 |
|
|
CALL L0077 ; routine TEMP-PTR1 sets CH-ADD
|
12431 |
|
|
JR L26C3 ; to S-NUMERIC to record nature of result
|
12432 |
|
|
|
12433 |
|
|
; ---
|
12434 |
|
|
|
12435 |
|
|
; branch here in runtime.
|
12436 |
|
|
|
12437 |
|
|
;; S-STK-DEC
|
12438 |
|
|
L26B5: RST 18H ; GET-CHAR positions HL at digit.
|
12439 |
|
|
|
12440 |
|
|
;; S-SD-SKIP
|
12441 |
|
|
L26B6: INC HL ; advance pointer
|
12442 |
|
|
LD A,(HL) ; until we find
|
12443 |
|
|
CP $0E ; chr 14d - the number indicator
|
12444 |
|
|
JR NZ,L26B6 ; to S-SD-SKIP until a match
|
12445 |
|
|
; it has to be here.
|
12446 |
|
|
|
12447 |
|
|
INC HL ; point to first byte of number
|
12448 |
|
|
CALL L33B4 ; routine STACK-NUM stacks it
|
12449 |
|
|
LD ($5C5D),HL ; update system variable CH_ADD
|
12450 |
|
|
|
12451 |
|
|
;; S-NUMERIC
|
12452 |
|
|
L26C3: SET 6,(IY+$01) ; update FLAGS - Signal numeric result
|
12453 |
|
|
JR L26DD ; forward to S-CONT-1 ===>
|
12454 |
|
|
; actually S-CONT-2 is destination but why
|
12455 |
|
|
; waste a byte on a jump when a JR will do.
|
12456 |
|
|
; Actually a JR L2712 can be used. Rats.
|
12457 |
|
|
|
12458 |
|
|
; end of functions accessed from scanning functions table.
|
12459 |
|
|
|
12460 |
|
|
; --------------------------
|
12461 |
|
|
; Scanning variable routines
|
12462 |
|
|
; --------------------------
|
12463 |
|
|
;
|
12464 |
|
|
;
|
12465 |
|
|
|
12466 |
|
|
;; S-LETTER
|
12467 |
|
|
L26C9: CALL L28B2 ; routine LOOK-VARS
|
12468 |
|
|
|
12469 |
|
|
JP C,L1C2E ; jump back to REPORT-2 if variable not found
|
12470 |
|
|
; 'Variable not found'
|
12471 |
|
|
; but a variable is always 'found' if syntax
|
12472 |
|
|
; is being checked.
|
12473 |
|
|
|
12474 |
|
|
CALL Z,L2996 ; routine STK-VAR considers a subscript/slice
|
12475 |
|
|
LD A,($5C3B) ; fetch FLAGS value
|
12476 |
|
|
CP $C0 ; compare 11000000
|
12477 |
|
|
JR C,L26DD ; step forward to S-CONT-1 if string ===>
|
12478 |
|
|
|
12479 |
|
|
INC HL ; advance pointer
|
12480 |
|
|
CALL L33B4 ; routine STACK-NUM
|
12481 |
|
|
|
12482 |
|
|
;; S-CONT-1
|
12483 |
|
|
L26DD: JR L2712 ; forward to S-CONT-2 ===>
|
12484 |
|
|
|
12485 |
|
|
; ----------------------------------------
|
12486 |
|
|
; -> the scanning branch was here if not alphanumeric.
|
12487 |
|
|
; All the remaining functions will be evaluated by a single call to the
|
12488 |
|
|
; calculator. The correct priority for the operation has to be placed in
|
12489 |
|
|
; the B register and the operation code, calculator literal in the C register.
|
12490 |
|
|
; the operation code has bit 7 set if result is numeric and bit 6 is
|
12491 |
|
|
; set if operand is numeric. so
|
12492 |
|
|
; $C0 = numeric result, numeric operand. e.g. 'sin'
|
12493 |
|
|
; $80 = numeric result, string operand. e.g. 'code'
|
12494 |
|
|
; $40 = string result, numeric operand. e.g. 'str$'
|
12495 |
|
|
; $00 = string result, string operand. e.g. 'val$'
|
12496 |
|
|
|
12497 |
|
|
;; S-NEGATE
|
12498 |
|
|
L26DF: LD BC,$09DB ; prepare priority 09, operation code $C0 +
|
12499 |
|
|
; 'negate' ($1B) - bits 6 and 7 set for numeric
|
12500 |
|
|
; result and numeric operand.
|
12501 |
|
|
|
12502 |
|
|
CP $2D ; is it '-' ?
|
12503 |
|
|
JR Z,L270D ; forward if so to S-PUSH-PO
|
12504 |
|
|
|
12505 |
|
|
LD BC,$1018 ; prepare priority $10, operation code 'val$' -
|
12506 |
|
|
; bits 6 and 7 reset for string result and
|
12507 |
|
|
; string operand.
|
12508 |
|
|
|
12509 |
|
|
CP $AE ; is it 'VAL$' ?
|
12510 |
|
|
JR Z,L270D ; forward if so to S-PUSH-PO
|
12511 |
|
|
|
12512 |
|
|
SUB $AF ; subtract token 'CODE' value to reduce
|
12513 |
|
|
; functions 'CODE' to 'NOT' although the
|
12514 |
|
|
; upper range is, as yet, unchecked.
|
12515 |
|
|
; valid range would be $00 - $14.
|
12516 |
|
|
|
12517 |
|
|
JP C,L1C8A ; jump back to REPORT-C with anything else
|
12518 |
|
|
; 'Nonsense in BASIC'
|
12519 |
|
|
|
12520 |
|
|
LD BC,$04F0 ; prepare priority $04, operation $C0 +
|
12521 |
|
|
; 'not' ($30)
|
12522 |
|
|
|
12523 |
|
|
CP $14 ; is it 'NOT'
|
12524 |
|
|
JR Z,L270D ; forward to S-PUSH-PO if so
|
12525 |
|
|
|
12526 |
|
|
JP NC,L1C8A ; to REPORT-C if higher
|
12527 |
|
|
; 'Nonsense in BASIC'
|
12528 |
|
|
|
12529 |
|
|
LD B,$10 ; priority $10 for all the rest
|
12530 |
|
|
ADD A,$DC ; make range $DC - $EF
|
12531 |
|
|
; $C0 + 'code'($1C) thru 'chr$' ($2F)
|
12532 |
|
|
|
12533 |
|
|
LD C,A ; transfer 'function' to C
|
12534 |
|
|
CP $DF ; is it 'sin' ?
|
12535 |
|
|
JR NC,L2707 ; forward to S-NO-TO-$ with 'sin' through
|
12536 |
|
|
; 'chr$' as operand is numeric.
|
12537 |
|
|
|
12538 |
|
|
; all the rest 'cos' through 'chr$' give a numeric result except 'str$'
|
12539 |
|
|
; and 'chr$'.
|
12540 |
|
|
|
12541 |
|
|
RES 6,C ; signal string operand for 'code', 'val' and
|
12542 |
|
|
; 'len'.
|
12543 |
|
|
|
12544 |
|
|
;; S-NO-TO-$
|
12545 |
|
|
L2707: CP $EE ; compare 'str$'
|
12546 |
|
|
JR C,L270D ; forward to S-PUSH-PO if lower as result
|
12547 |
|
|
; is numeric.
|
12548 |
|
|
|
12549 |
|
|
RES 7,C ; reset bit 7 of op code for 'str$', 'chr$'
|
12550 |
|
|
; as result is string.
|
12551 |
|
|
|
12552 |
|
|
; >> This is where they were all headed for.
|
12553 |
|
|
|
12554 |
|
|
;; S-PUSH-PO
|
12555 |
|
|
L270D: PUSH BC ; push the priority and calculator operation
|
12556 |
|
|
; code.
|
12557 |
|
|
|
12558 |
|
|
RST 20H ; NEXT-CHAR
|
12559 |
|
|
JP L24FF ; jump back to S-LOOP-1 to go round the loop
|
12560 |
|
|
; again with the next character.
|
12561 |
|
|
|
12562 |
|
|
; --------------------------------
|
12563 |
|
|
|
12564 |
|
|
; ===> there were many branches forward to here
|
12565 |
|
|
|
12566 |
|
|
; An important step after the evaluation of an expression is to test for
|
12567 |
|
|
; a string expression and allow it to be sliced. If a numeric expression is
|
12568 |
|
|
; followed by a '(' then the numeric expression is complete.
|
12569 |
|
|
; Since a string slice can itself be sliced then loop repeatedly
|
12570 |
|
|
; e.g. (STR$ PI) (3 TO) (TO 2) or "nonsense" (4 TO )
|
12571 |
|
|
|
12572 |
|
|
;; S-CONT-2
|
12573 |
|
|
L2712: RST 18H ; GET-CHAR
|
12574 |
|
|
|
12575 |
|
|
;; S-CONT-3
|
12576 |
|
|
L2713: CP $28 ; is it '(' ?
|
12577 |
|
|
JR NZ,L2723 ; forward, if not, to S-OPERTR
|
12578 |
|
|
|
12579 |
|
|
BIT 6,(IY+$01) ; test FLAGS - numeric or string result ?
|
12580 |
|
|
JR NZ,L2734 ; forward, if numeric, to S-LOOP
|
12581 |
|
|
|
12582 |
|
|
; if a string expression preceded the '(' then slice it.
|
12583 |
|
|
|
12584 |
|
|
CALL L2A52 ; routine SLICING
|
12585 |
|
|
|
12586 |
|
|
RST 20H ; NEXT-CHAR
|
12587 |
|
|
JR L2713 ; loop back to S-CONT-3
|
12588 |
|
|
|
12589 |
|
|
; ---------------------------
|
12590 |
|
|
|
12591 |
|
|
; the branch was here when possibility of a '(' has been excluded.
|
12592 |
|
|
|
12593 |
|
|
;; S-OPERTR
|
12594 |
|
|
L2723: LD B,$00 ; prepare to add
|
12595 |
|
|
LD C,A ; possible operator to C
|
12596 |
|
|
LD HL,L2795 ; Address: $2795 - tbl-of-ops
|
12597 |
|
|
CALL L16DC ; routine INDEXER
|
12598 |
|
|
JR NC,L2734 ; forward to S-LOOP if not in table
|
12599 |
|
|
|
12600 |
|
|
; but if found in table the priority has to be looked up.
|
12601 |
|
|
|
12602 |
|
|
LD C,(HL) ; operation code to C ( B is still zero )
|
12603 |
|
|
LD HL,L27B0 - $C3 ; $26ED is base of table
|
12604 |
|
|
ADD HL,BC ; index into table.
|
12605 |
|
|
LD B,(HL) ; priority to B.
|
12606 |
|
|
|
12607 |
|
|
; ------------------
|
12608 |
|
|
; Scanning main loop
|
12609 |
|
|
; ------------------
|
12610 |
|
|
; the juggling act
|
12611 |
|
|
|
12612 |
|
|
;; S-LOOP
|
12613 |
|
|
L2734: POP DE ; fetch last priority and operation
|
12614 |
|
|
LD A,D ; priority to A
|
12615 |
|
|
CP B ; compare with this one
|
12616 |
|
|
JR C,L2773 ; forward to S-TIGHTER to execute the
|
12617 |
|
|
; last operation before this one as it has
|
12618 |
|
|
; higher priority.
|
12619 |
|
|
|
12620 |
|
|
; the last priority was greater or equal this one.
|
12621 |
|
|
|
12622 |
|
|
AND A ; if it is zero then so is this
|
12623 |
|
|
JP Z,L0018 ; jump to exit via get-char pointing at
|
12624 |
|
|
; next character.
|
12625 |
|
|
; This may be the character after the
|
12626 |
|
|
; expression or, if exiting a recursive call,
|
12627 |
|
|
; the next part of the expression to be
|
12628 |
|
|
; evaluated.
|
12629 |
|
|
|
12630 |
|
|
PUSH BC ; save current priority/operation
|
12631 |
|
|
; as it has lower precedence than the one
|
12632 |
|
|
; now in DE.
|
12633 |
|
|
|
12634 |
|
|
; the 'USR' function is special in that it is overloaded to give two types
|
12635 |
|
|
; of result.
|
12636 |
|
|
|
12637 |
|
|
LD HL,$5C3B ; address FLAGS
|
12638 |
|
|
LD A,E ; new operation to A register
|
12639 |
|
|
CP $ED ; is it $C0 + 'usr-no' ($2D) ?
|
12640 |
|
|
JR NZ,L274C ; forward to S-STK-LST if not
|
12641 |
|
|
|
12642 |
|
|
BIT 6,(HL) ; string result expected ?
|
12643 |
|
|
; (from the lower priority operand we've
|
12644 |
|
|
; just pushed on stack )
|
12645 |
|
|
JR NZ,L274C ; forward to S-STK-LST if numeric
|
12646 |
|
|
; as operand bits match.
|
12647 |
|
|
|
12648 |
|
|
LD E,$99 ; reset bit 6 and substitute $19 'usr-$'
|
12649 |
|
|
; for string operand.
|
12650 |
|
|
|
12651 |
|
|
;; S-STK-LST
|
12652 |
|
|
L274C: PUSH DE ; now stack this priority/operation
|
12653 |
|
|
CALL L2530 ; routine SYNTAX-Z
|
12654 |
|
|
JR Z,L275B ; forward to S-SYNTEST if checking syntax.
|
12655 |
|
|
|
12656 |
|
|
LD A,E ; fetch the operation code
|
12657 |
|
|
AND $3F ; mask off the result/operand bits to leave
|
12658 |
|
|
; a calculator literal.
|
12659 |
|
|
LD B,A ; transfer to B register
|
12660 |
|
|
|
12661 |
|
|
; now use the calculator to perform the single operation - operand is on
|
12662 |
|
|
; the calculator stack.
|
12663 |
|
|
; Note. although the calculator is performing a single operation most
|
12664 |
|
|
; functions e.g. TAN are written using other functions and literals and
|
12665 |
|
|
; these in turn are written using further strings of calculator literals so
|
12666 |
|
|
; another level of magical recursion joins the juggling act for a while
|
12667 |
|
|
; as the calculator too is calling itself.
|
12668 |
|
|
|
12669 |
|
|
RST 28H ;; FP-CALC
|
12670 |
|
|
DEFB $3B ;;fp-calc-2
|
12671 |
|
|
L2758: DEFB $38 ;;end-calc
|
12672 |
|
|
|
12673 |
|
|
JR L2764 ; forward to S-RUNTEST
|
12674 |
|
|
|
12675 |
|
|
; ---
|
12676 |
|
|
|
12677 |
|
|
; the branch was here if checking syntax only.
|
12678 |
|
|
|
12679 |
|
|
;; S-SYNTEST
|
12680 |
|
|
L275B: LD A,E ; fetch the operation code to accumulator
|
12681 |
|
|
XOR (IY+$01) ; compare with bits of FLAGS
|
12682 |
|
|
AND $40 ; bit 6 will be zero now if operand
|
12683 |
|
|
; matched expected result.
|
12684 |
|
|
|
12685 |
|
|
;; S-RPORT-C2
|
12686 |
|
|
L2761: JP NZ,L1C8A ; to REPORT-C if mismatch
|
12687 |
|
|
; 'Nonsense in BASIC'
|
12688 |
|
|
; else continue to set flags for next
|
12689 |
|
|
|
12690 |
|
|
; the branch is to here in runtime after a successful operation.
|
12691 |
|
|
|
12692 |
|
|
;; S-RUNTEST
|
12693 |
|
|
L2764: POP DE ; fetch the last operation from stack
|
12694 |
|
|
LD HL,$5C3B ; address FLAGS
|
12695 |
|
|
SET 6,(HL) ; set default to numeric result in FLAGS
|
12696 |
|
|
BIT 7,E ; test the operational result
|
12697 |
|
|
JR NZ,L2770 ; forward to S-LOOPEND if numeric
|
12698 |
|
|
|
12699 |
|
|
RES 6,(HL) ; reset bit 6 of FLAGS to show string result.
|
12700 |
|
|
|
12701 |
|
|
;; S-LOOPEND
|
12702 |
|
|
L2770: POP BC ; fetch the previous priority/operation
|
12703 |
|
|
JR L2734 ; back to S-LOOP to perform these
|
12704 |
|
|
|
12705 |
|
|
; ---
|
12706 |
|
|
|
12707 |
|
|
; the branch was here when a stacked priority/operator had higher priority
|
12708 |
|
|
; than the current one.
|
12709 |
|
|
|
12710 |
|
|
;; S-TIGHTER
|
12711 |
|
|
L2773: PUSH DE ; save high priority op on stack again
|
12712 |
|
|
LD A,C ; fetch lower priority operation code
|
12713 |
|
|
BIT 6,(IY+$01) ; test FLAGS - Numeric or string result ?
|
12714 |
|
|
JR NZ,L2790 ; forward to S-NEXT if numeric result
|
12715 |
|
|
|
12716 |
|
|
; if this is lower priority yet has string then must be a comparison.
|
12717 |
|
|
; Since these can only be evaluated in context and were defaulted to
|
12718 |
|
|
; numeric in operator look up they must be changed to string equivalents.
|
12719 |
|
|
|
12720 |
|
|
AND $3F ; mask to give true calculator literal
|
12721 |
|
|
ADD A,$08 ; augment numeric literals to string
|
12722 |
|
|
; equivalents.
|
12723 |
|
|
; 'no-&-no' => 'str-&-no'
|
12724 |
|
|
; 'no-l-eql' => 'str-l-eql'
|
12725 |
|
|
; 'no-gr-eq' => 'str-gr-eq'
|
12726 |
|
|
; 'nos-neql' => 'strs-neql'
|
12727 |
|
|
; 'no-grtr' => 'str-grtr'
|
12728 |
|
|
; 'no-less' => 'str-less'
|
12729 |
|
|
; 'nos-eql' => 'strs-eql'
|
12730 |
|
|
; 'addition' => 'strs-add'
|
12731 |
|
|
LD C,A ; put modified comparison operator back
|
12732 |
|
|
CP $10 ; is it now 'str-&-no' ?
|
12733 |
|
|
JR NZ,L2788 ; forward to S-NOT-AND if not.
|
12734 |
|
|
|
12735 |
|
|
SET 6,C ; set numeric operand bit
|
12736 |
|
|
JR L2790 ; forward to S-NEXT
|
12737 |
|
|
|
12738 |
|
|
; ---
|
12739 |
|
|
|
12740 |
|
|
;; S-NOT-AND
|
12741 |
|
|
L2788: JR C,L2761 ; back to S-RPORT-C2 if less
|
12742 |
|
|
; 'Nonsense in BASIC'.
|
12743 |
|
|
; e.g. a$ * b$
|
12744 |
|
|
|
12745 |
|
|
CP $17 ; is it 'strs-add' ?
|
12746 |
|
|
JR Z,L2790 ; forward to S-NEXT if so
|
12747 |
|
|
; (bit 6 and 7 are reset)
|
12748 |
|
|
|
12749 |
|
|
SET 7,C ; set numeric (Boolean) result for all others
|
12750 |
|
|
|
12751 |
|
|
;; S-NEXT
|
12752 |
|
|
L2790: PUSH BC ; now save this priority/operation on stack
|
12753 |
|
|
|
12754 |
|
|
RST 20H ; NEXT-CHAR
|
12755 |
|
|
JP L24FF ; jump back to S-LOOP-1
|
12756 |
|
|
|
12757 |
|
|
; ------------------
|
12758 |
|
|
; Table of operators
|
12759 |
|
|
; ------------------
|
12760 |
|
|
; This table is used to look up the calculator literals associated with
|
12761 |
|
|
; the operator character. The thirteen calculator operations $03 - $0F
|
12762 |
|
|
; have bits 6 and 7 set to signify a numeric result.
|
12763 |
|
|
; Some of these codes and bits may be altered later if the context suggests
|
12764 |
|
|
; a string comparison or operation.
|
12765 |
|
|
; that is '+', '=', '>', '<', '<=', '>=' or '<>'.
|
12766 |
|
|
|
12767 |
|
|
;; tbl-of-ops
|
12768 |
|
|
L2795: DEFB '+', $CF ; $C0 + 'addition'
|
12769 |
|
|
DEFB '-', $C3 ; $C0 + 'subtract'
|
12770 |
|
|
DEFB '*', $C4 ; $C0 + 'multiply'
|
12771 |
|
|
DEFB '/', $C5 ; $C0 + 'division'
|
12772 |
|
|
DEFB '^', $C6 ; $C0 + 'to-power'
|
12773 |
|
|
DEFB '=', $CE ; $C0 + 'nos-eql'
|
12774 |
|
|
DEFB '>', $CC ; $C0 + 'no-grtr'
|
12775 |
|
|
DEFB '<', $CD ; $C0 + 'no-less'
|
12776 |
|
|
|
12777 |
|
|
DEFB $C7, $C9 ; '<=' $C0 + 'no-l-eql'
|
12778 |
|
|
DEFB $C8, $CA ; '>=' $C0 + 'no-gr-eql'
|
12779 |
|
|
DEFB $C9, $CB ; '<>' $C0 + 'nos-neql'
|
12780 |
|
|
DEFB $C5, $C7 ; 'OR' $C0 + 'or'
|
12781 |
|
|
DEFB $C6, $C8 ; 'AND' $C0 + 'no-&-no'
|
12782 |
|
|
|
12783 |
|
|
DEFB $00 ; zero end-marker.
|
12784 |
|
|
|
12785 |
|
|
|
12786 |
|
|
; -------------------
|
12787 |
|
|
; Table of priorities
|
12788 |
|
|
; -------------------
|
12789 |
|
|
; This table is indexed with the operation code obtained from the above
|
12790 |
|
|
; table $C3 - $CF to obtain the priority for the respective operation.
|
12791 |
|
|
|
12792 |
|
|
;; tbl-priors
|
12793 |
|
|
L27B0: DEFB $06 ; '-' opcode $C3
|
12794 |
|
|
DEFB $08 ; '*' opcode $C4
|
12795 |
|
|
DEFB $08 ; '/' opcode $C5
|
12796 |
|
|
DEFB $0A ; '^' opcode $C6
|
12797 |
|
|
DEFB $02 ; 'OR' opcode $C7
|
12798 |
|
|
DEFB $03 ; 'AND' opcode $C8
|
12799 |
|
|
DEFB $05 ; '<=' opcode $C9
|
12800 |
|
|
DEFB $05 ; '>=' opcode $CA
|
12801 |
|
|
DEFB $05 ; '<>' opcode $CB
|
12802 |
|
|
DEFB $05 ; '>' opcode $CC
|
12803 |
|
|
DEFB $05 ; '<' opcode $CD
|
12804 |
|
|
DEFB $05 ; '=' opcode $CE
|
12805 |
|
|
DEFB $06 ; '+' opcode $CF
|
12806 |
|
|
|
12807 |
|
|
; ----------------------
|
12808 |
|
|
; Scanning function (FN)
|
12809 |
|
|
; ----------------------
|
12810 |
|
|
; This routine deals with user-defined functions.
|
12811 |
|
|
; The definition can be anywhere in the program area but these are best
|
12812 |
|
|
; placed near the start of the program as we shall see.
|
12813 |
|
|
; The evaluation process is quite complex as the Spectrum has to parse two
|
12814 |
|
|
; statements at the same time. Syntax of both has been checked previously
|
12815 |
|
|
; and hidden locations have been created immediately after each argument
|
12816 |
|
|
; of the DEF FN statement. Each of the arguments of the FN function is
|
12817 |
|
|
; evaluated by SCANNING and placed in the hidden locations. Then the
|
12818 |
|
|
; expression to the right of the DEF FN '=' is evaluated by SCANNING and for
|
12819 |
|
|
; any variables encountered, a search is made in the DEF FN variable list
|
12820 |
|
|
; in the program area before searching in the normal variables area.
|
12821 |
|
|
;
|
12822 |
|
|
; Recursion is not allowed: i.e. the definition of a function should not use
|
12823 |
|
|
; the same function, either directly or indirectly ( through another function).
|
12824 |
|
|
; You'll normally get error 4, ('Out of memory'), although sometimes the system
|
12825 |
|
|
; will crash. - Vickers, Pitman 1984.
|
12826 |
|
|
;
|
12827 |
|
|
; As the definition is just an expression, there would seem to be no means
|
12828 |
|
|
; of breaking out of such recursion.
|
12829 |
|
|
; However, by the clever use of string expressions and VAL, such recursion is
|
12830 |
|
|
; possible.
|
12831 |
|
|
; e.g. DEF FN a(n) = VAL "n+FN a(n-1)+0" ((n<1) * 10 + 1 TO )
|
12832 |
|
|
; will evaluate the full 11-character expression for all values where n is
|
12833 |
|
|
; greater than zero but just the 11th character, "0", when n drops to zero
|
12834 |
|
|
; thereby ending the recursion producing the correct result.
|
12835 |
|
|
; Recursive string functions are possible using VAL$ instead of VAL and the
|
12836 |
|
|
; null string as the final addend.
|
12837 |
|
|
; - from a turn of the century newsgroup discussion initiated by Mike Wynne.
|
12838 |
|
|
|
12839 |
|
|
;; S-FN-SBRN
|
12840 |
|
|
L27BD: CALL L2530 ; routine SYNTAX-Z
|
12841 |
|
|
JR NZ,L27F7 ; forward to SF-RUN in runtime
|
12842 |
|
|
|
12843 |
|
|
|
12844 |
|
|
RST 20H ; NEXT-CHAR
|
12845 |
|
|
CALL L2C8D ; routine ALPHA check for letters A-Z a-z
|
12846 |
|
|
JP NC,L1C8A ; jump back to REPORT-C if not
|
12847 |
|
|
; 'Nonsense in BASIC'
|
12848 |
|
|
|
12849 |
|
|
|
12850 |
|
|
RST 20H ; NEXT-CHAR
|
12851 |
|
|
CP $24 ; is it '$' ?
|
12852 |
|
|
PUSH AF ; save character and flags
|
12853 |
|
|
JR NZ,L27D0 ; forward to SF-BRKT-1 with numeric function
|
12854 |
|
|
|
12855 |
|
|
|
12856 |
|
|
RST 20H ; NEXT-CHAR
|
12857 |
|
|
|
12858 |
|
|
;; SF-BRKT-1
|
12859 |
|
|
L27D0: CP $28 ; is '(' ?
|
12860 |
|
|
JR NZ,L27E6 ; forward to SF-RPRT-C if not
|
12861 |
|
|
; 'Nonsense in BASIC'
|
12862 |
|
|
|
12863 |
|
|
|
12864 |
|
|
RST 20H ; NEXT-CHAR
|
12865 |
|
|
CP $29 ; is it ')' ?
|
12866 |
|
|
JR Z,L27E9 ; forward to SF-FLAG-6 if no arguments.
|
12867 |
|
|
|
12868 |
|
|
;; SF-ARGMTS
|
12869 |
|
|
L27D9: CALL L24FB ; routine SCANNING checks each argument
|
12870 |
|
|
; which may be an expression.
|
12871 |
|
|
|
12872 |
|
|
RST 18H ; GET-CHAR
|
12873 |
|
|
CP $2C ; is it a ',' ?
|
12874 |
|
|
JR NZ,L27E4 ; forward if not to SF-BRKT-2 to test bracket
|
12875 |
|
|
|
12876 |
|
|
|
12877 |
|
|
RST 20H ; NEXT-CHAR if a comma was found
|
12878 |
|
|
JR L27D9 ; back to SF-ARGMTS to parse all arguments.
|
12879 |
|
|
|
12880 |
|
|
; ---
|
12881 |
|
|
|
12882 |
|
|
;; SF-BRKT-2
|
12883 |
|
|
L27E4: CP $29 ; is character the closing ')' ?
|
12884 |
|
|
|
12885 |
|
|
;; SF-RPRT-C
|
12886 |
|
|
L27E6: JP NZ,L1C8A ; jump to REPORT-C
|
12887 |
|
|
; 'Nonsense in BASIC'
|
12888 |
|
|
|
12889 |
|
|
; at this point any optional arguments have had their syntax checked.
|
12890 |
|
|
|
12891 |
|
|
;; SF-FLAG-6
|
12892 |
|
|
L27E9: RST 20H ; NEXT-CHAR
|
12893 |
|
|
LD HL,$5C3B ; address system variable FLAGS
|
12894 |
|
|
RES 6,(HL) ; signal string result
|
12895 |
|
|
POP AF ; restore test against '$'.
|
12896 |
|
|
JR Z,L27F4 ; forward to SF-SYN-EN if string function.
|
12897 |
|
|
|
12898 |
|
|
SET 6,(HL) ; signal numeric result
|
12899 |
|
|
|
12900 |
|
|
;; SF-SYN-EN
|
12901 |
|
|
L27F4: JP L2712 ; jump back to S-CONT-2 to continue scanning.
|
12902 |
|
|
|
12903 |
|
|
; ---
|
12904 |
|
|
|
12905 |
|
|
; the branch was here in runtime.
|
12906 |
|
|
|
12907 |
|
|
;; SF-RUN
|
12908 |
|
|
L27F7: RST 20H ; NEXT-CHAR fetches name
|
12909 |
|
|
AND $DF ; AND 11101111 - reset bit 5 - upper-case.
|
12910 |
|
|
LD B,A ; save in B
|
12911 |
|
|
|
12912 |
|
|
RST 20H ; NEXT-CHAR
|
12913 |
|
|
SUB $24 ; subtract '$'
|
12914 |
|
|
LD C,A ; save result in C
|
12915 |
|
|
JR NZ,L2802 ; forward if not '$' to SF-ARGMT1
|
12916 |
|
|
|
12917 |
|
|
RST 20H ; NEXT-CHAR advances to bracket
|
12918 |
|
|
|
12919 |
|
|
;; SF-ARGMT1
|
12920 |
|
|
L2802: RST 20H ; NEXT-CHAR advances to start of argument
|
12921 |
|
|
PUSH HL ; save address
|
12922 |
|
|
LD HL,($5C53) ; fetch start of program area from PROG
|
12923 |
|
|
DEC HL ; the search starting point is the previous
|
12924 |
|
|
; location.
|
12925 |
|
|
|
12926 |
|
|
;; SF-FND-DF
|
12927 |
|
|
L2808: LD DE,$00CE ; search is for token 'DEF FN' in E,
|
12928 |
|
|
; statement count in D.
|
12929 |
|
|
PUSH BC ; save C the string test, and B the letter.
|
12930 |
|
|
CALL L1D86 ; routine LOOK-PROG will search for token.
|
12931 |
|
|
POP BC ; restore BC.
|
12932 |
|
|
JR NC,L2814 ; forward to SF-CP-DEF if a match was found.
|
12933 |
|
|
|
12934 |
|
|
|
12935 |
|
|
;; REPORT-P
|
12936 |
|
|
L2812: RST 08H ; ERROR-1
|
12937 |
|
|
DEFB $18 ; Error Report: FN without DEF
|
12938 |
|
|
|
12939 |
|
|
;; SF-CP-DEF
|
12940 |
|
|
L2814: PUSH HL ; save address of DEF FN
|
12941 |
|
|
CALL L28AB ; routine FN-SKPOVR skips over white-space etc.
|
12942 |
|
|
; without disturbing CH-ADD.
|
12943 |
|
|
AND $DF ; make fetched character upper-case.
|
12944 |
|
|
CP B ; compare with FN name
|
12945 |
|
|
JR NZ,L2825 ; forward to SF-NOT-FD if no match.
|
12946 |
|
|
|
12947 |
|
|
; the letters match so test the type.
|
12948 |
|
|
|
12949 |
|
|
CALL L28AB ; routine FN-SKPOVR skips white-space
|
12950 |
|
|
SUB $24 ; subtract '$' from fetched character
|
12951 |
|
|
CP C ; compare with saved result of same operation
|
12952 |
|
|
; on FN name.
|
12953 |
|
|
JR Z,L2831 ; forward to SF-VALUES with a match.
|
12954 |
|
|
|
12955 |
|
|
; the letters matched but one was string and the other numeric.
|
12956 |
|
|
|
12957 |
|
|
;; SF-NOT-FD
|
12958 |
|
|
L2825: POP HL ; restore search point.
|
12959 |
|
|
DEC HL ; make location before
|
12960 |
|
|
LD DE,$0200 ; the search is to be for the end of the
|
12961 |
|
|
; current definition - 2 statements forward.
|
12962 |
|
|
PUSH BC ; save the letter/type
|
12963 |
|
|
CALL L198B ; routine EACH-STMT steps past rejected
|
12964 |
|
|
; definition.
|
12965 |
|
|
POP BC ; restore letter/type
|
12966 |
|
|
JR L2808 ; back to SF-FND-DF to continue search
|
12967 |
|
|
|
12968 |
|
|
; ---
|
12969 |
|
|
|
12970 |
|
|
; Success!
|
12971 |
|
|
; the branch was here with matching letter and numeric/string type.
|
12972 |
|
|
|
12973 |
|
|
;; SF-VALUES
|
12974 |
|
|
L2831: AND A ; test A ( will be zero if string '$' - '$' )
|
12975 |
|
|
|
12976 |
|
|
CALL Z,L28AB ; routine FN-SKPOVR advances HL past '$'.
|
12977 |
|
|
|
12978 |
|
|
POP DE ; discard pointer to 'DEF FN'.
|
12979 |
|
|
POP DE ; restore pointer to first FN argument.
|
12980 |
|
|
LD ($5C5D),DE ; save in CH_ADD
|
12981 |
|
|
|
12982 |
|
|
CALL L28AB ; routine FN-SKPOVR advances HL past '('
|
12983 |
|
|
PUSH HL ; save start address in DEF FN ***
|
12984 |
|
|
CP $29 ; is character a ')' ?
|
12985 |
|
|
JR Z,L2885 ; forward to SF-R-BR-2 if no arguments.
|
12986 |
|
|
|
12987 |
|
|
;; SF-ARG-LP
|
12988 |
|
|
L2843: INC HL ; point to next character.
|
12989 |
|
|
LD A,(HL) ; fetch it.
|
12990 |
|
|
CP $0E ; is it the number marker
|
12991 |
|
|
LD D,$40 ; signal numeric in D.
|
12992 |
|
|
JR Z,L2852 ; forward to SF-ARG-VL if numeric.
|
12993 |
|
|
|
12994 |
|
|
DEC HL ; back to letter
|
12995 |
|
|
CALL L28AB ; routine FN-SKPOVR skips any white-space
|
12996 |
|
|
INC HL ; advance past the expected '$' to
|
12997 |
|
|
; the 'hidden' marker.
|
12998 |
|
|
LD D,$00 ; signal string.
|
12999 |
|
|
|
13000 |
|
|
;; SF-ARG-VL
|
13001 |
|
|
L2852: INC HL ; now address first of 5-byte location.
|
13002 |
|
|
PUSH HL ; save address in DEF FN statement
|
13003 |
|
|
PUSH DE ; save D - result type
|
13004 |
|
|
|
13005 |
|
|
CALL L24FB ; routine SCANNING evaluates expression in
|
13006 |
|
|
; the FN statement setting FLAGS and leaving
|
13007 |
|
|
; result as last value on calculator stack.
|
13008 |
|
|
|
13009 |
|
|
POP AF ; restore saved result type to A
|
13010 |
|
|
|
13011 |
|
|
XOR (IY+$01) ; xor with FLAGS
|
13012 |
|
|
AND $40 ; and with 01000000 to test bit 6
|
13013 |
|
|
JR NZ,L288B ; forward to REPORT-Q if type mismatch.
|
13014 |
|
|
; 'Parameter error'
|
13015 |
|
|
|
13016 |
|
|
POP HL ; pop the start address in DEF FN statement
|
13017 |
|
|
EX DE,HL ; transfer to DE ?? pop straight into de ?
|
13018 |
|
|
|
13019 |
|
|
LD HL,($5C65) ; set HL to STKEND location after value
|
13020 |
|
|
LD BC,$0005 ; five bytes to move
|
13021 |
|
|
SBC HL,BC ; decrease HL by 5 to point to start.
|
13022 |
|
|
LD ($5C65),HL ; set STKEND 'removing' value from stack.
|
13023 |
|
|
|
13024 |
|
|
LDIR ; copy value into DEF FN statement
|
13025 |
|
|
EX DE,HL ; set HL to location after value in DEF FN
|
13026 |
|
|
DEC HL ; step back one
|
13027 |
|
|
CALL L28AB ; routine FN-SKPOVR gets next valid character
|
13028 |
|
|
CP $29 ; is it ')' end of arguments ?
|
13029 |
|
|
JR Z,L2885 ; forward to SF-R-BR-2 if so.
|
13030 |
|
|
|
13031 |
|
|
; a comma separator has been encountered in the DEF FN argument list.
|
13032 |
|
|
|
13033 |
|
|
PUSH HL ; save position in DEF FN statement
|
13034 |
|
|
|
13035 |
|
|
RST 18H ; GET-CHAR from FN statement
|
13036 |
|
|
CP $2C ; is it ',' ?
|
13037 |
|
|
JR NZ,L288B ; forward to REPORT-Q if not
|
13038 |
|
|
; 'Parameter error'
|
13039 |
|
|
|
13040 |
|
|
RST 20H ; NEXT-CHAR in FN statement advances to next
|
13041 |
|
|
; argument.
|
13042 |
|
|
|
13043 |
|
|
POP HL ; restore DEF FN pointer
|
13044 |
|
|
CALL L28AB ; routine FN-SKPOVR advances to corresponding
|
13045 |
|
|
; argument.
|
13046 |
|
|
|
13047 |
|
|
JR L2843 ; back to SF-ARG-LP looping until all
|
13048 |
|
|
; arguments are passed into the DEF FN
|
13049 |
|
|
; hidden locations.
|
13050 |
|
|
|
13051 |
|
|
; ---
|
13052 |
|
|
|
13053 |
|
|
; the branch was here when all arguments passed.
|
13054 |
|
|
|
13055 |
|
|
;; SF-R-BR-2
|
13056 |
|
|
L2885: PUSH HL ; save location of ')' in DEF FN
|
13057 |
|
|
|
13058 |
|
|
RST 18H ; GET-CHAR gets next character in FN
|
13059 |
|
|
CP $29 ; is it a ')' also ?
|
13060 |
|
|
JR Z,L288D ; forward to SF-VALUE if so.
|
13061 |
|
|
|
13062 |
|
|
|
13063 |
|
|
;; REPORT-Q
|
13064 |
|
|
L288B: RST 08H ; ERROR-1
|
13065 |
|
|
DEFB $19 ; Error Report: Parameter error
|
13066 |
|
|
|
13067 |
|
|
;; SF-VALUE
|
13068 |
|
|
L288D: POP DE ; location of ')' in DEF FN to DE.
|
13069 |
|
|
EX DE,HL ; now to HL, FN ')' pointer to DE.
|
13070 |
|
|
LD ($5C5D),HL ; initialize CH_ADD to this value.
|
13071 |
|
|
|
13072 |
|
|
; At this point the start of the DEF FN argument list is on the machine stack.
|
13073 |
|
|
; We also have to consider that this defined function may form part of the
|
13074 |
|
|
; definition of another defined function (though not itself).
|
13075 |
|
|
; As this defined function may be part of a hierarchy of defined functions
|
13076 |
|
|
; currently being evaluated by recursive calls to SCANNING, then we have to
|
13077 |
|
|
; preserve the original value of DEFADD and not assume that it is zero.
|
13078 |
|
|
|
13079 |
|
|
LD HL,($5C0B) ; get original DEFADD address
|
13080 |
|
|
EX (SP),HL ; swap with DEF FN address on stack ***
|
13081 |
|
|
LD ($5C0B),HL ; set DEFADD to point to this argument list
|
13082 |
|
|
; during scanning.
|
13083 |
|
|
|
13084 |
|
|
PUSH DE ; save FN ')' pointer.
|
13085 |
|
|
|
13086 |
|
|
RST 20H ; NEXT-CHAR advances past ')' in define
|
13087 |
|
|
|
13088 |
|
|
RST 20H ; NEXT-CHAR advances past '=' to expression
|
13089 |
|
|
|
13090 |
|
|
CALL L24FB ; routine SCANNING evaluates but searches
|
13091 |
|
|
; initially for variables at DEFADD
|
13092 |
|
|
|
13093 |
|
|
POP HL ; pop the FN ')' pointer
|
13094 |
|
|
LD ($5C5D),HL ; set CH_ADD to this
|
13095 |
|
|
POP HL ; pop the original DEFADD value
|
13096 |
|
|
LD ($5C0B),HL ; and re-insert into DEFADD system variable.
|
13097 |
|
|
|
13098 |
|
|
RST 20H ; NEXT-CHAR advances to character after ')'
|
13099 |
|
|
JP L2712 ; to S-CONT-2 - to continue current
|
13100 |
|
|
; invocation of scanning
|
13101 |
|
|
|
13102 |
|
|
; --------------------
|
13103 |
|
|
; Used to parse DEF FN
|
13104 |
|
|
; --------------------
|
13105 |
|
|
; e.g. DEF FN s $ ( x ) = b $ ( TO x ) : REM exaggerated
|
13106 |
|
|
;
|
13107 |
|
|
; This routine is used 10 times to advance along a DEF FN statement
|
13108 |
|
|
; skipping spaces and colour control codes. It is similar to NEXT-CHAR
|
13109 |
|
|
; which is, at the same time, used to skip along the corresponding FN function
|
13110 |
|
|
; except the latter has to deal with AT and TAB characters in string
|
13111 |
|
|
; expressions. These cannot occur in a program area so this routine is
|
13112 |
|
|
; simpler as both colour controls and their parameters are less than space.
|
13113 |
|
|
|
13114 |
|
|
;; FN-SKPOVR
|
13115 |
|
|
L28AB: INC HL ; increase pointer
|
13116 |
|
|
LD A,(HL) ; fetch addressed character
|
13117 |
|
|
CP $21 ; compare with space + 1
|
13118 |
|
|
JR C,L28AB ; back to FN-SKPOVR if less
|
13119 |
|
|
|
13120 |
|
|
RET ; return pointing to a valid character.
|
13121 |
|
|
|
13122 |
|
|
; ---------
|
13123 |
|
|
; LOOK-VARS
|
13124 |
|
|
; ---------
|
13125 |
|
|
;
|
13126 |
|
|
;
|
13127 |
|
|
|
13128 |
|
|
;; LOOK-VARS
|
13129 |
|
|
L28B2: SET 6,(IY+$01) ; update FLAGS - presume numeric result
|
13130 |
|
|
|
13131 |
|
|
RST 18H ; GET-CHAR
|
13132 |
|
|
CALL L2C8D ; routine ALPHA tests for A-Za-z
|
13133 |
|
|
JP NC,L1C8A ; jump to REPORT-C if not.
|
13134 |
|
|
; 'Nonsense in BASIC'
|
13135 |
|
|
|
13136 |
|
|
PUSH HL ; save pointer to first letter ^1
|
13137 |
|
|
AND $1F ; mask lower bits, 1 - 26 decimal 000xxxxx
|
13138 |
|
|
LD C,A ; store in C.
|
13139 |
|
|
|
13140 |
|
|
RST 20H ; NEXT-CHAR
|
13141 |
|
|
PUSH HL ; save pointer to second character ^2
|
13142 |
|
|
CP $28 ; is it '(' - an array ?
|
13143 |
|
|
JR Z,L28EF ; forward to V-RUN/SYN if so.
|
13144 |
|
|
|
13145 |
|
|
SET 6,C ; set 6 signaling string if solitary 010
|
13146 |
|
|
CP $24 ; is character a '$' ?
|
13147 |
|
|
JR Z,L28DE ; forward to V-STR-VAR
|
13148 |
|
|
|
13149 |
|
|
SET 5,C ; signal numeric 011
|
13150 |
|
|
CALL L2C88 ; routine ALPHANUM sets carry if second
|
13151 |
|
|
; character is alphanumeric.
|
13152 |
|
|
JR NC,L28E3 ; forward to V-TEST-FN if just one character
|
13153 |
|
|
|
13154 |
|
|
; It is more than one character but re-test current character so that 6 reset
|
13155 |
|
|
; This loop renders the similar loop at V-PASS redundant.
|
13156 |
|
|
|
13157 |
|
|
;; V-CHAR
|
13158 |
|
|
L28D4: CALL L2C88 ; routine ALPHANUM
|
13159 |
|
|
JR NC,L28EF ; to V-RUN/SYN when no more
|
13160 |
|
|
|
13161 |
|
|
RES 6,C ; make long named type 001
|
13162 |
|
|
|
13163 |
|
|
RST 20H ; NEXT-CHAR
|
13164 |
|
|
JR L28D4 ; loop back to V-CHAR
|
13165 |
|
|
|
13166 |
|
|
; ---
|
13167 |
|
|
|
13168 |
|
|
|
13169 |
|
|
;; V-STR-VAR
|
13170 |
|
|
L28DE: RST 20H ; NEXT-CHAR advances past '$'
|
13171 |
|
|
RES 6,(IY+$01) ; update FLAGS - signal string result.
|
13172 |
|
|
|
13173 |
|
|
;; V-TEST-FN
|
13174 |
|
|
L28E3: LD A,($5C0C) ; load A with DEFADD_hi
|
13175 |
|
|
AND A ; and test for zero.
|
13176 |
|
|
JR Z,L28EF ; forward to V-RUN/SYN if a defined function
|
13177 |
|
|
; is not being evaluated.
|
13178 |
|
|
|
13179 |
|
|
; Note.
|
13180 |
|
|
|
13181 |
|
|
CALL L2530 ; routine SYNTAX-Z
|
13182 |
|
|
JP NZ,L2951 ; JUMP to STK-F-ARG in runtime and then
|
13183 |
|
|
; back to this point if no variable found.
|
13184 |
|
|
|
13185 |
|
|
;; V-RUN/SYN
|
13186 |
|
|
L28EF: LD B,C ; save flags in B
|
13187 |
|
|
CALL L2530 ; routine SYNTAX-Z
|
13188 |
|
|
JR NZ,L28FD ; to V-RUN to look for the variable in runtime
|
13189 |
|
|
|
13190 |
|
|
; if checking syntax the letter is not returned
|
13191 |
|
|
|
13192 |
|
|
LD A,C ; copy letter/flags to A
|
13193 |
|
|
AND $E0 ; and with 11100000 to get rid of the letter
|
13194 |
|
|
SET 7,A ; use spare bit to signal checking syntax.
|
13195 |
|
|
LD C,A ; and transfer to C.
|
13196 |
|
|
JR L2934 ; forward to V-SYNTAX
|
13197 |
|
|
|
13198 |
|
|
; ---
|
13199 |
|
|
|
13200 |
|
|
; but in runtime search for the variable.
|
13201 |
|
|
|
13202 |
|
|
;; V-RUN
|
13203 |
|
|
L28FD: LD HL,($5C4B) ; set HL to start of variables from VARS
|
13204 |
|
|
|
13205 |
|
|
;; V-EACH
|
13206 |
|
|
L2900: LD A,(HL) ; get first character
|
13207 |
|
|
AND $7F ; and with 01111111
|
13208 |
|
|
; ignoring bit 7 which distinguishes
|
13209 |
|
|
; arrays or for/next variables.
|
13210 |
|
|
|
13211 |
|
|
JR Z,L2932 ; to V-80-BYTE if zero as must be 10000000
|
13212 |
|
|
; the variables end-marker.
|
13213 |
|
|
|
13214 |
|
|
CP C ; compare with supplied value.
|
13215 |
|
|
JR NZ,L292A ; forward to V-NEXT if no match.
|
13216 |
|
|
|
13217 |
|
|
RLA ; destructively test
|
13218 |
|
|
ADD A,A ; bits 5 and 6 of A
|
13219 |
|
|
; jumping if bit 5 reset or 6 set
|
13220 |
|
|
|
13221 |
|
|
JP P,L293F ; to V-FOUND-2 strings and arrays
|
13222 |
|
|
|
13223 |
|
|
JR C,L293F ; to V-FOUND-2 simple and for next
|
13224 |
|
|
|
13225 |
|
|
; leaving long name variables.
|
13226 |
|
|
|
13227 |
|
|
POP DE ; pop pointer to 2nd. char
|
13228 |
|
|
PUSH DE ; save it again
|
13229 |
|
|
PUSH HL ; save variable first character pointer
|
13230 |
|
|
|
13231 |
|
|
;; V-MATCHES
|
13232 |
|
|
L2912: INC HL ; address next character in vars area
|
13233 |
|
|
|
13234 |
|
|
;; V-SPACES
|
13235 |
|
|
L2913: LD A,(DE) ; pick up letter from prog area
|
13236 |
|
|
INC DE ; and advance address
|
13237 |
|
|
CP $20 ; is it a space
|
13238 |
|
|
JR Z,L2913 ; back to V-SPACES until non-space
|
13239 |
|
|
|
13240 |
|
|
OR $20 ; convert to range 1 - 26.
|
13241 |
|
|
CP (HL) ; compare with addressed variables character
|
13242 |
|
|
JR Z,L2912 ; loop back to V-MATCHES if a match on an
|
13243 |
|
|
; intermediate letter.
|
13244 |
|
|
|
13245 |
|
|
OR $80 ; now set bit 7 as last character of long
|
13246 |
|
|
; names are inverted.
|
13247 |
|
|
CP (HL) ; compare again
|
13248 |
|
|
JR NZ,L2929 ; forward to V-GET-PTR if no match
|
13249 |
|
|
|
13250 |
|
|
; but if they match check that this is also last letter in prog area
|
13251 |
|
|
|
13252 |
|
|
LD A,(DE) ; fetch next character
|
13253 |
|
|
CALL L2C88 ; routine ALPHANUM sets carry if not alphanum
|
13254 |
|
|
JR NC,L293E ; forward to V-FOUND-1 with a full match.
|
13255 |
|
|
|
13256 |
|
|
;; V-GET-PTR
|
13257 |
|
|
L2929: POP HL ; pop saved pointer to char 1
|
13258 |
|
|
|
13259 |
|
|
;; V-NEXT
|
13260 |
|
|
L292A: PUSH BC ; save flags
|
13261 |
|
|
CALL L19B8 ; routine NEXT-ONE gets next variable in DE
|
13262 |
|
|
EX DE,HL ; transfer to HL.
|
13263 |
|
|
POP BC ; restore the flags
|
13264 |
|
|
JR L2900 ; loop back to V-EACH
|
13265 |
|
|
; to compare each variable
|
13266 |
|
|
|
13267 |
|
|
; ---
|
13268 |
|
|
|
13269 |
|
|
;; V-80-BYTE
|
13270 |
|
|
L2932: SET 7,B ; will signal not found
|
13271 |
|
|
|
13272 |
|
|
; the branch was here when checking syntax
|
13273 |
|
|
|
13274 |
|
|
;; V-SYNTAX
|
13275 |
|
|
L2934: POP DE ; discard the pointer to 2nd. character v2
|
13276 |
|
|
; in BASIC line/workspace.
|
13277 |
|
|
|
13278 |
|
|
RST 18H ; GET-CHAR gets character after variable name.
|
13279 |
|
|
CP $28 ; is it '(' ?
|
13280 |
|
|
JR Z,L2943 ; forward to V-PASS
|
13281 |
|
|
; Note. could go straight to V-END ?
|
13282 |
|
|
|
13283 |
|
|
SET 5,B ; signal not an array
|
13284 |
|
|
JR L294B ; forward to V-END
|
13285 |
|
|
|
13286 |
|
|
; ---------------------------
|
13287 |
|
|
|
13288 |
|
|
; the jump was here when a long name matched and HL pointing to last character
|
13289 |
|
|
; in variables area.
|
13290 |
|
|
|
13291 |
|
|
;; V-FOUND-1
|
13292 |
|
|
L293E: POP DE ; discard pointer to first var letter
|
13293 |
|
|
|
13294 |
|
|
; the jump was here with all other matches HL points to first var char.
|
13295 |
|
|
|
13296 |
|
|
;; V-FOUND-2
|
13297 |
|
|
L293F: POP DE ; discard pointer to 2nd prog char v2
|
13298 |
|
|
POP DE ; drop pointer to 1st prog char v1
|
13299 |
|
|
PUSH HL ; save pointer to last char in vars
|
13300 |
|
|
|
13301 |
|
|
RST 18H ; GET-CHAR
|
13302 |
|
|
|
13303 |
|
|
;; V-PASS
|
13304 |
|
|
L2943: CALL L2C88 ; routine ALPHANUM
|
13305 |
|
|
JR NC,L294B ; forward to V-END if not
|
13306 |
|
|
|
13307 |
|
|
; but it never will be as we advanced past long-named variables earlier.
|
13308 |
|
|
|
13309 |
|
|
RST 20H ; NEXT-CHAR
|
13310 |
|
|
JR L2943 ; back to V-PASS
|
13311 |
|
|
|
13312 |
|
|
; ---
|
13313 |
|
|
|
13314 |
|
|
;; V-END
|
13315 |
|
|
L294B: POP HL ; pop the pointer to first character in
|
13316 |
|
|
; BASIC line/workspace.
|
13317 |
|
|
RL B ; rotate the B register left
|
13318 |
|
|
; bit 7 to carry
|
13319 |
|
|
BIT 6,B ; test the array indicator bit.
|
13320 |
|
|
RET ; return
|
13321 |
|
|
|
13322 |
|
|
; -----------------------
|
13323 |
|
|
; Stack function argument
|
13324 |
|
|
; -----------------------
|
13325 |
|
|
; This branch is taken from LOOK-VARS when a defined function is currently
|
13326 |
|
|
; being evaluated.
|
13327 |
|
|
; Scanning is evaluating the expression after the '=' and the variable
|
13328 |
|
|
; found could be in the argument list to the left of the '=' or in the
|
13329 |
|
|
; normal place after the program. Preference will be given to the former.
|
13330 |
|
|
; The variable name to be matched is in C.
|
13331 |
|
|
|
13332 |
|
|
;; STK-F-ARG
|
13333 |
|
|
L2951: LD HL,($5C0B) ; set HL to DEFADD
|
13334 |
|
|
LD A,(HL) ; load the first character
|
13335 |
|
|
CP $29 ; is it ')' ?
|
13336 |
|
|
JP Z,L28EF ; JUMP back to V-RUN/SYN, if so, as there are
|
13337 |
|
|
; no arguments.
|
13338 |
|
|
|
13339 |
|
|
; but proceed to search argument list of defined function first if not empty.
|
13340 |
|
|
|
13341 |
|
|
;; SFA-LOOP
|
13342 |
|
|
L295A: LD A,(HL) ; fetch character again.
|
13343 |
|
|
OR $60 ; or with 01100000 presume a simple variable.
|
13344 |
|
|
LD B,A ; save result in B.
|
13345 |
|
|
INC HL ; address next location.
|
13346 |
|
|
LD A,(HL) ; pick up byte.
|
13347 |
|
|
CP $0E ; is it the number marker ?
|
13348 |
|
|
JR Z,L296B ; forward to SFA-CP-VR if so.
|
13349 |
|
|
|
13350 |
|
|
; it was a string. White-space may be present but syntax has been checked.
|
13351 |
|
|
|
13352 |
|
|
DEC HL ; point back to letter.
|
13353 |
|
|
CALL L28AB ; routine FN-SKPOVR skips to the '$'
|
13354 |
|
|
INC HL ; now address the hidden marker.
|
13355 |
|
|
RES 5,B ; signal a string variable.
|
13356 |
|
|
|
13357 |
|
|
;; SFA-CP-VR
|
13358 |
|
|
L296B: LD A,B ; transfer found variable letter to A.
|
13359 |
|
|
CP C ; compare with expected.
|
13360 |
|
|
JR Z,L2981 ; forward to SFA-MATCH with a match.
|
13361 |
|
|
|
13362 |
|
|
INC HL ; step
|
13363 |
|
|
INC HL ; past
|
13364 |
|
|
INC HL ; the
|
13365 |
|
|
INC HL ; five
|
13366 |
|
|
INC HL ; bytes.
|
13367 |
|
|
|
13368 |
|
|
CALL L28AB ; routine FN-SKPOVR skips to next character
|
13369 |
|
|
CP $29 ; is it ')' ?
|
13370 |
|
|
JP Z,L28EF ; jump back if so to V-RUN/SYN to look in
|
13371 |
|
|
; normal variables area.
|
13372 |
|
|
|
13373 |
|
|
CALL L28AB ; routine FN-SKPOVR skips past the ','
|
13374 |
|
|
; all syntax has been checked and these
|
13375 |
|
|
; things can be taken as read.
|
13376 |
|
|
JR L295A ; back to SFA-LOOP while there are more
|
13377 |
|
|
; arguments.
|
13378 |
|
|
|
13379 |
|
|
; ---
|
13380 |
|
|
|
13381 |
|
|
;; SFA-MATCH
|
13382 |
|
|
L2981: BIT 5,C ; test if numeric
|
13383 |
|
|
JR NZ,L2991 ; to SFA-END if so as will be stacked
|
13384 |
|
|
; by scanning
|
13385 |
|
|
|
13386 |
|
|
INC HL ; point to start of string descriptor
|
13387 |
|
|
LD DE,($5C65) ; set DE to STKEND
|
13388 |
|
|
CALL L33C0 ; routine MOVE-FP puts parameters on stack.
|
13389 |
|
|
EX DE,HL ; new free location to HL.
|
13390 |
|
|
LD ($5C65),HL ; use it to set STKEND system variable.
|
13391 |
|
|
|
13392 |
|
|
;; SFA-END
|
13393 |
|
|
L2991: POP DE ; discard
|
13394 |
|
|
POP DE ; pointers.
|
13395 |
|
|
XOR A ; clear carry flag.
|
13396 |
|
|
INC A ; and zero flag.
|
13397 |
|
|
RET ; return.
|
13398 |
|
|
|
13399 |
|
|
; ------------------------
|
13400 |
|
|
; Stack variable component
|
13401 |
|
|
; ------------------------
|
13402 |
|
|
; This is called to evaluate a complex structure that has been found, in
|
13403 |
|
|
; runtime, by LOOK-VARS in the variables area.
|
13404 |
|
|
; In this case HL points to the initial letter, bits 7-5
|
13405 |
|
|
; of which indicate the type of variable.
|
13406 |
|
|
; 010 - simple string, 110 - string array, 100 - array of numbers.
|
13407 |
|
|
;
|
13408 |
|
|
; It is called from CLASS-01 when assigning to a string or array including
|
13409 |
|
|
; a slice.
|
13410 |
|
|
; It is called from SCANNING to isolate the required part of the structure.
|
13411 |
|
|
;
|
13412 |
|
|
; An important part of the runtime process is to check that the number of
|
13413 |
|
|
; dimensions of the variable match the number of subscripts supplied in the
|
13414 |
|
|
; BASIC line.
|
13415 |
|
|
;
|
13416 |
|
|
; If checking syntax,
|
13417 |
|
|
; the B register, which counts dimensions is set to zero (256) to allow
|
13418 |
|
|
; the loop to continue till all subscripts are checked. While doing this it
|
13419 |
|
|
; is reading dimension sizes from some arbitrary area of memory. Although
|
13420 |
|
|
; these are meaningless it is of no concern as the limit is never checked by
|
13421 |
|
|
; int-exp during syntax checking.
|
13422 |
|
|
;
|
13423 |
|
|
; The routine is also called from the syntax path of DIM command to check the
|
13424 |
|
|
; syntax of both string and numeric arrays definitions except that bit 6 of C
|
13425 |
|
|
; is reset so both are checked as numeric arrays. This ruse avoids a terminal
|
13426 |
|
|
; slice being accepted as part of the DIM command.
|
13427 |
|
|
; All that is being checked is that there are a valid set of comma-separated
|
13428 |
|
|
; expressions before a terminal ')', although, as above, it will still go
|
13429 |
|
|
; through the motions of checking dummy dimension sizes.
|
13430 |
|
|
|
13431 |
|
|
;; STK-VAR
|
13432 |
|
|
L2996: XOR A ; clear A
|
13433 |
|
|
LD B,A ; and B, the syntax dimension counter (256)
|
13434 |
|
|
BIT 7,C ; checking syntax ?
|
13435 |
|
|
JR NZ,L29E7 ; forward to SV-COUNT if so.
|
13436 |
|
|
|
13437 |
|
|
; runtime evaluation.
|
13438 |
|
|
|
13439 |
|
|
BIT 7,(HL) ; will be reset if a simple string.
|
13440 |
|
|
JR NZ,L29AE ; forward to SV-ARRAYS otherwise
|
13441 |
|
|
|
13442 |
|
|
INC A ; set A to 1, simple string.
|
13443 |
|
|
|
13444 |
|
|
;; SV-SIMPLE$
|
13445 |
|
|
L29A1: INC HL ; address length low
|
13446 |
|
|
LD C,(HL) ; place in C
|
13447 |
|
|
INC HL ; address length high
|
13448 |
|
|
LD B,(HL) ; place in B
|
13449 |
|
|
INC HL ; address start of string
|
13450 |
|
|
EX DE,HL ; DE = start now.
|
13451 |
|
|
CALL L2AB2 ; routine STK-STO-$ stacks string parameters
|
13452 |
|
|
; DE start in variables area,
|
13453 |
|
|
; BC length, A=1 simple string
|
13454 |
|
|
|
13455 |
|
|
; the only thing now is to consider if a slice is required.
|
13456 |
|
|
|
13457 |
|
|
RST 18H ; GET-CHAR puts character at CH_ADD in A
|
13458 |
|
|
JP L2A49 ; jump forward to SV-SLICE? to test for '('
|
13459 |
|
|
|
13460 |
|
|
; --------------------------------------------------------
|
13461 |
|
|
|
13462 |
|
|
; the branch was here with string and numeric arrays in runtime.
|
13463 |
|
|
|
13464 |
|
|
;; SV-ARRAYS
|
13465 |
|
|
L29AE: INC HL ; step past
|
13466 |
|
|
INC HL ; the total length
|
13467 |
|
|
INC HL ; to address Number of dimensions.
|
13468 |
|
|
LD B,(HL) ; transfer to B overwriting zero.
|
13469 |
|
|
BIT 6,C ; a numeric array ?
|
13470 |
|
|
JR Z,L29C0 ; forward to SV-PTR with numeric arrays
|
13471 |
|
|
|
13472 |
|
|
DEC B ; ignore the final element of a string array
|
13473 |
|
|
; the fixed string size.
|
13474 |
|
|
|
13475 |
|
|
JR Z,L29A1 ; back to SV-SIMPLE$ if result is zero as has
|
13476 |
|
|
; been created with DIM a$(10) for instance
|
13477 |
|
|
; and can be treated as a simple string.
|
13478 |
|
|
|
13479 |
|
|
; proceed with multi-dimensioned string arrays in runtime.
|
13480 |
|
|
|
13481 |
|
|
EX DE,HL ; save pointer to dimensions in DE
|
13482 |
|
|
|
13483 |
|
|
RST 18H ; GET-CHAR looks at the BASIC line
|
13484 |
|
|
CP $28 ; is character '(' ?
|
13485 |
|
|
JR NZ,L2A20 ; to REPORT-3 if not
|
13486 |
|
|
; 'Subscript wrong'
|
13487 |
|
|
|
13488 |
|
|
EX DE,HL ; dimensions pointer to HL to synchronize
|
13489 |
|
|
; with next instruction.
|
13490 |
|
|
|
13491 |
|
|
; runtime numeric arrays path rejoins here.
|
13492 |
|
|
|
13493 |
|
|
;; SV-PTR
|
13494 |
|
|
L29C0: EX DE,HL ; save dimension pointer in DE
|
13495 |
|
|
JR L29E7 ; forward to SV-COUNT with true no of dims
|
13496 |
|
|
; in B. As there is no initial comma the
|
13497 |
|
|
; loop is entered at the midpoint.
|
13498 |
|
|
|
13499 |
|
|
; ----------------------------------------------------------
|
13500 |
|
|
; the dimension counting loop which is entered at mid-point.
|
13501 |
|
|
|
13502 |
|
|
;; SV-COMMA
|
13503 |
|
|
L29C3: PUSH HL ; save counter
|
13504 |
|
|
|
13505 |
|
|
RST 18H ; GET-CHAR
|
13506 |
|
|
|
13507 |
|
|
POP HL ; pop counter
|
13508 |
|
|
CP $2C ; is character ',' ?
|
13509 |
|
|
JR Z,L29EA ; forward to SV-LOOP if so
|
13510 |
|
|
|
13511 |
|
|
; in runtime the variable definition indicates a comma should appear here
|
13512 |
|
|
|
13513 |
|
|
BIT 7,C ; checking syntax ?
|
13514 |
|
|
JR Z,L2A20 ; forward to REPORT-3 if not
|
13515 |
|
|
; 'Subscript error'
|
13516 |
|
|
|
13517 |
|
|
; proceed if checking syntax of an array?
|
13518 |
|
|
|
13519 |
|
|
BIT 6,C ; array of strings
|
13520 |
|
|
JR NZ,L29D8 ; forward to SV-CLOSE if so
|
13521 |
|
|
|
13522 |
|
|
; an array of numbers.
|
13523 |
|
|
|
13524 |
|
|
CP $29 ; is character ')' ?
|
13525 |
|
|
JR NZ,L2A12 ; forward to SV-RPT-C if not
|
13526 |
|
|
; 'Nonsense in BASIC'
|
13527 |
|
|
|
13528 |
|
|
RST 20H ; NEXT-CHAR moves CH-ADD past the statement
|
13529 |
|
|
RET ; return ->
|
13530 |
|
|
|
13531 |
|
|
; ---
|
13532 |
|
|
|
13533 |
|
|
; the branch was here with an array of strings.
|
13534 |
|
|
|
13535 |
|
|
;; SV-CLOSE
|
13536 |
|
|
L29D8: CP $29 ; as above ')' could follow the expression
|
13537 |
|
|
JR Z,L2A48 ; forward to SV-DIM if so
|
13538 |
|
|
|
13539 |
|
|
CP $CC ; is it 'TO' ?
|
13540 |
|
|
JR NZ,L2A12 ; to SV-RPT-C with anything else
|
13541 |
|
|
; 'Nonsense in BASIC'
|
13542 |
|
|
|
13543 |
|
|
; now backtrack CH_ADD to set up for slicing routine.
|
13544 |
|
|
; Note. in a BASIC line we can safely backtrack to a colour parameter.
|
13545 |
|
|
|
13546 |
|
|
;; SV-CH-ADD
|
13547 |
|
|
L29E0: RST 18H ; GET-CHAR
|
13548 |
|
|
DEC HL ; backtrack HL
|
13549 |
|
|
LD ($5C5D),HL ; to set CH_ADD up for slicing routine
|
13550 |
|
|
JR L2A45 ; forward to SV-SLICE and make a return
|
13551 |
|
|
; when all slicing complete.
|
13552 |
|
|
|
13553 |
|
|
; ----------------------------------------
|
13554 |
|
|
; -> the mid-point entry point of the loop
|
13555 |
|
|
|
13556 |
|
|
;; SV-COUNT
|
13557 |
|
|
L29E7: LD HL,$0000 ; initialize data pointer to zero.
|
13558 |
|
|
|
13559 |
|
|
;; SV-LOOP
|
13560 |
|
|
L29EA: PUSH HL ; save the data pointer.
|
13561 |
|
|
|
13562 |
|
|
RST 20H ; NEXT-CHAR in BASIC area points to an
|
13563 |
|
|
; expression.
|
13564 |
|
|
|
13565 |
|
|
POP HL ; restore the data pointer.
|
13566 |
|
|
LD A,C ; transfer name/type to A.
|
13567 |
|
|
CP $C0 ; is it 11000000 ?
|
13568 |
|
|
; Note. the letter component is absent if
|
13569 |
|
|
; syntax checking.
|
13570 |
|
|
JR NZ,L29FB ; forward to SV-MULT if not an array of
|
13571 |
|
|
; strings.
|
13572 |
|
|
|
13573 |
|
|
; proceed to check string arrays during syntax.
|
13574 |
|
|
|
13575 |
|
|
RST 18H ; GET-CHAR
|
13576 |
|
|
CP $29 ; ')' end of subscripts ?
|
13577 |
|
|
JR Z,L2A48 ; forward to SV-DIM to consider further slice
|
13578 |
|
|
|
13579 |
|
|
CP $CC ; is it 'TO' ?
|
13580 |
|
|
JR Z,L29E0 ; back to SV-CH-ADD to consider a slice.
|
13581 |
|
|
; (no need to repeat get-char at L29E0)
|
13582 |
|
|
|
13583 |
|
|
; if neither, then an expression is required so rejoin runtime loop ??
|
13584 |
|
|
; registers HL and DE only point to somewhere meaningful in runtime so
|
13585 |
|
|
; comments apply to that situation.
|
13586 |
|
|
|
13587 |
|
|
;; SV-MULT
|
13588 |
|
|
L29FB: PUSH BC ; save dimension number.
|
13589 |
|
|
PUSH HL ; push data pointer/rubbish.
|
13590 |
|
|
; DE points to current dimension.
|
13591 |
|
|
CALL L2AEE ; routine DE,(DE+1) gets next dimension in DE
|
13592 |
|
|
; and HL points to it.
|
13593 |
|
|
EX (SP),HL ; dim pointer to stack, data pointer to HL (*)
|
13594 |
|
|
EX DE,HL ; data pointer to DE, dim size to HL.
|
13595 |
|
|
|
13596 |
|
|
CALL L2ACC ; routine INT-EXP1 checks integer expression
|
13597 |
|
|
; and gets result in BC in runtime.
|
13598 |
|
|
JR C,L2A20 ; to REPORT-3 if > HL
|
13599 |
|
|
; 'Subscript out of range'
|
13600 |
|
|
|
13601 |
|
|
DEC BC ; adjust returned result from 1-x to 0-x
|
13602 |
|
|
CALL L2AF4 ; routine GET-HL*DE multiplies data pointer by
|
13603 |
|
|
; dimension size.
|
13604 |
|
|
ADD HL,BC ; add the integer returned by expression.
|
13605 |
|
|
POP DE ; pop the dimension pointer. ***
|
13606 |
|
|
POP BC ; pop dimension counter.
|
13607 |
|
|
DJNZ L29C3 ; back to SV-COMMA if more dimensions
|
13608 |
|
|
; Note. during syntax checking, unless there
|
13609 |
|
|
; are more than 256 subscripts, the branch
|
13610 |
|
|
; back to SV-COMMA is always taken.
|
13611 |
|
|
|
13612 |
|
|
BIT 7,C ; are we checking syntax ?
|
13613 |
|
|
; then we've got a joker here.
|
13614 |
|
|
|
13615 |
|
|
;; SV-RPT-C
|
13616 |
|
|
L2A12: JR NZ,L2A7A ; forward to SL-RPT-C if so
|
13617 |
|
|
; 'Nonsense in BASIC'
|
13618 |
|
|
; more than 256 subscripts in BASIC line.
|
13619 |
|
|
|
13620 |
|
|
; but in runtime the number of subscripts are at least the same as dims
|
13621 |
|
|
|
13622 |
|
|
PUSH HL ; save data pointer.
|
13623 |
|
|
BIT 6,C ; is it a string array ?
|
13624 |
|
|
JR NZ,L2A2C ; forward to SV-ELEM$ if so.
|
13625 |
|
|
|
13626 |
|
|
; a runtime numeric array subscript.
|
13627 |
|
|
|
13628 |
|
|
LD B,D ; register DE has advanced past all dimensions
|
13629 |
|
|
LD C,E ; and points to start of data in variable.
|
13630 |
|
|
; transfer it to BC.
|
13631 |
|
|
|
13632 |
|
|
RST 18H ; GET-CHAR checks BASIC line
|
13633 |
|
|
CP $29 ; must be a ')' ?
|
13634 |
|
|
JR Z,L2A22 ; skip to SV-NUMBER if so
|
13635 |
|
|
|
13636 |
|
|
; else more subscripts in BASIC line than the variable definition.
|
13637 |
|
|
|
13638 |
|
|
;; REPORT-3
|
13639 |
|
|
L2A20: RST 08H ; ERROR-1
|
13640 |
|
|
DEFB $02 ; Error Report: Subscript wrong
|
13641 |
|
|
|
13642 |
|
|
; continue if subscripts matched the numeric array.
|
13643 |
|
|
|
13644 |
|
|
;; SV-NUMBER
|
13645 |
|
|
L2A22: RST 20H ; NEXT-CHAR moves CH_ADD to next statement
|
13646 |
|
|
; - finished parsing.
|
13647 |
|
|
|
13648 |
|
|
POP HL ; pop the data pointer.
|
13649 |
|
|
LD DE,$0005 ; each numeric element is 5 bytes.
|
13650 |
|
|
CALL L2AF4 ; routine GET-HL*DE multiplies.
|
13651 |
|
|
ADD HL,BC ; now add to start of data in the variable.
|
13652 |
|
|
|
13653 |
|
|
RET ; return with HL pointing at the numeric
|
13654 |
|
|
; array subscript. ->
|
13655 |
|
|
|
13656 |
|
|
; ---------------------------------------------------------------
|
13657 |
|
|
|
13658 |
|
|
; the branch was here for string subscripts when the number of subscripts
|
13659 |
|
|
; in the BASIC line was one less than in variable definition.
|
13660 |
|
|
|
13661 |
|
|
;; SV-ELEM$
|
13662 |
|
|
L2A2C: CALL L2AEE ; routine DE,(DE+1) gets final dimension
|
13663 |
|
|
; the length of strings in this array.
|
13664 |
|
|
EX (SP),HL ; start pointer to stack, data pointer to HL.
|
13665 |
|
|
CALL L2AF4 ; routine GET-HL*DE multiplies by element
|
13666 |
|
|
; size.
|
13667 |
|
|
POP BC ; the start of data pointer is added
|
13668 |
|
|
ADD HL,BC ; in - now points to location before.
|
13669 |
|
|
INC HL ; point to start of required string.
|
13670 |
|
|
LD B,D ; transfer the length (final dimension size)
|
13671 |
|
|
LD C,E ; from DE to BC.
|
13672 |
|
|
EX DE,HL ; put start in DE.
|
13673 |
|
|
CALL L2AB1 ; routine STK-ST-0 stores the string parameters
|
13674 |
|
|
; with A=0 - a slice or subscript.
|
13675 |
|
|
|
13676 |
|
|
; now check that there were no more subscripts in the BASIC line.
|
13677 |
|
|
|
13678 |
|
|
RST 18H ; GET-CHAR
|
13679 |
|
|
CP $29 ; is it ')' ?
|
13680 |
|
|
JR Z,L2A48 ; forward to SV-DIM to consider a separate
|
13681 |
|
|
; subscript or/and a slice.
|
13682 |
|
|
|
13683 |
|
|
CP $2C ; a comma is allowed if the final subscript
|
13684 |
|
|
; is to be sliced e.g. a$(2,3,4 TO 6).
|
13685 |
|
|
JR NZ,L2A20 ; to REPORT-3 with anything else
|
13686 |
|
|
; 'Subscript error'
|
13687 |
|
|
|
13688 |
|
|
;; SV-SLICE
|
13689 |
|
|
L2A45: CALL L2A52 ; routine SLICING slices the string.
|
13690 |
|
|
|
13691 |
|
|
; but a slice of a simple string can itself be sliced.
|
13692 |
|
|
|
13693 |
|
|
;; SV-DIM
|
13694 |
|
|
L2A48: RST 20H ; NEXT-CHAR
|
13695 |
|
|
|
13696 |
|
|
;; SV-SLICE?
|
13697 |
|
|
L2A49: CP $28 ; is character '(' ?
|
13698 |
|
|
JR Z,L2A45 ; loop back if so to SV-SLICE
|
13699 |
|
|
|
13700 |
|
|
RES 6,(IY+$01) ; update FLAGS - Signal string result
|
13701 |
|
|
RET ; and return.
|
13702 |
|
|
|
13703 |
|
|
; ---
|
13704 |
|
|
|
13705 |
|
|
; The above section deals with the flexible syntax allowed.
|
13706 |
|
|
; DIM a$(3,3,10) can be considered as two dimensional array of ten-character
|
13707 |
|
|
; strings or a 3-dimensional array of characters.
|
13708 |
|
|
; a$(1,1) will return a 10-character string as will a$(1,1,1 TO 10)
|
13709 |
|
|
; a$(1,1,1) will return a single character.
|
13710 |
|
|
; a$(1,1) (1 TO 6) is the same as a$(1,1,1 TO 6)
|
13711 |
|
|
; A slice can itself be sliced ad infinitum
|
13712 |
|
|
; b$ () () () () () () (2 TO 10) (2 TO 9) (3) is the same as b$(5)
|
13713 |
|
|
|
13714 |
|
|
|
13715 |
|
|
|
13716 |
|
|
; -------------------------
|
13717 |
|
|
; Handle slicing of strings
|
13718 |
|
|
; -------------------------
|
13719 |
|
|
; The syntax of string slicing is very natural and it is as well to reflect
|
13720 |
|
|
; on the permutations possible.
|
13721 |
|
|
; a$() and a$( TO ) indicate the entire string although just a$ would do
|
13722 |
|
|
; and would avoid coming here.
|
13723 |
|
|
; h$(16) indicates the single character at position 16.
|
13724 |
|
|
; a$( TO 32) indicates the first 32 characters.
|
13725 |
|
|
; a$(257 TO) indicates all except the first 256 characters.
|
13726 |
|
|
; a$(19000 TO 19999) indicates the thousand characters at position 19000.
|
13727 |
|
|
; Also a$(9 TO 5) returns a null string not an error.
|
13728 |
|
|
; This enables a$(2 TO) to return a null string if the passed string is
|
13729 |
|
|
; of length zero or 1.
|
13730 |
|
|
; A string expression in brackets can be sliced. e.g. (STR$ PI) (3 TO )
|
13731 |
|
|
; We arrived here from SCANNING with CH-ADD pointing to the initial '('
|
13732 |
|
|
; or from above.
|
13733 |
|
|
|
13734 |
|
|
;; SLICING
|
13735 |
|
|
L2A52: CALL L2530 ; routine SYNTAX-Z
|
13736 |
|
|
CALL NZ,L2BF1 ; routine STK-FETCH fetches parameters of
|
13737 |
|
|
; string at runtime, start in DE, length
|
13738 |
|
|
; in BC. This could be an array subscript.
|
13739 |
|
|
|
13740 |
|
|
RST 20H ; NEXT-CHAR
|
13741 |
|
|
CP $29 ; is it ')' ? e.g. a$()
|
13742 |
|
|
JR Z,L2AAD ; forward to SL-STORE to store entire string.
|
13743 |
|
|
|
13744 |
|
|
PUSH DE ; else save start address of string
|
13745 |
|
|
|
13746 |
|
|
XOR A ; clear accumulator to use as a running flag.
|
13747 |
|
|
PUSH AF ; and save on stack before any branching.
|
13748 |
|
|
|
13749 |
|
|
PUSH BC ; save length of string to be sliced.
|
13750 |
|
|
LD DE,$0001 ; default the start point to position 1.
|
13751 |
|
|
|
13752 |
|
|
RST 18H ; GET-CHAR
|
13753 |
|
|
|
13754 |
|
|
POP HL ; pop length to HL as default end point
|
13755 |
|
|
; and limit.
|
13756 |
|
|
|
13757 |
|
|
CP $CC ; is it 'TO' ? e.g. a$( TO 10000)
|
13758 |
|
|
JR Z,L2A81 ; to SL-SECOND to evaluate second parameter.
|
13759 |
|
|
|
13760 |
|
|
POP AF ; pop the running flag.
|
13761 |
|
|
|
13762 |
|
|
CALL L2ACD ; routine INT-EXP2 fetches first parameter.
|
13763 |
|
|
|
13764 |
|
|
PUSH AF ; save flag (will be $FF if parameter>limit)
|
13765 |
|
|
|
13766 |
|
|
LD D,B ; transfer the start
|
13767 |
|
|
LD E,C ; to DE overwriting 0001.
|
13768 |
|
|
PUSH HL ; save original length.
|
13769 |
|
|
|
13770 |
|
|
RST 18H ; GET-CHAR
|
13771 |
|
|
POP HL ; pop the limit length.
|
13772 |
|
|
CP $CC ; is it 'TO' after a start ?
|
13773 |
|
|
JR Z,L2A81 ; to SL-SECOND to evaluate second parameter
|
13774 |
|
|
|
13775 |
|
|
CP $29 ; is it ')' ? e.g. a$(365)
|
13776 |
|
|
|
13777 |
|
|
;; SL-RPT-C
|
13778 |
|
|
L2A7A: JP NZ,L1C8A ; jump to REPORT-C with anything else
|
13779 |
|
|
; 'Nonsense in BASIC'
|
13780 |
|
|
|
13781 |
|
|
LD H,D ; copy start
|
13782 |
|
|
LD L,E ; to end - just a one character slice.
|
13783 |
|
|
JR L2A94 ; forward to SL-DEFINE.
|
13784 |
|
|
|
13785 |
|
|
; ---------------------
|
13786 |
|
|
|
13787 |
|
|
;; SL-SECOND
|
13788 |
|
|
L2A81: PUSH HL ; save limit length.
|
13789 |
|
|
|
13790 |
|
|
RST 20H ; NEXT-CHAR
|
13791 |
|
|
|
13792 |
|
|
POP HL ; pop the length.
|
13793 |
|
|
|
13794 |
|
|
CP $29 ; is character ')' ? e.g. a$(7 TO )
|
13795 |
|
|
JR Z,L2A94 ; to SL-DEFINE using length as end point.
|
13796 |
|
|
|
13797 |
|
|
POP AF ; else restore flag.
|
13798 |
|
|
CALL L2ACD ; routine INT-EXP2 gets second expression.
|
13799 |
|
|
|
13800 |
|
|
PUSH AF ; save the running flag.
|
13801 |
|
|
|
13802 |
|
|
RST 18H ; GET-CHAR
|
13803 |
|
|
|
13804 |
|
|
LD H,B ; transfer second parameter
|
13805 |
|
|
LD L,C ; to HL. e.g. a$(42 to 99)
|
13806 |
|
|
CP $29 ; is character a ')' ?
|
13807 |
|
|
JR NZ,L2A7A ; to SL-RPT-C if not
|
13808 |
|
|
; 'Nonsense in BASIC'
|
13809 |
|
|
|
13810 |
|
|
; we now have start in DE and an end in HL.
|
13811 |
|
|
|
13812 |
|
|
;; SL-DEFINE
|
13813 |
|
|
L2A94: POP AF ; pop the running flag.
|
13814 |
|
|
EX (SP),HL ; put end point on stack, start address to HL
|
13815 |
|
|
ADD HL,DE ; add address of string to the start point.
|
13816 |
|
|
DEC HL ; point to first character of slice.
|
13817 |
|
|
EX (SP),HL ; start address to stack, end point to HL (*)
|
13818 |
|
|
AND A ; prepare to subtract.
|
13819 |
|
|
SBC HL,DE ; subtract start point from end point.
|
13820 |
|
|
LD BC,$0000 ; default the length result to zero.
|
13821 |
|
|
JR C,L2AA8 ; forward to SL-OVER if start > end.
|
13822 |
|
|
|
13823 |
|
|
INC HL ; increment the length for inclusive byte.
|
13824 |
|
|
|
13825 |
|
|
AND A ; now test the running flag.
|
13826 |
|
|
JP M,L2A20 ; jump back to REPORT-3 if $FF.
|
13827 |
|
|
; 'Subscript out of range'
|
13828 |
|
|
|
13829 |
|
|
LD B,H ; transfer the length
|
13830 |
|
|
LD C,L ; to BC.
|
13831 |
|
|
|
13832 |
|
|
;; SL-OVER
|
13833 |
|
|
L2AA8: POP DE ; restore start address from machine stack ***
|
13834 |
|
|
RES 6,(IY+$01) ; update FLAGS - signal string result for
|
13835 |
|
|
; syntax.
|
13836 |
|
|
|
13837 |
|
|
;; SL-STORE
|
13838 |
|
|
L2AAD: CALL L2530 ; routine SYNTAX-Z (UNSTACK-Z?)
|
13839 |
|
|
RET Z ; return if checking syntax.
|
13840 |
|
|
; but continue to store the string in runtime.
|
13841 |
|
|
|
13842 |
|
|
; ------------------------------------
|
13843 |
|
|
; other than from above, this routine is called from STK-VAR to stack
|
13844 |
|
|
; a known string array element.
|
13845 |
|
|
; ------------------------------------
|
13846 |
|
|
|
13847 |
|
|
;; STK-ST-0
|
13848 |
|
|
L2AB1: XOR A ; clear to signal a sliced string or element.
|
13849 |
|
|
|
13850 |
|
|
; -------------------------
|
13851 |
|
|
; this routine is called from chr$, scrn$ etc. to store a simple string result.
|
13852 |
|
|
; --------------------------
|
13853 |
|
|
|
13854 |
|
|
;; STK-STO-$
|
13855 |
|
|
L2AB2: RES 6,(IY+$01) ; update FLAGS - signal string result.
|
13856 |
|
|
; and continue to store parameters of string.
|
13857 |
|
|
|
13858 |
|
|
; ---------------------------------------
|
13859 |
|
|
; Pass five registers to calculator stack
|
13860 |
|
|
; ---------------------------------------
|
13861 |
|
|
; This subroutine puts five registers on the calculator stack.
|
13862 |
|
|
|
13863 |
|
|
;; STK-STORE
|
13864 |
|
|
L2AB6: PUSH BC ; save two registers
|
13865 |
|
|
CALL L33A9 ; routine TEST-5-SP checks room and puts 5
|
13866 |
|
|
; in BC.
|
13867 |
|
|
POP BC ; fetch the saved registers.
|
13868 |
|
|
LD HL,($5C65) ; make HL point to first empty location STKEND
|
13869 |
|
|
LD (HL),A ; place the 5 registers.
|
13870 |
|
|
INC HL ;
|
13871 |
|
|
LD (HL),E ;
|
13872 |
|
|
INC HL ;
|
13873 |
|
|
LD (HL),D ;
|
13874 |
|
|
INC HL ;
|
13875 |
|
|
LD (HL),C ;
|
13876 |
|
|
INC HL ;
|
13877 |
|
|
LD (HL),B ;
|
13878 |
|
|
INC HL ;
|
13879 |
|
|
LD ($5C65),HL ; update system variable STKEND.
|
13880 |
|
|
RET ; and return.
|
13881 |
|
|
|
13882 |
|
|
; -------------------------------------------
|
13883 |
|
|
; Return result of evaluating next expression
|
13884 |
|
|
; -------------------------------------------
|
13885 |
|
|
; This clever routine is used to check and evaluate an integer expression
|
13886 |
|
|
; which is returned in BC, setting A to $FF, if greater than a limit supplied
|
13887 |
|
|
; in HL. It is used to check array subscripts, parameters of a string slice
|
13888 |
|
|
; and the arguments of the DIM command. In the latter case, the limit check
|
13889 |
|
|
; is not required and H is set to $FF. When checking optional string slice
|
13890 |
|
|
; parameters, it is entered at the second entry point so as not to disturb
|
13891 |
|
|
; the running flag A, which may be $00 or $FF from a previous invocation.
|
13892 |
|
|
|
13893 |
|
|
;; INT-EXP1
|
13894 |
|
|
L2ACC: XOR A ; set result flag to zero.
|
13895 |
|
|
|
13896 |
|
|
; -> The entry point is here if A is used as a running flag.
|
13897 |
|
|
|
13898 |
|
|
;; INT-EXP2
|
13899 |
|
|
L2ACD: PUSH DE ; preserve DE register throughout.
|
13900 |
|
|
PUSH HL ; save the supplied limit.
|
13901 |
|
|
PUSH AF ; save the flag.
|
13902 |
|
|
|
13903 |
|
|
CALL L1C82 ; routine EXPT-1NUM evaluates expression
|
13904 |
|
|
; at CH_ADD returning if numeric result,
|
13905 |
|
|
; with value on calculator stack.
|
13906 |
|
|
|
13907 |
|
|
POP AF ; pop the flag.
|
13908 |
|
|
CALL L2530 ; routine SYNTAX-Z
|
13909 |
|
|
JR Z,L2AEB ; forward to I-RESTORE if checking syntax so
|
13910 |
|
|
; avoiding a comparison with supplied limit.
|
13911 |
|
|
|
13912 |
|
|
PUSH AF ; save the flag.
|
13913 |
|
|
|
13914 |
|
|
CALL L1E99 ; routine FIND-INT2 fetches value from
|
13915 |
|
|
; calculator stack to BC producing an error
|
13916 |
|
|
; if too high.
|
13917 |
|
|
|
13918 |
|
|
POP DE ; pop the flag to D.
|
13919 |
|
|
LD A,B ; test value for zero and reject
|
13920 |
|
|
OR C ; as arrays and strings begin at 1.
|
13921 |
|
|
SCF ; set carry flag.
|
13922 |
|
|
JR Z,L2AE8 ; forward to I-CARRY if zero.
|
13923 |
|
|
|
13924 |
|
|
POP HL ; restore the limit.
|
13925 |
|
|
PUSH HL ; and save.
|
13926 |
|
|
AND A ; prepare to subtract.
|
13927 |
|
|
SBC HL,BC ; subtract value from limit.
|
13928 |
|
|
|
13929 |
|
|
;; I-CARRY
|
13930 |
|
|
L2AE8: LD A,D ; move flag to accumulator $00 or $FF.
|
13931 |
|
|
SBC A,$00 ; will set to $FF if carry set.
|
13932 |
|
|
|
13933 |
|
|
;; I-RESTORE
|
13934 |
|
|
L2AEB: POP HL ; restore the limit.
|
13935 |
|
|
POP DE ; and DE register.
|
13936 |
|
|
RET ; return.
|
13937 |
|
|
|
13938 |
|
|
|
13939 |
|
|
; -----------------------
|
13940 |
|
|
; LD DE,(DE+1) Subroutine
|
13941 |
|
|
; -----------------------
|
13942 |
|
|
; This routine just loads the DE register with the contents of the two
|
13943 |
|
|
; locations following the location addressed by DE.
|
13944 |
|
|
; It is used to step along the 16-bit dimension sizes in array definitions.
|
13945 |
|
|
; Note. Such code is made into subroutines to make programs easier to
|
13946 |
|
|
; write and it would use less space to include the five instructions in-line.
|
13947 |
|
|
; However, there are so many exchanges going on at the places this is invoked
|
13948 |
|
|
; that to implement it in-line would make the code hard to follow.
|
13949 |
|
|
; It probably had a zippier label though as the intention is to simplify the
|
13950 |
|
|
; program.
|
13951 |
|
|
|
13952 |
|
|
;; DE,(DE+1)
|
13953 |
|
|
L2AEE: EX DE,HL ;
|
13954 |
|
|
INC HL ;
|
13955 |
|
|
LD E,(HL) ;
|
13956 |
|
|
INC HL ;
|
13957 |
|
|
LD D,(HL) ;
|
13958 |
|
|
RET ;
|
13959 |
|
|
|
13960 |
|
|
; -------------------
|
13961 |
|
|
; HL=HL*DE Subroutine
|
13962 |
|
|
; -------------------
|
13963 |
|
|
; This routine calls the mathematical routine to multiply HL by DE in runtime.
|
13964 |
|
|
; It is called from STK-VAR and from DIM. In the latter case syntax is not
|
13965 |
|
|
; being checked so the entry point could have been at the second CALL
|
13966 |
|
|
; instruction to save a few clock-cycles.
|
13967 |
|
|
|
13968 |
|
|
;; GET-HL*DE
|
13969 |
|
|
L2AF4: CALL L2530 ; routine SYNTAX-Z.
|
13970 |
|
|
RET Z ; return if checking syntax.
|
13971 |
|
|
|
13972 |
|
|
CALL L30A9 ; routine HL-HL*DE.
|
13973 |
|
|
JP C,L1F15 ; jump back to REPORT-4 if over 65535.
|
13974 |
|
|
|
13975 |
|
|
RET ; else return with 16-bit result in HL.
|
13976 |
|
|
|
13977 |
|
|
; -----------------
|
13978 |
|
|
; THE 'LET' COMMAND
|
13979 |
|
|
; -----------------
|
13980 |
|
|
; Sinclair BASIC adheres to the ANSI-78 standard and a LET is required in
|
13981 |
|
|
; assignments e.g. LET a = 1 : LET h$ = "hat".
|
13982 |
|
|
;
|
13983 |
|
|
; Long names may contain spaces but not colour controls (when assigned).
|
13984 |
|
|
; a substring can appear to the left of the equals sign.
|
13985 |
|
|
|
13986 |
|
|
; An earlier mathematician Lewis Carroll may have been pleased that
|
13987 |
|
|
; 10 LET Babies cannot manage crocodiles = Babies are illogical AND
|
13988 |
|
|
; Nobody is despised who can manage a crocodile AND Illogical persons
|
13989 |
|
|
; are despised
|
13990 |
|
|
; does not give the 'Nonsense..' error if the three variables exist.
|
13991 |
|
|
; I digress.
|
13992 |
|
|
|
13993 |
|
|
;; LET
|
13994 |
|
|
L2AFF: LD HL,($5C4D) ; fetch system variable DEST to HL.
|
13995 |
|
|
BIT 1,(IY+$37) ; test FLAGX - handling a new variable ?
|
13996 |
|
|
JR Z,L2B66 ; forward to L-EXISTS if not.
|
13997 |
|
|
|
13998 |
|
|
; continue for a new variable. DEST points to start in BASIC line.
|
13999 |
|
|
; from the CLASS routines.
|
14000 |
|
|
|
14001 |
|
|
LD BC,$0005 ; assume numeric and assign an initial 5 bytes
|
14002 |
|
|
|
14003 |
|
|
;; L-EACH-CH
|
14004 |
|
|
L2B0B: INC BC ; increase byte count for each relevant
|
14005 |
|
|
; character
|
14006 |
|
|
|
14007 |
|
|
;; L-NO-SP
|
14008 |
|
|
L2B0C: INC HL ; increase pointer.
|
14009 |
|
|
LD A,(HL) ; fetch character.
|
14010 |
|
|
CP $20 ; is it a space ?
|
14011 |
|
|
JR Z,L2B0C ; back to L-NO-SP is so.
|
14012 |
|
|
|
14013 |
|
|
JR NC,L2B1F ; forward to L-TEST-CH if higher.
|
14014 |
|
|
|
14015 |
|
|
CP $10 ; is it $00 - $0F ?
|
14016 |
|
|
JR C,L2B29 ; forward to L-SPACES if so.
|
14017 |
|
|
|
14018 |
|
|
CP $16 ; is it $16 - $1F ?
|
14019 |
|
|
JR NC,L2B29 ; forward to L-SPACES if so.
|
14020 |
|
|
|
14021 |
|
|
; it was $10 - $15 so step over a colour code.
|
14022 |
|
|
|
14023 |
|
|
INC HL ; increase pointer.
|
14024 |
|
|
JR L2B0C ; loop back to L-NO-SP.
|
14025 |
|
|
|
14026 |
|
|
; ---
|
14027 |
|
|
|
14028 |
|
|
; the branch was to here if higher than space.
|
14029 |
|
|
|
14030 |
|
|
;; L-TEST-CH
|
14031 |
|
|
L2B1F: CALL L2C88 ; routine ALPHANUM sets carry if alphanumeric
|
14032 |
|
|
JR C,L2B0B ; loop back to L-EACH-CH for more if so.
|
14033 |
|
|
|
14034 |
|
|
CP $24 ; is it '$' ?
|
14035 |
|
|
JP Z,L2BC0 ; jump forward if so, to L-NEW$
|
14036 |
|
|
; with a new string.
|
14037 |
|
|
|
14038 |
|
|
;; L-SPACES
|
14039 |
|
|
L2B29: LD A,C ; save length lo in A.
|
14040 |
|
|
LD HL,($5C59) ; fetch E_LINE to HL.
|
14041 |
|
|
DEC HL ; point to location before, the variables
|
14042 |
|
|
; end-marker.
|
14043 |
|
|
CALL L1655 ; routine MAKE-ROOM creates BC spaces
|
14044 |
|
|
; for name and numeric value.
|
14045 |
|
|
INC HL ; advance to first new location.
|
14046 |
|
|
INC HL ; then to second.
|
14047 |
|
|
EX DE,HL ; set DE to second location.
|
14048 |
|
|
PUSH DE ; save this pointer.
|
14049 |
|
|
LD HL,($5C4D) ; reload HL with DEST.
|
14050 |
|
|
DEC DE ; point to first.
|
14051 |
|
|
SUB $06 ; subtract six from length_lo.
|
14052 |
|
|
LD B,A ; save count in B.
|
14053 |
|
|
JR Z,L2B4F ; forward to L-SINGLE if it was just
|
14054 |
|
|
; one character.
|
14055 |
|
|
|
14056 |
|
|
; HL points to start of variable name after 'LET' in BASIC line.
|
14057 |
|
|
|
14058 |
|
|
;; L-CHAR
|
14059 |
|
|
L2B3E: INC HL ; increase pointer.
|
14060 |
|
|
LD A,(HL) ; pick up character.
|
14061 |
|
|
CP $21 ; is it space or higher ?
|
14062 |
|
|
JR C,L2B3E ; back to L-CHAR with space and less.
|
14063 |
|
|
|
14064 |
|
|
OR $20 ; make variable lower-case.
|
14065 |
|
|
INC DE ; increase destination pointer.
|
14066 |
|
|
LD (DE),A ; and load to edit line.
|
14067 |
|
|
DJNZ L2B3E ; loop back to L-CHAR until B is zero.
|
14068 |
|
|
|
14069 |
|
|
OR $80 ; invert the last character.
|
14070 |
|
|
LD (DE),A ; and overwrite that in edit line.
|
14071 |
|
|
|
14072 |
|
|
; now consider first character which has bit 6 set
|
14073 |
|
|
|
14074 |
|
|
LD A,$C0 ; set A 11000000 is xor mask for a long name.
|
14075 |
|
|
; %101 is xor/or result
|
14076 |
|
|
|
14077 |
|
|
; single character numerics rejoin here with %00000000 in mask.
|
14078 |
|
|
; %011 will be xor/or result
|
14079 |
|
|
|
14080 |
|
|
;; L-SINGLE
|
14081 |
|
|
L2B4F: LD HL,($5C4D) ; fetch DEST - HL addresses first character.
|
14082 |
|
|
XOR (HL) ; apply variable type indicator mask (above).
|
14083 |
|
|
OR $20 ; make lowercase - set bit 5.
|
14084 |
|
|
POP HL ; restore pointer to 2nd character.
|
14085 |
|
|
CALL L2BEA ; routine L-FIRST puts A in first character.
|
14086 |
|
|
; and returns with HL holding
|
14087 |
|
|
; new E_LINE-1 the $80 vars end-marker.
|
14088 |
|
|
|
14089 |
|
|
;; L-NUMERIC
|
14090 |
|
|
L2B59: PUSH HL ; save the pointer.
|
14091 |
|
|
|
14092 |
|
|
; the value of variable is deleted but remains after calculator stack.
|
14093 |
|
|
|
14094 |
|
|
RST 28H ;; FP-CALC
|
14095 |
|
|
DEFB $02 ;;delete ; delete variable value
|
14096 |
|
|
DEFB $38 ;;end-calc
|
14097 |
|
|
|
14098 |
|
|
; DE (STKEND) points to start of value.
|
14099 |
|
|
|
14100 |
|
|
POP HL ; restore the pointer.
|
14101 |
|
|
LD BC,$0005 ; start of number is five bytes before.
|
14102 |
|
|
AND A ; prepare for true subtraction.
|
14103 |
|
|
SBC HL,BC ; HL points to start of value.
|
14104 |
|
|
JR L2BA6 ; forward to L-ENTER ==>
|
14105 |
|
|
|
14106 |
|
|
; ---
|
14107 |
|
|
|
14108 |
|
|
|
14109 |
|
|
; the jump was to here if the variable already existed.
|
14110 |
|
|
|
14111 |
|
|
;; L-EXISTS
|
14112 |
|
|
L2B66: BIT 6,(IY+$01) ; test FLAGS - numeric or string result ?
|
14113 |
|
|
JR Z,L2B72 ; skip forward to L-DELETE$ -*->
|
14114 |
|
|
; if string result.
|
14115 |
|
|
|
14116 |
|
|
; A numeric variable could be simple or an array element.
|
14117 |
|
|
; They are treated the same and the old value is overwritten.
|
14118 |
|
|
|
14119 |
|
|
LD DE,$0006 ; six bytes forward points to loc past value.
|
14120 |
|
|
ADD HL,DE ; add to start of number.
|
14121 |
|
|
JR L2B59 ; back to L-NUMERIC to overwrite value.
|
14122 |
|
|
|
14123 |
|
|
; ---
|
14124 |
|
|
|
14125 |
|
|
; -*-> the branch was here if a string existed.
|
14126 |
|
|
|
14127 |
|
|
;; L-DELETE$
|
14128 |
|
|
L2B72: LD HL,($5C4D) ; fetch DEST to HL.
|
14129 |
|
|
; (still set from first instruction)
|
14130 |
|
|
LD BC,($5C72) ; fetch STRLEN to BC.
|
14131 |
|
|
BIT 0,(IY+$37) ; test FLAGX - handling a complete simple
|
14132 |
|
|
; string ?
|
14133 |
|
|
JR NZ,L2BAF ; forward to L-ADD$ if so.
|
14134 |
|
|
|
14135 |
|
|
; must be a string array or a slice in workspace.
|
14136 |
|
|
; Note. LET a$(3 TO 6) = h$ will assign "hat " if h$ = "hat"
|
14137 |
|
|
; and "hats" if h$ = "hatstand".
|
14138 |
|
|
;
|
14139 |
|
|
; This is known as Procrustean lengthening and shortening after a
|
14140 |
|
|
; character Procrustes in Greek legend who made travellers sleep in his bed,
|
14141 |
|
|
; cutting off their feet or stretching them so they fitted the bed perfectly.
|
14142 |
|
|
; The bloke was hatstand and slain by Theseus.
|
14143 |
|
|
|
14144 |
|
|
LD A,B ; test if length
|
14145 |
|
|
OR C ; is zero and
|
14146 |
|
|
RET Z ; return if so.
|
14147 |
|
|
|
14148 |
|
|
PUSH HL ; save pointer to start.
|
14149 |
|
|
|
14150 |
|
|
RST 30H ; BC-SPACES creates room.
|
14151 |
|
|
PUSH DE ; save pointer to first new location.
|
14152 |
|
|
PUSH BC ; and length (*)
|
14153 |
|
|
LD D,H ; set DE to point to last location.
|
14154 |
|
|
LD E,L ;
|
14155 |
|
|
INC HL ; set HL to next location.
|
14156 |
|
|
LD (HL),$20 ; place a space there.
|
14157 |
|
|
LDDR ; copy bytes filling with spaces.
|
14158 |
|
|
|
14159 |
|
|
PUSH HL ; save pointer to start.
|
14160 |
|
|
CALL L2BF1 ; routine STK-FETCH start to DE,
|
14161 |
|
|
; length to BC.
|
14162 |
|
|
POP HL ; restore the pointer.
|
14163 |
|
|
EX (SP),HL ; (*) length to HL, pointer to stack.
|
14164 |
|
|
AND A ; prepare for true subtraction.
|
14165 |
|
|
SBC HL,BC ; subtract old length from new.
|
14166 |
|
|
ADD HL,BC ; and add back.
|
14167 |
|
|
JR NC,L2B9B ; forward if it fits to L-LENGTH.
|
14168 |
|
|
|
14169 |
|
|
LD B,H ; otherwise set
|
14170 |
|
|
LD C,L ; length to old length.
|
14171 |
|
|
; "hatstand" becomes "hats"
|
14172 |
|
|
|
14173 |
|
|
;; L-LENGTH
|
14174 |
|
|
L2B9B: EX (SP),HL ; (*) length to stack, pointer to HL.
|
14175 |
|
|
EX DE,HL ; pointer to DE, start of string to HL.
|
14176 |
|
|
LD A,B ; is the length zero ?
|
14177 |
|
|
OR C ;
|
14178 |
|
|
JR Z,L2BA3 ; forward to L-IN-W/S if so
|
14179 |
|
|
; leaving prepared spaces.
|
14180 |
|
|
|
14181 |
|
|
LDIR ; else copy bytes overwriting some spaces.
|
14182 |
|
|
|
14183 |
|
|
;; L-IN-W/S
|
14184 |
|
|
L2BA3: POP BC ; pop the new length. (*)
|
14185 |
|
|
POP DE ; pop pointer to new area.
|
14186 |
|
|
POP HL ; pop pointer to variable in assignment.
|
14187 |
|
|
; and continue copying from workspace
|
14188 |
|
|
; to variables area.
|
14189 |
|
|
|
14190 |
|
|
; ==> branch here from L-NUMERIC
|
14191 |
|
|
|
14192 |
|
|
;; L-ENTER
|
14193 |
|
|
L2BA6: EX DE,HL ; exchange pointers HL=STKEND DE=end of vars.
|
14194 |
|
|
LD A,B ; test the length
|
14195 |
|
|
OR C ; and make a
|
14196 |
|
|
RET Z ; return if zero (strings only).
|
14197 |
|
|
|
14198 |
|
|
PUSH DE ; save start of destination.
|
14199 |
|
|
LDIR ; copy bytes.
|
14200 |
|
|
POP HL ; address the start.
|
14201 |
|
|
RET ; and return.
|
14202 |
|
|
|
14203 |
|
|
; ---
|
14204 |
|
|
|
14205 |
|
|
; the branch was here from L-DELETE$ if an existing simple string.
|
14206 |
|
|
; register HL addresses start of string in variables area.
|
14207 |
|
|
|
14208 |
|
|
;; L-ADD$
|
14209 |
|
|
L2BAF: DEC HL ; point to high byte of length.
|
14210 |
|
|
DEC HL ; to low byte.
|
14211 |
|
|
DEC HL ; to letter.
|
14212 |
|
|
LD A,(HL) ; fetch masked letter to A.
|
14213 |
|
|
PUSH HL ; save the pointer on stack.
|
14214 |
|
|
PUSH BC ; save new length.
|
14215 |
|
|
CALL L2BC6 ; routine L-STRING adds new string at end
|
14216 |
|
|
; of variables area.
|
14217 |
|
|
; if no room we still have old one.
|
14218 |
|
|
POP BC ; restore length.
|
14219 |
|
|
POP HL ; restore start.
|
14220 |
|
|
INC BC ; increase
|
14221 |
|
|
INC BC ; length by three
|
14222 |
|
|
INC BC ; to include character and length bytes.
|
14223 |
|
|
JP L19E8 ; jump to indirect exit via RECLAIM-2
|
14224 |
|
|
; deleting old version and adjusting pointers.
|
14225 |
|
|
|
14226 |
|
|
; ---
|
14227 |
|
|
|
14228 |
|
|
; the jump was here with a new string variable.
|
14229 |
|
|
|
14230 |
|
|
;; L-NEW$
|
14231 |
|
|
L2BC0: LD A,$DF ; indicator mask %11011111 for
|
14232 |
|
|
; %010xxxxx will be result
|
14233 |
|
|
LD HL,($5C4D) ; address DEST first character.
|
14234 |
|
|
AND (HL) ; combine mask with character.
|
14235 |
|
|
|
14236 |
|
|
;; L-STRING
|
14237 |
|
|
L2BC6: PUSH AF ; save first character and mask.
|
14238 |
|
|
CALL L2BF1 ; routine STK-FETCH fetches parameters of
|
14239 |
|
|
; the string.
|
14240 |
|
|
EX DE,HL ; transfer start to HL.
|
14241 |
|
|
ADD HL,BC ; add to length.
|
14242 |
|
|
PUSH BC ; save the length.
|
14243 |
|
|
DEC HL ; point to end of string.
|
14244 |
|
|
LD ($5C4D),HL ; save pointer in DEST.
|
14245 |
|
|
; (updated by POINTERS if in workspace)
|
14246 |
|
|
INC BC ; extra byte for letter.
|
14247 |
|
|
INC BC ; two bytes
|
14248 |
|
|
INC BC ; for the length of string.
|
14249 |
|
|
LD HL,($5C59) ; address E_LINE.
|
14250 |
|
|
DEC HL ; now end of VARS area.
|
14251 |
|
|
CALL L1655 ; routine MAKE-ROOM makes room for string.
|
14252 |
|
|
; updating pointers including DEST.
|
14253 |
|
|
LD HL,($5C4D) ; pick up pointer to end of string from DEST.
|
14254 |
|
|
POP BC ; restore length from stack.
|
14255 |
|
|
PUSH BC ; and save again on stack.
|
14256 |
|
|
INC BC ; add a byte.
|
14257 |
|
|
LDDR ; copy bytes from end to start.
|
14258 |
|
|
EX DE,HL ; HL addresses length low
|
14259 |
|
|
INC HL ; increase to address high byte
|
14260 |
|
|
POP BC ; restore length to BC
|
14261 |
|
|
LD (HL),B ; insert high byte
|
14262 |
|
|
DEC HL ; address low byte location
|
14263 |
|
|
LD (HL),C ; insert that byte
|
14264 |
|
|
POP AF ; restore character and mask
|
14265 |
|
|
|
14266 |
|
|
;; L-FIRST
|
14267 |
|
|
L2BEA: DEC HL ; address variable name
|
14268 |
|
|
LD (HL),A ; and insert character.
|
14269 |
|
|
LD HL,($5C59) ; load HL with E_LINE.
|
14270 |
|
|
DEC HL ; now end of VARS area.
|
14271 |
|
|
RET ; return
|
14272 |
|
|
|
14273 |
|
|
; ------------------------------------
|
14274 |
|
|
; Get last value from calculator stack
|
14275 |
|
|
; ------------------------------------
|
14276 |
|
|
;
|
14277 |
|
|
;
|
14278 |
|
|
|
14279 |
|
|
;; STK-FETCH
|
14280 |
|
|
L2BF1: LD HL,($5C65) ; STKEND
|
14281 |
|
|
DEC HL ;
|
14282 |
|
|
LD B,(HL) ;
|
14283 |
|
|
DEC HL ;
|
14284 |
|
|
LD C,(HL) ;
|
14285 |
|
|
DEC HL ;
|
14286 |
|
|
LD D,(HL) ;
|
14287 |
|
|
DEC HL ;
|
14288 |
|
|
LD E,(HL) ;
|
14289 |
|
|
DEC HL ;
|
14290 |
|
|
LD A,(HL) ;
|
14291 |
|
|
LD ($5C65),HL ; STKEND
|
14292 |
|
|
RET ;
|
14293 |
|
|
|
14294 |
|
|
; ------------------
|
14295 |
|
|
; Handle DIM command
|
14296 |
|
|
; ------------------
|
14297 |
|
|
; e.g. DIM a(2,3,4,7): DIM a$(32) : DIM b$(20,2,768) : DIM c$(20000)
|
14298 |
|
|
; the only limit to dimensions is memory so, for example,
|
14299 |
|
|
; DIM a(2,2,2,2,2,2,2,2,2,2,2,2,2) is possible and creates a multi-
|
14300 |
|
|
; dimensional array of zeros. String arrays are initialized to spaces.
|
14301 |
|
|
; It is not possible to erase an array, but it can be re-dimensioned to
|
14302 |
|
|
; a minimal size of 1, after use, to free up memory.
|
14303 |
|
|
|
14304 |
|
|
;; DIM
|
14305 |
|
|
L2C02: CALL L28B2 ; routine LOOK-VARS
|
14306 |
|
|
|
14307 |
|
|
;; D-RPORT-C
|
14308 |
|
|
L2C05: JP NZ,L1C8A ; jump to REPORT-C if a long-name variable.
|
14309 |
|
|
; DIM lottery numbers(49) doesn't work.
|
14310 |
|
|
|
14311 |
|
|
CALL L2530 ; routine SYNTAX-Z
|
14312 |
|
|
JR NZ,L2C15 ; forward to D-RUN in runtime.
|
14313 |
|
|
|
14314 |
|
|
RES 6,C ; signal 'numeric' array even if string as
|
14315 |
|
|
; this simplifies the syntax checking.
|
14316 |
|
|
|
14317 |
|
|
CALL L2996 ; routine STK-VAR checks syntax.
|
14318 |
|
|
CALL L1BEE ; routine CHECK-END performs early exit ->
|
14319 |
|
|
|
14320 |
|
|
; the branch was here in runtime.
|
14321 |
|
|
|
14322 |
|
|
;; D-RUN
|
14323 |
|
|
L2C15: JR C,L2C1F ; skip to D-LETTER if variable did not exist.
|
14324 |
|
|
; else reclaim the old one.
|
14325 |
|
|
|
14326 |
|
|
PUSH BC ; save type in C.
|
14327 |
|
|
CALL L19B8 ; routine NEXT-ONE find following variable
|
14328 |
|
|
; or position of $80 end-marker.
|
14329 |
|
|
CALL L19E8 ; routine RECLAIM-2 reclaims the
|
14330 |
|
|
; space between.
|
14331 |
|
|
POP BC ; pop the type.
|
14332 |
|
|
|
14333 |
|
|
;; D-LETTER
|
14334 |
|
|
L2C1F: SET 7,C ; signal array.
|
14335 |
|
|
LD B,$00 ; initialize dimensions to zero and
|
14336 |
|
|
PUSH BC ; save with the type.
|
14337 |
|
|
LD HL,$0001 ; make elements one character presuming string
|
14338 |
|
|
BIT 6,C ; is it a string ?
|
14339 |
|
|
JR NZ,L2C2D ; forward to D-SIZE if so.
|
14340 |
|
|
|
14341 |
|
|
LD L,$05 ; make elements 5 bytes as is numeric.
|
14342 |
|
|
|
14343 |
|
|
;; D-SIZE
|
14344 |
|
|
L2C2D: EX DE,HL ; save the element size in DE.
|
14345 |
|
|
|
14346 |
|
|
; now enter a loop to parse each of the integers in the list.
|
14347 |
|
|
|
14348 |
|
|
;; D-NO-LOOP
|
14349 |
|
|
L2C2E: RST 20H ; NEXT-CHAR
|
14350 |
|
|
LD H,$FF ; disable limit check by setting HL high
|
14351 |
|
|
CALL L2ACC ; routine INT-EXP1
|
14352 |
|
|
JP C,L2A20 ; to REPORT-3 if > 65280 and then some
|
14353 |
|
|
; 'Subscript out of range'
|
14354 |
|
|
|
14355 |
|
|
POP HL ; pop dimension counter, array type
|
14356 |
|
|
PUSH BC ; save dimension size ***
|
14357 |
|
|
INC H ; increment the dimension counter
|
14358 |
|
|
PUSH HL ; save the dimension counter
|
14359 |
|
|
LD H,B ; transfer size
|
14360 |
|
|
LD L,C ; to HL
|
14361 |
|
|
CALL L2AF4 ; routine GET-HL*DE multiplies dimension by
|
14362 |
|
|
; running total of size required initially
|
14363 |
|
|
; 1 or 5.
|
14364 |
|
|
EX DE,HL ; save running total in DE
|
14365 |
|
|
|
14366 |
|
|
RST 18H ; GET-CHAR
|
14367 |
|
|
CP $2C ; is it ',' ?
|
14368 |
|
|
JR Z,L2C2E ; loop back to D-NO-LOOP until all dimensions
|
14369 |
|
|
; have been considered
|
14370 |
|
|
|
14371 |
|
|
; when loop complete continue.
|
14372 |
|
|
|
14373 |
|
|
CP $29 ; is it ')' ?
|
14374 |
|
|
JR NZ,L2C05 ; to D-RPORT-C with anything else
|
14375 |
|
|
; 'Nonsense in BASIC'
|
14376 |
|
|
|
14377 |
|
|
|
14378 |
|
|
RST 20H ; NEXT-CHAR advances to next statement/CR
|
14379 |
|
|
|
14380 |
|
|
POP BC ; pop dimension counter/type
|
14381 |
|
|
LD A,C ; type to A
|
14382 |
|
|
|
14383 |
|
|
; now calculate space required for array variable
|
14384 |
|
|
|
14385 |
|
|
LD L,B ; dimensions to L since these require 16 bits
|
14386 |
|
|
; then this value will be doubled
|
14387 |
|
|
LD H,$00 ; set high byte to zero
|
14388 |
|
|
|
14389 |
|
|
; another four bytes are required for letter(1), total length(2), number of
|
14390 |
|
|
; dimensions(1) but since we have yet to double allow for two
|
14391 |
|
|
|
14392 |
|
|
INC HL ; increment
|
14393 |
|
|
INC HL ; increment
|
14394 |
|
|
|
14395 |
|
|
ADD HL,HL ; now double giving 4 + dimensions * 2
|
14396 |
|
|
|
14397 |
|
|
ADD HL,DE ; add to space required for array contents
|
14398 |
|
|
|
14399 |
|
|
JP C,L1F15 ; to REPORT-4 if > 65535
|
14400 |
|
|
; 'Out of memory'
|
14401 |
|
|
|
14402 |
|
|
PUSH DE ; save data space
|
14403 |
|
|
PUSH BC ; save dimensions/type
|
14404 |
|
|
PUSH HL ; save total space
|
14405 |
|
|
LD B,H ; total space
|
14406 |
|
|
LD C,L ; to BC
|
14407 |
|
|
LD HL,($5C59) ; address E_LINE - first location after
|
14408 |
|
|
; variables area
|
14409 |
|
|
DEC HL ; point to location before - the $80 end-marker
|
14410 |
|
|
CALL L1655 ; routine MAKE-ROOM creates the space if
|
14411 |
|
|
; memory is available.
|
14412 |
|
|
|
14413 |
|
|
INC HL ; point to first new location and
|
14414 |
|
|
LD (HL),A ; store letter/type
|
14415 |
|
|
|
14416 |
|
|
POP BC ; pop total space
|
14417 |
|
|
DEC BC ; exclude name
|
14418 |
|
|
DEC BC ; exclude the 16-bit
|
14419 |
|
|
DEC BC ; counter itself
|
14420 |
|
|
INC HL ; point to next location the 16-bit counter
|
14421 |
|
|
LD (HL),C ; insert low byte
|
14422 |
|
|
INC HL ; address next
|
14423 |
|
|
LD (HL),B ; insert high byte
|
14424 |
|
|
|
14425 |
|
|
POP BC ; pop the number of dimensions.
|
14426 |
|
|
LD A,B ; dimensions to A
|
14427 |
|
|
INC HL ; address next
|
14428 |
|
|
LD (HL),A ; and insert "No. of dims"
|
14429 |
|
|
|
14430 |
|
|
LD H,D ; transfer DE space + 1 from make-room
|
14431 |
|
|
LD L,E ; to HL
|
14432 |
|
|
DEC DE ; set DE to next location down.
|
14433 |
|
|
LD (HL),$00 ; presume numeric and insert a zero
|
14434 |
|
|
BIT 6,C ; test bit 6 of C. numeric or string ?
|
14435 |
|
|
JR Z,L2C7C ; skip to DIM-CLEAR if numeric
|
14436 |
|
|
|
14437 |
|
|
LD (HL),$20 ; place a space character in HL
|
14438 |
|
|
|
14439 |
|
|
;; DIM-CLEAR
|
14440 |
|
|
L2C7C: POP BC ; pop the data length
|
14441 |
|
|
|
14442 |
|
|
LDDR ; LDDR sets to zeros or spaces
|
14443 |
|
|
|
14444 |
|
|
; The number of dimensions is still in A.
|
14445 |
|
|
; A loop is now entered to insert the size of each dimension that was pushed
|
14446 |
|
|
; during the D-NO-LOOP working downwards from position before start of data.
|
14447 |
|
|
|
14448 |
|
|
;; DIM-SIZES
|
14449 |
|
|
L2C7F: POP BC ; pop a dimension size ***
|
14450 |
|
|
LD (HL),B ; insert high byte at position
|
14451 |
|
|
DEC HL ; next location down
|
14452 |
|
|
LD (HL),C ; insert low byte
|
14453 |
|
|
DEC HL ; next location down
|
14454 |
|
|
DEC A ; decrement dimension counter
|
14455 |
|
|
JR NZ,L2C7F ; back to DIM-SIZES until all done.
|
14456 |
|
|
|
14457 |
|
|
RET ; return.
|
14458 |
|
|
|
14459 |
|
|
; -----------------------------
|
14460 |
|
|
; Check whether digit or letter
|
14461 |
|
|
; -----------------------------
|
14462 |
|
|
; This routine checks that the character in A is alphanumeric
|
14463 |
|
|
; returning with carry set if so.
|
14464 |
|
|
|
14465 |
|
|
;; ALPHANUM
|
14466 |
|
|
L2C88: CALL L2D1B ; routine NUMERIC will reset carry if so.
|
14467 |
|
|
CCF ; Complement Carry Flag
|
14468 |
|
|
RET C ; Return if numeric else continue into
|
14469 |
|
|
; next routine.
|
14470 |
|
|
|
14471 |
|
|
; This routine checks that the character in A is alphabetic
|
14472 |
|
|
|
14473 |
|
|
;; ALPHA
|
14474 |
|
|
L2C8D: CP $41 ; less than 'A' ?
|
14475 |
|
|
CCF ; Complement Carry Flag
|
14476 |
|
|
RET NC ; return if so
|
14477 |
|
|
|
14478 |
|
|
CP $5B ; less than 'Z'+1 ?
|
14479 |
|
|
RET C ; is within first range
|
14480 |
|
|
|
14481 |
|
|
CP $61 ; less than 'a' ?
|
14482 |
|
|
CCF ; Complement Carry Flag
|
14483 |
|
|
RET NC ; return if so.
|
14484 |
|
|
|
14485 |
|
|
CP $7B ; less than 'z'+1 ?
|
14486 |
|
|
RET ; carry set if within a-z.
|
14487 |
|
|
|
14488 |
|
|
; -------------------------
|
14489 |
|
|
; Decimal to floating point
|
14490 |
|
|
; -------------------------
|
14491 |
|
|
; This routine finds the floating point number represented by an expression
|
14492 |
|
|
; beginning with BIN, '.' or a digit.
|
14493 |
|
|
; Note that BIN need not have any '0's or '1's after it.
|
14494 |
|
|
; BIN is really just a notational symbol and not a function.
|
14495 |
|
|
|
14496 |
|
|
;; DEC-TO-FP
|
14497 |
|
|
L2C9B: CP $C4 ; 'BIN' token ?
|
14498 |
|
|
JR NZ,L2CB8 ; to NOT-BIN if not
|
14499 |
|
|
|
14500 |
|
|
LD DE,$0000 ; initialize 16 bit buffer register.
|
14501 |
|
|
|
14502 |
|
|
;; BIN-DIGIT
|
14503 |
|
|
L2CA2: RST 20H ; NEXT-CHAR
|
14504 |
|
|
SUB $31 ; '1'
|
14505 |
|
|
ADC A,$00 ; will be zero if '1' or '0'
|
14506 |
|
|
; carry will be set if was '0'
|
14507 |
|
|
JR NZ,L2CB3 ; forward to BIN-END if result not zero
|
14508 |
|
|
|
14509 |
|
|
EX DE,HL ; buffer to HL
|
14510 |
|
|
CCF ; Carry now set if originally '1'
|
14511 |
|
|
ADC HL,HL ; shift the carry into HL
|
14512 |
|
|
JP C,L31AD ; to REPORT-6 if overflow - too many digits
|
14513 |
|
|
; after first '1'. There can be an unlimited
|
14514 |
|
|
; number of leading zeros.
|
14515 |
|
|
; 'Number too big' - raise an error
|
14516 |
|
|
|
14517 |
|
|
EX DE,HL ; save the buffer
|
14518 |
|
|
JR L2CA2 ; back to BIN-DIGIT for more digits
|
14519 |
|
|
|
14520 |
|
|
; ---
|
14521 |
|
|
|
14522 |
|
|
;; BIN-END
|
14523 |
|
|
L2CB3: LD B,D ; transfer 16 bit buffer
|
14524 |
|
|
LD C,E ; to BC register pair.
|
14525 |
|
|
JP L2D2B ; JUMP to STACK-BC to put on calculator stack
|
14526 |
|
|
|
14527 |
|
|
; ---
|
14528 |
|
|
|
14529 |
|
|
; continue here with .1, 42, 3.14, 5., 2.3 E -4
|
14530 |
|
|
|
14531 |
|
|
;; NOT-BIN
|
14532 |
|
|
L2CB8: CP $2E ; '.' - leading decimal point ?
|
14533 |
|
|
JR Z,L2CCB ; skip to DECIMAL if so.
|
14534 |
|
|
|
14535 |
|
|
CALL L2D3B ; routine INT-TO-FP to evaluate all digits
|
14536 |
|
|
; This number 'x' is placed on stack.
|
14537 |
|
|
CP $2E ; '.' - mid decimal point ?
|
14538 |
|
|
|
14539 |
|
|
JR NZ,L2CEB ; to E-FORMAT if not to consider that format
|
14540 |
|
|
|
14541 |
|
|
RST 20H ; NEXT-CHAR
|
14542 |
|
|
CALL L2D1B ; routine NUMERIC returns carry reset if 0-9
|
14543 |
|
|
|
14544 |
|
|
JR C,L2CEB ; to E-FORMAT if not a digit e.g. '1.'
|
14545 |
|
|
|
14546 |
|
|
JR L2CD5 ; to DEC-STO-1 to add the decimal part to 'x'
|
14547 |
|
|
|
14548 |
|
|
; ---
|
14549 |
|
|
|
14550 |
|
|
; a leading decimal point has been found in a number.
|
14551 |
|
|
|
14552 |
|
|
;; DECIMAL
|
14553 |
|
|
L2CCB: RST 20H ; NEXT-CHAR
|
14554 |
|
|
CALL L2D1B ; routine NUMERIC will reset carry if digit
|
14555 |
|
|
|
14556 |
|
|
;; DEC-RPT-C
|
14557 |
|
|
L2CCF: JP C,L1C8A ; to REPORT-C if just a '.'
|
14558 |
|
|
; raise 'Nonsense in BASIC'
|
14559 |
|
|
|
14560 |
|
|
; since there is no leading zero put one on the calculator stack.
|
14561 |
|
|
|
14562 |
|
|
RST 28H ;; FP-CALC
|
14563 |
|
|
DEFB $A0 ;;stk-zero ; 0.
|
14564 |
|
|
DEFB $38 ;;end-calc
|
14565 |
|
|
|
14566 |
|
|
; If rejoining from earlier there will be a value 'x' on stack.
|
14567 |
|
|
; If continuing from above the value zero.
|
14568 |
|
|
; Now store 1 in mem-0.
|
14569 |
|
|
; Note. At each pass of the digit loop this will be divided by ten.
|
14570 |
|
|
|
14571 |
|
|
;; DEC-STO-1
|
14572 |
|
|
L2CD5: RST 28H ;; FP-CALC
|
14573 |
|
|
DEFB $A1 ;;stk-one ;x or 0,1.
|
14574 |
|
|
DEFB $C0 ;;st-mem-0 ;x or 0,1.
|
14575 |
|
|
DEFB $02 ;;delete ;x or 0.
|
14576 |
|
|
DEFB $38 ;;end-calc
|
14577 |
|
|
|
14578 |
|
|
|
14579 |
|
|
;; NXT-DGT-1
|
14580 |
|
|
L2CDA: RST 18H ; GET-CHAR
|
14581 |
|
|
CALL L2D22 ; routine STK-DIGIT stacks single digit 'd'
|
14582 |
|
|
JR C,L2CEB ; exit to E-FORMAT when digits exhausted >
|
14583 |
|
|
|
14584 |
|
|
|
14585 |
|
|
RST 28H ;; FP-CALC ;x or 0,d. first pass.
|
14586 |
|
|
DEFB $E0 ;;get-mem-0 ;x or 0,d,1.
|
14587 |
|
|
DEFB $A4 ;;stk-ten ;x or 0,d,1,10.
|
14588 |
|
|
DEFB $05 ;;division ;x or 0,d,1/10.
|
14589 |
|
|
DEFB $C0 ;;st-mem-0 ;x or 0,d,1/10.
|
14590 |
|
|
DEFB $04 ;;multiply ;x or 0,d/10.
|
14591 |
|
|
DEFB $0F ;;addition ;x or 0 + d/10.
|
14592 |
|
|
DEFB $38 ;;end-calc last value.
|
14593 |
|
|
|
14594 |
|
|
RST 20H ; NEXT-CHAR moves to next character
|
14595 |
|
|
JR L2CDA ; back to NXT-DGT-1
|
14596 |
|
|
|
14597 |
|
|
; ---
|
14598 |
|
|
|
14599 |
|
|
; although only the first pass is shown it can be seen that at each pass
|
14600 |
|
|
; the new less significant digit is multiplied by an increasingly smaller
|
14601 |
|
|
; factor (1/100, 1/1000, 1/10000 ... ) before being added to the previous
|
14602 |
|
|
; last value to form a new last value.
|
14603 |
|
|
|
14604 |
|
|
; Finally see if an exponent has been input.
|
14605 |
|
|
|
14606 |
|
|
;; E-FORMAT
|
14607 |
|
|
L2CEB: CP $45 ; is character 'E' ?
|
14608 |
|
|
JR Z,L2CF2 ; to SIGN-FLAG if so
|
14609 |
|
|
|
14610 |
|
|
CP $65 ; 'e' is acceptable as well.
|
14611 |
|
|
RET NZ ; return as no exponent.
|
14612 |
|
|
|
14613 |
|
|
;; SIGN-FLAG
|
14614 |
|
|
L2CF2: LD B,$FF ; initialize temporary sign byte to $FF
|
14615 |
|
|
|
14616 |
|
|
RST 20H ; NEXT-CHAR
|
14617 |
|
|
CP $2B ; is character '+' ?
|
14618 |
|
|
JR Z,L2CFE ; to SIGN-DONE
|
14619 |
|
|
|
14620 |
|
|
CP $2D ; is character '-' ?
|
14621 |
|
|
JR NZ,L2CFF ; to ST-E-PART as no sign
|
14622 |
|
|
|
14623 |
|
|
INC B ; set sign to zero
|
14624 |
|
|
|
14625 |
|
|
; now consider digits of exponent.
|
14626 |
|
|
; Note. incidentally this is the only occasion in Spectrum BASIC when an
|
14627 |
|
|
; expression may not be used when a number is expected.
|
14628 |
|
|
|
14629 |
|
|
;; SIGN-DONE
|
14630 |
|
|
L2CFE: RST 20H ; NEXT-CHAR
|
14631 |
|
|
|
14632 |
|
|
;; ST-E-PART
|
14633 |
|
|
L2CFF: CALL L2D1B ; routine NUMERIC
|
14634 |
|
|
JR C,L2CCF ; to DEC-RPT-C if not
|
14635 |
|
|
; raise 'Nonsense in BASIC'.
|
14636 |
|
|
|
14637 |
|
|
PUSH BC ; save sign (in B)
|
14638 |
|
|
CALL L2D3B ; routine INT-TO-FP places exponent on stack
|
14639 |
|
|
CALL L2DD5 ; routine FP-TO-A transfers it to A
|
14640 |
|
|
POP BC ; restore sign
|
14641 |
|
|
JP C,L31AD ; to REPORT-6 if overflow (over 255)
|
14642 |
|
|
; raise 'Number too big'.
|
14643 |
|
|
|
14644 |
|
|
AND A ; set flags
|
14645 |
|
|
JP M,L31AD ; to REPORT-6 if over '127'.
|
14646 |
|
|
; raise 'Number too big'.
|
14647 |
|
|
; 127 is still way too high and it is
|
14648 |
|
|
; impossible to enter an exponent greater
|
14649 |
|
|
; than 39 from the keyboard. The error gets
|
14650 |
|
|
; raised later in E-TO-FP so two different
|
14651 |
|
|
; error messages depending how high A is.
|
14652 |
|
|
|
14653 |
|
|
INC B ; $FF to $00 or $00 to $01 - expendable now.
|
14654 |
|
|
JR Z,L2D18 ; forward to E-FP-JUMP if exponent positive
|
14655 |
|
|
|
14656 |
|
|
NEG ; Negate the exponent.
|
14657 |
|
|
|
14658 |
|
|
;; E-FP-JUMP
|
14659 |
|
|
L2D18: JP L2D4F ; JUMP forward to E-TO-FP to assign to
|
14660 |
|
|
; last value x on stack x * 10 to power A
|
14661 |
|
|
; a relative jump would have done.
|
14662 |
|
|
|
14663 |
|
|
; ---------------------
|
14664 |
|
|
; Check for valid digit
|
14665 |
|
|
; ---------------------
|
14666 |
|
|
; This routine checks that the ASCII character in A is numeric
|
14667 |
|
|
; returning with carry reset if so.
|
14668 |
|
|
|
14669 |
|
|
;; NUMERIC
|
14670 |
|
|
L2D1B: CP $30 ; '0'
|
14671 |
|
|
RET C ; return if less than zero character.
|
14672 |
|
|
|
14673 |
|
|
CP $3A ; The upper test is '9'
|
14674 |
|
|
CCF ; Complement Carry Flag
|
14675 |
|
|
RET ; Return - carry clear if character '0' - '9'
|
14676 |
|
|
|
14677 |
|
|
; -----------
|
14678 |
|
|
; Stack Digit
|
14679 |
|
|
; -----------
|
14680 |
|
|
; This subroutine is called from INT-TO-FP and DEC-TO-FP to stack a digit
|
14681 |
|
|
; on the calculator stack.
|
14682 |
|
|
|
14683 |
|
|
;; STK-DIGIT
|
14684 |
|
|
L2D22: CALL L2D1B ; routine NUMERIC
|
14685 |
|
|
RET C ; return if not numeric character
|
14686 |
|
|
|
14687 |
|
|
SUB $30 ; convert from ASCII to digit
|
14688 |
|
|
|
14689 |
|
|
; -----------------
|
14690 |
|
|
; Stack accumulator
|
14691 |
|
|
; -----------------
|
14692 |
|
|
;
|
14693 |
|
|
;
|
14694 |
|
|
|
14695 |
|
|
;; STACK-A
|
14696 |
|
|
L2D28: LD C,A ; transfer to C
|
14697 |
|
|
LD B,$00 ; and make B zero
|
14698 |
|
|
|
14699 |
|
|
; ----------------------
|
14700 |
|
|
; Stack BC register pair
|
14701 |
|
|
; ----------------------
|
14702 |
|
|
;
|
14703 |
|
|
|
14704 |
|
|
;; STACK-BC
|
14705 |
|
|
L2D2B: LD IY,$5C3A ; re-initialize ERR_NR
|
14706 |
|
|
|
14707 |
|
|
XOR A ; clear to signal small integer
|
14708 |
|
|
LD E,A ; place in E for sign
|
14709 |
|
|
LD D,C ; LSB to D
|
14710 |
|
|
LD C,B ; MSB to C
|
14711 |
|
|
LD B,A ; last byte not used
|
14712 |
|
|
CALL L2AB6 ; routine STK-STORE
|
14713 |
|
|
|
14714 |
|
|
RST 28H ;; FP-CALC
|
14715 |
|
|
DEFB $38 ;;end-calc make HL = STKEND-5
|
14716 |
|
|
|
14717 |
|
|
AND A ; clear carry
|
14718 |
|
|
RET ; before returning
|
14719 |
|
|
|
14720 |
|
|
; -------------------------
|
14721 |
|
|
; Integer to floating point
|
14722 |
|
|
; -------------------------
|
14723 |
|
|
; This routine places one or more digits found in a BASIC line
|
14724 |
|
|
; on the calculator stack multiplying the previous value by ten each time
|
14725 |
|
|
; before adding in the new digit to form a last value on calculator stack.
|
14726 |
|
|
|
14727 |
|
|
;; INT-TO-FP
|
14728 |
|
|
L2D3B: PUSH AF ; save first character
|
14729 |
|
|
|
14730 |
|
|
RST 28H ;; FP-CALC
|
14731 |
|
|
DEFB $A0 ;;stk-zero ; v=0. initial value
|
14732 |
|
|
DEFB $38 ;;end-calc
|
14733 |
|
|
|
14734 |
|
|
POP AF ; fetch first character back.
|
14735 |
|
|
|
14736 |
|
|
;; NXT-DGT-2
|
14737 |
|
|
L2D40: CALL L2D22 ; routine STK-DIGIT puts 0-9 on stack
|
14738 |
|
|
RET C ; will return when character is not numeric >
|
14739 |
|
|
|
14740 |
|
|
RST 28H ;; FP-CALC ; v, d.
|
14741 |
|
|
DEFB $01 ;;exchange ; d, v.
|
14742 |
|
|
DEFB $A4 ;;stk-ten ; d, v, 10.
|
14743 |
|
|
DEFB $04 ;;multiply ; d, v*10.
|
14744 |
|
|
DEFB $0F ;;addition ; d + v*10 = newvalue
|
14745 |
|
|
DEFB $38 ;;end-calc ; v.
|
14746 |
|
|
|
14747 |
|
|
CALL L0074 ; routine CH-ADD+1 get next character
|
14748 |
|
|
JR L2D40 ; back to NXT-DGT-2 to process as a digit
|
14749 |
|
|
|
14750 |
|
|
|
14751 |
|
|
;*********************************
|
14752 |
|
|
;** Part 9. ARITHMETIC ROUTINES **
|
14753 |
|
|
;*********************************
|
14754 |
|
|
|
14755 |
|
|
; --------------------------
|
14756 |
|
|
; E-format to floating point
|
14757 |
|
|
; --------------------------
|
14758 |
|
|
; This subroutine is used by the PRINT-FP routine and the decimal to FP
|
14759 |
|
|
; routines to stack a number expressed in exponent format.
|
14760 |
|
|
; Note. Though not used by the ROM as such, it has also been set up as
|
14761 |
|
|
; a unary calculator literal but this will not work as the accumulator
|
14762 |
|
|
; is not available from within the calculator.
|
14763 |
|
|
|
14764 |
|
|
; on entry there is a value x on the calculator stack and an exponent of ten
|
14765 |
|
|
; in A. The required value is x + 10 ^ A
|
14766 |
|
|
|
14767 |
|
|
;; e-to-fp
|
14768 |
|
|
;; E-TO-FP
|
14769 |
|
|
L2D4F: RLCA ; this will set the x.
|
14770 |
|
|
RRCA ; carry if bit 7 is set
|
14771 |
|
|
|
14772 |
|
|
JR NC,L2D55 ; to E-SAVE if positive.
|
14773 |
|
|
|
14774 |
|
|
CPL ; make negative positive
|
14775 |
|
|
INC A ; without altering carry.
|
14776 |
|
|
|
14777 |
|
|
;; E-SAVE
|
14778 |
|
|
L2D55: PUSH AF ; save positive exp and sign in carry
|
14779 |
|
|
|
14780 |
|
|
LD HL,$5C92 ; address MEM-0
|
14781 |
|
|
|
14782 |
|
|
CALL L350B ; routine FP-0/1
|
14783 |
|
|
; places an integer zero, if no carry,
|
14784 |
|
|
; else a one in mem-0 as a sign flag
|
14785 |
|
|
|
14786 |
|
|
RST 28H ;; FP-CALC
|
14787 |
|
|
DEFB $A4 ;;stk-ten x, 10.
|
14788 |
|
|
DEFB $38 ;;end-calc
|
14789 |
|
|
|
14790 |
|
|
POP AF ; pop the exponent.
|
14791 |
|
|
|
14792 |
|
|
; now enter a loop
|
14793 |
|
|
|
14794 |
|
|
;; E-LOOP
|
14795 |
|
|
L2D60: SRL A ; 0>76543210>C
|
14796 |
|
|
|
14797 |
|
|
JR NC,L2D71 ; forward to E-TST-END if no bit
|
14798 |
|
|
|
14799 |
|
|
PUSH AF ; save shifted exponent.
|
14800 |
|
|
|
14801 |
|
|
RST 28H ;; FP-CALC
|
14802 |
|
|
DEFB $C1 ;;st-mem-1 x, 10.
|
14803 |
|
|
DEFB $E0 ;;get-mem-0 x, 10, (0/1).
|
14804 |
|
|
DEFB $00 ;;jump-true
|
14805 |
|
|
|
14806 |
|
|
DEFB $04 ;;to L2D6D, E-DIVSN
|
14807 |
|
|
|
14808 |
|
|
DEFB $04 ;;multiply x*10.
|
14809 |
|
|
DEFB $33 ;;jump
|
14810 |
|
|
|
14811 |
|
|
DEFB $02 ;;to L2D6E, E-FETCH
|
14812 |
|
|
|
14813 |
|
|
;; E-DIVSN
|
14814 |
|
|
L2D6D: DEFB $05 ;;division x/10.
|
14815 |
|
|
|
14816 |
|
|
;; E-FETCH
|
14817 |
|
|
L2D6E: DEFB $E1 ;;get-mem-1 x/10 or x*10, 10.
|
14818 |
|
|
DEFB $38 ;;end-calc new x, 10.
|
14819 |
|
|
|
14820 |
|
|
POP AF ; restore shifted exponent
|
14821 |
|
|
|
14822 |
|
|
; the loop branched to here with no carry
|
14823 |
|
|
|
14824 |
|
|
;; E-TST-END
|
14825 |
|
|
L2D71: JR Z,L2D7B ; forward to E-END if A emptied of bits
|
14826 |
|
|
|
14827 |
|
|
PUSH AF ; re-save shifted exponent
|
14828 |
|
|
|
14829 |
|
|
RST 28H ;; FP-CALC
|
14830 |
|
|
DEFB $31 ;;duplicate new x, 10, 10.
|
14831 |
|
|
DEFB $04 ;;multiply new x, 100.
|
14832 |
|
|
DEFB $38 ;;end-calc
|
14833 |
|
|
|
14834 |
|
|
POP AF ; restore shifted exponent
|
14835 |
|
|
JR L2D60 ; back to E-LOOP until all bits done.
|
14836 |
|
|
|
14837 |
|
|
; ---
|
14838 |
|
|
|
14839 |
|
|
; although only the first pass is shown it can be seen that for each set bit
|
14840 |
|
|
; representing a power of two, x is multiplied or divided by the
|
14841 |
|
|
; corresponding power of ten.
|
14842 |
|
|
|
14843 |
|
|
;; E-END
|
14844 |
|
|
L2D7B: RST 28H ;; FP-CALC final x, factor.
|
14845 |
|
|
DEFB $02 ;;delete final x.
|
14846 |
|
|
DEFB $38 ;;end-calc x.
|
14847 |
|
|
|
14848 |
|
|
RET ; return
|
14849 |
|
|
|
14850 |
|
|
|
14851 |
|
|
|
14852 |
|
|
|
14853 |
|
|
; -------------
|
14854 |
|
|
; Fetch integer
|
14855 |
|
|
; -------------
|
14856 |
|
|
; This routine is called by the mathematical routines - FP-TO-BC, PRINT-FP,
|
14857 |
|
|
; mult, re-stack and negate to fetch an integer from address HL.
|
14858 |
|
|
; HL points to the stack or a location in MEM and no deletion occurs.
|
14859 |
|
|
; If the number is negative then a similar process to that used in INT-STORE
|
14860 |
|
|
; is used to restore the twos complement number to normal in DE and a sign
|
14861 |
|
|
; in C.
|
14862 |
|
|
|
14863 |
|
|
;; INT-FETCH
|
14864 |
|
|
L2D7F: INC HL ; skip zero indicator.
|
14865 |
|
|
LD C,(HL) ; fetch sign to C
|
14866 |
|
|
INC HL ; address low byte
|
14867 |
|
|
LD A,(HL) ; fetch to A
|
14868 |
|
|
XOR C ; two's complement
|
14869 |
|
|
SUB C ;
|
14870 |
|
|
LD E,A ; place in E
|
14871 |
|
|
INC HL ; address high byte
|
14872 |
|
|
LD A,(HL) ; fetch to A
|
14873 |
|
|
ADC A,C ; two's complement
|
14874 |
|
|
XOR C ;
|
14875 |
|
|
LD D,A ; place in D
|
14876 |
|
|
RET ; return
|
14877 |
|
|
|
14878 |
|
|
; ------------------------
|
14879 |
|
|
; Store a positive integer
|
14880 |
|
|
; ------------------------
|
14881 |
|
|
; This entry point is not used in this ROM but would
|
14882 |
|
|
; store any integer as positive.
|
14883 |
|
|
|
14884 |
|
|
;; p-int-sto
|
14885 |
|
|
L2D8C: LD C,$00 ; make sign byte positive and continue
|
14886 |
|
|
|
14887 |
|
|
; -------------
|
14888 |
|
|
; Store integer
|
14889 |
|
|
; -------------
|
14890 |
|
|
; this routine stores an integer in DE at address HL.
|
14891 |
|
|
; It is called from mult, truncate, negate and sgn.
|
14892 |
|
|
; The sign byte $00 +ve or $FF -ve is in C.
|
14893 |
|
|
; If negative, the number is stored in 2's complement form so that it is
|
14894 |
|
|
; ready to be added.
|
14895 |
|
|
|
14896 |
|
|
;; INT-STORE
|
14897 |
|
|
L2D8E: PUSH HL ; preserve HL
|
14898 |
|
|
|
14899 |
|
|
LD (HL),$00 ; first byte zero shows integer not exponent
|
14900 |
|
|
INC HL ;
|
14901 |
|
|
LD (HL),C ; then store the sign byte
|
14902 |
|
|
INC HL ;
|
14903 |
|
|
; e.g. +1 -1
|
14904 |
|
|
LD A,E ; fetch low byte 00000001 00000001
|
14905 |
|
|
XOR C ; xor sign 00000000 or 11111111
|
14906 |
|
|
; gives 00000001 or 11111110
|
14907 |
|
|
SUB C ; sub sign 00000000 or 11111111
|
14908 |
|
|
; gives 00000001>0 or 11111111>C
|
14909 |
|
|
LD (HL),A ; store 2's complement.
|
14910 |
|
|
INC HL ;
|
14911 |
|
|
LD A,D ; high byte 00000000 00000000
|
14912 |
|
|
ADC A,C ; sign 00000000<0 11111111
|
14913 |
|
|
; gives 00000000 or 00000000
|
14914 |
|
|
XOR C ; xor sign 00000000 11111111
|
14915 |
|
|
LD (HL),A ; store 2's complement.
|
14916 |
|
|
INC HL ;
|
14917 |
|
|
LD (HL),$00 ; last byte always zero for integers.
|
14918 |
|
|
; is not used and need not be looked at when
|
14919 |
|
|
; testing for zero but comes into play should
|
14920 |
|
|
; an integer be converted to fp.
|
14921 |
|
|
POP HL ; restore HL
|
14922 |
|
|
RET ; return.
|
14923 |
|
|
|
14924 |
|
|
|
14925 |
|
|
; -----------------------------
|
14926 |
|
|
; Floating point to BC register
|
14927 |
|
|
; -----------------------------
|
14928 |
|
|
; This routine gets a floating point number e.g. 127.4 from the calculator
|
14929 |
|
|
; stack to the BC register.
|
14930 |
|
|
|
14931 |
|
|
;; FP-TO-BC
|
14932 |
|
|
L2DA2: RST 28H ;; FP-CALC set HL to
|
14933 |
|
|
DEFB $38 ;;end-calc point to last value.
|
14934 |
|
|
|
14935 |
|
|
LD A,(HL) ; get first of 5 bytes
|
14936 |
|
|
AND A ; and test
|
14937 |
|
|
JR Z,L2DAD ; forward to FP-DELETE if an integer
|
14938 |
|
|
|
14939 |
|
|
; The value is first rounded up and then converted to integer.
|
14940 |
|
|
|
14941 |
|
|
RST 28H ;; FP-CALC x.
|
14942 |
|
|
DEFB $A2 ;;stk-half x. 1/2.
|
14943 |
|
|
DEFB $0F ;;addition x + 1/2.
|
14944 |
|
|
DEFB $27 ;;int int(x + .5)
|
14945 |
|
|
DEFB $38 ;;end-calc
|
14946 |
|
|
|
14947 |
|
|
; now delete but leave HL pointing at integer
|
14948 |
|
|
|
14949 |
|
|
;; FP-DELETE
|
14950 |
|
|
L2DAD: RST 28H ;; FP-CALC
|
14951 |
|
|
DEFB $02 ;;delete
|
14952 |
|
|
DEFB $38 ;;end-calc
|
14953 |
|
|
|
14954 |
|
|
PUSH HL ; save pointer.
|
14955 |
|
|
PUSH DE ; and STKEND.
|
14956 |
|
|
EX DE,HL ; make HL point to exponent/zero indicator
|
14957 |
|
|
LD B,(HL) ; indicator to B
|
14958 |
|
|
CALL L2D7F ; routine INT-FETCH
|
14959 |
|
|
; gets int in DE sign byte to C
|
14960 |
|
|
; but meaningless values if a large integer
|
14961 |
|
|
|
14962 |
|
|
XOR A ; clear A
|
14963 |
|
|
SUB B ; subtract indicator byte setting carry
|
14964 |
|
|
; if not a small integer.
|
14965 |
|
|
|
14966 |
|
|
BIT 7,C ; test a bit of the sign byte setting zero
|
14967 |
|
|
; if positive.
|
14968 |
|
|
|
14969 |
|
|
LD B,D ; transfer int
|
14970 |
|
|
LD C,E ; to BC
|
14971 |
|
|
LD A,E ; low byte to A as a useful return value.
|
14972 |
|
|
|
14973 |
|
|
POP DE ; pop STKEND
|
14974 |
|
|
POP HL ; and pointer to last value
|
14975 |
|
|
RET ; return
|
14976 |
|
|
; if carry is set then the number was too big.
|
14977 |
|
|
|
14978 |
|
|
; ------------
|
14979 |
|
|
; LOG(2^A)
|
14980 |
|
|
; ------------
|
14981 |
|
|
; This routine is used when printing floating point numbers to calculate
|
14982 |
|
|
; the number of digits before the decimal point.
|
14983 |
|
|
|
14984 |
|
|
; first convert a one-byte signed integer to its five byte form.
|
14985 |
|
|
|
14986 |
|
|
;; LOG(2^A)
|
14987 |
|
|
L2DC1: LD D,A ; store a copy of A in D.
|
14988 |
|
|
RLA ; test sign bit of A.
|
14989 |
|
|
SBC A,A ; now $FF if negative or $00
|
14990 |
|
|
LD E,A ; sign byte to E.
|
14991 |
|
|
LD C,A ; and to C
|
14992 |
|
|
XOR A ; clear A
|
14993 |
|
|
LD B,A ; and B.
|
14994 |
|
|
CALL L2AB6 ; routine STK-STORE stacks number AEDCB
|
14995 |
|
|
|
14996 |
|
|
; so 00 00 XX 00 00 (positive) or 00 FF XX FF 00 (negative).
|
14997 |
|
|
; i.e. integer indicator, sign byte, low, high, unused.
|
14998 |
|
|
|
14999 |
|
|
; now multiply exponent by log to the base 10 of two.
|
15000 |
|
|
|
15001 |
|
|
RST 28H ;; FP-CALC
|
15002 |
|
|
|
15003 |
|
|
DEFB $34 ;;stk-data .30103 (log 2)
|
15004 |
|
|
DEFB $EF ;;Exponent: $7F, Bytes: 4
|
15005 |
|
|
DEFB $1A,$20,$9A,$85 ;;
|
15006 |
|
|
DEFB $04 ;;multiply
|
15007 |
|
|
|
15008 |
|
|
DEFB $27 ;;int
|
15009 |
|
|
|
15010 |
|
|
DEFB $38 ;;end-calc
|
15011 |
|
|
|
15012 |
|
|
; -------------------
|
15013 |
|
|
; Floating point to A
|
15014 |
|
|
; -------------------
|
15015 |
|
|
; this routine collects a floating point number from the stack into the
|
15016 |
|
|
; accumulator returning carry set if not in range 0 - 255.
|
15017 |
|
|
; Not all the calling routines raise an error with overflow so no attempt
|
15018 |
|
|
; is made to produce an error report here.
|
15019 |
|
|
|
15020 |
|
|
;; FP-TO-A
|
15021 |
|
|
L2DD5: CALL L2DA2 ; routine FP-TO-BC returns with C in A also.
|
15022 |
|
|
RET C ; return with carry set if > 65535, overflow
|
15023 |
|
|
|
15024 |
|
|
PUSH AF ; save the value and flags
|
15025 |
|
|
DEC B ; and test that
|
15026 |
|
|
INC B ; the high byte is zero.
|
15027 |
|
|
JR Z,L2DE1 ; forward FP-A-END if zero
|
15028 |
|
|
|
15029 |
|
|
; else there has been 8-bit overflow
|
15030 |
|
|
|
15031 |
|
|
POP AF ; retrieve the value
|
15032 |
|
|
SCF ; set carry flag to show overflow
|
15033 |
|
|
RET ; and return.
|
15034 |
|
|
|
15035 |
|
|
; ---
|
15036 |
|
|
|
15037 |
|
|
;; FP-A-END
|
15038 |
|
|
L2DE1: POP AF ; restore value and success flag and
|
15039 |
|
|
RET ; return.
|
15040 |
|
|
|
15041 |
|
|
|
15042 |
|
|
; -----------------------------
|
15043 |
|
|
; Print a floating point number
|
15044 |
|
|
; -----------------------------
|
15045 |
|
|
; Not a trivial task.
|
15046 |
|
|
; Begin by considering whether to print a leading sign for negative numbers.
|
15047 |
|
|
|
15048 |
|
|
;; PRINT-FP
|
15049 |
|
|
L2DE3: RST 28H ;; FP-CALC
|
15050 |
|
|
DEFB $31 ;;duplicate
|
15051 |
|
|
DEFB $36 ;;less-0
|
15052 |
|
|
DEFB $00 ;;jump-true
|
15053 |
|
|
|
15054 |
|
|
DEFB $0B ;;to L2DF2, PF-NEGTVE
|
15055 |
|
|
|
15056 |
|
|
DEFB $31 ;;duplicate
|
15057 |
|
|
DEFB $37 ;;greater-0
|
15058 |
|
|
DEFB $00 ;;jump-true
|
15059 |
|
|
|
15060 |
|
|
DEFB $0D ;;to L2DF8, PF-POSTVE
|
15061 |
|
|
|
15062 |
|
|
; must be zero itself
|
15063 |
|
|
|
15064 |
|
|
DEFB $02 ;;delete
|
15065 |
|
|
DEFB $38 ;;end-calc
|
15066 |
|
|
|
15067 |
|
|
LD A,$30 ; prepare the character '0'
|
15068 |
|
|
|
15069 |
|
|
RST 10H ; PRINT-A
|
15070 |
|
|
RET ; return. ->
|
15071 |
|
|
; ---
|
15072 |
|
|
|
15073 |
|
|
;; PF-NEGTVE
|
15074 |
|
|
L2DF2: DEFB $2A ;;abs
|
15075 |
|
|
DEFB $38 ;;end-calc
|
15076 |
|
|
|
15077 |
|
|
LD A,$2D ; the character '-'
|
15078 |
|
|
|
15079 |
|
|
RST 10H ; PRINT-A
|
15080 |
|
|
|
15081 |
|
|
; and continue to print the now positive number.
|
15082 |
|
|
|
15083 |
|
|
RST 28H ;; FP-CALC
|
15084 |
|
|
|
15085 |
|
|
;; PF-POSTVE
|
15086 |
|
|
L2DF8: DEFB $A0 ;;stk-zero x,0. begin by
|
15087 |
|
|
DEFB $C3 ;;st-mem-3 x,0. clearing a temporary
|
15088 |
|
|
DEFB $C4 ;;st-mem-4 x,0. output buffer to
|
15089 |
|
|
DEFB $C5 ;;st-mem-5 x,0. fifteen zeros.
|
15090 |
|
|
DEFB $02 ;;delete x.
|
15091 |
|
|
DEFB $38 ;;end-calc x.
|
15092 |
|
|
|
15093 |
|
|
EXX ; in case called from 'str$' then save the
|
15094 |
|
|
PUSH HL ; pointer to whatever comes after
|
15095 |
|
|
EXX ; str$ as H'L' will be used.
|
15096 |
|
|
|
15097 |
|
|
; now enter a loop?
|
15098 |
|
|
|
15099 |
|
|
;; PF-LOOP
|
15100 |
|
|
L2E01: RST 28H ;; FP-CALC
|
15101 |
|
|
DEFB $31 ;;duplicate x,x.
|
15102 |
|
|
DEFB $27 ;;int x,int x.
|
15103 |
|
|
DEFB $C2 ;;st-mem-2 x,int x.
|
15104 |
|
|
DEFB $03 ;;subtract x-int x. fractional part.
|
15105 |
|
|
DEFB $E2 ;;get-mem-2 x-int x, int x.
|
15106 |
|
|
DEFB $01 ;;exchange int x, x-int x.
|
15107 |
|
|
DEFB $C2 ;;st-mem-2 int x, x-int x.
|
15108 |
|
|
DEFB $02 ;;delete int x.
|
15109 |
|
|
DEFB $38 ;;end-calc int x.
|
15110 |
|
|
;
|
15111 |
|
|
; mem-2 holds the fractional part.
|
15112 |
|
|
|
15113 |
|
|
; HL points to last value int x
|
15114 |
|
|
|
15115 |
|
|
LD A,(HL) ; fetch exponent of int x.
|
15116 |
|
|
AND A ; test
|
15117 |
|
|
JR NZ,L2E56 ; forward to PF-LARGE if a large integer
|
15118 |
|
|
; > 65535
|
15119 |
|
|
|
15120 |
|
|
; continue with small positive integer components in range 0 - 65535
|
15121 |
|
|
; if original number was say .999 then this integer component is zero.
|
15122 |
|
|
|
15123 |
|
|
CALL L2D7F ; routine INT-FETCH gets x in DE
|
15124 |
|
|
; (but x is not deleted)
|
15125 |
|
|
|
15126 |
|
|
LD B,$10 ; set B, bit counter, to 16d
|
15127 |
|
|
|
15128 |
|
|
LD A,D ; test if
|
15129 |
|
|
AND A ; high byte is zero
|
15130 |
|
|
JR NZ,L2E1E ; forward to PF-SAVE if 16-bit integer.
|
15131 |
|
|
|
15132 |
|
|
; and continue with integer in range 0 - 255.
|
15133 |
|
|
|
15134 |
|
|
OR E ; test the low byte for zero
|
15135 |
|
|
; i.e. originally just point something or other.
|
15136 |
|
|
JR Z,L2E24 ; forward if so to PF-SMALL
|
15137 |
|
|
|
15138 |
|
|
;
|
15139 |
|
|
|
15140 |
|
|
LD D,E ; transfer E to D
|
15141 |
|
|
LD B,$08 ; and reduce the bit counter to 8.
|
15142 |
|
|
|
15143 |
|
|
;; PF-SAVE
|
15144 |
|
|
L2E1E: PUSH DE ; save the part before decimal point.
|
15145 |
|
|
EXX ;
|
15146 |
|
|
POP DE ; and pop in into D'E'
|
15147 |
|
|
EXX ;
|
15148 |
|
|
JR L2E7B ; forward to PF-BITS
|
15149 |
|
|
|
15150 |
|
|
; ---------------------
|
15151 |
|
|
|
15152 |
|
|
; the branch was here when 'int x' was found to be zero as in say 0.5.
|
15153 |
|
|
; The zero has been fetched from the calculator stack but not deleted and
|
15154 |
|
|
; this should occur now. This omission leaves the stack unbalanced and while
|
15155 |
|
|
; that causes no problems with a simple PRINT statement, it will if str$ is
|
15156 |
|
|
; being used in an expression e.g. "2" + STR$ 0.5 gives the result "0.5"
|
15157 |
|
|
; instead of the expected result "20.5".
|
15158 |
|
|
; credit Tony Stratton, 1982.
|
15159 |
|
|
; A DEFB 02 delete is required immediately on using the calculator.
|
15160 |
|
|
|
15161 |
|
|
;; PF-SMALL
|
15162 |
|
|
L2E24: RST 28H ;; FP-CALC int x = 0.
|
15163 |
|
|
L2E25: DEFB $E2 ;;get-mem-2 int x = 0, x-int x.
|
15164 |
|
|
DEFB $38 ;;end-calc
|
15165 |
|
|
|
15166 |
|
|
LD A,(HL) ; fetch exponent of positive fractional number
|
15167 |
|
|
SUB $7E ; subtract
|
15168 |
|
|
|
15169 |
|
|
CALL L2DC1 ; routine LOG(2^A) calculates leading digits.
|
15170 |
|
|
|
15171 |
|
|
LD D,A ; transfer count to D
|
15172 |
|
|
LD A,($5CAC) ; fetch total MEM-5-1
|
15173 |
|
|
SUB D ;
|
15174 |
|
|
LD ($5CAC),A ; MEM-5-1
|
15175 |
|
|
LD A,D ;
|
15176 |
|
|
CALL L2D4F ; routine E-TO-FP
|
15177 |
|
|
|
15178 |
|
|
RST 28H ;; FP-CALC
|
15179 |
|
|
DEFB $31 ;;duplicate
|
15180 |
|
|
DEFB $27 ;;int
|
15181 |
|
|
DEFB $C1 ;;st-mem-1
|
15182 |
|
|
DEFB $03 ;;subtract
|
15183 |
|
|
DEFB $E1 ;;get-mem-1
|
15184 |
|
|
DEFB $38 ;;end-calc
|
15185 |
|
|
|
15186 |
|
|
CALL L2DD5 ; routine FP-TO-A
|
15187 |
|
|
|
15188 |
|
|
PUSH HL ; save HL
|
15189 |
|
|
LD ($5CA1),A ; MEM-3-1
|
15190 |
|
|
DEC A ;
|
15191 |
|
|
RLA ;
|
15192 |
|
|
SBC A,A ;
|
15193 |
|
|
INC A ;
|
15194 |
|
|
|
15195 |
|
|
LD HL,$5CAB ; address MEM-5-1 leading digit counter
|
15196 |
|
|
LD (HL),A ; store counter
|
15197 |
|
|
INC HL ; address MEM-5-2 total digits
|
15198 |
|
|
ADD A,(HL) ; add counter to contents
|
15199 |
|
|
LD (HL),A ; and store updated value
|
15200 |
|
|
POP HL ; restore HL
|
15201 |
|
|
|
15202 |
|
|
JP L2ECF ; JUMP forward to PF-FRACTN
|
15203 |
|
|
|
15204 |
|
|
; ---
|
15205 |
|
|
|
15206 |
|
|
; Note. while it would be pedantic to comment on every occasion a JP
|
15207 |
|
|
; instruction could be replaced with a JR instruction, this applies to the
|
15208 |
|
|
; above, which is useful if you wish to correct the unbalanced stack error
|
15209 |
|
|
; by inserting a 'DEFB 02 delete' at L2E25, and maintain main addresses.
|
15210 |
|
|
|
15211 |
|
|
; the branch was here with a large positive integer > 65535 e.g. 123456789
|
15212 |
|
|
; the accumulator holds the exponent.
|
15213 |
|
|
|
15214 |
|
|
;; PF-LARGE
|
15215 |
|
|
L2E56: SUB $80 ; make exponent positive
|
15216 |
|
|
CP $1C ; compare to 28
|
15217 |
|
|
JR C,L2E6F ; to PF-MEDIUM if integer <= 2^27
|
15218 |
|
|
|
15219 |
|
|
CALL L2DC1 ; routine LOG(2^A)
|
15220 |
|
|
SUB $07 ;
|
15221 |
|
|
LD B,A ;
|
15222 |
|
|
LD HL,$5CAC ; address MEM-5-1 the leading digits counter.
|
15223 |
|
|
ADD A,(HL) ; add A to contents
|
15224 |
|
|
LD (HL),A ; store updated value.
|
15225 |
|
|
LD A,B ;
|
15226 |
|
|
NEG ; negate
|
15227 |
|
|
CALL L2D4F ; routine E-TO-FP
|
15228 |
|
|
JR L2E01 ; back to PF-LOOP
|
15229 |
|
|
|
15230 |
|
|
; ----------------------------
|
15231 |
|
|
|
15232 |
|
|
;; PF-MEDIUM
|
15233 |
|
|
L2E6F: EX DE,HL ;
|
15234 |
|
|
CALL L2FBA ; routine FETCH-TWO
|
15235 |
|
|
EXX ;
|
15236 |
|
|
SET 7,D ;
|
15237 |
|
|
LD A,L ;
|
15238 |
|
|
EXX ;
|
15239 |
|
|
SUB $80 ;
|
15240 |
|
|
LD B,A ;
|
15241 |
|
|
|
15242 |
|
|
; the branch was here to handle bits in DE with 8 or 16 in B if small int
|
15243 |
|
|
; and integer in D'E', 6 nibbles will accommodate 065535 but routine does
|
15244 |
|
|
; 32-bit numbers as well from above
|
15245 |
|
|
|
15246 |
|
|
;; PF-BITS
|
15247 |
|
|
L2E7B: SLA E ; C
|
15248 |
|
|
RL D ; C
|
15249 |
|
|
EXX ;
|
15250 |
|
|
RL E ; C
|
15251 |
|
|
RL D ; C
|
15252 |
|
|
EXX ;
|
15253 |
|
|
|
15254 |
|
|
LD HL,$5CAA ; set HL to mem-4-5th last byte of buffer
|
15255 |
|
|
LD C,$05 ; set byte count to 5 - 10 nibbles
|
15256 |
|
|
|
15257 |
|
|
;; PF-BYTES
|
15258 |
|
|
L2E8A: LD A,(HL) ; fetch 0 or prev value
|
15259 |
|
|
ADC A,A ; shift left add in carry C
|
15260 |
|
|
|
15261 |
|
|
DAA ; Decimal Adjust Accumulator.
|
15262 |
|
|
; if greater than 9 then the left hand
|
15263 |
|
|
; nibble is incremented. If greater than
|
15264 |
|
|
; 99 then adjusted and carry set.
|
15265 |
|
|
; so if we'd built up 7 and a carry came in
|
15266 |
|
|
; 0000 0111 < C
|
15267 |
|
|
; 0000 1111
|
15268 |
|
|
; daa 1 0101 which is 15 in BCD
|
15269 |
|
|
|
15270 |
|
|
LD (HL),A ; put back
|
15271 |
|
|
DEC HL ; work down thru mem 4
|
15272 |
|
|
DEC C ; decrease the 5 counter.
|
15273 |
|
|
JR NZ,L2E8A ; back to PF-BYTES until the ten nibbles rolled
|
15274 |
|
|
|
15275 |
|
|
DJNZ L2E7B ; back to PF-BITS until 8 or 16 (or 32) done
|
15276 |
|
|
|
15277 |
|
|
; at most 9 digits for 32-bit number will have been loaded with digits
|
15278 |
|
|
; each of the 9 nibbles in mem 4 is placed into ten bytes in mem-3 and mem 4
|
15279 |
|
|
; unless the nibble is zero as the buffer is already zero.
|
15280 |
|
|
; ( or in the case of mem-5 will become zero as a result of RLD instruction )
|
15281 |
|
|
|
15282 |
|
|
XOR A ; clear to accept
|
15283 |
|
|
LD HL,$5CA6 ; address MEM-4-0 byte destination.
|
15284 |
|
|
LD DE,$5CA1 ; address MEM-3-0 nibble source.
|
15285 |
|
|
LD B,$09 ; the count is 9 (not ten) as the first
|
15286 |
|
|
; nibble is known to be blank.
|
15287 |
|
|
|
15288 |
|
|
RLD ; shift RH nibble to left in (HL)
|
15289 |
|
|
; A (HL)
|
15290 |
|
|
; 0000 0000 < 0000 3210
|
15291 |
|
|
; 0000 0000 3210 0000
|
15292 |
|
|
; A picks up the blank nibble
|
15293 |
|
|
|
15294 |
|
|
|
15295 |
|
|
LD C,$FF ; set a flag to indicate when a significant
|
15296 |
|
|
; digit has been encountered.
|
15297 |
|
|
|
15298 |
|
|
;; PF-DIGITS
|
15299 |
|
|
L2EA1: RLD ; pick up leftmost nibble from (HL)
|
15300 |
|
|
; A (HL)
|
15301 |
|
|
; 0000 0000 < 7654 3210
|
15302 |
|
|
; 0000 7654 3210 0000
|
15303 |
|
|
|
15304 |
|
|
|
15305 |
|
|
JR NZ,L2EA9 ; to PF-INSERT if non-zero value picked up.
|
15306 |
|
|
|
15307 |
|
|
DEC C ; test
|
15308 |
|
|
INC C ; flag
|
15309 |
|
|
JR NZ,L2EB3 ; skip forward to PF-TEST-2 if flag still $FF
|
15310 |
|
|
; indicating this is a leading zero.
|
15311 |
|
|
|
15312 |
|
|
; but if the zero is a significant digit e.g. 10 then include in digit totals.
|
15313 |
|
|
; the path for non-zero digits rejoins here.
|
15314 |
|
|
|
15315 |
|
|
;; PF-INSERT
|
15316 |
|
|
L2EA9: LD (DE),A ; insert digit at destination
|
15317 |
|
|
INC DE ; increase the destination pointer
|
15318 |
|
|
INC (IY+$71) ; increment MEM-5-1st digit counter
|
15319 |
|
|
INC (IY+$72) ; increment MEM-5-2nd leading digit counter
|
15320 |
|
|
LD C,$00 ; set flag to zero indicating that any
|
15321 |
|
|
; subsequent zeros are significant and not
|
15322 |
|
|
; leading.
|
15323 |
|
|
|
15324 |
|
|
;; PF-TEST-2
|
15325 |
|
|
L2EB3: BIT 0,B ; test if the nibble count is even
|
15326 |
|
|
JR Z,L2EB8 ; skip to PF-ALL-9 if so to deal with the
|
15327 |
|
|
; other nibble in the same byte
|
15328 |
|
|
|
15329 |
|
|
INC HL ; point to next source byte if not
|
15330 |
|
|
|
15331 |
|
|
;; PF-ALL-9
|
15332 |
|
|
L2EB8: DJNZ L2EA1 ; decrement the nibble count, back to PF-DIGITS
|
15333 |
|
|
; if all nine not done.
|
15334 |
|
|
|
15335 |
|
|
; For 8-bit integers there will be at most 3 digits.
|
15336 |
|
|
; For 16-bit integers there will be at most 5 digits.
|
15337 |
|
|
; but for larger integers there could be nine leading digits.
|
15338 |
|
|
; if nine digits complete then the last one is rounded up as the number will
|
15339 |
|
|
; be printed using E-format notation
|
15340 |
|
|
|
15341 |
|
|
LD A,($5CAB) ; fetch digit count from MEM-5-1st
|
15342 |
|
|
SUB $09 ; subtract 9 - max possible
|
15343 |
|
|
JR C,L2ECB ; forward if less to PF-MORE
|
15344 |
|
|
|
15345 |
|
|
DEC (IY+$71) ; decrement digit counter MEM-5-1st to 8
|
15346 |
|
|
LD A,$04 ; load A with the value 4.
|
15347 |
|
|
CP (IY+$6F) ; compare with MEM-4-4th - the ninth digit
|
15348 |
|
|
JR L2F0C ; forward to PF-ROUND
|
15349 |
|
|
; to consider rounding.
|
15350 |
|
|
|
15351 |
|
|
; ---------------------------------------
|
15352 |
|
|
|
15353 |
|
|
; now delete int x from calculator stack and fetch fractional part.
|
15354 |
|
|
|
15355 |
|
|
;; PF-MORE
|
15356 |
|
|
L2ECB: RST 28H ;; FP-CALC int x.
|
15357 |
|
|
DEFB $02 ;;delete .
|
15358 |
|
|
DEFB $E2 ;;get-mem-2 x - int x = f.
|
15359 |
|
|
DEFB $38 ;;end-calc f.
|
15360 |
|
|
|
15361 |
|
|
;; PF-FRACTN
|
15362 |
|
|
L2ECF: EX DE,HL ;
|
15363 |
|
|
CALL L2FBA ; routine FETCH-TWO
|
15364 |
|
|
EXX ;
|
15365 |
|
|
LD A,$80 ;
|
15366 |
|
|
SUB L ;
|
15367 |
|
|
LD L,$00 ;
|
15368 |
|
|
SET 7,D ;
|
15369 |
|
|
EXX ;
|
15370 |
|
|
CALL L2FDD ; routine SHIFT-FP
|
15371 |
|
|
|
15372 |
|
|
;; PF-FRN-LP
|
15373 |
|
|
L2EDF: LD A,(IY+$71) ; MEM-5-1st
|
15374 |
|
|
CP $08 ;
|
15375 |
|
|
JR C,L2EEC ; to PF-FR-DGT
|
15376 |
|
|
|
15377 |
|
|
EXX ;
|
15378 |
|
|
RL D ;
|
15379 |
|
|
EXX ;
|
15380 |
|
|
JR L2F0C ; to PF-ROUND
|
15381 |
|
|
|
15382 |
|
|
; ---
|
15383 |
|
|
|
15384 |
|
|
;; PF-FR-DGT
|
15385 |
|
|
L2EEC: LD BC,$0200 ;
|
15386 |
|
|
|
15387 |
|
|
;; PF-FR-EXX
|
15388 |
|
|
L2EEF: LD A,E ;
|
15389 |
|
|
CALL L2F8B ; routine CA-10*A+C
|
15390 |
|
|
LD E,A ;
|
15391 |
|
|
LD A,D ;
|
15392 |
|
|
CALL L2F8B ; routine CA-10*A+C
|
15393 |
|
|
LD D,A ;
|
15394 |
|
|
PUSH BC ;
|
15395 |
|
|
EXX ;
|
15396 |
|
|
POP BC ;
|
15397 |
|
|
DJNZ L2EEF ; to PF-FR-EXX
|
15398 |
|
|
|
15399 |
|
|
LD HL,$5CA1 ; MEM-3
|
15400 |
|
|
LD A,C ;
|
15401 |
|
|
LD C,(IY+$71) ; MEM-5-1st
|
15402 |
|
|
ADD HL,BC ;
|
15403 |
|
|
LD (HL),A ;
|
15404 |
|
|
INC (IY+$71) ; MEM-5-1st
|
15405 |
|
|
JR L2EDF ; to PF-FRN-LP
|
15406 |
|
|
|
15407 |
|
|
; ----------------
|
15408 |
|
|
|
15409 |
|
|
; 1) with 9 digits but 8 in mem-5-1 and A holding 4, carry set if rounding up.
|
15410 |
|
|
; e.g.
|
15411 |
|
|
; 999999999 is printed as 1E+9
|
15412 |
|
|
; 100000001 is printed as 1E+8
|
15413 |
|
|
; 100000009 is printed as 1.0000001E+8
|
15414 |
|
|
|
15415 |
|
|
;; PF-ROUND
|
15416 |
|
|
L2F0C: PUSH AF ; save A and flags
|
15417 |
|
|
LD HL,$5CA1 ; address MEM-3 start of digits
|
15418 |
|
|
LD C,(IY+$71) ; MEM-5-1st No. of digits to C
|
15419 |
|
|
LD B,$00 ; prepare to add
|
15420 |
|
|
ADD HL,BC ; address last digit + 1
|
15421 |
|
|
LD B,C ; No. of digits to B counter
|
15422 |
|
|
POP AF ; restore A and carry flag from comparison.
|
15423 |
|
|
|
15424 |
|
|
;; PF-RND-LP
|
15425 |
|
|
L2F18: DEC HL ; address digit at rounding position.
|
15426 |
|
|
LD A,(HL) ; fetch it
|
15427 |
|
|
ADC A,$00 ; add carry from the comparison
|
15428 |
|
|
LD (HL),A ; put back result even if $0A.
|
15429 |
|
|
AND A ; test A
|
15430 |
|
|
JR Z,L2F25 ; skip to PF-R-BACK if ZERO?
|
15431 |
|
|
|
15432 |
|
|
CP $0A ; compare to 'ten' - overflow
|
15433 |
|
|
CCF ; complement carry flag so that set if ten.
|
15434 |
|
|
JR NC,L2F2D ; forward to PF-COUNT with 1 - 9.
|
15435 |
|
|
|
15436 |
|
|
;; PF-R-BACK
|
15437 |
|
|
L2F25: DJNZ L2F18 ; loop back to PF-RND-LP
|
15438 |
|
|
|
15439 |
|
|
; if B counts down to zero then we've rounded right back as in 999999995.
|
15440 |
|
|
; and the first 8 locations all hold $0A.
|
15441 |
|
|
|
15442 |
|
|
|
15443 |
|
|
LD (HL),$01 ; load first location with digit 1.
|
15444 |
|
|
INC B ; make B hold 1 also.
|
15445 |
|
|
; could save an instruction byte here.
|
15446 |
|
|
INC (IY+$72) ; make MEM-5-2nd hold 1.
|
15447 |
|
|
; and proceed to initialize total digits to 1.
|
15448 |
|
|
|
15449 |
|
|
;; PF-COUNT
|
15450 |
|
|
L2F2D: LD (IY+$71),B ; MEM-5-1st
|
15451 |
|
|
|
15452 |
|
|
; now balance the calculator stack by deleting it
|
15453 |
|
|
|
15454 |
|
|
RST 28H ;; FP-CALC
|
15455 |
|
|
DEFB $02 ;;delete
|
15456 |
|
|
DEFB $38 ;;end-calc
|
15457 |
|
|
|
15458 |
|
|
; note if used from str$ then other values may be on the calculator stack.
|
15459 |
|
|
; we can also restore the next literal pointer from its position on the
|
15460 |
|
|
; machine stack.
|
15461 |
|
|
|
15462 |
|
|
EXX ;
|
15463 |
|
|
POP HL ; restore next literal pointer.
|
15464 |
|
|
EXX ;
|
15465 |
|
|
|
15466 |
|
|
LD BC,($5CAB) ; set C to MEM-5-1st digit counter.
|
15467 |
|
|
; set B to MEM-5-2nd leading digit counter.
|
15468 |
|
|
LD HL,$5CA1 ; set HL to start of digits at MEM-3-1
|
15469 |
|
|
LD A,B ;
|
15470 |
|
|
CP $09 ;
|
15471 |
|
|
JR C,L2F46 ; to PF-NOT-E
|
15472 |
|
|
|
15473 |
|
|
CP $FC ;
|
15474 |
|
|
JR C,L2F6C ; to PF-E-FRMT
|
15475 |
|
|
|
15476 |
|
|
;; PF-NOT-E
|
15477 |
|
|
L2F46: AND A ; test for zero leading digits as in .123
|
15478 |
|
|
|
15479 |
|
|
CALL Z,L15EF ; routine OUT-CODE prints a zero e.g. 0.123
|
15480 |
|
|
|
15481 |
|
|
;; PF-E-SBRN
|
15482 |
|
|
L2F4A: XOR A ;
|
15483 |
|
|
SUB B ;
|
15484 |
|
|
JP M,L2F52 ; skip forward to PF-OUT-LP if originally +ve
|
15485 |
|
|
|
15486 |
|
|
LD B,A ; else negative count now +ve
|
15487 |
|
|
JR L2F5E ; forward to PF-DC-OUT ->
|
15488 |
|
|
|
15489 |
|
|
; ---
|
15490 |
|
|
|
15491 |
|
|
;; PF-OUT-LP
|
15492 |
|
|
L2F52: LD A,C ; fetch total digit count
|
15493 |
|
|
AND A ; test for zero
|
15494 |
|
|
JR Z,L2F59 ; forward to PF-OUT-DT if so
|
15495 |
|
|
|
15496 |
|
|
LD A,(HL) ; fetch digit
|
15497 |
|
|
INC HL ; address next digit
|
15498 |
|
|
DEC C ; decrease total digit counter
|
15499 |
|
|
|
15500 |
|
|
;; PF-OUT-DT
|
15501 |
|
|
L2F59: CALL L15EF ; routine OUT-CODE outputs it.
|
15502 |
|
|
DJNZ L2F52 ; loop back to PF-OUT-LP until B leading
|
15503 |
|
|
; digits output.
|
15504 |
|
|
|
15505 |
|
|
;; PF-DC-OUT
|
15506 |
|
|
L2F5E: LD A,C ; fetch total digits and
|
15507 |
|
|
AND A ; test if also zero
|
15508 |
|
|
RET Z ; return if so -->
|
15509 |
|
|
|
15510 |
|
|
;
|
15511 |
|
|
|
15512 |
|
|
INC B ; increment B
|
15513 |
|
|
LD A,$2E ; prepare the character '.'
|
15514 |
|
|
|
15515 |
|
|
;; PF-DEC-0S
|
15516 |
|
|
L2F64: RST 10H ; PRINT-A outputs the character '.' or '0'
|
15517 |
|
|
|
15518 |
|
|
LD A,$30 ; prepare the character '0'
|
15519 |
|
|
; (for cases like .000012345678)
|
15520 |
|
|
DJNZ L2F64 ; loop back to PF-DEC-0S for B times.
|
15521 |
|
|
|
15522 |
|
|
LD B,C ; load B with now trailing digit counter.
|
15523 |
|
|
JR L2F52 ; back to PF-OUT-LP
|
15524 |
|
|
|
15525 |
|
|
; ---------------------------------
|
15526 |
|
|
|
15527 |
|
|
; the branch was here for E-format printing e.g. 123456789 => 1.2345679e+8
|
15528 |
|
|
|
15529 |
|
|
;; PF-E-FRMT
|
15530 |
|
|
L2F6C: LD D,B ; counter to D
|
15531 |
|
|
DEC D ; decrement
|
15532 |
|
|
LD B,$01 ; load B with 1.
|
15533 |
|
|
|
15534 |
|
|
CALL L2F4A ; routine PF-E-SBRN above
|
15535 |
|
|
|
15536 |
|
|
LD A,$45 ; prepare character 'e'
|
15537 |
|
|
RST 10H ; PRINT-A
|
15538 |
|
|
|
15539 |
|
|
LD C,D ; exponent to C
|
15540 |
|
|
LD A,C ; and to A
|
15541 |
|
|
AND A ; test exponent
|
15542 |
|
|
JP P,L2F83 ; to PF-E-POS if positive
|
15543 |
|
|
|
15544 |
|
|
NEG ; negate
|
15545 |
|
|
LD C,A ; positive exponent to C
|
15546 |
|
|
LD A,$2D ; prepare character '-'
|
15547 |
|
|
JR L2F85 ; skip to PF-E-SIGN
|
15548 |
|
|
|
15549 |
|
|
; ---
|
15550 |
|
|
|
15551 |
|
|
;; PF-E-POS
|
15552 |
|
|
L2F83: LD A,$2B ; prepare character '+'
|
15553 |
|
|
|
15554 |
|
|
;; PF-E-SIGN
|
15555 |
|
|
L2F85: RST 10H ; PRINT-A outputs the sign
|
15556 |
|
|
|
15557 |
|
|
LD B,$00 ; make the high byte zero.
|
15558 |
|
|
JP L1A1B ; exit via OUT-NUM-1 to print exponent in BC
|
15559 |
|
|
|
15560 |
|
|
; ------------------------------
|
15561 |
|
|
; Handle printing floating point
|
15562 |
|
|
; ------------------------------
|
15563 |
|
|
; This subroutine is called twice from above when printing floating-point
|
15564 |
|
|
; numbers. It returns 10*A +C in registers C and A
|
15565 |
|
|
|
15566 |
|
|
;; CA-10*A+C
|
15567 |
|
|
L2F8B: PUSH DE ; preserve DE.
|
15568 |
|
|
LD L,A ; transfer A to L
|
15569 |
|
|
LD H,$00 ; zero high byte.
|
15570 |
|
|
LD E,L ; copy HL
|
15571 |
|
|
LD D,H ; to DE.
|
15572 |
|
|
ADD HL,HL ; double (*2)
|
15573 |
|
|
ADD HL,HL ; double (*4)
|
15574 |
|
|
ADD HL,DE ; add DE (*5)
|
15575 |
|
|
ADD HL,HL ; double (*10)
|
15576 |
|
|
LD E,C ; copy C to E (D is 0)
|
15577 |
|
|
ADD HL,DE ; and add to give required result.
|
15578 |
|
|
LD C,H ; transfer to
|
15579 |
|
|
LD A,L ; destination registers.
|
15580 |
|
|
POP DE ; restore DE
|
15581 |
|
|
RET ; return with result.
|
15582 |
|
|
|
15583 |
|
|
; --------------
|
15584 |
|
|
; Prepare to add
|
15585 |
|
|
; --------------
|
15586 |
|
|
; This routine is called twice by addition to prepare the two numbers. The
|
15587 |
|
|
; exponent is picked up in A and the location made zero. Then the sign bit
|
15588 |
|
|
; is tested before being set to the implied state. Negative numbers are twos
|
15589 |
|
|
; complemented.
|
15590 |
|
|
|
15591 |
|
|
;; PREP-ADD
|
15592 |
|
|
L2F9B: LD A,(HL) ; pick up exponent
|
15593 |
|
|
LD (HL),$00 ; make location zero
|
15594 |
|
|
AND A ; test if number is zero
|
15595 |
|
|
RET Z ; return if so
|
15596 |
|
|
|
15597 |
|
|
INC HL ; address mantissa
|
15598 |
|
|
BIT 7,(HL) ; test the sign bit
|
15599 |
|
|
SET 7,(HL) ; set it to implied state
|
15600 |
|
|
DEC HL ; point to exponent
|
15601 |
|
|
RET Z ; return if positive number.
|
15602 |
|
|
|
15603 |
|
|
PUSH BC ; preserve BC
|
15604 |
|
|
LD BC,$0005 ; length of number
|
15605 |
|
|
ADD HL,BC ; point HL past end
|
15606 |
|
|
LD B,C ; set B to 5 counter
|
15607 |
|
|
LD C,A ; store exponent in C
|
15608 |
|
|
SCF ; set carry flag
|
15609 |
|
|
|
15610 |
|
|
;; NEG-BYTE
|
15611 |
|
|
L2FAF: DEC HL ; work from LSB to MSB
|
15612 |
|
|
LD A,(HL) ; fetch byte
|
15613 |
|
|
CPL ; complement
|
15614 |
|
|
ADC A,$00 ; add in initial carry or from prev operation
|
15615 |
|
|
LD (HL),A ; put back
|
15616 |
|
|
DJNZ L2FAF ; loop to NEG-BYTE till all 5 done
|
15617 |
|
|
|
15618 |
|
|
LD A,C ; stored exponent to A
|
15619 |
|
|
POP BC ; restore original BC
|
15620 |
|
|
RET ; return
|
15621 |
|
|
|
15622 |
|
|
; -----------------
|
15623 |
|
|
; Fetch two numbers
|
15624 |
|
|
; -----------------
|
15625 |
|
|
; This routine is called twice when printing floating point numbers and also
|
15626 |
|
|
; to fetch two numbers by the addition, multiply and division routines.
|
15627 |
|
|
; HL addresses the first number, DE addresses the second number.
|
15628 |
|
|
; For arithmetic only, A holds the sign of the result which is stored in
|
15629 |
|
|
; the second location.
|
15630 |
|
|
|
15631 |
|
|
;; FETCH-TWO
|
15632 |
|
|
L2FBA: PUSH HL ; save pointer to first number, result if math.
|
15633 |
|
|
PUSH AF ; save result sign.
|
15634 |
|
|
|
15635 |
|
|
LD C,(HL) ;
|
15636 |
|
|
INC HL ;
|
15637 |
|
|
|
15638 |
|
|
LD B,(HL) ;
|
15639 |
|
|
LD (HL),A ; store the sign at correct location in
|
15640 |
|
|
; destination 5 bytes for arithmetic only.
|
15641 |
|
|
INC HL ;
|
15642 |
|
|
|
15643 |
|
|
LD A,C ;
|
15644 |
|
|
LD C,(HL) ;
|
15645 |
|
|
PUSH BC ;
|
15646 |
|
|
INC HL ;
|
15647 |
|
|
LD C,(HL) ;
|
15648 |
|
|
INC HL ;
|
15649 |
|
|
LD B,(HL) ;
|
15650 |
|
|
EX DE,HL ;
|
15651 |
|
|
LD D,A ;
|
15652 |
|
|
LD E,(HL) ;
|
15653 |
|
|
PUSH DE ;
|
15654 |
|
|
INC HL ;
|
15655 |
|
|
LD D,(HL) ;
|
15656 |
|
|
INC HL ;
|
15657 |
|
|
LD E,(HL) ;
|
15658 |
|
|
PUSH DE ;
|
15659 |
|
|
EXX ;
|
15660 |
|
|
POP DE ;
|
15661 |
|
|
POP HL ;
|
15662 |
|
|
POP BC ;
|
15663 |
|
|
EXX ;
|
15664 |
|
|
INC HL ;
|
15665 |
|
|
LD D,(HL) ;
|
15666 |
|
|
INC HL ;
|
15667 |
|
|
LD E,(HL) ;
|
15668 |
|
|
|
15669 |
|
|
POP AF ; restore possible result sign.
|
15670 |
|
|
POP HL ; and pointer to possible result.
|
15671 |
|
|
RET ; return.
|
15672 |
|
|
|
15673 |
|
|
; ---------------------------------
|
15674 |
|
|
; Shift floating point number right
|
15675 |
|
|
; ---------------------------------
|
15676 |
|
|
;
|
15677 |
|
|
;
|
15678 |
|
|
|
15679 |
|
|
;; SHIFT-FP
|
15680 |
|
|
L2FDD: AND A ;
|
15681 |
|
|
RET Z ;
|
15682 |
|
|
|
15683 |
|
|
CP $21 ;
|
15684 |
|
|
JR NC,L2FF9 ; to ADDEND-0
|
15685 |
|
|
|
15686 |
|
|
PUSH BC ;
|
15687 |
|
|
LD B,A ;
|
15688 |
|
|
|
15689 |
|
|
;; ONE-SHIFT
|
15690 |
|
|
L2FE5: EXX ;
|
15691 |
|
|
SRA L ;
|
15692 |
|
|
RR D ;
|
15693 |
|
|
RR E ;
|
15694 |
|
|
EXX ;
|
15695 |
|
|
RR D ;
|
15696 |
|
|
RR E ;
|
15697 |
|
|
DJNZ L2FE5 ; to ONE-SHIFT
|
15698 |
|
|
|
15699 |
|
|
POP BC ;
|
15700 |
|
|
RET NC ;
|
15701 |
|
|
|
15702 |
|
|
CALL L3004 ; routine ADD-BACK
|
15703 |
|
|
RET NZ ;
|
15704 |
|
|
|
15705 |
|
|
;; ADDEND-0
|
15706 |
|
|
L2FF9: EXX ;
|
15707 |
|
|
XOR A ;
|
15708 |
|
|
|
15709 |
|
|
;; ZEROS-4/5
|
15710 |
|
|
L2FFB: LD L,$00 ;
|
15711 |
|
|
LD D,A ;
|
15712 |
|
|
LD E,L ;
|
15713 |
|
|
EXX ;
|
15714 |
|
|
LD DE,$0000 ;
|
15715 |
|
|
RET ;
|
15716 |
|
|
|
15717 |
|
|
; ------------------
|
15718 |
|
|
; Add back any carry
|
15719 |
|
|
; ------------------
|
15720 |
|
|
;
|
15721 |
|
|
;
|
15722 |
|
|
|
15723 |
|
|
;; ADD-BACK
|
15724 |
|
|
L3004: INC E ;
|
15725 |
|
|
RET NZ ;
|
15726 |
|
|
|
15727 |
|
|
INC D ;
|
15728 |
|
|
RET NZ ;
|
15729 |
|
|
|
15730 |
|
|
EXX ;
|
15731 |
|
|
INC E ;
|
15732 |
|
|
JR NZ,L300D ; to ALL-ADDED
|
15733 |
|
|
|
15734 |
|
|
INC D ;
|
15735 |
|
|
|
15736 |
|
|
;; ALL-ADDED
|
15737 |
|
|
L300D: EXX ;
|
15738 |
|
|
RET ;
|
15739 |
|
|
|
15740 |
|
|
; -----------------------
|
15741 |
|
|
; Handle subtraction (03)
|
15742 |
|
|
; -----------------------
|
15743 |
|
|
; Subtraction is done by switching the sign byte/bit of the second number
|
15744 |
|
|
; which may be integer of floating point and continuing into addition.
|
15745 |
|
|
|
15746 |
|
|
;; subtract
|
15747 |
|
|
L300F: EX DE,HL ; address second number with HL
|
15748 |
|
|
|
15749 |
|
|
CALL L346E ; routine NEGATE switches sign
|
15750 |
|
|
|
15751 |
|
|
EX DE,HL ; address first number again
|
15752 |
|
|
; and continue.
|
15753 |
|
|
|
15754 |
|
|
; --------------------
|
15755 |
|
|
; Handle addition (0F)
|
15756 |
|
|
; --------------------
|
15757 |
|
|
; HL points to first number, DE to second.
|
15758 |
|
|
; If they are both integers, then go for the easy route.
|
15759 |
|
|
|
15760 |
|
|
;; addition
|
15761 |
|
|
L3014: LD A,(DE) ; fetch first byte of second
|
15762 |
|
|
OR (HL) ; combine with first byte of first
|
15763 |
|
|
JR NZ,L303E ; forward to FULL-ADDN if at least one was
|
15764 |
|
|
; in floating point form.
|
15765 |
|
|
|
15766 |
|
|
; continue if both were small integers.
|
15767 |
|
|
|
15768 |
|
|
PUSH DE ; save pointer to lowest number for result.
|
15769 |
|
|
|
15770 |
|
|
INC HL ; address sign byte and
|
15771 |
|
|
PUSH HL ; push the pointer.
|
15772 |
|
|
|
15773 |
|
|
INC HL ; address low byte
|
15774 |
|
|
LD E,(HL) ; to E
|
15775 |
|
|
INC HL ; address high byte
|
15776 |
|
|
LD D,(HL) ; to D
|
15777 |
|
|
INC HL ; address unused byte
|
15778 |
|
|
|
15779 |
|
|
INC HL ; address known zero indicator of 1st number
|
15780 |
|
|
INC HL ; address sign byte
|
15781 |
|
|
|
15782 |
|
|
LD A,(HL) ; sign to A, $00 or $FF
|
15783 |
|
|
|
15784 |
|
|
INC HL ; address low byte
|
15785 |
|
|
LD C,(HL) ; to C
|
15786 |
|
|
INC HL ; address high byte
|
15787 |
|
|
LD B,(HL) ; to B
|
15788 |
|
|
|
15789 |
|
|
POP HL ; pop result sign pointer
|
15790 |
|
|
EX DE,HL ; integer to HL
|
15791 |
|
|
|
15792 |
|
|
ADD HL,BC ; add to the other one in BC
|
15793 |
|
|
; setting carry if overflow.
|
15794 |
|
|
|
15795 |
|
|
EX DE,HL ; save result in DE bringing back sign pointer
|
15796 |
|
|
|
15797 |
|
|
ADC A,(HL) ; if pos/pos A=01 with overflow else 00
|
15798 |
|
|
; if neg/neg A=FF with overflow else FE
|
15799 |
|
|
; if mixture A=00 with overflow else FF
|
15800 |
|
|
|
15801 |
|
|
RRCA ; bit 0 to (C)
|
15802 |
|
|
|
15803 |
|
|
ADC A,$00 ; both acceptable signs now zero
|
15804 |
|
|
|
15805 |
|
|
JR NZ,L303C ; forward to ADDN-OFLW if not
|
15806 |
|
|
|
15807 |
|
|
SBC A,A ; restore a negative result sign
|
15808 |
|
|
|
15809 |
|
|
LD (HL),A ;
|
15810 |
|
|
INC HL ;
|
15811 |
|
|
LD (HL),E ;
|
15812 |
|
|
INC HL ;
|
15813 |
|
|
LD (HL),D ;
|
15814 |
|
|
DEC HL ;
|
15815 |
|
|
DEC HL ;
|
15816 |
|
|
DEC HL ;
|
15817 |
|
|
|
15818 |
|
|
POP DE ; STKEND
|
15819 |
|
|
RET ;
|
15820 |
|
|
|
15821 |
|
|
; ---
|
15822 |
|
|
|
15823 |
|
|
;; ADDN-OFLW
|
15824 |
|
|
L303C: DEC HL ;
|
15825 |
|
|
POP DE ;
|
15826 |
|
|
|
15827 |
|
|
;; FULL-ADDN
|
15828 |
|
|
L303E: CALL L3293 ; routine RE-ST-TWO
|
15829 |
|
|
EXX ;
|
15830 |
|
|
PUSH HL ;
|
15831 |
|
|
EXX ;
|
15832 |
|
|
PUSH DE ;
|
15833 |
|
|
PUSH HL ;
|
15834 |
|
|
CALL L2F9B ; routine PREP-ADD
|
15835 |
|
|
LD B,A ;
|
15836 |
|
|
EX DE,HL ;
|
15837 |
|
|
CALL L2F9B ; routine PREP-ADD
|
15838 |
|
|
LD C,A ;
|
15839 |
|
|
CP B ;
|
15840 |
|
|
JR NC,L3055 ; to SHIFT-LEN
|
15841 |
|
|
|
15842 |
|
|
LD A,B ;
|
15843 |
|
|
LD B,C ;
|
15844 |
|
|
EX DE,HL ;
|
15845 |
|
|
|
15846 |
|
|
;; SHIFT-LEN
|
15847 |
|
|
L3055: PUSH AF ;
|
15848 |
|
|
SUB B ;
|
15849 |
|
|
CALL L2FBA ; routine FETCH-TWO
|
15850 |
|
|
CALL L2FDD ; routine SHIFT-FP
|
15851 |
|
|
POP AF ;
|
15852 |
|
|
POP HL ;
|
15853 |
|
|
LD (HL),A ;
|
15854 |
|
|
PUSH HL ;
|
15855 |
|
|
LD L,B ;
|
15856 |
|
|
LD H,C ;
|
15857 |
|
|
ADD HL,DE ;
|
15858 |
|
|
EXX ;
|
15859 |
|
|
EX DE,HL ;
|
15860 |
|
|
ADC HL,BC ;
|
15861 |
|
|
EX DE,HL ;
|
15862 |
|
|
LD A,H ;
|
15863 |
|
|
ADC A,L ;
|
15864 |
|
|
LD L,A ;
|
15865 |
|
|
RRA ;
|
15866 |
|
|
XOR L ;
|
15867 |
|
|
EXX ;
|
15868 |
|
|
EX DE,HL ;
|
15869 |
|
|
POP HL ;
|
15870 |
|
|
RRA ;
|
15871 |
|
|
JR NC,L307C ; to TEST-NEG
|
15872 |
|
|
|
15873 |
|
|
LD A,$01 ;
|
15874 |
|
|
CALL L2FDD ; routine SHIFT-FP
|
15875 |
|
|
INC (HL) ;
|
15876 |
|
|
JR Z,L309F ; to ADD-REP-6
|
15877 |
|
|
|
15878 |
|
|
;; TEST-NEG
|
15879 |
|
|
L307C: EXX ;
|
15880 |
|
|
LD A,L ;
|
15881 |
|
|
AND $80 ;
|
15882 |
|
|
EXX ;
|
15883 |
|
|
INC HL ;
|
15884 |
|
|
LD (HL),A ;
|
15885 |
|
|
DEC HL ;
|
15886 |
|
|
JR Z,L30A5 ; to GO-NC-MLT
|
15887 |
|
|
|
15888 |
|
|
LD A,E ;
|
15889 |
|
|
NEG ; Negate
|
15890 |
|
|
CCF ; Complement Carry Flag
|
15891 |
|
|
LD E,A ;
|
15892 |
|
|
LD A,D ;
|
15893 |
|
|
CPL ;
|
15894 |
|
|
ADC A,$00 ;
|
15895 |
|
|
LD D,A ;
|
15896 |
|
|
EXX ;
|
15897 |
|
|
LD A,E ;
|
15898 |
|
|
CPL ;
|
15899 |
|
|
ADC A,$00 ;
|
15900 |
|
|
LD E,A ;
|
15901 |
|
|
LD A,D ;
|
15902 |
|
|
CPL ;
|
15903 |
|
|
ADC A,$00 ;
|
15904 |
|
|
JR NC,L30A3 ; to END-COMPL
|
15905 |
|
|
|
15906 |
|
|
RRA ;
|
15907 |
|
|
EXX ;
|
15908 |
|
|
INC (HL) ;
|
15909 |
|
|
|
15910 |
|
|
;; ADD-REP-6
|
15911 |
|
|
L309F: JP Z,L31AD ; to REPORT-6
|
15912 |
|
|
|
15913 |
|
|
EXX ;
|
15914 |
|
|
|
15915 |
|
|
;; END-COMPL
|
15916 |
|
|
L30A3: LD D,A ;
|
15917 |
|
|
EXX ;
|
15918 |
|
|
|
15919 |
|
|
;; GO-NC-MLT
|
15920 |
|
|
L30A5: XOR A ;
|
15921 |
|
|
JP L3155 ; to TEST-NORM
|
15922 |
|
|
|
15923 |
|
|
; -----------------------------
|
15924 |
|
|
; Used in 16 bit multiplication
|
15925 |
|
|
; -----------------------------
|
15926 |
|
|
; This routine is used, in the first instance, by the multiply calculator
|
15927 |
|
|
; literal to perform an integer multiplication in preference to
|
15928 |
|
|
; 32-bit multiplication to which it will resort if this overflows.
|
15929 |
|
|
;
|
15930 |
|
|
; It is also used by STK-VAR to calculate array subscripts and by DIM to
|
15931 |
|
|
; calculate the space required for multi-dimensional arrays.
|
15932 |
|
|
|
15933 |
|
|
;; HL-HL*DE
|
15934 |
|
|
L30A9: PUSH BC ; preserve BC throughout
|
15935 |
|
|
LD B,$10 ; set B to 16
|
15936 |
|
|
LD A,H ; save H in A high byte
|
15937 |
|
|
LD C,L ; save L in C low byte
|
15938 |
|
|
LD HL,$0000 ; initialize result to zero
|
15939 |
|
|
|
15940 |
|
|
; now enter a loop.
|
15941 |
|
|
|
15942 |
|
|
;; HL-LOOP
|
15943 |
|
|
L30B1: ADD HL,HL ; double result
|
15944 |
|
|
JR C,L30BE ; to HL-END if overflow
|
15945 |
|
|
|
15946 |
|
|
RL C ; shift AC left into carry
|
15947 |
|
|
RLA ;
|
15948 |
|
|
JR NC,L30BC ; to HL-AGAIN to skip addition if no carry
|
15949 |
|
|
|
15950 |
|
|
ADD HL,DE ; add in DE
|
15951 |
|
|
JR C,L30BE ; to HL-END if overflow
|
15952 |
|
|
|
15953 |
|
|
;; HL-AGAIN
|
15954 |
|
|
L30BC: DJNZ L30B1 ; back to HL-LOOP for all 16 bits
|
15955 |
|
|
|
15956 |
|
|
;; HL-END
|
15957 |
|
|
L30BE: POP BC ; restore preserved BC
|
15958 |
|
|
RET ; return with carry reset if successful
|
15959 |
|
|
; and result in HL.
|
15960 |
|
|
|
15961 |
|
|
; ----------------------------------------------
|
15962 |
|
|
; THE 'PREPARE TO MULTIPLY OR DIVIDE' SUBROUTINE
|
15963 |
|
|
; ----------------------------------------------
|
15964 |
|
|
; This routine is called in succession from multiply and divide to prepare
|
15965 |
|
|
; two mantissas by setting the leftmost bit that is used for the sign.
|
15966 |
|
|
; On the first call A holds zero and picks up the sign bit. On the second
|
15967 |
|
|
; call the two bits are XORed to form the result sign - minus * minus giving
|
15968 |
|
|
; plus etc. If either number is zero then this is flagged.
|
15969 |
|
|
; HL addresses the exponent.
|
15970 |
|
|
|
15971 |
|
|
;; PREP-M/D
|
15972 |
|
|
L30C0: CALL L34E9 ; routine TEST-ZERO preserves accumulator.
|
15973 |
|
|
RET C ; return carry set if zero
|
15974 |
|
|
|
15975 |
|
|
INC HL ; address first byte of mantissa
|
15976 |
|
|
XOR (HL) ; pick up the first or xor with first.
|
15977 |
|
|
SET 7,(HL) ; now set to give true 32-bit mantissa
|
15978 |
|
|
DEC HL ; point to exponent
|
15979 |
|
|
RET ; return with carry reset
|
15980 |
|
|
|
15981 |
|
|
; ----------------------
|
15982 |
|
|
; THE 'MULTIPLY' ROUTINE
|
15983 |
|
|
; ----------------------
|
15984 |
|
|
; (offset: $04 'multiply')
|
15985 |
|
|
;
|
15986 |
|
|
;
|
15987 |
|
|
; "He said go forth and something about mathematics, I wasn't really
|
15988 |
|
|
; listening" - overheard conversation between two unicorns.
|
15989 |
|
|
; [ The Odd Streak ].
|
15990 |
|
|
|
15991 |
|
|
;; multiply
|
15992 |
|
|
L30CA: LD A,(DE) ;
|
15993 |
|
|
OR (HL) ;
|
15994 |
|
|
JR NZ,L30F0 ; to MULT-LONG
|
15995 |
|
|
|
15996 |
|
|
PUSH DE ;
|
15997 |
|
|
PUSH HL ;
|
15998 |
|
|
PUSH DE ;
|
15999 |
|
|
CALL L2D7F ; routine INT-FETCH
|
16000 |
|
|
EX DE,HL ;
|
16001 |
|
|
EX (SP),HL ;
|
16002 |
|
|
LD B,C ;
|
16003 |
|
|
CALL L2D7F ; routine INT-FETCH
|
16004 |
|
|
LD A,B ;
|
16005 |
|
|
XOR C ;
|
16006 |
|
|
LD C,A ;
|
16007 |
|
|
POP HL ;
|
16008 |
|
|
CALL L30A9 ; routine HL-HL*DE
|
16009 |
|
|
EX DE,HL ;
|
16010 |
|
|
POP HL ;
|
16011 |
|
|
JR C,L30EF ; to MULT-OFLW
|
16012 |
|
|
|
16013 |
|
|
LD A,D ;
|
16014 |
|
|
OR E ;
|
16015 |
|
|
JR NZ,L30EA ; to MULT-RSLT
|
16016 |
|
|
|
16017 |
|
|
LD C,A ;
|
16018 |
|
|
|
16019 |
|
|
;; MULT-RSLT
|
16020 |
|
|
L30EA: CALL L2D8E ; routine INT-STORE
|
16021 |
|
|
POP DE ;
|
16022 |
|
|
RET ;
|
16023 |
|
|
|
16024 |
|
|
; ---
|
16025 |
|
|
|
16026 |
|
|
;; MULT-OFLW
|
16027 |
|
|
L30EF: POP DE ;
|
16028 |
|
|
|
16029 |
|
|
;; MULT-LONG
|
16030 |
|
|
L30F0: CALL L3293 ; routine RE-ST-TWO
|
16031 |
|
|
XOR A ;
|
16032 |
|
|
CALL L30C0 ; routine PREP-M/D
|
16033 |
|
|
RET C ;
|
16034 |
|
|
|
16035 |
|
|
EXX ;
|
16036 |
|
|
PUSH HL ;
|
16037 |
|
|
EXX ;
|
16038 |
|
|
PUSH DE ;
|
16039 |
|
|
EX DE,HL ;
|
16040 |
|
|
CALL L30C0 ; routine PREP-M/D
|
16041 |
|
|
EX DE,HL ;
|
16042 |
|
|
JR C,L315D ; to ZERO-RSLT
|
16043 |
|
|
|
16044 |
|
|
PUSH HL ;
|
16045 |
|
|
CALL L2FBA ; routine FETCH-TWO
|
16046 |
|
|
LD A,B ;
|
16047 |
|
|
AND A ;
|
16048 |
|
|
SBC HL,HL ;
|
16049 |
|
|
EXX ;
|
16050 |
|
|
PUSH HL ;
|
16051 |
|
|
SBC HL,HL ;
|
16052 |
|
|
EXX ;
|
16053 |
|
|
LD B,$21 ;
|
16054 |
|
|
JR L3125 ; to STRT-MLT
|
16055 |
|
|
|
16056 |
|
|
; ---
|
16057 |
|
|
|
16058 |
|
|
;; MLT-LOOP
|
16059 |
|
|
L3114: JR NC,L311B ; to NO-ADD
|
16060 |
|
|
|
16061 |
|
|
ADD HL,DE ;
|
16062 |
|
|
EXX ;
|
16063 |
|
|
ADC HL,DE ;
|
16064 |
|
|
EXX ;
|
16065 |
|
|
|
16066 |
|
|
;; NO-ADD
|
16067 |
|
|
L311B: EXX ;
|
16068 |
|
|
RR H ;
|
16069 |
|
|
RR L ;
|
16070 |
|
|
EXX ;
|
16071 |
|
|
RR H ;
|
16072 |
|
|
RR L ;
|
16073 |
|
|
|
16074 |
|
|
;; STRT-MLT
|
16075 |
|
|
L3125: EXX ;
|
16076 |
|
|
RR B ;
|
16077 |
|
|
RR C ;
|
16078 |
|
|
EXX ;
|
16079 |
|
|
RR C ;
|
16080 |
|
|
RRA ;
|
16081 |
|
|
DJNZ L3114 ; to MLT-LOOP
|
16082 |
|
|
|
16083 |
|
|
EX DE,HL ;
|
16084 |
|
|
EXX ;
|
16085 |
|
|
EX DE,HL ;
|
16086 |
|
|
EXX ;
|
16087 |
|
|
POP BC ;
|
16088 |
|
|
POP HL ;
|
16089 |
|
|
LD A,B ;
|
16090 |
|
|
ADD A,C ;
|
16091 |
|
|
JR NZ,L313B ; to MAKE-EXPT
|
16092 |
|
|
|
16093 |
|
|
AND A ;
|
16094 |
|
|
|
16095 |
|
|
;; MAKE-EXPT
|
16096 |
|
|
L313B: DEC A ;
|
16097 |
|
|
CCF ; Complement Carry Flag
|
16098 |
|
|
|
16099 |
|
|
;; DIVN-EXPT
|
16100 |
|
|
L313D: RLA ;
|
16101 |
|
|
CCF ; Complement Carry Flag
|
16102 |
|
|
RRA ;
|
16103 |
|
|
JP P,L3146 ; to OFLW1-CLR
|
16104 |
|
|
|
16105 |
|
|
JR NC,L31AD ; to REPORT-6
|
16106 |
|
|
|
16107 |
|
|
AND A ;
|
16108 |
|
|
|
16109 |
|
|
;; OFLW1-CLR
|
16110 |
|
|
L3146: INC A ;
|
16111 |
|
|
JR NZ,L3151 ; to OFLW2-CLR
|
16112 |
|
|
|
16113 |
|
|
JR C,L3151 ; to OFLW2-CLR
|
16114 |
|
|
|
16115 |
|
|
EXX ;
|
16116 |
|
|
BIT 7,D ;
|
16117 |
|
|
EXX ;
|
16118 |
|
|
JR NZ,L31AD ; to REPORT-6
|
16119 |
|
|
|
16120 |
|
|
;; OFLW2-CLR
|
16121 |
|
|
L3151: LD (HL),A ;
|
16122 |
|
|
EXX ;
|
16123 |
|
|
LD A,B ;
|
16124 |
|
|
EXX ;
|
16125 |
|
|
|
16126 |
|
|
;; TEST-NORM
|
16127 |
|
|
L3155: JR NC,L316C ; to NORMALISE
|
16128 |
|
|
|
16129 |
|
|
LD A,(HL) ;
|
16130 |
|
|
AND A ;
|
16131 |
|
|
|
16132 |
|
|
;; NEAR-ZERO
|
16133 |
|
|
L3159: LD A,$80 ;
|
16134 |
|
|
JR Z,L315E ; to SKIP-ZERO
|
16135 |
|
|
|
16136 |
|
|
;; ZERO-RSLT
|
16137 |
|
|
L315D: XOR A ;
|
16138 |
|
|
|
16139 |
|
|
;; SKIP-ZERO
|
16140 |
|
|
L315E: EXX ;
|
16141 |
|
|
AND D ;
|
16142 |
|
|
CALL L2FFB ; routine ZEROS-4/5
|
16143 |
|
|
RLCA ;
|
16144 |
|
|
LD (HL),A ;
|
16145 |
|
|
JR C,L3195 ; to OFLOW-CLR
|
16146 |
|
|
|
16147 |
|
|
INC HL ;
|
16148 |
|
|
LD (HL),A ;
|
16149 |
|
|
DEC HL ;
|
16150 |
|
|
JR L3195 ; to OFLOW-CLR
|
16151 |
|
|
|
16152 |
|
|
; ---
|
16153 |
|
|
|
16154 |
|
|
;; NORMALISE
|
16155 |
|
|
L316C: LD B,$20 ;
|
16156 |
|
|
|
16157 |
|
|
;; SHIFT-ONE
|
16158 |
|
|
L316E: EXX ;
|
16159 |
|
|
BIT 7,D ;
|
16160 |
|
|
EXX ;
|
16161 |
|
|
JR NZ,L3186 ; to NORML-NOW
|
16162 |
|
|
|
16163 |
|
|
RLCA ;
|
16164 |
|
|
RL E ;
|
16165 |
|
|
RL D ;
|
16166 |
|
|
EXX ;
|
16167 |
|
|
RL E ;
|
16168 |
|
|
RL D ;
|
16169 |
|
|
EXX ;
|
16170 |
|
|
DEC (HL) ;
|
16171 |
|
|
JR Z,L3159 ; to NEAR-ZERO
|
16172 |
|
|
|
16173 |
|
|
DJNZ L316E ; to SHIFT-ONE
|
16174 |
|
|
|
16175 |
|
|
JR L315D ; to ZERO-RSLT
|
16176 |
|
|
|
16177 |
|
|
; ---
|
16178 |
|
|
|
16179 |
|
|
;; NORML-NOW
|
16180 |
|
|
L3186: RLA ;
|
16181 |
|
|
JR NC,L3195 ; to OFLOW-CLR
|
16182 |
|
|
|
16183 |
|
|
CALL L3004 ; routine ADD-BACK
|
16184 |
|
|
JR NZ,L3195 ; to OFLOW-CLR
|
16185 |
|
|
|
16186 |
|
|
EXX ;
|
16187 |
|
|
LD D,$80 ;
|
16188 |
|
|
EXX ;
|
16189 |
|
|
INC (HL) ;
|
16190 |
|
|
JR Z,L31AD ; to REPORT-6
|
16191 |
|
|
|
16192 |
|
|
;; OFLOW-CLR
|
16193 |
|
|
L3195: PUSH HL ;
|
16194 |
|
|
INC HL ;
|
16195 |
|
|
EXX ;
|
16196 |
|
|
PUSH DE ;
|
16197 |
|
|
EXX ;
|
16198 |
|
|
POP BC ;
|
16199 |
|
|
LD A,B ;
|
16200 |
|
|
RLA ;
|
16201 |
|
|
RL (HL) ;
|
16202 |
|
|
RRA ;
|
16203 |
|
|
LD (HL),A ;
|
16204 |
|
|
INC HL ;
|
16205 |
|
|
LD (HL),C ;
|
16206 |
|
|
INC HL ;
|
16207 |
|
|
LD (HL),D ;
|
16208 |
|
|
INC HL ;
|
16209 |
|
|
LD (HL),E ;
|
16210 |
|
|
POP HL ;
|
16211 |
|
|
POP DE ;
|
16212 |
|
|
EXX ;
|
16213 |
|
|
POP HL ;
|
16214 |
|
|
EXX ;
|
16215 |
|
|
RET ;
|
16216 |
|
|
|
16217 |
|
|
; ---
|
16218 |
|
|
|
16219 |
|
|
;; REPORT-6
|
16220 |
|
|
L31AD: RST 08H ; ERROR-1
|
16221 |
|
|
DEFB $05 ; Error Report: Number too big
|
16222 |
|
|
|
16223 |
|
|
; ----------------------
|
16224 |
|
|
; THE 'DIVISION' ROUTINE
|
16225 |
|
|
; ----------------------
|
16226 |
|
|
; (offset: $05 'division')
|
16227 |
|
|
;
|
16228 |
|
|
; "He who can properly define and divide is to be considered a god"
|
16229 |
|
|
; - Plato, 429 - 347 B.C.
|
16230 |
|
|
|
16231 |
|
|
;; division
|
16232 |
|
|
L31AF: CALL L3293 ; routine RE-ST-TWO
|
16233 |
|
|
EX DE,HL ;
|
16234 |
|
|
XOR A ;
|
16235 |
|
|
CALL L30C0 ; routine PREP-M/D
|
16236 |
|
|
JR C,L31AD ; to REPORT-6
|
16237 |
|
|
|
16238 |
|
|
EX DE,HL ;
|
16239 |
|
|
CALL L30C0 ; routine PREP-M/D
|
16240 |
|
|
RET C ;
|
16241 |
|
|
|
16242 |
|
|
EXX ;
|
16243 |
|
|
PUSH HL ;
|
16244 |
|
|
EXX ;
|
16245 |
|
|
PUSH DE ;
|
16246 |
|
|
PUSH HL ;
|
16247 |
|
|
CALL L2FBA ; routine FETCH-TWO
|
16248 |
|
|
EXX ;
|
16249 |
|
|
PUSH HL ;
|
16250 |
|
|
LD H,B ;
|
16251 |
|
|
LD L,C ;
|
16252 |
|
|
EXX ;
|
16253 |
|
|
LD H,C ;
|
16254 |
|
|
LD L,B ;
|
16255 |
|
|
XOR A ;
|
16256 |
|
|
LD B,$DF ;
|
16257 |
|
|
JR L31E2 ; to DIV-START
|
16258 |
|
|
|
16259 |
|
|
; ---
|
16260 |
|
|
|
16261 |
|
|
;; DIV-LOOP
|
16262 |
|
|
L31D2: RLA ;
|
16263 |
|
|
RL C ;
|
16264 |
|
|
EXX ;
|
16265 |
|
|
RL C ;
|
16266 |
|
|
RL B ;
|
16267 |
|
|
EXX ;
|
16268 |
|
|
|
16269 |
|
|
;; div-34th
|
16270 |
|
|
L31DB: ADD HL,HL ;
|
16271 |
|
|
EXX ;
|
16272 |
|
|
ADC HL,HL ;
|
16273 |
|
|
EXX ;
|
16274 |
|
|
JR C,L31F2 ; to SUBN-ONLY
|
16275 |
|
|
|
16276 |
|
|
;; DIV-START
|
16277 |
|
|
L31E2: SBC HL,DE ;
|
16278 |
|
|
EXX ;
|
16279 |
|
|
SBC HL,DE ;
|
16280 |
|
|
EXX ;
|
16281 |
|
|
JR NC,L31F9 ; to NO-RSTORE
|
16282 |
|
|
|
16283 |
|
|
ADD HL,DE ;
|
16284 |
|
|
EXX ;
|
16285 |
|
|
ADC HL,DE ;
|
16286 |
|
|
EXX ;
|
16287 |
|
|
AND A ;
|
16288 |
|
|
JR L31FA ; to COUNT-ONE
|
16289 |
|
|
|
16290 |
|
|
; ---
|
16291 |
|
|
|
16292 |
|
|
;; SUBN-ONLY
|
16293 |
|
|
L31F2: AND A ;
|
16294 |
|
|
SBC HL,DE ;
|
16295 |
|
|
EXX ;
|
16296 |
|
|
SBC HL,DE ;
|
16297 |
|
|
EXX ;
|
16298 |
|
|
|
16299 |
|
|
;; NO-RSTORE
|
16300 |
|
|
L31F9: SCF ; Set Carry Flag
|
16301 |
|
|
|
16302 |
|
|
;; COUNT-ONE
|
16303 |
|
|
L31FA: INC B ;
|
16304 |
|
|
JP M,L31D2 ; to DIV-LOOP
|
16305 |
|
|
|
16306 |
|
|
PUSH AF ;
|
16307 |
|
|
JR Z,L31E2 ; to DIV-START
|
16308 |
|
|
|
16309 |
|
|
;
|
16310 |
|
|
;
|
16311 |
|
|
;
|
16312 |
|
|
;
|
16313 |
|
|
|
16314 |
|
|
LD E,A ;
|
16315 |
|
|
LD D,C ;
|
16316 |
|
|
EXX ;
|
16317 |
|
|
LD E,C ;
|
16318 |
|
|
LD D,B ;
|
16319 |
|
|
POP AF ;
|
16320 |
|
|
RR B ;
|
16321 |
|
|
POP AF ;
|
16322 |
|
|
RR B ;
|
16323 |
|
|
EXX ;
|
16324 |
|
|
POP BC ;
|
16325 |
|
|
POP HL ;
|
16326 |
|
|
LD A,B ;
|
16327 |
|
|
SUB C ;
|
16328 |
|
|
JP L313D ; jump back to DIVN-EXPT
|
16329 |
|
|
|
16330 |
|
|
; ------------------------------------
|
16331 |
|
|
; Integer truncation towards zero ($3A)
|
16332 |
|
|
; ------------------------------------
|
16333 |
|
|
;
|
16334 |
|
|
;
|
16335 |
|
|
|
16336 |
|
|
;; truncate
|
16337 |
|
|
L3214: LD A,(HL) ;
|
16338 |
|
|
AND A ;
|
16339 |
|
|
RET Z ;
|
16340 |
|
|
|
16341 |
|
|
CP $81 ;
|
16342 |
|
|
JR NC,L3221 ; to T-GR-ZERO
|
16343 |
|
|
|
16344 |
|
|
LD (HL),$00 ;
|
16345 |
|
|
LD A,$20 ;
|
16346 |
|
|
JR L3272 ; to NIL-BYTES
|
16347 |
|
|
|
16348 |
|
|
; ---
|
16349 |
|
|
|
16350 |
|
|
;; T-GR-ZERO
|
16351 |
|
|
L3221: CP $91 ;
|
16352 |
|
|
JR NZ,L323F ; to T-SMALL
|
16353 |
|
|
|
16354 |
|
|
INC HL ;
|
16355 |
|
|
INC HL ;
|
16356 |
|
|
INC HL ;
|
16357 |
|
|
LD A,$80 ;
|
16358 |
|
|
AND (HL) ;
|
16359 |
|
|
DEC HL ;
|
16360 |
|
|
OR (HL) ;
|
16361 |
|
|
DEC HL ;
|
16362 |
|
|
JR NZ,L3233 ; to T-FIRST
|
16363 |
|
|
|
16364 |
|
|
LD A,$80 ;
|
16365 |
|
|
XOR (HL) ;
|
16366 |
|
|
|
16367 |
|
|
;; T-FIRST
|
16368 |
|
|
L3233: DEC HL ;
|
16369 |
|
|
JR NZ,L326C ; to T-EXPNENT
|
16370 |
|
|
|
16371 |
|
|
LD (HL),A ;
|
16372 |
|
|
INC HL ;
|
16373 |
|
|
LD (HL),$FF ;
|
16374 |
|
|
DEC HL ;
|
16375 |
|
|
LD A,$18 ;
|
16376 |
|
|
JR L3272 ; to NIL-BYTES
|
16377 |
|
|
|
16378 |
|
|
; ---
|
16379 |
|
|
|
16380 |
|
|
;; T-SMALL
|
16381 |
|
|
L323F: JR NC,L326D ; to X-LARGE
|
16382 |
|
|
|
16383 |
|
|
PUSH DE ;
|
16384 |
|
|
CPL ;
|
16385 |
|
|
ADD A,$91 ;
|
16386 |
|
|
INC HL ;
|
16387 |
|
|
LD D,(HL) ;
|
16388 |
|
|
INC HL ;
|
16389 |
|
|
LD E,(HL) ;
|
16390 |
|
|
DEC HL ;
|
16391 |
|
|
DEC HL ;
|
16392 |
|
|
LD C,$00 ;
|
16393 |
|
|
BIT 7,D ;
|
16394 |
|
|
JR Z,L3252 ; to T-NUMERIC
|
16395 |
|
|
|
16396 |
|
|
DEC C ;
|
16397 |
|
|
|
16398 |
|
|
;; T-NUMERIC
|
16399 |
|
|
L3252: SET 7,D ;
|
16400 |
|
|
LD B,$08 ;
|
16401 |
|
|
SUB B ;
|
16402 |
|
|
ADD A,B ;
|
16403 |
|
|
JR C,L325E ; to T-TEST
|
16404 |
|
|
|
16405 |
|
|
LD E,D ;
|
16406 |
|
|
LD D,$00 ;
|
16407 |
|
|
SUB B ;
|
16408 |
|
|
|
16409 |
|
|
;; T-TEST
|
16410 |
|
|
L325E: JR Z,L3267 ; to T-STORE
|
16411 |
|
|
|
16412 |
|
|
LD B,A ;
|
16413 |
|
|
|
16414 |
|
|
;; T-SHIFT
|
16415 |
|
|
L3261: SRL D ;
|
16416 |
|
|
RR E ;
|
16417 |
|
|
DJNZ L3261 ; to T-SHIFT
|
16418 |
|
|
|
16419 |
|
|
;; T-STORE
|
16420 |
|
|
L3267: CALL L2D8E ; routine INT-STORE
|
16421 |
|
|
POP DE ;
|
16422 |
|
|
RET ;
|
16423 |
|
|
|
16424 |
|
|
; ---
|
16425 |
|
|
|
16426 |
|
|
;; T-EXPNENT
|
16427 |
|
|
L326C: LD A,(HL) ;
|
16428 |
|
|
|
16429 |
|
|
;; X-LARGE
|
16430 |
|
|
L326D: SUB $A0 ;
|
16431 |
|
|
RET P ;
|
16432 |
|
|
|
16433 |
|
|
NEG ; Negate
|
16434 |
|
|
|
16435 |
|
|
;; NIL-BYTES
|
16436 |
|
|
L3272: PUSH DE ;
|
16437 |
|
|
EX DE,HL ;
|
16438 |
|
|
DEC HL ;
|
16439 |
|
|
LD B,A ;
|
16440 |
|
|
SRL B ;
|
16441 |
|
|
SRL B ;
|
16442 |
|
|
SRL B ;
|
16443 |
|
|
JR Z,L3283 ; to BITS-ZERO
|
16444 |
|
|
|
16445 |
|
|
;; BYTE-ZERO
|
16446 |
|
|
L327E: LD (HL),$00 ;
|
16447 |
|
|
DEC HL ;
|
16448 |
|
|
DJNZ L327E ; to BYTE-ZERO
|
16449 |
|
|
|
16450 |
|
|
;; BITS-ZERO
|
16451 |
|
|
L3283: AND $07 ;
|
16452 |
|
|
JR Z,L3290 ; to IX-END
|
16453 |
|
|
|
16454 |
|
|
LD B,A ;
|
16455 |
|
|
LD A,$FF ;
|
16456 |
|
|
|
16457 |
|
|
;; LESS-MASK
|
16458 |
|
|
L328A: SLA A ;
|
16459 |
|
|
DJNZ L328A ; to LESS-MASK
|
16460 |
|
|
|
16461 |
|
|
AND (HL) ;
|
16462 |
|
|
LD (HL),A ;
|
16463 |
|
|
|
16464 |
|
|
;; IX-END
|
16465 |
|
|
L3290: EX DE,HL ;
|
16466 |
|
|
POP DE ;
|
16467 |
|
|
RET ;
|
16468 |
|
|
|
16469 |
|
|
; ----------------------------------
|
16470 |
|
|
; Storage of numbers in 5 byte form.
|
16471 |
|
|
; ==================================
|
16472 |
|
|
; Both integers and floating-point numbers can be stored in five bytes.
|
16473 |
|
|
; Zero is a special case stored as 5 zeros.
|
16474 |
|
|
; For integers the form is
|
16475 |
|
|
; Byte 1 - zero,
|
16476 |
|
|
; Byte 2 - sign byte, $00 +ve, $FF -ve.
|
16477 |
|
|
; Byte 3 - Low byte of integer.
|
16478 |
|
|
; Byte 4 - High byte
|
16479 |
|
|
; Byte 5 - unused but always zero.
|
16480 |
|
|
;
|
16481 |
|
|
; it seems unusual to store the low byte first but it is just as easy either
|
16482 |
|
|
; way. Statistically it just increases the chances of trailing zeros which
|
16483 |
|
|
; is an advantage elsewhere in saving ROM code.
|
16484 |
|
|
;
|
16485 |
|
|
; zero sign low high unused
|
16486 |
|
|
; So +1 is 00000000 00000000 00000001 00000000 00000000
|
16487 |
|
|
;
|
16488 |
|
|
; and -1 is 00000000 11111111 11111111 11111111 00000000
|
16489 |
|
|
;
|
16490 |
|
|
; much of the arithmetic found in BASIC lines can be done using numbers
|
16491 |
|
|
; in this form using the Z80's 16 bit register operation ADD.
|
16492 |
|
|
; (multiplication is done by a sequence of additions).
|
16493 |
|
|
;
|
16494 |
|
|
; Storing -ve integers in two's complement form, means that they are ready for
|
16495 |
|
|
; addition and you might like to add the numbers above to prove that the
|
16496 |
|
|
; answer is zero. If, as in this case, the carry is set then that denotes that
|
16497 |
|
|
; the result is positive. This only applies when the signs don't match.
|
16498 |
|
|
; With positive numbers a carry denotes the result is out of integer range.
|
16499 |
|
|
; With negative numbers a carry denotes the result is within range.
|
16500 |
|
|
; The exception to the last rule is when the result is -65536
|
16501 |
|
|
;
|
16502 |
|
|
; Floating point form is an alternative method of storing numbers which can
|
16503 |
|
|
; be used for integers and larger (or fractional) numbers.
|
16504 |
|
|
;
|
16505 |
|
|
; In this form 1 is stored as
|
16506 |
|
|
; 10000001 00000000 00000000 00000000 00000000
|
16507 |
|
|
;
|
16508 |
|
|
; When a small integer is converted to a floating point number the last two
|
16509 |
|
|
; bytes are always blank so they are omitted in the following steps
|
16510 |
|
|
;
|
16511 |
|
|
; first make exponent +1 +16d (bit 7 of the exponent is set if positive)
|
16512 |
|
|
|
16513 |
|
|
; 10010001 00000000 00000001
|
16514 |
|
|
; 10010000 00000000 00000010 <- now shift left and decrement exponent
|
16515 |
|
|
; ...
|
16516 |
|
|
; 10000010 01000000 00000000 <- until a 1 abuts the imaginary point
|
16517 |
|
|
; 10000001 10000000 00000000 to the left of the mantissa.
|
16518 |
|
|
;
|
16519 |
|
|
; however since the leftmost bit of the mantissa is always set then it can
|
16520 |
|
|
; be used to denote the sign of the mantissa and put back when needed by the
|
16521 |
|
|
; PREP routines which gives
|
16522 |
|
|
;
|
16523 |
|
|
; 10000001 00000000 00000000
|
16524 |
|
|
|
16525 |
|
|
; ----------------------------------------------
|
16526 |
|
|
; THE 'RE-STACK TWO "SMALL" INTEGERS' SUBROUTINE
|
16527 |
|
|
; ----------------------------------------------
|
16528 |
|
|
; This routine is called to re-stack two numbers in full floating point form
|
16529 |
|
|
; e.g. from mult when integer multiplication has overflowed.
|
16530 |
|
|
|
16531 |
|
|
;; RE-ST-TWO
|
16532 |
|
|
L3293: CALL L3296 ; routine RESTK-SUB below and continue
|
16533 |
|
|
; into the routine to do the other one.
|
16534 |
|
|
|
16535 |
|
|
;; RESTK-SUB
|
16536 |
|
|
L3296: EX DE,HL ; swap pointers
|
16537 |
|
|
|
16538 |
|
|
; ---------------------------------------------
|
16539 |
|
|
; THE 'RE-STACK ONE "SMALL" INTEGER' SUBROUTINE
|
16540 |
|
|
; ---------------------------------------------
|
16541 |
|
|
; (offset: $3D 're-stack')
|
16542 |
|
|
; This routine re-stacks an integer, usually on the calculator stack, in full
|
16543 |
|
|
; floating point form. HL points to first byte.
|
16544 |
|
|
|
16545 |
|
|
;; re-stack
|
16546 |
|
|
L3297: LD A,(HL) ; Fetch Exponent byte to A
|
16547 |
|
|
AND A ; test it
|
16548 |
|
|
RET NZ ; return if not zero as already in full
|
16549 |
|
|
; floating-point form.
|
16550 |
|
|
|
16551 |
|
|
PUSH DE ; preserve DE.
|
16552 |
|
|
CALL L2D7F ; routine INT-FETCH
|
16553 |
|
|
; integer to DE, sign to C.
|
16554 |
|
|
|
16555 |
|
|
; HL points to 4th byte.
|
16556 |
|
|
|
16557 |
|
|
XOR A ; clear accumulator.
|
16558 |
|
|
INC HL ; point to 5th.
|
16559 |
|
|
LD (HL),A ; and blank.
|
16560 |
|
|
DEC HL ; point to 4th.
|
16561 |
|
|
LD (HL),A ; and blank.
|
16562 |
|
|
|
16563 |
|
|
LD B,$91 ; set exponent byte +ve $81
|
16564 |
|
|
; and imaginary dec point 16 bits to right
|
16565 |
|
|
; of first bit.
|
16566 |
|
|
|
16567 |
|
|
; we could skip to normalize now but it's quicker to avoid normalizing
|
16568 |
|
|
; through an empty D.
|
16569 |
|
|
|
16570 |
|
|
LD A,D ; fetch the high byte D
|
16571 |
|
|
AND A ; is it zero ?
|
16572 |
|
|
JR NZ,L32B1 ; skip to RS-NRMLSE if not.
|
16573 |
|
|
|
16574 |
|
|
OR E ; low byte E to A and test for zero
|
16575 |
|
|
LD B,D ; set B exponent to 0
|
16576 |
|
|
JR Z,L32BD ; forward to RS-STORE if value is zero.
|
16577 |
|
|
|
16578 |
|
|
LD D,E ; transfer E to D
|
16579 |
|
|
LD E,B ; set E to 0
|
16580 |
|
|
LD B,$89 ; reduce the initial exponent by eight.
|
16581 |
|
|
|
16582 |
|
|
|
16583 |
|
|
;; RS-NRMLSE
|
16584 |
|
|
L32B1: EX DE,HL ; integer to HL, addr of 4th byte to DE.
|
16585 |
|
|
|
16586 |
|
|
;; RSTK-LOOP
|
16587 |
|
|
L32B2: DEC B ; decrease exponent
|
16588 |
|
|
ADD HL,HL ; shift DE left
|
16589 |
|
|
JR NC,L32B2 ; loop back to RSTK-LOOP
|
16590 |
|
|
; until a set bit pops into carry
|
16591 |
|
|
|
16592 |
|
|
RRC C ; now rotate the sign byte $00 or $FF
|
16593 |
|
|
; into carry to give a sign bit
|
16594 |
|
|
|
16595 |
|
|
RR H ; rotate the sign bit to left of H
|
16596 |
|
|
RR L ; rotate any carry into L
|
16597 |
|
|
|
16598 |
|
|
EX DE,HL ; address 4th byte, normalized int to DE
|
16599 |
|
|
|
16600 |
|
|
;; RS-STORE
|
16601 |
|
|
L32BD: DEC HL ; address 3rd byte
|
16602 |
|
|
LD (HL),E ; place E
|
16603 |
|
|
DEC HL ; address 2nd byte
|
16604 |
|
|
LD (HL),D ; place D
|
16605 |
|
|
DEC HL ; address 1st byte
|
16606 |
|
|
LD (HL),B ; store the exponent
|
16607 |
|
|
|
16608 |
|
|
POP DE ; restore initial DE.
|
16609 |
|
|
RET ; return.
|
16610 |
|
|
|
16611 |
|
|
;****************************************
|
16612 |
|
|
;** Part 10. FLOATING-POINT CALCULATOR **
|
16613 |
|
|
;****************************************
|
16614 |
|
|
|
16615 |
|
|
; As a general rule the calculator avoids using the IY register.
|
16616 |
|
|
; exceptions are val, val$ and str$.
|
16617 |
|
|
; So an assembly language programmer who has disabled interrupts to use
|
16618 |
|
|
; IY for other purposes can still use the calculator for mathematical
|
16619 |
|
|
; purposes.
|
16620 |
|
|
|
16621 |
|
|
|
16622 |
|
|
; ------------------------
|
16623 |
|
|
; THE 'TABLE OF CONSTANTS'
|
16624 |
|
|
; ------------------------
|
16625 |
|
|
;
|
16626 |
|
|
;
|
16627 |
|
|
|
16628 |
|
|
; used 11 times
|
16629 |
|
|
;; stk-zero 00 00 00 00 00
|
16630 |
|
|
L32C5: DEFB $00 ;;Bytes: 1
|
16631 |
|
|
DEFB $B0 ;;Exponent $00
|
16632 |
|
|
DEFB $00 ;;(+00,+00,+00)
|
16633 |
|
|
|
16634 |
|
|
; used 19 times
|
16635 |
|
|
;; stk-one 00 00 01 00 00
|
16636 |
|
|
L32C8: DEFB $40 ;;Bytes: 2
|
16637 |
|
|
DEFB $B0 ;;Exponent $00
|
16638 |
|
|
DEFB $00,$01 ;;(+00,+00)
|
16639 |
|
|
|
16640 |
|
|
; used 9 times
|
16641 |
|
|
;; stk-half 80 00 00 00 00
|
16642 |
|
|
L32CC: DEFB $30 ;;Exponent: $80, Bytes: 1
|
16643 |
|
|
DEFB $00 ;;(+00,+00,+00)
|
16644 |
|
|
|
16645 |
|
|
; used 4 times.
|
16646 |
|
|
;; stk-pi/2 81 49 0F DA A2
|
16647 |
|
|
L32CE: DEFB $F1 ;;Exponent: $81, Bytes: 4
|
16648 |
|
|
DEFB $49,$0F,$DA,$A2 ;;
|
16649 |
|
|
|
16650 |
|
|
; used 3 times.
|
16651 |
|
|
;; stk-ten 00 00 0A 00 00
|
16652 |
|
|
L32D3: DEFB $40 ;;Bytes: 2
|
16653 |
|
|
DEFB $B0 ;;Exponent $00
|
16654 |
|
|
DEFB $00,$0A ;;(+00,+00)
|
16655 |
|
|
|
16656 |
|
|
|
16657 |
|
|
; ------------------------
|
16658 |
|
|
; THE 'TABLE OF ADDRESSES'
|
16659 |
|
|
; ------------------------
|
16660 |
|
|
; "Each problem that I solved became a rule which served afterwards to solve
|
16661 |
|
|
; other problems" - Rene Descartes 1596 - 1650.
|
16662 |
|
|
;
|
16663 |
|
|
; Starts with binary operations which have two operands and one result.
|
16664 |
|
|
; Three pseudo binary operations first.
|
16665 |
|
|
|
16666 |
|
|
;; tbl-addrs
|
16667 |
|
|
L32D7: DEFW L368F ; $00 Address: $368F - jump-true
|
16668 |
|
|
DEFW L343C ; $01 Address: $343C - exchange
|
16669 |
|
|
DEFW L33A1 ; $02 Address: $33A1 - delete
|
16670 |
|
|
|
16671 |
|
|
; True binary operations.
|
16672 |
|
|
|
16673 |
|
|
DEFW L300F ; $03 Address: $300F - subtract
|
16674 |
|
|
DEFW L30CA ; $04 Address: $30CA - multiply
|
16675 |
|
|
DEFW L31AF ; $05 Address: $31AF - division
|
16676 |
|
|
DEFW L3851 ; $06 Address: $3851 - to-power
|
16677 |
|
|
DEFW L351B ; $07 Address: $351B - or
|
16678 |
|
|
|
16679 |
|
|
DEFW L3524 ; $08 Address: $3524 - no-&-no
|
16680 |
|
|
DEFW L353B ; $09 Address: $353B - no-l-eql
|
16681 |
|
|
DEFW L353B ; $0A Address: $353B - no-gr-eql
|
16682 |
|
|
DEFW L353B ; $0B Address: $353B - nos-neql
|
16683 |
|
|
DEFW L353B ; $0C Address: $353B - no-grtr
|
16684 |
|
|
DEFW L353B ; $0D Address: $353B - no-less
|
16685 |
|
|
DEFW L353B ; $0E Address: $353B - nos-eql
|
16686 |
|
|
DEFW L3014 ; $0F Address: $3014 - addition
|
16687 |
|
|
|
16688 |
|
|
DEFW L352D ; $10 Address: $352D - str-&-no
|
16689 |
|
|
DEFW L353B ; $11 Address: $353B - str-l-eql
|
16690 |
|
|
DEFW L353B ; $12 Address: $353B - str-gr-eql
|
16691 |
|
|
DEFW L353B ; $13 Address: $353B - strs-neql
|
16692 |
|
|
DEFW L353B ; $14 Address: $353B - str-grtr
|
16693 |
|
|
DEFW L353B ; $15 Address: $353B - str-less
|
16694 |
|
|
DEFW L353B ; $16 Address: $353B - strs-eql
|
16695 |
|
|
DEFW L359C ; $17 Address: $359C - strs-add
|
16696 |
|
|
|
16697 |
|
|
; Unary follow.
|
16698 |
|
|
|
16699 |
|
|
DEFW L35DE ; $18 Address: $35DE - val$
|
16700 |
|
|
DEFW L34BC ; $19 Address: $34BC - usr-$
|
16701 |
|
|
DEFW L3645 ; $1A Address: $3645 - read-in
|
16702 |
|
|
DEFW L346E ; $1B Address: $346E - negate
|
16703 |
|
|
|
16704 |
|
|
DEFW L3669 ; $1C Address: $3669 - code
|
16705 |
|
|
DEFW L35DE ; $1D Address: $35DE - val
|
16706 |
|
|
DEFW L3674 ; $1E Address: $3674 - len
|
16707 |
|
|
DEFW L37B5 ; $1F Address: $37B5 - sin
|
16708 |
|
|
DEFW L37AA ; $20 Address: $37AA - cos
|
16709 |
|
|
DEFW L37DA ; $21 Address: $37DA - tan
|
16710 |
|
|
DEFW L3833 ; $22 Address: $3833 - asn
|
16711 |
|
|
DEFW L3843 ; $23 Address: $3843 - acs
|
16712 |
|
|
DEFW L37E2 ; $24 Address: $37E2 - atn
|
16713 |
|
|
DEFW L3713 ; $25 Address: $3713 - ln
|
16714 |
|
|
DEFW L36C4 ; $26 Address: $36C4 - exp
|
16715 |
|
|
DEFW L36AF ; $27 Address: $36AF - int
|
16716 |
|
|
DEFW L384A ; $28 Address: $384A - sqr
|
16717 |
|
|
DEFW L3492 ; $29 Address: $3492 - sgn
|
16718 |
|
|
DEFW L346A ; $2A Address: $346A - abs
|
16719 |
|
|
DEFW L34AC ; $2B Address: $34AC - peek
|
16720 |
|
|
DEFW L34A5 ; $2C Address: $34A5 - in
|
16721 |
|
|
DEFW L34B3 ; $2D Address: $34B3 - usr-no
|
16722 |
|
|
DEFW L361F ; $2E Address: $361F - str$
|
16723 |
|
|
DEFW L35C9 ; $2F Address: $35C9 - chrs
|
16724 |
|
|
DEFW L3501 ; $30 Address: $3501 - not
|
16725 |
|
|
|
16726 |
|
|
; End of true unary.
|
16727 |
|
|
|
16728 |
|
|
DEFW L33C0 ; $31 Address: $33C0 - duplicate
|
16729 |
|
|
DEFW L36A0 ; $32 Address: $36A0 - n-mod-m
|
16730 |
|
|
DEFW L3686 ; $33 Address: $3686 - jump
|
16731 |
|
|
DEFW L33C6 ; $34 Address: $33C6 - stk-data
|
16732 |
|
|
DEFW L367A ; $35 Address: $367A - dec-jr-nz
|
16733 |
|
|
DEFW L3506 ; $36 Address: $3506 - less-0
|
16734 |
|
|
DEFW L34F9 ; $37 Address: $34F9 - greater-0
|
16735 |
|
|
DEFW L369B ; $38 Address: $369B - end-calc
|
16736 |
|
|
DEFW L3783 ; $39 Address: $3783 - get-argt
|
16737 |
|
|
DEFW L3214 ; $3A Address: $3214 - truncate
|
16738 |
|
|
DEFW L33A2 ; $3B Address: $33A2 - fp-calc-2
|
16739 |
|
|
DEFW L2D4F ; $3C Address: $2D4F - e-to-fp
|
16740 |
|
|
DEFW L3297 ; $3D Address: $3297 - re-stack
|
16741 |
|
|
|
16742 |
|
|
; The following are just the next available slots for the 128 compound
|
16743 |
|
|
; literals which are in range $80 - $FF.
|
16744 |
|
|
|
16745 |
|
|
DEFW L3449 ; Address: $3449 - series-xx $80 - $9F.
|
16746 |
|
|
DEFW L341B ; Address: $341B - stk-const-xx $A0 - $BF.
|
16747 |
|
|
DEFW L342D ; Address: $342D - st-mem-xx $C0 - $DF.
|
16748 |
|
|
DEFW L340F ; Address: $340F - get-mem-xx $E0 - $FF.
|
16749 |
|
|
|
16750 |
|
|
; Aside: 3E - 3F are therefore unused calculator literals.
|
16751 |
|
|
; If the literal has to be also usable as a function then bits 6 and 7 are
|
16752 |
|
|
; used to show type of arguments and result.
|
16753 |
|
|
|
16754 |
|
|
; --------------
|
16755 |
|
|
; The Calculator
|
16756 |
|
|
; --------------
|
16757 |
|
|
; "A good calculator does not need artificial aids"
|
16758 |
|
|
; Lao Tze 604 - 531 B.C.
|
16759 |
|
|
|
16760 |
|
|
;; CALCULATE
|
16761 |
|
|
L335B: CALL L35BF ; routine STK-PNTRS is called to set up the
|
16762 |
|
|
; calculator stack pointers for a default
|
16763 |
|
|
; unary operation. HL = last value on stack.
|
16764 |
|
|
; DE = STKEND first location after stack.
|
16765 |
|
|
|
16766 |
|
|
; the calculate routine is called at this point by the series generator...
|
16767 |
|
|
|
16768 |
|
|
;; GEN-ENT-1
|
16769 |
|
|
L335E: LD A,B ; fetch the Z80 B register to A
|
16770 |
|
|
LD ($5C67),A ; and store value in system variable BREG.
|
16771 |
|
|
; this will be the counter for dec-jr-nz
|
16772 |
|
|
; or if used from fp-calc2 the calculator
|
16773 |
|
|
; instruction.
|
16774 |
|
|
|
16775 |
|
|
; ... and again later at this point
|
16776 |
|
|
|
16777 |
|
|
;; GEN-ENT-2
|
16778 |
|
|
L3362: EXX ; switch sets
|
16779 |
|
|
EX (SP),HL ; and store the address of next instruction,
|
16780 |
|
|
; the return address, in H'L'.
|
16781 |
|
|
; If this is a recursive call the H'L'
|
16782 |
|
|
; of the previous invocation goes on stack.
|
16783 |
|
|
; c.f. end-calc.
|
16784 |
|
|
EXX ; switch back to main set
|
16785 |
|
|
|
16786 |
|
|
; this is the re-entry looping point when handling a string of literals.
|
16787 |
|
|
|
16788 |
|
|
;; RE-ENTRY
|
16789 |
|
|
L3365: LD ($5C65),DE ; save end of stack in system variable STKEND
|
16790 |
|
|
EXX ; switch to alt
|
16791 |
|
|
LD A,(HL) ; get next literal
|
16792 |
|
|
INC HL ; increase pointer'
|
16793 |
|
|
|
16794 |
|
|
; single operation jumps back to here
|
16795 |
|
|
|
16796 |
|
|
;; SCAN-ENT
|
16797 |
|
|
L336C: PUSH HL ; save pointer on stack
|
16798 |
|
|
AND A ; now test the literal
|
16799 |
|
|
JP P,L3380 ; forward to FIRST-3D if in range $00 - $3D
|
16800 |
|
|
; anything with bit 7 set will be one of
|
16801 |
|
|
; 128 compound literals.
|
16802 |
|
|
|
16803 |
|
|
; compound literals have the following format.
|
16804 |
|
|
; bit 7 set indicates compound.
|
16805 |
|
|
; bits 6-5 the subgroup 0-3.
|
16806 |
|
|
; bits 4-0 the embedded parameter $00 - $1F.
|
16807 |
|
|
; The subgroup 0-3 needs to be manipulated to form the next available four
|
16808 |
|
|
; address places after the simple literals in the address table.
|
16809 |
|
|
|
16810 |
|
|
LD D,A ; save literal in D
|
16811 |
|
|
AND $60 ; and with 01100000 to isolate subgroup
|
16812 |
|
|
RRCA ; rotate bits
|
16813 |
|
|
RRCA ; 4 places to right
|
16814 |
|
|
RRCA ; not five as we need offset * 2
|
16815 |
|
|
RRCA ; 00000xx0
|
16816 |
|
|
ADD A,$7C ; add ($3E * 2) to give correct offset.
|
16817 |
|
|
; alter above if you add more literals.
|
16818 |
|
|
LD L,A ; store in L for later indexing.
|
16819 |
|
|
LD A,D ; bring back compound literal
|
16820 |
|
|
AND $1F ; use mask to isolate parameter bits
|
16821 |
|
|
JR L338E ; forward to ENT-TABLE
|
16822 |
|
|
|
16823 |
|
|
; ---
|
16824 |
|
|
|
16825 |
|
|
; the branch was here with simple literals.
|
16826 |
|
|
|
16827 |
|
|
;; FIRST-3D
|
16828 |
|
|
L3380: CP $18 ; compare with first unary operations.
|
16829 |
|
|
JR NC,L338C ; to DOUBLE-A with unary operations
|
16830 |
|
|
|
16831 |
|
|
; it is binary so adjust pointers.
|
16832 |
|
|
|
16833 |
|
|
EXX ;
|
16834 |
|
|
LD BC,$FFFB ; the value -5
|
16835 |
|
|
LD D,H ; transfer HL, the last value, to DE.
|
16836 |
|
|
LD E,L ;
|
16837 |
|
|
ADD HL,BC ; subtract 5 making HL point to second
|
16838 |
|
|
; value.
|
16839 |
|
|
EXX ;
|
16840 |
|
|
|
16841 |
|
|
;; DOUBLE-A
|
16842 |
|
|
L338C: RLCA ; double the literal
|
16843 |
|
|
LD L,A ; and store in L for indexing
|
16844 |
|
|
|
16845 |
|
|
;; ENT-TABLE
|
16846 |
|
|
L338E: LD DE,L32D7 ; Address: tbl-addrs
|
16847 |
|
|
LD H,$00 ; prepare to index
|
16848 |
|
|
ADD HL,DE ; add to get address of routine
|
16849 |
|
|
LD E,(HL) ; low byte to E
|
16850 |
|
|
INC HL ;
|
16851 |
|
|
LD D,(HL) ; high byte to D
|
16852 |
|
|
LD HL,L3365 ; Address: RE-ENTRY
|
16853 |
|
|
EX (SP),HL ; goes to stack
|
16854 |
|
|
PUSH DE ; now address of routine
|
16855 |
|
|
EXX ; main set
|
16856 |
|
|
; avoid using IY register.
|
16857 |
|
|
LD BC,($5C66) ; STKEND_hi
|
16858 |
|
|
; nothing much goes to C but BREG to B
|
16859 |
|
|
; and continue into next ret instruction
|
16860 |
|
|
; which has a dual identity
|
16861 |
|
|
|
16862 |
|
|
|
16863 |
|
|
; ------------------
|
16864 |
|
|
; Handle delete (02)
|
16865 |
|
|
; ------------------
|
16866 |
|
|
; A simple return but when used as a calculator literal this
|
16867 |
|
|
; deletes the last value from the calculator stack.
|
16868 |
|
|
; On entry, as always with binary operations,
|
16869 |
|
|
; HL=first number, DE=second number
|
16870 |
|
|
; On exit, HL=result, DE=stkend.
|
16871 |
|
|
; So nothing to do
|
16872 |
|
|
|
16873 |
|
|
;; delete
|
16874 |
|
|
L33A1: RET ; return - indirect jump if from above.
|
16875 |
|
|
|
16876 |
|
|
; ---------------------
|
16877 |
|
|
; Single operation (3B)
|
16878 |
|
|
; ---------------------
|
16879 |
|
|
; This single operation is used, in the first instance, to evaluate most
|
16880 |
|
|
; of the mathematical and string functions found in BASIC expressions.
|
16881 |
|
|
|
16882 |
|
|
;; fp-calc-2
|
16883 |
|
|
L33A2: POP AF ; drop return address.
|
16884 |
|
|
LD A,($5C67) ; load accumulator from system variable BREG
|
16885 |
|
|
; value will be literal e.g. 'tan'
|
16886 |
|
|
EXX ; switch to alt
|
16887 |
|
|
JR L336C ; back to SCAN-ENT
|
16888 |
|
|
; next literal will be end-calc at L2758
|
16889 |
|
|
|
16890 |
|
|
; ---------------------------------
|
16891 |
|
|
; THE 'TEST FIVE SPACES' SUBROUTINE
|
16892 |
|
|
; ---------------------------------
|
16893 |
|
|
; This routine is called from MOVE-FP, STK-CONST and STK-STORE to test that
|
16894 |
|
|
; there is enough space between the calculator stack and the machine stack
|
16895 |
|
|
; for another five-byte value. It returns with BC holding the value 5 ready
|
16896 |
|
|
; for any subsequent LDIR.
|
16897 |
|
|
|
16898 |
|
|
;; TEST-5-SP
|
16899 |
|
|
L33A9: PUSH DE ; save
|
16900 |
|
|
PUSH HL ; registers
|
16901 |
|
|
LD BC,$0005 ; an overhead of five bytes
|
16902 |
|
|
CALL L1F05 ; routine TEST-ROOM tests free RAM raising
|
16903 |
|
|
; an error if not.
|
16904 |
|
|
POP HL ; else restore
|
16905 |
|
|
POP DE ; registers.
|
16906 |
|
|
RET ; return with BC set at 5.
|
16907 |
|
|
|
16908 |
|
|
; -----------------------------
|
16909 |
|
|
; THE 'STACK NUMBER' SUBROUTINE
|
16910 |
|
|
; -----------------------------
|
16911 |
|
|
; This routine is called to stack a hidden floating point number found in
|
16912 |
|
|
; a BASIC line. It is also called to stack a numeric variable value, and
|
16913 |
|
|
; from BEEP, to stack an entry in the semi-tone table. It is not part of the
|
16914 |
|
|
; calculator suite of routines. On entry, HL points to the number to be
|
16915 |
|
|
; stacked.
|
16916 |
|
|
|
16917 |
|
|
;; STACK-NUM
|
16918 |
|
|
L33B4: LD DE,($5C65) ; Load destination from STKEND system variable.
|
16919 |
|
|
|
16920 |
|
|
CALL L33C0 ; Routine MOVE-FP puts on calculator stack
|
16921 |
|
|
; with a memory check.
|
16922 |
|
|
LD ($5C65),DE ; Set STKEND to next free location.
|
16923 |
|
|
|
16924 |
|
|
RET ; Return.
|
16925 |
|
|
|
16926 |
|
|
; ---------------------------------
|
16927 |
|
|
; Move a floating point number (31)
|
16928 |
|
|
; ---------------------------------
|
16929 |
|
|
|
16930 |
|
|
; This simple routine is a 5-byte LDIR instruction
|
16931 |
|
|
; that incorporates a memory check.
|
16932 |
|
|
; When used as a calculator literal it duplicates the last value on the
|
16933 |
|
|
; calculator stack.
|
16934 |
|
|
; Unary so on entry HL points to last value, DE to stkend
|
16935 |
|
|
|
16936 |
|
|
;; duplicate
|
16937 |
|
|
;; MOVE-FP
|
16938 |
|
|
L33C0: CALL L33A9 ; routine TEST-5-SP test free memory
|
16939 |
|
|
; and sets BC to 5.
|
16940 |
|
|
LDIR ; copy the five bytes.
|
16941 |
|
|
RET ; return with DE addressing new STKEND
|
16942 |
|
|
; and HL addressing new last value.
|
16943 |
|
|
|
16944 |
|
|
; -------------------
|
16945 |
|
|
; Stack literals ($34)
|
16946 |
|
|
; -------------------
|
16947 |
|
|
; When a calculator subroutine needs to put a value on the calculator
|
16948 |
|
|
; stack that is not a regular constant this routine is called with a
|
16949 |
|
|
; variable number of following data bytes that convey to the routine
|
16950 |
|
|
; the integer or floating point form as succinctly as is possible.
|
16951 |
|
|
|
16952 |
|
|
;; stk-data
|
16953 |
|
|
L33C6: LD H,D ; transfer STKEND
|
16954 |
|
|
LD L,E ; to HL for result.
|
16955 |
|
|
|
16956 |
|
|
;; STK-CONST
|
16957 |
|
|
L33C8: CALL L33A9 ; routine TEST-5-SP tests that room exists
|
16958 |
|
|
; and sets BC to $05.
|
16959 |
|
|
|
16960 |
|
|
EXX ; switch to alternate set
|
16961 |
|
|
PUSH HL ; save the pointer to next literal on stack
|
16962 |
|
|
EXX ; switch back to main set
|
16963 |
|
|
|
16964 |
|
|
EX (SP),HL ; pointer to HL, destination to stack.
|
16965 |
|
|
|
16966 |
|
|
PUSH BC ; save BC - value 5 from test room ??.
|
16967 |
|
|
|
16968 |
|
|
LD A,(HL) ; fetch the byte following 'stk-data'
|
16969 |
|
|
AND $C0 ; isolate bits 7 and 6
|
16970 |
|
|
RLCA ; rotate
|
16971 |
|
|
RLCA ; to bits 1 and 0 range $00 - $03.
|
16972 |
|
|
LD C,A ; transfer to C
|
16973 |
|
|
INC C ; and increment to give number of bytes
|
16974 |
|
|
; to read. $01 - $04
|
16975 |
|
|
LD A,(HL) ; reload the first byte
|
16976 |
|
|
AND $3F ; mask off to give possible exponent.
|
16977 |
|
|
JR NZ,L33DE ; forward to FORM-EXP if it was possible to
|
16978 |
|
|
; include the exponent.
|
16979 |
|
|
|
16980 |
|
|
; else byte is just a byte count and exponent comes next.
|
16981 |
|
|
|
16982 |
|
|
INC HL ; address next byte and
|
16983 |
|
|
LD A,(HL) ; pick up the exponent ( - $50).
|
16984 |
|
|
|
16985 |
|
|
;; FORM-EXP
|
16986 |
|
|
L33DE: ADD A,$50 ; now add $50 to form actual exponent
|
16987 |
|
|
LD (DE),A ; and load into first destination byte.
|
16988 |
|
|
LD A,$05 ; load accumulator with $05 and
|
16989 |
|
|
SUB C ; subtract C to give count of trailing
|
16990 |
|
|
; zeros plus one.
|
16991 |
|
|
INC HL ; increment source
|
16992 |
|
|
INC DE ; increment destination
|
16993 |
|
|
LD B,$00 ; prepare to copy
|
16994 |
|
|
LDIR ; copy C bytes
|
16995 |
|
|
|
16996 |
|
|
POP BC ; restore 5 counter to BC ??.
|
16997 |
|
|
|
16998 |
|
|
EX (SP),HL ; put HL on stack as next literal pointer
|
16999 |
|
|
; and the stack value - result pointer -
|
17000 |
|
|
; to HL.
|
17001 |
|
|
|
17002 |
|
|
EXX ; switch to alternate set.
|
17003 |
|
|
POP HL ; restore next literal pointer from stack
|
17004 |
|
|
; to H'L'.
|
17005 |
|
|
EXX ; switch back to main set.
|
17006 |
|
|
|
17007 |
|
|
LD B,A ; zero count to B
|
17008 |
|
|
XOR A ; clear accumulator
|
17009 |
|
|
|
17010 |
|
|
;; STK-ZEROS
|
17011 |
|
|
L33F1: DEC B ; decrement B counter
|
17012 |
|
|
RET Z ; return if zero. >>
|
17013 |
|
|
; DE points to new STKEND
|
17014 |
|
|
; HL to new number.
|
17015 |
|
|
|
17016 |
|
|
LD (DE),A ; else load zero to destination
|
17017 |
|
|
INC DE ; increase destination
|
17018 |
|
|
JR L33F1 ; loop back to STK-ZEROS until done.
|
17019 |
|
|
|
17020 |
|
|
; -------------------------------
|
17021 |
|
|
; THE 'SKIP CONSTANTS' SUBROUTINE
|
17022 |
|
|
; -------------------------------
|
17023 |
|
|
; This routine traverses variable-length entries in the table of constants,
|
17024 |
|
|
; stacking intermediate, unwanted constants onto a dummy calculator stack,
|
17025 |
|
|
; in the first five bytes of ROM. The destination DE normally points to the
|
17026 |
|
|
; end of the calculator stack which might be in the normal place or in the
|
17027 |
|
|
; system variables area during E-LINE-NO; INT-TO-FP; stk-ten. In any case,
|
17028 |
|
|
; it would be simpler all round if the routine just shoved unwanted values
|
17029 |
|
|
; where it is going to stick the wanted value. The instruction LD DE, $0000
|
17030 |
|
|
; can be removed.
|
17031 |
|
|
|
17032 |
|
|
;; SKIP-CONS
|
17033 |
|
|
L33F7: AND A ; test if initially zero.
|
17034 |
|
|
|
17035 |
|
|
;; SKIP-NEXT
|
17036 |
|
|
L33F8: RET Z ; return if zero. >>
|
17037 |
|
|
|
17038 |
|
|
PUSH AF ; save count.
|
17039 |
|
|
PUSH DE ; and normal STKEND
|
17040 |
|
|
|
17041 |
|
|
LD DE,$0000 ; dummy value for STKEND at start of ROM
|
17042 |
|
|
; Note. not a fault but this has to be
|
17043 |
|
|
; moved elsewhere when running in RAM.
|
17044 |
|
|
; e.g. with Expandor Systems 'Soft ROM'.
|
17045 |
|
|
; Better still, write to the normal place.
|
17046 |
|
|
CALL L33C8 ; routine STK-CONST works through variable
|
17047 |
|
|
; length records.
|
17048 |
|
|
|
17049 |
|
|
POP DE ; restore real STKEND
|
17050 |
|
|
POP AF ; restore count
|
17051 |
|
|
DEC A ; decrease
|
17052 |
|
|
JR L33F8 ; loop back to SKIP-NEXT
|
17053 |
|
|
|
17054 |
|
|
; ------------------------------
|
17055 |
|
|
; THE 'LOCATE MEMORY' SUBROUTINE
|
17056 |
|
|
; ------------------------------
|
17057 |
|
|
; This routine, when supplied with a base address in HL and an index in A,
|
17058 |
|
|
; will calculate the address of the A'th entry, where each entry occupies
|
17059 |
|
|
; five bytes. It is used for reading the semi-tone table and addressing
|
17060 |
|
|
; floating-point numbers in the calculator's memory area.
|
17061 |
|
|
; It is not possible to use this routine for the table of constants as these
|
17062 |
|
|
; six values are held in compressed format.
|
17063 |
|
|
|
17064 |
|
|
;; LOC-MEM
|
17065 |
|
|
L3406: LD C,A ; store the original number $00-$1F.
|
17066 |
|
|
RLCA ; X2 - double.
|
17067 |
|
|
RLCA ; X4 - quadruple.
|
17068 |
|
|
ADD A,C ; X5 - now add original to multiply by five.
|
17069 |
|
|
|
17070 |
|
|
LD C,A ; place the result in the low byte.
|
17071 |
|
|
LD B,$00 ; set high byte to zero.
|
17072 |
|
|
ADD HL,BC ; add to form address of start of number in HL.
|
17073 |
|
|
|
17074 |
|
|
RET ; return.
|
17075 |
|
|
|
17076 |
|
|
; ------------------------------
|
17077 |
|
|
; Get from memory area ($E0 etc.)
|
17078 |
|
|
; ------------------------------
|
17079 |
|
|
; Literals $E0 to $FF
|
17080 |
|
|
; A holds $00-$1F offset.
|
17081 |
|
|
; The calculator stack increases by 5 bytes.
|
17082 |
|
|
|
17083 |
|
|
;; get-mem-xx
|
17084 |
|
|
L340F: PUSH DE ; save STKEND
|
17085 |
|
|
LD HL,($5C68) ; MEM is base address of the memory cells.
|
17086 |
|
|
CALL L3406 ; routine LOC-MEM so that HL = first byte
|
17087 |
|
|
CALL L33C0 ; routine MOVE-FP moves 5 bytes with memory
|
17088 |
|
|
; check.
|
17089 |
|
|
; DE now points to new STKEND.
|
17090 |
|
|
POP HL ; original STKEND is now RESULT pointer.
|
17091 |
|
|
RET ; return.
|
17092 |
|
|
|
17093 |
|
|
; --------------------------
|
17094 |
|
|
; Stack a constant (A0 etc.)
|
17095 |
|
|
; --------------------------
|
17096 |
|
|
; This routine allows a one-byte instruction to stack up to 32 constants
|
17097 |
|
|
; held in short form in a table of constants. In fact only 5 constants are
|
17098 |
|
|
; required. On entry the A register holds the literal ANDed with 1F.
|
17099 |
|
|
; It isn't very efficient and it would have been better to hold the
|
17100 |
|
|
; numbers in full, five byte form and stack them in a similar manner
|
17101 |
|
|
; to that used for semi-tone table values.
|
17102 |
|
|
|
17103 |
|
|
;; stk-const-xx
|
17104 |
|
|
L341B: LD H,D ; save STKEND - required for result
|
17105 |
|
|
LD L,E ;
|
17106 |
|
|
EXX ; swap
|
17107 |
|
|
PUSH HL ; save pointer to next literal
|
17108 |
|
|
LD HL,L32C5 ; Address: stk-zero - start of table of
|
17109 |
|
|
; constants
|
17110 |
|
|
EXX ;
|
17111 |
|
|
CALL L33F7 ; routine SKIP-CONS
|
17112 |
|
|
CALL L33C8 ; routine STK-CONST
|
17113 |
|
|
EXX ;
|
17114 |
|
|
POP HL ; restore pointer to next literal.
|
17115 |
|
|
EXX ;
|
17116 |
|
|
RET ; return.
|
17117 |
|
|
|
17118 |
|
|
; --------------------------------
|
17119 |
|
|
; Store in a memory area ($C0 etc.)
|
17120 |
|
|
; --------------------------------
|
17121 |
|
|
; Offsets $C0 to $DF
|
17122 |
|
|
; Although 32 memory storage locations can be addressed, only six
|
17123 |
|
|
; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5)
|
17124 |
|
|
; required for these are allocated. Spectrum programmers who wish to
|
17125 |
|
|
; use the floating point routines from assembly language may wish to
|
17126 |
|
|
; alter the system variable MEM to point to 160 bytes of RAM to have
|
17127 |
|
|
; use the full range available.
|
17128 |
|
|
; A holds the derived offset $00-$1F.
|
17129 |
|
|
; This is a unary operation, so on entry HL points to the last value and DE
|
17130 |
|
|
; points to STKEND.
|
17131 |
|
|
|
17132 |
|
|
;; st-mem-xx
|
17133 |
|
|
L342D: PUSH HL ; save the result pointer.
|
17134 |
|
|
EX DE,HL ; transfer to DE.
|
17135 |
|
|
LD HL,($5C68) ; fetch MEM the base of memory area.
|
17136 |
|
|
CALL L3406 ; routine LOC-MEM sets HL to the destination.
|
17137 |
|
|
EX DE,HL ; swap - HL is start, DE is destination.
|
17138 |
|
|
CALL L33C0 ; routine MOVE-FP.
|
17139 |
|
|
; note. a short ld bc,5; ldir
|
17140 |
|
|
; the embedded memory check is not required
|
17141 |
|
|
; so these instructions would be faster.
|
17142 |
|
|
EX DE,HL ; DE = STKEND
|
17143 |
|
|
POP HL ; restore original result pointer
|
17144 |
|
|
RET ; return.
|
17145 |
|
|
|
17146 |
|
|
; -------------------------
|
17147 |
|
|
; THE 'EXCHANGE' SUBROUTINE
|
17148 |
|
|
; -------------------------
|
17149 |
|
|
; (offset: $01 'exchange')
|
17150 |
|
|
; This routine swaps the last two values on the calculator stack.
|
17151 |
|
|
; On entry, as always with binary operations,
|
17152 |
|
|
; HL=first number, DE=second number
|
17153 |
|
|
; On exit, HL=result, DE=stkend.
|
17154 |
|
|
|
17155 |
|
|
;; exchange
|
17156 |
|
|
L343C: LD B,$05 ; there are five bytes to be swapped
|
17157 |
|
|
|
17158 |
|
|
; start of loop.
|
17159 |
|
|
|
17160 |
|
|
;; SWAP-BYTE
|
17161 |
|
|
L343E: LD A,(DE) ; each byte of second
|
17162 |
|
|
LD C,(HL) ; each byte of first
|
17163 |
|
|
EX DE,HL ; swap pointers
|
17164 |
|
|
LD (DE),A ; store each byte of first
|
17165 |
|
|
LD (HL),C ; store each byte of second
|
17166 |
|
|
INC HL ; advance both
|
17167 |
|
|
INC DE ; pointers.
|
17168 |
|
|
DJNZ L343E ; loop back to SWAP-BYTE until all 5 done.
|
17169 |
|
|
|
17170 |
|
|
EX DE,HL ; even up the exchanges so that DE addresses
|
17171 |
|
|
; STKEND.
|
17172 |
|
|
|
17173 |
|
|
RET ; return.
|
17174 |
|
|
|
17175 |
|
|
; ------------------------------
|
17176 |
|
|
; THE 'SERIES GENERATOR' ROUTINE
|
17177 |
|
|
; ------------------------------
|
17178 |
|
|
; (offset: $86 'series-06')
|
17179 |
|
|
; (offset: $88 'series-08')
|
17180 |
|
|
; (offset: $8C 'series-0C')
|
17181 |
|
|
; The Spectrum uses Chebyshev polynomials to generate approximations for
|
17182 |
|
|
; SIN, ATN, LN and EXP. These are named after the Russian mathematician
|
17183 |
|
|
; Pafnuty Chebyshev, born in 1821, who did much pioneering work on numerical
|
17184 |
|
|
; series. As far as calculators are concerned, Chebyshev polynomials have an
|
17185 |
|
|
; advantage over other series, for example the Taylor series, as they can
|
17186 |
|
|
; reach an approximation in just six iterations for SIN, eight for EXP and
|
17187 |
|
|
; twelve for LN and ATN. The mechanics of the routine are interesting but
|
17188 |
|
|
; for full treatment of how these are generated with demonstrations in
|
17189 |
|
|
; Sinclair BASIC see "The Complete Spectrum ROM Disassembly" by Dr Ian Logan
|
17190 |
|
|
; and Dr Frank O'Hara, published 1983 by Melbourne House.
|
17191 |
|
|
|
17192 |
|
|
;; series-xx
|
17193 |
|
|
L3449: LD B,A ; parameter $00 - $1F to B counter
|
17194 |
|
|
CALL L335E ; routine GEN-ENT-1 is called.
|
17195 |
|
|
; A recursive call to a special entry point
|
17196 |
|
|
; in the calculator that puts the B register
|
17197 |
|
|
; in the system variable BREG. The return
|
17198 |
|
|
; address is the next location and where
|
17199 |
|
|
; the calculator will expect its first
|
17200 |
|
|
; instruction - now pointed to by HL'.
|
17201 |
|
|
; The previous pointer to the series of
|
17202 |
|
|
; five-byte numbers goes on the machine stack.
|
17203 |
|
|
|
17204 |
|
|
; The initialization phase.
|
17205 |
|
|
|
17206 |
|
|
DEFB $31 ;;duplicate x,x
|
17207 |
|
|
DEFB $0F ;;addition x+x
|
17208 |
|
|
DEFB $C0 ;;st-mem-0 x+x
|
17209 |
|
|
DEFB $02 ;;delete .
|
17210 |
|
|
DEFB $A0 ;;stk-zero 0
|
17211 |
|
|
DEFB $C2 ;;st-mem-2 0
|
17212 |
|
|
|
17213 |
|
|
; a loop is now entered to perform the algebraic calculation for each of
|
17214 |
|
|
; the numbers in the series
|
17215 |
|
|
|
17216 |
|
|
;; G-LOOP
|
17217 |
|
|
L3453: DEFB $31 ;;duplicate v,v.
|
17218 |
|
|
DEFB $E0 ;;get-mem-0 v,v,x+2
|
17219 |
|
|
DEFB $04 ;;multiply v,v*x+2
|
17220 |
|
|
DEFB $E2 ;;get-mem-2 v,v*x+2,v
|
17221 |
|
|
DEFB $C1 ;;st-mem-1
|
17222 |
|
|
DEFB $03 ;;subtract
|
17223 |
|
|
DEFB $38 ;;end-calc
|
17224 |
|
|
|
17225 |
|
|
; the previous pointer is fetched from the machine stack to H'L' where it
|
17226 |
|
|
; addresses one of the numbers of the series following the series literal.
|
17227 |
|
|
|
17228 |
|
|
CALL L33C6 ; routine STK-DATA is called directly to
|
17229 |
|
|
; push a value and advance H'L'.
|
17230 |
|
|
CALL L3362 ; routine GEN-ENT-2 recursively re-enters
|
17231 |
|
|
; the calculator without disturbing
|
17232 |
|
|
; system variable BREG
|
17233 |
|
|
; H'L' value goes on the machine stack and is
|
17234 |
|
|
; then loaded as usual with the next address.
|
17235 |
|
|
|
17236 |
|
|
DEFB $0F ;;addition
|
17237 |
|
|
DEFB $01 ;;exchange
|
17238 |
|
|
DEFB $C2 ;;st-mem-2
|
17239 |
|
|
DEFB $02 ;;delete
|
17240 |
|
|
|
17241 |
|
|
DEFB $35 ;;dec-jr-nz
|
17242 |
|
|
DEFB $EE ;;back to L3453, G-LOOP
|
17243 |
|
|
|
17244 |
|
|
; when the counted loop is complete the final subtraction yields the result
|
17245 |
|
|
; for example SIN X.
|
17246 |
|
|
|
17247 |
|
|
DEFB $E1 ;;get-mem-1
|
17248 |
|
|
DEFB $03 ;;subtract
|
17249 |
|
|
DEFB $38 ;;end-calc
|
17250 |
|
|
|
17251 |
|
|
RET ; return with H'L' pointing to location
|
17252 |
|
|
; after last number in series.
|
17253 |
|
|
|
17254 |
|
|
; ---------------------------------
|
17255 |
|
|
; THE 'ABSOLUTE MAGNITUDE' FUNCTION
|
17256 |
|
|
; ---------------------------------
|
17257 |
|
|
; (offset: $2A 'abs')
|
17258 |
|
|
; This calculator literal finds the absolute value of the last value,
|
17259 |
|
|
; integer or floating point, on calculator stack.
|
17260 |
|
|
|
17261 |
|
|
;; abs
|
17262 |
|
|
L346A: LD B,$FF ; signal abs
|
17263 |
|
|
JR L3474 ; forward to NEG-TEST
|
17264 |
|
|
|
17265 |
|
|
; ---------------------------
|
17266 |
|
|
; THE 'UNARY MINUS' OPERATION
|
17267 |
|
|
; ---------------------------
|
17268 |
|
|
; (offset: $1B 'negate')
|
17269 |
|
|
; Unary so on entry HL points to last value, DE to STKEND.
|
17270 |
|
|
|
17271 |
|
|
;; NEGATE
|
17272 |
|
|
;; negate
|
17273 |
|
|
L346E: CALL L34E9 ; call routine TEST-ZERO and
|
17274 |
|
|
RET C ; return if so leaving zero unchanged.
|
17275 |
|
|
|
17276 |
|
|
LD B,$00 ; signal negate required before joining
|
17277 |
|
|
; common code.
|
17278 |
|
|
|
17279 |
|
|
;; NEG-TEST
|
17280 |
|
|
L3474: LD A,(HL) ; load first byte and
|
17281 |
|
|
AND A ; test for zero
|
17282 |
|
|
JR Z,L3483 ; forward to INT-CASE if a small integer
|
17283 |
|
|
|
17284 |
|
|
; for floating point numbers a single bit denotes the sign.
|
17285 |
|
|
|
17286 |
|
|
INC HL ; address the first byte of mantissa.
|
17287 |
|
|
LD A,B ; action flag $FF=abs, $00=neg.
|
17288 |
|
|
AND $80 ; now $80 $00
|
17289 |
|
|
OR (HL) ; sets bit 7 for abs
|
17290 |
|
|
RLA ; sets carry for abs and if number negative
|
17291 |
|
|
CCF ; complement carry flag
|
17292 |
|
|
RRA ; and rotate back in altering sign
|
17293 |
|
|
LD (HL),A ; put the altered adjusted number back
|
17294 |
|
|
DEC HL ; HL points to result
|
17295 |
|
|
RET ; return with DE unchanged
|
17296 |
|
|
|
17297 |
|
|
; ---
|
17298 |
|
|
|
17299 |
|
|
; for integer numbers an entire byte denotes the sign.
|
17300 |
|
|
|
17301 |
|
|
;; INT-CASE
|
17302 |
|
|
L3483: PUSH DE ; save STKEND.
|
17303 |
|
|
|
17304 |
|
|
PUSH HL ; save pointer to the last value/result.
|
17305 |
|
|
|
17306 |
|
|
CALL L2D7F ; routine INT-FETCH puts integer in DE
|
17307 |
|
|
; and the sign in C.
|
17308 |
|
|
|
17309 |
|
|
POP HL ; restore the result pointer.
|
17310 |
|
|
|
17311 |
|
|
LD A,B ; $FF=abs, $00=neg
|
17312 |
|
|
OR C ; $FF for abs, no change neg
|
17313 |
|
|
CPL ; $00 for abs, switched for neg
|
17314 |
|
|
LD C,A ; transfer result to sign byte.
|
17315 |
|
|
|
17316 |
|
|
CALL L2D8E ; routine INT-STORE to re-write the integer.
|
17317 |
|
|
|
17318 |
|
|
POP DE ; restore STKEND.
|
17319 |
|
|
RET ; return.
|
17320 |
|
|
|
17321 |
|
|
; ---------------------
|
17322 |
|
|
; THE 'SIGNUM' FUNCTION
|
17323 |
|
|
; ---------------------
|
17324 |
|
|
; (offset: $29 'sgn')
|
17325 |
|
|
; This routine replaces the last value on the calculator stack,
|
17326 |
|
|
; which may be in floating point or integer form, with the integer values
|
17327 |
|
|
; zero if zero, with one if positive and with -minus one if negative.
|
17328 |
|
|
|
17329 |
|
|
;; sgn
|
17330 |
|
|
L3492: CALL L34E9 ; call routine TEST-ZERO and
|
17331 |
|
|
RET C ; exit if so as no change is required.
|
17332 |
|
|
|
17333 |
|
|
PUSH DE ; save pointer to STKEND.
|
17334 |
|
|
|
17335 |
|
|
LD DE,$0001 ; the result will be 1.
|
17336 |
|
|
INC HL ; skip over the exponent.
|
17337 |
|
|
RL (HL) ; rotate the sign bit into the carry flag.
|
17338 |
|
|
DEC HL ; step back to point to the result.
|
17339 |
|
|
SBC A,A ; byte will be $FF if negative, $00 if positive.
|
17340 |
|
|
LD C,A ; store the sign byte in the C register.
|
17341 |
|
|
CALL L2D8E ; routine INT-STORE to overwrite the last
|
17342 |
|
|
; value with 0001 and sign.
|
17343 |
|
|
|
17344 |
|
|
POP DE ; restore STKEND.
|
17345 |
|
|
RET ; return.
|
17346 |
|
|
|
17347 |
|
|
; -----------------
|
17348 |
|
|
; THE 'IN' FUNCTION
|
17349 |
|
|
; -----------------
|
17350 |
|
|
; (offset: $2C 'in')
|
17351 |
|
|
; This function reads a byte from an input port.
|
17352 |
|
|
|
17353 |
|
|
;; in
|
17354 |
|
|
L34A5: CALL L1E99 ; Routine FIND-INT2 puts port address in BC.
|
17355 |
|
|
; All 16 bits are put on the address line.
|
17356 |
|
|
|
17357 |
|
|
IN A,(C) ; Read the port.
|
17358 |
|
|
|
17359 |
|
|
JR L34B0 ; exit to STACK-A (via IN-PK-STK to save a byte
|
17360 |
|
|
; of instruction code).
|
17361 |
|
|
|
17362 |
|
|
; -------------------
|
17363 |
|
|
; THE 'PEEK' FUNCTION
|
17364 |
|
|
; -------------------
|
17365 |
|
|
; (offset: $2B 'peek')
|
17366 |
|
|
; This function returns the contents of a memory address.
|
17367 |
|
|
; The entire address space can be peeked including the ROM.
|
17368 |
|
|
|
17369 |
|
|
;; peek
|
17370 |
|
|
L34AC: CALL L1E99 ; routine FIND-INT2 puts address in BC.
|
17371 |
|
|
LD A,(BC) ; load contents into A register.
|
17372 |
|
|
|
17373 |
|
|
;; IN-PK-STK
|
17374 |
|
|
L34B0: JP L2D28 ; exit via STACK-A to put the value on the
|
17375 |
|
|
; calculator stack.
|
17376 |
|
|
|
17377 |
|
|
; ------------------
|
17378 |
|
|
; THE 'USR' FUNCTION
|
17379 |
|
|
; ------------------
|
17380 |
|
|
; (offset: $2d 'usr-no')
|
17381 |
|
|
; The USR function followed by a number 0-65535 is the method by which
|
17382 |
|
|
; the Spectrum invokes machine code programs. This function returns the
|
17383 |
|
|
; contents of the BC register pair.
|
17384 |
|
|
; Note. that STACK-BC re-initializes the IY register if a user-written
|
17385 |
|
|
; program has altered it.
|
17386 |
|
|
|
17387 |
|
|
;; usr-no
|
17388 |
|
|
L34B3: CALL L1E99 ; routine FIND-INT2 to fetch the
|
17389 |
|
|
; supplied address into BC.
|
17390 |
|
|
|
17391 |
|
|
LD HL,L2D2B ; address: STACK-BC is
|
17392 |
|
|
PUSH HL ; pushed onto the machine stack.
|
17393 |
|
|
PUSH BC ; then the address of the machine code
|
17394 |
|
|
; routine.
|
17395 |
|
|
|
17396 |
|
|
RET ; make an indirect jump to the routine
|
17397 |
|
|
; and, hopefully, to STACK-BC also.
|
17398 |
|
|
|
17399 |
|
|
; -------------------------
|
17400 |
|
|
; THE 'USR STRING' FUNCTION
|
17401 |
|
|
; -------------------------
|
17402 |
|
|
; (offset: $19 'usr-$')
|
17403 |
|
|
; The user function with a one-character string argument, calculates the
|
17404 |
|
|
; address of the User Defined Graphic character that is in the string.
|
17405 |
|
|
; As an alternative, the ASCII equivalent, upper or lower case,
|
17406 |
|
|
; may be supplied. This provides a user-friendly method of redefining
|
17407 |
|
|
; the 21 User Definable Graphics e.g.
|
17408 |
|
|
; POKE USR "a", BIN 10000000 will put a dot in the top left corner of the
|
17409 |
|
|
; character 144.
|
17410 |
|
|
; Note. the curious double check on the range. With 26 UDGs the first check
|
17411 |
|
|
; only is necessary. With anything less the second check only is required.
|
17412 |
|
|
; It is highly likely that the first check was written by Steven Vickers.
|
17413 |
|
|
|
17414 |
|
|
;; usr-$
|
17415 |
|
|
L34BC: CALL L2BF1 ; routine STK-FETCH fetches the string
|
17416 |
|
|
; parameters.
|
17417 |
|
|
DEC BC ; decrease BC by
|
17418 |
|
|
LD A,B ; one to test
|
17419 |
|
|
OR C ; the length.
|
17420 |
|
|
JR NZ,L34E7 ; to REPORT-A if not a single character.
|
17421 |
|
|
|
17422 |
|
|
LD A,(DE) ; fetch the character
|
17423 |
|
|
CALL L2C8D ; routine ALPHA sets carry if 'A-Z' or 'a-z'.
|
17424 |
|
|
JR C,L34D3 ; forward to USR-RANGE if ASCII.
|
17425 |
|
|
|
17426 |
|
|
SUB $90 ; make UDGs range 0-20d
|
17427 |
|
|
JR C,L34E7 ; to REPORT-A if too low. e.g. usr " ".
|
17428 |
|
|
|
17429 |
|
|
CP $15 ; Note. this test is not necessary.
|
17430 |
|
|
JR NC,L34E7 ; to REPORT-A if higher than 20.
|
17431 |
|
|
|
17432 |
|
|
INC A ; make range 1-21d to match LSBs of ASCII
|
17433 |
|
|
|
17434 |
|
|
;; USR-RANGE
|
17435 |
|
|
L34D3: DEC A ; make range of bits 0-4 start at zero
|
17436 |
|
|
ADD A,A ; multiply by eight
|
17437 |
|
|
ADD A,A ; and lose any set bits
|
17438 |
|
|
ADD A,A ; range now 0 - 25*8
|
17439 |
|
|
CP $A8 ; compare to 21*8
|
17440 |
|
|
JR NC,L34E7 ; to REPORT-A if originally higher
|
17441 |
|
|
; than 'U','u' or graphics U.
|
17442 |
|
|
|
17443 |
|
|
LD BC,($5C7B) ; fetch the UDG system variable value.
|
17444 |
|
|
ADD A,C ; add the offset to character
|
17445 |
|
|
LD C,A ; and store back in register C.
|
17446 |
|
|
JR NC,L34E4 ; forward to USR-STACK if no overflow.
|
17447 |
|
|
|
17448 |
|
|
INC B ; increment high byte.
|
17449 |
|
|
|
17450 |
|
|
;; USR-STACK
|
17451 |
|
|
L34E4: JP L2D2B ; jump back and exit via STACK-BC to store
|
17452 |
|
|
|
17453 |
|
|
; ---
|
17454 |
|
|
|
17455 |
|
|
;; REPORT-A
|
17456 |
|
|
L34E7: RST 08H ; ERROR-1
|
17457 |
|
|
DEFB $09 ; Error Report: Invalid argument
|
17458 |
|
|
|
17459 |
|
|
; ------------------------------
|
17460 |
|
|
; THE 'TEST FOR ZERO' SUBROUTINE
|
17461 |
|
|
; ------------------------------
|
17462 |
|
|
; Test if top value on calculator stack is zero. The carry flag is set if
|
17463 |
|
|
; the last value is zero but no registers are altered.
|
17464 |
|
|
; All five bytes will be zero but first four only need be tested.
|
17465 |
|
|
; On entry, HL points to the exponent the first byte of the value.
|
17466 |
|
|
|
17467 |
|
|
;; TEST-ZERO
|
17468 |
|
|
L34E9: PUSH HL ; preserve HL which is used to address.
|
17469 |
|
|
PUSH BC ; preserve BC which is used as a store.
|
17470 |
|
|
LD B,A ; preserve A in B.
|
17471 |
|
|
|
17472 |
|
|
LD A,(HL) ; load first byte to accumulator
|
17473 |
|
|
INC HL ; advance.
|
17474 |
|
|
OR (HL) ; OR with second byte and clear carry.
|
17475 |
|
|
INC HL ; advance.
|
17476 |
|
|
OR (HL) ; OR with third byte.
|
17477 |
|
|
INC HL ; advance.
|
17478 |
|
|
OR (HL) ; OR with fourth byte.
|
17479 |
|
|
|
17480 |
|
|
LD A,B ; restore A without affecting flags.
|
17481 |
|
|
POP BC ; restore the saved
|
17482 |
|
|
POP HL ; registers.
|
17483 |
|
|
|
17484 |
|
|
RET NZ ; return if not zero and with carry reset.
|
17485 |
|
|
|
17486 |
|
|
SCF ; set the carry flag.
|
17487 |
|
|
RET ; return with carry set if zero.
|
17488 |
|
|
|
17489 |
|
|
; --------------------------------
|
17490 |
|
|
; THE 'GREATER THAN ZERO' OPERATOR
|
17491 |
|
|
; --------------------------------
|
17492 |
|
|
; (offset: $37 'greater-0' )
|
17493 |
|
|
; Test if the last value on the calculator stack is greater than zero.
|
17494 |
|
|
; This routine is also called directly from the end-tests of the comparison
|
17495 |
|
|
; routine.
|
17496 |
|
|
|
17497 |
|
|
;; GREATER-0
|
17498 |
|
|
;; greater-0
|
17499 |
|
|
L34F9: CALL L34E9 ; routine TEST-ZERO
|
17500 |
|
|
RET C ; return if was zero as this
|
17501 |
|
|
; is also the Boolean 'false' value.
|
17502 |
|
|
|
17503 |
|
|
LD A,$FF ; prepare XOR mask for sign bit
|
17504 |
|
|
JR L3507 ; forward to SIGN-TO-C
|
17505 |
|
|
; to put sign in carry
|
17506 |
|
|
; (carry will become set if sign is positive)
|
17507 |
|
|
; and then overwrite location with 1 or 0
|
17508 |
|
|
; as appropriate.
|
17509 |
|
|
|
17510 |
|
|
; ------------------
|
17511 |
|
|
; THE 'NOT' FUNCTION
|
17512 |
|
|
; ------------------
|
17513 |
|
|
; (offset: $30 'not')
|
17514 |
|
|
; This overwrites the last value with 1 if it was zero else with zero
|
17515 |
|
|
; if it was any other value.
|
17516 |
|
|
;
|
17517 |
|
|
; e.g. NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0.
|
17518 |
|
|
;
|
17519 |
|
|
; The subroutine is also called directly from the end-tests of the comparison
|
17520 |
|
|
; operator.
|
17521 |
|
|
|
17522 |
|
|
;; NOT
|
17523 |
|
|
;; not
|
17524 |
|
|
L3501: CALL L34E9 ; routine TEST-ZERO sets carry if zero
|
17525 |
|
|
|
17526 |
|
|
JR L350B ; to FP-0/1 to overwrite operand with
|
17527 |
|
|
; 1 if carry is set else to overwrite with zero.
|
17528 |
|
|
|
17529 |
|
|
; ------------------------------
|
17530 |
|
|
; THE 'LESS THAN ZERO' OPERATION
|
17531 |
|
|
; ------------------------------
|
17532 |
|
|
; (offset: $36 'less-0' )
|
17533 |
|
|
; Destructively test if last value on calculator stack is less than zero.
|
17534 |
|
|
; Bit 7 of second byte will be set if so.
|
17535 |
|
|
|
17536 |
|
|
;; less-0
|
17537 |
|
|
L3506: XOR A ; set XOR mask to zero
|
17538 |
|
|
; (carry will become set if sign is negative).
|
17539 |
|
|
|
17540 |
|
|
; transfer sign of mantissa to Carry Flag.
|
17541 |
|
|
|
17542 |
|
|
;; SIGN-TO-C
|
17543 |
|
|
L3507: INC HL ; address 2nd byte.
|
17544 |
|
|
XOR (HL) ; bit 7 of HL will be set if number is negative.
|
17545 |
|
|
DEC HL ; address 1st byte again.
|
17546 |
|
|
RLCA ; rotate bit 7 of A to carry.
|
17547 |
|
|
|
17548 |
|
|
; ----------------------------
|
17549 |
|
|
; THE 'ZERO OR ONE' SUBROUTINE
|
17550 |
|
|
; ----------------------------
|
17551 |
|
|
; This routine places an integer value of zero or one at the addressed
|
17552 |
|
|
; location of the calculator stack or MEM area. The value one is written if
|
17553 |
|
|
; carry is set on entry else zero.
|
17554 |
|
|
|
17555 |
|
|
;; FP-0/1
|
17556 |
|
|
L350B: PUSH HL ; save pointer to the first byte
|
17557 |
|
|
LD A,$00 ; load accumulator with zero - without
|
17558 |
|
|
; disturbing flags.
|
17559 |
|
|
LD (HL),A ; zero to first byte
|
17560 |
|
|
INC HL ; address next
|
17561 |
|
|
LD (HL),A ; zero to 2nd byte
|
17562 |
|
|
INC HL ; address low byte of integer
|
17563 |
|
|
RLA ; carry to bit 0 of A
|
17564 |
|
|
LD (HL),A ; load one or zero to low byte.
|
17565 |
|
|
RRA ; restore zero to accumulator.
|
17566 |
|
|
INC HL ; address high byte of integer.
|
17567 |
|
|
LD (HL),A ; put a zero there.
|
17568 |
|
|
INC HL ; address fifth byte.
|
17569 |
|
|
LD (HL),A ; put a zero there.
|
17570 |
|
|
POP HL ; restore pointer to the first byte.
|
17571 |
|
|
RET ; return.
|
17572 |
|
|
|
17573 |
|
|
; -----------------
|
17574 |
|
|
; THE 'OR' OPERATOR
|
17575 |
|
|
; -----------------
|
17576 |
|
|
; (offset: $07 'or' )
|
17577 |
|
|
; The Boolean OR operator. e.g. X OR Y
|
17578 |
|
|
; The result is zero if both values are zero else a non-zero value.
|
17579 |
|
|
;
|
17580 |
|
|
; e.g. 0 OR 0 returns 0.
|
17581 |
|
|
; -3 OR 0 returns -3.
|
17582 |
|
|
; 0 OR -3 returns 1.
|
17583 |
|
|
; -3 OR 2 returns 1.
|
17584 |
|
|
;
|
17585 |
|
|
; A binary operation.
|
17586 |
|
|
; On entry HL points to first operand (X) and DE to second operand (Y).
|
17587 |
|
|
|
17588 |
|
|
;; or
|
17589 |
|
|
L351B: EX DE,HL ; make HL point to second number
|
17590 |
|
|
CALL L34E9 ; routine TEST-ZERO
|
17591 |
|
|
EX DE,HL ; restore pointers
|
17592 |
|
|
RET C ; return if result was zero - first operand,
|
17593 |
|
|
; now the last value, is the result.
|
17594 |
|
|
|
17595 |
|
|
SCF ; set carry flag
|
17596 |
|
|
JR L350B ; back to FP-0/1 to overwrite the first operand
|
17597 |
|
|
; with the value 1.
|
17598 |
|
|
|
17599 |
|
|
|
17600 |
|
|
; ---------------------------------
|
17601 |
|
|
; THE 'NUMBER AND NUMBER' OPERATION
|
17602 |
|
|
; ---------------------------------
|
17603 |
|
|
; (offset: $08 'no-&-no')
|
17604 |
|
|
; The Boolean AND operator.
|
17605 |
|
|
;
|
17606 |
|
|
; e.g. -3 AND 2 returns -3.
|
17607 |
|
|
; -3 AND 0 returns 0.
|
17608 |
|
|
; 0 and -2 returns 0.
|
17609 |
|
|
; 0 and 0 returns 0.
|
17610 |
|
|
;
|
17611 |
|
|
; Compare with OR routine above.
|
17612 |
|
|
|
17613 |
|
|
;; no-&-no
|
17614 |
|
|
L3524: EX DE,HL ; make HL address second operand.
|
17615 |
|
|
|
17616 |
|
|
CALL L34E9 ; routine TEST-ZERO sets carry if zero.
|
17617 |
|
|
|
17618 |
|
|
EX DE,HL ; restore pointers.
|
17619 |
|
|
RET NC ; return if second non-zero, first is result.
|
17620 |
|
|
|
17621 |
|
|
;
|
17622 |
|
|
|
17623 |
|
|
AND A ; else clear carry.
|
17624 |
|
|
JR L350B ; back to FP-0/1 to overwrite first operand
|
17625 |
|
|
; with zero for return value.
|
17626 |
|
|
|
17627 |
|
|
; ---------------------------------
|
17628 |
|
|
; THE 'STRING AND NUMBER' OPERATION
|
17629 |
|
|
; ---------------------------------
|
17630 |
|
|
; (offset: $10 'str-&-no')
|
17631 |
|
|
; e.g. "You Win" AND score>99 will return the string if condition is true
|
17632 |
|
|
; or the null string if false.
|
17633 |
|
|
|
17634 |
|
|
;; str-&-no
|
17635 |
|
|
L352D: EX DE,HL ; make HL point to the number.
|
17636 |
|
|
CALL L34E9 ; routine TEST-ZERO.
|
17637 |
|
|
EX DE,HL ; restore pointers.
|
17638 |
|
|
RET NC ; return if number was not zero - the string
|
17639 |
|
|
; is the result.
|
17640 |
|
|
|
17641 |
|
|
; if the number was zero (false) then the null string must be returned by
|
17642 |
|
|
; altering the length of the string on the calculator stack to zero.
|
17643 |
|
|
|
17644 |
|
|
PUSH DE ; save pointer to the now obsolete number
|
17645 |
|
|
; (which will become the new STKEND)
|
17646 |
|
|
|
17647 |
|
|
DEC DE ; point to the 5th byte of string descriptor.
|
17648 |
|
|
XOR A ; clear the accumulator.
|
17649 |
|
|
LD (DE),A ; place zero in high byte of length.
|
17650 |
|
|
DEC DE ; address low byte of length.
|
17651 |
|
|
LD (DE),A ; place zero there - now the null string.
|
17652 |
|
|
|
17653 |
|
|
POP DE ; restore pointer - new STKEND.
|
17654 |
|
|
RET ; return.
|
17655 |
|
|
|
17656 |
|
|
; ---------------------------
|
17657 |
|
|
; THE 'COMPARISON' OPERATIONS
|
17658 |
|
|
; ---------------------------
|
17659 |
|
|
; (offset: $0A 'no-gr-eql')
|
17660 |
|
|
; (offset: $0B 'nos-neql')
|
17661 |
|
|
; (offset: $0C 'no-grtr')
|
17662 |
|
|
; (offset: $0D 'no-less')
|
17663 |
|
|
; (offset: $0E 'nos-eql')
|
17664 |
|
|
; (offset: $11 'str-l-eql')
|
17665 |
|
|
; (offset: $12 'str-gr-eql')
|
17666 |
|
|
; (offset: $13 'strs-neql')
|
17667 |
|
|
; (offset: $14 'str-grtr')
|
17668 |
|
|
; (offset: $15 'str-less')
|
17669 |
|
|
; (offset: $16 'strs-eql')
|
17670 |
|
|
|
17671 |
|
|
; True binary operations.
|
17672 |
|
|
; A single entry point is used to evaluate six numeric and six string
|
17673 |
|
|
; comparisons. On entry, the calculator literal is in the B register and
|
17674 |
|
|
; the two numeric values, or the two string parameters, are on the
|
17675 |
|
|
; calculator stack.
|
17676 |
|
|
; The individual bits of the literal are manipulated to group similar
|
17677 |
|
|
; operations although the SUB 8 instruction does nothing useful and merely
|
17678 |
|
|
; alters the string test bit.
|
17679 |
|
|
; Numbers are compared by subtracting one from the other, strings are
|
17680 |
|
|
; compared by comparing every character until a mismatch, or the end of one
|
17681 |
|
|
; or both, is reached.
|
17682 |
|
|
;
|
17683 |
|
|
; Numeric Comparisons.
|
17684 |
|
|
; --------------------
|
17685 |
|
|
; The 'x>y' example is the easiest as it employs straight-thru logic.
|
17686 |
|
|
; Number y is subtracted from x and the result tested for greater-0 yielding
|
17687 |
|
|
; a final value 1 (true) or 0 (false).
|
17688 |
|
|
; For 'x
|
17689 |
|
|
; calculator stack.
|
17690 |
|
|
; For 'x=y' NOT is applied to the subtraction result yielding true if the
|
17691 |
|
|
; difference was zero and false with anything else.
|
17692 |
|
|
; The first three numeric comparisons are just the opposite of the last three
|
17693 |
|
|
; so the same processing steps are used and then a final NOT is applied.
|
17694 |
|
|
;
|
17695 |
|
|
; literal Test No sub 8 ExOrNot 1st RRCA exch sub ? End-Tests
|
17696 |
|
|
; ========= ==== == ======== === ======== ======== ==== === = === === ===
|
17697 |
|
|
; no-l-eql x<=y 09 00000001 dec 00000000 00000000 ---- x-y ? --- >0? NOT
|
17698 |
|
|
; no-gr-eql x>=y 0A 00000010 dec 00000001 10000000c swap y-x ? --- >0? NOT
|
17699 |
|
|
; nos-neql x<>y 0B 00000011 dec 00000010 00000001 ---- x-y ? NOT --- NOT
|
17700 |
|
|
; no-grtr x>y 0C 00000100 - 00000100 00000010 ---- x-y ? --- >0? ---
|
17701 |
|
|
; no-less x0? ---
|
17702 |
|
|
; nos-eql x=y 0E 00000110 - 00000110 00000011 ---- x-y ? NOT --- ---
|
17703 |
|
|
;
|
17704 |
|
|
; comp -> C/F
|
17705 |
|
|
; ==== ===
|
17706 |
|
|
; str-l-eql x$<=y$ 11 00001001 dec 00001000 00000100 ---- x$y$ 0 !or >0? NOT
|
17707 |
|
|
; str-gr-eql x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0 !or >0? NOT
|
17708 |
|
|
; strs-neql x$<>y$ 13 00001011 dec 00001010 00000101 ---- x$y$ 0 !or >0? NOT
|
17709 |
|
|
; str-grtr x$>y$ 14 00001100 - 00001100 00000110 ---- x$y$ 0 !or >0? ---
|
17710 |
|
|
; str-less x$0? ---
|
17711 |
|
|
; strs-eql x$=y$ 16 00001110 - 00001110 00000111 ---- x$y$ 0 !or >0? ---
|
17712 |
|
|
;
|
17713 |
|
|
; String comparisons are a little different in that the eql/neql carry flag
|
17714 |
|
|
; from the 2nd RRCA is, as before, fed into the first of the end tests but
|
17715 |
|
|
; along the way it gets modified by the comparison process. The result on the
|
17716 |
|
|
; stack always starts off as zero and the carry fed in determines if NOT is
|
17717 |
|
|
; applied to it. So the only time the greater-0 test is applied is if the
|
17718 |
|
|
; stack holds zero which is not very efficient as the test will always yield
|
17719 |
|
|
; zero. The most likely explanation is that there were once separate end tests
|
17720 |
|
|
; for numbers and strings.
|
17721 |
|
|
|
17722 |
|
|
;; no-l-eql,etc.
|
17723 |
|
|
L353B: LD A,B ; transfer literal to accumulator.
|
17724 |
|
|
SUB $08 ; subtract eight - which is not useful.
|
17725 |
|
|
|
17726 |
|
|
BIT 2,A ; isolate '>', '<', '='.
|
17727 |
|
|
|
17728 |
|
|
JR NZ,L3543 ; skip to EX-OR-NOT with these.
|
17729 |
|
|
|
17730 |
|
|
DEC A ; else make $00-$02, $08-$0A to match bits 0-2.
|
17731 |
|
|
|
17732 |
|
|
;; EX-OR-NOT
|
17733 |
|
|
L3543: RRCA ; the first RRCA sets carry for a swap.
|
17734 |
|
|
JR NC,L354E ; forward to NU-OR-STR with other 8 cases
|
17735 |
|
|
|
17736 |
|
|
; for the other 4 cases the two values on the calculator stack are exchanged.
|
17737 |
|
|
|
17738 |
|
|
PUSH AF ; save A and carry.
|
17739 |
|
|
PUSH HL ; save HL - pointer to first operand.
|
17740 |
|
|
; (DE points to second operand).
|
17741 |
|
|
|
17742 |
|
|
CALL L343C ; routine exchange swaps the two values.
|
17743 |
|
|
; (HL = second operand, DE = STKEND)
|
17744 |
|
|
|
17745 |
|
|
POP DE ; DE = first operand
|
17746 |
|
|
EX DE,HL ; as we were.
|
17747 |
|
|
POP AF ; restore A and carry.
|
17748 |
|
|
|
17749 |
|
|
; Note. it would be better if the 2nd RRCA preceded the string test.
|
17750 |
|
|
; It would save two duplicate bytes and if we also got rid of that sub 8
|
17751 |
|
|
; at the beginning we wouldn't have to alter which bit we test.
|
17752 |
|
|
|
17753 |
|
|
;; NU-OR-STR
|
17754 |
|
|
L354E: BIT 2,A ; test if a string comparison.
|
17755 |
|
|
JR NZ,L3559 ; forward to STRINGS if so.
|
17756 |
|
|
|
17757 |
|
|
; continue with numeric comparisons.
|
17758 |
|
|
|
17759 |
|
|
RRCA ; 2nd RRCA causes eql/neql to set carry.
|
17760 |
|
|
PUSH AF ; save A and carry
|
17761 |
|
|
|
17762 |
|
|
CALL L300F ; routine subtract leaves result on stack.
|
17763 |
|
|
JR L358C ; forward to END-TESTS
|
17764 |
|
|
|
17765 |
|
|
; ---
|
17766 |
|
|
|
17767 |
|
|
;; STRINGS
|
17768 |
|
|
L3559: RRCA ; 2nd RRCA causes eql/neql to set carry.
|
17769 |
|
|
PUSH AF ; save A and carry.
|
17770 |
|
|
|
17771 |
|
|
CALL L2BF1 ; routine STK-FETCH gets 2nd string params
|
17772 |
|
|
PUSH DE ; save start2 *.
|
17773 |
|
|
PUSH BC ; and the length.
|
17774 |
|
|
|
17775 |
|
|
CALL L2BF1 ; routine STK-FETCH gets 1st string
|
17776 |
|
|
; parameters - start in DE, length in BC.
|
17777 |
|
|
POP HL ; restore length of second to HL.
|
17778 |
|
|
|
17779 |
|
|
; A loop is now entered to compare, by subtraction, each corresponding character
|
17780 |
|
|
; of the strings. For each successful match, the pointers are incremented and
|
17781 |
|
|
; the lengths decreased and the branch taken back to here. If both string
|
17782 |
|
|
; remainders become null at the same time, then an exact match exists.
|
17783 |
|
|
|
17784 |
|
|
;; BYTE-COMP
|
17785 |
|
|
L3564: LD A,H ; test if the second string
|
17786 |
|
|
OR L ; is the null string and hold flags.
|
17787 |
|
|
|
17788 |
|
|
EX (SP),HL ; put length2 on stack, bring start2 to HL *.
|
17789 |
|
|
LD A,B ; hi byte of length1 to A
|
17790 |
|
|
|
17791 |
|
|
JR NZ,L3575 ; forward to SEC-PLUS if second not null.
|
17792 |
|
|
|
17793 |
|
|
OR C ; test length of first string.
|
17794 |
|
|
|
17795 |
|
|
;; SECND-LOW
|
17796 |
|
|
L356B: POP BC ; pop the second length off stack.
|
17797 |
|
|
JR Z,L3572 ; forward to BOTH-NULL if first string is also
|
17798 |
|
|
; of zero length.
|
17799 |
|
|
|
17800 |
|
|
; the true condition - first is longer than second (SECND-LESS)
|
17801 |
|
|
|
17802 |
|
|
POP AF ; restore carry (set if eql/neql)
|
17803 |
|
|
CCF ; complement carry flag.
|
17804 |
|
|
; Note. equality becomes false.
|
17805 |
|
|
; Inequality is true. By swapping or applying
|
17806 |
|
|
; a terminal 'not', all comparisons have been
|
17807 |
|
|
; manipulated so that this is success path.
|
17808 |
|
|
JR L3588 ; forward to leave via STR-TEST
|
17809 |
|
|
|
17810 |
|
|
; ---
|
17811 |
|
|
; the branch was here with a match
|
17812 |
|
|
|
17813 |
|
|
;; BOTH-NULL
|
17814 |
|
|
L3572: POP AF ; restore carry - set for eql/neql
|
17815 |
|
|
JR L3588 ; forward to STR-TEST
|
17816 |
|
|
|
17817 |
|
|
; ---
|
17818 |
|
|
; the branch was here when 2nd string not null and low byte of first is yet
|
17819 |
|
|
; to be tested.
|
17820 |
|
|
|
17821 |
|
|
|
17822 |
|
|
;; SEC-PLUS
|
17823 |
|
|
L3575: OR C ; test the length of first string.
|
17824 |
|
|
JR Z,L3585 ; forward to FRST-LESS if length is zero.
|
17825 |
|
|
|
17826 |
|
|
; both strings have at least one character left.
|
17827 |
|
|
|
17828 |
|
|
LD A,(DE) ; fetch character of first string.
|
17829 |
|
|
SUB (HL) ; subtract with that of 2nd string.
|
17830 |
|
|
JR C,L3585 ; forward to FRST-LESS if carry set
|
17831 |
|
|
|
17832 |
|
|
JR NZ,L356B ; back to SECND-LOW and then STR-TEST
|
17833 |
|
|
; if not exact match.
|
17834 |
|
|
|
17835 |
|
|
DEC BC ; decrease length of 1st string.
|
17836 |
|
|
INC DE ; increment 1st string pointer.
|
17837 |
|
|
|
17838 |
|
|
INC HL ; increment 2nd string pointer.
|
17839 |
|
|
EX (SP),HL ; swap with length on stack
|
17840 |
|
|
DEC HL ; decrement 2nd string length
|
17841 |
|
|
JR L3564 ; back to BYTE-COMP
|
17842 |
|
|
|
17843 |
|
|
; ---
|
17844 |
|
|
; the false condition.
|
17845 |
|
|
|
17846 |
|
|
;; FRST-LESS
|
17847 |
|
|
L3585: POP BC ; discard length
|
17848 |
|
|
POP AF ; pop A
|
17849 |
|
|
AND A ; clear the carry for false result.
|
17850 |
|
|
|
17851 |
|
|
; ---
|
17852 |
|
|
; exact match and x$>y$ rejoin here
|
17853 |
|
|
|
17854 |
|
|
;; STR-TEST
|
17855 |
|
|
L3588: PUSH AF ; save A and carry
|
17856 |
|
|
|
17857 |
|
|
RST 28H ;; FP-CALC
|
17858 |
|
|
DEFB $A0 ;;stk-zero an initial false value.
|
17859 |
|
|
DEFB $38 ;;end-calc
|
17860 |
|
|
|
17861 |
|
|
; both numeric and string paths converge here.
|
17862 |
|
|
|
17863 |
|
|
;; END-TESTS
|
17864 |
|
|
L358C: POP AF ; pop carry - will be set if eql/neql
|
17865 |
|
|
PUSH AF ; save it again.
|
17866 |
|
|
|
17867 |
|
|
CALL C,L3501 ; routine NOT sets true(1) if equal(0)
|
17868 |
|
|
; or, for strings, applies true result.
|
17869 |
|
|
|
17870 |
|
|
POP AF ; pop carry and
|
17871 |
|
|
PUSH AF ; save A
|
17872 |
|
|
|
17873 |
|
|
CALL NC,L34F9 ; routine GREATER-0 tests numeric subtraction
|
17874 |
|
|
; result but also needlessly tests the string
|
17875 |
|
|
; value for zero - it must be.
|
17876 |
|
|
|
17877 |
|
|
POP AF ; pop A
|
17878 |
|
|
RRCA ; the third RRCA - test for '<=', '>=' or '<>'.
|
17879 |
|
|
CALL NC,L3501 ; apply a terminal NOT if so.
|
17880 |
|
|
RET ; return.
|
17881 |
|
|
|
17882 |
|
|
; ------------------------------------
|
17883 |
|
|
; THE 'STRING CONCATENATION' OPERATION
|
17884 |
|
|
; ------------------------------------
|
17885 |
|
|
; (offset: $17 'strs-add')
|
17886 |
|
|
; This literal combines two strings into one e.g. LET a$ = b$ + c$
|
17887 |
|
|
; The two parameters of the two strings to be combined are on the stack.
|
17888 |
|
|
|
17889 |
|
|
;; strs-add
|
17890 |
|
|
L359C: CALL L2BF1 ; routine STK-FETCH fetches string parameters
|
17891 |
|
|
; and deletes calculator stack entry.
|
17892 |
|
|
PUSH DE ; save start address.
|
17893 |
|
|
PUSH BC ; and length.
|
17894 |
|
|
|
17895 |
|
|
CALL L2BF1 ; routine STK-FETCH for first string
|
17896 |
|
|
POP HL ; re-fetch first length
|
17897 |
|
|
PUSH HL ; and save again
|
17898 |
|
|
PUSH DE ; save start of second string
|
17899 |
|
|
PUSH BC ; and its length.
|
17900 |
|
|
|
17901 |
|
|
ADD HL,BC ; add the two lengths.
|
17902 |
|
|
LD B,H ; transfer to BC
|
17903 |
|
|
LD C,L ; and create
|
17904 |
|
|
RST 30H ; BC-SPACES in workspace.
|
17905 |
|
|
; DE points to start of space.
|
17906 |
|
|
|
17907 |
|
|
CALL L2AB2 ; routine STK-STO-$ stores parameters
|
17908 |
|
|
; of new string updating STKEND.
|
17909 |
|
|
|
17910 |
|
|
POP BC ; length of first
|
17911 |
|
|
POP HL ; address of start
|
17912 |
|
|
LD A,B ; test for
|
17913 |
|
|
OR C ; zero length.
|
17914 |
|
|
JR Z,L35B7 ; to OTHER-STR if null string
|
17915 |
|
|
|
17916 |
|
|
LDIR ; copy string to workspace.
|
17917 |
|
|
|
17918 |
|
|
;; OTHER-STR
|
17919 |
|
|
L35B7: POP BC ; now second length
|
17920 |
|
|
POP HL ; and start of string
|
17921 |
|
|
LD A,B ; test this one
|
17922 |
|
|
OR C ; for zero length
|
17923 |
|
|
JR Z,L35BF ; skip forward to STK-PNTRS if so as complete.
|
17924 |
|
|
|
17925 |
|
|
LDIR ; else copy the bytes.
|
17926 |
|
|
; and continue into next routine which
|
17927 |
|
|
; sets the calculator stack pointers.
|
17928 |
|
|
|
17929 |
|
|
; -----------------------------------
|
17930 |
|
|
; THE 'SET STACK POINTERS' SUBROUTINE
|
17931 |
|
|
; -----------------------------------
|
17932 |
|
|
; Register DE is set to STKEND and HL, the result pointer, is set to five
|
17933 |
|
|
; locations below this.
|
17934 |
|
|
; This routine is used when it is inconvenient to save these values at the
|
17935 |
|
|
; time the calculator stack is manipulated due to other activity on the
|
17936 |
|
|
; machine stack.
|
17937 |
|
|
; This routine is also used to terminate the VAL and READ-IN routines for
|
17938 |
|
|
; the same reason and to initialize the calculator stack at the start of
|
17939 |
|
|
; the CALCULATE routine.
|
17940 |
|
|
|
17941 |
|
|
;; STK-PNTRS
|
17942 |
|
|
L35BF: LD HL,($5C65) ; fetch STKEND value from system variable.
|
17943 |
|
|
LD DE,$FFFB ; the value -5
|
17944 |
|
|
PUSH HL ; push STKEND value.
|
17945 |
|
|
|
17946 |
|
|
ADD HL,DE ; subtract 5 from HL.
|
17947 |
|
|
|
17948 |
|
|
POP DE ; pop STKEND to DE.
|
17949 |
|
|
RET ; return.
|
17950 |
|
|
|
17951 |
|
|
; -------------------
|
17952 |
|
|
; THE 'CHR$' FUNCTION
|
17953 |
|
|
; -------------------
|
17954 |
|
|
; (offset: $2f 'chr$')
|
17955 |
|
|
; This function returns a single character string that is a result of
|
17956 |
|
|
; converting a number in the range 0-255 to a string e.g. CHR$ 65 = "A".
|
17957 |
|
|
|
17958 |
|
|
;; chrs
|
17959 |
|
|
L35C9: CALL L2DD5 ; routine FP-TO-A puts the number in A.
|
17960 |
|
|
|
17961 |
|
|
JR C,L35DC ; forward to REPORT-Bd if overflow
|
17962 |
|
|
JR NZ,L35DC ; forward to REPORT-Bd if negative
|
17963 |
|
|
|
17964 |
|
|
PUSH AF ; save the argument.
|
17965 |
|
|
|
17966 |
|
|
LD BC,$0001 ; one space required.
|
17967 |
|
|
RST 30H ; BC-SPACES makes DE point to start
|
17968 |
|
|
|
17969 |
|
|
POP AF ; restore the number.
|
17970 |
|
|
|
17971 |
|
|
LD (DE),A ; and store in workspace
|
17972 |
|
|
|
17973 |
|
|
CALL L2AB2 ; routine STK-STO-$ stacks descriptor.
|
17974 |
|
|
|
17975 |
|
|
EX DE,HL ; make HL point to result and DE to STKEND.
|
17976 |
|
|
RET ; return.
|
17977 |
|
|
|
17978 |
|
|
; ---
|
17979 |
|
|
|
17980 |
|
|
;; REPORT-Bd
|
17981 |
|
|
L35DC: RST 08H ; ERROR-1
|
17982 |
|
|
DEFB $0A ; Error Report: Integer out of range
|
17983 |
|
|
|
17984 |
|
|
; ----------------------------
|
17985 |
|
|
; THE 'VAL and VAL$' FUNCTIONS
|
17986 |
|
|
; ----------------------------
|
17987 |
|
|
; (offset: $1d 'val')
|
17988 |
|
|
; (offset: $18 'val$')
|
17989 |
|
|
; VAL treats the characters in a string as a numeric expression.
|
17990 |
|
|
; e.g. VAL "2.3" = 2.3, VAL "2+4" = 6, VAL ("2" + "4") = 24.
|
17991 |
|
|
; VAL$ treats the characters in a string as a string expression.
|
17992 |
|
|
; e.g. VAL$ (z$+"(2)") = a$(2) if z$ happens to be "a$".
|
17993 |
|
|
|
17994 |
|
|
;; val
|
17995 |
|
|
;; val$
|
17996 |
|
|
L35DE: LD HL,($5C5D) ; fetch value of system variable CH_ADD
|
17997 |
|
|
PUSH HL ; and save on the machine stack.
|
17998 |
|
|
LD A,B ; fetch the literal (either $1D or $18).
|
17999 |
|
|
ADD A,$E3 ; add $E3 to form $00 (setting carry) or $FB.
|
18000 |
|
|
SBC A,A ; now form $FF bit 6 = numeric result
|
18001 |
|
|
; or $00 bit 6 = string result.
|
18002 |
|
|
PUSH AF ; save this mask on the stack
|
18003 |
|
|
|
18004 |
|
|
CALL L2BF1 ; routine STK-FETCH fetches the string operand
|
18005 |
|
|
; from calculator stack.
|
18006 |
|
|
|
18007 |
|
|
PUSH DE ; save the address of the start of the string.
|
18008 |
|
|
INC BC ; increment the length for a carriage return.
|
18009 |
|
|
|
18010 |
|
|
RST 30H ; BC-SPACES creates the space in workspace.
|
18011 |
|
|
POP HL ; restore start of string to HL.
|
18012 |
|
|
LD ($5C5D),DE ; load CH_ADD with start DE in workspace.
|
18013 |
|
|
|
18014 |
|
|
PUSH DE ; save the start in workspace
|
18015 |
|
|
LDIR ; copy string from program or variables or
|
18016 |
|
|
; workspace to the workspace area.
|
18017 |
|
|
EX DE,HL ; end of string + 1 to HL
|
18018 |
|
|
DEC HL ; decrement HL to point to end of new area.
|
18019 |
|
|
LD (HL),$0D ; insert a carriage return at end.
|
18020 |
|
|
RES 7,(IY+$01) ; update FLAGS - signal checking syntax.
|
18021 |
|
|
CALL L24FB ; routine SCANNING evaluates string
|
18022 |
|
|
; expression and result.
|
18023 |
|
|
|
18024 |
|
|
RST 18H ; GET-CHAR fetches next character.
|
18025 |
|
|
CP $0D ; is it the expected carriage return ?
|
18026 |
|
|
JR NZ,L360C ; forward to V-RPORT-C if not
|
18027 |
|
|
; 'Nonsense in BASIC'.
|
18028 |
|
|
|
18029 |
|
|
POP HL ; restore start of string in workspace.
|
18030 |
|
|
POP AF ; restore expected result flag (bit 6).
|
18031 |
|
|
XOR (IY+$01) ; xor with FLAGS now updated by SCANNING.
|
18032 |
|
|
AND $40 ; test bit 6 - should be zero if result types
|
18033 |
|
|
; match.
|
18034 |
|
|
|
18035 |
|
|
;; V-RPORT-C
|
18036 |
|
|
L360C: JP NZ,L1C8A ; jump back to REPORT-C with a result mismatch.
|
18037 |
|
|
|
18038 |
|
|
LD ($5C5D),HL ; set CH_ADD to the start of the string again.
|
18039 |
|
|
SET 7,(IY+$01) ; update FLAGS - signal running program.
|
18040 |
|
|
CALL L24FB ; routine SCANNING evaluates the string
|
18041 |
|
|
; in full leaving result on calculator stack.
|
18042 |
|
|
|
18043 |
|
|
POP HL ; restore saved character address in program.
|
18044 |
|
|
LD ($5C5D),HL ; and reset the system variable CH_ADD.
|
18045 |
|
|
|
18046 |
|
|
JR L35BF ; back to exit via STK-PNTRS.
|
18047 |
|
|
; resetting the calculator stack pointers
|
18048 |
|
|
; HL and DE from STKEND as it wasn't possible
|
18049 |
|
|
; to preserve them during this routine.
|
18050 |
|
|
|
18051 |
|
|
; -------------------
|
18052 |
|
|
; THE 'STR$' FUNCTION
|
18053 |
|
|
; -------------------
|
18054 |
|
|
; (offset: $2e 'str$')
|
18055 |
|
|
; This function produces a string comprising the characters that would appear
|
18056 |
|
|
; if the numeric argument were printed.
|
18057 |
|
|
; e.g. STR$ (1/10) produces "0.1".
|
18058 |
|
|
|
18059 |
|
|
;; str$
|
18060 |
|
|
L361F: LD BC,$0001 ; create an initial byte in workspace
|
18061 |
|
|
RST 30H ; using BC-SPACES restart.
|
18062 |
|
|
|
18063 |
|
|
LD ($5C5B),HL ; set system variable K_CUR to new location.
|
18064 |
|
|
PUSH HL ; and save start on machine stack also.
|
18065 |
|
|
|
18066 |
|
|
LD HL,($5C51) ; fetch value of system variable CURCHL
|
18067 |
|
|
PUSH HL ; and save that too.
|
18068 |
|
|
|
18069 |
|
|
LD A,$FF ; select system channel 'R'.
|
18070 |
|
|
CALL L1601 ; routine CHAN-OPEN opens it.
|
18071 |
|
|
CALL L2DE3 ; routine PRINT-FP outputs the number to
|
18072 |
|
|
; workspace updating K-CUR.
|
18073 |
|
|
|
18074 |
|
|
POP HL ; restore current channel.
|
18075 |
|
|
CALL L1615 ; routine CHAN-FLAG resets flags.
|
18076 |
|
|
|
18077 |
|
|
POP DE ; fetch saved start of string to DE.
|
18078 |
|
|
LD HL,($5C5B) ; load HL with end of string from K_CUR.
|
18079 |
|
|
|
18080 |
|
|
AND A ; prepare for true subtraction.
|
18081 |
|
|
SBC HL,DE ; subtract start from end to give length.
|
18082 |
|
|
LD B,H ; transfer the length to
|
18083 |
|
|
LD C,L ; the BC register pair.
|
18084 |
|
|
|
18085 |
|
|
CALL L2AB2 ; routine STK-STO-$ stores string parameters
|
18086 |
|
|
; on the calculator stack.
|
18087 |
|
|
|
18088 |
|
|
EX DE,HL ; HL = last value, DE = STKEND.
|
18089 |
|
|
RET ; return.
|
18090 |
|
|
|
18091 |
|
|
; ------------------------
|
18092 |
|
|
; THE 'READ-IN' SUBROUTINE
|
18093 |
|
|
; ------------------------
|
18094 |
|
|
; (offset: $1a 'read-in')
|
18095 |
|
|
; This is the calculator literal used by the INKEY$ function when a '#'
|
18096 |
|
|
; is encountered after the keyword.
|
18097 |
|
|
; INKEY$ # does not interact correctly with the keyboard, #0 or #1, and
|
18098 |
|
|
; its uses are for other channels.
|
18099 |
|
|
|
18100 |
|
|
;; read-in
|
18101 |
|
|
L3645: CALL L1E94 ; routine FIND-INT1 fetches stream to A
|
18102 |
|
|
CP $10 ; compare with 16 decimal.
|
18103 |
|
|
JP NC,L1E9F ; JUMP to REPORT-Bb if not in range 0 - 15.
|
18104 |
|
|
; 'Integer out of range'
|
18105 |
|
|
; (REPORT-Bd is within range)
|
18106 |
|
|
|
18107 |
|
|
LD HL,($5C51) ; fetch current channel CURCHL
|
18108 |
|
|
PUSH HL ; save it
|
18109 |
|
|
|
18110 |
|
|
CALL L1601 ; routine CHAN-OPEN opens channel
|
18111 |
|
|
|
18112 |
|
|
CALL L15E6 ; routine INPUT-AD - the channel must have an
|
18113 |
|
|
; input stream or else error here from stream
|
18114 |
|
|
; stub.
|
18115 |
|
|
LD BC,$0000 ; initialize length of string to zero
|
18116 |
|
|
JR NC,L365F ; forward to R-I-STORE if no key detected.
|
18117 |
|
|
|
18118 |
|
|
INC C ; increase length to one.
|
18119 |
|
|
|
18120 |
|
|
RST 30H ; BC-SPACES creates space for one character
|
18121 |
|
|
; in workspace.
|
18122 |
|
|
LD (DE),A ; the character is inserted.
|
18123 |
|
|
|
18124 |
|
|
;; R-I-STORE
|
18125 |
|
|
L365F: CALL L2AB2 ; routine STK-STO-$ stacks the string
|
18126 |
|
|
; parameters.
|
18127 |
|
|
POP HL ; restore current channel address
|
18128 |
|
|
|
18129 |
|
|
CALL L1615 ; routine CHAN-FLAG resets current channel
|
18130 |
|
|
; system variable and flags.
|
18131 |
|
|
|
18132 |
|
|
JP L35BF ; jump back to STK-PNTRS
|
18133 |
|
|
|
18134 |
|
|
; -------------------
|
18135 |
|
|
; THE 'CODE' FUNCTION
|
18136 |
|
|
; -------------------
|
18137 |
|
|
; (offset: $1c 'code')
|
18138 |
|
|
; Returns the ASCII code of a character or first character of a string
|
18139 |
|
|
; e.g. CODE "Aardvark" = 65, CODE "" = 0.
|
18140 |
|
|
|
18141 |
|
|
;; code
|
18142 |
|
|
L3669: CALL L2BF1 ; routine STK-FETCH to fetch and delete the
|
18143 |
|
|
; string parameters.
|
18144 |
|
|
; DE points to the start, BC holds the length.
|
18145 |
|
|
|
18146 |
|
|
LD A,B ; test length
|
18147 |
|
|
OR C ; of the string.
|
18148 |
|
|
JR Z,L3671 ; skip to STK-CODE with zero if the null string.
|
18149 |
|
|
|
18150 |
|
|
LD A,(DE) ; else fetch the first character.
|
18151 |
|
|
|
18152 |
|
|
;; STK-CODE
|
18153 |
|
|
L3671: JP L2D28 ; jump back to STACK-A (with memory check)
|
18154 |
|
|
|
18155 |
|
|
; ------------------
|
18156 |
|
|
; THE 'LEN' FUNCTION
|
18157 |
|
|
; ------------------
|
18158 |
|
|
; (offset: $1e 'len')
|
18159 |
|
|
; Returns the length of a string.
|
18160 |
|
|
; In Sinclair BASIC strings can be more than twenty thousand characters long
|
18161 |
|
|
; so a sixteen-bit register is required to store the length
|
18162 |
|
|
|
18163 |
|
|
;; len
|
18164 |
|
|
L3674: CALL L2BF1 ; Routine STK-FETCH to fetch and delete the
|
18165 |
|
|
; string parameters from the calculator stack.
|
18166 |
|
|
; Register BC now holds the length of string.
|
18167 |
|
|
|
18168 |
|
|
JP L2D2B ; Jump back to STACK-BC to save result on the
|
18169 |
|
|
; calculator stack (with memory check).
|
18170 |
|
|
|
18171 |
|
|
; -------------------------------------
|
18172 |
|
|
; THE 'DECREASE THE COUNTER' SUBROUTINE
|
18173 |
|
|
; -------------------------------------
|
18174 |
|
|
; (offset: $35 'dec-jr-nz')
|
18175 |
|
|
; The calculator has an instruction that decrements a single-byte
|
18176 |
|
|
; pseudo-register and makes consequential relative jumps just like
|
18177 |
|
|
; the Z80's DJNZ instruction.
|
18178 |
|
|
|
18179 |
|
|
;; dec-jr-nz
|
18180 |
|
|
L367A: EXX ; switch in set that addresses code
|
18181 |
|
|
|
18182 |
|
|
PUSH HL ; save pointer to offset byte
|
18183 |
|
|
LD HL,$5C67 ; address BREG in system variables
|
18184 |
|
|
DEC (HL) ; decrement it
|
18185 |
|
|
POP HL ; restore pointer
|
18186 |
|
|
|
18187 |
|
|
JR NZ,L3687 ; to JUMP-2 if not zero
|
18188 |
|
|
|
18189 |
|
|
INC HL ; step past the jump length.
|
18190 |
|
|
EXX ; switch in the main set.
|
18191 |
|
|
RET ; return.
|
18192 |
|
|
|
18193 |
|
|
; Note. as a general rule the calculator avoids using the IY register
|
18194 |
|
|
; otherwise the cumbersome 4 instructions in the middle could be replaced by
|
18195 |
|
|
; dec (iy+$2d) - three bytes instead of six.
|
18196 |
|
|
|
18197 |
|
|
|
18198 |
|
|
; ---------------------
|
18199 |
|
|
; THE 'JUMP' SUBROUTINE
|
18200 |
|
|
; ---------------------
|
18201 |
|
|
; (offset: $33 'jump')
|
18202 |
|
|
; This enables the calculator to perform relative jumps just like the Z80
|
18203 |
|
|
; chip's JR instruction.
|
18204 |
|
|
|
18205 |
|
|
;; jump
|
18206 |
|
|
;; JUMP
|
18207 |
|
|
L3686: EXX ; switch in pointer set
|
18208 |
|
|
|
18209 |
|
|
;; JUMP-2
|
18210 |
|
|
L3687: LD E,(HL) ; the jump byte 0-127 forward, 128-255 back.
|
18211 |
|
|
LD A,E ; transfer to accumulator.
|
18212 |
|
|
RLA ; if backward jump, carry is set.
|
18213 |
|
|
SBC A,A ; will be $FF if backward or $00 if forward.
|
18214 |
|
|
LD D,A ; transfer to high byte.
|
18215 |
|
|
ADD HL,DE ; advance calculator pointer forward or back.
|
18216 |
|
|
|
18217 |
|
|
EXX ; switch back.
|
18218 |
|
|
RET ; return.
|
18219 |
|
|
|
18220 |
|
|
; --------------------------
|
18221 |
|
|
; THE 'JUMP-TRUE' SUBROUTINE
|
18222 |
|
|
; --------------------------
|
18223 |
|
|
; (offset: $00 'jump-true')
|
18224 |
|
|
; This enables the calculator to perform conditional relative jumps dependent
|
18225 |
|
|
; on whether the last test gave a true result.
|
18226 |
|
|
|
18227 |
|
|
;; jump-true
|
18228 |
|
|
L368F: INC DE ; Collect the
|
18229 |
|
|
INC DE ; third byte
|
18230 |
|
|
LD A,(DE) ; of the test
|
18231 |
|
|
DEC DE ; result and
|
18232 |
|
|
DEC DE ; backtrack.
|
18233 |
|
|
|
18234 |
|
|
AND A ; Is result 0 or 1 ?
|
18235 |
|
|
JR NZ,L3686 ; Back to JUMP if true (1).
|
18236 |
|
|
|
18237 |
|
|
EXX ; Else switch in the pointer set.
|
18238 |
|
|
INC HL ; Step past the jump length.
|
18239 |
|
|
EXX ; Switch in the main set.
|
18240 |
|
|
RET ; Return.
|
18241 |
|
|
|
18242 |
|
|
; -------------------------
|
18243 |
|
|
; THE 'END-CALC' SUBROUTINE
|
18244 |
|
|
; -------------------------
|
18245 |
|
|
; (offset: $38 'end-calc')
|
18246 |
|
|
; The end-calc literal terminates a mini-program written in the Spectrum's
|
18247 |
|
|
; internal language.
|
18248 |
|
|
|
18249 |
|
|
;; end-calc
|
18250 |
|
|
L369B: POP AF ; Drop the calculator return address RE-ENTRY
|
18251 |
|
|
EXX ; Switch to the other set.
|
18252 |
|
|
|
18253 |
|
|
EX (SP),HL ; Transfer H'L' to machine stack for the
|
18254 |
|
|
; return address.
|
18255 |
|
|
; When exiting recursion, then the previous
|
18256 |
|
|
; pointer is transferred to H'L'.
|
18257 |
|
|
|
18258 |
|
|
EXX ; Switch back to main set.
|
18259 |
|
|
RET ; Return.
|
18260 |
|
|
|
18261 |
|
|
|
18262 |
|
|
; ------------------------
|
18263 |
|
|
; THE 'MODULUS' SUBROUTINE
|
18264 |
|
|
; ------------------------
|
18265 |
|
|
; (offset: $32 'n-mod-m')
|
18266 |
|
|
; (n1,n2 -- r,q)
|
18267 |
|
|
; Similar to FORTH's 'divide mod' /MOD
|
18268 |
|
|
; On the Spectrum, this is only used internally by the RND function and could
|
18269 |
|
|
; have been implemented inline. On the ZX81, this calculator routine was also
|
18270 |
|
|
; used by PRINT-FP.
|
18271 |
|
|
|
18272 |
|
|
;; n-mod-m
|
18273 |
|
|
L36A0: RST 28H ;; FP-CALC 17, 3.
|
18274 |
|
|
DEFB $C0 ;;st-mem-0 17, 3.
|
18275 |
|
|
DEFB $02 ;;delete 17.
|
18276 |
|
|
DEFB $31 ;;duplicate 17, 17.
|
18277 |
|
|
DEFB $E0 ;;get-mem-0 17, 17, 3.
|
18278 |
|
|
DEFB $05 ;;division 17, 17/3.
|
18279 |
|
|
DEFB $27 ;;int 17, 5.
|
18280 |
|
|
DEFB $E0 ;;get-mem-0 17, 5, 3.
|
18281 |
|
|
DEFB $01 ;;exchange 17, 3, 5.
|
18282 |
|
|
DEFB $C0 ;;st-mem-0 17, 3, 5.
|
18283 |
|
|
DEFB $04 ;;multiply 17, 15.
|
18284 |
|
|
DEFB $03 ;;subtract 2.
|
18285 |
|
|
DEFB $E0 ;;get-mem-0 2, 5.
|
18286 |
|
|
DEFB $38 ;;end-calc 2, 5.
|
18287 |
|
|
|
18288 |
|
|
RET ; return.
|
18289 |
|
|
|
18290 |
|
|
|
18291 |
|
|
; ------------------
|
18292 |
|
|
; THE 'INT' FUNCTION
|
18293 |
|
|
; ------------------
|
18294 |
|
|
; (offset $27: 'int' )
|
18295 |
|
|
; This function returns the integer of x, which is just the same as truncate
|
18296 |
|
|
; for positive numbers. The truncate literal truncates negative numbers
|
18297 |
|
|
; upwards so that -3.4 gives -3 whereas the BASIC INT function has to
|
18298 |
|
|
; truncate negative numbers down so that INT -3.4 is -4.
|
18299 |
|
|
; It is best to work through using, say, +-3.4 as examples.
|
18300 |
|
|
|
18301 |
|
|
;; int
|
18302 |
|
|
L36AF: RST 28H ;; FP-CALC x. (= 3.4 or -3.4).
|
18303 |
|
|
DEFB $31 ;;duplicate x, x.
|
18304 |
|
|
DEFB $36 ;;less-0 x, (1/0)
|
18305 |
|
|
DEFB $00 ;;jump-true x, (1/0)
|
18306 |
|
|
DEFB $04 ;;to L36B7, X-NEG
|
18307 |
|
|
|
18308 |
|
|
DEFB $3A ;;truncate trunc 3.4 = 3.
|
18309 |
|
|
DEFB $38 ;;end-calc 3.
|
18310 |
|
|
|
18311 |
|
|
RET ; return with + int x on stack.
|
18312 |
|
|
|
18313 |
|
|
; ---
|
18314 |
|
|
|
18315 |
|
|
|
18316 |
|
|
;; X-NEG
|
18317 |
|
|
L36B7: DEFB $31 ;;duplicate -3.4, -3.4.
|
18318 |
|
|
DEFB $3A ;;truncate -3.4, -3.
|
18319 |
|
|
DEFB $C0 ;;st-mem-0 -3.4, -3.
|
18320 |
|
|
DEFB $03 ;;subtract -.4
|
18321 |
|
|
DEFB $E0 ;;get-mem-0 -.4, -3.
|
18322 |
|
|
DEFB $01 ;;exchange -3, -.4.
|
18323 |
|
|
DEFB $30 ;;not -3, (0).
|
18324 |
|
|
DEFB $00 ;;jump-true -3.
|
18325 |
|
|
DEFB $03 ;;to L36C2, EXIT -3.
|
18326 |
|
|
|
18327 |
|
|
DEFB $A1 ;;stk-one -3, 1.
|
18328 |
|
|
DEFB $03 ;;subtract -4.
|
18329 |
|
|
|
18330 |
|
|
;; EXIT
|
18331 |
|
|
L36C2: DEFB $38 ;;end-calc -4.
|
18332 |
|
|
|
18333 |
|
|
RET ; return.
|
18334 |
|
|
|
18335 |
|
|
|
18336 |
|
|
; ------------------
|
18337 |
|
|
; THE 'EXP' FUNCTION
|
18338 |
|
|
; ------------------
|
18339 |
|
|
; (offset $26: 'exp')
|
18340 |
|
|
; The exponential function EXP x is equal to e^x, where e is the mathematical
|
18341 |
|
|
; name for a number approximated to 2.718281828.
|
18342 |
|
|
; ERROR 6 if argument is more than about 88.
|
18343 |
|
|
|
18344 |
|
|
;; EXP
|
18345 |
|
|
;; exp
|
18346 |
|
|
L36C4: RST 28H ;; FP-CALC
|
18347 |
|
|
DEFB $3D ;;re-stack (not required - mult will do)
|
18348 |
|
|
DEFB $34 ;;stk-data
|
18349 |
|
|
DEFB $F1 ;;Exponent: $81, Bytes: 4
|
18350 |
|
|
DEFB $38,$AA,$3B,$29 ;;
|
18351 |
|
|
DEFB $04 ;;multiply
|
18352 |
|
|
DEFB $31 ;;duplicate
|
18353 |
|
|
DEFB $27 ;;int
|
18354 |
|
|
DEFB $C3 ;;st-mem-3
|
18355 |
|
|
DEFB $03 ;;subtract
|
18356 |
|
|
DEFB $31 ;;duplicate
|
18357 |
|
|
DEFB $0F ;;addition
|
18358 |
|
|
DEFB $A1 ;;stk-one
|
18359 |
|
|
DEFB $03 ;;subtract
|
18360 |
|
|
DEFB $88 ;;series-08
|
18361 |
|
|
DEFB $13 ;;Exponent: $63, Bytes: 1
|
18362 |
|
|
DEFB $36 ;;(+00,+00,+00)
|
18363 |
|
|
DEFB $58 ;;Exponent: $68, Bytes: 2
|
18364 |
|
|
DEFB $65,$66 ;;(+00,+00)
|
18365 |
|
|
DEFB $9D ;;Exponent: $6D, Bytes: 3
|
18366 |
|
|
DEFB $78,$65,$40 ;;(+00)
|
18367 |
|
|
DEFB $A2 ;;Exponent: $72, Bytes: 3
|
18368 |
|
|
DEFB $60,$32,$C9 ;;(+00)
|
18369 |
|
|
DEFB $E7 ;;Exponent: $77, Bytes: 4
|
18370 |
|
|
DEFB $21,$F7,$AF,$24 ;;
|
18371 |
|
|
DEFB $EB ;;Exponent: $7B, Bytes: 4
|
18372 |
|
|
DEFB $2F,$B0,$B0,$14 ;;
|
18373 |
|
|
DEFB $EE ;;Exponent: $7E, Bytes: 4
|
18374 |
|
|
DEFB $7E,$BB,$94,$58 ;;
|
18375 |
|
|
DEFB $F1 ;;Exponent: $81, Bytes: 4
|
18376 |
|
|
DEFB $3A,$7E,$F8,$CF ;;
|
18377 |
|
|
DEFB $E3 ;;get-mem-3
|
18378 |
|
|
DEFB $38 ;;end-calc
|
18379 |
|
|
|
18380 |
|
|
CALL L2DD5 ; routine FP-TO-A
|
18381 |
|
|
JR NZ,L3705 ; to N-NEGTV
|
18382 |
|
|
|
18383 |
|
|
JR C,L3703 ; to REPORT-6b
|
18384 |
|
|
; 'Number too big'
|
18385 |
|
|
|
18386 |
|
|
ADD A,(HL) ;
|
18387 |
|
|
JR NC,L370C ; to RESULT-OK
|
18388 |
|
|
|
18389 |
|
|
|
18390 |
|
|
;; REPORT-6b
|
18391 |
|
|
L3703: RST 08H ; ERROR-1
|
18392 |
|
|
DEFB $05 ; Error Report: Number too big
|
18393 |
|
|
|
18394 |
|
|
; ---
|
18395 |
|
|
|
18396 |
|
|
;; N-NEGTV
|
18397 |
|
|
L3705: JR C,L370E ; to RSLT-ZERO
|
18398 |
|
|
|
18399 |
|
|
SUB (HL) ;
|
18400 |
|
|
JR NC,L370E ; to RSLT-ZERO
|
18401 |
|
|
|
18402 |
|
|
NEG ; Negate
|
18403 |
|
|
|
18404 |
|
|
;; RESULT-OK
|
18405 |
|
|
L370C: LD (HL),A ;
|
18406 |
|
|
RET ; return.
|
18407 |
|
|
|
18408 |
|
|
; ---
|
18409 |
|
|
|
18410 |
|
|
|
18411 |
|
|
;; RSLT-ZERO
|
18412 |
|
|
L370E: RST 28H ;; FP-CALC
|
18413 |
|
|
DEFB $02 ;;delete
|
18414 |
|
|
DEFB $A0 ;;stk-zero
|
18415 |
|
|
DEFB $38 ;;end-calc
|
18416 |
|
|
|
18417 |
|
|
RET ; return.
|
18418 |
|
|
|
18419 |
|
|
|
18420 |
|
|
; --------------------------------
|
18421 |
|
|
; THE 'NATURAL LOGARITHM' FUNCTION
|
18422 |
|
|
; --------------------------------
|
18423 |
|
|
; (offset $25: 'ln')
|
18424 |
|
|
; Function to calculate the natural logarithm (to the base e ).
|
18425 |
|
|
; Natural logarithms were devised in 1614 by well-traveled Scotsman John
|
18426 |
|
|
; Napier who noted
|
18427 |
|
|
; "Nothing doth more molest and hinder calculators than the multiplications,
|
18428 |
|
|
; divisions, square and cubical extractions of great numbers".
|
18429 |
|
|
;
|
18430 |
|
|
; Napier's logarithms enabled the above operations to be accomplished by
|
18431 |
|
|
; simple addition and subtraction simplifying the navigational and
|
18432 |
|
|
; astronomical calculations which beset his age.
|
18433 |
|
|
; Napier's logarithms were quickly overtaken by logarithms to the base 10
|
18434 |
|
|
; devised, in conjunction with Napier, by Henry Briggs a Cambridge-educated
|
18435 |
|
|
; professor of Geometry at Oxford University. These simplified the layout
|
18436 |
|
|
; of the tables enabling humans to easily scale calculations.
|
18437 |
|
|
;
|
18438 |
|
|
; It is only recently with the introduction of pocket calculators and machines
|
18439 |
|
|
; like the ZX Spectrum that natural logarithms are once more at the fore,
|
18440 |
|
|
; although some computers retain logarithms to the base ten.
|
18441 |
|
|
;
|
18442 |
|
|
; 'Natural' logarithms are powers to the base 'e', which like 'pi' is a
|
18443 |
|
|
; naturally occurring number in branches of mathematics.
|
18444 |
|
|
; Like 'pi' also, 'e' is an irrational number and starts 2.718281828...
|
18445 |
|
|
;
|
18446 |
|
|
; The tabular use of logarithms was that to multiply two numbers one looked
|
18447 |
|
|
; up their two logarithms in the tables, added them together and then looked
|
18448 |
|
|
; for the result in a table of antilogarithms to give the desired product.
|
18449 |
|
|
;
|
18450 |
|
|
; The EXP function is the BASIC equivalent of a calculator's 'antiln' function
|
18451 |
|
|
; and by picking any two numbers, 1.72 and 6.89 say,
|
18452 |
|
|
; 10 PRINT EXP ( LN 1.72 + LN 6.89 )
|
18453 |
|
|
; will give just the same result as
|
18454 |
|
|
; 20 PRINT 1.72 * 6.89.
|
18455 |
|
|
; Division is accomplished by subtracting the two logs.
|
18456 |
|
|
;
|
18457 |
|
|
; Napier also mentioned "square and cubicle extractions".
|
18458 |
|
|
; To raise a number to the power 3, find its 'ln', multiply by 3 and find the
|
18459 |
|
|
; 'antiln'. e.g. PRINT EXP( LN 4 * 3 ) gives 64.
|
18460 |
|
|
; Similarly to find the n'th root divide the logarithm by 'n'.
|
18461 |
|
|
; The ZX81 ROM used PRINT EXP ( LN 9 / 2 ) to find the square root of the
|
18462 |
|
|
; number 9. The Napieran square root function is just a special case of
|
18463 |
|
|
; the 'to_power' function. A cube root or indeed any root/power would be just
|
18464 |
|
|
; as simple.
|
18465 |
|
|
|
18466 |
|
|
; First test that the argument to LN is a positive, non-zero number.
|
18467 |
|
|
; Error A if the argument is 0 or negative.
|
18468 |
|
|
|
18469 |
|
|
;; ln
|
18470 |
|
|
L3713: RST 28H ;; FP-CALC
|
18471 |
|
|
DEFB $3D ;;re-stack
|
18472 |
|
|
DEFB $31 ;;duplicate
|
18473 |
|
|
DEFB $37 ;;greater-0
|
18474 |
|
|
DEFB $00 ;;jump-true
|
18475 |
|
|
DEFB $04 ;;to L371C, VALID
|
18476 |
|
|
|
18477 |
|
|
DEFB $38 ;;end-calc
|
18478 |
|
|
|
18479 |
|
|
|
18480 |
|
|
;; REPORT-Ab
|
18481 |
|
|
L371A: RST 08H ; ERROR-1
|
18482 |
|
|
DEFB $09 ; Error Report: Invalid argument
|
18483 |
|
|
|
18484 |
|
|
;; VALID
|
18485 |
|
|
L371C: DEFB $A0 ;;stk-zero Note. not
|
18486 |
|
|
DEFB $02 ;;delete necessary.
|
18487 |
|
|
DEFB $38 ;;end-calc
|
18488 |
|
|
LD A,(HL) ;
|
18489 |
|
|
|
18490 |
|
|
LD (HL),$80 ;
|
18491 |
|
|
CALL L2D28 ; routine STACK-A
|
18492 |
|
|
|
18493 |
|
|
RST 28H ;; FP-CALC
|
18494 |
|
|
DEFB $34 ;;stk-data
|
18495 |
|
|
DEFB $38 ;;Exponent: $88, Bytes: 1
|
18496 |
|
|
DEFB $00 ;;(+00,+00,+00)
|
18497 |
|
|
DEFB $03 ;;subtract
|
18498 |
|
|
DEFB $01 ;;exchange
|
18499 |
|
|
DEFB $31 ;;duplicate
|
18500 |
|
|
DEFB $34 ;;stk-data
|
18501 |
|
|
DEFB $F0 ;;Exponent: $80, Bytes: 4
|
18502 |
|
|
DEFB $4C,$CC,$CC,$CD ;;
|
18503 |
|
|
DEFB $03 ;;subtract
|
18504 |
|
|
DEFB $37 ;;greater-0
|
18505 |
|
|
DEFB $00 ;;jump-true
|
18506 |
|
|
DEFB $08 ;;to L373D, GRE.8
|
18507 |
|
|
|
18508 |
|
|
DEFB $01 ;;exchange
|
18509 |
|
|
DEFB $A1 ;;stk-one
|
18510 |
|
|
DEFB $03 ;;subtract
|
18511 |
|
|
DEFB $01 ;;exchange
|
18512 |
|
|
DEFB $38 ;;end-calc
|
18513 |
|
|
|
18514 |
|
|
INC (HL) ;
|
18515 |
|
|
|
18516 |
|
|
RST 28H ;; FP-CALC
|
18517 |
|
|
|
18518 |
|
|
;; GRE.8
|
18519 |
|
|
L373D: DEFB $01 ;;exchange
|
18520 |
|
|
DEFB $34 ;;stk-data
|
18521 |
|
|
DEFB $F0 ;;Exponent: $80, Bytes: 4
|
18522 |
|
|
DEFB $31,$72,$17,$F8 ;;
|
18523 |
|
|
DEFB $04 ;;multiply
|
18524 |
|
|
DEFB $01 ;;exchange
|
18525 |
|
|
DEFB $A2 ;;stk-half
|
18526 |
|
|
DEFB $03 ;;subtract
|
18527 |
|
|
DEFB $A2 ;;stk-half
|
18528 |
|
|
DEFB $03 ;;subtract
|
18529 |
|
|
DEFB $31 ;;duplicate
|
18530 |
|
|
DEFB $34 ;;stk-data
|
18531 |
|
|
DEFB $32 ;;Exponent: $82, Bytes: 1
|
18532 |
|
|
DEFB $20 ;;(+00,+00,+00)
|
18533 |
|
|
DEFB $04 ;;multiply
|
18534 |
|
|
DEFB $A2 ;;stk-half
|
18535 |
|
|
DEFB $03 ;;subtract
|
18536 |
|
|
DEFB $8C ;;series-0C
|
18537 |
|
|
DEFB $11 ;;Exponent: $61, Bytes: 1
|
18538 |
|
|
DEFB $AC ;;(+00,+00,+00)
|
18539 |
|
|
DEFB $14 ;;Exponent: $64, Bytes: 1
|
18540 |
|
|
DEFB $09 ;;(+00,+00,+00)
|
18541 |
|
|
DEFB $56 ;;Exponent: $66, Bytes: 2
|
18542 |
|
|
DEFB $DA,$A5 ;;(+00,+00)
|
18543 |
|
|
DEFB $59 ;;Exponent: $69, Bytes: 2
|
18544 |
|
|
DEFB $30,$C5 ;;(+00,+00)
|
18545 |
|
|
DEFB $5C ;;Exponent: $6C, Bytes: 2
|
18546 |
|
|
DEFB $90,$AA ;;(+00,+00)
|
18547 |
|
|
DEFB $9E ;;Exponent: $6E, Bytes: 3
|
18548 |
|
|
DEFB $70,$6F,$61 ;;(+00)
|
18549 |
|
|
DEFB $A1 ;;Exponent: $71, Bytes: 3
|
18550 |
|
|
DEFB $CB,$DA,$96 ;;(+00)
|
18551 |
|
|
DEFB $A4 ;;Exponent: $74, Bytes: 3
|
18552 |
|
|
DEFB $31,$9F,$B4 ;;(+00)
|
18553 |
|
|
DEFB $E7 ;;Exponent: $77, Bytes: 4
|
18554 |
|
|
DEFB $A0,$FE,$5C,$FC ;;
|
18555 |
|
|
DEFB $EA ;;Exponent: $7A, Bytes: 4
|
18556 |
|
|
DEFB $1B,$43,$CA,$36 ;;
|
18557 |
|
|
DEFB $ED ;;Exponent: $7D, Bytes: 4
|
18558 |
|
|
DEFB $A7,$9C,$7E,$5E ;;
|
18559 |
|
|
DEFB $F0 ;;Exponent: $80, Bytes: 4
|
18560 |
|
|
DEFB $6E,$23,$80,$93 ;;
|
18561 |
|
|
DEFB $04 ;;multiply
|
18562 |
|
|
DEFB $0F ;;addition
|
18563 |
|
|
DEFB $38 ;;end-calc
|
18564 |
|
|
|
18565 |
|
|
RET ; return.
|
18566 |
|
|
|
18567 |
|
|
|
18568 |
|
|
; -----------------------------
|
18569 |
|
|
; THE 'TRIGONOMETRIC' FUNCTIONS
|
18570 |
|
|
; -----------------------------
|
18571 |
|
|
; Trigonometry is rocket science. It is also used by carpenters and pyramid
|
18572 |
|
|
; builders.
|
18573 |
|
|
; Some uses can be quite abstract but the principles can be seen in simple
|
18574 |
|
|
; right-angled triangles. Triangles have some special properties -
|
18575 |
|
|
;
|
18576 |
|
|
; 1) The sum of the three angles is always PI radians (180 degrees).
|
18577 |
|
|
; Very helpful if you know two angles and wish to find the third.
|
18578 |
|
|
; 2) In any right-angled triangle the sum of the squares of the two shorter
|
18579 |
|
|
; sides is equal to the square of the longest side opposite the right-angle.
|
18580 |
|
|
; Very useful if you know the length of two sides and wish to know the
|
18581 |
|
|
; length of the third side.
|
18582 |
|
|
; 3) Functions sine, cosine and tangent enable one to calculate the length
|
18583 |
|
|
; of an unknown side when the length of one other side and an angle is
|
18584 |
|
|
; known.
|
18585 |
|
|
; 4) Functions arcsin, arccosine and arctan enable one to calculate an unknown
|
18586 |
|
|
; angle when the length of two of the sides is known.
|
18587 |
|
|
|
18588 |
|
|
; --------------------------------
|
18589 |
|
|
; THE 'REDUCE ARGUMENT' SUBROUTINE
|
18590 |
|
|
; --------------------------------
|
18591 |
|
|
; (offset $39: 'get-argt')
|
18592 |
|
|
;
|
18593 |
|
|
; This routine performs two functions on the angle, in radians, that forms
|
18594 |
|
|
; the argument to the sine and cosine functions.
|
18595 |
|
|
; First it ensures that the angle 'wraps round'. That if a ship turns through
|
18596 |
|
|
; an angle of, say, 3*PI radians (540 degrees) then the net effect is to turn
|
18597 |
|
|
; through an angle of PI radians (180 degrees).
|
18598 |
|
|
; Secondly it converts the angle in radians to a fraction of a right angle,
|
18599 |
|
|
; depending within which quadrant the angle lies, with the periodicity
|
18600 |
|
|
; resembling that of the desired sine value.
|
18601 |
|
|
; The result lies in the range -1 to +1.
|
18602 |
|
|
;
|
18603 |
|
|
; 90 deg.
|
18604 |
|
|
;
|
18605 |
|
|
; (pi/2)
|
18606 |
|
|
; II +1 I
|
18607 |
|
|
; |
|
18608 |
|
|
; sin+ |\ | /| sin+
|
18609 |
|
|
; cos- | \ | / | cos+
|
18610 |
|
|
; tan- | \ | / | tan+
|
18611 |
|
|
; | \|/) |
|
18612 |
|
|
; 180 deg. (pi) 0 -|----+----|-- 0 (0) 0 degrees
|
18613 |
|
|
; | /|\ |
|
18614 |
|
|
; sin- | / | \ | sin-
|
18615 |
|
|
; cos- | / | \ | cos+
|
18616 |
|
|
; tan+ |/ | \| tan-
|
18617 |
|
|
; |
|
18618 |
|
|
; III -1 IV
|
18619 |
|
|
; (3pi/2)
|
18620 |
|
|
;
|
18621 |
|
|
; 270 deg.
|
18622 |
|
|
;
|
18623 |
|
|
|
18624 |
|
|
;; get-argt
|
18625 |
|
|
L3783: RST 28H ;; FP-CALC X.
|
18626 |
|
|
DEFB $3D ;;re-stack (not rquired done by mult)
|
18627 |
|
|
DEFB $34 ;;stk-data
|
18628 |
|
|
DEFB $EE ;;Exponent: $7E,
|
18629 |
|
|
;;Bytes: 4
|
18630 |
|
|
DEFB $22,$F9,$83,$6E ;; X, 1/(2*PI)
|
18631 |
|
|
DEFB $04 ;;multiply X/(2*PI) = fraction
|
18632 |
|
|
DEFB $31 ;;duplicate
|
18633 |
|
|
DEFB $A2 ;;stk-half
|
18634 |
|
|
DEFB $0F ;;addition
|
18635 |
|
|
DEFB $27 ;;int
|
18636 |
|
|
|
18637 |
|
|
DEFB $03 ;;subtract now range -.5 to .5
|
18638 |
|
|
|
18639 |
|
|
DEFB $31 ;;duplicate
|
18640 |
|
|
DEFB $0F ;;addition now range -1 to 1.
|
18641 |
|
|
DEFB $31 ;;duplicate
|
18642 |
|
|
DEFB $0F ;;addition now range -2 to +2.
|
18643 |
|
|
|
18644 |
|
|
; quadrant I (0 to +1) and quadrant IV (-1 to 0) are now correct.
|
18645 |
|
|
; quadrant II ranges +1 to +2.
|
18646 |
|
|
; quadrant III ranges -2 to -1.
|
18647 |
|
|
|
18648 |
|
|
DEFB $31 ;;duplicate Y, Y.
|
18649 |
|
|
DEFB $2A ;;abs Y, abs(Y). range 1 to 2
|
18650 |
|
|
DEFB $A1 ;;stk-one Y, abs(Y), 1.
|
18651 |
|
|
DEFB $03 ;;subtract Y, abs(Y)-1. range 0 to 1
|
18652 |
|
|
DEFB $31 ;;duplicate Y, Z, Z.
|
18653 |
|
|
DEFB $37 ;;greater-0 Y, Z, (1/0).
|
18654 |
|
|
|
18655 |
|
|
DEFB $C0 ;;st-mem-0 store as possible sign
|
18656 |
|
|
;; for cosine function.
|
18657 |
|
|
|
18658 |
|
|
DEFB $00 ;;jump-true
|
18659 |
|
|
DEFB $04 ;;to L37A1, ZPLUS with quadrants II and III.
|
18660 |
|
|
|
18661 |
|
|
; else the angle lies in quadrant I or IV and value Y is already correct.
|
18662 |
|
|
|
18663 |
|
|
DEFB $02 ;;delete Y. delete the test value.
|
18664 |
|
|
DEFB $38 ;;end-calc Y.
|
18665 |
|
|
|
18666 |
|
|
RET ; return. with Q1 and Q4 >>>
|
18667 |
|
|
|
18668 |
|
|
; ---
|
18669 |
|
|
|
18670 |
|
|
; the branch was here with quadrants II (0 to 1) and III (1 to 0).
|
18671 |
|
|
; Y will hold -2 to -1 if this is quadrant III.
|
18672 |
|
|
|
18673 |
|
|
;; ZPLUS
|
18674 |
|
|
L37A1: DEFB $A1 ;;stk-one Y, Z, 1.
|
18675 |
|
|
DEFB $03 ;;subtract Y, Z-1. Q3 = 0 to -1
|
18676 |
|
|
DEFB $01 ;;exchange Z-1, Y.
|
18677 |
|
|
DEFB $36 ;;less-0 Z-1, (1/0).
|
18678 |
|
|
DEFB $00 ;;jump-true Z-1.
|
18679 |
|
|
DEFB $02 ;;to L37A8, YNEG
|
18680 |
|
|
;;if angle in quadrant III
|
18681 |
|
|
|
18682 |
|
|
; else angle is within quadrant II (-1 to 0)
|
18683 |
|
|
|
18684 |
|
|
DEFB $1B ;;negate range +1 to 0.
|
18685 |
|
|
|
18686 |
|
|
;; YNEG
|
18687 |
|
|
L37A8: DEFB $38 ;;end-calc quadrants II and III correct.
|
18688 |
|
|
|
18689 |
|
|
RET ; return.
|
18690 |
|
|
|
18691 |
|
|
|
18692 |
|
|
; ---------------------
|
18693 |
|
|
; THE 'COSINE' FUNCTION
|
18694 |
|
|
; ---------------------
|
18695 |
|
|
; (offset $20: 'cos')
|
18696 |
|
|
; Cosines are calculated as the sine of the opposite angle rectifying the
|
18697 |
|
|
; sign depending on the quadrant rules.
|
18698 |
|
|
;
|
18699 |
|
|
;
|
18700 |
|
|
; /|
|
18701 |
|
|
; h /y|
|
18702 |
|
|
; / |o
|
18703 |
|
|
; /x |
|
18704 |
|
|
; /----|
|
18705 |
|
|
; a
|
18706 |
|
|
;
|
18707 |
|
|
; The cosine of angle x is the adjacent side (a) divided by the hypotenuse 1.
|
18708 |
|
|
; However if we examine angle y then a/h is the sine of that angle.
|
18709 |
|
|
; Since angle x plus angle y equals a right-angle, we can find angle y by
|
18710 |
|
|
; subtracting angle x from pi/2.
|
18711 |
|
|
; However it's just as easy to reduce the argument first and subtract the
|
18712 |
|
|
; reduced argument from the value 1 (a reduced right-angle).
|
18713 |
|
|
; It's even easier to subtract 1 from the angle and rectify the sign.
|
18714 |
|
|
; In fact, after reducing the argument, the absolute value of the argument
|
18715 |
|
|
; is used and rectified using the test result stored in mem-0 by 'get-argt'
|
18716 |
|
|
; for that purpose.
|
18717 |
|
|
;
|
18718 |
|
|
|
18719 |
|
|
;; cos
|
18720 |
|
|
L37AA: RST 28H ;; FP-CALC angle in radians.
|
18721 |
|
|
DEFB $39 ;;get-argt X reduce -1 to +1
|
18722 |
|
|
|
18723 |
|
|
DEFB $2A ;;abs ABS X. 0 to 1
|
18724 |
|
|
DEFB $A1 ;;stk-one ABS X, 1.
|
18725 |
|
|
DEFB $03 ;;subtract now opposite angle
|
18726 |
|
|
;; although sign is -ve.
|
18727 |
|
|
|
18728 |
|
|
DEFB $E0 ;;get-mem-0 fetch the sign indicator
|
18729 |
|
|
DEFB $00 ;;jump-true
|
18730 |
|
|
DEFB $06 ;;fwd to L37B7, C-ENT
|
18731 |
|
|
;;forward to common code if in QII or QIII.
|
18732 |
|
|
|
18733 |
|
|
DEFB $1B ;;negate else make sign +ve.
|
18734 |
|
|
DEFB $33 ;;jump
|
18735 |
|
|
DEFB $03 ;;fwd to L37B7, C-ENT
|
18736 |
|
|
;; with quadrants I and IV.
|
18737 |
|
|
|
18738 |
|
|
; -------------------
|
18739 |
|
|
; THE 'SINE' FUNCTION
|
18740 |
|
|
; -------------------
|
18741 |
|
|
; (offset $1F: 'sin')
|
18742 |
|
|
; This is a fundamental transcendental function from which others such as cos
|
18743 |
|
|
; and tan are directly, or indirectly, derived.
|
18744 |
|
|
; It uses the series generator to produce Chebyshev polynomials.
|
18745 |
|
|
;
|
18746 |
|
|
;
|
18747 |
|
|
; /|
|
18748 |
|
|
; 1 / |
|
18749 |
|
|
; / |x
|
18750 |
|
|
; /a |
|
18751 |
|
|
; /----|
|
18752 |
|
|
; y
|
18753 |
|
|
;
|
18754 |
|
|
; The 'get-argt' function is designed to modify the angle and its sign
|
18755 |
|
|
; in line with the desired sine value and afterwards it can launch straight
|
18756 |
|
|
; into common code.
|
18757 |
|
|
|
18758 |
|
|
;; sin
|
18759 |
|
|
L37B5: RST 28H ;; FP-CALC angle in radians
|
18760 |
|
|
DEFB $39 ;;get-argt reduce - sign now correct.
|
18761 |
|
|
|
18762 |
|
|
;; C-ENT
|
18763 |
|
|
L37B7: DEFB $31 ;;duplicate
|
18764 |
|
|
DEFB $31 ;;duplicate
|
18765 |
|
|
DEFB $04 ;;multiply
|
18766 |
|
|
DEFB $31 ;;duplicate
|
18767 |
|
|
DEFB $0F ;;addition
|
18768 |
|
|
DEFB $A1 ;;stk-one
|
18769 |
|
|
DEFB $03 ;;subtract
|
18770 |
|
|
|
18771 |
|
|
DEFB $86 ;;series-06
|
18772 |
|
|
DEFB $14 ;;Exponent: $64, Bytes: 1
|
18773 |
|
|
DEFB $E6 ;;(+00,+00,+00)
|
18774 |
|
|
DEFB $5C ;;Exponent: $6C, Bytes: 2
|
18775 |
|
|
DEFB $1F,$0B ;;(+00,+00)
|
18776 |
|
|
DEFB $A3 ;;Exponent: $73, Bytes: 3
|
18777 |
|
|
DEFB $8F,$38,$EE ;;(+00)
|
18778 |
|
|
DEFB $E9 ;;Exponent: $79, Bytes: 4
|
18779 |
|
|
DEFB $15,$63,$BB,$23 ;;
|
18780 |
|
|
DEFB $EE ;;Exponent: $7E, Bytes: 4
|
18781 |
|
|
DEFB $92,$0D,$CD,$ED ;;
|
18782 |
|
|
DEFB $F1 ;;Exponent: $81, Bytes: 4
|
18783 |
|
|
DEFB $23,$5D,$1B,$EA ;;
|
18784 |
|
|
DEFB $04 ;;multiply
|
18785 |
|
|
DEFB $38 ;;end-calc
|
18786 |
|
|
|
18787 |
|
|
RET ; return.
|
18788 |
|
|
|
18789 |
|
|
; ----------------------
|
18790 |
|
|
; THE 'TANGENT' FUNCTION
|
18791 |
|
|
; ----------------------
|
18792 |
|
|
; (offset $21: 'tan')
|
18793 |
|
|
;
|
18794 |
|
|
; Evaluates tangent x as sin(x) / cos(x).
|
18795 |
|
|
;
|
18796 |
|
|
;
|
18797 |
|
|
; /|
|
18798 |
|
|
; h / |
|
18799 |
|
|
; / |o
|
18800 |
|
|
; /x |
|
18801 |
|
|
; /----|
|
18802 |
|
|
; a
|
18803 |
|
|
;
|
18804 |
|
|
; the tangent of angle x is the ratio of the length of the opposite side
|
18805 |
|
|
; divided by the length of the adjacent side. As the opposite length can
|
18806 |
|
|
; be calculates using sin(x) and the adjacent length using cos(x) then
|
18807 |
|
|
; the tangent can be defined in terms of the previous two functions.
|
18808 |
|
|
|
18809 |
|
|
; Error 6 if the argument, in radians, is too close to one like pi/2
|
18810 |
|
|
; which has an infinite tangent. e.g. PRINT TAN (PI/2) evaluates as 1/0.
|
18811 |
|
|
; Similarly PRINT TAN (3*PI/2), TAN (5*PI/2) etc.
|
18812 |
|
|
|
18813 |
|
|
;; tan
|
18814 |
|
|
L37DA: RST 28H ;; FP-CALC x.
|
18815 |
|
|
DEFB $31 ;;duplicate x, x.
|
18816 |
|
|
DEFB $1F ;;sin x, sin x.
|
18817 |
|
|
DEFB $01 ;;exchange sin x, x.
|
18818 |
|
|
DEFB $20 ;;cos sin x, cos x.
|
18819 |
|
|
DEFB $05 ;;division sin x/cos x (= tan x).
|
18820 |
|
|
DEFB $38 ;;end-calc tan x.
|
18821 |
|
|
|
18822 |
|
|
RET ; return.
|
18823 |
|
|
|
18824 |
|
|
; ---------------------
|
18825 |
|
|
; THE 'ARCTAN' FUNCTION
|
18826 |
|
|
; ---------------------
|
18827 |
|
|
; (Offset $24: 'atn')
|
18828 |
|
|
; the inverse tangent function with the result in radians.
|
18829 |
|
|
; This is a fundamental transcendental function from which others such as asn
|
18830 |
|
|
; and acs are directly, or indirectly, derived.
|
18831 |
|
|
; It uses the series generator to produce Chebyshev polynomials.
|
18832 |
|
|
|
18833 |
|
|
;; atn
|
18834 |
|
|
L37E2: CALL L3297 ; routine re-stack
|
18835 |
|
|
LD A,(HL) ; fetch exponent byte.
|
18836 |
|
|
CP $81 ; compare to that for 'one'
|
18837 |
|
|
JR C,L37F8 ; forward, if less, to SMALL
|
18838 |
|
|
|
18839 |
|
|
RST 28H ;; FP-CALC
|
18840 |
|
|
DEFB $A1 ;;stk-one
|
18841 |
|
|
DEFB $1B ;;negate
|
18842 |
|
|
DEFB $01 ;;exchange
|
18843 |
|
|
DEFB $05 ;;division
|
18844 |
|
|
DEFB $31 ;;duplicate
|
18845 |
|
|
DEFB $36 ;;less-0
|
18846 |
|
|
DEFB $A3 ;;stk-pi/2
|
18847 |
|
|
DEFB $01 ;;exchange
|
18848 |
|
|
DEFB $00 ;;jump-true
|
18849 |
|
|
DEFB $06 ;;to L37FA, CASES
|
18850 |
|
|
|
18851 |
|
|
DEFB $1B ;;negate
|
18852 |
|
|
DEFB $33 ;;jump
|
18853 |
|
|
DEFB $03 ;;to L37FA, CASES
|
18854 |
|
|
|
18855 |
|
|
;; SMALL
|
18856 |
|
|
L37F8: RST 28H ;; FP-CALC
|
18857 |
|
|
DEFB $A0 ;;stk-zero
|
18858 |
|
|
|
18859 |
|
|
;; CASES
|
18860 |
|
|
L37FA: DEFB $01 ;;exchange
|
18861 |
|
|
DEFB $31 ;;duplicate
|
18862 |
|
|
DEFB $31 ;;duplicate
|
18863 |
|
|
DEFB $04 ;;multiply
|
18864 |
|
|
DEFB $31 ;;duplicate
|
18865 |
|
|
DEFB $0F ;;addition
|
18866 |
|
|
DEFB $A1 ;;stk-one
|
18867 |
|
|
DEFB $03 ;;subtract
|
18868 |
|
|
DEFB $8C ;;series-0C
|
18869 |
|
|
DEFB $10 ;;Exponent: $60, Bytes: 1
|
18870 |
|
|
DEFB $B2 ;;(+00,+00,+00)
|
18871 |
|
|
DEFB $13 ;;Exponent: $63, Bytes: 1
|
18872 |
|
|
DEFB $0E ;;(+00,+00,+00)
|
18873 |
|
|
DEFB $55 ;;Exponent: $65, Bytes: 2
|
18874 |
|
|
DEFB $E4,$8D ;;(+00,+00)
|
18875 |
|
|
DEFB $58 ;;Exponent: $68, Bytes: 2
|
18876 |
|
|
DEFB $39,$BC ;;(+00,+00)
|
18877 |
|
|
DEFB $5B ;;Exponent: $6B, Bytes: 2
|
18878 |
|
|
DEFB $98,$FD ;;(+00,+00)
|
18879 |
|
|
DEFB $9E ;;Exponent: $6E, Bytes: 3
|
18880 |
|
|
DEFB $00,$36,$75 ;;(+00)
|
18881 |
|
|
DEFB $A0 ;;Exponent: $70, Bytes: 3
|
18882 |
|
|
DEFB $DB,$E8,$B4 ;;(+00)
|
18883 |
|
|
DEFB $63 ;;Exponent: $73, Bytes: 2
|
18884 |
|
|
DEFB $42,$C4 ;;(+00,+00)
|
18885 |
|
|
DEFB $E6 ;;Exponent: $76, Bytes: 4
|
18886 |
|
|
DEFB $B5,$09,$36,$BE ;;
|
18887 |
|
|
DEFB $E9 ;;Exponent: $79, Bytes: 4
|
18888 |
|
|
DEFB $36,$73,$1B,$5D ;;
|
18889 |
|
|
DEFB $EC ;;Exponent: $7C, Bytes: 4
|
18890 |
|
|
DEFB $D8,$DE,$63,$BE ;;
|
18891 |
|
|
DEFB $F0 ;;Exponent: $80, Bytes: 4
|
18892 |
|
|
DEFB $61,$A1,$B3,$0C ;;
|
18893 |
|
|
DEFB $04 ;;multiply
|
18894 |
|
|
DEFB $0F ;;addition
|
18895 |
|
|
DEFB $38 ;;end-calc
|
18896 |
|
|
|
18897 |
|
|
RET ; return.
|
18898 |
|
|
|
18899 |
|
|
|
18900 |
|
|
; ---------------------
|
18901 |
|
|
; THE 'ARCSIN' FUNCTION
|
18902 |
|
|
; ---------------------
|
18903 |
|
|
; (Offset $22: 'asn')
|
18904 |
|
|
; The inverse sine function with result in radians.
|
18905 |
|
|
; Derived from arctan function above.
|
18906 |
|
|
; Error A unless the argument is between -1 and +1 inclusive.
|
18907 |
|
|
; Uses an adaptation of the formula asn(x) = atn(x/sqr(1-x*x))
|
18908 |
|
|
;
|
18909 |
|
|
;
|
18910 |
|
|
; /|
|
18911 |
|
|
; / |
|
18912 |
|
|
; 1/ |x
|
18913 |
|
|
; /a |
|
18914 |
|
|
; /----|
|
18915 |
|
|
; y
|
18916 |
|
|
;
|
18917 |
|
|
; e.g. We know the opposite side (x) and hypotenuse (1)
|
18918 |
|
|
; and we wish to find angle a in radians.
|
18919 |
|
|
; We can derive length y by Pythagoras and then use ATN instead.
|
18920 |
|
|
; Since y*y + x*x = 1*1 (Pythagoras Theorem) then
|
18921 |
|
|
; y=sqr(1-x*x) - no need to multiply 1 by itself.
|
18922 |
|
|
; So, asn(a) = atn(x/y)
|
18923 |
|
|
; or more fully,
|
18924 |
|
|
; asn(a) = atn(x/sqr(1-x*x))
|
18925 |
|
|
|
18926 |
|
|
; Close but no cigar.
|
18927 |
|
|
|
18928 |
|
|
; While PRINT ATN (x/SQR (1-x*x)) gives the same results as PRINT ASN x,
|
18929 |
|
|
; it leads to division by zero when x is 1 or -1.
|
18930 |
|
|
; To overcome this, 1 is added to y giving half the required angle and the
|
18931 |
|
|
; result is then doubled.
|
18932 |
|
|
; That is, PRINT ATN (x/(SQR (1-x*x) +1)) *2
|
18933 |
|
|
;
|
18934 |
|
|
; GEOMETRIC PROOF.
|
18935 |
|
|
;
|
18936 |
|
|
;
|
18937 |
|
|
; . /|
|
18938 |
|
|
; . c/ |
|
18939 |
|
|
; . /1 |x
|
18940 |
|
|
; . c b /a |
|
18941 |
|
|
; ---------/----|
|
18942 |
|
|
; 1 y
|
18943 |
|
|
;
|
18944 |
|
|
; By creating an isosceles triangle with two equal sides of 1, angles c and
|
18945 |
|
|
; c are also equal. If b+c+c = 180 degrees and b+a = 180 degrees then c=a/2.
|
18946 |
|
|
;
|
18947 |
|
|
; A value higher than 1 gives the required error as attempting to find the
|
18948 |
|
|
; square root of a negative number generates an error in Sinclair BASIC.
|
18949 |
|
|
|
18950 |
|
|
;; asn
|
18951 |
|
|
L3833: RST 28H ;; FP-CALC x.
|
18952 |
|
|
DEFB $31 ;;duplicate x, x.
|
18953 |
|
|
DEFB $31 ;;duplicate x, x, x.
|
18954 |
|
|
DEFB $04 ;;multiply x, x*x.
|
18955 |
|
|
DEFB $A1 ;;stk-one x, x*x, 1.
|
18956 |
|
|
DEFB $03 ;;subtract x, x*x-1.
|
18957 |
|
|
DEFB $1B ;;negate x, 1-x*x.
|
18958 |
|
|
DEFB $28 ;;sqr x, sqr(1-x*x) = y
|
18959 |
|
|
DEFB $A1 ;;stk-one x, y, 1.
|
18960 |
|
|
DEFB $0F ;;addition x, y+1.
|
18961 |
|
|
DEFB $05 ;;division x/y+1.
|
18962 |
|
|
DEFB $24 ;;atn a/2 (half the angle)
|
18963 |
|
|
DEFB $31 ;;duplicate a/2, a/2.
|
18964 |
|
|
DEFB $0F ;;addition a.
|
18965 |
|
|
DEFB $38 ;;end-calc a.
|
18966 |
|
|
|
18967 |
|
|
RET ; return.
|
18968 |
|
|
|
18969 |
|
|
|
18970 |
|
|
; ---------------------
|
18971 |
|
|
; THE 'ARCCOS' FUNCTION
|
18972 |
|
|
; ---------------------
|
18973 |
|
|
; (Offset $23: 'acs')
|
18974 |
|
|
; the inverse cosine function with the result in radians.
|
18975 |
|
|
; Error A unless the argument is between -1 and +1.
|
18976 |
|
|
; Result in range 0 to pi.
|
18977 |
|
|
; Derived from asn above which is in turn derived from the preceding atn.
|
18978 |
|
|
; It could have been derived directly from atn using acs(x) = atn(sqr(1-x*x)/x).
|
18979 |
|
|
; However, as sine and cosine are horizontal translations of each other,
|
18980 |
|
|
; uses acs(x) = pi/2 - asn(x)
|
18981 |
|
|
|
18982 |
|
|
; e.g. the arccosine of a known x value will give the required angle b in
|
18983 |
|
|
; radians.
|
18984 |
|
|
; We know, from above, how to calculate the angle a using asn(x).
|
18985 |
|
|
; Since the three angles of any triangle add up to 180 degrees, or pi radians,
|
18986 |
|
|
; and the largest angle in this case is a right-angle (pi/2 radians), then
|
18987 |
|
|
; we can calculate angle b as pi/2 (both angles) minus asn(x) (angle a).
|
18988 |
|
|
;
|
18989 |
|
|
;
|
18990 |
|
|
; /|
|
18991 |
|
|
; 1 /b|
|
18992 |
|
|
; / |x
|
18993 |
|
|
; /a |
|
18994 |
|
|
; /----|
|
18995 |
|
|
; y
|
18996 |
|
|
;
|
18997 |
|
|
|
18998 |
|
|
;; acs
|
18999 |
|
|
L3843: RST 28H ;; FP-CALC x.
|
19000 |
|
|
DEFB $22 ;;asn asn(x).
|
19001 |
|
|
DEFB $A3 ;;stk-pi/2 asn(x), pi/2.
|
19002 |
|
|
DEFB $03 ;;subtract asn(x) - pi/2.
|
19003 |
|
|
DEFB $1B ;;negate pi/2 -asn(x) = acs(x).
|
19004 |
|
|
DEFB $38 ;;end-calc acs(x).
|
19005 |
|
|
|
19006 |
|
|
RET ; return.
|
19007 |
|
|
|
19008 |
|
|
|
19009 |
|
|
; --------------------------
|
19010 |
|
|
; THE 'SQUARE ROOT' FUNCTION
|
19011 |
|
|
; --------------------------
|
19012 |
|
|
; (Offset $28: 'sqr')
|
19013 |
|
|
; This routine is remarkable for its brevity - 7 bytes.
|
19014 |
|
|
; It wasn't written here but in the ZX81 where the programmers had to squeeze
|
19015 |
|
|
; a bulky operating system into an 8K ROM. It simply calculates
|
19016 |
|
|
; the square root by stacking the value .5 and continuing into the 'to-power'
|
19017 |
|
|
; routine. With more space available the much faster Newton-Raphson method
|
19018 |
|
|
; could have been used as on the Jupiter Ace.
|
19019 |
|
|
|
19020 |
|
|
;; sqr
|
19021 |
|
|
L384A: RST 28H ;; FP-CALC
|
19022 |
|
|
DEFB $31 ;;duplicate
|
19023 |
|
|
DEFB $30 ;;not
|
19024 |
|
|
DEFB $00 ;;jump-true
|
19025 |
|
|
DEFB $1E ;;to L386C, LAST
|
19026 |
|
|
|
19027 |
|
|
DEFB $A2 ;;stk-half
|
19028 |
|
|
DEFB $38 ;;end-calc
|
19029 |
|
|
|
19030 |
|
|
|
19031 |
|
|
; ------------------------------
|
19032 |
|
|
; THE 'EXPONENTIATION' OPERATION
|
19033 |
|
|
; ------------------------------
|
19034 |
|
|
; (Offset $06: 'to-power')
|
19035 |
|
|
; This raises the first number X to the power of the second number Y.
|
19036 |
|
|
; As with the ZX80,
|
19037 |
|
|
; 0 ^ 0 = 1.
|
19038 |
|
|
; 0 ^ +n = 0.
|
19039 |
|
|
; 0 ^ -n = arithmetic overflow.
|
19040 |
|
|
;
|
19041 |
|
|
|
19042 |
|
|
;; to-power
|
19043 |
|
|
L3851: RST 28H ;; FP-CALC X, Y.
|
19044 |
|
|
DEFB $01 ;;exchange Y, X.
|
19045 |
|
|
DEFB $31 ;;duplicate Y, X, X.
|
19046 |
|
|
DEFB $30 ;;not Y, X, (1/0).
|
19047 |
|
|
DEFB $00 ;;jump-true
|
19048 |
|
|
DEFB $07 ;;to L385D, XIS0 if X is zero.
|
19049 |
|
|
|
19050 |
|
|
; else X is non-zero. Function 'ln' will catch a negative value of X.
|
19051 |
|
|
|
19052 |
|
|
DEFB $25 ;;ln Y, LN X.
|
19053 |
|
|
DEFB $04 ;;multiply Y * LN X.
|
19054 |
|
|
DEFB $38 ;;end-calc
|
19055 |
|
|
|
19056 |
|
|
JP L36C4 ; jump back to EXP routine ->
|
19057 |
|
|
|
19058 |
|
|
; ---
|
19059 |
|
|
|
19060 |
|
|
; these routines form the three simple results when the number is zero.
|
19061 |
|
|
; begin by deleting the known zero to leave Y the power factor.
|
19062 |
|
|
|
19063 |
|
|
;; XIS0
|
19064 |
|
|
L385D: DEFB $02 ;;delete Y.
|
19065 |
|
|
DEFB $31 ;;duplicate Y, Y.
|
19066 |
|
|
DEFB $30 ;;not Y, (1/0).
|
19067 |
|
|
DEFB $00 ;;jump-true
|
19068 |
|
|
DEFB $09 ;;to L386A, ONE if Y is zero.
|
19069 |
|
|
|
19070 |
|
|
DEFB $A0 ;;stk-zero Y, 0.
|
19071 |
|
|
DEFB $01 ;;exchange 0, Y.
|
19072 |
|
|
DEFB $37 ;;greater-0 0, (1/0).
|
19073 |
|
|
DEFB $00 ;;jump-true 0.
|
19074 |
|
|
DEFB $06 ;;to L386C, LAST if Y was any positive
|
19075 |
|
|
;; number.
|
19076 |
|
|
|
19077 |
|
|
; else force division by zero thereby raising an Arithmetic overflow error.
|
19078 |
|
|
; There are some one and two-byte alternatives but perhaps the most formal
|
19079 |
|
|
; might have been to use end-calc; rst 08; defb 05.
|
19080 |
|
|
|
19081 |
|
|
DEFB $A1 ;;stk-one 0, 1.
|
19082 |
|
|
DEFB $01 ;;exchange 1, 0.
|
19083 |
|
|
DEFB $05 ;;division 1/0 ouch!
|
19084 |
|
|
|
19085 |
|
|
; ---
|
19086 |
|
|
|
19087 |
|
|
;; ONE
|
19088 |
|
|
L386A: DEFB $02 ;;delete .
|
19089 |
|
|
DEFB $A1 ;;stk-one 1.
|
19090 |
|
|
|
19091 |
|
|
;; LAST
|
19092 |
|
|
L386C: DEFB $38 ;;end-calc last value is 1 or 0.
|
19093 |
|
|
|
19094 |
|
|
RET ; return.
|
19095 |
|
|
|
19096 |
|
|
; "Everything should be made as simple as possible, but not simpler"
|
19097 |
|
|
; - Albert Einstein, 1879-1955.
|
19098 |
|
|
|
19099 |
|
|
; ---------------------
|
19100 |
|
|
; THE 'SPARE' LOCATIONS
|
19101 |
|
|
; ---------------------
|
19102 |
|
|
|
19103 |
|
|
;; spare
|
19104 |
|
|
L386E: DEFB $FF, $FF ;
|
19105 |
|
|
|
19106 |
|
|
|
19107 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19108 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19109 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19110 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19111 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19112 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19113 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19114 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19115 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19116 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19117 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19118 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19119 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19120 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19121 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19122 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19123 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19124 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19125 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19126 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19127 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19128 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19129 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19130 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19131 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19132 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19133 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19134 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19135 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19136 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19137 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19138 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19139 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19140 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19141 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19142 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19143 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19144 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19145 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19146 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19147 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19148 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19149 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19150 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19151 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19152 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19153 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19154 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19155 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19156 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19157 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19158 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19159 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19160 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19161 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19162 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19163 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19164 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19165 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19166 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19167 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19168 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19169 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19170 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19171 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19172 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19173 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19174 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19175 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19176 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19177 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19178 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19179 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19180 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19181 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19182 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19183 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19184 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19185 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19186 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19187 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19188 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19189 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19190 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19191 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19192 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19193 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19194 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19195 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19196 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19197 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19198 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19199 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19200 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19201 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19202 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19203 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19204 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19205 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19206 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19207 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19208 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19209 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19210 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19211 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19212 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19213 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19214 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19215 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19216 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19217 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19218 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19219 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19220 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19221 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19222 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19223 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19224 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19225 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19226 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19227 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19228 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19229 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19230 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19231 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19232 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19233 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19234 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19235 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19236 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19237 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19238 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19239 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19240 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19241 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19242 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19243 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19244 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19245 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19246 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19247 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19248 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19249 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19250 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19251 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19252 |
|
|
DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF;
|
19253 |
|
|
|
19254 |
|
|
ORG $3D00
|
19255 |
|
|
|
19256 |
|
|
; -------------------------------
|
19257 |
|
|
; THE 'ZX SPECTRUM CHARACTER SET'
|
19258 |
|
|
; -------------------------------
|
19259 |
|
|
|
19260 |
|
|
;; char-set
|
19261 |
|
|
|
19262 |
|
|
; $20 - Character: ' ' CHR$(32)
|
19263 |
|
|
|
19264 |
|
|
L3D00: DEFB %00000000
|
19265 |
|
|
DEFB %00000000
|
19266 |
|
|
DEFB %00000000
|
19267 |
|
|
DEFB %00000000
|
19268 |
|
|
DEFB %00000000
|
19269 |
|
|
DEFB %00000000
|
19270 |
|
|
DEFB %00000000
|
19271 |
|
|
DEFB %00000000
|
19272 |
|
|
|
19273 |
|
|
; $21 - Character: '!' CHR$(33)
|
19274 |
|
|
|
19275 |
|
|
DEFB %00000000
|
19276 |
|
|
DEFB %00010000
|
19277 |
|
|
DEFB %00010000
|
19278 |
|
|
DEFB %00010000
|
19279 |
|
|
DEFB %00010000
|
19280 |
|
|
DEFB %00000000
|
19281 |
|
|
DEFB %00010000
|
19282 |
|
|
DEFB %00000000
|
19283 |
|
|
|
19284 |
|
|
; $22 - Character: '"' CHR$(34)
|
19285 |
|
|
|
19286 |
|
|
DEFB %00000000
|
19287 |
|
|
DEFB %00100100
|
19288 |
|
|
DEFB %00100100
|
19289 |
|
|
DEFB %00000000
|
19290 |
|
|
DEFB %00000000
|
19291 |
|
|
DEFB %00000000
|
19292 |
|
|
DEFB %00000000
|
19293 |
|
|
DEFB %00000000
|
19294 |
|
|
|
19295 |
|
|
; $23 - Character: '#' CHR$(35)
|
19296 |
|
|
|
19297 |
|
|
DEFB %00000000
|
19298 |
|
|
DEFB %00100100
|
19299 |
|
|
DEFB %01111110
|
19300 |
|
|
DEFB %00100100
|
19301 |
|
|
DEFB %00100100
|
19302 |
|
|
DEFB %01111110
|
19303 |
|
|
DEFB %00100100
|
19304 |
|
|
DEFB %00000000
|
19305 |
|
|
|
19306 |
|
|
; $24 - Character: '$' CHR$(36)
|
19307 |
|
|
|
19308 |
|
|
DEFB %00000000
|
19309 |
|
|
DEFB %00001000
|
19310 |
|
|
DEFB %00111110
|
19311 |
|
|
DEFB %00101000
|
19312 |
|
|
DEFB %00111110
|
19313 |
|
|
DEFB %00001010
|
19314 |
|
|
DEFB %00111110
|
19315 |
|
|
DEFB %00001000
|
19316 |
|
|
|
19317 |
|
|
; $25 - Character: '%' CHR$(37)
|
19318 |
|
|
|
19319 |
|
|
DEFB %00000000
|
19320 |
|
|
DEFB %01100010
|
19321 |
|
|
DEFB %01100100
|
19322 |
|
|
DEFB %00001000
|
19323 |
|
|
DEFB %00010000
|
19324 |
|
|
DEFB %00100110
|
19325 |
|
|
DEFB %01000110
|
19326 |
|
|
DEFB %00000000
|
19327 |
|
|
|
19328 |
|
|
; $26 - Character: '&' CHR$(38)
|
19329 |
|
|
|
19330 |
|
|
DEFB %00000000
|
19331 |
|
|
DEFB %00010000
|
19332 |
|
|
DEFB %00101000
|
19333 |
|
|
DEFB %00010000
|
19334 |
|
|
DEFB %00101010
|
19335 |
|
|
DEFB %01000100
|
19336 |
|
|
DEFB %00111010
|
19337 |
|
|
DEFB %00000000
|
19338 |
|
|
|
19339 |
|
|
; $27 - Character: ''' CHR$(39)
|
19340 |
|
|
|
19341 |
|
|
DEFB %00000000
|
19342 |
|
|
DEFB %00001000
|
19343 |
|
|
DEFB %00010000
|
19344 |
|
|
DEFB %00000000
|
19345 |
|
|
DEFB %00000000
|
19346 |
|
|
DEFB %00000000
|
19347 |
|
|
DEFB %00000000
|
19348 |
|
|
DEFB %00000000
|
19349 |
|
|
|
19350 |
|
|
; $28 - Character: '(' CHR$(40)
|
19351 |
|
|
|
19352 |
|
|
DEFB %00000000
|
19353 |
|
|
DEFB %00000100
|
19354 |
|
|
DEFB %00001000
|
19355 |
|
|
DEFB %00001000
|
19356 |
|
|
DEFB %00001000
|
19357 |
|
|
DEFB %00001000
|
19358 |
|
|
DEFB %00000100
|
19359 |
|
|
DEFB %00000000
|
19360 |
|
|
|
19361 |
|
|
; $29 - Character: ')' CHR$(41)
|
19362 |
|
|
|
19363 |
|
|
DEFB %00000000
|
19364 |
|
|
DEFB %00100000
|
19365 |
|
|
DEFB %00010000
|
19366 |
|
|
DEFB %00010000
|
19367 |
|
|
DEFB %00010000
|
19368 |
|
|
DEFB %00010000
|
19369 |
|
|
DEFB %00100000
|
19370 |
|
|
DEFB %00000000
|
19371 |
|
|
|
19372 |
|
|
; $2A - Character: '*' CHR$(42)
|
19373 |
|
|
|
19374 |
|
|
DEFB %00000000
|
19375 |
|
|
DEFB %00000000
|
19376 |
|
|
DEFB %00010100
|
19377 |
|
|
DEFB %00001000
|
19378 |
|
|
DEFB %00111110
|
19379 |
|
|
DEFB %00001000
|
19380 |
|
|
DEFB %00010100
|
19381 |
|
|
DEFB %00000000
|
19382 |
|
|
|
19383 |
|
|
; $2B - Character: '+' CHR$(43)
|
19384 |
|
|
|
19385 |
|
|
DEFB %00000000
|
19386 |
|
|
DEFB %00000000
|
19387 |
|
|
DEFB %00001000
|
19388 |
|
|
DEFB %00001000
|
19389 |
|
|
DEFB %00111110
|
19390 |
|
|
DEFB %00001000
|
19391 |
|
|
DEFB %00001000
|
19392 |
|
|
DEFB %00000000
|
19393 |
|
|
|
19394 |
|
|
; $2C - Character: ',' CHR$(44)
|
19395 |
|
|
|
19396 |
|
|
DEFB %00000000
|
19397 |
|
|
DEFB %00000000
|
19398 |
|
|
DEFB %00000000
|
19399 |
|
|
DEFB %00000000
|
19400 |
|
|
DEFB %00000000
|
19401 |
|
|
DEFB %00001000
|
19402 |
|
|
DEFB %00001000
|
19403 |
|
|
DEFB %00010000
|
19404 |
|
|
|
19405 |
|
|
; $2D - Character: '-' CHR$(45)
|
19406 |
|
|
|
19407 |
|
|
DEFB %00000000
|
19408 |
|
|
DEFB %00000000
|
19409 |
|
|
DEFB %00000000
|
19410 |
|
|
DEFB %00000000
|
19411 |
|
|
DEFB %00111110
|
19412 |
|
|
DEFB %00000000
|
19413 |
|
|
DEFB %00000000
|
19414 |
|
|
DEFB %00000000
|
19415 |
|
|
|
19416 |
|
|
; $2E - Character: '.' CHR$(46)
|
19417 |
|
|
|
19418 |
|
|
DEFB %00000000
|
19419 |
|
|
DEFB %00000000
|
19420 |
|
|
DEFB %00000000
|
19421 |
|
|
DEFB %00000000
|
19422 |
|
|
DEFB %00000000
|
19423 |
|
|
DEFB %00011000
|
19424 |
|
|
DEFB %00011000
|
19425 |
|
|
DEFB %00000000
|
19426 |
|
|
|
19427 |
|
|
; $2F - Character: '/' CHR$(47)
|
19428 |
|
|
|
19429 |
|
|
DEFB %00000000
|
19430 |
|
|
DEFB %00000000
|
19431 |
|
|
DEFB %00000010
|
19432 |
|
|
DEFB %00000100
|
19433 |
|
|
DEFB %00001000
|
19434 |
|
|
DEFB %00010000
|
19435 |
|
|
DEFB %00100000
|
19436 |
|
|
DEFB %00000000
|
19437 |
|
|
|
19438 |
|
|
; $30 - Character: '0' CHR$(48)
|
19439 |
|
|
|
19440 |
|
|
DEFB %00000000
|
19441 |
|
|
DEFB %00111100
|
19442 |
|
|
DEFB %01000110
|
19443 |
|
|
DEFB %01001010
|
19444 |
|
|
DEFB %01010010
|
19445 |
|
|
DEFB %01100010
|
19446 |
|
|
DEFB %00111100
|
19447 |
|
|
DEFB %00000000
|
19448 |
|
|
|
19449 |
|
|
; $31 - Character: '1' CHR$(49)
|
19450 |
|
|
|
19451 |
|
|
DEFB %00000000
|
19452 |
|
|
DEFB %00011000
|
19453 |
|
|
DEFB %00101000
|
19454 |
|
|
DEFB %00001000
|
19455 |
|
|
DEFB %00001000
|
19456 |
|
|
DEFB %00001000
|
19457 |
|
|
DEFB %00111110
|
19458 |
|
|
DEFB %00000000
|
19459 |
|
|
|
19460 |
|
|
; $32 - Character: '2' CHR$(50)
|
19461 |
|
|
|
19462 |
|
|
DEFB %00000000
|
19463 |
|
|
DEFB %00111100
|
19464 |
|
|
DEFB %01000010
|
19465 |
|
|
DEFB %00000010
|
19466 |
|
|
DEFB %00111100
|
19467 |
|
|
DEFB %01000000
|
19468 |
|
|
DEFB %01111110
|
19469 |
|
|
DEFB %00000000
|
19470 |
|
|
|
19471 |
|
|
; $33 - Character: '3' CHR$(51)
|
19472 |
|
|
|
19473 |
|
|
DEFB %00000000
|
19474 |
|
|
DEFB %00111100
|
19475 |
|
|
DEFB %01000010
|
19476 |
|
|
DEFB %00001100
|
19477 |
|
|
DEFB %00000010
|
19478 |
|
|
DEFB %01000010
|
19479 |
|
|
DEFB %00111100
|
19480 |
|
|
DEFB %00000000
|
19481 |
|
|
|
19482 |
|
|
; $34 - Character: '4' CHR$(52)
|
19483 |
|
|
|
19484 |
|
|
DEFB %00000000
|
19485 |
|
|
DEFB %00001000
|
19486 |
|
|
DEFB %00011000
|
19487 |
|
|
DEFB %00101000
|
19488 |
|
|
DEFB %01001000
|
19489 |
|
|
DEFB %01111110
|
19490 |
|
|
DEFB %00001000
|
19491 |
|
|
DEFB %00000000
|
19492 |
|
|
|
19493 |
|
|
; $35 - Character: '5' CHR$(53)
|
19494 |
|
|
|
19495 |
|
|
DEFB %00000000
|
19496 |
|
|
DEFB %01111110
|
19497 |
|
|
DEFB %01000000
|
19498 |
|
|
DEFB %01111100
|
19499 |
|
|
DEFB %00000010
|
19500 |
|
|
DEFB %01000010
|
19501 |
|
|
DEFB %00111100
|
19502 |
|
|
DEFB %00000000
|
19503 |
|
|
|
19504 |
|
|
; $36 - Character: '6' CHR$(54)
|
19505 |
|
|
|
19506 |
|
|
DEFB %00000000
|
19507 |
|
|
DEFB %00111100
|
19508 |
|
|
DEFB %01000000
|
19509 |
|
|
DEFB %01111100
|
19510 |
|
|
DEFB %01000010
|
19511 |
|
|
DEFB %01000010
|
19512 |
|
|
DEFB %00111100
|
19513 |
|
|
DEFB %00000000
|
19514 |
|
|
|
19515 |
|
|
; $37 - Character: '7' CHR$(55)
|
19516 |
|
|
|
19517 |
|
|
DEFB %00000000
|
19518 |
|
|
DEFB %01111110
|
19519 |
|
|
DEFB %00000010
|
19520 |
|
|
DEFB %00000100
|
19521 |
|
|
DEFB %00001000
|
19522 |
|
|
DEFB %00010000
|
19523 |
|
|
DEFB %00010000
|
19524 |
|
|
DEFB %00000000
|
19525 |
|
|
|
19526 |
|
|
; $38 - Character: '8' CHR$(56)
|
19527 |
|
|
|
19528 |
|
|
DEFB %00000000
|
19529 |
|
|
DEFB %00111100
|
19530 |
|
|
DEFB %01000010
|
19531 |
|
|
DEFB %00111100
|
19532 |
|
|
DEFB %01000010
|
19533 |
|
|
DEFB %01000010
|
19534 |
|
|
DEFB %00111100
|
19535 |
|
|
DEFB %00000000
|
19536 |
|
|
|
19537 |
|
|
; $39 - Character: '9' CHR$(57)
|
19538 |
|
|
|
19539 |
|
|
DEFB %00000000
|
19540 |
|
|
DEFB %00111100
|
19541 |
|
|
DEFB %01000010
|
19542 |
|
|
DEFB %01000010
|
19543 |
|
|
DEFB %00111110
|
19544 |
|
|
DEFB %00000010
|
19545 |
|
|
DEFB %00111100
|
19546 |
|
|
DEFB %00000000
|
19547 |
|
|
|
19548 |
|
|
; $3A - Character: ':' CHR$(58)
|
19549 |
|
|
|
19550 |
|
|
DEFB %00000000
|
19551 |
|
|
DEFB %00000000
|
19552 |
|
|
DEFB %00000000
|
19553 |
|
|
DEFB %00010000
|
19554 |
|
|
DEFB %00000000
|
19555 |
|
|
DEFB %00000000
|
19556 |
|
|
DEFB %00010000
|
19557 |
|
|
DEFB %00000000
|
19558 |
|
|
|
19559 |
|
|
; $3B - Character: ';' CHR$(59)
|
19560 |
|
|
|
19561 |
|
|
DEFB %00000000
|
19562 |
|
|
DEFB %00000000
|
19563 |
|
|
DEFB %00010000
|
19564 |
|
|
DEFB %00000000
|
19565 |
|
|
DEFB %00000000
|
19566 |
|
|
DEFB %00010000
|
19567 |
|
|
DEFB %00010000
|
19568 |
|
|
DEFB %00100000
|
19569 |
|
|
|
19570 |
|
|
; $3C - Character: '<' CHR$(60)
|
19571 |
|
|
|
19572 |
|
|
DEFB %00000000
|
19573 |
|
|
DEFB %00000000
|
19574 |
|
|
DEFB %00000100
|
19575 |
|
|
DEFB %00001000
|
19576 |
|
|
DEFB %00010000
|
19577 |
|
|
DEFB %00001000
|
19578 |
|
|
DEFB %00000100
|
19579 |
|
|
DEFB %00000000
|
19580 |
|
|
|
19581 |
|
|
; $3D - Character: '=' CHR$(61)
|
19582 |
|
|
|
19583 |
|
|
DEFB %00000000
|
19584 |
|
|
DEFB %00000000
|
19585 |
|
|
DEFB %00000000
|
19586 |
|
|
DEFB %00111110
|
19587 |
|
|
DEFB %00000000
|
19588 |
|
|
DEFB %00111110
|
19589 |
|
|
DEFB %00000000
|
19590 |
|
|
DEFB %00000000
|
19591 |
|
|
|
19592 |
|
|
; $3E - Character: '>' CHR$(62)
|
19593 |
|
|
|
19594 |
|
|
DEFB %00000000
|
19595 |
|
|
DEFB %00000000
|
19596 |
|
|
DEFB %00010000
|
19597 |
|
|
DEFB %00001000
|
19598 |
|
|
DEFB %00000100
|
19599 |
|
|
DEFB %00001000
|
19600 |
|
|
DEFB %00010000
|
19601 |
|
|
DEFB %00000000
|
19602 |
|
|
|
19603 |
|
|
; $3F - Character: '?' CHR$(63)
|
19604 |
|
|
|
19605 |
|
|
DEFB %00000000
|
19606 |
|
|
DEFB %00111100
|
19607 |
|
|
DEFB %01000010
|
19608 |
|
|
DEFB %00000100
|
19609 |
|
|
DEFB %00001000
|
19610 |
|
|
DEFB %00000000
|
19611 |
|
|
DEFB %00001000
|
19612 |
|
|
DEFB %00000000
|
19613 |
|
|
|
19614 |
|
|
; $40 - Character: '@' CHR$(64)
|
19615 |
|
|
|
19616 |
|
|
DEFB %00000000
|
19617 |
|
|
DEFB %00111100
|
19618 |
|
|
DEFB %01001010
|
19619 |
|
|
DEFB %01010110
|
19620 |
|
|
DEFB %01011110
|
19621 |
|
|
DEFB %01000000
|
19622 |
|
|
DEFB %00111100
|
19623 |
|
|
DEFB %00000000
|
19624 |
|
|
|
19625 |
|
|
; $41 - Character: 'A' CHR$(65)
|
19626 |
|
|
|
19627 |
|
|
DEFB %00000000
|
19628 |
|
|
DEFB %00111100
|
19629 |
|
|
DEFB %01000010
|
19630 |
|
|
DEFB %01000010
|
19631 |
|
|
DEFB %01111110
|
19632 |
|
|
DEFB %01000010
|
19633 |
|
|
DEFB %01000010
|
19634 |
|
|
DEFB %00000000
|
19635 |
|
|
|
19636 |
|
|
; $42 - Character: 'B' CHR$(66)
|
19637 |
|
|
|
19638 |
|
|
DEFB %00000000
|
19639 |
|
|
DEFB %01111100
|
19640 |
|
|
DEFB %01000010
|
19641 |
|
|
DEFB %01111100
|
19642 |
|
|
DEFB %01000010
|
19643 |
|
|
DEFB %01000010
|
19644 |
|
|
DEFB %01111100
|
19645 |
|
|
DEFB %00000000
|
19646 |
|
|
|
19647 |
|
|
; $43 - Character: 'C' CHR$(67)
|
19648 |
|
|
|
19649 |
|
|
DEFB %00000000
|
19650 |
|
|
DEFB %00111100
|
19651 |
|
|
DEFB %01000010
|
19652 |
|
|
DEFB %01000000
|
19653 |
|
|
DEFB %01000000
|
19654 |
|
|
DEFB %01000010
|
19655 |
|
|
DEFB %00111100
|
19656 |
|
|
DEFB %00000000
|
19657 |
|
|
|
19658 |
|
|
; $44 - Character: 'D' CHR$(68)
|
19659 |
|
|
|
19660 |
|
|
DEFB %00000000
|
19661 |
|
|
DEFB %01111000
|
19662 |
|
|
DEFB %01000100
|
19663 |
|
|
DEFB %01000010
|
19664 |
|
|
DEFB %01000010
|
19665 |
|
|
DEFB %01000100
|
19666 |
|
|
DEFB %01111000
|
19667 |
|
|
DEFB %00000000
|
19668 |
|
|
|
19669 |
|
|
; $45 - Character: 'E' CHR$(69)
|
19670 |
|
|
|
19671 |
|
|
DEFB %00000000
|
19672 |
|
|
DEFB %01111110
|
19673 |
|
|
DEFB %01000000
|
19674 |
|
|
DEFB %01111100
|
19675 |
|
|
DEFB %01000000
|
19676 |
|
|
DEFB %01000000
|
19677 |
|
|
DEFB %01111110
|
19678 |
|
|
DEFB %00000000
|
19679 |
|
|
|
19680 |
|
|
; $46 - Character: 'F' CHR$(70)
|
19681 |
|
|
|
19682 |
|
|
DEFB %00000000
|
19683 |
|
|
DEFB %01111110
|
19684 |
|
|
DEFB %01000000
|
19685 |
|
|
DEFB %01111100
|
19686 |
|
|
DEFB %01000000
|
19687 |
|
|
DEFB %01000000
|
19688 |
|
|
DEFB %01000000
|
19689 |
|
|
DEFB %00000000
|
19690 |
|
|
|
19691 |
|
|
; $47 - Character: 'G' CHR$(71)
|
19692 |
|
|
|
19693 |
|
|
DEFB %00000000
|
19694 |
|
|
DEFB %00111100
|
19695 |
|
|
DEFB %01000010
|
19696 |
|
|
DEFB %01000000
|
19697 |
|
|
DEFB %01001110
|
19698 |
|
|
DEFB %01000010
|
19699 |
|
|
DEFB %00111100
|
19700 |
|
|
DEFB %00000000
|
19701 |
|
|
|
19702 |
|
|
; $48 - Character: 'H' CHR$(72)
|
19703 |
|
|
|
19704 |
|
|
DEFB %00000000
|
19705 |
|
|
DEFB %01000010
|
19706 |
|
|
DEFB %01000010
|
19707 |
|
|
DEFB %01111110
|
19708 |
|
|
DEFB %01000010
|
19709 |
|
|
DEFB %01000010
|
19710 |
|
|
DEFB %01000010
|
19711 |
|
|
DEFB %00000000
|
19712 |
|
|
|
19713 |
|
|
; $49 - Character: 'I' CHR$(73)
|
19714 |
|
|
|
19715 |
|
|
DEFB %00000000
|
19716 |
|
|
DEFB %00111110
|
19717 |
|
|
DEFB %00001000
|
19718 |
|
|
DEFB %00001000
|
19719 |
|
|
DEFB %00001000
|
19720 |
|
|
DEFB %00001000
|
19721 |
|
|
DEFB %00111110
|
19722 |
|
|
DEFB %00000000
|
19723 |
|
|
|
19724 |
|
|
; $4A - Character: 'J' CHR$(74)
|
19725 |
|
|
|
19726 |
|
|
DEFB %00000000
|
19727 |
|
|
DEFB %00000010
|
19728 |
|
|
DEFB %00000010
|
19729 |
|
|
DEFB %00000010
|
19730 |
|
|
DEFB %01000010
|
19731 |
|
|
DEFB %01000010
|
19732 |
|
|
DEFB %00111100
|
19733 |
|
|
DEFB %00000000
|
19734 |
|
|
|
19735 |
|
|
; $4B - Character: 'K' CHR$(75)
|
19736 |
|
|
|
19737 |
|
|
DEFB %00000000
|
19738 |
|
|
DEFB %01000100
|
19739 |
|
|
DEFB %01001000
|
19740 |
|
|
DEFB %01110000
|
19741 |
|
|
DEFB %01001000
|
19742 |
|
|
DEFB %01000100
|
19743 |
|
|
DEFB %01000010
|
19744 |
|
|
DEFB %00000000
|
19745 |
|
|
|
19746 |
|
|
; $4C - Character: 'L' CHR$(76)
|
19747 |
|
|
|
19748 |
|
|
DEFB %00000000
|
19749 |
|
|
DEFB %01000000
|
19750 |
|
|
DEFB %01000000
|
19751 |
|
|
DEFB %01000000
|
19752 |
|
|
DEFB %01000000
|
19753 |
|
|
DEFB %01000000
|
19754 |
|
|
DEFB %01111110
|
19755 |
|
|
DEFB %00000000
|
19756 |
|
|
|
19757 |
|
|
; $4D - Character: 'M' CHR$(77)
|
19758 |
|
|
|
19759 |
|
|
DEFB %00000000
|
19760 |
|
|
DEFB %01000010
|
19761 |
|
|
DEFB %01100110
|
19762 |
|
|
DEFB %01011010
|
19763 |
|
|
DEFB %01000010
|
19764 |
|
|
DEFB %01000010
|
19765 |
|
|
DEFB %01000010
|
19766 |
|
|
DEFB %00000000
|
19767 |
|
|
|
19768 |
|
|
; $4E - Character: 'N' CHR$(78)
|
19769 |
|
|
|
19770 |
|
|
DEFB %00000000
|
19771 |
|
|
DEFB %01000010
|
19772 |
|
|
DEFB %01100010
|
19773 |
|
|
DEFB %01010010
|
19774 |
|
|
DEFB %01001010
|
19775 |
|
|
DEFB %01000110
|
19776 |
|
|
DEFB %01000010
|
19777 |
|
|
DEFB %00000000
|
19778 |
|
|
|
19779 |
|
|
; $4F - Character: 'O' CHR$(79)
|
19780 |
|
|
|
19781 |
|
|
DEFB %00000000
|
19782 |
|
|
DEFB %00111100
|
19783 |
|
|
DEFB %01000010
|
19784 |
|
|
DEFB %01000010
|
19785 |
|
|
DEFB %01000010
|
19786 |
|
|
DEFB %01000010
|
19787 |
|
|
DEFB %00111100
|
19788 |
|
|
DEFB %00000000
|
19789 |
|
|
|
19790 |
|
|
; $50 - Character: 'P' CHR$(80)
|
19791 |
|
|
|
19792 |
|
|
DEFB %00000000
|
19793 |
|
|
DEFB %01111100
|
19794 |
|
|
DEFB %01000010
|
19795 |
|
|
DEFB %01000010
|
19796 |
|
|
DEFB %01111100
|
19797 |
|
|
DEFB %01000000
|
19798 |
|
|
DEFB %01000000
|
19799 |
|
|
DEFB %00000000
|
19800 |
|
|
|
19801 |
|
|
; $51 - Character: 'Q' CHR$(81)
|
19802 |
|
|
|
19803 |
|
|
DEFB %00000000
|
19804 |
|
|
DEFB %00111100
|
19805 |
|
|
DEFB %01000010
|
19806 |
|
|
DEFB %01000010
|
19807 |
|
|
DEFB %01010010
|
19808 |
|
|
DEFB %01001010
|
19809 |
|
|
DEFB %00111100
|
19810 |
|
|
DEFB %00000000
|
19811 |
|
|
|
19812 |
|
|
; $52 - Character: 'R' CHR$(82)
|
19813 |
|
|
|
19814 |
|
|
DEFB %00000000
|
19815 |
|
|
DEFB %01111100
|
19816 |
|
|
DEFB %01000010
|
19817 |
|
|
DEFB %01000010
|
19818 |
|
|
DEFB %01111100
|
19819 |
|
|
DEFB %01000100
|
19820 |
|
|
DEFB %01000010
|
19821 |
|
|
DEFB %00000000
|
19822 |
|
|
|
19823 |
|
|
; $53 - Character: 'S' CHR$(83)
|
19824 |
|
|
|
19825 |
|
|
DEFB %00000000
|
19826 |
|
|
DEFB %00111100
|
19827 |
|
|
DEFB %01000000
|
19828 |
|
|
DEFB %00111100
|
19829 |
|
|
DEFB %00000010
|
19830 |
|
|
DEFB %01000010
|
19831 |
|
|
DEFB %00111100
|
19832 |
|
|
DEFB %00000000
|
19833 |
|
|
|
19834 |
|
|
; $54 - Character: 'T' CHR$(84)
|
19835 |
|
|
|
19836 |
|
|
DEFB %00000000
|
19837 |
|
|
DEFB %11111110
|
19838 |
|
|
DEFB %00010000
|
19839 |
|
|
DEFB %00010000
|
19840 |
|
|
DEFB %00010000
|
19841 |
|
|
DEFB %00010000
|
19842 |
|
|
DEFB %00010000
|
19843 |
|
|
DEFB %00000000
|
19844 |
|
|
|
19845 |
|
|
; $55 - Character: 'U' CHR$(85)
|
19846 |
|
|
|
19847 |
|
|
DEFB %00000000
|
19848 |
|
|
DEFB %01000010
|
19849 |
|
|
DEFB %01000010
|
19850 |
|
|
DEFB %01000010
|
19851 |
|
|
DEFB %01000010
|
19852 |
|
|
DEFB %01000010
|
19853 |
|
|
DEFB %00111100
|
19854 |
|
|
DEFB %00000000
|
19855 |
|
|
|
19856 |
|
|
; $56 - Character: 'V' CHR$(86)
|
19857 |
|
|
|
19858 |
|
|
DEFB %00000000
|
19859 |
|
|
DEFB %01000010
|
19860 |
|
|
DEFB %01000010
|
19861 |
|
|
DEFB %01000010
|
19862 |
|
|
DEFB %01000010
|
19863 |
|
|
DEFB %00100100
|
19864 |
|
|
DEFB %00011000
|
19865 |
|
|
DEFB %00000000
|
19866 |
|
|
|
19867 |
|
|
; $57 - Character: 'W' CHR$(87)
|
19868 |
|
|
|
19869 |
|
|
DEFB %00000000
|
19870 |
|
|
DEFB %01000010
|
19871 |
|
|
DEFB %01000010
|
19872 |
|
|
DEFB %01000010
|
19873 |
|
|
DEFB %01000010
|
19874 |
|
|
DEFB %01011010
|
19875 |
|
|
DEFB %00100100
|
19876 |
|
|
DEFB %00000000
|
19877 |
|
|
|
19878 |
|
|
; $58 - Character: 'X' CHR$(88)
|
19879 |
|
|
|
19880 |
|
|
DEFB %00000000
|
19881 |
|
|
DEFB %01000010
|
19882 |
|
|
DEFB %00100100
|
19883 |
|
|
DEFB %00011000
|
19884 |
|
|
DEFB %00011000
|
19885 |
|
|
DEFB %00100100
|
19886 |
|
|
DEFB %01000010
|
19887 |
|
|
DEFB %00000000
|
19888 |
|
|
|
19889 |
|
|
; $59 - Character: 'Y' CHR$(89)
|
19890 |
|
|
|
19891 |
|
|
DEFB %00000000
|
19892 |
|
|
DEFB %10000010
|
19893 |
|
|
DEFB %01000100
|
19894 |
|
|
DEFB %00101000
|
19895 |
|
|
DEFB %00010000
|
19896 |
|
|
DEFB %00010000
|
19897 |
|
|
DEFB %00010000
|
19898 |
|
|
DEFB %00000000
|
19899 |
|
|
|
19900 |
|
|
; $5A - Character: 'Z' CHR$(90)
|
19901 |
|
|
|
19902 |
|
|
DEFB %00000000
|
19903 |
|
|
DEFB %01111110
|
19904 |
|
|
DEFB %00000100
|
19905 |
|
|
DEFB %00001000
|
19906 |
|
|
DEFB %00010000
|
19907 |
|
|
DEFB %00100000
|
19908 |
|
|
DEFB %01111110
|
19909 |
|
|
DEFB %00000000
|
19910 |
|
|
|
19911 |
|
|
; $5B - Character: '[' CHR$(91)
|
19912 |
|
|
|
19913 |
|
|
DEFB %00000000
|
19914 |
|
|
DEFB %00001110
|
19915 |
|
|
DEFB %00001000
|
19916 |
|
|
DEFB %00001000
|
19917 |
|
|
DEFB %00001000
|
19918 |
|
|
DEFB %00001000
|
19919 |
|
|
DEFB %00001110
|
19920 |
|
|
DEFB %00000000
|
19921 |
|
|
|
19922 |
|
|
; $5C - Character: '\' CHR$(92)
|
19923 |
|
|
|
19924 |
|
|
DEFB %00000000
|
19925 |
|
|
DEFB %00000000
|
19926 |
|
|
DEFB %01000000
|
19927 |
|
|
DEFB %00100000
|
19928 |
|
|
DEFB %00010000
|
19929 |
|
|
DEFB %00001000
|
19930 |
|
|
DEFB %00000100
|
19931 |
|
|
DEFB %00000000
|
19932 |
|
|
|
19933 |
|
|
; $5D - Character: ']' CHR$(93)
|
19934 |
|
|
|
19935 |
|
|
DEFB %00000000
|
19936 |
|
|
DEFB %01110000
|
19937 |
|
|
DEFB %00010000
|
19938 |
|
|
DEFB %00010000
|
19939 |
|
|
DEFB %00010000
|
19940 |
|
|
DEFB %00010000
|
19941 |
|
|
DEFB %01110000
|
19942 |
|
|
DEFB %00000000
|
19943 |
|
|
|
19944 |
|
|
; $5E - Character: '^' CHR$(94)
|
19945 |
|
|
|
19946 |
|
|
DEFB %00000000
|
19947 |
|
|
DEFB %00010000
|
19948 |
|
|
DEFB %00111000
|
19949 |
|
|
DEFB %01010100
|
19950 |
|
|
DEFB %00010000
|
19951 |
|
|
DEFB %00010000
|
19952 |
|
|
DEFB %00010000
|
19953 |
|
|
DEFB %00000000
|
19954 |
|
|
|
19955 |
|
|
; $5F - Character: '_' CHR$(95)
|
19956 |
|
|
|
19957 |
|
|
DEFB %00000000
|
19958 |
|
|
DEFB %00000000
|
19959 |
|
|
DEFB %00000000
|
19960 |
|
|
DEFB %00000000
|
19961 |
|
|
DEFB %00000000
|
19962 |
|
|
DEFB %00000000
|
19963 |
|
|
DEFB %00000000
|
19964 |
|
|
DEFB %11111111
|
19965 |
|
|
|
19966 |
|
|
; $60 - Character: ' £ ' CHR$(96)
|
19967 |
|
|
|
19968 |
|
|
DEFB %00000000
|
19969 |
|
|
DEFB %00011100
|
19970 |
|
|
DEFB %00100010
|
19971 |
|
|
DEFB %01111000
|
19972 |
|
|
DEFB %00100000
|
19973 |
|
|
DEFB %00100000
|
19974 |
|
|
DEFB %01111110
|
19975 |
|
|
DEFB %00000000
|
19976 |
|
|
|
19977 |
|
|
; $61 - Character: 'a' CHR$(97)
|
19978 |
|
|
|
19979 |
|
|
DEFB %00000000
|
19980 |
|
|
DEFB %00000000
|
19981 |
|
|
DEFB %00111000
|
19982 |
|
|
DEFB %00000100
|
19983 |
|
|
DEFB %00111100
|
19984 |
|
|
DEFB %01000100
|
19985 |
|
|
DEFB %00111100
|
19986 |
|
|
DEFB %00000000
|
19987 |
|
|
|
19988 |
|
|
; $62 - Character: 'b' CHR$(98)
|
19989 |
|
|
|
19990 |
|
|
DEFB %00000000
|
19991 |
|
|
DEFB %00100000
|
19992 |
|
|
DEFB %00100000
|
19993 |
|
|
DEFB %00111100
|
19994 |
|
|
DEFB %00100010
|
19995 |
|
|
DEFB %00100010
|
19996 |
|
|
DEFB %00111100
|
19997 |
|
|
DEFB %00000000
|
19998 |
|
|
|
19999 |
|
|
; $63 - Character: 'c' CHR$(99)
|
20000 |
|
|
|
20001 |
|
|
DEFB %00000000
|
20002 |
|
|
DEFB %00000000
|
20003 |
|
|
DEFB %00011100
|
20004 |
|
|
DEFB %00100000
|
20005 |
|
|
DEFB %00100000
|
20006 |
|
|
DEFB %00100000
|
20007 |
|
|
DEFB %00011100
|
20008 |
|
|
DEFB %00000000
|
20009 |
|
|
|
20010 |
|
|
; $64 - Character: 'd' CHR$(100)
|
20011 |
|
|
|
20012 |
|
|
DEFB %00000000
|
20013 |
|
|
DEFB %00000100
|
20014 |
|
|
DEFB %00000100
|
20015 |
|
|
DEFB %00111100
|
20016 |
|
|
DEFB %01000100
|
20017 |
|
|
DEFB %01000100
|
20018 |
|
|
DEFB %00111100
|
20019 |
|
|
DEFB %00000000
|
20020 |
|
|
|
20021 |
|
|
; $65 - Character: 'e' CHR$(101)
|
20022 |
|
|
|
20023 |
|
|
DEFB %00000000
|
20024 |
|
|
DEFB %00000000
|
20025 |
|
|
DEFB %00111000
|
20026 |
|
|
DEFB %01000100
|
20027 |
|
|
DEFB %01111000
|
20028 |
|
|
DEFB %01000000
|
20029 |
|
|
DEFB %00111100
|
20030 |
|
|
DEFB %00000000
|
20031 |
|
|
|
20032 |
|
|
; $66 - Character: 'f' CHR$(102)
|
20033 |
|
|
|
20034 |
|
|
DEFB %00000000
|
20035 |
|
|
DEFB %00001100
|
20036 |
|
|
DEFB %00010000
|
20037 |
|
|
DEFB %00011000
|
20038 |
|
|
DEFB %00010000
|
20039 |
|
|
DEFB %00010000
|
20040 |
|
|
DEFB %00010000
|
20041 |
|
|
DEFB %00000000
|
20042 |
|
|
|
20043 |
|
|
; $67 - Character: 'g' CHR$(103)
|
20044 |
|
|
|
20045 |
|
|
DEFB %00000000
|
20046 |
|
|
DEFB %00000000
|
20047 |
|
|
DEFB %00111100
|
20048 |
|
|
DEFB %01000100
|
20049 |
|
|
DEFB %01000100
|
20050 |
|
|
DEFB %00111100
|
20051 |
|
|
DEFB %00000100
|
20052 |
|
|
DEFB %00111000
|
20053 |
|
|
|
20054 |
|
|
; $68 - Character: 'h' CHR$(104)
|
20055 |
|
|
|
20056 |
|
|
DEFB %00000000
|
20057 |
|
|
DEFB %01000000
|
20058 |
|
|
DEFB %01000000
|
20059 |
|
|
DEFB %01111000
|
20060 |
|
|
DEFB %01000100
|
20061 |
|
|
DEFB %01000100
|
20062 |
|
|
DEFB %01000100
|
20063 |
|
|
DEFB %00000000
|
20064 |
|
|
|
20065 |
|
|
; $69 - Character: 'i' CHR$(105)
|
20066 |
|
|
|
20067 |
|
|
DEFB %00000000
|
20068 |
|
|
DEFB %00010000
|
20069 |
|
|
DEFB %00000000
|
20070 |
|
|
DEFB %00110000
|
20071 |
|
|
DEFB %00010000
|
20072 |
|
|
DEFB %00010000
|
20073 |
|
|
DEFB %00111000
|
20074 |
|
|
DEFB %00000000
|
20075 |
|
|
|
20076 |
|
|
; $6A - Character: 'j' CHR$(106)
|
20077 |
|
|
|
20078 |
|
|
DEFB %00000000
|
20079 |
|
|
DEFB %00000100
|
20080 |
|
|
DEFB %00000000
|
20081 |
|
|
DEFB %00000100
|
20082 |
|
|
DEFB %00000100
|
20083 |
|
|
DEFB %00000100
|
20084 |
|
|
DEFB %00100100
|
20085 |
|
|
DEFB %00011000
|
20086 |
|
|
|
20087 |
|
|
; $6B - Character: 'k' CHR$(107)
|
20088 |
|
|
|
20089 |
|
|
DEFB %00000000
|
20090 |
|
|
DEFB %00100000
|
20091 |
|
|
DEFB %00101000
|
20092 |
|
|
DEFB %00110000
|
20093 |
|
|
DEFB %00110000
|
20094 |
|
|
DEFB %00101000
|
20095 |
|
|
DEFB %00100100
|
20096 |
|
|
DEFB %00000000
|
20097 |
|
|
|
20098 |
|
|
; $6C - Character: 'l' CHR$(108)
|
20099 |
|
|
|
20100 |
|
|
DEFB %00000000
|
20101 |
|
|
DEFB %00010000
|
20102 |
|
|
DEFB %00010000
|
20103 |
|
|
DEFB %00010000
|
20104 |
|
|
DEFB %00010000
|
20105 |
|
|
DEFB %00010000
|
20106 |
|
|
DEFB %00001100
|
20107 |
|
|
DEFB %00000000
|
20108 |
|
|
|
20109 |
|
|
; $6D - Character: 'm' CHR$(109)
|
20110 |
|
|
|
20111 |
|
|
DEFB %00000000
|
20112 |
|
|
DEFB %00000000
|
20113 |
|
|
DEFB %01101000
|
20114 |
|
|
DEFB %01010100
|
20115 |
|
|
DEFB %01010100
|
20116 |
|
|
DEFB %01010100
|
20117 |
|
|
DEFB %01010100
|
20118 |
|
|
DEFB %00000000
|
20119 |
|
|
|
20120 |
|
|
; $6E - Character: 'n' CHR$(110)
|
20121 |
|
|
|
20122 |
|
|
DEFB %00000000
|
20123 |
|
|
DEFB %00000000
|
20124 |
|
|
DEFB %01111000
|
20125 |
|
|
DEFB %01000100
|
20126 |
|
|
DEFB %01000100
|
20127 |
|
|
DEFB %01000100
|
20128 |
|
|
DEFB %01000100
|
20129 |
|
|
DEFB %00000000
|
20130 |
|
|
|
20131 |
|
|
; $6F - Character: 'o' CHR$(111)
|
20132 |
|
|
|
20133 |
|
|
DEFB %00000000
|
20134 |
|
|
DEFB %00000000
|
20135 |
|
|
DEFB %00111000
|
20136 |
|
|
DEFB %01000100
|
20137 |
|
|
DEFB %01000100
|
20138 |
|
|
DEFB %01000100
|
20139 |
|
|
DEFB %00111000
|
20140 |
|
|
DEFB %00000000
|
20141 |
|
|
|
20142 |
|
|
; $70 - Character: 'p' CHR$(112)
|
20143 |
|
|
|
20144 |
|
|
DEFB %00000000
|
20145 |
|
|
DEFB %00000000
|
20146 |
|
|
DEFB %01111000
|
20147 |
|
|
DEFB %01000100
|
20148 |
|
|
DEFB %01000100
|
20149 |
|
|
DEFB %01111000
|
20150 |
|
|
DEFB %01000000
|
20151 |
|
|
DEFB %01000000
|
20152 |
|
|
|
20153 |
|
|
; $71 - Character: 'q' CHR$(113)
|
20154 |
|
|
|
20155 |
|
|
DEFB %00000000
|
20156 |
|
|
DEFB %00000000
|
20157 |
|
|
DEFB %00111100
|
20158 |
|
|
DEFB %01000100
|
20159 |
|
|
DEFB %01000100
|
20160 |
|
|
DEFB %00111100
|
20161 |
|
|
DEFB %00000100
|
20162 |
|
|
DEFB %00000110
|
20163 |
|
|
|
20164 |
|
|
; $72 - Character: 'r' CHR$(114)
|
20165 |
|
|
|
20166 |
|
|
DEFB %00000000
|
20167 |
|
|
DEFB %00000000
|
20168 |
|
|
DEFB %00011100
|
20169 |
|
|
DEFB %00100000
|
20170 |
|
|
DEFB %00100000
|
20171 |
|
|
DEFB %00100000
|
20172 |
|
|
DEFB %00100000
|
20173 |
|
|
DEFB %00000000
|
20174 |
|
|
|
20175 |
|
|
; $73 - Character: 's' CHR$(115)
|
20176 |
|
|
|
20177 |
|
|
DEFB %00000000
|
20178 |
|
|
DEFB %00000000
|
20179 |
|
|
DEFB %00111000
|
20180 |
|
|
DEFB %01000000
|
20181 |
|
|
DEFB %00111000
|
20182 |
|
|
DEFB %00000100
|
20183 |
|
|
DEFB %01111000
|
20184 |
|
|
DEFB %00000000
|
20185 |
|
|
|
20186 |
|
|
; $74 - Character: 't' CHR$(116)
|
20187 |
|
|
|
20188 |
|
|
DEFB %00000000
|
20189 |
|
|
DEFB %00010000
|
20190 |
|
|
DEFB %00111000
|
20191 |
|
|
DEFB %00010000
|
20192 |
|
|
DEFB %00010000
|
20193 |
|
|
DEFB %00010000
|
20194 |
|
|
DEFB %00001100
|
20195 |
|
|
DEFB %00000000
|
20196 |
|
|
|
20197 |
|
|
; $75 - Character: 'u' CHR$(117)
|
20198 |
|
|
|
20199 |
|
|
DEFB %00000000
|
20200 |
|
|
DEFB %00000000
|
20201 |
|
|
DEFB %01000100
|
20202 |
|
|
DEFB %01000100
|
20203 |
|
|
DEFB %01000100
|
20204 |
|
|
DEFB %01000100
|
20205 |
|
|
DEFB %00111000
|
20206 |
|
|
DEFB %00000000
|
20207 |
|
|
|
20208 |
|
|
; $76 - Character: 'v' CHR$(118)
|
20209 |
|
|
|
20210 |
|
|
DEFB %00000000
|
20211 |
|
|
DEFB %00000000
|
20212 |
|
|
DEFB %01000100
|
20213 |
|
|
DEFB %01000100
|
20214 |
|
|
DEFB %00101000
|
20215 |
|
|
DEFB %00101000
|
20216 |
|
|
DEFB %00010000
|
20217 |
|
|
DEFB %00000000
|
20218 |
|
|
|
20219 |
|
|
; $77 - Character: 'w' CHR$(119)
|
20220 |
|
|
|
20221 |
|
|
DEFB %00000000
|
20222 |
|
|
DEFB %00000000
|
20223 |
|
|
DEFB %01000100
|
20224 |
|
|
DEFB %01010100
|
20225 |
|
|
DEFB %01010100
|
20226 |
|
|
DEFB %01010100
|
20227 |
|
|
DEFB %00101000
|
20228 |
|
|
DEFB %00000000
|
20229 |
|
|
|
20230 |
|
|
; $78 - Character: 'x' CHR$(120)
|
20231 |
|
|
|
20232 |
|
|
DEFB %00000000
|
20233 |
|
|
DEFB %00000000
|
20234 |
|
|
DEFB %01000100
|
20235 |
|
|
DEFB %00101000
|
20236 |
|
|
DEFB %00010000
|
20237 |
|
|
DEFB %00101000
|
20238 |
|
|
DEFB %01000100
|
20239 |
|
|
DEFB %00000000
|
20240 |
|
|
|
20241 |
|
|
; $79 - Character: 'y' CHR$(121)
|
20242 |
|
|
|
20243 |
|
|
DEFB %00000000
|
20244 |
|
|
DEFB %00000000
|
20245 |
|
|
DEFB %01000100
|
20246 |
|
|
DEFB %01000100
|
20247 |
|
|
DEFB %01000100
|
20248 |
|
|
DEFB %00111100
|
20249 |
|
|
DEFB %00000100
|
20250 |
|
|
DEFB %00111000
|
20251 |
|
|
|
20252 |
|
|
; $7A - Character: 'z' CHR$(122)
|
20253 |
|
|
|
20254 |
|
|
DEFB %00000000
|
20255 |
|
|
DEFB %00000000
|
20256 |
|
|
DEFB %01111100
|
20257 |
|
|
DEFB %00001000
|
20258 |
|
|
DEFB %00010000
|
20259 |
|
|
DEFB %00100000
|
20260 |
|
|
DEFB %01111100
|
20261 |
|
|
DEFB %00000000
|
20262 |
|
|
|
20263 |
|
|
; $7B - Character: '{' CHR$(123)
|
20264 |
|
|
|
20265 |
|
|
DEFB %00000000
|
20266 |
|
|
DEFB %00001110
|
20267 |
|
|
DEFB %00001000
|
20268 |
|
|
DEFB %00110000
|
20269 |
|
|
DEFB %00001000
|
20270 |
|
|
DEFB %00001000
|
20271 |
|
|
DEFB %00001110
|
20272 |
|
|
DEFB %00000000
|
20273 |
|
|
|
20274 |
|
|
; $7C - Character: '|' CHR$(124)
|
20275 |
|
|
|
20276 |
|
|
DEFB %00000000
|
20277 |
|
|
DEFB %00001000
|
20278 |
|
|
DEFB %00001000
|
20279 |
|
|
DEFB %00001000
|
20280 |
|
|
DEFB %00001000
|
20281 |
|
|
DEFB %00001000
|
20282 |
|
|
DEFB %00001000
|
20283 |
|
|
DEFB %00000000
|
20284 |
|
|
|
20285 |
|
|
; $7D - Character: '}' CHR$(125)
|
20286 |
|
|
|
20287 |
|
|
DEFB %00000000
|
20288 |
|
|
DEFB %01110000
|
20289 |
|
|
DEFB %00010000
|
20290 |
|
|
DEFB %00001100
|
20291 |
|
|
DEFB %00010000
|
20292 |
|
|
DEFB %00010000
|
20293 |
|
|
DEFB %01110000
|
20294 |
|
|
DEFB %00000000
|
20295 |
|
|
|
20296 |
|
|
; $7E - Character: '~' CHR$(126)
|
20297 |
|
|
|
20298 |
|
|
DEFB %00000000
|
20299 |
|
|
DEFB %00010100
|
20300 |
|
|
DEFB %00101000
|
20301 |
|
|
DEFB %00000000
|
20302 |
|
|
DEFB %00000000
|
20303 |
|
|
DEFB %00000000
|
20304 |
|
|
DEFB %00000000
|
20305 |
|
|
DEFB %00000000
|
20306 |
|
|
|
20307 |
|
|
; $7F - Character: ' © ' CHR$(127)
|
20308 |
|
|
|
20309 |
|
|
DEFB %00111100
|
20310 |
|
|
DEFB %01000010
|
20311 |
|
|
DEFB %10011001
|
20312 |
|
|
DEFB %10100001
|
20313 |
|
|
DEFB %10100001
|
20314 |
|
|
DEFB %10011001
|
20315 |
|
|
DEFB %01000010
|
20316 |
|
|
DEFB %00111100
|
20317 |
|
|
|
20318 |
|
|
|
20319 |
|
|
#end ; generic cross-assembler directive
|
20320 |
|
|
|
20321 |
|
|
; Acknowledgements
|
20322 |
|
|
; -----------------
|
20323 |
|
|
; Sean Irvine for default list of section headings
|
20324 |
|
|
; Dr. Ian Logan for labels and functional disassembly.
|
20325 |
|
|
; Dr. Frank O'Hara for labels and functional disassembly.
|
20326 |
|
|
;
|
20327 |
|
|
; Credits
|
20328 |
|
|
; -------
|
20329 |
|
|
; Alex Pallero Gonzales for corrections.
|
20330 |
|
|
; Mike Dailly for comments.
|
20331 |
|
|
; Alvin Albrecht for comments.
|
20332 |
|
|
; Andy Styles for full relocatability implementation and testing. testing.
|
20333 |
|
|
; Andrew Owen for ZASM compatibility and format improvements.
|
20334 |
|
|
|
20335 |
|
|
; For other assemblers you may have to add directives like these near the
|
20336 |
|
|
; beginning - see accompanying documentation.
|
20337 |
|
|
; ZASM (MacOs) cross-assembler directives. (uncomment by removing ';' )
|
20338 |
|
|
; #target rom ; declare target file format as binary.
|
20339 |
|
|
; #code 0,$4000 ; declare code segment.
|
20340 |
|
|
; Also see notes at Address Labels 0609 and 1CA5 if your assembler has
|
20341 |
|
|
; trouble with expressions.
|
20342 |
|
|
;
|
20343 |
|
|
; Note. The Sinclair Interface 1 ROM written by Dr. Ian Logan and Martin
|
20344 |
|
|
; Brennan calls numerous routines in this ROM.
|
20345 |
|
|
; Non-standard entry points have a label beginning with X.
|