diff --git a/new/.gitignore b/new/.gitignore new file mode 100644 index 0000000..378eac2 --- /dev/null +++ b/new/.gitignore @@ -0,0 +1 @@ +build diff --git a/new/Makefile b/new/Makefile new file mode 100644 index 0000000..844c2a1 --- /dev/null +++ b/new/Makefile @@ -0,0 +1,40 @@ +.SILENT: +ASM := zasm +ASMFLAGS := -w -b +BUILDDIR := build + +FILES := bios +SUBDIRS := apps/basic + +SOURCES := $(addprefix ./, $(addsuffix .asm, $(FILES))) +TARGETS := $(addprefix $(BUILDDIR)/, $(addsuffix .bin, $(FILES))) + +TOPTARGETS := all clean size +$(TOPTARGETS): $(SUBDIRS) + +all: $(BUILDDIR) $(TARGETS) size + +clean: + rm -rf $(BUILDDIR) + +$(BUILDDIR): + mkdir -p $(BUILDDIR) + +$(BUILDDIR)/%.bin: ./%.asm + echo '>$<' + $(ASM) $(ASMFLAGS) $< $@ + +size: + @for file in $(TARGETS); do \ + if [ -f "$$file" ]; then \ + echo "$$file: $$(wc -c < "$$file") bytes"; \ + else \ + echo "$$file: Not built yet (run 'make')"; \ + fi \ + done + +$(SUBDIRS): + $(MAKE) -C $@ $(or $(MAKECMDGOALS),all) --no-print-directory + +.PHONY: $(TOPTARGETS) $(SUBDIRS) + diff --git a/new/apps/basic/Makefile b/new/apps/basic/Makefile new file mode 100644 index 0000000..4094dd8 --- /dev/null +++ b/new/apps/basic/Makefile @@ -0,0 +1,40 @@ +.SILENT: +ASM := zasm +ASMFLAGS := -w -b +BUILDDIR := ../../build/basic + +FILES := basic +SUBDIRS := + +SOURCES := $(addprefix ./, $(addsuffix .asm, $(FILES))) +TARGETS := $(addprefix $(BUILDDIR)/, $(addsuffix .bin, $(FILES))) + +TOPTARGETS := all clean size +$(TOPTARGETS): $(SUBDIRS) + +all: $(BUILDDIR) $(TARGETS) size + +clean: + rm -rf $(BUILDDIR) + +$(BUILDDIR): + mkdir -p $(BUILDDIR) + +$(BUILDDIR)/%.bin: ./%.asm + echo '>$<' + $(ASM) $(ASMFLAGS) $< $@ + +size: + @for file in $(TARGETS); do \ + if [ -f "$$file" ]; then \ + echo "$$file: $$(wc -c < "$$file") bytes"; \ + else \ + echo "$$file: Not built yet (run 'make')"; \ + fi \ + done + +$(SUBDIRS): + $(MAKE) -C $@ $(or $(MAKECMDGOALS),all) --no-print-directory + +.PHONY: $(TOPTARGETS) $(SUBDIRS) + diff --git a/new/apps/basic/basic.asm b/new/apps/basic/basic.asm new file mode 100644 index 0000000..f67c689 --- /dev/null +++ b/new/apps/basic/basic.asm @@ -0,0 +1,4369 @@ +;================================================================================== +; Project Extensions by Joppe Blondel +; +; The specific modifications and additions introduced in this version are dedicated +; to the public domain under CC0, to the maximum extent permitted by law. +; +; However, because this file incorporates prior modifications by Grant Searle, +; which are restricted to NON-COMMERCIAL USE ONLY, the combined file inherits +; that restriction and may not be used for commercial purposes. +; +; Changes made to Grant's version: +; - workspace base and code org +; - fixed ram size instead of poking at ram locations +; - BIOS calls instead of using RST +; - Unsupported functions cause FCERR, not a reset or REM +; +;================================================================================== +; The updates to the original BASIC within this file are copyright Grant Searle +; +; You have permission to use this for NON COMMERCIAL USE ONLY +; If you wish to use it elsewhere, please include an acknowledgement to myself. +; +; http://searle.hostei.com/grant/index.html +; +; eMail: home.micros01@btinternet.com +; +; If the above don't work, please perform an Internet search to see if I have +; updated the web page hosting service. +; +;================================================================================== + +; NASCOM ROM BASIC Ver 4.7, (C) 1978 Microsoft +; Scanned from source published in 80-BUS NEWS from Vol 2, Issue 3 +; (May-June 1983) to Vol 3, Issue 3 (May-June 1984) +; Adapted for the freeware Zilog Macro Assembler 2.10 to produce +; the original ROM code (checksum A934H). PA + +; MACHINE CONFIG +MC_BIOS_PUTC .EQU 0C050H +MC_BIOS_TRY_GETC .EQU 0C053H +MC_BIOS_GETC .EQU 0C056H +MC_BIOS_FLUSH .EQU 0C062H +MC_BIOS_MONITOR .EQU 0C06EH +MC_CODE_START .EQU 04000H +MC_RAM_START .EQU 08000H +MC_RAM_END .EQU 0BFFFH + +; GENERAL EQUATES + +CTRLC .EQU 03H ; Control "C" +CTRLG .EQU 07H ; Control "G" +BKSP .EQU 7FH ; Back space +LF .EQU 0AH ; Line feed +CS .EQU 0CH ; Clear screen +CR .EQU 0DH ; Carriage return +CTRLO .EQU 0FH ; Control "O" +CTRLQ .EQU 11H ; Control "Q" +CTRLR .EQU 12H ; Control "R" +CTRLS .EQU 13H ; Control "S" +CTRLU .EQU 15H ; Control "U" +ESC .EQU 1BH ; Escape +DEL .EQU 08H ; Delete + +; BASIC WORK SPACE LOCATIONS + +WRKSPC .EQU MC_RAM_START ; BASIC Work space +USR .EQU WRKSPC+3H ; "USR (x)" jump +OUTSUB .EQU WRKSPC+6H ; "OUT p,n" +OTPORT .EQU WRKSPC+7H ; Port (p) +DIVSUP .EQU WRKSPC+9H ; Division support routine +DIV1 .EQU WRKSPC+0AH ; <- Values +DIV2 .EQU WRKSPC+0EH ; <- to +DIV3 .EQU WRKSPC+12H ; <- be +DIV4 .EQU WRKSPC+15H ; <-inserted +SEED .EQU WRKSPC+17H ; Random number seed +LSTRND .EQU WRKSPC+3AH ; Last random number +INPSUB .EQU WRKSPC+3EH ; #INP (x)" Routine +INPORT .EQU WRKSPC+3FH ; PORT (x) +NULLS .EQU WRKSPC+41H ; Number of nulls +LWIDTH .EQU WRKSPC+42H ; Terminal width +COMMAN .EQU WRKSPC+43H ; Width for commas +NULFLG .EQU WRKSPC+44H ; Null after input byte flag +CTLOFG .EQU WRKSPC+45H ; Control "O" flag +LINESC .EQU WRKSPC+46H ; Lines counter +LINESN .EQU WRKSPC+48H ; Lines number +CHKSUM .EQU WRKSPC+4AH ; Array load/save check sum +NMIFLG .EQU WRKSPC+4CH ; Flag for NMI break routine +BRKFLG .EQU WRKSPC+4DH ; Break flag +RINPUT .EQU WRKSPC+4EH ; Input reflection +POINT .EQU WRKSPC+51H ; "POINT" reflection (unused) +PSET .EQU WRKSPC+54H ; "SET" reflection +RESET .EQU WRKSPC+57H ; "RESET" reflection +STRSPC .EQU WRKSPC+5AH ; Bottom of string space +LINEAT .EQU WRKSPC+5CH ; Current line number +BASTXT .EQU WRKSPC+5EH ; Pointer to start of program +BUFFER .EQU WRKSPC+61H ; Input buffer +STACK .EQU WRKSPC+66H ; Initial stack +CURPOS .EQU WRKSPC+0ABH ; Character position on line +LCRFLG .EQU WRKSPC+0ACH ; Locate/Create flag +TYPE .EQU WRKSPC+0ADH ; Data type flag +DATFLG .EQU WRKSPC+0AEH ; Literal statement flag +LSTRAM .EQU WRKSPC+0AFH ; Last available RAM +TMSTPT .EQU WRKSPC+0B1H ; Temporary string pointer +TMSTPL .EQU WRKSPC+0B3H ; Temporary string pool +TMPSTR .EQU WRKSPC+0BFH ; Temporary string +STRBOT .EQU WRKSPC+0C3H ; Bottom of string space +CUROPR .EQU WRKSPC+0C5H ; Current operator in EVAL +LOOPST .EQU WRKSPC+0C7H ; First statement of loop +DATLIN .EQU WRKSPC+0C9H ; Line of current DATA item +FORFLG .EQU WRKSPC+0CBH ; "FOR" loop flag +LSTBIN .EQU WRKSPC+0CCH ; Last byte entered +READFG .EQU WRKSPC+0CDH ; Read/Input flag +BRKLIN .EQU WRKSPC+0CEH ; Line of break +NXTOPR .EQU WRKSPC+0D0H ; Next operator in EVAL +ERRLIN .EQU WRKSPC+0D2H ; Line of error +CONTAD .EQU WRKSPC+0D4H ; Where to CONTinue +PROGND .EQU WRKSPC+0D6H ; End of program +VAREND .EQU WRKSPC+0D8H ; End of variables +ARREND .EQU WRKSPC+0DAH ; End of arrays +NXTDAT .EQU WRKSPC+0DCH ; Next data item +FNRGNM .EQU WRKSPC+0DEH ; Name of FN argument +FNARG .EQU WRKSPC+0E0H ; FN argument value +FPREG .EQU WRKSPC+0E4H ; Floating point register +FPEXP .EQU FPREG+3 ; Floating point exponent +SGNRES .EQU WRKSPC+0E8H ; Sign of result +PBUFF .EQU WRKSPC+0E9H ; Number print buffer +MULVAL .EQU WRKSPC+0F6H ; Multiplier +PROGST .EQU WRKSPC+0F9H ; Start of program text area +STLOOK .EQU WRKSPC+15DH ; Start of memory test + +; BASIC ERROR CODE VALUES + +NF .EQU 00H ; NEXT without FOR +SN .EQU 02H ; Syntax error +RG .EQU 04H ; RETURN without GOSUB +OD .EQU 06H ; Out of DATA +FC .EQU 08H ; Function call error +OV .EQU 0AH ; Overflow +OM .EQU 0CH ; Out of memory +UL .EQU 0EH ; Undefined line number +BS .EQU 10H ; Bad subscript +DD .EQU 12H ; Re-DIMensioned array +DZ .EQU 14H ; Division by zero (/0) +ID .EQU 16H ; Illegal direct +TM .EQU 18H ; Type miss-match +OS .EQU 1AH ; Out of string space +LS .EQU 1CH ; String too long +ST .EQU 1EH ; String formula too complex +CN .EQU 20H ; Can't CONTinue +UF .EQU 22H ; UnDEFined FN function +MO .EQU 24H ; Missing operand +HX .EQU 26H ; HEX error +BN .EQU 28H ; BIN error + + .ORG MC_CODE_START + +COLD: JP STARTB ; Jump for cold start +WARM: JP WARMST ; Jump for warm start +STARTB: + LD IX,0 ; Flag cold start + JP CSTART ; Jump to initialise + + .WORD DEINT ; Get integer -32768 to 32767 + .WORD ABPASS ; Return integer in AB + + +CSTART: LD HL,WRKSPC ; Start of workspace RAM + LD SP,HL ; Set up a temporary stack + JP INITST ; Go to initialise + +INIT: LD DE,INITAB ; Initialise workspace + LD B,INITBE-INITAB+3; Bytes to copy + LD HL,WRKSPC ; Into workspace RAM +COPY: LD A,(DE) ; Get source + LD (HL),A ; To destination + INC HL ; Next destination + INC DE ; Next source + DEC B ; Count bytes + JP NZ,COPY ; More to move + LD SP,HL ; Temporary stack + CALL CLREG ; Clear registers and stack + CALL PRNTCRLF ; Output CRLF + LD (BUFFER+72+1),A ; Mark end of buffer + LD (PROGST),A ; Initialise program area +MSIZE: LD HL,MC_RAM_END+1 ; Directly set top of ram instead of probing + JP SETTOP + ;LD HL,MEMMSG ; Point to message + ;CALL PRS ; Output "Memory size" + ;CALL PROMPT ; Get input with '?' + ;CALL GETCHR ; Get next character + ;OR A ; Set flags + ;JP NZ,TSTMEM ; If number - Test if RAM there + ;LD HL,STLOOK ; Point to start of RAM +;MLOOP: INC HL ; Next byte + ;LD A,H ; Above address FFFF ? + ;OR L + ;JP Z,SETTOP ; Yes - 64K RAM + ;LD A,(HL) ; Get contents + ;LD B,A ; Save it + ;CPL ; Flip all bits + ;LD (HL),A ; Put it back + ;CP (HL) ; RAM there if same + ;LD (HL),B ; Restore old contents + ;JP Z,MLOOP ; If RAM - test next byte + ;JP SETTOP ; Top of RAM found + +;TSTMEM: CALL ATOH ; Get high memory into DE + ;OR A ; Set flags on last byte + ;JP NZ,SNERR ; ?SN Error if bad character + ;EX DE,HL ; Address into HL + ;DEC HL ; Back one byte + ;LD A,11011001B ; Test byte + ;LD B,(HL) ; Get old contents + ;LD (HL),A ; Load test byte + ;CP (HL) ; RAM there if same + ;LD (HL),B ; Restore old contents + ;JP NZ,MSIZE ; Ask again if no RAM + +SETTOP: DEC HL ; Back one byte + LD DE,STLOOK-1 ; See if enough RAM + CALL CPDEHL ; Compare DE with HL + JP C,MSIZE ; Ask again if not enough RAM + LD DE,0-50 ; 50 Bytes string space + LD (LSTRAM),HL ; Save last available RAM + ADD HL,DE ; Allocate string space + LD (STRSPC),HL ; Save string space + CALL CLRPTR ; Clear program area + LD HL,(STRSPC) ; Get end of memory + LD DE,0-17 ; Offset for free bytes + ADD HL,DE ; Adjust HL + LD DE,PROGST ; Start of program text + LD A,L ; Get LSB + SUB E ; Adjust it + LD L,A ; Re-save + LD A,H ; Get MSB + SBC A,D ; Adjust it + LD H,A ; Re-save + PUSH HL ; Save bytes free + LD HL,SIGNON ; Sign-on message + CALL PRS ; Output string + POP HL ; Get bytes free back + CALL PRNTHL ; Output amount of free memory + LD HL,BFREE ; " Bytes free" message + CALL PRS ; Output string + +WARMST: LD SP,STACK ; Temporary stack +BRKRET: CALL CLREG ; Clear registers and stack + JP PRNTOK ; Go to get command line + +BFREE: .BYTE " Bytes free",CR,LF,0,0 + +SIGNON: .BYTE "Z80 BASIC Ver 4.7b",CR,LF + .BYTE "Copyright ",40,"C",41 + .BYTE " 1978 by Microsoft",CR,LF,0,0 + +MEMMSG: .BYTE "Memory top",0 + +; FUNCTION ADDRESS TABLE + +FNCTAB: .WORD SGN + .WORD INT + .WORD ABS + .WORD USR + .WORD FRE + .WORD INP + .WORD POS + .WORD SQR + .WORD RND + .WORD LOG + .WORD EXP + .WORD COS + .WORD SIN + .WORD TAN + .WORD ATN + .WORD PEEK + .WORD DEEK + .WORD POINT + .WORD LEN + .WORD STR + .WORD VAL + .WORD ASC + .WORD CHR + .WORD HEX + .WORD BIN + .WORD LEFT + .WORD RIGHT + .WORD MID + +; RESERVED WORD LIST + +WORDS: .BYTE 'E'+80H,"ND" + .BYTE 'F'+80H,"OR" + .BYTE 'N'+80H,"EXT" + .BYTE 'D'+80H,"ATA" + .BYTE 'I'+80H,"NPUT" + .BYTE 'D'+80H,"IM" + .BYTE 'R'+80H,"EAD" + .BYTE 'L'+80H,"ET" + .BYTE 'G'+80H,"OTO" + .BYTE 'R'+80H,"UN" + .BYTE 'I'+80H,"F" + .BYTE 'R'+80H,"ESTORE" + .BYTE 'G'+80H,"OSUB" + .BYTE 'R'+80H,"ETURN" + .BYTE 'R'+80H,"EM" + .BYTE 'S'+80H,"TOP" + .BYTE 'O'+80H,"UT" + .BYTE 'O'+80H,"N" + .BYTE 'N'+80H,"ULL" + .BYTE 'W'+80H,"AIT" + .BYTE 'D'+80H,"EF" + .BYTE 'P'+80H,"OKE" + .BYTE 'D'+80H,"OKE" + .BYTE 'S'+80H,"CREEN" + .BYTE 'L'+80H,"INES" + .BYTE 'C'+80H,"LS" + .BYTE 'W'+80H,"IDTH" + .BYTE 'M'+80H,"ONITOR" + .BYTE 'S'+80H,"ET" + .BYTE 'R'+80H,"ESET" + .BYTE 'P'+80H,"RINT" + .BYTE 'C'+80H,"ONT" + .BYTE 'L'+80H,"IST" + .BYTE 'C'+80H,"LEAR" + .BYTE 'C'+80H,"LOAD" + .BYTE 'C'+80H,"SAVE" + .BYTE 'N'+80H,"EW" + + .BYTE 'T'+80H,"AB(" + .BYTE 'T'+80H,"O" + .BYTE 'F'+80H,"N" + .BYTE 'S'+80H,"PC(" + .BYTE 'T'+80H,"HEN" + .BYTE 'N'+80H,"OT" + .BYTE 'S'+80H,"TEP" + + .BYTE '+'+80H + .BYTE '-'+80H + .BYTE '*'+80H + .BYTE '/'+80H + .BYTE '^'+80H + .BYTE 'A'+80H,"ND" + .BYTE 'O'+80H,"R" + .BYTE '>'+80H + .BYTE '='+80H + .BYTE '<'+80H + + .BYTE 'S'+80H,"GN" + .BYTE 'I'+80H,"NT" + .BYTE 'A'+80H,"BS" + .BYTE 'U'+80H,"SR" + .BYTE 'F'+80H,"RE" + .BYTE 'I'+80H,"NP" + .BYTE 'P'+80H,"OS" + .BYTE 'S'+80H,"QR" + .BYTE 'R'+80H,"ND" + .BYTE 'L'+80H,"OG" + .BYTE 'E'+80H,"XP" + .BYTE 'C'+80H,"OS" + .BYTE 'S'+80H,"IN" + .BYTE 'T'+80H,"AN" + .BYTE 'A'+80H,"TN" + .BYTE 'P'+80H,"EEK" + .BYTE 'D'+80H,"EEK" + .BYTE 'P'+80H,"OINT" + .BYTE 'L'+80H,"EN" + .BYTE 'S'+80H,"TR$" + .BYTE 'V'+80H,"AL" + .BYTE 'A'+80H,"SC" + .BYTE 'C'+80H,"HR$" + .BYTE 'H'+80H,"EX$" + .BYTE 'B'+80H,"IN$" + .BYTE 'L'+80H,"EFT$" + .BYTE 'R'+80H,"IGHT$" + .BYTE 'M'+80H,"ID$" + .BYTE 80H ; End of list marker + +; KEYWORD ADDRESS TABLE + +WORDTB: .WORD PEND + .WORD FOR + .WORD NEXT + .WORD DATA + .WORD INPUT + .WORD DIM + .WORD READ + .WORD LET + .WORD GOTO + .WORD RUN + .WORD IF + .WORD RESTOR + .WORD GOSUB + .WORD RETURN + .WORD REM + .WORD STOP + .WORD POUT + .WORD ON + .WORD NULL + .WORD WAIT + .WORD DEF + .WORD POKE + .WORD DOKE + .WORD REM + .WORD LINES + .WORD CLS + .WORD WIDTH + .WORD MONITR + .WORD PSET + .WORD RESET + .WORD PRINT + .WORD CONT + .WORD LIST + .WORD CLEAR + .WORD FCERR + .WORD FCERR + .WORD NEW + +; RESERVED WORD TOKEN VALUES + +ZEND .EQU 080H ; END +ZFOR .EQU 081H ; FOR +ZDATA .EQU 083H ; DATA +ZGOTO .EQU 088H ; GOTO +ZGOSUB .EQU 08CH ; GOSUB +ZREM .EQU 08EH ; REM +ZPRINT .EQU 09EH ; PRINT +ZNEW .EQU 0A4H ; NEW + +ZTAB .EQU 0A5H ; TAB +ZTO .EQU 0A6H ; TO +ZFN .EQU 0A7H ; FN +ZSPC .EQU 0A8H ; SPC +ZTHEN .EQU 0A9H ; THEN +ZNOT .EQU 0AAH ; NOT +ZSTEP .EQU 0ABH ; STEP + +ZPLUS .EQU 0ACH ; + +ZMINUS .EQU 0ADH ; - +ZTIMES .EQU 0AEH ; * +ZDIV .EQU 0AFH ; / +ZOR .EQU 0B2H ; OR +ZGTR .EQU 0B3H ; > +ZEQUAL .EQU 0B4H ; M +ZLTH .EQU 0B5H ; < +ZSGN .EQU 0B6H ; SGN +ZPOINT .EQU 0C7H ; POINT +ZLEFT .EQU 0CDH +2 ; LEFT$ + +; ARITHMETIC PRECEDENCE TABLE + +PRITAB: .BYTE 79H ; Precedence value + .WORD PADD ; FPREG = + FPREG + + .BYTE 79H ; Precedence value + .WORD PSUB ; FPREG = - FPREG + + .BYTE 7CH ; Precedence value + .WORD MULT ; PPREG = * FPREG + + .BYTE 7CH ; Precedence value + .WORD DIV ; FPREG = / FPREG + + .BYTE 7FH ; Precedence value + .WORD POWER ; FPREG = ^ FPREG + + .BYTE 50H ; Precedence value + .WORD PAND ; FPREG = AND FPREG + + .BYTE 46H ; Precedence value + .WORD POR ; FPREG = OR FPREG + +; BASIC ERROR CODE LIST + +ERRORS: .BYTE "NF" ; NEXT without FOR + .BYTE "SN" ; Syntax error + .BYTE "RG" ; RETURN without GOSUB + .BYTE "OD" ; Out of DATA + .BYTE "FC" ; Illegal function call + .BYTE "OV" ; Overflow error + .BYTE "OM" ; Out of memory + .BYTE "UL" ; Undefined line + .BYTE "BS" ; Bad subscript + .BYTE "DD" ; Re-DIMensioned array + .BYTE "/0" ; Division by zero + .BYTE "ID" ; Illegal direct + .BYTE "TM" ; Type mis-match + .BYTE "OS" ; Out of string space + .BYTE "LS" ; String too long + .BYTE "ST" ; String formula too complex + .BYTE "CN" ; Can't CONTinue + .BYTE "UF" ; Undefined FN function + .BYTE "MO" ; Missing operand + .BYTE "HX" ; HEX error + .BYTE "BN" ; BIN error + +; INITIALISATION TABLE ------------------------------------------------------- + +INITAB: JP WARMST ; Warm start jump + JP FCERR ; "USR (X)" jump (Set to Error) + OUT (0),A ; "OUT p,n" skeleton + RET + SUB 0 ; Division support routine + LD L,A + LD A,H + SBC A,0 + LD H,A + LD A,B + SBC A,0 + LD B,A + LD A,0 + RET + .BYTE 0,0,0 ; Random number seed table used by RND + .BYTE 035H,04AH,0CAH,099H ;-2.65145E+07 + .BYTE 039H,01CH,076H,098H ; 1.61291E+07 + .BYTE 022H,095H,0B3H,098H ;-1.17691E+07 + .BYTE 00AH,0DDH,047H,098H ; 1.30983E+07 + .BYTE 053H,0D1H,099H,099H ;-2-01612E+07 + .BYTE 00AH,01AH,09FH,098H ;-1.04269E+07 + .BYTE 065H,0BCH,0CDH,098H ;-1.34831E+07 + .BYTE 0D6H,077H,03EH,098H ; 1.24825E+07 + .BYTE 052H,0C7H,04FH,080H ; Last random number + IN A,(0) ; INP (x) skeleton + RET + .BYTE 1 ; POS (x) number (1) + .BYTE 255 ; Terminal width (255 = no auto CRLF) + .BYTE 28 ; Width for commas (3 columns) + .BYTE 0 ; No nulls after input bytes + .BYTE 0 ; Output enabled (^O off) + .WORD 20 ; Initial lines counter + .WORD 20 ; Initial lines number + .WORD 0 ; Array load/save check sum + .BYTE 0 ; Break not by NMI + .BYTE 0 ; Break flag + JP TTYLIN ; Input reflection (set to TTY) + JP FCERR ; POINT reflection (unsupported) + JP FCERR ; SET reflection (unsupported) + JP FCERR ; RESET reflection (unsupported) + .WORD STLOOK ; Temp string space + .WORD -2 ; Current line number (cold) + .WORD PROGST+1 ; Start of program text +INITBE: + +; END OF INITIALISATION TABLE --------------------------------------------------- + +ERRMSG: .BYTE " Error",0 +INMSG: .BYTE " in ",0 +ZERBYT .EQU $-1 ; A zero byte +OKMSG: .BYTE "Ok",CR,LF,0,0 +BRKMSG: .BYTE "Break",0 + +BAKSTK: LD HL,4 ; Look for "FOR" block with + ADD HL,SP ; same index as specified +LOKFOR: LD A,(HL) ; Get block ID + INC HL ; Point to index address + CP ZFOR ; Is it a "FOR" token + RET NZ ; No - exit + LD C,(HL) ; BC = Address of "FOR" index + INC HL + LD B,(HL) + INC HL ; Point to sign of STEP + PUSH HL ; Save pointer to sign + LD L,C ; HL = address of "FOR" index + LD H,B + LD A,D ; See if an index was specified + OR E ; DE = 0 if no index specified + EX DE,HL ; Specified index into HL + JP Z,INDFND ; Skip if no index given + EX DE,HL ; Index back into DE + CALL CPDEHL ; Compare index with one given +INDFND: LD BC,16-3 ; Offset to next block + POP HL ; Restore pointer to sign + RET Z ; Return if block found + ADD HL,BC ; Point to next block + JP LOKFOR ; Keep on looking + +MOVUP: CALL ENFMEM ; See if enough memory +MOVSTR: PUSH BC ; Save end of source + EX (SP),HL ; Swap source and dest" end + POP BC ; Get end of destination +MOVLP: CALL CPDEHL ; See if list moved + LD A,(HL) ; Get byte + LD (BC),A ; Move it + RET Z ; Exit if all done + DEC BC ; Next byte to move to + DEC HL ; Next byte to move + JP MOVLP ; Loop until all bytes moved + +CHKSTK: PUSH HL ; Save code string address + LD HL,(ARREND) ; Lowest free memory + LD B,0 ; BC = Number of levels to test + ADD HL,BC ; 2 Bytes for each level + ADD HL,BC + .BYTE 3EH ; Skip "PUSH HL" +ENFMEM: PUSH HL ; Save code string address + LD A,0D0H ;LOW -48 ; 48 Bytes minimum RAM + SUB L + LD L,A + LD A,0FFH; HIGH (-48) ; 48 Bytes minimum RAM + SBC A,H + JP C,OMERR ; Not enough - ?OM Error + LD H,A + ADD HL,SP ; Test if stack is overflowed + POP HL ; Restore code string address + RET C ; Return if enough mmory +OMERR: LD E,OM ; ?OM Error + JP ERROR + +DATSNR: LD HL,(DATLIN) ; Get line of current DATA item + LD (LINEAT),HL ; Save as current line +SNERR: LD E,SN ; ?SN Error + .BYTE 01H ; Skip "LD E,DZ" +DZERR: LD E,DZ ; ?/0 Error + .BYTE 01H ; Skip "LD E,NF" +NFERR: LD E,NF ; ?NF Error + .BYTE 01H ; Skip "LD E,DD" +DDERR: LD E,DD ; ?DD Error + .BYTE 01H ; Skip "LD E,UF" +UFERR: LD E,UF ; ?UF Error + .BYTE 01H ; Skip "LD E,OV +OVERR: LD E,OV ; ?OV Error + .BYTE 01H ; Skip "LD E,TM" +TMERR: LD E,TM ; ?TM Error + +ERROR: CALL CLREG ; Clear registers and stack + LD (CTLOFG),A ; Enable output (A is 0) + CALL STTLIN ; Start new line + LD HL,ERRORS ; Point to error codes + LD D,A ; D = 0 (A is 0) + LD A,'?' + CALL OUTC ; Output '?' + ADD HL,DE ; Offset to correct error code + LD A,(HL) ; First character + CALL OUTC ; Output it + CALL GETCHR ; Get next character + CALL OUTC ; Output it + LD HL,ERRMSG ; "Error" message +ERRIN: CALL PRS ; Output message + LD HL,(LINEAT) ; Get line of error + LD DE,-2 ; Cold start error if -2 + CALL CPDEHL ; See if cold start error + JP Z,CSTART ; Cold start error - Restart + LD A,H ; Was it a direct error? + AND L ; Line = -1 if direct error + INC A + CALL NZ,LINEIN ; No - output line of error + .BYTE 3EH ; Skip "POP BC" +POPNOK: POP BC ; Drop address in input buffer + +PRNTOK: XOR A ; Output "Ok" and get command + LD (CTLOFG),A ; Enable output + CALL STTLIN ; Start new line + LD HL,OKMSG ; "Ok" message + CALL PRS ; Output "Ok" +GETCMD: LD HL,-1 ; Flag direct mode + LD (LINEAT),HL ; Save as current line + CALL GETLIN ; Get an input line + JP C,GETCMD ; Get line again if break + CALL GETCHR ; Get first character + INC A ; Test if end of line + DEC A ; Without affecting Carry + JP Z,GETCMD ; Nothing entered - Get another + PUSH AF ; Save Carry status + CALL ATOH ; Get line number into DE + PUSH DE ; Save line number + CALL CRUNCH ; Tokenise rest of line + LD B,A ; Length of tokenised line + POP DE ; Restore line number + POP AF ; Restore Carry + JP NC,EXCUTE ; No line number - Direct mode + PUSH DE ; Save line number + PUSH BC ; Save length of tokenised line + XOR A + LD (LSTBIN),A ; Clear last byte input + CALL GETCHR ; Get next character + OR A ; Set flags + PUSH AF ; And save them + CALL SRCHLN ; Search for line number in DE + JP C,LINFND ; Jump if line found + POP AF ; Get status + PUSH AF ; And re-save + JP Z,ULERR ; Nothing after number - Error + OR A ; Clear Carry +LINFND: PUSH BC ; Save address of line in prog + JP NC,INEWLN ; Line not found - Insert new + EX DE,HL ; Next line address in DE + LD HL,(PROGND) ; End of program +SFTPRG: LD A,(DE) ; Shift rest of program down + LD (BC),A + INC BC ; Next destination + INC DE ; Next source + CALL CPDEHL ; All done? + JP NZ,SFTPRG ; More to do + LD H,B ; HL - New end of program + LD L,C + LD (PROGND),HL ; Update end of program + +INEWLN: POP DE ; Get address of line, + POP AF ; Get status + JP Z,SETPTR ; No text - Set up pointers + LD HL,(PROGND) ; Get end of program + EX (SP),HL ; Get length of input line + POP BC ; End of program to BC + ADD HL,BC ; Find new end + PUSH HL ; Save new end + CALL MOVUP ; Make space for line + POP HL ; Restore new end + LD (PROGND),HL ; Update end of program pointer + EX DE,HL ; Get line to move up in HL + LD (HL),H ; Save MSB + POP DE ; Get new line number + INC HL ; Skip pointer + INC HL + LD (HL),E ; Save LSB of line number + INC HL + LD (HL),D ; Save MSB of line number + INC HL ; To first byte in line + LD DE,BUFFER ; Copy buffer to program +MOVBUF: LD A,(DE) ; Get source + LD (HL),A ; Save destinations + INC HL ; Next source + INC DE ; Next destination + OR A ; Done? + JP NZ,MOVBUF ; No - Repeat +SETPTR: CALL RUNFST ; Set line pointers + INC HL ; To LSB of pointer + EX DE,HL ; Address to DE +PTRLP: LD H,D ; Address to HL + LD L,E + LD A,(HL) ; Get LSB of pointer + INC HL ; To MSB of pointer + OR (HL) ; Compare with MSB pointer + JP Z,GETCMD ; Get command line if end + INC HL ; To LSB of line number + INC HL ; Skip line number + INC HL ; Point to first byte in line + XOR A ; Looking for 00 byte +FNDEND: CP (HL) ; Found end of line? + INC HL ; Move to next byte + JP NZ,FNDEND ; No - Keep looking + EX DE,HL ; Next line address to HL + LD (HL),E ; Save LSB of pointer + INC HL + LD (HL),D ; Save MSB of pointer + JP PTRLP ; Do next line + +SRCHLN: LD HL,(BASTXT) ; Start of program text +SRCHLP: LD B,H ; BC = Address to look at + LD C,L + LD A,(HL) ; Get address of next line + INC HL + OR (HL) ; End of program found? + DEC HL + RET Z ; Yes - Line not found + INC HL + INC HL + LD A,(HL) ; Get LSB of line number + INC HL + LD H,(HL) ; Get MSB of line number + LD L,A + CALL CPDEHL ; Compare with line in DE + LD H,B ; HL = Start of this line + LD L,C + LD A,(HL) ; Get LSB of next line address + INC HL + LD H,(HL) ; Get MSB of next line address + LD L,A ; Next line to HL + CCF + RET Z ; Lines found - Exit + CCF + RET NC ; Line not found,at line after + JP SRCHLP ; Keep looking + +NEW: RET NZ ; Return if any more on line +CLRPTR: LD HL,(BASTXT) ; Point to start of program + XOR A ; Set program area to empty + LD (HL),A ; Save LSB = 00 + INC HL + LD (HL),A ; Save MSB = 00 + INC HL + LD (PROGND),HL ; Set program end + +RUNFST: LD HL,(BASTXT) ; Clear all variables + DEC HL + +INTVAR: LD (BRKLIN),HL ; Initialise RUN variables + LD HL,(LSTRAM) ; Get end of RAM + LD (STRBOT),HL ; Clear string space + XOR A + CALL RESTOR ; Reset DATA pointers + LD HL,(PROGND) ; Get end of program + LD (VAREND),HL ; Clear variables + LD (ARREND),HL ; Clear arrays + +CLREG: POP BC ; Save return address + LD HL,(STRSPC) ; Get end of working RAN + LD SP,HL ; Set stack + LD HL,TMSTPL ; Temporary string pool + LD (TMSTPT),HL ; Reset temporary string ptr + XOR A ; A = 00 + LD L,A ; HL = 0000 + LD H,A + LD (CONTAD),HL ; No CONTinue + LD (FORFLG),A ; Clear FOR flag + LD (FNRGNM),HL ; Clear FN argument + PUSH HL ; HL = 0000 + PUSH BC ; Put back return +DOAGN: LD HL,(BRKLIN) ; Get address of code to RUN + RET ; Return to execution driver + +PROMPT: LD A,'?' ; '?' + CALL OUTC ; Output character + LD A,' ' ; Space + CALL OUTC ; Output character + JP RINPUT ; Get input line + +CRUNCH: XOR A ; Tokenise line @ HL to BUFFER + LD (DATFLG),A ; Reset literal flag + LD C,2+3 ; 2 byte number and 3 nulls + LD DE,BUFFER ; Start of input buffer +CRNCLP: LD A,(HL) ; Get byte + CP ' ' ; Is it a space? + JP Z,MOVDIR ; Yes - Copy direct + LD B,A ; Save character + CP '"' ; Is it a quote? + JP Z,CPYLIT ; Yes - Copy literal string + OR A ; Is it end of buffer? + JP Z,ENDBUF ; Yes - End buffer + LD A,(DATFLG) ; Get data type + OR A ; Literal? + LD A,(HL) ; Get byte to copy + JP NZ,MOVDIR ; Literal - Copy direct + CP '?' ; Is it '?' short for PRINT + LD A,ZPRINT ; "PRINT" token + JP Z,MOVDIR ; Yes - replace it + LD A,(HL) ; Get byte again + CP '0' ; Is it less than '0' + JP C,FNDWRD ; Yes - Look for reserved words + CP 60; ";"+1 ; Is it "0123456789:;" ? + JP C,MOVDIR ; Yes - copy it direct +FNDWRD: PUSH DE ; Look for reserved words + LD DE,WORDS-1 ; Point to table + PUSH BC ; Save count + LD BC,RETNAD ; Where to return to + PUSH BC ; Save return address + LD B,ZEND-1 ; First token value -1 + LD A,(HL) ; Get byte + CP 'a' ; Less than 'a' ? + JP C,SEARCH ; Yes - search for words + CP 'z'+1 ; Greater than 'z' ? + JP NC,SEARCH ; Yes - search for words + AND 01011111B ; Force upper case + LD (HL),A ; Replace byte +SEARCH: LD C,(HL) ; Search for a word + EX DE,HL +GETNXT: INC HL ; Get next reserved word + OR (HL) ; Start of word? + JP P,GETNXT ; No - move on + INC B ; Increment token value + LD A, (HL) ; Get byte from table + AND 01111111B ; Strip bit 7 + RET Z ; Return if end of list + CP C ; Same character as in buffer? + JP NZ,GETNXT ; No - get next word + EX DE,HL + PUSH HL ; Save start of word + +NXTBYT: INC DE ; Look through rest of word + LD A,(DE) ; Get byte from table + OR A ; End of word ? + JP M,MATCH ; Yes - Match found + LD C,A ; Save it + LD A,B ; Get token value + CP ZGOTO ; Is it "GOTO" token ? + JP NZ,NOSPC ; No - Don't allow spaces + CALL GETCHR ; Get next character + DEC HL ; Cancel increment from GETCHR +NOSPC: INC HL ; Next byte + LD A,(HL) ; Get byte + CP 'a' ; Less than 'a' ? + JP C,NOCHNG ; Yes - don't change + AND 01011111B ; Make upper case +NOCHNG: CP C ; Same as in buffer ? + JP Z,NXTBYT ; Yes - keep testing + POP HL ; Get back start of word + JP SEARCH ; Look at next word + +MATCH: LD C,B ; Word found - Save token value + POP AF ; Throw away return + EX DE,HL + RET ; Return to "RETNAD" +RETNAD: EX DE,HL ; Get address in string + LD A,C ; Get token value + POP BC ; Restore buffer length + POP DE ; Get destination address +MOVDIR: INC HL ; Next source in buffer + LD (DE),A ; Put byte in buffer + INC DE ; Move up buffer + INC C ; Increment length of buffer + SUB ':' ; End of statement? + JP Z,SETLIT ; Jump if multi-statement line + CP ZDATA-3AH ; Is it DATA statement ? + JP NZ,TSTREM ; No - see if REM +SETLIT: LD (DATFLG),A ; Set literal flag +TSTREM: SUB ZREM-3AH ; Is it REM? + JP NZ,CRNCLP ; No - Leave flag + LD B,A ; Copy rest of buffer +NXTCHR: LD A,(HL) ; Get byte + OR A ; End of line ? + JP Z,ENDBUF ; Yes - Terminate buffer + CP B ; End of statement ? + JP Z,MOVDIR ; Yes - Get next one +CPYLIT: INC HL ; Move up source string + LD (DE),A ; Save in destination + INC C ; Increment length + INC DE ; Move up destination + JP NXTCHR ; Repeat + +ENDBUF: LD HL,BUFFER-1 ; Point to start of buffer + LD (DE),A ; Mark end of buffer (A = 00) + INC DE + LD (DE),A ; A = 00 + INC DE + LD (DE),A ; A = 00 + RET + +DODEL: LD A,(NULFLG) ; Get null flag status + OR A ; Is it zero? + LD A,0 ; Zero A - Leave flags + LD (NULFLG),A ; Zero null flag + JP NZ,ECHDEL ; Set - Echo it + DEC B ; Decrement length + JP Z,GETLIN ; Get line again if empty + CALL OUTC ; Output null character + .BYTE 3EH ; Skip "DEC B" +ECHDEL: DEC B ; Count bytes in buffer + DEC HL ; Back space buffer + JP Z,OTKLN ; No buffer - Try again + LD A,(HL) ; Get deleted byte + CALL OUTC ; Echo it + JP MORINP ; Get more input + +DELCHR: DEC B ; Count bytes in buffer + DEC HL ; Back space buffer + CALL OUTC ; Output character in A + JP NZ,MORINP ; Not end - Get more +OTKLN: CALL OUTC ; Output character in A +KILIN: CALL PRNTCRLF ; Output CRLF + JP TTYLIN ; Get line again + +GETLIN: +TTYLIN: LD HL,BUFFER ; Get a line by character + LD B,1 ; Set buffer as empty + XOR A + LD (NULFLG),A ; Clear null flag +MORINP: CALL CLOTST ; Get character and test ^O + LD C,A ; Save character in C + CP DEL ; Delete character? + JP Z,DODEL ; Yes - Process it + LD A,(NULFLG) ; Get null flag + OR A ; Test null flag status + JP Z,PROCES ; Reset - Process character + LD A,0 ; Set a null + CALL OUTC ; Output null + XOR A ; Clear A + LD (NULFLG),A ; Reset null flag +PROCES: LD A,C ; Get character + CP CTRLG ; Bell? + JP Z,PUTCTL ; Yes - Save it + CP CTRLC ; Is it control "C"? + CALL Z,PRNTCRLF ; Yes - Output CRLF + SCF ; Flag break + RET Z ; Return if control "C" + CP CR ; Is it enter? + JP Z,ENDINP ; Yes - Terminate input + CP CTRLU ; Is it control "U"? + JP Z,KILIN ; Yes - Get another line + CP '@' ; Is it "kill line"? + JP Z,OTKLN ; Yes - Kill line + CP '_' ; Is it delete? + JP Z,DELCHR ; Yes - Delete character + CP BKSP ; Is it backspace? + JP Z,DELCHR ; Yes - Delete character + CP CTRLR ; Is it control "R"? + JP NZ,PUTBUF ; No - Put in buffer + PUSH BC ; Save buffer length + PUSH DE ; Save DE + PUSH HL ; Save buffer address + LD (HL),0 ; Mark end of buffer + CALL OUTNCR ; Output and do CRLF + LD HL,BUFFER ; Point to buffer start + CALL PRS ; Output buffer + POP HL ; Restore buffer address + POP DE ; Restore DE + POP BC ; Restore buffer length + JP MORINP ; Get another character + +PUTBUF: CP ' ' ; Is it a control code? + JP C,MORINP ; Yes - Ignore +PUTCTL: LD A,B ; Get number of bytes in buffer + CP 72+1 ; Test for line overflow + LD A,CTRLG ; Set a bell + JP NC,OUTNBS ; Ring bell if buffer full + LD A,C ; Get character + LD (HL),C ; Save in buffer + LD (LSTBIN),A ; Save last input byte + INC HL ; Move up buffer + INC B ; Increment length +OUTIT: CALL OUTC ; Output the character entered + JP MORINP ; Get another character + +OUTNBS: CALL OUTC ; Output bell and back over it + LD A,BKSP ; Set back space + JP OUTIT ; Output it and get more + +CPDEHL: LD A,H ; Get H + SUB D ; Compare with D + RET NZ ; Different - Exit + LD A,L ; Get L + SUB E ; Compare with E + RET ; Return status + +CHKSYN: LD A,(HL) ; Check syntax of character + EX (SP),HL ; Address of test byte + CP (HL) ; Same as in code string? + INC HL ; Return address + EX (SP),HL ; Put it back + JP Z,GETCHR ; Yes - Get next character + JP SNERR ; Different - ?SN Error + +OUTC: PUSH AF ; Save character + LD A,(CTLOFG) ; Get control "O" flag + OR A ; Is it set? + JP NZ,POPAF ; Yes - don't output + POP AF ; Restore character + PUSH BC ; Save buffer length + PUSH AF ; Save character + CP ' ' ; Is it a control code? + JP C,DINPOS ; Yes - Don't INC POS(X) + LD A,(LWIDTH) ; Get line width + LD B,A ; To B + LD A,(CURPOS) ; Get cursor position + INC B ; Width 255? + JP Z,INCLEN ; Yes - No width limit + DEC B ; Restore width + CP B ; At end of line? + CALL Z,PRNTCRLF ; Yes - output CRLF +INCLEN: INC A ; Move on one character + LD (CURPOS),A ; Save new position +DINPOS: POP AF ; Restore character + POP BC ; Restore buffer length + CALL MONOUT ; Send it + RET + +CLOTST: CALL GETINP ; Get input character + AND 01111111B ; Strip bit 7 + CP CTRLO ; Is it control "O"? + RET NZ ; No don't flip flag + LD A,(CTLOFG) ; Get flag + CPL ; Flip it + LD (CTLOFG),A ; Put it back + XOR A ; Null character + RET + +LIST: CALL ATOH ; ASCII number to DE + RET NZ ; Return if anything extra + POP BC ; Rubbish - Not needed + CALL SRCHLN ; Search for line number in DE + PUSH BC ; Save address of line + CALL SETLIN ; Set up lines counter +LISTLP: POP HL ; Restore address of line + LD C,(HL) ; Get LSB of next line + INC HL + LD B,(HL) ; Get MSB of next line + INC HL + LD A,B ; BC = 0 (End of program)? + OR C + JP Z,PRNTOK ; Yes - Go to command mode + CALL COUNT ; Count lines + CALL TSTBRK ; Test for break key + PUSH BC ; Save address of next line + CALL PRNTCRLF ; Output CRLF + LD E,(HL) ; Get LSB of line number + INC HL + LD D,(HL) ; Get MSB of line number + INC HL + PUSH HL ; Save address of line start + EX DE,HL ; Line number to HL + CALL PRNTHL ; Output line number in decimal + LD A,' ' ; Space after line number + POP HL ; Restore start of line address +LSTLP2: CALL OUTC ; Output character in A +LSTLP3: LD A,(HL) ; Get next byte in line + OR A ; End of line? + INC HL ; To next byte in line + JP Z,LISTLP ; Yes - get next line + JP P,LSTLP2 ; No token - output it + SUB ZEND-1 ; Find and output word + LD C,A ; Token offset+1 to C + LD DE,WORDS ; Reserved word list +FNDTOK: LD A,(DE) ; Get character in list + INC DE ; Move on to next + OR A ; Is it start of word? + JP P,FNDTOK ; No - Keep looking for word + DEC C ; Count words + JP NZ,FNDTOK ; Not there - keep looking +OUTWRD: AND 01111111B ; Strip bit 7 + CALL OUTC ; Output first character + LD A,(DE) ; Get next character + INC DE ; Move on to next + OR A ; Is it end of word? + JP P,OUTWRD ; No - output the rest + JP LSTLP3 ; Next byte in line + +SETLIN: PUSH HL ; Set up LINES counter + LD HL,(LINESN) ; Get LINES number + LD (LINESC),HL ; Save in LINES counter + POP HL + RET + +COUNT: PUSH HL ; Save code string address + PUSH DE + LD HL,(LINESC) ; Get LINES counter + LD DE,-1 + ADC HL,DE ; Decrement + LD (LINESC),HL ; Put it back + POP DE + POP HL ; Restore code string address + RET P ; Return if more lines to go + PUSH HL ; Save code string address + LD HL,(LINESN) ; Get LINES number + LD (LINESC),HL ; Reset LINES counter + CALL GETINP ; Get input character + CP CTRLC ; Is it control "C"? + JP Z,RSLNBK ; Yes - Reset LINES and break + POP HL ; Restore code string address + JP COUNT ; Keep on counting + +RSLNBK: LD HL,(LINESN) ; Get LINES number + LD (LINESC),HL ; Reset LINES counter + JP BRKRET ; Go and output "Break" + +FOR: LD A,64H ; Flag "FOR" assignment + LD (FORFLG),A ; Save "FOR" flag + CALL LET ; Set up initial index + POP BC ; Drop RETurn address + PUSH HL ; Save code string address + CALL DATA ; Get next statement address + LD (LOOPST),HL ; Save it for start of loop + LD HL,2 ; Offset for "FOR" block + ADD HL,SP ; Point to it +FORSLP: CALL LOKFOR ; Look for existing "FOR" block + POP DE ; Get code string address + JP NZ,FORFND ; No nesting found + ADD HL,BC ; Move into "FOR" block + PUSH DE ; Save code string address + DEC HL + LD D,(HL) ; Get MSB of loop statement + DEC HL + LD E,(HL) ; Get LSB of loop statement + INC HL + INC HL + PUSH HL ; Save block address + LD HL,(LOOPST) ; Get address of loop statement + CALL CPDEHL ; Compare the FOR loops + POP HL ; Restore block address + JP NZ,FORSLP ; Different FORs - Find another + POP DE ; Restore code string address + LD SP,HL ; Remove all nested loops + +FORFND: EX DE,HL ; Code string address to HL + LD C,8 + CALL CHKSTK ; Check for 8 levels of stack + PUSH HL ; Save code string address + LD HL,(LOOPST) ; Get first statement of loop + EX (SP),HL ; Save and restore code string + PUSH HL ; Re-save code string address + LD HL,(LINEAT) ; Get current line number + EX (SP),HL ; Save and restore code string + CALL TSTNUM ; Make sure it's a number + CALL CHKSYN ; Make sure "TO" is next + .BYTE ZTO ; "TO" token + CALL GETNUM ; Get "TO" expression value + PUSH HL ; Save code string address + CALL BCDEFP ; Move "TO" value to BCDE + POP HL ; Restore code string address + PUSH BC ; Save "TO" value in block + PUSH DE + LD BC,8100H ; BCDE - 1 (default STEP) + LD D,C ; C=0 + LD E,D ; D=0 + LD A,(HL) ; Get next byte in code string + CP ZSTEP ; See if "STEP" is stated + LD A,1 ; Sign of step = 1 + JP NZ,SAVSTP ; No STEP given - Default to 1 + CALL GETCHR ; Jump over "STEP" token + CALL GETNUM ; Get step value + PUSH HL ; Save code string address + CALL BCDEFP ; Move STEP to BCDE + CALL TSTSGN ; Test sign of FPREG + POP HL ; Restore code string address +SAVSTP: PUSH BC ; Save the STEP value in block + PUSH DE + PUSH AF ; Save sign of STEP + INC SP ; Don't save flags + PUSH HL ; Save code string address + LD HL,(BRKLIN) ; Get address of index variable + EX (SP),HL ; Save and restore code string +PUTFID: LD B,ZFOR ; "FOR" block marker + PUSH BC ; Save it + INC SP ; Don't save C + +RUNCNT: CALL TSTBRK ; Execution driver - Test break + LD (BRKLIN),HL ; Save code address for break + LD A,(HL) ; Get next byte in code string + CP ':' ; Multi statement line? + JP Z,EXCUTE ; Yes - Execute it + OR A ; End of line? + JP NZ,SNERR ; No - Syntax error + INC HL ; Point to address of next line + LD A,(HL) ; Get LSB of line pointer + INC HL + OR (HL) ; Is it zero (End of prog)? + JP Z,ENDPRG ; Yes - Terminate execution + INC HL ; Point to line number + LD E,(HL) ; Get LSB of line number + INC HL + LD D,(HL) ; Get MSB of line number + EX DE,HL ; Line number to HL + LD (LINEAT),HL ; Save as current line number + EX DE,HL ; Line number back to DE +EXCUTE: CALL GETCHR ; Get key word + LD DE,RUNCNT ; Where to RETurn to + PUSH DE ; Save for RETurn +IFJMP: RET Z ; Go to RUNCNT if end of STMT +ONJMP: SUB ZEND ; Is it a token? + JP C,LET ; No - try to assign it + CP ZNEW+1-ZEND ; END to NEW ? + JP NC,SNERR ; Not a key word - ?SN Error + RLCA ; Double it + LD C,A ; BC = Offset into table + LD B,0 + EX DE,HL ; Save code string address + LD HL,WORDTB ; Keyword address table + ADD HL,BC ; Point to routine address + LD C,(HL) ; Get LSB of routine address + INC HL + LD B,(HL) ; Get MSB of routine address + PUSH BC ; Save routine address + EX DE,HL ; Restore code string address + +GETCHR: INC HL ; Point to next character + LD A,(HL) ; Get next code string byte + CP ':' ; Z if ':' + RET NC ; NC if > "9" + CP ' ' + JP Z,GETCHR ; Skip over spaces + CP '0' + CCF ; NC if < '0' + INC A ; Test for zero - Leave carry + DEC A ; Z if Null + RET + +RESTOR: EX DE,HL ; Save code string address + LD HL,(BASTXT) ; Point to start of program + JP Z,RESTNL ; Just RESTORE - reset pointer + EX DE,HL ; Restore code string address + CALL ATOH ; Get line number to DE + PUSH HL ; Save code string address + CALL SRCHLN ; Search for line number in DE + LD H,B ; HL = Address of line + LD L,C + POP DE ; Restore code string address + JP NC,ULERR ; ?UL Error if not found +RESTNL: DEC HL ; Byte before DATA statement +UPDATA: LD (NXTDAT),HL ; Update DATA pointer + EX DE,HL ; Restore code string address + RET + + +TSTBRK: ;RST 18H ; Check input status + CALL MC_BIOS_TRY_GETC + OR A + RET Z ; No key, go back + ;RST 10H ; Get the key into A + CP ESC ; Escape key? + JR Z,BRK ; Yes, break + CP CTRLC ; + JR Z,BRK ; Yes, break + CP CTRLS ; Stop scrolling? + RET NZ ; Other key, ignore + + +STALL: ;RST 10H ; Wait for key + CALL MC_BIOS_GETC + CP CTRLQ ; Resume scrolling? + RET Z ; Release the chokehold + CP CTRLC ; Second break? + JR Z,STOP ; Break during hold exits prog + JR STALL ; Loop until or + +BRK LD A,$FF ; Set BRKFLG + LD (BRKFLG),A ; Store it + + +STOP: RET NZ ; Exit if anything else + .BYTE 0F6H ; Flag "STOP" +PEND: RET NZ ; Exit if anything else + LD (BRKLIN),HL ; Save point of break + .BYTE 21H ; Skip "OR 11111111B" +INPBRK: OR 11111111B ; Flag "Break" wanted + POP BC ; Return not needed and more +ENDPRG: LD HL,(LINEAT) ; Get current line number + PUSH AF ; Save STOP / END status + LD A,L ; Is it direct break? + AND H + INC A ; Line is -1 if direct break + JP Z,NOLIN ; Yes - No line number + LD (ERRLIN),HL ; Save line of break + LD HL,(BRKLIN) ; Get point of break + LD (CONTAD),HL ; Save point to CONTinue +NOLIN: XOR A + LD (CTLOFG),A ; Enable output + CALL STTLIN ; Start a new line + POP AF ; Restore STOP / END status + LD HL,BRKMSG ; "Break" message + JP NZ,ERRIN ; "in line" wanted? + JP PRNTOK ; Go to command mode + +CONT: LD HL,(CONTAD) ; Get CONTinue address + LD A,H ; Is it zero? + OR L + LD E,CN ; ?CN Error + JP Z,ERROR ; Yes - output "?CN Error" + EX DE,HL ; Save code string address + LD HL,(ERRLIN) ; Get line of last break + LD (LINEAT),HL ; Set up current line number + EX DE,HL ; Restore code string address + RET ; CONTinue where left off + +NULL: CALL GETINT ; Get integer 0-255 + RET NZ ; Return if bad value + LD (NULLS),A ; Set nulls number + RET + + +ACCSUM: PUSH HL ; Save address in array + LD HL,(CHKSUM) ; Get check sum + LD B,0 ; BC - Value of byte + LD C,A + ADD HL,BC ; Add byte to check sum + LD (CHKSUM),HL ; Re-save check sum + POP HL ; Restore address in array + RET + +CHKLTR: LD A,(HL) ; Get byte + CP 'A' ; < 'a' ? + RET C ; Carry set if not letter + CP 'Z'+1 ; > 'z' ? + CCF + RET ; Carry set if not letter + +FPSINT: CALL GETCHR ; Get next character +POSINT: CALL GETNUM ; Get integer 0 to 32767 +DEPINT: CALL TSTSGN ; Test sign of FPREG + JP M,FCERR ; Negative - ?FC Error +DEINT: LD A,(FPEXP) ; Get integer value to DE + CP 80H+16 ; Exponent in range (16 bits)? + JP C,FPINT ; Yes - convert it + LD BC,9080H ; BCDE = -32768 + LD DE,0000 + PUSH HL ; Save code string address + CALL CMPNUM ; Compare FPREG with BCDE + POP HL ; Restore code string address + LD D,C ; MSB to D + RET Z ; Return if in range +FCERR: LD E,FC ; ?FC Error + JP ERROR ; Output error- + +ATOH: DEC HL ; ASCII number to DE binary +GETLN: LD DE,0 ; Get number to DE +GTLNLP: CALL GETCHR ; Get next character + RET NC ; Exit if not a digit + PUSH HL ; Save code string address + PUSH AF ; Save digit + LD HL,65529/10 ; Largest number 65529 + CALL CPDEHL ; Number in range? + JP C,SNERR ; No - ?SN Error + LD H,D ; HL = Number + LD L,E + ADD HL,DE ; Times 2 + ADD HL,HL ; Times 4 + ADD HL,DE ; Times 5 + ADD HL,HL ; Times 10 + POP AF ; Restore digit + SUB '0' ; Make it 0 to 9 + LD E,A ; DE = Value of digit + LD D,0 + ADD HL,DE ; Add to number + EX DE,HL ; Number to DE + POP HL ; Restore code string address + JP GTLNLP ; Go to next character + +CLEAR: JP Z,INTVAR ; Just "CLEAR" Keep parameters + CALL POSINT ; Get integer 0 to 32767 to DE + DEC HL ; Cancel increment + CALL GETCHR ; Get next character + PUSH HL ; Save code string address + LD HL,(LSTRAM) ; Get end of RAM + JP Z,STORED ; No value given - Use stored + POP HL ; Restore code string address + CALL CHKSYN ; Check for comma + .BYTE ',' + PUSH DE ; Save number + CALL POSINT ; Get integer 0 to 32767 + DEC HL ; Cancel increment + CALL GETCHR ; Get next character + JP NZ,SNERR ; ?SN Error if more on line + EX (SP),HL ; Save code string address + EX DE,HL ; Number to DE +STORED: LD A,L ; Get LSB of new RAM top + SUB E ; Subtract LSB of string space + LD E,A ; Save LSB + LD A,H ; Get MSB of new RAM top + SBC A,D ; Subtract MSB of string space + LD D,A ; Save MSB + JP C,OMERR ; ?OM Error if not enough mem + PUSH HL ; Save RAM top + LD HL,(PROGND) ; Get program end + LD BC,40 ; 40 Bytes minimum working RAM + ADD HL,BC ; Get lowest address + CALL CPDEHL ; Enough memory? + JP NC,OMERR ; No - ?OM Error + EX DE,HL ; RAM top to HL + LD (STRSPC),HL ; Set new string space + POP HL ; End of memory to use + LD (LSTRAM),HL ; Set new top of RAM + POP HL ; Restore code string address + JP INTVAR ; Initialise variables + +RUN: JP Z,RUNFST ; RUN from start if just RUN + CALL INTVAR ; Initialise variables + LD BC,RUNCNT ; Execution driver loop + JP RUNLIN ; RUN from line number + +GOSUB: LD C,3 ; 3 Levels of stack needed + CALL CHKSTK ; Check for 3 levels of stack + POP BC ; Get return address + PUSH HL ; Save code string for RETURN + PUSH HL ; And for GOSUB routine + LD HL,(LINEAT) ; Get current line + EX (SP),HL ; Into stack - Code string out + LD A,ZGOSUB ; "GOSUB" token + PUSH AF ; Save token + INC SP ; Don't save flags + +RUNLIN: PUSH BC ; Save return address +GOTO: CALL ATOH ; ASCII number to DE binary + CALL REM ; Get end of line + PUSH HL ; Save end of line + LD HL,(LINEAT) ; Get current line + CALL CPDEHL ; Line after current? + POP HL ; Restore end of line + INC HL ; Start of next line + CALL C,SRCHLP ; Line is after current line + CALL NC,SRCHLN ; Line is before current line + LD H,B ; Set up code string address + LD L,C + DEC HL ; Incremented after + RET C ; Line found +ULERR: LD E,UL ; ?UL Error + JP ERROR ; Output error message + +RETURN: RET NZ ; Return if not just RETURN + LD D,-1 ; Flag "GOSUB" search + CALL BAKSTK ; Look "GOSUB" block + LD SP,HL ; Kill all FORs in subroutine + CP ZGOSUB ; Test for "GOSUB" token + LD E,RG ; ?RG Error + JP NZ,ERROR ; Error if no "GOSUB" found + POP HL ; Get RETURN line number + LD (LINEAT),HL ; Save as current + INC HL ; Was it from direct statement? + LD A,H + OR L ; Return to line + JP NZ,RETLIN ; No - Return to line + LD A,(LSTBIN) ; Any INPUT in subroutine? + OR A ; If so buffer is corrupted + JP NZ,POPNOK ; Yes - Go to command mode +RETLIN: LD HL,RUNCNT ; Execution driver loop + EX (SP),HL ; Into stack - Code string out + .BYTE 3EH ; Skip "POP HL" +NXTDTA: POP HL ; Restore code string address + +DATA: .BYTE 01H,3AH ; ':' End of statement +REM: LD C,0 ; 00 End of statement + LD B,0 +NXTSTL: LD A,C ; Statement and byte + LD C,B + LD B,A ; Statement end byte +NXTSTT: LD A,(HL) ; Get byte + OR A ; End of line? + RET Z ; Yes - Exit + CP B ; End of statement? + RET Z ; Yes - Exit + INC HL ; Next byte + CP '"' ; Literal string? + JP Z,NXTSTL ; Yes - Look for another '"' + JP NXTSTT ; Keep looking + +LET: CALL GETVAR ; Get variable name + CALL CHKSYN ; Make sure "=" follows + .BYTE ZEQUAL ; "=" token + PUSH DE ; Save address of variable + LD A,(TYPE) ; Get data type + PUSH AF ; Save type + CALL EVAL ; Evaluate expression + POP AF ; Restore type + EX (SP),HL ; Save code - Get var addr + LD (BRKLIN),HL ; Save address of variable + RRA ; Adjust type + CALL CHKTYP ; Check types are the same + JP Z,LETNUM ; Numeric - Move value +LETSTR: PUSH HL ; Save address of string var + LD HL,(FPREG) ; Pointer to string entry + PUSH HL ; Save it on stack + INC HL ; Skip over length + INC HL + LD E,(HL) ; LSB of string address + INC HL + LD D,(HL) ; MSB of string address + LD HL,(BASTXT) ; Point to start of program + CALL CPDEHL ; Is string before program? + JP NC,CRESTR ; Yes - Create string entry + LD HL,(STRSPC) ; Point to string space + CALL CPDEHL ; Is string literal in program? + POP DE ; Restore address of string + JP NC,MVSTPT ; Yes - Set up pointer + LD HL,TMPSTR ; Temporary string pool + CALL CPDEHL ; Is string in temporary pool? + JP NC,MVSTPT ; No - Set up pointer + .BYTE 3EH ; Skip "POP DE" +CRESTR: POP DE ; Restore address of string + CALL BAKTMP ; Back to last tmp-str entry + EX DE,HL ; Address of string entry + CALL SAVSTR ; Save string in string area +MVSTPT: CALL BAKTMP ; Back to last tmp-str entry + POP HL ; Get string pointer + CALL DETHL4 ; Move string pointer to var + POP HL ; Restore code string address + RET + +LETNUM: PUSH HL ; Save address of variable + CALL FPTHL ; Move value to variable + POP DE ; Restore address of variable + POP HL ; Restore code string address + RET + +ON: CALL GETINT ; Get integer 0-255 + LD A,(HL) ; Get "GOTO" or "GOSUB" token + LD B,A ; Save in B + CP ZGOSUB ; "GOSUB" token? + JP Z,ONGO ; Yes - Find line number + CALL CHKSYN ; Make sure it's "GOTO" + .BYTE ZGOTO ; "GOTO" token + DEC HL ; Cancel increment +ONGO: LD C,E ; Integer of branch value +ONGOLP: DEC C ; Count branches + LD A,B ; Get "GOTO" or "GOSUB" token + JP Z,ONJMP ; Go to that line if right one + CALL GETLN ; Get line number to DE + CP ',' ; Another line number? + RET NZ ; No - Drop through + JP ONGOLP ; Yes - loop + +IF: CALL EVAL ; Evaluate expression + LD A,(HL) ; Get token + CP ZGOTO ; "GOTO" token? + JP Z,IFGO ; Yes - Get line + CALL CHKSYN ; Make sure it's "THEN" + .BYTE ZTHEN ; "THEN" token + DEC HL ; Cancel increment +IFGO: CALL TSTNUM ; Make sure it's numeric + CALL TSTSGN ; Test state of expression + JP Z,REM ; False - Drop through + CALL GETCHR ; Get next character + JP C,GOTO ; Number - GOTO that line + JP IFJMP ; Otherwise do statement + +MRPRNT: DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character +PRINT: JP Z,PRNTCRLF ; CRLF if just PRINT +PRNTLP: RET Z ; End of list - Exit + CP ZTAB ; "TAB(" token? + JP Z,DOTAB ; Yes - Do TAB routine + CP ZSPC ; "SPC(" token? + JP Z,DOTAB ; Yes - Do SPC routine + PUSH HL ; Save code string address + CP ',' ; Comma? + JP Z,DOCOM ; Yes - Move to next zone + CP 59 ;";" ; Semi-colon? + JP Z,NEXITM ; Do semi-colon routine + POP BC ; Code string address to BC + CALL EVAL ; Evaluate expression + PUSH HL ; Save code string address + LD A,(TYPE) ; Get variable type + OR A ; Is it a string variable? + JP NZ,PRNTST ; Yes - Output string contents + CALL NUMASC ; Convert number to text + CALL CRTST ; Create temporary string + LD (HL),' ' ; Followed by a space + LD HL,(FPREG) ; Get length of output + INC (HL) ; Plus 1 for the space + LD HL,(FPREG) ; < Not needed > + LD A,(LWIDTH) ; Get width of line + LD B,A ; To B + INC B ; Width 255 (No limit)? + JP Z,PRNTNB ; Yes - Output number string + INC B ; Adjust it + LD A,(CURPOS) ; Get cursor position + ADD A,(HL) ; Add length of string + DEC A ; Adjust it + CP B ; Will output fit on this line? + CALL NC,PRNTCRLF ; No - CRLF first +PRNTNB: CALL PRS1 ; Output string at (HL) + XOR A ; Skip CALL by setting 'z' flag +PRNTST: CALL NZ,PRS1 ; Output string at (HL) + POP HL ; Restore code string address + JP MRPRNT ; See if more to PRINT + +STTLIN: LD A,(CURPOS) ; Make sure on new line + OR A ; Already at start? + RET Z ; Yes - Do nothing + JP PRNTCRLF ; Start a new line + +ENDINP: LD (HL),0 ; Mark end of buffer + LD HL,BUFFER-1 ; Point to buffer +PRNTCRLF: LD A,CR ; Load a CR + CALL OUTC ; Output character + LD A,LF ; Load a LF + CALL OUTC ; Output character +DONULL: XOR A ; Set to position 0 + LD (CURPOS),A ; Store it + LD A,(NULLS) ; Get number of nulls +NULLP: DEC A ; Count them + RET Z ; Return if done + PUSH AF ; Save count + XOR A ; Load a null + CALL OUTC ; Output it + POP AF ; Restore count + JP NULLP ; Keep counting + +DOCOM: LD A,(COMMAN) ; Get comma width + LD B,A ; Save in B + LD A,(CURPOS) ; Get current position + CP B ; Within the limit? + CALL NC,PRNTCRLF ; No - output CRLF + JP NC,NEXITM ; Get next item +ZONELP: SUB 14 ; Next zone of 14 characters + JP NC,ZONELP ; Repeat if more zones + CPL ; Number of spaces to output + JP ASPCS ; Output them + +DOTAB: PUSH AF ; Save token + CALL FNDNUM ; Evaluate expression + CALL CHKSYN ; Make sure ")" follows + .BYTE ")" + DEC HL ; Back space on to ")" + POP AF ; Restore token + SUB ZSPC ; Was it "SPC(" ? + PUSH HL ; Save code string address + JP Z,DOSPC ; Yes - Do 'E' spaces + LD A,(CURPOS) ; Get current position +DOSPC: CPL ; Number of spaces to print to + ADD A,E ; Total number to print + JP NC,NEXITM ; TAB < Current POS(X) +ASPCS: INC A ; Output A spaces + LD B,A ; Save number to print + LD A,' ' ; Space +SPCLP: CALL OUTC ; Output character in A + DEC B ; Count them + JP NZ,SPCLP ; Repeat if more +NEXITM: POP HL ; Restore code string address + CALL GETCHR ; Get next character + JP PRNTLP ; More to print + +REDO: .BYTE "?Redo from start",CR,LF,0 + +BADINP: LD A,(READFG) ; READ or INPUT? + OR A + JP NZ,DATSNR ; READ - ?SN Error + POP BC ; Throw away code string addr + LD HL,REDO ; "Redo from start" message + CALL PRS ; Output string + JP DOAGN ; Do last INPUT again + +INPUT: CALL IDTEST ; Test for illegal direct + LD A,(HL) ; Get character after "INPUT" + CP '"' ; Is there a prompt string? + LD A,0 ; Clear A and leave flags + LD (CTLOFG),A ; Enable output + JP NZ,NOPMPT ; No prompt - get input + CALL QTSTR ; Get string terminated by '"' + CALL CHKSYN ; Check for ';' after prompt + .BYTE ';' + PUSH HL ; Save code string address + CALL PRS1 ; Output prompt string + .BYTE 3EH ; Skip "PUSH HL" +NOPMPT: PUSH HL ; Save code string address + CALL PROMPT ; Get input with "? " prompt + POP BC ; Restore code string address + JP C,INPBRK ; Break pressed - Exit + INC HL ; Next byte + LD A,(HL) ; Get it + OR A ; End of line? + DEC HL ; Back again + PUSH BC ; Re-save code string address + JP Z,NXTDTA ; Yes - Find next DATA stmt + LD (HL),',' ; Store comma as separator + JP NXTITM ; Get next item + +READ: PUSH HL ; Save code string address + LD HL,(NXTDAT) ; Next DATA statement + .BYTE 0F6H ; Flag "READ" +NXTITM: XOR A ; Flag "INPUT" + LD (READFG),A ; Save "READ"/"INPUT" flag + EX (SP),HL ; Get code str' , Save pointer + JP GTVLUS ; Get values + +NEDMOR: CALL CHKSYN ; Check for comma between items + .BYTE ',' +GTVLUS: CALL GETVAR ; Get variable name + EX (SP),HL ; Save code str" , Get pointer + PUSH DE ; Save variable address + LD A,(HL) ; Get next "INPUT"/"DATA" byte + CP ',' ; Comma? + JP Z,ANTVLU ; Yes - Get another value + LD A,(READFG) ; Is it READ? + OR A + JP NZ,FDTLP ; Yes - Find next DATA stmt + LD A,'?' ; More INPUT needed + CALL OUTC ; Output character + CALL PROMPT ; Get INPUT with prompt + POP DE ; Variable address + POP BC ; Code string address + JP C,INPBRK ; Break pressed + INC HL ; Point to next DATA byte + LD A,(HL) ; Get byte + OR A ; Is it zero (No input) ? + DEC HL ; Back space INPUT pointer + PUSH BC ; Save code string address + JP Z,NXTDTA ; Find end of buffer + PUSH DE ; Save variable address +ANTVLU: LD A,(TYPE) ; Check data type + OR A ; Is it numeric? + JP Z,INPBIN ; Yes - Convert to binary + CALL GETCHR ; Get next character + LD D,A ; Save input character + LD B,A ; Again + CP '"' ; Start of literal sting? + JP Z,STRENT ; Yes - Create string entry + LD A,(READFG) ; "READ" or "INPUT" ? + OR A + LD D,A ; Save 00 if "INPUT" + JP Z,ITMSEP ; "INPUT" - End with 00 + LD D,':' ; "DATA" - End with 00 or ':' +ITMSEP: LD B,',' ; Item separator + DEC HL ; Back space for DTSTR +STRENT: CALL DTSTR ; Get string terminated by D + EX DE,HL ; String address to DE + LD HL,LTSTND ; Where to go after LETSTR + EX (SP),HL ; Save HL , get input pointer + PUSH DE ; Save address of string + JP LETSTR ; Assign string to variable + +INPBIN: CALL GETCHR ; Get next character + CALL ASCTFP ; Convert ASCII to FP number + EX (SP),HL ; Save input ptr, Get var addr + CALL FPTHL ; Move FPREG to variable + POP HL ; Restore input pointer +LTSTND: DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP Z,MORDT ; End of line - More needed? + CP ',' ; Another value? + JP NZ,BADINP ; No - Bad input +MORDT: EX (SP),HL ; Get code string address + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP NZ,NEDMOR ; More needed - Get it + POP DE ; Restore DATA pointer + LD A,(READFG) ; "READ" or "INPUT" ? + OR A + EX DE,HL ; DATA pointer to HL + JP NZ,UPDATA ; Update DATA pointer if "READ" + PUSH DE ; Save code string address + OR (HL) ; More input given? + LD HL,EXTIG ; "?Extra ignored" message + CALL NZ,PRS ; Output string if extra given + POP HL ; Restore code string address + RET + +EXTIG: .BYTE "?Extra ignored",CR,LF,0 + +FDTLP: CALL DATA ; Get next statement + OR A ; End of line? + JP NZ,FANDT ; No - See if DATA statement + INC HL + LD A,(HL) ; End of program? + INC HL + OR (HL) ; 00 00 Ends program + LD E,OD ; ?OD Error + JP Z,ERROR ; Yes - Out of DATA + INC HL + LD E,(HL) ; LSB of line number + INC HL + LD D,(HL) ; MSB of line number + EX DE,HL + LD (DATLIN),HL ; Set line of current DATA item + EX DE,HL +FANDT: CALL GETCHR ; Get next character + CP ZDATA ; "DATA" token + JP NZ,FDTLP ; No "DATA" - Keep looking + JP ANTVLU ; Found - Convert input + +NEXT: LD DE,0 ; In case no index given +NEXT1: CALL NZ,GETVAR ; Get index address + LD (BRKLIN),HL ; Save code string address + CALL BAKSTK ; Look for "FOR" block + JP NZ,NFERR ; No "FOR" - ?NF Error + LD SP,HL ; Clear nested loops + PUSH DE ; Save index address + LD A,(HL) ; Get sign of STEP + INC HL + PUSH AF ; Save sign of STEP + PUSH DE ; Save index address + CALL PHLTFP ; Move index value to FPREG + EX (SP),HL ; Save address of TO value + PUSH HL ; Save address of index + CALL ADDPHL ; Add STEP to index value + POP HL ; Restore address of index + CALL FPTHL ; Move value to index variable + POP HL ; Restore address of TO value + CALL LOADFP ; Move TO value to BCDE + PUSH HL ; Save address of line of FOR + CALL CMPNUM ; Compare index with TO value + POP HL ; Restore address of line num + POP BC ; Address of sign of STEP + SUB B ; Compare with expected sign + CALL LOADFP ; BC = Loop stmt,DE = Line num + JP Z,KILFOR ; Loop finished - Terminate it + EX DE,HL ; Loop statement line number + LD (LINEAT),HL ; Set loop line number + LD L,C ; Set code string to loop + LD H,B + JP PUTFID ; Put back "FOR" and continue + +KILFOR: LD SP,HL ; Remove "FOR" block + LD HL,(BRKLIN) ; Code string after "NEXT" + LD A,(HL) ; Get next byte in code string + CP ',' ; More NEXTs ? + JP NZ,RUNCNT ; No - Do next statement + CALL GETCHR ; Position to index name + CALL NEXT1 ; Re-enter NEXT routine +; < will not RETurn to here , Exit to RUNCNT or Loop > + +GETNUM: CALL EVAL ; Get a numeric expression +TSTNUM: .BYTE 0F6H ; Clear carry (numeric) +TSTSTR: SCF ; Set carry (string) +CHKTYP: LD A,(TYPE) ; Check types match + ADC A,A ; Expected + actual + OR A ; Clear carry , set parity + RET PE ; Even parity - Types match + JP TMERR ; Different types - Error + +OPNPAR: CALL CHKSYN ; Make sure "(" follows + .BYTE "(" +EVAL: DEC HL ; Evaluate expression & save + LD D,0 ; Precedence value +EVAL1: PUSH DE ; Save precedence + LD C,1 + CALL CHKSTK ; Check for 1 level of stack + CALL OPRND ; Get next expression value +EVAL2: LD (NXTOPR),HL ; Save address of next operator +EVAL3: LD HL,(NXTOPR) ; Restore address of next opr + POP BC ; Precedence value and operator + LD A,B ; Get precedence value + CP 78H ; "AND" or "OR" ? + CALL NC,TSTNUM ; No - Make sure it's a number + LD A,(HL) ; Get next operator / function + LD D,0 ; Clear Last relation +RLTLP: SUB ZGTR ; ">" Token + JP C,FOPRND ; + - * / ^ AND OR - Test it + CP ZLTH+1-ZGTR ; < = > + JP NC,FOPRND ; Function - Call it + CP ZEQUAL-ZGTR ; "=" + RLA ; <- Test for legal + XOR D ; <- combinations of < = > + CP D ; <- by combining last token + LD D,A ; <- with current one + JP C,SNERR ; Error if "<<' '==" or ">>" + LD (CUROPR),HL ; Save address of current token + CALL GETCHR ; Get next character + JP RLTLP ; Treat the two as one + +FOPRND: LD A,D ; < = > found ? + OR A + JP NZ,TSTRED ; Yes - Test for reduction + LD A,(HL) ; Get operator token + LD (CUROPR),HL ; Save operator address + SUB ZPLUS ; Operator or function? + RET C ; Neither - Exit + CP ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ? + RET NC ; No - Exit + LD E,A ; Coded operator + LD A,(TYPE) ; Get data type + DEC A ; FF = numeric , 00 = string + OR E ; Combine with coded operator + LD A,E ; Get coded operator + JP Z,CONCAT ; String concatenation + RLCA ; Times 2 + ADD A,E ; Times 3 + LD E,A ; To DE (D is 0) + LD HL,PRITAB ; Precedence table + ADD HL,DE ; To the operator concerned + LD A,B ; Last operator precedence + LD D,(HL) ; Get evaluation precedence + CP D ; Compare with eval precedence + RET NC ; Exit if higher precedence + INC HL ; Point to routine address + CALL TSTNUM ; Make sure it's a number + +STKTHS: PUSH BC ; Save last precedence & token + LD BC,EVAL3 ; Where to go on prec' break + PUSH BC ; Save on stack for return + LD B,E ; Save operator + LD C,D ; Save precedence + CALL STAKFP ; Move value to stack + LD E,B ; Restore operator + LD D,C ; Restore precedence + LD C,(HL) ; Get LSB of routine address + INC HL + LD B,(HL) ; Get MSB of routine address + INC HL + PUSH BC ; Save routine address + LD HL,(CUROPR) ; Address of current operator + JP EVAL1 ; Loop until prec' break + +OPRND: XOR A ; Get operand routine + LD (TYPE),A ; Set numeric expected + CALL GETCHR ; Get next character + LD E,MO ; ?MO Error + JP Z,ERROR ; No operand - Error + JP C,ASCTFP ; Number - Get value + CALL CHKLTR ; See if a letter + JP NC,CONVAR ; Letter - Find variable + CP '&' ; &H = HEX, &B = BINARY + JR NZ, NOTAMP + CALL GETCHR ; Get next character + CP 'H' ; Hex number indicated? [function added] + JP Z,HEXTFP ; Convert Hex to FPREG + CP 'B' ; Binary number indicated? [function added] + JP Z,BINTFP ; Convert Bin to FPREG + LD E,SN ; If neither then a ?SN Error + JP Z,ERROR ; +NOTAMP: CP ZPLUS ; '+' Token ? + JP Z,OPRND ; Yes - Look for operand + CP '.' ; '.' ? + JP Z,ASCTFP ; Yes - Create FP number + CP ZMINUS ; '-' Token ? + JP Z,MINUS ; Yes - Do minus + CP '"' ; Literal string ? + JP Z,QTSTR ; Get string terminated by '"' + CP ZNOT ; "NOT" Token ? + JP Z,EVNOT ; Yes - Eval NOT expression + CP ZFN ; "FN" Token ? + JP Z,DOFN ; Yes - Do FN routine + SUB ZSGN ; Is it a function? + JP NC,FNOFST ; Yes - Evaluate function +EVLPAR: CALL OPNPAR ; Evaluate expression in "()" + CALL CHKSYN ; Make sure ")" follows + .BYTE ")" + RET + +MINUS: LD D,7DH ; '-' precedence + CALL EVAL1 ; Evaluate until prec' break + LD HL,(NXTOPR) ; Get next operator address + PUSH HL ; Save next operator address + CALL INVSGN ; Negate value +RETNUM: CALL TSTNUM ; Make sure it's a number + POP HL ; Restore next operator address + RET + +CONVAR: CALL GETVAR ; Get variable address to DE +FRMEVL: PUSH HL ; Save code string address + EX DE,HL ; Variable address to HL + LD (FPREG),HL ; Save address of variable + LD A,(TYPE) ; Get type + OR A ; Numeric? + CALL Z,PHLTFP ; Yes - Move contents to FPREG + POP HL ; Restore code string address + RET + +FNOFST: LD B,0 ; Get address of function + RLCA ; Double function offset + LD C,A ; BC = Offset in function table + PUSH BC ; Save adjusted token value + CALL GETCHR ; Get next character + LD A,C ; Get adjusted token value + CP 2*(ZLEFT-ZSGN)-1; Adj' LEFT$,RIGHT$ or MID$ ? + JP C,FNVAL ; No - Do function + CALL OPNPAR ; Evaluate expression (X,... + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' + CALL TSTSTR ; Make sure it's a string + EX DE,HL ; Save code string address + LD HL,(FPREG) ; Get address of string + EX (SP),HL ; Save address of string + PUSH HL ; Save adjusted token value + EX DE,HL ; Restore code string address + CALL GETINT ; Get integer 0-255 + EX DE,HL ; Save code string address + EX (SP),HL ; Save integer,HL = adj' token + JP GOFUNC ; Jump to string function + +FNVAL: CALL EVLPAR ; Evaluate expression + EX (SP),HL ; HL = Adjusted token value + LD DE,RETNUM ; Return number from function + PUSH DE ; Save on stack +GOFUNC: LD BC,FNCTAB ; Function routine addresses + ADD HL,BC ; Point to right address + LD C,(HL) ; Get LSB of address + INC HL ; + LD H,(HL) ; Get MSB of address + LD L,C ; Address to HL + JP (HL) ; Jump to function + +SGNEXP: DEC D ; Dee to flag negative exponent + CP ZMINUS ; '-' token ? + RET Z ; Yes - Return + CP '-' ; '-' ASCII ? + RET Z ; Yes - Return + INC D ; Inc to flag positive exponent + CP '+' ; '+' ASCII ? + RET Z ; Yes - Return + CP ZPLUS ; '+' token ? + RET Z ; Yes - Return + DEC HL ; DEC 'cos GETCHR INCs + RET ; Return "NZ" + +POR: .BYTE 0F6H ; Flag "OR" +PAND: XOR A ; Flag "AND" + PUSH AF ; Save "AND" / "OR" flag + CALL TSTNUM ; Make sure it's a number + CALL DEINT ; Get integer -32768 to 32767 + POP AF ; Restore "AND" / "OR" flag + EX DE,HL ; <- Get last + POP BC ; <- value + EX (SP),HL ; <- from + EX DE,HL ; <- stack + CALL FPBCDE ; Move last value to FPREG + PUSH AF ; Save "AND" / "OR" flag + CALL DEINT ; Get integer -32768 to 32767 + POP AF ; Restore "AND" / "OR" flag + POP BC ; Get value + LD A,C ; Get LSB + LD HL,ACPASS ; Address of save AC as current + JP NZ,POR1 ; Jump if OR + AND E ; "AND" LSBs + LD C,A ; Save LSB + LD A,B ; Get MBS + AND D ; "AND" MSBs + JP (HL) ; Save AC as current (ACPASS) + +POR1: OR E ; "OR" LSBs + LD C,A ; Save LSB + LD A,B ; Get MSB + OR D ; "OR" MSBs + JP (HL) ; Save AC as current (ACPASS) + +TSTRED: LD HL,CMPLOG ; Logical compare routine + LD A,(TYPE) ; Get data type + RRA ; Carry set = string + LD A,D ; Get last precedence value + RLA ; Times 2 plus carry + LD E,A ; To E + LD D,64H ; Relational precedence + LD A,B ; Get current precedence + CP D ; Compare with last + RET NC ; Eval if last was rel' or log' + JP STKTHS ; Stack this one and get next + +CMPLOG: .WORD CMPLG1 ; Compare two values / strings +CMPLG1: LD A,C ; Get data type + OR A + RRA + POP BC ; Get last expression to BCDE + POP DE + PUSH AF ; Save status + CALL CHKTYP ; Check that types match + LD HL,CMPRES ; Result to comparison + PUSH HL ; Save for RETurn + JP Z,CMPNUM ; Compare values if numeric + XOR A ; Compare two strings + LD (TYPE),A ; Set type to numeric + PUSH DE ; Save string name + CALL GSTRCU ; Get current string + LD A,(HL) ; Get length of string + INC HL + INC HL + LD C,(HL) ; Get LSB of address + INC HL + LD B,(HL) ; Get MSB of address + POP DE ; Restore string name + PUSH BC ; Save address of string + PUSH AF ; Save length of string + CALL GSTRDE ; Get second string + CALL LOADFP ; Get address of second string + POP AF ; Restore length of string 1 + LD D,A ; Length to D + POP HL ; Restore address of string 1 +CMPSTR: LD A,E ; Bytes of string 2 to do + OR D ; Bytes of string 1 to do + RET Z ; Exit if all bytes compared + LD A,D ; Get bytes of string 1 to do + SUB 1 + RET C ; Exit if end of string 1 + XOR A + CP E ; Bytes of string 2 to do + INC A + RET NC ; Exit if end of string 2 + DEC D ; Count bytes in string 1 + DEC E ; Count bytes in string 2 + LD A,(BC) ; Byte in string 2 + CP (HL) ; Compare to byte in string 1 + INC HL ; Move up string 1 + INC BC ; Move up string 2 + JP Z,CMPSTR ; Same - Try next bytes + CCF ; Flag difference (">" or "<") + JP FLGDIF ; "<" gives -1 , ">" gives +1 + +CMPRES: INC A ; Increment current value + ADC A,A ; Double plus carry + POP BC ; Get other value + AND B ; Combine them + ADD A,-1 ; Carry set if different + SBC A,A ; 00 - Equal , FF - Different + JP FLGREL ; Set current value & continue + +EVNOT: LD D,5AH ; Precedence value for "NOT" + CALL EVAL1 ; Eval until precedence break + CALL TSTNUM ; Make sure it's a number + CALL DEINT ; Get integer -32768 - 32767 + LD A,E ; Get LSB + CPL ; Invert LSB + LD C,A ; Save "NOT" of LSB + LD A,D ; Get MSB + CPL ; Invert MSB + CALL ACPASS ; Save AC as current + POP BC ; Clean up stack + JP EVAL3 ; Continue evaluation + +DIMRET: DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + RET Z ; End of DIM statement + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' +DIM: LD BC,DIMRET ; Return to "DIMRET" + PUSH BC ; Save on stack + .BYTE 0F6H ; Flag "Create" variable +GETVAR: XOR A ; Find variable address,to DE + LD (LCRFLG),A ; Set locate / create flag + LD B,(HL) ; Get First byte of name +GTFNAM: CALL CHKLTR ; See if a letter + JP C,SNERR ; ?SN Error if not a letter + XOR A + LD C,A ; Clear second byte of name + LD (TYPE),A ; Set type to numeric + CALL GETCHR ; Get next character + JP C,SVNAM2 ; Numeric - Save in name + CALL CHKLTR ; See if a letter + JP C,CHARTY ; Not a letter - Check type +SVNAM2: LD C,A ; Save second byte of name +ENDNAM: CALL GETCHR ; Get next character + JP C,ENDNAM ; Numeric - Get another + CALL CHKLTR ; See if a letter + JP NC,ENDNAM ; Letter - Get another +CHARTY: SUB '$' ; String variable? + JP NZ,NOTSTR ; No - Numeric variable + INC A ; A = 1 (string type) + LD (TYPE),A ; Set type to string + RRCA ; A = 80H , Flag for string + ADD A,C ; 2nd byte of name has bit 7 on + LD C,A ; Resave second byte on name + CALL GETCHR ; Get next character +NOTSTR: LD A,(FORFLG) ; Array name needed ? + DEC A + JP Z,ARLDSV ; Yes - Get array name + JP P,NSCFOR ; No array with "FOR" or "FN" + LD A,(HL) ; Get byte again + SUB '(' ; Subscripted variable? + JP Z,SBSCPT ; Yes - Sort out subscript + +NSCFOR: XOR A ; Simple variable + LD (FORFLG),A ; Clear "FOR" flag + PUSH HL ; Save code string address + LD D,B ; DE = Variable name to find + LD E,C + LD HL,(FNRGNM) ; FN argument name + CALL CPDEHL ; Is it the FN argument? + LD DE,FNARG ; Point to argument value + JP Z,POPHRT ; Yes - Return FN argument value + LD HL,(VAREND) ; End of variables + EX DE,HL ; Address of end of search + LD HL,(PROGND) ; Start of variables address +FNDVAR: CALL CPDEHL ; End of variable list table? + JP Z,CFEVAL ; Yes - Called from EVAL? + LD A,C ; Get second byte of name + SUB (HL) ; Compare with name in list + INC HL ; Move on to first byte + JP NZ,FNTHR ; Different - Find another + LD A,B ; Get first byte of name + SUB (HL) ; Compare with name in list +FNTHR: INC HL ; Move on to LSB of value + JP Z,RETADR ; Found - Return address + INC HL ; <- Skip + INC HL ; <- over + INC HL ; <- F.P. + INC HL ; <- value + JP FNDVAR ; Keep looking + +CFEVAL: POP HL ; Restore code string address + EX (SP),HL ; Get return address + PUSH DE ; Save address of variable + LD DE,FRMEVL ; Return address in EVAL + CALL CPDEHL ; Called from EVAL ? + POP DE ; Restore address of variable + JP Z,RETNUL ; Yes - Return null variable + EX (SP),HL ; Put back return + PUSH HL ; Save code string address + PUSH BC ; Save variable name + LD BC,6 ; 2 byte name plus 4 byte data + LD HL,(ARREND) ; End of arrays + PUSH HL ; Save end of arrays + ADD HL,BC ; Move up 6 bytes + POP BC ; Source address in BC + PUSH HL ; Save new end address + CALL MOVUP ; Move arrays up + POP HL ; Restore new end address + LD (ARREND),HL ; Set new end address + LD H,B ; End of variables to HL + LD L,C + LD (VAREND),HL ; Set new end address + +ZEROLP: DEC HL ; Back through to zero variable + LD (HL),0 ; Zero byte in variable + CALL CPDEHL ; Done them all? + JP NZ,ZEROLP ; No - Keep on going + POP DE ; Get variable name + LD (HL),E ; Store second character + INC HL + LD (HL),D ; Store first character + INC HL +RETADR: EX DE,HL ; Address of variable in DE + POP HL ; Restore code string address + RET + +RETNUL: LD (FPEXP),A ; Set result to zero + LD HL,ZERBYT ; Also set a null string + LD (FPREG),HL ; Save for EVAL + POP HL ; Restore code string address + RET + +SBSCPT: PUSH HL ; Save code string address + LD HL,(LCRFLG) ; Locate/Create and Type + EX (SP),HL ; Save and get code string + LD D,A ; Zero number of dimensions +SCPTLP: PUSH DE ; Save number of dimensions + PUSH BC ; Save array name + CALL FPSINT ; Get subscript (0-32767) + POP BC ; Restore array name + POP AF ; Get number of dimensions + EX DE,HL + EX (SP),HL ; Save subscript value + PUSH HL ; Save LCRFLG and TYPE + EX DE,HL + INC A ; Count dimensions + LD D,A ; Save in D + LD A,(HL) ; Get next byte in code string + CP ',' ; Comma (more to come)? + JP Z,SCPTLP ; Yes - More subscripts + CALL CHKSYN ; Make sure ")" follows + .BYTE ")" + LD (NXTOPR),HL ; Save code string address + POP HL ; Get LCRFLG and TYPE + LD (LCRFLG),HL ; Restore Locate/create & type + LD E,0 ; Flag not CSAVE* or CLOAD* + PUSH DE ; Save number of dimensions (D) + .BYTE 11H ; Skip "PUSH HL" and "PUSH AF' + +ARLDSV: PUSH HL ; Save code string address + PUSH AF ; A = 00 , Flags set = Z,N + LD HL,(VAREND) ; Start of arrays + .BYTE 3EH ; Skip "ADD HL,DE" +FNDARY: ADD HL,DE ; Move to next array start + EX DE,HL + LD HL,(ARREND) ; End of arrays + EX DE,HL ; Current array pointer + CALL CPDEHL ; End of arrays found? + JP Z,CREARY ; Yes - Create array + LD A,(HL) ; Get second byte of name + CP C ; Compare with name given + INC HL ; Move on + JP NZ,NXTARY ; Different - Find next array + LD A,(HL) ; Get first byte of name + CP B ; Compare with name given +NXTARY: INC HL ; Move on + LD E,(HL) ; Get LSB of next array address + INC HL + LD D,(HL) ; Get MSB of next array address + INC HL + JP NZ,FNDARY ; Not found - Keep looking + LD A,(LCRFLG) ; Found Locate or Create it? + OR A + JP NZ,DDERR ; Create - ?DD Error + POP AF ; Locate - Get number of dim'ns + LD B,H ; BC Points to array dim'ns + LD C,L + JP Z,POPHRT ; Jump if array load/save + SUB (HL) ; Same number of dimensions? + JP Z,FINDEL ; Yes - Find element +BSERR: LD E,BS ; ?BS Error + JP ERROR ; Output error + +CREARY: LD DE,4 ; 4 Bytes per entry + POP AF ; Array to save or 0 dim'ns? + JP Z,FCERR ; Yes - ?FC Error + LD (HL),C ; Save second byte of name + INC HL + LD (HL),B ; Save first byte of name + INC HL + LD C,A ; Number of dimensions to C + CALL CHKSTK ; Check if enough memory + INC HL ; Point to number of dimensions + INC HL + LD (CUROPR),HL ; Save address of pointer + LD (HL),C ; Set number of dimensions + INC HL + LD A,(LCRFLG) ; Locate of Create? + RLA ; Carry set = Create + LD A,C ; Get number of dimensions +CRARLP: LD BC,10+1 ; Default dimension size 10 + JP NC,DEFSIZ ; Locate - Set default size + POP BC ; Get specified dimension size + INC BC ; Include zero element +DEFSIZ: LD (HL),C ; Save LSB of dimension size + INC HL + LD (HL),B ; Save MSB of dimension size + INC HL + PUSH AF ; Save num' of dim'ns an status + PUSH HL ; Save address of dim'n size + CALL MLDEBC ; Multiply DE by BC to find + EX DE,HL ; amount of mem needed (to DE) + POP HL ; Restore address of dimension + POP AF ; Restore number of dimensions + DEC A ; Count them + JP NZ,CRARLP ; Do next dimension if more + PUSH AF ; Save locate/create flag + LD B,D ; MSB of memory needed + LD C,E ; LSB of memory needed + EX DE,HL + ADD HL,DE ; Add bytes to array start + JP C,OMERR ; Too big - Error + CALL ENFMEM ; See if enough memory + LD (ARREND),HL ; Save new end of array + +ZERARY: DEC HL ; Back through array data + LD (HL),0 ; Set array element to zero + CALL CPDEHL ; All elements zeroed? + JP NZ,ZERARY ; No - Keep on going + INC BC ; Number of bytes + 1 + LD D,A ; A=0 + LD HL,(CUROPR) ; Get address of array + LD E,(HL) ; Number of dimensions + EX DE,HL ; To HL + ADD HL,HL ; Two bytes per dimension size + ADD HL,BC ; Add number of bytes + EX DE,HL ; Bytes needed to DE + DEC HL + DEC HL + LD (HL),E ; Save LSB of bytes needed + INC HL + LD (HL),D ; Save MSB of bytes needed + INC HL + POP AF ; Locate / Create? + JP C,ENDDIM ; A is 0 , End if create +FINDEL: LD B,A ; Find array element + LD C,A + LD A,(HL) ; Number of dimensions + INC HL + .BYTE 16H ; Skip "POP HL" +FNDELP: POP HL ; Address of next dim' size + LD E,(HL) ; Get LSB of dim'n size + INC HL + LD D,(HL) ; Get MSB of dim'n size + INC HL + EX (SP),HL ; Save address - Get index + PUSH AF ; Save number of dim'ns + CALL CPDEHL ; Dimension too large? + JP NC,BSERR ; Yes - ?BS Error + PUSH HL ; Save index + CALL MLDEBC ; Multiply previous by size + POP DE ; Index supplied to DE + ADD HL,DE ; Add index to pointer + POP AF ; Number of dimensions + DEC A ; Count them + LD B,H ; MSB of pointer + LD C,L ; LSB of pointer + JP NZ,FNDELP ; More - Keep going + ADD HL,HL ; 4 Bytes per element + ADD HL,HL + POP BC ; Start of array + ADD HL,BC ; Point to element + EX DE,HL ; Address of element to DE +ENDDIM: LD HL,(NXTOPR) ; Got code string address + RET + +FRE: LD HL,(ARREND) ; Start of free memory + EX DE,HL ; To DE + LD HL,0 ; End of free memory + ADD HL,SP ; Current stack value + LD A,(TYPE) ; Dummy argument type + OR A + JP Z,FRENUM ; Numeric - Free variable space + CALL GSTRCU ; Current string to pool + CALL GARBGE ; Garbage collection + LD HL,(STRSPC) ; Bottom of string space in use + EX DE,HL ; To DE + LD HL,(STRBOT) ; Bottom of string space +FRENUM: LD A,L ; Get LSB of end + SUB E ; Subtract LSB of beginning + LD C,A ; Save difference if C + LD A,H ; Get MSB of end + SBC A,D ; Subtract MSB of beginning +ACPASS: LD B,C ; Return integer AC +ABPASS: LD D,B ; Return integer AB + LD E,0 + LD HL,TYPE ; Point to type + LD (HL),E ; Set type to numeric + LD B,80H+16 ; 16 bit integer + JP RETINT ; Return the integr + +POS: LD A,(CURPOS) ; Get cursor position +PASSA: LD B,A ; Put A into AB + XOR A ; Zero A + JP ABPASS ; Return integer AB + +DEF: CALL CHEKFN ; Get "FN" and name + CALL IDTEST ; Test for illegal direct + LD BC,DATA ; To get next statement + PUSH BC ; Save address for RETurn + PUSH DE ; Save address of function ptr + CALL CHKSYN ; Make sure "(" follows + .BYTE "(" + CALL GETVAR ; Get argument variable name + PUSH HL ; Save code string address + EX DE,HL ; Argument address to HL + DEC HL + LD D,(HL) ; Get first byte of arg name + DEC HL + LD E,(HL) ; Get second byte of arg name + POP HL ; Restore code string address + CALL TSTNUM ; Make sure numeric argument + CALL CHKSYN ; Make sure ")" follows + .BYTE ")" + CALL CHKSYN ; Make sure "=" follows + .BYTE ZEQUAL ; "=" token + LD B,H ; Code string address to BC + LD C,L + EX (SP),HL ; Save code str , Get FN ptr + LD (HL),C ; Save LSB of FN code string + INC HL + LD (HL),B ; Save MSB of FN code string + JP SVSTAD ; Save address and do function + +DOFN: CALL CHEKFN ; Make sure FN follows + PUSH DE ; Save function pointer address + CALL EVLPAR ; Evaluate expression in "()" + CALL TSTNUM ; Make sure numeric result + EX (SP),HL ; Save code str , Get FN ptr + LD E,(HL) ; Get LSB of FN code string + INC HL + LD D,(HL) ; Get MSB of FN code string + INC HL + LD A,D ; And function DEFined? + OR E + JP Z,UFERR ; No - ?UF Error + LD A,(HL) ; Get LSB of argument address + INC HL + LD H,(HL) ; Get MSB of argument address + LD L,A ; HL = Arg variable address + PUSH HL ; Save it + LD HL,(FNRGNM) ; Get old argument name + EX (SP),HL ; ; Save old , Get new + LD (FNRGNM),HL ; Set new argument name + LD HL,(FNARG+2) ; Get LSB,NLSB of old arg value + PUSH HL ; Save it + LD HL,(FNARG) ; Get MSB,EXP of old arg value + PUSH HL ; Save it + LD HL,FNARG ; HL = Value of argument + PUSH DE ; Save FN code string address + CALL FPTHL ; Move FPREG to argument + POP HL ; Get FN code string address + CALL GETNUM ; Get value from function + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP NZ,SNERR ; Bad character in FN - Error + POP HL ; Get MSB,EXP of old arg + LD (FNARG),HL ; Restore it + POP HL ; Get LSB,NLSB of old arg + LD (FNARG+2),HL ; Restore it + POP HL ; Get name of old arg + LD (FNRGNM),HL ; Restore it + POP HL ; Restore code string address + RET + +IDTEST: PUSH HL ; Save code string address + LD HL,(LINEAT) ; Get current line number + INC HL ; -1 means direct statement + LD A,H + OR L + POP HL ; Restore code string address + RET NZ ; Return if in program + LD E,ID ; ?ID Error + JP ERROR + +CHEKFN: CALL CHKSYN ; Make sure FN follows + .BYTE ZFN ; "FN" token + LD A,80H + LD (FORFLG),A ; Flag FN name to find + OR (HL) ; FN name has bit 7 set + LD B,A ; in first byte of name + CALL GTFNAM ; Get FN name + JP TSTNUM ; Make sure numeric function + +STR: CALL TSTNUM ; Make sure it's a number + CALL NUMASC ; Turn number into text +STR1: CALL CRTST ; Create string entry for it + CALL GSTRCU ; Current string to pool + LD BC,TOPOOL ; Save in string pool + PUSH BC ; Save address on stack + +SAVSTR: LD A,(HL) ; Get string length + INC HL + INC HL + PUSH HL ; Save pointer to string + CALL TESTR ; See if enough string space + POP HL ; Restore pointer to string + LD C,(HL) ; Get LSB of address + INC HL + LD B,(HL) ; Get MSB of address + CALL CRTMST ; Create string entry + PUSH HL ; Save pointer to MSB of addr + LD L,A ; Length of string + CALL TOSTRA ; Move to string area + POP DE ; Restore pointer to MSB + RET + +MKTMST: CALL TESTR ; See if enough string space +CRTMST: LD HL,TMPSTR ; Temporary string + PUSH HL ; Save it + LD (HL),A ; Save length of string + INC HL +SVSTAD: INC HL + LD (HL),E ; Save LSB of address + INC HL + LD (HL),D ; Save MSB of address + POP HL ; Restore pointer + RET + +CRTST: DEC HL ; DEC - INCed after +QTSTR: LD B,'"' ; Terminating quote + LD D,B ; Quote to D +DTSTR: PUSH HL ; Save start + LD C,-1 ; Set counter to -1 +QTSTLP: INC HL ; Move on + LD A,(HL) ; Get byte + INC C ; Count bytes + OR A ; End of line? + JP Z,CRTSTE ; Yes - Create string entry + CP D ; Terminator D found? + JP Z,CRTSTE ; Yes - Create string entry + CP B ; Terminator B found? + JP NZ,QTSTLP ; No - Keep looking +CRTSTE: CP '"' ; End with '"'? + CALL Z,GETCHR ; Yes - Get next character + EX (SP),HL ; Starting quote + INC HL ; First byte of string + EX DE,HL ; To DE + LD A,C ; Get length + CALL CRTMST ; Create string entry +TSTOPL: LD DE,TMPSTR ; Temporary string + LD HL,(TMSTPT) ; Temporary string pool pointer + LD (FPREG),HL ; Save address of string ptr + LD A,1 + LD (TYPE),A ; Set type to string + CALL DETHL4 ; Move string to pool + CALL CPDEHL ; Out of string pool? + LD (TMSTPT),HL ; Save new pointer + POP HL ; Restore code string address + LD A,(HL) ; Get next code byte + RET NZ ; Return if pool OK + LD E,ST ; ?ST Error + JP ERROR ; String pool overflow + +PRNUMS: INC HL ; Skip leading space +PRS: CALL CRTST ; Create string entry for it +PRS1: CALL GSTRCU ; Current string to pool + CALL LOADFP ; Move string block to BCDE + INC E ; Length + 1 +PRSLP: DEC E ; Count characters + RET Z ; End of string + LD A,(BC) ; Get byte to output + CALL OUTC ; Output character in A + CP CR ; Return? + CALL Z,DONULL ; Yes - Do nulls + INC BC ; Next byte in string + JP PRSLP ; More characters to output + +TESTR: OR A ; Test if enough room + .BYTE 0EH ; No garbage collection done +GRBDON: POP AF ; Garbage collection done + PUSH AF ; Save status + LD HL,(STRSPC) ; Bottom of string space in use + EX DE,HL ; To DE + LD HL,(STRBOT) ; Bottom of string area + CPL ; Negate length (Top down) + LD C,A ; -Length to BC + LD B,-1 ; BC = -ve length of string + ADD HL,BC ; Add to bottom of space in use + INC HL ; Plus one for 2's complement + CALL CPDEHL ; Below string RAM area? + JP C,TESTOS ; Tidy up if not done else err + LD (STRBOT),HL ; Save new bottom of area + INC HL ; Point to first byte of string + EX DE,HL ; Address to DE +POPAF: POP AF ; Throw away status push + RET + +TESTOS: POP AF ; Garbage collect been done? + LD E,OS ; ?OS Error + JP Z,ERROR ; Yes - Not enough string apace + CP A ; Flag garbage collect done + PUSH AF ; Save status + LD BC,GRBDON ; Garbage collection done + PUSH BC ; Save for RETurn +GARBGE: LD HL,(LSTRAM) ; Get end of RAM pointer +GARBLP: LD (STRBOT),HL ; Reset string pointer + LD HL,0 + PUSH HL ; Flag no string found + LD HL,(STRSPC) ; Get bottom of string space + PUSH HL ; Save bottom of string space + LD HL,TMSTPL ; Temporary string pool +GRBLP: EX DE,HL + LD HL,(TMSTPT) ; Temporary string pool pointer + EX DE,HL + CALL CPDEHL ; Temporary string pool done? + LD BC,GRBLP ; Loop until string pool done + JP NZ,STPOOL ; No - See if in string area + LD HL,(PROGND) ; Start of simple variables +SMPVAR: EX DE,HL + LD HL,(VAREND) ; End of simple variables + EX DE,HL + CALL CPDEHL ; All simple strings done? + JP Z,ARRLP ; Yes - Do string arrays + LD A,(HL) ; Get type of variable + INC HL + INC HL + OR A ; "S" flag set if string + CALL STRADD ; See if string in string area + JP SMPVAR ; Loop until simple ones done + +GNXARY: POP BC ; Scrap address of this array +ARRLP: EX DE,HL + LD HL,(ARREND) ; End of string arrays + EX DE,HL + CALL CPDEHL ; All string arrays done? + JP Z,SCNEND ; Yes - Move string if found + CALL LOADFP ; Get array name to BCDE + LD A,E ; Get type of array + PUSH HL ; Save address of num of dim'ns + ADD HL,BC ; Start of next array + OR A ; Test type of array + JP P,GNXARY ; Numeric array - Ignore it + LD (CUROPR),HL ; Save address of next array + POP HL ; Get address of num of dim'ns + LD C,(HL) ; BC = Number of dimensions + LD B,0 + ADD HL,BC ; Two bytes per dimension size + ADD HL,BC + INC HL ; Plus one for number of dim'ns +GRBARY: EX DE,HL + LD HL,(CUROPR) ; Get address of next array + EX DE,HL + CALL CPDEHL ; Is this array finished? + JP Z,ARRLP ; Yes - Get next one + LD BC,GRBARY ; Loop until array all done +STPOOL: PUSH BC ; Save return address + OR 80H ; Flag string type +STRADD: LD A,(HL) ; Get string length + INC HL + INC HL + LD E,(HL) ; Get LSB of string address + INC HL + LD D,(HL) ; Get MSB of string address + INC HL + RET P ; Not a string - Return + OR A ; Set flags on string length + RET Z ; Null string - Return + LD B,H ; Save variable pointer + LD C,L + LD HL,(STRBOT) ; Bottom of new area + CALL CPDEHL ; String been done? + LD H,B ; Restore variable pointer + LD L,C + RET C ; String done - Ignore + POP HL ; Return address + EX (SP),HL ; Lowest available string area + CALL CPDEHL ; String within string area? + EX (SP),HL ; Lowest available string area + PUSH HL ; Re-save return address + LD H,B ; Restore variable pointer + LD L,C + RET NC ; Outside string area - Ignore + POP BC ; Get return , Throw 2 away + POP AF ; + POP AF ; + PUSH HL ; Save variable pointer + PUSH DE ; Save address of current + PUSH BC ; Put back return address + RET ; Go to it + +SCNEND: POP DE ; Addresses of strings + POP HL ; + LD A,L ; HL = 0 if no more to do + OR H + RET Z ; No more to do - Return + DEC HL + LD B,(HL) ; MSB of address of string + DEC HL + LD C,(HL) ; LSB of address of string + PUSH HL ; Save variable address + DEC HL + DEC HL + LD L,(HL) ; HL = Length of string + LD H,0 + ADD HL,BC ; Address of end of string+1 + LD D,B ; String address to DE + LD E,C + DEC HL ; Last byte in string + LD B,H ; Address to BC + LD C,L + LD HL,(STRBOT) ; Current bottom of string area + CALL MOVSTR ; Move string to new address + POP HL ; Restore variable address + LD (HL),C ; Save new LSB of address + INC HL + LD (HL),B ; Save new MSB of address + LD L,C ; Next string area+1 to HL + LD H,B + DEC HL ; Next string area address + JP GARBLP ; Look for more strings + +CONCAT: PUSH BC ; Save prec' opr & code string + PUSH HL ; + LD HL,(FPREG) ; Get first string + EX (SP),HL ; Save first string + CALL OPRND ; Get second string + EX (SP),HL ; Restore first string + CALL TSTSTR ; Make sure it's a string + LD A,(HL) ; Get length of second string + PUSH HL ; Save first string + LD HL,(FPREG) ; Get second string + PUSH HL ; Save second string + ADD A,(HL) ; Add length of second string + LD E,LS ; ?LS Error + JP C,ERROR ; String too long - Error + CALL MKTMST ; Make temporary string + POP DE ; Get second string to DE + CALL GSTRDE ; Move to string pool if needed + EX (SP),HL ; Get first string + CALL GSTRHL ; Move to string pool if needed + PUSH HL ; Save first string + LD HL,(TMPSTR+2) ; Temporary string address + EX DE,HL ; To DE + CALL SSTSA ; First string to string area + CALL SSTSA ; Second string to string area + LD HL,EVAL2 ; Return to evaluation loop + EX (SP),HL ; Save return,get code string + PUSH HL ; Save code string address + JP TSTOPL ; To temporary string to pool + +SSTSA: POP HL ; Return address + EX (SP),HL ; Get string block,save return + LD A,(HL) ; Get length of string + INC HL + INC HL + LD C,(HL) ; Get LSB of string address + INC HL + LD B,(HL) ; Get MSB of string address + LD L,A ; Length to L +TOSTRA: INC L ; INC - DECed after +TSALP: DEC L ; Count bytes moved + RET Z ; End of string - Return + LD A,(BC) ; Get source + LD (DE),A ; Save destination + INC BC ; Next source + INC DE ; Next destination + JP TSALP ; Loop until string moved + +GETSTR: CALL TSTSTR ; Make sure it's a string +GSTRCU: LD HL,(FPREG) ; Get current string +GSTRHL: EX DE,HL ; Save DE +GSTRDE: CALL BAKTMP ; Was it last tmp-str? + EX DE,HL ; Restore DE + RET NZ ; No - Return + PUSH DE ; Save string + LD D,B ; String block address to DE + LD E,C + DEC DE ; Point to length + LD C,(HL) ; Get string length + LD HL,(STRBOT) ; Current bottom of string area + CALL CPDEHL ; Last one in string area? + JP NZ,POPHL ; No - Return + LD B,A ; Clear B (A=0) + ADD HL,BC ; Remove string from str' area + LD (STRBOT),HL ; Save new bottom of str' area +POPHL: POP HL ; Restore string + RET + +BAKTMP: LD HL,(TMSTPT) ; Get temporary string pool top + DEC HL ; Back + LD B,(HL) ; Get MSB of address + DEC HL ; Back + LD C,(HL) ; Get LSB of address + DEC HL ; Back + DEC HL ; Back + CALL CPDEHL ; String last in string pool? + RET NZ ; Yes - Leave it + LD (TMSTPT),HL ; Save new string pool top + RET + +LEN: LD BC,PASSA ; To return integer A + PUSH BC ; Save address +GETLEN: CALL GETSTR ; Get string and its length + XOR A + LD D,A ; Clear D + LD (TYPE),A ; Set type to numeric + LD A,(HL) ; Get length of string + OR A ; Set status flags + RET + +ASC: LD BC,PASSA ; To return integer A + PUSH BC ; Save address +GTFLNM: CALL GETLEN ; Get length of string + JP Z,FCERR ; Null string - Error + INC HL + INC HL + LD E,(HL) ; Get LSB of address + INC HL + LD D,(HL) ; Get MSB of address + LD A,(DE) ; Get first byte of string + RET + +CHR: LD A,1 ; One character string + CALL MKTMST ; Make a temporary string + CALL MAKINT ; Make it integer A + LD HL,(TMPSTR+2) ; Get address of string + LD (HL),E ; Save character +TOPOOL: POP BC ; Clean up stack + JP TSTOPL ; Temporary string to pool + +LEFT: CALL LFRGNM ; Get number and ending ")" + XOR A ; Start at first byte in string +RIGHT1: EX (SP),HL ; Save code string,Get string + LD C,A ; Starting position in string +MID1: PUSH HL ; Save string block address + LD A,(HL) ; Get length of string + CP B ; Compare with number given + JP C,ALLFOL ; All following bytes required + LD A,B ; Get new length + .BYTE 11H ; Skip "LD C,0" +ALLFOL: LD C,0 ; First byte of string + PUSH BC ; Save position in string + CALL TESTR ; See if enough string space + POP BC ; Get position in string + POP HL ; Restore string block address + PUSH HL ; And re-save it + INC HL + INC HL + LD B,(HL) ; Get LSB of address + INC HL + LD H,(HL) ; Get MSB of address + LD L,B ; HL = address of string + LD B,0 ; BC = starting address + ADD HL,BC ; Point to that byte + LD B,H ; BC = source string + LD C,L + CALL CRTMST ; Create a string entry + LD L,A ; Length of new string + CALL TOSTRA ; Move string to string area + POP DE ; Clear stack + CALL GSTRDE ; Move to string pool if needed + JP TSTOPL ; Temporary string to pool + +RIGHT: CALL LFRGNM ; Get number and ending ")" + POP DE ; Get string length + PUSH DE ; And re-save + LD A,(DE) ; Get length + SUB B ; Move back N bytes + JP RIGHT1 ; Go and get sub-string + +MID: EX DE,HL ; Get code string address + LD A,(HL) ; Get next byte ',' or ")" + CALL MIDNUM ; Get number supplied + INC B ; Is it character zero? + DEC B + JP Z,FCERR ; Yes - Error + PUSH BC ; Save starting position + LD E,255 ; All of string + CP ')' ; Any length given? + JP Z,RSTSTR ; No - Rest of string + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' + CALL GETINT ; Get integer 0-255 +RSTSTR: CALL CHKSYN ; Make sure ")" follows + .BYTE ")" + POP AF ; Restore starting position + EX (SP),HL ; Get string,8ave code string + LD BC,MID1 ; Continuation of MID$ routine + PUSH BC ; Save for return + DEC A ; Starting position-1 + CP (HL) ; Compare with length + LD B,0 ; Zero bytes length + RET NC ; Null string if start past end + LD C,A ; Save starting position-1 + LD A,(HL) ; Get length of string + SUB C ; Subtract start + CP E ; Enough string for it? + LD B,A ; Save maximum length available + RET C ; Truncate string if needed + LD B,E ; Set specified length + RET ; Go and create string + +VAL: CALL GETLEN ; Get length of string + JP Z,RESZER ; Result zero + LD E,A ; Save length + INC HL + INC HL + LD A,(HL) ; Get LSB of address + INC HL + LD H,(HL) ; Get MSB of address + LD L,A ; HL = String address + PUSH HL ; Save string address + ADD HL,DE + LD B,(HL) ; Get end of string+1 byte + LD (HL),D ; Zero it to terminate + EX (SP),HL ; Save string end,get start + PUSH BC ; Save end+1 byte + LD A,(HL) ; Get starting byte + CP '$' ; Hex number indicated? [function added] + JP NZ,VAL1 + CALL HEXTFP ; Convert Hex to FPREG + JR VAL3 +VAL1: CP '%' ; Binary number indicated? [function added] + JP NZ,VAL2 + CALL BINTFP ; Convert Bin to FPREG + JR VAL3 +VAL2: CALL ASCTFP ; Convert ASCII string to FP +VAL3: POP BC ; Restore end+1 byte + POP HL ; Restore end+1 address + LD (HL),B ; Put back original byte + RET + +LFRGNM: EX DE,HL ; Code string address to HL + CALL CHKSYN ; Make sure ")" follows + .BYTE ")" +MIDNUM: POP BC ; Get return address + POP DE ; Get number supplied + PUSH BC ; Re-save return address + LD B,E ; Number to B + RET + +INP: CALL MAKINT ; Make it integer A + LD (INPORT),A ; Set input port + CALL INPSUB ; Get input from port + JP PASSA ; Return integer A + +POUT: CALL SETIO ; Set up port number + JP OUTSUB ; Output data and return + +WAIT: CALL SETIO ; Set up port number + PUSH AF ; Save AND mask + LD E,0 ; Assume zero if none given + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP Z,NOXOR ; No XOR byte given + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' + CALL GETINT ; Get integer 0-255 to XOR with +NOXOR: POP BC ; Restore AND mask +WAITLP: CALL INPSUB ; Get input + XOR E ; Flip selected bits + AND B ; Result non-zero? + JP Z,WAITLP ; No = keep waiting + RET + +SETIO: CALL GETINT ; Get integer 0-255 + LD (INPORT),A ; Set input port + LD (OTPORT),A ; Set output port + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' + JP GETINT ; Get integer 0-255 and return + +FNDNUM: CALL GETCHR ; Get next character +GETINT: CALL GETNUM ; Get a number from 0 to 255 +MAKINT: CALL DEPINT ; Make sure value 0 - 255 + LD A,D ; Get MSB of number + OR A ; Zero? + JP NZ,FCERR ; No - Error + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + LD A,E ; Get number to A + RET + +PEEK: CALL DEINT ; Get memory address + LD A,(DE) ; Get byte in memory + JP PASSA ; Return integer A + +POKE: CALL GETNUM ; Get memory address + CALL DEINT ; Get integer -32768 to 3276 + PUSH DE ; Save memory address + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' + CALL GETINT ; Get integer 0-255 + POP DE ; Restore memory address + LD (DE),A ; Load it into memory + RET + +ROUND: LD HL,HALF ; Add 0.5 to FPREG +ADDPHL: CALL LOADFP ; Load FP at (HL) to BCDE + JP FPADD ; Add BCDE to FPREG + +SUBPHL: CALL LOADFP ; FPREG = -FPREG + number at HL + .BYTE 21H ; Skip "POP BC" and "POP DE" +PSUB: POP BC ; Get FP number from stack + POP DE +SUBCDE: CALL INVSGN ; Negate FPREG +FPADD: LD A,B ; Get FP exponent + OR A ; Is number zero? + RET Z ; Yes - Nothing to add + LD A,(FPEXP) ; Get FPREG exponent + OR A ; Is this number zero? + JP Z,FPBCDE ; Yes - Move BCDE to FPREG + SUB B ; BCDE number larger? + JP NC,NOSWAP ; No - Don't swap them + CPL ; Two's complement + INC A ; FP exponent + EX DE,HL + CALL STAKFP ; Put FPREG on stack + EX DE,HL + CALL FPBCDE ; Move BCDE to FPREG + POP BC ; Restore number from stack + POP DE +NOSWAP: CP 24+1 ; Second number insignificant? + RET NC ; Yes - First number is result + PUSH AF ; Save number of bits to scale + CALL SIGNS ; Set MSBs & sign of result + LD H,A ; Save sign of result + POP AF ; Restore scaling factor + CALL SCALE ; Scale BCDE to same exponent + OR H ; Result to be positive? + LD HL,FPREG ; Point to FPREG + JP P,MINCDE ; No - Subtract FPREG from CDE + CALL PLUCDE ; Add FPREG to CDE + JP NC,RONDUP ; No overflow - Round it up + INC HL ; Point to exponent + INC (HL) ; Increment it + JP Z,OVERR ; Number overflowed - Error + LD L,1 ; 1 bit to shift right + CALL SHRT1 ; Shift result right + JP RONDUP ; Round it up + +MINCDE: XOR A ; Clear A and carry + SUB B ; Negate exponent + LD B,A ; Re-save exponent + LD A,(HL) ; Get LSB of FPREG + SBC A, E ; Subtract LSB of BCDE + LD E,A ; Save LSB of BCDE + INC HL + LD A,(HL) ; Get NMSB of FPREG + SBC A,D ; Subtract NMSB of BCDE + LD D,A ; Save NMSB of BCDE + INC HL + LD A,(HL) ; Get MSB of FPREG + SBC A,C ; Subtract MSB of BCDE + LD C,A ; Save MSB of BCDE +CONPOS: CALL C,COMPL ; Overflow - Make it positive + +BNORM: LD L,B ; L = Exponent + LD H,E ; H = LSB + XOR A +BNRMLP: LD B,A ; Save bit count + LD A,C ; Get MSB + OR A ; Is it zero? + JP NZ,PNORM ; No - Do it bit at a time + LD C,D ; MSB = NMSB + LD D,H ; NMSB= LSB + LD H,L ; LSB = VLSB + LD L,A ; VLSB= 0 + LD A,B ; Get exponent + SUB 8 ; Count 8 bits + CP -24-8 ; Was number zero? + JP NZ,BNRMLP ; No - Keep normalising +RESZER: XOR A ; Result is zero +SAVEXP: LD (FPEXP),A ; Save result as zero + RET + +NORMAL: DEC B ; Count bits + ADD HL,HL ; Shift HL left + LD A,D ; Get NMSB + RLA ; Shift left with last bit + LD D,A ; Save NMSB + LD A,C ; Get MSB + ADC A,A ; Shift left with last bit + LD C,A ; Save MSB +PNORM: JP P,NORMAL ; Not done - Keep going + LD A,B ; Number of bits shifted + LD E,H ; Save HL in EB + LD B,L + OR A ; Any shifting done? + JP Z,RONDUP ; No - Round it up + LD HL,FPEXP ; Point to exponent + ADD A,(HL) ; Add shifted bits + LD (HL),A ; Re-save exponent + JP NC,RESZER ; Underflow - Result is zero + RET Z ; Result is zero +RONDUP: LD A,B ; Get VLSB of number +RONDB: LD HL,FPEXP ; Point to exponent + OR A ; Any rounding? + CALL M,FPROND ; Yes - Round number up + LD B,(HL) ; B = Exponent + INC HL + LD A,(HL) ; Get sign of result + AND 10000000B ; Only bit 7 needed + XOR C ; Set correct sign + LD C,A ; Save correct sign in number + JP FPBCDE ; Move BCDE to FPREG + +FPROND: INC E ; Round LSB + RET NZ ; Return if ok + INC D ; Round NMSB + RET NZ ; Return if ok + INC C ; Round MSB + RET NZ ; Return if ok + LD C,80H ; Set normal value + INC (HL) ; Increment exponent + RET NZ ; Return if ok + JP OVERR ; Overflow error + +PLUCDE: LD A,(HL) ; Get LSB of FPREG + ADD A,E ; Add LSB of BCDE + LD E,A ; Save LSB of BCDE + INC HL + LD A,(HL) ; Get NMSB of FPREG + ADC A,D ; Add NMSB of BCDE + LD D,A ; Save NMSB of BCDE + INC HL + LD A,(HL) ; Get MSB of FPREG + ADC A,C ; Add MSB of BCDE + LD C,A ; Save MSB of BCDE + RET + +COMPL: LD HL,SGNRES ; Sign of result + LD A,(HL) ; Get sign of result + CPL ; Negate it + LD (HL),A ; Put it back + XOR A + LD L,A ; Set L to zero + SUB B ; Negate exponent,set carry + LD B,A ; Re-save exponent + LD A,L ; Load zero + SBC A,E ; Negate LSB + LD E,A ; Re-save LSB + LD A,L ; Load zero + SBC A,D ; Negate NMSB + LD D,A ; Re-save NMSB + LD A,L ; Load zero + SBC A,C ; Negate MSB + LD C,A ; Re-save MSB + RET + +SCALE: LD B,0 ; Clear underflow +SCALLP: SUB 8 ; 8 bits (a whole byte)? + JP C,SHRITE ; No - Shift right A bits + LD B,E ; <- Shift + LD E,D ; <- right + LD D,C ; <- eight + LD C,0 ; <- bits + JP SCALLP ; More bits to shift + +SHRITE: ADD A,8+1 ; Adjust count + LD L,A ; Save bits to shift +SHRLP: XOR A ; Flag for all done + DEC L ; All shifting done? + RET Z ; Yes - Return + LD A,C ; Get MSB +SHRT1: RRA ; Shift it right + LD C,A ; Re-save + LD A,D ; Get NMSB + RRA ; Shift right with last bit + LD D,A ; Re-save it + LD A,E ; Get LSB + RRA ; Shift right with last bit + LD E,A ; Re-save it + LD A,B ; Get underflow + RRA ; Shift right with last bit + LD B,A ; Re-save underflow + JP SHRLP ; More bits to do + +UNITY: .BYTE 000H,000H,000H,081H ; 1.00000 + +LOGTAB: .BYTE 3 ; Table used by LOG + .BYTE 0AAH,056H,019H,080H ; 0.59898 + .BYTE 0F1H,022H,076H,080H ; 0.96147 + .BYTE 045H,0AAH,038H,082H ; 2.88539 + +LOG: CALL TSTSGN ; Test sign of value + OR A + JP PE,FCERR ; ?FC Error if <= zero + LD HL,FPEXP ; Point to exponent + LD A,(HL) ; Get exponent + LD BC,8035H ; BCDE = SQR(1/2) + LD DE,04F3H + SUB B ; Scale value to be < 1 + PUSH AF ; Save scale factor + LD (HL),B ; Save new exponent + PUSH DE ; Save SQR(1/2) + PUSH BC + CALL FPADD ; Add SQR(1/2) to value + POP BC ; Restore SQR(1/2) + POP DE + INC B ; Make it SQR(2) + CALL DVBCDE ; Divide by SQR(2) + LD HL,UNITY ; Point to 1. + CALL SUBPHL ; Subtract FPREG from 1 + LD HL,LOGTAB ; Coefficient table + CALL SUMSER ; Evaluate sum of series + LD BC,8080H ; BCDE = -0.5 + LD DE,0000H + CALL FPADD ; Subtract 0.5 from FPREG + POP AF ; Restore scale factor + CALL RSCALE ; Re-scale number +MULLN2: LD BC,8031H ; BCDE = Ln(2) + LD DE,7218H + .BYTE 21H ; Skip "POP BC" and "POP DE" + +MULT: POP BC ; Get number from stack + POP DE +FPMULT: CALL TSTSGN ; Test sign of FPREG + RET Z ; Return zero if zero + LD L,0 ; Flag add exponents + CALL ADDEXP ; Add exponents + LD A,C ; Get MSB of multiplier + LD (MULVAL),A ; Save MSB of multiplier + EX DE,HL + LD (MULVAL+1),HL ; Save rest of multiplier + LD BC,0 ; Partial product (BCDE) = zero + LD D,B + LD E,B + LD HL,BNORM ; Address of normalise + PUSH HL ; Save for return + LD HL,MULT8 ; Address of 8 bit multiply + PUSH HL ; Save for NMSB,MSB + PUSH HL ; + LD HL,FPREG ; Point to number +MULT8: LD A,(HL) ; Get LSB of number + INC HL ; Point to NMSB + OR A ; Test LSB + JP Z,BYTSFT ; Zero - shift to next byte + PUSH HL ; Save address of number + LD L,8 ; 8 bits to multiply by +MUL8LP: RRA ; Shift LSB right + LD H,A ; Save LSB + LD A,C ; Get MSB + JP NC,NOMADD ; Bit was zero - Don't add + PUSH HL ; Save LSB and count + LD HL,(MULVAL+1) ; Get LSB and NMSB + ADD HL,DE ; Add NMSB and LSB + EX DE,HL ; Leave sum in DE + POP HL ; Restore MSB and count + LD A,(MULVAL) ; Get MSB of multiplier + ADC A,C ; Add MSB +NOMADD: RRA ; Shift MSB right + LD C,A ; Re-save MSB + LD A,D ; Get NMSB + RRA ; Shift NMSB right + LD D,A ; Re-save NMSB + LD A,E ; Get LSB + RRA ; Shift LSB right + LD E,A ; Re-save LSB + LD A,B ; Get VLSB + RRA ; Shift VLSB right + LD B,A ; Re-save VLSB + DEC L ; Count bits multiplied + LD A,H ; Get LSB of multiplier + JP NZ,MUL8LP ; More - Do it +POPHRT: POP HL ; Restore address of number + RET + +BYTSFT: LD B,E ; Shift partial product left + LD E,D + LD D,C + LD C,A + RET + +DIV10: CALL STAKFP ; Save FPREG on stack + LD BC,8420H ; BCDE = 10. + LD DE,0000H + CALL FPBCDE ; Move 10 to FPREG + +DIV: POP BC ; Get number from stack + POP DE +DVBCDE: CALL TSTSGN ; Test sign of FPREG + JP Z,DZERR ; Error if division by zero + LD L,-1 ; Flag subtract exponents + CALL ADDEXP ; Subtract exponents + INC (HL) ; Add 2 to exponent to adjust + INC (HL) + DEC HL ; Point to MSB + LD A,(HL) ; Get MSB of dividend + LD (DIV3),A ; Save for subtraction + DEC HL + LD A,(HL) ; Get NMSB of dividend + LD (DIV2),A ; Save for subtraction + DEC HL + LD A,(HL) ; Get MSB of dividend + LD (DIV1),A ; Save for subtraction + LD B,C ; Get MSB + EX DE,HL ; NMSB,LSB to HL + XOR A + LD C,A ; Clear MSB of quotient + LD D,A ; Clear NMSB of quotient + LD E,A ; Clear LSB of quotient + LD (DIV4),A ; Clear overflow count +DIVLP: PUSH HL ; Save divisor + PUSH BC + LD A,L ; Get LSB of number + CALL DIVSUP ; Subt' divisor from dividend + SBC A,0 ; Count for overflows + CCF + JP NC,RESDIV ; Restore divisor if borrow + LD (DIV4),A ; Re-save overflow count + POP AF ; Scrap divisor + POP AF + SCF ; Set carry to + .BYTE 0D2H ; Skip "POP BC" and "POP HL" + +RESDIV: POP BC ; Restore divisor + POP HL + LD A,C ; Get MSB of quotient + INC A + DEC A + RRA ; Bit 0 to bit 7 + JP M,RONDB ; Done - Normalise result + RLA ; Restore carry + LD A,E ; Get LSB of quotient + RLA ; Double it + LD E,A ; Put it back + LD A,D ; Get NMSB of quotient + RLA ; Double it + LD D,A ; Put it back + LD A,C ; Get MSB of quotient + RLA ; Double it + LD C,A ; Put it back + ADD HL,HL ; Double NMSB,LSB of divisor + LD A,B ; Get MSB of divisor + RLA ; Double it + LD B,A ; Put it back + LD A,(DIV4) ; Get VLSB of quotient + RLA ; Double it + LD (DIV4),A ; Put it back + LD A,C ; Get MSB of quotient + OR D ; Merge NMSB + OR E ; Merge LSB + JP NZ,DIVLP ; Not done - Keep dividing + PUSH HL ; Save divisor + LD HL,FPEXP ; Point to exponent + DEC (HL) ; Divide by 2 + POP HL ; Restore divisor + JP NZ,DIVLP ; Ok - Keep going + JP OVERR ; Overflow error + +ADDEXP: LD A,B ; Get exponent of dividend + OR A ; Test it + JP Z,OVTST3 ; Zero - Result zero + LD A,L ; Get add/subtract flag + LD HL,FPEXP ; Point to exponent + XOR (HL) ; Add or subtract it + ADD A,B ; Add the other exponent + LD B,A ; Save new exponent + RRA ; Test exponent for overflow + XOR B + LD A,B ; Get exponent + JP P,OVTST2 ; Positive - Test for overflow + ADD A,80H ; Add excess 128 + LD (HL),A ; Save new exponent + JP Z,POPHRT ; Zero - Result zero + CALL SIGNS ; Set MSBs and sign of result + LD (HL),A ; Save new exponent + DEC HL ; Point to MSB + RET + +OVTST1: CALL TSTSGN ; Test sign of FPREG + CPL ; Invert sign + POP HL ; Clean up stack +OVTST2: OR A ; Test if new exponent zero +OVTST3: POP HL ; Clear off return address + JP P,RESZER ; Result zero + JP OVERR ; Overflow error + +MLSP10: CALL BCDEFP ; Move FPREG to BCDE + LD A,B ; Get exponent + OR A ; Is it zero? + RET Z ; Yes - Result is zero + ADD A,2 ; Multiply by 4 + JP C,OVERR ; Overflow - ?OV Error + LD B,A ; Re-save exponent + CALL FPADD ; Add BCDE to FPREG (Times 5) + LD HL,FPEXP ; Point to exponent + INC (HL) ; Double number (Times 10) + RET NZ ; Ok - Return + JP OVERR ; Overflow error + +TSTSGN: LD A,(FPEXP) ; Get sign of FPREG + OR A + RET Z ; RETurn if number is zero + LD A,(FPREG+2) ; Get MSB of FPREG + .BYTE 0FEH ; Test sign +RETREL: CPL ; Invert sign + RLA ; Sign bit to carry +FLGDIF: SBC A,A ; Carry to all bits of A + RET NZ ; Return -1 if negative + INC A ; Bump to +1 + RET ; Positive - Return +1 + +SGN: CALL TSTSGN ; Test sign of FPREG +FLGREL: LD B,80H+8 ; 8 bit integer in exponent + LD DE,0 ; Zero NMSB and LSB +RETINT: LD HL,FPEXP ; Point to exponent + LD C,A ; CDE = MSB,NMSB and LSB + LD (HL),B ; Save exponent + LD B,0 ; CDE = integer to normalise + INC HL ; Point to sign of result + LD (HL),80H ; Set sign of result + RLA ; Carry = sign of integer + JP CONPOS ; Set sign of result + +ABS: CALL TSTSGN ; Test sign of FPREG + RET P ; Return if positive +INVSGN: LD HL,FPREG+2 ; Point to MSB + LD A,(HL) ; Get sign of mantissa + XOR 80H ; Invert sign of mantissa + LD (HL),A ; Re-save sign of mantissa + RET + +STAKFP: EX DE,HL ; Save code string address + LD HL,(FPREG) ; LSB,NLSB of FPREG + EX (SP),HL ; Stack them,get return + PUSH HL ; Re-save return + LD HL,(FPREG+2) ; MSB and exponent of FPREG + EX (SP),HL ; Stack them,get return + PUSH HL ; Re-save return + EX DE,HL ; Restore code string address + RET + +PHLTFP: CALL LOADFP ; Number at HL to BCDE +FPBCDE: EX DE,HL ; Save code string address + LD (FPREG),HL ; Save LSB,NLSB of number + LD H,B ; Exponent of number + LD L,C ; MSB of number + LD (FPREG+2),HL ; Save MSB and exponent + EX DE,HL ; Restore code string address + RET + +BCDEFP: LD HL,FPREG ; Point to FPREG +LOADFP: LD E,(HL) ; Get LSB of number + INC HL + LD D,(HL) ; Get NMSB of number + INC HL + LD C,(HL) ; Get MSB of number + INC HL + LD B,(HL) ; Get exponent of number +INCHL: INC HL ; Used for conditional "INC HL" + RET + +FPTHL: LD DE,FPREG ; Point to FPREG +DETHL4: LD B,4 ; 4 bytes to move +DETHLB: LD A,(DE) ; Get source + LD (HL),A ; Save destination + INC DE ; Next source + INC HL ; Next destination + DEC B ; Count bytes + JP NZ,DETHLB ; Loop if more + RET + +SIGNS: LD HL,FPREG+2 ; Point to MSB of FPREG + LD A,(HL) ; Get MSB + RLCA ; Old sign to carry + SCF ; Set MSBit + RRA ; Set MSBit of MSB + LD (HL),A ; Save new MSB + CCF ; Complement sign + RRA ; Old sign to carry + INC HL + INC HL + LD (HL),A ; Set sign of result + LD A,C ; Get MSB + RLCA ; Old sign to carry + SCF ; Set MSBit + RRA ; Set MSBit of MSB + LD C,A ; Save MSB + RRA + XOR (HL) ; New sign of result + RET + +CMPNUM: LD A,B ; Get exponent of number + OR A + JP Z,TSTSGN ; Zero - Test sign of FPREG + LD HL,RETREL ; Return relation routine + PUSH HL ; Save for return + CALL TSTSGN ; Test sign of FPREG + LD A,C ; Get MSB of number + RET Z ; FPREG zero - Number's MSB + LD HL,FPREG+2 ; MSB of FPREG + XOR (HL) ; Combine signs + LD A,C ; Get MSB of number + RET M ; Exit if signs different + CALL CMPFP ; Compare FP numbers + RRA ; Get carry to sign + XOR C ; Combine with MSB of number + RET + +CMPFP: INC HL ; Point to exponent + LD A,B ; Get exponent + CP (HL) ; Compare exponents + RET NZ ; Different + DEC HL ; Point to MBS + LD A,C ; Get MSB + CP (HL) ; Compare MSBs + RET NZ ; Different + DEC HL ; Point to NMSB + LD A,D ; Get NMSB + CP (HL) ; Compare NMSBs + RET NZ ; Different + DEC HL ; Point to LSB + LD A,E ; Get LSB + SUB (HL) ; Compare LSBs + RET NZ ; Different + POP HL ; Drop RETurn + POP HL ; Drop another RETurn + RET + +FPINT: LD B,A ; <- Move + LD C,A ; <- exponent + LD D,A ; <- to all + LD E,A ; <- bits + OR A ; Test exponent + RET Z ; Zero - Return zero + PUSH HL ; Save pointer to number + CALL BCDEFP ; Move FPREG to BCDE + CALL SIGNS ; Set MSBs & sign of result + XOR (HL) ; Combine with sign of FPREG + LD H,A ; Save combined signs + CALL M,DCBCDE ; Negative - Decrement BCDE + LD A,80H+24 ; 24 bits + SUB B ; Bits to shift + CALL SCALE ; Shift BCDE + LD A,H ; Get combined sign + RLA ; Sign to carry + CALL C,FPROND ; Negative - Round number up + LD B,0 ; Zero exponent + CALL C,COMPL ; If negative make positive + POP HL ; Restore pointer to number + RET + +DCBCDE: DEC DE ; Decrement BCDE + LD A,D ; Test LSBs + AND E + INC A + RET NZ ; Exit if LSBs not FFFF + DEC BC ; Decrement MSBs + RET + +INT: LD HL,FPEXP ; Point to exponent + LD A,(HL) ; Get exponent + CP 80H+24 ; Integer accuracy only? + LD A,(FPREG) ; Get LSB + RET NC ; Yes - Already integer + LD A,(HL) ; Get exponent + CALL FPINT ; F.P to integer + LD (HL),80H+24 ; Save 24 bit integer + LD A,E ; Get LSB of number + PUSH AF ; Save LSB + LD A,C ; Get MSB of number + RLA ; Sign to carry + CALL CONPOS ; Set sign of result + POP AF ; Restore LSB of number + RET + +MLDEBC: LD HL,0 ; Clear partial product + LD A,B ; Test multiplier + OR C + RET Z ; Return zero if zero + LD A,16 ; 16 bits +MLDBLP: ADD HL,HL ; Shift P.P left + JP C,BSERR ; ?BS Error if overflow + EX DE,HL + ADD HL,HL ; Shift multiplier left + EX DE,HL + JP NC,NOMLAD ; Bit was zero - No add + ADD HL,BC ; Add multiplicand + JP C,BSERR ; ?BS Error if overflow +NOMLAD: DEC A ; Count bits + JP NZ,MLDBLP ; More + RET + +ASCTFP: CP '-' ; Negative? + PUSH AF ; Save it and flags + JP Z,CNVNUM ; Yes - Convert number + CP '+' ; Positive? + JP Z,CNVNUM ; Yes - Convert number + DEC HL ; DEC 'cos GETCHR INCs +CNVNUM: CALL RESZER ; Set result to zero + LD B,A ; Digits after point counter + LD D,A ; Sign of exponent + LD E,A ; Exponent of ten + CPL + LD C,A ; Before or after point flag +MANLP: CALL GETCHR ; Get next character + JP C,ADDIG ; Digit - Add to number + CP '.' + JP Z,DPOINT ; '.' - Flag point + CP 'E' + JP NZ,CONEXP ; Not 'E' - Scale number + CALL GETCHR ; Get next character + CALL SGNEXP ; Get sign of exponent +EXPLP: CALL GETCHR ; Get next character + JP C,EDIGIT ; Digit - Add to exponent + INC D ; Is sign negative? + JP NZ,CONEXP ; No - Scale number + XOR A + SUB E ; Negate exponent + LD E,A ; And re-save it + INC C ; Flag end of number +DPOINT: INC C ; Flag point passed + JP Z,MANLP ; Zero - Get another digit +CONEXP: PUSH HL ; Save code string address + LD A,E ; Get exponent + SUB B ; Subtract digits after point +SCALMI: CALL P,SCALPL ; Positive - Multiply number + JP P,ENDCON ; Positive - All done + PUSH AF ; Save number of times to /10 + CALL DIV10 ; Divide by 10 + POP AF ; Restore count + INC A ; Count divides + +ENDCON: JP NZ,SCALMI ; More to do + POP DE ; Restore code string address + POP AF ; Restore sign of number + CALL Z,INVSGN ; Negative - Negate number + EX DE,HL ; Code string address to HL + RET + +SCALPL: RET Z ; Exit if no scaling needed +MULTEN: PUSH AF ; Save count + CALL MLSP10 ; Multiply number by 10 + POP AF ; Restore count + DEC A ; Count multiplies + RET + +ADDIG: PUSH DE ; Save sign of exponent + LD D,A ; Save digit + LD A,B ; Get digits after point + ADC A,C ; Add one if after point + LD B,A ; Re-save counter + PUSH BC ; Save point flags + PUSH HL ; Save code string address + PUSH DE ; Save digit + CALL MLSP10 ; Multiply number by 10 + POP AF ; Restore digit + SUB '0' ; Make it absolute + CALL RSCALE ; Re-scale number + POP HL ; Restore code string address + POP BC ; Restore point flags + POP DE ; Restore sign of exponent + JP MANLP ; Get another digit + +RSCALE: CALL STAKFP ; Put number on stack + CALL FLGREL ; Digit to add to FPREG +PADD: POP BC ; Restore number + POP DE + JP FPADD ; Add BCDE to FPREG and return + +EDIGIT: LD A,E ; Get digit + RLCA ; Times 2 + RLCA ; Times 4 + ADD A,E ; Times 5 + RLCA ; Times 10 + ADD A,(HL) ; Add next digit + SUB '0' ; Make it absolute + LD E,A ; Save new digit + JP EXPLP ; Look for another digit + +LINEIN: PUSH HL ; Save code string address + LD HL,INMSG ; Output " in " + CALL PRS ; Output string at HL + POP HL ; Restore code string address +PRNTHL: EX DE,HL ; Code string address to DE + XOR A + LD B,80H+24 ; 24 bits + CALL RETINT ; Return the integer + LD HL,PRNUMS ; Print number string + PUSH HL ; Save for return +NUMASC: LD HL,PBUFF ; Convert number to ASCII + PUSH HL ; Save for return + CALL TSTSGN ; Test sign of FPREG + LD (HL),' ' ; Space at start + JP P,SPCFST ; Positive - Space to start + LD (HL),'-' ; '-' sign at start +SPCFST: INC HL ; First byte of number + LD (HL),'0' ; '0' if zero + JP Z,JSTZER ; Return '0' if zero + PUSH HL ; Save buffer address + CALL M,INVSGN ; Negate FPREG if negative + XOR A ; Zero A + PUSH AF ; Save it + CALL RNGTST ; Test number is in range +SIXDIG: LD BC,9143H ; BCDE - 99999.9 + LD DE,4FF8H + CALL CMPNUM ; Compare numbers + OR A + JP PO,INRNG ; > 99999.9 - Sort it out + POP AF ; Restore count + CALL MULTEN ; Multiply by ten + PUSH AF ; Re-save count + JP SIXDIG ; Test it again + +GTSIXD: CALL DIV10 ; Divide by 10 + POP AF ; Get count + INC A ; Count divides + PUSH AF ; Re-save count + CALL RNGTST ; Test number is in range +INRNG: CALL ROUND ; Add 0.5 to FPREG + INC A + CALL FPINT ; F.P to integer + CALL FPBCDE ; Move BCDE to FPREG + LD BC,0306H ; 1E+06 to 1E-03 range + POP AF ; Restore count + ADD A,C ; 6 digits before point + INC A ; Add one + JP M,MAKNUM ; Do it in 'E' form if < 1E-02 + CP 6+1+1 ; More than 999999 ? + JP NC,MAKNUM ; Yes - Do it in 'E' form + INC A ; Adjust for exponent + LD B,A ; Exponent of number + LD A,2 ; Make it zero after + +MAKNUM: DEC A ; Adjust for digits to do + DEC A + POP HL ; Restore buffer address + PUSH AF ; Save count + LD DE,POWERS ; Powers of ten + DEC B ; Count digits before point + JP NZ,DIGTXT ; Not zero - Do number + LD (HL),'.' ; Save point + INC HL ; Move on + LD (HL),'0' ; Save zero + INC HL ; Move on +DIGTXT: DEC B ; Count digits before point + LD (HL),'.' ; Save point in case + CALL Z,INCHL ; Last digit - move on + PUSH BC ; Save digits before point + PUSH HL ; Save buffer address + PUSH DE ; Save powers of ten + CALL BCDEFP ; Move FPREG to BCDE + POP HL ; Powers of ten table + LD B, '0'-1 ; ASCII '0' - 1 +TRYAGN: INC B ; Count subtractions + LD A,E ; Get LSB + SUB (HL) ; Subtract LSB + LD E,A ; Save LSB + INC HL + LD A,D ; Get NMSB + SBC A,(HL) ; Subtract NMSB + LD D,A ; Save NMSB + INC HL + LD A,C ; Get MSB + SBC A,(HL) ; Subtract MSB + LD C,A ; Save MSB + DEC HL ; Point back to start + DEC HL + JP NC,TRYAGN ; No overflow - Try again + CALL PLUCDE ; Restore number + INC HL ; Start of next number + CALL FPBCDE ; Move BCDE to FPREG + EX DE,HL ; Save point in table + POP HL ; Restore buffer address + LD (HL),B ; Save digit in buffer + INC HL ; And move on + POP BC ; Restore digit count + DEC C ; Count digits + JP NZ,DIGTXT ; More - Do them + DEC B ; Any decimal part? + JP Z,DOEBIT ; No - Do 'E' bit +SUPTLZ: DEC HL ; Move back through buffer + LD A,(HL) ; Get character + CP '0' ; '0' character? + JP Z,SUPTLZ ; Yes - Look back for more + CP '.' ; A decimal point? + CALL NZ,INCHL ; Move back over digit + +DOEBIT: POP AF ; Get 'E' flag + JP Z,NOENED ; No 'E' needed - End buffer + LD (HL),'E' ; Put 'E' in buffer + INC HL ; And move on + LD (HL),'+' ; Put '+' in buffer + JP P,OUTEXP ; Positive - Output exponent + LD (HL),'-' ; Put '-' in buffer + CPL ; Negate exponent + INC A +OUTEXP: LD B,'0'-1 ; ASCII '0' - 1 +EXPTEN: INC B ; Count subtractions + SUB 10 ; Tens digit + JP NC,EXPTEN ; More to do + ADD A,'0'+10 ; Restore and make ASCII + INC HL ; Move on + LD (HL),B ; Save MSB of exponent +JSTZER: INC HL ; + LD (HL),A ; Save LSB of exponent + INC HL +NOENED: LD (HL),C ; Mark end of buffer + POP HL ; Restore code string address + RET + +RNGTST: LD BC,9474H ; BCDE = 999999. + LD DE,23F7H + CALL CMPNUM ; Compare numbers + OR A + POP HL ; Return address to HL + JP PO,GTSIXD ; Too big - Divide by ten + JP (HL) ; Otherwise return to caller + +HALF: .BYTE 00H,00H,00H,80H ; 0.5 + +POWERS: .BYTE 0A0H,086H,001H ; 100000 + .BYTE 010H,027H,000H ; 10000 + .BYTE 0E8H,003H,000H ; 1000 + .BYTE 064H,000H,000H ; 100 + .BYTE 00AH,000H,000H ; 10 + .BYTE 001H,000H,000H ; 1 + +NEGAFT: LD HL,INVSGN ; Negate result + EX (SP),HL ; To be done after caller + JP (HL) ; Return to caller + +SQR: CALL STAKFP ; Put value on stack + LD HL,HALF ; Set power to 1/2 + CALL PHLTFP ; Move 1/2 to FPREG + +POWER: POP BC ; Get base + POP DE + CALL TSTSGN ; Test sign of power + LD A,B ; Get exponent of base + JP Z,EXP ; Make result 1 if zero + JP P,POWER1 ; Positive base - Ok + OR A ; Zero to negative power? + JP Z,DZERR ; Yes - ?/0 Error +POWER1: OR A ; Base zero? + JP Z,SAVEXP ; Yes - Return zero + PUSH DE ; Save base + PUSH BC + LD A,C ; Get MSB of base + OR 01111111B ; Get sign status + CALL BCDEFP ; Move power to BCDE + JP P,POWER2 ; Positive base - Ok + PUSH DE ; Save power + PUSH BC + CALL INT ; Get integer of power + POP BC ; Restore power + POP DE + PUSH AF ; MSB of base + CALL CMPNUM ; Power an integer? + POP HL ; Restore MSB of base + LD A,H ; but don't affect flags + RRA ; Exponent odd or even? +POWER2: POP HL ; Restore MSB and exponent + LD (FPREG+2),HL ; Save base in FPREG + POP HL ; LSBs of base + LD (FPREG),HL ; Save in FPREG + CALL C,NEGAFT ; Odd power - Negate result + CALL Z,INVSGN ; Negative base - Negate it + PUSH DE ; Save power + PUSH BC + CALL LOG ; Get LOG of base + POP BC ; Restore power + POP DE + CALL FPMULT ; Multiply LOG by power + +EXP: CALL STAKFP ; Put value on stack + LD BC,08138H ; BCDE = 1/Ln(2) + LD DE,0AA3BH + CALL FPMULT ; Multiply value by 1/LN(2) + LD A,(FPEXP) ; Get exponent + CP 80H+8 ; Is it in range? + JP NC,OVTST1 ; No - Test for overflow + CALL INT ; Get INT of FPREG + ADD A,80H ; For excess 128 + ADD A,2 ; Exponent > 126? + JP C,OVTST1 ; Yes - Test for overflow + PUSH AF ; Save scaling factor + LD HL,UNITY ; Point to 1. + CALL ADDPHL ; Add 1 to FPREG + CALL MULLN2 ; Multiply by LN(2) + POP AF ; Restore scaling factor + POP BC ; Restore exponent + POP DE + PUSH AF ; Save scaling factor + CALL SUBCDE ; Subtract exponent from FPREG + CALL INVSGN ; Negate result + LD HL,EXPTAB ; Coefficient table + CALL SMSER1 ; Sum the series + LD DE,0 ; Zero LSBs + POP BC ; Scaling factor + LD C,D ; Zero MSB + JP FPMULT ; Scale result to correct value + +EXPTAB: .BYTE 8 ; Table used by EXP + .BYTE 040H,02EH,094H,074H ; -1/7! (-1/5040) + .BYTE 070H,04FH,02EH,077H ; 1/6! ( 1/720) + .BYTE 06EH,002H,088H,07AH ; -1/5! (-1/120) + .BYTE 0E6H,0A0H,02AH,07CH ; 1/4! ( 1/24) + .BYTE 050H,0AAH,0AAH,07EH ; -1/3! (-1/6) + .BYTE 0FFH,0FFH,07FH,07FH ; 1/2! ( 1/2) + .BYTE 000H,000H,080H,081H ; -1/1! (-1/1) + .BYTE 000H,000H,000H,081H ; 1/0! ( 1/1) + +SUMSER: CALL STAKFP ; Put FPREG on stack + LD DE,MULT ; Multiply by "X" + PUSH DE ; To be done after + PUSH HL ; Save address of table + CALL BCDEFP ; Move FPREG to BCDE + CALL FPMULT ; Square the value + POP HL ; Restore address of table +SMSER1: CALL STAKFP ; Put value on stack + LD A,(HL) ; Get number of coefficients + INC HL ; Point to start of table + CALL PHLTFP ; Move coefficient to FPREG + .BYTE 06H ; Skip "POP AF" +SUMLP: POP AF ; Restore count + POP BC ; Restore number + POP DE + DEC A ; Cont coefficients + RET Z ; All done + PUSH DE ; Save number + PUSH BC + PUSH AF ; Save count + PUSH HL ; Save address in table + CALL FPMULT ; Multiply FPREG by BCDE + POP HL ; Restore address in table + CALL LOADFP ; Number at HL to BCDE + PUSH HL ; Save address in table + CALL FPADD ; Add coefficient to FPREG + POP HL ; Restore address in table + JP SUMLP ; More coefficients + +RND: CALL TSTSGN ; Test sign of FPREG + LD HL,SEED+2 ; Random number seed + JP M,RESEED ; Negative - Re-seed + LD HL,LSTRND ; Last random number + CALL PHLTFP ; Move last RND to FPREG + LD HL,SEED+2 ; Random number seed + RET Z ; Return if RND(0) + ADD A,(HL) ; Add (SEED)+2) + AND 00000111B ; 0 to 7 + LD B,0 + LD (HL),A ; Re-save seed + INC HL ; Move to coefficient table + ADD A,A ; 4 bytes + ADD A,A ; per entry + LD C,A ; BC = Offset into table + ADD HL,BC ; Point to coefficient + CALL LOADFP ; Coefficient to BCDE + CALL FPMULT ; ; Multiply FPREG by coefficient + LD A,(SEED+1) ; Get (SEED+1) + INC A ; Add 1 + AND 00000011B ; 0 to 3 + LD B,0 + CP 1 ; Is it zero? + ADC A,B ; Yes - Make it 1 + LD (SEED+1),A ; Re-save seed + LD HL,RNDTAB-4 ; Addition table + ADD A,A ; 4 bytes + ADD A,A ; per entry + LD C,A ; BC = Offset into table + ADD HL,BC ; Point to value + CALL ADDPHL ; Add value to FPREG +RND1: CALL BCDEFP ; Move FPREG to BCDE + LD A,E ; Get LSB + LD E,C ; LSB = MSB + XOR 01001111B ; Fiddle around + LD C,A ; New MSB + LD (HL),80H ; Set exponent + DEC HL ; Point to MSB + LD B,(HL) ; Get MSB + LD (HL),80H ; Make value -0.5 + LD HL,SEED ; Random number seed + INC (HL) ; Count seed + LD A,(HL) ; Get seed + SUB 171 ; Do it modulo 171 + JP NZ,RND2 ; Non-zero - Ok + LD (HL),A ; Zero seed + INC C ; Fillde about + DEC D ; with the + INC E ; number +RND2: CALL BNORM ; Normalise number + LD HL,LSTRND ; Save random number + JP FPTHL ; Move FPREG to last and return + +RESEED: LD (HL),A ; Re-seed random numbers + DEC HL + LD (HL),A + DEC HL + LD (HL),A + JP RND1 ; Return RND seed + +RNDTAB: .BYTE 068H,0B1H,046H,068H ; Table used by RND + .BYTE 099H,0E9H,092H,069H + .BYTE 010H,0D1H,075H,068H + +COS: LD HL,HALFPI ; Point to PI/2 + CALL ADDPHL ; Add it to PPREG +SIN: CALL STAKFP ; Put angle on stack + LD BC,8349H ; BCDE = 2 PI + LD DE,0FDBH + CALL FPBCDE ; Move 2 PI to FPREG + POP BC ; Restore angle + POP DE + CALL DVBCDE ; Divide angle by 2 PI + CALL STAKFP ; Put it on stack + CALL INT ; Get INT of result + POP BC ; Restore number + POP DE + CALL SUBCDE ; Make it 0 <= value < 1 + LD HL,QUARTR ; Point to 0.25 + CALL SUBPHL ; Subtract value from 0.25 + CALL TSTSGN ; Test sign of value + SCF ; Flag positive + JP P,SIN1 ; Positive - Ok + CALL ROUND ; Add 0.5 to value + CALL TSTSGN ; Test sign of value + OR A ; Flag negative +SIN1: PUSH AF ; Save sign + CALL P,INVSGN ; Negate value if positive + LD HL,QUARTR ; Point to 0.25 + CALL ADDPHL ; Add 0.25 to value + POP AF ; Restore sign + CALL NC,INVSGN ; Negative - Make positive + LD HL,SINTAB ; Coefficient table + JP SUMSER ; Evaluate sum of series + +HALFPI: .BYTE 0DBH,00FH,049H,081H ; 1.5708 (PI/2) + +QUARTR: .BYTE 000H,000H,000H,07FH ; 0.25 + +SINTAB: .BYTE 5 ; Table used by SIN + .BYTE 0BAH,0D7H,01EH,086H ; 39.711 + .BYTE 064H,026H,099H,087H ;-76.575 + .BYTE 058H,034H,023H,087H ; 81.602 + .BYTE 0E0H,05DH,0A5H,086H ;-41.342 + .BYTE 0DAH,00FH,049H,083H ; 6.2832 + +TAN: CALL STAKFP ; Put angle on stack + CALL SIN ; Get SIN of angle + POP BC ; Restore angle + POP HL + CALL STAKFP ; Save SIN of angle + EX DE,HL ; BCDE = Angle + CALL FPBCDE ; Angle to FPREG + CALL COS ; Get COS of angle + JP DIV ; TAN = SIN / COS + +ATN: CALL TSTSGN ; Test sign of value + CALL M,NEGAFT ; Negate result after if -ve + CALL M,INVSGN ; Negate value if -ve + LD A,(FPEXP) ; Get exponent + CP 81H ; Number less than 1? + JP C,ATN1 ; Yes - Get arc tangnt + LD BC,8100H ; BCDE = 1 + LD D,C + LD E,C + CALL DVBCDE ; Get reciprocal of number + LD HL,SUBPHL ; Sub angle from PI/2 + PUSH HL ; Save for angle > 1 +ATN1: LD HL,ATNTAB ; Coefficient table + CALL SUMSER ; Evaluate sum of series + LD HL,HALFPI ; PI/2 - angle in case > 1 + RET ; Number > 1 - Sub from PI/2 + +ATNTAB: .BYTE 9 ; Table used by ATN + .BYTE 04AH,0D7H,03BH,078H ; 1/17 + .BYTE 002H,06EH,084H,07BH ;-1/15 + .BYTE 0FEH,0C1H,02FH,07CH ; 1/13 + .BYTE 074H,031H,09AH,07DH ;-1/11 + .BYTE 084H,03DH,05AH,07DH ; 1/9 + .BYTE 0C8H,07FH,091H,07EH ;-1/7 + .BYTE 0E4H,0BBH,04CH,07EH ; 1/5 + .BYTE 06CH,0AAH,0AAH,07FH ;-1/3 + .BYTE 000H,000H,000H,081H ; 1/1 + + +ARET: RET ; A RETurn instruction + +GETINP: JP MC_BIOS_GETC ;input a character + +CLS: + LD A,CS ; ASCII Clear screen + JP MONOUT ; Output character + +WIDTH: CALL GETINT ; Get integer 0-255 + LD A,E ; Width to A + LD (LWIDTH),A ; Set width + RET + +LINES: CALL GETNUM ; Get a number + CALL DEINT ; Get integer -32768 to 32767 + LD (LINESC),DE ; Set lines counter + LD (LINESN),DE ; Set lines number + RET + +DEEK: CALL DEINT ; Get integer -32768 to 32767 + PUSH DE ; Save number + POP HL ; Number to HL + LD B,(HL) ; Get LSB of contents + INC HL + LD A,(HL) ; Get MSB of contents + JP ABPASS ; Return integer AB + +DOKE: CALL GETNUM ; Get a number + CALL DEINT ; Get integer -32768 to 32767 + PUSH DE ; Save address + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' + CALL GETNUM ; Get a number + CALL DEINT ; Get integer -32768 to 32767 + EX (SP),HL ; Save value,get address + LD (HL),E ; Save LSB of value + INC HL + LD (HL),D ; Save MSB of value + POP HL ; Restore code string address + RET + + +; HEX$(nn) Convert 16 bit number to Hexadecimal string + +HEX: CALL TSTNUM ; Verify it's a number + CALL DEINT ; Get integer -32768 to 32767 + PUSH BC ; Save contents of BC + LD HL,PBUFF + LD A,D ; Get high order into A + CP $0 + JR Z,HEX2 ; Skip output if both high digits are zero + CALL BYT2ASC ; Convert D to ASCII + LD A,B + CP '0' + JR Z,HEX1 ; Don't store high digit if zero + LD (HL),B ; Store it to PBUFF + INC HL ; Next location +HEX1: LD (HL),C ; Store C to PBUFF+1 + INC HL ; Next location +HEX2: LD A,E ; Get lower byte + CALL BYT2ASC ; Convert E to ASCII + LD A,D + CP $0 + JR NZ,HEX3 ; If upper byte was not zero then always print lower byte + LD A,B + CP '0' ; If high digit of lower byte is zero then don't print + JR Z,HEX4 +HEX3: LD (HL),B ; to PBUFF+2 + INC HL ; Next location +HEX4: LD (HL),C ; to PBUFF+3 + INC HL ; PBUFF+4 to zero + XOR A ; Terminating character + LD (HL),A ; Store zero to terminate + INC HL ; Make sure PBUFF is terminated + LD (HL),A ; Store the double zero there + POP BC ; Get BC back + LD HL,PBUFF ; Reset to start of PBUFF + JP STR1 ; Convert the PBUFF to a string and return it + +BYT2ASC LD B,A ; Save original value + AND $0F ; Strip off upper nybble + CP $0A ; 0-9? + JR C,ADD30 ; If A-F, add 7 more + ADD A,$07 ; Bring value up to ASCII A-F +ADD30 ADD A,$30 ; And make ASCII + LD C,A ; Save converted char to C + LD A,B ; Retrieve original value + RRCA ; and Rotate it right + RRCA + RRCA + RRCA + AND $0F ; Mask off upper nybble + CP $0A ; 0-9? < A hex? + JR C,ADD301 ; Skip Add 7 + ADD A,$07 ; Bring it up to ASCII A-F +ADD301 ADD A,$30 ; And make it full ASCII + LD B,A ; Store high order byte + RET + +; Convert "&Hnnnn" to FPREG +; Gets a character from (HL) checks for Hexadecimal ASCII numbers "&Hnnnn" +; Char is in A, NC if char is ;<=>?@ A-z, CY is set if 0-9 +HEXTFP EX DE,HL ; Move code string pointer to DE + LD HL,$0000 ; Zero out the value + CALL GETHEX ; Check the number for valid hex + JP C,HXERR ; First value wasn't hex, HX error + JR HEXLP1 ; Convert first character +HEXLP CALL GETHEX ; Get second and addtional characters + JR C,HEXIT ; Exit if not a hex character +HEXLP1 ADD HL,HL ; Rotate 4 bits to the left + ADD HL,HL + ADD HL,HL + ADD HL,HL + OR L ; Add in D0-D3 into L + LD L,A ; Save new value + JR HEXLP ; And continue until all hex characters are in + +GETHEX INC DE ; Next location + LD A,(DE) ; Load character at pointer + CP ' ' + JP Z,GETHEX ; Skip spaces + SUB $30 ; Get absolute value + RET C ; < "0", error + CP $0A + JR C,NOSUB7 ; Is already in the range 0-9 + SUB $07 ; Reduce to A-F + CP $0A ; Value should be $0A-$0F at this point + RET C ; CY set if was : ; < = > ? @ +NOSUB7 CP $10 ; > Greater than "F"? + CCF + RET ; CY set if it wasn't valid hex + +HEXIT EX DE,HL ; Value into DE, Code string into HL + LD A,D ; Load DE into AC + LD C,E ; For prep to + PUSH HL + CALL ACPASS ; ACPASS to set AC as integer into FPREG + POP HL + RET + +HXERR: LD E,HX ; ?HEX Error + JP ERROR + +; BIN$(NN) Convert integer to a 1-16 char binary string +BIN: CALL TSTNUM ; Verify it's a number + CALL DEINT ; Get integer -32768 to 32767 +BIN2: PUSH BC ; Save contents of BC + LD HL,PBUFF + LD B,17 ; One higher than max char count +ZEROSUP: ; Suppress leading zeros + DEC B ; Max 16 chars + LD A,B + CP $01 + JR Z,BITOUT ; Always output at least one character + RL E + RL D + JR NC,ZEROSUP + JR BITOUT2 +BITOUT: + RL E + RL D ; Top bit now in carry +BITOUT2: + LD A,'0' ; Char for '0' + ADC A,0 ; If carry set then '0' --> '1' + LD (HL),A + INC HL + DEC B + JR NZ,BITOUT + XOR A ; Terminating character + LD (HL),A ; Store zero to terminate + INC HL ; Make sure PBUFF is terminated + LD (HL),A ; Store the double zero there + POP BC + LD HL,PBUFF + JP STR1 + +; Convert "&Bnnnn" to FPREG +; Gets a character from (HL) checks for Binary ASCII numbers "&Bnnnn" +BINTFP: EX DE,HL ; Move code string pointer to DE + LD HL,$0000 ; Zero out the value + CALL CHKBIN ; Check the number for valid bin + JP C,BINERR ; First value wasn't bin, HX error +BINIT: SUB '0' + ADD HL,HL ; Rotate HL left + OR L + LD L,A + CALL CHKBIN ; Get second and addtional characters + JR NC,BINIT ; Process if a bin character + EX DE,HL ; Value into DE, Code string into HL + LD A,D ; Load DE into AC + LD C,E ; For prep to + PUSH HL + CALL ACPASS ; ACPASS to set AC as integer into FPREG + POP HL + RET + +; Char is in A, NC if char is 0 or 1 +CHKBIN: INC DE + LD A,(DE) + CP ' ' + JP Z,CHKBIN ; Skip spaces + CP '0' ; Set C if < '0' + RET C + CP '2' + CCF ; Set C if > '1' + RET + +BINERR: LD E,BN ; ?BIN Error + JP ERROR + + +JJUMP1: LD IX,-1 ; Flag cold start + JP CSTART ; Go and initialise + +MONOUT: JP MC_BIOS_PUTC ; output a char + + +MONITR: CALL MC_BIOS_FLUSH + JP MC_BIOS_MONITOR ; Restart (Normally Monitor Start) + + +INITST: LD A,0 ; Clear break flag + LD (BRKFLG),A + JP INIT + +ARETN: RETN ; Return from NMI + + +TSTBIT: PUSH AF ; Save bit mask + AND B ; Get common bits + POP BC ; Restore bit mask + CP B ; Same bit set? + LD A,0 ; Return 0 in A + RET + +OUTNCR: CALL OUTC ; Output character in A + JP PRNTCRLF ; Output CRLF + +.end + diff --git a/new/apps/basic/nascom8kbasic.asm b/new/apps/basic/nascom8kbasic.asm new file mode 100644 index 0000000..24130f2 --- /dev/null +++ b/new/apps/basic/nascom8kbasic.asm @@ -0,0 +1,4855 @@ +; NASCOM ROM BASIC Ver 4.7, (C) 1978 Microsoft +; Scanned from source published in 80-BUS NEWS from Vol 2, Issue 3 +; (May-June 1983) to Vol 3, Issue 3 (May-June 1984) +; Adapted for the freeware Zilog Macro Assembler 2.10 to produce +; the original ROM code (checksum A934H). PA + +; MONITOR EQUATES (RESTART INSTRUCTIONS) + +_ROUT EQU 0F7H ; ROUT - Output char in A +_BLNK EQU 07BDFH ; SCAL BLINK - Get input char in A +_INLN EQU 063DFH ; SCAL INLIN - Get input line +_MFLP EQU 05FDFH ; SCAL MFLP - Toggle tape drv LED +_MRET EQU 05BDFH ; SCAL MRET - Return to monitor +_READ EQU 052DFH ; SCAL READ +_RIN EQU 062DFH ; SCAL RIN - Scan for input char +_VRFY EQU 056DFH ; SCAL VERIFY +_WRIT EQU 057DFH ; SCAL WRITE + +; GENERAL EQUATES + +UARTD EQU 01H ; UART data port +UARTS EQU 02H ; UART status port +CTRLC EQU 03H ; Control "C" +CTRLG EQU 07H ; Control "G" +BKSP EQU 08H ; Back space +LF EQU 0AH ; Line feed +CS EQU 0CH ; Clear screen +CR EQU 0DH ; Carriage return +CTRLO EQU 0FH ; Control "O" +CTRLR EQU 12H ; Control "R" +CTRLS EQU 13H ; Control "S" +CTRLU EQU 15H ; Control "U" +CTRLZ EQU 1AH ; Control "Z" +ESC EQU 1BH ; Escape +TBRK EQU 1CH ; "T" monitor break +TBS EQU 1DH ; "T" monitor back space +TCS EQU 1EH ; "T" monitor clear screen +TCR EQU 1FH ; "T" monitor carriage return +DEL EQU 7FH ; Delete + +; MONITOR LOCATIONS + +MONSTT EQU 0000H ; Start of monitor +STMON EQU 000DH ; NAS-SYS initialisation +MFLP EQU 0051H ; Flip tape LED ("T") +MONTYP EQU 008DH ; Type of "T" monitor +T2DUMP EQU 03D1H ; "T2" Dump routine +T4WR EQU 0400H ; "T4" Write routine +T4READ EQU 070CH ; "T4" Read routine +VDU EQU 0800H ; NASCOM Video RAM base + +; MONITOR WORK SPACE LOCATIONS + +PORT0 EQU 0C00H ; Copy of output port 0 +ARG1 EQU 0C0CH ; Argument 1 +ARG2 EQU 0C0EH ; Argument 2 +TCUR EQU 0C18H ; "T" monitor cursor +CURSOR EQU 0C29H ; NAS-SYS Cursor +ARGN EQU 0C2BH ; Number of ARGS +TOUT EQU 0C4AH ; "T" Output reflection +TIN EQU 0C4DH ; "T" Input reflection +CIN EQU 0C75H ; NAS-SYS Input table +NMI EQU 0C7EH ; NAS-SYS NMI Jump + +; BASIC WORK SPACE LOCATIONS + +WRKSPC EQU 1000H ; BASIC Work space +USR EQU 1003H ; "USR (x)" jump +OUTSUB EQU 1006H ; "OUT p,n" +OTPORT EQU 1007H ; Port (p) +DIVSUP EQU 1009H ; Division support routine +DIV1 EQU 100AH ; <- Values +DIV2 EQU 100EH ; <- to +DIV3 EQU 1012H ; <- be +DIV4 EQU 1015H ; <-inserted +SEED EQU 1017H ; Random number seed +LSTRND EQU 103AH ; Last random number +INPSUB EQU 103EH ; #INP (x)" Routine +INPORT EQU 103FH ; PORT (x) +NULLS EQU 1041H ; Number of nulls +LWIDTH EQU 1042H ; Terminal width +COMMAN EQU 1043H ; Width for commas +NULFLG EQU 1044H ; Null after input byte flag +CTLOFG EQU 1045H ; Control "O" flag +LINESC EQU 1046H ; Lines counter +LINESN EQU 1048H ; Lines number +CHKSUM EQU 104AH ; Array load/save check sum +NMIFLG EQU 104CH ; Flag for NMI break routine +BRKFLG EQU 104DH ; Break flag +RINPUT EQU 104EH ; Input reflection +POINT EQU 1051H ; "POINT" reflection (unused) +PSET EQU 1054H ; "SET" reflection +RESET EQU 1057H ; "RESET" reflection +STRSPC EQU 105AH ; Bottom of string space +LINEAT EQU 105CH ; Current line number +BASTXT EQU 105EH ; Pointer to start of program +BUFFER EQU 1061H ; Input buffer +STACK EQU 1066H ; Initial stack +CURPOS EQU 10ABH ; Character position on line +LCRFLG EQU 10ACH ; Locate/Create flag +TYPE EQU 10ADH ; Data type flag +DATFLG EQU 10AEH ; Literal statement flag +LSTRAM EQU 10AFH ; Last available RAM +TMSTPT EQU 10B1H ; Temporary string pointer +TMSTPL EQU 10B3H ; Temporary string pool +TMPSTR EQU 10BFH ; Temporary string +STRBOT EQU 10C3H ; Bottom of string space +CUROPR EQU 10C5H ; Current operator in EVAL +LOOPST EQU 10C7H ; First statement of loop +DATLIN EQU 10C9H ; Line of current DATA item +FORFLG EQU 10CBH ; "FOR" loop flag +LSTBIN EQU 10CCH ; Last byte entered +READFG EQU 10CDH ; Read/Input flag +BRKLIN EQU 10CEH ; Line of break +NXTOPR EQU 10D0H ; Next operator in EVAL +ERRLIN EQU 10D2H ; Line of error +CONTAD EQU 10D4H ; Where to CONTinue +PROGND EQU 10D6H ; End of program +VAREND EQU 10D8H ; End of variables +ARREND EQU 10DAH ; End of arrays +NXTDAT EQU 10DCH ; Next data item +FNRGNM EQU 10DEH ; Name of FN argument +FNARG EQU 10E0H ; FN argument value +FPREG EQU 10E4H ; Floating point register +FPEXP EQU FPREG+3 ; Floating point exponent +SGNRES EQU 10E8H ; Sign of result +PBUFF EQU 10E9H ; Number print buffer +MULVAL EQU 10F6H ; Multiplier +PROGST EQU 10F9H ; Start of program text area +STLOOK EQU 115DH ; Start of memory test + +; BASIC ERROR CODE VALUES + +NF EQU 00H ; NEXT without FOR +SN EQU 02H ; Syntax error +RG EQU 04H ; RETURN without GOSUB +OD EQU 06H ; Out of DATA +FC EQU 08H ; Function call error +OV EQU 0AH ; Overflow +OM EQU 0CH ; Out of memory +UL EQU 0EH ; Undefined line number +BS EQU 10H ; Bad subscript +DD EQU 12H ; Re-DIMensioned array +DZ EQU 14H ; Division by zero (/0) +ID EQU 16H ; Illegal direct +TM EQU 18H ; Type miss-match +OS EQU 1AH ; Out of string space +LS EQU 1CH ; String too long +ST EQU 1EH ; String formula too complex +CN EQU 20H ; Can't CONTinue +UF EQU 22H ; UnDEFined FN function +MO EQU 24H ; Missing operand + + ORG 0E000H + +START: JP STARTB ; Jump for restart jump +STARTB: DI ; No interrupts + LD IX,0 ; Flag cold start + JP CSTART ; Jump to initialise + + DW DEINT ; Get integer -32768 to 32767 + DW ABPASS ; Return integer in AB + + JP LDNMI1 ; << NO REFERENCE TO HERE >> + +CSTART: LD HL,WRKSPC ; Start of workspace RAM + LD SP,HL ; Set up a temporary stack + JP INITST ; Go to initialise + +INIT: LD DE,INITAB ; Initialise workspace + LD B,INITBE-INITAB+3; Bytes to copy + LD HL,WRKSPC ; Into workspace RAM +COPY: LD A,(DE) ; Get source + LD (HL),A ; To destination + INC HL ; Next destination + INC DE ; Next source + DEC B ; Count bytes + JP NZ,COPY ; More to move + LD SP,HL ; Temporary stack + CALL CLREG ; Clear registers and stack + CALL PRNTCR ; Output CRLF + LD (BUFFER+72+1),A ; Mark end of buffer + LD (PROGST),A ; Initialise program area +MSIZE: LD HL,MEMMSG ; Point to message + CALL PRS ; Output "Memory size" + CALL PROMPT ; Get input with "?" + CALL GETCHR ; Get next character + OR A ; Set flags + JP NZ,TSTMEM ; If number - Test if RAM there + LD HL,STLOOK ; Point to start of RAM +MLOOP: INC HL ; Next byte + LD A,H ; Above address FFFF ? + OR L + JP Z,SETTOP ; Yes - 64K RAM + LD A,(HL) ; Get contents + LD B,A ; Save it + CPL ; Flip all bits + LD (HL),A ; Put it back + CP (HL) ; RAM there if same + LD (HL),B ; Restore old contents + JP Z,MLOOP ; If RAM - test next byte + JP SETTOP ; Top of RAM found + +TSTMEM: CALL ATOH ; Get high memory into DE + OR A ; Set flags on last byte + JP NZ,SNERR ; ?SN Error if bad character + EX DE,HL ; Address into HL + DEC HL ; Back one byte + LD A,11011001B ; Test byte + LD B,(HL) ; Get old contents + LD (HL),A ; Load test byte + CP (HL) ; RAM there if same + LD (HL),B ; Restore old contents + JP NZ,MSIZE ; Ask again if no RAM + +SETTOP: DEC HL ; Back one byte + LD DE,STLOOK-1 ; See if enough RAM + CALL CPDEHL ; Compare DE with HL + JP C,MSIZE ; Ask again if not enough RAM + NOP + NOP + NOP + NOP + NOP + NOP + NOP + NOP + NOP + LD DE,0-50 ; 50 Bytes string space + LD (LSTRAM),HL ; Save last available RAM + ADD HL,DE ; Allocate string space + LD (STRSPC),HL ; Save string space + CALL CLRPTR ; Clear program area + LD HL,(STRSPC) ; Get end of memory + LD DE,0-17 ; Offset for free bytes + ADD HL,DE ; Adjust HL + LD DE,PROGST ; Start of program text + LD A,L ; Get LSB + SUB E ; Adjust it + LD L,A ; Re-save + LD A,H ; Get MSB + SBC A,D ; Adjust it + LD H,A ; Re-save + PUSH HL ; Save bytes free + LD HL,SIGNON ; Sign-on message + CALL PRS ; Output string + POP HL ; Get bytes free back + CALL PRNTHL ; Output amount of free memory + LD HL,BFREE ; " Bytes free" message + CALL PRS ; Output string + +WARMST: LD SP,STACK ; Temporary stack +BRKRET: CALL CLREG ; Clear registers and stack + JP PRNTOK ; Go to get command line + +BFREE: DB " Bytes free",CR,0,0 + +SIGNON: DB "NASCOM ROM BASIC Ver 4.7 ",CR + DB "Copyright (C) 1978 by Microsoft",CR,0,0 + +MEMMSG: DB "Memory size",0 + +; FUNCTION ADDRESS TABLE + +FNCTAB: DW SGN + DW INT + DW ABS + DW USR + DW FRE + DW INP + DW POS + DW SQR + DW RND + DW LOG + DW EXP + DW COS + DW SIN + DW TAN + DW ATN + DW PEEK + DW DEEK + DW POINT + DW LEN + DW STR + DW VAL + DW ASC + DW CHR + DW LEFT + DW RIGHT + DW MID + +; RESERVED WORD LIST + +WORDS: DB "E"+80H,"ND" + DB "F"+80H,"OR" + DB "N"+80H,"EXT" + DB "D"+80H,"ATA" + DB "I"+80H,"NPUT" + DB "D"+80H,"IM" + DB "R"+80H,"EAD" + DB "L"+80H,"ET" + DB "G"+80H,"OTO" + DB "R"+80H,"UN" + DB "I"+80H,"F" + DB "R"+80H,"ESTORE" + DB "G"+80H,"OSUB" + DB "R"+80H,"ETURN" + DB "R"+80H,"EM" + DB "S"+80H,"TOP" + DB "O"+80H,"UT" + DB "O"+80H,"N" + DB "N"+80H,"ULL" + DB "W"+80H,"AIT" + DB "D"+80H,"EF" + DB "P"+80H,"OKE" + DB "D"+80H,"OKE" + DB "S"+80H,"CREEN" + DB "L"+80H,"INES" + DB "C"+80H,"LS" + DB "W"+80H,"IDTH" + DB "M"+80H,"ONITOR" + DB "S"+80H,"ET" + DB "R"+80H,"ESET" + DB "P"+80H,"RINT" + DB "C"+80H,"ONT" + DB "L"+80H,"IST" + DB "C"+80H,"LEAR" + DB "C"+80H,"LOAD" + DB "C"+80H,"SAVE" + DB "N"+80H,"EW" + DB "T"+80H,"AB(" + DB "T"+80H,"O" + DB "F"+80H,"N" + DB "S"+80H,"PC(" + DB "T"+80H,"HEN" + DB "N"+80H,"OT" + DB "S"+80H,"TEP" + + DB "+"+80H + DB "-"+80H + DB "*"+80H + DB "/"+80H + DB "^"+80H + DB "A"+80H,"ND" + DB "O"+80H,"R" + DB ">"+80H + DB "="+80H + DB "<"+80H + + DB "S"+80H,"GN" + DB "I"+80H,"NT" + DB "A"+80H,"BS" + DB "U"+80H,"SR" + DB "F"+80H,"RE" + DB "I"+80H,"NP" + DB "P"+80H,"OS" + DB "S"+80H,"QR" + DB "R"+80H,"ND" + DB "L"+80H,"OG" + DB "E"+80H,"XP" + DB "C"+80H,"OS" + DB "S"+80H,"IN" + DB "T"+80H,"AN" + DB "A"+80H,"TN" + DB "P"+80H,"EEK" + DB "D"+80H,"EEK" + DB "P"+80H,"OINT" + DB "L"+80H,"EN" + DB "S"+80H,"TR$" + DB "V"+80H,"AL" + DB "A"+80H,"SC" + DB "C"+80H,"HR$" + DB "L"+80H,"EFT$" + DB "R"+80H,"IGHT$" + DB "M"+80H,"ID$" + DB 80H ; End of list marker + +; KEYWORD ADDRESS TABLE + +WORDTB: DW PEND + DW FOR + DW NEXT + DW DATA + DW INPUT + DW DIM + DW READ + DW LET + DW GOTO + DW RUN + DW IF + DW RESTOR + DW GOSUB + DW RETURN + DW REM + DW STOP + DW POUT + DW ON + DW NULL + DW WAIT + DW DEF + DW POKE + DW DOKE + DW SCREEN + DW LINES + DW CLS + DW WIDTH + DW MONITR + DW PSET + DW RESET + DW PRINT + DW CONT + DW LIST + DW CLEAR + DW CLOAD + DW CSAVE + DW NEW + +; RESERVED WORD TOKEN VALUES + +ZEND EQU 080H ; END +ZFOR EQU 081H ; FOR +ZDATA EQU 083H ; DATA +ZGOTO EQU 088H ; GOTO +ZGOSUB EQU 08CH ; GOSUB +ZREM EQU 08EH ; REM +ZPRINT EQU 09EH ; PRINT +ZNEW EQU 0A4H ; NEW + +ZTAB EQU 0A5H ; TAB +ZTO EQU 0A6H ; TO +ZFN EQU 0A7H ; FN +ZSPC EQU 0A8H ; SPC +ZTHEN EQU 0A9H ; THEN +ZNOT EQU 0AAH ; NOT +ZSTEP EQU 0ABH ; STEP + +ZPLUS EQU 0ACH ; + +ZMINUS EQU 0ADH ; - +ZTIMES EQU 0AEH ; * +ZDIV EQU 0AFH ; / +ZOR EQU 0B2H ; OR +ZGTR EQU 0B3H ; > +ZEQUAL EQU 0B4H ; M +ZLTH EQU 0B5H ; < +ZSGN EQU 0B6H ; SGN +ZPOINT EQU 0C7H ; POINT +ZLEFT EQU 0CDH ; LEFT$ + +; ARITHMETIC PRECEDENCE TABLE + +PRITAB: DB 79H ; Precedence value + DW PADD ; FPREG = + FPREG + + DB 79H ; Precedence value + DW PSUB ; FPREG = - FPREG + + DB 7CH ; Precedence value + DW MULT ; PPREG = * FPREG + + DB 7CH ; Precedence value + DW DIV ; FPREG = / FPREG + + DB 7FH ; Precedence value + DW POWER ; FPREG = ^ FPREG + + DB 50H ; Precedence value + DW PAND ; FPREG = AND FPREG + + DB 46H ; Precedence value + DW POR ; FPREG = OR FPREG + +; BASIC ERROR CODE LIST + +ERRORS: DB "NF" ; NEXT without FOR + DB "SN" ; Syntax error + DB "RG" ; RETURN without GOSUB + DB "OD" ; Out of DATA + DB "FC" ; Illegal function call + DB "OV" ; Overflow error + DB "OM" ; Out of memory + DB "UL" ; Undefined line + DB "BS" ; Bad subscript + DB "DD" ; Re-DIMensioned array + DB "/0" ; Division by zero + DB "ID" ; Illegal direct + DB "TM" ; Type mis-match + DB "OS" ; Out of string space + DB "LS" ; String too long + DB "ST" ; String formula too complex + DB "CN" ; Can't CONTinue + DB "UF" ; Undefined FN function + DB "MO" ; Missing operand + +; INITIALISATION TABLE + +INITAB: JP WARMST ; Warm start jump + JP FCERR ; "USR (X)" jump (Set to Error) + + OUT (0),A ; "OUT p,n" skeleton + RET + + SUB 0 ; Division support routine + LD L,A + LD A,H + SBC A,0 + LD H,A + LD A,B + SBC A,0 + LD B,A + LD A,0 + RET + + DB 0,0,0 ; Random number seed + ; Table used by RND + DB 035H,04AH,0CAH,099H ;-2.65145E+07 + DB 039H,01CH,076H,098H ; 1.61291E+07 + DB 022H,095H,0B3H,098H ;-1.17691E+07 + DB 00AH,0DDH,047H,098H ; 1.30983E+07 + DB 053H,0D1H,099H,099H ;-2-01612E+07 + DB 00AH,01AH,09FH,098H ;-1.04269E+07 + DB 065H,0BCH,0CDH,098H ;-1.34831E+07 + DB 0D6H,077H,03EH,098H ; 1.24825E+07 + DB 052H,0C7H,04FH,080H ; Last random number + + IN A,(0) ; INP (x) skeleton + RET + + DB 1 ; POS (x) number (1) + DB 47 ; Terminal width (47) + DB 28 ; Width for commas (3 columns) + DB 0 ; No nulls after input bytes + DB 0 ; Output enabled (^O off) + + DW 5 ; Initial lines counter + DW 5 ; Initial lines number + DW 0 ; Array load/save check sum + + DB 0 ; Break not by NMI + DB 0 ; Break flag + + JP TTYLIN ; Input reflection (set to TTY) + JP POINTB ; POINT reflection unused + JP SETB ; SET reflection + JP RESETB ; RESET reflection + + DW STLOOK ; Temp string space + DW -2 ; Current line number (cold) + DW PROGST+1 ; Start of program text +INITBE: ; END OF INITIALISATION TABLE + +ERRMSG: DB " Error",0 +INMSG: DB " in ",0 +ZERBYT EQU $-1 ; A zero byte +OKMSG: DB "Ok",CR,0,0 +BRKMSG: DB "Break",0 + +BAKSTK: LD HL,4 ; Look for "FOR" block with + ADD HL,SP ; same index as specified +LOKFOR: LD A,(HL) ; Get block ID + INC HL ; Point to index address + CP ZFOR ; Is it a "FOR" token + RET NZ ; No - exit + LD C,(HL) ; BC = Address of "FOR" index + INC HL + LD B,(HL) + INC HL ; Point to sign of STEP + PUSH HL ; Save pointer to sign + LD L,C ; HL = address of "FOR" index + LD H,B + LD A,D ; See if an index was specified + OR E ; DE = 0 if no index specified + EX DE,HL ; Specified index into HL + JP Z,INDFND ; Skip if no index given + EX DE,HL ; Index back into DE + CALL CPDEHL ; Compare index with one given +INDFND: LD BC,16-3 ; Offset to next block + POP HL ; Restore pointer to sign + RET Z ; Return if block found + ADD HL,BC ; Point to next block + JP LOKFOR ; Keep on looking + +MOVUP: CALL ENFMEM ; See if enough memory +MOVSTR: PUSH BC ; Save end of source + EX (SP),HL ; Swap source and dest" end + POP BC ; Get end of destination +MOVLP: CALL CPDEHL ; See if list moved + LD A,(HL) ; Get byte + LD (BC),A ; Move it + RET Z ; Exit if all done + DEC BC ; Next byte to move to + DEC HL ; Next byte to move + JP MOVLP ; Loop until all bytes moved + +CHKSTK: PUSH HL ; Save code string address + LD HL,(ARREND) ; Lowest free memory + LD B,0 ; BC = Number of levels to test + ADD HL,BC ; 2 Bytes for each level + ADD HL,BC + DB 3EH ; Skip "PUSH HL" +ENFMEM: PUSH HL ; Save code string address + LD A,LOW -48 ; 48 Bytes minimum RAM + SUB L + LD L,A + LD A,HIGH -48 ; 48 Bytes minimum RAM + SBC A,H + JP C,OMERR ; Not enough - ?OM Error + LD H,A + ADD HL,SP ; Test if stack is overflowed + POP HL ; Restore code string address + RET C ; Return if enough mmory +OMERR: LD E,OM ; ?OM Error + JP ERROR + +DATSNR: LD HL,(DATLIN) ; Get line of current DATA item + LD (LINEAT),HL ; Save as current line +SNERR: LD E,SN ; ?SN Error + DB 01H ; Skip "LD E,DZ" +DZERR: LD E,DZ ; ?/0 Error + DB 01H ; Skip "LD E,NF" +NFERR: LD E,NF ; ?NF Error + DB 01H ; Skip "LD E,DD" +DDERR: LD E,DD ; ?DD Error + DB 01H ; Skip "LD E,UF" +UFERR: LD E,UF ; ?UF Error + DB 01H ; Skip "LD E,OV +OVERR: LD E,OV ; ?OV Error + DB 01H ; Skip "LD E,TM" +TMERR: LD E,TM ; ?TM Error + +ERROR: CALL CLREG ; Clear registers and stack + LD (CTLOFG),A ; Enable output (A is 0) + CALL STTLIN ; Start new line + LD HL,ERRORS ; Point to error codes + LD D,A ; D = 0 (A is 0) + LD A,"?" + CALL OUTC ; Output "?" + ADD HL,DE ; Offset to correct error code + LD A,(HL) ; First character + CALL OUTC ; Output it + CALL GETCHR ; Get next character + CALL OUTC ; Output it + LD HL,ERRMSG ; "Error" message +ERRIN: CALL PRS ; Output message + LD HL,(LINEAT) ; Get line of error + LD DE,-2 ; Cold start error if -2 + CALL CPDEHL ; See if cold start error + JP Z,CSTART ; Cold start error - Restart + LD A,H ; Was it a direct error? + AND L ; Line = -1 if direct error + INC A + CALL NZ,LINEIN ; No - output line of error + DB 3EH ; Skip "POP BC" +POPNOK: POP BC ; Drop address in input buffer + +PRNTOK: XOR A ; Output "Ok" and get command + LD (CTLOFG),A ; Enable output + CALL STTLIN ; Start new line + LD HL,OKMSG ; "Ok" message + CALL PRS ; Output "Ok" +GETCMD: LD HL,-1 ; Flag direct mode + LD (LINEAT),HL ; Save as current line + CALL GETLIN ; Get an input line + JP C,GETCMD ; Get line again if break + CALL GETCHR ; Get first character + INC A ; Test if end of line + DEC A ; Without affecting Carry + JP Z,GETCMD ; Nothing entered - Get another + PUSH AF ; Save Carry status + CALL ATOH ; Get line number into DE + PUSH DE ; Save line number + CALL CRUNCH ; Tokenise rest of line + LD B,A ; Length of tokenised line + POP DE ; Restore line number + POP AF ; Restore Carry + JP NC,EXCUTE ; No line number - Direct mode + PUSH DE ; Save line number + PUSH BC ; Save length of tokenised line + XOR A + LD (LSTBIN),A ; Clear last byte input + CALL GETCHR ; Get next character + OR A ; Set flags + PUSH AF ; And save them + CALL SRCHLN ; Search for line number in DE + JP C,LINFND ; Jump if line found + POP AF ; Get status + PUSH AF ; And re-save + JP Z,ULERR ; Nothing after number - Error + OR A ; Clear Carry +LINFND: PUSH BC ; Save address of line in prog + JP NC,INEWLN ; Line not found - Insert new + EX DE,HL ; Next line address in DE + LD HL,(PROGND) ; End of program +SFTPRG: LD A,(DE) ; Shift rest of program down + LD (BC),A + INC BC ; Next destination + INC DE ; Next source + CALL CPDEHL ; All done? + JP NZ,SFTPRG ; More to do + LD H,B ; HL - New end of program + LD L,C + LD (PROGND),HL ; Update end of program + +INEWLN: POP DE ; Get address of line, + POP AF ; Get status + JP Z,SETPTR ; No text - Set up pointers + LD HL,(PROGND) ; Get end of program + EX (SP),HL ; Get length of input line + POP BC ; End of program to BC + ADD HL,BC ; Find new end + PUSH HL ; Save new end + CALL MOVUP ; Make space for line + POP HL ; Restore new end + LD (PROGND),HL ; Update end of program pointer + EX DE,HL ; Get line to move up in HL + LD (HL),H ; Save MSB + POP DE ; Get new line number + INC HL ; Skip pointer + INC HL + LD (HL),E ; Save LSB of line number + INC HL + LD (HL),D ; Save MSB of line number + INC HL ; To first byte in line + LD DE,BUFFER ; Copy buffer to program +MOVBUF: LD A,(DE) ; Get source + LD (HL),A ; Save destinations + INC HL ; Next source + INC DE ; Next destination + OR A ; Done? + JP NZ,MOVBUF ; No - Repeat +SETPTR: CALL RUNFST ; Set line pointers + INC HL ; To LSB of pointer + EX DE,HL ; Address to DE +PTRLP: LD H,D ; Address to HL + LD L,E + LD A,(HL) ; Get LSB of pointer + INC HL ; To MSB of pointer + OR (HL) ; Compare with MSB pointer + JP Z,GETCMD ; Get command line if end + INC HL ; To LSB of line number + INC HL ; Skip line number + INC HL ; Point to first byte in line + XOR A ; Looking for 00 byte +FNDEND: CP (HL) ; Found end of line? + INC HL ; Move to next byte + JP NZ,FNDEND ; No - Keep looking + EX DE,HL ; Next line address to HL + LD (HL),E ; Save LSB of pointer + INC HL + LD (HL),D ; Save MSB of pointer + JP PTRLP ; Do next line + +SRCHLN: LD HL,(BASTXT) ; Start of program text +SRCHLP: LD B,H ; BC = Address to look at + LD C,L + LD A,(HL) ; Get address of next line + INC HL + OR (HL) ; End of program found? + DEC HL + RET Z ; Yes - Line not found + INC HL + INC HL + LD A,(HL) ; Get LSB of line number + INC HL + LD H,(HL) ; Get MSB of line number + LD L,A + CALL CPDEHL ; Compare with line in DE + LD H,B ; HL = Start of this line + LD L,C + LD A,(HL) ; Get LSB of next line address + INC HL + LD H,(HL) ; Get MSB of next line address + LD L,A ; Next line to HL + CCF + RET Z ; Lines found - Exit + CCF + RET NC ; Line not found,at line after + JP SRCHLP ; Keep looking + +NEW: RET NZ ; Return if any more on line +CLRPTR: LD HL,(BASTXT) ; Point to start of program + XOR A ; Set program area to empty + LD (HL),A ; Save LSB = 00 + INC HL + LD (HL),A ; Save MSB = 00 + INC HL + LD (PROGND),HL ; Set program end + +RUNFST: LD HL,(BASTXT) ; Clear all variables + DEC HL + +INTVAR: LD (BRKLIN),HL ; Initialise RUN variables + LD HL,(LSTRAM) ; Get end of RAM + LD (STRBOT),HL ; Clear string space + XOR A + CALL RESTOR ; Reset DATA pointers + LD HL,(PROGND) ; Get end of program + LD (VAREND),HL ; Clear variables + LD (ARREND),HL ; Clear arrays + +CLREG: POP BC ; Save return address + LD HL,(STRSPC) ; Get end of working RAN + LD SP,HL ; Set stack + LD HL,TMSTPL ; Temporary string pool + LD (TMSTPT),HL ; Reset temporary string ptr + XOR A ; A = 00 + LD L,A ; HL = 0000 + LD H,A + LD (CONTAD),HL ; No CONTinue + LD (FORFLG),A ; Clear FOR flag + LD (FNRGNM),HL ; Clear FN argument + PUSH HL ; HL = 0000 + PUSH BC ; Put back return +DOAGN: LD HL,(BRKLIN) ; Get address of code to RUN + RET ; Return to execution driver + +PROMPT: LD A,"?" ; "?" + CALL OUTC ; Output character + LD A," " ; Space + CALL OUTC ; Output character + JP RINPUT ; Get input line + +CRUNCH: XOR A ; Tokenise line @ HL to BUFFER + LD (DATFLG),A ; Reset literal flag + LD C,2+3 ; 2 byte number and 3 nulls + LD DE,BUFFER ; Start of input buffer +CRNCLP: LD A,(HL) ; Get byte + CP " " ; Is it a space? + JP Z,MOVDIR ; Yes - Copy direct + LD B,A ; Save character + CP '"' ; Is it a quote? + JP Z,CPYLIT ; Yes - Copy literal string + OR A ; Is it end of buffer? + JP Z,ENDBUF ; Yes - End buffer + LD A,(DATFLG) ; Get data type + OR A ; Literal? + LD A,(HL) ; Get byte to copy + JP NZ,MOVDIR ; Literal - Copy direct + CP "?" ; Is it "?" short for PRINT + LD A,ZPRINT ; "PRINT" token + JP Z,MOVDIR ; Yes - replace it + LD A,(HL) ; Get byte again + CP "0" ; Is it less than "0" + JP C,FNDWRD ; Yes - Look for reserved words + CP ";"+1 ; Is it "0123456789:;" ? + JP C,MOVDIR ; Yes - copy it direct +FNDWRD: PUSH DE ; Look for reserved words + LD DE,WORDS-1 ; Point to table + PUSH BC ; Save count + LD BC,RETNAD ; Where to return to + PUSH BC ; Save return address + LD B,ZEND-1 ; First token value -1 + LD A,(HL) ; Get byte + CP "a" ; Less than "a" ? + JP C,SEARCH ; Yes - search for words + CP "z"+1 ; Greater than "z" ? + JP NC,SEARCH ; Yes - search for words + AND 01011111B ; Force upper case + LD (HL),A ; Replace byte +SEARCH: LD C,(HL) ; Search for a word + EX DE,HL +GETNXT: INC HL ; Get next reserved word + OR (HL) ; Start of word? + JP P,GETNXT ; No - move on + INC B ; Increment token value + LD A, (HL) ; Get byte from table + AND 01111111B ; Strip bit 7 + RET Z ; Return if end of list + CP C ; Same character as in buffer? + JP NZ,GETNXT ; No - get next word + EX DE,HL + PUSH HL ; Save start of word + +NXTBYT: INC DE ; Look through rest of word + LD A,(DE) ; Get byte from table + OR A ; End of word ? + JP M,MATCH ; Yes - Match found + LD C,A ; Save it + LD A,B ; Get token value + CP ZGOTO ; Is it "GOTO" token ? + JP NZ,NOSPC ; No - Don't allow spaces + CALL GETCHR ; Get next character + DEC HL ; Cancel increment from GETCHR +NOSPC: INC HL ; Next byte + LD A,(HL) ; Get byte + CP "a" ; Less than "a" ? + JP C,NOCHNG ; Yes - don't change + AND 01011111B ; Make upper case +NOCHNG: CP C ; Same as in buffer ? + JP Z,NXTBYT ; Yes - keep testing + POP HL ; Get back start of word + JP SEARCH ; Look at next word + +MATCH: LD C,B ; Word found - Save token value + POP AF ; Throw away return + EX DE,HL + RET ; Return to "RETNAD" +RETNAD: EX DE,HL ; Get address in string + LD A,C ; Get token value + POP BC ; Restore buffer length + POP DE ; Get destination address +MOVDIR: INC HL ; Next source in buffer + LD (DE),A ; Put byte in buffer + INC DE ; Move up buffer + INC C ; Increment length of buffer + SUB ":" ; End of statement? + JP Z,SETLIT ; Jump if multi-statement line + CP ZDATA-3AH ; Is it DATA statement ? + JP NZ,TSTREM ; No - see if REM +SETLIT: LD (DATFLG),A ; Set literal flag +TSTREM: SUB ZREM-3AH ; Is it REM? + JP NZ,CRNCLP ; No - Leave flag + LD B,A ; Copy rest of buffer +NXTCHR: LD A,(HL) ; Get byte + OR A ; End of line ? + JP Z,ENDBUF ; Yes - Terminate buffer + CP B ; End of statement ? + JP Z,MOVDIR ; Yes - Get next one +CPYLIT: INC HL ; Move up source string + LD (DE),A ; Save in destination + INC C ; Increment length + INC DE ; Move up destination + JP NXTCHR ; Repeat + +ENDBUF: LD HL,BUFFER-1 ; Point to start of buffer + LD (DE),A ; Mark end of buffer (A = 00) + INC DE + LD (DE),A ; A = 00 + INC DE + LD (DE),A ; A = 00 + RET + +DODEL: LD A,(NULFLG) ; Get null flag status + OR A ; Is it zero? + LD A,0 ; Zero A - Leave flags + LD (NULFLG),A ; Zero null flag + JP NZ,ECHDEL ; Set - Echo it + DEC B ; Decrement length + JP Z,GETLIN ; Get line again if empty + CALL OUTC ; Output null character + DB 3EH ; Skip "DEC B" +ECHDEL: DEC B ; Count bytes in buffer + DEC HL ; Back space buffer + JP Z,OTKLN ; No buffer - Try again + LD A,(HL) ; Get deleted byte + CALL OUTC ; Echo it + JP MORINP ; Get more input + +DELCHR: DEC B ; Count bytes in buffer + DEC HL ; Back space buffer + CALL OUTC ; Output character in A + JP NZ,MORINP ; Not end - Get more +OTKLN: CALL OUTC ; Output character in A +KILIN: CALL PRNTCR ; Output CRLF + JP TTYLIN ; Get line again + +GETLIN: CALL MONTST ; Is it NAS-SYS? + JP Z,TTYLIN ; No - Character input + LD HL,(CIN) ; Point to NAS-SYS input table + LD A,(HL) ; Get input mode + CP 74H ; Is it "X" mode? + JP Z,TTYLIN ; Yes - Teletype line input + CALL INLINE ; Get a line from NAS-SYS + JP DONULL ; POS(X)=0 and do nulls + +TTYLIN: LD HL,BUFFER ; Get a line by character + LD B,1 ; Set buffer as empty + XOR A + LD (NULFLG),A ; Clear null flag +MORINP: CALL CLOTST ; Get character and test ^O + LD C,A ; Save character in C + CP DEL ; Delete character? + JP Z,DODEL ; Yes - Process it + LD A,(NULFLG) ; Get null flag + OR A ; Test null flag status + JP Z,PROCES ; Reset - Process character + LD A,0 ; Set a null + CALL OUTC ; Output null + XOR A ; Clear A + LD (NULFLG),A ; Reset null flag +PROCES: LD A,C ; Get character + CP CTRLG ; Bell? + JP Z,PUTCTL ; Yes - Save it + CP CTRLC ; Is it control "C"? + CALL Z,PRNTCR ; Yes - Output CRLF + SCF ; Flag break + RET Z ; Return if control "C" + CP CR ; Is it enter? + JP Z,ENDINP ; Yes - Terminate input + CP CTRLU ; Is it control "U"? + JP Z,KILIN ; Yes - Get another line + CP "@" ; Is it "kill line"? + JP Z,OTKLN ; Yes - Kill line + CP "_" ; Is it delete? + JP Z,DELCHR ; Yes - Delete character + CP BKSP ; Is it backspace? + JP Z,DELCHR ; Yes - Delete character + CP CTRLR ; Is it control "R"? + JP NZ,PUTBUF ; No - Put in buffer + PUSH BC ; Save buffer length + PUSH DE ; Save DE + PUSH HL ; Save buffer address + LD (HL),0 ; Mark end of buffer + CALL OUTNCR ; Output and do CRLF + LD HL,BUFFER ; Point to buffer start + CALL PRS ; Output buffer + POP HL ; Restore buffer address + POP DE ; Restore DE + POP BC ; Restore buffer length + JP MORINP ; Get another character + +PUTBUF: CP " " ; Is it a control code? + JP C,MORINP ; Yes - Ignore +PUTCTL: LD A,B ; Get number of bytes in buffer + CP 72+1 ; Test for line overflow + LD A,CTRLG ; Set a bell + JP NC,OUTNBS ; Ring bell if buffer full + LD A,C ; Get character + LD (HL),C ; Save in buffer + LD (LSTBIN),A ; Save last input byte + INC HL ; Move up buffer + INC B ; Increment length +OUTIT: CALL OUTC ; Output the character entered + JP MORINP ; Get another character + +OUTNBS: CALL OUTC ; Output bell and back over it + LD A,BKSP ; Set back space + JP OUTIT ; Output it and get more + +CPDEHL: LD A,H ; Get H + SUB D ; Compare with D + RET NZ ; Different - Exit + LD A,L ; Get L + SUB E ; Compare with E + RET ; Return status + +CHKSYN: LD A,(HL) ; Check syntax of character + EX (SP),HL ; Address of test byte + CP (HL) ; Same as in code string? + INC HL ; Return address + EX (SP),HL ; Put it back + JP Z,GETCHR ; Yes - Get next character + JP SNERR ; Different - ?SN Error + +OUTC: PUSH AF ; Save character + LD A,(CTLOFG) ; Get control "O" flag + OR A ; Is it set? + JP NZ,POPAF ; Yes - don't output + POP AF ; Restore character + PUSH BC ; Save buffer length + PUSH AF ; Save character + CP " " ; Is it a control code? + JP C,DINPOS ; Yes - Don't INC POS(X) + LD A,(LWIDTH) ; Get line width + LD B,A ; To B + LD A,(CURPOS) ; Get cursor position + INC B ; Width 255? + JP Z,INCLEN ; Yes - No width limit + DEC B ; Restore width + CP B ; At end of line? + CALL Z,PRNTCR ; Yes - output CRLF +INCLEN: INC A ; Move on one character + LD (CURPOS),A ; Save new position +DINPOS: POP AF ; Restore character + POP BC ; Restore buffer length + PUSH AF ; << This sequence >> + POP AF ; << is not needed >> + PUSH AF ; Save character + PUSH BC ; Save buffer length + LD C,A ; Character to C + CALL CONMON ; Send it + POP BC ; Restore buffer length + POP AF ; Restore character + RET + +CLOTST: CALL GETINP ; Get input character + AND 01111111B ; Strip bit 7 + CP CTRLO ; Is it control "O"? + RET NZ ; No don't flip flag + LD A,(CTLOFG) ; Get flag + CPL ; Flip it + LD (CTLOFG),A ; Put it back + XOR A ; Null character + RET + +LIST: CALL ATOH ; ASCII number to DE + RET NZ ; Return if anything extra + POP BC ; Rubbish - Not needed + CALL SRCHLN ; Search for line number in DE + PUSH BC ; Save address of line + CALL SETLIN ; Set up lines counter +LISTLP: POP HL ; Restore address of line + LD C,(HL) ; Get LSB of next line + INC HL + LD B,(HL) ; Get MSB of next line + INC HL + LD A,B ; BC = 0 (End of program)? + OR C + JP Z,PRNTOK ; Yes - Go to command mode + CALL COUNT ; Count lines + CALL TSTBRK ; Test for break key + PUSH BC ; Save address of next line + CALL PRNTCR ; Output CRLF + LD E,(HL) ; Get LSB of line number + INC HL + LD D,(HL) ; Get MSB of line number + INC HL + PUSH HL ; Save address of line start + EX DE,HL ; Line number to HL + CALL PRNTHL ; Output line number in decimal + LD A," " ; Space after line number + POP HL ; Restore start of line address +LSTLP2: CALL OUTC ; Output character in A +LSTLP3: LD A,(HL) ; Get next byte in line + OR A ; End of line? + INC HL ; To next byte in line + JP Z,LISTLP ; Yes - get next line + JP P,LSTLP2 ; No token - output it + SUB ZEND-1 ; Find and output word + LD C,A ; Token offset+1 to C + LD DE,WORDS ; Reserved word list +FNDTOK: LD A,(DE) ; Get character in list + INC DE ; Move on to next + OR A ; Is it start of word? + JP P,FNDTOK ; No - Keep looking for word + DEC C ; Count words + JP NZ,FNDTOK ; Not there - keep looking +OUTWRD: AND 01111111B ; Strip bit 7 + CALL OUTC ; Output first character + LD A,(DE) ; Get next character + INC DE ; Move on to next + OR A ; Is it end of word? + JP P,OUTWRD ; No - output the rest + JP LSTLP3 ; Next byte in line + +SETLIN: PUSH HL ; Set up LINES counter + LD HL,(LINESN) ; Get LINES number + LD (LINESC),HL ; Save in LINES counter + POP HL + RET + +LDNMI1: LD HL,BREAK ; Break routine + LD (NMI),HL ; NMI forces break + JP PRNTOK ; Go to command mode + + DB 0FEH ; <<< NO REFERENCE TO HERE >>> + +COUNT: PUSH HL ; Save code string address + PUSH DE + LD HL,(LINESC) ; Get LINES counter + LD DE,-1 + ADC HL,DE ; Decrement + LD (LINESC),HL ; Put it back + POP DE + POP HL ; Restore code string address + RET P ; Return if more lines to go + PUSH HL ; Save code string address + LD HL,(LINESN) ; Get LINES number + LD (LINESC),HL ; Reset LINES counter + LD A,(NMIFLG) ; Break by NMI? + OR A + JP NZ,ARETN ; Yes - "RETN" + CALL GETINP ; Get input character + CP CTRLC ; Is it control "C"? + JP Z,RSLNBK ; Yes - Reset LINES an break + POP HL ; Restore code string address + JP COUNT ; Keep on counting + +RSLNBK: LD HL,(LINESN) ; Get LINES number + LD (LINESC),HL ; Reset LINES counter + JP BRKRET ; Go and output "Break" + +FOR: LD A,64H ; Flag "FOR" assignment + LD (FORFLG),A ; Save "FOR" flag + CALL LET ; Set up initial index + POP BC ; Drop RETurn address + PUSH HL ; Save code string address + CALL DATA ; Get next statement address + LD (LOOPST),HL ; Save it for start of loop + LD HL,2 ; Offset for "FOR" block + ADD HL,SP ; Point to it +FORSLP: CALL LOKFOR ; Look for existing "FOR" block + POP DE ; Get code string address + JP NZ,FORFND ; No nesting found + ADD HL,BC ; Move into "FOR" block + PUSH DE ; Save code string address + DEC HL + LD D,(HL) ; Get MSB of loop statement + DEC HL + LD E,(HL) ; Get LSB of loop statement + INC HL + INC HL + PUSH HL ; Save block address + LD HL,(LOOPST) ; Get address of loop statement + CALL CPDEHL ; Compare the FOR loops + POP HL ; Restore block address + JP NZ,FORSLP ; Different FORs - Find another + POP DE ; Restore code string address + LD SP,HL ; Remove all nested loops + +FORFND: EX DE,HL ; Code string address to HL + LD C,8 + CALL CHKSTK ; Check for 8 levels of stack + PUSH HL ; Save code string address + LD HL,(LOOPST) ; Get first statement of loop + EX (SP),HL ; Save and restore code string + PUSH HL ; Re-save code string address + LD HL,(LINEAT) ; Get current line number + EX (SP),HL ; Save and restore code string + CALL TSTNUM ; Make sure it's a number + CALL CHKSYN ; Make sure "TO" is next + DB ZTO ; "TO" token + CALL GETNUM ; Get "TO" expression value + PUSH HL ; Save code string address + CALL BCDEFP ; Move "TO" value to BCDE + POP HL ; Restore code string address + PUSH BC ; Save "TO" value in block + PUSH DE + LD BC,8100H ; BCDE - 1 (default STEP) + LD D,C ; C=0 + LD E,D ; D=0 + LD A,(HL) ; Get next byte in code string + CP ZSTEP ; See if "STEP" is stated + LD A,1 ; Sign of step = 1 + JP NZ,SAVSTP ; No STEP given - Default to 1 + CALL GETCHR ; Jump over "STEP" token + CALL GETNUM ; Get step value + PUSH HL ; Save code string address + CALL BCDEFP ; Move STEP to BCDE + CALL TSTSGN ; Test sign of FPREG + POP HL ; Restore code string address +SAVSTP: PUSH BC ; Save the STEP value in block + PUSH DE + PUSH AF ; Save sign of STEP + INC SP ; Don't save flags + PUSH HL ; Save code string address + LD HL,(BRKLIN) ; Get address of index variable + EX (SP),HL ; Save and restore code string +PUTFID: LD B,ZFOR ; "FOR" block marker + PUSH BC ; Save it + INC SP ; Don't save C + +RUNCNT: CALL CHKBRK ; Execution driver - Test break + OR A ; Break key hit? + CALL NZ,STALL ; Yes - Pause for a key + LD (BRKLIN),HL ; Save code address for break + LD A,(HL) ; Get next byte in code string + CP ":" ; Multi statement line? + JP Z,EXCUTE ; Yes - Execute it + OR A ; End of line? + JP NZ,SNERR ; No - Syntax error + INC HL ; Point to address of next line + LD A,(HL) ; Get LSB of line pointer + INC HL + OR (HL) ; Is it zero (End of prog)? + JP Z,ENDPRG ; Yes - Terminate execution + INC HL ; Point to line number + LD E,(HL) ; Get LSB of line number + INC HL + LD D,(HL) ; Get MSB of line number + EX DE,HL ; Line number to HL + LD (LINEAT),HL ; Save as current line number + EX DE,HL ; Line number back to DE +EXCUTE: CALL GETCHR ; Get key word + LD DE,RUNCNT ; Where to RETurn to + PUSH DE ; Save for RETurn +IFJMP: RET Z ; Go to RUNCNT if end of STMT +ONJMP: SUB ZEND ; Is it a token? + JP C,LET ; No - try to assign it + CP ZNEW+1-ZEND ; END to NEW ? + JP NC,SNERR ; Not a key word - ?SN Error + RLCA ; Double it + LD C,A ; BC = Offset into table + LD B,0 + EX DE,HL ; Save code string address + LD HL,WORDTB ; Keyword address table + ADD HL,BC ; Point to routine address + LD C,(HL) ; Get LSB of routine address + INC HL + LD B,(HL) ; Get MSB of routine address + PUSH BC ; Save routine address + EX DE,HL ; Restore code string address + +GETCHR: INC HL ; Point to next character + LD A,(HL) ; Get next code string byte + CP ":" ; Z if ":" + RET NC ; NC if > "9" + CP " " + JP Z,GETCHR ; Skip over spaces + CP "0" + CCF ; NC if < "0" + INC A ; Test for zero - Leave carry + DEC A ; Z if Null + RET + +RESTOR: EX DE,HL ; Save code string address + LD HL,(BASTXT) ; Point to start of program + JP Z,RESTNL ; Just RESTORE - reset pointer + EX DE,HL ; Restore code string address + CALL ATOH ; Get line number to DE + PUSH HL ; Save code string address + CALL SRCHLN ; Search for line number in DE + LD H,B ; HL = Address of line + LD L,C + POP DE ; Restore code string address + JP NC,ULERR ; ?UL Error if not found +RESTNL: DEC HL ; Byte before DATA statement +UPDATA: LD (NXTDAT),HL ; Update DATA pointer + EX DE,HL ; Restore code string address + RET + +TSTBRK: CALL CHKBRK ; Test for interrupts + OR A + RET Z ; Return if no key pressed +STALL: CALL CLOTST ; Get input and test for ^O + CP CTRLS ; Is it control "S" + CALL Z,CLOTST ; Yes - Get another character + CP CTRLC ; Return if not control "C" +STOP: RET NZ ; Exit if anything else + DB 0F6H ; Flag "STOP" +PEND: RET NZ ; Exit if anything else + LD (BRKLIN),HL ; Save point of break + DB 21H ; Skip "OR 11111111B" +INPBRK: OR 11111111B ; Flag "Break" wanted + POP BC ; Return not needed and more +ENDPRG: LD HL,(LINEAT) ; Get current line number + PUSH AF ; Save STOP / END status + LD A,L ; Is it direct break? + AND H + INC A ; Line is -1 if direct break + JP Z,NOLIN ; Yes - No line number + LD (ERRLIN),HL ; Save line of break + LD HL,(BRKLIN) ; Get point of break + LD (CONTAD),HL ; Save point to CONTinue +NOLIN: XOR A + LD (CTLOFG),A ; Enable output + CALL STTLIN ; Start a new line + POP AF ; Restore STOP / END status + LD HL,BRKMSG ; "Break" message + JP NZ,ERRIN ; "in line" wanted? + JP PRNTOK ; Go to command mode + +CONT: LD HL,(CONTAD) ; Get CONTinue address + LD A,H ; Is it zero? + OR L + LD E,CN ; ?CN Error + JP Z,ERROR ; Yes - output "?CN Error" + EX DE,HL ; Save code string address + LD HL,(ERRLIN) ; Get line of last break + LD (LINEAT),HL ; Set up current line number + EX DE,HL ; Restore code string address + RET ; CONTinue where left off + +NULL: CALL GETINT ; Get integer 0-255 + RET NZ ; Return if bad value + LD (NULLS),A ; Set nulls number + RET + +ARRLD1: LD B,-1 ; Flag array load +ARRSV1: CALL GETCHR ; Skip "*" + LD A,B ; CLOAD* or CSAVE* + LD (BRKLIN),A ; Save it + LD A,1 ; It's an array + LD (FORFLG),A ; Flag array name + CALL GETVAR ; Get address of array name + PUSH HL ; Save code string address + LD (FORFLG),A ; Clear flag + LD H,B ; Address of array to HL + LD L,C + DEC BC ; Back space + DEC BC ; to point + DEC BC ; to the + DEC BC ; array name + LD A,(BRKLIN) ; CLOAD* or CSAVE* ? + OR A + PUSH AF ; Save CLOAD* / CSAVE* status + EX DE,HL ; Array data length + ADD HL,DE ; End of data + EX DE,HL ; To DE + LD C,(HL) ; Get dimension bytes + LD B,0 + ADD HL,BC ; 2 Bytes each dimension + ADD HL,BC + INC HL ; Over number of dimensions + PUSH HL ; Address of array data + PUSH DE ; End of array data + PUSH BC ; Number of dimensions + LD A,(BRKLIN) ; CLOAD* or CSAVE* ? + CP -1 + CALL Z,CASFF ; CLOAD* - Cassette on + LD A,(BRKLIN) ; CLOAD* or CSAVE* ? + CP -1 + CALL NZ,CASFFW ; CSAVE* - Cassette on and wait + NOP + NOP + NOP + LD HL,0 + LD (CHKSUM),HL ; Zero check sum + POP BC ; Number of dimensions + POP DE ; End of array data + POP HL ; Address of array data + LD B,11010010B ; Header byte + JP JPLDSV ; CSAVE-SNDHDR , CLOAD-GETHDR + +SNDHDR: LD A,B ; Get header byte + CALL WUART2 ; Send 2 bytes to UART + CALL WUART2 ; Send 2 bytes to UART + JP SNDARY ; Send array data + +GETHDR: LD C,4 ; 4 Bytes to check +HDRLP: CALL RUART ; Read byte from UART + CP B ; Same as header? + JP NZ,GETHDR ; No - Wait for another + DEC C ; Count bytes + JP NZ,HDRLP ; More needed +SNDARY: CALL TSTNUM ; Check it's a numerical array +ARYLP: CALL CPDEHL ; All array data done + JP Z,SUMOFF ; Yes - Do check sum + POP AF ; CLOAD* or CSAVE* ? + PUSH AF ; Re-save flags + LD A,(HL) ; Get byte + CALL P,WUART ; CSAVE* - Write byte + CALL M,RUART ; CLOAD* - Read byte + LD (HL),A ; Save byte in case of CLOAD* + CALL ACCSUM ; Accumulate check sum + INC HL ; Next byte + JP ARYLP ; Repeat + +SUMOFF: CALL DOSUM ; Do check sum + CALL CASFF ; Cassette off + POP AF ; Not needed any more + POP HL ; Restore code string address + RET + +ACCSUM: PUSH HL ; Save address in array + LD HL,(CHKSUM) ; Get check sum + LD B,0 ; BC - Value of byte + LD C,A + ADD HL,BC ; Add byte to check sum + LD (CHKSUM),HL ; Re-save check sum + POP HL ; Restore address in array + RET + +DOSUM: LD A,(BRKLIN) ; CLOAD* or CSAVE* ? + OR A + JP M,CHSUMS ; CLOAD* - Check if sums match + LD A,(CHKSUM) ; Get LSB of check sum + CALL WUART ; Write to UART + LD A,(CHKSUM+1) ; Get MSB of check sum + JP WUART ; Write to UART and return + +CHSUMS: CALL RUART ; Read LSB of check sum + PUSH AF ; Save it + CALL RUART ; Read MSB of check sum + POP BC ; LSB to B + LD E,B ; LSB to E + LD D,A ; MSB to D + LD HL,(CHKSUM) ; Get accumulated check sum + CALL CPDEHL ; Are they the same? + RET Z ; Yes - End CLOAD* + CALL CASFF ; Cassette off + JP OUTBAD ; Different - Output "Bad" + +CHKLTR: LD A,(HL) ; Get byte + CP "A" ; < "A" ? + RET C ; Carry set if not letter + CP "Z"+1 ; > "Z" ? + CCF + RET ; Carry set if not letter + +FPSINT: CALL GETCHR ; Get next character +POSINT: CALL GETNUM ; Get integer 0 to 32767 +DEPINT: CALL TSTSGN ; Test sign of FPREG + JP M,FCERR ; Negative - ?FC Error +DEINT: LD A,(FPEXP) ; Get integer value to DE + CP 80H+16 ; Exponent in range (16 bits)? + JP C,FPINT ; Yes - convert it + LD BC,9080H ; BCDE = -32768 + LD DE,0000 + PUSH HL ; Save code string address + CALL CMPNUM ; Compare FPREG with BCDE + POP HL ; Restore code string address + LD D,C ; MSB to D + RET Z ; Return if in range +FCERR: LD E,FC ; ?FC Error + JP ERROR ; Output error- + +ATOH: DEC HL ; ASCII number to DE binary +GETLN: LD DE,0 ; Get number to DE +GTLNLP: CALL GETCHR ; Get next character + RET NC ; Exit if not a digit + PUSH HL ; Save code string address + PUSH AF ; Save digit + LD HL,65529/10 ; Largest number 65529 + CALL CPDEHL ; Number in range? + JP C,SNERR ; No - ?SN Error + LD H,D ; HL = Number + LD L,E + ADD HL,DE ; Times 2 + ADD HL,HL ; Times 4 + ADD HL,DE ; Times 5 + ADD HL,HL ; Times 10 + POP AF ; Restore digit + SUB "0" ; Make it 0 to 9 + LD E,A ; DE = Value of digit + LD D,0 + ADD HL,DE ; Add to number + EX DE,HL ; Number to DE + POP HL ; Restore code string address + JP GTLNLP ; Go to next character + +CLEAR: JP Z,INTVAR ; Just "CLEAR" Keep parameters + CALL POSINT ; Get integer 0 to 32767 to DE + DEC HL ; Cancel increment + CALL GETCHR ; Get next character + PUSH HL ; Save code string address + LD HL,(LSTRAM) ; Get end of RAM + JP Z,STORED ; No value given - Use stored + POP HL ; Restore code string address + CALL CHKSYN ; Check for comma + DB "," + PUSH DE ; Save number + CALL POSINT ; Get integer 0 to 32767 + DEC HL ; Cancel increment + CALL GETCHR ; Get next character + JP NZ,SNERR ; ?SN Error if more on line + EX (SP),HL ; Save code string address + EX DE,HL ; Number to DE +STORED: LD A,L ; Get LSB of new RAM top + SUB E ; Subtract LSB of string space + LD E,A ; Save LSB + LD A,H ; Get MSB of new RAM top + SBC A,D ; Subtract MSB of string space + LD D,A ; Save MSB + JP C,OMERR ; ?OM Error if not enough mem + PUSH HL ; Save RAM top + LD HL,(PROGND) ; Get program end + LD BC,40 ; 40 Bytes minimum working RAM + ADD HL,BC ; Get lowest address + CALL CPDEHL ; Enough memory? + JP NC,OMERR ; No - ?OM Error + EX DE,HL ; RAM top to HL + LD (STRSPC),HL ; Set new string space + POP HL ; End of memory to use + LD (LSTRAM),HL ; Set new top of RAM + POP HL ; Restore code string address + JP INTVAR ; Initialise variables + +RUN: JP Z,RUNFST ; RUN from start if just RUN + CALL INTVAR ; Initialise variables + LD BC,RUNCNT ; Execution driver loop + JP RUNLIN ; RUN from line number + +GOSUB: LD C,3 ; 3 Levels of stack needed + CALL CHKSTK ; Check for 3 levels of stack + POP BC ; Get return address + PUSH HL ; Save code string for RETURN + PUSH HL ; And for GOSUB routine + LD HL,(LINEAT) ; Get current line + EX (SP),HL ; Into stack - Code string out + LD A,ZGOSUB ; "GOSUB" token + PUSH AF ; Save token + INC SP ; Don't save flags + +RUNLIN: PUSH BC ; Save return address +GOTO: CALL ATOH ; ASCII number to DE binary + CALL REM ; Get end of line + PUSH HL ; Save end of line + LD HL,(LINEAT) ; Get current line + CALL CPDEHL ; Line after current? + POP HL ; Restore end of line + INC HL ; Start of next line + CALL C,SRCHLP ; Line is after current line + CALL NC,SRCHLN ; Line is before current line + LD H,B ; Set up code string address + LD L,C + DEC HL ; Incremented after + RET C ; Line found +ULERR: LD E,UL ; ?UL Error + JP ERROR ; Output error message + +RETURN: RET NZ ; Return if not just RETURN + LD D,-1 ; Flag "GOSUB" search + CALL BAKSTK ; Look "GOSUB" block + LD SP,HL ; Kill all FORs in subroutine + CP ZGOSUB ; Test for "GOSUB" token + LD E,RG ; ?RG Error + JP NZ,ERROR ; Error if no "GOSUB" found + POP HL ; Get RETURN line number + LD (LINEAT),HL ; Save as current + INC HL ; Was it from direct statement? + LD A,H + OR L ; Return to line + JP NZ,RETLIN ; No - Return to line + LD A,(LSTBIN) ; Any INPUT in subroutine? + OR A ; If so buffer is corrupted + JP NZ,POPNOK ; Yes - Go to command mode +RETLIN: LD HL,RUNCNT ; Execution driver loop + EX (SP),HL ; Into stack - Code string out + DB 3EH ; Skip "POP HL" +NXTDTA: POP HL ; Restore code string address + +DATA: DB 01H,3AH ; ":" End of statement +REM: LD C,0 ; 00 End of statement + LD B,0 +NXTSTL: LD A,C ; Statement and byte + LD C,B + LD B,A ; Statement end byte +NXTSTT: LD A,(HL) ; Get byte + OR A ; End of line? + RET Z ; Yes - Exit + CP B ; End of statement? + RET Z ; Yes - Exit + INC HL ; Next byte + CP '"' ; Literal string? + JP Z,NXTSTL ; Yes - Look for another '"' + JP NXTSTT ; Keep looking + +LET: CALL GETVAR ; Get variable name + CALL CHKSYN ; Make sure "=" follows + DB ZEQUAL ; "=" token + PUSH DE ; Save address of variable + LD A,(TYPE) ; Get data type + PUSH AF ; Save type + CALL EVAL ; Evaluate expression + POP AF ; Restore type + EX (SP),HL ; Save code - Get var addr + LD (BRKLIN),HL ; Save address of variable + RRA ; Adjust type + CALL CHKTYP ; Check types are the same + JP Z,LETNUM ; Numeric - Move value +LETSTR: PUSH HL ; Save address of string var + LD HL,(FPREG) ; Pointer to string entry + PUSH HL ; Save it on stack + INC HL ; Skip over length + INC HL + LD E,(HL) ; LSB of string address + INC HL + LD D,(HL) ; MSB of string address + LD HL,(BASTXT) ; Point to start of program + CALL CPDEHL ; Is string before program? + JP NC,CRESTR ; Yes - Create string entry + LD HL,(STRSPC) ; Point to string space + CALL CPDEHL ; Is string literal in program? + POP DE ; Restore address of string + JP NC,MVSTPT ; Yes - Set up pointer + LD HL,TMPSTR ; Temporary string pool + CALL CPDEHL ; Is string in temporary pool? + JP NC,MVSTPT ; No - Set up pointer + DB 3EH ; Skip "POP DE" +CRESTR: POP DE ; Restore address of string + CALL BAKTMP ; Back to last tmp-str entry + EX DE,HL ; Address of string entry + CALL SAVSTR ; Save string in string area +MVSTPT: CALL BAKTMP ; Back to last tmp-str entry + POP HL ; Get string pointer + CALL DETHL4 ; Move string pointer to var + POP HL ; Restore code string address + RET + +LETNUM: PUSH HL ; Save address of variable + CALL FPTHL ; Move value to variable + POP DE ; Restore address of variable + POP HL ; Restore code string address + RET + +ON: CALL GETINT ; Get integer 0-255 + LD A,(HL) ; Get "GOTO" or "GOSUB" token + LD B,A ; Save in B + CP ZGOSUB ; "GOSUB" token? + JP Z,ONGO ; Yes - Find line number + CALL CHKSYN ; Make sure it's "GOTO" + DB ZGOTO ; "GOTO" token + DEC HL ; Cancel increment +ONGO: LD C,E ; Integer of branch value +ONGOLP: DEC C ; Count branches + LD A,B ; Get "GOTO" or "GOSUB" token + JP Z,ONJMP ; Go to that line if right one + CALL GETLN ; Get line number to DE + CP "," ; Another line number? + RET NZ ; No - Drop through + JP ONGOLP ; Yes - loop + +IF: CALL EVAL ; Evaluate expression + LD A,(HL) ; Get token + CP ZGOTO ; "GOTO" token? + JP Z,IFGO ; Yes - Get line + CALL CHKSYN ; Make sure it's "THEN" + DB ZTHEN ; "THEN" token + DEC HL ; Cancel increment +IFGO: CALL TSTNUM ; Make sure it's numeric + CALL TSTSGN ; Test state of expression + JP Z,REM ; False - Drop through + CALL GETCHR ; Get next character + JP C,GOTO ; Number - GOTO that line + JP IFJMP ; Otherwise do statement + +MRPRNT: DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character +PRINT: JP Z,PRNTCR ; CRLF if just PRINT +PRNTLP: RET Z ; End of list - Exit + CP ZTAB ; "TAB(" token? + JP Z,DOTAB ; Yes - Do TAB routine + CP ZSPC ; "SPC(" token? + JP Z,DOTAB ; Yes - Do SPC routine + PUSH HL ; Save code string address + CP "," ; Comma? + JP Z,DOCOM ; Yes - Move to next zone + CP ";" ; Semi-colon? + JP Z,NEXITM ; Do semi-colon routine + POP BC ; Code string address to BC + CALL EVAL ; Evaluate expression + PUSH HL ; Save code string address + LD A,(TYPE) ; Get variable type + OR A ; Is it a string variable? + JP NZ,PRNTST ; Yes - Output string contents + CALL NUMASC ; Convert number to text + CALL CRTST ; Create temporary string + LD (HL)," " ; Followed by a space + LD HL,(FPREG) ; Get length of output + INC (HL) ; Plus 1 for the space + LD HL,(FPREG) ; < Not needed > + LD A,(LWIDTH) ; Get width of line + LD B,A ; To B + INC B ; Width 255 (No limit)? + JP Z,PRNTNB ; Yes - Output number string + INC B ; Adjust it + LD A,(CURPOS) ; Get cursor position + ADD A,(HL) ; Add length of string + DEC A ; Adjust it + CP B ; Will output fit on this line? + CALL NC,PRNTCR ; No - CRLF first +PRNTNB: CALL PRS1 ; Output string at (HL) + XOR A ; Skip CALL by setting "Z" flag +PRNTST: CALL NZ,PRS1 ; Output string at (HL) + POP HL ; Restore code string address + JP MRPRNT ; See if more to PRINT + +STTLIN: LD A,(CURPOS) ; Make sure on new line + OR A ; Already at start? + RET Z ; Yes - Do nothing + JP PRNTCR ; Start a new line + +ENDINP: LD (HL),0 ; Mark end of buffer + LD HL,BUFFER-1 ; Point to buffer +PRNTCR: LD A,CR ; Load a CR + CALL OUTC ; Output character +DONULL: XOR A ; Set to position 0 + LD (CURPOS),A ; Store it + LD A,(NULLS) ; Get number of nulls +NULLP: DEC A ; Count them + RET Z ; Return if done + PUSH AF ; Save count + XOR A ; Load a null + CALL OUTC ; Output it + POP AF ; Restore count + JP NULLP ; Keep counting + +DOCOM: LD A,(COMMAN) ; Get comma width + LD B,A ; Save in B + LD A,(CURPOS) ; Get current position + CP B ; Within the limit? + CALL NC,PRNTCR ; No - output CRLF + JP NC,NEXITM ; Get next item +ZONELP: SUB 14 ; Next zone of 14 characters + JP NC,ZONELP ; Repeat if more zones + CPL ; Number of spaces to output + JP ASPCS ; Output them + +DOTAB: PUSH AF ; Save token + CALL FNDNUM ; Evaluate expression + CALL CHKSYN ; Make sure ")" follows + DB ")" + DEC HL ; Back space on to ")" + POP AF ; Restore token + SUB ZSPC ; Was it "SPC(" ? + PUSH HL ; Save code string address + JP Z,DOSPC ; Yes - Do "E" spaces + LD A,(CURPOS) ; Get current position +DOSPC: CPL ; Number of spaces to print to + ADD A,E ; Total number to print + JP NC,NEXITM ; TAB < Current POS(X) +ASPCS: INC A ; Output A spaces + LD B,A ; Save number to print + LD A," " ; Space +SPCLP: CALL OUTC ; Output character in A + DEC B ; Count them + JP NZ,SPCLP ; Repeat if more +NEXITM: POP HL ; Restore code string address + CALL GETCHR ; Get next character + JP PRNTLP ; More to print + +REDO: DB "?Redo from start",CR,LF,0 + +BADINP: LD A,(READFG) ; READ or INPUT? + OR A + JP NZ,DATSNR ; READ - ?SN Error + POP BC ; Throw away code string addr + LD HL,REDO ; "Redo from start" message + CALL PRS ; Output string + JP DOAGN ; Do last INPUT again + +INPUT: CALL IDTEST ; Test for illegal direct + LD A,(HL) ; Get character after "INPUT" + CP '"' ; Is there a prompt string? + LD A,0 ; Clear A and leave flags + LD (CTLOFG),A ; Enable output + JP NZ,NOPMPT ; No prompt - get input + CALL QTSTR ; Get string terminated by '"' + CALL CHKSYN ; Check for ";" after prompt + DB ";" + PUSH HL ; Save code string address + CALL PRS1 ; Output prompt string + DB 3EH ; Skip "PUSH HL" +NOPMPT: PUSH HL ; Save code string address + CALL PROMPT ; Get input with "? " prompt + POP BC ; Restore code string address + JP C,INPBRK ; Break pressed - Exit + INC HL ; Next byte + LD A,(HL) ; Get it + OR A ; End of line? + DEC HL ; Back again + PUSH BC ; Re-save code string address + JP Z,NXTDTA ; Yes - Find next DATA stmt + LD (HL),"," ; Store comma as separator + JP NXTITM ; Get next item + +READ: PUSH HL ; Save code string address + LD HL,(NXTDAT) ; Next DATA statement + DB 0F6H ; Flag "READ" +NXTITM: XOR A ; Flag "INPUT" + LD (READFG),A ; Save "READ"/"INPUT" flag + EX (SP),HL ; Get code str' , Save pointer + JP GTVLUS ; Get values + +NEDMOR: CALL CHKSYN ; Check for comma between items + DB "," +GTVLUS: CALL GETVAR ; Get variable name + EX (SP),HL ; Save code str" , Get pointer + PUSH DE ; Save variable address + LD A,(HL) ; Get next "INPUT"/"DATA" byte + CP "," ; Comma? + JP Z,ANTVLU ; Yes - Get another value + LD A,(READFG) ; Is it READ? + OR A + JP NZ,FDTLP ; Yes - Find next DATA stmt + LD A,"?" ; More INPUT needed + CALL OUTC ; Output character + CALL PROMPT ; Get INPUT with prompt + POP DE ; Variable address + POP BC ; Code string address + JP C,INPBRK ; Break pressed + INC HL ; Point to next DATA byte + LD A,(HL) ; Get byte + OR A ; Is it zero (No input) ? + DEC HL ; Back space INPUT pointer + PUSH BC ; Save code string address + JP Z,NXTDTA ; Find end of buffer + PUSH DE ; Save variable address +ANTVLU: LD A,(TYPE) ; Check data type + OR A ; Is it numeric? + JP Z,INPBIN ; Yes - Convert to binary + CALL GETCHR ; Get next character + LD D,A ; Save input character + LD B,A ; Again + CP '"' ; Start of literal sting? + JP Z,STRENT ; Yes - Create string entry + LD A,(READFG) ; "READ" or "INPUT" ? + OR A + LD D,A ; Save 00 if "INPUT" + JP Z,ITMSEP ; "INPUT" - End with 00 + LD D,":" ; "DATA" - End with 00 or ":" +ITMSEP: LD B,"," ; Item separator + DEC HL ; Back space for DTSTR +STRENT: CALL DTSTR ; Get string terminated by D + EX DE,HL ; String address to DE + LD HL,LTSTND ; Where to go after LETSTR + EX (SP),HL ; Save HL , get input pointer + PUSH DE ; Save address of string + JP LETSTR ; Assign string to variable + +INPBIN: CALL GETCHR ; Get next character + CALL ASCTFP ; Convert ASCII to FP number + EX (SP),HL ; Save input ptr, Get var addr + CALL FPTHL ; Move FPREG to variable + POP HL ; Restore input pointer +LTSTND: DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP Z,MORDT ; End of line - More needed? + CP "," ; Another value? + JP NZ,BADINP ; No - Bad input +MORDT: EX (SP),HL ; Get code string address + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP NZ,NEDMOR ; More needed - Get it + POP DE ; Restore DATA pointer + LD A,(READFG) ; "READ" or "INPUT" ? + OR A + EX DE,HL ; DATA pointer to HL + JP NZ,UPDATA ; Update DATA pointer if "READ" + PUSH DE ; Save code string address + OR (HL) ; More input given? + LD HL,EXTIG ; "?Extra ignored" message + CALL NZ,PRS ; Output string if extra given + POP HL ; Restore code string address + RET + +EXTIG: DB "?Extra ignored",CR,LF,0 + +FDTLP: CALL DATA ; Get next statement + OR A ; End of line? + JP NZ,FANDT ; No - See if DATA statement + INC HL + LD A,(HL) ; End of program? + INC HL + OR (HL) ; 00 00 Ends program + LD E,OD ; ?OD Error + JP Z,ERROR ; Yes - Out of DATA + INC HL + LD E,(HL) ; LSB of line number + INC HL + LD D,(HL) ; MSB of line number + EX DE,HL + LD (DATLIN),HL ; Set line of current DATA item + EX DE,HL +FANDT: CALL GETCHR ; Get next character + CP ZDATA ; "DATA" token + JP NZ,FDTLP ; No "DATA" - Keep looking + JP ANTVLU ; Found - Convert input + +NEXT: LD DE,0 ; In case no index given +NEXT1: CALL NZ,GETVAR ; Get index address + LD (BRKLIN),HL ; Save code string address + CALL BAKSTK ; Look for "FOR" block + JP NZ,NFERR ; No "FOR" - ?NF Error + LD SP,HL ; Clear nested loops + PUSH DE ; Save index address + LD A,(HL) ; Get sign of STEP + INC HL + PUSH AF ; Save sign of STEP + PUSH DE ; Save index address + CALL PHLTFP ; Move index value to FPREG + EX (SP),HL ; Save address of TO value + PUSH HL ; Save address of index + CALL ADDPHL ; Add STEP to index value + POP HL ; Restore address of index + CALL FPTHL ; Move value to index variable + POP HL ; Restore address of TO value + CALL LOADFP ; Move TO value to BCDE + PUSH HL ; Save address of line of FOR + CALL CMPNUM ; Compare index with TO value + POP HL ; Restore address of line num + POP BC ; Address of sign of STEP + SUB B ; Compare with expected sign + CALL LOADFP ; BC = Loop stmt,DE = Line num + JP Z,KILFOR ; Loop finished - Terminate it + EX DE,HL ; Loop statement line number + LD (LINEAT),HL ; Set loop line number + LD L,C ; Set code string to loop + LD H,B + JP PUTFID ; Put back "FOR" and continue + +KILFOR: LD SP,HL ; Remove "FOR" block + LD HL,(BRKLIN) ; Code string after "NEXT" + LD A,(HL) ; Get next byte in code string + CP "," ; More NEXTs ? + JP NZ,RUNCNT ; No - Do next statement + CALL GETCHR ; Position to index name + CALL NEXT1 ; Re-enter NEXT routine +; < will not RETurn to here , Exit to RUNCNT or Loop > + +GETNUM: CALL EVAL ; Get a numeric expression +TSTNUM: DB 0F6H ; Clear carry (numeric) +TSTSTR: SCF ; Set carry (string) +CHKTYP: LD A,(TYPE) ; Check types match + ADC A,A ; Expected + actual + OR A ; Clear carry , set parity + RET PE ; Even parity - Types match + JP TMERR ; Different types - Error + +; <<< NO REFERENCE TO HERE >>> + + CALL CHKSYN ; Make sure "=" follows + DB ZEQUAL ; "=" + JP EVAL ; Evaluate expression + +OPNPAR: CALL CHKSYN ; Make sure "(" follows + DB "(" +EVAL: DEC HL ; Evaluate expression & save + LD D,0 ; Precedence value +EVAL1: PUSH DE ; Save precedence + LD C,1 + CALL CHKSTK ; Check for 1 level of stack + CALL OPRND ; Get next expression value +EVAL2: LD (NXTOPR),HL ; Save address of next operator +EVAL3: LD HL,(NXTOPR) ; Restore address of next opr + POP BC ; Precedence value and operator + LD A,B ; Get precedence value + CP 78H ; "AND" or "OR" ? + CALL NC,TSTNUM ; No - Make sure it's a number + LD A,(HL) ; Get next operator / function + LD D,0 ; Clear Last relation +RLTLP: SUB ZGTR ; ">" Token + JP C,FOPRND ; + - * / ^ AND OR - Test it + CP ZLTH+1-ZGTR ; < = > + JP NC,FOPRND ; Function - Call it + CP ZEQUAL-ZGTR ; "=" + RLA ; <- Test for legal + XOR D ; <- combinations of < = > + CP D ; <- by combining last token + LD D,A ; <- with current one + JP C,SNERR ; Error if "<<" "==" or ">>" + LD (CUROPR),HL ; Save address of current token + CALL GETCHR ; Get next character + JP RLTLP ; Treat the two as one + +FOPRND: LD A,D ; < = > found ? + OR A + JP NZ,TSTRED ; Yes - Test for reduction + LD A,(HL) ; Get operator token + LD (CUROPR),HL ; Save operator address + SUB ZPLUS ; Operator or function? + RET C ; Neither - Exit + CP ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ? + RET NC ; No - Exit + LD E,A ; Coded operator + LD A,(TYPE) ; Get data type + DEC A ; FF = numeric , 00 = string + OR E ; Combine with coded operator + LD A,E ; Get coded operator + JP Z,CONCAT ; String concatenation + RLCA ; Times 2 + ADD A,E ; Times 3 + LD E,A ; To DE (D is 0) + LD HL,PRITAB ; Precedence table + ADD HL,DE ; To the operator concerned + LD A,B ; Last operator precedence + LD D,(HL) ; Get evaluation precedence + CP D ; Compare with eval precedence + RET NC ; Exit if higher precedence + INC HL ; Point to routine address + CALL TSTNUM ; Make sure it's a number + +STKTHS: PUSH BC ; Save last precedence & token + LD BC,EVAL3 ; Where to go on prec' break + PUSH BC ; Save on stack for return + LD B,E ; Save operator + LD C,D ; Save precedence + CALL STAKFP ; Move value to stack + LD E,B ; Restore operator + LD D,C ; Restore precedence + LD C,(HL) ; Get LSB of routine address + INC HL + LD B,(HL) ; Get MSB of routine address + INC HL + PUSH BC ; Save routine address + LD HL,(CUROPR) ; Address of current operator + JP EVAL1 ; Loop until prec' break + +OPRND: XOR A ; Get operand routine + LD (TYPE),A ; Set numeric expected + CALL GETCHR ; Get next character + LD E,MO ; ?MO Error + JP Z,ERROR ; No operand - Error + JP C,ASCTFP ; Number - Get value + CALL CHKLTR ; See if a letter + JP NC,CONVAR ; Letter - Find variable + CP ZPLUS ; "+" Token ? + JP Z,OPRND ; Yes - Look for operand + CP "." ; "." ? + JP Z,ASCTFP ; Yes - Create FP number + CP ZMINUS ; "-" Token ? + JP Z,MINUS ; Yes - Do minus + CP '"' ; Literal string ? + JP Z,QTSTR ; Get string terminated by '"' + CP ZNOT ; "NOT" Token ? + JP Z,EVNOT ; Yes - Eval NOT expression + CP ZFN ; "FN" Token ? + JP Z,DOFN ; Yes - Do FN routine + SUB ZSGN ; Is it a function? + JP NC,FNOFST ; Yes - Evaluate function +EVLPAR: CALL OPNPAR ; Evaluate expression in "()" + CALL CHKSYN ; Make sure ")" follows + DB ")" + RET + +MINUS: LD D,7DH ; "-" precedence + CALL EVAL1 ; Evaluate until prec' break + LD HL,(NXTOPR) ; Get next operator address + PUSH HL ; Save next operator address + CALL INVSGN ; Negate value +RETNUM: CALL TSTNUM ; Make sure it's a number + POP HL ; Restore next operator address + RET + +CONVAR: CALL GETVAR ; Get variable address to DE +FRMEVL: PUSH HL ; Save code string address + EX DE,HL ; Variable address to HL + LD (FPREG),HL ; Save address of variable + LD A,(TYPE) ; Get type + OR A ; Numeric? + CALL Z,PHLTFP ; Yes - Move contents to FPREG + POP HL ; Restore code string address + RET + +FNOFST: LD B,0 ; Get address of function + RLCA ; Double function offset + LD C,A ; BC = Offset in function table + PUSH BC ; Save adjusted token value + CALL GETCHR ; Get next character + LD A,C ; Get adjusted token value + CP 2*(ZPOINT-ZSGN) ; Adjusted "POINT" token? + JP Z,POINTB ; Yes - Do "POINT" (not POINTB) + CP 2*(ZLEFT-ZSGN)-1; Adj' LEFT$,RIGHT$ or MID$ ? + JP C,FNVAL ; No - Do function + CALL OPNPAR ; Evaluate expression (X,... + CALL CHKSYN ; Make sure "," follows + DB "," + CALL TSTSTR ; Make sure it's a string + EX DE,HL ; Save code string address + LD HL,(FPREG) ; Get address of string + EX (SP),HL ; Save address of string + PUSH HL ; Save adjusted token value + EX DE,HL ; Restore code string address + CALL GETINT ; Get integer 0-255 + EX DE,HL ; Save code string address + EX (SP),HL ; Save integer,HL = adj' token + JP GOFUNC ; Jump to string function + +FNVAL: CALL EVLPAR ; Evaluate expression + EX (SP),HL ; HL = Adjusted token value + LD DE,RETNUM ; Return number from function + PUSH DE ; Save on stack +GOFUNC: LD BC,FNCTAB ; Function routine addresses + ADD HL,BC ; Point to right address + LD C,(HL) ; Get LSB of address + INC HL ; + LD H,(HL) ; Get MSB of address + LD L,C ; Address to HL + JP (HL) ; Jump to function + +SGNEXP: DEC D ; Dee to flag negative exponent + CP ZMINUS ; "-" token ? + RET Z ; Yes - Return + CP "-" ; "-" ASCII ? + RET Z ; Yes - Return + INC D ; Inc to flag positive exponent + CP "+" ; "+" ASCII ? + RET Z ; Yes - Return + CP ZPLUS ; "+" token ? + RET Z ; Yes - Return + DEC HL ; DEC 'cos GETCHR INCs + RET ; Return "NZ" + +POR: DB 0F6H ; Flag "OR" +PAND: XOR A ; Flag "AND" + PUSH AF ; Save "AND" / "OR" flag + CALL TSTNUM ; Make sure it's a number + CALL DEINT ; Get integer -32768 to 32767 + POP AF ; Restore "AND" / "OR" flag + EX DE,HL ; <- Get last + POP BC ; <- value + EX (SP),HL ; <- from + EX DE,HL ; <- stack + CALL FPBCDE ; Move last value to FPREG + PUSH AF ; Save "AND" / "OR" flag + CALL DEINT ; Get integer -32768 to 32767 + POP AF ; Restore "AND" / "OR" flag + POP BC ; Get value + LD A,C ; Get LSB + LD HL,ACPASS ; Address of save AC as current + JP NZ,POR1 ; Jump if OR + AND E ; "AND" LSBs + LD C,A ; Save LSB + LD A,B ; Get MBS + AND D ; "AND" MSBs + JP (HL) ; Save AC as current (ACPASS) + +POR1: OR E ; "OR" LSBs + LD C,A ; Save LSB + LD A,B ; Get MSB + OR D ; "OR" MSBs + JP (HL) ; Save AC as current (ACPASS) + +TSTRED: LD HL,CMPLOG ; Logical compare routine + LD A,(TYPE) ; Get data type + RRA ; Carry set = string + LD A,D ; Get last precedence value + RLA ; Times 2 plus carry + LD E,A ; To E + LD D,64H ; Relational precedence + LD A,B ; Get current precedence + CP D ; Compare with last + RET NC ; Eval if last was rel' or log' + JP STKTHS ; Stack this one and get next + +CMPLOG: DW CMPLG1 ; Compare two values / strings +CMPLG1: LD A,C ; Get data type + OR A + RRA + POP BC ; Get last expression to BCDE + POP DE + PUSH AF ; Save status + CALL CHKTYP ; Check that types match + LD HL,CMPRES ; Result to comparison + PUSH HL ; Save for RETurn + JP Z,CMPNUM ; Compare values if numeric + XOR A ; Compare two strings + LD (TYPE),A ; Set type to numeric + PUSH DE ; Save string name + CALL GSTRCU ; Get current string + LD A,(HL) ; Get length of string + INC HL + INC HL + LD C,(HL) ; Get LSB of address + INC HL + LD B,(HL) ; Get MSB of address + POP DE ; Restore string name + PUSH BC ; Save address of string + PUSH AF ; Save length of string + CALL GSTRDE ; Get second string + CALL LOADFP ; Get address of second string + POP AF ; Restore length of string 1 + LD D,A ; Length to D + POP HL ; Restore address of string 1 +CMPSTR: LD A,E ; Bytes of string 2 to do + OR D ; Bytes of string 1 to do + RET Z ; Exit if all bytes compared + LD A,D ; Get bytes of string 1 to do + SUB 1 + RET C ; Exit if end of string 1 + XOR A + CP E ; Bytes of string 2 to do + INC A + RET NC ; Exit if end of string 2 + DEC D ; Count bytes in string 1 + DEC E ; Count bytes in string 2 + LD A,(BC) ; Byte in string 2 + CP (HL) ; Compare to byte in string 1 + INC HL ; Move up string 1 + INC BC ; Move up string 2 + JP Z,CMPSTR ; Same - Try next bytes + CCF ; Flag difference (">" or "<") + JP FLGDIF ; "<" gives -1 , ">" gives +1 + +CMPRES: INC A ; Increment current value + ADC A,A ; Double plus carry + POP BC ; Get other value + AND B ; Combine them + ADD A,-1 ; Carry set if different + SBC A,A ; 00 - Equal , FF - Different + JP FLGREL ; Set current value & continue + +EVNOT: LD D,5AH ; Precedence value for "NOT" + CALL EVAL1 ; Eval until precedence break + CALL TSTNUM ; Make sure it's a number + CALL DEINT ; Get integer -32768 - 32767 + LD A,E ; Get LSB + CPL ; Invert LSB + LD C,A ; Save "NOT" of LSB + LD A,D ; Get MSB + CPL ; Invert MSB + CALL ACPASS ; Save AC as current + POP BC ; Clean up stack + JP EVAL3 ; Continue evaluation + +DIMRET: DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + RET Z ; End of DIM statement + CALL CHKSYN ; Make sure "," follows + DB "," +DIM: LD BC,DIMRET ; Return to "DIMRET" + PUSH BC ; Save on stack + DB 0F6H ; Flag "Create" variable +GETVAR: XOR A ; Find variable address,to DE + LD (LCRFLG),A ; Set locate / create flag + LD B,(HL) ; Get First byte of name +GTFNAM: CALL CHKLTR ; See if a letter + JP C,SNERR ; ?SN Error if not a letter + XOR A + LD C,A ; Clear second byte of name + LD (TYPE),A ; Set type to numeric + CALL GETCHR ; Get next character + JP C,SVNAM2 ; Numeric - Save in name + CALL CHKLTR ; See if a letter + JP C,CHARTY ; Not a letter - Check type +SVNAM2: LD C,A ; Save second byte of name +ENDNAM: CALL GETCHR ; Get next character + JP C,ENDNAM ; Numeric - Get another + CALL CHKLTR ; See if a letter + JP NC,ENDNAM ; Letter - Get another +CHARTY: SUB "$" ; String variable? + JP NZ,NOTSTR ; No - Numeric variable + INC A ; A = 1 (string type) + LD (TYPE),A ; Set type to string + RRCA ; A = 80H , Flag for string + ADD A,C ; 2nd byte of name has bit 7 on + LD C,A ; Resave second byte on name + CALL GETCHR ; Get next character +NOTSTR: LD A,(FORFLG) ; Array name needed ? + DEC A + JP Z,ARLDSV ; Yes - Get array name + JP P,NSCFOR ; No array with "FOR" or "FN" + LD A,(HL) ; Get byte again + SUB "(" ; Subscripted variable? + JP Z,SBSCPT ; Yes - Sort out subscript + +NSCFOR: XOR A ; Simple variable + LD (FORFLG),A ; Clear "FOR" flag + PUSH HL ; Save code string address + LD D,B ; DE = Variable name to find + LD E,C + LD HL,(FNRGNM) ; FN argument name + CALL CPDEHL ; Is it the FN argument? + LD DE,FNARG ; Point to argument value + JP Z,POPHRT ; Yes - Return FN argument value + LD HL,(VAREND) ; End of variables + EX DE,HL ; Address of end of search + LD HL,(PROGND) ; Start of variables address +FNDVAR: CALL CPDEHL ; End of variable list table? + JP Z,CFEVAL ; Yes - Called from EVAL? + LD A,C ; Get second byte of name + SUB (HL) ; Compare with name in list + INC HL ; Move on to first byte + JP NZ,FNTHR ; Different - Find another + LD A,B ; Get first byte of name + SUB (HL) ; Compare with name in list +FNTHR: INC HL ; Move on to LSB of value + JP Z,RETADR ; Found - Return address + INC HL ; <- Skip + INC HL ; <- over + INC HL ; <- F.P. + INC HL ; <- value + JP FNDVAR ; Keep looking + +CFEVAL: POP HL ; Restore code string address + EX (SP),HL ; Get return address + PUSH DE ; Save address of variable + LD DE,FRMEVL ; Return address in EVAL + CALL CPDEHL ; Called from EVAL ? + POP DE ; Restore address of variable + JP Z,RETNUL ; Yes - Return null variable + EX (SP),HL ; Put back return + PUSH HL ; Save code string address + PUSH BC ; Save variable name + LD BC,6 ; 2 byte name plus 4 byte data + LD HL,(ARREND) ; End of arrays + PUSH HL ; Save end of arrays + ADD HL,BC ; Move up 6 bytes + POP BC ; Source address in BC + PUSH HL ; Save new end address + CALL MOVUP ; Move arrays up + POP HL ; Restore new end address + LD (ARREND),HL ; Set new end address + LD H,B ; End of variables to HL + LD L,C + LD (VAREND),HL ; Set new end address + +ZEROLP: DEC HL ; Back through to zero variable + LD (HL),0 ; Zero byte in variable + CALL CPDEHL ; Done them all? + JP NZ,ZEROLP ; No - Keep on going + POP DE ; Get variable name + LD (HL),E ; Store second character + INC HL + LD (HL),D ; Store first character + INC HL +RETADR: EX DE,HL ; Address of variable in DE + POP HL ; Restore code string address + RET + +RETNUL: LD (FPEXP),A ; Set result to zero + LD HL,ZERBYT ; Also set a null string + LD (FPREG),HL ; Save for EVAL + POP HL ; Restore code string address + RET + +SBSCPT: PUSH HL ; Save code string address + LD HL,(LCRFLG) ; Locate/Create and Type + EX (SP),HL ; Save and get code string + LD D,A ; Zero number of dimensions +SCPTLP: PUSH DE ; Save number of dimensions + PUSH BC ; Save array name + CALL FPSINT ; Get subscript (0-32767) + POP BC ; Restore array name + POP AF ; Get number of dimensions + EX DE,HL + EX (SP),HL ; Save subscript value + PUSH HL ; Save LCRFLG and TYPE + EX DE,HL + INC A ; Count dimensions + LD D,A ; Save in D + LD A,(HL) ; Get next byte in code string + CP "," ; Comma (more to come)? + JP Z,SCPTLP ; Yes - More subscripts + CALL CHKSYN ; Make sure ")" follows + DB ")" + LD (NXTOPR),HL ; Save code string address + POP HL ; Get LCRFLG and TYPE + LD (LCRFLG),HL ; Restore Locate/create & type + LD E,0 ; Flag not CSAVE* or CLOAD* + PUSH DE ; Save number of dimensions (D) + DB 11H ; Skip "PUSH HL" and "PUSH AF' + +ARLDSV: PUSH HL ; Save code string address + PUSH AF ; A = 00 , Flags set = Z,N + LD HL,(VAREND) ; Start of arrays + DB 3EH ; Skip "ADD HL,DE" +FNDARY: ADD HL,DE ; Move to next array start + EX DE,HL + LD HL,(ARREND) ; End of arrays + EX DE,HL ; Current array pointer + CALL CPDEHL ; End of arrays found? + JP Z,CREARY ; Yes - Create array + LD A,(HL) ; Get second byte of name + CP C ; Compare with name given + INC HL ; Move on + JP NZ,NXTARY ; Different - Find next array + LD A,(HL) ; Get first byte of name + CP B ; Compare with name given +NXTARY: INC HL ; Move on + LD E,(HL) ; Get LSB of next array address + INC HL + LD D,(HL) ; Get MSB of next array address + INC HL + JP NZ,FNDARY ; Not found - Keep looking + LD A,(LCRFLG) ; Found Locate or Create it? + OR A + JP NZ,DDERR ; Create - ?DD Error + POP AF ; Locate - Get number of dim'ns + LD B,H ; BC Points to array dim'ns + LD C,L + JP Z,POPHRT ; Jump if array load/save + SUB (HL) ; Same number of dimensions? + JP Z,FINDEL ; Yes - Find element +BSERR: LD E,BS ; ?BS Error + JP ERROR ; Output error + +CREARY: LD DE,4 ; 4 Bytes per entry + POP AF ; Array to save or 0 dim'ns? + JP Z,FCERR ; Yes - ?FC Error + LD (HL),C ; Save second byte of name + INC HL + LD (HL),B ; Save first byte of name + INC HL + LD C,A ; Number of dimensions to C + CALL CHKSTK ; Check if enough memory + INC HL ; Point to number of dimensions + INC HL + LD (CUROPR),HL ; Save address of pointer + LD (HL),C ; Set number of dimensions + INC HL + LD A,(LCRFLG) ; Locate of Create? + RLA ; Carry set = Create + LD A,C ; Get number of dimensions +CRARLP: LD BC,10+1 ; Default dimension size 10 + JP NC,DEFSIZ ; Locate - Set default size + POP BC ; Get specified dimension size + INC BC ; Include zero element +DEFSIZ: LD (HL),C ; Save LSB of dimension size + INC HL + LD (HL),B ; Save MSB of dimension size + INC HL + PUSH AF ; Save num' of dim'ns an status + PUSH HL ; Save address of dim'n size + CALL MLDEBC ; Multiply DE by BC to find + EX DE,HL ; amount of mem needed (to DE) + POP HL ; Restore address of dimension + POP AF ; Restore number of dimensions + DEC A ; Count them + JP NZ,CRARLP ; Do next dimension if more + PUSH AF ; Save locate/create flag + LD B,D ; MSB of memory needed + LD C,E ; LSB of memory needed + EX DE,HL + ADD HL,DE ; Add bytes to array start + JP C,OMERR ; Too big - Error + CALL ENFMEM ; See if enough memory + LD (ARREND),HL ; Save new end of array + +ZERARY: DEC HL ; Back through array data + LD (HL),0 ; Set array element to zero + CALL CPDEHL ; All elements zeroed? + JP NZ,ZERARY ; No - Keep on going + INC BC ; Number of bytes + 1 + LD D,A ; A=0 + LD HL,(CUROPR) ; Get address of array + LD E,(HL) ; Number of dimensions + EX DE,HL ; To HL + ADD HL,HL ; Two bytes per dimension size + ADD HL,BC ; Add number of bytes + EX DE,HL ; Bytes needed to DE + DEC HL + DEC HL + LD (HL),E ; Save LSB of bytes needed + INC HL + LD (HL),D ; Save MSB of bytes needed + INC HL + POP AF ; Locate / Create? + JP C,ENDDIM ; A is 0 , End if create +FINDEL: LD B,A ; Find array element + LD C,A + LD A,(HL) ; Number of dimensions + INC HL + DB 16H ; Skip "POP HL" +FNDELP: POP HL ; Address of next dim' size + LD E,(HL) ; Get LSB of dim'n size + INC HL + LD D,(HL) ; Get MSB of dim'n size + INC HL + EX (SP),HL ; Save address - Get index + PUSH AF ; Save number of dim'ns + CALL CPDEHL ; Dimension too large? + JP NC,BSERR ; Yes - ?BS Error + PUSH HL ; Save index + CALL MLDEBC ; Multiply previous by size + POP DE ; Index supplied to DE + ADD HL,DE ; Add index to pointer + POP AF ; Number of dimensions + DEC A ; Count them + LD B,H ; MSB of pointer + LD C,L ; LSB of pointer + JP NZ,FNDELP ; More - Keep going + ADD HL,HL ; 4 Bytes per element + ADD HL,HL + POP BC ; Start of array + ADD HL,BC ; Point to element + EX DE,HL ; Address of element to DE +ENDDIM: LD HL,(NXTOPR) ; Got code string address + RET + +FRE: LD HL,(ARREND) ; Start of free memory + EX DE,HL ; To DE + LD HL,0 ; End of free memory + ADD HL,SP ; Current stack value + LD A,(TYPE) ; Dummy argument type + OR A + JP Z,FRENUM ; Numeric - Free variable space + CALL GSTRCU ; Current string to pool + CALL GARBGE ; Garbage collection + LD HL,(STRSPC) ; Bottom of string space in use + EX DE,HL ; To DE + LD HL,(STRBOT) ; Bottom of string space +FRENUM: LD A,L ; Get LSB of end + SUB E ; Subtract LSB of beginning + LD C,A ; Save difference if C + LD A,H ; Get MSB of end + SBC A,D ; Subtract MSB of beginning +ACPASS: LD B,C ; Return integer AC +ABPASS: LD D,B ; Return integer AB + LD E,0 + LD HL,TYPE ; Point to type + LD (HL),E ; Set type to numeric + LD B,80H+16 ; 16 bit integer + JP RETINT ; Return the integr + +POS: LD A,(CURPOS) ; Get cursor position +PASSA: LD B,A ; Put A into AB + XOR A ; Zero A + JP ABPASS ; Return integer AB + +DEF: CALL CHEKFN ; Get "FN" and name + CALL IDTEST ; Test for illegal direct + LD BC,DATA ; To get next statement + PUSH BC ; Save address for RETurn + PUSH DE ; Save address of function ptr + CALL CHKSYN ; Make sure "(" follows + DB "(" + CALL GETVAR ; Get argument variable name + PUSH HL ; Save code string address + EX DE,HL ; Argument address to HL + DEC HL + LD D,(HL) ; Get first byte of arg name + DEC HL + LD E,(HL) ; Get second byte of arg name + POP HL ; Restore code string address + CALL TSTNUM ; Make sure numeric argument + CALL CHKSYN ; Make sure ")" follows + DB ")" + CALL CHKSYN ; Make sure "=" follows + DB ZEQUAL ; "=" token + LD B,H ; Code string address to BC + LD C,L + EX (SP),HL ; Save code str , Get FN ptr + LD (HL),C ; Save LSB of FN code string + INC HL + LD (HL),B ; Save MSB of FN code string + JP SVSTAD ; Save address and do function + +DOFN: CALL CHEKFN ; Make sure FN follows + PUSH DE ; Save function pointer address + CALL EVLPAR ; Evaluate expression in "()" + CALL TSTNUM ; Make sure numeric result + EX (SP),HL ; Save code str , Get FN ptr + LD E,(HL) ; Get LSB of FN code string + INC HL + LD D,(HL) ; Get MSB of FN code string + INC HL + LD A,D ; And function DEFined? + OR E + JP Z,UFERR ; No - ?UF Error + LD A,(HL) ; Get LSB of argument address + INC HL + LD H,(HL) ; Get MSB of argument address + LD L,A ; HL = Arg variable address + PUSH HL ; Save it + LD HL,(FNRGNM) ; Get old argument name + EX (SP),HL ; ; Save old , Get new + LD (FNRGNM),HL ; Set new argument name + LD HL,(FNARG+2) ; Get LSB,NLSB of old arg value + PUSH HL ; Save it + LD HL,(FNARG) ; Get MSB,EXP of old arg value + PUSH HL ; Save it + LD HL,FNARG ; HL = Value of argument + PUSH DE ; Save FN code string address + CALL FPTHL ; Move FPREG to argument + POP HL ; Get FN code string address + CALL GETNUM ; Get value from function + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP NZ,SNERR ; Bad character in FN - Error + POP HL ; Get MSB,EXP of old arg + LD (FNARG),HL ; Restore it + POP HL ; Get LSB,NLSB of old arg + LD (FNARG+2),HL ; Restore it + POP HL ; Get name of old arg + LD (FNRGNM),HL ; Restore it + POP HL ; Restore code string address + RET + +IDTEST: PUSH HL ; Save code string address + LD HL,(LINEAT) ; Get current line number + INC HL ; -1 means direct statement + LD A,H + OR L + POP HL ; Restore code string address + RET NZ ; Return if in program + LD E,ID ; ?ID Error + JP ERROR + +CHEKFN: CALL CHKSYN ; Make sure FN follows + DB ZFN ; "FN" token + LD A,80H + LD (FORFLG),A ; Flag FN name to find + OR (HL) ; FN name has bit 7 set + LD B,A ; in first byte of name + CALL GTFNAM ; Get FN name + JP TSTNUM ; Make sure numeric function + +STR: CALL TSTNUM ; Make sure it's a number + CALL NUMASC ; Turn number into text + CALL CRTST ; Create string entry for it + CALL GSTRCU ; Current string to pool + LD BC,TOPOOL ; Save in string pool + PUSH BC ; Save address on stack + +SAVSTR: LD A,(HL) ; Get string length + INC HL + INC HL + PUSH HL ; Save pointer to string + CALL TESTR ; See if enough string space + POP HL ; Restore pointer to string + LD C,(HL) ; Get LSB of address + INC HL + LD B,(HL) ; Get MSB of address + CALL CRTMST ; Create string entry + PUSH HL ; Save pointer to MSB of addr + LD L,A ; Length of string + CALL TOSTRA ; Move to string area + POP DE ; Restore pointer to MSB + RET + +MKTMST: CALL TESTR ; See if enough string space +CRTMST: LD HL,TMPSTR ; Temporary string + PUSH HL ; Save it + LD (HL),A ; Save length of string + INC HL +SVSTAD: INC HL + LD (HL),E ; Save LSB of address + INC HL + LD (HL),D ; Save MSB of address + POP HL ; Restore pointer + RET + +CRTST: DEC HL ; DEC - INCed after +QTSTR: LD B,'"' ; Terminating quote + LD D,B ; Quote to D +DTSTR: PUSH HL ; Save start + LD C,-1 ; Set counter to -1 +QTSTLP: INC HL ; Move on + LD A,(HL) ; Get byte + INC C ; Count bytes + OR A ; End of line? + JP Z,CRTSTE ; Yes - Create string entry + CP D ; Terminator D found? + JP Z,CRTSTE ; Yes - Create string entry + CP B ; Terminator B found? + JP NZ,QTSTLP ; No - Keep looking +CRTSTE: CP '"' ; End with '"'? + CALL Z,GETCHR ; Yes - Get next character + EX (SP),HL ; Starting quote + INC HL ; First byte of string + EX DE,HL ; To DE + LD A,C ; Get length + CALL CRTMST ; Create string entry +TSTOPL: LD DE,TMPSTR ; Temporary string + LD HL,(TMSTPT) ; Temporary string pool pointer + LD (FPREG),HL ; Save address of string ptr + LD A,1 + LD (TYPE),A ; Set type to string + CALL DETHL4 ; Move string to pool + CALL CPDEHL ; Out of string pool? + LD (TMSTPT),HL ; Save new pointer + POP HL ; Restore code string address + LD A,(HL) ; Get next code byte + RET NZ ; Return if pool OK + LD E,ST ; ?ST Error + JP ERROR ; String pool overflow + +PRNUMS: INC HL ; Skip leading space +PRS: CALL CRTST ; Create string entry for it +PRS1: CALL GSTRCU ; Current string to pool + CALL LOADFP ; Move string block to BCDE + INC E ; Length + 1 +PRSLP: DEC E ; Count characters + RET Z ; End of string + LD A,(BC) ; Get byte to output + CALL OUTC ; Output character in A + CP CR ; Return? + CALL Z,DONULL ; Yes - Do nulls + INC BC ; Next byte in string + JP PRSLP ; More characters to output + +TESTR: OR A ; Test if enough room + DB 0EH ; No garbage collection done +GRBDON: POP AF ; Garbage collection done + PUSH AF ; Save status + LD HL,(STRSPC) ; Bottom of string space in use + EX DE,HL ; To DE + LD HL,(STRBOT) ; Bottom of string area + CPL ; Negate length (Top down) + LD C,A ; -Length to BC + LD B,-1 ; BC = -ve length of string + ADD HL,BC ; Add to bottom of space in use + INC HL ; Plus one for 2's complement + CALL CPDEHL ; Below string RAM area? + JP C,TESTOS ; Tidy up if not done else err + LD (STRBOT),HL ; Save new bottom of area + INC HL ; Point to first byte of string + EX DE,HL ; Address to DE +POPAF: POP AF ; Throw away status push + RET + +TESTOS: POP AF ; Garbage collect been done? + LD E,OS ; ?OS Error + JP Z,ERROR ; Yes - Not enough string apace + CP A ; Flag garbage collect done + PUSH AF ; Save status + LD BC,GRBDON ; Garbage collection done + PUSH BC ; Save for RETurn +GARBGE: LD HL,(LSTRAM) ; Get end of RAM pointer +GARBLP: LD (STRBOT),HL ; Reset string pointer + LD HL,0 + PUSH HL ; Flag no string found + LD HL,(STRSPC) ; Get bottom of string space + PUSH HL ; Save bottom of string space + LD HL,TMSTPL ; Temporary string pool +GRBLP: EX DE,HL + LD HL,(TMSTPT) ; Temporary string pool pointer + EX DE,HL + CALL CPDEHL ; Temporary string pool done? + LD BC,GRBLP ; Loop until string pool done + JP NZ,STPOOL ; No - See if in string area + LD HL,(PROGND) ; Start of simple variables +SMPVAR: EX DE,HL + LD HL,(VAREND) ; End of simple variables + EX DE,HL + CALL CPDEHL ; All simple strings done? + JP Z,ARRLP ; Yes - Do string arrays + LD A,(HL) ; Get type of variable + INC HL + INC HL + OR A ; "S" flag set if string + CALL STRADD ; See if string in string area + JP SMPVAR ; Loop until simple ones done + +GNXARY: POP BC ; Scrap address of this array +ARRLP: EX DE,HL + LD HL,(ARREND) ; End of string arrays + EX DE,HL + CALL CPDEHL ; All string arrays done? + JP Z,SCNEND ; Yes - Move string if found + CALL LOADFP ; Get array name to BCDE + LD A,E ; Get type of array + PUSH HL ; Save address of num of dim'ns + ADD HL,BC ; Start of next array + OR A ; Test type of array + JP P,GNXARY ; Numeric array - Ignore it + LD (CUROPR),HL ; Save address of next array + POP HL ; Get address of num of dim'ns + LD C,(HL) ; BC = Number of dimensions + LD B,0 + ADD HL,BC ; Two bytes per dimension size + ADD HL,BC + INC HL ; Plus one for number of dim'ns +GRBARY: EX DE,HL + LD HL,(CUROPR) ; Get address of next array + EX DE,HL + CALL CPDEHL ; Is this array finished? + JP Z,ARRLP ; Yes - Get next one + LD BC,GRBARY ; Loop until array all done +STPOOL: PUSH BC ; Save return address + OR 80H ; Flag string type +STRADD: LD A,(HL) ; Get string length + INC HL + INC HL + LD E,(HL) ; Get LSB of string address + INC HL + LD D,(HL) ; Get MSB of string address + INC HL + RET P ; Not a string - Return + OR A ; Set flags on string length + RET Z ; Null string - Return + LD B,H ; Save variable pointer + LD C,L + LD HL,(STRBOT) ; Bottom of new area + CALL CPDEHL ; String been done? + LD H,B ; Restore variable pointer + LD L,C + RET C ; String done - Ignore + POP HL ; Return address + EX (SP),HL ; Lowest available string area + CALL CPDEHL ; String within string area? + EX (SP),HL ; Lowest available string area + PUSH HL ; Re-save return address + LD H,B ; Restore variable pointer + LD L,C + RET NC ; Outside string area - Ignore + POP BC ; Get return , Throw 2 away + POP AF ; + POP AF ; + PUSH HL ; Save variable pointer + PUSH DE ; Save address of current + PUSH BC ; Put back return address + RET ; Go to it + +SCNEND: POP DE ; Addresses of strings + POP HL ; + LD A,L ; HL = 0 if no more to do + OR H + RET Z ; No more to do - Return + DEC HL + LD B,(HL) ; MSB of address of string + DEC HL + LD C,(HL) ; LSB of address of string + PUSH HL ; Save variable address + DEC HL + DEC HL + LD L,(HL) ; HL = Length of string + LD H,0 + ADD HL,BC ; Address of end of string+1 + LD D,B ; String address to DE + LD E,C + DEC HL ; Last byte in string + LD B,H ; Address to BC + LD C,L + LD HL,(STRBOT) ; Current bottom of string area + CALL MOVSTR ; Move string to new address + POP HL ; Restore variable address + LD (HL),C ; Save new LSB of address + INC HL + LD (HL),B ; Save new MSB of address + LD L,C ; Next string area+1 to HL + LD H,B + DEC HL ; Next string area address + JP GARBLP ; Look for more strings + +CONCAT: PUSH BC ; Save prec' opr & code string + PUSH HL ; + LD HL,(FPREG) ; Get first string + EX (SP),HL ; Save first string + CALL OPRND ; Get second string + EX (SP),HL ; Restore first string + CALL TSTSTR ; Make sure it's a string + LD A,(HL) ; Get length of second string + PUSH HL ; Save first string + LD HL,(FPREG) ; Get second string + PUSH HL ; Save second string + ADD A,(HL) ; Add length of second string + LD E,LS ; ?LS Error + JP C,ERROR ; String too long - Error + CALL MKTMST ; Make temporary string + POP DE ; Get second string to DE + CALL GSTRDE ; Move to string pool if needed + EX (SP),HL ; Get first string + CALL GSTRHL ; Move to string pool if needed + PUSH HL ; Save first string + LD HL,(TMPSTR+2) ; Temporary string address + EX DE,HL ; To DE + CALL SSTSA ; First string to string area + CALL SSTSA ; Second string to string area + LD HL,EVAL2 ; Return to evaluation loop + EX (SP),HL ; Save return,get code string + PUSH HL ; Save code string address + JP TSTOPL ; To temporary string to pool + +SSTSA: POP HL ; Return address + EX (SP),HL ; Get string block,save return + LD A,(HL) ; Get length of string + INC HL + INC HL + LD C,(HL) ; Get LSB of string address + INC HL + LD B,(HL) ; Get MSB of string address + LD L,A ; Length to L +TOSTRA: INC L ; INC - DECed after +TSALP: DEC L ; Count bytes moved + RET Z ; End of string - Return + LD A,(BC) ; Get source + LD (DE),A ; Save destination + INC BC ; Next source + INC DE ; Next destination + JP TSALP ; Loop until string moved + +GETSTR: CALL TSTSTR ; Make sure it's a string +GSTRCU: LD HL,(FPREG) ; Get current string +GSTRHL: EX DE,HL ; Save DE +GSTRDE: CALL BAKTMP ; Was it last tmp-str? + EX DE,HL ; Restore DE + RET NZ ; No - Return + PUSH DE ; Save string + LD D,B ; String block address to DE + LD E,C + DEC DE ; Point to length + LD C,(HL) ; Get string length + LD HL,(STRBOT) ; Current bottom of string area + CALL CPDEHL ; Last one in string area? + JP NZ,POPHL ; No - Return + LD B,A ; Clear B (A=0) + ADD HL,BC ; Remove string from str' area + LD (STRBOT),HL ; Save new bottom of str' area +POPHL: POP HL ; Restore string + RET + +BAKTMP: LD HL,(TMSTPT) ; Get temporary string pool top + DEC HL ; Back + LD B,(HL) ; Get MSB of address + DEC HL ; Back + LD C,(HL) ; Get LSB of address + DEC HL ; Back + DEC HL ; Back + CALL CPDEHL ; String last in string pool? + RET NZ ; Yes - Leave it + LD (TMSTPT),HL ; Save new string pool top + RET + +LEN: LD BC,PASSA ; To return integer A + PUSH BC ; Save address +GETLEN: CALL GETSTR ; Get string and its length + XOR A + LD D,A ; Clear D + LD (TYPE),A ; Set type to numeric + LD A,(HL) ; Get length of string + OR A ; Set status flags + RET + +ASC: LD BC,PASSA ; To return integer A + PUSH BC ; Save address +GTFLNM: CALL GETLEN ; Get length of string + JP Z,FCERR ; Null string - Error + INC HL + INC HL + LD E,(HL) ; Get LSB of address + INC HL + LD D,(HL) ; Get MSB of address + LD A,(DE) ; Get first byte of string + RET + +CHR: LD A,1 ; One character string + CALL MKTMST ; Make a temporary string + CALL MAKINT ; Make it integer A + LD HL,(TMPSTR+2) ; Get address of string + LD (HL),E ; Save character +TOPOOL: POP BC ; Clean up stack + JP TSTOPL ; Temporary string to pool + +LEFT: CALL LFRGNM ; Get number and ending ")" + XOR A ; Start at first byte in string +RIGHT1: EX (SP),HL ; Save code string,Get string + LD C,A ; Starting position in string +MID1: PUSH HL ; Save string block address + LD A,(HL) ; Get length of string + CP B ; Compare with number given + JP C,ALLFOL ; All following bytes required + LD A,B ; Get new length + DB 11H ; Skip "LD C,0" +ALLFOL: LD C,0 ; First byte of string + PUSH BC ; Save position in string + CALL TESTR ; See if enough string space + POP BC ; Get position in string + POP HL ; Restore string block address + PUSH HL ; And re-save it + INC HL + INC HL + LD B,(HL) ; Get LSB of address + INC HL + LD H,(HL) ; Get MSB of address + LD L,B ; HL = address of string + LD B,0 ; BC = starting address + ADD HL,BC ; Point to that byte + LD B,H ; BC = source string + LD C,L + CALL CRTMST ; Create a string entry + LD L,A ; Length of new string + CALL TOSTRA ; Move string to string area + POP DE ; Clear stack + CALL GSTRDE ; Move to string pool if needed + JP TSTOPL ; Temporary string to pool + +RIGHT: CALL LFRGNM ; Get number and ending ")" + POP DE ; Get string length + PUSH DE ; And re-save + LD A,(DE) ; Get length + SUB B ; Move back N bytes + JP RIGHT1 ; Go and get sub-string + +MID: EX DE,HL ; Get code string address + LD A,(HL) ; Get next byte "," or ")" + CALL MIDNUM ; Get number supplied + INC B ; Is it character zero? + DEC B + JP Z,FCERR ; Yes - Error + PUSH BC ; Save starting position + LD E,255 ; All of string + CP ")" ; Any length given? + JP Z,RSTSTR ; No - Rest of string + CALL CHKSYN ; Make sure "," follows + DB "," + CALL GETINT ; Get integer 0-255 +RSTSTR: CALL CHKSYN ; Make sure ")" follows + DB ")" + POP AF ; Restore starting position + EX (SP),HL ; Get string,8ave code string + LD BC,MID1 ; Continuation of MID$ routine + PUSH BC ; Save for return + DEC A ; Starting position-1 + CP (HL) ; Compare with length + LD B,0 ; Zero bytes length + RET NC ; Null string if start past end + LD C,A ; Save starting position-1 + LD A,(HL) ; Get length of string + SUB C ; Subtract start + CP E ; Enough string for it? + LD B,A ; Save maximum length available + RET C ; Truncate string if needed + LD B,E ; Set specified length + RET ; Go and create string + +VAL: CALL GETLEN ; Get length of string + JP Z,RESZER ; Result zero + LD E,A ; Save length + INC HL + INC HL + LD A,(HL) ; Get LSB of address + INC HL + LD H,(HL) ; Get MSB of address + LD L,A ; HL = String address + PUSH HL ; Save string address + ADD HL,DE + LD B,(HL) ; Get end of string+1 byte + LD (HL),D ; Zero it to terminate + EX (SP),HL ; Save string end,get start + PUSH BC ; Save end+1 byte + LD A,(HL) ; Get starting byte + CALL ASCTFP ; Convert ASCII string to FP + POP BC ; Restore end+1 byte + POP HL ; Restore end+1 address + LD (HL),B ; Put back original byte + RET + +LFRGNM: EX DE,HL ; Code string address to HL + CALL CHKSYN ; Make sure ")" follows + DB ")" +MIDNUM: POP BC ; Get return address + POP DE ; Get number supplied + PUSH BC ; Re-save return address + LD B,E ; Number to B + RET + +INP: CALL MAKINT ; Make it integer A + LD (INPORT),A ; Set input port + CALL INPSUB ; Get input from port + JP PASSA ; Return integer A + +POUT: CALL SETIO ; Set up port number + JP OUTSUB ; Output data and return + +WAIT: CALL SETIO ; Set up port number + PUSH AF ; Save AND mask + LD E,0 ; Assume zero if none given + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP Z,NOXOR ; No XOR byte given + CALL CHKSYN ; Make sure "," follows + DB "," + CALL GETINT ; Get integer 0-255 to XOR with +NOXOR: POP BC ; Restore AND mask +WAITLP: CALL INPSUB ; Get input + XOR E ; Flip selected bits + AND B ; Result non-zero? + JP Z,WAITLP ; No = keep waiting + RET + +SETIO: CALL GETINT ; Get integer 0-255 + LD (INPORT),A ; Set input port + LD (OTPORT),A ; Set output port + CALL CHKSYN ; Make sure "," follows + DB "," + JP GETINT ; Get integer 0-255 and return + +FNDNUM: CALL GETCHR ; Get next character +GETINT: CALL GETNUM ; Get a number from 0 to 255 +MAKINT: CALL DEPINT ; Make sure value 0 - 255 + LD A,D ; Get MSB of number + OR A ; Zero? + JP NZ,FCERR ; No - Error + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + LD A,E ; Get number to A + RET + +; << NO REFERENCE TO THIS SECTION OF CODE >> +; << Set up another program area (can be in ROM) >> + + LD HL,(BASTXT) ; Get start of program text + LD (PROGND),HL ; Set more variable space + LD HL,8000H ; Address of new program + LD E,(HL) ; Get LSB of new RAM end + INC HL + LD D,(HL) ; Get MSB of new RAM end + INC HL + INC HL ; Null at start of program + LD (BASTXT),HL ; New program text area 8003H + EX DE,HL ; New RAM end to HL + LD (LSTRAM),HL ; Set new RAM end + LD (STRSPC),HL ; Clear string space + LD BC,RUNCNT ; Execution driver loop + PUSH BC ; Save for return + JP RUNFST ; Clear variables and continue + +RUART: JP GUART ; Get a byte from UART + +WUART2: CALL WUART ; Send 2 Bytes to UART +WUART: PUSH AF ; Save byte + PUSH BC ; Save BC + LD C,A ; Byte to C + CALL SUART ; Send byte to UART + POP BC ; Restore BC + POP AF ; Restore byte + RET + +CSAVE: LD B,1 ; Flag "CSAVE" + CP ZTIMES ; "*" token? ("CSAVE*") + JP Z,ARRSV1 ; Yes - Array save + CALL EVAL ; Evaluate expression + PUSH HL ; Save code string address + CALL GTFLNM ; Get file name + PUSH DE ; Save file name + CALL CASFFW ; Turn on motor and wait + POP DE ; Restore file name + LD A,11010011B ; Header byte + CALL WUART ; Send byte to UART + CALL WUART2 ; Send byte twice more + LD A,(DE) ; Get file name + CALL WUART ; Send it to UART + NOP + NOP + NOP + LD HL,PROGND ; Start of program information + LD (ARG1),HL ; Save for monitor save routine + LD HL,(PROGND) ; End of program information + LD (ARG2),HL ; Save for monitor save routine + CALL SAVE ; Save program to tape + CALL ARET ; Not much there! + POP HL ; Restore code string address + RET + +CLOAD: LD A,(HL) ; Get byte after "CLOAD" + CP ZTIMES ; "*" token? ("CLOAD*") + JP Z,ARRLD1 ; Yes - Array load + CALL SMOTOR ; Start motor and get "?" + SUB ZPRINT ; "?" ("PRINT" token) Verify? + JP Z,FLGVER ; Yes - Flag "verify" + XOR A ; Flag "load" + DB 01H ; Skip "CPL" and "INC HL" +FLGVER: CPL ; Flag "verify" + INC HL ; Skip over "?" + PUSH AF ; Save verify flag + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + LD A,0 ; Any file will do + JP Z,ANYNAM ; No name given - Any will do + CALL EVAL ; Evaluate expression + CALL GTFLNM ; Get file name + LD A,(DE) ; Get first byte of name +ANYNAM: LD L,A ; Save name to find + POP AF ; Get verify flag + PUSH AF ; And re-save + OR A ; Verify of load? + LD H,A + LD (FPREG),HL ; Save nam of file to find + CALL Z,CLRPTR ; Load - Clear pointers + LD HL,(FPREG) ; Get name of program to find + EX DE,HL ; Name to DE +CLOAD1: LD B,3 ; 3 Header bytes +CLOAD2: CALL RUART ; Get a byte from UART + SUB 11010011B ; Header byte? + JP NZ,CLOAD1 ; Look for header + DEC B ; Count header bytes + JP NZ,CLOAD2 ; More to find? + CALL RUART ; Get name of file + CALL FILFND ; Display "file X found" + INC E ; Any file name given? + DEC E + JP Z,THSFIL ; No - This file will do + CP E ; Has file been found? + JP NZ,CLOAD1 ; No - Look for another +THSFIL: NOP + NOP + NOP + POP AF ; Get verify flag + OR A ; Load or verify? + JP NZ,CLOADV ; Verify program + CALL MONLD ; Use monitor to load program + LD HL,(PROGND) ; Get end of program + CALL ENFMEM ; See if enough memory + JP CLOADE ; "Ok" and set up pointers + +CLOADV: CALL MONVE ; Use monitor to verify program +CLOADE: LD HL,OKMSG ; "Ok" message + CALL PRS ; Output string + CALL ARET ; Not a lot there! + JP SETPTR ; Set up line pointers + +OUTBAD: LD HL,BAD ; "Bad" message + CALL PRS ; Output string + JP ERRIN ; In line message + +FILFND: PUSH BC ; <- Save + PUSH HL ; <- all + PUSH DE ; <- the + PUSH AF ; <- registers + LD HL,FILE ; "File" message + CALL PRS ; Output string + POP AF ; Get file name + PUSH AF ; And re-save + CALL CONMON ; Output file name to screen + LD HL,FOUND ; "Found" message + CALL PRS ; Output string + POP AF ; <- Restore + POP DE ; <- all + POP HL ; <- the + POP BC ; <- registers + RET + +FILE: DB "File ",0 +FOUND: DB " Found",CR,LF,0 +BAD: DB "Bad",0,0,0 + +PEEK: CALL DEINT ; Get memory address + LD A,(DE) ; Get byte in memory + JP PASSA ; Return integer A + +POKE: CALL GETNUM ; Get memory address + CALL DEINT ; Get integer -32768 to 3276 + PUSH DE ; Save memory address + CALL CHKSYN ; Make sure "," follows + DB "," + CALL GETINT ; Get integer 0-255 + POP DE ; Restore memory address + LD (DE),A ; Load it into memory + RET + +ROUND: LD HL,HALF ; Add 0.5 to FPREG +ADDPHL: CALL LOADFP ; Load FP at (HL) to BCDE + JP FPADD ; Add BCDE to FPREG + +SUBPHL: CALL LOADFP ; FPREG = -FPREG + number at HL + DB 21H ; Skip "POP BC" and "POP DE" +PSUB: POP BC ; Get FP number from stack + POP DE +SUBCDE: CALL INVSGN ; Negate FPREG +FPADD: LD A,B ; Get FP exponent + OR A ; Is number zero? + RET Z ; Yes - Nothing to add + LD A,(FPEXP) ; Get FPREG exponent + OR A ; Is this number zero? + JP Z,FPBCDE ; Yes - Move BCDE to FPREG + SUB B ; BCDE number larger? + JP NC,NOSWAP ; No - Don't swap them + CPL ; Two's complement + INC A ; FP exponent + EX DE,HL + CALL STAKFP ; Put FPREG on stack + EX DE,HL + CALL FPBCDE ; Move BCDE to FPREG + POP BC ; Restore number from stack + POP DE +NOSWAP: CP 24+1 ; Second number insignificant? + RET NC ; Yes - First number is result + PUSH AF ; Save number of bits to scale + CALL SIGNS ; Set MSBs & sign of result + LD H,A ; Save sign of result + POP AF ; Restore scaling factor + CALL SCALE ; Scale BCDE to same exponent + OR H ; Result to be positive? + LD HL,FPREG ; Point to FPREG + JP P,MINCDE ; No - Subtract FPREG from CDE + CALL PLUCDE ; Add FPREG to CDE + JP NC,RONDUP ; No overflow - Round it up + INC HL ; Point to exponent + INC (HL) ; Increment it + JP Z,OVERR ; Number overflowed - Error + LD L,1 ; 1 bit to shift right + CALL SHRT1 ; Shift result right + JP RONDUP ; Round it up + +MINCDE: XOR A ; Clear A and carry + SUB B ; Negate exponent + LD B,A ; Re-save exponent + LD A,(HL) ; Get LSB of FPREG + SBC A, E ; Subtract LSB of BCDE + LD E,A ; Save LSB of BCDE + INC HL + LD A,(HL) ; Get NMSB of FPREG + SBC A,D ; Subtract NMSB of BCDE + LD D,A ; Save NMSB of BCDE + INC HL + LD A,(HL) ; Get MSB of FPREG + SBC A,C ; Subtract MSB of BCDE + LD C,A ; Save MSB of BCDE +CONPOS: CALL C,COMPL ; Overflow - Make it positive + +BNORM: LD L,B ; L = Exponent + LD H,E ; H = LSB + XOR A +BNRMLP: LD B,A ; Save bit count + LD A,C ; Get MSB + OR A ; Is it zero? + JP NZ,PNORM ; No - Do it bit at a time + LD C,D ; MSB = NMSB + LD D,H ; NMSB= LSB + LD H,L ; LSB = VLSB + LD L,A ; VLSB= 0 + LD A,B ; Get exponent + SUB 8 ; Count 8 bits + CP -24-8 ; Was number zero? + JP NZ,BNRMLP ; No - Keep normalising +RESZER: XOR A ; Result is zero +SAVEXP: LD (FPEXP),A ; Save result as zero + RET + +NORMAL: DEC B ; Count bits + ADD HL,HL ; Shift HL left + LD A,D ; Get NMSB + RLA ; Shift left with last bit + LD D,A ; Save NMSB + LD A,C ; Get MSB + ADC A,A ; Shift left with last bit + LD C,A ; Save MSB +PNORM: JP P,NORMAL ; Not done - Keep going + LD A,B ; Number of bits shifted + LD E,H ; Save HL in EB + LD B,L + OR A ; Any shifting done? + JP Z,RONDUP ; No - Round it up + LD HL,FPEXP ; Point to exponent + ADD A,(HL) ; Add shifted bits + LD (HL),A ; Re-save exponent + JP NC,RESZER ; Underflow - Result is zero + RET Z ; Result is zero +RONDUP: LD A,B ; Get VLSB of number +RONDB: LD HL,FPEXP ; Point to exponent + OR A ; Any rounding? + CALL M,FPROND ; Yes - Round number up + LD B,(HL) ; B = Exponent + INC HL + LD A,(HL) ; Get sign of result + AND 10000000B ; Only bit 7 needed + XOR C ; Set correct sign + LD C,A ; Save correct sign in number + JP FPBCDE ; Move BCDE to FPREG + +FPROND: INC E ; Round LSB + RET NZ ; Return if ok + INC D ; Round NMSB + RET NZ ; Return if ok + INC C ; Round MSB + RET NZ ; Return if ok + LD C,80H ; Set normal value + INC (HL) ; Increment exponent + RET NZ ; Return if ok + JP OVERR ; Overflow error + +PLUCDE: LD A,(HL) ; Get LSB of FPREG + ADD A,E ; Add LSB of BCDE + LD E,A ; Save LSB of BCDE + INC HL + LD A,(HL) ; Get NMSB of FPREG + ADC A,D ; Add NMSB of BCDE + LD D,A ; Save NMSB of BCDE + INC HL + LD A,(HL) ; Get MSB of FPREG + ADC A,C ; Add MSB of BCDE + LD C,A ; Save MSB of BCDE + RET + +COMPL: LD HL,SGNRES ; Sign of result + LD A,(HL) ; Get sign of result + CPL ; Negate it + LD (HL),A ; Put it back + XOR A + LD L,A ; Set L to zero + SUB B ; Negate exponent,set carry + LD B,A ; Re-save exponent + LD A,L ; Load zero + SBC A,E ; Negate LSB + LD E,A ; Re-save LSB + LD A,L ; Load zero + SBC A,D ; Negate NMSB + LD D,A ; Re-save NMSB + LD A,L ; Load zero + SBC A,C ; Negate MSB + LD C,A ; Re-save MSB + RET + +SCALE: LD B,0 ; Clear underflow +SCALLP: SUB 8 ; 8 bits (a whole byte)? + JP C,SHRITE ; No - Shift right A bits + LD B,E ; <- Shift + LD E,D ; <- right + LD D,C ; <- eight + LD C,0 ; <- bits + JP SCALLP ; More bits to shift + +SHRITE: ADD A,8+1 ; Adjust count + LD L,A ; Save bits to shift +SHRLP: XOR A ; Flag for all done + DEC L ; All shifting done? + RET Z ; Yes - Return + LD A,C ; Get MSB +SHRT1: RRA ; Shift it right + LD C,A ; Re-save + LD A,D ; Get NMSB + RRA ; Shift right with last bit + LD D,A ; Re-save it + LD A,E ; Get LSB + RRA ; Shift right with last bit + LD E,A ; Re-save it + LD A,B ; Get underflow + RRA ; Shift right with last bit + LD B,A ; Re-save underflow + JP SHRLP ; More bits to do + +UNITY: DB 000H,000H,000H,081H ; 1.00000 + +LOGTAB: DB 3 ; Table used by LOG + DB 0AAH,056H,019H,080H ; 0.59898 + DB 0F1H,022H,076H,080H ; 0.96147 + DB 045H,0AAH,038H,082H ; 2.88539 + +LOG: CALL TSTSGN ; Test sign of value + OR A + JP PE,FCERR ; ?FC Error if <= zero + LD HL,FPEXP ; Point to exponent + LD A,(HL) ; Get exponent + LD BC,8035H ; BCDE = SQR(1/2) + LD DE,04F3H + SUB B ; Scale value to be < 1 + PUSH AF ; Save scale factor + LD (HL),B ; Save new exponent + PUSH DE ; Save SQR(1/2) + PUSH BC + CALL FPADD ; Add SQR(1/2) to value + POP BC ; Restore SQR(1/2) + POP DE + INC B ; Make it SQR(2) + CALL DVBCDE ; Divide by SQR(2) + LD HL,UNITY ; Point to 1. + CALL SUBPHL ; Subtract FPREG from 1 + LD HL,LOGTAB ; Coefficient table + CALL SUMSER ; Evaluate sum of series + LD BC,8080H ; BCDE = -0.5 + LD DE,0000H + CALL FPADD ; Subtract 0.5 from FPREG + POP AF ; Restore scale factor + CALL RSCALE ; Re-scale number +MULLN2: LD BC,8031H ; BCDE = Ln(2) + LD DE,7218H + DB 21H ; Skip "POP BC" and "POP DE" + +MULT: POP BC ; Get number from stack + POP DE +FPMULT: CALL TSTSGN ; Test sign of FPREG + RET Z ; Return zero if zero + LD L,0 ; Flag add exponents + CALL ADDEXP ; Add exponents + LD A,C ; Get MSB of multiplier + LD (MULVAL),A ; Save MSB of multiplier + EX DE,HL + LD (MULVAL+1),HL ; Save rest of multiplier + LD BC,0 ; Partial product (BCDE) = zero + LD D,B + LD E,B + LD HL,BNORM ; Address of normalise + PUSH HL ; Save for return + LD HL,MULT8 ; Address of 8 bit multiply + PUSH HL ; Save for NMSB,MSB + PUSH HL ; + LD HL,FPREG ; Point to number +MULT8: LD A,(HL) ; Get LSB of number + INC HL ; Point to NMSB + OR A ; Test LSB + JP Z,BYTSFT ; Zero - shift to next byte + PUSH HL ; Save address of number + LD L,8 ; 8 bits to multiply by +MUL8LP: RRA ; Shift LSB right + LD H,A ; Save LSB + LD A,C ; Get MSB + JP NC,NOMADD ; Bit was zero - Don't add + PUSH HL ; Save LSB and count + LD HL,(MULVAL+1) ; Get LSB and NMSB + ADD HL,DE ; Add NMSB and LSB + EX DE,HL ; Leave sum in DE + POP HL ; Restore MSB and count + LD A,(MULVAL) ; Get MSB of multiplier + ADC A,C ; Add MSB +NOMADD: RRA ; Shift MSB right + LD C,A ; Re-save MSB + LD A,D ; Get NMSB + RRA ; Shift NMSB right + LD D,A ; Re-save NMSB + LD A,E ; Get LSB + RRA ; Shift LSB right + LD E,A ; Re-save LSB + LD A,B ; Get VLSB + RRA ; Shift VLSB right + LD B,A ; Re-save VLSB + DEC L ; Count bits multiplied + LD A,H ; Get LSB of multiplier + JP NZ,MUL8LP ; More - Do it +POPHRT: POP HL ; Restore address of number + RET + +BYTSFT: LD B,E ; Shift partial product left + LD E,D + LD D,C + LD C,A + RET + +DIV10: CALL STAKFP ; Save FPREG on stack + LD BC,8420H ; BCDE = 10. + LD DE,0000H + CALL FPBCDE ; Move 10 to FPREG + +DIV: POP BC ; Get number from stack + POP DE +DVBCDE: CALL TSTSGN ; Test sign of FPREG + JP Z,DZERR ; Error if division by zero + LD L,-1 ; Flag subtract exponents + CALL ADDEXP ; Subtract exponents + INC (HL) ; Add 2 to exponent to adjust + INC (HL) + DEC HL ; Point to MSB + LD A,(HL) ; Get MSB of dividend + LD (DIV3),A ; Save for subtraction + DEC HL + LD A,(HL) ; Get NMSB of dividend + LD (DIV2),A ; Save for subtraction + DEC HL + LD A,(HL) ; Get MSB of dividend + LD (DIV1),A ; Save for subtraction + LD B,C ; Get MSB + EX DE,HL ; NMSB,LSB to HL + XOR A + LD C,A ; Clear MSB of quotient + LD D,A ; Clear NMSB of quotient + LD E,A ; Clear LSB of quotient + LD (DIV4),A ; Clear overflow count +DIVLP: PUSH HL ; Save divisor + PUSH BC + LD A,L ; Get LSB of number + CALL DIVSUP ; Subt' divisor from dividend + SBC A,0 ; Count for overflows + CCF + JP NC,RESDIV ; Restore divisor if borrow + LD (DIV4),A ; Re-save overflow count + POP AF ; Scrap divisor + POP AF + SCF ; Set carry to + DB 0D2H ; Skip "POP BC" and "POP HL" + +RESDIV: POP BC ; Restore divisor + POP HL + LD A,C ; Get MSB of quotient + INC A + DEC A + RRA ; Bit 0 to bit 7 + JP M,RONDB ; Done - Normalise result + RLA ; Restore carry + LD A,E ; Get LSB of quotient + RLA ; Double it + LD E,A ; Put it back + LD A,D ; Get NMSB of quotient + RLA ; Double it + LD D,A ; Put it back + LD A,C ; Get MSB of quotient + RLA ; Double it + LD C,A ; Put it back + ADD HL,HL ; Double NMSB,LSB of divisor + LD A,B ; Get MSB of divisor + RLA ; Double it + LD B,A ; Put it back + LD A,(DIV4) ; Get VLSB of quotient + RLA ; Double it + LD (DIV4),A ; Put it back + LD A,C ; Get MSB of quotient + OR D ; Merge NMSB + OR E ; Merge LSB + JP NZ,DIVLP ; Not done - Keep dividing + PUSH HL ; Save divisor + LD HL,FPEXP ; Point to exponent + DEC (HL) ; Divide by 2 + POP HL ; Restore divisor + JP NZ,DIVLP ; Ok - Keep going + JP OVERR ; Overflow error + +ADDEXP: LD A,B ; Get exponent of dividend + OR A ; Test it + JP Z,OVTST3 ; Zero - Result zero + LD A,L ; Get add/subtract flag + LD HL,FPEXP ; Point to exponent + XOR (HL) ; Add or subtract it + ADD A,B ; Add the other exponent + LD B,A ; Save new exponent + RRA ; Test exponent for overflow + XOR B + LD A,B ; Get exponent + JP P,OVTST2 ; Positive - Test for overflow + ADD A,80H ; Add excess 128 + LD (HL),A ; Save new exponent + JP Z,POPHRT ; Zero - Result zero + CALL SIGNS ; Set MSBs and sign of result + LD (HL),A ; Save new exponent + DEC HL ; Point to MSB + RET + +OVTST1: CALL TSTSGN ; Test sign of FPREG + CPL ; Invert sign + POP HL ; Clean up stack +OVTST2: OR A ; Test if new exponent zero +OVTST3: POP HL ; Clear off return address + JP P,RESZER ; Result zero + JP OVERR ; Overflow error + +MLSP10: CALL BCDEFP ; Move FPREG to BCDE + LD A,B ; Get exponent + OR A ; Is it zero? + RET Z ; Yes - Result is zero + ADD A,2 ; Multiply by 4 + JP C,OVERR ; Overflow - ?OV Error + LD B,A ; Re-save exponent + CALL FPADD ; Add BCDE to FPREG (Times 5) + LD HL,FPEXP ; Point to exponent + INC (HL) ; Double number (Times 10) + RET NZ ; Ok - Return + JP OVERR ; Overflow error + +TSTSGN: LD A,(FPEXP) ; Get sign of FPREG + OR A + RET Z ; RETurn if number is zero + LD A,(FPREG+2) ; Get MSB of FPREG + DB 0FEH ; Test sign +RETREL: CPL ; Invert sign + RLA ; Sign bit to carry +FLGDIF: SBC A,A ; Carry to all bits of A + RET NZ ; Return -1 if negative + INC A ; Bump to +1 + RET ; Positive - Return +1 + +SGN: CALL TSTSGN ; Test sign of FPREG +FLGREL: LD B,80H+8 ; 8 bit integer in exponent + LD DE,0 ; Zero NMSB and LSB +RETINT: LD HL,FPEXP ; Point to exponent + LD C,A ; CDE = MSB,NMSB and LSB + LD (HL),B ; Save exponent + LD B,0 ; CDE = integer to normalise + INC HL ; Point to sign of result + LD (HL),80H ; Set sign of result + RLA ; Carry = sign of integer + JP CONPOS ; Set sign of result + +ABS: CALL TSTSGN ; Test sign of FPREG + RET P ; Return if positive +INVSGN: LD HL,FPREG+2 ; Point to MSB + LD A,(HL) ; Get sign of mantissa + XOR 80H ; Invert sign of mantissa + LD (HL),A ; Re-save sign of mantissa + RET + +STAKFP: EX DE,HL ; Save code string address + LD HL,(FPREG) ; LSB,NLSB of FPREG + EX (SP),HL ; Stack them,get return + PUSH HL ; Re-save return + LD HL,(FPREG+2) ; MSB and exponent of FPREG + EX (SP),HL ; Stack them,get return + PUSH HL ; Re-save return + EX DE,HL ; Restore code string address + RET + +PHLTFP: CALL LOADFP ; Number at HL to BCDE +FPBCDE: EX DE,HL ; Save code string address + LD (FPREG),HL ; Save LSB,NLSB of number + LD H,B ; Exponent of number + LD L,C ; MSB of number + LD (FPREG+2),HL ; Save MSB and exponent + EX DE,HL ; Restore code string address + RET + +BCDEFP: LD HL,FPREG ; Point to FPREG +LOADFP: LD E,(HL) ; Get LSB of number + INC HL + LD D,(HL) ; Get NMSB of number + INC HL + LD C,(HL) ; Get MSB of number + INC HL + LD B,(HL) ; Get exponent of number +INCHL: INC HL ; Used for conditional "INC HL" + RET + +FPTHL: LD DE,FPREG ; Point to FPREG +DETHL4: LD B,4 ; 4 bytes to move +DETHLB: LD A,(DE) ; Get source + LD (HL),A ; Save destination + INC DE ; Next source + INC HL ; Next destination + DEC B ; Count bytes + JP NZ,DETHLB ; Loop if more + RET + +SIGNS: LD HL,FPREG+2 ; Point to MSB of FPREG + LD A,(HL) ; Get MSB + RLCA ; Old sign to carry + SCF ; Set MSBit + RRA ; Set MSBit of MSB + LD (HL),A ; Save new MSB + CCF ; Complement sign + RRA ; Old sign to carry + INC HL + INC HL + LD (HL),A ; Set sign of result + LD A,C ; Get MSB + RLCA ; Old sign to carry + SCF ; Set MSBit + RRA ; Set MSBit of MSB + LD C,A ; Save MSB + RRA + XOR (HL) ; New sign of result + RET + +CMPNUM: LD A,B ; Get exponent of number + OR A + JP Z,TSTSGN ; Zero - Test sign of FPREG + LD HL,RETREL ; Return relation routine + PUSH HL ; Save for return + CALL TSTSGN ; Test sign of FPREG + LD A,C ; Get MSB of number + RET Z ; FPREG zero - Number's MSB + LD HL,FPREG+2 ; MSB of FPREG + XOR (HL) ; Combine signs + LD A,C ; Get MSB of number + RET M ; Exit if signs different + CALL CMPFP ; Compare FP numbers + RRA ; Get carry to sign + XOR C ; Combine with MSB of number + RET + +CMPFP: INC HL ; Point to exponent + LD A,B ; Get exponent + CP (HL) ; Compare exponents + RET NZ ; Different + DEC HL ; Point to MBS + LD A,C ; Get MSB + CP (HL) ; Compare MSBs + RET NZ ; Different + DEC HL ; Point to NMSB + LD A,D ; Get NMSB + CP (HL) ; Compare NMSBs + RET NZ ; Different + DEC HL ; Point to LSB + LD A,E ; Get LSB + SUB (HL) ; Compare LSBs + RET NZ ; Different + POP HL ; Drop RETurn + POP HL ; Drop another RETurn + RET + +FPINT: LD B,A ; <- Move + LD C,A ; <- exponent + LD D,A ; <- to all + LD E,A ; <- bits + OR A ; Test exponent + RET Z ; Zero - Return zero + PUSH HL ; Save pointer to number + CALL BCDEFP ; Move FPREG to BCDE + CALL SIGNS ; Set MSBs & sign of result + XOR (HL) ; Combine with sign of FPREG + LD H,A ; Save combined signs + CALL M,DCBCDE ; Negative - Decrement BCDE + LD A,80H+24 ; 24 bits + SUB B ; Bits to shift + CALL SCALE ; Shift BCDE + LD A,H ; Get combined sign + RLA ; Sign to carry + CALL C,FPROND ; Negative - Round number up + LD B,0 ; Zero exponent + CALL C,COMPL ; If negative make positive + POP HL ; Restore pointer to number + RET + +DCBCDE: DEC DE ; Decrement BCDE + LD A,D ; Test LSBs + AND E + INC A + RET NZ ; Exit if LSBs not FFFF + DEC BC ; Decrement MSBs + RET + +INT: LD HL,FPEXP ; Point to exponent + LD A,(HL) ; Get exponent + CP 80H+24 ; Integer accuracy only? + LD A,(FPREG) ; Get LSB + RET NC ; Yes - Already integer + LD A,(HL) ; Get exponent + CALL FPINT ; F.P to integer + LD (HL),80H+24 ; Save 24 bit integer + LD A,E ; Get LSB of number + PUSH AF ; Save LSB + LD A,C ; Get MSB of number + RLA ; Sign to carry + CALL CONPOS ; Set sign of result + POP AF ; Restore LSB of number + RET + +MLDEBC: LD HL,0 ; Clear partial product + LD A,B ; Test multiplier + OR C + RET Z ; Return zero if zero + LD A,16 ; 16 bits +MLDBLP: ADD HL,HL ; Shift P.P left + JP C,BSERR ; ?BS Error if overflow + EX DE,HL + ADD HL,HL ; Shift multiplier left + EX DE,HL + JP NC,NOMLAD ; Bit was zero - No add + ADD HL,BC ; Add multiplicand + JP C,BSERR ; ?BS Error if overflow +NOMLAD: DEC A ; Count bits + JP NZ,MLDBLP ; More + RET + +ASCTFP: CP "-" ; Negative? + PUSH AF ; Save it and flags + JP Z,CNVNUM ; Yes - Convert number + CP "+" ; Positive? + JP Z,CNVNUM ; Yes - Convert number + DEC HL ; DEC 'cos GETCHR INCs +CNVNUM: CALL RESZER ; Set result to zero + LD B,A ; Digits after point counter + LD D,A ; Sign of exponent + LD E,A ; Exponent of ten + CPL + LD C,A ; Before or after point flag +MANLP: CALL GETCHR ; Get next character + JP C,ADDIG ; Digit - Add to number + CP "." + JP Z,DPOINT ; "." - Flag point + CP "E" + JP NZ,CONEXP ; Not "E" - Scale number + CALL GETCHR ; Get next character + CALL SGNEXP ; Get sign of exponent +EXPLP: CALL GETCHR ; Get next character + JP C,EDIGIT ; Digit - Add to exponent + INC D ; Is sign negative? + JP NZ,CONEXP ; No - Scale number + XOR A + SUB E ; Negate exponent + LD E,A ; And re-save it + INC C ; Flag end of number +DPOINT: INC C ; Flag point passed + JP Z,MANLP ; Zero - Get another digit +CONEXP: PUSH HL ; Save code string address + LD A,E ; Get exponent + SUB B ; Subtract digits after point +SCALMI: CALL P,SCALPL ; Positive - Multiply number + JP P,ENDCON ; Positive - All done + PUSH AF ; Save number of times to /10 + CALL DIV10 ; Divide by 10 + POP AF ; Restore count + INC A ; Count divides + +ENDCON: JP NZ,SCALMI ; More to do + POP DE ; Restore code string address + POP AF ; Restore sign of number + CALL Z,INVSGN ; Negative - Negate number + EX DE,HL ; Code string address to HL + RET + +SCALPL: RET Z ; Exit if no scaling needed +MULTEN: PUSH AF ; Save count + CALL MLSP10 ; Multiply number by 10 + POP AF ; Restore count + DEC A ; Count multiplies + RET + +ADDIG: PUSH DE ; Save sign of exponent + LD D,A ; Save digit + LD A,B ; Get digits after point + ADC A,C ; Add one if after point + LD B,A ; Re-save counter + PUSH BC ; Save point flags + PUSH HL ; Save code string address + PUSH DE ; Save digit + CALL MLSP10 ; Multiply number by 10 + POP AF ; Restore digit + SUB "0" ; Make it absolute + CALL RSCALE ; Re-scale number + POP HL ; Restore code string address + POP BC ; Restore point flags + POP DE ; Restore sign of exponent + JP MANLP ; Get another digit + +RSCALE: CALL STAKFP ; Put number on stack + CALL FLGREL ; Digit to add to FPREG +PADD: POP BC ; Restore number + POP DE + JP FPADD ; Add BCDE to FPREG and return + +EDIGIT: LD A,E ; Get digit + RLCA ; Times 2 + RLCA ; Times 4 + ADD A,E ; Times 5 + RLCA ; Times 10 + ADD A,(HL) ; Add next digit + SUB "0" ; Make it absolute + LD E,A ; Save new digit + JP EXPLP ; Look for another digit + +LINEIN: PUSH HL ; Save code string address + LD HL,INMSG ; Output " in " + CALL PRS ; Output string at HL + POP HL ; Restore code string address +PRNTHL: EX DE,HL ; Code string address to DE + XOR A + LD B,80H+24 ; 24 bits + CALL RETINT ; Return the integer + LD HL,PRNUMS ; Print number string + PUSH HL ; Save for return +NUMASC: LD HL,PBUFF ; Convert number to ASCII + PUSH HL ; Save for return + CALL TSTSGN ; Test sign of FPREG + LD (HL)," " ; Space at start + JP P,SPCFST ; Positive - Space to start + LD (HL),"-" ; "-" sign at start +SPCFST: INC HL ; First byte of number + LD (HL),"0" ; "0" if zero + JP Z,JSTZER ; Return "0" if zero + PUSH HL ; Save buffer address + CALL M,INVSGN ; Negate FPREG if negative + XOR A ; Zero A + PUSH AF ; Save it + CALL RNGTST ; Test number is in range +SIXDIG: LD BC,9143H ; BCDE - 99999.9 + LD DE,4FF8H + CALL CMPNUM ; Compare numbers + OR A + JP PO,INRNG ; > 99999.9 - Sort it out + POP AF ; Restore count + CALL MULTEN ; Multiply by ten + PUSH AF ; Re-save count + JP SIXDIG ; Test it again + +GTSIXD: CALL DIV10 ; Divide by 10 + POP AF ; Get count + INC A ; Count divides + PUSH AF ; Re-save count + CALL RNGTST ; Test number is in range +INRNG: CALL ROUND ; Add 0.5 to FPREG + INC A + CALL FPINT ; F.P to integer + CALL FPBCDE ; Move BCDE to FPREG + LD BC,0306H ; 1E+06 to 1E-03 range + POP AF ; Restore count + ADD A,C ; 6 digits before point + INC A ; Add one + JP M,MAKNUM ; Do it in "E" form if < 1E-02 + CP 6+1+1 ; More than 999999 ? + JP NC,MAKNUM ; Yes - Do it in "E" form + INC A ; Adjust for exponent + LD B,A ; Exponent of number + LD A,2 ; Make it zero after + +MAKNUM: DEC A ; Adjust for digits to do + DEC A + POP HL ; Restore buffer address + PUSH AF ; Save count + LD DE,POWERS ; Powers of ten + DEC B ; Count digits before point + JP NZ,DIGTXT ; Not zero - Do number + LD (HL),"." ; Save point + INC HL ; Move on + LD (HL),"0" ; Save zero + INC HL ; Move on +DIGTXT: DEC B ; Count digits before point + LD (HL),"." ; Save point in case + CALL Z,INCHL ; Last digit - move on + PUSH BC ; Save digits before point + PUSH HL ; Save buffer address + PUSH DE ; Save powers of ten + CALL BCDEFP ; Move FPREG to BCDE + POP HL ; Powers of ten table + LD B, "0"-1 ; ASCII "0" - 1 +TRYAGN: INC B ; Count subtractions + LD A,E ; Get LSB + SUB (HL) ; Subtract LSB + LD E,A ; Save LSB + INC HL + LD A,D ; Get NMSB + SBC A,(HL) ; Subtract NMSB + LD D,A ; Save NMSB + INC HL + LD A,C ; Get MSB + SBC A,(HL) ; Subtract MSB + LD C,A ; Save MSB + DEC HL ; Point back to start + DEC HL + JP NC,TRYAGN ; No overflow - Try again + CALL PLUCDE ; Restore number + INC HL ; Start of next number + CALL FPBCDE ; Move BCDE to FPREG + EX DE,HL ; Save point in table + POP HL ; Restore buffer address + LD (HL),B ; Save digit in buffer + INC HL ; And move on + POP BC ; Restore digit count + DEC C ; Count digits + JP NZ,DIGTXT ; More - Do them + DEC B ; Any decimal part? + JP Z,DOEBIT ; No - Do "E" bit +SUPTLZ: DEC HL ; Move back through buffer + LD A,(HL) ; Get character + CP "0" ; "0" character? + JP Z,SUPTLZ ; Yes - Look back for more + CP "." ; A decimal point? + CALL NZ,INCHL ; Move back over digit + +DOEBIT: POP AF ; Get "E" flag + JP Z,NOENED ; No "E" needed - End buffer + LD (HL),"E" ; Put "E" in buffer + INC HL ; And move on + LD (HL),"+" ; Put '+' in buffer + JP P,OUTEXP ; Positive - Output exponent + LD (HL),"-" ; Put "-" in buffer + CPL ; Negate exponent + INC A +OUTEXP: LD B,"0"-1 ; ASCII "0" - 1 +EXPTEN: INC B ; Count subtractions + SUB 10 ; Tens digit + JP NC,EXPTEN ; More to do + ADD A,"0"+10 ; Restore and make ASCII + INC HL ; Move on + LD (HL),B ; Save MSB of exponent +JSTZER: INC HL ; + LD (HL),A ; Save LSB of exponent + INC HL +NOENED: LD (HL),C ; Mark end of buffer + POP HL ; Restore code string address + RET + +RNGTST: LD BC,9474H ; BCDE = 999999. + LD DE,23F7H + CALL CMPNUM ; Compare numbers + OR A + POP HL ; Return address to HL + JP PO,GTSIXD ; Too big - Divide by ten + JP (HL) ; Otherwise return to caller + +HALF: DB 00H,00H,00H,80H ; 0.5 + +POWERS: DB 0A0H,086H,001H ; 100000 + DB 010H,027H,000H ; 10000 + DB 0E8H,003H,000H ; 1000 + DB 064H,000H,000H ; 100 + DB 00AH,000H,000H ; 10 + DB 001H,000H,000H ; 1 + +NEGAFT: LD HL,INVSGN ; Negate result + EX (SP),HL ; To be done after caller + JP (HL) ; Return to caller + +SQR: CALL STAKFP ; Put value on stack + LD HL,HALF ; Set power to 1/2 + CALL PHLTFP ; Move 1/2 to FPREG + +POWER: POP BC ; Get base + POP DE + CALL TSTSGN ; Test sign of power + LD A,B ; Get exponent of base + JP Z,EXP ; Make result 1 if zero + JP P,POWER1 ; Positive base - Ok + OR A ; Zero to negative power? + JP Z,DZERR ; Yes - ?/0 Error +POWER1: OR A ; Base zero? + JP Z,SAVEXP ; Yes - Return zero + PUSH DE ; Save base + PUSH BC + LD A,C ; Get MSB of base + OR 01111111B ; Get sign status + CALL BCDEFP ; Move power to BCDE + JP P,POWER2 ; Positive base - Ok + PUSH DE ; Save power + PUSH BC + CALL INT ; Get integer of power + POP BC ; Restore power + POP DE + PUSH AF ; MSB of base + CALL CMPNUM ; Power an integer? + POP HL ; Restore MSB of base + LD A,H ; but don't affect flags + RRA ; Exponent odd or even? +POWER2: POP HL ; Restore MSB and exponent + LD (FPREG+2),HL ; Save base in FPREG + POP HL ; LSBs of base + LD (FPREG),HL ; Save in FPREG + CALL C,NEGAFT ; Odd power - Negate result + CALL Z,INVSGN ; Negative base - Negate it + PUSH DE ; Save power + PUSH BC + CALL LOG ; Get LOG of base + POP BC ; Restore power + POP DE + CALL FPMULT ; Multiply LOG by power + +EXP: CALL STAKFP ; Put value on stack + LD BC,08138H ; BCDE = 1/Ln(2) + LD DE,0AA3BH + CALL FPMULT ; Multiply value by 1/LN(2) + LD A,(FPEXP) ; Get exponent + CP 80H+8 ; Is it in range? + JP NC,OVTST1 ; No - Test for overflow + CALL INT ; Get INT of FPREG + ADD A,80H ; For excess 128 + ADD A,2 ; Exponent > 126? + JP C,OVTST1 ; Yes - Test for overflow + PUSH AF ; Save scaling factor + LD HL,UNITY ; Point to 1. + CALL ADDPHL ; Add 1 to FPREG + CALL MULLN2 ; Multiply by LN(2) + POP AF ; Restore scaling factor + POP BC ; Restore exponent + POP DE + PUSH AF ; Save scaling factor + CALL SUBCDE ; Subtract exponent from FPREG + CALL INVSGN ; Negate result + LD HL,EXPTAB ; Coefficient table + CALL SMSER1 ; Sum the series + LD DE,0 ; Zero LSBs + POP BC ; Scaling factor + LD C,D ; Zero MSB + JP FPMULT ; Scale result to correct value + +EXPTAB: DB 8 ; Table used by EXP + DB 040H,02EH,094H,074H ; -1/7! (-1/5040) + DB 070H,04FH,02EH,077H ; 1/6! ( 1/720) + DB 06EH,002H,088H,07AH ; -1/5! (-1/120) + DB 0E6H,0A0H,02AH,07CH ; 1/4! ( 1/24) + DB 050H,0AAH,0AAH,07EH ; -1/3! (-1/6) + DB 0FFH,0FFH,07FH,07FH ; 1/2! ( 1/2) + DB 000H,000H,080H,081H ; -1/1! (-1/1) + DB 000H,000H,000H,081H ; 1/0! ( 1/1) + +SUMSER: CALL STAKFP ; Put FPREG on stack + LD DE,MULT ; Multiply by "X" + PUSH DE ; To be done after + PUSH HL ; Save address of table + CALL BCDEFP ; Move FPREG to BCDE + CALL FPMULT ; Square the value + POP HL ; Restore address of table +SMSER1: CALL STAKFP ; Put value on stack + LD A,(HL) ; Get number of coefficients + INC HL ; Point to start of table + CALL PHLTFP ; Move coefficient to FPREG + DB 06H ; Skip "POP AF" +SUMLP: POP AF ; Restore count + POP BC ; Restore number + POP DE + DEC A ; Cont coefficients + RET Z ; All done + PUSH DE ; Save number + PUSH BC + PUSH AF ; Save count + PUSH HL ; Save address in table + CALL FPMULT ; Multiply FPREG by BCDE + POP HL ; Restore address in table + CALL LOADFP ; Number at HL to BCDE + PUSH HL ; Save address in table + CALL FPADD ; Add coefficient to FPREG + POP HL ; Restore address in table + JP SUMLP ; More coefficients + +RND: CALL TSTSGN ; Test sign of FPREG + LD HL,SEED+2 ; Random number seed + JP M,RESEED ; Negative - Re-seed + LD HL,LSTRND ; Last random number + CALL PHLTFP ; Move last RND to FPREG + LD HL,SEED+2 ; Random number seed + RET Z ; Return if RND(0) + ADD A,(HL) ; Add (SEED)+2) + AND 00000111B ; 0 to 7 + LD B,0 + LD (HL),A ; Re-save seed + INC HL ; Move to coefficient table + ADD A,A ; 4 bytes + ADD A,A ; per entry + LD C,A ; BC = Offset into table + ADD HL,BC ; Point to coefficient + CALL LOADFP ; Coefficient to BCDE + CALL FPMULT ; ; Multiply FPREG by coefficient + LD A,(SEED+1) ; Get (SEED+1) + INC A ; Add 1 + AND 00000011B ; 0 to 3 + LD B,0 + CP 1 ; Is it zero? + ADC A,B ; Yes - Make it 1 + LD (SEED+1),A ; Re-save seed + LD HL,RNDTAB-4 ; Addition table + ADD A,A ; 4 bytes + ADD A,A ; per entry + LD C,A ; BC = Offset into table + ADD HL,BC ; Point to value + CALL ADDPHL ; Add value to FPREG +RND1: CALL BCDEFP ; Move FPREG to BCDE + LD A,E ; Get LSB + LD E,C ; LSB = MSB + XOR 01001111B ; Fiddle around + LD C,A ; New MSB + LD (HL),80H ; Set exponent + DEC HL ; Point to MSB + LD B,(HL) ; Get MSB + LD (HL),80H ; Make value -0.5 + LD HL,SEED ; Random number seed + INC (HL) ; Count seed + LD A,(HL) ; Get seed + SUB 171 ; Do it modulo 171 + JP NZ,RND2 ; Non-zero - Ok + LD (HL),A ; Zero seed + INC C ; Fillde about + DEC D ; with the + INC E ; number +RND2: CALL BNORM ; Normalise number + LD HL,LSTRND ; Save random number + JP FPTHL ; Move FPREG to last and return + +RESEED: LD (HL),A ; Re-seed random numbers + DEC HL + LD (HL),A + DEC HL + LD (HL),A + JP RND1 ; Return RND seed + +RNDTAB: DB 068H,0B1H,046H,068H ; Table used by RND + DB 099H,0E9H,092H,069H + DB 010H,0D1H,075H,068H + +COS: LD HL,HALFPI ; Point to PI/2 + CALL ADDPHL ; Add it to PPREG +SIN: CALL STAKFP ; Put angle on stack + LD BC,8349H ; BCDE = 2 PI + LD DE,0FDBH + CALL FPBCDE ; Move 2 PI to FPREG + POP BC ; Restore angle + POP DE + CALL DVBCDE ; Divide angle by 2 PI + CALL STAKFP ; Put it on stack + CALL INT ; Get INT of result + POP BC ; Restore number + POP DE + CALL SUBCDE ; Make it 0 <= value < 1 + LD HL,QUARTR ; Point to 0.25 + CALL SUBPHL ; Subtract value from 0.25 + CALL TSTSGN ; Test sign of value + SCF ; Flag positive + JP P,SIN1 ; Positive - Ok + CALL ROUND ; Add 0.5 to value + CALL TSTSGN ; Test sign of value + OR A ; Flag negative +SIN1: PUSH AF ; Save sign + CALL P,INVSGN ; Negate value if positive + LD HL,QUARTR ; Point to 0.25 + CALL ADDPHL ; Add 0.25 to value + POP AF ; Restore sign + CALL NC,INVSGN ; Negative - Make positive + LD HL,SINTAB ; Coefficient table + JP SUMSER ; Evaluate sum of series + +HALFPI: DB 0DBH,00FH,049H,081H ; 1.5708 (PI/2) + +QUARTR: DB 000H,000H,000H,07FH ; 0.25 + +SINTAB: DB 5 ; Table used by SIN + DB 0BAH,0D7H,01EH,086H ; 39.711 + DB 064H,026H,099H,087H ;-76.575 + DB 058H,034H,023H,087H ; 81.602 + DB 0E0H,05DH,0A5H,086H ;-41.342 + DB 0DAH,00FH,049H,083H ; 6.2832 + +TAN: CALL STAKFP ; Put angle on stack + CALL SIN ; Get SIN of angle + POP BC ; Restore angle + POP HL + CALL STAKFP ; Save SIN of angle + EX DE,HL ; BCDE = Angle + CALL FPBCDE ; Angle to FPREG + CALL COS ; Get COS of angle + JP DIV ; TAN = SIN / COS + +ATN: CALL TSTSGN ; Test sign of value + CALL M,NEGAFT ; Negate result after if -ve + CALL M,INVSGN ; Negate value if -ve + LD A,(FPEXP) ; Get exponent + CP 81H ; Number less than 1? + JP C,ATN1 ; Yes - Get arc tangnt + LD BC,8100H ; BCDE = 1 + LD D,C + LD E,C + CALL DVBCDE ; Get reciprocal of number + LD HL,SUBPHL ; Sub angle from PI/2 + PUSH HL ; Save for angle > 1 +ATN1: LD HL,ATNTAB ; Coefficient table + CALL SUMSER ; Evaluate sum of series + LD HL,HALFPI ; PI/2 - angle in case > 1 + RET ; Number > 1 - Sub from PI/2 + +ATNTAB: DB 9 ; Table used by ATN + DB 04AH,0D7H,03BH,078H ; 1/17 + DB 002H,06EH,084H,07BH ;-1/15 + DB 0FEH,0C1H,02FH,07CH ; 1/13 + DB 074H,031H,09AH,07DH ;-1/11 + DB 084H,03DH,05AH,07DH ; 1/9 + DB 0C8H,07FH,091H,07EH ;-1/7 + DB 0E4H,0BBH,04CH,07EH ; 1/5 + DB 06CH,0AAH,0AAH,07FH ;-1/3 + DB 000H,000H,000H,081H ; 1/1 + +CASFFW: CALL FLPLED ; Turn on cassette + LD B,0 ; Set 1 second delay +DELAYB: CALL DELAY ; Wait a bit + DEC B ; Count + JP NZ,DELAYB ; More delay needed + RET + +CASFF: JP FLPLED ; Flip tape LED + +ARET: RET ; A RETurn instruction + +CONMON: PUSH HL ; Output character to screen + PUSH BC ; + PUSH DE ; + PUSH AF ; + CALL MONTST ; See if NAS-SYS + JP NZ,NASOUT ; NAS-SYS - Output ASCII + POP AF ; Get character + PUSH AF ; And re-save + CP LF ; ASCII Line feed? + JP Z,IGCHR ; Yes - Ignore it + CP BKSP ; ASCII back space? + JP NZ,CONOT1 ; No - Test for CR + LD A,TBS ; NASBUG back space +CONOT1: CP CR ; ASCII CR? + JP NZ,OUTCHR ; No - Output character + LD A,TCR ; NASBUG CR + JP OUTCHR ; Output it + +NASOUT: POP AF ; Get character + PUSH AF ; And re-save +OUTCHR: CALL MONOUT ; Output it +IGCHR: POP AF ; Restore character + POP DE ; + POP BC ; + POP HL ; + RET + +GETINP: PUSH HL ; Get an input character + PUSH BC ; + PUSH DE ; + CALL MONTST ; See if NAS-SYS + JP Z,GETTIN ; "T" monitor - Get input + DW _BLNK + JP CONVIN ; Convert to ASCII + +GETTIN: CALL TIN ; "T" input a character + JP NC,GETTIN ; No input - wait +CONVIN: CP TBS ; NASBUG back space? + JP NZ,CNVIN1 ; No - Test for break + LD A,BKSP ; ASCII back space +CNVIN1: CP TBRK ; NASBUG break? + JP NZ,CNVIN2 ; No - Test for control Z + LD A,CTRLC ; Control C +CNVIN2: CP CTRLZ ; ^Z? + JP NZ,CNVIN3 ; No - Test for escape + LD A,DEL ; Delete +CNVIN3: CP ESC ; "ESC" ? + JP NZ,CNVIN4 ; No - Test for CR + LD A,CTRLC ; Control C +CNVIN4: CP TCR ; NASBUG CR? + JP NZ,CNVIN5 ; No - Return character + LD A,CR ; ASCII CR +CNVIN5: POP DE + POP BC + POP HL + RET + +CHKBRK: XOR A ; Check for break + CALL SFTENT ; Test for shift/enter + JP Z,TBRK2 ; Yes - Test for second break + LD A,(BRKFLG) ; Get break flag + OR A ; Break flag set? + JP NZ,TBRK2 ; Yes - Test for second break + XOR A ; Flag no break + RET + +TBRK2: CALL BREAK2 ; Second break? + LD A,-1 ; Flag break + RET + +GUART: IN A,(UARTS) ; Get UART status + RLA ; Any data ready? + JP NC,GUART ; No - wait until there is + IN A,(UARTD) ; Get data from UART + RET + +UARTOT: OUT (UARTD),A ; Send data to UART +URTOLP: IN A,(UARTS) ; Get status + ADD A,A ; Byte sent? + RET M ; Yes - Return + JP URTOLP ; Keep waiting + +SUART: PUSH AF ; Save A + CALL UARTOT ; Send it to UART + POP AF ; Restore A + RET + + NOP + NOP + +SFTENT: PUSH HL ; Test for Shift Enter from KBD + LD A,00000010B ; Reset KBD counter mask + LD HL,PORT0 ; Get old contents + XOR (HL) ; Toggle bit + OUT (0),A ; Reset KBD counter + XOR 00000001B ; Toggle bit + OUT (0),A ; Next row + XOR 00000010B + OUT (0),A ; Clear "clear" strobe + LD A,(HL) ; Get old value + OUT (0),A ; Original contents + ADD HL,DE ; ?? WHAT ?? + POP HL ; Restore HL + IN A,(0) ; Read in row + AND 00010010B ; Mask SHIFT and ENTER + RET + +CLS: CALL MONTST ; See if NAS-SYS + JP Z,TCLS ; "T" CLS + LD A,CS ; ASCII Clear screen + JP CONMON ; Output character + +TCLS: LD A,TCS ; NASBUG Clear screen + JP CONMON ; Output character + +DELAY: XOR A ; Delay routine +DELAY1: PUSH AF ; PUSHes and POPs delay + POP AF + PUSH AF + POP AF + DEC A ; Count delays + JP NZ,DELAY1 ; More delay + RET + +WIDTH: CALL GETINT ; Get integer 0-255 + LD A,E ; Width to A + LD (LWIDTH),A ; Set width + RET + +LINES: CALL GETNUM ; Get a number + CALL DEINT ; Get integer -32768 to 32767 + EX DE,HL + LD (LINESC),HL ; Set lines counter + LD (LINESN),HL ; Set lines number + EX DE,HL ; Restore code string address + RET + +DEEK: CALL DEINT ; Get integer -32768 to 32767 + PUSH DE ; Save number + POP HL ; Number to HL + LD B,(HL) ; Get LSB of contents + INC HL + LD A,(HL) ; Get MSB of contents + JP ABPASS ; Return integer AB + +DOKE: CALL GETNUM ; Get a number + CALL DEINT ; Get integer -32768 to 32767 + PUSH DE ; Save address + CALL CHKSYN ; Make sure "," follows + DB "," + CALL GETNUM ; Get a number + CALL DEINT ; Get integer -32768 to 32767 + EX (SP),HL ; Save value,get address + LD (HL),E ; Save LSB of value + INC HL + LD (HL),D ; Save MSB of value + POP HL ; Restore code string address + RET + +JJUMP1: DI ; Disable interrupts + LD IX,-1 ; Flag cold start + JP CSTART ; Go and initialise + +SCREEN: CALL GETINT ; Get integer 0 to 255 + PUSH AF ; Save column + CALL CHKSYN ; Make sure "," follows + DB "," + CALL GETINT ; Get integer 0 to 255 + POP BC ; Column to B + PUSH HL ; Save code string address + PUSH BC ; Save column + CALL SCRADR ; Calculate screen address + PUSH HL ; Save screen address + CALL MONTST ; See if NAS-SYS + JP Z,TMNCUR ; "T" monitor - "T" cursor + POP HL ; Restore screen address + LD (CURSOR),HL ; Set new cursor position + POP HL ; Rstore code string address + RET + +TMNCUR: LD HL,(TCUR) ; Get address or cursor + LD (HL)," " ; Remove cursor + POP HL ; Get new cursor address + LD (TCUR),HL ; Set new cursor + LD (HL),"_" ; Put it on screen + POP HL ; Restore code string address + RET + +SCRADR: LD HL,VDU+10-65 ; SCREEN VDU address (0,0) + LD B,0 + LD C,A ; Line to BC + OR A ; Test it + JP Z,FCERR ; Zero - ?FC Error + CP 16+1 ; 16 lines + JP P,FCERR ; > 16 - ?FC Error + POP DE ; RETurn address + POP AF ; Get column + PUSH DE ; Re-save RETurn + LD D,0 + LD E,A ; Column to DE + OR A ; Test it + JP Z,FCERR ; Zero - ?FC Error + CP 48+1 ; 48 characters per line + JP P,FCERR ; > 48 - ?FC Error + ADD HL,DE ; Add column to address + LD D,0 + LD E,C ; Line to DE + LD B,64 ; 64 Bytes per line +ADD64X: ADD HL,DE ; Add line + DJNZ ADD64X ; SIXTY FOUR TIMES!!! + RET + +FLPLED: CALL MONTST ; See if NAS-SYS + JP Z,TMFLP ; "T" MFLP + DW _MFLP + RET + +TMFLP: JP MFLP ; Flip drive LED + +MONOUT: PUSH AF ; Save character + CALL MONTST ; See if NAS-SYS + JP Z,TMNOUT ; "T" output + POP AF ; Restore character + DB _ROUT ; Output it + RET + +TMNOUT: POP AF ; Restore character + JP TOUT ; "T" output + +BREAK2: LD A,(BRKFLG) ; Break flag set? + JP NZ,RETCTC ; Yes - Return ^C + CALL MONTST ; See if NAS-SYS + JP Z,TCHINP ; Get "T" character input + DW _RIN ; Scan for a character + RET + +TCHINP: JP TIN ; "T" input a character + +RETCTC: LD A,0 ; Clear Break flag + LD (BRKFLG),A + LD A,CTRLC ; Return ^C + RET + +MONTST: LD A,(MONSTT+1) ; "T" monitor or NAS-SYS? + CP 33H ; 31 00 10 / 31 33 0C + RET + +SAVE: CALL FLPLED ; Flip tape LED + CALL MONTST ; See if NAS-SYS + JP Z,TSAVE ; "T" save + DW _WRIT ; Save program + RET + +TSAVE: LD A,(MONTYP) ; "T2" or "T4" (FLAGS!!!) + JP Z,T4WR ; T4 Write + JP T2DUMP ; T2 Dump + +MONLD: CALL FLPLED ; Flip tape LED + CALL MONTST ; See if NAS-SYS + JP Z,TLOAD ; "T" load + LD A,"R" ; Set READ + LD (ARGN),A + DW _READ ; Load program + RET + +TLOAD: LD A,(MONTYP) ; "T2" or "T4" (FLAGS!!!) + JP Z,T4READ ; T4 Read + JP T2DUMP ; T2 Dump ?????????? + +MONITR: CALL MONTST ; See if NAS-SYS + JP Z,MONSTT ; Jump to zero if "T" + DW _MRET ; Return to NAS-SYS + +MONVE: CALL FLPLED ; Flip tape LED + CALL MONTST ; See if NAS-SYS + JP Z,FCERR ; Verify not available on "T" + LD A,"V" ; Set VERIFY + LD (ARGN),A + DW _VRFY ; Verify tape + RET + +INITST: LD A,0 ; Clear break flag + LD (BRKFLG),A + CALL MONTST ; See if NAS-SYS + JP Z,INIT ; "T" - No NMI vector + LD HL,BREAK ; Set NMI gives break + LD (NMI),HL + PUSH IX ; Get start up condition + POP AF ; "Z" set if cold , Else clear + OR A ; "Cold" or "Cool" start? + JP NZ,INIT ; "Cool" don't init NAS-SYS + LD B,15 ; Delay for keyboard clear + CALL DELAYB ; Allow time for key release + CALL STMON ; Initialise NAS-SYS + JP INIT ; Initialise BASIC + +BREAK: PUSH AF ; Save character + LD A,-1 + LD (BRKFLG),A ; Flag break + POP AF ; Restore character +ARETN: RETN ; Return from NMI + + NOP + +INLINE: DW _INLN ; Get an input line + PUSH DE ; Save cursor address + PUSH DE ; Cursor address to HL + POP HL + LD DE,48-1 ; Length of line-1 + ADD HL,DE ; Point to end of line +ENDLIN: LD A,(HL) ; Get end of line + CP " " ; Space? + JP NZ,LINTBF ; No - Copy to buffer + DEC E ; Back 1 character + LD A,0 ; Wasteful test on E + OR E + JP Z,LINTBF ; Start of line - Copy it + DEC HL ; Back 1 character + JP ENDLIN ; Keep looking for end + +LINTBF: PUSH DE ; Line length to BC + POP BC + INC BC ; Length +1 + LD DE,BUFFER ; Input buffer + POP HL ; Line start + PUSH BC ; Save length + LDIR ; Move line to buffer + LD A,0 + LD (DE),A ; Mark end of buffer with 00 + POP BC ; Restore buffer length + LD B,C ; Length returned in B + LD HL,BUFFER-1 ; Point to start of buffer-1 + RET + +GETXYA: CALL CHKSYN ; Make sure "(" follows + DB "(" + CALL GETNUM ; Get a number + CALL DEINT ; Get integer -32768 to 32767 + PUSH DE ; Save "X" + CALL CHKSYN ; Make sure "," follows + DB "," + CALL GETNUM ; Get a number + CALL CHKSYN ; Make sure ")" follows + DB ")" + CALL DEINT ; Get integer -32768 to 32767 + PUSH HL ; Save code string address + POP IY ; In IY + CALL XYPOS ; Address and bit mask + PUSH AF ; Save mask + CALL ADJCOL ; Adjust column + CALL SCRADR ; Get VDU address + POP AF ; Restore bit mask + LD B,11000000B ; Block graphics base + OR B ; Set bits 7 & 6 + RET + +SETB: CALL GETXYA ; Get co-ords and VDU address + PUSH AF ; Save bit mask + LD A,(HL) ; Get character from screen + CP 11000000B ; Is it a block graphic? + JP NC,SETOR ; Yes - OR new bit + POP AF ; Restore bit mask +PUTBIT: LD (HL),A ; Put character on screen +RESCSA: PUSH IY ; Restore code string address + POP HL ; From IY + RET + +SETOR: POP BC ; Restore bit mask + OR B ; Merge the bits + JP PUTBIT ; Save on screen + +RESETB: CALL GETXYA ; Get co-ords and VDU address + PUSH AF ; Save bit mask + LD A,(HL) ; Get byte from screen + CP 11000000B ; Is it a block graphic? + JP C,NORES ; No - Leave it + LD B,00111111B ; Six bits per block + AND B ; Clear bits 7 & 6 + POP BC ; Get bit mask + AND B ; Test for common bit + JP Z,RESCSA ; None - Leave it + LD A,(HL) ; Get byte from screen + AND 00111111B ; Isolate bit + XOR B ; Clear that bit + CP 11000000B ; Is it a graphic blank? + JP NZ,PUTBIT ; No - Save character + LD A," " ; Put a space there + JP PUTBIT ; Save the space + +NORES: POP BC ; Drop bit mask + JP RESCSA ; Restore code string address + +POINTB: CALL GETXYA ; Get co-ords and VDU address + LD B,(HL) ; Get character from screen + CALL TSTBIT ; Test if bit is set + JP NZ,POINT0 ; Different - Return zero + LD A,0 + LD B,1 ; Integer AB = 1 +POINTX: POP HL ; Drop return + PUSH IY ; PUSH code string address + LD DE,RETNUM ; To return a number + PUSH DE ; Save for return + JP ABPASS ; Return integer AB + +POINT0: LD B,0 ; Set zero + JP POINTX ; Return value + +XYPOS: POP BC ; Get return address + POP HL ; Get column + PUSH HL ; And re-save + PUSH BC ; Put back return address + LD A,L ; Get column + LD B,00000001B ; 2 bits per character + AND B ; Odd or even bit + PUSH AF ; Save it + PUSH DE ; Get row + POP HL ; to HL + LD DE,0 ; Zero line count + LD BC,3 ; 3 blocks per line + INC HL +DIV3LP: SBC HL,BC ; Subtract 3 + INC DE ; Count the subtractions + JP Z,DIV3EX ; Exactly - Exit + JP P,DIV3LP ; More to do + +DIV3EX: ADD HL,BC ; Restore number + POP AF ; Restore column and odd/even + OR A ; Set flags (NZ or Z) + LD A,L ; Get remainder from /3 + JP Z,NOREMD ; No remainder + ADD A,3 ; Adjust remainder +NOREMD: LD B,A ; Bit number+1 to B + LD A,00000001B ; Bit to rotate +SHFTBT: RLCA ; Shift bit left + DJNZ SHFTBT ; Count shifts + RRA ; Restore correct place + RET + +ADJCOL: POP BC ; Restore return address + POP AF ; Get bit mask + POP HL ; Get column + PUSH AF ; Re-save but mask + LD A,L ; Get column + RRA ; Divide by 2 + ADD A,1 ; Start at column 1 + AND 00111111B ; 0 to 63 + LD H,A ; Save column in H + PUSH HL ; Re-save column + PUSH BC ; Put back return + LD A,E ; Get row + RET + +SMOTOR: CALL CASFF ; Flip tape drive + LD A,(HL) ; Get byte + RET + +JPLDSV: LD A,(BRKLIN) ; CLOAD or CSAVE? + CP -1 + JP NZ,SNDHDR ; CSAVE - Send header + JP GETHDR ; CLOAD - Get header + +CRLIN1: CALL PRNTCR ; Output CRLF + JP GETLIN ; Get an input line + +CRLIN: CALL PRNTCR ; Output CRLF + JP GETLIN ; Get an input line + +TSTBIT: PUSH AF ; Save bit mask + AND B ; Get common bits + POP BC ; Restore bit mask + CP B ; Same bit set? + LD A,0 ; Return 0 in A + RET + +OUTNCR: CALL OUTC ; Output character in A + JP PRNTCR ; Output CRLF + +JJUMP: JP JJUMP1 ; "Cool" start + +ZJUMP: JP BRKRET ; Warm start + END diff --git a/new/apps/basic/searle8kbasic.asm b/new/apps/basic/searle8kbasic.asm new file mode 100644 index 0000000..933df7a --- /dev/null +++ b/new/apps/basic/searle8kbasic.asm @@ -0,0 +1,4341 @@ +;================================================================================== +; The updates to the original BASIC within this file are copyright Grant Searle +; +; You have permission to use this for NON COMMERCIAL USE ONLY +; If you wish to use it elsewhere, please include an acknowledgement to myself. +; +; http://searle.hostei.com/grant/index.html +; +; eMail: home.micros01@btinternet.com +; +; If the above don't work, please perform an Internet search to see if I have +; updated the web page hosting service. +; +;================================================================================== + +; NASCOM ROM BASIC Ver 4.7, (C) 1978 Microsoft +; Scanned from source published in 80-BUS NEWS from Vol 2, Issue 3 +; (May-June 1983) to Vol 3, Issue 3 (May-June 1984) +; Adapted for the freeware Zilog Macro Assembler 2.10 to produce +; the original ROM code (checksum A934H). PA + +; GENERAL EQUATES + +CTRLC .EQU 03H ; Control "C" +CTRLG .EQU 07H ; Control "G" +BKSP .EQU 08H ; Back space +LF .EQU 0AH ; Line feed +CS .EQU 0CH ; Clear screen +CR .EQU 0DH ; Carriage return +CTRLO .EQU 0FH ; Control "O" +CTRLQ .EQU 11H ; Control "Q" +CTRLR .EQU 12H ; Control "R" +CTRLS .EQU 13H ; Control "S" +CTRLU .EQU 15H ; Control "U" +ESC .EQU 1BH ; Escape +DEL .EQU 7FH ; Delete + +; BASIC WORK SPACE LOCATIONS + +WRKSPC .EQU 2045H ; BASIC Work space +USR .EQU WRKSPC+3H ; "USR (x)" jump +OUTSUB .EQU WRKSPC+6H ; "OUT p,n" +OTPORT .EQU WRKSPC+7H ; Port (p) +DIVSUP .EQU WRKSPC+9H ; Division support routine +DIV1 .EQU WRKSPC+0AH ; <- Values +DIV2 .EQU WRKSPC+0EH ; <- to +DIV3 .EQU WRKSPC+12H ; <- be +DIV4 .EQU WRKSPC+15H ; <-inserted +SEED .EQU WRKSPC+17H ; Random number seed +LSTRND .EQU WRKSPC+3AH ; Last random number +INPSUB .EQU WRKSPC+3EH ; #INP (x)" Routine +INPORT .EQU WRKSPC+3FH ; PORT (x) +NULLS .EQU WRKSPC+41H ; Number of nulls +LWIDTH .EQU WRKSPC+42H ; Terminal width +COMMAN .EQU WRKSPC+43H ; Width for commas +NULFLG .EQU WRKSPC+44H ; Null after input byte flag +CTLOFG .EQU WRKSPC+45H ; Control "O" flag +LINESC .EQU WRKSPC+46H ; Lines counter +LINESN .EQU WRKSPC+48H ; Lines number +CHKSUM .EQU WRKSPC+4AH ; Array load/save check sum +NMIFLG .EQU WRKSPC+4CH ; Flag for NMI break routine +BRKFLG .EQU WRKSPC+4DH ; Break flag +RINPUT .EQU WRKSPC+4EH ; Input reflection +POINT .EQU WRKSPC+51H ; "POINT" reflection (unused) +PSET .EQU WRKSPC+54H ; "SET" reflection +RESET .EQU WRKSPC+57H ; "RESET" reflection +STRSPC .EQU WRKSPC+5AH ; Bottom of string space +LINEAT .EQU WRKSPC+5CH ; Current line number +BASTXT .EQU WRKSPC+5EH ; Pointer to start of program +BUFFER .EQU WRKSPC+61H ; Input buffer +STACK .EQU WRKSPC+66H ; Initial stack +CURPOS .EQU WRKSPC+0ABH ; Character position on line +LCRFLG .EQU WRKSPC+0ACH ; Locate/Create flag +TYPE .EQU WRKSPC+0ADH ; Data type flag +DATFLG .EQU WRKSPC+0AEH ; Literal statement flag +LSTRAM .EQU WRKSPC+0AFH ; Last available RAM +TMSTPT .EQU WRKSPC+0B1H ; Temporary string pointer +TMSTPL .EQU WRKSPC+0B3H ; Temporary string pool +TMPSTR .EQU WRKSPC+0BFH ; Temporary string +STRBOT .EQU WRKSPC+0C3H ; Bottom of string space +CUROPR .EQU WRKSPC+0C5H ; Current operator in EVAL +LOOPST .EQU WRKSPC+0C7H ; First statement of loop +DATLIN .EQU WRKSPC+0C9H ; Line of current DATA item +FORFLG .EQU WRKSPC+0CBH ; "FOR" loop flag +LSTBIN .EQU WRKSPC+0CCH ; Last byte entered +READFG .EQU WRKSPC+0CDH ; Read/Input flag +BRKLIN .EQU WRKSPC+0CEH ; Line of break +NXTOPR .EQU WRKSPC+0D0H ; Next operator in EVAL +ERRLIN .EQU WRKSPC+0D2H ; Line of error +CONTAD .EQU WRKSPC+0D4H ; Where to CONTinue +PROGND .EQU WRKSPC+0D6H ; End of program +VAREND .EQU WRKSPC+0D8H ; End of variables +ARREND .EQU WRKSPC+0DAH ; End of arrays +NXTDAT .EQU WRKSPC+0DCH ; Next data item +FNRGNM .EQU WRKSPC+0DEH ; Name of FN argument +FNARG .EQU WRKSPC+0E0H ; FN argument value +FPREG .EQU WRKSPC+0E4H ; Floating point register +FPEXP .EQU FPREG+3 ; Floating point exponent +SGNRES .EQU WRKSPC+0E8H ; Sign of result +PBUFF .EQU WRKSPC+0E9H ; Number print buffer +MULVAL .EQU WRKSPC+0F6H ; Multiplier +PROGST .EQU WRKSPC+0F9H ; Start of program text area +STLOOK .EQU WRKSPC+15DH ; Start of memory test + +; BASIC ERROR CODE VALUES + +NF .EQU 00H ; NEXT without FOR +SN .EQU 02H ; Syntax error +RG .EQU 04H ; RETURN without GOSUB +OD .EQU 06H ; Out of DATA +FC .EQU 08H ; Function call error +OV .EQU 0AH ; Overflow +OM .EQU 0CH ; Out of memory +UL .EQU 0EH ; Undefined line number +BS .EQU 10H ; Bad subscript +DD .EQU 12H ; Re-DIMensioned array +DZ .EQU 14H ; Division by zero (/0) +ID .EQU 16H ; Illegal direct +TM .EQU 18H ; Type miss-match +OS .EQU 1AH ; Out of string space +LS .EQU 1CH ; String too long +ST .EQU 1EH ; String formula too complex +CN .EQU 20H ; Can't CONTinue +UF .EQU 22H ; UnDEFined FN function +MO .EQU 24H ; Missing operand +HX .EQU 26H ; HEX error +BN .EQU 28H ; BIN error + + .ORG 00150H + +COLD: JP STARTB ; Jump for cold start +WARM: JP WARMST ; Jump for warm start +STARTB: + LD IX,0 ; Flag cold start + JP CSTART ; Jump to initialise + + .WORD DEINT ; Get integer -32768 to 32767 + .WORD ABPASS ; Return integer in AB + + +CSTART: LD HL,WRKSPC ; Start of workspace RAM + LD SP,HL ; Set up a temporary stack + JP INITST ; Go to initialise + +INIT: LD DE,INITAB ; Initialise workspace + LD B,INITBE-INITAB+3; Bytes to copy + LD HL,WRKSPC ; Into workspace RAM +COPY: LD A,(DE) ; Get source + LD (HL),A ; To destination + INC HL ; Next destination + INC DE ; Next source + DEC B ; Count bytes + JP NZ,COPY ; More to move + LD SP,HL ; Temporary stack + CALL CLREG ; Clear registers and stack + CALL PRNTCRLF ; Output CRLF + LD (BUFFER+72+1),A ; Mark end of buffer + LD (PROGST),A ; Initialise program area +MSIZE: LD HL,MEMMSG ; Point to message + CALL PRS ; Output "Memory size" + CALL PROMPT ; Get input with '?' + CALL GETCHR ; Get next character + OR A ; Set flags + JP NZ,TSTMEM ; If number - Test if RAM there + LD HL,STLOOK ; Point to start of RAM +MLOOP: INC HL ; Next byte + LD A,H ; Above address FFFF ? + OR L + JP Z,SETTOP ; Yes - 64K RAM + LD A,(HL) ; Get contents + LD B,A ; Save it + CPL ; Flip all bits + LD (HL),A ; Put it back + CP (HL) ; RAM there if same + LD (HL),B ; Restore old contents + JP Z,MLOOP ; If RAM - test next byte + JP SETTOP ; Top of RAM found + +TSTMEM: CALL ATOH ; Get high memory into DE + OR A ; Set flags on last byte + JP NZ,SNERR ; ?SN Error if bad character + EX DE,HL ; Address into HL + DEC HL ; Back one byte + LD A,11011001B ; Test byte + LD B,(HL) ; Get old contents + LD (HL),A ; Load test byte + CP (HL) ; RAM there if same + LD (HL),B ; Restore old contents + JP NZ,MSIZE ; Ask again if no RAM + +SETTOP: DEC HL ; Back one byte + LD DE,STLOOK-1 ; See if enough RAM + CALL CPDEHL ; Compare DE with HL + JP C,MSIZE ; Ask again if not enough RAM + LD DE,0-50 ; 50 Bytes string space + LD (LSTRAM),HL ; Save last available RAM + ADD HL,DE ; Allocate string space + LD (STRSPC),HL ; Save string space + CALL CLRPTR ; Clear program area + LD HL,(STRSPC) ; Get end of memory + LD DE,0-17 ; Offset for free bytes + ADD HL,DE ; Adjust HL + LD DE,PROGST ; Start of program text + LD A,L ; Get LSB + SUB E ; Adjust it + LD L,A ; Re-save + LD A,H ; Get MSB + SBC A,D ; Adjust it + LD H,A ; Re-save + PUSH HL ; Save bytes free + LD HL,SIGNON ; Sign-on message + CALL PRS ; Output string + POP HL ; Get bytes free back + CALL PRNTHL ; Output amount of free memory + LD HL,BFREE ; " Bytes free" message + CALL PRS ; Output string + +WARMST: LD SP,STACK ; Temporary stack +BRKRET: CALL CLREG ; Clear registers and stack + JP PRNTOK ; Go to get command line + +BFREE: .BYTE " Bytes free",CR,LF,0,0 + +SIGNON: .BYTE "Z80 BASIC Ver 4.7b",CR,LF + .BYTE "Copyright ",40,"C",41 + .BYTE " 1978 by Microsoft",CR,LF,0,0 + +MEMMSG: .BYTE "Memory top",0 + +; FUNCTION ADDRESS TABLE + +FNCTAB: .WORD SGN + .WORD INT + .WORD ABS + .WORD USR + .WORD FRE + .WORD INP + .WORD POS + .WORD SQR + .WORD RND + .WORD LOG + .WORD EXP + .WORD COS + .WORD SIN + .WORD TAN + .WORD ATN + .WORD PEEK + .WORD DEEK + .WORD POINT + .WORD LEN + .WORD STR + .WORD VAL + .WORD ASC + .WORD CHR + .WORD HEX + .WORD BIN + .WORD LEFT + .WORD RIGHT + .WORD MID + +; RESERVED WORD LIST + +WORDS: .BYTE 'E'+80H,"ND" + .BYTE 'F'+80H,"OR" + .BYTE 'N'+80H,"EXT" + .BYTE 'D'+80H,"ATA" + .BYTE 'I'+80H,"NPUT" + .BYTE 'D'+80H,"IM" + .BYTE 'R'+80H,"EAD" + .BYTE 'L'+80H,"ET" + .BYTE 'G'+80H,"OTO" + .BYTE 'R'+80H,"UN" + .BYTE 'I'+80H,"F" + .BYTE 'R'+80H,"ESTORE" + .BYTE 'G'+80H,"OSUB" + .BYTE 'R'+80H,"ETURN" + .BYTE 'R'+80H,"EM" + .BYTE 'S'+80H,"TOP" + .BYTE 'O'+80H,"UT" + .BYTE 'O'+80H,"N" + .BYTE 'N'+80H,"ULL" + .BYTE 'W'+80H,"AIT" + .BYTE 'D'+80H,"EF" + .BYTE 'P'+80H,"OKE" + .BYTE 'D'+80H,"OKE" + .BYTE 'S'+80H,"CREEN" + .BYTE 'L'+80H,"INES" + .BYTE 'C'+80H,"LS" + .BYTE 'W'+80H,"IDTH" + .BYTE 'M'+80H,"ONITOR" + .BYTE 'S'+80H,"ET" + .BYTE 'R'+80H,"ESET" + .BYTE 'P'+80H,"RINT" + .BYTE 'C'+80H,"ONT" + .BYTE 'L'+80H,"IST" + .BYTE 'C'+80H,"LEAR" + .BYTE 'C'+80H,"LOAD" + .BYTE 'C'+80H,"SAVE" + .BYTE 'N'+80H,"EW" + + .BYTE 'T'+80H,"AB(" + .BYTE 'T'+80H,"O" + .BYTE 'F'+80H,"N" + .BYTE 'S'+80H,"PC(" + .BYTE 'T'+80H,"HEN" + .BYTE 'N'+80H,"OT" + .BYTE 'S'+80H,"TEP" + + .BYTE '+'+80H + .BYTE '-'+80H + .BYTE '*'+80H + .BYTE '/'+80H + .BYTE '^'+80H + .BYTE 'A'+80H,"ND" + .BYTE 'O'+80H,"R" + .BYTE '>'+80H + .BYTE '='+80H + .BYTE '<'+80H + + .BYTE 'S'+80H,"GN" + .BYTE 'I'+80H,"NT" + .BYTE 'A'+80H,"BS" + .BYTE 'U'+80H,"SR" + .BYTE 'F'+80H,"RE" + .BYTE 'I'+80H,"NP" + .BYTE 'P'+80H,"OS" + .BYTE 'S'+80H,"QR" + .BYTE 'R'+80H,"ND" + .BYTE 'L'+80H,"OG" + .BYTE 'E'+80H,"XP" + .BYTE 'C'+80H,"OS" + .BYTE 'S'+80H,"IN" + .BYTE 'T'+80H,"AN" + .BYTE 'A'+80H,"TN" + .BYTE 'P'+80H,"EEK" + .BYTE 'D'+80H,"EEK" + .BYTE 'P'+80H,"OINT" + .BYTE 'L'+80H,"EN" + .BYTE 'S'+80H,"TR$" + .BYTE 'V'+80H,"AL" + .BYTE 'A'+80H,"SC" + .BYTE 'C'+80H,"HR$" + .BYTE 'H'+80H,"EX$" + .BYTE 'B'+80H,"IN$" + .BYTE 'L'+80H,"EFT$" + .BYTE 'R'+80H,"IGHT$" + .BYTE 'M'+80H,"ID$" + .BYTE 80H ; End of list marker + +; KEYWORD ADDRESS TABLE + +WORDTB: .WORD PEND + .WORD FOR + .WORD NEXT + .WORD DATA + .WORD INPUT + .WORD DIM + .WORD READ + .WORD LET + .WORD GOTO + .WORD RUN + .WORD IF + .WORD RESTOR + .WORD GOSUB + .WORD RETURN + .WORD REM + .WORD STOP + .WORD POUT + .WORD ON + .WORD NULL + .WORD WAIT + .WORD DEF + .WORD POKE + .WORD DOKE + .WORD REM + .WORD LINES + .WORD CLS + .WORD WIDTH + .WORD MONITR + .WORD PSET + .WORD RESET + .WORD PRINT + .WORD CONT + .WORD LIST + .WORD CLEAR + .WORD REM + .WORD REM + .WORD NEW + +; RESERVED WORD TOKEN VALUES + +ZEND .EQU 080H ; END +ZFOR .EQU 081H ; FOR +ZDATA .EQU 083H ; DATA +ZGOTO .EQU 088H ; GOTO +ZGOSUB .EQU 08CH ; GOSUB +ZREM .EQU 08EH ; REM +ZPRINT .EQU 09EH ; PRINT +ZNEW .EQU 0A4H ; NEW + +ZTAB .EQU 0A5H ; TAB +ZTO .EQU 0A6H ; TO +ZFN .EQU 0A7H ; FN +ZSPC .EQU 0A8H ; SPC +ZTHEN .EQU 0A9H ; THEN +ZNOT .EQU 0AAH ; NOT +ZSTEP .EQU 0ABH ; STEP + +ZPLUS .EQU 0ACH ; + +ZMINUS .EQU 0ADH ; - +ZTIMES .EQU 0AEH ; * +ZDIV .EQU 0AFH ; / +ZOR .EQU 0B2H ; OR +ZGTR .EQU 0B3H ; > +ZEQUAL .EQU 0B4H ; M +ZLTH .EQU 0B5H ; < +ZSGN .EQU 0B6H ; SGN +ZPOINT .EQU 0C7H ; POINT +ZLEFT .EQU 0CDH +2 ; LEFT$ + +; ARITHMETIC PRECEDENCE TABLE + +PRITAB: .BYTE 79H ; Precedence value + .WORD PADD ; FPREG = + FPREG + + .BYTE 79H ; Precedence value + .WORD PSUB ; FPREG = - FPREG + + .BYTE 7CH ; Precedence value + .WORD MULT ; PPREG = * FPREG + + .BYTE 7CH ; Precedence value + .WORD DIV ; FPREG = / FPREG + + .BYTE 7FH ; Precedence value + .WORD POWER ; FPREG = ^ FPREG + + .BYTE 50H ; Precedence value + .WORD PAND ; FPREG = AND FPREG + + .BYTE 46H ; Precedence value + .WORD POR ; FPREG = OR FPREG + +; BASIC ERROR CODE LIST + +ERRORS: .BYTE "NF" ; NEXT without FOR + .BYTE "SN" ; Syntax error + .BYTE "RG" ; RETURN without GOSUB + .BYTE "OD" ; Out of DATA + .BYTE "FC" ; Illegal function call + .BYTE "OV" ; Overflow error + .BYTE "OM" ; Out of memory + .BYTE "UL" ; Undefined line + .BYTE "BS" ; Bad subscript + .BYTE "DD" ; Re-DIMensioned array + .BYTE "/0" ; Division by zero + .BYTE "ID" ; Illegal direct + .BYTE "TM" ; Type mis-match + .BYTE "OS" ; Out of string space + .BYTE "LS" ; String too long + .BYTE "ST" ; String formula too complex + .BYTE "CN" ; Can't CONTinue + .BYTE "UF" ; Undefined FN function + .BYTE "MO" ; Missing operand + .BYTE "HX" ; HEX error + .BYTE "BN" ; BIN error + +; INITIALISATION TABLE ------------------------------------------------------- + +INITAB: JP WARMST ; Warm start jump + JP FCERR ; "USR (X)" jump (Set to Error) + OUT (0),A ; "OUT p,n" skeleton + RET + SUB 0 ; Division support routine + LD L,A + LD A,H + SBC A,0 + LD H,A + LD A,B + SBC A,0 + LD B,A + LD A,0 + RET + .BYTE 0,0,0 ; Random number seed table used by RND + .BYTE 035H,04AH,0CAH,099H ;-2.65145E+07 + .BYTE 039H,01CH,076H,098H ; 1.61291E+07 + .BYTE 022H,095H,0B3H,098H ;-1.17691E+07 + .BYTE 00AH,0DDH,047H,098H ; 1.30983E+07 + .BYTE 053H,0D1H,099H,099H ;-2-01612E+07 + .BYTE 00AH,01AH,09FH,098H ;-1.04269E+07 + .BYTE 065H,0BCH,0CDH,098H ;-1.34831E+07 + .BYTE 0D6H,077H,03EH,098H ; 1.24825E+07 + .BYTE 052H,0C7H,04FH,080H ; Last random number + IN A,(0) ; INP (x) skeleton + RET + .BYTE 1 ; POS (x) number (1) + .BYTE 255 ; Terminal width (255 = no auto CRLF) + .BYTE 28 ; Width for commas (3 columns) + .BYTE 0 ; No nulls after input bytes + .BYTE 0 ; Output enabled (^O off) + .WORD 20 ; Initial lines counter + .WORD 20 ; Initial lines number + .WORD 0 ; Array load/save check sum + .BYTE 0 ; Break not by NMI + .BYTE 0 ; Break flag + JP TTYLIN ; Input reflection (set to TTY) + JP $0000 ; POINT reflection unused + JP $0000 ; SET reflection + JP $0000 ; RESET reflection + .WORD STLOOK ; Temp string space + .WORD -2 ; Current line number (cold) + .WORD PROGST+1 ; Start of program text +INITBE: + +; END OF INITIALISATION TABLE --------------------------------------------------- + +ERRMSG: .BYTE " Error",0 +INMSG: .BYTE " in ",0 +ZERBYT .EQU $-1 ; A zero byte +OKMSG: .BYTE "Ok",CR,LF,0,0 +BRKMSG: .BYTE "Break",0 + +BAKSTK: LD HL,4 ; Look for "FOR" block with + ADD HL,SP ; same index as specified +LOKFOR: LD A,(HL) ; Get block ID + INC HL ; Point to index address + CP ZFOR ; Is it a "FOR" token + RET NZ ; No - exit + LD C,(HL) ; BC = Address of "FOR" index + INC HL + LD B,(HL) + INC HL ; Point to sign of STEP + PUSH HL ; Save pointer to sign + LD L,C ; HL = address of "FOR" index + LD H,B + LD A,D ; See if an index was specified + OR E ; DE = 0 if no index specified + EX DE,HL ; Specified index into HL + JP Z,INDFND ; Skip if no index given + EX DE,HL ; Index back into DE + CALL CPDEHL ; Compare index with one given +INDFND: LD BC,16-3 ; Offset to next block + POP HL ; Restore pointer to sign + RET Z ; Return if block found + ADD HL,BC ; Point to next block + JP LOKFOR ; Keep on looking + +MOVUP: CALL ENFMEM ; See if enough memory +MOVSTR: PUSH BC ; Save end of source + EX (SP),HL ; Swap source and dest" end + POP BC ; Get end of destination +MOVLP: CALL CPDEHL ; See if list moved + LD A,(HL) ; Get byte + LD (BC),A ; Move it + RET Z ; Exit if all done + DEC BC ; Next byte to move to + DEC HL ; Next byte to move + JP MOVLP ; Loop until all bytes moved + +CHKSTK: PUSH HL ; Save code string address + LD HL,(ARREND) ; Lowest free memory + LD B,0 ; BC = Number of levels to test + ADD HL,BC ; 2 Bytes for each level + ADD HL,BC + .BYTE 3EH ; Skip "PUSH HL" +ENFMEM: PUSH HL ; Save code string address + LD A,0D0H ;LOW -48 ; 48 Bytes minimum RAM + SUB L + LD L,A + LD A,0FFH; HIGH (-48) ; 48 Bytes minimum RAM + SBC A,H + JP C,OMERR ; Not enough - ?OM Error + LD H,A + ADD HL,SP ; Test if stack is overflowed + POP HL ; Restore code string address + RET C ; Return if enough mmory +OMERR: LD E,OM ; ?OM Error + JP ERROR + +DATSNR: LD HL,(DATLIN) ; Get line of current DATA item + LD (LINEAT),HL ; Save as current line +SNERR: LD E,SN ; ?SN Error + .BYTE 01H ; Skip "LD E,DZ" +DZERR: LD E,DZ ; ?/0 Error + .BYTE 01H ; Skip "LD E,NF" +NFERR: LD E,NF ; ?NF Error + .BYTE 01H ; Skip "LD E,DD" +DDERR: LD E,DD ; ?DD Error + .BYTE 01H ; Skip "LD E,UF" +UFERR: LD E,UF ; ?UF Error + .BYTE 01H ; Skip "LD E,OV +OVERR: LD E,OV ; ?OV Error + .BYTE 01H ; Skip "LD E,TM" +TMERR: LD E,TM ; ?TM Error + +ERROR: CALL CLREG ; Clear registers and stack + LD (CTLOFG),A ; Enable output (A is 0) + CALL STTLIN ; Start new line + LD HL,ERRORS ; Point to error codes + LD D,A ; D = 0 (A is 0) + LD A,'?' + CALL OUTC ; Output '?' + ADD HL,DE ; Offset to correct error code + LD A,(HL) ; First character + CALL OUTC ; Output it + CALL GETCHR ; Get next character + CALL OUTC ; Output it + LD HL,ERRMSG ; "Error" message +ERRIN: CALL PRS ; Output message + LD HL,(LINEAT) ; Get line of error + LD DE,-2 ; Cold start error if -2 + CALL CPDEHL ; See if cold start error + JP Z,CSTART ; Cold start error - Restart + LD A,H ; Was it a direct error? + AND L ; Line = -1 if direct error + INC A + CALL NZ,LINEIN ; No - output line of error + .BYTE 3EH ; Skip "POP BC" +POPNOK: POP BC ; Drop address in input buffer + +PRNTOK: XOR A ; Output "Ok" and get command + LD (CTLOFG),A ; Enable output + CALL STTLIN ; Start new line + LD HL,OKMSG ; "Ok" message + CALL PRS ; Output "Ok" +GETCMD: LD HL,-1 ; Flag direct mode + LD (LINEAT),HL ; Save as current line + CALL GETLIN ; Get an input line + JP C,GETCMD ; Get line again if break + CALL GETCHR ; Get first character + INC A ; Test if end of line + DEC A ; Without affecting Carry + JP Z,GETCMD ; Nothing entered - Get another + PUSH AF ; Save Carry status + CALL ATOH ; Get line number into DE + PUSH DE ; Save line number + CALL CRUNCH ; Tokenise rest of line + LD B,A ; Length of tokenised line + POP DE ; Restore line number + POP AF ; Restore Carry + JP NC,EXCUTE ; No line number - Direct mode + PUSH DE ; Save line number + PUSH BC ; Save length of tokenised line + XOR A + LD (LSTBIN),A ; Clear last byte input + CALL GETCHR ; Get next character + OR A ; Set flags + PUSH AF ; And save them + CALL SRCHLN ; Search for line number in DE + JP C,LINFND ; Jump if line found + POP AF ; Get status + PUSH AF ; And re-save + JP Z,ULERR ; Nothing after number - Error + OR A ; Clear Carry +LINFND: PUSH BC ; Save address of line in prog + JP NC,INEWLN ; Line not found - Insert new + EX DE,HL ; Next line address in DE + LD HL,(PROGND) ; End of program +SFTPRG: LD A,(DE) ; Shift rest of program down + LD (BC),A + INC BC ; Next destination + INC DE ; Next source + CALL CPDEHL ; All done? + JP NZ,SFTPRG ; More to do + LD H,B ; HL - New end of program + LD L,C + LD (PROGND),HL ; Update end of program + +INEWLN: POP DE ; Get address of line, + POP AF ; Get status + JP Z,SETPTR ; No text - Set up pointers + LD HL,(PROGND) ; Get end of program + EX (SP),HL ; Get length of input line + POP BC ; End of program to BC + ADD HL,BC ; Find new end + PUSH HL ; Save new end + CALL MOVUP ; Make space for line + POP HL ; Restore new end + LD (PROGND),HL ; Update end of program pointer + EX DE,HL ; Get line to move up in HL + LD (HL),H ; Save MSB + POP DE ; Get new line number + INC HL ; Skip pointer + INC HL + LD (HL),E ; Save LSB of line number + INC HL + LD (HL),D ; Save MSB of line number + INC HL ; To first byte in line + LD DE,BUFFER ; Copy buffer to program +MOVBUF: LD A,(DE) ; Get source + LD (HL),A ; Save destinations + INC HL ; Next source + INC DE ; Next destination + OR A ; Done? + JP NZ,MOVBUF ; No - Repeat +SETPTR: CALL RUNFST ; Set line pointers + INC HL ; To LSB of pointer + EX DE,HL ; Address to DE +PTRLP: LD H,D ; Address to HL + LD L,E + LD A,(HL) ; Get LSB of pointer + INC HL ; To MSB of pointer + OR (HL) ; Compare with MSB pointer + JP Z,GETCMD ; Get command line if end + INC HL ; To LSB of line number + INC HL ; Skip line number + INC HL ; Point to first byte in line + XOR A ; Looking for 00 byte +FNDEND: CP (HL) ; Found end of line? + INC HL ; Move to next byte + JP NZ,FNDEND ; No - Keep looking + EX DE,HL ; Next line address to HL + LD (HL),E ; Save LSB of pointer + INC HL + LD (HL),D ; Save MSB of pointer + JP PTRLP ; Do next line + +SRCHLN: LD HL,(BASTXT) ; Start of program text +SRCHLP: LD B,H ; BC = Address to look at + LD C,L + LD A,(HL) ; Get address of next line + INC HL + OR (HL) ; End of program found? + DEC HL + RET Z ; Yes - Line not found + INC HL + INC HL + LD A,(HL) ; Get LSB of line number + INC HL + LD H,(HL) ; Get MSB of line number + LD L,A + CALL CPDEHL ; Compare with line in DE + LD H,B ; HL = Start of this line + LD L,C + LD A,(HL) ; Get LSB of next line address + INC HL + LD H,(HL) ; Get MSB of next line address + LD L,A ; Next line to HL + CCF + RET Z ; Lines found - Exit + CCF + RET NC ; Line not found,at line after + JP SRCHLP ; Keep looking + +NEW: RET NZ ; Return if any more on line +CLRPTR: LD HL,(BASTXT) ; Point to start of program + XOR A ; Set program area to empty + LD (HL),A ; Save LSB = 00 + INC HL + LD (HL),A ; Save MSB = 00 + INC HL + LD (PROGND),HL ; Set program end + +RUNFST: LD HL,(BASTXT) ; Clear all variables + DEC HL + +INTVAR: LD (BRKLIN),HL ; Initialise RUN variables + LD HL,(LSTRAM) ; Get end of RAM + LD (STRBOT),HL ; Clear string space + XOR A + CALL RESTOR ; Reset DATA pointers + LD HL,(PROGND) ; Get end of program + LD (VAREND),HL ; Clear variables + LD (ARREND),HL ; Clear arrays + +CLREG: POP BC ; Save return address + LD HL,(STRSPC) ; Get end of working RAN + LD SP,HL ; Set stack + LD HL,TMSTPL ; Temporary string pool + LD (TMSTPT),HL ; Reset temporary string ptr + XOR A ; A = 00 + LD L,A ; HL = 0000 + LD H,A + LD (CONTAD),HL ; No CONTinue + LD (FORFLG),A ; Clear FOR flag + LD (FNRGNM),HL ; Clear FN argument + PUSH HL ; HL = 0000 + PUSH BC ; Put back return +DOAGN: LD HL,(BRKLIN) ; Get address of code to RUN + RET ; Return to execution driver + +PROMPT: LD A,'?' ; '?' + CALL OUTC ; Output character + LD A,' ' ; Space + CALL OUTC ; Output character + JP RINPUT ; Get input line + +CRUNCH: XOR A ; Tokenise line @ HL to BUFFER + LD (DATFLG),A ; Reset literal flag + LD C,2+3 ; 2 byte number and 3 nulls + LD DE,BUFFER ; Start of input buffer +CRNCLP: LD A,(HL) ; Get byte + CP ' ' ; Is it a space? + JP Z,MOVDIR ; Yes - Copy direct + LD B,A ; Save character + CP '"' ; Is it a quote? + JP Z,CPYLIT ; Yes - Copy literal string + OR A ; Is it end of buffer? + JP Z,ENDBUF ; Yes - End buffer + LD A,(DATFLG) ; Get data type + OR A ; Literal? + LD A,(HL) ; Get byte to copy + JP NZ,MOVDIR ; Literal - Copy direct + CP '?' ; Is it '?' short for PRINT + LD A,ZPRINT ; "PRINT" token + JP Z,MOVDIR ; Yes - replace it + LD A,(HL) ; Get byte again + CP '0' ; Is it less than '0' + JP C,FNDWRD ; Yes - Look for reserved words + CP 60; ";"+1 ; Is it "0123456789:;" ? + JP C,MOVDIR ; Yes - copy it direct +FNDWRD: PUSH DE ; Look for reserved words + LD DE,WORDS-1 ; Point to table + PUSH BC ; Save count + LD BC,RETNAD ; Where to return to + PUSH BC ; Save return address + LD B,ZEND-1 ; First token value -1 + LD A,(HL) ; Get byte + CP 'a' ; Less than 'a' ? + JP C,SEARCH ; Yes - search for words + CP 'z'+1 ; Greater than 'z' ? + JP NC,SEARCH ; Yes - search for words + AND 01011111B ; Force upper case + LD (HL),A ; Replace byte +SEARCH: LD C,(HL) ; Search for a word + EX DE,HL +GETNXT: INC HL ; Get next reserved word + OR (HL) ; Start of word? + JP P,GETNXT ; No - move on + INC B ; Increment token value + LD A, (HL) ; Get byte from table + AND 01111111B ; Strip bit 7 + RET Z ; Return if end of list + CP C ; Same character as in buffer? + JP NZ,GETNXT ; No - get next word + EX DE,HL + PUSH HL ; Save start of word + +NXTBYT: INC DE ; Look through rest of word + LD A,(DE) ; Get byte from table + OR A ; End of word ? + JP M,MATCH ; Yes - Match found + LD C,A ; Save it + LD A,B ; Get token value + CP ZGOTO ; Is it "GOTO" token ? + JP NZ,NOSPC ; No - Don't allow spaces + CALL GETCHR ; Get next character + DEC HL ; Cancel increment from GETCHR +NOSPC: INC HL ; Next byte + LD A,(HL) ; Get byte + CP 'a' ; Less than 'a' ? + JP C,NOCHNG ; Yes - don't change + AND 01011111B ; Make upper case +NOCHNG: CP C ; Same as in buffer ? + JP Z,NXTBYT ; Yes - keep testing + POP HL ; Get back start of word + JP SEARCH ; Look at next word + +MATCH: LD C,B ; Word found - Save token value + POP AF ; Throw away return + EX DE,HL + RET ; Return to "RETNAD" +RETNAD: EX DE,HL ; Get address in string + LD A,C ; Get token value + POP BC ; Restore buffer length + POP DE ; Get destination address +MOVDIR: INC HL ; Next source in buffer + LD (DE),A ; Put byte in buffer + INC DE ; Move up buffer + INC C ; Increment length of buffer + SUB ':' ; End of statement? + JP Z,SETLIT ; Jump if multi-statement line + CP ZDATA-3AH ; Is it DATA statement ? + JP NZ,TSTREM ; No - see if REM +SETLIT: LD (DATFLG),A ; Set literal flag +TSTREM: SUB ZREM-3AH ; Is it REM? + JP NZ,CRNCLP ; No - Leave flag + LD B,A ; Copy rest of buffer +NXTCHR: LD A,(HL) ; Get byte + OR A ; End of line ? + JP Z,ENDBUF ; Yes - Terminate buffer + CP B ; End of statement ? + JP Z,MOVDIR ; Yes - Get next one +CPYLIT: INC HL ; Move up source string + LD (DE),A ; Save in destination + INC C ; Increment length + INC DE ; Move up destination + JP NXTCHR ; Repeat + +ENDBUF: LD HL,BUFFER-1 ; Point to start of buffer + LD (DE),A ; Mark end of buffer (A = 00) + INC DE + LD (DE),A ; A = 00 + INC DE + LD (DE),A ; A = 00 + RET + +DODEL: LD A,(NULFLG) ; Get null flag status + OR A ; Is it zero? + LD A,0 ; Zero A - Leave flags + LD (NULFLG),A ; Zero null flag + JP NZ,ECHDEL ; Set - Echo it + DEC B ; Decrement length + JP Z,GETLIN ; Get line again if empty + CALL OUTC ; Output null character + .BYTE 3EH ; Skip "DEC B" +ECHDEL: DEC B ; Count bytes in buffer + DEC HL ; Back space buffer + JP Z,OTKLN ; No buffer - Try again + LD A,(HL) ; Get deleted byte + CALL OUTC ; Echo it + JP MORINP ; Get more input + +DELCHR: DEC B ; Count bytes in buffer + DEC HL ; Back space buffer + CALL OUTC ; Output character in A + JP NZ,MORINP ; Not end - Get more +OTKLN: CALL OUTC ; Output character in A +KILIN: CALL PRNTCRLF ; Output CRLF + JP TTYLIN ; Get line again + +GETLIN: +TTYLIN: LD HL,BUFFER ; Get a line by character + LD B,1 ; Set buffer as empty + XOR A + LD (NULFLG),A ; Clear null flag +MORINP: CALL CLOTST ; Get character and test ^O + LD C,A ; Save character in C + CP DEL ; Delete character? + JP Z,DODEL ; Yes - Process it + LD A,(NULFLG) ; Get null flag + OR A ; Test null flag status + JP Z,PROCES ; Reset - Process character + LD A,0 ; Set a null + CALL OUTC ; Output null + XOR A ; Clear A + LD (NULFLG),A ; Reset null flag +PROCES: LD A,C ; Get character + CP CTRLG ; Bell? + JP Z,PUTCTL ; Yes - Save it + CP CTRLC ; Is it control "C"? + CALL Z,PRNTCRLF ; Yes - Output CRLF + SCF ; Flag break + RET Z ; Return if control "C" + CP CR ; Is it enter? + JP Z,ENDINP ; Yes - Terminate input + CP CTRLU ; Is it control "U"? + JP Z,KILIN ; Yes - Get another line + CP '@' ; Is it "kill line"? + JP Z,OTKLN ; Yes - Kill line + CP '_' ; Is it delete? + JP Z,DELCHR ; Yes - Delete character + CP BKSP ; Is it backspace? + JP Z,DELCHR ; Yes - Delete character + CP CTRLR ; Is it control "R"? + JP NZ,PUTBUF ; No - Put in buffer + PUSH BC ; Save buffer length + PUSH DE ; Save DE + PUSH HL ; Save buffer address + LD (HL),0 ; Mark end of buffer + CALL OUTNCR ; Output and do CRLF + LD HL,BUFFER ; Point to buffer start + CALL PRS ; Output buffer + POP HL ; Restore buffer address + POP DE ; Restore DE + POP BC ; Restore buffer length + JP MORINP ; Get another character + +PUTBUF: CP ' ' ; Is it a control code? + JP C,MORINP ; Yes - Ignore +PUTCTL: LD A,B ; Get number of bytes in buffer + CP 72+1 ; Test for line overflow + LD A,CTRLG ; Set a bell + JP NC,OUTNBS ; Ring bell if buffer full + LD A,C ; Get character + LD (HL),C ; Save in buffer + LD (LSTBIN),A ; Save last input byte + INC HL ; Move up buffer + INC B ; Increment length +OUTIT: CALL OUTC ; Output the character entered + JP MORINP ; Get another character + +OUTNBS: CALL OUTC ; Output bell and back over it + LD A,BKSP ; Set back space + JP OUTIT ; Output it and get more + +CPDEHL: LD A,H ; Get H + SUB D ; Compare with D + RET NZ ; Different - Exit + LD A,L ; Get L + SUB E ; Compare with E + RET ; Return status + +CHKSYN: LD A,(HL) ; Check syntax of character + EX (SP),HL ; Address of test byte + CP (HL) ; Same as in code string? + INC HL ; Return address + EX (SP),HL ; Put it back + JP Z,GETCHR ; Yes - Get next character + JP SNERR ; Different - ?SN Error + +OUTC: PUSH AF ; Save character + LD A,(CTLOFG) ; Get control "O" flag + OR A ; Is it set? + JP NZ,POPAF ; Yes - don't output + POP AF ; Restore character + PUSH BC ; Save buffer length + PUSH AF ; Save character + CP ' ' ; Is it a control code? + JP C,DINPOS ; Yes - Don't INC POS(X) + LD A,(LWIDTH) ; Get line width + LD B,A ; To B + LD A,(CURPOS) ; Get cursor position + INC B ; Width 255? + JP Z,INCLEN ; Yes - No width limit + DEC B ; Restore width + CP B ; At end of line? + CALL Z,PRNTCRLF ; Yes - output CRLF +INCLEN: INC A ; Move on one character + LD (CURPOS),A ; Save new position +DINPOS: POP AF ; Restore character + POP BC ; Restore buffer length + CALL MONOUT ; Send it + RET + +CLOTST: CALL GETINP ; Get input character + AND 01111111B ; Strip bit 7 + CP CTRLO ; Is it control "O"? + RET NZ ; No don't flip flag + LD A,(CTLOFG) ; Get flag + CPL ; Flip it + LD (CTLOFG),A ; Put it back + XOR A ; Null character + RET + +LIST: CALL ATOH ; ASCII number to DE + RET NZ ; Return if anything extra + POP BC ; Rubbish - Not needed + CALL SRCHLN ; Search for line number in DE + PUSH BC ; Save address of line + CALL SETLIN ; Set up lines counter +LISTLP: POP HL ; Restore address of line + LD C,(HL) ; Get LSB of next line + INC HL + LD B,(HL) ; Get MSB of next line + INC HL + LD A,B ; BC = 0 (End of program)? + OR C + JP Z,PRNTOK ; Yes - Go to command mode + CALL COUNT ; Count lines + CALL TSTBRK ; Test for break key + PUSH BC ; Save address of next line + CALL PRNTCRLF ; Output CRLF + LD E,(HL) ; Get LSB of line number + INC HL + LD D,(HL) ; Get MSB of line number + INC HL + PUSH HL ; Save address of line start + EX DE,HL ; Line number to HL + CALL PRNTHL ; Output line number in decimal + LD A,' ' ; Space after line number + POP HL ; Restore start of line address +LSTLP2: CALL OUTC ; Output character in A +LSTLP3: LD A,(HL) ; Get next byte in line + OR A ; End of line? + INC HL ; To next byte in line + JP Z,LISTLP ; Yes - get next line + JP P,LSTLP2 ; No token - output it + SUB ZEND-1 ; Find and output word + LD C,A ; Token offset+1 to C + LD DE,WORDS ; Reserved word list +FNDTOK: LD A,(DE) ; Get character in list + INC DE ; Move on to next + OR A ; Is it start of word? + JP P,FNDTOK ; No - Keep looking for word + DEC C ; Count words + JP NZ,FNDTOK ; Not there - keep looking +OUTWRD: AND 01111111B ; Strip bit 7 + CALL OUTC ; Output first character + LD A,(DE) ; Get next character + INC DE ; Move on to next + OR A ; Is it end of word? + JP P,OUTWRD ; No - output the rest + JP LSTLP3 ; Next byte in line + +SETLIN: PUSH HL ; Set up LINES counter + LD HL,(LINESN) ; Get LINES number + LD (LINESC),HL ; Save in LINES counter + POP HL + RET + +COUNT: PUSH HL ; Save code string address + PUSH DE + LD HL,(LINESC) ; Get LINES counter + LD DE,-1 + ADC HL,DE ; Decrement + LD (LINESC),HL ; Put it back + POP DE + POP HL ; Restore code string address + RET P ; Return if more lines to go + PUSH HL ; Save code string address + LD HL,(LINESN) ; Get LINES number + LD (LINESC),HL ; Reset LINES counter + CALL GETINP ; Get input character + CP CTRLC ; Is it control "C"? + JP Z,RSLNBK ; Yes - Reset LINES and break + POP HL ; Restore code string address + JP COUNT ; Keep on counting + +RSLNBK: LD HL,(LINESN) ; Get LINES number + LD (LINESC),HL ; Reset LINES counter + JP BRKRET ; Go and output "Break" + +FOR: LD A,64H ; Flag "FOR" assignment + LD (FORFLG),A ; Save "FOR" flag + CALL LET ; Set up initial index + POP BC ; Drop RETurn address + PUSH HL ; Save code string address + CALL DATA ; Get next statement address + LD (LOOPST),HL ; Save it for start of loop + LD HL,2 ; Offset for "FOR" block + ADD HL,SP ; Point to it +FORSLP: CALL LOKFOR ; Look for existing "FOR" block + POP DE ; Get code string address + JP NZ,FORFND ; No nesting found + ADD HL,BC ; Move into "FOR" block + PUSH DE ; Save code string address + DEC HL + LD D,(HL) ; Get MSB of loop statement + DEC HL + LD E,(HL) ; Get LSB of loop statement + INC HL + INC HL + PUSH HL ; Save block address + LD HL,(LOOPST) ; Get address of loop statement + CALL CPDEHL ; Compare the FOR loops + POP HL ; Restore block address + JP NZ,FORSLP ; Different FORs - Find another + POP DE ; Restore code string address + LD SP,HL ; Remove all nested loops + +FORFND: EX DE,HL ; Code string address to HL + LD C,8 + CALL CHKSTK ; Check for 8 levels of stack + PUSH HL ; Save code string address + LD HL,(LOOPST) ; Get first statement of loop + EX (SP),HL ; Save and restore code string + PUSH HL ; Re-save code string address + LD HL,(LINEAT) ; Get current line number + EX (SP),HL ; Save and restore code string + CALL TSTNUM ; Make sure it's a number + CALL CHKSYN ; Make sure "TO" is next + .BYTE ZTO ; "TO" token + CALL GETNUM ; Get "TO" expression value + PUSH HL ; Save code string address + CALL BCDEFP ; Move "TO" value to BCDE + POP HL ; Restore code string address + PUSH BC ; Save "TO" value in block + PUSH DE + LD BC,8100H ; BCDE - 1 (default STEP) + LD D,C ; C=0 + LD E,D ; D=0 + LD A,(HL) ; Get next byte in code string + CP ZSTEP ; See if "STEP" is stated + LD A,1 ; Sign of step = 1 + JP NZ,SAVSTP ; No STEP given - Default to 1 + CALL GETCHR ; Jump over "STEP" token + CALL GETNUM ; Get step value + PUSH HL ; Save code string address + CALL BCDEFP ; Move STEP to BCDE + CALL TSTSGN ; Test sign of FPREG + POP HL ; Restore code string address +SAVSTP: PUSH BC ; Save the STEP value in block + PUSH DE + PUSH AF ; Save sign of STEP + INC SP ; Don't save flags + PUSH HL ; Save code string address + LD HL,(BRKLIN) ; Get address of index variable + EX (SP),HL ; Save and restore code string +PUTFID: LD B,ZFOR ; "FOR" block marker + PUSH BC ; Save it + INC SP ; Don't save C + +RUNCNT: CALL TSTBRK ; Execution driver - Test break + LD (BRKLIN),HL ; Save code address for break + LD A,(HL) ; Get next byte in code string + CP ':' ; Multi statement line? + JP Z,EXCUTE ; Yes - Execute it + OR A ; End of line? + JP NZ,SNERR ; No - Syntax error + INC HL ; Point to address of next line + LD A,(HL) ; Get LSB of line pointer + INC HL + OR (HL) ; Is it zero (End of prog)? + JP Z,ENDPRG ; Yes - Terminate execution + INC HL ; Point to line number + LD E,(HL) ; Get LSB of line number + INC HL + LD D,(HL) ; Get MSB of line number + EX DE,HL ; Line number to HL + LD (LINEAT),HL ; Save as current line number + EX DE,HL ; Line number back to DE +EXCUTE: CALL GETCHR ; Get key word + LD DE,RUNCNT ; Where to RETurn to + PUSH DE ; Save for RETurn +IFJMP: RET Z ; Go to RUNCNT if end of STMT +ONJMP: SUB ZEND ; Is it a token? + JP C,LET ; No - try to assign it + CP ZNEW+1-ZEND ; END to NEW ? + JP NC,SNERR ; Not a key word - ?SN Error + RLCA ; Double it + LD C,A ; BC = Offset into table + LD B,0 + EX DE,HL ; Save code string address + LD HL,WORDTB ; Keyword address table + ADD HL,BC ; Point to routine address + LD C,(HL) ; Get LSB of routine address + INC HL + LD B,(HL) ; Get MSB of routine address + PUSH BC ; Save routine address + EX DE,HL ; Restore code string address + +GETCHR: INC HL ; Point to next character + LD A,(HL) ; Get next code string byte + CP ':' ; Z if ':' + RET NC ; NC if > "9" + CP ' ' + JP Z,GETCHR ; Skip over spaces + CP '0' + CCF ; NC if < '0' + INC A ; Test for zero - Leave carry + DEC A ; Z if Null + RET + +RESTOR: EX DE,HL ; Save code string address + LD HL,(BASTXT) ; Point to start of program + JP Z,RESTNL ; Just RESTORE - reset pointer + EX DE,HL ; Restore code string address + CALL ATOH ; Get line number to DE + PUSH HL ; Save code string address + CALL SRCHLN ; Search for line number in DE + LD H,B ; HL = Address of line + LD L,C + POP DE ; Restore code string address + JP NC,ULERR ; ?UL Error if not found +RESTNL: DEC HL ; Byte before DATA statement +UPDATA: LD (NXTDAT),HL ; Update DATA pointer + EX DE,HL ; Restore code string address + RET + + +TSTBRK: RST 18H ; Check input status + RET Z ; No key, go back + RST 10H ; Get the key into A + CP ESC ; Escape key? + JR Z,BRK ; Yes, break + CP CTRLC ; + JR Z,BRK ; Yes, break + CP CTRLS ; Stop scrolling? + RET NZ ; Other key, ignore + + +STALL: RST 10H ; Wait for key + CP CTRLQ ; Resume scrolling? + RET Z ; Release the chokehold + CP CTRLC ; Second break? + JR Z,STOP ; Break during hold exits prog + JR STALL ; Loop until or + +BRK LD A,$FF ; Set BRKFLG + LD (BRKFLG),A ; Store it + + +STOP: RET NZ ; Exit if anything else + .BYTE 0F6H ; Flag "STOP" +PEND: RET NZ ; Exit if anything else + LD (BRKLIN),HL ; Save point of break + .BYTE 21H ; Skip "OR 11111111B" +INPBRK: OR 11111111B ; Flag "Break" wanted + POP BC ; Return not needed and more +ENDPRG: LD HL,(LINEAT) ; Get current line number + PUSH AF ; Save STOP / END status + LD A,L ; Is it direct break? + AND H + INC A ; Line is -1 if direct break + JP Z,NOLIN ; Yes - No line number + LD (ERRLIN),HL ; Save line of break + LD HL,(BRKLIN) ; Get point of break + LD (CONTAD),HL ; Save point to CONTinue +NOLIN: XOR A + LD (CTLOFG),A ; Enable output + CALL STTLIN ; Start a new line + POP AF ; Restore STOP / END status + LD HL,BRKMSG ; "Break" message + JP NZ,ERRIN ; "in line" wanted? + JP PRNTOK ; Go to command mode + +CONT: LD HL,(CONTAD) ; Get CONTinue address + LD A,H ; Is it zero? + OR L + LD E,CN ; ?CN Error + JP Z,ERROR ; Yes - output "?CN Error" + EX DE,HL ; Save code string address + LD HL,(ERRLIN) ; Get line of last break + LD (LINEAT),HL ; Set up current line number + EX DE,HL ; Restore code string address + RET ; CONTinue where left off + +NULL: CALL GETINT ; Get integer 0-255 + RET NZ ; Return if bad value + LD (NULLS),A ; Set nulls number + RET + + +ACCSUM: PUSH HL ; Save address in array + LD HL,(CHKSUM) ; Get check sum + LD B,0 ; BC - Value of byte + LD C,A + ADD HL,BC ; Add byte to check sum + LD (CHKSUM),HL ; Re-save check sum + POP HL ; Restore address in array + RET + +CHKLTR: LD A,(HL) ; Get byte + CP 'A' ; < 'a' ? + RET C ; Carry set if not letter + CP 'Z'+1 ; > 'z' ? + CCF + RET ; Carry set if not letter + +FPSINT: CALL GETCHR ; Get next character +POSINT: CALL GETNUM ; Get integer 0 to 32767 +DEPINT: CALL TSTSGN ; Test sign of FPREG + JP M,FCERR ; Negative - ?FC Error +DEINT: LD A,(FPEXP) ; Get integer value to DE + CP 80H+16 ; Exponent in range (16 bits)? + JP C,FPINT ; Yes - convert it + LD BC,9080H ; BCDE = -32768 + LD DE,0000 + PUSH HL ; Save code string address + CALL CMPNUM ; Compare FPREG with BCDE + POP HL ; Restore code string address + LD D,C ; MSB to D + RET Z ; Return if in range +FCERR: LD E,FC ; ?FC Error + JP ERROR ; Output error- + +ATOH: DEC HL ; ASCII number to DE binary +GETLN: LD DE,0 ; Get number to DE +GTLNLP: CALL GETCHR ; Get next character + RET NC ; Exit if not a digit + PUSH HL ; Save code string address + PUSH AF ; Save digit + LD HL,65529/10 ; Largest number 65529 + CALL CPDEHL ; Number in range? + JP C,SNERR ; No - ?SN Error + LD H,D ; HL = Number + LD L,E + ADD HL,DE ; Times 2 + ADD HL,HL ; Times 4 + ADD HL,DE ; Times 5 + ADD HL,HL ; Times 10 + POP AF ; Restore digit + SUB '0' ; Make it 0 to 9 + LD E,A ; DE = Value of digit + LD D,0 + ADD HL,DE ; Add to number + EX DE,HL ; Number to DE + POP HL ; Restore code string address + JP GTLNLP ; Go to next character + +CLEAR: JP Z,INTVAR ; Just "CLEAR" Keep parameters + CALL POSINT ; Get integer 0 to 32767 to DE + DEC HL ; Cancel increment + CALL GETCHR ; Get next character + PUSH HL ; Save code string address + LD HL,(LSTRAM) ; Get end of RAM + JP Z,STORED ; No value given - Use stored + POP HL ; Restore code string address + CALL CHKSYN ; Check for comma + .BYTE ',' + PUSH DE ; Save number + CALL POSINT ; Get integer 0 to 32767 + DEC HL ; Cancel increment + CALL GETCHR ; Get next character + JP NZ,SNERR ; ?SN Error if more on line + EX (SP),HL ; Save code string address + EX DE,HL ; Number to DE +STORED: LD A,L ; Get LSB of new RAM top + SUB E ; Subtract LSB of string space + LD E,A ; Save LSB + LD A,H ; Get MSB of new RAM top + SBC A,D ; Subtract MSB of string space + LD D,A ; Save MSB + JP C,OMERR ; ?OM Error if not enough mem + PUSH HL ; Save RAM top + LD HL,(PROGND) ; Get program end + LD BC,40 ; 40 Bytes minimum working RAM + ADD HL,BC ; Get lowest address + CALL CPDEHL ; Enough memory? + JP NC,OMERR ; No - ?OM Error + EX DE,HL ; RAM top to HL + LD (STRSPC),HL ; Set new string space + POP HL ; End of memory to use + LD (LSTRAM),HL ; Set new top of RAM + POP HL ; Restore code string address + JP INTVAR ; Initialise variables + +RUN: JP Z,RUNFST ; RUN from start if just RUN + CALL INTVAR ; Initialise variables + LD BC,RUNCNT ; Execution driver loop + JP RUNLIN ; RUN from line number + +GOSUB: LD C,3 ; 3 Levels of stack needed + CALL CHKSTK ; Check for 3 levels of stack + POP BC ; Get return address + PUSH HL ; Save code string for RETURN + PUSH HL ; And for GOSUB routine + LD HL,(LINEAT) ; Get current line + EX (SP),HL ; Into stack - Code string out + LD A,ZGOSUB ; "GOSUB" token + PUSH AF ; Save token + INC SP ; Don't save flags + +RUNLIN: PUSH BC ; Save return address +GOTO: CALL ATOH ; ASCII number to DE binary + CALL REM ; Get end of line + PUSH HL ; Save end of line + LD HL,(LINEAT) ; Get current line + CALL CPDEHL ; Line after current? + POP HL ; Restore end of line + INC HL ; Start of next line + CALL C,SRCHLP ; Line is after current line + CALL NC,SRCHLN ; Line is before current line + LD H,B ; Set up code string address + LD L,C + DEC HL ; Incremented after + RET C ; Line found +ULERR: LD E,UL ; ?UL Error + JP ERROR ; Output error message + +RETURN: RET NZ ; Return if not just RETURN + LD D,-1 ; Flag "GOSUB" search + CALL BAKSTK ; Look "GOSUB" block + LD SP,HL ; Kill all FORs in subroutine + CP ZGOSUB ; Test for "GOSUB" token + LD E,RG ; ?RG Error + JP NZ,ERROR ; Error if no "GOSUB" found + POP HL ; Get RETURN line number + LD (LINEAT),HL ; Save as current + INC HL ; Was it from direct statement? + LD A,H + OR L ; Return to line + JP NZ,RETLIN ; No - Return to line + LD A,(LSTBIN) ; Any INPUT in subroutine? + OR A ; If so buffer is corrupted + JP NZ,POPNOK ; Yes - Go to command mode +RETLIN: LD HL,RUNCNT ; Execution driver loop + EX (SP),HL ; Into stack - Code string out + .BYTE 3EH ; Skip "POP HL" +NXTDTA: POP HL ; Restore code string address + +DATA: .BYTE 01H,3AH ; ':' End of statement +REM: LD C,0 ; 00 End of statement + LD B,0 +NXTSTL: LD A,C ; Statement and byte + LD C,B + LD B,A ; Statement end byte +NXTSTT: LD A,(HL) ; Get byte + OR A ; End of line? + RET Z ; Yes - Exit + CP B ; End of statement? + RET Z ; Yes - Exit + INC HL ; Next byte + CP '"' ; Literal string? + JP Z,NXTSTL ; Yes - Look for another '"' + JP NXTSTT ; Keep looking + +LET: CALL GETVAR ; Get variable name + CALL CHKSYN ; Make sure "=" follows + .BYTE ZEQUAL ; "=" token + PUSH DE ; Save address of variable + LD A,(TYPE) ; Get data type + PUSH AF ; Save type + CALL EVAL ; Evaluate expression + POP AF ; Restore type + EX (SP),HL ; Save code - Get var addr + LD (BRKLIN),HL ; Save address of variable + RRA ; Adjust type + CALL CHKTYP ; Check types are the same + JP Z,LETNUM ; Numeric - Move value +LETSTR: PUSH HL ; Save address of string var + LD HL,(FPREG) ; Pointer to string entry + PUSH HL ; Save it on stack + INC HL ; Skip over length + INC HL + LD E,(HL) ; LSB of string address + INC HL + LD D,(HL) ; MSB of string address + LD HL,(BASTXT) ; Point to start of program + CALL CPDEHL ; Is string before program? + JP NC,CRESTR ; Yes - Create string entry + LD HL,(STRSPC) ; Point to string space + CALL CPDEHL ; Is string literal in program? + POP DE ; Restore address of string + JP NC,MVSTPT ; Yes - Set up pointer + LD HL,TMPSTR ; Temporary string pool + CALL CPDEHL ; Is string in temporary pool? + JP NC,MVSTPT ; No - Set up pointer + .BYTE 3EH ; Skip "POP DE" +CRESTR: POP DE ; Restore address of string + CALL BAKTMP ; Back to last tmp-str entry + EX DE,HL ; Address of string entry + CALL SAVSTR ; Save string in string area +MVSTPT: CALL BAKTMP ; Back to last tmp-str entry + POP HL ; Get string pointer + CALL DETHL4 ; Move string pointer to var + POP HL ; Restore code string address + RET + +LETNUM: PUSH HL ; Save address of variable + CALL FPTHL ; Move value to variable + POP DE ; Restore address of variable + POP HL ; Restore code string address + RET + +ON: CALL GETINT ; Get integer 0-255 + LD A,(HL) ; Get "GOTO" or "GOSUB" token + LD B,A ; Save in B + CP ZGOSUB ; "GOSUB" token? + JP Z,ONGO ; Yes - Find line number + CALL CHKSYN ; Make sure it's "GOTO" + .BYTE ZGOTO ; "GOTO" token + DEC HL ; Cancel increment +ONGO: LD C,E ; Integer of branch value +ONGOLP: DEC C ; Count branches + LD A,B ; Get "GOTO" or "GOSUB" token + JP Z,ONJMP ; Go to that line if right one + CALL GETLN ; Get line number to DE + CP ',' ; Another line number? + RET NZ ; No - Drop through + JP ONGOLP ; Yes - loop + +IF: CALL EVAL ; Evaluate expression + LD A,(HL) ; Get token + CP ZGOTO ; "GOTO" token? + JP Z,IFGO ; Yes - Get line + CALL CHKSYN ; Make sure it's "THEN" + .BYTE ZTHEN ; "THEN" token + DEC HL ; Cancel increment +IFGO: CALL TSTNUM ; Make sure it's numeric + CALL TSTSGN ; Test state of expression + JP Z,REM ; False - Drop through + CALL GETCHR ; Get next character + JP C,GOTO ; Number - GOTO that line + JP IFJMP ; Otherwise do statement + +MRPRNT: DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character +PRINT: JP Z,PRNTCRLF ; CRLF if just PRINT +PRNTLP: RET Z ; End of list - Exit + CP ZTAB ; "TAB(" token? + JP Z,DOTAB ; Yes - Do TAB routine + CP ZSPC ; "SPC(" token? + JP Z,DOTAB ; Yes - Do SPC routine + PUSH HL ; Save code string address + CP ',' ; Comma? + JP Z,DOCOM ; Yes - Move to next zone + CP 59 ;";" ; Semi-colon? + JP Z,NEXITM ; Do semi-colon routine + POP BC ; Code string address to BC + CALL EVAL ; Evaluate expression + PUSH HL ; Save code string address + LD A,(TYPE) ; Get variable type + OR A ; Is it a string variable? + JP NZ,PRNTST ; Yes - Output string contents + CALL NUMASC ; Convert number to text + CALL CRTST ; Create temporary string + LD (HL),' ' ; Followed by a space + LD HL,(FPREG) ; Get length of output + INC (HL) ; Plus 1 for the space + LD HL,(FPREG) ; < Not needed > + LD A,(LWIDTH) ; Get width of line + LD B,A ; To B + INC B ; Width 255 (No limit)? + JP Z,PRNTNB ; Yes - Output number string + INC B ; Adjust it + LD A,(CURPOS) ; Get cursor position + ADD A,(HL) ; Add length of string + DEC A ; Adjust it + CP B ; Will output fit on this line? + CALL NC,PRNTCRLF ; No - CRLF first +PRNTNB: CALL PRS1 ; Output string at (HL) + XOR A ; Skip CALL by setting 'z' flag +PRNTST: CALL NZ,PRS1 ; Output string at (HL) + POP HL ; Restore code string address + JP MRPRNT ; See if more to PRINT + +STTLIN: LD A,(CURPOS) ; Make sure on new line + OR A ; Already at start? + RET Z ; Yes - Do nothing + JP PRNTCRLF ; Start a new line + +ENDINP: LD (HL),0 ; Mark end of buffer + LD HL,BUFFER-1 ; Point to buffer +PRNTCRLF: LD A,CR ; Load a CR + CALL OUTC ; Output character + LD A,LF ; Load a LF + CALL OUTC ; Output character +DONULL: XOR A ; Set to position 0 + LD (CURPOS),A ; Store it + LD A,(NULLS) ; Get number of nulls +NULLP: DEC A ; Count them + RET Z ; Return if done + PUSH AF ; Save count + XOR A ; Load a null + CALL OUTC ; Output it + POP AF ; Restore count + JP NULLP ; Keep counting + +DOCOM: LD A,(COMMAN) ; Get comma width + LD B,A ; Save in B + LD A,(CURPOS) ; Get current position + CP B ; Within the limit? + CALL NC,PRNTCRLF ; No - output CRLF + JP NC,NEXITM ; Get next item +ZONELP: SUB 14 ; Next zone of 14 characters + JP NC,ZONELP ; Repeat if more zones + CPL ; Number of spaces to output + JP ASPCS ; Output them + +DOTAB: PUSH AF ; Save token + CALL FNDNUM ; Evaluate expression + CALL CHKSYN ; Make sure ")" follows + .BYTE ")" + DEC HL ; Back space on to ")" + POP AF ; Restore token + SUB ZSPC ; Was it "SPC(" ? + PUSH HL ; Save code string address + JP Z,DOSPC ; Yes - Do 'E' spaces + LD A,(CURPOS) ; Get current position +DOSPC: CPL ; Number of spaces to print to + ADD A,E ; Total number to print + JP NC,NEXITM ; TAB < Current POS(X) +ASPCS: INC A ; Output A spaces + LD B,A ; Save number to print + LD A,' ' ; Space +SPCLP: CALL OUTC ; Output character in A + DEC B ; Count them + JP NZ,SPCLP ; Repeat if more +NEXITM: POP HL ; Restore code string address + CALL GETCHR ; Get next character + JP PRNTLP ; More to print + +REDO: .BYTE "?Redo from start",CR,LF,0 + +BADINP: LD A,(READFG) ; READ or INPUT? + OR A + JP NZ,DATSNR ; READ - ?SN Error + POP BC ; Throw away code string addr + LD HL,REDO ; "Redo from start" message + CALL PRS ; Output string + JP DOAGN ; Do last INPUT again + +INPUT: CALL IDTEST ; Test for illegal direct + LD A,(HL) ; Get character after "INPUT" + CP '"' ; Is there a prompt string? + LD A,0 ; Clear A and leave flags + LD (CTLOFG),A ; Enable output + JP NZ,NOPMPT ; No prompt - get input + CALL QTSTR ; Get string terminated by '"' + CALL CHKSYN ; Check for ';' after prompt + .BYTE ';' + PUSH HL ; Save code string address + CALL PRS1 ; Output prompt string + .BYTE 3EH ; Skip "PUSH HL" +NOPMPT: PUSH HL ; Save code string address + CALL PROMPT ; Get input with "? " prompt + POP BC ; Restore code string address + JP C,INPBRK ; Break pressed - Exit + INC HL ; Next byte + LD A,(HL) ; Get it + OR A ; End of line? + DEC HL ; Back again + PUSH BC ; Re-save code string address + JP Z,NXTDTA ; Yes - Find next DATA stmt + LD (HL),',' ; Store comma as separator + JP NXTITM ; Get next item + +READ: PUSH HL ; Save code string address + LD HL,(NXTDAT) ; Next DATA statement + .BYTE 0F6H ; Flag "READ" +NXTITM: XOR A ; Flag "INPUT" + LD (READFG),A ; Save "READ"/"INPUT" flag + EX (SP),HL ; Get code str' , Save pointer + JP GTVLUS ; Get values + +NEDMOR: CALL CHKSYN ; Check for comma between items + .BYTE ',' +GTVLUS: CALL GETVAR ; Get variable name + EX (SP),HL ; Save code str" , Get pointer + PUSH DE ; Save variable address + LD A,(HL) ; Get next "INPUT"/"DATA" byte + CP ',' ; Comma? + JP Z,ANTVLU ; Yes - Get another value + LD A,(READFG) ; Is it READ? + OR A + JP NZ,FDTLP ; Yes - Find next DATA stmt + LD A,'?' ; More INPUT needed + CALL OUTC ; Output character + CALL PROMPT ; Get INPUT with prompt + POP DE ; Variable address + POP BC ; Code string address + JP C,INPBRK ; Break pressed + INC HL ; Point to next DATA byte + LD A,(HL) ; Get byte + OR A ; Is it zero (No input) ? + DEC HL ; Back space INPUT pointer + PUSH BC ; Save code string address + JP Z,NXTDTA ; Find end of buffer + PUSH DE ; Save variable address +ANTVLU: LD A,(TYPE) ; Check data type + OR A ; Is it numeric? + JP Z,INPBIN ; Yes - Convert to binary + CALL GETCHR ; Get next character + LD D,A ; Save input character + LD B,A ; Again + CP '"' ; Start of literal sting? + JP Z,STRENT ; Yes - Create string entry + LD A,(READFG) ; "READ" or "INPUT" ? + OR A + LD D,A ; Save 00 if "INPUT" + JP Z,ITMSEP ; "INPUT" - End with 00 + LD D,':' ; "DATA" - End with 00 or ':' +ITMSEP: LD B,',' ; Item separator + DEC HL ; Back space for DTSTR +STRENT: CALL DTSTR ; Get string terminated by D + EX DE,HL ; String address to DE + LD HL,LTSTND ; Where to go after LETSTR + EX (SP),HL ; Save HL , get input pointer + PUSH DE ; Save address of string + JP LETSTR ; Assign string to variable + +INPBIN: CALL GETCHR ; Get next character + CALL ASCTFP ; Convert ASCII to FP number + EX (SP),HL ; Save input ptr, Get var addr + CALL FPTHL ; Move FPREG to variable + POP HL ; Restore input pointer +LTSTND: DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP Z,MORDT ; End of line - More needed? + CP ',' ; Another value? + JP NZ,BADINP ; No - Bad input +MORDT: EX (SP),HL ; Get code string address + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP NZ,NEDMOR ; More needed - Get it + POP DE ; Restore DATA pointer + LD A,(READFG) ; "READ" or "INPUT" ? + OR A + EX DE,HL ; DATA pointer to HL + JP NZ,UPDATA ; Update DATA pointer if "READ" + PUSH DE ; Save code string address + OR (HL) ; More input given? + LD HL,EXTIG ; "?Extra ignored" message + CALL NZ,PRS ; Output string if extra given + POP HL ; Restore code string address + RET + +EXTIG: .BYTE "?Extra ignored",CR,LF,0 + +FDTLP: CALL DATA ; Get next statement + OR A ; End of line? + JP NZ,FANDT ; No - See if DATA statement + INC HL + LD A,(HL) ; End of program? + INC HL + OR (HL) ; 00 00 Ends program + LD E,OD ; ?OD Error + JP Z,ERROR ; Yes - Out of DATA + INC HL + LD E,(HL) ; LSB of line number + INC HL + LD D,(HL) ; MSB of line number + EX DE,HL + LD (DATLIN),HL ; Set line of current DATA item + EX DE,HL +FANDT: CALL GETCHR ; Get next character + CP ZDATA ; "DATA" token + JP NZ,FDTLP ; No "DATA" - Keep looking + JP ANTVLU ; Found - Convert input + +NEXT: LD DE,0 ; In case no index given +NEXT1: CALL NZ,GETVAR ; Get index address + LD (BRKLIN),HL ; Save code string address + CALL BAKSTK ; Look for "FOR" block + JP NZ,NFERR ; No "FOR" - ?NF Error + LD SP,HL ; Clear nested loops + PUSH DE ; Save index address + LD A,(HL) ; Get sign of STEP + INC HL + PUSH AF ; Save sign of STEP + PUSH DE ; Save index address + CALL PHLTFP ; Move index value to FPREG + EX (SP),HL ; Save address of TO value + PUSH HL ; Save address of index + CALL ADDPHL ; Add STEP to index value + POP HL ; Restore address of index + CALL FPTHL ; Move value to index variable + POP HL ; Restore address of TO value + CALL LOADFP ; Move TO value to BCDE + PUSH HL ; Save address of line of FOR + CALL CMPNUM ; Compare index with TO value + POP HL ; Restore address of line num + POP BC ; Address of sign of STEP + SUB B ; Compare with expected sign + CALL LOADFP ; BC = Loop stmt,DE = Line num + JP Z,KILFOR ; Loop finished - Terminate it + EX DE,HL ; Loop statement line number + LD (LINEAT),HL ; Set loop line number + LD L,C ; Set code string to loop + LD H,B + JP PUTFID ; Put back "FOR" and continue + +KILFOR: LD SP,HL ; Remove "FOR" block + LD HL,(BRKLIN) ; Code string after "NEXT" + LD A,(HL) ; Get next byte in code string + CP ',' ; More NEXTs ? + JP NZ,RUNCNT ; No - Do next statement + CALL GETCHR ; Position to index name + CALL NEXT1 ; Re-enter NEXT routine +; < will not RETurn to here , Exit to RUNCNT or Loop > + +GETNUM: CALL EVAL ; Get a numeric expression +TSTNUM: .BYTE 0F6H ; Clear carry (numeric) +TSTSTR: SCF ; Set carry (string) +CHKTYP: LD A,(TYPE) ; Check types match + ADC A,A ; Expected + actual + OR A ; Clear carry , set parity + RET PE ; Even parity - Types match + JP TMERR ; Different types - Error + +OPNPAR: CALL CHKSYN ; Make sure "(" follows + .BYTE "(" +EVAL: DEC HL ; Evaluate expression & save + LD D,0 ; Precedence value +EVAL1: PUSH DE ; Save precedence + LD C,1 + CALL CHKSTK ; Check for 1 level of stack + CALL OPRND ; Get next expression value +EVAL2: LD (NXTOPR),HL ; Save address of next operator +EVAL3: LD HL,(NXTOPR) ; Restore address of next opr + POP BC ; Precedence value and operator + LD A,B ; Get precedence value + CP 78H ; "AND" or "OR" ? + CALL NC,TSTNUM ; No - Make sure it's a number + LD A,(HL) ; Get next operator / function + LD D,0 ; Clear Last relation +RLTLP: SUB ZGTR ; ">" Token + JP C,FOPRND ; + - * / ^ AND OR - Test it + CP ZLTH+1-ZGTR ; < = > + JP NC,FOPRND ; Function - Call it + CP ZEQUAL-ZGTR ; "=" + RLA ; <- Test for legal + XOR D ; <- combinations of < = > + CP D ; <- by combining last token + LD D,A ; <- with current one + JP C,SNERR ; Error if "<<' '==" or ">>" + LD (CUROPR),HL ; Save address of current token + CALL GETCHR ; Get next character + JP RLTLP ; Treat the two as one + +FOPRND: LD A,D ; < = > found ? + OR A + JP NZ,TSTRED ; Yes - Test for reduction + LD A,(HL) ; Get operator token + LD (CUROPR),HL ; Save operator address + SUB ZPLUS ; Operator or function? + RET C ; Neither - Exit + CP ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ? + RET NC ; No - Exit + LD E,A ; Coded operator + LD A,(TYPE) ; Get data type + DEC A ; FF = numeric , 00 = string + OR E ; Combine with coded operator + LD A,E ; Get coded operator + JP Z,CONCAT ; String concatenation + RLCA ; Times 2 + ADD A,E ; Times 3 + LD E,A ; To DE (D is 0) + LD HL,PRITAB ; Precedence table + ADD HL,DE ; To the operator concerned + LD A,B ; Last operator precedence + LD D,(HL) ; Get evaluation precedence + CP D ; Compare with eval precedence + RET NC ; Exit if higher precedence + INC HL ; Point to routine address + CALL TSTNUM ; Make sure it's a number + +STKTHS: PUSH BC ; Save last precedence & token + LD BC,EVAL3 ; Where to go on prec' break + PUSH BC ; Save on stack for return + LD B,E ; Save operator + LD C,D ; Save precedence + CALL STAKFP ; Move value to stack + LD E,B ; Restore operator + LD D,C ; Restore precedence + LD C,(HL) ; Get LSB of routine address + INC HL + LD B,(HL) ; Get MSB of routine address + INC HL + PUSH BC ; Save routine address + LD HL,(CUROPR) ; Address of current operator + JP EVAL1 ; Loop until prec' break + +OPRND: XOR A ; Get operand routine + LD (TYPE),A ; Set numeric expected + CALL GETCHR ; Get next character + LD E,MO ; ?MO Error + JP Z,ERROR ; No operand - Error + JP C,ASCTFP ; Number - Get value + CALL CHKLTR ; See if a letter + JP NC,CONVAR ; Letter - Find variable + CP '&' ; &H = HEX, &B = BINARY + JR NZ, NOTAMP + CALL GETCHR ; Get next character + CP 'H' ; Hex number indicated? [function added] + JP Z,HEXTFP ; Convert Hex to FPREG + CP 'B' ; Binary number indicated? [function added] + JP Z,BINTFP ; Convert Bin to FPREG + LD E,SN ; If neither then a ?SN Error + JP Z,ERROR ; +NOTAMP: CP ZPLUS ; '+' Token ? + JP Z,OPRND ; Yes - Look for operand + CP '.' ; '.' ? + JP Z,ASCTFP ; Yes - Create FP number + CP ZMINUS ; '-' Token ? + JP Z,MINUS ; Yes - Do minus + CP '"' ; Literal string ? + JP Z,QTSTR ; Get string terminated by '"' + CP ZNOT ; "NOT" Token ? + JP Z,EVNOT ; Yes - Eval NOT expression + CP ZFN ; "FN" Token ? + JP Z,DOFN ; Yes - Do FN routine + SUB ZSGN ; Is it a function? + JP NC,FNOFST ; Yes - Evaluate function +EVLPAR: CALL OPNPAR ; Evaluate expression in "()" + CALL CHKSYN ; Make sure ")" follows + .BYTE ")" + RET + +MINUS: LD D,7DH ; '-' precedence + CALL EVAL1 ; Evaluate until prec' break + LD HL,(NXTOPR) ; Get next operator address + PUSH HL ; Save next operator address + CALL INVSGN ; Negate value +RETNUM: CALL TSTNUM ; Make sure it's a number + POP HL ; Restore next operator address + RET + +CONVAR: CALL GETVAR ; Get variable address to DE +FRMEVL: PUSH HL ; Save code string address + EX DE,HL ; Variable address to HL + LD (FPREG),HL ; Save address of variable + LD A,(TYPE) ; Get type + OR A ; Numeric? + CALL Z,PHLTFP ; Yes - Move contents to FPREG + POP HL ; Restore code string address + RET + +FNOFST: LD B,0 ; Get address of function + RLCA ; Double function offset + LD C,A ; BC = Offset in function table + PUSH BC ; Save adjusted token value + CALL GETCHR ; Get next character + LD A,C ; Get adjusted token value + CP 2*(ZLEFT-ZSGN)-1; Adj' LEFT$,RIGHT$ or MID$ ? + JP C,FNVAL ; No - Do function + CALL OPNPAR ; Evaluate expression (X,... + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' + CALL TSTSTR ; Make sure it's a string + EX DE,HL ; Save code string address + LD HL,(FPREG) ; Get address of string + EX (SP),HL ; Save address of string + PUSH HL ; Save adjusted token value + EX DE,HL ; Restore code string address + CALL GETINT ; Get integer 0-255 + EX DE,HL ; Save code string address + EX (SP),HL ; Save integer,HL = adj' token + JP GOFUNC ; Jump to string function + +FNVAL: CALL EVLPAR ; Evaluate expression + EX (SP),HL ; HL = Adjusted token value + LD DE,RETNUM ; Return number from function + PUSH DE ; Save on stack +GOFUNC: LD BC,FNCTAB ; Function routine addresses + ADD HL,BC ; Point to right address + LD C,(HL) ; Get LSB of address + INC HL ; + LD H,(HL) ; Get MSB of address + LD L,C ; Address to HL + JP (HL) ; Jump to function + +SGNEXP: DEC D ; Dee to flag negative exponent + CP ZMINUS ; '-' token ? + RET Z ; Yes - Return + CP '-' ; '-' ASCII ? + RET Z ; Yes - Return + INC D ; Inc to flag positive exponent + CP '+' ; '+' ASCII ? + RET Z ; Yes - Return + CP ZPLUS ; '+' token ? + RET Z ; Yes - Return + DEC HL ; DEC 'cos GETCHR INCs + RET ; Return "NZ" + +POR: .BYTE 0F6H ; Flag "OR" +PAND: XOR A ; Flag "AND" + PUSH AF ; Save "AND" / "OR" flag + CALL TSTNUM ; Make sure it's a number + CALL DEINT ; Get integer -32768 to 32767 + POP AF ; Restore "AND" / "OR" flag + EX DE,HL ; <- Get last + POP BC ; <- value + EX (SP),HL ; <- from + EX DE,HL ; <- stack + CALL FPBCDE ; Move last value to FPREG + PUSH AF ; Save "AND" / "OR" flag + CALL DEINT ; Get integer -32768 to 32767 + POP AF ; Restore "AND" / "OR" flag + POP BC ; Get value + LD A,C ; Get LSB + LD HL,ACPASS ; Address of save AC as current + JP NZ,POR1 ; Jump if OR + AND E ; "AND" LSBs + LD C,A ; Save LSB + LD A,B ; Get MBS + AND D ; "AND" MSBs + JP (HL) ; Save AC as current (ACPASS) + +POR1: OR E ; "OR" LSBs + LD C,A ; Save LSB + LD A,B ; Get MSB + OR D ; "OR" MSBs + JP (HL) ; Save AC as current (ACPASS) + +TSTRED: LD HL,CMPLOG ; Logical compare routine + LD A,(TYPE) ; Get data type + RRA ; Carry set = string + LD A,D ; Get last precedence value + RLA ; Times 2 plus carry + LD E,A ; To E + LD D,64H ; Relational precedence + LD A,B ; Get current precedence + CP D ; Compare with last + RET NC ; Eval if last was rel' or log' + JP STKTHS ; Stack this one and get next + +CMPLOG: .WORD CMPLG1 ; Compare two values / strings +CMPLG1: LD A,C ; Get data type + OR A + RRA + POP BC ; Get last expression to BCDE + POP DE + PUSH AF ; Save status + CALL CHKTYP ; Check that types match + LD HL,CMPRES ; Result to comparison + PUSH HL ; Save for RETurn + JP Z,CMPNUM ; Compare values if numeric + XOR A ; Compare two strings + LD (TYPE),A ; Set type to numeric + PUSH DE ; Save string name + CALL GSTRCU ; Get current string + LD A,(HL) ; Get length of string + INC HL + INC HL + LD C,(HL) ; Get LSB of address + INC HL + LD B,(HL) ; Get MSB of address + POP DE ; Restore string name + PUSH BC ; Save address of string + PUSH AF ; Save length of string + CALL GSTRDE ; Get second string + CALL LOADFP ; Get address of second string + POP AF ; Restore length of string 1 + LD D,A ; Length to D + POP HL ; Restore address of string 1 +CMPSTR: LD A,E ; Bytes of string 2 to do + OR D ; Bytes of string 1 to do + RET Z ; Exit if all bytes compared + LD A,D ; Get bytes of string 1 to do + SUB 1 + RET C ; Exit if end of string 1 + XOR A + CP E ; Bytes of string 2 to do + INC A + RET NC ; Exit if end of string 2 + DEC D ; Count bytes in string 1 + DEC E ; Count bytes in string 2 + LD A,(BC) ; Byte in string 2 + CP (HL) ; Compare to byte in string 1 + INC HL ; Move up string 1 + INC BC ; Move up string 2 + JP Z,CMPSTR ; Same - Try next bytes + CCF ; Flag difference (">" or "<") + JP FLGDIF ; "<" gives -1 , ">" gives +1 + +CMPRES: INC A ; Increment current value + ADC A,A ; Double plus carry + POP BC ; Get other value + AND B ; Combine them + ADD A,-1 ; Carry set if different + SBC A,A ; 00 - Equal , FF - Different + JP FLGREL ; Set current value & continue + +EVNOT: LD D,5AH ; Precedence value for "NOT" + CALL EVAL1 ; Eval until precedence break + CALL TSTNUM ; Make sure it's a number + CALL DEINT ; Get integer -32768 - 32767 + LD A,E ; Get LSB + CPL ; Invert LSB + LD C,A ; Save "NOT" of LSB + LD A,D ; Get MSB + CPL ; Invert MSB + CALL ACPASS ; Save AC as current + POP BC ; Clean up stack + JP EVAL3 ; Continue evaluation + +DIMRET: DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + RET Z ; End of DIM statement + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' +DIM: LD BC,DIMRET ; Return to "DIMRET" + PUSH BC ; Save on stack + .BYTE 0F6H ; Flag "Create" variable +GETVAR: XOR A ; Find variable address,to DE + LD (LCRFLG),A ; Set locate / create flag + LD B,(HL) ; Get First byte of name +GTFNAM: CALL CHKLTR ; See if a letter + JP C,SNERR ; ?SN Error if not a letter + XOR A + LD C,A ; Clear second byte of name + LD (TYPE),A ; Set type to numeric + CALL GETCHR ; Get next character + JP C,SVNAM2 ; Numeric - Save in name + CALL CHKLTR ; See if a letter + JP C,CHARTY ; Not a letter - Check type +SVNAM2: LD C,A ; Save second byte of name +ENDNAM: CALL GETCHR ; Get next character + JP C,ENDNAM ; Numeric - Get another + CALL CHKLTR ; See if a letter + JP NC,ENDNAM ; Letter - Get another +CHARTY: SUB '$' ; String variable? + JP NZ,NOTSTR ; No - Numeric variable + INC A ; A = 1 (string type) + LD (TYPE),A ; Set type to string + RRCA ; A = 80H , Flag for string + ADD A,C ; 2nd byte of name has bit 7 on + LD C,A ; Resave second byte on name + CALL GETCHR ; Get next character +NOTSTR: LD A,(FORFLG) ; Array name needed ? + DEC A + JP Z,ARLDSV ; Yes - Get array name + JP P,NSCFOR ; No array with "FOR" or "FN" + LD A,(HL) ; Get byte again + SUB '(' ; Subscripted variable? + JP Z,SBSCPT ; Yes - Sort out subscript + +NSCFOR: XOR A ; Simple variable + LD (FORFLG),A ; Clear "FOR" flag + PUSH HL ; Save code string address + LD D,B ; DE = Variable name to find + LD E,C + LD HL,(FNRGNM) ; FN argument name + CALL CPDEHL ; Is it the FN argument? + LD DE,FNARG ; Point to argument value + JP Z,POPHRT ; Yes - Return FN argument value + LD HL,(VAREND) ; End of variables + EX DE,HL ; Address of end of search + LD HL,(PROGND) ; Start of variables address +FNDVAR: CALL CPDEHL ; End of variable list table? + JP Z,CFEVAL ; Yes - Called from EVAL? + LD A,C ; Get second byte of name + SUB (HL) ; Compare with name in list + INC HL ; Move on to first byte + JP NZ,FNTHR ; Different - Find another + LD A,B ; Get first byte of name + SUB (HL) ; Compare with name in list +FNTHR: INC HL ; Move on to LSB of value + JP Z,RETADR ; Found - Return address + INC HL ; <- Skip + INC HL ; <- over + INC HL ; <- F.P. + INC HL ; <- value + JP FNDVAR ; Keep looking + +CFEVAL: POP HL ; Restore code string address + EX (SP),HL ; Get return address + PUSH DE ; Save address of variable + LD DE,FRMEVL ; Return address in EVAL + CALL CPDEHL ; Called from EVAL ? + POP DE ; Restore address of variable + JP Z,RETNUL ; Yes - Return null variable + EX (SP),HL ; Put back return + PUSH HL ; Save code string address + PUSH BC ; Save variable name + LD BC,6 ; 2 byte name plus 4 byte data + LD HL,(ARREND) ; End of arrays + PUSH HL ; Save end of arrays + ADD HL,BC ; Move up 6 bytes + POP BC ; Source address in BC + PUSH HL ; Save new end address + CALL MOVUP ; Move arrays up + POP HL ; Restore new end address + LD (ARREND),HL ; Set new end address + LD H,B ; End of variables to HL + LD L,C + LD (VAREND),HL ; Set new end address + +ZEROLP: DEC HL ; Back through to zero variable + LD (HL),0 ; Zero byte in variable + CALL CPDEHL ; Done them all? + JP NZ,ZEROLP ; No - Keep on going + POP DE ; Get variable name + LD (HL),E ; Store second character + INC HL + LD (HL),D ; Store first character + INC HL +RETADR: EX DE,HL ; Address of variable in DE + POP HL ; Restore code string address + RET + +RETNUL: LD (FPEXP),A ; Set result to zero + LD HL,ZERBYT ; Also set a null string + LD (FPREG),HL ; Save for EVAL + POP HL ; Restore code string address + RET + +SBSCPT: PUSH HL ; Save code string address + LD HL,(LCRFLG) ; Locate/Create and Type + EX (SP),HL ; Save and get code string + LD D,A ; Zero number of dimensions +SCPTLP: PUSH DE ; Save number of dimensions + PUSH BC ; Save array name + CALL FPSINT ; Get subscript (0-32767) + POP BC ; Restore array name + POP AF ; Get number of dimensions + EX DE,HL + EX (SP),HL ; Save subscript value + PUSH HL ; Save LCRFLG and TYPE + EX DE,HL + INC A ; Count dimensions + LD D,A ; Save in D + LD A,(HL) ; Get next byte in code string + CP ',' ; Comma (more to come)? + JP Z,SCPTLP ; Yes - More subscripts + CALL CHKSYN ; Make sure ")" follows + .BYTE ")" + LD (NXTOPR),HL ; Save code string address + POP HL ; Get LCRFLG and TYPE + LD (LCRFLG),HL ; Restore Locate/create & type + LD E,0 ; Flag not CSAVE* or CLOAD* + PUSH DE ; Save number of dimensions (D) + .BYTE 11H ; Skip "PUSH HL" and "PUSH AF' + +ARLDSV: PUSH HL ; Save code string address + PUSH AF ; A = 00 , Flags set = Z,N + LD HL,(VAREND) ; Start of arrays + .BYTE 3EH ; Skip "ADD HL,DE" +FNDARY: ADD HL,DE ; Move to next array start + EX DE,HL + LD HL,(ARREND) ; End of arrays + EX DE,HL ; Current array pointer + CALL CPDEHL ; End of arrays found? + JP Z,CREARY ; Yes - Create array + LD A,(HL) ; Get second byte of name + CP C ; Compare with name given + INC HL ; Move on + JP NZ,NXTARY ; Different - Find next array + LD A,(HL) ; Get first byte of name + CP B ; Compare with name given +NXTARY: INC HL ; Move on + LD E,(HL) ; Get LSB of next array address + INC HL + LD D,(HL) ; Get MSB of next array address + INC HL + JP NZ,FNDARY ; Not found - Keep looking + LD A,(LCRFLG) ; Found Locate or Create it? + OR A + JP NZ,DDERR ; Create - ?DD Error + POP AF ; Locate - Get number of dim'ns + LD B,H ; BC Points to array dim'ns + LD C,L + JP Z,POPHRT ; Jump if array load/save + SUB (HL) ; Same number of dimensions? + JP Z,FINDEL ; Yes - Find element +BSERR: LD E,BS ; ?BS Error + JP ERROR ; Output error + +CREARY: LD DE,4 ; 4 Bytes per entry + POP AF ; Array to save or 0 dim'ns? + JP Z,FCERR ; Yes - ?FC Error + LD (HL),C ; Save second byte of name + INC HL + LD (HL),B ; Save first byte of name + INC HL + LD C,A ; Number of dimensions to C + CALL CHKSTK ; Check if enough memory + INC HL ; Point to number of dimensions + INC HL + LD (CUROPR),HL ; Save address of pointer + LD (HL),C ; Set number of dimensions + INC HL + LD A,(LCRFLG) ; Locate of Create? + RLA ; Carry set = Create + LD A,C ; Get number of dimensions +CRARLP: LD BC,10+1 ; Default dimension size 10 + JP NC,DEFSIZ ; Locate - Set default size + POP BC ; Get specified dimension size + INC BC ; Include zero element +DEFSIZ: LD (HL),C ; Save LSB of dimension size + INC HL + LD (HL),B ; Save MSB of dimension size + INC HL + PUSH AF ; Save num' of dim'ns an status + PUSH HL ; Save address of dim'n size + CALL MLDEBC ; Multiply DE by BC to find + EX DE,HL ; amount of mem needed (to DE) + POP HL ; Restore address of dimension + POP AF ; Restore number of dimensions + DEC A ; Count them + JP NZ,CRARLP ; Do next dimension if more + PUSH AF ; Save locate/create flag + LD B,D ; MSB of memory needed + LD C,E ; LSB of memory needed + EX DE,HL + ADD HL,DE ; Add bytes to array start + JP C,OMERR ; Too big - Error + CALL ENFMEM ; See if enough memory + LD (ARREND),HL ; Save new end of array + +ZERARY: DEC HL ; Back through array data + LD (HL),0 ; Set array element to zero + CALL CPDEHL ; All elements zeroed? + JP NZ,ZERARY ; No - Keep on going + INC BC ; Number of bytes + 1 + LD D,A ; A=0 + LD HL,(CUROPR) ; Get address of array + LD E,(HL) ; Number of dimensions + EX DE,HL ; To HL + ADD HL,HL ; Two bytes per dimension size + ADD HL,BC ; Add number of bytes + EX DE,HL ; Bytes needed to DE + DEC HL + DEC HL + LD (HL),E ; Save LSB of bytes needed + INC HL + LD (HL),D ; Save MSB of bytes needed + INC HL + POP AF ; Locate / Create? + JP C,ENDDIM ; A is 0 , End if create +FINDEL: LD B,A ; Find array element + LD C,A + LD A,(HL) ; Number of dimensions + INC HL + .BYTE 16H ; Skip "POP HL" +FNDELP: POP HL ; Address of next dim' size + LD E,(HL) ; Get LSB of dim'n size + INC HL + LD D,(HL) ; Get MSB of dim'n size + INC HL + EX (SP),HL ; Save address - Get index + PUSH AF ; Save number of dim'ns + CALL CPDEHL ; Dimension too large? + JP NC,BSERR ; Yes - ?BS Error + PUSH HL ; Save index + CALL MLDEBC ; Multiply previous by size + POP DE ; Index supplied to DE + ADD HL,DE ; Add index to pointer + POP AF ; Number of dimensions + DEC A ; Count them + LD B,H ; MSB of pointer + LD C,L ; LSB of pointer + JP NZ,FNDELP ; More - Keep going + ADD HL,HL ; 4 Bytes per element + ADD HL,HL + POP BC ; Start of array + ADD HL,BC ; Point to element + EX DE,HL ; Address of element to DE +ENDDIM: LD HL,(NXTOPR) ; Got code string address + RET + +FRE: LD HL,(ARREND) ; Start of free memory + EX DE,HL ; To DE + LD HL,0 ; End of free memory + ADD HL,SP ; Current stack value + LD A,(TYPE) ; Dummy argument type + OR A + JP Z,FRENUM ; Numeric - Free variable space + CALL GSTRCU ; Current string to pool + CALL GARBGE ; Garbage collection + LD HL,(STRSPC) ; Bottom of string space in use + EX DE,HL ; To DE + LD HL,(STRBOT) ; Bottom of string space +FRENUM: LD A,L ; Get LSB of end + SUB E ; Subtract LSB of beginning + LD C,A ; Save difference if C + LD A,H ; Get MSB of end + SBC A,D ; Subtract MSB of beginning +ACPASS: LD B,C ; Return integer AC +ABPASS: LD D,B ; Return integer AB + LD E,0 + LD HL,TYPE ; Point to type + LD (HL),E ; Set type to numeric + LD B,80H+16 ; 16 bit integer + JP RETINT ; Return the integr + +POS: LD A,(CURPOS) ; Get cursor position +PASSA: LD B,A ; Put A into AB + XOR A ; Zero A + JP ABPASS ; Return integer AB + +DEF: CALL CHEKFN ; Get "FN" and name + CALL IDTEST ; Test for illegal direct + LD BC,DATA ; To get next statement + PUSH BC ; Save address for RETurn + PUSH DE ; Save address of function ptr + CALL CHKSYN ; Make sure "(" follows + .BYTE "(" + CALL GETVAR ; Get argument variable name + PUSH HL ; Save code string address + EX DE,HL ; Argument address to HL + DEC HL + LD D,(HL) ; Get first byte of arg name + DEC HL + LD E,(HL) ; Get second byte of arg name + POP HL ; Restore code string address + CALL TSTNUM ; Make sure numeric argument + CALL CHKSYN ; Make sure ")" follows + .BYTE ")" + CALL CHKSYN ; Make sure "=" follows + .BYTE ZEQUAL ; "=" token + LD B,H ; Code string address to BC + LD C,L + EX (SP),HL ; Save code str , Get FN ptr + LD (HL),C ; Save LSB of FN code string + INC HL + LD (HL),B ; Save MSB of FN code string + JP SVSTAD ; Save address and do function + +DOFN: CALL CHEKFN ; Make sure FN follows + PUSH DE ; Save function pointer address + CALL EVLPAR ; Evaluate expression in "()" + CALL TSTNUM ; Make sure numeric result + EX (SP),HL ; Save code str , Get FN ptr + LD E,(HL) ; Get LSB of FN code string + INC HL + LD D,(HL) ; Get MSB of FN code string + INC HL + LD A,D ; And function DEFined? + OR E + JP Z,UFERR ; No - ?UF Error + LD A,(HL) ; Get LSB of argument address + INC HL + LD H,(HL) ; Get MSB of argument address + LD L,A ; HL = Arg variable address + PUSH HL ; Save it + LD HL,(FNRGNM) ; Get old argument name + EX (SP),HL ; ; Save old , Get new + LD (FNRGNM),HL ; Set new argument name + LD HL,(FNARG+2) ; Get LSB,NLSB of old arg value + PUSH HL ; Save it + LD HL,(FNARG) ; Get MSB,EXP of old arg value + PUSH HL ; Save it + LD HL,FNARG ; HL = Value of argument + PUSH DE ; Save FN code string address + CALL FPTHL ; Move FPREG to argument + POP HL ; Get FN code string address + CALL GETNUM ; Get value from function + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP NZ,SNERR ; Bad character in FN - Error + POP HL ; Get MSB,EXP of old arg + LD (FNARG),HL ; Restore it + POP HL ; Get LSB,NLSB of old arg + LD (FNARG+2),HL ; Restore it + POP HL ; Get name of old arg + LD (FNRGNM),HL ; Restore it + POP HL ; Restore code string address + RET + +IDTEST: PUSH HL ; Save code string address + LD HL,(LINEAT) ; Get current line number + INC HL ; -1 means direct statement + LD A,H + OR L + POP HL ; Restore code string address + RET NZ ; Return if in program + LD E,ID ; ?ID Error + JP ERROR + +CHEKFN: CALL CHKSYN ; Make sure FN follows + .BYTE ZFN ; "FN" token + LD A,80H + LD (FORFLG),A ; Flag FN name to find + OR (HL) ; FN name has bit 7 set + LD B,A ; in first byte of name + CALL GTFNAM ; Get FN name + JP TSTNUM ; Make sure numeric function + +STR: CALL TSTNUM ; Make sure it's a number + CALL NUMASC ; Turn number into text +STR1: CALL CRTST ; Create string entry for it + CALL GSTRCU ; Current string to pool + LD BC,TOPOOL ; Save in string pool + PUSH BC ; Save address on stack + +SAVSTR: LD A,(HL) ; Get string length + INC HL + INC HL + PUSH HL ; Save pointer to string + CALL TESTR ; See if enough string space + POP HL ; Restore pointer to string + LD C,(HL) ; Get LSB of address + INC HL + LD B,(HL) ; Get MSB of address + CALL CRTMST ; Create string entry + PUSH HL ; Save pointer to MSB of addr + LD L,A ; Length of string + CALL TOSTRA ; Move to string area + POP DE ; Restore pointer to MSB + RET + +MKTMST: CALL TESTR ; See if enough string space +CRTMST: LD HL,TMPSTR ; Temporary string + PUSH HL ; Save it + LD (HL),A ; Save length of string + INC HL +SVSTAD: INC HL + LD (HL),E ; Save LSB of address + INC HL + LD (HL),D ; Save MSB of address + POP HL ; Restore pointer + RET + +CRTST: DEC HL ; DEC - INCed after +QTSTR: LD B,'"' ; Terminating quote + LD D,B ; Quote to D +DTSTR: PUSH HL ; Save start + LD C,-1 ; Set counter to -1 +QTSTLP: INC HL ; Move on + LD A,(HL) ; Get byte + INC C ; Count bytes + OR A ; End of line? + JP Z,CRTSTE ; Yes - Create string entry + CP D ; Terminator D found? + JP Z,CRTSTE ; Yes - Create string entry + CP B ; Terminator B found? + JP NZ,QTSTLP ; No - Keep looking +CRTSTE: CP '"' ; End with '"'? + CALL Z,GETCHR ; Yes - Get next character + EX (SP),HL ; Starting quote + INC HL ; First byte of string + EX DE,HL ; To DE + LD A,C ; Get length + CALL CRTMST ; Create string entry +TSTOPL: LD DE,TMPSTR ; Temporary string + LD HL,(TMSTPT) ; Temporary string pool pointer + LD (FPREG),HL ; Save address of string ptr + LD A,1 + LD (TYPE),A ; Set type to string + CALL DETHL4 ; Move string to pool + CALL CPDEHL ; Out of string pool? + LD (TMSTPT),HL ; Save new pointer + POP HL ; Restore code string address + LD A,(HL) ; Get next code byte + RET NZ ; Return if pool OK + LD E,ST ; ?ST Error + JP ERROR ; String pool overflow + +PRNUMS: INC HL ; Skip leading space +PRS: CALL CRTST ; Create string entry for it +PRS1: CALL GSTRCU ; Current string to pool + CALL LOADFP ; Move string block to BCDE + INC E ; Length + 1 +PRSLP: DEC E ; Count characters + RET Z ; End of string + LD A,(BC) ; Get byte to output + CALL OUTC ; Output character in A + CP CR ; Return? + CALL Z,DONULL ; Yes - Do nulls + INC BC ; Next byte in string + JP PRSLP ; More characters to output + +TESTR: OR A ; Test if enough room + .BYTE 0EH ; No garbage collection done +GRBDON: POP AF ; Garbage collection done + PUSH AF ; Save status + LD HL,(STRSPC) ; Bottom of string space in use + EX DE,HL ; To DE + LD HL,(STRBOT) ; Bottom of string area + CPL ; Negate length (Top down) + LD C,A ; -Length to BC + LD B,-1 ; BC = -ve length of string + ADD HL,BC ; Add to bottom of space in use + INC HL ; Plus one for 2's complement + CALL CPDEHL ; Below string RAM area? + JP C,TESTOS ; Tidy up if not done else err + LD (STRBOT),HL ; Save new bottom of area + INC HL ; Point to first byte of string + EX DE,HL ; Address to DE +POPAF: POP AF ; Throw away status push + RET + +TESTOS: POP AF ; Garbage collect been done? + LD E,OS ; ?OS Error + JP Z,ERROR ; Yes - Not enough string apace + CP A ; Flag garbage collect done + PUSH AF ; Save status + LD BC,GRBDON ; Garbage collection done + PUSH BC ; Save for RETurn +GARBGE: LD HL,(LSTRAM) ; Get end of RAM pointer +GARBLP: LD (STRBOT),HL ; Reset string pointer + LD HL,0 + PUSH HL ; Flag no string found + LD HL,(STRSPC) ; Get bottom of string space + PUSH HL ; Save bottom of string space + LD HL,TMSTPL ; Temporary string pool +GRBLP: EX DE,HL + LD HL,(TMSTPT) ; Temporary string pool pointer + EX DE,HL + CALL CPDEHL ; Temporary string pool done? + LD BC,GRBLP ; Loop until string pool done + JP NZ,STPOOL ; No - See if in string area + LD HL,(PROGND) ; Start of simple variables +SMPVAR: EX DE,HL + LD HL,(VAREND) ; End of simple variables + EX DE,HL + CALL CPDEHL ; All simple strings done? + JP Z,ARRLP ; Yes - Do string arrays + LD A,(HL) ; Get type of variable + INC HL + INC HL + OR A ; "S" flag set if string + CALL STRADD ; See if string in string area + JP SMPVAR ; Loop until simple ones done + +GNXARY: POP BC ; Scrap address of this array +ARRLP: EX DE,HL + LD HL,(ARREND) ; End of string arrays + EX DE,HL + CALL CPDEHL ; All string arrays done? + JP Z,SCNEND ; Yes - Move string if found + CALL LOADFP ; Get array name to BCDE + LD A,E ; Get type of array + PUSH HL ; Save address of num of dim'ns + ADD HL,BC ; Start of next array + OR A ; Test type of array + JP P,GNXARY ; Numeric array - Ignore it + LD (CUROPR),HL ; Save address of next array + POP HL ; Get address of num of dim'ns + LD C,(HL) ; BC = Number of dimensions + LD B,0 + ADD HL,BC ; Two bytes per dimension size + ADD HL,BC + INC HL ; Plus one for number of dim'ns +GRBARY: EX DE,HL + LD HL,(CUROPR) ; Get address of next array + EX DE,HL + CALL CPDEHL ; Is this array finished? + JP Z,ARRLP ; Yes - Get next one + LD BC,GRBARY ; Loop until array all done +STPOOL: PUSH BC ; Save return address + OR 80H ; Flag string type +STRADD: LD A,(HL) ; Get string length + INC HL + INC HL + LD E,(HL) ; Get LSB of string address + INC HL + LD D,(HL) ; Get MSB of string address + INC HL + RET P ; Not a string - Return + OR A ; Set flags on string length + RET Z ; Null string - Return + LD B,H ; Save variable pointer + LD C,L + LD HL,(STRBOT) ; Bottom of new area + CALL CPDEHL ; String been done? + LD H,B ; Restore variable pointer + LD L,C + RET C ; String done - Ignore + POP HL ; Return address + EX (SP),HL ; Lowest available string area + CALL CPDEHL ; String within string area? + EX (SP),HL ; Lowest available string area + PUSH HL ; Re-save return address + LD H,B ; Restore variable pointer + LD L,C + RET NC ; Outside string area - Ignore + POP BC ; Get return , Throw 2 away + POP AF ; + POP AF ; + PUSH HL ; Save variable pointer + PUSH DE ; Save address of current + PUSH BC ; Put back return address + RET ; Go to it + +SCNEND: POP DE ; Addresses of strings + POP HL ; + LD A,L ; HL = 0 if no more to do + OR H + RET Z ; No more to do - Return + DEC HL + LD B,(HL) ; MSB of address of string + DEC HL + LD C,(HL) ; LSB of address of string + PUSH HL ; Save variable address + DEC HL + DEC HL + LD L,(HL) ; HL = Length of string + LD H,0 + ADD HL,BC ; Address of end of string+1 + LD D,B ; String address to DE + LD E,C + DEC HL ; Last byte in string + LD B,H ; Address to BC + LD C,L + LD HL,(STRBOT) ; Current bottom of string area + CALL MOVSTR ; Move string to new address + POP HL ; Restore variable address + LD (HL),C ; Save new LSB of address + INC HL + LD (HL),B ; Save new MSB of address + LD L,C ; Next string area+1 to HL + LD H,B + DEC HL ; Next string area address + JP GARBLP ; Look for more strings + +CONCAT: PUSH BC ; Save prec' opr & code string + PUSH HL ; + LD HL,(FPREG) ; Get first string + EX (SP),HL ; Save first string + CALL OPRND ; Get second string + EX (SP),HL ; Restore first string + CALL TSTSTR ; Make sure it's a string + LD A,(HL) ; Get length of second string + PUSH HL ; Save first string + LD HL,(FPREG) ; Get second string + PUSH HL ; Save second string + ADD A,(HL) ; Add length of second string + LD E,LS ; ?LS Error + JP C,ERROR ; String too long - Error + CALL MKTMST ; Make temporary string + POP DE ; Get second string to DE + CALL GSTRDE ; Move to string pool if needed + EX (SP),HL ; Get first string + CALL GSTRHL ; Move to string pool if needed + PUSH HL ; Save first string + LD HL,(TMPSTR+2) ; Temporary string address + EX DE,HL ; To DE + CALL SSTSA ; First string to string area + CALL SSTSA ; Second string to string area + LD HL,EVAL2 ; Return to evaluation loop + EX (SP),HL ; Save return,get code string + PUSH HL ; Save code string address + JP TSTOPL ; To temporary string to pool + +SSTSA: POP HL ; Return address + EX (SP),HL ; Get string block,save return + LD A,(HL) ; Get length of string + INC HL + INC HL + LD C,(HL) ; Get LSB of string address + INC HL + LD B,(HL) ; Get MSB of string address + LD L,A ; Length to L +TOSTRA: INC L ; INC - DECed after +TSALP: DEC L ; Count bytes moved + RET Z ; End of string - Return + LD A,(BC) ; Get source + LD (DE),A ; Save destination + INC BC ; Next source + INC DE ; Next destination + JP TSALP ; Loop until string moved + +GETSTR: CALL TSTSTR ; Make sure it's a string +GSTRCU: LD HL,(FPREG) ; Get current string +GSTRHL: EX DE,HL ; Save DE +GSTRDE: CALL BAKTMP ; Was it last tmp-str? + EX DE,HL ; Restore DE + RET NZ ; No - Return + PUSH DE ; Save string + LD D,B ; String block address to DE + LD E,C + DEC DE ; Point to length + LD C,(HL) ; Get string length + LD HL,(STRBOT) ; Current bottom of string area + CALL CPDEHL ; Last one in string area? + JP NZ,POPHL ; No - Return + LD B,A ; Clear B (A=0) + ADD HL,BC ; Remove string from str' area + LD (STRBOT),HL ; Save new bottom of str' area +POPHL: POP HL ; Restore string + RET + +BAKTMP: LD HL,(TMSTPT) ; Get temporary string pool top + DEC HL ; Back + LD B,(HL) ; Get MSB of address + DEC HL ; Back + LD C,(HL) ; Get LSB of address + DEC HL ; Back + DEC HL ; Back + CALL CPDEHL ; String last in string pool? + RET NZ ; Yes - Leave it + LD (TMSTPT),HL ; Save new string pool top + RET + +LEN: LD BC,PASSA ; To return integer A + PUSH BC ; Save address +GETLEN: CALL GETSTR ; Get string and its length + XOR A + LD D,A ; Clear D + LD (TYPE),A ; Set type to numeric + LD A,(HL) ; Get length of string + OR A ; Set status flags + RET + +ASC: LD BC,PASSA ; To return integer A + PUSH BC ; Save address +GTFLNM: CALL GETLEN ; Get length of string + JP Z,FCERR ; Null string - Error + INC HL + INC HL + LD E,(HL) ; Get LSB of address + INC HL + LD D,(HL) ; Get MSB of address + LD A,(DE) ; Get first byte of string + RET + +CHR: LD A,1 ; One character string + CALL MKTMST ; Make a temporary string + CALL MAKINT ; Make it integer A + LD HL,(TMPSTR+2) ; Get address of string + LD (HL),E ; Save character +TOPOOL: POP BC ; Clean up stack + JP TSTOPL ; Temporary string to pool + +LEFT: CALL LFRGNM ; Get number and ending ")" + XOR A ; Start at first byte in string +RIGHT1: EX (SP),HL ; Save code string,Get string + LD C,A ; Starting position in string +MID1: PUSH HL ; Save string block address + LD A,(HL) ; Get length of string + CP B ; Compare with number given + JP C,ALLFOL ; All following bytes required + LD A,B ; Get new length + .BYTE 11H ; Skip "LD C,0" +ALLFOL: LD C,0 ; First byte of string + PUSH BC ; Save position in string + CALL TESTR ; See if enough string space + POP BC ; Get position in string + POP HL ; Restore string block address + PUSH HL ; And re-save it + INC HL + INC HL + LD B,(HL) ; Get LSB of address + INC HL + LD H,(HL) ; Get MSB of address + LD L,B ; HL = address of string + LD B,0 ; BC = starting address + ADD HL,BC ; Point to that byte + LD B,H ; BC = source string + LD C,L + CALL CRTMST ; Create a string entry + LD L,A ; Length of new string + CALL TOSTRA ; Move string to string area + POP DE ; Clear stack + CALL GSTRDE ; Move to string pool if needed + JP TSTOPL ; Temporary string to pool + +RIGHT: CALL LFRGNM ; Get number and ending ")" + POP DE ; Get string length + PUSH DE ; And re-save + LD A,(DE) ; Get length + SUB B ; Move back N bytes + JP RIGHT1 ; Go and get sub-string + +MID: EX DE,HL ; Get code string address + LD A,(HL) ; Get next byte ',' or ")" + CALL MIDNUM ; Get number supplied + INC B ; Is it character zero? + DEC B + JP Z,FCERR ; Yes - Error + PUSH BC ; Save starting position + LD E,255 ; All of string + CP ')' ; Any length given? + JP Z,RSTSTR ; No - Rest of string + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' + CALL GETINT ; Get integer 0-255 +RSTSTR: CALL CHKSYN ; Make sure ")" follows + .BYTE ")" + POP AF ; Restore starting position + EX (SP),HL ; Get string,8ave code string + LD BC,MID1 ; Continuation of MID$ routine + PUSH BC ; Save for return + DEC A ; Starting position-1 + CP (HL) ; Compare with length + LD B,0 ; Zero bytes length + RET NC ; Null string if start past end + LD C,A ; Save starting position-1 + LD A,(HL) ; Get length of string + SUB C ; Subtract start + CP E ; Enough string for it? + LD B,A ; Save maximum length available + RET C ; Truncate string if needed + LD B,E ; Set specified length + RET ; Go and create string + +VAL: CALL GETLEN ; Get length of string + JP Z,RESZER ; Result zero + LD E,A ; Save length + INC HL + INC HL + LD A,(HL) ; Get LSB of address + INC HL + LD H,(HL) ; Get MSB of address + LD L,A ; HL = String address + PUSH HL ; Save string address + ADD HL,DE + LD B,(HL) ; Get end of string+1 byte + LD (HL),D ; Zero it to terminate + EX (SP),HL ; Save string end,get start + PUSH BC ; Save end+1 byte + LD A,(HL) ; Get starting byte + CP '$' ; Hex number indicated? [function added] + JP NZ,VAL1 + CALL HEXTFP ; Convert Hex to FPREG + JR VAL3 +VAL1: CP '%' ; Binary number indicated? [function added] + JP NZ,VAL2 + CALL BINTFP ; Convert Bin to FPREG + JR VAL3 +VAL2: CALL ASCTFP ; Convert ASCII string to FP +VAL3: POP BC ; Restore end+1 byte + POP HL ; Restore end+1 address + LD (HL),B ; Put back original byte + RET + +LFRGNM: EX DE,HL ; Code string address to HL + CALL CHKSYN ; Make sure ")" follows + .BYTE ")" +MIDNUM: POP BC ; Get return address + POP DE ; Get number supplied + PUSH BC ; Re-save return address + LD B,E ; Number to B + RET + +INP: CALL MAKINT ; Make it integer A + LD (INPORT),A ; Set input port + CALL INPSUB ; Get input from port + JP PASSA ; Return integer A + +POUT: CALL SETIO ; Set up port number + JP OUTSUB ; Output data and return + +WAIT: CALL SETIO ; Set up port number + PUSH AF ; Save AND mask + LD E,0 ; Assume zero if none given + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP Z,NOXOR ; No XOR byte given + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' + CALL GETINT ; Get integer 0-255 to XOR with +NOXOR: POP BC ; Restore AND mask +WAITLP: CALL INPSUB ; Get input + XOR E ; Flip selected bits + AND B ; Result non-zero? + JP Z,WAITLP ; No = keep waiting + RET + +SETIO: CALL GETINT ; Get integer 0-255 + LD (INPORT),A ; Set input port + LD (OTPORT),A ; Set output port + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' + JP GETINT ; Get integer 0-255 and return + +FNDNUM: CALL GETCHR ; Get next character +GETINT: CALL GETNUM ; Get a number from 0 to 255 +MAKINT: CALL DEPINT ; Make sure value 0 - 255 + LD A,D ; Get MSB of number + OR A ; Zero? + JP NZ,FCERR ; No - Error + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + LD A,E ; Get number to A + RET + +PEEK: CALL DEINT ; Get memory address + LD A,(DE) ; Get byte in memory + JP PASSA ; Return integer A + +POKE: CALL GETNUM ; Get memory address + CALL DEINT ; Get integer -32768 to 3276 + PUSH DE ; Save memory address + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' + CALL GETINT ; Get integer 0-255 + POP DE ; Restore memory address + LD (DE),A ; Load it into memory + RET + +ROUND: LD HL,HALF ; Add 0.5 to FPREG +ADDPHL: CALL LOADFP ; Load FP at (HL) to BCDE + JP FPADD ; Add BCDE to FPREG + +SUBPHL: CALL LOADFP ; FPREG = -FPREG + number at HL + .BYTE 21H ; Skip "POP BC" and "POP DE" +PSUB: POP BC ; Get FP number from stack + POP DE +SUBCDE: CALL INVSGN ; Negate FPREG +FPADD: LD A,B ; Get FP exponent + OR A ; Is number zero? + RET Z ; Yes - Nothing to add + LD A,(FPEXP) ; Get FPREG exponent + OR A ; Is this number zero? + JP Z,FPBCDE ; Yes - Move BCDE to FPREG + SUB B ; BCDE number larger? + JP NC,NOSWAP ; No - Don't swap them + CPL ; Two's complement + INC A ; FP exponent + EX DE,HL + CALL STAKFP ; Put FPREG on stack + EX DE,HL + CALL FPBCDE ; Move BCDE to FPREG + POP BC ; Restore number from stack + POP DE +NOSWAP: CP 24+1 ; Second number insignificant? + RET NC ; Yes - First number is result + PUSH AF ; Save number of bits to scale + CALL SIGNS ; Set MSBs & sign of result + LD H,A ; Save sign of result + POP AF ; Restore scaling factor + CALL SCALE ; Scale BCDE to same exponent + OR H ; Result to be positive? + LD HL,FPREG ; Point to FPREG + JP P,MINCDE ; No - Subtract FPREG from CDE + CALL PLUCDE ; Add FPREG to CDE + JP NC,RONDUP ; No overflow - Round it up + INC HL ; Point to exponent + INC (HL) ; Increment it + JP Z,OVERR ; Number overflowed - Error + LD L,1 ; 1 bit to shift right + CALL SHRT1 ; Shift result right + JP RONDUP ; Round it up + +MINCDE: XOR A ; Clear A and carry + SUB B ; Negate exponent + LD B,A ; Re-save exponent + LD A,(HL) ; Get LSB of FPREG + SBC A, E ; Subtract LSB of BCDE + LD E,A ; Save LSB of BCDE + INC HL + LD A,(HL) ; Get NMSB of FPREG + SBC A,D ; Subtract NMSB of BCDE + LD D,A ; Save NMSB of BCDE + INC HL + LD A,(HL) ; Get MSB of FPREG + SBC A,C ; Subtract MSB of BCDE + LD C,A ; Save MSB of BCDE +CONPOS: CALL C,COMPL ; Overflow - Make it positive + +BNORM: LD L,B ; L = Exponent + LD H,E ; H = LSB + XOR A +BNRMLP: LD B,A ; Save bit count + LD A,C ; Get MSB + OR A ; Is it zero? + JP NZ,PNORM ; No - Do it bit at a time + LD C,D ; MSB = NMSB + LD D,H ; NMSB= LSB + LD H,L ; LSB = VLSB + LD L,A ; VLSB= 0 + LD A,B ; Get exponent + SUB 8 ; Count 8 bits + CP -24-8 ; Was number zero? + JP NZ,BNRMLP ; No - Keep normalising +RESZER: XOR A ; Result is zero +SAVEXP: LD (FPEXP),A ; Save result as zero + RET + +NORMAL: DEC B ; Count bits + ADD HL,HL ; Shift HL left + LD A,D ; Get NMSB + RLA ; Shift left with last bit + LD D,A ; Save NMSB + LD A,C ; Get MSB + ADC A,A ; Shift left with last bit + LD C,A ; Save MSB +PNORM: JP P,NORMAL ; Not done - Keep going + LD A,B ; Number of bits shifted + LD E,H ; Save HL in EB + LD B,L + OR A ; Any shifting done? + JP Z,RONDUP ; No - Round it up + LD HL,FPEXP ; Point to exponent + ADD A,(HL) ; Add shifted bits + LD (HL),A ; Re-save exponent + JP NC,RESZER ; Underflow - Result is zero + RET Z ; Result is zero +RONDUP: LD A,B ; Get VLSB of number +RONDB: LD HL,FPEXP ; Point to exponent + OR A ; Any rounding? + CALL M,FPROND ; Yes - Round number up + LD B,(HL) ; B = Exponent + INC HL + LD A,(HL) ; Get sign of result + AND 10000000B ; Only bit 7 needed + XOR C ; Set correct sign + LD C,A ; Save correct sign in number + JP FPBCDE ; Move BCDE to FPREG + +FPROND: INC E ; Round LSB + RET NZ ; Return if ok + INC D ; Round NMSB + RET NZ ; Return if ok + INC C ; Round MSB + RET NZ ; Return if ok + LD C,80H ; Set normal value + INC (HL) ; Increment exponent + RET NZ ; Return if ok + JP OVERR ; Overflow error + +PLUCDE: LD A,(HL) ; Get LSB of FPREG + ADD A,E ; Add LSB of BCDE + LD E,A ; Save LSB of BCDE + INC HL + LD A,(HL) ; Get NMSB of FPREG + ADC A,D ; Add NMSB of BCDE + LD D,A ; Save NMSB of BCDE + INC HL + LD A,(HL) ; Get MSB of FPREG + ADC A,C ; Add MSB of BCDE + LD C,A ; Save MSB of BCDE + RET + +COMPL: LD HL,SGNRES ; Sign of result + LD A,(HL) ; Get sign of result + CPL ; Negate it + LD (HL),A ; Put it back + XOR A + LD L,A ; Set L to zero + SUB B ; Negate exponent,set carry + LD B,A ; Re-save exponent + LD A,L ; Load zero + SBC A,E ; Negate LSB + LD E,A ; Re-save LSB + LD A,L ; Load zero + SBC A,D ; Negate NMSB + LD D,A ; Re-save NMSB + LD A,L ; Load zero + SBC A,C ; Negate MSB + LD C,A ; Re-save MSB + RET + +SCALE: LD B,0 ; Clear underflow +SCALLP: SUB 8 ; 8 bits (a whole byte)? + JP C,SHRITE ; No - Shift right A bits + LD B,E ; <- Shift + LD E,D ; <- right + LD D,C ; <- eight + LD C,0 ; <- bits + JP SCALLP ; More bits to shift + +SHRITE: ADD A,8+1 ; Adjust count + LD L,A ; Save bits to shift +SHRLP: XOR A ; Flag for all done + DEC L ; All shifting done? + RET Z ; Yes - Return + LD A,C ; Get MSB +SHRT1: RRA ; Shift it right + LD C,A ; Re-save + LD A,D ; Get NMSB + RRA ; Shift right with last bit + LD D,A ; Re-save it + LD A,E ; Get LSB + RRA ; Shift right with last bit + LD E,A ; Re-save it + LD A,B ; Get underflow + RRA ; Shift right with last bit + LD B,A ; Re-save underflow + JP SHRLP ; More bits to do + +UNITY: .BYTE 000H,000H,000H,081H ; 1.00000 + +LOGTAB: .BYTE 3 ; Table used by LOG + .BYTE 0AAH,056H,019H,080H ; 0.59898 + .BYTE 0F1H,022H,076H,080H ; 0.96147 + .BYTE 045H,0AAH,038H,082H ; 2.88539 + +LOG: CALL TSTSGN ; Test sign of value + OR A + JP PE,FCERR ; ?FC Error if <= zero + LD HL,FPEXP ; Point to exponent + LD A,(HL) ; Get exponent + LD BC,8035H ; BCDE = SQR(1/2) + LD DE,04F3H + SUB B ; Scale value to be < 1 + PUSH AF ; Save scale factor + LD (HL),B ; Save new exponent + PUSH DE ; Save SQR(1/2) + PUSH BC + CALL FPADD ; Add SQR(1/2) to value + POP BC ; Restore SQR(1/2) + POP DE + INC B ; Make it SQR(2) + CALL DVBCDE ; Divide by SQR(2) + LD HL,UNITY ; Point to 1. + CALL SUBPHL ; Subtract FPREG from 1 + LD HL,LOGTAB ; Coefficient table + CALL SUMSER ; Evaluate sum of series + LD BC,8080H ; BCDE = -0.5 + LD DE,0000H + CALL FPADD ; Subtract 0.5 from FPREG + POP AF ; Restore scale factor + CALL RSCALE ; Re-scale number +MULLN2: LD BC,8031H ; BCDE = Ln(2) + LD DE,7218H + .BYTE 21H ; Skip "POP BC" and "POP DE" + +MULT: POP BC ; Get number from stack + POP DE +FPMULT: CALL TSTSGN ; Test sign of FPREG + RET Z ; Return zero if zero + LD L,0 ; Flag add exponents + CALL ADDEXP ; Add exponents + LD A,C ; Get MSB of multiplier + LD (MULVAL),A ; Save MSB of multiplier + EX DE,HL + LD (MULVAL+1),HL ; Save rest of multiplier + LD BC,0 ; Partial product (BCDE) = zero + LD D,B + LD E,B + LD HL,BNORM ; Address of normalise + PUSH HL ; Save for return + LD HL,MULT8 ; Address of 8 bit multiply + PUSH HL ; Save for NMSB,MSB + PUSH HL ; + LD HL,FPREG ; Point to number +MULT8: LD A,(HL) ; Get LSB of number + INC HL ; Point to NMSB + OR A ; Test LSB + JP Z,BYTSFT ; Zero - shift to next byte + PUSH HL ; Save address of number + LD L,8 ; 8 bits to multiply by +MUL8LP: RRA ; Shift LSB right + LD H,A ; Save LSB + LD A,C ; Get MSB + JP NC,NOMADD ; Bit was zero - Don't add + PUSH HL ; Save LSB and count + LD HL,(MULVAL+1) ; Get LSB and NMSB + ADD HL,DE ; Add NMSB and LSB + EX DE,HL ; Leave sum in DE + POP HL ; Restore MSB and count + LD A,(MULVAL) ; Get MSB of multiplier + ADC A,C ; Add MSB +NOMADD: RRA ; Shift MSB right + LD C,A ; Re-save MSB + LD A,D ; Get NMSB + RRA ; Shift NMSB right + LD D,A ; Re-save NMSB + LD A,E ; Get LSB + RRA ; Shift LSB right + LD E,A ; Re-save LSB + LD A,B ; Get VLSB + RRA ; Shift VLSB right + LD B,A ; Re-save VLSB + DEC L ; Count bits multiplied + LD A,H ; Get LSB of multiplier + JP NZ,MUL8LP ; More - Do it +POPHRT: POP HL ; Restore address of number + RET + +BYTSFT: LD B,E ; Shift partial product left + LD E,D + LD D,C + LD C,A + RET + +DIV10: CALL STAKFP ; Save FPREG on stack + LD BC,8420H ; BCDE = 10. + LD DE,0000H + CALL FPBCDE ; Move 10 to FPREG + +DIV: POP BC ; Get number from stack + POP DE +DVBCDE: CALL TSTSGN ; Test sign of FPREG + JP Z,DZERR ; Error if division by zero + LD L,-1 ; Flag subtract exponents + CALL ADDEXP ; Subtract exponents + INC (HL) ; Add 2 to exponent to adjust + INC (HL) + DEC HL ; Point to MSB + LD A,(HL) ; Get MSB of dividend + LD (DIV3),A ; Save for subtraction + DEC HL + LD A,(HL) ; Get NMSB of dividend + LD (DIV2),A ; Save for subtraction + DEC HL + LD A,(HL) ; Get MSB of dividend + LD (DIV1),A ; Save for subtraction + LD B,C ; Get MSB + EX DE,HL ; NMSB,LSB to HL + XOR A + LD C,A ; Clear MSB of quotient + LD D,A ; Clear NMSB of quotient + LD E,A ; Clear LSB of quotient + LD (DIV4),A ; Clear overflow count +DIVLP: PUSH HL ; Save divisor + PUSH BC + LD A,L ; Get LSB of number + CALL DIVSUP ; Subt' divisor from dividend + SBC A,0 ; Count for overflows + CCF + JP NC,RESDIV ; Restore divisor if borrow + LD (DIV4),A ; Re-save overflow count + POP AF ; Scrap divisor + POP AF + SCF ; Set carry to + .BYTE 0D2H ; Skip "POP BC" and "POP HL" + +RESDIV: POP BC ; Restore divisor + POP HL + LD A,C ; Get MSB of quotient + INC A + DEC A + RRA ; Bit 0 to bit 7 + JP M,RONDB ; Done - Normalise result + RLA ; Restore carry + LD A,E ; Get LSB of quotient + RLA ; Double it + LD E,A ; Put it back + LD A,D ; Get NMSB of quotient + RLA ; Double it + LD D,A ; Put it back + LD A,C ; Get MSB of quotient + RLA ; Double it + LD C,A ; Put it back + ADD HL,HL ; Double NMSB,LSB of divisor + LD A,B ; Get MSB of divisor + RLA ; Double it + LD B,A ; Put it back + LD A,(DIV4) ; Get VLSB of quotient + RLA ; Double it + LD (DIV4),A ; Put it back + LD A,C ; Get MSB of quotient + OR D ; Merge NMSB + OR E ; Merge LSB + JP NZ,DIVLP ; Not done - Keep dividing + PUSH HL ; Save divisor + LD HL,FPEXP ; Point to exponent + DEC (HL) ; Divide by 2 + POP HL ; Restore divisor + JP NZ,DIVLP ; Ok - Keep going + JP OVERR ; Overflow error + +ADDEXP: LD A,B ; Get exponent of dividend + OR A ; Test it + JP Z,OVTST3 ; Zero - Result zero + LD A,L ; Get add/subtract flag + LD HL,FPEXP ; Point to exponent + XOR (HL) ; Add or subtract it + ADD A,B ; Add the other exponent + LD B,A ; Save new exponent + RRA ; Test exponent for overflow + XOR B + LD A,B ; Get exponent + JP P,OVTST2 ; Positive - Test for overflow + ADD A,80H ; Add excess 128 + LD (HL),A ; Save new exponent + JP Z,POPHRT ; Zero - Result zero + CALL SIGNS ; Set MSBs and sign of result + LD (HL),A ; Save new exponent + DEC HL ; Point to MSB + RET + +OVTST1: CALL TSTSGN ; Test sign of FPREG + CPL ; Invert sign + POP HL ; Clean up stack +OVTST2: OR A ; Test if new exponent zero +OVTST3: POP HL ; Clear off return address + JP P,RESZER ; Result zero + JP OVERR ; Overflow error + +MLSP10: CALL BCDEFP ; Move FPREG to BCDE + LD A,B ; Get exponent + OR A ; Is it zero? + RET Z ; Yes - Result is zero + ADD A,2 ; Multiply by 4 + JP C,OVERR ; Overflow - ?OV Error + LD B,A ; Re-save exponent + CALL FPADD ; Add BCDE to FPREG (Times 5) + LD HL,FPEXP ; Point to exponent + INC (HL) ; Double number (Times 10) + RET NZ ; Ok - Return + JP OVERR ; Overflow error + +TSTSGN: LD A,(FPEXP) ; Get sign of FPREG + OR A + RET Z ; RETurn if number is zero + LD A,(FPREG+2) ; Get MSB of FPREG + .BYTE 0FEH ; Test sign +RETREL: CPL ; Invert sign + RLA ; Sign bit to carry +FLGDIF: SBC A,A ; Carry to all bits of A + RET NZ ; Return -1 if negative + INC A ; Bump to +1 + RET ; Positive - Return +1 + +SGN: CALL TSTSGN ; Test sign of FPREG +FLGREL: LD B,80H+8 ; 8 bit integer in exponent + LD DE,0 ; Zero NMSB and LSB +RETINT: LD HL,FPEXP ; Point to exponent + LD C,A ; CDE = MSB,NMSB and LSB + LD (HL),B ; Save exponent + LD B,0 ; CDE = integer to normalise + INC HL ; Point to sign of result + LD (HL),80H ; Set sign of result + RLA ; Carry = sign of integer + JP CONPOS ; Set sign of result + +ABS: CALL TSTSGN ; Test sign of FPREG + RET P ; Return if positive +INVSGN: LD HL,FPREG+2 ; Point to MSB + LD A,(HL) ; Get sign of mantissa + XOR 80H ; Invert sign of mantissa + LD (HL),A ; Re-save sign of mantissa + RET + +STAKFP: EX DE,HL ; Save code string address + LD HL,(FPREG) ; LSB,NLSB of FPREG + EX (SP),HL ; Stack them,get return + PUSH HL ; Re-save return + LD HL,(FPREG+2) ; MSB and exponent of FPREG + EX (SP),HL ; Stack them,get return + PUSH HL ; Re-save return + EX DE,HL ; Restore code string address + RET + +PHLTFP: CALL LOADFP ; Number at HL to BCDE +FPBCDE: EX DE,HL ; Save code string address + LD (FPREG),HL ; Save LSB,NLSB of number + LD H,B ; Exponent of number + LD L,C ; MSB of number + LD (FPREG+2),HL ; Save MSB and exponent + EX DE,HL ; Restore code string address + RET + +BCDEFP: LD HL,FPREG ; Point to FPREG +LOADFP: LD E,(HL) ; Get LSB of number + INC HL + LD D,(HL) ; Get NMSB of number + INC HL + LD C,(HL) ; Get MSB of number + INC HL + LD B,(HL) ; Get exponent of number +INCHL: INC HL ; Used for conditional "INC HL" + RET + +FPTHL: LD DE,FPREG ; Point to FPREG +DETHL4: LD B,4 ; 4 bytes to move +DETHLB: LD A,(DE) ; Get source + LD (HL),A ; Save destination + INC DE ; Next source + INC HL ; Next destination + DEC B ; Count bytes + JP NZ,DETHLB ; Loop if more + RET + +SIGNS: LD HL,FPREG+2 ; Point to MSB of FPREG + LD A,(HL) ; Get MSB + RLCA ; Old sign to carry + SCF ; Set MSBit + RRA ; Set MSBit of MSB + LD (HL),A ; Save new MSB + CCF ; Complement sign + RRA ; Old sign to carry + INC HL + INC HL + LD (HL),A ; Set sign of result + LD A,C ; Get MSB + RLCA ; Old sign to carry + SCF ; Set MSBit + RRA ; Set MSBit of MSB + LD C,A ; Save MSB + RRA + XOR (HL) ; New sign of result + RET + +CMPNUM: LD A,B ; Get exponent of number + OR A + JP Z,TSTSGN ; Zero - Test sign of FPREG + LD HL,RETREL ; Return relation routine + PUSH HL ; Save for return + CALL TSTSGN ; Test sign of FPREG + LD A,C ; Get MSB of number + RET Z ; FPREG zero - Number's MSB + LD HL,FPREG+2 ; MSB of FPREG + XOR (HL) ; Combine signs + LD A,C ; Get MSB of number + RET M ; Exit if signs different + CALL CMPFP ; Compare FP numbers + RRA ; Get carry to sign + XOR C ; Combine with MSB of number + RET + +CMPFP: INC HL ; Point to exponent + LD A,B ; Get exponent + CP (HL) ; Compare exponents + RET NZ ; Different + DEC HL ; Point to MBS + LD A,C ; Get MSB + CP (HL) ; Compare MSBs + RET NZ ; Different + DEC HL ; Point to NMSB + LD A,D ; Get NMSB + CP (HL) ; Compare NMSBs + RET NZ ; Different + DEC HL ; Point to LSB + LD A,E ; Get LSB + SUB (HL) ; Compare LSBs + RET NZ ; Different + POP HL ; Drop RETurn + POP HL ; Drop another RETurn + RET + +FPINT: LD B,A ; <- Move + LD C,A ; <- exponent + LD D,A ; <- to all + LD E,A ; <- bits + OR A ; Test exponent + RET Z ; Zero - Return zero + PUSH HL ; Save pointer to number + CALL BCDEFP ; Move FPREG to BCDE + CALL SIGNS ; Set MSBs & sign of result + XOR (HL) ; Combine with sign of FPREG + LD H,A ; Save combined signs + CALL M,DCBCDE ; Negative - Decrement BCDE + LD A,80H+24 ; 24 bits + SUB B ; Bits to shift + CALL SCALE ; Shift BCDE + LD A,H ; Get combined sign + RLA ; Sign to carry + CALL C,FPROND ; Negative - Round number up + LD B,0 ; Zero exponent + CALL C,COMPL ; If negative make positive + POP HL ; Restore pointer to number + RET + +DCBCDE: DEC DE ; Decrement BCDE + LD A,D ; Test LSBs + AND E + INC A + RET NZ ; Exit if LSBs not FFFF + DEC BC ; Decrement MSBs + RET + +INT: LD HL,FPEXP ; Point to exponent + LD A,(HL) ; Get exponent + CP 80H+24 ; Integer accuracy only? + LD A,(FPREG) ; Get LSB + RET NC ; Yes - Already integer + LD A,(HL) ; Get exponent + CALL FPINT ; F.P to integer + LD (HL),80H+24 ; Save 24 bit integer + LD A,E ; Get LSB of number + PUSH AF ; Save LSB + LD A,C ; Get MSB of number + RLA ; Sign to carry + CALL CONPOS ; Set sign of result + POP AF ; Restore LSB of number + RET + +MLDEBC: LD HL,0 ; Clear partial product + LD A,B ; Test multiplier + OR C + RET Z ; Return zero if zero + LD A,16 ; 16 bits +MLDBLP: ADD HL,HL ; Shift P.P left + JP C,BSERR ; ?BS Error if overflow + EX DE,HL + ADD HL,HL ; Shift multiplier left + EX DE,HL + JP NC,NOMLAD ; Bit was zero - No add + ADD HL,BC ; Add multiplicand + JP C,BSERR ; ?BS Error if overflow +NOMLAD: DEC A ; Count bits + JP NZ,MLDBLP ; More + RET + +ASCTFP: CP '-' ; Negative? + PUSH AF ; Save it and flags + JP Z,CNVNUM ; Yes - Convert number + CP '+' ; Positive? + JP Z,CNVNUM ; Yes - Convert number + DEC HL ; DEC 'cos GETCHR INCs +CNVNUM: CALL RESZER ; Set result to zero + LD B,A ; Digits after point counter + LD D,A ; Sign of exponent + LD E,A ; Exponent of ten + CPL + LD C,A ; Before or after point flag +MANLP: CALL GETCHR ; Get next character + JP C,ADDIG ; Digit - Add to number + CP '.' + JP Z,DPOINT ; '.' - Flag point + CP 'E' + JP NZ,CONEXP ; Not 'E' - Scale number + CALL GETCHR ; Get next character + CALL SGNEXP ; Get sign of exponent +EXPLP: CALL GETCHR ; Get next character + JP C,EDIGIT ; Digit - Add to exponent + INC D ; Is sign negative? + JP NZ,CONEXP ; No - Scale number + XOR A + SUB E ; Negate exponent + LD E,A ; And re-save it + INC C ; Flag end of number +DPOINT: INC C ; Flag point passed + JP Z,MANLP ; Zero - Get another digit +CONEXP: PUSH HL ; Save code string address + LD A,E ; Get exponent + SUB B ; Subtract digits after point +SCALMI: CALL P,SCALPL ; Positive - Multiply number + JP P,ENDCON ; Positive - All done + PUSH AF ; Save number of times to /10 + CALL DIV10 ; Divide by 10 + POP AF ; Restore count + INC A ; Count divides + +ENDCON: JP NZ,SCALMI ; More to do + POP DE ; Restore code string address + POP AF ; Restore sign of number + CALL Z,INVSGN ; Negative - Negate number + EX DE,HL ; Code string address to HL + RET + +SCALPL: RET Z ; Exit if no scaling needed +MULTEN: PUSH AF ; Save count + CALL MLSP10 ; Multiply number by 10 + POP AF ; Restore count + DEC A ; Count multiplies + RET + +ADDIG: PUSH DE ; Save sign of exponent + LD D,A ; Save digit + LD A,B ; Get digits after point + ADC A,C ; Add one if after point + LD B,A ; Re-save counter + PUSH BC ; Save point flags + PUSH HL ; Save code string address + PUSH DE ; Save digit + CALL MLSP10 ; Multiply number by 10 + POP AF ; Restore digit + SUB '0' ; Make it absolute + CALL RSCALE ; Re-scale number + POP HL ; Restore code string address + POP BC ; Restore point flags + POP DE ; Restore sign of exponent + JP MANLP ; Get another digit + +RSCALE: CALL STAKFP ; Put number on stack + CALL FLGREL ; Digit to add to FPREG +PADD: POP BC ; Restore number + POP DE + JP FPADD ; Add BCDE to FPREG and return + +EDIGIT: LD A,E ; Get digit + RLCA ; Times 2 + RLCA ; Times 4 + ADD A,E ; Times 5 + RLCA ; Times 10 + ADD A,(HL) ; Add next digit + SUB '0' ; Make it absolute + LD E,A ; Save new digit + JP EXPLP ; Look for another digit + +LINEIN: PUSH HL ; Save code string address + LD HL,INMSG ; Output " in " + CALL PRS ; Output string at HL + POP HL ; Restore code string address +PRNTHL: EX DE,HL ; Code string address to DE + XOR A + LD B,80H+24 ; 24 bits + CALL RETINT ; Return the integer + LD HL,PRNUMS ; Print number string + PUSH HL ; Save for return +NUMASC: LD HL,PBUFF ; Convert number to ASCII + PUSH HL ; Save for return + CALL TSTSGN ; Test sign of FPREG + LD (HL),' ' ; Space at start + JP P,SPCFST ; Positive - Space to start + LD (HL),'-' ; '-' sign at start +SPCFST: INC HL ; First byte of number + LD (HL),'0' ; '0' if zero + JP Z,JSTZER ; Return '0' if zero + PUSH HL ; Save buffer address + CALL M,INVSGN ; Negate FPREG if negative + XOR A ; Zero A + PUSH AF ; Save it + CALL RNGTST ; Test number is in range +SIXDIG: LD BC,9143H ; BCDE - 99999.9 + LD DE,4FF8H + CALL CMPNUM ; Compare numbers + OR A + JP PO,INRNG ; > 99999.9 - Sort it out + POP AF ; Restore count + CALL MULTEN ; Multiply by ten + PUSH AF ; Re-save count + JP SIXDIG ; Test it again + +GTSIXD: CALL DIV10 ; Divide by 10 + POP AF ; Get count + INC A ; Count divides + PUSH AF ; Re-save count + CALL RNGTST ; Test number is in range +INRNG: CALL ROUND ; Add 0.5 to FPREG + INC A + CALL FPINT ; F.P to integer + CALL FPBCDE ; Move BCDE to FPREG + LD BC,0306H ; 1E+06 to 1E-03 range + POP AF ; Restore count + ADD A,C ; 6 digits before point + INC A ; Add one + JP M,MAKNUM ; Do it in 'E' form if < 1E-02 + CP 6+1+1 ; More than 999999 ? + JP NC,MAKNUM ; Yes - Do it in 'E' form + INC A ; Adjust for exponent + LD B,A ; Exponent of number + LD A,2 ; Make it zero after + +MAKNUM: DEC A ; Adjust for digits to do + DEC A + POP HL ; Restore buffer address + PUSH AF ; Save count + LD DE,POWERS ; Powers of ten + DEC B ; Count digits before point + JP NZ,DIGTXT ; Not zero - Do number + LD (HL),'.' ; Save point + INC HL ; Move on + LD (HL),'0' ; Save zero + INC HL ; Move on +DIGTXT: DEC B ; Count digits before point + LD (HL),'.' ; Save point in case + CALL Z,INCHL ; Last digit - move on + PUSH BC ; Save digits before point + PUSH HL ; Save buffer address + PUSH DE ; Save powers of ten + CALL BCDEFP ; Move FPREG to BCDE + POP HL ; Powers of ten table + LD B, '0'-1 ; ASCII '0' - 1 +TRYAGN: INC B ; Count subtractions + LD A,E ; Get LSB + SUB (HL) ; Subtract LSB + LD E,A ; Save LSB + INC HL + LD A,D ; Get NMSB + SBC A,(HL) ; Subtract NMSB + LD D,A ; Save NMSB + INC HL + LD A,C ; Get MSB + SBC A,(HL) ; Subtract MSB + LD C,A ; Save MSB + DEC HL ; Point back to start + DEC HL + JP NC,TRYAGN ; No overflow - Try again + CALL PLUCDE ; Restore number + INC HL ; Start of next number + CALL FPBCDE ; Move BCDE to FPREG + EX DE,HL ; Save point in table + POP HL ; Restore buffer address + LD (HL),B ; Save digit in buffer + INC HL ; And move on + POP BC ; Restore digit count + DEC C ; Count digits + JP NZ,DIGTXT ; More - Do them + DEC B ; Any decimal part? + JP Z,DOEBIT ; No - Do 'E' bit +SUPTLZ: DEC HL ; Move back through buffer + LD A,(HL) ; Get character + CP '0' ; '0' character? + JP Z,SUPTLZ ; Yes - Look back for more + CP '.' ; A decimal point? + CALL NZ,INCHL ; Move back over digit + +DOEBIT: POP AF ; Get 'E' flag + JP Z,NOENED ; No 'E' needed - End buffer + LD (HL),'E' ; Put 'E' in buffer + INC HL ; And move on + LD (HL),'+' ; Put '+' in buffer + JP P,OUTEXP ; Positive - Output exponent + LD (HL),'-' ; Put '-' in buffer + CPL ; Negate exponent + INC A +OUTEXP: LD B,'0'-1 ; ASCII '0' - 1 +EXPTEN: INC B ; Count subtractions + SUB 10 ; Tens digit + JP NC,EXPTEN ; More to do + ADD A,'0'+10 ; Restore and make ASCII + INC HL ; Move on + LD (HL),B ; Save MSB of exponent +JSTZER: INC HL ; + LD (HL),A ; Save LSB of exponent + INC HL +NOENED: LD (HL),C ; Mark end of buffer + POP HL ; Restore code string address + RET + +RNGTST: LD BC,9474H ; BCDE = 999999. + LD DE,23F7H + CALL CMPNUM ; Compare numbers + OR A + POP HL ; Return address to HL + JP PO,GTSIXD ; Too big - Divide by ten + JP (HL) ; Otherwise return to caller + +HALF: .BYTE 00H,00H,00H,80H ; 0.5 + +POWERS: .BYTE 0A0H,086H,001H ; 100000 + .BYTE 010H,027H,000H ; 10000 + .BYTE 0E8H,003H,000H ; 1000 + .BYTE 064H,000H,000H ; 100 + .BYTE 00AH,000H,000H ; 10 + .BYTE 001H,000H,000H ; 1 + +NEGAFT: LD HL,INVSGN ; Negate result + EX (SP),HL ; To be done after caller + JP (HL) ; Return to caller + +SQR: CALL STAKFP ; Put value on stack + LD HL,HALF ; Set power to 1/2 + CALL PHLTFP ; Move 1/2 to FPREG + +POWER: POP BC ; Get base + POP DE + CALL TSTSGN ; Test sign of power + LD A,B ; Get exponent of base + JP Z,EXP ; Make result 1 if zero + JP P,POWER1 ; Positive base - Ok + OR A ; Zero to negative power? + JP Z,DZERR ; Yes - ?/0 Error +POWER1: OR A ; Base zero? + JP Z,SAVEXP ; Yes - Return zero + PUSH DE ; Save base + PUSH BC + LD A,C ; Get MSB of base + OR 01111111B ; Get sign status + CALL BCDEFP ; Move power to BCDE + JP P,POWER2 ; Positive base - Ok + PUSH DE ; Save power + PUSH BC + CALL INT ; Get integer of power + POP BC ; Restore power + POP DE + PUSH AF ; MSB of base + CALL CMPNUM ; Power an integer? + POP HL ; Restore MSB of base + LD A,H ; but don't affect flags + RRA ; Exponent odd or even? +POWER2: POP HL ; Restore MSB and exponent + LD (FPREG+2),HL ; Save base in FPREG + POP HL ; LSBs of base + LD (FPREG),HL ; Save in FPREG + CALL C,NEGAFT ; Odd power - Negate result + CALL Z,INVSGN ; Negative base - Negate it + PUSH DE ; Save power + PUSH BC + CALL LOG ; Get LOG of base + POP BC ; Restore power + POP DE + CALL FPMULT ; Multiply LOG by power + +EXP: CALL STAKFP ; Put value on stack + LD BC,08138H ; BCDE = 1/Ln(2) + LD DE,0AA3BH + CALL FPMULT ; Multiply value by 1/LN(2) + LD A,(FPEXP) ; Get exponent + CP 80H+8 ; Is it in range? + JP NC,OVTST1 ; No - Test for overflow + CALL INT ; Get INT of FPREG + ADD A,80H ; For excess 128 + ADD A,2 ; Exponent > 126? + JP C,OVTST1 ; Yes - Test for overflow + PUSH AF ; Save scaling factor + LD HL,UNITY ; Point to 1. + CALL ADDPHL ; Add 1 to FPREG + CALL MULLN2 ; Multiply by LN(2) + POP AF ; Restore scaling factor + POP BC ; Restore exponent + POP DE + PUSH AF ; Save scaling factor + CALL SUBCDE ; Subtract exponent from FPREG + CALL INVSGN ; Negate result + LD HL,EXPTAB ; Coefficient table + CALL SMSER1 ; Sum the series + LD DE,0 ; Zero LSBs + POP BC ; Scaling factor + LD C,D ; Zero MSB + JP FPMULT ; Scale result to correct value + +EXPTAB: .BYTE 8 ; Table used by EXP + .BYTE 040H,02EH,094H,074H ; -1/7! (-1/5040) + .BYTE 070H,04FH,02EH,077H ; 1/6! ( 1/720) + .BYTE 06EH,002H,088H,07AH ; -1/5! (-1/120) + .BYTE 0E6H,0A0H,02AH,07CH ; 1/4! ( 1/24) + .BYTE 050H,0AAH,0AAH,07EH ; -1/3! (-1/6) + .BYTE 0FFH,0FFH,07FH,07FH ; 1/2! ( 1/2) + .BYTE 000H,000H,080H,081H ; -1/1! (-1/1) + .BYTE 000H,000H,000H,081H ; 1/0! ( 1/1) + +SUMSER: CALL STAKFP ; Put FPREG on stack + LD DE,MULT ; Multiply by "X" + PUSH DE ; To be done after + PUSH HL ; Save address of table + CALL BCDEFP ; Move FPREG to BCDE + CALL FPMULT ; Square the value + POP HL ; Restore address of table +SMSER1: CALL STAKFP ; Put value on stack + LD A,(HL) ; Get number of coefficients + INC HL ; Point to start of table + CALL PHLTFP ; Move coefficient to FPREG + .BYTE 06H ; Skip "POP AF" +SUMLP: POP AF ; Restore count + POP BC ; Restore number + POP DE + DEC A ; Cont coefficients + RET Z ; All done + PUSH DE ; Save number + PUSH BC + PUSH AF ; Save count + PUSH HL ; Save address in table + CALL FPMULT ; Multiply FPREG by BCDE + POP HL ; Restore address in table + CALL LOADFP ; Number at HL to BCDE + PUSH HL ; Save address in table + CALL FPADD ; Add coefficient to FPREG + POP HL ; Restore address in table + JP SUMLP ; More coefficients + +RND: CALL TSTSGN ; Test sign of FPREG + LD HL,SEED+2 ; Random number seed + JP M,RESEED ; Negative - Re-seed + LD HL,LSTRND ; Last random number + CALL PHLTFP ; Move last RND to FPREG + LD HL,SEED+2 ; Random number seed + RET Z ; Return if RND(0) + ADD A,(HL) ; Add (SEED)+2) + AND 00000111B ; 0 to 7 + LD B,0 + LD (HL),A ; Re-save seed + INC HL ; Move to coefficient table + ADD A,A ; 4 bytes + ADD A,A ; per entry + LD C,A ; BC = Offset into table + ADD HL,BC ; Point to coefficient + CALL LOADFP ; Coefficient to BCDE + CALL FPMULT ; ; Multiply FPREG by coefficient + LD A,(SEED+1) ; Get (SEED+1) + INC A ; Add 1 + AND 00000011B ; 0 to 3 + LD B,0 + CP 1 ; Is it zero? + ADC A,B ; Yes - Make it 1 + LD (SEED+1),A ; Re-save seed + LD HL,RNDTAB-4 ; Addition table + ADD A,A ; 4 bytes + ADD A,A ; per entry + LD C,A ; BC = Offset into table + ADD HL,BC ; Point to value + CALL ADDPHL ; Add value to FPREG +RND1: CALL BCDEFP ; Move FPREG to BCDE + LD A,E ; Get LSB + LD E,C ; LSB = MSB + XOR 01001111B ; Fiddle around + LD C,A ; New MSB + LD (HL),80H ; Set exponent + DEC HL ; Point to MSB + LD B,(HL) ; Get MSB + LD (HL),80H ; Make value -0.5 + LD HL,SEED ; Random number seed + INC (HL) ; Count seed + LD A,(HL) ; Get seed + SUB 171 ; Do it modulo 171 + JP NZ,RND2 ; Non-zero - Ok + LD (HL),A ; Zero seed + INC C ; Fillde about + DEC D ; with the + INC E ; number +RND2: CALL BNORM ; Normalise number + LD HL,LSTRND ; Save random number + JP FPTHL ; Move FPREG to last and return + +RESEED: LD (HL),A ; Re-seed random numbers + DEC HL + LD (HL),A + DEC HL + LD (HL),A + JP RND1 ; Return RND seed + +RNDTAB: .BYTE 068H,0B1H,046H,068H ; Table used by RND + .BYTE 099H,0E9H,092H,069H + .BYTE 010H,0D1H,075H,068H + +COS: LD HL,HALFPI ; Point to PI/2 + CALL ADDPHL ; Add it to PPREG +SIN: CALL STAKFP ; Put angle on stack + LD BC,8349H ; BCDE = 2 PI + LD DE,0FDBH + CALL FPBCDE ; Move 2 PI to FPREG + POP BC ; Restore angle + POP DE + CALL DVBCDE ; Divide angle by 2 PI + CALL STAKFP ; Put it on stack + CALL INT ; Get INT of result + POP BC ; Restore number + POP DE + CALL SUBCDE ; Make it 0 <= value < 1 + LD HL,QUARTR ; Point to 0.25 + CALL SUBPHL ; Subtract value from 0.25 + CALL TSTSGN ; Test sign of value + SCF ; Flag positive + JP P,SIN1 ; Positive - Ok + CALL ROUND ; Add 0.5 to value + CALL TSTSGN ; Test sign of value + OR A ; Flag negative +SIN1: PUSH AF ; Save sign + CALL P,INVSGN ; Negate value if positive + LD HL,QUARTR ; Point to 0.25 + CALL ADDPHL ; Add 0.25 to value + POP AF ; Restore sign + CALL NC,INVSGN ; Negative - Make positive + LD HL,SINTAB ; Coefficient table + JP SUMSER ; Evaluate sum of series + +HALFPI: .BYTE 0DBH,00FH,049H,081H ; 1.5708 (PI/2) + +QUARTR: .BYTE 000H,000H,000H,07FH ; 0.25 + +SINTAB: .BYTE 5 ; Table used by SIN + .BYTE 0BAH,0D7H,01EH,086H ; 39.711 + .BYTE 064H,026H,099H,087H ;-76.575 + .BYTE 058H,034H,023H,087H ; 81.602 + .BYTE 0E0H,05DH,0A5H,086H ;-41.342 + .BYTE 0DAH,00FH,049H,083H ; 6.2832 + +TAN: CALL STAKFP ; Put angle on stack + CALL SIN ; Get SIN of angle + POP BC ; Restore angle + POP HL + CALL STAKFP ; Save SIN of angle + EX DE,HL ; BCDE = Angle + CALL FPBCDE ; Angle to FPREG + CALL COS ; Get COS of angle + JP DIV ; TAN = SIN / COS + +ATN: CALL TSTSGN ; Test sign of value + CALL M,NEGAFT ; Negate result after if -ve + CALL M,INVSGN ; Negate value if -ve + LD A,(FPEXP) ; Get exponent + CP 81H ; Number less than 1? + JP C,ATN1 ; Yes - Get arc tangnt + LD BC,8100H ; BCDE = 1 + LD D,C + LD E,C + CALL DVBCDE ; Get reciprocal of number + LD HL,SUBPHL ; Sub angle from PI/2 + PUSH HL ; Save for angle > 1 +ATN1: LD HL,ATNTAB ; Coefficient table + CALL SUMSER ; Evaluate sum of series + LD HL,HALFPI ; PI/2 - angle in case > 1 + RET ; Number > 1 - Sub from PI/2 + +ATNTAB: .BYTE 9 ; Table used by ATN + .BYTE 04AH,0D7H,03BH,078H ; 1/17 + .BYTE 002H,06EH,084H,07BH ;-1/15 + .BYTE 0FEH,0C1H,02FH,07CH ; 1/13 + .BYTE 074H,031H,09AH,07DH ;-1/11 + .BYTE 084H,03DH,05AH,07DH ; 1/9 + .BYTE 0C8H,07FH,091H,07EH ;-1/7 + .BYTE 0E4H,0BBH,04CH,07EH ; 1/5 + .BYTE 06CH,0AAH,0AAH,07FH ;-1/3 + .BYTE 000H,000H,000H,081H ; 1/1 + + +ARET: RET ; A RETurn instruction + +GETINP: RST 10H ;input a character + RET + +CLS: + LD A,CS ; ASCII Clear screen + JP MONOUT ; Output character + +WIDTH: CALL GETINT ; Get integer 0-255 + LD A,E ; Width to A + LD (LWIDTH),A ; Set width + RET + +LINES: CALL GETNUM ; Get a number + CALL DEINT ; Get integer -32768 to 32767 + LD (LINESC),DE ; Set lines counter + LD (LINESN),DE ; Set lines number + RET + +DEEK: CALL DEINT ; Get integer -32768 to 32767 + PUSH DE ; Save number + POP HL ; Number to HL + LD B,(HL) ; Get LSB of contents + INC HL + LD A,(HL) ; Get MSB of contents + JP ABPASS ; Return integer AB + +DOKE: CALL GETNUM ; Get a number + CALL DEINT ; Get integer -32768 to 32767 + PUSH DE ; Save address + CALL CHKSYN ; Make sure ',' follows + .BYTE ',' + CALL GETNUM ; Get a number + CALL DEINT ; Get integer -32768 to 32767 + EX (SP),HL ; Save value,get address + LD (HL),E ; Save LSB of value + INC HL + LD (HL),D ; Save MSB of value + POP HL ; Restore code string address + RET + + +; HEX$(nn) Convert 16 bit number to Hexadecimal string + +HEX: CALL TSTNUM ; Verify it's a number + CALL DEINT ; Get integer -32768 to 32767 + PUSH BC ; Save contents of BC + LD HL,PBUFF + LD A,D ; Get high order into A + CP $0 + JR Z,HEX2 ; Skip output if both high digits are zero + CALL BYT2ASC ; Convert D to ASCII + LD A,B + CP '0' + JR Z,HEX1 ; Don't store high digit if zero + LD (HL),B ; Store it to PBUFF + INC HL ; Next location +HEX1: LD (HL),C ; Store C to PBUFF+1 + INC HL ; Next location +HEX2: LD A,E ; Get lower byte + CALL BYT2ASC ; Convert E to ASCII + LD A,D + CP $0 + JR NZ,HEX3 ; If upper byte was not zero then always print lower byte + LD A,B + CP '0' ; If high digit of lower byte is zero then don't print + JR Z,HEX4 +HEX3: LD (HL),B ; to PBUFF+2 + INC HL ; Next location +HEX4: LD (HL),C ; to PBUFF+3 + INC HL ; PBUFF+4 to zero + XOR A ; Terminating character + LD (HL),A ; Store zero to terminate + INC HL ; Make sure PBUFF is terminated + LD (HL),A ; Store the double zero there + POP BC ; Get BC back + LD HL,PBUFF ; Reset to start of PBUFF + JP STR1 ; Convert the PBUFF to a string and return it + +BYT2ASC LD B,A ; Save original value + AND $0F ; Strip off upper nybble + CP $0A ; 0-9? + JR C,ADD30 ; If A-F, add 7 more + ADD A,$07 ; Bring value up to ASCII A-F +ADD30 ADD A,$30 ; And make ASCII + LD C,A ; Save converted char to C + LD A,B ; Retrieve original value + RRCA ; and Rotate it right + RRCA + RRCA + RRCA + AND $0F ; Mask off upper nybble + CP $0A ; 0-9? < A hex? + JR C,ADD301 ; Skip Add 7 + ADD A,$07 ; Bring it up to ASCII A-F +ADD301 ADD A,$30 ; And make it full ASCII + LD B,A ; Store high order byte + RET + +; Convert "&Hnnnn" to FPREG +; Gets a character from (HL) checks for Hexadecimal ASCII numbers "&Hnnnn" +; Char is in A, NC if char is ;<=>?@ A-z, CY is set if 0-9 +HEXTFP EX DE,HL ; Move code string pointer to DE + LD HL,$0000 ; Zero out the value + CALL GETHEX ; Check the number for valid hex + JP C,HXERR ; First value wasn't hex, HX error + JR HEXLP1 ; Convert first character +HEXLP CALL GETHEX ; Get second and addtional characters + JR C,HEXIT ; Exit if not a hex character +HEXLP1 ADD HL,HL ; Rotate 4 bits to the left + ADD HL,HL + ADD HL,HL + ADD HL,HL + OR L ; Add in D0-D3 into L + LD L,A ; Save new value + JR HEXLP ; And continue until all hex characters are in + +GETHEX INC DE ; Next location + LD A,(DE) ; Load character at pointer + CP ' ' + JP Z,GETHEX ; Skip spaces + SUB $30 ; Get absolute value + RET C ; < "0", error + CP $0A + JR C,NOSUB7 ; Is already in the range 0-9 + SUB $07 ; Reduce to A-F + CP $0A ; Value should be $0A-$0F at this point + RET C ; CY set if was : ; < = > ? @ +NOSUB7 CP $10 ; > Greater than "F"? + CCF + RET ; CY set if it wasn't valid hex + +HEXIT EX DE,HL ; Value into DE, Code string into HL + LD A,D ; Load DE into AC + LD C,E ; For prep to + PUSH HL + CALL ACPASS ; ACPASS to set AC as integer into FPREG + POP HL + RET + +HXERR: LD E,HX ; ?HEX Error + JP ERROR + +; BIN$(NN) Convert integer to a 1-16 char binary string +BIN: CALL TSTNUM ; Verify it's a number + CALL DEINT ; Get integer -32768 to 32767 +BIN2: PUSH BC ; Save contents of BC + LD HL,PBUFF + LD B,17 ; One higher than max char count +ZEROSUP: ; Suppress leading zeros + DEC B ; Max 16 chars + LD A,B + CP $01 + JR Z,BITOUT ; Always output at least one character + RL E + RL D + JR NC,ZEROSUP + JR BITOUT2 +BITOUT: + RL E + RL D ; Top bit now in carry +BITOUT2: + LD A,'0' ; Char for '0' + ADC A,0 ; If carry set then '0' --> '1' + LD (HL),A + INC HL + DEC B + JR NZ,BITOUT + XOR A ; Terminating character + LD (HL),A ; Store zero to terminate + INC HL ; Make sure PBUFF is terminated + LD (HL),A ; Store the double zero there + POP BC + LD HL,PBUFF + JP STR1 + +; Convert "&Bnnnn" to FPREG +; Gets a character from (HL) checks for Binary ASCII numbers "&Bnnnn" +BINTFP: EX DE,HL ; Move code string pointer to DE + LD HL,$0000 ; Zero out the value + CALL CHKBIN ; Check the number for valid bin + JP C,BINERR ; First value wasn't bin, HX error +BINIT: SUB '0' + ADD HL,HL ; Rotate HL left + OR L + LD L,A + CALL CHKBIN ; Get second and addtional characters + JR NC,BINIT ; Process if a bin character + EX DE,HL ; Value into DE, Code string into HL + LD A,D ; Load DE into AC + LD C,E ; For prep to + PUSH HL + CALL ACPASS ; ACPASS to set AC as integer into FPREG + POP HL + RET + +; Char is in A, NC if char is 0 or 1 +CHKBIN: INC DE + LD A,(DE) + CP ' ' + JP Z,CHKBIN ; Skip spaces + CP '0' ; Set C if < '0' + RET C + CP '2' + CCF ; Set C if > '1' + RET + +BINERR: LD E,BN ; ?BIN Error + JP ERROR + + +JJUMP1: + LD IX,-1 ; Flag cold start + JP CSTART ; Go and initialise + +MONOUT: + JP $0008 ; output a char + + +MONITR: + JP $0000 ; Restart (Normally Monitor Start) + + +INITST: LD A,0 ; Clear break flag + LD (BRKFLG),A + JP INIT + +ARETN: RETN ; Return from NMI + + +TSTBIT: PUSH AF ; Save bit mask + AND B ; Get common bits + POP BC ; Restore bit mask + CP B ; Same bit set? + LD A,0 ; Return 0 in A + RET + +OUTNCR: CALL OUTC ; Output character in A + JP PRNTCRLF ; Output CRLF + +.end + diff --git a/new/apps/basic/searle8kinit.asm b/new/apps/basic/searle8kinit.asm new file mode 100644 index 0000000..c0c79c6 --- /dev/null +++ b/new/apps/basic/searle8kinit.asm @@ -0,0 +1,202 @@ +;================================================================================== +; Contents of this file are copyright Grant Searle +; +; You have permission to use this for NON COMMERCIAL USE ONLY +; If you wish to use it elsewhere, please include an acknowledgement to myself. +; +; http://searle.hostei.com/grant/index.html +; +; eMail: home.micros01@btinternet.com +; +; If the above don't work, please perform an Internet search to see if I have +; updated the web page hosting service. +; +;================================================================================== + +; Minimum 6850 ACIA interrupt driven serial I/O to run modified NASCOM Basic 4.7 +; Full input buffering with incoming data hardware handshaking +; Handshake shows full before the buffer is totally filled to allow run-on from the sender + +SER_BUFSIZE .EQU 3FH +SER_FULLSIZE .EQU 30H +SER_EMPTYSIZE .EQU 5 + +RTS_HIGH .EQU 0D6H +RTS_LOW .EQU 096H + +serBuf .EQU $2000 +serInPtr .EQU serBuf+SER_BUFSIZE +serRdPtr .EQU serInPtr+2 +serBufUsed .EQU serRdPtr+2 +basicStarted .EQU serBufUsed+1 +TEMPSTACK .EQU $20ED ; Top of BASIC line input buffer so is "free ram" when BASIC resets + +CR .EQU 0DH +LF .EQU 0AH +CS .EQU 0CH ; Clear screen + + .ORG $0000 +;------------------------------------------------------------------------------ +; Reset + +RST00 DI ;Disable interrupts + JP INIT ;Initialize Hardware and go + +;------------------------------------------------------------------------------ +; TX a character over RS232 + + .ORG 0008H +RST08 JP TXA + +;------------------------------------------------------------------------------ +; RX a character over RS232 Channel A [Console], hold here until char ready. + + .ORG 0010H +RST10 JP RXA + +;------------------------------------------------------------------------------ +; Check serial status + + .ORG 0018H +RST18 JP CKINCHAR + +;------------------------------------------------------------------------------ +; RST 38 - INTERRUPT VECTOR [ for IM 1 ] + + .ORG 0038H +RST38 JR serialInt + +;------------------------------------------------------------------------------ +serialInt: PUSH AF + PUSH HL + + IN A,($80) + AND $01 ; Check if interupt due to read buffer full + JR Z,rts0 ; if not, ignore + + IN A,($81) + PUSH AF + LD A,(serBufUsed) + CP SER_BUFSIZE ; If full then ignore + JR NZ,notFull + POP AF + JR rts0 + +notFull: LD HL,(serInPtr) + INC HL + LD A,L ; Only need to check low byte becasuse buffer<256 bytes + CP (serBuf+SER_BUFSIZE) & $FF + JR NZ, notWrap + LD HL,serBuf +notWrap: LD (serInPtr),HL + POP AF + LD (HL),A + LD A,(serBufUsed) + INC A + LD (serBufUsed),A + CP SER_FULLSIZE + JR C,rts0 + LD A,RTS_HIGH + OUT ($80),A +rts0: POP HL + POP AF + EI + RETI + +;------------------------------------------------------------------------------ +RXA: +waitForChar: LD A,(serBufUsed) + CP $00 + JR Z, waitForChar + PUSH HL + LD HL,(serRdPtr) + INC HL + LD A,L ; Only need to check low byte becasuse buffer<256 bytes + CP (serBuf+SER_BUFSIZE) & $FF + JR NZ, notRdWrap + LD HL,serBuf +notRdWrap: DI + LD (serRdPtr),HL + LD A,(serBufUsed) + DEC A + LD (serBufUsed),A + CP SER_EMPTYSIZE + JR NC,rts1 + LD A,RTS_LOW + OUT ($80),A +rts1: + LD A,(HL) + EI + POP HL + RET ; Char ready in A + +;------------------------------------------------------------------------------ +TXA: PUSH AF ; Store character +conout1: IN A,($80) ; Status byte + BIT 1,A ; Set Zero flag if still transmitting character + JR Z,conout1 ; Loop until flag signals ready + POP AF ; Retrieve character + OUT ($81),A ; Output the character + RET + +;------------------------------------------------------------------------------ +CKINCHAR LD A,(serBufUsed) + CP $0 + RET + +PRINT: LD A,(HL) ; Get character + OR A ; Is it $00 ? + RET Z ; Then RETurn on terminator + RST 08H ; Print it + INC HL ; Next Character + JR PRINT ; Continue until $00 + RET +;------------------------------------------------------------------------------ +INIT: + LD HL,TEMPSTACK ; Temp stack + LD SP,HL ; Set up a temporary stack + LD HL,serBuf + LD (serInPtr),HL + LD (serRdPtr),HL + XOR A ;0 to accumulator + LD (serBufUsed),A + LD A,RTS_LOW + OUT ($80),A ; Initialise ACIA + IM 1 + EI + LD HL,SIGNON1 ; Sign-on message + CALL PRINT ; Output string + LD A,(basicStarted); Check the BASIC STARTED flag + CP 'Y' ; to see if this is power-up + JR NZ,COLDSTART ; If not BASIC started then always do cold start + LD HL,SIGNON2 ; Cold/warm message + CALL PRINT ; Output string +CORW: + CALL RXA + AND %11011111 ; lower to uppercase + CP 'C' + JR NZ, CHECKWARM + RST 08H + LD A,$0D + RST 08H + LD A,$0A + RST 08H +COLDSTART: LD A,'Y' ; Set the BASIC STARTED flag + LD (basicStarted),A + JP $0150 ; Start BASIC COLD +CHECKWARM: + CP 'W' + JR NZ, CORW + RST 08H + LD A,$0D + RST 08H + LD A,$0A + RST 08H + JP $0153 ; Start BASIC WARM + +SIGNON1: .BYTE CS + .BYTE "Z80 SBC By Grant Searle",CR,LF,0 +SIGNON2: .BYTE CR,LF + .BYTE "Cold or warm start (C or W)? ",0 + +.END diff --git a/new/bios.asm b/new/bios.asm new file mode 100644 index 0000000..5af0338 --- /dev/null +++ b/new/bios.asm @@ -0,0 +1,433 @@ +#target bin +#include "memory.inc" +#include "hardware.inc" +#include "bios.inc" + +CTC_BASE .equ 020h +CTC_CHANNEL_0 .equ CTC_BASE+000h +CTC_CHANNEL_1 .equ CTC_BASE+001h +CTC_CHANNEL_2 .equ CTC_BASE+002h +CTC_CHANNEL_3 .equ CTC_BASE+003h +UART_BASE .equ 024h +UART_CONTROL .equ UART_BASE+000h +UART_DATA .equ UART_BASE+001h + +BUF_SIZE .equ 16 +BUF_SIZE_MASK .equ 00fh + +WORKSPACE .equ SHARED_MEM_START+01000h +TX_HEAD .equ WORKSPACE+000h +TX_TAIL .equ WORKSPACE+001h +TX_COUNT .equ WORKSPACE+002h +RX_HEAD .equ WORKSPACE+003h +RX_TAIL .equ WORKSPACE+004h +RX_COUNT .equ WORKSPACE+005h +TX_BUSY .equ WORKSPACE+006h +TX_BUF .equ WORKSPACE+007h +RX_BUF .equ TX_BUF+BUF_SIZE + +; ------------------------------------------------------- +; entry +; ------------------------------------------------------- +#code BIOS_BOOT, ROM_START, (BIOS_ROM_START-ROM_START) +.org 00000h + jp boot_copy +.org 00008h +boot_copy: + ; copy bios to top 16k + di + ld a,BOOT_BANK_MAPPING + ld (SYSTEM_REGISTER),a + ld sp,BIOS_STACK_TOP + ld hl,BIOS_ROM_START + ld de,SHARED_MEM_START + ld bc,BIOS_size + ldir + jp init + +#code BIOS, SHARED_MEM_START +#assert BIOS_size <= BIOS_ROM_SIZE +; ------------------------------------------------------- +; Interrupt vector table +; ------------------------------------------------------- +.org SHARED_MEM_START+000h + jp init +.org SHARED_MEM_START+008h + reti +.org SHARED_MEM_START+010h + reti +.org SHARED_MEM_START+018h + reti +.org SHARED_MEM_START+020h + reti +.org SHARED_MEM_START+028h + reti +.org SHARED_MEM_START+030h + reti +.org SHARED_MEM_START+038h + reti +.org SHARED_MEM_START+040h + .dw ctc_isr + .dw ctc_isr + .dw ctc_isr + .dw uart_isr + +; ------------------------------------------------------- +; BIOS JUMP TABLE +; ------------------------------------------------------- +.org BIOS_PUTC + jp putc +.org BIOS_GETC + jp getc +.org BIOS_TRY_GETC + jp try_getc +.org BIOS_PUTS + jp puts + +; ------------------------------------------------------- +; BIOS ENTRY +; ------------------------------------------------------- +init: + di + ld sp,SHARED_MEM_END + ; Some im2 mode peripherals may still be 'in service' + ; force some irets to clear them + call release_daisy_chain + call release_daisy_chain + call release_daisy_chain + call release_daisy_chain + call release_daisy_chain + call release_daisy_chain + call release_daisy_chain + call release_daisy_chain + ; Setup interrupts + ld a,0c0h ; load interrupt table + ld i,a + im 2 + + ; Initialize tx and rx buffers + call buffers_init + ; Initialize peripherals + call ctc_uart_init + ei + + ; Print header message + ld hl,msg_header + call puts + + ; Shouldnt come here + ; just to be safe an endless loop +0$: + call getc + call putc + jr 0$ + +; ------------------------------------------------------- +; CTC interrupt +; ------------------------------------------------------- +ctc_isr: + ei + reti + +; ------------------------------------------------------- +; UART INTERRUPT +; ------------------------------------------------------- +uart_isr: + push af + push bc + push de + push hl + ; Load status byte + in a,(UART_CONTROL) + ld b,a + ; Check status for rx interrupt + ld a,b + and 021h + jr nz,3$ ; rx interrupt +101$: + ; Check status for tx interrupt + ld a,b + and 002h + jr nz,1$ ; tx interrupt +100$: + pop hl + pop de + pop bc + pop af + ei + reti + +1$: + ; tx interrupt, dequeue byte and transmit + ld a,(TX_BUSY) + cp 1 + jr nz,100$ ; not actively txing, return + ld a,(TX_COUNT) + cp 0 + jr z,2$ ; nothing to transmit + ; something in queue, dequeue + ld hl,TX_BUF + ld a,(TX_TAIL) + ld e,a + ld d,0 + add hl,de + ; hl contains tail of queue + ld a,(hl) + ld d,a + ; d contains data to transmit + ; do (tail+1)%BUF_SIZE + ld a,e + inc a + and BUF_SIZE_MASK + ld (TX_TAIL),a + ld hl,TX_COUNT ; decrease tx count + dec (hl) + ; transmit the byte + ld a,d + out (UART_DATA),a + jr 100$ +2$: + ; Queue is empty, stop tx interrupts + ld a,10010101b + out (UART_CONTROL),a + ; clear tx busy flag + ld a,0 + ld (TX_BUSY),a + jr 100$ +3$: + ; rx interrupt + in a,(UART_DATA) + ld c,a + ld a,b + and 001h ; check status bit 0 + jr z,101$ ; status bit 0 is clear, return + ld a,(RX_COUNT) + cp BUF_SIZE + jr z,101$ ; rx queue is full, return + ; enqueue byte + ld hl,RX_BUF + ld a,(RX_HEAD) + ld e,a + ld d,0 + add hl,de + ; hl contains head of queue + ld (hl),c + ; Do (head+1)%BUFSIZE + ld a,e + inc a + and BUF_SIZE_MASK + ld (RX_HEAD),a ; Increase rx count + ld hl,RX_COUNT + inc (hl) + jr 101$ + +; ------------------------------------------------------- +; Force IRET +; ------------------------------------------------------- +release_daisy_chain: + reti + +; ------------------------------------------------------- +; Initialize CTC and UART +; ------------------------------------------------------- +ctc_uart_init: + ; Reset CTC channels + ld a,003h + out (CTC_CHANNEL_0),a + out (CTC_CHANNEL_1),a + out (CTC_CHANNEL_2),a + out (CTC_CHANNEL_3),a + ; Reset UART + ld a,00000011b + out (UART_CONTROL),a + ; CTC channel 0 is timesource for uart + ld a,057h + out (CTC_CHANNEL_0),a + ld a,13 + out (CTC_CHANNEL_0),a + ; CTC channel 3 is interrupt source for handler + ld a,11001111b + out (CTC_CHANNEL_3),a + ld a ,1 + out (CTC_CHANNEL_3),a + ; set im2 vector for CTC + ld a,000h + out (CTC_CHANNEL_0),a + ld a,040h + out (CTC_CHANNEL_0),a + ; Initialise UART + ld a,10010101b + out (UART_CONTROL),a + ret + +; ------------------------------------------------------- +; Initialize TX and RX queues +; ------------------------------------------------------- +buffers_init: + ld a,00h + ld (TX_HEAD),a + ld (TX_TAIL),a + ld (TX_COUNT),a + ld (RX_HEAD),a + ld (RX_TAIL),a + ld (RX_COUNT),a + ld (TX_BUSY),a + ret + +; ------------------------------------------------------- +; Kick uart to start transmission +; uses a +; ------------------------------------------------------- +uart_kick: + di + push de + push hl + ld a,(TX_BUSY) + cp 0 + jr z,100$ ; not actively transmitting yet +1$: + pop hl + pop de + ei + ret +100$: + ld a,(TX_COUNT) + cp 0 + jr z,1$ ; tx queue empty, return + ld hl,TX_BUF + ld a,(TX_TAIL) + ld e,a + ld d,0 + add hl,de + ; hl contains tail of queue + ld a,(hl) + ld d,a + ; Do (tail+1)%BUFSIZE + ld a,e + inc a + and BUF_SIZE_MASK + ld (TX_TAIL),a + ld hl,TX_COUNT ; Decrement tx count + dec (hl) + ld a,1 ; set busy flag + ld (TX_BUSY),a + ; transmit actual data + ld a,d + out (UART_DATA),a + ; Enable tx interrupts + ld a,10110101b + out (UART_CONTROL),a + jr 1$ + +; ------------------------------------------------------- +; Write a byte to uart +; needs a (byte to tx) +; ------------------------------------------------------- +putc: + push de + push bc + push hl + ld c,a +100$: + di + ld b,0 + ld a,(TX_COUNT) + cp BUF_SIZE + jr z,1$ ; tx queue full, wait + ; enqueue data + ld hl,TX_BUF + ld a,(TX_HEAD) + ld e,a + ld d,0 + add hl,de + ; hl contains head of queue + ld (hl),c + ; Do (head+1)%BUF_SIZE + ld a,e + inc a + and BUF_SIZE_MASK + ld (TX_HEAD),a + ld hl,TX_COUNT ; Increment tx count + inc (hl) + ld b,1 ; set succeeded flag +1$: + ei + ld a,b + cp 1 ; Check if succeeded + jr z,2$ ; tx done, kick and return + ; not succeeded, try again + call uart_kick + jr 100$ +2$: + call uart_kick + pop hl + pop bc + pop de + ret + +; ------------------------------------------------------- +; Try to receive a byte +; returns a (byte) +; carry == not succeeded +; ------------------------------------------------------- +try_getc: + di + push bc + push de + push hl + ld a,(RX_COUNT) + cp 0 + jr z,1$ ; rx queue empty, return + ; dequeue + ld hl,RX_BUF + ld a,(RX_TAIL) + ld e,a + ld d,0 + add hl,de + ; hl contains tail of queue + ld a,(hl) + ld d,a + ; Do (tail+1)%BUF_SIZE + ld a,e + inc a + and BUF_SIZE_MASK + ld (RX_TAIL),a + ld hl,RX_COUNT ; decrement rx count + dec (hl) + ld a,d + or a,a ; clear carry +100$: + pop hl + pop de + pop bc + ei + ret +1$: + scf + jr 100$ + +; ------------------------------------------------------- +; Print a string +; needs hl (pointer to string) +; uses a +; ------------------------------------------------------- +puts: + ld a,(hl) + cp 0 + ret z ; encountered a 0, end of string + call putc + inc hl + jr puts + +; ------------------------------------------------------- +; Get a byte, block if unavailable +; ------------------------------------------------------- +getc: + call try_getc + jr c,getc + ret + +; ------------------------------------------------------- +; Strings +; ------------------------------------------------------- +msg_header: .db "BIOS v1.0 - Joppe Blondel",00dh,00ah,000h diff --git a/new/bios.inc b/new/bios.inc new file mode 100644 index 0000000..04bed92 --- /dev/null +++ b/new/bios.inc @@ -0,0 +1,4 @@ +BIOS_PUTC .equ 0c050h +BIOS_GETC .equ 0c053h +BIOS_TRY_GETC .equ 0c056h +BIOS_PUTS .equ 0c059h diff --git a/new/hardware.inc b/new/hardware.inc new file mode 100644 index 0000000..5c99aba --- /dev/null +++ b/new/hardware.inc @@ -0,0 +1,6 @@ +SYSTEM_REGISTER .equ 000h +BOOT_BANK_MAPPING .equ 006h +ROM_DISABLE_BIT .equ 001h +BANK_SELECT_BIT .equ 002h +BANK_ENABLE_BIT .equ 004h +BANK_MODE_CLEAR_MASK .equ 0f9h diff --git a/new/memory.inc b/new/memory.inc new file mode 100644 index 0000000..f2c6d7c --- /dev/null +++ b/new/memory.inc @@ -0,0 +1,14 @@ +ROM_START .equ 00000h +ROM_SIZE .equ 08000h +ROM_END .equ 07fffh +RAM_START .equ 08000h +RAM_SIZE .equ 08000h +RAM_END .equ 0ffffh + +SHARED_MEM_START .equ 0c000h +SHARED_MEM_SIZE .equ 04000h +SHARED_MEM_END .equ 0ffffh + +BIOS_STACK_TOP .equ SHARED_MEM_END +BIOS_ROM_START .equ ROM_START+0080h +BIOS_ROM_SIZE .equ 00f80h