From 755410c252aa343b02e8c8861a92ccb8482daf56 Mon Sep 17 00:00:00 2001 From: spectrum Date: Sun, 2 Feb 2025 01:56:45 +0300 Subject: [PATCH] =?UTF-8?q?=D0=94=D0=BE=D0=B1=D0=B0=D0=B2=D0=B8=D1=82?= =?UTF-8?q?=D1=8C=20zx-spectrum-rom.asm?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- zx-spectrum-rom.asm | 17580 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 17580 insertions(+) create mode 100644 zx-spectrum-rom.asm diff --git a/zx-spectrum-rom.asm b/zx-spectrum-rom.asm new file mode 100644 index 0000000..f0122bd --- /dev/null +++ b/zx-spectrum-rom.asm @@ -0,0 +1,17580 @@ +;************************************************************************ +;** An assembly file listing to generate a 16K Rom for the ZX Spectrum ** +;************************************************************************ +; +; Copyright (c) Amstrad plc. All rights reserved. +; +; Acknowledgements +; ----------------- +; Sean Irvine for default list of section headings +; (author unknown). +; Dr. Ian Logan for labels and functional disassembly. +; Dr. Frank O'Hara for labels and functional disassembly. +; +; Credits +; ------- +; Alex Pallero Gonzales for corrections. +; Mike Dailly for comments. +; Alvin Albrecht for comments. +; Hob of c.s.s for full relocatability implementation and testing. +; +; z00m^SinDiKAT sjasmplus adaptation and dirty reformat. +; +; obsolete labels +; L1C16 JUMP-C-R + + OUTPUT "48.ROM" + +; System variables definitions + + include "zx-spectrum-sysvars.asm" + +;***************************************** +;** Part 1. RESTART ROUTINES AND TABLES ** +;***************************************** + +;------ +; Start +;------ +; At switch on, the Z80 chip is in interrupt mode 0. +; This location can also be 'called' to reset the machine. +; Typically with PRINT USR 0. + + ORG $0000 + ;;;$0000 +START: DI ; disable interrupts. + XOR A ; signal coming from START. + LD DE,$FFFF ; top of possible physical RAM. + JP START_NEW ; jump forward to common code at START_NEW. + +;-------------- +; Error restart +;-------------- +; The error pointer is made to point to the position of the error to enable +; the editor to show the error if it occurred during syntax checking. +; It is used at 37 places in the program. +; An instruction fetch on address $0008 may page in a peripheral ROM +; although this was not an original design concept. + + ;;;$0008 +ERROR_1: LD HL,(CH_ADD) ; fetch the character address from CH_ADD. + LD (X_PTR),HL ; copy it to the error pointer X_PTR. + JR ERROR_2 ; forward to continue at ERROR_2. + +;------------------ +; Print a character +;------------------ +; The A register holds the code of the character that is to be sent to +; the output stream of the current channel. +; The alternate register set is used to output a character in the A register +; so there is no need to preserve any of the current registers. +; This restart occurs 21 times. + + ;;;$0010 +PRINT_A: JP PRINT_A_2 ; jump forward to continue at PRINT_A_2. + + DEFB $FF, $FF, $FF ; five unused locations. + DEFB $FF, $FF + +;-------------------- +; Collect a character +;-------------------- +; The contents of the location currently addressed by CH_ADD are fetched. +; A return is made if the value represents a character that has +; relevance to the BASIC parser. Otherwise CH_ADD is incremented and the +; tests repeated. CH_ADD will be addressing somewhere - +; 1) in the basic program area during line execution. +; 2) in workspace if evaluating, for example, a string expression. +; 3) in the edit buffer if parsing a direct command or a new basic line. +; 4) in workspace if accepting input but not that from INPUT LINE. + + ;;;$0018 +GET_CHAR: LD HL,(CH_ADD) ; fetch the address from CH_ADD. + LD A,(HL) ; use it to pick up current character. + + ;;;$001C +TEST_CHAR: CALL SKIP_OVER ; routine SKIP_OVER tests if the character + RET NC ; is relevant. Return if it is so. + +;----------------------- +; Collect next character +;----------------------- +; As the BASIC commands and expressions are interpreted, this routine is +; called repeatedly to step along the line. It is used 83 times. + + ;;;$0020 +NEXT_CHAR: CALL CH_ADD_1 ; routine CH_ADD_1 fetches the next immediate character. + JR TEST_CHAR ; jump back to TEST_CHAR until a valid + ; character is found. + DEFB $FF, $FF, $FF ; unused + +;------------------- +; Calculator restart +;------------------- +; This restart enters the Spectrum's internal, floating-point, +; stack-based, FORTH-like language. +; It is further used recursively from within the calculator. +; It is used on 77 occasions. + + ;;;$0028 +FP_CALC: JP CALCULATE ; jump forward to the CALCULATE routine. + + DEFB $FF, $FF, $FF ; spare - note that on the ZX81, space being a + DEFB $FF, $FF ; little cramped, these same locations were + ; used for the five-byte END_CALC literal. + +;------------------------------------ +; Create free locations in work space +;------------------------------------ +; This restart is used on only 12 occasions to create BC spaces +; between workspace and the calculator stack. + + ;;;$0030 +BC_SPACES: PUSH BC ; save number of spaces. + LD HL,(WORKSP) ; fetch WORKSP. + PUSH HL ; save address of workspace. + JP RESERVE ; jump forward to continuation code RESERVE. + +;--------------------------- +; Maskable interrupt routine +;--------------------------- +; This routine increments the Spectrum's three-byte FRAMES counter +; fifty times a second (sixty times a second in the USA ). +; Both this routine and the called KEYBOARD subroutine use +; the IY register to access system variables and flags so a user-written +; program must disable interrupts to make use of the IY register. + + ;;;$0038 +MASK_INT: PUSH AF ; save the registers. + PUSH HL ; but not IY unfortunately. + LD HL,(FRAMES1) ; fetch two bytes at FRAMES1. + INC HL ; increment lowest two bytes of counter. + LD (FRAMES1),HL ; place back in FRAMES1. + LD A,H ; test if the result + OR L ; was zero. + JR NZ,KEY_INT ; forward to KEY_INT if not. + + INC (IY+$40) ; otherwise increment FRAMES3 the third byte. + + ; now save the rest of the main registers and read and decode the keyboard. + + ;;;$0048 +KEY_INT: PUSH BC ; save the other + PUSH DE ; main registers. + CALL KEYBOARD ; routine KEYBOARD executes a stage in the process of reading a key-press. + POP DE + POP BC ; restore registers. + POP HL + POP AF + EI ; enable interrupts. + RET ; return. + +;---------------- +; ERROR_2 routine +;---------------- +; A continuation of the code at 0008. +; The error code is stored and after clearing down stacks, +; an indirect jump is made to MAIN_4, etc. to handle the error. + + ;;;$0053 +ERROR_2: POP HL ; drop the return address - the location + ; after the RST 08H instruction. + LD L,(HL) ; fetch the error code that follows. + ; (nice to see this instruction used.) + + ; Note. this entry point is used when out of memory at REPORT_4. + ; The L register has been loaded with the report code but X_PTR + ; is not updated. + + ;;;$0055 +ERROR_3: LD (IY+$00),L ; store it in the system variable ERR_NR. + LD SP,(ERR_SP) ; ERR_SP points to an error handler on the + ; machine stack. There may be a hierarchy + ; of routines. + ; to MAIN_4 initially at base. + ; or REPORT_G on line entry. + ; or ED_ERROR when editing. + ; or ED_FULL during ED_ENTER. + ; or IN_VAR_1 during runtime input etc. + + JP SET_STK ; jump to SET_STK to clear the calculator + ; stack and reset MEM to usual place in the + ; systems variables area. + ; and then indirectly to MAIN_4, etc. + + DEFB $FF, $FF, $FF ; unused locations + DEFB $FF, $FF, $FF ; before the fixed-position + DEFB $FF ; NMI routine. + +;------------------------------- +; Non-maskable interrupt routine +;------------------------------- +; There is no NMI switch on the standard Spectrum. +; When activated, a location in the system variables is tested +; and if the contents are zero a jump made to that location else +; a return is made. Perhaps a disabled development feature but +; if the logic was reversed, no program would be safe from +; copy-protection and the Spectrum would have had no software base. +; The location NMIADD was later used by Interface 1 for other purposes +; ironically to make use of the Spectrum's RS232 TAB character +; which was not understood when the Interface was designed. +; On later Spectrums, and the Brazilian Spectrum, the logic of this +; routine was reversed. + + ;;;$0066 +RESET: PUSH AF ; save the + PUSH HL ; registers. + LD HL,(NMIADD) ; fetch the system variable NMIADD. + LD A,H ; test address + OR L ; for zero. + JR NZ,NO_RESET ; skip to NO_RESET if NOT ZERO + + JP (HL) ; jump to routine ( i.e. START ) + + ;;;$0070 +NO_RESET: POP HL ; restore the + POP AF ; registers. + RETN ; return to previous interrupt state. + +;---------------------- +; CH ADD + 1 subroutine +;---------------------- +; This subroutine is called from RST 20, and three times from elsewhere +; to fetch the next immediate character following the current valid character +; address and update the associated system variable. +; The entry point TEMP_PTR1 is used from the SCANNING routine. +; Both TEMP_PTR1 and TEMP_PTR2 are used by the READ command routine. + + ;;;$0074 +CH_ADD_1: LD HL,(CH_ADD) ; fetch address from CH_ADD. + + ;;;$0077 +TEMP_PTR1: INC HL ; increase the character address by one. + + ;;;$0078 +TEMP_PTR2: LD (CH_ADD),HL ; update CH_ADD with character address. + LD A,(HL) ; load character to A from HL. + RET ; and return. + +;---------- +; Skip over +;---------- +; This subroutine is called once from RST 18 to skip over white-space and +; other characters irrelevant to the parsing of a basic line etc. . +; Initially the A register holds the character to be considered +; and HL holds it's address which will not be within quoted text +; when a basic line is parsed. +; Although the 'tab' and 'at' characters will not appear in a basic line, +; they could be present in a string expression, and in other situations. +; Note. although white-space is usually placed in a program to indent loops +; and make it more readable, it can also be used for the opposite effect and +; spaces may appear in variable names although the parser never sees them. +; It is this routine that helps make the variables 'Anum bEr5 3BUS' and +; 'a number 53 bus' appear the same to the parser. + + ;;;$007D +SKIP_OVER: CP $21 ; test if higher than space. + RET NC ; return with carry clear if so. + + CP $0D ; carriage return ? + RET Z ; return also with carry clear if so. + + ; all other characters have no relevance + ; to the parser and must be returned with + ; carry set. + + CP $10 ; test if 0-15d + RET C ; return, if so, with carry set. + + CP $18 ; test if 24-32d + CCF ; complement carry flag. + RET C ; return with carry set if so. + + ; now leaves 16d-23d + + INC HL ; all above have at least one extra character + ; to be stepped over. + CP $16 ; controls 22d ('at') and 23d ('tab') have two. + JR C,SKIPS ; forward to SKIPS with ink, paper, flash, + ; bright, inverse or over controls. + ; Note. the high byte of tab is for RS232 only. + ; it has no relevance on this machine. + INC HL ; step over the second character of 'at'/'tab'. + + ;;;$0090 +SKIPS: SCF ; set the carry flag + LD (CH_ADD),HL ; update the CH_ADD system variable. + RET ; return with carry set. + + +;------------- +; Token tables +;------------- +; The tokenized characters 134d (RND) to 255d (COPY) are expanded using +; this table. The last byte of a token is inverted to denote the end of +; the word. The first is an inverted step-over byte. + + ;;;$0095 +TKN_TABLE: DEFB '?'+$80 + DEFB "RN",'D'+$80 + DEFB "INKEY",'$'+$80 + DEFB "P",'I'+$80 + DEFB "F",'N'+$80 + DEFB "POIN",'T'+$80 + DEFB "SCREEN",'$'+$80 + DEFB "ATT",'R'+$80 + DEFB "A",'T'+$80 + DEFB "TA",'B'+$80 + DEFB "VAL",'$'+$80 + DEFB "COD",'E'+$80 + DEFB "VA",'L'+$80 + DEFB "LE",'N'+$80 + DEFB "SI",'N'+$80 + DEFB "CO",'S'+$80 + DEFB "TA",'N'+$80 + DEFB "AS",'N'+$80 + DEFB "AC",'S'+$80 + DEFB "AT",'N'+$80 + DEFB "L",'N'+$80 + DEFB "EX",'P'+$80 + DEFB "IN",'T'+$80 + DEFB "SQ",'R'+$80 + DEFB "SG",'N'+$80 + DEFB "AB",'S'+$80 + DEFB "PEE",'K'+$80 + DEFB "I",'N'+$80 + DEFB "US",'R'+$80 + DEFB "STR",'$'+$80 + DEFB "CHR",'$'+$80 + DEFB "NO",'T'+$80 + DEFB "BI",'N'+$80 + + ; The previous 32 function-type words are printed without a leading space + ; The following have a leading space if they begin with a letter + + DEFB "O",'R'+$80 + DEFB "AN",'D'+$80 + DEFB $3C,'='+$80 ; <= + DEFB $3E,'='+$80 ; >= + DEFB $3C,$3E+$80 ; <> + DEFB "LIN",'E'+$80 + DEFB "THE",'N'+$80 + DEFB "T",'O'+$80 + DEFB "STE",'P'+$80 + DEFB "DEF F",'N'+$80 + DEFB "CA",'T'+$80 + DEFB "FORMA",'T'+$80 + DEFB "MOV",'E'+$80 + DEFB "ERAS",'E'+$80 + DEFB "OPEN ",'#'+$80 + DEFB "CLOSE ",'#'+$80 + DEFB "MERG",'E'+$80 + DEFB "VERIF",'Y'+$80 + DEFB "BEE",'P'+$80 + DEFB "CIRCL",'E'+$80 + DEFB "IN",'K'+$80 + DEFB "PAPE",'R'+$80 + DEFB "FLAS",'H'+$80 + DEFB "BRIGH",'T'+$80 + DEFB "INVERS",'E'+$80 + DEFB "OVE",'R'+$80 + DEFB "OU",'T'+$80 + DEFB "LPRIN",'T'+$80 + DEFB "LLIS",'T'+$80 + DEFB "STO",'P'+$80 + DEFB "REA",'D'+$80 + DEFB "DAT",'A'+$80 + DEFB "RESTOR",'E'+$80 + DEFB "NE",'W'+$80 + DEFB "BORDE",'R'+$80 + DEFB "CONTINU",'E'+$80 + DEFB "DI",'M'+$80 + DEFB "RE",'M'+$80 + DEFB "FO",'R'+$80 + DEFB "GO T",'O'+$80 + DEFB "GO SU",'B'+$80 + DEFB "INPU",'T'+$80 + DEFB "LOA",'D'+$80 + DEFB "LIS",'T'+$80 + DEFB "LE",'T'+$80 + DEFB "PAUS",'E'+$80 + DEFB "NEX",'T'+$80 + DEFB "POK",'E'+$80 + DEFB "PRIN",'T'+$80 + DEFB "PLO",'T'+$80 + DEFB "RU",'N'+$80 + DEFB "SAV",'E'+$80 + DEFB "RANDOMIZ",'E'+$80 + DEFB "I",'F'+$80 + DEFB "CL",'S'+$80 + DEFB "DRA",'W'+$80 + DEFB "CLEA",'R'+$80 + DEFB "RETUR",'N'+$80 + DEFB "COP",'Y'+$80 + +;----------- +; Key tables +;----------- +; These six look-up tables are used by the keyboard reading routine +; to decode the key values. + +; The first table contains the maps for the 39 keys of the standard +; 40-key Spectrum keyboard. The remaining key [SHIFT $27] is read directly. +; The keys consist of the 26 upper-case alphabetic characters, the 10 digit +; keys and the space, ENTER and symbol shift key. +; Unshifted alphabetic keys have $20 added to the value. +; The keywords for the main alphabetic keys are obtained by adding $A5 to +; the values obtained from this table. + + ;;;$0205 +MAIN_KEYS: DEFB $42 ; B + DEFB $48 ; H + DEFB $59 ; Y + DEFB $36 ; 6 + DEFB $35 ; 5 + DEFB $54 ; T + DEFB $47 ; G + DEFB $56 ; V + DEFB $4E ; N + DEFB $4A ; J + DEFB $55 ; U + DEFB $37 ; 7 + DEFB $34 ; 4 + DEFB $52 ; R + DEFB $46 ; F + DEFB $43 ; C + DEFB $4D ; M + DEFB $4B ; K + DEFB $49 ; I + DEFB $38 ; 8 + DEFB $33 ; 3 + DEFB $45 ; E + DEFB $44 ; D + DEFB $58 ; X + DEFB $0E ; SYMBOL SHIFT + DEFB $4C ; L + DEFB $4F ; O + DEFB $39 ; 9 + DEFB $32 ; 2 + DEFB $57 ; W + DEFB $53 ; S + DEFB $5A ; Z + DEFB $20 ; SPACE + DEFB $0D ; ENTER + DEFB $50 ; P + DEFB $30 ; 0 + DEFB $31 ; 1 + DEFB $51 ; Q + DEFB $41 ; A + + ;;;$022C + ; The 26 unshifted extended mode keys for the alphabetic characters. + ; The green keywords on the original keyboard. +E_UNSHIFT: DEFB $E3 ; READ + DEFB $C4 ; BIN + DEFB $E0 ; LPRINT + DEFB $E4 ; DATA + DEFB $B4 ; TAN + DEFB $BC ; SGN + DEFB $BD ; ABS + DEFB $BB ; SQR + DEFB $AF ; CODE + DEFB $B0 ; VAL + DEFB $B1 ; LEN + DEFB $C0 ; USR + DEFB $A7 ; PI + DEFB $A6 ; INKEY$ + DEFB $BE ; PEEK + DEFB $AD ; TAB + DEFB $B2 ; SIN + DEFB $BA ; INT + DEFB $E5 ; RESTORE + DEFB $A5 ; RND + DEFB $C2 ; CHR$ + DEFB $E1 ; LLIST + DEFB $B3 ; COS + DEFB $B9 ; EXP + DEFB $C1 ; STR$ + DEFB $B8 ; LN + + ;;;$0246 + ; The 26 shifted extended mode keys for the alphabetic characters. + ; The red keywords below keys on the original keyboard. +EXT_SHIFT: DEFB $7E ; ~ + DEFB $DC ; BRIGHT + DEFB $DA ; PAPER + DEFB $5C ; \ ; + DEFB $B7 ; ATN + DEFB $7B ; { + DEFB $7D ; } + DEFB $D8 ; CIRCLE + DEFB $BF ; IN + DEFB $AE ; VAL$ + DEFB $AA ; SCREEN$ + DEFB $AB ; ATTR + DEFB $DD ; INVERSE + DEFB $DE ; OVER + DEFB $DF ; OUT + DEFB $7F ; (Copyright character) + DEFB $B5 ; ASN + DEFB $D6 ; VERIFY + DEFB $7C ; | + DEFB $D5 ; MERGE + DEFB $5D ; ] + DEFB $DB ; FLASH + DEFB $B6 ; ACS + DEFB $D9 ; INK + DEFB $5B ; [ + DEFB $D7 ; BEEP + + ;;;$0260 + ; The ten control codes assigned to the top line of digits when the shift + ; key is pressed. +CTL_CODES: DEFB $0C ; DELETE + DEFB $07 ; EDIT + DEFB $06 ; CAPS LOCK + DEFB $04 ; TRUE VIDEO + DEFB $05 ; INVERSE VIDEO + DEFB $08 ; CURSOR LEFT + DEFB $0A ; CURSOR DOWN + DEFB $0B ; CURSOR UP + DEFB $09 ; CURSOR RIGHT + DEFB $0F ; GRAPHICS + + ;;;$026A + ; The 26 red symbols assigned to the alphabetic characters of the keyboard. + ; The ten single-character digit symbols are converted without the aid of + ; a table using subtraction and minor manipulation. +SYM_CODES: DEFB $E2 ; STOP + DEFB $2A ; * + DEFB $3F ; ? + DEFB $CD ; STEP + DEFB $C8 ; >= + DEFB $CC ; TO + DEFB $CB ; THEN + DEFB $5E ; ^ + DEFB $AC ; AT + DEFB $2D ; - + DEFB $2B ; + + DEFB $3D ; = + DEFB $2E ; . + DEFB $2C ; , + DEFB $3B ; ; + DEFB $22 ; " + DEFB $C7 ; <= + DEFB $3C ; < + DEFB $C3 ; NOT + DEFB $3E ; > + DEFB $C5 ; OR + DEFB $2F ; / + DEFB $C9 ; <> + DEFB $60 ; pound + DEFB $C6 ; AND + DEFB $3A ; : + + ;;;$0284 + ; The ten keywords assigned to the digits in extended mode. + ; The remaining red keywords below the keys. +E_DIGITS: DEFB $D0 ; FORMAT + DEFB $CE ; DEF FN + DEFB $A8 ; FN + DEFB $CA ; LINE + DEFB $D3 ; OPEN# + DEFB $D4 ; CLOSE# + DEFB $D1 ; MOVE + DEFB $D2 ; ERASE + DEFB $A9 ; POINT + DEFB $CF ; CAT + + +;******************************* +;** Part 2. KEYBOARD ROUTINES ** +;******************************* + +; Using shift keys and a combination of modes the Spectrum 40-key keyboard +; can be mapped to 256 input characters + +;---------------------------------------------------------------------------- +; +; 0 1 2 3 4 -Bits- 4 3 2 1 0 +; PORT PORT +; +; F7FE [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ] | [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 0 ] EFFE +; ^ | v +; FBFE [ Q ] [ W ] [ E ] [ R ] [ T ] | [ Y ] [ U ] [ I ] [ O ] [ P ] DFFE +; ^ | v +; FDFE [ A ] [ S ] [ D ] [ F ] [ G ] | [ H ] [ J ] [ K ] [ L ] [ ENT ] BFFE +; ^ | v +; FEFE [SHI] [ Z ] [ X ] [ C ] [ V ] | [ B ] [ N ] [ M ] [sym] [ SPC ] 7FFE +; ^ $27 $18 v +; Start End +; 00100111 00011000 +; +;---------------------------------------------------------------------------- +; The above map may help in reading. +; The neat arrangement of ports means that the B register need only be +; rotated left to work up the left hand side and then down the right +; hand side of the keyboard. When the reset bit drops into the carry +; then all 8 half-rows have been read. Shift is the first key to be +; read. The lower six bits of the shifts are unambiguous. + +;------------------ +; Keyboard scanning +;------------------ +; from keyboard and S_INKEY +; returns 1 or 2 keys in DE, most significant shift first if any +; key values 0-39 else 255 + + ;;;$028E +KEY_SCAN: LD L,$2F ; initial key value + ; valid values are obtained by subtracting + ; eight five times. + LD DE,$FFFF ; a buffer to receive 2 keys. + LD BC,$FEFE ; the commencing port address + ; B holds 11111110 initially and is also + ; used to count the 8 half-rows + ;;;$0296 +KEY_LINE: IN A,(C) ; read the port to A - bits will be reset + ; if a key is pressed else set. + CPL ; complement - pressed key-bits are now set + AND $1F ; apply 00011111 mask to pick up the + ; relevant set bits. + JR Z,KEY_DONE ; forward to KEY_DONE if zero and therefore + ; no keys pressed in row at all. + LD H,A ; transfer row bits to H + LD A,L ; load the initial key value to A + + ;;;$029F +KEY_3KEYS: INC D ; now test the key buffer + RET NZ ; if we have collected 2 keys already + ; then too many so quit. + + ;;;$02A1 +KEY_BITS: SUB $08 ; subtract 8 from the key value + ; cycling through key values (top = $27) + ; e.g. 2F> 27>1F>17>0F>07 + ; 2E> 26>1E>16>0E>06 + SRL H ; shift key bits right into carry. + JR NC,KEY_BITS ; back to KEY_BITS if not pressed + ; but if pressed we have a value (0-39d) + LD D,E ; transfer a possible previous key to D + LD E,A ; transfer the new key to E + JR NZ,KEY_3KEYS ; back to KEY_3KEYS if there were more + ; set bits - H was not yet zero. + + ;;;$02AB +KEY_DONE: DEC L ; cycles 2F>2E>2D>2C>2B>2A>29>28 for + ; each half-row. + RLC B ; form next port address e.g. FEFE > FDFE + JR C,KEY_LINE ; back to KEY_LINE if still more rows to do. + + LD A,D ; now test if D is still FF ? + INC A ; if it is zero we have at most 1 key + ; range now $01-$28 (1-40d) + RET Z ; return if one key or no key. + + CP $28 ; is it capsshift (was $27) ? + RET Z ; return if so. + + CP $19 ; is it symbol shift (was $18) ? + RET Z ; return also + + LD A,E ; now test E + LD E,D ; but first switch + LD D,A ; the two keys. + CP $18 ; is it symbol shift ? + RET ; return (with zero set if it was). + ; but with symbol shift now in D + +;------------------------------- +; Scan keyboard and decode value +;------------------------------- +; from interrupt 50 times a second + + ;;;$02BF +KEYBOARD: CALL KEY_SCAN ; routine KEY_SCAN + RET NZ ; return if invalid combinations + + ; then decrease the counters within the two key-state maps + ; as this could cause one to become free. + ; if the keyboard has not been pressed during the last five interrupts + ; then both sets will be free. + + + LD HL,KSTATE_0 ; point to KSTATE_0 + + ;;;$02C6 +K_ST_LOOP: BIT 7,(HL) ; is it free ? ($FF) + JR NZ,K_CH_SET ; forward to K_CH_SET if so + + INC HL ; address 5-counter + DEC (HL) ; decrease counter + DEC HL ; step back + JR NZ,K_CH_SET ; forward to K_CH_SET if not at end of count + + LD (HL),$FF ; else mark it free. + + ;;;$02D1 +K_CH_SET: LD A,L ; store low address byte. + LD HL,KSTATE_4 ; point to KSTATE_4 + ; (ld l, $04) + CP L ; have 2 been done ? + JR NZ,K_ST_LOOP ; back to K_ST_LOOP to consider this 2nd set + + ; now the raw key (0-38) is converted to a main key (uppercase). + + CALL K_TEST ; routine K_TEST to get main key in A + RET NC ; return if single shift + + LD HL,KSTATE_0 ; point to KSTATE_0 + CP (HL) ; does it match ? + JR Z,K_REPEAT ; forward to K_REPEAT if so + + ; if not consider the second key map. + + EX DE,HL ; save KSTATE_0 in DE + LD HL,KSTATE_4 ; point to KSTATE_4 + CP (HL) ; does it match ? + JR Z,K_REPEAT ; forward to K_REPEAT if so + + ; having excluded a repeating key we can now consider a new key. + ; the second set is always examined before the first. + + BIT 7,(HL) ; is it free ? + JR NZ,K_NEW ; forward to K_NEW if so. + + EX DE,HL ; bring back KSTATE_0 + BIT 7,(HL) ; is it free ? + RET Z ; return if not. + ; as we have a key but nowhere to put it yet. + + ; continue or jump to here if one of the buffers was free. + + ;;;$02F1 +K_NEW: LD E,A ; store key in E + LD (HL),A ; place in free location + INC HL ; advance to interrupt counter + LD (HL),$05 ; and initialize to 5 + INC HL ; advance to delay + LD A,(REPDEL) ; pick up system variable REPDEL + LD (HL),A ; and insert that for first repeat delay. + INC HL ; advance to last location of state map. + LD C,(IY+$07) ; pick up MODE (3 bytes) + LD D,(IY+$01) ; pick up FLAGS (3 bytes) + PUSH HL ; save state map location + ; Note. could now have used. + ; ld l,$41; ld c,(hl); ld l,$3B; ld d,(hl). + ; six and two threes of course. + CALL K_DECODE ; routine K_DECODE + POP HL ; restore map pointer + LD (HL),A ; put decoded key in last location of map. + + ;;;$0308 +K_END: LD (LASTK),A ; update LASTK system variable. + SET 5,(IY+$01) ; update FLAGS - signal new key. + RET ; done + +;------------------- +; Repeat key routine +;------------------- +; A possible repeat has been identified. HL addresses the raw (main) key. +; The last location holds the decoded key (from the first context). + + ;;;$0310 +K_REPEAT: INC HL ; advance + LD (HL),$05 ; maintain interrupt counter at 5 + INC HL ; advance + DEC (HL) ; decrease REPDEL value. + RET NZ ; return if not yet zero. + + LD A,(REPPER) ; REPPER + LD (HL),A ; but for subsequent repeats REPPER will be used. + INC HL ; advance + LD A,(HL) ; pick up the key decoded possibly in another context. + JR K_END ; back to K_END + +;--------------- +; Test key value +;--------------- +; also called from S_INKEY +; begin by testing for a shift with no other. + + ;;;$031E +K_TEST: LD B,D ; load most significant key to B + ; will be $FF if not shift. + LD D,$00 ; and reset D to index into main table + LD A,E ; load least significant key from E + CP $27 ; is it higher than 39d i.e. FF + RET NC ; return with just a shift (in B now) + + CP $18 ; is it symbol shift ? + JR NZ,K_MAIN ; forward to K_MAIN if not + + ; but we could have just symbol shift and no other + + BIT 7,B ; is other key $FF (ie not shift) + RET NZ ; return with solitary symbol shift + + ;;;$032C +K_MAIN: LD HL,MAIN_KEYS ; address: MAIN_KEYS + ADD HL,DE ; add offset 0-38 + LD A,(HL) ; pick up main key value + SCF ; set carry flag + RET ; return (B has other key still) + +;------------------ +; Keyboard decoding +;------------------ +; also called from S_INKEY + + ;;;$0333 +K_DECODE: LD A,E ; pick up the stored main key + CP $3A ; an arbitrary point between digits and letters + JR C,K_DIGIT ; forward to K_DIGIT with digits,space,enter + + DEC C ; decrease MODE ( 0='KLC', 1='E', 2='G') + JP M,K_KLC_LET ; to K_KLC_LET if was zero + + JR Z,K_E_LET ; to K_E_LET if was 1 for extended letters. + + ; proceed with graphic codes. + ; Note. should selectively drop return address if code > 'U' ($55). + ; i.e. abort the KEYBOARD call. + ; e.g. cp 'V'; jr c addit; pop af; ;;addit etc. (5 bytes of instruction). + ; (S_INKEY never gets into graphics mode.) + + ;; addit + ADD A,$4F ; add offset to augment 'A' to graphics A say. + RET ; return. + ; Note. ( but [GRAPH] V gives RND, etc ). + + ; the jump was to here with extended mode with uppercase A-Z. + + ;;;$0341 +K_E_LET: LD HL,E_UNSHIFT-$41; base address of E_UNSHIFT-$41 + ; ( $01EB in standard ROM ) + INC B ; test B is it empty i.e. not a shift + JR Z,K_LOOK_UP ; forward to K_LOOK_UP if neither shift + + LD HL,EXT_SHIFT-$41; Address: $0205 EXT_SHIFT-$41 base + + ;;;$034A +K_LOOK_UP: LD D,$00 ; prepare to index + ADD HL,DE ; add the main key value + LD A,(HL) ; pick up other mode value + RET ; return + + ; the jump was here with mode = 0 + + ;;;$034F +K_KLC_LET: LD HL,SYM_CODES-$41; prepare base of SYM_CODES + BIT 0,B ; shift=$27 sym-shift=$18 + JR Z,K_LOOK_UP ; back to K_LOOK_UP with symbol-shift + + BIT 3,D ; test FLAGS is it 'K' mode (from OUT_CURS) + JR Z,K_TOKENS ; skip to K_TOKENS if so + + BIT 3,(IY+$30) ; test FLAGS2 - consider CAPS LOCK ? + RET NZ ; return if so with main code. + + INC B ; is shift being pressed ? + ; result zero if not + RET NZ ; return if shift pressed. + + ADD A,$20 ; else convert the code to lower case. + RET ; return. + + ; the jump was here for tokens + + ;;;$0364 +K_TOKENS: ADD A,$A5 ; add offset to main code so that 'A' + ; becomes 'NEW' etc. + RET ; return + + ; the jump was here with digits, space, enter and symbol shift (< $xx) + + ;;;$0367 +K_DIGIT: CP $30 ; is it '0' or higher ? + RET C ; return with space, enter and symbol-shift + + DEC C ; test MODE (was 0='KLC', 1='E', 2='G') + JP M,K_KLC_DGT ; jump to K_KLC_DGT if was 0. + + JR NZ,K_GRA_DGT ; forward to K_GRA_DGT if mode was 2. + + ; continue with extended digits 0-9. + + LD HL,E_DIGITS-$30 ; $0254 - base of E_DIGITS + BIT 5,B ; test - shift=$27 sym-shift=$18 + JR Z,K_LOOK_UP ; to K_LOOK_UP if sym-shift + + CP $38 ; is character '8' ? + JR NC,K_8_AND_9 ; to K_8_AND_9 if greater than '7' + + SUB $20 ; reduce to ink range $10-$17 + INC B ; shift ? + RET Z ; return if not. + + ADD A,$08 ; add 8 to give paper range $18 - $1F + RET ; return + + ; 89 + + ;;;$0382 +K_8_AND_9: SUB $36 ; reduce to 02 and 03 bright codes + INC B ; test if shift pressed. + RET Z ; return if not. + + ADD A,$FE ; subtract 2 setting carry + RET ; to give 0 and 1 flash codes. + + ; graphics mode with digits + + ;;;$0389 +K_GRA_DGT: LD HL,CTL_CODES-$30; $0230 base address of CTL_CODES + + CP $39 ; is key '9' ? + JR Z,K_LOOK_UP ; back to K_LOOK_UP - changed to $0F, GRAPHICS. + + CP $30 ; is key '0' ? + JR Z,K_LOOK_UP ; back to K_LOOK_UP - changed to $0C, delete. + + ; for keys '0' - '7' we assign a mosaic character depending on shift. + + AND $07 ; convert character to number. 0 - 7. + ADD A,$80 ; add offset - they start at $80 + INC B ; destructively test for shift + RET Z ; and return if not pressed. + + XOR $0F ; toggle bits becomes range $88-$8F + RET ; return. + + ; now digits in 'KLC' mode + + ;;;$039D +K_KLC_DGT: INC B ; return with digit codes if neither + RET Z ; shift key pressed. + + BIT 5,B ; test for caps shift. + LD HL,CTL_CODES-$30; prepare base of table CTL_CODES. + JR NZ,K_LOOK_UP ; back to K_LOOK_UP if shift pressed. + + ; must have been symbol shift + + SUB $10 ; for ascii most will now be correct + ; on a standard typewriter. + CP $22 ; but '@' is not - see below. + JR Z,K_AT_CHAR ; forward to to K_AT_CHAR if so + + CP $20 ; '_' is the other one that fails + RET NZ ; return if not. + + LD A,$5F ; substitute ascii '_' + RET ; return. + + ;;;$03B2 +K_AT_CHAR: LD A,$40 ; substitute ascii '@' + RET ; return. + + +;------------------------------------------------------------------------- +; The Spectrum Input character keys. One or two are abbreviated. +; From $00 Flash 0 to $FF COPY. The routine above has decoded all these. + +; | 00 Fl0| 01 Fl1| 02 Br0| 03 Br1| 04 In0| 05 In1| 06 CAP| 07 EDT| +; | 08 LFT| 09 RIG| 0A DWN| 0B UP | 0C DEL| 0D ENT| 0E SYM| 0F GRA| +; | 10 Ik0| 11 Ik1| 12 Ik2| 13 Ik3| 14 Ik4| 15 Ik5| 16 Ik6| 17 Ik7| +; | 18 Pa0| 19 Pa1| 1A Pa2| 1B Pa3| 1C Pa4| 1D Pa5| 1E Pa6| 1F Pa7| +; | 20 SP | 21 ! | 22 " | 23 # | 24 $ | 25 % | 26 & | 27 ' | +; | 28 ( | 29 ) | 2A * | 2B + | 2C , | 2D - | 2E . | 2F / | +; | 30 0 | 31 1 | 32 2 | 33 3 | 34 4 | 35 5 | 36 6 | 37 7 | +; | 38 8 | 39 9 | 3A : | 3B ; | 3C < | 3D = | 3E > | 3F ? | +; | 40 @ | 41 A | 42 B | 43 C | 44 D | 45 E | 46 F | 47 G | +; | 48 H | 49 I | 4A J | 4B K | 4C L | 4D M | 4E N | 4F O | +; | 50 P | 51 Q | 52 R | 53 S | 54 T | 55 U | 56 V | 57 W | +; | 58 X | 59 Y | 5A Z | 5B [ | 5C \ | 5D ] | 5E ^ | 5F _ | +; | 60 ukp| 61 a | 62 b | 63 c | 64 d | 65 e | 66 f | 67 g | +; | 68 h | 69 i | 6A j | 6B k | 6C l | 6D m | 6E n | 6F o | +; | 70 p | 71 q | 72 r | 73 s | 74 t | 75 u | 76 v | 77 w | +; | 78 x | 79 y | 7A z | 7B { | 7C | | 7D } | 7E ~ | 7F (c)| +; | 80 128| 81 129| 82 130| 83 131| 84 132| 85 133| 86 134| 87 135| +; | 88 136| 89 137| 8A 138| 8B 139| 8C 140| 8D 141| 8E 142| 8F 143| +; | 90 [A]| 91 [B]| 92 [C]| 93 [D]| 94 [E]| 95 [F]| 96 [G]| 97 [H]| +; | 98 [I]| 99 [J]| 9A [K]| 9B [L]| 9C [M]| 9D [N]| 9E [O]| 9F [P]| +; | A0 [Q]| A1 [R]| A2 [S]| A3 [T]| A4 [U]| A5 RND| A6 IK$| A7 PI | +; | A8 FN | A9 PNT| AA SC$| AB ATT| AC AT | AD TAB| AE VL$| AF COD| +; | B0 VAL| B1 LEN| B2 SIN| B3 COS| B4 TAN| B5 ASN| B6 ACS| B7 ATN| +; | B8 LN | B9 EXP| BA INT| BB SQR| BC SGN| BD ABS| BE PEK| BF IN | +; | C0 USR| C1 ST$| C2 CH$| C3 NOT| C4 BIN| C5 OR | C6 AND| C7 <= | +; | C8 >= | C9 <> | CA LIN| CB THN| CC TO | CD STP| CE DEF| CF CAT| +; | D0 FMT| D1 MOV| D2 ERS| D3 OPN| D4 CLO| D5 MRG| D6 VFY| D7 BEP| +; | D8 CIR| D9 INK| DA PAP| DB FLA| DC BRI| DD INV| DE OVR| DF OUT| +; | E0 LPR| E1 LLI| E2 STP| E3 REA| E4 DAT| E5 RES| E6 NEW| E7 BDR| +; | E8 CON| E9 DIM| EA REM| EB FOR| EC GTO| ED GSB| EE INP| EF LOA| +; | F0 LIS| F1 LET| F2 PAU| F3 NXT| F4 POK| F5 PRI| F6 PLO| F7 RUN| +; | F8 SAV| F9 RAN| FA IF | FB CLS| FC DRW| FD CLR| FE RET| FF CPY| + +; Note that for simplicity, Sinclair have located all the control codes +; below the space character. +; ascii DEL, $7F, has been made a copyright symbol. +; Also $60, '`', not used in Basic but used in other languages, has been +; allocated the local currency symbol for the relevant country - +; ukp in most Spectrums. + +;------------------------------------------------------------------------- + +;********************************** +;** Part 3. LOUDSPEAKER ROUTINES ** +;********************************** + + +; Documented by Alvin Albrecht. + + +;------------------------------- +; Routine to control loudspeaker +;------------------------------- +; Outputs a square wave of given duration and frequency +; to the loudspeaker. +; Enter with: DE = #cycles - 1 +; HL = tone period as described next +; +; The tone period is measured in T states and consists of +; three parts: a coarse part (H register), a medium part +; (bits 7..2 of L) and a fine part (bits 1..0 of L) which +; contribute to the waveform timing as follows: +; +; coarse medium fine +; duration of low = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3) +; duration of hi = 118 + 1024*H + 16*(L>>2) + 4*(L&0x3) +; Tp = tone period = 236 + 2048*H + 32*(L>>2) + 8*(L&0x3) +; = 236 + 2048*H + 8*L = 236 + 8*HL +; +; As an example, to output five seconds of middle C (261.624 Hz): +; (a) Tone period = 1/261.624 = 3.822ms +; (b) Tone period in T-States = 3.822ms*fCPU = 13378 +; where fCPU = clock frequency of the CPU = 3.5MHz +; (c) Find H and L for desired tone period: +; HL = (Tp - 236) / 8 = (13378 - 236) / 8 = 1643 = 0x066B +; (d) Tone duration in cycles = 5s/3.822ms = 1308 cycles +; DE = 1308 - 1 = 0x051B +; +; The resulting waveform has a duty ratio of exactly 50%. + + ;;;$03B5 +BEEPER: DI ; Disable Interrupts so they don't disturb timing + LD A,L + SRL L + SRL L ; L = medium part of tone period + CPL + AND $03 ; A = 3 - fine part of tone period + LD C,A + LD B,$00 + LD IX,BE_IX_3 ; Address: BE_IX_3 + ADD IX,BC ; IX holds address of entry into the loop + ; the loop will contain 0-3 NOPs, implementing + ; the fine part of the tone period. + LD A,(BORDCR) ; BORDCR + AND $38 ; bits 5..3 contain border colour + RRCA ; border colour bits moved to 2..0 + RRCA ; to match border bits on port #FE + RRCA + OR $08 ; bit 3 set (tape output bit on port #FE) + ; for loud sound output + ;;;$03D1 +BE_IX_3: NOP ;(4) ; optionally executed NOPs for small + ; adjustments to tone period + ;;;$03D2 +BE_IX_2: NOP ;(4) + ;;;$03D3 +BE_IX_1: NOP ;(4) + ;;;$03D4 +BE_IX_0: INC B ;(4) + INC C ;(4) + + ;;;$03D6 +BE_HL_LP: DEC C ;(4) ; timing loop for duration of + JR NZ,BE_HL_LP ;(12/7) ; high or low pulse of waveform + + LD C,$3F ;(7) + DEC B ;(4) + JP NZ,BE_HL_LP ;(10) ; to BE_HL_LP + + XOR $10 ;(7) ; toggle output beep bit + OUT ($FE),A ;(11) ; output pulse + LD B,H ;(4) ; B = coarse part of tone period + LD C,A ;(4) ; save port #FE output byte + BIT 4,A ;(8) ; if new output bit is high, go + JR NZ,BE_AGAIN ;(12/7) ; to BE_AGAIN + + LD A,D ;(4) ; one cycle of waveform has completed + OR E ;(4) ; (low->low). if cycle countdown = 0 + JR Z,BE_END ;(12/7) ; go to BE_END + + LD A,C ;(4) ; restore output byte for port #FE + LD C,L ;(4) ; C = medium part of tone period + DEC DE ;(6) ; decrement cycle count + JP (IX) ;(8) ; do another cycle + + ;;;$03F2; halfway through cycle +BE_AGAIN: LD C,L ;(4) ; C = medium part of tone period + INC C ;(4) ; adds 16 cycles to make duration of high = duration of low + JP (IX) ;(8) ; do high pulse of tone + + ;;;$03F6 +BE_END: EI ; Enable Interrupts + RET + + +;-------------------- +; Handle BEEP command +;-------------------- +; BASIC interface to BEEPER subroutine. +; Invoked in BASIC with: +; BEEP dur,pitch +; where dur = duration in seconds +; pitch = # of semitones above/below middle C +; +; Enter with: pitch on top of calculator stack +; duration next on calculator stack + + ;;;$03F8 +BEEP: RST 28H ;; FP_CALC + DEFB $31 ;;DUPLICATE ; duplicate pitch + DEFB $27 ;;INT ; convert to integer + DEFB $C0 ;;st-mem-0 ; store integer pitch to memory 0 + DEFB $03 ;;SUBTRACT ; calculate fractional part of pitch = fp_pitch - int_pitch + DEFB $34 ;;STK_DATA ; push constant + DEFB $EC ;;Exponent: $7C, Bytes: 4 ; constant = 0.05762265 + DEFB $6C,$98,$1F,$F5 ;;($6C,$98,$1F,$F5) + DEFB $04 ;;MULTIPLY ; compute: + DEFB $A1 ;;STK_ONE ; 1 + 0.05762265 * fraction_part(pitch) + DEFB $0F ;;ADDITION + DEFB $38 ;;END_CALC ; leave on calc stack + + LD HL,MEM_0 ; MEM_0: number stored here is in 16 bit integer format (pitch) + ; 0, 0/FF (pos/neg), LSB, MSB, 0 + ; LSB/MSB is stored in two's complement + ; In the following, the pitch is checked if it is in the range -128<=p<=127 + LD A,(HL) ; First byte must be zero, otherwise + AND A ; error in integer conversion + JR NZ,REPORT_B ; to REPORT_B + + INC HL + LD C,(HL) ; C = pos/neg flag = 0/FF + INC HL + LD B,(HL) ; B = LSB, two's complement + LD A,B + RLA + SBC A,A ; A = 0/FF if B is pos/neg + CP C ; must be the same as C if the pitch is -128<=p<=127 + JR NZ,REPORT_B ; if no, error REPORT_B + + INC HL ; if -128<=p<=127, MSB will be 0/FF if B is pos/neg + CP (HL) ; verify this + JR NZ,REPORT_B ; if no, error REPORT_B + ; now we know -128<=p<=127 + LD A,B ; A = pitch + 60 + ADD A,$3C ; if -60<=pitch<=67, + JP P,BE_I_OK ; goto BE_I_OK + + JP PO,REPORT_B ; if pitch <= 67 goto REPORT_B + ; lower bound of pitch set at -60 + + ;;;$0425; here, -60<=pitch<=127 + ; and A=pitch+60 -> 0<=A<=187 + +BE_I_OK: LD B,$FA ; 6 octaves below middle C + + ;;;$0427 ; A=# semitones above 5 octaves below middle C +BE_OCTAVE: INC B ; increment octave + SUB $0C ; 12 semitones = one octave + JR NC,BE_OCTAVE ; to BE_OCTAVE + + ADD A,$0C ; A = # semitones above C (0-11) + PUSH BC ; B = octave displacement from middle C, 2's complement: -5<=B<=10 + LD HL,SEMI_TONE ; Address: SEMI_TONE + CALL LOC_MEM ; routine LOC_MEM + ; HL = 5*A + $046E + CALL STACK_NUM ; routine STACK_NUM + ; read FP value (freq) from semitone table (HL) and push onto calc stack + + RST 28H ;; FP_CALC + DEFB $04 ;;MULTIPLY mult freq by 1 + 0.0576 * fraction_part(pitch) stacked earlier + ;; thus taking into account fractional part of pitch. + ;; the number 0.0576*frequency is the distance in Hz to the next + ;; note (verify with the frequencies recorded in the semitone + ;; table below) so that the fraction_part of the pitch does + ;; indeed represent a fractional distance to the next note. + DEFB $38 ;;END_CALC HL points to first byte of fp num on stack = middle frequency to generate + + POP AF ; A = octave displacement from middle C, 2's complement: -5<=A<=10 + ADD A,(HL) ; increase exponent by A (equivalent to multiplying by 2^A) + LD (HL),A + RST 28H ;; FP_CALC + DEFB $C0 ;;st-mem-0 ; store frequency in memory 0 + DEFB $02 ;;DELETE ; remove from calc stack + DEFB $31 ;;DUPLICATE ; duplicate duration (seconds) + DEFB $38 ;;END_CALC + + CALL FIND_INT1 ; routine FIND_INT1 ; FP duration to A + CP $0B ; if dur > 10 seconds, + JR NC,REPORT_B ; goto REPORT_B + + ;;; The following calculation finds the tone period for HL and the cycle count + ;;; for DE expected in the BEEPER subroutine. From the example in the BEEPER comments, + ;;; + ;;; HL = ((fCPU / f) - 236) / 8 = fCPU/8/f - 236/8 = 437500/f -29.5 + ;;; DE = duration * frequency - 1 + ;;; + ;;; Note the different constant (30.125) used in the calculation of HL + ;;; below. This is probably an error. + + RST 28H ;; FP_CALC + DEFB $E0 ;;get-mem-0 ; push frequency + DEFB $04 ;;MULTIPLY ; result1: #cycles = duration * frequency + DEFB $E0 ;;get-mem-0 ; push frequency + DEFB $34 ;;STK_DATA ; push constant + DEFB $80 ;;Exponent $93, Bytes: 3 ; constant = 437500 + DEFB $43,$55,$9F,$80 ;;($55,$9F,$80,$00) + DEFB $01 ;;EXCHANGE ; frequency on top + DEFB $05 ;;DIVISION ; 437500 / frequency + DEFB $34 ;;STK_DATA ; push constant + DEFB $35 ;;Exponent: $85, Bytes: 1 ; constant = 30.125 + DEFB $71 ;;($71,$00,$00,$00) + DEFB $03 ;;SUBTRACT ; result2: tone_period(HL) = 437500 / freq - 30.125 + DEFB $38 ;;END_CALC + + CALL FIND_INT2 ; routine FIND_INT2 + PUSH BC ; BC = tone_period(HL) + CALL FIND_INT2 ; routine FIND_INT2, BC = #cycles to generate + POP HL ; HL = tone period + LD D,B + LD E,C ; DE = #cycles + LD A,D + OR E + RET Z ; if duration = 0, skip BEEP and avoid 65536 cycle + ; boondoggle that would occur next + DEC DE ; DE = #cycles - 1 + JP BEEPER ; to BEEPER + + ;;;$046C +REPORT_B: RST 08H ; ERROR_1 + DEFB $0A ; Error Report: Integer out of range + + + +;---------------- +; Semi-tone table +;---------------- +; +; Holds frequencies corresponding to semitones in middle octave. +; To move n octaves higher or lower, frequencies are multiplied by 2^n. + +;;;$046E five byte fp decimal freq note (middle) +SEMI_TONE: DEFB $89, $02, $D0, $12, $86; 261.625565290 C + DEFB $89, $0A, $97, $60, $75; 277.182631135 C# + DEFB $89, $12, $D5, $17, $1F; 293.664768100 D + DEFB $89, $1B, $90, $41, $02; 311.126983881 D# + DEFB $89, $24, $D0, $53, $CA; 329.627557039 E + DEFB $89, $2E, $9D, $36, $B1; 349.228231549 F + DEFB $89, $38, $FF, $49, $3E; 369.994422674 F# + DEFB $89, $43, $FF, $6A, $73; 391.995436072 G + DEFB $89, $4F, $A7, $00, $54; 415.304697513 G# + DEFB $89, $5C, $00, $00, $00; 440.000000000 A + DEFB $89, $69, $14, $F6, $24; 466.163761616 A# + DEFB $89, $76, $F1, $10, $05; 493.883301378 B + + +;**************************************** +;** Part 4. CASSETTE HANDLING ROUTINES ** +;**************************************** + +; These routines begin with the service routines followed by a single +; command entry point. +; The first of these service routines is a curiosity. + +;------------------ +; ZX81_NAME routine +;------------------ +; This routine fetches a filename in ZX81 format. +; and is not used by the cassette handling routines in this ROM. + + ;;;$04AA +ZX81_NAME: CALL SCANNING ; routine SCANNING to evaluate expression. + LD A,(FLAGS) ; fetch system variable FLAGS. + ADD A,A ; test bit 7 - syntax, bit 6 - result type. + JP M,REPORT_C ; to REPORT_C if not string result + ; 'Nonsense in Basic'. + POP HL ; drop return address. + RET NC ; return early if checking syntax. + + PUSH HL ; re-save return address. + CALL STK_FETCH ; routine STK_FETCH fetches string parameters. + LD H,D ; transfer start of filename + LD L,E ; to the HL register. + DEC C ; adjust to point to last character and + RET M ; return if the null string. + ; or multiple of 256! + ADD HL,BC ; find last character of the filename. + ; and also clear carry. + SET 7,(HL) ; invert it. + RET ; return. + +; ========================================= +; +; PORT 254 ($FE) +; +; spk mic { border } +; ___ ___ ___ ___ ___ ___ ___ ___ +; PORT | | | | | | | | | +; 254 | | | | | | | | | +; $FE |___|___|___|___|___|___|___|___| +; 7 6 5 4 3 2 1 0 +; + +;----------------------------------- +; Save header and program/data bytes +;----------------------------------- +; This routine saves a section of data. It is called from SA-CTRL to save the +; seventeen bytes of header data. It is also the exit route from that routine +; when it is set up to save the actual data. +; On entry - +; HL points to start of data. +; IX points to descriptor. +; The accumulator is set to $00 for a header, $FF for data. + + ;;;$04C2 +SA_BYTES: LD HL,SA_LD_RET ; address: SA_LD_RET + PUSH HL ; is pushed as common exit route. + ; however there is only one non-terminal exit point. + LD HL,$1F80 ; a timing constant H=$1F, L=$80 + ; inner and outer loop counters + ; a five second lead-in is used for a header. + BIT 7,A ; test one bit of accumulator. + ; (AND A ?) + JR Z,SA_FLAG ; skip to SA_FLAG if a header is being saved. + + ; else is data bytes and a shorter lead-in is used. + + LD HL,$0C98 ; another timing value H=$0C, L=$98. + ; a two second lead-in is used for the data. + + ;;;$04D0 +SA_FLAG: EX AF,AF' ; save flag + INC DE ; increase length by one. + DEC IX ; decrease start. + DI ; disable interrupts + LD A,$02 ; select red for border, microphone bit on. + LD B,A ; also does as an initial slight counter value. + + ;;;$04D8 +SA_LEADER: DJNZ SA_LEADER ; self loop to SA_LEADER for delay. + ; after initial loop, count is $A4 (or $A3) + OUT ($FE),A ; output byte $02/$0D to tape port. + XOR $0F ; switch from RED (mic on) to CYAN (mic off). + LD B,$A4 ; hold count. also timed instruction. + DEC L ; originally $80 or $98. + ; but subsequently cycles 256 times. + JR NZ,SA_LEADER ; back to SA_LEADER until L is zero. + + ; the outer loop is counted by H + + DEC B ; decrement count + DEC H ; originally twelve or thirty-one. + JP P,SA_LEADER ; back to SA_LEADER until H becomes $FF + + ; now send a synch pulse. At this stage mic is off and A holds value + ; for mic on. + ; A synch pulse is much shorter than the steady pulses of the lead-in. + + LD B,$2F ; another short timed delay. + + ;;;$04EA +SA_SYNC_1: DJNZ SA_SYNC_1 ; self loop to SA_SYNC_1 + OUT ($FE),A ; switch to mic on and red. + LD A,$0D ; prepare mic off - cyan + LD B,$37 ; another short timed delay. + + ;;;$04F2 +SA_SYNC_2: DJNZ SA_SYNC_2 ; self loop to SA_SYNC_2 + OUT ($FE),A ; output mic off, cyan border. + LD BC,$3B0E ; B=$3B time(*), C=$0E, YELLOW, MIC OFF. + EX AF,AF' ; restore saved flag + ; which is 1st byte to be saved. + LD L,A ; and transfer to L. + ; the initial parity is A, $FF or $00. + JP SA_START ; jump forward to SA_START -> + ; the mid entry point of loop. + + ; ------------------------- + ; During the save loop a parity byte is maintained in H. + ; the save loop begins by testing if reduced length is zero and if so + ; the final parity byte is saved reducing count to $FFFF. + + ;;;$04FE +SA_LOOP: LD A,D ; fetch high byte + OR E ; test against low byte. + JR Z,SA_PARITY ; forward to SA_PARITY if zero. + + LD L,(IX+$00) ; load currently addressed byte to L. + + ;;;$0505 +SA_LOOP_P: LD A,H ; fetch parity byte. + XOR L ; exclusive or with new byte. + + ; -> the mid entry point of loop. + + ;;;$0507 +SA_START: LD H,A ; put parity byte in H. + LD A,$01 ; prepare blue, mic=on. + SCF ; set carry flag ready to rotate in. + JP SA_8_BITS ; jump forward to SA_8_BITS -8-> + + ;;;$050E +SA_PARITY: LD L,H ; transfer the running parity byte to L and + JR SA_LOOP_P ; back to SA_LOOP_P + ; to output that byte before quitting normally. + + ;-------------------------- + ; entry point to save yellow part of bit. + ; a bit consists of a period with mic on and blue border followed by + ; a period of mic off with yellow border. + ; Note. since the DJNZ instruction does not affect flags, the zero flag is used + ; to indicate which of the two passes is in effect and the carry maintains the + ; state of the bit to be saved. + + ;;;$0511 +SA_BIT_2: LD A,C ; fetch 'mic on and yellow' which is held permanently in C. + BIT 7,B ; set the zero flag. B holds $3E. + + ; entry point to save 1 entire bit. For first bit B holds $3B(*). + ; Carry is set if saved bit is 1. zero is reset NZ on entry. + + ;;;$0514 +SA_BIT_1: DJNZ SA_BIT_1 ; self loop for delay to SA_BIT_1 + JR NC,SA_OUT ; forward to SA_OUT if bit is 0. + + ; but if bit is 1 then the mic state is held for longer. + + LD B,$42 ; set timed delay. (66 decimal) + + ;;;$051A +SA_SET: DJNZ SA_SET ; self loop to SA_SET + ; (roughly an extra 66*13 clock cycles) + + ;;;$051C +SA_OUT: OUT ($FE),A ; blue and mic on OR yellow and mic off. + LD B,$3E ; set up delay + JR NZ,SA_BIT_2 ; back to SA_BIT_2 if zero reset NZ (first pass) + + ; proceed when the blue and yellow bands have been output. + + DEC B ; change value $3E to $3D. + XOR A ; clear carry flag (ready to rotate in). + INC A ; reset zero flag ie. NZ. + + ; -8-> + + ;;;$0525 +SA_8_BITS: RL L ; rotate left through carry + ; C<76543210 + + ; now test if byte counter has reached $FFFF. + + LD A,D ; fetch high byte + INC A ; increment. + JP NZ,SA_LOOP ; jump to SA_LOOP if more bytes. + + LD B,$3B ; a final delay. + + ;;;$053C +SA_DELAY: DJNZ SA_DELAY ; self loop to SA_DELAY + RET ; return - - > + +;--------------------------------------------------- +; Reset border and check BREAK key for LOAD and SAVE +;--------------------------------------------------- +; the address of this routine is pushed on the stack prior to any load/save +; operation and it handles normal completion with the restoration of the +; border and also abnormal termination when the break key, or to be more +; precise the space key is pressed during a tape operation. +; - - > + + ;;;$053F +SA_LD_RET: PUSH AF ; preserve accumulator throughout. + LD A,(BORDCR) ; fetch border colour from BORDCR. + AND $38 ; mask off paper bits. + RRCA ; rotate + RRCA ; to the + RRCA ; range 0-7. + OUT ($FE),A ; change the border colour. + LD A,$7F ; read from port address $7FFE the + IN A,($FE) ; row with the space key at outside. + RRA ; test for space key pressed. + EI ; enable interrupts + JR C,SA_LD_END ; forward to SA_LD_END if not + + ;;;$0552 +REPORT_DA: RST 08H ; ERROR_1 + DEFB $0C ; Error Report: BREAK - CONT repeats + + ;;;$0554 +SA_LD_END: POP AF ; restore the accumulator. + RET ; return. + +;------------------------------------- +; Load header or block of information +;------------------------------------- +; This routine is used to load bytes and on entry A is set to $00 for a +; header or to $FF for data. IX points to the start of receiving location +; and DE holds the length of bytes to be loaded. If, on entry the carry flag +; is set then data is loaded, if reset then it is verified. + + ;;;$0556 +LD_BYTES: INC D ; reset the zero flag without disturbing carry. + EX AF,AF' ; preserve entry flags. + DEC D ; restore high byte of length. + DI ; disable interrupts + LD A,$0F ; make the border white and mic off. + OUT ($FE),A ; output to port. + LD HL,SA_LD_RET ; Address: SA_LD_RET + PUSH HL ; is saved on stack as terminating routine. + + ; the reading of the EAR bit (D6) will always be preceded by a test of the + ; space key (D0), so store the initial post-test state. + + IN A,($FE) ; read the ear state - bit 6. + RRA ; rotate to bit 5. + AND $20 ; isolate this bit. + OR $02 ; combine with red border colour. + LD C,A ; and store initial state long-term in C. + CP A ; set the zero flag. + + ;;;$056B +LD_BREAK: RET NZ ; return if at any time space is pressed. + + ;;;$056C +LD_START: CALL LD_EDGE_1 ; routine LD_EDGE_1 + JR NC,LD_BREAK ; back to LD_BREAK with time out and no + ; edge present on tape. + + ; but continue when a transition is found on tape. + + LD HL,$0415 ; set up 16-bit outer loop counter for + ; approx 1 second delay. + + ;;;$0574 +LD_WAIT: DJNZ LD_WAIT ; self loop to LD_WAIT (for 256 times) + DEC HL ; decrease outer loop counter. + LD A,H ; test for + OR L ; zero. + JR NZ,LD_WAIT ; back to LD_WAIT, if not zero, with zero in B. + + ; continue after delay with H holding zero and B also. + ; sample 256 edges to check that we are in the middle of a lead-in section. + + CALL LD_EDGE_2 ; routine LD_EDGE_2 + JR NC,LD_BREAK ; back to LD_BREAK + ; if no edges at all. + + ;;;$0580 +LD_LEADER: LD B,$9C ; set timing value. + CALL LD_EDGE_2 ; routine LD_EDGE_2 + JR NC,LD_BREAK ; back to LD_BREAK if time-out + + LD A,$C6 ; two edges must be spaced apart. + CP B ; compare + JR NC,LD_START ; back to LD_START if too close together for a + ; lead-in. + INC H ; proceed to test 256 edged sample. + JR NZ,LD_LEADER ; back to LD_LEADER while more to do. + + ; sample indicates we are in the middle of a two or five second lead-in. + ; Now test every edge looking for the terminal synch signal. + + ;;;$058F +LD_SYNC: LD B,$C9 ; initial timing value in B. + CALL LD_EDGE_1 ; routine LD_EDGE_1 + JR NC,LD_BREAK ; back to LD_BREAK with time-out. + + LD A,B ; fetch augmented timing value from B. + CP $D4 ; compare + JR NC,LD_SYNC ; back to LD_SYNC if gap too big, that is, + ; a normal lead-in edge gap. + + ; but a short gap will be the synch pulse. + ; in which case another edge should appear before B rises to $FF + + CALL LD_EDGE_1 ; routine LD_EDGE_1 + RET NC ; return with time-out. + + ; proceed when the synch at the end of the lead-in is found. + ; We are about to load data so change the border colours. + + LD A,C ; fetch long-term mask from C + XOR $03 ; and make blue/yellow. + LD C,A ; store the new long-term byte. + LD H,$00 ; set up parity byte as zero. + LD B,$B0 ; timing. + JR LD_MARKER ; forward to LD_MARKER + ; the loop mid entry point with the alternate + ; zero flag reset to indicate first byte + ; is discarded. + + ; the loading loop loads each byte and is entered at the mid point. + + ;;;$05A9 +LD_LOOP: EX AF,AF' ; restore entry flags and type in A. + JR NZ,LD_FLAG ; forward to LD_FLAG if awaiting initial flag + ; which is to be discarded. + JR NC,LD_VERIFY ; forward to LD_VERIFY if not to be loaded. + + LD (IX+$00),L ; place loaded byte at memory location. + JR LD_NEXT ; forward to LD_NEXT + + ;;;$05B3 +LD_FLAG: RL C ; preserve carry (verify) flag in long-term + ; state byte. Bit 7 can be lost. + XOR L ; compare type in A with first byte in L. + RET NZ ; return if no match e.g. CODE vs DATA. + + ; continue when data type matches. + + LD A,C ; fetch byte with stored carry + RRA ; rotate it to carry flag again + LD C,A ; restore long-term port state. + INC DE ; increment length ?? + JR LD_DEC ; forward to LD_DEC. + ; but why not to location after ? + + ; for verification the byte read from tape is compared with that in memory. + + ;;;$05BD +LD_VERIFY: LD A,(IX+$00) ; fetch byte from memory. + XOR L ; compare with that on tape + RET NZ ; return if not zero. + + ;;;$05C2 +LD_NEXT: INC IX ; increment byte pointer. + + ;;;$05C4 +LD_DEC: DEC DE ; decrement length. + EX AF,AF' ; store the flags. + LD B,$B2 ; timing. + + ; when starting to read 8 bits the receiving byte is marked with bit at right. + ; when this is rotated out again then 8 bits have been read. + + ;;;$05C8 +LD_MARKER: LD L,$01 ; initialize as %00000001 + + ;;;$05CA +LD_8_BITS: CALL LD_EDGE_2 ; routine LD_EDGE_2 increments B relative to + ; gap between 2 edges. + RET NC ; return with time-out. + + LD A,$CB ; the comparison byte. + CP B ; compare to incremented value of B. + ; if B is higher then bit on tape was set. + ; if <= then bit on tape is reset. + + RL L ; rotate the carry bit into L. + LD B,$B0 ; reset the B timer byte. + JP NC,LD_8_BITS ; jump back to LD_8_BITS + + ; when carry set then marker bit has been passed out and byte is complete. + + LD A,H ; fetch the running parity byte. + XOR L ; include the new byte. + LD H,A ; and store back in parity register. + LD A,D ; check length of + OR E ; expected bytes. + JR NZ,LD_LOOP ; back to LD_LOOP + ; while there are more. + + ; when all bytes loaded then parity byte should be zero. + + LD A,H ; fetch parity byte. + CP $01 ; set carry if zero. + RET ; return + ; in no carry then error as checksum disagrees. + +;-------------------------- +; Check signal being loaded +;-------------------------- +; An edge is a transition from one mic state to another. +; More specifically a change in bit 6 of value input from port $FE. +; Graphically it is a change of border colour, say, blue to yellow. +; The first entry point looks for two adjacent edges. The second entry point +; is used to find a single edge. +; The B register holds a count, up to 256, within which the edge (or edges) +; must be found. The gap between two edges will be more for a '1' than a '0' +; so the value of B denotes the state of the bit (two edges) read from tape. + + ; -> + + ;;;$05E3 +LD_EDGE_2: CALL LD_EDGE_1 ; call routine LD_EDGE_1 below. + RET NC ; return if space pressed or time-out. + ; else continue and look for another adjacent + ; edge which together represent a bit on the + ; tape. + + ; -> + ; this entry point is used to find a single edge from above but also + ; when detecting a read-in signal on the tape. + + ;;;$05E7 +LD_EDGE_1: LD A,$16 ; a delay value of twenty two. + + ;;;$05E9 +LD_DELAY: DEC A ; decrement counter + JR NZ,LD_DELAY ; loop back to LD_DELAY 22 times. + + AND A ; clear carry. + + ;;;$05ED +LD_SAMPLE: INC B ; increment the time-out counter. + RET Z ; return with failure when $FF passed. + + LD A,$7F ; prepare to read keyboard and EAR port + IN A,($FE) ; row $7FFE. bit 6 is EAR, bit 0 is SPACE key. + RRA ; test outer key the space. (bit 6 moves to 5) + RET NC ; return if space pressed. >>> + + XOR C ; compare with initial long-term state. + AND $20 ; isolate bit 5 + JR Z,LD_SAMPLE ; back to LD_SAMPLE if no edge. + + ; but an edge, a transition of the EAR bit, has been found so switch the + ; long-term comparison byte containing both border colour and EAR bit. + + LD A,C ; fetch comparison value. + CPL ; switch the bits + LD C,A ; and put back in C for long-term. + AND $07 ; isolate new colour bits. + OR $08 ; set bit 3 - MIC off. + OUT ($FE),A ; send to port to effect change of colour. + SCF ; set carry flag signalling edge found within + ; time allowed. + RET ; return. + +;---------------------------------- +; Entry point for all tape commands +;---------------------------------- +; This is the single entry point for the four tape commands. +; The routine first determines in what context it has been called by examining +; the low byte of the Syntax table entry which was stored in T_ADDR. +; Subtracting $EO (the present arrangement) gives a value of +; $00 - SAVE +; $01 - LOAD +; $02 - VERIFY +; $03 - MERGE +; As with all commands the address STMT_RET is on the stack. + + ;;;$0605 +SAVE_ETC: POP AF ; discard address STMT_RET. + LD A,(T_ADDR) ; fetch T_ADDR + + ; Now reduce the low byte of the Syntax table entry to give command. + + SUB $E0 ; subtract the known offset - giving 0 for SAVE, + ; 1 for LOAD, 2 for VERIFY and 3 for MERGE + LD (T_ADDR),A ; and put back in T_ADDR as 0,1,2, or 3 + ; for future reference. + CALL EXPT_EXP ; routine EXPT_EXP checks that a string + ; expression follows and stacks the + ; parameters in run-time. + CALL SYNTAX_Z ; routine SYNTAX_Z + JR Z,SA_DATA ; forward to SA_DATA if checking syntax. + + LD BC,$0011 ; presume seventeen bytes for a header. + LD A,(T_ADDR) ; fetch command from T_ADDR. + AND A ; test for zero - SAVE. + JR Z,SA_SPACE ; forward to SA_SPACE if so. + + LD C,$22 ; else double length to thirty four. + + ;;;$0621 +SA_SPACE: RST 30H ; BC_SPACES creates 17/34 bytes in workspace. + PUSH DE ; transfer the start of new space to + POP IX ; the available index register. + + ; ten spaces are required for the default filename but it is simpler to + ; overwrite the first file-type indicator byte as well. + + LD B,$0B ; set counter to eleven. + LD A,$20 ; prepare a space. + + ;;;$0629 +SA_BLANK: LD (DE),A ; set workspace location to space. + INC DE ; next location. + DJNZ SA_BLANK ; loop back to SA_BLANK till all eleven done. + LD (IX+$01),$FF ; set first byte of ten character filename + ; to $FF as a default to signal null string. + CALL STK_FETCH ; routine STK_FETCH fetches the filename + ; parameters from the calculator stack. + ; length of string in BC. + ; start of string in DE. + LD HL,$FFF6 ; prepare the value minus ten. + DEC BC ; decrement length. + ; ten becomes nine, zero becomes $FFFF. + ADD HL,BC ; trial addition. + INC BC ; restore true length. + JR NC,SA_NAME ; forward to SA_NAME if length is one to ten. + + ; the filename is more than ten characters in length or the null string. + + LD A,(T_ADDR) ; fetch command from T_ADDR. + AND A ; test for zero - SAVE. + JR NZ,SA_NULL ; forward to SA_NULL if not the SAVE command. + + ; but no more than ten characters are allowed for SAVE. + ; The first ten characters of any other command parameter are acceptable. + ; Weird, but necessary, if saving to sectors. + ; Note. the golden rule that there are no restriction on anything is broken. + + ;;;$0642 +REPORT_FA: RST 08H ; ERROR_1 + DEFB $0E ; Error Report: Invalid file name + + ; continue with LOAD, MERGE, VERIFY and also SAVE within ten character limit. + + ;;;$0644 +SA_NULL: LD A,B ; test length of filename + OR C ; for zero. + JR Z,SA_DATA ; forward to SA_DATA if so using the 255 + ; indicator followed by spaces. + LD BC,$000A ; else trim length to ten. + + ; other paths rejoin here with BC holding length in range 1 - 10. + + ;;;$064B +SA_NAME: PUSH IX ; push start of file descriptor. + POP HL ; and pop into HL. + INC HL ; HL now addresses first byte of filename. + EX DE,HL ; transfer destination address to DE, start + ; of string in command to HL. + LDIR ; copy up to ten bytes + ; if less than ten then trailing spaces follow. + + ; the case for the null string rejoins here. + + ;;;$0652 +SA_DATA: RST 18H ; GET_CHAR + CP $E4 ; is character after filename the token 'DATA' ? + JR NZ,SA_SCR ; forward to SA_SCR to consider SCREEN$ if not. + + ; continue to consider DATA. + + LD A,(T_ADDR) ; fetch command from T_ADDR + CP $03 ; is it 'VERIFY' ? + JP Z,REPORT_C ; jump forward to REPORT_C if so. + ; 'Nonsense in basic' + ; VERIFY "d" DATA is not allowed. + + ; continue with SAVE, LOAD, MERGE of DATA. + + RST 20H ; NEXT_CHAR + CALL LOOK_VARS ; routine LOOK_VARS searches variables area + ; returning with carry reset if found or + ; checking syntax. + SET 7,C ; this converts a simple string to a + ; string array. The test for an array or string + ; comes later. + JR NC,SA_V_OLD ; forward to SA_V_OLD if variable found. + + LD HL,$0000 ; set destination to zero as not fixed. + LD A,(T_ADDR) ; fetch command from T_ADDR + DEC A ; test for 1 - LOAD + JR Z,SA_V_NEW ; forward to SA_V_NEW with LOAD DATA. + ; to load a new array. + + ; otherwise the variable was not found in run-time with SAVE/MERGE. + + ;;;$0670 +REPORT_2A: RST 08H ; ERROR_1 + DEFB $01 ; Error Report: Variable not found + + ; continue with SAVE/LOAD DATA + + ;;;$0672 +SA_V_OLD: JP NZ,REPORT_C ; to REPORT_C if not an array variable. + ; or erroneously a simple string. + ; 'Nonsense in basic' + + + CALL SYNTAX_Z ; routine SYNTAX_Z + JR Z,SA_DATA_1 ; forward to SA_DATA_1 if checking syntax. + + INC HL ; step past single character variable name. + LD A,(HL) ; fetch low byte of length. + LD (IX+$0B),A ; place in descriptor. + INC HL ; point to high byte. + LD A,(HL) ; and transfer that + LD (IX+$0C),A ; to descriptor. + INC HL ; increase pointer within variable. + + ;;;$0685 +SA_V_NEW: LD (IX+$0E),C ; place character array name in header. + LD A,$01 ; default to type numeric. + BIT 6,C ; test result from LOOK_VARS. + JR Z,SA_V_TYPE ; forward to SA_V_TYPE if numeric. + + INC A ; set type to 2 - string array. + + ;;;$068F +SA_V_TYPE: LD (IX+$00),A ; place type 0, 1 or 2 in descriptor. + + ;;;$0692 +SA_DATA_1: EX DE,HL ; save var pointer in DE + + RST 20H ; NEXT_CHAR + CP $29 ; is character ')' ? + JR NZ,SA_V_OLD ; back if not to SA_V_OLD to report + ; 'Nonsense in basic' + + RST 20H ; NEXT_CHAR advances character address. + CALL CHECK_END ; routine CHECK_END errors if not end of the statement. + EX DE,HL ; bring back variables data pointer. + JP SA_ALL ; jump forward to SA_ALL + + ; the branch was here to consider a 'SCREEN$', the display file. + + ;;;$06A0 +SA_SCR: CP $AA ; is character the token 'SCREEN$' ? + JR NZ,SA_CODE ; forward to SA_CODE if not. + + LD A,(T_ADDR) ; fetch command from T_ADDR + CP $03 ; is it MERGE ? + JP Z,REPORT_C ; jump to REPORT_C if so. + ; 'Nonsense in basic' + + ; continue with SAVE/LOAD/VERIFY SCREEN$. + + RST 20H ; NEXT_CHAR + CALL CHECK_END ; routine CHECK_END errors if not at end of + ; statement. + + ; continue in runtime. + + LD (IX+$0B),$00 ; set descriptor length + LD (IX+$0C),$1B ; to $1b00 to include bitmaps and attributes. + LD HL,$4000 ; set start to display file start. + LD (IX+$0D),L ; place start in + LD (IX+$0E),H ; the descriptor. + JR SA_TYPE_3 ; forward to SA_TYPE_3 + + ; the branch was here to consider CODE. + + ;;;$06C3 +SA_CODE: CP $AF ; is character the token 'CODE' ? + JR NZ,SA_LINE ; forward if not to SA_LINE to consider an + ; auto-started basic program. + LD A,(T_ADDR) ; fetch command from T_ADDR + CP $03 ; is it MERGE ? + JP Z,REPORT_C ; jump forward to REPORT_C if so. + ; 'Nonsense in basic' + + RST 20H ; NEXT_CHAR advances character address. + CALL PR_ST_END ; routine PR_ST_END checks if a carriage + ; return or ':' follows. + JR NZ,SA_CODE_1 ; forward to SA_CODE_1 if there are parameters. + + LD A,(T_ADDR) ; else fetch the command from T_ADDR. + AND A ; test for zero - SAVE without a specification. + JP Z,REPORT_C ; jump to REPORT_C if so. + ; 'Nonsense in basic' + + ; for LOAD/VERIFY put zero on stack to signify handle at location saved from. + + CALL USE_ZERO ; routine USE_ZERO + JR SA_CODE_2 ; forward to SA_CODE_2 + + ; if there are more characters after CODE expect start and possibly length. + + ;;;$06E1 +SA_CODE_1: CALL EXPT_1NUM ; routine EXPT_1NUM checks for numeric + ; expression and stacks it in run-time. + RST 18H ; GET_CHAR + CP $2C ; does a comma follow ? + JR Z,SA_CODE_3 ; forward if so to SA_CODE_3 + + ; else allow saved code to be loaded to a specified address. + + LD A,(T_ADDR) ; fetch command from T_ADDR. + AND A ; is the command SAVE which requires length ? + JP Z,REPORT_C ; jump to REPORT_C if so. + ; 'Nonsense in basic' + + ; the command LOAD code may rejoin here with zero stacked as start. + + ;;;$06F0 +SA_CODE_2: CALL USE_ZERO ; routine USE_ZERO stacks zero for length. + JR SA_CODE_4 ; forward to SA_CODE_4 + + ; the branch was here with SAVE CODE start, + + ;;;$06F5 +SA_CODE_3: RST 20H ; NEXT_CHAR advances character address. + CALL EXPT_1NUM ; routine EXPT_1NUM checks for expression + ; and stacks in run-time. + + ; paths converge here and nothing must follow. + + ;;;$06F9 +SA_CODE_4: CALL CHECK_END ; routine CHECK_END errors with extraneous + ; characters and quits if checking syntax. + + ; in run-time there are two 16-bit parameters on the calculator stack. + + CALL FIND_INT2 ; routine FIND_INT2 gets length. + LD (IX+$0B),C ; place length + LD (IX+$0C),B ; in descriptor. + CALL FIND_INT2 ; routine FIND_INT2 gets start. + LD (IX+$0D),C ; place start + LD (IX+$0E),B ; in descriptor. + LD H,B ; transfer the + LD L,C ; start to HL also. + + ;;;$0710 +SA_TYPE_3: LD (IX+$00),$03 ; place type 3 - code in descriptor. + JR SA_ALL ; forward to SA_ALL. + + + ; the branch was here with basic to consider an optional auto-start line number. + + ;;;$0716 +SA_LINE: CP $CA ; is character the token 'LINE' ? + JR Z,SA_LINE_1 ; forward to SA_LINE_1 if so. + + ; else all possibilities have been considered and nothing must follow. + + CALL CHECK_END ; routine CHECK_END + + ; continue in run-time to save basic without auto-start. + + LD (IX+$0E),$80 ; place high line number in descriptor to disable auto-start. + JR SA_TYPE_0 ; forward to SA_TYPE_0 to save program. + + ; the branch was here to consider auto-start. + + ;;;$0723 +SA_LINE_1: LD A,(T_ADDR) ; fetch command from T_ADDR + AND A ; test for SAVE. + JP NZ,REPORT_C ; jump forward to REPORT_C with anything else. + ; 'Nonsense in basic' + RST 20H ; NEXT_CHAR + CALL EXPT_1NUM ; routine EXPT_1NUM checks for numeric + ; expression and stacks in run-time. + CALL CHECK_END ; routine CHECK_END quits if syntax path. + CALL FIND_INT2 ; routine FIND_INT2 fetches the numeric expression. + LD (IX+$0D),C ; place the auto-start + LD (IX+$0E),B ; line number in the descriptor. + + ; Note. this isn't checked, but is subsequently handled by the system. + ; If the user typed 40000 instead of 4000 then it won't auto-start + ; at line 4000, or indeed, at all. + + ; continue to save program and any variables. + + ;;;$073A +SA_TYPE_0: LD (IX+$00),$00 ; place type zero - program in descriptor. + LD HL,(E_LINE) ; fetch E_LINE to HL. + LD DE,(PROG) ; fetch PROG to DE. + SCF ; set carry flag to calculate from end of + ; variables E_LINE -1. + SBC HL,DE ; subtract to give total length. + LD (IX+$0B),L ; place total length + LD (IX+$0C),H ; in descriptor. + LD HL,(VARS) ; load HL from system variable VARS + SBC HL,DE ; subtract to give program length. + LD (IX+$0F),L ; place length of program + LD (IX+$10),H ; in the descriptor. + EX DE,HL ; start to HL, length to DE. + + ;;;$075A +SA_ALL: LD A,(T_ADDR) ; fetch command from T_ADDR + AND A ; test for zero - SAVE. + JP Z,SA_CONTRL ; jump forward to SA_CONTRL with SAVE -> + + ; continue with LOAD, MERGE and VERIFY. + + PUSH HL ; save start. + LD BC,$0011 ; prepare to add seventeen + ADD IX,BC ; to point IX at second descriptor. + + ;;;$0767 +LD_LOOK_H: PUSH IX ; save IX + LD DE,$0011 ; seventeen bytes + XOR A ; reset zero flag + SCF ; set carry flag + CALL LD_BYTES ; routine LD_BYTES loads a header from tape + ; to second descriptor. + POP IX ; restore IX. + JR NC,LD_LOOK_H ; loop back to LD_LOOK_H until header found. + + LD A,$FE ; select system channel 'S' + CALL CHAN_OPEN ; routine CHAN_OPEN opens it. + LD (IY+$52),$03 ; set SCR_CT to 3 lines. + LD C,$80 ; C has bit 7 set to indicate type mismatch as + ; a default startpoint. + LD A,(IX+$00) ; fetch loaded header type to A + CP (IX-$11) ; compare with expected type. + JR NZ,LD_TYPE ; forward to LD_TYPE with mis-match. + + LD C,$F6 ; set C to minus ten - will count characters up to zero. + + ;;;$078A +LD_TYPE: CP $04 ; check if type in acceptable range 0 - 3. + JR NC,LD_LOOK_H ; back to LD_LOOK_H with 4 and over. + + ; else A indicates type 0-3. + + LD DE,TAPE_MSGS2 ; address base of last 4 tape messages + PUSH BC ; save BC + CALL PO_MSG ; routine PO_MSG outputs relevant message. + ; Note. all messages have a leading newline. + POP BC ; restore BC + PUSH IX ; transfer IX, + POP DE ; the 2nd descriptor, to DE. + LD HL,$FFF0 ; prepare minus seventeen. + ADD HL,DE ; add to point HL to 1st descriptor. + LD B,$0A ; the count will be ten characters for the filename. + LD A,(HL) ; fetch first character and test for + INC A ; value 255. + JR NZ,LD_NAME ; forward to LD_NAME if not the wildcard. + + ; but if it is the wildcard, then add ten to C which is minus ten for a type + ; match or -128 for a type mismatch. Although characters have to be counted + ; bit 7 of C will not alter from state set here. + + LD A,C ; transfer $F6 or $80 to A + ADD A,B ; add $0A + LD C,A ; place result, zero or -118, in C. + + ; At this point we have either a type mismatch, a wildcard match or ten + ; characters to be counted. The characters must be shown on the screen. + + ;;;$07A6 +LD_NAME: INC DE ; address next input character + LD A,(DE) ; fetch character + CP (HL) ; compare to expected + INC HL ; address next expected character + JR NZ,LD_CH_PR ; forward to LD_CH_PR with mismatch + + INC C ; increment matched character count + + ;;;$07AD +LD_CH_PR: RST 10H ; PRINT_A prints character + DJNZ LD_NAME ; loop back to LD_NAME for ten characters. + + ; if ten characters matched and the types previously matched then C will + ; now hold zero. + + BIT 7,C ; test if all matched + JR NZ,LD_LOOK_H ; back to LD_LOOK_H if not + + ; else print a terminal carriage return. + + LD A,$0D ; prepare carriage return. + RST 10H ; PRINT_A outputs it. + + ; The various control routines for LOAD, VERIFY and MERGE are executed + ; during the one-second gap following the header on tape. + + POP HL ; restore xx + LD A,(IX+$00) ; fetch incoming type + CP $03 ; compare with CODE + JR Z,VR_CONTROL ; forward to VR_CONTROL if it is CODE. + + ; type is a program or an array. + + LD A,(T_ADDR) ; fetch command from T_ADDR + DEC A ; was it LOAD ? + JP Z,LD_CONTRL ; jump forward to LD_CONTRL if so to + ; load BASIC or variables. + CP $02 ; was command MERGE ? + JP Z,ME_CONTRL ; jump forward to ME_CONTRL if so. + + ; else continue into VERIFY control routine to verify. + +;---------------------- +; Handle VERIFY control +;---------------------- +; There are two branches to this routine. +; 1) From above to verify a program or array +; 2) from earlier with no carry to load or verify code. + + ;;;$07CB +VR_CONTROL: PUSH HL ; save pointer to data. + LD L,(IX-$06) ; fetch length of old data + LD H,(IX-$05) ; to HL. + LD E,(IX+$0B) ; fetch length of new data + LD D,(IX+$0C) ; to DE. + LD A,H ; check length of old + OR L ; for zero. + JR Z,VR_CONT_1 ; forward to VR_CONT_1 if length unspecified + ; e.g LOAD "x" CODE + + ; as opposed to, say, LOAD 'x' CODE 32768,300. + + SBC HL,DE ; subtract the two lengths. + JR C,REPORT_R ; forward to REPORT_R if the length on tape is + ; larger than that specified in command. + ; 'Tape loading error' + + JR Z,VR_CONT_1 ; forward to VR_CONT_1 if lengths match. + + ; a length on tape shorter than expected is not allowed for CODE + + LD A,(IX+$00) ; else fetch type from tape. + CP $03 ; is it CODE ? + JR NZ,REPORT_R ; forward to REPORT_R if so + ; 'Tape loading error' + + ;;;$07E9 +VR_CONT_1: POP HL ; pop pointer to data + LD A,H ; test for zero + OR L ; e.g. LOAD 'x' CODE + JR NZ,VR_CONT_2 ; forward to VR_CONT_2 if destination specified. + + LD L,(IX+$0D) ; else use the destination in the header + LD H,(IX+$0E) ; and load code at address saved from. + + ;;;$07F4 +VR_CONT_2: PUSH HL ; push pointer to start of data block. + POP IX ; transfer to IX. + LD A,(T_ADDR) ; fetch reduced command from T_ADDR + CP $02 ; is it VERIFY ? + SCF ; prepare a set carry flag + JR NZ,VR_CONT_3 ; skip to VR_CONT_3 if not + + AND A ; clear carry flag for VERIFY so that + ; data is not loaded. + + ;;;$0800 +VR_CONT_3: LD A,$FF ; signal data block to be loaded + +;------------------ +; Load a data block +;------------------ +; This routine is called from 3 places other than above to load a data block. +; In all cases the accumulator is first set to $FF so the routine could be +; called at the previous instruction. + + ;;;$0802 +LD_BLOCK: CALL LD_BYTES ; routine LD_BYTES + RET C ; return if successful. + + + ;;;$0806 +REPORT_R: RST 08H ; ERROR_1 + DEFB $1A ; Error Report: Tape loading error + +;-------------------- +; Handle LOAD control +;-------------------- +; This branch is taken when the command is LOAD with type 0, 1 or 2. + + ;;;$0808 +LD_CONTRL: LD E,(IX+$0B) ; fetch length of found data block + LD D,(IX+$0C) ; from 2nd descriptor. + PUSH HL ; save destination + LD A,H ; test for zero + OR L + JR NZ,LD_CONT_1 ; forward if not to LD_CONT_1 + + INC DE ; increase length + INC DE ; for letter name + INC DE ; and 16-bit length + EX DE,HL ; length to HL, + JR LD_CONT_2 ; forward to LD_CONT_2 + + ;;;$0819 +LD_CONT_1: LD L,(IX-$06) ; fetch length from + LD H,(IX-$05) ; the first header. + EX DE,HL + SCF ; set carry flag + SBC HL,DE + JR C,LD_DATA ; to LD_DATA + + ;;;$0825 +LD_CONT_2: LD DE,$0005 ; allow overhead of five bytes. + ADD HL,DE ; add in the difference in data lengths. + LD B,H ; transfer to + LD C,L ; the BC register pair + CALL TEST_ROOM ; routine TEST_ROOM fails if not enough room. + + ;;;$082E +LD_DATA: POP HL ; pop destination + LD A,(IX+$00) ; fetch type 0, 1 or 2. + AND A ; test for program and variables. + JR Z,LD_PROG ; forward if so to LD_PROG + + ; the type is a numeric or string array. + + LD A,H ; test the destination for zero + OR L ; indicating variable does not already exist. + JR Z,LD_DATA_1 ; forward if so to LD_DATA_1 + + ; else the destination is the first dimension within the array structure + + DEC HL ; address high byte of total length + LD B,(HL) ; transfer to B. + DEC HL ; address low byte of total length. + LD C,(HL) ; transfer to C. + DEC HL ; point to letter of variable. + INC BC ; adjust length to + INC BC ; include these + INC BC ; three bytes also. + LD (X_PTR),IX ; save header pointer in X_PTR. + CALL RECLAIM_2 ; routine RECLAIM_2 reclaims the old variable + ; sliding workspace including the two headers downwards. + LD IX,(X_PTR) ; reload IX from X_PTR which will have been + ; adjusted down by POINTERS routine. + + ;;;$084C +LD_DATA_1: LD HL,(E_LINE) ; address E_LINE + DEC HL ; now point to the $80 variables end-marker. + LD C,(IX+$0B) ; fetch new data length + LD B,(IX+$0C) ; from 2nd header. + PUSH BC ; * save it. + INC BC ; adjust the + INC BC ; length to include + INC BC ; letter name and total length. + LD A,(IX-$03) ; fetch letter name from old header. + PUSH AF ; preserve accumulator though not corrupted. + CALL MAKE_ROOM ; routine MAKE_ROOM creates space for variable + ; sliding workspace up. IX no longer addresses + ; anywhere meaningful. + INC HL ; point to first new location. + POP AF ; fetch back the letter name. + LD (HL),A ; place in first new location. + POP DE ; * pop the data length. + INC HL ; address 2nd location + LD (HL),E ; store low byte of length. + INC HL ; address next. + LD (HL),D ; store high byte. + INC HL ; address start of data. + PUSH HL ; transfer address + POP IX ; to IX register pair. + SCF ; set carry flag indicating load not verify. + LD A,$FF ; signal data not header. + JP LD_BLOCK ; jump back to LD_BLOCK + + ; the branch is here when a program as opposed to an array is to be loaded. + + ;;;$0873 +LD_PROG: EX DE,HL ; transfer dest to DE. + LD HL,(E_LINE) ; address E_LINE + DEC HL ; now variables end-marker. + LD (X_PTR),IX ; place the IX header pointer in X_PTR + LD C,(IX+$0B) ; get new length + LD B,(IX+$0C) ; from 2nd header + PUSH BC ; and save it. + CALL RECLAIM_1 ; routine RECLAIM_1 reclaims program and vars. + ; adjusting X_PTR. + POP BC ; restore new length. + PUSH HL ; * save start + PUSH BC ; ** and length. + CALL MAKE_ROOM ; routine MAKE_ROOM creates the space. + LD IX,(X_PTR) ; reload IX from adjusted X_PTR + INC HL ; point to start of new area. + LD C,(IX+$0F) ; fetch length of BASIC on tape + LD B,(IX+$10) ; from 2nd descriptor + ADD HL,BC ; add to address the start of variables. + LD (VARS),HL ; set system variable VARS + LD H,(IX+$0E) ; fetch high byte of autostart line number. + LD A,H ; transfer to A + AND $C0 ; test if greater than $3F. + JR NZ,LD_PROG_1 ; forward to LD_PROG_1 if so with no autostart. + + LD L,(IX+$0D) ; else fetch the low byte. + LD (NEWPPC),HL ; set sytem variable to line number NEWPPC + LD (IY+$0A),$00 ; set statement NSPPC to zero. + + ;;;$08AD +LD_PROG_1: POP DE ; ** pop the length + POP IX ; * and start. + SCF ; set carry flag + LD A,$FF ; signal data as opposed to a header. + JP LD_BLOCK ; jump back to LD_BLOCK + +;--------------------- +; Handle MERGE control +;--------------------- +; the branch was here to merge a program and it's variables or an array. + + ;;;$08B6 +ME_CONTRL: LD C,(IX+$0B) ; fetch length + LD B,(IX+$0C) ; of data block on tape. + PUSH BC ; save it. + INC BC ; one for the pot. + RST 30H ; BC_SPACES creates room in workspace. + ; HL addresses last new location. + LD (HL),$80 ; place end-marker at end. + EX DE,HL ; transfer first location to HL. + POP DE ; restore length to DE. + PUSH HL ; save start. + PUSH HL ; and transfer it + POP IX ; to IX register. + SCF ; set carry flag to load data on tape. + LD A,$FF ; signal data not a header. + CALL LD_BLOCK ; routine LD_BLOCK loads to workspace. + POP HL ; restore first location in workspace to HL. + LD DE,(PROG) ; set DE from system variable PROG. + + ; now enter a loop to merge the data block in workspace with the program and + ; variables. + + ;;;$08D2 +ME_NEW_LP: LD A,(HL) ; fetch next byte from workspace. + AND $C0 ; compare with $3F. + JR NZ,ME_VAR_LP ; forward to ME_VAR_LP if a variable. + + ; continue when HL addresses a Basic line number. + + ;;;$08D7 +ME_OLD_LP: LD A,(DE) ; fetch high byte from program area. + INC DE ; bump prog address. + CP (HL) ; compare with that in workspace. + INC HL ; bump workspace address. + JR NZ,ME_OLD_L1 ; forward to ME_OLD_L1 if high bytes don't match + + LD A,(DE) ; fetch the low byte of program line number. + CP (HL) ; compare with that in workspace. + + ;;;$08DF +ME_OLD_L1: DEC DE ; point to start of + DEC HL ; respective lines again. + JR NC,ME_NEW_L2 ; forward to ME_NEW_L2 if line number in + ; workspace is less than or equal to current + ; program line as has to be added to program. + PUSH HL ; else save workspace pointer. + EX DE,HL ; transfer prog pointer to HL + CALL NEXT_ONE ; routine NEXT_ONE finds next line in DE. + POP HL ; restore workspace pointer + JR ME_OLD_LP ; back to ME_OLD_LP until destination position + ; in program area found. + + ; the branch was here with an insertion or replacement point. + + ;;;$08EB: +ME_NEW_L2: CALL ME_ENTER ; routine ME_ENTER enters the line + JR ME_NEW_LP ; loop back to ME_NEW_LP. + + ; the branch was here when the location in workspace held a variable. + + ;;;$08F0 +ME_VAR_LP: LD A,(HL) ; fetch first byte of workspace variable. + LD C,A ; copy to C also. + CP $80 ; is it the end-marker ? + RET Z ; return if so as complete. >>>>> + + PUSH HL ; save workspace area pointer. + LD HL,(VARS) ; load HL with VARS - start of variables area. + + ;;;$08F9 +ME_OLD_VP: LD A,(HL) ; fetch first byte. + CP $80 ; is it the end-marker ? + JR Z,ME_VAR_L2 ; forward if so to ME_VAR_L2 to add + ; variable at end of variables area. + CP C ; compare with variable in workspace area. + JR Z,ME_OLD_V2 ; forward to ME_OLD_V2 if a match to replace. + + ; else entire variables area has to be searched. + + ;;;$0901 +ME_OLD_V1: PUSH BC ; save character in C. + CALL NEXT_ONE ; routine NEXT_ONE gets following variable address in DE. + POP BC ; restore character in C + EX DE,HL ; transfer next address to HL. + JR ME_OLD_VP ; loop back to ME_OLD_VP + + ; the branch was here when first characters of name matched. + + ;;;$0909 +ME_OLD_V2: AND $E0 ; keep bits 11100000 + CP $A0 ; compare 10100000 - a long-named variable. + JR NZ,ME_VAR_L1 ; forward to ME_VAR_L1 if just one-character. + + ; but long-named variables have to be matched character by character. + + POP DE ; fetch workspace 1st character pointer + PUSH DE ; and save it on the stack again. + PUSH HL ; save variables area pointer on stack. + + ;;;$0912 +ME_OLD_V3: INC HL ; address next character in vars area. + INC DE ; address next character in workspace area. + LD A,(DE) ; fetch workspace character. + CP (HL) ; compare to variables character. + JR NZ,ME_OLD_V4 ; forward to ME_OLD_V4 with a mismatch. + + RLA ; test if the terminal inverted character. + JR NC,ME_OLD_V3 ; loop back to ME_OLD_V3 if more to test. + + ; otherwise the long name matches in it's entirety. + + POP HL ; restore pointer to first character of variable + JR ME_VAR_L1 ; forward to ME_VAR_L1 + + ; the branch is here when two characters don't match + + ;;;$091E +ME_OLD_V4: POP HL ; restore the prog/vars pointer. + JR ME_OLD_V1 ; back to ME_OLD_V1 to resume search. + + ; branch here when variable is to replace an existing one + + ;;;$0921 +ME_VAR_L1: LD A,$FF ; indicate a replacement. + + ; this entry point is when A holds $80 indicating a new variable. + + ;;;$0923 +ME_VAR_L2: POP DE ; pop workspace pointer. + EX DE,HL ; now make HL workspace pointer, DE vars pointer + INC A ; zero flag set if replacement. + SCF ; set carry flag indicating a variable not a program line. + CALL ME_ENTER ; routine ME_ENTER copies variable in. + JR ME_VAR_LP ; loop back to ME_VAR_LP + +;------------------------- +; Merge a Line or Variable +;------------------------- +; A Basic line or variable is inserted at the current point. If the line numbers +; or variable names match (zero flag set) then a replacement takes place. + + ;;;$092C +ME_ENTER: JR NZ,ME_ENT_1 ; forward to ME_ENT_1 for insertion only. + + ; but the program line or variable matches so old one is reclaimed. + + EX AF,AF' ; save flag?? + LD (X_PTR),HL ; preserve workspace pointer in dynamic X_PTR + EX DE,HL ; transfer program dest pointer to HL. + CALL NEXT_ONE ; routine NEXT_ONE finds following location + ; in program or variables area. + CALL RECLAIM_2 ; routine RECLAIM_2 reclaims the space between. + EX DE,HL ; transfer program dest pointer back to DE. + LD HL,(X_PTR) ; fetch adjusted workspace pointer from X_PTR + EX AF,AF' ; restore flags. + + ; now the new line or variable is entered. + + ;;;$093E +ME_ENT_1: EX AF,AF' ; save or re-save flags. + PUSH DE ; save dest pointer in prog/vars area. + CALL NEXT_ONE ; routine NEXT_ONE finds next in workspace. + ; gets next in DE, difference in BC. + ; prev addr in HL + LD (X_PTR),HL ; store pointer in X_PTR + LD HL,(PROG) ; load HL from system variable PROG + EX (SP),HL ; swap with prog/vars pointer on stack. + PUSH BC ; ** save length of new program line/variable. + EX AF,AF' ; fetch flags back. + JR C,ME_ENT_2 ; skip to ME_ENT_2 if variable + + DEC HL ; address location before pointer + CALL MAKE_ROOM ; routine MAKE_ROOM creates room for basic line + INC HL ; address next. + JR ME_ENT_3 ; forward to ME_ENT_3 + + ;;;$0955 +ME_ENT_2: CALL MAKE_ROOM ; routine MAKE_ROOM creates room for variable. + + ;;;$0958 +ME_ENT_3: INC HL ; address next? + POP BC ; ** pop length + POP DE ; * pop value for PROG which may have been + ; altered by POINTERS if first line. + LD (PROG),DE ; set PROG to original value. + LD DE,(X_PTR) ; fetch adjusted workspace pointer from X_PTR + PUSH BC ; save length + PUSH DE ; and workspace pointer + EX DE,HL ; make workspace pointer source, prog/vars + ; pointer the destination + LDIR ; copy bytes of line or variable into new area. + POP HL ; restore workspace pointer. + POP BC ; restore length. + PUSH DE ; save new prog/vars pointer. + CALL RECLAIM_2 ; routine RECLAIM_2 reclaims the space used + ; by the line or variable in workspace block + ; as no longer required and space could be + ; useful for adding more lines. + POP DE ; restore the prog/vars pointer + RET ; return. + +;-------------------- +; Handle SAVE control +;-------------------- +; A branch from the main SAVE_ETC routine at SAVE-ALL. +; First the header data is saved. Then after a wait of 1 second +; the data itself is saved. +; HL points to start of data. +; IX points to start of descriptor. + + ;;;$0970 +SA_CONTRL: PUSH HL ; save start of data + LD A,$FD ; select system channel 'S' + CALL CHAN_OPEN ; routine CHAN_OPEN + XOR A ; clear to address table directly + LD DE,TAPE_MSGS ; address: TAPE_MSGS + CALL PO_MSG ; routine PO_MSG - + ; 'Start tape then press any key.' + SET 5,(IY+$02) ; TV_FLAG - Signal lower screen requires clearing + CALL WAIT_KEY ; routine WAIT_KEY + PUSH IX ; save pointer to descriptor. + LD DE,$0011 ; there are seventeen bytes. + XOR A ; signal a header. + CALL SA_BYTES ; routine SA_BYTES + POP IX ; restore descriptor pointer. + LD B,$32 ; wait for a second - 50 interrupts. + + ;;;$0991 +SA_1_SEC: HALT ; wait for interrupt + DJNZ SA_1_SEC ; back to SA_1_SEC until pause complete. + LD E,(IX+$0B) ; fetch length of bytes from the + LD D,(IX+$0C) ; descriptor. + LD A,$FF ; signal data bytes. + POP IX ; retrieve pointer to start + JP SA_BYTES ; jump back to SA_BYTES + + +; Arrangement of two headers in workspace. +; Originally IX addresses first location and only one header is required +; when saving. +; +; OLD NEW PROG DATA DATA CODE +; HEADER HEADER num chr NOTES. +; ------ ------ ---- ---- ---- ---- ----------------------------- +; IX-$11 IX+$00 0 1 2 3 Type. +; IX-$10 IX+$01 x x x x F ($FF if filename is null). +; IX-$0F IX+$02 x x x x i +; IX-$0E IX+$03 x x x x l +; IX-$0D IX+$04 x x x x e +; IX-$0C IX+$05 x x x x n +; IX-$0B IX+$06 x x x x a +; IX-$0A IX+$07 x x x x m +; IX-$09 IX+$08 x x x x e +; IX-$08 IX+$09 x x x x . +; IX-$07 IX+$0A x x x x (terminal spaces). +; IX-$06 IX+$0B lo lo lo lo Total +; IX-$05 IX+$0C hi hi hi hi Length of datablock. +; IX-$04 IX+$0D Auto - - Start Various +; IX-$03 IX+$0E Start a-z a-z addr ($80 if no autostart). +; IX-$02 IX+$0F lo - - - Length of Program +; IX-$01 IX+$10 hi - - - only i.e. without variables. + +;------------------------- +; Canned cassette messages +;------------------------- +; The last-character-inverted Cassette messages. +; Starts with normal initial step-over byte. + + ;;;$09A1 +TAPE_MSGS: DEFB $80 + DEFB "Start tape, then press any key" +TAPE_MSGS2: DEFB '.'+$80 + DEFB $0D + DEFB "Program:",' '+$80 + DEFB $0D + DEFB "Number array:",' '+$80 + DEFB $0D + DEFB "Character array:",' '+$80 + DEFB $0D + DEFB "Bytes:",' '+$80 + + + +;************************************************** +;** Part 5. SCREEN AND PRINTER HANDLING ROUTINES ** +;************************************************** + +;---------------------- +; General PRINT routine +;---------------------- +; This is the routine most often used by the RST 10 restart although the +; subroutine is on two occasions called directly when it is known that +; output will definitely be to the lower screen. + + ;;;$09F4 +PRINT_OUT: CALL PO_FETCH ; routine PO_FETCH fetches print position + ; to HL register pair. + CP $20 ; is character a space or higher ? + JP NC,PO_ABLE ; jump forward to PO_ABLE if so. + + CP $06 ; is character in range 00-05 ? + JR C,PO_QUEST ; to PO_QUEST to print '?' if so. + + CP $18 ; is character in range 24d - 31d ? + JR NC,PO_QUEST ; to PO_QUEST to also print '?' if so. + + LD HL,CTLCHRTAB - 6; address $0A0B - the base address of control + ; character table - where zero would be. + LD E,A ; control character 06 - 23d + LD D,$00 ; is transferred to DE. + ADD HL,DE ; index into table. + LD E,(HL) ; fetch the offset to routine. + ADD HL,DE ; add to make HL the address. + PUSH HL ; push the address. + JP PO_FETCH ; to PO_FETCH, as the screen/printer position + ; has been disturbed, and indirectly to + ; routine on stack. + +;------------------------ +; Control character table +;------------------------ +; For control characters in the range 6 - 23d the following table +; is indexed to provide an offset to the handling routine that +; follows the table. + + ;;;$0A11 +CTLCHRTAB: DEFB PO_COMMA - $ ; 06d offset $4E to Address: PO_COMMA + DEFB PO_QUEST - $ ; 07d offset $57 to Address: PO_QUEST + DEFB PO_BACK_1 - $ ; 08d offset $10 to Address: PO_BACK_1 + DEFB PO_RIGHT - $ ; 09d offset $29 to Address: PO_RIGHT + DEFB PO_QUEST - $ ; 10d offset $54 to Address: PO_QUEST + DEFB PO_QUEST - $ ; 11d offset $53 to Address: PO_QUEST + DEFB PO_QUEST - $ ; 12d offset $52 to Address: PO_QUEST + DEFB PO_ENTER - $ ; 13d offset $37 to Address: PO_ENTER + DEFB PO_QUEST - $ ; 14d offset $50 to Address: PO_QUEST + DEFB PO_QUEST - $ ; 15d offset $4F to Address: PO_QUEST + DEFB PO_1_OPER - $ ; 16d offset $5F to Address: PO_1_OPER + DEFB PO_1_OPER - $ ; 17d offset $5E to Address: PO_1_OPER + DEFB PO_1_OPER - $ ; 18d offset $5D to Address: PO_1_OPER + DEFB PO_1_OPER - $ ; 19d offset $5C to Address: PO_1_OPER + DEFB PO_1_OPER - $ ; 20d offset $5B to Address: PO_1_OPER + DEFB PO_1_OPER - $ ; 21d offset $5A to Address: PO_1_OPER + DEFB PO_2_OPER - $ ; 22d offset $54 to Address: PO_2_OPER + DEFB PO_2_OPER - $ ; 23d offset $53 to Address: PO_2_OPER + + +;-------------------- +; Cursor left routine +;-------------------- +; Backspace and up a line if that action is from the left of screen. +; For ZX printer backspace up to first column but not beyond. + + ;;;$0A23 +PO_BACK_1: INC C ; move left one column. + LD A,$22 ; value $21 is leftmost column. + CP C ; have we passed ? + JR NZ,PO_BACK_3 ; to PO_BACK_3 if not and store new position. + + BIT 1,(IY+$01) ; test FLAGS - is printer in use ? + JR NZ,PO_BACK_2 ; to PO_BACK_2 if so, as we are unable to + ; backspace from the leftmost position. + INC B ; move up one screen line + LD C,$02 ; the rightmost column position. + LD A,$18 ; Note. This should be $19 + ; credit. Dr. Frank O'Hara, 1982 + CP B ; has position moved past top of screen ? + JR NZ,PO_BACK_3 ; to PO_BACK_3 if not and store new position. + + DEC B ; else back to $18. + + ;;;$0A38 +PO_BACK_2: LD C,$21 ; the leftmost column position. + + ;;;$0A3A +PO_BACK_3: JP CL_SET ; to CL_SET and PO_STORE to save new + ; position in system variables. + +;--------------------- +; Cursor right routine +;--------------------- +; This moves the print position to the right leaving a trail in the +; current background colour. +; "However the programmer has failed to store the new print position +; so CHR$ 9 will only work if the next print position is at a newly +; defined place. +; e.g. PRINT PAPER 2; CHR$ 9; AT 4,0; +; does work but is not very helpful" +; - Dr. Ian Logan, Understanding Your Spectrum, 1982. + + ;;;$0A3D +PO_RIGHT: LD A,(P_FLAG) ; fetch P_FLAG value + PUSH AF ; and save it on stack. + LD (IY+$57),$01 ; temporarily set P_FLAG 'OVER 1'. + LD A,$20 ; prepare a space. + CALL PO_CHAR ; routine PO_CHAR to print it. + ; Note. could be PO_ABLE which would update + ; the column position. + POP AF ; restore the permanent flag. + LD (P_FLAG),A ; and restore system variable P_FLAG + RET ; return without updating column position + +;------------------------ +; Perform carriage return +;------------------------ +; A carriage return is 'printed' to screen or printer buffer. + + ;;;$0A4F +PO_ENTER: BIT 1,(IY+$01) ; test FLAGS - is printer in use ? + JP NZ,COPY_BUFF ; to COPY_BUFF if so, to flush buffer and reset + ; the print position. + LD C,$21 ; the leftmost column position. + CALL PO_SCR ; routine PO_SCR handles any scrolling required. + DEC B ; to next screen line. + JP CL_SET ; jump forward to CL_SET to store new position. + +;------------ +; Print comma +;------------ +; The comma control character. The 32 column screen has two 16 character +; tabstops. The routine is only reached via the control character table. + + ;;;$0A5F +PO_COMMA: CALL PO_FETCH ; routine PO_FETCH - seems unnecessary. + LD A,C ; the column position. $21-$01 + DEC A ; move right. $20-$00 + DEC A ; and again $1F-$00 or $FF if trailing + AND $10 ; will be $00 or $10. + JR PO_FILL ; forward to PO_FILL + +;-------------------- +; Print question mark +;-------------------- +; This routine prints a question mark which is commonly +; used to print an unassigned control character in range 0-31d. +; there are a surprising number yet to be assigned. + + ;;;$0A69 +PO_QUEST: LD A,$3F ; prepare the character '?'. + JR PO_ABLE ; forward to PO_ABLE. + +;--------------------------------- +; Control characters with operands +;--------------------------------- +; Certain control characters are followed by 1 or 2 operands. +; The entry points from control character table are PO_2_OPER and PO_1_OPER. +; The routines alter the output address of the current channel so that +; subsequent RST $10 instructions take the appropriate action +; before finally resetting the output address back to PRINT_OUT. + + ;;;$0A6D +PO_TV_2: LD DE,PO_CONT ; address: PO_CONT will be next output routine + LD (TVDATA_HI),A ; store first operand in TVDATA_HI + JR PO_CHANGE ; forward to PO_CHANGE >> + + ; -> This initial entry point deals with two operands - AT or TAB. + + ;;;$0A75 +PO_2_OPER: LD DE,PO_TV_2 ; address: PO_TV_2 will be next output routine + JR PO_TV_1 ; forward to PO_TV_1 + + ; -> This initial entry point deals with one operand INK to OVER. + + ;;;$0A7A +PO_1_OPER: LD DE,PO_CONT ; address: PO_CONT will be next output routine + + ;;;$0A7D +PO_TV_1: LD (TVDATA_LO),A ; store control code in TVDATA_LO + + ;;;$0A80 +PO_CHANGE: LD HL,(CURCHL) ; use CURCHL to find current output channel. + LD (HL),E ; make it + INC HL ; the supplied + LD (HL),D ; address from DE. + RET ; Note. should clear carry before returning + + ;;;$0A87 +PO_CONT: LD DE,PRINT_OUT ; Address: PRINT_OUT + CALL PO_CHANGE ; routine PO_CHANGE to restore normal channel. + LD HL,(TVDATA_LO) ; TVDATA gives control code and possible + ; subsequent character + LD D,A ; save current character + LD A,L ; the stored control code + CP $16 ; was it INK to OVER (1 operand) ? + JP C,CO_TEMP_5 ; to CO_TEMP_5 + + JR NZ,PO_TAB ; to PO_TAB if not 22d i.e. 23d TAB. + + ; else must have been 22d AT. + LD B,H ; line to H (0-23d) + LD C,D ; column to C (0-31d) + LD A,$1F ; the value 31d + SUB C ; reverse the column number. + JR C,PO_AT_ERR ; to PO_AT_ERR if C was greater than 31d. + + ADD A,$02 ; transform to system range $02-$21 + LD C,A ; and place in column register. + BIT 1,(IY+$01) ; test FLAGS - is printer in use ? + JR NZ,PO_AT_SET ; to PO_AT_SET as line can be ignored. + + LD A,$16 ; 22 decimal + SUB B ; subtract line number to reverse + ; 0 - 22 becomes 22 - 0. + + ;;;$0AAC +PO_AT_ERR: JP C,REPORT_BB ; to REPORT_BB if higher than 22 decimal + ; Integer out of range. + INC A ; adjust for system range $01-$17 + LD B,A ; place in line register + INC B ; adjust to system range $02-$18 + BIT 0,(IY+$02) ; TV_FLAG - Lower screen in use ? + JP NZ,PO_SCR ; exit to PO_SCR to test for scrolling + + CP (IY+$31) ; Compare against DF_SZ + JP C,REPORT_5 ; to REPORT_5 if too low + ; Out of screen. + + ;;;$0ABF +PO_AT_SET: JP CL_SET ; print position is valid so exit via CL_SET + + ; Continue here when dealing with TAB. + ; Note. In basic TAB is followed by a 16-bit number and was initially + ; designed to work with any output device. + + ;;;$0AC2 +PO_TAB: LD A,H ; transfer parameter to A + ; Losing current character - + ; High byte of TAB parameter. + + ;;;$0AC3 +PO_FILL: CALL PO_FETCH ; routine PO_FETCH, HL-addr, BC=line/column. + ; column 1 (right), $21 (left) + ADD A,C ; add operand to current column + DEC A ; range 0 - 31+ + AND $1F ; make range 0 - 31d + RET Z ; return if result zero + + LD D,A ; Counter to D + SET 0,(IY+$01) ; update FLAGS - signal suppress leading space. + + ;;;$0AD0 +PO_SPACE: LD A,$20 ; space character. + CALL PO_SAVE ; routine PO_SAVE prints the character + ; using alternate set (normal output routine) + DEC D ; decrement counter. + JR NZ,PO_SPACE ; to PO_SPACE until done + + RET ; return + +;----------------------- +; Printable character(s) +;----------------------- +; This routine prints printable characters and continues into +; the position store routine + + ;;;$0AD9 +PO_ABLE: CALL PO_ANY ; routine PO_ANY + ; and continue into position store routine. + +;-------------------------------------- +; Store line, column, and pixel address +;-------------------------------------- +; This routine updates the system variables associated with +; The main screen, lower screen/input buffer or ZX printer. + + ;;;$0ADC +PO_STORE: BIT 1,(IY+$01) ; test FLAGS - Is printer in use ? + JR NZ,PO_ST_PR ; to PO_ST_PR if so + + BIT 0,(IY+$02) ; TV_FLAG - Lower screen in use ? + JR NZ,PO_ST_E ; to PO_ST_E if so + + LD (S_POSN),BC ; S_POSN line/column upper screen + LD (DF_CC),HL ; DF_CC display file address + RET + + ;;;$0AF0: +PO_ST_E: LD (SPOSNL),BC ; SPOSNL line/column lower screen + LD (ECHO_E),BC ; ECHO_E line/column input buffer + LD (DFCCL),HL ; DFCCL lower screen memory address + RET + + ;;;$0AFC +PO_ST_PR: LD (IY+$45),C ; P_POSN column position printer + LD (PR_CC),HL ; PR_CC full printer buffer memory address + RET + +;-------------------------- +; Fetch position parameters +;-------------------------- +; This routine fetches the line/column and display file address +; of the upper and lower screen or, if the printer is in use, +; the column position and absolute memory address. +; Note. that PR-CC-hi (23681) is used by this routine and the one above +; and if, in accordance with the manual (that says this is unused), the +; location has been used for other purposes, then subsequent output +; to the printer buffer could corrupt a 256-byte section of memory. + + ;;;$0B03 +PO_FETCH: BIT 1,(IY+$01) ; test FLAGS - Is printer in use + JR NZ,PO_F_PR ; to PO_F_PR if so + ; assume upper screen + LD BC,(S_POSN) ; S_POSN + LD HL,(DF_CC) ; DF_CC display file address + BIT 0,(IY+$02) ; TV_FLAG - Lower screen in use ? + RET Z ; return if upper screen + ; ah well, was lower screen + LD BC,(SPOSNL) ; SPOSNL + LD HL,(DFCCL) ; DFCCL + RET ; return + + ;;;$0B1D +PO_F_PR: LD C,(IY+$45) ; P_POSN column only + LD HL,(PR_CC) ; PR_CC printer buffer address + RET ; return + +;-------------------- +; Print any character +;-------------------- +; This routine is used to print any character in range 32d - 255d +; It is only called from PO_ABLE and continues into PO_STORE + + ;;;$0B24 +PO_ANY: CP $80 ; ascii ? + JR C,PO_CHAR ; to PO_CHAR is so. + + CP $90 ; test if a block graphic character. + JR NC,PO_T_UDG ; to PO_T_UDG to print tokens and udg's + + ; The 16 2*2 mosaic characters 128-143 decimal are formed from + ; bits 0-3 of the character. + + LD B,A ; save character + CALL PO_GR_1 ; routine PO_GR_1 to construct top half then bottom half. + CALL PO_FETCH ; routine PO_FETCH fetches print position. + LD DE,MEM_0 ; MEM_0 is location of 8 bytes of character + JR PR_ALL ; to PR_ALL to print to screen or printer + + ;;;$0B38 +PO_GR_1: LD HL,MEM_0 ; address MEM_0 - a temporary buffer in + ; systems variables which is normally used by the calculator. + CALL PO_GR_2 ; routine PO_GR_2 to construct top half + ; and continue into routine to construct bottom half. + + ;;;$0B3E +PO_GR_2: RR B ; rotate bit 0/2 to carry + SBC A,A ; result $00 or $FF + AND $0F ; mask off right hand side + LD C,A ; store part in C + RR B ; rotate bit 1/3 of original chr to carry + SBC A,A ; result $00 or $FF + AND $F0 ; mask off left hand side + OR C ; combine with stored pattern + LD C,$04 ; four bytes for top/bottom half + + ;;;$0B4C +PO_GR_3: LD (HL),A ; store bit patterns in temporary buffer + INC HL ; next address + DEC C ; jump back to + JR NZ,PO_GR_3 ; to PO_GR_3 until byte is stored 4 times + + RET ; return + + ; Tokens and User defined graphics are now separated. + + ;;;$0B52 +PO_T_UDG: SUB $A5 ; the 'RND' character + JR NC,PO_T ; to PO_T to print tokens + + ADD A,$15 ; add 21d to restore to 0 - 20 + PUSH BC ; save current print position + LD BC,(UDG) ; fetch UDG to address bit patterns + JR PO_CHAR_2 ; to PO_CHAR_2 - common code to lay down + ; a bit patterned character + + ;;;$0B5F +PO_T: CALL PO_TOKENS ; routine PO_TOKENS prints tokens + JP PO_FETCH ; exit via PO_FETCH as this routine must continue into PO_STORE + + ; This point is used to print ascii characters 32d - 127d. + + ;;;$0B65 +PO_CHAR: PUSH BC ; save print position + LD BC,(CHARS) ; address CHARS + + ; This common code is used to transfer the character bytes to memory. + + ;;;$0B6A +PO_CHAR_2: EX DE,HL ; transfer destination address to DE + LD HL,FLAGS ; point to FLAGS + RES 0,(HL) ; allow for leading space + CP $20 ; is it a space ? + JR NZ,PO_CHAR_3 ; to PO_CHAR_3 if not + + SET 0,(HL) ; signal no leading space to FLAGS + + ;;;$0B76 +PO_CHAR_3: LD H,$00 ; set high byte to 0 + LD L,A ; character to A + ; 0-21 UDG or 32-127 ascii. + ADD HL,HL ; multiply + ADD HL,HL ; by + ADD HL,HL ; eight + ADD HL,BC ; HL now points to first byte of character + POP BC ; the source address CHARS or UDG + EX DE,HL ; character address to DE + +;--------------------- +; Print all characters +;--------------------- +; This entry point entered from above to print ascii and UDGs +; but also from earlier to print mosaic characters. +; HL=destination +; DE=character source +; BC=line/column + + ;;;$0B7F +PR_ALL: LD A,C ; column to A + DEC A ; move right + LD A,$21 ; pre-load with leftmost position + JR NZ,PR_ALL_1 ; but if not zero to PR_ALL_1 + + DEC B ; down one line + LD C,A ; load C with $21 + BIT 1,(IY+$01) ; test FLAGS - Is printer in use + JR Z,PR_ALL_1 ; to PR_ALL_1 if not + + PUSH DE ; save source address + CALL COPY_BUFF ; routine COPY_BUFF outputs line to printer + POP DE ; restore character source address + LD A,C ; the new column number ($21) to C + + ;;;$0B93 +PR_ALL_1: CP C ; this test is really for screen - new line ? + PUSH DE ; save source + CALL Z,PO_SCR ; routine PO_SCR considers scrolling + POP DE ; restore source + PUSH BC ; save line/column + PUSH HL ; and destination + LD A,(P_FLAG) ; fetch P_FLAG to accumulator + LD B,$FF ; prepare OVER mask in B. + RRA ; bit 0 set if OVER 1 + JR C,PR_ALL_2 ; to PR_ALL_2 + + INC B ; set OVER mask to 0 + + ;;;$0BA4 +PR_ALL_2: RRA ; skip bit 1 of P_FLAG + RRA ; bit 2 is INVERSE + SBC A,A ; will be FF for INVERSE 1 else zero + LD C,A ; transfer INVERSE mask to C + LD A,$08 ; prepare to count 8 bytes + AND A ; clear carry to signal screen + BIT 1,(IY+$01) ; test FLAGS - Is printer in use ? + JR Z,PR_ALL_3 ; to PR_ALL_3 if screen + + SET 1,(IY+$30) ; update FLAGS2 - Signal printer buffer has been used. + SCF ; set carry flag to signal printer. + + ;;;$0BB6 +PR_ALL_3: EX DE,HL ; now HL=source, DE=destination + + ;;;$0BB7 +PR_ALL_4: EX AF,AF' ; save printer/screen flag + LD A,(DE) ; fetch existing destination byte + AND B ; consider OVER + XOR (HL) ; now XOR with source + XOR C ; now with INVERSE MASK + LD (DE),A ; update screen/printer + EX AF,AF' ; restore flag + JR C,PR_ALL_6 ; to PR_ALL_6 - printer address update + + INC D ; gives next pixel line down screen + + ;;;$0BC1 +PR_ALL_5: INC HL ; address next character byte + DEC A ; the byte count is decremented + JR NZ,PR_ALL_4 ; back to PR_ALL_4 for all 8 bytes + + EX DE,HL ; destination to HL + DEC H ; bring back to last updated screen position + BIT 1,(IY+$01) ; test FLAGS - is printer in use ? + CALL Z,PO_ATTR ; if not, call routine PO_ATTR to update corresponding colour attribute. + POP HL ; restore original screen/printer position + POP BC ; and line column + DEC C ; move column to right + INC HL ; increase screen/printer position + RET ; return and continue into PO_STORE within PO_ABLE + + ; This branch is used to update the printer position by 32 places + ; Note. The high byte of the address D remains constant (which it should). + + ;;;$0BD3 +PR_ALL_6: EX AF,AF' ; save the flag + LD A,$20 ; load A with 32 decimal + ADD A,E ; add this to E + LD E,A ; and store result in E + EX AF,AF' ; fetch the flag + JR PR_ALL_5 ; back to PR_ALL_5 + +;-------------- +; Set attribute +;-------------- +; This routine is entered with the HL register holding the last screen +; address to be updated by PRINT or PLOT. +; The Spectrum screen arrangement leads to the L register holding +; the correct value for the attribute file and it is only necessary +; to manipulate H to form the correct colour attribute address. + + ;;;$0BDB +PO_ATTR: LD A,H ; fetch high byte $40 - $57 + RRCA ; shift + RRCA ; bits 3 and 4 + RRCA ; to right. + AND $03 ; range is now 0 - 2 + OR $58 ; form correct high byte for third of screen + LD H,A ; HL is now correct + LD DE,(ATTRT_MASKT); make D hold ATTR_T, E hold MASK-T + LD A,(HL) ; fetch existing attribute + XOR E ; apply masks + AND D + XOR E + BIT 6,(IY+$57) ; test P_FLAG - is this PAPER 9 ?? + JR Z,PO_ATTR_1 ; skip to PO_ATTR_1 if not. + + AND $C7 ; set paper + BIT 2,A ; to contrast with ink + JR NZ,PO_ATTR_1 ; skip to PO_ATTR_1 + + XOR $38 + + ;;;$0BFA +PO_ATTR_1: BIT 4,(IY+$57) ; test P_FLAG - Is this INK 9 ?? + JR Z,PO_ATTR_2 ; skip to PO_ATTR_2 if not + + AND $F8 ; make ink + BIT 5,A ; contrast with paper. + JR NZ,PO_ATTR_2 ; to PO_ATTR_2 + + XOR $07 + + ;;;$0C08 +PO_ATTR_2: LD (HL),A ; save the new attribute. + RET ; return. + +;----------------- +; Message printing +;----------------- +; This entry point is used to print tape, boot-up, scroll? and error messages +; On entry the DE register points to an initial step-over byte or +; the inverted end-marker of the previous entry in the table. +; A contains the message number, often zero to print first message. +; (HL has nothing important usually P_FLAG) + + ;;;$0C0A +PO_MSG: PUSH HL ; put hi-byte zero on stack to suppress + LD H,$00 ; trailing spaces + EX (SP),HL ; ld h,0; push hl would have done ?. + JR PO_TABLE ; forward to PO_TABLE. + + ; This entry point prints the basic keywords, '<>' etc. from alt set + + ;;;$0C10 +PO_TOKENS: LD DE,TKN_TABLE ; address: TKN_TABLE + PUSH AF ; save the token number to control + ; trailing spaces - see later * + + ;;;$0C14 +PO_TABLE: CALL PO_SEARCH ; routine PO_SEARCH will set carry for + ; all messages and function words. + JR C,PO_EACH ; forward to PO_EACH if not a command, + ; '<>' etc. + + LD A,$20 ; prepare leading space + BIT 0,(IY+$01) ; test FLAGS - leading space if not set + CALL Z,PO_SAVE ; routine PO_SAVE to print a space + ; without disturbing registers + + ;;;$0C22 +PO_EACH: LD A,(DE) ; fetch character + AND $7F ; remove any inverted bit + CALL PO_SAVE ; routine PO_SAVE to print using alternate set of registers. + LD A,(DE) ; re-fetch character. + INC DE ; address next + ADD A,A ; was character inverted? (this also doubles character) + JR NC,PO_EACH ; back to PO_EACH if not + + POP DE ; * re-fetch trailing space flag to D (was A) + CP $48 ; was last character '$' ($24*2) + JR Z,PO_TR_SP ; forward to PO_TR_SP to consider trailing space if so. + + CP $82 ; was it < 'A' i.e. '#','>','=' from tokens + ; or ' ','.' (from tape) or '?' from scroll + RET C ; no trailing space + + ;;;$0C35 +PO_TR_SP: LD A,D ; the trailing space flag (zero if an error msg) + CP $03 ; test against RND, INKEY$ and PI + ; which have no parameters and + RET C ; therefore no trailing space so return. + + LD A,$20 ; else continue and print a trailing space. + +;-------------------------- +; Handle recursive printing +;-------------------------- +; This routine which is part of PRINT_OUT allows RST $10 to be +; used recursively to print tokens and the spaces associated with them. + + ;;;$0C3B +PO_SAVE: PUSH DE ; save DE as CALL_SUB doesn't. + EXX ; switch in main set + RST 10H ; PRINT_A prints using this alternate set. + EXX ; back to this alternate set. + POP DE ; restore initial DE. + RET ; return. + +;------------- +; Table search +;------------- +; This subroutine searches a message or the token table for the +; message number held in A. DE holds the address of the table. + + ;;;$0C41 +PO_SEARCH: PUSH AF ; save the message/token number + EX DE,HL ; transfer DE to HL + INC A ; adjust for initial step-over byte + + ;;;$0C44 +PO_STEP: BIT 7,(HL) ; is character inverted ? + INC HL ; address next + JR Z,PO_STEP ; back to PO-STEP if not inverted. + + DEC A ; decrease counter + JR NZ,PO_STEP ; back to PO-STEP if not zero + + EX DE,HL ; transfer address to DE + POP AF ; restore message/token number + CP $20 ; return with carry set + RET C ; for all messages and function tokens + + LD A,(DE) ; test first character of token + SUB $41 ; and return with carry set + RET ; if it is less that 'A' + ; i.e. '<>', '<=', '>=' + +;---------------- +; Test for scroll +;---------------- +; This test routine is called when printing carriage return, when considering +; PRINT AT and from the general PRINT ALL characters routine to test if +; scrolling is required, prompting the user if necessary. +; This is therefore using the alternate set. +; The B register holds the current line. + + ;;;$0C55 +PO_SCR: BIT 1,(IY+$01) ; test FLAGS - is printer in use ? + RET NZ ; return immediately if so. + + LD DE,CL_SET ; set DE to address: CL_SET + PUSH DE ; and push for return address. + LD A,B ; transfer the line to A. + BIT 0,(IY+$02) ; test TV_FLAG - Lower screen in use ? + JP NZ,PO_SCR_4 ; jump forward to PO_SCR_4 if so. + + CP (IY+$31) ; greater than DF_SZ display file size ? + JR C,REPORT_5 ; forward to REPORT_5 if less. + ; 'Out of screen' + RET NZ ; return (via CL_SET) if greater + + BIT 4,(IY+$02) ; test TV_FLAG - Automatic listing ? + JR Z,PO_SCR_2 ; forward to PO_SCR_2 if not. + + LD E,(IY+$2D) ; fetch BREG - the count of scroll lines to E. + DEC E ; decrease and jump + JR Z,PO_SCR_3 ; to PO_SCR_3 if zero and scrolling required. + + LD A,$00 ; explicit - select channel zero. + CALL CHAN_OPEN ; routine CHAN_OPEN opens it. + LD SP,(LIST_SP) ; set stack pointer to LIST_SP + RES 4,(IY+$02) ; reset TV_FLAG - signal auto listing finished. + RET ; return ignoring pushed value, CL_SET + ; to MAIN or EDITOR without updating + ; print position -> + + + ;;;$0C86 +REPORT_5: RST 08H ; ERROR_1 + DEFB $04 ; Error Report: Out of screen + + ; continue here if not an automatic listing. + + ;;;$0C88 +PO_SCR_2: DEC (IY+$52) ; decrease SCR_CT + JR NZ,PO_SCR_3 ; forward to PO_SCR_3 to scroll display if + ; result not zero. + + ; now produce prompt. + + LD A,$18 ; reset + SUB B ; the + LD (SCR_CT),A ; SCR_CT scroll count + LD HL,(ATTRT_MASKT); L=ATTR_T, H=MASK_T + PUSH HL ; save on stack + LD A,(P_FLAG) ; P_FLAG + PUSH AF ; save on stack to prevent lower screen + ; attributes (BORDCR etc.) being applied. + LD A,$FD ; select system channel 'K' + CALL CHAN_OPEN ; routine CHAN_OPEN opens it + XOR A ; clear to address message directly + LD DE,SCRL_MSSG ; make DE address: SCRL_MSSG + CALL PO_MSG ; routine PO_MSG prints to lower screen + SET 5,(IY+$02) ; set TV_FLAG - signal lower screen requires clearing + LD HL,FLAGS ; make HL address FLAGS + SET 3,(HL) ; signal 'L' mode. + RES 5,(HL) ; signal 'no new key'. + EXX ; switch to main set. + ; as calling chr input from alternative set. + CALL WAIT_KEY ; routine WAIT_KEY waits for new key + ; Note. this is the right routine but the + ; stream in use is unsatisfactory. From the + ; choices available, it is however the best. + EXX ; switch back to alternate set. + CP $20 ; space is considered as BREAK + JR Z,REPORT_D ; forward to REPORT_D if so + ; 'BREAK - CONT repeats' + CP $E2 ; is character 'STOP' ? + JR Z,REPORT_D ; forward to REPORT_D if so + + OR $20 ; convert to lower-case + CP $6E ; is character 'n' ? + JR Z,REPORT_D ; forward to REPORT_D if so else scroll. + + LD A,$FE ; select system channel 'S' + CALL CHAN_OPEN ; routine CHAN_OPEN + POP AF ; restore original P_FLAG + LD (P_FLAG),A ; and save in P_FLAG. + POP HL ; restore original ATTR_T, MASK_T + LD (ATTRT_MASKT),HL; and reset ATTR_T, MASK-T as 'scroll?' has been printed. + + ;;;$0CD2 +PO_SCR_3: CALL CL_SC_ALL ; routine CL_SC_ALL to scroll whole display + LD B,(IY+$31) ; fetch DF_SZ to B + INC B ; increase to address last line of display + LD C,$21 ; set C to $21 (was $21 from above routine) + PUSH BC ; save the line and column in BC. + CALL CL_ADDR ; routine CL_ADDR finds display address. + LD A,H ; now find the corresponding attribute byte + RRCA ; (this code sequence is used twice + RRCA ; elsewhere and is a candidate for + RRCA ; a subroutine.) + AND $03 + OR $58 + LD H,A + LD DE,$5AE0 ; start of last 'line' of attribute area + LD A,(DE) ; get attribute for last line + LD C,(HL) ; transfer to base line of upper part + LD B,$20 ; there are thirty two bytes + EX DE,HL ; swap the pointers. + + ;;;$0CF0 +PO_SCR_3A: LD (DE),A ; transfer + LD (HL),C ; attributes. + INC DE ; address next. + INC HL ; address next. + DJNZ PO_SCR_3A ; loop back to PO_SCR_3A for all adjacent + ; attribute lines. + POP BC ; restore the line/column. + RET ; return via CL_SET (was pushed on stack). + + ; The message 'scroll?' appears here with last byte inverted. + + ;;;$0CF8 +SCRL_MSSG: DEFB $80 ; initial step-over byte. + DEFB "scroll",'?'+$80 + + ;;;$0D00 +REPORT_D: RST 08H ; ERROR_1 + DEFB $0C ; Error Report: BREAK - CONT repeats + + ; continue here if using lower display - A holds line number. + + ;;;$0D02 +PO_SCR_4: CP $02 ; is line number less than 2 ? + JR C,REPORT_5 ; to REPORT_5 if so + ; 'Out of Screen'. + ADD A,(IY+$31) ; add DF_SZ + SUB $19 + RET NC ; return if scrolling unnecessary + + NEG ; Negate to give number of scrolls required. + PUSH BC ; save line/column + LD B,A ; count to B + LD HL,(ATTRT_MASKT); fetch current ATTR_T, MASK_T to HL. + PUSH HL ; and save + LD HL,(P_FLAG) ; fetch P_FLAG + PUSH HL ; and save. + ; to prevent corruption by input AT + CALL TEMPS ; routine TEMPS sets to BORDCR etc + LD A,B ; transfer scroll number to A. + + ;;;$0D1C +PO_SCR_4A: PUSH AF ; save scroll number. + LD HL,DF_SZ ; address DF_SZ + LD B,(HL) ; fetch old value + LD A,B ; transfer to A + INC A ; and increment + LD (HL),A ; then put back. + LD HL,S_POSN_HI ; address S_POSN_HI - line + CP (HL) ; compare + JR C,PO_SCR_4B ; forward to PO_SCR_4B if scrolling required + + INC (HL) ; else increment S_POSN_HI + LD B,$18 ; set count to whole display ?? + ; Note. should be $17 and the top line + ; will be scrolled into the ROM which + ; is harmless on the standard set up. + + ;;;$0D2D +PO_SCR_4B: CALL CL_SCROLL ; routine CL_SCROLL scrolls B lines + POP AF ; restore scroll counter. + DEC A ; decrease + JR NZ,PO_SCR_4A ; back to to PO_SCR_4A until done + + POP HL ; restore original P_FLAG. + LD (IY+$57),L ; and overwrite system variable P_FLAG. + POP HL ; restore original ATTR_T/MASK_T. + LD (ATTRT_MASKT),HL; and update system variables. + LD BC,(S_POSN) ; fetch S_POSN to BC. + RES 0,(IY+$02) ; signal to TV_FLAG - main screen in use. + CALL CL_SET ; call routine CL_SET for upper display. + SET 0,(IY+$02) ; signal to TV_FLAG - lower screen in use. + POP BC ; restore line/column + RET ; return via CL_SET for lower display. + +;----------------------- +; Temporary colour items +;----------------------- +; This subroutine is called 11 times to copy the permanent colour items +; to the temporary ones. + + ;;;$0D4D +TEMPS: XOR A ; clear the accumulator + LD HL,(ATTRP_MASKP); fetch L=ATTR_P and H=MASK_P + BIT 0,(IY+$02) ; test TV_FLAG - is lower screen in use ? + JR Z,TEMPS_1 ; skip to TEMPS_1 if not + + LD H,A ; set H, MASK P, to 00000000. + LD L,(IY+$0E) ; fetch BORDCR to L which is used for lower screen. + + ;;;$0D5B +TEMPS_1: LD (ATTRT_MASKT),HL; transfer values to ATTR_T and MASK_T + + ; for the print flag the permanent values are odd bits, temporary even bits. + + LD HL,P_FLAG ; address P_FLAG. + JR NZ,TEMPS_2 ; skip to TEMPS_2 if lower screen using A=0. + + LD A,(HL) ; else pick up flag bits. + RRCA ; rotate permanent bits to temporary bits. + + ;;;$0D65 +TEMPS_2: XOR (HL) + AND $55 ; BIN 01010101 + XOR (HL) ; permanent now as original + LD (HL),A ; apply permanent bits to temporary bits. + RET ; and return. + +;------------------- +; Handle CLS command +;------------------- +; clears the display. +; if it's difficult to write it should be difficult to read. + + ;;;$0D6B +CLS: CALL CL_ALL ; routine CL_ALL clears display and + ; resets attributes to permanent. + ; re-attaches it to this computer. + + ; this routine called from input, ** + + ;;;$0D6E +CLS_LOWER: LD HL,TV_FLAG ; address TV_FLAG + RES 5,(HL) ; TV_FLAG - signal do not clear lower screen. + SET 0,(HL) ; TV_FLAG - signal lower screen in use. + CALL TEMPS ; routine TEMPS picks up temporary colours. + LD B,(IY+$31) ; fetch lower screen DF_SZ + CALL CL_LINE ; routine CL_LINE clears lower part + ; and sets permanent attributes. + LD HL,$5AC0 ; fetch attribute address leftmost cell, second line up. + LD A,(ATTRP_MASKP) ; fetch permanent attribute from ATTR_P. + DEC B ; decrement lower screen display file size + JR CLS_3 ; forward to CLS_3 -> + + ;;;$0D87 +CLS_1: LD C,$20 ; set counter to 32 characters per line + + ;;;$0D89 +CLS_2: DEC HL ; decrease attribute address. + LD (HL),A ; and place attributes in next line up. + DEC C ; decrease 32 counter. + JR NZ,CLS_2 ; loop back to CLS_2 until all 32 done. + + ;;;$0D8E +CLS_3: DJNZ CLS_1 ; decrease B counter and back to CLS_1 + ; if not zero. + LD (IY+$31),$02 ; set DF_SZ lower screen to 2 + + ; This entry point is called from CL_ALL below to + ; reset the system channel input and output addresses to normal. + + ;;;$0D94 +CL_CHAN: LD A,$FD ; select system channel 'K' + CALL CHAN_OPEN ; routine CHAN_OPEN opens it. + LD HL,(CURCHL) ; fetch CURCHL to HL to address current channel + LD DE,PRINT_OUT ; set address to PRINT_OUT for first pass. + AND A ; clear carry for first pass. + + ;;;$0DA0 +CL_CHAN_A: LD (HL),E ; insert output address first pass. + INC HL ; or input address on second pass. + LD (HL),D + INC HL + LD DE,KEY_INPUT ; fetch address KEY_INPUT for second pass + CCF ; complement carry flag - will set on pass 1. + JR C,CL_CHAN_A ; back to CL_CHAN_A if first pass else done. + + LD BC,$1721 ; line 23 for lower screen + JR CL_SET ; exit via CL_SET to set column + ; for lower display + +;---------------------------- +; Clearing whole display area +;---------------------------- +; This subroutine called from CLS, AUTO_LIST and MAIN_3 +; clears 24 lines of the display and resets the relevant system variables +; and system channels. + + ;;;$0DAF +CL_ALL: LD HL,$0000 ; initialize plot coordinates. + LD (COORDS),HL ; set COORDS to 0,0. + RES 0,(IY+$30) ; update FLAGS2 - signal main screen is clear. + CALL CL_CHAN ; routine CL_CHAN makes channel 'K' 'normal'. + LD A,$FE ; select system channel 'S' + CALL CHAN_OPEN ; routine CHAN_OPEN opens it + CALL TEMPS ; routine TEMPS picks up permanent values. + LD B,$18 ; There are 24 lines. + CALL CL_LINE ; routine CL_LINE clears 24 text lines + ; (and sets BC to $1821) + LD HL,(CURCHL) ; fetch CURCHL make HL address current channel 'S' + LD DE,PRINT_OUT ; address: PRINT_OUT + LD (HL),E ; is made + INC HL ; the normal + LD (HL),D ; output address. + LD (IY+$52),$01 ; set SCR_CT - scroll count is set to default. + ; Note. BC already contains $1821. + LD BC,$1821 ; reset column and line to 0,0 + ; and continue into CL_SET, below, exiting + ; via PO_STORE (for upper screen). + +;---------------------------- +; Set line and column numbers +;---------------------------- +; This important subroutine is used to calculate the character output +; address for screens or printer based on the line/column for screens +; or the column for printer. + + ;;;$0DD9 +CL_SET: LD HL,$5B00 ; the base address of printer buffer + BIT 1,(IY+$01) ; test FLAGS - is printer in use ? + JR NZ,CL_SET_2 ; forward to CL_SET_2 if so. + + LD A,B ; transfer line to A. + BIT 0,(IY+$02) ; test TV_FLAG - lower screen in use ? + JR Z,CL_SET_1 ; skip to CL_SET_1 if handling upper part + + ADD A,(IY+$31) ; add DF_SZ for lower screen + SUB $18 ; and adjust. + + ;;;$0DEE +CL_SET_1: PUSH BC ; save the line/column. + LD B,A ; transfer line to B + ; (adjusted if lower screen) + CALL CL_ADDR ; routine CL_ADDR calculates address at left of screen. + POP BC ; restore the line/column. + + ;;;$0DF4 +CL_SET_2: LD A,$21 ; the column $1-$21 is reversed + SUB C ; to range $00 - $20 + LD E,A ; now transfer to DE + LD D,$00 ; prepare for addition + ADD HL,DE ; and add to base address + JP PO_STORE ; exit via PO_STORE to update relevant + ; system variables. +;----------------- +; Handle scrolling +;----------------- +; The routine CL_SC_ALL is called once from PO to scroll all the display +; and from the routine CL_SCROLL, once, to scroll part of the display. + + ;;;$0DFE +CL_SC_ALL: LD B,$17 ; scroll 23 lines, after 'scroll?'. + + ;;;$0E00 +CL_SCROLL: CALL CL_ADDR ; routine CL_ADDR gets screen address in HL. + LD C,$08 ; there are 8 pixel lines to scroll. + + ;;;$0E05 +CL_SCR_1: PUSH BC ; save counters. + PUSH HL ; and initial address. + LD A,B ; get line count. + AND $07 ; will set zero if all third to be scrolled. + LD A,B ; re-fetch the line count. + JR NZ,CL_SCR_3 ; forward to CL_SCR_3 if partial scroll. + + ; HL points to top line of third and must be copied to bottom of previous 3rd. + ; ( so HL = $4800 or $5000 ) ( but also sometimes $4000 ) + + ;;;$0E0D +CL_SCR_2: EX DE,HL ; copy HL to DE. + LD HL,$F8E0 ; subtract $08 from H and add $E0 to L - + ADD HL,DE ; to make destination bottom line of previous third. + EX DE,HL ; restore the source and destination. + LD BC,$0020 ; thirty-two bytes are to be copied. + DEC A ; decrement the line count. + LDIR ; copy a pixel line to previous third. + + ;;;$0E19 +CL_SCR_3: EX DE,HL ; save source in DE. + LD HL,$FFE0 ; load the value -32. + ADD HL,DE ; add to form destination in HL. + EX DE,HL ; switch source and destination + LD B,A ; save the count in B. + AND $07 ; mask to find count applicable to current + RRCA ; third and + RRCA ; multiply by + RRCA ; thirty two (same as 5 RLCAs) + LD C,A ; transfer byte count to C ($E0 at most) + LD A,B ; store line count to A + LD B,$00 ; make B zero + LDIR ; copy bytes (BC=0, H incremented, L=0) + LD B,$07 ; set B to 7, C is zero. + ADD HL,BC ; add 7 to H to address next third. + AND $F8 ; has last third been done ? + JR NZ,CL_SCR_2 ; back to CL_SCR_2 if not + + POP HL ; restore topmost address. + INC H ; next pixel line down. + POP BC ; restore counts. + DEC C ; reduce pixel line count. + JR NZ,CL_SCR_1 ; back to CL_SCR_1 if all eight not done. + + CALL CL_ATTR ; routine CL_ATTR gets address in attributes + ; from current 'ninth line', count in BC. + LD HL,$FFE0 ; set HL to the 16-bit value -32. + ADD HL,DE ; and add to form destination address. + EX DE,HL ; swap source and destination addresses. + LDIR ; copy bytes scrolling the linear attributes. + LD B,$01 ; continue to clear the bottom line. + +;---------------------------- +; Clear text lines of display +;---------------------------- +; This subroutine, called from CL_ALL, CLS_LOWER and AUTO_LIST and above, +; clears text lines at bottom of display. +; The B register holds on entry the number of lines to be cleared 1-24. + + ;;;$0E44 +CL_LINE: PUSH BC ; save line count + CALL CL_ADDR ; routine CL_ADDR gets top address + LD C,$08 ; there are eight screen lines to a text line. + + ;;;$0E4A +CL_LINE_1: PUSH BC ; save pixel line count + PUSH HL ; and save the address + LD A,B ; transfer the line to A (1-24). + + ;;;$0E4D +CL_LINE_2: AND $07 ; mask 0-7 to consider thirds at a time + RRCA ; multiply + RRCA ; by 32 (same as five RLCA instructions) + RRCA ; now 32 - 256(0) + LD C,A ; store result in C + LD A,B ; save line in A (1-24) + LD B,$00 ; set high byte to 0, prepare for ldir. + DEC C ; decrement count 31-255. + LD D,H ; copy HL + LD E,L ; to DE. + LD (HL),$00 ; blank the first byte. + INC DE ; make DE point to next byte. + LDIR ; ldir will clear lines. + LD DE,$0701 ; now address next third adjusting + ADD HL,DE ; register E to address left hand side + DEC A ; decrease the line count. + AND $F8 ; will be 16, 8 or 0 (AND $18 will do). + LD B,A ; transfer count to B. + JR NZ,CL_LINE_2 ; back to CL_LINE_2 if 16 or 8 to do + ; the next third. + POP HL ; restore start address. + INC H ; address next line down. + POP BC ; fetch counts. + DEC C ; decrement pixel line count + JR NZ,CL_LINE_1 ; back to CL_LINE_1 till all done. + + CALL CL_ATTR ; routine CL_ATTR gets attribute address + ; in DE and B * 32 in BC. + LD H,D ; transfer the address + LD L,E ; to HL. + INC DE ; make DE point to next location. + LD A,(ATTRP_MASKP) ; fetch ATTR_P - permanent attributes + BIT 0,(IY+$02) ; test TV_FLAG - lower screen in use ? + JR Z,CL_LINE_3 ; skip to CL_LINE_3 if not. + + LD A,(BORDCR) ; else lower screen uses BORDCR as attribute. + + ;;;$0E80 +CL_LINE_3: LD (HL),A ; put attribute in first byte. + DEC BC ; decrement the counter. + LDIR ; copy bytes to set all attributes. + POP BC ; restore the line $01-$24. + LD C,$21 ; make column $21. (No use is made of this) + RET ; return to the calling routine. + +;------------------- +; Attribute handling +;------------------- +; This subroutine is called from CL_LINE or CL_SCROLL with the HL register +; pointing to the 'ninth' line and H needs to be decremented before or after +; the division. Had it been done first then either present code or that used +; at the start of PO_ATTR could have been used. +; The Spectrum screen arrangement leads to the L register holding already +; the correct value for the attribute file and it is only necessary +; to manipulate H to form the correct colour attribute address. + + ;;;$0E88 +CL_ATTR: LD A,H ; fetch H to A - $48, $50, or $58. + RRCA ; divide by + RRCA ; eight. + RRCA ; $09, $0A or $0B. + DEC A ; $08, $09 or $0A. + OR $50 ; $58, $59 or $5A. + LD H,A ; save high byte of attributes. + EX DE,HL ; transfer attribute address to DE + LD H,C ; set H to zero - from last LDIR. + LD L,B ; load L with the line from B. + ADD HL,HL ; multiply + ADD HL,HL ; by + ADD HL,HL ; thirty two + ADD HL,HL ; to give count of attribute + ADD HL,HL ; cells to end of display. + LD B,H ; transfer result + LD C,L ; to register BC. + RET ; and return. + +;-------------------------------- +; Handle display with line number +;-------------------------------- +; This subroutine is called from four places to calculate the address +; of the start of a screen character line which is supplied in B. + + ;;;$0E9B +CL_ADDR: LD A,$18 ; reverse the line number + SUB B ; to range $00 - $17. + LD D,A ; save line in D for later. + RRCA ; multiply + RRCA ; by + RRCA ; thirty-two. + AND $E0 ; mask off low bits to make + LD L,A ; L a multiple of 32. + LD A,D ; bring back the line to A. + AND $18 ; now $00, $08 or $10. + OR $40 ; add the base address of screen. + LD H,A ; HL now has the correct address. + RET ; return. + +;-------------------- +; Handle COPY command +;-------------------- +; This command copies the top 176 lines to the ZX Printer +; It is popular to call this from machine code at point +; L0EAF with B holding 192 (and interrupts disabled) for a full-screen +; copy. This particularly applies to 16K Spectrums as time-critical +; machine code routines cannot be written in the first 16K of RAM as +; it is shared with the ULA which has precedence over the Z80 chip. + + ;;;$0EAC +COPY: DI ; disable interrupts as this is time-critical. + LD B,$B0 ; top 176 lines. +L0EAF: LD HL,$4000 ; address start of the display file. + + ; now enter a loop to handle each pixel line. + + ;;;$0EB2 +COPY_1: PUSH HL ; save the screen address. + PUSH BC ; and the line counter. + CALL COPY_LINE ; routine COPY_LINE outputs one line. + POP BC ; restore the line counter. + POP HL ; and display address. + INC H ; next line down screen within 'thirds'. + LD A,H ; high byte to A. + AND $07 ; result will be zero if we have left third. + JR NZ,COPY_2 ; forward to COPY_2 if not to continue loop. + + LD A,L ; consider low byte first. + ADD A,$20 ; increase by 32 - sets carry if back to zero. + LD L,A ; will be next group of 8. + CCF ; complement - carry set if more lines in the previous third. + SBC A,A ; will be FF, if more, else 00. + AND $F8 ; will be F8 (-8) or 00. + ADD A,H ; that is subtract 8, if more to do in third. + LD H,A ; and reset address. + + ;;;$0EC9 +COPY_2: DJNZ COPY_1 ; back to COPY_1 for all lines. + JR COPY_END ; forward to COPY_END to switch off the printer + ; motor and enable interrupts. + ; Note. Nothing else required. + +;------------------------------- +; Pass printer buffer to printer +;------------------------------- +; This routine is used to copy 8 text lines from the printer buffer +; to the ZX Printer. These text lines are mapped linearly so HL does +; not need to be adjusted at the end of each line. + + ;;;$0ECD +COPY_BUFF: DI ; disable interrupts + LD HL,$5B00 ; the base address of the Printer Buffer. + LD B,$08 ; set count to 8 lines of 32 bytes. + + ;;;$0ED3 +COPY_3: PUSH BC ; save counter. + CALL COPY_LINE ; routine COPY_LINE outputs 32 bytes + POP BC ; restore counter. + DJNZ COPY_3 ; loop back to COPY_3 for all 8 lines. + ; then stop motor and clear buffer. + + ; Note. the COPY command rejoins here, essentially to execute the next + ; three instructions. + + ;;;$0EDA +COPY_END: LD A,$04 ; output value 4 to port + OUT ($FB),A ; to stop the slowed printer motor. + EI ; enable interrupts. + +;--------------------- +; Clear Printer Buffer +;--------------------- +; This routine clears an arbitrary 256 bytes of memory. +; Note. The routine seems designed to clear a buffer that follows the +; system variables. +; The routine should check a flag or HL address and simply return if COPY +; is in use. +; (T-ADDR-lo would work for the system but not if COPY called externally.) +; As a consequence of this omission the buffer will needlessly +; be cleared when COPY is used and the screen/printer position may be set to +; the start of the buffer and the line number to 0 (B) +; giving an 'Out of Screen' error. +; There seems to have been an unsuccessful attempt to circumvent the use +; of PR_CC_hi. + + ;;;$0EDF +CLEAR_PRB: LD HL,$5B00 ; the location of the buffer. + LD (IY+$46),L ; update PR_CC_lo - set to zero - superfluous. + XOR A ; clear the accumulator. + LD B,A ; set count to 256 bytes. + + ;;;$0EE7 +PRB_BYTES: LD (HL),A ; set addressed location to zero. + INC HL ; address next byte - Note. not INC L. + DJNZ PRB_BYTES ; back to PRB_BYTES. repeat for 256 bytes. + RES 1,(IY+$30) ; set FLAGS2 - signal printer buffer is clear. + LD C,$21 ; set the column position . + JP CL_SET ; exit via CL_SET and then PO_STORE. + +;------------------ +; Copy line routine +;------------------ +; This routine is called from COPY and COPY_BUFF to output a line of +; 32 bytes to the ZX Printer. +; Output to port $FB - +; bit 7 set - activate stylus. +; bit 7 low - deactivate stylus. +; bit 2 set - stops printer. +; bit 2 reset - starts printer +; bit 1 set - slows printer. +; bit 1 reset - normal speed. + + ;;;$0EF4 +COPY_LINE: LD A,B ; fetch the counter 1-8 or 1-176 + CP $03 ; is it 01 or 02 ?. + SBC A,A ; result is $FF if so else $00. + AND $02 ; result is 02 now else 00. + ; bit 1 set slows the printer. + OUT ($FB),A ; slow the printer for the + ; last two lines. + LD D,A ; save the mask to control the printer later. + + ;;;$0EFD +COPY_L_1: CALL BREAK_KEY ; call BREAK_KEY to read keyboard immediately. + JR C,COPY_L_2 ; forward to COPY_L_2 if 'break' not pressed. + + LD A,$04 ; else stop the + OUT ($FB),A ; printer motor. + EI ; enable interrupts. + CALL CLEAR_PRB ; call routine CLEAR_PRB. + ; Note. should not be cleared if COPY in use. + + ;;;$0F0A +REPORT_DC: RST 08H ; ERROR_1 + DEFB $0C ; Error Report: BREAK - CONT repeats + + ;;;$0F0C +COPY_L_2: IN A,($FB) ; test now to see if + ADD A,A ; a printer is attached. + RET M ; return if not - but continue with parent + ; command. + JR NC,COPY_L_1 ; back to COPY_L_1 if stylus of printer not + ; in position. + LD C,$20 ; set count to 32 bytes. + + ;;;$0F14 +COPY_L_3: LD E,(HL) ; fetch a byte from line. + INC HL ; address next location. Note. not INC L. + LD B,$08 ; count the bits. + + ;;;$0F18 +COPY_L_4: RL D ; prepare mask to receive bit. + RL E ; rotate leftmost print bit to carry + RR D ; and back to bit 7 of D restoring bit 1 + + ;;;$0F1E +COPY_L_5: IN A,($FB) ; read the port. + RRA ; bit 0 to carry. + JR NC,COPY_L_5 ; back to COPY_L_5 if stylus not in position. + + LD A,D ; transfer command bits to A. + OUT ($FB),A ; and output to port. + DJNZ COPY_L_4 ; loop back to COPY_L_4 for all 8 bits. + DEC C ; decrease the byte count. + JR NZ,COPY_L_3 ; back to COPY_L_3 until 256 bits done. + + RET ; return to calling routine COPY/COPY_BUFF. + + +;----------------------------------- +; Editor routine for BASIC and INPUT +;----------------------------------- +; The editor is called to prepare or edit a basic line. +; It is also called from INPUT to input a numeric or string expression. +; The behaviour and options are quite different in the various modes +; and distinguished by bit 5 of FLAGX. +; +; This is a compact and highly versatile routine. + + ;;;$0F2C +EDITOR: LD HL,(ERR_SP) ; fetch ERR_SP + PUSH HL ; save on stack + + ;;;$0F30 +ED_AGAIN: LD HL,ED_ERROR ; address: ED_ERROR + PUSH HL ; save address on stack and + LD (ERR_SP),SP ; make ERR_SP point to it. + + ; Note. While in editing/input mode should an error occur then RST 08 will + ; update X_PTR to the location reached by CH_ADD and jump to ED_ERROR + ; where the error will be cancelled and the loop begin again from ED_AGAIN + ; above. The position of the error will be apparent when the lower screen is + ; reprinted. If no error then the re-iteration is to ED_LOOP below when + ; input is arriving from the keyboard. + + ;;;$0F38 +ED_LOOP: CALL WAIT_KEY ; routine WAIT_KEY gets key possibly changing the mode. + PUSH AF ; save key. + LD D,$00 ; and give a short click based + LD E,(IY-$01) ; on PIP value for duration. + LD HL,$00C8 ; and pitch. + CALL BEEPER ; routine BEEPER gives click - effective with rubber keyboard. + POP AF ; get saved key value. + LD HL,ED_LOOP ; address: ED_LOOP is loaded to HL. + PUSH HL ; and pushed onto stack. + + ; At this point there is a looping return address on the stack, an error + ; handler and an input stream set up to supply characters. + ; The character that has been received can now be processed. + + CP $18 ; range 24 to 255 ? + JR NC,ADD_CHAR ; forward to ADD_CHAR if so. + + CP $07 ; lower than 7 ? + JR C,ADD_CHAR ; forward to ADD_CHAR also. + ; Note. This is a 'bug' and CHR$ 6, the comma + ; control character, should have had an + ; entry in the ED_KEYS table. + ; Steven Vickers, 1984, Pitman. + CP $10 ; less than 16 ? + JR C,ED_KEYS ; forward to ED_KEYS if editing control + ; range 7 to 15 dealt with by a table + LD BC,$0002 ; prepare for ink/paper etc. + LD D,A ; save character in D + CP $16 ; is it ink/paper/bright etc. ? + JR C,ED_CONTR ; forward to ED_CONTR if so + + ; leaves 22d AT and 23d TAB + ; which can't be entered via KEY_INPUT. + ; so this code is never normally executed + ; when the keyboard is used for input. + + INC BC ; if it was AT/TAB - 3 locations required + BIT 7,(IY+$37) ; test FLAGX - Is this INPUT LINE ? + JP Z,ED_IGNORE ; jump to ED_IGNORE if not, else + + CALL WAIT_KEY ; routine WAIT_KEY - input address is KEY_NEXT + ; but is reset to KEY_INPUT + LD E,A ; save first in E + + ;;;$0F6C +ED_CONTR: CALL WAIT_KEY ; routine WAIT_KEY for control. + ; input address will be KEY_NEXT. + PUSH DE ; saved code/parameters + LD HL,(K_CUR) ; fetch address of keyboard cursor from K_CUR + RES 0,(IY+$07) ; set MODE to 'L' + CALL MAKE_ROOM ; routine MAKE_ROOM makes 2/3 spaces at cursor + POP BC ; restore code/parameters + INC HL ; address first location + LD (HL),B ; place code (ink etc.) + INC HL ; address next + LD (HL),C ; place possible parameter. If only one + ; then DE points to this location also. + JR ADD_CH_1 ; forward to ADD_CH_1 + +;------------------------- +; Add code to current line +;------------------------- +; this is the branch used to add normal non-control characters +; with ED_LOOP as the stacked return address. +; it is also the OUTPUT service routine for system channel 'R'. + + ;;;$0F81 +ADD_CHAR: RES 0,(IY+$07) ; set MODE to 'L' + LD HL,(K_CUR) ; fetch address of keyboard cursor from K_CUR + CALL ONE_SPACE ; routine ONE_SPACE creates one space. + + ; either a continuation of above or from ED_CONTR with ED_LOOP on stack. + + ;;;$0F8B +ADD_CH_1: LD (DE),A ; load current character to last new location. + INC DE ; address next + LD (K_CUR),DE ; and update K_CUR system variable. + RET ; return - either a simple return + ; from ADD_CHAR or to ED_LOOP on stack. + + ; a branch of the editing loop to deal with control characters + ; using a look-up table. + + ;;;$0F92 +ED_KEYS: LD E,A ; character to E. + LD D,$00 ; prepare to add. + LD HL,ED_KEYS_T - 7; base address of editing keys table. $0F99 + ADD HL,DE ; add E + LD E,(HL) ; fetch offset to E + ADD HL,DE ; add offset for address of handling routine. + PUSH HL ; push the address on machine stack. + LD HL,(K_CUR) ; load address of cursor from K_CUR. + RET ; an make an indirect jump forward to routine. + +;------------------- +; Editing keys table +;------------------- +; For each code in the range $07 to $0F this table contains a +; single offset byte to the routine that services that code. +; Note. for what was intended there should also have been an +; entry for CHR$ 6 with offset to ED_SYMBOL. + + ;;;$0FA0 +ED_KEYS_T: DEFB ED_EDIT - $ ; 07d offset $09 to Address: ED_EDIT + DEFB ED_LEFT - $ ; 08d offset $66 to Address: ED_LEFT + DEFB ED_RIGHT - $ ; 09d offset $6A to Address: ED_RIGHT + DEFB ED_DOWN - $ ; 10d offset $50 to Address: ED_DOWN + DEFB ED_UP - $ ; 11d offset $B5 to Address: ED_UP + DEFB ED_DELETE - $ ; 12d offset $70 to Address: ED_DELETE + DEFB ED_ENTER - $ ; 13d offset $7E to Address: ED_ENTER + DEFB ED_SYMBOL - $ ; 14d offset $CF to Address: ED-SYMBOL + DEFB ED_GRAPH - $ ; 15d offset $D4 to Address: ED_GRAPH + +;---------------- +; Handle EDIT key +;---------------- +; The user has pressed SHIFT 1 to bring edit line down to bottom of screen. +; Alternatively the user wishes to clear the input buffer and start again. +; Alternatively ... + + ;;;$0FA9 +ED_EDIT: LD HL,(E_PPC) ; fetch E_PPC the last line number entered. + ; Note. may not exist and may follow program. + BIT 5,(IY+$37) ; test FLAGX - input mode ? + JP NZ,CLEAR_SP ; jump forward to CLEAR_SP if not in editor. + + CALL LINE_ADDR ; routine LINE_ADDR to find address of line + ; or following line if it doesn't exist. + CALL LINE_NO ; routine LINE_NO will get line number from + ; address or previous line if at end-marker. + LD A,D ; if there is no program then DE will + OR E ; contain zero so test for this. + JP Z,CLEAR_SP ; jump to to CLEAR_SP if so. + + ; Note. at this point we have a validated line number, not just an + ; approximation and it would be best to update E_PPC with the true + ; cursor line value which would enable the line cursor to be suppressed + ; in all situations - see shortly. + + PUSH HL ; save address of line. + INC HL ; address low byte of length. + LD C,(HL) ; transfer to C + INC HL ; next to high byte + LD B,(HL) ; transfer to B. + LD HL,$000A ; an overhead of ten bytes + ADD HL,BC ; is added to length. + LD B,H ; transfer adjusted value + LD C,L ; to BC register. + CALL TEST_ROOM ; routine TEST_ROOM checks free memory. + CALL CLEAR_SP ; routine CLEAR_SP clears editing area. + LD HL,(CURCHL) ; address CURCHL + EX (SP),HL ; swap with line address on stack + PUSH HL ; save line address underneath + LD A,$FF ; select system channel 'R' + CALL CHAN_OPEN ; routine CHAN_OPEN opens it + POP HL ; drop line address + DEC HL ; make it point to first byte of line num. + DEC (IY+$0F) ; decrease E_PPC_LO to suppress line cursor. + ; Note. ineffective when E_PPC is one + ; greater than last line of program perhaps + ; as a result of a delete. + ; credit. Paul Harrison 1982. + + CALL OUT_LINE ; routine OUT_LINE outputs the BASIC line + ; to the editing area. + INC (IY+$0F) ; restore E_PPC_LO to the previous value. + LD HL,(E_LINE) ; address E_LINE in editing area. + INC HL ; advance + INC HL ; past space + INC HL ; and digit characters + INC HL ; of line number. + LD (K_CUR),HL ; update K_CUR to address start of BASIC. + POP HL ; restore the address of CURCHL. + CALL CHAN_FLAG ; routine CHAN_FLAG sets flags for it. + RET ; return to ED_LOOP. + +;-------------------- +; Cursor down editing +;-------------------- +; The basic lines are displayed at the top of the screen and the user +; wishes to move the cursor down one line in edit mode. +; In input mode this key can be used as an alternative to entering STOP. + + ;;;$0FF3 +ED_DOWN: BIT 5,(IY+$37) ; test FLAGX - Input Mode ? + JR NZ,ED_STOP ; skip to ED_STOP if so + + LD HL,E_PPC ; address E_PPC - 'current line' + CALL LN_FETCH ; routine LN_FETCH fetches number of next + ; line or same if at end of program. + JR ED_LIST ; forward to ED_LIST to produce an + ; automatic listing. + + ;;;$1001 +ED_STOP: LD (IY+$00),$10 ; set ERR_NR to 'STOP in INPUT' code + JR ED_ENTER ; forward to ED_ENTER to produce error. + +;-------------------- +; Cursor left editing +;-------------------- +; This acts on the cursor in the lower section of the screen in both +; editing and input mode. + + ;;;$1007 +ED_LEFT: CALL ED_EDGE ; routine ED_EDGE moves left if possible + JR ED_CUR ; forward to ED_CUR to update K-CUR + ; and return to ED_LOOP. + +;--------------------- +; Cursor right editing +;--------------------- +; This acts on the cursor in the lower screen in both editing and input +; mode and moves it to the right. + + ;;;$100C +ED_RIGHT: LD A,(HL) ; fetch addressed character. + CP $0D ; is it carriage return ? + RET Z ; return if so to ED_LOOP + + INC HL ; address next character + + ;;;$1011 +ED_CUR: LD (K_CUR),HL ; update K_CUR system variable + RET ; return to ED_LOOP + +;--------------- +; DELETE editing +;--------------- +; This acts on the lower screen and deletes the character to left of +; cursor. If control characters are present these are deleted first +; leaving the naked parameter (0-7) which appears as a '?' except in the +; case of CHR$ 6 which is the comma control character. It is not mandatory +; to delete these second characters. + + ;;;$1015 +ED_DELETE: CALL ED_EDGE ; routine ED_EDGE moves cursor to left. + LD BC,$0001 ; of character to be deleted. + JP RECLAIM_2 ; to RECLAIM_2 reclaim the character. + +;------------------------------------------- +; Ignore next 2 codes from KEY_INPUT routine +;------------------------------------------- +; Since AT and TAB cannot be entered this point is never reached +; from the keyboard. If inputting from a tape device or network then +; the control and two following characters are ignored and processing +; continues as if a carriage return had been received. +; Here, perhaps, another Spectrum has said print #15; AT 0,0; "This is yellow" +; and this one is interpreting input #15; a$. + + ;;;$101E +ED_IGNORE: CALL WAIT_KEY ; routine WAIT_KEY to ignore keystroke. + CALL WAIT_KEY ; routine WAIT_KEY to ignore next key. + +;-------------- +; Enter/newline +;-------------- +; The enter key has been pressed to have basic line or input accepted. + + ;;;$1024 +ED_ENTER: POP HL ; discard address ED_LOOP + POP HL ; drop address ED_ERROR + + ;;;$1026 +ED_END: POP HL ; the previous value of ERR_SP + LD (ERR_SP),HL ; is restored to ERR_SP system variable + BIT 7,(IY+$00) ; is ERR_NR $FF (= 'OK') ? + RET NZ ; return if so + LD SP,HL ; else put error routine on stack + RET ; and make an indirect jump to it. + +;------------------------------ +; Move cursor left when editing +;------------------------------ +; This routine moves the cursor left. The complication is that it must +; not position the cursor between control codes and their parameters. +; It is further complicated in that it deals with TAB and AT characters +; which are never present from the keyboard. +; The method is to advance from the beginning of the line each time, +; jumping one, two, or three characters as necessary saving the original +; position at each jump in DE. Once it arrives at the cursor then the next +; legitimate leftmost position is in DE. + + ;;;$1031 +ED_EDGE: SCF ; carry flag must be set to call the nested + CALL SET_DE ; subroutine SET_DE. + ; if input then DE=WORKSP + ; if editing then DE=E_LINE + SBC HL,DE ; subtract address from start of line + ADD HL,DE ; and add back. + INC HL ; adjust for carry. + POP BC ; drop return address + RET C ; return to ED_LOOP if already at left of line. + + PUSH BC ; resave return address - ED_LOOP. + LD B,H ; transfer HL - cursor address + LD C,L ; to BC register pair. + ; at this point DE addresses start of line. + + ;;;$103E +ED_EDGE_1: LD H,D ; transfer DE - leftmost pointer + LD L,E ; to HL + INC HL ; address next leftmost character to advance position each time. + LD A,(DE) ; pick up previous in A + AND $F0 ; lose the low bits + CP $10 ; is it INK to TAB $10-$1F ? + ; that is, is it followed by a parameter ? + JR NZ,ED_EDGE_2 ; to ED_EDGE_2 if not + ; HL has been incremented once + + INC HL ; address next as at least one parameter. + + ; in fact since 'tab' and 'at' cannot be entered the next section seems + ; superfluous. + ; The test will always fail and the jump to ED_EDGE_2 will be taken. + + LD A,(DE) ; reload leftmost character + SUB $17 ; decimal 23 ('tab') + ADC A,$00 ; will be 0 for 'tab' and 'at'. + JR NZ,ED_EDGE_2 ; forward to ED_EDGE_2 if not + ; HL has been incremented twice + INC HL ; increment a third time for 'at'/'tab' + + ;;;$1051 +ED_EDGE_2: AND A ; prepare for true subtraction + SBC HL,BC ; subtract cursor address from pointer + ADD HL,BC ; and add back + ; Note when HL matches the cursor position BC, + ; there is no carry and the previous + ; position is in DE. + EX DE,HL ; transfer result to DE if looping again. + ; transfer DE to HL to be used as K-CUR + ; if exiting loop. + JR C,ED_EDGE_1 ; back to ED_EDGE_1 if cursor not matched. + + RET ; return. + +;------------------ +; Cursor up editing +;------------------ +; The main screen displays part of the BASIC program and the user wishes +; to move up one line scrolling if necessary. +; This has no alternative use in input mode. + + ;;;$1059 +ED_UP: BIT 5,(IY+$37) ; test FLAGX - input mode ? + RET NZ ; return if not in editor - to ED_LOOP. + + LD HL,(E_PPC) ; get current line from E_PPC + CALL LINE_ADDR ; routine LINE_ADDR gets address + EX DE,HL ; and previous in DE + CALL LINE_NO ; routine LINE_NO gets prev line number + LD HL,E_PPC_HI ; set HL to E_PPC_HI as next routine stores top first. + CALL LN_STORE ; routine LN_STORE loads DE value to HL + ; high byte first - E_PPC_LO takes E + + ; this branch is also taken from ED_DOWN. + + ;;;$106E +ED_LIST: CALL AUTO_LIST ; routine AUTO_LIST lists to upper screen + ; including adjusted current line. + LD A,$00 ; select lower screen again + JP CHAN_OPEN ; exit via CHAN_OPEN to ED_LOOP + +;--------------------------------- +; Use of symbol and graphics codes +;--------------------------------- +; These will not be encountered with the keyboard but would be handled +; otherwise as follows. +; As noted earlier, Vickers says there should have been an entry in +; the KEYS table for CHR$ 6 which also pointed here. +; If, for simplicity, two Spectrums were both using #15 as a bi-directional +; channel connected to each other:- +; then when the other Spectrum has said PRINT #15; x, y +; input #15; i ; j would treat the comma control as a newline and the +; control would skip to input j. +; You can get round the missing CHR$ 6 handler by sending multiple print +; items separated by a newline '. + +; CHR$ 14 would have the same functionality. + +; This is CHR$ 14. + ;;;$1076 +ED_SYMBOL: BIT 7,(IY+$37) ; test FLAGX - is this INPUT LINE ? + JR Z,ED_ENTER ; back to ED_ENTER if not to treat as if + ; enter had been pressed. + ; else continue and add code to buffer. + + ; Next is CHR$ 15 + ; Note that ADD_CHAR precedes the table so we can't offset to it directly. + + ;;;$107C +ED_GRAPH: JP ADD_CHAR ; jump back to ADD_CHAR + +;--------------------- +; Editor error routine +;--------------------- +; If an error occurs while editing, or inputting, then ERR_SP +; points to the stack location holding address ED_ERROR. + + ;;;$107F +ED_ERROR: BIT 4,(IY+$30) ; test FLAGS2 - is K channel in use ? + JR Z,ED_END ; back to ED_END if not. + + ; but as long as we're editing lines or inputting from the keyboard, then + ; we've run out of memory so give a short rasp. + + LD (IY+$00),$FF ; reset ERR_NR to 'OK'. + LD D,$00 ; prepare for beeper. + LD E,(IY-$02) ; use RASP value. + LD HL,$1A90 ; set a duration. + CALL BEEPER ; routine BEEPER emits a warning rasp. + JP ED_AGAIN ; to ED_AGAIN to re-stack address of + ; this routine and make ERR_SP point to it. + +;---------------------- +; Clear edit/work space +;---------------------- +; The editing area or workspace is cleared depending on context. +; This is called from ED_EDIT to clear workspace if edit key is +; used during input, to clear editing area if no program exists +; and to clear editing area prior to copying the edit line to it. +; It is also used by the error routine to clear the respective +; area depending on FLAGX. + + ;;;$1097 +CLEAR_SP: PUSH HL ; preserve HL + CALL SET_HL ; routine SET_HL + ; if in edit HL = WORKSP-1, DE = E_LINE + ; if in input HL = STKBOT, DE = WORKSP + DEC HL ; adjust + CALL RECLAIM_1 ; routine RECLAIM_1 reclaims space + LD (K_CUR),HL ; set K_CUR to start of empty area + LD (IY+$07),$00 ; set MODE to 'KLC' + POP HL ; restore HL. + RET ; return. + +;---------------------- +; Handle keyboard input +;---------------------- +; This is the service routine for the input stream of the keyboard +; channel 'K'. + + ;;;$10A8 +KEY_INPUT: BIT 3,(IY+$02) ; test TV_FLAG - has a key been pressed in editor ? + CALL NZ,ED_COPY ; routine ED_COPY if so to reprint the lower + ; screen at every keystroke. + AND A ; clear carry - required exit condition. + BIT 5,(IY+$01) ; test FLAGS - has a new key been pressed ? + RET Z ; return if not. + + LD A,(LASTK) ; system variable LASTK will hold last key - + ; from the interrupt routine. + RES 5,(IY+$01) ; update FLAGS - reset the new key flag. + PUSH AF ; save the input character. + BIT 5,(IY+$02) ; test TV_FLAG - clear lower screen ? + CALL NZ,CLS_LOWER ; routine CLS_LOWER if so. + POP AF ; restore the character code. + CP $20 ; if space or higher then + JR NC,KEY_DONE2 ; forward to KEY_DONE2 and return with carry + ; set to signal key-found. + CP $10 ; with 16d INK and higher skip + JR NC,KEY_CONTR ; forward to KEY_CONTR. + + CP $06 ; for 6 - 15d + JR NC,KEY_M_CL ; skip forward to KEY_M_CL to handle Modes + ; and CapsLock. + + ; that only leaves 0-5, the flash bright inverse switches. + + LD B,A ; save character in B + AND $01 ; isolate the embedded parameter (0/1). + LD C,A ; and store in C + LD A,B ; re-fetch copy (0-5) + RRA ; halve it 0, 1 or 2. + ADD A,$12 ; add 18d gives 'flash', 'bright' and 'inverse'. + JR KEY_DATA ; forward to KEY_DATA with the + ; parameter (0/1) in C. + + ; Now separate capslock 06 from modes 7-15. + + ;;;$10DB +KEY_M_CL: JR NZ,KEY_MODE ; forward to KEY_MODE if not 06 (capslock) + + LD HL,FLAGS2 ; point to FLAGS2 + LD A,$08 ; value 00000100 + XOR (HL) ; toggle BIT 2 of FLAGS2 the capslock bit + LD (HL),A ; and store result in FLAGS2 again. + JR KEY_FLAG ; forward to KEY_FLAG to signal no-key. + + ;;;$10E6 +KEY_MODE: CP $0E ; compare with chr 14d + RET C ; return with carry set "key found" for + ; codes 7 - 13d leaving 14d and 15d + ; which are converted to mode codes. + SUB $0D ; subtract 13d leaving 1 and 2 + ; 1 is 'E' mode, 2 is 'G' mode. + LD HL,MODE ; address the MODE system variable. + CP (HL) ; compare with existing value before + LD (HL),A ; inserting the new value. + JR NZ,KEY_FLAG ; forward to KEY_FLAG if it has changed. + + LD (HL),$00 ; else make MODE zero - KLC mode + ; Note. while in Extended/Graphics mode, + ; the Extended Mode/Graphics key is pressed + ; again to get out. + + ;;;$10F4 +KEY_FLAG: SET 3,(IY+$02) ; update TV_FLAG - show key state has changed + CP A ; clear carry and reset zero flags - no actual key returned. + RET ; make the return. + + ; now deal with colour controls - 16-23 ink, 24-31 paper + + ;;;$10FA +KEY_CONTR: LD B,A ; make a copy of character. + AND $07 ; mask to leave bits 0-7 + LD C,A ; and store in C. + LD A,$10 ; initialize to 16d - INK. + BIT 3,B ; was it paper ? + JR NZ,KEY_DATA ; forward to KEY_DATA with INK 16d and colour in C. + + INC A ; else change from INK to PAPER (17d) if so. + + ;;;$1105 +KEY_DATA: LD (IY-$2D),C ; put the colour (0-7)/state(0/1) in KDATA + LD DE,KEY_NEXT ; address: KEY_NEXT will be next input stream + JR KEY_CHAN ; forward to KEY_CHAN to change it ... + + ; ... so that INPUT_AD directs control to here at next call to WAIT_KEY + + ;;;$110D +KEY_NEXT: LD A,(KDATA) ; pick up the parameter stored in KDATA. + LD DE,KEY_INPUT ; address: KEY_INPUT will be next input stream + ; continue to restore default channel and + ; make a return with the control code. + + ;;;$1113 +KEY_CHAN: LD HL,(CHANS) ; address start of CHANNELS area using CHANS + ; Note. One might have expected CURCHL to + ; have been used. + INC HL ; step over the + INC HL ; output address + LD (HL),E ; and update the input + INC HL ; routine address for + LD (HL),D ; the next call to WAIT_KEY. + + ;;;$111B +KEY_DONE2: SCF ; set carry flag to show a key has been found + RET ; and return. + +;--------------------- +; Lower screen copying +;--------------------- +; This subroutine is called whenever the line in the editing area or +; input workspace is required to be printed to the lower screen. +; It is by calling this routine after any change that the cursor, for +; instance, appears to move to the left. +; Remember the edit line will contain characters and tokens +; e.g. "1000 LET a = 1" is 12 characters. + + ;;;$111D +ED_COPY: CALL TEMPS ; routine TEMPS sets temporary attributes. + RES 3,(IY+$02) ; update TV_FLAG - signal no change in mode + RES 5,(IY+$02) ; update TV_FLAG - signal don't clear lower screen. + LD HL,(SPOSNL) ; fetch SPOSNL + PUSH HL ; and save on stack. + LD HL,(ERR_SP) ; fetch ERR_SP + PUSH HL ; and save also + LD HL,ED_FULL ; address: ED_FULL + PUSH HL ; is pushed as the error routine + LD (ERR_SP),SP ; and ERR_SP made to point to it. + LD HL,(ECHO_E) ; fetch ECHO_E + PUSH HL ; and push also + SCF ; set carry flag to control SET_DE + CALL SET_DE ; call routine SET_DE + ; if in input DE = WORKSP + ; if in edit DE = E_LINE + EX DE,HL ; start address to HL + CALL OUT_LINE2 ; routine OUT_LINE2 outputs entire line up to + ; carriage return including initial + ; characterized line number when present. + EX DE,HL ; transfer new address to DE + CALL OUT_CURS ; routine OUT_CURS considers a terminating cursor. + LD HL,(SPOSNL) ; fetch updated SPOSNL + EX (SP),HL ; exchange with ECHO_E on stack + EX DE,HL ; transfer ECHO_E to DE + CALL TEMPS ; routine TEMPS to re-set attributes + ; if altered. + + ; the lower screen was not cleared, at the outset, so if deleting then old + ; text from a previous print may follow this line and requires blanking. + + ;;;$1150 +ED_BLANK: LD A,(SPOSNL_HI) ; fetch SPOSNL_HI is current line + SUB D ; compare with old + JR C,ED_C_DONE ; forward to ED_C_DONE if no blanking + + JR NZ,ED_SPACES ; forward to ED_SPACES if line has changed + + LD A,E ; old column to A + SUB (IY+$50) ; subtract new in SPOSNL_lo + JR NC,ED_C_DONE ; forward to ED_C_DONE if no backfilling. + + ;;;$115E +ED_SPACES: LD A,$20 ; prepare a space. + PUSH DE ; save old line/column. + CALL PRINT_OUT ; routine PRINT_OUT prints a space over + ; any text from previous print. + ; Note. Since the blanking only occurs when + ; using $09F4 to print to the lower screen, + ; there is no need to vector via a RST 10 + ; and we can use this alternate set. + POP DE ; restore the old line column. + JR ED_BLANK ; back to ED_BLANK until all old text blanked. + +;-------- +; ED_FULL +;-------- +; this is the error routine addressed by ERR_SP. This is not for the out of +; memory situation as we're just printing. The pitch and duration are exactly +; the same as used by ED_ERROR from which this has been augmented. The +; situation is that the lower screen is full and a rasp is given to suggest +; that this is perhaps not the best idea you've had that day. + + ;;;$1167 +ED_FULL: LD D,$00 ; prepare to moan. + LD E,(IY-$02) ; fetch RASP value. + LD HL,$1A90 ; set duration. + CALL BEEPER ; routine BEEPER. + LD (IY+$00),$FF ; clear ERR_NR. + LD DE,(SPOSNL) ; fetch SPOSNL. + JR ED_C_END ; forward to ED_C_END + + ; the exit point from line printing continues here. + + ;;;$117C +ED_C_DONE: POP DE ; fetch new line/column. + POP HL ; fetch the error address. + + ; the error path rejoins here. + + ;;;$117E +ED_C_END: POP HL ; restore the old value of ERR_SP. + LD (ERR_SP),HL ; update the system variable ERR_SP + POP BC ; old value of SPOSN_L + PUSH DE ; save new value + CALL CL_SET ; routine CL_SET and PO_STORE + ; update ECHO_E and SPOSN_L from BC + POP HL ; restore new value + LD (ECHO_E),HL ; and update ECHO_E + LD (IY+$26),$00 ; make error pointer X_PTR_HI out of bounds + RET ; return + +;------------------------------------------------ +; Point to first and last locations of work space +;------------------------------------------------ +; These two nested routines ensure that the appropriate pointers are +; selected for the editing area or workspace. The routines that call +; these routines are designed to work on either area. + +; this routine is called once + ;;;$1190 +SET_HL: LD HL,(WORKSP) ; fetch WORKSP to HL. + DEC HL ; point to last location of editing area. + AND A ; clear carry to limit exit points to first or last. + + ; this routine is called with carry set and exits at a conditional return. + + ;;;$1195 +SET_DE: LD DE,(E_LINE) ; fetch E_LINE to DE + BIT 5,(IY+$37) ; test FLAGX - Input Mode ? + RET Z ; return now if in editing mode + + LD DE,(WORKSP) ; fetch WORKSP to DE + RET C ; return if carry set ( entry = SET_DE) + + LD HL,(STKBOT) ; fetch STKBOT to HL as well + RET ; and return (entry = SET_HL (in input)) + +;-------------------------------- +; Remove floating point from line +;-------------------------------- +; When a BASIC LINE or the INPUT BUFFER is parsed any numbers will have +; an invisible chr 14d inserted after them and the 5-byte integer or +; floating point form inserted after that. Similar invisible value holders +; are also created after the numeric and string variables in a DEF FN list. +; This routine removes these 'compiled' numbers from the edit line or +; input workspace. + + ;;;$11A7 +REMOVE_FP: LD A,(HL) ; fetch character + CP $0E ; is it the number marker ? + LD BC,$0006 ; prepare for six bytes + CALL Z,RECLAIM_2 ; routine RECLAIM_2 reclaims space if $0E + LD A,(HL) ; reload next (or same) character + INC HL ; and advance address + CP $0D ; end of line or input buffer ? + JR NZ,REMOVE_FP ; back to REMOVE_FP until entire line done. + + RET ; return + + +;********************************* +;** Part 6. EXECUTIVE ROUTINES ** +;********************************* + +; The memory. +; +; +---------+-----------+------------+--------------+-------------+-- +; | BASIC | Display | Attributes | ZX Printer | System | +; | ROM | File | File | Buffer | Variables | +; +---------+-----------+------------+--------------+-------------+-- +; ^ ^ ^ ^ ^ ^ +; $0000 $4000 $5800 $5B00 $5C00 $5CB6 = CHANS +; +; +; --+----------+---+---------+-----------+---+------------+--+---+-- +; | Channel |$80| Basic | Variables |$80| Edit Line |NL|$80| +; | Info | | Program | Area | | or Command | | | +; --+----------+---+---------+-----------+---+------------+--+---+-- +; ^ ^ ^ ^ ^ +; CHANS PROG VARS E_LINE WORKSP +; +; +; ---5--> <---2--- <--3--- +; --+-------+--+------------+-------+-------+---------+-------+-+---+------+ +; | INPUT |NL| Temporary | Calc. | Spare | Machine | Gosub |?|$3E| UDGs | +; | data | | Work Space | Stack | | Stack | Stack | | | | +; --+-------+--+------------+-------+-------+---------+-------+-+---+------+ +; ^ ^ ^ ^ ^ ^ ^ +; WORKSP STKBOT STKEND sp RAMTOP UDG P_RAMT +; + +;-------------------- +; Handle NEW command +;-------------------- +; The NEW command is about to set all RAM below RAMTOP to zero and +; then re-initialize the system. All RAM above RAMTOP should, and will be, +; preserved. +; There is nowhere to store values in RAM or on the stack which becomes +; inoperable. Similarly PUSH and CALL instructions cannot be used to +; store values or section common code. The alternate register set is the only +; place available to store 3 persistent 16-bit system variables. + + ;;;$11B7 +NEW: DI ; disable interrupts - machine stack will be cleared. + LD A,$FF ; flag coming from NEW. + LD DE,(RAMTOP) ; fetch RAMTOP as top value. + EXX ; switch in alternate set. + LD BC,(P_RAMT) ; fetch P_RAMT differs on 16K/48K machines. + LD DE,(RASP_PIP) ; fetch RASP/PIP. + LD HL,(UDG) ; fetch UDG differs on 16K/48K machines. + EXX ; switch back to main set and continue into... + +;---------------------------- +; Main entry (initialization) +;---------------------------- +; This common code tests ram and sets it to zero re-initializing +; all the non-zero system variables and channel information. +; The A register tells if coming from START or NEW + + ;;;$11CB +START_NEW: LD B,A ; save the flag for later branching. + LD A,$07 ; select a white border + OUT ($FE),A ; and set it now. + LD A,$3F ; load accumulator with last page in ROM. + LD I,A ; set the I register - this remains constant + ; and can't be in range $40 - $7F as 'snow' + ; appears on the screen. + NOP ; these seem unnecessary. + NOP + NOP + NOP + NOP + NOP + +;------------- +; Check RAM +;------------- +; Typically a Spectrum will have 16K or 48K of Ram and this code will +; test it all till it finds an unpopulated location or, less likely, a +; faulty location. Usually it stops when it reaches the top $FFFF or +; in the case of NEW the supplied top value. The entire screen turns +; black with sometimes red stripes on black paper visible. + + ;;;$11DA +RAM_CHECK: LD H,D ; transfer the top value to + LD L,E ; the HL register pair. + + ;;;$11DC +RAM_FILL: LD (HL),$02 ; load with 2 - red ink on black paper + DEC HL ; next lower + CP H ; have we reached ROM - $3F ? + JR NZ,RAM_FILL ; back to RAM_FILL if not. + + ;;;$11E2 +RAM_READ: AND A ; clear carry - prepare to subtract + SBC HL,DE ; subtract and add back setting + ADD HL,DE ; carry when back at start. + INC HL ; and increment for next iteration. + JR NC,RAM_DONE ; forward to RAM_DONE if we've got back to + ; starting point with no errors. + DEC (HL) ; decrement to 1. + JR Z,RAM_DONE ; forward to RAM_DONE if faulty. + + DEC (HL) ; decrement to zero. + JR Z,RAM_READ ; back to RAM_READ if zero flag was set. + + ;;;$11EF +RAM_DONE: DEC HL ; step back to last valid location. + EXX ; regardless of state, set up possibly + ; stored system variables in case from NEW. + LD (P_RAMT),BC ; insert P_RAMT. + LD (RASP_PIP),DE ; insert RASP/PIP. + LD (UDG),HL ; insert UDG. + EXX ; switch in main set. + INC B ; now test if we arrived here from NEW. + JR Z,RAM_SET ; forward to RAM_SET if we did. + + ; this section applies to START only. + + LD (P_RAMT),HL ; set P_RAMT to the highest working RAM address. + LD DE,$3EAF ; address of last byte of 'U' bitmap in ROM. + LD BC,$00A8 ; there are 21 user defined graphics. + EX DE,HL ; switch pointers and make the UDGs a + LDDR ; copy of the standard characters A - U. + EX DE,HL ; switch the pointer to HL. + INC HL ; update to start of 'A' in RAM. + LD (UDG),HL ; make UDG system variable address the first bitmap. + DEC HL ; point at RAMTOP again. + LD BC,$0040 ; set the values of + LD (RASP_PIP),BC ; the PIP and RASP system variables. + + ; the NEW command path rejoins here. + + ;;;$1219 +RAM_SET: LD (RAMTOP),HL ; set system variable RAMTOP to HL. + LD HL,$3C00 ; a strange place to set the pointer to the + LD (CHARS),HL ; character set, CHARS - as no printing yet. + LD HL,(RAMTOP) ; fetch RAMTOP to HL again as we've lost it. + LD (HL),$3E ; top of user ram holds GOSUB end marker + ; an impossible line number - see RETURN. + ; no significance in the number $3E. It has + ; been traditional since the ZX80. + DEC HL ; followed by empty byte (not important). + LD SP,HL ; set up the machine stack pointer. + DEC HL + DEC HL + LD (ERR_SP),HL ; ERR_SP is where the error pointer is + ; at moment empty - will take address MAIN_4 + ; at the call preceding that address, + ; although interrupts and calls will make use + ; of this location in meantime. + IM 1 ; select interrupt mode 1. + LD IY,ERR_NR ; set IY to ERR_NR. IY can reach all standard + ; system variables but shadow ROM system + ; variables will be mostly out of range. + + EI ; enable interrupts now that we have a stack. + LD HL,$5CB6 ; the address of the channels - initially + ; following system variables. + LD (CHANS),HL ; set the CHANS system variable. + LD DE,INIT_CHAN ; address: INIT_CHAN in ROM. + LD BC,$0015 ; there are 21 bytes of initial data in ROM. + EX DE,HL ; swap the pointers. + LDIR ; copy the bytes to RAM. + EX DE,HL ; swap pointers. HL points to program area. + DEC HL ; decrement address. + LD (DATADD),HL ; set DATADD to location before program area. + INC HL ; increment again. + LD (PROG),HL ; set PROG the location where BASIC starts. + LD (VARS),HL ; set VARS to same location with a + LD (HL),$80 ; variables end-marker. + INC HL ; advance address. + LD (E_LINE),HL ; set E_LINE, where the edit line + ; will be created. + ; Note. it is not strictly necessary to + ; execute the next fifteen bytes of code + ; as this will be done by the call to SET_MIN. + + LD (HL),$0D ; initially just has a carriage return + INC HL ; followed by + LD (HL),$80 ; an end-marker. + INC HL ; address the next location. + LD (WORKSP),HL ; set WORKSP - empty workspace. + LD (STKBOT),HL ; set STKBOT - bottom of the empty stack. + LD (STKEND),HL ; set STKEND to the end of the empty stack. + LD A,$38 ; the colour system is set to white paper, + ; black ink, no flash or bright. + LD (ATTRP_MASKP),A ; set ATTR_P permanent colour attributes. + LD (ATTRT_MASKT),A ; set ATTR_T temporary colour attributes. + LD (BORDCR),A ; set BORDCR the border colour/lower screen + ; attributes. + LD HL,$0523 ; The keyboard repeat and delay values + LD (REPDEL),HL ; are loaded to REPDEL and REPPER. + + DEC (IY-$3A) ; set KSTATE_0 to $FF. + DEC (IY-$36) ; set KSTATE_4 to $FF. + ; thereby marking both available. + LD HL,INIT_STRM ; set source to ROM Address: INIT_STRM + LD DE,STRMS_FD ; set destination to system variable STRMS_FD + LD BC,$000E ; copy the 14 bytes of initial 7 streams data + LDIR ; from ROM to RAM. + SET 1,(IY+$01) ; update FLAGS - signal printer in use. + CALL CLEAR_PRB ; call routine CLEAR_PRB to initialize system + ; variables associated with printer. + LD (IY+$31),$02 ; set DF_SZ the lower screen display size to + ; two lines + CALL CLS ; call routine CLS to set up system + ; variables associated with screen and clear + ; the screen and set attributes. + XOR A ; clear accumulator so that we can address + LD DE,COPYRIGHT - 1; the message table directly. + CALL PO_MSG ; routine PO_MSG puts + ; '(c) 1982 Sinclair Research Ltd' + ; at bottom of display. + SET 5,(IY+$02) ; update TV_FLAG - signal lower screen will + ; require clearing. + JR MAIN_1 ; forward to MAIN_1 + +;-------------------- +; Main execution loop +;-------------------- + + ;;;$12A2 +MAIN_EXEC: LD (IY+$31),$02 ; set DF_SZ lower screen display file size to 2 lines. + CALL AUTO_LIST ; routine AUTO_LIST + + ;;;$12A9 +MAIN_1: CALL SET_MIN ; routine SET_MIN clears work areas. + + ;;;$12AC +MAIN_2: LD A,$00 ; select channel 'K' the keyboard + CALL CHAN_OPEN ; routine CHAN_OPEN opens it + CALL EDITOR ; routine EDITOR is called. + ; Note the above routine is where the Spectrum + ; waits for user-interaction. Perhaps the + ; most common input at this stage is LOAD "". + CALL LINE_SCAN ; routine LINE_SCAN scans the input. + BIT 7,(IY+$00) ; test ERR_NR - will be $FF if syntax is correct. + JR NZ,MAIN_3 ; forward, if correct, to MAIN_3. + + BIT 4,(IY+$30) ; test FLAGS2 - K channel in use ? + JR Z,MAIN_4 ; forward to MAIN_4 if not. + + LD HL,(E_LINE) ; an editing error so address E_LINE. + CALL REMOVE_FP ; routine REMOVE_FP removes the hidden floating-point forms. + LD (IY+$00),$FF ; system variable ERR_NR is reset to 'OK'. + JR MAIN_2 ; back to MAIN_2 to allow user to correct. + + ; the branch was here if syntax has passed test. + + ;;;$12CF +MAIN_3: LD HL,(E_LINE) ; fetch the edit line address from E_LINE. + LD (CH_ADD),HL ; system variable CH_ADD is set to first + ; character of edit line. + ; Note. the above two instructions are a little + ; inadequate. + ; They are repeated with a subtle difference + ; at the start of the next subroutine and are + ; therefore not required above. + CALL E_LINE_NO ; routine E_LINE_NO will fetch any line + ; number to BC if this is a program line. + LD A,B ; test if the number of + OR C ; the line is non-zero. + JP NZ,MAIN_ADD ; jump forward to MAIN_ADD if so to add the + ; line to the BASIC program. + + ; Has the user just pressed the ENTER key ? + + RST 18H ; GET_CHAR gets character addressed by CH_ADD. + CP $0D ; is it a carriage return ? + JR Z,MAIN_EXEC ; back to MAIN_EXEC if so for an automatic + ; listing. + + ; this must be a direct command. + + BIT 0,(IY+$30) ; test FLAGS2 - clear the main screen ? + CALL NZ,CL_ALL ; routine CL_ALL, if so, e.g. after listing. + CALL CLS_LOWER ; routine CLS_LOWER anyway. + LD A,$19 ; compute scroll count to 25 minus + SUB (IY+$4F) ; value of S_POSN_HI. + LD (SCR_CT),A ; update SCR_CT system variable. + SET 7,(IY+$01) ; update FLAGS - signal running program. + LD (IY+$00),$FF ; set ERR_NR to 'OK'. + LD (IY+$0A),$01 ; set NSPPC to one for first statement. + CALL LINE_RUN ; call routine LINE_RUN to run the line. + ; sysvar ERR_SP therefore addresses MAIN_4 + + ; Examples of direct commands are RUN, CLS, LOAD "", PRINT USR 40000, + ; LPRINT "A"; etc.. + ; If a user written machine-code program disables interrupts then it + ; must enable them to pass the next step. We also jumped to here if the + ; keyboard was not being used. + + ;;;$1303 +MAIN_4: HALT ; wait for interrupt. + RES 5,(IY+$01) ; update FLAGS - signal no new key. + BIT 1,(IY+$30) ; test FLAGS2 - is printer buffer clear ? + CALL NZ,COPY_BUFF ; call routine COPY_BUFF if not. + ; Note. the programmer has neglected + ; to set bit 1 of FLAGS first. + LD A,(ERR_NR) ; fetch ERR_NR + INC A ; increment to give true code. + + ; Now deal with a runtime error as opposed to an editing error. + ; However if the error code is now zero then the OK message will be printed. + + ;;;$1313 +MAIN_G: PUSH AF ; save the error number. + LD HL,$0000 ; prepare to clear some system variables. + LD (IY+$37),H ; clear all the bits of FLAGX. + LD (IY+$26),H ; blank X_PTR_HI to suppress error marker. + LD (DEFADD),HL ; blank DEFADD to signal that no defined + ; function is currently being evaluated. + LD HL,$0001 ; explicit - inc hl would do. + LD (STRMS_00),HL ; ensure STRMS_00 is keyboard. + CALL SET_MIN ; routine SET_MIN clears workspace etc. + RES 5,(IY+$37) ; update FLAGX - signal in EDIT not INPUT mode. + ; Note. all the bits were reset earlier. + + CALL CLS_LOWER ; call routine CLS_LOWER. + SET 5,(IY+$02) ; update TV_FLAG - signal lower screen + ; requires clearing. + + POP AF ; bring back the error number + LD B,A ; and make a copy in B. + CP $0A ; is it a print-ready digit ? + JR C,MAIN_5 ; forward to MAIN_5 if so. + + ADD A,$07 ; add ascii offset to letters. + + ;;;$133C +MAIN_5: CALL OUT_CODE ; call routine OUT_CODE to print the code. + LD A,$20 ; followed by a space. + RST 10H ; PRINT_A + LD A,B ; fetch stored report code. + LD DE,RPT_MESGS ; address: RPT_MESGS. + CALL PO_MSG ; call routine PO_MSG to print. + XOR A ; clear to directly + LD DE,COMMA_SP - 1 ; address comma and space message. + CALL PO_MSG ; routine PO_MSG prints them although it would + ; be more succinct to use RST $10. + LD BC,(PPC) ; fetch PPC the current line number. + CALL OUT_NUM_1 ; routine OUT_NUM_1 will print that + LD A,$3A ; then a ':'. + RST 10H ; PRINT_A + LD C,(IY+$0D) ; then SUBPPC for statement + LD B,$00 ; limited to 127 + CALL OUT_NUM_1 ; routine OUT_NUM_1 + CALL CLEAR_SP ; routine CLEAR_SP clears editing area. + ; which probably contained 'RUN'. + LD A,(ERR_NR) ; fetch ERR_NR again + INC A ; test for no error originally $FF. + JR Z,MAIN_9 ; forward to MAIN_9 if no error. + + CP $09 ; is code Report 9 STOP ? + JR Z,MAIN_6 ; forward to MAIN_6 if so + + CP $15 ; is code Report L Break ? + JR NZ,MAIN_7 ; forward to MAIN_7 if not + + ; Stop or Break was encountered so consider CONTINUE. + + ;;;$1373 +MAIN_6: INC (IY+$0D) ; increment SUBPPC to next statement. + + ;;;$1376 +MAIN_7: LD BC,$0003 ; prepare to copy 3 system variables to + LD DE,OSPPC ; address OSPPC - statement for CONTINUE. + ; also updating OLDPPC line number below. + LD HL,NSPPC ; set source top to NSPPC next statement. + BIT 7,(HL) ; did BREAK occur before the jump ? + ; e.g. between GO TO and next statement. + JR Z,MAIN_8 ; skip forward to MAIN_8, if not, as setup + ; is correct. + ADD HL,BC ; set source to SUBPPC number of current + ; statement/line which will be repeated. + + ;;;$1384 +MAIN_8: LDDR ; copy PPC to OLDPPC and SUBPPC to OSPCC + ; or NSPPC to OLDPPC and NEWPPC to OSPCC + + ;;;$1386 +MAIN_9: LD (IY+$0A),$FF ; update NSPPC - signal 'no jump'. + RES 3,(IY+$01) ; update FLAGS - signal use 'K' mode for + ; the first character in the editor and + JP MAIN_2 ; jump back to MAIN_2. + + +;----------------------- +; Canned report messages +;----------------------- +; The Error reports with the last byte inverted. The first entry +; is a dummy entry. The last, which begins with $7F, the Spectrum +; character for copyright symbol, is placed here for convenience +; as is the preceding comma and space. +; The report line must accomodate a 4-digit line number and a 3-digit +; statement number which limits the length of the message text to twenty +; characters. +; e.g. "B Integer out of range, 1000:127" + + ;;;$1391 +RPT_MESGS: DEFB $80 + DEFB "O",'K'+$80 ; 0 + DEFB "NEXT without FO",'R'+$80 ; 1 + DEFB "Variable not foun",'d'+$80 ; 2 + DEFB "Subscript wron",'g'+$80 ; 3 + DEFB "Out of memor",'y'+$80 ; 4 + DEFB "Out of scree",'n'+$80 ; 5 + DEFB "Number too bi",'g'+$80 ; 6 + DEFB "RETURN without GOSU",'B'+$80 ; 7 + DEFB "End of fil",'e'+$80 ; 8 + DEFB "STOP statemen",'t'+$80 ; 9 + DEFB "Invalid argumen",'t'+$80 ; A + DEFB "Integer out of rang",'e'+$80 ; B + DEFB "Nonsense in BASI",'C'+$80 ; C + DEFB "BREAK - CONT repeat",'s'+$80 ; D + DEFB "Out of DAT",'A'+$80 ; E + DEFB "Invalid file nam",'e'+$80 ; F + DEFB "No room for lin",'e'+$80 ; G + DEFB "STOP in INPU",'T'+$80 ; H + DEFB "FOR without NEX",'T'+$80 ; I + DEFB "Invalid I/O devic",'e'+$80 ; J + DEFB "Invalid colou",'r'+$80 ; K + DEFB "BREAK into progra",'m'+$80 ; L + DEFB "RAMTOP no goo",'d'+$80 ; M + DEFB "Statement los",'t'+$80 ; N + DEFB "Invalid strea",'m'+$80 ; O + DEFB "FN without DE",'F'+$80 ; P + DEFB "Parameter erro",'r'+$80 ; Q + DEFB "Tape loading erro",'r'+$80 ; R + + ;;;$1537 +COMMA_SP: DEFB ",",' '+$80 ; used in report line. + + ;;;$1539 +COPYRIGHT: DEFB $7F ; copyright + DEFB " 1982 Sinclair Research Lt",'d'+$80 + +;--------- +; REPORT_G +;--------- +; Note ERR_SP points here during line entry which allows the +; normal 'Out of Memory' report to be augmented to the more +; precise 'No Room for line' report. + + ;;;$1555 + ; No Room for line +REPORT_G: LD A,$10 ; i.e. 'G' -$30 -$07 + LD BC,$0000 ; this seems unnecessary. + JP MAIN_G ; jump back to MAIN_G + +;------------------------------ +; Handle addition of BASIC line +;------------------------------ +; Note this is not a subroutine but a branch of the main execution loop. +; System variable ERR_SP still points to editing error handler. +; A new line is added to the Basic program at the appropriate place. +; An existing line with same number is deleted first. +; Entering an existing line number deletes that line. +; Entering a non-existent line allows the subsequent line to be edited next. + + ;;;$155D +MAIN_ADD: LD (E_PPC),BC ; set E_PPC to extracted line number. + LD HL,(CH_ADD) ; fetch CH_ADD - points to location after the + ; initial digits (set in E_LINE_NO). + EX DE,HL ; save start of BASIC in DE. + LD HL,REPORT_G ; Address: REPORT_G + PUSH HL ; is pushed on stack and addressed by ERR_SP. + ; the only error that can occur is + ; 'Out of memory'. + LD HL,(WORKSP) ; fetch WORKSP - end of line. + SCF ; prepare for true subtraction. + SBC HL,DE ; find length of BASIC and + PUSH HL ; save it on stack. + LD H,B ; transfer line number + LD L,C ; to HL register. + CALL LINE_ADDR ; routine LINE_ADDR will see if + ; a line with the same number exists. + JR NZ,MAIN_ADD1 ; forward if no existing line to MAIN_ADD1. + + CALL NEXT_ONE ; routine NEXT_ONE finds the existing line. + CALL RECLAIM_2 ; routine RECLAIM_2 reclaims it. + + ;;;$157D +MAIN_ADD1: POP BC ; retrieve the length of the new line. + LD A,C ; and test if carriage return only + DEC A ; i.e. one byte long. + OR B ; result would be zero. + JR Z,MAIN_ADD2 ; forward to MAIN_ADD2 is so. + + PUSH BC ; save the length again. + INC BC ; adjust for inclusion + INC BC ; of line number (two bytes) + INC BC ; and line length + INC BC ; (two bytes). + DEC HL ; HL points to location before the destination + LD DE,(PROG) ; fetch the address of PROG + PUSH DE ; and save it on the stack + CALL MAKE_ROOM ; routine MAKE_ROOM creates BC spaces in + ; program area and updates pointers. + POP HL ; restore old program pointer. + LD (PROG),HL ; and put back in PROG as it may have been + ; altered by the POINTERS routine. + POP BC ; retrieve BASIC length + PUSH BC ; and save again. + INC DE ; points to end of new area. + LD HL,(WORKSP) ; set HL to WORKSP - location after edit line. + DEC HL ; decrement to address end marker. + DEC HL ; decrement to address carriage return. + LDDR ; copy the Basic line back to initial command. + LD HL,(E_PPC) ; fetch E_PPC - line number. + EX DE,HL ; swap it to DE, HL points to last of four locations. + POP BC ; retrieve length of line. + LD (HL),B ; high byte last. + DEC HL + LD (HL),C ; then low byte of length. + DEC HL + LD (HL),E ; then low byte of line number. + DEC HL + LD (HL),D ; then high byte range $0 - $27 (1-9999). + + ;;;$15AB +MAIN_ADD2: POP AF ; drop the address of Report G + JP MAIN_EXEC ; and back to MAIN_EXEC producing a listing + ; and to reset ERR_SP in EDITOR. + +;---------------------------- +; Initial channel information +;---------------------------- +; This initial channel information is copied from ROM to RAM, +; during initialization. It's new location is after the system +; variables and is addressed by the system variable CHANS +; which means that it can slide up and down in memory. +; The table is never searched and the last character which could be anything +; other than a comma provides a convenient resting place for DATADD. + + ;;;$15AF +INIT_CHAN: DEFW PRINT_OUT ; PRINT_OUT + DEFW KEY_INPUT ; KEY_INPUT + DEFB $4B ; 'K' + DEFW PRINT_OUT ; PRINT_OUT + DEFW REPORT_J ; REPORT_J + DEFB $53 ; 'S' + DEFW ADD_CHAR ; ADD_CHAR + DEFW REPORT_J ; REPORT_J + DEFB $52 ; 'R' + DEFW PRINT_OUT ; PRINT_OUT + DEFW REPORT_J ; REPORT_J + DEFB $50 ; 'P' + + DEFB $80 ; End Marker + + ;;;$15C4 +REPORT_J: RST 08H ; ERROR_1 + DEFB $12 ; Error Report: Invalid I/O device + +;-------------------- +; Initial stream data +;-------------------- +; This is the initial stream data for the seven streams $FD - $03 that is +; copied from ROM to the STRMS system variables area during initialization. +; There are reserved locations there for another 12 streams. +; Each location contains an offset to the second byte of a channel. +; The first byte of a channel can't be used as that would result in an +; offset of zero for some and zero is used to denote that a stream is closed. + + ;;;$15C6 +INIT_STRM: DEFB $01, $00 ; stream $FD offset to channel 'K' + DEFB $06, $00 ; stream $FE offset to channel 'S' + DEFB $0B, $00 ; stream $FF offset to channel 'R' + DEFB $01, $00 ; stream $00 offset to channel 'K' + DEFB $01, $00 ; stream $01 offset to channel 'K' + DEFB $06, $00 ; stream $02 offset to channel 'S' + DEFB $10, $00 ; stream $03 offset to channel 'P' + +;----------------------------- +; Control for input subroutine +;----------------------------- + + ;;;$15D4 +WAIT_KEY: BIT 5,(IY+$02) ; test TV_FLAG - clear lower screen ? + JR NZ,WAIT_KEY1 ; forward to WAIT_KEY1 if so. + + SET 3,(IY+$02) ; update TV_FLAG - signal reprint the edit + ; line to the lower screen. + + ;;;$15DE +WAIT_KEY1: CALL INPUT_AD ; routine INPUT_AD is called. + RET C ; return with acceptable keys. + + JR Z,WAIT_KEY1 ; back to WAIT_KEY1 if no key is pressed + ; or it has been handled within INPUT_AD. + + ; Note. When inputting from the keyboard all characters are returned with + ; above conditions so this path is never taken. + + ;;;$15E4 +REPORT_8: RST 08H ; ERROR_1 + DEFB $07 ; Error Report: End of file + +;------------------------------- +; Make HL point to input address +;------------------------------- +; This routine fetches the address of the input stream from the current +; channel area using system variable CURCHL. + + ;;;$15E6 +INPUT_AD: EXX ; switch in alternate set. + PUSH HL ; save HL register + LD HL,(CURCHL) ; fetch address of CURCHL - current channel. + INC HL ; step over output routine + INC HL ; to point to low byte of input routine. + JR CALL_SUB ; forward to CALL_SUB. + +;-------------------- +; Main Output Routine +;-------------------- +; The entry point OUT_CODE is called on five occasions to print +; the ascii equivalent of a value 0-9. +; +; PRINT_A_2 is a continuation of the RST 10 to print any character. +; Both print to the current channel and the printing of control codes +; may alter that channel to divert subsequent RST 10 instructions +; to temporary routines. The normal channel is $09F4. + + ;;;$15EF +OUT_CODE: LD E,$30 ; add 48 decimal to give ascii + ADD A,E ; character '0' to '9'. + + ;;;$15F2 +PRINT_A_2: EXX ; switch in alternate set + PUSH HL ; save HL register + LD HL,(CURCHL) ; fetch CURCHL the current channel. + + ; INPUT_AD rejoins here also. + + ;;;$15F7 +CALL_SUB: LD E,(HL) ; put the low byte in E. + INC HL ; advance address. + LD D,(HL) ; put the high byte to D. + EX DE,HL ; transfer the stream to HL. + CALL CALL_JUMP ; use routine CALL_JUMP. + ; in effect CALL (HL). + POP HL ; restore saved HL register. + EXX ; switch back to the main set and + RET ; return. + +;------------- +; Open channel +;------------- +; This subroutine is used by the ROM to open a channel 'K', 'S', 'R' or 'P'. +; This is either for it's own use or in response to a user's request, for +; example, when '#' is encountered with output - PRINT, LIST etc. +; or with input - INPUT, INKEY$ etc. +; it is entered with a system stream $FD - $FF, or a user stream $00 - $0F +; in the accumulator. + + ;;;$1601 +CHAN_OPEN: ADD A,A ; double the stream ($FF will become $FE etc.) + ADD A,$16 ; add the offset to stream 0 from $5C00 + LD L,A ; result to L + LD H,$5C ; now form the address in STRMS area. + LD E,(HL) ; fetch low byte of CHANS offset + INC HL ; address next + LD D,(HL) ; fetch high byte of offset + LD A,D ; test that the stream is open. + OR E ; zero if closed. + JR NZ,CHAN_OP_1 ; forward to CHAN_OP_1 if open. + + ;;;$160E +REPORT_OA: RST 08H ; ERROR_1 + DEFB $17 ; Error Report: Invalid stream + + ; continue here if stream was open. Note that the offset is from CHANS + ; to the second byte of the channel. + + ;;;$1610 +CHAN_OP_1: DEC DE ; reduce offset so it points to the channel. + LD HL,(CHANS) ; Fetch CHANS the location of the base of + ; the channel information area + ADD HL,DE ; and add the offset to address the channel. + ; and continue to set flags. + +;------------------ +; Set channel flags +;------------------ +; This subroutine is used from ED_EDIT, STR$ and READ_IN to reset the +; current channel when it has been temporarily altered. + + ;;;$1615 +CHAN_FLAG: LD (CURCHL),HL ; set CURCHL system variable to the address in HL + RES 4,(IY+$30) ; update FLAGS2 - signal K channel not in use. + ; Note. provide a default for channel 'R'. + INC HL ; advance past + INC HL ; output routine. + INC HL ; advance past + INC HL ; input routine. + LD C,(HL) ; pick up the letter. + LD HL,CHN_CD_LU ; address: CHN_CD_LU + CALL INDEXER ; routine INDEXER finds offset to a + ; flag-setting routine. + RET NC ; but if the letter wasn't found in the + ; table just return now. - channel 'R'. + LD D,$00 ; prepare to add + LD E,(HL) ; offset to E + ADD HL,DE ; add offset to location of offset to form + ; address of routine + + ;;;$L162C +CALL_JUMP: JP (HL) ; jump to the routine + + ; Footnote. calling any location that holds JP (HL) is the equivalent to + ; a pseudo Z80 instruction CALL (HL). The ROM uses the instruction above. + +;--------------------------- +; Channel code look-up table +;--------------------------- +; This table is used by the routine above to find one of the three +; flag setting routines below it. +; A zero end-marker is required as channel 'R' is not present. + + ;;;$162D +CHN_CD_LU: DEFB 'K', CHAN_K-$-1 ; offset $06 to CHAN_K + DEFB 'S', CHAN_S-$-1 ; offset $12 to CHAN_S + DEFB 'P', CHAN_P-$-1 ; offset $1B to CHAN_P + + DEFB $00 ; end marker. + +;--------------- +; Channel K flag +;--------------- +; routine to set flags for lower screen/keyboard channel. + + ;;;$1634 +CHAN_K: SET 0,(IY+$02) ; update TV_FLAG - signal lower screen in use + RES 5,(IY+$01) ; update FLAGS - signal no new key + SET 4,(IY+$30) ; update FLAGS2 - signal K channel in use + JR CHAN_S_1 ; forward to CHAN_S_1 for indirect exit + +;--------------- +; Channel S flag +;--------------- +; routine to set flags for upper screen channel. + + ;;;$1642 +CHAN_S: RES 0,(IY+$02) ; TV_FLAG - signal main screen in use + + ;;;$1646 +CHAN_S_1: RES 1,(IY+$01) ; update FLAGS - signal printer not in use + JP TEMPS ; jump back to TEMPS and exit via that + ; routine after setting temporary attributes. +;--------------- +; Channel P flag +;--------------- +; This routine sets a flag so that subsequent print related commands +; print to printer or update the relevant system variables. +; This status remains in force until reset by the routine above. + + ;;;$164D +CHAN_P: SET 1,(IY+$01) ; update FLAGS - signal printer in use + RET ; return + +;------------------------ +; Just one space required +;------------------------ +; This routine is called once only to create a single space +; in workspace by ADD_CHAR. It is slightly quicker than using a RST $30. +; There are several instances in the calculator where the sequence +; ld bc, 1; rst $30 could be replaced by a call to this routine but it +; only gives a saving of one byte each time. + + ;;;$1652 +ONE_SPACE: LD BC,$0001 ; create space for a single character. + +;---------- +; Make Room +;---------- +; This entry point is used to create BC spaces in various areas such as +; program area, variables area, workspace etc.. +; The entire free RAM is available to each BASIC statement. +; On entry, HL addresses where the first location is to be created. +; Afterwards, HL will point to the location before this. + + ;;;$1655 +MAKE_ROOM: PUSH HL ; save the address pointer. + CALL TEST_ROOM ; routine TEST_ROOM checks if room + ; exists and generates an error if not. + POP HL ; restore the address pointer. + CALL POINTERS ; routine POINTERS updates the + ; dynamic memory location pointers. + ; DE now holds the old value of STKEND. + LD HL,(STKEND) ; fetch new STKEND the top destination. + EX DE,HL ; HL now addresses the top of the area to + ; be moved up - old STKEND. + LDDR ; the program, variables, etc are moved up. + RET ; return with new area ready to be populated. + ; HL points to location before new area, + ; and DE to last of new locations. + +;------------------------------------------------ +; Adjust pointers before making or reclaiming room +;------------------------------------------------ +; This routine is called by MAKE_ROOM to adjust upwards and by RECLAIM to +; adjust downwards the pointers within dynamic memory. +; The fourteen pointers to dynamic memory, starting with VARS and ending +; with STKEND, are updated adding BC if they are higher than the position +; in HL. +; The system variables are in no particular order except that STKEND, the first +; free location after dynamic memory must be the last encountered. + + ;;;$1664 +POINTERS: PUSH AF ; preserve accumulator. + PUSH HL ; put pos pointer on stack. + LD HL,VARS ; address VARS the first of the + LD A,$0E ; fourteen variables to consider. + + ;;;$166B +PTR_NEXT: LD E,(HL) ; fetch the low byte of the system variable. + INC HL ; advance address. + LD D,(HL) ; fetch high byte of the system variable. + EX (SP),HL ; swap pointer on stack with the variable pointer. + AND A ; prepare to subtract. + SBC HL,DE ; subtract variable address + ADD HL,DE ; and add back + EX (SP),HL ; swap pos with system variable pointer + JR NC,PTR_DONE ; forward to PTR_DONE if var before pos + + PUSH DE ; save system variable address. + EX DE,HL ; transfer to HL + ADD HL,BC ; add the offset + EX DE,HL ; back to DE + LD (HL),D ; load high byte + DEC HL ; move back + LD (HL),E ; load low byte + INC HL ; advance to high byte + POP DE ; restore old system variable address. + + ;;;$167F +PTR_DONE: INC HL ; address next system variable. + DEC A ; decrease counter. + JR NZ,PTR_NEXT ; back to PTR_NEXT if more. + EX DE,HL ; transfer old value of STKEND to HL. + ; Note. this has always been updated. + POP DE ; pop the address of the position. + POP AF ; pop preserved accumulator. + AND A ; clear carry flag preparing to subtract. + SBC HL,DE ; subtract position from old stkend + LD B,H ; to give number of data bytes + LD C,L ; to be moved. + INC BC ; increment as we also copy byte at old STKEND. + ADD HL,DE ; recompute old stkend. + EX DE,HL ; transfer to DE. + RET ; return. + +;-------------------- +; Collect line number +;-------------------- +; This routine extracts a line number, at an address that has previously +; been found using LINE_ADDR, and it is entered at LINE_NO. If it encounters +; the program 'end-marker' then the previous line is used and if that +; should also be unacceptable then zero is used as it must be a direct +; command. The program end-marker is the variables end-marker $80, or +; if variables exist, then the first character of any variable name. + + ;;;$168F +LINE_ZERO: DEFB $00, $00 ; dummy line number used for direct commands + + ;;;$1691 +LINE_NO_A: EX DE,HL ; fetch the previous line to HL and set + LD DE,LINE_ZERO ; DE to LINE_ZERO should HL also fail. + + ; -> The Entry Point. + + ;;;$1695 +LINE_NO: LD A,(HL) ; fetch the high byte - max $2F + AND $C0 ; mask off the invalid bits. + JR NZ,LINE_NO_A ; to LINE_NO_A if an end-marker. + + LD D,(HL) ; reload the high byte. + INC HL ; advance address. + LD E,(HL) ; pick up the low byte. + RET ; return from here. + +;-------------------- +; Handle reserve room +;-------------------- +; This is a continuation of the restart BC_SPACES + + ;;;$169E +RESERVE: LD HL,(STKBOT) ; STKBOT first location of calculator stack + DEC HL ; make one less than new location + CALL MAKE_ROOM ; routine MAKE_ROOM creates the room. + INC HL ; address the first new location + INC HL ; advance to second + POP BC ; restore old WORKSP + LD (WORKSP),BC ; system variable WORKSP was perhaps + ; changed by POINTERS routine. + POP BC ; restore count for return value. + EX DE,HL ; switch. DE = location after first new space + INC HL ; HL now location after new space + RET ; return. + +;---------------------------- +; Clear various editing areas +;---------------------------- +; This routine sets the editing area, workspace and calculator stack +; to their minimum configurations as at initialization and indeed this +; routine could have been relied on to perform that task. +; This routine uses HL only and returns with that register holding +; WORKSP/STKBOT/STKEND though no use is made of this. The routines also +; reset MEM to it's usual place in the systems variable area should it +; have been relocated to a FOR-NEXT variable. The main entry point +; SET_MIN is called at the start of the MAIN_EXEC loop and prior to +; displaying an error. + + ;;;$16B0 +SET_MIN: LD HL,(E_LINE) ; fetch E_LINE + LD (HL),$0D ; insert carriage return + LD (K_CUR),HL ; make K_CUR keyboard cursor point there. + INC HL ; next location + LD (HL),$80 ; holds end-marker $80 + INC HL ; next location becomes + LD (WORKSP),HL ; start of WORKSP + + ; This entry point is used prior to input and prior to the execution, + ; or parsing, of each statement. + + ;;;$16BF +SET_WORK: LD HL,(WORKSP) ; fetch WORKSP value + LD (STKBOT),HL ; and place in STKBOT + + ; This entry point is used to move the stack back to it's normal place + ; after temporary relocation during line entry and also from ERROR_3 + + ;;;$16C5 +SET_STK: LD HL,(STKBOT) ; fetch STKBOT value + LD (STKEND),HL ; and place in STKEND. + PUSH HL ; perhaps an obsolete entry point. + LD HL,MEM_0 ; normal location of MEM_0 + LD (MEM),HL ; is restored to system variable MEM. + POP HL ; saved value not required. + RET ; return. + +;------------------- +; Reclaim edit-line? +;------------------- +; This seems to be legacy code from the ZX80/ZX81 as it is +; not used in this ROM. +; That task, in fact, is performed here by the dual-area routine CLEAR_SP. +; This routine is designed to deal with something that is known to be in the +; edit buffer and not workspace. +; On entry, HL must point to the end of the something to be deleted. + + ;;;$16D4 +REC_EDIT: LD DE,(E_LINE) ; fetch start of edit line from E_LINE. + JP RECLAIM_1 ; jump forward to RECLAIM_1. + +;--------------------------- +; The Table INDEXING routine +;--------------------------- +; This routine is used to search two-byte hash tables for a character +; held in C, returning the address of the following offset byte. +; if it is known that the character is in the table e.g. for priorities, +; then the table requires no zero end-marker. If this is not known at the +; outset then a zero end-marker is required and carry is set to signal +; success. + + ;;;$16DB +INDEXER_1: INC HL ; address the next pair of values. + + ; -> The Entry Point. + + ;;;$16DC +INDEXER: LD A,(HL) ; fetch the first byte of pair + AND A ; is it the end-marker ? + RET Z ; return with carry reset if so. + + CP C ; is it the required character ? + INC HL ; address next location. + JR NZ,INDEXER_1 ; back to INDEXER_1 if no match. + + SCF ; else set the carry flag. + RET ; return with carry set + +;--------------------------------- +; The Channel and Streams Routines +;--------------------------------- +; A channel is is an input/output route to a hardware device +; and is identified to the system by a single letter e.g. 'K' for +; the keyboard. A channel can have an input and output route +; associated with it in which case it is bi-directional like +; the keyboard. Others like the upper screen 'S' are output +; only and the input routine usually points to a report message. +; Channels 'K' and 'S' are system channels and it would be inappropriate +; to close the associated streams so a mechanism is provided to +; re-attach them. When the re-attachment is no longer required, then +; closing these streams resets them as at initialization. +; The same also would have applied to channel 'R', the RS232 channel +; as that is used by the system. It's input stream seems to have been +; removed and it is not available to the user. However the channel could +; not be removed entirely as its output routine was used by the system. +; As a result of removing this channel, channel 'P', the printer is +; erroneously treated as a system channel. +; Ironically the tape streamer is not accessed through streams and +; channels. +; Early demonstrations of the Spectrum showed a single microdrive being +; controlled by this ROM. Adverts also said that the network and RS232 +; were in this ROM. Channels 'M' and 'N' are user channels and have been +; removed successfully if, as seems possible, they existed. + +;---------------------- +; Handle CLOSE# command +;---------------------- +; This command allows streams to be closed after use. +; Any temporary memory areas used by the stream would be reclaimed and +; finally flags set or reset if necessary. + + ;;;$16E5 +CLOSE: CALL STR_DATA ; routine STR_DATA fetches parameter + ; from calculator stack and gets the + ; existing STRMS data pointer address in HL + ; and stream offset from CHANS in BC. + + ; Note. this offset could be zero if the + ; stream is already closed. A check for this + ; should occur now and an error should be + ; generated, for example, + ; Report S 'Stream already closed'. + + CALL CLOSE_2 ; routine CLOSE_2 would perform any actions + ; peculiar to that stream without disturbing + ; data pointer to STRMS entry in HL. + LD BC,$0000 ; the stream is to be blanked. + LD DE,$A3E2 ; the number of bytes from stream 4, $5C1E, to $10000 + EX DE,HL ; transfer offset to HL, STRMS data pointer to DE. + ADD HL,DE ; add the offset to the data pointer. + JR C,CLOSE_1 ; forward to CLOSE_1 if a non-system stream. + ; i.e. higher than 3. + + ; proceed with a negative result. + + LD BC,INIT_STRM+14 ; prepare the address of the byte after + ; the initial stream data in ROM. ($15D4) + ADD HL,BC ; index into the data table with negative value. + LD C,(HL) ; low byte to C + INC HL ; address next. + LD B,(HL) ; high byte to B. + + ; and for streams 0 - 3 just enter the initial data back into the STRMS entry + ; streams 0 - 2 can't be closed as they are shared by the operating system. + ; -> for streams 4 - 15 then blank the entry. + + ;;;$16FC +CLOSE_1: EX DE,HL ; address of stream to HL. + LD (HL),C ; place zero (or low byte). + INC HL ; next address. + LD (HL),B ; place zero (or high byte). + RET ; return. + +;------------------- +; CLOSE_2 Subroutine +;------------------- +; There is not much point in coming here. +; The purpose was once to find the offset to a special closing routine, +; in this ROM and within 256 bytes of the close stream look up table that +; would reclaim any buffers associated with a stream. At least one has been +; removed. + + ;;;$1701 +CLOSE_2: PUSH HL ; * save address of stream data pointer + ; in STRMS on the machine stack. + LD HL,(CHANS) ; fetch CHANS address to HL + ADD HL,BC ; add the offset to address the second + ; byte of the output routine hopefully. + INC HL ; step past + INC HL ; the input routine. + INC HL ; to address channel's letter + LD C,(HL) ; pick it up in C. + ; Note. but if stream is already closed we + ; get the value $10 (the byte preceding 'K'). + EX DE,HL ; save the pointer to the letter in DE. + LD HL,CL_STR_LU ; address: CL_STR_LU in ROM. + CALL INDEXER ; routine INDEXER uses the code to get + ; the 8-bit offset from the current point to + ; the address of the closing routine in ROM. + ; Note. it won't find $10 there! + LD C,(HL) ; transfer the offset to C. + LD B,$00 ; prepare to add. + ADD HL,BC ; add offset to point to the address of the + ; routine that closes the stream. + ; (and presumably removes any buffers that + ; are associated with it.) + JP (HL) ; jump to that routine. + +;--------------------------- +; CLOSE stream look-up table +;--------------------------- +; This table contains an entry for a letter found in the CHANS area. +; followed by an 8-bit displacement, from that byte's address in the +; table to the routine that performs any ancillary actions associated +; with closing the stream of that channel. +; The table doesn't require a zero end-marker as the letter has been +; picked up from a channel that has an open stream. + + ;;;$1716 +CL_STR_LU: DEFB 'K', CLOSE_STR-$-1 ; offset 5 to CLOSE_STR + DEFB 'S', CLOSE_STR-$-1 ; offset 3 to CLOSE_STR + DEFB 'P', CLOSE_STR-$-1 ; offset 1 to CLOSE_STR + + +;------------------------- +; Close Stream Subroutines +;------------------------- +; The close stream routines in fact have no ancillary actions to perform +; which is not surprising with regard to 'K' and 'S'. + + ;;;$171C +CLOSE_STR: POP HL ; * now just restore the stream data pointer + RET ; in STRMS and return. + +;------------ +; Stream data +;------------ +; This routine finds the data entry in the STRMS area for the specified +; stream which is passed on the calculator stack. It returns with HL +; pointing to this system variable and BC holding a displacement from +; the CHANS area to the second byte of the stream's channel. If BC holds +; zero, then that signifies that the stream is closed. + + ;;;$171E +STR_DATA: CALL FIND_INT1 ; routine FIND_INT1 fetches parameter to A + CP $10 ; is it less than 16d ? + JR C,STR_DATA1 ; skip forward to STR_DATA1 if so. + + ;;;$1725 +REPORT_OB: RST 08H ; ERROR_1 + DEFB $17 ; Error Report: Invalid stream + + ;;;$1727 +STR_DATA1: ADD A,$03 ; add the offset for 3 system streams. + ; range 00 - 15d becomes 3 - 18d. + RLCA ; double as there are two bytes per + ; stream - now 06 - 36d + LD HL,STRMS_FD ; address STRMS_FD - the start of the streams + ; data area in system variables. + LD C,A ; transfer the low byte to A. + LD B,$00 ; prepare to add offset. + ADD HL,BC ; add to address the data entry in STRMS_FD. + + ; the data entry itself contains an offset from CHANS to the address of the + ; stream + + LD C,(HL) ; low byte of displacement to C. + INC HL ; address next. + LD B,(HL) ; high byte of displacement to B. + DEC HL ; step back to leave HL pointing to STRMS_FD data entry. + RET ; return with CHANS displacement in BC + ; and address of stream data entry in HL. + +;--------------------- +; Handle OPEN# command +;--------------------- +; Command syntax example: OPEN #5,"s" +; On entry the channel code entry is on the calculator stack with the next +; value containing the stream identifier. They have to swapped. + + ;;;$1736 +OPEN: RST 28H ;; FP_CALC ;s,c. + DEFB $01 ;;EXCHANGE ;c,s. + DEFB $38 ;;END_CALC + + CALL STR_DATA ; routine STR_DATA fetches the stream off + ; the stack and returns with the CHANS + ; displacement in BC and HL addressing + ; the STRMS_FD data entry. + LD A,B ; test for zero which + OR C ; indicates the stream is closed. + JR Z,OPEN_1 ; skip forward to OPEN_1 if so. + + ; if it is a system channel then it can re-attached. + + EX DE,HL ; save STRMS_FD address in DE. + LD HL,(CHANS) ; fetch CHANS. + ADD HL,BC ; add the offset to address the second byte of the channel. + INC HL ; skip over the + INC HL ; input routine. + INC HL ; and address the letter. + LD A,(HL) ; pick up the letter. + EX DE,HL ; save letter pointer and bring back the STRMS_FD pointer. + CP $4B ; is it 'K' ? + JR Z,OPEN_1 ; forward to OPEN_1 if so + + CP $53 ; is it 'S' ? + JR Z,OPEN_1 ; forward to OPEN_1 if so + + CP $50 ; is it 'P' ? + JR NZ,REPORT_OB ; back to REPORT_OB if not. + ; to report 'Invalid stream'. + + ; continue if one of the upper-case letters was found. + ; and rejoin here from above if stream was closed. + + ;;;$1756 +OPEN_1: CALL OPEN_2 ; routine OPEN_2 opens the stream. + + ; it now remains to update the STRMS_FD variable. + + LD (HL),E ; insert or overwrite the low byte. + INC HL ; address high byte in STRMS_FD. + LD (HL),D ; insert or overwrite the high byte. + RET ; return. + +;------------------ +; OPEN_2 Subroutine +;------------------ +; There is some point in coming here as, as well as once creating buffers, +; this routine also sets flags. + + ;;;$175D +OPEN_2: PUSH HL ; * save the STRMS_FD data entry pointer. + CALL STK_FETCH ; routine STK_FETCH now fetches the + ; parameters of the channel string. + ; start in DE, length in BC. + LD A,B ; test that it is not + OR C ; the null string. + JR NZ,OPEN_3 ; skip forward to OPEN_3 with 1 character + ; or more! + + ;;;$1765 +REPORT_F: RST 08H ; ERROR_1 + DEFB $0E ; Error Report: Invalid file name + + ;;;$1767 +OPEN_3: PUSH BC ; save the length of the string. + LD A,(DE) ; pick up the first character. + ; Note. if the second character is used to + ; distinguish between a binary or text + ; channel then it will be simply a matter + ; of setting bit 7 of FLAGX. + AND $DF ; make it upper-case. + LD C,A ; place it in C. + LD HL,OP_STR_LU ; address: OP_STR_LU is loaded. + CALL INDEXER ; routine INDEXER will search for letter. + JR NC,REPORT_F ; back to REPORT_F if not found + ; 'Invalid filename' + + LD C,(HL) ; fetch the displacement to opening routine. + LD B,$00 ; prepare to add. + ADD HL,BC ; now form address of opening routine. + POP BC ; restore the length of string. + JP (HL) ; now jump forward to the relevant routine. + +;-------------------------- +; OPEN stream look-up table +;-------------------------- +; The open stream look-up table consists of matched pairs. +; The channel letter is followed by an 8-bit displacement to the +; associated stream-opening routine in this ROM. +; The table requires a zero end-marker as the letter has been +; provided by the user and not the operating system. + + ;;;$177A +OP_STR_LU: DEFB 'K', OPEN_K-$-1 ; $06 offset to OPEN_K + DEFB 'S', OPEN_S-$-1 ; $08 offset to OPEN_S + DEFB 'P', OPEN_P-$-1 ; $0A offset to OPEN_P + + DEFB $00 ; end-marker. + +;----------------------------- +; The Stream Opening Routines. +;----------------------------- +; These routines would have opened any buffers associated with the stream +; before jumping forward to to OPEN_END with the displacement value in E +; and perhaps a modified value in BC. The strange pathing does seem to +; provide for flexibility in this respect. +; +; There is no need to open the printer buffer as it is there already +; even if you are still saving up for a ZX Printer or have moved onto +; something bigger. In any case it would have to be created after +; the system variables but apart from that it is a simple task +; and all but one of the ROM routines can handle a buffer in that position. +; (PR_ALL_6 would require an extra 3 bytes of code). +; However it wouldn't be wise to have two streams attached to the ZX Printer +; as you can now, so one assumes that if PR_CC_hi was non-zero then +; the OPEN_P routine would have refused to attach a stream if another +; stream was attached. + +; Something of significance is being passed to these ghost routines in the +; second character. Strings 'RB', 'RT' perhaps or a drive/station number. +; The routine would have to deal with that and exit to OPEN_END with BC +; containing $0001 or more likely there would be an exit within the routine. +; Anyway doesn't matter, these routines are long gone. + +;------------------ +; OPEN_K Subroutine +;------------------ +; Open Keyboard stream. + + ;;;$1781 +OPEN_K: LD E,$01 ; 01 is offset to second byte of channel 'K'. + JR OPEN_END ; forward to OPEN_END + +;------------------ +; OPEN_S Subroutine +;------------------ +; Open Screen stream. + + ;;;$1785 +OPEN_S: LD E,$06 ; 06 is offset to 2nd byte of channel 'S' + JR OPEN_END ; to OPEN_END + +;------------------ +; OPEN_P Subroutine +;------------------ +; Open Printer stream. + + ;;;$1789 +OPEN_P: LD E,$10 ; 16d is offset to 2nd byte of channel 'P' + + ;;;$178B +OPEN_END: DEC BC ; the stored length of 'K','S','P' or + ; whatever is now tested. ?? + LD A,B ; test now if initial or residual length + OR C ; is one character. + JR NZ,REPORT_F ; to REPORT_F 'Invalid file name' if not. + + LD D,A ; load D with zero to form the displacement + ; in the DE register. + POP HL ; * restore the saved STRMS_FD pointer. + RET ; return to update STRMS_FD entry thereby + ; signalling stream is open. + +;----------------------------------------- +; Handle CAT, ERASE, FORMAT, MOVE commands +;----------------------------------------- +; These just generate an error report as the ROM is 'incomplete'. +; +; Luckily this provides a mechanism for extending these in a shadow ROM +; but without the powerful mechanisms set up in this ROM. +; An instruction fetch on $0008 may page in a peripheral ROM, +; e.g. the Sinclair Interface 1 ROM, to handle these commands. +; However that wasn't the plan. +; Development of this ROM continued for another three months until the cost +; of replacing it and the manual became unfeasible. +; The ultimate power of channels and streams died at birth. + + ;;;$1793 +CAT_ETC: JR REPORT_OB ; to REPORT_OB + +;------------------ +; Perform AUTO_LIST +;------------------ +; This produces an automatic listing in the upper screen. + + ;;;$1795 +AUTO_LIST: LD (LIST_SP),SP ; save stack pointer in LIST_SP + LD (IY+$02),$10 ; update TV_FLAG set bit 3 + CALL CL_ALL ; routine CL_ALL. + SET 0,(IY+$02) ; update TV_FLAG - signal lower screen in use + LD B,(IY+$31) ; fetch DF_SZ to B. + CALL CL_LINE ; routine CL_LINE clears lower display preserving B. + RES 0,(IY+$02) ; update TV_FLAG - signal main screen in use + SET 0,(IY+$30) ; update FLAGS2 - signal unnecessary to clear main screen. + LD HL,(E_PPC) ; fetch E_PPC current edit line to HL. + LD DE,(S_TOP) ; fetch S_TOP to DE, the current top line + ; (initially zero) + AND A ; prepare for true subtraction. + SBC HL,DE ; subtract and + ADD HL,DE ; add back. + JR C,AUTO_L_2 ; to AUTO_L_2 if S_TOP higher than E_PPC + ; to set S_TOP to E_PPC + PUSH DE ; save the top line number. + CALL LINE_ADDR ; routine LINE_ADDR gets address of E_PPC. + LD DE,$02C0 ; prepare known number of characters in + ; the default upper screen. + EX DE,HL ; offset to HL, program address to DE. + SBC HL,DE ; subtract high value from low to obtain + ; negated result used in addition. + EX (SP),HL ; swap result with top line number on stack. + CALL LINE_ADDR ; routine LINE_ADDR gets address of that + ; top line in HL and next line in DE. + POP BC ; restore the result to balance stack. + + ;;;$17CE +AUTO_L_1: PUSH BC ; save the result. + CALL NEXT_ONE ; routine NEXT_ONE gets address in HL of + ; line after auto-line (in DE). + POP BC ; restore result. + ADD HL,BC ; compute back. + JR C,AUTO_L_3 ; to AUTO_L_3 if line 'should' appear + + EX DE,HL ; address of next line to HL. + LD D,(HL) ; get line + INC HL ; number + LD E,(HL) ; in DE. + DEC HL ; adjust back to start. + LD (S_TOP),DE ; update S_TOP. + JR AUTO_L_1 ; to AUTO_L_1 until estimate reached. + + ; the jump was to here if S_TOP was greater than E_PPC + + ;;;$17E1 +AUTO_L_2: LD (S_TOP),HL ; make S_TOP the same as E_PPC. + + ; continue here with valid starting point from above or good estimate + ; from computation + + ;;;$17E4 +AUTO_L_3: LD HL,(S_TOP) ; fetch S_TOP line number to HL. + CALL LINE_ADDR ; routine LINE_ADDR gets address in HL. + ; address of next in DE. + JR Z,AUTO_L_4 ; to AUTO_L_4 if line exists. + + EX DE,HL ; else use address of next line. + + ;;;$17ED +AUTO_L_4: CALL LIST_ALL ; routine LIST_ALL >>> + + ; The return will be to here if no scrolling occurred + + RES 4,(IY+$02) ; update TV_FLAG - signal no auto listing. + RET ; return. + +;------------- +; Handle LLIST +;------------- +; A short form of LIST #3. The listing goes to stream 3 - default printer. + + ;;;$17F5 +LLIST: LD A,$03 ; the usual stream for ZX Printer + JR LIST_1 ; forward to LIST_1 + +;------------ +; Handle LIST +;------------ +; List to any stream. +; Note. While a starting line can be specified it is +; not possible to specify an end line. +; Just listing a line makes it the current edit line. + + ;;;$17F9 +LIST: LD A,$02 ; default is stream 2 - the upper screen. + + ;;;$17FB +LIST_1: LD (IY+$02),$00 ; the TV_FLAG is initialized. + CALL SYNTAX_Z ; routine SYNTAX_Z - checking syntax ? + CALL NZ,CHAN_OPEN ; routine CHAN_OPEN if in run-time. + RST 18H ; GET_CHAR + CALL STR_ALTER ; routine STR_ALTER will alter if '#'. + JR C,LIST_4 ; forward to LIST_4 not a '#' . + + RST 18H ; GET_CHAR + CP $3B ; is it ';' ? + JR Z,LIST_2 ; skip to LIST_2 if so. + + CP $2C ; is it ',' ? + JR NZ,LIST_3 ; forward to LIST_3 if neither separator. + + ; we have, say, LIST #15, and a number must follow the separator. + + ;;;$1814 +LIST_2: RST 20H ; NEXT_CHAR + CALL EXPT_1NUM ; routine EXPT_1NUM + JR LIST_5 ; forward to LIST_5 + + ; the branch was here with just LIST #3 etc. + + ;;;$181A +LIST_3: CALL USE_ZERO ; routine USE_ZERO + JR LIST_5 ; forward to LIST_5 + + ; the branch was here with LIST + + ;;;$181F +LIST_4: CALL FETCH_NUM ; routine FETCH_NUM checks if a number + ; follows else uses zero. + + ;;;$1822 +LIST_5: CALL CHECK_END ; routine CHECK_END quits if syntax OK >>> + CALL FIND_INT2 ; routine FIND_INT2 fetches the number + ; from the calculator stack in run-time. + LD A,B ; fetch high byte of line number and + AND $3F ; make less than $40 so that NEXT_ONE + ; (from LINE_ADDR) doesn't lose context. + ; Note. this is not satisfactory and the typo + ; LIST 20000 will list an entirely different + ; section than LIST 2000. Such typos are not + ; available for checking if they are direct + ; commands. + + LD H,A ; transfer the modified + LD L,C ; line number to HL. + LD (E_PPC),HL ; update E_PPC to new line number. + CALL LINE_ADDR ; routine LINE_ADDR gets the address of the line. + + ; This routine is called from AUTO_LIST + + ;;;$1833 +LIST_ALL: LD E,$01 ; signal current line not yet printed + + ;;;$1835 +LIST_ALL_2: CALL OUT_LINE ; routine OUT_LINE outputs a BASIC line + ; using PRINT_OUT and makes an early return + ; when no more lines to print. >>> + + RST 10H ; PRINT_A prints the carriage return (in A) + BIT 4,(IY+$02) ; test TV_FLAG - automatic listing ? + JR Z,LIST_ALL_2 ; back to LIST_ALL_2 if not + ; (loop exit is via OUT_LINE) + + ; continue here if an automatic listing required. + + LD A,(DF_SZ) ; fetch DF_SZ lower display file size. + SUB (IY+$4F) ; subtract S_POSN_HI ithe current line number. + JR NZ,LIST_ALL_2 ; back to LIST_ALL_2 if upper screen not full. + XOR E ; A contains zero, E contains one if the + ; current edit line has not been printed + ; or zero if it has (from OUT_LINE). + RET Z ; return if the screen is full and the line + ; has been printed. + + ; continue with automatic listings if the screen is full and the current + ; edit line is missing. OUT_LINE will scroll automatically. + + PUSH HL ; save the pointer address. + PUSH DE ; save the E flag. + LD HL,S_TOP ; fetch S_TOP the rough estimate. + CALL LN_FETCH ; routine LN_FETCH updates S_TOP with the number of the next line. + POP DE ; restore the E flag. + POP HL ; restore the address of the next line. + JR LIST_ALL_2 ; back to LIST_ALL_2. + +;------------------------- +; Print a whole BASIC line +;------------------------- +; This routine prints a whole basic line and it is called +; from LIST_ALL to output the line to current channel +; and from ED_EDIT to 'sprint' the line to the edit buffer. + + ;;;$1855 +OUT_LINE: LD BC,(E_PPC) ; fetch E_PPC the current line which may be + ; unchecked and not exist. + CALL CP_LINES ; routine CP_LINES finds match or line after. + LD D,$3E ; prepare cursor '>' in D. + JR Z,OUT_LINE1 ; to OUT_LINE1 if matched or line after. + + LD DE,$0000 ; put zero in D, to suppress line cursor. + RL E ; pick up carry in E if line before current + ; leave E zero if same or after. + + ;;;$1865 +OUT_LINE1: LD (IY+$2D),E ; save flag in BREG which is spare. + LD A,(HL) ; get high byte of line number. + CP $40 ; is it too high ($2F is maximum possible) ? + POP BC ; drop the return address and + RET NC ; make an early return if so >>> + + PUSH BC ; save return address + CALL OUT_NUM_2 ; routine OUT_NUM_2 to print addressed number + ; with leading space. + INC HL ; skip low number byte. + INC HL ; and the two + INC HL ; length bytes. + RES 0,(IY+$01) ; update FLAGS - signal leading space required. + LD A,D ; fetch the cursor. + AND A ; test for zero. + JR Z,OUT_LINE3 ; to OUT_LINE3 if zero. + + RST 10H ; PRINT_A prints '>' the current line cursor. + + ; this entry point is called from ED_COPY + + ;;;$187D +OUT_LINE2: SET 0,(IY+$01) ; update FLAGS - suppress leading space. + + ;;;$1881 +OUT_LINE3: PUSH DE ; save flag E for a return value. + EX DE,HL ; save HL address in DE. + RES 2,(IY+$30) ; update FLAGS2 - signal NOT in QUOTES. + LD HL,FLAGS ; point to FLAGS. + RES 2,(HL) ; signal 'K' mode. (starts before keyword) + BIT 5,(IY+$37) ; test FLAGX - input mode ? + JR Z,OUT_LINE4 ; forward to OUT_LINE4 if not. + + SET 2,(HL) ; signal 'L' mode. (used for input) + + ;;;$1894 +OUT_LINE4: LD HL,(X_PTR) ; fetch X_PTR - possibly the error pointer address. + AND A ; clear the carry flag. + SBC HL,DE ; test if an error address has been reached. + JR NZ,OUT_LINE5 ; forward to OUT_LINE5 if not. + + LD A,$3F ; load A with '?' the error marker. + CALL OUT_FLASH ; routine OUT_FLASH to print flashing marker. + + ;;;$18A1 +OUT_LINE5: CALL OUT_CURS ; routine OUT_CURS will print the cursor if + ; this is the right position. + EX DE,HL ; restore address pointer to HL. + LD A,(HL) ; fetch the addressed character. + CALL NUMBER ; routine NUMBER skips a hidden floating + ; point number if present. + INC HL ; now increment the pointer. + CP $0D ; is character end-of-line ? + JR Z,OUT_LINE6 ; to OUT_LINE6, if so, as line is finished. + + EX DE,HL ; save the pointer in DE. + CALL OUT_CHAR ; routine OUT_CHAR to output character/token. + JR OUT_LINE4 ; back to OUT_LINE4 until entire line is done. + + ;;;$18B4 +OUT_LINE6: POP DE ; bring back the flag E, zero if current + ; line printed else 1 if still to print. + RET ; return with A holding $0D + +;-------------------------- +; Check for a number marker +;-------------------------- +; this subroutine is called from two processes. while outputting basic lines +; and while searching statements within a basic line. +; during both, this routine will pass over an invisible number indicator +; and the five bytes floating-point number that follows it. +; Note that this causes floating point numbers to be stripped from +; the basic line when it is fetched to the edit buffer by OUT_LINE. +; the number marker also appears after the arguments of a DEF FN statement +; and may mask old 5-byte string parameters. + + ;;;$18B6 +NUMBER: CP $0E ; character fourteen ? + RET NZ ; return if not. + + INC HL ; skip the character + INC HL ; and five bytes + INC HL ; following. + INC HL + INC HL + INC HL + LD A,(HL) ; fetch the following character + RET ; for return value. + +;--------------------------- +; Print a flashing character +;--------------------------- +; This subroutine is called from OUT_LINE to print a flashing error +; marker '?' or from the next routine to print a flashing cursor e.g. 'L'. +; However, this only gets called from OUT_LINE when printing the edit line +; or the input buffer to the lower screen so a direct call to 09F4 can +; be used, even though out-line outputs to other streams. +; In fact the alternate set is used for the whole routine. + + ;;;$18C1 +OUT_FLASH: EXX ; switch in alternate set + LD HL,(ATTRT_MASKT); fetch L = ATTR_T, H = MASK-T + PUSH HL ; save masks. + RES 7,H ; reset flash mask bit so active. + SET 7,L ; make attribute FLASH. + LD (ATTRT_MASKT),HL; resave ATTR_T and MASK-T + LD HL,P_FLAG ; address P_FLAG + LD D,(HL) ; fetch to D + PUSH DE ; and save. + LD (HL),$00 ; clear inverse, over, ink/paper 9 + CALL PRINT_OUT ; routine PRINT_OUT outputs character + ; without the need to vector via RST 10. + POP HL ; pop P_FLAG to H. + LD (IY+$57),H ; and restore system variable P_FLAG. + POP HL ; restore temporary masks + LD (ATTRT_MASKT),HL; and restore system variables ATTR_T/MASK_T + EXX ; switch back to main set + RET ; return + +;----------------- +; Print the cursor +;----------------- +; This routine is called before any character is output while outputting +; a basic line or the input buffer. This includes listing to a printer +; or screen, copying a basic line to the edit buffer and printing the +; input buffer or edit buffer to the lower screen. It is only in the +; latter two cases that it has any relevance and in the last case it +; performs another very important function also. + + ;;;$18E1 +OUT_CURS: LD HL,(K_CUR) ; fetch K_CUR the current cursor address + AND A ; prepare for true subtraction. + SBC HL,DE ; test against pointer address in DE and + RET NZ ; return if not at exact position. + + ; the value of MODE, maintained by KEY_INPUT, is tested and if non-zero + ; then this value 'E' or 'G' will take precedence. + + LD A,(MODE) ; fetch MODE 0='KLC', 1='E', 2='G'. + RLC A ; double the value and set flags. + JR Z,OUT_C_1 ; to OUT_C_1 if still zero ('KLC'). + + ADD A,$43 ; add 'C' - will become 'E' if originally 1 + ; or 'G' if originally 2. + JR OUT_C_2 ; forward to OUT_C_2 to print. + + ; If mode was zero then, while printing a basic line, bit 2 of flags has been + ; set if 'THEN' or ':' was encountered as a main character and reset otherwise. + ; This is now used to determine if the 'K' cursor is to be printed but this + ; transient state is also now transferred permanently to bit 3 of FLAGS + ; to let the interrupt routine know how to decode the next key. + + ;;;$18F3 +OUT_C_1: LD HL,FLAGS ; Address FLAGS + RES 3,(HL) ; signal 'K' mode initially. + LD A,$4B ; prepare letter 'K'. + BIT 2,(HL) ; test FLAGS - was the + ; previous main character ':' or 'THEN' ? + JR Z,OUT_C_2 ; forward to OUT_C_2 if so to print. + + SET 3,(HL) ; signal 'L' mode to interrupt routine. + ; Note. transient bit has been made permanent. + INC A ; augment from 'K' to 'L'. + BIT 3,(IY+$30) ; test FLAGS2 - consider caps lock ? + ; which is maintained by KEY_INPUT. + JR Z,OUT_C_2 ; forward to OUT_C_2 if not set to print. + + LD A,$43 ; alter 'L' to 'C'. + + ;;;$1909 +OUT_C_2: PUSH DE ; save address pointer but OK as OUT_FLASH + ; uses alternate set without RST 10. + CALL OUT_FLASH ; routine OUT_FLASH to print. + POP DE ; restore and + RET ; return. + +;----------------------------- +; Get line number of next line +;----------------------------- +; These two subroutines are called while editing. +; This entry point is from ED_DOWN with HL addressing E_PPC +; to fetch the next line number. +; Also from AUTO_LIST with HL addressing S_TOP just to update S_TOP +; with the value of the next line number. It gets fetched but is discarded. +; These routines never get called while the editor is being used for input. + + ;;;$190F +LN_FETCH: LD E,(HL) ; fetch low byte + INC HL ; address next + LD D,(HL) ; fetch high byte. + PUSH HL ; save system variable hi pointer. + EX DE,HL ; line number to HL, + INC HL ; increment as a starting point. + CALL LINE_ADDR ; routine LINE_ADDR gets address in HL. + CALL LINE_NO ; routine LINE_NO gets line number in DE. + POP HL ; restore system variable hi pointer. + + ; This entry point is from the ED_UP with HL addressing E_PPC_HI + + ;;;$191C +LN_STORE: BIT 5,(IY+$37) ; test FLAGX - input mode ? + RET NZ ; return if so. + ; Note. above already checked by ED_UP/ED_DOWN. + + LD (HL),D ; save high byte of line number. + DEC HL ; address lower + LD (HL),E ; save low byte of line number. + RET ; return. + +;------------------------------------------ +; Outputting numbers at start of BASIC line +;------------------------------------------ +; This routine entered at OUT_SP_NO is used to compute then output the first +; three digits of a 4-digit basic line printing a space if necessary. +; The line number, or residual part, is held in HL and the BC register +; holds a subtraction value -1000, -100 or -10. +; Note. for example line number 200 - +; space(out_char), 2(out_code), 0(out_char) final number always out-code. + + ;;;$1925 +OUT_SP_2: LD A,E ; will be space if OUT_CODE not yet called. + ; or $FF if spaces are suppressed. + ; else $30 ('0'). + ; (from the first instruction at OUT_CODE) + ; this guy is just too clever. + AND A ; test bit 7 of A. + RET M ; return if $FF, as leading spaces not + ; required. This is set when printing line + ; number and statement in MAIN_5. + + JR OUT_CHAR ; forward to exit via OUT_CHAR. + + ; -> the single entry point. + + ;;;$192A +OUT_SP_NO: XOR A ; initialize digit to 0 + + ;;;$192B +OUT_SP_1: ADD HL,BC ; add negative number to HL. + INC A ; increment digit + JR C,OUT_SP_1 ; back to OUT_SP_1 until no carry from + ; the addition. + SBC HL,BC ; cancel the last addition + DEC A ; and decrement the digit. + JR Z,OUT_SP_2 ; back to OUT_SP_2 if it is zero. + + JP OUT_CODE ; jump back to exit via OUT_CODE. -> + + +;-------------------------------------- +; Outputting characters in a BASIC line +;-------------------------------------- +; This subroutine ... + + ;;;$1937 +OUT_CHAR: CALL NUMERIC ; routine NUMERIC tests if it is a digit ? + JR NC,OUT_CH_3 ; to OUT_CH_3 to print digit without + ; changing mode. Will be 'K' mode if digits + ; are at beginning of edit line. + CP $21 ; less than quote character ? + JR C,OUT_CH_3 ; to OUT_CH_3 to output controls and space. + + RES 2,(IY+$01) ; initialize FLAGS to 'K' mode and leave + ; unchanged if this character would precede a keyword. + CP $CB ; is character 'THEN' token ? + JR Z,OUT_CH_3 ; to OUT_CH_3 to output if so. + + CP $3A ; is it ':' ? + JR NZ,OUT_CH_1 ; to OUT_CH_1 if not statement separator + ; to change mode back to 'L'. + BIT 5,(IY+$37) ; FLAGX - Input Mode ?? + JR NZ,OUT_CH_2 ; to OUT_CH_2 if in input as no statements. + ; Note. this check should seemingly be at + ; the start. Commands seem inappropriate in + ; INPUT mode and are rejected by the syntax checker anyway. + ; unless INPUT LINE is being used. + BIT 2,(IY+$30) ; test FLAGS2 - is the ':' within quotes ? + JR Z,OUT_CH_3 ; to OUT_CH_3 if ':' is outside quoted text. + + JR OUT_CH_2 ; to OUT_CH_2 as ':' is within quotes + + ;;;$195A +OUT_CH_1: CP $22 ; is it quote character '"' ? + JR NZ,OUT_CH_2 ; to OUT_CH_2 with others to set 'L' mode. + + PUSH AF ; save character. + LD A,(FLAGS2) ; fetch FLAGS2. + XOR $04 ; toggle the quotes flag. + LD (FLAGS2),A ; update FLAGS2 + POP AF ; and restore character. + + ;;;$1968 +OUT_CH_2: SET 2,(IY+$01) ; update FLAGS - signal L mode if the cursor + ; is next. + + ;;;$196C +OUT_CH_3: RST 10H ; PRINT_A vectors the character to + ; channel 'S', 'K', 'R' or 'P'. + RET ; return. + +;-------------------------------------------- +; Get starting address of line, or line after +;-------------------------------------------- +; This routine is used often to get the address, in HL, of a basic line +; number supplied in HL, or failing that the address of the following line +; and the address of the previous line in DE. + + ;;;$196E +LINE_ADDR: PUSH HL ; save line number in HL register + LD HL,(PROG) ; fetch start of program from PROG + LD D,H ; transfer address to + LD E,L ; the DE register pair. + + ;;;$1974 +LINE_AD_1: POP BC ; restore the line number to BC + CALL CP_LINES ; routine CP_LINES compares with that addressed by HL + RET NC ; return if line has been passed or matched. + ; if NZ, address of previous is in DE + PUSH BC ; save the current line number + CALL NEXT_ONE ; routine NEXT_ONE finds address of next line number in DE, previous in HL. + EX DE,HL ; switch so next in HL + JR LINE_AD_1 ; back to LINE_AD_1 for another comparison + +;--------------------- +; Compare line numbers +;--------------------- +; This routine compares a line number supplied in BC with an addressed +; line number pointed to by HL. + + ;;;$1980 +CP_LINES: LD A,(HL) ; Load the high byte of line number and + CP B ; compare with that of supplied line number. + RET NZ ; return if yet to match (carry will be set). + + INC HL ; address low byte of + LD A,(HL) ; number and pick up in A. + DEC HL ; step back to first position. + CP C ; now compare. + RET ; zero set if exact match. + ; carry set if yet to match. + ; no carry indicates a match or + ; next available basic line or + ; program end marker. + +;-------------------- +; Find each statement +;-------------------- +; The single entry point EACH_STMT is used to +; 1) To find the D'th statement in a line. +; 2) To find a token in held E. + + ;;;$1988 +NOT_USED: INC HL + INC HL + INC HL + ; -> entry point. + + ;;;$198B +EACH_STMT: LD (CH_ADD),HL ; save HL in CH_ADD + LD C,$00 ; initialize quotes flag + + ;;;$1990 +EACH_S_1: DEC D ; decrease statement count + RET Z ; return if zero + + RST 20H ; NEXT_CHAR + CP E ; is it the search token ? + JR NZ,EACH_S_3 ; forward to EACH_S_3 if not + + AND A ; clear carry + RET ; return signalling success. + + ;;;$1998 +EACH_S_2: INC HL ; next address + LD A,(HL) ; next character + + ;;;$199A +EACH_S_3: CALL NUMBER ; routine NUMBER skips if number marker + LD (CH_ADD),HL ; save in CH_ADD + CP $22 ; is it quotes '"' ? + JR NZ,EACH_S_4 ; to EACH_S_4 if not + + DEC C ; toggle bit 0 of C + + ;;;$19A5 +EACH_S_4: CP $3A ; is it ':' + JR Z,EACH_S_5 ; to EACH_S_5 + + CP $CB ; 'THEN' + JR NZ,EACH_S_6 ; to EACH_S_6 + + ;;;$19AD +EACH_S_5: BIT 0,C ; is it in quotes + JR Z,EACH_S_1 ; to EACH_S_1 if not + + ;;;$19B1 +EACH_S_6: CP $0D ; end of line ? + JR NZ,EACH_S_2 ; to EACH_S_2 + + DEC D ; decrease the statement counter + ; which should be zero else + ; 'Statement Lost'. + SCF ; set carry flag - not found + RET ; return + +;------------------------------------------------------------------------ +; Storage of variables. For full details - see chapter 24. +; ZX Spectrum BASIC Programming by Steven Vickers 1982. +; It is bits 7-5 of the first character of a variable that allow +; the six types to be distinguished. Bits 4-0 are the reduced letter. +; So any variable name is higher that $3F and can be distinguished +; also from the variables area end-marker $80. +; +; 76543210 meaning brief outline of format. +; -------- ------------------------ ----------------------- +; 010 string variable. 2 byte length + contents. +; 110 string array. 2 byte length + contents. +; 100 array of numbers. 2 byte length + contents. +; 011 simple numeric variable. 5 bytes. +; 101 variable length named numeric. 5 bytes. +; 111 for-next loop variable. 18 bytes. +; 10000000 the variables area end-marker. +; +; Note. any of the above seven will serve as a program end-marker. +; +; ----------------------------------------------------------------------- + +;------------- +; Get next one +;------------- +; This versatile routine is used to find the address of the next line +; in the program area or the next variable in the variables area. +; The reason one routine is made to handle two apparently unrelated tasks +; is that it can be called indiscriminately when merging a line or a +; variable. + + ;;;$19B8 +NEXT_ONE: PUSH HL ; save the pointer address. + LD A,(HL) ; get first byte. + CP $40 ; compare with upper limit for line numbers. + JR C,NEXT_O_3 ; forward to NEXT_O_3 if within basic area. + + ; the continuation here is for the next variable unless the supplied + ; line number was erroneously over 16383. see RESTORE command. + + BIT 5,A ; is it a string or an array variable ? + JR Z,NEXT_O_4 ; forward to NEXT_O_4 to compute length. + + ADD A,A ; test bit 6 for single-character variables. + JP M,NEXT_O_1 ; forward to NEXT_O_1 if so + + CCF ; clear the carry for long-named variables. + ; it remains set for for-next loop variables. + + ;;;$19C7 +NEXT_O_1: LD BC,$0005 ; set BC to 5 for floating point number + JR NC,NEXT_O_2 ; forward to NEXT_O_2 if not a for/next + ; variable. + LD C,$12 ; set BC to eighteen locations. + ; value, limit, step, line and statement. + + ; now deal with long-named variables + + ;;;$19CE +NEXT_O_2: RLA ; test if character inverted. carry will also + ; be set for single character variables + INC HL ; address next location. + LD A,(HL) ; and load character. + JR NC,NEXT_O_2 ; back to NEXT_O_2 if not inverted bit. + ; forward immediately with single character + ; variable names. + JR NEXT_O_5 ; forward to NEXT_O_5 to add length of + ; floating point number(s etc.). + + ; this branch is for line numbers. + + ;;;$19D5 +NEXT_O_3: INC HL ; increment pointer to low byte of line no. + + ; strings and arrays rejoin here + + ;;;$19D6 +NEXT_O_4: INC HL ; increment to address the length low byte. + LD C,(HL) ; transfer to C and + INC HL ; point to high byte of length. + LD B,(HL) ; transfer that to B + INC HL ; point to start of basic/variable contents. + + ; the three types of numeric variables rejoin here + + ;;;$19DB +NEXT_O_5: ADD HL,BC ; add the length to give address of next line/variable in HL. + POP DE ; restore previous address to DE. + +;------------------- +; Difference routine +;------------------- +; This routine terminates the above routine and is also called from the +; start of the next routine to calculate the length to reclaim. + + ;;;$19DD +DIFFER: AND A ; prepare for true subtraction. + SBC HL,DE ; subtract the two pointers. + LD B,H ; transfer result + LD C,L ; to BC register pair. + ADD HL,DE ; add back + EX DE,HL ; and switch pointers + RET ; return values are the length of area in BC, + ; low pointer (previous) in HL, + ; high pointer (next) in DE. + +;------------------------ +; Handle reclaiming space +;------------------------ +; + + ;;;$19E5 +RECLAIM_1: CALL DIFFER ; routine DIFFER immediately above + + ;;;$19E8 +RECLAIM_2: PUSH BC + LD A,B + CPL + LD B,A + LD A,C + CPL + LD C,A + INC BC + CALL POINTERS ; routine POINTERS + EX DE,HL + POP HL + ADD HL,DE + PUSH DE + LDIR ; copy bytes + POP HL + RET + +;----------------------------------------- +; Read line number of line in editing area +;----------------------------------------- +; This routine reads a line number in the editing area returning the number +; in the BC register or zero if no digits exist before commands. +; It is called from LINE_SCAN to check the syntax of the digits. +; It is called from MAIN_3 to extract the line number in preparation for +; inclusion of the line in the BASIC program area. +; +; Interestingly the calculator stack is moved from it's normal place at the +; end of dynamic memory to an adequate area within the system variables area. +; This ensures that in a low memory situation, that valid line numbers can +; be extracted without raising an error and that memory can be reclaimed +; by deleting lines. If the stack was in it's normal place then a situation +; arises whereby the Spectrum becomes locked with no means of reclaiming space. + + ;;;$19FB +E_LINE_NO: LD HL,(E_LINE) ; load HL from system variable E_LINE. + DEC HL ; decrease so that NEXT_CHAR can be used + ; without skipping the first digit. + LD (CH_ADD),HL ; store in the system variable CH_ADD. + RST 20H ; NEXT_CHAR skips any noise and white-space + ; to point exactly at the first digit. + LD HL,MEM_0 ; use MEM_0 as a temporary calculator stack + ; an overhead of three locations are needed. + LD (STKEND),HL ; set new STKEND. + CALL INT_TO_FP ; routine INT_TO_FP will read digits till + ; a non-digit found. + CALL FP_TO_BC ; routine FP_TO_BC will retrieve number from stack at membot. + JR C,E_L_1 ; forward to E_L_1 if overflow i.e. > 65535. + ; 'Nonsense in basic' + LD HL,$D8F0 ; load HL with value -9999 + ADD HL,BC ; add to line number in BC + + ;;;$1A15 +E_L_1: JP C,REPORT_C ; to REPORT_C 'Nonsense in Basic' if over. + ; Note. As ERR_SP points to ED_ERROR + ; the report is never produced although + ; the RST $08 will update X_PTR leading to + ; the error marker being displayed when + ; the ED_LOOP is reiterated. + ; in fact, since it is immediately + ; cancelled, any report will do. + + ; a line in the range 0 - 9999 has been entered. + + JP SET_STK ; jump back to SET_STK to set the calculator + ; stack back to it's normal place and exit + ; from there. + +;---------------------------------- +; Report and line number outputting +;---------------------------------- +; Entry point OUT_NUM_1 is used by the Error Reporting code to print +; the line number and later the statement number held in BC. +; If the statement was part of a direct command then -2 is used as a +; dummy line number so that zero will be printed in the report. +; This routine is also used to print the exponent of E-format numbers. +; +; Entry point OUT_NUM_2 is used from OUT_LINE to output the line number +; addressed by HL with leading spaces if necessary. + + ;;;$1A1B +OUT_NUM_1: PUSH DE ; save the + PUSH HL ; registers. + XOR A ; set A to zero. + BIT 7,B ; is the line number minus two ? + JR NZ,OUT_NUM_4 ; forward to OUT_NUM_4 if so to print zero + ; for a direct command. + LD H,B ; transfer the + LD L,C ; number to HL. + LD E,$FF ; signal 'no leading zeros'. + JR OUT_NUM_3 ; forward to continue at OUT_NUM_3 + + ; from OUT_LINE - HL addresses line number. + + ;;;$1A28 +OUT_NUM_2: PUSH DE ; save flags + LD D,(HL) ; high byte to D + INC HL ; address next + LD E,(HL) ; low byte to E + PUSH HL ; save pointer + EX DE,HL ; transfer number to HL + LD E,$20 ; signal 'output leading spaces' + + ;;;$1A30 +OUT_NUM_3: LD BC,$FC18 ; value -1000 + CALL OUT_SP_NO ; routine OUT_SP_NO outputs space or number + LD BC,$FF9C ; value -100 + CALL OUT_SP_NO ; routine OUT_SP_NO + LD C,$F6 ; value -10 ( B is still $FF ) + CALL OUT_SP_NO ; routine OUT_SP_NO + LD A,L ; remainder to A. + + ;;;$1A42 +OUT_NUM_4: CALL OUT_CODE ; routine OUT_CODE for final digit. + ; else report code zero wouldn't get printed. + POP HL ; restore the + POP DE ; registers and + RET ; return. + + +;*************************************************** +;** Part 7. BASIC LINE AND COMMAND INTERPRETATION ** +;*************************************************** + +;----------------- +; The offset table +;----------------- +; The BASIC interpreter has found a command code $CE - $FF +; which is then reduced to range $00 - $31 and added to the base address +; of this table to give the address of an offset which, when added to +; the offset therein, gives the location in the following parameter table +; where a list of class codes, separators and addresses relevant to the +; command exists. + + ;;;$1A48 +OFFST_TBL: DEFB P_DEF_FN - $ ; B1 offset to Address: P_DEF_FN + DEFB P_CAT - $ ; CB offset to Address: P_CAT + DEFB P_FORMAT - $ ; BC offset to Address: P_FORMAT + DEFB P_MOVE - $ ; BF offset to Address: P_MOVE + DEFB P_ERASE - $ ; C4 offset to Address: P_ERASE + DEFB P_OPEN - $ ; AF offset to Address: P_OPEN + DEFB P_CLOSE - $ ; B4 offset to Address: P_CLOSE + DEFB P_MERGE - $ ; 93 offset to Address: P_MERGE + DEFB P_VERIFY - $ ; 91 offset to Address: P_VERIFY + DEFB P_BEEP - $ ; 92 offset to Address: P_BEEP + DEFB P_CIRCLE - $ ; 95 offset to Address: P_CIRCLE + DEFB P_INK - $ ; 98 offset to Address: P_INK + DEFB P_PAPER - $ ; 98 offset to Address: P_PAPER + DEFB P_FLASH - $ ; 98 offset to Address: P_FLASH + DEFB P_BRIGHT - $ ; 98 offset to Address: P_BRIGHT + DEFB P_INVERSE - $ ; 98 offset to Address: P_INVERSE + DEFB P_OVER - $ ; 98 offset to Address: P_OVER + DEFB P_OUT - $ ; 98 offset to Address: P_OUT + DEFB P_LPRINT - $ ; 7F offset to Address: P_LPRINT + DEFB P_LLIST - $ ; 81 offset to Address: P_LLIST + DEFB P_STOP - $ ; 2E offset to Address: P_STOP + DEFB P_READ - $ ; 6C offset to Address: P_READ + DEFB P_DATA - $ ; 6E offset to Address: P_DATA + DEFB P_RESTORE - $ ; 70 offset to Address: P_RESTORE + DEFB P_NEW - $ ; 48 offset to Address: P_NEW + DEFB P_BORDER - $ ; 94 offset to Address: P_BORDER + DEFB P_CONT - $ ; 56 offset to Address: P_CONT + DEFB P_DIM - $ ; 3F offset to Address: P_DIM + DEFB P_REM - $ ; 41 offset to Address: P_REM + DEFB P_FOR - $ ; 2B offset to Address: P_FOR + DEFB P_GO_TO - $ ; 17 offset to Address: P_GO_TO + DEFB P_GO_SUB - $ ; 1F offset to Address: P_GO_SUB + DEFB P_INPUT - $ ; 37 offset to Address: P_INPUT + DEFB P_LOAD - $ ; 77 offset to Address: P_LOAD + DEFB P_LIST - $ ; 44 offset to Address: P_LIST + DEFB P_LET - $ ; 0F offset to Address: P_LET + DEFB P_PAUSE - $ ; 59 offset to Address: P_PAUSE + DEFB P_NEXT - $ ; 2B offset to Address: P_NEXT + DEFB P_POKE - $ ; 43 offset to Address: P_POKE + DEFB P_PRINT - $ ; 2D offset to Address: P_PRINT + DEFB P_PLOT - $ ; 51 offset to Address: P_PLOT + DEFB P_RUN - $ ; 3A offset to Address: P_RUN + DEFB P_SAVE - $ ; 6D offset to Address: P_SAVE + DEFB P_RANDOM - $ ; 42 offset to Address: P_RANDOM + DEFB P_IF - $ ; 0D offset to Address: P_IF + DEFB P_CLS - $ ; 49 offset to Address: P_CLS + DEFB P_DRAW - $ ; 5C offset to Address: P_DRAW + DEFB P_CLEAR - $ ; 44 offset to Address: P_CLEAR + DEFB P_RETURN - $ ; 15 offset to Address: P_RETURN + DEFB P_COPY - $ ; 5D offset to Address: P_COPY + +;-------------------------------- +; The parameter or "Syntax" table +;-------------------------------- +; For each command there exists a variable list of parameters. +; If the character is greater than a space it is a required separator. +; If less, then it is a command class in the range 00 - 0B. +; Note that classes 00, 03 and 05 will fetch the addresses from this table. +; Some classes e.g. 07 and 0B have the same address in all invocations +; and the command is re-computed from the low-byte of the parameter address. +; Some e.g. 02 are only called once so a call to the command is made from +; within the class routine rather than holding the address within the table. +; Some class routines check syntax entirely and some leave this task for the +; command itself. +; Others for example CIRCLE (x,y,z) check the first part (x,y) using the +; class routine and the final part (,z) within the command. +; The last few commands appear to have been added in a rush but their syntax +; is rather simple e.g. MOVE "M1","M2" + + ;;;$1A7A +P_LET: DEFB $01 ; CLASS_01 - A variable is required. + DEFB $3D ; Separator: '=' + DEFB $02 ; CLASS_02 - An expression, numeric or string, must follow. + + ;;;$1A7D +P_GO_TO: DEFB $06 ; CLASS_06 - A numeric expression must follow. + DEFB $00 ; CLASS_00 - No further operands. + DEFW GO_TO ; Address: $1E67; Address: GO_TO + + ;;;$1A81 +P_IF: DEFB $06 ; CLASS_06 - A numeric expression must follow. + DEFB $CB ; Separator: 'THEN' + DEFB $05 ; CLASS_05 - Variable syntax checked by routine. + DEFW IF_CMD ; Address: $1CF0; Address: IF + + ;;;$1A86 +P_GO_SUB: DEFB $06 ; CLASS_06 - A numeric expression must follow. + DEFB $00 ; CLASS_00 - No further operands. + DEFW GO_SUB ; Address: $1EED; Address: GO_SUB + + ;;;$1A8A +P_STOP: DEFB $00 ; CLASS_00 - No further operands. + DEFW STOP ; Address: $1CEE; Address: STOP + + ;;;$1A8D +P_RETURN: DEFB $00 ; CLASS_00 - No further operands. + DEFW RETURN ; Address: $1F23; Address: RETURN + + ;;;$1A90 +P_FOR: DEFB $04 ; CLASS_04 - A single character variable must follow. + DEFB $3D ; Separator: '=' + DEFB $06 ; CLASS_06 - A numeric expression must follow. + DEFB $CC ; Separator: 'TO' + DEFB $06 ; CLASS_06 - A numeric expression must follow. + DEFB $05 ; CLASS_05 - Variable syntax checked by routine. + DEFW FOR ; Address: $1D03; Address: FOR + + ;;;$1A98 +P_NEXT: DEFB $04 ; CLASS_04 - A single character variable must follow. + DEFB $00 ; CLASS_00 - No further operands. + DEFW NEXT ; Address: $1DAB; Address: NEXT + + ;;;$1A9C +P_PRINT: DEFB $05 ; CLASS_05 - Variable syntax checked entirely by routine. + DEFW PRINT ; Address: $1FCD; Address: PRINT + + ;;;$1A9F +P_INPUT: DEFB $05 ; CLASS_05 - Variable syntax checked entirely by routine. + DEFW INPUT ; Address: $2089; Address: INPUT + + ;;;$1AA2 +P_DIM: DEFB $05 ; CLASS_05 - Variable syntax checked entirely by routine. + DEFW DIM ; Address: $2C02; Address: DIM + + ;;;$1AA5 +P_REM: DEFB $05 ; CLASS_05 - Variable syntax checked entirely by routine. + DEFW REM ; Address: $1BB2; Address: REM + + ;;;$1AA8 +P_NEW: DEFB $00 ; CLASS_00 - No further operands. + DEFW NEW ; Address: $11B7; Address: NEW + + ;;;$1AAB +P_RUN: DEFB $03 ; CLASS_03 - A numeric expression may follow else default to zero. + DEFW RUN ; Address: $1EA1; Address: RUN + + ;;;$1AAE +P_LIST: DEFB $05 ; CLASS_05 - Variable syntax checked entirely by routine. + DEFW LIST ; Address: $17F9; Address: LIST + + ;;;$1AB1 +P_POKE: DEFB $08 ; CLASS_08 - Two comma-separated numeric expressions required. + DEFB $00 ; CLASS_00 - No further operands. + DEFW POKE ; Address: $1E80; Address: POKE + + ;;;$1AB5 +P_RANDOM: DEFB $03 ; CLASS_03 - A numeric expression may follow else default to zero. + DEFW RANDOMIZE ; Address: $1E4F; Address: RANDOMIZE + + ;;;$1AB8 +P_CONT: DEFB $00 ; CLASS_00 - No further operands. + DEFW CONTINUE ; Address: $1E5F; Address: CONTINUE + + ;;;$1ABB +P_CLEAR: DEFB $03 ; CLASS_03 - A numeric expression may follow else default to zero. + DEFW CLEAR ; Address: $1EAC; Address: CLEAR + + ;;;$1ABE +P_CLS: DEFB $00 ; CLASS_00 - No further operands. + DEFW CLS ; Address: $0D6B; Address: CLS + + ;;;$1AC1 +P_PLOT: DEFB $09 ; CLASS_09 - Two comma-separated numeric expressions required with optional colour items. + DEFB $00 ; CLASS_00 - No further operands. + DEFW PLOT ; Address: $22DC; Address: PLOT + + ;;;$1AC5 +P_PAUSE: DEFB $06 ; CLASS_06 - A numeric expression must follow. + DEFB $00 ; CLASS_00 - No further operands. + DEFW PAUSE ; Address: $1F3A; Address: PAUSE + + ;;;$1AC9 +P_READ: DEFB $05 ; CLASS_05 - Variable syntax checked entirely by routine. + DEFW READ ; Address: $1DED; Address: READ + + ;;;$1ACC +P_DATA: DEFB $05 ; CLASS_05 - Variable syntax checked entirely by routine. + DEFW DATA ; Address: $1E27; Address: DATA + + ;;;$1ACF +P_RESTORE: DEFB $03 ; CLASS_03 - A numeric expression may follow else default to zero. + DEFW RESTORE ; Address: $1E42; Address: RESTORE + + ;;;$1AD2 +P_DRAW: DEFB $09 ; CLASS_09 - Two comma-separated numeric expressions required with optional colour items. + DEFB $05 ; CLASS_05 - Variable syntax checked by routine. + DEFW DRAW ; Address: $2382; Address: DRAW + + ;;;$1AD6 +P_COPY: DEFB $00 ; CLASS_00 - No further operands. + DEFW COPY ; Address: $0EAC; Address: COPY + + ;;;$1AD9 +P_LPRINT: DEFB $05 ; CLASS_05 - Variable syntax checked entirely by routine. + DEFW LPRINT ; Address: $1FC9; Address: LPRINT + + ;;;$1ADC +P_LLIST: DEFB $05 ; CLASS_05 - Variable syntax checked entirely by routine. + DEFW LLIST ; Address: $17F5; Address: LLIST + + ;;;$1ADF +P_SAVE: DEFB $0B ; CLASS_0B - Offset address converted to tape command. + + ;;;$L1AE0 +P_LOAD: DEFB $0B ; CLASS_0B - Offset address converted to tape command. + + ;;;$1AE1 +P_VERIFY: DEFB $0B ; CLASS_0B - Offset address converted to tape command. + + ;;;$1AE2 +P_MERGE: DEFB $0B ; CLASS_0B - Offset address converted to tape command. + + ;;;$1AE3 +P_BEEP: DEFB $08 ; CLASS_08 - Two comma-separated numeric expressions required. + DEFB $00 ; CLASS_00 - No further operands. + DEFW BEEP ; Address: $03F8; Address: BEEP + + ;;;$1AE7 +P_CIRCLE: DEFB $09 ; CLASS_09 - Two comma-separated numeric expressions required with optional colour items. + DEFB $05 ; CLASS_05 - Variable syntax checked by routine. + DEFW CIRCLE ; Address: $2320; Address: CIRCLE + + ;;;$1AEB +P_INK: DEFB $07 ; CLASS_07 - Offset address is converted to colour code. + ; + + ;;;$1AEC +P_PAPER: DEFB $07 ; CLASS_07 - Offset address is converted to colour code. + + ;;;$1AED +P_FLASH: DEFB $07 ; CLASS_07 - Offset address is converted to colour code. + + ;;;$1AEE +P_BRIGHT: DEFB $07 ; CLASS_07 - Offset address is converted to colour code. + + ;;;$1AEF +P_INVERSE: DEFB $07 ; CLASS_07 - Offset address is converted to colour code. + + ;;;$1AF0 +P_OVER: DEFB $07 ; CLASS_07 - Offset address is converted to colour code. + + ;;;$1AF1 +P_OUT: DEFB $08 ; CLASS_08 - Two comma-separated numeric expressions required. + DEFB $00 ; CLASS_00 - No further operands. + DEFW OUT_CMD ; Address: $1E7A; Address: OUT + + ;;;$1AF5 +P_BORDER: DEFB $06 ; CLASS_06 - A numeric expression must follow. + DEFB $00 ; CLASS_00 - No further operands. + DEFW BORDER ; Address: $2294; Address: BORDER + + ;;;$1AF9 +P_DEF_FN: DEFB $05 ; CLASS_05 - Variable syntax checked entirely by routine. + DEFW DEF_FN ; Address: $1F60; Address: DEF_FN + + ;;;$1AFC +P_OPEN: DEFB $06 ; CLASS_06 - A numeric expression must follow. + DEFB $2C ; Separator: ',' see Footnote * + DEFB $0A ; CLASS_0A - A string expression must follow. + DEFB $00 ; CLASS_00 - No further operands. + DEFW OPEN ; Address: $1736; Address: OPEN + + ;;;$1B02 +P_CLOSE: DEFB $06 ; CLASS_06 - A numeric expression must follow. + DEFB $00 ; CLASS_00 - No further operands. + DEFW CLOSE ; Address: $16E5; Address: CLOSE + + ;;;$1B06 +P_FORMAT: DEFB $0A ; CLASS_0A - A string expression must follow. + DEFB $00 ; CLASS_00 - No further operands. + DEFW CAT_ETC ; Address: $1793; Address: CAT_ETC + + ;;;$1B0A +P_MOVE: DEFB $0A ; CLASS_0A - A string expression must follow. + DEFB $2C ; Separator: ',' + DEFB $0A ; CLASS_0A - A string expression must follow. + DEFB $00 ; CLASS_00 - No further operands. + DEFW CAT_ETC ; Address: $1793; Address: CAT_ETC + + ;;;$1B10 +P_ERASE: DEFB $0A ; CLASS_0A - A string expression must follow. + DEFB $00 ; CLASS_00 - No further operands. + DEFW CAT_ETC ; Address: $1793; Address: CAT_ETC + + ;;;$1B14 +P_CAT: DEFB $00 ; CLASS_00 - No further operands. + DEFW CAT_ETC ; Address: $1793; Address: CAT_ETC + + ; * Note that a comma is required as a separator with the OPEN command + ; but the Interface 1 programmers relaxed this allowing ';' as an + ; alternative for their channels creating a confusing mixture of + ; allowable syntax as it is this ROM which opens or re-opens the + ; normal channels. + +;-------------------------------- +; Main parser (BASIC interpreter) +;-------------------------------- +; This routine is called once from MAIN_2 when the Basic line is to +; be entered or re-entered into the Program area and the syntax +; requires checking. + + ;;;$1B17 +LINE_SCAN: RES 7,(IY+$01) ; update FLAGS - signal checking syntax + CALL E_LINE_NO ; routine E_LINE_NO >> + ; fetches the line number if in range. + XOR A ; clear the accumulator. + LD (SUBPPC),A ; set statement number SUBPPC to zero. + DEC A ; set accumulator to $FF. + LD (ERR_NR),A ; set ERR_NR to 'OK' - 1. + JR STMT_L_1 ; forward to continue at STMT_L_1. + +;--------------- +; Statement loop +;--------------- + + ;;;$1B28 +STMT_LOOP: RST 20H ; NEXT_CHAR + + ; -> the entry point from above or LINE_RUN + ;;;$1B29 +STMT_L_1: CALL SET_WORK ; routine SET_WORK clears workspace etc. + INC (IY+$0D) ; increment statement number SUBPPC + JP M,REPORT_C ; to REPORT_C to raise + ; 'Nonsense in basic' if over 127. + RST 18H ; GET_CHAR + LD B,$00 ; set B to zero for later indexing. + ; early so any other reason ??? + CP $0D ; is character carriage return ? + ; i.e. an empty statement. + JR Z,LINE_END ; forward to LINE_END if so. + + CP $3A ; is it statement end marker ':' ? + ; i.e. another type of empty statement. + JR Z,STMT_LOOP ; back to STMT_LOOP if so. + + LD HL,STMT_RET ; address: STMT_RET + PUSH HL ; is now pushed as a return address + LD C,A ; transfer the current character to C. + + ; advance CH_ADD to a position after command and test if it is a command. + + RST 20H ; NEXT_CHAR to advance pointer + LD A,C ; restore current character + SUB $CE ; subtract 'DEF FN' - first command + JP C,REPORT_C ; jump to REPORT_C if less than a command raising + ; 'Nonsense in basic' + LD C,A ; put the valid command code back in C. + ; register B is zero. + LD HL,OFFST_TBL ; address: OFFST_TBL + ADD HL,BC ; index into table with one of 50 commands. + LD C,(HL) ; pick up displacement to syntax table entry. + ADD HL,BC ; add to address the relevant entry. + JR GET_PARAM ; forward to continue at GET_PARAM + +;----------------------- +; The main scanning loop +;----------------------- +; not documented properly + + ;;;$1B52 +SCAN_LOOP: LD HL,(T_ADDR) ; fetch temporary address from T_ADDR + ; during subsequent loops. + + ; -> the initial entry point with HL addressing start of syntax table entry. + + ;;;$1B55 +GET_PARAM: LD A,(HL) ; pick up the parameter. + INC HL ; address next one. + LD (T_ADDR),HL ; save pointer in system variable T_ADDR + LD BC,SCAN_LOOP ; address: SCAN_LOOP + PUSH BC ; is now pushed on stack as looping address. + LD C,A ; store parameter in C. + CP $20 ; is it greater than ' ' ? + JR NC,SEPARATOR ; forward to SEPARATOR to check that correct + ; separator appears in statement if so. + LD HL,CLASS_TBL ; address: CLASS_TBL. + LD B,$00 ; prepare to index into the class table. + ADD HL,BC ; index to find displacement to routine. + LD C,(HL) ; displacement to BC + ADD HL,BC ; add to address the CLASS routine. + PUSH HL ; push the address on the stack. + RST 18H ; GET_CHAR - HL points to place in statement. + DEC B ; reset the zero flag - the initial state + ; for all class routines. + RET ; and make an indirect jump to routine + ; and then SCAN_LOOP (also on stack). + + ; Note. one of the class routines will eventually drop the return address + ; off the stack breaking out of the above seemingly endless loop. + +;----------------- +; Verify separator +;----------------- +; This routine is called once to verify that the mandatory separator +; present in the parameter table is also present in the correct +; location following the command. For example, the 'THEN' token after +; the 'IF' token and expression. + + ;;;$1B6F +SEPARATOR: RST 18H ; GET_CHAR + CP C ; does it match the character in C ? + JP NZ,REPORT_C ; jump forward to REPORT_C if not + ; 'Nonsense in basic'. + + RST 20H ; NEXT_CHAR advance to next character + RET ; return. + +;------------------------------- +; Come here after interpretation +;------------------------------- + + ;;;$1B76 +STMT_RET: CALL BREAK_KEY ; routine BREAK_KEY is tested after every statement. + JR C,STMT_R_1 ; step forward to STMT_R_1 if not pressed. + + ;;;$1B7B +REPORT_L: RST 08H ; ERROR_1 + DEFB $14 ; Error Report: BREAK into program + + ;;;$1B7D +STMT_R_1: BIT 7,(IY+$0A) ; test NSPPC - will be set if $FF - no jump to be made. + JR NZ,STMT_NEXT ; forward to STMT_NEXT if a program line. + + LD HL,(NEWPPC) ; fetch line number from NEWPPC + BIT 7,H ; will be set if minus two - direct command(s) + JR Z,LINE_NEW ; forward to LINE_NEW if a jump is to be + ; made to a new program line/statement. + +;--------------------- +; Run a direct command +;--------------------- +; A direct command is to be run or, if continuing from above, +; the next statement of a direct command is to be considered. + + ;;;$1B8A +LINE_RUN: LD HL,$FFFE ; The dummy value minus two + LD (PPC),HL ; is set/reset as line number in PPC. + LD HL,(WORKSP) ; point to end of line + 1 - WORKSP. + DEC HL ; now point to $80 end-marker. + LD DE,(E_LINE) ; address the start of line E_LINE. + DEC DE ; now location before - for GET_CHAR. + LD A,(NSPPC) ; load statement to A from NSPPC. + JR NEXT_LINE ; forward to NEXT_LINE. + +;------------------------------- +; Find start address of new line +;------------------------------- +; The branch was to here if a jump is to made to a new line number +; and statement. +; That is the previous statement was a GO TO, GO SUB, RUN, RETURN, NEXT etc.. + + ;;;$1B9E +LINE_NEW: CALL LINE_ADDR ; routine LINE_ADDR gets address of line + ; returning zero flag set if line found. + LD A,(NSPPC) ; fetch new statement from NSPPC + JR Z,LINE_USE ; forward to LINE_USE if line matched. + + ; continue as must be a direct command. + + AND A ; test statement which should be zero + JR NZ,REPORT_N ; forward to REPORT_N if not. + ; 'Statement lost' + LD B,A ; save statement in B. ? + LD A,(HL) ; fetch high byte of line number. + AND $C0 ; test if using direct command + ; a program line is less than $3F + LD A,B ; retrieve statement. + ; (we can assume it is zero). + JR Z,LINE_USE ; forward to LINE_USE if was a program line + + ; Alternatively a direct statement has finished correctly. + + ;;;$1BB0 +REPORT_0: RST 08H ; ERROR_1 + DEFB $FF ; Error Report: OK + +;------------------- +; Handle REM command +;------------------- +; The REM command routine. +; The return address STMT_RET is dropped and the rest of line ignored. + + ;;;$1BB2 +REM: POP BC ; drop return address STMT_RET and + ; continue ignoring rest of line. + +;------------- +; End of line? +;------------- + + ;;;$1BB3 +LINE_END: CALL SYNTAX_Z ; routine SYNTAX_Z (UNSTACK_Z?) + RET Z ; return if checking syntax. + + LD HL,(NXTLIN) ; fetch NXTLIN to HL. + LD A,$C0 ; test against the + AND (HL) ; system limit $3F. + RET NZ ; return if more as must be end of program. + ; (or direct command) + + XOR A ; set statement to zero. + + ; and continue to set up the next following line and then consider this new one. + +;---------------------- +; General line checking +;---------------------- +; The branch was here from LINE_NEW if Basic is branching. +; or a continuation from above if dealing with a new sequential line. +; First make statement zero number one leaving others unaffected. + + ;;;$1BBF +LINE_USE: CP $01 ; will set carry if zero. + ADC A,$00 ; add in any carry. + LD D,(HL) ; high byte of line number to D. + INC HL ; advance pointer. + LD E,(HL) ; low byte of line number to E. + LD (PPC),DE ; set system variable PPC. + INC HL ; advance pointer. + LD E,(HL) ; low byte of line length to E. + INC HL ; advance pointer. + LD D,(HL) ; high byte of line length to D. + EX DE,HL ; swap pointer to DE before + ADD HL,DE ; adding to address the end of line. + INC HL ; advance to start of next line. + +;------------------------------ +; Update NEXT LINE but consider +; previous line or edit line. +;------------------------------ +; The pointer will be the next line if continuing from above or to +; edit line end-marker ($80) if from LINE_RUN. + + ;;;$1BD1 +NEXT_LINE: LD (NXTLIN),HL ; store pointer in system variable NXTLIN + EX DE,HL ; bring back pointer to previous or edit line + LD (CH_ADD),HL ; and update CH_ADD with character address. + LD D,A ; store statement in D. + LD E,$00 ; set E to zero to suppress token searching if EACH_STMT is to be called. + LD (IY+$0A),$FF ; set statement NSPPC to $FF signalling no jump to be made. + DEC D ; decrement and test statement + LD (IY+$0D),D ; set SUBPPC to decremented statement number. + JP Z,STMT_LOOP ; to STMT_LOOP if result zero as statement is + ; at start of line and address is known. + INC D ; else restore statement. + CALL EACH_STMT ; routine EACH_STMT finds the D'th statement address as E does not contain a token. + JR Z,STMT_NEXT ; forward to STMT_NEXT if address found. + + ;;;$1BEC +REPORT_N: RST 08H ; ERROR_1 + DEFB $16 ; Error Report: Statement lost + +;------------------ +; End of statement? +;------------------ +; This combination of routines is called from 20 places when +; the end of a statement should have been reached and all preceding +; syntax is in order. + + ;;;$1BEE +CHECK_END: CALL SYNTAX_Z ; routine SYNTAX_Z + RET NZ ; return immediately in runtime + + POP BC ; drop address of calling routine. + POP BC ; drop address STMT_RET. + ; and continue to find next statement. + +;--------------------- +; Go to next statement +;--------------------- +; Acceptable characters at this point are carriage return and ':'. +; If so go to next statement which in the first case will be on next line. + + ;;;$1BF4 +STMT_NEXT: RST 18H ; GET_CHAR - ignoring white space etc. + CP $0D ; is it carriage return ? + JR Z,LINE_END ; back to LINE_END if so. + + CP $3A ; is it ':' ? + JP Z,STMT_LOOP ; jump back to STMT_LOOP to consider + ; further statements + JP REPORT_C ; jump to REPORT_C with any other character + ; 'Nonsense in BASIC'. + +; Note. the two-byte sequence 'rst 08; defb $0b' could replace the above jp. + +;-------------------- +; Command class table +;-------------------- + + ;;;$1C01 +CLASS_TBL: DEFB CLASS_00 - $ ; 0F offset to Address: CLASS_00 + DEFB CLASS_01 - $ ; 1D offset to Address: CLASS_01 + DEFB CLASS_02 - $ ; 4B offset to Address: CLASS_02 + DEFB CLASS_03 - $ ; 09 offset to Address: CLASS_03 + DEFB CLASS_04 - $ ; 67 offset to Address: CLASS_04 + DEFB CLASS_05 - $ ; 0B offset to Address: CLASS_05 + DEFB CLASS_06 - $ ; 7B offset to Address: CLASS_06 + DEFB CLASS_07 - $ ; 8E offset to Address: CLASS_07 + DEFB CLASS_08 - $ ; 71 offset to Address: CLASS_08 + DEFB CLASS_09 - $ ; B4 offset to Address: CLASS_09 + DEFB CLASS_0A - $ ; 81 offset to Address: CLASS_0A + DEFB CLASS_0B - $ ; CF offset to Address: CLASS_0B + + +;------------------------------- +; Command classes 00, 03, and 05 +;------------------------------- +; CLASS_03 e.g RUN or RUN 200 ; optional operand +; CLASS_00 e.g CONTINUE ; no operand +; CLASS_05 e.g PRINT ; variable syntax checked by routine + + ;;;$1C0D +CLASS_03: CALL FETCH_NUM ; routine FETCH_NUM + + ;;;$1C10 +CLASS_00: CP A ; reset zero flag. + + ; if entering here then all class routines are entered with zero reset. + + ;;;$1C11 +CLASS_05: POP BC ; drop address SCAN_LOOP. + CALL Z,CHECK_END ; if zero set then call routine CHECK_END >>> + ; as should be no further characters. + EX DE,HL ; save HL to DE. + LD HL,(T_ADDR) ; fetch T_ADDR + LD C,(HL) ; fetch low byte of routine + INC HL ; address next. + LD B,(HL) ; fetch high byte of routine. + EX DE,HL ; restore HL from DE + PUSH BC ; push the address + RET ; and make an indirect jump to the command. + +;------------------------------- +; Command classes 01, 02, and 04 +;------------------------------- +; CLASS_01 e.g LET A = 2*3 ; a variable is reqd + +; This class routine is also called from INPUT and READ to find the +; destination variable for an assignment. + + ;;;$1C1F +CLASS_01: CALL LOOK_VARS ; routine LOOK_VARS returns carry set if not + ; found in runtime. + +;----------------------- +; Variable in assignment +;----------------------- + + ;;;$1C22 +VAR_A_1: LD (IY+$37),$00 ; set FLAGX to zero + JR NC,VAR_A_2 ; forward to VAR_A_2 if found or checking syntax. + + SET 1,(IY+$37) ; FLAGX - Signal a new variable + JR NZ,VAR_A_3 ; to VAR_A_3 if not assigning to an array + ; e.g. LET a$(3,3) = "X" + + ;;;$1C2E +REPORT_2: RST 08H ; ERROR_1 + DEFB $01 ; Error Report: Variable not found + + ;;;$1C30 +VAR_A_2: CALL Z,STK_VAR ; routine STK_VAR considers a subscript/slice + BIT 6,(IY+$01) ; test FLAGS - Numeric or string result ? + JR NZ,VAR_A_3 ; to VAR_A_3 if numeric + + XOR A ; default to array/slice - to be retained. + CALL SYNTAX_Z ; routine SYNTAX_Z + CALL NZ,STK_FETCH ; routine STK_FETCH is called in runtime + ; may overwrite A with 1. + LD HL,FLAGX ; address system variable FLAGX + OR (HL) ; set bit 0 if simple variable to be reclaimed + LD (HL),A ; update FLAGX + EX DE,HL ; start of string/subscript to DE + + ;;;$1C46 +VAR_A_3: LD (STRLEN),BC ; update STRLEN + LD (DEST),HL ; and DEST of assigned string. + RET ; return. + +; --------------------------- +; CLASS_02 e.g. LET a = 1 + 1 ; an expression must follow + + ;;;$1C4E +CLASS_02: POP BC ; drop return address SCAN_LOOP + CALL VAL_FET_1 ; routine VAL_FET_1 is called to check + ; expression and assign result in runtime + CALL CHECK_END ; routine CHECK_END checks nothing else + ; is present in statement. + RET ; return + +;-------------- +; Fetch a value +;-------------- + + ;;;$1C56 +VAL_FET_1: LD A,(FLAGS) ; initial FLAGS to A + + ;;;$LC59 +VAL_FET_2: PUSH AF ; save A briefly + CALL SCANNING ; routine SCANNING evaluates expression. + POP AF ; restore A + LD D,(IY+$01) ; post-SCANNING FLAGS to D + XOR D ; xor the two sets of flags + AND $40 ; pick up bit 6 of xored FLAGS should be zero + JR NZ,REPORT_C ; forward to REPORT_C if not zero + ; 'Nonsense in Basic' - results don't agree. + BIT 7,D ; test FLAGS - is syntax being checked ? + JP NZ,LET ; jump forward to LET to make the assignment + ; in runtime. + RET ; but return from here if checking syntax. + +;------------------- +; Command CLASS_--04 +;------------------- +; CLASS_04 e.g. FOR i ; a single character variable must follow + + ;;;$1C6C +CLASS_04: CALL LOOK_VARS ; routine LOOK_VARS + PUSH AF ; preserve flags. + LD A,C ; fetch type - should be 011xxxxx + OR $9F ; combine with 10011111. + INC A ; test if now $FF by incrementing. + JR NZ,REPORT_C ; forward to REPORT_C if result not zero. + + POP AF ; else restore flags. + JR VAR_A_1 ; back to VAR_A_1 + + +;--------------------------------- +; Expect numeric/string expression +;--------------------------------- +; This routine is used to get the two coordinates of STRING$, ATTR and POINT. +; It is also called from PRINT_ITEM to get the two numeric expressions that +; follow the AT ( in PRINT AT, INPUT AT). + + ;;;$1C79 +NEXT_2NUM: RST 20H ; NEXT_CHAR advance past 'AT' or '('. + +; ------------------------- +; CLASS_08 e.g POKE 65535,2 ; two numeric expressions separated by comma + + ;;;$1C7A +CLASS_08: +EXPT_2NUM: CALL EXPT_1NUM ; routine EXPT_1NUM is called for first + ; numeric expression + CP $2C ; is character ',' ? + JR NZ,REPORT_C ; to REPORT_C if not required separator. + ; 'Nonsense in basic'. + + RST 20H ; NEXT_CHAR + +; --------------------------- +; CLASS_06 e.g. GOTO a*1000 ; a numeric expression must follow + + ;;;$1C82 +CLASS_06: +EXPT_1NUM: CALL SCANNING ; routine SCANNING + BIT 6,(IY+$01) ; test FLAGS - Numeric or string result ? + RET NZ ; return if result is numeric. + + ;;;$1C8A +REPORT_C: RST 08H ; ERROR_1 + DEFB $0B ; Error Report: Nonsense in BASIC + +; -------------------------- +; CLASS_0A e.g. ERASE "????" ; a string expression must follow. +; ; these only occur in unimplemented commands +; ; although the routine EXPT_EXP is called +; ; from SAVE_ETC + + ;;;$1C8C +CLASS_0A: +EXPT_EXP: CALL SCANNING ; routine SCANNING + BIT 6,(IY+$01) ; test FLAGS - Numeric or string result ? + RET Z ; return if string result. + + JR REPORT_C ; back to REPORT_C if numeric. + +;---------------------- +; Set permanent colours +; class 07 +;---------------------- +; CLASS_07 e.g PAPER 6 ; a single class for a collection of +; ; similar commands. Clever. +; +; Note. these commands should ensure that current channel is 'S' + + ;;;$1C96 +CLASS_07: BIT 7,(IY+$01) ; test FLAGS - checking syntax only ? + RES 0,(IY+$02) ; TV_FLAG - signal main screen in use + CALL NZ,TEMPS ; routine TEMPS is called in runtime. + POP AF ; drop return address SCAN_LOOP + LD A,(T_ADDR) ; T_ADDR_lo to accumulator. + ; points to '$07' entry + 1 + ; e.g. for INK points to $EC now + + ; Note if you move alter the syntax table next line may have to be altered. + + SUB $13 ; convert $EB to $D8 ('INK') etc. + ; ( is SUB $13 in standard ROM ) + CALL CO_TEMP_4 ; routine CO_TEMP_4 + CALL CHECK_END ; routine CHECK_END check that nothing else in statement. + + ; return here in runtime. + + LD HL,(ATTRT_MASKT); pick up ATTR_T and MASK_T + LD (ATTRP_MASKP),HL; and store in ATTR_P and MASK_P + LD HL,P_FLAG ; point to P_FLAG. + LD A,(HL) ; pick up in A + RLCA ; rotate to left + XOR (HL) ; combine with HL + AND $AA ; 10101010 + XOR (HL) ; only permanent bits affected + LD (HL),A ; reload into P_FLAG. + RET ; return. + +;----------------- +; Command CLASS 09 +;----------------- +; e.g. PLOT PAPER 0; 128,88 ; two coordinates preceded by optional +; ; embedded colour items. +; +; Note. this command should ensure that current channel is 'S'. + + ;;;$1CBE +CLASS_09: CALL SYNTAX_Z ; routine SYNTAX_Z + JR Z,CL_09_1 ; forward to CL_09_1 if checking syntax. + + RES 0,(IY+$02) ; update TV_FLAG - signal main screen in use + CALL TEMPS ; routine TEMPS is called. + LD HL,MASK_T ; point to MASK_T + LD A,(HL) ; fetch mask to accumulator. + OR $F8 ; or with 11111000 paper/bright/flash 8 + LD (HL),A ; mask back to MASK_T system variable. + RES 6,(IY+$57) ; reset P_FLAG - signal NOT PAPER 9 ? + RST 18H ; GET_CHAR + + ;;;$1CD6 +CL_09_1: CALL CO_TEMP_2 ; routine CO_TEMP_2 deals with embedded colour items. + JR EXPT_2NUM ; exit via EXPT_2NUM to check for x,y. + +;----------------- +; Command CLASS 0B +;----------------- +; Again a single class for four commands. +; This command just jumps back to SAVE_ETC to handle the four tape commands. +; The routine itself works out which command has called it by examining the +; address in T_ADDR_lo. Note therefore that the syntax table has to be +; located where these and other sequential command addresses are not split +; over a page boundary. + + ;;;$1CDB +CLASS_0B: JP SAVE_ETC ; jump way back to SAVE_ETC + +;--------------- +; Fetch a number +;--------------- +; This routine is called from CLASS_03 when a command may be followed by +; an optional numeric expression e.g. RUN. If the end of statement has +; been reached then zero is used as the default. +; Also called from LIST_4. + + ;;;$1CDE +FETCH_NUM: CP $0D ; is character a carriage return ? + JR Z,USE_ZERO ; forward to USE_ZERO if so + + CP $3A ; is it ':' ? + JR NZ,EXPT_1NUM ; forward to EXPT_1NUM if not. + ; else continue and use zero. + +;----------------- +; Use zero routine +;----------------- +; This routine is called four times to place the value zero on the +; calculator stack as a default value in runtime. + + ;;;$1CE6 +USE_ZERO: CALL SYNTAX_Z ; routine SYNTAX_Z (UNSTACK_Z?) + RET Z ; + + RST 28H ;; FP_CALC + DEFB $A0 ;;STK_ZERO ;0. + DEFB $38 ;;END_CALC + + RET ; return. + +;-------------------- +; Handle STOP command +;-------------------- +; Command Syntax: STOP +; One of the shortest and least used commands. As with 'OK' not an error. + + ;;;$1CEE +STOP: RST 08H ; ERROR_1 + DEFB $08 ; Error Report: STOP statement + +;------------------ +; Handle IF command +;------------------ +; e.g. IF score>100 THEN PRINT "You Win" +; The parser has already checked the expression the result of which is on +; the calculator stack. The presence of the 'THEN' separator has also been +; checked and CH-ADD points to the command after THEN. + + ;;;$1CF0 +IF_CMD: POP BC ; drop return address - STMT_RET + CALL SYNTAX_Z ; routine SYNTAX_Z + JR Z,IF_1 ; forward to IF_1 if checking syntax + ; to check syntax of PRINT "You Win" + RST 28H ;; FP_CALC score>100 (1=TRUE 0=FALSE) + DEFB $02 ;;DELETE + DEFB $38 ;;END_CALC + + EX DE,HL ; make HL point to deleted value + CALL TEST_ZERO ; routine TEST_ZERO + JP C,LINE_END ; jump to LINE_END if FALSE (0) + + ;;;$1D00 +IF_1: JP STMT_L_1 ; to STMT_L_1, if true (1) to execute command + ; after 'THEN' token. + +;------------------- +; Handle FOR command +;------------------- +; e.g. FOR i = 0 TO 1 STEP 0.1 +; Using the syntax tables, the parser has already checked for a start and +; limit value and also for the intervening separator. +; the two values v,l are on the calculator stack. +; CLASS_04 has also checked the variable and the name is in STRLEN_lo. +; The routine begins by checking for an optional STEP. + + ;;;$1D03 +FOR: CP $CD ; is there a 'STEP' ? + JR NZ,F_USE_1 ; to F_USE_1 if not to use 1 as default. + + RST 20H ; NEXT_CHAR + CALL EXPT_1NUM ; routine EXPT_1NUM + CALL CHECK_END ; routine CHECK_END + JR F_REORDER ; to F_REORDER + + ;;;$1D10 +F_USE_1: CALL CHECK_END ; routine CHECK_END + RST 28H ;; FP_CALC v,l. + DEFB $A1 ;;STK_ONE v,l,1=s. + DEFB $38 ;;END_CALC + + ;;;$1D16 +F_REORDER: RST 28H ;; FP_CALC v,l,s. + DEFB $C0 ;;st-mem-0 v,l,s. + DEFB $02 ;;DELETE v,l. + DEFB $01 ;;EXCHANGE l,v. + DEFB $E0 ;;get-mem-0 l,v,s. + DEFB $01 ;;EXCHANGE l,s,v. + DEFB $38 ;;END_CALC + + CALL LET ; routine LET assigns the initial value v to + ; the variable altering type if necessary. + LD (MEM),HL ; The system variable MEM is made to point to + ; the variable instead of it's normal location MEMBOT + DEC HL ; point to single-character name + LD A,(HL) ; fetch name + SET 7,(HL) ; set bit 7 at location + LD BC,$0006 ; add six to HL + ADD HL,BC ; to address where limit should be. + RLCA ; test bit 7 of original name. + JR C,F_L_S ; forward to F_L_S if already a FOR/NEXT + ; variable + LD C,$0D ; otherwise an additional 13 bytes are needed. + ; 5 for each value, two for line number and + ; 1 byte for looping statement. + CALL MAKE_ROOM ; routine MAKE_ROOM creates them. + INC HL ; make HL address limit. + + ;;;$1D34 +F_L_S: PUSH HL ; save position. + + RST 28H ;; FP_CALC l,s. + DEFB $02 ;;DELETE l. + DEFB $02 ;;DELETE . + DEFB $38 ;;END_CALC + ; DE points to STKEND, l. + + POP HL ; restore variable position + EX DE,HL ; swap pointers + LD C,$0A ; ten bytes to move + LDIR ; Copy 'deleted' values to variable. + LD HL,(PPC) ; Load with current line number from PPC + EX DE,HL ; exchange pointers. + LD (HL),E ; save the looping line + INC HL ; in the next + LD (HL),D ; two locations. + LD D,(IY+$0D) ; fetch statement from SUBPPC system variable. + INC D ; increment statement. + INC HL ; and pointer + LD (HL),D ; and store the looping statement. ; + CALL NEXT_LOOP ; routine NEXT_LOOP considers an initial + RET NC ; iteration. Return to STMT_RET if a loop is + ; possible to execute next statement. + + ; no loop is possible so execution continues after the matching 'NEXT' + + LD B,(IY+$38) ; get single-character name from STRLEN_lo + LD HL,(PPC) ; get the current line from PPC + LD (NEWPPC),HL ; and store it in NEWPPC + LD A,(SUBPPC) ; fetch current statement from SUBPPC + NEG ; Negate as counter decrements from zero + ; initially and we are in the middle of a line. + LD D,A ; Store result in D. + LD HL,(CH_ADD) ; get current address from CH_ADD + LD E,$F3 ; search will be for token 'NEXT' + + ;;;$1D64 +F_LOOP: PUSH BC ; save variable name. + LD BC,(NXTLIN) ; fetch NXTLIN + CALL LOOK_PROG ; routine LOOK_PROG searches for 'NEXT' token. + LD (NXTLIN),BC ; update NXTLIN + POP BC ; and fetch the letter + JR C,REPORT_I ; forward to REPORT_I if the end of program + ; was reached by LOOK_PROG. + ; 'FOR without NEXT' + + RST 20H ; NEXT_CHAR fetches character after NEXT + OR $20 ; ensure it is upper-case. + CP B ; compare with FOR variable name + JR Z,F_FOUND ; forward to F_FOUND if it matches. + + ; but if no match i.e. nested FOR/NEXT loops then continue search. + + RST 20H ; NEXT_CHAR + JR F_LOOP ; back to F_LOOP + + ;;;$1D7C +F_FOUND: RST 20H ; NEXT_CHAR + LD A,$01 ; subtract the negated counter from 1 + SUB D ; to give the statement after the NEXT + LD (NSPPC),A ; set system variable NSPPC + RET ; return to STMT_RET to branch to new + ; line and statement. -> + + ;;;$1D84 +REPORT_I: RST 08H ; ERROR_1 + DEFB $11 ; Error Report: FOR without NEXT + +;---------- +; LOOK_PROG +;---------- +; Find DATA, DEF FN or NEXT. +; This routine searches the program area for one of the above three keywords. +; On entry, HL points to start of search area. +; The token is in E, and D holds a statement count, decremented from zero. + + ;;;$1D86 +LOOK_PROG: LD A,(HL) ; fetch current character + CP $3A ; is it ':' a statement separator ? + JR Z,LOOK_P_2 ; forward to LOOK_P_2 if so. + + ; The starting point was PROG - 1 or the end of a line. + + ;;;$1D8B +LOOK_P_1: INC HL ; increment pointer to address + LD A,(HL) ; the high byte of line number + AND $C0 ; test for program end marker $80 or a variable + SCF ; Set Carry Flag + RET NZ ; return with carry set if at end + ; of program. -> + LD B,(HL) ; high byte of line number to B + INC HL + LD C,(HL) ; low byte to C. + LD (NEWPPC),BC ; set system variable NEWPPC. + INC HL + LD C,(HL) ; low byte of line length to C. + INC HL + LD B,(HL) ; high byte to B. + PUSH HL ; save address + ADD HL,BC ; add length to position. + LD B,H ; and save result + LD C,L ; in BC. + POP HL ; restore address. + LD D,$00 ; initialize statement counter to zero. + + ;;;$1DA3 +LOOK_P_2: PUSH BC ; save address of next line + CALL EACH_STMT ; routine EACH_STMT searches current line. + POP BC ; restore address. + RET NC ; return if match was found. -> + + JR LOOK_P_1 ; back to LOOK_P_1 for next line. + +;-------------------- +; Handle NEXT command +;-------------------- +; e.g. NEXT i +; The parameter tables have already evaluated the presence of a variable + + ;;;$1DAB +NEXT: BIT 1,(IY+$37) ; test FLAGX - handling a new variable ? + JP NZ,REPORT_2 ; jump back to REPORT_2 if so + ; 'Variable not found' + + ; now test if found variable is a simple variable uninitialized by a FOR. + + LD HL,(DEST) ; load address of variable from DEST + BIT 7,(HL) ; is it correct type ? + JR Z,REPORT_1 ; forward to REPORT_1 if not + ; 'NEXT without FOR' + + INC HL ; step past variable name + LD (MEM),HL ; and set MEM to point to three 5-byte values + ; value, limit, step. + + RST 28H ;; FP_CALC add step and re-store + DEFB $E0 ;;get-mem-0 v. + DEFB $E2 ;;get-mem-2 v,s. + DEFB $0F ;;ADDITION v+s. + DEFB $C0 ;;st-mem-0 v+s. + DEFB $02 ;;DELETE . + DEFB $38 ;;END_CALC + + CALL NEXT_LOOP ; routine NEXT_LOOP tests against limit. + RET C ; return if no more iterations possible. + + LD HL,(MEM) ; find start of variable contents from MEM. + LD DE,$000F ; add 3*5 to + ADD HL,DE ; address the looping line number + LD E,(HL) ; low byte to E + INC HL + LD D,(HL) ; high byte to D + INC HL ; address looping statement + LD H,(HL) ; and store in H + EX DE,HL ; swap registers + JP GO_TO_2 ; exit via GO_TO_2 to execute another loop. + + ;;;$1DD8 +REPORT_1: RST 08H ; ERROR_1 + DEFB $00 ; Error Report: NEXT without FOR + + +;------------------ +; Perform NEXT loop +;------------------ +; This routine is called from the FOR command to test for an initial +; iteration and from the NEXT command to test for all subsequent iterations. +; the system variable MEM addresses the variable's contents which, in the +; latter case, have had the step, possibly negative, added to the value. + + ;;;$1DDA +NEXT_LOOP: RST 28H ;; FP_CALC + DEFB $E1 ;;get-mem-1 l. + DEFB $E0 ;;get-mem-0 l,v. + DEFB $E2 ;;get-mem-2 l,v,s. + DEFB $36 ;;LESS_0 l,v,(1/0) negative step ? + DEFB $00 ;;JUMP_TRUE l,v.(1/0) + + DEFB $02 ;;to NEXT_1 if step negative + + DEFB $01 ;;EXCHANGE v,l. + + ;;;$1DE2 +NEXT_1: DEFB $03 ;;SUBTRACT l-v OR v-l. + DEFB $37 ;;GREATER_0 (1/0) + DEFB $00 ;;JUMP_TRUE . + + DEFB $04 ;;to NEXT_2 if no more iterations. + + DEFB $38 ;;END_CALC . + + AND A ; clear carry flag signalling another loop. + RET ; return + + ;;;$1DE9 +NEXT_2: DEFB $38 ;;END_CALC . + + SCF ; set carry flag signalling looping exhausted. + RET ; return + + +;-------------------- +; Handle READ command +;-------------------- +; e.g. READ a, b$, c$(1000 TO 3000) +; A list of comma-separated variables is assigned from a list of +; comma-separated expressions. +; As it moves along the first list, the character address CH_ADD is stored +; in X_PTR while CH_ADD is used to read the second list. + + ;;;$1DEC +READ_3: RST 20H ; NEXT_CHAR + + ; -> Entry point. + ;;;$1DED +READ: CALL CLASS_01 ; routine CLASS_01 checks variable. + CALL SYNTAX_Z ; routine SYNTAX_Z + JR Z,READ_2 ; forward to READ_2 if checking syntax + + RST 18H ; GET_CHAR + LD (X_PTR),HL ; save character position in X_PTR. + LD HL,(DATADD) ; load HL with Data Address DATADD, which is + ; the start of the program or the address + ; after the last expression that was read or + ; the address of the line number of the + ; last RESTORE command. + LD A,(HL) ; fetch character + CP $2C ; is it a comma ? + JR Z,READ_1 ; forward to READ_1 if so. + + ; else all data in this statement has been read so look for next DATA token + + LD E,$E4 ; token 'DATA' + CALL LOOK_PROG ; routine LOOK_PROG + JR NC,READ_1 ; forward to READ_1 if DATA found + + ; else report the error. + + ;;;$1E08 +REPORT_E: RST 08H ; ERROR_1 + DEFB $0D ; Error Report: Out of DATA + + ;;;$1E0A +READ_1: CALL TEMP_PTR1 ; routine TEMP_PTR1 advances updating CH_ADD with new DATADD position. + CALL VAL_FET_1 ; routine VAL_FET_1 assigns value to variable + ; checking type match and adjusting CH_ADD. + RST 18H ; GET_CHAR fetches adjusted character position + LD (DATADD),HL ; store back in DATADD + LD HL,(X_PTR) ; fetch X_PTR the original READ CH_ADD + LD (IY+$26),$00 ; now nullify X_PTR_HI + CALL TEMP_PTR2 ; routine TEMP_PTR2 restores READ CH_ADD + + ;;;$1E1E +READ_2: RST 18H ; GET_CHAR + CP $2C ; is it ',' indicating more variables to read ? + JR Z,READ_3 ; back to READ_3 if so + + CALL CHECK_END ; routine CHECK_END + RET ; return from here in runtime to STMT_RET. + +;-------------------- +; Handle DATA command +;-------------------- +; In runtime this 'command' is passed by but the syntax is checked when such +; a statement is found while parsing a line. +; e.g. DATA 1, 2, "text", score-1, a$(location, room, object), FN r(49), +; wages - tax, TRUE, The meaning of life + + ;;;$1E27 +DATA: CALL SYNTAX_Z ; routine SYNTAX_Z to check status + JR NZ,DATA_2 ; forward to DATA_2 if in runtime + + ;;;$1E2C +DATA_1: CALL SCANNING ; routine SCANNING to check syntax of expression + CP $2C ; is it a comma ? + CALL NZ,CHECK_END ; routine CHECK_END checks that statement + ; is complete. Will make an early exit if + ; so. >>> + RST 20H ; NEXT_CHAR + JR DATA_1 ; back to DATA_1 + + ;;;$1E37 +DATA_2: LD A,$E4 ; set token to 'DATA' and continue into + ; the the PASS_BY routine. + + +;----------------------------------- +; Check statement for DATA or DEF FN +;----------------------------------- +; This routine is used to backtrack to a command token and then +; forward to the next statement in runtime. + + ;;;$1E39 +PASS_BY: LD B,A ; Give BC enough space to find token. + CPDR ; Compare decrement and repeat. (Only use). + ; Work backwards till keyword is found which + ; is start of statement before any quotes. + ; HL points to location before keyword. + LD DE,$0200 ; count 1+1 statements, dummy value in E to + ; inhibit searching for a token. + JP EACH_STMT ; to EACH_STMT to find next statement + +;------------------------------------------------------------------------ +; A General Note on Invalid Line Numbers. +; ======================================= +; One of the revolutionary concepts of Sinclair Basic was that it supported +; virtual line numbers. That is the destination of a GO TO, RESTORE etc. need +; not exist. It could be a point before or after an actual line number. +; Zero suffices for a before but the after should logically be infinity. +; Since the maximum actual line limit is 9999 then the system limit, 16383 +; when variables kick in, would serve fine as a virtual end point. +; However, ironically, only the LOAD command gets it right. It will not +; autostart a program that has been saved with a line higher than 16383. +; All the other commands deal with the limit unsatisfactorily. +; LIST, RUN, GO TO, GO SUB and RESTORE have problems and the latter may +; crash the machine when supplied with an inappropriate virtual line number. +; This is puzzling as very careful consideration must have been given to +; this point when the new variable types were allocated their masks and also +; when the routine NEXT-ONE was successfully re-written to reflect this. +; An enigma. +;-------------------------------------------------------------------------- + +;----------------------- +; Handle RESTORE command +;----------------------- +; The restore command sets the system variable for the data address to +; point to the location before the supplied line number or first line +; thereafter. +; This alters the position where subsequent READ commands look for data. +; Note. If supplied with inappropriate high numbers the system may crash +; in the LINE-ADDR routine as it will pass the program/variables end-marker +; and then lose control of what it is looking for - variable or line number. +; - observation, Steven Vickers, 1984, Pitman. + + ;;;$1E42 +RESTORE: CALL FIND_INT2 ; routine FIND_INT2 puts integer in BC. + ; Note. B should be checked against limit $3F + ; and an error generated if higher. + + ; this entry point is used from RUN command with BC holding zero + + ;;;$1E45 +REST_RUN: LD H,B ; transfer the line + LD L,C ; number to the HL register. + CALL LINE_ADDR ; routine LINE_ADDR to fetch the address. + DEC HL ; point to the location before the line. + LD (DATADD),HL ; update system variable DATADD. + RET ; return to STMT_RET (or RUN) + +;------------------------- +; Handle RANDOMIZE command +;------------------------- +; This command sets the SEED for the RND function to a fixed value. +; With the parameter zero, a random start point is used depending on +; how long the computer has been switched on. + + ;;;$1E4F +RANDOMIZE: CALL FIND_INT2 ; routine FIND_INT2 puts parameter in BC. + LD A,B ; test this + OR C ; for zero. + JR NZ,RAND_1 ; forward to RAND_1 if not zero. + + LD BC,(FRAMES1) ; use the lower two bytes at FRAMES1. + + ;;;$1E5A +RAND_1: LD (SEED),BC ; place in SEED system variable. + RET ; return to STMT_RET + +;------------------------ +; Handle CONTINUE command +;------------------------ +; The CONTINUE command transfers the OLD (but incremented) values of +; line number and statement to the equivalent "NEW VALUE" system variables +; by using the last part of GO TO and exits indirectly to STMT_RET. + + ;;;$1E5F +CONTINUE: LD HL,(OLDPPC) ; fetch OLDPPC line number. + LD D,(IY+$36) ; fetch OSPPC statement. + JR GO_TO_2 ; forward to GO_TO_2 + +;--------------------- +; Handle GO TO command +;--------------------- +; The GO TO command routine is also called by GO SUB and RUN routines +; to evaluate the parameters of both commands. +; It updates the system variables used to fetch the next line/statement. +; It is at STMT_RET that the actual change in control takes place. +; Unlike some BASICs the line number need not exist. +; Note. the high byte of the line number is incorrectly compared with $F0 +; instead of $3F. This leads to commands with operands greater than 32767 +; being considered as having been run from the editing area and the +; error report 'Statement Lost' is given instead of 'OK'. +; - Steven Vickers, 1984. + + ;;;$1E67 +GO_TO: CALL FIND_INT2 ; routine FIND_INT2 puts operand in BC + LD H,B ; transfer line + LD L,C ; number to HL. + LD D,$00 ; set statement to 0 - first. + LD A,H ; compare high byte only + CP $F0 ; to $F0 i.e. 61439 in full. + JR NC,REPORT_BB ; forward to REPORT_BB if above. + + ; This call entry point is used to update the system variables e.g. by RETURN. + + ;;;$1E73 +GO_TO_2: LD (NEWPPC),HL ; save line number in NEWPPC + LD (IY+$0A),D ; and statement in NSPPC + RET ; to STMT_RET (or GO_SUB command) + +;------------------- +; Handle OUT command +;------------------- +; Syntax has been checked and the two comma-separated values are on the +; calculator stack. + + ;;;$1E7A +OUT_CMD: CALL TWO_PARAM ; routine TWO_PARAM fetches values to BC and A. + OUT (C),A ; perform the operation. + RET ; return to STMT_RET. + +;-------------------- +; Handle POKE command +;-------------------- +; This routine alters a single byte in the 64K address space. +; Happily no check is made as to whether ROM or RAM is addressed. +; Sinclair Basic requires no poking of system variables. + + ;;;$1E80 +POKE: CALL TWO_PARAM ; routine TWO_PARAM fetches values to BC and A. + LD (BC),A ; load memory location with A. + RET ; return to STMT_RET. + +;-------------------------------------------- +; Fetch two parameters from calculator stack +;-------------------------------------------- +; This routine fetches a byte and word from the calculator stack +; producing an error if either is out of range. + + ;;;$1E85 +TWO_PARAM: CALL FP_TO_A ; routine FP_TO_A + JR C,REPORT_BB ; forward to REPORT_BB if overflow occurred + + JR Z,TWO_P_1 ; forward to TWO_P_1 if positive + + NEG ; negative numbers are made positive + + ;;;$1E8E +TWO_P_1: PUSH AF ; save the value + CALL FIND_INT2 ; routine FIND_INT2 gets integer to BC + POP AF ; restore the value + RET ; return + +;-------------- +; Find integers +;-------------- +; The first of these routines fetches a 8-bit integer (range 0-255) from the +; calculator stack to the accumulator and is used for colours, streams, +; durations and coordinates. +; The second routine fetches 16-bit integers to the BC register pair +; and is used to fetch command and function arguments involving line numbers +; or memory addresses and also array subscripts and tab arguments. +; -> + + ;;;$1E94 +FIND_INT1: CALL FP_TO_A ; routine FP_TO_A + JR FIND_I_1 ; forward to FIND_I_1 for common exit routine. + + ; -> + + ;;;$1E99 +FIND_INT2: CALL FP_TO_BC ; routine FP_TO_BC + + ;;;$1E9C +FIND_I_1: JR C,REPORT_BB ; to REPORT_BB with overflow. + + RET Z ; return if positive. + + + ;;;$1E9F +REPORT_BB: RST 08H ; ERROR_1 + DEFB $0A ; Error Report: Integer out of range + +;------------------- +; Handle RUN command +;------------------- +; This command runs a program starting at an optional line. +; It performs a 'RESTORE 0' then CLEAR + + ;;;$1EA1 +RUN: CALL GO_TO ; routine GO_TO puts line number in system variables. + LD BC,$0000 ; prepare to set DATADD to first line. + CALL REST_RUN ; routine REST_RUN does the 'restore'. + ; Note BC still holds zero. + JR CLEAR_RUN ; forward to CLEAR_RUN to clear variables + ; without disturbing RAMTOP and + ; exit indirectly to STMT_RET + +;--------------------- +; Handle CLEAR command +;--------------------- +; This command reclaims the space used by the variables. +; It also clears the screen and the GO SUB stack. +; With an integer expression, it sets the uppermost memory +; address within the BASIC system. +; "Contrary to the manual, CLEAR doesn't execute a RESTORE" - +; Steven Vickers, Pitman Pocket Guide to the Spectrum, 1984. + + ;;;$1EAC +CLEAR: CALL FIND_INT2 ; routine FIND_INT2 fetches to BC. + + ;;;$1EAF +CLEAR_RUN: LD A,B ; test for + OR C ; zero. + JR NZ,CLEAR_1 ; skip to CLEAR_1 if not zero. + + LD BC,(RAMTOP) ; use the existing value of RAMTOP if zero. + + ;;;$1EB7 +CLEAR_1: PUSH BC ; save ramtop value. + LD DE,(VARS) ; fetch VARS + LD HL,(E_LINE) ; fetch E_LINE + DEC HL ; adjust to point at variables end-marker. + CALL RECLAIM_1 ; routine RECLAIM_1 reclaims the space used by the variables. + CALL CLS ; routine CLS to clear screen. + LD HL,(STKEND) ; fetch STKEND the start of free memory. + LD DE,$0032 ; allow for another 50 bytes. + ADD HL,DE ; add the overhead to HL. + POP DE ; restore the ramtop value. + SBC HL,DE ; if HL is greater than the value then jump + JR NC,REPORT_M ; forward to REPORT_M + ; 'RAMTOP no good' + LD HL,(P_RAMT) ; now P_RAMT ($7FFF on 16K RAM machine) + AND A ; exact this time. + SBC HL,DE ; new ramtop must be lower or the same. + JR NC,CLEAR_2 ; skip to CLEAR_2 if in actual RAM. + + ;;;$1EDA +REPORT_M: RST 08H ; ERROR_1 + DEFB $15 ; Error Report: RAMTOP no good + + ;;;$1EDC +CLEAR_2: EX DE,HL ; transfer ramtop value to HL. + LD (RAMTOP),HL ; update system variable RAMTOP. + POP DE ; pop the return address STMT_RET. + POP BC ; pop the Error Address. + LD (HL),$3E ; now put the GO SUB end-marker at RAMTOP. + DEC HL ; leave a location beneath it. + LD SP,HL ; initialize the machine stack pointer. + PUSH BC ; push the error address. + LD (ERR_SP),SP ; make ERR_SP point to location. + EX DE,HL ; put STMT_RET in HL. + JP (HL) ; and go there directly. + +;---------------------- +; Handle GO SUB command +;---------------------- +; The GO SUB command diverts Basic control to a new line number +; in a very similar manner to GO TO but +; the current line number and current statement + 1 +; are placed on the GO SUB stack as a RETURN point. + + ;;;$1EED +GO_SUB: POP DE ; drop the address STMT_RET + LD H,(IY+$0D) ; fetch statement from SUBPPC and + INC H ; increment it + EX (SP),HL ; swap - error address to HL, + ; H (statement) at top of stack, + ; L (unimportant) beneath. + INC SP ; adjust to overwrite unimportant byte + LD BC,(PPC) ; fetch the current line number from PPC + PUSH BC ; and PUSH onto GO SUB stack. + ; the empty machine-stack can be rebuilt + PUSH HL ; push the error address. + LD (ERR_SP),SP ; make system variable ERR_SP point to it. + PUSH DE ; push the address STMT_RET. + CALL GO_TO ; call routine GO_TO to update the system + ; variables NEWPPC and NSPPC. + ; then make an indirect exit to STMT_RET via + LD BC,$0014 ; a 20-byte overhead memory check. + +;----------------------- +; Check available memory +;----------------------- +; This routine is used on many occasions when extending a dynamic area +; upwards or the GO SUB stack downwards. + + ;;;$1F05 +TEST_ROOM: LD HL,(STKEND) ; fetch STKEND + ADD HL,BC ; add the supplied test value + JR C,REPORT_4 ; forward to REPORT_4 if over $FFFF + + EX DE,HL ; was less so transfer to DE + LD HL,$0050 ; test against another 80 bytes + ADD HL,DE ; anyway + JR C,REPORT_4 ; forward to REPORT_4 if this passes $FFFF + + SBC HL,SP ; if less than the machine stack pointer + RET C ; then return - OK. + + ;;;$1F15 +REPORT_4: LD L,$03 ; prepare 'Out of Memory' + JP ERROR_3 ; jump back to ERROR_3 at $0055 + ; Note. this error can't be trapped at $0008 + +;------------ +; Free memory +;------------ +; This routine is not used by the ROM but allows users to evaluate +; approximate free memory with PRINT 65536 - USR 7962. + + ;;$1F1A +FREE_MEM: LD BC,$0000 ; allow no overhead. + CALL TEST_ROOM ; routine TEST_ROOM. + LD B,H ; transfer the result + LD C,L ; to BC register. + RET ; USR function returns value of BC. + +;---------------------- +; Handle RETURN command +;---------------------- +; As with any command, there are two values on the +; machine stack at the time it is invoked. +; The machine stack is below the GOSUB stack +; Both grow downwards, the machine stack by two bytes, +; the gosub stack by 3 bytes. Highest is statement byte +; then a two-byte line number. + + ;;;$1F23 +RETURN: POP BC ; drop the address STMT_RET. + POP HL ; now the error address. + POP DE ; now a possible basic return line. + LD A,D ; the high byte $00 - $27 is + CP $3E ; compared with the traditional end-marker $3E. + JR Z,REPORT_7 ; forward to REPORT_7 with a match. + ; 'RETURN without GOSUB' + + ; It was not the end-marker so a single statement byte remains at the base of + ; the calculator stack. It can't be popped off. + + DEC SP ; adjust stack pointer to create room for two bytes. + EX (SP),HL ; statement to H, error address to base of + ; new machine stack. + EX DE,HL ; statement to D, basic line number to HL. + LD (ERR_SP),SP ; adjust ERR_SP to point to new stack pointer + PUSH BC ; now re-stack the address STMT_RET + JP GO_TO_2 ; to GO_TO_2 to update statement and line + ; system variables and exit indirectly to the + ; address just pushed on stack. + + ;;;$1F36 +REPORT_7: PUSH DE ; replace the end-marker. + PUSH HL ; now restore the error address + ; as required in a few clock cycles. + RST 08H ; ERROR_1 + DEFB $06 ; Error Report: RETURN without GOSUB + +;--------------------- +; Handle PAUSE command +;--------------------- +; The pause command takes as it's parameter the number of interrupts +; for which to wait. PAUSE 50 pauses for about a second. +; PAUSE 0 pauses indefinitely. +; Both forms can be finished by pressing a key. + + ;;;$1F3A +PAUSE: CALL FIND_INT2 ; routine FIND_INT2 puts value in BC + + ;;;$1F3D +PAUSE_1: HALT ; wait for interrupt. + DEC BC ; decrease counter. + LD A,B ; test if + OR C ; result is zero. + JR Z,PAUSE_END ; forward to PAUSE_END if so. + + LD A,B ; test if + AND C ; now $FFFF + INC A ; that is, initially zero. + JR NZ,PAUSE_2 ; skip forward to PAUSE_2 if not. + + INC BC ; restore counter to zero. + + ;;;$1F49 +PAUSE_2: BIT 5,(IY+$01) ; test FLAGS - has a new key been pressed ? + JR Z,PAUSE_1 ; back to PAUSE_1 if not. + + ;;;$1F4F +PAUSE_END: RES 5,(IY+$01) ; update FLAGS - signal no new key + RET ; and return. + +;-------------------- +; Check for BREAK key +;-------------------- +; This routine is called from COPY_LINE, when interrupts are disabled, +; to test if BREAK (SHIFT - SPACE) is being pressed. +; It is also called at STMT_RET after every statement. + + ;;;$1F54 +BREAK_KEY: LD A,$7F ; Input address: $7FFE + IN A,($FE) ; read lower right keys + RRA ; rotate bit 0 - SPACE + RET C ; return if not reset + + LD A,$FE ; Input address: $FEFE + IN A,($FE) ; read lower left keys + RRA ; rotate bit 0 - SHIFT + RET ; carry will be set if not pressed. + ; return with no carry if both keys pressed. + +;---------------------- +; Handle DEF FN command +;---------------------- +; e.g DEF FN r$(a$,a) = a$(a TO ) +; this 'command' is ignored in runtime but has it's syntax checked +; during line-entry. + + ;;;$1F60 +DEF_FN: CALL SYNTAX_Z ; routine SYNTAX_Z + JR Z,DEF_FN_1 ; forward to DEF_FN_1 if parsing + + LD A,$CE ; else load A with 'DEF FN' and + JP PASS_BY ; jump back to PASS_BY + + ; continue here if checking syntax. + + ;;;$1F6A +DEF_FN_1: SET 6,(IY+$01) ; set FLAGS - Assume numeric result + CALL ALPHA ; call routine ALPHA + JR NC,DEF_FN_4 ; if not then to DEF_FN_4 to jump to + ; 'Nonsense in Basic' + RST 20H ; NEXT_CHAR + CP $24 ; is it '$' ? + JR NZ,DEF_FN_2 ; to DEF_FN_2 if not as numeric. + + RES 6,(IY+$01) ; set FLAGS - Signal string result + RST 20H ; get NEXT_CHAR + + ;;;$1F7D +DEF_FN_2: CP $28 ; is it '(' ? + JR NZ,DEF_FN_7 ; to DEF_FN_7 'Nonsense in Basic' + + RST 20H ; NEXT_CHAR + CP $29 ; is it ')' ? + JR Z,DEF_FN_6 ; to DEF_FN_6 if null argument + + ;;;$1F86 +DEF_FN_3: CALL ALPHA ; routine ALPHA checks that it is the expected alphabetic character. + + ;;;$1F89 +DEF_FN_4: JP NC,REPORT_C ; to REPORT_C if not + ; 'Nonsense in Basic'. + + EX DE,HL ; save pointer in DE + RST 20H ; NEXT_CHAR re-initializes HL from CH_ADD and advances. + CP $24 ; '$' ? is it a string argument. + JR NZ,DEF_FN_5 ; forward to DEF_FN_5 if not. + + EX DE,HL ; save pointer to '$' in DE + + RST 20H ; NEXT_CHAR re-initializes HL and advances + + ;;;$1F94 +DEF_FN_5: EX DE,HL ; bring back pointer. + LD BC,$0006 ; the function requires six hidden bytes for + ; each parameter passed. + ; The first byte will be $0E + ; then 5-byte numeric value + ; or 5-byte string pointer. + CALL MAKE_ROOM ; routine MAKE_ROOM creates space in program area. + INC HL ; adjust HL (set by LDDR) + INC HL ; to point to first location. + LD (HL),$0E ; insert the 'hidden' marker. + + ; Note. these invisible storage locations hold nothing meaningful for the + ; moment. They will be used every time the corresponding function is + ; evaluated in runtime. + ; Now consider the following character fetched earlier. + + CP $2C ; is it ',' ? (more than one parameter) + JR NZ,DEF_FN_6 ; to DEF_FN_6 if not + + RST 20H ; else NEXT_CHAR + JR DEF_FN_3 ; and back to DEF_FN_3 + + ;;;$1FA6 +DEF_FN_6: CP $29 ; should close with a ')' + JR NZ,DEF_FN_7 ; to DEF_FN_7 if not + ; 'Nonsense in Basic' + RST 20H ; get NEXT_CHAR + CP $3D ; is it '=' ? + JR NZ,DEF_FN_7 ; to DEF_FN_7 if not 'Nonsense...' + + RST 20H ; address NEXT_CHAR + LD A,(FLAGS) ; get FLAGS which has been set above + PUSH AF ; and save while + CALL SCANNING ; routine SCANNING checks syntax of expression and sets flags also + POP AF ; restore previous flags + XOR (IY+$01) ; xor with FLAGS - bit 6 should be same, therefore will be reset. + AND $40 ; isolate bit 6. + + ;;;$1FBD +DEF_FN_7: JP NZ,REPORT_C ; jump back to REPORT_C if the expected result is not the same. + ; 'Nonsense in Basic' + CALL CHECK_END ; routine CHECK_END will return early if + ; at end of statement and move onto next + ; else produce error report. >>> + ; There will be no return to here. + +;-------------------------------- +; Returning early from subroutine +;-------------------------------- +; All routines are capable of being run in two modes - syntax checking mode +; and runtime mode. +; This routine is called often to allow a routine to return early +; if checking syntax. + + ;;;$1FC3 +UNSTACK_Z: CALL SYNTAX_Z ; routine SYNTAX_Z sets zero flag if syntax is being checked. + POP HL ; drop the return address. + RET Z ; return to previous call in chain if checking syntax. + + JP (HL) ; jump to return address as Basic program is + ; actually running. + +;---------------------- +; Handle LPRINT command +;---------------------- +; A simple form of 'PRINT #3' although it can output to 16 streams. +; Probably for compatibility with other basics particularly ZX81 Basic. +; An extra UDG might have been better. + + ;;;$1FC9 +LPRINT: LD A,$03 ; the printer channel + JR PRINT_1 ; forward to PRINT_1 + +;---------------------- +; Handle PRINT commands +;---------------------- +; The Spectrum's main stream output command. +; The default stream is stream 2 which is normally the upper screen +; of the computer. However the stream can be altered in range 0 - 15. + + ;;;$1FCD +PRINT: LD A,$02 ; the stream for the upper screen. + + ; The LPRINT command joins here. + + ;;;$1FCF +PRINT_1: CALL SYNTAX_Z ; routine SYNTAX_Z checks if program running + CALL NZ,CHAN_OPEN ; routine CHAN_OPEN if so + CALL TEMPS ; routine TEMPS sets temporary colours. + CALL PRINT_2 ; routine PRINT_2 - the actual item + CALL CHECK_END ; routine CHECK_END gives error if not at end of statement + RET ; and return >>> + + ; this subroutine is called from above + ; and also from INPUT. + + ;;;$1FDF +PRINT_2: RST 18H ; GET_CHAR gets printable character + CALL PR_END_Z ; routine PR_END_Z checks if more printing + JR Z,PRINT_4 ; to PRINT_4 if not e.g. just 'PRINT :' + + ; This tight loop deals with combinations of positional controls and + ; print items. An early return can be made from within the loop + ; if the end of a print sequence is reached. + + ;;;$1FE5 +PRINT_3: CALL PR_POSN_1 ; routine PR_POSN_1 returns zero if more + ; but returns early at this point if + ; at end of statement! + JR Z,PRINT_3 ; to PRINT_3 if consecutive positioners + + CALL PR_ITEM_1 ; routine PR_ITEM_1 deals with strings etc. + CALL PR_POSN_1 ; routine PR_POSN_1 for more position codes + JR Z,PRINT_3 ; loop back to PRINT_3 if so + + ;;;$1FF2 +PRINT_4: CP $29 ; return now if this is ')' from input-item. + ; (see INPUT.) + RET Z ; or continue and print carriage return in + ; runtime + +;---------------------- +; Print carriage return +;---------------------- +; This routine which continues from above prints a carriage return +; in run-time. It is also called once from PRINT_POSN. + + ;;;$1FF5 +PRINT_CR: CALL UNSTACK_Z ; routine UNSTACK_Z + LD A,$0D ; prepare a carriage return + RST 10H ; PRINT_A + RET ; return + +;------------ +; Print items +;------------ +; This routine deals with print items as in +; PRINT AT 10,0;"The value of A is ";a +; It returns once a single item has been dealt with as it is part +; of a tight loop that considers sequences of positional and print items + + ;;;$1FFC +PR_ITEM_1: RST 18H ; GET_CHAR + CP $AC ; is character 'AT' ? + JR NZ,PR_ITEM_2 ; forward to PR_ITEM_2 if not. + + CALL NEXT_2NUM ; routine NEXT_2NUM check for two comma + ; separated numbers placing them on the + ; calculator stack in runtime. + CALL UNSTACK_Z ; routine UNSTACK_Z quits if checking syntax. + CALL STK_TO_BC ; routine STK_TO_BC get the numbers in B and C. + LD A,$16 ; prepare the 'at' control. + JR PR_AT_TAB ; forward to PR_AT_TAB to print the sequence. + + ;;;$200E +PR_ITEM_2: CP $AD ; is character 'TAB' ? + JR NZ,PR_ITEM_3 ; to PR_ITEM_3 if not + + RST 20H ; NEXT_CHAR to address next character + CALL EXPT_1NUM ; routine EXPT_1NUM + CALL UNSTACK_Z ; routine UNSTACK_Z quits if checking syntax. + CALL FIND_INT2 ; routine FIND_INT2 puts integer in BC. + LD A,$17 ; prepare the 'tab' control. + + ;;;$201E +PR_AT_TAB: RST 10H ; PRINT_A outputs the control + LD A,C ; first value to A + RST 10H ; PRINT_A outputs it. + LD A,B ; second value + RST 10H ; PRINT_A + RET ; return - item finished >>> + + ; Now consider paper 2; #2; a$ + + ;;;$2024 +PR_ITEM_3: CALL CO_TEMP_3 ; routine CO_TEMP_3 will print any colour + RET NC ; items - return if success. + + CALL STR_ALTER ; routine STR_ALTER considers new stream + RET NC ; return if altered. + + CALL SCANNING ; routine SCANNING now to evaluate expression + CALL UNSTACK_Z ; routine UNSTACK_Z if not runtime. + BIT 6,(IY+$01) ; test FLAGS - Numeric or string result ? + CALL Z,STK_FETCH ; routine STK_FETCH if string. + ; note no flags affected. + JP NZ,PRINT_FP ; to PRINT_FP to print if numeric >>> + + ; It was a string expression - start in DE, length in BC + ; Now enter a loop to print it + + ;;;$203C +PR_STRING: LD A,B ; this tests if the + OR C ; length is zero and sets flag accordingly. + DEC BC ; this doesn't but decrements counter. + RET Z ; return if zero. + + LD A,(DE) ; fetch character. + INC DE ; address next location. + RST 10H ; PRINT_A. + JR PR_STRING ; loop back to PR_STRING. + +;---------------- +; End of printing +;---------------- +; This subroutine returns zero if no further printing is required +; in the current statement. +; The first terminator is found in escaped input items only, +; the others in print_items. + + ;;;$2045 +PR_END_Z: CP $29 ; is character a ')' ? + RET Z ; return if so - e.g. INPUT (p$); a$ + + ;;;$2048 +PR_ST_END: CP $0D ; is it a carriage return ? + RET Z ; return also - e.g. PRINT a + + CP $3A ; is character a ':' ? + RET ; return - zero flag will be set if so. + ; e.g. PRINT a : + +;--------------- +; Print position +;--------------- +; This routine considers a single positional character ';', ',', ''' + + ;;;$204E +PR_POSN_1: RST 18H ; GET_CHAR + CP $3B ; is it ';' ? + ; i.e. print from last position. + JR Z,PR_POSN_3 ; forward to PR_POSN_3 if so. + ; i.e. do nothing. + CP $2C ; is it ',' ? + ; i.e. print at next tabstop. + JR NZ,PR_POSN_2 ; forward to PR_POSN_2 if anything else. + + CALL SYNTAX_Z ; routine SYNTAX_Z + JR Z,PR_POSN_3 ; forward to PR_POSN_3 if checking syntax. + + LD A,$06 ; prepare the 'comma' control character. + RST 10H ; PRINT_A outputs to current channel in run-time. + JR PR_POSN_3 ; skip to PR_POSN_3. + + ; check for newline. + + ;;;$2061 +PR_POSN_2: CP $27 ; is character a "'" ? (newline) + RET NZ ; return if no match >>> + + CALL PRINT_CR ; routine PRINT_CR outputs a carriage return in runtime only. + + ;;;$2067 +PR_POSN_3: RST 20H ; NEXT_CHAR to A. + CALL PR_END_Z ; routine PR_END_Z checks if at end. + JR NZ,PR_POSN_4 ; to PR_POSN_4 if not. + + POP BC ; drop return address if at end. + + ;;;$206E +PR_POSN_4: CP A ; reset the zero flag. + RET ; and return to loop or quit. + +;------------- +; Alter stream +;------------- +; This routine is called from PRINT ITEMS above, and also LIST as in +; LIST #15 + + ;;;$2070 +STR_ALTER: CP $23 ; is character '#' ? + SCF ; set carry flag. + RET NZ ; return if no match. + + RST 20H ; NEXT_CHAR + CALL EXPT_1NUM ; routine EXPT_1NUM gets stream number + AND A ; prepare to exit early with carry reset + CALL UNSTACK_Z ; routine UNSTACK_Z exits early if parsing + CALL FIND_INT1 ; routine FIND_INT1 gets number off stack + CP $10 ; must be range 0 - 15 decimal. + JP NC,REPORT_OA ; jump back to REPORT_OA if not + ; 'Invalid stream'. + CALL CHAN_OPEN ; routine CHAN_OPEN + AND A ; clear carry - signal item dealt with. + RET ; return + +;--------------------- +; Handle INPUT command +;--------------------- +; This command +; + + ;;;$2089 +INPUT: CALL SYNTAX_Z ; routine SYNTAX_Z to check if in runtime. + JR Z,INPUT_1 ; forward to INPUT_1 if checking syntax. + + LD A,$01 ; select channel 'K' the keyboard for input. + CALL CHAN_OPEN ; routine CHAN_OPEN opens it. + CALL CLS_LOWER ; routine CLS_LOWER clears the lower screen. + + ;;;$2096 +INPUT_1: LD (IY+$02),$01 ; set TV_FLAG - signal lower screen in use and clear the other bits. + CALL IN_ITEM_1 ; routine IN_ITEM_1 to handle the input. + CALL CHECK_END ; routine CHECK_END will make an early exit if checking syntax. >>> + + ; keyboard input has been made and it remains to adjust the upper + ; screen in case the lower two lines have been extended upwards. + + LD BC,(S_POSN) ; fetch S_POSN current line/column of the upper screen. + LD A,(DF_SZ) ; fetch DF_SZ the display file size of the lower screen. + CP B ; test that lower screen does not overlap + JR C,INPUT_2 ; forward to INPUT_2 if not. + + ; the two screens overlap so adjust upper screen. + + LD C,$21 ; set column of upper screen to leftmost. + LD B,A ; and line to one above lower screen. + ; continue forward to update upper screen + ; print position. + + ;;;$20AD +INPUT_2: LD (S_POSN),BC ; set S_POSN update upper screen line/column. + LD A,$19 ; subtract from twenty five + SUB B ; the new line number. + LD (SCR_CT),A ; and place result in SCR_CT - scroll count. + RES 0,(IY+$02) ; update TV_FLAG - signal main screen in use. + CALL CL_SET ; routine CL_SET sets the print position + ; system variables for the upper screen. + JP CLS_LOWER ; jump back to CLS_LOWER and make + ; an indirect exit >>. + +;---------------------- +; INPUT ITEM subroutine +;---------------------- +; This subroutine deals with the input items and print items. +; from the current input channel. +; It is only called from the above INPUT routine but was obviously +; once called from somewhere else in another context. + + ;;;$20C1 +IN_ITEM_1: CALL PR_POSN_1 ; routine PR_POSN_1 deals with a single + ; position item at each call. + JR Z,IN_ITEM_1 ; back to IN_ITEM_1 until no more in a sequence. + + CP $28 ; is character '(' ? + JR NZ,IN_ITEM_2 ; forward to IN_ITEM_2 if not. + + ; any variables within braces will be treated as part, or all, of the prompt + ; instead of being used as destination variables. + + RST 20H ; NEXT_CHAR + CALL PRINT_2 ; routine PRINT_2 to output the dynamic prompt. + RST 18H ; GET_CHAR + CP $29 ; is character a matching ')' ? + JP NZ,REPORT_C ; jump back to REPORT_C if not. + ; 'Nonsense in basic'. + RST 20H ; NEXT_CHAR + JP IN_NEXT_2 ; forward to IN_NEXT_2 + + ;;;$20D8 +IN_ITEM_2: CP $CA ; is the character the token 'LINE' ? + JR NZ,IN_ITEM_3 ; forward to IN_ITEM_3 if not. + + RST 20H ; NEXT_CHAR - variable must come next. + CALL CLASS_01 ; routine CLASS_01 returns destination + ; address of variable to be assigned. + ; or generates an error if no variable + ; at this position. + + SET 7,(IY+$37) ; update FLAGX - signal handling INPUT LINE + BIT 6,(IY+$01) ; test FLAGS - numeric or string result ? + JP NZ,REPORT_C ; jump back to REPORT_C if not string + ; 'Nonsense in basic'. + + JR IN_PROMPT ; forward to IN_PROMPT to set up workspace. + + ; the jump was here for other variables. + + ;;;$20ED +IN_ITEM_3: CALL ALPHA ; routine ALPHA checks if character is + ; a suitable variable name. + JP NC,IN_NEXT_1 ; forward to IN_NEXT_1 if not + + CALL CLASS_01 ; routine CLASS_01 returns destination + ; address of variable to be assigned. + RES 7,(IY+$37) ; update FLAGX - signal not INPUT LINE. + + ;;;$20FA +IN_PROMPT: CALL SYNTAX_Z ; routine SYNTAX_Z + JP Z,IN_NEXT_2 ; forward to IN_NEXT_2 if checking syntax. + + CALL SET_WORK ; routine SET_WORK clears workspace. + LD HL,FLAGX ; point to system variable FLAGX + RES 6,(HL) ; signal string result. + SET 5,(HL) ; signal in Input Mode for editor. + LD BC,$0001 ; initialize space required to one for + ; the carriage return. + BIT 7,(HL) ; test FLAGX - INPUT LINE in use ? + JR NZ,IN_PR_2 ; forward to IN_PR_2 if so as that is all the space that is required. + + LD A,(FLAGS) ; load accumulator from FLAGS + AND $40 ; mask to test BIT 6 of FLAGS and clear the other bits in A. + ; numeric result expected ? + JR NZ,IN_PR_1 ; forward to IN_PR_1 if so + + LD C,$03 ; increase space to three bytes for the pair of surrounding quotes. + + ;;;$211A +IN_PR_1: OR (HL) ; if numeric result, set bit 6 of FLAGX. + LD (HL),A ; and update system variable + + ;;;$211C +IN_PR_2: RST 30H ; BC_SPACES opens 1 or 3 bytes in workspace + LD (HL),$0D ; insert carriage return at last new location. + LD A,C ; fetch the length, one or three. + RRCA ; lose bit 0. + RRCA ; test if quotes required. + JR NC,IN_PR_3 ; forward to IN_PR_3 if not. + + LD A,$22 ; load the '"' character + LD (DE),A ; place quote in first new location at DE. + DEC HL ; decrease HL - from carriage return. + LD (HL),A ; and place a quote in second location. + + ;;;$2129 +IN_PR_3: LD (K_CUR),HL ; set keyboard cursor K_CUR to HL + BIT 7,(IY+$37) ; test FLAGX - is this INPUT LINE ?? + JR NZ,IN_VAR_3 ; forward to IN_VAR_3 if so as input will + ; be accepted without checking it's syntax. + LD HL,(CH_ADD) ; fetch CH_ADD + PUSH HL ; and save on stack. + LD HL,(ERR_SP) ; fetch ERR_SP + PUSH HL ; and save on stack + + ;;;$213A +IN_VAR_1: LD HL,IN_VAR_1 ; address: IN_VAR_1 - this address + PUSH HL ; is saved on stack to handle errors. + BIT 4,(IY+$30) ; test FLAGS2 - is K channel in use ? + JR Z,IN_VAR_2 ; forward to IN_VAR_2 if not using the keyboard for input. (??) + + LD (ERR_SP),SP ; set ERR_SP to point to IN_VAR_1 on stack. + + ;;;$2148 +IN_VAR_2: LD HL,(WORKSP) ; set HL to WORKSP - start of workspace. + CALL REMOVE_FP ; routine REMOVE_FP removes floating point + ; forms when looping in error condition. + LD (IY+$00),$FF ; set ERR_NR to 'OK' cancelling the error. + ; but X_PTR causes flashing error marker + ; to be displayed at each call to the editor. + CALL EDITOR ; routine EDITOR allows input to be entered + ; or corrected if this is second time around. + + ; if we pass to next then there are no system errors + + RES 7,(IY+$01) ; update FLAGS - signal checking syntax + CALL IN_ASSIGN ; routine IN_ASSIGN checks syntax using + ; the VAL_FET_2 and powerful SCANNING routines. + ; any syntax error and it's back to IN_VAR_1. + ; but with the flashing error marker showing + ; where the error is. + ; Note. the syntax of string input has to be + ; checked as the user may have removed the + ; bounding quotes or escaped them as with + ; "hat" + "stand" for example. + ; proceed if syntax passed. + + JR IN_VAR_4 ; jump forward to IN_VAR_4 + + ; the jump was to here when using INPUT LINE. + + ;;;$215E +IN_VAR_3: CALL EDITOR ; routine EDITOR is called for input + + ; when ENTER received rejoin other route but with no syntax check. + + ; INPUT and INPUT LINE converge here. + + ;;;$2161 +IN_VAR_4: LD (IY+$22),$00 ; set K_CUR_hi to a low value so that the cursor + ; no longer appears in the input line. + CALL IN_CHAN_K ; routine IN_CHAN_K tests if the keyboard + ; is being used for input. + JR NZ,IN_VAR_5 ; forward to IN_VAR_5 if using another input channel. + + ; continue here if using the keyboard. + + CALL ED_COPY ; routine ED_COPY overprints the edit line + ; to the lower screen. The only visible + ; affect is that the cursor disappears. + ; if you're inputting more than one item in + ; a statement then that becomes apparent. + LD BC,(ECHO_E) ; fetch line and column from ECHO_E + CALL CL_SET ; routine CL_SET sets S-POSNL to those values. + + ; if using another input channel rejoin here. + + ;;;$2174 +IN_VAR_5: LD HL,FLAGX ; point HL to FLAGX + RES 5,(HL) ; signal not in input mode + BIT 7,(HL) ; is this INPUT LINE ? + RES 7,(HL) ; cancel the bit anyway. + JR NZ,IN_VAR_6 ; forward to IN_VAR_6 if INPUT LINE. + + POP HL ; drop the looping address + POP HL ; drop the the address of previous error handler. + LD (ERR_SP),HL ; set ERR_SP to point to it. + POP HL ; drop original CH_ADD which points to INPUT command in BASIC line. + LD (X_PTR),HL ; save in X_PTR while input is assigned. + SET 7,(IY+$01) ; update FLAGS - Signal running program + CALL IN_ASSIGN ; routine IN_ASSIGN is called again + ; this time the variable will be assigned + ; the input value without error. + ; Note. the previous example now + ; becomes "hatstand" + LD HL,(X_PTR) ; fetch stored CH_ADD value from X_PTR. + LD (IY+$26),$00 ; set X_PTR_HI so that no longer relevant. + LD (CH_ADD),HL ; put restored value back in CH_ADD + JR IN_NEXT_2 ; forward to IN_NEXT_2 to see if anything + ; more in the INPUT list. + + ; the jump was to here with INPUT LINE only + + ;;;$219B +IN_VAR_6: LD HL,(STKBOT) ; STKBOT points to the end of the input. + LD DE,(WORKSP) ; WORKSP points to the beginning. + SCF ; prepare for true subtraction. + SBC HL,DE ; subtract to get length + LD B,H ; transfer it to + LD C,L ; the BC register pair. + CALL STK_STO_D ; routine STK_STO_D stores parameters on + ; the calculator stack. + CALL LET ; routine LET assigns it to destination. + JR IN_NEXT_2 ; forward to IN_NEXT_2 as print items + ; not allowed with INPUT LINE. + ; Note. that "hat" + "stand" will, for + ; example, be unchanged as also would + ; 'PRINT "Iris was here"'. + + ; the jump was to here when ALPHA found more items while looking for + ; a variable name. + + ;;;$21AF +IN_NEXT_1: CALL PR_ITEM_1 ; routine PR_ITEM_1 considers further items. + + ;;;$21B2 +IN_NEXT_2: CALL PR_POSN_1 ; routine PR_POSN_1 handles a position item. + JP Z,IN_ITEM_1 ; jump back to IN_ITEM_1 if the zero flag + ; indicates more items are present. + + RET ; return. + +;---------------------------- +; INPUT ASSIGNMENT Subroutine +;---------------------------- +; This subroutine is called twice from the INPUT command when normal +; keyboard input is assigned. On the first occasion syntax is checked +; using SCANNING. The final call with the syntax flag reset is to make +; the assignment. + + ;;;$21B9 +IN_ASSIGN: LD HL,(WORKSP) ; fetch WORKSP start of input + LD (CH_ADD),HL ; set CH_ADD to first character + RST 18H ; GET_CHAR ignoring leading white-space. + CP $E2 ; is it 'STOP' + JR Z,IN_STOP ; forward to IN_STOP if so. + + LD A,(FLAGX) ; load accumulator from FLAGX + CALL VAL_FET_2 ; routine VAL_FET_2 makes assignment + ; or goes through the motions if checking + ; syntax. SCANNING is used. + RST 18H ; GET_CHAR + CP $0D ; is it carriage return ? + RET Z ; return if so + ; either syntax is OK + ; or assignment has been made. + + ; if another character was found then raise an error. + ; User doesn't see report but the flashing error marker + ; appears in the lower screen. + + ;;;$21CE +REPORT_CB: RST 08H ; ERROR_1 + DEFB $0B ; Error Report: Nonsense in BASIC + + ;;;$21D0 +IN_STOP: CALL SYNTAX_Z ; routine SYNTAX_Z (UNSTACK_Z?) + RET Z ; return if checking syntax + ; as user wouldn't see error report. + ; but generate visible error report + ; on second invocation. + + ;;;$21D4 +REPORT_H: RST 08H ; ERROR_1 + DEFB $10 ; Error Report: STOP in INPUT + +;------------------- +; Test for channel K +;------------------- +; This subroutine is called once from the keyboard +; INPUT command to check if the input routine in +; use is the one for the keyboard. + + ;;;$21D6 +IN_CHAN_K: LD HL,(CURCHL) ; fetch address of current channel CURCHL + INC HL + INC HL ; advance past + INC HL ; input and + INC HL ; output streams + LD A,(HL) ; fetch the channel identifier. + CP $4B ; test for 'K' + RET ; return with zero set if keyboard is use. + +;--------------------- +; Colour Item Routines +;--------------------- +; +; These routines have 3 entry points - +; 1) CO_TEMP_2 to handle a series of embedded Graphic colour items. +; 2) CO_TEMP_3 to handle a single embedded print colour item. +; 3) CO_TEMP_4 to handle a colour command such as FLASH 1 +; +; "Due to a bug, if you bring in a peripheral channel and later use a colour +; statement, colour controls will be sent to it by mistake." - Steven Vickers +; Pitman Pocket Guide, 1984. +; +; To be fair, this only applies if the last channel was other than 'K', 'S' +; or 'P', which are all that are supported by this ROM, but if that last +; channel was a microdrive file, network channel etc. then +; PAPER 6; CLS will not turn the screen yellow and +; CIRCLE INK 2; 128,88,50 will not draw a red circle. +; +; This bug does not apply to embedded PRINT items as it is quite permissible +; to mix stream altering commands and colour items. +; The fix therefore would be to ensure that CLASS_07 and CLASS_09 make +; PRINT_OUT the current channel when not checking syntax. +; ----------------------------------------------------------------- + + ;;;$21E1 +CO_TEMP_1: RST 20H ; NEXT_CHAR + + ; -> Entry point from CLASS_09. Embedded Graphic colour items. + ; e.g. PLOT INK 2; PAPER 8; 128,88 + ; Loops till all colour items output, finally addressing the coordinates. + + ;;;$21E2 +CO_TEMP_2: CALL CO_TEMP_3 ; routine CO_TEMP_3 to output colour control. + RET C ; return if nothing more to output. -> + + RST 18H ; GET_CHAR + CP $2C ; is it ',' separator ? + JR Z,CO_TEMP_1 ; back if so to CO_TEMP_1 + + CP $3B ; is it ';' separator ? + JR Z,CO_TEMP_1 ; back to CO_TEMP_1 for more. + + JP REPORT_C ; to REPORT_C (REPORT_CB is within range) + ; 'Nonsense in Basic' + +; ------------------- +; CO_TEMP_3 +; ------------------- +; -> this routine evaluates and outputs a colour control and parameter. +; It is called from above and also from PR_ITEM_3 to handle a single embedded +; print item e.g. PRINT PAPER 6; "Hi". In the latter case, the looping for +; multiple items is within the PR-ITEM routine. +; It is quite permissible to send these to any stream. + + ;;;$21F2 +CO_TEMP_3: CP $D9 ; is it 'INK' ? + RET C ; return if less. + + CP $DF ; compare with 'OUT' + CCF ; Complement Carry Flag + RET C ; return if greater than 'OVER', $DE. + + PUSH AF ; save the colour token. + RST 20H ; address NEXT_CHAR + POP AF ; restore token and continue. + + ; -> this entry point used by CLASS_07. e.g. the command PAPER 6. + + ;;;$21FC +CO_TEMP_4: SUB $C9 ; reduce to control character $10 (INK) thru $15 (OVER). + PUSH AF ; save control. + CALL EXPT_1NUM ; routine EXPT_1NUM stacks addressed + ; parameter on calculator stack. + POP AF ; restore control. + AND A ; clear carry + CALL UNSTACK_Z ; routine UNSTACK_Z returns if checking syntax. + PUSH AF ; save again + CALL FIND_INT1 ; routine FIND_INT1 fetches parameter to A. + LD D,A ; transfer now to D + POP AF ; restore control. + RST 10H ; PRINT_A outputs the control to current channel. + LD A,D ; transfer parameter to A. + RST 10H ; PRINT_A outputs parameter. + RET ; return. -> + +; ------------------------------------------------------------------------- +; +; {fl}{br}{ paper }{ ink } The temporary colour attributes +; ___ ___ ___ ___ ___ ___ ___ ___ system variable. +; ATTR_T | | | | | | | | | +; | | | | | | | | | +; 23695 |___|___|___|___|___|___|___|___| +; 7 6 5 4 3 2 1 0 +; +; +; {fl}{br}{ paper }{ ink } The temporary mask used for +; ___ ___ ___ ___ ___ ___ ___ ___ transparent colours. Any bit +; MASK_T | | | | | | | | | that is 1 shows that the +; | | | | | | | | | corresponding attribute is +; 23696 |___|___|___|___|___|___|___|___| taken not from ATTR-T but from +; 7 6 5 4 3 2 1 0 what is already on the screen. +; +; +; {paper9 }{ ink9 }{ inv1 }{ over1} The print flags. Even bits are +; ___ ___ ___ ___ ___ ___ ___ ___ temporary flags. The odd bits +; P_FLAG | | | | | | | | | are the permanent flags. +; | p | t | p | t | p | t | p | t | +; 23697 |___|___|___|___|___|___|___|___| +; 7 6 5 4 3 2 1 0 +; +; ----------------------------------------------------------------------- + + +; ------------------------------------ +; The colour system variable handler. +; ------------------------------------ +; This is an exit branch from PO_1_OPER, PO_2_OPER +; A holds control $10 (INK) to $15 (OVER) +; D holds parameter 0-9 for ink/paper 0,1 or 8 for bright/flash, +; 0 or 1 for over/inverse. + + ;;;$2211 +CO_TEMP_5: SUB $11 ; reduce range $FF-$04 + ADC A,$00 ; add in carry if INK + JR Z,CO_TEMP_7 ; forward to CO_TEMP_7 with INK and PAPER. + + SUB $02 ; reduce range $FF-$02 + ADC A,$00 ; add carry if FLASH + JR Z,CO_TEMP_C ; forward to CO_TEMP_C with FLASH and BRIGHT. + + CP $01 ; is it 'INVERSE' ? + LD A,D ; fetch parameter for INVERSE/OVER + LD B,$01 ; prepare OVER mask setting bit 0. + JR NZ,CO_TEMP_6 ; forward to CO_TEMP_6 if OVER + + RLCA ; shift bit 0 + RLCA ; to bit 2 + LD B,$04 ; set bit 2 of mask for inverse. + + ;;;$2228 +CO_TEMP_6: LD C,A ; save the A + LD A,D ; re-fetch parameter + CP $02 ; is it less than 2 + JR NC,REPORT_K ; to REPORT_K if not 0 or 1. + ; 'Invalid colour'. + LD A,C ; restore A + LD HL,P_FLAG ; address system variable P_FLAG + JR CO_CHANGE ; forward to exit via routine CO_CHANGE + + ; the branch was here with INK/PAPER and carry set for INK. + + ;;;$2234 +CO_TEMP_7: LD A,D ; fetch parameter + LD B,$07 ; set ink mask 00000111 + JR C,CO_TEMP_8 ; forward to CO_TEMP_8 with INK + + RLCA ; shift bits 0-2 + RLCA ; to + RLCA ; bits 3-5 + LD B,$38 ; set paper mask 00111000 + + ; both paper and ink rejoin here + + ;;;$223E +CO_TEMP_8: LD C,A ; value to C + LD A,D ; fetch parameter + CP $0A ; is it less than 10d ? + JR C,CO_TEMP_9 ; forward to CO_TEMP_9 if so. + + ; ink 10 etc. is not allowed. + + ;;;$2244 +REPORT_K: RST 08H ; ERROR_1 + DEFB $13 ; Error Report: Invalid colour + + ;;;$2246 +CO_TEMP_9: LD HL,ATTRT_MASKT ; address system variable ATTR_T initially. + CP $08 ; compare with 8 + JR C,CO_TEMP_B ; forward to CO_TEMP_B with 0-7. + + LD A,(HL) ; fetch temporary attribute as no change. + JR Z,CO_TEMP_A ; forward to CO_TEMP_A with INK/PAPER 8 + + ; it is either ink 9 or paper 9 (contrasting) + + OR B ; or with mask to make white + CPL ; make black and change other to dark + AND $24 ; 00100100 + JR Z,CO_TEMP_A ; forward to CO_TEMP_A if black and + ; originally light. + LD A,B ; else just use the mask (white) + + ;;;$2257 +CO_TEMP_A: LD C,A ; save A in C + + ;;;$2258 +CO_TEMP_B: LD A,C ; load colour to A + CALL CO_CHANGE ; routine CO_CHANGE addressing ATTR-T + LD A,$07 ; put 7 in accumulator + CP D ; compare with parameter + SBC A,A ; $00 if 0-7, $FF if 8 + CALL CO_CHANGE ; routine CO_CHANGE addressing MASK-T + ; mask returned in A. + + ; now consider P-FLAG. + + RLCA ; 01110000 or 00001110 + RLCA ; 11100000 or 00011100 + AND $50 ; 01000000 or 00010000 (AND 01010000) + LD B,A ; transfer to mask + LD A,$08 ; load A with 8 + CP D ; compare with parameter + SBC A,A ; $FF if was 9, $00 if 0-8 + ; continue while addressing P-FLAG + ; setting bit 4 if ink 9 + ; setting bit 6 if paper 9 + +;------------------------ +; Handle change of colour +;------------------------ +; This routine addresses a system variable ATTR_T, MASK_T or P-FLAG in HL. +; colour value in A, mask in B. + + ;;;$226C +CO_CHANGE: XOR (HL) ; impress bits specified + AND B ; by mask + XOR (HL) ; on system variable. + LD (HL),A ; update system variable. + INC HL ; address next location. + LD A,B ; put current value of mask in A + RET ; return. + + ; the branch was here with flash and bright + + ;;;$2273 +CO_TEMP_C: SBC A,A ; set zero flag for bright. + LD A,D ; fetch original parameter 0,1 or 8 + RRCA ; rotate bit 0 to bit 7 + LD B,$80 ; mask for flash 10000000 + JR NZ,CO_TEMP_D ; forward to CO_TEMP_D if flash + + RRCA ; rotate bit 7 to bit 6 + LD B,$40 ; mask for bright 01000000 + + ;;;$227D +CO_TEMP_D: LD C,A ; store value in C + LD A,D ; fetch parameter + CP $08 ; compare with 8 + JR Z,CO_TEMP_E ; forward to CO_TEMP_E if 8 + + CP $02 ; test if 0 or 1 + JR NC,REPORT_K ; back to REPORT_K if not + ; 'Invalid colour' + + ;;;$2287 +CO_TEMP_E: LD A,C ; value to A + LD HL,ATTRT_MASKT ; address ATTR_T + CALL CO_CHANGE ; routine CO_CHANGE addressing ATTR_T + LD A,C ; fetch value + RRCA ; for flash8/bright8 complete + RRCA ; rotations to put set bit in + RRCA ; bit 7 (flash) bit 6 (bright) + JR CO_CHANGE ; back to CO_CHANGE addressing MASK_T + ; and indirect return. + +;---------------------- +; Handle BORDER command +;---------------------- +; Command syntax example: BORDER 7 +; This command routine sets the border to one of the eight colours. +; The colours used for the lower screen are based on this. + + ;;;$2294 +BORDER: CALL FIND_INT1 ; routine FIND_INT1 + CP $08 ; must be in range 0 (black) to 7 (white) + JR NC,REPORT_K ; back to REPORT_K if not + ; 'Invalid colour'. + OUT ($FE),A ; outputting to port effects an immediate + ; change. + RLCA ; shift the colour to + RLCA ; the paper bits setting the + RLCA ; ink colour black. + BIT 5,A ; is the number light coloured ? + ; i.e. in the range green to white. + JR NZ,BORDER_1 ; skip to BORDER_1 if so + + XOR $07 ; make the ink white. + + ;;;$22A6 +BORDER_1: LD (BORDCR),A ; update BORDCR with new paper/ink + RET ; return. + +;------------------ +; Get pixel address +;------------------ + + ;;;$22AA +PIXEL_ADD: LD A,$AF ; load with 175 decimal. + SUB B ; subtract the y value. + JP C,REPORT_BC ; jump forward to REPORT_BC if greater. + ; 'Integer out of range' + + ; the high byte is derived from Y only. + ; the first 3 bits are always 010 + ; the next 2 bits denote in which third of the screen the byte is. + ; the last 3 bits denote in which of the 8 scan lines within a third + ; the byte is located. There are 24 discrete values. + + + LD B,A ; the line number from top of screen to B. + AND A ; clear carry (already clear) + RRA ; 0xxxxxxx + SCF ; set carry flag + RRA ; 10xxxxxx + AND A ; clear carry flag + RRA ; 010xxxxx + XOR B + AND $F8 ; keep the top 5 bits 11111000 + XOR B ; 010xxbbb + LD H,A ; transfer high byte to H. + + ; the low byte is derived from both X and Y. + + LD A,C ; the x value 0-255. + RLCA + RLCA + RLCA + XOR B ; the y value + AND $C7 ; apply mask 11000111 + XOR B ; restore unmasked bits xxyyyxxx + RLCA ; rotate to xyyyxxxx + RLCA ; required position. yyyxxxxx + LD L,A ; low byte to L. + + ; finally form the pixel position in A. + + LD A,C ; x value to A + AND $07 ; mod 8 + RET ; return + +;----------------- +; Point Subroutine +;----------------- +; The point subroutine is called from S_POINT via the scanning functions +; table. + + ;;;$22CB +POINT_SUB: CALL STK_TO_BC ; routine STK_TO_BC + CALL PIXEL_ADD ; routine PIXEL_ADD finds address of pixel. + LD B,A ; pixel position to B, 0-7. + INC B ; increment to give rotation count 1-8. + LD A,(HL) ; fetch byte from screen. + + ;;;$22D4 +POINT_LP: RLCA ; rotate and loop back + DJNZ POINT_LP ; to POINT_LP until pixel at right. + AND $01 ; test to give zero or one. + JP STACK_A ; jump forward to STACK_A to save result. + +;-------------------- +; Handle PLOT command +;-------------------- +; Command Syntax example: PLOT 128,88 + + ;;;$22DC +PLOT: CALL STK_TO_BC ; routine STK_TO_BC + CALL PLOT_SUB ; routine PLOT_SUB + JP TEMPS ; to TEMPS + +; ------------------- +; The Plot subroutine +; ------------------- +; A screen byte holds 8 pixels so it is necessary to rotate a mask +; into the correct position to leave the other 7 pixels unaffected. +; However all 64 pixels in the character cell take any embedded colour items. +; A pixel can be reset (inverse 1), toggled (over 1), or set ( with inverse +; and over switches off). With both switches on, the byte is simply put +; back on the screen though the colours may change. + + ;;;$22E5 +PLOT_SUB: LD (COORDS),BC ; store new x/y values in COORDS + CALL PIXEL_ADD ; routine PIXEL_ADD gets address in HL, + ; count from left 0-7 in B. + LD B,A ; transfer count to B. + INC B ; increase 1-8. + LD A,$FE ; 11111110 in A. + + ;;;$22F0 +PLOT_LOOP: RRCA ; rotate mask. + DJNZ PLOT_LOOP ; to PLOT_LOOP until B circular rotations. + LD B,A ; load mask to B + LD A,(HL) ; fetch screen byte to A + LD C,(IY+$57) ; P_FLAG to C + BIT 0,C ; is it to be OVER 1 ? + JR NZ,PL_TST_IN ; forward to PL_TST_IN if so. + + ; was over 0 + + AND B ; combine with mask to blank pixel. + + ;;;$22FD +PL_TST_IN: BIT 2,C ; is it inverse 1 ? + JR NZ,PLOT_END ; to PLOT_END if so. + + XOR B ; switch the pixel + CPL ; restore other 7 bits + + ;;;$2303 +PLOT_END: LD (HL),A ; load byte to the screen. + JP PO_ATTR ; exit to PO_ATTR to set colours for cell. + +;------------------------------- +; Put two numbers in BC register +;------------------------------- + + ;;;$2307 +STK_TO_BC: CALL STK_TO_A ; routine STK_TO_A + LD B,A + PUSH BC + CALL STK_TO_A ; routine STK_TO_A + LD E,C + POP BC + LD D,C + LD C,A + RET + +;------------------------ +; Put stack in A register +;------------------------ +; This routine puts the last value on the calculator stack into the accumulator +; deleting the last value. + + ;;;$2314 +STK_TO_A: CALL FP_TO_A ; routine FP_TO_A compresses last value into + ; accumulator. e.g. PI would become 3. + ; zero flag set if positive. + JP C,REPORT_BC ; jump forward to REPORT_BC if >= 255.5. + + LD C,$01 ; prepare a positive sign byte. + RET Z ; return if FP_TO_BC indicated positive. + + LD C,$FF ; prepare negative sign byte and + RET ; return. + + +;---------------------- +; Handle CIRCLE command +;---------------------- +; +; syntax has been partly checked using the class for draw command. + + ;;;$2320 +CIRCLE: RST 18H ; GET_CHAR + CP $2C ; is it required comma ? + JP NZ,REPORT_C ; jump to REPORT_C if not + + RST 20H ; NEXT_CHAR + CALL EXPT_1NUM ; routine EXPT_1NUM fetches radius + CALL CHECK_END ; routine CHECK_END will return here if + ; nothing follows command. + RST 28H ;; FP_CALC + DEFB $2A ;;ABS ; make radius positive + DEFB $3D ;;RE_STACK ; in full floating point form + DEFB $38 ;;END_CALC + + LD A,(HL) ; fetch first floating point byte + CP $81 ; compare to one + JR NC,C_R_GRE_1 ; forward to C_R_GRE_1 if circle radius + ; is greater than one. + RST 28H ;; FP_CALC + DEFB $02 ;;DELETE ; delete the radius from stack. + DEFB $38 ;;END_CALC + + JR PLOT ; to PLOT to just plot x,y. + + + ;;;$233B +C_R_GRE_1: RST 28H ;; FP_CALC ; x, y, r + DEFB $A3 ;;STK_PI_2 ; x, y, r, pi/2. + DEFB $38 ;;END_CALC + + LD (HL),$83 ; x, y, r, 2*PI + RST 28H ;; FP_CALC + DEFB $C5 ;;st-mem-5 ; store 2*PI in mem-5 + DEFB $02 ;;DELETE ; x, y, z. + DEFB $38 ;;END_CALC + + CALL CD_PRMS1 ; routine CD_PRMS1 + PUSH BC + RST 28H ;; FP_CALC + DEFB $31 ;;DUPLICATE + DEFB $E1 ;;get-mem-1 + DEFB $04 ;;MULTIPLY + DEFB $38 ;;END_CALC + + LD A,(HL) + CP $80 + JR NC,C_ARC_GE1 ; to C_ARC_GE1 + + RST 28H ;; FP_CALC + DEFB $02 ;;DELETE + DEFB $02 ;;DELETE + DEFB $38 ;;END_CALC + + POP BC + JP PLOT ; to PLOT + + + ;;;$235A +C_ARC_GE1: RST 28H ;; FP_CALC + DEFB $C2 ;;st-mem-2 + DEFB $01 ;;EXCHANGE + DEFB $C0 ;;st-mem-0 + DEFB $02 ;;DELETE + DEFB $03 ;;SUBTRACT + DEFB $01 ;;EXCHANGE + DEFB $E0 ;;get-mem-0 + DEFB $0F ;;ADDITION + DEFB $C0 ;;st-mem-0 + DEFB $01 ;;EXCHANGE + DEFB $31 ;;DUPLICATE + DEFB $E0 ;;get-mem-0 + DEFB $01 ;;EXCHANGE + DEFB $31 ;;DUPLICATE + DEFB $E0 ;;get-mem-0 + DEFB $A0 ;;STK_ZERO + DEFB $C1 ;;st-mem-1 + DEFB $02 ;;DELETE + DEFB $38 ;;END_CALC + + INC (IY+$62) ; MEM-2-1st + CALL FIND_INT1 ; routine FIND_INT1 + LD L,A + PUSH HL + CALL FIND_INT1 ; routine FIND_INT1 + POP HL + LD H,A + LD (COORDS),HL ; COORDS + POP BC + JP DRW_STEPS ; to DRW_STEPS + + +;-------------------- +; Handle DRAW command +;-------------------- + + ;;;$2382 +DRAW: RST 18H ; GET_CHAR + CP $2C + JR Z,DR_3_PRMS ; to DR_3_PRMS + + CALL CHECK_END ; routine CHECK_END + JP LINE_DRAW ; to LINE_DRAW + + + ;;;$238D +DR_3_PRMS: RST 20H ; NEXT_CHAR + CALL EXPT_1NUM ; routine EXPT_1NUM + CALL CHECK_END ; routine CHECK_END + + RST 28H ;; FP_CALC + DEFB $C5 ;;st-mem-5 + DEFB $A2 ;;STK_HALF + DEFB $04 ;;MULTIPLY + DEFB $1F ;;SIN_ + DEFB $31 ;;DUPLICATE + DEFB $30 ;;NOT + DEFB $30 ;;NOT + DEFB $00 ;;JUMP_TRUE + + DEFB $06 ;;to DR_SIN_NZ + + DEFB $02 ;;DELETE + DEFB $38 ;;END_CALC + + JP LINE_DRAW ; to LINE_DRAW + + ;;;$23A3 +DR_SIN_NZ: DEFB $C0 ;;st-mem-0 + DEFB $02 ;;DELETE + DEFB $C1 ;;st-mem-1 + DEFB $02 ;;DELETE + DEFB $31 ;;DUPLICATE + DEFB $2A ;;ABS + DEFB $E1 ;;get-mem-1 + DEFB $01 ;;EXCHANGE + DEFB $E1 ;;get-mem-1 + DEFB $2A ;;ABS + DEFB $0F ;;ADDITION + DEFB $E0 ;;get-mem-0 + DEFB $05 ;;DIVISION + DEFB $2A ;;ABS + DEFB $E0 ;;get-mem-0 + DEFB $01 ;;EXCHANGE + DEFB $3D ;;RE_STACK + DEFB $38 ;;END_CALC + + LD A,(HL) + CP $81 + JR NC,DR_PRMS ; to DR_PRMS + + RST 28H ;; FP_CALC + DEFB $02 ;;DELETE + DEFB $02 ;;DELETE + DEFB $38 ;;END_CALC + + JP LINE_DRAW ; to LINE_DRAW + + ;;;$23C1 +DR_PRMS: CALL CD_PRMS1 ; routine CD_PRMS1 + PUSH BC ; + RST 28H ;; FP_CALC + DEFB $02 ;;DELETE + DEFB $E1 ;;get-mem-1 + DEFB $01 ;;EXCHANGE + DEFB $05 ;;DIVISION + DEFB $C1 ;;st-mem-1 + DEFB $02 ;;DELETE + DEFB $01 ;;EXCHANGE + DEFB $31 ;;DUPLICATE + DEFB $E1 ;;get-mem-1 + DEFB $04 ;;MULTIPLY + DEFB $C2 ;;st-mem-2 + DEFB $02 ;;DELETE + DEFB $01 ;;EXCHANGE + DEFB $31 ;;DUPLICATE + DEFB $E1 ;;get-mem-1 + DEFB $04 ;;MULTIPLY + DEFB $E2 ;;get-mem-2 + DEFB $E5 ;;get-mem-5 + DEFB $E0 ;;get-mem-0 + DEFB $03 ;;SUBTRACT + DEFB $A2 ;;STK_HALF + DEFB $04 ;;MULTIPLY + DEFB $31 ;;DUPLICATE + DEFB $1F ;;SIN_ + DEFB $C5 ;;st-mem-5 + DEFB $02 ;;DELETE + DEFB $20 ;;COS_ + DEFB $C0 ;;st-mem-0 + DEFB $02 ;;DELETE + DEFB $C2 ;;st-mem-2 + DEFB $02 ;;DELETE + DEFB $C1 ;;st-mem-1 + DEFB $E5 ;;get-mem-5 + DEFB $04 ;;MULTIPLY + DEFB $E0 ;;get-mem-0 + DEFB $E2 ;;get-mem-2 + DEFB $04 ;;MULTIPLY + DEFB $0F ;;ADDITION + DEFB $E1 ;;get-mem-1 + DEFB $01 ;;EXCHANGE + DEFB $C1 ;;st-mem-1 + DEFB $02 ;;DELETE + DEFB $E0 ;;get-mem-0 + DEFB $04 ;;MULTIPLY + DEFB $E2 ;;get-mem-2 + DEFB $E5 ;;get-mem-5 + DEFB $04 ;;MULTIPLY + DEFB $03 ;;SUBTRACT + DEFB $C2 ;;st-mem-2 + DEFB $2A ;;ABS + DEFB $E1 ;;get-mem-1 + DEFB $2A ;;ABS + DEFB $0F ;;ADDITION + DEFB $02 ;;DELETE + DEFB $38 ;;END_CALC + + LD A,(DE) + CP $81 + POP BC + JP C,LINE_DRAW ; to LINE_DRAW + + PUSH BC + RST 28H ;; FP_CALC + DEFB $01 ;;EXCHANGE + DEFB $38 ;;END_CALC + + LD A,(COORDS) ; COORDS-x + CALL STACK_A ; routine STACK_A + RST 28H ;; FP_CALC + DEFB $C0 ;;st-mem-0 + DEFB $0F ;;ADDITION + DEFB $01 ;;EXCHANGE + DEFB $38 ;;END_CALC + + LD A,(COORDS_Y) ; COORDS_Y + CALL STACK_A ; routine STACK_A + RST 28H ;; FP_CALC + DEFB $C5 ;;st-mem-5 + DEFB $0F ;;ADDITION + DEFB $E0 ;;get-mem-0 + DEFB $E5 ;;get-mem-5 + DEFB $38 ;;END_CALC + + POP BC + + ;;;$2420 +DRW_STEPS: DEC B + JR Z,ARC_END ; to ARC_END + + JR ARC_START ; to ARC_START + + ;;;$2425 +ARC_LOOP: RST 28H ;; FP_CALC + DEFB $E1 ;;get-mem-1 + DEFB $31 ;;DUPLICATE + DEFB $E3 ;;get-mem-3 + DEFB $04 ;;MULTIPLY + DEFB $E2 ;;get-mem-2 + DEFB $E4 ;;get-mem-4 + DEFB $04 ;;MULTIPLY + DEFB $03 ;;SUBTRACT + DEFB $C1 ;;st-mem-1 + DEFB $02 ;;DELETE + DEFB $E4 ;;get-mem-4 + DEFB $04 ;;MULTIPLY + DEFB $E2 ;;get-mem-2 + DEFB $E3 ;;get-mem-3 + DEFB $04 ;;MULTIPLY + DEFB $0F ;;ADDITION + DEFB $C2 ;;st-mem-2 + DEFB $02 ;;DELETE + DEFB $38 ;;END_CALC + + ;;;$2439 +ARC_START: PUSH BC + RST 28H ;; FP_CALC + DEFB $C0 ;;st-mem-0 + DEFB $02 ;;DELETE + DEFB $E1 ;;get-mem-1 + DEFB $0F ;;ADDITION + DEFB $31 ;;DUPLICATE + DEFB $38 ;;END_CALC + + LD A,(COORDS) ; COORDS-x + CALL STACK_A ; routine STACK_A + RST 28H ;; FP_CALC + DEFB $03 ;;SUBTRACT + DEFB $E0 ;;get-mem-0 + DEFB $E2 ;;get-mem-2 + DEFB $0F ;;ADDITION + DEFB $C0 ;;st-mem-0 + DEFB $01 ;;EXCHANGE + DEFB $E0 ;;get-mem-0 + DEFB $38 ;;END_CALC + + LD A,(COORDS_Y) ; COORDS_Y + CALL STACK_A ; routine STACK_A + RST 28H ;; FP_CALC + DEFB $03 ;;SUBTRACT + DEFB $38 ;;END_CALC + + CALL DRAW_LINE ; routine DRAW_LINE + POP BC + DJNZ ARC_LOOP ; to ARC_LOOP + + ;;;$245F +ARC_END: RST 28H ;; FP_CALC + DEFB $02 ;;DELETE + DEFB $02 ;;DELETE + DEFB $01 ;;EXCHANGE + DEFB $38 ;;END_CALC + + LD A,(COORDS) ; COORDS-x + CALL STACK_A ; routine STACK_A + RST 28H ;; FP_CALC + DEFB $03 ;;SUBTRACT + DEFB $01 ;;EXCHANGE + DEFB $38 ;;END_CALC + + LD A,(COORDS_Y) ; COORDS_Y + CALL STACK_A ; routine STACK_A + RST 28H ;; FP_CALC + DEFB $03 ;;SUBTRACT + DEFB $38 ;;END_CALC + + ;;;$2477 +LINE_DRAW: CALL DRAW_LINE ; routine DRAW_LINE + JP TEMPS ; to TEMPS + +;------------------- +; Initial parameters +;------------------- + + ;;;$247D +CD_PRMS1: RST 28H ;; FP_CALC + DEFB $31 ;;DUPLICATE + DEFB $28 ;;SQR + DEFB $34 ;;STK_DATA + DEFB $32 ;;Exponent: $82, Bytes: 1 + DEFB $00 ;;(+00,+00,+00) + DEFB $01 ;;EXCHANGE + DEFB $05 ;;DIVISION + DEFB $E5 ;;get-mem-5 + DEFB $01 ;;EXCHANGE + DEFB $05 ;;DIVISION + DEFB $2A ;;ABS + DEFB $38 ;;END_CALC + + CALL FP_TO_A ; routine FP_TO_A + JR C,USE_252 ; to USE_252 + + AND $FC + ADD A,$04 + JR NC,DRAW_SAVE ; to DRAW_SAVE + + ;;;$2495 +USE_252: LD A,$FC + + ;;;$2497 +DRAW_SAVE: PUSH AF + CALL STACK_A ; routine STACK_A + RST 28H ;; FP_CALC + DEFB $E5 ;;get-mem-5 + DEFB $01 ;;EXCHANGE + DEFB $05 ;;DIVISION + DEFB $31 ;;DUPLICATE + DEFB $1F ;;SIN_ + DEFB $C4 ;;st-mem-4 + DEFB $02 ;;DELETE + DEFB $31 ;;DUPLICATE + DEFB $A2 ;;STK_HALF + DEFB $04 ;;MULTIPLY + DEFB $1F ;;SIN_ + DEFB $C1 ;;st-mem-1 + DEFB $01 ;;EXCHANGE + DEFB $C0 ;;st-mem-0 + DEFB $02 ;;DELETE + DEFB $31 ;;DUPLICATE + DEFB $04 ;;MULTIPLY + DEFB $31 ;;DUPLICATE + DEFB $0F ;;ADDITION + DEFB $A1 ;;STK_ONE + DEFB $03 ;;SUBTRACT + DEFB $1B ;;NEGATE + DEFB $C3 ;;st-mem-3 + DEFB $02 ;;DELETE + DEFB $38 ;;END_CALC + + POP BC + RET + +;------------- +; Line drawing +;------------- + + ;;;$24B7 +DRAW_LINE: CALL STK_TO_BC ; routine STK_TO_BC + LD A,C + CP B + JR NC,DL_X_GE_Y ; to DL_X_GE_Y + + LD L,C + PUSH DE + XOR A + LD E,A + JR DL_LARGER ; to DL_LARGER + + ;;;$24C4 +DL_X_GE_Y: OR C + RET Z + + LD L,B + LD B,C + PUSH DE + LD D,$00 + + ;;;$24CB +DL_LARGER: LD H,B + LD A,B + RRA + + ;;;$24CE +D_L_LOOP: ADD A,L ; + JR C,D_L_DIAG ; to D_L_DIAG + + CP H ; + JR C,D_L_HR_VT ; to D_L_HR_VT + + ;;;$24D4 +D_L_DIAG: SUB H + LD C,A + EXX + POP BC + PUSH BC + JR D_L_STEP ; to D_L_STEP + + ;;;$24DB +D_L_HR_VT: LD C,A + PUSH DE + EXX + POP BC + + ;;;$24DF +D_L_STEP: LD HL,(COORDS) + LD A,B + ADD A,H + LD B,A + LD A,C + INC A + ADD A,L + JR C,D_L_RANGE ; to D_L_RANGE + + JR Z,REPORT_BC ; to REPORT_BC + + ;;;$24EC +D_L_PLOT: DEC A + LD C,A + CALL PLOT_SUB ; routine PLOT_SUB + EXX + LD A,C + DJNZ D_L_LOOP ; to D_L_LOOP + POP DE + RET + + ;;;$24F7 +D_L_RANGE: JR Z,D_L_PLOT ; to D_L_PLOT + + ;;;$24F9 +REPORT_BC: RST 08H ; ERROR_1 + DEFB $0A ; Error Report: Integer out of range + +;*********************************** +;** Part 8. EXPRESSION EVALUATION ** +;*********************************** +; +; It is a this stage of the ROM that the Spectrum ceases altogether to be +; just a colourful novelty. One remarkable feature is that in all previous +; commands when the Spectrum is expecting a number or a string then an +; expression of the same type can be substituted ad infinitum. +; This is the routine that evaluates that expression. +; This is what causes 2 + 2 to give the answer 4. +; That is quite easy to understand. However you don't have to make it much +; more complex to start a remarkable juggling act. +; e.g. PRINT 2 * (VAL "2+2" + TAN 3) +; In fact, provided there is enough free RAM, the Spectrum can evaluate +; an expression of unlimited complexity. +; Apart from a couple of minor glitches, which you can now correct, the +; system is remarkably robust. + +;---------------------------------- +; Scan expression or sub-expression +;---------------------------------- + + ;;;$24FB +SCANNING: RST 18H ; GET_CHAR + LD B,$00 ; priority marker zero is pushed on stack + ; to signify end of expression when it is popped off again. + PUSH BC ; put in on stack. + ; and proceed to consider the first character + ; of the expression. + + ;;;$24FF +S_LOOP_1: LD C,A ; store the character while a look up is done. + LD HL,SCAN_FUNC ; Address: SCAN_FUNC + CALL INDEXER ; routine INDEXER is called to see if it is + ; part of a limited range '+', '(', 'ATTR' etc. + LD A,C ; fetch the character back + JP NC,S_ALPHNUM ; jump forward to S_ALPHNUM if not in primary + ; operators and functions to consider in the + ; first instance a digit or a variable and + ; then anything else. >>> + LD B,$00 ; but here if it was found in table so + LD C,(HL) ; fetch offset from table and make B zero. + ADD HL,BC ; add the offset to position found + JP (HL) ; and jump to the routine e.g. S_BIN + ; making an indirect exit from there. + +;-------------------------------------------------------------------------- +; The four service subroutines for routines in the scannings function table +;-------------------------------------------------------------------------- +; PRINT """Hooray!"" he cried." + + ;;;$250F +S_QUOTE_S: CALL CH_ADD_1 ; routine CH_ADD_1 points to next character + ; and fetches that character. + INC BC ; increase length counter. + CP $0D ; is it carriage return ? + ; inside a quote. + JP Z,REPORT_C ; jump back to REPORT_C if so. + ; 'Nonsense in basic'. + CP $22 ; is it a quote '"' ? + JR NZ,S_QUOTE_S ; back to S_QUOTE_S if not for more. + + CALL CH_ADD_1 ; routine CH_ADD_1 + CP $22 ; compare with possible adjacent quote + RET ; return. with zero set if two together. + + ; This subroutine is used to get two coordinate expressions for the three + ; functions SCREEN$, ATTR and POINT that have two fixed parameters and + ; therefore require surrounding braces. + + ;;;$2522 +S_2_COORD: RST 20H ; NEXT_CHAR + CP $28 ; is it the opening '(' ? + JR NZ,S_RPORT_C ; forward to S_RPORT_C if not + ; 'Nonsense in Basic'. + CALL NEXT_2NUM ; routine NEXT_2NUM gets two comma-separated + ; numeric expressions. Note. this could cause + ; many more recursive calls to SCANNING but + ; the parent function will be evaluated fully + ; before rejoining the main juggling act. + RST 18H ; GET_CHAR + CP $29 ; is it the closing ')' ? + + ;; S_RPORT_C +S_RPORT_C: JP NZ,REPORT_C ; jump back to REPORT_C if not. + ; 'Nonsense in Basic'. + +;------------- +; Check syntax +;------------- +; This routine is called on a number of occasions to check if syntax is being +; checked or if the program is being run. To test the flag inline would use +; four bytes of code, but a call instruction only uses 3 bytes of code. + + ;;;$2530 +SYNTAX_Z: BIT 7,(IY+$01) ; test FLAGS - checking syntax only ? + RET ; return. + +;----------------- +; Scanning SCREEN$ +;----------------- +; This function returns the code of a bit-mapped character at screen +; position at line C, column B. It is unable to detect the mosaic characters +; which are not bit-mapped but detects the ascii 32 - 127 range. +; The bit-mapped UDGs are ignored which is curious as it requires only a +; few extra bytes of code. As usual, anything to do with CHARS is weird. +; If no match is found a null string is returned. +; No actual check on ranges is performed - that's up to the Basic programmer. +; No real harm can come from SCREEN$(255,255) although the Basic manual +; says that invalid values will be trapped. +; Interestingly, in the Pitman pocket guide, 1984, Vickers says that the +; range checking will be performed. + + ;;;$2535 +S_SCRN_S: CALL STK_TO_BC ; routine STK_TO_BC. + LD HL,(CHARS) ; fetch address of CHARS. + LD DE,$0100 ; fetch offset to CHR$ 32 + ADD HL,DE ; and find start of bitmaps. + ; Note. not inc h. ?? + LD A,C ; transfer line to A. + RRCA ; multiply + RRCA ; by + RRCA ; thirty-two. + AND $E0 ; and with 11100000 + XOR B ; combine with column $00 - $1F + LD E,A ; to give the low byte of top line + LD A,C ; column to A range 00000000 to 00011111 + AND $18 ; and with 00011000 + XOR $40 ; xor with 01000000 (high byte screen start) + LD D,A ; register DE now holds start address of cell. + LD B,$60 ; there are 96 characters in ascii set. + + ;;;$254F +S_SCRN_LP: PUSH BC ; save count + PUSH DE ; save screen start address + PUSH HL ; save bitmap start + LD A,(DE) ; first byte of screen to A + XOR (HL) ; xor with corresponding character byte + JR Z,S_SC_MTCH ; forward to S_SC_MTCH if they match + ; if inverse result would be $FF + ; if any other then mismatch + INC A ; set to $00 if inverse + JR NZ,S_SCR_NXT ; forward to S_SCR_NXT if a mismatch + + DEC A ; restore $FF + + ; a match has been found so seven more to test. + + ;;;$255A +S_SC_MTCH: LD C,A ; load C with inverse mask $00 or $FF + LD B,$07 ; count seven more bytes + + ;;;$255D +S_SC_ROWS: INC D ; increment screen address. + INC HL ; increment bitmap address. + LD A,(DE) ; byte to A + XOR (HL) ; will give $00 or $FF (inverse) + XOR C ; xor with inverse mask + JR NZ,S_SCR_NXT ; forward to S_SCR_NXT if no match. + + DJNZ S_SC_ROWS ; back to S_SC_ROWS until all eight matched. + + ; continue if a match of all eight bytes was found + + POP BC ; discard the + POP BC ; saved + POP BC ; pointers + LD A,$80 ; the endpoint of character set + SUB B ; subtract the counter + ; to give the code 32-127 + LD BC,$0001 ; make one space in workspace. + RST 30H ; BC_SPACES creates the space sliding + ; the calculator stack upwards. + LD (DE),A ; start is addressed by DE, so insert code + JR S_SCR_STO ; forward to S_SCR_STO + + ; the jump was here if no match and more bitmaps to test. + + ;;;$2573 +S_SCR_NXT: POP HL ; restore the last bitmap start + LD DE,$0008 ; and prepare to add 8. + ADD HL,DE ; now addresses next character bitmap. + POP DE ; restore screen address + POP BC ; and character counter in B + DJNZ S_SCRN_LP ; back to S_SCRN_LP if more characters. + LD C,B ; B is now zero, so BC now zero. + + ;;;$257D +S_SCR_STO: JP STK_STO_D ; to STK_STO_D to store the string in + ; workspace or a string with zero length. + ; (value of DE doesn't matter in last case) + + ; Note. this exit seems correct but the general-purpose routine S_STRING + ; that calls this one will also stack any of it's string results so this + ; leads to a double storing of the result in this case. + ; The instruction at S_SCR_STO should just be a RET. + ; credit Stephen Kelly and others, 1982. + +;-------------- +; Scanning ATTR +;-------------- +; This function subroutine returns the attributes of a screen location - +; a numeric result. +; Again it's up to the Basic programmer to supply valid values of line/column. + + ;;;$2580 +S_ATTR_S: CALL STK_TO_BC ; routine STK_TO_BC fetches line to C, and column to B. + LD A,C ; line to A $00 - $17 (max 00010111) + RRCA ; rotate + RRCA ; bits + RRCA ; left. + LD C,A ; store in C as an intermediate value. + AND $E0 ; pick up bits 11100000 ( was 00011100 ) + XOR B ; combine with column $00 - $1F + LD L,A ; low byte now correct. + LD A,C ; bring back intermediate result from C + AND $03 ; mask to give correct third of + ; screen $00 - $02 + XOR $58 ; combine with base address. + LD H,A ; high byte correct. + LD A,(HL) ; pick up the colour attribute. + JP STACK_A ; forward to STACK_A to store result + ; and make an indirect exit. + +;------------------------ +; Scanning function table +;------------------------ +; This table is used by INDEXER routine to find the offsets to +; four operators and eight functions. e.g. $A8 is the token 'FN'. +; This table is used in the first instance for the first character of an +; expression or by a recursive call to SCANNING for the first character of +; any sub-expression. It eliminates functions that have no argument or +; functions that can have more than one argument and therefore require +; braces. By eliminating and dealing with these now it can later take a +; simplistic approach to all other functions and assume that they have +; one argument. +; Similarly by eliminating BIN and '.' now it is later able to assume that +; all numbers begin with a digit and that the presence of a number or +; variable can be detected by a call to ALPHANUM. +; By default all expressions are positive and the spurious '+' is eliminated +; now as in print +2. This should not be confused with the operator '+'. +; Note. this does allow a degree of nonsense to be accepted as in +; PRINT +"3 is the greatest.". +; An acquired programming skill is the ability to include brackets where +; they are not necessary. +; A bracket at the start of a sub-expression may be spurious or necessary +; to denote that the contained expression is to be evaluated as an entity. +; In either case this is dealt with by recursive calls to SCANNING. +; An expression that begins with a quote requires special treatment. + + ;;;$2596 +SCAN_FUNC: DEFB $22, S_QUOTE-$-1 ; $1C offset to S_QUOTE + DEFB '(', S_BRACKET-$-1 ; $4F offset to S_BRACKET + DEFB '.', S_DECIMAL-$-1 ; $F2 offset to S_DECIMAL + DEFB '+', S_U_PLUS-$-1 ; $12 offset to S_U_PLUS + DEFB $A8, S_FN-$-1 ; $56 offset to S_FN + DEFB $A5, S_RND-$-1 ; $57 offset to S_RND + DEFB $A7, S_PI-$-1 ; $84 offset to S_PI + DEFB $A6, S_INKEY-$-1 ; $8F offset to S_INKEY + DEFB $C4, S_BIN-$-1 ; $E6 offset to S_BIN + DEFB $AA, S_SCREEN-$-1 ; $BF offset to S_SCREEN + DEFB $AB, S_ATTR-$-1 ; $C7 offset to S_ATTR + DEFB $A9, S_POINT-$-1 ; $CE offset to S_POINT + + DEFB $00 ; zero end marker + +;--------------------------- +; Scanning function routines +;--------------------------- +; These are the 11 subroutines accessed by the above table. +; S_BIN and S_DECIMAL are the same +; The 1-byte offset limits their location to within 255 bytes of their +; entry in the table. + + ; -> + ;;;$25AF +S_U_PLUS: RST 20H ; NEXT_CHAR just ignore + JP S_LOOP_1 ; to S_LOOP_1 + + ; -> + ;;;$25B3 +S_QUOTE: RST 18H ; GET_CHAR + INC HL ; address next character (first in quotes) + PUSH HL ; save start of quoted text. + LD BC,$0000 ; initialize length of string to zero. + CALL S_QUOTE_S ; routine S_QUOTE_S + JR NZ,S_Q_PRMS ; forward to S_Q_PRMS if + + ;;;$25BE +S_Q_AGAIN: CALL S_QUOTE_S ; routine S_QUOTE_S copies string until a + ; quote is encountered + JR Z,S_Q_AGAIN ; back to S_Q_AGAIN if two quotes WERE + ; together. + + ; but if just an isolated quote then that terminates the string. + + CALL SYNTAX_Z ; routine SYNTAX_Z + JR Z,S_Q_PRMS ; forward to S_Q_PRMS if checking syntax. + + + RST 30H ; BC_SPACES creates the space for true + ; copy of string in workspace. + POP HL ; re-fetch start of quoted text. + PUSH DE ; save start in workspace. + + ;;;$25CB +S_Q_COPY: LD A,(HL) ; fetch a character from source. + INC HL ; advance source address. + LD (DE),A ; place in destination. + INC DE ; advance destination address. + CP $22 ; was it a '"' just copied ? + JR NZ,S_Q_COPY ; back to S_Q_COPY to copy more if not + + LD A,(HL) ; fetch adjacent character from source. + INC HL ; advance source address. + CP $22 ; is this '"' ? - i.e. two quotes together ? + JR Z,S_Q_COPY ; to S_Q_COPY if so including just one of the + ; pair of quotes. + + ; proceed when terminating quote encountered. + + ;;;$25D9 +S_Q_PRMS: DEC BC ; decrease count by 1. + POP DE ; restore start of string in workspace. + + ;;;$25DB +S_STRING: LD HL,FLAGS ; Address FLAGS system variable. + RES 6,(HL) ; signal string result. + BIT 7,(HL) ; is syntax being checked. + CALL NZ,STK_STO_D ; routine STK_STO_D is called in runtime. + JP S_CONT_2 ; jump forward to S_CONT_2 ===> + + ; -> + ;;;$25E8 +S_BRACKET: RST 20H ; NEXT_CHAR + CALL SCANNING ; routine SCANNING is called recursively. + CP $29 ; is it the closing ')' ? + JP NZ,REPORT_C ; jump back to REPORT_C if not + ; 'Nonsense in basic' + + RST 20H ; NEXT_CHAR + JP S_CONT_2 ; jump forward to S_CONT_2 ===> + ; -> + ;;$25F5 +S_FN: JP S_FN_SBRN ; jump forward to S_FN_SBRN. + + ; -> + ;;;$25F8 +S_RND: CALL SYNTAX_Z ; routine SYNTAX_Z + JR Z,S_RND_END ; forward to S_RND_END if checking syntax. + + LD BC,(SEED) ; fetch system variable SEED + CALL STACK_BC ; routine STACK_BC places on calculator stack + RST 28H ;; FP_CALC ;s. + DEFB $A1 ;;STK_ONE ;s,1. + DEFB $0F ;;ADDITION ;s+1. + DEFB $34 ;;STK_DATA ; + DEFB $37 ;;Exponent: $87, + ;;Bytes: 1 + DEFB $16 ;;(+00,+00,+00) ;s+1,75. + DEFB $04 ;;MULTIPLY ;(s+1)*75 = v + DEFB $34 ;;STK_DATA ;v. + DEFB $80 ;;Bytes: 3 + DEFB $41 ;;Exponent $91 + DEFB $00,$00,$80 ;;(+00) ;v,65537. + DEFB $32 ;;N_MOD_M ;remainder,result. + DEFB $02 ;;DELETE ;remainder. + DEFB $A1 ;;STK_ONE ;remainder,1. + DEFB $03 ;;SUBTRACT ;remainder - 1. = rnd + DEFB $31 ;;DUPLICATE ;rnd,rnd. + DEFB $38 ;;END_CALC + + CALL FP_TO_BC ; routine FP_TO_BC + LD (SEED),BC ; store in SEED for next starting point. + LD A,(HL) ; fetch exponent + AND A ; is it zero ? + JR Z,S_RND_END ; forward if so to S_RND_END + + SUB $10 ; reduce exponent by 2^16 + LD (HL),A ; place back + + ;;;$2625 +S_RND_END: JR S_PI_END ; forward to S_PI_END + + ; the number PI 3.14159... + + ; -> + ;;;$2627 +S_PI: CALL SYNTAX_Z ; routine SYNTAX_Z + JR Z,S_PI_END ; to S_PI_END if checking syntax. + + RST 28H ;; FP_CALC + DEFB $A3 ;;STK_PI_2 pi/2. + DEFB $38 ;;END_CALC + + INC (HL) ; increment the exponent leaving pi + ; on the calculator stack. + + ;;;$2630 +S_PI_END: RST 20H ; NEXT_CHAR + JP S_NUMERIC ; jump forward to S_NUMERIC + + ; -> + ;;;$2634 +S_INKEY: LD BC,$105A ; priority $10, operation code $1A ('READ_IN') + ; +$40 for string result, numeric operand. + ; set this up now in case we need to use the calculator. + RST 20H ; NEXT_CHAR + CP $23 ; '#' ? + JP Z,S_PUSH_PO ; to S_PUSH_PO if so to use the calculator + ; single operation + ; to read from network/RS232 etc. . + + ; else read a key from the keyboard. + + LD HL,FLAGS ; fetch FLAGS + RES 6,(HL) ; signal string result. + BIT 7,(HL) ; checking syntax ? + JR Z,S_INK_EN ; forward to S_INK_EN if so + + CALL KEY_SCAN ; routine KEY_SCAN key in E, shift in D. + LD C,$00 ; the length of an empty string + JR NZ,S_IK_STK ; to S_IK_STK to store empty string if no key returned. + + CALL K_TEST ; routine K_TEST get main code in A + JR NC,S_IK_STK ; to S_IK_STK to stack null string if invalid + + DEC D ; D is expected to be FLAGS so set bit 3 $FF + ; 'L' Mode so no keywords. + LD E,A ; main key to A + ; C is MODE 0 'KLC' from above still. + CALL K_DECODE ; routine K_DECODE + PUSH AF ; save the code + LD BC,$0001 ; make room for one character + RST 30H ; BC_SPACES + POP AF ; bring the code back + LD (DE),A ; put the key in workspace + LD C,$01 ; set C length to one + + ;;;$2660 +S_IK_STK: LD B,$00 ; set high byte of length to zero + CALL STK_STO_D ; routine STK_STO_D + + ;;;$2665 +S_INK_EN: JP S_CONT_2 ; to S_CONT_2 ===> + + ; -> + ;;;$2668 +S_SCREEN: CALL S_2_COORD ; routine S_2_COORD + CALL NZ,S_SCRN_S ; routine S_SCRN_S + RST 20H ; NEXT_CHAR + JP S_STRING ; forward to S_STRING to stack result + + ; -> + ;;;$2672 +S_ATTR: CALL S_2_COORD ; routine S_2_COORD + CALL NZ,S_ATTR_S ; routine S_ATTR_S + RST 20H ; NEXT_CHAR + JR S_NUMERIC ; forward to S_NUMERIC + + ; -> + ;;;$267B +S_POINT: CALL S_2_COORD ; routine S_2_COORD + CALL NZ,POINT_SUB ; routine POINT_SUB + RST 20H ; NEXT_CHAR + JR S_NUMERIC ; forward to S_NUMERIC + + ; ==> The branch was here if not in table. + + ;;;$2684 +S_ALPHNUM: CALL ALPHANUM ; routine ALPHANUM checks if variable or + ; a digit. + JR NC,S_NEGATE ; forward to S_NEGATE if not to consider + ; a '-' character then functions. + CP $41 ; compare 'A' + JR NC,S_LETTER ; forward to S_LETTER if alpha -> + ; else must have been numeric so continue + ; into that routine. + + ; This important routine is called during runtime and from LINE_SCAN + ; when a BASIC line is checked for syntax. It is this routine that + ; inserts, during syntax checking, the invisible floating point numbers + ; after the numeric expression. During runtime it just picks these + ; numbers up. It also handles BIN format numbers. + + ; -> + ;;;$268D +S_DECIMAL: +S_BIN: CALL SYNTAX_Z ; routine SYNTAX_Z + JR NZ,S_STK_DEC ; to S_STK_DEC in runtime + + ; this route is taken when checking syntax. + + CALL DEC_TO_FP ; routine DEC_TO_FP to evaluate number + RST 18H ; GET_CHAR to fetch HL + LD BC,$0006 ; six locations required + CALL MAKE_ROOM ; routine MAKE_ROOM + INC HL ; to first new location + LD (HL),$0E ; insert number marker + INC HL ; address next + EX DE,HL ; make DE destination. + LD HL,(STKEND) ; STKEND points to end of stack. + LD C,$05 ; result is five locations lower + AND A ; prepare for true subtraction + SBC HL,BC ; point to start of value. + LD (STKEND),HL ; update STKEND as we are taking number. + LDIR ; Copy five bytes to program location + EX DE,HL ; transfer pointer to HL + DEC HL ; adjust + CALL TEMP_PTR1 ; routine TEMP_PTR1 sets CH-ADD + JR S_NUMERIC ; to S_NUMERIC to record nature of result + + ; branch here in runtime. + + ;;;$26B5 +S_STK_DEC: RST 18H ; GET_CHAR positions HL at digit. + + ;;;$26B6 +S_SD_SKIP: INC HL ; advance pointer + LD A,(HL) ; until we find + CP $0E ; chr 14d - the number indicator + JR NZ,S_SD_SKIP ; to S_SD_SKIP until a match it has to be here. + + INC HL ; point to first byte of number + CALL STACK_NUM ; routine STACK_NUM stacks it + LD (CH_ADD),HL ; update system variable CH_ADD + + ;;;$26C3 +S_NUMERIC: SET 6,(IY+$01) ; update FLAGS - Signal numeric result + JR S_CONT_1 ; forward to S_CONT_1 ===> + ; actually S_CONT_2 is destination but why + ; waste a byte on a jump when a JR will do. + ; actually a JR S_CONT_2 can be used. Rats. + + ; end of functions accessed from scanning functions table. + +;--------------------------- +; Scanning variable routines +;--------------------------- + + ;;;$26C9 +S_LETTER: CALL LOOK_VARS ; routine LOOK_VARS + JP C,REPORT_2 ; jump back to REPORT_2 if not found + ; 'Variable not found' + ; but a variable is always 'found' if syntax + ; is being checked. + + CALL Z,STK_VAR ; routine STK_VAR considers a subscript/slice + LD A,(FLAGS) ; fetch FLAGS value + CP $C0 ; compare 11000000 + JR C,S_CONT_1 ; step forward to S_CONT_1 if string ===> + + INC HL ; advance pointer + CALL STACK_NUM ; routine STACK_NUM + + ;;;$26DD +S_CONT_1: JR S_CONT_2 ; forward to S_CONT_2 ===> + + ;----------------------------------------- + ; -> the scanning branch was here if not alphanumeric. + ; All the remaining functions will be evaluated by a single call to the + ; calculator. The correct priority for the operation has to be placed in + ; the B register and the operation code, calculator literal in the C register. + ; the operation code has bit 7 set if result is numeric and bit 6 is + ; set if operand is numeric. so + ; $C0 = numeric result, numeric operand. e.g. 'SIN' + ; $80 = numeric result, string operand. e.g. 'CODE' + ; $40 = string result, numeric operand. e.g. 'STR$' + ; $00 = string result, string operand. e.g. 'VAL$' + + ;;;$26DF +S_NEGATE: LD BC,$09DB ; prepare priority 09, operation code $C0 + + ; 'NEGATE' ($1B) - bits 6 and 7 set for numeric + ; result and numeric operand. + + CP $2D ; is it '-' ? + JR Z,S_PUSH_PO ; forward if so to S_PUSH_PO + + LD BC,$1018 ; prepare priority $10, operation code 'VAL$' - + ; bits 6 and 7 reset for string result and string operand. + CP $AE ; is it 'VAL$' ? + JR Z,S_PUSH_PO ; forward if so to S_PUSH_PO + + SUB $AF ; subtract token 'CODE' value to reduce + ; functions 'CODE' to 'NOT' although the + ; upper range is, as yet, unchecked. + ; valid range would be $00 - $14. + JP C,REPORT_C ; jump back to REPORT_C with anything else + ; 'Nonsense in Basic' + LD BC,$04F0 ; prepare priority $04, operation $C0 + + ; 'not' ($30) + CP $14 ; is it 'NOT' + JR Z,S_PUSH_PO ; forward to S_PUSH_PO if so + + JP NC,REPORT_C ; to REPORT_C if higher + ; 'Nonsense in Basic' + LD B,$10 ; priority $10 for all the rest + ADD A,$DC ; make range $DC - $EF + ; $C0 + 'CODE'($1C) thru 'CHR$' ($2F) + LD C,A ; transfer 'function' to C + CP $DF ; is it 'SIN' ? + JR NC,S_NO_TO ; forward to S_NO_TO with 'SIN' through + ; 'CHR$' as operand is numeric. + + ; all the rest 'COS' through 'CHR$' give a numeric result except 'STR$' + ; and 'CHR$'. + + RES 6,C ; signal string operand for 'CODE', 'VAL' and + ; 'LEN'. + + ;;;$2707 +S_NO_TO: CP $EE ; compare 'STR$' + JR C,S_PUSH_PO ; forward to S_PUSH_PO if lower as result + ; is numeric. + RES 7,C ; reset bit 7 of op code for 'STR$', 'CHR$' + ; as result is string. + + ; >> This is where they were all headed for. + + ;;;$270D +S_PUSH_PO: PUSH BC ; push the priority and calculator operation code. + RST 20H ; NEXT_CHAR + JP S_LOOP_1 ; jump back to S_LOOP_1 to go round the loop + ; again with the next character. + + ; ===> there were many branches forward to here + + ;;;$2712 +S_CONT_2: RST 18H ; GET_CHAR + + ;;;$2713 +S_CONT_3: CP $28 ; is it '(' ? + JR NZ,S_OPERTR ; forward to S_OPERTR if not > + + BIT 6,(IY+$01) ; test FLAGS - numeric or string result ? + JR NZ,S_LOOP ; forward to S_LOOP if numeric to evaluate > + + ; if a string preceded '(' then slice it. + + CALL SLICING ; routine SLICING + RST 20H ; NEXT_CHAR + JR S_CONT_3 ; back to S_CONT_3 + + + ; the branch was here when possibility of an operator '(' has been excluded. + + ;;;$2723 +S_OPERTR: LD B,$00 ; prepare to add + LD C,A ; possible operator to C + LD HL,TBL_OF_OPS ; Address: TBL_OF_OPS + CALL INDEXER ; routine INDEXER + JR NC,S_LOOP ; forward to S_LOOP if not in table + + ; but if found in table the priority has to be looked up. + + LD C,(HL) ; operation code to C ( B is still zero ) + LD HL,TBL_PRIORS-$C3 ; $26ED is base of table + ADD HL,BC ; index into table. + LD B,(HL) ; priority to B. + +;------------------- +; Scanning main loop +;------------------- +; the juggling act + + ;;;$2734 +S_LOOP: POP DE ; fetch last priority and operation + LD A,D ; priority to A + CP B ; compare with this one + JR C,S_TIGHTER ; forward to S_TIGHTER to execute the + ; last operation before this one as it has + ; higher priority. + + ; the last priority was greater or equal this one. + + AND A ; if it is zero then so is this + JP Z,GET_CHAR ; jump to exit via GET_CHAR pointing at + ; next character. + ; This may be the character after the + ; expression or, if exiting a recursive call, + ; the next part of the expression to be + ; evaluated. + PUSH BC ; save current priority/operation + ; as it has lower precedence than the one + ; now in DE. + + ; the 'USR' function is special in that it is overloaded to give two types + ; of result. + + LD HL,FLAGS ; address FLAGS + LD A,E ; new operation to A register + CP $ED ; is it $C0 + 'USR_NO' ($2D) ? + JR NZ,S_STK_LST ; forward to S_STK_LST if not + + BIT 6,(HL) ; string result expected ? + ; (from the lower priority operand we've + ; just pushed on stack ) + JR NZ,S_STK_LST ; forward to S_STK_LST if numeric + ; as operand bits match. + LD E,$99 ; reset bit 6 and substitute $19 'USR-$' + ; for string operand. + + ;;;$274C +S_STK_LST: PUSH DE ; now stack this priority/operation + CALL SYNTAX_Z ; routine SYNTAX_Z + JR Z,S_SYNTEST ; forward to S_SYNTEST if checking syntax. + + LD A,E ; fetch the operation code + AND $3F ; mask off the result/operand bits to leave a calculator literal. + LD B,A ; transfer to B register + + ; now use the calculator to perform the single operation - operand is on + ; the calculator stack. + ; Note. although the calculator is performing a single operation most + ; functions e.g. TAN are written using other functions and literals and + ; these in turn are written using further strings of calculator literals so + ; another level of magical recursion joins the juggling act for a while + ; as the calculator too is calling itself. + + RST 28H ;; FP_CALC + DEFB $3B ;;FP_CALC_2 + + ;;;$2758 + DEFB $38 ;;END_CALC + + JR S_RUNTEST ; forward to S_RUNTEST + + ; the branch was here if checking syntax only. + + ;;;$275B +S_SYNTEST: LD A,E ; fetch the operation code to accumulator + XOR (IY+$01) ; compare with bits of FLAGS + AND $40 ; bit 6 will be zero now if operand + ; matched expected result. + + ;;;$2761 +S_RPORT_C2: JP NZ,REPORT_C ; to REPORT_C if mismatch + ; 'Nonsense in Basic' + ; else continue to set flags for next + + ; the branch is to here in runtime after a successful operation. + + ;;;$2764 +S_RUNTEST: POP DE ; fetch the last operation from stack + LD HL,FLAGS ; address FLAGS + SET 6,(HL) ; set default to numeric result in FLAGS + BIT 7,E ; test the operational result + JR NZ,S_LOOPEND ; forward to S_LOOPEND if numeric + + RES 6,(HL) ; reset bit 6 of FLAGS to show string result. + + ;;;$2770 +S_LOOPEND: POP BC ; fetch the previous priority/operation + JR S_LOOP ; back to S_LOOP to perform these + + ; the branch was here when a stacked priority/operator had higher priority + ; than the current one. + + ;;;$2773 +S_TIGHTER: PUSH DE ; save high priority op on stack again + LD A,C ; fetch lower priority operation code + BIT 6,(IY+$01) ; test FLAGS - Numeric or string result ? + JR NZ,S_NEXT ; forward to S_NEXT if numeric result + + ; if this is lower priority yet has string then must be a comparison. + ; Since these can only be evaluated in context and were defaulted to + ; numeric in operator look up they must be changed to string equivalents. + + AND $3F ; mask to give true calculator literal + ADD A,$08 ; augment numeric literals to string + ; equivalents. + ; 'NO_AND_NO' => 'STR_AND_NO' + ; 'NO_L_EQL' => 'STR_L_EQL' + ; 'NO_GR_EQL' => 'STR_GR_EQL' + ; 'NOS_NEQL' => 'STRS_NEQL' + ; 'NO_GRTR' => 'STR_GRTR' + ; 'NO_LESS' => 'STR_LESS' + ; 'NOS_EQL' => 'STRS_EQL' + ; 'ADDITION' => 'STRS_ADD' + LD C,A ; put modified comparison operator back + CP $10 ; is it now 'STR_AND_NO' ? + JR NZ,S_NOT_AND ; forward to S_NOT_AND if not. + + SET 6,C ; set numeric operand bit + JR S_NEXT ; forward to S_NEXT + + ;;;$2788 +S_NOT_AND: JR C,S_RPORT_C2 ; back to S_RPORT_C2 if less + ; 'Nonsense in basic'. + ; e.g. a$ * b$ + CP $17 ; is it 'STRS_ADD' ? + JR Z,S_NEXT ; forward to to S_NEXT if so + ; (bit 6 and 7 are reset) + SET 7,C ; set numeric (Boolean) result for all others + + ;;;$2790 +S_NEXT: PUSH BC ; now save this priority/operation on stack + RST 20H ; NEXT_CHAR + JP S_LOOP_1 ; jump back to S_LOOP_1 + +;------------------- +; Table of operators +;------------------- +; This table is used to look up the calculator literals associated with +; the operator character. The thirteen calculator operations $03 - $0F +; have bits 6 and 7 set to signify a numeric result. +; Some of these codes and bits may be altered later if the context suggests +; a string comparison or operation. +; that is '+', '=', '>', '<', '<=', '>=' or '<>'. + + ;;;$2795 +TBL_OF_OPS: DEFB '+', $CF ; $C0 + 'ADDITION' + DEFB '-', $C3 ; $C0 + 'SUBTRACT' + DEFB '*', $C4 ; $C0 + 'MULTIPLY' + DEFB '/', $C5 ; $C0 + 'DIVISION' + DEFB '^', $C6 ; $C0 + 'TO_POWER' + DEFB '=', $CE ; $C0 + 'NOS_EQL' + DEFB '>', $CC ; $C0 + 'NO_GRTR' + DEFB '<', $CD ; $C0 + 'NO_LESS' + DEFB $C7, $C9 ; '<=' $C0 + 'NO_L_EQL' + DEFB $C8, $CA ; '>=' $C0 + 'NO_GR_EQL' + DEFB $C9, $CB ; '<>' $C0 + 'NOS_NEQL' + DEFB $C5, $C7 ; 'OR' $C0 + 'OR' + DEFB $C6, $C8 ; 'AND' $C0 + 'NO_AND_NO' + + DEFB $00 ; zero end-marker. + + +;-------------------- +; Table of priorities +;-------------------- +; This table is indexed with the operation code obtained from the above +; table $C3 - $CF to obtain the priority for the respective operation. + + ;;;$27B0 +TBL_PRIORS: DEFB $06 ; '-' opcode $C3 + DEFB $08 ; '*' opcode $C4 + DEFB $08 ; '/' opcode $C5 + DEFB $0A ; '^' opcode $C6 + DEFB $02 ; 'OR' opcode $C7 + DEFB $03 ; 'AND' opcode $C8 + DEFB $05 ; '<=' opcode $C9 + DEFB $05 ; '>=' opcode $CA + DEFB $05 ; '<>' opcode $CB + DEFB $05 ; '>' opcode $CC + DEFB $05 ; '<' opcode $CD + DEFB $05 ; '=' opcode $CE + DEFB $06 ; '+' opcode $CF + +;----------------------- +; Scanning function (FN) +;----------------------- +; This routine deals with user-defined functions. +; The definition can be anywhere in the program area but these are best +; placed near the start of the program as we shall see. +; The evaluation process is quite complex as the Spectrum has to parse two +; statements at the same time. Syntax of both has been checked previously +; and hidden locations have been created immediately after each argument +; of the DEF FN statement. Each of the arguments of the FN function is +; evaluated by SCANNING and placed in the hidden locations. Then the +; expression to the right of the DEF FN '=' is evaluated by SCANNING and for +; any variables encountered, a search is made in the DEF FN variable list +; in the program area before searching in the normal variables area. +; +; Recursion is not allowed: i.e. the definition of a function should not use +; the same function, either directly or indirectly ( through another function). +; You'll normally get error 4, ('Out of memory'), although sometimes the sytem +; will crash. - Vickers, Pitman 1984. +; +; As the definition is just an expression, there would seem to be no means +; of breaking out of such recursion. +; However, by the clever use of string expressions and VAL, such recursion is +; possible. +; e.g. DEF FN a(n) = VAL "n+FN a(n-1)+0" ((n<1) * 10 + 1 TO ) +; will evaluate the full 11-character expression for all values where n is +; greater than zero but just the 11th character, "0", when n drops to zero +; thereby ending the recursion producing the correct result. +; Recursive string functions are possible using VAL$ instead of VAL and the +; null string as the final addend. +; - from a turn of the century newsgroup discussion initiated by Mike Wynne. + + ;;;$27BD +S_FN_SBRN: CALL SYNTAX_Z ; routine SYNTAX_Z + JR NZ,SF_RUN ; forward to SF_RUN in runtime + + RST 20H ; NEXT_CHAR + CALL ALPHA ; routine ALPHA check for letters A-Z a-z + JP NC,REPORT_C ; jump back to REPORT_C if not + ; 'Nonsense in Basic' + RST 20H ; NEXT_CHAR + CP $24 ; is it '$' ? + PUSH AF ; save character and flags + JR NZ,SF_BRKT_1 ; forward to SF_BRKT_1 with numeric function + + RST 20H ; NEXT_CHAR + + ;;;$27D0 +SF_BRKT_1: CP $28 ; is '(' ? + JR NZ,SF_RPRT_C ; forward to SF_RPRT_C if not + ; 'Nonsense in Basic' + RST 20H ; NEXT_CHAR + CP $29 ; is it ')' ? + JR Z,SF_FLAG_6 ; forward to SF_FLAG_6 if no arguments. + + ;;;$27D9 +SF_ARGMTS: CALL SCANNING ; routine SCANNING checks each argument + ; which may be an expression. + RST 18H ; GET_CHAR + CP $2C ; is it a ',' ? + JR NZ,SF_BRKT_2 ; forward if not to SF_BRKT_2 to test bracket + + RST 20H ; NEXT_CHAR if a comma was found + JR SF_ARGMTS ; back to SF_ARGMTS to parse all arguments. + + ;;;$27E4 +SF_BRKT_2: CP $29 ; is character the closing ')' ? + + ;;;$27E6 +SF_RPRT_C: JP NZ,REPORT_C ; jump to REPORT_C + ; 'Nonsense in Basic' + + ; at this point any optional arguments have had their syntax checked. + + ;;;$27E9 +SF_FLAG_6: RST 20H ; NEXT_CHAR + LD HL,FLAGS ; address system variable FLAGS + RES 6,(HL) ; signal string result + POP AF ; restore test against '$'. + JR Z,SF_SYN_EN ; forward to SF_SYN_EN if string function. + + SET 6,(HL) ; signal numeric result + + ;;;$27F4 +SF_SYN_EN: JP S_CONT_2 ; jump back to S_CONT_2 to continue scanning. + + ; the branch was here in runtime. + + ;;;$27F7 +SF_RUN: RST 20H ; NEXT_CHAR fetches name + AND $DF ; AND 11101111 - reset bit 5 - upper-case. + LD B,A ; save in B + RST 20H ; NEXT_CHAR + SUB $24 ; subtract '$' + LD C,A ; save result in C + JR NZ,SF_ARGMT1 ; forward if not '$' to SF_ARGMT1 + + RST 20H ; NEXT_CHAR advances to bracket + + ;;;$2802 +SF_ARGMT1: RST 20H ; NEXT_CHAR advances to start of argument + PUSH HL ; save address + LD HL,(PROG) ; fetch start of program area from PROG + DEC HL ; the search starting point is the previous + ; location. + + ;;;$2808 +SF_FND_DF: LD DE,$00CE ; search is for token 'DEF FN' in E, statement count in D. + PUSH BC ; save C the string test, and B the letter. + CALL LOOK_PROG ; routine LOOK_PROG will search for token. + POP BC ; restore BC. + JR NC,SF_CP_DEF ; forward to SF_CP_DEF if a match was found. + + ;;;$2812 +REPORT_P: RST 08H ; ERROR_1 + DEFB $18 ; Error Report: FN without DEF + + ;;;$2814 +SF_CP_DEF: PUSH HL ; save address of DEF FN + CALL FN_SKPOVR ; routine FN_SKPOVR skips over white-space etc. + ; without disturbing CH-ADD. + AND $DF ; make fetched character upper-case. + CP B ; compare with FN name + JR NZ,SF_NOT_FD ; forward to SF_NOT_FD if no match. + + ; the letters match so test the type. + + CALL FN_SKPOVR ; routine FN_SKPOVR skips white-space + SUB $24 ; subtract '$' from fetched character + CP C ; compare with saved result of same operation on FN name. + JR Z,SF_VALUES ; forward to SF_VALUES with a match. + + ; the letters matched but one was string and the other numeric. + + ;;;$2825 +SF_NOT_FD: POP HL ; restore search point. + DEC HL ; make location before + LD DE,$0200 ; the search is to be for the end of the + ; current definition - 2 statements forward. + PUSH BC ; save the letter/type + CALL EACH_STMT ; routine EACH_STMT steps past rejected definition. + POP BC ; restore letter/type + JR SF_FND_DF ; back to SF_FND_DF to continue search + + ; Success! + ; the branch was here with matching letter and numeric/string type. + + ;;;$2831 +SF_VALUES: AND A ; test A ( will be zero if string '$' - '$' ) + CALL Z,FN_SKPOVR ; routine FN_SKPOVR advances HL past '$'. + POP DE ; discard pointer to 'DEF FN'. + POP DE ; restore pointer to first FN argument. + LD (CH_ADD),DE ; save in CH_ADD + CALL FN_SKPOVR ; routine FN_SKPOVR advances HL past '(' + PUSH HL ; save start address in DEF FN *** + CP $29 ; is character a ')' ? + JR Z,SF_R_BR_2 ; forward to SF_R_BR_2 if no arguments. + + ;;;$2843 +SF_ARG_LP: INC HL ; point to next character. + LD A,(HL) ; fetch it. + CP $0E ; is it the number marker + LD D,$40 ; signal numeric in D. + JR Z,SF_ARG_VL ; forward to SF_ARG_VL if numeric. + + DEC HL ; back to letter + CALL FN_SKPOVR ; routine FN_SKPOVR skips any white-space + INC HL ; advance past the expected '$' to the 'hidden' marker. + LD D,$00 ; signal string. + + ;;;$2852 +SF_ARG_VL: INC HL ; now address first of 5-byte location. + PUSH HL ; save address in DEF FN statement + PUSH DE ; save D - result type + CALL SCANNING ; routine SCANNING evaluates expression in + ; the FN statement setting FLAGS and leaving + ; result as last value on calculator stack. + POP AF ; restore saved result type to A + XOR (IY+$01) ; xor with FLAGS + AND $40 ; and with 01000000 to test bit 6 + JR NZ,REPORT_Q ; forward to REPORT_Q if type mismatch. + ; 'Parameter error' + POP HL ; pop the start address in DEF FN statement + EX DE,HL ; transfer to DE ?? pop straight into de ? + LD HL,(STKEND) ; set HL to STKEND location after value + LD BC,$0005 ; five bytes to move + SBC HL,BC ; decrease HL by 5 to point to start. + LD (STKEND),HL ; set STKEND 'removing' value from stack. + LDIR ; copy value into DEF FN statement + EX DE,HL ; set HL to location after value in DEF FN + DEC HL ; step back one + CALL FN_SKPOVR ; routine FN_SKPOVR gets next valid character + CP $29 ; is it ')' end of arguments ? + JR Z,SF_R_BR_2 ; forward to SF_R_BR_2 if so. + + ; a comma separator has been encountered in the DEF FN argument list. + + PUSH HL ; save position in DEF FN statement + RST 18H ; GET_CHAR from FN statement + CP $2C ; is it ',' ? + JR NZ,REPORT_Q ; forward to REPORT_Q if not + ; 'Parameter error' + RST 20H ; NEXT_CHAR in FN statement advances to next + ; argument. + POP HL ; restore DEF FN pointer + CALL FN_SKPOVR ; routine FN_SKPOVR advances to corresponding + ; argument. + JR SF_ARG_LP ; back to SF_ARG_LP looping until all + ; arguments are passed into the DEF FN + ; hidden locations. + + ; the branch was here when all arguments passed. + + ;;;$2885 +SF_R_BR_2: PUSH HL ; save location of ')' in DEF FN + RST 18H ; GET_CHAR gets next character in FN + CP $29 ; is it a ')' also ? + JR Z,SF_VALUE ; forward to SF_VALUE if so. + + ;;;$288B +REPORT_Q: RST 08H ; ERROR_1 + DEFB $19 ; Error Report: Parameter error + + ;;;$288D +SF_VALUE: POP DE ; location of ')' in DEF FN to DE. + EX DE,HL ; now to HL, FN ')' pointer to DE. + LD (CH_ADD),HL ; initialize CH_ADD to this value. + + ; At this point the start of the DEF FN argument list is on the machine stack. + ; We also have to consider that this defined function may form part of the + ; definition of another defined function (though not itself). + ; As this defined function may be part of a hierarchy of defined functions + ; currently being evaluated by recursive calls to SCANNING, then we have to + ; preserve the original value of DEFADD and not assume that it is zero. + + LD HL,(DEFADD) ; get original DEFADD address + EX (SP),HL ; swap with DEF FN address on stack *** + LD (DEFADD),HL ; set DEFADD to point to this argument list + ; during scanning. + PUSH DE ; save FN ')' pointer. + RST 20H ; NEXT_CHAR advances past ')' in define + RST 20H ; NEXT_CHAR advances past '=' to expression + CALL SCANNING ; routine SCANNING evaluates but searches + ; initially for variables at DEFADD + POP HL ; pop the FN ')' pointer + LD (CH_ADD),HL ; set CH_ADD to this + POP HL ; pop the original DEFADD value + LD (DEFADD),HL ; and re-insert into DEFADD system variable. + + RST 20H ; NEXT_CHAR advances to character after ')' + JP S_CONT_2 ; to S_CONT_2 - to continue current + ; invocation of scanning + +;--------------------- +; Used to parse DEF FN +;--------------------- +; e.g. DEF FN s $ ( x ) = b $ ( TO x ) : REM exaggerated +; +; This routine is used 10 times to advance along a DEF FN statement +; skipping spaces and colour control codes. It is similar to NEXT-CHAR +; which is, at the same time, used to skip along the corresponding FN function +; except the latter has to deal with AT and TAB characters in string +; expressions. These cannot occur in a program area so this routine is +; simpler as both colour controls and their parameters are less than space. + + ;;;$28AB +FN_SKPOVR: INC HL ; increase pointer + LD A,(HL) ; fetch addressed character + CP $21 ; compare with space + 1 + JR C,FN_SKPOVR ; back to FN_SKPOVR if less + + RET ; return pointing to a valid character. + +;---------- +; LOOK_VARS +;---------- + + ;;;$28B2 +LOOK_VARS: SET 6,(IY+$01) ; update FLAGS - presume numeric result + RST 18H ; GET_CHAR + CALL ALPHA ; routine ALPHA tests for A-Za-z + JP NC,REPORT_C ; jump to REPORT_C if not. + ; 'Nonsense in basic' + PUSH HL ; save pointer to first letter ^1 + AND $1F ; mask lower bits, 1 - 26 decimal 000xxxxx + LD C,A ; store in C. + RST 20H ; NEXT_CHAR + PUSH HL ; save pointer to second character ^2 + CP $28 ; is it '(' - an array ? + JR Z,V_RUN_SYN ; forward to V_RUN_SYN if so. + + SET 6,C ; set 6 signalling string if solitary 010 + CP $24 ; is character a '$' ? + JR Z,V_STR_VAR ; forward to V_STR_VAR + + SET 5,C ; signal numeric 011 + CALL ALPHANUM ; routine ALPHANUM sets carry if second + ; character is alphanumeric. + JR NC,V_TEST_FN ; forward to V_TEST_FN if just one character + + + ; it is more than one character but re-test current character so that 6 reset + ; Note. this is a rare lack of elegance. Bit 6 could be reset once before + ; entering the loop. Another puzzle is that this loop renders the similar + ; loop at V_PASS redundant. + + ;;;$28D4 +V_CHAR: CALL ALPHANUM ; routine ALPHANUM + JR NC,V_RUN_SYN ; to V_RUN_SYN when no more + + RES 6,C ; make long named type 001 + RST 20H ; NEXT_CHAR + JR V_CHAR ; loop back to V_CHAR + + ;;;$28DE +V_STR_VAR: RST 20H ; NEXT_CHAR advances past '$' + RES 6,(IY+$01) ; update FLAGS - signal string result. + + ;;;$28E3 +V_TEST_FN: LD A,($5C0C) ; load A with DEFADD_hi + AND A ; and test for zero. + JR Z,V_RUN_SYN ; forward to V_RUN_SYN if a defined function + ; is not being evaluated. + CALL SYNTAX_Z ; routine SYNTAX_Z + JP NZ,STK_F_ARG ; branch to STK_F_ARG in runtime and then + ; back to this point if no variable found. + + ;;;$28EF +V_RUN_SYN: LD B,C ; save flags in B + CALL SYNTAX_Z ; routine SYNTAX_Z + JR NZ,V_RUN ; to V_RUN to look for the variable in runtime + + ; if checking syntax the letter is not returned + + LD A,C ; copy letter/flags to A + AND $E0 ; and with 11100000 to get rid of the letter + SET 7,A ; use spare bit to signal checking syntax. + LD C,A ; and transfer to C. + JR V_SYNTAX ; forward to V_SYNTAX + + ; but in runtime search for the variable. + + ;;;$28FD +V_RUN: LD HL,(VARS) ; set HL to start of variables from VARS + + ;;;$2900 +V_EACH: LD A,(HL) ; get first character + AND $7F ; and with 01111111 + ; ignoring bit 7 which distinguishes + ; arrays or for/next variables. + JR Z,V_80_BYTE ; to V_80_BYTE if zero as must be 10000000 + ; the variables end-marker. + CP C ; compare with supplied value. + JR NZ,V_NEXT ; forward to V_NEXT if no match. + + RLA ; destructively test + ADD A,A ; bits 5 and 6 of A + ; jumping if bit 5 reset or 6 set + JP P,V_FOUND_2 ; to V_FOUND_2 strings and arrays + + JR C,V_FOUND_2 ; to V_FOUND_2 simple and for next + + ; leaving long name variables. + + POP DE ; pop pointer to 2nd. char + PUSH DE ; save it again + PUSH HL ; save variable first character pointer + + ;;;$2912 +V_MATCHES: INC HL ; address next character in vars area + + ;;;$2913 +V_SPACES: LD A,(DE) ; pick up letter from prog area + INC DE ; and advance address + CP $20 ; is it a space + JR Z,V_SPACES ; back to V_SPACES until non-space + + OR $20 ; convert to range 1 - 26. + CP (HL) ; compare with addressed variables character + JR Z,V_MATCHES ; loop back to V_MATCHES if a match on an + ; intermediate letter. + OR $80 ; now set bit 7 as last character of long + ; names are inverted. + CP (HL) ; compare again + JR NZ,V_GET_PTR ; forward to V_GET_PTR if no match + + ; but if they match check that this is also last letter in prog area + + LD A,(DE) ; fetch next character + CALL ALPHANUM ; routine ALPHANUM sets carry if not alphanum + JR NC,V_FOUND_1 ; forward to V_FOUND_1 with a full match. + + ;;;$2929 +V_GET_PTR: POP HL ; pop saved pointer to char 1 + + ;;;$292A +V_NEXT: PUSH BC ; save flags + CALL NEXT_ONE ; routine NEXT_ONE gets next variable in DE + EX DE,HL ; transfer to HL. + POP BC ; restore the flags + JR V_EACH ; loop back to V_EACH + ; to compare each variable + + ;;;$2932 +V_80_BYTE: SET 7,B ; will signal not found + + ; the branch was here when checking syntax + + ;;;$2934 +V_SYNTAX: POP DE ; discard the pointer to 2nd. character v2 + ; in basic line/workspace. + RST 18H ; GET_CHAR gets character after variable name. + CP $28 ; is it '(' ? + JR Z,V_PASS ; forward to V_PASS + ; Note. could go straight to V_END ? + SET 5,B ; signal not an array + JR V_END ; forward to V_END + + ; the jump was here when a long name matched and HL pointing to last character + ; in variables area. + + ;;;$293E +V_FOUND_1: POP DE ; discard pointer to first var letter + + ; the jump was here with all other matches HL points to first var char. + + ;;;$293F +V_FOUND_2: POP DE ; discard pointer to 2nd prog char v2 + POP DE ; drop pointer to 1st prog char v1 + PUSH HL ; save pointer to last char in vars + RST 18H ; GET_CHAR + + ;;;$2943 +V_PASS: CALL ALPHANUM ; routine ALPHANUM + JR NC,V_END ; forward to V_END if not + + ; but it never will be as we advanced past long-named variables earlier. + + RST 20H ; NEXT_CHAR + JR V_PASS ; back to V_PASS + + ;;;$294B +V_END: POP HL ; pop the pointer to first character in basic line/workspace. + RL B ; rotate the B register, left bit 7 to carry + BIT 6,B ; test the array indicator bit. + RET ; return + +;------------------------ +; Stack function argument +;------------------------ +; This branch is taken from LOOK_VARS when a defined function is currently +; being evaluated. +; Scanning is evaluating the expression after the '=' and the variable +; found could be in the argument list to the left of the '=' or in the +; normal place after the program. Preference will be given to the former. +; The variable name to be matched is in C. + + ;;;$2951 +STK_F_ARG: LD HL,(DEFADD) ; set HL to DEFADD + LD A,(HL) ; load the first character + CP $29 ; is it ')' ? + JP Z,V_RUN_SYN ; back to V_RUN_SYN, if so, as no arguments. + + ; but proceed to search argument list of defined function first if not empty. + + ;;;$295A +SFA_LOOP: LD A,(HL) ; fetch character again. + OR $60 ; or with 01100000 presume a simple variable. + LD B,A ; save result in B. + INC HL ; address next location. + LD A,(HL) ; pick up byte. + CP $0E ; is it the number marker ? + JR Z,SFA_CP_VR ; forward to SFA_CP_VR if so. + + ; it was a string. White-space may be present but syntax has been checked. + + DEC HL ; point back to letter. + CALL FN_SKPOVR ; routine FN_SKPOVR skips to the '$' + INC HL ; now address the hidden marker. + RES 5,B ; signal a string variable. + + ;;;$296B +SFA_CP_VR: LD A,B ; transfer found variable letter to A. + CP C ; compare with expected. + JR Z,SFA_MATCH ; forward to SFA_MATCH with a match. + + INC HL ; step + INC HL ; past + INC HL ; the + INC HL ; five + INC HL ; bytes. + CALL FN_SKPOVR ; routine FN_SKPOVR skips to next character + CP $29 ; is it ')' ? + JP Z,V_RUN_SYN ; jump back if so to V_RUN_SYN to look in + ; normal variables area. + CALL FN_SKPOVR ; routine FN_SKPOVR skips past the ',' + ; all syntax has been checked and these + ; things can be taken as read. + JR SFA_LOOP ; back to SFA_LOOP while there are more + ; arguments. + + ;;;$2981 +SFA_MATCH: BIT 5,C ; test if numeric + JR NZ,SFA_END ; to SFA_END if so as will be stacked + ; by scanning + INC HL ; point to start of string descriptor + LD DE,(STKEND) ; set DE to STKEND + CALL MOVE_FP ; routine MOVE_FP puts parameters on stack. + EX DE,HL ; new free location to HL. + LD (STKEND),HL ; use it to set STKEND system variable. + + ;;;$2991 +SFA_END: POP DE ; discard + POP DE ; pointers. + XOR A ; clear carry flag. + INC A ; and zero flag. + RET ; return. + +;------------------------- +; Stack variable component +;------------------------- +; This is called to evaluate a complex structure that has been found, in +; runtime, by LOOK_VARS in the variables area. +; In this case HL points to the initial letter, bits 7-5 +; of which indicate the type of variable. +; 010 - simple string, 110 - string array, 100 - array of numbers. +; +; It is called from CLASS_01 when assigning to a string or array including +; a slice. +; It is called from SCANNING to isolate the required part of the structure. +; +; An important part of the runtime process is to check that the number of +; dimensions of the variable match the number of subscripts supplied in the +; basic line. +; +; If checking syntax, +; the B register, which counts dimensions is set to zero (256) to allow +; the loop to continue till all subscripts are checked. While doing this it +; is reading dimension sizes from some arbitrary area of memory. Although +; these are meaningless it is of no concern as the limit is never checked by +; int-exp during syntax checking. +; +; The routine is also called from the syntax path of DIM command to check the +; syntax of both string and numeric arrays definitions except that bit 6 of C +; is reset so both are checked as numeric arrays. This ruse avoids a terminal +; slice being accepted as part of the DIM command. +; All that is being checked is that there are a valid set of comma-separated +; expressions before a terminal ')', although, as above, it will still go +; through the motions of checking dummy dimension sizes. + + ;;;$2996 +STK_VAR: XOR A ; clear A + LD B,A ; and B, the syntax dimension counter (256) + BIT 7,C ; checking syntax ? + JR NZ,SV_COUNT ; forward to SV_COUNT if so. + + ; runtime evaluation. + + BIT 7,(HL) ; will be reset if a simple string. + JR NZ,SV_ARRAYS ; forward to SV_ARRAYS otherwise + + INC A ; set A to 1, simple string. + + ;;;$29A1 +SV_SIMPLE: INC HL ; address length low + LD C,(HL) ; place in C + INC HL ; address length high + LD B,(HL) ; place in B + INC HL ; address start of string + EX DE,HL ; DE = start now. + CALL STK_STO_D ; routine STK_STO_D stacks string parameters + ; DE start in variables area, + ; BC length, A=1 simple string + + ; the only thing now is to consider if a slice is required. + + RST 18H ; GET_CHAR puts character at CH_ADD in A + JP SV_SLICE_EX ; jump forward to SV_SLICE_EX to test for '(' + + ; the branch was here with string and numeric arrays in runtime. + + ;;;$29AE +SV_ARRAYS: INC HL ; step past + INC HL ; the total length + INC HL ; to address Number of dimensions. + LD B,(HL) ; transfer to B overwriting zero. + BIT 6,C ; a numeric array ? + JR Z,SV_PTR ; forward to SV_PTR with numeric arrays + + DEC B ; ignore the final element of a string array + ; the fixed string size. + JR Z,SV_SIMPLE ; back to SV_SIMPLE if result is zero as has + ; been created with DIM a$(10) for instance + ; and can be treated as a simple string. + + ; proceed with multi-dimensioned string arrays in runtime. + + EX DE,HL ; save pointer to dimensions in DE + RST 18H ; GET_CHAR looks at the Basic line + CP $28 ; is character '(' ? + JR NZ,REPORT_3 ; to REPORT_3 if not + ; 'Subscript wrong' + EX DE,HL ; dimensions pointer to HL to synchronize + ; with next instruction. + + ; runtime numeric arrays path rejoins here. + + ;;;$29C0 +SV_PTR: EX DE,HL ; save dimension pointer in DE + JR SV_COUNT ; forward to SV_COUNT with true no of dims + ; in B. As there is no initial comma the + ; loop is entered at the midpoint. + + ; the dimension counting loop which is entered at mid-point. + + ;;;$29C3 +SV_COMMA: PUSH HL ; save counter + RST 18H ; GET_CHAR + POP HL ; pop counter + CP $2C ; is character ',' ? + JR Z,SV_LOOP ; forward to SV_LOOP if so + + ; in runtime the variable definition indicates a comma should appear here + + BIT 7,C ; checking syntax ? + JR Z,REPORT_3 ; forward to REPORT_3 if not + ; 'Subscript error' + + ; proceed if checking syntax of an array? + + BIT 6,C ; array of strings + JR NZ,SV_CLOSE ; forward to SV_CLOSE if so + + ; an array of numbers. + + CP $29 ; is character ')' ? + JR NZ,SV_RPT_C ; forward to SV_RPT_C if not + ; 'Nonsense in basic' + RST 20H ; NEXT_CHAR moves CH-ADD past the statement + RET ; return -> + + ; the branch was here with an array of strings. + + ;;;$29D8 +SV_CLOSE: CP $29 ; as above ')' could follow the expression + JR Z,SV_DIM ; forward to SV_DIM if so + + CP $CC ; is it 'TO' ? + JR NZ,SV_RPT_C ; to SV_RPT_C with anything else + ; 'Nonsense in basic' + + ; now backtrack CH_ADD to set up for slicing routine. + ; Note. in a basic line we can safely backtrack to a colour parameter. + + ;;;$29E0 +SV_CH_ADD: RST 18H ; GET_CHAR + DEC HL ; backtrack HL + LD (CH_ADD),HL ; to set CH_ADD up for slicing routine + JR SV_SLICE ; forward to SV_SLICE and make a return + ; when all slicing complete. + + ; -> the mid-point entry point of the loop + + ;;;$29E7 +SV_COUNT: LD HL,$0000 ; initialize data pointer to zero. + + + ;;;$29EA +SV_LOOP: PUSH HL ; save the data pointer. + RST 20H ; NEXT_CHAR in Basic area points to an expression. + POP HL ; restore the data pointer. + LD A,C ; transfer name/type to A. + CP $C0 ; is it 11000000 ? + ; Note. the letter component is absent if + ; syntax checking. + JR NZ,SV_MULT ; forward to SV_MULT if not an array of + ; strings. + + ; proceed to check string arrays during syntax. + + RST 18H ; GET_CHAR + CP $29 ; ')' end of subscripts ? + JR Z,SV_DIM ; forward to SV_DIM to consider further slice + + CP $CC ; is it 'TO' ? + JR Z,SV_CH_ADD ; back to SV_CH_ADD to consider a slice. + ; (no need to repeat GET_CHAR at SV_CH_ADD) + + ; if neither, then an expression is required so rejoin runtime loop ?? + ; registers HL and DE only point to somewhere meaningful in runtime so + ; comments apply to that situation. + + ;;;$29FB +SV_MULT: PUSH BC ; save dimension number. + PUSH HL ; push data pointer/rubbish. + ; DE points to current dimension. + CALL DE_DE_1 ; routine DE_DE_1 gets next dimension in DE + ; and HL points to it. + EX (SP),HL ; dim pointer to stack, data pointer to HL (*) + EX DE,HL ; data pointer to DE, dim size to HL. + CALL INT_EXP1 ; routine INT_EXP1 checks integer expression + ; and gets result in BC in runtime. + JR C,REPORT_3 ; to REPORT_3 if > HL + ; 'Subscript out of range' + DEC BC ; adjust returned result from 1-x to 0-x + CALL GET_HL_DE ; routine GET_HL_DE multiplies data pointer by dimension size. + ADD HL,BC ; add the integer returned by expression. + POP DE ; pop the dimension pointer. *** + POP BC ; pop dimension counter. + DJNZ SV_COMMA ; back to SV_COMMA if more dimensions + ; Note. during syntax checking, unless there + ; are more than 256 subscripts, the branch + ; back to SV_COMMA is always taken. + BIT 7,C ; are we checking syntax ? + ; then we've got a joker here. + + ;;;$2A12 +SV_RPT_C: JR NZ,SL_RPT_C ; forward to SL_RPT_C if so + ; 'Nonsense in Basic' + ; more than 256 subscripts in Basic line. + + ; but in runtime the number of subscripts are at least the same as dims + + PUSH HL ; save data pointer. + BIT 6,C ; is it a string array ? + JR NZ,SV_ELEM ; forward to SV_ELEM if so. + + ; a runtime numeric array subscript. + + LD B,D ; register DE has advanced past all dimensions + LD C,E ; and points to start of data in variable. + ; transfer it to BC. + RST 18H ; GET_CHAR checks Basic line + CP $29 ; must be a ')' ? + JR Z,SV_NUMBER ; skip to SV_NUMBER if so + + ; else more subscripts in Basic line than the variable definition. + + ;;;$2A20 +REPORT_3: RST 08H ; ERROR_1 + DEFB $02 ; Error Report: Subscript wrong + + ; continue if subscripts matched the numeric array. + + ;;;$2A22 +SV_NUMBER: RST 20H ; NEXT_CHAR moves CH_ADD to next statement - finished parsing. + POP HL ; pop the data pointer. + LD DE,$0005 ; each numeric element is 5 bytes. + CALL GET_HL_DE ; routine GET_HL_DE multiplies. + ADD HL,BC ; now add to start of data in the variable. + RET ; return with HL pointing at the numeric + ; array subscript. -> + + ; the branch was here for string subscripts when the number of subscripts + ; in the basic line was one less than in variable definition. + + ;;;$2A2C +SV_ELEM: CALL DE_DE_1 ; routine DE_DE_1 gets final dimension + ; the length of strings in this array. + EX (SP),HL ; start pointer to stack, data pointer to HL. + CALL GET_HL_DE ; routine GET_HL_DE multiplies by element size. + POP BC ; the start of data pointer is added + ADD HL,BC ; in - now points to location before. + INC HL ; point to start of required string. + LD B,D ; transfer the length (final dimension size) + LD C,E ; from DE to BC. + EX DE,HL ; put start in DE. + CALL STK_ST_0 ; routine STK_ST_0 stores the string parameters + ; with A=0 - a slice or subscript. + + ; now check that there were no more subscripts in the Basic line. + + RST 18H ; GET_CHAR + CP $29 ; is it ')' ? + JR Z,SV_DIM ; forward to SV_DIM to consider a separate + ; subscript or/and a slice. + CP $2C ; a comma is allowed if the final subscript + ; is to be sliced e.g a$(2,3,4 TO 6). + JR NZ,REPORT_3 ; to REPORT_3 with anything else + ; 'Subscript error' + + ;;;$2A45 +SV_SLICE: CALL SLICING ; routine SLICING slices the string. + ; but a slice of a simple string can itself be sliced. + + ;;;$2A48 +SV_DIM: RST 20H ; NEXT_CHAR + + ;;;$2A49 +SV_SLICE_EX: CP $28 ; is character '(' ? + JR Z,SV_SLICE ; loop back if so to SV_SLICE + + RES 6,(IY+$01) ; update FLAGS - Signal string result + RET ; and return. + +; The above section deals with the flexible syntax allowed. +; DIM a$(3,3,10) can be considered as two dimensional array of ten-character +; strings or a 3-dimensional array of characters. +; a$(1,1) will return a 10-character string as will a$(1,1,1 TO 10) +; a$(1,1,1) will return a single character. +; a$(1,1) (1 TO 6) is the same as a$(1,1,1 TO 6) +; A slice can itself be sliced ad infinitum +; b$ () () () () () () (2 TO 10) (2 TO 9) (3) is the same as b$(5) + + +;-------------------------- +; Handle slicing of strings +;-------------------------- +; The syntax of string slicing is very natural and it is as well to reflect +; on the permutations possible. +; a$() and a$( TO ) indicate the entire string although just a$ would do +; and would avoid coming here. +; h$(16) indicates the single character at position 16. +; a$( TO 32) indicates the first 32 characters. +; a$(257 TO) indicates all except the first 256 characters. +; a$(19000 TO 19999) indicates the thousand characters at position 19000. +; Also a$(9 TO 5) returns a null string not an error. +; This enables a$(2 TO) to return a null string if the passed string is +; of length zero or 1. +; A string expression in brackets can be sliced. e.g. (STR$ PI) (3 TO ) +; We arrived here from SCANNING with CH-ADD pointing to the initial '(' +; or from above. + + ;;;$2A52 +SLICING: CALL SYNTAX_Z ; routine SYNTAX_Z + CALL NZ,STK_FETCH ; routine STK_FETCH fetches parameters of + ; string at runtime, start in DE, length + ; in BC. This could be an array subscript. + RST 20H ; NEXT_CHAR + CP $29 ; is it ')' ? e.g. a$() + JR Z,SL_STORE ; forward to SL_STORE to store entire string. + + PUSH DE ; else save start address of string + XOR A ; clear accumulator to use as a running flag. + PUSH AF ; and save on stack before any branching. + PUSH BC ; save length of string to be sliced. + LD DE,$0001 ; default the start point to position 1. + RST 18H ; GET_CHAR + POP HL ; pop length to HL as default end point + ; and limit. + CP $CC ; is it 'TO' ? e.g. a$( TO 10000) + JR Z,SL_SECOND ; to SL_SECOND to evaluate second parameter. + + POP AF ; pop the running flag. + CALL INT_EXP2 ; routine INT_EXP2 fetches first parameter. + PUSH AF ; save flag (will be $FF if parameter>limit) + LD D,B ; transfer the start + LD E,C ; to DE overwriting 0001. + PUSH HL ; save original length. + RST 18H ; GET_CHAR + POP HL ; pop the limit length. + CP $CC ; is it 'TO' after a start ? + JR Z,SL_SECOND ; to SL_SECOND to evaluate second parameter + + CP $29 ; is it ')' ? e.g. a$(365) + + ;;;$2A7A +SL_RPT_C: JP NZ,REPORT_C ; jump to REPORT_C with anything else + ; 'Nonsense in basic' + LD H,D ; copy start + LD L,E ; to end - just a one character slice. + JR SL_DEFINE ; forward to SL_DEFINE. + + ;;;$2A81 +SL_SECOND: PUSH HL ; save limit length. + RST 20H ; NEXT_CHAR + POP HL ; pop the length. + CP $29 ; is character ')' ? e.g a$(7 TO ) + JR Z,SL_DEFINE ; to SL_DEFINE using length as end point. + + POP AF ; else restore flag. + CALL INT_EXP2 ; routine INT_EXP2 gets second expression. + PUSH AF ; save the running flag. + RST 18H ; GET_CHAR + LD H,B ; transfer second parameter + LD L,C ; to HL. e.g. a$(42 to 99) + CP $29 ; is character a ')' ? + JR NZ,SL_RPT_C ; to SL_RPT_C if not + ; 'Nonsense in basic' + + ; we now have start in DE and an end in HL. + + ;;;$2A94 +SL_DEFINE: POP AF ; pop the running flag. + EX (SP),HL ; put end point on stack, start address to HL + ADD HL,DE ; add address of string to the start point. + DEC HL ; point to first character of slice. + EX (SP),HL ; start address to stack, end point to HL (*) + AND A ; prepare to subtract. + SBC HL,DE ; subtract start point from end point. + LD BC,$0000 ; default the length result to zero. + JR C,SL_OVER ; forward to SL_OVER if start > end. + + INC HL ; increment the length for inclusive byte. + AND A ; now test the running flag. + JP M,REPORT_3 ; jump back to REPORT_3 if $FF. + ; 'Subscript out of range' + LD B,H ; transfer the length + LD C,L ; to BC. + + ;;;$2AA8 +SL_OVER: POP DE ; restore start address from machine stack *** + RES 6,(IY+$01) ; update FLAGS - signal string result for + ; syntax. + + ;;;$2AAD +SL_STORE: CALL SYNTAX_Z ; routine SYNTAX_Z (UNSTACK_Z?) + RET Z ; return if checking syntax. + ; but continue to store the string in runtime. + + ; ------------------------------------ + ; other than from above, this routine is called from STK_VAR to stack + ; a known string array element. + ; ------------------------------------ + + ;;;$2AB1 +STK_ST_0: XOR A ; clear to signal a sliced string or element. + + ; ------------------------- + ; this routine is called from CHR$, scrn$ etc. to store a simple string result. + ; -------------------------- + + ;;;$2AB2 +STK_STO_D: RES 6,(IY+$01) ; update FLAGS - signal string result. + ; and continue to store parameters of string. + +;---------------------------------------- +; Pass five registers to calculator stack +;---------------------------------------- +; This subroutine puts five registers on the calculator stack. + + ;;;$2AB6 +STK_STORE: PUSH BC ; save two registers + CALL TEST_5_SP ; routine TEST_5_SP checks room and puts 5 in BC. + POP BC ; fetch the saved registers. + LD HL,(STKEND) ; make HL point to first empty location STKEND + LD (HL),A ; place the 5 registers. + INC HL + LD (HL),E + INC HL + LD (HL),D + INC HL + LD (HL),C + INC HL + LD (HL),B + INC HL + LD (STKEND),HL ; update system variable STKEND. + RET ; and return. + +;-------------------------------------------- +; Return result of evaluating next expression +;-------------------------------------------- +; This clever routine is used to check and evaluate an integer expression +; which is returned in BC, setting A to $FF, if greater than a limit supplied +; in HL. It is used to check array subscripts, parameters of a string slice +; and the arguments of the DIM command. In the latter case, the limit check +; is not required and H is set to $FF. When checking optional string slice +; parameters, it is entered at the second entry point so as not to disturb +; the running flag A, which may be $00 or $FF from a previous invocation. + + ;;;$2ACC +INT_EXP1: XOR A ; set result flag to zero. + + ; -> The entry point is here if A is used as a running flag. + + ;;;$2ACD +INT_EXP2: PUSH DE ; preserve DE register throughout. + PUSH HL ; save the supplied limit. + PUSH AF ; save the flag. + CALL EXPT_1NUM ; routine EXPT_1NUM evaluates expression + ; at CH_ADD returning if numeric result, + ; with value on calculator stack. + POP AF ; pop the flag. + CALL SYNTAX_Z ; routine SYNTAX_Z + JR Z,I_RESTORE ; forward to I_RESTORE if checking syntax so + ; avoiding a comparison with supplied limit. + PUSH AF ; save the flag. + CALL FIND_INT2 ; routine FIND_INT2 fetches value from + ; calculator stack to BC producing an error if too high. + POP DE ; pop the flag to D. + LD A,B ; test value for zero and reject + OR C ; as arrays and strings begin at 1. + SCF ; set carry flag. + JR Z,I_CARRY ; forward to I_CARRY if zero. + + POP HL ; restore the limit. + PUSH HL ; and save. + AND A ; prepare to subtract. + SBC HL,BC ; subtract value from limit. + + ;;;$2AE8 +I_CARRY: LD A,D ; move flag to accumulator $00 or $FF. + SBC A,$00 ; will set to $FF if carry set. + + ;;;$2AEB +I_RESTORE: POP HL ; restore the limit. + POP DE ; and DE register. + RET ; return. + + +;------------------------ +; LD DE,(DE+1) Subroutine +;------------------------ +; This routine just loads the DE register with the contents of the two +; locations following the location addressed by DE. +; It is used to step along the 16-bit dimension sizes in array definitions. +; Note. Such code is made into subroutines to make programs easier to +; write and it would use less space to include the five instructions in-line. +; However, there are so many exchanges going on at the places this is invoked +; that to implement it in-line would make the code hard to follow. +; It probably had a zipier label though as the intention is to simplify the +; program. + + ;;;$2AEE +DE_DE_1: EX DE,HL + INC HL + LD E,(HL) + INC HL + LD D,(HL) + RET + +;-------------------- +; HL=HL*DE Subroutine +;-------------------- +; This routine calls the mathematical routine to multiply HL by DE in runtime. +; It is called from STK_VAR and from DIM. In the latter case syntax is not +; being checked so the entry point could have been at the second CALL +; instruction to save a few clock-cycles. + + ;;;$2AF4 +GET_HL_DE: CALL SYNTAX_Z ; routine SYNTAX_Z. + RET Z ; return if checking syntax. + + CALL HL_HL_DE ; routine HL_HL_DE. + JP C,REPORT_4 ; jump back to REPORT_4 if over 65535. + + RET ; else return with 16-bit result in HL. + +;------------------- +; Handle LET command +;------------------- +; Sinclair Basic adheres to the ANSI-79 standard and a LET is required in +; assignments e.g. LET a = 1 : LET h$ = "hat" +; Long names may contain spaces but not colour controls (when assigned). +; a substring can appear to the left of the equals sign. + +; An earlier mathematician Lewis Carroll may have been pleased that +; 10 LET Babies cannot manage crocodiles = Babies are illogical AND +; Nobody is despised who can manage a crocodile AND Illogical persons +; are despised +; does not give the 'Nonsense..' error if the three variables exist. +; I digress. + + ;;;$2AFF +LET: LD HL,(DEST) ; fetch system variable DEST to HL. + BIT 1,(IY+$37) ; test FLAGX - handling a new variable ? + JR Z,L_EXISTS ; forward to L_EXISTS if not. + + ; continue for a new variable. DEST points to start in Basic line. + ; from the CLASS routines. + + LD BC,$0005 ; assume numeric and assign an initial 5 bytes + + ;;;$2B0B +L_EACH_CH: INC BC ; increase byte count for each relevant + ; character + + ;;;$2B0C +L_NO_SP: INC HL ; increase pointer. + LD A,(HL) ; fetch character. + CP $20 ; is it a space ? + JR Z,L_NO_SP ; back to L_NO_SP is so. + + JR NC,L_TEST_CH ; forward to L_TEST_CH if higher. + + CP $10 ; is it $00 - $0F ? + JR C,L_SPACES ; forward to L_SPACES if so. + + CP $16 ; is it $16 - $1F ? + JR NC,L_SPACES ; forward to L_SPACES if so. + + ; it was $10 - $15 so step over a colour code. + + INC HL ; increase pointer. + JR L_NO_SP ; loop back to L_NO_SP. + + ; the branch was here if higher than space + + ;;;$2B1F +L_TEST_CH: CALL ALPHANUM ; routine ALPHANUM sets carry if alphanumeric + JR C,L_EACH_CH ; loop back to L_EACH_CH for more if so. + + CP $24 ; is it '$' ? + JP Z,L_NEW ; jump forward if so, to L_NEW + ; with a new string. + + ;;;$2B29 +L_SPACES: LD A,C ; save length lo in A. + LD HL,(E_LINE) ; fetch E_LINE to HL. + DEC HL ; point to location before, the variables end-marker. + CALL MAKE_ROOM ; routine MAKE_ROOM creates BC spaces + ; for name and numeric value. + INC HL ; advance to first new location. + INC HL ; then to second. + EX DE,HL ; set DE to second location. + PUSH DE ; save this pointer. + LD HL,(DEST) ; reload HL with DEST. + DEC DE ; point to first. + SUB $06 ; subtract six from length_lo. + LD B,A ; save count in B. + JR Z,L_SINGLE ; forward to L_SINGLE if it was just one character. + + ; HL points to start of variable name after 'LET' in Basic line. + + ;;;$2B3E +L_CHAR: INC HL ; increase pointer. + LD A,(HL) ; pick up character. + CP $21 ; is it space or higher ? + JR C,L_CHAR ; back to L_CHAR with space and less. + + OR $20 ; make variable lower-case. + INC DE ; increase destination pointer. + LD (DE),A ; and load to edit line. + DJNZ L_CHAR ; loop back to L_CHAR until B is zero. + OR $80 ; invert the last character. + LD (DE),A ; and overwrite that in edit line. + + ; now consider first character which has bit 6 set + + LD A,$C0 ; set A 11000000 is xor mask for a long name. + ; %101 is xor/or result + + ; single character numerics rejoin here with %00000000 in mask. + ; %011 will be xor/or result + + ;;;$2B4F +L_SINGLE: LD HL,(DEST) ; fetch DEST - HL addresses first character. + XOR (HL) ; apply variable type indicator mask (above). + OR $20 ; make lowercase - set bit 5. + POP HL ; restore pointer to 2nd character. + CALL L_FIRST ; routine L_FIRST puts A in first character. + ; and returns with HL holding + ; new E_LINE-1 the $80 vars end-marker. + + ;;;$2B59 +L_NUMERIC: PUSH HL ; save the pointer. + + ; the value of variable is deleted but remains after calculator stack. + + RST 28H ;; FP_CALC + DEFB $02 ;;DELETE ; delete variable value + DEFB $38 ;;END_CALC + + ; DE (STKEND) points to start of value. + + POP HL ; restore the pointer. + LD BC,$0005 ; start of number is five bytes before. + AND A ; prepare for true subtraction. + SBC HL,BC ; HL points to start of value. + JR L_ENTER ; forward to L_ENTER ==> + + + ; the jump was to here if the variable already existed. + + ;;;$2B66 +L_EXISTS: BIT 6,(IY+$01) ; test FLAGS - numeric or string result ? + JR Z,L_DELETE ; skip forward to L_DELETE -*-> + ; if string result. + + ; A numeric variable could be simple or an array element. + ; They are treated the same and the old value is overwritten. + + LD DE,$0006 ; six bytes forward points to loc past value. + ADD HL,DE ; add to start of number. + JR L_NUMERIC ; back to L_NUMERIC to overwrite value. + + ; -*-> the branch was here if a string existed. + + ;;;$2B72 +L_DELETE: LD HL,(DEST) ; fetch DEST to HL. + ; (still set from first instruction) + LD BC,(STRLEN) ; fetch STRLEN to BC. + BIT 0,(IY+$37) ; test FLAGX - handling a complete simple string ? + JR NZ,L_ADD ; forward to L_ADD if so. + + ; must be a string array or a slice in workspace. + ; Note. LET a$(3 TO 6) = h$ will assign "hat " if h$ = "hat" + ; and "hats" if h$ = "hatstand". + + ; This is known as Procrustian lengthening and shortening after a + ; character Procrustes in Greek legend who made travellers sleep in his bed, + ; cutting off their feet or stretching them so they fitted the bed perfectly. + ; The bloke was hatstand and slain by Theseus. + + LD A,B ; test if length + OR C ; is zero and + RET Z ; return if so. + + PUSH HL ; save pointer to start. + RST 30H ; BC_SPACES creates room. + PUSH DE ; save pointer to first new location. + PUSH BC ; and length (*) + LD D,H ; set DE to point to last location. + LD E,L + INC HL ; set HL to next location. + LD (HL),$20 ; place a space there. + LDDR ; copy bytes filling with spaces. + PUSH HL ; save pointer to start. + CALL STK_FETCH ; routine STK_FETCH start to DE, length to BC. + POP HL ; restore the pointer. + EX (SP),HL ; (*) length to HL, pointer to stack. + AND A ; prepare for true subtraction. + SBC HL,BC ; subtract old length from new. + ADD HL,BC ; and add back. + JR NC,L_LENGTH ; forward if it fits to L_LENGTH. + + LD B,H ; otherwise set + LD C,L ; length to old length. + ; "hatstand" becomes "hats" + + ;;;$2B9B +L_LENGTH: EX (SP),HL ; (*) length to stack, pointer to HL. + EX DE,HL ; pointer to DE, start of string to HL. + LD A,B ; is the length zero ? + OR C ; + JR Z,L_IN_W_S ; forward to L_IN_W_S if so + ; leaving prepared spaces. + LDIR ; else copy bytes overwriting some spaces. + + ;;;$2BA3 +L_IN_W_S: POP BC ; pop the new length. (*) + POP DE ; pop pointer to new area. + POP HL ; pop pointer to variable in assignment. + ; and continue copying from workspace + ; to variables area. + + ; ==> branch here from L_NUMERIC + + ;;;$2BA6 +L_ENTER: EX DE,HL ; exchange pointers HL=STKEND DE=end of vars. + LD A,B ; test the length + OR C ; and make a + RET Z ; return if zero (strings only). + + PUSH DE ; save start of destination. + LDIR ; copy bytes. + POP HL ; address the start. + RET ; and return. + + ; the branch was here from L_DELETE if an existing simple string. + ; register HL addresses start of string in variables area. + + ;;;$2BAF +L_ADD: DEC HL ; point to high byte of length. + DEC HL ; to low byte. + DEC HL ; to letter. + LD A,(HL) ; fetch masked letter to A. + PUSH HL ; save the pointer on stack. + PUSH BC ; save new length. + CALL L_STRING ; routine L_STRING adds new string at end + ; of variables area. + ; if no room we still have old one. + POP BC ; restore length. + POP HL ; restore start. + INC BC ; increase + INC BC ; length by three + INC BC ; to include character and length bytes. + JP RECLAIM_2 ; jump to indirect exit via RECLAIM_2 + ; deleting old version and adjusting pointers. + + ; the jump was here with a new string variable. + + ;;;$2BC0 +L_NEW: LD A,$DF ; indicator mask %11011111 for + ; %010xxxxx will be result + LD HL,(DEST) ; address DEST first character. + AND (HL) ; combine mask with character. + + ;;;$2BC6 +L_STRING: PUSH AF ; save first character and mask. + CALL STK_FETCH ; routine STK_FETCH fetches parameters of the string. + EX DE,HL ; transfer start to HL. + ADD HL,BC ; add to length. + PUSH BC ; save the length. + DEC HL ; point to end of string. + LD (DEST),HL ; save pointer in DEST. + ; (updated by POINTERS if in workspace) + INC BC ; extra byte for letter. + INC BC ; two bytes + INC BC ; for the length of string. + LD HL,(E_LINE) ; address E_LINE. + DEC HL ; now end of VARS area. + CALL MAKE_ROOM ; routine MAKE_ROOM makes room for string. + ; updating pointers including DEST. + LD HL,(DEST) ; pick up pointer to end of string from DEST. + POP BC ; restore length from stack. + PUSH BC ; and save again on stack. + INC BC ; add a byte. + LDDR ; copy bytes from end to start. + EX DE,HL ; HL addresses length low + INC HL ; increase to address high byte + POP BC ; restore length to BC + LD (HL),B ; insert high byte + DEC HL ; address low byte location + LD (HL),C ; insert that byte + POP AF ; restore character and mask + + ;;;$2BEA +L_FIRST: DEC HL ; address variable name + LD (HL),A ; and insert character. + LD HL,(E_LINE) ; load HL with E_LINE. + DEC HL ; now end of VARS area. + RET ; return + +;------------------------------------- +; Get last value from calculator stack +;------------------------------------- + + ;;;$2BF1 +STK_FETCH: LD HL,(STKEND) ; STKEND + DEC HL + LD B,(HL) + DEC HL + LD C,(HL) + DEC HL + LD D,(HL) + DEC HL + LD E,(HL) + DEC HL + LD A,(HL) + LD (STKEND),HL ; STKEND + RET + +;------------------- +; Handle DIM command +;------------------- +; e.g. DIM a(2,3,4,7): DIM a$(32) : DIM b$(300,2,768) : DIM c$(20000) +; the only limit to dimensions is memory so, for example, +; DIM a(2,2,2,2,2,2,2,2,2,2,2,2,2) is possible and creates a multi- +; dimensional array of zeros. String arrays are initialized to spaces. +; It is not possible to erase an array, but it can be re-dimensioned to +; a minimal size of 1, after use, to free up memory. + + ;;;$2C02 +DIM: CALL LOOK_VARS ; routine LOOK_VARS + + ;;;$2C05 +D_RPORT_C: JP NZ,REPORT_C ; jump to REPORT_C if a long-name variable. + ; DIM lottery numbers(49) doesn't work. + + CALL SYNTAX_Z ; routine SYNTAX_Z + JR NZ,D_RUN ; forward to D_RUN in runtime. + + RES 6,C ; signal 'numeric' array even if string as + ; this simplifies the syntax checking. + CALL STK_VAR ; routine STK_VAR checks syntax. + CALL CHECK_END ; routine CHECK_END performs early exit -> + + ; the branch was here in runtime. + + ;;;$2C15 +D_RUN: JR C,D_LETTER ; skip to D_LETTER if variable did not exist. + ; else reclaim the old one. + PUSH BC ; save type in C. + CALL NEXT_ONE ; routine NEXT_ONE find following variable + ; or position of $80 end-marker. + CALL RECLAIM_2 ; routine RECLAIM_2 reclaims the space between. + POP BC ; pop the type. + + ;;;$2C1F +D_LETTER: SET 7,C ; signal array. + LD B,$00 ; initialize dimensions to zero and + PUSH BC ; save with the type. + LD HL,$0001 ; make elements one character presuming string + BIT 6,C ; is it a string ? + JR NZ,D_SIZE ; forward to D_SIZE if so. + + LD L,$05 ; make elements 5 bytes as is numeric. + + ;;;$2C2D +D_SIZE: EX DE,HL ; save the element size in DE. + + ; now enter a loop to parse each of the integers in the list. + + ;;;$2C2E +D_NO_LOOP: RST 20H ; NEXT_CHAR + LD H,$FF ; disable limit check by setting HL high + CALL INT_EXP1 ; routine INT_EXP1 + JP C,REPORT_3 ; to REPORT_3 if > 65280 and then some + ; 'Subscript out of range' + POP HL ; pop dimension counter, array type + PUSH BC ; save dimension size *** + INC H ; increment the dimension counter + PUSH HL ; save the dimension counter + LD H,B ; transfer size + LD L,C ; to HL + CALL GET_HL_DE ; routine GET_HL_DE multiplies dimension by + ; running total of size required initially + ; 1 or 5. + EX DE,HL ; save running total in DE + RST 18H ; GET_CHAR + CP $2C ; is it ',' ? + JR Z,D_NO_LOOP ; loop back to D_NO_LOOP until all dimensions + ; have been considered + + ; when loop complete continue. + + CP $29 ; is it ')' ? + JR NZ,D_RPORT_C ; to D_RPORT_C with anything else + ; 'Nonsense in basic' + + + RST 20H ; NEXT_CHAR advances to next statement/CR + POP BC ; pop dimension counter/type + LD A,C ; type to A + + ; now calculate space required for array variable + + LD L,B ; dimensions to L since these require 16 bits + ; then this value will be doubled + LD H,$00 ; set high byte to zero + + ; another four bytes are required for letter(1), total length(2), number of + ; dimensions(1) but since we have yet to double allow for two + + INC HL ; increment + INC HL ; increment + ADD HL,HL ; now double giving 4 + dimensions * 2 + ADD HL,DE ; add to space required for array contents + JP C,REPORT_4 ; to REPORT_4 if > 65535 + ; 'Out of memory' + PUSH DE ; save data space + PUSH BC ; save dimensions/type + PUSH HL ; save total space + LD B,H ; total space + LD C,L ; to BC + LD HL,(E_LINE) ; address E_LINE - first location after variables area + DEC HL ; point to location before - the $80 end-marker + CALL MAKE_ROOM ; routine MAKE_ROOM creates the space if memory is available. + INC HL ; point to first new location and + LD (HL),A ; store letter/type + POP BC ; pop total space + DEC BC ; exclude name + DEC BC ; exclude the 16-bit + DEC BC ; counter itself + INC HL ; point to next location the 16-bit counter + LD (HL),C ; insert low byte + INC HL ; address next + LD (HL),B ; insert high byte + POP BC ; pop the number of dimensions. + LD A,B ; dimensions to A + INC HL ; address next + LD (HL),A ; and insert "No. of dims" + LD H,D ; transfer DE space + 1 from MAKE_ROOM + LD L,E ; to HL + DEC DE ; set DE to next location down. + LD (HL),$00 ; presume numeric and insert a zero + BIT 6,C ; test bit 6 of C. numeric or string ? + JR Z,DIM_CLEAR ; skip to DIM_CLEAR if numeric + + LD (HL),$20 ; place a space character in HL + + ;;;$2C7C +DIM_CLEAR: POP BC ; pop the data length + LDDR ; LDDR sets to zeros or spaces + + ; The number of dimensions is still in A. + ; A loop is now entered to insert the size of each dimension that was pushed + ; during the D_NO_LOOP working downwards from position before start of data. + + ;;;$2C7F +DIM_SIZES: POP BC ; pop a dimension size *** + LD (HL),B ; insert high byte at position + DEC HL ; next location down + LD (HL),C ; insert low byte + DEC HL ; next location down + DEC A ; decrement dimension counter + JR NZ,DIM_SIZES ; back to DIM_SIZES until all done. + + RET ; return. + +;------------------------------ +; Check whether digit or letter +;------------------------------ +; This routine checks that the character in A is alphanumeric +; returning with carry set if so. + + ;;;$2C88 +ALPHANUM: CALL NUMERIC ; routine NUMERIC will reset carry if so. + CCF ; Complement Carry Flag + RET C ; Return if numeric else continue into next routine. + + ; This routine checks that the character in A is alphabetic + + ;;;$2C8D +ALPHA: CP $41 ; less than 'A' ? + CCF ; Complement Carry Flag + RET NC ; return if so + + CP $5B ; less than 'Z'+1 ? + RET C ; is within first range + + CP $61 ; less than 'a' ? + CCF ; Complement Carry Flag + RET NC ; return if so. + + CP $7B ; less than 'z'+1 ? + RET ; carry set if within a-z. + +;-------------------------- +; Decimal to floating point +;-------------------------- +; This routine finds the floating point number represented by an expression +; beginning with BIN, '.' or a digit. +; Note that BIN need not have any '0's or '1's after it. +; BIN is really just a notational symbol and not a function. + + ;;;$2C9B +DEC_TO_FP: CP $C4 ; 'BIN' token ? + JR NZ,NOT_BIN ; to NOT_BIN if not + + LD DE,$0000 ; initialize 16 bit buffer register. + + ;;;$2CA2 +BIN_DIGIT: RST 20H ; NEXT_CHAR + SUB $31 ; '1' + ADC A,$00 ; will be zero if '1' or '0' + ; carry will be set if was '0' + JR NZ,BIN_END ; forward to BIN_END if result not zero + + EX DE,HL ; buffer to HL + CCF ; Carry now set if originally '1' + ADC HL,HL ; shift the carry into HL + JP C,REPORT_6 ; to REPORT_6 if overflow - too many digits + ; after first '1'. There can be an unlimited + ; number of leading zeros. + ; 'Number too big' - raise an error + EX DE,HL ; save the buffer + JR BIN_DIGIT ; back to BIN_DIGIT for more digits + + ;;;$2CB3 +BIN_END: LD B,D ; transfer 16 bit buffer + LD C,E ; to BC register pair. + JP STACK_BC ; to STACK_BC to put on calculator stack + + ; continue here with .1, 42, 3.14, 5., 2.3 E -4 + + ;;;$2CB8 +NOT_BIN: CP $2E ; '.' - leading decimal point ? + JR Z,DECIMAL ; skip to DECIMAL if so. + + CALL INT_TO_FP ; routine INT_TO_FP to evaluate all digits + ; This number 'x' is placed on stack. + CP $2E ; '.' - mid decimal point ? + JR NZ,E_FORMAT ; to E_FORMAT if not to consider that format + + RST 20H ; NEXT_CHAR + CALL NUMERIC ; routine NUMERIC returns carry reset if 0-9 + JR C,E_FORMAT ; to E_FORMAT if not a digit e.g. '1.' + + JR DEC_STO_1 ; to DEC_STO_1 to add the decimal part to 'x' + + ; a leading decimal point has been found in a number. + + ;;;$2CCB +DECIMAL: RST 20H ; NEXT_CHAR + CALL NUMERIC ; routine NUMERIC will reset carry if digit + + ;;;$2CCF +DEC_RPT_C: JP C,REPORT_C ; to REPORT_C if just a '.' + ; raise 'Nonsense in Basic' + + ; since there is no leading zero put one on the calculator stack. + + RST 28H ;; FP_CALC + DEFB $A0 ;;STK_ZERO ; 0. + DEFB $38 ;;END_CALC + + ; If rejoining from earlier there will be a value 'x' on stack. + ; If continuing from above the value zero. + ; Now store 1 in mem-0. + ; Note. At each pass of the digit loop this will be divided by ten. + + ;;;$2CD5 +DEC_STO_1: RST 28H ;; FP_CALC + DEFB $A1 ;;STK_ONE ;x or 0,1. + DEFB $C0 ;;st-mem-0 ;x or 0,1. + DEFB $02 ;;DELETE ;x or 0. + DEFB $38 ;;END_CALC + + ;;;$2CDA +NXT_DGT_1: RST 18H ; GET_CHAR + CALL STK_DIGIT ; routine STK_DIGIT stacks single digit 'd' + JR C,E_FORMAT ; exit to E_FORMAT when digits exhausted > + + RST 28H ;; FP_CALC ;x or 0,d. first pass. + DEFB $E0 ;;get-mem-0 ;x or 0,d,1. + DEFB $A4 ;;STK_TEN ;x or 0,d,1,10. + DEFB $05 ;;DIVISION ;x or 0,d,1/10. + DEFB $C0 ;;st-mem-0 ;x or 0,d,1/10. + DEFB $04 ;;MULTIPLY ;x or 0,d/10. + DEFB $0F ;;ADDITION ;x or 0 + d/10. + DEFB $38 ;;END_CALC last value. + + RST 20H ; NEXT_CHAR moves to next character + JR NXT_DGT_1 ; back to NXT_DGT_1 + + ; although only the first pass is shown it can be seen that at each pass + ; the new less significant digit is multiplied by an increasingly smaller + ; factor (1/100, 1/1000, 1/10000 ... ) before being added to the previous + ; last value to form a new last value. + + ; Finally see if an exponent has been input. + + ;;;$2CEB +E_FORMAT: CP $45 ; is character 'E' ? + JR Z,SIGN_FLAG ; to SIGN_FLAG if so + + CP $65 ; 'e' is acceptable as well. + RET NZ ; return as no exponent. + + ;;;$2CF2 +SIGN_FLAG: LD B,$FF ; initialize temporary sign byte to $FF + RST 20H ; NEXT_CHAR + CP $2B ; is character '+' ? + JR Z,SIGN_DONE ; to SIGN_DONE + + CP $2D ; is character '-' ? + JR NZ,ST_E_PART ; to ST_E_PART as no sign + + INC B ; set sign to zero + + ; now consider digits of exponent. + ; Note. incidentally this is the only occasion in Spectrum Basic when an + ; expression may not be used when a number is expected. + + ;;;$2CFE +SIGN_DONE: RST 20H ; NEXT_CHAR + + ;;;$2CFF +ST_E_PART: CALL NUMERIC ; routine NUMERIC + JR C,DEC_RPT_C ; to DEC_RPT_C if not + ; raise 'Nonsense in Basic'. + PUSH BC ; save sign (in B) + CALL INT_TO_FP ; routine INT_TO_FP places exponent on stack + CALL FP_TO_A ; routine FP_TO_A transfers it to A + POP BC ; restore sign + JP C,REPORT_6 ; to REPORT_6 if overflow (over 255) + ; raise 'Number too big'. + AND A ; set flags + JP M,REPORT_6 ; to REPORT_6 if over '127'. + ; raise 'Number too big'. + ; 127 is still way too high and it is + ; impossible to enter an exponent greater + ; than 39 from the keyboard. The error gets + ; raised later in E_TO_FP so two different + ; error messages depending how high A is. + INC B ; $FF to $00 or $00 to $01 - expendable now. + JR Z,E_FP_JUMP ; forward to E_FP_JUMP if exponent positive + + NEG ; Negate the exponent. + + ;;;$2D18 +E_FP_JUMP: JP E_TO_FP ; jump forward to E_TO_FP to assign to + ; last value x on stack x * 10 to power A + ; a relative jump would have done. + +;---------------------- +; Check for valid digit +;---------------------- +; This routine checks that the ascii character in A is numeric +; returning with carry reset if so. + + ;;;$2D1B +NUMERIC: CP $30 ; '0' + RET C ; return if less than zero character. + + CP $3A ; The upper test is '9' + CCF ; Complement Carry Flag + RET ; Return - carry clear if character '0' - '9' + +;------------ +; Stack Digit +;------------ +; This subroutine is called from INT_TO_FP and DEC_TO_FP to stack a digit +; on the calculator stack. + + ;;;$2D22 +STK_DIGIT: CALL NUMERIC ; routine NUMERIC + RET C ; return if not numeric character + + SUB $30 ; convert from ascii to digit + +;------------------ +; Stack accumulator +;------------------ + + ;;;$2D28 +STACK_A: LD C,A ; transfer to C + LD B,$00 ; and make B zero + +;----------------------- +; Stack BC register pair +;----------------------- + + ;;;$2D2B +STACK_BC: LD IY,ERR_NR ; re-initialize ERR_NR + XOR A ; clear to signal small integer + LD E,A ; place in E for sign + LD D,C ; LSB to D + LD C,B ; MSB to C + LD B,A ; last byte not used + CALL STK_STORE ; routine STK_STORE + RST 28H ;; FP_CALC + DEFB $38 ;;END_CALC make HL = STKEND-5 + + AND A ; clear carry + RET ; before returning + +;-------------------------- +; Integer to floating point +;-------------------------- +; This routine places one or more digits found in a basic line +; on the calculator stack multiplying the previous value by ten each time +; before adding in the new digit to form a last value on calculator stack. + + ;;;$2D3B +INT_TO_FP: PUSH AF ; save first character + RST 28H ;; FP_CALC + DEFB $A0 ;;STK_ZERO ; v=0. initial value + DEFB $38 ;;END_CALC + + POP AF ; fetch first character back. + + ;;;$2D40 +NXT_DGT_2: CALL STK_DIGIT ; routine STK_DIGIT puts 0-9 on stack + RET C ; will return when character is not numeric > + + RST 28H ;; FP_CALC ; v, d. + DEFB $01 ;;EXCHANGE ; d, v. + DEFB $A4 ;;STK_TEN ; d, v, 10. + DEFB $04 ;;MULTIPLY ; d, v*10. + DEFB $0F ;;ADDITION ; d + v*10 = newvalue + DEFB $38 ;;END_CALC ; v. + + CALL CH_ADD_1 ; routine CH_ADD_1 get next character + JR NXT_DGT_2 ; back to NXT_DGT_2 to process as a digit + + +;********************************* +;** Part 9. ARITHMETIC ROUTINES ** +;********************************* + +;--------------------------- +; E-format to floating point +;--------------------------- +; This subroutine is used by the PRINT_FP routine and the decimal to FP +; routines to stack a number expressed in exponent format. +; Note. Though not used by the ROM as such, it has also been set up as +; a unary calculator literal but this will not work as the accumulator +; is not available from within the calculator. + +; on entry there is a value x on the calculator stack and an exponent of ten +; in A. The required value is x + 10 ^ A + + ;;;$2D4F +E_TO_FP: RLCA ; this will set the x. + RRCA ; carry if bit 7 is set + JR NC,E_SAVE ; to E_SAVE if positive. + + CPL ; make negative positive + INC A ; without altering carry. + + ;;;$2D55 +E_SAVE: PUSH AF ; save positive exp and sign in carry + LD HL,MEM_0 ; address MEM_0 + CALL FP_0_1 ; routine FP_0_1 + ; places an integer zero, if no carry, + ; else a one in mem-0 as a sign flag + RST 28H ;; FP_CALC + DEFB $A4 ;;STK_TEN x, 10. + DEFB $38 ;;END_CALC + + POP AF ; pop the exponent. + + ; now enter a loop + + ;;;$2D60 +E_LOOP: SRL A ; 0>76543210>C + JR NC,E_TST_END ; forward to E_TST_END if no bit + + PUSH AF ; save shifted exponent. + RST 28H ;; FP_CALC + DEFB $C1 ;;st-mem-1 x, 10. + DEFB $E0 ;;get-mem-0 x, 10, (0/1). + DEFB $00 ;;JUMP_TRUE + + DEFB $04 ;;to E_DIVSN + + DEFB $04 ;;MULTIPLY x*10. + DEFB $33 ;;jump + + DEFB $02 ;;to E_FETCH + + ;;;$2D6D +E_DIVSN: DEFB $05 ;;DIVISION x/10. + + ;;;$2D6E +E_FETCH: DEFB $E1 ;;get-mem-1 x/10 or x*10, 10. + DEFB $38 ;;END_CALC new x, 10. + + POP AF ; restore shifted exponent + + ; the loop branched to here with no carry + + ;;;$2D71 +E_TST_END: JR Z,E_END ; forward to E_END if A emptied of bits + PUSH AF ; re-save shifted exponent + RST 28H ;; FP_CALC + DEFB $31 ;;DUPLICATE new x, 10, 10. + DEFB $04 ;;MULTIPLY new x, 100. + DEFB $38 ;;END_CALC + + POP AF ; restore shifted exponent + JR E_LOOP ; back to E_LOOP until all bits done. + + ; although only the first pass is shown it can be seen that for each set bit + ; representing a power of two, x is multiplied or divided by the + ; corresponding power of ten. + + ;;;$2D7B +E_END: RST 28H ;; FP_CALC final x, factor. + DEFB $02 ;;DELETE final x. + DEFB $38 ;;END_CALC x. + + RET ; return + +;-------------- +; Fetch integer +;-------------- +; This routine is called by the mathematical routines - FP_TO_BC, PRINT_FP, +; MULTIPLY, RE_STACK and NEGATE to fetch an integer from address HL. +; HL points to the stack or a location in MEM and no deletion occurs. +; If the number is negative then a similar process to that used in INT_STORE +; is used to restore the twos complement number to normal in DE and a sign +; in C. + + ;;;$2D7F +INT_FETCH: INC HL ; skip zero indicator. + LD C,(HL) ; fetch sign to C + INC HL ; address low byte + LD A,(HL) ; fetch to A + XOR C ; two's complement + SUB C + LD E,A ; place in E + INC HL ; address high byte + LD A,(HL) ; fetch to A + ADC A,C ; two's complement + XOR C + LD D,A ; place in D + RET ; return + +;------------------------- +; Store a positive integer +;------------------------- +; This entry point is not used in this ROM but would +; store any integer as positive. + + ;;;$2D8C +P_INT_STO: LD C,$00 ; make sign byte positive and continue + +;-------------- +; Store integer +;-------------- +; this routine stores an integer in DE at address HL. +; It is called from MULTIPLY, TRUNCATE, NEGATE and SGN. +; The sign byte $00 +ve or $FF -ve is in C. +; If negative, the number is stored in 2's complement form so that it is +; ready to be added. + + ;;;$2D8E +INT_STORE: PUSH HL ; preserve HL + LD (HL),$00 ; first byte zero shows integer not exponent + INC HL + LD (HL),C ; then store the sign byte + INC HL + ; e.g. +1 -1 + LD A,E ; fetch low byte 00000001 00000001 + XOR C ; xor sign 00000000 or 11111111 + ; gives 00000001 or 11111110 + SUB C ; sub sign 00000000 or 11111111 + ; gives 00000001>0 or 11111111>C + LD (HL),A ; store 2's complement. + INC HL + LD A,D ; high byte 00000000 00000000 + ADC A,C ; sign 00000000<0 11111111 65535, overflow + + PUSH AF ; save the value and flags + DEC B ; and test that + INC B ; the high byte is zero. + JR Z,FP_A_END ; forward FP_A_END if zero + + ; else there has been 8-bit overflow + + POP AF ; retrieve the value + SCF ; set carry flag to show overflow + RET ; and return. + + ;;;$2DE1 +FP_A_END: POP AF ; restore value and success flag and + RET ; return. + + +;------------------------------ +; Print a floating point number +;------------------------------ +; Not a trivial task. +; Begin by considering whether to print a leading sign for negative numbers. + + ;;;$2DE3 +PRINT_FP: RST 28H ;; FP_CALC + DEFB $31 ;;DUPLICATE + DEFB $36 ;;LESS_0 + DEFB $00 ;;JUMP_TRUE + + DEFB $0B ;;to PF_NEGTVE + + DEFB $31 ;;DUPLICATE + DEFB $37 ;;GREATER_0 + DEFB $00 ;;JUMP_TRUE + + DEFB $0D ;;to PF_POSTVE + + ; must be zero itself + + DEFB $02 ;;DELETE + DEFB $38 ;;END_CALC + + LD A,$30 ; prepare the character '0' + RST 10H ; PRINT_A + RET ; return. -> + + ;;;$2DF2 +PF_NEGTVE: DEFB $2A ;;ABS + DEFB $38 ;;END_CALC + + LD A,$2D ; the character '-' + RST 10H ; PRINT_A + + ; and continue to print the now positive number. + + RST 28H ;; FP_CALC + + ;;;$2DF8 +PF_POSTVE: DEFB $A0 ;;STK_ZERO x,0. begin by + DEFB $C3 ;;st-mem-3 x,0. clearing a temporary + DEFB $C4 ;;st-mem-4 x,0. output buffer to + DEFB $C5 ;;st-mem-5 x,0. fifteen zeros. + DEFB $02 ;;DELETE x. + DEFB $38 ;;END_CALC x. + + EXX ; in case called from 'STR$' then save the + PUSH HL ; pointer to whatever comes after + EXX ; STR$ as H'L' will be used. + + ; now enter a loop? + + ;;;$2E01 +PF_LOOP: RST 28H ;; FP_CALC + DEFB $31 ;;DUPLICATE x,x. + DEFB $27 ;;INT x,int x. + DEFB $C2 ;;st-mem-2 x,int x. + DEFB $03 ;;SUBTRACT x-int x. fractional part. + DEFB $E2 ;;get-mem-2 x-int x, int x. + DEFB $01 ;;EXCHANGE int x, x-int x. + DEFB $C2 ;;st-mem-2 int x, x-int x. + DEFB $02 ;;DELETE int x. + DEFB $38 ;;END_CALC int x. + ; + ; mem-2 holds the fractional part. + + ; HL points to last value int x + + LD A,(HL) ; fetch exponent of int x. + AND A ; test + JR NZ,PF_LARGE ; forward to PF_LARGE if a large integer + ; > 65535 + + ; continue with small positive integer components in range 0 - 65535 + ; if original number was say .999 then this integer component is zero. + + CALL INT_FETCH ; routine INT_FETCH gets x in DE + ; (but x is not deleted) + LD B,$10 ; set B, bit counter, to 16d + LD A,D ; test if + AND A ; high byte is zero + JR NZ,PF_SAVE ; forward to PF_SAVE if 16-bit integer. + + ; and continue with integer in range 0 - 255. + + OR E ; test the low byte for zero + ; i.e. originally just point something or other. + JR Z,PF_SMALL ; forward if so to PF_SMALL + + LD D,E ; transfer E to D + LD B,$08 ; and reduce the bit counter to 8. + + ;;;$2E1E +PF_SAVE: PUSH DE ; save the part before decimal point. + EXX + POP DE ; and pop in into D'E' + EXX + JR PF_BITS ; forward to PF_BITS + + ; the branch was here when 'int x' was found to be zero as in say 0.5. + ; The zero has been fetched from the calculator stack but not deleted and + ; this should occur now. This omission leaves the stack unbalanced and while + ; that causes no problems with a simple PRINT statement, it will if STR$ is + ; being used in an expression e.g. "2" + STR$ 0.5 gives the result "0.5" + ; instead of the expected result "20.5". + ; credit Tony Stratton, 1982. + ; A DEFB 02 delete is required immediately on using the calculator. + + ;;;$2E24 +PF_SMALL: RST 28H ;; FP_CALC int x = 0. +L2E25: DEFB $E2 ;;get-mem-2 int x = 0, x-int x. + DEFB $38 ;;END_CALC + + LD A,(HL) ; fetch exponent of positive fractional number + SUB $7E ; subtract + CALL LOG_2_A ; routine LOG_2_A calculates leading digits. + LD D,A ; transfer count to D + LD A,(MEM_5_1) ; fetch total digits - MEM_5 2nd byte + SUB D + LD (MEM_5_1),A ; store MEM_5 2nd byte + LD A,D + CALL E_TO_FP ; routine E_TO_FP + RST 28H ;; FP_CALC + DEFB $31 ;;DUPLICATE + DEFB $27 ;;INT + DEFB $C1 ;;st-mem-1 + DEFB $03 ;;SUBTRACT + DEFB $E1 ;;get-mem-1 + DEFB $38 ;;END_CALC + + CALL FP_TO_A ; routine FP_TO_A + PUSH HL ; save HL + LD (MEM_3),A ; MEM_3 1st byte + DEC A + RLA + SBC A,A + INC A + LD HL,MEM_5_0 ; address MEM_5 leading digit counter + LD (HL),A ; store counter + INC HL ; address MEM_5 2nd byte - total digits + ADD A,(HL) ; add counter to contents + LD (HL),A ; and store updated value + POP HL ; restore HL + JP PF_FRACTN ; jump forward to PF_FRACTN + + ; Note. while it would be pedantic to comment on every occasion a JP + ; instruction could be replaced with a JR instruction, this applies to the + ; above, which is useful if you wish to correct the unbalanced stack error + ; by inserting a 'DEFB 02 delete' at L2E25, and maintain main addresses. + + ; the branch was here with a large positive integer > 65535 e.g. 123456789 + ; the accumulator holds the exponent. + + ;;;$2E56 +PF_LARGE: SUB $80 ; make exponent positive + CP $1C ; compare to 28 + JR C,PF_MEDIUM ; to PF_MEDIUM if integer <= 2^27 + + CALL LOG_2_A ; routine LOG_2_A + SUB $07 + LD B,A + LD HL,MEM_5_1 ; address MEM_5_1 the leading digits counter. + ADD A,(HL) ; add A to contents + LD (HL),A ; store updated value. + LD A,B + NEG ; negate + CALL E_TO_FP ; routine E_TO_FP + JR PF_LOOP ; back to PF_LOOP + + ;;;$2E6F +PF_MEDIUM: EX DE,HL + CALL FETCH_TWO ; routine FETCH_TWO + EXX + SET 7,D + LD A,L + EXX + SUB $80 + LD B,A + + ; the branch was here to handle bits in DE with 8 or 16 in B if small int + ; and integer in D'E', 6 nibbles will accommodate 065535 but routine does + ; 32-bit numbers as well from above + + ;;;$2E7B +PF_BITS: SLA E ; C + + ;;;$2F52 +PF_OUT_LP: LD A,C ; fetch total digit count + AND A ; test for zero + JR Z,PF_OUT_DT ; forward to PF_OUT_DT if so + + LD A,(HL) ; fetch digit + INC HL ; address next digit + DEC C ; decrease total digit counter + + ;;;$2F59 +PF_OUT_DT: CALL OUT_CODE ; routine OUT_CODE outputs it. + DJNZ PF_OUT_LP ; loop back to PF_OUT_LP until B leading digits output. + + ;;;$2F5E +PF_DC_OUT: LD A,C ; fetch total digits and + AND A ; test if also zero + RET Z ; return if so --> + + INC B ; increment B + LD A,$2E ; prepare the character '.' + + ;;;$L2F64 +PF_DEC_0: RST 10H ; PRINT_A outputs the character '.' or '0' + LD A,$30 ; prepare the character '0' + ; (for cases like .000012345678) + DJNZ PF_DEC_0 ; loop back to PF_DEC_0 for B times. + LD B,C ; load B with now trailing digit counter. + JR PF_OUT_LP ; back to PF_OUT_LP + + ; the branch was here for E-format printing e.g 123456789 => 1.2345679e+8 + + ;;;$2F6C +PF_E_FRMT: LD D,B ; counter to D + DEC D ; decrement + LD B,$01 ; load B with 1. + CALL PF_E_SBRN ; routine PF_E_SBRN above + LD A,$45 ; prepare character 'e' + RST 10H ; PRINT_A + LD C,D ; exponent to C + LD A,C ; and to A + AND A ; test exponent + JP P,PF_E_POS ; to PF_E_POS if positive + + NEG ; negate + LD C,A ; positive exponent to C + LD A,$2D ; prepare character '-' + JR PF_E_SIGN ; skip to PF_E_SIGN + + ;;;$2F83 +PF_E_POS: LD A,$2B ; prepare character '+' + + ;;;$2F85 +PF_E_SIGN: RST 10H ; PRINT_A outputs the sign + LD B,$00 ; make the high byte zero. + JP OUT_NUM_1 ; exit via OUT_NUM_1 to print exponent in BC + +;------------------------------- +; Handle printing floating point +;------------------------------- +; This subroutine is called twice from above when printing floating-point +; numbers. It returns 10*A +C in registers C and A + + ;;;$2F8B + ; CA-10*A+C +CA_10_A_C: PUSH DE ; preserve DE. + LD L,A ; transfer A to L + LD H,$00 ; zero high byte. + LD E,L ; copy HL + LD D,H ; to DE. + ADD HL,HL ; double (*2) + ADD HL,HL ; double (*4) + ADD HL,DE ; add DE (*5) + ADD HL,HL ; double (*10) + LD E,C ; copy C to E (D is 0) + ADD HL,DE ; and add to give required result. + LD C,H ; transfer to + LD A,L ; destination registers. + POP DE ; restore DE + RET ; return with result. + +;--------------- +; Prepare to add +;--------------- +; This routine is called twice by addition to prepare the two numbers. The +; exponent is picked up in A and the location made zero. Then the sign bit +; is tested before being set to the implied state. Negative numbers are twos +; complemented. + + ;;;$2F9B +PREP_ADD: LD A,(HL) ; pick up exponent + LD (HL),$00 ; make location zero + AND A ; test if number is zero + RET Z ; return if so + + INC HL ; address mantissa + BIT 7,(HL) ; test the sign bit + SET 7,(HL) ; set it to implied state + DEC HL ; point to exponent + RET Z ; return if positive number. + + PUSH BC ; preserve BC + LD BC,$0005 ; length of number + ADD HL,BC ; point HL past end + LD B,C ; set B to 5 counter + LD C,A ; store exponent in C + SCF ; set carry flag + + ;;;$2FAF +NEG_BYTE: DEC HL ; work from LSB to MSB + LD A,(HL) ; fetch byte + CPL ; complement + ADC A,$00 ; add in initial carry or from prev operation + LD (HL),A ; put back + DJNZ NEG_BYTE ; loop to NEG_BYTE till all 5 done + LD A,C ; stored exponent to A + POP BC ; restore original BC + RET ; return + +;------------------ +; Fetch two numbers +;------------------ +; This routine is called twice when printing floating point numbers and also +; to fetch two numbers by the addition, multiply and division routines. +; HL addresses the first number, DE addresses the second number. +; For arithmetic only, A holds the sign of the result which is stored in +; the second location. + + ;;;$2FBA +FETCH_TWO: PUSH HL ; save pointer to first number, result if math. + PUSH AF ; save result sign. + LD C,(HL) + INC HL + LD B,(HL) + LD (HL),A ; store the sign at correct location in + ; destination 5 bytes for arithmetic only. + INC HL + LD A,C + LD C,(HL) + PUSH BC + INC HL + LD C,(HL) + INC HL + LD B,(HL) + EX DE,HL + LD D,A + LD E,(HL) + PUSH DE + INC HL + LD D,(HL) + INC HL + LD E,(HL) + PUSH DE + EXX + POP DE + POP HL + POP BC + EXX + INC HL + LD D,(HL) + INC HL + LD E,(HL) + POP AF ; restore possible result sign. + POP HL ; and pointer to possible result. + RET ; return. + +;---------------------------------- +; Shift floating point number right +;---------------------------------- + + ;;;$2FDD +SHIFT_FP: AND A + RET Z + + CP $21 + JR NC,ADDEND_0 ; to ADDEND_0 + + PUSH BC + LD B,A + + ;;;$2FE5 +ONE_SHIFT: EXX + SRA L + RR D + RR E + EXX + RR D + RR E + DJNZ ONE_SHIFT ; to ONE_SHIFT + POP BC + RET NC + + CALL ADD_BACK ; routine ADD_BACK + RET NZ + + ;;;$2FF9 +ADDEND_0: EXX + XOR A + + ;;;$2FFB +ZEROS_4_5: LD L,$00 + LD D,A + LD E,L + EXX + LD DE,$0000 + RET + +;------------------- +; Add back any carry +;------------------- + + ;;;$3004 +ADD_BACK: INC E + RET NZ + + INC D + RET NZ + + EXX + INC E + JR NZ,ALL_ADDED ; to ALL_ADDED + + INC D + + ;;;$300D +ALL_ADDED: EXX + RET + +;------------------------- +; Handle subtraction ($03) +;------------------------- +; Subtraction is done by switching the sign byte/bit of the second number +; which may be integer of floating point and continuing into addition. + + ;;;$300F +SUBTRACT: EX DE,HL ; address second number with HL + CALL NEGATE ; routine NEGATE switches sign + EX DE,HL ; address first number again + ; and continue. + +;---------------------- +; Handle addition ($0F) +;---------------------- +; HL points to first number, DE to second. +; If they are both integers, then go for the easy route. + + ;; ADDITION +ADDITION: LD A,(DE) ; fetch first byte of second + OR (HL) ; combine with first byte of first + JR NZ,FULL_ADDN ; forward to FULL_ADDN if at least one was + ; in floating point form. + + ; continue if both were small integers. + + PUSH DE ; save pointer to lowest number for result. + INC HL ; address sign byte and + PUSH HL ; push the pointer. + INC HL ; address low byte + LD E,(HL) ; to E + INC HL ; address high byte + LD D,(HL) ; to D + INC HL ; address unused byte + INC HL ; address known zero indicator of 1st number + INC HL ; address sign byte + LD A,(HL) ; sign to A, $00 or $FF + INC HL ; address low byte + LD C,(HL) ; to C + INC HL ; address high byte + LD B,(HL) ; to B + POP HL ; pop result sign pointer + EX DE,HL ; integer to HL + ADD HL,BC ; add to the other one in BC + ; setting carry if overflow. + EX DE,HL ; save result in DE bringing back sign pointer + ADC A,(HL) ; if pos/pos A=01 with overflow else 00 + ; if neg/neg A=FF with overflow else FE + ; if mixture A=00 with overflow else FF + RRCA ; bit 0 to (C) + ADC A,$00 ; both acceptable signs now zero + JR NZ,ADDN_OFLW ; forward to ADDN_OFLW if not + + SBC A,A ; restore a negative result sign + LD (HL),A + INC HL + LD (HL),E + INC HL + LD (HL),D + DEC HL + DEC HL + DEC HL + POP DE ; STKEND + RET + + ;;;$303C +ADDN_OFLW: DEC HL + POP DE + + ;;;$303E +FULL_ADDN: CALL RE_ST_TWO ; routine RE_ST_TWO + EXX + PUSH HL + EXX + PUSH DE + PUSH HL + CALL PREP_ADD ; routine PREP_ADD + LD B,A + EX DE,HL + CALL PREP_ADD ; routine PREP_ADD + LD C,A + CP B + JR NC,SHIFT_LEN ; to SHIFT_LEN + + LD A,B + LD B,C + EX DE,HL + + ;;;$3055 +SHIFT_LEN: PUSH AF + SUB B + CALL FETCH_TWO ; routine FETCH_TWO + CALL SHIFT_FP ; routine SHIFT_FP + POP AF + POP HL + LD (HL),A + PUSH HL + LD L,B + LD H,C + ADD HL,DE + EXX + EX DE,HL + ADC HL,BC + EX DE,HL + LD A,H + ADC A,L + LD L,A + RRA + XOR L + EXX + EX DE,HL + POP HL + RRA + JR NC,TEST_NEG ; to TEST_NEG + + LD A,$01 + CALL SHIFT_FP ; routine SHIFT_FP + INC (HL) + JR Z,ADD_REP_6 ; to ADD_REP_6 + + ;;;$307C +TEST_NEG: EXX + LD A,L + AND $80 + EXX + INC HL + LD (HL),A + DEC HL + JR Z,GO_NC_MLT ; to GO_NC_MLT + + LD A,E + NEG ; Negate + CCF ; Complement Carry Flag + LD E,A + LD A,D + CPL + ADC A,$00 + LD D,A + EXX + LD A,E + CPL + ADC A,$00 + LD E,A + LD A,D + CPL + ADC A,$00 + JR NC,END_COMPL ; to END_COMPL + + RRA + EXX + INC (HL) + + ;;;$309F +ADD_REP_6: JP Z,REPORT_6 ; to REPORT_6 + + EXX + + ;;;$30A3 +END_COMPL: LD D,A + EXX + + ;;;$30A5 +GO_NC_MLT: XOR A + JP TEST_NORM ; to TEST_NORM + +;------------------------------ +; Used in 16 bit multiplication +;------------------------------ +; This routine is used, in the first instance, by the multiply calculator +; literal to perform an integer multiplication in preference to +; 32-bit multiplication to which it will resort if this overflows. +; +; It is also used by STK_VAR to calculate array subscripts and by DIM to +; calculate the space required for multi-dimensional arrays. + + ;;;$30A9 + ;; HL-HL*DE +HL_HL_DE: PUSH BC ; preserve BC throughout + LD B,$10 ; set B to 16 + LD A,H ; save H in A high byte + LD C,L ; save L in C low byte + LD HL,$0000 ; initialize result to zero + + ; now enter a loop. + + ;;;$30B1 +HL_LOOP: ADD HL,HL ; double result + JR C,HL_END ; to HL_END if overflow + + RL C ; shift AC left into carry + RLA ; + JR NC,HL_AGAIN ; to HL_AGAIN to skip addition if no carry + + ADD HL,DE ; add in DE + JR C,HL_END ; to HL_END if overflow + + ;;;$30BC +HL_AGAIN: DJNZ HL_LOOP ; back to HL_LOOP for all 16 bits + + ;;;$30BE +HL_END: POP BC ; restore preserved BC + RET ; return with carry reset if successful + ; and result in HL. + +;------------------------------ +; Prepare to multiply or divide +;------------------------------ +; This routine is called in succession from multiply and divide to prepare +; two mantissas by setting the leftmost bit that is used for the sign. +; On the first call A holds zero and picks up the sign bit. On the second +; call the two bits are XORed to form the result sign - minus * minus giving +; plus etc. If either number is zero then this is flagged. +; HL addresses the exponent. + + ;;;$30C0 +PREP_M_D: CALL TEST_ZERO ; routine TEST_ZERO preserves accumulator. + RET C ; return carry set if zero + + INC HL ; address first byte of mantissa + XOR (HL) ; pick up the first or xor with first. + SET 7,(HL) ; now set to give true 32-bit mantissa + DEC HL ; point to exponent + RET ; return with carry reset + +;---------------------------- +; Handle multiplication ($04) +;---------------------------- + + ;;;$30CA +MULTIPLY: LD A,(DE) + OR (HL) + JR NZ,MULT_LONG ; to MULT_LONG + + PUSH DE + PUSH HL + PUSH DE + CALL INT_FETCH ; routine INT_FETCH + EX DE,HL + EX (SP),HL + LD B,C + CALL INT_FETCH ; routine INT_FETCH + LD A,B + XOR C + LD C,A + POP HL + CALL HL_HL_DE ; routine HL_HL_DE + EX DE,HL + POP HL + JR C,MULT_OFLW ; to MULT_OFLW + + LD A,D + OR E + JR NZ,MULT_RSLT ; to MULT_RSLT + + LD C,A + + ;;;$30EA +MULT_RSLT: CALL INT_STORE ; routine INT_STORE + POP DE + RET + + ;;;$30EF +MULT_OFLW: POP DE + + ;;;$30F0 +MULT_LONG: CALL RE_ST_TWO ; routine RE_ST_TWO + XOR A + CALL PREP_M_D ; routine PREP_M_D + RET C + + EXX + PUSH HL + EXX + PUSH DE + EX DE,HL + CALL PREP_M_D ; routine PREP_M_D + EX DE,HL + JR C,ZERO_RSLT ; to ZERO_RSLT + + PUSH HL + CALL FETCH_TWO ; routine FETCH_TWO + LD A,B + AND A + SBC HL,HL + EXX + PUSH HL + SBC HL,HL + EXX + LD B,$21 + JR STRT_MLT ; to STRT_MLT + + ;;;$3114 +MLT_LOOP: JR NC,NO_ADD ; to NO_ADD + + ADD HL,DE + EXX + ADC HL,DE + EXX + + ;;;$311B +NO_ADD: EXX + RR H + RR L + EXX + RR H + RR L + + ;;;$3125 +STRT_MLT: EXX + RR B + RR C + EXX + RR C + RRA + DJNZ MLT_LOOP ; to MLT_LOOP + EX DE,HL + EXX + EX DE,HL + EXX + POP BC + POP HL + LD A,B + ADD A,C + JR NZ,MAKE_EXPT ; to MAKE_EXPT + + AND A + + ;;;$313B +MAKE_EXPT: DEC A + CCF ; Complement Carry Flag + + ;;;$313D +DIVN_EXPT: RLA + CCF ; Complement Carry Flag + RRA + JP P,OFLW1_CLR ; to OFLW1_CLR + + JR NC,REPORT_6 ; to REPORT_6 + + AND A + + ;;;$3146 +OFLW1_CLR: INC A ; + JR NZ,OFLW2_CLR ; to OFLW2_CLR + + JR C,OFLW2_CLR ; to OFLW2_CLR + + EXX + BIT 7,D + EXX + JR NZ,REPORT_6 ; to REPORT_6 + + ;;;$3151 +OFLW2_CLR: LD (HL),A + EXX + LD A,B + EXX + + ;;;$3155 +TEST_NORM: JR NC,NORMALISE ; to NORMALISE + + LD A,(HL) + AND A + + ;;;$3159 +NEAR_ZERO: LD A,$80 + JR Z,SKIP_ZERO ; to SKIP_ZERO + + ;;;$315D +ZERO_RSLT: XOR A + + ;;;$315E +SKIP_ZERO: EXX + AND D + CALL ZEROS_4_5 ; routine ZEROS_4_5 + RLCA + LD (HL),A + JR C,OFLOW_CLR ; to OFLOW_CLR + + INC HL + LD (HL),A + DEC HL + JR OFLOW_CLR ; to OFLOW_CLR + + ;;;$316C +NORMALISE: LD B,$20 + + ;;;$316E +SHIFT_ONE: EXX + BIT 7,D + EXX + JR NZ,NORML_NOW ; to NORML_NOW + + RLCA + RL E + RL D + EXX + RL E + RL D + EXX + DEC (HL) + JR Z,NEAR_ZERO ; to NEAR_ZERO + + DJNZ SHIFT_ONE ; to SHIFT_ONE + JR ZERO_RSLT ; to ZERO_RSLT + + ;;;$3186 +NORML_NOW: RLA + JR NC,OFLOW_CLR ; to OFLOW_CLR + + CALL ADD_BACK ; routine ADD_BACK + JR NZ,OFLOW_CLR ; to OFLOW_CLR + + EXX + LD D,$80 + EXX + INC (HL) + JR Z,REPORT_6 ; to REPORT_6 + + ;;;$3195 +OFLOW_CLR: PUSH HL + INC HL + EXX + PUSH DE + EXX + POP BC + LD A,B + RLA + RL (HL) + RRA + LD (HL),A + INC HL + LD (HL),C + INC HL + LD (HL),D + INC HL + LD (HL),E + POP HL + POP DE + EXX + POP HL + EXX + RET + + ;;;$31AD +REPORT_6: RST 08H ; ERROR_1 + DEFB $05 ; Error Report: Number too big + +;---------------------- +; Handle division ($05) +;---------------------- + + ;;;$31AF +DIVISION: CALL RE_ST_TWO ; routine RE_ST_TWO + EX DE,HL + XOR A + CALL PREP_M_D ; routine PREP_M_D + JR C,REPORT_6 ; to REPORT_6 + + EX DE,HL + CALL PREP_M_D ; routine PREP_M_D + RET C + + EXX + PUSH HL + EXX + PUSH DE + PUSH HL + CALL FETCH_TWO ; routine FETCH_TWO + EXX + PUSH HL + LD H,B + LD L,C + EXX + LD H,C + LD L,B + XOR A + LD B,$DF + JR DIV_START ; to DIV_START + + ;;;$31D2 +DIV_LOOP: RLA + RL C + EXX + RL C + RL B + EXX + + ;;;$31DB +DIV_34TH: ADD HL,HL + EXX + ADC HL,HL + EXX + JR C,SUBN_ONLY ; to SUBN_ONLY + + ;;;$31E2 +DIV_START: SBC HL,DE + EXX + SBC HL,DE + EXX + JR NC,NO_RSTORE ; to NO_RSTORE + + ADD HL,DE + EXX + ADC HL,DE + EXX + AND A + JR COUNT_ONE ; to COUNT_ONE + + ;;;$31F2 +SUBN_ONLY: AND A + SBC HL,DE + EXX + SBC HL,DE + EXX + + ;;;$31F9 +NO_RSTORE: SCF ; Set Carry Flag + + ;;;$31FA +COUNT_ONE: INC B + JP M,DIV_LOOP ; to DIV_LOOP + + PUSH AF + JR Z,DIV_START ; to DIV_START + + LD E,A + LD D,C + EXX + LD E,C + LD D,B + POP AF + RR B + POP AF + RR B + EXX + POP BC + POP HL + LD A,B + SUB C + JP DIVN_EXPT ; to DIVN_EXPT + +;-------------------------------------- +; Integer truncation towards zero ($3A) +;-------------------------------------- + + ;;;$3214 +TRUNCATE: LD A,(HL) + AND A + RET Z + + CP $81 + JR NC,T_GR_ZERO ; to T_GR_ZERO + + LD (HL),$00 + LD A,$20 + JR NIL_BYTES ; to NIL_BYTES + + ;;;$3221 +T_GR_ZERO: CP $91 + JR NZ,T_SMALL ; to T_SMALL + + INC HL + INC HL + INC HL + LD A,$80 + AND (HL) + DEC HL + OR (HL) + DEC HL + JR NZ,T_FIRST ; to T_FIRST + + LD A,$80 + XOR (HL) + + ;;;$3233 +T_FIRST: DEC HL + JR NZ,T_EXPNENT ; to T_EXPNENT + + LD (HL),A + INC HL + LD (HL),$FF + DEC HL + LD A,$18 + JR NIL_BYTES ; to NIL_BYTES + + ;;;$323F +T_SMALL: JR NC,X_LARGE ; to X_LARGE + + PUSH DE + CPL + ADD A,$91 + INC HL + LD D,(HL) + INC HL + LD E,(HL) + DEC HL + DEC HL + LD C,$00 + BIT 7,D + JR Z,T_NUMERIC ; to T_NUMERIC + + DEC C + + ;;;$3252 +T_NUMERIC: SET 7,D + LD B,$08 + SUB B + ADD A,B + JR C,T_TEST ; to T_TEST + + LD E,D + LD D,$00 + SUB B + + ;;;$325E +T_TEST: JR Z,T_STORE ; to T_STORE + + LD B,A + + ;;;$3261 +T_SHIFT: SRL D + RR E + DJNZ T_SHIFT ; to T_SHIFT + + ;;;$3267 +T_STORE: CALL INT_STORE ; routine INT_STORE + POP DE + RET + + ;;;$326C +T_EXPNENT: LD A,(HL) + + ;;;$326D +X_LARGE: SUB $A0 + RET P + + NEG ; Negate + + ;;;$3272 +NIL_BYTES: PUSH DE + EX DE,HL + DEC HL + LD B,A + SRL B + SRL B + SRL B + JR Z,BITS_ZERO ; to BITS_ZERO + + ;;;$327E +BYTE_ZERO: LD (HL),$00 + DEC HL + DJNZ BYTE_ZERO ; to BYTE_ZERO + + ;; BITS_ZERO +BITS_ZERO: AND $07 + JR Z,IX_END ; to IX_END + + LD B,A + LD A,$FF + + ;;;$328A +LESS_MASK: SLA A + DJNZ LESS_MASK ; to LESS_MASK + AND (HL) + LD (HL),A + + ;;;$3290 +IX_END: EX DE,HL + POP DE + RET + +; ---------------------------------- +; Storage of numbers in 5 byte form. +; ================================== +; Both integers and floating-point numbers can be stored in five bytes. +; Zero is a special case stored as 5 zeros. +; For integers the form is +; Byte 1 - zero, +; Byte 2 - sign byte, $00 +ve, $FF -ve. +; Byte 3 - Low byte of integer. +; Byte 4 - High byte +; Byte 5 - unused but always zero. +; +; it seems unusual to store the low byte first but it is just as easy either +; way. Statistically it just increases the chances of trailing zeros which +; is an advantage elsewhere in saving ROM code. +; +; zero sign low high unused +; So +1 is 00000000 00000000 00000001 00000000 00000000 +; +; and -1 is 00000000 11111111 11111111 11111111 00000000 +; +; much of the arithmetic found in basic lines can be done using numbers +; in this form using the Z80's 16 bit register operation ADD. +; (multiplication is done by a sequence of additions). +; +; Storing -ve integers in two's complement form, means that they are ready for +; addition and you might like to add the numbers above to prove that the +; answer is zero. If, as in this case, the carry is set then that denotes that +; the result is positive. This only applies when the signs don't match. +; With positive numbers a carry denotes the result is out of integer range. +; With negative numbers a carry denotes the result is within range. +; The exception to the last rule is when the result is -65536 +; +; Floating point form is an alternative method of storing numbers which can +; be used for integers and larger (or fractional) numbers. +; +; In this form 1 is stored as +; 10000001 00000000 00000000 00000000 00000000 +; +; When a small integer is converted to a floating point number the last two +; bytes are always blank so they are omitted in the following steps +; +; first make exponent +1 +16d (bit 7 of the exponent is set if positive) + +; 10010001 00000000 00000001 +; 10010000 00000000 00000010 <- now shift left and decrement exponent +; ... +; 10000010 01000000 00000000 <- until a 1 abuts the imaginary point +; 10000001 10000000 00000000 to the left of the mantissa. +; +; however since the leftmost bit of the mantissa is always set then it can +; be used to denote the sign of the mantissa and put back when needed by the +; PREP routines which gives +; +; 10000001 00000000 00000000 + +;------------------------------ +; Re-stack two `small' integers +;------------------------------ +; This routine is called to re-stack two numbers in full floating point form +; e.g. from MULTIPLY when integer multiplication has overflowed. + + ;;;$3293 +RE_ST_TWO: CALL RESTK_SUB ; routine RESTK_SUB below and continue + ; into the routine to do the other one. + + ;;;$3296 +RESTK_SUB: EX DE,HL ; swap pointers + +;--------------------------------- +; Re-stack one number in full form +;--------------------------------- +; This routine re-stacks an integer usually on the calculator stack +; in full floating point form. +; HL points to first byte. + + ;;;$3297 +RE_STACK: LD A,(HL) ; Fetch Exponent byte to A + AND A ; test it + RET NZ ; return if not zero as already in full + ; floating-point form. + PUSH DE ; preserve DE. + CALL INT_FETCH ; routine INT_FETCH + ; integer to DE, sign to C. + + ; HL points to 4th byte. + + XOR A ; clear accumulator. + INC HL ; point to 5th. + LD (HL),A ; and blank. + DEC HL ; point to 4th. + LD (HL),A ; and blank. + LD B,$91 ; set exponent byte +ve $81 + ; and imaginary dec point 16 bits to right + ; of first bit. + + ; we could skip to normalize now but it's quicker to avoid + ; normalizing through an empty D. + + LD A,D ; fetch the high byte D + AND A ; is it zero ? + JR NZ,RS_NRMLSE ; skip to RS_NRMLSE if not. + + OR E ; low byte E to A and test for zero + LD B,D ; set B exponent to 0 + JR Z,RS_STORE ; forward to RS_STORE if value is zero. + + LD D,E ; transfer E to D + LD E,B ; set E to 0 + LD B,$89 ; reduce the initial exponent by eight. + + + ;;;$32B1 +RS_NRMLSE: EX DE,HL ; integer to HL, addr of 4th byte to DE. + + ;;;$32B2 +RSTK_LOOP: DEC B ; decrease exponent + ADD HL,HL ; shift DE left + JR NC,RSTK_LOOP ; loop back to RSTK_LOOP + ; until a set bit pops into carry + RRC C ; now rotate the sign byte $00 or $FF + ; into carry to give a sign bit + RR H ; rotate the sign bit to left of H + RR L ; rotate any carry into L + EX DE,HL ; address 4th byte, normalized int to DE + + ;;;$32BD +RS_STORE: DEC HL ; address 3rd byte + LD (HL),E ; place E + DEC HL ; address 2nd byte + LD (HL),D ; place D + DEC HL ; address 1st byte + LD (HL),B ; store the exponent + + POP DE ; restore initial DE. + RET ; return. + +;**************************************** +;** Part 10. FLOATING-POINT CALCULATOR ** +;**************************************** + +; As a general rule the calculator avoids using the IY register. +; exceptions are VAL, VAL$ and STR$. +; So an assembly language programmer who has disabled interrupts to use +; IY for other purposes can still use the calculator for mathematical +; purposes. + + +;------------------- +; Table of constants +;------------------- + +; used 11 times + ;;;$32C5 00 00 00 00 00 +STK_ZERO: DEFB $00 ;;Bytes: 1 + DEFB $B0 ;;Exponent $00 + DEFB $00 ;;(+00,+00,+00) + +; used 19 times + ;;;$32C8 00 00 01 00 00 +STK_ONE: DEFB $40 ;;Bytes: 2 + DEFB $B0 ;;Exponent $00 + DEFB $00,$01 ;;(+00,+00) + +; used 9 times + ;;;$32CC 80 00 00 00 00 +STK_HALF: DEFB $30 ;;Exponent: $80, Bytes: 1 + DEFB $00 ;;(+00,+00,+00) + +; used 4 times + ;;;$32CE + ;; stk-pi/2 81 49 0F DA A2 +STK_PI_2: DEFB $F1 ;;Exponent: $81, Bytes: 4 + DEFB $49,$0F,$DA,$A2 + +; used 3 times + ;;;$32D3 00 00 0A 00 00 +STK_TEN: DEFB $40 ;;Bytes: 2 + DEFB $B0 ;;Exponent $00 + DEFB $00,$0A ;;(+00,+00) + + +;------------------- +; Table of addresses +;------------------- +; +; starts with binary operations which have two operands and one result. +; three pseudo binary operations first. + + ;;;$32D7 +TBL_ADDRS: DEFW JUMP_TRUE ; $00 Address: $368F - JUMP_TRUE + DEFW EXCHANGE ; $01 Address: $343C - EXCHANGE + DEFW DELETE ; $02 Address: $33A1 - DELETE + + ; true binary operations. + + DEFW SUBTRACT ; $03 Address: $300F - SUBTRACT + DEFW MULTIPLY ; $04 Address: $30CA - MULTIPLY + DEFW DIVISION ; $05 Address: $31AF - DIVISION + DEFW TO_POWER ; $06 Address: $3851 - TO_POWER + DEFW OR_ ; $07 Address: $351B - OR + + DEFW NO_AND_NO ; $08 Address: $3524 - NO_AND_NO + DEFW NO_L_EQL ; $09 Address: $353B - NO_L_EQL + DEFW NO_GR_EQL ; $0A Address: $353B - NO_GR_EQL + DEFW NOS_NEQL ; $0B Address: $353B - NOS_NEQL + DEFW NO_GRTR ; $0C Address: $353B - NO_GRTR + DEFW NO_LESS ; $0D Address: $353B - NO_LESS + DEFW NOS_EQL ; $0E Address: $353B - NOS_EQL + DEFW ADDITION ; $0F Address: $3014 - ADDITION + + DEFW STR_AND_NO ; $10 Address: $352D - STR_AND_NO + DEFW STR_L_EQL ; $11 Address: $353B - STR_L_EQL + DEFW STR_GR_EQL ; $12 Address: $353B - STR_GR_EQL + DEFW STRS_NEQL ; $13 Address: $353B - STRS_NEQL + DEFW STR_GRTR ; $14 Address: $353B - STR_GRTR + DEFW STR_LESS ; $15 Address: $353B - STR_LESS + DEFW STRS_EQL ; $16 Address: $353B - STRS_EQL + DEFW STRS_ADD ; $17 Address: $359C - STRS_ADD + + ; unary follow + + DEFW VALS ; $18 Address: $35DE - VAL$ + DEFW USR_ ; $19 Address: $34BC - USR-$ + DEFW READ_IN ; $1A Address: $3645 - READ_IN + DEFW NEGATE ; $1B Address: $346E - NEGATE + + DEFW CODE ; $1C Address: $3669 - CODE + DEFW VAL ; $1D Address: $35DE - VAL + DEFW LEN ; $1E Address: $3674 - LEN + DEFW SIN_ ; $1F Address: $37B5 - SIN + DEFW COS_ ; $20 Address: $37AA - COS + DEFW TAN ; $21 Address: $37DA - TAN + DEFW ASN ; $22 Address: $3833 - ASN + DEFW ACS ; $23 Address: $3843 - ACS + DEFW ATN ; $24 Address: $37E2 - ATN + DEFW LN ; $25 Address: $3713 - LN + DEFW EXP ; $26 Address: $36C4 - EXP + DEFW INT ; $27 Address: $36AF - INT + DEFW SQR ; $28 Address: $384A - SQR + DEFW SGN ; $29 Address: $3492 - SGN + DEFW ABS ; $2A Address: $346A - ABS + DEFW PEEK ; $2B Address: $34AC - PEEK + DEFW IN_ ; $2C Address: $34A5 - IN + DEFW USR_NO ; $2D Address: $34B3 - USR_NO + DEFW STRS ; $2E Address: $361F - STR$ + DEFW CHRS ; $2F Address: $35C9 - CHR$ + DEFW NOT_ ; $30 Address: $3501 - NOT + + ; end of true unary + + DEFW DUPLICATE ; $31 Address: $33C0 - DUPLICATE + DEFW N_MOD_M ; $32 Address: $36A0 - N_MOD_M + DEFW JUMP ; $33 Address: $3686 - JUMP + DEFW STK_DATA ; $34 Address: $33C6 - STK_DATA + DEFW DEC_JR_NZ ; $35 Address: $367A - DEC_JR_NZ + DEFW LESS_0 ; $36 Address: $3506 - LESS_0 + DEFW GREATER_0 ; $37 Address: $34F9 - GREATER_0 + DEFW END_CALC ; $38 Address: $369B - END_CALC + DEFW GET_ARGT ; $39 Address: $3783 - GET_ARGT + DEFW TRUNCATE ; $3A Address: $3214 - TRUNCATE + DEFW FP_CALC_2 ; $3B Address: $33A2 - FP_CALC_2 + DEFW E_TO_FP ; $3C Address: $2D4F - E_TO_FP + DEFW RE_STACK ; $3D Address: $3297 - RE_STACK + + ; the following are just the next available slots for the 128 compound literals + ; which are in range $80 - $FF. + + DEFW SERIES_XX ; $3E Address: $3449 - SERIES_XX $80 - $9F. + DEFW STK_CONST_XX ; $3F Address: $341B - STK_CONST_XX $A0 - $BF. + DEFW ST_MEM_XX ; $40 Address: $342D - ST_MEM_XX $C0 - $DF. + DEFW GET_MEM_XX ; $41 Address: $340F - GET_MEM_XX $E0 - $FF. + + ; Aside: $3E - $7F are therefore unused calculator literals. + ; $3E - $7B would be available for expansion. + +;--------------- +; The Calculator +;--------------- + + ;;;$335B +CALCULATE: CALL STK_PNTRS ; routine STK_PNTRS is called to set up the + ; calculator stack pointers for a default + ; unary operation. HL = last value on stack. + ; DE = STKEND first location after stack. + + ; the calculate routine is called at this point by the series generator... + + ;;;$335E +GEN_ENT_1: LD A,B ; fetch the Z80 B register to A + LD (BREG),A ; and store value in system variable BREG. + ; this will be the counter for DEC_JR_NZ + ; or if used from FP_CALC2 the calculator + ; instruction. + + ; ... and again later at this point + + ;;;$3362 +GEN_ENT_2: EXX ; switch sets + EX (SP),HL ; and store the address of next instruction, + ; the return address, in H'L'. + ; If this is a recursive call the the H'L' + ; of the previous invocation goes on stack. + ; c.f. END_CALC. + EXX ; switch back to main set + + ; this is the re-entry looping point when handling a string of literals. + + ;;;$3365 +RE_ENTRY: LD (STKEND),DE ; save end of stack in system variable STKEND + EXX ; switch to alt + LD A,(HL) ; get next literal + INC HL ; increase pointer' + + ; single operation jumps back to here + + ;;;$336C +SCAN_ENT: PUSH HL ; save pointer on stack + AND A ; now test the literal + JP P,FIRST_3D ; forward to FIRST_3D if in range $00 - $3D + ; anything with bit 7 set will be one of + ; 128 compound literals. + + ; compound literals have the following format. + ; bit 7 set indicates compound. + ; bits 6-5 the subgroup 0-3. + ; bits 4-0 the embedded parameter $00 - $1F. + ; The subgroup 0-3 needs to be manipulated to form the next available four + ; address places after the simple literals in the address table. + + LD D,A ; save literal in D + AND $60 ; and with 01100000 to isolate subgroup + RRCA ; rotate bits + RRCA ; 4 places to right + RRCA ; not five as we need offset * 2 + RRCA ; 00000xx0 + ADD A,$7C ; add ($3E * 2) to give correct offset. + ; alter above if you add more literals. + LD L,A ; store in L for later indexing. + LD A,D ; bring back compound literal + AND $1F ; use mask to isolate parameter bits + JR ENT_TABLE ; forward to ENT_TABLE + + ; the branch was here with simple literals. + + ;;;$3380 +FIRST_3D: CP $18 ; compare with first unary operations. + JR NC,DOUBLE_A ; to DOUBLE_A with unary operations + + ; it is binary so adjust pointers. + + EXX + LD BC,$FFFB ; the value -5 + LD D,H ; transfer HL, the last value, to DE. + LD E,L + ADD HL,BC ; subtract 5 making HL point to second value. + EXX + + ;;;$338C +DOUBLE_A: RLCA ; double the literal + LD L,A ; and store in L for indexing + + ;;;$338E +ENT_TABLE: LD DE,TBL_ADDRS ; Address: TBL_ADDRS + LD H,$00 ; prepare to index + ADD HL,DE ; add to get address of routine + LD E,(HL) ; low byte to E + INC HL + LD D,(HL) ; high byte to D + LD HL,RE_ENTRY ; Address: RE_ENTRY + EX (SP),HL ; goes to stack + PUSH DE ; now address of routine + EXX ; main set + ; avoid using IY register. + LD BC,(STKEND_HI) ; STKEND_hi + ; nothing much goes to C but BREG to B + ; and continue into next ret instruction + ; which has a dual identity + + +;-------------------- +; Handle delete ($02) +;-------------------- +; A simple return but when used as a calculator literal this +; deletes the last value from the calculator stack. +; On entry, as always with binary operations, +; HL=first number, DE=second number +; On exit, HL=result, DE=stkend. +; So nothing to do + + ;;;$33A1 +DELETE: RET ; return - indirect jump if from above. + +;----------------------- +; Single operation ($3B) +;----------------------- +; this single operation is used, in the first instance, to evaluate most +; of the mathematical and string functions found in Basic expressions. + + ;;;$33A2 +FP_CALC_2: POP AF ; drop return address. + LD A,(BREG) ; load accumulator from system variable BREG + ; value will be literal eg. 'TAN' + EXX ; switch to alt + JR SCAN_ENT ; back to SCAN_ENT + ; next literal will be END_CALC at $2758 + +;----------------- +; Test five-spaces +;----------------- +; This routine is called from MOVE_FP, STK_CONST and STK_STORE to +; test that there is enough space between the calculator stack and the +; machine stack for another five-byte value. It returns with BC holding +; the value 5 ready for any subsequent LDIR. + + ;;;$33A9 +TEST_5_SP: PUSH DE ; save + PUSH HL ; registers + LD BC,$0005 ; an overhead of five bytes + CALL TEST_ROOM ; routine TEST_ROOM tests free RAM raising an error if not. + POP HL ; else restore + POP DE ; registers. + RET ; return with BC set at 5. + +;------------- +; Stack number +;------------- +; This routine is called to stack a hidden floating point number found in +; a Basic line. It is also called to stack a numeric variable value, and +; from BEEP, to stack an entry in the semi-tone table. It is not part of the +; calculator suite of routines. +; On entry HL points to the number to be stacked. + + ;;;$33B4 +STACK_NUM: LD DE,(STKEND) ; load destination from STKEND system variable. + CALL MOVE_FP ; routine MOVE_FP puts on calculator stack with a memory check. + LD (STKEND),DE ; set STKEND to next free location. + RET ; return. + +;----------------------------------- +; Move a floating point number ($31) +;----------------------------------- +; This simple routine is a 5-byte LDIR instruction +; that incorporates a memory check. +; When used as a calculator literal it duplicates the last value on the +; calculator stack. +; Unary so on entry HL points to last value, DE to stkend + + ;;;$33C0 +DUPLICATE: +MOVE_FP: CALL TEST_5_SP ; routine TEST_5_SP test free memory and sets BC to 5. + LDIR ; copy the five bytes. + RET ; return with DE addressing new STKEND + ; and HL addressing new last value. + +;--------------------- +; Stack literals ($34) +;--------------------- +; When a calculator subroutine needs to put a value on the calculator +; stack that is not a regular constant this routine is called with a +; variable number of following data bytes that convey to the routine +; the integer or floating point form as succinctly as is possible. + + ;;;$33C6 +STK_DATA: LD H,D ; transfer STKEND + LD L,E ; to HL for result. + + ;;;$33C8 +STK_CONST: CALL TEST_5_SP ; routine TEST_5_SP tests that room exists + ; and sets BC to $05. + EXX ; switch to alternate set + PUSH HL ; save the pointer to next literal on stack + EXX ; switch back to main set + EX (SP),HL ; pointer to HL, destination to stack. + PUSH BC ; save BC - value 5 from test room ??. + LD A,(HL) ; fetch the byte following 'STK_DATA' + AND $C0 ; isolate bits 7 and 6 + RLCA ; rotate + RLCA ; to bits 1 and 0 range $00 - $03. + LD C,A ; transfer to C + INC C ; and increment to give number of bytes + ; to read. $01 - $04 + LD A,(HL) ; reload the first byte + AND $3F ; mask off to give possible exponent. + JR NZ,FORM_EXP ; forward to FORM_EXP if it was possible to + ; include the exponent. + + ; else byte is just a byte count and exponent comes next. + + INC HL ; address next byte and + LD A,(HL) ; pick up the exponent ( - $50). + + ;;;$33DE +FORM_EXP: ADD A,$50 ; now add $50 to form actual exponent + LD (DE),A ; and load into first destination byte. + LD A,$05 ; load accumulator with $05 and + SUB C ; subtract C to give count of trailing zeros plus one. + INC HL ; increment source + INC DE ; increment destination + LD B,$00 ; prepare to copy + LDIR ; copy C bytes + POP BC ; restore 5 counter to BC ??. + EX (SP),HL ; put HL on stack as next literal pointer + ; and the stack value - result pointer - to HL. + EXX ; switch to alternate set. + POP HL ; restore next literal pointer from stack to H'L'. + EXX ; switch back to main set. + LD B,A ; zero count to B + XOR A ; clear accumulator + + ;;;$33F1 +STK_ZEROS: DEC B ; decrement B counter + RET Z ; return if zero. >> + ; DE points to new STKEND + ; HL to new number. + + LD (DE),A ; else load zero to destination + INC DE ; increase destination + JR STK_ZEROS ; loop back to STK_ZEROS until done. + +;--------------- +; Skip constants +;--------------- +; This routine traverses variable-length entries in the table of constants, +; stacking intermediate, unwanted constants onto a dummy calculator stack, +; in the first five bytes of ROM. + + ;;;$33F7 +SKIP_CONS: AND A ; test if initially zero. + + ;;;$33F8 +SKIP_NEXT: RET Z ; return if zero. >> + + PUSH AF ; save count. + PUSH DE ; and normal STKEND + LD DE,$0000 ; dummy value for STKEND at start of ROM + ; Note. not a fault but this has to be + ; moved elsewhere when running in RAM. + ; e.g. with Expandor Systems 'Soft Rom'. + CALL STK_CONST ; routine STK_CONST works through variable length records. + POP DE ; restore real STKEND + POP AF ; restore count + DEC A ; decrease + JR SKIP_NEXT ; loop back to SKIP_NEXT + +;---------------- +; Memory location +;---------------- +; This routine, when supplied with a base address in HL and an index in A +; will calculate the address of the A'th entry, where each entry occupies +; five bytes. It is used for reading the semi-tone table and addressing +; floating-point numbers in the calculator's memory area. + + ;;;$3406 +LOC_MEM: LD C,A ; store the original number $00-$1F. + RLCA ; double. + RLCA ; quadruple. + ADD A,C ; now add original to multiply by five. + LD C,A ; place the result in C. + LD B,$00 ; set B to 0. + ADD HL,BC ; add to form address of start of number in HL. + RET ; return. + +;-------------------------------- +; Get from memory area ($E0 etc.) +;-------------------------------- +; Literals $E0 to $FF +; A holds $00-$1F offset. +; The calculator stack increases by 5 bytes. + + ;;;$340F +GET_MEM_XX: PUSH DE ; save STKEND + LD HL,(MEM) ; MEM is base address of the memory cells. + CALL LOC_MEM ; routine LOC_MEM so that HL = first byte + CALL MOVE_FP ; routine MOVE_FP moves 5 bytes with memory check. + ; DE now points to new STKEND. + POP HL ; original STKEND is now RESULT pointer. + RET ; return. + +;---------------------------- +; Stack a constant ($A0 etc.) +;---------------------------- +; This routine allows a one-byte instruction to stack up to 32 constants +; held in short form in a table of constants. In fact only 5 constants are +; required. On entry the A register holds the literal ANDed with 1F. +; It isn't very efficient and it would have been better to hold the +; numbers in full, five byte form and stack them in a similar manner +; to that used for semi-tone table values. + + ;;;$341B +STK_CONST_XX: LD H,D ; save STKEND - required for result + LD L,E + EXX ; swap + PUSH HL ; save pointer to next literal + LD HL,STK_ZERO ; Address: STK_ZERO - start of table of constants + EXX + CALL SKIP_CONS ; routine SKIP_CONS + CALL STK_CONST ; routine STK_CONST + EXX + POP HL ; restore pointer to next literal. + EXX + RET ; return. + +;---------------------------------- +; Store in a memory area ($C0 etc.) +;---------------------------------- +; Offsets $C0 to $DF +; Although 32 memory storage locations can be addressed, only six +; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5) +; required for these are allocated. Spectrum programmers who wish to +; use the floating point routines from assembly language may wish to +; alter the system variable MEM to point to 160 bytes of RAM to have +; use the full range available. +; A holds derived offset $00-$1F. +; Unary so on entry HL points to last value, DE to STKEND. + + ;;;$342D +ST_MEM_XX: PUSH HL ; save the result pointer. + EX DE,HL ; transfer to DE. + LD HL,(MEM) ; fetch MEM the base of memory area. + CALL LOC_MEM ; routine LOC_MEM sets HL to the destination. + EX DE,HL ; swap - HL is start, DE is destination. + CALL MOVE_FP ; routine MOVE_FP. + ; note. a short ld bc,5; ldir + ; the embedded memory check is not required + ; so these instructions would be faster. + EX DE,HL ; DE = STKEND + POP HL ; restore original result pointer + RET ; return. + +;------------------------------------- +; Swap first number with second number +;------------------------------------- +; This routine exchanges the last two values on the calculator stack +; On entry, as always with binary operations, +; HL=first number, DE=second number +; On exit, HL=result, DE=stkend. + + ;;;$343C +EXCHANGE: LD B,$05 ; there are five bytes to be swapped + + ; start of loop. + + ;;;$343E +SWAP_BYTE: LD A,(DE) ; each byte of second + LD C,(HL) ; each byte of first + EX DE,HL ; swap pointers + LD (DE),A ; store each byte of first + LD (HL),C ; store each byte of second + INC HL ; advance both + INC DE ; pointers. + DJNZ SWAP_BYTE ; loop back to SWAP_BYTE until all 5 done. + EX DE,HL ; even up the exchanges + ; so that DE addresses STKEND. + RET ; return. + +;---------------------------- +; Series generator ($86 etc.) +;---------------------------- +; The Spectrum uses Chebyshev polynomials to generate approximations for +; SIN, ATN, LN and EXP. These are named after the Russian mathematician +; Pafnuty Chebyshev, born in 1821, who did much pioneering work on numerical +; series. As far as calculators are concerned, Chebyshev polynomials have an +; advantage over other series, for example the Taylor series, as they can +; reach an approximation in just six iterations for SIN, eight for EXP and +; twelve for LN and ATN. The mechanics of the routine are interesting but +; for full treatment of how these are generated with demonstrations in +; Sinclair Basic see "The Complete Spectrum ROM Disassembly" by Dr Ian Logan +; and Dr Frank O'Hara, published 1983 by Melbourne House. + + ;;;$3449 +SERIES_XX: LD B,A ; parameter $00 - $1F to B counter + CALL GEN_ENT_1 ; routine GEN_ENT_1 is called. + ; A recursive call to a special entry point + ; in the calculator that puts the B register + ; in the system variable BREG. The return + ; address is the next location and where + ; the calculator will expect it's first + ; instruction - now pointed to by HL'. + ; The previous pointer to the series of + ; five-byte numbers goes on the machine stack. + + ; The initialization phase. + + DEFB $31 ;;DUPLICATE x,x + DEFB $0F ;;ADDITION x+x + DEFB $C0 ;;st-mem-0 x+x + DEFB $02 ;;DELETE . + DEFB $A0 ;;STK_ZERO 0 + DEFB $C2 ;;st-mem-2 0 + + ; a loop is now entered to perform the algebraic calculation for each of + ; the numbers in the series + + ;; G_LOOP +G_LOOP: DEFB $31 ;;DUPLICATE v,v. + DEFB $E0 ;;get-mem-0 v,v,x+2 + DEFB $04 ;;MULTIPLY v,v*x+2 + DEFB $E2 ;;get-mem-2 v,v*x+2,v + DEFB $C1 ;;st-mem-1 + DEFB $03 ;;SUBTRACT + DEFB $38 ;;END_CALC + + ; the previous pointer is fetched from the machine stack to H'L' where it + ; addresses one of the numbers of the series following the series literal. + + CALL STK_DATA ; routine STK_DATA is called directly to + ; push a value and advance H'L'. + CALL GEN_ENT_2 ; routine GEN_ENT_2 recursively re-enters + ; the calculator without disturbing + ; system variable BREG + ; H'L' value goes on the machine stack and is + ; then loaded as usual with the next address. + + DEFB $0F ;;ADDITION + DEFB $01 ;;EXCHANGE + DEFB $C2 ;;st-mem-2 + DEFB $02 ;;DELETE + + DEFB $35 ;;DEC_JR_NZ + DEFB $EE ;;back to G_LOOP + + ; when the counted loop is complete the final subtraction yields the result + ; for example SIN X. + + DEFB $E1 ;;get-mem-1 + DEFB $03 ;;SUBTRACT + DEFB $38 ;;END_CALC + + RET ; return with H'L' pointing to location + ; after last number in series. + +;------------------------- +; Absolute magnitude ($2A) +;------------------------- +; This calculator literal finds the absolute value of the last value, +; integer or floating point, on calculator stack. + + ;;;$346A +ABS: LD B,$FF ; signal abs + JR NEG_TEST ; forward to NEG_TEST + +;------------------------- +; Handle unary minus ($1B) +;------------------------- +; Unary so on entry HL points to last value, DE to STKEND. + + ;;;$346E +NEGATE: CALL TEST_ZERO ; call routine TEST_ZERO and + RET C ; return if so leaving zero unchanged. + + LD B,$00 ; signal negate required before joining + ; common code. + + ;;;$3474 +NEG_TEST: LD A,(HL) ; load first byte and + AND A ; test for zero + JR Z,INT_CASE ; forward to INT_CASE if a small integer + + ; for floating point numbers a single bit denotes the sign. + + INC HL ; address the first byte of mantissa. + LD A,B ; action flag $FF=abs, $00=neg. + AND $80 ; now $80 $00 + OR (HL) ; sets bit 7 for abs + RLA ; sets carry for abs and if number negative + CCF ; complement carry flag + RRA ; and rotate back in altering sign + LD (HL),A ; put the altered adjusted number back + DEC HL ; HL points to result + RET ; return with DE unchanged + + ; for integer numbers an entire byte denotes the sign. + + ;;;$3483 +INT_CASE: PUSH DE ; save STKEND. + PUSH HL ; save pointer to the last value/result. + CALL INT_FETCH ; routine INT_FETCH puts integer in DE and the sign in C. + POP HL ; restore the result pointer. + LD A,B ; $FF=abs, $00=neg + OR C ; $FF for abs, no change neg + CPL ; $00 for abs, switched for neg + LD C,A ; transfer result to sign byte. + CALL INT_STORE ; routine INT_STORE to re-write the integer. + POP DE ; restore STKEND. + RET ; return. + +;------------- +; Signum ($29) +;------------- +; This routine replaces the last value on the calculator stack, +; which may be in floating point or integer form, with the integer values +; zero if zero, with one if positive and with -minus one if negative. + + ;;;$3492 +SGN: CALL TEST_ZERO ; call routine TEST_ZERO and + RET C ; exit if so as no change is required. + PUSH DE ; save pointer to STKEND. + LD DE,$0001 ; the result will be 1. + INC HL ; skip over the exponent. + RL (HL) ; rotate the sign bit into the carry flag. + DEC HL ; step back to point to the result. + SBC A,A ; byte will be $FF if negative, $00 if positive. + LD C,A ; store the sign byte in the C register. + CALL INT_STORE ; routine INT_STORE to overwrite the last value with 0001 and sign. + POP DE ; restore STKEND. + RET ; return. + +;------------------------- +; Handle IN function ($2C) +;------------------------- +; This function reads a byte from an input port. + + ;;;$34A5 +IN_: CALL FIND_INT2 ; routine FIND_INT2 puts port address in BC. + ; all 16 bits are put on the address line. + IN A,(C) ; read the port. + JR IN_PK_STK ; exit to STACK_A (via IN_PK_STK to save a byte + ; of instruction code). + +;-------------------------- +; Handle PEEK function ($2B) +;-------------------------- +; This function returns the contents of a memory address. +; The entire address space can be peeked including the ROM. + + ;;;$34AC +PEEK: CALL FIND_INT2 ; routine FIND_INT2 puts address in BC. + LD A,(BC) ; load contents into A register. + + ;;;$34B0 +IN_PK_STK: JP STACK_A ; exit via STACK_A to put value on the + ; calculator stack. + +;----------------- +; USR number ($2D) +;----------------- +; The USR function followed by a number 0-65535 is the method by which +; the Spectrum invokes machine code programs. This function returns the +; contents of the BC register pair. +; Note. that STACK_BC re-initializes the IY register if a user-written +; program has altered it. + + ;; USR_NO +USR_NO: CALL FIND_INT2 ; routine FIND_INT2 to fetch the supplied address into BC. + LD HL,STACK_BC ; address: STACK_BC is + PUSH HL ; pushed onto the machine stack. + PUSH BC ; then the address of the machine code routine. + RET ; make an indirect jump to the routine + ; and, hopefully, to STACK_BC also. + +;----------------- +; USR string ($19) +;----------------- +; The user function with a one-character string argument, calculates the +; address of the User Defined Graphic character that is in the string. +; As an alternative, the ascii equivalent, upper or lower case, +; may be supplied. This provides a user-friendly method of redefining +; the 21 User Definable Graphics e.g. +; POKE USR "a", BIN 10000000 will put a dot in the top left corner of the +; character 144. +; Note. the curious double check on the range. With 26 UDGs the first check +; only is necessary. With anything less the second check only is required. +; It is highly likely that the first check was written by Steven Vickers. + + ;;;$34BC +USR_: CALL STK_FETCH ; routine STK_FETCH fetches the string parameters. + DEC BC ; decrease BC by + LD A,B ; one to test + OR C ; the length. + JR NZ,REPORT_A ; to REPORT_A if not a single character. + + LD A,(DE) ; fetch the character + CALL ALPHA ; routine ALPHA sets carry if 'A-Z' or 'a-z'. + JR C,USR_RANGE ; forward to USR_RANGE if ascii. + + SUB $90 ; make udgs range 0-20d + JR C,REPORT_A ; to REPORT_A if too low. e.g. usr " ". + + CP $15 ; Note. this test is not necessary. + JR NC,REPORT_A ; to REPORT_A if higher than 20. + + INC A ; make range 1-21d to match LSBs of ascii + + ;;;$34D3 +USR_RANGE: DEC A ; make range of bits 0-4 start at zero + ADD A,A ; multiply by eight + ADD A,A ; and lose any set bits + ADD A,A ; range now 0 - 25*8 + CP $A8 ; compare to 21*8 + JR NC,REPORT_A ; to REPORT_A if originally higher + ; than 'U','u' or graphics U. + LD BC,(UDG) ; fetch the UDG system variable value. + ADD A,C ; add the offset to character + LD C,A ; and store back in register C. + JR NC,USR_STACK ; forward to USR_STACK if no overflow. + + INC B ; increment high byte. + + ;;;$34E4 +USR_STACK: JP STACK_BC ; jump back and exit via STACK_BC to store + + ;;;$34E7 +REPORT_A: RST 08H ; ERROR_1 + DEFB $09 ; Error Report: Invalid argument + +;-------------- +; Test for zero +;-------------- +; Test if top value on calculator stack is zero. +; The carry flag is set if the last value is zero but no registers are altered. +; All five bytes will be zero but first four only need be tested. +; On entry HL points to the exponent the first byte of the value. + + ;;;$34E9 +TEST_ZERO: PUSH HL ; preserve HL which is used to address. + PUSH BC ; preserve BC which is used as a store. + LD B,A ; preserve A in B. + LD A,(HL) ; load first byte to accumulator + INC HL ; advance. + OR (HL) ; OR with second byte and clear carry. + INC HL ; advance. + OR (HL) ; OR with third byte. + INC HL ; advance. + OR (HL) ; OR with fourth byte. + LD A,B ; restore A without affecting flags. + POP BC ; restore the saved + POP HL ; registers. + RET NZ ; return if not zero and with carry reset. + + SCF ; set the carry flag. + RET ; return with carry set if zero. + +;------------------------ +; Greater than zero ($37) +;------------------------ +; Test if the last value on the calculator stack is greater than zero. +; This routine is also called directly from the end-tests of the comparison +; routine. + + ;;;$34F9 +GREATER_0: CALL TEST_ZERO ; routine TEST_ZERO + RET C ; return if was zero as this + ; is also the Boolean 'false' value. + LD A,$FF ; prepare XOR mask for sign bit + JR SIGN_TO_C ; forward to SIGN_TO_C + ; to put sign in carry + ; (carry will become set if sign is positive) + ; and then overwrite location with 1 or 0 + ; as appropriate. + +;-------------------------- +; Handle NOT operator ($30) +;-------------------------- +; This overwrites the last value with 1 if it was zero else with zero +; if it was any other value. +; +; e.g NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0. +; +; The subroutine is also called directly from the end-tests of the comparison +; operator. + + ;;;$3501 +NOT_: CALL TEST_ZERO ; routine TEST_ZERO sets carry if zero + JR FP_0_1 ; to FP_0_1 to overwrite operand with + ; 1 if carry is set else to overwrite with zero. + +;--------------------- +; Less than zero ($36) +;--------------------- +; Destructively test if last value on calculator stack is less than zero. +; Bit 7 of second byte will be set if so. + + ;;;$3506 +LESS_0: XOR A ; set xor mask to zero + ; (carry will become set if sign is negative). + + ; transfer sign of mantissa to Carry Flag. + + ;;;$3507 +SIGN_TO_C: INC HL ; address 2nd byte. + XOR (HL) ; bit 7 of HL will be set if number is negative. + DEC HL ; address 1st byte again. + RLCA ; rotate bit 7 of A to carry. + +;------------ +; Zero or one +;------------ +; This routine places an integer value zero or one at the addressed location +; of calculator stack or MEM area. The value one is written if carry is set on +; entry else zero. + + ;;;$350B + ;; FP-0/1 +FP_0_1: PUSH HL ; save pointer to the first byte + LD A,$00 ; load accumulator with zero - without disturbing flags. + LD (HL),A ; zero to first byte + INC HL ; address next + LD (HL),A ; zero to 2nd byte + INC HL ; address low byte of integer + RLA ; carry to bit 0 of A + LD (HL),A ; load one or zero to low byte. + RRA ; restore zero to accumulator. + INC HL ; address high byte of integer. + LD (HL),A ; put a zero there. + INC HL ; address fifth byte. + LD (HL),A ; put a zero there. + POP HL ; restore pointer to the first byte. + RET ; return. + +;------------------------- +; Handle OR operator ($07) +;------------------------- +; The Boolean OR operator. eg. X OR Y +; The result is zero if both values are zero else a non-zero value. +; +; e.g. 0 OR 0 returns 0. +; -3 OR 0 returns -3. +; 0 OR -3 returns 1. +; -3 OR 2 returns 1. +; +; A binary operation. +; On entry HL points to first operand (X) and DE to second operand (Y). + + ;;;$351B +OR_: EX DE,HL ; make HL point to second number + CALL TEST_ZERO ; routine TEST_ZERO + EX DE,HL ; restore pointers + RET C ; return if result was zero - first operand, + ; now the last value, is the result. + SCF ; set carry flag + JR FP_0_1 ; back to FP_0_1 to overwrite the first operand + ; with the value 1. + + +;------------------------------- +; Handle number AND number ($08) +;------------------------------- +; The Boolean AND operator. +; +; e.g. -3 AND 2 returns -3. +; -3 AND 0 returns 0. +; 0 AND -2 returns 0. +; 0 AND 0 returns 0. +; +; Compare with OR routine above. + + ;;;$3524 +NO_AND_NO: EX DE,HL ; make HL address second operand. + CALL TEST_ZERO ; routine TEST_ZERO sets carry if zero. + EX DE,HL ; restore pointers. + RET NC ; return if second non-zero, first is result. + + AND A ; else clear carry. + JR FP_0_1 ; back to FP_0_1 to overwrite first operand + ; with zero for return value. + +;------------------------------- +; Handle string AND number ($10) +;------------------------------- +; e.g. "You Win" AND score>99 will return the string if condition is true +; or the null string if false. + + ;;;$352D +STR_AND_NO: EX DE,HL ; make HL point to the number. + CALL TEST_ZERO ; routine TEST_ZERO. + EX DE,HL ; restore pointers. + RET NC ; return if number was not zero - the string is the result. + + ; if the number was zero (false) then the null string must be returned by + ; altering the length of the string on the calculator stack to zero. + + PUSH DE ; save pointer to the now obsolete number + ; (which will become the new STKEND) + DEC DE ; point to the 5th byte of string descriptor. + XOR A ; clear the accumulator. + LD (DE),A ; place zero in high byte of length. + DEC DE ; address low byte of length. + LD (DE),A ; place zero there - now the null string. + POP DE ; restore pointer - new STKEND. + RET ; return. + +;------------------------------------ +; Perform comparison ($09-$0E, $11-$16) +;------------------------------------ +; True binary operations. +; +; A single entry point is used to evaluate six numeric and six string +; comparisons. On entry, the calculator literal is in the B register and +; the two numeric values, or the two string parameters, are on the +; calculator stack. +; The individual bits of the literal are manipulated to group similar +; operations although the SUB 8 instruction does nothing useful and merely +; alters the string test bit. +; Numbers are compared by subtracting one from the other, strings are +; compared by comparing every character until a mismatch, or the end of one +; or both, is reached. +; +; Numeric Comparisons. +; -------------------- +; The 'x>y' example is the easiest as it employs straight-thru logic. +; Number y is subtracted from x and the result tested for GREATER_0 yielding +; a final value 1 (true) or 0 (false). +; For 'x0? NOT +; NO_GR_EQL x>=y 0A 00000010 dec 00000001 10000000c swap y-x ? --- >0? NOT +; NOS_NEQL x<>y 0B 00000011 dec 00000010 00000001 ---- x-y ? NOT --- NOT +; NO_GRTR x>y 0C 00000100 - 00000100 00000010 ---- x-y ? --- >0? --- +; NO_LESS x0? --- +; NOS_EQL x=y 0E 00000110 - 00000110 00000011 ---- x-y ? NOT --- --- +; +; comp -> C/F +; ==== === +; STR_L_EQL x$<=y$ 11 00001001 dec 00001000 00000100 ---- x$y$ 0 !or >0? NOT +; STR_GR_EQL x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0 !or >0? NOT +; STRS_NEQL x$<>y$ 13 00001011 dec 00001010 00000101 ---- x$y$ 0 !or >0? NOT +; STR_GRTR x$>y$ 14 00001100 - 00001100 00000110 ---- x$y$ 0 !or >0? --- +; STR_LESS x$0? --- +; STRS_EQL x$=y$ 16 00001110 - 00001110 00000111 ---- x$y$ 0 !or >0? --- +; +; String comparisons are a little different in that the eql/neql carry flag +; from the 2nd RRCA is, as before, fed into the first of the end tests but +; along the way it gets modified by the comparison process. The result on the +; stack always starts off as zero and the carry fed in determines if NOT is +; applied to it. So the only time the GREATER_0 test is applied is if the +; stack holds zero which is not very efficient as the test will always yield +; zero. The most likely explanation is that there were once separate end tests +; for numbers and strings. + + ;;;$353B +NO_L_EQL: +NO_GR_EQL: +NOS_NEQL: +NO_GRTR: +NO_LESS: +NOS_EQL: + +STR_L_EQL: +STR_GR_EQL: +STRS_NEQL: +STR_GRTR: +STR_LESS: +STRS_EQL: + + LD A,B ; transfer literal to accumulator. + SUB $08 ; subtract eight - which is not useful. + BIT 2,A ; isolate '>', '<', '='. + JR NZ,EX_OR_NOT ; skip to EX_OR_NOT with these. + + DEC A ; else make $00-$02, $08-$0A to match bits 0-2. + + ;;;$3543 +EX_OR_NOT: RRCA ; the first RRCA sets carry for a swap. + JR NC,NU_OR_STR ; forward to NU_OR_STR with other 8 cases + + ; for the other 4 cases the two values on the calculator stack are exchanged. + + PUSH AF ; save A and carry. + PUSH HL ; save HL - pointer to first operand. + ; (DE points to second operand). + CALL EXCHANGE ; routine EXCHANGE swaps the two values. + ; (HL = second operand, DE = STKEND) + POP DE ; DE = first operand + EX DE,HL ; as we were. + POP AF ; restore A and carry. + + ; Note. it would be better if the 2nd RRCA preceded the string test. + ; It would save two duplicate bytes and if we also got rid of that sub 8 + ; at the beginning we wouldn't have to alter which bit we test. + + ;;;$354E +NU_OR_STR: BIT 2,A ; test if a string comparison. + JR NZ,STRINGS ; forward to STRINGS if so. + + ; continue with numeric comparisons. + + RRCA ; 2nd RRCA causes eql/neql to set carry. + PUSH AF ; save A and carry + CALL SUBTRACT ; routine SUBTRACT leaves result on stack. + JR END_TESTS ; forward to END_TESTS + + ;;;$3559 +STRINGS: RRCA ; 2nd RRCA causes eql/neql to set carry. + PUSH AF ; save A and carry. + CALL STK_FETCH ; routine STK_FETCH gets 2nd string params + PUSH DE ; save start2 *. + PUSH BC ; and the length. + CALL STK_FETCH ; routine STK_FETCH gets 1st string + ; parameters - start in DE, length in BC. + POP HL ; restore length of second to HL. + + ; A loop is now entered to compare, by subtraction, each corresponding character + ; of the strings. For each successful match, the pointers are incremented and + ; the lengths decreased and the branch taken back to here. If both string + ; remainders become null at the same time, then an exact match exists. + + ;;;$3564 +BYTE_COMP: LD A,H ; test if the second string + OR L ; is the null string and hold flags. + EX (SP),HL ; put length2 on stack, bring start2 to HL *. + LD A,B ; hi byte of length1 to A + JR NZ,SEC_PLUS ; forward to SEC_PLUS if second not null. + + OR C ; test length of first string. + + ;;;$356B +SECND_LOW: POP BC ; pop the second length off stack. + JR Z,BOTH_NULL ; forward to BOTH_NULL if first string is also + ; of zero length. + + ; the true condition - first is longer than second (SECND-LESS) + + POP AF ; restore carry (set if eql/neql) + CCF ; complement carry flag. + ; Note. equality becomes false. + ; Inequality is true. By swapping or applying + ; a terminal 'not', all comparisons have been + ; manipulated so that this is success path. + JR STR_TEST ; forward to leave via STR_TEST + + ; the branch was here with a match + + ;;;$3572 +BOTH_NULL: POP AF ; restore carry - set for eql/neql + JR STR_TEST ; forward to STR_TEST + + ; the branch was here when 2nd string not null and low byte of first is yet + ; to be tested. + + ;;;$3575 +SEC_PLUS: OR C ; test the length of first string. + JR Z,FRST_LESS ; forward to FRST_LESS if length is zero. + + ; both strings have at least one character left. + + LD A,(DE) ; fetch character of first string. + SUB (HL) ; subtract with that of 2nd string. + JR C,FRST_LESS ; forward to FRST_LESS if carry set + + JR NZ,SECND_LOW ; back to SECND_LOW and then STR_TEST + ; if not exact match. + + DEC BC ; decrease length of 1st string. + INC DE ; increment 1st string pointer. + INC HL ; increment 2nd string pointer. + EX (SP),HL ; swap with length on stack + DEC HL ; decrement 2nd string length + JR BYTE_COMP ; back to BYTE_COMP + + ; the false condition. + + ;;;$3585 +FRST_LESS: POP BC ; discard length + POP AF ; pop A + AND A ; clear the carry for false result. + + ; exact match and x$>y$ rejoin here + + ;;;$3588 +STR_TEST: PUSH AF ; save A and carry + RST 28H ;; FP_CALC + DEFB $A0 ;;STK_ZERO an initial false value. + DEFB $38 ;;END_CALC + + ; both numeric and string paths converge here. + + ;;;$358C +END_TESTS: POP AF ; pop carry - will be set if eql/neql + PUSH AF ; save it again. + CALL C,NOT_ ; routine NOT sets true(1) if equal(0) + ; or, for strings, applies true result. + POP AF ; pop carry and + PUSH AF ; save A + CALL NC,GREATER_0 ; routine GREATER_0 tests numeric subtraction + ; result but also needlessly tests the string + ; value for zero - it must be. + POP AF ; pop A + RRCA ; the third RRCA - test for '<=', '>=' or '<>'. + CALL NC,NOT_ ; apply a terminal NOT if so. + RET ; return. + +;--------------------------- +; String concatenation ($17) +;--------------------------- +; This literal combines two strings into one e.g. LET a$ = b$ + c$ +; The two parameters of the two strings to be combined are on the stack. + + ;;;$359C +STRS_ADD: CALL STK_FETCH ; routine STK_FETCH fetches string parameters + ; and deletes calculator stack entry. + PUSH DE ; save start address. + PUSH BC ; and length. + CALL STK_FETCH ; routine STK_FETCH for first string + POP HL ; re-fetch first length + PUSH HL ; and save again + PUSH DE ; save start of second string + PUSH BC ; and it's length. + ADD HL,BC ; add the two lengths. + LD B,H ; transfer to BC + LD C,L ; and create + RST 30H ; BC_SPACES in workspace. + ; DE points to start of space. + CALL STK_STO_D ; routine STK_STO_D stores parameters + ; of new string updating STKEND. + POP BC ; length of first + POP HL ; address of start + LD A,B ; test for + OR C ; zero length. + JR Z,OTHER_STR ; to OTHER_STR if null string + + LDIR ; copy string to workspace. + + ;;;$35B7 +OTHER_STR: POP BC ; now second length + POP HL ; and start of string + LD A,B ; test this one + OR C ; for zero length + JR Z,STK_PNTRS ; skip forward to STK_PNTRS if so as complete. + + LDIR ; else copy the bytes. + ; and continue into next routine which + ; sets the calculator stack pointers. + +;--------------------- +; Check stack pointers +;--------------------- +; Register DE is set to STKEND and HL, the result pointer, is set to five +; locations below this. +; This routine is used when it is inconvenient to save these values at the +; time the calculator stack is manipulated due to other activity on the +; machine stack. +; This routine is also used to terminate the VAL and READ_IN routines for +; the same reason and to initialize the calculator stack at the start of +; the CALCULATE routine. + + ;;;$35BF +STK_PNTRS: LD HL,(STKEND) ; fetch STKEND value from system variable. + LD DE,$FFFB ; the value -5 + PUSH HL ; push STKEND value. + ADD HL,DE ; subtract 5 from HL. + POP DE ; pop STKEND to DE. + RET ; return. + +;------------------ +; Handle CHR$ ($2F) +;------------------ +; This function returns a single character string that is a result of +; converting a number in the range 0-255 to a string e.g. CHR$ 65 = "A". + + ;;;$35C9 +CHRS: CALL FP_TO_A ; routine FP_TO_A puts the number in A. + JR C,REPORT_BD ; forward to REPORT_BD if overflow + JR NZ,REPORT_BD ; forward to REPORT_BD if negative + + PUSH AF ; save the argument. + LD BC,$0001 ; one space required. + RST 30H ; BC_SPACES makes DE point to start + POP AF ; restore the number. + LD (DE),A ; and store in workspace + CALL STK_STO_D ; routine STK_STO_D stacks descriptor. + EX DE,HL ; make HL point to result and DE to STKEND. + RET ; return. + + ;;;$35DC +REPORT_BD: RST 08H ; ERROR_1 + DEFB $0A ; Error Report: Integer out of range + +;------------------------------- +; Handle VAL and VAL$ ($1D, $18) +;------------------------------- +; VAL treats the characters in a string as a numeric expression. +; e.g. VAL "2.3" = 2.3, VAL "2+4" = 6, VAL ("2" + "4") = 24. +; VAL$ treats the characters in a string as a string expression. +; e.g. VAL$ (z$+"(2)") = a$(2) if z$ happens to be "a$". + + ;;;$35DE +VAL: +VALS: + LD HL,(CH_ADD) ; fetch value of system variable CH_ADD + PUSH HL ; and save on the machine stack. + LD A,B ; fetch the literal $1D or $18. + ADD A,$E3 ; add $E3 to form $00 (setting carry) or $FB. + SBC A,A ; now form $FF bit 6 = numeric result + ; or $00 bit 6 = string result. + PUSH AF ; save this mask on the stack + CALL STK_FETCH ; routine STK_FETCH fetches the string operand + ; from calculator stack. + PUSH DE ; save the address of the start of the string. + INC BC ; increment the length for a carriage return. + RST 30H ; BC_SPACES creates the space in workspace. + POP HL ; restore start of string to HL. + LD (CH_ADD),DE ; load CH_ADD with start DE in workspace. + PUSH DE ; save the start in workspace + LDIR ; copy string from program or variables or + ; workspace to the workspace area. + EX DE,HL ; end of string + 1 to HL + DEC HL ; decrement HL to point to end of new area. + LD (HL),$0D ; insert a carriage return at end. + RES 7,(IY+$01) ; update FLAGS - signal checking syntax. + CALL SCANNING ; routine SCANNING evaluates string + ; expression and result. + RST 18H ; GET_CHAR fetches next character. + CP $0D ; is it the expected carriage return ? + JR NZ,V_RPORT_C ; forward to V_RPORT_C if not + ; 'Nonsense in Basic'. + POP HL ; restore start of string in workspace. + POP AF ; restore expected result flag (bit 6). + XOR (IY+$01) ; xor with FLAGS now updated by SCANNING. + AND $40 ; test bit 6 - should be zero if result types match. + + ;;;$360C +V_RPORT_C: JP NZ,REPORT_C ; jump back to REPORT_C with a result mismatch. + LD (CH_ADD),HL ; set CH_ADD to the start of the string again. + SET 7,(IY+$01) ; update FLAGS - signal running program. + CALL SCANNING ; routine SCANNING evaluates the string + ; in full leaving result on calculator stack. + POP HL ; restore saved character address in program. + LD (CH_ADD),HL ; and reset the system variable CH_ADD. + JR STK_PNTRS ; back to exit via STK_PNTRS. + ; resetting the calculator stack pointers + ; HL and DE from STKEND as it wasn't possible + ; to preserve them during this routine. + +;------------------ +; Handle STR$ ($2E) +;------------------ + + ;;;$361F +STRS: LD BC,$0001 ; create an initial byte in workspace + RST 30H ; using BC_SPACES restart. + LD (K_CUR),HL ; set system variable K_CUR to new location. + PUSH HL ; and save start on machine stack also. + LD HL,(CURCHL) ; fetch value of system variable CURCHL + PUSH HL ; and save that too. + LD A,$FF ; select system channel 'R'. + CALL CHAN_OPEN ; routine CHAN_OPEN opens it. + CALL PRINT_FP ; routine PRINT_FP outputs the number to + ; workspace updating K-CUR. + POP HL ; restore current channel. + CALL CHAN_FLAG ; routine CHAN_FLAG resets flags. + POP DE ; fetch saved start of string to DE. + LD HL,(K_CUR) ; load HL with end of string from K_CUR. + AND A ; prepare for true subtraction. + SBC HL,DE ; subtract start from end to give length. + LD B,H ; transfer the length to + LD C,L ; the BC register pair. + CALL STK_STO_D ; routine STK_STO_D stores string parameters + ; on the calculator stack. + EX DE,HL ; HL = last value, DE = STKEND. + RET ; return. + +;-------------- +; Read-in ($1A) +;-------------- +; This is the calculator literal used by the INKEY$ function when a '#' +; is encountered after the keyword. +; INKEY$ # does not interact correctly with the keyboard, #0 or #1, and +; it's uses are for other channels. + + ;;;$3645 +READ_IN: CALL FIND_INT1 ; routine FIND_INT1 fetches stream to A + CP $10 ; compare with 16 decimal. + JP NC,REPORT_BB ; jump to REPORT_BB if not in range 0 - 15. + ; 'Integer out of range' + ; (REPORT_BD is within range) + LD HL,(CURCHL) ; fetch current channel CURCHL + PUSH HL ; save it + CALL CHAN_OPEN ; routine CHAN_OPEN opens channel + CALL INPUT_AD ; routine INPUT_AD - the channel must have an + ; input stream or else error here from stream stub. + LD BC,$0000 ; initialize length of string to zero + JR NC,R_I_STORE ; forward to R_I_STORE if no key detected. + INC C ; increase length to one. + RST 30H ; BC_SPACES creates space for one character in workspace. + LD (DE),A ; the character is inserted. + + ;;;$365F +R_I_STORE: CALL STK_STO_D ; routine STK_STO_D stacks the string parameters. + POP HL ; restore current channel address + CALL CHAN_FLAG ; routine CHAN_FLAG resets current channel + ; system variable and flags. + JP STK_PNTRS ; jump back to STK_PNTRS + +;------------------ +; Handle CODE ($1C) +;------------------ +; Returns the ascii code of a character or first character of a string +; e.g. CODE "Aardvark" = 65, CODE "" = 0. + + ;;;$3669 +CODE: CALL STK_FETCH ; routine STK_FETCH to fetch and delete the + ; string parameters. + ; DE points to the start, BC holds the length. + LD A,B ; test length + OR C ; of the string. + JR Z,STK_CODE ; skip to STK_CODE with zero if the null string. + + LD A,(DE) ; else fetch the first character. + + ;;;$3671 +STK_CODE: JP STACK_A ; jump back to STACK_A (with memory check) + +;----------------- +; Handle LEN ($1E) +;----------------- +; Returns the length of a string. +; In Sinclair Basic strings can be more than twenty thousand characters long +; so a sixteen-bit register is required to store the length + + ;;;$3674 +LEN: CALL STK_FETCH ; routine STK_FETCH to fetch and delete the + ; string parameters from the calculator stack. + ; register BC now holds the length of string. + JP STACK_BC ; jump back to STACK_BC to save result on the + ; calculator stack (with memory check). + +;--------------------------- +; Decrease the counter ($35) +;--------------------------- +; The calculator has an instruction that decrements a single-byte +; pseudo-register and makes consequential relative jumps just like +; the Z80's DJNZ instruction. + + ;;;$367A +DEC_JR_NZ: EXX ; switch in set that addresses code + PUSH HL ; save pointer to offset byte + LD HL,BREG ; address BREG in system variables + DEC (HL) ; decrement it + POP HL ; restore pointer + JR NZ,JUMP_2 ; to JUMP_2 if not zero + + INC HL ; step past the jump length. + EXX ; switch in the main set. + RET ; return. + + ; Note. as a general rule the calculator avoids using the IY register + ; otherwise the cumbersome 4 instructions in the middle could be replaced by + ; dec (iy+$2d) - three bytes instead of six. + +;----------- +; Jump ($33) +;----------- +; This enables the calculator to perform relative jumps just like +; the Z80 chip's JR instruction + + ;;;$3686 +JUMP: EXX ;switch in pointer set + + ;;;$3687 +JUMP_2: LD E,(HL) ; the jump byte 0-127 forward, 128-255 back. + LD A,E ; transfer to accumulator. + RLA ; if backward jump, carry is set. + SBC A,A ; will be $FF if backward or $00 if forward. + LD D,A ; transfer to high byte. + ADD HL,DE ; advance calculator pointer forward or back. + EXX ; switch back. + RET ; return. + +;------------------- +; Jump on true ($00) +;------------------- +; This enables the calculator to perform conditional relative jumps +; dependent on whether the last test gave a true result + + ;;;$368F +JUMP_TRUE: INC DE ; collect the + INC DE ; third byte + LD A,(DE) ; of the test + DEC DE ; result and + DEC DE ; backtrack. + AND A ; is result 0 or 1 ? + JR NZ,JUMP ; back to JUMP if true (1). + + EXX ; else switch in the pointer set. + INC HL ; step past the jump length. + EXX ; switch in the main set. + RET ; return. + +;------------------------- +; End of calculation ($38) +;------------------------- +; The END_CALC literal terminates a mini-program written in the Spectrum's +; internal language. + + ;;;$369B +END_CALC: POP AF ; drop the calculator return address RE_ENTRY + EXX ; switch to the other set. + EX (SP),HL ; transfer H'L' to machine stack for the + ; return address. + ; when exiting recursion then the previous + ; pointer is transferred to H'L'. + EXX ; back to main set. + RET ; return. + + +;------------- +; Modulus ($32) +;------------- + + ;;;$36A0 +N_MOD_M: RST 28H ;; FP_CALC 17, 3. + DEFB $C0 ;;st-mem-0 17, 3. + DEFB $02 ;;DELETE 17. + DEFB $31 ;;DUPLICATE 17, 17. + DEFB $E0 ;;get-mem-0 17, 17, 3. + DEFB $05 ;;DIVISION 17, 17/3. + DEFB $27 ;;INT 17, 5. + DEFB $E0 ;;get-mem-0 17, 5, 3. + DEFB $01 ;;EXCHANGE 17, 3, 5. + DEFB $C0 ;;st-mem-0 17, 3, 5. + DEFB $04 ;;MULTIPLY 17, 15. + DEFB $03 ;;SUBTRACT 2. + DEFB $E0 ;;get-mem-0 2, 5. + DEFB $38 ;;END_CALC 2, 5. + + RET ; return. + + +;----------------- +; Handle INT ($27) +;----------------- +; This function returns the integer of x, which is just the same as truncate +; for positive numbers. The truncate literal truncates negative numbers +; upwards so that -3.4 gives -3 whereas the Basic INT function has to +; truncate negative numbers down so that INT -3.4 is 4. +; It is best to work through using +-3.4 as examples. + + ;;;$36AF +INT: RST 28H ;; FP_CALC x. (= 3.4 or -3.4). + DEFB $31 ;;DUPLICATE x, x. + DEFB $36 ;;LESS_0 x, (1/0) + DEFB $00 ;;JUMP_TRUE x, (1/0) + DEFB $04 ;;to X_NEG + DEFB $3A ;;TRUNCATE trunc 3.4 = 3. + DEFB $38 ;;END_CALC 3. + + RET ; return with + int x on stack. + + ;;;$36B7 +X_NEG: DEFB $31 ;;DUPLICATE -3.4, -3.4. + DEFB $3A ;;TRUNCATE -3.4, -3. + DEFB $C0 ;;st-mem-0 -3.4, -3. + DEFB $03 ;;SUBTRACT -.4 + DEFB $E0 ;;get-mem-0 -.4, -3. + DEFB $01 ;;EXCHANGE -3, -.4. + DEFB $30 ;;NOT -3, (0). + DEFB $00 ;;JUMP_TRUE -3. + DEFB $03 ;;to EXIT -3. + DEFB $A1 ;;STK_ONE -3, 1. + DEFB $03 ;;SUBTRACT -4. + + ;;;$36C2 +EXIT: DEFB $38 ;;END_CALC -4. + + RET ; return. + +;----------------- +; Exponential ($26) +;----------------- + + ;;;$36C4 +EXP: RST 28H ;; FP_CALC + DEFB $3D ;;RE_STACK + DEFB $34 ;;STK_DATA + DEFB $F1 ;;Exponent: $81, Bytes: 4 + DEFB $38,$AA,$3B,$29 ;; + DEFB $04 ;;MULTIPLY + DEFB $31 ;;DUPLICATE + DEFB $27 ;;INT + DEFB $C3 ;;st-mem-3 + DEFB $03 ;;SUBTRACT + DEFB $31 ;;DUPLICATE + DEFB $0F ;;ADDITION + DEFB $A1 ;;STK_ONE + DEFB $03 ;;SUBTRACT + DEFB $88 ;;series-08 + DEFB $13 ;;Exponent: $63, Bytes: 1 + DEFB $36 ;;(+00,+00,+00) + DEFB $58 ;;Exponent: $68, Bytes: 2 + DEFB $65,$66 ;;(+00,+00) + DEFB $9D ;;Exponent: $6D, Bytes: 3 + DEFB $78,$65,$40 ;;(+00) + DEFB $A2 ;;Exponent: $72, Bytes: 3 + DEFB $60,$32,$C9 ;;(+00) + DEFB $E7 ;;Exponent: $77, Bytes: 4 + DEFB $21,$F7,$AF,$24 ;; + DEFB $EB ;;Exponent: $7B, Bytes: 4 + DEFB $2F,$B0,$B0,$14 ;; + DEFB $EE ;;Exponent: $7E, Bytes: 4 + DEFB $7E,$BB,$94,$58 ;; + DEFB $F1 ;;Exponent: $81, Bytes: 4 + DEFB $3A,$7E,$F8,$CF ;; + DEFB $E3 ;;get-mem-3 + DEFB $38 ;;END_CALC + + CALL FP_TO_A ; routine FP_TO_A + JR NZ,N_NEGTV ; to N_NEGTV + + JR C,REPORT_6B ; to REPORT_6B + + ADD A,(HL) ; + JR NC,RESULT_OK ; to RESULT_OK + + ;;;$3703 +REPORT_6B: RST 08H ; ERROR_1 + DEFB $05 ; Error Report: Number too big + + ;; N_NEGTV +N_NEGTV: JR C,RSLT_ZERO ; to RSLT_ZERO + + SUB (HL) + JR NC,RSLT_ZERO ; to RSLT_ZERO + + NEG ; Negate + + ;;;$370C +RESULT_OK: LD (HL),A + RET ; return. + + ;;;$370E +RSLT_ZERO: RST 28H ;; FP_CALC + DEFB $02 ;;DELETE + DEFB $A0 ;;STK_ZERO + DEFB $38 ;;END_CALC + + RET ; return. + + +;------------------------ +; Natural logarithm ($25) +;------------------------ + + ;;;$3713 +LN: RST 28H ;; FP_CALC + DEFB $3D ;;RE_STACK + DEFB $31 ;;DUPLICATE + DEFB $37 ;;GREATER_0 + DEFB $00 ;;JUMP_TRUE + DEFB $04 ;;to VALID + DEFB $38 ;;END_CALC + + ;;;$371A +REPORT_AB: RST 08H ; ERROR_1 + DEFB $09 ; Error Report: Invalid argument + + ;;;$371C +VALID: DEFB $A0 ;;STK_ZERO + DEFB $02 ;;DELETE + DEFB $38 ;;END_CALC + + LD A,(HL) + LD (HL),$80 + CALL STACK_A ; routine STACK_A + RST 28H ;; FP_CALC + DEFB $34 ;;STK_DATA + DEFB $38 ;;Exponent: $88, Bytes: 1 + DEFB $00 ;;(+00,+00,+00) + DEFB $03 ;;SUBTRACT + DEFB $01 ;;EXCHANGE + DEFB $31 ;;DUPLICATE + DEFB $34 ;;STK_DATA + DEFB $F0 ;;Exponent: $80, Bytes: 4 + DEFB $4C,$CC,$CC,$CD ;; + DEFB $03 ;;SUBTRACT + DEFB $37 ;;GREATER_0 + DEFB $00 ;;JUMP_TRUE + DEFB $08 ;;to GRE_8 + DEFB $01 ;;EXCHANGE + DEFB $A1 ;;STK_ONE + DEFB $03 ;;SUBTRACT + DEFB $01 ;;EXCHANGE + DEFB $38 ;;END_CALC + + INC (HL) + RST 28H ;; FP_CALC + + ;;;$373D +GRE_8: DEFB $01 ;;EXCHANGE + DEFB $34 ;;STK_DATA + DEFB $F0 ;;Exponent: $80, Bytes: 4 + DEFB $31,$72,$17,$F8 ;; + DEFB $04 ;;MULTIPLY + DEFB $01 ;;EXCHANGE + DEFB $A2 ;;STK_HALF + DEFB $03 ;;SUBTRACT + DEFB $A2 ;;STK_HALF + DEFB $03 ;;SUBTRACT + DEFB $31 ;;DUPLICATE + DEFB $34 ;;STK_DATA + DEFB $32 ;;Exponent: $82, Bytes: 1 + DEFB $20 ;;(+00,+00,+00) + DEFB $04 ;;MULTIPLY + DEFB $A2 ;;STK_HALF + DEFB $03 ;;SUBTRACT + DEFB $8C ;;series-0C + DEFB $11 ;;Exponent: $61, Bytes: 1 + DEFB $AC ;;(+00,+00,+00) + DEFB $14 ;;Exponent: $64, Bytes: 1 + DEFB $09 ;;(+00,+00,+00) + DEFB $56 ;;Exponent: $66, Bytes: 2 + DEFB $DA,$A5 ;;(+00,+00) + DEFB $59 ;;Exponent: $69, Bytes: 2 + DEFB $30,$C5 ;;(+00,+00) + DEFB $5C ;;Exponent: $6C, Bytes: 2 + DEFB $90,$AA ;;(+00,+00) + DEFB $9E ;;Exponent: $6E, Bytes: 3 + DEFB $70,$6F,$61 ;;(+00) + DEFB $A1 ;;Exponent: $71, Bytes: 3 + DEFB $CB,$DA,$96 ;;(+00) + DEFB $A4 ;;Exponent: $74, Bytes: 3 + DEFB $31,$9F,$B4 ;;(+00) + DEFB $E7 ;;Exponent: $77, Bytes: 4 + DEFB $A0,$FE,$5C,$FC ;; + DEFB $EA ;;Exponent: $7A, Bytes: 4 + DEFB $1B,$43,$CA,$36 ;; + DEFB $ED ;;Exponent: $7D, Bytes: 4 + DEFB $A7,$9C,$7E,$5E ;; + DEFB $F0 ;;Exponent: $80, Bytes: 4 + DEFB $6E,$23,$80,$93 ;; + DEFB $04 ;;MULTIPLY + DEFB $0F ;;ADDITION + DEFB $38 ;;END_CALC + + RET ; return. + +;---------------------- +; Reduce argument ($39) +;---------------------- + + ;;;$3783 +GET_ARGT: RST 28H ;; FP_CALC + DEFB $3D ;;RE_STACK + DEFB $34 ;;STK_DATA + DEFB $EE ;;Exponent: $7E, Bytes: 4 + DEFB $22,$F9,$83,$6E + DEFB $04 ;;MULTIPLY + DEFB $31 ;;DUPLICATE + DEFB $A2 ;;STK_HALF + DEFB $0F ;;ADDITION + DEFB $27 ;;INT + DEFB $03 ;;SUBTRACT + DEFB $31 ;;DUPLICATE + DEFB $0F ;;ADDITION + DEFB $31 ;;DUPLICATE + DEFB $0F ;;ADDITION + DEFB $31 ;;DUPLICATE + DEFB $2A ;;ABS + DEFB $A1 ;;STK_ONE + DEFB $03 ;;SUBTRACT + DEFB $31 ;;DUPLICATE + DEFB $37 ;;GREATER_0 + DEFB $C0 ;;st-mem-0 + DEFB $00 ;;JUMP_TRUE + DEFB $04 ;;to ZPLUS + DEFB $02 ;;DELETE + DEFB $38 ;;END_CALC + + RET ; return. + + ;;;$37A1 +ZPLUS: DEFB $A1 ;;STK_ONE + DEFB $03 ;;SUBTRACT + DEFB $01 ;;EXCHANGE + DEFB $36 ;;LESS_0 + DEFB $00 ;;JUMP_TRUE + DEFB $02 ;;to YNEG + DEFB $1B ;;NEGATE + + ;;;$37A8 +YNEG: DEFB $38 ;;END_CALC + + RET ; return. + +;-------------------- +; Handle cosine ($20) +;-------------------- + + ;;;$37AA +COS_: RST 28H ;; FP_CALC + DEFB $39 ;;GET_ARGT + DEFB $2A ;;ABS + DEFB $A1 ;;STK_ONE + DEFB $03 ;;SUBTRACT + DEFB $E0 ;;get-mem-0 + DEFB $00 ;;JUMP_TRUE + DEFB $06 ;;fwd to C_ENT + DEFB $1B ;;NEGATE + DEFB $33 ;;jump + DEFB $03 ;;fwd to C_ENT + +;------------------ +; Handle sine ($1F) +;------------------ + + ;;;$37B5 +SIN_: RST 28H ;; FP_CALC + DEFB $39 ;;GET_ARGT + + ;;;$37B7 +C_ENT: DEFB $31 ;;DUPLICATE + DEFB $31 ;;DUPLICATE + DEFB $04 ;;MULTIPLY + DEFB $31 ;;DUPLICATE + DEFB $0F ;;ADDITION + DEFB $A1 ;;STK_ONE + DEFB $03 ;;SUBTRACT + DEFB $86 ;;series-06 + DEFB $14 ;;Exponent: $64, Bytes: 1 + DEFB $E6 ;;(+00,+00,+00) + DEFB $5C ;;Exponent: $6C, Bytes: 2 + DEFB $1F,$0B ;;(+00,+00) + DEFB $A3 ;;Exponent: $73, Bytes: 3 + DEFB $8F,$38,$EE ;;(+00) + DEFB $E9 ;;Exponent: $79, Bytes: 4 + DEFB $15,$63,$BB,$23 ;; + DEFB $EE ;;Exponent: $7E, Bytes: 4 + DEFB $92,$0D,$CD,$ED ;; + DEFB $F1 ;;Exponent: $81, Bytes: 4 + DEFB $23,$5D,$1B,$EA ;; + DEFB $04 ;;MULTIPLY + DEFB $38 ;;END_CALC + + RET ; return. + + +;--------------------- +; Handle tangent ($21) +;--------------------- +; Evaluates tangent x as sin x/cos x. + + ;;;$37DA +TAN: RST 28H ;; FP_CALC x. + DEFB $31 ;;DUPLICATE x, x. + DEFB $1F ;;SIN_ x, sin x. + DEFB $01 ;;EXCHANGE sin x, x. + DEFB $20 ;;COS_ sin x, cos x. + DEFB $05 ;;DIVISION sin x/cos x (= tan x). + DEFB $38 ;;END_CALC tan x. + + RET ; return. + +;------------------- +; Handle arctan ($24) +;------------------- +; the inverse tangent function with the result in radians. + + ;;;$37E2 +ATN: CALL RE_STACK ; routine RE_STACK + LD A,(HL) + CP $81 + JR C,SMALL ; to SMALL + + RST 28H ;; FP_CALC + DEFB $A1 ;;STK_ONE + DEFB $1B ;;NEGATE + DEFB $01 ;;EXCHANGE + DEFB $05 ;;DIVISION + DEFB $31 ;;DUPLICATE + DEFB $36 ;;LESS_0 + DEFB $A3 ;;STK_PI_2 + DEFB $01 ;;EXCHANGE + DEFB $00 ;;JUMP_TRUE + DEFB $06 ;;to CASES + DEFB $1B ;;NEGATE + DEFB $33 ;;jump + DEFB $03 ;;to CASES + + ;;;$37F8 +SMALL: RST 28H ;; FP_CALC + DEFB $A0 ;;STK_ZERO + + ;;;$37FA +CASES: DEFB $01 ;;EXCHANGE + DEFB $31 ;;DUPLICATE + DEFB $31 ;;DUPLICATE + DEFB $04 ;;MULTIPLY + DEFB $31 ;;DUPLICATE + DEFB $0F ;;ADDITION + DEFB $A1 ;;STK_ONE + DEFB $03 ;;SUBTRACT + DEFB $8C ;;series-0C + DEFB $10 ;;Exponent: $60, Bytes: 1 + DEFB $B2 ;;(+00,+00,+00) + DEFB $13 ;;Exponent: $63, Bytes: 1 + DEFB $0E ;;(+00,+00,+00) + DEFB $55 ;;Exponent: $65, Bytes: 2 + DEFB $E4,$8D ;;(+00,+00) + DEFB $58 ;;Exponent: $68, Bytes: 2 + DEFB $39,$BC ;;(+00,+00) + DEFB $5B ;;Exponent: $6B, Bytes: 2 + DEFB $98,$FD ;;(+00,+00) + DEFB $9E ;;Exponent: $6E, Bytes: 3 + DEFB $00,$36,$75 ;;(+00) + DEFB $A0 ;;Exponent: $70, Bytes: 3 + DEFB $DB,$E8,$B4 ;;(+00) + DEFB $63 ;;Exponent: $73, Bytes: 2 + DEFB $42,$C4 ;;(+00,+00) + DEFB $E6 ;;Exponent: $76, Bytes: 4 + DEFB $B5,$09,$36,$BE ;; + DEFB $E9 ;;Exponent: $79, Bytes: 4 + DEFB $36,$73,$1B,$5D ;; + DEFB $EC ;;Exponent: $7C, Bytes: 4 + DEFB $D8,$DE,$63,$BE ;; + DEFB $F0 ;;Exponent: $80, Bytes: 4 + DEFB $61,$A1,$B3,$0C ;; + DEFB $04 ;;MULTIPLY + DEFB $0F ;;ADDITION + DEFB $38 ;;END_CALC + + RET ; return. + + +;-------------------- +; Handle arcsin ($22) +;-------------------- +; the inverse sine function with result in radians. +; Error A unless the argument is between -1 and +1. + + ;;;$3833 +ASN: RST 28H ;; FP_CALC + DEFB $31 ;;DUPLICATE + DEFB $31 ;;DUPLICATE + DEFB $04 ;;MULTIPLY + DEFB $A1 ;;STK_ONE + DEFB $03 ;;SUBTRACT + DEFB $1B ;;NEGATE + DEFB $28 ;;SQR + DEFB $A1 ;;STK_ONE + DEFB $0F ;;ADDITION + DEFB $05 ;;DIVISION + DEFB $24 ;;ATN + DEFB $31 ;;DUPLICATE + DEFB $0F ;;ADDITION + DEFB $38 ;;END_CALC + + RET ; return. + + +;-------------------- +; Handle arccos ($23) +;-------------------- +; the inverse cosine function with the result in radians. +; Error A unless the argument is between -1 and +1. + + ;;;$3843 +ACS: RST 28H ;; FP_CALC + DEFB $22 ;;ASN + DEFB $A3 ;;STK_PI_2 + DEFB $03 ;;SUBTRACT + DEFB $1B ;;NEGATE + DEFB $38 ;;END_CALC + + RET ; return. + + +;------------------------- +; Handle square root ($28) +;------------------------- +; This routine is remarkable only in it's brevity - 7 bytes. +; It wasn't written here but in the ZX81 where the programmers had to squeeze +; a bulky operating sytem into an 8K ROM. it simply calculates +; + + ;;;$384A +SQR: RST 28H ;; FP_CALC + DEFB $31 ;;DUPLICATE + DEFB $30 ;;NOT + DEFB $00 ;;JUMP_TRUE + DEFB $1E ;;to LAST + DEFB $A2 ;;STK_HALF + DEFB $38 ;;END_CALC + + +;------------------------- +; Handle exponential ($06) +;------------------------- + + ;;;$3851 +TO_POWER: RST 28H ;; FP_CALC + DEFB $01 ;;EXCHANGE + DEFB $31 ;;DUPLICATE + DEFB $30 ;;NOT + DEFB $00 ;;JUMP_TRUE + DEFB $07 ;;to XISO + DEFB $25 ;;LN + DEFB $04 ;;MULTIPLY + DEFB $38 ;;END_CALC + + JP EXP ; to EXP + + ;;;$385D +XISO: DEFB $02 ;;DELETE + DEFB $31 ;;DUPLICATE + DEFB $30 ;;NOT + DEFB $00 ;;JUMP_TRUE + DEFB $09 ;;to ONE + DEFB $A0 ;;STK_ZERO + DEFB $01 ;;EXCHANGE + DEFB $37 ;;GREATER_0 + DEFB $00 ;;JUMP_TRUE + DEFB $06 ;;to LAST + DEFB $A1 ;;STK_ONE + DEFB $01 ;;EXCHANGE + DEFB $05 ;;DIVISION + + ;;;$386A +ONE: DEFB $02 ;;DELETE + DEFB $A1 ;;STK_ONE + + ;;;$386C +LAST: DEFB $38 ;;END_CALC + + RET ; return + +;---------------- +; Spare Locations +;---------------- + + ;;;$386E +SPARE: DEFB $FF, $FF + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + DEFB $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF; + +;-------------- +; Character set +;-------------- + + ;;;$3D00 +CHAR_SET: DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 +; Character: ! + DEFB %00000000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00000000 + DEFB %00010000 + DEFB %00000000 +; Character: " + DEFB %00000000 + DEFB %00100100 + DEFB %00100100 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 +; Character: # + DEFB %00000000 + DEFB %00100100 + DEFB %01111110 + DEFB %00100100 + DEFB %00100100 + DEFB %01111110 + DEFB %00100100 + DEFB %00000000 +; Character: $ + DEFB %00000000 + DEFB %00001000 + DEFB %00111110 + DEFB %00101000 + DEFB %00111110 + DEFB %00001010 + DEFB %00111110 + DEFB %00001000 +; Character: % + DEFB %00000000 + DEFB %01100010 + DEFB %01100100 + DEFB %00001000 + DEFB %00010000 + DEFB %00100110 + DEFB %01000110 + DEFB %00000000 +; Character: & + DEFB %00000000 + DEFB %00010000 + DEFB %00101000 + DEFB %00010000 + DEFB %00101010 + DEFB %01000100 + DEFB %00111010 + DEFB %00000000 +; Character: ' + DEFB %00000000 + DEFB %00001000 + DEFB %00010000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 +; Character: ( + DEFB %00000000 + DEFB %00000100 + DEFB %00001000 + DEFB %00001000 + DEFB %00001000 + DEFB %00001000 + DEFB %00000100 + DEFB %00000000 +; Character: ) + DEFB %00000000 + DEFB %00100000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00100000 + DEFB %00000000 +; Character: * + DEFB %00000000 + DEFB %00000000 + DEFB %00010100 + DEFB %00001000 + DEFB %00111110 + DEFB %00001000 + DEFB %00010100 + DEFB %00000000 +; Character: + + DEFB %00000000 + DEFB %00000000 + DEFB %00001000 + DEFB %00001000 + DEFB %00111110 + DEFB %00001000 + DEFB %00001000 + DEFB %00000000 +; Character: , + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00001000 + DEFB %00001000 + DEFB %00010000 +; Character: - + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00111110 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 +; Character: . + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00011000 + DEFB %00011000 + DEFB %00000000 +; Character: / + DEFB %00000000 + DEFB %00000000 + DEFB %00000010 + DEFB %00000100 + DEFB %00001000 + DEFB %00010000 + DEFB %00100000 + DEFB %00000000 +; Character: 0 + DEFB %00000000 + DEFB %00111100 + DEFB %01000110 + DEFB %01001010 + DEFB %01010010 + DEFB %01100010 + DEFB %00111100 + DEFB %00000000 +; Character: 1 + DEFB %00000000 + DEFB %00011000 + DEFB %00101000 + DEFB %00001000 + DEFB %00001000 + DEFB %00001000 + DEFB %00111110 + DEFB %00000000 +; Character: 2 + DEFB %00000000 + DEFB %00111100 + DEFB %01000010 + DEFB %00000010 + DEFB %00111100 + DEFB %01000000 + DEFB %01111110 + DEFB %00000000 +; Character: 3 + DEFB %00000000 + DEFB %00111100 + DEFB %01000010 + DEFB %00001100 + DEFB %00000010 + DEFB %01000010 + DEFB %00111100 + DEFB %00000000 +; Character: 4 + DEFB %00000000 + DEFB %00001000 + DEFB %00011000 + DEFB %00101000 + DEFB %01001000 + DEFB %01111110 + DEFB %00001000 + DEFB %00000000 +; Character: 5 + DEFB %00000000 + DEFB %01111110 + DEFB %01000000 + DEFB %01111100 + DEFB %00000010 + DEFB %01000010 + DEFB %00111100 + DEFB %00000000 +; Character: 6 + DEFB %00000000 + DEFB %00111100 + DEFB %01000000 + DEFB %01111100 + DEFB %01000010 + DEFB %01000010 + DEFB %00111100 + DEFB %00000000 +; Character: 7 + DEFB %00000000 + DEFB %01111110 + DEFB %00000010 + DEFB %00000100 + DEFB %00001000 + DEFB %00010000 + DEFB %00010000 + DEFB %00000000 +; Character: 8 + DEFB %00000000 + DEFB %00111100 + DEFB %01000010 + DEFB %00111100 + DEFB %01000010 + DEFB %01000010 + DEFB %00111100 + DEFB %00000000 +; Character: 9 + DEFB %00000000 + DEFB %00111100 + DEFB %01000010 + DEFB %01000010 + DEFB %00111110 + DEFB %00000010 + DEFB %00111100 + DEFB %00000000 +; Character: : + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00010000 + DEFB %00000000 + DEFB %00000000 + DEFB %00010000 + DEFB %00000000 +; Character: ; + DEFB %00000000 + DEFB %00000000 + DEFB %00010000 + DEFB %00000000 + DEFB %00000000 + DEFB %00010000 + DEFB %00010000 + DEFB %00100000 +; Character: < + DEFB %00000000 + DEFB %00000000 + DEFB %00000100 + DEFB %00001000 + DEFB %00010000 + DEFB %00001000 + DEFB %00000100 + DEFB %00000000 +; Character: = + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00111110 + DEFB %00000000 + DEFB %00111110 + DEFB %00000000 + DEFB %00000000 +; Character: > + DEFB %00000000 + DEFB %00000000 + DEFB %00010000 + DEFB %00001000 + DEFB %00000100 + DEFB %00001000 + DEFB %00010000 + DEFB %00000000 +; Character: ? + DEFB %00000000 + DEFB %00111100 + DEFB %01000010 + DEFB %00000100 + DEFB %00001000 + DEFB %00000000 + DEFB %00001000 + DEFB %00000000 +; Character: @ + DEFB %00000000 + DEFB %00111100 + DEFB %01001010 + DEFB %01010110 + DEFB %01011110 + DEFB %01000000 + DEFB %00111100 + DEFB %00000000 +; Character: A + DEFB %00000000 + DEFB %00111100 + DEFB %01000010 + DEFB %01000010 + DEFB %01111110 + DEFB %01000010 + DEFB %01000010 + DEFB %00000000 +; Character: B + DEFB %00000000 + DEFB %01111100 + DEFB %01000010 + DEFB %01111100 + DEFB %01000010 + DEFB %01000010 + DEFB %01111100 + DEFB %00000000 +; Character: C + DEFB %00000000 + DEFB %00111100 + DEFB %01000010 + DEFB %01000000 + DEFB %01000000 + DEFB %01000010 + DEFB %00111100 + DEFB %00000000 +; Character: D + DEFB %00000000 + DEFB %01111000 + DEFB %01000100 + DEFB %01000010 + DEFB %01000010 + DEFB %01000100 + DEFB %01111000 + DEFB %00000000 +; Character: E + DEFB %00000000 + DEFB %01111110 + DEFB %01000000 + DEFB %01111100 + DEFB %01000000 + DEFB %01000000 + DEFB %01111110 + DEFB %00000000 +; Character: F + DEFB %00000000 + DEFB %01111110 + DEFB %01000000 + DEFB %01111100 + DEFB %01000000 + DEFB %01000000 + DEFB %01000000 + DEFB %00000000 +; Character: G + DEFB %00000000 + DEFB %00111100 + DEFB %01000010 + DEFB %01000000 + DEFB %01001110 + DEFB %01000010 + DEFB %00111100 + DEFB %00000000 +; Character: H + DEFB %00000000 + DEFB %01000010 + DEFB %01000010 + DEFB %01111110 + DEFB %01000010 + DEFB %01000010 + DEFB %01000010 + DEFB %00000000 +; Character: I + DEFB %00000000 + DEFB %00111110 + DEFB %00001000 + DEFB %00001000 + DEFB %00001000 + DEFB %00001000 + DEFB %00111110 + DEFB %00000000 +; Character: J + DEFB %00000000 + DEFB %00000010 + DEFB %00000010 + DEFB %00000010 + DEFB %01000010 + DEFB %01000010 + DEFB %00111100 + DEFB %00000000 +; Character: K + DEFB %00000000 + DEFB %01000100 + DEFB %01001000 + DEFB %01110000 + DEFB %01001000 + DEFB %01000100 + DEFB %01000010 + DEFB %00000000 +; Character: L + DEFB %00000000 + DEFB %01000000 + DEFB %01000000 + DEFB %01000000 + DEFB %01000000 + DEFB %01000000 + DEFB %01111110 + DEFB %00000000 +; Character: M + DEFB %00000000 + DEFB %01000010 + DEFB %01100110 + DEFB %01011010 + DEFB %01000010 + DEFB %01000010 + DEFB %01000010 + DEFB %00000000 +; Character: N + DEFB %00000000 + DEFB %01000010 + DEFB %01100010 + DEFB %01010010 + DEFB %01001010 + DEFB %01000110 + DEFB %01000010 + DEFB %00000000 +; Character: O + DEFB %00000000 + DEFB %00111100 + DEFB %01000010 + DEFB %01000010 + DEFB %01000010 + DEFB %01000010 + DEFB %00111100 + DEFB %00000000 +; Character: P + DEFB %00000000 + DEFB %01111100 + DEFB %01000010 + DEFB %01000010 + DEFB %01111100 + DEFB %01000000 + DEFB %01000000 + DEFB %00000000 +; Character: Q + DEFB %00000000 + DEFB %00111100 + DEFB %01000010 + DEFB %01000010 + DEFB %01010010 + DEFB %01001010 + DEFB %00111100 + DEFB %00000000 +; Character: R + DEFB %00000000 + DEFB %01111100 + DEFB %01000010 + DEFB %01000010 + DEFB %01111100 + DEFB %01000100 + DEFB %01000010 + DEFB %00000000 +; Character: S + DEFB %00000000 + DEFB %00111100 + DEFB %01000000 + DEFB %00111100 + DEFB %00000010 + DEFB %01000010 + DEFB %00111100 + DEFB %00000000 +; Character: T + DEFB %00000000 + DEFB %11111110 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00000000 +; Character: U + DEFB %00000000 + DEFB %01000010 + DEFB %01000010 + DEFB %01000010 + DEFB %01000010 + DEFB %01000010 + DEFB %00111100 + DEFB %00000000 +; Character: V + DEFB %00000000 + DEFB %01000010 + DEFB %01000010 + DEFB %01000010 + DEFB %01000010 + DEFB %00100100 + DEFB %00011000 + DEFB %00000000 +; Character: W + DEFB %00000000 + DEFB %01000010 + DEFB %01000010 + DEFB %01000010 + DEFB %01000010 + DEFB %01011010 + DEFB %00100100 + DEFB %00000000 +; Character: X + DEFB %00000000 + DEFB %01000010 + DEFB %00100100 + DEFB %00011000 + DEFB %00011000 + DEFB %00100100 + DEFB %01000010 + DEFB %00000000 +; Character: Y + DEFB %00000000 + DEFB %10000010 + DEFB %01000100 + DEFB %00101000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00000000 +; Character: Z + DEFB %00000000 + DEFB %01111110 + DEFB %00000100 + DEFB %00001000 + DEFB %00010000 + DEFB %00100000 + DEFB %01111110 + DEFB %00000000 +; Character: [ + DEFB %00000000 + DEFB %00001110 + DEFB %00001000 + DEFB %00001000 + DEFB %00001000 + DEFB %00001000 + DEFB %00001110 + DEFB %00000000 +; Character: \ + DEFB %00000000 + DEFB %00000000 + DEFB %01000000 + DEFB %00100000 + DEFB %00010000 + DEFB %00001000 + DEFB %00000100 + DEFB %00000000 +; Character: ] + DEFB %00000000 + DEFB %01110000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %01110000 + DEFB %00000000 +; Character: ^ + DEFB %00000000 + DEFB %00010000 + DEFB %00111000 + DEFB %01010100 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00000000 +; Character: _ + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %11111111 +; Character: Pound + DEFB %00000000 + DEFB %00011100 + DEFB %00100010 + DEFB %01111000 + DEFB %00100000 + DEFB %00100000 + DEFB %01111110 + DEFB %00000000 +; Character: a + DEFB %00000000 + DEFB %00000000 + DEFB %00111000 + DEFB %00000100 + DEFB %00111100 + DEFB %01000100 + DEFB %00111100 + DEFB %00000000 +; Character: b + DEFB %00000000 + DEFB %00100000 + DEFB %00100000 + DEFB %00111100 + DEFB %00100010 + DEFB %00100010 + DEFB %00111100 + DEFB %00000000 +; Character: c + DEFB %00000000 + DEFB %00000000 + DEFB %00011100 + DEFB %00100000 + DEFB %00100000 + DEFB %00100000 + DEFB %00011100 + DEFB %00000000 +; Character: d + DEFB %00000000 + DEFB %00000100 + DEFB %00000100 + DEFB %00111100 + DEFB %01000100 + DEFB %01000100 + DEFB %00111100 + DEFB %00000000 +; Character: e + DEFB %00000000 + DEFB %00000000 + DEFB %00111000 + DEFB %01000100 + DEFB %01111000 + DEFB %01000000 + DEFB %00111100 + DEFB %00000000 +; Character: f + DEFB %00000000 + DEFB %00001100 + DEFB %00010000 + DEFB %00011000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00000000 +; Character: g + DEFB %00000000 + DEFB %00000000 + DEFB %00111100 + DEFB %01000100 + DEFB %01000100 + DEFB %00111100 + DEFB %00000100 + DEFB %00111000 +; Character: h + DEFB %00000000 + DEFB %01000000 + DEFB %01000000 + DEFB %01111000 + DEFB %01000100 + DEFB %01000100 + DEFB %01000100 + DEFB %00000000 +; Character: i + DEFB %00000000 + DEFB %00010000 + DEFB %00000000 + DEFB %00110000 + DEFB %00010000 + DEFB %00010000 + DEFB %00111000 + DEFB %00000000 +; Character: j + DEFB %00000000 + DEFB %00000100 + DEFB %00000000 + DEFB %00000100 + DEFB %00000100 + DEFB %00000100 + DEFB %00100100 + DEFB %00011000 +; Character: k + DEFB %00000000 + DEFB %00100000 + DEFB %00101000 + DEFB %00110000 + DEFB %00110000 + DEFB %00101000 + DEFB %00100100 + DEFB %00000000 +; Character: l + DEFB %00000000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00001100 + DEFB %00000000 +; Character: m + DEFB %00000000 + DEFB %00000000 + DEFB %01101000 + DEFB %01010100 + DEFB %01010100 + DEFB %01010100 + DEFB %01010100 + DEFB %00000000 +; Character: n + DEFB %00000000 + DEFB %00000000 + DEFB %01111000 + DEFB %01000100 + DEFB %01000100 + DEFB %01000100 + DEFB %01000100 + DEFB %00000000 +; Character: o + DEFB %00000000 + DEFB %00000000 + DEFB %00111000 + DEFB %01000100 + DEFB %01000100 + DEFB %01000100 + DEFB %00111000 + DEFB %00000000 +; Character: p + DEFB %00000000 + DEFB %00000000 + DEFB %01111000 + DEFB %01000100 + DEFB %01000100 + DEFB %01111000 + DEFB %01000000 + DEFB %01000000 +; Character: q + DEFB %00000000 + DEFB %00000000 + DEFB %00111100 + DEFB %01000100 + DEFB %01000100 + DEFB %00111100 + DEFB %00000100 + DEFB %00000110 +; Character: r + DEFB %00000000 + DEFB %00000000 + DEFB %00011100 + DEFB %00100000 + DEFB %00100000 + DEFB %00100000 + DEFB %00100000 + DEFB %00000000 +; Character: s + DEFB %00000000 + DEFB %00000000 + DEFB %00111000 + DEFB %01000000 + DEFB %00111000 + DEFB %00000100 + DEFB %01111000 + DEFB %00000000 +; Character: t + DEFB %00000000 + DEFB %00010000 + DEFB %00111000 + DEFB %00010000 + DEFB %00010000 + DEFB %00010000 + DEFB %00001100 + DEFB %00000000 +; Character: u + DEFB %00000000 + DEFB %00000000 + DEFB %01000100 + DEFB %01000100 + DEFB %01000100 + DEFB %01000100 + DEFB %00111000 + DEFB %00000000 +; Character: v + DEFB %00000000 + DEFB %00000000 + DEFB %01000100 + DEFB %01000100 + DEFB %00101000 + DEFB %00101000 + DEFB %00010000 + DEFB %00000000 +; Character: w + DEFB %00000000 + DEFB %00000000 + DEFB %01000100 + DEFB %01010100 + DEFB %01010100 + DEFB %01010100 + DEFB %00101000 + DEFB %00000000 +; Character: x + DEFB %00000000 + DEFB %00000000 + DEFB %01000100 + DEFB %00101000 + DEFB %00010000 + DEFB %00101000 + DEFB %01000100 + DEFB %00000000 +; Character: y + DEFB %00000000 + DEFB %00000000 + DEFB %01000100 + DEFB %01000100 + DEFB %01000100 + DEFB %00111100 + DEFB %00000100 + DEFB %00111000 +; Character: z + DEFB %00000000 + DEFB %00000000 + DEFB %01111100 + DEFB %00001000 + DEFB %00010000 + DEFB %00100000 + DEFB %01111100 + DEFB %00000000 +; Character: { + DEFB %00000000 + DEFB %00001110 + DEFB %00001000 + DEFB %00110000 + DEFB %00001000 + DEFB %00001000 + DEFB %00001110 + DEFB %00000000 +; Character: | + DEFB %00000000 + DEFB %00001000 + DEFB %00001000 + DEFB %00001000 + DEFB %00001000 + DEFB %00001000 + DEFB %00001000 + DEFB %00000000 +; Character: } + DEFB %00000000 + DEFB %01110000 + DEFB %00010000 + DEFB %00001100 + DEFB %00010000 + DEFB %00010000 + DEFB %01110000 + DEFB %00000000 +; Character: ~ + DEFB %00000000 + DEFB %00010100 + DEFB %00101000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 + DEFB %00000000 +; Character: Copyright + DEFB %00111100 + DEFB %01000010 + DEFB %10011001 + DEFB %10100001 + DEFB %10100001 + DEFB %10011001 + DEFB %01000010 + DEFB %00111100 \ No newline at end of file