string and the other numeric. ;; SF-NOT-FD L2825: 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 L198B ; routine EACH-STMT steps past rejected ; definition. POP BC ; restore letter/type JR L2808 ; back to SF-FND-DF to continue search ; --- ; Success! ; the branch was here with matching letter and numeric/string type. ;; SF-VALUES L2831: AND A ; test A ( will be zero if string '$' - '$' ) CALL Z,L28AB ; routine FN-SKPOVR advances HL past '$'. POP DE ; discard pointer to 'DEF FN'. POP DE ; restore pointer to first FN argument. LD ($5C5D),DE ; save in CH_ADD CALL L28AB ; routine FN-SKPOVR advances HL past '(' PUSH HL ; save start address in DEF FN *** CP $29 ; is character a ')' ? JR Z,L2885 ; forward to SF-R-BR-2 if no arguments. ;; SF-ARG-LP L2843: INC HL ; point to next character. LD A,(HL) ; fetch it. CP $0E ; is it the number marker LD D,$40 ; signal numeric in D. JR Z,L2852 ; forward to SF-ARG-VL if numeric. DEC HL ; back to letter CALL L28AB ; routine FN-SKPOVR skips any white-space INC HL ; advance past the expected '$' to ; the 'hidden' marker. LD D,$00 ; signal string. ;; SF-ARG-VL L2852: INC HL ; now address first of 5-byte location. PUSH HL ; save address in DEF FN statement PUSH DE ; save D - result type CALL L24FB ; 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,L288B ; forward to REPORT-Q if type mismatch. ; 'Parameter error' POP HL ; pop the start address in DEF FN statement EX DE,HL ; transfer to DE ?? pop straight into de ? LD HL,($5C65) ; 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 ($5C65),HL ; set STKEND 'removing' value from stack. LDIR ; copy value into DEF FN statement EX DE,HL ; set HL to location after value in DEF FN DEC HL ; step back one CALL L28AB ; routine FN-SKPOVR gets next valid character CP $29 ; is it ')' end of arguments ? JR Z,L2885 ; forward to SF-R-BR-2 if so. ; a comma separator has been encountered in the DEF FN argument list. PUSH HL ; save position in DEF FN statement RST 18H ; GET-CHAR from FN statement CP $2C ; is it ',' ? JR NZ,L288B ; forward to REPORT-Q if not ; 'Parameter error' RST 20H ; NEXT-CHAR in FN statement advances to next ; argument. POP HL ; restore DEF FN pointer CALL L28AB ; routine FN-SKPOVR advances to corresponding ; argument. JR L2843 ; 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 L2885: 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,L288D ; forward to SF-VALUE if so. ;; REPORT-Q L288B: RST 08H ; ERROR-1 DEFB $19 ; Error Report: Parameter error ;; SF-VALUE L288D: POP DE ; location of ')' in DEF FN to DE. EX DE,HL ; now to HL, FN ')' pointer to DE. LD ($5C5D),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,($5C0B) ; get original DEFADD address EX (SP),HL ; swap with DEF FN address on stack *** LD ($5C0B),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 L24FB ; routine SCANNING evaluates but searches ; initially for variables at DEFADD POP HL ; pop the FN ')' pointer LD ($5C5D),HL ; set CH_ADD to this POP HL ; pop the original DEFADD value LD ($5C0B),HL ; and re-insert into DEFADD system variable. RST 20H ; NEXT-CHAR advances to character after ')' JP L2712 ; to S-CONT-2 - to continue current ; invocation of scanning ; -------------------- ; Used to parse DEF FN ; -------------------- ; e.g. DEF FN s $ ( x ) = b $ ( TO x ) : REM exaggerated ; ; This routine is used 10 times to advance along a DEF FN statement ; skipping spaces and colour control codes. It is similar to NEXT-CHAR ; which is, at the same time, used to skip along the corresponding FN function ; except the latter has to deal with AT and TAB characters in string ; expressions. These cannot occur in a program area so this routine is ; simpler as both colour controls and their parameters are less than space. ;; FN-SKPOVR L28AB: INC HL ; increase pointer LD A,(HL) ; fetch addressed character CP $21 ; compare with space + 1 JR C,L28AB ; back to FN-SKPOVR if less RET ; return pointing to a valid character. ; --------- ; LOOK-VARS ; --------- ; ; ;; LOOK-VARS L28B2: SET 6,(IY+$01) ; update FLAGS - presume numeric result RST 18H ; GET-CHAR CALL L2C8D ; routine ALPHA tests for A-Za-z JP NC,L1C8A ; jump to REPORT-C if not. ; 'Nonsense in BASIC' PUSH HL ; save pointer to first letter ^1 AND $1F ; mask lower bits, 1 - 26 decimal 000xxxxx LD C,A ; store in C. RST 20H ; NEXT-CHAR PUSH HL ; save pointer to second character ^2 CP $28 ; is it '(' - an array ? JR Z,L28EF ; forward to V-RUN/SYN if so. SET 6,C ; set 6 signaling string if solitary 010 CP $24 ; is character a '$' ? JR Z,L28DE ; forward to V-STR-VAR SET 5,C ; signal numeric 011 CALL L2C88 ; routine ALPHANUM sets carry if second ; character is alphanumeric. JR NC,L28E3 ; forward to V-TEST-FN if just one character ; It is more than one character but re-test current character so that 6 reset ; This loop renders the similar loop at V-PASS redundant. ;; V-CHAR L28D4: CALL L2C88 ; routine ALPHANUM JR NC,L28EF ; to V-RUN/SYN when no more RES 6,C ; make long named type 001 RST 20H ; NEXT-CHAR JR L28D4 ; loop back to V-CHAR ; --- ;; V-STR-VAR L28DE: RST 20H ; NEXT-CHAR advances past '$' RES 6,(IY+$01) ; update FLAGS - signal string result. ;; V-TEST-FN L28E3: LD A,($5C0C) ; load A with DEFADD_hi AND A ; and test for zero. JR Z,L28EF ; forward to V-RUN/SYN if a defined function ; is not being evaluated. ; Note. CALL L2530 ; routine SYNTAX-Z JP NZ,L2951 ; JUMP to STK-F-ARG in runtime and then ; back to this point if no variable found. ;; V-RUN/SYN L28EF: LD B,C ; save flags in B CALL L2530 ; routine SYNTAX-Z JR NZ,L28FD ; to V-RUN to look for the variable in runtime ; if checking syntax the letter is not returned LD A,C ; copy letter/flags to A AND $E0 ; and with 11100000 to get rid of the letter SET 7,A ; use spare bit to signal checking syntax. LD C,A ; and transfer to C. JR L2934 ; forward to V-SYNTAX ; --- ; but in runtime search for the variable. ;; V-RUN L28FD: LD HL,($5C4B) ; set HL to start of variables from VARS ;; V-EACH L2900: LD A,(HL) ; get first character AND $7F ; and with 01111111 ; ignoring bit 7 which distinguishes ; arrays or for/next variables. JR Z,L2932 ; to V-80-BYTE if zero as must be 10000000 ; the variables end-marker. CP C ; compare with supplied value. JR NZ,L292A ; forward to V-NEXT if no match. RLA ; destructively test ADD A,A ; bits 5 and 6 of A ; jumping if bit 5 reset or 6 set JP P,L293F ; to V-FOUND-2 strings and arrays JR C,L293F ; to V-FOUND-2 simple and for next ; leaving long name variables. POP DE ; pop pointer to 2nd. char PUSH DE ; save it again PUSH HL ; save variable first character pointer ;; V-MATCHES L2912: INC HL ; address next character in vars area ;; V-SPACES L2913: LD A,(DE) ; pick up letter from prog area INC DE ; and advance address CP $20 ; is it a space JR Z,L2913 ; back to V-SPACES until non-space OR $20 ; convert to range 1 - 26. CP (HL) ; compare with addressed variables character JR Z,L2912 ; loop back to V-MATCHES if a match on an ; intermediate letter. OR $80 ; now set bit 7 as last character of long ; names are inverted. CP (HL) ; compare again JR NZ,L2929 ; forward to V-GET-PTR if no match ; but if they match check that this is also last letter in prog area LD A,(DE) ; fetch next character CALL L2C88 ; routine ALPHANUM sets carry if not alphanum JR NC,L293E ; forward to V-FOUND-1 with a full match. ;; V-GET-PTR L2929: POP HL ; pop saved pointer to char 1 ;; V-NEXT L292A: PUSH BC ; save flags CALL L19B8 ; routine NEXT-ONE gets next variable in DE EX DE,HL ; transfer to HL. POP BC ; restore the flags JR L2900 ; loop back to V-EACH ; to compare each variable ; --- ;; V-80-BYTE L2932: SET 7,B ; will signal not found ; the branch was here when checking syntax ;; V-SYNTAX L2934: POP DE ; discard the pointer to 2nd. character v2 ; in BASIC line/workspace. RST 18H ; GET-CHAR gets character after variable name. CP $28 ; is it '(' ? JR Z,L2943 ; forward to V-PASS ; Note. could go straight to V-END ? SET 5,B ; signal not an array JR L294B ; 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 L293E: 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 L293F: POP DE ; discard pointer to 2nd prog char v2 POP DE ; drop pointer to 1st prog char v1 PUSH HL ; save pointer to last char in vars RST 18H ; GET-CHAR ;; V-PASS L2943: CALL L2C88 ; routine ALPHANUM JR NC,L294B ; forward to V-END if not ; but it never will be as we advanced past long-named variables earlier. RST 20H ; NEXT-CHAR JR L2943 ; back to V-PASS ; --- ;; V-END L294B: POP HL ; pop the pointer to first character in ; BASIC line/workspace. RL B ; rotate the B register left ; bit 7 to carry BIT 6,B ; test the array indicator bit. RET ; return ; ----------------------- ; Stack function argument ; ----------------------- ; This branch is taken from LOOK-VARS when a defined function is currently ; being evaluated. ; Scanning is evaluating the expression after the '=' and the variable ; found could be in the argument list to the left of the '=' or in the ; normal place after the program. Preference will be given to the former. ; The variable name to be matched is in C. ;; STK-F-ARG L2951: LD HL,($5C0B) ; set HL to DEFADD LD A,(HL) ; load the first character CP $29 ; is it ')' ? JP Z,L28EF ; 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 L295A: 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,L296B ; forward to SFA-CP-VR if so. ; it was a string. White-space may be present but syntax has been checked. DEC HL ; point back to letter. CALL L28AB ; routine FN-SKPOVR skips to the '$' INC HL ; now address the hidden marker. RES 5,B ; signal a string variable. ;; SFA-CP-VR L296B: LD A,B ; transfer found variable letter to A. CP C ; compare with expected. JR Z,L2981 ; forward to SFA-MATCH with a match. INC HL ; step INC HL ; past INC HL ; the INC HL ; five INC HL ; bytes. CALL L28AB ; routine FN-SKPOVR skips to next character CP $29 ; is it ')' ? JP Z,L28EF ; jump back if so to V-RUN/SYN to look in ; normal variables area. CALL L28AB ; routine FN-SKPOVR skips past the ',' ; all syntax has been checked and these ; things can be taken as read. JR L295A ; back to SFA-LOOP while there are more ; arguments. ; --- ;; SFA-MATCH L2981: BIT 5,C ; test if numeric JR NZ,L2991 ; to SFA-END if so as will be stacked ; by scanning INC HL ; point to start of string descriptor LD DE,($5C65) ; set DE to STKEND CALL L33C0 ; routine MOVE-FP puts parameters on stack. EX DE,HL ; new free location to HL. LD ($5C65),HL ; use it to set STKEND system variable. ;; SFA-END L2991: 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 L2996: XOR A ; clear A LD B,A ; and B, the syntax dimension counter (256) BIT 7,C ; checking syntax ? JR NZ,L29E7 ; forward to SV-COUNT if so. ; runtime evaluation. BIT 7,(HL) ; will be reset if a simple string. JR NZ,L29AE ; forward to SV-ARRAYS otherwise INC A ; set A to 1, simple string. ;; SV-SIMPLE$ L29A1: 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 L2AB2 ; routine STK-STO-$ stacks string parameters ; DE start in variables area, ; BC length, A=1 simple string ; the only thing now is to consider if a slice is required. RST 18H ; GET-CHAR puts character at CH_ADD in A JP L2A49 ; jump forward to SV-SLICE? to test for '(' ; -------------------------------------------------------- ; the branch was here with string and numeric arrays in runtime. ;; SV-ARRAYS L29AE: 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,L29C0 ; forward to SV-PTR with numeric arrays DEC B ; ignore the final element of a string array ; the fixed string size. JR Z,L29A1 ; 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,L2A20 ; to REPORT-3 if not ; 'Subscript wrong' EX DE,HL ; dimensions pointer to HL to synchronize ; with next instruction. ; runtime numeric arrays path rejoins here. ;; SV-PTR L29C0: EX DE,HL ; save dimension pointer in DE JR L29E7 ; 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 L29C3: PUSH HL ; save counter RST 18H ; GET-CHAR POP HL ; pop counter CP $2C ; is character ',' ? JR Z,L29EA ; forward to SV-LOOP if so ; in runtime the variable definition indicates a comma should appear here BIT 7,C ; checking syntax ? JR Z,L2A20 ; forward to REPORT-3 if not ; 'Subscript error' ; proceed if checking syntax of an array? BIT 6,C ; array of strings JR NZ,L29D8 ; forward to SV-CLOSE if so ; an array of numbers. CP $29 ; is character ')' ? JR NZ,L2A12 ; forward to SV-RPT-C if not ; 'Nonsense in BASIC' RST 20H ; NEXT-CHAR moves CH-ADD past the statement RET ; return -> ; --- ; the branch was here with an array of strings. ;; SV-CLOSE L29D8: CP $29 ; as above ')' could follow the expression JR Z,L2A48 ; forward to SV-DIM if so CP $CC ; is it 'TO' ? JR NZ,L2A12 ; 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 L29E0: RST 18H ; GET-CHAR DEC HL ; backtrack HL LD ($5C5D),HL ; to set CH_ADD up for slicing routine JR L2A45 ; forward to SV-SLICE and make a return ; when all slicing complete. ; ---------------------------------------- ; -> the mid-point entry point of the loop ;; SV-COUNT L29E7: LD HL,$0000 ; initialize data pointer to zero. ;; SV-LOOP L29EA: 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,L29FB ; 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,L2A48 ; forward to SV-DIM to consider further slice CP $CC ; is it 'TO' ? JR Z,L29E0 ; 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 L29FB: PUSH BC ; save dimension number. PUSH HL ; push data pointer/rubbish. ; DE points to current dimension. CALL L2AEE ; 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 L2ACC ; routine INT-EXP1 checks integer expression ; and gets result in BC in runtime. JR C,L2A20 ; to REPORT-3 if > HL ; 'Subscript out of range' DEC BC ; adjust returned result from 1-x to 0-x CALL L2AF4 ; 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 L29C3 ; 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 L2A12: JR NZ,L2A7A ; forward to SL-RPT-C if so ; 'Nonsense in BASIC' ; more than 256 subscripts in BASIC line. ; but in runtime the number of subscripts are at least the same as dims PUSH HL ; save data pointer. BIT 6,C ; is it a string array ? JR NZ,L2A2C ; forward to SV-ELEM$ if so. ; a runtime numeric array subscript. LD B,D ; register DE has advanced past all dimensions LD C,E ; and points to start of data in variable. ; transfer it to BC. RST 18H ; GET-CHAR checks BASIC line CP $29 ; must be a ')' ? JR Z,L2A22 ; skip to SV-NUMBER if so ; else more subscripts in BASIC line than the variable definition. ;; REPORT-3 L2A20: RST 08H ; ERROR-1 DEFB $02 ; Error Report: Subscript wrong ; continue if subscripts matched the numeric array. ;; SV-NUMBER L2A22: 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 L2AF4 ; 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-ELEM$ L2A2C: CALL L2AEE ; routine DE,(DE+1) gets final dimension ; the length of strings in this array. EX (SP),HL ; start pointer to stack, data pointer to HL. CALL L2AF4 ; 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 L2AB1 ; routine STK-ST-0 stores the string parameters ; with A=0 - a slice or subscript. ; now check that there were no more subscripts in the BASIC line. RST 18H ; GET-CHAR CP $29 ; is it ')' ? JR Z,L2A48 ; 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,L2A20 ; to REPORT-3 with anything else ; 'Subscript error' ;; SV-SLICE L2A45: CALL L2A52 ; routine SLICING slices the string. ; but a slice of a simple string can itself be sliced. ;; SV-DIM L2A48: RST 20H ; NEXT-CHAR ;; SV-SLICE? L2A49: CP $28 ; is character '(' ? JR Z,L2A45 ; loop back if so to SV-SLICE RES 6,(IY+$01) ; update FLAGS - Signal string result RET ; and return. ; --- ; The above section deals with the flexible syntax allowed. ; DIM a$(3,3,10) can be considered as two dimensional array of ten-character ; strings or a 3-dimensional array of characters. ; a$(1,1) will return a 10-character string as will a$(1,1,1 TO 10) ; a$(1,1,1) will return a single character. ; a$(1,1) (1 TO 6) is the same as a$(1,1,1 TO 6) ; A slice can itself be sliced ad infinitum ; b$ () () () () () () (2 TO 10) (2 TO 9) (3) is the same as b$(5) ; ------------------------- ; Handle slicing of strings ; ------------------------- ; The syntax of string slicing is very natural and it is as well to reflect ; on the permutations possible. ; a$() and a$( TO ) indicate the entire string although just a$ would do ; and would avoid coming here. ; h$(16) indicates the single character at position 16. ; a$( TO 32) indicates the first 32 characters. ; a$(257 TO) indicates all except the first 256 characters. ; a$(19000 TO 19999) indicates the thousand characters at position 19000. ; Also a$(9 TO 5) returns a null string not an error. ; This enables a$(2 TO) to return a null string if the passed string is ; of length zero or 1. ; A string expression in brackets can be sliced. e.g. (STR$ PI) (3 TO ) ; We arrived here from SCANNING with CH-ADD pointing to the initial '(' ; or from above. ;; SLICING L2A52: CALL L2530 ; routine SYNTAX-Z CALL NZ,L2BF1 ; 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,L2AAD ; 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,L2A81 ; to SL-SECOND to evaluate second parameter. POP AF ; pop the running flag. CALL L2ACD ; 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,L2A81 ; to SL-SECOND to evaluate second parameter CP $29 ; is it ')' ? e.g. a$(365) ;; SL-RPT-C L2A7A: JP NZ,L1C8A ; jump to REPORT-C with anything else ; 'Nonsense in BASIC' LD H,D ; copy start LD L,E ; to end - just a one character slice. JR L2A94 ; forward to SL-DEFINE. ; --------------------- ;; SL-SECOND L2A81: 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,L2A94 ; to SL-DEFINE using length as end point. POP AF ; else restore flag. CALL L2ACD ; 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,L2A7A ; to SL-RPT-C if not ; 'Nonsense in BASIC' ; we now have start in DE and an end in HL. ;; SL-DEFINE L2A94: 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,L2AA8 ; forward to SL-OVER if start > end. INC HL ; increment the length for inclusive byte. AND A ; now test the running flag. JP M,L2A20 ; jump back to REPORT-3 if $FF. ; 'Subscript out of range' LD B,H ; transfer the length LD C,L ; to BC. ;; SL-OVER L2AA8: POP DE ; restore start address from machine stack *** RES 6,(IY+$01) ; update FLAGS - signal string result for ; syntax. ;; SL-STORE L2AAD: CALL L2530 ; routine SYNTAX-Z (UNSTACK-Z?) RET Z ; return if checking syntax. ; but continue to store the string in runtime. ; ------------------------------------ ; other than from above, this routine is called from STK-VAR to stack ; a known string array element. ; ------------------------------------ ;; STK-ST-0 L2AB1: 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-$ L2AB2: RES 6,(IY+$01) ; update FLAGS - signal string result. ; and continue to store parameters of string. ; --------------------------------------- ; Pass five registers to calculator stack ; --------------------------------------- ; This subroutine puts five registers on the calculator stack. ;; STK-STORE L2AB6: PUSH BC ; save two registers CALL L33A9 ; routine TEST-5-SP checks room and puts 5 ; in BC. POP BC ; fetch the saved registers. LD HL,($5C65) ; 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 ($5C65),HL ; update system variable STKEND. RET ; and return. ; ------------------------------------------- ; Return result of evaluating next expression ; ------------------------------------------- ; This clever routine is used to check and evaluate an integer expression ; which is returned in BC, setting A to $FF, if greater than a limit supplied ; in HL. It is used to check array subscripts, parameters of a string slice ; and the arguments of the DIM command. In the latter case, the limit check ; is not required and H is set to $FF. When checking optional string slice ; parameters, it is entered at the second entry point so as not to disturb ; the running flag A, which may be $00 or $FF from a previous invocation. ;; INT-EXP1 L2ACC: XOR A ; set result flag to zero. ; -> The entry point is here if A is used as a running flag. ;; INT-EXP2 L2ACD: PUSH DE ; preserve DE register throughout. PUSH HL ; save the supplied limit. PUSH AF ; save the flag. CALL L1C82 ; routine EXPT-1NUM evaluates expression ; at CH_ADD returning if numeric result, ; with value on calculator stack. POP AF ; pop the flag. CALL L2530 ; routine SYNTAX-Z JR Z,L2AEB ; forward to I-RESTORE if checking syntax so ; avoiding a comparison with supplied limit. PUSH AF ; save the flag. CALL L1E99 ; 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,L2AE8 ; forward to I-CARRY if zero. POP HL ; restore the limit. PUSH HL ; and save. AND A ; prepare to subtract. SBC HL,BC ; subtract value from limit. ;; I-CARRY L2AE8: LD A,D ; move flag to accumulator $00 or $FF. SBC A,$00 ; will set to $FF if carry set. ;; I-RESTORE L2AEB: 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. ;; DE,(DE+1) L2AEE: 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. ;; GET-HL*DE L2AF4: CALL L2530 ; routine SYNTAX-Z. RET Z ; return if checking syntax. CALL L30A9 ; routine HL-HL*DE. JP C,L1F15 ; jump back to REPORT-4 if over 65535. 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 L2AFF: LD HL,($5C4D) ; fetch system variable DEST to HL. BIT 1,(IY+$37) ; test FLAGX - handling a new variable ? JR Z,L2B66 ; forward to L-EXISTS if not. ; continue for a new variable. DEST points to start in BASIC line. ; from the CLASS routines. LD BC,$0005 ; assume numeric and assign an initial 5 bytes ;; L-EACH-CH L2B0B: INC BC ; increase byte count for each relevant ; character ;; L-NO-SP L2B0C: INC HL ; increase pointer. LD A,(HL) ; fetch character. CP $20 ; is it a space ? JR Z,L2B0C ; back to L-NO-SP is so. JR NC,L2B1F ; forward to L-TEST-CH if higher. CP $10 ; is it $00 - $0F ? JR C,L2B29 ; forward to L-SPACES if so. CP $16 ; is it $16 - $1F ? JR NC,L2B29 ; forward to L-SPACES if so. ; it was $10 - $15 so step over a colour code. INC HL ; increase pointer. JR L2B0C ; loop back to L-NO-SP. ; --- ; the branch was to here if higher than space. ;; L-TEST-CH L2B1F: CALL L2C88 ; routine ALPHANUM sets carry if alphanumeric JR C,L2B0B ; loop back to L-EACH-CH for more if so. CP $24 ; is it '$' ? JP Z,L2BC0 ; jump forward if so, to L-NEW$ ; with a new string. ;; L-SPACES L2B29: LD A,C ; save length lo in A. LD HL,($5C59) ; fetch E_LINE to HL. DEC HL ; point to location before, the variables ; end-marker. CALL L1655 ; routine MAKE-ROOM creates BC spaces ; for name and numeric value. INC HL ; advance to first new location. INC HL ; then to second. EX DE,HL ; set DE to second location. PUSH DE ; save this pointer. LD HL,($5C4D) ; 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,L2B4F ; forward to L-SINGLE if it was just ; one character. ; HL points to start of variable name after 'LET' in BASIC line. ;; L-CHAR L2B3E: INC HL ; increase pointer. LD A,(HL) ; pick up character. CP $21 ; is it space or higher ? JR C,L2B3E ; 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 L2B3E ; 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 L2B4F: LD HL,($5C4D) ; 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 L2BEA ; routine L-FIRST puts A in first character. ; and returns with HL holding ; new E_LINE-1 the $80 vars end-marker. ;; L-NUMERIC L2B59: PUSH HL ; save the pointer. ; the value of variable is deleted but remains after calculator stack. RST 28H ;; FP-CALC DEFB $02 ;;delete ; delete variable value DEFB $38 ;;end-calc ; DE (STKEND) points to start of value. POP HL ; restore the pointer. LD BC,$0005 ; start of number is five bytes before. AND A ; prepare for true subtraction. SBC HL,BC ; HL points to start of value. JR L2BA6 ; forward to L-ENTER ==> ; --- ; the jump was to here if the variable already existed. ;; L-EXISTS L2B66: BIT 6,(IY+$01) ; test FLAGS - numeric or string result ? JR Z,L2B72 ; 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 L2B59 ; back to L-NUMERIC to overwrite value. ; --- ; -*-> the branch was here if a string existed. ;; L-DELETE$ L2B72: LD HL,($5C4D) ; fetch DEST to HL. ; (still set from first instruction) LD BC,($5C72) ; fetch STRLEN to BC. BIT 0,(IY+$37) ; test FLAGX - handling a complete simple ; string ? JR NZ,L2BAF ; forward to L-ADD$ if so. ; must be a string array or a slice in workspace. ; Note. LET a$(3 TO 6) = h$ will assign "hat " if h$ = "hat" ; and "hats" if h$ = "hatstand". ; ; This is known as Procrustean lengthening and shortening after a ; character Procrustes in Greek legend who made travellers sleep in his bed, ; cutting off their feet or stretching them so they fitted the bed perfectly. ; The bloke was hatstand and slain by Theseus. LD A,B ; test if length OR C ; is zero and RET Z ; return if so. PUSH HL ; save pointer to start. RST 30H ; BC-SPACES creates room. PUSH DE ; save pointer to first new location. PUSH BC ; and length (*) LD D,H ; set DE to point to last location. LD E,L ; INC HL ; set HL to next location. LD (HL),$20 ; place a space there. LDDR ; copy bytes filling with spaces. PUSH HL ; save pointer to start. CALL L2BF1 ; 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,L2B9B ; forward if it fits to L-LENGTH. LD B,H ; otherwise set LD C,L ; length to old length. ; "hatstand" becomes "hats" ;; L-LENGTH L2B9B: 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,L2BA3 ; forward to L-IN-W/S if so ; leaving prepared spaces. LDIR ; else copy bytes overwriting some spaces. ;; L-IN-W/S L2BA3: 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 L2BA6: EX DE,HL ; exchange pointers HL=STKEND DE=end of vars. LD A,B ; test the length OR C ; and make a RET Z ; return if zero (strings only). PUSH DE ; save start of destination. LDIR ; copy bytes. POP HL ; address the start. RET ; and return. ; --- ; the branch was here from L-DELETE$ if an existing simple string. ; register HL addresses start of string in variables area. ;; L-ADD$ L2BAF: 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 L2BC6 ; 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 L19E8 ; jump to indirect exit via RECLAIM-2 ; deleting old version and adjusting pointers. ; --- ; the jump was here with a new string variable. ;; L-NEW$ L2BC0: LD A,$DF ; indicator mask %11011111 for ; %010xxxxx will be result LD HL,($5C4D) ; address DEST first character. AND (HL) ; combine mask with character. ;; L-STRING L2BC6: PUSH AF ; save first character and mask. CALL L2BF1 ; routine STK-FETCH fetches parameters of ; the string. EX DE,HL ; transfer start to HL. ADD HL,BC ; add to length. PUSH BC ; save the length. DEC HL ; point to end of string. LD ($5C4D),HL ; save pointer in DEST. ; (updated by POINTERS if in workspace) INC BC ; extra byte for letter. INC BC ; two bytes INC BC ; for the length of string. LD HL,($5C59) ; address E_LINE. DEC HL ; now end of VARS area. CALL L1655 ; routine MAKE-ROOM makes room for string. ; updating pointers including DEST. LD HL,($5C4D) ; 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 L2BEA: DEC HL ; address variable name LD (HL),A ; and insert character. LD HL,($5C59) ; load HL with E_LINE. DEC HL ; now end of VARS area. RET ; return ; ------------------------------------ ; Get last value from calculator stack ; ------------------------------------ ; ; ;; STK-FETCH L2BF1: LD HL,($5C65) ; 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 ($5C65),HL ; STKEND RET ; ; ------------------ ; Handle 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 L2C02: CALL L28B2 ; routine LOOK-VARS ;; D-RPORT-C L2C05: JP NZ,L1C8A ; jump to REPORT-C if a long-name variable. ; DIM lottery numbers(49) doesn't work. CALL L2530 ; routine SYNTAX-Z JR NZ,L2C15 ; forward to D-RUN in runtime. RES 6,C ; signal 'numeric' array even if string as ; this simplifies the syntax checking. CALL L2996 ; routine STK-VAR checks syntax. CALL L1BEE ; routine CHECK-END performs early exit -> ; the branch was here in runtime. ;; D-RUN L2C15: JR C,L2C1F ; skip to D-LETTER if variable did not exist. ; else reclaim the old one. PUSH BC ; save type in C. CALL L19B8 ; routine NEXT-ONE find following variable ; or position of $80 end-marker. CALL L19E8 ; routine RECLAIM-2 reclaims the ; space between. POP BC ; pop the type. ;; D-LETTER L2C1F: 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,L2C2D ; forward to D-SIZE if so. LD L,$05 ; make elements 5 bytes as is numeric. ;; D-SIZE L2C2D: 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 L2C2E: RST 20H ; NEXT-CHAR LD H,$FF ; disable limit check by setting HL high CALL L2ACC ; routine INT-EXP1 JP C,L2A20 ; to REPORT-3 if > 65280 and then some ; 'Subscript out of range' POP HL ; pop dimension counter, array type PUSH BC ; save dimension size *** INC H ; increment the dimension counter PUSH HL ; save the dimension counter LD H,B ; transfer size LD L,C ; to HL CALL L2AF4 ; 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,L2C2E ; loop back to D-NO-LOOP until all dimensions ; have been considered ; when loop complete continue. CP $29 ; is it ')' ? JR NZ,L2C05 ; to D-RPORT-C with anything else ; 'Nonsense in BASIC' RST 20H ; NEXT-CHAR advances to next statement/CR POP BC ; pop dimension counter/type LD A,C ; type to A ; now calculate space required for array variable LD L,B ; dimensions to L since these require 16 bits ; then this value will be doubled LD H,$00 ; set high byte to zero ; another four bytes are required for letter(1), total length(2), number of ; dimensions(1) but since we have yet to double allow for two INC HL ; increment INC HL ; increment ADD HL,HL ; now double giving 4 + dimensions * 2 ADD HL,DE ; add to space required for array contents JP C,L1F15 ; to REPORT-4 if > 65535 ; 'Out of memory' PUSH DE ; save data space PUSH BC ; save dimensions/type PUSH HL ; save total space LD B,H ; total space LD C,L ; to BC LD HL,($5C59) ; address E_LINE - first location after ; variables area DEC HL ; point to location before - the $80 end-marker CALL L1655 ; routine MAKE-ROOM creates the space if ; memory is available. INC HL ; point to first new location and LD (HL),A ; store letter/type POP BC ; pop total space DEC BC ; exclude name DEC BC ; exclude the 16-bit DEC BC ; counter itself INC HL ; point to next location the 16-bit counter LD (HL),C ; insert low byte INC HL ; address next LD (HL),B ; insert high byte POP BC ; pop the number of dimensions. LD A,B ; dimensions to A INC HL ; address next LD (HL),A ; and insert "No. of dims" LD H,D ; transfer DE space + 1 from make-room LD L,E ; to HL DEC DE ; set DE to next location down. LD (HL),$00 ; presume numeric and insert a zero BIT 6,C ; test bit 6 of C. numeric or string ? JR Z,L2C7C ; skip to DIM-CLEAR if numeric LD (HL),$20 ; place a space character in HL ;; DIM-CLEAR L2C7C: 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 L2C7F: 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,L2C7F ; back to DIM-SIZES until all done. RET ; return. ; ----------------------------- ; Check whether digit or letter ; ----------------------------- ; This routine checks that the character in A is alphanumeric ; returning with carry set if so. ;; ALPHANUM L2C88: CALL L2D1B ; routine NUMERIC will reset carry if so. CCF ; Complement Carry Flag RET C ; Return if numeric else continue into ; next routine. ; This routine checks that the character in A is alphabetic ;; ALPHA L2C8D: CP $41 ; less than 'A' ? CCF ; Complement Carry Flag RET NC ; return if so CP $5B ; less than 'Z'+1 ? RET C ; is within first range CP $61 ; less than 'a' ? CCF ; Complement Carry Flag RET NC ; return if so. CP $7B ; less than 'z'+1 ? RET ; carry set if within a-z. ; ------------------------- ; Decimal to floating point ; ------------------------- ; This routine finds the floating point number represented by an expression ; beginning with BIN, '.' or a digit. ; Note that BIN need not have any '0's or '1's after it. ; BIN is really just a notational symbol and not a function. ;; DEC-TO-FP L2C9B: CP $C4 ; 'BIN' token ? JR NZ,L2CB8 ; to NOT-BIN if not LD DE,$0000 ; initialize 16 bit buffer register. ;; BIN-DIGIT L2CA2: 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,L2CB3 ; 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,L31AD ; 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 L2CA2 ; back to BIN-DIGIT for more digits ; --- ;; BIN-END L2CB3: LD B,D ; transfer 16 bit buffer LD C,E ; to BC register pair. JP L2D2B ; JUMP to STACK-BC to put on calculator stack ; --- ; continue here with .1, 42, 3.14, 5., 2.3 E -4 ;; NOT-BIN L2CB8: CP $2E ; '.' - leading decimal point ? JR Z,L2CCB ; skip to DECIMAL if so. CALL L2D3B ; routine INT-TO-FP to evaluate all digits ; This number 'x' is placed on stack. CP $2E ; '.' - mid decimal point ? JR NZ,L2CEB ; to E-FORMAT if not to consider that format RST 20H ; NEXT-CHAR CALL L2D1B ; routine NUMERIC returns carry reset if 0-9 JR C,L2CEB ; to E-FORMAT if not a digit e.g. '1.' JR L2CD5 ; to DEC-STO-1 to add the decimal part to 'x' ; --- ; a leading decimal point has been found in a number. ;; DECIMAL L2CCB: RST 20H ; NEXT-CHAR CALL L2D1B ; routine NUMERIC will reset carry if digit ;; DEC-RPT-C L2CCF: JP C,L1C8A ; to REPORT-C if just a '.' ; raise 'Nonsense in BASIC' ; since there is no leading zero put one on the calculator stack. RST 28H ;; FP-CALC DEFB $A0 ;;stk-zero ; 0. DEFB $38 ;;end-calc ; If rejoining from earlier there will be a value 'x' on stack. ; If continuing from above the value zero. ; Now store 1 in mem-0. ; Note. At each pass of the digit loop this will be divided by ten. ;; DEC-STO-1 L2CD5: 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 L2CDA: RST 18H ; GET-CHAR CALL L2D22 ; routine STK-DIGIT stacks single digit 'd' JR C,L2CEB ; exit to E-FORMAT when digits exhausted > RST 28H ;; FP-CALC ;x or 0,d. first pass. DEFB $E0 ;;get-mem-0 ;x or 0,d,1. DEFB $A4 ;;stk-ten ;x or 0,d,1,10. DEFB $05 ;;division ;x or 0,d,1/10. DEFB $C0 ;;st-mem-0 ;x or 0,d,1/10. DEFB $04 ;;multiply ;x or 0,d/10. DEFB $0F ;;addition ;x or 0 + d/10. DEFB $38 ;;end-calc last value. RST 20H ; NEXT-CHAR moves to next character JR L2CDA ; back to NXT-DGT-1 ; --- ; although only the first pass is shown it can be seen that at each pass ; the new less significant digit is multiplied by an increasingly smaller ; factor (1/100, 1/1000, 1/10000 ... ) before being added to the previous ; last value to form a new last value. ; Finally see if an exponent has been input. ;; E-FORMAT L2CEB: CP $45 ; is character 'E' ? JR Z,L2CF2 ; to SIGN-FLAG if so CP $65 ; 'e' is acceptable as well. RET NZ ; return as no exponent. ;; SIGN-FLAG L2CF2: LD B,$FF ; initialize temporary sign byte to $FF RST 20H ; NEXT-CHAR CP $2B ; is character '+' ? JR Z,L2CFE ; to SIGN-DONE CP $2D ; is character '-' ? JR NZ,L2CFF ; 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 L2CFE: RST 20H ; NEXT-CHAR ;; ST-E-PART L2CFF: CALL L2D1B ; routine NUMERIC JR C,L2CCF ; to DEC-RPT-C if not ; raise 'Nonsense in BASIC'. PUSH BC ; save sign (in B) CALL L2D3B ; routine INT-TO-FP places exponent on stack CALL L2DD5 ; routine FP-TO-A transfers it to A POP BC ; restore sign JP C,L31AD ; to REPORT-6 if overflow (over 255) ; raise 'Number too big'. AND A ; set flags JP M,L31AD ; 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,L2D18 ; forward to E-FP-JUMP if exponent positive NEG ; Negate the exponent. ;; E-FP-JUMP L2D18: JP L2D4F ; JUMP forward to E-TO-FP to assign to ; last value x on stack x * 10 to power A ; a relative jump would have done. ; --------------------- ; Check for valid digit ; --------------------- ; This routine checks that the ASCII character in A is numeric ; returning with carry reset if so. ;; NUMERIC L2D1B: CP $30 ; '0' RET C ; return if less than zero character. CP $3A ; The upper test is '9' CCF ; Complement Carry Flag RET ; Return - carry clear if character '0' - '9' ; ----------- ; Stack Digit ; ----------- ; This subroutine is called from INT-TO-FP and DEC-TO-FP to stack a digit ; on the calculator stack. ;; STK-DIGIT L2D22: CALL L2D1B ; routine NUMERIC RET C ; return if not numeric character SUB $30 ; convert from ASCII to digit ; ----------------- ; Stack accumulator ; ----------------- ; ; ;; STACK-A L2D28: LD C,A ; transfer to C LD B,$00 ; and make B zero ; ---------------------- ; Stack BC register pair ; ---------------------- ; ;; STACK-BC L2D2B: LD IY,$5C3A ; re-initialize ERR_NR XOR A ; clear to signal small integer LD E,A ; place in E for sign LD D,C ; LSB to D LD C,B ; MSB to C LD B,A ; last byte not used CALL L2AB6 ; routine STK-STORE RST 28H ;; FP-CALC DEFB $38 ;;end-calc make HL = STKEND-5 AND A ; clear carry RET ; before returning ; ------------------------- ; Integer to floating point ; ------------------------- ; This routine places one or more digits found in a BASIC line ; on the calculator stack multiplying the previous value by ten each time ; before adding in the new digit to form a last value on calculator stack. ;; INT-TO-FP L2D3B: 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 L2D40: CALL L2D22 ; 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 L0074 ; routine CH-ADD+1 get next character JR L2D40 ; back to NXT-DGT-2 to process as a digit ;********************************* ;** Part 9. ARITHMETIC ROUTINES ** ;********************************* ; -------------------------- ; E-format to floating point ; -------------------------- ; This subroutine is used by the PRINT-FP routine and the decimal to FP ; routines to stack a number expressed in exponent format. ; Note. Though not used by the ROM as such, it has also been set up as ; a unary calculator literal but this will not work as the accumulator ; is not available from within the calculator. ; on entry there is a value x on the calculator stack and an exponent of ten ; in A. The required value is x + 10 ^ A ;; e-to-fp ;; E-TO-FP L2D4F: RLCA ; this will set the x. RRCA ; carry if bit 7 is set JR NC,L2D55 ; to E-SAVE if positive. CPL ; make negative positive INC A ; without altering carry. ;; E-SAVE L2D55: PUSH AF ; save positive exp and sign in carry LD HL,$5C92 ; address MEM-0 CALL L350B ; 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 L2D60: SRL A ; 0>76543210>C JR NC,L2D71 ; forward to E-TST-END if no bit PUSH AF ; save shifted exponent. RST 28H ;; FP-CALC DEFB $C1 ;;st-mem-1 x, 10. DEFB $E0 ;;get-mem-0 x, 10, (0/1). DEFB $00 ;;jump-true DEFB $04 ;;to L2D6D, E-DIVSN DEFB $04 ;;multiply x*10. DEFB $33 ;;jump DEFB $02 ;;to L2D6E, E-FETCH ;; E-DIVSN L2D6D: DEFB $05 ;;division x/10. ;; E-FETCH L2D6E: 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 L2D71: JR Z,L2D7B ; 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 L2D60 ; 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 L2D7B: RST 28H ;; FP-CALC final x, factor. DEFB $02 ;;delete final x. DEFB $38 ;;end-calc x. RET ; return ; ------------- ; Fetch integer ; ------------- ; This routine is called by the mathematical routines - FP-TO-BC, PRINT-FP, ; mult, re-stack and negate to fetch an integer from address HL. ; HL points to the stack or a location in MEM and no deletion occurs. ; If the number is negative then a similar process to that used in INT-STORE ; is used to restore the twos complement number to normal in DE and a sign ; in C. ;; INT-FETCH L2D7F: INC HL ; skip zero indicator. LD C,(HL) ; fetch sign to C INC HL ; address low byte LD A,(HL) ; fetch to A XOR C ; two's complement SUB C ; LD E,A ; place in E INC HL ; address high byte LD A,(HL) ; fetch to A ADC A,C ; two's complement XOR C ; LD D,A ; place in D RET ; return ; ------------------------ ; Store a positive integer ; ------------------------ ; This entry point is not used in this ROM but would ; store any integer as positive. ;; p-int-sto L2D8C: LD C,$00 ; make sign byte positive and continue ; ------------- ; Store integer ; ------------- ; this routine stores an integer in DE at address HL. ; It is called from 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 L2D8E: PUSH HL ; preserve HL LD (HL),$00 ; first byte zero shows integer not exponent INC HL ; LD (HL),C ; then store the sign byte INC HL ; ; e.g. +1 -1 LD A,E ; fetch low byte 00000001 00000001 XOR C ; xor sign 00000000 or 11111111 ; gives 00000001 or 11111110 SUB C ; sub sign 00000000 or 11111111 ; gives 00000001>0 or 11111111>C LD (HL),A ; store 2's complement. INC HL ; LD A,D ; high byte 00000000 00000000 ADC A,C ; sign 00000000<0 11111111<C ; gives 00000000 or 00000000 XOR C ; xor sign 00000000 11111111 LD (HL),A ; store 2's complement. INC HL ; LD (HL),$00 ; last byte always zero for integers. ; is not used and need not be looked at when ; testing for zero but comes into play should ; an integer be converted to fp. POP HL ; restore HL RET ; return. ; ----------------------------- ; Floating point to BC register ; ----------------------------- ; This routine gets a floating point number e.g. 127.4 from the calculator ; stack to the BC register. ;; FP-TO-BC L2DA2: RST 28H ;; FP-CALC set HL to DEFB $38 ;;end-calc point to last value. LD A,(HL) ; get first of 5 bytes AND A ; and test JR Z,L2DAD ; forward to FP-DELETE if an integer ; The value is first rounded up and then converted to integer. RST 28H ;; FP-CALC x. DEFB $A2 ;;stk-half x. 1/2. DEFB $0F ;;addition x + 1/2. DEFB $27 ;;int int(x + .5) DEFB $38 ;;end-calc ; now delete but leave HL pointing at integer ;; FP-DELETE L2DAD: RST 28H ;; FP-CALC DEFB $02 ;;delete DEFB $38 ;;end-calc PUSH HL ; save pointer. PUSH DE ; and STKEND. EX DE,HL ; make HL point to exponent/zero indicator LD B,(HL) ; indicator to B CALL L2D7F ; routine INT-FETCH ; gets int in DE sign byte to C ; but meaningless values if a large integer XOR A ; clear A SUB B ; subtract indicator byte setting carry ; if not a small integer. BIT 7,C ; test a bit of the sign byte setting zero ; if positive. LD B,D ; transfer int LD C,E ; to BC LD A,E ; low byte to A as a useful return value. POP DE ; pop STKEND POP HL ; and pointer to last value RET ; return ; if carry is set then the number was too big. ; ------------ ; LOG(2^A) ; ------------ ; This routine is used when printing floating point numbers to calculate ; the number of digits before the decimal point. ; first convert a one-byte signed integer to its five byte form. ;; LOG(2^A) L2DC1: LD D,A ; store a copy of A in D. RLA ; test sign bit of A. SBC A,A ; now $FF if negative or $00 LD E,A ; sign byte to E. LD C,A ; and to C XOR A ; clear A LD B,A ; and B. CALL L2AB6 ; routine STK-STORE stacks number AEDCB ; so 00 00 XX 00 00 (positive) or 00 FF XX FF 00 (negative). ; i.e. integer indicator, sign byte, low, high, unused. ; now multiply exponent by log to the base 10 of two. RST 28H ;; FP-CALC DEFB $34 ;;stk-data .30103 (log 2) DEFB $EF ;;Exponent: $7F, Bytes: 4 DEFB $1A,$20,$9A,$85 ;; DEFB $04 ;;multiply DEFB $27 ;;int DEFB $38 ;;end-calc ; ------------------- ; Floating point to A ; ------------------- ; this routine collects a floating point number from the stack into the ; accumulator returning carry set if not in range 0 - 255. ; Not all the calling routines raise an error with overflow so no attempt ; is made to produce an error report here. ;; FP-TO-A L2DD5: CALL L2DA2 ; routine FP-TO-BC returns with C in A also. RET C ; return with carry set if > 65535, overflow PUSH AF ; save the value and flags DEC B ; and test that INC B ; the high byte is zero. JR Z,L2DE1 ; forward FP-A-END if zero ; else there has been 8-bit overflow POP AF ; retrieve the value SCF ; set carry flag to show overflow RET ; and return. ; --- ;; FP-A-END L2DE1: POP AF ; restore value and success flag and RET ; return. ; ----------------------------- ; Print a floating point number ; ----------------------------- ; Not a trivial task. ; Begin by considering whether to print a leading sign for negative numbers. ;; PRINT-FP L2DE3: RST 28H ;; FP-CALC DEFB $31 ;;duplicate DEFB $36 ;;less-0 DEFB $00 ;;jump-true DEFB $0B ;;to L2DF2, PF-NEGTVE DEFB $31 ;;duplicate DEFB $37 ;;greater-0 DEFB $00 ;;jump-true DEFB $0D ;;to L2DF8, 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 L2DF2: 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 L2DF8: 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 L2E01: 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,L2E56 ; 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 L2D7F ; routine INT-FETCH gets x in DE ; (but x is not deleted) LD B,$10 ; set B, bit counter, to 16d LD A,D ; test if AND A ; high byte is zero JR NZ,L2E1E ; 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,L2E24 ; 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 L2E1E: PUSH DE ; save the part before decimal point. EXX ; POP DE ; and pop in into D'E' EXX ; JR L2E7B ; forward to PF-BITS ; --------------------- ; the branch was here when 'int x' was found to be zero as in say 0.5. ; The zero has been fetched from the calculator stack but not deleted and ; this should occur now. This omission leaves the stack unbalanced and while ; that causes no problems with a simple PRINT statement, it will if str$ is ; being used in an expression e.g. "2" + STR$ 0.5 gives the result "0.5" ; instead of the expected result "20.5". ; credit Tony Stratton, 1982. ; A DEFB 02 delete is required immediately on using the calculator. ;; PF-SMALL L2E24: RST 28H ;; FP-CALC int x = 0. L2E25: DEFB $E2 ;;get-mem-2 int x = 0, x-int x. DEFB $38 ;;end-calc LD A,(HL) ; fetch exponent of positive fractional number SUB $7E ; subtract CALL L2DC1 ; routine LOG(2^A) calculates leading digits. LD D,A ; transfer count to D LD A,($5CAC) ; fetch total MEM-5-1 SUB D ; LD ($5CAC),A ; MEM-5-1 LD A,D ; CALL L2D4F ; 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 L2DD5 ; routine FP-TO-A PUSH HL ; save HL LD ($5CA1),A ; MEM-3-1 DEC A ; RLA ; SBC A,A ; INC A ; LD HL,$5CAB ; 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 JP L2ECF ; 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 L2E56: SUB $80 ; make exponent positive CP $1C ; compare to 28 JR C,L2E6F ; to PF-MEDIUM if integer <= 2^27 CALL L2DC1 ; routine LOG(2^A) SUB $07 ; LD B,A ; LD HL,$5CAC ; 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 L2D4F ; routine E-TO-FP JR L2E01 ; back to PF-LOOP ; ---------------------------- ;; PF-MEDIUM L2E6F: EX DE,HL ; CALL L2FBA ; 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 L2E7B: SLA E ; C<xxxxxxxx<0 RL D ; C<xxxxxxxx<C EXX ; RL E ; C<xxxxxxxx<C RL D ; C<xxxxxxxx<C EXX ; LD HL,$5CAA ; set HL to mem-4-5th last byte of buffer LD C,$05 ; set byte count to 5 - 10 nibbles ;; PF-BYTES L2E8A: LD A,(HL) ; fetch 0 or prev value ADC A,A ; shift left add in carry C<xxxxxxxx<C DAA ; Decimal Adjust Accumulator. ; if greater than 9 then the left hand ; nibble is incremented. If greater than ; 99 then adjusted and carry set. ; so if we'd built up 7 and a carry came in ; 0000 0111 < C ; 0000 1111 ; daa 1 0101 which is 15 in BCD LD (HL),A ; put back DEC HL ; work down thru mem 4 DEC C ; decrease the 5 counter. JR NZ,L2E8A ; back to PF-BYTES until the ten nibbles rolled DJNZ L2E7B ; back to PF-BITS until 8 or 16 (or 32) done ; at most 9 digits for 32-bit number will have been loaded with digits ; each of the 9 nibbles in mem 4 is placed into ten bytes in mem-3 and mem 4 ; unless the nibble is zero as the buffer is already zero. ; ( or in the case of mem-5 will become zero as a result of RLD instruction ) XOR A ; clear to accept LD HL,$5CA6 ; address MEM-4-0 byte destination. LD DE,$5CA1 ; address MEM-3-0 nibble source. LD B,$09 ; the count is 9 (not ten) as the first ; nibble is known to be blank. RLD ; shift RH nibble to left in (HL) ; A (HL) ; 0000 0000 < 0000 3210 ; 0000 0000 3210 0000 ; A picks up the blank nibble LD C,$FF ; set a flag to indicate when a significant ; digit has been encountered. ;; PF-DIGITS L2EA1: RLD ; pick up leftmost nibble from (HL) ; A (HL) ; 0000 0000 < 7654 3210 ; 0000 7654 3210 0000 JR NZ,L2EA9 ; to PF-INSERT if non-zero value picked up. DEC C ; test INC C ; flag JR NZ,L2EB3 ; skip forward to PF-TEST-2 if flag still $FF ; indicating this is a leading zero. ; but if the zero is a significant digit e.g. 10 then include in digit totals. ; the path for non-zero digits rejoins here. ;; PF-INSERT L2EA9: LD (DE),A ; insert digit at destination INC DE ; increase the destination pointer INC (IY+$71) ; increment MEM-5-1st digit counter INC (IY+$72) ; increment MEM-5-2nd leading digit counter LD C,$00 ; set flag to zero indicating that any ; subsequent zeros are significant and not ; leading. ;; PF-TEST-2 L2EB3: BIT 0,B ; test if the nibble count is even JR Z,L2EB8 ; skip to PF-ALL-9 if so to deal with the ; other nibble in the same byte INC HL ; point to next source byte if not ;; PF-ALL-9 L2EB8: DJNZ L2EA1 ; decrement the nibble count, back to PF-DIGITS ; if all nine not done. ; For 8-bit integers there will be at most 3 digits. ; For 16-bit integers there will be at most 5 digits. ; but for larger integers there could be nine leading digits. ; if nine digits complete then the last one is rounded up as the number will ; be printed using E-format notation LD A,($5CAB) ; fetch digit count from MEM-5-1st SUB $09 ; subtract 9 - max possible JR C,L2ECB ; forward if less to PF-MORE DEC (IY+$71) ; decrement digit counter MEM-5-1st to 8 LD A,$04 ; load A with the value 4. CP (IY+$6F) ; compare with MEM-4-4th - the ninth digit JR L2F0C ; forward to PF-ROUND ; to consider rounding. ; --------------------------------------- ; now delete int x from calculator stack and fetch fractional part. ;; PF-MORE L2ECB: RST 28H ;; FP-CALC int x. DEFB $02 ;;delete . DEFB $E2 ;;get-mem-2 x - int x = f. DEFB $38 ;;end-calc f. ;; PF-FRACTN L2ECF: EX DE,HL ; CALL L2FBA ; routine FETCH-TWO EXX ; LD A,$80 ; SUB L ; LD L,$00 ; SET 7,D ; EXX ; CALL L2FDD ; routine SHIFT-FP ;; PF-FRN-LP L2EDF: LD A,(IY+$71) ; MEM-5-1st CP $08 ; JR C,L2EEC ; to PF-FR-DGT EXX ; RL D ; EXX ; JR L2F0C ; to PF-ROUND ; --- ;; PF-FR-DGT L2EEC: LD BC,$0200 ; ;; PF-FR-EXX L2EEF: LD A,E ; CALL L2F8B ; routine CA-10*A+C LD E,A ; LD A,D ; CALL L2F8B ; routine CA-10*A+C LD D,A ; PUSH BC ; EXX ; POP BC ; DJNZ L2EEF ; to PF-FR-EXX LD HL,$5CA1 ; MEM-3 LD A,C ; LD C,(IY+$71) ; MEM-5-1st ADD HL,BC ; LD (HL),A ; INC (IY+$71) ; MEM-5-1st JR L2EDF ; to PF-FRN-LP ; ---------------- ; 1) with 9 digits but 8 in mem-5-1 and A holding 4, carry set if rounding up. ; e.g. ; 999999999 is printed as 1E+9 ; 100000001 is printed as 1E+8 ; 100000009 is printed as 1.0000001E+8 ;; PF-ROUND L2F0C: PUSH AF ; save A and flags LD HL,$5CA1 ; address MEM-3 start of digits LD C,(IY+$71) ; MEM-5-1st No. of digits to C LD B,$00 ; prepare to add ADD HL,BC ; address last digit + 1 LD B,C ; No. of digits to B counter POP AF ; restore A and carry flag from comparison. ;; PF-RND-LP L2F18: DEC HL ; address digit at rounding position. LD A,(HL) ; fetch it ADC A,$00 ; add carry from the comparison LD (HL),A ; put back result even if $0A. AND A ; test A JR Z,L2F25 ; skip to PF-R-BACK if ZERO? CP $0A ; compare to 'ten' - overflow CCF ; complement carry flag so that set if ten. JR NC,L2F2D ; forward to PF-COUNT with 1 - 9. ;; PF-R-BACK L2F25: DJNZ L2F18 ; loop back to PF-RND-LP ; if B counts down to zero then we've rounded right back as in 999999995. ; and the first 8 locations all hold $0A. LD (HL),$01 ; load first location with digit 1. INC B ; make B hold 1 also. ; could save an instruction byte here. INC (IY+$72) ; make MEM-5-2nd hold 1. ; and proceed to initialize total digits to 1. ;; PF-COUNT L2F2D: LD (IY+$71),B ; MEM-5-1st ; now balance the calculator stack by deleting it RST 28H ;; FP-CALC DEFB $02 ;;delete DEFB $38 ;;end-calc ; note if used from str$ then other values may be on the calculator stack. ; we can also restore the next literal pointer from its position on the ; machine stack. EXX ; POP HL ; restore next literal pointer. EXX ; LD BC,($5CAB) ; set C to MEM-5-1st digit counter. ; set B to MEM-5-2nd leading digit counter. LD HL,$5CA1 ; set HL to start of digits at MEM-3-1 LD A,B ; CP $09 ; JR C,L2F46 ; to PF-NOT-E CP $FC ; JR C,L2F6C ; to PF-E-FRMT ;; PF-NOT-E L2F46: AND A ; test for zero leading digits as in .123 CALL Z,L15EF ; routine OUT-CODE prints a zero e.g. 0.123 ;; PF-E-SBRN L2F4A: XOR A ; SUB B ; JP M,L2F52 ; skip forward to PF-OUT-LP if originally +ve LD B,A ; else negative count now +ve JR L2F5E ; forward to PF-DC-OUT -> ; --- ;; PF-OUT-LP L2F52: LD A,C ; fetch total digit count AND A ; test for zero JR Z,L2F59 ; forward to PF-OUT-DT if so LD A,(HL) ; fetch digit INC HL ; address next digit DEC C ; decrease total digit counter ;; PF-OUT-DT L2F59: CALL L15EF ; routine OUT-CODE outputs it. DJNZ L2F52 ; loop back to PF-OUT-LP until B leading ; digits output. ;; PF-DC-OUT L2F5E: 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 L2F64: RST 10H ; PRINT-A outputs the character '.' or '0' LD A,$30 ; prepare the character '0' ; (for cases like .000012345678) DJNZ L2F64 ; loop back to PF-DEC-0S for B times. LD B,C ; load B with now trailing digit counter. JR L2F52 ; back to PF-OUT-LP ; --------------------------------- ; the branch was here for E-format printing e.g. 123456789 => 1.2345679e+8 ;; PF-E-FRMT L2F6C: LD D,B ; counter to D DEC D ; decrement LD B,$01 ; load B with 1. CALL L2F4A ; 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,L2F83 ; to PF-E-POS if positive NEG ; negate LD C,A ; positive exponent to C LD A,$2D ; prepare character '-' JR L2F85 ; skip to PF-E-SIGN ; --- ;; PF-E-POS L2F83: LD A,$2B ; prepare character '+' ;; PF-E-SIGN L2F85: RST 10H ; PRINT-A outputs the sign LD B,$00 ; make the high byte zero. JP L1A1B ; exit via OUT-NUM-1 to print exponent in BC ; ------------------------------ ; Handle printing floating point ; ------------------------------ ; This subroutine is called twice from above when printing floating-point ; numbers. It returns 10*A +C in registers C and A ;; CA-10*A+C L2F8B: PUSH DE ; preserve DE. LD L,A ; transfer A to L LD H,$00 ; zero high byte. LD E,L ; copy HL LD D,H ; to DE. ADD HL,HL ; double (*2) ADD HL,HL ; double (*4) ADD HL,DE ; add DE (*5) ADD HL,HL ; double (*10) LD E,C ; copy C to E (D is 0) ADD HL,DE ; and add to give required result. LD C,H ; transfer to LD A,L ; destination registers. POP DE ; restore DE RET ; return with result. ; -------------- ; Prepare to add ; -------------- ; This routine is called twice by addition to prepare the two numbers. The ; exponent is picked up in A and the location made zero. Then the sign bit ; is tested before being set to the implied state. Negative numbers are twos ; complemented. ;; PREP-ADD L2F9B: LD A,(HL) ; pick up exponent LD (HL),$00 ; make location zero AND A ; test if number is zero RET Z ; return if so INC HL ; address mantissa BIT 7,(HL) ; test the sign bit SET 7,(HL) ; set it to implied state DEC HL ; point to exponent RET Z ; return if positive number. PUSH BC ; preserve BC LD BC,$0005 ; length of number ADD HL,BC ; point HL past end LD B,C ; set B to 5 counter LD C,A ; store exponent in C SCF ; set carry flag ;; NEG-BYTE L2FAF: 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 L2FAF ; loop to NEG-BYTE till all 5 done LD A,C ; stored exponent to A POP BC ; restore original BC RET ; return ; ----------------- ; Fetch two numbers ; ----------------- ; This routine is called twice when printing floating point numbers and also ; to fetch two numbers by the addition, multiply and division routines. ; HL addresses the first number, DE addresses the second number. ; For arithmetic only, A holds the sign of the result which is stored in ; the second location. ;; FETCH-TWO L2FBA: PUSH HL ; save pointer to first number, result if math. PUSH AF ; save result sign. LD C,(HL) ; INC HL ; LD B,(HL) ; LD (HL),A ; store the sign at correct location in ; destination 5 bytes for arithmetic only. INC HL ; LD A,C ; LD C,(HL) ; PUSH BC ; INC HL ; LD C,(HL) ; INC HL ; LD B,(HL) ; EX DE,HL ; LD D,A ; LD E,(HL) ; PUSH DE ; INC HL ; LD D,(HL) ; INC HL ; LD E,(HL) ; PUSH DE ; EXX ; POP DE ; POP HL ; POP BC ; EXX ; INC HL ; LD D,(HL) ; INC HL ; LD E,(HL) ; POP AF ; restore possible result sign. POP HL ; and pointer to possible result. RET ; return. ; --------------------------------- ; Shift floating point number right ; --------------------------------- ; ; ;; SHIFT-FP L2FDD: AND A ; RET Z ; CP $21 ; JR NC,L2FF9 ; to ADDEND-0 PUSH BC ; LD B,A ; ;; ONE-SHIFT L2FE5: EXX ; SRA L ; RR D ; RR E ; EXX ; RR D ; RR E ; DJNZ L2FE5 ; to ONE-SHIFT POP BC ; RET NC ; CALL L3004 ; routine ADD-BACK RET NZ ; ;; ADDEND-0 L2FF9: EXX ; XOR A ; ;; ZEROS-4/5 L2FFB: LD L,$00 ; LD D,A ; LD E,L ; EXX ; LD DE,$0000 ; RET ; ; ------------------ ; Add back any carry ; ------------------ ; ; ;; ADD-BACK L3004: INC E ; RET NZ ; INC D ; RET NZ ; EXX ; INC E ; JR NZ,L300D ; to ALL-ADDED INC D ; ;; ALL-ADDED L300D: EXX ; RET ; ; ----------------------- ; Handle subtraction (03) ; ----------------------- ; Subtraction is done by switching the sign byte/bit of the second number ; which may be integer of floating point and continuing into addition. ;; subtract L300F: EX DE,HL ; address second number with HL CALL L346E ; routine NEGATE switches sign EX DE,HL ; address first number again ; and continue. ; -------------------- ; Handle addition (0F) ; -------------------- ; HL points to first number, DE to second. ; If they are both integers, then go for the easy route. ;; addition L3014: LD A,(DE) ; fetch first byte of second OR (HL) ; combine with first byte of first JR NZ,L303E ; forward to FULL-ADDN if at least one was ; in floating point form. ; continue if both were small integers. PUSH DE ; save pointer to lowest number for result. INC HL ; address sign byte and PUSH HL ; push the pointer. INC HL ; address low byte LD E,(HL) ; to E INC HL ; address high byte LD D,(HL) ; to D INC HL ; address unused byte INC HL ; address known zero indicator of 1st number INC HL ; address sign byte LD A,(HL) ; sign to A, $00 or $FF INC HL ; address low byte LD C,(HL) ; to C INC HL ; address high byte LD B,(HL) ; to B POP HL ; pop result sign pointer EX DE,HL ; integer to HL ADD HL,BC ; add to the other one in BC ; setting carry if overflow. EX DE,HL ; save result in DE bringing back sign pointer ADC A,(HL) ; if pos/pos A=01 with overflow else 00 ; if neg/neg A=FF with overflow else FE ; if mixture A=00 with overflow else FF RRCA ; bit 0 to (C) ADC A,$00 ; both acceptable signs now zero JR NZ,L303C ; forward to ADDN-OFLW if not SBC A,A ; restore a negative result sign LD (HL),A ; INC HL ; LD (HL),E ; INC HL ; LD (HL),D ; DEC HL ; DEC HL ; DEC HL ; POP DE ; STKEND RET ; ; --- ;; ADDN-OFLW L303C: DEC HL ; POP DE ; ;; FULL-ADDN L303E: CALL L3293 ; routine RE-ST-TWO EXX ; PUSH HL ; EXX ; PUSH DE ; PUSH HL ; CALL L2F9B ; routine PREP-ADD LD B,A ; EX DE,HL ; CALL L2F9B ; routine PREP-ADD LD C,A ; CP B ; JR NC,L3055 ; to SHIFT-LEN LD A,B ; LD B,C ; EX DE,HL ; ;; SHIFT-LEN L3055: PUSH AF ; SUB B ; CALL L2FBA ; routine FETCH-TWO CALL L2FDD ; 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,L307C ; to TEST-NEG LD A,$01 ; CALL L2FDD ; routine SHIFT-FP INC (HL) ; JR Z,L309F ; to ADD-REP-6 ;; TEST-NEG L307C: EXX ; LD A,L ; AND $80 ; EXX ; INC HL ; LD (HL),A ; DEC HL ; JR Z,L30A5 ; 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,L30A3 ; to END-COMPL RRA ; EXX ; INC (HL) ; ;; ADD-REP-6 L309F: JP Z,L31AD ; to REPORT-6 EXX ; ;; END-COMPL L30A3: LD D,A ; EXX ; ;; GO-NC-MLT L30A5: XOR A ; JP L3155 ; to TEST-NORM ; ----------------------------- ; Used in 16 bit multiplication ; ----------------------------- ; This routine is used, in the first instance, by the multiply calculator ; literal to perform an integer multiplication in preference to ; 32-bit multiplication to which it will resort if this overflows. ; ; It is also used by STK-VAR to calculate array subscripts and by DIM to ; calculate the space required for multi-dimensional arrays. ;; HL-HL*DE L30A9: 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 L30B1: ADD HL,HL ; double result JR C,L30BE ; to HL-END if overflow RL C ; shift AC left into carry RLA ; JR NC,L30BC ; to HL-AGAIN to skip addition if no carry ADD HL,DE ; add in DE JR C,L30BE ; to HL-END if overflow ;; HL-AGAIN L30BC: DJNZ L30B1 ; back to HL-LOOP for all 16 bits ;; HL-END L30BE: 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 L30C0: CALL L34E9 ; 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 'MULTIPLY' ROUTINE ; ---------------------- ; (offset: $04 'multiply') ; ; ; "He said go forth and something about mathematics, I wasn't really ; listening" - overheard conversation between two unicorns. ; [ The Odd Streak ]. ;; multiply L30CA: LD A,(DE) ; OR (HL) ; JR NZ,L30F0 ; to MULT-LONG PUSH DE ; PUSH HL ; PUSH DE ; CALL L2D7F ; routine INT-FETCH EX DE,HL ; EX (SP),HL ; LD B,C ; CALL L2D7F ; routine INT-FETCH LD A,B ; XOR C ; LD C,A ; POP HL ; CALL L30A9 ; routine HL-HL*DE EX DE,HL ; POP HL ; JR C,L30EF ; to MULT-OFLW LD A,D ; OR E ; JR NZ,L30EA ; to MULT-RSLT LD C,A ; ;; MULT-RSLT L30EA: CALL L2D8E ; routine INT-STORE POP DE ; RET ; ; --- ;; MULT-OFLW L30EF: POP DE ; ;; MULT-LONG L30F0: CALL L3293 ; routine RE-ST-TWO XOR A ; CALL L30C0 ; routine PREP-M/D RET C ; EXX ; PUSH HL ; EXX ; PUSH DE ; EX DE,HL ; CALL L30C0 ; routine PREP-M/D EX DE,HL ; JR C,L315D ; to ZERO-RSLT PUSH HL ; CALL L2FBA ; routine FETCH-TWO LD A,B ; AND A ; SBC HL,HL ; EXX ; PUSH HL ; SBC HL,HL ; EXX ; LD B,$21 ; JR L3125 ; to STRT-MLT ; --- ;; MLT-LOOP L3114: JR NC,L311B ; to NO-ADD ADD HL,DE ; EXX ; ADC HL,DE ; EXX ; ;; NO-ADD L311B: EXX ; RR H ; RR L ; EXX ; RR H ; RR L ; ;; STRT-MLT L3125: EXX ; RR B ; RR C ; EXX ; RR C ; RRA ; DJNZ L3114 ; to MLT-LOOP EX DE,HL ; EXX ; EX DE,HL ; EXX ; POP BC ; POP HL ; LD A,B ; ADD A,C ; JR NZ,L313B ; to MAKE-EXPT AND A ; ;; MAKE-EXPT L313B: DEC A ; CCF ; Complement Carry Flag ;; DIVN-EXPT L313D: RLA ; CCF ; Complement Carry Flag RRA ; JP P,L3146 ; to OFLW1-CLR JR NC,L31AD ; to REPORT-6 AND A ; ;; OFLW1-CLR L3146: INC A ; JR NZ,L3151 ; to OFLW2-CLR JR C,L3151 ; to OFLW2-CLR EXX ; BIT 7,D ; EXX ; JR NZ,L31AD ; to REPORT-6 ;; OFLW2-CLR L3151: LD (HL),A ; EXX ; LD A,B ; EXX ; ;; TEST-NORM L3155: JR NC,L316C ; to NORMALISE LD A,(HL) ; AND A ; ;; NEAR-ZERO L3159: LD A,$80 ; JR Z,L315E ; to SKIP-ZERO ;; ZERO-RSLT L315D: XOR A ; ;; SKIP-ZERO L315E: EXX ; AND D ; CALL L2FFB ; routine ZEROS-4/5 RLCA ; LD (HL),A ; JR C,L3195 ; to OFLOW-CLR INC HL ; LD (HL),A ; DEC HL ; JR L3195 ; to OFLOW-CLR ; --- ;; NORMALISE L316C: LD B,$20 ; ;; SHIFT-ONE L316E: EXX ; BIT 7,D ; EXX ; JR NZ,L3186 ; to NORML-NOW RLCA ; RL E ; RL D ; EXX ; RL E ; RL D ; EXX ; DEC (HL) ; JR Z,L3159 ; to NEAR-ZERO DJNZ L316E ; to SHIFT-ONE JR L315D ; to ZERO-RSLT ; --- ;; NORML-NOW L3186: RLA ; JR NC,L3195 ; to OFLOW-CLR CALL L3004 ; routine ADD-BACK JR NZ,L3195 ; to OFLOW-CLR EXX ; LD D,$80 ; EXX ; INC (HL) ; JR Z,L31AD ; to REPORT-6 ;; OFLOW-CLR L3195: 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 L31AD: RST 08H ; ERROR-1 DEFB $05 ; Error Report: Number too big ; ---------------------- ; THE 'DIVISION' ROUTINE ; ---------------------- ; (offset: $05 'division') ; ; "He who can properly define and divide is to be considered a god" ; - Plato, 429 - 347 B.C. ;; division L31AF: CALL L3293 ; routine RE-ST-TWO EX DE,HL ; XOR A ; CALL L30C0 ; routine PREP-M/D JR C,L31AD ; to REPORT-6 EX DE,HL ; CALL L30C0 ; routine PREP-M/D RET C ; EXX ; PUSH HL ; EXX ; PUSH DE ; PUSH HL ; CALL L2FBA ; 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 L31E2 ; to DIV-START ; --- ;; DIV-LOOP L31D2: RLA ; RL C ; EXX ; RL C ; RL B ; EXX ; ;; div-34th L31DB: ADD HL,HL ; EXX ; ADC HL,HL ; EXX ; JR C,L31F2 ; to SUBN-ONLY ;; DIV-START L31E2: SBC HL,DE ; EXX ; SBC HL,DE ; EXX ; JR NC,L31F9 ; to NO-RSTORE ADD HL,DE ; EXX ; ADC HL,DE ; EXX ; AND A ; JR L31FA ; to COUNT-ONE ; --- ;; SUBN-ONLY L31F2: AND A ; SBC HL,DE ; EXX ; SBC HL,DE ; EXX ; ;; NO-RSTORE L31F9: SCF ; Set Carry Flag ;; COUNT-ONE L31FA: INC B ; JP M,L31D2 ; to DIV-LOOP PUSH AF ; JR Z,L31E2 ; 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 L313D ; jump back to DIVN-EXPT ; ------------------------------------ ; Integer truncation towards zero ($3A) ; ------------------------------------ ; ; ;; truncate L3214: LD A,(HL) ; AND A ; RET Z ; CP $81 ; JR NC,L3221 ; to T-GR-ZERO LD (HL),$00 ; LD A,$20 ; JR L3272 ; to NIL-BYTES ; --- ;; T-GR-ZERO L3221: CP $91 ; JR NZ,L323F ; to T-SMALL INC HL ; INC HL ; INC HL ; LD A,$80 ; AND (HL) ; DEC HL ; OR (HL) ; DEC HL ; JR NZ,L3233 ; to T-FIRST LD A,$80 ; XOR (HL) ; ;; T-FIRST L3233: DEC HL ; JR NZ,L326C ; to T-EXPNENT LD (HL),A ; INC HL ; LD (HL),$FF ; DEC HL ; LD A,$18 ; JR L3272 ; to NIL-BYTES ; --- ;; T-SMALL L323F: JR NC,L326D ; to X-LARGE PUSH DE ; CPL ; ADD A,$91 ; INC HL ; LD D,(HL) ; INC HL ; LD E,(HL) ; DEC HL ; DEC HL ; LD C,$00 ; BIT 7,D ; JR Z,L3252 ; to T-NUMERIC DEC C ; ;; T-NUMERIC L3252: SET 7,D ; LD B,$08 ; SUB B ; ADD A,B ; JR C,L325E ; to T-TEST LD E,D ; LD D,$00 ; SUB B ; ;; T-TEST L325E: JR Z,L3267 ; to T-STORE LD B,A ; ;; T-SHIFT L3261: SRL D ; RR E ; DJNZ L3261 ; to T-SHIFT ;; T-STORE L3267: CALL L2D8E ; routine INT-STORE POP DE ; RET ; ; --- ;; T-EXPNENT L326C: LD A,(HL) ; ;; X-LARGE L326D: SUB $A0 ; RET P ; NEG ; Negate ;; NIL-BYTES L3272: PUSH DE ; EX DE,HL ; DEC HL ; LD B,A ; SRL B ; SRL B ; SRL B ; JR Z,L3283 ; to BITS-ZERO ;; BYTE-ZERO L327E: LD (HL),$00 ; DEC HL ; DJNZ L327E ; to BYTE-ZERO ;; BITS-ZERO L3283: AND $07 ; JR Z,L3290 ; to IX-END LD B,A ; LD A,$FF ; ;; LESS-MASK L328A: SLA A ; DJNZ L328A ; to LESS-MASK AND (HL) ; LD (HL),A ; ;; IX-END L3290: EX DE,HL ; POP DE ; RET ; ; ---------------------------------- ; Storage of numbers in 5 byte form. ; ================================== ; Both integers and floating-point numbers can be stored in five bytes. ; Zero is a special case stored as 5 zeros. ; For integers the form is ; Byte 1 - zero, ; Byte 2 - sign byte, $00 +ve, $FF -ve. ; Byte 3 - Low byte of integer. ; Byte 4 - High byte ; Byte 5 - unused but always zero. ; ; it seems unusual to store the low byte first but it is just as easy either ; way. Statistically it just increases the chances of trailing zeros which ; is an advantage elsewhere in saving ROM code. ; ; zero sign low high unused ; So +1 is 00000000 00000000 00000001 00000000 00000000 ; ; and -1 is 00000000 11111111 11111111 11111111 00000000 ; ; much of the arithmetic found in BASIC lines can be done using numbers ; in this form using the Z80's 16 bit register operation ADD. ; (multiplication is done by a sequence of additions). ; ; Storing -ve integers in two's complement form, means that they are ready for ; addition and you might like to add the numbers above to prove that the ; answer is zero. If, as in this case, the carry is set then that denotes that ; the result is positive. This only applies when the signs don't match. ; With positive numbers a carry denotes the result is out of integer range. ; With negative numbers a carry denotes the result is within range. ; The exception to the last rule is when the result is -65536 ; ; Floating point form is an alternative method of storing numbers which can ; be used for integers and larger (or fractional) numbers. ; ; In this form 1 is stored as ; 10000001 00000000 00000000 00000000 00000000 ; ; When a small integer is converted to a floating point number the last two ; bytes are always blank so they are omitted in the following steps ; ; first make exponent +1 +16d (bit 7 of the exponent is set if positive) ; 10010001 00000000 00000001 ; 10010000 00000000 00000010 <- now shift left and decrement exponent ; ... ; 10000010 01000000 00000000 <- until a 1 abuts the imaginary point ; 10000001 10000000 00000000 to the left of the mantissa. ; ; however since the leftmost bit of the mantissa is always set then it can ; be used to denote the sign of the mantissa and put back when needed by the ; PREP routines which gives ; ; 10000001 00000000 00000000 ; ---------------------------------------------- ; 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 L3293: CALL L3296 ; routine RESTK-SUB below and continue ; into the routine to do the other one. ;; RESTK-SUB L3296: EX DE,HL ; swap pointers ; --------------------------------------------- ; 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 first byte. ;; re-stack L3297: LD A,(HL) ; Fetch Exponent byte to A AND A ; test it RET NZ ; return if not zero as already in full ; floating-point form. PUSH DE ; preserve DE. CALL L2D7F ; routine INT-FETCH ; integer to DE, sign to C. ; HL points to 4th byte. XOR A ; clear accumulator. INC HL ; point to 5th. LD (HL),A ; and blank. DEC HL ; point to 4th. LD (HL),A ; and blank. LD B,$91 ; set exponent byte +ve $81 ; and imaginary dec point 16 bits to right ; of first bit. ; we could skip to normalize now but it's quicker to avoid normalizing ; through an empty D. LD A,D ; fetch the high byte D AND A ; is it zero ? JR NZ,L32B1 ; skip to RS-NRMLSE if not. OR E ; low byte E to A and test for zero LD B,D ; set B exponent to 0 JR Z,L32BD ; forward to RS-STORE if value is zero. LD D,E ; transfer E to D LD E,B ; set E to 0 LD B,$89 ; reduce the initial exponent by eight. ;; RS-NRMLSE L32B1: EX DE,HL ; integer to HL, addr of 4th byte to DE. ;; RSTK-LOOP L32B2: DEC B ; decrease exponent ADD HL,HL ; shift DE left JR NC,L32B2 ; 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 L32BD: DEC HL ; address 3rd byte LD (HL),E ; place E DEC HL ; address 2nd byte LD (HL),D ; place D DEC HL ; address 1st byte LD (HL),B ; store the exponent POP DE ; restore initial DE. RET ; return. ;**************************************** ;** Part 10. FLOATING-POINT CALCULATOR ** ;**************************************** ; As a general rule the calculator avoids using the IY register. ; exceptions are val, val$ and str$. ; So an assembly language programmer who has disabled interrupts to use ; IY for other purposes can still use the calculator for mathematical ; purposes. ; ------------------------ ; THE 'TABLE OF CONSTANTS' ; ------------------------ ; ; ; 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) ; ------------------------ ; THE 'TABLE OF ADDRESSES' ; ------------------------ ; "Each problem that I solved became a rule which served afterwards to solve ; other problems" - Rene Descartes 1596 - 1650. ; ; Starts with binary operations which have two operands and one result. ; Three pseudo binary operations first. ;; tbl-addrs L32D7: DEFW L368F ; $00 Address: $368F - jump-true DEFW L343C ; $01 Address: $343C - exchange DEFW L33A1 ; $02 Address: $33A1 - delete ; True binary operations. DEFW L300F ; $03 Address: $300F - subtract DEFW L30CA ; $04 Address: $30CA - multiply DEFW L31AF ; $05 Address: $31AF - division DEFW L3851 ; $06 Address: $3851 - to-power DEFW L351B ; $07 Address: $351B - or DEFW L3524 ; $08 Address: $3524 - no-&-no DEFW L353B ; $09 Address: $353B - no-l-eql DEFW L353B ; $0A Address: $353B - no-gr-eql DEFW L353B ; $0B Address: $353B - nos-neql DEFW L353B ; $0C Address: $353B - no-grtr DEFW L353B ; $0D Address: $353B - no-less DEFW L353B ; $0E Address: $353B - nos-eql DEFW L3014 ; $0F Address: $3014 - addition DEFW L352D ; $10 Address: $352D - str-&-no DEFW L353B ; $11 Address: $353B - str-l-eql DEFW L353B ; $12 Address: $353B - str-gr-eql DEFW L353B ; $13 Address: $353B - strs-neql DEFW L353B ; $14 Address: $353B - str-grtr DEFW L353B ; $15 Address: $353B - str-less DEFW L353B ; $16 Address: $353B - strs-eql DEFW L359C ; $17 Address: $359C - strs-add ; Unary follow. DEFW L35DE ; $18 Address: $35DE - val$ DEFW L34BC ; $19 Address: $34BC - usr-$ DEFW L3645 ; $1A Address: $3645 - read-in DEFW L346E ; $1B Address: $346E - negate DEFW L3669 ; $1C Address: $3669 - code DEFW L35DE ; $1D Address: $35DE - val DEFW L3674 ; $1E Address: $3674 - len DEFW L37B5 ; $1F Address: $37B5 - sin DEFW L37AA ; $20 Address: $37AA - cos DEFW L37DA ; $21 Address: $37DA - tan DEFW L3833 ; $22 Address: $3833 - asn DEFW L3843 ; $23 Address: $3843 - acs DEFW L37E2 ; $24 Address: $37E2 - atn DEFW L3713 ; $25 Address: $3713 - ln DEFW L36C4 ; $26 Address: $36C4 - exp DEFW L36AF ; $27 Address: $36AF - int DEFW L384A ; $28 Address: $384A - sqr DEFW L3492 ; $29 Address: $3492 - sgn DEFW L346A ; $2A Address: $346A - abs DEFW L34AC ; $2B Address: $34AC - peek DEFW L34A5 ; $2C Address: $34A5 - in DEFW L34B3 ; $2D Address: $34B3 - usr-no DEFW L361F ; $2E Address: $361F - str$ DEFW L35C9 ; $2F Address: $35C9 - chrs DEFW L3501 ; $30 Address: $3501 - not ; End of true unary. DEFW L33C0 ; $31 Address: $33C0 - duplicate DEFW L36A0 ; $32 Address: $36A0 - n-mod-m DEFW L3686 ; $33 Address: $3686 - jump DEFW L33C6 ; $34 Address: $33C6 - stk-data DEFW L367A ; $35 Address: $367A - dec-jr-nz DEFW L3506 ; $36 Address: $3506 - less-0 DEFW L34F9 ; $37 Address: $34F9 - greater-0 DEFW L369B ; $38 Address: $369B - end-calc DEFW L3783 ; $39 Address: $3783 - get-argt DEFW L3214 ; $3A Address: $3214 - truncate DEFW L33A2 ; $3B Address: $33A2 - fp-calc-2 DEFW L2D4F ; $3C Address: $2D4F - e-to-fp DEFW L3297 ; $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 L3449 ; Address: $3449 - series-xx $80 - $9F. DEFW L341B ; Address: $341B - stk-const-xx $A0 - $BF. DEFW L342D ; Address: $342D - st-mem-xx $C0 - $DF. DEFW L340F ; 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 Calculator ; -------------- ; "A good calculator does not need artificial aids" ; Lao Tze 604 - 531 B.C. ;; CALCULATE L335B: CALL L35BF ; 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 L335E: LD A,B ; fetch the Z80 B register to A LD ($5C67),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 L3362: 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 L3365: LD ($5C65),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 L336C: PUSH HL ; save pointer on stack AND A ; now test the literal JP P,L3380 ; 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 L338E ; forward to ENT-TABLE ; --- ; the branch was here with simple literals. ;; FIRST-3D L3380: CP $18 ; compare with first unary operations. JR NC,L338C ; to DOUBLE-A with unary operations ; it is binary so adjust pointers. EXX ; LD BC,$FFFB ; the value -5 LD D,H ; transfer HL, the last value, to DE. LD E,L ; ADD HL,BC ; subtract 5 making HL point to second ; value. EXX ; ;; DOUBLE-A L338C: RLCA ; double the literal LD L,A ; and store in L for indexing ;; ENT-TABLE L338E: LD DE,L32D7 ; Address: tbl-addrs LD H,$00 ; prepare to index ADD HL,DE ; add to get address of routine LD E,(HL) ; low byte to E INC HL ; LD D,(HL) ; high byte to D LD HL,L3365 ; Address: RE-ENTRY EX (SP),HL ; goes to stack PUSH DE ; now address of routine EXX ; main set ; avoid using IY register. LD BC,($5C66) ; STKEND_hi ; nothing much goes to C but BREG to B ; and continue into next ret instruction ; which has a dual identity ; ------------------ ; Handle delete (02) ; ------------------ ; A simple return but when used as a calculator literal this ; deletes the last value from the calculator stack. ; On entry, as always with binary operations, ; HL=first number, DE=second number ; On exit, HL=result, DE=stkend. ; So nothing to do ;; delete L33A1: RET ; return - indirect jump if from above. ; --------------------- ; Single operation (3B) ; --------------------- ; This single operation is used, in the first instance, to evaluate most ; of the mathematical and string functions found in BASIC expressions. ;; fp-calc-2 L33A2: POP AF ; drop return address. LD A,($5C67) ; load accumulator from system variable BREG ; value will be literal e.g. 'tan' EXX ; switch to alt JR L336C ; 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. It returns with BC holding the value 5 ready ; for any subsequent LDIR. ;; TEST-5-SP L33A9: PUSH DE ; save PUSH HL ; registers LD BC,$0005 ; an overhead of five bytes CALL L1F05 ; routine TEST-ROOM tests free RAM raising ; an error if not. POP HL ; else restore POP DE ; registers. RET ; return with BC set at 5. ; ----------------------------- ; 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 L33B4: LD DE,($5C65) ; Load destination from STKEND system variable. CALL L33C0 ; Routine MOVE-FP puts on calculator stack ; with a memory check. LD ($5C65),DE ; Set STKEND to next free location. RET ; Return. ; --------------------------------- ; Move a floating point number (31) ; --------------------------------- ; This simple routine is a 5-byte LDIR instruction ; that incorporates a memory check. ; When used as a calculator literal it duplicates the last value on the ; calculator stack. ; Unary so on entry HL points to last value, DE to stkend ;; duplicate ;; MOVE-FP L33C0: CALL L33A9 ; routine TEST-5-SP test free memory ; and sets BC to 5. LDIR ; copy the five bytes. RET ; return with DE addressing new STKEND ; and HL addressing new last value. ; ------------------- ; Stack literals ($34) ; ------------------- ; When a calculator subroutine needs to put a value on the calculator ; stack that is not a regular constant this routine is called with a ; variable number of following data bytes that convey to the routine ; the integer or floating point form as succinctly as is possible. ;; stk-data L33C6: LD H,D ; transfer STKEND LD L,E ; to HL for result. ;; STK-CONST L33C8: CALL L33A9 ; routine TEST-5-SP tests that room exists ; and sets BC to $05. EXX ; switch to alternate set PUSH HL ; save the pointer to next literal on stack EXX ; switch back to main set EX (SP),HL ; pointer to HL, destination to stack. PUSH BC ; save BC - value 5 from test room ??. LD A,(HL) ; fetch the byte following 'stk-data' AND $C0 ; isolate bits 7 and 6 RLCA ; rotate RLCA ; to bits 1 and 0 range $00 - $03. LD C,A ; transfer to C INC C ; and increment to give number of bytes ; to read. $01 - $04 LD A,(HL) ; reload the first byte AND $3F ; mask off to give possible exponent. JR NZ,L33DE ; forward to FORM-EXP if it was possible to ; include the exponent. ; else byte is just a byte count and exponent comes next. INC HL ; address next byte and LD A,(HL) ; pick up the exponent ( - $50). ;; FORM-EXP L33DE: ADD A,$50 ; now add $50 to form actual exponent LD (DE),A ; and load into first destination byte. LD A,$05 ; load accumulator with $05 and SUB C ; subtract C to give count of trailing ; zeros plus one. INC HL ; increment source INC DE ; increment destination LD B,$00 ; prepare to copy LDIR ; copy C bytes POP BC ; restore 5 counter to BC ??. EX (SP),HL ; put HL on stack as next literal pointer ; and the stack value - result pointer - ; to HL. EXX ; switch to alternate set. POP HL ; restore next literal pointer from stack ; to H'L'. EXX ; switch back to main set. LD B,A ; zero count to B XOR A ; clear accumulator ;; STK-ZEROS L33F1: 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 L33F1 ; loop back to STK-ZEROS until done. ; ------------------------------- ; THE 'SKIP CONSTANTS' SUBROUTINE ; ------------------------------- ; This routine traverses variable-length entries in the table of constants, ; stacking intermediate, unwanted constants onto a dummy calculator stack, ; in the first five bytes of ROM. 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 L33C8 ; routine STK-CONST works through variable ; length records. POP DE ; restore real STKEND POP AF ; restore count DEC A ; decrease JR L33F8 ; 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 L3406: 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. ; ------------------------------ ; Get from memory area ($E0 etc.) ; ------------------------------ ; Literals $E0 to $FF ; A holds $00-$1F offset. ; The calculator stack increases by 5 bytes. ;; get-mem-xx L340F: PUSH DE ; save STKEND LD HL,($5C68) ; MEM is base address of the memory cells. CALL L3406 ; routine LOC-MEM so that HL = first byte CALL L33C0 ; routine MOVE-FP moves 5 bytes with memory ; check. ; DE now points to new STKEND. POP HL ; original STKEND is now RESULT pointer. RET ; return. ; -------------------------- ; Stack a constant (A0 etc.) ; -------------------------- ; This routine allows a one-byte instruction to stack up to 32 constants ; held in short form in a table of constants. In fact only 5 constants are ; required. On entry the A register holds the literal ANDed with 1F. ; It isn't very efficient and it would have been better to hold the ; numbers in full, five byte form and stack them in a similar manner ; to that used for semi-tone table values. ;; stk-const-xx L341B: LD H,D ; save STKEND - required for result LD L,E ; EXX ; swap PUSH HL ; save pointer to next literal LD HL,L32C5 ; Address: stk-zero - start of table of ; constants EXX ; CALL L33F7 ; routine SKIP-CONS CALL L33C8 ; routine STK-CONST EXX ; POP HL ; restore pointer to next literal. EXX ; RET ; return. ; -------------------------------- ; Store in a memory area ($C0 etc.) ; -------------------------------- ; Offsets $C0 to $DF ; Although 32 memory storage locations can be addressed, only six ; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5) ; required for these are allocated. Spectrum programmers who wish to ; use the floating point routines from assembly language may wish to ; alter the system variable MEM to point to 160 bytes of RAM to have ; use the full range available. ; A holds the derived offset $00-$1F. ; This is a unary operation, so on entry HL points to the last value and DE ; points to STKEND. ;; st-mem-xx L342D: PUSH HL ; save the result pointer. EX DE,HL ; transfer to DE. LD HL,($5C68) ; fetch MEM the base of memory area. CALL L3406 ; routine LOC-MEM sets HL to the destination. EX DE,HL ; swap - HL is start, DE is destination. CALL L33C0 ; routine MOVE-FP. ; note. a short ld bc,5; ldir ; the embedded memory check is not required ; so these instructions would be faster. EX DE,HL ; DE = STKEND POP HL ; restore original result pointer RET ; return. ; ------------------------- ; 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 L343C: LD B,$05 ; there are five bytes to be swapped ; start of loop. ;; SWAP-BYTE L343E: LD A,(DE) ; each byte of second LD C,(HL) ; each byte of first EX DE,HL ; swap pointers LD (DE),A ; store each byte of first LD (HL),C ; store each byte of second INC HL ; advance both INC DE ; pointers. DJNZ L343E ; loop back to SWAP-BYTE until all 5 done. EX DE,HL ; even up the exchanges so that DE addresses ; 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. ;; series-xx L3449: LD B,A ; parameter $00 - $1F to B counter CALL L335E ; 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 L3453: 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 L33C6 ; routine STK-DATA is called directly to ; push a value and advance H'L'. CALL L3362 ; routine GEN-ENT-2 recursively re-enters ; the calculator without disturbing ; system variable BREG ; H'L' value goes on the machine stack and is ; then loaded as usual with the next address. DEFB $0F ;;addition DEFB $01 ;;exchange DEFB $C2 ;;st-mem-2 DEFB $02 ;;delete DEFB $35 ;;dec-jr-nz DEFB $EE ;;back to L3453, 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 calculator stack. ;; abs L346A: LD B,$FF ; signal abs JR L3474 ; forward to NEG-TEST ; --------------------------- ; THE 'UNARY MINUS' OPERATION ; --------------------------- ; (offset: $1B 'negate') ; Unary so on entry HL points to last value, DE to STKEND. ;; NEGATE ;; negate L346E: CALL L34E9 ; 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 L3474: LD A,(HL) ; load first byte and AND A ; test for zero JR Z,L3483 ; forward to INT-CASE if a small integer ; for floating point numbers a single bit denotes the sign. INC HL ; address the first byte of mantissa. LD A,B ; action flag $FF=abs, $00=neg. AND $80 ; now $80 $00 OR (HL) ; sets bit 7 for abs RLA ; sets carry for abs and if number negative CCF ; complement carry flag RRA ; and rotate back in altering sign LD (HL),A ; put the altered adjusted number back DEC HL ; HL points to result RET ; return with DE unchanged ; --- ; for integer numbers an entire byte denotes the sign. ;; INT-CASE L3483: PUSH DE ; save STKEND. PUSH HL ; save pointer to the last value/result. CALL L2D7F ; routine INT-FETCH puts integer in DE ; and the sign in C. POP HL ; restore the result pointer. LD A,B ; $FF=abs, $00=neg OR C ; $FF for abs, no change neg CPL ; $00 for abs, switched for neg LD C,A ; transfer result to sign byte. CALL L2D8E ; 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 L3492: CALL L34E9 ; call routine TEST-ZERO and RET C ; exit if so as no change is required. PUSH DE ; save pointer to STKEND. LD DE,$0001 ; the result will be 1. INC HL ; skip over the exponent. RL (HL) ; rotate the sign bit into the carry flag. DEC HL ; step back to point to the result. SBC A,A ; byte will be $FF if negative, $00 if positive. LD C,A ; store the sign byte in the C register. CALL L2D8E ; 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. ;; in L34A5: CALL L1E99 ; Routine FIND-INT2 puts port address in BC. ; All 16 bits are put on the address line. IN A,(C) ; Read the port. JR L34B0 ; 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 peeked including the ROM. ;; peek L34AC: CALL L1E99 ; routine FIND-INT2 puts address in BC. LD A,(BC) ; load contents into A register. ;; IN-PK-STK L34B0: JP L2D28 ; 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 L34B3: CALL L1E99 ; routine FIND-INT2 to fetch the ; supplied address into BC. LD HL,L2D2B ; address: STACK-BC is PUSH HL ; pushed onto the machine stack. PUSH BC ; then the address of the machine code ; routine. RET ; make an indirect jump to the routine ; and, hopefully, to STACK-BC also. ; ------------------------- ; 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-$ L34BC: CALL L2BF1 ; routine STK-FETCH fetches the string ; parameters. DEC BC ; decrease BC by LD A,B ; one to test OR C ; the length. JR NZ,L34E7 ; to REPORT-A if not a single character. LD A,(DE) ; fetch the character CALL L2C8D ; routine ALPHA sets carry if 'A-Z' or 'a-z'. JR C,L34D3 ; forward to USR-RANGE if ASCII. SUB $90 ; make UDGs range 0-20d JR C,L34E7 ; to REPORT-A if too low. e.g. usr " ". CP $15 ; Note. this test is not necessary. JR NC,L34E7 ; to REPORT-A if higher than 20. INC A ; make range 1-21d to match LSBs of ASCII ;; USR-RANGE L34D3: 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,L34E7 ; to REPORT-A if originally higher ; than 'U','u' or graphics U. LD BC,($5C7B) ; 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,L34E4 ; forward to USR-STACK if no overflow. INC B ; increment high byte. ;; USR-STACK L34E4: JP L2D2B ; jump back and exit via STACK-BC to store ; --- ;; REPORT-A L34E7: RST 08H ; 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 first four only need be tested. ; On entry, HL points to the exponent the first byte of the value. ;; TEST-ZERO L34E9: PUSH HL ; preserve HL which is used to address. PUSH BC ; preserve BC which is used as a store. LD B,A ; preserve A in B. LD A,(HL) ; load first byte to accumulator INC HL ; advance. OR (HL) ; OR with second byte and clear carry. INC HL ; advance. OR (HL) ; OR with third byte. INC HL ; advance. OR (HL) ; OR with fourth byte. LD A,B ; restore A without affecting flags. POP BC ; restore the saved POP HL ; registers. RET NZ ; return if not zero and with carry reset. SCF ; set the carry flag. RET ; return with carry set if zero. ; -------------------------------- ; 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 ;; greater-0 L34F9: CALL L34E9 ; 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 L3507 ; 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. ;; NOT ;; not L3501: CALL L34E9 ; routine TEST-ZERO sets carry if zero JR L350B ; 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 second byte will be set if so. ;; less-0 L3506: 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 L3507: 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 L350B: PUSH HL ; save pointer to the first byte LD A,$00 ; load accumulator with zero - without ; disturbing flags. LD (HL),A ; zero to first byte INC HL ; address next LD (HL),A ; zero to 2nd byte INC HL ; address low byte of integer RLA ; carry to bit 0 of A LD (HL),A ; load one or zero to low byte. RRA ; restore zero to accumulator. INC HL ; address high byte of integer. LD (HL),A ; put a zero there. INC HL ; address fifth byte. LD (HL),A ; put a zero there. POP HL ; restore pointer to the first byte. RET ; return. ; ----------------- ; 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). ;; or L351B: EX DE,HL ; make HL point to second number CALL L34E9 ; 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 L350B ; 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-&-no L3524: EX DE,HL ; make HL address second operand. CALL L34E9 ; 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 L350B ; 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-&-no L352D: EX DE,HL ; make HL point to the number. CALL L34E9 ; routine TEST-ZERO. EX DE,HL ; restore pointers. RET NC ; return if number was not zero - the string ; is the result. ; if the number was zero (false) then the null string must be returned by ; altering the length of the string on the calculator stack to zero. PUSH DE ; save pointer to the now obsolete number ; (which will become the new STKEND) DEC DE ; point to the 5th byte of string descriptor. XOR A ; clear the accumulator. LD (DE),A ; place zero in high byte of length. DEC DE ; address low byte of length. LD (DE),A ; place zero there - now the null string. POP DE ; restore pointer - new STKEND. RET ; return. ; --------------------------- ; 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 'x<y' the same logic is used but the two values are first swapped on the ; calculator stack. ; For 'x=y' NOT is applied to the subtraction result yielding true if the ; difference was zero and false with anything else. ; The first three numeric comparisons are just the opposite of the last three ; so the same processing steps are used and then a final NOT is applied. ; ; literal Test No sub 8 ExOrNot 1st RRCA exch sub ? End-Tests ; ========= ==== == ======== === ======== ======== ==== === = === === === ; no-l-eql x<=y 09 00000001 dec 00000000 00000000 ---- x-y ? --- >0? NOT ; no-gr-eql x>=y 0A 00000010 dec 00000001 10000000c swap y-x ? --- >0? NOT ; nos-neql x<>y 0B 00000011 dec 00000010 00000001 ---- x-y ? NOT --- NOT ; no-grtr x>y 0C 00000100 - 00000100 00000010 ---- x-y ? --- >0? --- ; no-less x<y 0D 00000101 - 00000101 10000010c swap y-x ? --- >0? --- ; nos-eql x=y 0E 00000110 - 00000110 00000011 ---- x-y ? NOT --- --- ; ; comp -> C/F ; ==== === ; str-l-eql x$<=y$ 11 00001001 dec 00001000 00000100 ---- x$y$ 0 !or >0? NOT ; str-gr-eql x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0 !or >0? NOT ; strs-neql x$<>y$ 13 00001011 dec 00001010 00000101 ---- x$y$ 0 !or >0? NOT ; str-grtr x$>y$ 14 00001100 - 00001100 00000110 ---- x$y$ 0 !or >0? --- ; str-less x$<y$ 15 00001101 - 00001101 10000110c swap y$x$ 0 !or >0? --- ; strs-eql x$=y$ 16 00001110 - 00001110 00000111 ---- x$y$ 0 !or >0? --- ; ; String comparisons are a little different in that the eql/neql carry flag ; from the 2nd RRCA is, as before, fed into the first of the end tests but ; along the way it gets modified by the comparison process. The result on the ; stack always starts off as zero and the carry fed in determines if NOT is ; applied to it. So the only time the greater-0 test is applied is if the ; stack holds zero which is not very efficient as the test will always yield ; zero. The most likely explanation is that there were once separate end tests ; for numbers and strings. ;; no-l-eql,etc. L353B: LD A,B ; transfer literal to accumulator. SUB $08 ; subtract eight - which is not useful. BIT 2,A ; isolate '>', '<', '='. JR NZ,L3543 ; skip to EX-OR-NOT with these. DEC A ; else make $00-$02, $08-$0A to match bits 0-2. ;; EX-OR-NOT L3543: RRCA ; the first RRCA sets carry for a swap. JR NC,L354E ; 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 L343C ; routine exchange swaps the two values. ; (HL = second operand, DE = STKEND) POP DE ; DE = first operand EX DE,HL ; as we were. POP AF ; restore A and carry. ; Note. it would be better if the 2nd RRCA preceded the string test. ; It would save two duplicate bytes and if we also got rid of that sub 8 ; at the beginning we wouldn't have to alter which bit we test. ;; NU-OR-STR L354E: BIT 2,A ; test if a string comparison. JR NZ,L3559 ; forward to STRINGS if so. ; continue with numeric comparisons. RRCA ; 2nd RRCA causes eql/neql to set carry. PUSH AF ; save A and carry CALL L300F ; routine subtract leaves result on stack. JR L358C ; forward to END-TESTS ; --- ;; STRINGS L3559: RRCA ; 2nd RRCA causes eql/neql to set carry. PUSH AF ; save A and carry. CALL L2BF1 ; routine STK-FETCH gets 2nd string params PUSH DE ; save start2 *. PUSH BC ; and the length. CALL L2BF1 ; 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 L3564: 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,L3575 ; forward to SEC-PLUS if second not null. OR C ; test length of first string. ;; SECND-LOW L356B: POP BC ; pop the second length off stack. JR Z,L3572 ; 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 L3588 ; forward to leave via STR-TEST ; --- ; the branch was here with a match ;; BOTH-NULL L3572: POP AF ; restore carry - set for eql/neql JR L3588 ; 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 L3575: OR C ; test the length of first string. JR Z,L3585 ; 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,L3585 ; forward to FRST-LESS if carry set JR NZ,L356B ; 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 L3564 ; back to BYTE-COMP ; --- ; the false condition. ;; FRST-LESS L3585: 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 L3588: 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 L358C: POP AF ; pop carry - will be set if eql/neql PUSH AF ; save it again. CALL C,L3501 ; 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,L34F9 ; 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,L3501 ; apply a terminal NOT if so. 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 L359C: CALL L2BF1 ; routine STK-FETCH fetches string parameters ; and deletes calculator stack entry. PUSH DE ; save start address. PUSH BC ; and length. CALL L2BF1 ; routine STK-FETCH for first string POP HL ; re-fetch first length PUSH HL ; and save again PUSH DE ; save start of second string PUSH BC ; and its length. ADD HL,BC ; add the two lengths. LD B,H ; transfer to BC LD C,L ; and create RST 30H ; BC-SPACES in workspace. ; DE points to start of space. CALL L2AB2 ; 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,L35B7 ; to OTHER-STR if null string LDIR ; copy string to workspace. ;; OTHER-STR L35B7: POP BC ; now second length POP HL ; and start of string LD A,B ; test this one OR C ; for zero length JR Z,L35BF ; skip forward to STK-PNTRS if so as complete. LDIR ; else copy the bytes. ; and continue into next routine which ; sets the calculator stack pointers. ; ----------------------------------- ; THE 'SET STACK POINTERS' SUBROUTINE ; ----------------------------------- ; Register DE is set to STKEND and HL, the result pointer, is s