; *********************************************************************** ; ** An Assembly File to generate a 16K Custom ROM for the ZX Spectrum ** ; *********************************************************************** ; THE 16K "SEA CHANGE" ZX MINIMAL ROM ; modified by Geoff Wearmouth. ; ------------------------- ; Last updated: 13-DEC-2004 ; Release 1.78 ; ------------------------- ; Perceived Mission Statement ; --------------------------- ; To produce a user-friendly operating system for a colour computer to exploit ; the hardware available in the early 1980s. Apart from a few sensible ; alphabetical restrictions, there should be no other limitations other than ; available memory. All the computer's unused memory should be placed at the ; disposal of the user after each statement has executed. Whenever the ; interpreter is expecting a number or a string, then an expression of the ; same type can be substituted ad infinitum. ; This is a "Concept Computer" and the ROM may not recognize the format of ; programs saved from a conventional ZX Spectrum whether they have been saved ; as tapes or snapshots. ; This implementation does not try to maintain common routine addresses such ; as $09F4. Nor are the System Variables compatible with the BASIC manual. ; With the exception of those programs written in BASIC, third-party software ; is unlikely to run on this platform. The program has the network routines ; and the RS232 routines in the main ROM as originally intended. It also has ; the original "Warm reset" NMI service routine which I recently discovered. ; This program is a re-arrangement of other people's code, including the ; open standard "Sinclair Network Standard" and remains the copyright of ; Amstrad PLC and Sinclair Research Ltd. ; Amstrad have kindly given their permission for the redistribution of their ; copyrighted material but retain that copyright. ; TASM cross-assembler directives. ; ( comment out, perhaps, for other assemblers - see Notes at end. ) #define DEFB .BYTE #define DEFW .WORD #define DEFM .TEXT #define ORG .ORG #define EQU .EQU #define equ .EQU ORG 0000 ;***************************************** ;** Part 1. RESTART ROUTINES AND TABLES ** ;***************************************** ; ----------- ; THE 'START' ; ----------- ; At switch on, the Z80 chip is in Interrupt Mode 0. ; It needs to be placed in Interrupt Mode 1. ; This location can also be 'called' to reset the machine. ; Typically with PRINT USR 0. L0000 START DI ; Disable Interrupts. XOR A ; Signal coming from START. LD DE,$FFFF ; Set pointer to top of possible physical RAM. JP START_NEW ; Jump forward to common code at START_NEW. ; ----------------------- ; THE OLD 'ERROR' RESTART ; ----------------------- ; Note. The ERROR restart is to be moved to L0030. ; An instruction fetch on address $0008 may page in a peripheral ROM such as ; the Sinclair Interface 1 or Disciple Disk Interface. This would now be ; disastrous as none of the routines it uses in this ROM are where they used ; to be. Also the network and RS232 are now controlled from this ROM. ; The shadow ROM could also paged by an instruction fetch on address $1708. ; Since this restart is unused, just stick a return here. Leave room for an ; error report but for now use location nine for release number. ; The command PRINT PEEK 9 gives release number. L0008 RESTART8 RET ;+ Disabled. DEFB 78 ;+ unused - but for now has release number. DEFB $FF, $FF, $FF ;+ unused DEFB $FF, $FF, $FF ;+ unused ; ----------------------------- ; THE 'PRINT CHARACTER' RESTART ; ----------------------------- ; 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 main registers (HL, DE, BC). ; This restart is used 21 times. L0010 PRINT_A JP PRINT_A_2 ; Jump forward to continue at PRINT_A_2. ; --- ;;; DEFB $FF, $FF, $FF ; was unused. ;;; DEFB $FF, $FF ; was unused. ; This 5-byte routine is part of the new FORMAT command and has been moved ; here to exploit spare space. (JS) FORMAT_T LD A,C ;+ Get user-supplied TAB width LD ($5BB8),A ;+ Set it RET ;+ Return. ; ------------------------------- ; THE 'COLLECT CHARACTER' RESTART ; ------------------------------- ; 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. L0018 GET_CHAR LD HL,($5B5D) ; Fetch the address from CH_ADD. LD A,(HL) ; Use it to pick up the current character. TEST_CHAR CALL SKIP_OVER ; Routine SKIP_OVER tests if the character is ; relevant. RET NC ; Return if it is significant. ; ------------------------------------ ; THE 'COLLECT NEXT CHARACTER' RESTART ; ------------------------------------ ; As the BASIC commands and expressions are interpreted, this routine is ; called repeatedly to step along the line. It is used 83 times. L0020 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. ; --- ; ------------------ ; THE 'STOP' COMMAND ; ------------------ ; Command Syntax: STOP ; One of the shortest and least used commands. As with 'OK' not an error. ; This has been moved here as two bytes were unused. STOP RST 30H ; ERROR_1 DEFB $08 ; Error Report: STOP statement ;;; DEFB $FF,$FF ; was unused DEFB $FF ; unused. ; ----------------------- ; THE 'CALCULATE' 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. L0028 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' operator. ;;; ; Note. This idea may be re-visited! ; ------------------------- ; THE 'END_CALC' SUBROUTINE ; ------------------------- ; (offset: $38 'end-calc') ; The end-calc literal terminates a mini-program written in the Spectrum's ; internal language. 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 ;+ Switch back to main set. RET ;+ Return. ; --------------------------- ; THE 'RST 30H' ERROR RESTART ; --------------------------- ; This restart is to be used for error handling without paging in Interface1 ; while, at the same time, allowing access to its hardware. ; The error pointer is made to point to the position of the error to enable ; the editor to highlight the error position if it occurred during syntax ; checking. It is used at 37 places in the program although not all errors ; pass through here. L0030 ERROR_1 LD HL,($5B5D) ;+ Fetch the character address from CH_ADD. LD ($5B5F),HL ;+ Copy it to the error pointer X_PTR. JR ERROR_2 ;+ Forward to continue at ERROR_2. ; -------------------------------- ; THE '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. L0038 ; Note Interrupts are automatically disabled. MASK_INT PUSH AF ; Save the registers that will be used. PUSH HL ; ;;; LD HL,($5B78) ; Fetch the first two bytes at FRAMES1. ;;; INC HL ; Increment lowest two bytes of counter. ;;; LD ($5B78),HL ; Place back in FRAMES1. ;;; LD A,H ; Test if the result was zero. ;;; OR L ; ;;; JR NZ,KEY_INT ; Forward, if not, to KEY_INT ;;; ;;; INC (IY+$40) ; otherwise increment FRAMES3 the third byte. ; Note. the above code has been replaced with this neater and shorter ; sequence which also avoids using the IY register. LD HL,$5B78 ;+ Address FRAMES INC (HL) ;+ Increment low byte of counter. JR NZ,KEY_INT ;+ Forward, if not back to zero, to KEY_INT. INC L ;+ Increment address using 4 clock cycles. INC (HL) ;+ Increment middle counter. JR NZ,KEY_INT ;+ Forward, if not back to zero, to KEY_INT. INC L ;+ All the FRAMES addresses have same high byte. INC (HL) ;+ Increment last counter. ; Now save the rest of the main registers and read and decode the keyboard. KEY_INT PUSH BC ; Save the other main registers. PUSH DE ; CALL KEYBOARD ; Routine KEYBOARD executes a stage in the ; process of reading a key-press. ; Only registers HL, DE, BC and AF can be used. POP DE ; Restore all four registers. POP BC ; POP HL ; POP AF ; EI ; Enable Interrupts. RET ; Return. ; --------------------- ; THE 'ERROR_2' ROUTINE ; --------------------- ; A continuation of the code at ERROR_1. ; The error code is stored and, after clearing down the calculator stack, an ; indirect jump is made to the Error Stack Pointer to handle the error. ERROR_2 POP HL ; Drop the return address - the location after ; the error restart. LD L,(HL) ; Fetch the error code that follows. ; 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. ERROR_3 LD (IY+$00),L ; Store it in the system variable ERR_NR. LD SP,($5B3D) ; 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 ; one of the addresses above. ; ----- ; SPARE ; ----- DEFB $FF, $FF, $FF, ;+ Spare DEFB $FF, $FF, $FF, ;+ DEFB $FF, $FF, $FF, ;+ L0066 ; ------------------------------------ ; THE 'NON-MASKABLE INTERRUPT' ROUTINE ; ------------------------------------ ; There was no NMI switch on the standard Spectrum. ; There was however a well-developed NMI routine, reproduced here with one ; major difference. On the original Spectrum the branch to the address held ; in the NMIADD System Variables was taken if the address was zero and not, ; as expected, if the address was non-zero. ; ; Sinclair Research said that, since they had never advertised the NMI, they ; had no plans to fix the error "until the opportunity arose". In fact, the ; location NMIADD was later used by Interface 1 for other purposes. ; On later Amstrad Spectrums, and the Brazilian Spectrum, the logic of this ; routine was reversed but not as at first intended. ; ; The original functionality is resurrected in full here. The clue is the ; rather clumsy initialization of CHARS in the code at RAM_SET . The ; NMIADD System variable now holds the address NMI_PTR by default and the ; code there provides for a Warm Reset which re-initializes the system ; without losing the BASIC program. ; ; In all probability the NMI button would have been on the advertized ; RS232/Network board. ; ; Software houses who didn't want their programs broken into could presumably ; set NMIADD to zero to defeat hackers. NMI PUSH AF ; Save the PUSH HL ; registers. LD HL,($5BB0) ; Fetch the system variable NMIADD. LD A,H ; Test address OR L ; for zero. ;;; JR NZ,NMI_2 ;- Skip to NO_NMI if both bytes default N Z! JR Z,NMI_2 ;+ Skip to NO_NMI if both bytes default ZERO. JP (HL) ; else jump to routine. NMI_2 POP HL ; Restore the POP AF ; registers. NMI_END RETN ; Return to previous interrupt state. ; --------------------------- ; THE '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. CH_ADD__1 LD HL,($5B5D) ; fetch address from CH_ADD. TEMP_PTR1 INC HL ; increase the character address by one. TEMP_PTR2 LD A,(HL) ; load character to A from HL. TEMP_PTR3 LD ($5B5D),HL ; update CH_ADD with character address. RET ; and return. ; -------------------------- ; THE 'SKIP OVER' SUBROUTINE ; -------------------------- ; 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 ; its 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. SKIP_OVER CP $21 ; test if higher than space. RET NC ; return with carry clear if higher. CP $0D ; carriage return ? RET Z ; return, if so, also with carry clear. ; 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, if so, with carry set. ; 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. INC HL ; step over the second character of 'at'/'tab'. SKIPS SCF ; set the carry flag JR TEMP_PTR3 ;+ back to similar code above. ;;; LD ($5B5D),HL ; update the CH_ADD system variable. ;;; RET ; return with carry set. ; ------------------ ; THE '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. TKN_TABLE DEFB '?'+$80 DEFM "RN" DEFB 'D'+$80 DEFM "INKEY" DEFB '$'+$80 DEFB 'P','I'+$80 DEFB 'F','N'+$80 DEFM "POIN" DEFB 'T'+$80 DEFM "SCREEN" DEFB '$'+$80 DEFM "ATT" DEFB 'R'+$80 DEFB 'A','T'+$80 DEFM "TA" DEFB 'B'+$80 DEFM "VAL" DEFB '$'+$80 DEFM "COD" DEFB 'E'+$80 DEFM "VA" DEFB 'L'+$80 DEFM "LE" DEFB 'N'+$80 DEFM "SI" DEFB 'N'+$80 DEFM "CO" DEFB 'S'+$80 DEFM "TA" DEFB 'N'+$80 DEFM "AS" DEFB 'N'+$80 DEFM "AC" DEFB 'S'+$80 DEFM "AT" DEFB 'N'+$80 DEFB 'L','N'+$80 DEFM "EX" DEFB 'P'+$80 DEFM "IN" DEFB 'T'+$80 DEFM "SQ" DEFB 'R'+$80 DEFM "SG" DEFB 'N'+$80 DEFM "AB" DEFB 'S'+$80 DEFM "PEE" DEFB 'K'+$80 DEFB 'I','N'+$80 DEFM "US" DEFB 'R'+$80 DEFM "STR" DEFB '$'+$80 DEFM "CHR" DEFB '$'+$80 DEFM "NO" DEFB 'T'+$80 DEFM "BI" DEFB '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 DEFM "AN" DEFB 'D'+$80 DEFB $3C,'='+$80 ; <= DEFB $3E,'='+$80 ; >= DEFB $3C,$3E+$80 ; <> DEFM "LIN" DEFB 'E'+$80 DEFM "THE" DEFB 'N'+$80 DEFB 'T','O'+$80 DEFM "STE" DEFB 'P'+$80 DEFM "DEF F" DEFB 'N'+$80 DEFM "CA" DEFB 'T'+$80 DEFM "FORMA" DEFB 'T'+$80 DEFM "MOV" DEFB 'E'+$80 DEFM "ERAS" DEFB 'E'+$80 DEFM "OPEN " DEFB '#'+$80 DEFM "CLOSE " DEFB '#'+$80 DEFM "MERG" DEFB 'E'+$80 DEFM "VERIF" DEFB 'Y'+$80 DEFM "BEE" DEFB 'P'+$80 DEFM "CIRCL" DEFB 'E'+$80 DEFM "IN" DEFB 'K'+$80 DEFM "PAPE" DEFB 'R'+$80 DEFM "FLAS" DEFB 'H'+$80 DEFM "BRIGH" DEFB 'T'+$80 DEFM "INVERS" DEFB 'E'+$80 DEFM "OVE" DEFB 'R'+$80 DEFM "OU" DEFB 'T'+$80 DEFM "LPRIN" DEFB 'T'+$80 DEFM "LLIS" DEFB 'T'+$80 DEFM "STO" DEFB 'P'+$80 DEFM "REA" DEFB 'D'+$80 DEFM "DAT" DEFB 'A'+$80 DEFM "RESTOR" DEFB 'E'+$80 DEFM "NE" DEFB 'W'+$80 DEFM "BORDE" DEFB 'R'+$80 DEFM "CONTINU" DEFB 'E'+$80 DEFM "DI" DEFB 'M'+$80 DEFM "RE" DEFB 'M'+$80 DEFM "FO" DEFB 'R'+$80 DEFM "GO T" DEFB 'O'+$80 DEFM "GO SU" DEFB 'B'+$80 DEFM "INPU" DEFB 'T'+$80 DEFM "LOA" DEFB 'D'+$80 DEFM "LIS" DEFB 'T'+$80 DEFM "LE" DEFB 'T'+$80 DEFM "PAUS" DEFB 'E'+$80 DEFM "NEX" DEFB 'T'+$80 DEFM "POK" DEFB 'E'+$80 DEFM "PRIN" DEFB 'T'+$80 DEFM "PLO" DEFB 'T'+$80 DEFM "RU" DEFB 'N'+$80 DEFM "SAV" DEFB 'E'+$80 DEFM "RANDOMIZ" DEFB 'E'+$80 DEFB 'I','F'+$80 DEFM "CL" DEFB 'S'+$80 DEFM "DRA" DEFB 'W'+$80 DEFM "CLEA" DEFB 'R'+$80 DEFM "RETUR" DEFB 'N'+$80 DEFM "COP" DEFB 'Y'+$80 ; ---------------- ; THE '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. 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 ; 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 ; 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 ; 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 ; 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 ; : ; 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. ; ------------------------------- ; THE 'KEYBOARD SCANNING' ROUTINE ; ------------------------------- ; From keyboard and s-inkey$ ; Returns 1 or 2 keys in DE, most significant shift first if any ; key values 0-39 else 255 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 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 KEY_3KEYS INC D ; now test the key buffer RET NZ ; if we have collected 2 keys already ; then too many so quit. 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, if not pressed, to KEY_BITS ; 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. 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 ; ---------------------- ; THE 'KEYBOARD' ROUTINE ; ---------------------- ; Called from the interrupt 50 times a second. ; KEYBOARD CALL KEY_SCAN ; routine KEY_SCAN RET NZ ; return if invalid combinations ; 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,$5B00 ; point to KSTATE_0 K_ST_LOOP BIT 7,(HL) ; is it free ? (i.e. $FF) JR NZ,K_CH_SET ; forward, if so, to K_CH_SET INC HL ; address the 5-counter DEC (HL) ; decrease the counter DEC HL ; step back JR NZ,K_CH_SET ; forward, if not at end of count, to K_CH_SET LD (HL),$FF ; else mark this particular map free. K_CH_SET LD A,L ; make a copy of the low address byte. ;;; LD HL,$5B04 ;- point to KSTATE_4 (Note. ld l,$04 would do) LD L,$04 ;+ point low order byte to KSTATE_4 CP L ; have both sets been considered ? JR NZ,K_ST_LOOP ; back to K_ST_LOOP to consider this 2nd set ; Now the raw key (0-38d) is converted to a main key (uppercase). CALL K_TEST ; routine K_TEST to get main key in A RET NC ; return if just a single shift LD HL,$5B00 ; point to KSTATE_0 CP (HL) ; does the main key code match ? JR Z,K_REPEAT ; forward, if so, to K_REPEAT ; If not consider the second key map for a repeat. ;;; EX DE,HL ; save KSTATE_0 in DE ;;; LD HL,$5B04 ; point to KSTATE_4 LD L,$04 ;+ point to KSTATE_4 CP (HL) ; does the main key code match ? JR Z,K_REPEAT ; forward, if so, to K_REPEAT ; 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 the key map free ? JR NZ,K_NEW ; forward, if so, to K_NEW ;;; EX DE,HL ; bring back KSTATE_0 LD L,$00 ;+ 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. K_NEW LD E,A ; store key in E LD (HL),A ; place in free location INC HL ; advance to the interrupt counter LD (HL),$05 ; and initialize counter to 5 INC HL ; advance to the delay LD A,($5B09) ; pick up the 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, to avoid IY, ; ld l,$41; ld c,(hl); ld l,$3B; ld d,(hl). ; six and two threes of course. LD L,$41 ;+ Avoid IY usage LD C,(HL) ;+ Load C register with system variable MODE. LD L,$3B ;+ LD D,(HL) ;+ Load D register with system variable FLAGS. CALL K_DECODE ; routine K_DECODE POP HL ; restore map pointer LD (HL),A ; put the decoded key in last location of map. K_END LD ($5B08),A ; update LASTK system variable. ;;; SET 5,(IY+$01) ;- update FLAGS - signal a new key. LD L,$3B ;+ HL now addresses FLAGS SET 5,(HL) ;+ signal new key. RET ; return to interrupt routine. ; ----------------------- ; THE 'REPEAT KEY' BRANCH ; ----------------------- ; A possible repeat has been identified. HL addresses the raw key. ; The last location of the key map holds the decoded key from the first ; context. This could be a keyword and, with the exception of NOT, a repeat ; is syntactically incorrect and not really desirable. ; credit: Chris Thornton 1983. K_REPEAT INC HL ; increment the map pointer to second location. LD (HL),$05 ; maintain interrupt counter at 5. INC HL ; now point to third location. DEC (HL) ; decrease the REPDEL value which is used to ; time the delay of a repeat key. RET NZ ; return if not yet zero. LD A,($5B0A) ; Fetch the system variable value REPPER. LD (HL),A ; For subsequent repeats REPPER will be used. INC HL ; Advance ; LD A,(HL) ; Pick up the key decoded possibly in another ; context. ; Note. should compare with $A5 (RND) and make ; a simple return if this is a keyword. ; e.g. cp $a5; ret nc; (3 extra bytes) CP $A5 ;+ Is repeat a keyword ? RET NC ;+ Ignore if a keyword. JR K_END ; Back, to accept key, at K_END ; ---------------------- ; THE 'KEY_TEST' ROUTINE ; ---------------------- ; This is also called from s-inkey$ ; Begin by testing for a shift with no other. K_TEST LD B,D ; Load most significant key to B - will be $FF ; if not shift. LD D,$00 ; 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, if not, to K_MAIN ; but we could have just symbol shift and no other BIT 7,B ; is other key $FF (i.e. not shift) RET NZ ; return with solitary symbol shift. 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) ; ---------------------------------- ; THE 'KEYBOARD DECODING' SUBROUTINE ; ---------------------------------- ; This is also called from s-inkey$ K_DECODE LD A,E ; pick up the stored main key K_DECODE2 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 not augment the keycode if code > 'U' ($55). ; (s-inkey$ never gets into graphics mode.) CP 'V' ;+ Compare with non graphic keys. JR C,ADDIT ;+ Skip forward if this key has a UDG. POP AF ;+ Drop return address. POP HL ;+ Stored value points to end of a map. XOR A ;+ Set key value to zero. LD L,A ;+ Form address KSTATE-0 LD (HL),A ;+ Blank the key. LD L,$04 ;+ Form address KSTATE-5 LD (HL),A ;+ Blank the other key. RET ;+ Return to Interrupt ADDIT ADD A,$4F ; add offset to augment 'A' to graphics A say. RET ; return. ; Note. ( but [GRAPH] V gave RND, etc ). ; --- ; the jump was to here with extended mode with uppercase A-Z. K_E_LET LD HL,E_UNSHIFT-$41; base address of E_UNSHIFT. INC B ; test B is it empty i.e. not a shift. JR Z,K_LOOK_UP ; forward, if neither shift, to K_LOOK_UP LD HL,EXT_SHIFT-$41; Address: EXT_SHIFT base 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 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, if so, to K_TOKENS ;;; BIT 3,(IY+$30) ;- test FLAGS2 - consider CAPS LOCK ? LD HL,$5B6A ;+ Address sysvar FLAGS2 using HL not IY BIT 3,(HL) ;+ test FLAGS2 - consider CAPS LOCK ? RET NZ ; return, if so, with main code. INC B ; is shift being pressed ? RET NZ ; return if shift pressed. ADD A,$20 ; else convert the code to lower case. RET ; return. ; --- ; the jump was here for tokens 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) 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 ; base of E_DIGITS BIT 5,B ; test - shift=$27 sym-shift=$18 JR Z,K_LOOK_UP ; back to K_LOOK_UP if sym-shift CP $38 ; is character '8' ? JR NC,K_8_and_9 ; to K_8_&_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 ; --- 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 to give 0 and 1 ; flash codes. RET ; Return. ; --- ; graphics mode with digits K_GRA_DGT LD HL,CTL_CODES-$30; 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 accumulator bits -gives range $88-$8F. RET ; return. ; --- ; now digits in 'KLC' mode 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, if so, to K_@_CHAR CP $20 ; character '_' is the other one that fails RET NZ ; return if not. LD A,$5F ; substitute ASCII '_' RET ; return. ; --- 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. ; ----------------------- ; THE 'BEEPER' SUBROUTINE ; ----------------------- ; 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%. ; ; 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_p_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,($5B48) ; 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 BE_IX_p_3 NOP ;(4) optionally executed NOPs for small ; adjustments to tone period BE_IX_p_2 NOP ;(4) BE_IX_p_1 NOP ;(4) BE_IX_p_0 INC B ;(4) INC C ;(4) BE_H_L_LP DEC C ;(4) timing loop for duration of JR NZ,BE_H_L_LP ;(12/7) high or low pulse of waveform LD C,$3F ;(7) DEC B ;(4) JP NZ,BE_H_L_LP ;(10) JUMP to BE_H&L_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 ;(2/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 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 BE_END EI ; Enable Interrupts RET ; ; ------------------ ; THE '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 ; 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,$5B92 ; 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 ; 'Integer out of range' 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 ; 'Integer out of range' 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 ; 'Integer out of range' ; 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 ; and A=pitch+60 -> 0<=A<=187 BE_I_OK LD B,$FA ; 6 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 ; 'Integer out of range' ;;; following calculation finds the tone period for HL and the cycle count ;;; DE expected in the BEEPER subroutine. From the example in the BEEPER comments, ;;; ;;; ((fCPU / f) - 236) / 8 = fCPU/8/f - 236/8 = 437500/f -29.5 ;;; duration * frequency - 1 ;;; ;;; the different constant (30.125) used in the calculation of HL ;;; w. 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 $6C ;;($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 ; jump back to BEEPER ; --- REPORT_B RST 30H ; ERROR_1 DEFB $0A ; Error Report: Integer out of range ; --------------------- ; THE 'SEMI-TONE' TABLE ; --------------------- ; ; Holds frequencies corresponding to semitones in middle octave. ; To move n octaves higher or lower, frequencies are multiplied by 2^n. 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 ; ------------------------------------- ; Text for banner of CAT command ; ------------------------------------- CAT1 DEFB $14,$01 ; Control codes for INVERSE 1 DEFB $CF ; The ' CAT ' token. DEFB $06 ; The 'comma control' DEFM "Free " ; Text. CAT2 DEFB 0,0 ; ballast ;**************************************** ;** 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. ; ----------------------- ; THE 'ZX81 NAME' ROUTINE ; ----------------------- ; This routine fetches a filename in ZX81 format and is not used by the ; cassette handling routines in this ROM. ;;; zx81-name ;;; L04AA: CALL SCANNING ; routine SCANNING to evaluate expression. ;;; LD A,($5B3B) ; 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 ; ; --------------------------- ; THE 'SAVE BYTES' SUBROUTINE ; --------------------------- ; 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 - ; DE holds the length of data. ; IX points to the start. ; The accumulator is set to $00 for a header, $FF for data. TAG1 L04C2: SA_BYTES LD HL,SA_LD_RET ; address: SA/LD_RET PUSH HL ; is pushed as common exit route. 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. 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. ; Note. the next location is trapped by emulators, see Z80.doc, in order to ; save bytes to a real tape recorder. The address should be $04D8 ; However saving on emulators is not supported. TAG2 L04D8: 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 sync pulse. At this stage mic is off and A holds value ; for mic on. ; A sync pulse is much shorter than the steady pulses of the lead-in. LD B,$2F ; another short timed delay. SA_SYNC_1 DJNZ SA_SYNC_1 ; self loop to SA-SYNC-1 OUT ($FE),A ; switch to mic on and red colour. LD A,$0D ; prepare mic off - cyan LD B,$37 ; another short timed delay. 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. 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. SA_LOOP_P LD A,H ; fetch parity byte. XOR L ; exclusive or with new byte. ; -> the mid entry point of loop. 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-> ; --- 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. ; --- ; The 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. 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. ; The 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. 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) SA_SET DJNZ SA_SET ; self loop to SA-SET ; (roughly an extra 66*13 clock cycles) 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 i.e. NZ. ; -8-> 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. SA_DELAY DJNZ SA_DELAY ; self loop to SA-DELAY RET ; return - - > ; ------------------------------ ; THE 'SAVE/LOAD RETURN' ROUTINE ; ------------------------------ ; 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. ; ; - - > SA_LD_RET PUSH AF ; preserve accumulator throughout. ;;; LD A,($5B48) ; 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. CALL BORD_REST ;+ Use new routine to restore 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, if not, to SA/LD-END REPORT_Da RST 30H ; ERROR-1 DEFB $0C ; Error Report: BREAK - CONT repeats ; --- SA_LD_END POP AF ; restore the accumulator. RET ; return. DEFB 0,0,0,0,0,0,0,0 ; ballast 2 ; --------------------------- ; THE 'LOAD BYTES' SUBROUTINE ; --------------------------- ; 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 to be verified only. TAG3 L0556: 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. ; Note. the next locations is trapped by emulators, see Z80.doc in order to ; load bytes from a tape recorder. No longer supported. Was L056A TAG4 L056A: CP A ; set the zero flag. ; LD_BREAK RET NZ ; return if at any time space is pressed. 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. 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, if not zero, to LD-WAIT ; 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, if no edges at all, to LD-BREAK LD_LEADER LD B,$9C ; set timing value. CALL LD_EDGE_2 ; routine LD-EDGE-2 JR NC,LD_BREAK ; back, if time-out, to LD-BREAK 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, while more to do, to LD-LEADER ; Note. H is zero again. ; sample indicates we are in the middle of a two or five second lead-in. ; Now test every edge looking for the terminal sync signal. LD_SYNC LD B,$C9 ; initial timing value in B. CALL LD_EDGE_1 ; routine LD-EDGE-1 JR NC,LD_BREAK ; back, with time-out, to LD-BREAK LD A,B ; fetch augmented timing value from B. CP $D4 ; compare JR NC,LD_SYNC ; back, if gap too big, to LD-SYNC ; it is a normal lead-in edge gap. ; but a short gap will be the sync 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 sync 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. 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, if not to be loaded, to LD-VERIFY LD (IX+$00),L ; place loaded byte at memory location. JR LD_NEXT ; forward to LD-NEXT ; --- 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 expected data type matches first byte received. 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 ? ; Timing. ; --- ; For verification the byte read from tape is compared with that in memory. LD_VERIFY LD A,(IX+$00) ; fetch byte from memory. XOR L ; compare with that on tape RET NZ ; return if not zero. ; Note. the report 'Verification has failed' could be added. LD_NEXT INC IX ; Increment the byte pointer. 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. LD_MARKER LD L,$01 ; initialize as %00000001 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 the carry flag is set, then the marker bit has been passed out and ; the received 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, while there are more, to LD-LOOP ; When all bytes loaded then parity byte should be zero. LD A,H ; fetch the adjusted parity byte. CP $01 ; set carry if zero. RET ; return ; If 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. ; -> 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. LD_EDGE_1 LD A,$16 ; a delay value of twenty two. LD_DELAY DEC A ; decrement counter JR NZ,LD_DELAY ; loop back to LD-DELAY 22 times. AND A ; clear carry. 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 the change of colour. SCF ; set carry flag signaling edge found within ; time allowed. RET ; return. ; ------------------------------------------ ; THE 'SAVE, LOAD, VERIFY AND MERGE' COMMAND ; ------------------------------------------ ; 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 original arrangement) gives a value of ; $00 - SAVE ; $01 - LOAD ; $02 - VERIFY ; $03 - MERGE ; Note. as the Syntax table is in ROM then bit 7 of T_ADDR_hi must be reset ; This bit can be used to indicate a non-tape operation. ; As with all commands, the address STMT-RET is on the stack. SAVE_ETC POP AF ; discard the address STMT-RET. ; Now reduce the low byte of the Syntax table entry to give command. LD HL,$5B74 ; Address T_ADDR LD A,(HL) ; fetch value. SUB P_SAVE +1 % 256 ; subtract the known offset. LD (HL),A ; and put back for future reference. ;;; LD A,($5B74) ; fetch the low order address byte of T_ADDR. ;;; SUB P_SAVE +1 % 256 ; subtract the known offset. ;;; LD ($5B74),A ; and put back for future reference. ;;; CALL SYNTAX_Z ; checking syntax ;;; JR Z,SA_STRM ; LD A,$FD ; select system channel 'K' CALL CHN_O_SYN ; and set as a default for tape message. ;;; CALL CHAN_SLCT ; routine CHAN-OPEN SA_STRM CALL STR_ALTER ;+ Allow for SAVE #8; JR C,SA_EXP ;+ forward if no stream specified. ; If a stream has been specified then check for a separator and set bit ; of T_ADDR_hi to show Tape is not being used as medium. ; e.g. SAVE #7,"marsupials" LOAD #15; "" SCREEN$ CALL CLASS_0C ;+ check for a separator SET 7,(IY+$3B) ;+ flag extended command by setting T_ADDR_hi SA_EXP CALL EXPT_EXP ; routine EXPT-EXP checks that a CLASS_0A ; string expression follows and stacks the ; parameters in run-time. CALL SYNTAX_Z ; routine SYNTAX-Z JR Z,SA_DATA ; forward, if checking syntax, to SA-DATA ; In runtime create the workspace which is addressed by IX register. LD BC,$0011 ; presume seventeen bytes for a SAVE header. LD A,($5B74) ; fetch command from T_ADDR_lo. AND A ; test for zero, the SAVE command. JR Z,SA_SPACE ; forward, if so, to SA-SPACE LD C,$22 ; else double length to thirty four. SA_SPACE CALL BC_SPACES ; BC_SPACES creates 17/34 bytes in workspace. PUSH DE ; transfer the start of the new space to the POP IX ; 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. 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 a null string. ; Now have $FF $20 $20... 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 the true length. JR NC,SA_NAME ; forward, if length 1 - 10 to SA-NAME ; The filename is more than ten characters in length or the null string. LD A,($5B74) ; fetch command from T_ADDR. AND A ; test for zero, the SAVE command. ;;; JR NZ,SA_NULL ; forward, if not SAVE, to SA-NULL JP Z,REPORT_F ; forward, if command is SAVE, to report ; 'Invalid file name' ; This could be a null filename or one greater than ten characters in length ; neither of which is acceptable for the SAVE command. ; The first ten characters of any other command parameter are acceptable. ;;; REPORT_Fa RST 30H ; ERROR-1 ;;; DEFB $0E ; Error Report: Invalid file name ; continue with LOAD, MERGE, VERIFY and also SAVE within ten character limit. SA_NULL LD A,B ; test length of filename OR C ; for zero. JR Z,SA_DATA ; forward, if zero, to SA-DATA ; using $FF indicator followed by spaces. LD BC,$000A ; else trim length to ten. ; other paths rejoin here with BC holding length in range 1 - 10. 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. SA_DATA RST 18H ; GET-CHAR CP $E4 ; is character after filename the token 'DATA' ? JR NZ,SA_SCREEN ; forward, if not, to SA_SCREEN ; to consider SCREEN$ ; continue to consider DATA. LD A,($5B74) ; fetch command from T_ADDR CP $03 ; is it 'VERIFY' ? ; VERIFY "d" DATA is not allowed. JR Z,REPORT_Ca ; forward, if so, to REPORT-Ca. ; 'Nonsense in BASIC' ; continue with SAVE, LOAD, MERGE of DATA. RST 20H ; NEXT-CHAR points to the array variable. CALL LOOK_VARS ; routine LOOK-VARS searches variables area ; returning with carry reset if found or ; checking syntax. ; CH_ADD points to opening bracket. 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, if variable found, to SA-V-OLD ; This is the runtime path only. LD HL,$0000 ; set destination to zero as not fixed. LD A,($5B74) ; fetch command from T_ADDR DEC A ; test for 1 - LOAD JR Z,SA_V_NEW ; forward, with LOAD DATA, to SA-V-NEW ; to load a new array. ; otherwise the variable was not found in run-time with SAVE/MERGE. REPORT_2a RST 30H ; ERROR-1 DEFB $01 ; Error Report: Variable not found ; continue with SAVE and LOAD of DATA SA_V_OLD JR NZ,REPORT_Ca ; forward, if not an array, to REPORT_Ca ; 'Nonsense in BASIC' CALL SYNTAX_Z ; routine SYNTAX-Z JR Z,SA_DATA_1 ; forward, if checking syntax, to SA-DATA-1 ; In runtime exclude a simple string by examining the VARS letter. ; Note. the standard ROM allows these to be saved but errors when they are ; subsequently loaded. ; credit: Dr. Ian Logan in The Complete Spectrum ROM Disassembly. ; solution: also by Dr. Ian Logan, in the Interface 1 ROM. BIT 7,(HL) ;+ test VARS letter - is it a simple string ? JR Z,REPORT_Ca ;+ back, if so, to REPORT_Ca ; Now transfer the array's details to the tape descriptor. INC HL ; step past single letter array variable name. LD A,(HL) ; fetch low byte of array length. LD (IX+$0B),A ; place in descriptor. INC HL ; point to high byte of array length. LD A,(HL) ; and transfer that LD (IX+$0C),A ; to descriptor. INC HL ; increase pointer within variable. ; The two runtime paths converge here. There is no syntax path error. SA_V_NEW LD (IX+$0E),C ; place the character array letter, formed ; earlier, in the header. LD A,$01 ; default the array type to numeric. BIT 6,C ; test the result from the LOOK-VARS routine. JR Z,SA_V_TYPE ; forward, if numeric, to SA-V-TYPE INC A ; set type to 2 - a string array. SA_V_TYPE LD (IX+$00),A ; place type 0, 1 or 2 in descriptor. ; The syntax path rejoins here. SA_DATA_1 EX DE,HL ; save var pointer in DE ; Note. LOOK_VARS left CH_ADD pointing at '(' in, say, SAVE "name" DATA a(). RST 20H ; NEXT-CHAR ;;; CP $29 ; is character ')' ? ;;; JR NZ,SA_V_OLD ; back, if not, to SA-V-OLD ;;; RST 20H ; NEXT-CHAR advances character address. CALL RBRKT_NXT ;+ check for right hand bracket and advances. CALL CHECK_END ; routine CHECK-END errors if not at end of ; the statement. EX DE,HL ; bring back variables data pointer. JR RJ_SA_ALL ; jump forward to SA-ALL. ; --- ; ; --- TST_COM_0 XOR A ; default comparison TST_COM CP (IY+$3A) ; compare A to T_ADDR_lo RET NZ ; return if not. REPORT_Ca RST 30H ; ERROR-1 DEFB $0B ; 'Nonsense in BASIC' ; the branch was here to consider a 'SCREEN$', the display file. SA_SCREEN CP $AA ; is character the token 'SCREEN$' ? JR NZ,SA_CODE ; forward, if not, to SA_CODE ;;; LD A,($5B74) ; fetch command from T_ADDR_lo ;;; CP $03 ; is it 'MERGE' ? ;;; JR NZ,SA_SCR_OK ; skip forward, if not, to SA_SCR_OK ;;; RST 30H ; ERROR-1 ;;; DEFB $0B ; 'Nonsense in BASIC' LD A,$03 ;+ Produce an error CALL TST_COM ;+ if command is 'MERGE' ; --- ; continue with SAVE/LOAD/VERIFY SCREEN$. SA_SCR_OK RST 20H ; NEXT-CHAR advances past command CALL CHECK_END ; routine CHECK-END errors if not at end of ; statement. ; continue in runtime. LD HL,$4000 ;+ set start to display file start. ;;; LD (IX+$0B),$00 ; set descriptor length LD (IX+$0B),L ;+ 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. 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,($5B74) ; fetch command from T_ADDR ;;; CP $03 ; is it MERGE ? ;;; JR Z,REPORT_Ca ; back, if so, to REPORT-Ca. LD A,$03 ;+ Produce an error CALL TST_COM ;+ if command is 'MERGE' 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, if there are parameters, to SA-CODE-1 ;;; LD A,($5B74) ; else fetch the command from T_ADDR. ;;; AND A ; test for zero - SAVE without a specification. ;;; JR Z,REPORT_Ca ; back, if so, to REPORT-Ca. CALL TST_COM_0 ;+ Test that command is not zero - SAVE ; For LOAD and VERIFY put a zero on the stack to signal use the address that ; the code was saved from. CALL USE_ZERO ; routine USE-ZERO stacks a zero in runtime. JR SA_CODE_2 ; forward to SA-CODE-2 ; --- ; if there are more characters after CODE expect start and possibly length. SA_CODE_1 CALL EXPT_1NUM ; routine EXPT-1NUM checks for numeric ; expression and stacks it in run-time. RST 18H ; GET-CHAR was the last instruction. 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,($5B74) ; fetch command from T_ADDR. ;;; AND A ; is the command SAVE which requires length ? ;;; JR Z,REPORT_Ca ; back, if so, to REPORT-Ca CALL TST_COM_0 ;+ Test that command is not zero - SAVE ; the command 'LOAD CODE' may rejoin here with zero handled as start. SA_CODE_2 CALL USE_ZERO ; routine USE-ZERO stacks zero for length ; if not checking syntax. JR SA_CODE_4 ; forward to SA_CODE_4 ; --- ; the branch was here with SAVE CODE start, SA_CODE_3 RST 20H ; NEXT-CHAR advances character address. CALL EXPT_1NUM ; routine EXPT_1NUM checks for an expression ; and stacks in run-time. ; paths converge here and nothing must follow. SA_CODE_4 CALL CHECK_END ; routine CHECK-END errors with extraneous ; characters and quits if checking syntax. ; in runtime 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. SA_TYPE_3 LD (IX+$00),$03 ; place type 3 - 'CODE' in descriptor. RJ_SA_ALL JR SA_ALL ; forward to SA-ALL. ; --- ; the branch was here with BASIC to consider an optional auto-start line ; number e.g. ; SAVE "some name" LINE ; SAVE "fruitbats" LINE 200 SA_LINE CP $CA ; is character the token 'LINE' ? JR Z,SA_LINE_1 ; forward, if so, to SA-LINE-1 ; 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 a high line number in descriptor LD B,$80 ; set B to $80 as a disabling value. JR SA_TYPE_0 ; forward, to save program, to SA-TYPE-0 ; --- ; the branch was here to consider auto-start. ; Note. both the BASIC manual and the Pocket Book state that the line number ; may be omitted SA_LINE_1 LD A,($5B74) ; fetch command from T_ADDR AND A ; test for SAVE. JR NZ,REPORT_Ca ; jump forward, with anything else, to REPORT-C ; 'Nonsense in BASIC' ; RST 20H ; NEXT-CHAR ;;; CALL EXPT_1NUM ; routine EXPT_1NUM checks for numeric ;;; ; expression and stacks in run-time. CALL FETCH_NUM ;+ routine FETCH_NUM checks for numeric ;+ expression and stacks in run-time defaulting ;+ to zero. CALL CHECK_END ; routine CHECK-END quits if syntax path. CALL FIND_LINE ; New routine FIND-LINE fetches a valid line ; number expression to BC. LD (IX+$0D),C ; place the valid auto-start SA_TYPE_0 LD (IX+$0E),B ; line number in the descriptor. ; continue to save program and any variables. ; Note. label has been moved back. sa_type_0 LD (IX+$00),$00 ; place type zero - program in descriptor. LD HL,($5B59) ; fetch E_LINE to HL. LD DE,($5B53) ; 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,($5B4B) ; load HL from system variable VARS SBC HL,DE ; subtract to give program length only. LD (IX+$0F),L ; place length of program LD (IX+$10),H ; in the descriptor. EX DE,HL ; Transfer start to HL, length to DE. SA_ALL LD A,($5B74) ; fetch command from system variable T_ADDR_lo AND A ; test for zero - SAVE. JP Z,SA_CONTRL ; jump forward, with SAVE, to SA-CONTRL -> ; ----------------------------------- ; THE 'LOAD, MERGE and VERIFY' BRANCH ; ----------------------------------- ; 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. LD_LOOK_H PUSH IX ; save IX LD DE,$0011 ; seventeen bytes XOR A ; reset zero flag SCF ; set carry flag to signal load the bytes. CALL LD_BYTES2 ; routine LD-BYTES loads a header from tape ; to second descriptor. POP IX ; restore IX. JR NC,LD_LOOK_H ; loop back, until header found, to LD-LOOK-H ;;; LD A,$FE ; select system channel 'S' ;;; CALL CHAN_SLCT ; routine CHAN-OPEN opens system channel. 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 0 - 3 placed in ; header by this ROM. JR NZ,LD_TYPE ; forward, with mismatch, to LD-TYPE LD C,$F6 ; set C to minus ten - will count characters ; up to zero. LD_TYPE CP $04 ; check if type is in acceptable range 0 - 3. JR NC,LD_LOOK_H ; back, with 4 and above, to LD-LOOK-H LD_TYPE_M LD DE,type_msgs ; address base of last 4 tape messages ;;; PUSH BC ; save BC ;;; CALL PO_MSG ; routine PO-MSG outputs relevant message. CALL DISP_MSG ;+ routine DISP_MSG outputs relevant message. ;;; 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 back to 1st descriptor. LD B,$0A ; the count will be ten characters for the ; filename. ; Check if user has typed something like LOAD "". LD A,(HL) ; fetch first character of filename and test INC A ; for the value $FF. JR NZ,LD_NAME ; forward, if not the $FF wildcard, to LD-NAME ; but if it is the wildcard, then add ten to C, which holds 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 the state set here. LD A,C ; transfer $F6 or $80 to A ADD A,B ; add $0A LD C,A ; place result, $00 or $8A, 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. LD_NAME INC DE ; Address the 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, with mismatch, to LD-CH-PR INC C ; Increment C - the matched character count. LD_CH_PR AND A ;+ clear carry for 1 character. CALL DISP_MSG ;+ call directly as screen is known ;;; RST 10H ; PRINT-A prints the character. DJNZ LD_NAME ; loop back, for ten characters, to LD-NAME ; if ten characters matched, and the types previously matched, then C will ; now hold zero. BIT 7,C ; test if all characters matched JR NZ,LD_LOOK_H ; back, if not, to LD-LOOK-H ; else, if name matched, print a terminal carriage return. LD A,$0D ; prepare carriage return. ????? ;;; RST 10H ; PRINT-A outputs it. CALL DISP_MSG ;+ Call print directly. ; The various control routines for LOAD, VERIFY and MERGE are now executed ; during the one-second gap following the header on tape. POP HL ; (*) restore START LD A,(IX+$00) ; Fetch the validated incoming type. CP $03 ; compare with type for CODE. JR Z,VR_CONTRL ; forward, if it is CODE, to VR-CONTRL ; to load or verify CODE data. ; type is a PROGRAM or an ARRAY. LD A,($5B74) ; fetch command from T_ADDR DEC A ; was it LOAD ? JR Z,LD_CONTRL ; JUMP forward, if so, to LD-CONTRL ; to load BASIC or variables. CP $02 ; was command MERGE ? JP Z,ME_CONTRL ; jump forward, if so, to ME-CONTRL ; else continue into VERIFY control routine to verify. ; ---------------------------- ; THE 'VERIFY CONTROL' ROUTINE ; ---------------------------- ; 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. VR_CONTRL 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 is unspecified ; e.g. LOAD "x" CODE ; as opposed to, say, LOAD 'x' CODE 32768,300. SBC HL,DE ; subtract the new length from the old length. JR C,REPORT_R ; forward to REPORT-R if the length on tape is ; larger than that specified in command. ; 'Loading error' JR Z,VR_CONT_1 ; forward, if lengths match, to VR-CONT-1 ; a length on tape shorter than expected is only allowed for CODE XX LD A,(IX+$00) ; Fetch type from tape. CP $03 ; Is it CODE ? JR NZ,REPORT_R ; forward, if not, to REPORT-R ; 'Loading error' VR_CONT_1 POP HL ; pop the pointer to the data LD A,H ; test for zero OR L ; e.g. LOAD 'x' CODE JR NZ,VR_CONT_2 ; forward, if destination given, to VR-CONT-2 LD L,(IX+$0D) ; else use the destination in the header LD H,(IX+$0E) ; and load code at address saved from. VR_CONT_2 PUSH HL ; push the pointer to the start of data block. POP IX ; transfer to IX. LD A,($5B74) ; fetch the reduced command from T_ADDR CP $02 ; is it VERIFY ? ;;; SCF ; prepare a set carry flag ;;; JR NZ,VR_CONT_3 ; skip, if not, to VR-CONT-3 JR Z,LD_BLOCK ;+ skip, if VERIFY, to LD_BLOCK ;+ with carry clear. ;;; AND A ; clear carry flag for VERIFY ; ------------------------------------------- ; THE NEW 'LOAD BLOCK' WITH CARRY SET ROUTINE ; ------------------------------------------- ; This saves some bytes by consolidating the most popular conditions. LD_BLCK_C SCF ;+ Set carry flag so that data is loaded. ; Continue to use, for verification, the same routine used to LOAD data. ;;; VR_CONT_3 LD A,$FF ; signal data block to be loaded ; ----------------------------- ; THE 'LOAD DATA BLOCK' ROUTINE ; ----------------------------- ; 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. ;;; LD_BLOCK CALL LD_BYTES ; routine LD-BYTES LD_BLOCK LD A,$FF ;+ signal data block to be loaded, not header. CALL LD_BYTES2 ; routine LD-BYTES RET C ; return if successful. REPORT_R RST 30H ; ERROR-1 1a DEFB $1A ; Error Report: Loading error ; -------------------------- ; THE 'LOAD CONTROL' ROUTINE ; -------------------------- ; This branch is taken when the command is LOAD with type 0, 1 or 2. 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 which indicates OR L ; an array - types 1 or 2. JR NZ,LD_CONT_1 ; forward, if not, to LD-CONT-1 INC DE ; increase array length INC DE ; for letter name INC DE ; and 16-bit length. EX DE,HL ; transfer adjusted length to HL. JR LD_CONT_2 ; forward to LD-CONT-2 ; --- ; The branch was here with type PROGRAM. 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 LD_CONT_2 LD DE,$0005 ; allow an 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. 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 which OR L ; indicates 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 array length LD B,(HL) ; transfer to B. DEC HL ; address low byte of total array 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 ($5B5F),IX ; save header pointer in X_PTR which is ; updated by the POINTERS routine. CALL RECLAIM_2 ; routine RECLAIM-2 reclaims the old variable ; sliding workspace including the two headers ; downwards. LD IX,($5B5F) ; reload IX from X_PTR which will have been ; adjusted down by the POINTERS routine. ;;; LD_DATA_1 LD HL,($5B59) ; address E_LINE ;;; DEC HL ; now point to the $80 variables end-marker. LD_DATA_1 CALL L_EL_DHL ; instead of prev 2 lines. 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 the letter name INC BC ; and two total length bytes. 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 the 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. TX_BLK_C PUSH HL ; transfer the address LD_BLK_R POP IX ; to IX register pair. ;;; SCF ; set carry flag indicating load not verify. ;;; LD A,$FF ; signal data not header. JR LD_BLCK_C ;+ JUMP back to LD-BLOCK ; --- ; The branch is here when a PROGRAM, as opposed to an ARRAY, is to be loaded. LD_PROG EX DE,HL ; transfer data destination to DE. CALL L_EL_DHL ;+ instead of next 2 lines? ;;; LD HL,($5B59) ; address E_LINE ;;; DEC HL ; now address variables end-marker. LD ($5B5F),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 the new length. PUSH HL ; * save start PUSH BC ; ** and length. CALL MAKE_ROOM ; routine MAKE-ROOM creates the space. LD IX,($5B5F) ; 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 ($5B4B),HL ; set the system variable VARS LD H,(IX+$0E) ; fetch high byte of autostart line number. ; Note. although the line number is checked at SAVE time, this check is ; still relevant as by default auto-start is inhibited. LD A,H ; transfer to A AND $C0 ; test if greater than $3F. JR NZ,LD_PROG_1 ; forward, if so, to LD-PROG-1 ; with no autostart. LD L,(IX+$0D) ; fetch the low byte. LD ($5B42),HL ; set system variable NEWPPC to line number ;;; LD (IY+$0A),$00 ; set statement NSPPC to zero. LD (IY+$0A),A ; set statement NSPPC to zero. 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_BLCK_C ; jump back to LD-BLOCK JR LD_BLK_R ;+ NEW relative jump back to LD-BLOCK routine ;+ at the instruction POP IX ; --------------------------- ; THE 'MERGE CONTROL' ROUTINE ; --------------------------- ; The branch was here to merge a program and its variables or an array. ; ME_CONTRL LD C,(IX+$0B) ; fetch length LD B,(IX+$0C) ; of data block on tape. PUSH BC ; save it. INC BC ; add one for the end-marker. CALL BC_SPACES ; routine 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 address of first location. ;;; PUSH HL ; and transfer first location ;;; POP IX ; to IX register. ;;; SCF ; set carry flag to load data on tape. ;;; LD A,$FF ; signal data not a header. CALL TX_BLK_C ;+ routine LD-BLOCK loads to workspace. POP HL ; restore first location in workspace to HL. LD DE,($5B53) ; set DE from system variable PROG. ; now enter a loop to merge the data block in workspace with the program and ; variables. 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 or ; end-marker. ; Continue when HL, the WORKSPACE pointer, still addresses a BASIC line number. ME_OLD_LP LD A,(DE) ; fetch high byte from PROGRAM area. INC DE ; increment the PROGRAM address. CP (HL) ; compare with line number in WORKSPACE. INC HL ; increment 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 low byte in WORKSPACE. 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. 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. ; New variables are easier than program lines as they are merely added at ; the end of the VARIABLES area. ME_VAR_LP LD A,(HL) ; fetch first byte of workspace variable. LD C,A ; copy to C also. CP $80 ; is it the workspace VARIABLES end-marker ? RET Z ; return, if so, as MERGE is complete. >>>>> PUSH HL ; save workspace area pointer. LD HL,($5B4B) ; load HL with VARS - start of variables area. ME_OLD_VP LD A,(HL) ; fetch first byte. CP $80 ; is it the VARIABLES 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, with a match, to ME-OLD-V2 ; to replace. ; else entire variables area has to be searched. 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. 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. 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, with a mismatch, to ME-OLD-V4 RLA ; test if it is the terminal inverted character. JR NC,ME_OLD_V3 ; loop back, if more to test, to ME-OLD-V3 ; otherwise the long name matches in its entirety. POP HL ; restore pointr to first character of variable JR ME_VAR_L1 ; forward to ME-VAR-L1 ; --- ; the branch is here when two characters don't match 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 ME_VAR_L1 LD A,$FF ; indicate a replacement. ; this entry point is when A holds $80 indicating a new variable. 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 ; ----------------------------------------- ; THE 'MERGE A LINE OR VARIABLE' SUBROUTINE ; ----------------------------------------- ; A BASIC line or variable is inserted at the current point. If the line ; number or variable names match (zero flag set) then a replacement takes ; place. ME_ENTER JR NZ,ME_ENT_1 ; forward, for insertion only, to ME-ENT-1 ; but the program line or variable matches so old one is reclaimed. EX AF,AF' ; save carry - prog/var flag LD ($5B5F),HL ; preserve workspace pointer in dynamic X_PTR EX DE,HL ; transfer program dest pointer to HL. ;;; CALL NEXT_ONE ; routine NEXT-ONE finds the following location ;;; ; in program or variables area. ;;; CALL RECLAIM_2 ; routine RECLAIM-2 reclaims the space between. CALL NXT_1_RC2 ;+ routine combines above 2 routines. EX DE,HL ; transfer program dest pointer back to DE. LD HL,($5B5F) ; fetch adjusted workspace pointer from X_PTR EX AF,AF' ; restore carry - program/variable flag. ; now the new line or variable is entered. ME_ENT_1 EX AF,AF' ; save or re-save carry - prog/var flag. 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 ($5B5F),HL ; store pointer in X_PTR LD HL,($5B53) ; 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 back carry - prog/var flag. JR C,ME_ENT_2 ; skip, if handling a variable, to ME-ENT-2 CALL MK_RM_DHL ;+ MAKE_ROOM decrementing HL first ;;; DEC HL ; address location before pointer ;;; CALL MAKE_ROOM ; routine MAKE-ROOM creates room for BASIC line INC HL ; address next. (keep this one) JR ME_ENT_3b ; forward to ME-ENT-3 ; --- ME_ENT_2 CALL MAKE_ROOM ; routine MAKE-ROOM creates room for variable. ;;; me_ent_3 INC HL ; address next? ME_ENT_3b POP BC ; ** pop length EX DE,HL ;+ DE now holds first new location ; Note. HL is now used instead of DE POP HL ; * pop value for PROG which may have been ; altered by POINTERS if first line. LD ($5B53),HL ; set PROG back to original value. LD HL,($5B5F) ; fetch adjusted workspace pointer from X_PTR PUSH BC ; save the length. PUSH HL ; and save the workspace pointer. ;;; EX DE,HL ; make workspace pointer the 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. ; -------------------------- ; THE 'SAVE CONTROL' ROUTINE ; -------------------------- ; 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. ; For tape, ; HL points to start of data. ; IX points to start of descriptor. ; For RS232 and network, ; HL points to the start of the data ; IX points to start of descriptor. ; If saving to tape then channel 'K' will be open for messages. SA_CONTRL PUSH HL ; save start of data. ;;; LD A,$FD ; select system channel 'K' ;;; CALL CHAN_SLCT ; routine CHAN-OPEN CALL IN_CHAN_K ; is tape being used ? JR NZ,SA_CBN ; skip the prompt message if not. ;;; XOR A ; Clear to address table directly LD DE,tape_msgs ; Address: tape-msgs CALL PO_MSG_0 ; Routine PO-MSG - ; 'Start tape then press any key.' ;;; SET 5,(IY+$02) ; Update TV_FLAG - signal lower screen requires ;;; ; clearing. SET 3,(IY+$01) ;+ Set 'L' key mode for prompt situation. CALL WAIT_KEY ; routine WAIT_KEY SA_CBN PUSH IX ; Save pointer to descriptor. LD DE,$0011 ; There are seventeen bytes to save. XOR A ; Set A to zero - to signal a header block. CALL SA_BYTES2 ; routine SA-BYTES saves block POP IX ; restore descriptor pointer. LD B,$32 ; wait for a second - 50 interrupts. SA_1_SEC HALT ; wait for an 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. ( dec a ) DEC A ;+ signal data bytes. POP IX ; retrieve pointer to start ;;; JP SA_BYTES ; jump back to SA-BYTES SA_BYTES2 BIT 7,(IY+$3B) ;+ are extended streams being used. T_ADDR_hi JP Z,SA_BYTES ;+ back to tape routine if not LD HL,SA_LD_RET ; address: SA/LD_RET Duplication. PUSH HL ; is pushed as common exit route. ; ------------------------------------------------ ; THE NEW 'SAVE BYTES TO NETWORK/RS232' SUBROUTINE ; ------------------------------------------------ ; This can also, for amusement, be used to save a small program to the ; Screen e.g. SAVE #2, "ABC" ; DE holds the length of data. ; IX points to the start. ; Begin by transferring the start of data from IX to HL as the extended ; streams will use the IX register. RST 10 preserves the main registers. SA_BYT_NB PUSH IX ; Transfer start to POP HL ; the HL register. SA_BYT_LP LD A,D ; Test for zero length. OR E ; RET Z ; Return if so. >> LD A,(HL) ; Fetch a byte to the accumulator. INC HL ; Increment address. DEC DE ; decrement byte count. RST 10H ; Restart outputs a byte to current channel. JR SA_BYT_LP ; loop back to save another byte to SA_BYT_LP ; ----------------- ; ; ----------------- LD_BYTES2 BIT 7,(IY+$3B) ; Test T_ADDR_hi JP Z,LD_BYTES ; jump to tape routines LD HL,SA_LD_RET ; Address: SA/LD-RET PUSH HL ; is saved on stack as terminating routine. EX AF,AF' ; preserve carry ; -------------------------------------------------- ; THE NEW 'LOAD BYTES FROM NETWORK/RS232' SUBROUTINE ; -------------------------------------------------- ; IX points to start ; DE holds length ; The alternate CARRY is set if data is to be loaded. LD_BYT_NB PUSH IX ; transfer the destination start address POP HL ; to the HL register pair. LD_BYT_LP CALL INPUT_AD ; input a byte from the current channel JR NC,LD_BYT_LP ; repeat until byte is acceptable. XXXXXXXXXX EX AF,AF' ; fetch the carry flag. JR C,LD_BYT_1 ; forward, with carry, to LOAD byte. EX AF,AF' ; preserve carry. ;;; XOR (HL) ; verify against byte in memory. CP (HL) ; compare RET NZ ; return if verification failed with NC also. JR LD_BYT_2 ; skip forward for next byte. LD_BYT_1 EX AF,AF' ; preserve carry flag bring back new byte. LD (HL),A ; insert byte from network or RS232. LD_BYT_2 INC HL ; increment memory pointer. DEC DE ; decrement the byte count. LD A,D ; Test for zero. OR E ; JR NZ,LD_BYT_LP ; back if not zero for more. SCF ; signal success. RET ; Return. ; --------------------------- ; THE NEW 'DISP_MSG' ROUTINE ; --------------------------- ; If, on entry, carry is set then this routine prints a message without ; disturbing the current channel. If the carry flag is reset then the ; single character in A is output. DISP_MSG PUSH HL ; Preserve Main registers. PUSH BC ; PUSH DE ; LD HL,($5B51) ; fetch the current channel. PUSH HL ; and save it PUSH DE ; preserve message pointer PUSH AF ; preserve type and carry flag CALL CHAN_O_FE ; select system channel for 'S' POP AF ; bring back the type POP DE ; and the message pointer JR NC,DISP_1 ; forward with no carry to output a single char CALL PO_MSG ; output message to upper screen LD A,':' ; follow the type message with ': ' RST 10H ; LD A,' ' ; DISP_1 RST 10H ; else print the character POP HL ; restore channel. CALL CHAN_FLAG ; routine CHAN_FLAG updates CURCHL and flags. POP DE ; Restore main registers. POP BC ; POP HL ; RET ; Return. ; --- ; Arrangement of the two tape cassette 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 length ; IX-$05 IX+$0C hi hi hi hi of datablock. ; IX-$04 IX+$0D Auto - - Start Various ; IX-$03 IX+$0E Start a-z a-z addr/0 ($80 if no autostart). ; IX-$02 IX+$0F lo - - - Length of Program ; IX-$01 IX+$10 hi - - - only i.e. without variables. ; ; ; Arrangement of 9-byte Interface1 Network/RS232 header when saving loading. ; Note. This has not been adopted by this ROM. ; ; $5BE6 HD_00 0 1 2 3 Type. ; ; $5BE7 HD_0B lo lo lo lo Total length ; $5BE8 HD_0C hi hi hi hi of datablock ; $5BE9 HD_0D -- -- -- lo/00 Start ; $5BEA HD_0E -- -- -- hi/00 Address. ; $5BEB HD_0F lo a-z a-z -- Length ; $5BEC HD_10 hi -- -- -- of program. ; $5BED HD_11 Auto -- -- -- Auto start line ; $5BEE HD_12 Start -- -- -- number. $FFFF if none. ; ------------------------------ ; THE 'CANNED CASSETTE' MESSAGES ; ------------------------------ ; The last-character-inverted Cassette messages. ; Starts with normal initial step-over byte. tape_msgs DEFB $80 DEFM "Start tape, then press a key" type_msgs DEFB '.'+$80 DEFB $0D DEFM "Progra" DEFB 'm'+$80 DEFB $0D DEFM "Number arra" DEFB 'y'+$80 DEFB $0D DEFM "Char arra" DEFB 'y'+$80 DEFB $0D DEFM "Byte" DEFB 's'+$80 ;************************************************** ;** Part 5. SCREEN AND PRINTER HANDLING ROUTINES ** ;************************************************** ; -------------------------- ; THE 'PRINT OUTPUT' 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. PRINT_OUT CALL PO_FETCH ; routine PO-FETCH fetches print position ; to HL register pair. CP $20 ; is character a space or higher ? JR NC,PO_Q_ABLE ; jump forward, if so, to PO-ABLE CP $06 ; is character in range 00-05 ? JR C,PO_QUEST ; forward, if so, to PO-QUEST CP $18 ; is character in range 24d - 31d ? JR NC,PO_QUEST ; forward, if so, to PO-QUEST LD HL,ctlchrtab-6 ; address - 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 of routine. JP PO_FETCH ; Jump forward to PO-FETCH, ; as the screen/printer position has been ; disturbed, and then indirectly to the ; routine on the stack. ; ----------------------------- ; THE '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. ctlchrtab DEFB PO_COMMA - $ ; 06d offset to Address: PO-COMMA DEFB PO_QUEST - $ ; 07d offset to Address: PO-QUEST DEFB PO_BACK_1 - $ ; 08d offset to Address: PO-BACK-1 DEFB PO_RIGHT - $ ; 09d offset to Address: PO-RIGHT DEFB PO_QUEST - $ ; 10d offset to Address: PO-QUEST DEFB PO_QUEST - $ ; 11d offset to Address: PO-QUEST DEFB PO_QUEST - $ ; 12d offset to Address: PO-QUEST DEFB PO_ENTER - $ ; 13d offset to Address: PO-ENTER DEFB PO_QUEST - $ ; 14d offset to Address: PO-QUEST DEFB PO_QUEST - $ ; 15d offset to Address: PO-QUEST DEFB PO_1_OPER - $ ; 16d offset to Address: PO-1-OPER DEFB PO_1_OPER - $ ; 17d offset to Address: PO-1-OPER DEFB PO_1_OPER - $ ; 18d offset to Address: PO-1-OPER DEFB PO_1_OPER - $ ; 19d offset to Address: PO-1-OPER DEFB PO_1_OPER - $ ; 20d offset to Address: PO-1-OPER DEFB PO_1_OPER - $ ; 21d offset to Address: PO-1-OPER DEFB PO_2_OPER - $ ; 22d offset to Address: PO-2-OPER DEFB PO_2_OPER - $ ; 23d offset to Address: PO-2-OPER ; ------------------------- ; THE 'CURSOR LEFT' ROUTINE ; ------------------------- ; Backspace and up a line if that action is from the left of screen. ; For the ZX printer backspace up to first column but not beyond. 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 ; Forward, if not, to PO-BACK-3 ; to store the new position. BIT 1,(IY+$01) ; Test FLAGS - is printer in use ? JR NZ,PO_BACK_2 ; Forward, if so, to PO-BACK-2 ; as it is not possible to move left. INC B ; Move up one screen line LD C,$02 ; The rightmost column position. ;;; LD A,$18 ; Note. This should be $19 (not $18) ;;; ; Credit: Dr. Frank O'Hara, 1982 LD A,$19 ;+ Test against the top line plus one. CP B ; Has position moved past top of screen ? JR NZ,PO_BACK_3 ; Forward, if not, to PO-BACK-3 ; to store the new position. DEC B ; else back to $18. PO_BACK_2 LD C,$21 ; the leftmost column position. PO_BACK_3 JR PO_ENTEND ;+ Forward, indirectly, to CL-SET and PO-STORE ; to store new position in system variables. ;;; JP CL_SET ; a 3-byte direct jump. ; -------------------------- ; THE '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. ;;; PO_RIGHT LD A,($5B91) ; fetch P_FLAG value ;;; PUSH AF ; and preserve the original value on the 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. ;;; POP AF ; restore the original P_FLAG value. ;;; LD ($5B91),A ; and restore system variable P_FLAG ;;; RET ; return without need to update column position. PO_RIGHT LD HL,$5B91 ;+ Address system variable P_FLAG LD D,(HL) ;+ Fetch the System Variable value and LD (HL),1 ;+ Set to OVER 1 CALL PO_SV_SP ;+ Routine prints a space LD (HL),D ;+ and place in P_FLAG RET ;+ Return ; ----------------------------------- ; THE 'PRINT CARRIAGE RETURN' ROUTINE ; ----------------------------------- ; A carriage return is 'printed' to screen or printer buffer. 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. ; Continue if writing to screen. LD C,$21 ; the leftmost screen column position. CALL PO_SCR ; routine PO-SCR handles any scrolling required. DEC B ; adjust to next screen line. PO_ENTEND JP CL_SET ; jump forward to CL-SET to store new position. ; ---------------------------- ; THE 'PRINT COMMA' SUBROUTINE ; ---------------------------- ; The comma control character. The 32 column screen has two 16 character ; tabstops. The routine is only reached via the control character table. ; If it was called from elsewhere then the call to PO-FETCH would be needed. ;;; CALL PO_FETCH ; routine PO-FETCH - seems unnecessary. PO_COMMA 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 ; ------------------------------------ ; THE 'PRINT QUESTION MARK' SUBROUTINE ; ------------------------------------ ; 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. PO_QUEST LD A,$3F ; prepare the character '?'. PO_Q_ABLE JR PO_ABLE ; forward to PO-ABLE. ; ----------------------------------------------- ; THE 'CONTROL CHARACTERS WITH OPERANDS' ROUTINES ; ----------------------------------------------- ; 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. PO_TV_2 LD DE,PO_CONT ; address: PO-CONT will be next output routine PO_TV_3 LD ($5B0F),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. 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. PO_1_OPER LD DE,PO_CONT ; address: PO-CONT will be next output routine PO_TV_1 LD ($5B0E),A ; store control code in TVDATA-lo PO_CHANGE LD HL,($5B51) ; use CURCHL to find current output channel. PO_CH_2 LD (HL),E ; make it INC HL ; the supplied LD (HL),D ; address from DE. RET ; return. ; --- PO_NORM LD DE,PRINT_OUT ; prepare to make PRINT_OUT normal. JR PO_CHANGE ; ; --- PO_CONT ;;; LD DE,PRINT_OUT ; Address: PRINT-OUT ;;; CALL PO_CHANGE ; routine PO-CHANGE to restore normal channel. CALL PO_NORM ;+ routine embodies above two instructions. ; Now that all the sequence of codes have been received they can be handled. ; The accumulator holds the final parameter and any previous codes are in ; the system variable TVDATA. LD HL,($5B0E) ; TVDATA gives control code and possible ; subsequent character LD D,A ; save current code. LD A,L ; fetch the stored control code CP $16 ; was it one operand - INK to OVER ? JP C,CO_TEMP_5 ; jump forward, if so, to CO-TEMP-5 ; Consider the two control codes with two operands. JR NZ,PO_TAB ; forward, if not 22 decimal, to PO-TAB (23) ; else must have been 22 decimal - 'AT'. LD B,H ; line to H (0-23d) LD C,D ; column to C (0-31d) LD A,$1F ; prepare the value 31d SUB C ; reverse the column number. JR C,PO_AT_ERR ; forward, if greater than 31, to PO-AT-ERR ; 'Integer out of range' ADD A,$02 ; transform to system range $02-$21 LD C,A ; and place in the column register. ; Now consider the line parameter. BIT 1,(IY+$01) ; test FLAGS - is printer in use ? JR NZ,PO_ENTEND ; forward, if so, ignoring line to PO-AT-SET LD A,$16 ; prepare 22 decimal SUB B ; subtract line number to reverse legal values ; 0 - 22 becomes 22 - 0. PO_AT_ERR JP C,REPORT_Bb ; jump, if higher than 22, to REPORT-B ; 'Integer out of range' INC A ; adjust for the system range $01-$17 LD B,A ; place in the line register INC B ; adjust to system range $02-$18 BIT 0,(IY+$02) ; test TV_FLAG - Lower screen in use ? JP NZ,PO_SCR ; forward, if so, to PO-SCR ; to test for scrolling. CP (IY+$31) ; for upper screen, compare against DF_SZ ;;; JP C,REPORT_5 ; to REPORT-5 if too low ;;; ; 'Out of screen' ;;; JP CL_SET ; to CL_SET if valid. PO_AT_SET JR NC,PO_ENTEND ;+ print position is valid so exit via CL-SET REPORT_5a RST 30H ;+ ERROR-1 DEFB $04 ;+ Error Report: Out of screen ; --- ; The branch was 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. PO_TAB LD A,H ; transfer parameter to A losing the current ; contents - the high byte of the TAB parameter. 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 mod 32 that is 0 - 31. RET Z ; return if result is zero. LD D,A ; Counter to D SET 0,(IY+$01) ; update FLAGS - signal suppress leading space. PO_SPACE CALL PO_SV_SP ;+ call instruction before PO_SAVE - ld a,$20 ;;; LD A,$20 ; space character. ;;; CALL PO_SAVE ; routine PO-SAVE prints the character ; using alternate set (normal output routine) DEC D ; decrement the spaces counter. JR NZ,PO_SPACE ; back to PO-SPACE until done. RET ; Return. ; ---------------------- ; Printable character(s) ; ---------------------- ; This routine prints printable characters and continues into ; the position store routine PO_ABLE CALL PO_ANY ; routine PO-ANY ; and continue into position store routine. ; ---------------------------- ; THE 'POSITION STORE' ROUTINE ; ---------------------------- ; This routine updates the system variables associated with the main screen, ; the lower screen/input buffer or the ZX printer. PO_STORE BIT 1,(IY+$01) ; Test FLAGS - is printer in use ? JR NZ,PO_ST_PR ; Forward, if so, to PO-ST-PR BIT 0,(IY+$02) ; Test TV_FLAG - is lower screen in use ? JR NZ,PO_ST_E ; Forward, if so, to PO-ST-E ; This section deals with the upper screen. LD ($5B88),BC ; Update S_POSN - line/column upper screen LD ($5B84),HL ; Update DF_CC - upper display file address RET ; Return. ; --- ; This section deals with the lower screen. PO_ST_E LD ($5B8A),BC ; Update SPOSNL line/column lower screen LD ($5B82),BC ; Update ECHO_E line/column input buffer LD ($5B86),HL ; Update DFCCL lower screen memory address RET ; Return. ; --- ; This section deals with the ZX Printer. ; Now just update the column number $00 - $21 within the channel. PO_ST_PR LD IX,($5B51) ;+ set IX to CURCHL LD (IX+$07),C ;+ Update P_POSN column position printer RET ; Return. ; ---------------------------- ; THE 'POSITION FETCH' ROUTINE ; ---------------------------- ; 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 is no longer used. The output address is calculated ; by this routine every time from the new channel variable P_POSN. ; The output address now alters whenever a channel is reclaimed. PO_FETCH BIT 1,(IY+$01) ; Test FLAGS - is printer in use ? JR NZ,PO_F_PR ; Forward, if so, to PO-F-PR ; assume upper screen in use and thus optimize for path that requires speed. LD BC,($5B88) ; Fetch line/column from S_POSN LD HL,($5B84) ; Fetch DF_CC display file address BIT 0,(IY+$02) ; Test TV_FLAG - lower screen in use ? RET Z ; Return if upper screen in use. ; Overwrite registers with values for lower screen. LD BC,($5B8A) ; Fetch line/column from SPOSNL LD HL,($5B86) ; Fetch display file address from DFCCL RET ; Return. ; --- ; This section deals with the ZX Printer. ; The column is obtained from the location within the channel. ; The output address HL is derived from this column number. PO_F_PR LD HL,($5B51) ;+ set HL to start of Channel from CURCHL LD BC,$0007 ;+ offset to column number. ADD HL,BC ;+ add to address P_POSN LD C,(HL) ;+ Fetch column from P_POSN. INC HL ;+ Start of 256 buffer. LD B,A ;+ copy character to B. LD A,$21 ;+ Reverse the column number SUB C ;+ Now $00 (left) $1F (right) ADD A,L ;+ add to low byte possibly setting carry flag. LD L,A ;+ place back in low byte. LD A,B ;+ copy character back to A RET NC ;+ return if address is correct. INC H ;+ else increase by 256 bytes. RET ;+ Return. ; --------------------------------- ; THE 'PRINT ANY CHARACTER' ROUTINE ; --------------------------------- ; This routine is used to print any character in range 32d - 255d ; It is only called from PO-ABLE which continues into PO-STORE ; On entry, HL contains the output address and BC the line column or just ; the column in the case of the ZX Printer. PO_ANY CP $80 ; ASCII ? JR C,PO_CHAR ; to PO-CHAR if so. CP $90 ; test if a block graphic character. JR NC,PO_T_UDG ; to PO-T&UDG to print tokens and UDGs ; 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 re-fetches print position. LD DE,$5B92 ; MEM-0 is location of 8 bytes of character JR PR_ALL ; forward to PR-ALL ; to print to screen or printer. ; --- PO_GR_1 LD HL,$5B92 ; 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. 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 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. PO_T_UDG SUB $A5 ; subtract the 'RND' character JR NC,PO_T ; forward, if a token, to PO-T ADD A,$15 ; add 21d to restore to 0 - 20 PUSH BC ; save current print position LD BC,($5B7B) ; fetch UDG to address bit patterns JR PO_CHAR_2 ; forward to common code at PO-CHAR-2 ; to lay down a bit patterned character ; --- ; Tokens PO_T CALL PO_TOKENS ; routine PO-TOKENS prints tokens ;;; JP PO_FETCH ; an absolut jump to PO_FETCH JR PO_FETCH ;+ exit via a JUMP to PO-FETCH as this routine ;+ must continue into PO-STORE. ;+ A JR instruction could be used. (Done) ; --- ; This point is used to print ASCII characters 32d - 127d. PO_CHAR PUSH BC ; Preserve print position LD BC,($5B36) ; Fetch font pointer from address CHARS ; This common code is used to transfer the character bytes to memory. PO_CHAR_2 EX DE,HL ; transfer destination address to DE LD HL,$5B3B ; point to FLAGS RES 0,(HL) ; update FLAGS - allow for leading space CP $20 ; is output character a space ? JR NZ,PO_CHAR_3 ; skip forward, if not, to PO-CHAR-3 SET 0,(HL) ; update FLAGS - signal no leading space. 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 ; retrieve the source address from CHARS or UDG. EX DE,HL ; transfer the character bitmap address to DE. ; ---------------------------------- ; THE 'PRINT ALL CHARACTERS' ROUTINE ; ---------------------------------- ; This entry point entered from above to print ASCII and UDGs but also from ; earlier to print the mosaic characters. ; HL = screen or printer destination ; DE = character bitmap source ; BC = line/column PR_ALL LD A,C ; transfer the column to A DEC A ; move to the right LD A,$21 ; pre-load with leftmost position PUSH DE ;+ Save character source before any branching. JR NZ,PR_ALL_1 ; forward, if not zero, to PR-ALL-1 ; If zero then move down a line, but B is of no significance if printer ; is in use 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 ; forward, if not, to PR-ALL-1 ; This is the printer-only path but we can trickle through. ;;; PUSH DE ; save source address ;;; CALL COPY_BUFF ; Routine COPY-BUFF outputs line to printer CALL NZ,COPY_BUFF ;+ Routine COPY-BUFF conditionally outputs line ;+ to printer leaving A=$00 and C=$21 and ;+ the zero flag reset - NZ. ;;; POP DE ; Restore the character source address ;;; LD A,C ; the new column number ($21) to A from C. ; This is the screen-only path but we can trickle through as A!=C. 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 address. ; The following applies to screen and printer. PR_ALL_1a PUSH BC ; save line/column PUSH HL ; and destination LD A,($5B91) ; fetch P_FLAG to accumulator LD B,$FF ; prepare an OVER mask in B. RRA ; carry is set if temporary bit is OVER 1 JR C,PR_ALL_2 ; forward, if OVER 1, to PR-ALL-2 INC B ; set OVER mask to 0 PR_ALL_2 RRA ; skip bit 1 of P_FLAG RRA ; bit 2 is temporary INVERSE SBC A,A ; will be FF for INVERSE 1 else zero LD C,A ; transfer the INVERSE mask to C LD A,$08 ; prepare to count 8 bytes AND A ; clear carry to signal screen in use. BIT 1,(IY+$01) ; test FLAGS - is screen in use ? JR Z,PR_ALL_3 ; forward, if screen, to PR-ALL-3 ;;; SET 1,(IY+$30) ; update FLAGS2 - signal printer buffer has ;;; ; been used. SCF ; set the carry flag to signal printer in use. PR_ALL_3 EX DE,HL ; now HL=source, DE=destination PR_ALL_4 EX AF,AF' ; Save the printer/screen Carry flag LD A,(DE) ; Fetch the 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 location. EX AF,AF' ; restore discriminating flag JR C,PR_ALL_6 ; forward, if printer, to PR-ALL-6 ; Continue with screen printing. INC D ; increment D - gives next screen pixel line PR_ALL_5 INC HL ; address next character source 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 ; transfer destination to HL DEC H ; bring back to last updated screen position ; from the 'ninth' line. BIT 1,(IY+$01) ; test FLAGS - is printer in use ? CALL Z,PO_ATTR ; if not, call routine PO-ATTR to update the ; corresponding colour attribute. ; (the address of which is now retained in DE) POP HL ; restore original screen/printer position POP BC ; and the line and column DEC C ; move column to right INC HL ; increase screen/printer position RET ; return and continue into PO-STORE ; within PO-ABLE ; Note. that DE has been made to retain the attribute byte. ; --- ; This branch is used to update the ZX printer position by 32 places ; Note. The high byte of the address D now increments if a page boundary ; is crossed as this ROM supports up to thirteen ZX Printer buffers. 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 JR NC,PR_ALL_7 ;+ skip forward if no wrap. INC D ;+ increment the high byte of channel address. PR_ALL_7 EX AF,AF' ; fetch the flag JR PR_ALL_5 ; back to PR-ALL-5 ; ----------------------------------- ; THE 'UPDATE ATTRIBUTE CELL' ROUTINE ; ----------------------------------- ; 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. ;;; 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 PO_ATTR CALL CL_ATTR2 ;+ NEW subroutine with above code. LD DE,($5B8F) ; make D hold ATTR_T, E hold MASK-T LD A,(HL) ; fetch existing attribute from attribute file 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, if not, to PO-ATTR-1 AND $C7 ; set paper BIT 2,A ; to contrast with ink JR NZ,PO_ATTR_1 ; skip to PO-ATTR-1 XOR $38 ; PO_ATTR_1 BIT 4,(IY+$57) ; test P_FLAG - is this INK 9 ?? JR Z,PO_ATTR_2 ; skip, if not, to PO-ATTR-2 AND $F8 ; make the ink colour contrast with paper. BIT 5,A ; Is paper light ? JR NZ,PO_ATTR_2 ; forward, if so, to PO-ATTR-2 XOR $07 ; toggle ink colour. PO_ATTR_2 LD (HL),A ; write the new attribute to the attribute file EX DE,HL ;+ Note. NEW - return the attribute byte in DE. RET ; return. ; --------------------------------- ; THE 'MESSAGE PRINTING' SUBROUTINE ; --------------------------------- ; 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. ; Register A contains the message number, often zero to print first message. ; (HL has nothing important usually P_FLAG) PO_MSG_0 XOR A ;+ NEW entry point to print first message. PO_MSG_1 SET 5,(IY+$02) ;+ update TV_FLAG - signal lower screen will ;+ require clearing. ; -> Normal Entry Point. 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 PO_TOKENS LD DE,TKN_TABLE ; address: TKN-TABLE PUSH AF ; stack the token number to control ; trailing spaces - see later * ; -> 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 the space in A. CALL Z,PO_SV_SP ; routine PO-SV_SP to print a space without ; disturbing registers. PO_EACH LD A,(DE) ; Fetch character from the table. AND $7F ; Cancel any inverted bit. CALL PO_SAVE ; Routine PO-SAVE to print using the alternate ; set of registers. LD A,(DE) ; Re-fetch character from table. INC DE ; Address next character in the table. ADD A,A ; Was character inverted ? ; (this also doubles character e.g. $41 -> $82) JR NC,PO_EACH ; back, if not, to PO-EACH POP DE ; * re-fetch trailing space byte to D CP $48 ; was the last character '$' ? JR Z,PO_TR_SP ; forward, if so, to PO-TR-SP ; to consider a trailing space. CP $82 ; was it < 'A' i.e. '#','>','=' from tokens ; or ' ','.' (from tape) or '?' from scroll RET C ; Return if so as no trailing space required. 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 therefore no trailing space. RET C ; Return if no trailing space. PO_SV_SP LD A,$20 ; Prepare the space character and continue to ; print and make an indirect return. ; ----------------------------------- ; THE 'RECURSIVE PRINTING' SUBROUTINE ; ----------------------------------- ; This routine which is part of PRINT-OUT allows RST $10 to be used ; recursively to print tokens and the spaces associated with them. ; It is called on three occasions when the value of DE must be preserved. PO_SAVE PUSH DE ; Save DE value. EXX ; Switch in main set RST 10H ; PRINT-A prints using this alternate set. EXX ; Switch back to this alternate set. POP DE ; Restore the initial DE value. RET ; Return. ; -------------------------- ; THE 'TABLE SEARCH' ROUTINE ; -------------------------- ; This subroutine searches a message or the token table for the ; message number held in A. DE holds the address of the table. PO_SEARCH PUSH AF ; save the original message/token number EX DE,HL ; transfer table address, DE to HL INC A ; adjust for initial step-over byte PO_STEP BIT 7,(HL) ; is character inverted ? INC HL ; address next JR Z,PO_STEP ; back, if not inverted, to PO-STEP ; The start of a new message token. DEC A ; decrease message counter JR NZ,PO_STEP ; back, if not zero, to PO-STEP ; Register HL now addresses the first character of the required message. EX DE,HL ; transfer address to DE POP AF ; restore original message/token number CP $20 ; compare to thirty two RET C ; return for all messages and function tokens. ; Note. there are thirty error messages, originally twenty eight. LD A,(DE) ; test first character of token SUB $41 ; against character 'A' RET ; Return - with carry set if it is less ; i.e. '<>', '<=', '>=' ; -------------------------------- ; THE 'TEST FOR SCROLL' SUBROUTINE ; -------------------------------- ; 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. ; The current channel could be the upper screen 'S' in which case the ; 'scroll?' prompt is printed or from the lower screen 'K' in which case ; no prompt is given. PO_SCR ;;; BIT 1,(IY+$01) ; test FLAGS - is printer in use ? ;;; RET NZ ; return immediately if so. ; Continue if handling upper or lower screen. LD DE,CL_SET ; set DE to address: CL-SET PUSH DE ; and push for the 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, if so, to PO-SCR-4 CP (IY+$31) ; greater than DF_SZ display file size ? REP_5 JR C,REPORT_5b ; forward, if less, to REPORT-5 ; '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, if not, to PO-SCR-2 LD E,(IY+$2D) ; fetch BREG - the count of scroll lines to E. DEC E ; decrease JR Z,PO_SCR_3 ; forward, if zero to scroll, at PO-SCR-3. ;;; LD A,$00 ; explicit - select channel zero. ;;; CALL CHAN_SLCT ; routine CHAN-OPEN opens it invoking TEMPS. CALL CHAN_ZERO ;+ routine CHAN-OPEN opens it invoking TEMPS. LD SP,($5B3F) ; set stack pointer to LIST_SP PO_N_AUTO RES 4,(IY+$02) ; Update TV_FLAG - signal auto listing finished. RET ; return, ignoring pushed value CL-SET, to MAIN ; or EDITOR without updating print position >> ; --- REPORT_5b RST 30H ; ERROR-1 DEFB $04 ; Error Report: Out of screen ; --- ; Continue here if not an automatic listing. PO_SCR_2 DEC (IY+$52) ; decrease the scroll count - SCR_CT JR NZ,PO_SCR_3 ; forward, if not zero, to scroll at PO-SCR-3 ; If scroll count is zero, produce prompt, so that user can see the scrolled ; output and BREAK if desired. LD A,$18 ; prepare 24 decimal. SUB B ; subtract the current line. LD ($5B8C),A ; update the scroll count - SCR_CT ; Although printing to lower screen will LD HL,($5B8F) ; L=ATTR_T, H=MASK_T PUSH HL ; save on stack LD A,($5B91) ; 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_SLCT ; routine CHAN-OPEN opens it and invokes TEMPS. ;;; XOR A ; clear to address message directly LD DE,scrl_mssg ; make DE address: scrl-mssg CALL PO_MSG_0 ; routine PO-MSG prints 'scroll?' to the lower ; screen. ;;; SET 5,(IY+$02) ; set TV_FLAG - signal lower screen requires ; clearing LD HL,$5B3B ; 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 EXX ; switch back to alternate set. CP $20 ; space is considered as BREAK JR Z,REPORT_D ; forward, if so, to REPORT-D ; 'BREAK - CONT repeats' CP $E2 ; is character 'STOP' ? JR Z,REPORT_D ; forward, if so, to REPORT-D ; 'BREAK - CONT repeats' OR $20 ; convert to lower-case CP $6E ; is character 'n' ? JR Z,REPORT_D ; forward, if so, to REPORT-D ; 'BREAK - CONT repeats' ; Scrolling is required. ;;; LD A,$FE ; select system channel 'S' ;;; CALL CHAN_SLCT ; CALL CHAN_O_FE ;+ Routine CHAN-OPEN opens it but applies ;+ ATTR_P to ATTR_T nullifying any embedded ;+ colour items in the current print statement. POP AF ; Restore original P_FLAG LD ($5B91),A ; and save in P_FLAG. POP HL ; Restore original ATTR_T, MASK_T LD ($5B8F),HL ; and reset ATTR_T, MASK-T as 'scroll?' has ; been printed. 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 ; CALL CL_ATTR2 ;+ Note. A NEW routine with the above code. LD DE,$5AE0 ; start of last 'line' of attribute area LD A,(DE) ; get attribute for last line LD C,(HL) ; get attribute for base line of upper part LD B,$20 ; there are thirty two attribute bytes to copy EX DE,HL ; swap the pointers. PO_SCR_3A LD (DE),A ; exchange the two LD (HL),C ; attributes. INC DE ; address next source location. INC HL ; address next destination location. DJNZ PO_SCR_3A ; loop back to PO-SCR-3A ; for all adjacent attribute cells. POP BC ; restore the line/column. RET ; return via CL-SET (was pushed on stack). ; -------------------- ; THE 'SCROLL?' PROMPT ; -------------------- ; The message 'scroll?' appears here with last byte inverted. scrl_mssg DEFB $80 ; initial step-over byte. DEFM "scroll" DEFB '?'+$80 ; --- REPORT_D RST 30H ; ERROR-1 DEFB $0C ; Error Report: BREAK - CONT repeats ; --- ; Continue here if using lower display - A holds line number. PO_SCR_4 CP $02 ; is line number less than 2 ? JR C,REPORT_5b ; back, if so, to REPORT-5 ; 'Out of Screen' ADD A,(IY+$31) ; add DF_SZ SUB $19 ; subtract twenty five. RET NC ; return if scrolling is unnecessary NEG ; Negate to give number of scrolls required. PUSH BC ; (*) save line/column ; to prevent corruption by input AT LD B,A ; transfer count to B ;;; LD HL,($5B8F) ; fetch current ATTR_T, MASK_T to HL. ;;; PUSH HL ; and save ;;; LD HL,($5B91) ; fetch P_FLAG ;;; PUSH HL ; and save. ;;; CALL TEMPs ; routine TEMPs sets to BORDCR etc. LD A,B ; transfer scroll number to A. PO_SCR_4A PUSH AF ; save scroll number. ; Now increment the lower screen display file size DF_SZ. ; Retain the old value in the B register as scroll count LD HL,$5B6B ; 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,$5B89 ; address S_POSN_hi - line LD L,$89 ; address S_POSN_hi - line CP (HL) ; compare DF_SZ to the line number. JR C,PO_SCR_4B ; forward, if less, to PO-SCR-4B ; to scroll the lower screen only. INC (HL) ; else increment S_POSN_hi the upper line value ;;; LD B,$18 ; set count to whole display ?? ;;; ; Note. should be $17 (not $18) and the top ;;; ; line will be scrolled into the ROM which ;;; ; is harmless on the standard set up. ;;; ; credit: P. Giblin 1984. LD B,$17 ;+ PO_SCR_4B CALL CL_SCROLL ; routine CL-SCROLL scrolls bottom B lines up. POP AF ; restore the scroll counter. DEC A ; decrease counter. JR NZ,PO_SCR_4A ; back 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 ($5B8F),HL ; and update system variables. LD BC,($5B88) ; fetch upper display line/column 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. POP BC ; (*) restore lower line/column SIG_L_SCR SET 0,(IY+$02) ; signal to TV_FLAG - lower screen in use. RET ; return via CL-SET for lower display. ; --------------------------------------------- ; THE 'SET TEMPORARY COLOUR ATTRIBUTES' ROUTINE ; --------------------------------------------- ; This subroutine is called several times to copy the permanent colour items ; to the temporary ones. TEMPS XOR A ; clear the accumulator LD HL,($5B8D) ; 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, if not lower screen, to TEMPS-1 LD H,A ; set H (MASK_P) to 00000000. (All bits show) LD L,(IY+$0E) ; fetch BORDCR to L which is used for lower ; screen. TEMPS_1 LD ($5B8F),HL ; update system variables ATTR_T and MASK_T ; For the print flag the permanent values are odd bits, temporary even bits. ; For the lower screen the temporary mask bits are reset. The ink colour ; has already been chosen to contrast with the border colour and attributes ; like OVER 1 are never allowed as it would confuse. For the upper screen ; then ink 9, paper 9, inverse 1, over 1 are the same as permanent values. LD HL,$5B91 ; address the print flag P_FLAG. JR NZ,TEMPS_2 ; skip, if lower screen using zero, to TEMPS-2 LD A,(HL) ; else pick up flag bits. RRCA ; rotate permanent bits to temporary bits. TEMPS_2 XOR (HL) ; AND $55 ; mask %01010101 XOR (HL) ; permanent bits now as original LD (HL),A ; apply the updated temporary bits. RET ; return. ; ----------------- ; THE 'CLS' COMMAND ; ----------------- ; This command clears the display. ; The routine is also called during initialization and by the CLEAR command. ; If it's difficult to write it should be difficult to read. CLS CALL CL_ALL ; Routine CL-ALL clears the entire display and ; sets the attributes to the permanent ones ; from ATTR-P. ; Having cleared all 24 lines of the display area, continue into the ; subroutine that clears the lower display area. Note that at the moment ; the attributes for the lower lines are the same as upper ones and have ; to be changed to match the BORDER colour. ; -------------------------- ; THE 'CLS-LOWER' SUBROUTINE ; -------------------------- ; This routine is called from INPUT, and from the MAIN execution loop. ; This is very much a housekeeping routine which clears between 2 and 23 ; lines of the display, setting attributes and correcting situations where ; errors have occurred while the normal input and output routines have been ; temporarily diverted to deal with, say colour control codes. CLS_LOWER LD HL,$5B3C ; address System Variable 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 applies permanent attributes, ; in this case BORDCR to ATTR_T. ; Note. this seems unnecessary and is repeated ; within CL-LINE. LD B,(IY+$31) ; fetch lower screen display file size DF_SZ CALL CL_LINE ; routine CL-LINE clears lines to bottom of the ; display and sets attributes from BORDCR while ; preserving the B register. LD HL,$5AC0 ; set initial attribute address to the leftmost ; cell of second line up. LD A,($5B8D) ; fetch permanent attribute from ATTR_P. DEC B ; decrement lower screen display file size. JR CLS_3 ; forward to enter the backfill loop at CLS-3 ; where B is decremented again. ; --- ; The backfill loop is entered at midpoint and ensures, if more than 2 ; lines have been cleared, that any other lines take the permanent screen ; attributes. CLS_1 LD C,$20 ; set counter to 32 character cells per line CLS_2 DEC HL ; decrease attribute address. LD (HL),A ; and place attributes in next line up. DEC C ; decrease the 32 counter. JR NZ,CLS_2 ; loop back to CLS-2 until all 32 cells done. CLS_3 DJNZ CLS_1 ; decrease B counter and back to CLS-1 ; if not zero. LD (IY+$31),$02 ; now set DF_SZ lower screen to 2 ; This entry point is also called from CL-ALL below to ; reset the system channel input and output addresses to normal should they ; have been left in an unstable state while outputting or inputting colour ; control codes. CL_CHAN LD A,$FD ; select system channel 'K' CALL CHAN_SLCT ; routine CHAN-OPEN opens it. ;;; LD HL,($5B51) ; 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. CALL PO_NORM ;+ routine embodies above two instructions. ;;; CL_CHAN_A LD (HL),E ; Insert the output address on the first pass ;;; INC HL ; or the input address on the second pass. ;;; LD (HL),D ; ;;; INC HL ; LD DE,KEY_INPUT ; fetch address 'KEY-INPUT' for second pass CALL KEY_CH2 ;+ inserts values ;;; 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 ; ------------------------------------ ; THE 'CLEAR WHOLE DISPLAY' SUBROUTINE ; ------------------------------------ ; This subroutine called from CLS, AUTO-LIST and MAIN-3, clears 24 lines of ; the display and resets the relevant system variables. This routine also ; recovers from an error situation where, for instance, an invalid colour or ; position control code has left the output routine addressing PO-TV-2 ; or PO-CONT. CL_ALL LD HL,$0000 ; Initialize plot coordinates. LD ($5B7D),HL ; Set system variable 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_O_FE ;+ routine CHAN-OPEN opens it calling TEMPS. ;;; CALL TEMPs ; routine TEMPs applies permanent attributes, ; in this case ATTR_P, to ATTR_T. ; Note. this seems unnecessary. LD B,$18 ; There are 24 text lines to clear. CALL CL_LINE ; routine CL-LINE clears 24 text lines and sets ; attributes from ATTR-P. ; This routine preserves B and sets C to $21. ;;; LD HL,($5B51) ; fetch CURCHL make HL address output routine. ;;; LD DE,PRINT_OUT ; address: PRINT-OUT ;;; LD (HL),E ; is made ;;; INC HL ; the normal ;;; LD (HL),D ; output address. CALL PO_NORM ;+ make PRINT_OUT normal. LD (IY+$52),$01 ; set SCR_CT - scroll count - 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 the upper screen). ; -------------------- ; THE 'CL-SET' ROUTINE ; -------------------- ; 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. CL_SET BIT 1,(IY+$01) ; test FLAGS - is printer in use ? JR NZ,CL_SET_2 ; forward, if so, to CL-SET-2 LD A,B ; transfer line to A. BIT 0,(IY+$02) ; test TV_FLAG - lower screen in use ? JR Z,CL_SET_1 ; skip, if handling upper part, to CL-SET-1 ADD A,(IY+$31) ; add DF_SZ for lower screen SUB $18 ; and adjust. 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 HL address at left ; of screen. POP BC ; restore the line/column. CL_SET_2 LD A,$21 ; the column $01-$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 the relevant system variables. ; -------------------------- ; THE 'SCROLLING' SUBROUTINE ; -------------------------- ; 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. CL_SC_ALL LD B,$17 ; scroll 23 lines, after 'scroll?'. CL_SCROLL CALL CL_ADDR ; routine CL-ADDR gets screen address in HL. LD C,$08 ; there are 8 pixel lines to scroll. 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, if partial scroll, to CL-SCR-3 ; Register HL points to top line of the third which must be copied to bottom ; line of the previous third. ; ( so HL = $4800 or $5000 ) CL_SCR_2 EX DE,HL ; transfer 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 to HL and destination to DE LD BC,$0020 ; thirty-two bytes are to be copied. DEC A ; decrement the line count. LDIR ; copy a pixel line to previous third. 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, if not, to CL-SCR-2. 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, if all eight not done, to CL-SCR-1 CALL CL_ATTR ; routine CL-ATTR gets address in attributes ; from current 'ninth line' and 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. ; ------------------------------ ; THE 'CLEAR TEXT LINES' ROUTINE ; ------------------------------ ; 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. CL_LINE PUSH BC ; save line count CALL CL_ADDR ; routine CL-ADDR gets top address LD C,$08 ; there are eight pixel lines to a text line. CL_LINE_1 PUSH BC ; save pixel line count PUSH HL ; and save the screen address LD A,B ; transfer the line to A (1-24). 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),0 ; blank the first byte. LD (HL),B ;+ blank the first byte. [ was LD (HL),0 ] INC DE ; make DE point to next byte. LDIR ; block move 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 HL 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,($5B8D) ; fetch ATTR_P - permanent attributes BIT 0,(IY+$02) ; test TV_FLAG - lower screen in use ? JR Z,CL_LINE_3 ; skip, if not, to CL-LINE-3 LD A,($5B48) ; else lower screen uses BORDCR as attribute. 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 WAS made of this) RET ; return to the calling routine. ; ------------------------------- ; THE 'ATTRIBUTE ADDRESS' ROUTINE ; ------------------------------- ; 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 already holding ; the correct value for the attribute file and it is only necessary ; to manipulate H to form the correct colour attribute address. ;;; 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. CL_ATTR 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 the end of display. LD B,H ; transfer the result LD C,L ; to register BC. EX DE,HL ; restore attribute address to HL DEC H ; decrease from ninth line to eighth. CL_ATTR2 LD A,H ; fetch H to A - $47, $4F, or $57. RRCA ; divide by ??? RRCA ; eight. RRCA ; $08, $09 or $0A. AND $03 ; $00, $01 or $02. OR $58 ; $58, $59 or $5A. LD H,A ; save high byte of attributes. LD D,H ; LD E,L ; RET ; return. ; ------------------------------- ; THE 'SCREEN ADDRESS' SUBROUTINE ; ------------------------------- ; This subroutine is called from four places to calculate the address ; of the start of a screen character line which is supplied in B. 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 ; register L a multiple of 32. LD A,D ; bring back the line to A. AND $18 ; mask to form $00, $08 or $10. OR $40 ; add $40 - the base address of screen. LD H,A ; HL now has the correct address. RET ; return. ; ----------------------- ; ballast ; ----------------------- DEFB 0,0,0,0,0,0,0 ; ballast ; ----------------------------------------- ; THE NEW 'STACK TO LINE COLUMN' SUBROUTINE ; ----------------------------------------- ; This new subroutine is used by S_ATTR and S_SCRNS essentially to call the ; routine below but, in addition, it produces a runtime error if the column ; is greater than 31 or the line is greater than 23. ; Both parameters must be positive as specified by the BASIC manual. STK_TO_LC CALL BC_POSTVE ; LD A,B ; CP $20 ; JR NC,REPORT_By ; LD A,C ; CP $18 ; JR NC,REPORT_By ; RET ; ; ---------------------------- ; THE NEW 'BC POSITIVE' SUBROUTINE ; ---------------------------- ; BC_POSTVE CALL STK_TO_BC ; LD A,D ; fetch sign $01 or $FF (negative) OR E ; combine both signs - $FF if either negative. INC A ; RET NZ ; Return if both positive. REPORT_By RST 30H ; ERROR-1 DEFB $0A ; Error Report: Integer out of range ; ------------------ ; THE '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. COPY DI ; disable interrupts as this is time-critical. LD B,$B0 ; top 176 lines. LD HL,$4000 ; address start of the display file. ; now enter a loop to handle each pixel line. 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. COPY_2 DJNZ COPY_1 ; back to COPY-1 for all lines. COPY_END LD A,$04 ;+ output value 4 to port OUT ($FB),A ;+ to stop the slowed printer motor. EI ;+ enable interrupts. RET ;+ return ; ---------------------------- ; THE 'COPY BUFFER' SUBROUTINE ; ---------------------------- ; 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. ; The routine is invoked in two situations. ; 1) From PO-ENTER when a carriage return is received. ; 2) From PR-ALL when the column count C is reduced to zero. COPY_BUFF DI ; Disable Interrupts ;;; LD HL,$5B00 ; the old way. LD HL,($5B51) ;+ Address of Current Channel. LD DE,$08 ;+ The offset to the 256 byte channel buffer. ADD HL,DE ;+ ;;; LD B,$08 ; set count to 8 lines of 32 bytes. LD B,E ; set count to 8 lines of 32 bytes. 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. ;;; COPY_4 LD A,$04 ; output value 4 to port ;;; OUT ($FB),A ; to stop the slowed printer motor. ;;; EI ; enable interrupts. COPY_4 CALL COPY_END ;+ ; ------------------------------------- ; THE 'CLEAR PRINTER BUFFER' SUBROUTINE ; ------------------------------------- ; 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. ; As a consequence of this omission the buffer was needlessly ; cleared when COPY was used and the screen/printer position was set to ; the start of the buffer and the line number to 0 (B) ; giving an 'Out of Screen' error. CLEAR_PRB LD HL,($5B51) ;+ address of Current Channel. LD DE,$08 ;+ the offset to buffer. ADD HL,DE ;+ now points to start of 256 byte buffer. ;;; LD HL,$5B00 ; The old way. ;;; LD (IY+$46),L ; update PR_CC_lo - set to zero - superfluous. ;;; XOR A ; clear the accumulator. LD B,D ; set count to 256 bytes. PRB_BYTES LD (HL),D ; 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 ; DEC H ;+ Set pointer to start of buffer. JP PO_STORE ;+ exit to PO-STORE to store C only. ; Note. The correct value of HL is required for when COPY_BUFF is called at ; the start of PR_ALL. ; -------------------------- ; THE 'COPY LINE' SUBROUTINE ; -------------------------- ; 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. ; ; The slowing of the printer ensures that the two stylii, attached to the ; motor-driven rubber belt, come to rest off the paper. 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. COPY_L_1 CALL BREAK_KEY ; Call BREAK-KEY to read keyboard immediately. JR C,COPY_L_2 ; Forward, if 'break' not pressed, to COPY-L-2 ;;; LD A,$04 ; Stop the ;;; OUT ($FB),A ; printer motor. ;;; EI ; Enable interrupts. CALL COPY_END ;+ Routine stops the motor and performs EI. ;;; CALL CLEAR_PRB ; Call routine CLEAR-PRB. ; Now see if it is part of the fixed screen that is being copied. LD A,H ;+ Fetch high byte of address being copied. CP $58 ;+ Is address less than attribute file ? CALL NC,CLEAR_PRB ;+ If not call routine CLEAR-PRB. ;+ Note. should not be cleared if COPY in use. REPORT_Dc RST 30H ; ERROR-1 DEFB $0C ; Error Report: BREAK - CONT repeats ; --- 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, if stylus not in position, to COPY-L-1 LD C,$20 ; set count to 32 bytes. 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. 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 COPY_L_5 IN A,($FB) ; read the port. RRA ; bit 0 to carry. JR NC,COPY_L_5 ; back, if stylus not in position, to COPY-L-5 TAG5 LD A,D ; transfer command bits to A. L0F24: OUT ($FB),A ; and output to port. DJNZ COPY_L_4 ; loop back, for all 8 bits, to COPY-L-4 DEC C ; decrease the byte count. JR NZ,COPY_L_3 ; back, until 256 bits done, to COPY-L-3 RET ; return to calling routine COPY/COPY-BUFF. ; -------------------- ; THE 'EDITOR' ROUTINE ; -------------------- ; The editor is called to prepare or edit a BASIC line. ; It is also called from INPUT to input a numeric or string expression or ; to input characters sent by a network station or serial device. ; 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. EDITOR LD HL,($5B3D) ; fetch ERR_SP PUSH HL ; save on stack ED_AGAIN LD HL,ED_ERROR ; address: ED-ERROR PUSH HL ; save address on stack and LD ($5B3D),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. ED_LOOP CALL WAIT_KEY ; routine WAIT-KEY gets key possibly changing ; the mode. PUSH AF ; save the key. ; Do we need to always click? LD HL,$00C8 ; Give a short click. ;;; LD D,$00 ; LD D,H ;+ LD E,(IY-$01) ; Use PIP value for duration. 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, if so, to ADD-CHAR. ;;; CP $07 ; lower than 7 ? CP $06 ;+ lower than 6 ? 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. LD BC,$0002 ; Prepare early for ink/paper etc. CP $10 ; less than 16 decimal ? JR C,ED_KEYS ; forward to ED-KEYS ,if editing control in the ; range 6 to 15, as 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, if so, to ED-CONTR ; 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 ED_CONTR CALL WAIT_KEY ; routine WAIT-KEY for control. ; input address will be key-next. PUSH DE ; saved code/parameters LD HL,($5B5B) ; fetch address of keyboard cursor from K_CUR RES 0,(IY+$07) ; allow MODE 'L' or 'G' cancelling 'E' CALL MAKE_ROOM ; routine MAKE-ROOM makes 2/3 spaces at cursor POP BC ; restore code/parameters ;;; INC HL ; Address the 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 ; ------------------------- ; THE 'ADD CHAR' SUBROUTINE ; ------------------------- ; 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'. ADD_CHAR RES 0,(IY+$07) ; allow MODE 'L' or 'G' cancelling 'E' LD HL,($5B5B) ; fetch address of keyboard cursor from K_CUR LD BC,$0001 ; one space required CALL MAKE_ROOM ; create space at 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. ADD_CH_1 LD (DE),A ; load current character to last new location. INC DE ; address next LD ($5B5B),DE ; and update K_CUR system variable. RET ; return - either a simple return ; from ADD-CHAR or to ED-LOOP on stack. ; --------------------- ; THE 'ED KEYS' SECTION ; --------------------- ; A branch of the editing loop to deal with control characters using a ; look-up table. On entry BC now holds $0002. ED_KEYS LD E,A ; character to E. ;;; LD D,$00 ; prepare to add. LD D,B ; prepare to add. ;;; LD HL,ED_KEYS_T -7 ; base address of editing keys table. LD HL,ED_KEYS_T -6 ;+ NEW base address of editing keys table. ADD HL,DE ; add E LD E,(HL) ; fetch one-byte offset to E. ADD HL,DE ; add offset for address of handling routine. PUSH HL ; push the routine address on the machine stack. LD HL,($5B5B) ; load address of the cursor from K_CUR. ; New. carry results of next test into the routine to save performing ; the tests separately within the routines. TST_INP_M BIT 5,(IY+$37) ;+ Test FLAGX - INPUT mode ? RET ; Make an indirect jump forward to routine. ; Note Zero flag determines mode, BC holds $0002. ; ------------------------ ; THE '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 the correct handling of comma-separated items, over the network, ; there should be an entry for CHR$6 with offset to ED-SYMBOL. Done. ED_KEYS_T DEFB ED_SYMBOL-$ ;+ 06d offset to Address: ED-SYMBOL DEFB ED_EDIT -$ ; 07d offset to Address: ED-EDIT DEFB ED_LEFT -$ ; 08d offset to Address: ED-LEFT DEFB ED_RIGHT -$ ; 09d offset to Address: ED-RIGHT DEFB ED_DOWN -$ ; 10d offset to Address: ED-DOWN DEFB ED_UP -$ ; 11d offset to Address: ED-UP DEFB ED_DELETE-$ ; 12d offset to Address: ED-DELETE DEFB ED_ENTER -$ ; 13d offset to Address: ED-ENTER DEFB ED_SYMBOL-$ ; 14d offset to Address: ED-SYMBOL DEFB ED_GRAPH -$ ; 15d offset to Address: ED-GRAPH ; ------------------------- ; THE 'EDIT KEY' SUBROUTINE ; ------------------------- ; 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 ... ED_EDIT LD HL,($5B49) ; fetch E_PPC the last line number entered. ; Note. may not exist and may follow program. ;;; BIT 5,(IY+$37) ; test FLAGX - INPUT mode ? JR NZ,CLEAR_SP ; jump forward, if INPUT mode, to CLEAR-SP CALL LINE_ADDR ; routine LINE-ADDR to find address of line ; or following line if it doesn't exist. ; in DE. CALL LINE_NO ; routine LINE-NO will get line number from ; address or number of previous line if at the ; end-marker. LD A,D ; If there is no program then DE will OR E ; contain zero so test for this. JR Z,CLEAR_SP ; jump forward, if so, to CLEAR-SP ; 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. ; However a better solution is to call OUT_LINE at a point where the cursor ; will not be printed. 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,($5B51) ; 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_SLCT ; 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. ; fixed above CALL OUT_LINEX ; routine OUT-LINE outputs the BASIC line ; to the editing area. ;;; INC (IY+$0F) ; restore E_PPC_lo to the previous value. LD HL,($5B59) ; address E_LINE in editing area. INC HL ; advance INC HL ; past space INC HL ; and digit characters INC HL ; of line number. LD ($5B5B),HL ; update K_CUR to address start of BASIC. REST_CHAN POP HL ; restore the address of CURCHL. JP CHAN_FLAG ;+ routine CHAN-FLAG sets flags for it. ;;; CALL CHAN_FLAG ; routine CHAN-FLAG sets flags for it. ;;; RET ; RETURN to ED-LOOP. ; ---------------------------- ; THE 'CLEAR SPACE' SUBROUTINE ; ---------------------------- ; 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. CLEAR_SP PUSH HL ; preserve HL throughout. 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 setting BC ; to zero. LD ($5B5B),HL ; set K_CUR to start of empty area. ;;; LD (IY+$07),$00 ; set MODE to 'KLC' LD (IY+$07),B ;+ set MODE to 'KLC' POP HL ; restore HL. RET ; return. ; ------------------------------------ ; THE 'CURSOR DOWN EDITING' SUBROUTINE ; ------------------------------------ ; 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. ; With INPUT LINE, this key must be used instead of entering STOP. ;;; ED_DOWN BIT 5,(IY+$37) ; test FLAGX - Input Mode ? ED_DOWN JR NZ,ED_STOP ; skip, if INPUT mode, to ED-STOP LD HL,$5B49 ; 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. ; --- ED_STOP LD (IY+$00),$10 ; set ERR_NR to 'STOP in INPUT' code JR ED_ENTER ; forward to ED-ENTER to produce error. ; ------------------------------------ ; THE 'CURSOR LEFT EDITING' SUBROUTINE ; ------------------------------------ ; This acts on the cursor in the lower section of the screen in both ; editing and input mode. 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. ; ------------------------------------- ; THE 'CURSOR RIGHT EDITING' SUBROUTINE ; ------------------------------------- ; This acts on the cursor in the lower screen in both editing and input ; mode and moves it to the right. ; Note. The new code, suggested by Andrew Owen, avoids placing the cursor ; between a control code and its parameter. 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 CP $15 ;+ OVER or higher JR NC,ED_CUR ;+ CP $0F ;+ JR C,ED_CUR ;+ INC HL ;+ Step over a control code parameter. ED_CUR LD ($5B5B),HL ; update K_CUR system variable RET ; return to ED-LOOP ; ------------------------------- ; THE 'EDITING DELETE' SUBROUTINE ; ------------------------------- ; 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. ; Note. the second method would delete both controls and their parameters. 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 one character. ;;; EX DE,HL ; ;;; JP RECLAIM_1 ; ; ------------------------------- ; THE 'EDITING IGNORE' SUBROUTINE ; ------------------------------- ; 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 #7; a$. ED_IGNORE CALL WAIT_KEY ; routine WAIT-KEY to ignore code. CALL WAIT_KEY ; routine WAIT-KEY to ignore next code. ; ---------------------------------- ; THE 'EDITING ENTER KEY' SUBROUTINE ; ---------------------------------- ; The ENTER key has been pressed to have BASIC line or INPUT accepted. ED_ENTER POP HL ; discard address ED-LOOP POP HL ; drop address ED-ERROR ED_END POP HL ; the previous value of ERR_SP LD ($5B3D),HL ; is restored to ERR_SP system variable BIT 7,(IY+$00) ; is ERR_NR $FF ? RET NZ ; return if 'OK' LD SP,HL ; else put error routine on stack RET ; and make an indirect jump to it. ; ------------------------------------ ; THE 'ED-EDGE' SUBROUTINE ; ------------------------------------ ; 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. 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. 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 ; forward, if not, to ED-EDGE-2 ; 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. ; ; However, as Vickers later revealed these can be encountered with the ; RS232 and Network. 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, if not, to ED-EDGE-2 ; HL has been incremented twice INC HL ; increment a third time for 'at'/'tab' 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. ; ---------------------------------- ; THE 'CURSOR UP EDITING' SUBROUTINE ; ---------------------------------- ; 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. ;;; ED_UP BIT 5,(IY+$37) ; test FLAGX - INPUT mode ? ED_UP RET NZ ; return if in INPUT mode - to ED-LOOP. LD HL,($5B49) ; 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,$5B4A ; 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. ED_LIST CALL AUTO_LIST ; routine AUTO-LIST lists to upper screen ; including adjusted current line. ;;; LD A,$00 ;- explicit - select lower screen again CHAN_ZERO XOR A ;+ select lower screen again. JP CHAN_SLCT ; exit via CHAN-OPEN to ED-LOOP ; ------------------------------- ; THE '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 directional ; channel connected to each other:- ; then, when the other Spectrum has said PRINT #15; 24, 7 ; INPUT #15; x ; y would then treat the comma control as a newline and the ; control would skip to INPUT y. ; On the standard Spectrum, it was possible to get round the missing chr$ 6 ; handler by sending multiple print items separated by a newline '. ; Otherwise the expression "24,7" would be assigned to the first variable x ; raising 'Nonsense in BASIC'. ; chr$14 would have the same functionality. ; This is chr$ 14. ED_SYMBOL BIT 7,(IY+$37) ; test FLAGX - is this INPUT LINE ? JR Z,ED_ENTER ; back, if not, to ED-ENTER ; 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. ED_GRAPH JP ADD_CHAR ; jump back to ADD-CHAR ; ---------------------- ; THE 'ED_ERROR' ROUTINE ; ---------------------- ; If an error occurs while editing, or inputting, then ERR_SP ; points to the stack location holding address ED_ERROR. ; Note. this is specifically designed to deal with a BREAK into network input. ED_ERROR BIT 4,(IY+$30) ; test FLAGS2 - is K channel in use ? JR Z,ED_END ; back, if not, to ED-END ; 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 the pitch. ;;; CALL BEEPER ; routine BEEPER emits a warning rasp. CALL ED_RASP ;+ call the above code in new subroutine. JP ED_AGAIN ; to ED-AGAIN to re-stack the address of ; this routine and make ERR_SP point to it. ; ---------------------------- ; THE 'KEYBOARD INPUT' ROUTINE ; ---------------------------- ; This is the service routine for the input stream of the keyboard channel 'K'. 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/mode change. AND A ; clear carry flag - required exit condition. ;;; BIT 5,(IY+$01) ; test FLAGS - has a new key been pressed ? LD HL,$5B3B ;+ Address system variable FLAGS BIT 5,(HL) ;+ test FLAGS - has a new key been pressed ? RET Z ; return if no key has been pressed. >> ; Continue if the interrupt routine has supplied a key. LD A,($5B08) ; system variable LASTK will hold last key - ; from the interrupt routine. ;;; RES 5,(IY+$01) ; update FLAGS - reset the new key flag. RES 5,(HL) ; +update FLAGS - reset the new key flag. ;;; PUSH AF ; Save the input character. ; Now test if screen is to be cleared. after scroll?, Start tape, the ; copyright message or an error message. BIT 5,(IY+$02) ; test TV_FLAG - clear lower screen ? JR Z,KEY_CMP ;+ forward if not BIT 3,(HL) ;+ is FLAGS set - L mode PUSH AF ;+ Now save the input character. ;;; CALL NZ,CLS_LOWER ; CALL CLS_LOWER ;+ routine CLS-LOWER. POP AF ; restore the character code and test result. JR NZ,KEY_DONE2 ;+ forward as single key required. KEY_CMP 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. KEY_M_CL JR NZ,KEY_MODE ; forward to KEY-MODE if not 06 (capslock) LD HL,$5B6A ; point to FLAGS2 LD A,$08 ; value 00001000 XOR (HL) ; toggle BIT 3 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. ; --- 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,$5B41 ; 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 XXXX LD (HL),$00 ;+ else make MODE zero - KLC mode (D=0,fr CLS) ; Note. while in Extended/Graphics mode, ; the Extended Mode/Graphics key is pressed ; again to get out. KEY_FLAG CP A ; clear carry and reset zero flags - ; no actual key returned. SIG_KSTAT SET 3,(IY+$02) ; update TV_FLAG - show key state has changed RET ; make the return. ; --- ; now deal with colour controls - 16-23 ink, 24-31 paper 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) 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 KEY_NEXT LD A,($5B0D) ; 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. KEY_CHAN LD HL,($5B4F) ; address start of CHANNELS area using CHANS ; system variable. INC HL ; step over the KEY_CH2 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. KEY_DONE2 SCF ; set carry flag to show a key has been found RET ; Return. ; ---------------------------------- ; THE 'LOWER SCREEN COPYING' ROUTINE ; ---------------------------------- ; 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 8 characters. ; It may also contain embedded colour control codes. 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,($5B8A) ; fetch SPOSNL PUSH HL ; and save on stack. LD HL,($5B3D) ; fetch ERR_SP PUSH HL ; and save also LD HL,ED_FULL ; address: ED-FULL PUSH HL ; is pushed as the error routine LD ($5B3D),SP ; and ERR_SP made to point to it. LD HL,($5B82) ; 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,($5B8A) ; 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. ED_BLANK LD A,($5B8B) ; 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. 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 PRINT_OUT 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. ; ------------------------------- ; THE 'EDITOR-FULL' ERROR ROUTINE ; ------------------------------- ; 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 to continue would perhaps not be the best idea you've had that day. ;;; ED_FULL LD D,$00 ; prepare to moan. ;;; LD E,(IY-$02) ; fetch RASP value. ;;; LD HL,$1A90 ; set the pitch. ;;; CALL BEEPER ; routine BEEPER. ;;; LD (IY+$00),$FF ; clear ERR_NR. ED_FULL CALL ED_RASP ;+ call the above code in new subroutine. LD DE,($5B8A) ; fetch SPOSNL. JR ED_C_END ; forward to ED-C-END ; ---------------------------- ; THE NEW 'ED_RASP' SUBROUTINE ; ---------------------------- ED_RASP LD D,$00 ;+ prepare to moan. LD E,(IY-$02) ;+ fetch RASP value. LD HL,$1A90 ;+ set the pitch. CALL BEEPER ;+ routine BEEPER. SET_ER_FF LD (IY+$00),$FF ;+ clear ERR_NR. RET ;+ ; ------- ; the exit point from line printing continues here. ED_C_DONE POP DE ; fetch new line/column. POP HL ; fetch the error address. ; the error path rejoins here. ED_C_END POP HL ; restore the old value of ERR_SP. LD ($5B3D),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 ( and sets D to zero) POP HL ; restore new value LD ($5B82),HL ; and overwrite ECHO_E ;;; LD (IY+$26),$00 ; make error pointer X_PTR_hi out of bounds LD (IY+$26),D ;+ 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 SET_HL LD HL,($5B61) ; 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. SET_DE LD DE,($5B59) ; fetch E_LINE to DE ;;; BIT 5,(IY+$37) ; test FLAGX - Input Mode ? CALL TST_INP_M ;+ bit 5,(iy+$37) as a 3-byte call. RET Z ; return now if in editing mode LD DE,($5B61) ; fetch WORKSP to DE RET C ; return if carry set ( entry = set-de) LD HL,($5B63) ; fetch STKBOT to HL as well RET ; and return (entry = set-hl (in input)) ; ----------------------------------- ; THE 'REMOVE FLOATING POINT' ROUTINE ; ----------------------------------- ; 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 starting at a point in the ; edit line or input workspace. REMOVE_FP LD A,(HL) ; fetch character CP $0E ; is it the CHR$ 14 number marker ? LD BC,$0006 ; prepare to strip six bytes CALL Z,RECLAIM_2 ; routine RECLAIM-2 reclaims bytes if CHR$ 14. LD A,(HL) ; reload next (or same) character INC HL ; and advance address CP $0D ; end of the line or the 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 | System | ; | ROM | File | File | Variables | ; +---------+-----------+------------+-----------+-+-- ; ^ ^ ^ ^ ^ ; $0000 $4000 $5800 $5B00 $5BC8 = 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 | GO SUB |?|$3E| UDGs | ; | data | | Work Space | Stack | | Stack | Stack | | | | ; --+-------+--+------------+-------+-------+---------+--------+-+---+------+ ; ^ ^ ^ ^ ^ ^ ^ ; WORKSP STKBOT STKEND sp RAMTOP UDG P_RAMT ; ; ----------------- ; THE '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. NEW DI ; Disable Interrupts - machine stack will be ; cleared. LD A,$FF ; Flag coming from NEW. LD DE,($5BB2) ; Fetch RAMTOP as top value. EXX ; Switch in alternate set. LD BC,($5BB4) ; Fetch P-RAMT differs on 16K/48K machines. LD DE,($5B38) ; Fetch RASP/PIP. LD HL,($5B7B) ; Fetch UDG differs on 16K/48K machines. EXX ; Switch back to main set and continue into... ; ---------------------- ; THE 'START-NEW' BRANCH ; ---------------------- ; This branch is taken from above and from RST 00h. ; The common code tests RAM and sets it to zero re-initializing all the ; non-zero system variables and channel information. The A register flags ; if coming from START or NEW. START_NEW LD B,A ; Save the flag to control later branching. LD A,$07 ; Select a white border OUT ($FE),A ; and set it now by writing to a port. LD A,$3F ; Load the accumulator with last page in ROM. LD I,A ; Set the I register - this remains constant ; and can't be in the range $40 - $7F as 'snow' ; appears on the screen. ;;; NOP ; These seem unnecessary. ;;; NOP ; ;;; NOP ; Ho Ho Hum. ;;; NOP ; ;;; NOP ; Reset the network probably. ;;; NOP ; ; ----------------------- ; THE 'RAM CHECK' SECTION ; ----------------------- ; Typically, a Spectrum will have 16K or 48K of RAM and this code will test ; it all until 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 just visible. ram_check LD H,D ; Transfer the top value to the HL register LD L,E ; pair. RAM_FILL LD (HL),$02 ; Load memory with $02 - red ink on black paper. DEC HL ; Decrement memory address. CP H ; Have we reached ROM - $3F ? JR NZ,RAM_FILL ; Back, if not, to RAM-FILL 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. 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 ($5BB4),BC ; insert P-RAMT. LD ($5B38),DE ; insert RASP/PIP. LD ($5B7B),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 ($5BB4),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 ($5B7B),HL ; make UDG system variable address the first ; bitmap. DEC HL ; point at RAMTOP again. ;;; LD BC,$0040 ; without disturbing HL, set the values of ;;; LD ($5B38),BC ; the PIP and RASP system variables. ;;; ; Note. PIP is already zero. INC A ;+ increment from $3F to $40. LD ($5B38),A ;+ set RASP only to sixty four. ; the NEW command path rejoins here. RAM_SET LD ($5BB2),HL ; set system variable RAMTOP to HL. ; the NMI_ADD system variable points here by default to provide a Warm Reset. NMI_PTR LD HL,$3C00 ; "A seemingly strange place to set CHARS" LD ($5B36),HL ; Note. but it all makes sense now - see L0066. LD HL,($5BB2) ; fetch RAMTOP to HL. LD (HL),$3E ; top of user ram holds GO SUB end marker ; an impossible line number - see RETURN. ; no significance in the number $3E. On the ; ZX80 and ZX81 $3F was used. DEC HL ; followed by empty byte (not important). LD SP,HL ; set up the machine stack pointer. DEC HL ; DEC HL ; LD ($5B3D),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,$5B3A ; 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. ; At this point check to see if the NMI has been activated. LD A,($5B50) ;+ fetch high byte of CHANS_hi AND A ;+ is it unitialized? JR Z,SET_CHANS ;+ forward if so as from NEW/START ; else the NMI was activated and we don't want to lose the program. LD A,$03 ;+ prepare to reset streams 2,1 and 0. CALL NMI_STRMS ;+ reset the streams - reclaiming any dynamic ;+ buffers without incurring memory leaks. LD A,$1D ;+ prepare the NMI error code. JP MAIN_G ;+ forward to report NMI. ; --- SET_CHANS ;;; LD HL,$5BB6 ; the old address of the channels LD HL,$5BC9 ;+ the address of the channels - now following ;+ the system variables NTHCS. LD ($5B4F),HL ; set the CHANS system variable. LD DE,INIT_CHAN ; address: init-chan in ROM. ;;; LD BC,$0015 ; there were 21 bytes of initial data. LD C,$10 ;+ there are [16] 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 ($5B57),HL ; set DATADD to location before program area. INC HL ; increment again. LD ($5B53),HL ; set PROG the location where BASIC starts. LD ($5B4B),HL ; set VARS to same location with a LD (HL),$80 ; variables end-marker. INC HL ; advance address. LD ($5B59),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. ; -- ;;; So let's test this theory ;;; 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 ($5B61),HL ; set WORKSP - empty workspace. ;;; LD ($5B63),HL ; set STKBOT - bottom of the empty stack. ;;; LD ($5B65),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 ($5B8D),A ; set ATTR_P permanent colour attributes. ;;; LD ($5B8F),A ; set ATTR_T temporary colour attributes. LD ($5B48),A ; set BORDCR the border colour/lower screen ; attributes. LD HL,$0523 ; The keyboard repeat and delay values are LD ($5B09),HL ; loaded to REPDEL and REPPER. ; Now initialize BAUD and NTSTAT for RS232 and Network. LD HL,$5BB6 ;+ address FLAGS3 - unused but 0 could mislead DEC (HL) ;+ so set to $FF ; Use new WIDTH to control printer width INC L ;+ skip WIDTH lo INC L ;+ address WIDTH hi LD (HL),$50 ;+ set width to 80 characters. INC L ;+ skip MAXIY - the last IY addressable loc. INC L ;+ address BAUD lo LD (HL),$0C ;+ set default BAUD rate (9600). INC L ;+ skip BAUD hi INC L ;+ address NTSTAT - own station number. INC (HL) ;+ Default Global Station Number to 1. LD HL,NMI_PTR ;+ initialize the NMI vector above. LD ($5BB0),HL ;+ set the NMI_ADD ; Back to normal. DEC (IY-$3A) ; set KSTATE-0 to $FF - keyboard map available. DEC (IY-$36) ; set KSTATE-4 to $FF - keyboard map available. LD HL,INIT_STRM ; set source to ROM Address: init-strm LD DE,$5B10 ; set destination to system variable STRMS-FD ;;; LD BC,$000E ; copy the 14 bytes of initial 7 streams LD C,$0C ;+ copy the [12] bytes of initial [6] streams LDIR ; data 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. ;;; ; The buffer is clear. 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_0 ; 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 ; ------------------------- ; THE 'MAIN EXECUTION' LOOP ; ------------------------- ; This is the Main Execution Loop within which control remains after ; initialization. It is entered for the first time at MAIN-1 and thereafter ; each iteration begins with an Automatic Listing. An 'automatic Listing' is ; one that appears without involving the LIST command, for example, when the ; user presses [ENTER] after an Error Report. MAIN_EXEC LD (IY+$31),$02 ; set DF_SZ lower screen display file size to ; two lines. CALL AUTO_LIST ; routine AUTO-LIST ; The Initial Entry Point. MAIN_1 CALL SET_MIN ; routine SET-MIN clears work areas. ;;; MAIN_2 LD A,$00 ;- explicit - select stream zero. MAIN_2 CALL CHAN_ZERO ;+ routine CHAN_ZERO opens channel zero MAIN_2b res 3,(iy+$02) ;+ Gotcha! Signal no change in Mode. 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 User's input. BIT 7,(IY+$00) ; test ERR_NR - will be $FF if syntax is OK. JR NZ,MAIN_3 ; forward, if correct, to MAIN-3. ; Note. Now test if channel 'K' is in use BIT 4,(IY+$30) ; test FLAGS2 - K channel in use ? JR Z,MAIN_4 ; forward, if not, to MAIN-4 ; Channel 'K' was in use so X_PTR will have been set. LD HL,($5B59) ; 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'. CALL SET_ER_FF ;+ NEW 3-byte call JR MAIN_2b ; back to MAIN-2 to allow user to correct. ; --- ; The branch was here if syntax has passed test. ;;; MAIN_3 LD HL,($5B59) ; fetch the edit line address from E_LINE. ;;; LD ($5B5D),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. MAIN_3 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, if so, to MAIN-EXEC ; 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 as twenty five SUB (IY+$4F) ; minus the value of S_POSN_hi. LD ($5B8C),A ; update SCR_CT system variable. SET 7,(IY+$01) ; update FLAGS - signal running program. ;;; LD (IY+$00),$FF ; set ERR_NR to 'OK'. CALL SET_ER_FF ;+ NEW 3-byte call 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. ; Also, OPEN #0,"n";2 which allows another Spectrum to take control of this ; one. ; 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. MAIN_4 HALT ; wait for interrupt the only routine that can ; set bit 5 of FLAGS. RES 5,(IY+$01) ; reset bit 5 of 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 empty. ;;; ; Note. the programmer has neglected ;;; ; to set bit 1 of FLAGS first. LD A,($5B3A) ; 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. 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 ($5B0B),HL ; blank DEFADD to signal that no defined ;;; ; function is currently being evaluated. XOR A ; Set accumulator to zero LD (IY+$37),A ; clear all the bits of FLAGX. LD (IY+$26),A ; blank X_PTR_hi to suppress error marker. LD (IY+$2E),A ; blank DEFADD_hi to signal inactive. ;;; LD HL,$0001 ; prepare stream data. ;;; LD ($5B16),HL ; ensure STRMS-00 is the keyboard. ;;; ; and not the network as would have been set ;;; ; by OPEN #0, "n" ; 2 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 true error number LD B,A ; and make a copy in B. CP $0A ; is it a print-ready digit ? JR C,MAIN_5 ; forward, if so, to MAIN-5 ADD A,$07 ; add ASCII offset to letters. 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_1 ; call routine PO-MSG to print the message. ;;; XOR A ; clear accumulator to directly ;;; LD DE,comma_sp -1 ; address the comma and space message. ;;; CALL PO_MSG_0 ; routine PO-MSG prints ', ' although it would ;;; ; be more succinct to use RST $10. LD A,',' ;+ comma RST 10H ;+ print LD A,' ' ;+ space RST 10H ;+ print LD BC,($5B45) ; fetch PPC the current line number. CALL OUT_NUM_1 ; routine OUT-NUM-1 will print that LD A,$3A ; then a ':' character. RST 10H ; PRINT-A LD C,(IY+$0D) ; then SUBPPC for statement ;;; LD B,$00 ; limited to 127 CALL OUT_NUM_0 ; routine OUT-NUM-0 prints C. CALL CLEAR_SP ; routine CLEAR-SP clears editing area which ; probably contained 'RUN'. (B = 0) LD A,($5B3A) ; fetch ERR_NR again INC A ; test for no error originally $FF. JR Z,MAIN_9 ; forward, if no error, to MAIN-9 CP $09 ; is code Report 9 STOP ? JR Z,MAIN_6 ; forward, if so, to MAIN-6 CP $15 ; is code Report L BREAK ? JR NZ,MAIN_7 ; forward, if so, to MAIN-7 ; Stop or Break was encountered so consider CONTINUE. MAIN_6 INC (IY+$0D) ; increment SUBPPC to next statement. ;;; MAIN_7 LD BC,$0003 ; prepare to copy 3 system variables to MAIN_7 LD C,$03 ;+ prepare to copy 3 system variables to LD DE,$5B70 ; ...address OSPPC - statement for CONTINUE. ; also updating OLDPPC line number below. LD HL,$5B44 ; 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 set-up ; is correct. ADD HL,BC ; set source to SUBPPC number of current ; statement/line which will be repeated. MAIN_8 LDDR ; copy PPC to OLDPPC and SUBPPC to OSPCC ; or NSPPC to OLDPPC and NEWPPC to OSPCC 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. ; ---------------------------- ; THE 'CANNED REPORT MESSAGES' ; ---------------------------- ; The 30 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 accommodate 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 RETURN without GOSUB, 1000:127" [ 32 characters ] rpt_mesgs DEFB $80 DEFB 'O','K'+$80 ; 0 DEFM "NEXT without FO" DEFB 'R'+$80 ; 1 DEFM "Variable not foun" DEFB 'd'+$80 ; 2 DEFM "Subscript wron" DEFB 'g'+$80 ; 3 DEFM "Out of memor" DEFB 'y'+$80 ; 4 DEFM "Out of scree" DEFB 'n'+$80 ; 5 DEFM "Number too bi" DEFB 'g'+$80 ; 6 DEFM "RETURN without GOSU" ; DEFB 'B'+$80 ; 7 DEFM "End of fil" DEFB 'e'+$80 ; 8 DEFM "STOP statemen" DEFB 't'+$80 ; 9 DEFM "Invalid argumen" DEFB 't'+$80 ; A DEFM "Integer out of rang" DEFB 'e'+$80 ; B DEFM "Nonsense in BASI" DEFB 'C'+$80 ; C DEFM "BREAK - CONT repeat" DEFB 's'+$80 ; D DEFM "Out of DAT" DEFB 'A'+$80 ; E DEFM "Invalid file nam" DEFB 'e'+$80 ; F DEFM "No room for lin" DEFB 'e'+$80 ; G DEFM "STOP in INPU" DEFB 'T'+$80 ; H DEFM "FOR without NEX" DEFB 'T'+$80 ; I DEFM "Invalid I/O devic" DEFB 'e'+$80 ; J DEFM "Invalid colou" DEFB 'r'+$80 ; K DEFM "BREAK into progra" DEFB 'm'+$80 ; L DEFM "RAMTOP no goo" DEFB 'd'+$80 ; M DEFM "Statement los" DEFB 't'+$80 ; N DEFM "Invalid strea" DEFB 'm'+$80 ; O DEFM "FN without DE" DEFB 'F'+$80 ; P DEFM "Parameter erro" DEFB 'r'+$80 ; Q DEFM "Loading erro" DEFB 'r'+$80 ; R DEFM "Stream close" ;+ DEFB 'd'+$80 ;+ S DEFM "NM" ;+ DEFB 'I'+$80 ;+ T DEFM "Net R/W erro" ;+ DEFB 'r'+$80 ;+ U ;;; comma_sp DEFB ',',' '+$80 ; used in report line. COPYRIGHT DEFB $7F ; copyright DEFM " 1982 Sinclair Research Ltd" DEFB '.'+$80 ;+ just differentiate ; ---------------------- ; THE 'REPORT_G' ROUTINE ; ---------------------- ; 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. Since this can only occur as a result of a direct command, ; there is no need to record the X-PTR via the error restart. ; 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 ; ---------------------- ; THE 'MAIN_ADD' SECTION ; ---------------------- ; 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. MAIN_ADD LD ($5B49),BC ; set E_PPC to extracted line number. RST 18H ;;;; ;;; LD HL,($5B5D) ; 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,($5B61) ; 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. CALL NXT_1_RC2 ;+ routine combines above 2 routines. MAIN_ADD1 POP BC ; retrieve the length of the new line. LD A,C ; and test if a carriage return only DEC A ; i.e. one byte long. OR B ; result would be zero. JR Z,MAIN_ADD2 ; forward, if so, to MAIN-ADD2 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,($5B53) ; fetch the address of PROG PUSH DE ; and save it on the stack CALL MK_RM_DHL ;+ MAKE_ROOM decrementing HL first ;;; CALL MAKE_ROOM ; routine MAKE-ROOM creates BC spaces in ; program area and updates pointers. POP HL ; restore old program pointer. LD ($5B53),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,($5B61) ; set HL to WORKSP - location after edit line. DEC HL ; decrement to address end marker. DEC HL ; decrement to address the carriage return. LDDR ; copy the BASIC line back to initial command. LD HL,($5B49) ; 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). 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. ; --------------------------------- ; THE '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, by this ROM, and the last ; character, which could be anything other than a comma, provides a ; convenient resting place for DATADD. 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 ; RAW_INPUT DEFB $52 ; 'R' ;;; DEFW PRINT_OUT ; PRINT-OUT ;;; DEFW REPORT_J ; REPORT-J ;;; DEFB $50 ; 'P' DEFB $80 ; End Marker REPORT_J RST 30H ; ERROR-1 DEFB $12 ; Error Report: Invalid I/O device ; ------------------------- ; THE '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. 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' ; ------------------------------ ; THE 'INPUT CONTROL' SUBROUTINE ; ------------------------------ ; WAIT_KEY BIT 5,(IY+$02) ; test TV_FLAG - clear lower screen ? JR NZ,WAIT_KEY1 ; forward, if so, to WAIT-KEY1 SET 3,(IY+$02) ; update TV_FLAG - signal reprint the edit ; line to the lower screen. SIG_KSTAT. 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 normally taken. ; It is taken when 'Iris' closes her channel. REPORT_8 RST 30H ; ERROR-1 DEFB $07 ; Error Report: End of file ; --------------------------- ; THE 'INPUT ADDRESS' ROUTINE ; --------------------------- ; This routine fetches the address of the input stream from the current ; channel area using the system variable CURCHL. INPUT_AD EXX ; switch in alternate set. PUSH HL ; save HL register LD HL,($5B51) ; 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. ; ---------------------- ; THE 'OUT CODE' ROUTINE ; ---------------------- ; This routine is called on five occasions to print the ASCII equivalent of ; a value 0-9. OUT_CODE LD E,$30 ; add 48 decimal to give the ASCII character ADD A,E ; '0' to '9' and continue into the main output ; routine. ; ------------------------- ; THE 'MAIN OUTPUT' ROUTINE ; ------------------------- ; The PRINT-A-2 is a continuation of the RST 10 restart that outputs any ; character. The routine prints 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 PRINT_OUT. PRINT_A_2 EXX ; switch in alternate set PUSH HL ; save HL register LD HL,($5B51) ; fetch CURCHL the current channel. ; input-ad rejoins here also. 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. ; --- ; Note. the most popular channel number could be placed here e.g. LD A,$FE ; ------------------------------- ; THE 'OPEN CHANNEL 0xFE' ROUTINE ; ------------------------------- CHAN_O_FE LD A,$FE ; JR CHAN_SLCT ; ; --------------------------------- ; THE 'OPEN CHANNEL SYNTAX' ROUTINE ; --------------------------------- CHN_O_SYN CALL UNSTACK_Z ;+ Return if Checking Syntax. ; -------------------------- ; THE 'CHANNEL SELECT' ROUTINE ; -------------------------- ; This subroutine is used by the ROM to select a channel 'K', 'S', 'R' or 'P'. ; This is either for its 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. CHAN_SLCT ADD A,A ; double the stream ($FF will become $FE etc.) ADD A,$16 ; add the offset to stream 0 from $5B00 LD L,A ; result to L LD H,$5B ; 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. JP Z,REPORT_O ; forward if closed to report ; 'Invalid stream' ;;; JR NZ,CHAN_OP_1 ; forward to CHAN-OP-1 if open. ;;; REPORT_Oa RST 30H ; 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. CHAN_OP_1 DEC DE ; reduce offset so it points to the channel. LD HL,($5B4F) ; 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. ; ------------------------------ ; THE 'CHANNEL FLAGS' SUBROUTINE ; ------------------------------ ; This subroutine is used from ED-EDIT, str$ and read-in to reset the ; current channel when it has been temporarily altered. CHAN_FLAG RES 4,(IY+$30) ; update FLAGS2 - signal K channel not in use. ; Note. provide a default for ; channel 'R','S' and 'P'. LD ($5B51),HL ; set CURCHL system variable to the ; address in HL ;;; INC HL ; advance past ;;; INC HL ; output routine. ;;; INC HL ; advance past ;;; INC HL ; input routine. ;;; LD C,(HL) ; pick up the letter. CALL IN_CHAN_K ;+ routine gets channel letter in A. LD HL,CHN_CD_LU-1 ; address: chn-cd-lu CALL INDEXER_0 ; 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 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. ; -------------------------------- ; THE '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. 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. ; ---------------------------- ; THE 'CHANNEL K FLAG' ROUTINE ; ---------------------------- ; routine to set flags for lower screen/keyboard channel. CHAN_K ;;; SET 0,(IY+$02) ; update TV_FLAG - signal lower screen in use CALL SIG_L_SCR ;+ set 0,(iy+$02) as a 3-byte call. 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 ; ---------------------------- ; THE 'CHANNEL S FLAG' ROUTINE ; ---------------------------- ; routine to set flags for upper screen channel. CHAN_S RES 0,(IY+$02) ; TV_FLAG - signal main screen in use 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. ; ---------------------------- ; THE 'CHANNEL P FLAG' ROUTINE ; ---------------------------- ; 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. CHAN_P SET 1,(IY+$01) ; update FLAGS - signal printer in use RET ; return ; -------------------------- ; THE 'ONE SPACE' SUBROUTINE ; -------------------------- ; This routine WAS called once only to create a single space ;;; ONE_SPACE LD BC,$0001 ; create space for a single character. MK_RM_EL LD HL,($5B59) ; fetch E_LINE to HL. MK_RM_DHL DEC HL ; point to location before. ; ----------------------- ; THE 'MAKE ROOM' ROUTINE ; ----------------------- ; 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 address this location. ; Note. It used to point to the location before this. 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,($5B65) ; 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. INC HL ;+ New - as suggested by James Smith. RET ; return with new area ready to be populated. ; Note. HL now points to first location of new area, and DE to last of new ; locations. ; ------------------------- ; THE 'POINTERS' SUBROUTINE ; ------------------------- ; 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. POINTERS PUSH AF ; preserve accumulator. PUSH HL ; put pos pointer on stack. LD HL,$5B4B ; address VARS the first of the LD A,$0E ; fourteen variables to consider. 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, if var before pos, to PTR-DONE 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. PTR_DONE INC HL ; address next system variable. DEC A ; decrease counter. JR NZ,PTR_NEXT ; back, if more, to PTR-NEXT 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. ; ------------------------------------ ; THE 'COLLECT LINE NUMBER' SUBROUTINE ; ------------------------------------ ; 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. ; Note. any two zero bytes in ROM will do for a line zero. ;;; LINE_ZERO DEFB $00, $00 ; dummy line number used for direct commands ;;; ; Note. space character is now used instead. LINE_NO_A EX DE,HL ; fetch the previous line to HL and set LD DE,LINE_ZERO ; set DE to word zero pointer should HL also ; fail. ; -> The Entry Point. 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. ; ---------------------------------- ; THE 'CREATE BC SPACES' SUBROUTINES ; ---------------------------------- ;+ This was formerly a restart but is now called as a subroutine ;+ to free up the RST 30 for error handling. BC_SPACE1 LD C,1 ;+ Creates one space - the most popular option. BC_SPACE0 LD B,0 ;+ Only C need be specified. BC_SPACES PUSH BC ; save number of spaces. LD HL,($5B61) ; fetch WORKSP. PUSH HL ; save address of workspace. RESERVE LD HL,($5B63) ; STKBOT first location of calculator stack CALL MK_RM_DHL ;+ routine MAKE_ROOM adjusting HL ;;; 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 ($5B61),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. ; ---------------------------- ; THE 'SET MINIMUM' SUBROUTINE ; ---------------------------- ; 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 ; resets MEM to its 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. ; Although not intended as such, this routine used to clear up any imbalance ; in the calculator stack. SET_MIN LD HL,($5B59) ; fetch E_LINE LD (HL),$0D ; insert carriage return LD ($5B5B),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 ($5B61),HL ; start of WORKSP ; This entry point is used prior to input and prior to the execution, ; or parsing, of each statement. SET_WORK LD HL,($5B61) ; fetch WORKSP value LD ($5B63),HL ; and place in STKBOT ; This entry point is used to move the stack back to its normal place ; after temporary relocation during line entry and also from ERROR-3 SET_STK LD HL,($5B63) ; fetch STKBOT value LD ($5B65),HL ; and place in STKEND. ;;; PUSH HL ; perhaps an obsolete entry point. LD HL,$5B92 ; normal location of MEM-0 LD ($5B68),HL ; is restored to system variable MEM. ;;; POP HL ; saved value not required. RET ; return. ; ---------------------- ; THE 'REC-EDIT' ROUTINE ; ---------------------- ; This is legacy code from the ZX80/ZX81 and it is not used in this ROM. ; That task, in fact, is performed here by the dual-area routine CLEAR-SP. ;;; REC-EDIT ;;; L16D4: LD DE,($5B59) ; fetch start of edit line from E_LINE. ;;; JP RECLAIM_1 ; jump forward to RECLAIM-1. ; ------------------------------- ; THE 'TABLE INDEXING' SUBROUTINE ; ------------------------------- ; 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. ; -> The Entry Point. INDEXER_0 LD C,A ;+ Replaces 4 similar instructions LD B,$00 ;+ A useful return value. INDEXER_1 INC HL ; Address the next pair of values. INDEXER LD A,(HL) ; Fetch the first byte of pair AND A ; Is it the end-marker ? ;;; RET Z ; Return, if so, with carry reset. JR NZ,INDEXER_2 ; LD A,C ; RET ; INDEXER_2 CP C ; Is it the required character ? INC HL ; Address next location. JR NZ,INDEXER_1 ; Back, if no match, to INDEXER-1 LD C,(HL) ; ADD HL,BC ; SCF ; Set the carry flag. RET ; Return with carry set. ; -------------------------------- ; The Channel and Streams Routines ; -------------------------------- ; A channel 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 'CLOSE STREAM' 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. ; Any attempt to CLOSE streams $00 to $04, without first opening the stream, ; will lead to either a system restart or the production of a strange report. ; credit: Martin Wren-Hilton 1982. 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 is closed'. JR NZ,CLOSE_OK ;+ Continue if stream is open. REPORT_S RST 30H ;+ ERROR-1 DEFB $1B ;+ 'Stream is closed' CLOSE_OK CALL CLOSE_2 ; routine CLOSE-2 will 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 ; LD DE,$A4E4 ;+ the number of bytes from stream 4 to $10000 EX DE,HL ; transfer the offset to HL and the STRMS data ; pointer to the DE register. ADD HL,DE ; add the offset to the data pointer. JR C,CLOSE_1 ; forward, if a non-system stream, to CLOSE_1 ; proceed with a negative result offset now 12 (was 14). ;;; LD BC,INIT_STRM +14; prepare the address of the byte after streams. LD BC,INIT_STRM +12;+ prepare the address of the byte after the ;+ initial stream data in ROM. ADD HL,BC ; index into the ROM data table with negative ; value. LD C,(HL) ; Read low-order byte from ROM to C INC HL ; address next ROM location. LD B,(HL) ; Read high-order byte from ROM to B. ; For streams 0 - 2 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 3 - 15, the BC register holds zero, and the entry is blanked. CLOSE_1 EX DE,HL ; Transfer 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. ; ------------------------ ; THE 'CLOSE-2' SUBROUTINE ; ------------------------ ; This routine finds the offset to a special closing routine, ; in this ROM and within 256 bytes of the close stream look up table that ; reclaims any buffers associated with a stream. ; IN: HL=address in STRMS BC=offset from CHANS to 2nd byte of channel CLOSE_2 PUSH HL ; * save address of stream data pointer ; in STRMS on the machine stack. LD HL,($5B4F) ; fetch CHANS address to HL ADD HL,BC ; add the offset to address the second byte DEC HL ; point to first byte. LD ($5B51),HL ;+ Update system variable CURCHL ;+ While we have the channel in the register, ;+ make it 'current; as we may have to flush. PUSH HL ;+ copy to IX register. POP IX ;+ LD D,B ;+ Save offset in DE. LD E,C ;+ LD A,(IX+$04) ;+ pick up the channel letter in A. LD HL,CL_STR_LU-1 ; address: cl-str-lu in ROM. CALL INDEXER_0 ; routine INDEXER uses the code to get ; the 8-bit offset from the current point to ; the address of the Closing Routine in ROM. ;;; 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. JP (HL) ; jump to that routine. ; --- ; Note. the address $1708 musr be avoided or else Interface 1 ROM will be ; paged in. We need the hardware - not the software. ; --- DEFB 0,0,0,0 ;+ ballast DEFB 0,0,0,0 ;+ ballast TAG6: DEFB 0,0,0,0 ;+ ballast ; -------------------------------- ; THE '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. CL_STR_LU DEFB 'K', CLOSE_E-$-1; offset to CLOSE_E DEFB 'S', CLOSE_E-$-1; offset to CLOSE_E DEFB 'P', CLOSE_P-$-1;+ offset to CLOSE_P DEFB 'B', CLOSE_A-$-1;+ offset to CLOSE_A DEFB 'T', CLOSE_A-$-1;+ offset to CLOSE_A DEFB 'N', CLOSE_N-$-1;+ offset to CLOSE_N ; ------------------------------ ; THE 'CLOSE PRINTER STREAM' SUBROUTINE ; ------------------------------ ; The last data block must be sent as an EOF record. CLOSE_P CALL COPY_BUFF ; send EOF record. JR CLOSE_A ; skip forward to generic CLOSE_A routine. ; ------------------------------ ; THE 'CLOSE NETWORK' SUBROUTINE ; ------------------------------ ; The last data block must be sent as an EOF record except when T_ADDR_hi ; indicates that 'CLEAR #' has been used. In this case the network buffer ; is simply closed losing its contents. CLOSE_N BIT 6,(IY+$3B) ; Test T_ADDR_hi CALL Z,SEND_NEOF ; send EOF record. ; -------------------------- ; THE 'CLOSE ALL' SUBROUTINE ; -------------------------- ;+ Initially, removed the 264 byte "P" channel and the ZX printer buffer. ;+ In fact this routine is generic and will remove any channel. CLOSE_A PUSH DE ; Save CHANS offset. PUSH IX ; POP HL ; HL addresses the start of the channel. LD C,(IX+$05) ; LD B,(IX+$06) ; BC contains length. PUSH BC ; Preserve bytes to reclaim. CALL RECLAIM_2 ; Routine RECLAIM-2 POP BC ; Restore reclaimed byte count. ; Any open streams that point to channels beyond that deleted (offset =DE) ; will have to have offsets reduced by the amount reclaimed (length = BC) ; This is similar to REST-STRM in Interface 1 LD A,$10 ; 16 user streams LD HL,$5B16 ; Start of user streams in sysvars. NEXT_STRM LD ($5B5F),HL ; Save current pointer in X_PTR LD E,(HL) ; Fetch displacement for current stream. INC HL ; LD D,(HL) ; POP HL ; restore chans offset PUSH HL ; push the value again. AND A ; clear carry SBC HL,DE ; compare by subtraction. JR NC,UPD_POINT ; forward if before deleted channel to do a ; dummy update as provides easier pathing. EX DE,HL ; transfer current displacement to HL. AND A ; clear carry. SBC HL,BC ; reduce displacement by amount deleted. EX DE,HL ; transfer new displacement to DE. UPD_POINT LD HL,($5B5F) ; Fetch STRMS pointer from X_PTR LD (HL),E ; INC HL ; LD (HL),D ; INC HL ; DEC A ; Decrement stream counter. JR NZ,NEXT_STRM ; loop back till all sixteen tested. POP HL ; balance stack ; Note. as long as X_PTR points to somewhere harmless it need not be set to ; a zero value. Interface 1 mistakenly sets the low byte anyway. ; -------------------------- ; THE 'CLOSE END' SUBROUTINE ; -------------------------- ; The close stream routines have no ancillary actions to perform with regard ; to 'K' and 'S'. CLOSE_E POP HL ; * now just restore the stream data pointer RET ; in STRMS and return. ; ---------------------------- ; THE 'STREAM DATA' SUBROUTINE ; ---------------------------- ; 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. STR_DATA CALL FIND_INT1 ; Routine FIND-INT1 fetches parameter to A ; setting B to zero. CP $10 ; Is it less than 16d ? JR C,STR_DATA1 ; Skip forward, if so, to STR-DATA1 ; Note. the unimplemented ERASE and MOVE commands also now point here. REPORT_O RST 30H ; ERROR-1 DEFB $17 ; Error Report: Invalid stream ; --- STR_DATA1 ADD A,$03 ; add the offset for the three system streams. ; range 00 - 15d becomes 3 - 18d. RLCA ; double the offset as there are two bytes per ; stream - now 06 - 36d LD HL,$5B10 ; address STRMS - the start of the streams ; data area in the system variables. LD C,A ; transfer the low byte to C. LD B,$00 ; prepare to add offset. ADD HL,BC ; add to address the data entry in STRMS. ; the data entry itself contains an offset from CHANS to the address of the ; stream LD C,(HL) ; Fetch low byte of displacement to C. INC HL ; Address next. LD B,(HL) ; Fetch high byte of displacement to B. DEC HL ; Step back to leave HL pointing to STRMS ; data entry. LD A,B ;+ Test for zero now OR C ;+ as a common return condition. RET ; Return with CHANS displacement in BC ; and address of stream data entry in HL. ; -------------------- ; THE 'OPEN #' COMMAND ; -------------------- ; This command has been changed from CLASS_03 to CLASS_05 ; Command syntax example: OPEN #6,"p" and OPEN #7,"n";64 OPEN LD A,$FF ; set all bits of A as station indicator. EX AF,AF' ; preserve as an invalid network station. CALL EXPT_SEP ; is next character a separator ? JR NZ,CHK_O_END ; forward if not to check end - no station. ; If there was a separator then the network station comes next. ;;; RST 20H ; NEXT_CHAR ;;; CALL EXPT_1NUM ; routine EXPT-1NUM checks for number ;;; CALL CHECK_END ; as in OPEN #9,"n",64 CALL CHK_END_1 ;+ above three routines combined. ; It is runtime so the network station is on the stack. CALL FIND_INT1 ;+ routine FIND-INT1 fetches parameter to A. EX AF,AF' ;+ preserve in alternate register ; It is simpler to pass through check than jump over it. CHK_O_END CALL CHECK_END ; finish if checking syntax. ; In runtime, the channel code entry is on the calculator stack with the next ; value containing the stream identifier. They have to be swapped. 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 data entry. The zero flag will be ; set if the stream is closed. ;;; LD A,B ; test for zero which ;;; OR C ; indicates the stream is closed. JR Z,OPEN_1 ; skip forward, if closed, to OPEN-1 ; If it is an open system channel, then it can be re-attached. EX DE,HL ; save STRMS address in DE. LD HL,($5B4F) ; fetch CHANS. ADD HL,BC ; add the offset to address the second ; byte of the channel. ;;; INC HL ; ;;; INC HL ; ;;; INC HL ; ;;; LD A,(HL) ; CALL NUMBER_3 ;+ add 3 to hl and fetch A comparing to 'K'. ; A new channel can replace an existing one only if the existing channel ; is not associated with a dynamic buffer. Otherwise the buffer would be ; left hanging. The channel to be replaced is checked against a list of ; those that are not dynamic. ; Note. If the channel is dynamic then it must be closed and then opened. ; This manual closure may involve re-instating an initial channel. EX DE,HL ; bring back the STRMS pointer. ;;; CP $4B ; is it 'K' ? JR Z,OPEN_1 ; forward, if so, to OPEN-1 ;;; CP $53 ; is it 'S' ? ;;; JR Z,OPEN_1 ; forward, if so, to OPEN-1 CP $53 ; is it 'S' ? (was 'P') JR NZ,REPORT_O ; back, if not, to REPORT-O ; 'Invalid stream'. ; Continue if one of the upper-case letters was found and rejoin here from ; above if the stream was already closed. OPEN_1 CALL OPEN_2 ; routine OPEN-2 opens the stream. ; It now remains to update the STRMS variable. JP PO_CH_2 ;+ jump to similar code to that below. (JS) ;;; LD (HL),E ; insert or overwrite the low byte. ;;; INC HL ; address high byte in STRMS. ;;; LD (HL),D ; insert or overwrite the high byte. ;;; RET ; return. ; ----------------------- ; THE 'OPEN_2' SUBROUTINE ; ----------------------- ; As well as creating buffers, this routine also sets flags. ; Note. that on the original Spectrum the network station was passed in ; after the "N" channel identifier. This made syntax checking easy but if ; the station identifier was numeric it is a departure from the rule that ; any number can be replaced by a numeric expression. The station identifier ; could have been a character. OPEN_2 PUSH HL ; * save the STRMS data entry pointer throughout CALL EXPT_SPEC ;+ NEW routine fetches a one character specifier ;+ to A ;;; CALL STK_FETCH ; routine STK-FETCH now fetches the paremeters. ;;; 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!!!! ;;; REPORT_F RST 30H ; ERROR-1 ;;; DEFB $0E ; Error Report: Invalid file name ;;; OPEN_3 PUSH BC ; Save the length of the string. ;;; LD A,(DE) ; Pick up the first character. AND $DF ; Make it upper-case. ;;; LD C,A ; Place channel specifier in C. LD HL,OP_STR_LU-1 ; Address: op-str-lu is addressed. CALL INDEXER_0 ; Routine INDEXER will search for the letter. JR NC,REPORT_F ; Forward, if not found, to REPORT-F ; 'Invalid filename' ;;; LD C,(HL) ; Fetch the displacement to opening routine. ;;; LD B,$00 ; prepare to add. ;;; ADD HL,BC ; Now form address of the opening routine. ;;; POP BC ; Restore the length of the string. JP (HL) ; Jump forward to the relevant routine. ; ------------------------------- ; THE '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. ; Note. The table has been re-arranged so that those without buffers ; come last providing two look-up tables in one. OP_STR_LU DEFB 'P', OPEN_P-$-1 ; offset to OPEN-P DEFB 'N', OPEN_N-$-1 ;+ offset to OPEN_N DEFB 'B', OPEN_B-$-1 ;+ offset to OPEN-B DEFB 'T', OPEN_T-$-1 ;+ offset to OPEN-T NOBUF_LU DEFB 'K', OPEN_K-$-1 ; offset to OPEN-K DEFB 'S', OPEN_S-$-1 ; offset to OPEN-S DEFB $00 ; end-marker. ; -------------------------------- ; THE 'STREAM OPENING' SUBROUTINES ; -------------------------------- ; Note. That was then, this is now. ; These routines would have opened any buffers associated with the stream ; before jumping forward 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. ; ----------------------- ; THE 'OPEN-K' SUBROUTINE ; ----------------------- ; Open Keyboard channel. ; Note. the full 16-bit offset is now supplied in DE. ;;; OPEN_K LD E,$01 ; offset to channel 'K'. OPEN_K LD DE,$0001 ;+ 01 is offset to 2nd byte of channel 'K'. JR OPEN_END ; forward to OPEN-END ; ----------------------- ; THE 'OPEN-S' SUBROUTINE ; ----------------------- ; Open Screen channel. ; Note. the full 16-bit offset is now supplied in DE. ;;; OPEN_S LD E,$06 ; offset to channel 'K'. OPEN_S LD DE,$0006 ;+ 06 is offset to 2nd byte of channel 'S' JR OPEN_END ; forward to OPEN-END ; ----------------------- ; THE 'OPEN-P' SUBROUTINE ; ----------------------- ; Open Printer channel. OPEN_P LD IX,PCHAN_DAT ;+ point to the channel data. JR OPEN_ALL ;+ forward to generic opening routine. ; ----------------------- ; THE 'OPEN-B' SUBROUTINE ; ----------------------- ; Open B RS232 channel OPEN_B LD IX,BCHAN_DAT ;+ point to the channel data. JR OPEN_ALL ;+ forward to generic opening routine. ; ----------------------- ; THE 'OPEN-T' SUBROUTINE ; ----------------------- ; Open T RS232 channel OPEN_T LD IX,TCHAN_DAT ;+ point to the channel data. JR OPEN_ALL ;+ forward to generic opening routine. ; ---------------------------------------- ; THE 'OPEN PERMANENT "N" CHANNEL' ROUTINE ; ---------------------------------------- ; e.g. OPEN #9,"N";2 OPEN_N LD IX,NCHAN_DAT ;+ ; ---------------------- ; THE 'OPEN_ALL' ROUTINE ; ---------------------- ;+ Generic Channel Opening Routine. ;+ DE still points to string OPEN_ALL LD HL,($5B53) ; Set pointer from PROG LD C,(IX+$05) ; length lo. LD B,(IX+$06) ; length hi. CALL MK_RM_DHL ;+ routine MAKE_ROOM decrementing HL first. ; HL points to the 1st location, DE to last new location, BC is zero ;;; INC HL ; HL points to start of new channel PUSH HL ; (*) Save channel pointer. EX DE,HL ; Transfer HL to DE. PUSH IX ; Transfer ROM data pointer POP HL ; to HL. LD C,(IX-$01) ; Find number of bytes in ROM LDIR ; Block copy the channel data. ; Note. a call to clear the ZX Printer buffer is required here. ; but can be done directly. LD A,(IX+$04) ; CP 'P' ; JR Z,P_BLANK ; Forward, if printer, to P_BLANK CP 'N' ; is it network ? JR NZ,OFFSET ; EX AF,AF' ; save device letter, bring back station. CP $41 ; compare to 64 JP NC,REPORT_B ; forward, if over, to report ; 'Integer out of range' LD (DE),A ; set channel variable NCIRIS INC DE ; address own station number. LD A,($5BBC) ; fetch global station number from sysvar NTSTAT LD (DE),A ; update channel variable NCSELF EX AF,AF' ; save again. INC DE ; point to next location ; Note. the network buffer does not have to be cleared. As long as we set ; the other channel variables to zero that is sufficient so use the same ; routine as is used for the ZX Printer buffer which does all but 4. P_BLANK LD H,D ; LD L,E ; INC DE ; LD (HL),B ; Blank first location DEC C ; set count to 255 decimal or whatever. LDIR ; ; now calculate offset from CHANS OFFSET LD HL,($5B4F) ; Address CHANS POP DE ; (*) Restore the channel pointer EX DE,HL ; INC HL ; the second byte is used. AND A ; prepare to subtract SBC HL,DE ; result is in HL EX DE,HL ; transfer offset to DE ;;; POP BC ; Restore length of string. CP 'N' JR Z,OPEN_END2 ; skip the length test ; ---------------------- ; THE 'OPEN END' ROUTINE ; ---------------------- ;;; 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. ; OPEN_IFN JP NZ,REPORT_F ; back, if not, to REPORT-Fb ;;; ; 'Invalid file name' ;;; LD D,A ; load D with zero to form the displacement. ; It used to go like that and now it goes like this... OPEN_END EX AF,AF' ; station number - should be $FF INC A ; test for $FF OPEN_END2 POP HL ; * restore the saved STRMS pointer. RET Z ; return to update STRMS entry thereby ; signaling stream is open. ; A parameter has been supplied for a channel that does not require one ; e.g. OPEN #6,"t",78 REPORT_F RST 30H ; ERROR-1 DEFB $0E ; Error Report: Invalid file name ; ---------------------- ; THE '"P" CHANNEL DATA' ; ---------------------- ; The eight bytes "P" channel descriptor. DEFB $08 ;+ length of channel data PCHAN_DAT DEFW PRINT_OUT ;+ PRINT-OUT DEFW REPORT_J ;+ REPORT-J DEFB 'P' ;+ Letter as in standard ROM DEFW $0108 ;+ Length of channel including printer buffer. DEFB $21 ;+ P_POSN (IX+$07) ; ---------------------- ; THE '"B" CHANNEL DATA' ; ---------------------- ; The seven bytes "B" channel descriptor. Maybe stick the 2-byte buffer here. DEFB $07 ;+ length of channel data BCHAN_DAT DEFW BCHAN_OUT ;+ BCHAN_OUT DEFW BCHAN_IN ;+ BCHAN_IN DEFB 'B' ;+ Letter DEFW $0007 ;+ Length of channel ; ---------------------- ; THE '"T" CHANNEL DATA' ; ---------------------- ; The seven bytes "T" channel descriptor. DEFB $07 ;+ length of channel data TCHAN_DAT DEFW TCHAN_OUT ;+ TCHAN_OUT DEFW TCHAN_IN ;+ TCHAN_IN DEFB 'T' ;+ Letter DEFW $0007 ;+ Length of channel ; ---------------------- ; THE '"N" CHANNEL DATA' ; ---------------------- ; The seven bytes "N" channel descriptor. DEFB $07 ;+ length of data NCHAN_DAT DEFW NCHAN_OUT ;+ NCHAN-OUT DEFW NCHAN_IN ;+ NCHAN_IN DEFB $4E ;+ character "N" DEFW $0110 ;+ length ; The other channel variables for network are defaulted to zero. They are - ; ; 1 NCIRIS IX+$07 ; The destination station number. ; 1 NCSELF IX+$08 ; This SPECTRUM's station number. ; 2 NCNUMB IX+$09 ; The block number. ; 1 NCTYPE IX+$0B ; The packet type code ... 0 data, 1 EOF. ; 1 NCOBL IX+$0C ; The number of bytes in the data block. ; 1 NCDCS IX+$0D ; The data checksum. ; 1 NCHCS IX+$0E ; The header checksum. ; 1 NCCUR IX+$0F ; The position of the last character taken from ; ; the buffer. ; 1 NCIBL IX+$10 ; The number of bytes in the input buffer. ; 255 NCB IX+$11 ; A 255 byte data buffer. ; ************************** ; ** THE RS232 ROUTINES ** ; ************************** ; ; --------------------------------------- ; THE '"T" CHANNEL INPUT SERVICE' ROUTINE ; --------------------------------------- ; The text channel input is limited to 7 bits so use the binary channel input ; and reset the most significant bit. TCHAN_IN CALL BCHAN_IN ; routine BCHAN-IN RES 7,A ; reset the MSB. RET ; Return. ; --------------------------------------- ; THE '"B" CHANNEL INPUT SERVICE' ROUTINE ; --------------------------------------- ; For serial input a two-byte buffer SER_FL is used. ; Sometimes 16 bits are received at a time so the second byte is stored ; here. BCHAN_IN LD HL,$5BBE ; Point to the SER_FL system variable. LD A,(HL) ; Fetch a byte. AND A ; Test for zero which signals no stored byte. JR Z,REC_BYTE ; Forward, if so, to REC-BYTE. LD (HL),$00 ; else signal taking the stored byte. INC HL ; Point to the stored byte. LD A,(HL) ; Load it to the accumulator. SCF ; Signal success by setting carry. RET ; Return. ; --- REC_BYTE CALL TEST_BRK ; Routine TEST-BRK tests the BREAK keys. DI ; Disable Interrupts LD A,($5BBD) ; Fetch I/O colour from IOBORD system variable. OUT ($FE),A ; Change the border to show activity. ; The value for LD DE,($5BBA) ; fetch value from BAUD system variable. LD HL,$0320 ; set counter to 800 decimal. LD B,D ; copy BAUD value LD C,E ; to BC register. SRL B ; 0 -> 76543210 -> C Halve the value RR C ; C -> 76543210 -> C LD A,$FE ; Make CTS (Clear To Send) high. OUT ($EF),A ; ; The other device, VTX modem, BBC computer, PC, Spectrum etc. will now send ; the data. READ_RS IN A,($F7) ; bit 7 is TXdata serial data RLCA ; rotate into carry. JR NC,TST_AGAIN ; forward to TST-AGAIN if TXdata low IN A,($F7) ; repeat the test 3 times RLCA ; JR NC,TST_AGAIN ; forward to TST-AGAIN IN A,($F7) ; RLCA ; JR NC,TST_AGAIN ; forward to TST-AGAIN IN A,($F7) ; RLCA ; JR C,START_BIT ; forward, if high for four tests, to START-BIT TST_AGAIN DEC HL ; decrement the 800 counter. LD A,H ; test for OR L ; zero. JR NZ,READ_RS ; back, if not, to READ-RS PUSH AF ; (*) Save the zero failure flag LD A,$EE ; make CTS (Clear To Send) line low. OUT ($EF),A ; JR WAIT_1 ; forward to WAIT-1 ; --- ; The branch was here when TXdata was high for 4 tests. START_BIT LD H,B ; Load HL with halved BAUD value. LD L,C ; LD B,$80 ; Load B with start bit. DEC HL ; reduce counter by the time for the 4 tests. DEC HL ; DEC HL ; SERIAL_IN ADD HL,DE ; Add the BAUD value. NOP ; (4) timing value. BD_DELAY DEC HL ; ( 6) Delay for 26 * BAUD LD A,H ; ( 4) OR L ; ( 4) JR NZ,BD_DELAY ; (12) back to BD-DELAY ADD A,$00 ; (7) wait IN A,($F7) ; Read a bit RLCA ; rotate bit 7 to carry. RR B ; pick up carry in B. JR NC,SERIAL_IN ; loop back, if no start bit, to SERIAL-IN ; After looping eight times, the start bit will pass through and B will ; contain a received byte. LD A,$EE ; Send CTS line low. OUT ($EF),A ; LD A,B ; transfer received byte to A. CPL ; complement. SCF ; signal success. PUSH AF ; (*) push success flag ; The success and failure (time out) paths converge here with HL holding zero. WAIT_1 ADD HL,DE ; transfer DE (BAUD) to HL. WAIT_2 DEC HL ; ( 6) Delay for stop bit. LD A,L ; ( 4) OR H ; ( 4) JR NZ,WAIT_2 ; (12/7) back to WAIT-2 ; Register HL is now zero. ADD HL,DE ; HL = 0 + BAUD ADD HL,DE ; HL = 2 * BAUD ADD HL,DE ; HL = 3 * BAUD ; The device at the other end of the cable may send a second byte even though ; CTS is low. T_FURTHER DEC HL ; decrement counter. LD A,L ; Test for OR H ; zero. JR Z,END_RS_IN ; forward, if no 2nd byte, to END-RS-IN IN A,($F7) ; Read TXdata. RLCA ; test bit. JR NC,T_FURTHER ; back, if none, to T-FURTHER ; As with first byte, TXdata must be high for four tests IN A,($F7) ; RLCA ; JR NC,T_FURTHER ; back to T-FURTHER IN A,($F7) ; RLCA ; JR NC,T_FURTHER ; back to T-FURTHER IN A,($F7) ; RLCA ; JR NC,T_FURTHER ; back to T-FURTHER ; A second byte is on its way and is received exactly as before. LD H,D ; LD L,E ; SRL H ; RR L ; LD B,$80 ; DEC HL ; DEC HL ; DEC HL ; SER_IN_2 ADD HL,DE ; NOP ; timing BD_DELAY2 DEC HL ; LD A,H ; OR L ; JR NZ,BD_DELAY2 ; back to BD-DELAY2 ADD A,$00 ; IN A,($F7) ; RLCA ; RR B ; JR NC,SER_IN_2 ; back to SER-IN-2 ; The start bit has been pushed out and B contains the second received byte. LD HL,$5BBE ; Address the SER_FL system variable. LD (HL),$01 ; signal there is a byte in next location INC HL ; address that location LD A,B ; transfer byte to A. CPL ; complement. LD (HL),A ; and insert in second byte of serial flag. END_RS_IN CALL BORD_REST ; routine BORD-REST restores the normal border. POP AF ; restore byte and flags ; (either 0 and NC or received byte and carry). ;;; EI ; Enable Interrupts RET ; Return. ; -------------------------------- ; THE '"T" CHANNEL OUTPUT' ROUTINE ; -------------------------------- ; The text channel output routine is able to list programs and, when printing, ; takes correct action with TAB values etc. I think. ; Note. The "t" channel can be tested on the RealSpec emulator as follows - ; 1) Assemble this file and note down addresses of BCHAN_IN and BCHAN_OUT ; 2) Select this ROM [F3] and serial interface [ALT F3] ; 3) Select output to a file. ; 3) Arrow down to bottom and supply IO addresses e.g. I 184E 19B0 ; 4) Session "t" channel output will appear in file SERIAL.BIN TCHAN_OUT CP $A5 ; Compare to 'RND' - first token JR C,NOT_TOKEN ; Forward, if less, to NOT-TOKEN SUB $A5 ; Reduce token to range $00-$5A JP PO_TOKENS ; Routine PO_TOKENS recursively prints tokens ;;; RET ; Return. ; --- NOT_TOKEN LD HL,$5B3B ; Address the FLAGS system variable. RES 0,(HL) ; update FLAGS - allow for leading space. CP $20 ; compare character to space JR NZ,NOT_LEAD ; forward, if not, to NOT-LEAD SET 0,(HL) ; update FLAGS - signal suppress leading space. ; The mosaic graphics and UDGs are output as '?' as also is (c) copyright. NOT_LEAD CP $7F ; compare to copyright symbol. (DEL in ASCII) JR C,NOT_GRAPH ; forward, if less, to NOT-GRAPH LD A,$3F ; Output CHR$(127) and graphics as '?' NOT_GRAPH CP $20 ; compare against space. JR C,CTRL_CODE ; forward, if less, to CTRL_CODE PUSH AF ; preserve character. INC (IY+$7D) ; increment width WIDTH_lo LD A,($5BB8) ; load A with limit WIDTH_hi CP (IY+$7D) ; compare to width WIDTH_lo JR NC,EMIT_CH ; forward, if width less or equal, to EMIT-CH CALL TAB_SETZ ; routine TAB-SETZ sets iy+$7D to zero and ; emits CR/LF. ;;; LD (IY+$7D),$01 ; set WIDTH_lo to one - for current character. INC (IY+$7D) ;+ set WIDTH_lo to one - for current character. EMIT_CH POP AF ; restore the unprinted character. JR BCH_OUT ; jump, indirectly, to BCHAN-OUT ; --- ; The branch was here with control codes. CTRL_CODE CP $0D ; is character a carriage return ? JR NZ,NOT_CR ; forward, if not, to NOT-CR TAB_SETZ LD (IY+$7D),$00 ; set width WIDTH_lo to zero. LD A,$0D ; output a CR carriage return. CALL BCHAN_OUT ; routine BCHAN-OUT LD A,$0A ; output a LF line feed. BCH_OUT JR BCHAN_OUT ; jump to BCHAN-OUT ; --- NOT_CR CP $06 ; is character a comma control ? JR NZ,NOT_COMMA ; forward, if not, to NOT_COMMA LD BC,($5BB7) ; load BC with width and limit from WIDTH LD E,$00 ; set the space counter to zero. SPC_COUNT INC E ; increment space counter. INC C ; increment width. LD A,C ; load A with width. CP B ; and compare to limit. JR Z,CMM_LP2 ; forward, if at limit, to CMM-LP2 CMM_LOOP SUB $08 ; subtract 8 - the tab stop. JR Z,CMM_LP2 ; forward, when zero, to CMM-LP2 JR NC,CMM_LOOP ; back, if higher than 8, to CMM-LOOP ; The result is less than zero so back to space count. JR SPC_COUNT ; back to SPC-COUNT ; The count in E is the spaces to advance to next multiple of eight. CMM_LP2 CALL PO_SV_SP ;+ ;;; PUSH DE ; save counter. ;;; LD A,$20 ; prepare a space. ;;; CALL TCHAN_OUT ; routine TCHAN-OUT outputs recursively. ;;; POP DE ; restore counter. DEC E ; decrement RET Z ; return when zero. JR CMM_LP2 ; loop back, if not, to CMM-LP2 ; --- NOT_COMMA CP $16 ; compare to twenty two ('AT') JR Z,TAB_PROC ; forward, if so, to TAB-PROC CP $17 ; compare to twenty three ('TAB') JR Z,TAB_PROC ; forward, also, to TAB-PROC CP $10 ; compare to sixteen (INK) RET C ; return if less. ; Now store code in TVDATA and alter the current channel to TAB_SERV2 LD DE,TAB_SERV2 ; Service routine for ink, paper etc. JR STORE_COD ; forward to STORE-COD ; --- TAB_PROC LD DE,TAB_SERV ; addr: TAB-SERV STORE_COD JP PO_TV_1 ; jump to similar code for tv output. ;;; STORE_COD LD ($5B0E),A ; store control code in TVDATA_lo ;;; ALTER_OUT LD HL,($5B51) ; Fetch current channel from CURCHL ;;; LD (HL),E ; Update the low byte of output address. ;;; INC HL ; ;;; LD (HL),D ; Now update the high byte. ;;; RET ; Return. ; ------------------------- ; THE 'TAB SERVICE ROUTINE' ; ------------------------- ; This deals with TAB and AT control codes. TAB_SERV LD DE,TAB_SERV2 ; addr: TAB-SERV2 JP PO_TV_3 ;+ use existing PO routine ;;; LD ($5B0F),A ; store second byte in TVDATA_hi ;;; JR ALTER_OUT ; back to ALTER-OUT ; --------------------------- ; THE 'TAB SERVICE 2' ROUTINE ; --------------------------- ; Once all the control sequence has been received this routine sorts them. TAB_SERV2 LD DE,TCHAN_OUT ; prepare normal address TCHAN-OUT CALL PO_CHANGE ;+ routine PO_CHANGE restores it. LD D,A ; save final character in D. LD A,($5B0E) ; fetch first character from TVDATA_lo CP $16 ; is it the AT control code ? JR Z,TST_WIDTH ; forward, with AT, to TST-WIDTH ???? CP $17 ; is it the TAB control code ? CCF ; if less, e.g. INK the carry is set so reset ; the carry for return condition. RET NZ ; return if INK - INVERSE and ignore. ; Continue with TAB. LD A,($5B0F) ; fetch low byte 0 - 255 from TVDATA_hi LD D,A ; and store in D, ignoring high byte. ; The TAB parameter, which is 16 bit is therefore taken mod 256 as only the ; low byte is used. For AT the column value is used and the line is ignored. TST_WIDTH LD A,($5BB8) ; fetch limit (max width, default 80) to A. CP D ; compare to column/tab value. JR Z,TAB_MOD ; forward, if a match, to TAB-MOD ??? JR NC,TABZERO ; forward if column less than limit to TABZERO ; The column/tab value is higher than the maximum width so calculate TAB_MOD LD B,A ; Transfer maximum width to B. LD A,D ; Transfer column/tab value to A. SUB B ; subtract a full line of characters. LD D,A ; and load result back to column/tab. JR TST_WIDTH ; loop back to TST-WIDTH ; --- ; The branch was here when the column/tab value was less than the width. TABZERO LD A,D ; Transfer column/tab to A. OR A ; Test for zero. JR Z,TAB_SETZ ; Back, if so, to TAB-SETZ ; to output a carriage return and linefeed. TABLOOP LD A,($5BB7) ; Fetch current print position from WIDTH_lo CP D ; Compare to column/tab value. RET Z ; Return when positions equal. >> CALL PO_SV_SP ;+ ;;; PUSH DE ; Preserve the column/tab value. ;;; LD A,$20 ; Prepare a space. ;;; CALL TCHAN_OUT ; Routine TCHAN-OUT outputs a space. ;;; POP DE ; Restore the column/tab value. JR TABLOOP ; Back to TABLOOP ; -------------------------------- ; THE '"B" CHANNEL OUTPUT' ROUTINE ; -------------------------------- ; The bits of a byte are sent inverted. They are fixed in length and heralded ; by a start bit and followed by two stop bits. BCHAN_OUT LD B,$0B ; Set bit count to eleven - 1 + 8 + 2. CPL ; Invert the bits in the character. LD C,A ; Copy character to C. LD A,($5BBD) ; select I/O border colour from IOBORD OUT ($FE),A ; change the border colour. LD A,$EF ; 11101111 OUT ($EF),A ; Make CTS (Clear To Send) low. CPL ; reset bit 0, 00010000 OUT ($F7),A ; Make RXdata low LD HL,($5BBA) ; fetch value from BAUD system variable LD D,H ; Copy to DE. LD E,L ; BD_DEL_1 DEC DE ; ( 6) Wait 26 * BAUD cycles. LD A,D ; ( 4) OR E ; ( 4) JR NZ,BD_DEL_1 ; (12) back to BD-DEL-1 TEST_DTR CALL TEST_BRK ; routine TEST-BRK allows user to stop. IN A,($EF) ; Read the communication port. AND $08 ; isolate DTR (Data Terminal Ready) bit. JR Z,TEST_DTR ; back, until DTR found high, to TEST-DTR SCF ; Set carry flag as start bit. DI ; Disable Interrupts. ; The bit sending loop. SER_OUT_L ADC A,$00 ; 76543210 <- C OUT ($F7),A ; Send rxdata, start bit LD D,H ; transfer BAUD to DE. LD E,L ; BD_DEL_2 DEC DE ; ( 6) Wait for 26 * BAUD LD A,D ; ( 4) OR E ; ( 4) JR NZ,BD_DEL_2 ; (12) back to BD-DEL-2 DEC DE ; (6) XOR A ; clear rxdata bit SRL C ; shift a bit of output byte to carry. DJNZ SER_OUT_L ; back for 11 bits to SER-OUT-L ; Note. the last two bits will have been sent reset as C is exhausted. ;;; EI ; Enable Interrupts. ;;; LD A,$01 ; set rxdata bit (inc a) INC A ; set rxdata bit. LD C,$EF ; prepare port address. LD B,$EE ; prepare mask %11101110 OUT ($F7),A ; Send rxdata high. OUT (C),B ; Send CTS and comms data low - switch off RS232. BD_DEL_3 DEC HL ; ( 6) The final 26 * BAUD delay. LD A,L ; ( 4) OR H ; ( 4) JR NZ,BD_DEL_3 ; (12) back to BD-DEL-3 ; ------------------------------- ; THE 'BORDER RESTORE' SUBROUTINE ; ------------------------------- ; This routine could also be used by the tape routines ; It restores the border colour to normal after it has been altered to show ; communication activity. Since interrupts are usually enabled at the same ; time, that instruction has been incorporated here to conserve ROM space. BORD_REST PUSH AF ; Preserve accumulator throughout. LD A,($5B48) ; 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. POP AF ; Restore flags. EI ;+ Enable Interrupts. RET ; Return. ; --------------------------- ; THE 'TEST BREAK' SUBROUTINE ; --------------------------- ; Note. this could also be called at statement return STMT_RET. TEST_BRK CALL BREAK_KEY ; Call the standard ROM routine. RET C ; return if BREAK not pressed. CALL BORD_REST ; else restore the border colour to normal. REPORT_Lb RST 30H ; ERROR-1 DEFB $14 ; Error Report: BREAK into program ; ************************** ; ** THE NETWORK ROUTINES ** ; ************************** ; "Spectrum" is the Latin word for a rainbow. ; "Iris" is the Greek word for a rainbow. ; By convention, "Spectrum" refers to this computer and "Iris" refers to the ; other computer which could be a ZX Spectrum or Sinclair QL. ; While Sinclair Research were secretive about the microdrive internals, ; there were no such restrictions on the Sinclair Network which remains an ; open standard. It was also adopted by the Disciple Disk Interface. ; "Indeed the linking of one microcomputer to another should be encouraged ; and the establishment of a Sinclair Network Standard may prove an ; important step forward" ; - Dr. Ian Logan, Interface 1 ROM co-author, 1983. ; --------------------------------------- ; THE '"N" CHANNEL INPUT SERVICE' ROUTINE ; --------------------------------------- ; The address of this network input service routine is contained in the ; channel information area and accessed by the INPUT_AD routine when the ; current channel has been made the "N" channel. ; The routine inputs a single byte from the network and if the 255-byte ; network buffer is empty, this may involve receiving a packet from the ; network. NCHAN_IN LD IX,($5B51) ; Set index register from system variable CURCHL LD A,(IX+$0C) ; Fetch number of output buffer bytes from NCOBL ; This should be zero when reading. AND A ; Test for zero. JR Z,TEST_BUFF ; Forward, if so, to TEST-BUFF. RST 30H ; ERROR-1 DEFB $1D ; 'Net R/W error' ; Should be - ; 'Reading a 'write' file' 22 chars ; --- TEST_BUFF LD A,(IX+$10) ; Fetch number of input buffer bytes from NCIBL AND A ; test for zero. JR Z,TST_N_EOF ; forward, if so, to TST-N-EOF LD E,(IX+$0F) ; Fetch position of last character taken NCCUR DEC A ; Decrement the total count. SUB E ; Subtract the taken count - will set the carry ; flag if at end. JR C,TST_N_EOF ; Forward, if so, to TST-N-EOF LD D,$00 ; Prepare to index. INC E ; Increment the position LD (IX+$0F),E ; and update the channel variable NCCUR. ADD IX,DE ; Index into the buffer at that position. LD A,(IX+$10) ; Read the byte from the buffer. SCF ; Signal success. RET ; Return. ; --- TST_N_EOF LD A,(IX+$0B) ; Fetch packet type from NCTYPE - 0 data, 1 EOF. AND A ; Test for data. JR Z,GET_N_BUF ; Forward, if so, to GET-N-BUF -> ; Note. Iris has closed her channel. RET ; Return (NC and NZ) ; Note. causes error 'End of file' ; --- ; -> GET_N_BUF LD A,($5BBD) ; fetch I/O border colour from IOBORD OUT ($FE),A ; and change the colour to show activity. DI ; Disable Interrupts. TRY_AGAIN CALL WT_SCOUT ; routine WT-SCOUT waits for the scout leader. JR NC,TIME_OUT ; forward, if none, to TIME-OUT CALL GET_NBLK ; routine GET-NBLK gets the header and data. JR NZ,TIME_OUT ; forward, if error, to TIME-OUT ;;; EI ; Enable Interrupts CALL BORD_REST ; routine BORD-REST restores the border. LD (IX+$0F),$00 ; Set cursor position NCCUR to zero. LD A,($5BC5) ; Fetch header type code from NTTYPE - data/EOF. LD (IX+$0B),A ; update the channel variable NCTYPE JR TEST_BUFF ; back to TEST-BUFF to read the first byte. ; --- ;;; TIME_OUT LD A,(IX+$07) ; Fetch the destination station number NCIRIS ;;; AND A ; test for zero - a broadcast. TIME_OUT CALL TST_BR ;+ New routine to test for a broadcast. JR Z,TRY_AGAIN ; back, if a broadcast, to TRY-AGAIN ; Note. a broadcast will not time out. JR BORD_REST ; back to exit via BORD_REST restoring border. ;;; EI ; enable interrupts ;;; CALL BORD_REST ; routine BORD-REST restores border preserving ;;; ; the AF registers and enabling interrupts. ;;; AND $00 ; signal failure. (NZ NC already set) ;;; RET ; Return. ; -------------------------------- ; THE '"N" CHANNEL OUTPUT' ROUTINE ; -------------------------------- ; The address of this network output service routine is contained in the ; channel information area and accessed by the RST 10H output restart ; routine when the current channel has been made the "N" channel. ; The routine outputs a single byte to the network and if the 255-byte ; network buffer is full, this may involve sending a packet to the ; network. NCHAN_OUT LD IX,($5B51) ; Set index register from system variable CURCHL LD B,A ; Copy the character to B. LD A,(IX+$10) ; Fetch number of input buffer bytes from NCIBL ; should be zero if channel is used for writing. AND A ; test for zero bytes. LD A,B ; bring the character back. JR Z,TEST_OUT ; forward, if zero bytes, to TEST-OUT RST 30H ; ERROR-1 DEFB $1D ; 'Net R/W error' ; Should be - ; 'Writing to a 'read' file' 24 chars ; --- TEST_OUT LD E,(IX+$0C) ; fetch number of output buffer bytes from NCOBL INC E ; increment the count. 1-255 JR NZ,ST_BF_LEN ; forward, if not full, to ST-BF-LEN ; The buffer is full and must be sent to the network. PUSH AF ; preserve character yet to be output XOR A ; Set A to 0 to signal data and not EOF. CALL S_PACK_1 ; routine S-PACK-1 sends the 255-byte buffer. ; The character can now be placed in the empty buffer at position 1. POP AF ; restore the output character. LD E,$01 ; set buffer position to 1. ST_BF_LEN LD (IX+$0C),E ; Update the byte count channel variable NCOBL LD D,$00 ; Prepare to index. ADD IX,DE ; Index into the network buffer. LD (IX+$10),A ; and store the byte at the offset. RET ; Return. ; ---------------------------- ; THE NEW 'NETWORK CR' ROUTINE ; ---------------------------- ; This routine is an extra check after outputting a carriage return. CR_END CALL IN_CHAN_K ;+ routine fetches the current channel letter. CP 'N' ;+ Is it the network. RET NZ ;+ Return if not. ; -------------------------------------- ; THE 'SEND CR BLOCK TO NETWORK' ROUTINE ; -------------------------------------- ; This should be sent as part of PRINT_CR to flush. SEND_NCR LD C,$00 ; a data block signal. JR SEND_END ; forward to send the packet. ; --------------------------------------- ; THE 'SEND EOF BLOCK TO NETWORK' ROUTINE ; --------------------------------------- ; This should be sent as part of CLOSE to flush. SEND_NEOF LD C,$01 ;+ An EOF signal SEND_END LD IX,($5B51) ; Set IX to current channel from CURCHL LD A,(IX+$0C) ; Load A from NCOBL the number of characters in ; the output buffer. AND A ; Test for zero. RET Z ; Return with zero. LD A,C ; Signal an EOF packet if 1. ; ---------------------- ; THE 'S-PACK-1' ROUTINE ; ---------------------- ; S_PACK_1 CALL SEND_PACK ; routine SEND-PACK sends a packet RET NZ ; Return if not a broadcast. ; ----------------------------- ; THE 'BROADCAST DELAY' ROUTINE ; ----------------------------- ; This routine ensures that there is a gap between packets when broadcasting. BR_DELAY LD DE,$1500 ; Set a delay counter. DL_LOOP DEC DE ; decrement. LD A,E ; Test for zero. OR D ; JR NZ,DL_LOOP ; back, if not, to DL-LOOP RET ; Return. ; ----------------------- ; THE 'SEND-PACK' ROUTINE ; ----------------------- ; This routine checksums, and then outputs to the network, an 8-byte ; header and a corresponding data block. SEND_PACK LD (IX+$0B),A ; Update the channel variable NCTYPE with the ; packet type - 0 data, 1 EOF. LD B,(IX+$0C) ; Load counter with number of output characters ; from NCOBL channel variable. LD A,($5BBD) ; Fetch I/O border colour from IOBORD OUT ($FE),A ; Change border to show communication activity. PUSH IX ; Transfer the channel base address POP DE ; to the DE register pair. LD HL,$0011 ; prepare the offset seventeen. ADD HL,DE ; and add to point to the first data byte. ;;; XOR A ; Initialize the data checksum to zero. ;;; CHKS1 ADD A,(HL) ; add a data byte. ;;; INC HL ; increment buffer pointer. ;;; DJNZ CHKS1 ; back, for count of characters, to CHKS1 CALL CHKS0 ;+ New general purpose checksum routine. LD (IX+$0D),A ; insert the checksum in NCDCS channel variable. LD HL,$0007 ; prepare the offset seven ADD HL,DE ; and add to address NCIRIS first header byte. PUSH HL ; (*)save the header pointer. ;;; LD B,$07 ; Set byte counter to seven. ;;; XOR A ; Initialize the header checksum to zero. ;;; CHKS2 ADD A,(HL) ; add the addressed byte. ;;; INC HL ; increment the pointer. ;;; DJNZ CHKS2 ; loop back to CHKS2 CALL CHKS7 ; routine checksums seven bytes LD (HL),A ; insert the checksum into NCHCS channel var. DI ; Disable Interrupts SENDSCOUT CALL SEND_SC ; routine SEND-SC POP HL ; (*) restore the header pointer - NCIRIS. PUSH HL ; (*) and preserve again. LD E,$08 ; There are eight bytes in a network header. CALL OUT_BLK_N ; routine OUT-BLK-N sends HEADER and receives ; the response code. JR NZ,SENDSCOUT ; back, with no response, to SENDSCOUT PUSH IX ; transfer base address of channel POP HL ; to the HL register. LD DE,$0011 ; prepare an offset of seventeen. ADD HL,DE ; add to address the first byte of buffer data. LD E,(IX+$0C) ; Fetch count of output characters from NCOBL LD A,E ; copy value to A. AND A ; test for zero. JR Z,INC_BLKN ; forward, if zero, to INC-BLKN LD B,$20 ; Set a delay value for a gap between the ; physical 8-byte header and data. SP_DL_1 DJNZ SP_DL_1 ; self loop to SP-DL-1 CALL OUT_BLK_N ; routine OUT-BLK-N sends the DATA and receives ; the response byte. JR NZ,SENDSCOUT ; back, with no response, to SENDSCOUT ;;; INC_BLKN INC (IX+$09) ; increment the channel variable NCNUMB_lo ;;; JR NZ,SP_N_END ; forward, if not '256' to SP-N-END ;;; INC (IX+$0A) ; increment the channel variable NCNUMB_hi INC_BLKN CALL SUBINC ;+ an existing subroutine that does above. SP_N_END POP HL ; (*) restore the pointer to NCIRIS CALL BORD_REST ; routine BORD-REST restores border. ;;; EI ; enable interrupts. LD (IX+$0C),0 ;+++ SET the number of output bytes to zero. TST_BR LD A,(IX+$07) ; fetch station of other machine from NCIRIS AND A ; test for zero - a broadcast. RET ; Return - with zero flag set for broadcast. ; ----------------------- ; THE 'OUT-BLK-N' ROUTINE ; ----------------------- ; This routine sends a single block of data, which could be a header or ; buffer block, and validates the response from IRIS. OUT_BLK_N CALL OUTPAK ; routine OUTPAK sends the data block returning ; with DE holding zero. ;;; LD A,(IX+$07) ; fetch the other station number from NCIRIS ;;; AND A ; test for zero. CALL TST_BR ;+ New routine to test for a broadcast. RET Z ; Return if a broadcast, no response required. LD HL,$5BC0 ; Make HL address system variable NTRESP ;;; LD (HL),$00 ; and insert a zero. ;;; LD E,$01 ; set byte count to 1. LD (HL),E ;+ and insert a zero. INC E ;+ set byte count to 1. CALL INPAK ; routine INPAK reads one byte from network. RET NZ ; return, signaling failure, if no activity. LD A,($5BC0) ; Fetch updated value of NTRESP. DEC A ; test for $01. RET ; Return, with zero flag set for success. ; --------------------------------------------- ; THE 'HEADER AND DATA BLOCK RECEIVING' ROUTINE ; --------------------------------------------- ; This subroutine is called once from NCHAN_IN to read in the next header ; and data block from the network, when the buffer is empty. ; An eight byte header is sent from the network channel of the sending ; computer but received into eight system variables. GET_NBLK LD HL,$5BC1 ; Address system variable NTDEST LD E,$08 ; Set byte count to eight. CALL INPAK ; Routine INPAK reads in a header. RET NZ ; Return, signaling failure, if inactive. ;;; LD HL,$5BC1 ; Address system variable NTDEST again. LD L,$C1 ;+ Address system variable NTDEST again ;;; XOR A ; Initialize checksum to zero. ;;; LD B,$07 ; Set byte count to seven. ;;; CHKS3 ADD A,(HL) ; Add the addressed byte. ;;; INC HL ; Point to next header byte. ;;; DJNZ CHKS3 ; Back, for all seven bytes, to CHKS3 ;;; CP (HL) ; Compare with eighth byte. CALL CHKS7 ; routine to checksum seven bytes. RET NZ ; Return if checksum disagrees. ; The header has been successfully received and it can be examined to see ; what type of data this is. ;;; LD A,($5BC1) ; Fetch the value of NTDEST the received sysvar LD L,$C1 ;+ Set HL to NTDEST the received system variable LD A,(HL) ;+ Fetch value to A. INC L ;+ Set HL to $5BC2 NTSRCE before branching. AND A ; test for zero. JR Z,BRCAST ; forward, if so, to BRCAST CP (IX+$08) ; Compare the destination with NCSELF - this ; station's number. RET NZ ; Return if data not intended for this Spectrum. ; The header indicates the data is for SELF. ;;; LD A,($5BC2) ; Fetch value of received system variable NTSRCE ;;; ; the sending station. LD A,(HL) ;+ Fetch the sender from $5BCF NTSRC. CP (IX+$07) ; Compare to channel variable NCIRIS. RET NZ ; Return if not the expected sender. ; The header indicates that both the sender and recipient (SELF) are correct. JR TEST_BLKN ; Forward to TEST-BLKN ; --- ; The branch was here when the header indicated a broadcast. BRCAST ;;; LD A,(IX+$07) ; Check the station number of NCIRIS. ;;; OR A ; Test for zero - a broadcast. CALL TST_BR ;+ New routine to test for a broadcast. RET NZ ; Return, with failure, if not. ; The two paths converge here. TEST_BLKN LD HL,($5BC3) ; Fetch, from received system variable NTNUMB, ; the number of the block. LD E,(IX+$09) ; Fetch bytes of expected block NCNUMB_lo and LD D,(IX+$0A) ; NCNUMB_hi, to DE, from channel variables. AND A ; prepare for true subtraction. SBC HL,DE ; subtract the two block numbers. JR Z,GET_NBUFF ; forward, if they match, to GET-NBUFF DEC HL ; Decrement HL in case the previously received LD A,H ; block is being resent because the sender OR L ; missed our response byte. RET NZ ; Return if this is not the previous block. CALL GET_NBUFF ; Routine GET-NBUFF gets the buffer data and ; resends the response byte also incrementing ; the block count. ; Note. the next check is new. RET NZ ;+ Return if, say, the checksum disagrees the ;+ second time around. ; Cancel the increment and return failure so that we try for the expected ; data again. ; Note. The DEC instruction does not affect the carry flag! LD A,(IX+$09) ;+ Fetch copy of NCNUMB_lo to accumulator. DEC (IX+$09) ; decrement actual NCNUMB_lo AND A ;+ Was it originally zero? ;;; JR NC,GETNB_END ; Forward, if not 255, to GETNB-END JR NZ,GETNB_END ;+ Forward, if not now 255, to GETNB-END DEC (IX+$0A) ; Decrement NCNUMB_hi GETNB_END OR $01 ; Reset the zero flag signaling failure to ; the calling routine. RET ; Return. ; --- ; The branch was here to read the data into the network buffer. ; First send a response byte for the header if this is not a broadcast. GET_NBUFF CALL SEND_RESP ; routine sends response byte if not a broadcast LD A,($5BC6) ; Fetch received system variable NTLEN AND A ; test for zero. JR Z,STORE_LEN ; forward, if empty, to STORE-LEN PUSH IX ; transfer channel base address to POP HL ; the HL register. LD DE,$0011 ; prepare an offset of seventeen. ADD HL,DE ; and add to address start of the data buffer. PUSH HL ; (*) Preserve the start of network buffer. LD E,A ; Transfer block length to E, value 1-255. CALL INPAK ; routine INPAK reads in the data. LD HL,($5BC6) ;+ load two system variables NTLEN/NTDCS at once. LD B,L ;+ count of bytes NTLEN to B. LD E,H ;+ checksum NTDCS to E. POP HL ; (*) Restore start of buffer. RET NZ ; Return failure if network was inactive. ;;; LD A,($5BC6) ; Fetch count of data bytes from sysvar NTLEN ;;; LD B,A ; transfer to B. (Beyond reach of IY) ;;; LD A,($5BC7) ; Fetch network data checksum from NTDCS ;;; The checksum is verified in the opposite way in which it was derived. ;;; CHKS4 SUB (HL) ; Subtract the addressed value. ;;; INC HL ; Increment data pointer. ;;; DJNZ CHKS4 ; Back, for all bytes, to CHKS4 CALL CHKS0 ;+ general purpose checksum adding routine. CP E ;+ compare with expected. RET NZ ; Return failure if result does not agree. ;;; LD A,($5BC1) ; Fetch station from system variable NTDEST ;;; AND A ; Check for zero - a broadcast CALL SEND_RESP ; routine SEND-RESP sends response for data ; if not a broadcast. STORE_LEN LD A,($5BC6) ; Fetch the verified length from sysvar NTLEN LD (IX+$10),A ; and insert value in channel variable NCIBL. ; Note the next could be a once-called subroutine to increment NCNUMB. SUBINC INC (IX+$09) ; Increment NCNUMB_lo JR NZ,GETBF_END ; Forward, if no wraparound, to GETBF-END INC (IX+$0A) ; Increment the high byte NCNUMB_hi GETBF_END CP A ; Set the zero flag. RET ; Return with zero flag set indicating success. ; ----------------------- ; THE NEW 'CHECKSUM' ROUTINES ; ----------------------- ; This routine saves just a few bytes by making a subroutine of repetitive ; code. It checksums the header or buffer data. The header data is always ; seven bytes in length. The second entry point is used for the variable ; length buffer data. CHKS7 LD B,$07 ; 7 header bytes to check. CHKS0 XOR A ; Initialize checksum. CHKSL ADD A,(HL) ; Add a byte. INC HL ; Address next. DJNZ CHKSL ; loop back for B bytes. CP (HL) ; compare with final value which could be sum RET ; return. ; --------------------------- ; THE 'NETWORK STATE' ROUTINE ; --------------------------- ; This routine waits for the network to become inactive so that it may be ; claimed by this SPECTRUM. So that two waiting Spectrums do not claim the ; network at the same time a random count is used. NET_STATE LD A,R ; Fetch a random 7-bit value from the Refresh ; register OR $C0 ; OR with %11000000 giving range 192 - 255. LD B,A ; transfer to B for count. CALL CHK_REST ; routine CHK-REST JR C,NET_STATE ; back to NET-STATE if network is busy. RET ; return. ; --------------------------- ; THE 'CHECK-RESTING' ROUTINE ; --------------------------- ; This subroutine checks that the network is inactive for a period ; determined by the B register which will $80 if called from below or a ; random value if called from the above routine. CHK_REST CALL TEST_BRK ; routine TEST-BRK will return here if BREAK is ; not pressed. MAKESURE PUSH BC ; timing POP BC ; timing IN A,($F7) ; Read the network port RRCA ; Test bit 0. RET C ; Return if network is claimed by other ; machines. DJNZ MAKESURE ; back to MAKESURE for a random count. RET ; Return. ; ------------------------ ; THE 'WAIT SCOUT' ROUTINE ; ------------------------ ; This routine is called once from NCHAN_IN to identify a SCOUT when this ; station is expecting to receive a network packet. WT_SCOUT CALL TEST_BRK ; routine TEST-BRK allows user to abort. LD HL,$01C2 ; An even timing value. CLAIMED LD B,$80 ; The non-random count for CHK REST CALL CHK_REST ; routine CHK-REST JR NC,WT_SYNC ; forward, if network resting, to WT-SYNC DEC HL ; decrement counter DEC HL ; decrement counter LD A,H ; Test for OR L ; zero. JR NZ,CLAIMED ; back, if not, to CLAIMED ; If operation has timed out, then return failure unless expecting a ; broadcast in which case the subroutine waits indefinitely. ;;; LD A,(IX+$07) ; fetch value of channel variable NCIRIS ;;; AND A ; test for broadcast. CALL TST_BR ;+ test for a broadcast JR Z,CLAIMED ; back, if so, to CLAIMED RET ; Return signaling failure. ; --- ; The branch was here when the network was found to be at rest. WT_SYNC IN A,($F7) ; read the port. RRCA ; rotate 'net input' to carry. JR C,SCOUT_END ; forward, if scout found, to SCOUT-END -> ; This is a clever twist. LD A,$7F ; Read port $7FFE the row with SPACE IN A,($FE) ; OR $FE ; Now read port $FEFE the row with SHIFT IN A,($FE) ; RRA ; If both SHIFT and SPACE then carry is reset. CALL NC,TEST_BRK ; routine TEST-BRK errors if BREAK was pressed. DEC HL ; decrement the counter. LD A,H ; Test for OR L ; zero. JR NZ,WT_SYNC ; back, if not, to WT-SYNC ;;; LD A,(IX+$07) ; load station number from NCIRIS ;;; AND A ; test for a broadcast. CALL TST_BR ;+ New routine to test for a broadcast. JR Z,WT_SYNC ; back, if zero, to WT-SYNC RET ; Return failure - NZ ; ---------------------- ; THE 'SCOUT END' BRANCH ; ---------------------- ; The scout is only read by the machine that sent it and as long as it can ; be read back then the sending machine is happy. This receiving machine ; uses the scout leader to synchronize its timing. SCOUT_END LD L,$09 ; set outer counter for 9 bits. LP_SCOUT DEC L ; ( 4) decrement counter. SCF ; ( 4) set success condition RET Z ; ( ) RETURN after nine bits have been timed. LD B,$0E ; An inner delay counter. DELAY_SC DJNZ DELAY_SC ; self loop to DELAY-SC JR LP_SCOUT ; loop back to LP-SCOUT ; ------------------------------------------------------------------------- ; ; Illustration: Network Station '10' sending its SCOUT. ; ; <-- values of the eight bits --> ; ; active '0' '0' '0' '0' '1' '0' '1' '0' active ; - - - - - - +---+---+---+---+---+ +---+ +---+ - - - - - - - - - - - - ; | | | | | | | | | | ; | | | | | | ; | 7 6 5 4 | 3 | 2 | 1 | 0 | ; | | | | | | ; | | | | | | ; inactive | | | | | | | | | | inactive ; ------------+ + + + + +---+ +---+ +------------------------ ; ; ^ ^ ^ <---><-------------- ------------->^ ; resting ? \/ \/ | ; send send 8 bits of the | ; SCOUT global station number Network claimed. ; leader ; ; ------------------------ ; THE 'SEND SCOUT' ROUTINE ; ------------------------ ; In order to claim the network for writing, the SPECTRUM sends out a leader ; followed by the eight inverted bits of the global station number which ; should be unique to each machine. SEND_SC CALL NET_STATE ; routine NET-STATE repeatedly examines the ; network until it is satisfied that the ; network is at rest. LD C,$F7 ; The comms port number. LD HL,$0009 ; H is the leader value, L is the count of ; the SCOUT bits. LD A,($5BBC) ; Fetch the global station number from NTSTAT LD E,A ; Transfer to E. IN A,($F7) ; Test that the network is still inactive. RRCA ; rotate 'net input' to carry. JR C,SEND_SC ; back, if network has become active, to SEND-SC ; Now output the nine values starting with the zero leader in H. ALL_BITS OUT (C),H ; output bit 0 'net output' LD D,H ; ( 4) copy state to D for later. LD H,$00 ; set output byte to zero. RLC E ; rotate a bit from 'global station' to carry. RL H ; pick it up in bit 0. LD B,$08 ; set timing counter S_SC_DEL DJNZ S_SC_DEL ; self loop back to S-SC-DEL IN A,($F7) ; read the network. AND $01 ; isolate the 'net input' bit. ; Note. network is activated with a zero bit. ; Received bit is therefore opposite state. CP D ; compare with expected state. JR Z,SEND_SC ; back, if not inverted, to SEND-SC ; to start process again. DEC L ; decrement the bit counter. JR NZ,ALL_BITS ; back, if SCOUT not complete, to ALL-BITS LD A,$01 ;; set the output bit. OUT ($F7),A ;; Make the network inactive. LD B,$0E ; Wait for a delay END_S_DEL DJNZ END_S_DEL ; self loop to END-S-DEL RET ; Return. ; ------------------- ; THE 'INPAK' ROUTINE ; ------------------- ; This routine reads into the network buffer at address HL a pack of bytes ; the count of which is in E. ; The value of E will be - ; a) 1 when reading the Network Response byte. ; b) 8 when reading an eight-byte header into the system variables. ; c) The value of NTLEN, from within the above header, when reading data. INPAK LD B,$FF ; Set a time-out counter. N_ACTIVE IN A,($F7) ; Read the network port. RRA ; rotate 'net input' bit to carry. JR C,INPAK_2 ; forward, if set, to INPAK-2 DJNZ N_ACTIVE ; loop back, 255 times, to N-ACTIVE INC B ; Indicate network inactive by resetting zero. RET ; Return. (NZ) ; --- INPAK_2 LD B,E ; Set B to count the number of bytes. ; The byte reading loop. INPAK_L LD E,$80 ; prepare a receiving byte with a marker bit. LD A,$CE ; Make A %11001110 (wait,cts and comms data low) OUT ($EF),A ; Enable the network. NOP ; ( 4) Wait 48 clock cycles. NOP ; ( 4) INC IX ; (10) DEC IX ; (10) INC IX ; (10) DEC IX ; (10) UNTIL_MK LD A,$00 ; ( 7) Timing. IN A,($F7) ; (10) Read net input to bit 0. RRA ; ( 4) rotate to carry. RR E ; ( 8) and pick up in E. JP NC,UNTIL_MK ; (10) JUMP, back if no marker bit, to UNTIL-MK LD (HL),E ; store the received byte. INC HL ; Address next location. DJNZ INPAK_L ; back to INPAK-L CP A ; Set zero flag to signal success. RET ; Return. ; -------------------------------- ; THE 'SEND RESPONSE BYTE' ROUTINE ; -------------------------------- ; When a header or a data block is successfully received then this routine is ; used to send a response byte to acknowledge the successful receipt of the ; data over the network. SEND_RESP LD HL,$5BC1 ; Address station number NTDEST XOR A ; set accumulator to zero CP (HL) ; compare with NTDEST RET Z ; return if a broadcast. DEC HL ; Address $5BC0 NTRESP LD E,$01 ; Load 1 to the byte count. LD (HL),E ; Insert the value 1 ; -------------------- ; THE 'OUTPAK' ROUTINE ; -------------------- ; This routine sends a packet of bytes, up to 255 in length, over the network. ; The start of the data is in HL and the number of bytes is held in E. OUTPAK XOR A ; clear bit 0 OUT ($F7),A ; send leader to port. LD B,$04 ; ( 4) set timing value. DEL_0_1 DJNZ DEL_0_1 ; (12/7) back to DEL-0-1 for leader of ; Now enter a loop to send E bytes each with a set start bit and a reset ; stop bit. OUTPAK_L LD A,(HL) ; ( 6) Fetch a byte to be sent. CPL ; ( 4) complement. SCF ; ( 4) Set an initial start bit RLA ; ( 4) C <- 76543210 <- C LD B,$0A ; ( 6) Set count to ten bits UNT_MARK OUT ($F7),A ; Output bit 0, to net. RRA ; C -> 76543210 -> C ; Rotate next bit to ; ; bit 0. AND A ; clear carry flag to feed in final stop bit. DEC B ; decrement bit counter. LD D,$00 ; ( 7) timing JP NZ,UNT_MARK ; JUMP back for 10 bits to UNT-MARK ; The last bit sent will be a reset stop bit. INC HL ; increment buffer address DEC E ; decrement the byte count. PUSH HL ; (11) timing. POP HL ; (11) timing. JP NZ,OUTPAK_L ; JUMP, if E not zero, to OUTPAK-L LD A,$01 ; switch off network. OUT ($F7),A ; RET ; Return. ; -------------------- ; THE 'FORMAT' COMMAND ; -------------------- ; by James Smith. ; This sets the local network station number which defaulted to 1 at ; switch-on. It can also be used to set the baud rate and printer width. ; FORMAT "n",2 set this station to station 2 ( acceptable range 1 - 64 ). ; FORMAT "b",1200 set baud rate for "b" and "t" RS232 transfers. ; FORMAT "t",80 set printer width of the "t" channel. ; ; This is a CLASS-00 command so it is only executed in runtime when the two ; parameters will be on the calculator stack. FORMAT CALL FIND_INT2 ; routine FIND-INT2 gets number to BC PUSH BC ; save on machine stack. CALL EXPT_SPEC ; gets channel specifier in A AND $DF ; Make it upper-case. POP BC ; retrieve numeric parameter. CP 'B' ; channel "B" BAUD rate ? JR Z,FORMAT_B ; forward, if so, to FORMAT_B ; After the 16 bit BAUD rate, only 8-bit values are allowed for width/station. INC B ; Test the high-order DEC B ; byte for zero. JP NZ,REPORT_B ; ERROR ; 'Integer out of range' CP 'T' ; Text width ? JP Z,FORMAT_T ; jump back, if so, to FORMAT_T CP 'N' ; Network ? JP NZ,REPORT_C ; back, if unknown letter, to report XXXXX ; 'Nonsense in BASIC' FORMAT_N LD A,C ; number should be 1-64 DEC A ; CP $40 ; compare to 64 JP NC,REPORT_Q ; INC A ; correct for earlier DEC LD ($5BBC),A ; set NTSTAT RET ; Return. ; --- ; Note. these 5 bytes fave been moved to space between restarts. (JS) ; FORMAT_T LD A,C ; get TAB width ; LD ($5BB8),A ; set it ; RET ; Return. ; --------------------------- ; THE 'SET BAUD RATE' ROUTINE ; --------------------------- ; by James Smith. ; The BAUD rate is calculated as follows: ; BAUD = (3500000/(26*baud rate)) - 2 ; FORMAT_B CALL STACK_BC ; put value on calculator stack. RST 28H ; FP-CALC DEFB $34 ;;stk-data DEFB $35 ;;Exponent $85, Bytes:1 constant = 26 DEFB $50 ;;$50 ($00,$00,$00) DEFB $04 ;;multiply DEFB $34 ;;stk-data DEFB $80 ;;Exponent $96, Bytes: 3 constant = 3500000 DEFB $46,$55,$9F,$80 ;;($55,$9F,$80,$00) DEFB $01 ;;exchange DEFB $05 ;;divide DEFB $38 ;;end-calc CALL FP_TO_BC ; get delay into BC DEC BC ; subtract value DEC BC ; two. LD ($5BBA),BC ; set BAUD system variable RET ; Return. ; ---------------------------------- ; THE NEW 'CHANNEL SPECIFIER' SUBROUTINE ; ---------------------------------- ; 10 bytes. ; This subroutine checks for a single character ALPHA. ; It is also now used by the usr_$ function to exploit similarities in ; the functional specification. EXPT_SPEC CALL STK_FETCH ; routine STK-FETCH to fetch and delete the ; string parameters. ; DE points to the start, BC holds the length. LD A,C ; DEC A ; OR B ; LD A,(DE) ; fetch character RET Z ; return with single character. REPORT_Ae RST 30H ; ERROR-1 DEFB $09 ; 'Invalid argument' ; ----------------- ; THE 'CAT' COMMAND ; ----------------- ; This CAT command lists the streams to the screen and really grows on you. ; It was inspired by Andrew Pennell's "Stream Lister" which appears in the ; book "master your zx microdrive" published by Melbourne House. CAT CALL CL_ALL ; clear 24 lines and leave upper screen open. LD DE,CAT1 ; Point to start of banner text. LD BC,CAT2-CAT1 ; Set the length. CALL PR_STRING ; routine PR_STRING outputs counted string. LD BC,45 ; decimal adjustment to equate to command line. CALL TEST_ROOM ; routine TEST_ROOM returns free RAM in HL. LD A,H ; The value is negated and must be transferred CPL ; to BC registers. LD B,A ; LD A,L ; CPL ; LD C,A ; CALL STACK_BC ; stack the 16 bit value. CALL PRINT_FP ; print the free memory. LD DE,CAT3 ; address the remaining text setting inverse 0 LD BC,CAT4-CAT3 ; set the length of the string. CALL PR_STRING ; print the rest of the banner. LD A,$FD ; The starting stream. (decimal 253). LD HL,$5B10 ; The relevant system variables location. LOOP AND A ; test for zero PUSH AF ; save the stream PUSH HL ; save the address in STRMS area JR NZ,NO_BLANK ; skip forward if not stream zero. LD A,$0D ; print a carriage return as a separator RST 10H ; if it is zero NO_BLANK CALL STACK_A ; LD A,$0D ; RST 10H ; CALL PRINT_FP ; LD A,6 ; RST 10H ; POP HL ; LD C,(HL) ; INC L ; LD B,(HL) ; INC L ; LD A,B ; OR C ; JR Z,PR_CR ; LD IX,($5B4F) ; CHANS ADD IX,BC ; LD A,(IX+$03) ; RST 10H ; PR_CR POP AF ; INC A ; CP $10 ; JR NZ,LOOP ; RET ; Return. CAT3 DEFB $06 ; The 'comma control' DEFB $14,$00 ; The control codes for INVERSE 0 DEFB $0D ; The carriage return character. CAT4 ; -------------------------- ; THE 'AUTO-LIST' SUBROUTINE ; -------------------------- ; This produces an automatic listing in the upper screen. AUTO_LIST LD ($5B3F),SP ; save stack pointer in LIST_SP LD (IY+$02),$10 ; update TV_FLAG set bit 3 CALL CL_ALL ; routine CL-ALL clears 24 lines. ;;; SET 0,(IY+$02) ; update TV_FLAG - signal lower screen in use CALL SIG_L_SCR ; set 0,(iy+$02) as a call. LD B,(IY+$31) ; fetch lower screen 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 it will be necessary ; to clear the main screen. LD HL,($5B49) ; fetch E_PPC current edit line to HL. LD DE,($5B6C) ; 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 is 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 ; transfer offset to HL, program address to DE. SBC HL,DE ; subtract high value from low to obtain the ; 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 the stack. AUTO_L_1 PUSH BC ; save the result. CALL NEXT_ONE ; routine NEXT-ONE gets address in HL of the ; line after auto-line (in DE). POP BC ; restore result. ADD HL,BC ; compute back. JR C,AUTO_L_3 ; forward, if line 'should' appear, to AUTO-L-3 EX DE,HL ; transfer the 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 ($5B6C),DE ; update system variable S_TOP. JR AUTO_L_1 ; back, until estimate reached, to AUTO-L-1 ; --- ; the jump was to here if S_TOP was greater than E_PPC AUTO_L_2 LD ($5B6C),HL ; make S_TOP the same as E_PPC. ; continue here with valid starting point from above or good estimate ; from computation AUTO_L_3 LD HL,($5B6C) ; 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 ; forward, if line exists, to AUTO-L-4 EX DE,HL ; else use address of next line. AUTO_L_4 CALL LIST_ALL ; routine LIST-ALL quits when screen full >>> ; The return will be to here if no scrolling occurred JP PO_N_AUTO ;+ to code similar to below. ;;; RES 4,(IY+$02) ; update TV_FLAG - signal no auto listing. ;;; RET ; return. ; ------------------- ; THE 'LLIST' COMMAND ; ------------------- ; List Program to any stream. ; As the manual points out, this is not standard BASIC. ; A short form of LIST #3. The listing goes to stream 3 - default printer. ; This always was a nonsense for compatibility with the ZX81 but now one is ; unable to assume that stream 3 will be used for a printer. ; This will be replaced with an extra UDG. LLIST LD A,$03 ; the usual stream for a Printer JR LIST_1 ; forward to LIST-1 ; ------------------ ; THE 'LIST' COMMAND ; ------------------ ; List Program 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. LIST_0 LD A,$02 ; default is stream 2 - the upper screen. LIST_1 LD (IY+$02),$00 ; the TV_FLAG is initialized with bit 0 reset ; indicating upper screen in use. ;;; CALL SYNTAX_Z ; routine SYNTAX-Z - checking syntax ? ;;; CALL NZ,CHAN_SLCT ; routine CHAN-OPEN if in run-time. CALL CHN_O_SYN ;+ Routine opens channel in runtime. ;;; RST 18H ; GET-CHAR CALL STR_ALTER ; routine STR-ALTER will alter if '#'. JR C,LIST_4 ; forward, if not a hash, to LIST-4 ;;; RST 18H ; GET-CHAR ;;; CP $3B ; is character a ';' ? ;;; JR Z,LIST_2 ; skip, if so, to LIST-2 ;;; CP $2C ; is character a ',' ? CALL EXPT_SEP ;+ NEW routine to check for ';' or ','. JR NZ,LIST_3 ; forward, if neither separator, to LIST-3 ; we have, say, LIST #15, and a number must follow the separator. LIST_2 RST 20H ; NEXT-CHAR CALL EXPT_1NUM ; routine EXPT-1NUM checks for numeric ; expression and stacks it in run-time. JR LIST_5 ; forward to LIST-5 ; --- ; the branch was here with just LIST #3 etc. LIST_3 CALL USE_ZERO ; routine USE-ZERO defaults first line. JR LIST_5 ; forward to LIST-5 ; --- ; the branch was here with LIST LIST_4 CALL FETCH_NUM ; routine FETCH-NUM checks if a number ; follows else uses zero. LIST_5 CALL CHECK_END ; routine CHECK-END quits if syntax OK >> ; Continue in runtime. CALL FIND_LINE ;+ routine FIND-LINE fetches the number from the ;+ calculator stack and validates 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,B ; transfer the modified ;;; LD L,C ; line number to HL. LD ($5B49),HL ; update E_PPC to the new line number. CALL LINE_ADDR ; routine LINE-ADDR gets the address of the ; line. ; This routine is called from AUTO-LIST LIST_ALL LD E,$01 ; signal current line not yet printed LIST_ALL2 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_ALL2 ; back, if not, to LIST-ALL-2 ; (loop exit is via OUT-LINE) ; Continue here if an automatic listing required. LD A,($5B6B) ; fetch DF_SZ lower display file size. SUB (IY+$4F) ; subtract S_POSN_hi the current line number. JR NZ,LIST_ALL2 ; 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,$5B6C ; 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_ALL2 ; back to LIST-ALL-2. ; ----------------------------------------- ; THE 'PRINT A WHOLE BASIC LINE' SUBROUTINE ; ----------------------------------------- ; 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. OUT_LINE LD BC,($5B49) ; 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. OUT_LINEX 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. 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 ; forward, if zero, to OUT-LINE3 RST 10H ; PRINT-A prints '>' the current line cursor. ; this entry point is called from ED-COPY OUT_LINE2 SET 0,(IY+$01) ; update FLAGS - suppress leading space. 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,$5B3B ; point to FLAGS. RES 2,(HL) ; signal 'K' mode. (starts before keyword) ;;; BIT 5,(IY+$37) ; test FLAGX - input mode ? CALL TST_INP_M ;+ bit 5,(iy+$37) as a 3-byte call. JR Z,OUT_LINE4 ; forward, if not, to OUT-LINE4 SET 2,(HL) ; signal 'L' mode. (used for input) OUT_LINE4 LD HL,($5B5F) ; 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, if not, to OUT-LINE5 LD A,$3F ; load A with '?' the error marker. CALL OUT_FLASH ; routine OUT-FLASH to print flashing marker. 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 ; forward, if so, to OUT-LINE6 ; as line is complete 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. ; --- OUT_LINE6 POP DE ; bring back the flag E, zero if current line ; printed else value one if still to print. RET ; return - with A holding $0D ; ------------------------------- ; THE 'CHANNEL LETTER' SUBROUTINE ; ------------------------------- ; IN_CHAN_K LD HL,($5B51) ; fetch address of current channel CURCHL JR NUMBER_4 ; forward to pick up channel letter. ; ----------------------- ; THE 'NUMBER' SUBROUTINE ; ----------------------- ; 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. NUMBER CP $0E ; character fourteen ? RET NZ ; return if not. INC HL ; skip the character NUMBER_5 INC HL ; and five bytes NUMBER_4 INC HL ; following. NUMBER_3 INC HL ; INC HL ; INC HL ; LD A,(HL) ; fetch the following character CP $4B ;+ default comparison - is it letter 'K' ? RET ; for return value. ; ------------------------------------------- ; THE 'PRINT A FLASHING CHARACTER' SUBROUTINE ; ------------------------------------------- ; 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 PRINT_OUT ; can be used, even though out-line outputs to other streams. ; In fact the alternate set is used for the whole routine. OUT_FLASH EXX ; Switch in alternate set ;;; LD HL,($5B8F) ; fetch L = ATTR_T, H = MASK-T ;;; PUSH HL ; preserve original value and masks. ;;; RES 7,H ; reset flash mask bit so active. ;;; SET 7,L ; make attribute FLASH. ;;; LD ($5B8F),HL ; update system variables ATTR_T and MASK-T ;;; LD HL,$5B91 ; Address P_FLAG ;;; LD D,(HL) ; fetch value to D ;;; PUSH DE ; and preserve original value. ;;; 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. EX DE,HL ;+ Note. NEW transfer attribute byte to HL. SET 7,(HL) ;+ Make it flash. ;;; POP HL ; pop the original P_FLAG to H. ;;; LD (IY+$57),H ; and restore system variable P_FLAG. ;;; POP HL ; restore original attribute and mask ;;; LD ($5B8F),HL ; and restore system variables ATTR_T/MASK_T EXX ; Switch back to main set RET ; Return ; --------------------------------- ; THE 'PRINT THE CURSOR' SUBROUTINE ; --------------------------------- ; 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 ; the 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. OUT_CURS LD HL,($5B5B) ; 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,($5B41) ; fetch MODE 0='KLC', 1='E', 2='G'. RLC A ; double the value and set flags. JR Z,OUT_C_1 ; forward, if still zero, to OUT-C-1 ('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. OUT_C_1 LD HL,$5B3B ; 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, if so to print, at OUT-C-2 SET 3,(HL) ; signal 'L' mode to the interrupt routine. ; Note. transient bit has been made permanent. INC A ; Augment character 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, if not set to print, at OUT-C-2 LD A,$43 ; alter character 'L' to 'C'. ;;; PUSH DE ; save address pointer but OK as OUT-FLASH ;;; ; uses alternate set without RST 10. OUT_C_2 JR OUT_FLASH ;+ routine OUT-FLASH to print. ;;; POP DE ; restore and ;;; RET ; return. (replace CALL,RET with a JR) ; ------------------------- ; THE 'LN_FETCH' SUBROUTINE ; ------------------------- ; These two subroutines are called while editing. ; The first 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. 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 ;;; L191C: BIT 5,(IY+$37) ; test FLAGX - input mode ? ;;; RET NZ ; return if not edit mode. ;;; ; Note. above already checked by ED-UP/ED-DOWN. LN_STORE LD (HL),D ; save high byte of line number. DEC HL ; address lower LD (HL),E ; save low byte of line number. RET ; return. ; ------------------------------------------ ; THE 'OUTPUT NUMBERS IN BASIC LINE' ROUTINE ; ------------------------------------------ ; 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 is output by ; space(out_char), 2(out_code), 0(out_char) final number always out-code. 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) 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. OUT_SP_NO XOR A ; initialize digit to 0 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. -> ; -------------------------------------------------- ; THE 'OUTPUT CHARACTERS IN A BASIC LINE' SUBROUTINE ; -------------------------------------------------- ; This subroutine ... 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 ; forward, if so, to OUT-CH-3 CP $3A ; is character ':' ? JR NZ,OUT_CH_1 ; forward, if not, to OUT-CH-1 ; to change mode back to 'L'. ;;; BIT 5,(IY+$37) ; FLAGX - Input Mode ?? CALL TST_INP_M ;+ bit 5,(iy+$37) as a 3-byte call. JR NZ,OUT_CH_2 ; forward, if in INPUT, to OUT-CH-2 ; 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 ; forward, if not, to OUT-CH-3 JR OUT_CH_2 ; forward to OUT-CH-2 as ':' is within quotes ; --- OUT_CH_1 CP $22 ; is it the quote character '"' ? JR NZ,OUT_CH_2 ; forward, with others, to OUT-CH-2 ; to set 'L' mode. PUSH AF ; save character. LD A,($5B6A) ; fetch FLAGS2. XOR $04 ; toggle the quotes flag - BIT 2, FLAGS2 LD ($5B6A),A ; update FLAGS2 POP AF ; and restore character. OUT_CH_2 SET 2,(IY+$01) ; update FLAGS - signal L mode if the cursor ; is next. OUT_CH_3 RST 10H ; PRINT-A vectors the character to ; channel 'S', 'K', 'R' or 'P'. RET ; return. ; ----------------------------- ; THE 'LINE ADDRESS' SUBROUTINE ; ----------------------------- ; 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. LINE_ADDR PUSH HL ; save line number in HL register LD HL,($5B53) ; fetch start of program from PROG LD D,H ; transfer address to LD E,L ; the DE register pair. 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, for another comparison, to LINE-AD-1 ; ------------------------------------- ; THE 'COMPARE LINE NUMBERS' SUBROUTINE ; ------------------------------------- ; This routine compares a line number supplied in BC with an addressed ; line number pointed to by HL. 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. ; ------------------------------------ ; THE 'FIND EACH STATEMENT' SUBROUTINE ; ------------------------------------ ; 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. ;;; L1988: INC HL ; not used ;;; INC HL ; not used ;;; INC HL ; not used ; -> entry point. EACH_STMT LD ($5B5D),HL ; Save HL in CH_ADD LD C,$00 ; Initialize the quotes flag EACH_S_1 DEC D ; Decrease the statement count RET Z ; Return if zero RST 20H ; NEXT-CHAR CP E ; Is it the search token ? JR NZ,EACH_S_3 ; Forward, if not, to EACH-S-3 AND A ; clear carry RET ; return signaling success. ; --- EACH_S_2 INC HL ; next address LD A,(HL) ; next character EACH_S_3 CALL NUMBER ; routine NUMBER skips if number marker LD ($5B5D),HL ; save character address in CH_ADD CP $22 ; is it quotes character '"' ? JR NZ,EACH_S_4 ; forward, if not, to EACH-S-4 DEC C ; toggle bit 0 of C EACH_S_4 CP $3A ; is character ':' JR Z,EACH_S_5 ; forward, if so, to EACH-S-5 CP $CB ; is character 'THEN' JR NZ,EACH_S_6 ; forward, if not, to EACH-S-6 EACH_S_5 BIT 0,C ; is it within quotes ? JR Z,EACH_S_1 ; back, if not, to EACH-S-1 EACH_S_6 CP $0D ; end of line ? JR NZ,EACH_S_2 ; back, if not, to EACH-S-2 DEC D ; decrease the statement counter ; which should be zero else ; 'Statement Lost'. SCF ; set carry flag - signal 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. ; ; ----------------------------------------------------------------------- ; ------------------------- ; THE 'NEXT ONE' SUBROUTINE ; ------------------------- ; 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. 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. 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, if so, to NEXT-O-1 CCF ; clear the carry for long-named variables. ; it remains set for for-next loop variables. 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 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. NEXT_O_3 INC HL ; increment pointer to low byte of line no. ; strings and arrays rejoin here 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 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. ; --------------------------- ; THE 'DIFFERENCE' SUBROUTINE ; --------------------------- ; This routine terminates the above routine and is also called from the ; start of the next routine to calculate the length to reclaim. 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. ; -------------------------------- ; THE 'NEXT_ONE/RECLAIM_2' ROUTINE ; -------------------------------- ; On three occasions the two subroutines are called in succession so this ; 5-byte routine by James Smith combines the two calls. NXT_1_RC2 CALL NEXT_ONE ;+ JR RECLAIM_2 ;+ forward to reclaim space ; ----------------------------- ; THE 'RECLAIM ROOM' SUBROUTINE ; ----------------------------- ; RECLAIM_1 CALL DIFFER ; routine DIFFER immediately above 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 ; Return. ; -------------------------------------- ; THE 'READ EDIT LINE NUMBER' SUBROUTINE ; -------------------------------------- ; 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 its 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 ; by deleting lines. If the stack was in its normal place, then a situation ; arises whereby the Spectrum becomes locked with no means of reclaiming ; space. E_LINE_NO CALL L_EL_DHL ;+ NEW routine with below code. ;;; LD HL,($5B59) ; load HL from system variable E_LINE. ;;; DEC HL ; decrease so that NEXT_CHAR can be used ;;; ; without skipping the first digit. LD ($5B5D),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,$5B92 ; use MEM-0 as a temporary calculator stack ; an overhead of three locations are needed. LD ($5B65),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,REPORT_Ce ; forward to E-L-1 if overflow i.e. > 65535. ; 'Nonsense in BASIC' LD HL,$D8F0 ; load HL with the value -9999 ADD HL,BC ; add to line number in BC ; a line in the range 0 - 9999 has been entered. JP NC,SET_STK ; jump back to SET-STK to set the calculator ; stack back to its normal place and exit ; from there. ;;; E_L_1 JP C,REPORT_C ; to REPORT-C 'Nonsense in BASIC' if over. REPORT_Ce RST 30H ; ERROR-1 DEFB $0B ; 'Nonsense in BASIC' ;;; JP SET_STK ; jump back to SET-STK ; ------------------------------------------------ ; THE 'REPORT AND LINE NUMBER PRINTING' SUBROUTINE ; ------------------------------------------------ ; 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. OUT_NUM_0 LD B,$00 ;+ New entry point to print C 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, if so, to OUT-NUM-4 ; 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 ; --- ; Entry point from OUT-LINE - HL addresses line number. 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' 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. 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. 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. 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" P_LET DEFB $01 ; Class-01 - A variable is required. DEFB $3D ; Separator: '=' DEFB $02 ; Class-02 - An expression, numeric or string, ; must follow. P_GO_TO DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW GO_TO ; Address: GO-TO 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 ; Address: IF P_GO_SUB DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW GO_SUB ; Address: GO-SUB P_STOP DEFB $00 ; Class-00 - No further operands. DEFW STOP ; Address: STOP P_RETURN DEFB $00 ; Class-00 - No further operands. DEFW RETURN ; Address: RETURN 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: FOR P_NEXT DEFB $04 ; Class-04 - A single character variable must ; follow. DEFB $00 ; Class-00 - No further operands. DEFW NEXT ; Address: NEXT P_PRINT DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW PRINT ; Address: PRINT P_INPUT DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW INPUT ; Address: INPUT P_DIM DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW DIM ; Address: DIM P_REM DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW REM ; Address: REM P_NEW DEFB $00 ; Class-00 - No further operands. DEFW NEW ; Address: NEW P_RUN DEFB $03 ; Class-03 - A numeric expression may follow ; else default to zero. DEFW RUN ; Address: RUN P_LIST DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW LIST_0 ; Address: LIST P_POKE DEFB $08 ; Class-08 - Two comma-separated numeric ; expressions required. DEFB $00 ; Class-00 - No further operands. DEFW POKE ; Address: POKE P_RANDOM DEFB $03 ; Class-03 - A numeric expression may follow ; else default to zero. DEFW RANDOMIZE ; Address: RANDOMIZE P_CONT DEFB $00 ; Class-00 - No further operands. DEFW CONTINUE ; Address: CONTINUE P_CLEAR ;;; DEFB $03 ; Class-03 - A numeric expression may follow ;;; ; else default to zero. DEFB $05 ;+ Variable syntax checked by routine. DEFW CLEAR ; Address: CLEAR P_CLS DEFB $00 ; Class-00 - No further operands. DEFW CLS ; Address: CLS 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: PLOT P_PAUSE DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW PAUSE ; Address: PAUSE P_READ DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW READ ; Address: READ P_DATA DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW DATA ; Address: DATA P_RESTORE DEFB $03 ; Class-03 - A numeric expression may follow ; else default to zero. DEFW RESTORE ; Address: RESTORE 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: DRAW P_COPY DEFB $00 ; Class-00 - No further operands. DEFW COPY ; Address: COPY P_LPRINT DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW LPRINT ; Address: LPRINT P_LLIST DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW LLIST ; Address: LLIST P_SAVE DEFB $0B ; Class-0B - Offset address converted to tape ; command. P_LOAD DEFB $0B ; Class-0B - Offset address converted to tape ; command. P_VERIFY DEFB $0B ; Class-0B - Offset address converted to tape ; command. P_MERGE DEFB $0B ; Class-0B - Offset address converted to tape ; command. P_BEEP DEFB $08 ; Class-08 - Two comma-separated numeric ; expressions required. DEFB $00 ; Class-00 - No further operands. DEFW BEEP ; Address: BEEP 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: CIRCLE P_INK DEFB $07 ; Class-07 - Offset address is converted to ; colour code. P_PAPER DEFB $07 ; Class-07 - Offset address is converted to ; colour code. P_FLASH DEFB $07 ; Class-07 - Offset address is converted to ; colour code. P_BRIGHT DEFB $07 ; Class-07 - Offset address is converted to ; colour code. P_INVERSE DEFB $07 ; Class-07 - Offset address is converted to ; colour code. P_OVER DEFB $07 ; Class-07 - Offset address is converted to ; colour code. P_OUT DEFB $08 ; Class-08 - Two comma-separated numeric ; expressions required. DEFB $00 ; Class-00 - No further operands. DEFW OUT_0 ; Address: OUT P_BORDER DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW BORDER ; Address: BORDER P_DEF_FN DEFB $05 ; Class-05 - Variable syntax checked entirely ; by routine. DEFW DEF_FN ; Address: DEF-FN P_OPEN DEFB $06 ; Class-06 - A numeric expression must follow. ;;; DEFB $2C ; Separator: ',' DEFB $0C ;+ Class-0C - NEW either ';' or ',' DEFB $0A ; Class-0A - A string expression must follow. ;;; DEFB $00 ; Class-00 - Was No further operands. DEFB $05 ;+ Class-05 - New Variable syntax. DEFW OPEN ; Address: OPEN P_CLOSE DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW CLOSE ; Address: CLOSE P_FORMAT DEFB $0A ; Class-0A - A string expression must follow. DEFB $0C ; Class-0C - NEW either ';' or ',' DEFB $06 ; Class-06 - A numeric expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW FORMAT ; Address: FORMAT ; Since the commands MOVE ERASE and CAT will not be used then the syntax ; can be removed and they can all use the CAT error-generating routine. 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: CAT-ETC P_ERASE ;;; DEFB $0A ; Class-0A - A string expression must follow. DEFB $00 ; Class-00 - No further operands. DEFW REPORT_O ; Address: REPORT_O - Invalid stream P_CAT DEFB $00 ; Class-00 - No further operands. DEFW CAT ; Address: CAT - ; ----------------------- ; THE 'LINE SCAN' ROUTINE ; ----------------------- ; The 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. 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 ($5B47),A ; set statement number SUBPPC to zero. DEC A ; set accumulator to $FF. LD ($5B3A),A ; set ERR_NR to 'OK' - 1. JR STMT_L_1 ; forward to continue at STMT-L-1. ; -------------------- ; THE 'STATEMENT' LOOP ; -------------------- ; ; STMT_LOOP RST 20H ; NEXT-CHAR ; -> the entry point from above or LINE-RUN STMT_L_1 CALL SET_WORK ; routine SET-WORK clears workspace etc. INC (IY+$0D) ; increment statement number SUBPPC JP M,REPORT_C ; back, if over 127, to REPORT-C ; 'Nonsense in BASIC' 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, if so, to LINE-END CP $3A ; is it statement end marker ':' ? ; i.e. another type of empty statement. JR Z,STMT_LOOP ; back, if so, to STMT-LOOP 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 JR C,SEP_RPT_C ; jump, if less than a command, to REPORT-C ; '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 SCAN' LOOP ; -------------------- ; SCAN_LOOP LD HL,($5B74) ; Fetch Table Address from T_ADDR during ; subsequent loops. ; -> the initial entry point with HL addressing start of syntax table entry. GET_PARAM LD A,(HL) ; Pick up the parameter. INC HL ; Address next one. LD ($5B74),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 HL,SCAN_LOOP ;+ address: SCAN-LOOP PUSH HL ;+ 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, if so, to SEPARATOR 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 ; Make an indirect jump to routine ; and then to 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. ; ----------------------- ; THE 'SEPARATOR' ROUTINE ; ----------------------- ; 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. SEPARATOR RST 18H ; GET-CHAR CP C ; does it match the character in C ? SEP_RPT_C JP NZ,REPORT_C ; jump forward, if not, to REPORT-C ; 'Nonsense in BASIC'. RST 20H ; NEXT-CHAR advance to next character RET ; return. ; ---------------------------- ; THE 'STATEMENT RETURN' POINT ; ---------------------------- ; Control returns to this point after every statement by virtue of the ; address pushed on the machine stack. STMT_RET CALL TEST_BRK ;+ the BREAK KEY is tested after every statement. ;;; JR C,STMT_R_1 ; step forward to STMT-R-1 if not pressed. ;;; REPORT_L RST 30H ; ERROR-1 ;;; DEFB $14 ; Error Report: BREAK into program ; --- STMT_R_1 BIT 7,(IY+$0A) ; test a bit of NSPPC - will be set if $FF - ; no jump to be made. JR NZ,STMT_NEXT ; forward, if no jump, to STMT-NEXT LD HL,($5B42) ; fetch BASIC line number from NEWPPC BIT 7,H ; test the high order byte. ; bit 7 is set if minus two - direct command(s) JR Z,LINE_NEW ; forward, if a jump is to be made, to LINE-NEW ; ---------------------------------- ; THE 'RUN A DIRECT COMMAND' ROUTINE ; ---------------------------------- ; A direct command is to be run or, if continuing from above, the next ; statement in a sequence of direct commands is to be considered. LINE_RUN LD HL,$FFFE ; The dummy value minus two LD ($5B45),HL ; is set/reset as line number in PPC. LD HL,($5B61) ; point to the start of workspace WORKSP. DEC HL ; now point to $80 Edit Line end-marker. LD DE,($5B59) ; address the start of line using E_LINE. DEC DE ; now location before - for GET-CHAR. LD A,($5B44) ; load statement to A from NSPPC. JR NEXT_LINE ; forward to NEXT-LINE. ; ---------------------- ; THE 'LINE NEW' ROUTINE ; ---------------------- ; This routine finds the 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.. LINE_NEW CALL LINE_ADDR ; routine LINE-ADDR gets address of line ; returning zero flag set if line found. LD A,($5B44) ; 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, if not, to REPORT-N ; '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,LIN_USE_0 ; forward to LINE-USE if was a program line ; Alternatively, a direct statement has finished correctly. REPORT_0 RST 30H ; ERROR-1 DEFB $FF ; Error Report: OK ; ----------------- ; THE 'REM' COMMAND ; ----------------- ; The REM command routine. ; The return address STMT-RET is dropped and the rest of line ignored. REM POP BC ; drop return address STMT-RET and ; continue ignoring rest of line. ; ------------ ; End of line? ; ------------ ; ; ;;; LINE_END CALL SYNTAX_Z ; routine SYNTAX_Z (UNSTACK_Z?) ;;; RET Z ; return if checking syntax. LINE_END CALL UNSTACK_Z ;+ return early if checking syntax. LD HL,($5B55) ; fetch NXTLIN to HL. LD A,$C0 ; test against the AND (HL) ; system limit $3F. RET NZ ; return if higher as must be end of program. ; (or direct command) LIN_USE_0 XOR A ; set statement to zero. ; and continue to set up the next following line and then consider this new one. ; --------------------- ; THE 'LINE USE' BRANCH ; --------------------- ; 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. 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 ($5B45),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 adding ADD HL,DE ; to address the end of the line. INC HL ; advance to start of next line. ; -------------------------- ; THE 'NEXT LINE' SUBROUTINE ; -------------------------- ; The pointer will be the next line if continuing from above or to edit line ; end-marker ($80) if from LINE-RUN. NEXT_LINE LD ($5B55),HL ; store pointer in system variable NXTLIN EX DE,HL ; bring back pointer to previous or edit line LD ($5B5D),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 signaling ; 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. REPORT_N RST 30H ; ERROR-1 DEFB $16 ; 'Statement lost' ; --------------------------------------------- ; THE NEW 'CHECK FOR NUMBER AND SYNTAX' ROUTINE ; --------------------------------------------- ; Combines two or three routines into one call. CHK_END_1 RST 20H ;+ NEXT_CHAR CHK_END_2 CALL EXPT_1NUM ;+ Check for 1 number and stack in runtime ; -------------------------- ; THE 'CHECK END' SUBROUTINE ; -------------------------- ; 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. 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. ; ---------------------------- ; THE 'STATEMENT NEXT' ROUTINE ; ---------------------------- ; 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. STMT_NEXT RST 18H ; GET-CHAR - ignoring white space etc. CP $0D ; is character carriage return ? JR Z,LINE_END ; back, if so, to LINE-END CP $3A ; is character a ':' ? JP Z,STMT_LOOP ; jump back, if so, to STMT-LOOP JR VAL_RPT_C ; forward, with any other, to VAL_RPT_C ; 'Nonsense in BASIC' ; ------------------------- ; THE 'COMMAND CLASS' TABLE ; ------------------------- ; CLASS_TBL DEFB CLASS_00 - $ ; offset to Address: CLASS-00 DEFB CLASS_01 - $ ; offset to Address: CLASS-01 DEFB CLASS_02 - $ ; offset to Address: CLASS-02 DEFB CLASS_03 - $ ; offset to Address: CLASS-03 DEFB CLASS_04 - $ ; offset to Address: CLASS-04 DEFB CLASS_05 - $ ; offset to Address: CLASS-05 DEFB CLASS_06 - $ ; offset to Address: CLASS-06 DEFB CLASS_07 - $ ; offset to Address: CLASS-07 DEFB CLASS_08 - $ ; offset to Address: CLASS-08 DEFB CLASS_09 - $ ; offset to Address: CLASS-09 DEFB CLASS_0A - $ ; offset to Address: CLASS-0A DEFB CLASS_0B - $ ; offset to Address: CLASS-0B DEFB CLASS_0C - $ ; offset to Address: CLASS_0C ; -------------------------------------------- ; THE 'COMMAND CLASSES 00, 03 and 05' ROUTINES ; -------------------------------------------- ; class-03 e.g. RUN or RUN 20 ; optional operand. ; class-00 e.g. CONTINUE ; no operand. ; class-05 e.g. PRINT ; variable syntax checked by routine. CLASS_03 CALL FETCH_NUM ; routine FETCH-NUM CLASS_00 CP A ; set zero flag. ; if entering here then all class routines are entered with zero reset. 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. ; If checking syntax then classes 00 and 03 terminate at the above step. EX DE,HL ; save HL to DE. LD HL,($5B74) ; 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. ; ------------------------------ ; THE 'COMMAND CLASS 01' ROUTINE ; ------------------------------ ; e.g. LET A = 2*3 ; A variable is required. ; This class routine is also called from INPUT and READ to find the ; destination variable for an assignment. CLASS_01 CALL LOOK_VARS ; routine LOOK-VARS returns carry set if the ; variable is not found in runtime. VAR_A_1 LD (IY+$37),$00 ; Set FLAGX to zero JR NC,VAR_A_2 ; Forward, if found or syntax path, to VAR-A-2 ; The variable was not found in runtime. SET 1,(IY+$37) ; Update FLAGX - signal a new variable. JR NZ,VAR_A_3 ; Forward, if not array subscript, to VAR-A-3 ; e.g. LET a$(3,3) = "X" REPORT_2 RST 30H ; ERROR-1 DEFB $01 ; Error Report: Variable not found. ; --- ; The branch was here when the variable was found or if checking syntax. 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 ; forward, if numeric, to VAR-A-3. XOR A ; Default A 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,$5B71 ; Address the FLAGX system variable. OR (HL) ; sets bit 0 if simple variable to be reclaimed. LD (HL),A ; update bit 0 of FLAGX EX DE,HL ; bring start of string/subscript to HL VAR_A_3 LD ($5B72),BC ; update STRLEN system variable. LD ($5B4D),HL ; update DEST of assigned string. RET ; Return. ; ------------------------------ ; THE 'COMMAND CLASS 02' ROUTINE ; ------------------------------ ; This is only used in the LET command. ; ; e.g. LET A = 2*3 ; an expression must follow the separator. CLASS_02 POP BC ; drop the 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 in runtime also. ; ------------------------------ ; THE 'FETCH A VALUE' SUBROUTINE ; ------------------------------ ; ; VAL_FET_1 LD A,($5B3B) ; fetch initial FLAGS system variable to A. VAL_FET_2 PUSH AF ; Save initial flags A briefly CALL SCANNING ; routine SCANNING evaluates expression. POP AF ; Restore the initial flags - A. LD D,(IY+$01) ; Fetch post-scanning FLAGS value to D XOR D ; XOR the before and after flags. AND $40 ; isolate bit 6 of result. VAL_RPT_C JR NZ,REPORT_C ; Forward, if not zero, to REPORT-C ; 'Nonsense in BASIC' BIT 7,D ; Test FLAGS - is syntax being checked ? JP NZ,LET ; Jump forward, in runtime, to LET ; to make the assignment. RET ; Return from here when checking syntax. ; ------------------------------ ; THE 'COMMAND CLASS 04' ROUTINE ; ------------------------------ ; e.g. FOR i ; a single character variable must follow 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 result is now $FF by incrementing. JR NZ,REPORT_C ; forward, if result not zero, to REPORT-C ; 'Nonsense in BASIC' 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 ). NEXT_2NUM RST 20H ; NEXT-CHAR advance past 'AT' or '('. CLASS_08 ; e.g. POKE 65535,2 ; two numeric expressions separated by comma 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 the required separator. ; 'Nonsense in BASIC'. RST 20H ; NEXT-CHAR ; -> CLASS_06 ; e.g. GO TO a*1000 ; a numeric expression must follow EXPT_1NUM CALL SCANNING ; routine SCANNING BIT 6,(IY+$01) ; test FLAGS - Numeric or string result ? RET NZ ; return if result is numeric. REPORT_C RST 30H ; ERROR-1 DEFB $0B ; Error Report: Nonsense in BASIC ; ------------------------------ ; THE 'COMMAND CLASS 0A' ROUTINE ; ------------------------------ ; ; A string expression must follow. These classes only occur in unimplemented ; commands although the routine EXPT_EXP is called from SAVE_ETC. ; It is used in the FORMAT and OPEN syntax tables. 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, if numeric, to REPORT-C. ; ------------------------------ ; THE 'COMMAND CLASS 07' ROUTINE ; ------------------------------ ; Set permanent colours ; e.g. PAPER 6 ; a single class for a collection of similar commands. Clever. ; ; Note. these commands should ensure that current channel is 'S' ;;; CLASS_07 BIT 7,(IY+$01) ; test FLAGS - checking syntax only ? ;;; RES 0,(IY+$02) ; update TV_FLAG - signal main screen in use ;;; CALL NZ,TEMPs ; routine TEMPs is called in runtime. CLASS_07 LD A,$FE ; CALL CHN_O_SYN ;+ ensure control codes go to screen and not a ;+ microdrive file in runtime. ;+ Returns if checking syntax. POP AF ; drop return address SCAN-LOOP LD A,($5B74) ; Fetch 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 P_INK-$D8 % 256 ; convert $EB to $D8 ('INK') etc. ; ( was SUB $13 in standard ROM ) CALL CO_TEMP_4 ; routine CO-TEMP-4 CALL CHECK_END ; routine CHECK-END check that nothing else ; appears in the statement and quits if ; checking syntax. >> ; Return to here in runtime. The temporary attributes set up by CO_TEMP_4 ; are now copied to the permanent attributes to make the change premanent. LD HL,($5B8F) ; pick up ATTR_T and MASK_T LD ($5B8D),HL ; and transfer to ATTR_P and MASK_P LD HL,$5B91 ; point to P_FLAG. LD A,(HL) ; pick up in A RLCA ; rotate to left XOR (HL) ; combine with HL AND $AA ; AND with %10101010 XOR (HL) ; only only the permanent bits affected LD (HL),A ; reload into system variable P_FLAG. RET ; Return. ; ------------------------------ ; THE 'COMMAND CLASS 09' ROUTINE ; ------------------------------ ; e.g. PLOT PAPER 0; 128,88 ; two coordinates preceded by optional ; ; embedded colour items. ; ; Note. this command should ensure that current channel is actually 'S'. 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 in runtime. CALL CHAN_O_FE ;+ ensure control codes go to screen and not ;+ to the network in runtime. LD HL,$5B90 ; point to MASK_T LD A,(HL) ; fetch mask to accumulator. OR $F8 ; or with 11111000 paper/bright/flash 8 LD (HL),A ; put mask back to MASK_T system variable. RES 6,(IY+$57) ; reset P_FLAG - signal NOT PAPER 9 ? RST 18H ; GET-CHAR CL_09_1 CALL CO_TEMP_2 ; routine CO-TEMP-2 deals with any embedded ; colour items. JR EXPT_2NUM ; exit via EXPT-2NUM to check for x,y. ; Note. if either of the numeric expressions contain STR$ then the flag ; setting above will be undone when the channel flags are reset during STR$. ; e.g. ; 10 BORDER 3 : PLOT VAL STR$ 128, VAL STR$ 100 ; credit: John Elliott. ; ------------------------------ ; THE 'COMMAND CLASS 0B' ROUTINE ; ------------------------------ ; 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. CLASS_0B JP SAVE_ETC ; jump way back to SAVE-ETC ; ---------------------------------- ; THE NEW 'EXPECT SEPARATOR' ROUTINE ; ---------------------------------- ; Seven bytes ; Returns with zero flag set if character is a separator. EXPT_SEP RST 18H ; GET_CHAR CP $2C ; is it a comma RET Z ; CP $3B ; is it a semicolon RET ; ; ----------------------------- ; THE NEW 'CLASS 0C' SUBROUTINE ; ----------------------------- CLASS_0C CALL EXPT_SEP ; check for a valid separator ';' or ','. JR NZ,REPORT_C ; jump forward, if not, to REPORT-C ; 'Nonsense in BASIC'. NXT_CH RST 20H ; NEXT-CHAR advance to next character RET ; return. ; ------------------------------- ; THE 'FETCH A NUMBER' SUBROUTINE ; ------------------------------- ; 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. ; Note. called from SAVE "program" LINE FETCH_NUM CP $0D ; is character a carriage return ? JR Z,USE_ZERO ; forward, if so, to USE-ZERO CP $3A ; is it ':' ? JR NZ,EXPT_1NUM ; back, if not, to EXPT-1NUM ; else continue and use zero. ; ---------------------- ; THE 'USE ZERO' ROUTINE ; ---------------------- ; This routine is called four times to place the value zero on the ; calculator stack as a default value in runtime. ;;; USE_ZERO CALL SYNTAX_Z ; routine SYNTAX_Z (UNSTACK_Z?) ;;; RET Z ; USE_ZERO CALL UNSTACK_Z ;+ return early if checking syntax. RST 28H ;; FP-CALC . DEFB $A0 ;;stk-zero 0. DEFB $38 ;;end-calc 0. RET ; Return. ; ------------------ ; THE 'STOP' COMMAND ; ------------------ ; Command Syntax: STOP ; One of the shortest and least used commands. As with 'OK' not an error. ; Note. moved to fill a couple of bytes at $0064. ; ---------------- ; THE 'IF' COMMAND ; ---------------- ; e.g. IF Warp Factor > 8 THEN PRINT "Och! she'll blow Captain." ; 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. IF POP BC ; drop return address - STMT-RET CALL SYNTAX_Z ; routine SYNTAX-Z JR Z,IF_1 ; forward, if checking syntax, to IF-1 ; to check syntax of PRINT "Och! She'll blow..." RST 28H ;; FP-CALC Warp Factor > 8 (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) IF_1 JP STMT_L_1 ; to STMT-L-1, if true (1) to execute command ; after 'THEN' token. ; ----------------- ; THE '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 separators. The two values v,l ; are on the calculator stack. The CLASS-04 routine has also checked the ; variable and the name is in STRLEN_lo. ; The routine begins by checking for an optional STEP. FOR CP $CD ; is there a 'STEP' ? JR NZ,F_USE_1 ; Forward, if not, to F-USE-1 ;;; RST 20H ; NEXT-CHAR ;;; CALL EXPT_1NUM ; routine EXPT-1NUM checks for number ;;; CALL CHECK_END ; routine CHECK-END CALL CHK_END_1 ;+ above three routines JR F_REORDER ; forward to F-REORDER ; --- 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 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. LD ($5B68),HL ; The system variable MEM is made to point to ; the variable instead of its normal location ; at MEMBOT. DEC HL ; point to the single-character name. LD A,(HL) ; fetch character. SET 7,(HL) ; set bit 7 at variable location. LD BC,$0006 ; add six to HL to skip the value and ADD HL,BC ; address where limit should be. RLCA ; test bit 7 of original variable name. JR C,F_L_S ; forward, if already correct type, to F-L-S 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 the limit. F_L_S PUSH HL ; save the limit position. RST 28H ;; FP-CALC l,s. DEFB $02 ;;delete l. DEFB $02 ;;delete . DEFB $38 ;;end-calc . ; At this point, DE points to STKEND the start of the two deleted numbers. POP HL ; restore variable limit position EX DE,HL ; swap pointers LD C,$0A ; ten bytes to move LDIR ; Copy 'deleted' values to limit and step. LD HL,($5B45) ; Load with current line number from PPC EX DE,HL ; exchange pointers. LD (HL),E ; save the looping line in INC HL ; in the next LD (HL),D ; two variable locations. LD D,(IY+$0D) ; fetch statement from SUBPPC system variable. INC D ; increment the statement. INC HL ; increment the variable pointer LD (HL),D ; and store the looping statement. CALL NEXT_LOOP ; routine NEXT-LOOP considers an initial ; iteration. RET NC ; Return to STMT-RET, if a loop is possible, to ; execute the next statement. ; No loop is possible, so execution continues after the matching 'NEXT' LD B,(IY+$38) ; get the single-character name from STRLEN_lo LD HL,($5B45) ; get the current line from PPC LD ($5B42),HL ; and store it in NEWPPC LD A,($5B47) ; 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. RST 18H ;;;; ;;; LD HL,($5B5D) ; get current character address from CH_ADD LD E,$F3 ; The search will be for the token 'NEXT' F_LOOP PUSH BC ; save the variable name in B. LD BC,($5B55) ; fetch NXTLIN CALL LOOK_PROG ; routine LOOK-PROG searches for 'NEXT' token ; setting carry flag if end of program reached ; and updating NEWPPC with line number, BC. LD ($5B55),BC ; update NXTLIN POP BC ; retrieve the variable name in B. JR C,REPORT_I ; forward, if at program end, to REPORT-I ; '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, if it matches, to F-FOUND ; but if no match i.e. nested FOR/NEXT loops then continue search. RST 20H ; NEXT-CHAR JR F_LOOP ; back to F-LOOP ; --- 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 ($5B44),A ; set system variable NSPPC RET ; return to STMT-RET to branch to new ; line and statement. -> ; --- REPORT_I RST 30H ; ERROR-1 DEFB $11 ; Error Report: FOR without NEXT ; ----------------------------- ; THE 'LOOK PROGRAM' SUBROUTINE ; ----------------------------- ; Used to find tokens 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. LOOK_PROG LD A,(HL) ; fetch current character CP $3A ; is it ':' a statement separator ? JR Z,LOOK_P_2 ; forward, if so, to LOOK-P-2 ; The starting point was PROG-1 or is now the end of a line. 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 ($5B42),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 current address - pointing to BASIC. ADD HL,BC ; add length to current address. LD B,H ; and transfer the result - the next line - LD C,L ; to the BC register. POP HL ; retrieve the current address. LD D,$00 ; initialize statement counter to zero. LOOK_P_2 PUSH BC ; preserve address of next line CALL EACH_STMT ; routine EACH-STMT searches current line. POP BC ; retrieve address of next line. RET NC ; return if match was found. -> JR LOOK_P_1 ; back, for next line, to LOOK-P-1 ; ------------------ ; THE 'NEXT' COMMAND ; ------------------ ; e.g. NEXT i ; The parameter tables have already evaluated the presence of a variable NEXT BIT 1,(IY+$37) ; test FLAGX - handling a new variable ? JP NZ,REPORT_2 ;.jump back, if so, to REPORT-2 ; 'Variable not found' ; now test if the found variable is a simple variable uninitialized by a FOR. LD HL,($5B4D) ; load address of variable from DEST BIT 7,(HL) ; is it correct type ? JR Z,REPORT_1 ; forward, if not, to REPORT-1 ; 'NEXT without FOR' INC HL ; step past variable name LD ($5B68),HL ; and set system variable MEM to point to the ; three 5-byte numbers - value, limit, step. ; Now add the step and put result in the value (mem-0). RST 28H ;; FP-CALC . 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,($5B68) ; 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 ; exchange - HL = line number, D = statement. JP GO_TO_2 ; exit via GO-TO-2 to execute another loop. ; --- REPORT_1 RST 30H ; ERROR-1 DEFB $00 ; Error Report: NEXT without FOR ; -------------------------- ; THE 'NEXT LOOP' SUBROUTINE ; -------------------------- ; 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. 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 NEXT_1 - $ ;;to NEXT-1 if step negative DEFB $01 ;;exchange v,l. NEXT_1 DEFB $03 ;;subtract l-v OR v-l. DEFB $37 ;;greater-0 (1/0) DEFB $00 ;;jump-true . DEFB NEXT_2 - $ ;;to NEXT-2 if no more iterations. DEFB $38 ;;end-calc . AND A ; clear carry flag signaling another loop. RET ; return ; --- NEXT_2 DEFB $38 ;;end-calc . SCF ; set carry flag signaling looping exhausted. RET ; return ; ------------------ ; THE '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 then used to read the second list. READ_3 RST 20H ; NEXT-CHAR ; -> Entry point. READ CALL CLASS_01 ; routine CLASS-01 checks variable. CALL SYNTAX_Z ; routine SYNTAX-Z JR Z,READ_2 ; forward, if checking syntax, to READ-2 ; The runtime path continues. RST 18H ; GET-CHAR fetches character address of variable ; within BASIC to HL. LD ($5B5F),HL ; save character position in X_PTR. LD HL,($5B57) ; 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 preceding the line number of the ; last RESTORE command. LD A,(HL) ; fetch character CP $2C ; is it a comma ? JR Z,READ_1 ; forward, if so, to READ-1 ; else all data in this statement has been read so look for next DATA token. LD E,$E4 ; prepare token 'DATA' CALL LOOK_PROG ; routine LOOK-PROG finds the token JR NC,READ_1 ; forward, if 'DATA' found, to READ-1 ; else report the error. REPORT_E RST 30H ; ERROR-1 DEFB $0D ; Error Report: Out of DATA ; --- 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 types match and advancing CH_ADD. RST 18H ; GET-CHAR fetches adjusted character position LD ($5B57),HL ; store back in DATADD LD HL,($5B5F) ; fetch original READ statement pointer from X_PTR LD (IY+$26),$00 ; nullify X_PTR_hi as redundant. CALL TEMP_PTR2 ; routine TEMP-PTR2 restores the READ character ; address to CH_ADD. READ_2 RST 18H ; GET-CHAR CP $2C ; is it ',' indicating more variables to read ? JR Z,READ_3 ; back, if so, to READ-3 CALL CHECK_END ; routine CHECK-END checks that nothing ; follows and returns if checking syntax >> RET ; return from here in runtime to STMT-RET. ; ------------------ ; THE 'DATA' COMMAND ; ------------------ ; e.g. DATA 1, 2, "text", score-1, a$(location, room, object), FN r(49), ; wages - tax, TRUE, The meaning of life ; In runtime this 'command' is passed by but the syntax is checked when such ; a statement is found while parsing a line. DATA CALL SYNTAX_Z ; routine SYNTAX-Z to check status JR NZ,DATA_2 ; forward, if in runtime, to DATA-2 ; The syntax path continues. DATA_1 CALL SCANNING ; routine SCANNING to check syntax of expression CP $2C ; is following character a comma ? CALL NZ,CHECK_END ; if not, routine CHECK-END checks that ; statement is complete. Will make an early ; exit if it is. >>> RST 20H ; NEXT-CHAR advances past comma. JR DATA_1 ; loop back to DATA-1 ; --- DATA_2 LD A,$E4 ; in runtime, set token to 'DATA' and continue ; into the PASS-BY routine. ; ------------------------ ; THE 'PASS BY' SUBROUTINE ; ------------------------ ; This routine is used to backtrack to a command token and then forward to ; the next statement in runtime. ; The A register contains the required token - either $E4 (DATA) from above, ; or $CE (DEF FN) when called. PASS_BY LD B,A ; Give BC enough space to find the token. CPDR ; Compare decrement and repeat. (Only use). ; Work backwards until keyword is found which ; is the 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 ; --------------------- ; THE '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. RESTORE CALL FIND_LINE ;+ routine FIND-INT2 puts integer in BC. ;+ Note. B is now checked against limit $3F ;+ and an error generated if higher. ; this entry point is used from RUN command with BC holding zero 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 ($5B57),HL ; update the dynamic system variable DATADD. RET ; return to STMT-RET (or RUN) ; ----------------------- ; THE '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. 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,($5B78) ; use the lower two bytes at FRAMES1. RAND_1 LD ($5B76),BC ; place in SEED system variable. RET ; return to STMT-RET ; ---------------------- ; THE '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. CONTINUE LD HL,($5B6E) ; fetch OLDPPC line number. LD D,(IY+$36) ; fetch OSPPC statement. JR GO_TO_2 ; forward to GO-TO-2 ; ------------------- ; THE '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. GO_TO CALL FIND_LINE ;+ 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, if higher, to REPORT-B ; This call entry point is used to update the system variables e.g. by RETURN. GO_TO_2 LD ($5B42),HL ; save line number in NEWPPC LD (IY+$0A),D ; and statement in NSPPC RET ; to STMT-RET (or GO-SUB command) ; ----------------- ; THE 'OUT' COMMAND ; ----------------- ; Syntax has been entirely checked and the two comma-separated values are on ; the calculator stack. OUT_0 CALL TWO_PARAM ; routine TWO-PARAM fetches values to BC and A. OUT (C),A ; perform the operation. RET ; return to STMT-RET. ; ------------------ ; THE '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 the system variables. 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. ; ------------------------------------- ; THE 'FETCH TWO PARAMETERS' SUBROUTINE ; ------------------------------------- ; This routine fetches a byte and word from the calculator stack producing an ; error if either is out of range. TWO_PARAM CALL FP_TO_A ; routine FP-TO-A JR C,REPORT_Bb ; forward, with 8-bit overflow, to REPORT-B ; 'Integer out of range' JR Z,TWO_P_1 ; skip forward, if positive, to TWO-P-1 NEG ; negative numbers are made positive. TWO_P_1 PUSH AF ; save the byte value CALL FIND_INT2 ; routine FIND-INT2 gets 16-bit integer to BC POP AF ; restore the byte value RET ; return ; ---------------------------- ; THE 'FIND INTEGERS' ROUTINES ; ---------------------------- ; 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. ; -> FIND_INT1 CALL FP_TO_A ; routine FP-TO-A JR FIND_I_1 ; forward to common exit routine at FIND-I-1 ; --- ; -> FIND_INT2 CALL FP_TO_BC ; routine FP-TO-BC ; The common exit routine checks that numbers are positive and do not overflow FIND_I_1 JR C,REPORT_Bb ; skip forward, with overflow, to REPORT-Bb RET Z ; return if BC (or A) is positive. REPORT_Bb RST 30H ; ERROR-1 DEFB $0A ; Error Report: Integer out of range ; ------------------------------ ; THE NEW 'FIND LINE' SUBROUTINE ; ------------------------------ ;+ This new routine is used in place of FIND_INT2 to validate the line numbers ;+ that it fetches. FIND_LINE CALL FIND_INT2 ;+ Routine gets 16 bit integer in BC. LD H,B ; LD L,C ; LD A,B ;+ Fetch high byte. CP $40 ;+ Compare with the system limit. JR NC,REPORT_Bb ;+ Back, if higher, than 16383 to ERROR_Bb ;+ 'Integer out of range' LD D,$00 ;+ Useful return value. RET ;+ Return. ; ---------------------------- ; THE NEW 'CLEAR HASH' ROUTINE ; ---------------------------- ; This routine responds to the command 'CLEAR #' by closing the sixteen ; streams in turn. Any pending printer output is flushed but network output ; is discarded. A hash has been found and it remains to check that nothing ; follows. CLR_HASH RST 20H ;+ NEXT_CHAR CALL CHECK_END ;+ CHECK_END quits if checking syntax >> ; The runtime path. LD A,16 ;+ Set stream to sixteen NMI_STRMS SET 6,(IY+$3B) ;+ Set T_ADDR_hi to indicate no Network EOF. ALL_STRMS DEC A ;+ pre-decrement PUSH AF ;+ save stream and result flag. CALL STR_DATA1 ;+ get the offset CALL NZ,CLOSE_OK ;+ CLOSE the stream if it's open. POP AF ;+ JR NZ,ALL_STRMS ;+ do all sixteen RET ;+ Return. ; ----------------- ; THE 'RUN' COMMAND ; ----------------- ; This command runs a program starting at an optional line. ; It performs a 'RESTORE 0' then CLEAR RUN CALL GO_TO ; routine GO-TO puts line number in ; system variables. ;;; LD BC,$0000 ; prepare to set DATADD to first line. LD B,D ;+ LD C,D ;+ 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 ; ------------------- ; THE '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. ; Notice also that if an error occurs then the GOSUB stack is not cleared. CLEAR RST 18H ; GET_CHAR CP $23 ; is character a '#' ? JR Z,CLR_HASH ; back if so. CALL FETCH_NUM ;+ routine FETCH_NUM checks for numeric ;+ expression and stacks in run-time defaulting ;+ to zero. CALL CHECK_END ; routine CHECK-END quits if syntax path. CALL FIND_INT2 ; routine FIND-INT2 fetches address to BC. CLEAR_RUN LD A,B ; test for OR C ; zero. JR NZ,CLEAR_1 ; skip, if not zero, to CLEAR-1 LD BC,($5BB2) ; use the existing value of RAMTOP if zero. CLEAR_1 PUSH BC ; save RAMTOP value. LD DE,($5B4B) ; fetch VARS ;;; LD HL,($5B59) ; fetch E_LINE ;;; DEC HL ; adjust to point at variables end-marker. CALL L_EL_DHL ;+ NEW routine with above code. CALL RECLAIM_1 ; routine RECLAIM-1 reclaims the space used by ; the variables, setting BC to zero. ; Note. A call to REST_RUN here would execute a RESTORE as per BASIC manual ; but it is difficult to decide if CLEAR should execute a RESTORE. Vickers ; merely points out that the ROM doesn't. CALL CLS ; routine CLS to clear screen. LD HL,($5B65) ; fetch STKEND the start of free memory. ;;; LD DE,$0032 ; allow for another 50 bytes. LD E,$32 ; 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,($5BB4) ; 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 ; skipa, if in actual RAM, to CLEAR-2 REPORT_M RST 30H ; ERROR-1 DEFB $15 ; Error Report: RAMTOP no good ; Now, even if RAMTOP has not moved, the GOSUB stack is cleared and ; initialized. CLEAR_2 EX DE,HL ; transfer RAMTOP value to HL. LD ($5BB2),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 ($5B3D),SP ; make ERR_SP point to location. EX DE,HL ; put STMT-RET in HL. JP (HL) ; and go there directly. ; -------------------- ; THE '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 ; plus 1 are placed on the GO SUB stack as a RETURN point. 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,($5B45) ; 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 ($5B3D),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. ; -------------------------- ; THE 'TEST ROOM' SUBROUTINE ; -------------------------- ; This routine is used on many occasions when extending a dynamic area ; upwards or the GO SUB stack downwards. TEST_ROOM LD HL,($5B65) ; fetch STKEND ADD HL,BC ; add the supplied test value JR C,REPORT_4 ; forward, if over $FFFF, to REPORT-4 ; 'Out of memory' EX DE,HL ; The result was less so transfer to DE LD HL,$0050 ; test against another 80 bytes ADD HL,DE ; anyway JR C,REPORT_4 ; forward, if this passes $FFFF, to REPORT-4 ; 'Out of memory' SBC HL,SP ; if less than the machine stack pointer RET C ; then return - OK. ; Register HL contains the negated number of ; free bytes. REPORT_4 LD L,$03 ; prepare 'Out of memory' JP ERROR_3 ; jump back to ERROR-3 ; Note. this error can't be trapped at $0008 ; ------------------------------ ; THE 'FREE MEMORY' USER ROUTINE ; ------------------------------ ; This routine is not used by the ROM but allows users to evaluate ; approximate free memory with PRINT 65536 - USR address. ; Note. It has been moved, for stability, to location ninety three decimal. ; -------------------- ; THE '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 GO SUB stack. Both grow ; downwards, the machine stack by two bytes, the GO SUB stack by 3 bytes. ; The highest location is a statement byte followed by a two-byte line number. 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, with a match, to REPORT-7 ; 'RETURN without GO SUB' ; 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 ($5B3D),SP ; adjust ERR_SP to point to new stack pointer PUSH BC ; now re-stack the address STMT-RET JP GO_TO_2 ; back to GO-TO-2 ; to update statement and line system variables ; and exit indirectly to the address just pushed ; on the stack. ; --- REPORT_7 PUSH DE ; replace the end-marker. PUSH HL ; now restore the error address ; as will be required in a few clock cycles. RST 30H ; ERROR-1 DEFB $06 ; Error Report: RETURN without GOSUB ; Note. 'GO SUB' won't fit in message. ; ------------------- ; THE 'PAUSE' COMMAND ; ------------------- ; The PAUSE command takes as its parameter the number of interrupts ; for which to wait. PAUSE 50 pauses for about a second in the UK. ; PAUSE 60 waits for the same time in the USA. ; PAUSE 0 pauses indefinitely. ; Both forms can be finished early by pressing a key. PAUSE CALL FIND_INT2 ; routine FIND-INT2 puts value in BC PAUSE_1 HALT ; wait for an interrupt. DEC BC ; decrease the counter. LD A,B ; test if the OR C ; result is zero. JR Z,PAUSE_END ; forward, if so, to PAUSE-END LD A,B ; test if AND C ; now $FFFF INC A ; that is, initially zero. JR NZ,PAUSE_2 ; skip forward, if not, to PAUSE-2 INC BC ; restore counter to zero. PAUSE_2 BIT 5,(IY+$01) ; test FLAGS - has a new key been pressed ? JR Z,PAUSE_1 ; back, if not, to PAUSE-1 PAUSE_END RES 5,(IY+$01) ; update FLAGS - signal no new key RET ; Return. ; -------------------------------- ; THE 'CHECK FOR BREAK' SUBROUTINE ; -------------------------------- ; 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. 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. ; -------------------- ; THE 'DEF FN' COMMAND ; -------------------- ; e.g. DEF FN r$(a$,a) = a$(a TO ) ; this 'command' is ignored in runtime but has its syntax checked during ; line-entry. DEF_FN CALL SYNTAX_Z ; routine SYNTAX-Z JR Z,DEF_FN_1 ; forward, if parsing, to DEF-FN-1 LD A,$CE ; else in runtime load A with 'DEF FN' and JP PASS_BY ; jump back to PASS-BY ; --- ; The syntax path continues here. DEF_FN_1 SET 6,(IY+$01) ; set FLAGS - assume numeric result CALL ALPHA ; call routine ALPHA JR NC,REPORT_Cd ; forward, if not, to DEF-FN-4 ; 'Nonsense in BASIC' RST 20H ; NEXT-CHAR CP $24 ; is character '$' ? JR NZ,DEF_FN_2 ; forward, if not type string, to DEF-FN-2 ;;; RES 6,(IY+$01) ; set FLAGS - signal string result. CALL STR_RSLT ;+ RST 20H ; get NEXT-CHAR DEF_FN_2 CP $28 ; is character '(' ? JR NZ,REPORT_Cd ; forward, if not, to DEF-FN-7 ; 'Nonsense in BASIC' RST 20H ; NEXT-CHAR CP $29 ; is character ')' ? JR Z,DEF_FN_6 ; forward, if null arguments, to DEF-FN-6 DEF_FN_3 CALL ALPHA ; routine ALPHA checks that it is the expected ; alphabetic character. DEF_FN_4 JR NC,REPORT_Cd ; jump, if not, to REPORT-C ; '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 character a '$' ? JR NZ,DEF_FN_5 ; forward, if not string argument, to DEF-FN-5 EX DE,HL ; save pointer to '$' in DE RST 20H ; NEXT-CHAR re-initializes HL and advances 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 ; forward, if not, to DEF-FN-6 RST 20H ; else NEXT-CHAR JR DEF_FN_3 ; and back to DEF-FN-3 ; --- DEF_FN_6 ;;; CP $29 ; is character the closing ')' ? ;;; JR NZ,REPORT_Cd ; forward, if not, to DEF-FN-7 ;;; RST 20H ; get NEXT-CHAR CALL RBRKT_NXT ;+ check for right-hand bracket and advances. CP $3D ; is it '=' ? JR NZ,REPORT_Cd ; to DEF-FN-7 ; 'Nonsense in BASIC' RST 20H ; address NEXT-CHAR LD A,($5B3B) ; get FLAGS which has been set above PUSH AF ; and preserve CALL SCANNING ; routine SCANNING checks syntax of expression ; and also sets flags. 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. ;;; DEF_FN_7 JP NZ,REPORT_C ; jump back to REPORT-C if the expected result ; is not the same type. ; 'Nonsense in BASIC' ;;; CALL CHECK_END ; routine CHECK-END will return early CALL Z,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. REPORT_Cd RST 30H ;+ ERROR-1 DEFB $0B ;+ Error Report: Nonsense in BASIC ; -------------------------- ; THE 'UNSTACK-Z' SUBROUTINE (6) ; -------------------------- ; 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. 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. ; -------------------- ; THE '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. LPRINT LD A,$03 ; the printer channel JR PRINT_1 ; forward to PRINT-1 ; ------------------- ; THE 'PRINT' COMMAND ; ------------------- ; 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. PRINT LD A,$02 ; the stream for the upper screen. ; The LPRINT command joins here. PRINT_1 CALL CHN_O_SYN ;+ routine opens channel in runtime. ;;; CALL SYNTAX_Z ; routine SYNTAX-Z checks if program running ;;; CALL NZ,CHAN_SLCT ; routine CHAN-OPEN if so (calls TEMPS) ;;; 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 in runtime >>> ; ------------------------ ; THE 'PRINT 2' SUBROUTINE ; ------------------------ ; This subroutine is called from above and also from INPUT. 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. 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, if so, to PRINT-3 PRINT_4 CP $29 ; return now if this is ')' from input-item. ; (see INPUT.) RET Z ; or continue and print carriage return in ; runtime ; ----------------------------------- ; THE 'PRINT CARRIAGE RETURN' ROUTINE ; ----------------------------------- ; This routine which continues from above prints a carriage return ; in run-time only. It is also called once from PRINT-POSN. PRINT_CR CALL UNSTACK_Z ; routine UNSTACK_Z quits if checking syntax. LD A,$0D ; prepare a carriage return RST 10H ; PRINT-A outputs to current channel. ;;; RET ; return. JP CR_END ;+ NEW test for network before returning. ; ---------------------------- ; THE 'PRINT ITEMS' SUBROUTINE ; ---------------------------- ; 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 PR_ITEM_1 RST 18H ; GET-CHAR CP $AC ; is character 'AT' ? JR NZ,PR_ITEM_2 ; forward, if not, to PR-ITEM-2 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. ; --- PR_ITEM_2 CP $AD ; is character 'TAB' ? JR NZ,PR_ITEM_3 ; forward, if not, to PR-ITEM-3 RST 20H ; NEXT-CHAR to address next character CALL EXPT_1NUM ; routine EXPT-1NUM checks for numeric ; expression and stacks it in run-time. 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. 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$ PR_ITEM_3 CALL CO_TEMP_3 ; routine CO-TEMP-3 will print any colour RET NC ; items - return if success. ; Now consider a change in the output stream. ; Note. as this is called from IN_ITEM it can also effect a change in the ; stream used for INPUT. 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 quits if not runtime. BIT 6,(IY+$01) ; test FLAGS - Numeric or string result ? ; Note. the next two instructions have been switched so that STK_FETCH ; can return zero if BC is zero (used elsewhere). JP NZ,PRINT_FP ; to PRINT-FP to print if numeric >>> CALL STK_FETCH ; routine STK-FETCH if string. ; note flags now affected. ; It was a string expression - start in DE, length in BC ; Now enter a loop to print it 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. ; -------------------------------- ; THE 'END OF PRINTING' SUBROUTINE ; -------------------------------- ; 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. PR_END_Z CP $29 ; is character a ')' ? RET Z ; return if so - e.g. INPUT (p$); a$ 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 with match. ; e.g. PRINT a : ; ---------------------------- ; THE 'PRINT POSITION' ROUTINE ; ---------------------------- ; This routine considers a single positional character ';', ',', ''' PR_POSN_1 RST 18H ; GET-CHAR CP $3B ; is it ';' ? ; i.e. print from last position. JR Z,PR_POSN_3 ; forward, if so, to PR-POSN-3 ; 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. 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. 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 ; skip forward, if not, to PR-POSN-4 POP BC ; drop return address if at end. PR_POSN_4 CP A ; reset the zero flag. RET ; and return to loop or quit. ; ----------------------------- ; THE 'ALTER STREAM' SUBROUTINE ; ----------------------------- ; This routine is called from PRINT ITEMS above, and also LIST as in LIST #15 STR_ALTER RST 18H ;+ GET_CHAR 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 CHAN_CHK CALL FIND_INT1 ; routine FIND-INT1 gets number off stack CP $10 ; stream must be range 0 - 15 decimal. JP NC,REPORT_O ; jump back, if not, to REPORT-O ; 'Invalid stream'. CALL CHAN_SLCT ; Routine CHAN-OPEN AND A ; Clear carry - signal item dealt with. RET ; Return. ; ------------------- ; THE 'INPUT' COMMAND ; ------------------- ; This command inputs by default from the stream 1. On the standard ; Spectrum this is selected before CLS-LOWER so the channel that is ; in force is the system 'K' channel and can only be overridden by the user ; using INPUT #1. INPUT CALL SYNTAX_Z ; routine SYNTAX-Z to check if in runtime. JR Z,INPUT_1 ; forward, if checking syntax, to INPUT-1 LD A,$01 ; select stream 1 which is reserved for INPUT. CALL CHAN_SLCT ; routine CHAN-OPEN opens the channel. CALL IN_CHAN_K ;+ routine IN-CHAN-K tests if keyboard in use. ;;; CALL CLS_LOWER ; routine CLS-LOWER wrongly clears lower screen. CALL Z,CLS_LOWER ;+ routine CLS-LOWER clears the lower screen ;+ and sets DF_SZ to two and TV_FLAG to $01 ;+ but only if stream 1 is the keyboard. INPUT_1 LD (IY+$02),$01 ; update TV_FLAG - signal lower screen in use ; ensuring that the correct set of system ; variables are updated and that the border ; colour is used. ; Note. The Complete Spectrum ROM Disassembly incorrectly names DF-SZ as the ; system variable that is updated above and if, you make this unnecessary ; alteration then there will be two blank lines between the lower screen and ; the upper screen areas which will also scroll wrongly. 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,($5B88) ; fetch S_POSN current line/column of ; the upper screen. LD A,($5B6B) ; 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, if not, to INPUT-2 ; 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. INPUT_2 LD ($5B88),BC ; set S_POSN update upper screen line/column. LD A,$19 ; subtract from twenty five SUB B ; the new line number. LD ($5B8C),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 >>. ; --------------------------- ; THE 'INPUT ITEM' SUBROUTINE ; --------------------------- ; This subroutine deals with the input items and print items from the current ; input channel which was defaulted to 'K' above. 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, if not, to IN-ITEM-2 ; any variables within brackets 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 ')' ? ;;; JR NZ,REPORT_Cy ; forward, if not, to REPORT-Cy ;;; RST 20H ; NEXT-CHAR CALL RBRKT_NXT ;+ check for right-hand bracket and advance. JP IN_NEXT_2 ; jump forward to IN-NEXT-2 ; --- ; Consider INPUT LINE IN_ITEM_2 CP $CA ; is the character the token 'LINE' ? JR NZ,IN_ITEM_3 ; forward, if not, to IN-ITEM-3 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 Z,IN_PROMPT ; forward, if string, to IN-PROMPT ; to set up workspace. REPORT_Cy RST 30H ;+ ERROR-1 DEFB $0B ;+ Error Report: Nonsense in BASIC ; --- ; the jump was here for other variables. ; Note. the character '#' will cause a jump to IN_NEXT_1 IN_ITEM_3 CALL ALPHA ; routine ALPHA checks if character is ; a suitable variable name. JP NC,IN_NEXT_1 ; jump forward, if not, to IN-NEXT-1 CALL CLASS_01 ; routine CLASS-01 returns destination ; address of variable to be assigned. RES 7,(IY+$37) ; update FLAGX - signal not INPUT LINE. ; The two paths converge here. IN_PROMPT CALL SYNTAX_Z ; routine SYNTAX-Z JP Z,IN_NEXT_2 ; forward to IN-NEXT-2 if checking syntax. ; Continue in runtime. CALL SET_WORK ; routine SET-WORK clears workspace. LD HL,$5B71 ; 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 CR. LD C,$01 ;+ initialize space required to one for the CR. BIT 7,(HL) ; test FLAGX - INPUT LINE in use ? JR NZ,IN_PR_2 ; forward, if so, to IN-PR-2 ; as that is all the space that is required. ; If not INPUT LINE then the result can be numeric or string. LD A,($5B3B) ; 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, if so, to IN-PR-1 LD C,$03 ; increase space to three bytes for the ; pair of surrounding quotes. IN_PR_1 OR (HL) ; if numeric result, set bit 6 of FLAGX. LD (HL),A ; and update system variable IN_PR_2 CALL BC_SPACE0 ; 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, if not, to IN-PR-3 BIT 1,C ;+ test if quotes required. JR Z,IN_PR_3 ;+ skip forward, if not, to IN_PR_3 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. IN_PR_3 LD ($5B5B),HL ; set keyboard cursor K_CUR to HL BIT 7,(IY+$37) ; test FLAGX - is this INPUT LINE ? JR NZ,IN_VAR_3 ; forward, if so, to IN-VAR-3 as input will ; be accepted without checking its syntax. ; prepare to parse the numeric or string input if not INPUT LINE. RST 18H ;+ ;;; LD HL,($5B5D) ; fetch CH_ADD PUSH HL ; and save on stack. LD HL,($5B3D) ; fetch ERR_SP PUSH HL ; and save on stack 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, if not keyboard, to IN-VAR-2 ; Now update the error pointer so that user is able to alter until correct. LD ($5B3D),SP ; set ERR_SP to point to IN-VAR-1 on stack. IN_VAR_2 LD HL,($5B61) ; set HL to WORKSP - start of workspace. CALL REMOVE_FP ; routine REMOVE-FP removes floating point ; forms when looping in the 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 SET_ER_FF ;+ NEW 3-byte call. 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 its 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. IN_VAR_3 CALL EDITOR ; routine EDITOR is called for input ; When ENTER received rejoin other route but with no syntax check. ; Paths for INPUT and INPUT LINE converge here. IN_VAR_4 ;;; LD (IY+$22),$00 ; set K_CUR_hi to a low value LD (IY+$22),A ;+ set K_CUR_hi to a low value so that cursor ;+ no longer appears in the input line. (A=13) CALL IN_CHAN_K ; routine IN-CHAN-K tests if keyboard in use. 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,($5B82) ; 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. IN_VAR_5 LD HL,$5B71 ; 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 address of previous ; error handler. LD ($5B3D),HL ; set ERR_SP to point to it. POP HL ; drop original CH_ADD which points to ; INPUT command in BASIC line. LD ($5B5F),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,($5B5F) ; fetch stored CH_ADD value from X_PTR. ;;; LD (IY+$26),$00 ; set X_PTR_hi so that it is no longer relevant. LD (IY+$26),A ;+ set X_PTR_hi so that it is irrelevant. (A=13) LD ($5B5D),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 IN_VAR_6 LD HL,($5B63) ; STKBOT points to the end of the input. LD DE,($5B61) ; 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_s ; routine STK-STO-$ 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. ; --- ; The jump was to here when ALPHA found more items while looking for ; a variable name. The routine PR_ITEM_1 is called for the first time ; which allows the stream to be altered if the character is '#'. IN_NEXT_1 CALL PR_ITEM_1 ; routine PR-ITEM-1 considers further items. 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. IN_ASSIGN LD HL,($5B61) ; fetch WORKSP start of input LD ($5B5D),HL ; set CH_ADD to first character RST 18H ; GET-CHAR ignoring any leading white-space. CP $E2 ; is it 'STOP' JR Z,IN_STOP ; forward, if so, to IN-STOP LD A,($5B71) ; 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 character a carriage return ? RET Z ; return with a match. ; 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. REPORT_Cb RST 30H ; ERROR-1 DEFB $0B ; Error Report: Nonsense in BASIC ; --- ;;; IN_STOP CALL SYNTAX_Z ; routine SYNTAX-Z (UNSTACK_Z?) ;;; RET Z ; return if checking syntax IN_STOP CALL UNSTACK_Z ;+ return if checking syntax. ;+ as user wouldn't see error report. ;+ but generate visible error report ;+ on second invocation. REPORT_H RST 30H ; ERROR-1 DEFB $10 ; Error Report: STOP in INPUT ; ----------------------------------- ; THE 'TEST FOR CHANNEL K' SUBROUTINE ; ----------------------------------- ; This subroutine is called once from the INPUT command to check if ; the input routine in use is the one for the keyboard. ; It returns with the zero flag set for the keyboard and reset for the ; network and RS232. ; Note. this routine, essentially the same as set out here, has been moved ; to a position before the NUMBER routine with which it is now combined. ;;; IN_CHAN_K LD HL,($5B51) ; 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. ; -------------------------- ; THE '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 were 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 ; channel 'S' the current channel when not checking syntax. ; ; ----------------------------------------------------------------- ;;; 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. CO_TEMP_2 CALL CO_TEMP_3 ; routine CO-TEMP-3 to output colour control. RET C ; return if nothing more to output. -> CALL CLASS_0C ;+ New routine to check for ';' or ',' and ;+ advance CH_ADD if so else produce error. JR CO_TEMP_2 ;+ back, if no error to CO_TEMP_2 ;;; 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, if so, to CO-TEMP-1 ;;; JR REPORT_Cb ; 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. CO_TEMP_3 CP $D9 ; compare addressed character to 'INK' RET C ; return if less. CP $DF ; compare with 'OUT' CCF ; Complement Carry Flag RET C ; return if greater than 'OVER' ($DE). ; The token expects one parameter so advance CH_ADD PUSH AF ; save the colour token e.g. 'PAPER'. RST 20H ; NEXT-CHAR advances address. POP AF ; restore token and continue. ; -> This entry point used by CLASS-07. e.g. the command PAPER 6. CO_TEMP_4 SUB $C9 ; reduce to control character $10 (INK) ; through $15 (OVER) and clears CARRY flag. PUSH AF ; save control and carry flag. CALL EXPT_1NUM ; routine EXPT-1NUM stacks addressed parameter ; on the calculator stack. POP AF ; restore control and clear carry flag. ;;; AND A ; clear carry for success (already clear). CALL UNSTACK_Z ; routine UNSTACK_Z returns if checking syntax. ; In runtime, output the two control characters. There is no need to ; assimilate the two codes first. ;;; PUSH AF ; save again RST 10H ;+ outputs the control altering output address. 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 restoring channel. 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. ; First consider INK and PAPER. CO_TEMP_5 SUB $11 ; reduce range $FF-$04 LD E,$00 ;+ Set E to zero. ;;; ADC A,$00 ; add in carry if INK ADC A,E ;+ add in carry if INK JR Z,CO_TEMP_7 ; forward to CO-TEMP-7 with INK and PAPER. ; Now consider FLASH and BRIGHT. SUB $02 ; reduce range $FF-$02 ;;; ADC A,$00 ; add carry if FLASH ADC A,E ;+ add carry if FLASH JR Z,CO_TEMP_C ; forward to CO-TEMP-C with FLASH and BRIGHT. ; Now consider remaining INVERSE and OVER. INC E ;+ now make E=1 ;;; CP $01 ; is it 'INVERSE' ? CP E ; is it 'INVERSE' ? LD A,D ; fetch parameter for INVERSE/OVER ;;; LD B,$01 ; prepare OVER mask setting bit 0. LD B,E ; prepare OVER mask setting bit 0. JR NZ,CO_TEMP_6 ; forward to CO-TEMP-6 if OVER ; Deal with INVERSE. RLCA ; shift bit 0 RLCA ; to bit 2 LD B,$04 ; set bit 2 of mask for INVERSE. ; The OVER path rejoins here. 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,$5B91 ; address system variable P_FLAG JR CO_CHANGE ; forward to exit via routine CO-CHANGE ; --- ; the branch was here with INK and PAPER and carry set for INK. 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 ; the INK path rejoins here. CO_TEMP_8 LD C,A ; value to C LD A,D ; fetch parameter CP $0A ; is it less than 10 decimal ? JR C,CO_TEMP_9 ; forward, if so, to CO-TEMP-9 ; INK 10 etc. is not allowed. REPORT_K RST 30H ; ERROR-1 DEFB $13 ; Error Report: Invalid colour ; --- CO_TEMP_9 LD HL,$5B8F ; 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) CO_TEMP_A LD C,A ; save A in C 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 ; ---------------------------- ; THE 'COLOUR CHANGE' ROUTINES ; ---------------------------- ; This routine addresses a system variable ATTR_T, MASK_T or P-FLAG in HL. ; colour value in A, mask in B. 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 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, if FLASH, to CO-TEMP-D RRCA ; rotate bit 7 to bit 6 LD B,$40 ; mask for BRIGHT - %01000000 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, if eight, to CO-TEMP-E CP $02 ; test if 0 or 1 JR NC,REPORT_K ; back, if not, to REPORT-K ; 'Invalid colour' CO_TEMP_E LD A,C ; value to A LD HL,$5B8F ; address ATTR_T CALL CO_CHANGE ; routine CO-CHANGE addressing ATTR_T LD A,C ; fetch value RRCA ; for flash8/bright8 complete the 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. ; -------------------- ; THE '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. ; This is a CLASS_0 command so syntax is checked by the tables and this ; routine is only invoked in runtime. BORDER CALL FIND_INT1 ; routine FIND-INT1 CP $08 ; must be in range 0 (black) to 7 (white) JR NC,REPORT_K ; back, if not, to REPORT-K ; '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 paper number light coloured ? ; i.e. in the range green to white. JR NZ,BORDER_1 ; skip, if so, to BORDER-1 XOR $07 ; make the ink white. BORDER_1 LD ($5B48),A ; update BORDCR with new paper/ink RET ; return. ; --------------------------- ; THE 'PIXEL ADDRESS' ROUTINE ; --------------------------- ; ; PIXEL_ADD LD A,$AF ; load with 175 decimal. SUB B ; subtract the y value. JR C,REPORT_Bz ; 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 of the address 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 ; ---------------------- ; THE 'POINT' SUBROUTINE ; ---------------------- ; The point subroutine is called from s_point via the SCANNING functions ; table. ; Error B unless 0<=x<=255 and 0<=y<=175. ; In accordance with the BASIC manual, parameters must now be positive. POINT_SUB CALL BC_POSTVE ; routine BC_POSTVE but with check on signs. CALL PIXEL_ADD ; routine PIXEL-ADD finds address of pixel ; producing an error if y is > 175. 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. POINT_LP RLCA ; rotate and loop back DJNZ POINT_LP ; to POINT-LP until required pixel at right. AND $01 ; test to give zero or one. JP STACK_A ; jump forward to STACK-A to save result. ; ------------------ ; THE 'PLOT' COMMAND ; ------------------ ; Command Syntax example: PLOT 128,88 ; PLOT CALL BC_POSTVE ; routine BC_POSTVE ;;; CALL PLOT_SUB ; routine PLOT-SUB ;;; JP TEMPs ;?to TEMPs to impose the permanent attributes ;;; ; onto the temporary ones as they may have been ;;; ; disturbed by embedded colour items ?? ; --------------------- ; 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 although the colours may change. PLOT_SUB LD ($5B7D),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. 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, if so, to PL-TST-IN ; was OVER 0. AND B ; combine with mask to blank pixel. PL_TST_IN BIT 2,C ; is it inverse 1 ? JR NZ,PLOT_END ; forward, if so, to PLOT-END XOR B ; switch the pixel CPL ; restore other 7 bits PLOT_END LD (HL),A ; load byte to the screen. JP PO_ATTR ; exit via PO-ATTR to set colours for cell. ; --- REPORT_Bz RST 30H ; ERROR-1 DEFB $0A ; Error Report: Integer out of range ; ---------------------------------------------- ; THE 'CALCULATOR STACK TO BC REGISTERS' ROUTINE ; ---------------------------------------------- ; ; 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 ; Return. ; --------------------------------------------- ; THE 'CALCULATOR STACK TO ACCUMULATOR' ROUTINE ; --------------------------------------------- ; This routine puts the last value on the calculator stack into the ; accumulator deleting the last value. 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. JR C,REPORT_Bz ; forward, if >= 255, to REPORT-Bc ; 'Integer out of range' 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. ; -------------------- ; THE 'CIRCLE' COMMAND ; -------------------- ; Syntax has been partly checked using the class for the DRAW command. CIRCLE RST 18H ; GET-CHAR CP $2C ; Is character the required comma ? JP NZ,REPORT_C ; Jump, if not, to REPORT-C ;;; RST 20H ; NEXT-CHAR ;;; CALL EXPT_1NUM ; Routine EXPT-1NUM fetches the radius. ;;; CALL CHECK_END ; Routine CHECK-END will return here CALL CHK_END_1 ; above 3 routines combined. ; Continue in runtime. 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 exponent byte CP $81 ; Compare to exponent for one JR NC,C_R_GRE_1 ; Forward to C-R-GRE-1 if circle radius is ; greater than a half. ; If the diameter is no greater than one then delete the radius and plot ; the single point. RST 28H ;; FP-CALC DEFB $02 ;;delete ; delete the radius from stack. DEFB $38 ;;end-calc JR PLOT ; Back to PLOT to just plot x,y. ; --- ; Continue if the radius is greater than 1. 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 x, y, r, pi/2. ; Cleverly multiply by four to form the circumference. LD (HL),$83 ; bump exponent x, y, r, 2*PI RST 28H ;; FP-CALC x, y, r, 2*PI DEFB $C5 ;;st-mem-5 store 2*PI in mem-5 DEFB $02 ;;delete x, y, r. DEFB $38 ;;end-calc x, y, r. CALL CD_PRMS1 ; routine CD_PRMS1 forms circle parameters. 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 ; JUMP to PLOT JR PLOT ;+ use relative jump to PLOT ; --- 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 gets start x-coordinate. ;;; LD L,A ; ;;; PUSH HL ; ;;; CALL FIND_INT1 ; routine FIND-INT1 gets start y-coordinate. ;;; POP HL ; ;;; LD H,A ; ;;; LD ($5B7D),HL ; COORDS CALL STK_TO_BC ; ??? LD L,B ; LD H,C ; LD ($5B7D),HL ; COORDS POP BC ; JP DRW_STEPS ; to DRW-STEPS ; ------------------ ; THE 'DRAW' COMMAND ; ------------------ ; The DRAW command is rather more sophisticated than anything contemplated ; for the ZX80 and ZX81 and, with a third parameter (A), it can draw an arc. ; At this stage, syntax has been partly checked by the class routines and ; the relative 'x, y' parameters have been verified. DRAW RST 18H ; GET-CHAR CP $2C ; is character the optional ',' ? JR Z,DR_3_PRMS ; forward, if so, to DR_3_PRMS CALL CHECK_END ; routine CHECK-END checks that nothing follows. JP LINE_DRAW ; jump forward, in runtime, to LINE-DRAW ; --- ; The branch was here when a comma indicated a third parameter was expected. DR_3_PRMS CALL CHK_END_1 ; following three routines combined. ;;; RST 20H ; NEXT-CHAR advances. ;;; CALL EXPT_1NUM ; routine EXPT-1NUM checks for numeric ;;; CALL CHECK_END ; routine CHECK-END RST 28H ;; FP-CALC x, y, A. DEFB $C5 ;;st-mem-5 x, y, A. DEFB $A2 ;;stk-half x, y, A, 1/2. DEFB $04 ;;multiply x, y, A/2. DEFB $1F ;;sin x, y, sin(A/2) DEFB $31 ;;duplicate x, y, sin(A/2), sin(A/2). DEFB $30 ;;not x, y, sin(A/2), (0/1). DEFB $30 ;;not x, y, sin(A/2), (1/0). DEFB $00 ;;jump-true x, y, sin(A/2). DEFB DR_SIN_NZ - $ ;;to DR_SIN_NZ DEFB $02 ;;delete x, y. DEFB $38 ;;end-calc x, y. JP LINE_DRAW ; to LINE-DRAW ; --- 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 ; Note. any value that has arisen from division is in floating-point form ; and does not require to be re-stacked. ;;; DEFB $3D ;;re-stack DEFB $38 ;;end-calc ; The following tests for adjacent start and end-points but is hardly ; required as it optimizes miniscule arcs at the expense of larger ones. ;;; 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 ;;; --- DR_PRMS CALL CD_PRMS1 ; routine CD_PRMS1 forms draw parameters. PUSH BC ; RST 28H ;; FP-CALC x, y, sin(A/2), Z DEFB $02 ;;delete x, y, sin(A/2) DEFB $E1 ;;get-mem-1 x, y, sin(A/2), sin(a/2). 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 ; ;;; JR C,LINE_DRAW ; JUMP to LINE-DRAW ;;; PUSH BC ; ;;; RST 28H ;; FP-CALC DEFB $01 ;;exchange DEFB $38 ;;end-calc LD A,($5B7D) ; 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,($5B7E) ; 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 ; Restore line-count from machine stack. DRW_STEPS DEC B ; Note. B is a minimum of 4 ;;; JR Z,ARC_END ; to ARC-END (path never taken) JR ARC_START ; to ARC-START ; --- 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 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,($5B7D) ; 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,($5B7E) ; 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 ARC_END RST 28H ;; FP-CALC DEFB $02 ;;delete DEFB $02 ;;delete DEFB $01 ;;exchange DEFB $38 ;;end-calc LD A,($5B7D) ; COORDS-x CALL STACK_A ; routine STACK-A RST 28H ;; FP-CALC DEFB $03 ;;subtract DEFB $01 ;;exchange DEFB $38 ;;end-calc LD A,($5B7E) ; COORDS-y CALL STACK_A ; routine STACK-A RST 28H ;; FP-CALC DEFB $03 ;;subtract DEFB $38 ;;end-calc LINE_DRAW JR DRAW_LINE ; routine DRAW-LINE ;;; CALL DRAW_LINE ; routine DRAW_LINE ;;; JP TEMPs ;?to TEMPs ; --------------------------------------------------- ; THE 'CIRCLE AND DRAW INITIAL PARAMETERS' SUBROUTINE ; --------------------------------------------------- ; ; 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 USE_252 LD A,$FC ; DRAW_SAVE PUSH AF ; CALL STACK_A ; routine STACK-A RST 28H ;; FP-CALC z, A. DEFB $E5 ;;get-mem-5 z, A, G. DEFB $01 ;;exchange z, G, A. DEFB $05 ;;division z, G/A. DEFB $31 ;;duplicate z, G/A, G/A. DEFB $31 ;;+duplicate z, G/A, G/A, G/A. DEFB $20 ;;+cos z, G/A, G/A, cos G/A. DEFB $C3 ;;+st-mem-3 z, G/A, G/A, cos G/A. DEFB $02 ;;+delete z, G/A, G/A. 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 $02 ;;+delete ;;; 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 ; ; -------------------------- ; THE 'DRAW LINE' SUBROUTINE ; -------------------------- ; B=Y C=X D=signY E=signX ; DRAW_LINE CALL STK_TO_BC ; routine STK-TO-BC LD A,C ; load X to accumulator. CP B ; compare to Y. JR NC,DL_X_GE_Y ; forward, if X greater or equal, to DL-X-GE-Y ; Y is greater than X LD L,C ; load L with X ; B is Y PUSH DE ; save signs. XOR A ; LD E,A ; set E to zero. JR DL_LARGER ; to DL-LARGER ; --- DL_X_GE_Y OR C ; check if x is zero RET Z ; return if so LD L,B ; load L with Y LD B,C ; load B with X PUSH DE ; save signs. LD D,$00 ; set D to zero. DL_LARGER LD H,B ; load H with larger LD A,B ; to A also RRA ; LET S = INT (M/2) 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 D_L_DIAG SUB H ; LD C,A ; EXX ; POP BC ; PUSH BC ; JR D_L_STEP ; to D-L-STEP ; --- D_L_HR_VT LD C,A ; PUSH DE ; EXX ; POP BC ; D_L_STEP LD HL,($5B7D) ; 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 ; 'Integer out of range' 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 ; ; --- D_L_RANGE JR Z,D_L_PLOT ; to D-L-PLOT REPORT_Bc RST 30H ; 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. ; ------------------------- ; THE 'SCANNING' SUBROUTINE ; ------------------------- ; Scan expression or sub-expression ; The routine begins and ends with a RST 18H instruction. SCANNING RST 18H ; GET-CHAR LD B,$00 ; Priority marker zero is pushed on stack to ; signify the end of expression when it is ; popped off again. PUSH BC ; Stack the marker byte and proceed to consider ; the first character of the expression. S_LOOP_1 ;;; LD C,A ; place the search character in C. LD HL,SCAN_FUNC-1 ; Address: scan-func CALL INDEXER_0 ; 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 complex ; 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) ; jump to the routine e.g. S-BIN ; making an indirect exit from there. ; ------------------------------------------------------------------------- ; The four service subroutines for routines in the scanning function table ; ------------------------------------------------------------------------- ; PRINT """Hooray!"" he cried." 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. JR Z,REPORT_Cs ; jump forward, if so, to REPORT-C ; 'Nonsense in BASIC'. CP $22 ; is it a quote '"' ? JR NZ,S_QUOTE_S ; back, if not, to S-QUOTE-S 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. S_2_COORD RST 20H ; NEXT-CHAR CP $28 ; is character the opening '(' ? JR NZ,REPORT_Cs ; forward, if not, to S-RPORT-C ; '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 was exit route for SCANNING TST_RBRKT CP $29 ; is it the closing ')' ? S_RPORT_C JR NZ,REPORT_Cs ; jump forward, if not, to REPORT-Cs ; ------------------------- ; THE 'SYNTAX_Z' SUBROUTINE ; ------------------------- ; 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. 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. S_SCRNs_S CALL STK_TO_LC ; NEW routine STK-TO-LC. LD HL,($5B36) ; fetch address of CHARS. ;;; LD DE,$0100 ; fetch offset to chr$ 32 ;;; ADD HL,DE ; and find start of bitmaps. ;;; ; Note. not inc h. ?? INC H ;+ increment high byte to address bitmaps. 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. 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. S_SC_MTCH LD C,A ; load C with inverse mask $00 or $FF LD B,$07 ; count seven more bytes 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. CALL BC_SPACE1 ; BC_SPACES creates the 1 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. 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. S_SCR_STO RET ; (WAS to STK-STO-$) 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 its 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. (Done! SEP-2002) ; 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. S_ATTR_S CALL STK_TO_LC ; NEW 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 ; right. 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 is 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 ; jump forward to STACK-A to store result ; and make an indirect exit. ; --- REPORT_Cs RST 30H ; ERROR_1 DEFB $0B ; Error Report: Nonsense in BASIC ; ----------------------------- ; THE '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. 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_INKEYs -$-1 ; $8F offset to S-INKEY$ DEFB $C4, S_DECIMAL -$-1 ; $E6 offset to S-BIN DEFB $AA, S_SCREENs -$-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 ; -------------------------------- ; THE 'SCANNING FUNCTION' ROUTINES ; -------------------------------- ; These are the 11 subroutines accessed by the above table. ; Addresses S-BIN and S-DECIMAL are the same ; The 1-byte offset limits their location to within 255 bytes of their ; entry in the above table. ; -> S_U_PLUS JP S_NEXT_1 ;+ forward to similar code. ;;; RST 20H ; NEXT-CHAR just ignore ;;; JP S_LOOP_1 ; back to S-LOOP-1 ; --- ; -> 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 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, if checking syntax, to S-Q-PRMS ; In runtime, build the string expression result. CALL BC_SPACES ; routine BC_SPACES creates the space for true ; copy of string in workspace. POP HL ; re-fetch start of quoted text. PUSH DE ; stack DE the start of string in workspace. S_Q_COPY LD A,(HL) ; fetch a character from source. INC HL ; advance the source address. LD (DE),A ; place in destination. INC DE ; advance the destination address. CP $22 ; was it a '"' just copied ? JR NZ,S_Q_COPY ; back, if not, to S-Q-COPY LD A,(HL) ; fetch adjacent character from source. INC HL ; advance the 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. ; If not two adjacent quotes then the terminating quote has just been copied. S_Q_PRMS DEC BC ; decrease the count by 1. POP DE ; restore start of string in workspace. S_STRING LD HL,$5B3B ; Address the FLAGS system variable. RES 6,(HL) ; signal a string result. BIT 7,(HL) ; is syntax being checked ? CALL NZ,STK_STO_s ; routine STK-STO-$ is called in runtime. JR S_INKs_EN ; jump forward to S-CONT-2 ===> ; --- ; -> S_BRACKET RST 20H ; NEXT-CHAR CALL SCANNING ; routine SCANNING is called recursively. ;;; CP $29 ; is it the closing ')' ? ;;; JR NZ,REPORT_Cs ;.jump back, if not, to REPORT-C CALL TST_RBRKT ; test for a right bracket ')' RST 20H ; NEXT-CHAR JR S_INKs_EN ; jump forward to S-CONT-2 ===> ; --- ; -> S_FN JP S_FN_SBRN ; jump forward to S-FN-SBRN. ; --- ; -> S_RND CALL SYNTAX_Z ; routine SYNTAX-Z JR Z,S_RND_END ; forward to S-RND-END if checking syntax. LD BC,($5B76) ; 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 ($5B76),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 S_RND_END JR S_PI_END ; forward to S-PI-END ; --- ; the number PI 3.14159... ; -> 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. S_PI_END JR S_AT_NUM ;+ forward to similar code ending at S_NUMERIC ;;; RST 20H ; NEXT-CHAR ;;; JP S_NUMERIC ; jump forward to S-NUMERIC ; --- ; -> S_INKEYs 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. ; else read a key from the keyboard. LD HL,$5B3B ; fetch FLAGS RES 6,(HL) ; signal string result. BIT 7,(HL) ; checking syntax ? JR Z,S_INKs_EN ; forward, if so, to S-INK$-EN CALL KEY_SCAN ; routine KEY-SCAN key in E, shift in D. LD C,$00 ; prepare the length of an empty string JR NZ,S_IKs_STK ; forward, if no key returned, to S-IK$-STK ; to store empty string. CALL K_TEST ; routine K-TEST get main code in A JR NC,S_IKs_STK ; forward, if invalid, to S-IK$-STK ; to stack null string. DEC D ; D is expected to be FLAGS so set bit 3 $FF ; 'L' Mode so no keywords. ;;; LD E,A ; main key to E ; C is MODE 0 'KLC' from above still. CALL K_DECODE2 ; routine K_DECODE but skip first. ;;; PUSH AF ; save the code ;;; LD BC,$0001 ; make room for one character CALL BC_SPACE1 ; routine BC_SPACE1 creates a single space. ;;; POP AF ; bring the code back LD (DE),A ; put the key in workspace ;;; LD C,$01 ; set C length to one (BC=1) S_IKs_STK LD B,$00 ; set high byte of length to zero CALL STK_STO_s ; routine STK-STO-$ S_INKs_EN JP S_CONT_2 ; to S-CONT-2 ===> ; --- ; -> S_SCREENs CALL S_2_COORD ; routine S-2-COORD CALL NZ,S_SCRNs_S ; routine S-SCRN$-S in runtime. RST 20H ; NEXT-CHAR JP S_STRING ; Back to S-STRING to stack runtime result ; --- ; -> S_ATTR CALL S_2_COORD ; routine S-2-COORD CALL NZ,S_ATTR_S ; routine S-ATTR-S in runtime. S_AT_NUM RST 20H ; NEXT-CHAR JR S_NUMERIC ; forward to S-NUMERIC ; --- ; -> S_POINT CALL S_2_COORD ; routine S-2-COORD CALL NZ,POINT_SUB ; routine POINT-SUB in runtime. JR S_AT_NUM ;+ back to similar sequence ending at S_NUMERIC ;;; RST 20H ; NEXT-CHAR ;;; JR S_NUMERIC ; forward to S-NUMERIC ; ----------------------------- ; ==> The branch was here if not in table of exceptions. S_ALPHNUM CALL ALPHANUM ; routine ALPHANUM checks if a variable or ; a digit follows. JR NC,S_NEGATE ; forward, if not, to S-NEGATE ; to consider a '-' character then functions. CP $41 ; compare with 'A' JR NC,S_LETTER ; forward, if alpha, to S-LETTER -> ; 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. ; -> S_DECIMAL 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 are required CALL MAKE_ROOM ; routine MAKE-ROOM ;;; INC HL ; LD (HL),$0E ; insert number marker at first location. INC HL ; address next location to receive the 5 bytes. EX DE,HL ; make DE destination. CALL GET_5 ;+ NEW subroutine below embodies following ;;; LD HL,($5B65) ; 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 ($5B65),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 ; --- GET_5 LD HL,($5B65) ;+ STKEND points to end of stack. LD BC,$0005 ;+ There are five bytes to copy. AND A ;+ Clear carry flag. SBC HL,BC ;+ Reduce HL by five. LD ($5B65),HL ;+ update STKEND as we are taking number. LDIR ;+ Copy five bytes to location EX DE,HL ;+ transfer pointer to HL DEC HL ;+ adjust RET ;+ Return ; --- ; S_DECIMAL branches here in runtime to pick up prepared number. S_STK_DEC RST 18H ; GET-CHAR positions HL at digit. 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 ; loop back, until match found, to S-SD-SKIP ; it has to be here. INC HL ; point to first byte of number CALL STACK_NUM ; routine STACK-NUM stacks it. LD ($5B5D),HL ; update system variable CH_ADD S_NUMERIC SET 6,(IY+$01) ; update FLAGS - Signal numeric result ;;; JR S_CONT_1 ; forward to S-CONT-1 ===> JR S_CONT_2 ;+ forward now directly to S-CONT-2 ; end of functions accessed from scanning functions table. ; -------------------------- ; Scanning variable routines ; -------------------------- ; ; 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,($5B3B) ; fetch FLAGS value CP $C0 ; compare 11000000 ;;; JR C,S_CONT_1 ; step forward to S-CONT-1 if string ===> JR C,S_CONT_2 ;+ step forward to S-CONT-2 if string ===> ; The variable is a simple numeric variable. INC HL ; advance pointer past last letter. CALL STACK_NUM ; routine STACK-NUM 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$' 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 the character '-' ? 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. JR C,REPORT_Cw ; forward, with anything else, to REPORT-C ; 'Nonsense in BASIC' LD BC,$04F0 ; prepare priority $04, operation $C0 + ; 'not' ($30) CP $14 ; is it 'NOT' JR Z,S_PUSH_PO ; forward, if so, to S-PUSH-PO JR NC,REPORT_Cw ; forward, if higher, to REPORT-C ; 'Nonsense in BASIC' LD B,$10 ; priority $10 for all the rest ADD A,$DC ; make range $DC - $EF ; $C0 + 'code' ($1C) through 'chr$' ($2F) LD C,A ; transfer 'function' to C CP $DF ; compare to 'sin' ? JR NC,S_NO_TO_s ; 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'. S_NO_TO_s 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. ; Push the Priority and Operand. S_PUSH_PO PUSH BC ; push the priority and calculator operation ; code. JR S_NEXT_1 ;+ forward to similar looping code. ;;; RST 20H ; NEXT-CHAR ;;; JP S_LOOP_1 ; jump back to S-LOOP-1 to go round the loop ; -------------------------------- ; ===> there were many branches forward to here S_CONT_2 RST 18H ; GET-CHAR S_CONT_3 CP $28 ; is it '(' ? JR NZ,S_OPERTR ; forward, if not, to S-OPERTR > 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 S_CONT_4 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. S_OPERTR ;;; LD B,$00 ; prepare to index. ;;; LD C,A ; possible operator to C LD HL,tbl_ofops-1 ; Address: tbl-of-ops CALL INDEXER_0 ; routine INDEXER does look up sets B to zero. 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_PRI-$C3 ; address theoretical base of table. ADD HL,BC ; index into table. LD B,(HL) ; priority to B. ; ----------------------- ; Scanning Operation loop ; ----------------------- ; The juggling act. S_LOOP POP DE ; fetch last priority and operation code. LD A,D ; priority to A CP B ; compare with this one JR C,S_TIGHTER ; forward, with carry, to S-TIGHTER ; to execute the operation before this one as ; it has a 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, if zero, to exit via GET-CHAR ; pointing CH_ADD 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 the current priority/operation as it ; must have 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,$5B3B ; Address the FLAGS system variable. LD A,E ; new operation to A register CP $ED ; is it $C0 + 'usr-no' ($2D) ? JR NZ,S_STK_LST ; forward, if not, to S-STK-LST BIT 6,(HL) ; is a string result expected ? ; (from the lower priority operand we've ; just pushed on stack ) JR NZ,S_STK_LST ; forward, if numeric, to S-STK-LST ; as the operand bits match. LD E,$99 ; reset bit 6 and substitute $19 'usr-$' ; for a string operand. S_STK_LST PUSH DE ; now stack this priority/operation code. CALL SYNTAX_Z ; routine SYNTAX-Z JR Z,S_SYNTEST ; forward, if checking syntax, to S-SYNTEST LD A,E ; fetch the operation code. AND $3F ; mask off the result/operand bits to leave ; a calculator literal. LD B,A ; transfer naked 'literal' to B register ; Now use the calculator to perform the single operation - the 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 operand. DEFB $3B ;;fp-calc-2 DEFB $38 ;;end-calc result. JR S_RUNTEST ; forward to S-RUNTEST ; --- ; The branch was here if checking syntax only. S_SYNTEST LD A,E ; fetch the operation code to the accumulator. XOR (IY+$01) ; XOR with the FLAGS system variable. AND $40 ; bit 6 will be zero now if operand ; matched expected result. JR Z,S_RUNTEST ; skip forward, if results match. REPORT_Cw RST 30H ; ERROR-1 DEFB $0B ; Error Report: Nonsense in BASIC ;;; S_RPRT_C2 JP NZ,REPORT_C ; to REPORT-C if mismatch ; else continue to set flags for next operation. ; The branch is to here in runtime after a successful operation. S_RUNTEST POP DE ; fetch the last operation from stack LD HL,$5B3B ; address FLAGS system variable. SET 6,(HL) ; set default FLAGS result to numeric. BIT 7,E ; test the operational result. JR NZ,S_LOOPEND ; forward, if numeric, to S-LOOPEND RES 6,(HL) ; reset bit 6 of FLAGS to show string result. 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. S_TIGHTER PUSH DE ; save higher priority/operator on stack again. LD A,C ; fetch the lower priority/operation code. BIT 6,(IY+$01) ; test FLAGS - numeric or string result ? JR NZ,S_NEXT ; forward, if numeric, to S-NEXT ; If this is lower priority, yet has a string result, then it must be a ; comparison. Since these can only be evaluated in context and were ; defaulted to numeric at the operator look-up stage, they must be changed ; to their string equivalents. AND $3F ; mask to give the true calculator literal. ADD A,$08 ; augment numeric literals to their string ; equivalents. ; 'no-&-no' => 'str-&-no' ; 'no-l-eql' => 'str-l-eql' ; 'no-gr-eq' => 'str-gr-eq' ; '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-&-no' ? JR NZ,S_NOT_AND ; skip forward, if not, to S-NOT-AND SET 6,C ; set numeric operand bit. JR S_NEXT ; forward to S-NEXT ; --- ; The short branch was to here when string operators had been compared. S_NOT_AND JR C,REPORT_Cw ; back, if less than '&', to S-RPORT-C2 ; 'Nonsense in BASIC' ; e.g. with a$ * b$ CP $17 ; is it 'strs-add' ? JR Z,S_NEXT ; forward, if so, to S-NEXT ; as already set for a string result. SET 7,C ; set numeric (Boolean) result for all others. S_NEXT PUSH BC ; now save this priority/operation on stack. S_NEXT_1 RST 20H ; NEXT-CHAR advances the character address. JP S_LOOP_1 ; jump back to S-LOOP-1 ; --------------------- ; THE 'OPERATORS' TABLE ; --------------------- ; 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 was intended. That is '+', '=', '>', '<', '<=', '>=' or '<>'. tbl_ofops 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-&-no' DEFB $00 ; zero end-marker. ; ---------------------- ; THE 'PRIORITIES' TABLE ; ---------------------- ; This table is indexed with the operation code obtained from the above ; table, $C3 - $CF, to obtain the priority for the respective operation. TBL_PRI 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 ; system 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. 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-Za-z] JR NC,REPORT_Cw ; jump back, if not, to REPORT-C ; 'Nonsense in BASIC' RST 20H ; NEXT-CHAR CP $24 ; is it '$' ? PUSH AF ; (*) save the flags JR NZ,SF_BRKT_1 ; forward, with numeric function, to SF-BRKT-1 RST 20H ; NEXT-CHAR advances past the '$'. SF_BRKT_1 CP $28 ; is character a '(' ? SF_RPT_C JR NZ,REPORT_Cw ; forward, if not, to SF-RPRT-C ; 'Nonsense in BASIC' RST 20H ; NEXT-CHAR CP $29 ; is it ')' ? JR Z,SF_FLAG_6 ; forward, if no arguments, to SF-FLAG-6 SF_ARGMTS CALL SCANNING ; routine SCANNING checks each argument which ; may be an expression and ends with RST 18H. ;;; 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. ; --- SF_BRKT_2 ;;; CP $29 ; is character the closing ')' ? ;;; JP NZ,REPORT_C ; Report 'Nonsense in basic' if not. CALL TST_RBRKT ;+ routine to test for right hand bracket. ; at this point any optional arguments have had their syntax checked. SF_FLAG_6 RST 20H ; NEXT-CHAR ;;; LD HL,$5B3B ; address system variable FLAGS ;;; RES 6,(HL) ; signal a string result CALL STR_RSLT ;+ set default result to string as 3 byte call. POP AF ; (*) restore test result against '$'. JP Z,S_CONT_2 ;+ to S_CONT_2 if string JP S_NUMERIC ;+ else to S_NUMERIC. ;;; JR Z,SF_SYN_EN ; skip forward to SF-SYN-EN if string function. ;;; SET 6,(HL) ; signal a numeric result. ;;; SF_SYN_EN JP S_CONT_2 ; jump back to S-CONT-2 to continue scanning. ; --- ; The branch was here in runtime. 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 SF_ARGMT1 RST 20H ; NEXT-CHAR advances to start of argument PUSH HL ; save address LD HL,($5B53) ; fetch start of program area from PROG DEC HL ; the search starting point is the previous ; location. 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. REPORT_P RST 30H ; ERROR-1 DEFB $18 ; Error Report: FN without DEF 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. 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 the 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. 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 ($5B5D),DE ; save address in CH_ADD CALL FN_SKPOVR ; routine FN-SKPOVR advances HL past the '(' PUSH HL ; save start address in DEF FN *** CP $29 ; is character a ')' ? JR Z,SF_R_BR_2 ; forward, if no arguments, to SF-R-BR-2 SF_ARG_LP INC HL ; point to next character. LD A,(HL) ; fetch it to A. CP $0E ; is it the number marker ? LD D,$40 ; signal numeric in D. JR Z,SF_ARG_VL ; forward, if numeric, to SF-ARG-VL 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 a string result. 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, with type mismatch, to REPORT-Q ; 'Parameter error' ;;; POP HL ; pop the start address in DEF FN statement ;;; EX DE,HL ; transfer to DE ?? pop straight into de ? POP DE ;+ pop the start address in DEF FN to DE. CALL GET_5 ;+ NEW subroutine above embodies following ;;; LD HL,($5B65) ; 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 ($5B65),HL ; set STKEND thus '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, if so, to SF-R-BR-2 ; 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 character the corresponding ',' ? JR NZ,REPORT_Q ; forward, if not, to REPORT-Q ; '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. 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, if so, to SF-VALUE REPORT_Q RST 30H ; ERROR-1 DEFB $19 ; Error Report: Parameter error SF_VALUE POP DE ; restore location of ')' in DEF FN to DE. EX DE,HL ; now to HL, FN ')' pointer to DE. LD ($5B5D),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,($5B0B) ; get original DEFADD address EX (SP),HL ; swap with DEF FN address on stack *** LD ($5B0B),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 ($5B5D),HL ; set CH_ADD to this POP HL ; pop the original DEFADD value LD ($5B0B),HL ; and re-insert into DEFADD system variable. JP S_CONT_4 ;+ back to similar code. ;;; RST 20H ; NEXT-CHAR advances to character after ')' ;;; JP S_CONT_2 ; jump back to S-CONT-2 ; -------------------------------- ; THE 'DEF FN SKIPOVER' SUBROUTINE ; -------------------------------- ; 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 ; that 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 collate to less than ; the space character. FN_SKPOVR INC HL ; increase pointer. LD A,(HL) ; fetch the addressed character. CP $21 ; compare with space + 1 JR C,FN_SKPOVR ; back to FN-SKPOVR if space or less. RET ; return pointing to a significant character. ; -------------------------------------- ; THE 'SEARCH VARIABLES AREA' SUBROUTINE ; -------------------------------------- ; ; 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 back, if not, to REPORT-C ; 'Nonsense in BASIC' ; The first character in BASIC is alphabetic PUSH HL ; save pointer to first character ^1 AND $1F ; mask lower bits, 1 - 26 decimal 000xxxxx LD C,A ; store in C as descriptor. RST 20H ; NEXT-CHAR points to second character. PUSH HL ; save pointer to second character ^2 CP $28 ; is it '(' - an array ? JR Z,V_RUN_SYN ; forward, if so, to V-RUN/SYN. with 000xxxxx SET 6,C ; preset bit 6 signaling string 010xxxxx CP $24 ; is character a '$' ? JR Z,V_STR_VAR ; forward, if so, to V-STR-VAR SET 5,C ; signal simple numeric 011xxxxx CALL ALPHANUM ; routine ALPHANUM sets carry if second ; character is also 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 ; Subsequent characters have the character reduced to 1-26 or 33-58 if lower ; case. Deceptively clever. 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 ; --- ; The jump was here when second character was '$'. V_STR_VAR RST 20H ; NEXT-CHAR advances past '$' ;;; RES 6,(IY+$01) ; update FLAGS - signal string result. CALL STR_RSLT ;+ V_TEST_FN LD A,($5B0C) ; 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. ; Note. CALL SYNTAX_Z ; routine SYNTAX-Z JR NZ,STK_F_ARG ; JUMP to STK-F-ARG in runtime and then ; back to this point if no variable found. ; All paths converge here with bits 5 and 6 describing variable. 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 back to C. JR V_SYNTAX ; forward to V-SYNTAX ; --- ; In runtime search for the variable. V_RUN LD HL,($5B4B) ; set HL to start of variables from VARS V_EACH LD A,(HL) ; get first variable letter AND $7F ; AND with %01111111 ; ignoring bit 7 which distinguishes ; arrays or for/next variables. JR Z,V_80_BYTE ; forward, if zero, to V-80-BYTE ; as must be 10000000 the variables end-marker. CP C ; compare with supplied value. JR NZ,V_NEXT ; forward, with no match, to V-NEXT 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 ; This leaves long name variables. x01xxxxx POP DE ; pop pointer to BASIC 2nd. character. PUSH DE ; save it again PUSH HL ; save variable first letter pointer V_MATCHES INC HL ; address next letter in VARS area V_SPACES LD A,(DE) ; pick up character from BASIC area INC DE ; and advance character address CP $20 ; is character a space ? JR Z,V_SPACES ; back to V-SPACES until non-space OR $20 ; convert character to reduced lower case.33-58 CP (HL) ; compare with addressed variables letter JR Z,V_MATCHES ; loop back to V-MATCHES if a match on an ; intermediate letter. ; the last letter won't match. OR $80 ; now set bit 7 as last character of long names ; is 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 BASIC character CALL ALPHANUM ; routine ALPHANUM sets carry if not alphanum JR NC,V_FOUND_1 ; forward to V-FOUND-1 with a full match. V_GET_PTR POP HL ; pop saved pointer to 1st BASIC character. V_NEXT PUSH BC ; save flags CALL NEXT_ONE ; routine NEXT-ONE gets next variable in DE EX DE,HL ; transfer VARS address to HL. POP BC ; restore the flags JR V_EACH ; loop back to V-EACH ; to compare each variable ; --- V_80_BYTE SET 7,B ; signals not found in runtime. ; the branch was here when checking syntax V_SYNTAX POP DE ; discard the pointer to 2nd. character v2 ; in BASIC line/workspace. ; Note HL addresses 2nd BASIC character also RST 18H ; GET-CHAR gets character after variable name. CP $28 ; is it '(' ? ; from a string array e.g. a$( ;;; JR Z,V_PASS ; forward, with string array, to V-PASS ;;; ; Note. could go straight to V-END ? JR Z,V_END ;+ forward, with string array, 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. 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. V_FOUND_2 POP DE ; discard pointer to 2nd BASIC char v2 POP DE ; drop pointer to 1st BASIC char v1 PUSH HL ; save pointer to last letter in VARS RST 18H ; GET-CHAR ;;; V_PASS CALL ALPHANUM ; Routine ALPHANUM ;;; JR NC,V_END ; Forward, if not, to V-END ; but it never will be as we advanced past long-named variables earlier. ;;; RST 20H ; NEXT-CHAR ;;; JR V_PASS ; Back to V-PASS ; --- V_END POP HL ; Pop the pointer to last or only letter in ; the VARS area. RL B ; Rotate the B register left, bit 7 to carry. BIT 6,B ; Test the array indicator bit. RET ; Return. ; ------------------------------------- ; THE 'STACK FUNCTION ARGUMENT' SECTION ; ------------------------------------- ; 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. STK_F_ARG LD HL,($5B0B) ; set HL to DEFADD LD A,(HL) ; load the first character CP $29 ; is it ')' ? SFA_VRSYN JR Z,V_RUN_SYN ; JUMP back to V-RUN/SYN, if so, as there are ; no arguments. ; but proceed to search argument list of defined function first if not empty. 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, if so, to SFA-CP-VR ; 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. 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 NUMBER_5 ;+ new entry point to increment HL by 5. CALL FN_SKPOVR ; routine FN-SKPOVR skips to next character CP $29 ; is it ')' ? JR Z,SFA_VRSYN ; jump back, if so, to V-RUN/SYN ; to look in the 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, until bracket encountered, to SFA-LOOP ; --- SFA_MATCH BIT 5,C ; test if numeric JR NZ,SFA_END ; forward, if so, to SFA-END ; as will be stacked by scanning. INC HL ; point to start of string descriptor ;;; LD DE,($5B65) ; set DE to STKEND ;;; CALL MOVE_FP ; routine MOVE-FP puts parameters on stack. ;;; EX DE,HL ; new free location to HL. ;;; LD ($5B65),HL ; use it to set STKEND system variable. CALL STACK_NUM ;+ subroutine embodies 3 of above instructions EX DE,HL ;+ HL must address STKEND 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. 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, if so, to SV-COUNT ; 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. 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_s ; routine STK-STO-$ stacks string parameters ; DE start in variables area, ; BC length, A=1 indicates a 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_SLICEq ; jump forward to SV-SLICE? to test for '(' ; -------------------------------------------------------- ; the branch was here with string and numeric arrays in runtime. 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 ; forward, if not, to REPORT-3 ; 'Subscript wrong' EX DE,HL ; dimensions pointer to HL to synchronize ; with next instruction. ; runtime numeric arrays path rejoins here. 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. SV_COMMA PUSH HL ; save counter RST 18H ; GET-CHAR POP HL ; pop counter CP $2C ; is character ',' ? JR Z,SV_LOOP ; forward, if so, to SV-LOOP ; in runtime the variable definition indicates a comma should appear here BIT 7,C ; checking syntax ? JR Z,REPORT_3 ; forward, if not, to REPORT-3 ; 'Subscript wrong' ; proceed if checking syntax of an array? BIT 6,C ; array of strings ? JR NZ,SV_CLOSE ; forward, if so, to SV-CLOSE ; an array of numbers. ;;; CP $29 ; is character ')' ? XXXXX ;;; JR NZ,SV_RPT_C ; forward, if not, to SV-RPT-C RBRKT_NXT CALL TST_RBRKT ;+ test for a right hand bracket. RST 20H ; NEXT-CHAR moves CH-ADD past the statement RET ; return -> ; --- ; the branch was here with an array of strings. SV_CLOSE CP $29 ; as above ')' could follow the expression JR Z,SV_DIM ; forward, if so, to SV-DIM 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. SV_CH_ADD RST 18H ; GET-CHAR DEC HL ; backtrack HL LD ($5B5D),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 SV_COUNT LD HL,$0000 ; initialize data pointer to zero. 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 L29E0) ; 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. SV_MULT PUSH BC ; save dimension number. PUSH HL ; push data pointer/rubbish. ; DE points to current dimension. EX DE,HL ; INC HL ; LD E,(HL) ; INC HL ; LD D,(HL) ; ;;; CALL DEDEplus1 ; 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 wrong' DEC BC ; adjust returned result from 1-x to 0-x CALL GET_HLxDE ; 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. SV_RPT_C JP NZ,REPORT_Cw ; forward, if so, to SL-RPT-C ; '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_ELEMs ; forward, if so, to SV-ELEM$ ; 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, if so, to SV-NUMBER ; else more subscripts in BASIC line than the variable definition. REPORT_3 RST 30H ; ERROR-1 DEFB $02 ; Error Report: Subscript wrong ; continue if subscripts matched the numeric array. 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_HLxDE ; 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. SV_ELEMs EX DE,HL ; INC HL ; LD E,(HL) ; INC HL ; LD D,(HL) ; ;;; CALL DEDEplus1 ; routine DE,(DE+1) gets next dimension in DE ; the length of strings in this array. EX (SP),HL ; start pointer to stack, data pointer to HL. CALL GET_HLxDE ; 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 indicating 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 wrong' SV_SLICE CALL SLICING ; routine SLICING slices the string. ; but a slice of a simple string can itself be sliced. SV_DIM RST 20H ; NEXT-CHAR SV_SLICEq CP $28 ; is character '(' ? JR Z,SV_SLICE ; loop back if so to SV-SLICE STR_RSLT 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) ; ------------------------------- ; THE 'STRING SLICING' SUBROUTINE ; ------------------------------- ; 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. 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) ;;; SL_RPT_C JP NZ,REPORT_C ; jump to REPORT-C with anything else CALL TST_RBRKT ;+ test for a right-hand bracket. LD H,D ; copy start LD L,E ; to end - just a one character slice. JR SL_DEFINE ; forward to SL-DEFINE. ; --------------------- 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 ; back, if not, to SL-RPT-C CALL TST_RBRKT ;+ Test for a right-hand bracket. ; we now have start in DE and an end in HL. 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 wrong' LD B,H ; transfer the length LD C,L ; to BC. SL_OVER POP DE ; restore start address from machine stack *** ;;; RES 6,(IY+$01) ; update FLAGS - signal string result for the ;;; ; syntax path. CALL STR_RSLT ;+ ;;; SL_STORE CALL SYNTAX_Z ; routine SYNTAX_Z (UNSTACK_Z?) ;;; RET Z ; return if checking syntax. SL_STORE CALL UNSTACK_Z ;+ return early if checking syntax. ; 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. ; ------------------------------------ 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. ; -------------------------- ;;; STK_STO_s RES 6,(IY+$01) ; update FLAGS - signal string result. STK_STO_s CALL STR_RSLT ;+ ; and continue to store parameters of string. ; ---------------------------- ; THE 'STACK STORE' SUBROUTINE ; ---------------------------- ; This subroutine puts five registers AEDCB on the calculator stack. STK_STORE PUSH BC ; preserve two registers CALL TEST_5_SP ; routine TEST-5-SP checks room POP BC ; fetch the saved registers. LD HL,($5B65) ; 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 ($5B65),HL ; update system variable STKEND. RET ; and return. ; ------------------------------------------- ; THE 'INTEGER EXPRESSION EVALUATION' ROUTINE ; ------------------------------------------- ; 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. INT_EXP1 XOR A ; set result flag to zero. ; -> The entry point is here if A is used as a running flag. 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, if checking syntax to I-RESTORE ; so avoiding a comparison with supplied limit. ; The runtime path. 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, if zero, to I-CARRY POP HL ; restore the limit. PUSH HL ; and save. AND A ; prepare to subtract. SBC HL,BC ; subtract value from limit. I_CARRY LD A,D ; move flag to accumulator $00 or $FF. SBC A,$00 ; will set to $FF if carry set. 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 zippier label though as the intention is to simplify the ; program. Note. this will probably have to go. ; DEDEplus1 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. ; Note. UNSTACK_Z can't be used at start as HL would be corrupted :-) GET_HLxDE CALL SYNTAX_Z ; routine SYNTAX-Z. RET Z ; return if checking syntax. CALL HL_HLxDE ; routine HL-HL*DE. JP C,REPORT_4 ; jump back to REPORT-4 if over 65535. ; 'Out of memory' RET ; else return with 16-bit result in HL. ; ----------------- ; THE 'LET' COMMAND ; ----------------- ; Sinclair BASIC adheres to the ANSI-78 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. LET LD HL,($5B4D) ; fetch system variable DEST to HL. BIT 1,(IY+$37) ; test FLAGX - handling a new variable ? JR Z,L_EXISTS ; forward, if not, to L-EXISTS ; 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 L_EACH_CH INC BC ; increase byte count for each relevant ; character 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, if so, to L-SPACES CP $16 ; is it $16 - $1F ? JR NC,L_SPACES ; forward, if so, to L-SPACES ; 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 to here if higher than space. L_TEST_CH CALL ALPHANUM ; routine ALPHANUM sets carry if alphanumeric JR C,L_EACH_CH ; loop back, if so, for more to L-EACH-CH CP $24 ; is it '$' ? JP Z,L_NEWs ; jump forward if so, to L-NEW$ ; with a new string. L_SPACES LD A,C ; save length lo in A. CALL MK_RM_EL ;+ MAKE_ROOM at E_LINE -1 ;;; LD HL,($5B59) ; fetch E_LINE to HL. ;;; DEC HL ; point to location before, the variables ;;; CALL MAKE_ROOM ; routine MAKE-ROOM creates BC spaces ;;; 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,($5B4D) ; 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. ; Register HL points to start of variable name after 'LET' in BASIC line. 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 L_SINGLE LD HL,($5B4D) ; 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. 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 ; Register 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. L_EXISTS BIT 6,(IY+$01) ; test FLAGS - numeric or string result ? JR Z,L_DELETEs ; 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. ;;; L_DELETEs LD HL,($5B4D) ; fetch DEST to HL. ; (still set from first instruction) L_DELETEs LD BC,($5B72) ; fetch STRLEN to BC. BIT 0,(IY+$37) ; test FLAGX - handling a complete simple ; string ? JR NZ,L_ADDs ; forward, if so, to L-ADD$ ; 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 Procrustean lengthening and shortening after a ; character Procrustes in Greek legend who made travelers 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 zero. PUSH HL ; save pointer to start. CALL BC_SPACES ; 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 ; block copy bytes filling area 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" 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, if so, to L-IN-W/S ;;; ; leaving the prepared spaces. ;;; LDIR ; else copy bytes overwriting some spaces. CALL COND_MV ;+ a Conditional (NZ) ldir routine 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 L_ENTER EX DE,HL ; exchange pointers HL=STKEND DE=end of vars. COND_MV 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 ; block copy bytes. POP HL ; address the start. RET ; Return. ; --- ; the branch was here from L-DELETE$ if an existing simple string. ; register HL addresses start of string in variables area. L_ADDs 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. L_NEWs LD A,$DF ; indicator mask %11011111 for ; %010xxxxx will be result LD HL,($5B4D) ; address DEST first character. AND (HL) ; combine mask with character. L_STRING PUSH AF ; save first character and mask. CALL STK_FETCH ; routine STK-FETCH fetches parameters of ; the string. Start in DE, length in BC. 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 ($5B4D),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. CALL MK_RM_EL ;+ MAKE_ROOM at E_LINE -1 ;;; LD HL,($5B59) ; 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,($5B4D) ; 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 L_FIRST DEC HL ; address variable name LD (HL),A ; and insert character. L_EL_DHL LD HL,($5B59) ; load HL with E_LINE. DEC HL ; now end of VARS area. RET ; return ; ---------------------------- ; THE 'STACK FETCH' SUBROUTINE ; ---------------------------- ; ; STK_FETCH LD HL,($5B65) ; 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 ($5B65),HL ; STKEND RET ; ; ----------------- ; THE 'DIM' COMMAND ; ----------------- ; e.g. DIM a(2,3,4,7): DIM a$(32) : DIM b$(20,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. DIM CALL LOOK_VARS ; routine LOOK-VARS 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, in runtime, to D-RUN RES 6,C ; signal 'numeric' array even if of type 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. 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. CALL NXT_1_RC2 ;+ routine combines above 2 routines. POP BC ; pop the type. 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, if so, to D-SIZE LD L,$05 ; make elements 5 bytes as is numeric. D_SIZE EX DE,HL ; save the element size in DE. ; now enter a loop to parse each of the integers in the list. 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 wrong' 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_HLxDE ; 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 ;;; RST 20H ; NEXT-CHAR advances to next statement/CR CALL RBRKT_NXT ;+ Test for a right hand bracket and advance. 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 CALL MK_RM_EL ;+ MAKE_ROOM at E_LINE -1 ;;; LD HL,($5B59) ; address E_LINE - first location after ;;; DEC HL ; point to location before - the $80 end-marker ;;; CALL MAKE_ROOM ; routine MAKE-ROOM creates the space if ;;; 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 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. 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. ; ------------------------- ; THE 'ALPHANUM' SUBROUTINE ; ------------------------- ; This routine checks that the character in A is alphanumeric returning, ; if so, with carry set. ALPHANUM CALL NUMERIC ; Routine NUMERIC resets carry if a number. CCF ; Complement Carry Flag. RET C ; Return if numeric else continue into next ; routine. ; This routine checks that the character in A is alphabetic setting the carry ; flag if it is. ALPHA CP $41 ; less than 'A' ? CCF ; Complement Carry Flag RET NC ; return if less. 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 less. CP $7B ; less than 'z'+1 ? RET ; carry set if within a-z. ; ------------------------------------------ ; THE 'DECIMAL TO FLOATING POINT' SUBROUTINE ; ------------------------------------------ ; 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. DEC_TO_FP CP $C4 ; 'BIN' token ? JR NZ,NOT_BIN ; forward, if not, to NOT-BIN LD DE,$0000 ; initialize 16 bit buffer register. 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 ; --- BIN_END LD B,D ; transfer 16 bit buffer LD C,E ; to BC register pair. JR STACK_BC ; JUMP to STACK-BC to put on calculator stack ; --- ; continue here with .1, 42, 3.14, 5., 2.3 E -4 NOT_BIN CP $2E ; '.' - leading decimal point ? JR Z,DECIMAL ; skip, if so, to DECIMAL 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. DECIMAL RST 20H ; NEXT-CHAR CALL NUMERIC ; routine NUMERIC will reset carry if digit 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 will be stacked. ; Now store 1 in mem-0. ; Note. At each pass of the digit loop this will be divided by ten. 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 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 > ; Note. by switching division and multiply .5 will evaluate as 5/10 instead ; of 5 * .1. The values 5/10 and 1/2 are therefore equal. 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 ;obsolete DEFB $04 ;+multiply ;x or 0,d,10. DEFB $C0 ;;st-mem-0 ;x or 0,d,10. ;;; DEFB $04 ;;multiply ;obsolete DEFB $05 ;+division ;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 divided by an increasingly larger ; factor (100, 1000, 10000 ... ) before being added to the previous ; last value to form a new last value. ; Finally see if an exponent has been input. E_FORMAT CP $45 ; is character 'E' ? JR Z,SIGN_FLAG ; forward, if so, to SIGN-FLAG CP $65 ; 'e' is acceptable as well. RET NZ ; return as no exponent. 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. SIGN_DONE RST 20H ; NEXT-CHAR ST_E_PART CALL NUMERIC ; routine NUMERIC JR C,DEC_RPT_C ; back, if not, to DEC-RPT-C ; '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. E_FP_JUMP JR 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. ; ------------------------ ; THE 'NUMERIC' SUBROUTINE ; ------------------------ ; This routine checks that the ASCII character in A is numeric ; returning, if so, with carry reset. 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' ; --------------------------------- ; THE 'STACK BC and SET IY' ROUTINE ; --------------------------------- ; STK_BC_IY LD IY,$5B3A ;+ re-initialize the IY register to access the ;+ system variables. (14 clock cycles) JR STACK_BC ;+ forward to stack the result of USR function. ; ---------------------------- ; THE 'STACK DIGIT' SUBROUTINE ; ---------------------------- ; This subroutine is called from INT-TO-FP and DEC-TO-FP to stack a digit ; on the calculator stack. STK_DIGIT CALL NUMERIC ; routine NUMERIC RET C ; return if not numeric character SUB $30 ; convert from ASCII to digit ; ------------------------ ; THE 'STACK A' SUBROUTINE ; ------------------------ ; ; STACK_A LD C,A ; transfer to C LD B,$00 ; and make B zero ; ------------------------- ; THE 'STACK BC' SUBROUTINE ; ------------------------- ; ;;; STACK_BC LD IY,$5B3A ; re-initialize ERR_NR STACK_BC XOR A ; Clear accumulator to signal small integer LD E,A ; Place in E for the sign byte. 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 stacks number AEDCB ; and sets carry. ; Note. HL now points to new STKEND. The requirement is that it should point ; to the 'result' and DE should point at STKEND as this is the terminating ; routine for some calculator functions. This can be done by simply entering ; and leaving the calculator but that uses many clock cycles if only two ; bytes. AND A ;+ Clear carry. JP STK_PNTRS ;+ set HL to result and DE to STKEND also ;+ the carry flag is unaffected. ;;; RST 28H ;; FP-CALC ;;; DEFB $38 ;;end-calc make HL = STKEND-5 and DE = STKEND ;;; AND A ; clear the carry flag. ;;; RET ; Return. ; ------------------------------------------ ; THE 'INTEGER TO FLOATING POINT' SUBROUTINE ; ------------------------------------------ ; 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. 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. 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 ** ;********************************* ; ------------------------------------------- ; THE 'E-FORMAT TO FLOATING POINT' SUBROUTINE ; ------------------------------------------- ; 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 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. E_SAVE PUSH AF ; save positive exp and sign in carry LD HL,$5B92 ; 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 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 E_DIVSN - $ ;;to E-DIVSN DEFB $04 ;;multiply x*10. DEFB $33 ;;jump DEFB E_FETCH - $ ;;to E-FETCH E_DIVSN DEFB $05 ;;division x/10. 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 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. E_END RST 28H ;; FP-CALC final x, factor. DEFB $02 ;;delete final x. DEFB $38 ;;end-calc x. RET ; return ; ------------------------------ ; THE 'FETCH INTEGER' SUBROUTINE ; ------------------------------ ; This routine is called by the mathematical routines - FP-TO-BC, PRINT-FP, ; mult, re-stack and negate to fetch an integer from address HL. Register ; 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. The contents of the B register are not affected. 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 ; -------------------------------------- ; THE 'Store a positive integer' ROUTINE ; -------------------------------------- ;;; This entry point is not used in this ROM but would store any integer as ;;; a positive number. ;;; p-int-sto ;;; L2D8C: LD C,$00 ; make sign byte positive and continue ; ------------------------------ ; THE 'STORE INTEGER' SUBROUTINE ; ------------------------------ ; This routine stores an integer in DE at address HL. ; It is called from mult, 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. INT_STORE PUSH HL ; Preserve HL throughout. ;;; 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 so set the carry flag. POP AF ; retrieve the value SCF ; set carry flag to show overflow RET ; and return. ; --- FP_A_END POP AF ; restore value and success flag and RET ; return. ; ---------------------------------------------- ; THE 'PRINT A FLOATING POINT NUMBER' SUBROUTINE ; ---------------------------------------------- ; Not a trivial task. ; Begin by considering whether to print a leading sign for negative numbers. PRINT_FP RST 28H ;; FP-CALC DEFB $31 ;;duplicate DEFB $36 ;;less-0 DEFB $00 ;;jump-true DEFB PF_NEGTVE - $ ;;to PF-NEGTVE DEFB $31 ;;duplicate DEFB $37 ;;greater-0 DEFB $00 ;;jump-true DEFB PF_POSTVE - $ ;;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. -> ; --- 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 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? 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 ; Register A equals D from above call. ;;; AND A ; test if 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. 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" as the number zero is read as the ; null string by the concatenate routine. ; credit: Tony Stratton, 1982. ; A DEFB $02 - 'delete' is required immediately on using the calculator. PF_SMALL RST 28H ;; FP-CALC int x = 0. DEFB $02 ;+delete . DEFB $E2 ;;get-mem-2 x-int x. DEFB $38 ;;end-calc LD A,(HL) ; fetch exponent of positive fractional number SUB $7E ; subtract CALL LOG_2powA ; routine LOG(2^A) calculates leading digits. LD D,A ; transfer count to D LD A,($5BAC) ; fetch total MEM-5-1 SUB D ; LD ($5BAC),A ; MEM-5-1 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 ($5BA1),A ; MEM-3-1 DEC A ; RLA ; SBC A,A ; INC A ; LD HL,$5BAB ; address MEM-5-1 leading digit counter LD (HL),A ; store counter INC HL ; address MEM-5-2 total digits ADD A,(HL) ; add counter to contents LD (HL),A ; and store updated value POP HL ; restore HL JR 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. 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_2powA ; routine LOG(2^A) SUB $07 ; LD B,A ; LD HL,$5BAC ; 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 ; ---------------------------- 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 PF_BITS SLA E ; C ; --- PF_OUT_LP LD A,C ; fetch total digit count AND A ; test for zero JR Z,PF_OUT_DT ; forward, if so, to PF-OUT-DT LD A,(HL) ; fetch digit INC HL ; address next digit DEC C ; decrease total digit counter 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. 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 '.' PF_DEC_0S RST 10H ; PRINT-A outputs the character '.' or '0' LD A,$30 ; prepare the character '0' ; (for cases like .000012345678) DJNZ PF_DEC_0S ; 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 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 ; --- PF_E_POS LD A,$2B ; prepare character '+' PF_E_SIGN RST 10H ; PRINT-A outputs the sign ;;; LD B,$00 ; make the high byte zero. JP OUT_NUM_0 ;+ exit via OUT-NUM-0 to print exponent in BC ; -------------------------------- ; THE 'CA = 10 x A + C' SUBROUTINE ; -------------------------------- ; This subroutine is called twice from PRINT_FP when printing floating-point ; numbers. It returns 10 * A + C in registers C and A (16 bytes) CA_10xA_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. ; ------------------------------- ; THE 'PREPARE TO ADD' SUBROUTINE ; ------------------------------- ; 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. 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 zero. 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 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 ; ---------------------------------- ; THE 'FETCH TWO NUMBERS' SUBROUTINE ; ---------------------------------- ; 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. 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. ; ------------------------- ; THE 'SHIFT FP' SUBROUTINE ; ------------------------- ; ; SHIFT_FP AND A ; RET Z ; CP $21 ; JR NC,ADDEND_0 ; to ADDEND-0 PUSH BC ; LD B,A ; 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 ; ADDEND_0 EXX ; XOR A ; ZEROS_4_5 LD L,$00 ; LD D,A ; LD E,L ; EXX ; LD DE,$0000 ; RET ; ; ------------------------- ; THE 'ADD BACK' SUBROUTINE ; ------------------------- ; Called twice to increment D'E'DE as a pseudo 32-bit register. ADD_BACK INC E ; RET NZ ; INC D ; RET NZ ; EXX ; INC E ; JR NZ,ALL_ADDED ; to ALL-ADDED INC D ; ALL_ADDED EXX ; RET ; ; --------------------------- ; THE 'SUBTRACTION' OPERATION ; --------------------------- ; (offset: $03 'subtract') ; Subtraction is done by switching the sign byte/bit of the second number, ; which may be integer of floating point, and continuing into addition. subtract EX DE,HL ; address second number with HL CALL negate ; routine NEGATE switches sign EX DE,HL ; address first number again ; and continue. ; ------------------------ ; THE 'ADDITION' OPERATION ; ------------------------ ; (offset: $0F 'addition') ; HL points to first number, DE to second. ; If they are both integers, then go for the easy route. 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 both small integers. PUSH DE ; save pointer to second number for new STKEND. INC HL ; address sign byte of first number 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 ; Now perform the actual addition. 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, if not, to ADDN-OFLW SBC A,A ; restore a negative result sign ; ------------------------------------------------ ; THE 'INT -65536 FIX' credit: Dr. Ian Logan, 1983 ; ------------------------------------------------ ; Note. the following is a modification of Dr. Ian Logan's suggested fix ; for the -65536 problem. At this point, the BC register pair is expendable ; and this solution is optimized for speed by avoiding the machine stack. LD C,A ;+ Make a copy of the sign byte in C. INC A ;+ Make any $FF in A into $00. OR E ;+ Test all three OR D ;+ bytes now for zero. LD A,C ;+ Restore true sign byte of integer. JR NZ,ADD_STORE ;+ forward, if not -65536, to ADD_STORE ; The number, in the registers, is -65536 i.e. 00 FF 00 00 00 and must be ; made 91 80 00 00 00 on the calculator stack. At this stage only the ; fifth byte on the calculator stack is as required. DEC HL ;+ Point to the first byte. LD (HL),$91 ;+ Enter exponent $91 in first byte. INC HL ;++ Point to the second byte AND $80 ;++ set A to $80 ; --------------------------------------------------------------------------- ADD_STORE LD (HL),A ; insert second byte INC HL ; LD (HL),E ; insert third byte INC HL ; LD (HL),D ; insert fourth byte DEC HL ; back to third. DEC HL ; back to second. DEC HL ; point to result. POP DE ; restore value of STKEND RET ; Return. ; --- ; The branch was here when simple register addition overflowed. ADDN_OFLW DEC HL ; POP DE ; 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 ; 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 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) ; ADD_REP_6 JP Z,REPORT_6 ; to REPORT-6 ; 'Number too big' EXX ; END_COMPL LD D,A ; EXX ; GO_NC_MLT XOR A ; JP TEST_NORM ; to TEST-NORM ; ----------------------------- ; THE 'HL = HL * DE' SUBROUTINE ; ----------------------------- ; 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. HL_HLxDE 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. 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 HL_AGAIN DJNZ HL_LOOP ; back to HL-LOOP for all 16 bits HL_END POP BC ; restore preserved BC RET ; return with carry reset if successful ; and result in HL. ; ---------------------------------------------- ; THE 'PREPARE TO MULTIPLY OR DIVIDE' SUBROUTINE ; ---------------------------------------------- ; 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. 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 ; ------------------------------ ; THE 'MULTIPLICATION' OPERATION ; ------------------------------ ; (offset: $04 'multiply') ; Begin by trying integer multiplication as used on the Sinclair ZX80. ; If that overflows then use floating point multiplication. multiply LD A,(DE) ; fetch exponent byte of second number. OR (HL) ; combine with that of first number. JR NZ,MULT_LONG ; forward, if either not integer, to MULT-LONG PUSH DE ; save pointer to second number - new STKEND. PUSH HL ; save pointer to first number - result pointer. PUSH DE ; save pointer to second number on stack again. CALL INT_FETCH ; routine INT-FETCH integer to DE, sign to C. EX DE,HL ; transfer first integer from DE to HL EX (SP),HL ; integer to stack and second pointer to HL. LD B,C ; place first sign byte in B. CALL INT_FETCH ; routine INT-FETCH integer to DE, sign to C ; and B preserved. ; Now manipulate sign bytes so that minus times a minus gives a plus result. LD A,B ; fetch first sign byte $00 or $FF. XOR C ; XOR with second sign byte. $00 or $FF. LD C,A ; transfer sign of result to C. POP HL ; pop first integer off the machine stack. CALL HL_HLxDE ; routine HL-HL*DE multiplies the two integers. EX DE,HL ; transfer the result to DE. POP HL ; restore the result pointer to HL. JR C,MULT_OFLW ; forward, with overflow, to MULT-OFLW ; Note. these next 5 bytes ensure that -zero (00 FF 00 00 00) is replaced ; by zero (00 00 00 00 00). They are required in the case of say, ; 0 * -1 which gives the result -0. This would be printed as -1E-38. ; Note. Contrary to the view expressed in The Complete Spectrum ROM ; Disassembly, these 5 bytes should not be deleted. LD A,D ; test 3rd OR E ; and 4th bytes for zero. JR NZ,MULT_RSLT ; skip forward, if not, to MULT-RSLT LD C,A ; make 2nd byte, possibly $FF, zero also. MULT_RSLT JP INT_STO_3 ;+ jump to similar code. ;;; CALL INT_STORE ; routine INT-STORE stores result at HL. ;;; POP DE ; retrieve the new pointer to STKEND. ;;; RET ; Return. ; --- ; The branch was here when simple register-based multiplication overflowed. MULT_OFLW POP DE ; 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 ; --- MLT_LOOP JR NC,NO_ADD ; to NO-ADD ADD HL,DE ; EXX ; ADC HL,DE ; EXX ; NO_ADD EXX ; RR H ; RR L ; EXX ; RR H ; RR L ; 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 ; MAKE_EXPT DEC A ; CCF ; Complement Carry Flag DIVN_EXPT RLA ; CCF ; Complement Carry Flag RRA ; JP P,OFLW1_CLR ; to OFLW1-CLR JR NC,REPORT_6 ; to REPORT-6 ; 'Number too big' AND A ; 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 OFLW2_CLR LD (HL),A ; EXX ; LD A,B ; EXX ; TEST_NORM JR NC,NORMALIZE ; to NORMALISE LD A,(HL) ; AND A ; NEAR_ZERO LD A,$80 ; JR Z,SKIP_ZERO ; to SKIP-ZERO ZERO_RSLT XOR A ; 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 ; --- NORMALIZE LD B,$20 ; 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 ; --- 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 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 ; ; --- REPORT_6 RST 30H ; ERROR-1 DEFB $05 ; Error Report: Number too big ; ------------------------ ; THE 'DIVISION' OPERATION ; ------------------------ ; (offset: $05 'division') ; ; 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 ; --- DIV_LOOP RLA ; RL C ; EXX ; RL C ; RL B ; EXX ; div_34th ADD HL,HL ; EXX ; ADC HL,HL ; EXX ; JR C,SUBN_ONLY ; to SUBN-ONLY 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 ; --- SUBN_ONLY AND A ; SBC HL,DE ; EXX ; SBC HL,DE ; EXX ; NO_RSTORE SCF ; Set Carry Flag 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 ; jump back to DIVN-EXPT ; ------------------------------------------------ ; THE 'INTEGER TRUNCATION TOWARDS ZERO' SUBROUTINE ; ------------------------------------------------ ; (offset: $3A 'truncate') ; This routine returns the integer of the 'last value' truncated towards zero ; so that, for example, the result for PI would be 3 and the result for -PI ; would be -3 (and not -4 as returned by the BASIC INT function). truncate LD A,(HL) ; Fetch the first byte. AND A ; Test for zero which indicates an integer. RET Z ; return if a small integer. CP $81 ; compare exponent to +1 JR NC,T_GR_ZERO ; forward, if 1 or more, to T-GR-ZERO ; The number is smaller than plus or minus one and can be made zero. LD (HL),$00 ; insert zero in first byte. LD A,$20 ; prepare to reset all 32 bits of 'mantissa' JR NIL_BYTES ; forward to NIL-BYTES ; --- T_GR_ZERO CP $91 ; compare exponent to +16 ; Note. the next section is designed to convert 91 80 00 00 00 to the ; integer 00 FF 00 00 00 . "This is a pity since the number would have ; been perfectly all right if left alone. The remedy would seem to be ; simply to omit the 28 bytes [below] from the program." ; credit: Dr. Ian Logan 1983. ;;; 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) ; ;;; 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 T_SMALL JR NC,X_LARGE ; forward if more than 16-bit integer to X-LARGE ; The number is a small integer +/- 1-65535 and can be held in two bytes. PUSH DE ; Preserve the STKEND pointer. ; The exponent ($81 to $90) is converted to a shift count - one to sixteen. CPL ; Complement - range $7F - $70 ADD A,$91 ; Add to give shift count $10 - $01 INC HL ; Point to first mantissa byte. LD D,(HL) ; Load to high-order byte. INC HL ; Point to next byte of mantissa. LD E,(HL) ; Load to low-order byte. DEC HL ; Restore pointer DEC HL ; to position at first byte. LD C,$00 ; prepare a positive sign byte. BIT 7,D ; test sign bit of mantissa byte. JR Z,T_NUMERIC ; skip, if positive, to T-NUMERIC DEC C ; make $FF - negative sign byte. T_NUMERIC SET 7,D ; put back the 'implied' bit. ; Now see if 8 bits can be right-shifted at once (if number < 256) LD B,$08 ; prepare 8 in B SUB B ; subtract from shift counter in A. ADD A,B ; and add back. JR C,T_TEST ; forward, if number > 255, to T-TEST LD E,D ; Transfer MSB to LSB LD D,$00 ; Make MSB zero. SUB B ; subtract 8 from the shift counter. T_TEST JR Z,T_STORE ; forward, if no more shifts, to T-STORE LD B,A ; Transfer count to B. T_SHIFT SRL D ; 0 -> 76543210 -> C RR E ; C -> 76543210 -> C DJNZ T_SHIFT ; back for count to T-SHIFT T_STORE JP INT_STO_3 ;+ jump to similar code. ;;; CALL INT_STORE ; routine INT-STORE stores integer DE at HL. ;;; POP DE ; Restore the STKEND value from the stack. ;;; RET ; Return. ; --- ; The next instruction is made redundant by Dr. Logan's fix. ;;; T_EXPNENT LD A,(HL) ; This instruction is never reached. ; --- ; The branch was here when the number was a large number e.g. 1000000.567 ; The accumulator holds the exponent. X_LARGE SUB $A0 ; Subtract +32 decimal from the exponent. RET P ; Return if the result is positive as 32 bits ; of the mantissa relate to the integer part. ; The radix point is somewhere to the right of ; the mantissa. NEG ; else negate to form number of rightmost bits ; to be blanked. ; For instance, disregarding the sign bit, the number 3.5 is held as ; exponent $82 mantissa .11100000 00000000 00000000 00000000. ; We need to reset $82 - $A0 = $E2, which negated = $1E (thirty) bits to ; form the integer of 3.5. NIL_BYTES PUSH DE ; Save pointer to STKEND. EX DE,HL ; Register HL now points to STKEND DEC HL ; Now at last byte of mantissa. LD B,A ; Transfer the bit count to register B, ; Now look into the possibility of blanking eight bits at a time. SRL B ; Divide SRL B ; by SRL B ; eight. JR Z,BITS_ZERO ; forward, if zero, to BITS-ZERO BYTE_ZERO LD (HL),$00 ; set eight bits to zero. DEC HL ; point to more significant byte of mantissa. DJNZ BYTE_ZERO ; loop back for all to BYTE-ZERO BITS_ZERO AND $07 ; mask the remaining bits from original count. JR Z,IX_END ; forward, if none, to IX-END LD B,A ; transfer bit count to B counter. LD A,$FF ; form an initial mask %11111111 LESS_MASK SLA A ; 1 <- 76543210 <- 0 slide mask leftwards. DJNZ LESS_MASK ; loop back, for bit count, to LESS-MASK AND (HL) ; lose the unwanted rightmost bits. LD (HL),A ; and place in the mantissa byte. IX_END EX DE,HL ; Restore the result pointer. POP DE ; Restore STKEND value from stack. RET ; Return. ; --------------------------------------- ; THE '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 ; ---------------------------------------------- ; THE 'RE-STACK TWO "SMALL" INTEGERS' SUBROUTINE ; ---------------------------------------------- ; This routine is called to re-stack two numbers in full floating point form ; e.g. from mult when integer multiplication has overflowed. RE_ST_TWO CALL RESTK_SUB ; routine RESTK-SUB below and continue ; into the routine to do the other one. RESTK_SUB EX DE,HL ; swap pointers and continue into same routine. ; --------------------------------------------- ; THE 'RE-STACK ONE "SMALL" INTEGER' SUBROUTINE ; --------------------------------------------- ; (offset: $3D 're-stack') ; This routine re-stacks an integer, usually on the calculator stack, in full ; floating point form. HL points to the first byte. re_stack LD A,(HL) ; Fetch Exponent byte to A AND A ; test it RET NZ ; return if first byte is not zero as number ; is already in floating-point form. PUSH DE ; preserve DE. CALL INT_FETCH ; routine INT-FETCH integer to DE, sign to C. ; Note. the above routine returns HL pointing to 4th byte. XOR A ; clear the accumulator. ; Note. The fifth byte of an integer is always zero for neatness so the next ; step is, I imagine, unnecessary. ;;; INC HL ; point to 5th. ;;; LD (HL),A ; and blank. ;;; DEC HL ; point to 4th. LD (HL),A ; blank the 4th byte. LD B,$91 ; set exponent byte +ve $81. ; and imaginary radix 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 order byte D AND A ; is it zero ? JR NZ,RS_NRMLSE ; skip, if not, to RS-NRMLSE ; Check if the number is zero in which case no modification is required. ; However, by updating first three bytes we convert minus zero to plus ; zero although I'm not sure if it can arise. It is eliminated in mult. OR E ; Fetch low byte E to A and test for zero. LD B,D ; set B, the exponent, to 0 JR Z,RS_STORE ; forward, if value is zero, to RS-STORE ; Move the significant bits eight places to the left. LD D,E ; transfer E to D LD E,B ; set E to 0 LD B,$89 ; reduce the initial exponent by eight. RS_NRMLSE EX DE,HL ; integer to HL, addr of 4th byte to DE. RSTK_LOOP DEC B ; decrease exponent ADD HL,HL ; shift HL 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 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 ; Register HL now points at result. 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. ; ------------------------ ; THE 'TABLE OF CONSTANTS' ; ------------------------ ; These five constants are now held in full five byte integer or ; floating-point form as it makes it much easier to pass them to the ; calculator stack when required. ;;; used 11 times ;;; stk-zero 00 00 00 00 00 ;;; L32C5: DEFB $00 ;;Bytes: 1 ;;; DEFB $B0 ;;Exponent $00 ;;; DEFB $00 ;;(+00,+00,+00) ;;; used 19 times ;;; stk-one 00 00 01 00 00 ;;; L32C8: DEFB $40 ;;Bytes: 2 ;;; DEFB $B0 ;;Exponent $00 ;;; DEFB $00,$01 ;;(+00,+00) ;;; used 9 times ;;; stk-half 80 00 00 00 00 ;;; L32CC: DEFB $30 ;;Exponent: $80, Bytes: 1 ;;; DEFB $00 ;;(+00,+00,+00) ;;; used 4 times. ;;; stk-pi/2 81 49 0F DA A2 ;;; L32CE: DEFB $F1 ;;Exponent: $81, Bytes: 4 ;;; DEFB $49,$0F,$DA,$A2 ;; ;;; used 3 times. ;;; stk-ten 00 00 0A 00 00 ;;; L32D3: DEFB $40 ;;Bytes: 2 ;;; DEFB $B0 ;;Exponent $00 ;;; DEFB $00,$0A ;;(+00,+00) TAB_CNST DEFB $00 ;+ the value zero. DEFB $00 ;+ DEFB $00 ;+ DEFB $00 ;+ DEFB $00 ;+ DEFB $00 ;+ the integer value 1. DEFB $00 ;+ DEFB $01 ;+ DEFB $00 ;+ DEFB $00 ;+ DEFB $80 ;+ the floating point value a half. DEFB $00 ;+ DEFB $00 ;+ DEFB $00 ;+ DEFB $00 ;+ DEFB $81 ;+ the floating point value pi/2 DEFB $49 ;+ DEFB $0F ;+ DEFB $DA ;+ DEFB $A2 ;+ DEFB $00 ;+ the integer value ten. DEFB $00 ;+ DEFB $0A ;+ DEFB $00 ;+ DEFB $00 ;+ ; ------------------------ ; THE 'TABLE OF ADDRESSES' ; ------------------------ ; ; Starts with binary operations which have two operands and one result. ; Three pseudo binary operations first. 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 Fn_or ; $07 Address: $351B - or DEFW no_v_no ; $08 Address: $3524 - no-&-no DEFW multcmp ; $09 Address: $353B - no-l-eql DEFW multcmp ; $0A Address: $353B - no-gr-eql DEFW multcmp ; $0B Address: $353B - nos-neql DEFW multcmp ; $0C Address: $353B - no-grtr DEFW multcmp ; $0D Address: $353B - no-less DEFW multcmp ; $0E Address: $353B - nos-eql DEFW addition ; $0F Address: $3014 - addition DEFW str_v_no ; $10 Address: $352D - str-&-no DEFW multcmp ; $11 Address: $353B - str-l-eql DEFW multcmp ; $12 Address: $353B - str-gr-eql DEFW multcmp ; $13 Address: $353B - strs-neql DEFW multcmp ; $14 Address: $353B - str-grtr DEFW multcmp ; $15 Address: $353B - str-less DEFW multcmp ; $16 Address: $353B - strs-eql DEFW strs_add ; $17 Address: $359C - strs-add ; Unary follow. DEFW val_s ; $18 Address: $35DE - val$ DEFW usr_str ; $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 Fn_in ; $2C Address: $34A5 - in DEFW usr_no ; $2D Address: $34B3 - usr-no DEFW str_s ; $2E Address: $361F - str$ DEFW chrs ; $2F Address: $35C9 - chrs DEFW Fn_not ; $30 Address: $3501 - not ; End of true unary. DEFW MOVE_FP ; $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 seriesg_x ; Address: $3449 - series-xx $80 - $9F. DEFW stk_con_x ; Address: $341B - stk-const-xx $A0 - $BF. DEFW sto_mem_x ; Address: $342D - st-mem-xx $C0 - $DF. DEFW get_mem_x ; Address: $340F - get-mem-xx $E0 - $FF. ; Aside: 3E - 3F are therefore unused calculator literals. ; If the literal has to be also usable as a function then bits 6 and 7 are ; used to show type of arguments and result. ; -------------------------- ; THE 'CALCULATE' SUBROUTINE ; -------------------------- ; ; 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... GEN_ENT_1 LD A,B ; fetch the Z80 B register to A LD ($5B67),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 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 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. RE_ENTRY LD ($5B65),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 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. 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. CALL STK_PTRS2 ; Routine to perform the above. EXX ; switch to alternate set of registers. DOUBLE_A RLCA ; double the literal LD L,A ; and store in L for indexing ENT_TABLE LD DE,tbl_addrs ; Address: tbl-addrs LD H,$00 ; prepare to index ADD HL,DE ; add to point to address of routine LD E,(HL) ; low byte of address to E INC HL ; LD D,(HL) ; high byte of address to D LD HL,RE_ENTRY ; Address: RE-ENTRY EX (SP),HL ; goes to stack and address of 'next literal' ; goes to HL' PUSH DE ; now stack the address of the routine EXX ; switch back to 'main' set ; Avoid using the IY register. LD BC,($5B66) ; STKEND_hi ; nothing much goes to C but BREG to B ; and continue into next ret instruction ; which has a dual identity ; ---------------------- ; THE 'DELETE' OPERATION ; ---------------------- ; (offset: $02 'delete') ; 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 delete RET ; return - indirect jump if from above. ; ------------------------------ ; THE 'SINGLE OPERATION' ROUTINE ; ------------------------------ ; (offset: $3B 'fp_calc2') ; This single operation is used, in the first instance, to evaluate most ; of the mathematical and string functions found in BASIC expressions. fp_calc_2 POP AF ; drop return address. LD A,($5B67) ; load accumulator from system variable BREG ; value will be literal e.g. 'tan' EXX ; switch to alt JR SCAN_ENT ; back to SCAN-ENT ; next literal will be end-calc at L2758 ; --------------------------------- ; THE 'TEST FIVE SPACES' SUBROUTINE ; --------------------------------- ; 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. TEST_5_SP PUSH DE ; preserve. PUSH HL ; registers LD BC,$0005 ; an overhead of eighty five bytes CALL TEST_ROOM ; routine TEST_ROOM checks space for 5 bytes. POP HL ; (balance) POP DE ; RET ; then return - OK. ; ----------------------------- ; THE 'STACK NUMBER' SUBROUTINE ; ----------------------------- ; 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. STACK_NUM LD DE,($5B65) ; Load destination from STKEND system variable. CALL MOVE_FP ; Routine MOVE-FP puts on calculator stack ; with a memory check. LD ($5B65),DE ; Set STKEND to next free location. RET ; Return. ; ------------------------- ; THE 'DUPLICATE' OPERATION ; ------------------------- ; (offset: $31 'duplicate') ; 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 duplicate MOVE_FP CALL TEST_5_SP ; routine TEST-5-SP test free memory ; and sets B to zero. BLK_MV LDIR ; copy the five bytes. RET ; return with DE addressing new STKEND ; and HL addressing new last value. ; ------------------------------ ; THE 'STACK LITERALS' OPERATION ; ------------------------------ ; (offset: $34 'stk_data') ; 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. stk_data LD H,D ; transfer STKEND LD L,E ; to HL for result. 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 the number of bytes ; to read. $01 - $04 LD A,(HL) ; reload the first byte AND $3F ; mask off bits 5 - 0 to give possible exponent. JR NZ,FORM_EXP ; Forward to FORM-EXP if it was possible to ; include the exponent and count in one byte. ; else byte is just a byte count and reduced exponent comes next. INC HL ; address next byte and LD A,(HL) ; pick up the exponent ( -$50 ). 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 (B=0, fr test5sp) 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 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. ; ----------------------------------------- ; THE REDUNDANT 'SKIP CONSTANTS' SUBROUTINE ; ----------------------------------------- ; This routine traversed variable-length entries in the table of constants, ; stacking intermediate, unwanted constants onto a dummy calculator stack, ; in the first five bytes of ROM. The destination DE normally points to the ; end of the calculator stack which might be in the normal place or in the ; system variables area during E-LINE-NO; INT-TO-FP; stk-ten. In any case, ; it would be simpler all round if the routine just shoved unwanted values ; where it is going to stick the wanted value. The instruction LD DE, $0000 ; can be removed. ;;; SKIP-CONS ;;; L33F7: AND A ; test if initially zero. ;;; SKIP-NEXT ;;; L33F8: 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'. ;;; ; Better still, write to the normal place. ;;; 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 ; ------------------------------ ; THE 'LOCATE MEMORY' SUBROUTINE ; ------------------------------ ; 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. ;;; It is not possible to use this routine for the table of constants as these ;;; six values are held in compressed format. LOC_MEM LD C,A ; store the original number $00-$1F. RLCA ; X2 - double. RLCA ; X4 - quadruple. ADD A,C ; X5 - now add original to multiply by five. LD C,A ; place the result in the low byte. LD B,$00 ; set high byte to zero. ADD HL,BC ; add to form address of start of number in HL. RET ; return. ; ------------------------------------ ; THE 'GET FROM MEMORY AREA' OPERATION ; ------------------------------------ ; Literals $E0 to $FF ; A holds $00-$1F offset. ; The calculator stack increases by 5 bytes. get_mem_x LD HL,($5B68) ; MEM is base address of the memory cells. INDEX_5 PUSH DE ; save STKEND CALL LOC_MEM ; routine LOC-MEM so that HL = first byte CALL MOVE_FP ; routine MOVE-FP moves 5 bytes with necessary ; memory check. ; DE now points to new STKEND. POP HL ; original STKEND is now RESULT pointer. RET ; return. ; -------------------------------- ; THE 'STACK A CONSTANT' OPERATION ; -------------------------------- ; Offsets $A0 to $A4 ; 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. stk_con_x LD HL,TAB_CNST ; Address table of five byte expanded constants JR INDEX_5 ; back to common code in routine above. ;;; stk-con-x ;;; L341B: LD H,D ; save STKEND - required for result ;;; LD L,E ; ;;; EXX ; swap ;;; PUSH HL ; save pointer to next literal ;;; LD HL,TAB_CNST ; 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. ; ------------------------------- ; THE 'STORE IN MEMORY' OPERATION ; ------------------------------- ; 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 the derived offset $00-$1F. ; This is a unary operation, so on entry HL points to the last value and DE ; points to STKEND. sto_mem_x PUSH HL ; save the result pointer. EX DE,HL ; transfer to DE. LD HL,($5B68) ; 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. LD C,$05 ;+ Set number of bytes to five, B is zero. LDIR ;+ Block copy the bytes avoiding RAM check. EX DE,HL ; DE = STKEND POP HL ; restore original result pointer RET ; return. ; ------------------------- ; THE 'EXCHANGE' SUBROUTINE ; ------------------------- ; (offset: $01 'exchange') ; This routine swaps 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. exchange LD B,$05 ; there are five bytes to be swapped ; Start of loop. SWAP_BYTE LD A,(DE) ; Each byte of second ;;; LD C,(HL) ; Each byte of first ;;; EX DE,HL ; Swap pointers LD C,A ;+ LD A,(HL) ;+ 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 ;;; ; system variable STKEND. RET ; Return. ; ------------------------------ ; THE 'SERIES GENERATOR' ROUTINE ; ------------------------------ ; (offset: $86 'series-06') ; (offset: $88 'series-08') ; (offset: $8C 'series-0C') ; 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. seriesg_x 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 its 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 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 G_LOOP - $ ;;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. ; --------------------------------- ; THE 'ABSOLUTE MAGNITUDE' FUNCTION ; --------------------------------- ; (offset: $2A 'abs') ; This calculator literal finds the absolute value of the last value, ; integer or floating point, on the calculator stack. abs LD B,$FF ; signal abs JR NEG_TEST ; forward to NEG-TEST ; --------------------------- ; THE 'UNARY MINUS' OPERATION ; --------------------------- ; (offset: $1B 'negate') ; e.g. LET balance = -2 ; Unary, so on entry HL points to last value, DE to STKEND. 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. NEG_TEST LD A,(HL) ; load first byte and AND A ; test for zero which indicates a small integer. JR Z,INT_CASE ; forward, if so, to INT-CASE ; for the FLOATING POINT CASE 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. 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 JR INT_STO_2 ;+ Forward to similar code. ;;; 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. ; --------------------- ; THE 'SIGNUM' FUNCTION ; --------------------- ; (offset: $29 'sgn') ; 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. sgn CALL TEST_ZERO ; call routine TEST-ZERO and RET C ; exit if zero 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. INT_STO_2 LD C,A ; store the sign byte in the C register. INT_STO_3 CALL INT_STORE ; routine INT-STORE to overwrite the last ; value with 0001 and sign. POP DE ; restore STKEND. RET ; return. ; ----------------- ; THE 'IN' FUNCTION ; ----------------- ; (offset: $2C 'in') ; This function reads a byte from an input port. Fn_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). ; ------------------- ; THE 'PEEK' FUNCTION ; ------------------- ; (offset: $2B 'peek') ; This function returns the contents of a memory address. ; The entire address space can be examined including the ROM. peek CALL FIND_INT2 ; routine FIND-INT2 puts the address in BC. LD A,(BC) ; load the contents into A register. IN_PK_STK JP STACK_A ; exit via STACK-A to put the value on the ; calculator stack. ; ------------------ ; THE 'USR' FUNCTION ; ------------------ ; (offset: $2d 'usr-no') ; 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 CALL FIND_INT2 ; routine FIND-INT2 to fetch the ; supplied address into BC. LD HL,STK_BC_IY ; NEW address: STK_BC_IY 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. ; ------------------------- ; THE 'USR STRING' FUNCTION ; ------------------------- ; (offset: $19 'usr-$') ; 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. usr_str ;;; 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 EXPT_SPEC ;+ fetch a single char CALL ALPHA ; routine ALPHA sets carry if 'A-Z' or 'a-z'. JR C,USR_RANGE ; forward, if ASCII, to USR-RANGE 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 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,($5B7B) ; 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. USR_STACK JP STACK_BC ; jump back and exit via STACK-BC to store ; --- REPORT_A RST 30H ; ERROR-1 DEFB $09 ; Error Report: Invalid argument ; ------------------------------ ; THE 'TEST FOR ZERO' SUBROUTINE ; ------------------------------ ; 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 only the first four bytes need be tested. ; On entry, HL points to the exponent the first byte of the value. 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 setting zero flag. 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. ; -------------------------------- ; THE 'GREATER THAN ZERO' OPERATOR ; -------------------------------- ; (offset: $37 'greater-0' ) ; 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. 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. ; ------------------ ; THE 'NOT' FUNCTION ; ------------------ ; (offset: $30 'not') ; 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. Fn_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. ; ------------------------------ ; THE 'LESS THAN ZERO' OPERATION ; ------------------------------ ; (offset: $36 'less-0' ) ; Destructively test if last value on calculator stack is less than zero. ; Bit 7 of the second byte will be set if it is. This will either be the ; first bit of a 32-bit mantissa or part of the sign byte if an integer. less_0 XOR A ; set XOR mask to zero ; (carry will become set if sign is negative). ; transfer sign of mantissa to Carry Flag. 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. ; ---------------------------- ; THE 'ZERO OR ONE' SUBROUTINE ; ---------------------------- ; This routine places an integer value of zero or one at the addressed ; location of the calculator stack or MEM area. The value one is written if ; carry is set on entry else zero. 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 for neatness. POP HL ; restore pointer to the first byte. RET ; return. ; ----------------- ; THE 'OR' OPERATOR ; ----------------- ; (offset: $07 'or' ) ; The Boolean OR operator. e.g. 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). Fn_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. ; --------------------------------- ; THE 'NUMBER AND NUMBER' OPERATION ; --------------------------------- ; (offset: $08 'no-&-no') ; 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. no_v_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. ; --------------------------------- ; THE 'STRING AND NUMBER' OPERATION ; --------------------------------- ; (offset: $10 'str-&-no') ; e.g. "You Win" AND score>99 will return the string if condition is true ; or the null string if false. str_v_no EX DE,HL ; make HL point to the number. CALL TEST_ZERO ; routine TEST-ZERO. EX DE,HL ; Restore the two 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. INC DE ;+ Restore DE using two increments which INC DE ;+ is quicker than using the machine stack. RET ; return. ; --------------------------- ; THE 'COMPARISON' OPERATIONS ; --------------------------- ; (offset: $0A 'no-gr-eql') ; (offset: $0B 'nos-neql') ; (offset: $0C 'no-grtr') ; (offset: $0D 'no-less') ; (offset: $0E 'nos-eql') ; (offset: $11 'str-l-eql') ; (offset: $12 'str-gr-eql') ; (offset: $13 'strs-neql') ; (offset: $14 'str-grtr') ; (offset: $15 'str-less') ; (offset: $16 'strs-eql') ; 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 00001010 dec 00001001 10000100c swap y-x ? --- >0? NOT ; nos-neql x<>y 0B 00001011 dec 00001010 00000101 ---- x-y ? NOT --- NOT ; no-grtr x>y 0C 00001100 - 00001100 00000110 ---- x-y ? --- >0? --- ; no-less x0? --- ; nos-eql x=y 0E 00001110 - 00001110 00000111 ---- x-y ? NOT --- --- ; ; comp -> C/F ; ==== === ; str-l-eql x$<=y$ 11 00010001 dec 00010000 00001000 ---- x$y$ 0 !or >0? NOT ; str-gr-eql x$>=y$ 12 00010010 dec 00010001 10001000c swap y$x$ 0 !or >0? NOT ; strs-neql x$<>y$ 13 00010011 dec 00010010 00001001 ---- x$y$ 0 !or >0? NOT ; str-grtr x$>y$ 14 00010100 - 00010100 00001010 ---- x$y$ 0 !or >0? --- ; str-less x$0? --- ; strs-eql x$=y$ 16 00010110 - 00010110 00001011 ---- 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. multcmp 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. 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. NU_OR_STR RRCA ;+ causes 'eql'/'neql' to set carry. PUSH AF ;+ save carry flag. ; 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. BIT 2,A ; test if a string comparison. JR NZ,STRINGS ; forward, if so, to STRINGS ; 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 ; --- ;;; RRCA ; 2nd RRCA causes eql/neql to set carry. ;;; PUSH AF ; save A and carry. STRINGS 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. 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. 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 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. 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. 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 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. END_TESTS POP AF ; pop carry - will be set if eql/neql PUSH AF ; save it again. CALL C,Fn_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,Fn_not ; if comparison then apply a terminal NOT RET ; return. ; ------------------------------------ ; THE 'STRING CONCATENATION' OPERATION ; ------------------------------------ ; (offset: $17 'strs-add') ; 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. 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 the first string POP HL ; re-fetch first length PUSH HL ; and save again PUSH DE ; save start of second string PUSH BC ; and its length. ADD HL,BC ; add the two lengths. LD B,H ; transfer result to BC LD C,L ; CALL BC_SPACES ; routine BC_SPACES creates room in workspace. ; DE points to start of space. CALL STK_STO_s ; routine STK-STO-$ 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 the first string to workspace. CALL COND_MV ; A three-byte call to ldir saves a byte. 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. CALL COND_MV ; A three-byte call to ldir saves a byte. ; Continue into next routine which sets the calculator stack pointers. ; ----------------------------------- ; THE 'SET STACK POINTERS' SUBROUTINE ; ----------------------------------- ; 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. STK_PNTRS LD HL,($5B65) ; 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. STK_PTRS2 LD D,H ; transfer to DE LD E,L ; DEC HL ; Make HL 5 locations lower. DEC HL ; DEC HL ; DEC HL ; DEC HL ; RET ; return. ; ------------------- ; THE 'CHR$' FUNCTION ; ------------------- ; (offset: $2f 'chr$') ; 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". 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. CALL BC_SPACE1 ; BC_SPACE1 makes DE point to start ;;; POP AF ; restore the number. LD (DE),A ; and store in workspace JR str_STK ;+ forward to similar code. ;;; CALL STK_STO_s ; routine STK-STO-$ stacks descriptor. ;;; EX DE,HL ; make DE point to STKEND. ;;; RET ; return. ; --- REPORT_Bd RST 30H ; ERROR-1 DEFB $0A ; Error Report: Integer out of range ; ---------------------------- ; THE 'VAL and VAL$' FUNCTIONS ; ---------------------------- ; (offset: $1d 'val') ; (offset: $18 'val$') ; 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$". val val_s RST 18H ;;; ;;; LD HL,($5B5D) ; fetch value of system variable CH_ADD PUSH HL ; and save on the machine stack. LD A,B ; fetch the literal (either $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 the calculator stack. PUSH DE ; save the address of the start of the string. INC BC ; increment the length for a carriage return. CALL BC_SPACES ; BC_SPACES creates the space in workspace. POP HL ; restore start of string to HL. LD ($5B5D),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 next char the expected carriage return ? JR NZ,V_RPORT_C ; forward, if not, to V-RPORT-C ; '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. V_RPORT_C JP NZ,REPORT_C ;.jump back to REPORT-C with a result mismatch. LD ($5B5D),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 ($5B5D),HL ; and reset the system variable CH_ADD. V_ST_PTRS 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. ; ------------------- ; THE 'STR$' FUNCTION ; ------------------- ; (offset: $2e 'str$') ; This function produces a string comprising the characters that would appear ; if the numeric argument were printed. ; e.g. STR$ (1/10) produces "0.1". ;;; strs LD BC,$0001 ; create an initial byte in workspace ;;; RST 30H ; using BC_SPACES restart. str_s CALL BC_SPACE1 ;+ create an initial byte in workspace. LD ($5B5B),HL ; set system variable K_CUR to new location. PUSH HL ; and save start on machine stack also. LD HL,($5B51) ; fetch value of system variable CURCHL PUSH HL ; and save that too. LD A,$FF ; select system channel 'R'. CALL CHAN_SLCT ; 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,($5B5B) ; 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. str_STK CALL STK_STO_s ; routine STK-STO-$ stores string parameters ; on the calculator stack. EX DE,HL ; Make DE point to STKEND. RET ; return. ; ------------------------ ; THE 'READ-IN' SUBROUTINE ; ------------------------ ; (offset: $1a 'read-in') ; This is the calculator literal used by the INKEY$ function when a '#' ; is encountered after the keyword. It appears to provide for the reading ; of data through different streams from those available on the standard ; Spectrum. ; INKEY$ # does not interact correctly with the keyboard, #0 or #1, and ; its uses are for other channels - Steven Vickers, Pitman Pocket Book. read_in LD HL,($5B51) ; fetch current channel CURCHL PUSH HL ; save it ;;; CALL FIND_INT1 ; routine FIND-INT1 fetches stream to A ;;; CP $10 ; compare with 16 decimal. ;;; JP NC,REPORT_B ; JUMP to REPORT-B if not in range 0 - 15. ;;; CALL CHAN_SLCT ; routine CHAN-OPEN opens channel CALL CHAN_CHK ;+ natural routine opens, if valid, else errors ;+ with 'Invalid stream' instead of 'Integer ;+ out of range' CALL IN_CHAN_K ;+ keyboard ? JR NZ,READ_IT ;+ Forward if not HALT ;+ Read the keyboard. READ_IT 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. CALL BC_SPACE1 ; NEW routine BC_SPACE1 creates space for one ; character in workspace. LD (DE),A ; the character is inserted. R_I_STORE CALL STK_STO_s ; routine STK-STO-$ stacks the string ; parameters. POP HL ; Restore current channel address CALL CHAN_FLAG ; Routine CHAN-FLAG resets current channel ; system variable and flags. JR V_ST_PTRS ; jump back indirectly to STK_PNTRS ; ------------------- ; THE 'CODE' FUNCTION ; ------------------- ; (offset: $1c 'code') ; Returns the ASCII code of a character or first character of a string ; e.g. CODE "Aardvark" = 65, CODE "" = 0. 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. STK_CODE JP STACK_A ; jump back to STACK-A (with memory check) ; ------------------ ; THE 'LEN' FUNCTION ; ------------------ ; (offset: $1e 'len') ; Returns the length of a string. ; In Sinclair BASIC, workable strings can be more than twenty thousand ; characters long so a sixteen-bit register is required to store the length. 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). ; ------------------------------------- ; THE 'DECREASE THE COUNTER' SUBROUTINE ; ------------------------------------- ; (offset: $35 'dec-jr-nz') ; The calculator has an instruction that decrements a single-byte ; pseudo-register and makes consequential relative jumps just like ; the Z80's DJNZ instruction. dec_jr_nz EXX ; switch in set that addresses code PUSH HL ; save pointer to offset byte LD HL,$5B67 ; address BREG in system variables DEC (HL) ; decrement it POP HL ; restore pointer JR NZ,JUMP_2 ; forward, if not zero, to JUMP_2 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. ; --------------------- ; THE 'JUMP' SUBROUTINE ; --------------------- ; (offset: $33 'jump') ; This enables the calculator to perform relative jumps just like the Z80 ; chip's JR instruction. JUMP EXX ; switch in pointer set 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. ; -------------------------- ; THE 'JUMP-TRUE' SUBROUTINE ; -------------------------- ; (offset: $00 'jump-true') ; This enables the calculator to perform conditional relative jumps dependent ; on whether the last test gave a true result. 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. ; ------------------------- ; THE 'END-CALC' SUBROUTINE ; ------------------------- ; (offset: $38 'end-calc') ; The end-calc literal terminates a mini-program written in the Spectrum's ; internal language. ; Note. this short 5-byte routine has been moved to space between the ; restarts to exploit spare space. ; ------------------------ ; THE 'MODULUS' SUBROUTINE ; ------------------------ ; (offset: $32 'n-mod-m') ; (n1,n2 -- r,q) ; Similar to FORTH's 'divide mod' /MOD ; On the Spectrum, this is only used internally by the RND function and could ; have been implemented inline. On the ZX81, this calculator routine was also ; used by PRINT-FP. 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. ; ------------------ ; THE 'INT' FUNCTION ; ------------------ ; (offset $27: 'int' ) ; 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, say, +-3.4 as examples. 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 X_NEG - $ ;;to X-NEG DEFB $3A ;;truncate trunc 3.4 = 3. DEFB $38 ;;end-calc 3. RET ; return with + int x on stack. ; --- 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 EXIT - $ ;;to EXIT -3. DEFB $A1 ;;stk-one -3, 1. DEFB $03 ;;subtract -4. EXIT DEFB $38 ;;end-calc -4. RET ; return. ; ------------------ ; THE 'EXP' FUNCTION ; ------------------ ; (offset $26: 'exp') ; The exponential function EXP x is equal to e^x, where e is the mathematical ; name for a number approximated to 2.718281828. ; ERROR 6 if argument is more than about 88. exp RST 28H ;; FP-CALC ;;; DEFB $3D ;;re-stack (not required mult will do) 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 ; 'Number too big' ADD A,(HL) ; JR NC,RESULT_OK ; to RESULT-OK REPORT_6b RST 30H ; ERROR-1 DEFB $05 ; Error Report: Number too big ; --- N_NEGTV JR C,RSLT_ZERO ; to RSLT-ZERO SUB (HL) ; JR NC,RSLT_ZERO ; to RSLT-ZERO NEG ; Negate RESULT_OK LD (HL),A ; RET ; return. ; --- RSLT_ZERO RST 28H ;; FP-CALC DEFB $02 ;;delete DEFB $A0 ;;stk-zero DEFB $38 ;;end-calc RET ; return. ; -------------------------------- ; THE 'NATURAL LOGARITHM' FUNCTION ; -------------------------------- ; (offset $25: 'ln') ; Function to calculate the natural logarithm (to the base e ). ; e.g. LN EXP 5.3 = 5.3 ; Error A if the argument is 0 or negative. ln RST 28H ;; FP-CALC DEFB $3D ;;re-stack DEFB $31 ;;duplicate DEFB $37 ;;greater-0 DEFB $00 ;;jump-true DEFB VALID - $ ;;to VALID INV_ARG DEFB $38 ;;end-calc REPORT_Ab RST 30H ; ERROR-1 DEFB $09 ; Error Report: Invalid argument VALID ;;; DEFB $A0 ;;stk-zero This is unnecessary ;;; 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 GRE_v_8 - $ ;;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 GRE_v_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. ; ----------------------------- ; THE 'TRIGONOMETRIC' FUNCTIONS ; ----------------------------- ; Trigonometry is rocket science. It is also used by carpenters and pyramid ; builders. Some uses can be quite abstract but the principles can be seen ; in simple right-angled triangles. Triangles have some special properties - ; ; 1) The sum of the three angles is always PI radians (180 degrees). ; Very helpful if you know two angles and wish to find the third. ; 2) In any right-angled triangle the sum of the squares of the two shorter ; sides is equal to the square of the longest side opposite the right-angle. ; Very useful if you know the length of two sides and wish to know the ; length of the third side. ; 3) Functions sine, cosine and tangent enable one to calculate the length ; of an unknown side, of a right-angled triangle, when the length of one ; other side and an angle is known. ; 4) Functions arcsin, arccosine and arctan enable one to calculate an unknown ; angle of a right-angled triangle when the length of two of the sides is ; known. ; -------------------------------- ; THE 'REDUCE ARGUMENT' SUBROUTINE ; -------------------------------- ; (offset $39: 'get-argt') ; ; This routine performs two functions on the angle, in radians, that forms ; the argument to the sine and cosine functions. ; First it ensures that the angle 'wraps round'. That if a ship turns through ; an angle of, say, 3*PI radians (540 degrees) then the net effect is to turn ; through an angle of PI radians (180 degrees). ; Secondly it converts the angle in radians to a fraction of a right angle, ; depending within which quadrant the angle lies, with the periodicity ; resembling that of the desired sine value. ; The result lies in the range -1 to +1. ; ; 90 deg. ; ; (pi/2) ; II +1 I ; | ; sin+ |\ | /| sin+ ; cos- | \ | / | cos+ ; tan- | \ | / | tan+ ; | \|/) | ; 180 deg. (pi) 0 -|----+----|-- 0 (0) 0 degrees ; | /|\ | ; sin- | / | \ | sin- ; cos- | / | \ | cos+ ; tan+ |/ | \| tan- ; | ; III -1 IV ; (3pi/2) ; ; 270 deg. ; get_argt RST 28H ;; FP-CALC X. ;;; DEFB $3D ;;re-stack (not required done by mult) DEFB $34 ;;stk-data DEFB $EE ;;Exponent: $7E, ;;Bytes: 4 DEFB $22,$F9,$83,$6E ;; X, 1/(2*PI) DEFB $04 ;;multiply X/(2*PI) = fraction DEFB $31 ;;duplicate DEFB $A2 ;;stk-half DEFB $0F ;;addition DEFB $27 ;;int DEFB $03 ;;subtract now range -.5 to .5 DEFB $31 ;;duplicate DEFB $0F ;;addition now range -1 to 1. DEFB $31 ;;duplicate DEFB $0F ;;addition now range -2 to +2. ; quadrant I (0 to +1) and quadrant IV (-1 to 0) are now correct. ; quadrant II ranges +1 to +2. ; quadrant III ranges -2 to -1. DEFB $31 ;;duplicate Y, Y. DEFB $2A ;;abs Y, abs(Y). range 1 to 2 DEFB $A1 ;;stk-one Y, abs(Y), 1. DEFB $03 ;;subtract Y, abs(Y)-1. range 0 to 1 DEFB $31 ;;duplicate Y, Z, Z. DEFB $37 ;;greater-0 Y, Z, (1/0). DEFB $C0 ;;st-mem-0 store as possible sign ;; for cosine function. DEFB $00 ;;jump-true DEFB ZPLUS - $ ;;to ZPLUS with quadrants II and III. ; else the angle lies in quadrant I or IV and value Y is already correct. DEFB $02 ;;delete Y. delete the test value. DEFB $38 ;;end-calc Y. RET ; return. with Q1 and Q4 >>> ; --- ; The branch was here with quadrants II (0 to 1) and III (1 to 0). ; Y will hold -2 to -1 if this is quadrant III. ZPLUS DEFB $A1 ;;stk-one Y, Z, 1. DEFB $03 ;;subtract Y, Z-1. Q3 = 0 to -1 DEFB $01 ;;exchange Z-1, Y. DEFB $36 ;;less-0 Z-1, (1/0). DEFB $00 ;;jump-true Z-1. DEFB YNEG - $ ;;to YNEG ;;if angle in quadrant III ; else angle is within quadrant II (-1 to 0) DEFB $1B ;;negate range +1 to 0. YNEG DEFB $38 ;;end-calc quadrants II and III correct. RET ; return. ; --------------------- ; THE 'COSINE' FUNCTION ; --------------------- ; (offset $20: 'cos') ; Cosines are calculated as the sine of the opposite angle rectifying the ; sign depending on the quadrant rules. ; ; ; /| ; h /y| ; / |o ; /x | ; /----| ; a ; ; The cosine of angle x is the adjacent side (a) divided by the hypotenuse 1. ; However if we examine angle y then a/h is the sine of that angle. ; Since angle x plus angle y equals a right-angle, we can find angle y by ; subtracting angle x from pi/2. ; However it's just as easy to reduce the argument first and subtract the ; reduced argument from the value 1 (a reduced right-angle). ; It's even easier to subtract 1 from the angle and rectify the sign. ; In fact, after reducing the argument, the absolute value of the argument ; is used and rectified using the test result stored in mem-0 by 'get-argt' ; for that purpose. ; cos RST 28H ;; FP-CALC angle in radians. DEFB $39 ;;get-argt X reduce -1 to +1 DEFB $2A ;;abs ABS X. 0 to 1 DEFB $A1 ;;stk-one ABS X, 1. DEFB $03 ;;subtract now opposite angle ;; although sign is -ve. DEFB $E0 ;;get-mem-0 fetch the sign indicator DEFB $00 ;;jump-true DEFB C_ENT - $ ;;fwd to C-ENT ;;forward to common code if in QII or QIII. DEFB $1B ;;negate else make sign +ve. DEFB $33 ;;jump DEFB C_ENT - $ ;;fwd to C-ENT ;; with quadrants I and IV. ; ------------------- ; THE 'SINE' FUNCTION ; ------------------- ; (offset $1F: 'sin') ; This is a fundamental transcendental function from which others such as cos ; and tan are directly, or indirectly, derived. ; It uses the series generator to produce Chebyshev polynomials. ; ; ; /| ; 1 / | ; / |x ; /a | ; /----| ; y ; ; The 'get-argt' function is designed to modify the angle and its sign ; in line with the desired sine value and afterwards it can launch straight ; into common code. sin RST 28H ;; FP-CALC angle in radians DEFB $39 ;;get-argt reduce - sign now correct. 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. ; ---------------------- ; THE 'TANGENT' FUNCTION ; ---------------------- ; (offset $21: 'tan') ; ; Evaluates tangent x as sin(x) / cos(x). ; ; ; /| ; h / | ; / |o ; /x | ; /----| ; a ; ; the tangent of angle x is the ratio of the length of the opposite side ; divided by the length of the adjacent side. As the opposite length can ; be calculates using sin(x) and the adjacent length using cos(x) then ; the tangent can be defined in terms of the previous two functions. ; Error 6 if the argument, in radians, is too close to one like pi/2 ; which has an infinite tangent. e.g. PRINT TAN (PI/2) evaluates as 1/0. ; Similarly PRINT TAN (3*PI/2), TAN (5*PI/2) etc. 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. ; --------------------- ; THE 'ARCTAN' FUNCTION ; --------------------- ; (Offset $24: 'atn') ; the inverse tangent function with the result in radians. ; This is a fundamental transcendental function from which others such as asn ; and acs are directly, or indirectly, derived. ; It uses the series generator to produce Chebyshev polynomials. atn CALL re_stack ; routine re-stack LD A,(HL) ; fetch exponent byte. CP $81 ; compare to that for 'one' JR C,SMALL ; forward, if less, 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 CASES - $ ;;to CASES DEFB $1B ;;negate DEFB $33 ;;jump DEFB CASES - $ ;;to CASES SMALL RST 28H ;; FP-CALC DEFB $A0 ;;stk-zero 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. ; --------------------- ; THE 'ARCSIN' FUNCTION ; --------------------- ; (Offset $22: 'asn') ; The inverse sine function with result in radians. ; Derived from arctan function above. ; Error A unless the argument is between -1 and +1 inclusive. ; Uses an adaptation of the formula asn(x) = atn(x/sqr(1-x*x)) ; ; ; /| ; / | ; 1/ |x ; /a | ; /----| ; y ; ; e.g. We know the opposite side (x) and hypotenuse (1) ; and we wish to find angle a in radians. ; We can derive length y by Pythagoras and then use ATN instead. ; Since y*y + x*x = 1*1 (Pythagoras Theorem) then ; y=sqr(1-x*x) - no need to multiply 1 by itself. ; So, asn(a) = atn(x/y) ; or more fully, ; asn(a) = atn(x/sqr(1-x*x)) ; Close but no cigar. ; While PRINT ATN (x/SQR (1-x*x)) gives the same results as PRINT ASN x, ; it leads to division by zero when x is 1 or -1. ; To overcome this, 1 is added to y giving half the required angle and the ; result is then doubled. ; That is, PRINT ATN (x/(SQR (1-x*x) +1)) *2 ; ; ; . /| ; . c/ | ; . /1 |x ; . c b /a | ; ---------/----| ; 1 y ; ; By creating an isosceles triangle with two equal sides of 1, angles c and ; c are also equal. If b+c+d = 180 degrees and b+a = 180 degrees then c=a/2. ; ; A value higher than 1 gives the required error as attempting to find the ; square root of a negative number generates an error in Sinclair BASIC. asn RST 28H ;; FP-CALC x. DEFB $31 ;;duplicate x, x. DEFB $31 ;;duplicate x, x, x. DEFB $04 ;;multiply x, x*x. DEFB $A1 ;;stk-one x, x*x, 1. DEFB $03 ;;subtract x, x*x-1. DEFB $1B ;;negate x, 1-x*x. DEFB $28 ;;sqr x, sqr(1-x*x) = y DEFB $A1 ;;stk-one x, y, 1. DEFB $0F ;;addition x, y+1. DEFB $05 ;;division x/y+1. DEFB $24 ;;atn a/2 (half the angle) DEFB $31 ;;duplicate a/2, a/2. DEFB $0F ;;addition a. DEFB $38 ;;end-calc a. RET ; return. ; --------------------- ; THE 'ARCCOS' FUNCTION ; --------------------- ; (Offset $23: 'acs') ; the inverse cosine function with the result in radians. ; Error A unless the argument is between -1 and +1. ; Result in range 0 to pi. ; Derived from asn above which is in turn derived from the preceding atn. ; It could have been derived directly from atn using ; acs(x) = atn(sqr(1-x*x)/x). ; However, as sine and cosine are horizontal translations of each other, ; uses acs(x) = pi/2 - asn(x) ; e.g. the arccosine of a known x value will give the required angle b in ; radians. ; We know, from above, how to calculate the angle a using asn(x). ; Since the three angles of any triangle add up to 180 degrees, or pi radians, ; and the largest angle in this case is a right-angle (pi/2 radians), then ; we can calculate angle b as pi/2 (both angles) minus asn(x) (angle a). ; ; ; /| ; 1 /b| ; / |x ; /a | ; /----| ; y ; acs RST 28H ;; FP-CALC x. DEFB $22 ;;asn asn(x). DEFB $A3 ;;stk-pi/2 asn(x), pi/2. DEFB $03 ;;subtract asn(x) - pi/2. DEFB $1B ;;negate pi/2 -asn(x) = acs(x). DEFB $38 ;;end-calc acs(x). RET ; return. ; ------------------------------ ; THE NEW 'SQUARE ROOT' FUNCTION ; ------------------------------ ; (Offset $28: 'sqr') ; "If I have seen further, it is by standing on the shoulders of giants" - ; Sir Isaac Newton, Cambridge 1676. ; The sqr function has been re-written to use the Newton-Raphson method. ; Although the method is centuries old, this one, appropriately, is based ; on a FORTH word written by Steven Vickers in the Jupiter Ace manual. ; Whereas that algorithm always used an initial guess of one, this one ; manipulates the exponent byte to obtain a better guess. ; First test for zero and return zero, if so, as the result. ; If the argument is negative, then produce an error. sqr RST 28H ;; FP-CALC x DEFB $3D ;;re-stack x. (in f.p. form) DEFB $C3 ;;st-mem-3 x. (seed for guess) DEFB $38 ;;end-calc ; The HL register now addresses the exponent byte LD A,(HL) ; fetch exponent to A AND A ; test for zero. RET Z ; return if so - with zero on calculator stack. INC HL ; address the byte with the sign bit. BIT 7,(HL) ; test the sign bit JP NZ,REPORT_Ab ; REPORT_A: 'Invalid argument' ; This guess is based on a Usenet discussion. ; Halve the exponent to achieve a good guess.(accurate with .25 16 64 etc.) LD HL,$5BA1 ; Address system variable mem-3 LD A,(HL) ; fetch exponent of mem-3 XOR $80 ; toggle sign of exponent of mem-3 SRA A ; shift right, bit 7 unchanged. INC A ; JR Z,ASIS ; forward with say .25 -> .5 JP P,ASIS ; leave increment if value > .5 DEC A ; restore to shift only. ASIS XOR $80 ; restore sign. LD (HL),A ; and put back 'halved' exponent. ; Now re-enter the calculator. RST 28H ;; FP-CALC x SLOOP DEFB $31 ;;duplicate x,x. DEFB $E3 ;;get-mem-3 x,x,guess DEFB $C4 ;;st-mem-4 x,x,guess DEFB $05 ;;div x,x/guess. DEFB $E3 ;;get-mem-3 x,x/guess,guess DEFB $0F ;;addition x,x/guess+guess DEFB $A2 ;;stk-half x,x/guess+guess,.5 DEFB $04 ;;multiply x,(x/guess+guess)*.5 DEFB $C3 ;;st-mem-3 x,newguess DEFB $E4 ;;get-mem-4 x,newguess,oldguess DEFB $03 ;;subtract x,newguess-oldguess DEFB $2A ;;abs x,difference. DEFB $37 ;;greater-0 x,(0/1). DEFB $00 ;;jump-true x. DEFB SLOOP - $ ;;to sloop x. DEFB $02 ;;delete . DEFB $E3 ;;get-mem-3 retrieve final guess. DEFB $38 ;;end-calc sqr x. RET ; return with square root on stack ; ----------------------------------- ; THE OLD SLOW 'SQUARE ROOT' FUNCTION ; ----------------------------------- ; (Offset $28: 'sqr') ; This is the old 7-byte method of calculating square roots which has been ; re-introduced at various stages during the development of this ROM due to ; lack of space. ;;; sqr RST 28H ;; FP-CALC ;;; DEFB $31 ;;duplicate ;;; DEFB $30 ;;not ;;; DEFB $00 ;;jump-true ;;; DEFB LAST - $ ;;to LAST ;;; ;;; DEFB $A2 ;;stk-half ;;; DEFB $38 ;;end-calc ; ------------------------------ ; THE 'EXPONENTIATION' OPERATION ; ------------------------------ ; (Offset $06: 'to-power') ; This raises the first number X to the power of the second number Y. ; As with the ZX80, ; 0 ^ 0 = 1. ; 0 ^ +n = 0. ; 0 ^ -n = arithmetic overflow. ; to_power RST 28H ;; FP-CALC X, Y. DEFB $01 ;;exchange Y, X. DEFB $31 ;;duplicate Y, X, X. DEFB $30 ;;not Y, X, (1/0). DEFB $00 ;;jump-true DEFB XIS0 - $ ;;to XISO if X is zero. ; else X is non-zero. Function 'ln' will catch a negative value of X. DEFB $25 ;;ln Y, LN X. DEFB $04 ;;multiply Y * LN X. DEFB $38 ;;end-calc JP exp ; jump back to EXP routine -> ; --- ; these routines form the three simple results when the number is zero. ; begin by deleting the known zero to leave Y the power factor. XIS0 DEFB $02 ;;delete Y. DEFB $31 ;;duplicate Y, Y. DEFB $30 ;;not Y, (1/0). DEFB $00 ;;jump-true DEFB ONE - $ ;;to ONE if Y is zero. DEFB $A0 ;;stk-zero Y, 0. DEFB $01 ;;exchange 0, Y. DEFB $37 ;;greater-0 0, (1/0). DEFB $00 ;;jump-true 0. DEFB LAST - $ ;;to LAST if Y was any positive ;; number. ; else force division by zero thereby raising an Arithmetic overflow error. ; There are some one and two-byte alternatives but perhaps the most formal ; might have been to use end-calc; rst 08; defb 05. DEFB $A1 ;;stk-one 0, 1. DEFB $01 ;;exchange 1, 0. DEFB $05 ;;division 1/0 ouch! ; --- ONE DEFB $02 ;;delete . DEFB $A1 ;;stk-one 1. LAST DEFB $38 ;;end-calc last value is 1 or 0. RET ; return. Whew! ; ---------------------------- ; THE 'SPARE LOCATIONS' PART 3 ; ---------------------------- TAG7 SPARE DEFB $FF, $FF, $FF ; ORG $3D00 ; ------------------------------- ; THE 'ZX SPECTRUM CHARACTER SET' ; ------------------------------- ; $20 - Character: ' ' CHR$(32) char_set DEFB %00000000 LINE_ZERO DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $21 - Character: '!' CHR$(33) DEFB %00000000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00000000 DEFB %00010000 DEFB %00000000 ; $22 - Character: '"' CHR$(34) DEFB %00000000 DEFB %00100100 DEFB %00100100 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $23 - Character: '#' CHR$(35) DEFB %00000000 DEFB %00100100 DEFB %01111110 DEFB %00100100 DEFB %00100100 DEFB %01111110 DEFB %00100100 DEFB %00000000 ; $24 - Character: '$' CHR$(36) DEFB %00000000 DEFB %00001000 DEFB %00111110 DEFB %00101000 DEFB %00111110 DEFB %00001010 DEFB %00111110 DEFB %00001000 ; $25 - Character: '%' CHR$(37) DEFB %00000000 DEFB %01100010 DEFB %01100100 DEFB %00001000 DEFB %00010000 DEFB %00100110 DEFB %01000110 DEFB %00000000 ; $26 - Character: '&' CHR$(38) DEFB %00000000 DEFB %00010000 DEFB %00101000 DEFB %00010000 DEFB %00101010 DEFB %01000100 DEFB %00111010 DEFB %00000000 ; $27 - Character: ''' CHR$(39) DEFB %00000000 DEFB %00001000 DEFB %00010000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $28 - Character: '(' CHR$(40) DEFB %00000000 DEFB %00000100 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00000100 DEFB %00000000 ; $29 - Character: ')' CHR$(41) DEFB %00000000 DEFB %00100000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00100000 DEFB %00000000 ; $2A - Character: '*' CHR$(42) DEFB %00000000 DEFB %00000000 DEFB %00010100 DEFB %00001000 DEFB %00111110 DEFB %00001000 DEFB %00010100 DEFB %00000000 ; $2B - Character: '+' CHR$(43) DEFB %00000000 DEFB %00000000 DEFB %00001000 DEFB %00001000 DEFB %00111110 DEFB %00001000 DEFB %00001000 DEFB %00000000 ; $2C - Character: ',' CHR$(44) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00001000 DEFB %00001000 DEFB %00010000 ; $2D - Character: '-' CHR$(45) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00111110 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $2E - Character: '.' CHR$(46) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00011000 DEFB %00011000 DEFB %00000000 ; $2F - Character: '/' CHR$(47) DEFB %00000000 DEFB %00000000 DEFB %00000010 DEFB %00000100 DEFB %00001000 DEFB %00010000 DEFB %00100000 DEFB %00000000 ; $30 - Character: '0' CHR$(48) DEFB %00000000 DEFB %00111100 DEFB %01000110 DEFB %01001010 DEFB %01010010 DEFB %01100010 DEFB %00111100 DEFB %00000000 ; $31 - Character: '1' CHR$(49) DEFB %00000000 DEFB %00011000 DEFB %00101000 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00111110 DEFB %00000000 ; $32 - Character: '2' CHR$(50) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %00000010 DEFB %00111100 DEFB %01000000 DEFB %01111110 DEFB %00000000 ; $33 - Character: '3' CHR$(51) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %00001100 DEFB %00000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $34 - Character: '4' CHR$(52) DEFB %00000000 DEFB %00001000 DEFB %00011000 DEFB %00101000 DEFB %01001000 DEFB %01111110 DEFB %00001000 DEFB %00000000 ; $35 - Character: '5' CHR$(53) DEFB %00000000 DEFB %01111110 DEFB %01000000 DEFB %01111100 DEFB %00000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $36 - Character: '6' CHR$(54) DEFB %00000000 DEFB %00111100 DEFB %01000000 DEFB %01111100 DEFB %01000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $37 - Character: '7' CHR$(55) DEFB %00000000 DEFB %01111110 DEFB %00000010 DEFB %00000100 DEFB %00001000 DEFB %00010000 DEFB %00010000 DEFB %00000000 ; $38 - Character: '8' CHR$(56) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %00111100 DEFB %01000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $39 - Character: '9' CHR$(57) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %01000010 DEFB %00111110 DEFB %00000010 DEFB %00111100 DEFB %00000000 ; $3A - Character: ':' CHR$(58) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00010000 DEFB %00000000 DEFB %00000000 DEFB %00010000 DEFB %00000000 ; $3B - Character: ';' CHR$(59) DEFB %00000000 DEFB %00000000 DEFB %00010000 DEFB %00000000 DEFB %00000000 DEFB %00010000 DEFB %00010000 DEFB %00100000 ; $3C - Character: '<' CHR$(60) DEFB %00000000 DEFB %00000000 DEFB %00000100 DEFB %00001000 DEFB %00010000 DEFB %00001000 DEFB %00000100 DEFB %00000000 ; $3D - Character: '=' CHR$(61) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00111110 DEFB %00000000 DEFB %00111110 DEFB %00000000 DEFB %00000000 ; $3E - Character: '>' CHR$(62) DEFB %00000000 DEFB %00000000 DEFB %00010000 DEFB %00001000 DEFB %00000100 DEFB %00001000 DEFB %00010000 DEFB %00000000 ; $3F - Character: '?' CHR$(63) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %00000100 DEFB %00001000 DEFB %00000000 DEFB %00001000 DEFB %00000000 ; $40 - Character: '@' CHR$(64) DEFB %00000000 DEFB %00111100 DEFB %01001010 DEFB %01010110 DEFB %01011110 DEFB %01000000 DEFB %00111100 DEFB %00000000 ; $41 - Character: 'A' CHR$(65) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %01000010 DEFB %01111110 DEFB %01000010 DEFB %01000010 DEFB %00000000 ; $42 - Character: 'B' CHR$(66) DEFB %00000000 DEFB %01111100 DEFB %01000010 DEFB %01111100 DEFB %01000010 DEFB %01000010 DEFB %01111100 DEFB %00000000 ; $43 - Character: 'C' CHR$(67) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %01000000 DEFB %01000000 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $44 - Character: 'D' CHR$(68) DEFB %00000000 DEFB %01111000 DEFB %01000100 DEFB %01000010 DEFB %01000010 DEFB %01000100 DEFB %01111000 DEFB %00000000 ; $45 - Character: 'E' CHR$(69) DEFB %00000000 DEFB %01111110 DEFB %01000000 DEFB %01111100 DEFB %01000000 DEFB %01000000 DEFB %01111110 DEFB %00000000 ; $46 - Character: 'F' CHR$(70) DEFB %00000000 DEFB %01111110 DEFB %01000000 DEFB %01111100 DEFB %01000000 DEFB %01000000 DEFB %01000000 DEFB %00000000 ; $47 - Character: 'G' CHR$(71) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %01000000 DEFB %01001110 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $48 - Character: 'H' CHR$(72) DEFB %00000000 DEFB %01000010 DEFB %01000010 DEFB %01111110 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %00000000 ; $49 - Character: 'I' CHR$(73) DEFB %00000000 DEFB %00111110 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00111110 DEFB %00000000 ; $4A - Character: 'J' CHR$(74) DEFB %00000000 DEFB %00000010 DEFB %00000010 DEFB %00000010 DEFB %01000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $4B - Character: 'K' CHR$(75) DEFB %00000000 DEFB %01000100 DEFB %01001000 DEFB %01110000 DEFB %01001000 DEFB %01000100 DEFB %01000010 DEFB %00000000 ; $4C - Character: 'L' CHR$(76) DEFB %00000000 DEFB %01000000 DEFB %01000000 DEFB %01000000 DEFB %01000000 DEFB %01000000 DEFB %01111110 DEFB %00000000 ; $4D - Character: 'M' CHR$(77) DEFB %00000000 DEFB %01000010 DEFB %01100110 DEFB %01011010 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %00000000 ; $4E - Character: 'N' CHR$(78) DEFB %00000000 DEFB %01000010 DEFB %01100010 DEFB %01010010 DEFB %01001010 DEFB %01000110 DEFB %01000010 DEFB %00000000 ; $4F - Character: 'O' CHR$(79) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $50 - Character: 'P' CHR$(80) DEFB %00000000 DEFB %01111100 DEFB %01000010 DEFB %01000010 DEFB %01111100 DEFB %01000000 DEFB %01000000 DEFB %00000000 ; $51 - Character: 'Q' CHR$(81) DEFB %00000000 DEFB %00111100 DEFB %01000010 DEFB %01000010 DEFB %01010010 DEFB %01001010 DEFB %00111100 DEFB %00000000 ; $52 - Character: 'R' CHR$(82) DEFB %00000000 DEFB %01111100 DEFB %01000010 DEFB %01000010 DEFB %01111100 DEFB %01000100 DEFB %01000010 DEFB %00000000 ; $53 - Character: 'S' CHR$(83) DEFB %00000000 DEFB %00111100 DEFB %01000000 DEFB %00111100 DEFB %00000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $54 - Character: 'T' CHR$(84) DEFB %00000000 DEFB %11111110 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00000000 ; $55 - Character: 'U' CHR$(85) DEFB %00000000 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %00111100 DEFB %00000000 ; $56 - Character: 'V' CHR$(86) DEFB %00000000 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %00100100 DEFB %00011000 DEFB %00000000 ; $57 - Character: 'W' CHR$(87) DEFB %00000000 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %01000010 DEFB %01011010 DEFB %00100100 DEFB %00000000 ; $58 - Character: 'X' CHR$(88) DEFB %00000000 DEFB %01000010 DEFB %00100100 DEFB %00011000 DEFB %00011000 DEFB %00100100 DEFB %01000010 DEFB %00000000 ; $59 - Character: 'Y' CHR$(89) DEFB %00000000 DEFB %10000010 DEFB %01000100 DEFB %00101000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00000000 ; $5A - Character: 'Z' CHR$(90) DEFB %00000000 DEFB %01111110 DEFB %00000100 DEFB %00001000 DEFB %00010000 DEFB %00100000 DEFB %01111110 DEFB %00000000 ; $5B - Character: '[' CHR$(91) DEFB %00000000 DEFB %00001110 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00001110 DEFB %00000000 ; $5C - Character: '\' CHR$(92) DEFB %00000000 DEFB %00000000 DEFB %01000000 DEFB %00100000 DEFB %00010000 DEFB %00001000 DEFB %00000100 DEFB %00000000 ; $5D - Character: ']' CHR$(93) DEFB %00000000 DEFB %01110000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %01110000 DEFB %00000000 ; $5E - Character: '^' CHR$(94) DEFB %00000000 DEFB %00010000 DEFB %00111000 DEFB %01010100 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00000000 ; $5F - Character: '_' CHR$(95) DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %11111111 ; $60 - Character: 'ukp' CHR$(96) DEFB %00000000 DEFB %00011100 DEFB %00100010 DEFB %01111000 DEFB %00100000 DEFB %00100000 DEFB %01111110 DEFB %00000000 ; $61 - Character: 'a' CHR$(97) DEFB %00000000 DEFB %00000000 DEFB %00111000 DEFB %00000100 DEFB %00111100 DEFB %01000100 DEFB %00111100 DEFB %00000000 ; $62 - Character: 'b' CHR$(98) DEFB %00000000 DEFB %00100000 DEFB %00100000 DEFB %00111100 DEFB %00100010 DEFB %00100010 DEFB %00111100 DEFB %00000000 ; $63 - Character: 'c' CHR$(99) DEFB %00000000 DEFB %00000000 DEFB %00011100 DEFB %00100000 DEFB %00100000 DEFB %00100000 DEFB %00011100 DEFB %00000000 ; $64 - Character: 'd' CHR$(100) DEFB %00000000 DEFB %00000100 DEFB %00000100 DEFB %00111100 DEFB %01000100 DEFB %01000100 DEFB %00111100 DEFB %00000000 ; $65 - Character: 'e' CHR$(101) DEFB %00000000 DEFB %00000000 DEFB %00111000 DEFB %01000100 DEFB %01111000 DEFB %01000000 DEFB %00111100 DEFB %00000000 ; $66 - Character: 'f' CHR$(102) DEFB %00000000 DEFB %00001100 DEFB %00010000 DEFB %00011000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00000000 ; $67 - Character: 'g' CHR$(103) DEFB %00000000 DEFB %00000000 DEFB %00111100 DEFB %01000100 DEFB %01000100 DEFB %00111100 DEFB %00000100 DEFB %00111000 ; $68 - Character: 'h' CHR$(104) DEFB %00000000 DEFB %01000000 DEFB %01000000 DEFB %01111000 DEFB %01000100 DEFB %01000100 DEFB %01000100 DEFB %00000000 ; $69 - Character: 'i' CHR$(105) DEFB %00000000 DEFB %00010000 DEFB %00000000 DEFB %00110000 DEFB %00010000 DEFB %00010000 DEFB %00111000 DEFB %00000000 ; $6A - Character: 'j' CHR$(106) DEFB %00000000 DEFB %00000100 DEFB %00000000 DEFB %00000100 DEFB %00000100 DEFB %00000100 DEFB %00100100 DEFB %00011000 ; $6B - Character: 'k' CHR$(107) DEFB %00000000 DEFB %00100000 DEFB %00101000 DEFB %00110000 DEFB %00110000 DEFB %00101000 DEFB %00100100 DEFB %00000000 ; $6C - Character: 'l' CHR$(108) DEFB %00000000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00001100 DEFB %00000000 ; $6D - Character: 'm' CHR$(109) DEFB %00000000 DEFB %00000000 DEFB %01101000 DEFB %01010100 DEFB %01010100 DEFB %01010100 DEFB %01010100 DEFB %00000000 ; $6E - Character: 'n' CHR$(110) DEFB %00000000 DEFB %00000000 DEFB %01111000 DEFB %01000100 DEFB %01000100 DEFB %01000100 DEFB %01000100 DEFB %00000000 ; $6F - Character: 'o' CHR$(111) DEFB %00000000 DEFB %00000000 DEFB %00111000 DEFB %01000100 DEFB %01000100 DEFB %01000100 DEFB %00111000 DEFB %00000000 ; $70 - Character: 'p' CHR$(112) DEFB %00000000 DEFB %00000000 DEFB %01111000 DEFB %01000100 DEFB %01000100 DEFB %01111000 DEFB %01000000 DEFB %01000000 ; $71 - Character: 'q' CHR$(113) DEFB %00000000 DEFB %00000000 DEFB %00111100 DEFB %01000100 DEFB %01000100 DEFB %00111100 DEFB %00000100 DEFB %00000110 ; $72 - Character: 'r' CHR$(114) DEFB %00000000 DEFB %00000000 DEFB %00011100 DEFB %00100000 DEFB %00100000 DEFB %00100000 DEFB %00100000 DEFB %00000000 ; $73 - Character: 's' CHR$(115) DEFB %00000000 DEFB %00000000 DEFB %00111000 DEFB %01000000 DEFB %00111000 DEFB %00000100 DEFB %01111000 DEFB %00000000 ; $74 - Character: 't' CHR$(116) DEFB %00000000 DEFB %00010000 DEFB %00111000 DEFB %00010000 DEFB %00010000 DEFB %00010000 DEFB %00001100 DEFB %00000000 ; $75 - Character: 'u' CHR$(117) DEFB %00000000 DEFB %00000000 DEFB %01000100 DEFB %01000100 DEFB %01000100 DEFB %01000100 DEFB %00111000 DEFB %00000000 ; $76 - Character: 'v' CHR$(118) DEFB %00000000 DEFB %00000000 DEFB %01000100 DEFB %01000100 DEFB %00101000 DEFB %00101000 DEFB %00010000 DEFB %00000000 ; $77 - Character: 'w' CHR$(119) DEFB %00000000 DEFB %00000000 DEFB %01000100 DEFB %01010100 DEFB %01010100 DEFB %01010100 DEFB %00101000 DEFB %00000000 ; $78 - Character: 'x' CHR$(120) DEFB %00000000 DEFB %00000000 DEFB %01000100 DEFB %00101000 DEFB %00010000 DEFB %00101000 DEFB %01000100 DEFB %00000000 ; $79 - Character: 'y' CHR$(121) DEFB %00000000 DEFB %00000000 DEFB %01000100 DEFB %01000100 DEFB %01000100 DEFB %00111100 DEFB %00000100 DEFB %00111000 ; $7A - Character: 'z' CHR$(122) DEFB %00000000 DEFB %00000000 DEFB %01111100 DEFB %00001000 DEFB %00010000 DEFB %00100000 DEFB %01111100 DEFB %00000000 ; $7B - Character: '{' CHR$(123) DEFB %00000000 DEFB %00001110 DEFB %00001000 DEFB %00110000 DEFB %00001000 DEFB %00001000 DEFB %00001110 DEFB %00000000 ; $7C - Character: '|' CHR$(124) DEFB %00000000 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00001000 DEFB %00000000 ; $7D - Character: '}' CHR$(125) DEFB %00000000 DEFB %01110000 DEFB %00010000 DEFB %00001100 DEFB %00010000 DEFB %00010000 DEFB %01110000 DEFB %00000000 ; $7E - Character: '~' CHR$(126) DEFB %00000000 DEFB %00010100 DEFB %00101000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 DEFB %00000000 ; $7F - Character: '(c)' CHR$(127) DEFB %00111100 DEFB %01000010 DEFB %10011001 DEFB %10100001 DEFB %10100001 DEFB %10011001 DEFB %01000010 DEFB %00111100 #end ; generic cross-assembler directive ; Acknowledgements ; ----------------- ; Sean Irvine for default list of section headings. ; Dr. Ian Logan for labels and functional disassembly. ; Dr. Frank O'Hara for labels and functional disassembly. ; Gianluca Carri for labels and functional disassembly. ; ; Credits ; ------- ; Alex Pallero Gonzales for corrections. ; Mike Dailly for comments. ; Alvin Albrecht for comments. ; Andy Styles for full relocatability implementation and testing. ; Andrew Owen for ZASM compatibility and format improvements. ; Philip Kendall for help with Newton Raphson square root theory. ; James Smith for optimizing some ROM routines to save space ; and the FORMAT routine. ; Dave Mills for EPROM burning and real world testing. ; Julian Albo for testing and bug spotting. ; ; ---------------------- ; THE 'SYSTEM VARIABLES' ; ---------------------- ; 5B00 (IY-$3A) 23296 KSTATE_0 $FF (free) else raw key value. ; 5B01 (IY-$39) 23297 KSTATE_1 The 5-counter ; 5B02 (IY-$38) 23298 KSTATE_2 Initially REPDEL value then REPPER ; 5B03 (IY-$37) 23299 KSTATE_3 This location holds the decoded key. ; ------------------------------- ; 5B04 (IY-$36) 23300 KSTATE_4 The second key map is arranged ; 5B05 (IY-$35) 23301 KSTATE_5 exactly as the first above and it is ; 5B06 (IY-$34) 23302 KSTATE_6 in fact this map that is considered ; 5B07 (IY-$33) 23303 KSTATE_7 first by the Keyboard routines. ; ------------------------------- ; 5B08 (IY-$32) 23304 LASTK Value of last key read from keyboard. ; 5B09 (IY-$31) 23305 REPDEL ; 5B0A (IY-$30) 23306 REPPER ; 5B0B (IY-$2F) 23307 DEFADD ; 5B0C (IY-$2E) 23308 DEFADD_hi ; 5B0D (IY-$2D) 23309 KDATA ; 5B0E (IY-$2C) 23310 TVDATA ; 5B0F (IY-$2B) 23311 TVDATA ; ------------------------------- ; 5B10 (IY-$2A) 23312 STRMS_FD ; 5B11 (IY-$29) 23313 STRMS_FD_hi ; 5B12 (IY-$28) 23314 STRMS_FE ; 5B13 (IY-$27) 23315 STRMS_FE_hi ; 5B14 (IY-$26) 23316 STRMS_FF ; 5B15 (IY-$25) 23317 STRMS_FF_hi ; 5B16 (IY-$24) 23318 STRMS_00 ; 5B17 (IY-$23) 23319 STRMS_00_hi ; 5B18 (IY-$22) 23320 STRMS_01 ; 5B19 (IY-$21) 23321 STRMS_01_hi ; 5B1A (IY-$20) 23322 STRMS_02 ; 5B1B (IY-$1F) 23323 STRMS_02_hi ; 5B1C (IY-$1E) 23324 STRMS_03 ; 5B1D (IY-$1D) 23325 STRMS_03_hi ; 5B1E (IY-$1C) 23326 STRMS_04 ; 5B1F (IY-$1B) 23327 STRMS_04_hi ; 5B20 (IY-$1A) 23328 STRMS_05 ; 5B21 (IY-$19) 23329 STRMS_05_hi ; 5B22 (IY-$18) 23330 STRMS_06 ; 5B23 (IY-$17) 23331 STRMS_06_hi ; 5B24 (IY-$16) 23332 STRMS_07 ; 5B25 (IY-$15) 23333 STRMS_07_hi ; 5B26 (IY-$14) 23334 STRMS_08 ; 5B27 (IY-$13) 23335 STRMS_08_hi ; 5B28 (IY-$12) 23336 STRMS_09 ; 5B29 (IY-$11) 23337 STRMS_09_hi ; 5B2A (IY-$10) 23338 STRMS_0A ; 5B2B (IY-$0F) 23339 STRMS_0A_hi ; 5B2C (IY-$0E) 23340 STRMS_0B ; 5B2D (IY-$0D) 23341 STRMS_0B_hi ; 5B2E (IY-$0C) 23342 STRMS_0C ; 5B2F (IY-$0B) 23343 STRMS_0C_hi ; 5B30 (IY-$0A) 23344 STRMS_0D ; 5B31 (IY-$09) 23345 STRMS_0D_hi ; 5B32 (IY-$08) 23346 STRMS_0E ; 5B33 (IY-$07) 23347 STRMS_0E_hi ; 5B34 (IY-$06) 23348 STRMS_0F ; 5B35 (IY-$05) 23349 STRMS_0F_hi ; ------------------------------- ; 5B36 (IY-$04) 23350 CHARS ; 5B37 (IY-$03) 23351 CHARS_hi ; 5B38 (IY-$02) 23352 RASP ; 5B39 (IY-$01) 23353 PIP ; 5B3A (IY+$00) 23354 ERR_NR ; ------------------------------- ; 5B3B (IY+$01) 23355 FLAGS 0 - Set to suppress a leading space. ; 1 - Set if ZX Printer is in use. ; 2 - Set if 'L' mode, temporary value. ; 3 - Set if 'L' mode, reset for 'K' perm. ; 4 - Unused by 48K BASIC. ; 5 - Set in a new key has been pressed. ; 6 - Set if scanning result is numeric. ; 7 - Reset if checking syntax. ; ------------------------------- ; 5B3C (IY+$02) 23356 TV_FLAG 0 - Set if lower screen in use. ; 1 - unused. ; 2 - unused. ; 3 - Set if edit key has been pressed. ; 4 - Set if an automatic listing. ; 5 - Set if lower screen to be cleared. ; 6 - unused. ; 7 - unused. ; ------------------------------- ; 5B3D (IY+$03) 23357 ERR_SP ; 5B3E (IY+$04) 23358 ERR_SP_hi ; 5B3F (IY+$05) 23359 LIST_SP ; 5B40 (IY+$06) 23360 LIST_SP_hi ; 5B41 (IY+$07) 23361 MODE Values 0, 1 or 2 ; 5B42 (IY+$08) 23362 NEWPPC ; 5B43 (IY+$09) 23363 NEWPPC_hi ; 5B44 (IY+$0A) 23364 NSPPC ; 5B45 (IY+$0B) 23365 PPC ; 5B46 (IY+$0C) 23366 PPC_hi ; 5B47 (IY+$0D) 23367 SUBPPC ; 5B48 (IY+$0E) 23368 BORDCR ; 5B49 (IY+$0F) 23369 E_PPC ; 5B4A (IY+$10) 23370 E_PPC_hi ; --------------------------------- ; 5B4B (IY+$11) 23371 VARS ; 5B4C (IY+$12) 23372 VARS_hi ; 5B4D (IY+$13) 23373 DEST ; 5B4E (IY+$14) 23374 DEST_hi ; 5B4F (IY+$15) 23375 CHANS ; 5B50 (IY+$16) 23376 CHANS_hi ; 5B51 (IY+$17) 23377 CURCHL ; 5B52 (IY+$18) 23378 CURCHL_hi ; 5B53 (IY+$19) 23379 PROG ; 5B54 (IY+$1A) 23380 PROG_hi ; 5B55 (IY+$1B) 23381 NXTLIN ; 5B56 (IY+$1C) 23382 NXTLIN_hi ; 5B57 (IY+$1D) 23383 DATADD ; 5B58 (IY+$1E) 23384 DATADD_hi ; 5B59 (IY+$1F) 23385 E_LINE ; 5B5A (IY+$20) 23386 E_LINE_hi ; 5B5B (IY+$21) 23387 K_CUR ; 5B5C (IY+$22) 23388 K_CUR_hi ; 5B5D (IY+$23) 23389 CH_ADD ; 5B5E (IY+$24) 23390 CH_ADD_hi ; 5B5F (IY+$25) 23391 X_PTR ; 5B60 (IY+$26) 23392 X_PTR_hi ; 5B61 (IY+$27) 23393 WORKSP ; 5B62 (IY+$28) 23394 WORKSP_hi ; 5B63 (IY+$29) 23395 STKBOT ; 5B64 (IY+$2A) 23396 STKBOT_hi ; 5B65 (IY+$2B) 23397 STKEND ; 5B66 (IY+$2C) 23398 STKEND_hi ; --------------------------------- ; 5B67 (IY+$2D) 23399 BREG ; 5B68 (IY+$2E) 23400 MEM ; 5B69 (IY+$2F) 23401 MEM_hi ; ------------------------------- ; 5B6A (IY+$30) 23402 FLAGS2 0 - Set if main screen to be cleared. ; 1 - Not used - held state of ZX buffer. ; 2 - Set if a ':' is within quotes. ; 3 - Set if Caps Lock on. ; 4 - Set if "K" channel is use. ; 5 - unused. ; 6 - unused. ; 7 - unused. ; ------------------------------- ; 5B6B (IY+$31) 23403 DF_SZ ; 5B6C (IY+$32) 23404 S_TOP ; 5B6D (IY+$33) 23405 S_TOP_hi ; 5B6E (IY+$34) 23406 OLDPPC ; 5B6F (IY+$35) 23407 OLDPPC_hi ; 5B70 (IY+$36) 23408 OSPPC ; ------------------------------- ; 5B71 (IY+$37) 23409 FLAGX 0 - Set if handling a simple string. ; 1 - Set if handling a new variable. ; 2 - unused. ; 3 - unused. ; 4 - unused. ; 5 - Set if in input mode. ; 6 - unused. ; 7 - Set if handling INPUT LINE. ; ------------------------------- ; 5B72 (IY+$38) 23410 STRLEN ; 5B73 (IY+$39) 23411 STRLEN_hi ; 5B74 (IY+$3A) 23412 T_ADDR ; 5B75 (IY+$3B) 23413 T_ADDR_hi ; 5B76 (IY+$3C) 23414 SEED ; 5B77 (IY+$3D) 23415 SEED_hi ; 5B78 (IY+$3E) 23416 FRAMES1 ; 5B79 (IY+$3F) 23417 FRAMES2 ; 5B7A (IY+$40) 23418 FRAMES3 ; 5B7B (IY+$41) 23419 UDG ; 5B7C (IY+$42) 23420 UDG_hi ; 5B7D (IY+$43) 23421 COORDS_x ; 5B7E (IY+$44) 23422 COORDS_y ; 5B7F (IY+$45) 23423 P_POSN (unused) ; 5B80 (IY+$46) 23424 PR_CC (unused) ; 5B81 (IY+$47) 23425 PR_CC (unused) ; 5B82 (IY+$48) 23426 ECHO_E ; 5B83 (IY+$49) 23427 ECHO_E_hi ; 5B84 (IY+$4A) 23428 DF_CC ; 5B85 (IY+$4B) 23429 DF_CC_hi ; 5B86 (IY+$4C) 23430 DFCCL ; 5B87 (IY+$4D) 23431 DFCCL_hi ; 5B88 (IY+$4E) 23432 S_POSN ; 5B89 (IY+$4F) 23433 S_POSN_hi ; 5B8A (IY+$50) 23434 SPOSNL ; 5B8B (IY+$51) 23435 SPOSNL_hi ; 5B8C (IY+$52) 23436 SCR_CT ; 5B8D (IY+$53) 23437 ATTR_P ; 5B8E (IY+$54) 23438 MASK_P ; 5B8F (IY+$55) 23439 ATTR_T ; 5B90 (IY+$56) 23440 MASK_T ; 5B91 (IY+$57) 23441 P_FLAG ; ------------------------------- ; 5B92 (IY+$58) 23442 MEM_0 ; 5B93 (IY+$59) 23443 MEM_0 ; 5B94 (IY+$5A) 23444 MEM_0 ; 5B95 (IY+$5B) 23445 MEM_0 ; 5B96 (IY+$5C) 23446 MEM_0 ; 5B97 (IY+$5D) 23447 MEM_1 ; 5B98 (IY+$5E) 23448 MEM_1 ; 5B99 (IY+$5F) 23449 MEM_1 ; 5B9A (IY+$60) 23450 MEM_1 ; 5B9B (IY+$61) 23451 MEM_1 ; 5B9C (IY+$62) 23452 MEM_2 ; 5B9D (IY+$63) 23453 MEM_2 ; 5B9E (IY+$64) 23454 MEM_2 ; 5B9F (IY+$65) 23455 MEM_2 ; 5BA0 (IY+$66) 23456 MEM_2 ; 5BA1 (IY+$67) 23457 MEM_3 ; 5BA2 (IY+$68) 23458 MEM_3 ; 5BA3 (IY+$69) 23459 MEM_3 ; 5BA4 (IY+$6A) 23460 MEM_3 ; 5BA5 (IY+$6B) 23461 MEM_3 ; 5BA6 (IY+$6C) 23462 MEM_4 ; 5BA7 (IY+$6D) 23463 MEM_4 ; 5BA8 (IY+$6E) 23464 MEM_4 ; 5BA9 (IY+$6F) 23465 MEM_4 ; 5BAA (IY+$70) 23466 MEM_4 ; 5BAB (IY+$71) 23467 MEM_5 ; 5BAC (IY+$72) 23468 MEM_5 ; 5BAD (IY+$73) 23469 MEM_5 ; 5BAE (IY+$74) 23470 MEM_5 ; 5BAF (IY+$75) 23471 MEM_5 ; ------------------------------- ; 5BB0 (IY+$76) 23472 NMI_ADD ; 5BB1 (IY+$77) 23473 NMI_ADD_hi ; 5BB2 (IY+$78) 23474 RAMTOP ; 5BB3 (IY+$79) 23475 RAMTOP_hi ; 5BB4 (IY+$7A) 23476 P_RAMT ; 5BB5 (IY+$7B) 23477 P_RAMT_hi ; ----------------------------------------------------------------------------- ; 5BB6 (IY+$7C) 23478 FLAGS3 unused - holds FF to show no Interface1 ; 5BB7 (IY+$7D) 23479 WIDTH RS232 Printer column variable ; 5BB8 (IY+$7E) 23480 WIDTH Printer width as set by FORMAT "t" ; 5BB9 (IY+$7F) 23481 MAXIY unused ; 5BBA 23482 BAUD_lo Two Byte number determining the BAUD ; 5BBB 23483 BAUD_hi rate. BAUD=(3500000/(26*baud rate))-2 ; 5BBC 23484 NTSTAT Own Network station number ; 5BBD 23485 IOBORD Border colour used during I/O ; 5BBE 23486 SER_FL 2-byte workspace used by RS232 ; 5BBF 23487 SER_FL holds second character if first is one ; 5BC0 23488 NTRESP Store for the network response code. ; 5BC1 23489 NTDEST Destination station number. ; 5BC2 23490 NTSRCE Source station number. ; 5BC3 23491 NTNUMB_lo Network block number - two bytes ; 5BC4 23492 NTNUMB_hi as received over the network ; 5BC5 23493 NTTYPE Header type code as received. ; 5BC6 23494 NTLEN Data block length 0-255. ; 5BC7 23495 NTDCS Data block checksum. ; 5BC8 23496 NTHCS Header block checksum. ; ; ; Revision History ; ---------------- ; ; 25-AUG-2002 ; All references to System Variables changed from $5C to $5B. ; Changed byte in CHAN-OPEN from $5C to $5B. ; The COPY command re-written so as not to clear the ZX Printer Buffer. ; Channel "P" removed from INITIAL CHANNEL DATA ; Reduced number of bytes copied during initialization from 21 to 16. ; Stream 3 entry removed from INITIAL STREAM DATA ; Reduced number of bytes copied during initialization from 14 to 12. ; Reduced offset in expression within CLOSE from 14 to 12. ; Modify CLOSE routine to error if stream offset is already closed (zero). ; Add new Error report 'Stream is closed' to error message table. ; Modify DE offset in CLOSE from $A3E2 to $A4E4 to reflect new STRMS location ; and fewer system streams. ; Substantially alter CLOSE-2 so that IX used to access letter and offset saved ; in DE. Start of channel saved in IX. ; (Noticed for the first time pointer to letter was previously saved in DE). ; Create new INITIAL P CHANNEL DATA (8 bytes) for channel creation. Contains ; usual 5 bytes plus + 2-byte length + P_POSN (column position). The output ; address PR_CC can't be held as this would vary as channels are deleted. ; ; 26-AUG-2002 ; Modify OPEN-1 so that a stream associated with "P" can't be re-attached. ; Modify OPEN-K so that LD E,$01 becomes LD DE,$0001. ; Modify OPEN-S so that LD E,$06 becomes LD DE,$0006. ; Completely re-write OPEN-P (which was no more sophisticated) so that it ; creates a 264 byte "P" channel at end of CHANS area. ; Remove line in OPEN-END that set high byte of offset to zero.?? ; Remove call to CLEAR-PRB during initialization. ; Remove call to COPY-BUFF at MAIN-4 [ * This will have to be re-visited ] ; Modify print routine so that FLAGS2 is not updated when a ZX buffer used. ; Modify PR-ALL-6 so that address can cross a 256-byte page boundary. ; Modify CLEAR-PRB so that FLAGS2 not cleared when buffer cleared. ; Modify CLEAR-PRB so that superfluous PR_CC reference removed. ; Modify CLEAR_PRB so that address of buffer is calculated from CURCHL. ; Modify COPY-LINE so that CLEAR-PRB only invoked when outputting to a channel ; and BREAK is pressed. ; Realising that CLEAR-PRB can only be used as such, go back to OPEN-P and ; clear the buffer bytes directly. ; Modify COPY_BUFF so that address of buffer is calculated from CURCHL. ; Remove "LD HL,$5B00" from start of CL-SET. Still works for ZX path. ; Modify PO-STORE so that IX from CURCHL used to update P_POSN (channel var). ; Substantially modify PO-FETCH so that the print address within the channel ; buffer is formed from the column position P_POSN. ; ; 27-AUG-2002 ; Write routine CLOSE-P so that channel reclaimed. ; Although not intended as such, this routine turns out to be generic. ; Adapt routine REST-STRM (from Interface 1) so that all other streams that ; have offsets beyond a closed stream have their offsets reduced by the ; reclaimed amount. ; Boot using VBSpec and test that channels open and close OK. ; Switch to RealSpec to test printing. Crash due to A not being preserved ; during new PO-FETCH. Trace and rectify using debugger and notice all OK. ; Switch to DOS Z80 emulator for final paper output tests. Brilliant as always. ; Re-locate FREE-MEM routine to spare space between restarts as address was ; moving around as code was added and removed. ; Free memory has increased from 41472 to 41733 ; ROM space has reduced alarmingly. Only 1040 bytes spare. ; Embark on a spree to remove redundant code. ; Routines ZX81 name routine, REC-EDIT and P-INT-STO commented out. ; 28-AUG-2002 ; Table of constants expanded to five bytes. ; SKIP-CONS commented out - no longer writes to ROM. ; First two instructions of get-mem swapped to provide entry point from ; the stk-con-x routine which is now just 5 bytes. ; To inhibit all writes to ROM, limit scroll routine to 23 lines (not 24). ; Interrupt routine re-written to avoid IY register use. (saves one byte) ; Applied fixes to KEYBOARD so that keywords don't repeat and only valid keys ; return a graphic key code i.e. only A-U. ; Generally, comment out unnecessary stack saves, double loads etc. ; Since labels have no relation to address, change them to use legalized ; disassembly labels. ; 31-AUG-2002 ; Square Root function rewritten to use the Newton-Raphson method. ; Can be improved further by finding a better initial guess than 1. ; 01-SEP-2002 ; Use better initial guess than '1' for Newton Raphson SQR function. ; Works even better when integers are immediately re-stacked as floating point ; numbers. ; 03-SEP-2002 ; More fixes - allow SAVE "program" LINE without number as per BASIC manual. ; ROM space pruning - use UNSTACK_Z to full potential. ; 04-SEP-2002 ; For consistency, use the words "CONTINUE" and "GO SUB" in error messages ; instead of the ZX81 tokens used in the production ZX Spectrum ROM. ; This was a mistake as both messages were at the maximum length. Reverted. ; The INT -65536 bug fixed as per Dr. Ian Logan's guidelines ensuring that the ; 3rd, 4th and 5th bytes were zero. ; 05-SEP-2002 ; All quirks, features and bugs removed. Details as follows. ; Source: Understanding Your Spectrum by Dr. Ian Logan ; (12 bugs listed in appendix) ; i. The 'division' error - is a misnomer. The inaccuracy mentioned occurs ; in the DEC_TO_FP routine and by switching the multiply and division ; operations then 0.5 is given the floating point form 80 00 00 00 00. ; The suggested fix is ignored. ; ii. The '-65536' error e.g. PRINT INT -65536 gives -1. ; Dr. Ian Logan's fix applied (with mods) and other code sections removed ; as suggested. ; iii. The 'program name' routine removed along with REC_EDIT and P_INT_STO. ; iv. The 'CHR$ 9' error corrected by calling PO_ABLE in preference to a ; terminal jump to CL_SET/PO_STORE. ; v. The 'scroll?' and 'Start tape' errors corrected by new routine CONS_IN. ; Later KEY_INPUT modified to recognize prompt (2 extra bytes). ; vi. The current cursor error corrected by updating E_PPC with valid line ; number while it is in the registers at an earlier stage. ; vii. The 'leading space error' resembles more a successful attempt to ; maximise the text that will fit within a 32 character display and has ; not been corrected. Ignored. (On second thoughts, this needs fixing) ; viii.The 'K-mode' error has been corrected by preventing keywords repeating ; when held down. ; ix. The 'CHR$ 8' error has been corrected as suggested by Dr. Frank O'Hara. ; x. The 'SCREEN$' error has been corrected by substituting the suggested RET ; instruction. ; xi. The 'STR$' error has been corrected by removing the extra zero from ; the calculator stack as suggested. ; xii. The 'CLOSE' error has been corrected by checking the status of the ; stream and issuing a new error message if it is already closed. ; The suggested fix - adding a zero end-marker to the Close Stream Look-up ; Table - is ignored. ; ; Source: The Complete Spectrum ROM Disassembly. by Dr. Ian Logan and ; Dr. Frank O'Hara (various additional features listed). ; 1) The NMI bug has been corrected and the logic changed as suggested on ; Page 2. The new default set-up is to produce a new informative message. ; 2) Simple strings are not excluded when saving DATA - on Page 22. ; e.g. 10 LET a$ = "dodo" : SAVE "animal" DATA a$() ; These are now rejected as they won't load back in. ; (credit: First fixed by Dr. Ian Logan in the Interface 1 ROM). ; 3) There is no end-marker for the CLOSE STREAM LOOK UP table nor should ; there be. Ignored. ; ; Source: ZX Spectrum BASIC programming by Steven Vickers. (discrepancies) ; 1) Line number should be optional in SAVE "some name" LINE - Page 133. ; Fixed. ; 2) CLEAR does a RESTORE (Page 124). ; Error in BASIC manual rather than ROM - ignored. Difficult to decide. ; 3) "Notice that the numbers in a DRAW statement can be negative, although ; those in a PLOT statement can't" - Page 92 ; Fixed. 0<=x<=255. 0<=y<=175 else Error B. ; 4) Similarly the POINT (x,y) function allowed negative coordinates. ; Fixed. Error B unless 0<=x<=255. 0<=y<=175. Page 153. ; 5) The ATTR (y,x) function allows negative and invalid coordinates. ; Fixed. Error B unless 0<=x<=31 and 0<=y<=23. Page 152. ; 6) The SCREEN$ (y,x) function allows negative and invalid parameters. ; Fixed. Error B unless 0<=x<=31 and 0<=y<=23. Page 154. ; ; Source: The Pitman Pocket Guide to the Sinclair Spectrum by Steven Vickers. ; (discrepancies not previously mentioned.) ; 1) RESTORE. "Don't specify numbers > 9999, as the program may crash." ; To be pedantic > 16383 - see below. Page 25. ; 2) 'Statement lost' can occur with RUN, GO TO and GO SUB when the line ; number is between 32768 and 61439. Page 67. ; Fixed by new routine which checks SAVE LINE, LIST, LLIST, RUN, GO TO, ; GO SUB and RESTORE for invalid line numbers. ; 3) 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 Page 59. ; Fixed by ensuring that the screen is first selected. ; 4) EDITING KEYS TABLE Page 58. ; When inputting from the network or RS232 or microdrive file, ; code 6 (comma separator): inserted in buffer. ; ("This is a bug. It should work like CHR$ 14"). Fixed. ; ; Source: www.nonowt.com "Bugs in the ROM" ; ( many already covered. Some are Programming Guides rather than errors. ) ; 1) The Monopolizing of IY Error. ; Although not strictly an error, the manual does not mention the ; restriction as did the ZX81 manual. Also some effort has gone into ; ensuring that the calculator avoids IY mathematically and it is restored ; following a USR function. ; Fixed - the interrupt routine uses HL to access system variables. ; Saves a few bytes too. ; 2) The PR_CC error (credit: Dilwyn Jones 1983). ; Fixed - No ZX printer system variables remain. The print position is ; recalculated every time from a single new channel variable. ; 3) The CLEAR PRINTER BUFFER Bug. ; Fixed - COPY no longer clears the buffer at the end of the statement or ; when BREAK pressed. ; 4) The Main-4 COPY-BUFF Error. ; Partly fixed as routine is no longer called but unprinted output is not ; yet flushed. ( To revisit at end ) (Done.) ; 5) The MAIN-4 HALT instruction not corrected as not really an error. ; The fault was with programmers and also with the Interface 1. ; The NMI fix provides a clean means of exit should the situation arise. ; i.e. Should a programmer forget to enable interrupts before returning ; to BASIC. However I have to admit I don't know why it is there. If you ; press BREAK it ensures the message remains a while longer. ; 6) The WRITE TO ROM at $0000 by SKIP_CONS has been avoided by improving ; the way constants are stored and indexed. ; The WRITE TO ROM by the SCROLL routine (credit: P.Giblin) has been ; avoided, as suggested, by ensuring that the full 24 lines are never ; scrolled. ; 7) The unimplemented e-to-fp calculator instruction could be removed by ; assigning $3C to 're-stack'. Five calculator routines would require ; alteration. This would gain two extra bytes of ROM space but has not ; yet been done. ; 8) The INKEY$#0 Error. This could apply to any stream although streams 0 ; and 1 read from the keyboard by default. If the selected stream has ; been attached to the keyboard then the null string is almost always ; returned. The read_in routine correctly cancels any keypress as we are ; not interested in what was pressed, perhaps, half an hour ago. However ; there is hardly anytime for an interrupt to occur before the channel ; is read. Fixed by testing for channel 'K' and executing a HALT if so. ; INKEY$#0 is not the same as INKEY$ as the latter always reads the ; keyboard directly whereas using streams has to take REPDEL and REPPER ; into account e.g. 10 PRINT ; CODE INKEY$#0 ; " "; : GO TO 10 ; ; Miscellaneous BUGS and features. ; ; 1) In graphics mode, keys V, W, X, Y and Z give inappropriate keywords. ; Fixed by not storing key if higher than 'U'. ; 2) USR-$ contains a double check on number of UDGs. First check removed. ; It would be required if there were 26 UDGs and so it may be put back. ; 4) A typo like LIST 40000 was silently changed to LIST 7232. As an error ; is now given, the modifying code (AND $3F) has been removed. ; 3) ZX81 keywords were used in Spectrum error messages. Fixed in error. ; Not possible to add a space to GOSUB without exceeding 32 characters. ; ; ----------------------------------------------------------------------------- ; 06-SEP-2002 ; RST 30H vacated by making BC_SPACES a subroutine. ; The ERROR restart is moved to $0030 to avoid paging in Interface 1 while, ; at the same time, allowing access to its hardware. ; RST 08H made a User Restart with a JP to three unused system variables ; starting at the old P-POSN. This idea later scotched. ; The NMI handler is located in the other 5 bytes. ; Routine PO_ATTR has an EX DE,HL instruction added to return the attribute ; address in DE. (see next) ; Routine OUT_FLASH rewritten to print the character and then set the FLASH ; bit of the attribute address. ; Routine CL_ATTR rearranged to perform attribute calculation last - providing ; a new subroutine CL_ATTR2 which is called twice where a similar sequence ; of instructions used to be. ; 07-SEP-2002 ; ROM usage reduced by reducing absolute jumps. etc. ; The same RASP routine was used in two places and this has been made a ; subroutine. ; Note. there is now one MORE spare byte than in the standard ZX Spectrum. ; There are 1172 unused bytes. ; 16 spare bytes moved to area before Cassette Interface to make addresses ; 04D8 and 056A the same as standard ROM as these are trapped by emulators ; to SAVE and LOAD to tape. ; 240 spare bytes moved to area surrounding $1708 to prevent Interface 1 paging. ; 08-SEP-2002 ; There are now 20 more bytes of free ROM space than in the standard Spectrum ; and that is despite writing an optimized TEST_5_SP routine. ; Optimized STACK_BC so IY not initialized every time. Result pointer set by ; a faster method. ; Optimized sto_mem_x so that memory not checked when removing a value from the ; calculator stack. ; 09-SEP-2002 ; Optimize FP_TO_BC and all routines that call it - FP_TO_A etc. by setting HL ; to the initial value by a faster method. ; Optimize FP_TO_A too. Anything involving the calculator stack has to be ; optimal. ; 10-SEP-2002 ; Noticed EX AF,AF' is little used outside the cassette interface and in some ; places it would be faster than PUSH/POP AF. Not very many. ; Corrected error introduced by pruning in GET_HLxDE. ; 11-SEP-2002 ; remove redundant code from -65536 fix and optimize to avoid machine stack. ; Spare locations = 1207 bytes ; 12-SEP-2002 ; Put back the five bytes before MULT_RSLT and document so I don't remove again. ; Concentrate on testing this stage. ; 13-SEP-2002 ; superfluous instruction removed from PIXEL_ADD ; 50 more bytes of spare ROM space than standard ROM. ; 14-SEP-2002 ; THE OPEN_P routine made generic and called OPEN_ALL. It is only necessary ; to set IX to the channel data before calling it. ; 15-SEP-2002 ; Add RS232 and Network channels. i.e. "B", "T" and "N". ; Less than fourteen bytes spare. ; Requires some tidying up. Stuff like OPEN #7,"N:64" requires implementation. ; Also a few flag setting routines. Looks promising though. ; It is possible to use PRINT, LIST, INPUT and INKEY$ with new channels but ; not SAVE, LOAD, MERGE and VERIFY. Yet. ; The microdrives don't stand a chance but this was all the adverts ever ; promised. Only one machine on the network requires a mass storage device. ; Commands MOVE, ERASE, CAT and FORMAT are not implemented. ; The FORMAT command would be useful for altering the BAUD rate and setting ; the network station number. ; 16-SEP-2002 ; Some problems when breaking into INPUT. Debugging code is in lower case. ; Document to help trace what's happening. ; 17-SEP-2002 ; Discover minor bug in the Interface 1 (and Discovery Disk Interface) at the ; end of GET_NBLK but my own bug eludes me. (BREAK message not being cleared) ; Find the bug in this ROM. Hurrah! I need to reset bit 3 of TV_FLAG before ; entering the editor. ; 18-SEP-2002 ; Complete the documentation of text channel. ; I've worked out where the new string syntax should be enforced. e.g. OPEN "N2" ; In the CLASS-0A routine. The runtime path would populate D_STR1. A lot easier ; than what I was contemplating and the effect is global. i.e. on all CLASS_0A ; strings. ; 19-SEP-2002 ; Alter 'sqr' so that IY not used. Improve comments. Start FILE_DESC. ; 20-SEP-2002 ; Clarify documentation and increase ROM space. ; 21-SEP-2002 ; Removed the 'SUB 08' from multi comparisons calculator routine. ; Re-arranged space between restarts. ; FREE memory is now PRINT 65536 - USR 93. ; 22-SEP-2002 ; Documented 'truncate'. Found a redundant byte and managed to save another. ; Incorporate the network SEND_NEOF routine. Also flush ZX Printer buffer. ; Use 2 as default Iris instead of 0 (broadcast). Input gives a satisfying ; 'End of File' report now. ; 23-SEP-2002 ; Test flags before branching in ED-KEYS saves 8 bytes. ; 24-SEP-2002 ; Modify KEY-INPUT so it recognizes the prompt situation. Get rid of temporary ; routine CONS_IN. Incorporate FILE_SPEC into CLASS_0A. ; 3 ROM bytes spare. Some syntax improvements to do. For instance ; OPEN #7,"printer" now passes through which it shouldn't. ; OPEN #7,"n:64" etc. now works. ; 25-SEP-2002 ; Pressed ahead and made syntax rock-solid. OPEN works fine. Did the FORMAT ; command while in the mood. Well there are now 53 bytes over the 16K limit. ; Always amazing. Found some nice similarities in the T_CHAN/TV_DATA code. ; ; The only way I could get under 16K was to go back to the old sqr routine :-( ; This was, however, merely an indulgence as I believe this was once in ; the ZX81 until the exact same situation arose as has occured now. ; ; Unless there are bugs, I doubt there will be any more updates for months. ; ; The only outstanding task is to SAVE/LOAD programs using the new channels. ; ; I stuck the 2-byte STOP command between the restarts eventually. I still ; have 5-byte and 3-byte unused sections in there. Mail me if you can think of ; a use for them - geoff{at}wearmouth{dot}demon{dot}co{dot}uk ; ; Somewhat belatedly PEEK 9 gives release number - currently 31. ; 26-SEP-2002 ; Corrected errors in proposed syntax. ; 01-OCT-2002 ; Abandoned Interface 1 compatible SAVE/LOAD syntax ; The "new" syntax will be OPEN #7,"n:2" : SAVE #7; "prognam" : CLOSE #7 ; 02-OCT-2002 ; Implemented SAVE/LOAD/MERGE/VERIFY from network and RS232 (both untested). ; Changed Error message for error code R: to just 'Loading error' ; Fixed Graphics mode bug caused by ROM space pruning (credit: Andrew Owen). ; 03-OCT-2002 ; Saving and Listing to RS232 seems to work OK but not Loading. ; This update contains a partial fix. ; 06-OCT-2002 ; This version has 10 spare ROM bytes. ; 08-OCT-2002 ; This has about 20 spare bytes and isolates $1708. ; 13-OCT-2002 ; Improve documentation. ; Apply ROM space saving techniques from James Smith. ; 17-OCT-2002 ; Apply more ROM space saving techniques from James Smith. ; MAKE_ROOM now increments HL which was almost always the next instruction. ; Trying to get enough room to bring back the fast square roots and tidy up. ; 18-OCT-2002 ; Isolate location $1708 again. ; 27-OCT-2002 ; Add the FORMAT routines of James Smith. ; About seven bytes overdrawn. ; 28-OCT-2002 ; reduce object code to 16384 bytes using techniques provided by James. ; 09-NOV-2002 ; Simplify K-DECODE to solve repeating key problem. (Reported by Andrew Owen) ; Rectify CLOSE_A to support 13 ZX printer buffers. ; 10-NOV-2002 ; Change FORMAT command to use FORMAT "channel specifier"; number ; Created new class routine CLASS_0C to allow choice of separators. ; Make OPEN a CLASS-05 routine and allow OPEN #3,"p" and ; OPEN #8,"n",6 with full syntax checking ; This creates almost enough room to bring back the fast square roots. ; 11-NOV-2002 ; Exploit the new CLASS_0C and EXPT_SEP routines to conserve ROM space. ; 13-NOV-2002 ; Optimize Newton Raphson square roots but use old ones for now, as although ; the new ones fit, they leave little room for development. 59 bytes spare. ; 15-NOV-2002 ; At the suggestion of James Smith, now that everything is in one ROM, use ; the PO_SAVE routine for recursive printing of spaces in the text channel TAB ; and comma control routines. So create new routine PO_SV_SP as the preceding ; instruction loads A with a space. What James can save I can squander. ; Rejoice in FORMAT "k", to set the keyboard beep. On second thoughts... ; Output from the RealSpec emulator SERIAL.BIN file. ; 10 OPEN #4,"t" ; 20 LIST #4 ; 30 PRINT #4,,"Hi" ; 40 PRINT #4;TAB 17;"There" ; 50 CLOSE #4 ; Hi ; There ; -------------------------------------------------- ; ; 17-NOV-2002 ; PO_RIGHT shortened. FORMAT_K removed :-) ; ; 22-NOV-2002 ; 'exchange' shortened, Some new routines to modularize common code. ; 100 bytes free ; 24-NOV-2002 ; Added verification from RS232 and Network. ; ED-RIGHT feature fixed. Reported by Andrew Owen. ; Emulator tape support abandoned. Just snapshots (.SNA) and not those from a ; normal Spectrum. ; 27-NOV-2002 ; Fixed a ZX Printer 'feature' revealed by the new VBSpec emulator . ; 30-NOV-2002 ; ZX Printer location $0F24 made standard for new SPIN emulator (fast mode). ; 01-DEC-2002 ; Add 'CLEAR #' command to clear all streams. ; Any ZX Spectrum buffers are flushed first which is interesting in the new ; paperless ZX environment. ; 03-DEC-2002 ; Woohoo! a CAT command. The Spectrum should have had this as standard. ; This version catalogs the streams to the screen. ; Not a lot of detail but give me the space. Ten bytes free. ; 04-DEC-2002 ; Banner above the CAT ; 07-DEC-2002 ; CAT with free memory report. Looks good. ; Once you've used this, it is difficult to give it up. ; I wonder... ; 08-DEC-2002 ; OPEN #7,"n" is now rejected, as previously, without a station but there is ; no room for a 'Missing station number' report. ; 10-DEC-2002 ; Minor improvements. ERASE gives error and not CAT. ; 14-DEC-2002 ; More tweaks and document flags. Enter test phase. ; 15-DEC-2002 ; Enough room for the fast square roots. Even 'ln' has been optimized. ; 22-DEC-2002 ; Tidy and format code. ; 23-DEC-2002 ; Trim COPY-BUFF by one byte and clean up. ; 25-DEC-2002 ; Fix bug in standard ROM at start of INPUT. Stream 1 is designated as the ; user's input stream as per original designer's comments. ; 26-DEC-2002 ; Allow OPEN #0,"n";2 so that commands can be accepted from another Spectrum ; as per Steven Vickers's remarks in the Pitman Pocket Guide. ; The network now sends the buffer on receipt of a carriage return. ; Scrapped the FREE MEMORY TEST - CAT will do just fine. ; 28-DEC-2002 ; The NMI service routine now closes stream 1 in a proper fashion without ; incurring a memory leak. ; 29-DEC-2002 ; Correct a pathing error in the revised scrolling routine. ; Tidy up initialization of BAUD rate. More testing. ; Correct stack corruption in DISP_MSG. Loads from network with messages now. ; Continue testing LOAD and SAVE. ; Commands LOAD, MERGE, VERIFY and SAVE all work ok from streams. ; 01-JAN-2003 ; Free up some spare space. TAG important labels. ; 09-JAN-2003 ; Remove RST 18H after scanning because it's there. Freed bytes not used. ; Tidy up CO_TEMP some of which had been made obsolete earlier. ; 10-JAN-2003 ; Found a natural subroutine to check for a right-hand bracket. ; 23-JAN-2003 ; Correct letter in BCHAN_DAT. ; Correct label in BCHAN_OUT - Saves and Loads OK to RS232 "B" in WinZ80. ; Note. this only works if the Interface1 hardware is selected - the Interface ; ROM paging has been avoided for this reason. ; 02-FEB-2003 ; Network header checksum created (accidentally omitted) one less byte of RAM. ; Cleaner NMI handler written performs a warm reset regaining standard memory. ; Restores all initial channels without memory leaks. ; Reclaims any dynamic buffers attached to them. ; It then performs a warm reset by joining at the initialization of CHARS. ; This code which appears clumsy in the standard Spectrum finally makes sense. ; Then invokes MAIN_G directly. Tested WinZ80. ; Also ROM tested in new Spectaculator 4.0 and ZX Printer routines work fine. ; Also NMI Warm Reset tested with SPIN emulator - F5 key - works great. ; 23-FEB-2003 ; Fixed INKEY$#0 Error. Credit Toni Baker. ; Although Vickers says that this is intended for channels other than the ; keyboard, it should really give some functionality when used with any device. ; The returned key value is of little use and subject to the values of REPPER ; and REPDEL and not the same as INKEY$ which always reads the keyboard ; directly. ; 28-OCT-2003 ; Use 'cos' function to form cosine of central angle in initial parameters ; routine. This does somewhat spoil a good story. The original method was ; to use ; cos a = 1 - 2 * sin(a/2) * sin(a/2) which is the "double angle formula" for ; cosines. This is the correct method as cosine involves 68 calls to TEST-ROOM ; which adds considerably to the 1315 calls used by CIRCLE. However I've used ; the cosine for simplicity and to save a few bytes at the expense of speed. ; 08-NOV-2003 ; Remove superfluous re-stack call from ARC-drawing routine and also remove ; the unnecessary test for zero at DRW_STEPS. The re-stack at get-args is ; also superfluous. ; 10-NOV-2003 ; Remove the optimization of small arcs (jumps to LINE_DRAW) as drawing 4 ; single-pixel arcs on the same, or adjacent, spot seems OK. ; 12-NOV-2003 ; Simpler updating of COORDS in CIRCLE saves a byte. I think the check for ; a sub .5 initial arc could be removed also, but I need to check under what ; circumstances it is invoked first. This file is great for what-if scenarios. ; 09-MAR-2004 ; Bug in the Error Message 1 spotted by Julian Albo. His cure also saves me ; an extra byte and is most welcome. ; ; 11-MAR-2004 ; labels made more generic at the suggestion of Julian Albo. Function ; labels 'or', 'and', 'not', 'in' and commands 'OUT' and 'LIST' changed. ; ; 13-MAR-2004 ; Re-arranged routines to line up tags to ensure compatibility with emulator ; traps. ; ; 18-MAY-2004 ; Corrected and tested the range limits of attr and screen$ parameters. ; ; ; Send any notification for such features to ; geoff {at} wearmouth {dot} ; demon {dot} co {dot} uk