; ***********************************************************************
; ** 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 £ | 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 © |
; | 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 -
; £ 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
; © 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<C
JP NZ,SA_BIT_1 ; JUMP back to SA-BIT-1
; until all 8 bits done.
; when the initial set carry is passed out again then a byte is complete.
DEC DE ; decrease length
INC IX ; increase byte pointer
LD B,$31 ; set up timing.
LD A,$7F ; test the space key and
IN A,($FE) ; return to common exit (to restore border)
RRA ; if a space is pressed
RET NC ; return to SA/LD-RET. - - >
; 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 the