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