From 51f466017c238a9a9f7e23485e5f25e603564158 Mon Sep 17 00:00:00 2001 From: Marco Maccaferri Date: Sun, 10 Feb 2019 08:48:48 +0100 Subject: [PATCH] Added default emulator rom and sources --- examples/BASIC.ASM | 4368 +++++++++++++++++++++++++ examples/MONITOR.ASM | 750 +++++ src/com/maccasoft/tools/Emulator.java | 54 +- src/com/maccasoft/tools/rom.bin | Bin 0 -> 16384 bytes 4 files changed, 5151 insertions(+), 21 deletions(-) create mode 100644 examples/BASIC.ASM create mode 100644 examples/MONITOR.ASM create mode 100644 src/com/maccasoft/tools/rom.bin diff --git a/examples/BASIC.ASM b/examples/BASIC.ASM new file mode 100644 index 0000000..4a3d578 --- /dev/null +++ b/examples/BASIC.ASM @@ -0,0 +1,4368 @@ +; ================================================================================== +; 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 4045H ; BASIC Work space +USR .EQU WRKSPC + 03H ; "USR (x)" jump +OUTSUB .EQU WRKSPC + 06H ; "OUT p,n" +OTPORT .EQU WRKSPC + 07H ; Port (p) +DIVSUP .EQU WRKSPC + 09H ; 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 + 03H ; 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 + 015DH ; 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 2000H + +COLD JP STARTB ; Jump for cold start +WARM JP WARMST ; Jump for warm start +STARTB + LD IX, 00H ; 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 + 03H ; 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 + 48H + 01H), 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, 0D9H ; 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 - 01H ; See if enough RAM + ;CALL CPDEHL ; Compare DE with HL + ;JP C, MSIZE ; Ask again if not enough RAM + LD DE, 00H - 32H ; 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, 00H - 11H ; 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 + .BYTE CR, LF, 00H, 00H + +SIGNON .BYTE "Z80 BASIC Ver 4.7b", CR, LF + .BYTE "Copyright (C)" + .BYTE " 1978 by Microsoft", CR, LF + .BYTE CR, LF, 00H, 00H + +;MEMMSG .BYTE "Memory top", 00H + +; 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 SCREEN + .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 80H ; END +ZFOR .EQU 81H ; FOR +ZDATA .EQU 83H ; DATA +ZGOTO .EQU 88H ; GOTO +ZGOSUB .EQU 8CH ; GOSUB +ZREM .EQU 8EH ; REM +ZPRINT .EQU 9EH ; 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 + 02H ; 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 (00H), A ; "OUT p,n" skeleton + RET + SUB 00H ; Division support routine + LD L, A + LD A, H + SBC A, 00H + LD H, A + LD A, B + SBC A, 00H + LD B, A + LD A, 00H + RET + .BYTE 00H, 00H, 00H ; Random number seed table used by RND + .BYTE 35H, 4AH, 0CAH, 99H ; -2.65145E+07 + .BYTE 39H, 1CH, 76H, 98H ; 1.61291E+07 + .BYTE 22H, 95H, 0B3H, 98H ; -1.17691E+07 + .BYTE 0AH, 0DDH, 47H, 98H ; 1.30983E+07 + .BYTE 53H, 0D1H, 99H, 99H ; -2-01612E+07 + .BYTE 0AH, 1AH, 9FH, 98H ; -1.04269E+07 + .BYTE 65H, 0BCH, 0CDH, 98H ; -1.34831E+07 + .BYTE 0D6H, 77H, 3EH, 98H ; 1.24825E+07 + .BYTE 52H, 0C7H, 4FH, 80H ; Last random number + IN A, (00H) ; INP (x) skeleton + RET + .BYTE 01H ; POS (x) number (1) + .BYTE 0FFH ; Terminal width (255 = no auto CRLF) + .BYTE 1CH ; Width for commas (3 columns) + .BYTE 00H ; No nulls after input bytes + .BYTE 00H ; Output enabled (^O off) + .WORD 14H ; Initial lines counter + .WORD 14H ; Initial lines number + .WORD 00H ; Array load/save check sum + .BYTE 00H ; Break not by NMI + .BYTE 00H ; Break flag + JP TTYLIN ; Input reflection (set to TTY) + JP 00H ; POINT reflection unused + JP 00H ; SET reflection + JP 00H ; RESET reflection + .WORD STLOOK ; Temp string space + .WORD -02H ; Current line number (cold) + .WORD PROGST + 01H ; 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, 04H ; 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, 10H - 03H ; 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, 00H ; 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, -02H ; 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, -01H ; 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, 02H + 03H ; 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 3CH ; ";"+1 ; Is it "0123456789:;" ? + JP C, MOVDIR ; Yes - copy it direct +FNDWRD PUSH DE ; Look for reserved words + LD DE, WORDS - 01H ; Point to table + PUSH BC ; Save count + LD BC, RETNAD ; Where to return to + PUSH BC ; Save return address + LD B, ZEND - 01H ; First token value -1 + LD A, (HL) ; Get byte + CP 'a' ; Less than 'a' ? + JP C, SEARCH ; Yes - search for words + CP 'z' + 01H ; Greater than 'z' ? + JP NC, SEARCH ; Yes - search for words + AND 5FH ; 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 7FH ; 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 5FH ; 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 - 01H ; 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, 00H ; 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, 01H ; 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, 00H ; 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), 00H ; 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 48H + 01H ; 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 7FH ; 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 - 01H ; 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 7FH ; 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, -01H + 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, 02H ; 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, 08H + 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, 01H ; 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 + 01H - 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, 00H + 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, 0FFH ; 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 0FFH ; 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, 00H ; 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' + 01H ; > '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 + 10H ; Exponent in range (16 bits)? + JP C, FPINT ; Yes - convert it + LD BC, 9080H ; BCDE = -32768 + LD DE, 00H + 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, 00H ; 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, 0FFF9H / 0AH ; 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, 00H + 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 + CALL GETNUM ; Get integer 0 to 65536 + CALL DEINT + 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, 28H ; 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, 03H ; 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, -01H ; 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, 00H ; 00 End of statement + LD B, 00H +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 3BH ; ";" ; 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), 00H ; Mark end of buffer + LD HL, BUFFER - 01H ; 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 0EH ; 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, 00H + +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, 00H ; 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, 00H + +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, 00H ; 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, 00H ; Precedence value +EVAL1 PUSH DE ; Save precedence + LD C, 01H + 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, 00H ; Clear Last relation +RLTLP SUB ZGTR ; ">" Token + JP C, FOPRND ; + - * / ^ AND OR - Test it + CP ZLTH + 01H - 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 + 01H - 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, 00H ; 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 02H * (ZLEFT - ZSGN) - 01H ; 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 01H + 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, -01H ; 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, 06H ; 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), 00H ; 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, 00H ; 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, 04H ; 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, 0AH + 01H ; 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), 00H ; 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, 00H ; 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, 00H + LD HL, TYPE ; Point to type + LD (HL), E ; Set type to numeric + LD B, 80H + 10H ; 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 + 02H) ; 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 + 02H), 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, -01H ; 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, 01H + 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, -01H ; 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, 00H + 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, 00H + 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, 00H + 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 + 02H) ; 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, 01H ; One character string + CALL MKTMST ; Make a temporary string + CALL MAKINT ; Make it integer A + LD HL, (TMPSTR + 02H) ; 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, 00H ; 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, 00H ; 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, 0FFH ; 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, 00H ; 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, 00H ; 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 18H + 01H ; 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, 01H ; 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 08H ; Count 8 bits + CP -18H - 08H ; 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 80H ; 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, 00H ; Clear underflow +SCALLP SUB 08H ; 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, 00H ; <- bits + JP SCALLP ; More bits to shift + +SHRITE ADD A, 08H + 01H ; 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 00H, 00H, 00H, 81H ; 1.00000 + +LOGTAB .BYTE 03H ; Table used by LOG + .BYTE 0AAH, 56H, 19H, 80H ; 0.59898 + .BYTE 0F1H, 22H, 76H, 80H ; 0.96147 + .BYTE 45H, 0AAH, 38H, 82H ; 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, 00H + 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, 00H ; 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 + 01H), HL ; Save rest of multiplier + LD BC, 00H ; 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, 08H ; 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 + 01H) ; 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, 00H + 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, -01H ; 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, 00H ; 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, 02H ; 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 + 02H) ; 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 + 08H ; 8 bit integer in exponent + LD DE, 00H ; 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, 00H ; 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 + 02H ; 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 + 02H) ; 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 + 02H), 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, 04H ; 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 + 02H ; 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 + 02H ; 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 + 18H ; 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, 00H ; 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 + 18H ; 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 + 18H ; 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, 00H ; Clear partial product + LD A, B ; Test multiplier + OR C + RET Z ; Return zero if zero + LD A, 10H ; 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 + 18H ; 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 06H + 01H + 01H ; 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, 02H ; 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' - 01H ; 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' - 01H ; ASCII '0' - 1 +EXPTEN INC B ; Count subtractions + SUB 0AH ; Tens digit + JP NC, EXPTEN ; More to do + ADD A, '0' + 0AH ; 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, 86H, 01H ; 100000 + .BYTE 10H, 27H, 00H ; 10000 + .BYTE 0E8H, 03H, 00H ; 1000 + .BYTE 64H, 00H, 00H ; 100 + .BYTE 0AH, 00H, 00H ; 10 + .BYTE 01H, 00H, 00H ; 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 7FH ; 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 + 02H), 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, 8138H ; BCDE = 1/Ln(2) + LD DE, 0AA3BH + CALL FPMULT ; Multiply value by 1/LN(2) + LD A, (FPEXP) ; Get exponent + CP 80H + 08H ; 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, 02H ; 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, 00H ; Zero LSBs + POP BC ; Scaling factor + LD C, D ; Zero MSB + JP FPMULT ; Scale result to correct value + +EXPTAB .BYTE 08H ; Table used by EXP + .BYTE 40H, 2EH, 94H, 74H ; -1/7! (-1/5040) + .BYTE 70H, 4FH, 2EH, 77H ; 1/6! ( 1/720) + .BYTE 6EH, 02H, 88H, 7AH ; -1/5! (-1/120) + .BYTE 0E6H, 0A0H, 2AH, 7CH ; 1/4! ( 1/24) + .BYTE 50H, 0AAH, 0AAH, 7EH ; -1/3! (-1/6) + .BYTE 0FFH, 0FFH, 7FH, 7FH ; 1/2! ( 1/2) + .BYTE 00H, 00H, 80H, 81H ; -1/1! (-1/1) + .BYTE 00H, 00H, 00H, 81H ; 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 + 02H ; 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 + 02H ; Random number seed + RET Z ; Return if RND(0) + ADD A, (HL) ; Add (SEED)+2) + AND 07H ; 0 to 7 + LD B, 00H + 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 + 01H) ; Get (SEED+1) + INC A ; Add 1 + AND 03H ; 0 to 3 + LD B, 00H + CP 01H ; Is it zero? + ADC A, B ; Yes - Make it 1 + LD (SEED + 01H), A ; Re-save seed + LD HL, RNDTAB - 04H ; 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 4FH ; 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 0ABH ; 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 68H, 0B1H, 46H, 68H ; Table used by RND + .BYTE 99H, 0E9H, 92H, 69H + .BYTE 10H, 0D1H, 75H, 68H + +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, 0FH, 49H, 81H ; 1.5708 (PI/2) + +QUARTR .BYTE 00H, 00H, 00H, 7FH ; 0.25 + +SINTAB .BYTE 05H ; Table used by SIN + .BYTE 0BAH, 0D7H, 1EH, 86H ; 39.711 + .BYTE 64H, 26H, 99H, 87H ; -76.575 + .BYTE 58H, 34H, 23H, 87H ; 81.602 + .BYTE 0E0H, 5DH, 0A5H, 86H ; -41.342 + .BYTE 0DAH, 0FH, 49H, 83H ; 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 09H ; Table used by ATN + .BYTE 4AH, 0D7H, 3BH, 78H ; 1/17 + .BYTE 02H, 6EH, 84H, 7BH ; -1/15 + .BYTE 0FEH, 0C1H, 2FH, 7CH ; 1/13 + .BYTE 74H, 31H, 9AH, 7DH ; -1/11 + .BYTE 84H, 3DH, 5AH, 7DH ; 1/9 + .BYTE 0C8H, 7FH, 91H, 7EH ; -1/7 + .BYTE 0E4H, 0BBH, 4CH, 7EH ; 1/5 + .BYTE 6CH, 0AAH, 0AAH, 7FH ; -1/3 + .BYTE 00H, 00H, 00H, 81H ; 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 00H + 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 00H + 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 0FH ; Strip off upper nybble + CP 0AH ; 0-9? + JR C, ADD30 ; If A-F, add 7 more + ADD A, 07H ; Bring value up to ASCII A-F +ADD30 ADD A, 30H ; 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 0FH ; Mask off upper nybble + CP 0AH ; 0-9? < A hex? + JR C, ADD301 ; Skip Add 7 + ADD A, 07H ; Bring it up to ASCII A-F +ADD301 ADD A, 30H ; 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, 00H ; 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 30H ; Get absolute value + RET C ; < "0", error + CP 0AH + JR C, NOSUB7 ; Is already in the range 0-9 + SUB 07H ; Reduce to A-F + CP 0AH ; Value should be $0A-$0F at this point + RET C ; CY set if was : ; < = > ? @ +NOSUB7 CP 10H ; > 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, 11H ; One higher than max char count +ZEROSUP ; Suppress leading zeros + DEC B ; Max 16 chars + LD A, B + CP 01H + 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, 00H ; 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, 00H ; 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 + +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 + LD C, A ; Row to C + PUSH HL ; Save code string address + PUSH BC + LD A, 1BH + CALL MONOUT + LD A, '[' + CALL MONOUT + POP HL ; Row and column to HL + PUSH HL + LD H, 0 + CALL PRNTHL ; Output row + LD A, ';' + CALL MONOUT + POP HL + LD L, H + LD H, 0 + CALL PRNTHL ; Output column + LD A, 'H' + CALL MONOUT + POP HL ; Restore code string address + RET + +JJUMP1 + LD IX, -01H ; Flag cold start + JP CSTART ; Go and initialise + +MONOUT + JP 08H ; output a char + +MONITR + JP 00H ; Restart (Normally Monitor Start) + +INITST LD A, 00H ; 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, 00H ; Return 0 in A + RET + +OUTNCR CALL OUTC ; Output character in A + JP PRNTCRLF ; Output CRLF + + .END diff --git a/examples/MONITOR.ASM b/examples/MONITOR.ASM new file mode 100644 index 0000000..bf02c56 --- /dev/null +++ b/examples/MONITOR.ASM @@ -0,0 +1,750 @@ +;================================================================================== +; Contents of this file are copyright Grant Searle +; HEX routines from Joel Owens. +; +; 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. +; +;================================================================================== + +;------------------------------------------------------------------------------ +; +; Z80 Monitor Rom +; +;------------------------------------------------------------------------------ +; General Equates +;------------------------------------------------------------------------------ + +CR .EQU 0DH +LF .EQU 0AH +ESC .EQU 1BH +CTRLC .EQU 03H +CLS .EQU 0CH + +; CF registers +CF_DATA .EQU 10H +CF_FEATURES .EQU 11H +CF_ERROR .EQU 11H +CF_SECCOUNT .EQU 12H +CF_SECTOR .EQU 13H +CF_CYL_LOW .EQU 14H +CF_CYL_HI .EQU 15H +CF_HEAD .EQU 16H +CF_STATUS .EQU 17H +CF_COMMAND .EQU 17H +CF_LBA0 .EQU 13H +CF_LBA1 .EQU 14H +CF_LBA2 .EQU 15H +CF_LBA3 .EQU 16H + +;CF Features +CF_8BIT .EQU 1 +CF_NOCACHE .EQU 82H +;CF Commands +CF_READ_SEC .EQU 20H +CF_WRITE_SEC .EQU 30H +CF_SET_FEAT .EQU 0EFH + +;BASIC cold and warm entry points +BASCLD .EQU 2000H +BASWRM .EQU 2003H + +LOADADDR .EQU 0D000H ; CP/M load address +NUMSECS .EQU 24 ; Number of 512 sectors to be loaded + +SIOA_D .EQU 81H +SIOA_C .EQU 80H +SIOB_D .EQU 83H +SIOB_C .EQU 82H + +;------------------------------------------------------------------------------ +; START OF MONITOR ROM +;------------------------------------------------------------------------------ + + .ORG 00H ; MONITOR ROM RESET VECTOR + +;------------------------------------------------------------------------------ +; Reset +;------------------------------------------------------------------------------ + +RST00 DI ; Disable INTerrupts + JP INIT ; Initialize Hardware and go + NOP + NOP + NOP + NOP + +;------------------------------------------------------------------------------ +; TX a character over RS232 wait for TXDONE first. +;------------------------------------------------------------------------------ + +RST08 JP CONOUT + NOP + NOP + NOP + NOP + NOP + +;------------------------------------------------------------------------------ +; RX a character from buffer wait until char ready. +;------------------------------------------------------------------------------ + +RST10 JP CONIN + NOP + NOP + NOP + NOP + NOP + +;------------------------------------------------------------------------------ +; Check input buffer status +;------------------------------------------------------------------------------ + +RST18 JP CKINCHAR + NOP + NOP + NOP + NOP + NOP + +;------------------------------------------------------------------------------ +; Interrupt vector +;------------------------------------------------------------------------------ + + .ORG 38H + + RETI + NOP + NOP + NOP + NOP + NOP + NOP + +;------------------------------------------------------------------------------ +; Console input routine +; Use the "primaryIO" flag to determine which input port to monitor. +;------------------------------------------------------------------------------ + +CONIN + LD A, (PRIMARYIO) + CP 00H + JR NZ, CONINB + +CONINA + XOR A + OUT (SIOA_C), A +WAITINA IN A, (SIOA_C) ; Status byte D2=TX Buff Empty, D0=RX char ready + AND 01H ; Rotates RX status into Carry Flag, + JR Z, WAITINA + IN A, (SIOA_D) + RET ; Char ready in A + +CONINB + XOR A + OUT (SIOB_C), A +WAITINB IN A, (SIOB_C) ; Status byte D2=TX Buff Empty, D0=RX char ready + AND 01H ; Rotates RX status into Carry Flag, + JR Z, WAITINB + IN A, (SIOB_D) + RET ; Char ready in A + +;------------------------------------------------------------------------------ +; Console output routine +; Use the "primaryIO" flag to determine which output port to send a character. +;------------------------------------------------------------------------------ + +CONOUT + PUSH AF ; Store character + LD A, (PRIMARYIO) + CP 00H + JR NZ, CONOUTB1 + JR CONOUTA1 + +CONOUTA + PUSH AF +CONOUTA1 XOR A ; See if SIO channel A is finished transmitting + OUT (SIOA_C), A +WAITOUTA IN A, (SIOA_C) ; Status byte D2=TX Buff Empty, D0=RX char ready + AND 04H + JR Z, WAITOUTA ; Loop until SIO flag signals ready + POP AF ; RETrieve character + OUT (SIOA_D), A ; OUTput the character + RET + +CONOUTB + PUSH AF +CONOUTB1 XOR A ; See if SIO channel B is finished transmitting + OUT (SIOB_C), A +WAITOUTB IN A, (SIOB_C) ; Status byte D2=TX Buff Empty, D0=RX char ready + AND 04H + JR Z, WAITOUTB ; Loop until SIO flag signals ready + POP AF ; RETrieve character + OUT (SIOB_D), A ; OUTput the character + RET + +;------------------------------------------------------------------------------ +; Check if there is a character in the input buffer +; Use the "primaryIO" flag to determine which port to check. +;------------------------------------------------------------------------------ + +CKINCHAR + LD A, (PRIMARYIO) + CP 00H + JR NZ, CKINCHARB + +CKINCHARA XOR A ; See if SIO channel A is finished transmitting + OUT (SIOA_C), A + IN A, (SIOA_C) ; Status byte D2=TX Buff Empty, D0=RX char ready + AND 01H + RET + +CKINCHARB XOR A + OUT (SIOB_C), A + IN A, (SIOB_C) ; Status byte D2=TX Buff Empty, D0=RX char ready + AND 01H + RET + +;------------------------------------------------------------------------------ +; Filtered Character I/O +;------------------------------------------------------------------------------ + +RDCHR + RST 10H + CP LF + JR Z, RDCHR ; Ignore LF + CP ESC + JR NZ, RDCHR1 + LD A, CTRLC ; Change ESC to CTRL-C +RDCHR1 RET + +WRCHR CP CR + JR Z, WRCRLF ; When CR, write CRLF + CP CLS + JR Z, WR ; Allow write of "CLS" + CP ' ' ; Don't write out any other control codes + JR C, NOWR ; ie. < space +WR RST 08H +NOWR RET + +WRCRLF LD A, CR + RST 08H + LD A, LF + RST 08H + LD A, CR + RET + +;------------------------------------------------------------------------------ +; Initialise hardware and start main loop +;------------------------------------------------------------------------------ +INIT + LD SP, STACK ; Set the Stack Pointer + + ; Initialise SIO A + + LD A, 00H + OUT (SIOA_C), A + LD A, 18H + OUT (SIOA_C), A + + LD A, 04H + OUT (SIOA_C), A + LD A, 0C4H + OUT (SIOA_C), A + + LD A, 01H + OUT (SIOA_C), A + LD A, 00H + OUT (SIOA_C), A + + LD A, 03H + OUT (SIOA_C), A + LD A, 0E1H + OUT (SIOA_C), A + + LD A, 05H + OUT (SIOA_C), A + LD A, 0EAH + OUT (SIOA_C), A + + ; Initialise SIO B + + LD A, 00H + OUT (SIOB_C), A + LD A, 18H + OUT (SIOB_C), A + + LD A, 04H + OUT (SIOB_C), A + LD A, 0C4H + OUT (SIOB_C), A + + LD A, 01H + OUT (SIOB_C), A + LD A, 00H + OUT (SIOB_C), A + + LD A, 02H + OUT (SIOB_C), A + LD A, 00H + OUT (SIOB_C), A + + LD A, 03H + OUT (SIOB_C), A + LD A, 0E1H + OUT (SIOB_C), A + + LD A, 05H + OUT (SIOB_C), A + LD A, 0EAH + OUT (SIOB_C), A + + ; Set primary console and clear screen + + LD A, 00H + LD (PRIMARYIO), A + LD A, CLS + RST 08H + +;------------------------------------------------------------------------------ +; Monitor +;------------------------------------------------------------------------------ + + CALL TXCRLF ; TXCRLF + LD HL, SIGNON ; Print SIGNON message + CALL PRINT + + ; Command loop + +MAIN + LD HL, MAIN ; Save entry point for Monitor + PUSH HL ; This is the return address +MAIN0 CALL TXCRLF ; Entry point for Monitor, Normal + LD A, '>' ; Get a ">" + RST 08H ; print it + +MAIN1 CALL RDCHR ; Get a character from the input port + CP ' ' ; or less? + JR C, MAIN1 ; Go back + + CP ':' ; ":"? + JP Z, LOAD ; First character of a HEX load + + CALL WRCHR ; Print char on console + + CP '?' + JP Z, HELP + + AND 5FH ; Make character uppercase + + CP 'R' + JP Z, RST00 + + CP 'B' + JP Z, BASIC + + CP 'G' + JP Z, GOTO + + CP 'X' + JP Z, CPMLOAD + + LD A, '?' ; Get a "?" + RST 08H ; Print it + JR MAIN0 + +;------------------------------------------------------------------------------ +; Print string of characters to Serial A until byte=$00, WITH CR, LF +;------------------------------------------------------------------------------ + +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 + +TXCRLF + LD A, 0DH ; + RST 08H ; Print character + LD A, 0AH ; + RST 08H ; Print character + RET + +;------------------------------------------------------------------------------ +; Get a character from the console, must be $20-$7F to be valid (no control characters) +; and breaks with the Zero Flag set +;------------------------------------------------------------------------------ + +GETCHR + CALL RDCHR ; RX a Character + CP 03H ; User break? + RET Z + CP 20H ; or better? + JR C, GETCHR ; Do it again until we get something usable + RET + +;------------------------------------------------------------------------------ +; Gets two ASCII characters from the console (assuming them to be HEX 0-9 A-F) +; Moves them into B and C, converts them into a byte value in A and updates a +; Checksum value in E +;------------------------------------------------------------------------------ + +GET2 + CALL GETCHR ; Get us a valid character to work with + LD B, A ; Load it in B + CALL GETCHR ; Get us another character + LD C, A ; load it in C + CALL BCTOA ; Convert ASCII to byte + LD C, A ; Build the checksum + LD A, E + SUB C ; The checksum should always equal zero when checked + LD E, A ; Save the checksum back where it came from + LD A, C ; Retrieve the byte and go back + RET + +;------------------------------------------------------------------------------ +; Gets four Hex characters from the console, converts them to values in HL +;------------------------------------------------------------------------------ + +GETHL + LD HL, 00H ; Gets xxxx but sets Carry Flag on any Terminator + CALL ECHO ; RX a Character + CP 0DH ; ? + JR NZ, GETX2 ; other key +SETCY SCF ; Set Carry Flag + RET ; and Return to main program + +;------------------------------------------------------------------------------ +; This routine converts last four hex characters (0-9 A-F) user types into a value in HL +; Rotates the old out and replaces with the new until the user hits a terminating character +;------------------------------------------------------------------------------ + +GETX + LD HL, 00H ; CLEAR HL +GETX1 CALL ECHO ; RX a character from the console + CP 0DH ; + RET Z ; quit + CP 2CH ; <,> can be used to safely quit for multiple entries + RET Z ; (Like filling both DE and HL from the user) +GETX2 CP 03H ; Likewise, a will terminate clean, too, but + JR Z, SETCY ; It also sets the Carry Flag for testing later. + ADD HL, HL ; Otherwise, rotate the previous low nibble to high + ADD HL, HL ; rather slowly + ADD HL, HL ; until we get to the top + ADD HL, HL ; and then we can continue on. + SUB 30H ; Convert ASCII to byte value + CP 0AH ; Are we in the 0-9 range? + JR C, GETX3 ; Then we just need to sub $30, but if it is A-F + SUB 07H ; We need to take off 7 more to get the value down to +GETX3 AND 0FH ; to the right hex value + ADD A, L ; Add the high nibble to the low + LD L, A ; Move the byte back to A + JR GETX1 ; and go back for next character until he terminates + +;------------------------------------------------------------------------------ +; Convert ASCII characters in B C registers to a byte value in A +;------------------------------------------------------------------------------ + +BCTOA LD A, B ; Move the hi order byte to A + SUB 30H ; Take it down from Ascii + CP 0AH ; Are we in the 0-9 range here? + JR C, BCTOA1 ; If so, get the next nybble + SUB 07H ; But if A-F, take it down some more +BCTOA1 RLCA ; Rotate the nybble from low to high + RLCA ; One bit at a time + RLCA ; Until we + RLCA ; Get there with it + LD B, A ; Save the converted high nybble + LD A, C ; Now get the low order byte + SUB 30H ; Convert it down from Ascii + CP 0AH ; 0-9 at this point? + JR C, BCTOA2 ; Good enough then, but + SUB 07H ; Take off 7 more if it's A-F +BCTOA2 ADD A, B ; Add in the high order nybble + RET + +;------------------------------------------------------------------------------ +; Get a character and echo it back to the user +;------------------------------------------------------------------------------ + +ECHO + CALL RDCHR + CALL WRCHR + RET + +;------------------------------------------------------------------------------ +; GOTO command +;------------------------------------------------------------------------------ + +GOTO + CALL GETHL ; ENTRY POINT FOR oto addr. Get XXXX from user. + RET C ; Return if invalid + LD A, (PRIMARYIO) + PUSH HL + RET ; Jump to HL address value + +;------------------------------------------------------------------------------ +; LOAD Intel Hex format file from the console. +; [Intel Hex Format is: +; 1) Colon (Frame 0) +; 2) Record Length Field (Frames 1 and 2) +; 3) Load Address Field (Frames 3,4,5,6) +; 4) Record Type Field (Frames 7 and 8) +; 5) Data Field (Frames 9 to 9+2*(Record Length)-1 +; 6) Checksum Field - Sum of all byte values from Record Length to and +; including Checksum Field = 0 ] +;------------------------------------------------------------------------------ + +LOAD + LD E, 0 ; First two Characters is the Record Length Field + CALL GET2 ; Get us two characters into BC, convert it to a byte + LD D, A ; Load Record Length count into D + CALL GET2 ; Get next two characters, Memory Load Address + LD H, A ; put value in H register. + CALL GET2 ; Get next two characters, Memory Load Address + LD L, A ; put value in L register. + CALL GET2 ; Get next two characters, Record Field Type + CP 01H ; Record Field Type 00 is Data, 01 is End of File + JR NZ, LOAD2 ; Must be the end of that file + CALL GET2 ; Get next two characters, assemble into byte + LD A, E ; Recall the Checksum byte + AND A ; Is it Zero? + JR Z, LOAD00 ; Print footer reached message + JR LOADERR ; Checksums don't add up, Error out + +LOAD2 LD A, D ; Retrieve line character counter + AND A ; Are we done with this line? + JR Z, LOAD3 ; Get two more ascii characters, build a byte and checksum + CALL GET2 ; Get next two chars, convert to byte in A, checksum it + LD (HL), A ; Move converted byte in A to memory location + INC HL ; Increment pointer to next memory location + LD A, '.' ; Print out a "." for every byte loaded + RST 08H ; + DEC D ; Decrement line character counter + JR LOAD2 ; and keep loading into memory until line is complete + +LOAD3 CALL GET2 ; Get two chars, build byte and checksum + LD A, E ; Check the checksum value + AND A ; Is it zero? + RET Z + +LOADERR LD HL, CKSUMERR ; Get "Checksum Error" message + CALL PRINT ; Print Message from (HL) and terminate the load + RET + +LOAD00 LD HL, LDETXT ; Print load complete message + CALL PRINT + RET + +;------------------------------------------------------------------------------ +; Display Help command +;------------------------------------------------------------------------------ + +HELP + LD HL, HLPTXT ; Print Help message + CALL PRINT + RET + +;------------------------------------------------------------------------------ +; Start BASIC command +;------------------------------------------------------------------------------ + +BASIC + LD HL, BASTXT + CALL PRINT + CALL GETCHR + RET Z ; Cancel if CTRL-C + AND 5FH ; uppercase + CP 'C' + JP Z, BAS1 + CP 'W' + JP Z, BAS2 + RET + +BASTXT + .BYTE 0DH, 0AH + .TEXT "Cold or Warm ?" + .BYTE 00H + +BAS1 LD A, CLS + RST 08 + JP BASCLD + +BAS2 CALL TXCRLF + CALL TXCRLF + JP BASWRM + +;------------------------------------------------------------------------------ +; CP/M load command +;------------------------------------------------------------------------------ + +CPMLOAD + LD HL, CPMTXT + CALL PRINT + CALL GETCHR + RET Z ; Cancel if CTRL-C + AND 5FH ; uppercase + CP 'Y' + JP Z, CPMLOAD2 + RET + +CPMTXT .BYTE 0DH, 0AH + .TEXT "Boot CP/M?" + .BYTE 00H + +CPMTXT2 .BYTE 0DH, 0AH + .TEXT "Loading CP/M..." + .BYTE 0DH, 0AH, 00H + +CPMLOAD2 + LD HL, CPMTXT2 + CALL PRINT + + CALL CFWAIT + LD A, CF_8BIT ; Set IDE to be 8bit + OUT (CF_FEATURES), A + LD A, CF_SET_FEAT + OUT (CF_COMMAND), A + + CALL CFWAIT + LD A, CF_NOCACHE ; No write cache + OUT (CF_FEATURES), A + LD A, CF_SET_FEAT + OUT (CF_COMMAND), A + + LD B, NUMSECS + + LD A, 0 + LD (SECNO), A + LD HL, LOADADDR + LD (DMAADDR), HL + +PROCESSSECTORS + CALL CFWAIT + + LD A, (SECNO) + OUT (CF_LBA0), A + LD A, 0 + OUT (CF_LBA1), A + OUT (CF_LBA2), A + LD A, 0E0H + OUT (CF_LBA3), A + LD A, 1 + OUT (CF_SECCOUNT), A + + CALL READ + + LD DE, 0200H + LD HL, (DMAADDR) + ADD HL, DE + LD (DMAADDR), HL + LD A, (SECNO) + INC A + LD (SECNO), A + + DJNZ PROCESSSECTORS + +; Start CP/M using entry at top of BIOS +; The current active console stream ID is pushed onto the stack +; to allow the CBIOS to pick it up +; 0 = SIO A, 1 = SIO B + + LD A, (PRIMARYIO) + LD HL, (0FFFEH) + JP (HL) + +;------------------------------------------------------------------------------ + +; Read physical sector from host + +READ + PUSH AF + PUSH BC + PUSH HL + + CALL CFWAIT + + LD A, CF_READ_SEC + OUT (CF_COMMAND), A + + CALL CFWAIT + + LD C, 4 + LD HL, (DMAADDR) +RD4SECS + LD B, 128 +RDBYTE + NOP + NOP + IN A, (CF_DATA) + LD (HL), A + INC HL + DEC B + JR NZ, RDBYTE + DEC C + JR NZ, RD4SECS + + POP HL + POP BC + POP AF + + RET + + +; Wait for disk to be ready (busy=0,ready=1) + +CFWAIT +TSTBUSY IN A, (CF_STATUS) + AND 80H + JR NZ, TSTBUSY +TSTREADY IN A, (CF_STATUS) + AND 40H + JR Z, TSTREADY + RET + +;------------------------------------------------------------------------------ + +SIGNON .BYTE "Z80 SBC Boot ROM 1.1" + .BYTE " by G. Searle" + .BYTE 0DH, 0AH + .BYTE "Type ? for options" + .BYTE 0DH, 0AH, 00H + +CKSUMERR .BYTE "Checksum error" + .BYTE 0DH, 0AH, 00H + +LDETXT .TEXT "Load complete." + .BYTE 0DH, 0AH, 00H + +HLPTXT .BYTE 0DH, 0AH + .TEXT "R - Reset" + .BYTE 0DH, 0AH + .TEXT "BC or BW - ROM BASIC Cold or Warm" + .BYTE 0DH, 0AH + .TEXT "X - Boot CP/M (load $D000-$FFFF from disk)" + .BYTE 0DH, 0AH + .TEXT ":nnnnnn... - Load Intel-Hex file record" + .BYTE 0DH, 0AH + .BYTE 00H + +;------------------------------------------------------------------------------ + + .ORG 4000H + +PRIMARYIO .DS 1 +SECNO .DS 1 +DMAADDR .DS 2 + +STACKSPACE .DS 32 +STACK .EQU $ ; Stack top + + .END diff --git a/src/com/maccasoft/tools/Emulator.java b/src/com/maccasoft/tools/Emulator.java index e115314..f32735a 100644 --- a/src/com/maccasoft/tools/Emulator.java +++ b/src/com/maccasoft/tools/Emulator.java @@ -13,6 +13,7 @@ package com.maccasoft.tools; import java.io.File; import java.io.FileInputStream; import java.io.IOException; +import java.io.InputStream; import java.io.InputStreamReader; import java.io.PipedInputStream; import java.io.PipedOutputStream; @@ -121,30 +122,41 @@ public class Emulator { @Override protected void run() { try { - String s = preferences.getRomImage1(); - if (s != null && !"".equals(s)) { - if (s.toUpperCase().endsWith(".ASM")) { - byte[] rom = compile(new File(s)); - if (rom == null) { - return; - } - machine.setRom(preferences.getRomAddress1(), rom); - } - else { - machine.setRom(preferences.getRomAddress1(), new File(s)); - } + String s1 = preferences.getRomImage1(); + String s2 = preferences.getRomImage2(); + + if ((s1 == null || "".equals(s1)) && (s2 == null || "".equals(s2))) { + InputStream is = Emulator.class.getResourceAsStream("rom.bin"); + byte[] rom = new byte[is.available()]; + is.read(rom); + is.close(); + machine.setRom(0, rom); } - s = preferences.getRomImage2(); - if (s != null && !"".equals(s)) { - if (s.toUpperCase().endsWith(".ASM")) { - byte[] rom = compile(new File(s)); - if (rom == null) { - return; + else { + if (s1 != null && !"".equals(s1)) { + if (s1.toUpperCase().endsWith(".ASM")) { + byte[] rom = compile(new File(s1)); + if (rom == null) { + return; + } + machine.setRom(preferences.getRomAddress1(), rom); + } + else { + machine.setRom(preferences.getRomAddress1(), new File(s1)); } - machine.setRom(preferences.getRomAddress2(), rom); } - else { - machine.setRom(preferences.getRomAddress2(), new File(s)); + + if (s2 != null && !"".equals(s2)) { + if (s2.toUpperCase().endsWith(".ASM")) { + byte[] rom = compile(new File(s2)); + if (rom == null) { + return; + } + machine.setRom(preferences.getRomAddress2(), rom); + } + else { + machine.setRom(preferences.getRomAddress2(), new File(s2)); + } } } } catch (Exception e) { diff --git a/src/com/maccasoft/tools/rom.bin b/src/com/maccasoft/tools/rom.bin new file mode 100644 index 0000000000000000000000000000000000000000..a1a314148c97b64bcb480566df2bc3e49cd2a1fd GIT binary patch literal 16384 zcmeHOe|!^Fwx9GTt+Wsj+5)zdOw#5@o1{sav}v18+NPmGliC&wu4_T4Py~vFrAb@T z78Fp~wf=YtK3#QPT}9Wf;u2PO-6lgYGcwY&r0@#5X7h%(nvc7t8s36_rtjPoUH^Ii zzxVlc=$*Mg&b{Z{?>*<-b7#WW)SoeQQ5}f~Mv*t456wOQxBHh(b1f!}VJU|+-d8m2JmY6suKU>IM^lqB&s=8Aw{&umFD*PPG&$n6Q7CvvaP2~DHU z$pPqpjb?iUHb@Tkj{-;k;~g$qgkfw*z-Qsv#vk$lzBs@q%lyr3(<|j#XR%TuIjxBh158l41 zXD42R0csS616J@yCF7!fKkBxDc?R{U?e5--*EOq~YOt)#wcVSxbnV)jD63SetV~RF zFwrF^8CFSX{>Nkv3)us6*|c0(8UZQ7#>Gh_)SCq45MPoVk%P+YbHv60kkG@24g16=rhJ>5I;EnR!=muF>~b|o%= z8I7HgsBzcc&K)JIJDvD_T{}AQp3cqPJzGG!`D-45c?9MWm`7k9fq4Yx5tv6{9)WoT z<`I}jU><>a1m+Q#M_?X-c?9MWm`7k9fq4Yx5tv6{9)WoT{(m7rrQy^*{1f=_ObPJ= zvTxNQD|wx2suI2~PTLIm6}`mLR3DCCXHQ79{~)zyi|AJtV&M0T4R_nry&vpm%5cht zD}^7=iob!+tuK)5LlVUcr0^fJc|x;g|C8MV&u-;JBRHE^8fO1!6b+(W=^G@BM^OY` z>)PA72R=}C!beo}$q{{Po%`5%XJ-$tR~hd`Uzc~gdb+l5+l$NU7Y^(EA%x1=Du(q<>nd23!_8k-d+sR{@pV*GI29F=lT=BxO z&Ofrprh3iCT0V3PUB+m^>?#bq75<@%`jeD`d*bg`7JjzIf?Lr?dJON{g=3EUkw(?_ zbZ)vI6Qy7kZh{{kvl9&j*R`?lWR$5SqAXb`$il*b3`$C{_YnSw7i!!|fm@W+?F6SN zu%uxb8D`Er{%_sp+2^Kr5?d?6m+}`^!CjO=fZ-@!B8B`cuwsPxz$;Z}-Zh%Nqc=M(Lj}2ZV3EBnnj2T8ZLivc3tLlmUWp6Zdt)@Ef~OrY2A`PHmNp0l{c5(M!PK zkX4G8S`^=q;susb_Ol}3ExyenF0gpPt6UfTlN4VgN4vL*^DNrM7BOMr{EDR(I)RoM z2b`!U$x-dsWOgb@=jL(dZmEqIGXqi&b5Lsfn)JARcT4#i^Dm*n&1!$2T4|WVrK@96I_mNUi6u)HPMMhPQohl*Qwl;&wfR1g*xX2z)4-otvT!N2 zM=E-ST(T7Y(WZw<5B#*{Vbb@aG?n?26lP;iRWk2Nkrq&ArKw7I`p%+ywqF4%EP9np z6O2L!w!hH94>CukXb9#nQZoiLsKLdjGejYue6C+%4DeaZJ_Wyw@kn_RM&&!0H>Lan zbX(%fFZ72v1IFG{1%o1A9rOZ69-lrdb@Gko^ojC9*8`w8M9Q2ja5pcYw1optjO~At zc1J!SBFuOZB29{fdlvSz8s&UNT)B z$7Ziix zuWmMg7<@95T@$5o3pZ~8?P7=JUXI-^7caDklCTO^N(6njqKuI8PUSrW82LgA zXmZ%6EDBzaW-nmZC8{DE*l2{UD`p!CUuDT+j@@Ml`$Gb3_>Q~W{2OM0?_d$K=(!eF zj2h!Q4wN{OHtg5IR6+gS@YAy26?uG4WH6@~v5bJZN5Qb8&{a566beiYO%Ka?>4cL= zccfua5iZUE#QafEM$yeJCTaschduHXbISBgcJDE*hfMSi7B z2)`}M;+KwHrc5Tzv4EIhc{e>yOtg~l zy-C0}uE?_t{5~INjuKHt4svf%nte$(raeT`oZ>Mu4Rd6OAA==u^Oj5ePip8n0ATVr zo{^b~E&RwdV-O6D2r-OfpErc>2;?sSPpO15P>yqP(Xl*$dfG|cdw-rhPad1nbS%g6 zqG9Sq8S|8cb;*=K$AQye{!11H;EO|mFMA+S4IoCM`=9I>c(xtfFbDobAj2|XxQU%a z6ylXI#4Ta!DG4(oVV{x+MvACHd3G|ark6`BrTJ)F=Lh)M9dcAgOHN$bD!G8bR9?!@ z20_P`&$1%oI)5}j#dj2Zu-0Pc0Wc}u~+1~-l`W}Z>-l}u3Kh29)U?D1_?upb)P ziy8wC!s;O*drx6DD^kGd4^^MO(63-um5!cSRT`%96j0|0Q2h!622RhMg`7wx+(yAC zm=2NEf%qttV$@NE=}5wBpzaev#Z>mhD+)DrRuN}^sRMcC%GlIv9OFgfsSg4{l`Y}> zQ+C=+7` zm5FT#`UZd887-}c`2_;B9qmO264dR?pmMn>tysxk)Ej(RX!Xf{ zW|21iV25bCIL~?Kdl1sp75fF7iv4xBv#o~pci3T*@GCMc)VktP?F(oCJ2 zu#~WNT%H1NFb+;b zl&<2K=M4yp5PP@QO%Q-k&>v?vYGEB??cx4+0)110OQY{sjW4?`^8+H8`A10&Rbr@m z%=_Zm*%v6iVfkG!<2gzC)s8+jdqeG|Hi4Rs7X^^g3uG!kSV4?z0El7zMjdm&Pq(O0 zMTg1(l+&%KFwv@-lK6J1s(@nAFse5#wp24K)iZ9DdrHQ9tr~@0mTTUiAdoK;N-fOh zGR18c6ox{Xd0XXrn()1t%f;0@GZ7u_LY80Lp zSRib@&7y=*27=g&svrtfqhVTGY!Tf`z`}uhRK&59}5Y&ILKnoi^A|I+-F+V?mrN|GPV0OvMItRQk!Dn0f&iLeG>@&H1oDPe=+O^ z!W1mVJR^I6*iAUV3<#v+4-i0`;}YD0P3%*9lTlloW3!FXaID(5OC7IW6U~F&2~H9) zgPX!XrA}@K-M%L(&xk6OXdbcYklN;O6U)O$fJhvqny{MM|b3ydqxh_I4=Iuc+Gf$R+5{2#PPzfPc=J%ZhCrka;hM+6L z|0_?Rz6n+r#@pC+DI9@kgxlCP?v2H`ke?2Q_rDuZHYn|!Qn{-T%V^%9oFlgpVOY8JO$ylg)!%F*{WIm_XmH}9WX}|(Wqf~;NV}Lv@$kh1R4cgIm zSP!>nuK1W1EGaR)6|`9ZLa@Kq0sB2(V9K`XMk5Z+eR`VKI)&MoA9TPQhJdMoxNjRE zRo?{5oX`#se2zXCS}{WXSsQh;8+0kDFtk5^mX|ZxD5xj~SB+FW77=*0{^}3XuyKd` z@%L?)>Sz|ksMUAOonE=ThMtJu%}acBI(BDeZWb@~HR;$-Dsz)z@Aigw(*RDP+#B>m z$6xET50dOblFHPuztB-@NVv!IvBc*7;P+g;K=8(k%tJa9vH`tzEs5lzK%T@wfgO;+ z=J-q^n(e1yTUddHO9Z&cN|E5fCA8?pa?lp)iVp4~ZxA*trzZfxwTIbk7@4@HQ&&Y{ z&qOtugi`{ktN$WoDJ09oA3Wt0(l#VL~NfJ$mY1{pg6z{qG%w``LEF zecW;7=lX4%M{O>T&!NA)t+U%XwSfQ3r_qmsYo$}=eL3x}#~d>@z4LCXhq+fTDz+Tz zov76ZoRIT;w^!dlxUUYq?w~dsR*l^{ws0(aNIym$Cfo;s!y~}qVFxWLvAET}qunF6 z{r}#v|JnBa#~rZ0PA!=Joxbj_JF+qAW&PQV?$MHftH9A$(B5Cr;ViIGC-v|`XE^!9 zoq0ns@xCGJiSh#w%X+?eMh2YSg0dmu*C`|M-Qe)A=)A!c)>$U<>)A=2h}N^)D+EJB z=$LUu7h|6{3QC8BxjhIyu_2(s*w4yb+Dc1QTxAhpSo3;OiJlWxlyMwD<|aH$XBnqj zP_WfC(OSkSsw{9IF;!X~{*i1Y1HRg_Fb%>xXaHY;KZtmt6+qE;KcSih7J9wXt!*da z){1Tp(h?nYw0CIlB02wl)=qwk)lB@Z42rRsal#vRRaF<<*sRa#&*?yz=Q!lf9GmGb zG6yJJ@0|2KU&g__%fgTWc%2?5#jqbL-WswMyyl!qHk=*mh208PzgJ0v6zZ@iJX5O& zQaGrB#+*%>K1|pE59pIvAf!S8lhVSgb6yyOQ@hxZb_8Yt&5qq^7-1O7p%i+k{Ys>? zxc@%X3r9{A`6!eq{GmY^QMd$~vJ#G*fE)5ub}&&|D7U1gtms`zr1}O8H0qpgEa=qhick{n;LZ}oK= zk-54`Q2g_n@m460KH0HwAyaMS`bWNT8)x5fL9HyK zs{#~2D+OuEvEiy4`Q`kAiTrXnQzcbbhvULum#6yFXMl z-9hyIvYl}K(xFsNn9IS75HM0SyqoZ5L9bM%yIcwH*_h4cyy}e85MzE(Zm<#t<;-BY zp+sE;Lri5(440oZK}6I`JP@V@d!G{iH-Ur=|Mj}@b1?0p7Y_**7h!)(#yq5)2 z6s<8tJ_mG=&)Ya>O-?4GV&+1*2dv7&)agTh*R??qawb*|h93u-IC`@%P!I-141-2q zIaLlz0Buuxu*RG+WS-^2!paknN3SG~Oz>sU@9Yp51YZ_ME`!yv*<~>_(tqf{y^0zu zSXTv@g7Yi&JGU31cs4=0tUimWub(E=9Gn@ z=q5n;G#Ict5b{Gfh-%Tf>xwQ+9jJii6x~DK__jhcNCF+?1Bb4rr(wOs;lqv$AVh-x zl&rd%oQCm&Bif&mqS=Z>6Ue#C(7)mD4u@e#*VMMAA z>>vJ7Qx)6ZZrFDG^C!9%2YRDav0^~NCsO=S(7d4`352n6%G5^q(!sCb6>xsjk{q&VX(~BApqVblQ zya)ueA+d{0)V?wp>AO?qptK17;px{*=$+XHK>w%n_uaW)FI@qz><(2< zX)ZzM)Twkn^Af+fhK}~F;o$rgrt=F?VEltfX+q#FkS+LV=|@X6-{hvCr&;qcs75OO z^^b%}@Vikty`XAJ1AN#Um6~fmjG5qhqml=n+8R1vhB&;Wi{A_=ybjK9UJ0*h%|C%# zm@CB4d)G>o-!Ye8jq>y-@WBDT98wF=#}s&#@&rlc;$K?hFM3bI*BOYL;cX8r$ow^r Lz&rx~2NC!m3ySki literal 0 HcmV?d00001