diff --git a/zx-spectrum-rom.asm b/zx-spectrum-rom.asm deleted file mode 100644 index f0122bd..0000000 --- a/zx-spectrum-rom.asm +++ /dev/null @@ -1,17580 +0,0 @@ -;************************************************************************ -;** 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